DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 29621 (0x73b5) Types: TextFile Names: »B«
└─⟦afbc8121e⟧ Bits:30000532 8mm tape, Rational 1000, MC68020_OS2000 7_2_2 └─ ⟦77aa8350c⟧ »DATA« └─⟦f794ecd1d⟧ └─⟦24d1ddd49⟧ └─⟦this⟧
-- 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 Calling_And_Delaying is pragma Suppress_All; -- Note: There is currently does no way to suppress overflow check -- due to egau/backend limitations. Entry_Id_Size : constant := Entry_Id'Size / 8; Duration_Size : constant := Duration'Size / 8; procedure Acknowledge_Abortion (Current_Task : Task_Id; Already_Acknowledged : in out Boolean) is pragma Routine_Number (Runtime_Ids.Internal); -- There is a comment in Abort_Multiple_Tasks -- that explains all of this. function Convert is new Unchecked_Conversion (System.Address, Group_Ref); begin if not Already_Acknowledged then Already_Acknowledged := True; declare Aborter : Task_Id renames Convert (Current_Task.Activations_In_Progress'Address). all; Aborted_While_Calling_Entry : Integer renames Aborter.Activations_In_Progress; begin -- if Safety_Check then -- Checking.Check_Task -- (Aborter, "Acknowledge_Abortion", -- Current_Task => Current_Task); -- end if; Aborted_While_Calling_Entry := Aborted_While_Calling_Entry - 1; if Aborted_While_Calling_Entry = 0 then Message_Queue_Utilities.Send_Reply (Aborter, Abortion_Acknowledged, Current_Task => Current_Task); end if; Aborter := null; end; end if; end Acknowledge_Abortion; procedure Cancel_Call (Current_Task : Task_Id; Message_Id : Mq.Message_Id; Entry_Queue : Mq.Id; Called_Task : Task_Id; Acknowledged_Abortion : in out Boolean) is pragma Routine_Number (Runtime_Ids.Internal); -- Maybe_Timeout_Pending : Boolean := False; -- Maybe_Abortion_Pending : Boolean := False) is -- Timeout_Reply_Ok : Boolean := Maybe_Timeout_Pending; -- Abortion_Reply_Ok : Boolean := Maybe_Abortion_Pending; Too_Late : Boolean := Message_Id = Mq.Null_Message; Reply : Reply_Kind; Status : Mq.Stratus; begin if not Too_Late then Mq.Remove_Message (Entry_Queue, Message_Id, Status); case Status is when Mq.Q_Nomess => Too_Late := True; when Mq.Q_Illque => Too_Late := (Called_Task.Suspension_State = Terminated) or else Called_Task.Action_State (Abnormal); when others => Too_Late := False; end case; end if; if Current_Task.Action_State (Abnormal) then Acknowledge_Abortion (Current_Task, Acknowledged_Abortion); end if; if Too_Late then -- if Debug_Mode then -- Debugging.Put_Message -- ("Too late to cancel entry call; must await reply"); -- end if; loop -- Rendezvous has already begun, so can't cancel it; -- instead, we wait for rendezvous to finish. -- Message_Queue_Utilities.Await_Reply (Calling_Entry, Reply, Current_Task => Current_Task); exit when Reply = Rendezvous_Done; -- if Timeout_Reply_Ok and then Reply = Call_Timed_Out then -- Timeout_Reply_Ok := False; -- elsif Abortion_Reply_Ok and then Reply = Task_Aborted then -- Abortion_Reply_Ok := False; -- else -- if Safety_Check then -- Checking.Check_Reply -- (Reply, Rendezvous_Done, -- Current_Task => Current_Task); -- end if; -- exit; -- end if; end loop; -- else -- if Safety_Check then -- Checking.Check_Message_Queue_Status -- (Status, Err.Bad_Status_From_Remove_Message, -- Current_Task => Current_Task); -- end if; -- if Debug_Mode then -- Debugging.Put_Message ("Cancelled entry call"); -- end if; end if; end Cancel_Call; \f -- Note: Param_Address is the address before the last argument passed to -- the particular form of entry call; the callers parameters are on the -- stack at this address. -- procedure Common_Entry_Call (Called_Task : Task_Id; -- The_Entry : Entry_Id; -- Param_Address : System_Address; -- Call_Kind : Entry_Call_Kind; -- Time : Duration := Duration'First; -- Call_Accepted : out Boolean) is -- -- Current_Task : constant Task_Id := Get_Current_Task_And_Acquire_Lock; -- Entry_Queue : Mq.Id -- renames Called_Task.Queues.Wait_List.List -- (Mq.Wait_List_Index (The_Entry)).Wait_Queue; -- Entry_Message : Entry_Call_Message; -- Message_Id : Mq.Message_Id; -- -- Reply : Reply_Kind; -- Status : Mq.Stratus; -- -- Acknowledged_Abortion : Boolean := False; -- begin -- -- if Debug_Mode then -- -- Debugging.Put_Message -- -- ("Entered Common_Entry_Call, Call_Kind = " & -- -- Entry_Call_Kind'Image (Call_Kind) & ", Called_Task =" & -- -- Integer'Image (Called_Task.Os9_Process_Id) & -- -- ", The_Entry =" & Integer'Image (Integer (The_Entry))); -- -- end if; -- -- -- -- if Safety_Check then -- -- Checking.Check_Task (Called_Task, "Common_Entry_Call", -- -- Current_Task => Current_Task); -- -- if The_Entry not in Valid_Entry_Id'First .. -- -- Entry_Id (Called_Task.Queues. -- -- Wait_List.List'Last) then -- -- Runtime_Exceptions.Raise_Runtime_Error -- -- ("Common_Entry_Call", -- -- "The_Entry = " & Integer'Image (Integer (The_Entry)) & -- -- ", which is not in the range 1 .. " & -- -- Integer'Image (Integer (Called_Task.Queues. -- -- Wait_List.List'Last)), -- -- Err.Bad_Entry_Number, -- -- Current_Task => Current_Task); -- -- end if; -- -- end if; -- -- --Runtime_Exceptions.Check_For_Abnormality (Current_Task => Current_Task); -- if Current_Task.Action_State (Abnormal) then -- Runtime_Exceptions.Raise_Abnormal_Task_Error -- (Current_Task => Current_Task); -- end if; -- -- if Called_Task.Action_State (Non_Callable) then -- Runtime_Exceptions.Raise_Tasking_Error; -- end if; -- -- Entry_Message.Caller := To_Caller_Name (Current_Task); -- Entry_Message.Rendezvous_Params := Param_Address; -- Entry_Message.Timer_Id := 0; -- -- case Call_Kind is -- when Simple => -- Mq.Send (Buffer => Entry_Message'Address, -- Size => Entry_Call_Message_Size, -- Queue => Entry_Queue, -- Result => Status, -- Handle => Message_Id); -- -- when Conditional => -- Mq.Conditional_Send (Buffer => Entry_Message'Address, -- Size => Entry_Call_Message_Size, -- Queue => Entry_Queue, -- Result => Status, -- Handle => Message_Id); -- -- when Timed => -- Entry_Message.Timer_Id := -- Message_Queue_Utilities.Start_Timer -- (Time, Call_Timed_Out, Current_Task => Current_Task); -- Mq.Send (Buffer => Entry_Message'Address, -- Size => Entry_Call_Message_Size, -- Queue => Entry_Queue, -- Result => Status, -- Handle => Message_Id); -- end case; -- -- if Status = Mq.Q_Full then -- if Call_Kind = Timed then -- Message_Queue_Utilities.Cancel_Timer -- (Timer_Id => Entry_Message.Timer_Id, -- Current_Task => Current_Task); -- end if; -- -- if Debug_Mode then -- -- Debugging.Put_Message -- -- ("Entry call raising Storage_Error due to full message queue"); -- -- end if; -- Runtime_Exceptions.Raise_Storage_Error; -- -- elsif (Call_Kind = Conditional) and then (Status = Mq.Q_Nowait) then -- Reply := Call_Timed_Out; -- else -- -- if Safety_Check then -- -- Checking.Check_Message_Queue_Status -- -- (Status, Err.Bad_Status_From_Send, -- -- Current_Task => Current_Task); -- -- -- -- if (Call_Kind = Conditional) and then -- -- (Message_Id /= Mq.Null_Message) then -- -- Runtime_Exceptions.Raise_Runtime_Error -- -- ("Common_Entry_Call", -- -- "Message_Queue.Conditional_Send returned non-null Message_Id", -- -- Err.Bad_Msg_Id_From_Send, -- -- Current_Task => Current_Task); -- -- end if; -- -- end if; -- -- -- if Debug_Mode then -- -- if Message_Id /= Mq.Null_Message then -- -- Debugging.Put_Message -- -- (" entry call not immediately accepted (callee was not waiting)"); -- -- else -- -- Debugging.Put_Message -- -- (" entry call accepted immediately (callee was waiting)"); -- -- end if; -- -- end if; -- -- Message_Queue_Utilities.Await_Reply -- (Calling_Entry, Reply, Current_Task => Current_Task); -- -- if Call_Kind = Timed then -- case Reply is -- when Call_Timed_Out => -- Cancel_Call (Current_Task, Message_Id, Entry_Queue, -- Called_Task, Acknowledged_Abortion); -- when Task_Aborted => -- Message_Queue_Utilities.Cancel_Timer -- (Timer_Id => Entry_Message.Timer_Id, -- Current_Task => Current_Task); -- Cancel_Call (Current_Task, Message_Id, Entry_Queue, -- Called_Task, Acknowledged_Abortion); -- when others => -- -- Callee has already cancelled timer. -- null; -- -- -- if Safety_Check then -- -- Checking.Check_Reply -- -- (Reply, Rendezvous_Done, -- -- Current_Task => Current_Task); -- -- end if; -- end case; -- else -- case Reply is -- when Task_Aborted => -- Cancel_Call (Current_Task, Message_Id, Entry_Queue, -- Called_Task, Acknowledged_Abortion); -- when others => -- null; -- -- if Safety_Check then -- -- Checking.Check_Reply -- -- (Reply, Rendezvous_Done, -- -- Current_Task => Current_Task); -- -- end if; -- end case; -- end if; -- end if; -- -- if Current_Task.Action_State (Abnormal) then -- Acknowledge_Abortion (Current_Task, Acknowledged_Abortion); -- Message_Queue_Utilities.Purge_Reply_Queue -- (Current_Task => Current_Task); -- end if; -- -- -- if Safety_Check then -- -- Message_Queue_Utilities.Assert_Empty_Reply_Queue -- -- ("Common_Entry_Call", Current_Task => Current_Task); -- -- end if; -- -- -- Runtime_Exceptions.Check_For_Pending_Exception -- -- (Current_Task => Current_Task); -- if Current_Task.Action_State (Abnormal) then -- Runtime_Exceptions.Raise_Abnormal_Task_Error -- (Current_Task => Current_Task); -- end if; -- if Current_Task.Action_State (Exception_Pending) then -- -- if Debug_Mode then -- -- Debugging.Put_Message ("Reraising exception"); -- -- end if; -- -- -- could be Runtime_Exceptions.Raise_Exception; -- -- but it is not visible -- Runtime_Exceptions.Check_For_Pending_Exception -- (Current_Task => Current_Task); -- end if; -- -- -- if Debug_Mode then -- -- if Reply = Rendezvous_Done then -- -- Debugging.Put_Message -- -- ("Resuming after entry call, rendezvous (or tasking error) occurred"); -- -- else -- -- Debugging.Put_Message -- -- ("Resuming after entry call, no rendezvous occurred"); -- -- end if; -- -- end if; -- -- Call_Accepted := (Reply = Rendezvous_Done); -- Release_Lock; -- end Common_Entry_Call; \f procedure Entry_Call (To_Task : Task_Id; At_Entry : Entry_Id) is pragma Routine_Number (Runtime_Ids.Entry_Call, Pop_Params => False); Current_Task : constant Task_Id := Get_Current_Task_And_Acquire_Lock; Entry_Queue : Mq.Id renames To_Task.Queues.Wait_List.List (Mq.Wait_List_Index (At_Entry)).Wait_Queue; Entry_Message : Entry_Call_Message; Message_Id : Mq.Message_Id; Reply : Reply_Kind; Status : Mq.Stratus; Acknowledged_Abortion : Boolean := False; begin if Current_Task.Action_State (Abnormal) then Runtime_Exceptions.Raise_Abnormal_Task_Error (Current_Task => Current_Task); end if; if To_Task.Action_State (Non_Callable) then Runtime_Exceptions.Raise_Tasking_Error; end if; Entry_Message.Caller := To_Caller_Name (Current_Task); Entry_Message.Rendezvous_Params := (To_Integer (At_Entry'Address) + Entry_Id_Size); Entry_Message.Timer_Id := 0; Mq.Send (Buffer => Entry_Message'Address, Size => Entry_Call_Message_Size, Queue => Entry_Queue, Result => Status, Handle => Message_Id); if Status = Mq.Q_Full then Runtime_Exceptions.Raise_Storage_Error; else -- Message_Queue_Utilities.Await_Reply -- (Calling_Entry, Reply, Current_Task => Current_Task); declare Wait_Item : Mq.Wait_Item renames Current_Task.Queues.Wait_List.List (Reply_Queue_Index); Reply_Index : Mq.Wait_List_Index; begin Current_Task.Suspension_State := Calling_Entry; Release_Lock; Mq.Wait (Wait_Item'Address, 1, Reply_Index); Reacquire_Lock; Mq.Retrieve_Message (Wait_Item.Wait_Queue, Reply'Address, Reply_Message_Size); Current_Task.Suspension_State := Not_Suspended; end; if Reply = Task_Aborted then Cancel_Call (Current_Task, Message_Id, Entry_Queue, To_Task, Acknowledged_Abortion); end if; end if; if Current_Task.Action_State (Abnormal) then Acknowledge_Abortion (Current_Task, Acknowledged_Abortion); Message_Queue_Utilities.Purge_Reply_Queue (Current_Task => Current_Task); Runtime_Exceptions.Raise_Abnormal_Task_Error (Current_Task => Current_Task); end if; if Current_Task.Action_State (Exception_Pending) then Runtime_Exceptions.Raise_Exception; end if; Release_Lock; end Entry_Call; \f function Timed_Entry_Call (To_Task : Task_Id; At_Entry : Entry_Id; For_Duration : Duration) -- return Boolean is --!!Kludge workaround for MP problem return Integer is pragma Routine_Number (Runtime_Ids.Timed_Entry_Call, Pop_Params => False); Timer_Used : constant Boolean := For_Duration > 0.0; Current_Task : constant Task_Id := Get_Current_Task_And_Acquire_Lock; Entry_Queue : Mq.Id renames To_Task.Queues.Wait_List.List (Mq.Wait_List_Index (At_Entry)).Wait_Queue; Entry_Message : Entry_Call_Message; Message_Id : Mq.Message_Id; Reply : Reply_Kind; Status : Mq.Stratus; Acknowledged_Abortion : Boolean := False; begin if Current_Task.Action_State (Abnormal) then Runtime_Exceptions.Raise_Abnormal_Task_Error (Current_Task => Current_Task); end if; if To_Task.Action_State (Non_Callable) then Runtime_Exceptions.Raise_Tasking_Error; end if; Entry_Message.Caller := To_Caller_Name (Current_Task); Entry_Message.Rendezvous_Params := (To_Integer (For_Duration'Address) + Duration_Size); if Timer_Used then Entry_Message.Timer_Id := Message_Queue_Utilities.Start_Timer (For_Duration, Call_Timed_Out, Current_Task => Current_Task); Mq.Send (Buffer => Entry_Message'Address, Size => Entry_Call_Message_Size, Queue => Entry_Queue, Result => Status, Handle => Message_Id); else Entry_Message.Timer_Id := 0; Mq.Conditional_Send (Buffer => Entry_Message'Address, Size => Entry_Call_Message_Size, Queue => Entry_Queue, Result => Status, Handle => Message_Id); end if; if Status = Mq.Q_Full then if Timer_Used then Message_Queue_Utilities.Cancel_Timer (Timer_Id => Entry_Message.Timer_Id, Current_Task => Current_Task); end if; Runtime_Exceptions.Raise_Storage_Error; elsif Status = Mq.Q_Nowait then Reply := Call_Timed_Out; else -- Message_Queue_Utilities.Await_Reply -- (Calling_Entry, Reply, Current_Task => Current_Task); declare Wait_Item : Mq.Wait_Item renames Current_Task.Queues.Wait_List.List (Reply_Queue_Index); Reply_Index : Mq.Wait_List_Index; begin Current_Task.Suspension_State := Calling_Entry; Release_Lock; Mq.Wait (Wait_Item'Address, 1, Reply_Index); Reacquire_Lock; Mq.Retrieve_Message (Wait_Item.Wait_Queue, Reply'Address, Reply_Message_Size); Current_Task.Suspension_State := Not_Suspended; end; case Reply is when Call_Timed_Out => Cancel_Call (Current_Task, Message_Id, Entry_Queue, To_Task, Acknowledged_Abortion); when Task_Aborted => if Timer_Used then Message_Queue_Utilities.Cancel_Timer (Timer_Id => Entry_Message.Timer_Id, Current_Task => Current_Task); end if; Cancel_Call (Current_Task, Message_Id, Entry_Queue, To_Task, Acknowledged_Abortion); when others => -- Callee has already cancelled timer. null; end case; end if; if Current_Task.Action_State (Abnormal) then Acknowledge_Abortion (Current_Task, Acknowledged_Abortion); Message_Queue_Utilities.Purge_Reply_Queue (Current_Task => Current_Task); Runtime_Exceptions.Raise_Abnormal_Task_Error (Current_Task => Current_Task); end if; if Current_Task.Action_State (Exception_Pending) then Runtime_Exceptions.Raise_Exception; end if; Release_Lock; --!!Kludge return Boolean'Pos (Reply = Rendezvous_Done); -- ie. Call_Accepted end Timed_Entry_Call; function Conditional_Entry_Call (To_Task : Task_Id; At_Entry : Entry_Id) -- return Boolean is --!!Kludge workaround for MP problem return Integer is pragma Routine_Number (Runtime_Ids.Conditional_Entry_Call, Pop_Params => False); Current_Task : constant Task_Id := Get_Current_Task_And_Acquire_Lock; Entry_Queue : Mq.Id renames To_Task.Queues.Wait_List.List (Mq.Wait_List_Index (At_Entry)).Wait_Queue; Entry_Message : Entry_Call_Message; Message_Id : Mq.Message_Id; Reply : Reply_Kind; Status : Mq.Stratus; Acknowledged_Abortion : Boolean := False; begin if Current_Task.Action_State (Abnormal) then Runtime_Exceptions.Raise_Abnormal_Task_Error (Current_Task => Current_Task); end if; if To_Task.Action_State (Non_Callable) then Runtime_Exceptions.Raise_Tasking_Error; end if; Entry_Message.Caller := To_Caller_Name (Current_Task); Entry_Message.Rendezvous_Params := (To_Integer (At_Entry'Address) + Entry_Id_Size); Entry_Message.Timer_Id := 0; Mq.Conditional_Send (Buffer => Entry_Message'Address, Size => Entry_Call_Message_Size, Queue => Entry_Queue, Result => Status, Handle => Message_Id); if Status = Mq.Q_Full then Runtime_Exceptions.Raise_Storage_Error; elsif Status = Mq.Q_Nowait then Reply := Call_Timed_Out; else -- Message_Queue_Utilities.Await_Reply -- (Calling_Entry, Reply, Current_Task => Current_Task); declare Wait_Item : Mq.Wait_Item renames Current_Task.Queues.Wait_List.List (Reply_Queue_Index); Reply_Index : Mq.Wait_List_Index; begin Current_Task.Suspension_State := Calling_Entry; Release_Lock; Mq.Wait (Wait_Item'Address, 1, Reply_Index); Reacquire_Lock; Mq.Retrieve_Message (Wait_Item.Wait_Queue, Reply'Address, Reply_Message_Size); Current_Task.Suspension_State := Not_Suspended; end; if Reply = Task_Aborted then Cancel_Call (Current_Task, Message_Id, Entry_Queue, To_Task, Acknowledged_Abortion); end if; end if; if Current_Task.Action_State (Abnormal) then Acknowledge_Abortion (Current_Task, Acknowledged_Abortion); Message_Queue_Utilities.Purge_Reply_Queue (Current_Task => Current_Task); Runtime_Exceptions.Raise_Abnormal_Task_Error (Current_Task => Current_Task); end if; if Current_Task.Action_State (Exception_Pending) then Runtime_Exceptions.Raise_Exception; end if; Release_Lock; --!!Kludge return Boolean'Pos (Reply = Rendezvous_Done); -- ie. Call_Accepted; end Conditional_Entry_Call; procedure Delay_Statement (For_Duration : Duration) is pragma Routine_Number (Runtime_Ids.Delay_Statement); Current_Task : constant Task_Id := Get_Current_Task_And_Acquire_Lock; Timer_Id : Timer.Id; Reply : Reply_Kind; Status : Mq.Stratus; begin -- if Debug_Mode then -- Debugging.Put_Message ("Entered Delay_Statement"); -- end if; Runtime_Exceptions.Check_For_Abnormality (Current_Task => Current_Task); if For_Duration > 0.0 then Timer_Id := Message_Queue_Utilities.Start_Timer (Current_Task => Current_Task, Time => For_Duration, Reply => Delay_Stmt_Done); -- Message_Queue_Utilities.Await_Reply -- (Delaying, Reply, Current_Task => Current_Task); declare Wait_Item : Mq.Wait_Item renames Current_Task.Queues.Wait_List.List (Reply_Queue_Index); Reply_Index : Mq.Wait_List_Index; begin Current_Task.Suspension_State := Delaying; Release_Lock; Mq.Wait (Wait_Item'Address, 1, Reply_Index); Reacquire_Lock; Mq.Retrieve_Message (Wait_Item.Wait_Queue, Reply'Address, Reply_Message_Size); Current_Task.Suspension_State := Not_Suspended; end; if Reply = Task_Aborted then Message_Queue_Utilities.Cancel_Timer (Timer_Id, Purge_If_Expired => True, Current_Task => Current_Task); Runtime_Exceptions.Raise_Abnormal_Task_Error (Current_Task => Current_Task); else -- if Safety_Check then -- Checking.Check_Reply (Reply, Delay_Stmt_Done, -- Current_Task => Current_Task); -- end if; if Current_Task.Action_State (Abnormal) then Message_Queue_Utilities.Purge_Reply_Queue (Current_Task => Current_Task); Runtime_Exceptions.Raise_Abnormal_Task_Error (Current_Task => Current_Task); end if; end if; end if; -- if Safety_Check then -- Message_Queue_Utilities.Assert_Empty_Reply_Queue -- ("Delay_Statement", Current_Task => Current_Task); -- end if; -- -- if Debug_Mode then -- Debugging.Put_Message ("Resuming after delay statement"); -- end if; Release_Lock; end Delay_Statement; end Calling_And_Delaying; pragma Runtime_Unit (Unit_Number => Runtime_Ids.Runtime_Compunit, Elab_Routine_Number => Runtime_Ids.Internal);