summaryrefslogtreecommitdiff
path: root/gcc/ada/tb-alvms.c
blob: d69128b92718c8114dde3210331ca2bb764b21c4 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
/****************************************************************************
 *                                                                          *
 *                         GNAT COMPILER COMPONENTS                         *
 *                                                                          *
 *                   T R A C E B A C K - A l p h a / V M S                  *
 *                                                                          *
 *                          C Implementation File                           *
 *                                                                          *
 *                     Copyright (C) 2003-2007, AdaCore                     *
 *                                                                          *
 * GNAT is free software;  you can  redistribute it  and/or modify it under *
 * terms of the  GNU General Public License as published  by the Free Soft- *
 * ware  Foundation;  either version 2,  or (at your option) any later ver- *
 * sion.  GNAT is distributed in the hope that it will be useful, but WITH- *
 * OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY *
 * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
 * for  more details.  You should have  received  a copy of the GNU General *
 * Public License  distributed with GNAT;  see file COPYING.  If not, write *
 * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
 * Boston, MA 02110-1301, USA.                                              *
 *                                                                          *
 * As a  special  exception,  if you  link  this file  with other  files to *
 * produce an executable,  this file does not by itself cause the resulting *
 * executable to be covered by the GNU General Public License. This except- *
 * ion does not  however invalidate  any other reasons  why the  executable *
 * file might be covered by the  GNU Public License.                        *
 *                                                                          *
 * GNAT was originally developed  by the GNAT team at  New York University. *
 * Extensive contributions were provided by Ada Core Technologies Inc.      *
 *                                                                          *
 ****************************************************************************/


/* Alpha VMS requires a special treatment due to the complexity of the ABI.
   What is here is along the lines of what the MD_FALLBACK_FRAME_STATE_FOR
   macro does for frame unwinding during exception propagation. This file is
   #included within tracebak.c in the appropriate case.

   Most of the contents is directed by the OpenVMS/Alpha Conventions (ABI)
   document, sections of which we will refer to as ABI-<section_number>.  */

#include <vms/pdscdef.h>
#include <vms/libicb.h>
#include <vms/chfctxdef.h>
#include <vms/chfdef.h>

/* A couple of items missing from the header file included above.  */
extern void * SYS$GL_CALL_HANDL;
#define PDSC$M_BASE_FRAME (1 << 10)

/* Registers are 64bit wide and addresses are 32bit wide on alpha-vms.  */
typedef void * ADDR;
typedef unsigned long long REG;

#define REG_AT(addr) (*(REG *)(addr))

#define AS_REG(addr) ((REG)(unsigned long)(addr))
#define AS_ADDR(reg) ((ADDR)(unsigned long)(reg))
#define ADDR_IN(reg) (AS_ADDR(reg))

/* The following structure defines the state maintained during the
   unwinding process.  */
typedef struct
{
  ADDR pc;  /* Address of the call insn involved in the chain.  */
  ADDR sp;  /* Stack Pointer at the time of this call.  */
  ADDR fp;  /* Frame Pointer at the time of this call.  */

  /* The values above are fetched as saved REGisters on the stack. They are
     typed ADDR because this is what the values in those registers are.  */

  /* Values of the registers saved by the functions in the chain,
     incrementally updated through consecutive calls to the "unwind" function
     below.  */
  REG saved_regs [32];
} frame_state_t;

/* Shortcuts for saved_regs of specific interest:

   Frame Pointer   is r29,
   Stack Pointer   is r30,
   Return Address  is r26,
   Procedure Value is r27.

   This is from ABI-3.1.1 [Integer Registers].  */

#define saved_fpr saved_regs[29]
#define saved_spr saved_regs[30]
#define saved_rar saved_regs[26]
#define saved_pvr saved_regs[27]

/* Special values for saved_rar, used to control the overall unwinding
   process.  */
#define RA_UNKNOWN ((REG)~0)
#define RA_STOP    ((REG)0)

/* We still use a number of macros similar to the ones for the generic
   __gnat_backtrace implementation.  */
#define PC_ADJUST 4
#define STOP_FRAME (frame_state.saved_rar == RA_STOP)

/* Compute Procedure Value from Frame Pointer value.  This follows the rules
   in ABI-3.6.1 [Current Procedure].  */
#define PV_FOR(FP) \
  (((FP) != 0) \
    ? (((REG_AT (FP) & 0x7) == 0) ? *(PDSCDEF **)(FP) : (PDSCDEF *)(FP)) : 0)


/**********
 * unwind *
 **********/

/* Helper for __gnat_backtrace.

   FS represents some call frame, identified by a pc and associated frame
   pointer in FS->pc and FS->fp. FS->saved_regs contains the state of the
   general registers upon entry in this frame. Of most interest in this set
   are the saved return address and frame pointer registers, which actually
   allow identifying the caller's frame.

   This routine "unwinds" the input frame state by adjusting it to eventually
   represent its caller's frame. The basic principle is to shift the fp and pc
   saved values into the current state, and then compute the corresponding new
   saved registers set.

   If the call chain goes through a signal handler, special processing is
   required when we process the kernel frame which has called the handler, to
   switch it to the interrupted context frame.  */

