?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Mark ChangeLog
[official-gcc.git] / gcc / ada / s-mastop-irix.adb
blobc6d1d90c0c8ced81265c1d727dd9c60f28c01d57
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-2004 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 Boolean := System.Word_Size = 32;
112 n32 : constant Boolean := System.Word_Size = 64;
113 o32n : constant Natural := Boolean'Pos (o32);
114 n32n : constant Natural := Boolean'Pos (n32);
115 -- Flags to indicate which ABI is in effect for this compilation. For the
116 -- purposes of this unit, the n32 and n64 ABI's are identical.
117
118 LSC : constant Character := Character'Val (o32n * Character'Pos ('w') +
119 n32n * Character'Pos ('d'));
120 -- This is 'w' for o32, and 'd' for n32/n64, used for constructing the
121 -- load/store instructions used to save/restore machine instructions.
122
123 Roff : constant Character := Character'Val (o32n * Character'Pos ('4') +
124 n32n * Character'Pos ('0'));
125 -- Offset from first byte of a __uint64 register save location where
126 -- the register value is stored. For n32/64 we store the entire 64
127 -- bit register into the uint64. For o32, only 32 bits are stored
128 -- at an offset of 4 bytes. This is used as part of expressions with
129 -- '+' signs on both sides, so a null offset has to be '0' and not ' '
130 -- to avoid assembler syntax errors on "X + + Y" in the latter case.
131
132 procedure Update_GP (Scp : Sigcontext_Ptr);
133
134 ---------------
135 -- Update_GP --
136 ---------------
137
138 procedure Update_GP (Scp : Sigcontext_Ptr) is
139
140 type F_op is mod 2 ** 6;
141 type F_reg is mod 2 ** 5;
142 type F_imm is new Short_Integer;
143
144 type I_Type is record
145 op : F_op;
146 rs : F_reg;
147 rt : F_reg;
148 imm : F_imm;
149 end record;
150
151 pragma Pack (I_Type);
152 for I_Type'Size use 32;
153
154 type I_Type_Ptr is access all I_Type;
155
156 LW : constant F_op := 2#100011#;
157 Reg_GP : constant := 28;
158
159 type Address_Int is mod 2 ** Standard'Address_Size;
160 function To_I_Type_Ptr is new
161 Unchecked_Conversion (Address_Int, I_Type_Ptr);
162
163 Ret_Ins : constant I_Type_Ptr := To_I_Type_Ptr (Address_Int (Scp.SC_PC));
164 GP_Ptr : Uns32_Ptr;
165
166 begin
167 if Ret_Ins.op = LW and then Ret_Ins.rt = Reg_GP then
168 GP_Ptr := To_Uns32_Ptr
169 (Addr_Int (Scp.SC_Regs (Integer (Ret_Ins.rs)))
170 + Addr_Int (Ret_Ins.imm));
171 Scp.SC_Regs (Reg_GP) := Uns64 (GP_Ptr.all);
172 end if;
173 end Update_GP;
174
175 ----------------------------
176 -- Allocate_Machine_State --
177 ----------------------------
178
179 function Allocate_Machine_State return Machine_State is
180 begin
181 return Machine_State
182 (Memory.Alloc (Sigcontext'Max_Size_In_Storage_Elements));
183 end Allocate_Machine_State;
184
185 -------------------
186 -- Enter_Handler --
187 -------------------
188
189 procedure Enter_Handler (M : Machine_State; Handler : Handler_Loc) is
190 pragma Warnings (Off, M);
191 pragma Warnings (Off, Handler);
192
193 LOADI : constant String (1 .. 2) := 'l' & LSC;
194 -- This is "lw" in o32 mode, and "ld" in n32/n64 mode
195
196 LOADF : constant String (1 .. 4) := 'l' & LSC & "c1";
197 -- This is "lwc1" in o32 mode and "ldc1" in n32/n64 mode
198
199 begin
200 -- Restore integer registers from machine state. Note that we know
201 -- that $4 points to M, and $5 points to Handler, since this is
202 -- the standard calling sequence
203
204 Asm (LOADI & " $16, 16*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
205 Asm (LOADI & " $17, 17*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
206 Asm (LOADI & " $18, 18*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
207 Asm (LOADI & " $19, 19*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
208 Asm (LOADI & " $20, 20*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
209 Asm (LOADI & " $21, 21*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
210 Asm (LOADI & " $22, 22*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
211 Asm (LOADI & " $23, 23*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
212 Asm (LOADI & " $24, 24*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
213 Asm (LOADI & " $25, 25*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
214 Asm (LOADI & " $26, 26*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
215 Asm (LOADI & " $27, 27*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
216 Asm (LOADI & " $28, 28*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
217 Asm (LOADI & " $29, 29*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
218 Asm (LOADI & " $30, 30*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
219 Asm (LOADI & " $31, 31*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
220
221 -- Restore floating-point registers from machine state
222
223 Asm (LOADF & " $f16, 16*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
224 Asm (LOADF & " $f17, 17*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
225 Asm (LOADF & " $f18, 18*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
226 Asm (LOADF & " $f19, 19*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
227 Asm (LOADF & " $f20, 20*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
228 Asm (LOADF & " $f21, 21*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
229 Asm (LOADF & " $f22, 22*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
230 Asm (LOADF & " $f23, 23*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
231 Asm (LOADF & " $f24, 24*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
232 Asm (LOADF & " $f25, 25*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
233 Asm (LOADF & " $f26, 26*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
234 Asm (LOADF & " $f27, 27*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
235 Asm (LOADF & " $f28, 28*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
236 Asm (LOADF & " $f29, 29*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
237 Asm (LOADF & " $f30, 30*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
238 Asm (LOADF & " $f31, 31*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
239
240 -- Jump directly to the handler
241
242 Asm ("jr $5");
243 end Enter_Handler;
244
245 ----------------
246 -- Fetch_Code --
247 ----------------
248
249 function Fetch_Code (Loc : Code_Loc) return Code_Loc is
250 begin
251 return Loc;
252 end Fetch_Code;
253
254 ------------------------
255 -- Free_Machine_State --
256 ------------------------
257
258 procedure Free_Machine_State (M : in out Machine_State) is
259 begin
260 Memory.Free (Address (M));
261 M := Machine_State (Null_Address);
262 end Free_Machine_State;
263
264 ------------------
265 -- Get_Code_Loc --
266 ------------------
267
268 function Get_Code_Loc (M : Machine_State) return Code_Loc is
269 SC : constant Sigcontext_Ptr := To_Sigcontext_Ptr (M);
270 begin
271 return To_Code_Loc (Addr_Int (SC.SC_PC));
272 end Get_Code_Loc;
273
274 --------------------------
275 -- Machine_State_Length --
276 --------------------------
277
278 function Machine_State_Length return Storage_Offset is
279 begin
280 return Sigcontext'Max_Size_In_Storage_Elements;
281 end Machine_State_Length;
282
283 ---------------
284 -- Pop_Frame --
285 ---------------
286
287 procedure Pop_Frame
288 (M : Machine_State;
289 Info : Subprogram_Info_Type)
290 is
291 pragma Warnings (Off, Info);
292
293 Scp : constant Sigcontext_Ptr := To_Sigcontext_Ptr (M);
294
295 procedure Exc_Unwind (Scp : Sigcontext_Ptr; Fde : Long_Integer := 0);
296 pragma Import (C, Exc_Unwind, "exc_unwind");
297
298 -- ??? Calling exc_unwind in the current setup does not work and
299 -- triggers the emission of system warning messages. Why it does
300 -- not work remains to be investigated. Part of the problem is
301 -- probably a section naming issue (e.g. .eh_frame/.debug_frame).
302
303 -- Instead of letting the call take place for nothing and emit
304 -- messages we don't expect, we just arrange things to pretend it
305 -- occurred and failed.
306
307 -- ??? Until this is fixed, we shall document that the backtrace
308 -- computation facility does not work, and we inhibit the pragma below
309 -- because we arrange for the call not to be emitted and the linker
310 -- complains when a library is linked in but resolves nothing.
311
312 -- pragma Linker_Options ("-lexc");
313
314 begin
315 -- exc_unwind is apparently not thread-safe under IRIX, so protect it
316 -- against race conditions within the GNAT run time.
317 -- ??? Note that we might want to use a fine grained lock here since
318 -- Lock_Task is used in many other places.
319
320 Lock_Task.all;
321
322 if False then
323 Exc_Unwind (Scp);
324 else
325 Scp.SC_PC := 0;
326 end if;
327
328 Unlock_Task.all;
329
330 if Scp.SC_PC = 0 or else Scp.SC_PC = 1 then
331
332 -- A return value of 0 or 1 means exc_unwind couldn't find a parent
333 -- frame. Propagate_Exception expects a zero return address to
334 -- indicate TOS.
335
336 Scp.SC_PC := 0;
337
338 else
339 -- Set the GP to restore to the caller value (not callee value)
340 -- This is done only in o32 mode. In n32/n64 mode, GP is a normal
341 -- callee save register
342
343 if o32 then
344 Update_GP (Scp);
345 end if;
346
347 -- Adjust the return address to the call site, not the
348 -- instruction following the branch delay slot. This may
349 -- be necessary if the last instruction of a pragma No_Return
350 -- subprogram is a call. The first instruction following the
351 -- delay slot may be the start of another subprogram. We back
352 -- off the address by 8, which points safely into the middle
353 -- of the generated subprogram code, avoiding end effects.
354
355 Scp.SC_PC := Scp.SC_PC - 8;
356 end if;
357 end Pop_Frame;
358
359 -----------------------
360 -- Set_Machine_State --
361 -----------------------
362
363 procedure Set_Machine_State (M : Machine_State) is
364
365 STOREI : constant String (1 .. 2) := 's' & LSC;
366 -- This is "sw" in o32 mode, and "sd" in n32 mode
367
368 STOREF : constant String (1 .. 4) := 's' & LSC & "c1";
369 -- This is "swc1" in o32 mode and "sdc1" in n32 mode
370
371 Scp : Sigcontext_Ptr;
372
373 begin
374 -- Save the integer registers. Note that we know that $4 points
375 -- to M, since that is where the first parameter is passed.
376 -- Restore integer registers from machine state. Note that we know
377 -- that $4 points to M since this is the standard calling sequence
378
379 <<Past_Prolog>>
380
381 Asm (STOREI & " $16, 16*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
382 Asm (STOREI & " $17, 17*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
383 Asm (STOREI & " $18, 18*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
384 Asm (STOREI & " $19, 19*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
385 Asm (STOREI & " $20, 20*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
386 Asm (STOREI & " $21, 21*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
387 Asm (STOREI & " $22, 22*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
388 Asm (STOREI & " $23, 23*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
389 Asm (STOREI & " $24, 24*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
390 Asm (STOREI & " $25, 25*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
391 Asm (STOREI & " $26, 26*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
392 Asm (STOREI & " $27, 27*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
393 Asm (STOREI & " $28, 28*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
394 Asm (STOREI & " $29, 29*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
395 Asm (STOREI & " $30, 30*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
396 Asm (STOREI & " $31, 31*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
397
398 -- Restore floating-point registers from machine state
399
400 Asm (STOREF & " $f16, 16*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
401 Asm (STOREF & " $f17, 17*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
402 Asm (STOREF & " $f18, 18*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
403 Asm (STOREF & " $f19, 19*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
404 Asm (STOREF & " $f20, 20*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
405 Asm (STOREF & " $f21, 21*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
406 Asm (STOREF & " $f22, 22*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
407 Asm (STOREF & " $f23, 23*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
408 Asm (STOREF & " $f24, 24*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
409 Asm (STOREF & " $f25, 25*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
410 Asm (STOREF & " $f26, 26*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
411 Asm (STOREF & " $f27, 27*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
412 Asm (STOREF & " $f28, 28*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
413 Asm (STOREF & " $f29, 29*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
414 Asm (STOREF & " $f30, 30*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
415 Asm (STOREF & " $f31, 31*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
416
417 -- Set the PC value for the context to a location after the
418 -- prolog has been executed.
419
420 Scp := To_Sigcontext_Ptr (M);
421 Scp.SC_PC := Uns64 (To_Addr_Int (Past_Prolog'Address));
422
423 -- We saved the state *inside* this routine, but what we want is
424 -- the state at the call site. So we need to do one pop operation.
425 -- This pop operation will properly set the PC value in the machine
426 -- state, so there is no need to save PC in the above code.
427
428 Pop_Frame (M, Set_Machine_State'Address);
429 end Set_Machine_State;
430
431 ------------------------------
432 -- Set_Signal_Machine_State --
433 ------------------------------
434
435 procedure Set_Signal_Machine_State
436 (M : Machine_State;
437 Context : System.Address)
438 is
439 pragma Warnings (Off, M);
440 pragma Warnings (Off, Context);
441
442 begin
443 null;
444 end Set_Signal_Machine_State;
445
446 end System.Machine_State_Operations;
Mirror of the offical gcc git repository hosted at gcc.gnu.org