lowey@sask.UUCP (05/26/87)
(*
This message contains the source code (in Turbo Pascal) to the benchmarks
I did in my other message. Kevin Lowey -- U of S Computing Services
*)
{************************************************************************}
program benchmarks (input,output);
{ }
{ Description: }
{ each benchmark individually, or run all the programs at once. }
{ The only test which requires user input is the Disk test, which is }
{ done first, so the person running the program can run all the tests }
{ without having to wait around at the computer. }
{ }
{ Written in Turbo Pascal, version 3.01A for PC-DOS }
{************************************************************************}
CONST
VERSION = '1.0c';
DATE = '16 May 1987';
AUTHOR = 'Kevin Lowey';
type {for Whetstone}
CPUARRAY =array [1..2] of real;
var
screen_results : real;
gscreen_results : real;
sieve_results : real;
intmath_results : real;
fibonacci_results : real;
float_results : real;
trancendental_results : real;
disk_results : real;
points_results : real;
memory_results : real;
whetstone_results : real;
{Whetstone test final results}
WIPS : real;
CPU : CPUARRAY;
{Menu variable}
choice : char;
{--------------------------------------------------------------------}
function timer:real;
{ returns the current time in seconds since the start of the day }
{ this is only accurate to .05 second, so don't trust the last digit }
{--------------------------------------------------------------------}
type
regpack = record case integer of
1 : ( ax,bx,cx,dx,bp,si,ds,es,flags : integer);
2 : ( al,ah,bl,bh,cl,ch,dl,dh : byte);
end;
var
regs : regpack;
begin {timer}
with regs do begin
ax := $2c00;
msdos(regs);
timer := ch * 3600.0 + cl * 60 + dh + dl / 100;
end;
end; {timer}
{************************************************************************}
FUNCTION CrtMode : Integer;
{ This function calls BIOS to determine the current CRT mode }
{ I use it to determine if I am using a Monochrome or graphics card }
{ It returns a 7 for a monochrome card. }
{************************************************************************}
TYPE
Register = record
ax,bx,cx,dx,bp,si,ds,es,flags : integer;
end;
VAR
Registers : Register;
BEGIN {crtmode function}
With Registers do BEGIN
ax := $0F00; {VIDEO_IO function 15}
Intr($10,Registers);
CrtMode := LO(ax);
END;
END; {crtmode function}
{----------------------------------------------------------------}
function screen_write:real;
{ Writes 100 79 character lines to the screen }
{ It is designed to test the speed of writing to the text screen }
{----------------------------------------------------------------}
var
start,finish : real;
i : integer;
st: string[80];
begin {screen_write}
clrscr;
writeln ('Starting Test C: Text screen test ...');
{ Create the string to be written to the screen }
st := '';
for i := 1 to 79 do
st := st + 'Z';
{Do the test}
start := timer;
for i := 1 to 100 do begin
writeln (st);
end;
finish := timer;
{ Finished }
writeln ('Finished text screen test');
writeln;
screen_write := (finish - start);
end; {screen_write}
{----------------------------------------------------------------}
function Whetstone_test(VAR CPU:CPUARRAY; VAR WIPS:real):real;
{ Whetstone CPU benchmark }
{ }
{ This program is the result of extensive research to }
{ determine the instruction mix of a typical Fortran }
{ program. The results of this program on different }
{ machines should give a good indication of which }
{ machine performs better under a typical load of }
{ Fortran programs. The statements are purposely }
{ arranged to defeat optimization by the compiler. }
{ }
{ This program was converted to pascal from fortran locally. }
{ I don't know what this will mean when doing comparisons. }
{ Perhaps show how much better pascal really is? }
{ }
{ Thanks to whoever it was that wrote the original version }
{ }
{ The parameter returned is the total time it took to do 1 }
{ iteration of the Whetstone. In the parameter list, }
{ CPU returns the times for pass 1 and pass 2 through the test, }
{ and WIPS returns the whetstone instructions per second result }
{----------------------------------------------------------------}
type {for Whetstone test}
earray = array[1..4] of real;
var
start,finish : real;
ssec,fsec,x1,x2,x3,x4,x,y,z,t,t1,t2: real;
e1 : earray;
i,iter,ipass,j,k,l : Integer;
n1,n2,n3,n4,n5,n6,n7,n8,n9,n10,n11,n12 : integer;
procedure POUT(N,J,K :integer; X1,X2,X3,X4:real);
begin
writeln (N:7, J:7, K:7, X1:12:4, X2:12:4, X3:12:4, X4:12:4);
END;
procedure PA(var E:earray);
var
j : integer;
begin
J := 0;
repeat
E[1] := ( E[1] + E[2] + E[3] - E[4]) * T;
E[2] := ( E[1] + E[2] - E[3] + E[4]) * T;
E[3] := ( E[1] - E[2] + E[3] + E[4]) * T;
E[4] := (-E[1] + E[2] + E[3] + E[4]) / T2;
J := J + 1;
until (j-6) >= 0;
END;
procedure P0;
begin
E1[J] := E1[K];
E1[K] := E1[L];
E1[L] := E1[J];
END;
procedure P3(var X,Y,Z : real);
var
x1,y1 : real;
begin
X1 := X;
Y1 := Y;
X1 := T * (X1 + Y1);
Y1 := T * (X1 + Y1);
Z := (X1 + Y1) / T2;
END;
begin {Whetstone test}
clrscr;
writeln ('Starting Test I: 1 iteration of the Whetstone test ...');
start := timer;
T := 0.499975;
T1 := 0.50025;
T2 := 2.0;
iter := 1;
for ipass := 1 to 2 do begin
IF (IPASS = 2) then
ITER := ITER + 10;
I := ITER;
ssec := timer;
N1 := 0;
N2 := 12 * I;
N3 := 14 * I;
N4 := 345 * I;
N5 := 0;
N6 := 210 * I;
N7 := 32 * I;
N8 := 899 * I;
N9 := 616 * I;
N10 := 0;
N11 := 93 * I;
N12 := 0;
X1 := 1.0;
X2 := -1.0;
X3 := -1.0;
X4 := -1.0;
IF N1 > 0 then begin
for I := 1 to N1 do begin
X1 := (X1 + X2 + X3 - X4) * T;
X2 := (X1 + X2 - X3 + X4) * T;
X4 := (-X1+ X2 + X3 + X4) * T;
X3 := (X1 - X2 + X3 + X4) * T;
end; {for}
end; {if}
POUT(N1,N1,N1,X1,X2,X3,X4);
E1[1] := 1.0;
E1[2] := -1.0;
E1[3] := -1.0;
E1[4] := -1.0;
IF N2 > 0 then begin
for i := 1 to n2 do begin
E1[1] := ( E1[1] + E1[2] + E1[3] - E1[4]) * T;
E1[2] := ( E1[1] + E1[2] - E1[3] + E1[4]) * T;
E1[3] := ( E1[1] - E1[2] + E1[3] + E1[4]) * T;
E1[4] := (-E1[1] + E1[2] + E1[3] + E1[4]) * T;
end;
end;
POUT(N2,N3,N2,E1[1],E1[2],E1[3],E1[4]);
IF N3 > 0 then
for i:= 1 to n3 do
PA(E1);
POUT(N3,N2,N2,E1[1],E1[2],E1[3],E1[4]);
J := 1;
IF N4 > 0 THEN BEGIN
FOR I := 1 TO N4 DO BEGIN
IF (J-1) = 0 THEN
J := 2
ELSE
J := 3;
IF (J-2) > 0 THEN
J := 0
ELSE
J := 1;
IF (J-1) < 0 THEN
J := 1
ELSE
J := 0;
END {FOR}
END;
POUT(N4,J,J,X1,X2,X3,X4);
J := 1;
K := 2;
L := 3;
IF (N6 > 0) THEN BEGIN
FOR I := 1 TO N6 DO BEGIN
J := J * (K-J) * (L-K);
K := L * K - (L-J) * K;
L := (L-K) * (K+J);
E1[L-1] := J + K + L;
E1[K-1] := J * K * L;
END;
END;
POUT(N6,J,K,E1[1],E1[2],E1[3],E1[4]);
X := 0.5;
Y := 0.5;
IF (N7 > 0) THEN BEGIN
FOR i := 1 TO N7 DO BEGIN
X := T * ARCTAN(T2*SIN(X)*COS(X)/(COS(X+Y)+COS(X-Y)-1.0));
Y := T * ARCTAN(T2*SIN(Y)*COS(Y)/(COS(X+Y)+COS(X-Y)-1.0));
END;
END;
POUT(N7,J,K,X,X,Y,Y);
X := 1.0;
Y := 1.0;
Z := 1.0;
IF (N8 > 0) then
for I := 1 to N8 do
P3(X,Y,Z);
POUT(N8,J,K,X,Y,Z,Z);
J := 1;
K := 2;
L := 3;
E1[1] := 1.0;
E1[2] := 2.00;
E1[3] := 3.0;
IF (N9 > 0) then
for I := 1 to N9 do
P0;
POUT(N9,J,K,E1[1],E1[2],E1[3],E1[4]);
J := 2;
K := 3;
IF (N10 > 0) then begin
for I := 1 to N10 do begin
J := J + K;
K := J + K;
J := J - K;
K := K - J - J;
end;
end;
POUT(N10,J,K,X1,X2,X3,X4);
X := 0.75;
IF (N11 > 0) then
for i := 1 to n11 do
X := SQRT(EXP(LN(X)/T1));
POUT(N11,J,K,X,X,X,X);
fsec := timer;
CPU[IPASS] := fsec - ssec;
writeln (' PASS ',Ipass,': ',CPU[IPASS]:10:4,' SEC CPU TIME');
end; {for ipass}
finish := timer;
WIPS := 1000.0 / (CPU[2] - CPU[1]);
writeln (' WHETSTONE INSTRUCTIONS PER SECOND: ', wips:7:1);
delay (5000);
WHETSTONE_TEST := finish - start;
END; {single precision test}
{----------------------------------------------------------------}
function memory_test:real;
{ This test is designed to test the speed of memory transfers }
{ It transfers a 4000 byte record) from the data segment, to a }
{ variable in the heap segment, then back again 2000 times }
{----------------------------------------------------------------}
type
data = array[1..4000] of byte;
var
start,finish : real;
i : integer;
buffer : ^data;
memory : data;
begin {memory_test}
clrscr;
writeln ('Starting Test F: Memory Test ...');
{ Initialize the memory }
for i := 1 to 4000 do begin
memory[i] := 127;
end;
{ Begin the test}
start := timer;
new (buffer);
for i := 1 to 2000 do begin
buffer^ := memory;
memory := buffer^;
end;
dispose (buffer);
finish := timer;
{ Finished}
clrscr;
writeln ('Finished Memory Move test');
writeln;
memory_test := (finish - start);
end; {memory_test}
{----------------------------------------------------------------}
function disk_test:real;
{ This function is designed to test writing characters to the }
{ disk. I didn't take any special care to check for buffered }
{ output, etc. so don't trust this test too much. It's just here }
{ to give a rough idea of the disk speed }
{----------------------------------------------------------------}
var
start,finish : real;
i,j : integer;
ch : char;
outfile:text;
begin {disk_test}
clrscr;
writeln ('Disk Write Test');
writeln;
writeln ('Press a formatted diskette in the current drive' +
' (if a floppy drive)');
writeln ('and press SPACE to continue, or any other key to skip this test');
writeln;
read (kbd,ch);
{ Allow users to skip the test if they want to }
if ch = ' ' then begin
writeln ('Starting Test B: Disk Write Test ...');
assign (outfile,'bench000.tmp');
rewrite (outfile);
{Start the test}
start := timer;
for i := 1 to 2048 do begin
for j := 1 to 78 do {actually 80 characters when cr/lf included}
write (outfile,'x');
writeln(outfile);
end; {for}
finish := timer;
close (outfile);
erase (outfile);
disk_test := (finish - start);
end
else begin
disk_test := 0;
writeln ('Skipping disk test');
end;
writeln ('Finished disk test');
writeln;
delay (2000);
end; {disk_test}
{----------------------------------------------------------------}
function gscreen_write:real;
{ Same as the screen write test above, except the text is done }
{ in 640 by 200 graphics mode rather than in text mode }
{----------------------------------------------------------------}
var
start,finish : real;
i : integer;
st: string[80];
begin {gscreen_write}
clrscr;
if crtmode <> 7 then begin {not mono screen}
hires;
writeln ('Starting Test D: 640 X 200 text to Graphics screen test ...');
st := '';
for i := 1 to 79 do
st := st + 'Z';
{Start Test}
start := timer;
for i := 1 to 100 do begin
writeln (st);
end;
finish := timer;
writeln ('Finished text screen test');
writeln;
textmode;
gscreen_write := (finish - start);
end
else begin
clrscr;
writeln ('Starting Test D: 640 X 200 text to Graphics screen test ...');
gscreen_write := 0;
write (chr(7));
writeln ('This computer does not have ' +
'a graphics card so this test cannot be done');
write (chr(7));
delay (2000);
clrscr;
end;
end; {gscreen_write}
{----------------------------------------------------------------}
function points_test:real;
{ Fill screen with points in graphics mode }
{----------------------------------------------------------------}
var
start,finish : real;
i,j : integer;
begin {points_test}
clrscr;
if crtmode <> 7 then begin {not mono screen}
hires;
writeln ('Starting Test E: 640 X 200 graphics point drawing test ...');
{ Start the test }
start := timer;
for j := 199 downto 0 do begin
for i := 0 to 639 do begin
plot (i,j,1);
end;
end;
finish := timer;
textmode;
points_test := (finish - start);
end
else begin
clrscr;
writeln ('Starting Test E: 640 X 200 graphics point drawing test ...');
points_test := 0;
write (chr(7));
writeln ('This computer does not have ' +
'a graphics card so this test cannot be done');
write (chr(7));
delay (2000);
clrscr;
end;
end; {points_test}
{------------------------------------------------------------------}
function sieve:real;
{ Calculate primes up to 8190 * 2 + 3 ten times }
{ Adapted from C program in byte magazine, November 1985 page 322 }
{------------------------------------------------------------------}
const
size = 8190; {size of array of flags}
var
start,finish : real;
i, prime, k, count, iter : integer;
flags : array [0..size] of Boolean; {array of prime flags}
begin
clrscr;
writeln ('Starting Test G: Sieve test ...');
start := timer;
for iter := 1 to 10 do begin
count := 0;
for i := 0 to size do begin
flags[i] := true;
end;
for i := 0 to size do begin
if flags[i] then begin
prime := i + i + 3;
k := i + prime;
while k <= size do begin
flags[k] := false;
k := k + prime;
end;
count := succ(count);
end;
end;
end; {for 10 iterations}
finish := timer;
writeln ('End of sieve test');
writeln;
sieve := finish - start;
end;
{------------------------------------------------------------------}
function intmath:real;
{ integer mathematics test, adapted from BYTE mag. Nov. 1985 p. 292}
{------------------------------------------------------------------}
const
count = 30000;
var
start, finish : real;
i,j,k : integer;
begin
clrscr;
writeln ('Starting Test J: Intmath test ...');
start := timer;
for i := 1 to count do begin
j := 240;
k := 15;
{ test byte-byte combinations }
j := (k * (j div k));
j := (k * (j div k));
j := (k+k+k+k+ k+k+k+k+ k+k+k+k+ k+k+k+k);
k := (j -k-k-k-k -k-k-k-k -k-k-k-k -k-k-k);
{ Test byte word combinations }
j := j shl 4;
k := k shl 4;
j := (k * (j div k));
j := (k * (j div k));
j := (k+k+k+k+ k+k+k+k+ k+k+k+k+ k+k+k+k);
k := (j -k-k-k-k -k-k-k-k -k-k-k-k -k-k-k);
{ Test word word combinations }
j := j shl 4;
k := k shl 4;
j := (k * (j div k));
j := (k * (j div k));
j := (k+k+k+k+ k+k+k+k+ k+k+k+k+ k+k+k+k);
k := (j -k-k-k-k -k-k-k-k -k-k-k-k -k-k-k);
end; {for i}
finish := timer;
writeln ('Finished INTMATH test');
writeln;
intmath := finish - start;
end; {intmath}
{------------------------------------------------------------------}
function fibonacci:real;
{ Calculate 24th fibonacci number from BYTE mag, Nov. 1985, p.280 }
{------------------------------------------------------------------}
const
ntimes = 10;
number = 23;
var
start,finish : real;
i,value : integer;
function fib(x:integer):integer;
begin
if x > 2 then
fib := fib(x-1) + fib(x-2)
else
fib := 1;
end; {fib}
begin
clrscr;
writeln ('Starting Test H: fibonacci test ...');
start := timer;
for i := 1 to ntimes do begin
value := fib(number);
end;
finish := timer;
writeln ('Finished fibonacci test ...');
writeln;
fibonacci := finish - start;
end; {fibonacci}
{------------------------------------------------------------------}
function Float:real;
{ Test mult and div operations, from BYTE mag, Nov. 1985, p.284 }
{------------------------------------------------------------------}
const
const1 = 3.141597;
const2 = 1.7839032e4;
count = 10000;
var
start,finish : real;
a,b,c : real;
i : integer;
begin
clrscr;
writeln ('Starting Test K: Floating math test ...');
start := timer;
a := const1;
b := const2;
for i := 1 to count do begin
c := a * b;
c := a / b;
c := a * b;
c := a / b;
c := a * b;
c := a / b;
c := a * b;
c := a / b;
c := a * b;
c := a / b;
c := a * b;
c := a / b;
c := a * b;
c := a / b;
end; {for}
finish := timer;
writeln ('Finished float test ...');
writeln;
float := finish - start;
end; {float}
{------------------------------------------------------------------}
function trancendental:real;
{ Test Trancendental functions, repeat expression 2500 times }
{------------------------------------------------------------------}
var
value,start,finish : real;
i : integer;
function tan (value:real):real;
begin
tan := sin(value) / cos (value);
end;
begin
clrscr;
writeln ('Starting Test L: Trancendental math test ...');
start := timer;
for i := 1 to 2500 do begin
value := tan(arctan(exp(ln(sqrt(i*1.0*i)))));
end;
finish := timer;
writeln ('Finished transendental test ...');
writeln;
trancendental := finish - start;
end; {transendental}
begin {benchmarks}
{ Initialize the timers }
screen_results := 0.0;
gscreen_results := 0.0;
sieve_results := 0.0;
intmath_results := 0.0;
fibonacci_results := 0.0;
float_results := 0.0;
trancendental_results := 0.0;
disk_results := 0.0;
points_results := 0.0;
memory_results := 0.0;
whetstone_results := 0.0;
cpu[1] := 0.0;
cpu[2] := 0.0;
WIPS := 0.0;
{ Display Menu }
repeat
clrscr;
writeln;
writeln ('Computer Benchmarking Program');
writeln ('Version: ',VERSION,' Date: ',DATE);
WRITELN;
writeln (' Written by ', AUTHOR);
writeln (' University of Saskatchewan Computing Services');
writeln (' LOWEY@SASK.BITNET or ...!ihnp4!sask!lowey.uucp');
writeln;
writeln (' General 0) Exit the program');
writeln (' A) Do All Tests');
writeln (' Disk Speed B) Test Disk Speed');
writeln (' Screen Tests C) Test Text Screen speed');
writeln (' D) Test Graphics Screen Text Speed');
writeln (' E) Test Graphics Screen Points Speed');
writeln (' Memory Speed F) Test Memory Block Moves');
writeln (' Computing Speed G) Sieve (test general computing speed)');
writeln (' H) Test Recursive Procedure Calls',
' (Fibonacci)');
writeln (' Whetstone I) Whetstone benchmark');
writeln (' Math Speed J) Test Integer Mathematics speed');
writeln (' K) Test Floating Mathematics speed');
writeln (' L) Test Trancendental functions speed');
writeln;
write ('Please enter your choice: ');
repeat
read (kbd,choice);
CHOICE := UPCASE(CHOICE);
if not (choice in ['0','A'..'L']) then
write (chr(7));
until choice in ['0','A'..'L'];
clrscr;
case choice of
'A' : begin
disk_results := disk_test;
screen_results := screen_write;
gscreen_results := gscreen_write;
points_results := points_test;
memory_results := memory_test;
sieve_results := sieve;
fibonacci_results := fibonacci;
whetstone_results := whetstone_test(CPU,WIPS);
intmath_results := intmath;
float_results := float;
trancendental_results := trancendental;
write (chr(7));
write (chr(7));
write (chr(7));
write (chr(7));
end;
'B' : Disk_results := disk_test;
'C' : screen_results := screen_write;
'D' : gscreen_results := gscreen_write;
'E' : points_results := points_test;
'F' : Memory_results := Memory_test;
'G' : sieve_results := sieve;
'H' : fibonacci_results := fibonacci;
'I' : whetstone_results := whetstone_test(CPU,WIPS);
'J' : intmath_results := intmath;
'K' : float_results := float;
'L' : trancendental_results := trancendental;
end;
clrscr;
writeln ('Final Results, times in seconds (Accurate to +/- .06 seconds)');
writeln ('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');
writeln ('Test Results Comments');
if disk_results <> 0 then
writeln ('Disk Test: ',disk_results:8:2,
' Opens file, writes 160K, deletes file');
if gscreen_results <> 0 then
writeln ('Graphics text: ',gscreen_results:8:2,
' Writes 100 79 column lines in 640 X 200 Graphics.');
if points_results <> 0 then
writeln ('Points test: ',points_results:8:2,
' 640 X 200 points drawn in Graphics mode.');
if screen_results <> 0 then
writeln ('Text Screen: ',screen_results:8:2,
' Writes 100 79 column lines in 80 col text mode.');
if memory_results <> 0 then
writeln ('Memory Test: ',memory_results:8:2,
' Move memory from data seg to heap space and back');
if sieve_results <> 0 then
writeln ('Sieve: ',sieve_results:8:2,
' Finds primes to 16383 ten times');
if fibonacci_results <> 0 then
writeln ('Fibonacci: ',fibonacci_results:8:2,
' Finds 23rd fibonacci number ten times');
if whetstone_results <> 0 then begin
writeln ('Whetstone Test: ',whetstone_results:8:2,
' Time to do 1 iteration of the whetstone benchmark');
writeln (' - Time to do first pass: ',CPU[1]:8:2,' seconds');
writeln (' - Time to do second pass: ',CPU[2]:8:2,' seconds');
writeln (' - Whetstone Instructions Per Second: ',WIPS:8:2,' wips.');
end;
if intmath_results <> 0 then
writeln ('Intmath: ',intmath_results:8:2,
' Integer Mathematics Test');
if float_results <> 0 then
writeln ('Float: ',float_results:8:2,
' Mult and Div real numbers 10000 times');
if trancendental_results <> 0 then
writeln ('Trancendental: ',trancendental_results:8:2,
' tan(atn(exp(log(sqr(x*x), x = 1 .. 2500');
writeln;
writeln ('Subtotal: ',
( screen_results +
sieve_results +
intmath_results +
fibonacci_results +
float_results +
trancendental_results +
whetstone_results +
memory_results
):8:2,
' Total without Disk and Graphics tests');
writeln ('Overall Total: ',
( screen_results +
gscreen_results +
sieve_results +
intmath_results +
fibonacci_results +
float_results +
trancendental_results +
disk_results +
points_results +
whetstone_results +
memory_results
):8:2,
' Total of all tests'
);
writeln;
if choice <> '0' then begin
writeln ('Press any key to continue');
repeat until keypressed;
end;
until choice = '0';
writeln ('Benchmarks completed');
end. {benchmarks}