DataMuseum.dk

top - download

    Length: 6873 (0x1ad9)
    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.
--
--

separate (Task_Management)
package body Ipc_Support is

    pragma Suppress_All;

    procedure Purge_A_Queue
                 (For_Task : Task_Id; The_Queue : Mq.Id; Was_Ipc_Q : Boolean) is
        pragma Routine_Number (Runtime_Ids.Internal);
        Status      : Mq.Stratus;
        Message     : Entry_Call_Message;
        Next_Caller : Task_Id;
    begin
        if Was_Ipc_Q then
            Ipc.Evacuate_Queue (The_Queue  => The_Queue,
                                Queue_Data => Message_Queue_Utilities.
                                                 Get_Associated_Data
                                                 (The_Queue, For_Task));
        end if;

        Mq.Delete_If_Empty (The_Queue, Status);
        if Status = Mq.Q_Notemp then
            loop
                Mq.Retrieve_If_Available (The_Queue, Message'Address,
                                          Entry_Call_Message_Size, Status);
                exit when Status = Mq.Q_Nomess;

                Message_Queue_Utilities.Cancel_Timer
                   (Message.Timer_Id, Current_Task => For_Task);
                Next_Caller := To_Task_Id (Message.Caller);

                Next_Caller.Exception_Id := Exceptions.Tasking_Error;
                Next_Caller.Action_State (Exception_Pending) := True;

                Message_Queue_Utilities.Send_Reply
                   (Next_Caller, Rendezvous_Done, Current_Task => For_Task);
            end loop;

            Mq.Delete_If_Empty (The_Queue, Status);

        end if;

        if Safety_Check then
            Checking.Check_Message_Queue_Status
               (Status, Err.Bad_Status_From_Delete_If_Empty,
                Current_Task => For_Task);
        end if;
    end Purge_A_Queue;


    procedure Attach_Queue (For_Entry :     Entry_Id;
                            New_Queue :     Message_Queues.Id;
                            Result    : out Status) is
        pragma Routine_Number (Runtime_Ids.Internal);
        Current_Task : constant Task_Id := Get_Current_Task_And_Acquire_Lock;
        Length       : Mq.Queue_Length;
        Status       : Mq.Stratus;
    begin
        if Debug_Mode then
            Debugging.Put_Message ("Entered Attach_Queue");
        end if;

        -- test if Queue is valid, Length is non-destructive
        Mq.Length (New_Queue, Status, Length);

        if Status /= Mq.Q_Success then
            Result := Invalid_Queue;

        elsif For_Entry not in Valid_Entry_Id'First ..
                                  Entry_Id (Current_Task.Queues.
                                            Wait_List.List'Last) then
            Result := Invalid_Entry;
        else
            declare
                The_Item : Mq.Wait_Item
                    renames Current_Task.Queues.Wait_List.List
                               (Mq.Wait_List_Index (For_Entry));
                Prior_Q  : constant Mq.Id   := The_Item.Wait_Queue;
                Was_Ipc  : constant Boolean := The_Item.Ipc_Queue;
            begin
                The_Item.Wait_Queue := New_Queue;
                The_Item.Ipc_Queue  := False;
                The_Item.Ipc_Queue  := True;

                Purge_A_Queue (For_Task  => Current_Task,
                               The_Queue => Prior_Q,
                               Was_Ipc_Q => Was_Ipc);  
            end;

            Result := Success;
        end if;

        Release_Lock;
    end Attach_Queue;

    procedure Detach_Queue (For_Entry : Entry_Id; Result : out Status) is
        pragma Routine_Number (Runtime_Ids.Internal);
        Current_Task : constant Task_Id := Get_Current_Task_And_Acquire_Lock;
    begin
        if Debug_Mode then
            Debugging.Put_Message ("Entered Detach_Queue");
        end if;

        if For_Entry not in Valid_Entry_Id'First ..
                               Entry_Id (Current_Task.Queues.
                                         Wait_List.List'Last) then
            Result := Invalid_Entry;
        else
            declare
                The_Item  : Mq.Wait_Item
                    renames Current_Task.Queues.Wait_List.List
                               (Mq.Wait_List_Index (For_Entry));
                Prior_Q   : constant Mq.Id   := The_Item.Wait_Queue;
                Was_Ipc   : constant Boolean := The_Item.Ipc_Queue;
                New_Queue : Mq.Id;
                Status    : Mq.Stratus;
            begin
                if Was_Ipc then
                    Mq.Create (Max_Message_Size  => Entry_Call_Message_Size,
                               Max_Message_Count => 64, -- ??
                               Result            => Status,
                               New_Queue         => New_Queue);
                    if Status = Mq.Q_Quesiz then
                        if Debug_Mode then
                            Debugging.Put_Message
                               ("Message_Queue.Create failed due to lack of storage; raising Storage_Error");
                        end if;
                        Runtime_Exceptions.Raise_Storage_Error;
                    else
                        if Safety_Check then
                            Checking.Check_Message_Queue_Status
                               (Status, Err.Bad_Status_From_Create,
                                Current_Task => Current_Task);
                        end if;
                    end if;

                    The_Item.Wait_Queue := New_Queue;
                    The_Item.Ipc_Queue  := False;

                    Purge_A_Queue (For_Task  => Current_Task,
                                   The_Queue => Prior_Q,
                                   Was_Ipc_Q => True);

                    Result := Success;
                else
                    Result := Invalid_Queue;
                end if;
            end;
        end if;

        Release_Lock;
    end Detach_Queue;

end Ipc_Support;
pragma Runtime_Unit (Unit_Number         => Runtime_Ids.Runtime_Compunit,
                     Elab_Routine_Number => Runtime_Ids.Internal);