?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
2003-12-26 Guilhem Lavaux <guilhem@kaffe.org>
[official-gcc.git] / gcc / ada / 5gmastop.adb
blob7f6785cba12f54877af434337d94279a5db6060f
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- SYSTEM.MACHINE_STATE_OPERATIONS --
6 -- --
7 -- B o d y --
8 -- (Version for IRIX/MIPS) --
9 -- --
10 -- Copyright (C) 1999-2003 Free Software Foundation, Inc. --
11 -- --
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. --
22 -- --
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. --
29 -- --
30 -- GNAT was originally developed by the GNAT team at New York University. --
31 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 -- --
33 ------------------------------------------------------------------------------
34
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.
38
39 with System.Machine_Code; use System.Machine_Code;
40 with System.Memory;
41 with System.Soft_Links; use System.Soft_Links;
42 with Unchecked_Conversion;
43
44 package body System.Machine_State_Operations is
45
46 use System.Storage_Elements;
47 use System.Exceptions;
48
49 -- The exc_unwind function in libexc operats on a Sigcontext
50
51 -- Type sigcontext_t is defined in /usr/include/sys/signal.h.
52 -- We define an equivalent Ada type here. From the comments in
53 -- signal.h:
54
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
58
59 type Uns32 is mod 2 ** 32;
60 type Uns64 is mod 2 ** 64;
61
62 type Uns32_Ptr is access all Uns32;
63 type Uns64_Array is array (Integer range <>) of Uns64;
64
65 type Reg_Array is array (0 .. 31) of Uns64;
66
67 type Sigcontext is record
68 SC_Regmask : Uns32; -- 0
69 SC_Status : Uns32; -- 4
70 SC_PC : Uns64; -- 8
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);
86 end record;
87
88 type Sigcontext_Ptr is access all Sigcontext;
89
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.
94
95 function To_Sigcontext_Ptr is
96 new Unchecked_Conversion (Machine_State, Sigcontext_Ptr);
97
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.
102
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);
106
107 --------------------------------
108 -- ABI-Dependent Declarations --
109 --------------------------------
110
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.
115
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.
120
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.
127
128 procedure Update_GP (Scp : Sigcontext_Ptr);
129
130 ---------------
131 -- Update_GP --
132 ---------------
133
134 procedure Update_GP (Scp : Sigcontext_Ptr) is
135
136 type F_op is mod 2 ** 6;
137 type F_reg is mod 2 ** 5;
138 type F_imm is new Short_Integer;
139
140 type I_Type is record
141 op : F_op;
142 rs : F_reg;
143 rt : F_reg;
144 imm : F_imm;
145 end record;
146
147 pragma Pack (I_Type);
148 for I_Type'Size use 32;
149
150 type I_Type_Ptr is access all I_Type;
151
152 LW : constant F_op := 2#100011#;
153 Reg_GP : constant := 28;
154
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);
158
159 Ret_Ins : I_Type_Ptr := To_I_Type_Ptr (Address_Int (Scp.SC_PC));
160 GP_Ptr : Uns32_Ptr;
161
162 begin
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);
168 end if;
169 end Update_GP;
170
171 ----------------------------
172 -- Allocate_Machine_State --
173 ----------------------------
174
175 function Allocate_Machine_State return Machine_State is
176 begin
177 return Machine_State
178 (Memory.Alloc (Sigcontext'Max_Size_In_Storage_Elements));
179 end Allocate_Machine_State;
180
181 -------------------
182 -- Enter_Handler --
183 -------------------
184
185 procedure Enter_Handler (M : Machine_State; Handler : Handler_Loc) is
186 pragma Warnings (Off, M);
187 pragma Warnings (Off, Handler);
188
189 LOADI : constant String (1 .. 2) := 'l' & LSC;
190 -- This is "lw" in o32 mode, and "ld" in n32/n64 mode
191
192 LOADF : constant String (1 .. 4) := 'l' & LSC & "c1";
193 -- This is "lwc1" in o32 mode and "ldc1" in n32/n64 mode
194
195 begin
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
199
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)");
216
217 -- Restore floating-point registers from machine state
218
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)");
235
236 -- Jump directly to the handler
237
238 Asm ("jr $5");
239 end Enter_Handler;
240
241 ----------------
242 -- Fetch_Code --
243 ----------------
244
245 function Fetch_Code (Loc : Code_Loc) return Code_Loc is
246 begin
247 return Loc;
248 end Fetch_Code;
249
250 ------------------------
251 -- Free_Machine_State --
252 ------------------------
253
254 procedure Free_Machine_State (M : in out Machine_State) is
255 begin
256 Memory.Free (Address (M));
257 M := Machine_State (Null_Address);
258 end Free_Machine_State;
259
260 ------------------
261 -- Get_Code_Loc --
262 ------------------
263
264 function Get_Code_Loc (M : Machine_State) return Code_Loc is
265 SC : constant Sigcontext_Ptr := To_Sigcontext_Ptr (M);
266 begin
267 return To_Code_Loc (Addr_Int (SC.SC_PC));
268 end Get_Code_Loc;
269
270 --------------------------
271 -- Machine_State_Length --
272 --------------------------
273
274 function Machine_State_Length return Storage_Offset is
275 begin
276 return Sigcontext'Max_Size_In_Storage_Elements;
277 end Machine_State_Length;
278
279 ---------------
280 -- Pop_Frame --
281 ---------------
282
283 procedure Pop_Frame
284 (M : Machine_State;
285 Info : Subprogram_Info_Type)
286 is
287 pragma Warnings (Off, Info);
288
289 Scp : Sigcontext_Ptr := To_Sigcontext_Ptr (M);
290
291 procedure Exc_Unwind (Scp : Sigcontext_Ptr; Fde : Long_Integer := 0);
292 pragma Import (C, Exc_Unwind, "exc_unwind");
293 pragma Linker_Options ("-lexc");
294
295 begin
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.
300
301 Lock_Task.all;
302 Exc_Unwind (Scp);
303 Unlock_Task.all;
304
305 if Scp.SC_PC = 0 or else Scp.SC_PC = 1 then
306
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
309 -- indicate TOS.
310
311 Scp.SC_PC := 0;
312
313 else
314
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
318
319 if o32 = 1 then
320 Update_GP (Scp);
321 end if;
322
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.
330
331 Scp.SC_PC := Scp.SC_PC - 8;
332 end if;
333 end Pop_Frame;
334
335 -----------------------
336 -- Set_Machine_State --
337 -----------------------
338
339 procedure Set_Machine_State (M : Machine_State) is
340
341 STOREI : constant String (1 .. 2) := 's' & LSC;
342 -- This is "sw" in o32 mode, and "sd" in n32 mode
343
344 STOREF : constant String (1 .. 4) := 's' & LSC & "c1";
345 -- This is "swc1" in o32 mode and "sdc1" in n32 mode
346
347 Scp : Sigcontext_Ptr;
348
349 begin
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
354
355 <<Past_Prolog>>
356
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)");
373
374 -- Restore floating-point registers from machine state
375
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)");
392
393 -- Set the PC value for the context to a location after the
394 -- prolog has been executed.
395
396 Scp := To_Sigcontext_Ptr (M);
397 Scp.SC_PC := Uns64 (To_Addr_Int (Past_Prolog'Address));
398
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.
403
404 Pop_Frame (M, Set_Machine_State'Address);
405 end Set_Machine_State;
406
407 ------------------------------
408 -- Set_Signal_Machine_State --
409 ------------------------------
410
411 procedure Set_Signal_Machine_State
412 (M : Machine_State;
413 Context : System.Address)
414 is
415 pragma Warnings (Off, M);
416 pragma Warnings (Off, Context);
417
418 begin
419 null;
420 end Set_Signal_Machine_State;
421
422 end System.Machine_State_Operations;
Mirror of the offical gcc git repository hosted at gcc.gnu.org