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