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