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