|
|
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 - metrics - download
Length: 28449 (0x6f21)
Types: TextFile
Notes: R1k Text-file segment
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦08b173a18⟧
└─⟦this⟧
-- Copyright 1986,1987,1988, 1992 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 unsigned_types;
with ada_krn_defs;
with link_block;
with v_usr_conf_i;
with v_i_cifo;
package v_i_taskop is
pragma suppress(ALL_CHECKS);
pragma suppress(EXCEPTION_TABLES);
pragma not_elaborated;
--------------------------------------------------------------------------
-- Tasking operation data structures. TASK_ID and PROGRAM_ID are
-- defined in system.
--------------------------------------------------------------------------
type MASTER_ID is private;
NO_MASTER_ID : constant MASTER_ID;
type A_LIST_ID is private;
NO_A_LIST_ID : constant A_LIST_ID;
--------------------------------------------------------------------------
-- Misc types provided for backward compatibility with
-- earlier releases of VADS. The subprograms in this package are
-- backward compatible with these subtypes.
--
-- Note, day_t is now defined in system.a and not v_i_types.a.
--------------------------------------------------------------------------
subtype a_task_t is system.task_id;
subtype a_program_t is system.program_id;
subtype a_master_t is MASTER_ID;
subtype a_alist_t is A_LIST_ID;
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;
pragma local_access(a_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;
pragma local_access(a_delay_record_t);
type abort_list_t is record
tsk : task_id;
end record;
-- CIFO option
pragma may_make_access_value(abort_list_t);
-- CIFO option
type a_abort_list_t is access abort_list_t;
pragma local_access(a_abort_list_t);
--------------------------------------------------------------------------
-- Task abort
--------------------------------------------------------------------------
procedure ts_abort(
abort_list : in a_abort_list_t;
abort_list_length : in integer);
function ts_abort_one_task(
tsk : task_id)
return boolean;
--------------------------------------------------------------------------
-- Disable/enable the current task from being completed when aborted.
-- These services must be paired. They can be nested. No return, if
-- not nested and the current task has been marked abnormal by a previous
-- abort.
--
-- Currently, not called by the compiler. However, called by Vads Exec
-- services.
--------------------------------------------------------------------------
procedure ts_disable_complete;
procedure ts_enable_complete;
--------------------------------------------------------------------------
-- Task activation
--------------------------------------------------------------------------
function ts_init_activate_list return a_list_id;
-- This activates a group of tasks at once.
procedure ts_activate_list(
activation_list : a_list_id;
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 task_id;
return_pc : in address);
-- DA_RTS
-- Activate a task created with ts_create_simple_task
procedure ts_activate_simple_task(
tsk : a_task_t);
-- Set the current task inactive. The task will not keep the program
-- from becoming idle. The da comm library keeps a cache of tasks that
-- are in the inactive state.
procedure ts_set_inactive;
-- DA_RTS
-- Set the current task to a state that is compatible with the
-- debug task. The task will not keep the program
-- from becoming idle.
procedure ts_set_debug_task;
-- 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 task_id) return boolean;
-- This implements the 'TERMINATED attribute.
function ts_terminated ( tsk : in task_id) 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 task_id;
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 task_id;
called_entry : in integer;
param_block : in address) return boolean;
-- CIFO_TRIVIAL_ENTRY
-- This is called for a conditional entry call to a trivial accept
-- statement. Supports the CIFO TRIVIAL_ENTRY pragma.
function ts_trivial_conditional_call (
called_task : in task_id;
called_entry : in integer) return boolean;
-- CIFO_TRIVIAL_ENTRY
-- 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 task_id;
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);
-- CIFO_TRIVIAL_ENTRY
-- This is called for a trivial accept statement. Supports
-- the CIFO TRIVIAL_ENTRY pragma.
procedure ts_trivial_accept(
accepting_entry : integer);
-- CIFO_TRIVIAL_ENTRY
-- 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);
-- CIFO option
-- When called from within a rendezvous, this function returns
-- the task id of the calling task. Otherwise it returns null.
function ts_caller return task_id;
-- CIFO option
--------------------------------------------------------------------------
-- RTS initialization and main procedure exit
--------------------------------------------------------------------------
-- This routine is called explicity by startup to set up the Ada RTS.
-- If ts_initialize returns, then, the program is ready to exit and
-- it returns the exit status.
function ts_initialize(
usr_link_block : link_block.a_link_block_t;
configuration_table : v_usr_conf_i.a_configuration_table_t;
main_pragmas : v_i_cifo.a_main_pragmas_t;
startup_continue : address) return integer;
-- 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(status: integer);
--------------------------------------------------------------------------
-- 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 : master_id;
prio : integer;
stack_size : integer;
start : address;
entry_count : integer;
generic_param : address;
task_attr : ada_krn_defs.a_task_attr_t;
has_pragma_prio : integer) return task_id;
-- 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 : master_id;
prio : integer;
stack_size : integer;
start : address;
entry_count : integer;
activation_list : a_list_id;
generic_param : address;
task_attr : ada_krn_defs.a_task_attr_t;
has_pragma_prio : integer) return task_id;
-- DA_RTS
-- Called to create a simple ada task. This task does not have
-- a master. This task will not make a call to ts_activation_complete
-- and should not be attached to the current task. This task has
-- no entry points and no elaboration address.
--
-- This task might eventually perform other ada tasking semantics
-- like rendezvous, ...
--
-- This task is activated via ts_activate_simple_task.
--
function ts_create_simple_task(
prio : integer;
stack_size : natural;
start : address;
task_attr : ada_krn_defs.a_task_attr_t;
has_pragma_prio : integer) return a_task_t;
-- DA_RTS
-- CIFO_SYNCHRONIZATION
procedure ts_set_entry_criteria(
tsk : task_id;
entry_criteria : v_i_cifo.queuing_t);
procedure ts_set_select_criteria(
tsk : task_id;
lexical_order : integer);
-- CIFO_SYNCHRONIZATION
-- 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(
fp : address;
generic_param : address) return master_id;
-- This returns the task id of the current task.
function ts_tid return task_id;
-- This creates and activates a new ada program. It
-- is layered upon the ada_krn_i.program_start service. The
-- following description of its operation is only applicable
-- to the VADS_MICRO for cross targets.
--
-- 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(
-- krn_prg: krn_program_id;-- program being terminated
-- key: address); -- 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. Also, the
-- terminate_callout_proc is called with the underlying kernel's
-- krn_program_id and not the Ada program_id.
function ts_create_program(
user_link_block_a : address;
key : address := memory_address(2);
terminate_callout : address := NO_ADDR) return program_id;
pragma inline_only(ts_create_program);
--------------------------------------------------------------------------
-- 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 master_id);
procedure ts_exception_master(master : in master_id);
procedure ts_terminate_list(activation_list: in out a_list_id);
-- CIFO option
-- Installs a cleanup procedure used to recover resources
-- allocated by the CIFO. Called by the RTS when a task terminates.
procedure ts_cifo_term_callout(proc : system.address);
-- CIFO option
--------------------------------------------------------------------------
-- Stack Limit
--------------------------------------------------------------------------
-- This returns the stack_limit of the current task. Handles
-- the case where the caller task is executing code in a fast rendezvous
-- using the acceptor's stack.
--
-- When the stack limit is stored in a register (g4 for SPARC, s7 for
-- MIPS), the compiler emits a call to this routine whenever
-- an Ada subprogram is called from 'C'. For MP Ada, the compiler
-- can no longer reference the stack limit directly from memory.
function ts_get_stack_limit return address;
--------------------------------------------------------------------------
-- Exception information
--------------------------------------------------------------------------
-- Gets/puts the last exception information for the current task.
-- If in an ISR, accesses the last exception information for the current
-- program.
procedure ts_get_last_exception(id: out address; pc: out address);
procedure ts_put_last_exception(id: address; pc: address);
--------------------------------------------------------------------------
-- Interrupt Entry
--------------------------------------------------------------------------
-- Attaches interrupt entry in current task to interrupt vector that can
-- be posted by interrupt handler
procedure ts_attach_interrupt(
attached_entry : integer;
intr_entry : ada_krn_defs.a_intr_entry_t);
-- Detaches all interrupt entries in passed task from signals.
procedure ts_detach_interrupt(tsk : in task_id);
--------------------------------------------------------------------------
-- Interrupt Entry ISRs
--------------------------------------------------------------------------
-- Attaches isr to interrupt vector specified by the interrupt entry
function ts_attach_isr(
intr_entry : ada_krn_defs.a_intr_entry_t;
isr : address) return address;
-- Detaches isr from interrupt vector specified by the interrupt entry
function ts_detach_isr(
intr_entry : ada_krn_defs.a_intr_entry_t) return address;
--------------------------------------------------------------------------
-- Interrupt Task
--------------------------------------------------------------------------
-- Creates a task that repetitively waits for and then processes an
-- interrupt. The created task is inactive until ts_activate_intr_task
-- is called.
function ts_create_intr_task (
prio : integer;
stack_size : integer;
start : address;
intr_vector : ada_krn_defs.intr_vector_id_t;
handler : system.address;
task_attr : ada_krn_defs.a_task_attr_t := null) return task_id;
-- Makes a previously created interrupt task runnable.
procedure ts_activate_intr_task (
intr_task : task_id);
-- This completes the calling interrupt task.
procedure ts_complete_intr_task;
-- Gets the interrupt vector for the current interrupt task.
-- The interrupt vector was passed when the interrupt task was created.
function ts_get_intr_task_vector return ada_krn_defs.intr_vector_id_t;
-- Gets the handler for the current interrupt task.
-- The handler was passed when the interrupt task was created.
function ts_get_intr_task_handler return address;
type intr_task_state_t is (
INTR_TASK_READY,
INTR_TASK_WAITING
);
-- Sets the Ada tasking state for the current interrupt task
procedure ts_set_intr_task_state (
intr_task_state : intr_task_state_t);
private
type MASTER_ID is new UNSIGNED_TYPES.UNSIGNED_INTEGER;
NO_MASTER_ID : constant MASTER_ID := 0;
type A_LIST_ID is new UNSIGNED_TYPES.UNSIGNED_INTEGER;
NO_A_LIST_ID : constant A_LIST_ID := 0;
pragma interface(ADA, ts_abort);
pragma interface_name(ts_abort, "TS_ABORT");
pragma interface(ADA, ts_abort_one_task);
pragma interface_name(ts_abort_one_task, "TS_ABORT_ONE_TASK");
pragma interface(ADA, ts_disable_complete);
pragma interface_name(ts_disable_complete, "TS_DISABLE_COMPLETE");
pragma interface(ADA, ts_enable_complete);
pragma interface_name(ts_enable_complete, "TS_ENABLE_COMPLETE");
pragma interface(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");
-- DA_RTS
pragma interface(ADA, ts_activate_simple_task);
pragma interface_name(ts_activate_simple_task, "TS_ACTIVATE_SIMPLE_TASK");
pragma interface(ADA, ts_set_inactive);
pragma interface_name(ts_set_inactive, "TS_SET_INACTIVE");
-- DA_RTS
pragma interface(ADA, ts_set_debug_task);
pragma interface_name(ts_set_debug_task, "TS_SET_DEBUG_TASK");
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");
-- CIFO option
pragma interface(ADA, ts_caller);
pragma interface_name(ts_caller, "TS_CALLER");
-- CIFO option
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");
-- CIFO_TRIVIAL_ENTRY
pragma interface(ADA, ts_trivial_conditional_call);
pragma interface_name(ts_trivial_conditional_call,
"TS_TRIVIAL_CONDITIONAL_CALL");
-- CIFO_TRIVIAL_ENTRY
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");
-- CIFO_TRIVIAL_ENTRY
pragma interface(ADA, ts_trivial_accept);
pragma interface_name(ts_trivial_accept, "TS_TRIVIAL_ACCEPT");
-- CIFO_TRIVIAL_ENTRY
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");
-- DA_RTS
pragma interface(ADA, ts_create_simple_task);
pragma interface_name(ts_create_simple_task, "TS_CREATE_SIMPLE_TASK");
-- DA_RTS
-- CIFO_SYNCHRONIZATION
pragma interface(ADA, ts_set_entry_criteria);
pragma interface_name(ts_set_entry_criteria, "TS_SET_ENTRY_CRITERIA");
pragma interface(ADA, ts_set_select_criteria);
pragma interface_name(ts_set_select_criteria, "TS_SET_SELECT_CRITERIA");
-- CIFO_SYNCHRONIZATION
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_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");
-- CIFO option
pragma interface(ADA, ts_cifo_term_callout);
pragma interface_name(ts_cifo_term_callout, "TS_CIFO_TERM_CALLOUT");
-- CIFO option
pragma interface(ADA, ts_get_stack_limit);
pragma interface_name(ts_get_stack_limit, "TS_GET_STACK_LIMIT");
pragma interface(ADA, ts_get_last_exception);
pragma interface_name(ts_get_last_exception, "TS_GET_LAST_EXCEPTION");
pragma interface(ADA, ts_put_last_exception);
pragma interface_name(ts_put_last_exception, "TS_PUT_LAST_EXCEPTION");
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");
pragma interface(ADA, ts_attach_isr);
pragma interface_name(ts_attach_isr, "TS_ATTACH_ISR");
pragma interface(ADA, ts_detach_isr);
pragma interface_name(ts_detach_isr, "TS_DETACH_ISR");
pragma interface(ADA, ts_create_intr_task);
pragma interface_name(ts_create_intr_task, "TS_CREATE_INTR_TASK");
pragma interface(ADA, ts_activate_intr_task);
pragma interface_name(ts_activate_intr_task, "TS_ACTIVATE_INTR_TASK");
pragma interface(ADA, ts_complete_intr_task);
pragma interface_name(ts_complete_intr_task, "TS_COMPLETE_INTR_TASK");
pragma interface(ADA, ts_get_intr_task_vector);
pragma interface_name(ts_get_intr_task_vector, "TS_GET_INTR_TASK_VECTOR");
pragma interface(ADA, ts_get_intr_task_handler);
pragma interface_name(ts_get_intr_task_handler,
"TS_GET_INTR_TASK_HANDLER");
pragma interface(ADA, ts_set_intr_task_state);
pragma interface_name(ts_set_intr_task_state, "TS_SET_INTR_TASK_STATE");
end;
with system; use system;
with ada_krn_i;
with link_block;
package body v_i_taskop is
function ts_create_program(
user_link_block_a : address;
key : address := memory_address(2);
terminate_callout : address := NO_ADDR) return program_id
is
begin
return ada_krn_i.program_start(
link_block.to_a_link_block_t(user_link_block_a),
key, terminate_callout);
end;
end