DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦25786f50f⟧ TextFile

    Length: 10172 (0x27bc)
    Types: TextFile
    Notes: R1k Text-file segment

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦cfc2e13cd⟧ »Space Info Vol 2« 
        └─⟦ab959fac0⟧ 
            └─⟦this⟧ 

TextFile

-- Copyright 1988,1992,1993 Verdix Corporation

------------------------------------------------------------------------------
-- Interface to the passive task data structure and subprograms.
--
-- The compiler emits calls to these subprograms when
-- "pragma passive" is present in task specification.
--
-- The compiler does an implicit "with v_i_pass" while compiling
-- units that declare passive tasks.  The compiler knows the
-- names and the basic data types of most of the objects declared 
-- in this package.
------------------------------------------------------------------------------
with system;				use system;
with ada_krn_defs;
with v_i_mutex;
with unchecked_conversion;
-- CIFO_SYNCHRONIZATION or PRIORITY_CEILING
with v_i_cifo;
-- CIFO_SYNCHRONIZATION or PRIORITY_CEILING
package v_i_pass is

    pragma suppress(ALL_CHECKS);
    pragma suppress(EXCEPTION_TABLES);
    pragma not_elaborated;
    pragma local_access;

   --------------------------------------------------------------------------
	-- Passive task header record,  allocated and built by the
	-- compiler,  one for each passive task object.  The entry
	-- and guard arrays are not really 1..8,  but we want them
	-- to be constrained.
   --------------------------------------------------------------------------
	type entry_array is array( integer range 1..8 ) of integer;
	type a_entrys is access entry_array;
	type guard_array is array( integer range 1..8 ) of boolean;
	type a_guards is access guard_array;

	type task_header;
	type task_header_ref is access task_header;
	type task_header is record
		state:   			integer;
		alloc_base:			address;
		guard_ptr:			a_guards;
		entry_ptr:			a_entrys;

		abort_safe:			boolean;
		entered_from_isr:	boolean;
		callable_from_isr:	boolean;

		active_passive_link:task_header_ref;
-- CIFO_SYNCHRONIZATION
		entry_criteria: 	v_i_cifo.queuing_t;
-- CIFO_SYNCHRONIZATION
-- PRIORITY_CEILING
		ceiling_prio:		integer;
-- PRIORITY_CEILING
		attr:				ada_krn_defs.a_mutex_attr_t;
		safe_cond:			v_i_mutex.safe_cond_t;
		safe_mutex:			v_i_mutex.safe_mutex_t;
	end record;

	function to_task_header_ref is
		new unchecked_conversion(address, task_header_ref);


   --------------------------------------------------------------------------
	-- The three different kinds of entry calls.  
   --------------------------------------------------------------------------
	pt_entry_call:		constant integer := 1;
	pt_cond_call:		constant integer := 2;
	pt_timed_call:		constant integer := 3;

   --------------------------------------------------------------------------
	-- Parameter block passed to passive task accept bodies and the
	-- compiler generated utility routines called by the accept bodies.
	-- A pointer to this block is passed in the target's RESULT register.
   --------------------------------------------------------------------------
	type param_block is record
		header:			task_header_ref;
		kind_of_call:	integer;
		delay_value:	duration;
	end record;
	type a_param_block is access param_block;

	-- These constants are used in v_usr_conf to allow the machine
	-- code routine V_PASSIVE_ISR to reference param_block fields.
	-- The rep spec below is included to allow the compiler to check
	-- that the offsets are correct and/or reasonable.


	PT_PB_HEADER_OFF:		constant := 0;
	PT_PB_KIND_OFF:			constant := 4;
	PT_PB_DELAY_OFF:		constant := 8;

	for param_block use record
		header 	  			at PT_PB_HEADER_OFF  	range 0..31;
		kind_of_call		at PT_PB_KIND_OFF  		range 0..31;
		delay_value			at PT_PB_DELAY_OFF  	range 0..31;
	end record;

   --------------------------------------------------------------------------
	-- Interrupt entry's ISR header record built by the compiler
   --------------------------------------------------------------------------
	type isr_header is record
		vector_num:   		integer;
		entry_num:  		integer;
		param_block:		a_param_block;
		finish_accept_a:	address;
	end record;

	-- These constants are used in v_usr_conf to allow the machine
	-- code routine V_PASSIVE_ISR to reference the isr header.
	-- The rep spec below is included to allow the compiler to check
	-- that the offsets are correct and/or reasonable.

	PT_ISR_VECTOR_NUM_OFF:			constant := 0;
	PT_ISR_ENTRY_NUM_OFF:			constant := 4;
	PT_ISR_PARAM_BLOCK_OFF:			constant := 8;
	PT_ISR_FINISH_ACCEPT_A_OFF:		constant := 12;

	for isr_header use record
		vector_num 	  		at PT_ISR_VECTOR_NUM_OFF   range 0..31;
		entry_num			at PT_ISR_ENTRY_NUM_OFF    range 0..31;
		param_block			at PT_ISR_PARAM_BLOCK_OFF  range 0..31;
		finish_accept_a	at PT_ISR_FINISH_ACCEPT_A_OFF  range 0..31;
	end record;
		
	type isr_header_ref is access isr_header;

   --------------------------------------------------------------------------
   -- Subprograms to call/enter a passive task's entry
   --------------------------------------------------------------------------
	function pt_enter(entry_num: integer; t: task_header_ref) 
		return boolean;
	function pt_safe_enter(entry_num: integer; t: task_header_ref)
		return boolean;

	function pt_cond_enter(entry_num: integer; t: task_header_ref)
		return boolean;
	function pt_safe_cond_enter(entry_num: integer; t: task_header_ref)
		return boolean;

	function pt_timed_enter(timeout: duration; entry_num: integer;
		t: task_header_ref) return boolean;
	function pt_safe_timed_enter(timeout: duration; entry_num: integer;
		t: task_header_ref) return boolean;

   --------------------------------------------------------------------------
	-- Subprogam to call/enter a passive task's entry from an ISR
   --------------------------------------------------------------------------
	procedure pt_isr_enter(t: task_header_ref);

   --------------------------------------------------------------------------
	-- Subprogram to leave a passive task
   --------------------------------------------------------------------------
	procedure pt_leave(t: task_header_ref);
	procedure pt_safe_leave(t: task_header_ref);

   --------------------------------------------------------------------------
	-- Subprogram to initialize a passive task
   --------------------------------------------------------------------------
	procedure pt_init(t: task_header_ref);

   --------------------------------------------------------------------------
	-- Abort a passive task by setting it's state to TERMINATED.
   --------------------------------------------------------------------------
	procedure pt_abort(t: task_header_ref);

   --------------------------------------------------------------------------
	-- The E'count attribute for passive tasks.
   --------------------------------------------------------------------------
	function pt_count(entry_num: integer; t: task_header_ref) return integer;

   --------------------------------------------------------------------------
	-- Routines to elaborate passive tasks.  Tasks are added to the 
	-- activation list by pt_link and elaborated _en masse_ by pt_elab_list.
   --------------------------------------------------------------------------
	procedure pt_link(activ_list: system.address; t: task_header_ref; 
		proc_addr: system.address; flag_addr: system.address;
		generic_env: system.address);

	procedure pt_elab_list(activ_list: system.address);