#define K_HANDLER_FRAME(fs) (PV_FOR ((fs)->fp) == SYS$GL_CALL_HANDL)

static void unwind_regular_code (frame_state_t * fs);
static void unwind_kernel_handler (frame_state_t * fs);

void
unwind (frame_state_t * fs)
{
  /* Don't do anything if requested so.  */
  if (fs->saved_rar == RA_STOP)
    return;

  /* Retrieve the values of interest computed during the previous
     call. PC_ADJUST gets us from the return address to the call insn
     address.  */
  fs->pc = ADDR_IN (fs->saved_rar) - PC_ADJUST;
  fs->sp = ADDR_IN (fs->saved_spr);
  fs->fp = ADDR_IN (fs->saved_fpr);

  /* Unless we are able to determine otherwise, set the frame state's
     saved return address such that the unwinding process will stop.  */
  fs->saved_rar = RA_STOP;

  /* Now we want to update fs->saved_regs to reflect the state of the caller
     of the procedure described by pc/fp.

     The condition to check for a special kernel frame which has called a
     signal handler is stated in ABI-6.7.1 [Signaler's Registers] : "The frame
     of the call to the handler can be identified by the return address of
     SYS$CALL_HANDL+4". We use the equivalent procedure value identification
     here because SYS$CALL_HANDL appears to be undefined. */

  if (K_HANDLER_FRAME (fs))
    unwind_kernel_handler (fs);
  else
    unwind_regular_code (fs);
}

/***********************
 * unwind_regular_code *
 ***********************/

/* Helper for unwind, for the case of unwinding through regular code which
   is not a signal handler.  */

static void
unwind_regular_code (frame_state_t * fs)
{
  PDSCDEF * pv = PV_FOR (fs->fp);

  ADDR frame_base;

  /* Use the procedure value to unwind, in a way depending on the kind of
     procedure at hand. See ABI-3.3 [Procedure Representation] and ABI-3.4
     [Procedure Types].  */

  if (pv == 0
      || pv->pdsc$w_flags & PDSC$M_BASE_FRAME)
    return;

  frame_base
    = (pv->pdsc$w_flags & PDSC$M_BASE_REG_IS_FP) ? fs->fp : fs->sp;

  switch (pv->pdsc$w_flags & 0xf)
    {
    case PDSC$K_KIND_FP_STACK:
      /* Stack Frame Procedure (ABI-3.4.1). Retrieve the necessary registers
	 from the Register Save Area in the frame.  */
      {
	ADDR rsa_base = frame_base + pv->pdsc$w_rsa_offset;
	int i, j;

	fs->saved_rar = REG_AT (rsa_base);
	fs->saved_pvr = REG_AT (frame_base);

	for (i = 0, j = 0; i < 32; i++)
	  if (pv->pdsc$l_ireg_mask & (1 << i))
	    fs->saved_regs[i] = REG_AT (rsa_base + 8 * ++j);

	/* Note that the loop above is guaranteed to set fs->saved_fpr,
	   because "The preserved register set must always include R29(FP)
	   since it will always be used." (ABI-3.4.3.4 [Register Save Area for
	   All Stack Frames]).

	   Also note that we need to run through all the registers to ensure
	   that unwinding through register procedures (see below) gets the
	   right values out of the saved_regs array.  */
      }
      break;

    case PDSC$K_KIND_FP_REGISTER:
      /* Register Procedure (ABI-3.4.4). Retrieve the necessary registers from
	 the registers where they have been saved.  */
      {
	fs->saved_rar = fs->saved_regs[pv->pdsc$b_save_ra];
	fs->saved_fpr = fs->saved_regs[pv->pdsc$b_save_fp];
      }
      break;

    default:
      /* ??? Are we supposed to ever get here ?  Don't think so.  */
      break;
    }

  /* SP is actually never part of the saved registers area, so we use the
     corresponding entry in the saved_regs array to manually keep track of
     it's evolution.  */
  fs->saved_spr = AS_REG (frame_base) + pv->pdsc$l_size;
}

/*************************
 * unwind_kernel_handler *
 *************************/

/* Helper for unwind, for the specific case of unwinding through a signal
   handler.

   The input frame state describes the kernel frame which has called a signal
   handler. We fill the corresponding saved_regs to have it's "caller" frame
   represented as the interrupted context.  */

