1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- SYSTEM.MACHINE_STATE_OPERATIONS --
8 -- (Version for IRIX/MIPS) --
10 -- Copyright (C) 1999-2007, 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, 51 Franklin Street, Fifth Floor, --
21 -- Boston, MA 02110-1301, 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 Ada
.Unchecked_Conversion
;
44 package body System
.Machine_State_Operations
is
46 use System
.Storage_Elements
;
48 -- The exc_unwind function in libexc operates on a Sigcontext
50 -- Type sigcontext_t is defined in /usr/include/sys/signal.h.
51 -- We define an equivalent Ada type here. From the comments in
54 -- sigcontext is not part of the ABI - so this version is used to
55 -- handle 32 and 64 bit applications - it is a constant size regardless
56 -- of compilation mode, and always returns 64 bit register values
58 type Uns32
is mod 2 ** 32;
59 type Uns64
is mod 2 ** 64;
61 type Uns32_Ptr
is access all Uns32
;
62 type Uns64_Array
is array (Integer range <>) of Uns64
;
64 type Reg_Array
is array (0 .. 31) of Uns64
;
66 type Sigcontext
is record
67 SC_Regmask
: Uns32
; -- 0
68 SC_Status
: Uns32
; -- 4
70 SC_Regs
: Reg_Array
; -- 16
71 SC_Fpregs
: Reg_Array
; -- 272
72 SC_Ownedfp
: Uns32
; -- 528
73 SC_Fpc_Csr
: Uns32
; -- 532
74 SC_Fpc_Eir
: Uns32
; -- 536
75 SC_Ssflags
: Uns32
; -- 540
76 SC_Mdhi
: Uns64
; -- 544
77 SC_Mdlo
: Uns64
; -- 552
78 SC_Cause
: Uns64
; -- 560
79 SC_Badvaddr
: Uns64
; -- 568
80 SC_Triggersave
: Uns64
; -- 576
81 SC_Sigset
: Uns64
; -- 584
82 SC_Fp_Rounded_Result
: Uns64
; -- 592
83 SC_Pancake
: Uns64_Array
(0 .. 5);
84 SC_Pad
: Uns64_Array
(0 .. 26);
87 type Sigcontext_Ptr
is access all Sigcontext
;
89 SC_Regs_Pos
: constant String := "16";
90 SC_Fpregs_Pos
: constant String := "272";
91 -- Byte offset of the Integer and Floating Point register save areas
92 -- within the Sigcontext.
94 function To_Sigcontext_Ptr
is
95 new Ada
.Unchecked_Conversion
(Machine_State
, Sigcontext_Ptr
);
97 type Addr_Int
is mod 2 ** Long_Integer'Size;
98 -- An unsigned integer type whose size is the same as System.Address.
99 -- We rely on the fact that Long_Integer'Size = System.Address'Size in
100 -- all ABIs. Type Addr_Int can be converted to Uns64.
102 function To_Code_Loc
is
103 new Ada
.Unchecked_Conversion
(Addr_Int
, Code_Loc
);
104 function To_Addr_Int
is
105 new Ada
.Unchecked_Conversion
(System
.Address
, Addr_Int
);
106 function To_Uns32_Ptr
is
107 new Ada
.Unchecked_Conversion
(Addr_Int
, Uns32_Ptr
);
109 --------------------------------
110 -- ABI-Dependent Declarations --
111 --------------------------------
113 o32
: constant Boolean := System
.Word_Size
= 32;
114 n32
: constant Boolean := System
.Word_Size
= 64;
115 o32n
: constant Natural := Boolean'Pos (o32
);
116 n32n
: constant Natural := Boolean'Pos (n32
);
117 -- Flags to indicate which ABI is in effect for this compilation. For the
118 -- purposes of this unit, the n32 and n64 ABIs are identical.
120 LSC
: constant Character := Character'Val (o32n
* Character'Pos ('w') +
121 n32n
* Character'Pos ('d'));
122 -- This is 'w' for o32, and 'd' for n32/n64, used for constructing the
123 -- load/store instructions used to save/restore machine instructions.
125 Roff
: constant Character := Character'Val (o32n
* Character'Pos ('4') +
126 n32n
* Character'Pos ('0'));
127 -- Offset from first byte of a __uint64 register save location where
128 -- the register value is stored. For n32/64 we store the entire 64
129 -- bit register into the uint64. For o32, only 32 bits are stored
130 -- at an offset of 4 bytes. This is used as part of expressions with
131 -- '+' signs on both sides, so a null offset has to be '0' and not ' '
132 -- to avoid assembler syntax errors on "X + + Y" in the latter case.
134 procedure Update_GP
(Scp
: Sigcontext_Ptr
);
140 procedure Update_GP
(Scp
: Sigcontext_Ptr
) is
142 type F_op
is mod 2 ** 6;
143 type F_reg
is mod 2 ** 5;
144 type F_imm
is new Short_Integer;
146 type I_Type
is record
153 pragma Pack
(I_Type
);
154 for I_Type
'Size use 32;
156 type I_Type_Ptr
is access all I_Type
;
158 LW
: constant F_op
:= 2#
100011#
;
159 Reg_GP
: constant := 28;
161 type Address_Int
is mod 2 ** Standard
'Address_Size;
162 function To_I_Type_Ptr
is new
163 Ada
.Unchecked_Conversion
(Address_Int
, I_Type_Ptr
);
165 Ret_Ins
: constant I_Type_Ptr
:= To_I_Type_Ptr
(Address_Int
(Scp
.SC_PC
));
169 if Ret_Ins
.op
= LW
and then Ret_Ins
.rt
= Reg_GP
then
170 GP_Ptr
:= To_Uns32_Ptr
171 (Addr_Int
(Scp
.SC_Regs
(Integer (Ret_Ins
.rs
)))
172 + Addr_Int
(Ret_Ins
.imm
));
173 Scp
.SC_Regs
(Reg_GP
) := Uns64
(GP_Ptr
.all);
177 ----------------------------
178 -- Allocate_Machine_State --
179 ----------------------------
181 function Allocate_Machine_State
return Machine_State
is
184 (Memory
.Alloc
(Sigcontext
'Max_Size_In_Storage_Elements));
185 end Allocate_Machine_State
;
191 function Fetch_Code
(Loc
: Code_Loc
) return Code_Loc
is
196 ------------------------
197 -- Free_Machine_State --
198 ------------------------
200 procedure Free_Machine_State
(M
: in out Machine_State
) is
202 Memory
.Free
(Address
(M
));
203 M
:= Machine_State
(Null_Address
);
204 end Free_Machine_State
;
210 function Get_Code_Loc
(M
: Machine_State
) return Code_Loc
is
211 SC
: constant Sigcontext_Ptr
:= To_Sigcontext_Ptr
(M
);
213 return To_Code_Loc
(Addr_Int
(SC
.SC_PC
));
216 --------------------------
217 -- Machine_State_Length --
218 --------------------------
220 function Machine_State_Length
return Storage_Offset
is
222 return Sigcontext
'Max_Size_In_Storage_Elements;
223 end Machine_State_Length
;
229 procedure Pop_Frame
(M
: Machine_State
) is
230 Scp
: constant Sigcontext_Ptr
:= To_Sigcontext_Ptr
(M
);
232 procedure Exc_Unwind
(Scp
: Sigcontext_Ptr
; Fde
: Long_Integer := 0);
233 pragma Import
(C
, Exc_Unwind
, "exc_unwind");
235 pragma Linker_Options
("-lexc");
238 -- exc_unwind is apparently not thread-safe under IRIX, so protect it
239 -- against race conditions within the GNAT run time.
240 -- ??? Note that we might want to use a fine grained lock here since
241 -- Lock_Task is used in many other places.
249 if Scp
.SC_PC
= 0 or else Scp
.SC_PC
= 1 then
251 -- A return value of 0 or 1 means exc_unwind couldn't find a parent
252 -- frame. Propagate_Exception expects a zero return address to
258 -- Set the GP to restore to the caller value (not callee value)
259 -- This is done only in o32 mode. In n32/n64 mode, GP is a normal
260 -- callee save register
266 -- Adjust the return address to the call site, not the
267 -- instruction following the branch delay slot. This may
268 -- be necessary if the last instruction of a pragma No_Return
269 -- subprogram is a call. The first instruction following the
270 -- delay slot may be the start of another subprogram. We back
271 -- off the address by 8, which points safely into the middle
272 -- of the generated subprogram code, avoiding end effects.
274 Scp
.SC_PC
:= Scp
.SC_PC
- 8;
278 -----------------------
279 -- Set_Machine_State --
280 -----------------------
282 procedure Set_Machine_State
(M
: Machine_State
) is
284 SI
: constant String (1 .. 2) := 's' & LSC
;
285 -- This is "sw" in o32 mode, and "sd" in n32 mode
287 SF
: constant String (1 .. 4) := 's' & LSC
& "c1";
288 -- This is "swc1" in o32 mode and "sdc1" in n32 mode
290 PI
: String renames SC_Regs_Pos
;
291 PF
: String renames SC_Fpregs_Pos
;
293 Scp
: Sigcontext_Ptr
;
296 -- Save the integer registers. Note that we know that $4 points
297 -- to M, since that is where the first parameter is passed.
298 -- Restore integer registers from machine state. Note that we know
299 -- that $4 points to M since this is the standard calling sequence
303 Asm
(SI
& " $16, 16*8+" & Roff
& "+" & PI
& "($4)", Volatile
=> True);
304 Asm
(SI
& " $17, 17*8+" & Roff
& "+" & PI
& "($4)", Volatile
=> True);
305 Asm
(SI
& " $18, 18*8+" & Roff
& "+" & PI
& "($4)", Volatile
=> True);
306 Asm
(SI
& " $19, 19*8+" & Roff
& "+" & PI
& "($4)", Volatile
=> True);
307 Asm
(SI
& " $20, 20*8+" & Roff
& "+" & PI
& "($4)", Volatile
=> True);
308 Asm
(SI
& " $21, 21*8+" & Roff
& "+" & PI
& "($4)", Volatile
=> True);
309 Asm
(SI
& " $22, 22*8+" & Roff
& "+" & PI
& "($4)", Volatile
=> True);
310 Asm
(SI
& " $23, 23*8+" & Roff
& "+" & PI
& "($4)", Volatile
=> True);
311 Asm
(SI
& " $24, 24*8+" & Roff
& "+" & PI
& "($4)", Volatile
=> True);
312 Asm
(SI
& " $25, 25*8+" & Roff
& "+" & PI
& "($4)", Volatile
=> True);
313 Asm
(SI
& " $26, 26*8+" & Roff
& "+" & PI
& "($4)", Volatile
=> True);
314 Asm
(SI
& " $27, 27*8+" & Roff
& "+" & PI
& "($4)", Volatile
=> True);
315 Asm
(SI
& " $28, 28*8+" & Roff
& "+" & PI
& "($4)", Volatile
=> True);
316 Asm
(SI
& " $29, 29*8+" & Roff
& "+" & PI
& "($4)", Volatile
=> True);
317 Asm
(SI
& " $30, 30*8+" & Roff
& "+" & PI
& "($4)", Volatile
=> True);
318 Asm
(SI
& " $31, 31*8+" & Roff
& "+" & PI
& "($4)", Volatile
=> True);
320 -- Restore floating-point registers from machine state
322 Asm
(SF
& " $f16, 16*8+" & Roff
& "+" & PF
& "($4)", Volatile
=> True);
323 Asm
(SF
& " $f17, 17*8+" & Roff
& "+" & PF
& "($4)", Volatile
=> True);
324 Asm
(SF
& " $f18, 18*8+" & Roff
& "+" & PF
& "($4)", Volatile
=> True);
325 Asm
(SF
& " $f19, 19*8+" & Roff
& "+" & PF
& "($4)", Volatile
=> True);
326 Asm
(SF
& " $f20, 20*8+" & Roff
& "+" & PF
& "($4)", Volatile
=> True);
327 Asm
(SF
& " $f21, 21*8+" & Roff
& "+" & PF
& "($4)", Volatile
=> True);
328 Asm
(SF
& " $f22, 22*8+" & Roff
& "+" & PF
& "($4)", Volatile
=> True);
329 Asm
(SF
& " $f23, 23*8+" & Roff
& "+" & PF
& "($4)", Volatile
=> True);
330 Asm
(SF
& " $f24, 24*8+" & Roff
& "+" & PF
& "($4)", Volatile
=> True);
331 Asm
(SF
& " $f25, 25*8+" & Roff
& "+" & PF
& "($4)", Volatile
=> True);
332 Asm
(SF
& " $f26, 26*8+" & Roff
& "+" & PF
& "($4)", Volatile
=> True);
333 Asm
(SF
& " $f27, 27*8+" & Roff
& "+" & PF
& "($4)", Volatile
=> True);
334 Asm
(SF
& " $f28, 28*8+" & Roff
& "+" & PF
& "($4)", Volatile
=> True);
335 Asm
(SF
& " $f29, 29*8+" & Roff
& "+" & PF
& "($4)", Volatile
=> True);
336 Asm
(SF
& " $f30, 30*8+" & Roff
& "+" & PF
& "($4)", Volatile
=> True);
337 Asm
(SF
& " $f31, 31*8+" & Roff
& "+" & PF
& "($4)", Volatile
=> True);
339 -- Set the PC value for the context to a location after the
340 -- prolog has been executed.
342 Scp
:= To_Sigcontext_Ptr
(M
);
343 Scp
.SC_PC
:= Uns64
(To_Addr_Int
(Past_Prolog
'Address));
345 -- We saved the state *inside* this routine, but what we want is
346 -- the state at the call site. So we need to do one pop operation.
347 -- This pop operation will properly set the PC value in the machine
348 -- state, so there is no need to save PC in the above code.
351 end Set_Machine_State
;
353 end System
.Machine_State_Operations
;