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) (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   /* Setup signal handler to map synchronous signals to appropriate
 452      exceptions. Make sure that the handler isn't interrupted by another
 453      signal that might cause a scheduling event! */
 454
 455   act.sa_handler = (void (*) (int)) __gnat_error_handler;
 456   act.sa_flags = SA_ONSTACK | SA_RESTART | SA_NODEFER | SA_SIGINFO;
 457   sigemptyset (&act.sa_mask);
 458
 459   /* Do not install handlers if interrupt state is "System" */
 460   if (__gnat_get_interrupt_state (SIGABRT) != 's')
 461     sigaction (SIGABRT, &act, NULL);
 462   if (__gnat_get_interrupt_state (SIGFPE) != 's')
 463     sigaction (SIGFPE,  &act, NULL);
 464   if (__gnat_get_interrupt_state (SIGILL) != 's')
 465     sigaction (SIGILL,  &act, NULL);
 466   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 467     sigaction (SIGSEGV, &act, NULL);
 468   if (__gnat_get_interrupt_state (SIGBUS) != 's')
 469     sigaction (SIGBUS,  &act, NULL);
 470
 471   __gnat_handler_installed = 1;
 472 }
 473
 474 void
 475 __gnat_initialize (void)
 476 {
 477 }
 478
 479 /* Routines called by 5amastop.adb.  */
 480
 481 #define SC_GP 29
 482
 483 char *
 484 __gnat_get_code_loc (struct sigcontext *context)
 485 {
 486   return (char *) context->sc_pc;
 487 }
 488
 489 void
 490 __gnat_enter_handler ( struct sigcontext *context, char *pc)
 491 {
 492   context->sc_pc = (long) pc;
 493   context->sc_regs[SC_GP] = exc_lookup_gp (pc);
 494   exc_resume (context);
 495 }
 496
 497 size_t
 498 __gnat_machine_state_length (void)
 499 {
 500   return sizeof (struct sigcontext);
 501 }
 502
 503 /************************************/
 504 /* __gnat_initialize (HPUX Version) */
 505 /************************************/
 506
 507 #elif defined (hpux)
 508
 509 #include <signal.h>
 510
 511 static void __gnat_error_handler (int);
 512
 513 static void
 514 __gnat_error_handler (int sig)
 515 {
 516   struct Exception_Data *exception;
 517   char *msg;
 518
 519   switch (sig)
 520     {
 521     case SIGSEGV:
 522       /* FIXME: we need to detect the case of a *real* SIGSEGV */
 523       exception = &storage_error;
 524       msg = "stack overflow or erroneous memory access";
 525       break;
 526
 527     case SIGBUS:
 528       exception = &constraint_error;
 529       msg = "SIGBUS";
 530       break;
 531
 532     case SIGFPE:
 533       exception = &constraint_error;
 534       msg = "SIGFPE";
 535       break;
 536
 537     default:
 538       exception = &program_error;
 539       msg = "unhandled signal";
 540     }
 541
 542   Raise_From_Signal_Handler (exception, msg);
 543 }
 544
 545 void
 546 __gnat_install_handler (void)
 547 {
 548   struct sigaction act;
 549
 550   /* Set up signal handler to map synchronous signals to appropriate
 551      exceptions.  Make sure that the handler isn't interrupted by another
 552      signal that might cause a scheduling event! Also setup an alternate
 553      stack region for the handler execution so that stack overflows can be
 554      handled properly, avoiding a SEGV generation from stack usage by the
 555      handler itself. */
 556
 557   static char handler_stack[SIGSTKSZ*2];
 558   /* SIGSTKSZ appeared to be "short" for the needs in some contexts
 559      (e.g. experiments with GCC ZCX exceptions).  */
 560
 561   stack_t stack;
 562
 563   stack.ss_sp    = handler_stack;
 564   stack.ss_size  = sizeof (handler_stack);
 565   stack.ss_flags = 0;
 566
 567   sigaltstack (&stack, NULL);
 568
 569   act.sa_handler = __gnat_error_handler;
 570   act.sa_flags = SA_NODEFER | SA_RESTART | SA_ONSTACK;
 571   sigemptyset (&act.sa_mask);
 572
 573   /* Do not install handlers if interrupt state is "System" */
 574   if (__gnat_get_interrupt_state (SIGABRT) != 's')
 575     sigaction (SIGABRT, &act, NULL);
 576   if (__gnat_get_interrupt_state (SIGFPE) != 's')
 577     sigaction (SIGFPE,  &act, NULL);
 578   if (__gnat_get_interrupt_state (SIGILL) != 's')
 579     sigaction (SIGILL,  &act, NULL);
 580   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 581     sigaction (SIGSEGV, &act, NULL);
 582   if (__gnat_get_interrupt_state (SIGBUS) != 's')
 583     sigaction (SIGBUS,  &act, NULL);
 584
 585   __gnat_handler_installed = 1;
 586 }
 587
 588 void
 589 __gnat_initialize (void)
 590 {
 591 }
 592
 593 /*****************************************/
 594 /* __gnat_initialize (GNU/Linux Version) */
 595 /*****************************************/
 596
 597 #elif defined (linux) && defined (i386) && !defined (__RT__)
 598
 599 #include <signal.h>
 600 #include <asm/sigcontext.h>
 601
 602 /* GNU/Linux, which uses glibc, does not define NULL in included
 603    header files */
 604
 605 #if !defined (NULL)
 606 #define NULL ((void *) 0)
 607 #endif
 608
 609 struct Machine_State
 610 {
 611   unsigned long eip;
 612   unsigned long ebx;
 613   unsigned long esp;
 614   unsigned long ebp;
 615   unsigned long esi;
 616   unsigned long edi;
 617 };
 618
 619 static void __gnat_error_handler (int);
 620
 621 static void
 622 __gnat_error_handler (int sig)
 623 {
 624   struct Exception_Data *exception;
 625   const char *msg;
 626   static int recurse = 0;
 627
 628   struct sigcontext *info
 629     = (struct sigcontext *) (((char *) &sig) + sizeof (int));
 630
 631   /* The Linux kernel does not document how to get the machine state in a
 632      signal handler, but in fact the necessary data is in a sigcontext_struct
 633      value that is on the stack immediately above the signal number
 634      parameter, and the above messing accesses this value on the stack. */
 635
 636   struct Machine_State *mstate;
 637
 638   switch (sig)
 639     {
 640     case SIGSEGV:
 641       /* If the problem was permissions, this is a constraint error.
 642        Likewise if the failing address isn't maximally aligned or if
 643        we've recursed.
 644
 645        ??? Using a static variable here isn't task-safe, but it's
 646        much too hard to do anything else and we're just determining
 647        which exception to raise.  */
 648       if (recurse)
 649       {
 650         exception = &constraint_error;
 651         msg = "SIGSEGV";
 652       }
 653       else
 654       {
 655         /* Here we would like a discrimination test to see whether the
 656            page before the faulting address is accessible. Unfortunately
 657            Linux seems to have no way of giving us the faulting address.
 658
 659            In versions of a-init.c before 1.95, we had a test of the page
 660            before the stack pointer using:
 661
 662             recurse++;
 663              ((volatile char *)
 664               ((long) info->esp_at_signal & - getpagesize ()))[getpagesize ()];
 665
 666            but that's wrong, since it tests the stack pointer location, and
 667            the current stack probe code does not move the stack pointer
 668            until all probes succeed.
 669
 670            For now we simply do not attempt any discrimination at all. Note
 671            that this is quite acceptable, since a "real" SIGSEGV can only
 672            occur as the result of an erroneous program */
 673
 674         msg = "stack overflow (or erroneous memory access)";
 675         exception = &storage_error;
 676       }
 677       break;
 678
 679     case SIGBUS:
 680       exception = &constraint_error;
 681       msg = "SIGBUS";
 682       break;
 683
 684     case SIGFPE:
 685       exception = &constraint_error;
 686       msg = "SIGFPE";
 687       break;
 688
 689     default:
 690       exception = &program_error;
 691       msg = "unhandled signal";
 692     }
 693
 694   mstate = (*Get_Machine_State_Addr) ();
 695   if (mstate)
 696     {
 697       mstate->eip = info->eip;
 698       mstate->ebx = info->ebx;
 699       mstate->esp = info->esp_at_signal;
 700       mstate->ebp = info->ebp;
 701       mstate->esi = info->esi;
 702       mstate->edi = info->edi;
 703     }
 704
 705   recurse = 0;
 706   Raise_From_Signal_Handler (exception, msg);
 707 }
 708
 709 void
 710 __gnat_install_handler (void)
 711 {
 712   struct sigaction act;
 713
 714   /* Set up signal handler to map synchronous signals to appropriate
 715      exceptions.  Make sure that the handler isn't interrupted by another
 716      signal that might cause a scheduling event! */
 717
 718   act.sa_handler = __gnat_error_handler;
 719   act.sa_flags = SA_NODEFER | SA_RESTART;
 720   sigemptyset (&act.sa_mask);
 721
 722   /* Do not install handlers if interrupt state is "System" */
 723   if (__gnat_get_interrupt_state (SIGABRT) != 's')
 724     sigaction (SIGABRT, &act, NULL);
 725   if (__gnat_get_interrupt_state (SIGFPE) != 's')
 726     sigaction (SIGFPE,  &act, NULL);
 727   if (__gnat_get_interrupt_state (SIGILL) != 's')
 728     sigaction (SIGILL,  &act, NULL);
 729   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 730     sigaction (SIGSEGV, &act, NULL);
 731   if (__gnat_get_interrupt_state (SIGBUS) != 's')
 732     sigaction (SIGBUS,  &act, NULL);
 733
 734   __gnat_handler_installed = 1;
 735 }
 736
 737 void
 738 __gnat_initialize (void)
 739 {
 740 }
 741
 742 /******************************************/
 743 /* __gnat_initialize (NT-mingw32 Version) */
 744 /******************************************/
 745
 746 #elif defined (__MINGW32__)
 747 #include <windows.h>
 748
 749 static LONG WINAPI __gnat_error_handler (PEXCEPTION_POINTERS);
 750
 751 /* __gnat_initialize (mingw32).  */
 752
 753 static LONG WINAPI
 754 __gnat_error_handler (PEXCEPTION_POINTERS info)
 755 {
 756   static int recurse;
 757   struct Exception_Data *exception;
 758   const char *msg;
 759
 760   switch (info->ExceptionRecord->ExceptionCode)
 761     {
 762     case EXCEPTION_ACCESS_VIOLATION:
 763       /* If the failing address isn't maximally-aligned or if we've
 764          recursed, this is a program error.  */
 765       if ((info->ExceptionRecord->ExceptionInformation[1] & 3) != 0
 766           || recurse)
 767         {
 768           exception = &program_error;
 769           msg = "EXCEPTION_ACCESS_VIOLATION";
 770         }
 771       else
 772         {
 773           /* See if the page before the faulting page is accessible.  Do that
 774              by trying to access it. */
 775           recurse++;
 776           * ((volatile char *) (info->ExceptionRecord->ExceptionInformation[1]
 777                                 + 4096));
 778           exception = &storage_error;
 779           msg = "stack overflow (or erroneous memory access)";
 780         }
 781       break;
 782
 783     case EXCEPTION_ARRAY_BOUNDS_EXCEEDED:
 784       exception = &constraint_error;
 785       msg = "EXCEPTION_ARRAY_BOUNDS_EXCEEDED";
 786       break;
 787
 788     case EXCEPTION_DATATYPE_MISALIGNMENT:
 789       exception = &constraint_error;
 790       msg = "EXCEPTION_DATATYPE_MISALIGNMENT";
 791       break;
 792
 793     case EXCEPTION_FLT_DENORMAL_OPERAND:
 794       exception = &constraint_error;
 795       msg = "EXCEPTION_FLT_DENORMAL_OPERAND";
 796       break;
 797
 798     case EXCEPTION_FLT_DIVIDE_BY_ZERO:
 799       exception = &constraint_error;
 800       msg = "EXCEPTION_FLT_DENORMAL_OPERAND";
 801       break;
 802
 803     case EXCEPTION_FLT_INVALID_OPERATION:
 804       exception = &constraint_error;
 805       msg = "EXCEPTION_FLT_INVALID_OPERATION";
 806       break;
 807
 808     case EXCEPTION_FLT_OVERFLOW:
 809       exception = &constraint_error;
 810       msg = "EXCEPTION_FLT_OVERFLOW";
 811       break;
 812
 813     case EXCEPTION_FLT_STACK_CHECK:
 814       exception = &program_error;
 815       msg = "EXCEPTION_FLT_STACK_CHECK";
 816       break;
 817
 818     case EXCEPTION_FLT_UNDERFLOW:
 819       exception = &constraint_error;
 820       msg = "EXCEPTION_FLT_UNDERFLOW";
 821       break;
 822
 823     case EXCEPTION_INT_DIVIDE_BY_ZERO:
 824       exception = &constraint_error;
 825       msg = "EXCEPTION_INT_DIVIDE_BY_ZERO";
 826       break;
 827
 828     case EXCEPTION_INT_OVERFLOW:
 829       exception = &constraint_error;
 830       msg = "EXCEPTION_INT_OVERFLOW";
 831       break;
 832
 833     case EXCEPTION_INVALID_DISPOSITION:
 834       exception = &program_error;
 835       msg = "EXCEPTION_INVALID_DISPOSITION";
 836       break;
 837
 838     case EXCEPTION_NONCONTINUABLE_EXCEPTION:
 839       exception = &program_error;
 840       msg = "EXCEPTION_NONCONTINUABLE_EXCEPTION";
 841       break;
 842
 843     case EXCEPTION_PRIV_INSTRUCTION:
 844       exception = &program_error;
 845       msg = "EXCEPTION_PRIV_INSTRUCTION";
 846       break;
 847
 848     case EXCEPTION_SINGLE_STEP:
 849       exception = &program_error;
 850       msg = "EXCEPTION_SINGLE_STEP";
 851       break;
 852
 853     case EXCEPTION_STACK_OVERFLOW:
 854       exception = &storage_error;
 855       msg = "EXCEPTION_STACK_OVERFLOW";
 856       break;
 857
 858    default:
 859       exception = &program_error;
 860       msg = "unhandled signal";
 861     }
 862
 863   recurse = 0;
 864   Raise_From_Signal_Handler (exception, msg);
 865   return 0; /* This is never reached, avoid compiler warning */
 866 }
 867
 868 void
 869 __gnat_install_handler (void)
 870 {
 871   SetUnhandledExceptionFilter (__gnat_error_handler);
 872   __gnat_handler_installed = 1;
 873 }
 874
 875 void
 876 __gnat_initialize (void)
 877 {
 878
 879    /* Initialize floating-point coprocessor. This call is needed because
 880       the MS libraries default to 64-bit precision instead of 80-bit
 881       precision, and we require the full precision for proper operation,
 882       given that we have set Max_Digits etc with this in mind */
 883
 884    __gnat_init_float ();
 885
 886    /* initialize a lock for a process handle list - see a-adaint.c for the
 887       implementation of __gnat_portable_no_block_spawn, __gnat_portable_wait */
 888    __gnat_plist_init();
 889 }
 890
 891 /***************************************/
 892 /* __gnat_initialize (Interix Version) */
 893 /***************************************/
 894
 895 #elif defined (__INTERIX)
 896
 897 #include <signal.h>
 898
 899 static void __gnat_error_handler (int);
 900
 901 static void
 902 __gnat_error_handler (int sig)
 903 {
 904   struct Exception_Data *exception;
 905   char *msg;
 906
 907   switch (sig)
 908     {
 909     case SIGSEGV:
 910       exception = &storage_error;
 911       msg = "stack overflow or erroneous memory access";
 912       break;
 913
 914     case SIGBUS:
 915       exception = &constraint_error;
 916       msg = "SIGBUS";
 917       break;
 918
 919     case SIGFPE:
 920       exception = &constraint_error;
 921       msg = "SIGFPE";
 922       break;
 923
 924     default:
 925       exception = &program_error;
 926       msg = "unhandled signal";
 927     }
 928
 929   Raise_From_Signal_Handler (exception, msg);
 930 }
 931
 932 void
 933 __gnat_install_handler (void)
 934 {
 935   struct sigaction act;
 936
 937   /* Set up signal handler to map synchronous signals to appropriate
 938      exceptions.  Make sure that the handler isn't interrupted by another
 939      signal that might cause a scheduling event! */
 940
 941   act.sa_handler = __gnat_error_handler;
 942   act.sa_flags = 0;
 943   sigemptyset (&act.sa_mask);
 944
 945   /* Handlers for signals besides SIGSEGV cause c974013 to hang */
 946 /*  sigaction (SIGILL,  &act, NULL); */
 947 /*  sigaction (SIGABRT, &act, NULL); */
 948 /*  sigaction (SIGFPE,  &act, NULL); */
 949 /*  sigaction (SIGBUS,  &act, NULL); */
 950
 951   /* Do not install handlers if interrupt state is "System" */
 952   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 953     sigaction (SIGSEGV, &act, NULL);
 954
 955   __gnat_handler_installed = 1;
 956 }
 957
 958 void
 959 __gnat_initialize (void)
 960 {
 961    __gnat_init_float ();
 962 }
 963
 964 /**************************************/
 965 /* __gnat_initialize (LynxOS Version) */
 966 /**************************************/
 967
 968 #elif defined (__Lynx__)
 969
 970 void
 971 __gnat_initialize (void)
 972 {
 973    __gnat_init_float ();
 974 }
 975
 976 /*********************************/
 977 /* __gnat_install_handler (Lynx) */
 978 /*********************************/
 979
 980 void
 981 __gnat_install_handler (void)
 982 {
 983   __gnat_handler_installed = 1;
 984 }
 985
 986 /****************************/
 987 /* __gnat_initialize (OS/2) */
 988 /****************************/
 989
 990 #elif defined (__EMX__) /* OS/2 dependent initialization */
 991
 992 void
 993 __gnat_initialize (void)
 994 {
 995 }
 996
 997 /*********************************/
 998 /* __gnat_install_handler (OS/2) */
 999 /*********************************/
