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-2004 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,  59 Temple Place - Suite 330,  Boston, *
  20  * MA 02111-1307, 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 /*********************/
 260 /* __gnat_initialize */
 261 /*********************/
 262
 263 /* __gnat_initialize is called at the start of execution of an Ada program
 264    (the call is generated by the binder). The standard routine does nothing
 265    at all; the intention is that this be replaced by system specific
 266    code where initialization is required. */
 267
 268 /* Notes on the Zero Cost Exceptions scheme and its impact on the signal
 269    handlers implemented below :
 270
 271    What we call Zero Cost Exceptions is implemented using the GCC eh
 272    circuitry, even if the underlying implementation is setjmp/longjmp
 273    based. In any case ...
 274
 275    The GCC unwinder expects to be dealing with call return addresses, since
 276    this is the "nominal" case of what we retrieve while unwinding a regular
 277    call chain. To evaluate if a handler applies at some point in this chain,
 278    the propagation engine needs to determine what region the corresponding
 279    call instruction pertains to. The return address may not be attached to the
 280    same region as the call, so the unwinder unconditionally substracts "some"
 281    amount to the return addresses it gets to search the region tables. The
 282    exact amount is computed to ensure that the resulting address is inside the
 283    call instruction, and is thus target dependant (think about delay slots for
 284    instance).
 285
 286    When we raise an exception from a signal handler, e.g. to transform a
 287    SIGSEGV into Storage_Error, things need to appear as if the signal handler
 288    had been "called" by the instruction which triggered the signal, so that
 289    exception handlers that apply there are considered. What the unwinder will
 290    retrieve as the return address from the signal handler is what it will find
 291    as the faulting instruction address in the corresponding signal context
 292    pushed by the kernel. Leaving this address untouched may loose, because if
 293    the triggering instruction happens to be the very first of a region, the
 294    later adjustements performed by the unwinder would yield an address outside
 295    that region. We need to compensate for those adjustments at some point,
 296    which we currently do in the GCC unwinding fallback macro.
 297
 298    The thread at http://gcc.gnu.org/ml/gcc-patches/2004-05/msg00343.html
 299    describes a couple of issues with our current approach. Basically: on some
 300    targets the adjustment to apply depends on the triggering signal, which is
 301    not easily accessible from the macro, and we actually do not tackle this as
 302    of today. Besides, other languages, e.g. Java, deal with this by performing
 303    the adjustment in the signal handler before the raise, so our adjustments
 304    may break those front-ends.
 305
 306    To have it all right, we should either find a way to deal with the signal
 307    variants from the macro and convert Java on all targets (ugh), or remove
 308    our macro adjustments and update our signal handlers a-la-java way.  The
 309    latter option appears the simplest, although some targets have their share
 310    of subtleties to account for.  See for instance the syscall(SYS_sigaction)
 311    story in libjava/include/i386-signal.h.  */
 312
 313 /***********************************/
 314 /* __gnat_initialize (AIX Version) */
 315 /***********************************/
 316
 317 #if defined (_AIX)
 318
 319 #include <signal.h>
 320 #include <sys/time.h>
 321
 322 /* Some versions of AIX don't define SA_NODEFER. */
 323
 324 #ifndef SA_NODEFER
 325 #define SA_NODEFER 0
 326 #endif /* SA_NODEFER */
 327
 328 /* Versions of AIX before 4.3 don't have nanosleep but provide
 329    nsleep instead. */
 330
 331 #ifndef _AIXVERSION_430
 332
 333 extern int nanosleep (struct timestruc_t *, struct timestruc_t *);
 334
 335 int
 336 nanosleep (struct timestruc_t *Rqtp, struct timestruc_t *Rmtp)
 337 {
 338   return nsleep (Rqtp, Rmtp);
 339 }
 340
 341 #endif /* _AIXVERSION_430 */
 342
 343 static void __gnat_error_handler (int);
 344
 345 static void
 346 __gnat_error_handler (int sig)
 347 {
 348   struct Exception_Data *exception;
 349   const char *msg;
 350
 351   switch (sig)
 352     {
 353     case SIGSEGV:
 354       /* FIXME: we need to detect the case of a *real* SIGSEGV */
 355       exception = &storage_error;
 356       msg = "stack overflow or erroneous memory access";
 357       break;
 358
 359     case SIGBUS:
 360       exception = &constraint_error;
 361       msg = "SIGBUS";
 362       break;
 363
 364     case SIGFPE:
 365       exception = &constraint_error;
 366       msg = "SIGFPE";
 367       break;
 368
 369     default:
 370       exception = &program_error;
 371       msg = "unhandled signal";
 372     }
 373
 374   Raise_From_Signal_Handler (exception, msg);
 375 }
 376
 377 void
 378 __gnat_install_handler (void)
 379 {
 380   struct sigaction act;
 381
 382   /* Set up signal handler to map synchronous signals to appropriate
 383      exceptions.  Make sure that the handler isn't interrupted by another
 384      signal that might cause a scheduling event! */
 385
 386   act.sa_handler = __gnat_error_handler;
 387   act.sa_flags = SA_NODEFER | SA_RESTART;
 388   sigemptyset (&act.sa_mask);
 389
 390   /* Do not install handlers if interrupt state is "System" */
 391   if (__gnat_get_interrupt_state (SIGABRT) != 's')
 392     sigaction (SIGABRT, &act, NULL);
 393   if (__gnat_get_interrupt_state (SIGFPE) != 's')
 394     sigaction (SIGFPE,  &act, NULL);
 395   if (__gnat_get_interrupt_state (SIGILL) != 's')
 396     sigaction (SIGILL,  &act, NULL);
 397   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 398     sigaction (SIGSEGV, &act, NULL);
 399   if (__gnat_get_interrupt_state (SIGBUS) != 's')
 400     sigaction (SIGBUS,  &act, NULL);
 401
 402   __gnat_handler_installed = 1;
 403 }
 404
 405 void
 406 __gnat_initialize (void)
 407 {
 408 }
 409
 410 /***************************************/
 411 /* __gnat_initialize (RTEMS version) */
 412 /***************************************/
 413
 414 #elif defined(__rtems__)
 415
 416 extern void __gnat_install_handler (void);
 417
 418 /* For RTEMS, each bsp will provide a custom __gnat_install_handler (). */
 419
 420 void
 421 __gnat_initialize (void)
 422 {
 423    __gnat_install_handler ();
 424 }
 425
 426 /****************************************/
 427 /* __gnat_initialize (Dec Unix Version) */
 428 /****************************************/
 429
 430 #elif defined(__alpha__) && defined(__osf__) && ! defined(__alpha_vxworks)
 431
 432 /* Note: it seems that __osf__ is defined for the Alpha VXWorks case. Not
 433    clear that this is reasonable, but in any case we have to be sure to
 434    exclude this case in the above test.  */
 435
 436 #include <signal.h>
 437 #include <sys/siginfo.h>
 438
 439 static void __gnat_error_handler (int, siginfo_t *, struct sigcontext *);
 440 extern char *__gnat_get_code_loc (struct sigcontext *);
 441 extern void __gnat_enter_handler (struct sigcontext *, char *);
 442 extern size_t __gnat_machine_state_length (void);
 443
 444 extern long exc_lookup_gp (char *);
 445 extern void exc_resume (struct sigcontext *);
 446
 447 static void
 448 __gnat_error_handler (int sig, siginfo_t *sip, struct sigcontext *context)
 449 {
 450   struct Exception_Data *exception;
 451   static int recurse = 0;
 452   struct sigcontext *mstate;
 453   const char *msg;
 454
 455   /* If this was an explicit signal from a "kill", just resignal it.  */
 456   if (SI_FROMUSER (sip))
 457     {
 458       signal (sig, SIG_DFL);
 459       kill (getpid(), sig);
 460     }
 461
 462   /* Otherwise, treat it as something we handle.  */
 463   switch (sig)
 464     {
 465     case SIGSEGV:
 466       /* If the problem was permissions, this is a constraint error.
 467          Likewise if the failing address isn't maximally aligned or if
 468          we've recursed.
 469
 470          ??? Using a static variable here isn't task-safe, but it's
 471          much too hard to do anything else and we're just determining
 472          which exception to raise.  */
 473       if (sip->si_code == SEGV_ACCERR
 474           || (((long) sip->si_addr) & 3) != 0
 475           || recurse)
 476         {
 477           exception = &constraint_error;
 478           msg = "SIGSEGV";
 479         }
 480       else
 481         {
 482           /* See if the page before the faulting page is accessible.  Do that
 483              by trying to access it.  We'd like to simply try to access
 484              4096 + the faulting address, but it's not guaranteed to be
 485              the actual address, just to be on the same page.  */
 486           recurse++;
 487           ((volatile char *)
 488            ((long) sip->si_addr & - getpagesize ()))[getpagesize ()];
 489           msg = "stack overflow (or erroneous memory access)";
 490           exception = &storage_error;
 491         }
 492       break;
 493
 494     case SIGBUS:
 495       exception = &program_error;
 496       msg = "SIGBUS";
 497       break;
 498
 499     case SIGFPE:
 500       exception = &constraint_error;
 501       msg = "SIGFPE";
 502       break;
 503
 504     default:
 505       exception = &program_error;
 506       msg = "unhandled signal";
 507     }
 508
 509   recurse = 0;
 510   mstate = (struct sigcontext *) (*Get_Machine_State_Addr) ();
 511   if (mstate != 0)
 512     *mstate = *context;
 513
 514   Raise_From_Signal_Handler (exception, (char *) msg);
 515 }
 516
 517 void
 518 __gnat_install_handler (void)
 519 {
 520   struct sigaction act;
 521
 522   /* Setup signal handler to map synchronous signals to appropriate
 523      exceptions. Make sure that the handler isn't interrupted by another
 524      signal that might cause a scheduling event! */
 525
 526   act.sa_handler = (void (*) (int)) __gnat_error_handler;
 527   act.sa_flags = SA_RESTART | SA_NODEFER | SA_SIGINFO;
 528   sigemptyset (&act.sa_mask);
 529
 530   /* Do not install handlers if interrupt state is "System" */
 531   if (__gnat_get_interrupt_state (SIGABRT) != 's')
 532     sigaction (SIGABRT, &act, NULL);
 533   if (__gnat_get_interrupt_state (SIGFPE) != 's')
 534     sigaction (SIGFPE,  &act, NULL);
 535   if (__gnat_get_interrupt_state (SIGILL) != 's')
 536     sigaction (SIGILL,  &act, NULL);
 537   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 538     sigaction (SIGSEGV, &act, NULL);
 539   if (__gnat_get_interrupt_state (SIGBUS) != 's')
 540     sigaction (SIGBUS,  &act, NULL);
 541
 542   __gnat_handler_installed = 1;
 543 }
 544
 545 void
 546 __gnat_initialize (void)
 547 {
 548 }
 549
 550 /* Routines called by 5amastop.adb.  */
 551
 552 #define SC_GP 29
 553
 554 char *
 555 __gnat_get_code_loc (struct sigcontext *context)
 556 {
 557   return (char *) context->sc_pc;
 558 }
 559
 560 void
 561 __gnat_enter_handler ( struct sigcontext *context, char *pc)
 562 {
 563   context->sc_pc = (long) pc;
 564   context->sc_regs[SC_GP] = exc_lookup_gp (pc);
 565   exc_resume (context);
 566 }
 567
 568 size_t
 569 __gnat_machine_state_length (void)
 570 {
 571   return sizeof (struct sigcontext);
 572 }
 573
 574 /************************************/
 575 /* __gnat_initialize (HPUX Version) */
 576 /************************************/
 577
 578 #elif defined (hpux)
 579
 580 #include <signal.h>
 581
 582 static void __gnat_error_handler (int);
 583
 584 static void
 585 __gnat_error_handler (int sig)
 586 {
 587   struct Exception_Data *exception;
 588   char *msg;
 589
 590   switch (sig)
 591     {
 592     case SIGSEGV:
 593       /* FIXME: we need to detect the case of a *real* SIGSEGV */
 594       exception = &storage_error;
 595       msg = "stack overflow or erroneous memory access";
 596       break;
 597
 598     case SIGBUS:
 599       exception = &constraint_error;
 600       msg = "SIGBUS";
 601       break;
 602
 603     case SIGFPE:
 604       exception = &constraint_error;
 605       msg = "SIGFPE";
 606       break;
 607
 608     default:
 609       exception = &program_error;
 610       msg = "unhandled signal";
 611     }
 612
 613   Raise_From_Signal_Handler (exception, msg);
 614 }
 615
 616 void
 617 __gnat_install_handler (void)
 618 {
 619   struct sigaction act;
 620
 621   /* Set up signal handler to map synchronous signals to appropriate
 622      exceptions.  Make sure that the handler isn't interrupted by another
 623      signal that might cause a scheduling event! Also setup an alternate
 624      stack region for the handler execution so that stack overflows can be
 625      handled properly, avoiding a SEGV generation from stack usage by the
 626      handler itself. */
 627
 628   static char handler_stack[SIGSTKSZ*2];
 629   /* SIGSTKSZ appeared to be "short" for the needs in some contexts
 630      (e.g. experiments with GCC ZCX exceptions).  */
 631
 632   stack_t stack;
 633
 634   stack.ss_sp    = handler_stack;
 635   stack.ss_size  = sizeof (handler_stack);
 636   stack.ss_flags = 0;
 637
 638   sigaltstack (&stack, NULL);
 639
 640   act.sa_handler = __gnat_error_handler;
 641   act.sa_flags = SA_NODEFER | SA_RESTART | SA_ONSTACK;
 642   sigemptyset (&act.sa_mask);
 643
 644   /* Do not install handlers if interrupt state is "System" */
 645   if (__gnat_get_interrupt_state (SIGABRT) != 's')
 646     sigaction (SIGABRT, &act, NULL);
 647   if (__gnat_get_interrupt_state (SIGFPE) != 's')
 648     sigaction (SIGFPE,  &act, NULL);
 649   if (__gnat_get_interrupt_state (SIGILL) != 's')
 650     sigaction (SIGILL,  &act, NULL);
 651   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 652     sigaction (SIGSEGV, &act, NULL);
 653   if (__gnat_get_interrupt_state (SIGBUS) != 's')
 654     sigaction (SIGBUS,  &act, NULL);
 655
 656   __gnat_handler_installed = 1;
 657 }
 658
 659 void
 660 __gnat_initialize (void)
 661 {
 662 }
 663
 664 /*****************************************/
 665 /* __gnat_initialize (GNU/Linux Version) */
 666 /*****************************************/
 667
 668 #elif defined (linux) && defined (i386) && !defined (__RT__)
 669
 670 #include <signal.h>
 671 #include <asm/sigcontext.h>
 672
 673 /* GNU/Linux, which uses glibc, does not define NULL in included
 674    header files */
 675
 676 #if !defined (NULL)
 677 #define NULL ((void *) 0)
 678 #endif
 679
 680 struct Machine_State
 681 {
 682   unsigned long eip;
 683   unsigned long ebx;
 684   unsigned long esp;
 685   unsigned long ebp;
 686   unsigned long esi;
 687   unsigned long edi;
 688 };
 689
 690 static void __gnat_error_handler (int);
 691
 692 static void
 693 __gnat_error_handler (int sig)
 694 {
 695   struct Exception_Data *exception;
 696   const char *msg;
 697   static int recurse = 0;
 698
 699   struct sigcontext *info
 700     = (struct sigcontext *) (((char *) &sig) + sizeof (int));
 701
 702   /* The Linux kernel does not document how to get the machine state in a
 703      signal handler, but in fact the necessary data is in a sigcontext_struct
 704      value that is on the stack immediately above the signal number
 705      parameter, and the above messing accesses this value on the stack. */
 706
 707   struct Machine_State *mstate;
 708
 709   switch (sig)
 710     {
 711     case SIGSEGV:
 712       /* If the problem was permissions, this is a constraint error.
 713        Likewise if the failing address isn't maximally aligned or if
 714        we've recursed.
 715
 716        ??? Using a static variable here isn't task-safe, but it's
 717        much too hard to do anything else and we're just determining
 718        which exception to raise.  */
 719       if (recurse)
 720       {
 721         exception = &constraint_error;
 722         msg = "SIGSEGV";
 723       }
 724       else
 725       {
 726         /* Here we would like a discrimination test to see whether the
 727            page before the faulting address is accessible. Unfortunately
 728            Linux seems to have no way of giving us the faulting address.
 729
 730            In versions of a-init.c before 1.95, we had a test of the page
 731            before the stack pointer using:
 732
 733             recurse++;
 734              ((volatile char *)
 735               ((long) info->esp_at_signal & - getpagesize ()))[getpagesize ()];
 736
 737            but that's wrong, since it tests the stack pointer location, and
 738            the current stack probe code does not move the stack pointer
 739            until all probes succeed.
 740
 741            For now we simply do not attempt any discrimination at all. Note
 742            that this is quite acceptable, since a "real" SIGSEGV can only
 743            occur as the result of an erroneous program */
 744
 745         msg = "stack overflow (or erroneous memory access)";
 746         exception = &storage_error;
 747       }
 748       break;
 749
 750     case SIGBUS:
 751       exception = &constraint_error;
 752       msg = "SIGBUS";
 753       break;
 754
 755     case SIGFPE:
 756       exception = &constraint_error;
 757       msg = "SIGFPE";
 758       break;
 759
 760     default:
 761       exception = &program_error;
 762       msg = "unhandled signal";
 763     }
 764
 765   mstate = (*Get_Machine_State_Addr) ();
 766   if (mstate)
 767     {
 768       mstate->eip = info->eip;
 769       mstate->ebx = info->ebx;
 770       mstate->esp = info->esp_at_signal;
 771       mstate->ebp = info->ebp;
 772       mstate->esi = info->esi;
 773       mstate->edi = info->edi;
 774     }
 775
 776   recurse = 0;
 777   Raise_From_Signal_Handler (exception, msg);
 778 }
 779
 780 void
 781 __gnat_install_handler (void)
 782 {
 783   struct sigaction act;
 784
 785   /* Set up signal handler to map synchronous signals to appropriate
 786      exceptions.  Make sure that the handler isn't interrupted by another
 787      signal that might cause a scheduling event! */
 788
 789   act.sa_handler = __gnat_error_handler;
 790   act.sa_flags = SA_NODEFER | SA_RESTART;
 791   sigemptyset (&act.sa_mask);
 792
 793   /* Do not install handlers if interrupt state is "System" */
 794   if (__gnat_get_interrupt_state (SIGABRT) != 's')
 795     sigaction (SIGABRT, &act, NULL);
 796   if (__gnat_get_interrupt_state (SIGFPE) != 's')
 797     sigaction (SIGFPE,  &act, NULL);
 798   if (__gnat_get_interrupt_state (SIGILL) != 's')
 799     sigaction (SIGILL,  &act, NULL);
 800   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 801     sigaction (SIGSEGV, &act, NULL);
 802   if (__gnat_get_interrupt_state (SIGBUS) != 's')
 803     sigaction (SIGBUS,  &act, NULL);
 804
 805   __gnat_handler_installed = 1;
 806 }
 807
 808 void
 809 __gnat_initialize (void)
 810 {
 811 }
 812
 813 /******************************************/
 814 /* __gnat_initialize (NT-mingw32 Version) */
 815 /******************************************/
 816
 817 #elif defined (__MINGW32__)
 818 #include <windows.h>
 819
 820 static LONG WINAPI __gnat_error_handler (PEXCEPTION_POINTERS);
 821
 822 /* __gnat_initialize (mingw32).  */
 823
 824 static LONG WINAPI
 825 __gnat_error_handler (PEXCEPTION_POINTERS info)
 826 {
 827   static int recurse;
 828   struct Exception_Data *exception;
 829   const char *msg;
 830
 831   switch (info->ExceptionRecord->ExceptionCode)
 832     {
 833     case EXCEPTION_ACCESS_VIOLATION:
 834       /* If the failing address isn't maximally-aligned or if we've
 835          recursed, this is a program error.  */
 836       if ((info->ExceptionRecord->ExceptionInformation[1] & 3) != 0
 837           || recurse)
 838         {
 839           exception = &program_error;
 840           msg = "EXCEPTION_ACCESS_VIOLATION";
 841         }
 842       else
 843         {
 844           /* See if the page before the faulting page is accessible.  Do that
 845              by trying to access it. */
 846           recurse++;
 847           * ((volatile char *) (info->ExceptionRecord->ExceptionInformation[1]
 848                                 + 4096));
 849           exception = &storage_error;
 850           msg = "stack overflow (or erroneous memory access)";
 851         }
 852       break;
 853
 854     case EXCEPTION_ARRAY_BOUNDS_EXCEEDED:
 855       exception = &constraint_error;
 856       msg = "EXCEPTION_ARRAY_BOUNDS_EXCEEDED";
 857       break;
 858
 859     case EXCEPTION_DATATYPE_MISALIGNMENT:
 860       exception = &constraint_error;
 861       msg = "EXCEPTION_DATATYPE_MISALIGNMENT";
 862       break;
 863
 864     case EXCEPTION_FLT_DENORMAL_OPERAND:
 865       exception = &constraint_error;
 866       msg = "EXCEPTION_FLT_DENORMAL_OPERAND";
 867       break;
 868
 869     case EXCEPTION_FLT_DIVIDE_BY_ZERO:
 870       exception = &constraint_error;
 871       msg = "EXCEPTION_FLT_DENORMAL_OPERAND";
 872       break;
 873
 874     case EXCEPTION_FLT_INVALID_OPERATION:
 875       exception = &constraint_error;
 876       msg = "EXCEPTION_FLT_INVALID_OPERATION";
 877       break;
 878
 879     case EXCEPTION_FLT_OVERFLOW:
 880       exception = &constraint_error;
 881       msg = "EXCEPTION_FLT_OVERFLOW";
 882       break;
 883
 884     case EXCEPTION_FLT_STACK_CHECK:
 885       exception = &program_error;
 886       msg = "EXCEPTION_FLT_STACK_CHECK";
 887       break;
 888
 889     case EXCEPTION_FLT_UNDERFLOW:
 890       exception = &constraint_error;
 891       msg = "EXCEPTION_FLT_UNDERFLOW";
 892       break;
 893
 894     case EXCEPTION_INT_DIVIDE_BY_ZERO:
 895       exception = &constraint_error;
 896       msg = "EXCEPTION_INT_DIVIDE_BY_ZERO";
 897       break;
 898
 899     case EXCEPTION_INT_OVERFLOW:
 900       exception = &constraint_error;
 901       msg = "EXCEPTION_INT_OVERFLOW";
 902       break;
 903
 904     case EXCEPTION_INVALID_DISPOSITION:
 905       exception = &program_error;
 906       msg = "EXCEPTION_INVALID_DISPOSITION";
 907       break;
 908
 909     case EXCEPTION_NONCONTINUABLE_EXCEPTION:
 910       exception = &program_error;
 911       msg = "EXCEPTION_NONCONTINUABLE_EXCEPTION";
 912       break;
 913
 914     case EXCEPTION_PRIV_INSTRUCTION:
 915       exception = &program_error;
 916       msg = "EXCEPTION_PRIV_INSTRUCTION";
 917       break;
 918
 919     case EXCEPTION_SINGLE_STEP:
 920       exception = &program_error;
 921       msg = "EXCEPTION_SINGLE_STEP";
 922       break;
 923
 924     case EXCEPTION_STACK_OVERFLOW:
 925       exception = &storage_error;
 926       msg = "EXCEPTION_STACK_OVERFLOW";
 927       break;
 928
 929    default:
 930       exception = &program_error;
 931       msg = "unhandled signal";
 932     }
 933
 934   recurse = 0;
 935   Raise_From_Signal_Handler (exception, msg);
 936   return 0; /* This is never reached, avoid compiler warning */
 937 }
 938
 939 void
 940 __gnat_install_handler (void)
 941 {
 942   SetUnhandledExceptionFilter (__gnat_error_handler);
 943   __gnat_handler_installed = 1;
 944 }
 945
 946 void
 947 __gnat_initialize (void)
 948 {
 949
 950    /* Initialize floating-point coprocessor. This call is needed because
 951       the MS libraries default to 64-bit precision instead of 80-bit
 952       precision, and we require the full precision for proper operation,
 953       given that we have set Max_Digits etc with this in mind */
 954
 955    __gnat_init_float ();
 956
 957    /* initialize a lock for a process handle list - see a-adaint.c for the
 958       implementation of __gnat_portable_no_block_spawn, __gnat_portable_wait */
 959    __gnat_plist_init();
 960 }
 961
 962 /***************************************/
 963 /* __gnat_initialize (Interix Version) */
 964 /***************************************/
 965
 966 #elif defined (__INTERIX)
 967
 968 #include <signal.h>
 969
 970 static void __gnat_error_handler (int);
 971
 972 static void
 973 __gnat_error_handler (int sig)
 974 {
 975   struct Exception_Data *exception;
 976   char *msg;
 977
 978   switch (sig)
 979     {
 980     case SIGSEGV:
 981       exception = &storage_error;
 982       msg = "stack overflow or erroneous memory access";
 983       break;
 984
 985     case SIGBUS:
 986       exception = &constraint_error;
 987       msg = "SIGBUS";
 988       break;
 989
 990     case SIGFPE:
 991       exception = &constraint_error;
 992       msg = "SIGFPE";
 993       break;
 994
 995     default:
 996       exception = &program_error;
 997       msg = "unhandled signal";
 998     }
 999
1000   Raise_From_Signal_Handler (exception, msg);
1001 }
1002
1003 void
1004 __gnat_install_handler (void)
1005 {
1006   struct sigaction act;
1007
1008   /* Set up signal handler to map synchronous signals to appropriate
1009      exceptions.  Make sure that the handler isn't interrupted by another
1010      signal that might cause a scheduling event! */
1011
1012   act.sa_handler = __gnat_error_handler;
1013   act.sa_flags = 0;
1014   sigemptyset (&act.sa_mask);
1015
1016   /* Handlers for signals besides SIGSEGV cause c974013 to hang */
1017 /*  sigaction (SIGILL,  &act, NULL); */
1018 /*  sigaction (SIGABRT, &act, NULL); */
1019 /*  sigaction (SIGFPE,  &act, NULL); */
1020 /*  sigaction (SIGBUS,  &act, NULL); */
1021
1022   /* Do not install handlers if interrupt state is "System" */
1023   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1024     sigaction (SIGSEGV, &act, NULL);
1025
1026   __gnat_handler_installed = 1;
1027 }
1028
1029 void
1030 __gnat_initialize (void)
1031 {
1032    __gnat_init_float ();
1033 }
1034
1035 /**************************************/
1036 /* __gnat_initialize (LynxOS Version) */
1037 /**************************************/
1038
1039 #elif defined (__Lynx__)
1040
1041 void
1042 __gnat_initialize (void)
1043 {
1044    __gnat_init_float ();
1045 }
1046
1047 /*********************************/
1048 /* __gnat_install_handler (Lynx) */
1049 /*********************************/
1050
1051 void
1052 __gnat_install_handler (void)
1053 {
1054   __gnat_handler_installed = 1;
1055 }
1056
1057 /****************************/
1058 /* __gnat_initialize (OS/2) */
1059 /****************************/
1060
1061 #elif defined (__EMX__) /* OS/2 dependent initialization */
1062
1063 void
1064 __gnat_initialize (void)
1065 {
1066 }
1067
1068 /*********************************/
1069 /* __gnat_install_handler (OS/2) */
1070 /*********************************/
1071
1072 void
1073 __gnat_install_handler (void)
1074 {
1075   __gnat_handler_installed = 1;
1076 }
1077
1078 /***********************************/
1079 /* __gnat_initialize (SGI Version) */
1080 /***********************************/
1081
1082 #elif defined (sgi)
1083
1084 #include <signal.h>
1085 #include <siginfo.h>
1086
1087 #ifndef NULL
1088 #define NULL 0
1089 #endif
1090
1091 #define SIGADAABORT 48
1092 #define SIGNAL_STACK_SIZE 4096
1093 #define SIGNAL_STACK_ALIGNMENT 64
1094
1095 struct Machine_State
1096 {
1097   sigcontext_t context;
1098 };
1099
1100 static void __gnat_error_handler (int, int, sigcontext_t *);
1101
1102 /* We are not setting the SA_SIGINFO bit in the sigaction flags when
1103    connecting that handler, with the effects described in the sigaction
1104    man page:
1105
1106           SA_SIGINFO [...]
1107           If cleared and the signal is caught, the first argument is
1108           also the signal number but the second argument is the signal
1109           code identifying the cause of the signal. The third argument
1110           points to a sigcontext_t structure containing the receiving
1111           process's context when the signal was delivered.
1112 */
1113
1114 static void
1115 __gnat_error_handler (int sig, int code, sigcontext_t *sc)
1116 {
1117   struct Machine_State  *mstate;
1118   struct Exception_Data *exception;
1119   const char *msg;
1120
1121   switch (sig)
1122     {
1123     case SIGSEGV:
1124       if (code == EFAULT)
1125         {
1126           exception = &program_error;
1127           msg = "SIGSEGV: (Invalid virtual address)";
1128         }
1129       else if (code == ENXIO)
1130         {
1131           exception = &program_error;
1132           msg = "SIGSEGV: (Read beyond mapped object)";
1133         }
1134       else if (code == ENOSPC)
1135         {
1136           exception = &program_error; /* ??? storage_error ??? */
1137           msg = "SIGSEGV: (Autogrow for file failed)";
1138         }
1139       else if (code == EACCES || code == EEXIST)
1140         {
1141           /* ??? We handle stack overflows here, some of which do trigger
1142                  SIGSEGV + EEXIST on Irix 6.5 although EEXIST is not part of
1143                  the documented valid codes for SEGV in the signal(5) man
1144                  page.  */
1145
1146           /* ??? Re-add smarts to further verify that we launched
1147                  the stack into a guard page, not an attempt to
1148                  write to .text or something */
1149           exception = &storage_error;
1150           msg = "SIGSEGV: (stack overflow or erroneous memory access)";
1151         }
1152       else
1153         {
1154           /* Just in case the OS guys did it to us again.  Sometimes
1155              they fail to document all of the valid codes that are
1156              passed to signal handlers, just in case someone depends
1157              on knowing all the codes */
1158           exception = &program_error;
1159           msg = "SIGSEGV: (Undocumented reason)";
1160         }
1161       break;
1162
1163     case SIGBUS:
1164       /* Map all bus errors to Program_Error.  */
1165       exception = &program_error;
1166       msg = "SIGBUS";
1167       break;
1168
1169     case SIGFPE:
1170       /* Map all fpe errors to Constraint_Error.  */
1171       exception = &constraint_error;
1172       msg = "SIGFPE";
1173       break;
1174
1175     case SIGADAABORT:
1176       if ((*Check_Abort_Status) ())
1177         {
1178           exception = &_abort_signal;
1179           msg = "";
1180         }
1181       else
1182         return;
1183
1184       break;
1185
1186     default:
1187       /* Everything else is a Program_Error. */
1188       exception = &program_error;
1189       msg = "unhandled signal";
1190     }
1191
1192   mstate = (*Get_Machine_State_Addr) ();
1193   if (mstate != 0)
1194     memcpy ((void *) mstate, (const void *) sc, sizeof (sigcontext_t));
1195
1196   Raise_From_Signal_Handler (exception, msg);
1197 }
1198
1199 void
1200 __gnat_install_handler (void)
1201 {
1202   struct sigaction act;
1203
1204   /* Setup signal handler to map synchronous signals to appropriate
1205      exceptions.  Make sure that the handler isn't interrupted by another
1206      signal that might cause a scheduling event! */
1207
1208   act.sa_handler = __gnat_error_handler;
1209   act.sa_flags = SA_NODEFER + SA_RESTART;
1210   sigfillset (&act.sa_mask);
1211   sigemptyset (&act.sa_mask);
1212
1213   /* Do not install handlers if interrupt state is "System" */
1214   if (__gnat_get_interrupt_state (SIGABRT) != 's')
1215     sigaction (SIGABRT, &act, NULL);
1216   if (__gnat_get_interrupt_state (SIGFPE) != 's')
1217     sigaction (SIGFPE,  &act, NULL);
1218   if (__gnat_get_interrupt_state (SIGILL) != 's')
1219     sigaction (SIGILL,  &act, NULL);
1220   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1221     sigaction (SIGSEGV, &act, NULL);
1222   if (__gnat_get_interrupt_state (SIGBUS) != 's')
1223     sigaction (SIGBUS,  &act, NULL);
1224   if (__gnat_get_interrupt_state (SIGADAABORT) != 's')
1225     sigaction (SIGADAABORT,  &act, NULL);
1226
1227   __gnat_handler_installed = 1;
1228 }
1229
1230 void
1231 __gnat_initialize (void)
1232 {
1233 }
1234
1235 /*************************************************/
1236 /* __gnat_initialize (Solaris and SunOS Version) */
1237 /*************************************************/
1238
1239 #elif defined (sun) && defined (__SVR4) && !defined (__vxworks)
1240
1241 #include <signal.h>
1242 #include <siginfo.h>
1243
1244 static void __gnat_error_handler (int, siginfo_t *);
1245
1246 static void
1247 __gnat_error_handler (int sig, siginfo_t *sip)
1248 {
1249   struct Exception_Data *exception;
1250   static int recurse = 0;
1251   const char *msg;
1252
1253   /* If this was an explicit signal from a "kill", just resignal it.  */
1254   if (SI_FROMUSER (sip))
1255     {
1256       signal (sig, SIG_DFL);
1257       kill (getpid(), sig);
1258     }
1259
1260   /* Otherwise, treat it as something we handle.  */
1261   switch (sig)
1262     {
1263     case SIGSEGV:
1264       /* If the problem was permissions, this is a constraint error.
1265          Likewise if the failing address isn't maximally aligned or if
1266          we've recursed.
1267
1268          ??? Using a static variable here isn't task-safe, but it's
1269          much too hard to do anything else and we're just determining
1270          which exception to raise.  */
1271       if (sip->si_code == SEGV_ACCERR
1272           || (((long) sip->si_addr) & 3) != 0
1273           || recurse)
1274         {
1275           exception = &constraint_error;
1276           msg = "SIGSEGV";
1277         }
1278       else
1279         {
1280           /* See if the page before the faulting page is accessible.  Do that
1281              by trying to access it.  We'd like to simply try to access
1282              4096 + the faulting address, but it's not guaranteed to be
1283              the actual address, just to be on the same page.  */
1284           recurse++;
1285           ((volatile char *)
1286            ((long) sip->si_addr & - getpagesize ()))[getpagesize ()];
1287           exception = &storage_error;
1288           msg = "stack overflow (or erroneous memory access)";
1289         }
1290       break;
1291
1292     case SIGBUS:
1293       exception = &program_error;
1294       msg = "SIGBUS";
1295       break;
1296
1297     case SIGFPE:
1298       exception = &constraint_error;
1299       msg = "SIGFPE";
1300       break;
1301
1302     default:
1303       exception = &program_error;
1304       msg = "unhandled signal";
1305     }
1306
1307   recurse = 0;
1308
1309   Raise_From_Signal_Handler (exception, msg);
1310 }
1311
1312 void
1313 __gnat_install_handler (void)
1314 {
1315   struct sigaction act;
1316
1317   /* Set up signal handler to map synchronous signals to appropriate
1318      exceptions.  Make sure that the handler isn't interrupted by another
1319      signal that might cause a scheduling event! */
1320
1321   act.sa_handler = __gnat_error_handler;
1322   act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
1323   sigemptyset (&act.sa_mask);
1324
1325   /* Do not install handlers if interrupt state is "System" */
1326   if (__gnat_get_interrupt_state (SIGABRT) != 's')
1327     sigaction (SIGABRT, &act, NULL);
1328   if (__gnat_get_interrupt_state (SIGFPE) != 's')
1329     sigaction (SIGFPE,  &act, NULL);
1330   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1331     sigaction (SIGSEGV, &act, NULL);
1332   if (__gnat_get_interrupt_state (SIGBUS) != 's')
1333     sigaction (SIGBUS,  &act, NULL);
1334
1335   __gnat_handler_installed = 1;
1336 }
1337
1338 void
1339 __gnat_initialize (void)
1340 {
1341 }
1342
1343 /***********************************/
1344 /* __gnat_initialize (VMS Version) */
1345 /***********************************/
1346
1347 #elif defined (VMS)
1348
1349 #ifdef __IA64
1350 #define lib_get_curr_invo_context LIB$I64_GET_CURR_INVO_CONTEXT
1351 #define lib_get_prev_invo_context LIB$I64_GET_PREV_INVO_CONTEXT
1352 #define lib_get_invo_handle LIB$I64_GET_INVO_HANDLE
1353 #else
1354 #define lib_get_curr_invo_context LIB$GET_CURR_INVO_CONTEXT
1355 #define lib_get_prev_invo_context LIB$GET_PREV_INVO_CONTEXT
1356 #define lib_get_invo_handle LIB$GET_INVO_HANDLE
1357 #endif
1358
1359 #if defined (IN_RTS) && !defined (__IA64)
1360
1361 /* The prehandler actually gets control first on a condition. It swaps the
1362    stack pointer and calls the handler (__gnat_error_handler). */
1363 extern long __gnat_error_prehandler (void);
1364
1365 extern char *__gnat_error_prehandler_stack;   /* Alternate signal stack */
1366 #endif
1367
1368 /* Conditions that don't have an Ada exception counterpart must raise
1369    Non_Ada_Error.  Since this is defined in s-auxdec, it should only be
1370    referenced by user programs, not the compiler or tools. Hence the
1371    #ifdef IN_RTS. */
1372
1373 #ifdef IN_RTS
1374 #define Non_Ada_Error system__aux_dec__non_ada_error
1375 extern struct Exception_Data Non_Ada_Error;
1376
1377 #define Coded_Exception system__vms_exception_table__coded_exception
1378 extern struct Exception_Data *Coded_Exception (Exception_Code);
1379
1380 #define Base_Code_In system__vms_exception_table__base_code_in
1381 extern Exception_Code Base_Code_In (Exception_Code);
1382 #endif
1383
1384 /* Define macro symbols for the VMS conditions that become Ada exceptions.
1385    Most of these are also defined in the header file ssdef.h which has not
1386    yet been converted to be recoginized by Gnu C. Some, which couldn't be
1387    located, are assigned names based on the DEC test suite tests which
1388    raise them. */
1389
1390 #define SS$_ACCVIO            12
1391 #define SS$_DEBUG           1132
1392 #define SS$_INTDIV          1156
1393 #define SS$_HPARITH         1284
1394 #define SS$_STKOVF          1364
1395 #define SS$_RESIGNAL        2328
1396 #define MTH$_FLOOVEMAT   1475268       /* Some ACVC_21 CXA tests */
1397 #define SS$_CE24VRU      3253636       /* Write to unopened file */
1398 #define SS$_C980VTE      3246436       /* AST requests time slice */
1399 #define CMA$_EXIT_THREAD 4227492
1400 #define CMA$_EXCCOPLOS   4228108
1401 #define CMA$_ALERTED     4227460
1402
1403 struct descriptor_s {unsigned short len, mbz; char *adr; };
1404
1405 long __gnat_error_handler (int *, void *);
1406
1407 long
1408 __gnat_error_handler (int *sigargs, void *mechargs)
1409 {
1410   struct Exception_Data *exception = 0;
1411   Exception_Code base_code;
1412
1413   char *msg = "";
1414   char message[256];
1415   long prvhnd;
1416   struct descriptor_s msgdesc;
1417   int msg_flag = 0x000f; /* 1 bit for each of the four message parts */
1418   unsigned short outlen;
1419   char curr_icb[544];
1420   long curr_invo_handle;
1421   long *mstate;
1422
1423   /* Resignaled condtions aren't effected by by pragma Import_Exception */
1424
1425   switch (sigargs[1])
1426   {
1427
1428     case CMA$_EXIT_THREAD:
1429       return SS$_RESIGNAL;
1430
1431     case SS$_DEBUG: /* Gdb attach, resignal to merge activate gdbstub. */
1432       return SS$_RESIGNAL;
1433
1434     case 1409786: /* Nickerson bug #33 ??? */
1435       return SS$_RESIGNAL;
1436
1437     case 1381050: /* Nickerson bug #33 ??? */
1438       return SS$_RESIGNAL;
1439
1440     case 20480426: /* RDB-E-STREAM_EOF */
1441       return SS$_RESIGNAL;
1442
1443     case 11829410: /* Resignalled as Use_Error for CE10VRC */
1444       return SS$_RESIGNAL;
1445
1446   }
1447
1448 #ifdef IN_RTS
1449   /* See if it's an imported exception. Beware that registered exceptions
1450      are bound to their base code, with the severity bits masked off.  */
1451   base_code = Base_Code_In ((Exception_Code) sigargs [1]);
1452   exception = Coded_Exception (base_code);
1453
1454   if (exception)
1455     {
1456       msgdesc.len = 256;
1457       msgdesc.mbz = 0;
1458       msgdesc.adr = message;
1459       SYS$GETMSG (sigargs[1], &outlen, &msgdesc, msg_flag, 0);
1460       message[outlen] = 0;
1461       msg = message;
1462
1463       exception->Name_Length = 19;
1464       /* The full name really should be get sys$getmsg returns. ??? */
1465       exception->Full_Name = "IMPORTED_EXCEPTION";
1466       exception->Import_Code = base_code;
1467     }
1468 #endif
1469
1470   if (exception == 0)
1471     switch (sigargs[1])
1472       {
1473       case SS$_ACCVIO:
1474         if (sigargs[3] == 0)
1475           {
1476             exception = &constraint_error;
1477             msg = "access zero";
1478           }
1479         else
1480           {
1481             exception = &storage_error;
1482             msg = "stack overflow (or erroneous memory access)";
1483           }
1484         break;
1485
1486       case SS$_STKOVF:
1487         exception = &storage_error;
1488         msg = "stack overflow";
1489         break;
1490
1491       case SS$_INTDIV:
1492         exception = &constraint_error;
1493         msg = "division by zero";
1494         break;
1495
1496       case SS$_HPARITH:
1497 #ifndef IN_RTS
1498         return SS$_RESIGNAL; /* toplev.c handles for compiler */
1499 #else
1500         {
1501           exception = &constraint_error;
1502           msg = "arithmetic error";
1503         }
1504 #endif
1505         break;
1506
1507       case MTH$_FLOOVEMAT:
1508         exception = &constraint_error;
1509         msg = "floating overflow in math library";
1510         break;
1511
1512       case SS$_CE24VRU:
1513         exception = &constraint_error;
1514         msg = "";
1515         break;
1516
1517       case SS$_C980VTE:
1518         exception = &program_error;
1519         msg = "";
1520         break;
1521
1522       default:
1523 #ifndef IN_RTS
1524         exception = &program_error;
1525 #else
1526         /* User programs expect Non_Ada_Error to be raised, reference
1527            DEC Ada test CXCONDHAN. */
1528         exception = &Non_Ada_Error;
1529 #endif
1530         msgdesc.len = 256;
1531         msgdesc.mbz = 0;
1532         msgdesc.adr = message;
1533         SYS$GETMSG (sigargs[1], &outlen, &msgdesc, msg_flag, 0);
1534         message[outlen] = 0;
1535         msg = message;
1536         break;
1537       }
1538
1539   mstate = (long *) (*Get_Machine_State_Addr) ();
1540   if (mstate != 0)
1541     {
1542       lib_get_curr_invo_context (&curr_icb);
1543       lib_get_prev_invo_context (&curr_icb);
1544       lib_get_prev_invo_context (&curr_icb);
1545       curr_invo_handle = lib_get_invo_handle (&curr_icb);
1546       *mstate = curr_invo_handle;
1547     }
1548   Raise_From_Signal_Handler (exception, msg);
1549 }
1550
1551 void
1552 __gnat_install_handler (void)
1553 {
1554   long prvhnd;
1555 #if defined (IN_RTS) && !defined (__IA64)
1556   char *c;
1557
1558   c = (char *) xmalloc (2049);
1559
1560   __gnat_error_prehandler_stack = &c[2048];
1561
1562   /* __gnat_error_prehandler is an assembly function.  */
1563   SYS$SETEXV (1, __gnat_error_prehandler, 3, &prvhnd);
1564 #else
1565   SYS$SETEXV (1, __gnat_error_handler, 3, &prvhnd);
1566 #endif
1567   __gnat_handler_installed = 1;
1568 }
1569
1570 void
1571 __gnat_initialize(void)
1572 {
1573 }
1574
1575 /*************************************************/
1576 /* __gnat_initialize (FreeBSD version) */
1577 /*************************************************/
1578
1579 #elif defined (__FreeBSD__)
1580
1581 #include <signal.h>
1582 #include <unistd.h>
1583
1584 static void
1585 __gnat_error_handler (sig, code, sc)
1586      int sig;
1587      int code;
1588      struct sigcontext *sc;
1589 {
1590   struct Exception_Data *exception;
1591   char *msg;
1592
1593   switch (sig)
1594     {
1595     case SIGFPE:
1596       exception = &constraint_error;
1597       msg = "SIGFPE";
1598       break;
1599
1600     case SIGILL:
1601       exception = &constraint_error;
1602       msg = "SIGILL";
1603       break;
1604
1605     case SIGSEGV:
1606       exception = &storage_error;
1607       msg = "stack overflow or erroneous memory access";
1608       break;
1609
1610     case SIGBUS:
1611       exception = &constraint_error;
1612       msg = "SIGBUS";
1613       break;
1614
1615     default:
1616       exception = &program_error;
1617       msg = "unhandled signal";
1618     }
1619
1620   Raise_From_Signal_Handler (exception, msg);
1621 }
1622
1623 void
1624 __gnat_install_handler ()
1625 {
1626   struct sigaction act;
1627
1628   /* Set up signal handler to map synchronous signals to appropriate
1629      exceptions.  Make sure that the handler isn't interrupted by another
1630      signal that might cause a scheduling event! */
1631
1632   act.sa_handler = __gnat_error_handler;
1633   act.sa_flags = SA_NODEFER | SA_RESTART;
1634   (void) sigemptyset (&act.sa_mask);
1635
1636   (void) sigaction (SIGILL,  &act, NULL);
1637   (void) sigaction (SIGFPE,  &act, NULL);
1638   (void) sigaction (SIGSEGV, &act, NULL);
1639   (void) sigaction (SIGBUS,  &act, NULL);
1640 }
1641
1642 void __gnat_init_float ();
1643
1644 void
1645 __gnat_initialize ()
1646 {
1647    __gnat_install_handler ();
1648
1649    /* XXX - Initialize floating-point coprocessor. This call is
1650       needed because FreeBSD defaults to 64-bit precision instead
1651       of 80-bit precision?  We require the full precision for
1652       proper operation, given that we have set Max_Digits etc
1653       with this in mind */
1654    __gnat_init_float ();
1655 }
1656
1657 /***************************************/
1658 /* __gnat_initialize (VXWorks Version) */
1659 /***************************************/
1660
1661 #elif defined(__vxworks)
1662
1663 #include <signal.h>
1664 #include <taskLib.h>
1665 #include <intLib.h>
1666 #include <iv.h>
1667
1668 extern int __gnat_inum_to_ivec (int);
1669 static void __gnat_error_handler (int, int, struct sigcontext *);
1670 void __gnat_map_signal (int);
1671
1672 #ifndef __alpha_vxworks
1673
1674 /* getpid is used by s-parint.adb, but is not defined by VxWorks, except
1675    on Alpha VxWorks */
1676
1677 extern long getpid (void);
1678
1679 long
1680 getpid (void)
1681 {
1682   return taskIdSelf ();
1683 }
1684 #endif
1685
1686 /* This is needed by the GNAT run time to handle Vxworks interrupts */
1687 int
1688 __gnat_inum_to_ivec (int num)
1689 {
1690   return INUM_TO_IVEC (num);
1691 }
1692
1693 /* Exported to 5zintman.adb in order to handle different signal
1694    to exception mappings in different VxWorks versions */
1695 void
1696 __gnat_map_signal (int sig)
1697 {
1698   struct Exception_Data *exception;
1699   char *msg;
1700
1701   switch (sig)
1702     {
1703     case SIGFPE:
1704       exception = &constraint_error;
1705       msg = "SIGFPE";
1706       break;
1707     case SIGILL:
1708       exception = &constraint_error;
1709       msg = "SIGILL";
1710       break;
1711     case SIGSEGV:
1712       exception = &program_error;
1713       msg = "SIGSEGV";
1714       break;
1715     case SIGBUS:
1716 #ifdef VTHREADS
1717       exception = &storage_error;
1718       msg = "SIGBUS: possible stack overflow";
1719 #else
1720       exception = &program_error;
1721       msg = "SIGBUS";
1722 #endif
1723       break;
1724     default:
1725       exception = &program_error;
1726       msg = "unhandled signal";
1727     }
1728
1729   Raise_From_Signal_Handler (exception, msg);
1730 }
1731
1732 static void
1733 __gnat_error_handler (int sig, int code, struct sigcontext *sc)
1734 {
1735   sigset_t mask;
1736   int result;
1737
1738   /* VxWorks will always mask out the signal during the signal handler and
1739      will reenable it on a longjmp.  GNAT does not generate a longjmp to
1740      return from a signal handler so the signal will still be masked unless
1741      we unmask it. */
1742   sigprocmask (SIG_SETMASK, NULL, &mask);
1743   sigdelset (&mask, sig);
1744   sigprocmask (SIG_SETMASK, &mask, NULL);
1745
1746   /* VxWorks will suspend the task when it gets a hardware exception.  We
1747      take the liberty of resuming the task for the application. */
1748   if (taskIsSuspended (taskIdSelf ()) != 0)
1749     taskResume (taskIdSelf ());
1750
1751   __gnat_map_signal (sig);
1752
1753 }
1754
1755 void
1756 __gnat_install_handler (void)
1757 {
1758   struct sigaction act;
1759
1760   /* Setup signal handler to map synchronous signals to appropriate
1761      exceptions.  Make sure that the handler isn't interrupted by another
1762      signal that might cause a scheduling event! */
1763
1764   act.sa_handler = __gnat_error_handler;
1765   act.sa_flags = SA_SIGINFO | SA_ONSTACK;
1766   sigemptyset (&act.sa_mask);
1767
1768   /* For VxWorks, install all signal handlers, since pragma Interrupt_State
1769      applies to vectored hardware interrupts, not signals */
1770   sigaction (SIGFPE,  &act, NULL);
1771   sigaction (SIGILL,  &act, NULL);
1772   sigaction (SIGSEGV, &act, NULL);
1773   sigaction (SIGBUS,  &act, NULL);
1774
1775   __gnat_handler_installed = 1;
1776 }
1777
1778 #define HAVE_GNAT_INIT_FLOAT
1779
1780 void
1781 __gnat_init_float (void)
1782 {
1783   /* Disable overflow/underflow exceptions on the PPC processor, this is needed
1784      to get correct Ada semantic.  */
1785 #if defined (_ARCH_PPC) && !defined (_SOFT_FLOAT)
1786   asm ("mtfsb0 25");
1787   asm ("mtfsb0 26");
1788 #endif
1789
1790   /* Similarily for sparc64. Achieved by masking bits in the Trap Enable Mask
1791      field of the Floating-point Status Register (see the Sparc Architecture
1792      Manual Version 9, p 48).  */
1793 #if defined (sparc64)
1794
1795 #define FSR_TEM_NVM (1 << 27)  /* Invalid operand  */
1796 #define FSR_TEM_OFM (1 << 26)  /* Overflow  */
1797 #define FSR_TEM_UFM (1 << 25)  /* Underflow  */
1798 #define FSR_TEM_DZM (1 << 24)  /* Division by Zero  */
1799 #define FSR_TEM_NXM (1 << 23)  /* Inexact result  */
1800   {
1801     unsigned int fsr;
1802
1803     __asm__("st %%fsr, %0" : "=m" (fsr));
1804     fsr &= ~(FSR_TEM_OFM | FSR_TEM_UFM);
1805     __asm__("ld %0, %%fsr" : : "m" (fsr));
1806   }
1807 #endif
1808 }
1809
1810 void
1811 __gnat_initialize (void)
1812 {
1813   __gnat_init_float ();
1814
1815   /* On targets where we might be using the ZCX scheme, we need to register
1816      the frame tables.
1817
1818      For applications loaded as a set of "modules", the crtstuff objects
1819      linked in (crtbegin/endS) are tailored to provide this service a-la C++
1820      static constructor fashion, typically triggered by the VxWorks loader.
1821      This is achieved by way of a special variable declaration in the crt
1822      object, the name of which has been deduced by analyzing the output of the
1823      "munching" step documented for C++.  The de-registration call is handled
1824      symetrically, a-la C++ destructor fashion and typically triggered by the
1825      dynamic unloader. Note that since the tables shall be registered against
1826      a common datastructure, libgcc should be one of the modules (vs beeing
1827      partially linked against all the others at build time) and shall be
1828      loaded first.
1829
1830      For applications linked with the kernel, the scheme above would lead to
1831      duplicated symbols because the VxWorks kernel build "munches" by default.
1832      To prevent those conflicts, we link against crtbegin/end objects that
1833      don't include the special variable and directly call the appropriate
1834      function here. We'll never unload that, so there is no de-registration to
1835      worry about.
1836
1837      For whole applications loaded as a single module, we may use one scheme
1838      or the other, except for the mixed Ada/C++ case in which the first scheme
1839      would fail for the same reason as in the linked-with-kernel situation.
1840
1841      We can differentiate by looking at the __module_has_ctors value provided
1842      by each class of crt objects. As of today, selecting the crt set with the
1843      static ctors/dtors capabilities (first scheme above) is triggered by
1844      adding "-static" to the gcc *link* command line options. Without this,
1845      the other set of crt objects is fetched.
1846
1847      This is a first approach, tightly synchronized with a number of GCC
1848      configuration and crtstuff changes. We need to ensure that those changes
1849      are there to activate this circuitry.  */
1850
1851 #if DWARF2_UNWIND_INFO && defined (_ARCH_PPC)
1852  {
1853    /* The scheme described above is only useful for the actual ZCX case, and
1854       we don't want any reference to the crt provided symbols otherwise.  We
1855       may not link with any of the crt objects in the non-ZCX case, e.g. from
1856       documented procedures instructing the use of -nostdlib, and references
1857       to the ctors symbols here would just remain unsatisfied.
1858
1859       We have no way to avoid those references in the right conditions in this
1860       C module, because we have nothing like a IN_ZCX_RTS macro.  This aspect
1861       is then deferred to an Ada routine, which can do that based on a test
1862       against a constant System flag value.  */
1863
1864    extern void __gnat_vxw_setup_for_eh (void);
1865    __gnat_vxw_setup_for_eh ();
1866  }
1867 #endif
1868 }
1869
1870 /********************************/
1871 /* __gnat_initialize for NetBSD */
1872 /********************************/
1873
1874 #elif defined(__NetBSD__)
1875
1876 #include <signal.h>
1877 #include <unistd.h>
1878
1879 static void
1880 __gnat_error_handler (int sig)
1881 {
1882   struct Exception_Data *exception;
1883   const char *msg;
1884
1885   switch(sig)
1886   {
1887     case SIGFPE:
1888       exception = &constraint_error;
1889       msg = "SIGFPE";
1890       break;
1891     case SIGILL:
1892       exception = &constraint_error;
1893       msg = "SIGILL";
1894       break;
1895     case SIGSEGV:
1896       exception = &storage_error;
1897       msg = "stack overflow or erroneous memory access";
1898       break;
1899     case SIGBUS:
1900       exception = &constraint_error;
1901       msg = "SIGBUS";
1902       break;
1903     default:
1904       exception = &program_error;
1905       msg = "unhandled signal";
1906     }
1907
1908     Raise_From_Signal_Handler(exception, msg);
1909 }
1910
1911 void
1912 __gnat_install_handler(void)
1913 {
1914   struct sigaction act;
1915
1916   act.sa_handler = __gnat_error_handler;
1917   act.sa_flags = SA_NODEFER | SA_RESTART;
1918   sigemptyset (&act.sa_mask);
1919
1920   /* Do not install handlers if interrupt state is "System" */
1921   if (__gnat_get_interrupt_state (SIGFPE) != 's')
1922     sigaction (SIGFPE,  &act, NULL);
1923   if (__gnat_get_interrupt_state (SIGILL) != 's')
1924     sigaction (SIGILL,  &act, NULL);
1925   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1926     sigaction (SIGSEGV, &act, NULL);
1927   if (__gnat_get_interrupt_state (SIGBUS) != 's')
1928     sigaction (SIGBUS,  &act, NULL);
1929
1930   __gnat_handler_installed = 1;
1931 }
1932
1933 void
1934 __gnat_initialize (void)
1935 {
1936   __gnat_install_handler ();
1937   __gnat_init_float ();
1938 }
1939
1940 #else
1941
1942 /* For all other versions of GNAT, the initialize routine and handler
1943    installation do nothing */
1944
1945 /***************************************/
1946 /* __gnat_initialize (Default Version) */
1947 /***************************************/
1948
1949 void
1950 __gnat_initialize (void)
1951 {
1952 }
1953
1954 /********************************************/
1955 /* __gnat_install_handler (Default Version) */
1956 /********************************************/
1957
1958 void
1959 __gnat_install_handler (void)
1960 {
1961   __gnat_handler_installed = 1;
1962 }
1963
1964 #endif
1965
1966 /*********************/
1967 /* __gnat_init_float */
1968 /*********************/
1969
1970 /* This routine is called as each process thread is created, for possible
1971    initialization of the FP processor. This version is used under INTERIX,
1972    WIN32 and could be used under OS/2 */
1973
1974 #if defined (_WIN32) || defined (__INTERIX) || defined (__EMX__) \
1975   || defined (__Lynx__) || defined(__NetBSD__) || defined(__FreeBSD__)
1976
1977 #define HAVE_GNAT_INIT_FLOAT
1978
1979 void
1980 __gnat_init_float (void)
1981 {
1982 #if defined (__i386__) || defined (i386)
1983
1984   /* This is used to properly initialize the FPU on an x86 for each
1985      process thread. */
1986
1987   asm ("finit");
1988
1989 #endif  /* Defined __i386__ */
1990 }
1991 #endif
1992
1993 #ifndef HAVE_GNAT_INIT_FLOAT
1994
1995 /* All targets without a specific __gnat_init_float will use an empty one */
1996 void
1997 __gnat_init_float (void)
1998 {
1999 }
2000 #endif