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 (Exception_Code);
1348
1349 #define Base_Code_In system__vms_exception_table__base_code_in
1350 extern Exception_Code Base_Code_In (Exception_Code);
1351 #endif
1352
1353 /* Define macro symbols for the VMS conditions that become Ada exceptions.
1354    Most of these are also defined in the header file ssdef.h which has not
1355    yet been converted to be recoginized by Gnu C. Some, which couldn't be
1356    located, are assigned names based on the DEC test suite tests which
1357    raise them. */
1358
1359 #define SS$_ACCVIO            12
1360 #define SS$_DEBUG           1132
1361 #define SS$_INTDIV          1156
1362 #define SS$_HPARITH         1284
1363 #define SS$_STKOVF          1364
1364 #define SS$_RESIGNAL        2328
1365 #define MTH$_FLOOVEMAT   1475268       /* Some ACVC_21 CXA tests */
1366 #define SS$_CE24VRU      3253636       /* Write to unopened file */
1367 #define SS$_C980VTE      3246436       /* AST requests time slice */
1368 #define CMA$_EXIT_THREAD 4227492
1369 #define CMA$_EXCCOPLOS   4228108
1370 #define CMA$_ALERTED     4227460
1371
1372 struct descriptor_s {unsigned short len, mbz; char *adr; };
1373
1374 long __gnat_error_handler (int *, void *);
1375
1376 long
1377 __gnat_error_handler (int *sigargs, void *mechargs)
1378 {
1379   struct Exception_Data *exception = 0;
1380   Exception_Code base_code;
1381
1382   char *msg = "";
1383   char message[256];
1384   long prvhnd;
1385   struct descriptor_s msgdesc;
1386   int msg_flag = 0x000f; /* 1 bit for each of the four message parts */
1387   unsigned short outlen;
1388   char curr_icb[544];
1389   long curr_invo_handle;
1390   long *mstate;
1391
1392   /* Resignaled condtions aren't effected by by pragma Import_Exception */
1393
1394   switch (sigargs[1])
1395   {
1396
1397     case CMA$_EXIT_THREAD:
1398       return SS$_RESIGNAL;
1399
1400     case SS$_DEBUG: /* Gdb attach, resignal to merge activate gdbstub. */
1401       return SS$_RESIGNAL;
1402
1403     case 1409786: /* Nickerson bug #33 ??? */
1404       return SS$_RESIGNAL;
1405
1406     case 1381050: /* Nickerson bug #33 ??? */
1407       return SS$_RESIGNAL;
1408
1409     case 20480426: /* RDB-E-STREAM_EOF */
1410       return SS$_RESIGNAL;
1411
1412     case 11829410: /* Resignalled as Use_Error for CE10VRC */
1413       return SS$_RESIGNAL;
1414
1415   }
1416
1417 #ifdef IN_RTS
1418   /* See if it's an imported exception. Beware that registered exceptions
1419      are bound to their base code, with the severity bits masked off.  */
1420   base_code = Base_Code_In ((Exception_Code) sigargs [1]);
1421   exception = Coded_Exception (base_code);
1422
1423   if (exception)
1424     {
1425       msgdesc.len = 256;
1426       msgdesc.mbz = 0;
1427       msgdesc.adr = message;
1428       SYS$GETMSG (sigargs[1], &outlen, &msgdesc, msg_flag, 0);
1429       message[outlen] = 0;
1430       msg = message;
1431
1432       exception->Name_Length = 19;
1433       /* The full name really should be get sys$getmsg returns. ??? */
1434       exception->Full_Name = "IMPORTED_EXCEPTION";
1435       exception->Import_Code = base_code;
1436     }
1437 #endif
1438
1439   if (exception == 0)
1440     switch (sigargs[1])
1441       {
1442       case SS$_ACCVIO:
1443         if (sigargs[3] == 0)
1444           {
1445             exception = &constraint_error;
1446             msg = "access zero";
1447           }
1448         else
1449           {
1450             exception = &storage_error;
1451             msg = "stack overflow (or erroneous memory access)";
1452           }
1453         break;
1454
1455       case SS$_STKOVF:
1456         exception = &storage_error;
1457         msg = "stack overflow";
1458         break;
1459
1460       case SS$_INTDIV:
1461         exception = &constraint_error;
1462         msg = "division by zero";
1463         break;
1464
1465       case SS$_HPARITH:
1466 #ifndef IN_RTS
1467         return SS$_RESIGNAL; /* toplev.c handles for compiler */
1468 #else
1469         {
1470           exception = &constraint_error;
1471           msg = "arithmetic error";
1472         }
1473 #endif
1474         break;
1475
1476       case MTH$_FLOOVEMAT:
1477         exception = &constraint_error;
1478         msg = "floating overflow in math library";
1479         break;
1480
1481       case SS$_CE24VRU:
1482         exception = &constraint_error;
1483         msg = "";
1484         break;
1485
1486       case SS$_C980VTE:
1487         exception = &program_error;
1488         msg = "";
1489         break;
1490
1491       default:
1492 #ifndef IN_RTS
1493         exception = &program_error;
1494 #else
1495         /* User programs expect Non_Ada_Error to be raised, reference
1496            DEC Ada test CXCONDHAN. */
1497         exception = &Non_Ada_Error;
1498 #endif
1499         msgdesc.len = 256;
1500         msgdesc.mbz = 0;
1501         msgdesc.adr = message;
1502         SYS$GETMSG (sigargs[1], &outlen, &msgdesc, msg_flag, 0);
1503         message[outlen] = 0;
1504         msg = message;
1505         break;
1506       }
1507
1508   mstate = (long *) (*Get_Machine_State_Addr) ();
1509   if (mstate != 0)
1510     {
1511       LIB$GET_CURR_INVO_CONTEXT (&curr_icb);
1512       LIB$GET_PREV_INVO_CONTEXT (&curr_icb);
1513       LIB$GET_PREV_INVO_CONTEXT (&curr_icb);
1514       curr_invo_handle = LIB$GET_INVO_HANDLE (&curr_icb);
1515       *mstate = curr_invo_handle;
1516     }
1517   Raise_From_Signal_Handler (exception, msg);
1518 }
1519
1520 void
1521 __gnat_install_handler (void)
1522 {
1523   long prvhnd;
1524   char *c;
1525
1526   c = (char *) xmalloc (2049);
1527
1528   __gnat_error_prehandler_stack = &c[2048];
1529
1530   /* __gnat_error_prehandler is an assembly function.  */
1531   SYS$SETEXV (1, __gnat_error_prehandler, 3, &prvhnd);
1532   __gnat_handler_installed = 1;
1533 }
1534
1535 void
1536 __gnat_initialize(void)
1537 {
1538 }
1539
1540 /*************************************************/
1541 /* __gnat_initialize (FreeBSD version) */
1542 /*************************************************/
1543
1544 #elif defined (__FreeBSD__)
1545
1546 #include <signal.h>
1547 #include <unistd.h>
1548
1549 static void
1550 __gnat_error_handler (sig, code, sc)
1551      int sig;
1552      int code;
1553      struct sigcontext *sc;
1554 {
1555   struct Exception_Data *exception;
1556   char *msg;
1557
1558   switch (sig)
1559     {
1560     case SIGFPE:
1561       exception = &constraint_error;
1562       msg = "SIGFPE";
1563       break;
1564
1565     case SIGILL:
1566       exception = &constraint_error;
1567       msg = "SIGILL";
1568       break;
1569
1570     case SIGSEGV:
1571       exception = &storage_error;
1572       msg = "stack overflow or erroneous memory access";
1573       break;
1574
1575     case SIGBUS:
1576       exception = &constraint_error;
1577       msg = "SIGBUS";
1578       break;
1579
1580     default:
1581       exception = &program_error;
1582       msg = "unhandled signal";
1583     }
1584
1585   Raise_From_Signal_Handler (exception, msg);
1586 }
1587
1588 void
1589 __gnat_install_handler ()
1590 {
1591   struct sigaction act;
1592
1593   /* Set up signal handler to map synchronous signals to appropriate
1594      exceptions.  Make sure that the handler isn't interrupted by another
1595      signal that might cause a scheduling event! */
1596
1597   act.sa_handler = __gnat_error_handler;
1598   act.sa_flags = SA_NODEFER | SA_RESTART;
1599   (void) sigemptyset (&act.sa_mask);
1600
1601   (void) sigaction (SIGILL,  &act, NULL);
1602   (void) sigaction (SIGFPE,  &act, NULL);
1603   (void) sigaction (SIGSEGV, &act, NULL);
1604   (void) sigaction (SIGBUS,  &act, NULL);
1605 }
1606
1607 void __gnat_init_float ();
1608
1609 void
1610 __gnat_initialize ()
1611 {
1612    __gnat_install_handler ();
1613
1614    /* XXX - Initialize floating-point coprocessor. This call is
1615       needed because FreeBSD defaults to 64-bit precision instead
1616       of 80-bit precision?  We require the full precision for
1617       proper operation, given that we have set Max_Digits etc
1618       with this in mind */
1619    __gnat_init_float ();
1620 }
1621
1622 /***************************************/
1623 /* __gnat_initialize (VXWorks Version) */
1624 /***************************************/
1625
1626 #elif defined(__vxworks)
1627
1628 #include <signal.h>
1629 #include <taskLib.h>
1630 #include <intLib.h>
1631 #include <iv.h>
1632
1633 extern int __gnat_inum_to_ivec (int);
1634 static void __gnat_error_handler (int, int, struct sigcontext *);
1635 void __gnat_map_signal (int);
1636
1637 #ifndef __alpha_vxworks
1638
1639 /* getpid is used by s-parint.adb, but is not defined by VxWorks, except
1640    on Alpha VxWorks */
1641
1642 extern long getpid (void);
1643
1644 long
1645 getpid (void)
1646 {
1647   return taskIdSelf ();
1648 }
1649 #endif
1650
1651 /* This is needed by the GNAT run time to handle Vxworks interrupts */
1652 int
1653 __gnat_inum_to_ivec (int num)
1654 {
1655   return INUM_TO_IVEC (num);
1656 }
1657
1658 /* Exported to 5zintman.adb in order to handle different signal
1659    to exception mappings in different VxWorks versions */
1660 void
1661 __gnat_map_signal (int sig)
1662 {
1663   struct Exception_Data *exception;
1664   char *msg;
1665
1666   switch (sig)
1667     {
1668     case SIGFPE:
1669       exception = &constraint_error;
1670       msg = "SIGFPE";
1671       break;
1672     case SIGILL:
1673       exception = &constraint_error;
1674       msg = "SIGILL";
1675       break;
1676     case SIGSEGV:
1677       exception = &program_error;
1678       msg = "SIGSEGV";
1679       break;
1680     case SIGBUS:
1681 #ifdef VTHREADS
1682       exception = &storage_error;
1683       msg = "SIGBUS: possible stack overflow";
1684 #else
1685       exception = &program_error;
1686       msg = "SIGBUS";
1687 #endif
1688       break;
1689     default:
1690       exception = &program_error;
1691       msg = "unhandled signal";
1692     }
1693
1694   Raise_From_Signal_Handler (exception, msg);
1695 }
1696
1697 static void
1698 __gnat_error_handler (int sig, int code, struct sigcontext *sc)
1699 {
1700   sigset_t mask;
1701   int result;
1702
1703   /* VxWorks will always mask out the signal during the signal handler and
1704      will reenable it on a longjmp.  GNAT does not generate a longjmp to
1705      return from a signal handler so the signal will still be masked unless
1706      we unmask it. */
1707   sigprocmask (SIG_SETMASK, NULL, &mask);
1708   sigdelset (&mask, sig);
1709   sigprocmask (SIG_SETMASK, &mask, NULL);
1710
1711   /* VxWorks will suspend the task when it gets a hardware exception.  We
1712      take the liberty of resuming the task for the application. */
1713   if (taskIsSuspended (taskIdSelf ()) != 0)
1714     taskResume (taskIdSelf ());
1715
1716   __gnat_map_signal (sig);
1717
1718 }
1719
1720 void
1721 __gnat_install_handler (void)
1722 {
1723   struct sigaction act;
1724
1725   /* Setup signal handler to map synchronous signals to appropriate
1726      exceptions.  Make sure that the handler isn't interrupted by another
1727      signal that might cause a scheduling event! */
1728
1729   act.sa_handler = __gnat_error_handler;
1730   act.sa_flags = SA_SIGINFO | SA_ONSTACK;
1731   sigemptyset (&act.sa_mask);
1732
1733   /* For VxWorks, install all signal handlers, since pragma Interrupt_State
1734      applies to vectored hardware interrupts, not signals */
1735   sigaction (SIGFPE,  &act, NULL);
1736   sigaction (SIGILL,  &act, NULL);
1737   sigaction (SIGSEGV, &act, NULL);
1738   sigaction (SIGBUS,  &act, NULL);
1739
1740   __gnat_handler_installed = 1;
1741 }
1742
1743 #define HAVE_GNAT_INIT_FLOAT
1744
1745 void
1746 __gnat_init_float (void)
1747 {
1748   /* Disable overflow/underflow exceptions on the PPC processor, this is needed
1749      to get correct Ada semantic.  */
1750 #if defined (_ARCH_PPC) && !defined (_SOFT_FLOAT)
1751   asm ("mtfsb0 25");
1752   asm ("mtfsb0 26");
1753 #endif
1754
1755   /* Similarily for sparc64. Achieved by masking bits in the Trap Enable Mask
1756      field of the Floating-point Status Register (see the Sparc Architecture
1757      Manual Version 9, p 48).  */
1758 #if defined (sparc64)
1759
1760 #define FSR_TEM_NVM (1 << 27)  /* Invalid operand  */
1761 #define FSR_TEM_OFM (1 << 26)  /* Overflow  */
1762 #define FSR_TEM_UFM (1 << 25)  /* Underflow  */
1763 #define FSR_TEM_DZM (1 << 24)  /* Division by Zero  */
1764 #define FSR_TEM_NXM (1 << 23)  /* Inexact result  */
1765   {
1766     unsigned int fsr;
1767
1768     __asm__("st %%fsr, %0" : "=m" (fsr));
1769     fsr &= ~(FSR_TEM_OFM | FSR_TEM_UFM);
1770     __asm__("ld %0, %%fsr" : : "m" (fsr));
1771   }
1772 #endif
1773 }
1774
1775 void
1776 __gnat_initialize (void)
1777 {
1778   __gnat_init_float ();
1779
1780   /* On targets where we might be using the ZCX scheme, we need to register
1781      the frame tables.
1782
1783      For application "modules", the crtstuff objects linked in (crtbegin/endS)
1784      are tailored to provide this service a-la C++ constructor fashion,
1785      typically triggered by the dynamic loader. This is achieved by way of a
1786      special variable declaration in the crt object, the name of which has
1787      been deduced by analyzing the output of the "munching" step documented
1788      for C++.  The de-registration call is handled symetrically, a-la C++
1789      destructor fashion and typically triggered by the dynamic unloader. With
1790      this scheme, a mixed Ada/C++ application has to be linked and loaded as
1791      separate modules for each language, which is not unreasonable anyway.
1792
1793      For applications statically linked with the kernel, the module scheme
1794      above would lead to duplicated symbols because the VxWorks kernel build
1795      "munches" by default. To prevent those conflicts, we link against
1796      crtbegin/end objects that don't include the special variable and directly
1797      call the appropriate function here. We'll never unload that, so there is
1798      no de-registration to worry about.
1799
1800      We can differentiate between the two cases by looking at the
1801      __module_has_ctors value provided by each class of crt objects. As of
1802      today, selecting the crt set intended for applications to be statically
1803      linked with the kernel is triggered by adding "-static" to the gcc *link*
1804      command line options.  */
1805
1806 #if 0
1807  {
1808    extern const int __module_has_ctors;
1809    extern void __do_global_ctors ();
1810
1811    if (! __module_has_ctors)
1812      __do_global_ctors ();
1813  }
1814 #endif
1815 }
1816
1817 /********************************/
1818 /* __gnat_initialize for NetBSD */
1819 /********************************/
1820
1821 #elif defined(__NetBSD__)
1822
1823 #include <signal.h>
1824 #include <unistd.h>
1825
1826 static void
1827 __gnat_error_handler (int sig)
1828 {
1829   struct Exception_Data *exception;
1830   const char *msg;
1831
1832   switch(sig)
1833   {
1834     case SIGFPE:
1835       exception = &constraint_error;
1836       msg = "SIGFPE";
1837       break;
1838     case SIGILL:
1839       exception = &constraint_error;
1840       msg = "SIGILL";
1841       break;
1842     case SIGSEGV:
1843       exception = &storage_error;
1844       msg = "stack overflow or erroneous memory access";
1845       break;
1846     case SIGBUS:
1847       exception = &constraint_error;
1848       msg = "SIGBUS";
1849       break;
1850     default:
1851       exception = &program_error;
1852       msg = "unhandled signal";
1853     }
1854
1855     Raise_From_Signal_Handler(exception, msg);
1856 }
1857
1858 void
1859 __gnat_install_handler(void)
1860 {
1861   struct sigaction act;
1862
1863   act.sa_handler = __gnat_error_handler;
1864   act.sa_flags = SA_NODEFER | SA_RESTART;
1865   sigemptyset (&act.sa_mask);
1866
1867   /* Do not install handlers if interrupt state is "System" */
1868   if (__gnat_get_interrupt_state (SIGFPE) != 's')
1869     sigaction (SIGFPE,  &act, NULL);
1870   if (__gnat_get_interrupt_state (SIGILL) != 's')
1871     sigaction (SIGILL,  &act, NULL);
1872   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1873     sigaction (SIGSEGV, &act, NULL);
1874   if (__gnat_get_interrupt_state (SIGBUS) != 's')
1875     sigaction (SIGBUS,  &act, NULL);
1876
1877   __gnat_handler_installed = 1;
1878 }
1879
1880 void
1881 __gnat_initialize (void)
1882 {
1883   __gnat_install_handler ();
1884   __gnat_init_float ();
1885 }
1886
1887 /***************************************/
1888 /* __gnat_initialize (RTEMS version) */
1889 /***************************************/
1890
1891 #elif defined(__rtems__)
1892
1893 extern void __gnat_install_handler (void);
1894
1895 /* For RTEMS, each bsp will provide a custom __gnat_install_handler (). */
1896
1897 void
1898 __gnat_initialize (void)
1899 {
1900    __gnat_install_handler ();
1901 }
1902
1903 #else
1904
1905 /* For all other versions of GNAT, the initialize routine and handler
1906    installation do nothing */
1907
1908 /***************************************/
1909 /* __gnat_initialize (Default Version) */
1910 /***************************************/
1911
1912 void
1913 __gnat_initialize (void)
1914 {
1915 }
1916
1917 /********************************************/
1918 /* __gnat_install_handler (Default Version) */
1919 /********************************************/
1920
1921 void
1922 __gnat_install_handler (void)
1923 {
1924   __gnat_handler_installed = 1;
1925 }
1926
1927 #endif
1928
1929 /*********************/
1930 /* __gnat_init_float */
1931 /*********************/
1932
1933 /* This routine is called as each process thread is created, for possible
1934    initialization of the FP processor. This version is used under INTERIX,
1935    WIN32 and could be used under OS/2 */
1936
1937 #if defined (_WIN32) || defined (__INTERIX) || defined (__EMX__) \
1938   || defined (__Lynx__) || defined(__NetBSD__) || defined(__FreeBSD__)
1939
1940 #define HAVE_GNAT_INIT_FLOAT
1941
1942 void
1943 __gnat_init_float (void)
1944 {
1945 #if defined (__i386__) || defined (i386)
1946
1947   /* This is used to properly initialize the FPU on an x86 for each
1948      process thread. */
1949
1950   asm ("finit");
1951
1952 #endif  /* Defined __i386__ */
1953 }
1954 #endif
1955
1956 #ifndef HAVE_GNAT_INIT_FLOAT
1957
1958 /* All targets without a specific __gnat_init_float will use an empty one */
1959 void
1960 __gnat_init_float (void)
1961 {
1962 }
1963 #endif