1000
1001 void
1002 __gnat_install_handler (void)
1003 {
1004   __gnat_handler_installed = 1;
1005 }
1006
1007 /***********************************/
1008 /* __gnat_initialize (SGI Version) */
1009 /***********************************/
1010
1011 #elif defined (sgi)
1012
1013 #include <signal.h>
1014 #include <siginfo.h>
1015
1016 #ifndef NULL
1017 #define NULL 0
1018 #endif
1019
1020 #define SIGADAABORT 48
1021 #define SIGNAL_STACK_SIZE 4096
1022 #define SIGNAL_STACK_ALIGNMENT 64
1023
1024 struct Machine_State
1025 {
1026   sigcontext_t context;
1027 };
1028
1029 static void __gnat_error_handler (int, int, sigcontext_t *);
1030
1031 static void
1032 __gnat_error_handler (int sig, int code, sigcontext_t *sc)
1033 {
1034   struct Machine_State  *mstate;
1035   struct Exception_Data *exception;
1036   const char *msg;
1037
1038   switch (sig)
1039     {
1040     case SIGSEGV:
1041       if (code == EFAULT)
1042         {
1043           exception = &program_error;
1044           msg = "SIGSEGV: (Invalid virtual address)";
1045         }
1046       else if (code == ENXIO)
1047         {
1048           exception = &program_error;
1049           msg = "SIGSEGV: (Read beyond mapped object)";
1050         }
1051       else if (code == ENOSPC)
1052         {
1053           exception = &program_error; /* ??? storage_error ??? */
1054           msg = "SIGSEGV: (Autogrow for file failed)";
1055         }
1056       else if (code == EACCES)
1057         {
1058           /* ??? Re-add smarts to further verify that we launched
1059                  the stack into a guard page, not an attempt to
1060                  write to .text or something */
1061           exception = &storage_error;
1062           msg = "SIGSEGV: (stack overflow or erroneous memory access)";
1063         }
1064       else
1065         {
1066           /* Just in case the OS guys did it to us again.  Sometimes
1067              they fail to document all of the valid codes that are
1068              passed to signal handlers, just in case someone depends
1069              on knowing all the codes */
1070           exception = &program_error;
1071           msg = "SIGSEGV: (Undocumented reason)";
1072         }
1073       break;
1074
1075     case SIGBUS:
1076       /* Map all bus errors to Program_Error.  */
1077       exception = &program_error;
1078       msg = "SIGBUS";
1079       break;
1080
1081     case SIGFPE:
1082       /* Map all fpe errors to Constraint_Error.  */
1083       exception = &constraint_error;
1084       msg = "SIGFPE";
1085       break;
1086
1087     case SIGADAABORT:
1088       if ((*Check_Abort_Status) ())
1089         {
1090           exception = &_abort_signal;
1091           msg = "";
1092         }
1093       else
1094         return;
1095
1096       break;
1097
1098     default:
1099       /* Everything else is a Program_Error. */
1100       exception = &program_error;
1101       msg = "unhandled signal";
1102     }
1103
1104   mstate = (*Get_Machine_State_Addr) ();
1105   if (mstate != 0)
1106     memcpy ((void *) mstate, (const void *) sc, sizeof (sigcontext_t));
1107
1108   Raise_From_Signal_Handler (exception, msg);
1109 }
1110
1111 void
1112 __gnat_install_handler (void)
1113 {
1114   struct sigaction act;
1115
1116   /* Setup signal handler to map synchronous signals to appropriate
1117      exceptions.  Make sure that the handler isn't interrupted by another
1118      signal that might cause a scheduling event! */
1119
1120   act.sa_handler = __gnat_error_handler;
1121   act.sa_flags = SA_NODEFER + SA_RESTART;
1122   sigfillset (&act.sa_mask);
1123   sigemptyset (&act.sa_mask);
1124
1125   /* Do not install handlers if interrupt state is "System" */
1126   if (__gnat_get_interrupt_state (SIGABRT) != 's')
1127     sigaction (SIGABRT, &act, NULL);
1128   if (__gnat_get_interrupt_state (SIGFPE) != 's')
1129     sigaction (SIGFPE,  &act, NULL);
1130   if (__gnat_get_interrupt_state (SIGILL) != 's')
1131     sigaction (SIGILL,  &act, NULL);
1132   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1133     sigaction (SIGSEGV, &act, NULL);
1134   if (__gnat_get_interrupt_state (SIGBUS) != 's')
1135     sigaction (SIGBUS,  &act, NULL);
1136   if (__gnat_get_interrupt_state (SIGADAABORT) != 's')
1137     sigaction (SIGADAABORT,  &act, NULL);
1138
1139   __gnat_handler_installed = 1;
1140 }
1141
1142 void
1143 __gnat_initialize (void)
1144 {
1145 }
1146
1147 /*************************************************/
1148 /* __gnat_initialize (Solaris and SunOS Version) */
1149 /*************************************************/
1150
1151 #elif defined (sun) && defined (__SVR4) && !defined (__vxworks)
1152
1153 #include <signal.h>
1154 #include <siginfo.h>
1155
1156 static void __gnat_error_handler (int, siginfo_t *);
1157
1158 static void
1159 __gnat_error_handler (int sig, siginfo_t *sip)
1160 {
1161   struct Exception_Data *exception;
1162   static int recurse = 0;
1163   const char *msg;
1164
1165   /* If this was an explicit signal from a "kill", just resignal it.  */
1166   if (SI_FROMUSER (sip))
1167     {
1168       signal (sig, SIG_DFL);
1169       kill (getpid(), sig);
1170     }
1171
1172   /* Otherwise, treat it as something we handle.  */
1173   switch (sig)
1174     {
1175     case SIGSEGV:
1176       /* If the problem was permissions, this is a constraint error.
1177          Likewise if the failing address isn't maximally aligned or if
1178          we've recursed.
1179
1180          ??? Using a static variable here isn't task-safe, but it's
1181          much too hard to do anything else and we're just determining
1182          which exception to raise.  */
1183       if (sip->si_code == SEGV_ACCERR
1184           || (((long) sip->si_addr) & 3) != 0
1185           || recurse)
1186         {
1187           exception = &constraint_error;
1188           msg = "SIGSEGV";
1189         }
1190       else
1191         {
1192           /* See if the page before the faulting page is accessible.  Do that
1193              by trying to access it.  We'd like to simply try to access
1194              4096 + the faulting address, but it's not guaranteed to be
1195              the actual address, just to be on the same page.  */
1196           recurse++;
1197           ((volatile char *)
1198            ((long) sip->si_addr & - getpagesize ()))[getpagesize ()];
1199           exception = &storage_error;
1200           msg = "stack overflow (or erroneous memory access)";
1201         }
1202       break;
1203
1204     case SIGBUS:
1205       exception = &program_error;
1206       msg = "SIGBUS";
1207       break;
1208
1209     case SIGFPE:
1210       exception = &constraint_error;
1211       msg = "SIGFPE";
1212       break;
1213
1214     default:
1215       exception = &program_error;
1216       msg = "unhandled signal";
1217     }
1218
1219   recurse = 0;
1220
1221   Raise_From_Signal_Handler (exception, msg);
1222 }
1223
1224 void
1225 __gnat_install_handler (void)
1226 {
1227   struct sigaction act;
1228
1229   /* Set up signal handler to map synchronous signals to appropriate
1230      exceptions.  Make sure that the handler isn't interrupted by another
1231      signal that might cause a scheduling event! */
1232
1233   act.sa_handler = __gnat_error_handler;
1234   act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
1235   sigemptyset (&act.sa_mask);
1236
1237   /* Do not install handlers if interrupt state is "System" */
1238   if (__gnat_get_interrupt_state (SIGABRT) != 's')
1239     sigaction (SIGABRT, &act, NULL);
1240   if (__gnat_get_interrupt_state (SIGFPE) != 's')
1241     sigaction (SIGFPE,  &act, NULL);
1242   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1243     sigaction (SIGSEGV, &act, NULL);
1244   if (__gnat_get_interrupt_state (SIGBUS) != 's')
1245     sigaction (SIGBUS,  &act, NULL);
1246
1247   __gnat_handler_installed = 1;
1248 }
1249
1250 void
1251 __gnat_initialize (void)
1252 {
1253 }
1254
1255 /***********************************/
1256 /* __gnat_initialize (VMS Version) */
1257 /***********************************/
1258
1259 #elif defined (VMS)
1260
1261 /* The prehandler actually gets control first on a condition. It swaps the
1262    stack pointer and calls the handler (__gnat_error_handler). */
1263 extern long __gnat_error_prehandler (void);
1264
1265 extern char *__gnat_error_prehandler_stack;   /* Alternate signal stack */
1266
1267 /* Conditions that don't have an Ada exception counterpart must raise
1268    Non_Ada_Error.  Since this is defined in s-auxdec, it should only be
1269    referenced by user programs, not the compiler or tools. Hence the
1270    #ifdef IN_RTS. */
1271
1272 #ifdef IN_RTS
1273 #define Non_Ada_Error system__aux_dec__non_ada_error
1274 extern struct Exception_Data Non_Ada_Error;
1275
1276 #define Coded_Exception system__vms_exception_table__coded_exception
1277 extern struct Exception_Data *Coded_Exception (int);
1278 #endif
1279
1280 /* Define macro symbols for the VMS conditions that become Ada exceptions.
1281    Most of these are also defined in the header file ssdef.h which has not
1282    yet been converted to be recoginized by Gnu C. Some, which couldn't be
1283    located, are assigned names based on the DEC test suite tests which
1284    raise them. */
1285
1286 #define SS$_ACCVIO            12
1287 #define SS$_DEBUG           1132
1288 #define SS$_INTDIV          1156
1289 #define SS$_HPARITH         1284
1290 #define SS$_STKOVF          1364
1291 #define SS$_RESIGNAL        2328
1292 #define MTH$_FLOOVEMAT   1475268       /* Some ACVC_21 CXA tests */
1293 #define SS$_CE24VRU      3253636       /* Write to unopened file */
1294 #define SS$_C980VTE      3246436       /* AST requests time slice */
1295 #define CMA$_EXIT_THREAD 4227492
1296 #define CMA$_EXCCOPLOS   4228108
1297 #define CMA$_ALERTED     4227460
1298
1299 struct descriptor_s {unsigned short len, mbz; char *adr; };
1300
1301 long __gnat_error_handler (int *, void *);
1302
1303 long
1304 __gnat_error_handler (int *sigargs, void *mechargs)
1305 {
1306   struct Exception_Data *exception = 0;
1307   char *msg = "";
1308   char message[256];
1309   long prvhnd;
1310   struct descriptor_s msgdesc;
1311   int msg_flag = 0x000f; /* 1 bit for each of the four message parts */
1312   unsigned short outlen;
1313   char curr_icb[544];
1314   long curr_invo_handle;
1315   long *mstate;
1316
1317   /* Resignaled condtions aren't effected by by pragma Import_Exception */
1318
1319   switch (sigargs[1])
1320   {
1321
1322     case CMA$_EXIT_THREAD:
1323       return SS$_RESIGNAL;
1324
1325     case SS$_DEBUG: /* Gdb attach, resignal to merge activate gdbstub. */
1326       return SS$_RESIGNAL;
1327
1328     case 1409786: /* Nickerson bug #33 ??? */
1329       return SS$_RESIGNAL;
1330
1331     case 1381050: /* Nickerson bug #33 ??? */
1332       return SS$_RESIGNAL;
1333
1334     case 11829410: /* Resignalled as Use_Error for CE10VRC */
1335       return SS$_RESIGNAL;
1336
1337   }
1338
1339 #ifdef IN_RTS
1340   /* See if it's an imported exception. Mask off severity bits. */
1341   exception = Coded_Exception (sigargs[1] & 0xfffffff8);
1342   if (exception)
1343     {
1344       msgdesc.len = 256;
1345       msgdesc.mbz = 0;
1346       msgdesc.adr = message;
1347       SYS$GETMSG (sigargs[1], &outlen, &msgdesc, msg_flag, 0);
1348       message[outlen] = 0;
1349       msg = message;
1350
1351       exception->Name_Length = 19;
1352       /* The full name really should be get sys$getmsg returns. ??? */
1353       exception->Full_Name = "IMPORTED_EXCEPTION";
1354       exception->Import_Code = sigargs[1] & 0xfffffff8;
1355     }
1356 #endif
1357
1358   if (exception == 0)
1359     switch (sigargs[1])
1360       {
1361       case SS$_ACCVIO:
1362         if (sigargs[3] == 0)
1363           {
1364             exception = &constraint_error;
1365             msg = "access zero";
1366           }
1367         else
1368           {
1369             exception = &storage_error;
1370             msg = "stack overflow (or erroneous memory access)";
1371           }
1372         break;
1373
1374       case SS$_STKOVF:
1375         exception = &storage_error;
1376         msg = "stack overflow";
1377         break;
1378
1379       case SS$_INTDIV:
1380         exception = &constraint_error;
1381         msg = "division by zero";
1382         break;
1383
1384       case SS$_HPARITH:
1385 #ifndef IN_RTS
1386         return SS$_RESIGNAL; /* toplev.c handles for compiler */
1387 #else
1388         {
1389           exception = &constraint_error;
1390           msg = "arithmetic error";
1391         }
1392 #endif
1393         break;
1394
1395       case MTH$_FLOOVEMAT:
1396         exception = &constraint_error;
1397         msg = "floating overflow in math library";
1398         break;
1399
1400       case SS$_CE24VRU:
1401         exception = &constraint_error;
1402         msg = "";
1403         break;
1404
1405       case SS$_C980VTE:
1406         exception = &program_error;
1407         msg = "";
1408         break;
1409
1410       default:
1411 #ifndef IN_RTS
1412         exception = &program_error;
1413 #else
1414         /* User programs expect Non_Ada_Error to be raised, reference
1415            DEC Ada test CXCONDHAN. */
1416         exception = &Non_Ada_Error;
1417 #endif
1418         msgdesc.len = 256;
1419         msgdesc.mbz = 0;
1420         msgdesc.adr = message;
1421         SYS$GETMSG (sigargs[1], &outlen, &msgdesc, msg_flag, 0);
1422         message[outlen] = 0;
1423         msg = message;
1424         break;
1425       }
1426
1427   mstate = (long *) (*Get_Machine_State_Addr) ();
1428   if (mstate != 0)
1429     {
1430       LIB$GET_CURR_INVO_CONTEXT (&curr_icb);
1431       LIB$GET_PREV_INVO_CONTEXT (&curr_icb);
1432       LIB$GET_PREV_INVO_CONTEXT (&curr_icb);
1433       curr_invo_handle = LIB$GET_INVO_HANDLE (&curr_icb);
1434       *mstate = curr_invo_handle;
1435     }
1436   Raise_From_Signal_Handler (exception, msg);
1437 }
1438
1439 void
1440 __gnat_install_handler (void)
1441 {
1442   long prvhnd;
1443   char *c;
1444
1445   c = (char *) xmalloc (2049);
1446
1447   __gnat_error_prehandler_stack = &c[2048];
1448
1449   /* __gnat_error_prehandler is an assembly function.  */
1450   SYS$SETEXV (1, __gnat_error_prehandler, 3, &prvhnd);
1451   __gnat_handler_installed = 1;
1452 }
1453
1454 void
1455 __gnat_initialize(void)
1456 {
1457 }
1458
1459 /*************************************************/
1460 /* __gnat_initialize (FreeBSD version) */
1461 /*************************************************/
1462
1463 #elif defined (__FreeBSD__)
1464
1465 #include <signal.h>
1466 #include <unistd.h>
1467
1468 static void
1469 __gnat_error_handler (sig, code, sc)
1470      int sig;
1471      int code;
1472      struct sigcontext *sc;
1473 {
1474   struct Exception_Data *exception;
1475   char *msg;
1476
1477   switch (sig)
1478     {
1479     case SIGFPE:
1480       exception = &constraint_error;
1481       msg = "SIGFPE";
1482       break;
1483
1484     case SIGILL:
1485       exception = &constraint_error;
1486       msg = "SIGILL";
1487       break;
1488
1489     case SIGSEGV:
1490       exception = &storage_error;
1491       msg = "stack overflow or erroneous memory access";
1492       break;
1493
1494     case SIGBUS:
1495       exception = &constraint_error;
1496       msg = "SIGBUS";
1497       break;
1498
1499     default:
1500       exception = &program_error;
1501       msg = "unhandled signal";
1502     }
1503
1504   Raise_From_Signal_Handler (exception, msg);
1505 }
1506
1507 void
1508 __gnat_install_handler ()
1509 {
1510   struct sigaction act;
1511
1512   /* Set up signal handler to map synchronous signals to appropriate
1513      exceptions.  Make sure that the handler isn't interrupted by another
1514      signal that might cause a scheduling event! */
1515
1516   act.sa_handler = __gnat_error_handler;
1517   act.sa_flags = SA_NODEFER | SA_RESTART;
1518   (void) sigemptyset (&act.sa_mask);
1519
1520   (void) sigaction (SIGILL,  &act, NULL);
1521   (void) sigaction (SIGFPE,  &act, NULL);
1522   (void) sigaction (SIGSEGV, &act, NULL);
1523   (void) sigaction (SIGBUS,  &act, NULL);
1524 }
1525
1526 void __gnat_init_float ();
1527
1528 void
1529 __gnat_initialize ()
1530 {
1531    __gnat_install_handler ();
1532
1533    /* XXX - Initialize floating-point coprocessor. This call is
1534       needed because FreeBSD defaults to 64-bit precision instead
1535       of 80-bit precision?  We require the full precision for
1536       proper operation, given that we have set Max_Digits etc
1537       with this in mind */
1538    __gnat_init_float ();
1539 }
1540
1541 /***************************************/
1542 /* __gnat_initialize (VXWorks Version) */
1543 /***************************************/
1544
1545 #elif defined(__vxworks)
1546
1547 #include <signal.h>
1548 #include <taskLib.h>
1549 #include <intLib.h>
1550 #include <iv.h>
1551
1552 extern int __gnat_inum_to_ivec (int);
1553 static void __gnat_error_handler (int, int, struct sigcontext *);
1554 void __gnat_map_signal (int);
1555
1556 #ifndef __alpha_vxworks
1557
1558 /* getpid is used by s-parint.adb, but is not defined by VxWorks, except
1559    on Alpha VxWorks */
1560
1561 extern long getpid (void);
1562
1563 long
1564 getpid (void)
1565 {
1566   return taskIdSelf ();
1567 }
1568 #endif
1569
1570 /* This is needed by the GNAT run time to handle Vxworks interrupts */
1571 int
1572 __gnat_inum_to_ivec (int num)
1573 {
1574   return INUM_TO_IVEC (num);
1575 }
1576
1577 /* Exported to 5zintman.adb in order to handle different signal
1578    to exception mappings in different VxWorks versions */
1579 void
1580 __gnat_map_signal (int sig)
1581 {
1582   struct Exception_Data *exception;
1583   char *msg;
1584
1585   switch (sig)
1586     {
1587     case SIGFPE:
1588       exception = &constraint_error;
1589       msg = "SIGFPE";
1590       break;
1591     case SIGILL:
1592       exception = &constraint_error;
1593       msg = "SIGILL";
1594       break;
1595     case SIGSEGV:
1596       exception = &program_error;
1597       msg = "SIGSEGV";
1598       break;
1599     case SIGBUS:
1600 #ifdef VTHREADS
1601       exception = &storage_error;
1602       msg = "SIGBUS: possible stack overflow";
1603 #else
1604       exception = &program_error;
1605       msg = "SIGBUS";
1606 #endif
1607       break;
1608     default:
1609       exception = &program_error;
1610       msg = "unhandled signal";
1611     }
1612
1613   Raise_From_Signal_Handler (exception, msg);
1614 }
1615
1616 static void
1617 __gnat_error_handler (int sig, int code, struct sigcontext *sc)
1618 {
1619   sigset_t mask;
1620   int result;
1621
1622   /* VxWorks will always mask out the signal during the signal handler and
1623      will reenable it on a longjmp.  GNAT does not generate a longjmp to
1624      return from a signal handler so the signal will still be masked unless
1625      we unmask it. */
1626   sigprocmask (SIG_SETMASK, NULL, &mask);
1627   sigdelset (&mask, sig);
1628   sigprocmask (SIG_SETMASK, &mask, NULL);
1629
1630   /* VxWorks will suspend the task when it gets a hardware exception.  We
1631      take the liberty of resuming the task for the application. */
1632   if (taskIsSuspended (taskIdSelf ()) != 0)
1633     taskResume (taskIdSelf ());
1634
1635   __gnat_map_signal (sig);
1636
1637 }
1638
1639 void
1640 __gnat_install_handler (void)
1641 {
1642   struct sigaction act;
1643
1644   /* Setup signal handler to map synchronous signals to appropriate
1645      exceptions.  Make sure that the handler isn't interrupted by another
1646      signal that might cause a scheduling event! */
1647
1648   act.sa_handler = __gnat_error_handler;
1649   act.sa_flags = SA_SIGINFO | SA_ONSTACK;
1650   sigemptyset (&act.sa_mask);
1651
1652   /* For VxWorks, install all signal handlers, since pragma Interrupt_State
1653      applies to vectored hardware interrupts, not signals */
1654   sigaction (SIGFPE,  &act, NULL);
1655   sigaction (SIGILL,  &act, NULL);
1656   sigaction (SIGSEGV, &act, NULL);
1657   sigaction (SIGBUS,  &act, NULL);
1658
1659   __gnat_handler_installed = 1;
1660 }
1661
1662 #define HAVE_GNAT_INIT_FLOAT
1663
1664 void
1665 __gnat_init_float (void)
1666 {
1667   /* Disable overflow/underflow exceptions on the PPC processor, this is needed
1668      to get correct Ada semantic.  */
1669 #if defined (_ARCH_PPC) && !defined (_SOFT_FLOAT)
1670   asm ("mtfsb0 25");
1671   asm ("mtfsb0 26");
1672 #endif
1673
1674   /* Similarily for sparc64. Achieved by masking bits in the Trap Enable Mask
1675      field of the Floating-point Status Register (see the Sparc Architecture
1676      Manual Version 9, p 48).  */
1677 #if defined (sparc64)
1678
1679 #define FSR_TEM_NVM (1 << 27)  /* Invalid operand  */
1680 #define FSR_TEM_OFM (1 << 26)  /* Overflow  */
1681 #define FSR_TEM_UFM (1 << 25)  /* Underflow  */
1682 #define FSR_TEM_DZM (1 << 24)  /* Division by Zero  */
1683 #define FSR_TEM_NXM (1 << 23)  /* Inexact result  */
1684   {
1685     unsigned int fsr;
1686
1687     __asm__("st %%fsr, %0" : "=m" (fsr));
1688     fsr &= ~(FSR_TEM_OFM | FSR_TEM_UFM);
1689     __asm__("ld %0, %%fsr" : : "m" (fsr));
1690   }
1691 #endif
1692 }
1693
1694 void
1695 __gnat_initialize (void)
1696 {
1697   __gnat_init_float ();
1698
1699   /* Assume an environment task stack size of 20kB.
1700
1701      Using a constant is necessary because we do not want each Ada application
1702      to depend on the optional taskShow library,
1703      which is required to get the actual stack information.
1704
1705      The consequence of this is that with -fstack-check
1706      the environment task must have an actual stack size
1707      of at least 20kB and the usable size will be about 14kB.
1708   */
1709
1710   __gnat_set_stack_size (14336);
1711   /* Allow some head room for the stack checking code, and for
1712      stack space consumed during initialization */
1713 }
1714
1715 /********************************/
1716 /* __gnat_initialize for NetBSD */
1717 /********************************/
1718
1719 #elif defined(__NetBSD__)
1720
1721 #include <signal.h>
1722 #include <unistd.h>
1723
1724 static void
1725 __gnat_error_handler (int sig)
1726 {
1727   struct Exception_Data *exception;
1728   const char *msg;
1729
1730   switch(sig)
1731   {
1732     case SIGFPE:
1733       exception = &constraint_error;
1734       msg = "SIGFPE";
1735       break;
1736     case SIGILL:
1737       exception = &constraint_error;
1738       msg = "SIGILL";
1739       break;
1740     case SIGSEGV:
1741       exception = &storage_error;
1742       msg = "stack overflow or erroneous memory access";
1743       break;
1744     case SIGBUS:
1745       exception = &constraint_error;
1746       msg = "SIGBUS";
1747       break;
1748     default:
1749       exception = &program_error;
1750       msg = "unhandled signal";
1751     }
1752
1753     Raise_From_Signal_Handler(exception, msg);
1754 }
1755
1756 void
1757 __gnat_install_handler(void)
1758 {
1759   struct sigaction act;
1760
1761   act.sa_handler = __gnat_error_handler;
1762   act.sa_flags = SA_NODEFER | SA_RESTART;
1763   sigemptyset (&act.sa_mask);
1764
1765   /* Do not install handlers if interrupt state is "System" */
1766   if (__gnat_get_interrupt_state (SIGFPE) != 's')
1767     sigaction (SIGFPE,  &act, NULL);
1768   if (__gnat_get_interrupt_state (SIGILL) != 's')
1769     sigaction (SIGILL,  &act, NULL);
1770   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1771     sigaction (SIGSEGV, &act, NULL);
1772   if (__gnat_get_interrupt_state (SIGBUS) != 's')
1773     sigaction (SIGBUS,  &act, NULL);
1774
1775   __gnat_handler_installed = 1;
1776 }
1777
1778 void
1779 __gnat_initialize (void)
1780 {
1781   __gnat_install_handler ();
1782   __gnat_init_float ();
1783 }
1784
1785 /***************************************/
1786 /* __gnat_initialize (RTEMS version) */
1787 /***************************************/
1788
1789 #elif defined(__rtems__)
1790
1791 extern void __gnat_install_handler (void);
1792
1793 /* For RTEMS, each bsp will provide a custom __gnat_install_handler (). */
1794
1795 void
1796 __gnat_initialize (void)
1797 {
1798    __gnat_install_handler ();
1799 }
1800
1801 #else
1802
1803 /* For all other versions of GNAT, the initialize routine and handler
1804    installation do nothing */
1805
1806 /***************************************/
1807 /* __gnat_initialize (Default Version) */
1808 /***************************************/
1809
1810 void
1811 __gnat_initialize (void)
1812 {
1813 }
1814
1815 /********************************************/
1816 /* __gnat_install_handler (Default Version) */
1817 /********************************************/
1818
1819 void
1820 __gnat_install_handler (void)
1821 {
1822   __gnat_handler_installed = 1;
1823 }
1824
1825 #endif
1826
1827 /*********************/
1828 /* __gnat_init_float */
1829 /*********************/
1830
1831 /* This routine is called as each process thread is created, for possible
1832    initialization of the FP processor. This version is used under INTERIX,
1833    WIN32 and could be used under OS/2 */
1834
1835 #if defined (_WIN32) || defined (__INTERIX) || defined (__EMX__) \
1836   || defined (__Lynx__) || defined(__NetBSD__) || defined(__FreeBSD__)
1837
1838 #define HAVE_GNAT_INIT_FLOAT
1839
1840 void
1841 __gnat_init_float (void)
1842 {
1843 #if defined (__i386__) || defined (i386)
1844
1845   /* This is used to properly initialize the FPU on an x86 for each
1846      process thread. */
1847
1848   asm ("finit");
1849
1850 #endif  /* Defined __i386__ */
1851 }
1852 #endif
1853
1854 #ifndef HAVE_GNAT_INIT_FLOAT
1855
1856 /* All targets without a specific __gnat_init_float will use an empty one */
1857 void
1858 __gnat_init_float (void)
1859 {
1860 }
1861 #endif