gcc/ada/tb-alvms.c

   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  ****************************************************************************/
  32
  33
  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.
  38
  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>.  */
  41
  42 #include <vms/pdscdef.h>
  43 #include <vms/libicb.h>
  44 #include <vms/chfctxdef.h>
  45 #include <vms/chfdef.h>
  46
  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)
  50
  51 /* Registers are 64bit wide and addresses are 32bit wide on alpha-vms.  */
  52 typedef void * ADDR;
  53 typedef unsigned long long REG;
  54
  55 #define REG_AT(addr) (*(REG *)(addr))
  56
  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))
  60
  61 /* The following structure defines the state maintained during the
  62    unwinding process.  */
  63 typedef struct
  64 {
  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.  */
  68
  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.  */
  71
  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;
  77
  78 /* Shortcuts for saved_regs of specific interest:
  79
  80    Frame Pointer   is r29,
  81    Stack Pointer   is r30,
  82    Return Address  is r26,
  83    Procedure Value is r27.
  84
  85    This is from ABI-3.1.1 [Integer Registers].  */
  86
  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]
  91
  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)
  96
  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)
 101
 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)
 107
 108
 109 /**********
 110  * unwind *
 111  **********/
 112
 113 /* Helper for __gnat_backtrace.
 114
 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.
 120
 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.
 125
 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.  */
 129
 130 #define K_HANDLER_FRAME(fs) (PV_FOR ((fs)->fp) == SYS$GL_CALL_HANDL)
 131
 132 static void unwind_regular_code (frame_state_t * fs);
 133 static void unwind_kernel_handler (frame_state_t * fs);
 134
 135 void
 136 unwind (frame_state_t * fs)
 137 {
 138   /* Don't do anything if requested so.  */
 139   if (fs->saved_rar == RA_STOP)
 140     return;
 141
 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);
 148
 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;
 152
 153   /* Now we want to update fs->saved_regs to reflect the state of the caller
 154      of the procedure described by pc/fp.
 155
 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. */
 161
 162   if (K_HANDLER_FRAME (fs))
 163     unwind_kernel_handler (fs);
 164   else
 165     unwind_regular_code (fs);
 166 }
 167
 168 /***********************
 169  * unwind_regular_code *
 170  ***********************/
 171
 172 /* Helper for unwind, for the case of unwinding through regular code which
 173    is not a signal handler.  */
 174
 175 static void
 176 unwind_regular_code (frame_state_t * fs)
 177 {
 178   PDSCDEF * pv = PV_FOR (fs->fp);
 179
 180   ADDR frame_base;
 181
 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].  */
 185
 186   if (pv == 0
 187       || pv->pdsc$w_flags & PDSC$M_BASE_FRAME)
 188     return;
 189
 190   frame_base
 191     = (pv->pdsc$w_flags & PDSC$M_BASE_REG_IS_FP) ? fs->fp : fs->sp;
 192
 193   switch (pv->pdsc$w_flags & 0xf)
 194     {
 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.  */
 198       {
 199         ADDR rsa_base = frame_base + pv->pdsc$w_rsa_offset;
 200         int i, j;
 201
 202         fs->saved_rar = REG_AT (rsa_base);
 203         fs->saved_pvr = REG_AT (frame_base);
 204
 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);
 208
 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]).
 213
 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.  */
 217       }
 218       break;
 219
 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.  */
 223       {
 224         fs->saved_rar = fs->saved_regs[pv->pdsc$b_save_ra];
 225         fs->saved_fpr = fs->saved_regs[pv->pdsc$b_save_fp];
 226       }
 227       break;
 228
 229     default:
 230       /* ??? Are we supposed to ever get here ?  Don't think so.  */
 231       break;
 232     }
 233
 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;
 238 }
 239
 240 /*************************
 241  * unwind_kernel_handler *
 242  *************************/
 243
 244 /* Helper for unwind, for the specific case of unwinding through a signal
 245    handler.
 246
 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.  */
 250
 251 static void
 252 unwind_kernel_handler (frame_state_t * fs)
 253 {
 254   PDSCDEF * pv = PV_FOR (fs->fp);
 255
 256   CHFDEF1 *sigargs;
 257   CHFDEF2 *mechargs;
 258
 259   /* Retrieve the arguments passed to the handler, by way of a VMS service
 260      providing the corresponding "Invocation Context Block".  */
 261   {
 262     long handler_ivhandle;
 263     INVO_CONTEXT_BLK handler_ivcb;
 264
 265     CHFCTX *chfctx;
 266
 267     handler_ivcb.libicb$q_ireg [29] = AS_REG (fs->fp);
 268     handler_ivcb.libicb$q_ireg [30] = 0;
 269
 270     handler_ivhandle = LIB$GET_INVO_HANDLE (&handler_ivcb);
 271
 272     if ((LIB$GET_INVO_CONTEXT (handler_ivhandle, &handler_ivcb) & 1) != 1)
 273       return;
 274
 275     chfctx = (CHFCTX *) AS_ADDR (handler_ivcb.libicb$ph_chfctx_addr);
 276
 277     sigargs = (CHFDEF1 *) AS_ADDR (chfctx->chfctx$q_sigarglst);
 278     mechargs = (CHFDEF2 *) AS_ADDR (chfctx->chfctx$q_mcharglst);
 279   }
 280
 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.  */
 284   {
 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.  */
 291
 292     /* The sigargs vector structure for 32bits addresses is:
 293
 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        +-----------------+ -+-
 306
 307        */
 308
 309     unsigned long * sigargs_vector
 310       = ((unsigned long *) (&sigargs->chf$is_sig_args)) + 1;
 311
 312     long sigargs_vsize
 313       = sigargs->chf$is_sig_args;
 314
 315     fs->saved_rar = (REG) sigargs_vector [sigargs_vsize - 2] + PC_ADJUST;
 316   }
 317
 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;
 321
 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;
 327 }
 328
 329 /* Structure representing a traceback entry in the tracebacks array to be
 330    filled by __gnat_backtrace below.
 331
 332    !! This should match what is in System.Traceback_Entries, so beware of
 333    !! the REG/ADDR difference here.
 334
 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;
 343
 344 /********************
 345  * __gnat_backtrace *
 346  ********************/
 347
 348 int
 349 __gnat_backtrace (void **array, int size,
 350                   void *exclude_min, void *exclude_max, int skip_frames)
 351 {
 352   int cnt;
 353
 354   tb_entry_t * tbe = (tb_entry_t *)&array [0];
 355
 356   frame_state_t frame_state;
 357
 358   /* Setup the frame state before initiating the unwinding sequence.  */
 359   register REG this_FP __asm__("$29");
 360   register REG this_SP __asm__("$30");
 361
 362   frame_state.saved_fpr = this_FP;
 363   frame_state.saved_spr = this_SP;
 364   frame_state.saved_rar = RA_UNKNOWN;
 365
 366   unwind (&frame_state);
 367
 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);
 372
 373   /* Now consider each frame as a potential candidate for insertion inside
 374      the provided array.  */
 375   cnt = 0;
 376   while (cnt < size)
 377     {
 378       PDSCDEF * pv = PV_FOR (frame_state.fp);
 379
 380       /* Stop if either the frame contents or the unwinder say so.  */
 381       if (STOP_FRAME)
 382         break;
 383
 384       if (! K_HANDLER_FRAME (&frame_state)
 385           && (frame_state.pc < exclude_min || frame_state.pc > exclude_max))
 386         {
 387           tbe->pc = (ADDR) frame_state.pc;
 388           tbe->pv = (ADDR) PV_FOR (frame_state.fp);
 389
 390           cnt ++;
 391           tbe ++;
 392         }
 393
 394       unwind (&frame_state);
 395     }
 396
 397   return cnt;
 398 }