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-2011, 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 3,  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.                                     *
  17  *                                                                          *
  18  * As a special exception under Section 7 of GPL version 3, you are granted *
  19  * additional permissions described in the GCC Runtime Library Exception,   *
  20  * version 3.1, as published by the Free Software Foundation.               *
  21  *                                                                          *
  22  * You should have received a copy of the GNU General Public License and    *
  23  * a copy of the GCC Runtime Library Exception along with this program;     *
  24  * see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    *
  25  * <http://www.gnu.org/licenses/>.                                          *
  26  *                                                                          *
  27  * GNAT was originally developed  by the GNAT team at  New York University. *
  28  * Extensive contributions were provided by Ada Core Technologies Inc.      *
  29  *                                                                          *
  30  ****************************************************************************/
  31
  32 /*  This unit contains initialization circuits that are system dependent.
  33     A major part of the functionality involves stack overflow checking.
  34     The GCC backend generates probe instructions to test for stack overflow.
  35     For details on the exact approach used to generate these probes, see the
  36     "Using and Porting GCC" manual, in particular the "Stack Checking" section
  37     and the subsection "Specifying How Stack Checking is Done".  The handlers
  38     installed by this file are used to catch the resulting signals that come
  39     from these probes failing (i.e. touching protected pages).  */
  40
  41 #ifdef __cplusplus
  42 extern "C" {
  43 #endif
  44
  45 /* This file should be kept synchronized with 2sinit.ads, 2sinit.adb,
  46    s-init-ae653-cert.adb and s-init-xi-sparc.adb.  All these files implement
  47    the required functionality for different targets.  */
  48
  49 /* The following include is here to meet the published VxWorks requirement
  50    that the __vxworks header appear before any other include.  */
  51 #ifdef __vxworks
  52 #include "vxWorks.h"
  53 #endif
  54
  55 #ifdef IN_RTS
  56 #include "tconfig.h"
  57 #include "tsystem.h"
  58 #include <sys/stat.h>
  59
  60 /* We don't have libiberty, so use malloc.  */
  61 #define xmalloc(S) malloc (S)
  62 #else
  63 #include "config.h"
  64 #include "system.h"
  65 #endif
  66
  67 #include "adaint.h"
  68 #include "raise.h"
  69
  70 extern void __gnat_raise_program_error (const char *, int);
  71
  72 /* Addresses of exception data blocks for predefined exceptions.  Tasking_Error
  73    is not used in this unit, and the abort signal is only used on IRIX.  */
  74 extern struct Exception_Data constraint_error;
  75 extern struct Exception_Data numeric_error;
  76 extern struct Exception_Data program_error;
  77 extern struct Exception_Data storage_error;
  78
  79 /* For the Cert run time we use the regular raise exception routine because
  80    Raise_From_Signal_Handler is not available.  */
  81 #ifdef CERT
  82 #define Raise_From_Signal_Handler \
  83                       __gnat_raise_exception
  84 extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *);
  85 #else
  86 #define Raise_From_Signal_Handler \
  87                       ada__exceptions__raise_from_signal_handler
  88 extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *);
  89 #endif
  90
  91 /* Global values computed by the binder.  */
  92 int   __gl_main_priority                 = -1;
  93 int   __gl_main_cpu                      = -1;
  94 int   __gl_time_slice_val                = -1;
  95 char  __gl_wc_encoding                   = 'n';
  96 char  __gl_locking_policy                = ' ';
  97 char  __gl_queuing_policy                = ' ';
  98 char  __gl_task_dispatching_policy       = ' ';
  99 char *__gl_priority_specific_dispatching = 0;
 100 int   __gl_num_specific_dispatching      = 0;
 101 char *__gl_interrupt_states              = 0;
 102 int   __gl_num_interrupt_states          = 0;
 103 int   __gl_unreserve_all_interrupts      = 0;
 104 int   __gl_exception_tracebacks          = 0;
 105 int   __gl_zero_cost_exceptions          = 0;
 106 int   __gl_detect_blocking               = 0;
 107 int   __gl_default_stack_size            = -1;
 108 int   __gl_leap_seconds_support          = 0;
 109 int   __gl_canonical_streams             = 0;
 110
 111 /* Indication of whether synchronous signal handler has already been
 112    installed by a previous call to adainit.  */
 113 int  __gnat_handler_installed      = 0;
 114
 115 #ifndef IN_RTS
 116 int __gnat_inside_elab_final_code = 0;
 117 /* ??? This variable is obsolete since 2001-08-29 but is kept to allow
 118    bootstrap from old GNAT versions (< 3.15).  */
 119 #endif
 120
 121 /* HAVE_GNAT_INIT_FLOAT must be set on every targets where a __gnat_init_float
 122    is defined.  If this is not set then a void implementation will be defined
 123    at the end of this unit.  */
 124 #undef HAVE_GNAT_INIT_FLOAT
 125
 126 /******************************/
 127 /* __gnat_get_interrupt_state */
 128 /******************************/
 129
 130 char __gnat_get_interrupt_state (int);
 131
 132 /* This routine is called from the runtime as needed to determine the state
 133    of an interrupt, as set by an Interrupt_State pragma appearing anywhere
 134    in the current partition.  The input argument is the interrupt number,
 135    and the result is one of the following:
 136
 137        'n'   this interrupt not set by any Interrupt_State pragma
 138        'u'   Interrupt_State pragma set state to User
 139        'r'   Interrupt_State pragma set state to Runtime
 140        's'   Interrupt_State pragma set state to System  */
 141
 142 char
 143 __gnat_get_interrupt_state (int intrup)
 144 {
 145   if (intrup >= __gl_num_interrupt_states)
 146     return 'n';
 147   else
 148     return __gl_interrupt_states [intrup];
 149 }
 150
 151 /***********************************/
 152 /* __gnat_get_specific_dispatching */
 153 /***********************************/
 154
 155 char __gnat_get_specific_dispatching (int);
 156
 157 /* This routine is called from the runtime as needed to determine the
 158    priority specific dispatching policy, as set by a
 159    Priority_Specific_Dispatching pragma appearing anywhere in the current
 160    partition.  The input argument is the priority number, and the result
 161    is the upper case first character of the policy name, e.g. 'F' for
 162    FIFO_Within_Priorities. A space ' ' is returned if no
 163    Priority_Specific_Dispatching pragma is used in the partition.  */
 164
 165 char
 166 __gnat_get_specific_dispatching (int priority)
 167 {
 168   if (__gl_num_specific_dispatching == 0)
 169     return ' ';
 170   else if (priority >= __gl_num_specific_dispatching)
 171     return 'F';
 172   else
 173     return __gl_priority_specific_dispatching [priority];
 174 }
 175
 176 #ifndef IN_RTS
 177
 178 /**********************/
 179 /* __gnat_set_globals */
 180 /**********************/
 181
 182 /* This routine is kept for bootstrapping purposes, since the binder generated
 183    file now sets the __gl_* variables directly.  */
 184
 185 void
 186 __gnat_set_globals (void)
 187 {
 188 }
 189
 190 #endif
 191
 192 /***************/
 193 /* AIX Section */
 194 /***************/
 195
 196 #if defined (_AIX)
 197
 198 #include <signal.h>
 199 #include <sys/time.h>
 200
 201 /* Some versions of AIX don't define SA_NODEFER.  */
 202
 203 #ifndef SA_NODEFER
 204 #define SA_NODEFER 0
 205 #endif /* SA_NODEFER */
 206
 207 /* Versions of AIX before 4.3 don't have nanosleep but provide
 208    nsleep instead.  */
 209
 210 #ifndef _AIXVERSION_430
 211
 212 extern int nanosleep (struct timestruc_t *, struct timestruc_t *);
 213
 214 int
 215 nanosleep (struct timestruc_t *Rqtp, struct timestruc_t *Rmtp)
 216 {
 217   return nsleep (Rqtp, Rmtp);
 218 }
 219
 220 #endif /* _AIXVERSION_430 */
 221
 222 static void
 223 __gnat_error_handler (int sig,
 224                       siginfo_t *si ATTRIBUTE_UNUSED,
 225                       void *ucontext ATTRIBUTE_UNUSED)
 226 {
 227   struct Exception_Data *exception;
 228   const char *msg;
 229
 230   switch (sig)
 231     {
 232     case SIGSEGV:
 233       /* FIXME: we need to detect the case of a *real* SIGSEGV.  */
 234       exception = &storage_error;
 235       msg = "stack overflow or erroneous memory access";
 236       break;
 237
 238     case SIGBUS:
 239       exception = &constraint_error;
 240       msg = "SIGBUS";
 241       break;
 242
 243     case SIGFPE:
 244       exception = &constraint_error;
 245       msg = "SIGFPE";
 246       break;
 247
 248     default:
 249       exception = &program_error;
 250       msg = "unhandled signal";
 251     }
 252
 253   Raise_From_Signal_Handler (exception, msg);
 254 }
 255
 256 void
 257 __gnat_install_handler (void)
 258 {
 259   struct sigaction act;
 260
 261   /* Set up signal handler to map synchronous signals to appropriate
 262      exceptions.  Make sure that the handler isn't interrupted by another
 263      signal that might cause a scheduling event!  */
 264
 265   act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
 266   act.sa_sigaction = __gnat_error_handler;
 267   sigemptyset (&act.sa_mask);
 268
 269   /* Do not install handlers if interrupt state is "System".  */
 270   if (__gnat_get_interrupt_state (SIGABRT) != 's')
 271     sigaction (SIGABRT, &act, NULL);
 272   if (__gnat_get_interrupt_state (SIGFPE) != 's')
 273     sigaction (SIGFPE,  &act, NULL);
 274   if (__gnat_get_interrupt_state (SIGILL) != 's')
 275     sigaction (SIGILL,  &act, NULL);
 276   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 277     sigaction (SIGSEGV, &act, NULL);
 278   if (__gnat_get_interrupt_state (SIGBUS) != 's')
 279     sigaction (SIGBUS,  &act, NULL);
 280
 281   __gnat_handler_installed = 1;
 282 }
 283
 284 /*****************/
 285 /* Tru64 section */
 286 /*****************/
 287
 288 #elif defined(__alpha__) && defined(__osf__)
 289
 290 #include <signal.h>
 291 #include <sys/siginfo.h>
 292
 293 extern char *__gnat_get_code_loc (struct sigcontext *);
 294 extern void __gnat_set_code_loc (struct sigcontext *, char *);
 295 extern size_t __gnat_machine_state_length (void);
 296
 297 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
 298
 299 void
 300 __gnat_adjust_context_for_raise (int signo, void *ucontext)
 301 {
 302   struct sigcontext *sigcontext = (struct sigcontext *) ucontext;
 303
 304   /* The unwinder expects the signal context to contain the address of the
 305      faulting instruction.  For SIGFPE, this depends on the trap shadow
 306      situation (see man ieee).  We nonetheless always compensate for it,
 307      considering that PC designates the instruction following the one that
 308      trapped.  This is not necessarily true but corresponds to what we have
 309      always observed.  */
 310   if (signo == SIGFPE)
 311     sigcontext->sc_pc--;
 312 }
 313
 314 static void
 315 __gnat_error_handler (int sig, siginfo_t *si, void *ucontext)
 316 {
 317   struct Exception_Data *exception;
 318   static int recurse = 0;
 319   const char *msg;
 320
 321   /* Adjusting is required for every fault context, so adjust for this one
 322      now, before we possibly trigger a recursive fault below.  */
 323   __gnat_adjust_context_for_raise (sig, ucontext);
 324
 325   /* If this was an explicit signal from a "kill", just resignal it.  */
 326   if (SI_FROMUSER (si))
 327     {
 328       signal (sig, SIG_DFL);
 329       kill (getpid(), sig);
 330     }
 331
 332   /* Otherwise, treat it as something we handle.  */
 333   switch (sig)
 334     {
 335     case SIGSEGV:
 336       /* If the problem was permissions, this is a constraint error.
 337          Likewise if the failing address isn't maximally aligned or if
 338          we've recursed.
 339
 340          ??? Using a static variable here isn't task-safe, but it's
 341          much too hard to do anything else and we're just determining
 342          which exception to raise.  */
 343       if (si->si_code == SEGV_ACCERR
 344           || (long) si->si_addr == 0
 345           || (((long) si->si_addr) & 3) != 0
 346           || recurse)
 347         {
 348           exception = &constraint_error;
 349           msg = "SIGSEGV";
 350         }
 351       else
 352         {
 353           /* See if the page before the faulting page is accessible.  Do that
 354              by trying to access it.  We'd like to simply try to access
 355              4096 + the faulting address, but it's not guaranteed to be
 356              the actual address, just to be on the same page.  */
 357           recurse++;
 358           ((volatile char *)
 359            ((long) si->si_addr & - getpagesize ()))[getpagesize ()];
 360           exception = &storage_error;
 361           msg = "stack overflow (or erroneous memory access)";
 362         }
 363       break;
 364
 365     case SIGBUS:
 366       exception = &program_error;
 367       msg = "SIGBUS";
 368       break;
 369
 370     case SIGFPE:
 371       exception = &constraint_error;
 372       msg = "SIGFPE";
 373       break;
 374
 375     default:
 376       exception = &program_error;
 377       msg = "unhandled signal";
 378     }
 379
 380   recurse = 0;
 381   Raise_From_Signal_Handler (exception, (const char *) msg);
 382 }
 383
 384 void
 385 __gnat_install_handler (void)
 386 {
 387   struct sigaction act;
 388
 389   /* Setup signal handler to map synchronous signals to appropriate
 390      exceptions. Make sure that the handler isn't interrupted by another
 391      signal that might cause a scheduling event!  */
 392
 393   act.sa_handler = (void (*) (int)) __gnat_error_handler;
 394   act.sa_flags = SA_RESTART | SA_NODEFER | SA_SIGINFO;
 395   sigemptyset (&act.sa_mask);
 396
 397   /* Do not install handlers if interrupt state is "System".  */
 398   if (__gnat_get_interrupt_state (SIGABRT) != 's')
 399     sigaction (SIGABRT, &act, NULL);
 400   if (__gnat_get_interrupt_state (SIGFPE) != 's')
 401     sigaction (SIGFPE,  &act, NULL);
 402   if (__gnat_get_interrupt_state (SIGILL) != 's')
 403     sigaction (SIGILL,  &act, NULL);
 404   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 405     sigaction (SIGSEGV, &act, NULL);
 406   if (__gnat_get_interrupt_state (SIGBUS) != 's')
 407     sigaction (SIGBUS,  &act, NULL);
 408
 409   __gnat_handler_installed = 1;
 410 }
 411
 412 /* Routines called by s-mastop-tru64.adb.  */
 413
 414 #define SC_GP 29
 415
 416 char *
 417 __gnat_get_code_loc (struct sigcontext *context)
 418 {
 419   return (char *) context->sc_pc;
 420 }
 421
 422 void
 423 __gnat_set_code_loc (struct sigcontext *context, char *pc)
 424 {
 425   context->sc_pc = (long) pc;
 426 }
 427
 428 size_t
 429 __gnat_machine_state_length (void)
 430 {
 431   return sizeof (struct sigcontext);
 432 }
 433
 434 /*****************/
 435 /* HP-UX section */
 436 /*****************/
 437
 438 #elif defined (__hpux__)
 439
 440 #include <signal.h>
 441 #include <sys/ucontext.h>
 442
 443 static void
 444 __gnat_error_handler (int sig,
 445                       siginfo_t *si ATTRIBUTE_UNUSED,
 446                       void *ucontext ATTRIBUTE_UNUSED)
 447 {
 448   struct Exception_Data *exception;
 449   const char *msg;
 450
 451   switch (sig)
 452     {
 453     case SIGSEGV:
 454       /* FIXME: we need to detect the case of a *real* SIGSEGV.  */
 455       exception = &storage_error;
 456       msg = "stack overflow or erroneous memory access";
 457       break;
 458
 459     case SIGBUS:
 460       exception = &constraint_error;
 461       msg = "SIGBUS";
 462       break;
 463
 464     case SIGFPE:
 465       exception = &constraint_error;
 466       msg = "SIGFPE";
 467       break;
 468
 469     default:
 470       exception = &program_error;
 471       msg = "unhandled signal";
 472     }
 473
 474   Raise_From_Signal_Handler (exception, msg);
 475 }
 476
 477 /* This must be in keeping with System.OS_Interface.Alternate_Stack_Size.  */
 478 #if defined (__hppa__)
 479 char __gnat_alternate_stack[16 * 1024]; /* 2 * SIGSTKSZ */
 480 #else
 481 char __gnat_alternate_stack[128 * 1024]; /* MINSIGSTKSZ */
 482 #endif
 483
 484 void
 485 __gnat_install_handler (void)
 486 {
 487   struct sigaction act;
 488
 489   /* Set up signal handler to map synchronous signals to appropriate
 490      exceptions.  Make sure that the handler isn't interrupted by another
 491      signal that might cause a scheduling event!  Also setup an alternate
 492      stack region for the handler execution so that stack overflows can be
 493      handled properly, avoiding a SEGV generation from stack usage by the
 494      handler itself.  */
 495
 496   stack_t stack;
 497   stack.ss_sp = __gnat_alternate_stack;
 498   stack.ss_size = sizeof (__gnat_alternate_stack);
 499   stack.ss_flags = 0;
 500   sigaltstack (&stack, NULL);
 501
 502   act.sa_sigaction = __gnat_error_handler;
 503   act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
 504   sigemptyset (&act.sa_mask);
 505
 506   /* Do not install handlers if interrupt state is "System".  */
 507   if (__gnat_get_interrupt_state (SIGABRT) != 's')
 508     sigaction (SIGABRT, &act, NULL);
 509   if (__gnat_get_interrupt_state (SIGFPE) != 's')
 510     sigaction (SIGFPE,  &act, NULL);
 511   if (__gnat_get_interrupt_state (SIGILL) != 's')
 512     sigaction (SIGILL,  &act, NULL);
 513   if (__gnat_get_interrupt_state (SIGBUS) != 's')
 514     sigaction (SIGBUS,  &act, NULL);
 515   act.sa_flags |= SA_ONSTACK;
 516   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 517     sigaction (SIGSEGV, &act, NULL);
 518
 519   __gnat_handler_installed = 1;
 520 }
 521
 522 /*********************/
 523 /* GNU/Linux Section */
 524 /*********************/
 525
 526 #elif defined (linux)
 527
 528 #include <signal.h>
 529
 530 #define __USE_GNU 1 /* required to get REG_EIP/RIP from glibc's ucontext.h */
 531 #include <sys/ucontext.h>
 532
 533 /* GNU/Linux, which uses glibc, does not define NULL in included
 534    header files.  */
 535
 536 #if !defined (NULL)
 537 #define NULL ((void *) 0)
 538 #endif
 539
 540 #if defined (MaRTE)
 541
 542 /* MaRTE OS provides its own version of sigaction, sigfillset, and
 543    sigemptyset (overriding these symbol names).  We want to make sure that
 544    the versions provided by the underlying C library are used here (these
 545    versions are renamed by MaRTE to linux_sigaction, fake_linux_sigfillset,
 546    and fake_linux_sigemptyset, respectively).  The MaRTE library will not
 547    always be present (it will not be linked if no tasking constructs are
 548    used), so we use the weak symbol mechanism to point always to the symbols
 549    defined within the C library.  */
 550
 551 #pragma weak linux_sigaction
 552 int linux_sigaction (int signum, const struct sigaction *act,
 553                      struct sigaction *oldact) {
 554   return sigaction (signum, act, oldact);
 555 }
 556 #define sigaction(signum, act, oldact) linux_sigaction (signum, act, oldact)
 557
 558 #pragma weak fake_linux_sigfillset
 559 void fake_linux_sigfillset (sigset_t *set) {
 560   sigfillset (set);
 561 }
 562 #define sigfillset(set) fake_linux_sigfillset (set)
 563
 564 #pragma weak fake_linux_sigemptyset
 565 void fake_linux_sigemptyset (sigset_t *set) {
 566   sigemptyset (set);
 567 }
 568 #define sigemptyset(set) fake_linux_sigemptyset (set)
 569
 570 #endif
 571
 572 #if defined (i386) || defined (__x86_64__) || defined (__ia64__)
 573
 574 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
 575
 576 void
 577 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
 578 {
 579   mcontext_t *mcontext = &((ucontext_t *) ucontext)->uc_mcontext;
 580
 581   /* On the i386 and x86-64 architectures, stack checking is performed by
 582      means of probes with moving stack pointer, that is to say the probed
 583      address is always the value of the stack pointer.  Upon hitting the
 584      guard page, the stack pointer therefore points to an inaccessible
 585      address and an alternate signal stack is needed to run the handler.
 586      But there is an additional twist: on these architectures, the EH
 587      return code writes the address of the handler at the target CFA's
 588      value on the stack before doing the jump.  As a consequence, if
 589      there is an active handler in the frame whose stack has overflowed,
 590      the stack pointer must nevertheless point to an accessible address
 591      by the time the EH return is executed.
 592
 593      We therefore adjust the saved value of the stack pointer by the size
 594      of one page + a small dope of 4 words, in order to make sure that it
 595      points to an accessible address in case it's used as the target CFA.
 596      The stack checking code guarantees that this address is unused by the
 597      time this happens.  */
 598
 599 #if defined (i386)
 600   unsigned long *pc = (unsigned long *)mcontext->gregs[REG_EIP];
 601   /* The pattern is "orl $0x0,(%esp)" for a probe in 32-bit mode.  */
 602   if (signo == SIGSEGV && pc && *pc == 0x00240c83)
 603     mcontext->gregs[REG_ESP] += 4096 + 4 * sizeof (unsigned long);
 604 #elif defined (__x86_64__)
 605   unsigned long *pc = (unsigned long *)mcontext->gregs[REG_RIP];
 606   /* The pattern is "orq $0x0,(%rsp)" for a probe in 64-bit mode.  */
 607   if (signo == SIGSEGV && pc && (*pc & 0xffffffffff) == 0x00240c8348)
 608     mcontext->gregs[REG_RSP] += 4096 + 4 * sizeof (unsigned long);
 609 #elif defined (__ia64__)
 610   /* ??? The IA-64 unwinder doesn't compensate for signals.  */
 611   mcontext->sc_ip++;
 612 #endif
 613 }
 614
 615 #endif
 616
 617 static void
 618 __gnat_error_handler (int sig, siginfo_t *si ATTRIBUTE_UNUSED, void *ucontext)
 619 {
 620   struct Exception_Data *exception;
 621   const char *msg;
 622
 623   /* Adjusting is required for every fault context, so adjust for this one
 624      now, before we possibly trigger a recursive fault below.  */
 625   __gnat_adjust_context_for_raise (sig, ucontext);
 626
 627   switch (sig)
 628     {
 629     case SIGSEGV:
 630       /* Here we would like a discrimination test to see whether the page
 631          before the faulting address is accessible.  Unfortunately, Linux
 632          seems to have no way of giving us the faulting address.
 633
 634          In old versions of init.c, we had a test of the page before the
 635          stack pointer:
 636
 637            ((volatile char *)
 638             ((long) si->esp_at_signal & - getpagesize ()))[getpagesize ()];
 639
 640          but that's wrong since it tests the stack pointer location and the
 641          stack probing code may not move it until all probes succeed.
 642
 643          For now we simply do not attempt any discrimination at all. Note
 644          that this is quite acceptable, since a "real" SIGSEGV can only
 645          occur as the result of an erroneous program.  */
 646       exception = &storage_error;
 647       msg = "stack overflow (or erroneous memory access)";
 648       break;
 649
 650     case SIGBUS:
 651       exception = &constraint_error;
 652       msg = "SIGBUS";
 653       break;
 654
 655     case SIGFPE:
 656       exception = &constraint_error;
 657       msg = "SIGFPE";
 658       break;
 659
 660     default:
 661       exception = &program_error;
 662       msg = "unhandled signal";
 663     }
 664
 665   Raise_From_Signal_Handler (exception, msg);
 666 }
 667
 668 #if defined (i386) || defined (__x86_64__) || defined (__powerpc__)
 669 /* This must be in keeping with System.OS_Interface.Alternate_Stack_Size.  */
 670 char __gnat_alternate_stack[16 * 1024]; /* 2 * SIGSTKSZ */
 671 #endif
 672
 673 #ifdef __XENO__
 674 #include <sys/mman.h>
 675 #include <native/task.h>
 676
 677 RT_TASK main_task;
 678 #endif
 679
 680 void
 681 __gnat_install_handler (void)
 682 {
 683   struct sigaction act;
 684
 685 #ifdef __XENO__
 686   int prio;
 687
 688   if (__gl_main_priority == -1)
 689     prio = 49;
 690   else
 691     prio = __gl_main_priority;
 692
 693   /* Avoid memory swapping for this program */
 694
 695   mlockall (MCL_CURRENT|MCL_FUTURE);
 696
 697   /* Turn the current Linux task into a native Xenomai task */
 698
 699   rt_task_shadow(&main_task, "environment_task", prio, T_FPU);
 700 #endif
 701
 702   /* Set up signal handler to map synchronous signals to appropriate
 703      exceptions.  Make sure that the handler isn't interrupted by another
 704      signal that might cause a scheduling event!  Also setup an alternate
 705      stack region for the handler execution so that stack overflows can be
 706      handled properly, avoiding a SEGV generation from stack usage by the
 707      handler itself.  */
 708
 709 #if defined (i386) || defined (__x86_64__) || defined (__powerpc__)
 710   stack_t stack;
 711   stack.ss_sp = __gnat_alternate_stack;
 712   stack.ss_size = sizeof (__gnat_alternate_stack);
 713   stack.ss_flags = 0;
 714   sigaltstack (&stack, NULL);
 715 #endif
 716
 717   act.sa_sigaction = __gnat_error_handler;
 718   act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
 719   sigemptyset (&act.sa_mask);
 720
 721   /* Do not install handlers if interrupt state is "System".  */
 722   if (__gnat_get_interrupt_state (SIGABRT) != 's')
 723     sigaction (SIGABRT, &act, NULL);
 724   if (__gnat_get_interrupt_state (SIGFPE) != 's')
 725     sigaction (SIGFPE,  &act, NULL);
 726   if (__gnat_get_interrupt_state (SIGILL) != 's')
 727     sigaction (SIGILL,  &act, NULL);
 728   if (__gnat_get_interrupt_state (SIGBUS) != 's')
 729     sigaction (SIGBUS,  &act, NULL);
 730 #if defined (i386) || defined (__x86_64__) || defined (__powerpc__)
 731   act.sa_flags |= SA_ONSTACK;
 732 #endif
 733   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 734     sigaction (SIGSEGV, &act, NULL);
 735
 736   __gnat_handler_installed = 1;
 737 }
 738
 739 /****************/
 740 /* IRIX Section */
 741 /****************/
 742
 743 #elif defined (sgi)
 744
 745 #include <signal.h>
 746 #include <siginfo.h>
 747
 748 #ifndef NULL
 749 #define NULL 0
 750 #endif
 751
 752 #define SIGADAABORT 48
 753 #define SIGNAL_STACK_SIZE 4096
 754 #define SIGNAL_STACK_ALIGNMENT 64
 755
 756 #define Check_Abort_Status     \
 757                       system__soft_links__check_abort_status
 758 extern int (*Check_Abort_Status) (void);
 759
 760 extern struct Exception_Data _abort_signal;
 761
 762 /* We are not setting the SA_SIGINFO bit in the sigaction flags when
 763    connecting that handler, with the effects described in the sigaction
 764    man page:
 765
 766           SA_SIGINFO   If set and the signal is caught, sig is passed as the
 767                        first argument to the signal-catching function.  If the
 768                        second argument is not equal to NULL, it points to a
 769                        siginfo_t structure containing the reason why the
 770                        signal was generated [see siginfo(5)]; the third
 771                        argument points to a ucontext_t structure containing
 772                        the receiving process's context when the signal was
 773                        delivered [see ucontext(5)].  If cleared and the signal
 774                        is caught, the first argument is also the signal number
 775                        but the second argument is the signal code identifying
 776                        the cause of the signal. The third argument points to a
 777                        sigcontext_t structure containing the receiving
 778                        process's context when the signal was delivered. This
 779                        is the default behavior (see signal(5) for more
 780                        details).  Additionally, when SA_SIGINFO is set for a
 781                        signal, multiple occurrences of that signal will be
 782                        queued for delivery in FIFO order (see sigqueue(3) for
 783                        a more detailed explanation of this concept), if those
 784                        occurrences of that signal were generated using
 785                        sigqueue(3).  */
 786
 787 static void
 788 __gnat_error_handler (int sig, siginfo_t *reason, void *uc ATTRIBUTE_UNUSED)
 789 {
 790   int code = reason == NULL ? 0 : reason->si_code;
 791   struct Exception_Data *exception;
 792   const char *msg;
 793
 794   switch (sig)
 795     {
 796     case SIGSEGV:
 797       if (code == EFAULT)
 798         {
 799           exception = &program_error;
 800           msg = "SIGSEGV: (Invalid virtual address)";
 801         }
 802       else if (code == ENXIO)
 803         {
 804           exception = &program_error;
 805           msg = "SIGSEGV: (Read beyond mapped object)";
 806         }
 807       else if (code == ENOSPC)
 808         {
 809           exception = &program_error; /* ??? storage_error ??? */
 810           msg = "SIGSEGV: (Autogrow for file failed)";
 811         }
 812       else if (code == EACCES || code == EEXIST)
 813         {
 814           /* ??? We handle stack overflows here, some of which do trigger
 815                  SIGSEGV + EEXIST on Irix 6.5 although EEXIST is not part of
 816                  the documented valid codes for SEGV in the signal(5) man
 817                  page.  */
 818
 819           /* ??? Re-add smarts to further verify that we launched
 820                  the stack into a guard page, not an attempt to
 821                  write to .text or something.  */
 822           exception = &storage_error;
 823           msg = "SIGSEGV: (stack overflow or erroneous memory access)";
 824         }
 825       else
 826         {
 827           /* Just in case the OS guys did it to us again.  Sometimes
 828              they fail to document all of the valid codes that are
 829              passed to signal handlers, just in case someone depends
 830              on knowing all the codes.  */
 831           exception = &program_error;
 832           msg = "SIGSEGV: (Undocumented reason)";
 833         }
 834       break;
 835
 836     case SIGBUS:
 837       /* Map all bus errors to Program_Error.  */
 838       exception = &program_error;
 839       msg = "SIGBUS";
 840       break;
 841
 842     case SIGFPE:
 843       /* Map all fpe errors to Constraint_Error.  */
 844       exception = &constraint_error;
 845       msg = "SIGFPE";
 846       break;
 847
 848     case SIGADAABORT:
 849       if ((*Check_Abort_Status) ())
 850         {
 851           exception = &_abort_signal;
 852           msg = "";
 853         }
 854       else
 855         return;
 856
 857       break;
 858
 859     default:
 860       /* Everything else is a Program_Error.  */
 861       exception = &program_error;
 862       msg = "unhandled signal";
 863     }
 864
 865   Raise_From_Signal_Handler (exception, msg);
 866 }
 867
 868 void
 869 __gnat_install_handler (void)
 870 {
 871   struct sigaction act;
 872
 873   /* Setup signal handler to map synchronous signals to appropriate
 874      exceptions.  Make sure that the handler isn't interrupted by another
 875      signal that might cause a scheduling event!  */
 876
 877   act.sa_sigaction = __gnat_error_handler;
 878   act.sa_flags = SA_NODEFER + SA_RESTART;
 879   sigfillset (&act.sa_mask);
 880   sigemptyset (&act.sa_mask);
 881
 882   /* Do not install handlers if interrupt state is "System".  */
 883   if (__gnat_get_interrupt_state (SIGABRT) != 's')
 884     sigaction (SIGABRT, &act, NULL);
 885   if (__gnat_get_interrupt_state (SIGFPE) != 's')
 886     sigaction (SIGFPE,  &act, NULL);
 887   if (__gnat_get_interrupt_state (SIGILL) != 's')
 888     sigaction (SIGILL,  &act, NULL);
 889   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 890     sigaction (SIGSEGV, &act, NULL);
 891   if (__gnat_get_interrupt_state (SIGBUS) != 's')
 892     sigaction (SIGBUS,  &act, NULL);
 893   if (__gnat_get_interrupt_state (SIGADAABORT) != 's')
 894     sigaction (SIGADAABORT,  &act, NULL);
 895
 896   __gnat_handler_installed = 1;
 897 }
 898
 899 /*******************/
 900 /* LynxOS Section */
 901 /*******************/
 902
 903 #elif defined (__Lynx__)
 904
 905 #include <signal.h>
 906 #include <unistd.h>
 907
 908 static void
 909 __gnat_error_handler (int sig)
 910 {
 911   struct Exception_Data *exception;
 912   const char *msg;
 913
 914   switch(sig)
 915   {
 916     case SIGFPE:
 917       exception = &constraint_error;
 918       msg = "SIGFPE";
 919       break;
 920     case SIGILL:
 921       exception = &constraint_error;
 922       msg = "SIGILL";
 923       break;
 924     case SIGSEGV:
 925       exception = &storage_error;
 926       msg = "stack overflow or erroneous memory access";
 927       break;
 928     case SIGBUS:
 929       exception = &constraint_error;
 930       msg = "SIGBUS";
 931       break;
 932     default:
 933       exception = &program_error;
 934       msg = "unhandled signal";
 935     }
 936
 937     Raise_From_Signal_Handler(exception, msg);
 938 }
 939
 940 void
 941 __gnat_install_handler(void)
 942 {
 943   struct sigaction act;
 944
 945   act.sa_handler = __gnat_error_handler;
 946   act.sa_flags = 0x0;
 947   sigemptyset (&act.sa_mask);
 948
 949   /* Do not install handlers if interrupt state is "System".  */
 950   if (__gnat_get_interrupt_state (SIGFPE) != 's')
 951     sigaction (SIGFPE,  &act, NULL);
 952   if (__gnat_get_interrupt_state (SIGILL) != 's')
 953     sigaction (SIGILL,  &act, NULL);
 954   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 955     sigaction (SIGSEGV, &act, NULL);
 956   if (__gnat_get_interrupt_state (SIGBUS) != 's')
 957     sigaction (SIGBUS,  &act, NULL);
 958
 959   __gnat_handler_installed = 1;
 960 }
 961
 962 /*******************/
 963 /* Solaris Section */
 964 /*******************/
 965
 966 #elif defined (sun) && defined (__SVR4) && !defined (__vxworks)
 967
 968 #include <signal.h>
 969 #include <siginfo.h>
 970 #include <sys/ucontext.h>
 971 #include <sys/regset.h>
 972
 973 /* The code below is common to SPARC and x86.  Beware of the delay slot
 974    differences for signal context adjustments.  */
 975
 976 #if defined (__sparc)
 977 #define RETURN_ADDR_OFFSET 8
 978 #else
 979 #define RETURN_ADDR_OFFSET 0
 980 #endif
 981
 982 static void
 983 __gnat_error_handler (int sig, siginfo_t *si, void *ucontext ATTRIBUTE_UNUSED)
 984 {
 985   struct Exception_Data *exception;
 986   static int recurse = 0;
 987   const char *msg;
 988
 989   switch (sig)
 990     {
 991     case SIGSEGV:
 992       /* If the problem was permissions, this is a constraint error.
 993          Likewise if the failing address isn't maximally aligned or if
 994          we've recursed.
 995
 996          ??? Using a static variable here isn't task-safe, but it's
 997          much too hard to do anything else and we're just determining
 998          which exception to raise.  */
 999       if (si->si_code == SEGV_ACCERR
1000           || (long) si->si_addr == 0
1001           || (((long) si->si_addr) & 3) != 0
1002           || recurse)
1003         {
1004           exception = &constraint_error;
1005           msg = "SIGSEGV";
1006         }
1007       else
1008         {
1009           /* See if the page before the faulting page is accessible.  Do that
1010              by trying to access it.  We'd like to simply try to access
1011              4096 + the faulting address, but it's not guaranteed to be
1012              the actual address, just to be on the same page.  */
1013           recurse++;
1014           ((volatile char *)
1015            ((long) si->si_addr & - getpagesize ()))[getpagesize ()];
1016           exception = &storage_error;
1017           msg = "stack overflow (or erroneous memory access)";
1018         }
1019       break;
1020
1021     case SIGBUS:
1022       exception = &program_error;
1023       msg = "SIGBUS";
1024       break;
1025
1026     case SIGFPE:
1027       exception = &constraint_error;
1028       msg = "SIGFPE";
1029       break;
1030
1031     default:
1032       exception = &program_error;
1033       msg = "unhandled signal";
1034     }
1035
1036   recurse = 0;
1037   Raise_From_Signal_Handler (exception, msg);
1038 }
1039
1040 void
1041 __gnat_install_handler (void)
1042 {
1043   struct sigaction act;
1044
1045   /* Set up signal handler to map synchronous signals to appropriate
1046      exceptions.  Make sure that the handler isn't interrupted by another
1047      signal that might cause a scheduling event!  */
1048
1049   act.sa_handler = __gnat_error_handler;
1050   act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
1051   sigemptyset (&act.sa_mask);
1052
1053   /* Do not install handlers if interrupt state is "System".  */
1054   if (__gnat_get_interrupt_state (SIGABRT) != 's')
1055     sigaction (SIGABRT, &act, NULL);
1056   if (__gnat_get_interrupt_state (SIGFPE) != 's')
1057     sigaction (SIGFPE,  &act, NULL);
1058   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1059     sigaction (SIGSEGV, &act, NULL);
1060   if (__gnat_get_interrupt_state (SIGBUS) != 's')
1061     sigaction (SIGBUS,  &act, NULL);
1062
1063   __gnat_handler_installed = 1;
1064 }
1065
1066 /***************/
1067 /* VMS Section */
1068 /***************/
1069
1070 #elif defined (VMS)
1071
1072 /* Routine called from binder to override default feature values. */
1073 void __gnat_set_features (void);
1074 int __gnat_features_set = 0;
1075
1076 #ifdef __IA64
1077 #define lib_get_curr_invo_context LIB$I64_GET_CURR_INVO_CONTEXT
1078 #define lib_get_prev_invo_context LIB$I64_GET_PREV_INVO_CONTEXT
1079 #define lib_get_invo_handle LIB$I64_GET_INVO_HANDLE
1080 #else
1081 #define lib_get_curr_invo_context LIB$GET_CURR_INVO_CONTEXT
1082 #define lib_get_prev_invo_context LIB$GET_PREV_INVO_CONTEXT
1083 #define lib_get_invo_handle LIB$GET_INVO_HANDLE
1084 #endif
1085
1086 /* Define macro symbols for the VMS conditions that become Ada exceptions.
1087    Most of these are also defined in the header file ssdef.h which has not
1088    yet been converted to be recognized by GNU C.  */
1089
1090 /* Defining these as macros, as opposed to external addresses, allows
1091    them to be used in a case statement below.  */
1092 #define SS$_ACCVIO            12
1093 #define SS$_HPARITH         1284
1094 #define SS$_STKOVF          1364
1095 #define SS$_RESIGNAL        2328
1096
1097 /* These codes are in standard message libraries.  */
1098 extern int C$_SIGKILL;
1099 extern int CMA$_EXIT_THREAD;
1100 extern int SS$_DEBUG;
1101 extern int SS$_INTDIV;
1102 extern int LIB$_KEYNOTFOU;
1103 extern int LIB$_ACTIMAGE;
1104 extern int MTH$_FLOOVEMAT;       /* Some ACVC_21 CXA tests */
1105
1106 /* These codes are non standard, which is to say the author is
1107    not sure if they are defined in the standard message libraries
1108    so keep them as macros for now.  */
1109 #define RDB$_STREAM_EOF 20480426
1110 #define FDL$_UNPRIKW 11829410
1111
1112 struct cond_except {
1113   const int *cond;
1114   const struct Exception_Data *except;
1115 };
1116
1117 struct descriptor_s {
1118   unsigned short len, mbz;
1119   __char_ptr32 adr;
1120 };
1121
1122 /* Conditions that don't have an Ada exception counterpart must raise
1123    Non_Ada_Error.  Since this is defined in s-auxdec, it should only be
1124    referenced by user programs, not the compiler or tools.  Hence the
1125    #ifdef IN_RTS.  */
1126
1127 #ifdef IN_RTS
1128
1129 #define Status_Error ada__io_exceptions__status_error
1130 extern struct Exception_Data Status_Error;
1131
1132 #define Mode_Error ada__io_exceptions__mode_error
1133 extern struct Exception_Data Mode_Error;
1134
1135 #define Name_Error ada__io_exceptions__name_error
1136 extern struct Exception_Data Name_Error;
1137
1138 #define Use_Error ada__io_exceptions__use_error
1139 extern struct Exception_Data Use_Error;
1140
1141 #define Device_Error ada__io_exceptions__device_error
1142 extern struct Exception_Data Device_Error;
1143
1144 #define End_Error ada__io_exceptions__end_error
1145 extern struct Exception_Data End_Error;
1146
1147 #define Data_Error ada__io_exceptions__data_error
1148 extern struct Exception_Data Data_Error;
1149
1150 #define Layout_Error ada__io_exceptions__layout_error
1151 extern struct Exception_Data Layout_Error;
1152
1153 #define Non_Ada_Error system__aux_dec__non_ada_error
1154 extern struct Exception_Data Non_Ada_Error;
1155
1156 #define Coded_Exception system__vms_exception_table__coded_exception
1157 extern struct Exception_Data *Coded_Exception (Exception_Code);
1158
1159 #define Base_Code_In system__vms_exception_table__base_code_in
1160 extern Exception_Code Base_Code_In (Exception_Code);
1161
1162 /* DEC Ada exceptions are not defined in a header file, so they
1163    must be declared as external addresses.  */
1164
1165 extern int ADA$_PROGRAM_ERROR;
1166 extern int ADA$_LOCK_ERROR;
1167 extern int ADA$_EXISTENCE_ERROR;
1168 extern int ADA$_KEY_ERROR;
1169 extern int ADA$_KEYSIZERR;
1170 extern int ADA$_STAOVF;
1171 extern int ADA$_CONSTRAINT_ERRO;
1172 extern int ADA$_IOSYSFAILED;
1173 extern int ADA$_LAYOUT_ERROR;
1174 extern int ADA$_STORAGE_ERROR;
1175 extern int ADA$_DATA_ERROR;
1176 extern int ADA$_DEVICE_ERROR;
1177 extern int ADA$_END_ERROR;
1178 extern int ADA$_MODE_ERROR;
1179 extern int ADA$_NAME_ERROR;
1180 extern int ADA$_STATUS_ERROR;
1181 extern int ADA$_NOT_OPEN;
1182 extern int ADA$_ALREADY_OPEN;
1183 extern int ADA$_USE_ERROR;
1184 extern int ADA$_UNSUPPORTED;
1185 extern int ADA$_FAC_MODE_MISMAT;
1186 extern int ADA$_ORG_MISMATCH;
1187 extern int ADA$_RFM_MISMATCH;
1188 extern int ADA$_RAT_MISMATCH;
1189 extern int ADA$_MRS_MISMATCH;
1190 extern int ADA$_MRN_MISMATCH;
1191 extern int ADA$_KEY_MISMATCH;
1192 extern int ADA$_MAXLINEXC;
1193 extern int ADA$_LINEXCMRS;
1194
1195 /* DEC Ada specific conditions.  */
1196 static const struct cond_except dec_ada_cond_except_table [] = {
1197   {&ADA$_PROGRAM_ERROR,   &program_error},
1198   {&ADA$_USE_ERROR,       &Use_Error},
1199   {&ADA$_KEYSIZERR,       &program_error},
1200   {&ADA$_STAOVF,          &storage_error},
1201   {&ADA$_CONSTRAINT_ERRO, &constraint_error},
1202   {&ADA$_IOSYSFAILED,     &Device_Error},
1203   {&ADA$_LAYOUT_ERROR,    &Layout_Error},
1204   {&ADA$_STORAGE_ERROR,   &storage_error},
1205   {&ADA$_DATA_ERROR,      &Data_Error},
1206   {&ADA$_DEVICE_ERROR,    &Device_Error},
1207   {&ADA$_END_ERROR,       &End_Error},
1208   {&ADA$_MODE_ERROR,      &Mode_Error},
1209   {&ADA$_NAME_ERROR,      &Name_Error},
1210   {&ADA$_STATUS_ERROR,    &Status_Error},
1211   {&ADA$_NOT_OPEN,        &Use_Error},
1212   {&ADA$_ALREADY_OPEN,    &Use_Error},
1213   {&ADA$_USE_ERROR,       &Use_Error},
1214   {&ADA$_UNSUPPORTED,     &Use_Error},
1215   {&ADA$_FAC_MODE_MISMAT, &Use_Error},
1216   {&ADA$_ORG_MISMATCH,    &Use_Error},
1217   {&ADA$_RFM_MISMATCH,    &Use_Error},
1218   {&ADA$_RAT_MISMATCH,    &Use_Error},
1219   {&ADA$_MRS_MISMATCH,    &Use_Error},
1220   {&ADA$_MRN_MISMATCH,    &Use_Error},
1221   {&ADA$_KEY_MISMATCH,    &Use_Error},
1222   {&ADA$_MAXLINEXC,       &constraint_error},
1223   {&ADA$_LINEXCMRS,       &constraint_error},
1224   {0,                     0}
1225 };
1226
1227 #if 0
1228    /* Already handled by a pragma Import_Exception
1229       in Aux_IO_Exceptions */
1230   {&ADA$_LOCK_ERROR,      &Lock_Error},
1231   {&ADA$_EXISTENCE_ERROR, &Existence_Error},
1232   {&ADA$_KEY_ERROR,       &Key_Error},
1233 #endif
1234
1235 #endif /* IN_RTS */
1236
1237 /* Non-DEC Ada specific conditions.  We could probably also put
1238    SS$_HPARITH here and possibly SS$_ACCVIO, SS$_STKOVF.  */
1239 static const struct cond_except cond_except_table [] = {
1240   {&MTH$_FLOOVEMAT, &constraint_error},
1241   {&SS$_INTDIV,     &constraint_error},
1242   {0,               0}
1243 };
1244
1245 /* To deal with VMS conditions and their mapping to Ada exceptions,
1246    the __gnat_error_handler routine below is installed as an exception
1247    vector having precedence over DEC frame handlers.  Some conditions
1248    still need to be handled by such handlers, however, in which case
1249    __gnat_error_handler needs to return SS$_RESIGNAL.  Consider for
1250    instance the use of a third party library compiled with DECAda and
1251    performing its own exception handling internally.
1252
1253    To allow some user-level flexibility, which conditions should be
1254    resignaled is controlled by a predicate function, provided with the
1255    condition value and returning a boolean indication stating whether
1256    this condition should be resignaled or not.
1257
1258    That predicate function is called indirectly, via a function pointer,
1259    by __gnat_error_handler, and changing that pointer is allowed to the
1260    user code by way of the __gnat_set_resignal_predicate interface.
1261
1262    The user level function may then implement what it likes, including
1263    for instance the maintenance of a dynamic data structure if the set
1264    of to be resignalled conditions has to change over the program's
1265    lifetime.
1266
1267    ??? This is not a perfect solution to deal with the possible
1268    interactions between the GNAT and the DECAda exception handling
1269    models and better (more general) schemes are studied.  This is so
1270    just provided as a convenient workaround in the meantime, and
1271    should be use with caution since the implementation has been kept
1272    very simple.  */
1273
1274 typedef int
1275 resignal_predicate (int code);
1276
1277 static const int * const cond_resignal_table [] = {
1278   &C$_SIGKILL,
1279   &CMA$_EXIT_THREAD,
1280   &SS$_DEBUG,
1281   &LIB$_KEYNOTFOU,
1282   &LIB$_ACTIMAGE,
1283   (int *) RDB$_STREAM_EOF,
1284   (int *) FDL$_UNPRIKW,
1285   0
1286 };
1287
1288 static const int facility_resignal_table [] = {
1289   0x1380000, /* RDB */
1290   0x2220000, /* SQL */
1291   0
1292 };
1293
1294 /* Default GNAT predicate for resignaling conditions.  */
1295
1296 static int
1297 __gnat_default_resignal_p (int code)
1298 {
1299   int i, iexcept;
1300
1301   for (i = 0; facility_resignal_table [i]; i++)
1302     if ((code & 0xfff0000) == facility_resignal_table [i])
1303       return 1;
1304
1305   for (i = 0, iexcept = 0;
1306        cond_resignal_table [i] &&
1307        !(iexcept = LIB$MATCH_COND (&code, &cond_resignal_table [i]));
1308        i++);
1309
1310   return iexcept;
1311 }
1312
1313 /* Static pointer to predicate that the __gnat_error_handler exception
1314    vector invokes to determine if it should resignal a condition.  */
1315
1316 static resignal_predicate *__gnat_resignal_p = __gnat_default_resignal_p;
1317
1318 /* User interface to change the predicate pointer to PREDICATE. Reset to
1319    the default if PREDICATE is null.  */
1320
1321 void
1322 __gnat_set_resignal_predicate (resignal_predicate *predicate)
1323 {
1324   if (predicate == NULL)
1325     __gnat_resignal_p = __gnat_default_resignal_p;
1326   else
1327     __gnat_resignal_p = predicate;
1328 }
1329
1330 /* Should match System.Parameters.Default_Exception_Msg_Max_Length.  */
1331 #define Default_Exception_Msg_Max_Length 512
1332
1333 /* Action routine for SYS$PUTMSG. There may be multiple
1334    conditions, each with text to be appended to MESSAGE
1335    and separated by line termination.  */
1336
1337 static int
1338 copy_msg (struct descriptor_s *msgdesc, char *message)
1339 {
1340   int len = strlen (message);
1341   int copy_len;
1342
1343   /* Check for buffer overflow and skip.  */
1344   if (len > 0 && len <= Default_Exception_Msg_Max_Length - 3)
1345     {
1346       strcat (message, "\r\n");
1347       len += 2;
1348     }
1349
1350   /* Check for buffer overflow and truncate if necessary.  */
1351   copy_len = (len + msgdesc->len <= Default_Exception_Msg_Max_Length - 1 ?
1352               msgdesc->len :
1353               Default_Exception_Msg_Max_Length - 1 - len);
1354   strncpy (&message [len], msgdesc->adr, copy_len);
1355   message [len + copy_len] = 0;
1356
1357   return 0;
1358 }
1359
1360 long
1361 __gnat_handle_vms_condition (int *sigargs, void *mechargs)
1362 {
1363   struct Exception_Data *exception = 0;
1364   Exception_Code base_code;
1365   struct descriptor_s gnat_facility = {4, 0, "GNAT"};
1366   char message [Default_Exception_Msg_Max_Length];
1367
1368   const char *msg = "";
1369
1370   /* Check for conditions to resignal which aren't effected by pragma
1371      Import_Exception.  */
1372   if (__gnat_resignal_p (sigargs [1]))
1373     return SS$_RESIGNAL;
1374
1375 #ifdef IN_RTS
1376   /* See if it's an imported exception.  Beware that registered exceptions
1377      are bound to their base code, with the severity bits masked off.  */
1378   base_code = Base_Code_In ((Exception_Code) sigargs[1]);
1379   exception = Coded_Exception (base_code);
1380
1381   if (exception)
1382     {
1383       message[0] = 0;
1384
1385       /* Subtract PC & PSL fields which messes with PUTMSG.  */
1386       sigargs[0] -= 2;
1387       SYS$PUTMSG (sigargs, copy_msg, &gnat_facility, message);
1388       sigargs[0] += 2;
1389       msg = message;
1390
1391       exception->Name_Length = 19;
1392       /* ??? The full name really should be get sys$getmsg returns.  */
1393       exception->Full_Name = "IMPORTED_EXCEPTION";
1394       exception->Import_Code = base_code;
1395
1396 #ifdef __IA64
1397       /* Do not adjust the program counter as already points to the next
1398          instruction (just after the call to LIB$STOP).  */
1399       Raise_From_Signal_Handler (exception, msg);
1400 #endif
1401     }
1402 #endif
1403
1404   if (exception == 0)
1405     switch (sigargs[1])
1406       {
1407       case SS$_ACCVIO:
1408         if (sigargs[3] == 0)
1409           {
1410             exception = &constraint_error;
1411             msg = "access zero";
1412           }
1413         else
1414           {
1415             exception = &storage_error;
1416             msg = "stack overflow (or erroneous memory access)";
1417           }
1418         __gnat_adjust_context_for_raise (SS$_ACCVIO, (void *)mechargs);
1419         break;
1420
1421       case SS$_STKOVF:
1422         exception = &storage_error;
1423         msg = "stack overflow";
1424         __gnat_adjust_context_for_raise (SS$_STKOVF, (void *)mechargs);
1425         break;
1426
1427       case SS$_HPARITH:
1428 #ifndef IN_RTS
1429         return SS$_RESIGNAL; /* toplev.c handles for compiler */
1430 #else
1431         exception = &constraint_error;
1432         msg = "arithmetic error";
1433         __gnat_adjust_context_for_raise (SS$_HPARITH, (void *)mechargs);
1434 #endif
1435         break;
1436
1437       default:
1438 #ifdef IN_RTS
1439         {
1440           int i;
1441
1442           /* Scan the DEC Ada exception condition table for a match and fetch
1443              the associated GNAT exception pointer.  */
1444           for (i = 0;
1445                dec_ada_cond_except_table [i].cond &&
1446                !LIB$MATCH_COND (&sigargs [1],
1447                                 &dec_ada_cond_except_table [i].cond);
1448                i++);
1449           exception = (struct Exception_Data *)
1450             dec_ada_cond_except_table [i].except;
1451
1452           if (!exception)
1453             {
1454               /* Scan the VMS standard condition table for a match and fetch
1455                  the associated GNAT exception pointer.  */
1456               for (i = 0;
1457                    cond_except_table[i].cond &&
1458                    !LIB$MATCH_COND (&sigargs[1], &cond_except_table[i].cond);
1459                    i++);
1460               exception = (struct Exception_Data *)
1461                 cond_except_table [i].except;
1462
1463               if (!exception)
1464                 /* User programs expect Non_Ada_Error to be raised, reference
1465                    DEC Ada test CXCONDHAN.  */
1466                 exception = &Non_Ada_Error;
1467             }
1468         }
1469 #else
1470         exception = &program_error;
1471 #endif
1472         message[0] = 0;
1473         /* Subtract PC & PSL fields which messes with PUTMSG.  */
1474         sigargs[0] -= 2;
1475         SYS$PUTMSG (sigargs, copy_msg, &gnat_facility, message);
1476         sigargs[0] += 2;
1477         msg = message;
1478         break;
1479       }
1480
1481   Raise_From_Signal_Handler (exception, msg);
1482 }
1483
1484 void
1485 __gnat_install_handler (void)
1486 {
1487   long prvhnd ATTRIBUTE_UNUSED;
1488
1489 #if !defined (IN_RTS)
1490   SYS$SETEXV (1, __gnat_handle_vms_condition, 3, &prvhnd);
1491 #endif
1492
1493   __gnat_handler_installed = 1;
1494 }
1495
1496 /* __gnat_adjust_context_for_raise for Alpha - see comments along with the
1497    default version later in this file.  */
1498
1499 #if defined (IN_RTS) && defined (__alpha__)
1500
1501 #include <vms/chfctxdef.h>
1502 #include <vms/chfdef.h>
1503
1504 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
1505
1506 void
1507 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
1508 {
1509   if (signo == SS$_HPARITH)
1510     {
1511       /* Sub one to the address of the instruction signaling the condition,
1512          located in the sigargs array.  */
1513
1514       CHF$MECH_ARRAY * mechargs = (CHF$MECH_ARRAY *) ucontext;
1515       CHF$SIGNAL_ARRAY * sigargs
1516         = (CHF$SIGNAL_ARRAY *) mechargs->chf$q_mch_sig_addr;
1517
1518       int vcount = sigargs->chf$is_sig_args;
1519       int * pc_slot = & (&sigargs->chf$l_sig_name)[vcount-2];
1520
1521       (*pc_slot)--;
1522     }
1523 }
1524
1525 #endif
1526
1527 /* __gnat_adjust_context_for_raise for ia64.  */
1528
1529 #if defined (IN_RTS) && defined (__IA64)
1530
1531 #include <vms/chfctxdef.h>
1532 #include <vms/chfdef.h>
1533
1534 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
1535
1536 typedef unsigned long long u64;
1537
1538 void
1539 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
1540 {
1541   /* Add one to the address of the instruction signaling the condition,
1542      located in the 64bits sigargs array.  */
1543
1544   CHF$MECH_ARRAY * mechargs = (CHF$MECH_ARRAY *) ucontext;
1545
1546   CHF64$SIGNAL_ARRAY *chfsig64
1547     = (CHF64$SIGNAL_ARRAY *) mechargs->chf$ph_mch_sig64_addr;
1548
1549   u64 * post_sigarray
1550     = (u64 *)chfsig64 + 1 + chfsig64->chf64$l_sig_args;
1551
1552   u64 * ih_pc_loc = post_sigarray - 2;
1553
1554   (*ih_pc_loc) ++;
1555 }
1556
1557 #endif
1558
1559 /* Easier interface for LIB$GET_LOGICAL: put the equivalence of NAME into BUF,
1560    always NUL terminated.  In case of error or if the result is longer than
1561    LEN (length of BUF) an empty string is written info BUF.  */
1562
1563 static void
1564 __gnat_vms_get_logical (const char *name, char *buf, int len)
1565 {
1566   struct descriptor_s name_desc, result_desc;
1567   int status;
1568   unsigned short rlen;
1569
1570   /* Build the descriptor for NAME.  */
1571   name_desc.len = strlen (name);
1572   name_desc.mbz = 0;
1573   name_desc.adr = (char *)name;
1574
1575   /* Build the descriptor for the result.  */
1576   result_desc.len = len;
1577   result_desc.mbz = 0;
1578   result_desc.adr = buf;
1579
1580   status = LIB$GET_LOGICAL (&name_desc, &result_desc, &rlen);
1581
1582   if ((status & 1) == 1 && rlen < len)
1583     buf[rlen] = 0;
1584   else
1585     buf[0] = 0;
1586 }
1587
1588 /* Size of a page on ia64 and alpha VMS.  */
1589 #define VMS_PAGESIZE 8192
1590
1591 /* User mode.  */
1592 #define PSL__C_USER 3
1593
1594 /* No access.  */
1595 #define PRT__C_NA 0
1596
1597 /* Descending region.  */
1598 #define VA__M_DESCEND 1
1599
1600 /* Get by virtual address.  */
1601 #define VA___REGSUM_BY_VA 1
1602
1603 /* Memory region summary.  */
1604 struct regsum
1605 {
1606   unsigned long long q_region_id;
1607   unsigned int l_flags;
1608   unsigned int l_region_protection;
1609   void *pq_start_va;
1610   unsigned long long q_region_size;
1611   void *pq_first_free_va;
1612 };
1613
1614 extern int SYS$GET_REGION_INFO (unsigned int, unsigned long long *,
1615                                 void *, void *, unsigned int,
1616                                 void *, unsigned int *);
1617 extern int SYS$EXPREG_64 (unsigned long long *, unsigned long long,
1618                           unsigned int, unsigned int, void **,
1619                           unsigned long long *);
1620 extern int SYS$SETPRT_64 (void *, unsigned long long, unsigned int,
1621                           unsigned int, void **, unsigned long long *,
1622                           unsigned int *);
1623 extern int SYS$PUTMSG (void *, int (*)(), void *, unsigned long long);
1624
1625 /* Add a guard page in the memory region containing ADDR at ADDR +/- SIZE.
1626    (The sign depends on the kind of the memory region).  */
1627
1628 static int
1629 __gnat_set_stack_guard_page (void *addr, unsigned long size)
1630 {
1631   int status;
1632   void *ret_va;
1633   unsigned long long ret_len;
1634   unsigned int ret_prot;
1635   void *start_va;
1636   unsigned long long length;
1637   unsigned int retlen;
1638   struct regsum buffer;
1639
1640   /* Get the region for ADDR.  */
1641   status = SYS$GET_REGION_INFO
1642     (VA___REGSUM_BY_VA, NULL, addr, NULL, sizeof (buffer), &buffer, &retlen);
1643
1644   if ((status & 1) != 1)
1645     return -1;
1646
1647   /* Extend the region.  */
1648   status = SYS$EXPREG_64 (&buffer.q_region_id,
1649                           size, 0, 0, &start_va, &length);
1650
1651   if ((status & 1) != 1)
1652     return -1;
1653
1654   /* Create a guard page.  */
1655   if (!(buffer.l_flags & VA__M_DESCEND))
1656     start_va = (void *)((unsigned long long)start_va + length - VMS_PAGESIZE);
1657
1658   status = SYS$SETPRT_64 (start_va, VMS_PAGESIZE, PSL__C_USER, PRT__C_NA,
1659                           &ret_va, &ret_len, &ret_prot);
1660
1661   if ((status & 1) != 1)
1662     return -1;
1663   return 0;
1664 }
1665
1666 /* Read logicals to limit the stack(s) size.  */
1667
1668 static void
1669 __gnat_set_stack_limit (void)
1670 {
1671 #ifdef __ia64__
1672   void *sp;
1673   unsigned long size;
1674   char value[16];
1675   char *e;
1676
1677   /* The main stack.  */
1678   __gnat_vms_get_logical ("GNAT_STACK_SIZE", value, sizeof (value));
1679   size = strtoul (value, &e, 0);
1680   if (e > value && *e == 0)
1681     {
1682       asm ("mov %0=sp" : "=r" (sp));
1683       __gnat_set_stack_guard_page (sp, size * 1024);
1684     }
1685
1686   /* The register stack.  */
1687   __gnat_vms_get_logical ("GNAT_RBS_SIZE", value, sizeof (value));
1688   size = strtoul (value, &e, 0);
1689   if (e > value && *e == 0)
1690     {
1691       asm ("mov %0=ar.bsp" : "=r" (sp));
1692       __gnat_set_stack_guard_page (sp, size * 1024);
1693     }
1694 #endif
1695 }
1696
1697 /* Feature logical name and global variable address pair.
1698    If we ever add another feature logical to this list, the
1699    feature struct will need to be enhanced to take into account
1700    possible values for *gl_addr.  */
1701 struct feature {
1702   const char *name;
1703   int *gl_addr;
1704 };
1705
1706 /* Default values for GNAT features set by environment.  */
1707 int __gl_heap_size = 64;
1708
1709 /* Array feature logical names and global variable addresses.  */
1710 static const struct feature features[] = {
1711   {"GNAT$NO_MALLOC_64", &__gl_heap_size},
1712   {0, 0}
1713 };
1714
1715 void
1716 __gnat_set_features (void)
1717 {
1718   int i;
1719   char buff[16];
1720
1721   /* Loop through features array and test name for enable/disable.  */
1722   for (i = 0; features[i].name; i++)
1723     {
1724       __gnat_vms_get_logical (features[i].name, buff, sizeof (buff));
1725
1726       if (strcmp (buff, "ENABLE") == 0
1727           || strcmp (buff, "TRUE") == 0
1728           || strcmp (buff, "1") == 0)
1729         *features[i].gl_addr = 32;
1730       else if (strcmp (buff, "DISABLE") == 0
1731                || strcmp (buff, "FALSE") == 0
1732                || strcmp (buff, "0") == 0)
1733         *features[i].gl_addr = 64;
1734     }
1735
1736   /* Features to artificially limit the stack size.  */
1737   __gnat_set_stack_limit ();
1738
1739   __gnat_features_set = 1;
1740 }
1741
1742 /*******************/
1743 /* FreeBSD Section */
1744 /*******************/
1745
1746 #elif defined (__FreeBSD__)
1747
1748 #include <signal.h>
1749 #include <sys/ucontext.h>
1750 #include <unistd.h>
1751
1752 static void
1753 __gnat_error_handler (int sig,
1754                       siginfo_t *si ATTRIBUTE_UNUSED,
1755                       void *ucontext ATTRIBUTE_UNUSED)
1756 {
1757   struct Exception_Data *exception;
1758   const char *msg;
1759
1760   switch (sig)
1761     {
1762     case SIGFPE:
1763       exception = &constraint_error;
1764       msg = "SIGFPE";
1765       break;
1766
1767     case SIGILL:
1768       exception = &constraint_error;
1769       msg = "SIGILL";
1770       break;
1771
1772     case SIGSEGV:
1773       exception = &storage_error;
1774       msg = "stack overflow or erroneous memory access";
1775       break;
1776
1777     case SIGBUS:
1778       exception = &constraint_error;
1779       msg = "SIGBUS";
1780       break;
1781
1782     default:
1783       exception = &program_error;
1784       msg = "unhandled signal";
1785     }
1786
1787   Raise_From_Signal_Handler (exception, msg);
1788 }
1789
1790 void
1791 __gnat_install_handler ()
1792 {
1793   struct sigaction act;
1794
1795   /* Set up signal handler to map synchronous signals to appropriate
1796      exceptions.  Make sure that the handler isn't interrupted by another
1797      signal that might cause a scheduling event!  */
1798
1799   act.sa_sigaction
1800     = (void (*)(int, struct __siginfo *, void*)) __gnat_error_handler;
1801   act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
1802   (void) sigemptyset (&act.sa_mask);
1803
1804   (void) sigaction (SIGILL,  &act, NULL);
1805   (void) sigaction (SIGFPE,  &act, NULL);
1806   (void) sigaction (SIGSEGV, &act, NULL);
1807   (void) sigaction (SIGBUS,  &act, NULL);
1808
1809   __gnat_handler_installed = 1;
1810 }
1811
1812 /*******************/
1813 /* VxWorks Section */
1814 /*******************/
1815
1816 #elif defined(__vxworks)
1817
1818 #include <signal.h>
1819 #include <taskLib.h>
1820
1821 #ifndef __RTP__
1822 #include <intLib.h>
1823 #include <iv.h>
1824 #endif
1825
1826 #ifdef VTHREADS
1827 #include "private/vThreadsP.h"
1828 #endif
1829
1830 void __gnat_error_handler (int, void *, struct sigcontext *);
1831
1832 #ifndef __RTP__
1833
1834 /* Directly vectored Interrupt routines are not supported when using RTPs.  */
1835
1836 extern int __gnat_inum_to_ivec (int);
1837
1838 /* This is needed by the GNAT run time to handle Vxworks interrupts.  */
1839 int
1840 __gnat_inum_to_ivec (int num)
1841 {
1842   return INUM_TO_IVEC (num);
1843 }
1844 #endif
1845
1846 #if !defined(__alpha_vxworks) && (_WRS_VXWORKS_MAJOR != 6) && !defined(__RTP__)
1847
1848 /* getpid is used by s-parint.adb, but is not defined by VxWorks, except
1849    on Alpha VxWorks and VxWorks 6.x (including RTPs).  */
1850
1851 extern long getpid (void);
1852
1853 long
1854 getpid (void)
1855 {
1856   return taskIdSelf ();
1857 }
1858 #endif
1859
1860 /* VxWorks 653 vThreads expects the field excCnt to be zeroed when a signal is.
1861    handled. The VxWorks version of longjmp does this; GCC's builtin_longjmp
1862    doesn't.  */
1863 void
1864 __gnat_clear_exception_count (void)
1865 {
1866 #ifdef VTHREADS
1867   WIND_TCB *currentTask = (WIND_TCB *) taskIdSelf();
1868
1869   currentTask->vThreads.excCnt = 0;
1870 #endif
1871 }
1872
1873 /* Handle different SIGnal to exception mappings in different VxWorks
1874    versions.   */
1875 static void
1876 __gnat_map_signal (int sig)
1877 {
1878   struct Exception_Data *exception;
1879   const char *msg;
1880
1881   switch (sig)
1882     {
1883     case SIGFPE:
1884       exception = &constraint_error;
1885       msg = "SIGFPE";
1886       break;
1887 #ifdef VTHREADS
1888 #ifdef __VXWORKSMILS__
1889     case SIGILL:
1890       exception = &storage_error;
1891       msg = "SIGILL: possible stack overflow";
1892       break;
1893     case SIGSEGV:
1894       exception = &storage_error;
1895       msg = "SIGSEGV";
1896       break;
1897     case SIGBUS:
1898       exception = &program_error;
1899       msg = "SIGBUS";
1900       break;
1901 #else
1902     case SIGILL:
1903       exception = &constraint_error;
1904       msg = "Floating point exception or SIGILL";
1905       break;
1906     case SIGSEGV:
1907       exception = &storage_error;
1908       msg = "SIGSEGV";
1909       break;
1910     case SIGBUS:
1911       exception = &storage_error;
1912       msg = "SIGBUS: possible stack overflow";
1913       break;
1914 #endif
1915 #elif (_WRS_VXWORKS_MAJOR == 6)
1916     case SIGILL:
1917       exception = &constraint_error;
1918       msg = "SIGILL";
1919       break;
1920 #ifdef __RTP__
1921     /* In RTP mode a SIGSEGV is most likely due to a stack overflow,
1922        since stack checking uses the probing mechanism.  */
1923     case SIGSEGV:
1924       exception = &storage_error;
1925       msg = "SIGSEGV: possible stack overflow";
1926       break;
1927     case SIGBUS:
1928       exception = &program_error;
1929       msg = "SIGBUS";
1930       break;
1931 #else
1932       /* VxWorks 6 kernel mode with probing. SIGBUS for guard page hit */
1933     case SIGSEGV:
1934       exception = &storage_error;
1935       msg = "SIGSEGV";
1936       break;
1937     case SIGBUS:
1938       exception = &storage_error;
1939       msg = "SIGBUS: possible stack overflow";
1940       break;
1941 #endif
1942 #else
1943     /* VxWorks 5: a SIGILL is most likely due to a stack overflow,
1944        since stack checking uses the stack limit mechanism.  */
1945     case SIGILL:
1946       exception = &storage_error;
1947       msg = "SIGILL: possible stack overflow";
1948       break;
1949     case SIGSEGV:
1950       exception = &storage_error;
1951       msg = "SIGSEGV";
1952       break;
1953     case SIGBUS:
1954       exception = &program_error;
1955       msg = "SIGBUS";
1956       break;
1957 #endif
1958     default:
1959       exception = &program_error;
1960       msg = "unhandled signal";
1961     }
1962
1963   __gnat_clear_exception_count ();
1964   Raise_From_Signal_Handler (exception, msg);
1965 }
1966
1967 /* Tasking and Non-tasking signal handler.  Map SIGnal to Ada exception
1968    propagation after the required low level adjustments.  */
1969
1970 void
1971 __gnat_error_handler (int sig,
1972                       void *si ATTRIBUTE_UNUSED,
1973                       struct sigcontext *sc ATTRIBUTE_UNUSED)
1974 {
1975   sigset_t mask;
1976
1977   /* VxWorks will always mask out the signal during the signal handler and
1978      will reenable it on a longjmp.  GNAT does not generate a longjmp to
1979      return from a signal handler so the signal will still be masked unless
1980      we unmask it.  */
1981   sigprocmask (SIG_SETMASK, NULL, &mask);
1982   sigdelset (&mask, sig);
1983   sigprocmask (SIG_SETMASK, &mask, NULL);
1984
1985   __gnat_map_signal (sig);
1986 }
1987
1988 void
1989 __gnat_install_handler (void)
1990 {
1991   struct sigaction act;
1992
1993   /* Setup signal handler to map synchronous signals to appropriate
1994      exceptions.  Make sure that the handler isn't interrupted by another
1995      signal that might cause a scheduling event!  */
1996
1997   act.sa_handler = __gnat_error_handler;
1998   act.sa_flags = SA_SIGINFO | SA_ONSTACK;
1999   sigemptyset (&act.sa_mask);
2000
2001   /* For VxWorks, install all signal handlers, since pragma Interrupt_State
2002      applies to vectored hardware interrupts, not signals.  */
2003   sigaction (SIGFPE,  &act, NULL);
2004   sigaction (SIGILL,  &act, NULL);
2005   sigaction (SIGSEGV, &act, NULL);
2006   sigaction (SIGBUS,  &act, NULL);
2007
2008   __gnat_handler_installed = 1;
2009 }
2010
2011 #define HAVE_GNAT_INIT_FLOAT
2012
2013 void
2014 __gnat_init_float (void)
2015 {
2016   /* Disable overflow/underflow exceptions on the PPC processor, needed
2017      to get correct Ada semantics.  Note that for AE653 vThreads, the HW
2018      overflow settings are an OS configuration issue.  The instructions
2019      below have no effect.  */
2020 #if defined (_ARCH_PPC) && !defined (_SOFT_FLOAT) && !defined (VTHREADS)
2021 #if defined (__SPE__)
2022   {
2023      const unsigned long spefscr_mask = 0xfffffff3;
2024      unsigned long spefscr;
2025      asm ("mfspr  %0, 512" : "=r" (spefscr));
2026      spefscr = spefscr & spefscr_mask;
2027      asm ("mtspr 512, %0\n\tisync" : : "r" (spefscr));
2028   }
2029 #else
2030   asm ("mtfsb0 25");
2031   asm ("mtfsb0 26");
2032 #endif
2033 #endif
2034
2035 #if (defined (__i386__) || defined (i386)) && !defined (VTHREADS)
2036   /* This is used to properly initialize the FPU on an x86 for each
2037      process thread.  */
2038   asm ("finit");
2039 #endif
2040
2041   /* Similarly for SPARC64.  Achieved by masking bits in the Trap Enable Mask
2042      field of the Floating-point Status Register (see the SPARC Architecture
2043      Manual Version 9, p 48).  */
2044 #if defined (sparc64)
2045
2046 #define FSR_TEM_NVM (1 << 27)  /* Invalid operand  */
2047 #define FSR_TEM_OFM (1 << 26)  /* Overflow  */
2048 #define FSR_TEM_UFM (1 << 25)  /* Underflow  */
2049 #define FSR_TEM_DZM (1 << 24)  /* Division by Zero  */
2050 #define FSR_TEM_NXM (1 << 23)  /* Inexact result  */
2051   {
2052     unsigned int fsr;
2053
2054     __asm__("st %%fsr, %0" : "=m" (fsr));
2055     fsr &= ~(FSR_TEM_OFM | FSR_TEM_UFM);
2056     __asm__("ld %0, %%fsr" : : "m" (fsr));
2057   }
2058 #endif
2059 }
2060
2061 /* This subprogram is called by System.Task_Primitives.Operations.Enter_Task
2062    (if not null) when a new task is created.  It is initialized by
2063    System.Stack_Checking.Operations.Initialize_Stack_Limit.
2064    The use of a hook avoids to drag stack checking subprograms if stack
2065    checking is not used.  */
2066 void (*__gnat_set_stack_limit_hook)(void) = (void (*)(void))0;
2067
2068 /******************/
2069 /* NetBSD Section */
2070 /******************/
2071
2072 #elif defined(__NetBSD__)
2073
2074 #include <signal.h>
2075 #include <unistd.h>
2076
2077 static void
2078 __gnat_error_handler (int sig)
2079 {
2080   struct Exception_Data *exception;
2081   const char *msg;
2082
2083   switch(sig)
2084   {
2085     case SIGFPE:
2086       exception = &constraint_error;
2087       msg = "SIGFPE";
2088       break;
2089     case SIGILL:
2090       exception = &constraint_error;
2091       msg = "SIGILL";
2092       break;
2093     case SIGSEGV:
2094       exception = &storage_error;
2095       msg = "stack overflow or erroneous memory access";
2096       break;
2097     case SIGBUS:
2098       exception = &constraint_error;
2099       msg = "SIGBUS";
2100       break;
2101     default:
2102       exception = &program_error;
2103       msg = "unhandled signal";
2104     }
2105
2106     Raise_From_Signal_Handler(exception, msg);
2107 }
2108
2109 void
2110 __gnat_install_handler(void)
2111 {
2112   struct sigaction act;
2113
2114   act.sa_handler = __gnat_error_handler;
2115   act.sa_flags = SA_NODEFER | SA_RESTART;
2116   sigemptyset (&act.sa_mask);
2117
2118   /* Do not install handlers if interrupt state is "System".  */
2119   if (__gnat_get_interrupt_state (SIGFPE) != 's')
2120     sigaction (SIGFPE,  &act, NULL);
2121   if (__gnat_get_interrupt_state (SIGILL) != 's')
2122     sigaction (SIGILL,  &act, NULL);
2123   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
2124     sigaction (SIGSEGV, &act, NULL);
2125   if (__gnat_get_interrupt_state (SIGBUS) != 's')
2126     sigaction (SIGBUS,  &act, NULL);
2127
2128   __gnat_handler_installed = 1;
2129 }
2130
2131 /*******************/
2132 /* OpenBSD Section */
2133 /*******************/
2134
2135 #elif defined(__OpenBSD__)
2136
2137 #include <signal.h>
2138 #include <unistd.h>
2139
2140 static void
2141 __gnat_error_handler (int sig)
2142 {
2143   struct Exception_Data *exception;
2144   const char *msg;
2145
2146   switch(sig)
2147   {
2148     case SIGFPE:
2149       exception = &constraint_error;
2150       msg = "SIGFPE";
2151       break;
2152     case SIGILL:
2153       exception = &constraint_error;
2154       msg = "SIGILL";
2155       break;
2156     case SIGSEGV:
2157       exception = &storage_error;
2158       msg = "stack overflow or erroneous memory access";
2159       break;
2160     case SIGBUS:
2161       exception = &constraint_error;
2162       msg = "SIGBUS";
2163       break;
2164     default:
2165       exception = &program_error;
2166       msg = "unhandled signal";
2167     }
2168
2169     Raise_From_Signal_Handler(exception, msg);
2170 }
2171
2172 void
2173 __gnat_install_handler(void)
2174 {
2175   struct sigaction act;
2176
2177   act.sa_handler = __gnat_error_handler;
2178   act.sa_flags = SA_NODEFER | SA_RESTART;
2179   sigemptyset (&act.sa_mask);
2180
2181   /* Do not install handlers if interrupt state is "System" */
2182   if (__gnat_get_interrupt_state (SIGFPE) != 's')
2183     sigaction (SIGFPE,  &act, NULL);
2184   if (__gnat_get_interrupt_state (SIGILL) != 's')
2185     sigaction (SIGILL,  &act, NULL);
2186   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
2187     sigaction (SIGSEGV, &act, NULL);
2188   if (__gnat_get_interrupt_state (SIGBUS) != 's')
2189     sigaction (SIGBUS,  &act, NULL);
2190
2191   __gnat_handler_installed = 1;
2192 }
2193
2194 /******************/
2195 /* Darwin Section */
2196 /******************/
2197
2198 #elif defined(__APPLE__)
2199
2200 #include <signal.h>
2201 #include <sys/syscall.h>
2202 #include <mach/mach_vm.h>
2203 #include <mach/mach_init.h>
2204 #include <mach/vm_statistics.h>
2205
2206 /* This must be in keeping with System.OS_Interface.Alternate_Stack_Size.  */
2207 char __gnat_alternate_stack[32 * 1024]; /* 1 * MINSIGSTKSZ */
2208
2209 /* Defined in xnu unix_signal.c.
2210    Tell the kernel to re-use alt stack when delivering a signal.  */
2211 #define UC_RESET_ALT_STACK      0x80000000
2212
2213 /* Return true if ADDR is within a stack guard area.  */
2214 static int
2215 __gnat_is_stack_guard (mach_vm_address_t addr)
2216 {
2217   kern_return_t kret;
2218   vm_region_submap_info_data_64_t info;
2219   mach_vm_address_t start;
2220   mach_vm_size_t size;
2221   natural_t depth;
2222   mach_msg_type_number_t count;
2223
2224   count = VM_REGION_SUBMAP_INFO_COUNT_64;
2225   start = addr;
2226   size = -1;
2227   depth = 9999;
2228   kret = mach_vm_region_recurse (mach_task_self (), &start, &size, &depth,
2229                                  (vm_region_recurse_info_t) &info, &count);
2230   if (kret == KERN_SUCCESS
2231       && addr >= start && addr < (start + size)
2232       && info.protection == VM_PROT_NONE
2233       && info.user_tag == VM_MEMORY_STACK)
2234     return 1;
2235   return 0;
2236 }
2237
2238 static void
2239 __gnat_error_handler (int sig, siginfo_t *si, void *ucontext ATTRIBUTE_UNUSED)
2240 {
2241   struct Exception_Data *exception;
2242   const char *msg;
2243
2244   switch (sig)
2245     {
2246     case SIGSEGV:
2247     case SIGBUS:
2248       if (__gnat_is_stack_guard ((unsigned long)si->si_addr))
2249         {
2250           exception = &storage_error;
2251           msg = "stack overflow";
2252         }
2253       else
2254         {
2255           exception = &constraint_error;
2256           msg = "erroneous memory access";
2257         }
2258       /* Reset the use of alt stack, so that the alt stack will be used
2259          for the next signal delivery.
2260          The stack can't be used in case of stack checking.  */
2261       syscall (SYS_sigreturn, NULL, UC_RESET_ALT_STACK);
2262       break;
2263
2264     case SIGFPE:
2265       exception = &constraint_error;
2266       msg = "SIGFPE";
2267       break;
2268
2269     default:
2270       exception = &program_error;
2271       msg = "unhandled signal";
2272     }
2273
2274   Raise_From_Signal_Handler (exception, msg);
2275 }
2276
2277 void
2278 __gnat_install_handler (void)
2279 {
2280   struct sigaction act;
2281
2282   /* Set up signal handler to map synchronous signals to appropriate
2283      exceptions.  Make sure that the handler isn't interrupted by another
2284      signal that might cause a scheduling event!  Also setup an alternate
2285      stack region for the handler execution so that stack overflows can be
2286      handled properly, avoiding a SEGV generation from stack usage by the
2287      handler itself (and it is required by Darwin).  */
2288
2289   stack_t stack;
2290   stack.ss_sp = __gnat_alternate_stack;
2291   stack.ss_size = sizeof (__gnat_alternate_stack);
2292   stack.ss_flags = 0;
2293   sigaltstack (&stack, NULL);
2294
2295   act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
2296   act.sa_sigaction = __gnat_error_handler;
2297   sigemptyset (&act.sa_mask);
2298
2299   /* Do not install handlers if interrupt state is "System".  */
2300   if (__gnat_get_interrupt_state (SIGABRT) != 's')
2301     sigaction (SIGABRT, &act, NULL);
2302   if (__gnat_get_interrupt_state (SIGFPE) != 's')
2303     sigaction (SIGFPE,  &act, NULL);
2304   if (__gnat_get_interrupt_state (SIGILL) != 's')
2305     sigaction (SIGILL,  &act, NULL);
2306
2307   act.sa_flags |= SA_ONSTACK;
2308   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
2309     sigaction (SIGSEGV, &act, NULL);
2310   if (__gnat_get_interrupt_state (SIGBUS) != 's')
2311     sigaction (SIGBUS,  &act, NULL);
2312
2313   __gnat_handler_installed = 1;
2314 }
2315
2316 #else
2317
2318 /* For all other versions of GNAT, the handler does nothing.  */
2319
2320 /*******************/
2321 /* Default Section */
2322 /*******************/
2323
2324 void
2325 __gnat_install_handler (void)
2326 {
2327   __gnat_handler_installed = 1;
2328 }
2329
2330 #endif
2331
2332 /*********************/
2333 /* __gnat_init_float */
2334 /*********************/
2335
2336 /* This routine is called as each process thread is created, for possible
2337    initialization of the FP processor.  This version is used under INTERIX
2338    and WIN32.  */
2339
2340 #if defined (_WIN32) || defined (__INTERIX) \
2341   || defined (__Lynx__) || defined(__NetBSD__) || defined(__FreeBSD__) \
2342   || defined (__OpenBSD__)
2343
2344 #define HAVE_GNAT_INIT_FLOAT
2345
2346 void
2347 __gnat_init_float (void)
2348 {
2349 #if defined (__i386__) || defined (i386) || defined (__x86_64)
2350
2351   /* This is used to properly initialize the FPU on an x86 for each
2352      process thread.  */
2353
2354   asm ("finit");
2355
2356 #endif  /* Defined __i386__ */
2357 }
2358 #endif
2359
2360 #ifndef HAVE_GNAT_INIT_FLOAT
2361
2362 /* All targets without a specific __gnat_init_float will use an empty one.  */
2363 void
2364 __gnat_init_float (void)
2365 {
2366 }
2367 #endif
2368
2369 /***********************************/
2370 /* __gnat_adjust_context_for_raise */
2371 /***********************************/
2372
2373 #ifndef HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
2374
2375 /* All targets without a specific version will use an empty one.  */
2376
2377 /* Given UCONTEXT a pointer to a context structure received by a signal
2378    handler for SIGNO, perform the necessary adjustments to let the handler
2379    raise an exception.  Calls to this routine are not conditioned by the
2380    propagation scheme in use.  */
2381
2382 void
2383 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED,
2384                                  void *ucontext ATTRIBUTE_UNUSED)
2385 {
2386   /* We used to compensate here for the raised from call vs raised from signal
2387      exception discrepancy with the GCC ZCX scheme, but this now can be dealt
2388      with generically in the unwinder (see GCC PR other/26208).  This however
2389      requires the use of the _Unwind_GetIPInfo routine in raise-gcc.c, which
2390      is predicated on the definition of HAVE_GETIPINFO at compile time.  Only
2391      the VMS ports still do the compensation described in the few lines below.
2392
2393      *** Call vs signal exception discrepancy with GCC ZCX scheme ***
2394
2395      The GCC unwinder expects to be dealing with call return addresses, since
2396      this is the "nominal" case of what we retrieve while unwinding a regular
2397      call chain.
2398
2399      To evaluate if a handler applies at some point identified by a return
2400      address, the propagation engine needs to determine what region the
2401      corresponding call instruction pertains to.  Because the return address
2402      may not be attached to the same region as the call, the unwinder always
2403      subtracts "some" amount from a return address to search the region
2404      tables, amount chosen to ensure that the resulting address is inside the
2405      call instruction.
2406
2407      When we raise an exception from a signal handler, e.g. to transform a
2408      SIGSEGV into Storage_Error, things need to appear as if the signal
2409      handler had been "called" by the instruction which triggered the signal,
2410      so that exception handlers that apply there are considered.  What the
2411      unwinder will retrieve as the return address from the signal handler is
2412      what it will find as the faulting instruction address in the signal
2413      context pushed by the kernel.  Leaving this address untouched looses, if
2414      the triggering instruction happens to be the very first of a region, as
2415      the later adjustments performed by the unwinder would yield an address
2416      outside that region.  We need to compensate for the unwinder adjustments
2417      at some point, and this is what this routine is expected to do.
2418
2419      signo is passed because on some targets for some signals the PC in
2420      context points to the instruction after the faulting one, in which case
2421      the unwinder adjustment is still desired.  */
2422 }
2423
2424 #endif
2425
2426 #ifdef __cplusplus
2427 }
2428 #endif