Category : System Diagnostics for your computer
Archive   : CTEST259.ZIP
Filename : COMPTEST.PAS

 
Output of file : COMPTEST.PAS contained in archive : CTEST259.ZIP
PROGRAM CompTest; { Copyright (c) 1988-1993 Norbert Juffa }

{$A+,B-,D-,E+,F-,G-,I-,L-,N+,O-,R-,S-,V-,X-}
{$M 4096,0,655360}

USES DOS, Crt, Time, Whet, Dhry, LLL, Caches;

CONST
MaxBufSize= 65500;
ClockFreq = 1.193182e6;


TYPE
LongWord = ARRAY [1..2] OF WORD;
IOPuffer = ARRAY [1..MaxBufSize] OF BYTE;
PufferZgr = ^IOPuffer;
Processor = (NA, i88, i86, V20, V30, i188, i186, i286, i386, i386sx, ct386,
ct386sx, c486dlc, c486slc, rapidcad, i486, i486sx, Pentium);
CardType = (MDA, CGA, Herkules, EGA, MCGA, VGA, PGA);
ResultRec = RECORD
CPUType: BYTE;
NDPType: BYTE;
AAMTime: INTEGER;
Dummy1: INTEGER;
MoveWTime,
BIOSWriteTime, MoveBTime, EMS_Time, Ext_Time, ScreenFillTime,
Dummy2, Speed87, Speed287, MoveDTime: INTEGER;
END;



CONST
SIOBase: ARRAY [1..4] OF WORD =
($3F8, $2F8, $3E8, $2E8);
SIOTypeStr: ARRAY [1..5] OF STRING [7] =
('8250', '16450', '16550', '16550A', 'unknown');
BusWidth: ARRAY [i88 .. pentium] OF BYTE =
(8, 16, 8, 16, 8, 16, 16, 32, 16, 32, 16,
32, 16, 32, 32, 32, 32);
AAM_Time: ARRAY [i88 .. pentium] OF INTEGER =
(77, 77, 15, 15, 19, 19, 16, 17, 17, 16, 16,
17, 17, 15, 15, 15, 18);
FillTime: ARRAY [i88 .. pentium] OF INTEGER =
(10, 10, 4, 4, 9, 9, 3, 5, 5, 5, 5,
4, 4, 4, 4, 4, 1);
MoveTime: ARRAY [i88 .. pentium] OF INTEGER =
(25, 17, 8, 16, 8, 16, 4, 4, 8, 4, 8,
4, 4, 5, 3, 3, 1);
LFaktor: ARRAY [i88 .. pentium] OF REAL =
(1, 1.45, 1.15, 1.78, 1.15, 1.78, 3.3, 4.1, 3.4,
4.5, 3.7, 5.0, 6.0, 6.5, 8.5, 8.5, 17);
CPU_Name: ARRAY [i88 .. pentium] OF STRING [15] =
('Intel 8088', 'Intel 8086', 'NEC V20', 'NEC V30',
'Intel 80188', 'Intel 80186', 'Intel 80286',
'Intel 80386', 'Intel 80386SX', 'C&T 38600DX',
'C&T 38600SX', 'Cyrix 486DLC', 'Cyrix 486SLC',
'Intel RapidCAD', 'Intel 80486',
'Intel 80486SX', 'Intel Pentium');
CoProcessor: ARRAY [0 .. 28] OF STRING [19] =
('NOT INSTALLED', 'Emulation via INT 7', 'Intel 8087',
'Intel 80C187', 'Intel 80287', 'Intel 80287XL', 'Intel 80387',
'Intel 80387sx', 'IIT 2C87', 'IIT 2C87', 'IIT 3C87',
'IIT 3C87sx', 'Cyrix 82S87 (old)', 'Cyrix 82S87 (old)',
'Cyrix 83D87', 'Cyrix 83S87 (old)', 'ULSI 83C87', 'ULSI 83S87',
'C&T 38700DX', 'C&T 38700SX', 'Intel 80387DX', 'Intel RapidCAD',
'Intel 486', 'Cyrix 82S87 (new)', 'Cyrix 82S87 (new)',
'Cyrix 387+', 'Cyrix 83S87 (new)', 'Cyrix EMC87',
'Intel Pentium');
Installed: ARRAY [FALSE..TRUE] OF STRING [13] =
('NOT INSTALLED', 'INSTALLED');
Computer: ARRAY [$F5..$FF] OF STRING [14] =
('PS/2 Model 60', 'PS/2 Model 50', 'XT-286', 'PS/2 Model 80',
'Laptop', 'PS/2 Model 30', 'XT', 'AT', 'PCjr', 'XT / Portable',
'PC');
CardMemBegin:ARRAY [MDA .. PGA] OF WORD =
($B000, $B800, $B000, $A000, $A000, $A000, $A000);
CardName: ARRAY [MDA .. PGA] OF STRING [37] =
('Monochrome Display Adapter (MDA)',
'Color Graphics Adapter (CGA)',
'Hercules Graphics Card (HGC)',
'Enhanced Graphics Adapter (EGA)',
'Multi Color Graphics Array (MCGA)',
'Video Graphics Array (VGA)',
'Professional Graphics Adapter (PGA)');


VAR
SIOType: ARRAY [1..4] OF BYTE;

SIOCtrl, SIOStat, SerOut, DataWidth, SaveByte,
ConfigStatHi, ConfigStatLo, DOS_Drives,
NrOfHardDisks, NrOfFloppies, EGAInfo, DriveByte,
ErrByte, NrHD, NrDD, Nr3DD, Nr3HD, Drive1,
Drive2, Typ, Head1, K: BYTE;

MemExists, GamesAdaptor, MousePresent,
ExtendedMem, ExpandedMem, MonoChromMode,
Disktest, OldMemExists, ExtraRAMFound, EGAPres,
VGAPres, ANSIPresent, Debug, Emu, Weitek,
PortExists: BOOLEAN;

Ch: CHAR;

ScreenWaits, Segment, OldSegment, NrParallelPorts,
NrSerialPorts, DefaultDr, ExtendedMemSize,
ExpandedMemSize, SystemMemory, L, DOS_Memory,
EGAMem, UsedMemory, BufSeg, BufOff, Head,
Dummy, Track, RAMBeg, ROMSize, EMS_Base,
FillSize, FirstLevel, SecondLevel, SPC,
SegTest, OfsTest, ChkSum: WORD;

Start, DOSWriteTime, BIOSWriteTime, SavedTime,
CacheTstTime, HeapPointer: LONGINT;

MoveTakte, MoveWTakte, FillTakte, Frequency,
Waitstates, Cache2Thru, Frequency87, Durchsatz,
EMS_Thruput, Ext_Thruput, DOSSpeed, CacheThru,
MemThru, BIOSSpeed, Index, Version, ThruPut: REAL;

MegaFlops, Dhrys, Whets: DOUBLE;
Fil: TEXT;
EMS_Version: STRING [3];
ComputerType, ScreenType: STRING [35];
ProcessorType: STRING [15];
DiskTypeStr, DriveStr: STRING [45];
TestStr: STRING [86];
ScreenAddr: POINTER;
CPU: Processor;
GraphCard: CardType;
Regs: Registers;
Result: ResultRec;
DummyPtr, BufPtr: PufferZgr;
MoveBuffer: POINTER;
Heads, Sectors, DOSCylinders, Tracks, Cylinders: ARRAY [$80..$83] OF WORD;
Capacity, CylSize: ARRAY [$80..$83] OF LONGINT;
Valid: ARRAY [$80..$83] OF BOOLEAN;
MaximumAccess, AverageAccess, TrackToTrack,
DiskThruPut: ARRAY [$80..$83] OF REAL;
CacheOn: ARRAY [$80..$83] OF BOOLEAN;
InfoBuf: ARRAY [0..64] OF BYTE;



{$L CCNEW.OBJ}

PROCEDURE SpeedTest (Debg, Ext_Flag, EMS_Flag: WORD;
EPtr, Bptr, Sptr: POINTER;
VAR Results: ResultRec); NEAR; EXTERNAL;



