gcc/ada/init.c

   1 /****************************************************************************
   2  *                                                                          *
   3  *                         GNAT COMPILER COMPONENTS                         *
   4  *                                                                          *
   5  *                                 I N I T                                  *
   6  *                                                                          *
   7  *                          C Implementation File                           *
   8  *                                                                          *
   9  *          Copyright (C) 1992-2007, Free Software Foundation, Inc.         *
  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 /*  This unit contains initialization circuits that are system dependent. A
  34     major part of the functionality involved involves stack overflow checking.
  35     The GCC backend generates probe instructions to test for stack overflow.
  36     For details on the exact approach used to generate these probes, see the
  37     "Using and Porting GCC" manual, in particular the "Stack Checking" section
  38     and the subsection "Specifying How Stack Checking is Done". The handlers
  39     installed by this file are used to handle resulting signals that come
  40     from these probes failing (i.e. touching protected pages) */
  41
  42 /* This file should be kept synchronized with 2sinit.ads, 2sinit.adb,
  43    s-init-ae653-cert.adb and s-init-xi-sparc.adb. All these files implement
  44    the required functionality for different targets. */
  45
  46 /* The following include is here to meet the published VxWorks requirement
  47    that the __vxworks header appear before any other include. */
  48 #ifdef __vxworks
  49 #include "vxWorks.h"
  50 #endif
  51
  52 #ifdef IN_RTS
  53 #include "tconfig.h"
  54 #include "tsystem.h"
  55 #include <sys/stat.h>
  56
  57 /* We don't have libiberty, so us malloc.  */
  58 #define xmalloc(S) malloc (S)
  59 #else
  60 #include "config.h"
  61 #include "system.h"
  62 #endif
  63
  64 #include "adaint.h"
  65 #include "raise.h"
  66
  67 extern void __gnat_raise_program_error (const char *, int);
  68
  69 /* Addresses of exception data blocks for predefined exceptions. Tasking_Error
  70    is not used in this unit, and the abort signal is only used on IRIX. */
  71 extern struct Exception_Data constraint_error;
  72 extern struct Exception_Data numeric_error;
  73 extern struct Exception_Data program_error;
  74 extern struct Exception_Data storage_error;
  75
  76 /* For the Cert run time we use the regular raise exception routine because
  77    Raise_From_Signal_Handler is not available. */
  78 #ifdef CERT
  79 #define Raise_From_Signal_Handler \
  80                       __gnat_raise_exception
  81 extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *);
  82 #else
  83 #define Raise_From_Signal_Handler \
  84                       ada__exceptions__raise_from_signal_handler
  85 extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *);
  86 #endif
  87
  88 /* Global values computed by the binder */
  89 int   __gl_main_priority                 = -1;
  90 int   __gl_time_slice_val                = -1;
  91 char  __gl_wc_encoding                   = 'n';
  92 char  __gl_locking_policy                = ' ';
  93 char  __gl_queuing_policy                = ' ';
  94 char  __gl_task_dispatching_policy       = ' ';
  95 char *__gl_priority_specific_dispatching = 0;
  96 int   __gl_num_specific_dispatching      = 0;
  97 char *__gl_interrupt_states              = 0;
  98 int   __gl_num_interrupt_states          = 0;
  99 int   __gl_unreserve_all_interrupts      = 0;
 100 int   __gl_exception_tracebacks          = 0;
 101 int   __gl_zero_cost_exceptions          = 0;
 102 int   __gl_detect_blocking               = 0;
 103 int   __gl_default_stack_size            = -1;
 104 int   __gl_leap_seconds_support          = 0;
 105
 106 /* Indication of whether synchronous signal handler has already been
 107    installed by a previous call to adainit */
 108 int  __gnat_handler_installed      = 0;
 109
 110 #ifndef IN_RTS
 111 int __gnat_inside_elab_final_code = 0;
 112 /* ??? This variable is obsolete since 2001-08-29 but is kept to allow
 113    bootstrap from old GNAT versions (< 3.15). */
 114 #endif
 115
 116 /* HAVE_GNAT_INIT_FLOAT must be set on every targets where a __gnat_init_float
 117    is defined. If this is not set them a void implementation will be defined
 118    at the end of this unit. */
 119 #undef HAVE_GNAT_INIT_FLOAT
 120
 121 /******************************/
 122 /* __gnat_get_interrupt_state */
 123 /******************************/
 124
 125 char __gnat_get_interrupt_state (int);
 126
 127 /* This routine is called from the runtime as needed to determine the state
 128    of an interrupt, as set by an Interrupt_State pragma appearing anywhere
 129    in the current partition. The input argument is the interrupt number,
 130    and the result is one of the following:
 131
 132        'n'   this interrupt not set by any Interrupt_State pragma
 133        'u'   Interrupt_State pragma set state to User
 134        'r'   Interrupt_State pragma set state to Runtime
 135        's'   Interrupt_State pragma set state to System */
 136
 137 char
 138 __gnat_get_interrupt_state (int intrup)
 139 {
 140   if (intrup >= __gl_num_interrupt_states)
 141     return 'n';
 142   else
 143     return __gl_interrupt_states [intrup];
 144 }
 145
 146 /***********************************/
 147 /* __gnat_get_specific_dispatching */
 148 /***********************************/
 149
 150 char __gnat_get_specific_dispatching (int);
 151
 152 /* This routine is called from the run time as needed to determine the
 153    priority specific dispatching policy, as set by a
 154    Priority_Specific_Dispatching pragma appearing anywhere in the current
 155    partition. The input argument is the priority number, and the result is
 156    the upper case first character of the policy name, e.g. 'F' for
 157    FIFO_Within_Priorities. A space ' ' is returned if no
 158    Priority_Specific_Dispatching pragma is used in the partition. */
 159
 160 char
 161 __gnat_get_specific_dispatching (int priority)
 162 {
 163   if (__gl_num_specific_dispatching == 0)
 164     return ' ';
 165   else if (priority >= __gl_num_specific_dispatching)
 166     return 'F';
 167   else
 168     return __gl_priority_specific_dispatching [priority];
 169 }
 170
 171 #ifndef IN_RTS
 172
 173 /**********************/
 174 /* __gnat_set_globals */
 175 /**********************/
 176
 177 /* This routine is kept for boostrapping purposes, since the binder generated
 178    file now sets the __gl_* variables directly. */
 179
 180 void
 181 __gnat_set_globals ()
 182 {
 183 }
 184
 185 #endif
 186
 187 /***************/
 188 /* AIX Section */
 189 /***************/
 190
 191 #if defined (_AIX)
 192
 193 #include <signal.h>
 194 #include <sys/time.h>
 195
 196 /* Some versions of AIX don't define SA_NODEFER. */
 197
 198 #ifndef SA_NODEFER
 199 #define SA_NODEFER 0
 200 #endif /* SA_NODEFER */
 201
 202 /* Versions of AIX before 4.3 don't have nanosleep but provide
 203    nsleep instead. */
 204
 205 #ifndef _AIXVERSION_430
 206
 207 extern int nanosleep (struct timestruc_t *, struct timestruc_t *);
 208
 209 int
 210 nanosleep (struct timestruc_t *Rqtp, struct timestruc_t *Rmtp)
 211 {
 212   return nsleep (Rqtp, Rmtp);
 213 }
 214
 215 #endif /* _AIXVERSION_430 */
 216
 217 static void __gnat_error_handler (int sig, siginfo_t * si, void * uc);
 218
 219 /* __gnat_adjust_context_for_raise - see comments along with the default
 220    version later in this file.  */
 221
 222 void
 223 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
 224 {
 225   /* We need to adjust the "Instruction Address Register" value, part of a
 226      'struct mstsave' wrapped as a jumpbuf in the mcontext field designated by
 227      the signal data pointer we get.  See sys/context.h + sys/mstsave.h  */
 228
 229   mcontext_t *mcontext = &((ucontext_t *) ucontext)->uc_mcontext;
 230   mcontext->jmp_context.iar++;
 231 }
 232
 233 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
 234
 235 static void
 236 __gnat_error_handler (int sig, siginfo_t * si, void * uc)
 237 {
 238   struct Exception_Data *exception;
 239   const char *msg;
 240
 241   switch (sig)
 242     {
 243     case SIGSEGV:
 244       /* FIXME: we need to detect the case of a *real* SIGSEGV */
 245       exception = &storage_error;
 246       msg = "stack overflow or erroneous memory access";
 247       break;
 248
 249     case SIGBUS:
 250       exception = &constraint_error;
 251       msg = "SIGBUS";
 252       break;
 253
 254     case SIGFPE:
 255       exception = &constraint_error;
 256       msg = "SIGFPE";
 257       break;
 258
 259     default:
 260       exception = &program_error;
 261       msg = "unhandled signal";
 262     }
 263
 264   __gnat_adjust_context_for_raise (sig, uc);
 265   Raise_From_Signal_Handler (exception, msg);
 266 }
 267
 268 void
 269 __gnat_install_handler (void)
 270 {
 271   struct sigaction act;
 272
 273   /* Set up signal handler to map synchronous signals to appropriate
 274      exceptions.  Make sure that the handler isn't interrupted by another
 275      signal that might cause a scheduling event! */
 276
 277   act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
 278   act.sa_sigaction = __gnat_error_handler;
 279   sigemptyset (&act.sa_mask);
 280
 281   /* Do not install handlers if interrupt state is "System" */
 282   if (__gnat_get_interrupt_state (SIGABRT) != 's')
 283     sigaction (SIGABRT, &act, NULL);
 284   if (__gnat_get_interrupt_state (SIGFPE) != 's')
 285     sigaction (SIGFPE,  &act, NULL);
 286   if (__gnat_get_interrupt_state (SIGILL) != 's')
 287     sigaction (SIGILL,  &act, NULL);
 288   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 289     sigaction (SIGSEGV, &act, NULL);
 290   if (__gnat_get_interrupt_state (SIGBUS) != 's')
 291     sigaction (SIGBUS,  &act, NULL);
 292
 293   __gnat_handler_installed = 1;
 294 }
 295
 296 /*****************/
 297 /* Tru64 section */
 298 /*****************/
 299
 300 #elif defined(__alpha__) && defined(__osf__)
 301
 302 #include <signal.h>
 303 #include <sys/siginfo.h>
 304
 305 static void __gnat_error_handler (int, siginfo_t *, struct sigcontext *);
 306 extern char *__gnat_get_code_loc (struct sigcontext *);
 307 extern void __gnat_set_code_loc (struct sigcontext *, char *);
 308 extern size_t __gnat_machine_state_length (void);
 309
 310 /* __gnat_adjust_context_for_raise - see comments along with the default
 311    version later in this file.  */
 312
 313 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
 314
 315 void
 316 __gnat_adjust_context_for_raise (int signo, void *context)
 317 {
 318   struct sigcontext * sigcontext = (struct sigcontext *) context;
 319
 320   /* The fallback code fetches the faulting insn address from sc_pc, so
 321      adjust that when need be.  For SIGFPE, the required adjustment depends
 322      on the trap shadow situation (see man ieee).  */
 323   if (signo == SIGFPE)
 324     {
 325       /* ??? We never adjust here, considering that sc_pc always
 326          designates the instruction following the one which trapped.
 327          This is not necessarily true but corresponds to what we have
 328          always observed.  */
 329     }
 330   else
 331     sigcontext->sc_pc ++;
 332 }
 333
 334 static void
 335 __gnat_error_handler
 336   (int sig, siginfo_t *sip, struct sigcontext *context)
 337 {
 338   struct Exception_Data *exception;
 339   static int recurse = 0;
 340   const char *msg;
 341
 342   /* Adjusting is required for every fault context, so adjust for this one
 343      now, before we possibly trigger a recursive fault below.  */
 344   __gnat_adjust_context_for_raise (sig, context);
 345
 346   /* If this was an explicit signal from a "kill", just resignal it.  */
 347   if (SI_FROMUSER (sip))
 348     {
 349       signal (sig, SIG_DFL);
 350       kill (getpid(), sig);
 351     }
 352
 353   /* Otherwise, treat it as something we handle.  */
 354   switch (sig)
 355     {
 356     case SIGSEGV:
 357       /* If the problem was permissions, this is a constraint error.
 358          Likewise if the failing address isn't maximally aligned or if
 359          we've recursed.
 360
 361          ??? Using a static variable here isn't task-safe, but it's
 362          much too hard to do anything else and we're just determining
 363          which exception to raise.  */
 364       if (sip->si_code == SEGV_ACCERR
 365           || (((long) sip->si_addr) & 3) != 0
 366           || recurse)
 367         {
 368           exception = &constraint_error;
 369           msg = "SIGSEGV";
 370         }
 371       else
 372         {
 373           /* See if the page before the faulting page is accessible.  Do that
 374              by trying to access it.  We'd like to simply try to access
 375              4096 + the faulting address, but it's not guaranteed to be
 376              the actual address, just to be on the same page.  */
 377           recurse++;
 378           ((volatile char *)
 379            ((long) sip->si_addr & - getpagesize ()))[getpagesize ()];
 380           msg = "stack overflow (or erroneous memory access)";
 381           exception = &storage_error;
 382         }
 383       break;
 384
 385     case SIGBUS:
 386       exception = &program_error;
 387       msg = "SIGBUS";
 388       break;
 389
 390     case SIGFPE:
 391       exception = &constraint_error;
 392       msg = "SIGFPE";
 393       break;
 394
 395     default:
 396       exception = &program_error;
 397       msg = "unhandled signal";
 398     }
 399
 400   recurse = 0;
 401   Raise_From_Signal_Handler (exception, (char *) msg);
 402 }
 403
 404 void
 405 __gnat_install_handler (void)
 406 {
 407   struct sigaction act;
 408
 409   /* Setup signal handler to map synchronous signals to appropriate
 410      exceptions. Make sure that the handler isn't interrupted by another
 411      signal that might cause a scheduling event! */
 412
 413   act.sa_handler = (void (*) (int)) __gnat_error_handler;
 414   act.sa_flags = SA_RESTART | SA_NODEFER | SA_SIGINFO;
 415   sigemptyset (&act.sa_mask);
 416
 417   /* Do not install handlers if interrupt state is "System" */
 418   if (__gnat_get_interrupt_state (SIGABRT) != 's')
 419     sigaction (SIGABRT, &act, NULL);
 420   if (__gnat_get_interrupt_state (SIGFPE) != 's')
 421     sigaction (SIGFPE,  &act, NULL);
 422   if (__gnat_get_interrupt_state (SIGILL) != 's')
 423     sigaction (SIGILL,  &act, NULL);
 424   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 425     sigaction (SIGSEGV, &act, NULL);
 426   if (__gnat_get_interrupt_state (SIGBUS) != 's')
 427     sigaction (SIGBUS,  &act, NULL);
 428
 429   __gnat_handler_installed = 1;
 430 }
 431
 432 /* Routines called by s-mastop-tru64.adb.  */
 433
 434 #define SC_GP 29
 435
 436 char *
 437 __gnat_get_code_loc (struct sigcontext *context)
 438 {
 439   return (char *) context->sc_pc;
 440 }
 441
 442 void
 443 __gnat_set_code_loc (struct sigcontext *context, char *pc)
 444 {
 445   context->sc_pc = (long) pc;
 446 }
 447
 448 size_t
 449 __gnat_machine_state_length (void)
 450 {
 451   return sizeof (struct sigcontext);
 452 }
 453
 454 /*****************/
 455 /* HP-UX section */
 456 /*****************/
 457
 458 #elif defined (__hpux__)
 459
 460 #include <signal.h>
 461 #include <sys/ucontext.h>
 462
 463 static void
 464 __gnat_error_handler (int sig, siginfo_t *siginfo, void *ucontext);
 465
 466 #if defined (__hppa__)
 467
 468 /* __gnat_adjust_context_for_raise - see comments along with the default
 469    version later in this file.  */
 470
 471 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
 472
 473 void
 474 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
 475 {
 476   mcontext_t *mcontext = &((ucontext_t *) ucontext)->uc_mcontext;
 477
 478   if (UseWideRegs (mcontext))
 479     mcontext->ss_wide.ss_32.ss_pcoq_head_lo ++;
 480   else
 481     mcontext->ss_narrow.ss_pcoq_head ++;
 482 }
 483
 484 #endif
 485
 486 static void
 487 __gnat_error_handler
 488   (int sig, siginfo_t *siginfo ATTRIBUTE_UNUSED, void *ucontext)
 489 {
 490   struct Exception_Data *exception;
 491   const char *msg;
 492
 493   switch (sig)
 494     {
 495     case SIGSEGV:
 496       /* FIXME: we need to detect the case of a *real* SIGSEGV */
 497       exception = &storage_error;
 498       msg = "stack overflow or erroneous memory access";
 499       break;
 500
 501     case SIGBUS:
 502       exception = &constraint_error;
 503       msg = "SIGBUS";
 504       break;
 505
 506     case SIGFPE:
 507       exception = &constraint_error;
 508       msg = "SIGFPE";
 509       break;
 510
 511     default:
 512       exception = &program_error;
 513       msg = "unhandled signal";
 514     }
 515
 516   __gnat_adjust_context_for_raise (sig, ucontext);
 517
 518   Raise_From_Signal_Handler (exception, msg);
 519 }
 520
 521 void
 522 __gnat_install_handler (void)
 523 {
 524   struct sigaction act;
 525
 526   /* Set up signal handler to map synchronous signals to appropriate
 527      exceptions.  Make sure that the handler isn't interrupted by another
 528      signal that might cause a scheduling event! Also setup an alternate
 529      stack region for the handler execution so that stack overflows can be
 530      handled properly, avoiding a SEGV generation from stack usage by the
 531      handler itself. */
 532
 533   static char handler_stack[SIGSTKSZ*2];
 534   /* SIGSTKSZ appeared to be "short" for the needs in some contexts
 535      (e.g. experiments with GCC ZCX exceptions).  */
 536
 537   stack_t stack;
 538
 539   stack.ss_sp    = handler_stack;
 540   stack.ss_size  = sizeof (handler_stack);
 541   stack.ss_flags = 0;
 542
 543   sigaltstack (&stack, NULL);
 544
 545   act.sa_sigaction = __gnat_error_handler;
 546   act.sa_flags = SA_NODEFER | SA_RESTART | SA_ONSTACK | SA_SIGINFO;
 547   sigemptyset (&act.sa_mask);
 548
 549   /* Do not install handlers if interrupt state is "System" */
 550   if (__gnat_get_interrupt_state (SIGABRT) != 's')
 551     sigaction (SIGABRT, &act, NULL);
 552   if (__gnat_get_interrupt_state (SIGFPE) != 's')
 553     sigaction (SIGFPE,  &act, NULL);
 554   if (__gnat_get_interrupt_state (SIGILL) != 's')
 555     sigaction (SIGILL,  &act, NULL);
 556   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 557     sigaction (SIGSEGV, &act, NULL);
 558   if (__gnat_get_interrupt_state (SIGBUS) != 's')
 559     sigaction (SIGBUS,  &act, NULL);
 560
 561   __gnat_handler_installed = 1;
 562 }
 563
 564 /*********************/
 565 /* GNU/Linux Section */
 566 /*********************/
 567
 568 #elif defined (linux) && (defined (i386) || defined (__x86_64__) \
 569                           || defined (__ia64__))
 570
 571 #include <signal.h>
 572
 573 #define __USE_GNU 1 /* required to get REG_EIP/RIP from glibc's ucontext.h */
 574 #include <sys/ucontext.h>
 575
 576 /* GNU/Linux, which uses glibc, does not define NULL in included
 577    header files */
 578
 579 #if !defined (NULL)
 580 #define NULL ((void *) 0)
 581 #endif
 582
 583 #if defined (MaRTE)
 584
 585 /* MaRTE OS provides its own version of sigaction, sigfillset, and
 586    sigemptyset (overriding these symbol names). We want to make sure that
 587    the versions provided by the underlying C library are used here (these
 588    versions are renamed by MaRTE to linux_sigaction, fake_linux_sigfillset,
 589    and fake_linux_sigemptyset, respectively). The MaRTE library will not
 590    always be present (it will not be linked if no tasking constructs are
 591    used), so we use the weak symbol mechanism to point always to the symbols
 592    defined within the C library. */
 593
 594 #pragma weak linux_sigaction
 595 int linux_sigaction (int signum, const struct sigaction *act,
 596                      struct sigaction *oldact) {
 597   return sigaction (signum, act, oldact);
 598 }
 599 #define sigaction(signum, act, oldact) linux_sigaction (signum, act, oldact)
 600
 601 #pragma weak fake_linux_sigfillset
 602 void fake_linux_sigfillset (sigset_t *set) {
 603   sigfillset (set);
 604 }
 605 #define sigfillset(set) fake_linux_sigfillset (set)
 606
 607 #pragma weak fake_linux_sigemptyset
 608 void fake_linux_sigemptyset (sigset_t *set) {
 609   sigemptyset (set);
 610 }
 611 #define sigemptyset(set) fake_linux_sigemptyset (set)
 612
 613 #endif
 614
 615 static void __gnat_error_handler (int, siginfo_t *siginfo, void *ucontext);
 616
 617 /* __gnat_adjust_context_for_raise - see comments along with the default
 618    version later in this file.  */
 619
 620 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
 621
 622 void
 623 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
 624 {
 625   mcontext_t *mcontext = &((ucontext_t *) ucontext)->uc_mcontext;
 626
 627 #if defined (i386)
 628   mcontext->gregs[REG_EIP]++;
 629 #elif defined (__x86_64__)
 630   mcontext->gregs[REG_RIP]++;
 631 #elif defined (__ia64__)
 632   mcontext->sc_ip++;
 633 #endif
 634 }
 635
 636 static void
 637 __gnat_error_handler (int sig,
 638                       siginfo_t *siginfo ATTRIBUTE_UNUSED,
 639                       void *ucontext)
 640 {
 641   struct Exception_Data *exception;
 642   const char *msg;
 643   static int recurse = 0;
 644
 645   switch (sig)
 646     {
 647     case SIGSEGV:
 648       /* If the problem was permissions, this is a constraint error.
 649        Likewise if the failing address isn't maximally aligned or if
 650        we've recursed.
 651
 652        ??? Using a static variable here isn't task-safe, but it's
 653        much too hard to do anything else and we're just determining
 654        which exception to raise.  */
 655       if (recurse)
 656       {
 657         exception = &constraint_error;
 658         msg = "SIGSEGV";
 659       }
 660       else
 661       {
 662         /* Here we would like a discrimination test to see whether the
 663            page before the faulting address is accessible. Unfortunately
 664            Linux seems to have no way of giving us the faulting address.
 665
 666            In versions of a-init.c before 1.95, we had a test of the page
 667            before the stack pointer using:
 668
 669             recurse++;
 670              ((volatile char *)
 671               ((long) info->esp_at_signal & - getpagesize ()))[getpagesize ()];
 672
 673            but that's wrong, since it tests the stack pointer location, and
 674            the current stack probe code does not move the stack pointer
 675            until all probes succeed.
 676
 677            For now we simply do not attempt any discrimination at all. Note
 678            that this is quite acceptable, since a "real" SIGSEGV can only
 679            occur as the result of an erroneous program */
 680
 681         msg = "stack overflow (or erroneous memory access)";
 682         exception = &storage_error;
 683       }
 684       break;
 685
 686     case SIGBUS:
 687       exception = &constraint_error;
 688       msg = "SIGBUS";
 689       break;
 690
 691     case SIGFPE:
 692       exception = &constraint_error;
 693       msg = "SIGFPE";
 694       break;
 695
 696     default:
 697       exception = &program_error;
 698       msg = "unhandled signal";
 699     }
 700   recurse = 0;
 701
 702   /* We adjust the interrupted context here (and not in the
 703      MD_FALLBACK_FRAME_STATE_FOR macro) because recent versions of the Native
 704      POSIX Thread Library (NPTL) are compiled with DWARF 2 unwind information,
 705      and hence the later macro is never executed for signal frames. */
 706
 707   __gnat_adjust_context_for_raise (sig, ucontext);
 708
 709   Raise_From_Signal_Handler (exception, msg);
 710 }
 711
 712 void
 713 __gnat_install_handler (void)
 714 {
 715   struct sigaction act;
 716
 717   /* Set up signal handler to map synchronous signals to appropriate
 718      exceptions.  Make sure that the handler isn't interrupted by another
 719      signal that might cause a scheduling event! */
 720
 721   act.sa_sigaction = __gnat_error_handler;
 722   act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
 723   sigemptyset (&act.sa_mask);
 724
 725   /* Do not install handlers if interrupt state is "System" */
 726   if (__gnat_get_interrupt_state (SIGABRT) != 's')
 727     sigaction (SIGABRT, &act, NULL);
 728   if (__gnat_get_interrupt_state (SIGFPE) != 's')
 729     sigaction (SIGFPE,  &act, NULL);
 730   if (__gnat_get_interrupt_state (SIGILL) != 's')
 731     sigaction (SIGILL,  &act, NULL);
 732   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 733     sigaction (SIGSEGV, &act, NULL);
 734   if (__gnat_get_interrupt_state (SIGBUS) != 's')
 735     sigaction (SIGBUS,  &act, NULL);
 736
 737   __gnat_handler_installed = 1;
 738 }
 739
 740 /*******************/
 741 /* Interix Section */
 742 /*******************/
 743
 744 #elif defined (__INTERIX)
 745
 746 #include <signal.h>
 747
 748 static void __gnat_error_handler (int);
 749
 750 static void
 751 __gnat_error_handler (int sig)
 752 {
 753   struct Exception_Data *exception;
 754   const char *msg;
 755
 756   switch (sig)
 757     {
 758     case SIGSEGV:
 759       exception = &storage_error;
 760       msg = "stack overflow or erroneous memory access";
 761       break;
 762
 763     case SIGBUS:
 764       exception = &constraint_error;
 765       msg = "SIGBUS";
 766       break;
 767
 768     case SIGFPE:
 769       exception = &constraint_error;
 770       msg = "SIGFPE";
 771       break;
 772
 773     default:
 774       exception = &program_error;
 775       msg = "unhandled signal";
 776     }
 777
 778   Raise_From_Signal_Handler (exception, msg);
 779 }
 780
 781 void
 782 __gnat_install_handler (void)
 783 {
 784   struct sigaction act;
 785
 786   /* Set up signal handler to map synchronous signals to appropriate
 787      exceptions.  Make sure that the handler isn't interrupted by another
 788      signal that might cause a scheduling event! */
 789
 790   act.sa_handler = __gnat_error_handler;
 791   act.sa_flags = 0;
 792   sigemptyset (&act.sa_mask);
 793
 794   /* Handlers for signals besides SIGSEGV cause c974013 to hang */
 795 /*  sigaction (SIGILL,  &act, NULL); */
 796 /*  sigaction (SIGABRT, &act, NULL); */
 797 /*  sigaction (SIGFPE,  &act, NULL); */
 798 /*  sigaction (SIGBUS,  &act, NULL); */
 799
 800   /* Do not install handlers if interrupt state is "System" */
 801   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 802     sigaction (SIGSEGV, &act, NULL);
 803
 804   __gnat_handler_installed = 1;
 805 }
 806
 807 /****************/
 808 /* IRIX Section */
 809 /****************/
 810
 811 #elif defined (sgi)
 812
 813 #include <signal.h>
 814 #include <siginfo.h>
 815
 816 #ifndef NULL
 817 #define NULL 0
 818 #endif
 819
 820 #define SIGADAABORT 48
 821 #define SIGNAL_STACK_SIZE 4096
 822 #define SIGNAL_STACK_ALIGNMENT 64
 823
 824 #define Check_Abort_Status     \
 825                       system__soft_links__check_abort_status
 826 extern int (*Check_Abort_Status) (void);
 827
 828 extern struct Exception_Data _abort_signal;
 829
 830 static void __gnat_error_handler (int, int, sigcontext_t *);
 831
 832 /* We are not setting the SA_SIGINFO bit in the sigaction flags when
 833    connecting that handler, with the effects described in the sigaction
 834    man page:
 835
 836           SA_SIGINFO [...]
 837           If cleared and the signal is caught, the first argument is
 838           also the signal number but the second argument is the signal
 839           code identifying the cause of the signal. The third argument
 840           points to a sigcontext_t structure containing the receiving
 841           process's context when the signal was delivered.
 842 */
 843
 844 static void
 845 __gnat_error_handler (int sig, int code, sigcontext_t *sc ATTRIBUTE_UNUSED)
 846 {
 847   struct Exception_Data *exception;
 848   const char *msg;
 849
 850   switch (sig)
 851     {
 852     case SIGSEGV:
 853       if (code == EFAULT)
 854         {
 855           exception = &program_error;
 856           msg = "SIGSEGV: (Invalid virtual address)";
 857         }
 858       else if (code == ENXIO)
 859         {
 860           exception = &program_error;
 861           msg = "SIGSEGV: (Read beyond mapped object)";
 862         }
 863       else if (code == ENOSPC)
 864         {
 865           exception = &program_error; /* ??? storage_error ??? */
 866           msg = "SIGSEGV: (Autogrow for file failed)";
 867         }
 868       else if (code == EACCES || code == EEXIST)
 869         {
 870           /* ??? We handle stack overflows here, some of which do trigger
 871                  SIGSEGV + EEXIST on Irix 6.5 although EEXIST is not part of
 872                  the documented valid codes for SEGV in the signal(5) man
 873                  page.  */
 874
 875           /* ??? Re-add smarts to further verify that we launched
 876                  the stack into a guard page, not an attempt to
 877                  write to .text or something */
 878           exception = &storage_error;
 879           msg = "SIGSEGV: (stack overflow or erroneous memory access)";
 880         }
 881       else
 882         {
 883           /* Just in case the OS guys did it to us again.  Sometimes
 884              they fail to document all of the valid codes that are
 885              passed to signal handlers, just in case someone depends
 886              on knowing all the codes */
 887           exception = &program_error;
 888           msg = "SIGSEGV: (Undocumented reason)";
 889         }
 890       break;
 891
 892     case SIGBUS:
 893       /* Map all bus errors to Program_Error.  */
 894       exception = &program_error;
 895       msg = "SIGBUS";
 896       break;
 897
 898     case SIGFPE:
 899       /* Map all fpe errors to Constraint_Error.  */
 900       exception = &constraint_error;
 901       msg = "SIGFPE";
 902       break;
 903
 904     case SIGADAABORT:
 905       if ((*Check_Abort_Status) ())
 906         {
 907           exception = &_abort_signal;
 908           msg = "";
 909         }
 910       else
 911         return;
 912
 913       break;
 914
 915     default:
 916       /* Everything else is a Program_Error. */
 917       exception = &program_error;
 918       msg = "unhandled signal";
 919     }
 920
 921   Raise_From_Signal_Handler (exception, msg);
 922 }
 923
 924 void
 925 __gnat_install_handler (void)
 926 {
 927   struct sigaction act;
 928
 929   /* Setup signal handler to map synchronous signals to appropriate
 930      exceptions.  Make sure that the handler isn't interrupted by another
 931      signal that might cause a scheduling event! */
 932
 933   act.sa_handler = __gnat_error_handler;
 934   act.sa_flags = SA_NODEFER + SA_RESTART;
 935   sigfillset (&act.sa_mask);
 936   sigemptyset (&act.sa_mask);
 937
 938   /* Do not install handlers if interrupt state is "System" */
 939   if (__gnat_get_interrupt_state (SIGABRT) != 's')
 940     sigaction (SIGABRT, &act, NULL);
 941   if (__gnat_get_interrupt_state (SIGFPE) != 's')
 942     sigaction (SIGFPE,  &act, NULL);
 943   if (__gnat_get_interrupt_state (SIGILL) != 's')
 944     sigaction (SIGILL,  &act, NULL);
 945   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 946     sigaction (SIGSEGV, &act, NULL);
 947   if (__gnat_get_interrupt_state (SIGBUS) != 's')
 948     sigaction (SIGBUS,  &act, NULL);
 949   if (__gnat_get_interrupt_state (SIGADAABORT) != 's')
 950     sigaction (SIGADAABORT,  &act, NULL);
 951
 952   __gnat_handler_installed = 1;
 953 }
 954
 955 /*******************/
 956 /* Solaris Section */
 957 /*******************/
 958
 959 #elif defined (sun) && defined (__SVR4) && !defined (__vxworks)
 960
 961 #include <signal.h>
 962 #include <siginfo.h>
 963 #include <sys/ucontext.h>
 964 #include <sys/regset.h>
 965
 966 /* The code below is common to sparc and x86.  Beware of the delay slot
 967    differences for signal context adjustments.  */
 968
 969 #if defined (__sparc)
 970 #define RETURN_ADDR_OFFSET 8
 971 #else
 972 #define RETURN_ADDR_OFFSET 0
 973 #endif
 974
 975 /* Likewise regarding how the "instruction pointer" register slot can
 976    be identified in signal machine contexts.  We have either "REG_PC"
 977    or "PC" at hand, depending on the target CPU and solaris version.  */
 978
 979 #if !defined (REG_PC)
 980 #define REG_PC PC
 981 #endif
 982
 983 static void __gnat_error_handler (int, siginfo_t *, ucontext_t *);
 984
 985 /* __gnat_adjust_context_for_raise - see comments along with the default
 986    version later in this file.  */
 987
 988 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
 989
 990 void
 991 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED,
 992                                  void * ucontext)
 993 {
 994   mcontext_t *mcontext = & ((ucontext_t *)ucontext)->uc_mcontext;
 995   mcontext->gregs[REG_PC] += (1 - RETURN_ADDR_OFFSET);
 996 }
 997
 998 static void
 999 __gnat_error_handler (int sig, siginfo_t *sip, ucontext_t *uctx)
