DataMuseum.dk

top - download

    Length: 6946 (0x1b22)
    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« 
        └─⟦d1707af99⟧ 
            └─⟦this⟧ 

TextFile

-- Copyright 1986,1987,1988,1992 Verdix Corporation

------------------------------------------------------------------------------
-- User interface to the binary semaphore data structure and subprograms
--
-- Provides backward compatibility with earlier releases of VADS.
--
-- The interface to ALL the low kernel services is now provided in
-- ada_krn_i.a. Types used by these services is defined in ada_krn_defs.a.
--
-- This package simply layers upon the semaphore data structures and
-- subprograms found in ada_krn_defs.a and ada_krn_i.a.
--
-- Differences from earlier releases:
--  [1] Semaphore must be initialized by calling the newly added routine,
--      init_sema().
--  [2] For VADS_MICRO, only FIFO queueing is supported. For priority
--      queueing use the mutex and condition variable services provided
--		in ada_krn_i.a.
--  [3] The following services aren't supported: suspend(), timed_suspend()
--		or resume().
------------------------------------------------------------------------------
with system;
with ada_krn_defs;
with unchecked_conversion;
package v_i_sema is

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

	V_I_SEMA_NOT_SUPPORTED: exception;
    
    --------------------------------------------------------------------------
    -- Semaphore data structure. An object of this type must be declared
    -- and initialized via init_sema() before calling any of the semaphore
	-- subprograms.
    --
    -- For example:
    --  declare
    --      my_semaphore: v_i_sema.semaphore_rec;
	--		result: boolean;
    --  begin
	--		result := v_i_sema.init_sema(
	--			v_i_sema.to_a_semaphore(my_semaphore'address),
	--			v_i_sema.SEMAPHORE_EMPTY);
	--
	--		...
	--
    --      v_i_sema.enter(v_i_sema.to_a_semaphore(my_semaphore'address));
    --  end;
    --------------------------------------------------------------------------

    type semaphore_rec is new ada_krn_defs.semaphore_t;
    type a_semaphore is new ada_krn_defs.a_semaphore_t;
    function to_a_semaphore is new
        unchecked_conversion(system.address, a_semaphore);

    type semaphore_state_t is new ada_krn_defs.semaphore_state_t;
    SEMAPHORE_FULL  : constant semaphore_state_t :=
						semaphore_state_t(ada_krn_defs.SEMAPHORE_FULL);
    SEMAPHORE_EMPTY : constant semaphore_state_t :=
						semaphore_state_t(ada_krn_defs.SEMAPHORE_EMPTY);

    --------------------------------------------------------------------------
    -- Subprogram to initialize the semaphore record. Returns TRUE if the
	-- semaphore was successfully initialized.
	--
	-- Newly added subprogram. Since the semaphore record content 
	-- depends on the underlying kernel (VADS_MICRO, SUN_THREADS, SGI_THREADS),
	-- you can no longer explicitly initialize the record fields as was
	-- done in earlier VADS releases.
    --------------------------------------------------------------------------
	function init_sema(
		s			: a_semaphore;
		init_state	: semaphore_state_t := SEMAPHORE_EMPTY) return boolean;
	  pragma inline_only(init_sema);

    --------------------------------------------------------------------------
    -- Subprograms to enter a critical region guarded by a semaphore.
    --  enter               - returns when in critical region. This may
    --                        necessitate suspension of current task until
    --                        another task leaves the critical region.
    --  conditional_enter   - like "enter" except that it returns immediately
    --                        with a return value of FALSE, if the critical
    --                        region cannot be entered right away
    --  timed_enter         - like "enter" except that if it cannot enter within
    --                        a specified amount of time, it returns a value =
    --                        FALSE
    --------------------------------------------------------------------------
    procedure enter(s: a_semaphore);
	  pragma inline_only(enter);
    function conditional_enter(s: a_semaphore) return boolean;
	  pragma inline_only(conditional_enter);
    function timed_enter(s: a_semaphore; timeout: duration)
        return boolean;
	  pragma inline_only(timed_enter);

    --------------------------------------------------------------------------
    -- Leaves a critical region previously entered. Resumes next task
    -- suspended on waiting to enter.
    --------------------------------------------------------------------------
    procedure leave(s: a_semaphore);
	  pragma inline_only(leave);

    --------------------------------------------------------------------------
    -- Subprograms to suspend the current task on semaphore queue
    --  suspend         - task is suspended until semaphore is resumed
    --  timed_suspend   - like "suspend" except that if task is not resumed
    --                    within a specified amount of time, it returns a
    --                    value = FALSE
	--
	-- Not Supported. If called, raise the exception, V_I_SEMA_NOT_SUPPORTED.
    --------------------------------------------------------------------------
    procedure suspend(s: a_semaphore);
	  pragma inline_only(suspend);
    function timed_suspend(s: a_semaphore; timeout: duration)
        return boolean;
	  pragma inline_only(timed_suspend);

    --------------------------------------------------------------------------
    -- Resumes all tasks previously suspended on semaphore queue
	--
	-- Not Supported. If called, raises the exception, V_I_SEMA_NOT_SUPPORTED.
    --------------------------------------------------------------------------
    procedure resume(s: a_semaphore);
	  pragma inline_only(resume);

end v_i_sema;

with system;
with ada_krn_defs;
with ada_krn_i;
package body v_i_sema is
	function init_sema(
		s			: a_semaphore;
		init_state	: semaphore_state_t := SEMAPHORE_EMPTY) return boolean
	is
	begin
		return ada_krn_i.semaphore_init(ada_krn_defs.a_semaphore_t(s),
			ada_krn_defs.semaphore_state_t(init_state), 
			ada_krn_defs.DEFAULT_SEMAPHORE_ATTR);
	end;

    procedure enter(s: a_semaphore) is
	begin
		ada_krn_i.semaphore_wait(ada_krn_defs.a_semaphore_t(s));
	end;
    function conditional_enter(s: a_semaphore) return boolean is
	begin
		return ada_krn_i.semaphore_trywait(ada_krn_defs.a_semaphore_t(s));
	end;
    function timed_enter(s: a_semaphore; timeout: duration) return boolean is
	begin
		return ada_krn_i.semaphore_timed_wait(ada_krn_defs.a_semaphore_t(s),
			timeout);
	end;

    procedure leave(s: a_semaphore) is
	begin
		ada_krn_i.semaphore_signal(ada_krn_defs.a_semaphore_t(s));
	end;

    procedure suspend(s: a_semaphore) is
	begin
		raise V_I_SEMA_NOT_SUPPORTED;
	end;
    function timed_suspend(s: a_semaphore; timeout: duration)
        return boolean
	is
	begin
		raise V_I_SEMA_NOT_SUPPORTED;
		return FALSE;
	end;

    procedure resume(s: a_semaphore) is
	begin
		raise V_I_SEMA_NOT_SUPPORTED;
	end;
end v_i_sema