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