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