home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 1998 April / Freeware-CD.bin / cputst / cmptest / cmptst!.EXE / COMPTEST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-06-07  |  54.1 KB  |  1,454 lines
  1. PROGRAM CompTest; { Copyright (c) 1988-1993 Norbert Juffa }
  2.  
  3. {$A+,B-,D-,E+,F-,G-,I-,L-,N+,O-,R-,S-,V-,X-}
  4. {$M 4096,0,655360}
  5.  
  6. USES DOS, Crt, Time, Whet, Dhry, LLL, Caches;
  7.  
  8. CONST
  9.    MaxBufSize= 65500;
  10.    ClockFreq = 1.193182e6;
  11.  
  12.  
  13. TYPE
  14.    LongWord  = ARRAY [1..2] OF WORD;
  15.    IOPuffer  = ARRAY [1..MaxBufSize] OF BYTE;
  16.    PufferZgr = ^IOPuffer;
  17.    Processor = (NA, i88, i86, V20, V30, i188, i186, i286, i386, i386sx, ct386,
  18.                 ct386sx, c486dlc, c486slc, rapidcad, i486, i486sx, Pentium);
  19.    CardType  = (MDA, CGA, Herkules, EGA, MCGA, VGA, PGA);
  20.    ResultRec = RECORD
  21.                   CPUType: BYTE;
  22.                   NDPType: BYTE;
  23.                   AAMTime: INTEGER;
  24.                   Dummy1:  INTEGER;
  25.                   MoveWTime,
  26.                   BIOSWriteTime, MoveBTime, EMS_Time, Ext_Time, ScreenFillTime,
  27.                   Dummy2, Speed87, Speed287, MoveDTime: INTEGER;
  28.                END;
  29.  
  30.  
  31.  
  32. CONST
  33.    SIOBase:     ARRAY [1..4] OF WORD =
  34.                 ($3F8, $2F8, $3E8, $2E8);
  35.    SIOTypeStr:  ARRAY [1..5] OF STRING [7] =
  36.                 ('8250', '16450', '16550', '16550A', 'unknown');
  37.    BusWidth:    ARRAY [i88 .. pentium] OF BYTE =
  38.                 (8, 16, 8, 16, 8, 16, 16, 32, 16, 32, 16,
  39.                  32, 16, 32, 32, 32, 32);
  40.    AAM_Time:    ARRAY [i88 .. pentium] OF INTEGER =
  41.                 (77, 77, 15, 15, 19, 19, 16, 17, 17, 16, 16,
  42.                  17, 17, 15, 15, 15, 18);
  43.    FillTime:    ARRAY [i88 .. pentium] OF INTEGER =
  44.                 (10, 10, 4, 4, 9, 9, 3, 5, 5, 5, 5,
  45.                 4, 4, 4, 4, 4, 1);
  46.    MoveTime:    ARRAY [i88 .. pentium] OF INTEGER =
  47.                 (25, 17, 8, 16, 8, 16, 4, 4, 8, 4, 8,
  48.                 4, 4, 5, 3, 3, 1);
  49.    LFaktor:     ARRAY [i88 .. pentium] OF REAL =
  50.                 (1, 1.45, 1.15, 1.78, 1.15, 1.78, 3.3, 4.1, 3.4,
  51.                  4.5, 3.7, 5.0, 6.0, 6.5, 8.5, 8.5, 17);
  52.    CPU_Name:    ARRAY [i88 .. pentium] OF STRING [15] =
  53.                 ('Intel 8088', 'Intel 8086', 'NEC V20', 'NEC V30',
  54.                  'Intel 80188', 'Intel 80186', 'Intel 80286',
  55.                  'Intel 80386', 'Intel 80386SX', 'C&T 38600DX',
  56.                  'C&T 38600SX', 'Cyrix 486DLC', 'Cyrix 486SLC',
  57.                  'Intel RapidCAD', 'Intel 80486',
  58.                  'Intel 80486SX', 'Intel Pentium');
  59.    CoProcessor: ARRAY [0 .. 28] OF STRING [19] =
  60.                 ('NOT INSTALLED', 'Emulation via INT 7', 'Intel 8087',
  61.                  'Intel 80C187', 'Intel 80287', 'Intel 80287XL', 'Intel 80387',
  62.                  'Intel 80387sx', 'IIT 2C87', 'IIT 2C87', 'IIT 3C87',
  63.                  'IIT 3C87sx', 'Cyrix 82S87 (old)', 'Cyrix 82S87 (old)',
  64.                  'Cyrix 83D87', 'Cyrix 83S87 (old)', 'ULSI 83C87', 'ULSI 83S87',
  65.                  'C&T 38700DX', 'C&T 38700SX', 'Intel 80387DX', 'Intel RapidCAD',
  66.                  'Intel 486', 'Cyrix 82S87 (new)', 'Cyrix 82S87 (new)',
  67.                  'Cyrix 387+', 'Cyrix 83S87 (new)', 'Cyrix EMC87',
  68.                  'Intel Pentium');
  69.    Installed:   ARRAY [FALSE..TRUE] OF STRING [13] =
  70.                 ('NOT INSTALLED', 'INSTALLED');
  71.    Computer:    ARRAY [$F5..$FF] OF STRING [14] =
  72.                 ('PS/2 Model 60', 'PS/2 Model 50', 'XT-286', 'PS/2 Model 80',
  73.                  'Laptop', 'PS/2 Model 30', 'XT', 'AT', 'PCjr', 'XT / Portable',
  74.                  'PC');
  75.    CardMemBegin:ARRAY [MDA .. PGA] OF WORD =
  76.                 ($B000, $B800, $B000, $A000, $A000, $A000, $A000);
  77.    CardName:    ARRAY [MDA .. PGA] OF STRING [37] =
  78.                 ('Monochrome Display Adapter (MDA)',
  79.                  'Color Graphics Adapter (CGA)',
  80.                  'Hercules Graphics Card (HGC)',
  81.                  'Enhanced Graphics Adapter (EGA)',
  82.                  'Multi Color Graphics Array (MCGA)',
  83.                  'Video Graphics Array (VGA)',
  84.                  'Professional Graphics Adapter (PGA)');
  85.  
  86.  
  87. VAR
  88.    SIOType:                                         ARRAY [1..4] OF BYTE;
  89.  
  90.    SIOCtrl, SIOStat, SerOut, DataWidth, SaveByte,
  91.    ConfigStatHi, ConfigStatLo, DOS_Drives,
  92.    NrOfHardDisks, NrOfFloppies, EGAInfo, DriveByte,
  93.    ErrByte, NrHD, NrDD, Nr3DD, Nr3HD, Drive1,
  94.    Drive2, Typ, Head1, K:                           BYTE;
  95.  
  96.    MemExists, GamesAdaptor, MousePresent,
  97.    ExtendedMem, ExpandedMem, MonoChromMode,
  98.    Disktest, OldMemExists, ExtraRAMFound, EGAPres,
  99.    VGAPres, ANSIPresent, Debug, Emu, Weitek,
  100.    PortExists:                                      BOOLEAN;
  101.  
  102.    Ch:                                              CHAR;
  103.  
  104.    ScreenWaits, Segment, OldSegment, NrParallelPorts,
  105.    NrSerialPorts, DefaultDr, ExtendedMemSize,
  106.    ExpandedMemSize, SystemMemory, L, DOS_Memory,
  107.    EGAMem, UsedMemory, BufSeg, BufOff, Head,
  108.    Dummy, Track, RAMBeg, ROMSize, EMS_Base,
  109.    FillSize, FirstLevel, SecondLevel, SPC,
  110.    SegTest, OfsTest, ChkSum:                        WORD;
  111.  
  112.    Start, DOSWriteTime, BIOSWriteTime, SavedTime,
  113.    CacheTstTime, HeapPointer:                       LONGINT;
  114.  
  115.    MoveTakte, MoveWTakte, FillTakte, Frequency,
  116.    Waitstates, Cache2Thru, Frequency87, Durchsatz,
  117.    EMS_Thruput, Ext_Thruput, DOSSpeed, CacheThru,
  118.    MemThru, BIOSSpeed, Index, Version, ThruPut:     REAL;
  119.  
  120.    MegaFlops, Dhrys, Whets:                         DOUBLE;
  121.    Fil:                                             TEXT;
  122.    EMS_Version:                                     STRING [3];
  123.    ComputerType, ScreenType:                        STRING [35];
  124.    ProcessorType:                                   STRING [15];
  125.    DiskTypeStr, DriveStr:                           STRING [45];
  126.    TestStr:                                         STRING [86];
  127.    ScreenAddr:                                      POINTER;
  128.    CPU:                                             Processor;
  129.    GraphCard:                                       CardType;
  130.    Regs:                                            Registers;
  131.    Result:                                          ResultRec;
  132.    DummyPtr, BufPtr:                                PufferZgr;
  133.    MoveBuffer:                                      POINTER;
  134.    Heads, Sectors, DOSCylinders, Tracks, Cylinders: ARRAY [$80..$83] OF WORD;
  135.    Capacity, CylSize:                               ARRAY [$80..$83] OF LONGINT;
  136.    Valid:                                           ARRAY [$80..$83] OF BOOLEAN;
  137.    MaximumAccess, AverageAccess, TrackToTrack,
  138.    DiskThruPut:                                     ARRAY [$80..$83] OF REAL;
  139.    CacheOn:                                         ARRAY [$80..$83] OF BOOLEAN;
  140.    InfoBuf:                                         ARRAY [0..64] OF BYTE;
  141.  
  142.  
  143.  
  144. {$L CCNEW.OBJ}
  145.  
  146. PROCEDURE SpeedTest (Debg, Ext_Flag, EMS_Flag: WORD;
  147.                      EPtr, Bptr, Sptr: POINTER;
  148.                      VAR Results: ResultRec); NEAR; EXTERNAL;
  149.  
  150.  
  151.  
  152. FUNCTION EMM_Installed: BOOLEAN;
  153.  
  154. VAR
  155.   EMM_Name: String[8];
  156.   Regs    : Registers;
  157.  
  158. BEGIN
  159.    EMM_Name := '        ';
  160.    Regs.AH := $35;
  161.    Regs.AL := $67;
  162.    Intr ($21, Regs);
  163.    Move (Mem [Regs.ES:$0A], EMM_Name[1], 8);
  164.    EMM_Installed := (EMM_Name = 'EMMXXXX0');
  165. END;
  166.  
  167.  
  168.  
  169. FUNCTION EMS_Memory: INTEGER;
  170. VAR Regs: Registers;
  171. BEGIN
  172.     Regs.AH    := $42;
  173.     Intr ($67, Regs);
  174.     EMS_Memory := Regs.DX * 16;
  175. END;
  176.  
  177.  
  178. FUNCTION GetEMSVersion: STRING;
  179. VAR Regs: Registers;
  180. BEGIN
  181.    Regs.AH := $46;
  182.    Intr ($67, Regs);
  183.    GetEMSVersion := Char (Regs.AL SHR 4 + 48) + '.' + Char(Regs.AL AND $F +48); { dito für Neben-Versionsnummer }
  184. END;
  185.  
  186.  
  187.  
  188. FUNCTION CheckMouse: BOOLEAN;
  189. VAR Regs: Registers;
  190. BEGIN
  191.    Regs.AX := 5;                 { get button press information (destroys AX) }
  192.    Regs.BX := 0;                 { left button }
  193.    Intr ($33, Regs);
  194.    CheckMouse := (Regs.AX <> 5);
  195. END;
  196.  
  197.  
  198.  
  199. FUNCTION GetEMSBase: WORD;
  200. VAR Regs: Registers;
  201. BEGIN
  202.    Regs.AH := $41;
  203.    Intr ($67, Regs);
  204.    GetEMSBase := Regs.BX;
  205. END;
  206.  
  207.  
  208.  
  209. {$F+}
  210. FUNCTION HeapFunc (Size: WORD): INTEGER;
  211. {$F-}
  212. BEGIN
  213.    HeapFunc := 1;
  214. END;
  215.  
  216.  
  217.  
  218. FUNCTION HercPresent: BOOLEAN;
  219. BEGIN
  220.    Inline($BB/$00/$01/$BA/$BA/$03/$EC/$88/$C4/$80/$E4/$80/$B9/$40/$00/$EC/
  221.           $24/$80/$38/$E0/$E1/$F9/$75/$05/$4B/$75/$F1/$EB/$33/$B8/$00/$B0/
  222.           $8E/$C0/$E8/$11/$00/$75/$0B/$B0/$01/$BA/$BF/$03/$EE/$E8/$06/$00/
  223.           $74/$1E/$B0/$01/$EB/$1C/$26/$8A/$1E/$FF/$7F/$26/$8A/$0E/$FF/$3F/
  224.           $26/$FE/$06/$FF/$3F/$26/$3A/$1E/$FF/$3F/$26/$88/$0E/$FF/$3F/$C3/
  225.           $30/$C0/$88/$46/$FF/$08/$C0);
  226. END;
  227.  
  228.  
  229. FUNCTION Hex (X: WORD): STRING;
  230. VAR H: ARRAY [0..15] OF CHAR;
  231. BEGIN
  232.    H := '0123456789ABCDEF';
  233.    Hex := H [X SHR 12] + H [(X AND $0F00) SHR 8] +
  234.           H [(X AND $00F0) SHR 4] + H [(X AND $000F)];
  235. END;
  236.  
  237.  
  238.  
  239. PROCEDURE SearchExtraRAM (FileWrite: BOOLEAN);
  240. BEGIN
  241.    ExtraRAMFound := FALSE;
  242.    IF SystemMemory * 64 < CardMemBegin [GraphCard] THEN
  243.       Segment := SystemMemory * 64
  244.    ELSE
  245.       Segment := $C000;
  246.    MemExists := FALSE;
  247.    WHILE Segment < $FC00 DO BEGIN
  248.       Inline ($54/$58/$3B/$C4/$74/$0C/$B0/$00/$E6/$A0/
  249.               $E4/$61/$0C/$30/$E6/$61/$EB/$0E/$E4/$70/
  250.               $0C/$80/$E6/$70/$E4/$71/$E4/$61/$0C/$0C/
  251.               $E6/$61/$FA);
  252.       OldMemExists := MemExists;
  253.       SaveByte := Mem [Segment:0];
  254.       Mem [Segment:0] := $55;
  255.       Dummy := Mem [Segment:0];
  256.       MemExists := (Dummy = $55);
  257.       Mem [Segment:0] := $AA;
  258.       Dummy := Mem [Segment:0];
  259.       MemExists := MemExists AND (Dummy = $AA);
  260.       Mem [Segment:0] := SaveByte;
  261.       Inline ($54/$58/$3B/$C4/$74/$0C/$E4/$61/$34/$30/
  262.               $E6/$61/$B0/$80/$E6/$A0/$EB/$0E/$E4/$61/
  263.               $34/$0C/$E6/$61/$E4/$70/$24/$7F/$E6/$70/
  264.               $E4/$71/$FB);
  265.       IF Segment = EMS_Base THEN
  266.          MemExists := FALSE;
  267.       IF Segment = CardMemBegin [GraphCard] THEN
  268.          MemExists := FALSE;
  269.       IF MemExists AND (NOT OldMemExists) THEN BEGIN
  270.          ExtraRAMFound := TRUE;
  271.          RAMBeg := Segment;
  272.          END;
  273.       IF (NOT MemExists) AND OldMemExists THEN BEGIN
  274.          IF FileWrite THEN
  275.             Write (Fil, Hex (RAMBeg)+'0', '-', Hex (Segment-1)+'F (',
  276.                   (Segment-RAMBeg) DIV 64:3 , ' KB)', #13#10, ' ':37)
  277.          ELSE
  278.             Write (Hex (RAMBeg)+'0', '-', Hex (Segment-1)+'F (',
  279.                   (Segment-RAMBeg) DIV 64:3 , ' KB)', #13#10, ' ':37);
  280.          END;
  281.       IF Segment = CardMemBegin [GraphCard] THEN
  282.          Segment := $BFF0;
  283.       IF Segment = EMS_Base THEN BEGIN
  284.          IF FileWrite THEN
  285.             Write (Fil, Hex (EMS_Base)+'0', '-', Hex (EMS_Base+$0FFF)+'F ( 64 KB)',
  286.                    ' EMS-frame', #13#10, ' ':37)
  287.          ELSE
  288.             Write (Hex (EMS_Base)+'0', '-', Hex (EMS_Base+$0FFF)+'F ( 64 KB)',
  289.                    ' EMS-frame', #13#10, ' ':37);
  290.          Inc (Segment, $1000);
  291.          END
  292.       ELSE
  293.          Inc (Segment, $10);
  294.    END;
  295.    IF (NOT ExtraRAMFound) AND ((NOT ExpandedMem) OR (EMS_BASE > $F000)) THEN
  296.       IF FileWrite THEN
  297.          WriteLn (Fil, 'NOT FOUND')
  298.       ELSE
  299.          WriteLn ('NOT FOUND');
  300. END;
  301.  
  302.  
  303. PROCEDURE SearchROM (FileWrite: BOOLEAN);
  304. VAR Vector_41: POINTER;
  305.     Vector_57: POINTER;
  306. BEGIN
  307.    GetIntVec ($41, Vector_41);
  308.    GetIntVec ($57, Vector_57);
  309.    ExtraRAMFound := FALSE;
  310.    Segment := $C000;
  311.    OldSegment := 0;
  312.    WHILE (Segment < $F000) AND (OldSegment < Segment) DO BEGIN
  313.       OldSegment := Segment;
  314.       IF MemW [Segment:0] = $AA55 THEN BEGIN
  315.          ROMSize := Mem [Segment:2] DIV 2;
  316.          Inline ($FC/$8B/$0E/ROMSize/$86/$CD/$D1/$E1/$D1/$E1/$31/
  317.                  $F6/$89/$F3/$A1/Segment/$1E/$8E/$D8/$AC/$00/$C3/
  318.                  $E2/$FB/$1F/$89/$1E/ChkSum);
  319.          IF ChkSum = 0 THEN BEGIN
  320.             ExtraRAMFound := TRUE;
  321.             IF FileWrite THEN
  322.                Write (Fil, Hex(Segment)+'0', '-', Hex(Segment+ROMSize * 64-1)+'F (',
  323.                       ROMSize:3, ' KB)')
  324.             ELSE
  325.                Write (Hex(Segment)+'0', '-', Hex(Segment+ROMSize * 64-1)+'F (',
  326.                       ROMSize:3, ' KB)');
  327.             IF (Seg(Vector_41^) = Segment) THEN
  328.                 IF FileWrite THEN
  329.                    Write (Fil, ' Harddisk-BIOS')
  330.                 ELSE
  331.                    Write (' Harddisk-BIOS');
  332.              IF (Segment = Seg(Vector_57^)) THEN
  333.                 IF FileWrite THEN
  334.                    Write (Fil, ' NetBIOS-ROM')
  335.                 ELSE
  336.                    Write (' NetBIOS-ROM');
  337.              IF (Segment = $C000) THEN
  338.                 IF VGAPres THEN
  339.                    IF FileWrite THEN
  340.                       Write (Fil, ' VGA-BIOS')
  341.                    ELSE
  342.                       Write (' VGA-BIOS')
  343.                 ELSE IF EGAPres THEN
  344.                    IF FileWrite THEN
  345.                       Write (Fil, ' EGA-BIOS')
  346.                    ELSE
  347.                       Write (' EGA-BIOS');
  348.             IF FileWrite THEN
  349.                Write (Fil, #13#10, ' ':37)
  350.             ELSE
  351.                Write (#13#10, ' ':37);
  352.             Inc (Segment, ROMSize * 64)
  353.             END
  354.          ELSE
  355.             Inc (Segment, $10);
  356.          END
  357.       ELSE
  358.          Inc (Segment, $10);
  359.     END;
  360.     IF NOT ExtraRAMFound THEN
  361.        IF FileWrite THEN
  362.           WriteLn (Fil, 'NOT FOUND')
  363.        ELSE
  364.           WriteLn ('NOT FOUND');
  365. END;
  366.  
  367.  
  368.  
  369. PROCEDURE ReserveMem;
  370. BEGIN
  371.    BufPtr := NIL;
  372.    IF CylSize [L] > LongInt (MaxBufSize) THEN BEGIN
  373.       SPC := MaxBufSize DIV 512;
  374.       CylSize [L] := SPC * 512;
  375.       END;
  376.    HeapPointer := LONGINT (LongWord(HeapPtr)[2]) * 16 + LongWord(HeapPtr)[1];
  377.    FillSize := $10000 - HeapPointer MOD $10000;
  378.    GetMem (DummyPtr, FillSize);
  379.    IF DummyPtr = NIL THEN BEGIN
  380.       WriteLn (#13#10#10'Not enough memory to test hard disk(s)');
  381.       Halt;
  382.    END;
  383.    GetMem (BufPtr, Word (CylSize[L]+16));
  384.    IF BufPtr = NIL THEN BEGIN
  385.       WriteLn (#13#10#10'Not enough memory to test hard disk(s)');
  386.       Halt;
  387.       END;
  388. END;
  389.  
  390.  
  391.  
  392. BEGIN
  393.    Debug := (ParamStr (ParamCount) = '-D') OR (ParamStr (ParamCount) = '-d') OR
  394.             (ParamStr (ParamCount) = '/D') OR (ParamStr (ParamCount) = '/d');
  395.    IF (ParamStr (ParamCount) = '-H') OR (ParamStr (ParamCount) = '-h') OR
  396.       (ParamStr (ParamCount) = '/H') OR (ParamStr (ParamCount) = '/h') OR
  397.       (ParamStr (ParamCount) = '/?') OR (ParamStr (ParamCount) = '-?') THEN BEGIN
  398.        WriteLn (#10#13, 'COMPTEST tests the performance of your PC compatible computer');
  399.        WriteLn (#10#13, 'usage: COMPTEST [file name] [/D] [/H]');
  400.        WriteLn (#10#13, 'file name: saves the test results in file specified');
  401.        WriteLn (        '/D:        enables additional debugging messages');
  402.        WriteLn (        '/H:        displays this information');
  403.        WriteLn;
  404.        Halt (0);
  405.        END;
  406.  
  407.    Regs.AH := 0;                         { switch off diskette motor }
  408.    Regs.DL := 0;                         { recalibrate diskettes only }
  409.    Intr ($13, Regs);
  410.  
  411.    DirectVideo := TRUE;
  412.    CheckBreak  := FALSE;
  413.  
  414.    HeapError := @HeapFunc;
  415.  
  416.    GetMem (MoveBuffer, 20000);
  417.    IF MoveBuffer = NIL THEN BEGIN
  418.       WriteLn ('Not enough memory to execute COMPTEST');
  419.       Halt;
  420.       END;
  421.  
  422.    WITH Result DO BEGIN
  423.  
  424.    {-------------------------------------------------------------------------
  425.      determine computer type
  426.    --------------------------------------------------------------------------}
  427.  
  428.    Typ := Mem [$FFFF:$000E];
  429.    Regs.AH := $C0;                       { get system description table }
  430.    Intr ($15, Regs);
  431.    IF Debug AND ((Regs.Flags AND FCarry) = 0) THEN BEGIN
  432.       WriteLn ('computer type: ', Hex (MemW [Regs.ES:Regs.BX+2]));
  433.       ReadLn;
  434.       END;
  435.    IF ((Regs.Flags AND FCarry) = 0) AND (Mem [Regs.ES:Regs.BX+2] = $FC) THEN
  436.       CASE Mem [Regs.ES:Regs.BX+3] OF
  437.          $02: Typ := $F7;                { XT-286 }
  438.          $04: Typ := $F6;                { PS/2 Model 50 }
  439.          $05: Typ := $F5;                { PS/2 Model 60 }
  440.       END;
  441.    IF Typ < $F5 THEN
  442.       ComputerType := 'Unknown'
  443.    ELSE
  444.       ComputerType := 'IBM ' + Computer [Typ] + ' or compatible';
  445.  
  446.  
  447.    {-------------------------------------------------------------------------
  448.      determine equipment
  449.    --------------------------------------------------------------------------}
  450.  
  451.    Intr ($11, Regs);                     { get BIOS equipment flag }
  452.    NrParallelPorts := (Regs.AH AND $C0) SHR 6;
  453.    GamesAdaptor    := (Regs.AH AND $10) <> 0;
  454.    NrSerialPorts   := (Regs.AH AND $6) SHR 1;
  455.    NrOfFloppies    := (Regs.AL AND $C0) SHR 6 + (Regs.AL AND 1);
  456.    MousePresent    := CheckMouse;
  457.  
  458.    IF NOT GamesAdaptor THEN
  459.       GamesAdaptor := (Port [$201] AND $F) = 0;
  460.  
  461.    IF Debug THEN WriteLn ('About to perform SIO-Test');
  462.  
  463.    Dummy := 0;
  464.    FOR L := 1 TO 4 DO BEGIN
  465.       SIOType [L] := 0;
  466.       SIOCtrl := Port [SIOBase [L] + 4];
  467.       Port [SIOBase [L] + 4] := SIOCtrl OR $10;
  468.       SIOStat := Port [SIOBase [L] + 6];
  469.       Port [SIOBase [L] + 4] := $1A;
  470.       SerOut := Port [SIOBase [L] + 6] AND $F0;
  471.       Port [SIOBase [L] + 4] := SIOCtrl;
  472.       Port [SIOBase [L] + 6] := SIOStat;
  473.       IF SerOut = $90 THEN BEGIN
  474.          Inc (Dummy);
  475.          SIOType [L] := 1;
  476.          K := Port [SIOBase [L]+7];
  477.          IF K = Port [SIOBase [L]+7] THEN BEGIN
  478.             PortExists := TRUE;
  479.             FOR K := 0 TO 255 DO BEGIN
  480.                 Port [SIOBase [L]+7] := K;
  481.                 Delay (1);
  482.                 PortExists := PortExists AND (K = Port [SIOBase [L]+7]);
  483.             END;
  484.             IF PortExists THEN BEGIN
  485.                Inc (SIOType [L]);
  486.                Port [SIOBase [L] + 2] := $01;
  487.                SIOStat := Port [SIOBase [L] + 2] AND $C0;
  488.                IF SIOStat = $C0 THEN
  489.                   SIOType [L] := 4
  490.                ELSE IF SIOStat = $80 THEN
  491.                   SIOType [L] := 3
  492.                ELSE IF SIOStat = 0 THEN
  493.                   SIOType [L] := 2
  494.                ELSE
  495.                   SIOType [L] := 5;
  496.                Port [SIOBase [L] + 2] := 0;
  497.                END; { if portexists...}
  498.             END; { if k...}
  499.          END; { if serout...}
  500.    END; { for l ... }
  501.  
  502.    IF Dummy > NrSerialPorts THEN
  503.       NrSerialPorts := Dummy;
  504.  
  505.  
  506.    {-------------------------------------------------------------------------
  507.      determine graphics card
  508.    --------------------------------------------------------------------------}
  509.  
  510.    Regs.AX := $1B00;                     { get VGA state information }
  511.    Regs.BX := 0;                         { implementation type }
  512.    Regs.ES := Seg (InfoBuf);             { buffer for }
  513.    Regs.DI := Ofs (InfoBuf);             { return information }
  514.    Intr ($10, Regs);                     { try to call VGA Bios }
  515.    VGAPres := (Regs.AL = $1B);           { VGA if AL = AH on return }
  516.  
  517.    Regs.AH := $12;                       { get EGA hardware configuration }
  518.    Regs.BX := $FF10;
  519.    Intr ($10, Regs);                     { try to call EGA Bios }
  520.    EGAPres := (Regs.BH <> $FF);          { EGA, if BH <> $FF }
  521.    EGAMem  := Lo (Regs.BX) * 64 + 64;    { size of EGA screen memory in KB }
  522.  
  523.    Regs.AH := $0F;                       { get screen status }
  524.    Intr ($10, Regs);                     { BIOS video interupt }
  525.    MonoChromMode := Regs.AL = 7;
  526.  
  527.    Regs.AX := $1A00;                     { get screen combination code }
  528.    Intr ($10, Regs);                     { call PS/2 BIOS }
  529.    IF (Regs.AL = $1A) AND (Regs.BL>= $A) AND (Regs.BL <= $C) THEN
  530.       GraphCard := MCGA
  531.    ELSE IF (Regs.AL = $1A) AND (Regs.BL = 6) THEN
  532.       GraphCard := PGA
  533.    ELSE IF MonoChromMode THEN
  534.       IF VGAPres THEN
  535.          GraphCard := VGA
  536.       ELSE IF EGAPres THEN
  537.          GraphCard := EGA
  538.       ELSE IF HercPresent THEN
  539.          GraphCard := Herkules
  540.       ELSE
  541.          GraphCard := MDA
  542.    ELSE
  543.       IF VGAPres THEN
  544.          GraphCard := VGA
  545.       ELSE IF EGAPres THEN
  546.          GraphCard := EGA
  547.       ELSE
  548.          GraphCard := CGA;
  549.  
  550.  
  551.    {-------------------------------------------------------------------------
  552.      determine memory
  553.    --------------------------------------------------------------------------}
  554.  
  555.    DOS_Memory := MemW [$0000:$0413];
  556.    UsedMemory := PrefixSeg SHR 6;
  557.    Regs.AH := $88;
  558.    Intr ($15, Regs);
  559.    ExtendedMem := (((Regs.Flags AND FCarry) = 0) AND (Regs.AX <> 0));
  560.    IF ExtendedMem THEN
  561.       ExtendedMemSize := Regs.AX
  562.    ELSE IF (Typ = $FC) OR ((Typ >= $F5) AND (Typ <= $F8)) THEN BEGIN
  563.       Port [$70] := $30;
  564.       Dummy := Port [$71];
  565.       Port [$70] := $31;
  566.       ExtendedMemSize := Port [$71] * 256 + Dummy;
  567.       ExtendedMem := ExtendedMemSize > 0;
  568.       END;
  569.    ExpandedMem := EMM_Installed;
  570.    EMS_Base := 0;
  571.    IF ExpandedMem THEN BEGIN
  572.       ExpandedMemSize := EMS_Memory;
  573.       EMS_Version := GetEMSVersion;
  574.       EMS_Base    := GetEMSBase;
  575.       END;
  576.  
  577.    Segment := 0;
  578.    SystemMemory := 0;
  579.    MemExists := TRUE;
  580.    WHILE MemExists AND (Segment < CardMemBegin [GraphCard]) DO BEGIN
  581.       Inline ($FA);                         { disable interupts }
  582.       SaveByte := Mem [Segment:0];
  583.       Mem [Segment:0] := $55;
  584.       Dummy := Mem [Segment:0];
  585.       MemExists := (Dummy = $55);
  586.       Mem [Segment:0] := $AA;
  587.       Dummy := Mem [Segment:0];
  588.       MemExists := MemExists AND (Dummy = $AA);
  589.       Mem [Segment:0] := SaveByte;
  590.       Inline ($FB);                         { enable interupts }
  591.       Inc (Segment, $400);
  592.       IF MemExists THEN
  593.          Inc (SystemMemory, 16);
  594.    END;
  595.  
  596.    {-------------------------------------------------------------------------
  597.      determine diskette drives
  598.    --------------------------------------------------------------------------}
  599.  
  600.    DOS_Drives := 0;
  601.    DriveStr := '  (';
  602.    Regs.AH := $19;
  603.    Intr ($21, Regs);
  604.    DefaultDr := Regs.AL;
  605.    FOR L:=0 TO 8 DO BEGIN
  606.       Regs.AH := $0e;
  607.       Regs.DX := L;
  608.       Intr ($21, Regs);
  609.       Regs.AH := $19;
  610.       Intr ($21, Regs);
  611.       IF (Regs.AL = Regs.DX) THEN BEGIN
  612.          Inc (DOS_Drives);
  613.          DriveStr := DriveStr + Chr (L+65) + ':, ';
  614.          END;
  615.    END;
  616.    Regs.AH := $0e;
  617.    Regs.DX := DefaultDr;
  618.    Intr ($21, Regs);
  619.    IF DriveStr [Length(DriveStr)-1] = ',' THEN
  620.       Dec (DriveStr [0], 2);
  621.    DriveStr := DriveStr + ')';
  622.  
  623.    DriveByte := 0;
  624.    IF Typ = $FC THEN BEGIN
  625.       Port [$70] := $10;
  626.       DriveByte := Port [$71];
  627.       Drive1 := DriveByte AND 15;
  628.       NrDD := 0;
  629.       NrHD := 0;
  630.       Nr3DD := 0;
  631.       Nr3HD := 0;
  632.       CASE Drive1 OF
  633.           1: Inc (NrDD);
  634.           2: Inc (NrHD);
  635.           3: Inc (Nr3DD);
  636.           4: Inc (Nr3HD);
  637.       END;
  638.       Drive2 := DriveByte SHR 4;
  639.       CASE Drive2 OF
  640.           1: Inc (NrDD);
  641.           2: Inc (NrHD);
  642.           3: Inc (Nr3DD);
  643.           4: Inc (Nr3HD);
  644.       END;
  645.    END;
  646.  
  647.    DiskTypeStr := '';
  648.    IF DriveByte <> 0 THEN BEGIN
  649.       DiskTypeStr := '  (';
  650.       IF NrDD <> 0 THEN
  651.          DiskTypeStr := DiskTypeStr + Char (48+NrDD) + ' x 360 KB 5¼", ';
  652.       IF NrHD <> 0 THEN
  653.          DiskTypeStr := DiskTypeStr + Char (48+NrHD) + ' x 1.2 MB 5¼", ';
  654.       IF Nr3DD <> 0 THEN
  655.          DiskTypeStr := DiskTypeStr + Char (48+Nr3DD) + ' x 720 KB 3½", ';
  656.       IF Nr3HD <> 0 THEN
  657.          DiskTypeStr := DiskTypeStr + Char (48+Nr3HD) + ' x 1.44 MB 3½", ';
  658.       Dec (DiskTypeStr[0], 2);
  659.       DiskTypeStr := DiskTypeStr + ')';
  660.       END;
  661.  
  662.    {-------------------------------------------------------------------------
  663.      determine hard disks
  664.    --------------------------------------------------------------------------}
  665.  
  666.    Regs.AH := $08;                          { get drive parameters }
  667.    Regs.DL := $80;                          { of first harddisk }
  668.    Intr ($13, Regs);                        { BIOS disk interupt }
  669.    IF (Regs.Flags AND FCarry) <> 0 THEN     { error indicates no harddisk }
  670.       NrOfHardDisks := 0
  671.    ELSE
  672.       NrOfHardDisks := Regs.DL;             { else # of harddisk is returned }
  673.  
  674.    FOR L := 1 TO 4 DO BEGIN
  675.       Regs.AH := $10;                       { test drive ready }
  676.       Regs.DL := $7F + L;                   { of harddisk # L }
  677.       Intr ($13, Regs);                     { BIOS disk interupt }
  678.       IF ((Regs.Flags AND FCarry) <> 0) OR  { no error indicates drive exists }
  679.          (NrOfHardDisks = 0) THEN
  680.          Valid [$7F+L] := FALSE
  681.       ELSE BEGIN
  682.          Valid [$7F+L] := TRUE;
  683.          Dec (NrOfHardDisks);
  684.          END;
  685.    END;
  686.  
  687.    NrOfHardDisks := 0;
  688.    FOR L := $80 TO $83 DO BEGIN
  689.       IF Valid [L] THEN
  690.          Inc (NrOfHardDisks);
  691.    END;
  692.  
  693.  
  694.    {-------------------------------------------------------------------------
  695.      determine type of processor and coprocessor
  696.    --------------------------------------------------------------------------}
  697.  
  698.    IF MonoChromMode THEN
  699.       ScreenAddr := Ptr ($B000,0000)
  700.    ELSE
  701.       ScreenAddr := Ptr ($B800,0000);
  702.  
  703.    IF Debug THEN BEGIN
  704.       WriteLn;
  705.       FillChar (Result, SizeOf (ResultRec), 0);
  706.       Result.Speed287 := 1;
  707.       END;
  708.  
  709.    SpeedTest (Word (NOT Debug), Word(ExtendedMem), Word(ExpandedMem), MoveBuffer,
  710.               Ptr (EMS_Base, 0), ScreenAddr, Result);
  711.  
  712.    IF Debug THEN BEGIN
  713.       WriteLn ('RawMoveWTime: ', MoveWtime);
  714.       WriteLn ('RawMoveDTime: ', MoveDTime);
  715.       WriteLn ('CPU-Type:     ', CPUType);
  716.       WriteLn ('AAMTime:      ', AAMTime DIV 4);
  717.       WriteLn ('MoveBTime:    ', MoveBtime);
  718.       ReadLn;
  719.       END;
  720.  
  721.    CPU := Processor (CPUType);
  722.    Weitek := (NDPType AND $80) <> 0;
  723.    NDPType := NDPType AND $7F;            { clear Weitek flag }
  724.    ProcessorType := CPU_Name [CPU];
  725.  
  726.    IF NOT (CPU >= i286) THEN
  727.       ExtendedMem := FALSE;
  728.  
  729.    CacheSize (Debug, CPU > i286, FirstLevel, SecondLevel, CacheThru, Cache2Thru, MemThru);
  730.  
  731.  
  732.    {-------------------------------------------------------------------------
  733.      determine speed
  734.    --------------------------------------------------------------------------}
  735.  
  736.    Frequency  := 200 * AAM_Time [CPU] * ClockFreq / AAMTime;
  737.    MoveTakte  := MoveBTime * Frequency / (ClockFreq * 5000);
  738.    MoveWTakte := MoveWTime * Frequency / (ClockFreq * 5000);
  739.    IF CPU >= i386 THEN BEGIN
  740.       MoveWTime := MoveDTime DIV 2;   { because twice the # of words were moved}
  741.       END;
  742.    IF Debug THEN BEGIN
  743.       WriteLn ('MoveWTime:    ', MoveWtime);
  744.       WriteLn ('MoveDTime:    ', MoveDTime);
  745.       WriteLn ('MoveTakte:    ', MoveTakte:0:2);
  746.       WriteLn ('MoveTimeCPU:  ', MoveTime [CPU]);
  747.       WriteLn ('LFaktor:      ', LFaktor [CPU]);
  748.       WriteLn ('Frequency:    ', Frequency);
  749.       END;
  750.    ThruPut    := ClockFreq * 10000 / MoveWTime;
  751.    IF CPU >= i386 THEN
  752.       DataWidth := 32
  753.    ELSE
  754.       DataWidth:= 16;
  755.    WaitStates := (((((DataWidth DIV 8) * Frequency / (MoveTime [CPU] * 1024)) / MemThru)
  756.                  * MoveTime [CPU] - MoveTime [CPU]) * 0.5);
  757.    Index      := LFaktor[CPU] * Frequency/4.7e6 * (MoveTime [CPU] / MoveTakte);
  758.    FillTakte  := ScreenFillTime * Frequency / (ClockFreq * 5000);
  759.    IF Debug THEN BEGIN
  760.       WriteLn ('ScreenFillTim:', ScreenFillTime);
  761.       WriteLn ('FillTakte:    ', FillTakte);
  762.       WriteLn ('Index:        ', Index);
  763.       WriteLn ('BIOSWriteTime:', BIOSWriteTime);
  764.       END;
  765.    ScreenWaits:= Trunc (FillTakte - FillTime [CPU] + 0.1);
  766.  
  767.    IF Debug THEN BEGIN
  768.       WriteLn ('Stat87:       ', NDPType);
  769.       WriteLn ('Speed87:      ', Speed87);
  770.       WriteLn ('Speed287:     ', Speed287);
  771.       WriteLn ('Freq287:      ', 1e-6 * 7690 * ClockFreq /Speed287 :0:2);
  772.       END;
  773.  
  774.  
  775.    IF ExpandedMem THEN BEGIN
  776.       IF CPU >= i386 THEN
  777.          EMS_Thruput := ClockFreq * 16000 / EMS_Time
  778.       ELSE
  779.          EMS_ThruPut := ClockFreq * 10000 / EMS_Time;
  780.       END;
  781.  
  782.  
  783.    IF ExtendedMem THEN
  784.       Ext_ThruPut := ClockFreq * 10000 / Ext_Time;
  785.  
  786.    CASE NDPType OF             { 40 * # of clock cycles for FSQRT }
  787.    {Pentium}28: Frequency87 := 1600 * ClockFreq / Speed287;  {~40 clocks }
  788.    {EMC87}  27: Frequency87 := 1470 * ClockFreq / Speed287;  { 36 clocks }
  789.    {83S87}  26: Frequency87 := 3040 * ClockFreq / Speed287;  { 76 clocks magazine}
  790.    {387+}   25: Frequency87 := 2880 * ClockFreq / Speed287;  { 76 clocks magazine}
  791.    {82S87}  24: Frequency87 := 3040 * ClockFreq / Speed287;  { 76 clocks magazine}
  792.    {82S87}  23: Frequency87 := 3040 * ClockFreq / Speed287;  { 72 clocks meas.}
  793.    {486}    22: Frequency87 := 3320 * ClockFreq / Speed287;  { 83 clocks meas. }
  794.    {RapidCAD}21:Frequency87 := 3320 * ClockFreq / Speed287;  { 83 clocks }
  795.    {387DX}  20: Frequency87 := 4480 * ClockFreq / Speed287;  { 112 clocks meas.}
  796.    {38700sx}19: Frequency87 := 2200 * ClockFreq / Speed287;  { 55 clocks }
  797.    {38700DX}18: Frequency87 := 2040 * ClockFreq / Speed287;  { 52 clocks }
  798.    {83C87sx}17: Frequency87 := 3640 * ClockFreq / Speed287;  { 91 clocks magazine}
  799.    {83C87}  16: Frequency87 := 3440 * ClockFreq / Speed287;  { 86 clocks meas.}
  800.    {83S87}  15: Frequency87 := 1880 * ClockFreq / Speed287;  { 47 clocks meas.}
  801.    {83D87}  14: Frequency87 := 1470 * ClockFreq / Speed287;  { 36 clocks meas.}
  802.    {82S87}  13: Frequency87 := 1880 * ClockFreq / Speed287;  { 47 clocks }
  803.    {82S87}  12: Frequency87 := 1880 * ClockFreq / Speed287;  { 47 clocks }
  804.    {3C87sx} 11: Frequency87 := 2280 * ClockFreq / Speed287;  { 57 clocks DataSheet }
  805.    {3C87}   10: Frequency87 := 2240 * ClockFreq / Speed287;  { 57 clocks meas.}
  806.    {2C87}  8,9: Frequency87 := (1970 * ClockFreq / Speed287) * (0.928 + Index/65.0);  { 49 Takte }
  807.    {387sx}   7: Frequency87 := 5160 * ClockFreq / Speed287;  { 129 clocks }
  808.    {387}     6: Frequency87 := 5120 * ClockFreq / Speed287;  { 128 clocks meas. }
  809.    {287XL}   5: Frequency87 := 5440 * ClockFreq / Speed287;  { 136 clocks}
  810.    {287}     4: Frequency87 := (7690 * ClockFreq / Speed287) * (0.928 + Index/65.0);  {183 clocks meas.}
  811.    {80C187}  3: Frequency87 := 5440 * ClockFreq / Speed87;   { 136 clocks }
  812.    {8087}    2: Frequency87 := 7440 * ClockFreq / Speed87;   { 186 clocks meas.}
  813.    END;
  814.  
  815.    (* Correction for faster execution of coprocessor instructions with 486DLC *)
  816.  
  817.    IF (CPU = c486dlc) THEN
  818.       Frequency87 := Frequency87 / 1.055;
  819.  
  820.    Regs.AH := $30;
  821.    Intr ($21, Regs);
  822.    Version := Regs.AL+Regs.AH / 100.0;
  823.  
  824.    {---------------------------------------------------------------------------
  825.      speed of screen output
  826.    ---------------------------------------------------------------------------}
  827.  
  828.    TestStr := '                                                $';
  829.    SegTest := Seg (TestStr);
  830.    OfsTest := Ofs (TestStr)+1;
  831.    Start := Clock;
  832.       inline ($b9/$14/$00/
  833.               $b4/$02/
  834.               $b7/$00/
  835.               $b6/$1a/
  836.               $b2/$01/
  837.               $cd/$10/
  838.               $b4/$09/
  839.               $8e/$1e/SegTest/
  840.               $8b/$16/OfsTest/
  841.               $cd/$21/
  842.               $e2/$e8);
  843.    DosWriteTime := Clock - Start;
  844.  
  845.    IF Debug THEN BEGIN
  846.       GotoXY (1,25);
  847.       WriteLn ('DOSWriteTime: ', DOSWriteTime);
  848.       REPEAT UNTIL KeyPressed;
  849.       Read (Ch);
  850.       END;
  851.  
  852.    BIOSSpeed  := 20 * ClockFreq / BiosWriteTime;
  853.    DOSSpeed   := 1e6 / DOSWriteTime;
  854.  
  855.  
  856.    Regs.AX := $0C0F;    { clear keyboard buffer }
  857.    Intr ($21, Regs);
  858.    TestStr := 'n$'#8#8#8#8#8#8#8'       ';
  859.    Regs.AH := 9;
  860.    Regs.DS := Seg (TestStr);
  861.    Regs.DX := Ofs (TestStr)+1;
  862.    Intr ($21, Regs);
  863.    Regs.AH := $B;
  864.    Intr ($21, Regs);
  865.    ANSIPresent := (Regs.AL = $FF);
  866.    Regs.AX := $0C0F;    { clear keyboard buffer }
  867.    Intr ($21, Regs);
  868.  
  869.    FreeMem (MoveBuffer, 20000);
  870.    Emu := (Test8087 = 0) OR (NDPType < 2);
  871.  
  872.  
  873.    {-------------------------------------------------------------------------
  874.      output page 1
  875.    --------------------------------------------------------------------------}
  876.  
  877.    ClrScr;
  878.    WriteLn    ('══ public domain version ═══ COMPTEST  2.59 ═══════════════════════ '+'Page 1 ═══');
  879.    WriteLn;
  880.    WriteLn    ('computer type: ':37, ComputerType);
  881.    WriteLn    ('CPU: ':37, ProcessorType);
  882.    WriteLn    ('clock frequency: ':37, Frequency/1e6:0:2, ' MHz');
  883.    WriteLn    ('bus width: ':37, BusWidth[CPU], ' bit');
  884.    Write      ('CPU-cache: ':37);
  885.    IF FirstLevel <> 0 THEN BEGIN
  886.       Write ('1. level: ', FirstLevel, ' KB');
  887.       IF SecondLevel = 0 THEN
  888.          WriteLn
  889.       ELSE
  890.          WriteLn (', 2. level: ', SecondLevel, ' KB')
  891.       END
  892.    ELSE
  893.       WriteLn ('NOT FOUND');
  894.    WriteLn;
  895.    IF FirstLevel <> 0 THEN BEGIN
  896.       Write    ('maximum RAM thruput (without cache): ':37, MemThru:0:0, ' KB/s');
  897.       WriteLn    (' (effective wait states: ', Waitstates:0:1, ')');
  898.       Write   ('CPU-cache thruput: ':37, '1. level: ', CacheThru:0:0, ' KB/s');
  899.       IF SecondLevel <> 0 THEN
  900.          WriteLn (', 2. level: ', Cache2Thru:0:0, ' KB/s');
  901.       END
  902.    ELSE BEGIN
  903.       Write    ('maximum RAM-thruput: ':37, MemThru:0:0, ' KB/s');
  904.       WriteLn  (' (effective wait-states: ', Waitstates:0:1, ')');
  905.       END;
  906.    WriteLn;
  907.    WriteLn    ('system memory: ':37, SystemMemory:0, ' KB');
  908.    WriteLn    ('available to DOS: ':37, DOS_Memory:0, ' KB');
  909.    WriteLn    ('permanently used by DOS and TSRs: ':37, UsedMemory:0, ' KB');
  910.    WriteLn;
  911.    Write      ('extended memory: ':37);
  912.    IF ExtendedMem THEN
  913.       WriteLn (ExtendedMemSize:0, ' KB (INT 15h thruput: ', Ext_Thruput/1024:0:0, ' KB/s)')
  914.    ELSE
  915.       WriteLn ('NOT FOUND');
  916.    Write      ('expanded memory: ':37);
  917.    IF ExpandedMem THEN
  918.       WriteLn (ExpandedMemSize:0, ' KB (EMS ', EMS_Version, ', thruput: ', EMS_ThruPut/1024:0:0, ' KB/s)')
  919.    ELSE
  920.       WriteLn ('NOT FOUND');
  921.    WriteLn;
  922.    Write      ('other RAM: ':37);
  923.    SearchExtraRAM (FALSE);
  924.    WriteLn;
  925.    Write      ('BIOS-extensions: ':37);
  926.    SearchROM (FALSE);
  927.    WriteLn;
  928.    WriteLn    ('════════════════════════════ COMPTEST  2.59 ═══════════ (c) 1988-1993 N.J. ═══');
  929.    Write      ('Press a key for page 2');
  930.  
  931.    Ch := ReadKey;
  932.    ClrScr;
  933.    WriteLn    ('══ public domain version ═══ COMPTEST  2.59 ═══════════════════════ Page 2 ═══');
  934.    WriteLn;
  935.    WriteLn    ('parallel ports: ':37, NrParallelPorts:1);
  936.    Write      ('serial ports: ':37, NrSerialPorts:1);
  937.    Dummy := 0;
  938.    IF NrSerialPorts <> 0 THEN BEGIN
  939.       Write (' (');
  940.       FOR L := 1 TO 4 DO BEGIN
  941.          IF SIOType [L] <> 0 THEN BEGIN
  942.             Inc (Dummy);
  943.             Write ('COM', L, ': ', SIOTypeStr [SIOType[L]]);
  944.             IF Dummy <> NrSerialPorts THEN
  945.                Write (', ');
  946.             END;
  947.       END;
  948.       WriteLn (')');
  949.       END;
  950.  
  951.    Write ('mathematical coprocessor: ':37);
  952.    IF NDPType > 0 THEN BEGIN
  953.       Write (CoProcessor [NDPType]);
  954.       IF NDPType > 1 THEN
  955.          Write (' (clock frequency:', Frequency87/1e6:0:2, ' MHz)')
  956.       END;
  957.    IF Weitek THEN BEGIN
  958.       IF NDPType > 1 THEN BEGIN
  959.          Writeln;
  960.          Write ('':37);
  961.          END;
  962.       IF CPU >= i486 THEN
  963.          Writeln ('Weitek 4167')
  964.       ELSE
  965.          Writeln ('Weitek 3167 or 1167');
  966.       END;
  967.    IF (NDPType = 0) AND (NOT Weitek) THEN
  968.       WriteLn (CoProcessor [NDPType])
  969.    ELSE IF (NOT Weitek) THEN
  970.       WriteLn;
  971.  
  972.    WriteLn    ('mouse: ':37, Installed [MousePresent]);
  973.    WriteLn    ('games adaptor: ':37, Installed [GamesAdaptor]);
  974.    Writeln;
  975.    WriteLn    ('DOS drives: ':37, DOS_Drives:0, DriveStr);
  976.    Write      ('floppy drives: ':37, NrOfFloppies:0);
  977.    WriteLn    (DiskTypeStr);
  978.    WriteLn    ('hard disks: ':37, NrOfHardDisks:0);
  979.    WriteLn;
  980.    Write      ('graphics card: ':37, CardName [GraphCard]);
  981.    IF GraphCard = EGA THEN
  982.       WriteLn (' w/', EGAMem:4, ' KB')
  983.    ELSE
  984.       WriteLn;
  985.    WriteLn    ('video-RAM wait states: ':37, ScreenWaits);
  986.    WriteLn    ('speed of video output via BIOS: ':37, BIOSSpeed:0:0, ' characters/sec');
  987.    Write      ('speed of video output via DOS: ':37, DOSSpeed:0:0, ' characters/sec (');
  988.    IF ANSIPresent THEN
  989.      Write  ('with')
  990.    ELSE
  991.      Write  ('without');
  992.    WriteLn  (' ANSI driver)');
  993.    WriteLn    ('DOS version: ':37, Version:3:2);
  994.    WriteLn;
  995.    Write      ('Dhrystones/second: ':37);
  996.    Dhrys := Dhrystones (Index);
  997.    Write     (Dhrys:0:1);
  998.    WriteLn   (' (CPU: ', Dhrys/3.6464E+2:0:1, '-fold of XT)');
  999.    Write      ('Double-Precision Kilowhetstones: ':37);
  1000.    Whets := Whetstone (Emu, Index);
  1001.    Write      (Whets:0:1);
  1002.    IF Emu THEN
  1003.       WriteLn (' (emulator: ', Whets/4.9169E+0:0:1, '-fold of XT)')
  1004.    ELSE
  1005.       WriteLn (' (FPU: ', Whets/9.9087E+1:0:1, '-fold of XT w/ 8087)');
  1006.    Write     ('Double-Precision MFLOPS: ':37);
  1007.    MegaFlops := MFlops (Emu, Index);
  1008.    Write     (MegaFlops:0:3);
  1009.    IF Emu THEN
  1010.       WriteLn (' (emulator: ', MegaFlops/6.5242E-4:0:1, '-fold of XT)')
  1011.    ELSE
  1012.       WriteLn (' (FPU: ', MegaFlops/1.2446E-2:0:1, '-fold of XT w/ 8087)');
  1013.    WriteLn;
  1014.    WriteLn    ('════════════════════════════ COMPTEST  2.59 ═══════════ (c) 1988-1993 N.J. ═══');
  1015.    IF (NOT Weitek) THEN
  1016.       WriteLn;
  1017.    END; {with}
  1018.  
  1019.    IF Debug THEN BEGIN
  1020.       WriteLn ('Dhry: ', Dhrys);
  1021.       WriteLn ('Whet: ', Whets);
  1022.       WriteLn ('MFlop:', MegaFlops);
  1023.       Ch := ReadKey;
  1024.       END;
  1025.  
  1026.    IF NrOfHardDisks <> 0 THEN BEGIN
  1027.       Write   ('Test hard disk(s) (Y/N) ? ');
  1028.       Ch := ReadKey;
  1029.       IF UpCase (Ch) <> 'Y' THEN
  1030.          NrOfHardDisks := 0;
  1031.       END;
  1032.  
  1033.    IF (NrOfHardDisks > 0) THEN BEGIN
  1034.  
  1035.      ClrScr;
  1036.      WriteLn    ('══ public domain version ═══ COMPTEST  2.59 ═══════════════════════ Page 3 ═══');
  1037.  
  1038.      FOR L := $80 TO $83 DO BEGIN
  1039.  
  1040.        IF Valid [L] THEN BEGIN
  1041.  
  1042.           WriteLn;
  1043.  
  1044.           Regs.AH := $08;
  1045.           Regs.DL := L;
  1046.           Intr ($13, Regs);
  1047.           Sectors [L]   := Regs.CL AND $3F;
  1048.           Cylinders [L] := Word (Regs.CL AND $C0) * 4 + Regs.CH + 1;
  1049.           Heads [L]     := Regs.DH + 1;
  1050.           CylSize [L]   := LongInt (Sectors [L]) * Heads [L] * 512;
  1051.  
  1052.           ReserveMem;
  1053.  
  1054.           BufOff := Ofs (BufPtr^);
  1055.           BufSeg := Seg (BufPtr^);
  1056.  
  1057.           Regs.CX := 1;
  1058.           Regs.DL := L;
  1059.           Regs.DH := 0;
  1060.           Regs.AX := $0201;
  1061.           Regs.ES := BufSeg;
  1062.           Regs.BX := BufOff;
  1063.           Intr ($13, Regs);
  1064.  
  1065.           DOSCylinders [L] := 0;
  1066.           Dummy := $1C5;
  1067.           WHILE (Dummy < $200) AND ((BufPtr^[$1FF] * 256 + BufPtr^[$200]) = $55AA) DO BEGIN
  1068.              IF ((BufPtr^[Dummy] AND $C0) * 4 + BufPtr^[Dummy+1] + 1) > DOSCylinders [L] THEN
  1069.                  DOSCylinders [L]:= (BufPtr^[Dummy] AND $C0) * 4 + BufPtr^[Dummy+1]+1;
  1070.              Inc (Dummy, $10);
  1071.           END;
  1072.  
  1073.           FreeMem (BufPtr, Word(CylSize [L]+16));
  1074.           FreeMem (DummyPtr, FillSize);
  1075.  
  1076.           IF DOSCylinders [L] > Cylinders [L] THEN
  1077.              Cylinders [L] := DOSCylinders [L];
  1078.           SPC         := Sectors [L] * Heads [L];
  1079.           CylSize [L] := LongInt (512) * SPC;
  1080.           Capacity [L]:= CylSize [L] * Cylinders [L];
  1081.  
  1082.           ReserveMem;
  1083.  
  1084.           Write   ('hard disk ', L-$7F:1);
  1085.           WriteLn ('cylinders: ':26, Cylinders[L]);
  1086.           WriteLn ('read/write heads: ':37, Heads[L]);
  1087.           WriteLn ('sectors per track: ':37, Sectors[L]);
  1088.           WriteLn ('storage capacity: ':37, Capacity[L],  ' Byte (',Capacity[L] / 1048576.0:0:2,' MB)');
  1089.           WriteLn;
  1090.  
  1091.   {-------------------------------------------------------------------------
  1092.      determine track-to-track time
  1093.    --------------------------------------------------------------------------}
  1094.  
  1095.           Write   ('track-to-track seek time: ':37);
  1096.           Start := Clock;
  1097.           FOR Track := 0 TO Cylinders[L]-1 DO BEGIN
  1098.              Inline ($8b/$16/L/            { mov dx, Drive&Head }
  1099.                      $a1/Track/            { mov ax, Track }
  1100.                      $88/$c5/              { mov ch, al }
  1101.                      $25/$00/$03/          { and ax, $300 }
  1102.                      $d1/$e8/              { shr ax, 1 }
  1103.                      $d1/$e8/              { shr ax, 1 }
  1104.                      $0d/$01/$00/          { or  ax, Sector }
  1105.                      $88/$c1/              { mov cl, al }
  1106.                      $b4/$0c/              { mov ah, SeekFunc }
  1107.                      $cd/$13);             { int BIOS-DiskIO }
  1108.           END;
  1109.           TrackToTrack [L] := Int (((Clock-Start) / Cylinders[L]) * 10 + 0.5) / 10;
  1110.           WriteLn (TrackToTrack [L]:6:2, ' ms');
  1111.  
  1112.   {-------------------------------------------------------------------------
  1113.      determine average acces time
  1114.    --------------------------------------------------------------------------}
  1115.  
  1116.           Write   ('average seek time: ':37);
  1117.           Dummy := 2 * Cylinders [L] DIV 3;
  1118.           Start := Clock;
  1119.           FOR Track := 1 TO 40 DO BEGIN
  1120.              Inline ($8b/$16/L/            { mov dx, Drive&Head }
  1121.                      $a1/Dummy/            { mov ax, Track }
  1122.                      $88/$c5/              { mov ch, al }
  1123.                      $25/$00/$03/          { and ax, $300 }
  1124.                      $d1/$e8/              { shr ax, 1 }
  1125.                      $d1/$e8/              { shr ax, 1 }
  1126.                      $0d/$01/$00/          { or  ax, Sector }
  1127.                      $88/$c1/              { mov cl, al }
  1128.                      $b4/$0c/              { mov ah, SeekFunc }
  1129.                      $cd/$13);             { int BIOS-DiskIO }
  1130.              Dummy := Cylinders [L] - Dummy;
  1131.           END;
  1132.           AverageAccess [L] := Int ((Clock - Start) * 0.25 + 0.5) / 10;
  1133.           WriteLn (AverageAccess [L]:6:2, ' ms');
  1134.  
  1135.    {-------------------------------------------------------------------------
  1136.      maximum access time
  1137.    --------------------------------------------------------------------------}
  1138.  
  1139.           Write   ('maximum seek time: ':37);
  1140.           Dummy := 0;
  1141.           Start := Clock;
  1142.           FOR Track := 1 TO 25 DO BEGIN
  1143.              Inline ($8b/$16/L/            { mov dx, Drive&Head }
  1144.                      $a1/Dummy/            { mov ax, Track }
  1145.                      $88/$c5/              { mov ch, al }
  1146.                      $25/$00/$03/          { and ax, $300 }
  1147.                      $d1/$e8/              { shr ax, 1 }
  1148.                      $d1/$e8/              { shr ax, 1 }
  1149.                      $0d/$01/$00/          { or  ax, Sector }
  1150.                      $88/$c1/              { mov cl, al }
  1151.                      $b4/$0c/              { mov ah, SeekFunc }
  1152.                      $cd/$13);             { int BIOS-DiskIO }
  1153.              Dummy := (Cylinders[L]-1) - Dummy;
  1154.           END;
  1155.           MaximumAccess [L]:= Int ((Clock-Start) * 0.04 + 0.5);
  1156.           WriteLn (MaximumAccess[L]:6:2, ' ms');
  1157.  
  1158.  
  1159.    {-------------------------------------------------------------------------
  1160.      determine maximum thruput
  1161.    --------------------------------------------------------------------------}
  1162.  
  1163.          IF Debug THEN BEGIN
  1164.             WriteLn ('SPC: ', SPC);
  1165.             WriteLn ('BufSeg: ', Hex(BufSeg));
  1166.             WriteLn ('BufOff: ', Hex(BufOff));
  1167.             ReadLn;
  1168.             END;
  1169.  
  1170.           Write   ('maximum thruput: ':37);
  1171.           Delay (200);
  1172.           Dummy := 0;
  1173.           Start := Clock;
  1174.           FOR Track := 1 TO 15 DO BEGIN
  1175.              Inline ($8b/$16/L/            { mov dx, Drive&Head }
  1176.                      $a1/Dummy/            { mov ax, 0 }
  1177.                      $88/$c5/              { mov ch, al }
  1178.                      $25/$00/$03/          { and ax, $300 }
  1179.                      $d1/$e8/              { shr ax, 1 }
  1180.                      $d1/$e8/              { shr ax, 1 }
  1181.                      $0d/$01/$00/          { or  ax, Sector }
  1182.                      $88/$c1/              { mov cl, al }
  1183.                      $8b/$1e/BufOff/       { mov bx, BufOff }
  1184.                      $8e/$06/BufSeg/       { mov es, BufSeg }
  1185.                      $a1/SPC/              { mov ax, SectorPerTrack }
  1186.                      $b4/$02/              { mov ah, ReadFunc }
  1187.                      $cd/$13);             { int BIOS-DiskIO }
  1188.           END;
  1189.           DiskThruPut [L] := 15000 * (CylSize [L] DIV 1024) / (Clock-Start);
  1190.           Delay (200);
  1191.           Dummy := Cylinders [L] - 1;
  1192.           Head1 := Heads [L] - ((SPC + Sectors[L] - 1) DIV Sectors [L]);
  1193.           ErrByte := 0;
  1194.           FOR Track := 1 TO 16 DO BEGIN
  1195.              IF Track = 2 THEN
  1196.                 Start := Clock;
  1197.              Inline ($8b/$16/L/            { mov dx, Drive }
  1198.                      $8a/$36/Head1/        { mov dh, Head }
  1199.                      $a1/Dummy/            { mov ax, Track}
  1200.                      $88/$c5/              { mov ch, al }
  1201.                      $25/$00/$03/          { and ax, $300 }
  1202.                      $d1/$e8/              { shr ax, 1 }
  1203.                      $d1/$e8/              { shr ax, 1 }
  1204.                      $0d/$01/$00/          { or  ax, Sector }
  1205.                      $88/$c1/              { mov cl, al }
  1206.                      $8b/$1e/BufOff/       { mov bx, BufOff }
  1207.                      $8e/$06/BufSeg/       { mov es, BufSeg }
  1208.                      $a1/SPC/              { mov ax, SectorPerTrack }
  1209.                      $b4/$02/              { mov ah, ReadFunc }
  1210.                      $cd/$13/              { int BIOS-DiskIO }
  1211.                      $08/$26/ErrByte);     { or ErrByte, ah }
  1212.           END;
  1213.           Durchsatz := 15000 * (CylSize [L] DIV 1024) / (Clock-Start);
  1214.  
  1215.  
  1216.           IF Debug THEN BEGIN
  1217.              WriteLn;
  1218.              WriteLn ('thruput track 0: ', DiskThruput[L]);
  1219.              WriteLn ('thruput track ', Cylinders [L], ': ', Durchsatz);
  1220.              END;
  1221.  
  1222.           IF (ErrByte = 0)  AND (Durchsatz > DiskThruPut [L]) THEN
  1223.              DiskThruPut [L] := Durchsatz;
  1224.           Write   (DiskThruPut [L]:3:0, ' KB/sec');
  1225.  
  1226.  
  1227.    {--------------------------------------------------------------------------
  1228.      test if disk cache active
  1229.    --------------------------------------------------------------------------}
  1230.  
  1231.           Dummy := 2 * Cylinders [L] DIV 3;
  1232.           SPC := 16;
  1233.           FOR Track := 1 TO 10 DO BEGIN
  1234.              IF Track = 8 THEN
  1235.                 Start := Clock;
  1236.              Inline ($8b/$16/L/            { mov dx, Drive&Head }
  1237.                      $a1/Dummy/            { mov ax, Track }
  1238.                      $88/$c5/              { mov ch, al }
  1239.                      $25/$00/$03/          { and ax, $300 }
  1240.                      $d1/$e8/              { shr ax, 1 }
  1241.                      $d1/$e8/              { shr ax, 1 }
  1242.                      $0d/$01/$00/          { or  ax, Sector }
  1243.                      $88/$c1/              { mov cl, al }
  1244.                      $8b/$1e/BufOff/       { mov bx, BufOff }
  1245.                      $8e/$06/BufSeg/       { mov es, BufSeg }
  1246.                      $a1/SPC/              { mov ax, NrOfSectors }
  1247.                      $b4/$02/              { mov ah, ReadFunc }
  1248.                      $cd/$13);             { int BIOS-DiskIO }
  1249.              Dummy := Cylinders [L] - Dummy;
  1250.           END;
  1251.  
  1252.           CacheTstTime := Clock - Start;
  1253.  
  1254.           IF Debug THEN BEGIN
  1255.              WriteLn;
  1256.              WriteLn ('Cachetest: ', CacheTstTime);
  1257.              ReadLn;
  1258.              END;
  1259.  
  1260.           IF CPU < i286 THEN
  1261.              CacheOn [L] := CacheTstTime < 75 { 3 seeks, 24 KB read < 75 ms }
  1262.           ELSE
  1263.              CacheOn [L] := CacheTstTime < 50;{ 3 seeks, 24 KB read < 50 ms }
  1264.           IF CacheOn [L] THEN
  1265.              WriteLn (' (using disk cache)')
  1266.           ELSE
  1267.              WriteLn;
  1268.  
  1269.           FreeMem (BufPtr, Word(CylSize [L])+16);
  1270.           FreeMem (DummyPtr, FillSize);
  1271.           WriteLn;
  1272.        END;
  1273.  
  1274.        END;
  1275.        IF NrOfHardDisks = 1 THEN
  1276.           WriteLn (#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10);
  1277.        WriteLn    ('════════════════════════════ COMPTEST  2.59 ═══════════ (c) 1988-1993 N.J. ═══');
  1278.     END;
  1279.  
  1280.  
  1281.     IF (ParamCount > 0) AND (NOT Debug) OR (ParamCount > 1) AND Debug THEN BEGIN
  1282.       Assign  (Fil, ParamStr(1));
  1283.       Rewrite (Fil);
  1284.       WriteLn (Fil, '══ public domain version ═══ COMPTEST  2.59 ═══════════════════════ Page 1 ═══');
  1285.       WriteLn (Fil);
  1286.       WriteLn (Fil, 'computer type: ':37, ComputerType);
  1287.       WriteLn (Fil, 'CPU: ':37, ProcessorType);
  1288.       WriteLn (Fil, 'clock frequency: ':37, Frequency/1e6:0:2, ' Mhz');
  1289.       WriteLn (Fil, 'bus width: ':37, BusWidth[CPU], ' bit');
  1290.       Write   (Fil, 'CPU-cache: ':37);
  1291.       IF FirstLevel <> 0 THEN BEGIN
  1292.          Write (Fil, '1. level: ', FirstLevel, ' KB');
  1293.          IF SecondLevel = 0 THEN
  1294.             WriteLn (Fil)
  1295.          ELSE
  1296.             WriteLn (Fil, ', 2. level: ', SecondLevel, ' KB')
  1297.          END
  1298.       ELSE
  1299.          WriteLn (Fil, 'NOT FOUND');
  1300.       WriteLn (Fil);
  1301.       IF FirstLevel <> 0 THEN BEGIN
  1302.          Write    (Fil,'maximum RAM thruput (without cache): ':37, MemThru:0:0, ' KB/s');
  1303.          WriteLn  (Fil,' (effective wait states: ', Waitstates:0:1, ')');
  1304.          Write    (Fil,'CPU cache thruput: ':37, '1. level: ', CacheThru:0:0, ' KB/s');
  1305.          IF SecondLevel <> 0 THEN
  1306.             WriteLn (Fil,', 2. level: ', Cache2Thru:0:0, ' KB/s');
  1307.          END
  1308.       ELSE BEGIN
  1309.          Write    (Fil, 'maximum RAM thruput: ':37, MemThru:0:0, ' KB/s');
  1310.          WriteLn  (Fil, ' (effective wait states: ', Waitstates:0:1, ')');
  1311.       END;
  1312.       WriteLn (Fil);
  1313.       WriteLn (Fil, 'system memory: ':37, SystemMemory:0, ' KB');
  1314.       WriteLn (Fil, 'available for DOS: ':37, DOS_Memory:0, ' KB');
  1315.       WriteLn (Fil, 'permanently used by DOS and TSRs: ':37, UsedMemory:0, ' KB');
  1316.  
  1317.       WriteLn (Fil);
  1318.       Write   (Fil, 'extended memory: ':37);
  1319.       IF ExtendedMem THEN
  1320.          WriteLn (Fil, ExtendedMemSize:0, ' KB (INT 15h thruput: ', Ext_Thruput/1024:0:0, ' KB/s)')
  1321.       ELSE
  1322.          WriteLn (Fil, 'NOT FOUND');
  1323.       Write      (Fil, 'expanded memory: ':37);
  1324.       IF ExpandedMem THEN
  1325.          WriteLn (Fil, ExpandedMemSize:0, ' KB (EMS ', EMS_Version, ', thruput: ', EMS_ThruPut/1024:0:0, ' KB/s)')
  1326.       ELSE
  1327.          WriteLn (Fil, 'NOT FOUND');
  1328.       WriteLn (Fil);
  1329.       Write   (Fil, 'other RAM: ':37);
  1330.       SearchExtraRAM (TRUE);
  1331.       WriteLn (Fil);
  1332.       Write   (Fil, 'BIOS-extensions: ':37);
  1333.       SearchROM (TRUE);
  1334.       WriteLn (Fil);
  1335.       WriteLn (Fil, '════════════════════════════ COMPTEST  2.59 ═══════════ (c) 1988-1993 N.J. ═══');
  1336.       WriteLn (Fil);
  1337.       WriteLn (Fil, '══ public domain version ═══ COMPTEST  2.59 ═══════════════════════ Page 2 ═══');
  1338.       WriteLn (Fil);
  1339.       WriteLn (Fil, 'parallel ports: ':37, NrParallelPorts:1);
  1340.       Write   (Fil, 'serial ports: ':37, NrSerialPorts:1);
  1341.       Dummy := 0;
  1342.       IF NrSerialPorts <> 0 THEN BEGIN
  1343.          Write (Fil, ' (');
  1344.          FOR L := 1 TO 4 DO BEGIN
  1345.             IF SIOType [L] <> 0 THEN BEGIN
  1346.                Inc (Dummy);
  1347.                Write (Fil, 'COM', L, ': ', SIOTypeStr [SIOType[L]]);
  1348.                IF Dummy <> NrSerialPorts THEN
  1349.                   Write (Fil, ', ');
  1350.                END;
  1351.          END;
  1352.          WriteLn (Fil, ')');
  1353.          END;
  1354.  
  1355.    Write (Fil, 'mathematical coprocessor: ':37);
  1356.    IF Result.NDPType > 0 THEN BEGIN
  1357.       Write (Fil, CoProcessor [Result.NDPType]);
  1358.       IF Result.NDPType > 1 THEN
  1359.          Write (Fil, ' (clock frequency:', Frequency87/1e6:0:2, ' MHz)')
  1360.       END;
  1361.    IF Weitek THEN BEGIN
  1362.       IF Result.NDPType > 1 THEN BEGIN
  1363.          Writeln (Fil);
  1364.          Write (Fil, '':37);
  1365.          END;
  1366.       IF CPU >= i486 THEN
  1367.          Writeln (Fil, 'Weitek 4167')
  1368.       ELSE
  1369.          Writeln (Fil, 'Weitek 3167 or 1167');
  1370.       END;
  1371.    IF (Result.NDPType = 0) AND (NOT Weitek) THEN
  1372.       WriteLn (Fil, CoProcessor [Result.NDPType])
  1373.    ELSE IF (NOT Weitek) THEN
  1374.       WriteLn (Fil);
  1375.  
  1376.       WriteLn  (Fil, 'mouse: ':37, Installed [MousePresent]);
  1377.       WriteLn  (Fil, 'games adaptor: ':37, Installed [GamesAdaptor]);
  1378.       WriteLn  (Fil);
  1379.       WriteLn  (Fil, 'DOS drives: ':37, DOS_Drives:0, DriveStr);
  1380.       Write    (Fil, 'floppy drives: ':37, NrOfFloppies:0);
  1381.       WriteLn  (Fil, DiskTypeStr);
  1382.       WriteLn  (Fil, 'hard disks: ':37, NrOfHardDisks:0);
  1383.       WriteLn  (Fil);
  1384.       Write    (Fil, 'graphics card: ':37, CardName [GraphCard]);
  1385.       IF GraphCard = EGA THEN
  1386.          WriteLn (Fil, ' w/', EGAMem:4, ' KB')
  1387.       ELSE
  1388.          WriteLn (Fil);
  1389.       WriteLn  (Fil, 'video-RAM wait states: ':37, ScreenWaits);
  1390.       WriteLn  (Fil, 'speed of video output via BIOS: ':37, BIOSSpeed:0:0, ' characters/sec');
  1391.       Write    (Fil, 'speed of video output via DOS: ':37, DOSSpeed:0:0, ' characters/sec (');
  1392.       IF ANSIPresent THEN
  1393.          Write  (Fil, 'with')
  1394.       ELSE
  1395.          Write  (Fil, 'without');
  1396.       WriteLn   (Fil, ' ANSI driver)');
  1397.       WriteLn   (Fil, 'DOS version: ':37, Version:3:2);
  1398.       WriteLn   (Fil);
  1399.       Write     (Fil, 'Dhrystones/second: ':37);
  1400.       Write     (Fil, Dhrys:0:1);
  1401.       WriteLn   (Fil, ' (CPU: ', Dhrys/3.6464E+2:0:1, '-fold of XT)');
  1402.       Write     (Fil, 'Double-Precision Kilowhetstones: ':37);
  1403.       Write     (Fil, Whets:0:1);
  1404.       IF Emu THEN
  1405.          WriteLn (Fil, ' (emulator: ', Whets/4.9169E+0:0:1, '-fold of XT)')
  1406.       ELSE
  1407.          WriteLn (Fil, ' (FPU: ', Whets/9.7087E+1:0:1, '-fold of XT w/ 8087)');
  1408.       Write     (Fil, 'Double-Precision MFLOPS: ':37);
  1409.       Write     (Fil, MegaFlops:0:3);
  1410.       IF Emu THEN
  1411.          WriteLn (Fil, ' (emulator: ', MegaFlops/6.5242E-4:0:1, '-fold of XT)')
  1412.       ELSE
  1413.          WriteLn (Fil, ' (FPU: ', MegaFlops/1.2446E-2:0:1, '-fold of XT w/ 8087)');
  1414.       WriteLn   (Fil);
  1415.       WriteLn   (Fil, '════════════════════════════ COMPTEST  2.59 ═══════════ (c) 1988-1993 N.J. ═══');
  1416.       WriteLn   (Fil);
  1417.       IF NrOfHardDisks = 0 THEN
  1418.          Close (Fil)
  1419.       ELSE BEGIN
  1420.          WriteLn   (Fil, '══ public domain version ═══ COMPTEST  2.59 ═══════════════════════ Page 3 ═══');
  1421.          WriteLn   (Fil);
  1422.  
  1423.          FOR L := $80 TO $7F+NrOfHardDisks DO BEGIN
  1424.  
  1425.            Write   (Fil, 'hard disk ', L-$7F:1);
  1426.            WriteLn (Fil, 'cylinders: ':26, Cylinders[L]);
  1427.            WriteLn (Fil, 'read/write heads: ':37, Heads[L]);
  1428.            WriteLn (Fil, 'sectors per track: ':37, Sectors[L]);
  1429.            WriteLn (Fil, 'storage capacity: ':37, Capacity[L],  ' Byte (',Capacity[L] / 1048576.0:0:2,' MB)');
  1430.            WriteLn (Fil);
  1431.            WriteLn (Fil, 'track-to-track seek time: ':37, TrackToTrack [L]:6:2, ' ms');
  1432.            WriteLn (Fil, 'average seek time: ':37, AverageAccess [L]:6:2, ' ms');
  1433.            WriteLn (Fil, 'maximum seek time: ':37, MaximumAccess[L]:6:2, ' ms');
  1434.            Write   (Fil, 'maximum thruput: ':37, DiskThruPut [L]:3:0, ' KB/sec');
  1435.            IF CacheOn [L] THEN
  1436.               WriteLn (Fil, ' (using disk cache)')
  1437.            ELSE
  1438.               WriteLn (Fil);
  1439.            WriteLn (Fil);
  1440.            WriteLn (Fil);
  1441.  
  1442.         END;
  1443.  
  1444.         WriteLn (Fil, '════════════════════════════ COMPTEST  2.59 ═══════════ (c) 1988-1993 N.J. ═══');
  1445.         END;
  1446.       Close (Fil);
  1447.       END;
  1448.       IF IOResult <> 0 THEN
  1449.          BEGIN END;
  1450.       Write   ('COMPTEST terminated - press any key');
  1451.       Ch := ReadKey;
  1452.  
  1453. END.
  1454.