program Whet; {$IFDEF VirtualPascal} {$AlignCode+,AlignData+,AlignRec+,Asm-,B-,Cdecl-,D-,Delphi-,Frame+,G4+,I-} {$Optimise+,OrgName-,P-,Q-,R-,SmartLink+,Speed+,T-,V-,W-,X+,Z-,ZD-} uses Dos, Os2Def, Os2Base; {$ENDIF} {$IFDEF Speed} {$B-,D-,I-,L-,O-,Q-,R-,S-,V-,Z-} uses Dos, BseDos; {$ENDIF} {$IFDEF Speed_Pascal_20} {$B-,D-,I-,L-,O-,Q-,R-,S-,V-,Z-} uses Dos,BseDos,OS2Def; {$ENDIF} {$IFDEF VER70} {$A+,B-,D-,E-,F-,G+,I-,L-,N+,O-,P-,Q-,R-,S-,T-,V-,X-,Y-} {$M 16384,0,655360} uses OpTimer, Dos; {$ENDIF} {$IFDEF Delphi} uses Dmisc; {$ENDIF Delphi} {$IFDEF FPC} uses Dos; {$ENDIF FPC} (********************************************************************** C Benchmark Double Precision Whetstone (A001) C C o This is a LONGREAL*8 version of C the Whetstone benchmark program. C o FOR-loop semantics are ANSI-66 compatible. C o Final measurements are to be made with all C WRITE statements and FORMAT sttements removed. C C**********************************************************************) const (* With loopcount NLoop=10, one million Whetstone instructions will be executed in each major loop. A major loop is executed 'II' times to increase wall-clock timing accuracy *) NLoopValue = 100; {$IFDEF OS2} function TimeNow : LongInt; var Clocks : LongInt; rc : ApiRet; begin rc := DosQuerySysInfo(qsv_Ms_Count, qsv_Ms_Count, Clocks, SizeOf(Clocks)); TimeNow := Clocks; end; {$ELSE} function TimeNow : Int64; var h,m,s,s100 : word; begin gettime(h,m,s,s100); TimeNow := h*3600*1000+m*60*1000+s*1000+s100*10; end; {$ENDIF} TYPE ARRAY4 = ARRAY [1..4] OF DOUBLE; VAR E1 : ARRAY4; T, T1, T2 : DOUBLE; J, K, L : LONGINT; ptime, time0, time1 : DOUBLE; PROCEDURE PA (VAR E : ARRAY4); VAR J1 : LONGINT; BEGIN J1 := 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; J1 := J1 + 1; UNTIL J1 >= 6; END; PROCEDURE P0; BEGIN E1 [J] := E1 [K]; E1 [K] := E1 [L]; E1 [L] := E1 [J]; END; PROCEDURE P3 (X,Y : DOUBLE; VAR Z : DOUBLE); VAR X1, Y1 : DOUBLE; BEGIN X1 := X; Y1 := Y; X1 := T * (X1 + Y1); Y1 := T * (X1 + Y1); Z := (X1 + Y1)/T2; END; PROCEDURE POUT (N, J, K : LONGINT; X1, X2, X3, X4 : DOUBLE); VAR time1 : double; BEGIN { time1 := TimeNow; WriteLn(time1-time0:6:1,time1-ptime:6,N:6,J:6,K:6,' ', X1:10,' ', X2:10,' ',X3:10,' ',X4:10); ptime := time1; } END; PROCEDURE DoIt; VAR NLoop, I, II, JJ : LONGINT; N1, N2, N3, N4, N5, N6, N7, N8, N9, N10, N11 : LONGINT; X1, X2, X3, X4, X, Y, Z : DOUBLE; BEGIN time0 := TimeNow; ptime := time0; (* The actual benchmark starts here. *) T := 0.499975; T1 := 0.50025; T2 := 2.0; NLoop := NLoopValue; II := 400; FOR JJ:=1 TO II DO BEGIN (* Establish the relative loop counts of each module. *) N1 := 0; N2 := 12 * NLoop; N3 := 14 * NLoop; N4 := 345 * NLoop; N5 := 0; N6 := 210 * NLoop; N7 := 32 * NLoop; N8 := 899 * NLoop; N9 := 616 * NLoop; N10 := 0; N11 := 93 * NLoop; (* Module 1: Simple identifiers *) X1 := 1.0; X2 := -1.0; X3 := -1.0; X4 := -1.0; FOR I:=1 TO N1 DO BEGIN X1 := (X1 + X2 + X3 - X4)*T; X2 := (X1 + X2 - X3 + X4)*T; X3 := (X1 - X2 + X3 + X4)*T; X4 := (-X1 + X2 + X3 + X4)*T; END; IF (JJ = II) THEN BEGIN POUT (N1, N1, N1, X1, X2, X3, X4); END; (* Module 2: Array elements *) E1 [1] := 1.0; E1 [2] := -1.0; E1 [3] := -1.0; E1 [4] := -1.0; 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; IF (JJ = II) THEN BEGIN POUT (N2, N3, N2, E1 [1], E1 [2], E1 [3], E1 [4]); END; (* Module 3: Array as parameter *) FOR I:=1 TO N3 DO BEGIN PA (E1); END; IF (JJ = II) THEN BEGIN POUT(N3, N2, N2, E1 [1], E1 [2], E1 [3], E1 [4]); END; (* Module 4: Conditional jumps *) J := 1; FOR I:=1 TO N4 DO BEGIN IF (J <> 1) THEN J := 3 ELSE J := 2; IF (J <= 2) THEN J := 1 ELSE J := 0; IF (J >= 1) THEN J := 0 ELSE J := 1; END; IF (JJ = II) THEN BEGIN POUT (N4, J, J, X1, X2, X3, X4) END; (* Module 5: Omitted; Module 6: Integer arithmetic *) J := 1; K := 2; L := 3; 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; IF (JJ = II) THEN BEGIN POUT (N6, J, K, E1 [1], E1 [2], E1 [3], E1 [4]); END; (* Module 7: Trigonometric functions *) X := 0.5; Y := 0.5; 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; IF (JJ = II) THEN BEGIN POUT (N7, J, K, X, X, Y, Y); END; (* Module 8: Procedure calls *) X := 1.0; Y := 1.0; Z := 1.0; FOR I:=1 TO N8 DO BEGIN P3 (X,Y,Z); END; IF (JJ = II) THEN BEGIN POUT (N8, J, K, X, Y, Z, Z); END; (* Module 9: Array references *) J := 1; K := 2; L := 3; E1 [1] := 1.0; E1 [2] := 2.0; E1 [3] := 3.0; FOR I:=1 TO N9 DO BEGIN P0; END; IF (JJ = II) THEN BEGIN POUT (N9, J, K, E1 [1], E1 [2], E1 [3], E1 [4]) END; (* Module 10: Integer arithmetic *) J := 2; K := 3; FOR I:=1 TO N10 DO BEGIN J := J + K; K := J + K; J := K - J; K := K - J - J; END; IF (JJ = II) THEN BEGIN POUT (N10, J, K, X1, X2, X3, X4) END; (* Module 11: Standard functions *) X := 0.75; FOR I:=1 TO N11 DO BEGIN X := sqrt (exp (ln (X)/T1)) // x:=sqrt(x); END; IF (JJ = II) THEN BEGIN POUT (N11, J, K, X, X, X, X) END; (* THIS IS THE END OF THE MAJOR LOOP. *) END; (* Stop benchmark timing at this point. *) time1 := TimeNow; (*---------------------------------------------------------------- Performance in Whetstone KIP's per second is given by (100*NLoop*II)/TIME where TIME is in seconds. --------------------------------------------------------------------*) WriteLn; WriteLn ('Double Whetstone KIPS ', (TRUNC ((100.0 * NLoop * II) * 1000 / (time1 - time0)))); WriteLn ('Whetstone MIPS ', 1.0*NLoop*II * 1000 / (time1 - time0):12:2); END; BEGIN DoIt; END.