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 bootstrapping 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 /* IRIX Section */
 742 /****************/
 743
 744 #elif defined (sgi)
 745
 746 #include <signal.h>
 747 #include <siginfo.h>
 748
 749 #ifndef NULL
 750 #define NULL 0
 751 #endif
 752
 753 #define SIGADAABORT 48
 754 #define SIGNAL_STACK_SIZE 4096
 755 #define SIGNAL_STACK_ALIGNMENT 64
 756
 757 #define Check_Abort_Status     \
 758                       system__soft_links__check_abort_status
 759 extern int (*Check_Abort_Status) (void);
 760
 761 extern struct Exception_Data _abort_signal;
 762
 763 static void __gnat_error_handler (int, int, sigcontext_t *);
 764
 765 /* We are not setting the SA_SIGINFO bit in the sigaction flags when
 766    connecting that handler, with the effects described in the sigaction
 767    man page:
 768
 769           SA_SIGINFO [...]
 770           If cleared and the signal is caught, the first argument is
 771           also the signal number but the second argument is the signal
 772           code identifying the cause of the signal. The third argument
 773           points to a sigcontext_t structure containing the receiving
 774           process's context when the signal was delivered.
 775 */
 776
 777 static void
 778 __gnat_error_handler (int sig, int code, sigcontext_t *sc ATTRIBUTE_UNUSED)
 779 {
 780   struct Exception_Data *exception;
 781   const char *msg;
 782
 783   switch (sig)
 784     {
 785     case SIGSEGV:
 786       if (code == EFAULT)
 787         {
 788           exception = &program_error;
 789           msg = "SIGSEGV: (Invalid virtual address)";
 790         }
 791       else if (code == ENXIO)
 792         {
 793           exception = &program_error;
 794           msg = "SIGSEGV: (Read beyond mapped object)";
 795         }
 796       else if (code == ENOSPC)
 797         {
 798           exception = &program_error; /* ??? storage_error ??? */
 799           msg = "SIGSEGV: (Autogrow for file failed)";
 800         }
 801       else if (code == EACCES || code == EEXIST)
 802         {
 803           /* ??? We handle stack overflows here, some of which do trigger
 804                  SIGSEGV + EEXIST on Irix 6.5 although EEXIST is not part of
 805                  the documented valid codes for SEGV in the signal(5) man
 806                  page.  */
 807
 808           /* ??? Re-add smarts to further verify that we launched
 809                  the stack into a guard page, not an attempt to
 810                  write to .text or something */
 811           exception = &storage_error;
 812           msg = "SIGSEGV: (stack overflow or erroneous memory access)";
 813         }
 814       else
 815         {
 816           /* Just in case the OS guys did it to us again.  Sometimes
 817              they fail to document all of the valid codes that are
 818              passed to signal handlers, just in case someone depends
 819              on knowing all the codes */
 820           exception = &program_error;
 821           msg = "SIGSEGV: (Undocumented reason)";
 822         }
 823       break;
 824
 825     case SIGBUS:
 826       /* Map all bus errors to Program_Error.  */
 827       exception = &program_error;
 828       msg = "SIGBUS";
 829       break;
 830
 831     case SIGFPE:
 832       /* Map all fpe errors to Constraint_Error.  */
 833       exception = &constraint_error;
 834       msg = "SIGFPE";
 835       break;
 836
 837     case SIGADAABORT:
 838       if ((*Check_Abort_Status) ())
 839         {
 840           exception = &_abort_signal;
 841           msg = "";
 842         }
 843       else
 844         return;
 845
 846       break;
 847
 848     default:
 849       /* Everything else is a Program_Error. */
 850       exception = &program_error;
 851       msg = "unhandled signal";
 852     }
 853
 854   Raise_From_Signal_Handler (exception, msg);
 855 }
 856
 857 void
 858 __gnat_install_handler (void)
 859 {
 860   struct sigaction act;
 861
 862   /* Setup signal handler to map synchronous signals to appropriate
 863      exceptions.  Make sure that the handler isn't interrupted by another
 864      signal that might cause a scheduling event! */
 865
 866   act.sa_handler = __gnat_error_handler;
 867   act.sa_flags = SA_NODEFER + SA_RESTART;
 868   sigfillset (&act.sa_mask);
 869   sigemptyset (&act.sa_mask);
 870
 871   /* Do not install handlers if interrupt state is "System" */
 872   if (__gnat_get_interrupt_state (SIGABRT) != 's')
 873     sigaction (SIGABRT, &act, NULL);
 874   if (__gnat_get_interrupt_state (SIGFPE) != 's')
 875     sigaction (SIGFPE,  &act, NULL);
 876   if (__gnat_get_interrupt_state (SIGILL) != 's')
 877     sigaction (SIGILL,  &act, NULL);
 878   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 879     sigaction (SIGSEGV, &act, NULL);
 880   if (__gnat_get_interrupt_state (SIGBUS) != 's')
 881     sigaction (SIGBUS,  &act, NULL);
 882   if (__gnat_get_interrupt_state (SIGADAABORT) != 's')
 883     sigaction (SIGADAABORT,  &act, NULL);
 884
 885   __gnat_handler_installed = 1;
 886 }
 887
 888 /*******************/
 889 /* Solaris Section */
 890 /*******************/
 891
 892 #elif defined (sun) && defined (__SVR4) && !defined (__vxworks)
 893
 894 #include <signal.h>
 895 #include <siginfo.h>
 896 #include <sys/ucontext.h>
 897 #include <sys/regset.h>
 898
 899 /* The code below is common to sparc and x86.  Beware of the delay slot
 900    differences for signal context adjustments.  */
 901
 902 #if defined (__sparc)
 903 #define RETURN_ADDR_OFFSET 8
 904 #else
 905 #define RETURN_ADDR_OFFSET 0
 906 #endif
 907
 908 /* Likewise regarding how the "instruction pointer" register slot can
 909    be identified in signal machine contexts.  We have either "REG_PC"
 910    or "PC" at hand, depending on the target CPU and solaris version.  */
 911
 912 #if !defined (REG_PC)
 913 #define REG_PC PC
 914 #endif
 915
 916 static void __gnat_error_handler (int, siginfo_t *, ucontext_t *);
 917
 918 /* __gnat_adjust_context_for_raise - see comments along with the default
 919    version later in this file.  */
 920
 921 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
 922
 923 void
 924 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED,
 925                                  void * ucontext)
 926 {
 927   mcontext_t *mcontext = & ((ucontext_t *)ucontext)->uc_mcontext;
 928   mcontext->gregs[REG_PC] += (1 - RETURN_ADDR_OFFSET);
 929 }
 930
 931 static void
 932 __gnat_error_handler (int sig, siginfo_t *sip, ucontext_t *uctx)
 933 {
 934   struct Exception_Data *exception;
 935   static int recurse = 0;
 936   const char *msg;
 937
 938   /* Adjusting is required for every fault context, so adjust for this one
 939      now, before we possibly trigger a recursive fault below.  */
 940   __gnat_adjust_context_for_raise (sig, (void *)uctx);
 941
 942   /* If this was an explicit signal from a "kill", just resignal it.  */
 943   if (SI_FROMUSER (sip))
 944     {
 945       signal (sig, SIG_DFL);
 946       kill (getpid(), sig);
 947     }
 948
 949   /* Otherwise, treat it as something we handle.  */
 950   switch (sig)
 951     {
 952     case SIGSEGV:
 953       /* If the problem was permissions, this is a constraint error.
 954          Likewise if the failing address isn't maximally aligned or if
 955          we've recursed.
 956
 957          ??? Using a static variable here isn't task-safe, but it's
 958          much too hard to do anything else and we're just determining
 959          which exception to raise.  */
 960       if (sip->si_code == SEGV_ACCERR
 961           || (((long) sip->si_addr) & 3) != 0
 962           || recurse)
 963         {
 964           exception = &constraint_error;
 965           msg = "SIGSEGV";
 966         }
 967       else
 968         {
 969           /* See if the page before the faulting page is accessible.  Do that
 970              by trying to access it.  We'd like to simply try to access
 971              4096 + the faulting address, but it's not guaranteed to be
 972              the actual address, just to be on the same page.  */
 973           recurse++;
 974           ((volatile char *)
 975            ((long) sip->si_addr & - getpagesize ()))[getpagesize ()];
 976           exception = &storage_error;
 977           msg = "stack overflow (or erroneous memory access)";
 978         }
 979       break;
 980
 981     case SIGBUS:
 982       exception = &program_error;
 983       msg = "SIGBUS";
 984       break;
 985
 986     case SIGFPE:
 987       exception = &constraint_error;
 988       msg = "SIGFPE";
 989       break;
 990
 991     default:
 992       exception = &program_error;
 993       msg = "unhandled signal";
 994     }
 995
 996   recurse = 0;
 997
 998   Raise_From_Signal_Handler (exception, msg);
 999 }
