1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- SYSTEM.MACHINE_STATE_OPERATIONS --
8 -- (Version for IRIX/MIPS) --
10 -- Copyright (C) 1999-2001 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
187 LOADI
: constant String (1 .. 2) := 'l' & LSC
;
188 -- This is "lw" in o32 mode, and "ld" in n32/n64 mode
190 LOADF
: constant String (1 .. 4) := 'l' & LSC
& "c1";
191 -- This is "lwc1" in o32 mode and "ldc1" in n32/n64 mode
194 -- Restore integer registers from machine state. Note that we know
195 -- that $4 points to M, and $5 points to Handler, since this is
196 -- the standard calling sequence
198 Asm
(LOADI
& " $16, 16*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
199 Asm
(LOADI
& " $17, 17*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
200 Asm
(LOADI
& " $18, 18*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
201 Asm
(LOADI
& " $19, 19*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
202 Asm
(LOADI
& " $20, 20*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
203 Asm
(LOADI
& " $21, 21*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
204 Asm
(LOADI
& " $22, 22*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
205 Asm
(LOADI
& " $23, 23*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
206 Asm
(LOADI
& " $24, 24*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
207 Asm
(LOADI
& " $25, 25*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
208 Asm
(LOADI
& " $26, 26*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
209 Asm
(LOADI
& " $27, 27*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
210 Asm
(LOADI
& " $28, 28*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
211 Asm
(LOADI
& " $29, 29*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
212 Asm
(LOADI
& " $30, 30*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
213 Asm
(LOADI
& " $31, 31*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
215 -- Restore floating-point registers from machine state
217 Asm
(LOADF
& " $f16, 16*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
218 Asm
(LOADF
& " $f17, 17*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
219 Asm
(LOADF
& " $f18, 18*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
220 Asm
(LOADF
& " $f19, 19*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
221 Asm
(LOADF
& " $f20, 20*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
222 Asm
(LOADF
& " $f21, 21*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
223 Asm
(LOADF
& " $f22, 22*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
224 Asm
(LOADF
& " $f23, 23*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
225 Asm
(LOADF
& " $f24, 24*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
226 Asm
(LOADF
& " $f25, 25*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
227 Asm
(LOADF
& " $f26, 26*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
228 Asm
(LOADF
& " $f27, 27*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
229 Asm
(LOADF
& " $f28, 28*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
230 Asm
(LOADF
& " $f29, 29*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
231 Asm
(LOADF
& " $f30, 30*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
232 Asm
(LOADF
& " $f31, 31*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
234 -- Jump directly to the handler
243 function Fetch_Code
(Loc
: Code_Loc
) return Code_Loc
is
248 ------------------------
249 -- Free_Machine_State --
250 ------------------------
252 procedure Free_Machine_State
(M
: in out Machine_State
) is
254 Memory
.Free
(Address
(M
));
255 M
:= Machine_State
(Null_Address
);
256 end Free_Machine_State
;
262 function Get_Code_Loc
(M
: Machine_State
) return Code_Loc
is
263 SC
: constant Sigcontext_Ptr
:= To_Sigcontext_Ptr
(M
);
265 return To_Code_Loc
(Addr_Int
(SC
.SC_PC
));
268 --------------------------
269 -- Machine_State_Length --
270 --------------------------
272 function Machine_State_Length
return Storage_Offset
is
274 return Sigcontext
'Max_Size_In_Storage_Elements;
275 end Machine_State_Length
;
283 Info
: Subprogram_Info_Type
)
285 Scp
: Sigcontext_Ptr
:= To_Sigcontext_Ptr
(M
);
287 procedure Exc_Unwind
(Scp
: Sigcontext_Ptr
; Fde
: Long_Integer := 0);
288 pragma Import
(C
, Exc_Unwind
, "exc_unwind");
289 pragma Linker_Options
("-lexc");
292 -- exc_unwind is apparently not thread-safe under IRIX, so protect it
293 -- against race conditions within the GNAT run time.
294 -- ??? Note that we might want to use a fine grained lock here since
295 -- Lock_Task is used in many other places.
301 if Scp
.SC_PC
= 0 or else Scp
.SC_PC
= 1 then
303 -- A return value of 0 or 1 means exc_unwind couldn't find a parent
304 -- frame. Propagate_Exception expects a zero return address to
311 -- Set the GP to restore to the caller value (not callee value)
312 -- This is done only in o32 mode. In n32/n64 mode, GP is a normal
313 -- callee save register
319 -- Adjust the return address to the call site, not the
320 -- instruction following the branch delay slot. This may
321 -- be necessary if the last instruction of a pragma No_Return
322 -- subprogram is a call. The first instruction following the
323 -- delay slot may be the start of another subprogram. We back
324 -- off the address by 8, which points safely into the middle
325 -- of the generated subprogram code, avoiding end effects.
327 Scp
.SC_PC
:= Scp
.SC_PC
- 8;
331 -----------------------
332 -- Set_Machine_State --
333 -----------------------
335 procedure Set_Machine_State
(M
: Machine_State
) is
337 STOREI
: constant String (1 .. 2) := 's' & LSC
;
338 -- This is "sw" in o32 mode, and "sd" in n32 mode
340 STOREF
: constant String (1 .. 4) := 's' & LSC
& "c1";
341 -- This is "swc1" in o32 mode and "sdc1" in n32 mode
343 Scp
: Sigcontext_Ptr
;
346 -- Save the integer registers. Note that we know that $4 points
347 -- to M, since that is where the first parameter is passed.
348 -- Restore integer registers from machine state. Note that we know
349 -- that $4 points to M since this is the standard calling sequence
353 Asm
(STOREI
& " $16, 16*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
354 Asm
(STOREI
& " $17, 17*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
355 Asm
(STOREI
& " $18, 18*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
356 Asm
(STOREI
& " $19, 19*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
357 Asm
(STOREI
& " $20, 20*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
358 Asm
(STOREI
& " $21, 21*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
359 Asm
(STOREI
& " $22, 22*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
360 Asm
(STOREI
& " $23, 23*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
361 Asm
(STOREI
& " $24, 24*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
362 Asm
(STOREI
& " $25, 25*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
363 Asm
(STOREI
& " $26, 26*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
364 Asm
(STOREI
& " $27, 27*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
365 Asm
(STOREI
& " $28, 28*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
366 Asm
(STOREI
& " $29, 29*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
367 Asm
(STOREI
& " $30, 30*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
368 Asm
(STOREI
& " $31, 31*8+" & Roff
& "+" & SC_Regs_Pos
& "($4)");
370 -- Restore floating-point registers from machine state
372 Asm
(STOREF
& " $f16, 16*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
373 Asm
(STOREF
& " $f17, 17*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
374 Asm
(STOREF
& " $f18, 18*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
375 Asm
(STOREF
& " $f19, 19*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
376 Asm
(STOREF
& " $f20, 20*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
377 Asm
(STOREF
& " $f21, 21*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
378 Asm
(STOREF
& " $f22, 22*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
379 Asm
(STOREF
& " $f23, 23*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
380 Asm
(STOREF
& " $f24, 24*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
381 Asm
(STOREF
& " $f25, 25*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
382 Asm
(STOREF
& " $f26, 26*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
383 Asm
(STOREF
& " $f27, 27*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
384 Asm
(STOREF
& " $f28, 28*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
385 Asm
(STOREF
& " $f29, 29*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
386 Asm
(STOREF
& " $f30, 30*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
387 Asm
(STOREF
& " $f31, 31*8+" & Roff
& "+" & SC_Fpregs_Pos
& "($4)");
389 -- Set the PC value for the context to a location after the
390 -- prolog has been executed.
392 Scp
:= To_Sigcontext_Ptr
(M
);
393 Scp
.SC_PC
:= Uns64
(To_Addr_Int
(Past_Prolog
'Address));
395 -- We saved the state *inside* this routine, but what we want is
396 -- the state at the call site. So we need to do one pop operation.
397 -- This pop operation will properly set the PC value in the machine
398 -- state, so there is no need to save PC in the above code.
400 Pop_Frame
(M
, Set_Machine_State
'Address);
401 end Set_Machine_State
;
403 ------------------------------
404 -- Set_Signal_Machine_State --
405 ------------------------------
407 procedure Set_Signal_Machine_State
409 Context
: System
.Address
) is
412 end Set_Signal_Machine_State
;
414 end System
.Machine_State_Operations
;