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