DataMuseum.dk

top - metrics - download

    Length: 4611 (0x1203)
    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⟧ 

TextFile

--
-- 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;