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 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)
 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)
 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)
 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)
 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)
 810 {
 811 }
 812
 813 /******************************************/
 814 /* __gnat_initialize (NT-mingw32 Version) */
 815 /******************************************/
 816
 817 #elif defined (__MINGW32__)
 818 #include <windows.h>
 819
 820 static LONG WINAPI __gnat_error_handler (PEXCEPTION_POINTERS);
 821
 822 /* __gnat_initialize (mingw32).  */
 823
 824 static LONG WINAPI
 825 __gnat_error_handler (PEXCEPTION_POINTERS info)
 826 {
 827   struct Exception_Data *exception;
 828   const char *msg;
 829
 830   switch (info->ExceptionRecord->ExceptionCode)
 831     {
 832     case EXCEPTION_ACCESS_VIOLATION:
 833       /* If the failing address isn't maximally-aligned or if the page
 834          before the faulting page is not accessible, this is a program error.
 835       */
 836       if ((info->ExceptionRecord->ExceptionInformation[1] & 3) != 0
 837           || IsBadCodePtr
 838           ((void *)(info->ExceptionRecord->ExceptionInformation[1] + 4096)))
 839         {
 840           exception = &program_error;
 841           msg = "EXCEPTION_ACCESS_VIOLATION";
 842         }
 843       else
 844         {
 845           /* otherwise it is a stack overflow  */
 846           exception = &storage_error;
 847           msg = "stack overflow (or erroneous memory access)";
 848         }
 849       break;
 850
 851     case EXCEPTION_ARRAY_BOUNDS_EXCEEDED:
 852       exception = &constraint_error;
 853       msg = "EXCEPTION_ARRAY_BOUNDS_EXCEEDED";
 854       break;
 855
 856     case EXCEPTION_DATATYPE_MISALIGNMENT:
 857       exception = &constraint_error;
 858       msg = "EXCEPTION_DATATYPE_MISALIGNMENT";
 859       break;
 860
 861     case EXCEPTION_FLT_DENORMAL_OPERAND:
 862       exception = &constraint_error;
 863       msg = "EXCEPTION_FLT_DENORMAL_OPERAND";
 864       break;
 865
 866     case EXCEPTION_FLT_DIVIDE_BY_ZERO:
 867       exception = &constraint_error;
 868       msg = "EXCEPTION_FLT_DENORMAL_OPERAND";
 869       break;
 870
 871     case EXCEPTION_FLT_INVALID_OPERATION:
 872       exception = &constraint_error;
 873       msg = "EXCEPTION_FLT_INVALID_OPERATION";
 874       break;
 875
 876     case EXCEPTION_FLT_OVERFLOW:
 877       exception = &constraint_error;
 878       msg = "EXCEPTION_FLT_OVERFLOW";
 879       break;
 880
 881     case EXCEPTION_FLT_STACK_CHECK:
 882       exception = &program_error;
 883       msg = "EXCEPTION_FLT_STACK_CHECK";
 884       break;
 885
 886     case EXCEPTION_FLT_UNDERFLOW:
 887       exception = &constraint_error;
 888       msg = "EXCEPTION_FLT_UNDERFLOW";
 889       break;
 890
 891     case EXCEPTION_INT_DIVIDE_BY_ZERO:
 892       exception = &constraint_error;
 893       msg = "EXCEPTION_INT_DIVIDE_BY_ZERO";
 894       break;
 895
 896     case EXCEPTION_INT_OVERFLOW:
 897       exception = &constraint_error;
 898       msg = "EXCEPTION_INT_OVERFLOW";
 899       break;
 900
 901     case EXCEPTION_INVALID_DISPOSITION:
 902       exception = &program_error;
 903       msg = "EXCEPTION_INVALID_DISPOSITION";
 904       break;
 905
 906     case EXCEPTION_NONCONTINUABLE_EXCEPTION:
 907       exception = &program_error;
 908       msg = "EXCEPTION_NONCONTINUABLE_EXCEPTION";
 909       break;
 910
 911     case EXCEPTION_PRIV_INSTRUCTION:
 912       exception = &program_error;
 913       msg = "EXCEPTION_PRIV_INSTRUCTION";
 914       break;
 915
 916     case EXCEPTION_SINGLE_STEP:
 917       exception = &program_error;
 918       msg = "EXCEPTION_SINGLE_STEP";
 919       break;
 920
 921     case EXCEPTION_STACK_OVERFLOW:
 922       exception = &storage_error;
 923       msg = "EXCEPTION_STACK_OVERFLOW";
 924       break;
 925
 926    default:
 927       exception = &program_error;
 928       msg = "unhandled signal";
 929     }
 930
 931   Raise_From_Signal_Handler (exception, msg);
 932   return 0; /* This is never reached, avoid compiler warning */
 933 }
 934
 935 void
 936 __gnat_install_handler (void)
 937 {
 938   SetUnhandledExceptionFilter (__gnat_error_handler);
 939   __gnat_handler_installed = 1;
 940 }
 941
 942 void
 943 __gnat_initialize (void)
 944 {
 945
 946    /* Initialize floating-point coprocessor. This call is needed because
 947       the MS libraries default to 64-bit precision instead of 80-bit
 948       precision, and we require the full precision for proper operation,
 949       given that we have set Max_Digits etc with this in mind */
 950
 951    __gnat_init_float ();
 952
 953    /* initialize a lock for a process handle list - see a-adaint.c for the
 954       implementation of __gnat_portable_no_block_spawn, __gnat_portable_wait */
 955    __gnat_plist_init();
 956 }
 957
 958 /***************************************/
 959 /* __gnat_initialize (Interix Version) */
 960 /***************************************/
 961
 962 #elif defined (__INTERIX)
 963
 964 #include <signal.h>
 965
 966 static void __gnat_error_handler (int);
 967
 968 static void
 969 __gnat_error_handler (int sig)
 970 {
 971   struct Exception_Data *exception;
 972   char *msg;
 973
 974   switch (sig)
 975     {
 976     case SIGSEGV:
 977       exception = &storage_error;
 978       msg = "stack overflow or erroneous memory access";
 979       break;
 980
 981     case SIGBUS:
 982       exception = &constraint_error;
 983       msg = "SIGBUS";
 984       break;
 985
 986     case SIGFPE:
 987       exception = &constraint_error;
 988       msg = "SIGFPE";
 989       break;
 990
 991     default:
 992       exception = &program_error;
 993       msg = "unhandled signal";
 994     }
 995
 996   Raise_From_Signal_Handler (exception, msg);
 997 }
 998
 999 void
