1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- SYSTEM.MACHINE_STATE_OPERATIONS --
8 -- (Version for IRIX/MIPS) --
10 -- Copyright (C) 1999-2005 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 Unchecked_Conversion
;
44 package body System
.Machine_State_Operations
is
46 use System
.Storage_Elements
;
48 -- The exc_unwind function in libexc operats 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 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 new Unchecked_Conversion
(Addr_Int
, Code_Loc
);
103 function To_Addr_Int
is new Unchecked_Conversion
(System
.Address
, Addr_Int
);
104 function To_Uns32_Ptr
is new Unchecked_Conversion
(Addr_Int
, Uns32_Ptr
);
106 --------------------------------
107 -- ABI-Dependent Declarations --
108 --------------------------------
110 o32
: constant Boolean := System
.Word_Size
= 32;
111 n32
: constant Boolean := System
.Word_Size
= 64;
112 o32n
: constant Natural := Boolean'Pos (o32
);
113 n32n
: constant Natural := Boolean'Pos (n32
);
114 -- Flags to indicate which ABI is in effect for this compilation. For the
115 -- purposes of this unit, the n32 and n64 ABI's are identical.
117 LSC
: constant Character := Character'Val (o32n
* Character'Pos ('w') +
118 n32n
* Character'Pos ('d'));
119 -- This is 'w' for o32, and 'd' for n32/n64, used for constructing the
120 -- load/store instructions used to save/restore machine instructions.
122 Roff
: constant Character := Character'Val (o32n
* Character'Pos ('4') +
123 n32n
* Character'Pos ('0'));
124 -- Offset from first byte of a __uint64 register save location where
125 -- the register value is stored. For n32/64 we store the entire 64
126 -- bit register into the uint64. For o32, only 32 bits are stored
127 -- at an offset of 4 bytes. This is used as part of expressions with
128 -- '+' signs on both sides, so a null offset has to be '0' and not ' '
129 -- to avoid assembler syntax errors on "X + + Y" in the latter case.
131 procedure Update_GP
(Scp
: Sigcontext_Ptr
);
137 procedure Update_GP
(Scp
: Sigcontext_Ptr
) is
139 type F_op
is mod 2 ** 6;
140 type F_reg
is mod 2 ** 5;
141 type F_imm
is new Short_Integer;
143 type I_Type
is record
150 pragma Pack
(I_Type
);
151 for I_Type
'Size use 32;
153 type I_Type_Ptr
is access all I_Type
;
155 LW
: constant F_op
:= 2#
100011#
;
156 Reg_GP
: constant := 28;
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
);
162 Ret_Ins
: constant I_Type_Ptr
:= To_I_Type_Ptr
(Address_Int
(Scp
.SC_PC
));
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);
174 ----------------------------
175 -- Allocate_Machine_State --
176 ----------------------------
178 function Allocate_Machine_State
return Machine_State
is
181 (Memory
.Alloc
(Sigcontext
'Max_Size_In_Storage_Elements));
182 end Allocate_Machine_State
;
188 function Fetch_Code
(Loc
: Code_Loc
) return Code_Loc
is
193 ------------------------
194 -- Free_Machine_State --
195 ------------------------
197 procedure Free_Machine_State
(M
: in out Machine_State
) is
199 Memory
.Free
(Address
(M
));
200 M
:= Machine_State
(Null_Address
);
201 end Free_Machine_State
;
207 function Get_Code_Loc
(M
: Machine_State
) return Code_Loc
is
208 SC
: constant Sigcontext_Ptr
:= To_Sigcontext_Ptr
(M
);
210 return To_Code_Loc
(Addr_Int
(SC
.SC_PC
));
213 --------------------------
214 -- Machine_State_Length --
215 --------------------------
217 function Machine_State_Length
return Storage_Offset
is
219 return Sigcontext
'Max_Size_In_Storage_Elements;
220 end Machine_State_Length
;
226 procedure Pop_Frame
(M
: Machine_State
) is
227 Scp
: constant Sigcontext_Ptr
:= To_Sigcontext_Ptr
(M
);
229 procedure Exc_Unwind
(Scp
: Sigcontext_Ptr
; Fde
: Long_Integer := 0);
230 pragma Import
(C
, Exc_Unwind
, "exc_unwind");
232 pragma Linker_Options
("-lexc");
235 -- exc_unwind is apparently not thread-safe under IRIX, so protect it
236 -- against race conditions within the GNAT run time.
237 -- ??? Note that we might want to use a fine grained lock here since
238 -- Lock_Task is used in many other places.
246 if Scp
.SC_PC
= 0 or else Scp
.SC_PC
= 1 then
248 -- A return value of 0 or 1 means exc_unwind couldn't find a parent
249 -- frame. Propagate_Exception expects a zero return address to
255 -- Set the GP to restore to the caller value (not callee value)
256 -- This is done only in o32 mode. In n32/n64 mode, GP is a normal
257 -- callee save register
263 -- Adjust the return address to the call site, not the
264 -- instruction following the branch delay slot. This may
265 -- be necessary if the last instruction of a pragma No_Return
266 -- subprogram is a call. The first instruction following the
267 -- delay slot may be the start of another subprogram. We back
268 -- off the address by 8, which points safely into the middle
269 -- of the generated subprogram code, avoiding end effects.
271 Scp
.SC_PC
:= Scp
.SC_PC
- 8;
275 -----------------------
276 -- Set_Machine_State --
277 -----------------------
279 procedure Set_Machine_State
(M
: Machine_State
) is
281 STOREI
: constant String (1 .. 2) := 's' & LSC
;
282 -- This is "sw" in o32 mode, and "sd" in n32 mode
284 STOREF
: constant String (1 .. 4) := 's' & LSC
& "c1";
285 -- This is "swc1" in o32 mode and "sdc1" in n32 mode
287 Scp
: Sigcontext_Ptr
;
290 -- Save the integer registers. Note that we know that $4 points
291 -- to M, since that is where the first parameter is passed.
292 -- Restore integer registers from machine state. Note that we know
293 -- that $4 points to M since this is the standard calling sequence
297 Asm
(STOREI
& " $16, 16*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
298 Asm
(STOREI
& " $17, 17*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
299 Asm
(STOREI
& " $18, 18*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
300 Asm
(STOREI
& " $19, 19*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
301 Asm
(STOREI
& " $20, 20*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
302 Asm
(STOREI
& " $21, 21*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
303 Asm
(STOREI
& " $22, 22*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
304 Asm
(STOREI
& " $23, 23*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
305 Asm
(STOREI
& " $24, 24*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
306 Asm
(STOREI
& " $25, 25*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
307 Asm
(STOREI
& " $26, 26*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
308 Asm
(STOREI
& " $27, 27*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
309 Asm
(STOREI
& " $28, 28*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
310 Asm
(STOREI
& " $29, 29*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
311 Asm
(STOREI
& " $30, 30*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
312 Asm
(STOREI
& " $31, 31*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
314 -- Restore floating-point registers from machine state
316 Asm
(STOREF
& " $f16, 16*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
317 Asm
(STOREF
& " $f17, 17*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
318 Asm
(STOREF
& " $f18, 18*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
319 Asm
(STOREF
& " $f19, 19*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
320 Asm
(STOREF
& " $f20, 20*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
321 Asm
(STOREF
& " $f21, 21*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
322 Asm
(STOREF
& " $f22, 22*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
323 Asm
(STOREF
& " $f23, 23*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
324 Asm
(STOREF
& " $f24, 24*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
325 Asm
(STOREF
& " $f25, 25*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
326 Asm
(STOREF
& " $f26, 26*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
327 Asm
(STOREF
& " $f27, 27*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
328 Asm
(STOREF
& " $f28, 28*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
329 Asm
(STOREF
& " $f29, 29*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
330 Asm
(STOREF
& " $f30, 30*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
331 Asm
(STOREF
& " $f31, 31*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
333 -- Set the PC value for the context to a location after the
334 -- prolog has been executed.
336 Scp
:= To_Sigcontext_Ptr
(M
);
337 Scp
.SC_PC
:= Uns64
(To_Addr_Int
(Past_Prolog
'Address));
339 -- We saved the state *inside* this routine, but what we want is
340 -- the state at the call site. So we need to do one pop operation.
341 -- This pop operation will properly set the PC value in the machine
342 -- state, so there is no need to save PC in the above code.
345 end Set_Machine_State
;
347 end System
.Machine_State_Operations
;