DOS Disk Tester Source Code
Jump to navigation
Jump to search
Source code for a simple DOS Disk Tester, which can be compiled using Turbo Pascal 6. Compiled code can be downloaded here.
Code
Program DiskTest;
{$M 8192, 131072, 131072}
{$N+ enable FPU, for scaling of output on pattern tests}
{$E+ enable FPU emulation if FPU not present}
{IOMeter type performance tests for XT/AT PCs with MS-DOS.
Used for the development of the Dangerous Prototype XT-IDE board, and
subsequently the lo-tech XT-CF board.
Includes pattern tests for testing 8-bit interface reliability and
to generate patterns to check with a scope attached.
Performance Testing
===================
By default, creates a 4MB file in the current working directory using
32K IOs. Then reads it back also using 32K IOs.
Next performs two random workload tests on it:
- 70% read, using 8K IOs (8K aligned)
- 100% read, using 512-byte IOs (sector aligned)
Finally displays the results, with speed calculated based on the system
clock. Note therefore that any hardware causing clock-skew via extended
disabling of interupts (causing loss of timer ticks) will cause results
to be overstated.
Pattern Testing
===============
For media testing, 'mediatest' command line option runs a 10-pass
pattern test. Default file size is 4MB; this can be extended to all
available free space by also specifying 'maxsize'. As with the performance
test, test size will be automatically truncated to available disk space.
Tests are potentially time consuming - can skip on (to the next part) by
pressing any key. Progress is shown onscreen though.
For interface testing, special patterns can be tested using the command
line option 'signaltest'. This option runs patterns that enable
assessment of signal quality with an osciloscope:
Test 1 - For testing at DD7. Flips the bit continually, all others
will be low. Line DD7 has a 10k pull-down at the interface.
Test 2 - For testing at DD11. Holds the bit low and flips all other
bits continually. Enables measurement of cross-talk as the
line serving this bit is in the middle of the data lines on
the 40-pin connector.
Test 3 - For testing on the ISA Bus at data bit 4 (ISA slot pin A5).
To enable assessment of signal quality on the ISA bus.
Flips this bit repeatedly.
By James Pearce, lo-tech.co.uk
v1.0 - 06-May-10
- Initial build 32K read and write and 8k random
v1.1 - 15-Apr-11
- Fixed transfer sizes (were 512-bytes too large)
v1.2 - 26-Apr-11:
- Added 512-byte random read test
- note random r-w at sector level would be misleading due
to variable DOS cluster sizes. Writes less than a cluster
must be performed as read-update-write.
- Added automatic reduction of test file size depending on free
space available.
- Added command line options (any order):
- 'maxsize', to test with maximum free space of drive
- 'maxseeks', to test random with 4096 seeks (default is 256)
- 'highseeks', to test random with 1024 seeks
- 'lowseeks', to test random with 128 seeks
- 'minseeks', to test random with 32 seeks (for floppys)
- '-h' or '/h' or '/?' to display a command line reference
v1.3 - 08-Sep-11:
- Added 'testintegrity' option, which performs extended pattern
testing and reports on any errors encountered (instead of the
performance tests).
v1.4 - 10-Sep-11:
- Revised checking method to detect errors for integrity test
- Added run-time and error notification to end of test
- Increased to 10 patterns
- Added progress indicators and some formating to ensure entire
test info will always show on one screen, regardless of test
file size.
- Made pattern tests 'two dimensional', to test interface integrity
too (i.e. individual bits in consecutive words transferred will
change)
- Added 'crosstalktest' option (for XT-IDE prototype scoping, see
below)
v1.5 - 14-Sep-11:
- Renamed and extended pattern tests
- Revised most parts for efficiency
- Set memory limits to ensure will run on 256K XT
- consolidated pattern test code
- added option 'cycle' to shift bits for every word on media-test
v1.6 - 19-Sep-11:
- Changed pattern test procedure to a function (returns no. of errors)
- Revised display scaling code in pattern test
- Added operational indication to performance tests
- Added ability to completely terminate pattern tests (press 'Q')
v1.7 - 14-Feb-12:
- Added "size=" parameter to enable test size to be directly set.
Specified size can include K or M for KB or MB respecitively.
Specified size must be >64KB, and will be truncated to avaulable
disk space. E.g: size=8M will define an 8MB test file, if that
much space is available.
v1.8 - 16-Feb-12:
- Added 'powertest' to signal test function and refined pattern
writing utility to support looping operation (to support it).
The powertest mode continually reads or writes 0x55AA 0xAA55 pairs
as fast as possible (without verifying), simply wrapping at the end
of the test file size allocated repeatedly until the test is
terminated by the user.
By flipping all 16-bits on every word, and all 8-bits on every
byte, power consumption of the card should be maximised, hence
allowing measurement of power drawn of the card in this worst-case
test pattern.
- Re-designed help screens as too much for one 80x25 page
v1.9 - 10-Apr-12
- Changed pattern definitions to consider the two seperate 8-bit transfers
more closely. Patterns are now:
0,$FFFF,$F0F0,$CCCC,$AAAA,$AA55,$A5A5,$FF00,$18E7,$E718
v2.0 - 29-Apr-12
- Added readonly test option.
v2.1 - 30-Apr-12
- Re-coded block comparison function in pattern tests; testing
now runs *much* faster on XT class hardware (5x).
v2.2 - 01-May-12
- Changed pattern testing to include both static patterns and
walking-ones / walking-zeros tests. Basic patterns are now:
0,$FFFF,$FF00,$F00F,$AA55,$A55A,$18E7,$E718, then
walking-1s and walking-0s.
Cycle option has been removed.
v2.3 - 04-May-12
- Added RAM test to the pattern test routine.
- Added 'noprogress' switch to surpress screen progress marks on
performance tests.
}
Uses Dos, Crt;
TYPE
Sector = array[0..255] of word; {512 bytes}
T32kArray = array[0..16383] of word; {32KB}
P32kArray = ^T32kArray;
T8kArray = array[0..8191] of word; {8k}
P8kArray = ^T8kArray;
CONST
TestSize : LongInt = 4194304; {4MB}
FName : String = 'TEST$$$.FIL';
Seeks : Word = 256;
PatternTests : Byte = 10;
Patterns : Array[1..10] of Word =
(0,$FFFF,$FF00,$F00F,$AA55,$A55A,$18E7,$E718,$0001,$FFFE);
PatternCycle : Array[1..10] of Byte =
(0, 0, 0, 0, 0, 0, 0, 0, 1, 1);
PatternNames : Array[1..10] of String[10] =
('','','','','','','','','Walking 1s','Walking 0s');
PowerPatterns : Array[1..2] of Word = ($55AA,$AA55);
VERSION : String = '2.3';
DisplayCodesCount : Byte = 4;
DisplayCodes : Array[1..4] of Char = ('-','\','|','/');
{Pattern test writer modes}
PatRead : Byte = 1;
PatReadContinuous : Byte = 2;
PatWrite : Byte = 4;
PatWriteContinuous : Byte = 8;
PatVerify : Byte = 16;
PatPrompt : Byte = 32;
VAR
Time : Real;
QUIT : Boolean;
noprogress : Boolean;
procedure StartClock;
var
hr, min, sec, sec100 : word;
begin
GetTime(hr,min,sec,sec100);
Time := (hr * 3600) + (min * 60) + sec + (sec100 / 100);
end;{StartClock}
function StopClock : Real;
var
hr, min, sec, sec100 : word;
Time2 : real;
begin
GetTime(hr,min,sec,sec100);
Time2 := (hr * 3600) + (min * 60) + sec + (sec100 / 100);
If Time2 = Time then
StopClock := 0.01 {prevent div by 0}
else
StopClock := (Time2 - Time);
end;{StopClock}
function CreateFile : Real;
{creates the file and returns the rate in KB/s}
var
f : file of T32kArray;
buffer : P32kArray;
i : word;
max : word;
res : word;
Mark, X, Y : Byte;
begin
Assign(f,FName);
Rewrite(f);
new(buffer);
max := TestSize div SizeOf(T32kArray);
X := WhereX; Y := WhereY;
Mark := 1;
StartClock;
{now do the write test}
if noprogress then
begin
for i := 1 to max do
write(f,buffer^);
end else begin
for i := 1 to max do
begin
Inc(Mark);
If Mark > DisplayCodesCount then Mark := 1;
write(DisplayCodes[Mark]);
GotoXY(X,Y);
write(f,buffer^);
end;{for}
end;{if/else}
close(f);
CreateFile := TestSize / 1024 / StopClock;
Dispose(buffer);
end;{createfile}
function ReadFile : Real;
{reads the file and returns the rate in KB/s}
var
f : file of T32kArray;
buffer : P32kArray;
i : word;
max : word;
res : word;
Mark, X, Y : Byte;
begin
Assign(f,FName);
Filemode := 0; {open read-only}
Reset(f);
new(buffer);
max := TestSize div SizeOf(T32kArray);
X := WhereX; Y := WhereY;
Mark := 1;
StartClock;
{now do the read test}
if noprogress then
begin
for i := 1 to max do
read(f,buffer^);
end else begin
for i := 1 to max do
begin
Inc(Mark);
If Mark > DisplayCodesCount then Mark := 1;
write(DisplayCodes[Mark]);
GotoXY(X,Y);
read(f,buffer^);
end;{for i}
end;{if/else}
close(f);
ReadFile := TestSize / 1024 / StopClock;
dispose(buffer);
end;{createfile}
function RandomTest( transfersize : word; readpercent : byte ) : Real;
{Random IOPS test, returns the rate in IOPS
Tests IOs of up to 32K each - transfersize is the size in bytes
readpercent is percentage that should be reads (50 = 50%)}
type
PositionArray = array[1..4096] of LongInt;
var
f : file;
buffer : P32kArray;
i, n : word;
max : LongInt;
p1, p2 : word;
max1, max2 : word;
res : word;
p : LongInt;
Positions : ^PositionArray;
limit : byte;
Mark, X, Y : Byte;
TimeInSeeks,
TimeInTransfers : Real;
begin
Randomize;
Assign(f,FName);
if readpercent = 100 then
Filemode := 0 {open read-only}
else Filemode := 2; {open read/write}
Reset(f,1);
max := TestSize - transfersize; {take off the transfer size to allow for
the last block}
max1 := max SHR 16;
max2 := max AND 65535;
p1 := 0;
new(Positions);
new(buffer);
for i := 1 to Seeks do begin
{create an array of seek positions (in bytes)}
if max1 > 0 then p1 := Random(max1);
p2 := Random(max2);
p := (longint(p1) SHL 16) + (p2 AND $FE00); {sector align}
Positions^[i] := p;
end;{for}
n := 1;
X := WhereX; Y := WhereY;
Mark := 1;
limit := readpercent div 10;
StartClock;
TimeInSeeks := 0; TimeInTransfers := 0;
{do the random IO test}
for i := 1 to Seeks do begin
if not noprogress then
begin
Inc(Mark);
If Mark > DisplayCodesCount then Mark := 1;
write(DisplayCodes[Mark]);
GotoXY(X,Y);
end;{if not noprogress}
seek(f,Positions^[i]);
{n keeps track of reads and writes}
if n <= limit then
blockread(f,buffer^,transfersize)
else
blockwrite(f,buffer^, transfersize,res);
inc(n);
if n > 10 then n := 1;
end;{for}
close(f);
RandomTest := i / StopClock;
Dispose(buffer);
Dispose(Positions);
end;{RandomTest}
procedure PurgeTestFile;
{purges the contents of the test file, if it's present}
var f : file;
begin
Assign(f,FName);
Rewrite(f);
Truncate(f);
Close(f);
end;{procedure PurgeTestFile}
function CheckTestFile : LongInt;
{returns the size of the test file, if it can be found}
var f : file;
begin
Assign(f,FName);
Filemode := 0; {open readonly}
{$I-}
Reset(f,1);
{$I+}
If IOResult <> 0 then
CheckTestFile := 0
else begin
CheckTestFile := FileSize(f);
Close(f);
end;{if IOResult}
end;{function}
Function COMPSW( source, destination : pointer; words : word) : Word;
{implements COMPSW function, comparing source with destination on a
word-by-word basis, returning zero if they were OK}
var
rDS, rSI,
rES, rDI : Word;
BlockBad : Word;
begin
rDS := Seg(source^);
rSI := Ofs(source^);
rES := Seg(destination^);
rDI := Ofs(destination^);
asm
push ds
push si
push es
push di
mov ax, rDS
mov ds, ax
mov ax, rSI
mov si, ax
mov ax, rES
mov es, ax
mov ax, rDI
mov di, rDI
mov cx, words
cld
rep cmpsw
jz @NoDiffs
inc cx
@NoDiffs:
mov BlockBad, cx
pop di
pop es
pop si
pop ds
end;{asm}
COMPSW := BlockBad;
end;{function COMPSW}
Function PatternTest( WriteBlock, Rd : P32kArray; DisplayStr : string;
Mode : Byte ) : LongInt;
{writer for pattern testing. Returns the number of errors encountered.
See constants at the top for the mode options (which can be combined).
Also checks the two transfer buffers with the pattern in question first,
to avoid showing a RAM problem as a controller problem.}
var
f : file of T32kArray;
ErrCount,
TotalErrors : LongInt;
IO, j, i : Word;
max, readmax : LongInt;
Dots, Mark, Next,
CurrentDot : Byte;
CurrentPosition : Single;
X, Y, XBreak,
X1, X2, Y1 : Byte;
Ch : Char;
PromptStr : String;
begin
Assign(f,FName);
Filemode := 2;{read/write}
max := TestSize div SizeOf(T32KArray); {number of IOs for test}
readmax := max; {size of read test - will reduce if write phase is skipped}
TotalErrors := 0;
ErrCount := 0;
DisplayStr := DisplayStr + ' - Writing: ';
Dots := (78 - Length(DisplayStr) - Length(' Comparing: ')) div 2;
{Dots will be the number of dots to displayed during the test each way}
{write out info + get cursor position}
Write(DisplayStr);
X := WhereX; Y := WhereY;
X1 := X; Y1 := Y;
Ch := CHAR(0);
{now write out file - will always do this part}
repeat
GoToXY(X1,Y1);
for i := 1 to dots do write(' ');
GoToXY(X1,Y1);
X := X1;
Reset(f);
CurrentDot := 0;
Mark := 1;
for IO := 1 to max do
begin
{calculate when to write a dot on screen.}
CurrentPosition := IO * Dots / max;
{debug line follows - introduces an error on one 32K block written}
{if IO = 4 then write(f,Rd^) else}
write(f,WriteBlock^);
{now update screen}
Next := trunc(CurrentPosition);
if (Next > CurrentDot) then
begin
{time to advance dot(s) on screen}
repeat
Write('.');
Inc(X);
Inc(CurrentDot);
until CurrentDot = Next;
end else begin
Inc(Mark);
If Mark > DisplayCodesCount then Mark := 1;
write(DisplayCodes[Mark]);
GotoXY(X,Y);
end;
if KeyPressed then begin
while KeyPressed do Ch := ReadKey; {clear keyboard buffer}
if (Ch = ' ') and ((Mode AND PatWriteContinuous) = PatWriteContinuous) then
{space finishes the current write block, then skips}
Mode := Mode AND NOT PatWriteContinuous
else begin
readmax := IO; {record how many blocks were written}
IO := max; {end write loop}
if (readmax < max) then
begin
if X > (80 - Dots - Length(' Comparing: ') - Length('Skipped ')) then
GotoXY((80 - Dots - Length(' Comparing: ') - Length('Skipped ')),Y);
Write('Skipped ');
end;{if (readmax<max)}
If UpCase(Ch) = 'S' then readmax := 0
else if UpCase(Ch) = 'Q' then begin
QUIT := true;
readmax := 0;
end;{if/else}
end;{if Ch=' '}
end;{if keypressed}
end;
until (Ch<>CHAR(0)) OR ((Mode AND PatWriteContinuous) <> PatWriteContinuous);
If ((Mode AND PatPrompt) = PatPrompt) then
begin
if ((Mode AND PatVerify) = PatVerify) then
PromptStr := 'Verify '
else
PromptStr := 'Read ';
if ((Mode AND PatReadContinuous) = PatReadContinuous) then
PromptStr := PromptStr + '(C)ontinuous/';
PromptStr := PromptStr + '(O)nce/(N)o: ';
X2 := 78 - Dots - Length(PromptStr);
GotoXY( X2, Y );
Write(PromptStr);
If ((Mode AND PatReadContinuous) = PatReadContinuous) then
repeat
Ch := Upcase(ReadKey);
until Ch in ['C', 'O', 'N']
else
repeat
Ch := Upcase(ReadKey);
until Ch in ['O', 'N'];
case Ch of
'O' : mode := mode AND NOT PatReadContinuous; {user selected not continuous}
'N' : mode := 0; {nothing to do}
end;{case}
GotoXY( X2, Y );
for i := 1 to length(PromptStr) do
Write(' ');
end;{read and verify behaviour required check}
while keypressed do Ch := ReadKey; {clear keyboard buffer}
Ch := CHAR(0); {clear input}
while (Ch = CHAR(0)) AND (readmax > 0) AND ((mode AND PatRead) = PatRead) do
begin
{now read back and compare if verify was specified}
GotoXY( (78 - Dots - Length('Comparing: ')), Y );
if ((mode and PatVerify) = PatVerify) then
Write(' Comparing: ')
else Write(' Reading: ');
reset(f);
CurrentDot := 0;
X := WhereX;
for IO := 1 to readmax do
begin
{calculate when to write a dot on screen}
CurrentPosition := IO * Dots / readmax;
{read the block}
read(f,Rd^);
{find which dot we're on now}
Next := trunc(CurrentPosition);
{compare what was read with what was written, if we need to}
if ((mode AND PatVerify) = PatVerify) then
ErrCount := ErrCount + COMPSW(WriteBlock,Rd,16384);
{now update screen}
if (Next > CurrentDot) then
begin
{time to advance mark(s) on screen}
repeat
if ErrCount = 0 then Write('û')
else write('!');
Inc(X);
Inc(CurrentDot);
until CurrentDot = Next;
if ErrCount <> 0 then
begin
Inc(TotalErrors);
ErrCount := 0;
end;
end else begin
Inc(Mark);
If Mark > DisplayCodesCount then Mark := 1;
write(DisplayCodes[Mark]);
GotoXY(X,Y);
end;
{check if user has interupted}
if KeyPressed then begin
while KeyPressed do Ch := ReadKey; {clear keyboard buffer}
IO := readmax; {end read loop}
if X > (79 - Length('Skipped')) then
GotoXY((79 - Length('Skipped')),Y);
Write('Skipped');
if UpCase(Ch) = 'Q' then QUIT := true;
end;{if}
end;
If ((mode AND PatReadContinuous) <> PatReadContinuous) then
mode := mode XOR PatRead; {end while loop as only one pass was required}
end;{while...}
{clear up}
WriteLn(' ');
close(f);
PatternTest := TotalErrors;
end;{procedure PatternTest}
function InHex(value : word) : string;
var
i, num : byte;
Ch : char;
begin
InHex := '0x';
InHex[0] := char(6); {set length to 6 chars}
for i := 1 to 4 do begin
num := value AND 15; {lower 4 bits}
value := value SHR 4; {strip off lower for, for the next iteration}
if num < 10 then ch := char(num+48) {'0' is ASCII 48}
else ch := char(num+55); {'A' is ASCII 65}
InHex[(7-i)] := ch;
end;{for}
end;{fucntion}
function TwoDigit(var number : byte) : String;
var
TempStr : String;
begin
Str(number,TempStr);
if number < 10 then TwoDigit := '0' + TempStr
else TwoDigit := TempStr;
end;{function}
procedure MediaTest;
var
Wr, Rd : P32kArray; {we allocation both memory blocks here,}
Test : byte; {so that we can test the pattern in RAM first}
DisplayStr : String;
H, M, S : Byte;
TestTime : Real;
i : Word;
Errors : LongInt;
Res : LongInt;
WrDS, WrSI : Word;
begin
Write('Pattern testing with ',PatternTests,' patterns over ');
if (TestSize > 1048576) then
{file is MB size}
write( (TestSize / 1048576):1:1,' MB.')
else
{file is KB size}
write( (TestSize div 1024),' KB.');
WriteLn;
Write('Press any key to skip on, S to skip test completely, Q to quit.');
WriteLn; WriteLn;
new(Wr); new(Rd);
Errors := 0;
QUIT := false;
StartClock;
for Test := 1 to PatternTests do
begin
{fill array with pattern}
if (PatternCycle[Test]=1) then begin
{this is a cyclic test, i.e. walking 1's or walking 0's etc}
{build the pattern array shifting every BYTE, since it's an 8-bit interface}
{we're testing}
WrDS := Seg(Wr^); WrSI := Ofs(Wr^);
Wr^[0] := Patterns[Test];
asm
push ds
push si
push ax
push cx
mov ds, WrDS
mov si, WrSI
mov ax, ds:[si]
mov cx, 32768
@comploop:
mov ds:[si], al
rol al, 1
inc si
loop @comploop
pop cx
pop ax
pop si
pop ds
end;{asm}
end else
for i := 0 to 16383 do Wr^[i] := Patterns[Test]; {fill array with pattern}
{now check the allocated RAM is free from apparent errors}
Rd^ := Wr^; {copy between the buffers}
{get test name}
If (PatternCycle[Test]=1) then
DisplayStr := PatternNames[Test]
else
DisplayStr := 'Pattern ' + InHex(Patterns[Test]);
{check the allocated RAM blocks for errors}
if COMPSW(Wr,Rd,16384) <> 0 then
begin
{RAM apparently is bad}
WriteLn('RAM Error detected with ', DisplayStr, '.');
WriteLn(' Block A is at: ', InHex(Seg(Wr^)), ':', InHex(Ofs(Wr^)), 'h');
WriteLn(' Block B is at: ', InHex(Seg(Rd^)), ':', InHex(Ofs(Rd^)), 'h');
WriteLn(' Source is at : ', InHex(Seg(Patterns)), ':', InHex(Ofs(Patterns)+Test), 'h');
WriteLn; Write('Checking: ');
for i := 0 to 16383 do begin
if Wr^[i] <> Rd^[i] then begin
WriteLn('Difference encountered at offset ', InHex((i*2)));
i := 16383; {drop out of loop}
end;
end;{for}
dispose(Rd); dispose(Wr);
Exit;
end;{if COMPSW}
{Otherwise, run the pattern test}
Errors := Errors + PatternTest(Wr,Rd,DisplayStr,(PatRead+PatWrite+PatVerify));
if Quit then Test := PatternTests;
end;{for}
TestTime := StopClock;
Dispose(Rd); Dispose(Wr);
H := Trunc(TestTime) div 3600;
M := (Trunc(TestTime) mod 3600) div 60;
S := Trunc(TestTime) mod 60;
WriteLn;
Write('Test ran for ',TwoDigit(H),':',TwoDigit(M),':',TwoDigit(S),'. ');
If Errors = 0 then Write('No')
else write(Abs(Errors),' 32K');
write(' blocks had errors.');
end;{procedure MediaTest}
procedure SignalTest;
{optional pattern tests specifically targetted at 8-bit XT/IDE adapter
development. See info in narrative at top of file.}
var
Test : Byte;
Wr, Rd : P32kArray;
EndOfTest : Boolean;
Ch : Char;
i : Word;
DisplayStr : String;
Errors : LongInt;
TestMode : Byte;
begin
WriteLn('XT/IDE Development Pattern Tests - using ',(TestSize div 1048576),'MB test file.');
New(Wr); New(Rd);
EndOfTest := False;
Errors := 0;
repeat
WriteLn;
WriteLn('Test 1 - For testing at DD7. Flips the bit continually, all others');
WriteLn(' will be low. Line DD7 has a 10k pull-down at the interface.');
WriteLn;
WriteLn('Test 2 - For testing at DD11. Holds the bit low and flips all other bits');
WriteLn(' continually. Enables measurement of cross-talk as the line serving');
WriteLn(' this bit is in the middle of the data lines on the 40-pin connector.');
WriteLn;
WriteLn('Test 3 - For testing on the ISA Bus at data bit 4 (ISA slot pin A5). To enable');
WriteLn(' assessment of ISA bus signal quality, flips this bit repeatedly.');
WriteLn;
WriteLn('Test 4 - For measuring peak power consumption of the interface under read and');
WriteLn(' write workloads. Total power consumption will be affected by the');
WriteLn(' system (and bus) speed, since faster switching will use more power.');
WriteLn(' Test patterns are', InHex(PowerPatterns[1]), ' and ', InHex(PowerPatterns[2]), '.' );
WriteLn;
WriteLn('Test 5 - As test 4, except that the read part of the test is a one-pass verify');
WriteLn(' This will run much slower, but will confirm, after a heavy write test');
WriteLn(' that the signals were intact.');
WriteLn;
Write('Enter Test (1-5) or E to end: ');
repeat
ch := UpCase(readkey);
until ch in ['1', '2', '3', '4', '5', 'E', 'Q'];
WriteLn(ch);
if (Ch = 'E') or (Ch = 'Q') then EndOfTest := True
else begin
{Fill buffer depending on choice}
if ch = '1' then begin
for i := 0 to 16383 do begin
Wr^[i] := $80;
inc(i);
Wr^[i] := 0;
end; {for}
end else if ch = '2' then begin
for i := 0 to 16383 do begin
Wr^[i] := $F7FF;
inc(i);
Wr^[i] := 0;
end; {for}
end else if ch = '3' then begin
for i := 0 to 16383 do
Wr^[i] := $1000
end else if ch in ['4','5'] then begin
for i := 0 to 16383 do begin
Wr^[i] := PowerPatterns[1];
inc(i);
Wr^[i] := PowerPatterns[2];
end; {for}
end;{if/else}
{perform the test}
WriteLn; Write('Will perform WRITE test first, then the READ. Data read back will ');
If Ch <> '5' then write('not ');
WriteLn; WriteLn('be verified. Press SPACE to move on to read test once current write');
WriteLn('test has finished, N to skip on immediately, or S to skip it.');
DisplayStr := 'Test ' + Ch;
TestMode := PatRead + PatWrite + PatWriteContinuous;
If Ch = '5' then TestMode := TestMode + PatVerify
else TestMode := TestMode + PatReadContinuous;
Errors := Errors + PatternTest(Wr,Rd,DisplayStr,TestMode);
end;{if/else}
until EndOfTest;
Dispose(Rd); Dispose(Wr);
If Errors = 0 then Write('No')
else write(Errors);
write(' errors were encountered.');
end;{procedure SignalTest}
function ParamSpecified(s : string) : boolean;
{checks all command line arguments for s, returning true if found}
var i : word; found : boolean;
begin
found := false;
for i := 1 to ParamCount do
if Copy(ParamStr(i),1,Length(s)) = s then found := true;
ParamSpecified := found;
end;{function ParamSpecified}
function GetParam(s : string) : string;
{returns the value specified by a paramter, e.g. for 'size=8M' it would
return '8M'}
var i : word; returnstr : string;
begin
returnstr := '';
for i := 1 to ParamCount do
if Copy(ParamStr(i),1,Length(s)) = s then
{this is the parameter we're looking for}
ReturnStr := Copy(ParamStr(i),succ(Length(s)),
(Length(ParamStr(i))-Length(s)) );
GetParam := ReturnStr;
end;{function GetParam}
function StringToValue(s : string) : LongInt;
{returns the value specified in the string as a LongInt, taking account
of K and M suffixes (Kilobytes and Megabytes)}
var
IsMega : Boolean;
IsKilo : Boolean;
n : LongInt;
Cd : Integer;
begin
IsKilo := False; IsMega := False;
Case UpCase(s[length(s)]) of
'K' : IsKilo := True;
'M' : IsMega := True;
end;{case}
If IsKilo or IsMega then
BYTE(s[0]) := Pred(BYTE(s[0])); {chop off suffix, if present}
val(s,n,cd);
if cd = 0 then
begin
{converted OK so apply multiplier}
if IsKilo then n := n SHL 10;
if IsMega then n := n SHL 20;
end;
If (n < 65536) or (cd <> 0) then
begin
{didn't understand size= input or < 64KB was specified; set to default}
writeln('Didn''t understand size parameter. Must be 64K or more.');
n := TestSize;
end;
StringToValue := n;
end;{function StringToValue}
{=========================================================================}
{Program main block follows.
{=========================================================================}
VAR
ReadSpeed,
WriteSpeed,
IOPS : Real;
Ch : Char;
Readonly : Boolean;
TestDone : Boolean;
BEGIN
WriteLn('DiskTest, by James Pearce. Version ', VERSION);
If ParamSpecified('/h') or ParamSpecified('-h') or
ParamSpecified('/?') or ParamSpecified('-?') then
begin
WriteLn('Disk and interface performance and reliability testing.');
WriteLn;
WriteLn('With no command line parameters, the utility will perform a file-system based');
WriteLn('performance test with a test file size of 4MB and 256 seeks, with file size');
WriteLn('truncated to available free space if it is less.');
WriteLn;
WriteLn('Performance test specific command line options:');
WriteLn;
WriteLn(' * maxseeks - 4096 seeks (default is 256)');
WriteLn(' * highseeks - 1024 seeks');
WriteLn(' * lowseeks - 128 seeks');
WriteLn(' * minseeks - 32 seeks (use for floppy drives)');
WriteLn(' * size=x - specify the test file size, which will be truncated to');
WriteLn(' available free space. To use all free space use ''maxsize'' ');
WriteLn(' instead. Value is in bytes, specify K or M as required.');
WriteLn(' examples: size=4M (default), size=16M, size=300K');
WriteLn;
WriteLn('Example: disktest size=8M maxseeks');
WriteLn;
WriteLn('Note: XT class hardware with stepper-motor drives will process random IO at');
WriteLn(' about 5 - 10 IOPS only, hence 256 seeks is enough for measurement on');
WriteLn(' such systems.');
WriteLn;
Write('Press (c) for reliability testing usage, any other key to quit: ');
Ch := UpCase(ReadKey);
If Ch = 'C' then
begin
{display reliability testing usage notes}
WriteLn(Ch); WriteLn;
WriteLn('Reliability Testing Options:');
WriteLn;
WriteLn(' * mediatest - performs pattern testing instead of performance testing,');
Writeln(' reporting errors as it runs. 10 tests.');
WriteLn;
WriteLn(' * signaltest - performs pattern tests for checking signal quality and');
WriteLn(' measuring power consumption. These operate interactively,');
WriteLn(' hence more help with this option is provided when specified.');
WriteLn;
WriteLn('Note: size=xM can also be specified for these tests.');
end;{if Ch}
end {help screen}
else
begin
WriteLn;
TestDone := False;
{check if we're running a read-only test on an existing test file}
if ParamSpecified('readonly') then readonly := true
else readonly := false;
if ParamSpecified('noprogress') then noprogress := true
else noprogress := false; {controls whether progress marks are displayed in performance tests}
if Not Readonly then
begin
TestDone := True;
{First truncate the test file to 0 bytes, if it's present}
Write('Preparing drive...');
PurgeTestFile;
{check to see if specific test size was specified with size=}
if ParamSpecified('size=') then
TestSize := StringToValue( GetParam('size=') );
{Then check disk space on the current drive, and reduce TestSize
accordingly}
If (DiskFree(0) < TestSize) or (ParamSpecified('maxsize')) then
begin
TestSize := (DiskFree(0) SHR 15) SHL 15;
{truncate to 32K boundary}
end;{if DiskFree}
WriteLn;
If ParamSpecified('mediatest') then MediaTest
else if ParamSpecified('signaltest') then SignalTest
else TestDone := False;
end;
If Not TestDone then
begin
{Next check for seek command line options}
If ParamSpecified('maxseeks') then Seeks := 4096;
If ParamSpecified('highseeks') then Seeks := 1024;
If ParamSpecified('lowseeks') then Seeks := 128;
If ParamSpecified('minseeks') then Seeks := 32;
If ReadOnly then
begin
{check for the test file and how big it is}
Write('Read-only test mode; checking for existing test file...');
TestSize := CheckTestFile;
if TestSize = 0 then
begin
WriteLn(' file not found.');
Halt(0);
end else writeLn(' OK');
end;{if ReadOnly}
{print test summary}
Write('Configuration: ',(TestSize div 1024),' KB test file, ');
WriteLn(Seeks,' IOs in random tests.');
WriteLn;
If Not Readonly then
begin
Write('Write Speed : ');
WriteSpeed := CreateFile;
WriteLn(WriteSpeed:3:2,' KB/s');
end;{if not Readonly}
Write('Read Speed : ');
ReadSpeed := ReadFile;
WriteLn(ReadSpeed:3:2,' KB/s');
If ReadOnly then
begin
Write('8K random read : ');
IOPS := RandomTest(8192,100);
end else begin
Write('8K random, 70% read : ');
IOPS := RandomTest(8192,70);
end;{if ReadOnly}
WriteLn(IOPS:3:1,' IOPS');
Write('Sector random read : ');
IOPS := RandomTest(512,100);
WriteLn(IOPS:3:1,' IOPS');
WriteLn;
Write('Average access time (includes latency and file system');
WriteLn(' overhead), is ',(1000/IOPS):2:0,' ms.');
WriteLn;
end;{if not TestDone}
end;{if/else}
END.{PROGRAM}