DataMuseum.dk

top - download

    Length: 9046 (0x2356)
    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« 
        └─⟦91d8dc785⟧ 
            └─⟦this⟧ 

TextFile

-- Copyright 1992  Verdix Corporation

with system;				use system;
with ada_krn_defs;
with v_i_cifo;
with unchecked_conversion;
package v_i_mutex is

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

	--------------------------------------------------------------------------
	-- Ada tasking ABORT_SAFE mutex and condition variable services
	--
	-- After locking a mutex the task is inhibited from being completed
	-- by an Ada abort until it unlocks the mutex.
	--
	-- However, if a task is aborted while waiting at a condition variable
	-- (after an implicit mutex unlock), then, it is completed.
	--
	-- These services also address the case where multiple ABORT_SAFE
	-- mutexes can be locked. The task is inhibited from being completed
	-- until all the mutexes are unlocked or it does a condition variable
	-- wait with only one mutex locked.
	--------------------------------------------------------------------------

    subtype safe_mutex_attr_t is ada_krn_defs.mutex_attr_t;
    subtype a_safe_mutex_attr_t is ada_krn_defs.a_mutex_attr_t;
    function to_a_safe_mutex_attr_t is
        new unchecked_conversion(address, a_safe_mutex_attr_t);

--    DEFAULT_SAFE_MUTEX_ATTR: constant a_safe_mutex_attr_t := null;
    function DEFAULT_SAFE_MUTEX_ATTR return a_safe_mutex_attr_t;
	  pragma inline_only(DEFAULT_SAFE_MUTEX_ATTR);

	type safe_mutex_t;
    type a_safe_mutex_t is access safe_mutex_t;
	type safe_mutex_t is record
		q_next:				a_safe_mutex_t;
-- PRIORITY_INHERITANCE
		owner:				task_id; -- updated for priority_inheritance to
									 -- inhibit relock of the task's
									 -- mutex
