Dead
[official-gcc.git] / gomp-20050608-branch / gcc / ada / tb-alvms.c
blob22fc540855d345265b32dad01d85ca3e45a1fc8f
1 /****************************************************************************
2 * *
3 * GNAT COMPILER COMPONENTS *
4 * *
5 * T R A C E B A C K - A l p h a / V M S *
6 * *
7 * C Implementation File *
8 * *
9 * Copyright (C) 2003-2005, AdaCore *
10 * *
11 * GNAT is free software; you can redistribute it and/or modify it under *
12 * terms of the GNU General Public License as published by the Free Soft- *
13 * ware Foundation; either version 2, or (at your option) any later ver- *
14 * sion. GNAT is distributed in the hope that it will be useful, but WITH- *
15 * OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
16 * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License *
17 * for more details. You should have received a copy of the GNU General *
18 * Public License distributed with GNAT; see file COPYING. If not, write *
19 * to the Free Software Foundation, 51 Franklin Street, Fifth Floor, *
20 * Boston, MA 02110-1301, USA. *
21 * *
22 * As a special exception, if you link this file with other files to *
23 * produce an executable, this file does not by itself cause the resulting *
24 * executable to be covered by the GNU General Public License. This except- *
25 * ion does not however invalidate any other reasons why the executable *
26 * file might be covered by the GNU Public License. *
27 * *
28 * GNAT was originally developed by the GNAT team at New York University. *
29 * Extensive contributions were provided by Ada Core Technologies Inc. *
30 * *
31 ****************************************************************************/
34 /* Alpha VMS requires a special treatment due to the complexity of the ABI.
35 What is here is along the lines of what the MD_FALLBACK_FRAME_STATE_FOR
36 macro does for frame unwinding during exception propagation. This file is
37 #included within tracebak.c in the appropriate case.
39 Most of the contents is directed by the OpenVMS/Alpha Conventions (ABI)
40 document, sections of which we will refer to as ABI-<section_number>. */
42 #include <vms/pdscdef.h>
43 #include <vms/libicb.h>
44 #include <vms/chfctxdef.h>
45 #include <vms/chfdef.h>
47 /* A couple of items missing from the header file included above. */
48 extern void * SYS$GL_CALL_HANDL;
49 #define PDSC$M_BASE_FRAME (1 << 10)
51 /* Registers are 64bit wide and addresses are 32bit wide on alpha-vms. */
52 typedef void * ADDR;
53 typedef unsigned long long REG;
55 #define REG_AT(addr) (*(REG *)(addr))
57 #define AS_REG(addr) ((REG)(unsigned long)(addr))
58 #define AS_ADDR(reg) ((ADDR)(unsigned long)(reg))
59 #define ADDR_IN(reg) (AS_ADDR(reg))
61 /* The following structure defines the state maintained during the
62 unwinding process. */
63 typedef struct
65 ADDR pc; /* Address of the call insn involved in the chain. */
66 ADDR sp; /* Stack Pointer at the time of this call. */
67 ADDR fp; /* Frame Pointer at the time of this call. */
69 /* The values above are fetched as saved REGisters on the stack. They are
70 typed ADDR because this is what the values in those registers are. */
72 /* Values of the registers saved by the functions in the chain,
73 incrementally updated through consecutive calls to the "unwind" function
74 below. */
75 REG saved_regs [32];
76 } frame_state_t;
78 /* Shortcuts for saved_regs of specific interest:
80 Frame Pointer is r29,
81 Stack Pointer is r30,
82 Return Address is r26,
83 Procedure Value is r27.
85 This is from ABI-3.1.1 [Integer Registers]. */
87 #define saved_fpr saved_regs[29]
88 #define saved_spr saved_regs[30]
89 #define saved_rar saved_regs[26]
90 #define saved_pvr saved_regs[27]
92 /* Special values for saved_rar, used to control the overall unwinding
93 process. */
94 #define RA_UNKNOWN ((REG)~0)
95 #define RA_STOP ((REG)0)
97 /* We still use a number of macros similar to the ones for the generic
98 __gnat_backtrace implementation. */
99 #define PC_ADJUST 4
100 #define STOP_FRAME (frame_state.saved_rar == RA_STOP)
102 /* Compute Procedure Value from Frame Pointer value. This follows the rules
103 in ABI-3.6.1 [Current Procedure]. */
104 #define PV_FOR(FP) \
105 (((FP) != 0) \
106 ? (((REG_AT (FP) & 0x7) == 0) ? *(PDSCDEF **)(FP) : (PDSCDEF *)(FP)) : 0)
109 /**********
110 * unwind *
111 **********/
113 /* Helper for __gnat_backtrace.
115 FS represents some call frame, identified by a pc and associated frame
116 pointer in FS->pc and FS->fp. FS->saved_regs contains the state of the
117 general registers upon entry in this frame. Of most interest in this set
118 are the saved return address and frame pointer registers, which actually
119 allow identifying the caller's frame.
121 This routine "unwinds" the input frame state by adjusting it to eventually
122 represent its caller's frame. The basic principle is to shift the fp and pc
123 saved values into the current state, and then compute the corresponding new
124 saved registers set.
126 If the call chain goes through a signal handler, special processing is
127 required when we process the kernel frame which has called the handler, to
128 switch it to the interrupted context frame. */
130 #define K_HANDLER_FRAME(fs) (PV_FOR ((fs)->fp) == SYS$GL_CALL_HANDL)
132 static void unwind_regular_code (frame_state_t * fs);
133 static void unwind_kernel_handler (frame_state_t * fs);
135 void
136 unwind (frame_state_t * fs)
138 /* Don't do anything if requested so. */
139 if (fs->saved_rar == RA_STOP)
140 return;
142 /* Retrieve the values of interest computed during the previous
143 call. PC_ADJUST gets us from the return address to the call insn
144 address. */
145 fs->pc = ADDR_IN (fs->saved_rar) - PC_ADJUST;
146 fs->sp = ADDR_IN (fs->saved_spr);
147 fs->fp = ADDR_IN (fs->saved_fpr);
149 /* Unless we are able to determine otherwise, set the frame state's
150 saved return address such that the unwinding process will stop. */
151 fs->saved_rar = RA_STOP;
153 /* Now we want to update fs->saved_regs to reflect the state of the caller
154 of the procedure described by pc/fp.
156 The condition to check for a special kernel frame which has called a
157 signal handler is stated in ABI-6.7.1 [Signaler's Registers] : "The frame
158 of the call to the handler can be identified by the return address of
159 SYS$CALL_HANDL+4". We use the equivalent procedure value identification
160 here because SYS$CALL_HANDL appears to be undefined. */
162 if (K_HANDLER_FRAME (fs))
163 unwind_kernel_handler (fs);
164 else
165 unwind_regular_code (fs);
168 /***********************
169 * unwind_regular_code *
170 ***********************/
172 /* Helper for unwind, for the case of unwinding through regular code which
173 is not a signal handler. */
175 static void
176 unwind_regular_code (frame_state_t * fs)
178 PDSCDEF * pv = PV_FOR (fs->fp);
180 ADDR frame_base;
182 /* Use the procedure value to unwind, in a way depending on the kind of
183 procedure at hand. See ABI-3.3 [Procedure Representation] and ABI-3.4
184 [Procedure Types]. */
186 if (pv == 0
187 || pv->pdsc$w_flags & PDSC$M_BASE_FRAME)
188 return;
190 frame_base
191 = (pv->pdsc$w_flags & PDSC$M_BASE_REG_IS_FP) ? fs->fp : fs->sp;
193 switch (pv->pdsc$w_flags & 0xf)
195 case PDSC$K_KIND_FP_STACK:
196 /* Stack Frame Procedure (ABI-3.4.1). Retrieve the necessary registers
197 from the Register Save Area in the frame. */
199 ADDR rsa_base = frame_base + pv->pdsc$w_rsa_offset;
200 int i, j;
202 fs->saved_rar = REG_AT (rsa_base);
203 fs->saved_pvr = REG_AT (frame_base);
205 for (i = 0, j = 0; i < 32; i++)
206 if (pv->pdsc$l_ireg_mask & (1 << i))
207 fs->saved_regs[i] = REG_AT (rsa_base + 8 * ++j);
209 /* Note that the loop above is guaranteed to set fs->saved_fpr,
210 because "The preserved register set must always include R29(FP)
211 since it will always be used." (ABI-3.4.3.4 [Register Save Area for
212 All Stack Frames]).
214 Also note that we need to run through all the registers to ensure
215 that unwinding through register procedures (see below) gets the
216 right values out of the saved_regs array. */
218 break;
220 case PDSC$K_KIND_FP_REGISTER:
221 /* Register Procedure (ABI-3.4.4). Retrieve the necessary registers from
222 the registers where they have been saved. */
224 fs->saved_rar = fs->saved_regs[pv->pdsc$b_save_ra];
225 fs->saved_fpr = fs->saved_regs[pv->pdsc$b_save_fp];
227 break;
229 default:
230 /* ??? Are we supposed to ever get here ? Don't think so. */
231 break;
234 /* SP is actually never part of the saved registers area, so we use the
235 corresponding entry in the saved_regs array to manually keep track of
236 it's evolution. */
237 fs->saved_spr = AS_REG (frame_base) + pv->pdsc$l_size;
240 /*************************
241 * unwind_kernel_handler *
242 *************************/
244 /* Helper for unwind, for the specific case of unwinding through a signal
245 handler.
247 The input frame state describes the kernel frame which has called a signal
248 handler. We fill the corresponding saved_regs to have it's "caller" frame
249 represented as the interrupted context. */
251 static void
252 unwind_kernel_handler (frame_state_t * fs)
254 PDSCDEF * pv = PV_FOR (fs->fp);
256 CHFDEF1 *sigargs;
257 CHFDEF2 *mechargs;
259 /* Retrieve the arguments passed to the handler, by way of a VMS service
260 providing the corresponding "Invocation Context Block". */
262 long handler_ivhandle;
263 INVO_CONTEXT_BLK handler_ivcb;
265 CHFCTX *chfctx;
267 handler_ivcb.libicb$q_ireg [29] = AS_REG (fs->fp);
268 handler_ivcb.libicb$q_ireg [30] = 0;
270 handler_ivhandle = LIB$GET_INVO_HANDLE (&handler_ivcb);
272 if ((LIB$GET_INVO_CONTEXT (handler_ivhandle, &handler_ivcb) & 1) != 1)
273 return;
275 chfctx = (CHFCTX *) AS_ADDR (handler_ivcb.libicb$ph_chfctx_addr);
277 sigargs = (CHFDEF1 *) AS_ADDR (chfctx->chfctx$q_sigarglst);
278 mechargs = (CHFDEF2 *) AS_ADDR (chfctx->chfctx$q_mcharglst);
281 /* Compute the saved return address as the PC of the instruction causing the
282 condition, accounting for the fact that it will be adjusted by the next
283 call to "unwind" as if it was an actual call return address. */
285 /* ABI-6.5.1.1 [Signal Argument Vector]: The signal occurrence address
286 is available from the sigargs argument to the handler, designed to
287 support both 32 and 64 bit addresses. The initial reference we get
288 is a pointer to the 32bit form, from which one may extract a pointer
289 to the 64bit version if need be. We work directly from the 32bit
290 form here. */
292 /* The sigargs vector structure for 32bits addresses is:
294 <......32bit......>
295 +-----------------+
296 | Vsize | :chf$is_sig_args
297 +-----------------+ -+-
298 | Condition Value | : [0]
299 +-----------------+ :
300 | ... | :
301 +-----------------+ : vector of Vsize entries
302 | Signal PC | :
303 +-----------------+ :
304 | PS | : [Vsize - 1]
305 +-----------------+ -+-
309 unsigned long * sigargs_vector
310 = ((unsigned long *) (&sigargs->chf$is_sig_args)) + 1;
312 long sigargs_vsize
313 = sigargs->chf$is_sig_args;
315 fs->saved_rar = (REG) sigargs_vector [sigargs_vsize - 2] + PC_ADJUST;
318 fs->saved_spr = RA_UNKNOWN;
319 fs->saved_fpr = (REG) mechargs->chf$q_mch_frame;
320 fs->saved_pvr = (REG) mechargs->chf$q_mch_savr27;
322 fs->saved_regs[16] = (REG) mechargs->chf$q_mch_savr16;
323 fs->saved_regs[17] = (REG) mechargs->chf$q_mch_savr17;
324 fs->saved_regs[18] = (REG) mechargs->chf$q_mch_savr18;
325 fs->saved_regs[19] = (REG) mechargs->chf$q_mch_savr19;
326 fs->saved_regs[20] = (REG) mechargs->chf$q_mch_savr20;
329 /* Structure representing a traceback entry in the tracebacks array to be
330 filled by __gnat_backtrace below.
332 !! This should match what is in System.Traceback_Entries, so beware of
333 !! the REG/ADDR difference here.
335 The use of a structure is motivated by the potential necessity of having
336 several fields to fill for each entry, for instance if later calls to VMS
337 system functions need more than just a mere PC to compute info on a frame
338 (e.g. for non-symbolic->symbolic translation purposes). */
339 typedef struct {
340 ADDR pc;
341 ADDR pv;
342 } tb_entry_t;
344 /********************
345 * __gnat_backtrace *
346 ********************/
349 __gnat_backtrace (void **array, int size,
350 void *exclude_min, void *exclude_max, int skip_frames)
352 int cnt;
354 tb_entry_t * tbe = (tb_entry_t *)&array [0];
356 frame_state_t frame_state;
358 /* Setup the frame state before initiating the unwinding sequence. */
359 register REG this_FP __asm__("$29");
360 register REG this_SP __asm__("$30");
362 frame_state.saved_fpr = this_FP;
363 frame_state.saved_spr = this_SP;
364 frame_state.saved_rar = RA_UNKNOWN;
366 unwind (&frame_state);
368 /* At this point frame_state describes this very function. Skip the
369 requested number of calls. */
370 for (cnt = 0; cnt < skip_frames; cnt ++)
371 unwind (&frame_state);
373 /* Now consider each frame as a potential candidate for insertion inside
374 the provided array. */
375 cnt = 0;
376 while (cnt < size)
378 PDSCDEF * pv = PV_FOR (frame_state.fp);
380 /* Stop if either the frame contents or the unwinder say so. */
381 if (STOP_FRAME)
382 break;
384 if (! K_HANDLER_FRAME (&frame_state)
385 && (frame_state.pc < exclude_min || frame_state.pc > exclude_max))
387 tbe->pc = (ADDR) frame_state.pc;
388 tbe->pv = (ADDR) PV_FOR (frame_state.fp);
390 cnt ++;
391 tbe ++;
394 unwind (&frame_state);
397 return cnt;