1000 {
1001   struct Exception_Data *exception;
1002   static int recurse = 0;
1003   const char *msg;
1004
1005   /* Adjusting is required for every fault context, so adjust for this one
1006      now, before we possibly trigger a recursive fault below.  */
1007   __gnat_adjust_context_for_raise (sig, (void *)uctx);
1008
1009   /* If this was an explicit signal from a "kill", just resignal it.  */
1010   if (SI_FROMUSER (sip))
1011     {
1012       signal (sig, SIG_DFL);
1013       kill (getpid(), sig);
1014     }
1015
1016   /* Otherwise, treat it as something we handle.  */
1017   switch (sig)
1018     {
1019     case SIGSEGV:
1020       /* If the problem was permissions, this is a constraint error.
1021          Likewise if the failing address isn't maximally aligned or if
1022          we've recursed.
1023
1024          ??? Using a static variable here isn't task-safe, but it's
1025          much too hard to do anything else and we're just determining
1026          which exception to raise.  */
1027       if (sip->si_code == SEGV_ACCERR
1028           || (((long) sip->si_addr) & 3) != 0
1029           || recurse)
1030         {
1031           exception = &constraint_error;
1032           msg = "SIGSEGV";
1033         }
1034       else
1035         {
1036           /* See if the page before the faulting page is accessible.  Do that
1037              by trying to access it.  We'd like to simply try to access
1038              4096 + the faulting address, but it's not guaranteed to be
1039              the actual address, just to be on the same page.  */
1040           recurse++;
1041           ((volatile char *)
1042            ((long) sip->si_addr & - getpagesize ()))[getpagesize ()];
1043           exception = &storage_error;
1044           msg = "stack overflow (or erroneous memory access)";
1045         }
1046       break;
1047
1048     case SIGBUS:
1049       exception = &program_error;
1050       msg = "SIGBUS";
1051       break;
1052
1053     case SIGFPE:
1054       exception = &constraint_error;
1055       msg = "SIGFPE";
1056       break;
1057
1058     default:
1059       exception = &program_error;
1060       msg = "unhandled signal";
1061     }
1062
1063   recurse = 0;
1064
1065   Raise_From_Signal_Handler (exception, msg);
1066 }
1067
1068 void
1069 __gnat_install_handler (void)
1070 {
1071   struct sigaction act;
1072
1073   /* Set up signal handler to map synchronous signals to appropriate
1074      exceptions.  Make sure that the handler isn't interrupted by another
1075      signal that might cause a scheduling event! */
1076
1077   act.sa_handler = __gnat_error_handler;
1078   act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
1079   sigemptyset (&act.sa_mask);
1080
1081   /* Do not install handlers if interrupt state is "System" */
1082   if (__gnat_get_interrupt_state (SIGABRT) != 's')
1083     sigaction (SIGABRT, &act, NULL);
1084   if (__gnat_get_interrupt_state (SIGFPE) != 's')
1085     sigaction (SIGFPE,  &act, NULL);
1086   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1087     sigaction (SIGSEGV, &act, NULL);
1088   if (__gnat_get_interrupt_state (SIGBUS) != 's')
1089     sigaction (SIGBUS,  &act, NULL);
1090
1091   __gnat_handler_installed = 1;
1092 }
1093
1094 /***************/
1095 /* VMS Section */
1096 /***************/
1097
1098 #elif defined (VMS)
1099
1100 long __gnat_error_handler (int *, void *);
1101
1102 #ifdef __IA64
1103 #define lib_get_curr_invo_context LIB$I64_GET_CURR_INVO_CONTEXT
1104 #define lib_get_prev_invo_context LIB$I64_GET_PREV_INVO_CONTEXT
1105 #define lib_get_invo_handle LIB$I64_GET_INVO_HANDLE
1106 #else
1107 #define lib_get_curr_invo_context LIB$GET_CURR_INVO_CONTEXT
1108 #define lib_get_prev_invo_context LIB$GET_PREV_INVO_CONTEXT
1109 #define lib_get_invo_handle LIB$GET_INVO_HANDLE
1110 #endif
1111
1112 #if defined (IN_RTS) && !defined (__IA64)
1113
1114 /* The prehandler actually gets control first on a condition. It swaps the
1115    stack pointer and calls the handler (__gnat_error_handler). */
1116 extern long __gnat_error_prehandler (void);
1117
1118 extern char *__gnat_error_prehandler_stack;   /* Alternate signal stack */
1119 #endif
1120
1121 /* Define macro symbols for the VMS conditions that become Ada exceptions.
1122    Most of these are also defined in the header file ssdef.h which has not
1123    yet been converted to be recognized by Gnu C. */
1124
1125 /* Defining these as macros, as opposed to external addresses, allows
1126    them to be used in a case statement (below */
1127 #define SS$_ACCVIO            12
1128 #define SS$_HPARITH         1284
1129 #define SS$_STKOVF          1364
1130 #define SS$_RESIGNAL        2328
1131
1132 /* These codes are in standard message libraries */
1133 extern int CMA$_EXIT_THREAD;
1134 extern int SS$_DEBUG;
1135 extern int SS$_INTDIV;
1136 extern int LIB$_KEYNOTFOU;
1137 extern int LIB$_ACTIMAGE;
1138 extern int MTH$_FLOOVEMAT;       /* Some ACVC_21 CXA tests */
1139
1140 /* These codes are non standard, which is to say the author is
1141    not sure if they are defined in the standard message libraries
1142    so keep them as macros for now. */
1143 #define RDB$_STREAM_EOF 20480426
1144 #define FDL$_UNPRIKW 11829410
1145
1146 struct cond_except {
1147   const int *cond;
1148   const struct Exception_Data *except;
1149 };
1150
1151 struct descriptor_s {unsigned short len, mbz; __char_ptr32 adr; };
1152
1153 /* Conditions that don't have an Ada exception counterpart must raise
1154    Non_Ada_Error.  Since this is defined in s-auxdec, it should only be
1155    referenced by user programs, not the compiler or tools. Hence the
1156    #ifdef IN_RTS. */
1157
1158 #ifdef IN_RTS
1159
1160 #define Status_Error ada__io_exceptions__status_error
1161 extern struct Exception_Data Status_Error;
1162
1163 #define Mode_Error ada__io_exceptions__mode_error
1164 extern struct Exception_Data Mode_Error;
1165
1166 #define Name_Error ada__io_exceptions__name_error
1167 extern struct Exception_Data Name_Error;
1168
1169 #define Use_Error ada__io_exceptions__use_error
1170 extern struct Exception_Data Use_Error;
1171
1172 #define Device_Error ada__io_exceptions__device_error
1173 extern struct Exception_Data Device_Error;
1174
1175 #define End_Error ada__io_exceptions__end_error
1176 extern struct Exception_Data End_Error;
1177
1178 #define Data_Error ada__io_exceptions__data_error
1179 extern struct Exception_Data Data_Error;
1180
1181 #define Layout_Error ada__io_exceptions__layout_error
1182 extern struct Exception_Data Layout_Error;
1183
1184 #define Non_Ada_Error system__aux_dec__non_ada_error
1185 extern struct Exception_Data Non_Ada_Error;
1186
1187 #define Coded_Exception system__vms_exception_table__coded_exception
1188 extern struct Exception_Data *Coded_Exception (Exception_Code);
1189
1190 #define Base_Code_In system__vms_exception_table__base_code_in
1191 extern Exception_Code Base_Code_In (Exception_Code);
1192
1193 /* DEC Ada exceptions are not defined in a header file, so they
1194    must be declared as external addresses */
1195
1196 extern int ADA$_PROGRAM_ERROR;
1197 extern int ADA$_LOCK_ERROR;
1198 extern int ADA$_EXISTENCE_ERROR;
1199 extern int ADA$_KEY_ERROR;
1200 extern int ADA$_KEYSIZERR;
1201 extern int ADA$_STAOVF;
1202 extern int ADA$_CONSTRAINT_ERRO;
1203 extern int ADA$_IOSYSFAILED;
1204 extern int ADA$_LAYOUT_ERROR;
1205 extern int ADA$_STORAGE_ERROR;
1206 extern int ADA$_DATA_ERROR;
1207 extern int ADA$_DEVICE_ERROR;
1208 extern int ADA$_END_ERROR;
1209 extern int ADA$_MODE_ERROR;
1210 extern int ADA$_NAME_ERROR;
1211 extern int ADA$_STATUS_ERROR;
1212 extern int ADA$_NOT_OPEN;
1213 extern int ADA$_ALREADY_OPEN;
1214 extern int ADA$_USE_ERROR;
1215 extern int ADA$_UNSUPPORTED;
1216 extern int ADA$_FAC_MODE_MISMAT;
1217 extern int ADA$_ORG_MISMATCH;
1218 extern int ADA$_RFM_MISMATCH;
1219 extern int ADA$_RAT_MISMATCH;
1220 extern int ADA$_MRS_MISMATCH;
1221 extern int ADA$_MRN_MISMATCH;
1222 extern int ADA$_KEY_MISMATCH;
1223 extern int ADA$_MAXLINEXC;
1224 extern int ADA$_LINEXCMRS;
1225
1226 /* DEC Ada specific conditions */
1227 static const struct cond_except dec_ada_cond_except_table [] = {
1228   {&ADA$_PROGRAM_ERROR,   &program_error},
1229   {&ADA$_USE_ERROR,       &Use_Error},
1230   {&ADA$_KEYSIZERR,       &program_error},
1231   {&ADA$_STAOVF,          &storage_error},
1232   {&ADA$_CONSTRAINT_ERRO, &constraint_error},
1233   {&ADA$_IOSYSFAILED,     &Device_Error},
1234   {&ADA$_LAYOUT_ERROR,    &Layout_Error},
1235   {&ADA$_STORAGE_ERROR,   &storage_error},
1236   {&ADA$_DATA_ERROR,      &Data_Error},
1237   {&ADA$_DEVICE_ERROR,    &Device_Error},
1238   {&ADA$_END_ERROR,       &End_Error},
1239   {&ADA$_MODE_ERROR,      &Mode_Error},
1240   {&ADA$_NAME_ERROR,      &Name_Error},
1241   {&ADA$_STATUS_ERROR,    &Status_Error},
1242   {&ADA$_NOT_OPEN,        &Use_Error},
1243   {&ADA$_ALREADY_OPEN,    &Use_Error},
1244   {&ADA$_USE_ERROR,       &Use_Error},
1245   {&ADA$_UNSUPPORTED,     &Use_Error},
1246   {&ADA$_FAC_MODE_MISMAT, &Use_Error},
1247   {&ADA$_ORG_MISMATCH,    &Use_Error},
1248   {&ADA$_RFM_MISMATCH,    &Use_Error},
1249   {&ADA$_RAT_MISMATCH,    &Use_Error},
1250   {&ADA$_MRS_MISMATCH,    &Use_Error},
1251   {&ADA$_MRN_MISMATCH,    &Use_Error},
1252   {&ADA$_KEY_MISMATCH,    &Use_Error},
1253   {&ADA$_MAXLINEXC,       &constraint_error},
1254   {&ADA$_LINEXCMRS,       &constraint_error},
1255   {0,                     0}
1256 };
1257
1258 #if 0
1259    /* Already handled by a pragma Import_Exception
1260       in Aux_IO_Exceptions */
1261   {&ADA$_LOCK_ERROR,      &Lock_Error},
1262   {&ADA$_EXISTENCE_ERROR, &Existence_Error},
1263   {&ADA$_KEY_ERROR,       &Key_Error},
1264 #endif
1265
1266 #endif /* IN_RTS */
1267
1268 /* Non DEC Ada specific conditions. We could probably also put
1269    SS$_HPARITH here and possibly SS$_ACCVIO, SS$_STKOVF. */
1270 static const struct cond_except cond_except_table [] = {
1271   {&MTH$_FLOOVEMAT, &constraint_error},
1272   {&SS$_INTDIV,     &constraint_error},
1273   {0,               0}
1274 };
1275
1276 /* To deal with VMS conditions and their mapping to Ada exceptions,
1277    the __gnat_error_handler routine below is installed as an exception
1278    vector having precedence over DEC frame handlers.  Some conditions
1279    still need to be handled by such handlers, however, in which case
1280    __gnat_error_handler needs to return SS$_RESIGNAL.  Consider for
1281    instance the use of a third party library compiled with DECAda and
1282    performing it's own exception handling internally.
1283
1284    To allow some user-level flexibility, which conditions should be
1285    resignaled is controlled by a predicate function, provided with the
1286    condition value and returning a boolean indication stating whether
1287    this condition should be resignaled or not.
1288
1289    That predicate function is called indirectly, via a function pointer,
1290    by __gnat_error_handler, and changing that pointer is allowed to the
1291    the user code by way of the __gnat_set_resignal_predicate interface.
1292
1293    The user level function may then implement what it likes, including
1294    for instance the maintenance of a dynamic data structure if the set
1295    of to be resignalled conditions has to change over the program's
1296    lifetime.
1297
1298    ??? This is not a perfect solution to deal with the possible
1299    interactions between the GNAT and the DECAda exception handling
1300    models and better (more general) schemes are studied.  This is so
1301    just provided as a convenient workaround in the meantime, and
1302    should be use with caution since the implementation has been kept
1303    very simple.  */
1304
1305 typedef int
1306 resignal_predicate (int code);
1307
1308 const int *cond_resignal_table [] = {
1309   &CMA$_EXIT_THREAD,
1310   &SS$_DEBUG,
1311   &LIB$_KEYNOTFOU,
1312   &LIB$_ACTIMAGE,
1313   (int *) RDB$_STREAM_EOF,
1314   (int *) FDL$_UNPRIKW,
1315   0
1316 };
1317
1318 const int facility_resignal_table [] = {
1319   0x1380000, /* RDB */
1320   0x2220000, /* SQL */
1321   0
1322 };
1323
1324 /* Default GNAT predicate for resignaling conditions.  */
1325
1326 static int
1327 __gnat_default_resignal_p (int code)
1328 {
1329   int i, iexcept;
1330
1331   for (i = 0; facility_resignal_table [i]; i++)
1332     if ((code & 0xfff0000) == facility_resignal_table [i])
1333       return 1;
1334
1335   for (i = 0, iexcept = 0;
1336        cond_resignal_table [i] &&
1337        !(iexcept = LIB$MATCH_COND (&code, &cond_resignal_table [i]));
1338        i++);
1339
1340   return iexcept;
1341 }
1342
1343 /* Static pointer to predicate that the __gnat_error_handler exception
1344    vector invokes to determine if it should resignal a condition.  */
1345
1346 static resignal_predicate * __gnat_resignal_p = __gnat_default_resignal_p;
1347
1348 /* User interface to change the predicate pointer to PREDICATE. Reset to
1349    the default if PREDICATE is null.  */
1350
1351 void
1352 __gnat_set_resignal_predicate (resignal_predicate * predicate)
1353 {
1354   if (predicate == 0)
1355     __gnat_resignal_p = __gnat_default_resignal_p;
1356   else
1357     __gnat_resignal_p = predicate;
1358 }
1359
1360 /* Should match System.Parameters.Default_Exception_Msg_Max_Length */
1361 #define Default_Exception_Msg_Max_Length 512
1362
1363 /* Action routine for SYS$PUTMSG. There may be
1364    multiple conditions, each with text to be appended to
1365    MESSAGE and separated by line termination. */
1366
1367 static int
1368 copy_msg (msgdesc, message)
1369      struct descriptor_s *msgdesc;
1370      char *message;
1371 {
1372   int len = strlen (message);
1373   int copy_len;
1374
1375   /* Check for buffer overflow and skip */
1376   if (len > 0 && len <= Default_Exception_Msg_Max_Length - 3)
1377     {
1378       strcat (message, "\r\n");
1379       len += 2;
1380     }
1381
1382   /* Check for buffer overflow and truncate if necessary */
1383   copy_len = (len + msgdesc->len <= Default_Exception_Msg_Max_Length - 1 ?
1384               msgdesc->len :
1385               Default_Exception_Msg_Max_Length - 1 - len);
1386   strncpy (&message [len], msgdesc->adr, copy_len);
1387   message [len + copy_len] = 0;
1388
1389   return 0;
1390 }
1391
1392 long
1393 __gnat_handle_vms_condition (int *sigargs, void *mechargs)
1394 {
1395   struct Exception_Data *exception = 0;
1396   Exception_Code base_code;
1397   struct descriptor_s gnat_facility = {4,0,"GNAT"};
1398   char message [Default_Exception_Msg_Max_Length];
1399
1400   const char *msg = "";
1401
1402   /* Check for conditions to resignal which aren't effected by pragma
1403      Import_Exception.  */
1404   if (__gnat_resignal_p (sigargs [1]))
1405     return SS$_RESIGNAL;
1406
1407 #ifdef IN_RTS
1408   /* See if it's an imported exception. Beware that registered exceptions
1409      are bound to their base code, with the severity bits masked off.  */
1410   base_code = Base_Code_In ((Exception_Code) sigargs [1]);
1411   exception = Coded_Exception (base_code);
1412
1413   if (exception)
1414     {
1415       message [0] = 0;
1416
1417       /* Subtract PC & PSL fields which messes with PUTMSG */
1418       sigargs [0] -= 2;
1419       SYS$PUTMSG (sigargs, copy_msg, &gnat_facility, message);
1420       sigargs [0] += 2;
1421       msg = message;
1422
1423       exception->Name_Length = 19;
1424       /* The full name really should be get sys$getmsg returns. ??? */
1425       exception->Full_Name = "IMPORTED_EXCEPTION";
1426       exception->Import_Code = base_code;
1427
1428 #ifdef __IA64
1429       /* Do not adjust the program counter as already points to the next
1430          instruction (just after the call to LIB$STOP).  */
1431       Raise_From_Signal_Handler (exception, msg);
1432 #endif
1433     }
1434 #endif
1435
1436   if (exception == 0)
1437     switch (sigargs[1])
1438       {
1439       case SS$_ACCVIO:
1440         if (sigargs[3] == 0)
1441           {
1442             exception = &constraint_error;
1443             msg = "access zero";
1444           }
1445         else
1446           {
1447             exception = &storage_error;
1448             msg = "stack overflow (or erroneous memory access)";
1449           }
1450         __gnat_adjust_context_for_raise (0, (void *)mechargs);
1451         break;
1452
1453       case SS$_STKOVF:
1454         exception = &storage_error;
1455         msg = "stack overflow";
1456         __gnat_adjust_context_for_raise (0, (void *)mechargs);
1457         break;
1458
1459       case SS$_HPARITH:
1460 #ifndef IN_RTS
1461         return SS$_RESIGNAL; /* toplev.c handles for compiler */
1462 #else
1463         exception = &constraint_error;
1464         msg = "arithmetic error";
1465         __gnat_adjust_context_for_raise (0, (void *)mechargs);
1466 #endif
1467         break;
1468
1469       default:
1470 #ifdef IN_RTS
1471         {
1472           int i;
1473
1474           /* Scan the DEC Ada exception condition table for a match and fetch
1475              the associated GNAT exception pointer */
1476           for (i = 0;
1477                dec_ada_cond_except_table [i].cond &&
1478                !LIB$MATCH_COND (&sigargs [1],
1479                                 &dec_ada_cond_except_table [i].cond);
1480                i++);
1481           exception = (struct Exception_Data *)
1482             dec_ada_cond_except_table [i].except;
1483
1484           if (!exception)
1485             {
1486               /* Scan the VMS standard condition table for a match and fetch
1487                  the associated GNAT exception pointer */
1488               for (i = 0;
1489                    cond_except_table [i].cond &&
1490                    !LIB$MATCH_COND (&sigargs [1], &cond_except_table [i].cond);
1491                    i++);
1492               exception = (struct Exception_Data *)
1493                 cond_except_table [i].except;
1494
1495               if (!exception)
1496                 /* User programs expect Non_Ada_Error to be raised, reference
1497                    DEC Ada test CXCONDHAN. */
1498                 exception = &Non_Ada_Error;
1499             }
1500         }
1501 #else
1502         exception = &program_error;
1503 #endif
1504         message [0] = 0;
1505         /* Subtract PC & PSL fields which messes with PUTMSG */
1506         sigargs [0] -= 2;
1507         SYS$PUTMSG (sigargs, copy_msg, &gnat_facility, message);
1508         sigargs [0] += 2;
1509         msg = message;
1510         break;
1511       }
1512
1513   Raise_From_Signal_Handler (exception, msg);
1514 }
1515
1516 long
1517 __gnat_error_handler (int *sigargs, void *mechargs)
1518 {
1519   return __gnat_handle_vms_condition (sigargs, mechargs);
1520 }
1521
1522 void
1523 __gnat_install_handler (void)
1524 {
1525   long prvhnd ATTRIBUTE_UNUSED;
1526
1527 #if !defined (IN_RTS)
1528   SYS$SETEXV (1, __gnat_error_handler, 3, &prvhnd);
1529 #endif
1530
1531   /* On alpha-vms, we avoid the global vector annoyance thanks to frame based
1532      handlers to turn conditions into exceptions since GCC 3.4.  The global
1533      vector is still required for earlier GCC versions.  We're resorting to
1534      the __gnat_error_prehandler assembly function in this case.  */
1535
1536 #if defined (IN_RTS) && defined (__alpha__)
1537   if ((__GNUC__ * 10 + __GNUC_MINOR__) < 34)
1538     {
1539       char * c = (char *) xmalloc (2049);
1540
1541       __gnat_error_prehandler_stack = &c[2048];
1542       SYS$SETEXV (1, __gnat_error_prehandler, 3, &prvhnd);
1543     }
1544 #endif
1545
1546   __gnat_handler_installed = 1;
1547 }
1548
1549 /* __gnat_adjust_context_for_raise for alpha - see comments along with the
1550    default version later in this file.  */
1551
1552 #if defined (IN_RTS) && defined (__alpha__)
1553
1554 #include <vms/chfctxdef.h>
1555 #include <vms/chfdef.h>
1556
1557 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
1558
1559 void
1560 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
1561 {
1562   /* Add one to the address of the instruction signaling the condition,
1563      located in the sigargs array.  */
1564
1565   CHF$MECH_ARRAY * mechargs = (CHF$MECH_ARRAY *) ucontext;
1566   CHF$SIGNAL_ARRAY * sigargs
1567     = (CHF$SIGNAL_ARRAY *) mechargs->chf$q_mch_sig_addr;
1568
1569   int vcount = sigargs->chf$is_sig_args;
1570   int * pc_slot = & (&sigargs->chf$l_sig_name)[vcount-2];
1571
1572   (*pc_slot) ++;
1573 }
1574
1575 #endif
1576
1577 /* __gnat_adjust_context_for_raise for ia64.  */
1578
1579 #if defined (IN_RTS) && defined (__IA64)
1580
1581 #include <vms/chfctxdef.h>
1582 #include <vms/chfdef.h>
1583
1584 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
1585
1586 typedef unsigned long long u64;
1587
1588 void
1589 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
1590 {
1591   /* Add one to the address of the instruction signaling the condition,
1592      located in the 64bits sigargs array.  */
1593
1594   CHF$MECH_ARRAY * mechargs = (CHF$MECH_ARRAY *) ucontext;
1595
1596   CHF64$SIGNAL_ARRAY *chfsig64
1597     = (CHF64$SIGNAL_ARRAY *) mechargs->chf$ph_mch_sig64_addr;
1598
1599   u64 * post_sigarray
1600     = (u64 *)chfsig64 + 1 + chfsig64->chf64$l_sig_args;
1601
1602   u64 * ih_pc_loc = post_sigarray - 2;
1603
1604   (*ih_pc_loc) ++;
1605 }
1606
1607 #endif
1608
1609 /*******************/
1610 /* FreeBSD Section */
1611 /*******************/
1612
1613 #elif defined (__FreeBSD__)
1614
1615 #include <signal.h>
1616 #include <sys/ucontext.h>
1617 #include <unistd.h>
1618
1619 static void __gnat_error_handler (int, siginfo_t *, ucontext_t *);
1620 void __gnat_adjust_context_for_raise (int, void*);
1621
1622 /* __gnat_adjust_context_for_raise - see comments along with the default
1623    version later in this file.  */
1624
1625 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
1626
1627 void
1628 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
1629 {
1630   mcontext_t *mcontext = &((ucontext_t *) ucontext)->uc_mcontext;
1631   mcontext->mc_eip++;
1632 }
1633
1634 static void
1635 __gnat_error_handler (int sig, siginfo_t *info __attribute__ ((unused)),
1636                       ucontext_t *ucontext)
1637 {
1638   struct Exception_Data *exception;
1639   const char *msg;
1640
1641   switch (sig)
1642     {
1643     case SIGFPE:
1644       exception = &constraint_error;
1645       msg = "SIGFPE";
1646       break;
1647
1648     case SIGILL:
1649       exception = &constraint_error;
1650       msg = "SIGILL";
1651       break;
1652
1653     case SIGSEGV:
1654       exception = &storage_error;
1655       msg = "stack overflow or erroneous memory access";
1656       break;
1657
1658     case SIGBUS:
1659       exception = &constraint_error;
1660       msg = "SIGBUS";
1661       break;
1662
1663     default:
1664       exception = &program_error;
1665       msg = "unhandled signal";
1666     }
1667
1668   __gnat_adjust_context_for_raise (sig, ucontext);
1669   Raise_From_Signal_Handler (exception, msg);
1670 }
1671
1672 void
1673 __gnat_install_handler ()
1674 {
1675   struct sigaction act;
1676
1677   /* Set up signal handler to map synchronous signals to appropriate
1678      exceptions.  Make sure that the handler isn't interrupted by another
1679      signal that might cause a scheduling event! */
1680
1681   act.sa_sigaction
1682     = (void (*)(int, struct __siginfo *, void*)) __gnat_error_handler;
1683   act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
1684   (void) sigemptyset (&act.sa_mask);
1685
1686   (void) sigaction (SIGILL,  &act, NULL);
1687   (void) sigaction (SIGFPE,  &act, NULL);
1688   (void) sigaction (SIGSEGV, &act, NULL);
1689   (void) sigaction (SIGBUS,  &act, NULL);
1690
1691   __gnat_handler_installed = 1;
1692 }
1693
1694 /*******************/
1695 /* VxWorks Section */
1696 /*******************/
1697
1698 #elif defined(__vxworks)
1699
1700 #include <signal.h>
1701 #include <taskLib.h>
1702
1703 #ifndef __RTP__
1704 #include <intLib.h>
1705 #include <iv.h>
1706 #endif
1707
1708 #ifdef VTHREADS
1709 #include "private/vThreadsP.h"
1710 #endif
1711
1712 static void __gnat_error_handler (int, int, struct sigcontext *);
1713 void __gnat_map_signal (int);
1714
1715 #ifndef __RTP__
1716
1717 /* Directly vectored Interrupt routines are not supported when using RTPs */
1718
1719 extern int __gnat_inum_to_ivec (int);
1720
1721 /* This is needed by the GNAT run time to handle Vxworks interrupts */
1722 int
1723 __gnat_inum_to_ivec (int num)
1724 {
1725   return INUM_TO_IVEC (num);
1726 }
1727 #endif
1728
1729 #if !defined(__alpha_vxworks) && (_WRS_VXWORKS_MAJOR != 6) && !defined(__RTP__)
1730
1731 /* getpid is used by s-parint.adb, but is not defined by VxWorks, except
1732    on Alpha VxWorks and VxWorks 6.x (including RTPs). */
1733
1734 extern long getpid (void);
1735
1736 long
1737 getpid (void)
1738 {
1739   return taskIdSelf ();
1740 }
1741 #endif
1742
1743 /* VxWorks expects the field excCnt to be zeroed when a signal is handled.
1744    The VxWorks version of longjmp does this; gcc's builtin_longjmp does not */
1745 void
1746 __gnat_clear_exception_count (void)
1747 {
1748 #ifdef VTHREADS
1749   WIND_TCB *currentTask = (WIND_TCB *) taskIdSelf();
1750
1751   currentTask->vThreads.excCnt = 0;
1752 #endif
1753 }
1754
1755 /* Exported to s-intman-vxworks.adb in order to handle different signal
1756    to exception mappings in different VxWorks versions */
1757 void
1758 __gnat_map_signal (int sig)
1759 {
1760   struct Exception_Data *exception;
1761   const char *msg;
1762
1763   switch (sig)
1764     {
1765     case SIGFPE:
1766       exception = &constraint_error;
1767       msg = "SIGFPE";
1768       break;
1769 #ifdef VTHREADS
1770     case SIGILL:
1771       exception = &constraint_error;
1772       msg = "Floating point exception or SIGILL";
1773       break;
1774     case SIGSEGV:
1775       exception = &storage_error;
1776       msg = "SIGSEGV: possible stack overflow";
1777       break;
1778     case SIGBUS:
1779       exception = &storage_error;
1780       msg = "SIGBUS: possible stack overflow";
1781       break;
1782 #else
1783     case SIGILL:
1784       exception = &constraint_error;
1785       msg = "SIGILL";
1786       break;
1787 /* In RTP mode a SIGSEGV is most likely due to a stack overflow. This is not
1788    the case in kernel mode where stack overflow detection uses a comparison
1789    method instead of memory probes. */
1790 #ifdef __RTP__
1791     case SIGSEGV:
1792       exception = &storage_error;
1793       msg = "SIGSEGV: possible stack overflow";
1794       break;
1795 #else
1796     case SIGSEGV:
1797       exception = &program_error;
1798       msg = "SIGSEGV";
1799       break;
1800 #endif
1801     case SIGBUS:
1802       exception = &program_error;
1803       msg = "SIGBUS";
1804       break;
1805 #endif
1806     default:
1807       exception = &program_error;
1808       msg = "unhandled signal";
1809     }
1810
1811   __gnat_clear_exception_count ();
1812   Raise_From_Signal_Handler (exception, msg);
1813 }
1814
1815 static void
1816 __gnat_error_handler (int sig, int code, struct sigcontext *sc)
1817 {
1818   sigset_t mask;
1819   int result;
1820
1821   /* VxWorks will always mask out the signal during the signal handler and
1822      will reenable it on a longjmp.  GNAT does not generate a longjmp to
1823      return from a signal handler so the signal will still be masked unless
1824      we unmask it. */
1825   sigprocmask (SIG_SETMASK, NULL, &mask);
1826   sigdelset (&mask, sig);
1827   sigprocmask (SIG_SETMASK, &mask, NULL);
1828
1829   __gnat_map_signal (sig);
1830
1831 }
1832
1833 void
1834 __gnat_install_handler (void)
1835 {
1836   struct sigaction act;
1837
1838   /* Setup signal handler to map synchronous signals to appropriate
1839      exceptions.  Make sure that the handler isn't interrupted by another
1840      signal that might cause a scheduling event! */
1841
1842   act.sa_handler = __gnat_error_handler;
1843   act.sa_flags = SA_SIGINFO | SA_ONSTACK;
1844   sigemptyset (&act.sa_mask);
1845
1846   /* For VxWorks, install all signal handlers, since pragma Interrupt_State
1847      applies to vectored hardware interrupts, not signals */
1848   sigaction (SIGFPE,  &act, NULL);
1849   sigaction (SIGILL,  &act, NULL);
1850   sigaction (SIGSEGV, &act, NULL);
1851   sigaction (SIGBUS,  &act, NULL);
1852
1853   __gnat_handler_installed = 1;
1854 }
1855
1856 #define HAVE_GNAT_INIT_FLOAT
1857
1858 void
1859 __gnat_init_float (void)
1860 {
1861   /* Disable overflow/underflow exceptions on the PPC processor, this is needed
1862      to get correct Ada semantics.  Note that for AE653 vThreads, the HW
1863      overflow settings are an OS configuration issue.  The instructions
1864      below have no effect */
1865 #if defined (_ARCH_PPC) && !defined (_SOFT_FLOAT) && !defined (VTHREADS)
1866   asm ("mtfsb0 25");
1867   asm ("mtfsb0 26");
1868 #endif
1869
1870 #if (defined (__i386__) || defined (i386)) && !defined (VTHREADS)
1871   /* This is used to properly initialize the FPU on an x86 for each
1872      process thread. */
1873   asm ("finit");
1874 #endif
1875
1876   /* Similarly for sparc64. Achieved by masking bits in the Trap Enable Mask
1877      field of the Floating-point Status Register (see the SPARC Architecture
1878      Manual Version 9, p 48).  */
1879 #if defined (sparc64)
1880
1881 #define FSR_TEM_NVM (1 << 27)  /* Invalid operand  */
1882 #define FSR_TEM_OFM (1 << 26)  /* Overflow  */
1883 #define FSR_TEM_UFM (1 << 25)  /* Underflow  */
1884 #define FSR_TEM_DZM (1 << 24)  /* Division by Zero  */
1885 #define FSR_TEM_NXM (1 << 23)  /* Inexact result  */
1886   {
1887     unsigned int fsr;
1888
1889     __asm__("st %%fsr, %0" : "=m" (fsr));
1890     fsr &= ~(FSR_TEM_OFM | FSR_TEM_UFM);
1891     __asm__("ld %0, %%fsr" : : "m" (fsr));
1892   }
1893 #endif
1894 }
1895
1896 /******************/
1897 /* NetBSD Section */
1898 /******************/
1899
1900 #elif defined(__NetBSD__)
1901
1902 #include <signal.h>
1903 #include <unistd.h>
1904
1905 static void
1906 __gnat_error_handler (int sig)
1907 {
1908   struct Exception_Data *exception;
1909   const char *msg;
1910
1911   switch(sig)
1912   {
1913     case SIGFPE:
1914       exception = &constraint_error;
1915       msg = "SIGFPE";
1916       break;
1917     case SIGILL:
1918       exception = &constraint_error;
1919       msg = "SIGILL";
1920       break;
1921     case SIGSEGV:
1922       exception = &storage_error;
1923       msg = "stack overflow or erroneous memory access";
1924       break;
1925     case SIGBUS:
1926       exception = &constraint_error;
1927       msg = "SIGBUS";
1928       break;
1929     default:
1930       exception = &program_error;
1931       msg = "unhandled signal";
1932     }
1933
1934     Raise_From_Signal_Handler(exception, msg);
1935 }
1936
1937 void
1938 __gnat_install_handler(void)
1939 {
1940   struct sigaction act;
1941
1942   act.sa_handler = __gnat_error_handler;
1943   act.sa_flags = SA_NODEFER | SA_RESTART;
1944   sigemptyset (&act.sa_mask);
1945
1946   /* Do not install handlers if interrupt state is "System" */
1947   if (__gnat_get_interrupt_state (SIGFPE) != 's')
1948     sigaction (SIGFPE,  &act, NULL);
1949   if (__gnat_get_interrupt_state (SIGILL) != 's')
1950     sigaction (SIGILL,  &act, NULL);
1951   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1952     sigaction (SIGSEGV, &act, NULL);
1953   if (__gnat_get_interrupt_state (SIGBUS) != 's')
1954     sigaction (SIGBUS,  &act, NULL);
1955
1956   __gnat_handler_installed = 1;
1957 }
1958
1959 #else
1960
1961 /* For all other versions of GNAT, the handler does nothing */
1962
1963 /*******************/
1964 /* Default Section */
1965 /*******************/
1966
1967 void
1968 __gnat_install_handler (void)
1969 {
1970   __gnat_handler_installed = 1;
1971 }
1972
1973 #endif
1974
1975 /*********************/
1976 /* __gnat_init_float */
1977 /*********************/
1978
1979 /* This routine is called as each process thread is created, for possible
1980    initialization of the FP processor. This version is used under INTERIX,
1981    WIN32 and could be used under OS/2 */
1982
1983 #if defined (_WIN32) || defined (__INTERIX) || defined (__EMX__) \
1984   || defined (__Lynx__) || defined(__NetBSD__) || defined(__FreeBSD__)
1985
1986 #define HAVE_GNAT_INIT_FLOAT
1987
1988 void
1989 __gnat_init_float (void)
1990 {
1991 #if defined (__i386__) || defined (i386)
1992
1993   /* This is used to properly initialize the FPU on an x86 for each
1994      process thread. */
1995
1996   asm ("finit");
1997
1998 #endif  /* Defined __i386__ */
1999 }
2000 #endif
2001
2002 #ifndef HAVE_GNAT_INIT_FLOAT
2003
2004 /* All targets without a specific __gnat_init_float will use an empty one */
2005 void
2006 __gnat_init_float (void)
2007 {
2008 }
2009 #endif
2010
2011 /***********************************/
2012 /* __gnat_adjust_context_for_raise */
2013 /***********************************/
2014
2015 #ifndef HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
2016
2017 /* All targets without a specific version will use an empty one */
2018
2019 /* Given UCONTEXT a pointer to a context structure received by a signal
2020    handler for SIGNO, perform the necessary adjustments to let the handler
2021    raise an exception.  Calls to this routine are not conditioned by the
2022    propagation scheme in use.  */
2023
2024 void
2025 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED,
2026                                  void *ucontext ATTRIBUTE_UNUSED)
2027 {
2028   /* Adjustments are currently required for the GCC ZCX propagation scheme
2029      only.  These adjustments (described below) are harmless for the other
2030      schemes, so may be applied unconditionally.  */
2031
2032   /* Adjustments required for a GCC ZCX propagation scheme:
2033      ------------------------------------------------------
2034
2035      The GCC unwinder expects to be dealing with call return addresses, since
2036      this is the "nominal" case of what we retrieve while unwinding a regular
2037      call chain.
2038
2039      To evaluate if a handler applies at some point identified by a return
2040      address, the propagation engine needs to determine what region the
2041      corresponding call instruction pertains to.  Because the return address
2042      may not be attached to the same region as the call, the unwinder always
2043      subtracts "some" amount from a return address to search the region
2044      tables, amount chosen to ensure that the resulting address is inside the
2045      call instruction.
2046
2047      When we raise an exception from a signal handler, e.g. to transform a
2048      SIGSEGV into Storage_Error, things need to appear as if the signal
2049      handler had been "called" by the instruction which triggered the signal,
2050      so that exception handlers that apply there are considered.  What the
2051      unwinder will retrieve as the return address from the signal handler is
2052      what it will find as the faulting instruction address in the signal
2053      context pushed by the kernel.  Leaving this address untouched looses, if
2054      the triggering instruction happens to be the very first of a region, as
2055      the later adjustments performed by the unwinder would yield an address
2056      outside that region.  We need to compensate for the unwinder adjustments
2057      at some point, and this is what this routine is expected to do.
2058
2059      signo is passed because on some targets for some signals the PC in
2060      context points to the instruction after the faulting one, in which case
2061      the unwinder adjustment is still desired.
2062
2063      We used to perform the compensation in the GCC unwinding fallback macro.
2064      The thread at http://gcc.gnu.org/ml/gcc-patches/2004-05/msg00343.html
2065      describes a couple of issues with this approach.  First, on some targets
2066      the adjustment to apply depends on the triggering signal, which is not
2067      easily accessible from the macro.  Besides, other languages, e.g. Java,
2068      deal with this by performing the adjustment in the signal handler before
2069      the raise, so fallback adjustments just break those front-ends.  */
2070 }
2071
2072 #endif