DataMuseum.dk

top - metrics - download

    Length: 6954 (0x1b2a)
    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« 
        └─⟦8e77c7d76⟧ 
            └─⟦this⟧ 

TextFile

-- Copyright 1988, 1992 Verdix Corporation

------------------------------------------------------------------------------
-- User interface to the counting semaphore data structures 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 counting semaphore data structures and
-- subprograms found in ada_krn_defs.a and ada_krn_i.a.
--
-- Differences from earlier releases:
--  [1] The intr_flag and intr_status are only applicable to the
--      VADS_MICRO.
--  [2] For the delete() service, if the conditional_delete_flag is TRUE,
--      the semaphore might not be deleted even though no tasks are
--      waiting on it. This caveat isn't applicable to the VADS_MICRO.
------------------------------------------------------------------------------
with ada_krn_defs;
with ada_krn_i;
package v_i_csema is

    pragma suppress(ALL_CHECKS);
    pragma suppress(EXCEPTION_TABLES);
    pragma not_elaborated;
    
    type intr_status_t is new ada_krn_defs.intr_status_t;
--    DISABLE_INTR_STATUS	: constant intr_status_t :=
--		intr_status_t(ada_krn_defs.DISABLE_INTR_STATUS);
	function DISABLE_INTR_STATUS return intr_status_t;
	  pragma inline_only(DISABLE_INTR_STATUS);

	-- Predefined wait_time values
	WAIT_FOREVER: constant duration := -1.0;
	DO_NOT_WAIT:  constant duration := 0.0;

    --------------------------------------------------------------------------
    -- Counting semaphore data structure
    --------------------------------------------------------------------------
    type cnt_sema_record_t is new ada_krn_defs.count_semaphore_t;
    type a_cnt_sema_t is new ada_krn_defs.a_count_semaphore_t;

    --------------------------------------------------------------------------
    -- Create a new counting semaphore.
    --
    -- Normally, the critical region for updating the semaphore's
    -- count is protected by a binary semaphore.
	--
    -- However, if the intr_flag is TRUE, then,
    -- its critical region is protected by disabling interrupts. This
    -- allows the counting semaphore to be accessed from an ISR.
    --
    -- STORAGE_ERROR exception is raised if not enough memory for semaphore.
	--
	-- Use of the intr_flag and intr_status fields is only applicable
	-- to the VADS_MICRO.
    --------------------------------------------------------------------------
    function create(initial_count: integer := 1;
        intr_flag: boolean := FALSE;
        intr_status: intr_status_t := DISABLE_INTR_STATUS
    ) return a_cnt_sema_t;
	  pragma inline_only(create);

    --------------------------------------------------------------------------
    -- Deletes a previously created counting semaphore. Returns TRUE if
    -- deletion was successful.
    --
    -- If conditional_delete_flag parameter is TRUE, then, semaphore
    -- is not deleted if any task is waiting on it.
    -- Otherwise, semaphore is always deleted and waiting tasks
    -- are resumed.
	--
	-- Note: if the conditional_delete_flag is TRUE, the semaphore might not
	-- be deleted even though no tasks are waiting on it. This caveat isn't
	-- applicable to the VADS_MICRO.
    --------------------------------------------------------------------------
    function delete(cnt_sema: a_cnt_sema_t; conditional_delete_flag: boolean)
        return boolean;
	  pragma inline_only(delete);

    --------------------------------------------------------------------------
    -- Waits on a counting semaphore.
    --
    -- Returns TRUE, if semaphore count > 0. The count is decremented
    -- before returning.
    --
    -- If count <= 0, then, returns according to the wait_time parameter:
    --  < 0.0    	    - returns when count > 0. This may necessitate
    --                    suspension of current task until another task
    --                    signals.
    --  = 0.0     	    - returns FALSE immediately if count <= 0.
    --  > 0.0           - if count doesn't become positive
    --                    within "wait_time" amount of time, returns FALSE.
    --
    -- Note: returns FALSE for any wait_time, if semaphore was deleted.
    --                    
    --------------------------------------------------------------------------
    function wait(cnt_sema: a_cnt_sema_t;
        wait_time: duration) return boolean;
	  pragma inline_only(wait);

    --------------------------------------------------------------------------
    -- Signals a counting semaphore.
    --
    -- Increments the semphore's count. If count > 0, resumes next
    -- task waiting on semaphore.
    --------------------------------------------------------------------------
    procedure signal(cnt_sema: a_cnt_sema_t);
	  pragma inline_only(signal);

end v_i_csema;

with system;
with ada_krn_defs;
with ada_krn_i;
with unchecked_deallocation;
package body v_i_csema is

    pragma suppress(ALL_CHECKS);
    pragma suppress(EXCEPTION_TABLES);
    
    function create(initial_count: integer := 1;
        intr_flag: boolean := FALSE;
        intr_status: intr_status_t := DISABLE_INTR_STATUS
    ) return a_cnt_sema_t
	is
		s: ada_krn_defs.a_count_semaphore_t :=
				new ada_krn_defs.count_semaphore_t;
	begin
		if intr_flag then
			declare
				attr_rec: ada_krn_defs.count_semaphore_attr_t;
			begin
				ada_krn_defs.count_intr_attr_init(
					ada_krn_defs.to_a_count_semaphore_attr_t(attr_rec'address),
					ada_krn_defs.intr_status_t(intr_status));
				if not ada_krn_i.count_semaphore_init(s, initial_count,
					ada_krn_defs.to_a_count_semaphore_attr_t(attr_rec'address))
				then
					raise STORAGE_ERROR;
				end if;
			end;
		else
			if not ada_krn_i.count_semaphore_init(s, initial_count,
				ada_krn_defs.DEFAULT_COUNT_SEMAPHORE_ATTR)
			then
				raise STORAGE_ERROR;
			end if;
		end if;
		return a_cnt_sema_t(s);
	end;

	procedure free is new unchecked_deallocation(
		ada_krn_defs.count_semaphore_t,
		ada_krn_defs.a_count_semaphore_t);

    function delete(cnt_sema: a_cnt_sema_t; conditional_delete_flag: boolean)
        return boolean
	is
		s: ada_krn_defs.a_count_semaphore_t :=
				ada_krn_defs.a_count_semaphore_t(cnt_sema);
	begin
		if conditional_delete_flag and then
			ada_krn_i.count_semaphore_get_in_use(s)
		then
			return FALSE;
		end if;
		ada_krn_i.count_semaphore_destroy(s);
		free(s);
		return TRUE;
	end;

    function wait(cnt_sema: a_cnt_sema_t;
        wait_time: duration) return boolean
	is
	begin
		return ada_krn_i.count_semaphore_wait(
			ada_krn_defs.a_count_semaphore_t(cnt_sema), wait_time);
	end;

    procedure signal(cnt_sema: a_cnt_sema_t) is
	begin
		ada_krn_i.count_semaphore_signal(
			ada_krn_defs.a_count_semaphore_t(cnt_sema));
	end;

	function DISABLE_INTR_STATUS return intr_status_t is
	begin
		return intr_status_t(ada_krn_defs.DISABLE_INTR_STATUS);
	end;
end v_i_csema