-- PRIORITY_CEILING
   --------------------------------------------------------------------------
   -- Priority ceiling server task subprograms
   --
   -- Only supported as part of the CIFO add-on product. These routines
   -- support the INITIAL_TASK_PRIORITY_CEILING pragma. Also support
   -- the routines, SET_PRIORITY_CEILING and PRIORITY_CEILING_OF
   -- found in the DYNAMIC_TASK_PRIORITY_CEILINGS package.
   --------------------------------------------------------------------------
	procedure pt_ceiling_init(t: task_header_ref; ceiling_prio: priority);
	function pt_ceiling_enter(entry_num: integer; t: task_header_ref)
		return boolean;
	procedure pt_ceiling_leave(t: task_header_ref);

	procedure pt_ceiling_set_priority(t: task_header_ref;
		ceiling_prio: priority);
	function pt_ceiling_get_priority(t: task_header_ref) return priority;
	  -- Either routine will raise v_i_cifo.PRIORITY_CEILING_ERROR if the
	  -- passive task isn't a priority ceiling server.
-- PRIORITY_CEILING

private
	pragma interface(ADA, pt_enter);
	pragma interface_name(pt_enter, "PT_ENTER");
	pragma interface(ADA, pt_safe_enter);
	pragma interface_name(pt_safe_enter, "PT_SAFE_ENTER");

	pragma interface(ADA, pt_cond_enter);
	pragma interface_name(pt_cond_enter, "PT_COND_ENTER");
	pragma interface(ADA, pt_safe_cond_enter);
	pragma interface_name(pt_safe_cond_enter, "PT_SAFE_COND_ENTER");

	pragma interface(ADA, pt_timed_enter);
	pragma interface_name(pt_timed_enter, "PT_TIMED_ENTER");
	pragma interface(ADA, pt_safe_timed_enter);
	pragma interface_name(pt_safe_timed_enter, "PT_SAFE_TIMED_ENTER");

	pragma interface(ADA, pt_isr_enter);
	pragma interface_name(pt_isr_enter, "PT_ISR_ENTER");

	pragma interface(ADA, pt_leave);
	pragma interface_name(pt_leave, "PT_LEAVE");
	pragma interface(ADA, pt_safe_leave);
	pragma interface_name(pt_safe_leave, "PT_SAFE_LEAVE");

	pragma interface(ADA, pt_init);
	pragma interface_name(pt_init, "PT_INIT");
	pragma interface(ADA, pt_elab_list);
	pragma interface_name(pt_elab_list, "PT_ELAB_LIST");
	pragma interface(ADA, pt_link);
	pragma interface_name(pt_link, "PT_LINK");
	pragma interface(ADA, pt_count);
	pragma interface_name(pt_count, "PT_COUNT");
	pragma interface(ADA, pt_abort);
	pragma interface_name(pt_abort, "PT_ABORT");

-- PRIORITY_CEILING
  	pragma interface(ADA, pt_ceiling_init);
	pragma interface_name(pt_ceiling_init, "PT_CEILING_INIT");
	pragma interface(ADA, pt_ceiling_enter);
	pragma interface_name(pt_ceiling_enter, "PT_CEILING_ENTER");
	pragma interface(ADA, pt_ceiling_leave);
	pragma interface_name(pt_ceiling_leave, "PT_CEILING_LEAVE");
	pragma interface(ADA, pt_ceiling_set_priority);
	pragma interface_name(pt_ceiling_set_priority, "PT_CEILING_SET_PRIORITY");
	pragma interface(ADA, pt_ceiling_get_priority);
	pragma interface_name(pt_ceiling_get_priority, "PT_CEILING_GET_PRIORITY");
-- PRIORITY_CEILING
end;

package body v_i_pass is
end