|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 19186 (0x4af2)
Types: TextFile
Names: »B«
└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
└─⟦5cb1d1d7f⟧ »DATA«
└─⟦3b1ee7bd8⟧
└─⟦this⟧
-- 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 Whetstone_Bug is
--pragma SUPPRESS(ACCESS_CHECK); DO NOT USE SUPPRESS for PIWG
--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 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
Put_Line ("Test Name: A000093 Class: Composite");
Mean_Time := 0.0;
Mean_Rating := 0.0;
No_Of_Cycles := 10;
No_Of_Runs := 5; -- 1 ok for PC's
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);
-- Compute elapsed time
Elapsed_Time := Stop_Time - Start_Time;
-- 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
Rating := (1000.0 * Float (No_Of_Cycles)) / Elapsed_Time;
-- Sum Whetstone rating
Mean_Rating := Mean_Rating + Rating;
Int_Rating := Integer (Rating);
-- 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);
-- Calculate average Whetstone rating and write
Mean_Rating := Mean_Rating / Float (No_Of_Runs);
Int_Rating := Integer (Mean_Rating);
New_Line;
Put ("Average time per cycle : ");
Put (Mean_Time, 5, 2, 0);
Put_Line (" milliseconds");
New_Line;
Put ("Average Whetstone rating : ");
Put_Line (Integer'Image (Int_Rating) & " KWIPS");
New_Line;
Put_Line ("Test Description:");
Put_Line (" ADA Whetstone benchmark using standard internal math" &
" routines");
New_Line;
New_Line;
end Compute_Whetstone_Kips;
begin
Compute_Whetstone_Kips;
end Whetstone_Bug;
pragma Main;