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
 115 /* Indication of whether synchronous signal handler has already been
 116    installed by a previous call to adainit */
 117 int  __gnat_handler_installed      = 0;
 118
 119 /* HAVE_GNAT_INIT_FLOAT must be set on every targets where a __gnat_init_float
 120    is defined. If this is not set them a void implementation will be defined
 121    at the end of this unit. */
 122 #undef HAVE_GNAT_INIT_FLOAT
 123
 124 /******************************/
 125 /* __gnat_get_interrupt_state */
 126 /******************************/
 127
 128 char __gnat_get_interrupt_state (int);
 129
 130 /* This routine is called from the runtime as needed to determine the state
 131    of an interrupt, as set by an Interrupt_State pragma appearing anywhere
 132    in the current partition. The input argument is the interrupt number,
 133    and the result is one of the following:
 134
 135        'n'   this interrupt not set by any Interrupt_State pragma
 136        'u'   Interrupt_State pragma set state to User
 137        'r'   Interrupt_State pragma set state to Runtime
 138        's'   Interrupt_State pragma set state to System */
 139
 140 char
 141 __gnat_get_interrupt_state (int intrup)
 142 {
 143   if (intrup >= __gl_num_interrupt_states)
 144     return 'n';
 145   else
 146     return __gl_interrupt_states [intrup];
 147 }
 148
 149 /**********************/
 150 /* __gnat_set_globals */
 151 /**********************/
 152
 153 /* This routine is called from the binder generated main program.  It copies
 154    the values for global quantities computed by the binder into the following
 155    global locations. The reason that we go through this copy, rather than just
 156    define the global locations in the binder generated file, is that they are
 157    referenced from the runtime, which may be in a shared library, and the
 158    binder file is not in the shared library. Global references across library
 159    boundaries like this are not handled correctly in all systems.  */
 160
 161 /* For detailed description of the parameters to this routine, see the
 162    section titled Run-Time Globals in package Bindgen (bindgen.adb) */
 163
 164 void
 165 __gnat_set_globals (int main_priority,
 166                     int time_slice_val,
 167                     char wc_encoding,
 168                     char locking_policy,
 169                     char queuing_policy,
 170                     char task_dispatching_policy,
 171                     char *restrictions,
 172                     char *interrupt_states,
 173                     int num_interrupt_states,
 174                     int unreserve_all_interrupts,
 175                     int exception_tracebacks,
 176                     int zero_cost_exceptions)
 177 {
 178   static int already_called = 0;
 179
 180   /* If this procedure has been already called once, check that the
 181      arguments in this call are consistent with the ones in the previous
 182      calls. Otherwise, raise a Program_Error exception.
 183
 184      We do not check for consistency of the wide character encoding
 185      method. This default affects only Wide_Text_IO where no explicit
 186      coding method is given, and there is no particular reason to let
 187      this default be affected by the source representation of a library
 188      in any case.
 189
 190      We do not check either for the consistency of exception tracebacks,
 191      because exception tracebacks are not normally set in Stand-Alone
 192      libraries. If a library or the main program set the exception
 193      tracebacks, then they are never reset afterwards (see below).
 194
 195      The value of main_priority is meaningful only when we are invoked
 196      from the main program elaboration routine of an Ada application.
 197      Checking the consistency of this parameter should therefore not be
 198      done. Since it is assured that the main program elaboration will
 199      always invoke this procedure before any library elaboration
 200      routine, only the value of main_priority during the first call
 201      should be taken into account and all the subsequent ones should be
 202      ignored. Note that the case where the main program is not written
 203      in Ada is also properly handled, since the default value will then
 204      be used for this parameter.
 205
 206      For identical reasons, the consistency of time_slice_val should not
 207      be checked. */
 208
 209   if (already_called)
 210     {
 211       if (__gl_locking_policy              != locking_policy
 212           || __gl_queuing_policy           != queuing_policy
 213           || __gl_task_dispatching_policy  != task_dispatching_policy
 214           || __gl_unreserve_all_interrupts != unreserve_all_interrupts
 215           || __gl_zero_cost_exceptions     != zero_cost_exceptions)
 216         __gnat_raise_program_error (__FILE__, __LINE__);
 217
 218       /* If either a library or the main program set the exception traceback
 219          flag, it is never reset later */
 220
 221       if (exception_tracebacks != 0)
 222          __gl_exception_tracebacks = exception_tracebacks;
 223
 224       return;
 225     }
 226   already_called = 1;
 227
 228   __gl_main_priority            = main_priority;
 229   __gl_time_slice_val           = time_slice_val;
 230   __gl_wc_encoding              = wc_encoding;
 231   __gl_locking_policy           = locking_policy;
 232   __gl_queuing_policy           = queuing_policy;
 233   __gl_restrictions             = restrictions;
 234   __gl_interrupt_states         = interrupt_states;
 235   __gl_num_interrupt_states     = num_interrupt_states;
 236   __gl_task_dispatching_policy  = task_dispatching_policy;
 237   __gl_unreserve_all_interrupts = unreserve_all_interrupts;
 238   __gl_exception_tracebacks     = exception_tracebacks;
 239
 240   /* ??? __gl_zero_cost_exceptions is new in 3.15 and is referenced from
 241      a-except.adb, which is also part of the compiler sources. Since the
 242      compiler is built with an older release of GNAT, the call generated by
 243      the old binder to this function does not provide any value for the
 244      corresponding argument, so the global has to be initialized in some
 245      reasonable other way. This could be removed as soon as the next major
 246      release is out.  */
 247
 248 #ifdef IN_RTS
 249   __gl_zero_cost_exceptions = zero_cost_exceptions;
 250 #else
 251   __gl_zero_cost_exceptions = 0;
 252   /* We never build the compiler to run in ZCX mode currently anyway.  */
 253 #endif
 254 }
 255
 256 /*********************/
 257 /* __gnat_initialize */
 258 /*********************/
 259
 260 /* __gnat_initialize is called at the start of execution of an Ada program
 261    (the call is generated by the binder). The standard routine does nothing
 262    at all; the intention is that this be replaced by system specific
 263    code where initialization is required. */
 264
 265 /***********************************/
 266 /* __gnat_initialize (AIX Version) */
 267 /***********************************/
 268
 269 #if defined (_AIX)
 270
 271 #include <signal.h>
 272 #include <sys/time.h>
 273
 274 /* Some versions of AIX don't define SA_NODEFER. */
 275
 276 #ifndef SA_NODEFER
 277 #define SA_NODEFER 0
 278 #endif /* SA_NODEFER */
 279
 280 /* Versions of AIX before 4.3 don't have nanosleep but provide
 281    nsleep instead. */
 282
 283 #ifndef _AIXVERSION_430
 284
 285 extern int nanosleep (struct timestruc_t *, struct timestruc_t *);
 286
 287 int
 288 nanosleep (struct timestruc_t *Rqtp, struct timestruc_t *Rmtp)
 289 {
 290   return nsleep (Rqtp, Rmtp);
 291 }
 292
 293 #endif /* _AIXVERSION_430 */
 294
 295 static void __gnat_error_handler (int);
 296
 297 static void
 298 __gnat_error_handler (int sig)
 299 {
 300   struct Exception_Data *exception;
 301   const char *msg;
 302
 303   switch (sig)
 304     {
 305     case SIGSEGV:
 306       /* FIXME: we need to detect the case of a *real* SIGSEGV */
 307       exception = &storage_error;
 308       msg = "stack overflow or erroneous memory access";
 309       break;
 310
 311     case SIGBUS:
 312       exception = &constraint_error;
 313       msg = "SIGBUS";
 314       break;
 315
 316     case SIGFPE:
 317       exception = &constraint_error;
 318       msg = "SIGFPE";
 319       break;
 320
 321     default:
 322       exception = &program_error;
 323       msg = "unhandled signal";
 324     }
 325
 326   Raise_From_Signal_Handler (exception, msg);
 327 }
 328
 329 void
 330 __gnat_install_handler (void)
 331 {
 332   struct sigaction act;
 333
 334   /* Set up signal handler to map synchronous signals to appropriate
 335      exceptions.  Make sure that the handler isn't interrupted by another
 336      signal that might cause a scheduling event! */
 337
 338   act.sa_handler = __gnat_error_handler;
 339   act.sa_flags = SA_NODEFER | SA_RESTART;
 340   sigemptyset (&act.sa_mask);
 341
 342   /* Do not install handlers if interrupt state is "System" */
 343   if (__gnat_get_interrupt_state (SIGABRT) != 's')
 344     sigaction (SIGABRT, &act, NULL);
 345   if (__gnat_get_interrupt_state (SIGFPE) != 's')
 346     sigaction (SIGFPE,  &act, NULL);
 347   if (__gnat_get_interrupt_state (SIGILL) != 's')
 348     sigaction (SIGILL,  &act, NULL);
 349   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 350     sigaction (SIGSEGV, &act, NULL);
 351   if (__gnat_get_interrupt_state (SIGBUS) != 's')
 352     sigaction (SIGBUS,  &act, NULL);
 353
 354   __gnat_handler_installed = 1;
 355 }
 356
 357 void
 358 __gnat_initialize (void)
 359 {
 360 }
 361
 362 /****************************************/
 363 /* __gnat_initialize (Dec Unix Version) */
 364 /****************************************/
 365
 366 #elif defined(__alpha__) && defined(__osf__) && ! defined(__alpha_vxworks)
 367
 368 /* Note: it seems that __osf__ is defined for the Alpha VXWorks case. Not
 369    clear that this is reasonable, but in any case we have to be sure to
 370    exclude this case in the above test.  */
 371
 372 #include <signal.h>
 373 #include <setjmp.h>
 374 #include <sys/siginfo.h>
 375
 376 static void __gnat_error_handler (int, siginfo_t *, struct sigcontext *);
 377 extern char *__gnat_get_code_loc (struct sigcontext *);
 378 extern void __gnat_enter_handler (struct sigcontext *, char *);
 379 extern size_t __gnat_machine_state_length (void);
 380
 381 extern long exc_lookup_gp (char *);
 382 extern void exc_resume (struct sigcontext *);
 383
 384 static void
 385 __gnat_error_handler (int sig, siginfo_t *sip, struct sigcontext *context)
 386 {
 387   struct Exception_Data *exception;
 388   static int recurse = 0;
 389   struct sigcontext *mstate;
 390   const char *msg;
 391   jmp_buf handler_jmpbuf;
 392
 393   /* If this was an explicit signal from a "kill", just resignal it.  */
 394   if (SI_FROMUSER (sip))
 395     {
 396       signal (sig, SIG_DFL);
 397       kill (getpid(), sig);
 398     }
 399
 400   /* Otherwise, treat it as something we handle.  */
 401
 402   /* We are now going to raise the exception corresponding to the signal we
 403      caught, which may eventually end up resuming the application code if the
 404      exception is handled.
 405
 406      When the exception is handled, merely arranging for the *exception*
 407      handler's context (stack pointer, program counter, other registers, ...)
 408      to be installed is *not* enough to let the kernel think we've left the
 409      *signal* handler.  This has annoying implications if an alternate stack
 410      has been setup for this *signal* handler, because the kernel thinks we
 411      are still running on that alternate stack even after the jump, which
 412      causes trouble at least as soon as another signal is raised.
 413
 414      We deal with this by forcing a "local" longjmp within the signal handler
 415      below, forcing the "on alternate stack" indication to be reset (kernel
 416      wise) on the way.  If no alternate stack has been setup, this should be a
 417      neutral operation. Otherwise, we will be in a delicate situation for a
 418      short while because we are going to run the exception propagation code
 419      within the alternate stack area (that is, with the stack pointer inside
 420      the alternate stack bounds), but with the corresponding flag off from the
 421      kernel's standpoint.  We expect this to be ok as long as the propagation
 422      code does not trigger a signal itself, which is expected.
 423
 424      ??? A better approach would be to at least delay this operation until the
 425      last second, that is, until just before we jump to the exception handler,
 426      if any.  */
 427
 428   if (setjmp (handler_jmpbuf) == 0)
 429     {
 430 #define JB_ONSIGSTK 0
 431
 432       /* Arrange for the "on alternate stack" flag to be reset.  See the
 433          comments around "jmp_buf offsets" in /usr/include/setjmp.h.  */
 434       handler_jmpbuf [JB_ONSIGSTK] = 0;
 435       longjmp (handler_jmpbuf, 1);
 436     }
 437
 438   switch (sig)
 439     {
 440     case SIGSEGV:
 441       /* If the problem was permissions, this is a constraint error.
 442          Likewise if the failing address isn't maximally aligned or if
 443          we've recursed.
 444
 445          ??? Using a static variable here isn't task-safe, but it's
 446          much too hard to do anything else and we're just determining
 447          which exception to raise.  */
 448       if (sip->si_code == SEGV_ACCERR
 449           || (((long) sip->si_addr) & 3) != 0
 450           || recurse)
 451         {
 452           exception = &constraint_error;
 453           msg = "SIGSEGV";
 454         }
 455       else
 456         {
 457           /* See if the page before the faulting page is accessible.  Do that
 458              by trying to access it.  We'd like to simply try to access
 459              4096 + the faulting address, but it's not guaranteed to be
 460              the actual address, just to be on the same page.  */
 461           recurse++;
 462           ((volatile char *)
 463            ((long) sip->si_addr & - getpagesize ()))[getpagesize ()];
 464           msg = "stack overflow (or erroneous memory access)";
 465           exception = &storage_error;
 466         }
 467       break;
 468
 469     case SIGBUS:
 470       exception = &program_error;
 471       msg = "SIGBUS";
 472       break;
 473
 474     case SIGFPE:
 475       exception = &constraint_error;
 476       msg = "SIGFPE";
 477       break;
 478
 479     default:
 480       exception = &program_error;
 481       msg = "unhandled signal";
 482     }
 483
 484   recurse = 0;
 485   mstate = (struct sigcontext *) (*Get_Machine_State_Addr) ();
 486   if (mstate != 0)
 487     *mstate = *context;
 488
 489   Raise_From_Signal_Handler (exception, (char *) msg);
 490 }
 491
 492 void
 493 __gnat_install_handler (void)
 494 {
 495   struct sigaction act;
 496
 497   /* stack-checking on this platform is performed by the back-end and conforms
 498      to what the ABI *mandates* (DEC OSF/1 Calling standard for AXP systems,
 499      chapter 6: Stack Limits in Multihtreaded Execution Environments).  This
 500      does not include a "stack reserve" region, so nothing guarantees that
 501      enough room remains on the current stack to propagate an exception when
 502      a stack-overflow is signaled.  We deal with this by requesting the use of
 503      an alternate stack region for signal handlers.
 504
 505      ??? The actual use of this alternate region depends on the act.sa_flags
 506      including SA_ONSTACK below.  Care should be taken to update s-intman if
 507      we want this to happen for tasks also.  */
 508
 509   static char sig_stack [8*1024];
 510   /* 8K is a mininum to be able to propagate an exception using the GCC/ZCX
 511      scheme.  */
 512
 513   struct sigaltstack ss;
 514
 515   ss.ss_sp = (void *) sig_stack;
 516   ss.ss_size = sizeof (sig_stack);
 517   ss.ss_flags = 0;
 518
 519   sigaltstack (&ss, 0);
 520
 521   /* Setup signal handler to map synchronous signals to appropriate
 522      exceptions. Make sure that the handler isn't interrupted by another
 523      signal that might cause a scheduling event! */
 524
 525   act.sa_handler = (void (*) (int)) __gnat_error_handler;
 526   act.sa_flags = SA_ONSTACK | SA_RESTART | SA_NODEFER | SA_SIGINFO;
 527   sigemptyset (&act.sa_mask);
 528
 529   /* Do not install handlers if interrupt state is "System" */
 530   if (__gnat_get_interrupt_state (SIGABRT) != 's')
 531     sigaction (SIGABRT, &act, NULL);
 532   if (__gnat_get_interrupt_state (SIGFPE) != 's')
 533     sigaction (SIGFPE,  &act, NULL);
 534   if (__gnat_get_interrupt_state (SIGILL) != 's')
 535     sigaction (SIGILL,  &act, NULL);
 536   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 537     sigaction (SIGSEGV, &act, NULL);
 538   if (__gnat_get_interrupt_state (SIGBUS) != 's')
 539     sigaction (SIGBUS,  &act, NULL);
 540
 541   __gnat_handler_installed = 1;
 542 }
 543
 544 void
 545 __gnat_initialize (void)
 546 {
 547 }
 548
 549 /* Routines called by 5amastop.adb.  */
 550
 551 #define SC_GP 29
 552
 553 char *
 554 __gnat_get_code_loc (struct sigcontext *context)
 555 {
 556   return (char *) context->sc_pc;
 557 }
 558
 559 void
 560 __gnat_enter_handler ( struct sigcontext *context, char *pc)
 561 {
 562   context->sc_pc = (long) pc;
 563   context->sc_regs[SC_GP] = exc_lookup_gp (pc);
 564   exc_resume (context);
 565 }
 566
 567 size_t
 568 __gnat_machine_state_length (void)
 569 {
 570   return sizeof (struct sigcontext);
 571 }
 572
 573 /************************************/
 574 /* __gnat_initialize (HPUX Version) */
 575 /************************************/
 576
 577 #elif defined (hpux)
 578
 579 #include <signal.h>
 580
 581 static void __gnat_error_handler (int);
 582
 583 static void
 584 __gnat_error_handler (int sig)
 585 {
 586   struct Exception_Data *exception;
 587   char *msg;
 588
 589   switch (sig)
 590     {
 591     case SIGSEGV:
 592       /* FIXME: we need to detect the case of a *real* SIGSEGV */
 593       exception = &storage_error;
 594       msg = "stack overflow or erroneous memory access";
 595       break;
 596
 597     case SIGBUS:
 598       exception = &constraint_error;
 599       msg = "SIGBUS";
 600       break;
 601
 602     case SIGFPE:
 603       exception = &constraint_error;
 604       msg = "SIGFPE";
 605       break;
 606
 607     default:
 608       exception = &program_error;
 609       msg = "unhandled signal";
 610     }
 611
 612   Raise_From_Signal_Handler (exception, msg);
 613 }
 614
 615 void
 616 __gnat_install_handler (void)
 617 {
 618   struct sigaction act;
 619
 620   /* Set up signal handler to map synchronous signals to appropriate
 621      exceptions.  Make sure that the handler isn't interrupted by another
 622      signal that might cause a scheduling event! Also setup an alternate
 623      stack region for the handler execution so that stack overflows can be
 624      handled properly, avoiding a SEGV generation from stack usage by the
 625      handler itself. */
 626
 627   static char handler_stack[SIGSTKSZ*2];
 628   /* SIGSTKSZ appeared to be "short" for the needs in some contexts
 629      (e.g. experiments with GCC ZCX exceptions).  */
 630
 631   stack_t stack;
 632
 633   stack.ss_sp    = handler_stack;
 634   stack.ss_size  = sizeof (handler_stack);
 635   stack.ss_flags = 0;
 636
 637   sigaltstack (&stack, NULL);
 638
 639   act.sa_handler = __gnat_error_handler;
 640   act.sa_flags = SA_NODEFER | SA_RESTART | SA_ONSTACK;
 641   sigemptyset (&act.sa_mask);
 642
 643   /* Do not install handlers if interrupt state is "System" */
 644   if (__gnat_get_interrupt_state (SIGABRT) != 's')
 645     sigaction (SIGABRT, &act, NULL);
 646   if (__gnat_get_interrupt_state (SIGFPE) != 's')
 647     sigaction (SIGFPE,  &act, NULL);
 648   if (__gnat_get_interrupt_state (SIGILL) != 's')
 649     sigaction (SIGILL,  &act, NULL);
 650   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 651     sigaction (SIGSEGV, &act, NULL);
 652   if (__gnat_get_interrupt_state (SIGBUS) != 's')
 653     sigaction (SIGBUS,  &act, NULL);
 654
 655   __gnat_handler_installed = 1;
 656 }
 657
 658 void
 659 __gnat_initialize (void)
 660 {
 661 }
 662
 663 /*****************************************/
 664 /* __gnat_initialize (GNU/Linux Version) */
 665 /*****************************************/
 666
 667 #elif defined (linux) && defined (i386) && !defined (__RT__)
 668
 669 #include <signal.h>
 670 #include <asm/sigcontext.h>
 671
 672 /* GNU/Linux, which uses glibc, does not define NULL in included
 673    header files */
 674
 675 #if !defined (NULL)
 676 #define NULL ((void *) 0)
 677 #endif
 678
 679 struct Machine_State
 680 {
 681   unsigned long eip;
 682   unsigned long ebx;
 683   unsigned long esp;
 684   unsigned long ebp;
 685   unsigned long esi;
 686   unsigned long edi;
 687 };
 688
 689 static void __gnat_error_handler (int);
 690
 691 static void
 692 __gnat_error_handler (int sig)
 693 {
 694   struct Exception_Data *exception;
 695   const char *msg;
 696   static int recurse = 0;
 697
 698   struct sigcontext *info
 699     = (struct sigcontext *) (((char *) &sig) + sizeof (int));
 700
 701   /* The Linux kernel does not document how to get the machine state in a
 702      signal handler, but in fact the necessary data is in a sigcontext_struct
 703      value that is on the stack immediately above the signal number
 704      parameter, and the above messing accesses this value on the stack. */
 705
 706   struct Machine_State *mstate;
 707
 708   switch (sig)
 709     {
 710     case SIGSEGV:
 711       /* If the problem was permissions, this is a constraint error.
 712        Likewise if the failing address isn't maximally aligned or if
 713        we've recursed.
 714
 715        ??? Using a static variable here isn't task-safe, but it's
 716        much too hard to do anything else and we're just determining
 717        which exception to raise.  */
 718       if (recurse)
 719       {
 720         exception = &constraint_error;
 721         msg = "SIGSEGV";
 722       }
 723       else
 724       {
 725         /* Here we would like a discrimination test to see whether the
 726            page before the faulting address is accessible. Unfortunately
 727            Linux seems to have no way of giving us the faulting address.
 728
 729            In versions of a-init.c before 1.95, we had a test of the page
 730            before the stack pointer using:
 731
 732             recurse++;
 733              ((volatile char *)
 734               ((long) info->esp_at_signal & - getpagesize ()))[getpagesize ()];
 735
 736            but that's wrong, since it tests the stack pointer location, and
 737            the current stack probe code does not move the stack pointer
 738            until all probes succeed.
 739
 740            For now we simply do not attempt any discrimination at all. Note
 741            that this is quite acceptable, since a "real" SIGSEGV can only
 742            occur as the result of an erroneous program */
 743
 744         msg = "stack overflow (or erroneous memory access)";
 745         exception = &storage_error;
 746       }
 747       break;
 748
 749     case SIGBUS:
 750       exception = &constraint_error;
 751       msg = "SIGBUS";
 752       break;
 753
 754     case SIGFPE:
 755       exception = &constraint_error;
 756       msg = "SIGFPE";
 757       break;
 758
 759     default:
 760       exception = &program_error;
 761       msg = "unhandled signal";
 762     }
 763
 764   mstate = (*Get_Machine_State_Addr) ();
 765   if (mstate)
 766     {
 767       mstate->eip = info->eip;
 768       mstate->ebx = info->ebx;
 769       mstate->esp = info->esp_at_signal;
 770       mstate->ebp = info->ebp;
 771       mstate->esi = info->esi;
 772       mstate->edi = info->edi;
 773     }
 774
 775   recurse = 0;
 776   Raise_From_Signal_Handler (exception, msg);
 777 }
 778
 779 void
 780 __gnat_install_handler (void)
 781 {
 782   struct sigaction act;
 783
 784   /* Set up signal handler to map synchronous signals to appropriate
 785      exceptions.  Make sure that the handler isn't interrupted by another
 786      signal that might cause a scheduling event! */
 787
 788   act.sa_handler = __gnat_error_handler;
 789   act.sa_flags = SA_NODEFER | SA_RESTART;
 790   sigemptyset (&act.sa_mask);
 791
 792   /* Do not install handlers if interrupt state is "System" */
 793   if (__gnat_get_interrupt_state (SIGABRT) != 's')
 794     sigaction (SIGABRT, &act, NULL);
 795   if (__gnat_get_interrupt_state (SIGFPE) != 's')
 796     sigaction (SIGFPE,  &act, NULL);
 797   if (__gnat_get_interrupt_state (SIGILL) != 's')
 798     sigaction (SIGILL,  &act, NULL);
 799   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 800     sigaction (SIGSEGV, &act, NULL);
 801   if (__gnat_get_interrupt_state (SIGBUS) != 's')
 802     sigaction (SIGBUS,  &act, NULL);
 803
 804   __gnat_handler_installed = 1;
 805 }
 806
 807 void
 808 __gnat_initialize (void)
 809 {
 810 }
 811
 812 /******************************************/
 813 /* __gnat_initialize (NT-mingw32 Version) */
 814 /******************************************/
 815
 816 #elif defined (__MINGW32__)
 817 #include <windows.h>
 818
 819 static LONG WINAPI __gnat_error_handler (PEXCEPTION_POINTERS);
 820
 821 /* __gnat_initialize (mingw32).  */
 822
 823 static LONG WINAPI
 824 __gnat_error_handler (PEXCEPTION_POINTERS info)
 825 {
 826   static int recurse;
 827   struct Exception_Data *exception;
 828   const char *msg;
 829
 830   switch (info->ExceptionRecord->ExceptionCode)
 831     {
 832     case EXCEPTION_ACCESS_VIOLATION:
 833       /* If the failing address isn't maximally-aligned or if we've
 834          recursed, this is a program error.  */
 835       if ((info->ExceptionRecord->ExceptionInformation[1] & 3) != 0
 836           || recurse)
 837         {
 838           exception = &program_error;
 839           msg = "EXCEPTION_ACCESS_VIOLATION";
 840         }
 841       else
 842         {
 843           /* See if the page before the faulting page is accessible.  Do that
 844              by trying to access it. */
 845           recurse++;
 846           * ((volatile char *) (info->ExceptionRecord->ExceptionInformation[1]
 847                                 + 4096));
 848           exception = &storage_error;
 849           msg = "stack overflow (or erroneous memory access)";
 850         }
 851       break;
 852
 853     case EXCEPTION_ARRAY_BOUNDS_EXCEEDED:
 854       exception = &constraint_error;
 855       msg = "EXCEPTION_ARRAY_BOUNDS_EXCEEDED";
 856       break;
 857
 858     case EXCEPTION_DATATYPE_MISALIGNMENT:
 859       exception = &constraint_error;
 860       msg = "EXCEPTION_DATATYPE_MISALIGNMENT";
 861       break;
 862
 863     case EXCEPTION_FLT_DENORMAL_OPERAND:
 864       exception = &constraint_error;
 865       msg = "EXCEPTION_FLT_DENORMAL_OPERAND";
 866       break;
 867
 868     case EXCEPTION_FLT_DIVIDE_BY_ZERO:
 869       exception = &constraint_error;
 870       msg = "EXCEPTION_FLT_DENORMAL_OPERAND";
 871       break;
 872
 873     case EXCEPTION_FLT_INVALID_OPERATION:
 874       exception = &constraint_error;
 875       msg = "EXCEPTION_FLT_INVALID_OPERATION";
 876       break;
 877
 878     case EXCEPTION_FLT_OVERFLOW:
 879       exception = &constraint_error;
 880       msg = "EXCEPTION_FLT_OVERFLOW";
 881       break;
 882
 883     case EXCEPTION_FLT_STACK_CHECK:
 884       exception = &program_error;
 885       msg = "EXCEPTION_FLT_STACK_CHECK";
 886       break;
 887
 888     case EXCEPTION_FLT_UNDERFLOW:
 889       exception = &constraint_error;
 890       msg = "EXCEPTION_FLT_UNDERFLOW";
 891       break;
 892
 893     case EXCEPTION_INT_DIVIDE_BY_ZERO:
 894       exception = &constraint_error;
 895       msg = "EXCEPTION_INT_DIVIDE_BY_ZERO";
 896       break;
 897
 898     case EXCEPTION_INT_OVERFLOW:
 899       exception = &constraint_error;
 900       msg = "EXCEPTION_INT_OVERFLOW";
 901       break;
 902
 903     case EXCEPTION_INVALID_DISPOSITION:
 904       exception = &program_error;
 905       msg = "EXCEPTION_INVALID_DISPOSITION";
 906       break;
 907
 908     case EXCEPTION_NONCONTINUABLE_EXCEPTION:
 909       exception = &program_error;
 910       msg = "EXCEPTION_NONCONTINUABLE_EXCEPTION";
 911       break;
 912
 913     case EXCEPTION_PRIV_INSTRUCTION:
 914       exception = &program_error;
 915       msg = "EXCEPTION_PRIV_INSTRUCTION";
 916       break;
 917
 918     case EXCEPTION_SINGLE_STEP:
 919       exception = &program_error;
 920       msg = "EXCEPTION_SINGLE_STEP";
 921       break;
 922
 923     case EXCEPTION_STACK_OVERFLOW:
 924       exception = &storage_error;
 925       msg = "EXCEPTION_STACK_OVERFLOW";
 926       break;
 927
 928    default:
 929       exception = &program_error;
 930       msg = "unhandled signal";
 931     }
 932
 933   recurse = 0;
 934   Raise_From_Signal_Handler (exception, msg);
 935   return 0; /* This is never reached, avoid compiler warning */
 936 }
 937
 938 void
 939 __gnat_install_handler (void)
 940 {
 941   SetUnhandledExceptionFilter (__gnat_error_handler);
 942   __gnat_handler_installed = 1;
 943 }
 944
 945 void
 946 __gnat_initialize (void)
 947 {
 948
 949    /* Initialize floating-point coprocessor. This call is needed because
 950       the MS libraries default to 64-bit precision instead of 80-bit
 951       precision, and we require the full precision for proper operation,
 952       given that we have set Max_Digits etc with this in mind */
 953
 954    __gnat_init_float ();
 955
 956    /* initialize a lock for a process handle list - see a-adaint.c for the
 957       implementation of __gnat_portable_no_block_spawn, __gnat_portable_wait */
 958    __gnat_plist_init();
 959 }
 960
 961 /***************************************/
 962 /* __gnat_initialize (Interix Version) */
 963 /***************************************/
 964
 965 #elif defined (__INTERIX)
 966
 967 #include <signal.h>
 968
 969 static void __gnat_error_handler (int);
 970
 971 static void
 972 __gnat_error_handler (int sig)
 973 {
 974   struct Exception_Data *exception;
 975   char *msg;
 976
 977   switch (sig)
 978     {
 979     case SIGSEGV:
 980       exception = &storage_error;
 981       msg = "stack overflow or erroneous memory access";
 982       break;
 983
 984     case SIGBUS:
 985       exception = &constraint_error;
 986       msg = "SIGBUS";
 987       break;
 988
 989     case SIGFPE:
 990       exception = &constraint_error;
 991       msg = "SIGFPE";
 992       break;
 993
 994     default:
 995       exception = &program_error;
 996       msg = "unhandled signal";
 997     }
 998
 999   Raise_From_Signal_Handler (exception, msg);
1000 }
1001
1002 void
1003 __gnat_install_handler (void)
1004 {
1005   struct sigaction act;
1006
1007   /* Set up signal handler to map synchronous signals to appropriate
1008      exceptions.  Make sure that the handler isn't interrupted by another
1009      signal that might cause a scheduling event! */
1010
1011   act.sa_handler = __gnat_error_handler;
1012   act.sa_flags = 0;
1013   sigemptyset (&act.sa_mask);
1014
1015   /* Handlers for signals besides SIGSEGV cause c974013 to hang */
1016 /*  sigaction (SIGILL,  &act, NULL); */
1017 /*  sigaction (SIGABRT, &act, NULL); */
1018 /*  sigaction (SIGFPE,  &act, NULL); */
1019 /*  sigaction (SIGBUS,  &act, NULL); */
1020
1021   /* Do not install handlers if interrupt state is "System" */
1022   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1023     sigaction (SIGSEGV, &act, NULL);
1024
1025   __gnat_handler_installed = 1;
1026 }
1027
1028 void
1029 __gnat_initialize (void)
1030 {
1031    __gnat_init_float ();
1032 }
1033
1034 /**************************************/
1035 /* __gnat_initialize (LynxOS Version) */
1036 /**************************************/
1037
1038 #elif defined (__Lynx__)
1039
1040 void
1041 __gnat_initialize (void)
1042 {
1043    __gnat_init_float ();
1044 }
1045
1046 /*********************************/
1047 /* __gnat_install_handler (Lynx) */
1048 /*********************************/
1049
1050 void
1051 __gnat_install_handler (void)
1052 {
1053   __gnat_handler_installed = 1;
1054 }
1055
1056 /****************************/
1057 /* __gnat_initialize (OS/2) */
1058 /****************************/
1059
1060 #elif defined (__EMX__) /* OS/2 dependent initialization */
1061
1062 void
1063 __gnat_initialize (void)
1064 {
1065 }
1066
1067 /*********************************/
1068 /* __gnat_install_handler (OS/2) */
1069 /*********************************/
1070
1071 void
1072 __gnat_install_handler (void)
1073 {
1074   __gnat_handler_installed = 1;
1075 }
1076
1077 /***********************************/
1078 /* __gnat_initialize (SGI Version) */
1079 /***********************************/
1080
1081 #elif defined (sgi)
1082
1083 #include <signal.h>
1084 #include <siginfo.h>
1085
1086 #ifndef NULL
1087 #define NULL 0
1088 #endif
1089
1090 #define SIGADAABORT 48
1091 #define SIGNAL_STACK_SIZE 4096
1092 #define SIGNAL_STACK_ALIGNMENT 64
1093
1094 struct Machine_State
1095 {
1096   sigcontext_t context;
1097 };
1098
1099 static void __gnat_error_handler (int, int, sigcontext_t *);
1100
1101 static void
1102 __gnat_error_handler (int sig, int code, sigcontext_t *sc)
1103 {
1104   struct Machine_State  *mstate;
1105   struct Exception_Data *exception;
1106   const char *msg;
1107
1108   switch (sig)
1109     {
1110     case SIGSEGV:
1111       if (code == EFAULT)
1112         {
1113           exception = &program_error;
1114           msg = "SIGSEGV: (Invalid virtual address)";
1115         }
1116       else if (code == ENXIO)
1117         {
1118           exception = &program_error;
1119           msg = "SIGSEGV: (Read beyond mapped object)";
1120         }
1121       else if (code == ENOSPC)
1122         {
1123           exception = &program_error; /* ??? storage_error ??? */
1124           msg = "SIGSEGV: (Autogrow for file failed)";
1125         }
1126       else if (code == EACCES)
1127         {
1128           /* ??? Re-add smarts to further verify that we launched
1129                  the stack into a guard page, not an attempt to
1130                  write to .text or something */
1131           exception = &storage_error;
1132           msg = "SIGSEGV: (stack overflow or erroneous memory access)";
1133         }
1134       else
1135         {
1136           /* Just in case the OS guys did it to us again.  Sometimes
1137              they fail to document all of the valid codes that are
1138              passed to signal handlers, just in case someone depends
1139              on knowing all the codes */
1140           exception = &program_error;
1141           msg = "SIGSEGV: (Undocumented reason)";
1142         }
1143       break;
1144
1145     case SIGBUS:
1146       /* Map all bus errors to Program_Error.  */
1147       exception = &program_error;
1148       msg = "SIGBUS";
1149       break;
1150
1151     case SIGFPE:
1152       /* Map all fpe errors to Constraint_Error.  */
1153       exception = &constraint_error;
1154       msg = "SIGFPE";
1155       break;
1156
1157     case SIGADAABORT:
1158       if ((*Check_Abort_Status) ())
1159         {
1160           exception = &_abort_signal;
1161           msg = "";
1162         }
1163       else
1164         return;
1165
1166       break;
1167
1168     default:
1169       /* Everything else is a Program_Error. */
1170       exception = &program_error;
1171       msg = "unhandled signal";
1172     }
1173
1174   mstate = (*Get_Machine_State_Addr) ();
1175   if (mstate != 0)
1176     memcpy ((void *) mstate, (const void *) sc, sizeof (sigcontext_t));
1177
1178   Raise_From_Signal_Handler (exception, msg);
1179 }
1180
1181 void
1182 __gnat_install_handler (void)
1183 {
1184   struct sigaction act;
1185
1186   /* Setup signal handler to map synchronous signals to appropriate
1187      exceptions.  Make sure that the handler isn't interrupted by another
1188      signal that might cause a scheduling event! */
1189
1190   act.sa_handler = __gnat_error_handler;
1191   act.sa_flags = SA_NODEFER + SA_RESTART;
1192   sigfillset (&act.sa_mask);
1193   sigemptyset (&act.sa_mask);
1194
1195   /* Do not install handlers if interrupt state is "System" */
1196   if (__gnat_get_interrupt_state (SIGABRT) != 's')
1197     sigaction (SIGABRT, &act, NULL);
1198   if (__gnat_get_interrupt_state (SIGFPE) != 's')
1199     sigaction (SIGFPE,  &act, NULL);
1200   if (__gnat_get_interrupt_state (SIGILL) != 's')
1201     sigaction (SIGILL,  &act, NULL);
1202   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1203     sigaction (SIGSEGV, &act, NULL);
1204   if (__gnat_get_interrupt_state (SIGBUS) != 's')
1205     sigaction (SIGBUS,  &act, NULL);
1206   if (__gnat_get_interrupt_state (SIGADAABORT) != 's')
1207     sigaction (SIGADAABORT,  &act, NULL);
1208
1209   __gnat_handler_installed = 1;
1210 }
1211
1212 void
1213 __gnat_initialize (void)
1214 {
1215 }
1216
1217 /*************************************************/
1218 /* __gnat_initialize (Solaris and SunOS Version) */
1219 /*************************************************/
1220
1221 #elif defined (sun) && defined (__SVR4) && !defined (__vxworks)
1222
1223 #include <signal.h>
1224 #include <siginfo.h>
1225
1226 static void __gnat_error_handler (int, siginfo_t *);
1227
1228 static void
1229 __gnat_error_handler (int sig, siginfo_t *sip)
1230 {
1231   struct Exception_Data *exception;
1232   static int recurse = 0;
1233   const char *msg;
1234
1235   /* If this was an explicit signal from a "kill", just resignal it.  */
1236   if (SI_FROMUSER (sip))
1237     {
1238       signal (sig, SIG_DFL);
1239       kill (getpid(), sig);
1240     }
1241
1242   /* Otherwise, treat it as something we handle.  */
1243   switch (sig)
1244     {
1245     case SIGSEGV:
1246       /* If the problem was permissions, this is a constraint error.
1247          Likewise if the failing address isn't maximally aligned or if
1248          we've recursed.
1249
1250          ??? Using a static variable here isn't task-safe, but it's
1251          much too hard to do anything else and we're just determining
1252          which exception to raise.  */
1253       if (sip->si_code == SEGV_ACCERR
1254           || (((long) sip->si_addr) & 3) != 0
1255           || recurse)
1256         {
1257           exception = &constraint_error;
1258           msg = "SIGSEGV";
1259         }
1260       else
1261         {
1262           /* See if the page before the faulting page is accessible.  Do that
1263              by trying to access it.  We'd like to simply try to access
1264              4096 + the faulting address, but it's not guaranteed to be
1265              the actual address, just to be on the same page.  */
1266           recurse++;
1267           ((volatile char *)
1268            ((long) sip->si_addr & - getpagesize ()))[getpagesize ()];
1269           exception = &storage_error;
1270           msg = "stack overflow (or erroneous memory access)";
1271         }
1272       break;
1273
1274     case SIGBUS:
1275       exception = &program_error;
1276       msg = "SIGBUS";
1277       break;
1278
1279     case SIGFPE:
1280       exception = &constraint_error;
1281       msg = "SIGFPE";
1282       break;
1283
1284     default:
1285       exception = &program_error;
1286       msg = "unhandled signal";
1287     }
1288
1289   recurse = 0;
1290
1291   Raise_From_Signal_Handler (exception, msg);
1292 }
1293
1294 void
1295 __gnat_install_handler (void)
1296 {
1297   struct sigaction act;
1298
1299   /* Set up signal handler to map synchronous signals to appropriate
1300      exceptions.  Make sure that the handler isn't interrupted by another
1301      signal that might cause a scheduling event! */
1302
1303   act.sa_handler = __gnat_error_handler;
1304   act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
1305   sigemptyset (&act.sa_mask);
1306
1307   /* Do not install handlers if interrupt state is "System" */
1308   if (__gnat_get_interrupt_state (SIGABRT) != 's')
1309     sigaction (SIGABRT, &act, NULL);
1310   if (__gnat_get_interrupt_state (SIGFPE) != 's')
1311     sigaction (SIGFPE,  &act, NULL);
1312   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1313     sigaction (SIGSEGV, &act, NULL);
1314   if (__gnat_get_interrupt_state (SIGBUS) != 's')
1315     sigaction (SIGBUS,  &act, NULL);
1316
1317   __gnat_handler_installed = 1;
1318 }
1319
1320 void
1321 __gnat_initialize (void)
1322 {
1323 }
1324
1325 /***********************************/
1326 /* __gnat_initialize (VMS Version) */
1327 /***********************************/
1328
1329 #elif defined (VMS)
1330
1331 /* The prehandler actually gets control first on a condition. It swaps the
1332    stack pointer and calls the handler (__gnat_error_handler). */
1333 extern long __gnat_error_prehandler (void);
1334
1335 extern char *__gnat_error_prehandler_stack;   /* Alternate signal stack */
1336
1337 /* Conditions that don't have an Ada exception counterpart must raise
1338    Non_Ada_Error.  Since this is defined in s-auxdec, it should only be
1339    referenced by user programs, not the compiler or tools. Hence the
1340    #ifdef IN_RTS. */
1341
1342 #ifdef IN_RTS
1343 #define Non_Ada_Error system__aux_dec__non_ada_error
1344 extern struct Exception_Data Non_Ada_Error;
1345
1346 #define Coded_Exception system__vms_exception_table__coded_exception
1347 extern struct Exception_Data *Coded_Exception (int);
1348 #endif
1349
1350 /* Define macro symbols for the VMS conditions that become Ada exceptions.
1351    Most of these are also defined in the header file ssdef.h which has not
1352    yet been converted to be recoginized by Gnu C. Some, which couldn't be
1353    located, are assigned names based on the DEC test suite tests which
1354    raise them. */
1355
1356 #define SS$_ACCVIO            12
1357 #define SS$_DEBUG           1132
1358 #define SS$_INTDIV          1156
1359 #define SS$_HPARITH         1284
1360 #define SS$_STKOVF          1364
1361 #define SS$_RESIGNAL        2328
1362 #define MTH$_FLOOVEMAT   1475268       /* Some ACVC_21 CXA tests */
1363 #define SS$_CE24VRU      3253636       /* Write to unopened file */
1364 #define SS$_C980VTE      3246436       /* AST requests time slice */
1365 #define CMA$_EXIT_THREAD 4227492
1366 #define CMA$_EXCCOPLOS   4228108
1367 #define CMA$_ALERTED     4227460
1368
1369 struct descriptor_s {unsigned short len, mbz; char *adr; };
1370
1371 long __gnat_error_handler (int *, void *);
1372
1373 long
1374 __gnat_error_handler (int *sigargs, void *mechargs)
1375 {
1376   struct Exception_Data *exception = 0;
1377   char *msg = "";
1378   char message[256];
1379   long prvhnd;
1380   struct descriptor_s msgdesc;
1381   int msg_flag = 0x000f; /* 1 bit for each of the four message parts */
1382   unsigned short outlen;
1383   char curr_icb[544];
1384   long curr_invo_handle;
1385   long *mstate;
1386
1387   /* Resignaled condtions aren't effected by by pragma Import_Exception */
1388
1389   switch (sigargs[1])
1390   {
1391
1392     case CMA$_EXIT_THREAD:
1393       return SS$_RESIGNAL;
1394
1395     case SS$_DEBUG: /* Gdb attach, resignal to merge activate gdbstub. */
1396       return SS$_RESIGNAL;
1397
1398     case 1409786: /* Nickerson bug #33 ??? */
1399       return SS$_RESIGNAL;
1400
1401     case 1381050: /* Nickerson bug #33 ??? */
1402       return SS$_RESIGNAL;
1403
1404     case 11829410: /* Resignalled as Use_Error for CE10VRC */
1405       return SS$_RESIGNAL;
1406
1407   }
1408
1409 #ifdef IN_RTS
1410   /* See if it's an imported exception. Mask off severity bits. */
1411   exception = Coded_Exception (sigargs[1] & 0xfffffff8);
1412   if (exception)
1413     {
1414       msgdesc.len = 256;
1415       msgdesc.mbz = 0;
1416       msgdesc.adr = message;
1417       SYS$GETMSG (sigargs[1], &outlen, &msgdesc, msg_flag, 0);
1418       message[outlen] = 0;
1419       msg = message;
1420
1421       exception->Name_Length = 19;
1422       /* The full name really should be get sys$getmsg returns. ??? */
1423       exception->Full_Name = "IMPORTED_EXCEPTION";
1424       exception->Import_Code = sigargs[1] & 0xfffffff8;
1425     }
1426 #endif
1427
1428   if (exception == 0)
1429     switch (sigargs[1])
1430       {
1431       case SS$_ACCVIO:
1432         if (sigargs[3] == 0)
1433           {
1434             exception = &constraint_error;
1435             msg = "access zero";
1436           }
1437         else
1438           {
1439             exception = &storage_error;
1440             msg = "stack overflow (or erroneous memory access)";
1441           }
1442         break;
1443
1444       case SS$_STKOVF:
1445         exception = &storage_error;
1446         msg = "stack overflow";
1447         break;
1448
1449       case SS$_INTDIV:
1450         exception = &constraint_error;
1451         msg = "division by zero";
1452         break;
1453
1454       case SS$_HPARITH:
1455 #ifndef IN_RTS
1456         return SS$_RESIGNAL; /* toplev.c handles for compiler */
1457 #else
1458         {
1459           exception = &constraint_error;
1460           msg = "arithmetic error";
1461         }
1462 #endif
1463         break;
1464
1465       case MTH$_FLOOVEMAT:
1466         exception = &constraint_error;
1467         msg = "floating overflow in math library";
1468         break;
1469
1470       case SS$_CE24VRU:
1471         exception = &constraint_error;
1472         msg = "";
1473         break;
1474
1475       case SS$_C980VTE:
1476         exception = &program_error;
1477         msg = "";
1478         break;
1479
1480       default:
1481 #ifndef IN_RTS
1482         exception = &program_error;
1483 #else
1484         /* User programs expect Non_Ada_Error to be raised, reference
1485            DEC Ada test CXCONDHAN. */
1486         exception = &Non_Ada_Error;
1487 #endif
1488         msgdesc.len = 256;
1489         msgdesc.mbz = 0;
1490         msgdesc.adr = message;
1491         SYS$GETMSG (sigargs[1], &outlen, &msgdesc, msg_flag, 0);
1492         message[outlen] = 0;
1493         msg = message;
1494         break;
1495       }
1496
1497   mstate = (long *) (*Get_Machine_State_Addr) ();
1498   if (mstate != 0)
1499     {
1500       LIB$GET_CURR_INVO_CONTEXT (&curr_icb);
1501       LIB$GET_PREV_INVO_CONTEXT (&curr_icb);
1502       LIB$GET_PREV_INVO_CONTEXT (&curr_icb);
1503       curr_invo_handle = LIB$GET_INVO_HANDLE (&curr_icb);
1504       *mstate = curr_invo_handle;
1505     }
1506   Raise_From_Signal_Handler (exception, msg);
1507 }
1508
1509 void
1510 __gnat_install_handler (void)
1511 {
1512   long prvhnd;
1513   char *c;
1514
1515   c = (char *) xmalloc (2049);
1516
1517   __gnat_error_prehandler_stack = &c[2048];
1518
1519   /* __gnat_error_prehandler is an assembly function.  */
1520   SYS$SETEXV (1, __gnat_error_prehandler, 3, &prvhnd);
1521   __gnat_handler_installed = 1;
1522 }
1523
1524 void
1525 __gnat_initialize(void)
1526 {
1527 }
1528
1529 /*************************************************/
1530 /* __gnat_initialize (FreeBSD version) */
1531 /*************************************************/
1532
1533 #elif defined (__FreeBSD__)
1534
1535 #include <signal.h>
1536 #include <unistd.h>
1537
1538 static void
1539 __gnat_error_handler (sig, code, sc)
1540      int sig;
1541      int code;
1542      struct sigcontext *sc;
1543 {
1544   struct Exception_Data *exception;
1545   char *msg;
1546
1547   switch (sig)
1548     {
1549     case SIGFPE:
1550       exception = &constraint_error;
1551       msg = "SIGFPE";
1552       break;
1553
1554     case SIGILL:
1555       exception = &constraint_error;
1556       msg = "SIGILL";
1557       break;
1558
1559     case SIGSEGV:
1560       exception = &storage_error;
1561       msg = "stack overflow or erroneous memory access";
1562       break;
1563
1564     case SIGBUS:
1565       exception = &constraint_error;
1566       msg = "SIGBUS";
1567       break;
1568
1569     default:
1570       exception = &program_error;
1571       msg = "unhandled signal";
1572     }
1573
1574   Raise_From_Signal_Handler (exception, msg);
1575 }
1576
1577 void
1578 __gnat_install_handler ()
1579 {
1580   struct sigaction act;
1581
1582   /* Set up signal handler to map synchronous signals to appropriate
1583      exceptions.  Make sure that the handler isn't interrupted by another
1584      signal that might cause a scheduling event! */
1585
1586   act.sa_handler = __gnat_error_handler;
1587   act.sa_flags = SA_NODEFER | SA_RESTART;
1588   (void) sigemptyset (&act.sa_mask);
1589
1590   (void) sigaction (SIGILL,  &act, NULL);
1591   (void) sigaction (SIGFPE,  &act, NULL);
1592   (void) sigaction (SIGSEGV, &act, NULL);
1593   (void) sigaction (SIGBUS,  &act, NULL);
1594 }
1595
1596 void __gnat_init_float ();
1597
1598 void
1599 __gnat_initialize ()
1600 {
1601    __gnat_install_handler ();
1602
1603    /* XXX - Initialize floating-point coprocessor. This call is
1604       needed because FreeBSD defaults to 64-bit precision instead
1605       of 80-bit precision?  We require the full precision for
1606       proper operation, given that we have set Max_Digits etc
1607       with this in mind */
1608    __gnat_init_float ();
1609 }
1610
1611 /***************************************/
1612 /* __gnat_initialize (VXWorks Version) */
1613 /***************************************/
1614
1615 #elif defined(__vxworks)
1616
1617 #include <signal.h>
1618 #include <taskLib.h>
1619 #include <intLib.h>
1620 #include <iv.h>
1621
1622 extern int __gnat_inum_to_ivec (int);
1623 static void __gnat_error_handler (int, int, struct sigcontext *);
1624 void __gnat_map_signal (int);
1625
1626 #ifndef __alpha_vxworks
1627
1628 /* getpid is used by s-parint.adb, but is not defined by VxWorks, except
1629    on Alpha VxWorks */
1630
1631 extern long getpid (void);
1632
1633 long
1634 getpid (void)
1635 {
1636   return taskIdSelf ();
1637 }
1638 #endif
1639
1640 /* This is needed by the GNAT run time to handle Vxworks interrupts */
1641 int
1642 __gnat_inum_to_ivec (int num)
1643 {
1644   return INUM_TO_IVEC (num);
1645 }
1646
1647 /* Exported to 5zintman.adb in order to handle different signal
1648    to exception mappings in different VxWorks versions */
1649 void
1650 __gnat_map_signal (int sig)
1651 {
1652   struct Exception_Data *exception;
1653   char *msg;
1654
1655   switch (sig)
1656     {
1657     case SIGFPE:
1658       exception = &constraint_error;
1659       msg = "SIGFPE";
1660       break;
1661     case SIGILL:
1662       exception = &constraint_error;
1663       msg = "SIGILL";
1664       break;
1665     case SIGSEGV:
1666       exception = &program_error;
1667       msg = "SIGSEGV";
1668       break;
1669     case SIGBUS:
1670 #ifdef VTHREADS
1671       exception = &storage_error;
1672       msg = "SIGBUS: possible stack overflow";
1673 #else
1674       exception = &program_error;
1675       msg = "SIGBUS";
1676 #endif
1677       break;
1678     default:
1679       exception = &program_error;
1680       msg = "unhandled signal";
1681     }
1682
1683   Raise_From_Signal_Handler (exception, msg);
1684 }
1685
1686 static void
1687 __gnat_error_handler (int sig, int code, struct sigcontext *sc)
1688 {
1689   sigset_t mask;
1690   int result;
1691
1692   /* VxWorks will always mask out the signal during the signal handler and
1693      will reenable it on a longjmp.  GNAT does not generate a longjmp to
1694      return from a signal handler so the signal will still be masked unless
1695      we unmask it. */
1696   sigprocmask (SIG_SETMASK, NULL, &mask);
1697   sigdelset (&mask, sig);
1698   sigprocmask (SIG_SETMASK, &mask, NULL);
1699
1700   /* VxWorks will suspend the task when it gets a hardware exception.  We
1701      take the liberty of resuming the task for the application. */
1702   if (taskIsSuspended (taskIdSelf ()) != 0)
1703     taskResume (taskIdSelf ());
1704
1705   __gnat_map_signal (sig);
1706
1707 }
1708
1709 void
1710 __gnat_install_handler (void)
1711 {
1712   struct sigaction act;
1713
1714   /* Setup signal handler to map synchronous signals to appropriate
1715      exceptions.  Make sure that the handler isn't interrupted by another
1716      signal that might cause a scheduling event! */
1717
1718   act.sa_handler = __gnat_error_handler;
1719   act.sa_flags = SA_SIGINFO | SA_ONSTACK;
1720   sigemptyset (&act.sa_mask);
1721
1722   /* For VxWorks, install all signal handlers, since pragma Interrupt_State
1723      applies to vectored hardware interrupts, not signals */
1724   sigaction (SIGFPE,  &act, NULL);
1725   sigaction (SIGILL,  &act, NULL);
1726   sigaction (SIGSEGV, &act, NULL);
1727   sigaction (SIGBUS,  &act, NULL);
1728
1729   __gnat_handler_installed = 1;
1730 }
1731
1732 #define HAVE_GNAT_INIT_FLOAT
1733
1734 void
1735 __gnat_init_float (void)
1736 {
1737   /* Disable overflow/underflow exceptions on the PPC processor, this is needed
1738      to get correct Ada semantic.  */
1739 #if defined (_ARCH_PPC) && !defined (_SOFT_FLOAT)
1740   asm ("mtfsb0 25");
1741   asm ("mtfsb0 26");
1742 #endif
1743
1744   /* Similarily for sparc64. Achieved by masking bits in the Trap Enable Mask
1745      field of the Floating-point Status Register (see the Sparc Architecture
1746      Manual Version 9, p 48).  */
1747 #if defined (sparc64)
1748
1749 #define FSR_TEM_NVM (1 << 27)  /* Invalid operand  */
1750 #define FSR_TEM_OFM (1 << 26)  /* Overflow  */
1751 #define FSR_TEM_UFM (1 << 25)  /* Underflow  */
1752 #define FSR_TEM_DZM (1 << 24)  /* Division by Zero  */
1753 #define FSR_TEM_NXM (1 << 23)  /* Inexact result  */
1754   {
1755     unsigned int fsr;
1756
1757     __asm__("st %%fsr, %0" : "=m" (fsr));
1758     fsr &= ~(FSR_TEM_OFM | FSR_TEM_UFM);
1759     __asm__("ld %0, %%fsr" : : "m" (fsr));
1760   }
1761 #endif
1762 }
1763
1764 void
1765 __gnat_initialize (void)
1766 {
1767   __gnat_init_float ();
1768
1769   /* Assume an environment task stack size of 20kB.
1770
1771      Using a constant is necessary because we do not want each Ada application
1772      to depend on the optional taskShow library,
1773      which is required to get the actual stack information.
1774
1775      The consequence of this is that with -fstack-check
1776      the environment task must have an actual stack size
1777      of at least 20kB and the usable size will be about 14kB.
1778   */
1779
1780   __gnat_set_stack_size (14336);
1781   /* Allow some head room for the stack checking code, and for
1782      stack space consumed during initialization */
1783 }
1784
1785 /********************************/
1786 /* __gnat_initialize for NetBSD */
1787 /********************************/
1788
1789 #elif defined(__NetBSD__)
1790
1791 #include <signal.h>
1792 #include <unistd.h>
1793
1794 static void
1795 __gnat_error_handler (int sig)
1796 {
1797   struct Exception_Data *exception;
1798   const char *msg;
1799
1800   switch(sig)
1801   {
1802     case SIGFPE:
1803       exception = &constraint_error;
1804       msg = "SIGFPE";
1805       break;
1806     case SIGILL:
1807       exception = &constraint_error;
1808       msg = "SIGILL";
1809       break;
1810     case SIGSEGV:
1811       exception = &storage_error;
1812       msg = "stack overflow or erroneous memory access";
1813       break;
1814     case SIGBUS:
1815       exception = &constraint_error;
1816       msg = "SIGBUS";
1817       break;
1818     default:
1819       exception = &program_error;
1820       msg = "unhandled signal";
1821     }
1822
1823     Raise_From_Signal_Handler(exception, msg);
1824 }
1825
1826 void
1827 __gnat_install_handler(void)
1828 {
1829   struct sigaction act;
1830
1831   act.sa_handler = __gnat_error_handler;
1832   act.sa_flags = SA_NODEFER | SA_RESTART;
1833   sigemptyset (&act.sa_mask);
1834
1835   /* Do not install handlers if interrupt state is "System" */
1836   if (__gnat_get_interrupt_state (SIGFPE) != 's')
1837     sigaction (SIGFPE,  &act, NULL);
1838   if (__gnat_get_interrupt_state (SIGILL) != 's')
1839     sigaction (SIGILL,  &act, NULL);
1840   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1841     sigaction (SIGSEGV, &act, NULL);
1842   if (__gnat_get_interrupt_state (SIGBUS) != 's')
1843     sigaction (SIGBUS,  &act, NULL);
1844
1845   __gnat_handler_installed = 1;
1846 }
1847
1848 void
1849 __gnat_initialize (void)
1850 {
1851   __gnat_install_handler ();
1852   __gnat_init_float ();
1853 }
1854
1855 /***************************************/
1856 /* __gnat_initialize (RTEMS version) */
1857 /***************************************/
1858
1859 #elif defined(__rtems__)
1860
1861 extern void __gnat_install_handler (void);
1862
1863 /* For RTEMS, each bsp will provide a custom __gnat_install_handler (). */
1864
1865 void
1866 __gnat_initialize (void)
1867 {
1868    __gnat_install_handler ();
1869 }
1870
1871 #else
1872
1873 /* For all other versions of GNAT, the initialize routine and handler
1874    installation do nothing */
1875
1876 /***************************************/
1877 /* __gnat_initialize (Default Version) */
1878 /***************************************/
1879
1880 void
1881 __gnat_initialize (void)
1882 {
1883 }
1884
1885 /********************************************/
1886 /* __gnat_install_handler (Default Version) */
1887 /********************************************/
1888
1889 void
1890 __gnat_install_handler (void)
1891 {
1892   __gnat_handler_installed = 1;
1893 }
1894
1895 #endif
1896
1897 /*********************/
1898 /* __gnat_init_float */
1899 /*********************/
1900
1901 /* This routine is called as each process thread is created, for possible
1902    initialization of the FP processor. This version is used under INTERIX,
1903    WIN32 and could be used under OS/2 */
1904
1905 #if defined (_WIN32) || defined (__INTERIX) || defined (__EMX__) \
1906   || defined (__Lynx__) || defined(__NetBSD__) || defined(__FreeBSD__)
1907
1908 #define HAVE_GNAT_INIT_FLOAT
1909
1910 void
1911 __gnat_init_float (void)
1912 {
1913 #if defined (__i386__) || defined (i386)
1914
1915   /* This is used to properly initialize the FPU on an x86 for each
1916      process thread. */
1917
1918   asm ("finit");
1919
1920 #endif  /* Defined __i386__ */
1921 }
1922 #endif
1923
1924 #ifndef HAVE_GNAT_INIT_FLOAT
1925
1926 /* All targets without a specific __gnat_init_float will use an empty one */
1927 void
1928 __gnat_init_float (void)
1929 {
1930 }
1931 #endif