diff options
Diffstat (limited to 'gcc/ada/s-mastop-irix.adb')
| -rw-r--r-- | gcc/ada/s-mastop-irix.adb | 444 |
1 files changed, 444 insertions, 0 deletions
diff --git a/gcc/ada/s-mastop-irix.adb b/gcc/ada/s-mastop-irix.adb new file mode 100644 index 00000000000..6c85ce54f1a --- /dev/null +++ b/gcc/ada/s-mastop-irix.adb @@ -0,0 +1,444 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- SYSTEM.MACHINE_STATE_OPERATIONS -- +-- -- +-- B o d y -- +-- (Version for IRIX/MIPS) -- +-- -- +-- Copyright (C) 1999-2004 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 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 ABI's 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. + + 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 : 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; + + ------------------- + -- Enter_Handler -- + ------------------- + + procedure Enter_Handler (M : Machine_State; Handler : Handler_Loc) is + pragma Warnings (Off, M); + pragma Warnings (Off, Handler); + + 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 + 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; + Info : Subprogram_Info_Type) + is + pragma Warnings (Off, Info); + + 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"); + + -- ??? Calling exc_unwind in the current setup does not work and + -- triggers the emission of system warning messages. Why it does + -- not work remains to be investigated. Part of the problem is + -- probably a section naming issue (e.g. .eh_frame/.debug_frame). + + -- Instead of letting the call take place for nothing and emit + -- messages we don't expect, we just arrange things to pretend it + -- occurred and failed. + + -- ??? Until this is fixed, we shall document that the backtrace + -- computation facility does not work, and we inhibit the pragma below + -- because we arrange for the call not to be emitted and the linker + -- complains when a library is linked in but resolves nothing. + + -- 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; + + if False then + Exc_Unwind (Scp); + else + Scp.SC_PC := 0; + end if; + + 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 + + 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 + pragma Warnings (Off, M); + pragma Warnings (Off, Context); + + begin + null; + end Set_Signal_Machine_State; + +end System.Machine_State_Operations; |