DataMuseum.dk

top - metrics - download

    Length: 2784 (0xae0)
    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

----------------------------------------------------------------------
--
--  THIS BENCHMARK TESTS TASKING PERFORMANCE USING THE BUFFERING TASK
--  GIVEN AS AN EXAMPLE IN CHAPTER 9.12 OF THE ADA RM.  THE CONSUMER
--  TASK IS THE MAIN PROGRAM ITSELF; THE PRODUCER AND BUFFER TASKS
--  ARE DECLARED AS TASKS WITHIN IT.  DURING EXECUTION EACH "WRITE"
--  ENTRY CALL PRODUCES A "." ON THE STANDARD OUTPUT FILE, WHILE EACH
--  "READ" CALL PRODUCES A "*".  WHEN ALL THE PRODUCED DATA HAS BEEN
--  CONSUMED A CHECK IS MADE TO SEE THAT THE DATA HAS ARRIVED IN THE
--  CORRECT ORDER AND THAT NO DATA REMAINS BUFFERED WITHIN THE BUFFER
--  TASK.
--
----------------------------------------------------------------------

with Instrument;
use Instrument;
procedure Prcoa2 is

    All_There : Boolean;

begin

    declare

        X : array (Character) of Character := (others => ' ');
        Pool_Size : constant Integer := 5;
        Pool : array (1 .. Pool_Size) of Character;
        Count : Integer range 0 .. Pool_Size := 0;

        task Buffer is
            entry Read (C : out Character);
            entry Write (C : in Character);
        end Buffer;

        task Producer;

        task body Producer is
        begin
            for C in Character loop
                Buffer.Write (C);
            end loop;
        end Producer;

        task body Buffer is
            In_Index, Out_Index : Integer range 1 .. Pool_Size := 1;
        begin
            loop
                select
                    when Count < Pool_Size =>
                        accept Write (C : in Character) do
                            Pool (In_Index) := C;
                        end Write;
                        In_Index := In_Index mod Pool_Size + 1;
                        Count := Count + 1;
                or
                    when Count > 0 =>
                        accept Read (C : out Character) do
                            C := Pool (Out_Index);
                        end Read;
                        Out_Index := Out_Index mod Pool_Size + 1;
                        Count := Count - 1;
                or
                    terminate;
                end select;
            end loop;
        end Buffer;

        function Is_Ok return Boolean is
        begin
            for I in X'Range loop
                if X (I) /= I then
                    return False;
                end if;
            end loop;
            return True;
        end Is_Ok;

    begin
        Start ("PRCOA2", "PRODUCER/CONSUMER TASK");
        for I in X'Range loop
            Buffer.Read (X (I));
        end loop;
        All_There := Is_Ok;
    end;

    if All_There then
        All_There := Ident_Bool (All_There);
    else
        Comment ("FAILED");
    end if;
    Stop;
end Prcoa2;