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