gcc/ada/init.c

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