Love this site? Hate it? Leave us some comments.

View \SEEKTEST.PAS

Hard Disk Benchmark Utility

Submitted By: WEBMASTER
Rating: (Not rated) (Rate It)


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 }

corner
© 1996-2008. All rights reserved. Reproduction in whole or in part, in any form or medium without express written permission is prohibited.
Violators of this policy may be subject to legal action. Please read our Terms Of Use and Privacy Statement for more information.
Publisher: Lars Hagelin.
bootstrapLabs Logo A bootstrapLabs project.