gcc/ada/init.c

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