home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
PASCAL
/
TPSEEK.ZIP
/
SEEKTEST.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1989-04-04
|
12KB
|
261 lines
program seektest;
{----------------------------------------------------------------------------
| Program SEEKTEST.PAS |
| |
| This program demonstrates the use of TPHRT in timing seek performance |
| of a PC based hard disk drive. The method used will determine the total|
| seek time of the device which includes actual disk seek, controller |
| overhead, and ROM BIOS overhead. This is a "real world" measurement |
| of disk performance under actual usage conditions. |
| |
| Environment: Turbo Pascal 5.0 |
| |
| (c)1989 Ryle Design, P.O. Box 22, Mt. Pleasant, Michigan 48804 |
----------------------------------------------------------------------------}
uses
dos, crt, tphrt;
var
regs : registers;
indx : integer;
numdisk : integer;
atom : byte;
keyin : char;
procedure disk_err(istat : integer);
{----------------------------------------------------------------------------
| This procedure outputs a description of an INT $13 error status, and |
| halts program execution. |
| |
| Globals referenced: none |
| |
| Arguments: (integer) istat - status returned from INT $13 in AH if |
| carry flag set. |
| |
| Returns : void |
----------------------------------------------------------------------------}
begin
if (istat <> 0) then
begin
case istat of
$01 : writeln('Disk error: Invalid command');
$02 : writeln('Disk error: Address mark not found');
$03 : writeln('Disk error: Disk is write-protected');
$04 : writeln('Disk error: Requested sector not found');
$05 : writeln('Disk error: Reset failed');
$06 : writeln('Disk error: Floppy disk removed');
$07 : writeln('Disk error: Bad parameter table');
$08 : writeln('Disk error: DMA overrun');
$09 : writeln('Disk error: DMA crossed 64KB boundary');
$0A : writeln('Disk error: Bad sector flag set');
$0B : writeln('Disk error: Bad track flag set');
$0C : writeln('Disk error: Requested media type not found');
$0D : writeln('Disk error: Invalid number of sectors on format');
$0E : writeln('Disk error: Control data address mark detected');
$0F : writeln('Disk error: DMA arbitration level out of range');
$10 : writeln('Disk error: Uncorrectable CRC or ECC data error');
$11 : writeln('Disk warning: ECC corrected data error');
$20 : writeln('Disk error: Controller failed');
$40 : writeln('Disk error: Seek failed');
$80 : writeln('Disk error: Disk has timed out');
$AA : writeln('Disk error: Drive not ready');
$BB : writeln('Disk error: Error is undefined');
$CC : writeln('Disk error: Write fault');
$E0 : writeln('Disk error: Status register error');
$FF : writeln('Disk error: Sense operation failed');
else
writeln('Unknown INT 13 return status ',istat);
end;
halt;
end;
end; { disk_err }
procedure test_disk(disk : byte);
{----------------------------------------------------------------------------
| This procedure, which contains the actual disk test routines, does the |
| following: |
| 1. Seeks the test disk to track 0. |
| 2. Times 100 calls to seek to track 0. Since the heads are already |
| on track 0, they will not move, and a estimate of the software |
| overhead for each seek call can be made. |
| 3. Times single track seeks to all cylinders (0-1,1-2,2-3,3-4,etc). |
| This provides a measurement of single track seek time. |
| 4. Seeks from track 0 to all tracks (0-1,0-2,0-3,0-4,etc). This |
| provides average seek time for the entire disk. |
| 5. The results are reported. |
| |
| TP intr() is used to call the ROM BIOS. There is some software |
| overhead incurred using this method. |
| |
| Globals referenced: regs |
| |
| Arguments: (char) disk - physical disk # - add to $80 for BIOS call. |
| |
| Returns : void |
----------------------------------------------------------------------------}
var
maxhead,maxcyl,indx : integer;
seek1,seek2,seek3,hits1,hits2,hits3 : longint;
begin
regs.dl := $80 + disk; { get disk config }
regs.ah := $08;
intr($13,regs);
if ( (regs.flags and Fcarry) <> 0) then disk_err(regs.ah);
maxhead := regs.dh; { move bits to get }
maxcyl := ((regs.cl and $C0) shl 2) + regs.ch; { heads & tracks }
writeln;
writeln('Physical drive ',disk,' shows ',maxcyl+1,' cylinders, ',maxhead+1,' heads');
writeln;
writeln('Starting track to track seek test ...');
regs.ah := $0C; { seek command }
regs.ch := $00; { track 0 }
regs.cl := $01; { XTs need sector bit set, or no seek }
regs.dh := 0; { head 0 }
regs.dl := $80 + disk; { disk # }
intr($13,regs); { seek to track 0 }
if ( (regs.flags and Fcarry) <> 0) then disk_err(regs.ah);
for indx := 1 to 100 do { seek to 0 100 times to get ave overhead }
begin
regs.ah := $0C; { seek command }
regs.ch := $00; { track 0 }
regs.cl := $01; { XTs need sector bit set, or no seek }
regs.dh := 0; { head 0 }
regs.dl := $80 + disk; { disk # }
t_entry(3);
intr($13,regs);
t_exit(3);
end;
for indx := 1 to maxcyl do { from zero, single track seek to end of disk }
begin
regs.ah := $0C; { seek command }
regs.ch := indx and $00FF; { mask track bits and stuff in cl & ch }
regs.cl := ((indx and $0300) shr 2) + 1; { cl sector bit 1 for XTs }
regs.dh := 0; { head 0 }
regs.dl := $80 + disk; { disk # }
t_entry(1);
intr($13,regs); { seek }
t_exit(1);
if ( (regs.flags and Fcarry) <> 0) then disk_err(regs.ah);
if ((indx mod 100) = 0) then write(indx,' '); { echo to user our progress }
end;
writeln;
writeln;
writeln('Starting full disk seek test ...');
regs.ah := $0C;
regs.ch := $00; { back to track 0 for next test }
regs.cl := $01; { sector bit for XTs }
regs.dh := 0;
regs.dl := $80 + disk;
intr($13,regs); { seek }
if ( (regs.flags and Fcarry) <> 0) then disk_err(regs.ah);
for indx := 1 to maxcyl do { from track 0, seek to all tracks }
begin
regs.ah := $0C;
regs.ch := indx and $00FF; { mask tracks bits and stuff in cl & ch }
regs.cl := ((indx and $0300) shr 2) + 1; { cl sector bit 1 for XTs }
regs.dh := 0;
regs.dl := $80 + disk;
t_entry(2);
intr($13,regs); { seek }
t_exit(2);
if ( (regs.flags and Fcarry) <> 0) then disk_err(regs.ah);
if ((indx mod 100) = 0) then write(indx,' '); { echo to user our progress }
regs.ah := $0C;
regs.ch := $00; { go back to track 0 for next seek }
regs.cl := $01;
regs.dh := 0;
regs.dl := $80 + disk;
intr($13,regs);
if ( (regs.flags and Fcarry) <> 0) then disk_err(regs.ah);
end;
t_ask_timer(1,hits1,seek1); { query timers }
t_ask_timer(2,hits2,seek2);
t_ask_timer(3,hits3,seek3);
writeln;
writeln;
writeln('Test of physical disk ',disk,' complete.');
writeln('Average track to track seek ........... ',((seek1/hits1)/1000.0):7:3,' milliseconds');
writeln('Average seek to all tracks ............ ',((seek2/hits2)/1000.0):7:3,' milliseconds');
writeln('Estimated software overhead per seek .. ',((seek3/hits3)/1000.0):7:3,' milliseconds');
t_reset(1); { reset all timers }
t_reset(2);
t_reset(3);
end; { test_disk }
begin
t_start; { start TPHRT }
writeln('SeekTest V1.00. TPHRT V2.00 Demonstration Series');
writeln('(c)1989 Ryle Design, P.O. Box 22, Mt. Pleasant, Michigan 48804');
writeln;
write('Checking equipment ... ');
regs.ah := $08;
regs.dl := $80;
intr($13,regs); { get available physical disks }
if ( (regs.flags and Fcarry) <> 0) then
begin
writeln('There are no hard disks on this system!');
writeln('SeekTest complete');
halt;
end;
numdisk := regs.dl; { DL has total disks on controller }
writeln(numdisk,' physical hard disk(s) found');
writeln;
writeln('*** WARNING -- Do not proceed unless the test disk is backed up!'); { A word of advice ... }
repeat
writeln;
for indx := 0 to (numdisk-1) do writeln(indx,' ... Test disk ',indx);
writeln(numdisk,' ... Exit SeekTest');
repeat
write('Select disk or exit (0-',numdisk,') >> ');
readln(atom);
until ( (atom >= 0) and (atom <= numdisk) );
if (atom = numdisk) then
begin
t_stop; { shut down TPHRT before exit }
writeln('SeekTest complete');
halt;
end;
test_disk(atom);
until (atom = numdisk);
end. { seektest }