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