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