1000
1001 void
1002 __gnat_install_handler (void)
1003 {
1004   struct sigaction act;
1005
1006   /* Set up signal handler to map synchronous signals to appropriate
1007      exceptions.  Make sure that the handler isn't interrupted by another
1008      signal that might cause a scheduling event! */
1009
1010   act.sa_handler = __gnat_error_handler;
1011   act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
1012   sigemptyset (&act.sa_mask);
1013
1014   /* Do not install handlers if interrupt state is "System" */
1015   if (__gnat_get_interrupt_state (SIGABRT) != 's')
1016     sigaction (SIGABRT, &act, NULL);
1017   if (__gnat_get_interrupt_state (SIGFPE) != 's')
1018     sigaction (SIGFPE,  &act, NULL);
1019   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1020     sigaction (SIGSEGV, &act, NULL);
1021   if (__gnat_get_interrupt_state (SIGBUS) != 's')
1022     sigaction (SIGBUS,  &act, NULL);
1023
1024   __gnat_handler_installed = 1;
1025 }
1026
1027 /***************/
1028 /* VMS Section */
1029 /***************/
1030
1031 #elif defined (VMS)
1032
1033 long __gnat_error_handler (int *, void *);
1034
1035 #ifdef __IA64
1036 #define lib_get_curr_invo_context LIB$I64_GET_CURR_INVO_CONTEXT
1037 #define lib_get_prev_invo_context LIB$I64_GET_PREV_INVO_CONTEXT
1038 #define lib_get_invo_handle LIB$I64_GET_INVO_HANDLE
1039 #else
1040 #define lib_get_curr_invo_context LIB$GET_CURR_INVO_CONTEXT
1041 #define lib_get_prev_invo_context LIB$GET_PREV_INVO_CONTEXT
1042 #define lib_get_invo_handle LIB$GET_INVO_HANDLE
1043 #endif
1044
1045 #if defined (IN_RTS) && !defined (__IA64)
1046
1047 /* The prehandler actually gets control first on a condition. It swaps the
1048    stack pointer and calls the handler (__gnat_error_handler). */
1049 extern long __gnat_error_prehandler (void);
1050
1051 extern char *__gnat_error_prehandler_stack;   /* Alternate signal stack */
1052 #endif
1053
1054 /* Define macro symbols for the VMS conditions that become Ada exceptions.
1055    Most of these are also defined in the header file ssdef.h which has not
1056    yet been converted to be recognized by Gnu C. */
1057
1058 /* Defining these as macros, as opposed to external addresses, allows
1059    them to be used in a case statement (below */
1060 #define SS$_ACCVIO            12
1061 #define SS$_HPARITH         1284
1062 #define SS$_STKOVF          1364
1063 #define SS$_RESIGNAL        2328
1064
1065 /* These codes are in standard message libraries */
1066 extern int CMA$_EXIT_THREAD;
1067 extern int SS$_DEBUG;
1068 extern int SS$_INTDIV;
1069 extern int LIB$_KEYNOTFOU;
1070 extern int LIB$_ACTIMAGE;
1071 extern int MTH$_FLOOVEMAT;       /* Some ACVC_21 CXA tests */
1072
1073 /* These codes are non standard, which is to say the author is
1074    not sure if they are defined in the standard message libraries
1075    so keep them as macros for now. */
1076 #define RDB$_STREAM_EOF 20480426
1077 #define FDL$_UNPRIKW 11829410
1078
1079 struct cond_except {
1080   const int *cond;
1081   const struct Exception_Data *except;
1082 };
1083
1084 struct descriptor_s {unsigned short len, mbz; __char_ptr32 adr; };
1085
1086 /* Conditions that don't have an Ada exception counterpart must raise
1087    Non_Ada_Error.  Since this is defined in s-auxdec, it should only be
1088    referenced by user programs, not the compiler or tools. Hence the
1089    #ifdef IN_RTS. */
1090
1091 #ifdef IN_RTS
1092
1093 #define Status_Error ada__io_exceptions__status_error
1094 extern struct Exception_Data Status_Error;
1095
1096 #define Mode_Error ada__io_exceptions__mode_error
1097 extern struct Exception_Data Mode_Error;
1098
1099 #define Name_Error ada__io_exceptions__name_error
1100 extern struct Exception_Data Name_Error;
1101
1102 #define Use_Error ada__io_exceptions__use_error
1103 extern struct Exception_Data Use_Error;
1104
1105 #define Device_Error ada__io_exceptions__device_error
1106 extern struct Exception_Data Device_Error;
1107
1108 #define End_Error ada__io_exceptions__end_error
1109 extern struct Exception_Data End_Error;
1110
1111 #define Data_Error ada__io_exceptions__data_error
1112 extern struct Exception_Data Data_Error;
1113
1114 #define Layout_Error ada__io_exceptions__layout_error
1115 extern struct Exception_Data Layout_Error;
1116
1117 #define Non_Ada_Error system__aux_dec__non_ada_error
1118 extern struct Exception_Data Non_Ada_Error;
1119
1120 #define Coded_Exception system__vms_exception_table__coded_exception
1121 extern struct Exception_Data *Coded_Exception (Exception_Code);
1122
1123 #define Base_Code_In system__vms_exception_table__base_code_in
1124 extern Exception_Code Base_Code_In (Exception_Code);
1125
1126 /* DEC Ada exceptions are not defined in a header file, so they
1127    must be declared as external addresses */
1128
1129 extern int ADA$_PROGRAM_ERROR;
1130 extern int ADA$_LOCK_ERROR;
1131 extern int ADA$_EXISTENCE_ERROR;
1132 extern int ADA$_KEY_ERROR;
1133 extern int ADA$_KEYSIZERR;
1134 extern int ADA$_STAOVF;
1135 extern int ADA$_CONSTRAINT_ERRO;
1136 extern int ADA$_IOSYSFAILED;
1137 extern int ADA$_LAYOUT_ERROR;
1138 extern int ADA$_STORAGE_ERROR;
1139 extern int ADA$_DATA_ERROR;
1140 extern int ADA$_DEVICE_ERROR;
1141 extern int ADA$_END_ERROR;
1142 extern int ADA$_MODE_ERROR;
1143 extern int ADA$_NAME_ERROR;
1144 extern int ADA$_STATUS_ERROR;
1145 extern int ADA$_NOT_OPEN;
1146 extern int ADA$_ALREADY_OPEN;
1147 extern int ADA$_USE_ERROR;
1148 extern int ADA$_UNSUPPORTED;
1149 extern int ADA$_FAC_MODE_MISMAT;
1150 extern int ADA$_ORG_MISMATCH;
1151 extern int ADA$_RFM_MISMATCH;
1152 extern int ADA$_RAT_MISMATCH;
1153 extern int ADA$_MRS_MISMATCH;
1154 extern int ADA$_MRN_MISMATCH;
1155 extern int ADA$_KEY_MISMATCH;
1156 extern int ADA$_MAXLINEXC;
1157 extern int ADA$_LINEXCMRS;
1158
1159 /* DEC Ada specific conditions */
1160 static const struct cond_except dec_ada_cond_except_table [] = {
1161   {&ADA$_PROGRAM_ERROR,   &program_error},
1162   {&ADA$_USE_ERROR,       &Use_Error},
1163   {&ADA$_KEYSIZERR,       &program_error},
1164   {&ADA$_STAOVF,          &storage_error},
1165   {&ADA$_CONSTRAINT_ERRO, &constraint_error},
1166   {&ADA$_IOSYSFAILED,     &Device_Error},
1167   {&ADA$_LAYOUT_ERROR,    &Layout_Error},
1168   {&ADA$_STORAGE_ERROR,   &storage_error},
1169   {&ADA$_DATA_ERROR,      &Data_Error},
1170   {&ADA$_DEVICE_ERROR,    &Device_Error},
1171   {&ADA$_END_ERROR,       &End_Error},
1172   {&ADA$_MODE_ERROR,      &Mode_Error},
1173   {&ADA$_NAME_ERROR,      &Name_Error},
1174   {&ADA$_STATUS_ERROR,    &Status_Error},
1175   {&ADA$_NOT_OPEN,        &Use_Error},
1176   {&ADA$_ALREADY_OPEN,    &Use_Error},
1177   {&ADA$_USE_ERROR,       &Use_Error},
1178   {&ADA$_UNSUPPORTED,     &Use_Error},
1179   {&ADA$_FAC_MODE_MISMAT, &Use_Error},
1180   {&ADA$_ORG_MISMATCH,    &Use_Error},
1181   {&ADA$_RFM_MISMATCH,    &Use_Error},
1182   {&ADA$_RAT_MISMATCH,    &Use_Error},
1183   {&ADA$_MRS_MISMATCH,    &Use_Error},
1184   {&ADA$_MRN_MISMATCH,    &Use_Error},
1185   {&ADA$_KEY_MISMATCH,    &Use_Error},
1186   {&ADA$_MAXLINEXC,       &constraint_error},
1187   {&ADA$_LINEXCMRS,       &constraint_error},
1188   {0,                     0}
1189 };
1190
1191 #if 0
1192    /* Already handled by a pragma Import_Exception
1193       in Aux_IO_Exceptions */
1194   {&ADA$_LOCK_ERROR,      &Lock_Error},
1195   {&ADA$_EXISTENCE_ERROR, &Existence_Error},
1196   {&ADA$_KEY_ERROR,       &Key_Error},
1197 #endif
1198
1199 #endif /* IN_RTS */
1200
1201 /* Non DEC Ada specific conditions. We could probably also put
1202    SS$_HPARITH here and possibly SS$_ACCVIO, SS$_STKOVF. */
1203 static const struct cond_except cond_except_table [] = {
1204   {&MTH$_FLOOVEMAT, &constraint_error},
1205   {&SS$_INTDIV,     &constraint_error},
1206   {0,               0}
1207 };
1208
1209 /* To deal with VMS conditions and their mapping to Ada exceptions,
1210    the __gnat_error_handler routine below is installed as an exception
1211    vector having precedence over DEC frame handlers.  Some conditions
1212    still need to be handled by such handlers, however, in which case
1213    __gnat_error_handler needs to return SS$_RESIGNAL.  Consider for
1214    instance the use of a third party library compiled with DECAda and
1215    performing it's own exception handling internally.
1216
1217    To allow some user-level flexibility, which conditions should be
1218    resignaled is controlled by a predicate function, provided with the
1219    condition value and returning a boolean indication stating whether
1220    this condition should be resignaled or not.
1221
1222    That predicate function is called indirectly, via a function pointer,
1223    by __gnat_error_handler, and changing that pointer is allowed to the
1224    the user code by way of the __gnat_set_resignal_predicate interface.
1225
1226    The user level function may then implement what it likes, including
1227    for instance the maintenance of a dynamic data structure if the set
1228    of to be resignalled conditions has to change over the program's
1229    lifetime.
1230
1231    ??? This is not a perfect solution to deal with the possible
1232    interactions between the GNAT and the DECAda exception handling
1233    models and better (more general) schemes are studied.  This is so
1234    just provided as a convenient workaround in the meantime, and
1235    should be use with caution since the implementation has been kept
1236    very simple.  */
1237
1238 typedef int
1239 resignal_predicate (int code);
1240
1241 const int *cond_resignal_table [] = {
1242   &CMA$_EXIT_THREAD,
1243   &SS$_DEBUG,
1244   &LIB$_KEYNOTFOU,
1245   &LIB$_ACTIMAGE,
1246   (int *) RDB$_STREAM_EOF,
1247   (int *) FDL$_UNPRIKW,
1248   0
1249 };
1250
1251 const int facility_resignal_table [] = {
1252   0x1380000, /* RDB */
1253   0x2220000, /* SQL */
1254   0
1255 };
1256
1257 /* Default GNAT predicate for resignaling conditions.  */
1258
1259 static int
1260 __gnat_default_resignal_p (int code)
1261 {
1262   int i, iexcept;
1263
1264   for (i = 0; facility_resignal_table [i]; i++)
1265     if ((code & 0xfff0000) == facility_resignal_table [i])
1266       return 1;
1267
1268   for (i = 0, iexcept = 0;
1269        cond_resignal_table [i] &&
1270        !(iexcept = LIB$MATCH_COND (&code, &cond_resignal_table [i]));
1271        i++);
1272
1273   return iexcept;
1274 }
1275
1276 /* Static pointer to predicate that the __gnat_error_handler exception
1277    vector invokes to determine if it should resignal a condition.  */
1278
1279 static resignal_predicate * __gnat_resignal_p = __gnat_default_resignal_p;
1280
1281 /* User interface to change the predicate pointer to PREDICATE. Reset to
1282    the default if PREDICATE is null.  */
1283
1284 void
1285 __gnat_set_resignal_predicate (resignal_predicate * predicate)
1286 {
1287   if (predicate == 0)
1288     __gnat_resignal_p = __gnat_default_resignal_p;
1289   else
1290     __gnat_resignal_p = predicate;
1291 }
1292
1293 /* Should match System.Parameters.Default_Exception_Msg_Max_Length */
1294 #define Default_Exception_Msg_Max_Length 512
1295
1296 /* Action routine for SYS$PUTMSG. There may be
1297    multiple conditions, each with text to be appended to
1298    MESSAGE and separated by line termination. */
1299
1300 static int
1301 copy_msg (msgdesc, message)
1302      struct descriptor_s *msgdesc;
1303      char *message;
1304 {
1305   int len = strlen (message);
1306   int copy_len;
1307
1308   /* Check for buffer overflow and skip */
1309   if (len > 0 && len <= Default_Exception_Msg_Max_Length - 3)
1310     {
1311       strcat (message, "\r\n");
1312       len += 2;
1313     }
1314
1315   /* Check for buffer overflow and truncate if necessary */
1316   copy_len = (len + msgdesc->len <= Default_Exception_Msg_Max_Length - 1 ?
1317               msgdesc->len :
1318               Default_Exception_Msg_Max_Length - 1 - len);
1319   strncpy (&message [len], msgdesc->adr, copy_len);
1320   message [len + copy_len] = 0;
1321
1322   return 0;
1323 }
1324
1325 long
1326 __gnat_handle_vms_condition (int *sigargs, void *mechargs)
1327 {
1328   struct Exception_Data *exception = 0;
1329   Exception_Code base_code;
1330   struct descriptor_s gnat_facility = {4,0,"GNAT"};
1331   char message [Default_Exception_Msg_Max_Length];
1332
1333   const char *msg = "";
1334
1335   /* Check for conditions to resignal which aren't effected by pragma
1336      Import_Exception.  */
1337   if (__gnat_resignal_p (sigargs [1]))
1338     return SS$_RESIGNAL;
1339
1340 #ifdef IN_RTS
1341   /* See if it's an imported exception. Beware that registered exceptions
1342      are bound to their base code, with the severity bits masked off.  */
1343   base_code = Base_Code_In ((Exception_Code) sigargs [1]);
1344   exception = Coded_Exception (base_code);
1345
1346   if (exception)
1347     {
1348       message [0] = 0;
1349
1350       /* Subtract PC & PSL fields which messes with PUTMSG */
1351       sigargs [0] -= 2;
1352       SYS$PUTMSG (sigargs, copy_msg, &gnat_facility, message);
1353       sigargs [0] += 2;
1354       msg = message;
1355
1356       exception->Name_Length = 19;
1357       /* The full name really should be get sys$getmsg returns. ??? */
1358       exception->Full_Name = "IMPORTED_EXCEPTION";
1359       exception->Import_Code = base_code;
1360
1361 #ifdef __IA64
1362       /* Do not adjust the program counter as already points to the next
1363          instruction (just after the call to LIB$STOP).  */
1364       Raise_From_Signal_Handler (exception, msg);
1365 #endif
1366     }
1367 #endif
1368
1369   if (exception == 0)
1370     switch (sigargs[1])
1371       {
1372       case SS$_ACCVIO:
1373         if (sigargs[3] == 0)
1374           {
1375             exception = &constraint_error;
1376             msg = "access zero";
1377           }
1378         else
1379           {
1380             exception = &storage_error;
1381             msg = "stack overflow (or erroneous memory access)";
1382           }
1383         __gnat_adjust_context_for_raise (0, (void *)mechargs);
1384         break;
1385
1386       case SS$_STKOVF:
1387         exception = &storage_error;
1388         msg = "stack overflow";
1389         __gnat_adjust_context_for_raise (0, (void *)mechargs);
1390         break;
1391
1392       case SS$_HPARITH:
1393 #ifndef IN_RTS
1394         return SS$_RESIGNAL; /* toplev.c handles for compiler */
1395 #else
1396         exception = &constraint_error;
1397         msg = "arithmetic error";
1398 #ifndef __alpha__
1399         /* No need to adjust pc on alpha: the pc is already on the instruction
1400            after the trapping one.  */
1401         __gnat_adjust_context_for_raise (0, (void *)mechargs);
1402 #endif
1403 #endif
1404         break;
1405
1406       default:
1407 #ifdef IN_RTS
1408         {
1409           int i;
1410
1411           /* Scan the DEC Ada exception condition table for a match and fetch
1412              the associated GNAT exception pointer */
1413           for (i = 0;
1414                dec_ada_cond_except_table [i].cond &&
1415                !LIB$MATCH_COND (&sigargs [1],
1416                                 &dec_ada_cond_except_table [i].cond);
1417                i++);
1418           exception = (struct Exception_Data *)
1419             dec_ada_cond_except_table [i].except;
1420
1421           if (!exception)
1422             {
1423               /* Scan the VMS standard condition table for a match and fetch
1424                  the associated GNAT exception pointer */
1425               for (i = 0;
1426                    cond_except_table [i].cond &&
1427                    !LIB$MATCH_COND (&sigargs [1], &cond_except_table [i].cond);
1428                    i++);
1429               exception = (struct Exception_Data *)
1430                 cond_except_table [i].except;
1431
1432               if (!exception)
1433                 /* User programs expect Non_Ada_Error to be raised, reference
1434                    DEC Ada test CXCONDHAN. */
1435                 exception = &Non_Ada_Error;
1436             }
1437         }
1438 #else
1439         exception = &program_error;
1440 #endif
1441         message [0] = 0;
1442         /* Subtract PC & PSL fields which messes with PUTMSG */
1443         sigargs [0] -= 2;
1444         SYS$PUTMSG (sigargs, copy_msg, &gnat_facility, message);
1445         sigargs [0] += 2;
1446         msg = message;
1447         break;
1448       }
1449
1450   Raise_From_Signal_Handler (exception, msg);
1451 }
1452
1453 long
1454 __gnat_error_handler (int *sigargs, void *mechargs)
1455 {
1456   return __gnat_handle_vms_condition (sigargs, mechargs);
1457 }
1458
1459 void
1460 __gnat_install_handler (void)
1461 {
1462   long prvhnd ATTRIBUTE_UNUSED;
1463
1464 #if !defined (IN_RTS)
1465   SYS$SETEXV (1, __gnat_error_handler, 3, &prvhnd);
1466 #endif
1467
1468   /* On alpha-vms, we avoid the global vector annoyance thanks to frame based
1469      handlers to turn conditions into exceptions since GCC 3.4.  The global
1470      vector is still required for earlier GCC versions.  We're resorting to
1471      the __gnat_error_prehandler assembly function in this case.  */
1472
1473 #if defined (IN_RTS) && defined (__alpha__)
1474   if ((__GNUC__ * 10 + __GNUC_MINOR__) < 34)
1475     {
1476       char * c = (char *) xmalloc (2049);
1477
1478       __gnat_error_prehandler_stack = &c[2048];
1479       SYS$SETEXV (1, __gnat_error_prehandler, 3, &prvhnd);
1480     }
1481 #endif
1482
1483   __gnat_handler_installed = 1;
1484 }
1485
1486 /* __gnat_adjust_context_for_raise for alpha - see comments along with the
1487    default version later in this file.  */
1488
1489 #if defined (IN_RTS) && defined (__alpha__)
1490
1491 #include <vms/chfctxdef.h>
1492 #include <vms/chfdef.h>
1493
1494 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
1495
1496 void
1497 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
1498 {
1499   /* Add one to the address of the instruction signaling the condition,
1500      located in the sigargs array.  */
1501
1502   CHF$MECH_ARRAY * mechargs = (CHF$MECH_ARRAY *) ucontext;
1503   CHF$SIGNAL_ARRAY * sigargs
1504     = (CHF$SIGNAL_ARRAY *) mechargs->chf$q_mch_sig_addr;
1505
1506   int vcount = sigargs->chf$is_sig_args;
1507   int * pc_slot = & (&sigargs->chf$l_sig_name)[vcount-2];
1508
1509   (*pc_slot) ++;
1510 }
1511
1512 #endif
1513
1514 /* __gnat_adjust_context_for_raise for ia64.  */
1515
1516 #if defined (IN_RTS) && defined (__IA64)
1517
1518 #include <vms/chfctxdef.h>
1519 #include <vms/chfdef.h>
1520
1521 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
1522
1523 typedef unsigned long long u64;
1524
1525 void
1526 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
1527 {
1528   /* Add one to the address of the instruction signaling the condition,
1529      located in the 64bits sigargs array.  */
1530
1531   CHF$MECH_ARRAY * mechargs = (CHF$MECH_ARRAY *) ucontext;
1532
1533   CHF64$SIGNAL_ARRAY *chfsig64
1534     = (CHF64$SIGNAL_ARRAY *) mechargs->chf$ph_mch_sig64_addr;
1535
1536   u64 * post_sigarray
1537     = (u64 *)chfsig64 + 1 + chfsig64->chf64$l_sig_args;
1538
1539   u64 * ih_pc_loc = post_sigarray - 2;
1540
1541   (*ih_pc_loc) ++;
1542 }
1543
1544 #endif
1545
1546 /*******************/
1547 /* FreeBSD Section */
1548 /*******************/
1549
1550 #elif defined (__FreeBSD__)
1551
1552 #include <signal.h>
1553 #include <sys/ucontext.h>
1554 #include <unistd.h>
1555
1556 static void __gnat_error_handler (int, siginfo_t *, ucontext_t *);
1557 void __gnat_adjust_context_for_raise (int, void*);
1558
1559 /* __gnat_adjust_context_for_raise - see comments along with the default
1560    version later in this file.  */
1561
1562 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
1563
1564 void
1565 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
1566 {
1567   mcontext_t *mcontext = &((ucontext_t *) ucontext)->uc_mcontext;
1568   mcontext->mc_eip++;
1569 }
1570
1571 static void
1572 __gnat_error_handler (int sig, siginfo_t *info __attribute__ ((unused)),
1573                       ucontext_t *ucontext)
1574 {
1575   struct Exception_Data *exception;
1576   const char *msg;
1577
1578   switch (sig)
1579     {
1580     case SIGFPE:
1581       exception = &constraint_error;
1582       msg = "SIGFPE";
1583       break;
1584
1585     case SIGILL:
1586       exception = &constraint_error;
1587       msg = "SIGILL";
1588       break;
1589
1590     case SIGSEGV:
1591       exception = &storage_error;
1592       msg = "stack overflow or erroneous memory access";
1593       break;
1594
1595     case SIGBUS:
1596       exception = &constraint_error;
1597       msg = "SIGBUS";
1598       break;
1599
1600     default:
1601       exception = &program_error;
1602       msg = "unhandled signal";
1603     }
1604
1605   __gnat_adjust_context_for_raise (sig, ucontext);
1606   Raise_From_Signal_Handler (exception, msg);
1607 }
1608
1609 void
1610 __gnat_install_handler ()
1611 {
1612   struct sigaction act;
1613
1614   /* Set up signal handler to map synchronous signals to appropriate
1615      exceptions.  Make sure that the handler isn't interrupted by another
1616      signal that might cause a scheduling event! */
1617
1618   act.sa_sigaction
1619     = (void (*)(int, struct __siginfo *, void*)) __gnat_error_handler;
1620   act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
1621   (void) sigemptyset (&act.sa_mask);
1622
1623   (void) sigaction (SIGILL,  &act, NULL);
1624   (void) sigaction (SIGFPE,  &act, NULL);
1625   (void) sigaction (SIGSEGV, &act, NULL);
1626   (void) sigaction (SIGBUS,  &act, NULL);
1627
1628   __gnat_handler_installed = 1;
1629 }
1630
1631 /*******************/
1632 /* VxWorks Section */
1633 /*******************/
1634
1635 #elif defined(__vxworks)
1636
1637 #include <signal.h>
1638 #include <taskLib.h>
1639
1640 #ifndef __RTP__
1641 #include <intLib.h>
1642 #include <iv.h>
1643 #endif
1644
1645 #ifdef VTHREADS
1646 #include "private/vThreadsP.h"
1647 #endif
1648
1649 static void __gnat_error_handler (int, int, struct sigcontext *);
1650 void __gnat_map_signal (int);
1651
1652 #ifndef __RTP__
1653
1654 /* Directly vectored Interrupt routines are not supported when using RTPs */
1655
1656 extern int __gnat_inum_to_ivec (int);
1657
1658 /* This is needed by the GNAT run time to handle Vxworks interrupts */
1659 int
1660 __gnat_inum_to_ivec (int num)
1661 {
1662   return INUM_TO_IVEC (num);
1663 }
1664 #endif
1665
1666 #if !defined(__alpha_vxworks) && (_WRS_VXWORKS_MAJOR != 6) && !defined(__RTP__)
1667
1668 /* getpid is used by s-parint.adb, but is not defined by VxWorks, except
1669    on Alpha VxWorks and VxWorks 6.x (including RTPs). */
1670
1671 extern long getpid (void);
1672
1673 long
1674 getpid (void)
1675 {
1676   return taskIdSelf ();
1677 }
1678 #endif
1679
1680 /* VxWorks expects the field excCnt to be zeroed when a signal is handled.
1681    The VxWorks version of longjmp does this; gcc's builtin_longjmp does not */
1682 void
1683 __gnat_clear_exception_count (void)
1684 {
1685 #ifdef VTHREADS
1686   WIND_TCB *currentTask = (WIND_TCB *) taskIdSelf();
1687
1688   currentTask->vThreads.excCnt = 0;
1689 #endif
1690 }
1691
1692 /* Exported to s-intman-vxworks.adb in order to handle different signal
1693    to exception mappings in different VxWorks versions */
1694 void
1695 __gnat_map_signal (int sig)
1696 {
1697   struct Exception_Data *exception;
1698   const char *msg;
1699
1700   switch (sig)
1701     {
1702     case SIGFPE:
1703       exception = &constraint_error;
1704       msg = "SIGFPE";
1705       break;
1706 #ifdef VTHREADS
1707     case SIGILL:
1708       exception = &constraint_error;
1709       msg = "Floating point exception or SIGILL";
1710       break;
1711     case SIGSEGV:
1712       exception = &storage_error;
1713       msg = "SIGSEGV: possible stack overflow";
1714       break;
1715     case SIGBUS:
1716       exception = &storage_error;
1717       msg = "SIGBUS: possible stack overflow";
1718       break;
1719 #else
1720 #ifdef __RTP__
1721     /* In RTP mode a SIGSEGV is most likely due to a stack overflow,
1722        since stack checking uses the probing mechanism.  */
1723     case SIGILL:
1724       exception = &constraint_error;
1725       msg = "SIGILL";
1726       break;
1727     case SIGSEGV:
1728       exception = &storage_error;
1729       msg = "SIGSEGV: possible stack overflow";
1730       break;
1731 #else
1732     /* In kernel mode a SIGILL is most likely due to a stack overflow,
1733        since stack checking uses the stack limit mechanism.  */
1734     case SIGILL:
1735       exception = &storage_error;
1736       msg = "SIGILL: possible stack overflow";
1737       break;
1738     case SIGSEGV:
1739       exception = &program_error;
1740       msg = "SIGSEGV";
1741       break;
1742 #endif
1743     case SIGBUS:
1744       exception = &program_error;
1745       msg = "SIGBUS";
1746       break;
1747 #endif
1748     default:
1749       exception = &program_error;
1750       msg = "unhandled signal";
1751     }
1752
1753   __gnat_clear_exception_count ();
1754   Raise_From_Signal_Handler (exception, msg);
1755 }
1756
1757 static void
1758 __gnat_error_handler (int sig, int code, struct sigcontext *sc)
1759 {
1760   sigset_t mask;
1761   int result;
1762
1763   /* VxWorks will always mask out the signal during the signal handler and
1764      will reenable it on a longjmp.  GNAT does not generate a longjmp to
1765      return from a signal handler so the signal will still be masked unless
1766      we unmask it. */
1767   sigprocmask (SIG_SETMASK, NULL, &mask);
1768   sigdelset (&mask, sig);
1769   sigprocmask (SIG_SETMASK, &mask, NULL);
1770
1771   __gnat_map_signal (sig);
1772
1773 }
1774
1775 void
1776 __gnat_install_handler (void)
1777 {
1778   struct sigaction act;
1779
1780   /* Setup signal handler to map synchronous signals to appropriate
1781      exceptions.  Make sure that the handler isn't interrupted by another
1782      signal that might cause a scheduling event! */
1783
1784   act.sa_handler = __gnat_error_handler;
1785   act.sa_flags = SA_SIGINFO | SA_ONSTACK;
1786   sigemptyset (&act.sa_mask);
1787
1788   /* For VxWorks, install all signal handlers, since pragma Interrupt_State
1789      applies to vectored hardware interrupts, not signals */
1790   sigaction (SIGFPE,  &act, NULL);
1791   sigaction (SIGILL,  &act, NULL);
1792   sigaction (SIGSEGV, &act, NULL);
1793   sigaction (SIGBUS,  &act, NULL);
1794
1795   __gnat_handler_installed = 1;
1796 }
1797
1798 #define HAVE_GNAT_INIT_FLOAT
1799
1800 void
1801 __gnat_init_float (void)
1802 {
1803   /* Disable overflow/underflow exceptions on the PPC processor, this is needed
1804      to get correct Ada semantics.  Note that for AE653 vThreads, the HW
1805      overflow settings are an OS configuration issue.  The instructions
1806      below have no effect */
1807 #if defined (_ARCH_PPC) && !defined (_SOFT_FLOAT) && !defined (VTHREADS)
1808   asm ("mtfsb0 25");
1809   asm ("mtfsb0 26");
1810 #endif
1811
1812 #if (defined (__i386__) || defined (i386)) && !defined (VTHREADS)
1813   /* This is used to properly initialize the FPU on an x86 for each
1814      process thread. */
1815   asm ("finit");
1816 #endif
1817
1818   /* Similarly for sparc64. Achieved by masking bits in the Trap Enable Mask
1819      field of the Floating-point Status Register (see the SPARC Architecture
1820      Manual Version 9, p 48).  */
1821 #if defined (sparc64)
1822
1823 #define FSR_TEM_NVM (1 << 27)  /* Invalid operand  */
1824 #define FSR_TEM_OFM (1 << 26)  /* Overflow  */
1825 #define FSR_TEM_UFM (1 << 25)  /* Underflow  */
1826 #define FSR_TEM_DZM (1 << 24)  /* Division by Zero  */
1827 #define FSR_TEM_NXM (1 << 23)  /* Inexact result  */
1828   {
1829     unsigned int fsr;
1830
1831     __asm__("st %%fsr, %0" : "=m" (fsr));
1832     fsr &= ~(FSR_TEM_OFM | FSR_TEM_UFM);
1833     __asm__("ld %0, %%fsr" : : "m" (fsr));
1834   }
1835 #endif
1836 }
1837
1838 /* This subprogram is called by System.Task_Primitives.Operations.Enter_Task
1839    (if not null) when a new task is created.  It is initialized by
1840    System.Stack_Checking.Operations.Initialize_Stack_Limit.
1841    The use of a hook avoids to drag stack checking subprograms if stack
1842    checking is not used.  */
1843 void (*__gnat_set_stack_limit_hook)(void) = (void (*)(void))0;
1844
1845
1846 /******************/
1847 /* NetBSD Section */
1848 /******************/
1849
1850 #elif defined(__NetBSD__)
1851
1852 #include <signal.h>
1853 #include <unistd.h>
1854
1855 static void
1856 __gnat_error_handler (int sig)
1857 {
1858   struct Exception_Data *exception;
1859   const char *msg;
1860
1861   switch(sig)
1862   {
1863     case SIGFPE:
1864       exception = &constraint_error;
1865       msg = "SIGFPE";
1866       break;
1867     case SIGILL:
1868       exception = &constraint_error;
1869       msg = "SIGILL";
1870       break;
1871     case SIGSEGV:
1872       exception = &storage_error;
1873       msg = "stack overflow or erroneous memory access";
1874       break;
1875     case SIGBUS:
1876       exception = &constraint_error;
1877       msg = "SIGBUS";
1878       break;
1879     default:
1880       exception = &program_error;
1881       msg = "unhandled signal";
1882     }
1883
1884     Raise_From_Signal_Handler(exception, msg);
1885 }
1886
1887 void
1888 __gnat_install_handler(void)
1889 {
1890   struct sigaction act;
1891
1892   act.sa_handler = __gnat_error_handler;
1893   act.sa_flags = SA_NODEFER | SA_RESTART;
1894   sigemptyset (&act.sa_mask);
1895
1896   /* Do not install handlers if interrupt state is "System" */
1897   if (__gnat_get_interrupt_state (SIGFPE) != 's')
1898     sigaction (SIGFPE,  &act, NULL);
1899   if (__gnat_get_interrupt_state (SIGILL) != 's')
1900     sigaction (SIGILL,  &act, NULL);
1901   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1902     sigaction (SIGSEGV, &act, NULL);
1903   if (__gnat_get_interrupt_state (SIGBUS) != 's')
1904     sigaction (SIGBUS,  &act, NULL);
1905
1906   __gnat_handler_installed = 1;
1907 }
1908
1909 /*******************/
1910 /* OpenBSD Section */
1911 /*******************/
1912
1913 #elif defined(__OpenBSD__)
1914
1915 #include <signal.h>
1916 #include <unistd.h>
1917
1918 static void
1919 __gnat_error_handler (int sig)
1920 {
1921   struct Exception_Data *exception;
1922   const char *msg;
1923
1924   switch(sig)
1925   {
1926     case SIGFPE:
1927       exception = &constraint_error;
1928       msg = "SIGFPE";
1929       break;
1930     case SIGILL:
1931       exception = &constraint_error;
1932       msg = "SIGILL";
1933       break;
1934     case SIGSEGV:
1935       exception = &storage_error;
1936       msg = "stack overflow or erroneous memory access";
1937       break;
1938     case SIGBUS:
1939       exception = &constraint_error;
1940       msg = "SIGBUS";
1941       break;
1942     default:
1943       exception = &program_error;
1944       msg = "unhandled signal";
1945     }
1946
1947     Raise_From_Signal_Handler(exception, msg);
1948 }
1949
1950 void
1951 __gnat_install_handler(void)
1952 {
1953   struct sigaction act;
1954
1955   act.sa_handler = __gnat_error_handler;
1956   act.sa_flags = SA_NODEFER | SA_RESTART;
1957   sigemptyset (&act.sa_mask);
1958
1959   /* Do not install handlers if interrupt state is "System" */
1960   if (__gnat_get_interrupt_state (SIGFPE) != 's')
1961     sigaction (SIGFPE,  &act, NULL);
1962   if (__gnat_get_interrupt_state (SIGILL) != 's')
1963     sigaction (SIGILL,  &act, NULL);
1964   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1965     sigaction (SIGSEGV, &act, NULL);
1966   if (__gnat_get_interrupt_state (SIGBUS) != 's')
1967     sigaction (SIGBUS,  &act, NULL);
1968
1969   __gnat_handler_installed = 1;
1970 }
1971
1972 #else
1973
1974 /* For all other versions of GNAT, the handler does nothing */
1975
1976 /*******************/
1977 /* Default Section */
1978 /*******************/
1979
1980 void
1981 __gnat_install_handler (void)
1982 {
1983   __gnat_handler_installed = 1;
1984 }
1985
1986 #endif
1987
1988 /*********************/
1989 /* __gnat_init_float */
1990 /*********************/
1991
1992 /* This routine is called as each process thread is created, for possible
1993    initialization of the FP processor. This version is used under INTERIX,
1994    WIN32 and could be used under OS/2 */
1995
1996 #if defined (_WIN32) || defined (__INTERIX) || defined (__EMX__) \
1997   || defined (__Lynx__) || defined(__NetBSD__) || defined(__FreeBSD__) \
1998   || defined (__OpenBSD__)
1999
2000 #define HAVE_GNAT_INIT_FLOAT
2001
2002 void
2003 __gnat_init_float (void)
2004 {
2005 #if defined (__i386__) || defined (i386)
2006
2007   /* This is used to properly initialize the FPU on an x86 for each
2008      process thread. */
2009
2010   asm ("finit");
2011
2012 #endif  /* Defined __i386__ */
2013 }
2014 #endif
2015
2016 #ifndef HAVE_GNAT_INIT_FLOAT
2017
2018 /* All targets without a specific __gnat_init_float will use an empty one */
2019 void
2020 __gnat_init_float (void)
2021 {
2022 }
2023 #endif
2024
2025 /***********************************/
2026 /* __gnat_adjust_context_for_raise */
2027 /***********************************/
2028
2029 #ifndef HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
2030
2031 /* All targets without a specific version will use an empty one */
2032
2033 /* Given UCONTEXT a pointer to a context structure received by a signal
2034    handler for SIGNO, perform the necessary adjustments to let the handler
2035    raise an exception.  Calls to this routine are not conditioned by the
2036    propagation scheme in use.  */
2037
2038 void
2039 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED,
2040                                  void *ucontext ATTRIBUTE_UNUSED)
2041 {
2042   /* Adjustments are currently required for the GCC ZCX propagation scheme
2043      only.  These adjustments (described below) are harmless for the other
2044      schemes, so may be applied unconditionally.  */
2045
2046   /* Adjustments required for a GCC ZCX propagation scheme:
2047      ------------------------------------------------------
2048
2049      The GCC unwinder expects to be dealing with call return addresses, since
2050      this is the "nominal" case of what we retrieve while unwinding a regular
2051      call chain.
2052
2053      To evaluate if a handler applies at some point identified by a return
2054      address, the propagation engine needs to determine what region the
2055      corresponding call instruction pertains to.  Because the return address
2056      may not be attached to the same region as the call, the unwinder always
2057      subtracts "some" amount from a return address to search the region
2058      tables, amount chosen to ensure that the resulting address is inside the
2059      call instruction.
2060
2061      When we raise an exception from a signal handler, e.g. to transform a
2062      SIGSEGV into Storage_Error, things need to appear as if the signal
2063      handler had been "called" by the instruction which triggered the signal,
2064      so that exception handlers that apply there are considered.  What the
2065      unwinder will retrieve as the return address from the signal handler is
2066      what it will find as the faulting instruction address in the signal
2067      context pushed by the kernel.  Leaving this address untouched looses, if
2068      the triggering instruction happens to be the very first of a region, as
2069      the later adjustments performed by the unwinder would yield an address
2070      outside that region.  We need to compensate for the unwinder adjustments
2071      at some point, and this is what this routine is expected to do.
2072
2073      signo is passed because on some targets for some signals the PC in
2074      context points to the instruction after the faulting one, in which case
2075      the unwinder adjustment is still desired.
2076
2077      We used to perform the compensation in the GCC unwinding fallback macro.
2078      The thread at http://gcc.gnu.org/ml/gcc-patches/2004-05/msg00343.html
2079      describes a couple of issues with this approach.  First, on some targets
2080      the adjustment to apply depends on the triggering signal, which is not
2081      easily accessible from the macro.  Besides, other languages, e.g. Java,
2082      deal with this by performing the adjustment in the signal handler before
2083      the raise, so fallback adjustments just break those front-ends.  */
2084 }
2085
2086 #endif