static void
unwind_kernel_handler (frame_state_t * fs)
{
  PDSCDEF * pv = PV_FOR (fs->fp);

  CHFDEF1 *sigargs;
  CHFDEF2 *mechargs;

  /* Retrieve the arguments passed to the handler, by way of a VMS service
     providing the corresponding "Invocation Context Block".  */
  {
    long handler_ivhandle;
    INVO_CONTEXT_BLK handler_ivcb;

    CHFCTX *chfctx;

    handler_ivcb.libicb$q_ireg [29] = AS_REG (fs->fp);
    handler_ivcb.libicb$q_ireg [30] = 0;

    handler_ivhandle = LIB$GET_INVO_HANDLE (&handler_ivcb);

    if ((LIB$GET_INVO_CONTEXT (handler_ivhandle, &handler_ivcb) & 1) != 1)
      return;

    chfctx = (CHFCTX *) AS_ADDR (handler_ivcb.libicb$ph_chfctx_addr);

    sigargs = (CHFDEF1 *) AS_ADDR (chfctx->chfctx$q_sigarglst);
    mechargs = (CHFDEF2 *) AS_ADDR (chfctx->chfctx$q_mcharglst);
  }

  /* Compute the saved return address as the PC of the instruction causing the
     condition, accounting for the fact that it will be adjusted by the next
     call to "unwind" as if it was an actual call return address.  */
  {
    /* ABI-6.5.1.1 [Signal Argument Vector]: The signal occurrence address
       is available from the sigargs argument to the handler, designed to
       support both 32 and 64 bit addresses.  The initial reference we get
       is a pointer to the 32bit form, from which one may extract a pointer
       to the 64bit version if need be.  We work directly from the 32bit
       form here.  */

    /* The sigargs vector structure for 32bits addresses is:

       <......32bit......>
       +-----------------+
       |      Vsize      | :chf$is_sig_args
       +-----------------+ -+-
       | Condition Value |  : [0]
       +-----------------+  :
       |       ...       |  :
       +-----------------+  : vector of Vsize entries
       |    Signal PC    |  :
       +-----------------+  :
       |       PS        |  : [Vsize - 1]
       +-----------------+ -+-

       */

    unsigned long * sigargs_vector
      = ((unsigned long *) (&sigargs->chf$is_sig_args)) + 1;

    long sigargs_vsize
      = sigargs->chf$is_sig_args;

    fs->saved_rar = (REG) sigargs_vector [sigargs_vsize - 2] + PC_ADJUST;
  }

  fs->saved_spr = RA_UNKNOWN;
  fs->saved_fpr = (REG) mechargs->chf$q_mch_frame;
  fs->saved_pvr = (REG) mechargs->chf$q_mch_savr27;

  fs->saved_regs[16] = (REG) mechargs->chf$q_mch_savr16;
  fs->saved_regs[17] = (REG) mechargs->chf$q_mch_savr17;
  fs->saved_regs[18] = (REG) mechargs->chf$q_mch_savr18;
  fs->saved_regs[19] = (REG) mechargs->chf$q_mch_savr19;
  fs->saved_regs[20] = (REG) mechargs->chf$q_mch_savr20;
}

/* Structure representing a traceback entry in the tracebacks array to be
   filled by __gnat_backtrace below.

   !! This should match what is in System.Traceback_Entries, so beware of
   !! the REG/ADDR difference here.

   The use of a structure is motivated by the potential necessity of having
   several fields to fill for each entry, for instance if later calls to VMS
   system functions need more than just a mere PC to compute info on a frame
   (e.g. for non-symbolic->symbolic translation purposes).  */
typedef struct {
  ADDR pc;  /* Program Counter.  */
  ADDR pv;  /* Procedure Value.  */
} tb_entry_t;

/********************
 * __gnat_backtrace *
 ********************/

int
__gnat_backtrace (void **array, int size,
                  void *exclude_min, void *exclude_max, int skip_frames)
{
  int cnt;

  tb_entry_t * tbe = (tb_entry_t *)&array [0];

  frame_state_t frame_state;

  /* Setup the frame state before initiating the unwinding sequence.  */
  register REG this_FP __asm__("$29");
  register REG this_SP __asm__("$30");

  frame_state.saved_fpr = this_FP;
  frame_state.saved_spr = this_SP;
  frame_state.saved_rar = RA_UNKNOWN;

  unwind (&frame_state);

  /* At this point frame_state describes this very function. Skip the
     requested number of calls.  */
  for (cnt = 0; cnt < skip_frames; cnt ++)
    unwind (&frame_state);

  /* Now consider each frame as a potential candidate for insertion inside
     the provided array.  */
  cnt = 0;
  while (cnt < size)
    {
      /* Stop if either the frame contents or the unwinder say so.  */
      if (STOP_FRAME)
        break;

      if (! K_HANDLER_FRAME (&frame_state)
	  && (frame_state.pc < exclude_min || frame_state.pc > exclude_max))
	{
	  tbe->pc = (ADDR) frame_state.pc;
	  tbe->pv = (ADDR) PV_FOR (frame_state.fp);

	  cnt ++;
	  tbe ++;
	}

      unwind (&frame_state);
    }

  return cnt;
}