Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP Posting-Version: version B 2.10 5/3/83; site trwspp.UUCP Path: utzoo!linus!decvax!ittvax!dcdwest!sdcsvax!sdcrdcf!trwrb!trwspp!adatrain From: adatrain@trwspp.UUCP Newsgroups: net.sources Subject: LA AdaTEC Ada Fair `84 Programs (2 of 2) Message-ID: <593@trwspp.UUCP> Date: Sun, 30-Sep-84 13:39:12 EDT Article-I.D.: trwspp.593 Posted: Sun Sep 30 13:39:12 1984 Date-Received: Tue, 2-Oct-84 06:06:58 EDT Organization: T R W, Redondo Beach, CA Lines: 2226 ------------------------------------------------------------------- --------------------- Next Program ----------------------------- ------------------------------------------------------------------- -- -- Version: @(#)floatvec.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 the adding of the -- elements of a large floating point vector -- -- Note: In order for the measurement to be meaningful, it must be the -- only program executing while the test is run. -- -- Please set Vector_Size 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 Float_Vector_Add_Test is Vector_Size : 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; type vector is array (1..Vector_Size) of Float; v1, v2, vector_result: vector; count: integer := integer'first; -- used in timing loop begin -- Initialize Vectors for N in vector'range loop v1(N) := float (N); v2(N) := float (vector'last - N + 1); end loop; -- Measure the timing loop overhead. Start_Time := Clock; for N in vector'range 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 vector'range loop count := count + 1; -- prevent optimization vector_result (n) := v1(n) + v2(n); 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 (1 iteration/element)"); Average_Time := Real_Time(Elapsed_Time - Loop_Time)/Real_Time(Vector_Size); Put("Average time for adding each element = "); 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 Float_Vector_Add_Test; ------------------------------------------------------------------- --------------------- Next Program ----------------------------- ------------------------------------------------------------------- -- -- Version: @(#)friend.ada 1.1 Date: 5/30/84 -- -- Author: Bryce Bardin -- Ada Projects Section -- Software Engineering Division -- Ground Systems Group -- Hughes Aircraft Company -- Fullerton, CA -- -- The purpose of this program is to determine how "friendly" the Ada -- compiler is with regard to warning about the use of uninitialized -- objects, exceptions which will always be raised, and both warning -- about and removal of code that will never be executed. -- Compilers may be graded by the number of instances they catch in each -- of the three categories: set/use errors, 'hard' exceptions, and -- 'dead' code removal. A perfect score is: 12, 3, and 4, respectively. -- Detection of set/use errors encountered during execution will not be -- counted in the score even though it may be a useful feature to have. -- Appropriate supporting evidence, such as an assembly listing, must be -- supplied if dead code removal is claimed. -- N.B.: It is not expected that any compiler will get a perfect score! -- package Global is G : Integer; -- uninitialized end Global; with Global; package Renamed is R : Integer renames Global.G; -- "A rose by any other name ..." end Renamed; with Text_IO; use Text_IO; procedure Do_It is begin Put_Line("Should do it."); end Do_It; with Text_IO; use Text_IO; procedure Dont_Do_It is begin Put_Line("Shouldn't have done it."); end Dont_Do_It; procedure Raise_It is begin raise Program_Error; end Raise_It; with Global; use Global; with Renamed; use Renamed; with Do_It; with Dont_Do_It; with Raise_It; procedure Friendly is L : Integer; -- uninitialized Use_1 : Integer := L; -- use before set 1 Use_2 : Integer := G; -- use before set 2 Use_3 : Integer := R; -- use before set 3 Use_4 : Integer; Use_5 : Integer; Use_6 : Integer; Static : constant Integer := 8; Named : constant := 8; procedure Embedded (Data : Integer) is separate; begin Use_4 := L; -- use before set 4 Use_5 := G; -- use before set 5 Use_6 := R; -- use before set 6 Embedded(L); -- use before set 7 Embedded(G); -- use before set 8 Embedded(R); -- use before set 9 if Static = 8 then Do_It; else Dont_Do_It; -- never executed 1 end if; if Static - 4 /= 2**2 then Dont_Do_It; -- never executed 2 else Do_It; end if; if Named mod 4 = 0 then Do_It; else Dont_Do_It; -- never executed 3 end if; if Named/2 + 2 /= 6 then Dont_Do_It; -- never executed 4 else Do_It; end if; Raise_It; -- always raised 1 end Friendly; separate (Friendly) procedure Embedded (Data : Integer) is Use_1 : Integer := L; -- use before set 10 Use_2 : Integer := G; -- use before set 11 Use_3 : Integer := R; -- use before set 12 begin Use_4 := Data; -- (if Data is uninitialized, causes a use before set) raise Program_Error; -- always raised 2 Raise_It; -- always raised 3 end Embedded; ------------------------------------------------------------------- --------------------- Next Program ----------------------------- ------------------------------------------------------------------- -- -- Version: @(#)int_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 Integer. -- -- 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 Integer_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 Int_Direct_IO is new Direct_IO (Integer); use Int_Direct_IO; file: Int_Direct_IO.file_type; value: Integer := 5; 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; Int_Direct_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; Int_Direct_IO.write (file, value); end loop; Write_Time := Clock - Start_Time; -- Close a file Start_Time := Clock; Int_Direct_IO.Close (file); Close_Time := Clock - Start_Time; -- Open a file Start_Time := Clock; Int_Direct_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; Int_Direct_IO.read (file, value); end loop; Read_Time := Clock - Start_Time; -- Delete a file Start_Time := Clock; Int_Direct_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 Integer_Direct_IO_Test; ------------------------------------------------------------------- --------------------- Next Program ----------------------------- ------------------------------------------------------------------- -- -- Version: @(#)int_text.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 with Integers. -- -- 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 Integer_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: Integer := 5; 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; Int_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; Int_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 Integer_Text_IO_Test; ------------------------------------------------------------------- --------------------- Next Program ----------------------------- ------------------------------------------------------------------- -- -- Version: @(#)intvec.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 the adding of the -- elements of a large integer vector -- -- Note: In order for the measurement to be meaningful, it must be the -- only program executing while the test is run. -- -- Please set Vector_Size 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 Integer_Vector_Add_Test is Vector_Size : 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; type vector is array (1..Vector_Size) of integer; v1, v2, vector_result: vector; count: integer := integer'first; -- used in timing loop begin -- Initialize Vectors for N in vector'range loop v1(N) := N; v2(N) := vector'last - N + 1; end loop; -- Measure the timing loop overhead. Start_Time := Clock; for N in vector'range 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 vector'range loop count := count + 1; -- prevent optimization vector_result (n) := v1(n) + v2(n); 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(" Elements"); Average_Time := Real_Time(Elapsed_Time - Loop_Time)/Real_Time(Vector_Size); Put("Average time for adding each element = "); 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 Integer_Vector_Add_Test; ------------------------------------------------------------------- --------------------- Next Program ----------------------------- ------------------------------------------------------------------- -- -- Version: @(#)lowlev.ada 1.1 Date: 5/30/84 -- -- Author: Bryce Bardin -- Ada Projects Section -- Software Engineering Division -- Ground Systems Group -- Hughes Aircraft Company -- Fullerton, CA -- -- The following program tests length clauses in conjunction with -- unchecked conversion. -- -- Before running the test, No_Of_Bits must be set to the base 2 logarithm -- of the successor of System.Max_Int, i.e., the total number of bits in -- the largest integer type supported. -- Note: The place where this change is to be made is flagged by a -- comment prefixed by "--!". -- -- For a compiler to pass this test, it must obey the length clauses -- and instantiate and use the unchecked conversions correctly. -- The output will consist of Cases sets of three identical values. -- If a conversion fails, the line will be flagged as an error. A summary -- error count and a "pass/fail" message will be output. -- Ideally, an assembly listing should be provided which demonstrates -- the efficiency of the compiled code. -- with Text_IO; use Text_IO; with Unchecked_Conversion; with System; procedure Change_Types is --! Change this to Log2 (System.Max_Int + 1): No_Of_Bits : constant := 32; Cases : constant := 100; type Int is range 0 .. 2**No_Of_Bits - 1; for Int'Size use No_Of_Bits; --! Change this to System.Max_Int/(Cases - 1): Increment : constant Int := System.Max_Int/(Cases - 1); type Bit is (Off, On); for Bit use (Off => 0, On => 1); for Bit'Size use 1; subtype Bits is Positive range 1 .. No_Of_Bits; type Bit_String is array (Bits) of Bit; for Bit_String'Size use No_Of_Bits; I : Int; J : Int; B : Bit_String; Errors : Natural := 0; Column : constant := 16; package Int_IO is new Integer_IO(Int); use Int_IO; package Nat_IO is new Integer_IO(Natural); use Nat_IO; procedure Put (B : Bit_String) is begin Put("2#"); for N in Bits loop if B(N) = On then Put("1"); else Put("0"); end if; end loop; Put("#"); end Put; function To_Bit_String is new Unchecked_Conversion (Int, Bit_String); function To_Int is new Unchecked_Conversion (Bit_String, Int); begin for N in 1 .. Cases loop I := Int(N-1) * Increment; B := To_Bit_String(I); J := To_Int(B); if J /= I then Errors := Errors + 1; Put("*** ERROR ***"); end if; Set_Col(To => Column); Put("I = "); Put(I, Base => 2); Put_Line(","); Set_Col(To => Column); Put("B = "); Put(B); Put_Line(","); Set_Col(To => Column); Put("J = "); Put(J, Base => 2); Put("."); New_Line(2); end loop; New_Line(2); if Errors > 0 then Put_Line("*** TEST FAILED! ***"); if Errors = 1 then Put_Line("There was 1 error."); else Put("There were "); Put(Errors, Width => 0); Put_Line(" errors."); end if; else Put_Line("TEST PASSED!"); Put_Line("There were no errors."); end if; end Change_Types; ------------------------------------------------------------------- --------------------- Next Program ----------------------------- ------------------------------------------------------------------- -- -- Version: @(#)proccal.ada 1.2 Date: 9/21/84 -- -- -- Author: Bryce Bardin -- Ada Projects Section -- Software Engineering Division -- Ground Systems Group -- Hughes Aircraft Company -- Fullerton, CA -- -- This program measures the time required for simple procedure calls -- with scalar parameters. -- -- 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 calling times, i.e., the differences between -- the elapsed times and the corresponding loop times for each form of -- call should be greater than 100 times Duration'Small & greater than -- 100 times System.Tick. with Text_IO; use Text_IO; with Calendar; use Calendar; with System; use System; procedure Procedure_Call is Times : constant Positive := 1000; type Real_Time is digits Max_Digits; Start_Time : Time; Loop_Time : Duration; Elapsed_Time : Duration; Average_Time : Real_Time; Insufficient_Precision : Boolean := False; 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; type Cases is range 1 .. 4; Kind : array (Cases) of String (1 .. 22) := ("No parameter call: ", "In parameter call: ", "Out parameter call: ", "In Out parameter call:"); -- This package is used to prevent elimination of a "null" call -- by a smart compiler. package Prevent is Counter : Natural := 0; procedure Prevent_Optimization; end Prevent; use Prevent; procedure Call is begin Prevent_Optimization; end Call; procedure Call_In (N : in Natural) is begin Counter := N; end Call_In; procedure Call_Out (N : out Natural) is begin N := Counter; end Call_Out; procedure Call_In_Out (N : in out Natural) is begin N := Counter; end Call_In_Out; -- This procedure determines if Times is large enough to assure adequate -- precision in the timings. procedure Check_Precision is begin if (Elapsed_Time - Loop_Time < 100 * Duration'Small or Elapsed_Time - Loop_Time < 100 * System.Tick) then Insufficient_Precision := True; end if; end Check_Precision; package body Prevent is procedure Prevent_Optimization is begin Counter := Counter + 1; end Prevent_Optimization; end Prevent; begin for Case_Number in Cases loop -- Measure the timing loop overhead. Start_Time := Clock; for N in 1 .. Times loop case Case_Number is when 1 => Prevent_Optimization; when 2 => Counter := N; when 3 => Counter := N; when 4 => Counter := N; end case; end loop; Loop_Time := Clock - Start_Time; -- Measure the time including the procedure call. Start_Time := Clock; for N in 1 .. Times loop case Case_Number is when 1 => Call; when 2 => Call_In(Counter); when 3 => Call_Out(Counter); when 4 => Call_In_Out(Counter); end case; end loop; Elapsed_Time := Clock - Start_Time; Check_Precision; -- Calculate timing and output the result Put(Kind(Case_Number)); New_Line(2); Put("Loop time = "); Put(Loop_Time, Fore => 0); Put(" seconds for "); Put(Times, Width => 0); Put_Line(" iterations"); Put("Elapsed time = "); Put(Elapsed_Time, Fore => 0); Put(" seconds for "); Put(Times, Width => 0); Put_Line(" iterations"); Average_Time := Real_Time(Elapsed_Time - Loop_Time)/Real_Time(Times); New_Line; Put("Average time for a call = "); Put(Average_Time); Put_Line(" seconds"); New_Line(3); end loop; if Insufficient_Precision then Put_Line("** TEST FAILED (due to insufficient precision)! **"); else Put_Line("TEST PASSED"); end if; end Procedure_Call; ------------------------------------------------------------------- --------------------- Next Program ----------------------------- ------------------------------------------------------------------- ---------------------------------------------------------------------- -- -- QUICK SORT BENCHMARK -- -- Version: @(#)qsortpar.ada 1.1 Date: 6/5/84 -- -- Gerry Fisher -- Computer Sciences Corporation -- -- May 26, 1984 -- -- This benchmark consists of two versions of the familiar quick -- sort algorithm: a parallel version and a sequential version. -- A relatively small vector (length 100) is sorted into ascending -- sequence. The number of comparisons and exchanges is counted. -- In the parallel version separate tasks are created to sort the -- two subvectors created by partitioning the vector. Each task -- invokes the quicksort procedure. The parallel version is -- functionally equivalent to the sequential version and should -- require the same number of comparisions and exchanges. A check -- is made to verify that this is so. Also, the sorted vector is -- checked to verify that the sort has been performed correctly. -- Control is exercised so that no more than fourteen tasks are -- created when sorting the vector. -- -- The sorting is repeated a number of times to obtain a measurable -- amount of execution time. -- -- The important measure for this benchmark is the ratio of the -- execution time of the parallel version to that of the sequential -- version. This will give some indication of task activation and -- scheduling overhead. -- -- One file is used for both versions. The boolean constant "p" -- indicates whether the parallel or serial version of the algorithm -- is to be used. Simply set this constant TRUE for the parallel -- test and FALSE for the sequential test. A difference in code -- size between the two tests may indicate that conditional -- compilation is supported by the compiler. -- ------------------------------------------------------------------------ with text_io; use text_io; procedure main is failed : exception; type vector is array(integer range <>) of integer; type stats is record c, e : integer := 0; end record; p : constant boolean := true; -- true for parallel algorithm n : constant integer := 100; -- size of vector to be sorted m : constant integer := 100; -- number of times to sort vector x : vector(1 .. n); y : stats; procedure Quick_sort(A : in out vector; w : out stats) is lb : constant integer := A'first; ub : constant integer := A'last; k : integer; c, e : integer := 0; u, v : stats; function partition(L, U : integer) return integer is q, r, i, j : integer; begin r := A((U + L)/2); i := L; j := U; while i < j loop while A(i) < r loop c := c + 1; i := i + 1; end loop; while A(j) > r loop c := c + 1; j := j - 1; end loop; c := c + 2; if i <= j then e := e + 1; q := A(i); A(i) := A(j); A(j) := q; i := i + 1; j := j - 1; end if; end loop; if j > L then return j; else return L; end if; end partition; begin if lb < ub then k := partition(lb, ub); if ub > lb + 15 then if p then declare task S1; task body S1 is begin Quick_sort(A(lb .. k), u); end S1; task S2; task body S2 is begin Quick_sort(A(k + 1 .. ub), v); end S2; begin null; end; else Quick_sort(A(lb .. k), u); Quick_sort(A(k + 1 .. ub), v); end if; elsif ub > lb + 1 then Quick_sort(A(lb .. k), u); Quick_sort(A(k + 1 .. ub), v); end if; e := e + u.e + v.e; c := c + u.c + v.c; end if; w := (c, e); end Quick_sort; begin set_line_length(count(50)); if p then put_line("*** Starting Parallel Quick Sort Benchmark"); else put_line("*** Starting Sequential Quick Sort Benchmark"); end if; for k in 1 .. m loop for i in x'range loop x(i) := x'last - i + 1; end loop; Quick_sort(x, y); for i in x'first .. x'last - 1 loop if x(i) > x(i + 1) then raise failed; end if; end loop; put("."); end loop; new_line; if y.c /= 782 or else y.e /= 148 then put_line("*** FAILED Wrong number of comparisons or exchanges"); else put_line("*** PASSED Sorting test"); end if; exception when failed => put_line("*** FAILED Vector not sorted"); end main; ------------------------------------------------------------------- --------------------- Next Program ----------------------------- ------------------------------------------------------------------- ---------------------------------------------------------------------- -- -- QUICK SORT BENCHMARK -- -- Version: @(#)qsortseq.ada 1.1 Date: 6/5/84 -- -- Gerry Fisher -- Computer Sciences Corporation -- May 27, 1984 -- -- -- This benchmark consists of two versions of the familiar quick -- sort algorithm: a parallel version and a sequential version. -- A relatively small vector (length 100) is sorted into ascending -- sequence. The number of comparisons and exchanges is counted. -- In the parallel version separate tasks are created to sort the -- two subvectors created by partitioning the vector. Each task -- invokes the quicksort procedure. The parallel version is -- functionally equivalent to the sequential version and should -- require the same number of comparisions and exchanges. A check -- is made to verify that this is so. Also, the sorted vector is -- checked to verify that the sort has been performed correctly. -- Control is exercised so that no more than fourteen tasks are -- created when sorting the vector. -- -- The sorting is repeated a number of times to obtain a measurable -- amount of execution time. -- -- The important measure for this benchmark is the ratio of the -- execution time of the parallel version to that of the sequential -- version. This will give some indication of task activation and -- scheduling overhead. -- -- One file is used for both versions. The boolean constant "p" -- indicates whether the parallel or serial version of the algorithm -- is to be used. Simply set this constant TRUE for the parallel -- test and FALSE for the sequential test. A difference in code -- size between the two tests may indicate that conditional -- compilation is supported by the compiler. -- -------------------------------------------------------------------- with text_io; use text_io; procedure main is failed : exception; type vector is array(integer range <>) of integer; type stats is record c, e : integer := 0; end record; p : constant boolean := false; -- true for parallel algorithm n : constant integer := 100; -- size of vector to be sorted m : constant integer := 100; -- number of times to sort vector x : vector(1 .. n); y : stats; procedure Quick_sort(A : in out vector; w : out stats) is lb : constant integer := A'first; ub : constant integer := A'last; k : integer; c, e : integer := 0; u, v : stats; function partition(L, U : integer) return integer is q, r, i, j : integer; begin r := A((U + L)/2); i := L; j := U; while i < j loop while A(i) < r loop c := c + 1; i := i + 1; end loop; while A(j) > r loop c := c + 1; j := j - 1; end loop; c := c + 2; if i <= j then e := e + 1; q := A(i); A(i) := A(j); A(j) := q; i := i + 1; j := j - 1; end if; end loop; if j > L then return j; else return L; end if; end partition; begin if lb < ub then k := partition(lb, ub); if ub > lb + 15 then if p then declare task S1; task body S1 is begin Quick_sort(A(lb .. k), u); end S1; task S2; task body S2 is begin Quick_sort(A(k + 1 .. ub), v); end S2; begin null; end; else Quick_sort(A(lb .. k), u); Quick_sort(A(k + 1 .. ub), v); end if; elsif ub > lb + 1 then Quick_sort(A(lb .. k), u); Quick_sort(A(k + 1 .. ub), v); end if; e := e + u.e + v.e; c := c + u.c + v.c; end if; w := (c, e); end Quick_sort; begin set_line_length(count(50)); if p then put_line("*** Starting Parallel Quick Sort Benchmark"); else put_line("*** Starting Sequential Quick Sort Benchmark"); end if; for k in 1 .. m loop for i in x'range loop x(i) := x'last - i + 1; end loop; Quick_sort(x, y); for i in x'first .. x'last - 1 loop if x(i) > x(i + 1) then raise failed; end if; end loop; put("."); end loop; new_line; if y.c /= 782 or else y.e /= 148 then put_line("*** FAILED Wrong number of comparisons or exchanges"); else put_line("*** PASSED Sorting test"); end if; exception when failed => put_line("*** FAILED Vector not sorted"); end main; ------------------------------------------------------------------- --------------------- Next Program ----------------------------- ------------------------------------------------------------------- -- -- Version: @(#)rendez.ada 1.2 Date: 9/21/84 -- -- Author: Bryce Bardin -- Ada Projects Section -- Software Engineering Division -- Ground Systems Group -- Hughes Aircraft Company -- Fullerton, CA -- -- This program measures the time required for a simple rendezvous. -- -- 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 rendezvous 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 Rendezvous is Times : 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; task T is entry Call; end T; -- This package is used to prevent elimination of the "null" timing loop -- by a smart compiler. package Prevent is Count : Natural := 0; procedure Prevent_Optimization; end Prevent; use Prevent; task body T is begin loop select accept Call; or terminate; end select; end loop; end T; package body Prevent is procedure Prevent_Optimization is begin Count := Count + 1; end Prevent_Optimization; end Prevent; begin -- Measure the timing loop overhead. Start_Time := Clock; for N in 1 .. Times loop Prevent_Optimization; end loop; Loop_Time := Clock - Start_Time; -- Measure the time including rendezvous. Start_Time := Clock; for N in 1 .. Times loop Prevent_Optimization; T.Call; end loop; Put("Loop time = "); Put(Loop_Time, Fore => 0); Put(" seconds for "); Put(Times, Width => 0); Put_Line(" iterations"); Elapsed_Time := Clock - Start_Time; Put("Elapsed time = "); Put(Elapsed_Time, Fore => 0); Put(" seconds for "); Put(Times, Width => 0); Put_Line(" iterations"); Average_Time := Real_Time(Elapsed_Time - Loop_Time)/Real_Time(Times); Put("Average time for no-parameter rendezvous = "); 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 Rendezvous; ------------------------------------------------------------------- --------------------- Next Program ----------------------------- ------------------------------------------------------------------- -- -- Version: @(#)sets.ada 1.2 Date: 9/20/84 -- -- -- Author: Bryce Bardin -- Ada Projects Section -- Software Engineering Division -- Ground Systems Group -- Hughes Aircraft Company -- Fullerton, CA -- -- This is a highly portable implementation of sets in Ada. -- -- N. B.: Vendors are invited to supply listings which demonstrate -- the quality of the code generated. -- generic type Element is (<>); with function Image (E : Element) return String is Element'Image; package Sets is type Set is private; -- A set of elements. Empty_Set : constant Set; -- The set of no elements. Full_Set : constant Set; -- The set of all elements. function "and" (Left, Right : Set) return Set; -- Returns the conjunction (intersection) of two sets. -- Usage: S1 and S2 function "or" (Left, Right : Set) return Set; -- Returns the inclusive disjunction (union) of two sets. -- Usage: S1 or S2 function "xor" (Left, Right : Set) return Set; -- Returns the exclusive disjunction of two sets. -- Usage: S1 xor S2 function "not" (Right : Set) return Set; -- Returns the negation (complement) of a set, i.e., the set of -- all elements not in Right. -- Usage: not S function "-" (Left, Right : Set) return Set; -- Returns the difference of two sets, i.e., the set of elements -- in Left which are not in Right. -- Usage: S1 - S2 function "+" (Left : Element; Right : Set) return Set; -- Adds an element to a set. -- Returns the union (or) of an element with a set. -- Usage: E + S function "+" (Left : Set; Right : Element) return Set; -- Adds an element to a set. -- Returns the union (or) of an element with a set. -- Usage: S + E function "+" (Right : Element) return Set; -- Makes an element into a Set. -- Returns the union of the element with the Empty_Set. -- Usage: + E function "+" (Left, Right : Element) return Set; -- Combines two elements into a Set. -- Returns the union (or) of two elements with the Empty_Set. -- Usage: E1 + E2 function "-" (Left : Set; Right : Element) return Set; -- Deletes an element from a set, i.e., removes it from the set -- if it is currently a member of the set, otherwise it returns -- the original set. -- Usage: S - E -- This function is predefined: -- function "=" (Left, Right : Set) return Boolean; -- Tests whether Left is identical to Right. -- Usage: S1 = S2 function "<=" (Left, Right : Set) return Boolean; -- Tests whether Left is contained in Right, i.e., whether Left -- is a subset of Right. -- Usage: S1 <= S2 function Is_Member (S : Set; E : Element) return Boolean; -- Tests an element for membership in a set. -- Returns true if an element is in a set. -- Usage: Is_Member (S, E) procedure Put (S : Set); -- Prints a set. -- Usage: Put (S) private type Set is array (Element) of Boolean; -- A set of elements. Empty_Set : constant Set := (Element => False); -- The set of no elements. Full_Set : constant Set := (Element => True); -- The set of all elements. pragma Inline ("and"); pragma Inline ("or"); pragma Inline ("xor"); pragma Inline ("not"); pragma Inline ("-"); pragma Inline ("+"); pragma Inline ("<="); pragma Inline ("Is_Member"); end Sets; with Text_IO; use Text_IO; package body Sets is type Bool is array (Element) of Boolean; function "and" (Left, Right : Set) return Set is begin return Set(Bool(Left) and Bool(Right)); end "and"; function "or" (Left, Right : Set) return Set is begin return Set(Bool(Left) or Bool(Right)); end "or"; function "xor" (Left, Right : Set) return Set is begin return Set(Bool(Left) xor Bool(Right)); end "xor"; function "not" (Right : Set) return Set is begin return Set(not Bool(Right)); end "not"; function "-" (Left, Right : Set) return Set is begin return (Left and not Right); end "-"; function "+" (Left : Element; Right : Set) return Set is Temp : Set := Right; begin Temp(Left) := True; return Temp; end "+"; function "+" (Left : Set; Right : Element) return Set is Temp : Set := Left; begin Temp(Right) := True; return Temp; end "+"; function "+" (Right : Element) return Set is begin return Empty_Set + Right; end "+"; function "+" (Left, Right : Element) return Set is begin return Empty_Set + Left + Right; end "+"; function "-" (Left : Set; Right : Element) return Set is Temp : Set := Left; begin Temp(Right) := False; return Temp; end "-"; function "<=" (Left, Right : Set) return Boolean is begin return ((Left and not Right) = Empty_Set); end "<="; function Is_Member (S : Set; E : Element) return Boolean is begin return (S(E) = True); end Is_Member; procedure Put (S : Set) is Comma_Needed : Boolean := False; begin Text_IO.Put ("{"); for E in Element loop if S(E) then if Comma_Needed then Text_IO.Put (","); end if; Text_IO.Put (Image(E)); Comma_Needed := True; end if; end loop; Text_IO.Put ("}"); New_Line; end Put; end Sets; -- This procedure tests the set package. -- Its output is self-explanatory. with Text_IO; use Text_IO; with Sets; procedure Main is type Color is (Red, Yellow, Green, Blue); package Color_Set is new Sets(Color); use Color_Set; X, Y, Z : Set; procedure Put_Set (Name : String; S : Set) is begin Put (Name); Put (" = "); Put (S); end Put_Set; procedure Compare_Set (S_String : String; S : Set; T_String : String; T : Set) is begin if S = T then Put (S_String); Put (" is identical to "); Put (T_String); New_Line; end if; if S /= T then Put (S_String); Put (" is not identical to "); Put (T_String); New_Line; end if; if S <= T then Put (S_String); Put (" is a subset of "); Put (T_String); New_Line; end if; if T <= S then Put (T_String); Put (" is a subset of "); Put (S_String); New_Line; end if; end Compare_Set; procedure Test_Membership (C : Color; S_String : String; S : Set) is begin Put (Color'Image(C)); if Is_Member(S,C) then Put (" is a member of "); else Put (" is not a member of "); end if; Put (S_String); New_Line; end Test_Membership; begin X := Empty_Set; Put_Line ("X := Empty_Set"); Put_Set ("X",X); Y := Empty_Set; Put_Line ("Y := Empty_Set"); Put_Set ("Y",Y); Compare_Set ("X",X,"Y",Y); Y := Full_Set; Put_Line ("Y := Full_Set"); Put_Set ("Y",Y); Compare_Set ("X",X,"Y",Y); X := not X; Put_Line ("X := not X"); Put_Set ("X",X); Compare_Set ("X",X,"Y",Y); Y := Empty_Set + Blue; Put_Line ("Y := Empty_Set + Blue"); Put_Set ("Y",Y); Y := + Yellow; Put_Line ("Y := + Yellow"); Put_Set ("Y",Y); Y := Blue + Y; Put_Line ("Y := Blue + Y"); Put_Set ("Y",Y); X := Full_Set - Red; Put_Line ("X := Full_Set - Red"); Put_Set ("X",X); Test_Membership (Red,"X",X); Test_Membership (Yellow,"X",X); Compare_Set ("X",X,"Y",Y); Z := X - Y; Put_Line ("Z := X - Y"); Put_Set ("Z",Z); Z := Y - X; Put_Line ("Z := Y - X"); Put_Set ("Z",Z); X := Green + Blue + Yellow + Red; Put_Line ("X := Green + Blue + Yellow + Red"); Put_Set ("X",X); X := Green + Blue; Put_Line ("X := Green + Blue"); Put_Set ("X",X); Z := X or Y; Put_Line ("Z := X or Y"); Put_Set ("Z",Z); Z := X and Y; Put_Line ("Z := X and Y"); Put_Set ("Z",Z); Z := X xor Y; Put_Line ("Z := X xor Y"); Put_Set ("Z",Z); end Main; ------------------------------------------------------------------- --------------------- Next Program ----------------------------- ------------------------------------------------------------------- -- -- Version: @(#)shared.ada 1.1 Date: 5/30/84 -- -- -- Author: Bryce Bardin -- Ada Projects Section -- Software Engineering Division -- Ground Systems Group -- Hughes Aircraft Company -- Fullerton, CA -- -- This program illustrates the use of tasking to provide shared access -- to global variables. N.B.: The values it outputs may vary from run -- to run depending on how tasking is implemented. -- A "FIFO" solution to the READERS/WRITERS problem. -- Authors: Gerald Fisher and Robert Dewar. -- (Modified by Bryce Bardin to terminate gracefully.) -- May be used to provide shared access to objects by an arbitrary number of -- readers and writers which are serviced in order from a single queue. -- Writers are given uninterrupted access for updates and readers are assured -- that updates are indivisible and therefore complete when read access is -- granted. -- -- If C is a task object of type Control and O is an object which is to be -- shared between readers and writers using C, then: -- -- readers should do: -- -- C.Start(Read); ---- C.Stop; -- -- and writers should do: -- -- C.Start(Write); -- -- C.Stop; package Readers_Writers is type Service is (Read, Write); task type Control is entry Start (Mode : Service); -- start readers or writers entry Stop; -- stop readers or writers end Control; end Readers_Writers; package body Readers_Writers is task body Control is Read_Count : Natural := 0; begin loop select -- remove the first reader or writer from the queue accept Start (Mode : Service) do if Mode = Read then Read_Count := Read_Count + 1; else -- when writer, wait for readers which have already -- started to finish before allowing the writer to -- perform the update while Read_Count > 0 loop -- when a write is pending, readers stop here accept Stop; Read_Count := Read_Count - 1; end loop; end if; end Start; if Read_Count = 0 then -- when writer, wait for writer to stop before allowing -- other readers or writers to start accept Stop; end if; or -- when no write is pending, readers stop here accept Stop; Read_Count := Read_Count -1; or -- quit when everyone agrees to do so terminate; end select; end loop; end Control; end Readers_Writers; -- This package allows any number of concurrent programs to read and/or -- indivisibly write a particular (possibly composite) variable object -- without interference and in FIFO order. Similar packages can be -- constructed to perform partial reads and writes of composite objects. -- If service cannot be started before the appropriate time limit expires, -- the exception Timed_Out will be raised. (By default, service must be -- started within Duration'Last (24+) hours. Setting the time limits to -- 0.0 will require immediate service.) -- generic type Object_Type is private; Object : in out Object_Type; Read_Time_Limit : in Duration := Duration'Last; Write_Time_Limit : in Duration := Duration'Last; -- for testing only with procedure Read_Put (Item : in Object_Type) is <>; -- for testing only with procedure Write_Put (Item : in Object_Type) is <>; -- for testing only with procedure Copy (From : in Object_Type; To : in out Object_Type); package Shared_Variable is -- for testing only: Item made "in out" instead of "out" procedure Read (Item : in out Object_Type); procedure Write (Item : in Object_Type); Timed_Out : exception; end Shared_Variable; with Readers_Writers; use Readers_Writers; package body Shared_Variable is C : Control; -- for testing only: Item made "in out" instead of "out" procedure Read (Item : in out Object_Type) is begin select C.Start(Read); or delay Read_Time_Limit; raise Timed_Out; end select; -- for testing only; this allows the scheduler to screw up! Copy(From => Object, To => Item); -- temporarily replaces -- Item := Object; -- for testing only Read_Put(Item); C.Stop; end Read; procedure Write (Item : in Object_Type) is begin select C.Start(Write); or delay Write_Time_Limit; raise Timed_Out; end select; -- for testing only; this allows the scheduler to screw up! Copy(From => Item, To => Object); -- temporarily replaces Object := Item; -- for testing only Write_Put(Item); C.Stop; end Write; end Shared_Variable; with Shared_Variable; package Encapsulate is Max : constant := 2; subtype Index is Positive range 1 .. Max; type Composite is array (Index) of Integer; procedure Read (C : out Composite); procedure Write (C : in Composite); -- This is a help function for testing function Set_To (I : Integer) return Composite; -- This is a help function for testing function Value_Of (C : Composite) return Integer; -- This entry is used to serialize debug output to Standard_Output task Msg is entry Put (S : String); end Msg; end Encapsulate; with Text_IO; package body Encapsulate is Shared : Composite; function Set_To (I : Integer) return Composite is Temp : Composite; begin for N in Index loop Temp(N) := I; end loop; return Temp; end Set_To; function Value_Of (C : Composite) return Integer is begin return C(Index'First); end Value_Of; -- for testing only; this allows the scheduler to overlap readers and -- writers and thus screw up if Readers_Writers doesn't do its job. -- it also checks that the copy is consistent. procedure Copy (From : in Composite; To : in out Composite) is begin for I in Index loop To(I) := From(I); -- delay so that another access could be made: delay 0.5; end loop; -- test for consistency: for I in Index range Index'Succ(Index'First) .. Index'Last loop if To(I) /= To(Index'First) then raise Program_Error; end if; end loop; end Copy; procedure Read_Put (Item : Composite) is begin Msg.Put(Integer'Image(Value_Of(Item)) & " read"); end Read_Put; procedure Write_Put (Item : Composite) is begin Msg.Put(Integer'Image(Value_Of(Item)) & " written"); end Write_Put; task body Msg is begin loop select accept Put (S : String) do Text_IO.Put (S); Text_IO.New_Line; end Put; or terminate; end select; end loop; end Msg; package Share is new Shared_Variable (Object_Type => Composite, Object => Shared, Read_Put => Read_Put, Write_Put => Write_Put, Copy => Copy); use Share; procedure Read (C : out Composite) is Temp : Composite; begin Share.Read(Temp); C := Temp; end Read; procedure Write (C : in Composite) is begin Share.Write(C); end Write; begin Shared := Set_To (0); end Encapsulate; with Encapsulate; use Encapsulate; with Text_IO; use Text_IO; procedure Test_Shared is Local : Composite := Set_To (-1); task A; task B; task C; procedure Put(C : Character; I : Integer); task body A is begin Read(Local); Put('A',Value_Of(Local)); Write(Set_To(1)); Read(Local); Put('A',Value_Of(Local)); Write(Set_To(2)); Read(Local); Put('A',Value_Of(Local)); end A; task body B is begin Read(Local); Put('B',Value_Of(Local)); Write(Set_To(3)); Read(Local); Put('B',Value_Of(Local)); end B; task body C is begin Write(Set_To(4)); Read(Local); Put('C',Value_Of(Local)); Write(Set_To(5)); Read(Local); Put('C',Value_Of(Local)); end C; procedure Put(C : Character; I : Integer) is begin Msg.Put("Task " & C & " read the value " & Integer'Image(I)); end Put; begin null; end Test_Shared;