⟦b8f876d0c⟧

E3 Source Code




-- Copyright 1986,1987,1988 Verdix Corporation

------------------------------------------------------------------------------
-- User interface to the ADA tasking operations
--
-- The compiler calls the following subprograms to implement the
-- ADA tasking semantics.
------------------------------------------------------------------------------
WITH System;
USE System;
WITH V_I_Types;
PACKAGE V_I_Taskop IS

   PRAGMA Suppress (All_Checks);
   PRAGMA Suppress (Exception_Tables);
   PRAGMA Not_Elaborated;

   SUBTYPE A_Task_T    IS V_I_Types.A_Task_T;
   SUBTYPE A_Program_T IS V_I_Types.A_Program_T;
   SUBTYPE Day_T       IS V_I_Types.Day_T;

   --------------------------------------------------------------------------
   -- Tasking operation data structures
   --------------------------------------------------------------------------

   TYPE A_Master_T   IS PRIVATE;
   TYPE A_Alist_T    IS PRIVATE;
   TYPE Act_Status_T IS (Act_Ok, Act_Elab_Err, Act_Except,
                         Act_Elab_Err_Act_Except);

   -- Select statements are implemented with a list of open entry numbers
   -- (zero for closed entries); the number of items in this list is passed
   -- as a parameter.
   TYPE Entry_Record_T IS
      RECORD
         Entry_Id : Integer;
      END RECORD;
   TYPE A_Entry_Record_T IS ACCESS Entry_Record_T;
   -- Delay records follow entry record in the list that compiler-generated
   -- code passes to ts_select_delay.
   TYPE Delay_Record_T IS
      RECORD
         Delay_Alt_Return_Info : Integer;
         Seconds_To_Delay      : Duration;
      END RECORD;
   TYPE A_Delay_Record_T IS ACCESS Delay_Record_T;

   TYPE Abort_List_T IS
      RECORD
         Tsk : A_Task_T;
      END RECORD;
   TYPE A_Abort_List_T IS ACCESS Abort_List_T;

   --------------------------------------------------------------------------
   -- Task abort
   --------------------------------------------------------------------------
   PROCEDURE Ts_Abort (User_Abort_List   : IN A_Abort_List_T;
                       Abort_List_Length : IN Integer);

   --------------------------------------------------------------------------
   -- Task activation
   --------------------------------------------------------------------------

   FUNCTION Ts_Init_Activate_List RETURN A_Alist_T;

   -- This activates a group of tasks at once.
   PROCEDURE Ts_Activate_List
                (Activation_List : A_Alist_T; Is_Allocator : Integer);

   -- This enters the named task into the runnable pool of tasks.
   -- The return_pc parameter is used for debugging purposes.
   PROCEDURE Ts_Activate (Tsk : IN A_Task_T; Return_Pc : IN Address);

   -- This is called by a newly-activated task to indicate to the RTS
   -- that is had completed its activation.  This will cause the
   -- activating task to unblock.
   PROCEDURE Ts_Activation_Complete (Act_Status : IN Act_Status_T);

   FUNCTION Ts_Activation_Exceptions RETURN Act_Status_T;

   --------------------------------------------------------------------------
   -- Task attributes
   --------------------------------------------------------------------------

   -- This is called when the CALLABLE attribute is used.
   FUNCTION Ts_Callable (Tsk : IN A_Task_T) RETURN Boolean;

   -- This implements the 'TERMINATED attribute.
   FUNCTION Ts_Terminated (Tsk : IN A_Task_T) RETURN Boolean;

   -- This returns the number of tasks queued at the entry (of the
   -- current task) whose id is passed.  This implements the 'COUNT
   -- attribute.
   FUNCTION Ts_Entry_Count (Entry_Id : IN Integer) RETURN Integer;

   --------------------------------------------------------------------------
   -- Task rendezvous
   --------------------------------------------------------------------------

   -- This is called by generated code to due an plain entry call.
   -- The task to call is named by the task id passed in 'called_task'.
   -- The entry id to do the call on is passed in 'called_entry'.
   -- A pointer to the parameters to pass to the accept statement
   -- that accepts this call is passed in 'param_block'.
   PROCEDURE Ts_Call (Called_Task  : IN A_Task_T;
                      Called_Entry : IN Integer;
                      Param_Block  : IN Address);

   -- This is called by the generated code to do a conditional entry
   -- call.
   -- This is like 'ts_call' except that is will return immediately
   -- with a return value of false if the call cannot be accepted right
   -- away.
   FUNCTION Ts_Conditional_Call (Called_Task  : IN A_Task_T;
                                 Called_Entry : IN Integer;
                                 Param_Block  : IN Address) RETURN Boolean;

   -- This is like 'ts_conditional_call' above except that it will
   -- wait for a specified amount of time for the call to go through
   -- if it is not immediately able to perform the call.  The time
   -- to wait for the call it passed in 'timeout' and is in milliseconds.
   FUNCTION Ts_Timed_Call (Timeout      : IN Duration;
                           Called_Task  : IN A_Task_T;
                           Called_Entry : IN Integer;
                           Param_Block  : IN Address) RETURN Boolean;

   -- An entry list is built by the generated code during the
   -- evaluation of the guards of a select statment.  A pointer to
   -- the entry list and it length (in entries) is passed to one of
   -- the 'ts_select ...' routines.
   --
   -- An entry list is a list of small integers that are either zero
   -- or the index of an entry.  Each integer corresponds to an accept
   -- alternative in the select statement being executed.  A zero
   -- indicates that the alternative is closed.  A non-zero value
   -- indicates that the alternative is open an its value indicates the
   -- entry being accepted.
   --
   -- If an entry is accepted in a select procedure, its index in the
   -- entry list is returned in the 'result' parameter.
   --
   -- This is called when a select statement having no else, terminate,
   -- or delay alternatives is executed.
   PROCEDURE Ts_Select (User_Entry_List : IN  A_Entry_Record_T;
                        Elist_Len       : IN  Integer;
                        Param_Block     : OUT Address;
                        Result          : OUT Integer);

   -- This is called when an accept statement that is not an alternative
   -- of a select statement is executed.
   FUNCTION Ts_Accept (Accepting_Entry : IN Integer) RETURN Address;

   -- This is called when an accept statement doesn't have any parameters or a
   -- "do ... end" sequence of statements. The accept simply serves as a
   -- synchronization point. There isn't a subsequent ts_finish_accept.
   PROCEDURE Ts_Fast_Accept (Accepting_Entry : Integer);

   -- This is called when a select statment with an else alternative
   -- is executed.  If the else alternative is taken the 'result'
   -- parameter is returned with -1.
   PROCEDURE Ts_Select_Else (User_Entry_List : IN  A_Entry_Record_T;
                             Elist_Len       : IN  Integer;
                             Param_Block     : OUT Address;
                             Result          : OUT Integer);

   -- This is called when a select statment with a delay alternative(s)
   -- is executed.
   PROCEDURE Ts_Select_Delay (User_Entry_List : IN  A_Entry_Record_T;
                              Elist_Len       : IN  Integer;
                              Dlist_Len       : IN  Integer;
                              Param_Block     : OUT Address;
                              Result          : OUT Integer);

   -- This is called when a select statment with a terminate alternative
   -- is executed.  'termin_open' is true if the terminate alternative
   -- is open (i.e., if it has no guard or if its guard is true.
   PROCEDURE Ts_Select_Terminate (User_Entry_List : IN  A_Entry_Record_T;
                                  Elist_Len       : IN  Integer;
                                  Termin_Open     : IN  Integer;
                                  Param_Block     : OUT Address;
                                  Result          : OUT Integer);

   -- Called when the end of an accept body is reached.
   -- If an exception occurred in the body of the accept, the first
   -- paramenter is true and the second points to the string that
   -- describes the exception.
   PROCEDURE Ts_Finish_Accept (Exception_Occurred : IN Integer;
                               Exception_String   : IN Address);

   --------------------------------------------------------------------------
   -- RTS initialization and main procedure exit
   --------------------------------------------------------------------------

   -- This routine is called explicity by startup to set upt the RTS's
   -- internal data structures.
   PROCEDURE Ts_Initialize;

   -- This is called by the main procedure of a program when it wishes
   -- to complete the whole program.  This procedure is not called
   -- by generated code, it is the last entry in the elaboration table
   -- if it is to be called.
   PROCEDURE Ts_Exit;

   --------------------------------------------------------------------------
   -- Task, master and program creation
   --------------------------------------------------------------------------

   -- This creates a new Ada task.  The 'master' parameter is the master
   -- id (returned by 'ts_create_master') for the master of the task to
   -- be created.  'prio' is a priority in the range 1..10.  'stack_size'
   -- is the size of the stack area that the new task requires.  'start'
   -- is the address of the first instruction of the task's code.
   -- 'entry_count' is the number of entries that the new task has.
   FUNCTION Ts_Create_Task (Master        : IN A_Master_T;
                            Prio          : IN Integer;
                            Stack_Size    : IN Integer;
                            Start         : IN Address;
                            Entry_Count   : IN Integer;
                            Generic_Param : IN Address) RETURN A_Task_T;

   -- This is like 'ts_create_task' above, except that it also enters
   -- the task id of the new task in the activation table passed
   -- in the 'activate_list' parameter.  See the 'ts_activ' package.
   FUNCTION Ts_Create_Task_And_Link (Master : A_Master_T;
                                     Prio : Integer;
                                     Stack_Size : Integer;
                                     Start : Address;
                                     Entry_Count : Integer;
                                     Activation_List : A_Alist_T;
                                     Generic_Param : Address) RETURN A_Task_T;

   -- This returns an id to use in future calls to 'ts_create_task'
   -- 'ts_create_task_and_link', and 'ts_complete_master'.  The
   -- effect of this call is to create an internal RTS structure
   -- to keep track of the tasks for whom the current task is
   -- master.
   FUNCTION Ts_Create_Master RETURN A_Master_T;

   -- This returns the task id of the current task.
   FUNCTION Ts_Tid RETURN A_Task_T;

   -- This creates and activates a new ada program.  The first passed
   -- parameter is the address of the new program's link_block. The
   -- second parameter is a user defined key stored in the new program's
   -- control block. This key is passed to the PROGRAM_SWITCH_EVENT
   -- callouts. The key may be obtained by routines in the new
   -- program via v_i_tasks.get_program_key.
   -- This key can be used to point to a list of program arguments.
   -- The key for the main program is set to 0 (NO_ADDR). The third
   -- parameter is the address of a routine called when the program
   -- terminates. It can be set to NO_ADDR for no callout.
   --
   -- The terminate callout procedure is called as follows:
   --    procedure terminate_callout_proc(
   --\x09\x09prg:\x09\x09\x09a_program_t;-- program being terminated
   --      key:\x09\x09\x09address);\x09-- its corresponding user defined key
   --
   -- The terminate_callout_proc must be compiled with stack limit
   -- checking suppressed. The PROGRAM_SWITCH_EVENT callout isn't
   -- called before calling the terminate_callout_proc.
   --
   -- Note, if the program is terminated via v_i_tasks.terminate_program
   -- and if the program has tasks in rendezvous with tasks in other
   -- programs, then, the terminate_callout may be called after
   -- returning from v_i_tasks.terminate_program.
   --
   FUNCTION Ts_Create_Program
               (User_Link_Block_A : Address;
                Key               : Address := Memory_Address (1);
                Terminate_Callout : Address := No_Addr) RETURN A_Program_T;

   --------------------------------------------------------------------------
   -- Delay and current time
   --------------------------------------------------------------------------

   -- This returns after delaying for at least the amount of time
   -- specified by 'delay_val'.  'delay_val' is internal representation
   -- for duration, normally milliseconds.
   PROCEDURE Ts_Delay (Delay_Val : IN Duration);

   -- This returns the current time, wherein, duration_time has been
   -- normalized to be less than a day.
   PROCEDURE Ts_Current_Time (Day : OUT Day_T; Sec : OUT Duration);

   --------------------------------------------------------------------------
   -- Task and master completion/termination
   --------------------------------------------------------------------------

   -- This completes the calling task.  This never returns and
   -- the calling task never executes again.
   PROCEDURE Ts_Complete_Task;

   -- This waits for the completion of all of the tasks whose master
   -- is named by the master id passed.  Then the calling task
   -- is completed just as it is in 'ts_complete_task'.
   PROCEDURE Ts_Complete_Master (Master : IN A_Master_T);

   PROCEDURE Ts_Exception_Master (Master : IN A_Master_T);

   PROCEDURE Ts_Terminate_List (Activation_List : IN OUT A_Alist_T);

   --------------------------------------------------------------------------
   -- Interrupt Entry
   --------------------------------------------------------------------------

   -- Attaches interrupt entry in current task to signal that can be posted
   -- by interrupt handler
   PROCEDURE Ts_Attach_Interrupt
                (Interrupt_Entry : Integer; Signal_Code : Integer);

   -- Detaches all interrupt entries in passed task from signals.
   PROCEDURE Ts_Detach_Interrupt (Tsk : IN A_Task_T);

PRIVATE
   TYPE A_Master_T IS NEW Integer;
   TYPE A_Alist_T  IS NEW Integer;

   PRAGMA Interface (Ada, Ts_Abort);
   PRAGMA Interface_Name (Ts_Abort, "TS_ABORT");
   PRAGMA Iterface (Ada, Ts_Init_Activate_List);
   PRAGMA Interface_Name (Ts_Init_Activate_List, "TS_INIT_ACTIVATE_LIST");
   PRAGMA Interface (Ada, Ts_Activate_List);
   PRAGMA Interface_Name (Ts_Activate_List, "TS_ACTIVATE_LIST");
   PRAGMA Interface (Ada, Ts_Activate);
   PRAGMA Interface_Name (Ts_Activate, "TS_ACTIVATE");
   PRAGMA Interface (Ada, Ts_Activation_Complete);
   PRAGMA Interface_Name (Ts_Activation_Complete, "TS_ACTIVATION_COMPLETE");
   PRAGMA Interface (Ada, Ts_Activation_Exceptions);
   PRAGMA Interface_Name (Ts_Activation_Exceptions,
                          "TS_ACTIVATION_EXCEPTIONS");
   PRAGMA Interface (Ada, Ts_Callable);
   PRAGMA Interface_Name (Ts_Callable, "TS_CALLABLE");
   PRAGMA Interface (Ada, Ts_Terminated);
   PRAGMA Interface_Name (Ts_Terminated, "TS_TERMINATED");
   PRAGMA Interface (Ada, Ts_Entry_Count);
   PRAGMA Interface_Name (Ts_Entry_Count, "TS_ENTRY_COUNT");
   PRAGMA Interface (Ada, Ts_Call);
   PRAGMA Interface_Name (Ts_Call, "TS_CALL");
   PRAGMA Interface (Ada, Ts_Conditional_Call);
   PRAGMA Interface_Name (Ts_Conditional_Call, "TS_CONDITIONAL_CALL");
   PRAGMA Interface (Ada, Ts_Timed_Call);
   PRAGMA Interface_Name (Ts_Timed_Call, "TS_TIMED_CALL");
   PRAGMA Interface (Ada, Ts_Select);
   PRAGMA Interface_Name (Ts_Select, "TS_SELECT");
   PRAGMA Interface (Ada, Ts_Accept);
   PRAGMA Interface_Name (Ts_Accept, "TS_ACCEPT");
   PRAGMA Interface (Ada, Ts_Fast_Accept);
   PRAGMA Interface_Name (Ts_Fast_Accept, "TS_FAST_ACCEPT");
   PRAGMA Interface (Ada, Ts_Select_Else);
   PRAGMA Interface_Name (Ts_Select_Else, "TS_SELECT_ELSE");
   PRAGMA Interface (Ada, Ts_Select_Delay);
   PRAGMA Interface_Name (Ts_Select_Delay, "TS_SELECT_DELAY");
   PRAGMA Interface (Ada, Ts_Select_Terminate);
   PRAGMA Interface_Name (Ts_Select_Terminate, "TS_SELECT_TERMINATE");
   PRAGMA Interface (Ada, Ts_Finish_Accept);
   PRAGMA Interface_Name (Ts_Finish_Accept, "TS_FINISH_ACCEPT");
   PRAGMA Interface (Ada, Ts_Initialize);
   PRAGMA Interface_Name (Ts_Initialize, "TS_INITIALIZE");
   PRAGMA Interface (Ada, Ts_Exit);
   PRAGMA Interface_Name (Ts_Exit, "TS_EXIT");
   PRAGMA Interface (Ada, Ts_Create_Task);
   PRAGMA Interface_Name (Ts_Create_Task, "TS_CREATE_TASK");
   PRAGMA Interface (Ada, Ts_Create_Task_And_Link);
   PRAGMA Interface_Name (Ts_Create_Task_And_Link, "TS_CREATE_TASK_AND_LINK");
   PRAGMA Interface (Ada, Ts_Create_Master);
   PRAGMA Interface_Name (Ts_Create_Master, "TS_CREATE_MASTER");
   PRAGMA Interface (Ada, Ts_Tid);
   PRAGMA Interface_Name (Ts_Tid, "TS_TID");
   PRAGMA Interface (Ada, Ts_Create_Program);
   PRAGMA Interface_Name (Ts_Create_Program, "TS_CREATE_PROGRAM");
   PRAGMA Interface (Ada, Ts_Delay);
   PRAGMA Interface_Name (Ts_Delay, "TS_DELAY");
   PRAGMA Interface (Ada, Ts_Current_Time);
   PRAGMA Interface_Name (Ts_Current_Time, "TS_CURRENT_TIME");
   PRAGMA Interface (Ada, Ts_Complete_Task);
   PRAGMA Interface_Name (Ts_Complete_Task, "TS_COMPLETE_TASK");
   PRAGMA Interface (Ada, Ts_Complete_Master);
   PRAGMA Interface_Name (Ts_Complete_Master, "TS_COMPLETE_MASTER");
   PRAGMA Interface (Ada, Ts_Exception_Master);
   PRAGMA Interface_Name (Ts_Exception_Master, "TS_EXCEPTION_MASTER");
   PRAGMA Interface (Ada, Ts_Terminate_List);
   PRAGMA Interface_Name (Ts_Terminate_List, "TS_TERMINATE_LIST");
   PRAGMA Interface (Ada, Ts_Attach_Interrupt);
   PRAGMA Interface_Name (Ts_Attach_Interrupt, "TS_ATTACH_INTERRUPT");
   PRAGMA Interface (Ada, Ts_Detach_Interrupt);
   PRAGMA Interface_Name (Ts_Detach_Interrupt, "TS_DETACH_INTERRUPT");
END V_I_Taskop;
DataMuseum.dk

Rational R1000/400

⟦b8f876d0c⟧ Ada Source

Derivation

E3 Source Code

E3 Meta Data
