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