-- PRIORITY_INHERITANCE
		mutex:				ada_krn_defs.mutex_t;
	end record;
    function to_a_safe_mutex_t is
		new unchecked_conversion(address, a_safe_mutex_t);

	type safe_cond_t;
    type a_safe_cond_t is access safe_cond_t;
	type safe_cond_t is record
		queuing:				v_i_cifo.queuing_t;
		abort_callout_proc:		address;
		abort_arg:				address;
		entryq_head:			task_id;
		entryq_tail:			task_id;
	end record;
    function to_a_safe_cond_t is
		new unchecked_conversion(address, a_safe_cond_t);

	--------------------------------------------------------------------------
	-- ABORT_SAFE mutex services
	--------------------------------------------------------------------------

	-- Returns TRUE if mutex was successfully initialized.
    function ts_mutex_init(
		safe_mutex	: a_safe_mutex_t;
		safe_attr	: a_safe_mutex_attr_t := DEFAULT_SAFE_MUTEX_ATTR)
	return boolean;

    procedure ts_mutex_destroy(safe_mutex: a_safe_mutex_t);

	-- If the safe_mutex is lockable from an ISR, then,
	-- these safe mutex lock/unlock services can be called from an ISR.
    procedure ts_mutex_lock(safe_mutex: a_safe_mutex_t);
    function ts_mutex_trylock(safe_mutex: a_safe_mutex_t) return boolean;
    procedure ts_mutex_unlock(safe_mutex: a_safe_mutex_t);

	--------------------------------------------------------------------------
	-- ABORT_SAFE condition variable services
	--------------------------------------------------------------------------

	-- Returns TRUE if cond variable was successfully initialized and the
	-- specified queuing type is supported.
	--
	-- Supports FIFO or PRIORITY queuing when the task waits on
	-- a condition variable.
	--
	-- Note: PRIORITY queuing is only supported in the CIFO add-on
	-- product.
    function ts_cond_init(
		safe_cond			: a_safe_cond_t;
		queuing				: v_i_cifo.queuing_t := v_i_cifo.ARBITRARY_QUEUING;
		abort_callout_proc	: address := NO_ADDR;
		abort_arg			: address := NO_ADDR) return boolean;
		  --
		  -- The abort_callout_proc callout has the following subprogram
		  -- interface:
		  --	procedure abort_callout_proc(abort_arg: address);
		  --
		  -- If the task is aborted while waiting on a condition variable, then,
		  -- its called in the context of the task doing the condition wait
		  -- with the mutex locked.
		  --
		  -- Setting abort_callout_proc to NO_ADDR inhibits the callout.
		  --
		  -- The abort_arg is passed directly to the abort_callout_proc().
		  --
		  -- If queuing = UNSPECIFIED_QUEUING or ARBITRARY_QUEUING, then, 
		  --  For CIFO add-on: uses queuing specified by the main
		  --	procedure's SET_GLOBAL_ENTRY_CRITERIA pragma.
		  --  Else: uses FIFO_QUEUING

    procedure ts_cond_destroy(safe_cond: a_safe_cond_t);

	-- If the task is aborted with more than one mutex locked, then,
	-- the abort can cause ts_cond_wait() to return prematurely without
	-- ts_cond_signal() or ts_cond_broadcast being called by the
	-- application code.
	--
	-- If the task is aborted with only one mutex locked, then,
	-- ts_cond_wait() doesn't return. However, if the abort_callout_proc
	-- parameter passed to ts_cond_init() is nonzero, then, it is called
	-- before the task completes itself.
    procedure ts_cond_wait(
		safe_cond			: a_safe_cond_t;
		safe_mutex			: a_safe_mutex_t);

	-- ts_cond_timed_wait() has the same abort/complete semantics as
	-- ts_cond_wait().
    function ts_cond_timed_wait(
		safe_cond			: a_safe_cond_t;
		safe_mutex			: a_safe_mutex_t;
        sec					: duration) return boolean;

	-- Calling ts_cond_signal() without locking the same safe_mutex
	-- used by ts_cond_wait/ts_cond_timed_wait can lead to unexpected
	-- results.
	--
	-- If the safe_mutex is lockable from an ISR, then, ts_cond_signal can
	-- be called from an ISR.
    procedure ts_cond_signal(safe_cond: a_safe_cond_t);

	-- ts_cond_broadcast() has the same comments as for ts_cond_signal().
    procedure ts_cond_broadcast(safe_cond: a_safe_cond_t);

	-- If the safe_mutex is lockable from an ISR, then,
	-- ts_cond_signal_unlock() can be called from an ISR.
    procedure ts_cond_signal_unlock(safe_cond: a_safe_cond_t;
		safe_mutex: a_safe_mutex_t);

	function ts_cond_get_wait_head_task(safe_cond: a_safe_cond_t)
		return task_id;

	-- Upon entry/exit, the safe mutex used to protect the condition
	-- variable must be locked by the caller.
	function ts_cond_get_wait_count(safe_cond: a_safe_cond_t)
		return natural;


    -------------------------------------------------------------------------
    -- ABORT_SAFE priority ceiling mutex services (CIFO augmentation)
    -------------------------------------------------------------------------

	-- Returns TRUE if underlying micro kernel supports the priority ceiling
	-- protocol and the mutex was successfully initialized.
    function ts_ceiling_mutex_init(
		safe_mutex		: a_safe_mutex_t;
		safe_attr		: a_safe_mutex_attr_t := DEFAULT_SAFE_MUTEX_ATTR;
		ceiling_prio	: priority := priority'last) return boolean;

	-- Returns FALSE if not a priority ceiling mutex
    function ts_ceiling_mutex_set_priority(safe_mutex: a_safe_mutex_t;
		ceiling_prio: priority) return boolean;

	-- Returns -1 if not a priority ceiling mutex
    function ts_ceiling_mutex_get_priority(safe_mutex: a_safe_mutex_t)
		return integer;
private
	pragma interface(ADA, ts_mutex_init);
    pragma interface_name(ts_mutex_init, "TS_MUTEX_INIT");
	pragma interface(ADA, ts_mutex_destroy);
    pragma interface_name(ts_mutex_destroy, "TS_MUTEX_DESTROY");
	pragma interface(ADA, ts_mutex_lock);
    pragma interface_name(ts_mutex_lock, "TS_MUTEX_LOCK");
	pragma interface(ADA, ts_mutex_trylock);
    pragma interface_name(ts_mutex_trylock, "TS_MUTEX_TRYLOCK");
	pragma interface(ADA, ts_mutex_unlock);
    pragma interface_name(ts_mutex_unlock, "TS_MUTEX_UNLOCK");

	pragma interface(ADA, ts_cond_init);
    pragma interface_name(ts_cond_init, "TS_COND_INIT");
    pragma interface(ADA, ts_cond_destroy);
    pragma interface_name(ts_cond_destroy, "TS_COND_DESTROY");
    pragma interface(ADA, ts_cond_wait);
    pragma interface_name(ts_cond_wait, "TS_COND_WAIT");
    pragma interface(ADA, ts_cond_timed_wait);
    pragma interface_name(ts_cond_timed_wait, "TS_COND_TIMED_WAIT");
    pragma interface(ADA, ts_cond_signal);
    pragma interface_name(ts_cond_signal, "TS_COND_SIGNAL");
    pragma interface(ADA, ts_cond_broadcast);
    pragma interface_name(ts_cond_broadcast, "TS_COND_BROADCAST");
    pragma interface(ADA, ts_cond_signal_unlock);
    pragma interface_name(ts_cond_signal_unlock, "TS_COND_SIGNAL_UNLOCK");
    pragma interface(ADA, ts_cond_get_wait_head_task);
    pragma interface_name(ts_cond_get_wait_head_task,
		"TS_COND_GET_WAIT_HEAD_TASK");
    pragma interface(ADA, ts_cond_get_wait_count);
    pragma interface_name(ts_cond_get_wait_count, "TS_COND_GET_WAIT_COUNT");

	pragma interface(ADA, ts_ceiling_mutex_init);
    pragma interface_name(ts_ceiling_mutex_init, "TS_CEILING_MUTEX_INIT");
    pragma interface(ADA, ts_ceiling_mutex_set_priority);
    pragma interface_name(ts_ceiling_mutex_set_priority,
		"TS_CEILING_MUTEX_SET_PRIORITY");
    pragma interface(ADA, ts_ceiling_mutex_get_priority);
    pragma interface_name(ts_ceiling_mutex_get_priority,
		"TS_CEILING_MUTEX_GET_PRIORITY");
end v_i_mutex;

package body v_i_mutex is
    function DEFAULT_SAFE_MUTEX_ATTR return a_safe_mutex_attr_t is
	begin
		return null;
	end;
end v_i_mutex