|
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: 33056 (0x8120)
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⟧
-- A000094.ADA "Henessy" benchmarks
--
-- modified to use CPU_TIME_CLOCK rather than CALENDAR.CLOCK for PIWG
-- ( Editorial note: These are unchanged by PIWG other than the the use of
-- CPU time rather than wall time. These procedures are for comparison
-- purposes. Many came from other languages and are used for comparing
-- Ada to other languages. Most of these procedures would be considered
-- poor Ada programming. The matrix multiply is also a poor numerical
-- method. )
--
-- This is a suite of benchmarks that are relatively short, both in program
-- size and execution time. It requires no input, and prints the execution
-- time for each program, using the system- dependent routine Getclock,
-- below, to find out the current CPU time. It does a rudimentary check to
-- make sure each program gets the right output. These programs were
-- gathered by John Henessy and modified by Peter Nye.
-- Ada version translated from Pascal
-- 11/15/85 by Mitchell Gart, Alsys Inc.
with Text_Io, Cpu_Time_Clock, Duration_Io;
procedure A000094 is
-- Global variables:
Timer : Duration;
Xtimes : Duration;
Sortelements : constant := 5000;
type Listsize is range 0 .. Sortelements;
Randarray : array (Listsize) of Integer;
type Long_Integer is range -2 ** 30 .. 2 ** 30;
Seed : Long_Integer;
-- Shared by Bubble and Quick
type Sortarray is array (Listsize) of Integer;
Sortlist : Sortarray;
Biggest, Littlest : Integer;
Top : Listsize;
-- global procedures
-- Getclock was replaced by CPU_TIME_CLOCK
-- function Getclock return CALENDAR.TIME renames CALENDAR.CLOCK;
procedure Initrand is
begin
Seed := 74755;
end Initrand;
function Rand return Integer is
begin
Seed := (Seed * 1309 + 13849) mod 32767;
return Integer (Seed);
end Rand;
generic
type Elem is private;
with function Cvt (Val : Integer) return Elem;
with function "+" (Left, Right : Elem) return Elem is <>;
with function "*" (Left, Right : Elem) return Elem is <>;
procedure Matrix_Mult;
-- Integer and real matrix multiplication, programmed with generics:
procedure Matrix_Mult is
Rowsize : constant := 40;
type Index is range 1 .. Rowsize;
type Matrix is array (Index, Index) of Elem;
Ima, Imb, Imr : Matrix;
procedure Initmatrix (M : out Matrix) is
K : Listsize;
begin
K := 0;
for I in Index'First .. Index'Last loop
for J in Index'First .. Index'Last loop
M (I, J) := Cvt (Randarray (K) mod 120 - 60);
K := K + 1;
end loop;
end loop;
end Initmatrix;
procedure Innerproduct (Result : out Elem;
A, B : in Matrix;
Row, Column : in Index) is
-- computes the inner product of A(row, and B--,column)
Res : Elem := Cvt (0);
begin
for I in Index'First .. Index'Last loop
Res := Res + A (Row, I) * B (I, Column);
end loop;
Result := Res;
end Innerproduct;
begin -- MATRIX_MULT
Initmatrix (Ima);
Initmatrix (Imb);
for I in Index'First .. Index'Last loop
for J in Index'First .. Index'Last loop
Innerproduct (Imr (I, J), Ima, Imb, I, J);
end loop;
end loop;
end Matrix_Mult;
-- Having to specify these conversion routines is sort of a pain.
-- At least they are only called during matrix initialization,
-- not during the product loop.
function Int_Cvt (I : Integer) return Integer is
begin
return I;
end Int_Cvt;
function Float_Cvt (I : Integer) return Float is
begin
return Float (I);
end Float_Cvt;
-- Here are the instantiations. "*" and "+" are implied parameters.
procedure Intmm is new Matrix_Mult (Integer, Int_Cvt);
procedure Mm is new Matrix_Mult (Float, Float_Cvt);
procedure Puzzle is
-- A compute-bound program from Forest Baskett.
Size : constant := 511;
Classmax : constant := 3;
Typemax : constant := 12;
D : constant := 8;
type Piececlass is range 0 .. Classmax;
type Piecetype is range 0 .. Typemax;
type Position is range 0 .. Size;
type Piecerange is range 0 .. 13;
Piececount : array (Piececlass) of Piecerange;
Class : array (Piecetype) of Piececlass;
Piecemax : array (Piecetype) of Position;
Puzzl : array (Position) of Boolean;
P : array (Piecetype, Position) of Boolean;
M, N : Position;
Kount : Integer;
function Fit (I : Piecetype; J : Position) return Boolean is
K, M : Position;
begin
for K in 0 .. Piecemax (I) loop
if P (I, K) and then Puzzl (J + K) then
return False;
end if;
end loop;
return True;
end Fit;
function Place (I : Piecetype; J : Position) return Position is
begin
for K in 0 .. Piecemax (I) loop
if P (I, K) then
Puzzl (J + K) := True;
end if;
end loop;
Piececount (Class (I)) := Piececount (Class (I)) - 1;
for K in J .. Size loop
if not Puzzl (K) then
return K;
end if;
end loop;
return 0;
end Place;
procedure Remove (I : Piecetype; J : Position) is
begin
for K in 0 .. Piecemax (I) loop
if P (I, K) then
Puzzl (J + K) := False;
end if;
end loop;
Piececount (Class (I)) := Piececount (Class (I)) + 1;
end Remove;
function Trial (J : Position) return Boolean is
K : Position;
begin
Kount := Kount + 1;
for I in Piecetype'First .. Piecetype'Last loop
if Piececount (Class (I)) /= 0 then
if Fit (I, J) then
K := Place (I, J);
if Trial (K) or (K = 0) then
return True;
else
Remove (I, J);
end if;
end if;
end if;
end loop;
return False;
end Trial;
begin -- PUZZLE
for M in Position'First .. Position'Last loop
Puzzl (M) := True;
end loop;
for I in 1 .. 5 loop
for J in 1 .. 5 loop
for K in 1 .. 5 loop
Puzzl (Position (I + D * (J + D * K))) := False;
end loop;
end loop;
end loop;
for I in Piecetype'First .. Piecetype'Last loop
for M in Position'First .. Position'Last loop
P (I, M) := False;
end loop;
end loop;
for I in 0 .. 3 loop
for J in 0 .. 1 loop
for K in 0 .. 0 loop
P (0, Position (I + D * (J + D * K))) := True;
end loop;
end loop;
end loop;
Class (0) := 0;
Piecemax (0) := 3 + D * 1 + D * D * 0;
for I in 0 .. 1 loop
for J in 0 .. 0 loop
for K in 0 .. 3 loop
P (1, Position (I + D * (J + D * K))) := True;
end loop;
end loop;
end loop;
Class (1) := 0;
Piecemax (1) := 1 + D * 0 + D * D * 3;
for I in 0 .. 0 loop
for J in 0 .. 3 loop
for K in 0 .. 1 loop
P (2, Position (I + D * (J + D * K))) := True;
end loop;
end loop;
end loop;
Class (2) := 0;
Piecemax (2) := 0 + D * 3 + D * D * 1;
for I in 0 .. 1 loop
for J in 0 .. 3 loop
for K in 0 .. 0 loop
P (3, Position (I + D * (J + D * K))) := True;
end loop;
end loop;
end loop;
Class (3) := 0;
Piecemax (3) := 1 + D * 3 + D * D * 0;
for I in 0 .. 3 loop
for J in 0 .. 0 loop
for K in 0 .. 1 loop
P (4, Position (I + D * (J + D * K))) := True;
end loop;
end loop;
end loop;
Class (4) := 0;
Piecemax (4) := 3 + D * 0 + D * D * 1;
for I in 0 .. 0 loop
for J in 0 .. 1 loop
for K in 0 .. 3 loop
P (5, Position (I + D * (J + D * K))) := True;
end loop;
end loop;
end loop;
Class (5) := 0;
Piecemax (5) := 0 + D * 1 + D * D * 3;
for I in 0 .. 2 loop
for J in 0 .. 0 loop
for K in 0 .. 0 loop
P (6, Position (I + D * (J + D * K))) := True;
end loop;
end loop;
end loop;
Class (6) := 1;
Piecemax (6) := 2 + D * 0 + D * D * 0;
for I in 0 .. 0 loop
for J in 0 .. 2 loop
for K in 0 .. 0 loop
P (7, Position (I + D * (J + D * K))) := True;
end loop;
end loop;
end loop;
Class (7) := 1;
Piecemax (7) := 0 + D * 2 + D * D * 0;
for I in 0 .. 0 loop
for J in 0 .. 0 loop
for K in 0 .. 2 loop
P (8, Position (I + D * (J + D * K))) := True;
end loop;
end loop;
end loop;
Class (8) := 1;
Piecemax (8) := 0 + D * 0 + D * D * 2;
for I in 0 .. 1 loop
for J in 0 .. 1 loop
for K in 0 .. 0 loop
P (9, Position (I + D * (J + D * K))) := True;
end loop;
end loop;
end loop;
Class (9) := 2;
Piecemax (9) := 1 + D * 1 + D * D * 0;
for I in 0 .. 1 loop
for J in 0 .. 0 loop
for K in 0 .. 1 loop
P (10, Position (I + D * (J + D * K))) := True;
end loop;
end loop;
end loop;
Class (10) := 2;
Piecemax (10) := 1 + D * 0 + D * D * 1;
for I in 0 .. 0 loop
for J in 0 .. 1 loop
for K in 0 .. 1 loop
P (11, Position (I + D * (J + D * K))) := True;
end loop;
end loop;
end loop;
Class (11) := 2;
Piecemax (11) := 0 + D * 1 + D * D * 1;
for I in 0 .. 1 loop
for J in 0 .. 1 loop
for K in 0 .. 1 loop
P (12, Position (I + D * (J + D * K))) := True;
end loop;
end loop;
end loop;
Class (12) := 3;
Piecemax (12) := 1 + D * 1 + D * D * 1;
Piececount (0) := 13;
Piececount (1) := 3;
Piececount (2) := 1;
Piececount (3) := 1;
M := 1 + D * (1 + D * 1);
Kount := 0;
if Fit (0, M) then
N := Place (0, M);
else
Text_Io.Put_Line ("Error1 in Puzzle");
end if;
if not Trial (N) then
Text_Io.Put_Line ("Error2 in Puzzle.");
elsif Kount /= 2005 then
Text_Io.Put_Line ("Error3 in Puzzle.");
end if;
end Puzzle;
procedure Trees is
-- Sorts an array using treesort
type Node;
type Nodeptr is access Node;
type Node is
record
Left, Right : Nodeptr;
Val : Integer;
end record;
-- tree
Tree : Nodeptr;
procedure Initarr is
begin
Biggest := 0;
Littlest := 0;
for I in Listsize'First .. Listsize'Last loop
Sortlist (I) := (Randarray (I) mod 10000) - 5000;
if Sortlist (I) > Biggest then
Biggest := Sortlist (I);
elsif Sortlist (I) < Littlest then
Littlest := Sortlist (I);
end if;
end loop;
end Initarr;
procedure Insert (N : Integer; T : in out Nodeptr) is
-- insert n into tree
procedure Createnode (T : in out Nodeptr; N : in Integer) is
begin
T := new Node;
T.Left := null;
T.Right := null;
T.Val := N;
end Createnode;
begin
if N > T.Val then
if T.Left = null then
Createnode (T.Left, N);
else
Insert (N, T.Left);
end if;
elsif N < T.Val then
if T.Right = null then
Createnode (T.Right, N);
else
Insert (N, T.Right);
end if;
end if;
end Insert;
function Checktree (P : Nodeptr) return Boolean is
-- check by inorder traversal
Result : Boolean;
begin
Result := True;
if P.Left /= null then
if P.Left.Val <= P.Val then
Result := False;
else
Result := Checktree (P.Left) and Result;
end if;
end if;
if P.Right /= null then
if P.Right.Val >= P.Val then
Result := False;
else
Result := Checktree (P.Right) and Result;
end if;
end if;
return Result;
end Checktree;
begin -- TREES
Initarr;
Tree := new Node;
Tree.Left := null;
Tree.Right := null;
Tree.Val := Sortlist (1);
for I in 2 .. Sortelements loop
Insert (Sortlist (Listsize (I)), Tree);
end loop;
if not Checktree (Tree) then
Text_Io.Put (" Error in Tree.");
end if;
end Trees;
procedure Perm is
-- Permutation program, heavily recursive, written by Denny Brown.
type Permrange is range 0 .. 10;
Permarray : array (Permrange) of Permrange;
Pctr : Long_Integer;
I : Integer;
procedure Swap (A, B : in Permrange) is
T : Permrange;
begin
T := Permarray (A);
Permarray (A) := Permarray (B);
Permarray (B) := T;
end Swap;
procedure Initialize is
begin
for I in 1 .. 7 loop
Permarray (Permrange (I)) := Permrange (I - 1);
end loop;
end Initialize;
procedure Permute (N : Permrange) is
begin
Pctr := Pctr + 1;
if N /= 1 then
Permute (N - 1);
for K in reverse 1 .. N - 1 loop
Swap (N, K);
Permute (N - 1);
Swap (N, K);
end loop;
end if;
end Permute;
begin -- Perm
Pctr := 0;
for I in 1 .. 5 loop
Initialize;
Permute (7);
end loop;
if Pctr /= 43300 then
Text_Io.Put_Line (" Error in Perm.");
end if;
end Perm;
procedure Towers is
-- Program to Solve the Towers of Hanoi
Towersbase : constant := 2.39;
Maxcells : constant := 18;
type Discsizrange is range 1 .. Maxcells;
type Stackrange is range 1 .. 3;
type Cellcursor is range 0 .. Maxcells;
type Element is
record
Discsize : Discsizrange;
Next : Cellcursor;
end record;
Stack : array (Stackrange) of Cellcursor;
Cellspace : array (1 .. Maxcells) of Element;
Cfreelist : Cellcursor;
Movesdone : Integer;
-- Freelist: integer;
procedure Error (Emsg : String) is
begin
Text_Io.Put ("Error in Towers: ");
Text_Io.Put_Line (Emsg);
end Error;
procedure Makenull (S : Stackrange) is
begin
Stack (S) := 0;
end Makenull;
function Getelement return Cellcursor is
Result : Cellcursor;
begin
if Cfreelist > 0 then
Result := Cfreelist;
Cfreelist := Cellspace (Integer (Cfreelist)).Next;
return Result;
else
Error ("out of space ");
end if;
end Getelement;
procedure Push (I : Discsizrange; S : Stackrange) is
Errorfound : Boolean;
Localel : Cellcursor;
begin
Errorfound := False;
if Stack (S) > 0 then
if Cellspace (Integer (Stack (S))).Discsize <= I then
Errorfound := True;
Error ("disc size error");
end if;
end if;
if not Errorfound then
Localel := Getelement;
Cellspace (Integer (Localel)).Next := Stack (S);
Stack (S) := Localel;
Cellspace (Integer (Localel)).Discsize := I;
end if;
end Push;
procedure Init (S : Stackrange; N : Discsizrange) is
Discctr : Discsizrange;
begin
Makenull (S);
for Discctr in reverse 1 .. N loop
Push (Discctr, S);
end loop;
end Init;
function Pop (S : Stackrange) return Discsizrange is
Temp : Cellcursor;
Result : Discsizrange;
begin
if Stack (S) > 0 then
Result := Cellspace (Integer (Stack (S))).Discsize;
Temp := Cellspace (Integer (Stack (S))).Next;
Cellspace (Integer (Stack (S))).Next := Cfreelist;
Cfreelist := Stack (S);
Stack (S) := Temp;
return Result;
else
Error ("nothing to pop ");
end if;
end Pop;
procedure Move (S1, S2 : Stackrange) is
begin
Push (Pop (S1), S2);
Movesdone := Movesdone + 1;
end Move;
procedure Tower (I, J, K : Integer) is
Other : Integer;
begin
if K = 1 then
Move (Stackrange (I), Stackrange (J));
else
Other := 6 - I - J;
Tower (I, Other, K - 1);
Move (Stackrange (I), Stackrange (J));
Tower (Other, J, K - 1);
end if;
end Tower;
begin -- Towers
for I in 1 .. Maxcells loop
Cellspace (Integer (I)).Next := Cellcursor (I - 1);
end loop;
Cfreelist := Maxcells;
Init (1, 14);
Makenull (2);
Makenull (3);
Movesdone := 0;
Tower (1, 2, 14);
if Movesdone /= 16383 then
Text_Io.Put_Line ("Error in Towers.");
end if;
end Towers;
procedure Queens is
-- The eight queens problem, solved 50 times.
I : Integer;
procedure Doit is
subtype Doubleboard is Integer range 2 .. 16;
subtype Doublenorm is Integer range -7 .. 7;
subtype Boardrange is Integer range 1 .. 8;
type Aarray is array (Boardrange) of Boolean;
type Barray is array (Doubleboard) of Boolean;
type Carray is array (Doublenorm) of Boolean;
type Xarray is array (Boardrange) of Boardrange;
I : Integer;
Q : Boolean := False;
A : Aarray;
B : Barray;
C : Carray;
X : Xarray;
procedure Try (I : in Integer;
Q : in out Boolean;
A : in out Barray;
B : in out Aarray) is
J : Integer;
begin
J := 0;
Q := False;
while (not Q) and (J /= 8) loop
J := J + 1;
Q := False;
if B (J) and A (I + J) and C (I - J) then
X (I) := J;
B (J) := False;
A (I + J) := False;
C (I - J) := False;
if I < 8 then
Try (I + 1, Q, A, B);
if not Q then
B (J) := True;
A (I + J) := True;
C (I - J) := True;
end if;
else
Q := True;
end if;
end if;
end loop;
end Try;
begin -- Doit
I := 0 - 7;
while I <= 16 loop
if (I >= 1) and (I <= 8) then
A (I) := True;
end if;
if I >= 2 then
B (I) := True;
end if;
if I <= 7 then
C (I) := True;
end if;
I := I + 1;
end loop;
Try (1, Q, B, A);
if not Q then
Text_Io.Put_Line (" Error in Queens.");
end if;
end Doit;
begin -- Queens
for I in 1 .. 50 loop
Doit;
end loop;
end Queens;
procedure Quick is
-- Sorts an array using quicksort
procedure Initarr is
begin
Biggest := -6500;
Littlest := 6500;
for I in 1 .. Sortelements loop
Sortlist (Listsize (I)) :=
(Randarray (Listsize (I)) mod 10000) - 5000;
if Sortlist (Listsize (I)) > Biggest then
Biggest := Sortlist (Listsize (I));
elsif Sortlist (Listsize (I)) < Littlest then
Littlest := Sortlist (Listsize (I));
end if;
end loop;
end Initarr;
procedure Quicksort (A : in out Sortarray; L, R : Listsize) is
-- quicksort the array A from start to finish
I, J : Integer;
X, W : Integer;
begin
I := Integer (L);
J := Integer (R);
X := A ((L + R) / 2);
loop
while A (Listsize (I)) < X loop
I := I + 1;
end loop;
while X < A (Listsize (J)) loop
J := J - 1;
end loop;
if I <= J then
W := A (Listsize (I));
A (Listsize (I)) := A (Listsize (J));
A (Listsize (J)) := W;
I := I + 1;
J := J - 1;
end if;
exit when I > J;
end loop;
if L < Listsize (J) then
Quicksort (A, L, Listsize (J));
end if;
if Listsize (I) < R then
Quicksort (A, Listsize (I), R);
end if;
end Quicksort;
begin -- QUICK
Initarr;
Quicksort (Sortlist, 1, Sortelements);
if (Sortlist (1) /= Littlest) or
(Sortlist (Sortelements) /= Biggest) then
Text_Io.Put (" Error in Quick.");
end if;
end Quick;
procedure Bubble is
-- Sorts an array using bubblesort
J : Integer;
I, Top : Listsize;
Limit : constant Listsize := Sortelements / 10;
procedure Initarr is
I : Listsize;
begin
Biggest := 0;
Littlest := 0;
for I in 1 .. Listsize'(Sortelements) loop
Sortlist (I) := (Randarray (I) mod 10000) - 5000;
if Sortlist (I) > Biggest then
Biggest := Sortlist (I);
elsif Sortlist (I) < Littlest then
Littlest := Sortlist (I);
end if;
end loop;
end Initarr;
begin -- BUBBLE
Initarr;
Top := Limit;
while Top > 1 loop
I := 1;
while I < Top loop
if Sortlist (I) > Sortlist (I + 1) then
J := Sortlist (I);
Sortlist (I) := Sortlist (I + 1);
Sortlist (I + 1) := J;
end if;
I := I + 1;
end loop;
Top := Top - 1;
end loop;
for I in 2 .. Limit loop
if (Sortlist (I - 1) > Sortlist (I)) then
Text_Io.Put ("Error3 in Bubble.");
end if;
end loop;
end Bubble;
procedure Oscar is
-- fft
Fftsize : constant := 256;
Fftsize2 : constant := 129;
type Complex is
record
Rp, Ip : Float;
end record;
type Carray is array (1 .. Fftsize) of Complex;
type C2array is array (1 .. Fftsize2) of Complex;
Z, W : Carray;
E : C2array;
Zr, Zi : Float;
function Cos (X : Float) return Float is
-- computes cos of x (x in radians) by an expansion
type T is range 2 .. 10;
I : T;
Result, Power : Float;
Factor : Long_Integer;
begin
Result := 1.0;
Factor := 1;
Power := X;
for I in 2 .. 10 loop
Factor := Factor * Long_Integer (I);
Power := Power * X;
if (I mod 2) = 0 then
if (I mod 4) = 0 then
Result := Result + Power / Float (Factor);
else
Result := Result - Power / Float (Factor);
end if;
end if;
end loop;
return Result;
end Cos;
function Min0 (Arg1, Arg2 : Integer) return Integer is
begin
if Arg1 < Arg2 then
return Arg1;
else
return Arg2;
end if;
end Min0;
procedure Uniform11 (Iy : in out Long_Integer; Yfl : out Float) is
begin
Iy := (4855 * Iy + 1731) mod 8192;
Yfl := Float (Iy) / 8192.0;
end Uniform11;
procedure Exptab (N : Integer; E : in out C2array) is
H : array (1 .. 25) of Float;
I, J, K, L, M : Integer;
Theta, Divisor : Float;
begin -- exptab
Theta := 3.1415926536;
Divisor := 4.0;
for I in 1 .. 25 loop
H (I) := 1.0 / (2.0 * Cos (Theta / Divisor));
Divisor := Divisor + Divisor;
end loop;
M := N / 2;
L := M / 2;
J := 1;
E (1).Rp := 1.0;
E (1).Ip := 0.0;
E (L + 1).Rp := 0.0;
E (L + 1).Ip := 1.0;
E (M + 1).Rp := -1.0;
E (M + 1).Ip := 0.0;
loop
I := L / 2;
K := I;
loop
E (K + 1).Rp := H (J) *
(E (K + I + 1).Rp + E (K - I + 1).Rp);
E (K + 1).Ip := H (J) *
(E (K + I + 1).Ip + E (K - I + 1).Ip);
K := K + L;
exit when K > M;
end loop;
J := Min0 (J + 1, 25);
L := I;
exit when L <= 1;
end loop;
end Exptab;
procedure Fft (N : in Integer;
Z, W : in out Carray;
E : in C2array;
Sqrinv : in Float) is
I, J, K, L, M, Index : Integer;
begin
M := N / 2;
L := 1;
loop
K := 0;
J := L;
I := 1;
loop
loop
W (I + K).Rp := Z (I).Rp + Z (M + I).Rp;
W (I + K).Ip := Z (I).Ip + Z (M + I).Ip;
W (I + J).Rp :=
E (K + 1).Rp * (Z (I).Rp - Z (I + M).Rp) -
E (K + 1).Ip * (Z (I).Ip - Z (I + M).Ip);
W (I + J).Ip :=
E (K + 1).Rp * (Z (I).Ip - Z (I + M).Ip) +
E (K + 1).Ip * (Z (I).Rp - Z (I + M).Rp);
I := I + 1;
exit when I > J;
end loop;
K := J;
J := K + L;
exit when J > M;
end loop;
-- Z := W;
Index := 1;
loop
Z (Index) := W (Index);
Index := Index + 1;
exit when Index > N;
end loop;
L := L + L;
exit when L > M;
end loop;
for I in 1 .. N loop
Z (I).Rp := Sqrinv * Z (I).Rp;
Z (I).Ip := -Sqrinv * Z (I).Ip;
end loop;
end Fft;
begin -- oscar
Exptab (Fftsize, E);
Seed := 5767;
for I in 1 .. Fftsize loop
Uniform11 (Seed, Zr);
Uniform11 (Seed, Zi);
Z (I).Rp := 20.0 * Zr - 10.0;
Z (I).Ip := 20.0 * Zi - 10.0;
end loop;
for I in 1 .. 20 loop
Fft (Fftsize, Z, W, E, 0.0625);
-- Printcomplex( 6, 99, z, 1, 256, 17 );
end loop;
end Oscar;
procedure Ackerman is
-- Ackerman function Ack(3,6) run 10 times:
X : Integer;
function Ack (M, N : Integer) return Integer is
begin
if M = 0 then
return N + 1;
elsif N = 0 then
return Ack (M - 1, 1);
else
return Ack (M - 1, Ack (M, N - 1));
end if;
end Ack;
begin
for I in 1 .. 10 loop
X := Ack (3, 6);
end loop;
end Ackerman;
begin -- BENCH A00094
Initrand;
for I in 1 .. Sortelements loop
Randarray (Listsize (I)) := Rand;
end loop;
Text_Io.Put_Line ("Test Name: A000094 Class: Composite");
Text_Io.Put (" Perm ");
Timer := Cpu_Time_Clock;
Perm;
Xtimes := Cpu_Time_Clock - Timer;
Duration_Io.Put (Xtimes, Fore => 4, Aft => 2, Exp => 0);
Text_Io.New_Line;
Text_Io.Put (" Towers ");
Timer := Cpu_Time_Clock;
Towers;
Xtimes := Cpu_Time_Clock - Timer;
Duration_Io.Put (Xtimes, Fore => 4, Aft => 2, Exp => 0);
Text_Io.New_Line;
Text_Io.Put (" Queens ");
Timer := Cpu_Time_Clock;
Queens;
Xtimes := Cpu_Time_Clock - Timer;
Duration_Io.Put (Xtimes, Fore => 4, Aft => 2, Exp => 0);
Text_Io.New_Line;
Text_Io.Put (" Intmm ");
Timer := Cpu_Time_Clock;
Intmm;
Xtimes := Cpu_Time_Clock - Timer;
Duration_Io.Put (Xtimes, Fore => 4, Aft => 2, Exp => 0);
Text_Io.New_Line;
Text_Io.Put (" Mm ");
Timer := Cpu_Time_Clock;
Mm;
Xtimes := Cpu_Time_Clock - Timer;
Duration_Io.Put (Xtimes, Fore => 4, Aft => 2, Exp => 0);
Text_Io.New_Line;
Text_Io.Put (" Puzzle ");
Timer := Cpu_Time_Clock;
Puzzle;
Xtimes := Cpu_Time_Clock - Timer;
Duration_Io.Put (Xtimes, Fore => 4, Aft => 2, Exp => 0);
Text_Io.New_Line;
Text_Io.Put (" Quick ");
Timer := Cpu_Time_Clock;
Quick;
Xtimes := Cpu_Time_Clock - Timer;
Duration_Io.Put (Xtimes, Fore => 4, Aft => 2, Exp => 0);
Text_Io.New_Line;
Text_Io.Put (" Bubble ");
Timer := Cpu_Time_Clock;
Bubble;
Xtimes := Cpu_Time_Clock - Timer;
Duration_Io.Put (Xtimes, Fore => 4, Aft => 2, Exp => 0);
Text_Io.New_Line;
Text_Io.Put (" Tree ");
Timer := Cpu_Time_Clock;
Trees;
Xtimes := Cpu_Time_Clock - Timer;
Duration_Io.Put (Xtimes, Fore => 4, Aft => 2, Exp => 0);
Text_Io.New_Line;
Text_Io.Put (" FFT ");
Timer := Cpu_Time_Clock;
Oscar;
Xtimes := Cpu_Time_Clock - Timer;
Duration_Io.Put (Xtimes, Fore => 4, Aft => 2, Exp => 0);
Text_Io.New_Line;
Text_Io.Put (" Ack ");
Timer := Cpu_Time_Clock;
Ackerman;
Xtimes := Cpu_Time_Clock - Timer;
Duration_Io.Put (Xtimes, Fore => 4, Aft => 2, Exp => 0);
Text_Io.New_Line;
Text_Io.Put_Line ("Test Description:");
Text_Io.Put_Line (" Henessy benchmarks");
Text_Io.New_Line;
Text_Io.New_Line;
Text_Io.New_Line;
end A000094;