Programmer's ROM - The Computer Language Library

home *** CD-ROM | disk | FTP | other *** search

/ Programmer's ROM - The Computer Language Library / programmersrom.iso / ada / piwg / a000093.ada < prev next >

Wrap

Text File | 1988-05-03 | 18.9 KB | 540 lines

-- Ada version of Whetstone Benchmark Program -- using standardized math routines for the measurements -- The math routines are physically included -------------------------------------------------------------------------- -- -- -- WHETADA.ADA distributed as A000093.ADA -- -- -- -- Ada version of the Whetstone Benchmark Program. -- -- Reference: "Computer Journal" February 1976, pages 43-49 -- -- for description of benchmark and ALGOL60 version. -- -- Note: Procedure POUT is omitted. -- -- -- -- From Timing Studies using a synthetic Whetstone Benchmark -- -- by Sam Harbaugh and John A. Forakis -- -- -- -------------------------------------------------------------------------- -- -- -- Authors Disclaimer -- -- " The Whetstone measure deals only with the most basic scientific/ -- -- computational aspects of the languages and computers and no general -- -- conclusions should be drawn from this work. Application specific -- -- benchmarks should be written and run by anyone needing to draw -- -- conclusions reguarding suitability of languages, compilers and -- -- hardware. This data is reported to stimulate interest and work in -- -- run time benchmarking and in no way is meant to influence anyone's -- -- choice of languages or software in any situation " -- -- -- -------------------------------------------------------------------------- -- -- -- All references to DATA_FILE and associated OPEN and PUT's are removed-- -- This was not in the timing loop. -- -- -- -------------------------------------------------------------------------- with CPU_TIME_CLOCK ; with TEXT_IO; use TEXT_IO; procedure A000093 is --pragma SUPPRESS(ACCESS_CHECK); --pragma SUPPRESS(DISCRIMINANT_CHECK); --pragma SUPPRESS(INDEX_CHECK); --pragma SUPPRESS(LENGTH_CHECK); --pragma SUPPRESS(RANGE_CHECK); --pragma SUPPRESS(DIVISION_CHECK); --pragma SUPPRESS(OVERFLOW_CHECK); --pragma SUPPRESS(STORAGE_CHECK); --pragma SUPPRESS(ELABORATION_CHECK); package INT_IO is new INTEGER_IO(INTEGER); use INT_IO; package REAL_IO is new FLOAT_IO(FLOAT); use REAL_IO; -- This is a standard Ada inplementation of the required math routines -- that is Copyright Westinghouse Electric Corporation 1983,1984,1985. -- These routines are provided for use by ACM SIGAda PIWG for making -- measurements. These routines are copyrighted and may only be used for -- performance measurements. These math routines must not be distributed -- without this notice. No permission is granted to any party to modify, -- to redistribute, to sell, to give away, or to otherwise use or -- transmit these math routines without express written permission from -- Westinghous Electric Corporation, c/o Jon Squire, P.O. Box 746 MS1615, -- Baltimore, MD 21203. PI_2 : constant FLOAT := 1.5707963267949 ; PI : constant FLOAT := 2.0 * PI_2 ; function SIN ( X : FLOAT ) return FLOAT is -- Copyright Westinghouse 1985 C1 : constant FLOAT := 1.57079631847 ; C3 : constant FLOAT := - 0.64596371106 ; C5 : constant FLOAT := 0.07968967928 ; C7 : constant FLOAT := - 0.00467376557 ; C9 : constant FLOAT := 0.00015148419 ; X_NORM : FLOAT ; X_INT : FLOAT ; X_2 : FLOAT ; Y : FLOAT ; begin X_NORM := X / PI_2 ; if abs ( X_NORM ) > 4.0 then -- REDUCE TO -2 PI .. 2 PI X_INT := FLOAT ( INTEGER( X_NORM / 4.0 )) ; X_NORM := X_NORM - 4.0 * X_INT ; end if ; if X_NORM > 2.0 then -- REDUCE TO -PI .. PI X_NORM := 2.0 - X_NORM ; elsif X_NORM < - 2.0 then X_NORM := - 2.0 - X_NORM ; end if ; if X_NORM > 1.0 then -- REDUCE TO -PI/2 .. PI/2 X_NORM := 2.0 - X_NORM ; elsif X_NORM < - 1.0 then X_NORM := - 2.0 - X_NORM ; end if ; X_2 := X_NORM * X_NORM ; Y := ( C1 +( C3 +( C5 +( C7 + C9 * X_2 ) * X_2) * X_2) * X_2) * X_NORM ; return Y ; end SIN ; function COS ( X : FLOAT ) return FLOAT is begin return SIN ( X + PI_2 ) ; end COS ; function ATAN ( X : FLOAT ) return FLOAT is -- Copyright Westinghouse 1985 C1 : constant FLOAT := 0.9999993329 ; C3 : constant FLOAT := - 0.3332985605 ; C5 : constant FLOAT := 0.1994653599 ; C7 : constant FLOAT := - 0.1390853351 ; C9 : constant FLOAT := 0.0964200441 ; C11 : constant FLOAT := - 0.0559098861 ; C13 : constant FLOAT := 0.0218612288 ; C15 : constant FLOAT := - 0.0040540580 ; A_2 : FLOAT ; Y : FLOAT ; A : FLOAT ; begin A := X ; if abs ( A ) > 1.0 then A := 1.0 / A ; end if ; A_2 := A * A ; Y := ( C1 +( C3 +( C5 +( C7 +( C9 +( C11 +( C13 + C15 * A_2 ) * A_2) * A_2 ) * A_2) * A_2) * A_2) * A_2) * A ; if abs ( X ) >= 1.0 then if X < 0.0 then Y := - ( PI_2 + Y ) ; else Y := PI_2 - Y ; end if ; end if ; return Y ; end ATAN ; function SQRT ( X : FLOAT ) return FLOAT is -- Copyright Westinghouse 1985 Y , ROOT_PWR , X_NORM : FLOAT ; A : constant FLOAT := 2.1902 ; B : constant FLOAT := - 3.0339 ; C : constant FLOAT := 1.5451 ; begin X_NORM := X ; ROOT_PWR := 1.0 ; if X <= 0.0 then return 0.0 ; end if ; if X > 1.0 then -- REDUCE TO 0.25 .. 1.0 while X_NORM > 1.0 loop ROOT_PWR := ROOT_PWR * 2.0 ; X_NORM := X_NORM * 0.25 ; end loop ; else while X_NORM < 0.25 loop ROOT_PWR := ROOT_PWR * 0.5 ; X_NORM := X_NORM * 4.0 ; end loop ; end if ; Y := A + B / ( C + X_NORM ) ; Y := 0.5 * ( Y + X_NORM / Y ) ; Y := 0.5 * ( Y + X_NORM / Y ) ; Y := Y * ROOT_PWR ; return Y ; end SQRT ; function EXP ( X : FLOAT ) return FLOAT is -- Copyright Westinghouse 1985 C1 : constant FLOAT := 9.99999900943303E-01 ; C2 : constant FLOAT := 5.00006347344554E-01 ; C3 : constant FLOAT := 1.66667985598315E-01 ; C4 : constant FLOAT := 4.16350120350139E-02 ; C5 : constant FLOAT := 8.32859610677671E-03 ; C6 : constant FLOAT := 1.43927433449119E-03 ; C7 : constant FLOAT := 2.04699933614437E-04 ; -- 4.01169746699903E-07 = MAX_ERROR APPROXIMATION-FUNCTION X1 : FLOAT ; Y : FLOAT ; E_PWR : FLOAT := 1.0 ; E : FLOAT := 2.71828182845905 ; begin if X > 88.0 then raise NUMERIC_ERROR ; end if ; X1 := abs ( X ) ; if X1 > 88.0 then return 0.0 ; end if ; while X1 >= 1.0 loop E_PWR := E_PWR * E * E ; X1 := X1 - 2.0 ; end loop ; Y := 1.0 + ( C1 +( C2 +( C3 +( C4 +( C5 +( C6 + C7 * X1 ) * X1) * X1) * X1 ) * X1) * X1) * X1 ; Y := Y * E_PWR ; if X < 0.0 then Y := 1.0 / Y ; end if ; return Y ; end EXP ; function LOG10 ( X : FLOAT ) return FLOAT is -- Copyright Westinghouse 1985 C1 : constant FLOAT := 0.868591718 ; C3 : constant FLOAT := 0.289335524 ; C5 : constant FLOAT := 0.177522071 ; C7 : constant FLOAT := 0.094376476 ; C9 : constant FLOAT := 0.191337714 ; C_R10 : constant FLOAT := 3.1622777 ; Y : FLOAT ; X_NORM : FLOAT ; X_LOG : FLOAT ; FRAC : FLOAT ; FRAC_2 : FLOAT ; begin X_LOG := 0.5 ; X_NORM := X ; if X <= 0.0 then return 0.0 ; end if ; if X >= 10.0 then while X_NORM >= 10.0 -- REDUCE TO 1.0 .. 10.0 loop X_LOG := X_LOG + 1.0 ; X_NORM := X_NORM * 0.1 ; end loop ; else while X_NORM < 1.0 -- REDUCE TO 1.0 .. 10.0 loop X_LOG := X_LOG - 1.0 ; X_NORM := X_NORM * 10.0 ; end loop ; end if ; FRAC := ( X_NORM - C_R10 ) / ( X_NORM + C_R10 ) ; FRAC_2 := FRAC * FRAC ; Y := ( C1 +( C3 +( C5 +( C7 + C9 * FRAC_2 ) * FRAC_2) * FRAC_2) * FRAC_2) * FRAC ; return Y + X_LOG ; end LOG10 ; -- end of copyrighted section function LOG ( X : FLOAT ) return FLOAT is begin return 2.302585093 * LOG10 ( X ) ; end LOG ; procedure WHETSTONE(I, NO_OF_CYCLES : in INTEGER; START_TIME,STOP_TIME: out FLOAT) is -- Calling procedure provides the loop count weight factor, I, and -- the encompassing loop count, NO_OF_CYCLES. type VECTOR is array (INTEGER range <>) of FLOAT; X1,X2,X3,X4,X,Y,Z,T,T1,T2 : FLOAT; E1 : VECTOR(1..4); J,K,L,N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11 : INTEGER; procedure PA(E: in out VECTOR) is -- tests computations with an array as a parameter J : INTEGER; -- T,T2 : FLOAT are global variables begin J:=0; <<LAB>> 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; if J < 6 then goto LAB; end if; end PA; procedure P0 is -- tests computations with no parameters -- T1,T2 : FLOAT are global -- E1 : VECTOR(1..4) is global -- J,K,L : INTEGER are global begin E1(J) := E1(K); E1(K) := E1(L); E1(L) := E1(J); end P0; procedure P3(X,Y: in out FLOAT; Z : out FLOAT) is -- tests computations with simple identifiers as parameters -- T,T2 : FLOAT are global begin X := T * (X + Y); Y := T * (X + Y); Z := (X + Y) / T2; end P3; begin -- Set constants T := 0.499975; T1 := 0.50025; T2 := 2.0; -- Compute the execution frequency for the benchmark modules N1 := 0; --Module 1 not executed N2 := 12 * I; N3 := 14 * I; N4 := 345*I; N5 := 0; -- Module 5 not executed N6 := 210*I; N7 := 32*I; N8 := 899*I; N9 := 616*I; N10:= 0; -- Module 10 not executed N11:= 93*I; START_TIME := FLOAT(CPU_TIME_CLOCK); --Get Whetstone start time CYCLE_LOOP: for CYCLE_NO in 1..NO_OF_CYCLES loop -- Module 1 : computations with simple identifiers X1 := 1.0; X2 := -1.0; X3 := -1.0; X4 := -1.0; for I in 1..N1 loop 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 loop; -- end Module 1 -- Module 2: computations with array elements E1(1) := 1.0; E1(2) := -1.0; E1(3) := -1.0; E1(4) := -1.0; for I in 1..N2 loop 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 loop; -- end Module 2 -- Module 3 : passing an array as a parmeter for I in 1..N3 loop PA(E1); end loop; -- end Module 3 -- Module 4 : performing conditional jumps J := 1; for I in 1..N4 loop if J=1 then J := 2; else J := 3; end if; if J>2 then J := 0; else J := 1; end if; if J<1 then J := 1; else J := 0; end if; end loop; --end Module 4 -- Module 5 : omitted -- Module 6 : performing integer arithmetic J := 1; K := 2; L := 3; for I in 1..N6 loop J := J * (K-J) * (L-K); K := L*K - (L-J) * K; L := (L-K) * (K+J); E1(L-1) := FLOAT(J+K+L); E1(K-1) := FLOAT(J*K*L); end loop; -- end Module 6 -- Module 7 : performing computations using trigonometric -- functions X := 0.5; Y := 0.5; for I in 1..N7 loop X := T*ATAN(T2*SIN(X)*COS(X)/(COS(X+Y)+COS(X-Y)-1.0)); Y := T*ATAN(T2*SIN(Y)*COS(Y)/(COS(X+Y)+COS(X-Y)-1.0)); end loop; -- end Module 7 -- Module 8 : procedure calls with simple identifiers as -- parameters X := 1.0; Y := 1.0; Z := 1.0; for I in 1..N8 loop P3(X,Y,Z); end loop; -- end Module 8 -- Module 9 : array reference and procedure calls with no -- parameters J := 1; K := 2; L := 3; E1(1) := 1.0; E1(2) := 2.0; E1(3) := 3.0; for I in 1..N9 loop P0; end loop; -- end Module 9 -- Module 10 : integer arithmetic J := 2; K := 3; for I in 1..N10 loop J := J + K; K := K + J; J := K - J; K := K - J - J; end loop; -- end Module 10 -- Module 11 : performing computations using standard -- mathematical functions X := 0.75; for I in 1..N11 loop X := SQRT(EXP(LOG(X)/T1)); end loop; -- end Moudle 11 end loop CYCLE_LOOP; STOP_TIME := FLOAT(CPU_TIME_CLOCK); --Get Whetstone stop time end WHETSTONE; procedure COMPUTE_WHETSTONE_KIPS is -- Variables used to control execution of benchmark and to -- compute the Whetstone rating : NO_OF_RUNS : INTEGER; -- Number of times the benchmark is executed NO_OF_CYCLES : INTEGER; -- Number of times the group of benchmark -- modules is executed I : INTEGER; -- Factor weighting number of times each module loops -- A value of ten gives a total weight for modules of -- approximately one million Whetstone instructions START_TIME : FLOAT; -- Time at which execution of benchmark modules begins STOP_TIME : FLOAT; -- Time at which execution of benchmark modules ends -- (time for NO_OF_CYCLES) ELAPSED_TIME : FLOAT; -- Time between START_TIME and STOP_TIME MEAN_TIME : FLOAT; -- Average time per cycle RATING : FLOAT; -- Thousands of Whetstone instructions per sec MEAN_RATING : FLOAT; -- Average Whetstone rating INT_RATING : INTEGER; -- Integer value of KWIPS begin NEW_LINE; PUT_LINE("ADA Whetstone benchmark"); NEW_LINE; PUT_LINE("A000093 using standard internal math routines"); NEW_LINE; MEAN_TIME := 0.0; MEAN_RATING := 0.0; NO_OF_CYCLES := 10; NO_OF_RUNS := 5; I := 10; RUN_LOOP: for RUN_NO in 1..NO_OF_RUNS loop -- Call the Whetstone benchmark parocedure WHETSTONE(I,NO_OF_CYCLES,START_TIME,STOP_TIME); -- Write the Whetstone start time NEW_LINE; PUT("Whetstone start time: "); PUT(START_TIME,5,2,0); PUT_LINE(" seconds"); -- Write the Whetstone stop time NEW_LINE; PUT("Whetstone stop time : "); PUT(STOP_TIME,5,2,0); PUT_LINE(" seconds "); -- Compute and write elapsed time ELAPSED_TIME := STOP_TIME - START_TIME; NEW_LINE; PUT("Elapsed time for "); PUT(NO_OF_CYCLES,3); PUT(" cycles : "); PUT(ELAPSED_TIME,5,2,0); PUT_LINE(" seconds"); -- Sum time in milliseconds per cycle MEAN_TIME := MEAN_TIME + (ELAPSED_TIME*1000.0)/FLOAT(NO_OF_CYCLES); -- Calculate the Whetstone rating based on the time for -- the number of cycles just executed and write RATING := (1000.0 * FLOAT(NO_OF_CYCLES))/ELAPSED_TIME; -- Sum Whetstone rating MEAN_RATING := MEAN_RATING + RATING; INT_RATING := INTEGER(RATING); NEW_LINE; PUT("Whetstone rating : "); PUT(INT_RATING); PUT_LINE(" KWIPS"); NEW_LINE; -- Reset NO_OF_CYCLES for next run using ten cycles more NO_OF_CYCLES := NO_OF_CYCLES + 10; end loop RUN_LOOP; -- Compute average time in millieseconds per cycle and write MEAN_TIME := MEAN_TIME/FLOAT(NO_OF_RUNS); NEW_LINE; PUT("Average time per cycle : "); PUT(MEAN_TIME,5,2,0); PUT_LINE(" milliseconds"); -- Calculate average Whetstone rating and write MEAN_RATING := MEAN_RATING/FLOAT(NO_OF_RUNS); INT_RATING := INTEGER(MEAN_RATING); NEW_LINE; PUT(" Average Whetstone rating : "); PUT(INT_RATING); PUT_LINE(" KWIPS"); NEW_LINE; NEW_LINE; end COMPUTE_WHETSTONE_KIPS; begin COMPUTE_WHETSTONE_KIPS; end A000093;