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