|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 11646 (0x2d7e)
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«
└─⟦29ed5d28b⟧
└─⟦this⟧
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
--
-- VERDIX CORPORATION (C) COPYRIGHT 1988
-- 14130-A Sullyfield Circle Proprietary Information
-- Chantilly, Virginia 22021 Not to be Disclosed
--
-- FILE: V_INTR_B.A
--
-- UNITS: VADS/EXEC Interrupts Package Body. This version is for
-- the M68000 Processor Family Cross Targets.
--
-- PURPOSE: This file contains the body for the interrupt services supporting
-- user-defined interrupt service routines (ISR's) and the
-- getting/setting of interrupt status.
--
-- Refer to V_INTERRUPTS package specification in V_VADS_EXEC.A for
-- a detailed description of each service.
--
-- Do not modify or recompile this package body.
--
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
--
-- Revision History:
--
-- 880306:1430 B01
--
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
-- TARGET IS MC68020
with Machine_Code;
with V_Cpu_Conf;
with Link_Block;
with V_I_Types;
with Ada_Krn_I;
with Ada_Krn_Defs;
with System;
use System;
package body V_Interrupts is
pragma Suppress (All_Checks);
Stack_Limit : Address;
pragma Interface_Name (Stack_Limit, "STACK_LIMIT");
-- Current task's bottom of stack limit.
Debug_Block : Link_Block.Debug_Block_T;
pragma Interface_Name (Debug_Block, "DEBUG_BLOCK");
-- Contains addresses of variables and ISR services in the kernel
-- program.
procedure Isr is
pragma Implicit_Code (Off);
use Machine_Code;
begin
-- Save scratch registers
Code_2'(Movem_L, A0 / A1 / D0 / D1 / D2 / D3, Decr (Sp));
--
-- Enter ISR.
--
-- The ENTER_ISR service
-- increments the interrupt depth and switches to the interrupt stack
-- if the depth was incremented from 0 to 1.
--
-- Note: if MASTER_STATE is enabled for mc68020, the CPU already did
-- a switch from master to interrupt stack for an external interrupt.
--
-- The scratch registers (d0/d1/d2/d3/a0/a1) must be saved before calling
-- the ENTER_ISR service.
--
-- Upon return, the address of the previous
-- stack is pushed on the new stack. This address is also pushed
-- for nested interrupts. The address points to the last entry
-- pushed on the stack before the call.
--
-- Get address of ENTER_ISR service in the kernel program
Code_2'(Movea_L, Debug_Block.Intr_Enter'Ref, A0);
Code_1'(Jsr, Indr (A0));
-- Set up the frame pointer register (a6) so that the debugger and
-- exception unwinding can deduce this is the top of the stack
-- for an ISR.
--
-- By convention a6 = 0, => top of user program stack,
-- a6 = odd address => top of ISR stack
--
-- Furthermore, a6 = sp + 1. This allows the debugger to find the
-- saved value for a6 and the ISR's exception frame.
Code_2'(Move_L, A6, Decr (Sp));
Code_2'(Movea_L, Sp, A6);
Code_2'(Addq_L, +1, A6);
-- The stack looks as follows:
-- 0 - saved a6 <-- a6 - 1
-- 4 - pointer to previous stack
--
-- Where previous stack is as follows:
-- 0 - d0/d1/d2/d3/a0/a1 (saved scratch registers)
-- 24 - ISR's exception stack frame
-- Switch stack limit to bottom of interrupt stack.
Code_2'(Move_L, Stack_Limit'Ref, Decr (Sp));
Code_2'(Movea_L, Debug_Block.Intr_Stack_Limit'Ref, A0);
Code_2'(Move_L, Indr (A0), Stack_Limit'Ref);
-- Process interrupt
Call_0'(Subp => Interrupt_Handler'Ref);
-- Restore stack limit
Code_2'(Move_L, Incr (Sp), Stack_Limit'Ref);
-- Restore frame pointer
Code_2'(Movea_L, Incr (Sp), A6);
-- Complete ISR
--
-- complete_isr expects stack to look as follows
-- 0 - return pc back to ISR
-- 4 - pointer to previous stack (see below) (normally, the
-- address pushed on the new stack by ENTER_ISR)
--
-- where previous stack looks as follows:
-- 0 - a0/a1/d0/d1/d2/d3 (saved scratch registers)
-- 24 - ISR's exception stack frame
--
-- Note: enter_isr must have been previosuly called for this ISR.
--
-- Get address of COMPLETE_ISR service in kernel program
Code_2'(Movea_L, Debug_Block.Intr_Complete'Ref, A0);
Code_1'(Jsr, Indr (A0));
-- No return back here
end Isr;
procedure Fast_Isr is
pragma Implicit_Code (Off);
use Machine_Code;
-- Fast version of ISR wrapper.
--
-- This version is made faster by eliminating the call to the
-- kernel service, ENTER_ISR, which switches to the the interrupt
-- stack and increments the interrupt depth. Also the logic for
-- saving, setting and restoring the current stack limit has been
-- omitted.
--
-- Restriction:
-- The INTERRUPT_HANDLER procedure and the subprograms it calls
-- must be compiled with "pragma suppress(ALL_CHECKS)" to suppress
-- stack limit checking.
--
-- If the kernel is configured to use the m68k's master state, then,
-- FAST_ISR can not be used for software traps. It can still
-- be used for external interrupts.
begin
-- Save scratch registers
Code_2'(Movem_L, A0 / A1 / D0 / D1 / D2 / D3, Decr (Sp));
-- Emulate the omitted ENTER_ISR kernel service call by incrementing
-- the kernel's interrupt depth count and pushing the current sp
-- as the address of the previous stack.
Code_2'(Movea_L, Debug_Block.Intr_Depth'Ref, A0);
Code_2'(Addq_L, +1, Indr (A0));
Code_2'(Move_L, Sp, Decr (Sp));
-- Set up the frame pointer register (a6) so that the debugger and
-- exception unwinding can deduce this is the top of the stack
-- for an ISR.
--
-- By convention a6 = 0, => top of user program stack,
-- a6 = odd address => top of ISR stack
--
-- Furthermore, a6 = sp + 1. This allows the debugger to find the
-- saved value for a6 and the ISR's exception frame.
--
Code_2'(Move_L, A6, Decr (Sp));
Code_2'(Movea_L, Sp, A6);
Code_2'(Addq_L, +1, A6);
-- The stack looks as follows:
-- 0 - saved a6 <-- a6 - 1
-- 4 - pointer to previous stack
--
-- Where previous stack is as follows:
-- 0 - d0/d1/d2/d3/a0/a1 (saved scratch registers)
-- 24 - ISR's exception stack frame
-- Process interrupt
Call_0'(Subp => Interrupt_Handler'Ref);
-- Restore frame pointer
Code_2'(Movea_L, Incr (Sp), A6);
-- Complete ISR
--
-- complete_isr expects stack to look as follows
-- 0 - return pc back to ISR
-- 4 - pointer to previous stack (see below) (normally, the
-- address pushed on the new stack by ENTER_ISR)
--
-- where previous stack looks as follows:
-- 0 - a0/a1/d0/d1/d2/d3 (saved scratch registers)
-- 24 - ISR's exception stack frame
--
-- Note: intr_depth must have been previosuly incremented for this ISR.
--
-- Get address of COMPLETE_ISR service in kernel program
Code_2'(Movea_L, Debug_Block.Intr_Complete'Ref, A0);
Code_1'(Jsr, Indr (A0));
-- No return back here
end Fast_Isr;
procedure Float_Wrapper is
pragma Implicit_Code (Off);
use Machine_Code;
begin
-- No floating-point state save or restore for this target
-- Process interrupt
Call_0'(Subp => Float_Handler'Ref);
Code_0'(Op => Rts);
end Float_Wrapper;
function Attach_Isr (Vector : in Vector_Id; Isr : in System.Address)
return System.Address is
use System;
Prev_Vector : Address;
begin
Prev_Vector := Ada_Krn_I.Isr_Attach
(Ada_Krn_Defs.Intr_Vector_Id_T (Vector), Isr);
if Prev_Vector = Ada_Krn_Defs.Bad_Intr_Vector then
raise Invalid_Interrupt_Vector;
end if;
return Prev_Vector;
end Attach_Isr;
procedure Attach_Isr (Vector : in Vector_Id; Isr : in System.Address) is
use System;
Prev_Vector : Address;
begin
Prev_Vector := Attach_Isr (Vector, Isr);
end Attach_Isr;
function Detach_Isr (Vector : in Vector_Id) return System.Address is
use System;
Prev_Vector : Address;
begin
Prev_Vector := Ada_Krn_I.Isr_Detach
(Ada_Krn_Defs.Intr_Vector_Id_T (Vector));
if Prev_Vector = Ada_Krn_Defs.Bad_Intr_Vector then
raise Invalid_Interrupt_Vector;
end if;
return Prev_Vector;
end Detach_Isr;
procedure Detach_Isr (Vector : in Vector_Id) is
use System;
Prev_Vector : Address;
begin
Prev_Vector := Detach_Isr (Vector);
end Detach_Isr;
function Get_Isr (Vector : in Vector_Id) return System.Address is
use System;
Isr : Address;
begin
Isr := Ada_Krn_I.Isr_Get (Ada_Krn_Defs.Intr_Vector_Id_T (Vector));
if Isr = Ada_Krn_Defs.Bad_Intr_Vector then
raise Invalid_Interrupt_Vector;
end if;
return Isr;
end Get_Isr;
function Get_Ivt return System.Address is
begin
return Ada_Krn_I.Isr_Get_Ivt;
end Get_Ivt;
function Current_Interrupt_Status return Interrupt_Status_T is
Status : Ada_Krn_Defs.Intr_Status_T;
begin
Ada_Krn_I.Interrupts_Get_Status (Status);
return Interrupt_Status_T (Status);
end Current_Interrupt_Status;
function Set_Interrupt_Status (New_Status : in Interrupt_Status_T)
return Interrupt_Status_T is
Old_Status : Ada_Krn_Defs.Intr_Status_T;
begin
Ada_Krn_I.Interrupts_Set_Status
(Old_Status, Ada_Krn_Defs.Intr_Status_T (New_Status));
return Interrupt_Status_T (Old_Status);
end Set_Interrupt_Status;
function Current_Supervisor_State return Boolean is
begin
return Ada_Krn_I.Task_Get_Supervisor_State;
end Current_Supervisor_State;
procedure Enter_Supervisor_State is
begin
Ada_Krn_I.Task_Enter_Supervisor_State;
end Enter_Supervisor_State;
procedure Leave_Supervisor_State is
begin
Ada_Krn_I.Task_Leave_Supervisor_State;
end Leave_Supervisor_State;
function Set_Supervisor_State (New_State : in Boolean) return Boolean is
Old_State : Boolean := Ada_Krn_I.Task_Get_Supervisor_State;
begin
if New_State /= Old_State then
if New_State then
Ada_Krn_I.Task_Enter_Supervisor_State;
else
Ada_Krn_I.Task_Leave_Supervisor_State;
end if;
end if;
return Old_State;
end Set_Supervisor_State;
end V_Interrupts;