1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- SYSTEM.MACHINE_STATE_OPERATIONS --
8 -- (Version for IRIX/MIPS) --
10 -- Copyright (C) 1999-2004 Free Software Foundation, Inc. --
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. --
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. --
30 -- GNAT was originally developed by the GNAT team at New York University. --
31 -- Extensive contributions were provided by Ada Core Technologies Inc. --
33 ------------------------------------------------------------------------------
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.
39 with System.Machine_Code; use System.Machine_Code;
41 with System.Soft_Links; use System.Soft_Links;
42 with Unchecked_Conversion;
44 package body System.Machine_State_Operations is
46 use System.Storage_Elements;
47 use System.Exceptions;
49 -- The exc_unwind function in libexc operats on a Sigcontext
51 -- Type sigcontext_t is defined in /usr/include/sys/signal.h.
52 -- We define an equivalent Ada type here. From the comments in
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
59 type Uns32 is mod 2 ** 32;
60 type Uns64 is mod 2 ** 64;
62 type Uns32_Ptr is access all Uns32;
63 type Uns64_Array is array (Integer range <>) of Uns64;
65 type Reg_Array is array (0 .. 31) of Uns64;
67 type Sigcontext is record
68 SC_Regmask : Uns32; -- 0
69 SC_Status : Uns32; -- 4
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);
88 type Sigcontext_Ptr is access all Sigcontext;
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.
95 function To_Sigcontext_Ptr is
96 new Unchecked_Conversion (Machine_State, Sigcontext_Ptr);
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.
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);
107 --------------------------------
108 -- ABI-Dependent Declarations --
109 --------------------------------
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.
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.
123 Roff : constant Character := Character'Val (o32n * Character'Pos ('4') +
124 n32n * Character'Pos (' '));
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.
130 procedure Update_GP (Scp : Sigcontext_Ptr);
136 procedure Update_GP (Scp : Sigcontext_Ptr) is
138 type F_op is mod 2 ** 6;
139 type F_reg is mod 2 ** 5;
140 type F_imm is new Short_Integer;
142 type I_Type is record
149 pragma Pack (I_Type);
150 for I_Type'Size use 32;
152 type I_Type_Ptr is access all I_Type;
154 LW : constant F_op := 2#100011#;
155 Reg_GP : constant := 28;
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);
161 Ret_Ins : constant I_Type_Ptr := To_I_Type_Ptr (Address_Int (Scp.SC_PC));
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);
173 ----------------------------
174 -- Allocate_Machine_State --
175 ----------------------------
177 function Allocate_Machine_State return Machine_State is
180 (Memory.Alloc (Sigcontext'Max_Size_In_Storage_Elements));
181 end Allocate_Machine_State;
187 procedure Enter_Handler (M : Machine_State; Handler : Handler_Loc) is
188 pragma Warnings (Off, M);
189 pragma Warnings (Off, Handler);
191 LOADI : constant String (1 .. 2) := 'l' & LSC;
192 -- This is "lw" in o32 mode, and "ld" in n32/n64 mode
194 LOADF : constant String (1 .. 4) := 'l' & LSC & "c1";
195 -- This is "lwc1" in o32 mode and "ldc1" in n32/n64 mode
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
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)");
219 -- Restore floating-point registers from machine state
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)");
238 -- Jump directly to the handler
247 function Fetch_Code (Loc : Code_Loc) return Code_Loc is
252 ------------------------
253 -- Free_Machine_State --
254 ------------------------
256 procedure Free_Machine_State (M : in out Machine_State) is
258 Memory.Free (Address (M));
259 M := Machine_State (Null_Address);
260 end Free_Machine_State;
266 function Get_Code_Loc (M : Machine_State) return Code_Loc is
267 SC : constant Sigcontext_Ptr := To_Sigcontext_Ptr (M);
269 return To_Code_Loc (Addr_Int (SC.SC_PC));
272 --------------------------
273 -- Machine_State_Length --
274 --------------------------
276 function Machine_State_Length return Storage_Offset is
278 return Sigcontext'Max_Size_In_Storage_Elements;
279 end Machine_State_Length;
287 Info : Subprogram_Info_Type)
289 pragma Warnings (Off, Info);
291 Scp : Sigcontext_Ptr := To_Sigcontext_Ptr (M);
293 procedure Exc_Unwind (Scp : Sigcontext_Ptr; Fde : Long_Integer := 0);
294 pragma Import (C, Exc_Unwind, "exc_unwind");
295 pragma Linker_Options ("-lexc");
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.
305 -- ??? Calling exc_unwind in the current setup does not work and
306 -- triggers the emission of system warning messages. Why it does
307 -- not work remains to be investigated. Part of the problem is
308 -- probably a section naming issue (e.g. .eh_frame/.debug_frame).
310 -- Instead of letting the call take place for nothing and emit
311 -- messages we don't expect, we just arrange things to pretend it
312 -- occurred and failed.
314 -- ??? Until this is fixed, we shall document that the backtrace
315 -- computation facility does not work.
325 if Scp.SC_PC = 0 or else Scp.SC_PC = 1 then
327 -- A return value of 0 or 1 means exc_unwind couldn't find a parent
328 -- frame. Propagate_Exception expects a zero return address to
334 -- Set the GP to restore to the caller value (not callee value)
335 -- This is done only in o32 mode. In n32/n64 mode, GP is a normal
336 -- callee save register
342 -- Adjust the return address to the call site, not the
343 -- instruction following the branch delay slot. This may
344 -- be necessary if the last instruction of a pragma No_Return
345 -- subprogram is a call. The first instruction following the
346 -- delay slot may be the start of another subprogram. We back
347 -- off the address by 8, which points safely into the middle
348 -- of the generated subprogram code, avoiding end effects.
350 Scp.SC_PC := Scp.SC_PC - 8;
354 -----------------------
355 -- Set_Machine_State --
356 -----------------------
358 procedure Set_Machine_State (M : Machine_State) is
360 STOREI : constant String (1 .. 2) := 's' & LSC;
361 -- This is "sw" in o32 mode, and "sd" in n32 mode
363 STOREF : constant String (1 .. 4) := 's' & LSC & "c1";
364 -- This is "swc1" in o32 mode and "sdc1" in n32 mode
366 Scp : Sigcontext_Ptr;
369 -- Save the integer registers. Note that we know that $4 points
370 -- to M, since that is where the first parameter is passed.
371 -- Restore integer registers from machine state. Note that we know
372 -- that $4 points to M since this is the standard calling sequence
376 Asm (STOREI & " $16, 16*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
377 Asm (STOREI & " $17, 17*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
378 Asm (STOREI & " $18, 18*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
379 Asm (STOREI & " $19, 19*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
380 Asm (STOREI & " $20, 20*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
381 Asm (STOREI & " $21, 21*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
382 Asm (STOREI & " $22, 22*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
383 Asm (STOREI & " $23, 23*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
384 Asm (STOREI & " $24, 24*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
385 Asm (STOREI & " $25, 25*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
386 Asm (STOREI & " $26, 26*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
387 Asm (STOREI & " $27, 27*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
388 Asm (STOREI & " $28, 28*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
389 Asm (STOREI & " $29, 29*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
390 Asm (STOREI & " $30, 30*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
391 Asm (STOREI & " $31, 31*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
393 -- Restore floating-point registers from machine state
395 Asm (STOREF & " $f16, 16*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
396 Asm (STOREF & " $f17, 17*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
397 Asm (STOREF & " $f18, 18*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
398 Asm (STOREF & " $f19, 19*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
399 Asm (STOREF & " $f20, 20*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
400 Asm (STOREF & " $f21, 21*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
401 Asm (STOREF & " $f22, 22*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
402 Asm (STOREF & " $f23, 23*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
403 Asm (STOREF & " $f24, 24*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
404 Asm (STOREF & " $f25, 25*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
405 Asm (STOREF & " $f26, 26*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
406 Asm (STOREF & " $f27, 27*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
407 Asm (STOREF & " $f28, 28*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
408 Asm (STOREF & " $f29, 29*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
409 Asm (STOREF & " $f30, 30*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
410 Asm (STOREF & " $f31, 31*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
412 -- Set the PC value for the context to a location after the
413 -- prolog has been executed.
415 Scp := To_Sigcontext_Ptr (M);
416 Scp.SC_PC := Uns64 (To_Addr_Int (Past_Prolog'Address));
418 -- We saved the state *inside* this routine, but what we want is
419 -- the state at the call site. So we need to do one pop operation.
420 -- This pop operation will properly set the PC value in the machine
421 -- state, so there is no need to save PC in the above code.
423 Pop_Frame (M, Set_Machine_State'Address);
424 end Set_Machine_State;
426 ------------------------------
427 -- Set_Signal_Machine_State --
428 ------------------------------
430 procedure Set_Signal_Machine_State
432 Context : System.Address)
434 pragma Warnings (Off, M);
435 pragma Warnings (Off, Context);
439 end Set_Signal_Machine_State;
441 end System.Machine_State_Operations;