LA AdaTEC Ada Fair `84 Programs (1 of 2)
adatrain at trwspp.UUCP
adatrain at trwspp.UUCP
Mon Oct 1 03:37:39 AEST 1984
--------------------------------------------------
-- Rules --
--------------------------------------------------
1. All rules apply equally to all vendors participating. Every effort
will be made to assure fairness in the treatment of the vendors.
2. All vendors must perform the tests in accordance with these rules.
Each vendor is responsible for complying with them and for
accurately reporting the results of all the tests which were
submitted, including any tests not performed.
3. If more than one Ada toolset or host/target environment is used, the
vendor should make a complete, independent report of the test
results for each distinct combination of tools, host, and target.
4. All tests must be performed using the source code in its original,
official format, without alteration of any kind, except as directed.
Where implementation differences may effect the source code,
directions for alteration may be supplied to the vendors in written
form, embedded in the source code as comments, or orally by the
Technical Chair or his authorized representative. Any alterations
made to a test in the absence of such directions or which violate
the clear intent of the directions given are grounds for
disqualification of the vendor on that test.
5. The test source files must be submitted as single compilations,
regardless of the number of compilation units they contain, unless
specific directions to the contrary are given. All pragmas which an
implementation can obey must be obeyed. In particular, range
checking must not be suppressed except where directed by pragmas in
the source code. A compilation listing file must be generated by
each compilation. Unless specifically requested, no linker or
loader outputs are required. Execution outputs must be those
produced by the Ada program and its run-time environment, without
alteration of any kind. The information submitted as official test
results must represent a complete, continuous, and self-consistent
sequence of operations in which the unaltered output of each
operation is the input of the next. The image which is executed
must be precisely that which is directly produced by the sequence
described above. The intent of this rule is to avoid any
inconsistency between the options used in different parts of the
test sequence and to make sure that timing and performance data are
measured for that specific sequence only. Additional information
which was not produced in that sequence may not be included in the
official test results, but may be submitted as a supplement as
described below.
6. All timing information which is requested (other than that obtained
directly by the program using the Calendar package) shall be given
in terms of differences in the actual time of day ("wall clock"
time), accurate to the nearest second (or tenth of a second, if
possible). Compilation, link or binding, and load times must
include the time required to load and initialize the programs which
perform these processes. Compilation times include all intermediate
translations performed (e.g., from assembly code to native object
code), and specifically must include those not performed by the Ada
compiler itself. The sum of the times given for each phase
(compilation, linking, etc.) must be equal to the actual elapsed
time for the entire sequence, starting with initiation of
compilation and ending with completion of execution.
7. Size information shall be given in bytes, accurate to the nearest
byte if possible. Module object code size does not include
predefined packages such as Text_IO and Calendar which were "with"ed
or the run-time support library or the underlying operating system
if any.
8. In the event that a test is found to be defective for any reason,
including (but not restricted to) invalid Ada code, functional
errors, or unclear directions for its execution, it will be dropped
from the test suite and will not be considered further unless it can
be corrected easily and all participating vendors can be given
timely notification of the corrections.
9. Any test may be challenged by any vendor stating their belief that
it is defective and why they feel that it is. (Suggestions for
fixing the defects will be gratefully received.) Such challenges
will be taken under advisement by the Technical Chair and his
appointed representatives and will be considered and accepted or
rejected as expeditiously as possible. Only those challenges made
before the date of the fair will be considered unless there is
unanimous agreement between all vendors and the Technical Chair that
a test is defective, in which case a challenge may be accepted on
the spot. In the case of a rejected challenge, vendors may include
their objections with their results.
10. In case of ambiguities or contradictions in these rules, the
interpretation of the Technical Chair shall prevail. Suggestions
for future changes to these rules which would improve them in any
way, particularly in their fairness, clarity of interpretation, and
usefulness to the Ada community are always welcome.
11. Several copies of these rules will be made available for public
inspection and reference at the Fair.
12. Vendors are requested to present two copies of a written summary of
their results and two copies of the compilation listing of each test
program to the Technical Chair at least 30 minutes prior to the
opening of the demonstration period (scheduled for 10:00am on 30
June, 1984). Additional documentation which may be specifically
required for each test and supplemental information which the vendor
desires to supply for each test should be submitted at the same
time. In particular, cross reference listings, set/use listings,
assembly listings, linkage and load maps, etc., which were not
generated in the official test sequence, may be included. The
summary of results shall categorize the results in accordance with
the program outlined below:
with Text_IO; use Text_IO;
procedure Summarize is
type Vendor_Name is (<List of participating vendors>, None);
Vendor : Vendor_Name := None;
Columns : constant := 80;
subtype Comment is String (1 .. Columns);
Blank_Comment : constant Comment := (1 .. Columns => ' ');
type Note is array (1 .. 5) of String (1 .. Columns);
Blank_Note : constant Note := (1 .. 5 => (1 .. Columns => ' '));
Compilation_Environment : Note := Blank_Note;
Execution_Environment : Note := Blank_Note;
type Test_Result is (Passed,
Failed,
Uncertain,
Unable_To_Run,
Not_Attempted,
Disqualified,
Test_Has_Been_Dropped);
Seconds : constant Integer := 1;
type Size is digits 6;
Kilo_Bytes : constant Size := 1.0; -- represents 1024 bytes
type Result_Record is
record
Class : Test_Result := Not_Attempted;
Class_Comment : Comment := Blank_Comment;
Challenged_By_Vendor : Boolean := False;
Challenge_Comment : Comment := Blank_Comment;
-- Officially requested results go here:
Performance_Data : Note := Blank_Note;
Performance_Comment : Comment := Blank_Comment;
-- Explanations and objections go here:
Explanations : Note := Blank_Note;
-- This includes any intermediate translations by other
-- compilers or assemblers:
Compilation_Time : Duration := 0.0 * Seconds;
Compilation_Comment : Comment := Blank_Comment;
-- A value of zero indicates load- or execution-time binding:
Link_Or_Binding_Time : Duration := 0.0 * Seconds;
Linkage_Comment : Comment := Blank_Comment;
-- A value of zero indicates load time is included in
-- execution time (and cannot be reported separately).
Load_Time : Duration := 0.0 * Seconds;
Loading_Comment : Comment := Blank_Comment;
-- This includes Load_Time if it is not reported above:
Execution_Time : Duration := 0.0 * Seconds;
Execution_Comment : Comment := Blank_Comment;
-- This includes only the units whose source is in the
-- compilation;
-- it excludes predefined packages which they "with":
Object_Code_Size : Size := 0.000 * Kilo_Bytes;
Object_Code_Comment : Comment := Blank_Comment;
-- This includes pure code only; it excludes data and the
-- run-time support library:
Code_Image_Size : Size := 0.000 * Kilo_Bytes;
Code_Image_Comment : Comment := Blank_Comment;
-- This includes it all -- code, data, and run-time support:
Maximum_Memory_Used : Size := 0.000 * Kilo_Bytes;
Memory_Used_Comment : Comment := Blank_Comment;
end record;
Number_Of_Programs : constant
:= <Number actually submitted to vendors>;
type Number is range 1 .. Number_Of_Programs;
type Result_Array is array (Number) of Result_Record;
Results : Result_Array;
procedure Put (N : Note) is ... end Put;
procedure Put (R : Result_Record) is ... end Put;
begin
Set_Line(To => 10);
Set_Column(To => 31);
Put_Line("LA AdaTEC Ada* Fair");
Set_Column(To => 33);
Put_Line("30 June, 1984");
Set_Column(To => 29);
Put_Line("COMPILER TEST RESULTS");
New_Line;
Vendor := <This vendor's name>;
Set_Column(To => <TBD>);
Put(Vendor);
New_Line(2);
Compilation_Environment
:= <Description of the host computer and compiler toolset>;
Put(Compilation_Environment);
New_Line;
Execution_Environment
:= <Description of the target computer and run-time environment>;
Put(Execution_Environment);
Set_Line(To => 55);
Put("* Ada is a registered trademark of the U.S. Government " &
"(Ada Joint Program Office)");
Results := <Vendor's actual results>;
for N in Number loop
New_Page;
Put(Results(N));
end loop;
end Summarize;
-------------------------------------------------------------------
--------------------- Next Program -----------------------------
-------------------------------------------------------------------
--
-- Version: @(#)akerman.ada 2.3 Date: 9/21/84
--
-- Author: Brian A. Wichmann
-- National Physical Laboratory
-- Teddington, Middlesex TW11 OLW, UK
--
-- Modified by LA AdaTEC to conform to ANSI Standard Ada & to test
-- for significance of elapsed time.
--
-- [Extracts from: "Latest resuts from the procedure calling test,
-- Ackermann's function", B. A. Wichamann, NPL Report DITC 3/82,
-- ISSN 0143-7348]
--
-- Ackermann's function has been used to measure the procedure calling
-- overhead in languages which support recursion [Algol-like languages,
-- Assembly Languages, & Basic]
--
-- Ackermann's function is a small recursive function .... Although of
-- no particular interest in itself, the function does perform other
-- operations common to much systems programming (testing for zero,
-- incrementing and decrementing integers). The function has two
-- parameters M and N, the test being for (3, N) with N in the range
-- 1 to 6.
--
-- [End of Extract]
--
-- The object code size of the Ackermann function should be reported in
-- 8-bit bytes, as well as, the Average Number of Instructions Executed
-- per Call of the Ackermann function. Also, if the stack space is
-- exceeded, report the parameter values used as input to the initial
-- invocation of the Ackermann function.
--
-- The Average Number of Instructions Executed Per Call should preferably
-- be determined by examining the object code and calculating the number
-- of instructions executed for a significant number of calls of the
-- Ackermann function (see below). If that is not possible,
-- please make an estimate based the average execution time per machine
-- instruction for the target machine and the average time per call for
-- a significant number of calls. Clearly indicate whether the Average
-- Number of Instructions Executed Per Call is an estimate or not.
--
-- Note: In order for the measurement to be meaningful, it must be the
-- only program executing while the test is run. The number of calls is
-- significant if the elapsed time for the initial invocation of the
-- Ackermann's function is at least 100 times Duration'Small & at least
-- 100 times System.Tick).
--
with Text_IO; use Text_IO;
with Calendar; use Calendar;
with System; use System;
procedure Time_Ackermann is
type Real_Time is digits Max_Digits;
Start_Time : Time;
Elapsed_Time : Duration;
Average_Time : Real_Time;
package Duration_IO is new Fixed_IO (Duration);
use Duration_IO;
package Real_Time_IO is new Float_IO (Real_Time);
use Real_Time_IO;
package Int_IO is new Integer_IO (Integer);
use Int_IO;
I, J, K, K1, Calls: Integer;
function Ackermann (M, N: Natural) return Natural is
begin
if M = 0 then
return N + 1;
elsif N = 0 then
return Ackermann (M - 1, 1);
else
return Ackermann (M - 1, Ackermann (M, N -1 ));
end if;
end Ackermann;
begin
K := 16;
K1 := 1;
I := 1;
while K1 < Integer'Last / 512 loop
Start_Time := Clock;
J := Ackermann (3, I);
Elapsed_Time := Clock - Start_Time;
if J /= K - 3 then
Put_line (" *** Wrong Value ***");
end if;
Calls := (512*K1 - 15*K + 9*I + 37) / 3;
Put ("Number of Calls = ");
Put (Calls, Width => 0);
new_line;
Put ("Elapsed Time = ");
Put (Elapsed_Time, Fore => 0);
Put (" seconds -- precision is ");
if (Elapsed_Time < 100 * Duration'Small or
Elapsed_Time < 100 * System.Tick) then
Put_line ("Insignificant");
else
Put_line ("Significant");
end if;
Average_Time := Real_Time (Elapsed_Time / Calls);
Put ("Average Time per call = ");
Put (Average_Time, Fore => 0);
Put_Line (" seconds");
new_line;
I := I + 1;
K1 := 4 * K1;
K := 2 * K;
end loop;
Put_Line (" End of Ackermann Test");
exception
when Storage_Error =>
New_line;
Put ("Stack space exceeded for Ackermann ( 3, " );
Put (I);
Put_line ( ")" );
new_line;
Put_Line (" End of Ackermann Test");
end Time_Ackermann;
-------------------------------------------------------------------
--------------------- Next Program -----------------------------
-------------------------------------------------------------------
--
-- Version: @(#)boolvec.ada 1.3 Date: 9/21/84
--
-- Author: Edward Colbert
-- Ada Technology Group
-- Information Software Systems Lab
-- Defense Systems Group
-- TRW
-- Redondo Beach, CA
--
-- This program measures the time required for the "and" operation on the
-- elements of a boolean vector
--
-- Note: In order for the measurement to be meaningful, it must be the
-- only program executing while the test is run.
--
-- Please set Iterations large enough to provide at least two significant
-- digits in the average times, i.e., the difference between
-- the elapsed time and the loop time must be at least 100 times
-- Duration'Small & at least 100 times System.Tick.
--
with Text_IO; use Text_IO;
with Calendar; use Calendar;
with System; use System;
procedure Boolean_Vector_AND_Test is
Iterations : constant Positive := 1000;
type Real_Time is digits Max_Digits;
Start_Time : Time;
Loop_Time : Duration;
Elapsed_Time : Duration;
Average_Time : Real_Time;
package Duration_IO is new Fixed_IO (Duration);
use Duration_IO;
package Real_Time_IO is new Float_IO (Real_Time);
use Real_Time_IO;
package Int_IO is new Integer_IO (Integer);
use Int_IO;
Vector_Size : constant Positive := 25;
type vector is array (1..Vector_Size) of Boolean;
v1, v2, vector_result: vector;
count: integer := integer'first; -- used in timing loop
begin
-- Initialize Vectors
for N in vector'range loop
v1(N) := true;
v2(N) := boolean'val (N mod 2);
end loop;
-- Measure the timing loop overhead.
Start_Time := Clock;
for N in 1 .. Iterations loop
count := count + 1; -- prevent optimization
end loop;
Loop_Time := Clock - Start_Time;
-- Measure the time including the adding of vector elements
Start_Time := Clock;
for N in 1 .. Iterations loop
count := count + 1; -- prevent optimization
vector_result := v1 and v2;
end loop;
Elapsed_Time := Clock - Start_Time;
Put("Loop time = ");
Put(Loop_Time, Fore => 0);
Put(" seconds for ");
Put(Vector_Size, Width => 0);
Put_Line(" iterations");
Put("Elapsed time = ");
Put(Elapsed_Time, Fore => 0);
Put(" seconds for ");
Put(Vector_Size, Width => 0);
Put_Line(" iterations");
Average_Time := Real_Time(Elapsed_Time - Loop_Time)/Real_Time(Vector_Size);
Put("Average time for " & '"' & "and" & '"' &
" of 2 arrays (" & Integer'Image (Vector_Size) & " elements) = ");
Put(Average_Time, Fore => 0);
Put_Line(" seconds");
New_Line;
if (Elapsed_Time - Loop_Time < 100 * Duration'Small or
Elapsed_Time - Loop_Time < 100 * System.Tick) then
Put_Line("** TEST FAILED (due to insufficient precision)! **");
else
Put_Line("** TEST PASSED **");
end if;
end Boolean_Vector_AND_Test;
-------------------------------------------------------------------
--------------------- Next Program -----------------------------
-------------------------------------------------------------------
--
-- Version: @(#)bsearch.ada 1.1 Date: 5/30/84
--
-- Authors: Marion Moon and Bryce Bardin
-- Software Engineering Division
-- Ground Systems Group
-- Hughes Aircraft Company
-- Fullerton, CA
--
-- This package implements a generic binary search function.
-- It was designed to allow the use of an enumeration type for the table
-- index (a feature of possibly dubious utility, but included here for
-- uniformity with other generic operations on unconstrained arrays).
--
generic
type Index is (<>);
type Item is limited private;
type Table is array (Index range <>) of Item;
with function "=" (Left, Right : Item) return Boolean is <>;
with function ">" (Left, Right : Item) return Boolean is <>;
package Searching is
function Index_Of (Key : in Item; Within : in Table) return Index;
-- Returns the Index of the Item in Within which matches Key
-- if there is one, otherwise raises Not_Found.
Not_Found : exception;
-- Raised if the search fails.
end Searching;
package body Searching is
function Index_Of (Key : in Item; Within : in Table) return Index is
Low : Index := Within'First;
Mid : Index;
Hi : Index := Within'Last;
begin
loop
if Low > Hi then
raise Not_Found;
end if;
-- Calculate the mean Index value, using an expression
-- which can never overflow:
Mid := Index'Val(Index'Pos(Low)/2 + Index'Pos(Hi)/2 +
(Index'Pos(Low) rem 2 + Index'Pos(Hi) rem 2)/2);
if Within(Mid) = Key then
return Mid;
elsif Within(Mid) > Key then
-- This can raise Constraint_Error, but in that case
-- the search has failed:
Hi := Index'Pred(Mid);
else
-- This can raise Constraint_Error, but in that case
-- the search has failed:
Low := Index'Succ(Mid);
end if;
end loop;
exception
when Constraint_Error =>
raise Not_Found;
end Index_Of;
end Searching;
-- This procedure tests the binary search package at the extreme limits
-- of its index type.
with Searching;
with System; use System;
with Text_IO; use Text_IO;
procedure Main is
type Big_Integer is range Min_Int .. Max_Int;
type Table is array (Big_Integer range <>) of Character;
package Table_Search is
new Searching (Big_Integer, Character, Table);
use Table_Search;
T1 : constant Table (Big_Integer'First .. Big_Integer'First + 2) := "XYZ";
T2 : constant Table (Big_Integer'Last - 3 .. Big_Integer'Last) := "ABCD";
Index : Big_Integer;
Key : Character;
subtype Alpha is Character range 'A' .. 'Z';
package Big_IO is new Integer_IO (Big_Integer);
use Big_IO;
procedure Put_Match (Index : Big_Integer; Key : Character) is
begin
Put("The index for the key value of '" & Key & "' is ");
Put(Index, Width => 0);
Put('.');
New_Line;
end Put_Match;
begin
begin
for C in reverse Alpha loop
Key := C;
Index := Index_Of (Key, Within => T1);
Put_Match(Index, Key);
end loop;
exception
when Not_Found =>
Put("Key '");
Put(Key);
Put_Line("' not found.");
end;
begin
for C in Alpha loop
Key := C;
Index := Index_Of (Key, Within => T2);
Put_Match(Index, Key);
end loop;
exception
when Not_Found =>
Put("Key '");
Put(Key);
Put_Line("' not found.");
end;
end Main;
-------------------------------------------------------------------
--------------------- Next Program -----------------------------
-------------------------------------------------------------------
--
-- Version: @(#)cauchfl.ada 1.1 Date: 6/3/84
--
with text_io; use text_io;
procedure cauchy is
--
-- This test of floating point accuracy based on computing the inverses
-- of Cauchy matricies. These are N x N matricies for which the i, jth
-- entry is 1 / (i + j - 1). The inverse is computed using determinants.
-- As N increases, the determinant rapidly approaches zero. The inverse
-- is computed exactly and then checked by multiplying it by the original
-- matrix.
--
-- Gerry Fisher
-- Computer Sciences Corporation
-- May 27, 1984
type REAL is digits 6;
type MATRIX is array(POSITIVE range <>, POSITIVE range <>) of REAL;
trials : constant := 5;
FAILED : Boolean := FALSE;
function cofactor(A : MATRIX; i, j : POSITIVE) return MATRIX is
B : MATRIX(A'FIRST(1) .. A'LAST(1) - 1, A'FIRST(2) .. A'LAST(2) - 1);
x : REAL;
begin
for p in A'RANGE(1) loop
for q in A'RANGE(2) loop
x := A(p, q);
if p < i and then q < j then
B(p, q) := x;
elsif p < i and then q > j then
B(p, q - 1) := x;
elsif p > i and then q < j then
B(p - 1, q) := x;
elsif p > i and then q > j then
B(p - 1, q - 1) := x;
end if;
end loop;
end loop;
return B;
end cofactor;
function det(A : MATRIX) return REAL is
D : REAL;
k : INTEGER;
begin
if A'LENGTH = 1 then
D := A(A'FIRST(1), A'FIRST(2));
else
D := 0.0;
k := 1;
for j in A'RANGE(2) loop
D := D + REAL(k) * A(A'FIRST(1), j) * det(cofactor(A, A'FIRST(1), j));
k := - k;
end loop;
end if;
return D;
end det;
function init(n : positive) return MATRIX is
B : MATRIX(1 .. n, 1 .. n);
begin
for i in B'RANGE(1) loop
for j in B'RANGE(2) loop
B(i, j) := 1.0 / REAL(i + j - 1);
end loop;
end loop;
return B;
end init;
function inverse(A : MATRIX) return MATRIX is
B : MATRIX(A'RANGE(1), A'RANGE(2));
D : REAL := det(A);
E : REAL;
begin
if A'LENGTH = 1 then
return (1 .. 1 => (1 .. 1 => 1.0 / D));
end if;
for i in B'RANGE(1) loop
for j in B'RANGE(2) loop
B(i, j) := REAL((-1) ** (i + j)) * (det(cofactor(A, i, j)) / D);
end loop;
end loop;
-- Now check the inverse
for i in A'RANGE loop
for j in A'RANGE loop
E := 0.0;
for k in A'RANGE loop
E := E + A(i, k) * B(k, j);
end loop;
if (i = j and then E /= 1.0) or else
(i /= j and then E /= 0.0) then
raise PROGRAM_ERROR;
end if;
end loop;
end loop;
return B;
end inverse;
begin
put_line("*** TEST Inversion of Cauchy Matricies.");
for N in 1 .. trials loop
begin
declare
A : constant MATRIX := init(N);
B : constant MATRIX := inverse(A);
begin
put_line("*** REMARK: The Cauchy Matrix of size" & integer'image(N) &
" successfully inverted.");
end;
exception
when PROGRAM_ERROR =>
put_line("*** REMARK: The Cauchy Matrix of size" & integer'image(N) &
" not successfully inverted.");
when NUMERIC_ERROR =>
put_line("*** REMARK: The Cauchy Matrix of size" & integer'image(N) &
" appears singular.");
when others =>
put_line("*** REMARK: Unexpected exception raised.");
raise;
end;
end loop;
put_line("*** FINISHED Matrix Inversion Test.");
end cauchy;
-------------------------------------------------------------------
--------------------- Next Program -----------------------------
-------------------------------------------------------------------
--
-- Version: @(#)cauchfx.ada 1.1 Date: 6/3/84
--
with text_io; use text_io;
procedure cauchy is
--
-- This test of fixed point accuracy based on computing the inverses
-- of Cauchy matricies. These are N x N matricies for which the i, jth
-- entry is 1 / (i + j - 1). The inverse is computed using determinants.
-- As N increases, the determinant rapidly approaches zero. The inverse
-- is computed exactly and then checked by multiplying it by the original
-- matrix.
--
-- Gerry Fisher
-- Computer Sciences Corporation
-- May 27, 1984
type FIXED is delta 2.0**(-16) range -1000.0 .. +1000.00;
type MATRIX is array(POSITIVE range <>, POSITIVE range <>) of FIXED;
trials : constant := 5;
FAILED : Boolean := FALSE;
function cofactor(A : MATRIX; i, j : POSITIVE) return MATRIX is
B : MATRIX(A'FIRST(1) .. A'LAST(1) - 1, A'FIRST(2) .. A'LAST(2) - 1);
x : FIXED;
begin
for p in A'RANGE(1) loop
for q in A'RANGE(2) loop
x := A(p, q);
if p < i and then q < j then
B(p, q) := x;
elsif p < i and then q > j then
B(p, q - 1) := x;
elsif p > i and then q < j then
B(p - 1, q) := x;
elsif p > i and then q > j then
B(p - 1, q - 1) := x;
end if;
end loop;
end loop;
return B;
end cofactor;
function det(A : MATRIX) return FIXED is
D : FIXED;
k : INTEGER;
begin
if A'LENGTH = 1 then
D := A(A'FIRST(1), A'FIRST(2));
else
D := 0.0;
k := 1;
for j in A'RANGE(2) loop
D := D + k * FIXED(A(A'FIRST(1), j) * det(cofactor(A, A'FIRST(1), j)));
k := - k;
end loop;
end if;
return D;
end det;
function init(n : positive) return MATRIX is
B : MATRIX(1 .. n, 1 .. n);
begin
for i in B'RANGE(1) loop
for j in B'RANGE(2) loop
B(i, j) := 1.0 / (i + j - 1);
end loop;
end loop;
return B;
end init;
function inverse(A : MATRIX) return MATRIX is
B : MATRIX(A'RANGE(1), A'RANGE(2));
D : FIXED := det(A);
E : FIXED;
begin
if A'LENGTH = 1 then
return (1 .. 1 => (1 .. 1 => FIXED(FIXED(1.0) / D)));
end if;
for i in B'RANGE(1) loop
for j in B'RANGE(2) loop
B(i, j) := ((-1) ** (i + j)) * FIXED(det(cofactor(A, i, j)) / D);
end loop;
end loop;
-- Now check the inverse
for i in A'RANGE loop
for j in A'RANGE loop
E := 0.0;
for k in A'RANGE loop
E := E + FIXED(A(i, k) * B(k, j));
end loop;
if (i = j and then E /= 1.0) or else
(i /= j and then E /= 0.0) then
raise PROGRAM_ERROR;
end if;
end loop;
end loop;
return B;
end inverse;
begin
put_line("*** TEST Inversion of Cauchy Matricies.");
for N in 1 .. trials loop
begin
declare
A : constant MATRIX := init(N);
B : constant MATRIX := inverse(A);
begin
put_line("*** REMARK: The Cauchy Matrix of size" & integer'image(N) &
" successfully inverted.");
end;
exception
when PROGRAM_ERROR =>
put_line("*** REMARK: The Cauchy Matrix of size" & integer'image(N) &
" not successfully inverted.");
when NUMERIC_ERROR =>
put_line("*** REMARK: The Cauchy Matrix of size" & integer'image(N) &
" appears singular.");
when others =>
put_line("*** REMARK: Unexpected exception raised.");
raise;
end;
end loop;
put_line("*** FINISHED Matrix Inversion Test.");
end cauchy;
-------------------------------------------------------------------
--------------------- Next Program -----------------------------
-------------------------------------------------------------------
--
-- Version: @(#)cauchun.ada 1.1 Date: 6/3/84
--
with universal_integer_arithmetic; use universal_integer_arithmetic;
with universal_real_arithmetic; use universal_real_arithmetic;
with text_io; use text_io;
procedure cauchy is
--
-- This test of the Universal Arithmetic Packages computes the inverses
-- of Cauchy matricies. These are N x N matricies for which the i, jth
-- entry is 1 / (i + j - 1). The inverse is computed using determinants.
-- As N increases, the determinant rapidly approaches zero. The inverse
-- is computed exactly and then checked by multiplying it by the original
-- matrix.
--
-- Gerry Fisher
-- Computer Sciences Corporation
-- May 27, 1984
type MATRIX is array(POSITIVE range <>, POSITIVE range <>) of Universal_real;
one : Universal_integer := UI(1);
r_one : Universal_real := UR(one, one);
r_zero : Universal_real := UR(UI(0), one);
trials : constant := 10;
FAILED : Boolean := FALSE;
function cofactor(A : MATRIX; i, j : POSITIVE) return MATRIX is
B : MATRIX(A'FIRST(1) .. A'LAST(1) - 1, A'FIRST(2) .. A'LAST(2) - 1);
x : Universal_real;
begin
for p in A'RANGE(1) loop
for q in A'RANGE(2) loop
x := A(p, q);
if p < i and then q < j then
B(p, q) := x;
elsif p < i and then q > j then
B(p, q - 1) := x;
elsif p > i and then q < j then
B(p - 1, q) := x;
elsif p > i and then q > j then
B(p - 1, q - 1) := x;
end if;
end loop;
end loop;
return B;
end cofactor;
function det(A : MATRIX) return Universal_real is
D : Universal_real;
k : INTEGER;
begin
if A'LENGTH = 1 then
D := A(A'FIRST(1), A'FIRST(2));
else
D := r_zero;
k := 1;
for j in A'RANGE(2) loop
D := D + UI(k) * A(A'FIRST(1), j) * det(cofactor(A, A'FIRST(1), j));
k := - k;
end loop;
end if;
return D;
end det;
function init(n : positive) return MATRIX is
B : MATRIX(1 .. n, 1 .. n);
begin
for i in B'RANGE(1) loop
for j in B'RANGE(2) loop
B(i, j) := UR(one, UI(i + j - 1));
end loop;
end loop;
return B;
end init;
function inverse(A : MATRIX) return MATRIX is
B : MATRIX(A'RANGE(1), A'RANGE(2));
D : Universal_real := det(A);
E : Universal_real;
begin
if A'LENGTH = 1 then
return (1 .. 1 => (1 .. 1 => r_one / D));
end if;
for i in B'RANGE(1) loop
for j in B'RANGE(2) loop
B(i, j) := UI((-1) ** (i + j)) * det(cofactor(A, i, j)) / D;
end loop;
end loop;
-- Now check the inverse
for i in A'RANGE loop
for j in A'RANGE loop
E := r_zero;
for k in A'RANGE loop
E := E + A(i, k) * B(k, j);
end loop;
if (i = j and then not eql(E, r_one)) or else
(i /= j and then not eql(E, r_zero)) then
raise PROGRAM_ERROR;
end if;
end loop;
end loop;
return B;
end inverse;
begin
put_line("*** TEST Inversion of Cauchy Matricies.");
for N in 1 .. trials loop
begin
declare
A : constant MATRIX := init(N);
B : constant MATRIX := inverse(A);
begin
put_line("*** REMARK: The Cauchy Matrix of size " & integer'image(N) &
" successfully inverted.");
end;
exception
when PROGRAM_ERROR =>
put_line("*** FAILED: Matrix of size " & integer'image(N) &
" not successfully inverted.");
FAILED := True;
exit;
end;
end loop;
if not FAILED then
put_line("*** PASSED Matrix Inversion Test.");
end if;
end cauchy;
-------------------------------------------------------------------
--------------------- Next Program -----------------------------
-------------------------------------------------------------------
--
-- Version: @(#)char_dir.ada 1.2 Date: 9/21/84
--
-- Author: Edward Colbert
-- Ada Technology Group
-- Information Software Systems Lab
-- Defense Systems Group
-- TRW
-- Redondo Beach, CA
--
-- This program measures the time required for doing various file
-- operations using the Direct_IO package with Characters.
--
-- Note: In order for the measurement to be meaningful, it must be the
-- only program executing while the test is run.
--
-- Please set Times large enough to provide at least two significant
-- digits in the average times, i.e., the difference between
-- the elapsed time and the loop time must be at least 100 times
-- Duration'Small & at least 100 times System.Tick.
--
with Text_IO; use Text_IO;
with Direct_IO;
with Calendar; use Calendar;
with System; use System;
procedure Character_Direct_IO_Test is
Times : constant Positive := 1000;
type Real_Time is digits Max_Digits;
Start_Time : Time;
Loop_Time : Duration;
Average_Time : Real_Time;
Create_Time : Duration;
Close_Time : Duration;
Open_Time : Duration;
Delete_Time : Duration;
Read_Time : Duration;
Write_Time : Duration;
package Duration_IO is new Fixed_IO (Duration);
use Duration_IO;
package Real_Time_IO is new Float_IO (Real_Time);
use Real_Time_IO;
package Int_IO is new Integer_IO (Integer);
use Int_IO;
package Char_IO is new Direct_IO (Character);
use Char_IO;
file: Char_IO.file_type;
value: character := 'A';
count: integer := integer'first; -- used in timing loop
begin
-- Measure the timing loop overhead.
Start_Time := Clock;
for N in 1 .. Times loop
count := count + 1; -- prevent optimization
end loop;
Loop_Time := Clock - Start_Time;
-- Create a file
Start_Time := Clock;
Char_IO.Create (file, mode => out_file, name => "test_file");
Create_Time := Clock - Start_Time;
-- Measure the time of Writing of value
Start_Time := Clock;
for N in 1 .. Times loop
count := count + 1;
Char_IO.write (file, value);
end loop;
Write_Time := Clock - Start_Time;
-- Close a file
Start_Time := Clock;
Char_IO.Close (file);
Close_Time := Clock - Start_Time;
-- Open a file
Start_Time := Clock;
Char_IO.Open (file, mode => in_file, name => "test_file");
Open_Time := Clock - Start_Time;
-- Measure the time of Reading of value
Start_Time := Clock;
for N in 1 .. Times loop
count := count + 1;
Char_IO.read (file, value);
end loop;
Read_Time := Clock - Start_Time;
-- Delete a file
Start_Time := Clock;
Char_IO.Delete (file);
Delete_Time := Clock - Start_Time;
Put ("Create File Time = ");
Put (Create_Time, Fore => 0);
put_line (" seconds ");
Put ("Close File Time = ");
Put (Close_Time, Fore => 0);
put_line (" seconds ");
Put ("Open File Time = ");
Put (Open_Time, Fore => 0);
put_line (" seconds ");
Put ("Delete File Time = ");
Put (Delete_Time, Fore => 0);
put_line (" seconds ");
Put("Loop time = ");
Put(Loop_Time, Fore => 0);
Put(" seconds for ");
Put(Times, Width => 0);
Put_Line(" iterations");
Put("Elapsed time = ");
Put(Write_Time, Fore => 0);
Put(" seconds for ");
Put(Times, Width => 0);
Put_Line(" Writes");
Average_Time := Real_Time(Write_Time - Loop_Time)/Real_Time(Times);
Put("Average time for a Write = ");
Put(Average_Time, Fore => 0);
Put_Line(" seconds");
New_Line;
Put("Elapsed time = ");
Put(Read_Time, Fore => 0);
Put(" seconds for ");
Put(Times, Width => 0);
Put_Line(" Reads");
Average_Time := Real_Time(Read_Time - Loop_Time)/Real_Time(Times);
Put("Average time for a Read = ");
Put(Average_Time, Fore => 0);
Put_Line(" seconds");
New_Line;
if (Read_Time - Loop_Time < 100 * Duration'Small) or
(Read_Time - Loop_Time < 100 * System.Tick) or
(Write_Time - Loop_Time < 100 * Duration'Small) or
(Write_Time - Loop_Time < 100 * System.Tick) then
Put_Line("** TEST FAILED (due to insufficient precision)! **");
else
Put_Line("** TEST PASSED **");
end if;
end Character_Direct_IO_Test;
-------------------------------------------------------------------
--------------------- Next Program -----------------------------
-------------------------------------------------------------------
--
-- Version: @(#)char_enm.ada 1.2 Date: 9/21/84
--
-- Author: Edward Colbert
-- Ada Technology Group
-- Information Software Systems Lab
-- Defense Systems Group
-- TRW
-- Redondo Beach, CA
--
-- This program measures the time required for doing various file
-- operations using the Text_IO package & the Enumeration_IO subpackage
-- with Characters.
--
-- Note: In order for the measurement to be meaningful, it must be the
-- only program executing while the test is run.
--
-- Please set Times large enough to provide at least two significant
-- digits in the average times, i.e., the difference between
-- the elapsed time and the loop time must be at least 100 times
-- Duration'Small & at least 100 times System.Tick.
--
with Text_IO; use Text_IO;
with Calendar; use Calendar;
with System; use System;
procedure Character_Enumeration_IO_Test is
Times : constant Positive := 1000;
type Real_Time is digits Max_Digits;
Start_Time : Time;
Loop_Time : Duration;
Average_Time : Real_Time;
Create_Time : Duration;
Close_Time : Duration;
Open_Time : Duration;
Delete_Time : Duration;
Read_Time : Duration;
Write_Time : Duration;
package Duration_IO is new Fixed_IO (Duration);
use Duration_IO;
package Real_Time_IO is new Float_IO (Real_Time);
use Real_Time_IO;
package Int_IO is new Integer_IO (Integer);
use Int_IO;
package Char_IO is new Enumeration_IO (Character);
file: Text_IO.file_type;
value: character := 'A';
count: integer := integer'first; -- used in timing loop
begin
-- Measure the timing loop overhead.
Start_Time := Clock;
for N in 1 .. Times loop
count := count + 1; -- prevent optimization
end loop;
Loop_Time := Clock - Start_Time;
-- Create a file
Start_Time := Clock;
Text_IO.Create (file, mode => out_file, name => "test_file");
Create_Time := Clock - Start_Time;
-- Measure the time of Writing of value
Start_Time := Clock;
for N in 1 .. Times loop
count := count + 1;
Char_IO.put (file, value);
end loop;
Write_Time := Clock - Start_Time;
-- Close a file
Start_Time := Clock;
Text_IO.Close (file);
Close_Time := Clock - Start_Time;
-- Open a file
Start_Time := Clock;
Text_IO.Open (file, mode => in_file, name => "test_file");
Open_Time := Clock - Start_Time;
-- Measure the time of Reading of value
Start_Time := Clock;
for N in 1 .. Times loop
count := count + 1;
Char_IO.get (file, value);
end loop;
Read_Time := Clock - Start_Time;
-- Delete a file
Start_Time := Clock;
Text_IO.Delete (file);
Delete_Time := Clock - Start_Time;
Put ("Create File Time = ");
Put (Create_Time, Fore => 0);
put_line (" seconds ");
Put ("Close File Time = ");
Put (Close_Time, Fore => 0);
put_line (" seconds ");
Put ("Open File Time = ");
Put (Open_Time, Fore => 0);
put_line (" seconds ");
Put ("Delete File Time = ");
Put (Delete_Time, Fore => 0);
put_line (" seconds ");
Put("Loop time = ");
Put(Loop_Time, Fore => 0);
Put(" seconds for ");
Put(Times, Width => 0);
Put_Line(" iterations");
Put("Elapsed time = ");
Put(Write_Time, Fore => 0);
Put(" seconds for ");
Put(Times, Width => 0);
Put_Line(" Writes");
Average_Time := Real_Time(Write_Time - Loop_Time)/Real_Time(Times);
Put("Average time for a Write = ");
Put(Average_Time, Fore => 0);
Put_Line(" seconds");
New_Line;
Put("Elapsed time = ");
Put(Read_Time, Fore => 0);
Put(" seconds for ");
Put(Times, Width => 0);
Put_Line(" Reads");
Average_Time := Real_Time(Read_Time - Loop_Time)/Real_Time(Times);
Put("Average time for a Read = ");
Put(Average_Time, Fore => 0);
Put_Line(" seconds");
New_Line;
if (Read_Time - Loop_Time < 100 * Duration'Small) or
(Read_Time - Loop_Time < 100 * System.Tick) or
(Write_Time - Loop_Time < 100 * Duration'Small) or
(Write_Time - Loop_Time < 100 * System.Tick) then
Put_Line("** TEST FAILED (due to insufficient precision)! **");
else
Put_Line("** TEST PASSED **");
end if;
end Character_Enumeration_IO_Test;
-------------------------------------------------------------------
--------------------- Next Program -----------------------------
-------------------------------------------------------------------
--
-- Version: @(#)char_txt.ada 1.3 Date: 9/21/84
--
-- Author: Edward Colbert
-- Ada Technology Group
-- Information Software Systems Lab
-- Defense Systems Group
-- TRW
-- Redondo Beach, CA
--
-- This program measures the time required for doing various file
-- operations using the Text_IO package with Characters.
--
-- Note: In order for the measurement to be meaningful, it must be the
-- only program executing while the test is run.
--
-- Please set Times large enough to provide at least two significant
-- digits in the average times, i.e., the difference between
-- the elapsed time and the loop time must be at least 100 times
-- Duration'Small & at least 100 times System.Tick.
--
with Text_IO; use Text_IO;
with Calendar; use Calendar;
with System; use System;
procedure Character_Text_IO_Test is
Times : constant Positive := 1000;
type Real_Time is digits Max_Digits;
Start_Time : Time;
Loop_Time : Duration;
Average_Time : Real_Time;
Create_Time : Duration;
Close_Time : Duration;
Open_Time : Duration;
Delete_Time : Duration;
Read_Time : Duration;
Write_Time : Duration;
package Duration_IO is new Fixed_IO (Duration);
use Duration_IO;
package Real_Time_IO is new Float_IO (Real_Time);
use Real_Time_IO;
package Int_IO is new Integer_IO (Integer);
use Int_IO;
file: Text_IO.file_type;
value: character := 'A';
count: integer := integer'first; -- used in timing loop
begin
-- Measure the timing loop overhead.
Start_Time := Clock;
for N in 1 .. Times loop
count := count + 1; -- prevent optimization
end loop;
Loop_Time := Clock - Start_Time;
-- Create a file
Start_Time := Clock;
Text_IO.Create (file, mode => out_file, name => "test_file");
Create_Time := Clock - Start_Time;
-- Measure the time of Writing of value
Start_Time := Clock;
for N in 1 .. Times loop
count := count + 1;
Text_IO.put (file, value);
end loop;
Write_Time := Clock - Start_Time;
-- Close a file
Start_Time := Clock;
Text_IO.Close (file);
Close_Time := Clock - Start_Time;
-- Open a file
Start_Time := Clock;
Text_IO.Open (file, mode => in_file, name => "test_file");
Open_Time := Clock - Start_Time;
-- Measure the time of Reading of value
Start_Time := Clock;
for N in 1 .. Times loop
count := count + 1;
Text_IO.get (file, value);
end loop;
Read_Time := Clock - Start_Time;
-- Delete a file
Start_Time := Clock;
Text_IO.Delete (file);
Delete_Time := Clock - Start_Time;
Put ("Create File Time = ");
Put (Create_Time, Fore => 0);
put_line (" seconds ");
Put ("Close File Time = ");
Put (Close_Time, Fore => 0);
put_line (" seconds ");
Put ("Open File Time = ");
Put (Open_Time, Fore => 0);
put_line (" seconds ");
Put ("Delete File Time = ");
Put (Delete_Time, Fore => 0);
put_line (" seconds ");
Put("Loop time = ");
Put(Loop_Time, Fore => 0);
Put(" seconds for ");
Put(Times, Width => 0);
Put_Line(" iterations");
Put("Elapsed time = ");
Put(Write_Time, Fore => 0);
Put(" seconds for ");
Put(Times, Width => 0);
Put_Line(" Writes");
Average_Time := Real_Time(Write_Time - Loop_Time)/Real_Time(Times);
Put("Average time for a Write = ");
Put(Average_Time, Fore => 0);
Put_Line(" seconds");
New_Line;
Put("Elapsed time = ");
Put(Read_Time, Fore => 0);
Put(" seconds for ");
Put(Times, Width => 0);
Put_Line(" Reads");
Average_Time := Real_Time(Read_Time - Loop_Time)/Real_Time(Times);
Put("Average time for a Read = ");
Put(Average_Time, Fore => 0);
Put_Line(" seconds");
New_Line;
if (Read_Time - Loop_Time < 100 * Duration'Small) or
(Read_Time - Loop_Time < 100 * System.Tick) or
(Write_Time - Loop_Time < 100 * Duration'Small) or
(Write_Time - Loop_Time < 100 * System.Tick) then
Put_Line("** TEST FAILED (due to insufficient precision)! **");
else
Put_Line("** TEST PASSED **");
end if;
end Character_Text_IO_Test;
More information about the Comp.sources.unix
mailing list