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