1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- SYSTEM.MACHINE_STATE_OPERATIONS --
8 -- (Version for IRIX/MIPS) --
10 -- Copyright (C) 1999-2003 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 Natural := Boolean'Pos (System
.Word_Size
= 32);
112 n32
: constant Natural := Boolean'Pos (System
.Word_Size
= 64);
113 -- Flags to indicate which ABI is in effect for this compilation. For the
114 -- purposes of this unit, the n32 and n64 ABI's are identical.
116 LSC
: constant Character := Character'Val (o32
* Character'Pos ('w') +
117 n32
* Character'Pos ('d'));
118 -- This is 'w' for o32, and 'd' for n32/n64, used for constructing the
119 -- load/store instructions used to save/restore machine instructions.
121 Roff
: constant Character := Character'Val (o32
* Character'Pos ('4') +
122 n32
* Character'Pos (' '));
123 -- Offset from first byte of a __uint64 register save location where
124 -- the register value is stored. For n32/64 we store the entire 64
125 -- bit register into the uint64. For o32, only 32 bits are stored
126 -- at an offset of 4 bytes.
128 procedure Update_GP
(Scp
: Sigcontext_Ptr
);
134 procedure Update_GP
(Scp
: Sigcontext_Ptr
) is
136 type F_op
is mod 2 ** 6;
137 type F_reg
is mod 2 ** 5;
138 type F_imm
is new Short_Integer;
140 type I_Type
is record
147 pragma Pack
(I_Type
);
148 for I_Type
'Size use 32;
150 type I_Type_Ptr
is access all I_Type
;
152 LW
: constant F_op
:= 2#
100011#
;
153 Reg_GP
: constant := 28;
155 type Address_Int
is mod 2 ** Standard
'Address_Size;
156 function To_I_Type_Ptr
is new
157 Unchecked_Conversion
(Address_Int
, I_Type_Ptr
);
159 Ret_Ins
: I_Type_Ptr
:= To_I_Type_Ptr
(Address_Int
(Scp
.SC_PC
));
163 if Ret_Ins
.op
= LW
and then Ret_Ins
.rt
= Reg_GP
then
164 GP_Ptr
:= To_Uns32_Ptr
165 (Addr_Int
(Scp
.SC_Regs
(Integer (Ret_Ins
.rs
)))
166 + Addr_Int
(Ret_Ins
.imm
));
167 Scp
.SC_Regs
(Reg_GP
) := Uns64
(GP_Ptr
.all);
171 ----------------------------
172 -- Allocate_Machine_State --
173 ----------------------------
175 function Allocate_Machine_State
return Machine_State
is
178 (Memory
.Alloc
(Sigcontext
'Max_Size_In_Storage_Elements));
179 end Allocate_Machine_State
;
185 procedure Enter_Handler
(M
: Machine_State
; Handler
: Handler_Loc
) is
186 pragma Warnings
(Off
, M
);
187 pragma Warnings
(Off
, Handler
);
189 LOADI
: constant String (1 .. 2) := 'l' & LSC
;
190 -- This is "lw" in o32 mode, and "ld" in n32/n64 mode
192 LOADF
: constant String (1 .. 4) := 'l' & LSC
& "c1";
193 -- This is "lwc1" in o32 mode and "ldc1" in n32/n64 mode
196 -- Restore integer registers from machine state. Note that we know
197 -- that $4 points to M, and $5 points to Handler, since this is
198 -- the standard calling sequence
200 Asm
(LOADI
& " $16, 16*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
201 Asm
(LOADI
& " $17, 17*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
202 Asm
(LOADI
& " $18, 18*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
203 Asm
(LOADI
& " $19, 19*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
204 Asm
(LOADI
& " $20, 20*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
205 Asm
(LOADI
& " $21, 21*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
206 Asm
(LOADI
& " $22, 22*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
207 Asm
(LOADI
& " $23, 23*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
208 Asm
(LOADI
& " $24, 24*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
209 Asm
(LOADI
& " $25, 25*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
210 Asm
(LOADI
& " $26, 26*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
211 Asm
(LOADI
& " $27, 27*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
212 Asm
(LOADI
& " $28, 28*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
213 Asm
(LOADI
& " $29, 29*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
214 Asm
(LOADI
& " $30, 30*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
215 Asm
(LOADI
& " $31, 31*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
217 -- Restore floating-point registers from machine state
219 Asm
(LOADF
& " $f16, 16*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
220 Asm
(LOADF
& " $f17, 17*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
221 Asm
(LOADF
& " $f18, 18*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
222 Asm
(LOADF
& " $f19, 19*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
223 Asm
(LOADF
& " $f20, 20*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
224 Asm
(LOADF
& " $f21, 21*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
225 Asm
(LOADF
& " $f22, 22*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
226 Asm
(LOADF
& " $f23, 23*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
227 Asm
(LOADF
& " $f24, 24*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
228 Asm
(LOADF
& " $f25, 25*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
229 Asm
(LOADF
& " $f26, 26*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
230 Asm
(LOADF
& " $f27, 27*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
231 Asm
(LOADF
& " $f28, 28*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
232 Asm
(LOADF
& " $f29, 29*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
233 Asm
(LOADF
& " $f30, 30*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
234 Asm
(LOADF
& " $f31, 31*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
236 -- Jump directly to the handler
245 function Fetch_Code
(Loc
: Code_Loc
) return Code_Loc
is
250 ------------------------
251 -- Free_Machine_State --
252 ------------------------
254 procedure Free_Machine_State
(M
: in out Machine_State
) is
256 Memory
.Free
(Address
(M
));
257 M
:= Machine_State
(Null_Address
);
258 end Free_Machine_State
;
264 function Get_Code_Loc
(M
: Machine_State
) return Code_Loc
is
265 SC
: constant Sigcontext_Ptr
:= To_Sigcontext_Ptr
(M
);
267 return To_Code_Loc
(Addr_Int
(SC
.SC_PC
));
270 --------------------------
271 -- Machine_State_Length --
272 --------------------------
274 function Machine_State_Length
return Storage_Offset
is
276 return Sigcontext
'Max_Size_In_Storage_Elements;
277 end Machine_State_Length
;
285 Info
: Subprogram_Info_Type
)
287 pragma Warnings
(Off
, Info
);
289 Scp
: Sigcontext_Ptr
:= To_Sigcontext_Ptr
(M
);
291 procedure Exc_Unwind
(Scp
: Sigcontext_Ptr
; Fde
: Long_Integer := 0);
292 pragma Import
(C
, Exc_Unwind
, "exc_unwind");
293 pragma Linker_Options
("-lexc");
296 -- exc_unwind is apparently not thread-safe under IRIX, so protect it
297 -- against race conditions within the GNAT run time.
298 -- ??? Note that we might want to use a fine grained lock here since
299 -- Lock_Task is used in many other places.
305 if Scp
.SC_PC
= 0 or else Scp
.SC_PC
= 1 then
307 -- A return value of 0 or 1 means exc_unwind couldn't find a parent
308 -- frame. Propagate_Exception expects a zero return address to
315 -- Set the GP to restore to the caller value (not callee value)
316 -- This is done only in o32 mode. In n32/n64 mode, GP is a normal
317 -- callee save register
323 -- Adjust the return address to the call site, not the
324 -- instruction following the branch delay slot. This may
325 -- be necessary if the last instruction of a pragma No_Return
326 -- subprogram is a call. The first instruction following the
327 -- delay slot may be the start of another subprogram. We back
328 -- off the address by 8, which points safely into the middle
329 -- of the generated subprogram code, avoiding end effects.
331 Scp
.SC_PC
:= Scp
.SC_PC
- 8;
335 -----------------------
336 -- Set_Machine_State --
337 -----------------------
339 procedure Set_Machine_State
(M
: Machine_State
) is
341 STOREI
: constant String (1 .. 2) := 's' & LSC
;
342 -- This is "sw" in o32 mode, and "sd" in n32 mode
344 STOREF
: constant String (1 .. 4) := 's' & LSC
& "c1";
345 -- This is "swc1" in o32 mode and "sdc1" in n32 mode
347 Scp
: Sigcontext_Ptr
;
350 -- Save the integer registers. Note that we know that $4 points
351 -- to M, since that is where the first parameter is passed.
352 -- Restore integer registers from machine state. Note that we know
353 -- that $4 points to M since this is the standard calling sequence
357 Asm
(STOREI
& " $16, 16*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
358 Asm
(STOREI
& " $17, 17*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
359 Asm
(STOREI
& " $18, 18*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
360 Asm
(STOREI
& " $19, 19*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
361 Asm
(STOREI
& " $20, 20*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
362 Asm
(STOREI
& " $21, 21*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
363 Asm
(STOREI
& " $22, 22*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
364 Asm
(STOREI
& " $23, 23*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
365 Asm
(STOREI
& " $24, 24*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
366 Asm
(STOREI
& " $25, 25*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
367 Asm
(STOREI
& " $26, 26*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
368 Asm
(STOREI
& " $27, 27*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
369 Asm
(STOREI
& " $28, 28*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
370 Asm
(STOREI
& " $29, 29*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
371 Asm
(STOREI
& " $30, 30*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
372 Asm
(STOREI
& " $31, 31*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
374 -- Restore floating-point registers from machine state
376 Asm
(STOREF
& " $f16, 16*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
377 Asm
(STOREF
& " $f17, 17*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
378 Asm
(STOREF
& " $f18, 18*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
379 Asm
(STOREF
& " $f19, 19*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
380 Asm
(STOREF
& " $f20, 20*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
381 Asm
(STOREF
& " $f21, 21*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
382 Asm
(STOREF
& " $f22, 22*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
383 Asm
(STOREF
& " $f23, 23*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
384 Asm
(STOREF
& " $f24, 24*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
385 Asm
(STOREF
& " $f25, 25*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
386 Asm
(STOREF
& " $f26, 26*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
387 Asm
(STOREF
& " $f27, 27*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
388 Asm
(STOREF
& " $f28, 28*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
389 Asm
(STOREF
& " $f29, 29*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
390 Asm
(STOREF
& " $f30, 30*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
391 Asm
(STOREF
& " $f31, 31*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
393 -- Set the PC value for the context to a location after the
394 -- prolog has been executed.
396 Scp
:= To_Sigcontext_Ptr
(M
);
397 Scp
.SC_PC
:= Uns64
(To_Addr_Int
(Past_Prolog
'Address));
399 -- We saved the state *inside* this routine, but what we want is
400 -- the state at the call site. So we need to do one pop operation.
401 -- This pop operation will properly set the PC value in the machine
402 -- state, so there is no need to save PC in the above code.
404 Pop_Frame
(M
, Set_Machine_State
'Address);
405 end Set_Machine_State
;
407 ------------------------------
408 -- Set_Signal_Machine_State --
409 ------------------------------
411 procedure Set_Signal_Machine_State
413 Context
: System
.Address
)
415 pragma Warnings
(Off
, M
);
416 pragma Warnings
(Off
, Context
);
420 end Set_Signal_Machine_State
;
422 end System
.Machine_State_Operations
;