1000 __gnat_install_handler (void)
1001 {
1002   struct sigaction act;
1003
1004   /* Set up signal handler to map synchronous signals to appropriate
1005      exceptions.  Make sure that the handler isn't interrupted by another
1006      signal that might cause a scheduling event! */
1007
1008   act.sa_handler = __gnat_error_handler;
1009   act.sa_flags = 0;
1010   sigemptyset (&act.sa_mask);
1011
1012   /* Handlers for signals besides SIGSEGV cause c974013 to hang */
1013 /*  sigaction (SIGILL,  &act, NULL); */
1014 /*  sigaction (SIGABRT, &act, NULL); */
1015 /*  sigaction (SIGFPE,  &act, NULL); */
1016 /*  sigaction (SIGBUS,  &act, NULL); */
1017
1018   /* Do not install handlers if interrupt state is "System" */
1019   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1020     sigaction (SIGSEGV, &act, NULL);
1021
1022   __gnat_handler_installed = 1;
1023 }
1024
1025 void
1026 __gnat_initialize (void)
1027 {
1028    __gnat_init_float ();
1029 }
1030
1031 /**************************************/
1032 /* __gnat_initialize (LynxOS Version) */
1033 /**************************************/
1034
1035 #elif defined (__Lynx__)
1036
1037 void
1038 __gnat_initialize (void)
1039 {
1040    __gnat_init_float ();
1041 }
1042
1043 /*********************************/
1044 /* __gnat_install_handler (Lynx) */
1045 /*********************************/
1046
1047 void
1048 __gnat_install_handler (void)
1049 {
1050   __gnat_handler_installed = 1;
1051 }
1052
1053 /****************************/
1054 /* __gnat_initialize (OS/2) */
1055 /****************************/
1056
1057 #elif defined (__EMX__) /* OS/2 dependent initialization */
1058
1059 void
1060 __gnat_initialize (void)
1061 {
1062 }
1063
1064 /*********************************/
1065 /* __gnat_install_handler (OS/2) */
1066 /*********************************/
1067
1068 void
1069 __gnat_install_handler (void)
1070 {
1071   __gnat_handler_installed = 1;
1072 }
1073
1074 /***********************************/
1075 /* __gnat_initialize (SGI Version) */
1076 /***********************************/
1077
1078 #elif defined (sgi)
1079
1080 #include <signal.h>
1081 #include <siginfo.h>
1082
1083 #ifndef NULL
1084 #define NULL 0
1085 #endif
1086
1087 #define SIGADAABORT 48
1088 #define SIGNAL_STACK_SIZE 4096
1089 #define SIGNAL_STACK_ALIGNMENT 64
1090
1091 struct Machine_State
1092 {
1093   sigcontext_t context;
1094 };
1095
1096 static void __gnat_error_handler (int, int, sigcontext_t *);
1097
1098 /* We are not setting the SA_SIGINFO bit in the sigaction flags when
1099    connecting that handler, with the effects described in the sigaction
1100    man page:
1101
1102           SA_SIGINFO [...]
1103           If cleared and the signal is caught, the first argument is
1104           also the signal number but the second argument is the signal
1105           code identifying the cause of the signal. The third argument
1106           points to a sigcontext_t structure containing the receiving
1107           process's context when the signal was delivered.
1108 */
1109
1110 static void
1111 __gnat_error_handler (int sig, int code, sigcontext_t *sc)
1112 {
1113   struct Machine_State  *mstate;
1114   struct Exception_Data *exception;
1115   const char *msg;
1116
1117   switch (sig)
1118     {
1119     case SIGSEGV:
1120       if (code == EFAULT)
1121         {
1122           exception = &program_error;
1123           msg = "SIGSEGV: (Invalid virtual address)";
1124         }
1125       else if (code == ENXIO)
1126         {
1127           exception = &program_error;
1128           msg = "SIGSEGV: (Read beyond mapped object)";
1129         }
1130       else if (code == ENOSPC)
1131         {
1132           exception = &program_error; /* ??? storage_error ??? */
1133           msg = "SIGSEGV: (Autogrow for file failed)";
1134         }
1135       else if (code == EACCES || code == EEXIST)
1136         {
1137           /* ??? We handle stack overflows here, some of which do trigger
1138                  SIGSEGV + EEXIST on Irix 6.5 although EEXIST is not part of
1139                  the documented valid codes for SEGV in the signal(5) man
1140                  page.  */
1141
1142           /* ??? Re-add smarts to further verify that we launched
1143                  the stack into a guard page, not an attempt to
1144                  write to .text or something */
1145           exception = &storage_error;
1146           msg = "SIGSEGV: (stack overflow or erroneous memory access)";
1147         }
1148       else
1149         {
1150           /* Just in case the OS guys did it to us again.  Sometimes
1151              they fail to document all of the valid codes that are
1152              passed to signal handlers, just in case someone depends
1153              on knowing all the codes */
1154           exception = &program_error;
1155           msg = "SIGSEGV: (Undocumented reason)";
1156         }
1157       break;
1158
1159     case SIGBUS:
1160       /* Map all bus errors to Program_Error.  */
1161       exception = &program_error;
1162       msg = "SIGBUS";
1163       break;
1164
1165     case SIGFPE:
1166       /* Map all fpe errors to Constraint_Error.  */
1167       exception = &constraint_error;
1168       msg = "SIGFPE";
1169       break;
1170
1171     case SIGADAABORT:
1172       if ((*Check_Abort_Status) ())
1173         {
1174           exception = &_abort_signal;
1175           msg = "";
1176         }
1177       else
1178         return;
1179
1180       break;
1181
1182     default:
1183       /* Everything else is a Program_Error. */
1184       exception = &program_error;
1185       msg = "unhandled signal";
1186     }
1187
1188   mstate = (*Get_Machine_State_Addr) ();
1189   if (mstate != 0)
1190     memcpy ((void *) mstate, (const void *) sc, sizeof (sigcontext_t));
1191
1192   Raise_From_Signal_Handler (exception, msg);
1193 }
1194
1195 void
1196 __gnat_install_handler (void)
1197 {
1198   struct sigaction act;
1199
1200   /* Setup signal handler to map synchronous signals to appropriate
1201      exceptions.  Make sure that the handler isn't interrupted by another
1202      signal that might cause a scheduling event! */
1203
1204   act.sa_handler = __gnat_error_handler;
1205   act.sa_flags = SA_NODEFER + SA_RESTART;
1206   sigfillset (&act.sa_mask);
1207   sigemptyset (&act.sa_mask);
1208
1209   /* Do not install handlers if interrupt state is "System" */
1210   if (__gnat_get_interrupt_state (SIGABRT) != 's')
1211     sigaction (SIGABRT, &act, NULL);
1212   if (__gnat_get_interrupt_state (SIGFPE) != 's')
1213     sigaction (SIGFPE,  &act, NULL);
1214   if (__gnat_get_interrupt_state (SIGILL) != 's')
1215     sigaction (SIGILL,  &act, NULL);
1216   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1217     sigaction (SIGSEGV, &act, NULL);
1218   if (__gnat_get_interrupt_state (SIGBUS) != 's')
1219     sigaction (SIGBUS,  &act, NULL);
1220   if (__gnat_get_interrupt_state (SIGADAABORT) != 's')
1221     sigaction (SIGADAABORT,  &act, NULL);
1222
1223   __gnat_handler_installed = 1;
1224 }
1225
1226 void
1227 __gnat_initialize (void)
1228 {
1229 }
1230
1231 /*************************************************/
1232 /* __gnat_initialize (Solaris and SunOS Version) */
1233 /*************************************************/
1234
1235 #elif defined (sun) && defined (__SVR4) && !defined (__vxworks)
1236
1237 #include <signal.h>
1238 #include <siginfo.h>
1239
1240 static void __gnat_error_handler (int, siginfo_t *);
1241
1242 static void
1243 __gnat_error_handler (int sig, siginfo_t *sip)
1244 {
1245   struct Exception_Data *exception;
1246   static int recurse = 0;
1247   const char *msg;
1248
1249   /* If this was an explicit signal from a "kill", just resignal it.  */
1250   if (SI_FROMUSER (sip))
1251     {
1252       signal (sig, SIG_DFL);
1253       kill (getpid(), sig);
1254     }
1255
1256   /* Otherwise, treat it as something we handle.  */
1257   switch (sig)
1258     {
1259     case SIGSEGV:
1260       /* If the problem was permissions, this is a constraint error.
1261          Likewise if the failing address isn't maximally aligned or if
1262          we've recursed.
1263
1264          ??? Using a static variable here isn't task-safe, but it's
1265          much too hard to do anything else and we're just determining
1266          which exception to raise.  */
1267       if (sip->si_code == SEGV_ACCERR
1268           || (((long) sip->si_addr) & 3) != 0
1269           || recurse)
1270         {
1271           exception = &constraint_error;
1272           msg = "SIGSEGV";
1273         }
1274       else
1275         {
1276           /* See if the page before the faulting page is accessible.  Do that
1277              by trying to access it.  We'd like to simply try to access
1278              4096 + the faulting address, but it's not guaranteed to be
1279              the actual address, just to be on the same page.  */
1280           recurse++;
1281           ((volatile char *)
1282            ((long) sip->si_addr & - getpagesize ()))[getpagesize ()];
1283           exception = &storage_error;
1284           msg = "stack overflow (or erroneous memory access)";
1285         }
1286       break;
1287
1288     case SIGBUS:
1289       exception = &program_error;
1290       msg = "SIGBUS";
1291       break;
1292
1293     case SIGFPE:
1294       exception = &constraint_error;
1295       msg = "SIGFPE";
1296       break;
1297
1298     default:
1299       exception = &program_error;
1300       msg = "unhandled signal";
1301     }
1302
1303   recurse = 0;
1304
1305   Raise_From_Signal_Handler (exception, msg);
1306 }
1307
1308 void
1309 __gnat_install_handler (void)
1310 {
1311   struct sigaction act;
1312
1313   /* Set up signal handler to map synchronous signals to appropriate
1314      exceptions.  Make sure that the handler isn't interrupted by another
1315      signal that might cause a scheduling event! */
1316
1317   act.sa_handler = __gnat_error_handler;
1318   act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
1319   sigemptyset (&act.sa_mask);
1320
1321   /* Do not install handlers if interrupt state is "System" */
1322   if (__gnat_get_interrupt_state (SIGABRT) != 's')
1323     sigaction (SIGABRT, &act, NULL);
1324   if (__gnat_get_interrupt_state (SIGFPE) != 's')
1325     sigaction (SIGFPE,  &act, NULL);
1326   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1327     sigaction (SIGSEGV, &act, NULL);
1328   if (__gnat_get_interrupt_state (SIGBUS) != 's')
1329     sigaction (SIGBUS,  &act, NULL);
1330
1331   __gnat_handler_installed = 1;
1332 }
1333
1334 void
1335 __gnat_initialize (void)
1336 {
1337 }
1338
1339 /***********************************/
1340 /* __gnat_initialize (VMS Version) */
1341 /***********************************/
1342
1343 #elif defined (VMS)
1344
1345 #ifdef __IA64
1346 #define lib_get_curr_invo_context LIB$I64_GET_CURR_INVO_CONTEXT
1347 #define lib_get_prev_invo_context LIB$I64_GET_PREV_INVO_CONTEXT
1348 #define lib_get_invo_handle LIB$I64_GET_INVO_HANDLE
1349 #else
1350 #define lib_get_curr_invo_context LIB$GET_CURR_INVO_CONTEXT
1351 #define lib_get_prev_invo_context LIB$GET_PREV_INVO_CONTEXT
1352 #define lib_get_invo_handle LIB$GET_INVO_HANDLE
1353 #endif
1354
1355 #if defined (IN_RTS) && !defined (__IA64)
1356
1357 /* The prehandler actually gets control first on a condition. It swaps the
1358    stack pointer and calls the handler (__gnat_error_handler). */
1359 extern long __gnat_error_prehandler (void);
1360
1361 extern char *__gnat_error_prehandler_stack;   /* Alternate signal stack */
1362 #endif
1363
1364 /* Conditions that don't have an Ada exception counterpart must raise
1365    Non_Ada_Error.  Since this is defined in s-auxdec, it should only be
1366    referenced by user programs, not the compiler or tools. Hence the
1367    #ifdef IN_RTS. */
1368
1369 #ifdef IN_RTS
1370 #define Non_Ada_Error system__aux_dec__non_ada_error
1371 extern struct Exception_Data Non_Ada_Error;
1372
1373 #define Coded_Exception system__vms_exception_table__coded_exception
1374 extern struct Exception_Data *Coded_Exception (Exception_Code);
1375
1376 #define Base_Code_In system__vms_exception_table__base_code_in
1377 extern Exception_Code Base_Code_In (Exception_Code);
1378 #endif
1379
1380 /* Define macro symbols for the VMS conditions that become Ada exceptions.
1381    Most of these are also defined in the header file ssdef.h which has not
1382    yet been converted to be recoginized by Gnu C. Some, which couldn't be
1383    located, are assigned names based on the DEC test suite tests which
1384    raise them. */
1385
1386 #define SS$_ACCVIO            12
1387 #define SS$_DEBUG           1132
1388 #define SS$_INTDIV          1156
1389 #define SS$_HPARITH         1284
1390 #define SS$_STKOVF          1364
1391 #define SS$_RESIGNAL        2328
1392 #define MTH$_FLOOVEMAT   1475268       /* Some ACVC_21 CXA tests */
1393 #define SS$_CE24VRU      3253636       /* Write to unopened file */
1394 #define SS$_C980VTE      3246436       /* AST requests time slice */
1395 #define CMA$_EXIT_THREAD 4227492
1396 #define CMA$_EXCCOPLOS   4228108
1397 #define CMA$_ALERTED     4227460
1398
1399 struct descriptor_s {unsigned short len, mbz; char *adr; };
1400
1401 long __gnat_error_handler (int *, void *);
1402
1403 long
1404 __gnat_error_handler (int *sigargs, void *mechargs)
1405 {
1406   struct Exception_Data *exception = 0;
1407   Exception_Code base_code;
1408
1409   char *msg = "";
1410   char message[256];
1411   long prvhnd;
1412   struct descriptor_s msgdesc;
1413   int msg_flag = 0x000f; /* 1 bit for each of the four message parts */
1414   unsigned short outlen;
1415   char curr_icb[544];
1416   long curr_invo_handle;
1417   long *mstate;
1418
1419   /* Resignaled condtions aren't effected by by pragma Import_Exception */
1420
1421   switch (sigargs[1])
1422   {
1423
1424     case CMA$_EXIT_THREAD:
1425       return SS$_RESIGNAL;
1426
1427     case SS$_DEBUG: /* Gdb attach, resignal to merge activate gdbstub. */
1428       return SS$_RESIGNAL;
1429
1430     case 1409786: /* Nickerson bug #33 ??? */
1431       return SS$_RESIGNAL;
1432
1433     case 1381050: /* Nickerson bug #33 ??? */
1434       return SS$_RESIGNAL;
1435
1436     case 20480426: /* RDB-E-STREAM_EOF */
1437       return SS$_RESIGNAL;
1438
1439     case 11829410: /* Resignalled as Use_Error for CE10VRC */
1440       return SS$_RESIGNAL;
1441
1442   }
1443
1444 #ifdef IN_RTS
1445   /* See if it's an imported exception. Beware that registered exceptions
1446      are bound to their base code, with the severity bits masked off.  */
1447   base_code = Base_Code_In ((Exception_Code) sigargs [1]);
1448   exception = Coded_Exception (base_code);
1449
1450   if (exception)
1451     {
1452       msgdesc.len = 256;
1453       msgdesc.mbz = 0;
1454       msgdesc.adr = message;
1455       SYS$GETMSG (sigargs[1], &outlen, &msgdesc, msg_flag, 0);
1456       message[outlen] = 0;
1457       msg = message;
1458
1459       exception->Name_Length = 19;
1460       /* The full name really should be get sys$getmsg returns. ??? */
1461       exception->Full_Name = "IMPORTED_EXCEPTION";
1462       exception->Import_Code = base_code;
1463     }
1464 #endif
1465
1466   if (exception == 0)
1467     switch (sigargs[1])
1468       {
1469       case SS$_ACCVIO:
1470         if (sigargs[3] == 0)
1471           {
1472             exception = &constraint_error;
1473             msg = "access zero";
1474           }
1475         else
1476           {
1477             exception = &storage_error;
1478             msg = "stack overflow (or erroneous memory access)";
1479           }
1480         break;
1481
1482       case SS$_STKOVF:
1483         exception = &storage_error;
1484         msg = "stack overflow";
1485         break;
1486
1487       case SS$_INTDIV:
1488         exception = &constraint_error;
1489         msg = "division by zero";
1490         break;
1491
1492       case SS$_HPARITH:
1493 #ifndef IN_RTS
1494         return SS$_RESIGNAL; /* toplev.c handles for compiler */
1495 #else
1496         {
1497           exception = &constraint_error;
1498           msg = "arithmetic error";
1499         }
1500 #endif
1501         break;
1502
1503       case MTH$_FLOOVEMAT:
1504         exception = &constraint_error;
1505         msg = "floating overflow in math library";
1506         break;
1507
1508       case SS$_CE24VRU:
1509         exception = &constraint_error;
1510         msg = "";
1511         break;
1512
1513       case SS$_C980VTE:
1514         exception = &program_error;
1515         msg = "";
1516         break;
1517
1518       default:
1519 #ifndef IN_RTS
1520         exception = &program_error;
1521 #else
1522         /* User programs expect Non_Ada_Error to be raised, reference
1523            DEC Ada test CXCONDHAN. */
1524         exception = &Non_Ada_Error;
1525 #endif
1526         msgdesc.len = 256;
1527         msgdesc.mbz = 0;
1528         msgdesc.adr = message;
1529         SYS$GETMSG (sigargs[1], &outlen, &msgdesc, msg_flag, 0);
1530         message[outlen] = 0;
1531         msg = message;
1532         break;
1533       }
1534
1535   mstate = (long *) (*Get_Machine_State_Addr) ();
1536   if (mstate != 0)
1537     {
1538       lib_get_curr_invo_context (&curr_icb);
1539       lib_get_prev_invo_context (&curr_icb);
1540       lib_get_prev_invo_context (&curr_icb);
1541       curr_invo_handle = lib_get_invo_handle (&curr_icb);
1542       *mstate = curr_invo_handle;
1543     }
1544   Raise_From_Signal_Handler (exception, msg);
1545 }
1546
1547 void
1548 __gnat_install_handler (void)
1549 {
1550   long prvhnd;
1551 #if defined (IN_RTS) && !defined (__IA64)
1552   char *c;
1553
1554   c = (char *) xmalloc (2049);
1555
1556   __gnat_error_prehandler_stack = &c[2048];
1557
1558   /* __gnat_error_prehandler is an assembly function.  */
1559   SYS$SETEXV (1, __gnat_error_prehandler, 3, &prvhnd);
1560 #else
1561   SYS$SETEXV (1, __gnat_error_handler, 3, &prvhnd);
1562 #endif
1563   __gnat_handler_installed = 1;
1564 }
1565
1566 void
1567 __gnat_initialize(void)
1568 {
1569 }
1570
1571 /*************************************************/
1572 /* __gnat_initialize (FreeBSD version) */
1573 /*************************************************/
1574
1575 #elif defined (__FreeBSD__)
1576
1577 #include <signal.h>
1578 #include <unistd.h>
1579
1580 static void
1581 __gnat_error_handler (sig, code, sc)
1582      int sig;
1583      int code;
1584      struct sigcontext *sc;
1585 {
1586   struct Exception_Data *exception;
1587   char *msg;
1588
1589   switch (sig)
1590     {
1591     case SIGFPE:
1592       exception = &constraint_error;
1593       msg = "SIGFPE";
1594       break;
1595
1596     case SIGILL:
1597       exception = &constraint_error;
1598       msg = "SIGILL";
1599       break;
1600
1601     case SIGSEGV:
1602       exception = &storage_error;
1603       msg = "stack overflow or erroneous memory access";
1604       break;
1605
1606     case SIGBUS:
1607       exception = &constraint_error;
1608       msg = "SIGBUS";
1609       break;
1610
1611     default:
1612       exception = &program_error;
1613       msg = "unhandled signal";
1614     }
1615
1616   Raise_From_Signal_Handler (exception, msg);
1617 }
1618
1619 void
1620 __gnat_install_handler ()
1621 {
1622   struct sigaction act;
1623
1624   /* Set up signal handler to map synchronous signals to appropriate
1625      exceptions.  Make sure that the handler isn't interrupted by another
1626      signal that might cause a scheduling event! */
1627
1628   act.sa_handler = __gnat_error_handler;
1629   act.sa_flags = SA_NODEFER | SA_RESTART;
1630   (void) sigemptyset (&act.sa_mask);
1631
1632   (void) sigaction (SIGILL,  &act, NULL);
1633   (void) sigaction (SIGFPE,  &act, NULL);
1634   (void) sigaction (SIGSEGV, &act, NULL);
1635   (void) sigaction (SIGBUS,  &act, NULL);
1636 }
1637
1638 void __gnat_init_float ();
1639
1640 void
1641 __gnat_initialize ()
1642 {
1643    __gnat_install_handler ();
1644
1645    /* XXX - Initialize floating-point coprocessor. This call is
1646       needed because FreeBSD defaults to 64-bit precision instead
1647       of 80-bit precision?  We require the full precision for
1648       proper operation, given that we have set Max_Digits etc
1649       with this in mind */
1650    __gnat_init_float ();
1651 }
1652
1653 /***************************************/
1654 /* __gnat_initialize (VXWorks Version) */
1655 /***************************************/
1656
1657 #elif defined(__vxworks)
1658
1659 #include <signal.h>
1660 #include <taskLib.h>
1661 #include <intLib.h>
1662 #include <iv.h>
1663
1664 extern int __gnat_inum_to_ivec (int);
1665 static void __gnat_error_handler (int, int, struct sigcontext *);
1666 void __gnat_map_signal (int);
1667
1668 #ifndef __alpha_vxworks
1669
1670 /* getpid is used by s-parint.adb, but is not defined by VxWorks, except
1671    on Alpha VxWorks */
1672
1673 extern long getpid (void);
1674
1675 long
1676 getpid (void)
1677 {
1678   return taskIdSelf ();
1679 }
1680 #endif
1681
1682 /* This is needed by the GNAT run time to handle Vxworks interrupts */
1683 int
1684 __gnat_inum_to_ivec (int num)
1685 {
1686   return INUM_TO_IVEC (num);
1687 }
1688
1689 /* Exported to 5zintman.adb in order to handle different signal
1690    to exception mappings in different VxWorks versions */
1691 void
1692 __gnat_map_signal (int sig)
1693 {
1694   struct Exception_Data *exception;
1695   char *msg;
1696
1697   switch (sig)
1698     {
1699     case SIGFPE:
1700       exception = &constraint_error;
1701       msg = "SIGFPE";
1702       break;
1703     case SIGILL:
1704       exception = &constraint_error;
1705       msg = "SIGILL";
1706       break;
1707 #ifdef VTHREADS
1708     case SIGSEGV:
1709       exception = &storage_error;
1710       msg = "SIGSEGV: possible stack overflow";
1711       break;
1712     case SIGBUS:
1713       exception = &storage_error;
1714       msg = "SIGBUS: possible stack overflow";
1715       break;
1716 #else
1717     case SIGSEGV:
1718       exception = &program_error;
1719       msg = "SIGSEGV";
1720       break;
1721     case SIGBUS:
1722       exception = &program_error;
1723       msg = "SIGBUS";
1724       break;
1725 #endif
1726     default:
1727       exception = &program_error;
1728       msg = "unhandled signal";
1729     }
1730
1731   Raise_From_Signal_Handler (exception, msg);
1732 }
1733
1734 static void
1735 __gnat_error_handler (int sig, int code, struct sigcontext *sc)
1736 {
1737   sigset_t mask;
1738   int result;
1739
1740   /* VxWorks will always mask out the signal during the signal handler and
1741      will reenable it on a longjmp.  GNAT does not generate a longjmp to
1742      return from a signal handler so the signal will still be masked unless
1743      we unmask it. */
1744   sigprocmask (SIG_SETMASK, NULL, &mask);
1745   sigdelset (&mask, sig);
1746   sigprocmask (SIG_SETMASK, &mask, NULL);
1747
1748   /* VxWorks will suspend the task when it gets a hardware exception.  We
1749      take the liberty of resuming the task for the application. */
1750   if (taskIsSuspended (taskIdSelf ()) != 0)
1751     taskResume (taskIdSelf ());
1752
1753   __gnat_map_signal (sig);
1754
1755 }
1756
1757 void
1758 __gnat_install_handler (void)
1759 {
1760   struct sigaction act;
1761
1762   /* Setup signal handler to map synchronous signals to appropriate
1763      exceptions.  Make sure that the handler isn't interrupted by another
1764      signal that might cause a scheduling event! */
1765
1766   act.sa_handler = __gnat_error_handler;
1767   act.sa_flags = SA_SIGINFO | SA_ONSTACK;
1768   sigemptyset (&act.sa_mask);
1769
1770   /* For VxWorks, install all signal handlers, since pragma Interrupt_State
1771      applies to vectored hardware interrupts, not signals */
1772   sigaction (SIGFPE,  &act, NULL);
1773   sigaction (SIGILL,  &act, NULL);
1774   sigaction (SIGSEGV, &act, NULL);
1775   sigaction (SIGBUS,  &act, NULL);
1776
1777   __gnat_handler_installed = 1;
1778 }
1779
1780 #define HAVE_GNAT_INIT_FLOAT
1781
1782 void
1783 __gnat_init_float (void)
1784 {
1785   /* Disable overflow/underflow exceptions on the PPC processor, this is needed
1786      to get correct Ada semantics.  Note that for AE653 vThreads, the HW
1787      overflow settings are an OS configuration issue.  The instructions
1788      below have no effect */
1789 #if defined (_ARCH_PPC) && !defined (_SOFT_FLOAT) && !defined (VTHREADS)
1790   asm ("mtfsb0 25");
1791   asm ("mtfsb0 26");
1792 #endif
1793
1794   /* Similarily for sparc64. Achieved by masking bits in the Trap Enable Mask
1795      field of the Floating-point Status Register (see the Sparc Architecture
1796      Manual Version 9, p 48).  */
1797 #if defined (sparc64)
1798
1799 #define FSR_TEM_NVM (1 << 27)  /* Invalid operand  */
1800 #define FSR_TEM_OFM (1 << 26)  /* Overflow  */
1801 #define FSR_TEM_UFM (1 << 25)  /* Underflow  */
1802 #define FSR_TEM_DZM (1 << 24)  /* Division by Zero  */
1803 #define FSR_TEM_NXM (1 << 23)  /* Inexact result  */
1804   {
1805     unsigned int fsr;
1806
1807     __asm__("st %%fsr, %0" : "=m" (fsr));
1808     fsr &= ~(FSR_TEM_OFM | FSR_TEM_UFM);
1809     __asm__("ld %0, %%fsr" : : "m" (fsr));
1810   }
1811 #endif
1812 }
1813
1814 void
1815 __gnat_initialize (void)
1816 {
1817   __gnat_init_float ();
1818
1819   /* On targets where we might be using the ZCX scheme, we need to register
1820      the frame tables.
1821
1822      For applications loaded as a set of "modules", the crtstuff objects
1823      linked in (crtbegin/endS) are tailored to provide this service a-la C++
1824      static constructor fashion, typically triggered by the VxWorks loader.
1825      This is achieved by way of a special variable declaration in the crt
1826      object, the name of which has been deduced by analyzing the output of the
1827      "munching" step documented for C++.  The de-registration call is handled
1828      symetrically, a-la C++ destructor fashion and typically triggered by the
1829      dynamic unloader. Note that since the tables shall be registered against
1830      a common datastructure, libgcc should be one of the modules (vs beeing
1831      partially linked against all the others at build time) and shall be
1832      loaded first.
1833
1834      For applications linked with the kernel, the scheme above would lead to
1835      duplicated symbols because the VxWorks kernel build "munches" by default.
1836      To prevent those conflicts, we link against crtbegin/end objects that
1837      don't include the special variable and directly call the appropriate
1838      function here. We'll never unload that, so there is no de-registration to
1839      worry about.
1840
1841      For whole applications loaded as a single module, we may use one scheme
1842      or the other, except for the mixed Ada/C++ case in which the first scheme
1843      would fail for the same reason as in the linked-with-kernel situation.
1844
1845      We can differentiate by looking at the __module_has_ctors value provided
1846      by each class of crt objects. As of today, selecting the crt set with the
1847      static ctors/dtors capabilities (first scheme above) is triggered by
1848      adding "-static" to the gcc *link* command line options. Without this,
1849      the other set of crt objects is fetched.
1850
1851      This is a first approach, tightly synchronized with a number of GCC
1852      configuration and crtstuff changes. We need to ensure that those changes
1853      are there to activate this circuitry.  */
1854
1855 #if DWARF2_UNWIND_INFO && defined (_ARCH_PPC)
1856  {
1857    /* The scheme described above is only useful for the actual ZCX case, and
1858       we don't want any reference to the crt provided symbols otherwise.  We
1859       may not link with any of the crt objects in the non-ZCX case, e.g. from
1860       documented procedures instructing the use of -nostdlib, and references
1861       to the ctors symbols here would just remain unsatisfied.
1862
1863       We have no way to avoid those references in the right conditions in this
1864       C module, because we have nothing like a IN_ZCX_RTS macro.  This aspect
1865       is then deferred to an Ada routine, which can do that based on a test
1866       against a constant System flag value.  */
1867
1868    extern void __gnat_vxw_setup_for_eh (void);
1869    __gnat_vxw_setup_for_eh ();
1870  }
1871 #endif
1872 }
1873
1874 /********************************/
1875 /* __gnat_initialize for NetBSD */
1876 /********************************/
1877
1878 #elif defined(__NetBSD__)
1879
1880 #include <signal.h>
1881 #include <unistd.h>
1882
1883 static void
1884 __gnat_error_handler (int sig)
1885 {
1886   struct Exception_Data *exception;
1887   const char *msg;
1888
1889   switch(sig)
1890   {
1891     case SIGFPE:
1892       exception = &constraint_error;
1893       msg = "SIGFPE";
1894       break;
1895     case SIGILL:
1896       exception = &constraint_error;
1897       msg = "SIGILL";
1898       break;
1899     case SIGSEGV:
1900       exception = &storage_error;
1901       msg = "stack overflow or erroneous memory access";
1902       break;
1903     case SIGBUS:
1904       exception = &constraint_error;
1905       msg = "SIGBUS";
1906       break;
1907     default:
1908       exception = &program_error;
1909       msg = "unhandled signal";
1910     }
1911
1912     Raise_From_Signal_Handler(exception, msg);
1913 }
1914
1915 void
1916 __gnat_install_handler(void)
1917 {
1918   struct sigaction act;
1919
1920   act.sa_handler = __gnat_error_handler;
1921   act.sa_flags = SA_NODEFER | SA_RESTART;
1922   sigemptyset (&act.sa_mask);
1923
1924   /* Do not install handlers if interrupt state is "System" */
1925   if (__gnat_get_interrupt_state (SIGFPE) != 's')
1926     sigaction (SIGFPE,  &act, NULL);
1927   if (__gnat_get_interrupt_state (SIGILL) != 's')
1928     sigaction (SIGILL,  &act, NULL);
1929   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1930     sigaction (SIGSEGV, &act, NULL);
1931   if (__gnat_get_interrupt_state (SIGBUS) != 's')
1932     sigaction (SIGBUS,  &act, NULL);
1933
1934   __gnat_handler_installed = 1;
1935 }
1936
1937 void
1938 __gnat_initialize (void)
1939 {
1940   __gnat_install_handler ();
1941   __gnat_init_float ();
1942 }
1943
1944 #else
1945
1946 /* For all other versions of GNAT, the initialize routine and handler
1947    installation do nothing */
1948
1949 /***************************************/
1950 /* __gnat_initialize (Default Version) */
1951 /***************************************/
1952
1953 void
1954 __gnat_initialize (void)
1955 {
1956 }
1957
1958 /********************************************/
1959 /* __gnat_install_handler (Default Version) */
1960 /********************************************/
1961
1962 void
1963 __gnat_install_handler (void)
1964 {
1965   __gnat_handler_installed = 1;
1966 }
1967
1968 #endif
1969
1970 /*********************/
1971 /* __gnat_init_float */
1972 /*********************/
1973
1974 /* This routine is called as each process thread is created, for possible
1975    initialization of the FP processor. This version is used under INTERIX,
1976    WIN32 and could be used under OS/2 */
1977
1978 #if defined (_WIN32) || defined (__INTERIX) || defined (__EMX__) \
1979   || defined (__Lynx__) || defined(__NetBSD__) || defined(__FreeBSD__)
1980
1981 #define HAVE_GNAT_INIT_FLOAT
1982
1983 void
1984 __gnat_init_float (void)
1985 {
1986 #if defined (__i386__) || defined (i386)
1987
1988   /* This is used to properly initialize the FPU on an x86 for each
1989      process thread. */
1990
1991   asm ("finit");
1992
1993 #endif  /* Defined __i386__ */
1994 }
1995 #endif
1996
1997 #ifndef HAVE_GNAT_INIT_FLOAT
1998
1999 /* All targets without a specific __gnat_init_float will use an empty one */
2000 void
2001 __gnat_init_float (void)
2002 {
2003 }
2004 #endif