gcc/ada/s-mastop-irix.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                     SYSTEM.MACHINE_STATE_OPERATIONS                      --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                         (Version for IRIX/MIPS)                          --
   9 --                                                                          --
  10 --          Copyright (C) 1999-2009, Free Software Foundation, Inc.         --
  11 --                                                                          --
  12 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  13 -- terms of the  GNU General Public License as published  by the Free Soft- --
  14 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  15 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  16 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  17 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  18 --                                                                          --
  19 -- As a special exception under Section 7 of GPL version 3, you are granted --
  20 -- additional permissions described in the GCC Runtime Library Exception,   --
  21 -- version 3.1, as published by the Free Software Foundation.               --
  22 --                                                                          --
  23 -- You should have received a copy of the GNU General Public License and    --
  24 -- a copy of the GCC Runtime Library Exception along with this program;     --
  25 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  26 -- <http://www.gnu.org/licenses/>.                                          --
  27 --                                                                          --
  28 -- GNAT was originally developed  by the GNAT team at  New York University. --
  29 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  30 --                                                                          --
  31 ------------------------------------------------------------------------------
  32
  33 --  This version of Ada.Exceptions.Machine_State_Operations is for use on
  34 --  SGI Irix systems. By means of compile time conditional calculations, it
  35 --  can handle both n32/n64 and o32 modes.
  36
  37 with System.Machine_Code; use System.Machine_Code;
  38 with System.Memory;
  39 with System.Soft_Links; use System.Soft_Links;
  40 with Ada.Unchecked_Conversion;
  41
  42 package body System.Machine_State_Operations is
  43
  44    use System.Storage_Elements;
  45
  46    --  The exc_unwind function in libexc operates on a Sigcontext
  47
  48    --  Type sigcontext_t is defined in /usr/include/sys/signal.h.
  49    --  We define an equivalent Ada type here. From the comments in
  50    --  signal.h:
  51
  52    --    sigcontext is not part of the ABI - so this version is used to
  53    --    handle 32 and 64 bit applications - it is a constant size regardless
  54    --    of compilation mode, and always returns 64 bit register values
  55
  56    type Uns32 is mod 2 ** 32;
  57    type Uns64 is mod 2 ** 64;
  58
  59    type Uns32_Ptr is access all Uns32;
  60    type Uns64_Array is array (Integer range <>) of Uns64;
  61
  62    type Reg_Array is array (0 .. 31) of Uns64;
  63
  64    type Sigcontext is record
  65       SC_Regmask           : Uns32;          --  0
  66       SC_Status            : Uns32;          --  4
  67       SC_PC                : Uns64;          --  8
  68       SC_Regs              : Reg_Array;      --  16
  69       SC_Fpregs            : Reg_Array;      --  272
  70       SC_Ownedfp           : Uns32;          --  528
  71       SC_Fpc_Csr           : Uns32;          --  532
  72       SC_Fpc_Eir           : Uns32;          --  536
  73       SC_Ssflags           : Uns32;          --  540
  74       SC_Mdhi              : Uns64;          --  544
  75       SC_Mdlo              : Uns64;          --  552
  76       SC_Cause             : Uns64;          --  560
  77       SC_Badvaddr          : Uns64;          --  568
  78       SC_Triggersave       : Uns64;          --  576
  79       SC_Sigset            : Uns64;          --  584
  80       SC_Fp_Rounded_Result : Uns64;          --  592
  81       SC_Pancake           : Uns64_Array (0 .. 5);
  82       SC_Pad               : Uns64_Array (0 .. 26);
  83    end record;
  84
  85    type Sigcontext_Ptr is access all Sigcontext;
  86
  87    SC_Regs_Pos   : constant String := "16";
  88    SC_Fpregs_Pos : constant String := "272";
  89    --  Byte offset of the Integer and Floating Point register save areas
  90    --  within the Sigcontext.
  91
  92    function To_Sigcontext_Ptr is
  93      new Ada.Unchecked_Conversion (Machine_State, Sigcontext_Ptr);
  94
  95    type Addr_Int is mod 2 ** Long_Integer'Size;
  96    --  An unsigned integer type whose size is the same as System.Address.
  97    --  We rely on the fact that Long_Integer'Size = System.Address'Size in
  98    --  all ABIs.  Type Addr_Int can be converted to Uns64.
  99
 100    function To_Code_Loc is
 101      new Ada.Unchecked_Conversion (Addr_Int, Code_Loc);
 102    function To_Addr_Int is
 103      new Ada.Unchecked_Conversion (System.Address, Addr_Int);
 104    function To_Uns32_Ptr is
 105      new Ada.Unchecked_Conversion (Addr_Int, Uns32_Ptr);
 106
 107    --------------------------------
 108    -- ABI-Dependent Declarations --
 109    --------------------------------
 110
 111    o32  : constant Boolean := System.Word_Size = 32;
 112    n32  : constant Boolean := System.Word_Size = 64;
 113    o32n : constant Natural := Boolean'Pos (o32);
 114    n32n : constant Natural := Boolean'Pos (n32);
 115    --  Flags to indicate which ABI is in effect for this compilation. For the
 116    --  purposes of this unit, the n32 and n64 ABIs are identical.
 117
 118    LSC : constant Character := Character'Val (o32n * Character'Pos ('w') +
 119                                               n32n * Character'Pos ('d'));
 120    --  This is 'w' for o32, and 'd' for n32/n64, used for constructing the
 121    --  load/store instructions used to save/restore machine instructions.
 122
 123    Roff : constant Character := Character'Val (o32n * Character'Pos ('4') +
 124                                                n32n * Character'Pos ('0'));
 125    --  Offset from first byte of a __uint64 register save location where
 126    --  the register value is stored.  For n32/64 we store the entire 64
 127    --  bit register into the uint64.  For o32, only 32 bits are stored
 128    --  at an offset of 4 bytes. This is used as part of expressions with
 129    --  '+' signs on both sides, so a null offset has to be '0' and not ' '
 130    --  to avoid assembler syntax errors on "X + + Y" in the latter case.
 131
 132    procedure Update_GP (Scp : Sigcontext_Ptr);
 133
 134    ---------------
 135    -- Update_GP --
 136    ---------------
 137
 138    procedure Update_GP (Scp : Sigcontext_Ptr) is
 139
 140       type F_op  is mod 2 ** 6;
 141       type F_reg is mod 2 ** 5;
 142       type F_imm is new Short_Integer;
 143
 144       type I_Type is record
 145          op    : F_op;
 146          rs    : F_reg;
 147          rt    : F_reg;
 148          imm   : F_imm;
 149       end record;
 150
 151       pragma Pack (I_Type);
 152       for I_Type'Size use 32;
 153
 154       type I_Type_Ptr is access all I_Type;
 155
 156       LW : constant F_op := 2#100011#;
 157       Reg_GP : constant := 28;
 158
 159       type Address_Int is mod 2 ** Standard'Address_Size;
 160       function To_I_Type_Ptr is new
 161         Ada.Unchecked_Conversion (Address_Int, I_Type_Ptr);
 162
 163       Ret_Ins : constant I_Type_Ptr := To_I_Type_Ptr (Address_Int (Scp.SC_PC));
 164       GP_Ptr  : Uns32_Ptr;
 165
 166    begin
 167       if Ret_Ins.op = LW and then Ret_Ins.rt = Reg_GP then
 168          GP_Ptr := To_Uns32_Ptr
 169            (Addr_Int (Scp.SC_Regs (Integer (Ret_Ins.rs)))
 170             + Addr_Int (Ret_Ins.imm));
 171          Scp.SC_Regs (Reg_GP) := Uns64 (GP_Ptr.all);
 172       end if;
 173    end Update_GP;
 174
 175    ----------------------------
 176    -- Allocate_Machine_State --
 177    ----------------------------
 178
 179    function Allocate_Machine_State return Machine_State is
 180    begin
 181       return Machine_State
 182         (Memory.Alloc (Sigcontext'Max_Size_In_Storage_Elements));
 183    end Allocate_Machine_State;
 184
 185    ----------------
 186    -- Fetch_Code --
 187    ----------------
 188
 189    function Fetch_Code (Loc : Code_Loc) return Code_Loc is
 190    begin
 191       return Loc;
 192    end Fetch_Code;
 193
 194    ------------------------
 195    -- Free_Machine_State --
 196    ------------------------
 197
 198    procedure Free_Machine_State (M : in out Machine_State) is
 199    begin
 200       Memory.Free (Address (M));
 201       M := Machine_State (Null_Address);
 202    end Free_Machine_State;
 203
 204    ------------------
 205    -- Get_Code_Loc --
 206    ------------------
 207
 208    function Get_Code_Loc (M : Machine_State) return Code_Loc is
 209       SC : constant Sigcontext_Ptr := To_Sigcontext_Ptr (M);
 210    begin
 211       return To_Code_Loc (Addr_Int (SC.SC_PC));
 212    end Get_Code_Loc;
 213
 214    --------------------------
 215    -- Machine_State_Length --
 216    --------------------------
 217
 218    function Machine_State_Length return Storage_Offset is
 219    begin
 220       return Sigcontext'Max_Size_In_Storage_Elements;
 221    end Machine_State_Length;
 222
 223    ---------------
 224    -- Pop_Frame --
 225    ---------------
 226
 227    procedure Pop_Frame (M : Machine_State) is
 228       Scp : constant Sigcontext_Ptr := To_Sigcontext_Ptr (M);
 229
 230       procedure Exc_Unwind (Scp : Sigcontext_Ptr; Fde : Long_Integer := 0);
 231       pragma Import (C, Exc_Unwind, "exc_unwind");
 232
 233       pragma Linker_Options ("-lexc");
 234
 235    begin
 236       --  exc_unwind is apparently not thread-safe under IRIX, so protect it
 237       --  against race conditions within the GNAT run time.
 238       --  ??? Note that we might want to use a fine grained lock here since
 239       --  Lock_Task is used in many other places.
 240
 241       Lock_Task.all;
 242
 243       Exc_Unwind (Scp);
 244
 245       Unlock_Task.all;
 246
 247       if Scp.SC_PC = 0 or else Scp.SC_PC = 1 then
 248
 249          --  A return value of 0 or 1 means exc_unwind couldn't find a parent
 250          --  frame. Propagate_Exception expects a zero return address to
 251          --  indicate TOS.
 252
 253          Scp.SC_PC := 0;
 254
 255       else
 256          --  Set the GP to restore to the caller value (not callee value)
 257          --  This is done only in o32 mode. In n32/n64 mode, GP is a normal
 258          --  callee save register
 259
 260          if o32 then
 261             Update_GP (Scp);
 262          end if;
 263
 264          --  Adjust the return address to the call site, not the
 265          --  instruction following the branch delay slot.  This may
 266          --  be necessary if the last instruction of a pragma No_Return
 267          --  subprogram is a call. The first instruction following the
 268          --  delay slot may be the start of another subprogram. We back
 269          --  off the address by 8, which points safely into the middle
 270          --  of the generated subprogram code, avoiding end effects.
 271
 272          Scp.SC_PC := Scp.SC_PC - 8;
 273       end if;
 274    end Pop_Frame;
 275
 276    -----------------------
 277    -- Set_Machine_State --
 278    -----------------------
 279
 280    procedure Set_Machine_State (M : Machine_State) is
 281
 282       SI : constant String (1 .. 2) := 's' & LSC;
 283       --  This is "sw" in o32 mode, and "sd" in n32 mode
 284
 285       SF : constant String (1 .. 4) := 's' & LSC & "c1";
 286       --  This is "swc1" in o32 mode and "sdc1" in n32 mode
 287
 288       PI : String renames SC_Regs_Pos;
 289       PF : String renames SC_Fpregs_Pos;
 290
 291       Scp : Sigcontext_Ptr;
 292
 293    begin
 294       --  Save the integer registers. Note that we know that $4 points
 295       --  to M, since that is where the first parameter is passed.
 296       --  Restore integer registers from machine state. Note that we know
 297       --  that $4 points to M since this is the standard calling sequence
 298
 299       <<Past_Prolog>>
 300
 301       Asm (SI & " $16,  16*8+" & Roff & "+" & PI & "($4)", Volatile => True);
 302       Asm (SI & " $17,  17*8+" & Roff & "+" & PI & "($4)", Volatile => True);
 303       Asm (SI & " $18,  18*8+" & Roff & "+" & PI & "($4)", Volatile => True);
 304       Asm (SI & " $19,  19*8+" & Roff & "+" & PI & "($4)", Volatile => True);
 305       Asm (SI & " $20,  20*8+" & Roff & "+" & PI & "($4)", Volatile => True);
 306       Asm (SI & " $21,  21*8+" & Roff & "+" & PI & "($4)", Volatile => True);
 307       Asm (SI & " $22,  22*8+" & Roff & "+" & PI & "($4)", Volatile => True);
 308       Asm (SI & " $23,  23*8+" & Roff & "+" & PI & "($4)", Volatile => True);
 309       Asm (SI & " $24,  24*8+" & Roff & "+" & PI & "($4)", Volatile => True);
 310       Asm (SI & " $25,  25*8+" & Roff & "+" & PI & "($4)", Volatile => True);
 311       Asm (SI & " $26,  26*8+" & Roff & "+" & PI & "($4)", Volatile => True);
 312       Asm (SI & " $27,  27*8+" & Roff & "+" & PI & "($4)", Volatile => True);
 313       Asm (SI & " $28,  28*8+" & Roff & "+" & PI & "($4)", Volatile => True);
 314       Asm (SI & " $29,  29*8+" & Roff & "+" & PI & "($4)", Volatile => True);
 315       Asm (SI & " $30,  30*8+" & Roff & "+" & PI & "($4)", Volatile => True);
 316       Asm (SI & " $31,  31*8+" & Roff & "+" & PI & "($4)", Volatile => True);
 317
 318       --  Restore floating-point registers from machine state
 319
 320       Asm (SF & " $f16, 16*8+" & Roff & "+" & PF & "($4)", Volatile => True);
 321       Asm (SF & " $f17, 17*8+" & Roff & "+" & PF & "($4)", Volatile => True);
 322       Asm (SF & " $f18, 18*8+" & Roff & "+" & PF & "($4)", Volatile => True);
 323       Asm (SF & " $f19, 19*8+" & Roff & "+" & PF & "($4)", Volatile => True);
 324       Asm (SF & " $f20, 20*8+" & Roff & "+" & PF & "($4)", Volatile => True);
 325       Asm (SF & " $f21, 21*8+" & Roff & "+" & PF & "($4)", Volatile => True);
 326       Asm (SF & " $f22, 22*8+" & Roff & "+" & PF & "($4)", Volatile => True);
 327       Asm (SF & " $f23, 23*8+" & Roff & "+" & PF & "($4)", Volatile => True);
 328       Asm (SF & " $f24, 24*8+" & Roff & "+" & PF & "($4)", Volatile => True);
 329       Asm (SF & " $f25, 25*8+" & Roff & "+" & PF & "($4)", Volatile => True);
 330       Asm (SF & " $f26, 26*8+" & Roff & "+" & PF & "($4)", Volatile => True);
 331       Asm (SF & " $f27, 27*8+" & Roff & "+" & PF & "($4)", Volatile => True);
 332       Asm (SF & " $f28, 28*8+" & Roff & "+" & PF & "($4)", Volatile => True);
 333       Asm (SF & " $f29, 29*8+" & Roff & "+" & PF & "($4)", Volatile => True);
 334       Asm (SF & " $f30, 30*8+" & Roff & "+" & PF & "($4)", Volatile => True);
 335       Asm (SF & " $f31, 31*8+" & Roff & "+" & PF & "($4)", Volatile => True);
 336
 337       --  Set the PC value for the context to a location after the
 338       --  prolog has been executed.
 339
 340       Scp := To_Sigcontext_Ptr (M);
 341       Scp.SC_PC := Uns64 (To_Addr_Int (Past_Prolog'Address));
 342
 343       --  We saved the state *inside* this routine, but what we want is
 344       --  the state at the call site. So we need to do one pop operation.
 345       --  This pop operation will properly set the PC value in the machine
 346       --  state, so there is no need to save PC in the above code.
 347
 348       Pop_Frame (M);
 349    end Set_Machine_State;
 350
 351 end System.Machine_State_Operations;