DataMuseum.dk

top - metrics - download

    Length: 16211 (0x3f53)
    Types: TextFile
    Names: »V«

└─⟦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 Runtime_Ids;

with Exceptions;
with Tasking_Types;  
with Message_Queues;
with Debug_Definitions;
with System_Definitions;

package Task_Management is

    subtype Layer_Id           is Tasking_Types.Layer_Id;
    subtype Group_Ref          is Tasking_Types.Group_Ref;
    subtype System_Address     is Tasking_Types.System_Address;
    subtype Address_Ref        is System_Definitions.Address_Ref;
    subtype Duration           is System_Definitions.Duration;
    subtype Priority           is Tasking_Types.Priority;
    subtype Task_Id            is Tasking_Types.Task_Id;
    subtype Entry_Id           is Tasking_Types.Entry_Id;
    subtype Entry_Number       is Tasking_Types.Entry_Number;
    subtype Alternative_Number is Tasking_Types.Alternative_Number;
    subtype Select_Info        is Tasking_Types.Select_Info;

    package Creation_And_Activation is

        procedure Initialize_Master (For_Layer : Layer_Id);
        -- set up a layer to serve as master for a new scope
        -- with dependent tasks and counters; the storage for
        -- the layer object is created by the caller.
        pragma Suppress (Elaboration_Check, Initialize_Master);
        pragma Export_Procedure (Initialize_Master, "__INITIALIZE_MASTER");


        function Create_Task
                    (Activation_Group  : Group_Ref;
                     Master            : Layer_Id;
                     Start_Addr_Ref    : Address_Ref;
                     Entry_Count       : Entry_Number;
                     Stack_Space       : Integer;
                     At_Priority       : Integer;
                     Closure           : System_Address;
                     Instance_Variable : System_Address) return Task_Id;
        -- create a new task (TCB only) returning its address, with appropriate
        -- master and parent number of entries, and adding it to one of the activation
        -- groups, with a specific priority and a pointer to the environment for it
        pragma Suppress (Elaboration_Check, Create_Task);
        pragma Export_Function (Create_Task, "__CREATE_TASK");


        procedure Activate_Offspring (Activation_Group          : Group_Ref;
                                      Perform_Elaboration_Check : Boolean);
        -- for the current task, activate all offspring in one of the activation
        -- groups, deleting the group as a result; allocate stack space for task
        -- if Perform_Elaboration_Check, then a check is made that the elab
        -- objects for each task in the group is non-zero.
        pragma Suppress (Elaboration_Check, Activate_Offspring);
        pragma Export_Procedure (Activate_Offspring, "__ACTIVATE_OFFSPRING");


        procedure Notify_Parent (Tasking_Error_Found : Boolean);
        -- notify parent of conclusion of activation
        pragma Suppress (Elaboration_Check, Notify_Parent);
        pragma Export_Procedure (Notify_Parent, "__NOTIFY_PARENT");


        -- This form of Notify_Parent is not called directly by user programs;
        -- it is only visible here so that it can be called from within
        -- other subunits of Task_Management.

        procedure Notify_Parent_Internal
                     (Tasking_Error_Found : Boolean; Current_Task : Task_Id);
        pragma Suppress (Elaboration_Check, Notify_Parent_Internal);
        pragma Export_Procedure (Notify_Parent_Internal,
                                 "__NOTIFY_PARENT_INTERNAL");

    end Creation_And_Activation;


    package Termination_And_Abortion is

        procedure Await_Dependents;
        -- a master needs to wait for its dependents to terminate before it can
        -- complete
        pragma Suppress (Elaboration_Check, Await_Dependents);
        pragma Export_Procedure (Await_Dependents, "__AWAIT_DEPENDENTS");


        procedure Task_End;
        -- finalization: before the current scope can be exited, make sure
        -- dependents (if any) are completed before completing this task
        pragma Suppress (Elaboration_Check, Task_End);
        pragma Export_Procedure (Task_End, "__TASK_END");


        procedure Task_Completion;
        -- finalization: make the task non-callable; used in the case of
        -- a task with dependent reaching its end, but requiring other
        -- finalization so that Task_End may not be called.  The sequence
        -- will be Task_Completion; Await_Dependents; other finalization;
        -- Task_End.
        pragma Suppress (Elaboration_Check, Task_Completion);
        pragma Export_Procedure (Task_Completion, "__TASK_COMPLETION");



        procedure Terminate_Allocated_Offspring (Activation_Group : Group_Ref);
        -- terminate any unactivated offspring tasks created by an
        -- allocator for the current task in the current Exception as
        -- long as they haven't been terminated yet, deleting the
        -- activation group as a result
        pragma Suppress (Elaboration_Check, Terminate_Allocated_Offspring);
        pragma Export_Procedure (Terminate_Allocated_Offspring,
                                 "__TERMINATE_ALLOCATED_OFFSPRING");


        procedure Terminate_Dependent_Offspring;
        -- terminate any unactivated offspring tasks dependent on the current layer
        -- of the current task, including any nonactivated tasks created by object
        -- declarations
        pragma Suppress (Elaboration_Check, Terminate_Dependent_Offspring);
        pragma Export_Procedure (Terminate_Dependent_Offspring,
                                 "__TERMINATE_DEPENDENT_OFFSPRING");



        procedure Abort_Multiple_Tasks
                     (Task_Count : Positive; The_First_Task : Task_Id);
        -- This parameter profile is deceptive; if N tasks are to be
        -- aborted, then N+1 parameters are passed to this routine (the
        -- N tasks and then the count N).
        pragma Suppress (Elaboration_Check, Abort_Multiple_Tasks);
        pragma Export_Procedure (Abort_Multiple_Tasks,
                                 "__ABORT_MULTIPLE_TASKS");


        function Check_Return_Task
                    (The_Task : Task_Id; Ptr_Stack_Frame : System_Address)
                    return Boolean;
        -- check whether the task value returned from a subprogram call is
        -- locally declared; return that indication
        pragma Suppress (Elaboration_Check, Check_Return_Task);
        pragma Export_Function (Check_Return_Task, "__CHECK_RETURN_TASK");


        -- Abort_Main_Program is not called from user programs, but is
        -- invoked indirectly as a result of an abort signal.

        procedure Abort_Main_Program;
        pragma Suppress (Elaboration_Check, Abort_Main_Program);
        pragma Export_Procedure (Abort_Main_Program, "__ABORT_MAIN_PROGRAM");


        -- Make_Eligible_For_Termination and Make_Ineligible_For_Termination
        -- are not called directly by user programs; they are only visible
        -- here so that they can be called from within other subunits of
        -- Task_Management.

        procedure Make_Eligible_For_Termination (Current_Task : Task_Id);
        pragma Suppress (Elaboration_Check, Make_Eligible_For_Termination);
        pragma Export_Procedure (Make_Eligible_For_Termination,
                                 "__TMTA_MAKE_ELIGIBLE_TERM");

        procedure Make_Ineligible_For_Termination (Current_Task : Task_Id);
        pragma Suppress (Elaboration_Check, Make_Ineligible_For_Termination);
        pragma Export_Procedure (Make_Ineligible_For_Termination,
                                 "__TMTA_MAKE_INELIGIBLE_TERM");

        procedure Forced_Termination (The_Task       : Task_Id;
                                      Term_Via_Abort : Boolean;
                                      Current_Task   : Task_Id);
        pragma Suppress (Elaboration_Check, Forced_Termination);
        pragma Export_Procedure (Forced_Termination,
                                 "__TMTA_FORCED_TERMINATION");

    end Termination_And_Abortion;


    package Calling_And_Delaying is

        procedure Entry_Call (To_Task : Task_Id; At_Entry : Entry_Id);
        -- an ordinary entry call for the task
        pragma Suppress (Elaboration_Check, Entry_Call);
        pragma Export_Procedure (Entry_Call, "__ENTRY_CALL");


        function Timed_Entry_Call (To_Task      : Task_Id;
                                   At_Entry     : Entry_Id;
                                   For_Duration : Duration)
                                  -- return Boolean;
                                  --!!Kludge workaround for MP problem
                                  return Integer;
        -- a timed entry call for the task; a delay amount is specified; return an
        -- indication of result of the call; (TRUE => call accepted,
        -- FALSE => delayed)
        pragma Suppress (Elaboration_Check, Timed_Entry_Call);
        pragma Export_Function (Timed_Entry_Call, "__TIMED_ENTRY_CALL");


        function Conditional_Entry_Call (To_Task : Task_Id; At_Entry : Entry_Id)
                                        -- return Boolean;
                                        --!!Kludge workaround for MP problem
                                        return Integer;
        -- a conditional entry call for the task; return the branch selected
        -- as a result of the call (TRUE => call accepted, FALSE => else branch)
        pragma Suppress (Elaboration_Check, Conditional_Entry_Call);
        pragma Export_Function (Conditional_Entry_Call,
                                "__CONDITIONAL_ENTRY_CALL");


        procedure Delay_Statement (For_Duration : Duration);
        -- arrange for appropriate delay for the current task
        pragma Suppress (Elaboration_Check, Delay_Statement);
        pragma Export_Procedure (Delay_Statement, "__TASKING_DELAY_STATEMENT");

    end Calling_And_Delaying;


    package Accepting_And_Selecting is

        function Select_Rendezvous (Select_Var : Select_Info;
                                    Round_Robin : in Integer;   -- really in out
                                    Parameter_Location : Address_Ref)
                                   -- return Alternative_Number;
                                   --!!Kludge workaround for MP problem
                                   return Integer;
        pragma Suppress (Elaboration_Check, Select_Rendezvous);
        pragma Export_Function (Select_Rendezvous, "__SELECT_RENDEZVOUS");


        procedure Begin_Accept (For_Entry          : Entry_Id;
                                Parameter_Location : Address_Ref);
        -- close all entries except one and prepare it for a rendezvous; return
        -- the address of the rendezvous' parameters
        pragma Suppress (Elaboration_Check, Begin_Accept);
        pragma Export_Procedure (Begin_Accept, "__BEGIN_ACCEPT");

        procedure Quick_Accept (For_Entry : Entry_Id);
        --
        -- accelerate the case of an accept for which there is
        -- no body
        pragma Suppress (Elaboration_Check, Quick_Accept);
        pragma Export_Procedure (Quick_Accept, "__QUICK_ACCEPT");


        procedure End_Accept (With_Exception : Boolean);
        -- whenever rendezvous or accept alternative completed, propagate
        -- exception if any, and readjust priority of tasks
        pragma Suppress (Elaboration_Check, End_Accept);
        pragma Export_Procedure (End_Accept, "__END_ACCEPT");

    end Accepting_And_Selecting;

    package Ipc_Support is

        -- type Status is (Successful, Invalid_Entry, Invalid_Queue);

        subtype Status is Integer;

        Success       : constant Status := 0;
        Invalid_Entry : constant Status := 1;
        Invalid_Queue : constant Status := 2;

        procedure Attach_Queue (For_Entry :     Entry_Id;
                                New_Queue :     Message_Queues.Id;
                                Result    : out Status);
        -- Associate a new IPC message queue with the given entry of the
        -- task performing the call.  Any entry calls pending for the entry
        -- will result in Tasking_Error.
        -- Status is  Successful    - attach succeeded
        --            Invalid_Entry - current task has no entry with given
        --                            entry number
        --            Invalid_Queue - given queue id was not legal

        pragma Suppress (Elaboration_Check, Attach_Queue);
        pragma Export_Procedure (Attach_Queue, "__ART_ATTACH_QUEUE");


        procedure Detach_Queue (For_Entry : Entry_Id; Result : out Status);
        -- Dissociate the current IPC queue from the given entry of the
        -- task performing the call and create a new regular Ada queue.
        -- Status is  Successful    - attach succeeded
        --            Invalid_Entry - current task has no entry with given
        --                            entry number

        pragma Suppress (Elaboration_Check, Detach_Queue);
        pragma Export_Procedure (Detach_Queue, "__ART_DETACH_QUEUE");

    end Ipc_Support;


    package Attributes is

        function Entry_Count (For_Entry : Entry_Id) return Integer;
        -- Ada entry attribute COUNT; return the value
        pragma Suppress (Elaboration_Check, Entry_Count);
        pragma Export_Function (Entry_Count, "__ENTRY_COUNT");


        function Task_Callable (The_Task : Task_Id) return Boolean;
        -- Ada task attribute CALLABLE; return that indication
        pragma Suppress (Elaboration_Check, Task_Callable);
        pragma Export_Function (Task_Callable, "__TASK_CALLABLE");


        function Task_Terminated (The_Task : Task_Id) return Boolean;
        -- Ada task attribute TERMINATED; return that indication
        pragma Suppress (Elaboration_Check, Task_Terminated);
        pragma Export_Function (Task_Terminated, "__TASK_TERMINATED");


        function Stack_Size (For_Task : Task_Id) return Integer;
        -- implements the 'Storage_Size attribute of a task
        pragma Suppress (Elaboration_Check, Stack_Size);
        pragma Export_Function (Stack_Size, "__TASK_STACK_SIZE");

    end Attributes;


    package Intra_Runtime is

        -- These operations are not called directly by user programs

        procedure Set_Exception (To_Value : Exceptions.Name);
        pragma Suppress (Elaboration_Check, Set_Exception);
        pragma Export_Procedure (Set_Exception, "__SET_EXCEPTION");


        function Get_Exception_And_Clear_Exception_Pending_Flag
                    return Exceptions.Name;
        pragma Suppress (Elaboration_Check,
                         Get_Exception_And_Clear_Exception_Pending_Flag);
        pragma Export_Function
           (Get_Exception_And_Clear_Exception_Pending_Flag, "__GET_EXCEPTION");


        procedure Finalize;
        pragma Suppress (Elaboration_Check, Finalize);
        pragma Export_Procedure (Finalize, "__TASKING_FINALIZATION");


        procedure Handle_Signal (Signal_Code : Integer);
        pragma Suppress (Elaboration_Check, Handle_Signal);
        pragma Export_Procedure (Handle_Signal, "__TASKING_SIGNAL_INTERCEPT");

    end Intra_Runtime;

end Task_Management;
pragma Export_Elaboration_Procedure ("__TASK_MGMT_SPEC_ELAB");
pragma Runtime_Unit (Unit_Number         => Runtime_Ids.Runtime_Compunit,
                     Elab_Routine_Number => Runtime_Ids.Internal);