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