+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT COMPILER COMPONENTS --
--- --
--- SYSTEM.MACHINE_STATE_OPERATIONS --
--- --
--- B o d y --
--- (Version for IRIX/MIPS) --
--- --
--- $Revision: 1.2.10.1 $
--- --
--- Copyright (C) 1999-2001 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 2, 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. See the GNU General Public License --
--- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
--- --
--- As a special exception, if other files instantiate generics from this --
--- unit, or you link this unit with other files to produce an executable, --
--- this unit does not by itself cause the resulting executable to be --
--- covered by the GNU General Public License. This exception does not --
--- however invalidate any other reasons why the executable file might be --
--- covered by the GNU Public License. --
--- --
--- 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 Unchecked_Conversion;
-
-package body System.Machine_State_Operations is
-
- use System.Storage_Elements;
- use System.Exceptions;
-
- -- The exc_unwind function in libexc operats 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 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 Unchecked_Conversion (Addr_Int, Code_Loc);
- function To_Addr_Int is new Unchecked_Conversion (System.Address, Addr_Int);
- function To_Uns32_Ptr is new Unchecked_Conversion (Addr_Int, Uns32_Ptr);
-
- --------------------------------
- -- ABI-Dependent Declarations --
- --------------------------------
-
- o32 : constant Natural := Boolean'Pos (System.Word_Size = 32);
- n32 : constant Natural := Boolean'Pos (System.Word_Size = 64);
- -- Flags to indicate which ABI is in effect for this compilation. For the
- -- purposes of this unit, the n32 and n64 ABI's are identical.
-
- LSC : constant Character := Character'Val (o32 * Character'Pos ('w') +
- n32 * 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 (o32 * Character'Pos ('4') +
- n32 * Character'Pos (' '));
- -- 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.
-
- 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
- Unchecked_Conversion (Address_Int, I_Type_Ptr);
-
- Ret_Ins : 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;
-
- -------------------
- -- Enter_Handler --
- -------------------
-
- procedure Enter_Handler (M : Machine_State; Handler : Handler_Loc) is
-
- LOADI : constant String (1 .. 2) := 'l' & LSC;
- -- This is "lw" in o32 mode, and "ld" in n32/n64 mode
-
- LOADF : constant String (1 .. 4) := 'l' & LSC & "c1";
- -- This is "lwc1" in o32 mode and "ldc1" in n32/n64 mode
-
- begin
- -- Restore integer registers from machine state. Note that we know
- -- that $4 points to M, and $5 points to Handler, since this is
- -- the standard calling sequence
-
- Asm (LOADI & " $16, 16*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (LOADI & " $17, 17*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (LOADI & " $18, 18*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (LOADI & " $19, 19*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (LOADI & " $20, 20*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (LOADI & " $21, 21*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (LOADI & " $22, 22*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (LOADI & " $23, 23*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (LOADI & " $24, 24*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (LOADI & " $25, 25*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (LOADI & " $26, 26*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (LOADI & " $27, 27*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (LOADI & " $28, 28*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (LOADI & " $29, 29*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (LOADI & " $30, 30*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (LOADI & " $31, 31*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-
- -- Restore floating-point registers from machine state
-
- Asm (LOADF & " $f16, 16*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (LOADF & " $f17, 17*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (LOADF & " $f18, 18*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (LOADF & " $f19, 19*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (LOADF & " $f20, 20*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (LOADF & " $f21, 21*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (LOADF & " $f22, 22*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (LOADF & " $f23, 23*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (LOADF & " $f24, 24*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (LOADF & " $f25, 25*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (LOADF & " $f26, 26*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (LOADF & " $f27, 27*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (LOADF & " $f28, 28*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (LOADF & " $f29, 29*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (LOADF & " $f30, 30*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (LOADF & " $f31, 31*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-
- -- Jump directly to the handler
-
- Asm ("jr $5");
- end Enter_Handler;
-
- ----------------
- -- 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
- procedure Gnat_Free (M : in Machine_State);
- pragma Import (C, Gnat_Free, "__gnat_free");
-
- begin
- Gnat_Free (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;
- Info : Subprogram_Info_Type)
- is
- Scp : 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 = 1 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
-
- STOREI : constant String (1 .. 2) := 's' & LSC;
- -- This is "sw" in o32 mode, and "sd" in n32 mode
-
- STOREF : constant String (1 .. 4) := 's' & LSC & "c1";
- -- This is "swc1" in o32 mode and "sdc1" in n32 mode
-
- 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 (STOREI & " $16, 16*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (STOREI & " $17, 17*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (STOREI & " $18, 18*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (STOREI & " $19, 19*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (STOREI & " $20, 20*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (STOREI & " $21, 21*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (STOREI & " $22, 22*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (STOREI & " $23, 23*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (STOREI & " $24, 24*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (STOREI & " $25, 25*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (STOREI & " $26, 26*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (STOREI & " $27, 27*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (STOREI & " $28, 28*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (STOREI & " $29, 29*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (STOREI & " $30, 30*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- Asm (STOREI & " $31, 31*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-
- -- Restore floating-point registers from machine state
-
- Asm (STOREF & " $f16, 16*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (STOREF & " $f17, 17*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (STOREF & " $f18, 18*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (STOREF & " $f19, 19*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (STOREF & " $f20, 20*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (STOREF & " $f21, 21*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (STOREF & " $f22, 22*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (STOREF & " $f23, 23*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (STOREF & " $f24, 24*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (STOREF & " $f25, 25*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (STOREF & " $f26, 26*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (STOREF & " $f27, 27*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (STOREF & " $f28, 28*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (STOREF & " $f29, 29*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (STOREF & " $f30, 30*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- Asm (STOREF & " $f31, 31*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-
- -- 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, Set_Machine_State'Address);
- end Set_Machine_State;
-
- ------------------------------
- -- Set_Signal_Machine_State --
- ------------------------------
-
- procedure Set_Signal_Machine_State
- (M : Machine_State;
- Context : System.Address) is
- begin
- null;
- end Set_Signal_Machine_State;
-
-end System.Machine_State_Operations;
projects / msp430-gcc.git / blobdiff