home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / TPHRT3.ZIP / SEEKTEST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-07-18  |  19.1 KB  |  431 lines
  1. program seektest;
  2. {----------------------------------------------------------------------------
  3.  |  Program SEEKTEST.PAS                                                    |
  4.  |                                                                          |
  5.  |  This program demonstrates the use of TPHRT in timing seek performance   |
  6.  |  of a PC based hard disk drive.  The method used will determine the total|
  7.  |  seek time of the device which includes actual disk seek, controller     |
  8.  |  overhead, and ROM BIOS overhead.  This is a "real world" measurement    |
  9.  |  of disk performance under actual usage conditions.                      |
  10.  |                                                                          |
  11.  |  This program uses both inline generic timers and BIOS interrupt         |
  12.  |  timers to measure disk performance.                                     |
  13.  |                                                                          |
  14.  |  (c)1989 Ryle Design, P.O. Box 22, Mt. Pleasant, Michigan 48804          |
  15.  |                                                                          |
  16.  |  V3.00 Shareware Evaluation Version                                      |
  17.  ----------------------------------------------------------------------------}
  18. uses
  19.     dos, crt, tphrt;
  20.  
  21. var
  22.     regs    : registers;
  23.     indx    : integer;
  24.     numdisk : integer;
  25.     atom    : byte;
  26.     keyin   : char;
  27.     dodad   : byte;
  28.  
  29.  
  30. procedure disk_err(istat : integer);
  31. {----------------------------------------------------------------------------
  32.  |  This procedure outputs a description of an INT $13 error status, and    |
  33.  |  halts program execution.                                                |
  34.  |                                                                          |
  35.  |  Globals referenced: none                                                |
  36.  |                                                                          |
  37.  |  Arguments: (integer) istat - status returned from INT $13 in AH if      |
  38.  |                               carry flag set.                            |
  39.  |                                                                          |
  40.  |  Returns  : void                                                         |
  41.  ----------------------------------------------------------------------------}
  42. begin
  43.     if (istat <> 0) then
  44.     begin
  45.         case istat of
  46.             $01 : writeln('Disk error: Invalid command');
  47.             $02 : writeln('Disk error: Address mark not found');
  48.             $03 : writeln('Disk error: Disk is write-protected');
  49.             $04 : writeln('Disk error: Requested sector not found');
  50.             $05 : writeln('Disk error: Reset failed');
  51.             $06 : writeln('Disk error: Floppy disk removed');
  52.             $07 : writeln('Disk error: Bad parameter table');
  53.             $08 : writeln('Disk error: DMA overrun');
  54.             $09 : writeln('Disk error: DMA crossed 64KB boundary');
  55.             $0A : writeln('Disk error: Bad sector flag set');
  56.             $0B : writeln('Disk error: Bad track flag set');
  57.             $0C : writeln('Disk error: Requested media type not found');
  58.             $0D : writeln('Disk error: Invalid number of sectors on format');
  59.             $0E : writeln('Disk error: Control data address mark detected');
  60.             $0F : writeln('Disk error: DMA arbitration level out of range');
  61.             $10 : writeln('Disk error: Uncorrectable CRC or ECC data error');
  62.             $11 : writeln('Disk warning: ECC corrected data error');
  63.             $20 : writeln('Disk error: Controller failed');
  64.             $40 : writeln('Disk error: Seek failed');
  65.             $80 : writeln('Disk error: Disk has timed out');
  66.             $AA : writeln('Disk error: Drive not ready');
  67.             $BB : writeln('Disk error: Error is undefined');
  68.             $CC : writeln('Disk error: Write fault');
  69.             $E0 : writeln('Disk error: Status register error');
  70.             $FF : writeln('Disk error: Sense operation failed');
  71.         else
  72.             writeln('Unknown INT 13 return status ',istat);
  73.         end;
  74.  
  75.         halt;
  76.     end;
  77. end; { disk_err }
  78.  
  79.  
  80. procedure test_disk(which_disk : byte);
  81. {----------------------------------------------------------------------------
  82.  |  This procedure, which contains the actual disk test routines, does the  |
  83.  |  following:                                                              |
  84.  |      1. Seeks the test disk to track 0.                                  |
  85.  |      2. Times 100 calls to seek to track 0.  Since the heads are already |
  86.  |         on track 0, they will not move, and a estimate of the software   |
  87.  |         overhead for each seek call can be made.                         |
  88.  |      3. Times single track seeks to all cylinders (0-1,1-2,2-3,3-4,etc). |
  89.  |         This provides a measurement of single track seek time.           |
  90.  |      4. Seeks from track 0 to all tracks (0-1,0-2,0-3,0-4,etc).  This    |
  91.  |         provides average seek time for the entire disk.                  |
  92.  |      5. The results are reported.                                        |
  93.  |                                                                          |
  94.  |  TP intr() is used to call the ROM BIOS.  There is some software         |
  95.  |  overhead incurred using this method.                                    |
  96.  |                                                                          |
  97.  |  Globals referenced: regs                                                |
  98.  |                                                                          |
  99.  |  Arguments: (char) which_disk - physical disk # - add to $80 & call      |
  100.  |                                                                          |
  101.  |  Returns  : void                                                         |
  102.  ----------------------------------------------------------------------------}
  103. var
  104.     maxhead,maxcyl,indx                     : integer;
  105.     seek1,seek2,seek3,hits1,hits2,hits3     : longint;
  106.  
  107. begin
  108.  
  109.     regs.dl := $80 + which_disk;                                  { get disk config }
  110.     regs.ah := $08;
  111.     intr($13,regs);
  112.     if ( (regs.flags and Fcarry) <> 0) then disk_err(regs.ah);
  113.  
  114.     maxhead := regs.dh;                                     { move bits to get }
  115.     maxcyl := ((regs.cl and $C0) shl 2) + regs.ch;          { heads & tracks   }
  116.  
  117.     writeln;
  118.     writeln('Physical drive ',which_disk,' shows ',maxcyl+1,' cylinders, ',maxhead+1,' heads');
  119.     writeln;
  120.  
  121.     writeln('Starting single track seek test ...');
  122.  
  123.     regs.ah := $0C;                                         { seek command                        }
  124.     regs.ch := $00;                                         { track 0                             }
  125.     regs.cl := $01;                                         { XTs need sector bit set, or no seek }
  126.     regs.dh := 0;                                           { head 0                              }
  127.     regs.dl := $80 + which_disk;                                  { disk #                              }
  128.  
  129.     intr($13,regs);                                         { seek to track 0 }
  130.     if ( (regs.flags and Fcarry) <> 0) then disk_err(regs.ah);
  131.  
  132.     for indx := 1 to 100 do                                 { seek to 0 100 times to get ave overhead }
  133.     begin
  134.         regs.ah := $0C;                                     { seek command                        }
  135.         regs.ch := $00;                                     { track 0                             }
  136.         regs.cl := $01;                                     { XTs need sector bit set, or no seek }
  137.         regs.dh := 0;                                       { head 0                              }
  138.         regs.dl := $80 + which_disk;                              { disk #                              }
  139.  
  140.         t_entry(3);
  141.         intr($13,regs);
  142.         t_exit(3);
  143.     end;
  144.  
  145.     for indx := 1 to maxcyl do                              { from zero, single track seek to end of disk }
  146.     begin
  147.         regs.ah := $0C;                                     { seek command                         }
  148.         regs.ch := indx and $00FF;                          { mask track bits and stuff in cl & ch }
  149.         regs.cl := ((indx and $0300) shr 2) + 1;            { cl sector bit 1 for XTs              }
  150.         regs.dh := 0;                                       { head 0                               }
  151.         regs.dl := $80 + which_disk;                              { disk #                               }
  152.  
  153.         t_entry(1);
  154.         intr($13,regs);                                     { seek }
  155.         t_exit(1);
  156.  
  157.         if ( (regs.flags and Fcarry) <> 0) then disk_err(regs.ah);
  158.  
  159.         if ((indx mod 100) = 0) then write(indx,' ');       { echo to user our progress }
  160.     end;
  161.  
  162.     writeln;
  163.     writeln;
  164.     writeln('Starting full disk seek test ...');
  165.  
  166.     regs.ah := $0C;
  167.     regs.ch := $00;                                         { back to track 0 for next test }
  168.     regs.cl := $01;                                         { sector bit for XTs            }
  169.     regs.dh := 0;
  170.     regs.dl := $80 + which_disk;
  171.     intr($13,regs);                                         { seek }
  172.  
  173.     if ( (regs.flags and Fcarry) <> 0) then disk_err(regs.ah);
  174.  
  175.     for indx := 1 to maxcyl do                              { from track 0, seek to all tracks }
  176.     begin
  177.         regs.ah := $0C;
  178.         regs.ch := indx and $00FF;                          { mask tracks bits and stuff in cl & ch }
  179.         regs.cl := ((indx and $0300) shr 2) + 1;            { cl sector bit 1 for XTs               }
  180.         regs.dh := 0;
  181.         regs.dl := $80 + which_disk;
  182.  
  183.         t_entry(2);
  184.         intr($13,regs);                                     { seek }
  185.         t_exit(2);
  186.  
  187.         if ( (regs.flags and Fcarry) <> 0) then disk_err(regs.ah);
  188.  
  189.         if ((indx mod 100) = 0) then write(indx,' ');       { echo to user our progress }
  190.  
  191.         regs.ah := $0C;
  192.         regs.ch := $00;                                     { go back to track 0 for next seek }
  193.         regs.cl := $01;
  194.         regs.dh := 0;
  195.         regs.dl := $80 + which_disk;
  196.         intr($13,regs);
  197.  
  198.         if ( (regs.flags and Fcarry) <> 0) then disk_err(regs.ah);
  199.  
  200.     end;
  201.  
  202.     t_ask_timer(1,hits1,seek1);                             { query timers }
  203.     t_ask_timer(2,hits2,seek2);
  204.     t_ask_timer(3,hits3,seek3);
  205.  
  206.     writeln;
  207.     writeln;
  208.     writeln('Test of physical disk ',which_disk,' with source timers complete.');
  209.     writeln('Average single track seek ............. ',((seek1/hits1)/1000.0):7:3,' milliseconds');
  210.     writeln('Average seek to all tracks ............ ',((seek2/hits2)/1000.0):7:3,' milliseconds');
  211.     writeln('Estimated software overhead per seek .. ',((seek3/hits3)/1000.0):7:3,' milliseconds');
  212.  
  213.     t_reset(1);                                             { reset all timers }
  214.     t_reset(2);
  215.     t_reset(3);
  216.  
  217. end; { test_disk }
  218.  
  219.  
  220. procedure test_disk_bios(which_disk : byte);
  221. {----------------------------------------------------------------------------
  222.  |  This procedure is identical to test_disk but utilizes BIOS interrupt    |
  223.  |  timing to time the disk activity.  This is an excellant tutorial on the |
  224.  |  t_bios timer functions.                                                 |
  225.  |                                                                          |
  226.  |  TP intr() is used to call the ROM BIOS.  There is some software         |
  227.  |  overhead incurred using this method.                                    |
  228.  |                                                                          |
  229.  |  Globals referenced: regs                                                |
  230.  |                                                                          |
  231.  |  Arguments: (char) which_disk - physical disk # - add to $80 & call      |
  232.  |                                                                          |
  233.  |  Returns  : void                                                         |
  234.  ----------------------------------------------------------------------------}
  235. var
  236.     maxhead,maxcyl,indx                     : integer;
  237.     seek1,seek2,seek3,hits1,hits2,hits3     : longint;
  238.  
  239. begin
  240.  
  241.     t_bios_start(DISK);
  242.  
  243.     regs.dl := $80 + which_disk;                                  { get disk config }
  244.     regs.ah := $08;
  245.     intr($13,regs);
  246.     if ( (regs.flags and Fcarry) <> 0) then disk_err(regs.ah);
  247.  
  248.     maxhead := regs.dh;                                     { move bits to get }
  249.     maxcyl := ((regs.cl and $C0) shl 2) + regs.ch;          { heads & tracks   }
  250.  
  251.     writeln;
  252.     writeln('Physical drive ',which_disk,' shows ',maxcyl+1,' cylinders, ',maxhead+1,' heads');
  253.     writeln;
  254.  
  255.     writeln('Starting single track seek test ...');
  256.  
  257.     regs.ah := $0C;                                         { seek command                        }
  258.     regs.ch := $00;                                         { track 0                             }
  259.     regs.cl := $01;                                         { XTs need sector bit set, or no seek }
  260.     regs.dh := 0;                                           { head 0                              }
  261.     regs.dl := $80 + which_disk;                                  { disk #                              }
  262.  
  263.     intr($13,regs);                                         { seek to track 0 }
  264.     if ( (regs.flags and Fcarry) <> 0) then
  265.     begin
  266.         t_bios_stop;
  267.         disk_err(regs.ah);
  268.     end;
  269.  
  270.     t_bios_reset(DISK,$0C);                                 { zero the seek function timer }
  271.  
  272.     for indx := 1 to 100 do                                 { seek to 0 100 times to get ave overhead }
  273.     begin
  274.         regs.ah := $0C;                                     { seek command                        }
  275.         regs.ch := $00;                                     { track 0                             }
  276.         regs.cl := $01;                                     { XTs need sector bit set, or no seek }
  277.         regs.dh := 0;                                       { head 0                              }
  278.         regs.dl := $80 + which_disk;                              { disk #                              }
  279.  
  280.         intr($13,regs);
  281.     end;
  282.  
  283.     t_bios_ask(DISK,$0C,hits3,seek3);
  284.     t_bios_reset(DISK,$0C);
  285.  
  286.     for indx := 1 to maxcyl do                              { from zero, single track seek to end of disk }
  287.     begin
  288.         regs.ah := $0C;                                     { seek command                         }
  289.         regs.ch := indx and $00FF;                          { mask track bits and stuff in cl & ch }
  290.         regs.cl := ((indx and $0300) shr 2) + 1;            { cl sector bit 1 for XTs              }
  291.         regs.dh := 0;                                       { head 0                               }
  292.         regs.dl := $80 + which_disk;                              { disk #                               }
  293.  
  294.         intr($13,regs);                                     { seek }
  295.  
  296.         if ( (regs.flags and Fcarry) <> 0) then
  297.         begin
  298.             t_bios_stop;
  299.             disk_err(regs.ah);
  300.         end;
  301.     
  302.         if ((indx mod 100) = 0) then write(indx,' ');       { echo to user our progress }
  303.     end;
  304.  
  305.     t_bios_ask(DISK,$0C,hits1,seek1);
  306.  
  307.     writeln;
  308.     writeln;
  309.     writeln('Starting full disk seek test ...');
  310.  
  311.     regs.ah := $0C;
  312.     regs.ch := $00;                                         { back to track 0 for next test }
  313.     regs.cl := $01;                                         { sector bit for XTs            }
  314.     regs.dh := 0;
  315.     regs.dl := $80 + which_disk;
  316.     intr($13,regs);                                         { seek }
  317.  
  318.  
  319.     if ( (regs.flags and Fcarry) <> 0) then
  320.     begin
  321.         t_bios_stop;
  322.         disk_err(regs.ah);
  323.     end;    
  324.  
  325.     t_bios_reset(DISK,$0C);
  326.  
  327.     for indx := 1 to maxcyl do                              { from track 0, seek to all tracks }
  328.     begin
  329.         regs.ah := $0C;
  330.         regs.ch := indx and $00FF;                          { mask tracks bits and stuff in cl & ch }
  331.         regs.cl := ((indx and $0300) shr 2) + 1;            { cl sector bit 1 for XTs               }
  332.         regs.dh := 0;
  333.         regs.dl := $80 + which_disk;
  334.  
  335.         intr($13,regs);                                     { seek }
  336.  
  337.         if ( (regs.flags and Fcarry) <> 0) then
  338.         begin
  339.             t_bios_stop;
  340.             disk_err(regs.ah);
  341.         end;    
  342.  
  343.         if ((indx mod 100) = 0) then write(indx,' ');       { echo to user our progress }
  344.  
  345.         regs.ah := $0C;
  346.         regs.ch := $00;                                     { go back to track 0 for next seek }
  347.         regs.cl := $01;
  348.         regs.dh := 0;
  349.         regs.dl := $80 + which_disk;
  350.         intr($13,regs);
  351.  
  352.         if ( (regs.flags and Fcarry) <> 0) then
  353.         begin
  354.             t_bios_stop;
  355.             disk_err(regs.ah);
  356.         end;    
  357.  
  358.     end;
  359.  
  360.     t_bios_ask(DISK,$0C,hits2,seek2);
  361.  
  362.     writeln;
  363.     writeln;
  364.     writeln('Test of physical disk ',which_disk,' with BIOS timers complete.');
  365.     writeln('Average single track seek ............. ',((seek1/hits1)/1000.0):7:3,' milliseconds');
  366.     writeln('Average seek to all tracks ............ ',((seek2/hits2)/1000.0):7:3,' milliseconds');
  367.     writeln('Estimated software overhead per seek .. ',((seek3/hits3)/1000.0):7:3,' milliseconds');
  368.  
  369.     t_bios_stop;
  370.  
  371. end; { test_disk_bios }
  372.  
  373.  
  374.  
  375. begin
  376.  
  377.     t_start;                                                { start TPHRT }
  378.  
  379.     writeln('SeekTest  TPHRT V3 Demonstration Series');
  380.     writeln;
  381.     write('Checking equipment ... ');
  382.  
  383.     regs.ah := $08;
  384.     regs.dl := $80;
  385.     intr($13,regs);                                         { get available physical disks }
  386.  
  387.     if ( (regs.flags and Fcarry) <> 0) then
  388.     begin
  389.         writeln('There are no hard disks on this system!');
  390.         writeln('SeekTest complete');
  391.         halt;
  392.     end;
  393.  
  394.     numdisk := regs.dl;                                     { DL has total disks on controller }
  395.     writeln(numdisk,' physical hard disk(s) found');
  396.     writeln;
  397.     writeln('*** WARNING -- Do not proceed unless the test disk is backed up!');     { A word of advice ... }
  398.     repeat
  399.         writeln;
  400.         for indx := 0 to (numdisk-1) do writeln(indx,' ... Test disk ',indx);
  401.         writeln(numdisk,' ... Exit SeekTest');
  402.         repeat
  403.             write('Select disk or exit (0-',numdisk,') >> ');
  404.             readln(atom);
  405.         until ( (atom >= 0) and (atom <= numdisk) );
  406.  
  407.         if (atom = numdisk) then
  408.         begin
  409.             t_stop;                                         { shut down TPHRT before exit }
  410.             writeln('SeekTest complete.');
  411.             halt;
  412.         end;
  413.  
  414.         repeat
  415.             writeln;
  416.             writeln('Test with source or BIOS timers?');
  417.             writeln('0 .... Source timers');
  418.             writeln('1 .... BIOS timers');
  419.             write('Source or BIOS timers (0-1) >> ');
  420.             readln(dodad);
  421.         until ( (dodad >= 0) and (dodad <= 1) );
  422.         
  423.         if (dodad = 0) then
  424.             test_disk(atom)
  425.         else
  426.             test_disk_bios(atom);
  427.  
  428.     until (atom = numdisk);
  429.  
  430. end.  { seektest }
  431.