352 lines
14 KiB
Ada
352 lines
14 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT COMPILER COMPONENTS --
|
|
-- --
|
|
-- SYSTEM.MACHINE_STATE_OPERATIONS --
|
|
-- --
|
|
-- B o d y --
|
|
-- (Version for IRIX/MIPS) --
|
|
-- --
|
|
-- Copyright (C) 1999-2009, Free Software Foundation, Inc. --
|
|
-- --
|
|
-- GNAT is free software; you can redistribute it and/or modify it under --
|
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
|
-- ware Foundation; either version 3, or (at your option) any later ver- --
|
|
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
|
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
|
-- or FITNESS FOR A PARTICULAR PURPOSE. --
|
|
-- --
|
|
-- As a special exception under Section 7 of GPL version 3, you are granted --
|
|
-- additional permissions described in the GCC Runtime Library Exception, --
|
|
-- version 3.1, as published by the Free Software Foundation. --
|
|
-- --
|
|
-- You should have received a copy of the GNU General Public License and --
|
|
-- a copy of the GCC Runtime Library Exception along with this program; --
|
|
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
|
-- <http://www.gnu.org/licenses/>. --
|
|
-- --
|
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
|
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
|
|
-- This version of Ada.Exceptions.Machine_State_Operations is for use on
|
|
-- SGI Irix systems. By means of compile time conditional calculations, it
|
|
-- can handle both n32/n64 and o32 modes.
|
|
|
|
with System.Machine_Code; use System.Machine_Code;
|
|
with System.Memory;
|
|
with System.Soft_Links; use System.Soft_Links;
|
|
with Ada.Unchecked_Conversion;
|
|
|
|
package body System.Machine_State_Operations is
|
|
|
|
use System.Storage_Elements;
|
|
|
|
-- The exc_unwind function in libexc operates on a Sigcontext
|
|
|
|
-- Type sigcontext_t is defined in /usr/include/sys/signal.h.
|
|
-- We define an equivalent Ada type here. From the comments in
|
|
-- signal.h:
|
|
|
|
-- sigcontext is not part of the ABI - so this version is used to
|
|
-- handle 32 and 64 bit applications - it is a constant size regardless
|
|
-- of compilation mode, and always returns 64 bit register values
|
|
|
|
type Uns32 is mod 2 ** 32;
|
|
type Uns64 is mod 2 ** 64;
|
|
|
|
type Uns32_Ptr is access all Uns32;
|
|
type Uns64_Array is array (Integer range <>) of Uns64;
|
|
|
|
type Reg_Array is array (0 .. 31) of Uns64;
|
|
|
|
type Sigcontext is record
|
|
SC_Regmask : Uns32; -- 0
|
|
SC_Status : Uns32; -- 4
|
|
SC_PC : Uns64; -- 8
|
|
SC_Regs : Reg_Array; -- 16
|
|
SC_Fpregs : Reg_Array; -- 272
|
|
SC_Ownedfp : Uns32; -- 528
|
|
SC_Fpc_Csr : Uns32; -- 532
|
|
SC_Fpc_Eir : Uns32; -- 536
|
|
SC_Ssflags : Uns32; -- 540
|
|
SC_Mdhi : Uns64; -- 544
|
|
SC_Mdlo : Uns64; -- 552
|
|
SC_Cause : Uns64; -- 560
|
|
SC_Badvaddr : Uns64; -- 568
|
|
SC_Triggersave : Uns64; -- 576
|
|
SC_Sigset : Uns64; -- 584
|
|
SC_Fp_Rounded_Result : Uns64; -- 592
|
|
SC_Pancake : Uns64_Array (0 .. 5);
|
|
SC_Pad : Uns64_Array (0 .. 26);
|
|
end record;
|
|
|
|
type Sigcontext_Ptr is access all Sigcontext;
|
|
|
|
SC_Regs_Pos : constant String := "16";
|
|
SC_Fpregs_Pos : constant String := "272";
|
|
-- Byte offset of the Integer and Floating Point register save areas
|
|
-- within the Sigcontext.
|
|
|
|
function To_Sigcontext_Ptr is
|
|
new Ada.Unchecked_Conversion (Machine_State, Sigcontext_Ptr);
|
|
|
|
type Addr_Int is mod 2 ** Long_Integer'Size;
|
|
-- An unsigned integer type whose size is the same as System.Address.
|
|
-- We rely on the fact that Long_Integer'Size = System.Address'Size in
|
|
-- all ABIs. Type Addr_Int can be converted to Uns64.
|
|
|
|
function To_Code_Loc is
|
|
new Ada.Unchecked_Conversion (Addr_Int, Code_Loc);
|
|
function To_Addr_Int is
|
|
new Ada.Unchecked_Conversion (System.Address, Addr_Int);
|
|
function To_Uns32_Ptr is
|
|
new Ada.Unchecked_Conversion (Addr_Int, Uns32_Ptr);
|
|
|
|
--------------------------------
|
|
-- ABI-Dependent Declarations --
|
|
--------------------------------
|
|
|
|
o32 : constant Boolean := System.Word_Size = 32;
|
|
n32 : constant Boolean := System.Word_Size = 64;
|
|
o32n : constant Natural := Boolean'Pos (o32);
|
|
n32n : constant Natural := Boolean'Pos (n32);
|
|
-- Flags to indicate which ABI is in effect for this compilation. For the
|
|
-- purposes of this unit, the n32 and n64 ABIs are identical.
|
|
|
|
LSC : constant Character := Character'Val (o32n * Character'Pos ('w') +
|
|
n32n * Character'Pos ('d'));
|
|
-- This is 'w' for o32, and 'd' for n32/n64, used for constructing the
|
|
-- load/store instructions used to save/restore machine instructions.
|
|
|
|
Roff : constant Character := Character'Val (o32n * Character'Pos ('4') +
|
|
n32n * Character'Pos ('0'));
|
|
-- Offset from first byte of a __uint64 register save location where
|
|
-- the register value is stored. For n32/64 we store the entire 64
|
|
-- bit register into the uint64. For o32, only 32 bits are stored
|
|
-- at an offset of 4 bytes. This is used as part of expressions with
|
|
-- '+' signs on both sides, so a null offset has to be '0' and not ' '
|
|
-- to avoid assembler syntax errors on "X + + Y" in the latter case.
|
|
|
|
procedure Update_GP (Scp : Sigcontext_Ptr);
|
|
|
|
---------------
|
|
-- Update_GP --
|
|
---------------
|
|
|
|
procedure Update_GP (Scp : Sigcontext_Ptr) is
|
|
|
|
type F_op is mod 2 ** 6;
|
|
type F_reg is mod 2 ** 5;
|
|
type F_imm is new Short_Integer;
|
|
|
|
type I_Type is record
|
|
op : F_op;
|
|
rs : F_reg;
|
|
rt : F_reg;
|
|
imm : F_imm;
|
|
end record;
|
|
|
|
pragma Pack (I_Type);
|
|
for I_Type'Size use 32;
|
|
|
|
type I_Type_Ptr is access all I_Type;
|
|
|
|
LW : constant F_op := 2#100011#;
|
|
Reg_GP : constant := 28;
|
|
|
|
type Address_Int is mod 2 ** Standard'Address_Size;
|
|
function To_I_Type_Ptr is new
|
|
Ada.Unchecked_Conversion (Address_Int, I_Type_Ptr);
|
|
|
|
Ret_Ins : constant I_Type_Ptr := To_I_Type_Ptr (Address_Int (Scp.SC_PC));
|
|
GP_Ptr : Uns32_Ptr;
|
|
|
|
begin
|
|
if Ret_Ins.op = LW and then Ret_Ins.rt = Reg_GP then
|
|
GP_Ptr := To_Uns32_Ptr
|
|
(Addr_Int (Scp.SC_Regs (Integer (Ret_Ins.rs)))
|
|
+ Addr_Int (Ret_Ins.imm));
|
|
Scp.SC_Regs (Reg_GP) := Uns64 (GP_Ptr.all);
|
|
end if;
|
|
end Update_GP;
|
|
|
|
----------------------------
|
|
-- Allocate_Machine_State --
|
|
----------------------------
|
|
|
|
function Allocate_Machine_State return Machine_State is
|
|
begin
|
|
return Machine_State
|
|
(Memory.Alloc (Sigcontext'Max_Size_In_Storage_Elements));
|
|
end Allocate_Machine_State;
|
|
|
|
----------------
|
|
-- Fetch_Code --
|
|
----------------
|
|
|
|
function Fetch_Code (Loc : Code_Loc) return Code_Loc is
|
|
begin
|
|
return Loc;
|
|
end Fetch_Code;
|
|
|
|
------------------------
|
|
-- Free_Machine_State --
|
|
------------------------
|
|
|
|
procedure Free_Machine_State (M : in out Machine_State) is
|
|
begin
|
|
Memory.Free (Address (M));
|
|
M := Machine_State (Null_Address);
|
|
end Free_Machine_State;
|
|
|
|
------------------
|
|
-- Get_Code_Loc --
|
|
------------------
|
|
|
|
function Get_Code_Loc (M : Machine_State) return Code_Loc is
|
|
SC : constant Sigcontext_Ptr := To_Sigcontext_Ptr (M);
|
|
begin
|
|
return To_Code_Loc (Addr_Int (SC.SC_PC));
|
|
end Get_Code_Loc;
|
|
|
|
--------------------------
|
|
-- Machine_State_Length --
|
|
--------------------------
|
|
|
|
function Machine_State_Length return Storage_Offset is
|
|
begin
|
|
return Sigcontext'Max_Size_In_Storage_Elements;
|
|
end Machine_State_Length;
|
|
|
|
---------------
|
|
-- Pop_Frame --
|
|
---------------
|
|
|
|
procedure Pop_Frame (M : Machine_State) is
|
|
Scp : constant Sigcontext_Ptr := To_Sigcontext_Ptr (M);
|
|
|
|
procedure Exc_Unwind (Scp : Sigcontext_Ptr; Fde : Long_Integer := 0);
|
|
pragma Import (C, Exc_Unwind, "exc_unwind");
|
|
|
|
pragma Linker_Options ("-lexc");
|
|
|
|
begin
|
|
-- exc_unwind is apparently not thread-safe under IRIX, so protect it
|
|
-- against race conditions within the GNAT run time.
|
|
-- ??? Note that we might want to use a fine grained lock here since
|
|
-- Lock_Task is used in many other places.
|
|
|
|
Lock_Task.all;
|
|
|
|
Exc_Unwind (Scp);
|
|
|
|
Unlock_Task.all;
|
|
|
|
if Scp.SC_PC = 0 or else Scp.SC_PC = 1 then
|
|
|
|
-- A return value of 0 or 1 means exc_unwind couldn't find a parent
|
|
-- frame. Propagate_Exception expects a zero return address to
|
|
-- indicate TOS.
|
|
|
|
Scp.SC_PC := 0;
|
|
|
|
else
|
|
-- Set the GP to restore to the caller value (not callee value)
|
|
-- This is done only in o32 mode. In n32/n64 mode, GP is a normal
|
|
-- callee save register
|
|
|
|
if o32 then
|
|
Update_GP (Scp);
|
|
end if;
|
|
|
|
-- Adjust the return address to the call site, not the
|
|
-- instruction following the branch delay slot. This may
|
|
-- be necessary if the last instruction of a pragma No_Return
|
|
-- subprogram is a call. The first instruction following the
|
|
-- delay slot may be the start of another subprogram. We back
|
|
-- off the address by 8, which points safely into the middle
|
|
-- of the generated subprogram code, avoiding end effects.
|
|
|
|
Scp.SC_PC := Scp.SC_PC - 8;
|
|
end if;
|
|
end Pop_Frame;
|
|
|
|
-----------------------
|
|
-- Set_Machine_State --
|
|
-----------------------
|
|
|
|
procedure Set_Machine_State (M : Machine_State) is
|
|
|
|
SI : constant String (1 .. 2) := 's' & LSC;
|
|
-- This is "sw" in o32 mode, and "sd" in n32 mode
|
|
|
|
SF : constant String (1 .. 4) := 's' & LSC & "c1";
|
|
-- This is "swc1" in o32 mode and "sdc1" in n32 mode
|
|
|
|
PI : String renames SC_Regs_Pos;
|
|
PF : String renames SC_Fpregs_Pos;
|
|
|
|
Scp : Sigcontext_Ptr;
|
|
|
|
begin
|
|
-- Save the integer registers. Note that we know that $4 points
|
|
-- to M, since that is where the first parameter is passed.
|
|
-- Restore integer registers from machine state. Note that we know
|
|
-- that $4 points to M since this is the standard calling sequence
|
|
|
|
<<Past_Prolog>>
|
|
|
|
Asm (SI & " $16, 16*8+" & Roff & "+" & PI & "($4)", Volatile => True);
|
|
Asm (SI & " $17, 17*8+" & Roff & "+" & PI & "($4)", Volatile => True);
|
|
Asm (SI & " $18, 18*8+" & Roff & "+" & PI & "($4)", Volatile => True);
|
|
Asm (SI & " $19, 19*8+" & Roff & "+" & PI & "($4)", Volatile => True);
|
|
Asm (SI & " $20, 20*8+" & Roff & "+" & PI & "($4)", Volatile => True);
|
|
Asm (SI & " $21, 21*8+" & Roff & "+" & PI & "($4)", Volatile => True);
|
|
Asm (SI & " $22, 22*8+" & Roff & "+" & PI & "($4)", Volatile => True);
|
|
Asm (SI & " $23, 23*8+" & Roff & "+" & PI & "($4)", Volatile => True);
|
|
Asm (SI & " $24, 24*8+" & Roff & "+" & PI & "($4)", Volatile => True);
|
|
Asm (SI & " $25, 25*8+" & Roff & "+" & PI & "($4)", Volatile => True);
|
|
Asm (SI & " $26, 26*8+" & Roff & "+" & PI & "($4)", Volatile => True);
|
|
Asm (SI & " $27, 27*8+" & Roff & "+" & PI & "($4)", Volatile => True);
|
|
Asm (SI & " $28, 28*8+" & Roff & "+" & PI & "($4)", Volatile => True);
|
|
Asm (SI & " $29, 29*8+" & Roff & "+" & PI & "($4)", Volatile => True);
|
|
Asm (SI & " $30, 30*8+" & Roff & "+" & PI & "($4)", Volatile => True);
|
|
Asm (SI & " $31, 31*8+" & Roff & "+" & PI & "($4)", Volatile => True);
|
|
|
|
-- Restore floating-point registers from machine state
|
|
|
|
Asm (SF & " $f16, 16*8+" & Roff & "+" & PF & "($4)", Volatile => True);
|
|
Asm (SF & " $f17, 17*8+" & Roff & "+" & PF & "($4)", Volatile => True);
|
|
Asm (SF & " $f18, 18*8+" & Roff & "+" & PF & "($4)", Volatile => True);
|
|
Asm (SF & " $f19, 19*8+" & Roff & "+" & PF & "($4)", Volatile => True);
|
|
Asm (SF & " $f20, 20*8+" & Roff & "+" & PF & "($4)", Volatile => True);
|
|
Asm (SF & " $f21, 21*8+" & Roff & "+" & PF & "($4)", Volatile => True);
|
|
Asm (SF & " $f22, 22*8+" & Roff & "+" & PF & "($4)", Volatile => True);
|
|
Asm (SF & " $f23, 23*8+" & Roff & "+" & PF & "($4)", Volatile => True);
|
|
Asm (SF & " $f24, 24*8+" & Roff & "+" & PF & "($4)", Volatile => True);
|
|
Asm (SF & " $f25, 25*8+" & Roff & "+" & PF & "($4)", Volatile => True);
|
|
Asm (SF & " $f26, 26*8+" & Roff & "+" & PF & "($4)", Volatile => True);
|
|
Asm (SF & " $f27, 27*8+" & Roff & "+" & PF & "($4)", Volatile => True);
|
|
Asm (SF & " $f28, 28*8+" & Roff & "+" & PF & "($4)", Volatile => True);
|
|
Asm (SF & " $f29, 29*8+" & Roff & "+" & PF & "($4)", Volatile => True);
|
|
Asm (SF & " $f30, 30*8+" & Roff & "+" & PF & "($4)", Volatile => True);
|
|
Asm (SF & " $f31, 31*8+" & Roff & "+" & PF & "($4)", Volatile => True);
|
|
|
|
-- Set the PC value for the context to a location after the
|
|
-- prolog has been executed.
|
|
|
|
Scp := To_Sigcontext_Ptr (M);
|
|
Scp.SC_PC := Uns64 (To_Addr_Int (Past_Prolog'Address));
|
|
|
|
-- We saved the state *inside* this routine, but what we want is
|
|
-- the state at the call site. So we need to do one pop operation.
|
|
-- This pop operation will properly set the PC value in the machine
|
|
-- state, so there is no need to save PC in the above code.
|
|
|
|
Pop_Frame (M);
|
|
end Set_Machine_State;
|
|
|
|
end System.Machine_State_Operations;
|