DataMuseum.dk

top - download

    Length: 5704 (0x1648)
    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« 
        └─⟦2fe0bb8e7⟧ 
            └─⟦this⟧ 

TextFile

-- Copyright 1988, 1992 Verdix Corporation

------------------------------------------------------------------------------
-- User interface to the interrupt services
--
-- 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 interrupt data structures and
-- subprograms found in ada_krn_defs.a and ada_krn_i.a.
--
-- Differences from earlier releases:
--  [1] The following services aren't supported: enter_isr(), complete_isr().
------------------------------------------------------------------------------
with system;
with ada_krn_defs;
package v_i_intr is

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

	V_I_INTR_NOT_SUPPORTED: exception;

    type intr_vector_id_t is new ada_krn_defs.intr_vector_id_t;
    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);

--    ENABLE_INTR_STATUS	: constant intr_status_t :=
--		intr_status_t(ada_krn_defs.ENABLE_INTR_STATUS);
	function ENABLE_INTR_STATUS return intr_status_t;
	  pragma inline_only(ENABLE_INTR_STATUS);

    --------------------------------------------------------------------------
    -- RTS routines to support attach/detach of ISR's.
	-- The attach/detach routines return TRUE if the isr was
	-- successfully attached/detached. They return FALSE for an invalid
	-- interrupt vector.
    --------------------------------------------------------------------------
    function attach_isr(iv: intr_vector_id_t; isr: system.address)
		return boolean;
	  pragma inline_only(attach_isr);
    function detach_isr(iv: intr_vector_id_t) return boolean;
	  pragma inline_only(detach_isr);

    --------------------------------------------------------------------------
    -- RTS routines to support enter/complete of ISR's
	--
	-- Not supported. If called, raise the exception, V_I_INTR_NOT_SUPPORTED.
	--
	-- Check, V_INTERRUPTS in VADS_EXEC, V_PASSIVE_ISR in V_USR_CONF
	-- or V_SIGNAL_ISR in V_USR_CONF for the routines to be called.
    --------------------------------------------------------------------------
    procedure enter_isr;
	  pragma inline_only(enter_isr);
    procedure complete_isr;
	  pragma inline_only(complete_isr);

    --------------------------------------------------------------------------
	-- RTS routines to enter/leave supervisor state for the current task
    --------------------------------------------------------------------------
	procedure enter_supervisor_state;
	  pragma inline_only(enter_supervisor_state);
	procedure leave_supervisor_state;
	  pragma inline_only(leave_supervisor_state);

    --------------------------------------------------------------------------
    -- RTS routine to support getting of interrupt status
    --------------------------------------------------------------------------
	procedure get_interrupts(old_status: out intr_status_t);
	  pragma inline_only(get_interrupts);

    --------------------------------------------------------------------------
	-- RTS routines to support enable/disable of interrupts from user program
    --------------------------------------------------------------------------
	procedure disable_interrupts(old_status: out intr_status_t;
		new_status: intr_status_t := DISABLE_INTR_STATUS);
	  pragma inline_only(disable_interrupts);
	procedure restore_interrupts(old_status: intr_status_t);
	  pragma inline_only(restore_interrupts);

end v_i_intr;

with system;		use system;
with ada_krn_defs;
with ada_krn_i;
package body v_i_intr is

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

    function attach_isr(iv: intr_vector_id_t; isr: system.address)
		return boolean
	is
	begin
		if ada_krn_i.isr_attach(
			ada_krn_defs.intr_vector_id_t(iv),
			isr) /= ada_krn_defs.BAD_INTR_VECTOR
		then
			return TRUE;
		else
			return FALSE;
		end if;
	end;

    function detach_isr(iv: intr_vector_id_t) return boolean is
	begin
		if ada_krn_i.isr_detach(ada_krn_defs.intr_vector_id_t(iv)) /=
			ada_krn_defs.BAD_INTR_VECTOR
		then
			return TRUE;
		else
			return FALSE;
		end if;
	end;

    procedure enter_isr is
	begin
		raise V_I_INTR_NOT_SUPPORTED;
	end;
    procedure complete_isr is
	begin
		raise V_I_INTR_NOT_SUPPORTED;
	end;

	procedure enter_supervisor_state is
	begin
		ada_krn_i.task_enter_supervisor_state;
	end;
	procedure leave_supervisor_state is
	begin
		ada_krn_i.task_leave_supervisor_state;
	end;

	procedure get_interrupts(old_status: out intr_status_t) is
		status: ada_krn_defs.intr_status_t;
	begin
		ada_krn_i.interrupts_get_status(status);
		old_status := intr_status_t(status);
	end;

	procedure disable_interrupts(old_status: out intr_status_t;
		new_status: intr_status_t := DISABLE_INTR_STATUS)
	is
		status: ada_krn_defs.intr_status_t;
	begin
		ada_krn_i.interrupts_set_status(status,
			ada_krn_defs.intr_status_t(new_status));
		old_status := intr_status_t(status);
	end;

	procedure restore_interrupts(old_status: intr_status_t) is
		status: ada_krn_defs.intr_status_t;
	begin
		ada_krn_i.interrupts_set_status(status,
			ada_krn_defs.intr_status_t(old_status));
	end;

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

	function ENABLE_INTR_STATUS return intr_status_t is
	begin
		return intr_status_t(ada_krn_defs.ENABLE_INTR_STATUS);
	end;

end v_i_intr