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