DataMuseum.dk

top - metrics - download

    Length: 4299 (0x10cb)
    Types: TextFile
    Names: »B«

└─⟦afbc8121e⟧ Bits:30000532 8mm tape, Rational 1000, MC68020_OS2000 7_2_2
    └─⟦77aa8350c⟧ »DATA« 
        └─⟦f794ecd1d⟧ 
            └─⟦24d1ddd49⟧ 
                └─⟦this⟧ 

TextFile

--    The use of this system is subject to the software license terms and
--    conditions agreed upon between Rational and the Customer.
--
--                Copyright 1988 by Rational.
--
--                          RESTRICTED RIGHTS LEGEND
--
--    Use, duplication, or disclosure by the Government is subject to
--    restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
--    Technical Data and Computer Software clause at 52.227-7013.
--
--
--                Rational
--                3320 Scott Boulevard
--                Santa Clara, California 95054-3197
--
--   PROPRIETARY AND CONFIDENTIAL INFORMATION OF RATIONAL;
--   USE OR COPYING WITHOUT EXPRESS WRITTEN AUTHORIZATION
--   IS STRICTLY PROHIBITED.  THIS MATERIAL IS PROTECTED AS
--   AN UNPUBLISHED WORK UNDER THE U.S. COPYRIGHT ACT OF
--   1976.  CREATED 1988.  ALL RIGHTS RESERVED.
--
--
with Exceptions;
with Message_Queues;
with Process_Ops;
with Runtime_Error;
with Timer;

package body Sequential_Ops is

    pragma Suppress_All;

    package Mq renames Message_Queues;
    package Re renames Runtime_Error;

    use Re.Values;

    Initialized : Boolean;
    pragma Import_Object (Initialized, "__SEQ_INITIALIZED");

    Wait_Item : Mq.Wait_Item;
    pragma Import_Object (Wait_Item, "__SEQ_WAIT_ITEM");


    Timer_Msg_Bytes : constant := Timer.Timeout_Message'Size / 8;


    procedure Initialize is
        pragma Routine_Number (Runtime_Ids.Internal);
        Status : Mq.Stratus;  
    begin
        Wait_Item.Not_Active := False;  
        Mq.Create (Max_Message_Size  => Timer_Msg_Bytes,  
                   Max_Message_Count => 1,  
                   Result            => Status,  
                   New_Queue         => Wait_Item.Wait_Queue);

        case Status is
            when Mq.Q_Success =>
                null;
            when Mq.Q_Quesiz =>
                raise Storage_Error;
            when others =>
                raise Exceptions.Runtime_Error;
        end case;
        Initialized := True;
    end Initialize;


    procedure Delay_Statement (For_Duration : Duration) is
        pragma Routine_Number (Runtime_Ids.Internal);
        T_Status        : Timer.Stratus;  
        Ignored         : Timer.Id;  
        Available       : Mq.Wait_List_Index;  
        Sent_Signal     : constant Timer.Timeout_Message := 4567;  
        Received_Signal : Timer.Timeout_Message;
    begin
        if For_Duration <= 0.0 then
            return;  
        end if;

        if not Initialized then
            Initialize;
        end if;

        Timer.Start (Time   => For_Duration,  
                     Queue  => Wait_Item.Wait_Queue,  
                     Signal => Sent_Signal,  
                     Result => T_Status,  
                     Handle => Ignored);

        case T_Status is
            when Timer.Ti_Success =>
                null;
            when Timer.Ti_Nofrte =>
                raise Storage_Error;
            when others =>
                raise Exceptions.Runtime_Error;
        end case;

        Mq.Wait (Wait_Item'Address, 1, Available);

        if (Available /= 1) then
            raise Exceptions.Runtime_Error;
        end if;

        Mq.Retrieve_Message (Wait_Item.Wait_Queue, Received_Signal'Address,  
                             Timer_Msg_Bytes);

        if (Received_Signal /= Sent_Signal) then
            raise Exceptions.Runtime_Error;
        end if;
    end Delay_Statement;


    procedure Finalize is
        pragma Routine_Number (Runtime_Ids.Internal);
        Status : Mq.Stratus;  
    begin
        if Initialized then
            Mq.Delete (Wait_Item.Wait_Queue, Status);

            if Status /= Mq.Q_Success then
                raise Exceptions.Runtime_Error;
            end if;
        end if;
    end Finalize;

    procedure Handle_Signal (Signal_Code : Integer) is
        pragma Routine_Number (Runtime_Ids.Internal);
    begin
        Re.Issue (Abort_Signal_Received_By_Program);
        Finalize;
        Process_Ops.Suicide;
    end Handle_Signal;

begin
    Initialized := False;
end Sequential_Ops;
pragma Export_Elaboration_Procedure ("__SEQUENTIAL_OPS_BODY_ELAB");
pragma Runtime_Unit (Unit_Number         => Runtime_Ids.Runtime_Compunit,
                     Elab_Routine_Number => Runtime_Ids.Internal);