mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-04 01:39:35 +01:00
285 lines
8.3 KiB
ObjectPascal
285 lines
8.3 KiB
ObjectPascal
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.
|