|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 17408 (0x4400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package V_I_Tasks, seg_04b9c6
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
-- Copyright 1986,1987,1988,1991,1993 Verdix Corporation
------------------------------------------------------------------------------
-- User interface to the ADA tasking extensions
--
-- Note: earlier releases used the following subtypes defined in v_i_types.
-- subtype v_i_types.a_task_t is system.task_id;\x09
-- subtype v_i_types.a_program_t is system.program_id;\x09
-- subtype v_i_types.user_field_t is integer;
--
-- The subprograms in this package are backward compatible with the above
-- subtypes.
------------------------------------------------------------------------------
with System;
use System;
with V_Usr_Conf_I;
package V_I_Tasks is
pragma Suppress (All_Checks);
pragma Suppress (Exception_Tables);
pragma Not_Elaborated;
--------------------------------------------------------------------------
-- Gets/sets the user field in the specified task.
--------------------------------------------------------------------------
function Get_User_Field (Tsk : Task_Id) return Integer;
procedure Set_User_Field (Tsk : Task_Id; New_Value : Integer);
--------------------------------------------------------------------------
-- Gets/sets the current or static priority of the specified task.
--
-- Task scheduling is only re-evaluated if the current priority of the
-- current task is lowered or if the current priority of any other
-- task is set.
--
-- The current priority is used for all scheduling activities.
-- The static priority is only used for rendezvous as follows:
-- rendezvous_start:
-- if not PRIORITY_INHERITANCE_ENABLED and then
-- called_task.current_priority < calling_task.static_priority
-- then
-- called_task.current_priority := calling_task.static_prioity;
-- end if;
-- rendezvous_end:
-- called_task.current_priority := called_task.static_priority;
--------------------------------------------------------------------------
function Get_Current_Priority (Tsk : Task_Id) return Priority;
procedure Set_Current_Priority (Tsk : Task_Id; New_Value : Priority);
function Get_Static_Priority (Tsk : Task_Id) return Priority;
procedure Set_Static_Priority (Tsk : Task_Id; New_Value : Priority);
-- CIFO option
function Task_Has_Pragma_Priority (Tsk : Task_Id) return Boolean;
-- CIFO option
--------------------------------------------------------------------------
-- Gets/sets the current pool (cp) for the current task
--------------------------------------------------------------------------
function Get_Pool return System.Address;
procedure Set_Pool (P : System.Address);
--------------------------------------------------------------------------
-- Gets/sets the flag to disable the program from exiting
--------------------------------------------------------------------------
function Get_Exit_Disabled_Flag return Boolean;
procedure Set_Exit_Disabled_Flag (Disabled_Flag : Boolean);
--------------------------------------------------------------------------
-- Gets/sets the fast rendezvous enabled flag for the current task.
-- See FAST_RENDEZVOUS_ENABLED in v_usr_conf.a for details about
-- the fast rendezvous optimization.
--
-- If FAST_RENDEZVOUS_ENABLED was disabled in the configuration table,
-- then, it can never be enabled.
--
-- Normally, fast rendezvous would only need to be disabled for
-- multi-processor Ada, where the accept body must execute
-- in the acceptor task that is bound to a processor.
--------------------------------------------------------------------------
function Get_Fast_Rendezvous_Enabled return Boolean;
procedure Set_Fast_Rendezvous_Enabled (Enabled : Boolean);
-- CIFO option
--------------------------------------------------------------------------
-- Gets/sets the private per-task data used by the CIFO.
--------------------------------------------------------------------------
procedure Get_Cifo_Tcb (T : Task_Id; P : out System.Address);
procedure Set_Cifo_Tcb (T : Task_Id; P : in System.Address);
--------------------------------------------------------------------------
-- Return the calling task's master task
--------------------------------------------------------------------------
function Get_Task_Master return Task_Id;
---------------------------------------------------------------------------
-- Returns TRUE if the task is in the current program's list of tasks and
-- the task has been activated but not yet terminated, abnormal or
-- completed. Otherwise, returns FALSE.
--
-- This subprogram first checks that the "tsk" parameter points to a
-- valid task control block (tcb) before accessing any field in the tcb.
--
-- If the sequence_num >= 0, then, the task's sequence_num must also
-- match for the task to be valid.
---------------------------------------------------------------------------
function Task_Is_Valid
(Tsk : Task_Id; Sequence_Num : Integer := -1) return Boolean;
---------------------------------------------------------------------------
-- Return TRUE if the task is abnormal. The task should have been
-- previously checked for validity with 'task_is_valid'.
---------------------------------------------------------------------------
function Task_Is_Abnormal (Tsk : Task_Id) return Boolean;
--------------------------------------------------------------------------
-- Returns TRUE if the calling task is in rendezvous with a passive
-- task.
--------------------------------------------------------------------------
function In_Passive_Rendezvous return Boolean;
-- CIFO option
--------------------------------------------------------------------------
-- Returns the pc of the first instruction of the task.
--------------------------------------------------------------------------
function Get_Task_Start_Pc (Tsk : Task_Id) return System.Address;
--------------------------------------------------------------------------
-- Returns the task's unique sequence number. The main task has a
-- sequence number of 1. Each time an Ada task is created, the sequence
-- number is incremented by 1 and assigned to the task.
--------------------------------------------------------------------------
function Get_Task_Sequence_Number (Tsk : Task_Id) return Integer;
--------------------------------------------------------------------------
-- Checks if the calling task is already in rendezvous with the
-- called task. Returns TRUE if in rendezvous.
--------------------------------------------------------------------------
function Check_In_Rendezvous
(Called_Task : Task_Id; Calling_Task : Task_Id) return Boolean;
--------------------------------------------------------------------------
-- Returns the Task Control Block (TCB) of the current task.
--
-- If executing in a fast rendezvous, returns the acceptor task and
-- not the caller task that is really executing the rendezvous.
--------------------------------------------------------------------------
function Get_Current_Task return Task_Id;
--------------------------------------------------------------------------
-- Returns the Task Control Block (TCB) associated with the specified task.
--------------------------------------------------------------------------
function Get_Task (Id : System.Task_Id) return Task_Id;
pragma Inline_Only (Get_Task);
--------------------------------------------------------------------------
-- Gets the configuration table for the current program.
--------------------------------------------------------------------------
function Get_Configuration_Table
return V_Usr_Conf_I.A_Configuration_Table_T;
--------------------------------------------------------------------------
-- Calls a procedure in another program
--------------------------------------------------------------------------
procedure Inter_Program_Call
(Proc_Prg : Program_Id; Proc_Addr : Address; Arg : Address);
------------------------------------------------------------------------------
-- The following services provide backward compatibility with earlier
-- releases of VADS.
--
-- The interface to these low kernel services is now provided in
-- ada_krn_i.a. The following routines simply layer upon their
-- counterparts in ada_krn_i.a.
------------------------------------------------------------------------------
--------------------------------------------------------------------------
-- Returns the Program Control Block (PCB) of the current program.
--------------------------------------------------------------------------
function Get_Current_Program return Program_Id;
pragma Inline_Only (Get_Current_Program);
--------------------------------------------------------------------------
-- Returns the specified task's Program Control Block (PCB)
--------------------------------------------------------------------------
function Get_Program (Tsk : Task_Id) return Program_Id;
pragma Inline_Only (Get_Program);
--------------------------------------------------------------------------
-- Terminates the specified Ada program
--------------------------------------------------------------------------
procedure Terminate_Program (Status : Integer; -- exit status
Prg : Program_Id := Get_Current_Program);
pragma Inline_Only (Terminate_Program);
--------------------------------------------------------------------------
-- Gets the user defined key for the specified program.
--------------------------------------------------------------------------
function Get_Program_Key
(Prg : Program_Id := Get_Current_Program) return System.Address;
pragma Inline_Only (Get_Program_Key);
--------------------------------------------------------------------------
-- Suspends/resumes the specified task.
--
-- The VADS_MICRO always returns TRUE. If not layered upon
-- VADS_MICRO, then, check ada_krn_i's task_suspend or task_resume.
--------------------------------------------------------------------------
function Suspend_Task (Tsk : Task_Id) return Boolean;
pragma Inline_Only (Suspend_Task);
function Resume_Task (Tsk : Task_Id) return Boolean;
pragma Inline_Only (Resume_Task);
--------------------------------------------------------------------------
-- Gets/sets the time slice interval for the specified task.
--
-- Time slicing for a task is disabled by setting it to 0.0 seconds
--------------------------------------------------------------------------
function Get_Time_Slice (Tsk : Task_Id) return Duration;
pragma Inline_Only (Get_Time_Slice);
procedure Set_Time_Slice (Tsk : Task_Id; New_Time_Slice : Duration);
pragma Inline_Only (Set_Time_Slice);
--------------------------------------------------------------------------
-- Gets/sets the global time slicing enabled configuration parameter
--------------------------------------------------------------------------
function Get_Time_Slicing return Boolean;
pragma Inline_Only (Get_Time_Slicing);
procedure Set_Time_Slicing (Enabled : Boolean);
pragma Inline_Only (Set_Time_Slicing);
--------------------------------------------------------------------------
-- Disables/enables task preemption
--
-- Shouldn't be called from an ISR. disable_preemption doesn't
-- disable interrupts.
--------------------------------------------------------------------------
procedure Disable_Preemption;
pragma Inline_Only (Disable_Preemption);
procedure Enable_Preemption;
pragma Inline_Only (Enable_Preemption);
private
pragma Interface (Ada, Get_User_Field);
pragma Interface_Name (Get_User_Field, "__GET_USER_FIELD");
pragma Interface (Ada, Set_User_Field);
pragma Interface_Name (Set_User_Field, "__SET_USER_FIELD");
pragma Interface (Ada, Get_Current_Priority);
pragma Interface_Name (Get_Current_Priority, "__GET_CURRENT_PRIORITY");
pragma Interface (Ada, Set_Current_Priority);
pragma Interface_Name (Set_Current_Priority, "__SET_CURRENT_PRIORITY");
pragma Interface (Ada, Get_Static_Priority);
pragma Interface_Name (Get_Static_Priority, "__GET_STATIC_PRIORITY");
pragma Interface (Ada, Set_Static_Priority);
pragma Interface_Name (Set_Static_Priority, "__SET_STATIC_PRIORITY");
pragma Interface (Ada, Get_Pool);
pragma Interface_Name (Get_Pool, "__GET_POOL");
pragma Interface (Ada, Set_Pool);
pragma Interface_Name (Set_Pool, "__SET_POOL");
pragma Interface (Ada, Get_Exit_Disabled_Flag);
pragma Interface_Name (Get_Exit_Disabled_Flag, "__GET_EXIT_DISABLED_FLAG");
pragma Interface (Ada, Set_Exit_Disabled_Flag);
pragma Interface_Name (Set_Exit_Disabled_Flag, "__SET_EXIT_DISABLED_FLAG");
pragma Interface (Ada, Get_Fast_Rendezvous_Enabled);
pragma Interface_Name (Get_Fast_Rendezvous_Enabled,
"__GET_FAST_RENDEZVOUS_ENABLED");
pragma Interface (Ada, Set_Fast_Rendezvous_Enabled);
pragma Interface_Name (Set_Fast_Rendezvous_Enabled,
"__SET_FAST_RENDEZVOUS_ENABLED");
-- CIFO option
pragma Interface (Ada, Get_Cifo_Tcb);
pragma Interface_Name (Get_Cifo_Tcb, "__GET_CIFO_TCB");
pragma Interface (Ada, Set_Cifo_Tcb);
pragma Interface_Name (Set_Cifo_Tcb, "__SET_CIFO_TCB");
pragma Interface (Ada, Get_Task_Master);
pragma Interface_Name (Get_Task_Master, "__GET_TASK_MASTER");
pragma Interface (Ada, Task_Is_Valid);
pragma Interface_Name (Task_Is_Valid, "__TASK_IS_VALID");
pragma Interface (Ada, Task_Is_Abnormal);
pragma Interface_Name (Task_Is_Abnormal, "__TASK_IS_ABNORMAL");
pragma Interface (Ada, Task_Has_Pragma_Priority);
pragma Interface_Name (Task_Has_Pragma_Priority,
"__TASK_HAS_PRAGMA_PRIORITY");
pragma Interface (Ada, In_Passive_Rendezvous);
pragma Interface_Name (In_Passive_Rendezvous, "__IN_PASSIVE_RENDEZVOUS");
-- CIFO option
pragma Interface (Ada, Get_Task_Start_Pc);
pragma Interface_Name (Get_Task_Start_Pc, "__GET_TASK_START_PC");
pragma Interface (Ada, Get_Task_Sequence_Number);
pragma Interface_Name (Get_Task_Sequence_Number,
"__GET_TASK_SEQUENCE_NUMBER");
pragma Interface (Ada, Check_In_Rendezvous);
pragma Interface_Name (Check_In_Rendezvous, "__CHECK_IN_RENDEZVOUS");
pragma Interface (Ada, Get_Current_Task);
pragma Interface_Name (Get_Current_Task, "TS_TID");
pragma Interface (Ada, Get_Configuration_Table);
pragma Interface_Name (Get_Configuration_Table,
"__GET_CONFIGURATION_TABLE");
pragma Interface (Ada, Inter_Program_Call);
pragma Interface_Name (Inter_Program_Call, "__INTER_PROGRAM_CALL");
end V_I_Tasks;
nblk1=10
nid=0
hdr6=20
[0x00] rec0=1b rec1=00 rec2=01 rec3=092
[0x01] rec0=15 rec1=00 rec2=02 rec3=010
[0x02] rec0=13 rec1=00 rec2=03 rec3=096
[0x03] rec0=14 rec1=00 rec2=04 rec3=080
[0x04] rec0=13 rec1=00 rec2=05 rec3=00c
[0x05] rec0=14 rec1=00 rec2=06 rec3=026
[0x06] rec0=10 rec1=00 rec2=07 rec3=006
[0x07] rec0=12 rec1=00 rec2=08 rec3=050
[0x08] rec0=14 rec1=00 rec2=09 rec3=066
[0x09] rec0=11 rec1=00 rec2=0a rec3=052
[0x0a] rec0=14 rec1=00 rec2=0b rec3=082
[0x0b] rec0=13 rec1=00 rec2=0c rec3=03c
[0x0c] rec0=15 rec1=00 rec2=0d rec3=03a
[0x0d] rec0=13 rec1=00 rec2=0e rec3=046
[0x0e] rec0=12 rec1=00 rec2=0f rec3=058
[0x0f] rec0=10 rec1=00 rec2=10 rec3=000
tail 0x21750be32868438a297c2 0x42a00088462060003