|
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: 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