?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Add hppa-openbsd target
[official-gcc.git] / gcc / ada / 5gmastop.adb
blob74935273fe65c49afdbe5aa350bce61b0966310a
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 -- --
11 -- Copyright (C) 1999-2001 Free Software Foundation, Inc. --
12 -- --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
23 -- --
24 -- As a special exception, if other files instantiate generics from this --
25 -- unit, or you link this unit with other files to produce an executable, --
26 -- this unit does not by itself cause the resulting executable to be --
27 -- covered by the GNU General Public License. This exception does not --
28 -- however invalidate any other reasons why the executable file might be --
29 -- covered by the GNU Public License. --
30 -- --
31 -- GNAT was originally developed by the GNAT team at New York University. --
32 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
33 -- --
34 ------------------------------------------------------------------------------
35
36 -- This version of Ada.Exceptions.Machine_State_Operations is for use on
37 -- SGI Irix systems. By means of compile time conditional calculations, it
38 -- can handle both n32/n64 and o32 modes.
39
40 with System.Machine_Code; use System.Machine_Code;
41 with System.Memory;
42 with System.Soft_Links; use System.Soft_Links;
43 with Unchecked_Conversion;
44
45 package body System.Machine_State_Operations is
46
47 use System.Storage_Elements;
48 use System.Exceptions;
49
50 -- The exc_unwind function in libexc operats on a Sigcontext
51
52 -- Type sigcontext_t is defined in /usr/include/sys/signal.h.
53 -- We define an equivalent Ada type here. From the comments in
54 -- signal.h:
55
56 -- sigcontext is not part of the ABI - so this version is used to
57 -- handle 32 and 64 bit applications - it is a constant size regardless
58 -- of compilation mode, and always returns 64 bit register values
59
60 type Uns32 is mod 2 ** 32;
61 type Uns64 is mod 2 ** 64;
62
63 type Uns32_Ptr is access all Uns32;
64 type Uns64_Array is array (Integer range <>) of Uns64;
65
66 type Reg_Array is array (0 .. 31) of Uns64;
67
68 type Sigcontext is record
69 SC_Regmask : Uns32; -- 0
70 SC_Status : Uns32; -- 4
71 SC_PC : Uns64; -- 8
72 SC_Regs : Reg_Array; -- 16
73 SC_Fpregs : Reg_Array; -- 272
74 SC_Ownedfp : Uns32; -- 528
75 SC_Fpc_Csr : Uns32; -- 532
76 SC_Fpc_Eir : Uns32; -- 536
77 SC_Ssflags : Uns32; -- 540
78 SC_Mdhi : Uns64; -- 544
79 SC_Mdlo : Uns64; -- 552
80 SC_Cause : Uns64; -- 560
81 SC_Badvaddr : Uns64; -- 568
82 SC_Triggersave : Uns64; -- 576
83 SC_Sigset : Uns64; -- 584
84 SC_Fp_Rounded_Result : Uns64; -- 592
85 SC_Pancake : Uns64_Array (0 .. 5);
86 SC_Pad : Uns64_Array (0 .. 26);
87 end record;
88
89 type Sigcontext_Ptr is access all Sigcontext;
90
91 SC_Regs_Pos : constant String := "16";
92 SC_Fpregs_Pos : constant String := "272";
93 -- Byte offset of the Integer and Floating Point register save areas
94 -- within the Sigcontext.
95
96 function To_Sigcontext_Ptr is
97 new Unchecked_Conversion (Machine_State, Sigcontext_Ptr);
98
99 type Addr_Int is mod 2 ** Long_Integer'Size;
100 -- An unsigned integer type whose size is the same as System.Address.
101 -- We rely on the fact that Long_Integer'Size = System.Address'Size in
102 -- all ABIs. Type Addr_Int can be converted to Uns64.
103
104 function To_Code_Loc is new Unchecked_Conversion (Addr_Int, Code_Loc);
105 function To_Addr_Int is new Unchecked_Conversion (System.Address, Addr_Int);
106 function To_Uns32_Ptr is new Unchecked_Conversion (Addr_Int, Uns32_Ptr);
107
108 --------------------------------
109 -- ABI-Dependent Declarations --
110 --------------------------------
111
112 o32 : constant Natural := Boolean'Pos (System.Word_Size = 32);
113 n32 : constant Natural := Boolean'Pos (System.Word_Size = 64);
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.
116
117 LSC : constant Character := Character'Val (o32 * Character'Pos ('w') +
118 n32 * 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.
121
122 Roff : constant Character := Character'Val (o32 * Character'Pos ('4') +
123 n32 * Character'Pos (' '));
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.
128
129 procedure Update_GP (Scp : Sigcontext_Ptr);
130
131 ---------------
132 -- Update_GP --
133 ---------------
134
135 procedure Update_GP (Scp : Sigcontext_Ptr) is
136
137 type F_op is mod 2 ** 6;
138 type F_reg is mod 2 ** 5;
139 type F_imm is new Short_Integer;
140
141 type I_Type is record
142 op : F_op;
143 rs : F_reg;
144 rt : F_reg;
145 imm : F_imm;
146 end record;
147
148 pragma Pack (I_Type);
149 for I_Type'Size use 32;
150
151 type I_Type_Ptr is access all I_Type;
152
153 LW : constant F_op := 2#100011#;
154 Reg_GP : constant := 28;
155
156 type Address_Int is mod 2 ** Standard'Address_Size;
157 function To_I_Type_Ptr is new
158 Unchecked_Conversion (Address_Int, I_Type_Ptr);
159
160 Ret_Ins : I_Type_Ptr := To_I_Type_Ptr (Address_Int (Scp.SC_PC));
161 GP_Ptr : Uns32_Ptr;
162
163 begin
164 if Ret_Ins.op = LW and then Ret_Ins.rt = Reg_GP then
165 GP_Ptr := To_Uns32_Ptr
166 (Addr_Int (Scp.SC_Regs (Integer (Ret_Ins.rs)))
167 + Addr_Int (Ret_Ins.imm));
168 Scp.SC_Regs (Reg_GP) := Uns64 (GP_Ptr.all);
169 end if;
170 end Update_GP;
171
172 ----------------------------
173 -- Allocate_Machine_State --
174 ----------------------------
175
176 function Allocate_Machine_State return Machine_State is
177 begin
178 return Machine_State
179 (Memory.Alloc (Sigcontext'Max_Size_In_Storage_Elements));
180 end Allocate_Machine_State;
181
182 -------------------
183 -- Enter_Handler --
184 -------------------
185
186 procedure Enter_Handler (M : Machine_State; Handler : Handler_Loc) is
187
188 LOADI : constant String (1 .. 2) := 'l' & LSC;
189 -- This is "lw" in o32 mode, and "ld" in n32/n64 mode
190
191 LOADF : constant String (1 .. 4) := 'l' & LSC & "c1";
192 -- This is "lwc1" in o32 mode and "ldc1" in n32/n64 mode
193
194 begin
195 -- Restore integer registers from machine state. Note that we know
196 -- that $4 points to M, and $5 points to Handler, since this is
197 -- the standard calling sequence
198
199 Asm (LOADI & " $16, 16*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
200 Asm (LOADI & " $17, 17*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
201 Asm (LOADI & " $18, 18*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
202 Asm (LOADI & " $19, 19*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
203 Asm (LOADI & " $20, 20*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
204 Asm (LOADI & " $21, 21*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
205 Asm (LOADI & " $22, 22*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
206 Asm (LOADI & " $23, 23*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
207 Asm (LOADI & " $24, 24*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
208 Asm (LOADI & " $25, 25*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
209 Asm (LOADI & " $26, 26*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
210 Asm (LOADI & " $27, 27*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
211 Asm (LOADI & " $28, 28*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
212 Asm (LOADI & " $29, 29*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
213 Asm (LOADI & " $30, 30*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
214 Asm (LOADI & " $31, 31*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
215
216 -- Restore floating-point registers from machine state
217
218 Asm (LOADF & " $f16, 16*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
219 Asm (LOADF & " $f17, 17*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
220 Asm (LOADF & " $f18, 18*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
221 Asm (LOADF & " $f19, 19*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
222 Asm (LOADF & " $f20, 20*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
223 Asm (LOADF & " $f21, 21*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
224 Asm (LOADF & " $f22, 22*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
225 Asm (LOADF & " $f23, 23*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
226 Asm (LOADF & " $f24, 24*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
227 Asm (LOADF & " $f25, 25*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
228 Asm (LOADF & " $f26, 26*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
229 Asm (LOADF & " $f27, 27*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
230 Asm (LOADF & " $f28, 28*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
231 Asm (LOADF & " $f29, 29*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
232 Asm (LOADF & " $f30, 30*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
233 Asm (LOADF & " $f31, 31*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
234
235 -- Jump directly to the handler
236
237 Asm ("jr $5");
238 end Enter_Handler;
239
240 ----------------
241 -- Fetch_Code --
242 ----------------
243
244 function Fetch_Code (Loc : Code_Loc) return Code_Loc is
245 begin
246 return Loc;
247 end Fetch_Code;
248
249 ------------------------
250 -- Free_Machine_State --
251 ------------------------
252
253 procedure Free_Machine_State (M : in out Machine_State) is
254 begin
255 Memory.Free (Address (M));
256 M := Machine_State (Null_Address);
257 end Free_Machine_State;
258
259 ------------------
260 -- Get_Code_Loc --
261 ------------------
262
263 function Get_Code_Loc (M : Machine_State) return Code_Loc is
264 SC : constant Sigcontext_Ptr := To_Sigcontext_Ptr (M);
265 begin
266 return To_Code_Loc (Addr_Int (SC.SC_PC));
267 end Get_Code_Loc;
268
269 --------------------------
270 -- Machine_State_Length --
271 --------------------------
272
273 function Machine_State_Length return Storage_Offset is
274 begin
275 return Sigcontext'Max_Size_In_Storage_Elements;
276 end Machine_State_Length;
277
278 ---------------
279 -- Pop_Frame --
280 ---------------
281
282 procedure Pop_Frame
283 (M : Machine_State;
284 Info : Subprogram_Info_Type)
285 is
286 Scp : Sigcontext_Ptr := To_Sigcontext_Ptr (M);
287
288 procedure Exc_Unwind (Scp : Sigcontext_Ptr; Fde : Long_Integer := 0);
289 pragma Import (C, Exc_Unwind, "exc_unwind");
290 pragma Linker_Options ("-lexc");
291
292 begin
293 -- exc_unwind is apparently not thread-safe under IRIX, so protect it
294 -- against race conditions within the GNAT run time.
295 -- ??? Note that we might want to use a fine grained lock here since
296 -- Lock_Task is used in many other places.
297
298 Lock_Task.all;
299 Exc_Unwind (Scp);
300 Unlock_Task.all;
301
302 if Scp.SC_PC = 0 or else Scp.SC_PC = 1 then
303
304 -- A return value of 0 or 1 means exc_unwind couldn't find a parent
305 -- frame. Propagate_Exception expects a zero return address to
306 -- indicate TOS.
307
308 Scp.SC_PC := 0;
309
310 else
311
312 -- Set the GP to restore to the caller value (not callee value)
313 -- This is done only in o32 mode. In n32/n64 mode, GP is a normal
314 -- callee save register
315
316 if o32 = 1 then
317 Update_GP (Scp);
318 end if;
319
320 -- Adjust the return address to the call site, not the
321 -- instruction following the branch delay slot. This may
322 -- be necessary if the last instruction of a pragma No_Return
323 -- subprogram is a call. The first instruction following the
324 -- delay slot may be the start of another subprogram. We back
325 -- off the address by 8, which points safely into the middle
326 -- of the generated subprogram code, avoiding end effects.
327
328 Scp.SC_PC := Scp.SC_PC - 8;
329 end if;
330 end Pop_Frame;
331
332 -----------------------
333 -- Set_Machine_State --
334 -----------------------
335
336 procedure Set_Machine_State (M : Machine_State) is
337
338 STOREI : constant String (1 .. 2) := 's' & LSC;
339 -- This is "sw" in o32 mode, and "sd" in n32 mode
340
341 STOREF : constant String (1 .. 4) := 's' & LSC & "c1";
342 -- This is "swc1" in o32 mode and "sdc1" in n32 mode
343
344 Scp : Sigcontext_Ptr;
345
346 begin
347 -- Save the integer registers. Note that we know that $4 points
348 -- to M, since that is where the first parameter is passed.
349 -- Restore integer registers from machine state. Note that we know
350 -- that $4 points to M since this is the standard calling sequence
351
352 <<Past_Prolog>>
353
354 Asm (STOREI & " $16, 16*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
355 Asm (STOREI & " $17, 17*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
356 Asm (STOREI & " $18, 18*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
357 Asm (STOREI & " $19, 19*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
358 Asm (STOREI & " $20, 20*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
359 Asm (STOREI & " $21, 21*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
360 Asm (STOREI & " $22, 22*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
361 Asm (STOREI & " $23, 23*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
362 Asm (STOREI & " $24, 24*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
363 Asm (STOREI & " $25, 25*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
364 Asm (STOREI & " $26, 26*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
365 Asm (STOREI & " $27, 27*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
366 Asm (STOREI & " $28, 28*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
367 Asm (STOREI & " $29, 29*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
368 Asm (STOREI & " $30, 30*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
369 Asm (STOREI & " $31, 31*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
370
371 -- Restore floating-point registers from machine state
372
373 Asm (STOREF & " $f16, 16*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
374 Asm (STOREF & " $f17, 17*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
375 Asm (STOREF & " $f18, 18*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
376 Asm (STOREF & " $f19, 19*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
377 Asm (STOREF & " $f20, 20*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
378 Asm (STOREF & " $f21, 21*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
379 Asm (STOREF & " $f22, 22*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
380 Asm (STOREF & " $f23, 23*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
381 Asm (STOREF & " $f24, 24*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
382 Asm (STOREF & " $f25, 25*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
383 Asm (STOREF & " $f26, 26*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
384 Asm (STOREF & " $f27, 27*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
385 Asm (STOREF & " $f28, 28*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
386 Asm (STOREF & " $f29, 29*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
387 Asm (STOREF & " $f30, 30*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
388 Asm (STOREF & " $f31, 31*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
389
390 -- Set the PC value for the context to a location after the
391 -- prolog has been executed.
392
393 Scp := To_Sigcontext_Ptr (M);
394 Scp.SC_PC := Uns64 (To_Addr_Int (Past_Prolog'Address));
395
396 -- We saved the state *inside* this routine, but what we want is
397 -- the state at the call site. So we need to do one pop operation.
398 -- This pop operation will properly set the PC value in the machine
399 -- state, so there is no need to save PC in the above code.
400
401 Pop_Frame (M, Set_Machine_State'Address);
402 end Set_Machine_State;
403
404 ------------------------------
405 -- Set_Signal_Machine_State --
406 ------------------------------
407
408 procedure Set_Signal_Machine_State
409 (M : Machine_State;
410 Context : System.Address) is
411 begin
412 null;
413 end Set_Signal_Machine_State;
414
415 end System.Machine_State_Operations;
Mirror of the offical gcc git repository hosted at gcc.gnu.org