gcc/ada/tb-alvms.c

   1 /****************************************************************************
   2  *                                                                          *
   3  *                         GNAT RUN-TIME 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-2011, 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 3,  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.                                     *
  17  *                                                                          *
  18  * As a special exception under Section 7 of GPL version 3, you are granted *
  19  * additional permissions described in the GCC Runtime Library Exception,   *
  20  * version 3.1, as published by the Free Software Foundation.               *
  21  *                                                                          *
  22  * You should have received a copy of the GNU General Public License and    *
  23  * a copy of the GCC Runtime Library Exception along with this program;     *
  24  * see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    *
  25  * <http://www.gnu.org/licenses/>.                                          *
  26  *                                                                          *
  27  * GNAT was originally developed  by the GNAT team at  New York University. *
  28  * Extensive contributions were provided by Ada Core Technologies Inc.      *
  29  *                                                                          *
  30  ****************************************************************************/
  31
  32
  33 /* Alpha VMS requires a special treatment due to the complexity of the ABI.
  34    What is here is along the lines of what the MD_FALLBACK_FRAME_STATE_FOR
  35    macro does for frame unwinding during exception propagation. This file is
  36    #included within tracebak.c in the appropriate case.
  37
  38    Most of the contents is directed by the OpenVMS/Alpha Conventions (ABI)
  39    document, sections of which we will refer to as ABI-<section_number>.  */
  40
  41 #include <vms/pdscdef.h>
  42 #include <vms/libicb.h>
  43 #include <vms/chfctxdef.h>
  44 #include <vms/chfdef.h>
  45
  46 /* A couple of items missing from the header file included above.  */
  47 extern void * SYS$GL_CALL_HANDL;
  48 #define PDSC$M_BASE_FRAME (1 << 10)
  49
  50 /* Registers are 64bit wide and addresses are 32bit wide on alpha-vms.  */
  51 typedef void * ADDR;
  52 typedef unsigned long long REG;
  53
  54 #define REG_AT(addr) (*(REG *)(addr))
  55
  56 #define AS_REG(addr) ((REG)(unsigned long)(addr))
  57 #define AS_ADDR(reg) ((ADDR)(unsigned long)(reg))
  58 #define ADDR_IN(reg) (AS_ADDR(reg))
  59
  60 /* The following structure defines the state maintained during the
  61    unwinding process.  */
  62 typedef struct
  63 {
  64   ADDR pc;  /* Address of the call insn involved in the chain.  */
  65   ADDR sp;  /* Stack Pointer at the time of this call.  */
  66   ADDR fp;  /* Frame Pointer at the time of this call.  */
  67
  68   /* The values above are fetched as saved REGisters on the stack. They are
  69      typed ADDR because this is what the values in those registers are.  */
  70
  71   /* Values of the registers saved by the functions in the chain,
  72      incrementally updated through consecutive calls to the "unwind" function
  73      below.  */
  74   REG saved_regs [32];
  75 } frame_state_t;
  76
  77 /* Shortcuts for saved_regs of specific interest:
  78
  79    Frame Pointer   is r29,
  80    Stack Pointer   is r30,
  81    Return Address  is r26,
  82    Procedure Value is r27.
  83
  84    This is from ABI-3.1.1 [Integer Registers].  */
  85
  86 #define saved_fpr saved_regs[29]
  87 #define saved_spr saved_regs[30]
  88 #define saved_rar saved_regs[26]
  89 #define saved_pvr saved_regs[27]
  90
  91 /* Special values for saved_rar, used to control the overall unwinding
  92    process.  */
  93 #define RA_UNKNOWN ((REG)~0)
  94 #define RA_STOP    ((REG)0)
  95
  96 /* We still use a number of macros similar to the ones for the generic
  97    __gnat_backtrace implementation.  */
  98 #define PC_ADJUST 4
  99 #define STOP_FRAME (frame_state.saved_rar == RA_STOP)
 100
 101 /* Compute Procedure Value from Frame Pointer value.  This follows the rules
 102    in ABI-3.6.1 [Current Procedure].  */
 103 #define PV_FOR(FP) \
 104   (((FP) != 0) \
 105     ? (((REG_AT (FP) & 0x7) == 0) ? *(PDSCDEF **)(FP) : (PDSCDEF *)(FP)) : 0)
 106
 107
 108 /**********
 109  * unwind *
 110  **********/
 111
 112 /* Helper for __gnat_backtrace.
 113
 114    FS represents some call frame, identified by a pc and associated frame
 115    pointer in FS->pc and FS->fp. FS->saved_regs contains the state of the
 116    general registers upon entry in this frame. Of most interest in this set
 117    are the saved return address and frame pointer registers, which actually
 118    allow identifying the caller's frame.
 119
 120    This routine "unwinds" the input frame state by adjusting it to eventually
 121    represent its caller's frame. The basic principle is to shift the fp and pc
 122    saved values into the current state, and then compute the corresponding new
 123    saved registers set.
 124
 125    If the call chain goes through a signal handler, special processing is
 126    required when we process the kernel frame which has called the handler, to
 127    switch it to the interrupted context frame.  */
 128
 129 #define K_HANDLER_FRAME(fs) (PV_FOR ((fs)->fp) == SYS$GL_CALL_HANDL)
 130
 131 static void unwind_regular_code (frame_state_t * fs);
 132 static void unwind_kernel_handler (frame_state_t * fs);
 133
 134 void
 135 unwind (frame_state_t * fs)
 136 {
 137   /* Don't do anything if requested so.  */
 138   if (fs->saved_rar == RA_STOP)
 139     return;
 140
 141   /* Retrieve the values of interest computed during the previous
 142      call. PC_ADJUST gets us from the return address to the call insn
 143      address.  */
 144   fs->pc = ADDR_IN (fs->saved_rar) - PC_ADJUST;
 145   fs->sp = ADDR_IN (fs->saved_spr);
 146   fs->fp = ADDR_IN (fs->saved_fpr);
 147
 148   /* Unless we are able to determine otherwise, set the frame state's
 149      saved return address such that the unwinding process will stop.  */
 150   fs->saved_rar = RA_STOP;
 151
 152   /* Now we want to update fs->saved_regs to reflect the state of the caller
 153      of the procedure described by pc/fp.
 154
 155      The condition to check for a special kernel frame which has called a
 156      signal handler is stated in ABI-6.7.1 [Signaler's Registers] : "The frame
 157      of the call to the handler can be identified by the return address of
 158      SYS$CALL_HANDL+4". We use the equivalent procedure value identification
 159      here because SYS$CALL_HANDL appears to be undefined. */
 160
 161   if (K_HANDLER_FRAME (fs))
 162     unwind_kernel_handler (fs);
 163   else
 164     unwind_regular_code (fs);
 165 }
 166
 167 /***********************
 168  * unwind_regular_code *
 169  ***********************/
 170
 171 /* Helper for unwind, for the case of unwinding through regular code which
 172    is not a signal handler.  */
 173
 174 static void
 175 unwind_regular_code (frame_state_t * fs)
 176 {
 177   PDSCDEF * pv = PV_FOR (fs->fp);
 178
 179   ADDR frame_base;
 180
 181   /* Use the procedure value to unwind, in a way depending on the kind of
 182      procedure at hand. See ABI-3.3 [Procedure Representation] and ABI-3.4
 183      [Procedure Types].  */
 184
 185   if (pv == 0
 186       || pv->pdsc$w_flags & PDSC$M_BASE_FRAME)
 187     return;
 188
 189   frame_base
 190     = (pv->pdsc$w_flags & PDSC$M_BASE_REG_IS_FP) ? fs->fp : fs->sp;
 191
 192   switch (pv->pdsc$w_flags & 0xf)
 193     {
 194     case PDSC$K_KIND_FP_STACK:
 195       /* Stack Frame Procedure (ABI-3.4.1). Retrieve the necessary registers
 196          from the Register Save Area in the frame.  */
 197       {
 198         ADDR rsa_base = frame_base + pv->pdsc$w_rsa_offset;
 199         int i, j;
 200
 201         fs->saved_rar = REG_AT (rsa_base);
 202         fs->saved_pvr = REG_AT (frame_base);
 203
 204         for (i = 0, j = 0; i < 32; i++)
 205           if (pv->pdsc$l_ireg_mask & (1 << i))
 206             fs->saved_regs[i] = REG_AT (rsa_base + 8 * ++j);
 207
 208         /* Note that the loop above is guaranteed to set fs->saved_fpr,
 209            because "The preserved register set must always include R29(FP)
 210            since it will always be used." (ABI-3.4.3.4 [Register Save Area for
 211            All Stack Frames]).
 212
 213            Also note that we need to run through all the registers to ensure
 214            that unwinding through register procedures (see below) gets the
 215            right values out of the saved_regs array.  */
 216       }
 217       break;
 218
 219     case PDSC$K_KIND_FP_REGISTER:
 220       /* Register Procedure (ABI-3.4.4). Retrieve the necessary registers from
 221          the registers where they have been saved.  */
 222       {
 223         fs->saved_rar = fs->saved_regs[pv->pdsc$b_save_ra];
 224         fs->saved_fpr = fs->saved_regs[pv->pdsc$b_save_fp];
 225       }
 226       break;
 227
 228     default:
 229       /* ??? Are we supposed to ever get here ?  Don't think so.  */
 230       break;
 231     }
 232
 233   /* SP is actually never part of the saved registers area, so we use the
 234      corresponding entry in the saved_regs array to manually keep track of
 235      it's evolution.  */
 236   fs->saved_spr = AS_REG (frame_base) + pv->pdsc$l_size;
 237 }
 238
 239 /*************************
 240  * unwind_kernel_handler *
 241  *************************/
 242
 243 /* Helper for unwind, for the specific case of unwinding through a signal
 244    handler.
 245
 246    The input frame state describes the kernel frame which has called a signal
 247    handler. We fill the corresponding saved_regs to have it's "caller" frame
 248    represented as the interrupted context.  */
 249
 250 static void
 251 unwind_kernel_handler (frame_state_t * fs)
 252 {
 253   PDSCDEF * pv = PV_FOR (fs->fp);
 254
 255   CHFDEF1 *sigargs;
 256   CHFDEF2 *mechargs;
 257
 258   /* Retrieve the arguments passed to the handler, by way of a VMS service
 259      providing the corresponding "Invocation Context Block".  */
 260   {
 261     long handler_ivhandle;
 262     INVO_CONTEXT_BLK handler_ivcb;
 263
 264     CHFCTX *chfctx;
 265
 266     handler_ivcb.libicb$q_ireg [29] = AS_REG (fs->fp);
 267     handler_ivcb.libicb$q_ireg [30] = 0;
 268
 269     handler_ivhandle = LIB$GET_INVO_HANDLE (&handler_ivcb);
 270
 271     if ((LIB$GET_INVO_CONTEXT (handler_ivhandle, &handler_ivcb) & 1) != 1)
 272       return;
 273
 274     chfctx = (CHFCTX *) AS_ADDR (handler_ivcb.libicb$ph_chfctx_addr);
 275
 276     sigargs = (CHFDEF1 *) AS_ADDR (chfctx->chfctx$q_sigarglst);
 277     mechargs = (CHFDEF2 *) AS_ADDR (chfctx->chfctx$q_mcharglst);
 278   }
 279
 280   /* Compute the saved return address as the PC of the instruction causing the
 281      condition, accounting for the fact that it will be adjusted by the next
 282      call to "unwind" as if it was an actual call return address.  */
 283   {
 284     /* ABI-6.5.1.1 [Signal Argument Vector]: The signal occurrence address
 285        is available from the sigargs argument to the handler, designed to
 286        support both 32 and 64 bit addresses.  The initial reference we get
 287        is a pointer to the 32bit form, from which one may extract a pointer
 288        to the 64bit version if need be.  We work directly from the 32bit
 289        form here.  */
 290
 291     /* The sigargs vector structure for 32bits addresses is:
 292
 293        <......32bit......>
 294        +-----------------+
 295        |      Vsize      | :chf$is_sig_args
 296        +-----------------+ -+-
 297        | Condition Value |  : [0]
 298        +-----------------+  :
 299        |       ...       |  :
 300        +-----------------+  : vector of Vsize entries
 301        |    Signal PC    |  :
 302        +-----------------+  :
 303        |       PS        |  : [Vsize - 1]
 304        +-----------------+ -+-
 305
 306        */
 307
 308     unsigned long * sigargs_vector
 309       = ((unsigned long *) (&sigargs->chf$is_sig_args)) + 1;
 310
 311     long sigargs_vsize
 312       = sigargs->chf$is_sig_args;
 313
 314     fs->saved_rar = (REG) sigargs_vector [sigargs_vsize - 2] + PC_ADJUST;
 315   }
 316
 317   fs->saved_spr = RA_UNKNOWN;
 318   fs->saved_fpr = (REG) mechargs->chf$q_mch_frame;
 319   fs->saved_pvr = (REG) mechargs->chf$q_mch_savr27;
 320
 321   fs->saved_regs[16] = (REG) mechargs->chf$q_mch_savr16;
 322   fs->saved_regs[17] = (REG) mechargs->chf$q_mch_savr17;
 323   fs->saved_regs[18] = (REG) mechargs->chf$q_mch_savr18;
 324   fs->saved_regs[19] = (REG) mechargs->chf$q_mch_savr19;
 325   fs->saved_regs[20] = (REG) mechargs->chf$q_mch_savr20;
 326 }
 327
 328 /* Structure representing a traceback entry in the tracebacks array to be
 329    filled by __gnat_backtrace below.
 330
 331    !! This should match what is in System.Traceback_Entries, so beware of
 332    !! the REG/ADDR difference here.
 333
 334    The use of a structure is motivated by the potential necessity of having
 335    several fields to fill for each entry, for instance if later calls to VMS
 336    system functions need more than just a mere PC to compute info on a frame
 337    (e.g. for non-symbolic->symbolic translation purposes).  */
 338 typedef struct {
 339   ADDR pc;  /* Program Counter.  */
 340   ADDR pv;  /* Procedure Value.  */
 341 } tb_entry_t;
 342
 343 /********************
 344  * __gnat_backtrace *
 345  ********************/
 346
 347 int
 348 __gnat_backtrace (void **array, int size,
 349                   void *exclude_min, void *exclude_max, int skip_frames)
 350 {
 351   int cnt;
 352
 353   tb_entry_t * tbe = (tb_entry_t *)&array [0];
 354
 355   frame_state_t frame_state;
 356
 357   /* Setup the frame state before initiating the unwinding sequence.  */
 358   register REG this_FP __asm__("$29");
 359   register REG this_SP __asm__("$30");
 360
 361   frame_state.saved_fpr = this_FP;
 362   frame_state.saved_spr = this_SP;
 363   frame_state.saved_rar = RA_UNKNOWN;
 364
 365   unwind (&frame_state);
 366
 367   /* At this point frame_state describes this very function. Skip the
 368      requested number of calls.  */
 369   for (cnt = 0; cnt < skip_frames; cnt ++)
 370     unwind (&frame_state);
 371
 372   /* Now consider each frame as a potential candidate for insertion inside
 373      the provided array.  */
 374   cnt = 0;
 375   while (cnt < size)
 376     {
 377       /* Stop if either the frame contents or the unwinder say so.  */
 378       if (STOP_FRAME)
 379         break;
 380
 381       if (! K_HANDLER_FRAME (&frame_state)
 382           && (frame_state.pc < exclude_min || frame_state.pc > exclude_max))
 383         {
 384           tbe->pc = (ADDR) frame_state.pc;
 385           tbe->pv = (ADDR) PV_FOR (frame_state.fp);
 386
 387           cnt ++;
 388           tbe ++;
 389         }
 390
 391       unwind (&frame_state);
 392     }
 393
 394   return cnt;
 395 }