FUNCTION EMM_Installed: BOOLEAN;

VAR
EMM_Name: String[8];
Regs : Registers;

BEGIN
EMM_Name := ' ';
Regs.AH := $35;
Regs.AL := $67;
Intr ($21, Regs);
Move (Mem [Regs.ES:$0A], EMM_Name[1], 8);
EMM_Installed := (EMM_Name = 'EMMXXXX0');
END;



FUNCTION EMS_Memory: INTEGER;
VAR Regs: Registers;
BEGIN
Regs.AH := $42;
Intr ($67, Regs);
EMS_Memory := Regs.DX * 16;
END;


FUNCTION GetEMSVersion: STRING;
VAR Regs: Registers;
BEGIN
Regs.AH := $46;
Intr ($67, Regs);
GetEMSVersion := Char (Regs.AL SHR 4 + 48) + '.' + Char(Regs.AL AND $F +48); { dito fr Neben-Versionsnummer }
END;



FUNCTION CheckMouse: BOOLEAN;
VAR Regs: Registers;
BEGIN
Regs.AX := 5; { get button press information (destroys AX) }
Regs.BX := 0; { left button }
Intr ($33, Regs);
CheckMouse := (Regs.AX <> 5);
END;



FUNCTION GetEMSBase: WORD;
VAR Regs: Registers;
BEGIN
Regs.AH := $41;
Intr ($67, Regs);
GetEMSBase := Regs.BX;
END;



{$F+}
FUNCTION HeapFunc (Size: WORD): INTEGER;
{$F-}
BEGIN
HeapFunc := 1;
END;



FUNCTION HercPresent: BOOLEAN;
BEGIN
Inline($BB/$00/$01/$BA/$BA/$03/$EC/$88/$C4/$80/$E4/$80/$B9/$40/$00/$EC/
$24/$80/$38/$E0/$E1/$F9/$75/$05/$4B/$75/$F1/$EB/$33/$B8/$00/$B0/
$8E/$C0/$E8/$11/$00/$75/$0B/$B0/$01/$BA/$BF/$03/$EE/$E8/$06/$00/
$74/$1E/$B0/$01/$EB/$1C/$26/$8A/$1E/$FF/$7F/$26/$8A/$0E/$FF/$3F/
$26/$FE/$06/$FF/$3F/$26/$3A/$1E/$FF/$3F/$26/$88/$0E/$FF/$3F/$C3/
$30/$C0/$88/$46/$FF/$08/$C0);
END;


FUNCTION Hex (X: WORD): STRING;
VAR H: ARRAY [0..15] OF CHAR;
BEGIN
H := '0123456789ABCDEF';
Hex := H [X SHR 12] + H [(X AND $0F00) SHR 8] +
H [(X AND $00F0) SHR 4] + H [(X AND $000F)];
END;



