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