PROCEDURE SearchExtraRAM (FileWrite: BOOLEAN);
BEGIN
ExtraRAMFound := FALSE;
IF SystemMemory * 64 < CardMemBegin [GraphCard] THEN
Segment := SystemMemory * 64
ELSE
Segment := $C000;
MemExists := FALSE;
WHILE Segment < $FC00 DO BEGIN
Inline ($54/$58/$3B/$C4/$74/$0C/$B0/$00/$E6/$A0/
$E4/$61/$0C/$30/$E6/$61/$EB/$0E/$E4/$70/
$0C/$80/$E6/$70/$E4/$71/$E4/$61/$0C/$0C/
$E6/$61/$FA);
OldMemExists := MemExists;
SaveByte := Mem [Segment:0];
Mem [Segment:0] := $55;
Dummy := Mem [Segment:0];
MemExists := (Dummy = $55);
Mem [Segment:0] := $AA;
Dummy := Mem [Segment:0];
MemExists := MemExists AND (Dummy = $AA);
Mem [Segment:0] := SaveByte;
Inline ($54/$58/$3B/$C4/$74/$0C/$E4/$61/$34/$30/
$E6/$61/$B0/$80/$E6/$A0/$EB/$0E/$E4/$61/
$34/$0C/$E6/$61/$E4/$70/$24/$7F/$E6/$70/
$E4/$71/$FB);
IF Segment = EMS_Base THEN
MemExists := FALSE;
IF Segment = CardMemBegin [GraphCard] THEN
MemExists := FALSE;
IF MemExists AND (NOT OldMemExists) THEN BEGIN
ExtraRAMFound := TRUE;
RAMBeg := Segment;
END;
IF (NOT MemExists) AND OldMemExists THEN BEGIN
IF FileWrite THEN
Write (Fil, Hex (RAMBeg)+'0', '-', Hex (Segment-1)+'F (',
(Segment-RAMBeg) DIV 64:3 , ' KB)', #13#10, ' ':37)
ELSE
Write (Hex (RAMBeg)+'0', '-', Hex (Segment-1)+'F (',
(Segment-RAMBeg) DIV 64:3 , ' KB)', #13#10, ' ':37);
END;
IF Segment = CardMemBegin [GraphCard] THEN
Segment := $BFF0;
IF Segment = EMS_Base THEN BEGIN
IF FileWrite THEN
Write (Fil, Hex (EMS_Base)+'0', '-', Hex (EMS_Base+$0FFF)+'F ( 64 KB)',
' EMS-frame', #13#10, ' ':37)
ELSE
Write (Hex (EMS_Base)+'0', '-', Hex (EMS_Base+$0FFF)+'F ( 64 KB)',
' EMS-frame', #13#10, ' ':37);
Inc (Segment, $1000);
END
ELSE
Inc (Segment, $10);
END;
IF (NOT ExtraRAMFound) AND ((NOT ExpandedMem) OR (EMS_BASE > $F000)) THEN
IF FileWrite THEN
WriteLn (Fil, 'NOT FOUND')
ELSE
WriteLn ('NOT FOUND');
END;


PROCEDURE SearchROM (FileWrite: BOOLEAN);
VAR Vector_41: POINTER;
Vector_57: POINTER;
BEGIN
GetIntVec ($41, Vector_41);
GetIntVec ($57, Vector_57);
ExtraRAMFound := FALSE;
Segment := $C000;
OldSegment := 0;
WHILE (Segment < $F000) AND (OldSegment < Segment) DO BEGIN
OldSegment := Segment;
IF MemW [Segment:0] = $AA55 THEN BEGIN
ROMSize := Mem [Segment:2] DIV 2;
Inline ($FC/$8B/$0E/ROMSize/$86/$CD/$D1/$E1/$D1/$E1/$31/
$F6/$89/$F3/$A1/Segment/$1E/$8E/$D8/$AC/$00/$C3/
$E2/$FB/$1F/$89/$1E/ChkSum);
IF ChkSum = 0 THEN BEGIN
ExtraRAMFound := TRUE;
IF FileWrite THEN
Write (Fil, Hex(Segment)+'0', '-', Hex(Segment+ROMSize * 64-1)+'F (',
ROMSize:3, ' KB)')
ELSE
Write (Hex(Segment)+'0', '-', Hex(Segment+ROMSize * 64-1)+'F (',
ROMSize:3, ' KB)');
IF (Seg(Vector_41^) = Segment) THEN
IF FileWrite THEN
Write (Fil, ' Harddisk-BIOS')
ELSE
Write (' Harddisk-BIOS');
IF (Segment = Seg(Vector_57^)) THEN
IF FileWrite THEN
Write (Fil, ' NetBIOS-ROM')
ELSE
Write (' NetBIOS-ROM');
IF (Segment = $C000) THEN
IF VGAPres THEN
IF FileWrite THEN
Write (Fil, ' VGA-BIOS')
ELSE
Write (' VGA-BIOS')
ELSE IF EGAPres THEN
IF FileWrite THEN
Write (Fil, ' EGA-BIOS')
ELSE
Write (' EGA-BIOS');
IF FileWrite THEN
Write (Fil, #13#10, ' ':37)
ELSE
Write (#13#10, ' ':37);
Inc (Segment, ROMSize * 64)
END
ELSE
Inc (Segment, $10);
END
ELSE
Inc (Segment, $10);
END;
IF NOT ExtraRAMFound THEN
IF FileWrite THEN
WriteLn (Fil, 'NOT FOUND')
ELSE
WriteLn ('NOT FOUND');
END;



PROCEDURE ReserveMem;
BEGIN
BufPtr := NIL;
IF CylSize [L] > LongInt (MaxBufSize) THEN BEGIN
SPC := MaxBufSize DIV 512;
CylSize [L] := SPC * 512;
END;
HeapPointer := LONGINT (LongWord(HeapPtr)[2]) * 16 + LongWord(HeapPtr)[1];
FillSize := $10000 - HeapPointer MOD $10000;
GetMem (DummyPtr, FillSize);
IF DummyPtr = NIL THEN BEGIN
WriteLn (#13#10#10'Not enough memory to test hard disk(s)');
Halt;
END;
GetMem (BufPtr, Word (CylSize[L]+16));
IF BufPtr = NIL THEN BEGIN
WriteLn (#13#10#10'Not enough memory to test hard disk(s)');
Halt;
END;
END;



BEGIN
Debug := (ParamStr (ParamCount) = '-D') OR (ParamStr (ParamCount) = '-d') OR
(ParamStr (ParamCount) = '/D') OR (ParamStr (ParamCount) = '/d');
IF (ParamStr (ParamCount) = '-H') OR (ParamStr (ParamCount) = '-h') OR
(ParamStr (ParamCount) = '/H') OR (ParamStr (ParamCount) = '/h') OR
(ParamStr (ParamCount) = '/?') OR (ParamStr (ParamCount) = '-?') THEN BEGIN
WriteLn (#10#13, 'COMPTEST tests the performance of your PC compatible computer');
WriteLn (#10#13, 'usage: COMPTEST [file name] [/D] [/H]');
WriteLn (#10#13, 'file name: saves the test results in file specified');
WriteLn ( '/D: enables additional debugging messages');
WriteLn ( '/H: displays this information');
WriteLn;
Halt (0);
END;

Regs.AH := 0; { switch off diskette motor }
Regs.DL := 0; { recalibrate diskettes only }
Intr ($13, Regs);

DirectVideo := TRUE;
CheckBreak := FALSE;

HeapError := @HeapFunc;

GetMem (MoveBuffer, 20000);
IF MoveBuffer = NIL THEN BEGIN
WriteLn ('Not enough memory to execute COMPTEST');
Halt;
END;

WITH Result DO BEGIN

{-------------------------------------------------------------------------
determine computer type
--------------------------------------------------------------------------}

Typ := Mem [$FFFF:$000E];
Regs.AH := $C0; { get system description table }
Intr ($15, Regs);
IF Debug AND ((Regs.Flags AND FCarry) = 0) THEN BEGIN
WriteLn ('computer type: ', Hex (MemW [Regs.ES:Regs.BX+2]));
ReadLn;
END;
IF ((Regs.Flags AND FCarry) = 0) AND (Mem [Regs.ES:Regs.BX+2] = $FC) THEN
CASE Mem [Regs.ES:Regs.BX+3] OF
$02: Typ := $F7; { XT-286 }
$04: Typ := $F6; { PS/2 Model 50 }
$05: Typ := $F5; { PS/2 Model 60 }
END;
IF Typ < $F5 THEN
ComputerType := 'Unknown'
ELSE
ComputerType := 'IBM ' + Computer [Typ] + ' or compatible';


{-------------------------------------------------------------------------
determine equipment
--------------------------------------------------------------------------}

Intr ($11, Regs); { get BIOS equipment flag }
NrParallelPorts := (Regs.AH AND $C0) SHR 6;
GamesAdaptor := (Regs.AH AND $10) <> 0;
NrSerialPorts := (Regs.AH AND $6) SHR 1;
NrOfFloppies := (Regs.AL AND $C0) SHR 6 + (Regs.AL AND 1);
MousePresent := CheckMouse;

IF NOT GamesAdaptor THEN
GamesAdaptor := (Port [$201] AND $F) = 0;

IF Debug THEN WriteLn ('About to perform SIO-Test');

Dummy := 0;
FOR L := 1 TO 4 DO BEGIN
SIOType [L] := 0;
SIOCtrl := Port [SIOBase [L] + 4];
Port [SIOBase [L] + 4] := SIOCtrl OR $10;
SIOStat := Port [SIOBase [L] + 6];
Port [SIOBase [L] + 4] := $1A;
SerOut := Port [SIOBase [L] + 6] AND $F0;
Port [SIOBase [L] + 4] := SIOCtrl;
Port [SIOBase [L] + 6] := SIOStat;
IF SerOut = $90 THEN BEGIN
Inc (Dummy);
SIOType [L] := 1;
K := Port [SIOBase [L]+7];
IF K = Port [SIOBase [L]+7] THEN BEGIN
PortExists := TRUE;
FOR K := 0 TO 255 DO BEGIN
Port [SIOBase [L]+7] := K;
Delay (1);
PortExists := PortExists AND (K = Port [SIOBase [L]+7]);
END;
IF PortExists THEN BEGIN
Inc (SIOType [L]);
Port [SIOBase [L] + 2] := $01;
SIOStat := Port [SIOBase [L] + 2] AND $C0;
IF SIOStat = $C0 THEN
SIOType [L] := 4
ELSE IF SIOStat = $80 THEN
SIOType [L] := 3
ELSE IF SIOStat = 0 THEN
SIOType [L] := 2
ELSE
SIOType [L] := 5;
Port [SIOBase [L] + 2] := 0;
END; { if portexists...}
END; { if k...}
END; { if serout...}
END; { for l ... }

IF Dummy > NrSerialPorts THEN
NrSerialPorts := Dummy;


{-------------------------------------------------------------------------
determine graphics card
--------------------------------------------------------------------------}

Regs.AX := $1B00; { get VGA state information }
Regs.BX := 0; { implementation type }
Regs.ES := Seg (InfoBuf); { buffer for }
Regs.DI := Ofs (InfoBuf); { return information }
Intr ($10, Regs); { try to call VGA Bios }
VGAPres := (Regs.AL = $1B); { VGA if AL = AH on return }

Regs.AH := $12; { get EGA hardware configuration }
Regs.BX := $FF10;
Intr ($10, Regs); { try to call EGA Bios }
EGAPres := (Regs.BH <> $FF); { EGA, if BH <> $FF }
EGAMem := Lo (Regs.BX) * 64 + 64; { size of EGA screen memory in KB }

Regs.AH := $0F; { get screen status }
Intr ($10, Regs); { BIOS video interupt }
MonoChromMode := Regs.AL = 7;

Regs.AX := $1A00; { get screen combination code }
Intr ($10, Regs); { call PS/2 BIOS }
IF (Regs.AL = $1A) AND (Regs.BL>= $A) AND (Regs.BL <= $C) THEN
GraphCard := MCGA
ELSE IF (Regs.AL = $1A) AND (Regs.BL = 6) THEN
GraphCard := PGA
ELSE IF MonoChromMode THEN
IF VGAPres THEN
GraphCard := VGA
ELSE IF EGAPres THEN
GraphCard := EGA
ELSE IF HercPresent THEN
GraphCard := Herkules
ELSE
GraphCard := MDA
ELSE
IF VGAPres THEN
GraphCard := VGA
ELSE IF EGAPres THEN
GraphCard := EGA
ELSE
GraphCard := CGA;


{-------------------------------------------------------------------------
determine memory
--------------------------------------------------------------------------}

DOS_Memory := MemW [$0000:$0413];
UsedMemory := PrefixSeg SHR 6;
Regs.AH := $88;
Intr ($15, Regs);
ExtendedMem := (((Regs.Flags AND FCarry) = 0) AND (Regs.AX <> 0));
IF ExtendedMem THEN
ExtendedMemSize := Regs.AX
ELSE IF (Typ = $FC) OR ((Typ >= $F5) AND (Typ <= $F8)) THEN BEGIN
Port [$70] := $30;
Dummy := Port [$71];
Port [$70] := $31;
ExtendedMemSize := Port [$71] * 256 + Dummy;
ExtendedMem := ExtendedMemSize > 0;
END;
ExpandedMem := EMM_Installed;
EMS_Base := 0;
IF ExpandedMem THEN BEGIN
ExpandedMemSize := EMS_Memory;
EMS_Version := GetEMSVersion;
EMS_Base := GetEMSBase;
END;

Segment := 0;
SystemMemory := 0;
MemExists := TRUE;
WHILE MemExists AND (Segment < CardMemBegin [GraphCard]) DO BEGIN
Inline ($FA); { disable interupts }
SaveByte := Mem [Segment:0];
Mem [Segment:0] := $55;
Dummy := Mem [Segment:0];
MemExists := (Dummy = $55);
Mem [Segment:0] := $AA;
Dummy := Mem [Segment:0];
MemExists := MemExists AND (Dummy = $AA);
Mem [Segment:0] := SaveByte;
Inline ($FB); { enable interupts }
Inc (Segment, $400);

IF MemExists THEN
Inc (SystemMemory, 16);
END;

{-------------------------------------------------------------------------
determine diskette drives
--------------------------------------------------------------------------}

DOS_Drives := 0;
DriveStr := ' (';
Regs.AH := $19;
Intr ($21, Regs);
DefaultDr := Regs.AL;
FOR L:=0 TO 8 DO BEGIN
Regs.AH := $0e;
Regs.DX := L;
Intr ($21, Regs);
Regs.AH := $19;
Intr ($21, Regs);
IF (Regs.AL = Regs.DX) THEN BEGIN
Inc (DOS_Drives);
DriveStr := DriveStr + Chr (L+65) + ':, ';
END;
END;
Regs.AH := $0e;
Regs.DX := DefaultDr;
Intr ($21, Regs);
IF DriveStr [Length(DriveStr)-1] = ',' THEN
Dec (DriveStr [0], 2);
DriveStr := DriveStr + ')';

DriveByte := 0;
IF Typ = $FC THEN BEGIN
Port [$70] := $10;
DriveByte := Port [$71];
Drive1 := DriveByte AND 15;
NrDD := 0;
NrHD := 0;
Nr3DD := 0;
Nr3HD := 0;
CASE Drive1 OF
1: Inc (NrDD);
2: Inc (NrHD);
3: Inc (Nr3DD);
4: Inc (Nr3HD);
END;
Drive2 := DriveByte SHR 4;
CASE Drive2 OF
1: Inc (NrDD);
2: Inc (NrHD);
3: Inc (Nr3DD);
4: Inc (Nr3HD);
END;
END;

DiskTypeStr := '';
IF DriveByte <> 0 THEN BEGIN
DiskTypeStr := ' (';
IF NrDD <> 0 THEN
DiskTypeStr := DiskTypeStr + Char (48+NrDD) + ' x 360 KB 5¬", ';
IF NrHD <> 0 THEN
DiskTypeStr := DiskTypeStr + Char (48+NrHD) + ' x 1.2 MB 5¬", ';
IF Nr3DD <> 0 THEN
DiskTypeStr := DiskTypeStr + Char (48+Nr3DD) + ' x 720 KB 3«", ';
IF Nr3HD <> 0 THEN
DiskTypeStr := DiskTypeStr + Char (48+Nr3HD) + ' x 1.44 MB 3«", ';
Dec (DiskTypeStr[0], 2);
DiskTypeStr := DiskTypeStr + ')';
END;

{-------------------------------------------------------------------------
determine hard disks
--------------------------------------------------------------------------}

Regs.AH := $08; { get drive parameters }
Regs.DL := $80; { of first harddisk }
Intr ($13, Regs); { BIOS disk interupt }
IF (Regs.Flags AND FCarry) <> 0 THEN { error indicates no harddisk }
NrOfHardDisks := 0
ELSE
NrOfHardDisks := Regs.DL; { else # of harddisk is returned }

FOR L := 1 TO 4 DO BEGIN
Regs.AH := $10; { test drive ready }
Regs.DL := $7F + L; { of harddisk # L }
Intr ($13, Regs); { BIOS disk interupt }
IF ((Regs.Flags AND FCarry) <> 0) OR { no error indicates drive exists }
(NrOfHardDisks = 0) THEN
Valid [$7F+L] := FALSE
ELSE BEGIN
Valid [$7F+L] := TRUE;
Dec (NrOfHardDisks);
END;
END;

NrOfHardDisks := 0;
FOR L := $80 TO $83 DO BEGIN
IF Valid [L] THEN
Inc (NrOfHardDisks);
END;


{-------------------------------------------------------------------------
determine type of processor and coprocessor
--------------------------------------------------------------------------}

IF MonoChromMode THEN
ScreenAddr := Ptr ($B000,0000)
ELSE
ScreenAddr := Ptr ($B800,0000);

IF Debug THEN BEGIN
WriteLn;
FillChar (Result, SizeOf (ResultRec), 0);
Result.Speed287 := 1;
END;

SpeedTest (Word (NOT Debug), Word(ExtendedMem), Word(ExpandedMem), MoveBuffer,
Ptr (EMS_Base, 0), ScreenAddr, Result);

IF Debug THEN BEGIN
WriteLn ('RawMoveWTime: ', MoveWtime);
WriteLn ('RawMoveDTime: ', MoveDTime);
WriteLn ('CPU-Type: ', CPUType);
WriteLn ('AAMTime: ', AAMTime DIV 4);
WriteLn ('MoveBTime: ', MoveBtime);
ReadLn;
END;

CPU := Processor (CPUType);
Weitek := (NDPType AND $80) <> 0;
NDPType := NDPType AND $7F; { clear Weitek flag }
ProcessorType := CPU_Name [CPU];

IF NOT (CPU >= i286) THEN
ExtendedMem := FALSE;

CacheSize (Debug, CPU > i286, FirstLevel, SecondLevel, CacheThru, Cache2Thru, MemThru);


{-------------------------------------------------------------------------
determine speed
--------------------------------------------------------------------------}

Frequency := 200 * AAM_Time [CPU] * ClockFreq / AAMTime;
MoveTakte := MoveBTime * Frequency / (ClockFreq * 5000);
MoveWTakte := MoveWTime * Frequency / (ClockFreq * 5000);
IF CPU >= i386 THEN BEGIN
MoveWTime := MoveDTime DIV 2; { because twice the # of words were moved}
END;
IF Debug THEN BEGIN
WriteLn ('MoveWTime: ', MoveWtime);
WriteLn ('MoveDTime: ', MoveDTime);
WriteLn ('MoveTakte: ', MoveTakte:0:2);
WriteLn ('MoveTimeCPU: ', MoveTime [CPU]);
WriteLn ('LFaktor: ', LFaktor [CPU]);
WriteLn ('Frequency: ', Frequency);
END;
ThruPut := ClockFreq * 10000 / MoveWTime;
IF CPU >= i386 THEN
DataWidth := 32
ELSE
DataWidth:= 16;
WaitStates := (((((DataWidth DIV 8) * Frequency / (MoveTime [CPU] * 1024)) / MemThru)
* MoveTime [CPU] - MoveTime [CPU]) * 0.5);
Index := LFaktor[CPU] * Frequency/4.7e6 * (MoveTime [CPU] / MoveTakte);
FillTakte := ScreenFillTime * Frequency / (ClockFreq * 5000);
IF Debug THEN BEGIN
WriteLn ('ScreenFillTim:', ScreenFillTime);
WriteLn ('FillTakte: ', FillTakte);
WriteLn ('Index: ', Index);
WriteLn ('BIOSWriteTime:', BIOSWriteTime);
END;
ScreenWaits:= Trunc (FillTakte - FillTime [CPU] + 0.1);

IF Debug THEN BEGIN
WriteLn ('Stat87: ', NDPType);
WriteLn ('Speed87: ', Speed87);
WriteLn ('Speed287: ', Speed287);
WriteLn ('Freq287: ', 1e-6 * 7690 * ClockFreq /Speed287 :0:2);
END;


IF ExpandedMem THEN BEGIN
IF CPU >= i386 THEN
EMS_Thruput := ClockFreq * 16000 / EMS_Time
ELSE
EMS_ThruPut := ClockFreq * 10000 / EMS_Time;
END;


IF ExtendedMem THEN
Ext_ThruPut := ClockFreq * 10000 / Ext_Time;

CASE NDPType OF { 40 * # of clock cycles for FSQRT }
{Pentium}28: Frequency87 := 1600 * ClockFreq / Speed287; {~40 clocks }
{EMC87} 27: Frequency87 := 1470 * ClockFreq / Speed287; { 36 clocks }
{83S87} 26: Frequency87 := 3040 * ClockFreq / Speed287; { 76 clocks magazine}
{387+} 25: Frequency87 := 2880 * ClockFreq / Speed287; { 76 clocks magazine}
{82S87} 24: Frequency87 := 3040 * ClockFreq / Speed287; { 76 clocks magazine}
{82S87} 23: Frequency87 := 3040 * ClockFreq / Speed287; { 72 clocks meas.}
{486} 22: Frequency87 := 3320 * ClockFreq / Speed287; { 83 clocks meas. }
{RapidCAD}21:Frequency87 := 3320 * ClockFreq / Speed287; { 83 clocks }
{387DX} 20: Frequency87 := 4480 * ClockFreq / Speed287; { 112 clocks meas.}
{38700sx}19: Frequency87 := 2200 * ClockFreq / Speed287; { 55 clocks }
{38700DX}18: Frequency87 := 2040 * ClockFreq / Speed287; { 52 clocks }
{83C87sx}17: Frequency87 := 3640 * ClockFreq / Speed287; { 91 clocks magazine}
{83C87} 16: Frequency87 := 3440 * ClockFreq / Speed287; { 86 clocks meas.}
{83S87} 15: Frequency87 := 1880 * ClockFreq / Speed287; { 47 clocks meas.}
{83D87} 14: Frequency87 := 1470 * ClockFreq / Speed287; { 36 clocks meas.}
{82S87} 13: Frequency87 := 1880 * ClockFreq / Speed287; { 47 clocks }
{82S87} 12: Frequency87 := 1880 * ClockFreq / Speed287; { 47 clocks }
{3C87sx} 11: Frequency87 := 2280 * ClockFreq / Speed287; { 57 clocks DataSheet }
{3C87} 10: Frequency87 := 2240 * ClockFreq / Speed287; { 57 clocks meas.}
{2C87} 8,9: Frequency87 := (1970 * ClockFreq / Speed287) * (0.928 + Index/65.0); { 49 Takte }
{387sx} 7: Frequency87 := 5160 * ClockFreq / Speed287; { 129 clocks }
{387} 6: Frequency87 := 5120 * ClockFreq / Speed287; { 128 clocks meas. }
{287XL} 5: Frequency87 := 5440 * ClockFreq / Speed287; { 136 clocks}
{287} 4: Frequency87 := (7690 * ClockFreq / Speed287) * (0.928 + Index/65.0); {183 clocks meas.}
{80C187} 3: Frequency87 := 5440 * ClockFreq / Speed87; { 136 clocks }
{8087} 2: Frequency87 := 7440 * ClockFreq / Speed87; { 186 clocks meas.}
END;

(* Correction for faster execution of coprocessor instructions with 486DLC *)

IF (CPU = c486dlc) THEN
Frequency87 := Frequency87 / 1.055;

Regs.AH := $30;
Intr ($21, Regs);
Version := Regs.AL+Regs.AH / 100.0;

{---------------------------------------------------------------------------
speed of screen output
---------------------------------------------------------------------------}

TestStr := ' $';
SegTest := Seg (TestStr);
OfsTest := Ofs (TestStr)+1;
Start := Clock;
inline ($b9/$14/$00/
$b4/$02/
$b7/$00/
$b6/$1a/
$b2/$01/
$cd/$10/
$b4/$09/
$8e/$1e/SegTest/
$8b/$16/OfsTest/
$cd/$21/
$e2/$e8);
DosWriteTime := Clock - Start;

IF Debug THEN BEGIN
GotoXY (1,25);
WriteLn ('DOSWriteTime: ', DOSWriteTime);
REPEAT UNTIL KeyPressed;
Read (Ch);
END;

BIOSSpeed := 20 * ClockFreq / BiosWriteTime;
DOSSpeed := 1e6 / DOSWriteTime;


Regs.AX := $0C0F; { clear keyboard buffer }
Intr ($21, Regs);
TestStr := '$'#8#8#8#8#8#8#8' ';
Regs.AH := 9;
Regs.DS := Seg (TestStr);
Regs.DX := Ofs (TestStr)+1;
Intr ($21, Regs);
Regs.AH := $B;
Intr ($21, Regs);
ANSIPresent := (Regs.AL = $FF);
Regs.AX := $0C0F; { clear keyboard buffer }
Intr ($21, Regs);

FreeMem (MoveBuffer, 20000);
Emu := (Test8087 = 0) OR (NDPType < 2);


{-------------------------------------------------------------------------
output page 1
--------------------------------------------------------------------------}

ClrScr;
WriteLn ('ÍÍ public domain version ÍÍÍ COMPTEST 2.59 ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ '+'Page 1 ÍÍÍ');
WriteLn;
WriteLn ('computer type: ':37, ComputerType);
WriteLn ('CPU: ':37, ProcessorType);
WriteLn ('clock frequency: ':37, Frequency/1e6:0:2, ' MHz');
WriteLn ('bus width: ':37, BusWidth[CPU], ' bit');
Write ('CPU-cache: ':37);
IF FirstLevel <> 0 THEN BEGIN
Write ('1. level: ', FirstLevel, ' KB');
IF SecondLevel = 0 THEN
WriteLn
ELSE
WriteLn (', 2. level: ', SecondLevel, ' KB')
END
ELSE
WriteLn ('NOT FOUND');
WriteLn;
IF FirstLevel <> 0 THEN BEGIN
Write ('maximum RAM thruput (without cache): ':37, MemThru:0:0, ' KB/s');
WriteLn (' (effective wait states: ', Waitstates:0:1, ')');
Write ('CPU-cache thruput: ':37, '1. level: ', CacheThru:0:0, ' KB/s');
IF SecondLevel <> 0 THEN
WriteLn (', 2. level: ', Cache2Thru:0:0, ' KB/s');
END
ELSE BEGIN
Write ('maximum RAM-thruput: ':37, MemThru:0:0, ' KB/s');
WriteLn (' (effective wait-states: ', Waitstates:0:1, ')');
END;
WriteLn;
WriteLn ('system memory: ':37, SystemMemory:0, ' KB');
WriteLn ('available to DOS: ':37, DOS_Memory:0, ' KB');
WriteLn ('permanently used by DOS and TSRs: ':37, UsedMemory:0, ' KB');
WriteLn;
Write ('extended memory: ':37);
IF ExtendedMem THEN
WriteLn (ExtendedMemSize:0, ' KB (INT 15h thruput: ', Ext_Thruput/1024:0:0, ' KB/s)')
ELSE
WriteLn ('NOT FOUND');
Write ('expanded memory: ':37);
IF ExpandedMem THEN
WriteLn (ExpandedMemSize:0, ' KB (EMS ', EMS_Version, ', thruput: ', EMS_ThruPut/1024:0:0, ' KB/s)')
ELSE
WriteLn ('NOT FOUND');
WriteLn;
Write ('other RAM: ':37);
SearchExtraRAM (FALSE);
WriteLn;
Write ('BIOS-extensions: ':37);
SearchROM (FALSE);
WriteLn;
WriteLn ('ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ COMPTEST 2.59 ÍÍÍÍÍÍÍÍÍÍÍ (c) 1988-1993 N.J. ÍÍÍ');
Write ('Press a key for page 2');

Ch := ReadKey;
ClrScr;
WriteLn ('ÍÍ public domain version ÍÍÍ COMPTEST 2.59 ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ Page 2 ÍÍÍ');
WriteLn;
WriteLn ('parallel ports: ':37, NrParallelPorts:1);
Write ('serial ports: ':37, NrSerialPorts:1);
Dummy := 0;
IF NrSerialPorts <> 0 THEN BEGIN
Write (' (');
FOR L := 1 TO 4 DO BEGIN
IF SIOType [L] <> 0 THEN BEGIN
Inc (Dummy);
Write ('COM', L, ': ', SIOTypeStr [SIOType[L]]);
IF Dummy <> NrSerialPorts THEN
Write (', ');
END;
END;
WriteLn (')');
END;

Write ('mathematical coprocessor: ':37);
IF NDPType > 0 THEN BEGIN
Write (CoProcessor [NDPType]);
IF NDPType > 1 THEN
Write (' (clock frequency:', Frequency87/1e6:0:2, ' MHz)')
END;
IF Weitek THEN BEGIN
IF NDPType > 1 THEN BEGIN
Writeln;
Write ('':37);
END;
IF CPU >= i486 THEN
Writeln ('Weitek 4167')
ELSE
Writeln ('Weitek 3167 or 1167');
END;
IF (NDPType = 0) AND (NOT Weitek) THEN
WriteLn (CoProcessor [NDPType])
ELSE IF (NOT Weitek) THEN
WriteLn;

WriteLn ('mouse: ':37, Installed [MousePresent]);
WriteLn ('games adaptor: ':37, Installed [GamesAdaptor]);
Writeln;
WriteLn ('DOS drives: ':37, DOS_Drives:0, DriveStr);
Write ('floppy drives: ':37, NrOfFloppies:0);
WriteLn (DiskTypeStr);
WriteLn ('hard disks: ':37, NrOfHardDisks:0);
WriteLn;
Write ('graphics card: ':37, CardName [GraphCard]);
IF GraphCard = EGA THEN
WriteLn (' w/', EGAMem:4, ' KB')
ELSE
WriteLn;
WriteLn ('video-RAM wait states: ':37, ScreenWaits);
WriteLn ('speed of video output via BIOS: ':37, BIOSSpeed:0:0, ' characters/sec');
Write ('speed of video output via DOS: ':37, DOSSpeed:0:0, ' characters/sec (');
IF ANSIPresent THEN
Write ('with')
ELSE
Write ('without');
WriteLn (' ANSI driver)');
WriteLn ('DOS version: ':37, Version:3:2);
WriteLn;
Write ('Dhrystones/second: ':37);
Dhrys := Dhrystones (Index);
Write (Dhrys:0:1);
WriteLn (' (CPU: ', Dhrys/3.6464E+2:0:1, '-fold of XT)');
Write ('Double-Precision Kilowhetstones: ':37);
Whets := Whetstone (Emu, Index);
Write (Whets:0:1);
IF Emu THEN
WriteLn (' (emulator: ', Whets/4.9169E+0:0:1, '-fold of XT)')
ELSE
WriteLn (' (FPU: ', Whets/9.9087E+1:0:1, '-fold of XT w/ 8087)');
Write ('Double-Precision MFLOPS: ':37);
MegaFlops := MFlops (Emu, Index);
Write (MegaFlops:0:3);
IF Emu THEN
WriteLn (' (emulator: ', MegaFlops/6.5242E-4:0:1, '-fold of XT)')
ELSE
WriteLn (' (FPU: ', MegaFlops/1.2446E-2:0:1, '-fold of XT w/ 8087)');
WriteLn;
WriteLn ('ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ COMPTEST 2.59 ÍÍÍÍÍÍÍÍÍÍÍ (c) 1988-1993 N.J. ÍÍÍ');
IF (NOT Weitek) THEN
WriteLn;
END; {with}

IF Debug THEN BEGIN
WriteLn ('Dhry: ', Dhrys);
WriteLn ('Whet: ', Whets);
WriteLn ('MFlop:', MegaFlops);
Ch := ReadKey;
END;

IF NrOfHardDisks <> 0 THEN BEGIN
Write ('Test hard disk(s) (Y/N) ? ');
Ch := ReadKey;
IF UpCase (Ch) <> 'Y' THEN
NrOfHardDisks := 0;
END;

IF (NrOfHardDisks > 0) THEN BEGIN

ClrScr;
WriteLn ('ÍÍ public domain version ÍÍÍ COMPTEST 2.59 ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ Page 3 ÍÍÍ');

FOR L := $80 TO $83 DO BEGIN

IF Valid [L] THEN BEGIN

WriteLn;

Regs.AH := $08;
Regs.DL := L;
Intr ($13, Regs);
Sectors [L] := Regs.CL AND $3F;
Cylinders [L] := Word (Regs.CL AND $C0) * 4 + Regs.CH + 1;
Heads [L] := Regs.DH + 1;
CylSize [L] := LongInt (Sectors [L]) * Heads [L] * 512;

ReserveMem;

BufOff := Ofs (BufPtr^);
BufSeg := Seg (BufPtr^);

Regs.CX := 1;
Regs.DL := L;
Regs.DH := 0;
Regs.AX := $0201;
Regs.ES := BufSeg;
Regs.BX := BufOff;
Intr ($13, Regs);

DOSCylinders [L] := 0;
Dummy := $1C5;
WHILE (Dummy < $200) AND ((BufPtr^[$1FF] * 256 + BufPtr^[$200]) = $55AA) DO BEGIN
IF ((BufPtr^[Dummy] AND $C0) * 4 + BufPtr^[Dummy+1] + 1) > DOSCylinders [L] THEN
DOSCylinders [L]:= (BufPtr^[Dummy] AND $C0) * 4 + BufPtr^[Dummy+1]+1;
Inc (Dummy, $10);
END;

FreeMem (BufPtr, Word(CylSize [L]+16));
FreeMem (DummyPtr, FillSize);

IF DOSCylinders [L] > Cylinders [L] THEN
Cylinders [L] := DOSCylinders [L];
SPC := Sectors [L] * Heads [L];
CylSize [L] := LongInt (512) * SPC;
Capacity [L]:= CylSize [L] * Cylinders [L];

ReserveMem;

Write ('hard disk ', L-$7F:1);
WriteLn ('cylinders: ':26, Cylinders[L]);
WriteLn ('read/write heads: ':37, Heads[L]);
WriteLn ('sectors per track: ':37, Sectors[L]);
WriteLn ('storage capacity: ':37, Capacity[L], ' Byte (',Capacity[L] / 1048576.0:0:2,' MB)');
WriteLn;

{-------------------------------------------------------------------------
determine track-to-track time
--------------------------------------------------------------------------}

Write ('track-to-track seek time: ':37);
Start := Clock;
FOR Track := 0 TO Cylinders[L]-1 DO BEGIN
Inline ($8b/$16/L/ { mov dx, Drive&Head }
$a1/Track/ { mov ax, Track }
$88/$c5/ { mov ch, al }
$25/$00/$03/ { and ax, $300 }
$d1/$e8/ { shr ax, 1 }
$d1/$e8/ { shr ax, 1 }
$0d/$01/$00/ { or ax, Sector }
$88/$c1/ { mov cl, al }
$b4/$0c/ { mov ah, SeekFunc }
$cd/$13); { int BIOS-DiskIO }
END;
TrackToTrack [L] := Int (((Clock-Start) / Cylinders[L]) * 10 + 0.5) / 10;
WriteLn (TrackToTrack [L]:6:2, ' ms');

{-------------------------------------------------------------------------
determine average acces time
--------------------------------------------------------------------------}

Write ('average seek time: ':37);
Dummy := 2 * Cylinders [L] DIV 3;
Start := Clock;
FOR Track := 1 TO 40 DO BEGIN
Inline ($8b/$16/L/ { mov dx, Drive&Head }
$a1/Dummy/ { mov ax, Track }
$88/$c5/ { mov ch, al }
$25/$00/$03/ { and ax, $300 }
$d1/$e8/ { shr ax, 1 }
$d1/$e8/ { shr ax, 1 }
$0d/$01/$00/ { or ax, Sector }
$88/$c1/ { mov cl, al }
$b4/$0c/ { mov ah, SeekFunc }
$cd/$13); { int BIOS-DiskIO }
Dummy := Cylinders [L] - Dummy;
END;
AverageAccess [L] := Int ((Clock - Start) * 0.25 + 0.5) / 10;
WriteLn (AverageAccess [L]:6:2, ' ms');

{-------------------------------------------------------------------------
maximum access time
--------------------------------------------------------------------------}

Write ('maximum seek time: ':37);
Dummy := 0;
Start := Clock;
FOR Track := 1 TO 25 DO BEGIN
Inline ($8b/$16/L/ { mov dx, Drive&Head }
$a1/Dummy/ { mov ax, Track }
$88/$c5/ { mov ch, al }
$25/$00/$03/ { and ax, $300 }
$d1/$e8/ { shr ax, 1 }
$d1/$e8/ { shr ax, 1 }
$0d/$01/$00/ { or ax, Sector }
$88/$c1/ { mov cl, al }
$b4/$0c/ { mov ah, SeekFunc }
$cd/$13); { int BIOS-DiskIO }
Dummy := (Cylinders[L]-1) - Dummy;
END;
MaximumAccess [L]:= Int ((Clock-Start) * 0.04 + 0.5);
WriteLn (MaximumAccess[L]:6:2, ' ms');


{-------------------------------------------------------------------------
determine maximum thruput
--------------------------------------------------------------------------}

IF Debug THEN BEGIN
WriteLn ('SPC: ', SPC);
WriteLn ('BufSeg: ', Hex(BufSeg));
WriteLn ('BufOff: ', Hex(BufOff));
ReadLn;
END;

Write ('maximum thruput: ':37);
Delay (200);
Dummy := 0;
Start := Clock;
FOR Track := 1 TO 15 DO BEGIN
Inline ($8b/$16/L/ { mov dx, Drive&Head }
$a1/Dummy/ { mov ax, 0 }
$88/$c5/ { mov ch, al }
$25/$00/$03/ { and ax, $300 }
$d1/$e8/ { shr ax, 1 }
$d1/$e8/ { shr ax, 1 }
$0d/$01/$00/ { or ax, Sector }
$88/$c1/ { mov cl, al }
$8b/$1e/BufOff/ { mov bx, BufOff }
$8e/$06/BufSeg/ { mov es, BufSeg }
$a1/SPC/ { mov ax, SectorPerTrack }
$b4/$02/ { mov ah, ReadFunc }
$cd/$13); { int BIOS-DiskIO }
END;
DiskThruPut [L] := 15000 * (CylSize [L] DIV 1024) / (Clock-Start);
Delay (200);
Dummy := Cylinders [L] - 1;
Head1 := Heads [L] - ((SPC + Sectors[L] - 1) DIV Sectors [L]);
ErrByte := 0;
FOR Track := 1 TO 16 DO BEGIN
IF Track = 2 THEN
Start := Clock;
Inline ($8b/$16/L/ { mov dx, Drive }
$8a/$36/Head1/ { mov dh, Head }
$a1/Dummy/ { mov ax, Track}
$88/$c5/ { mov ch, al }
$25/$00/$03/ { and ax, $300 }
$d1/$e8/ { shr ax, 1 }
$d1/$e8/ { shr ax, 1 }
$0d/$01/$00/ { or ax, Sector }
$88/$c1/ { mov cl, al }
$8b/$1e/BufOff/ { mov bx, BufOff }
$8e/$06/BufSeg/ { mov es, BufSeg }
$a1/SPC/ { mov ax, SectorPerTrack }
$b4/$02/ { mov ah, ReadFunc }
$cd/$13/ { int BIOS-DiskIO }
$08/$26/ErrByte); { or ErrByte, ah }
END;
Durchsatz := 15000 * (CylSize [L] DIV 1024) / (Clock-Start);


IF Debug THEN BEGIN
WriteLn;
WriteLn ('thruput track 0: ', DiskThruput[L]);
WriteLn ('thruput track ', Cylinders [L], ': ', Durchsatz);
END;

IF (ErrByte = 0) AND (Durchsatz > DiskThruPut [L]) THEN
DiskThruPut [L] := Durchsatz;
Write (DiskThruPut [L]:3:0, ' KB/sec');


{--------------------------------------------------------------------------
test if disk cache active
--------------------------------------------------------------------------}

Dummy := 2 * Cylinders [L] DIV 3;
SPC := 16;
FOR Track := 1 TO 10 DO BEGIN
IF Track = 8 THEN
Start := Clock;
Inline ($8b/$16/L/ { mov dx, Drive&Head }
$a1/Dummy/ { mov ax, Track }
$88/$c5/ { mov ch, al }
$25/$00/$03/ { and ax, $300 }
$d1/$e8/ { shr ax, 1 }
$d1/$e8/ { shr ax, 1 }
$0d/$01/$00/ { or ax, Sector }
$88/$c1/ { mov cl, al }
$8b/$1e/BufOff/ { mov bx, BufOff }
$8e/$06/BufSeg/ { mov es, BufSeg }
$a1/SPC/ { mov ax, NrOfSectors }
$b4/$02/ { mov ah, ReadFunc }
$cd/$13); { int BIOS-DiskIO }
Dummy := Cylinders [L] - Dummy;
END;

CacheTstTime := Clock - Start;

IF Debug THEN BEGIN
WriteLn;
WriteLn ('Cachetest: ', CacheTstTime);
ReadLn;
END;

IF CPU < i286 THEN
CacheOn [L] := CacheTstTime < 75 { 3 seeks, 24 KB read < 75 ms }
ELSE
CacheOn [L] := CacheTstTime < 50;{ 3 seeks, 24 KB read < 50 ms }
IF CacheOn [L] THEN
WriteLn (' (using disk cache)')
ELSE
WriteLn;

FreeMem (BufPtr, Word(CylSize [L])+16);
FreeMem (DummyPtr, FillSize);
WriteLn;
END;

END;
IF NrOfHardDisks = 1 THEN
WriteLn (#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10);
WriteLn ('ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ COMPTEST 2.59 ÍÍÍÍÍÍÍÍÍÍÍ (c) 1988-1993 N.J. ÍÍÍ');
END;


IF (ParamCount > 0) AND (NOT Debug) OR (ParamCount > 1) AND Debug THEN BEGIN
Assign (Fil, ParamStr(1));
Rewrite (Fil);
WriteLn (Fil, 'ÍÍ public domain version ÍÍÍ COMPTEST 2.59 ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ Page 1 ÍÍÍ');
WriteLn (Fil);
WriteLn (Fil, 'computer type: ':37, ComputerType);
WriteLn (Fil, 'CPU: ':37, ProcessorType);
WriteLn (Fil, 'clock frequency: ':37, Frequency/1e6:0:2, ' Mhz');
WriteLn (Fil, 'bus width: ':37, BusWidth[CPU], ' bit');
Write (Fil, 'CPU-cache: ':37);
IF FirstLevel <> 0 THEN BEGIN
Write (Fil, '1. level: ', FirstLevel, ' KB');
IF SecondLevel = 0 THEN
WriteLn (Fil)
ELSE
WriteLn (Fil, ', 2. level: ', SecondLevel, ' KB')
END
ELSE
WriteLn (Fil, 'NOT FOUND');
WriteLn (Fil);
IF FirstLevel <> 0 THEN BEGIN
Write (Fil,'maximum RAM thruput (without cache): ':37, MemThru:0:0, ' KB/s');
WriteLn (Fil,' (effective wait states: ', Waitstates:0:1, ')');
Write (Fil,'CPU cache thruput: ':37, '1. level: ', CacheThru:0:0, ' KB/s');
IF SecondLevel <> 0 THEN
WriteLn (Fil,', 2. level: ', Cache2Thru:0:0, ' KB/s');
END
ELSE BEGIN
Write (Fil, 'maximum RAM thruput: ':37, MemThru:0:0, ' KB/s');
WriteLn (Fil, ' (effective wait states: ', Waitstates:0:1, ')');
END;
WriteLn (Fil);
WriteLn (Fil, 'system memory: ':37, SystemMemory:0, ' KB');
WriteLn (Fil, 'available for DOS: ':37, DOS_Memory:0, ' KB');
WriteLn (Fil, 'permanently used by DOS and TSRs: ':37, UsedMemory:0, ' KB');

WriteLn (Fil);
Write (Fil, 'extended memory: ':37);
IF ExtendedMem THEN
WriteLn (Fil, ExtendedMemSize:0, ' KB (INT 15h thruput: ', Ext_Thruput/1024:0:0, ' KB/s)')
ELSE
WriteLn (Fil, 'NOT FOUND');
Write (Fil, 'expanded memory: ':37);
IF ExpandedMem THEN
WriteLn (Fil, ExpandedMemSize:0, ' KB (EMS ', EMS_Version, ', thruput: ', EMS_ThruPut/1024:0:0, ' KB/s)')
ELSE
WriteLn (Fil, 'NOT FOUND');
WriteLn (Fil);
Write (Fil, 'other RAM: ':37);
SearchExtraRAM (TRUE);
WriteLn (Fil);
Write (Fil, 'BIOS-extensions: ':37);
SearchROM (TRUE);
WriteLn (Fil);
WriteLn (Fil, 'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ COMPTEST 2.59 ÍÍÍÍÍÍÍÍÍÍÍ (c) 1988-1993 N.J. ÍÍÍ');
WriteLn (Fil);
WriteLn (Fil, 'ÍÍ public domain version ÍÍÍ COMPTEST 2.59 ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ Page 2 ÍÍÍ');
WriteLn (Fil);
WriteLn (Fil, 'parallel ports: ':37, NrParallelPorts:1);
Write (Fil, 'serial ports: ':37, NrSerialPorts:1);
Dummy := 0;
IF NrSerialPorts <> 0 THEN BEGIN
Write (Fil, ' (');
FOR L := 1 TO 4 DO BEGIN
IF SIOType [L] <> 0 THEN BEGIN
Inc (Dummy);
Write (Fil, 'COM', L, ': ', SIOTypeStr [SIOType[L]]);
IF Dummy <> NrSerialPorts THEN
Write (Fil, ', ');
END;
END;
WriteLn (Fil, ')');
END;

Write (Fil, 'mathematical coprocessor: ':37);
IF Result.NDPType > 0 THEN BEGIN
Write (Fil, CoProcessor [Result.NDPType]);
IF Result.NDPType > 1 THEN
Write (Fil, ' (clock frequency:', Frequency87/1e6:0:2, ' MHz)')
END;
IF Weitek THEN BEGIN
IF Result.NDPType > 1 THEN BEGIN
Writeln (Fil);
Write (Fil, '':37);
END;
IF CPU >= i486 THEN
Writeln (Fil, 'Weitek 4167')
ELSE
Writeln (Fil, 'Weitek 3167 or 1167');
END;
IF (Result.NDPType = 0) AND (NOT Weitek) THEN
WriteLn (Fil, CoProcessor [Result.NDPType])
ELSE IF (NOT Weitek) THEN
WriteLn (Fil);

WriteLn (Fil, 'mouse: ':37, Installed [MousePresent]);
WriteLn (Fil, 'games adaptor: ':37, Installed [GamesAdaptor]);
WriteLn (Fil);
WriteLn (Fil, 'DOS drives: ':37, DOS_Drives:0, DriveStr);
Write (Fil, 'floppy drives: ':37, NrOfFloppies:0);
WriteLn (Fil, DiskTypeStr);
WriteLn (Fil, 'hard disks: ':37, NrOfHardDisks:0);
WriteLn (Fil);
Write (Fil, 'graphics card: ':37, CardName [GraphCard]);
IF GraphCard = EGA THEN
WriteLn (Fil, ' w/', EGAMem:4, ' KB')
ELSE
WriteLn (Fil);
WriteLn (Fil, 'video-RAM wait states: ':37, ScreenWaits);
WriteLn (Fil, 'speed of video output via BIOS: ':37, BIOSSpeed:0:0, ' characters/sec');
Write (Fil, 'speed of video output via DOS: ':37, DOSSpeed:0:0, ' characters/sec (');
IF ANSIPresent THEN
Write (Fil, 'with')
ELSE
Write (Fil, 'without');
WriteLn (Fil, ' ANSI driver)');
WriteLn (Fil, 'DOS version: ':37, Version:3:2);
WriteLn (Fil);
Write (Fil, 'Dhrystones/second: ':37);
Write (Fil, Dhrys:0:1);
WriteLn (Fil, ' (CPU: ', Dhrys/3.6464E+2:0:1, '-fold of XT)');
Write (Fil, 'Double-Precision Kilowhetstones: ':37);
Write (Fil, Whets:0:1);
IF Emu THEN
WriteLn (Fil, ' (emulator: ', Whets/4.9169E+0:0:1, '-fold of XT)')
ELSE
WriteLn (Fil, ' (FPU: ', Whets/9.7087E+1:0:1, '-fold of XT w/ 8087)');
Write (Fil, 'Double-Precision MFLOPS: ':37);
Write (Fil, MegaFlops:0:3);
IF Emu THEN
WriteLn (Fil, ' (emulator: ', MegaFlops/6.5242E-4:0:1, '-fold of XT)')
ELSE
WriteLn (Fil, ' (FPU: ', MegaFlops/1.2446E-2:0:1, '-fold of XT w/ 8087)');
WriteLn (Fil);
WriteLn (Fil, 'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ COMPTEST 2.59 ÍÍÍÍÍÍÍÍÍÍÍ (c) 1988-1993 N.J. ÍÍÍ');
WriteLn (Fil);
IF NrOfHardDisks = 0 THEN
Close (Fil)
ELSE BEGIN
WriteLn (Fil, 'ÍÍ public domain version ÍÍÍ COMPTEST 2.59 ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ Page 3 ÍÍÍ');
WriteLn (Fil);

FOR L := $80 TO $7F+NrOfHardDisks DO BEGIN

Write (Fil, 'hard disk ', L-$7F:1);
WriteLn (Fil, 'cylinders: ':26, Cylinders[L]);
WriteLn (Fil, 'read/write heads: ':37, Heads[L]);
WriteLn (Fil, 'sectors per track: ':37, Sectors[L]);
WriteLn (Fil, 'storage capacity: ':37, Capacity[L], ' Byte (',Capacity[L] / 1048576.0:0:2,' MB)');
WriteLn (Fil);
WriteLn (Fil, 'track-to-track seek time: ':37, TrackToTrack [L]:6:2, ' ms');
WriteLn (Fil, 'average seek time: ':37, AverageAccess [L]:6:2, ' ms');
WriteLn (Fil, 'maximum seek time: ':37, MaximumAccess[L]:6:2, ' ms');
Write (Fil, 'maximum thruput: ':37, DiskThruPut [L]:3:0, ' KB/sec');
IF CacheOn [L] THEN
WriteLn (Fil, ' (using disk cache)')
ELSE
WriteLn (Fil);
WriteLn (Fil);
WriteLn (Fil);

END;

WriteLn (Fil, 'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ COMPTEST 2.59 ÍÍÍÍÍÍÍÍÍÍÍ (c) 1988-1993 N.J. ÍÍÍ');
END;
Close (Fil);
END;
IF IOResult <> 0 THEN
BEGIN END;
Write ('COMPTEST terminated - press any key');
Ch := ReadKey;

END.


  3 Responses to “Category : System Diagnostics for your computer
Archive   : CTEST259.ZIP
Filename : COMPTEST.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/