gcc/ada/init.c

   1 /****************************************************************************
   2  *                                                                          *
   3  *                         GNAT COMPILER COMPONENTS                         *
   4  *                                                                          *
   5  *                                 I N I T                                  *
   6  *                                                                          *
   7  *                          C Implementation File                           *
   8  *                                                                          *
   9  *          Copyright (C) 1992-2011, Free Software Foundation, Inc.         *
  10  *                                                                          *
  11  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  12  * terms of the  GNU General Public License as published  by the Free Soft- *
  13  * ware  Foundation;  either version 3,  or (at your option) any later ver- *
  14  * sion.  GNAT is distributed in the hope that it will be useful, but WITH- *
  15  * OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY *
  16  * or FITNESS FOR A PARTICULAR PURPOSE.                                     *
  17  *                                                                          *
  18  * As a special exception under Section 7 of GPL version 3, you are granted *
  19  * additional permissions described in the GCC Runtime Library Exception,   *
  20  * version 3.1, as published by the Free Software Foundation.               *
  21  *                                                                          *
  22  * You should have received a copy of the GNU General Public License and    *
  23  * a copy of the GCC Runtime Library Exception along with this program;     *
  24  * see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    *
  25  * <http://www.gnu.org/licenses/>.                                          *
  26  *                                                                          *
  27  * GNAT was originally developed  by the GNAT team at  New York University. *
  28  * Extensive contributions were provided by Ada Core Technologies Inc.      *
  29  *                                                                          *
  30  ****************************************************************************/
  31
  32 /*  This unit contains initialization circuits that are system dependent.
  33     A major part of the functionality involves stack overflow checking.
  34     The GCC backend generates probe instructions to test for stack overflow.
  35     For details on the exact approach used to generate these probes, see the
  36     "Using and Porting GCC" manual, in particular the "Stack Checking" section
  37     and the subsection "Specifying How Stack Checking is Done".  The handlers
  38     installed by this file are used to catch the resulting signals that come
  39     from these probes failing (i.e. touching protected pages).  */
  40
  41 #ifdef __cplusplus
  42 extern "C" {
  43 #endif
  44
  45 /* This file should be kept synchronized with 2sinit.ads, 2sinit.adb,
  46    s-init-ae653-cert.adb and s-init-xi-sparc.adb.  All these files implement
  47    the required functionality for different targets.  */
  48
  49 /* The following include is here to meet the published VxWorks requirement
  50    that the __vxworks header appear before any other include.  */
  51 #ifdef __vxworks
  52 #include "vxWorks.h"
  53 #endif
  54
  55 #ifdef IN_RTS
  56 #include "tconfig.h"
  57 #include "tsystem.h"
  58 #include <sys/stat.h>
  59
  60 /* We don't have libiberty, so use malloc.  */
  61 #define xmalloc(S) malloc (S)
  62 #else
  63 #include "config.h"
  64 #include "system.h"
  65 #endif
  66
  67 #include "adaint.h"
  68 #include "raise.h"
  69
  70 extern void __gnat_raise_program_error (const char *, int);
  71
  72 /* Addresses of exception data blocks for predefined exceptions.  Tasking_Error
  73    is not used in this unit, and the abort signal is only used on IRIX.  */
  74 extern struct Exception_Data constraint_error;
  75 extern struct Exception_Data numeric_error;
  76 extern struct Exception_Data program_error;
  77 extern struct Exception_Data storage_error;
  78
  79 /* For the Cert run time we use the regular raise exception routine because
  80    Raise_From_Signal_Handler is not available.  */
  81 #ifdef CERT
  82 #define Raise_From_Signal_Handler \
  83                       __gnat_raise_exception
  84 extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *);
  85 #else
  86 #define Raise_From_Signal_Handler \
  87                       ada__exceptions__raise_from_signal_handler
  88 extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *);
  89 #endif
  90
  91 /* Global values computed by the binder.  */
  92 int   __gl_main_priority                 = -1;
  93 int   __gl_main_cpu                      = -1;
  94 int   __gl_time_slice_val                = -1;
  95 char  __gl_wc_encoding                   = 'n';
  96 char  __gl_locking_policy                = ' ';
  97 char  __gl_queuing_policy                = ' ';
  98 char  __gl_task_dispatching_policy       = ' ';
  99 char *__gl_priority_specific_dispatching = 0;
 100 int   __gl_num_specific_dispatching      = 0;
 101 char *__gl_interrupt_states              = 0;
 102 int   __gl_num_interrupt_states          = 0;
 103 int   __gl_unreserve_all_interrupts      = 0;
 104 int   __gl_exception_tracebacks          = 0;
 105 int   __gl_zero_cost_exceptions          = 0;
 106 int   __gl_detect_blocking               = 0;
 107 int   __gl_default_stack_size            = -1;
 108 int   __gl_leap_seconds_support          = 0;
 109 int   __gl_canonical_streams             = 0;
 110
 111 /* Indication of whether synchronous signal handler has already been
 112    installed by a previous call to adainit.  */
 113 int  __gnat_handler_installed      = 0;
 114
 115 #ifndef IN_RTS
 116 int __gnat_inside_elab_final_code = 0;
 117 /* ??? This variable is obsolete since 2001-08-29 but is kept to allow
 118    bootstrap from old GNAT versions (< 3.15).  */
 119 #endif
 120
 121 /* HAVE_GNAT_INIT_FLOAT must be set on every targets where a __gnat_init_float
 122    is defined.  If this is not set then a void implementation will be defined
 123    at the end of this unit.  */
 124 #undef HAVE_GNAT_INIT_FLOAT
 125
 126 /******************************/
 127 /* __gnat_get_interrupt_state */
 128 /******************************/
 129
 130 char __gnat_get_interrupt_state (int);
 131
 132 /* This routine is called from the runtime as needed to determine the state
 133    of an interrupt, as set by an Interrupt_State pragma appearing anywhere
 134    in the current partition.  The input argument is the interrupt number,
 135    and the result is one of the following:
 136
 137        'n'   this interrupt not set by any Interrupt_State pragma
 138        'u'   Interrupt_State pragma set state to User
 139        'r'   Interrupt_State pragma set state to Runtime
 140        's'   Interrupt_State pragma set state to System  */
 141
 142 char
 143 __gnat_get_interrupt_state (int intrup)
 144 {
 145   if (intrup >= __gl_num_interrupt_states)
 146     return 'n';
 147   else
 148     return __gl_interrupt_states [intrup];
 149 }
 150
 151 /***********************************/
 152 /* __gnat_get_specific_dispatching */
 153 /***********************************/
 154
 155 char __gnat_get_specific_dispatching (int);
 156
 157 /* This routine is called from the runtime as needed to determine the
 158    priority specific dispatching policy, as set by a
 159    Priority_Specific_Dispatching pragma appearing anywhere in the current
 160    partition.  The input argument is the priority number, and the result
 161    is the upper case first character of the policy name, e.g. 'F' for
 162    FIFO_Within_Priorities. A space ' ' is returned if no
 163    Priority_Specific_Dispatching pragma is used in the partition.  */
 164
 165 char
 166 __gnat_get_specific_dispatching (int priority)
 167 {
 168   if (__gl_num_specific_dispatching == 0)
 169     return ' ';
 170   else if (priority >= __gl_num_specific_dispatching)
 171     return 'F';
 172   else
 173     return __gl_priority_specific_dispatching [priority];
 174 }
 175
 176 #ifndef IN_RTS
 177
 178 /**********************/
 179 /* __gnat_set_globals */
 180 /**********************/
 181
 182 /* This routine is kept for bootstrapping purposes, since the binder generated
 183    file now sets the __gl_* variables directly.  */
 184
 185 void
 186 __gnat_set_globals (void)
 187 {
 188 }
 189
 190 #endif
 191
 192 /***************/
 193 /* AIX Section */
 194 /***************/
 195
 196 #if defined (_AIX)
 197
 198 #include <signal.h>
 199 #include <sys/time.h>
 200
 201 /* Some versions of AIX don't define SA_NODEFER.  */
 202
 203 #ifndef SA_NODEFER
 204 #define SA_NODEFER 0
 205 #endif /* SA_NODEFER */
 206
 207 /* Versions of AIX before 4.3 don't have nanosleep but provide
 208    nsleep instead.  */
 209
 210 #ifndef _AIXVERSION_430
 211
 212 extern int nanosleep (struct timestruc_t *, struct timestruc_t *);
 213
 214 int
 215 nanosleep (struct timestruc_t *Rqtp, struct timestruc_t *Rmtp)
 216 {
 217   return nsleep (Rqtp, Rmtp);
 218 }
 219
 220 #endif /* _AIXVERSION_430 */
 221
 222 /* 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 = &constraint_error;
 665       msg = "SIGBUS";
 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 CMA$_EXIT_THREAD;
1121 extern int SS$_DEBUG;
1122 extern int SS$_INTDIV;
1123 extern int LIB$_KEYNOTFOU;
1124 extern int LIB$_ACTIMAGE;
1125 extern int MTH$_FLOOVEMAT;       /* Some ACVC_21 CXA tests */
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   const 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 as external addresses.  */
1185
1186 extern int ADA$_PROGRAM_ERROR;
1187 extern int ADA$_LOCK_ERROR;
1188 extern int ADA$_EXISTENCE_ERROR;
1189 extern int ADA$_KEY_ERROR;
1190 extern int ADA$_KEYSIZERR;
1191 extern int ADA$_STAOVF;
1192 extern int ADA$_CONSTRAINT_ERRO;
1193 extern int ADA$_IOSYSFAILED;
1194 extern int ADA$_LAYOUT_ERROR;
1195 extern int ADA$_STORAGE_ERROR;
1196 extern int ADA$_DATA_ERROR;
1197 extern int ADA$_DEVICE_ERROR;
1198 extern int ADA$_END_ERROR;
1199 extern int ADA$_MODE_ERROR;
1200 extern int ADA$_NAME_ERROR;
1201 extern int ADA$_STATUS_ERROR;
1202 extern int ADA$_NOT_OPEN;
1203 extern int ADA$_ALREADY_OPEN;
1204 extern int ADA$_USE_ERROR;
1205 extern int ADA$_UNSUPPORTED;
1206 extern int ADA$_FAC_MODE_MISMAT;
1207 extern int ADA$_ORG_MISMATCH;
1208 extern int ADA$_RFM_MISMATCH;
1209 extern int ADA$_RAT_MISMATCH;
1210 extern int ADA$_MRS_MISMATCH;
1211 extern int ADA$_MRN_MISMATCH;
1212 extern int ADA$_KEY_MISMATCH;
1213 extern int ADA$_MAXLINEXC;
1214 extern int ADA$_LINEXCMRS;
1215
1216 /* DEC Ada specific conditions.  */
1217 static const struct cond_except dec_ada_cond_except_table [] = {
1218   {&ADA$_PROGRAM_ERROR,   &program_error},
1219   {&ADA$_USE_ERROR,       &Use_Error},
1220   {&ADA$_KEYSIZERR,       &program_error},
1221   {&ADA$_STAOVF,          &storage_error},
1222   {&ADA$_CONSTRAINT_ERRO, &constraint_error},
1223   {&ADA$_IOSYSFAILED,     &Device_Error},
1224   {&ADA$_LAYOUT_ERROR,    &Layout_Error},
1225   {&ADA$_STORAGE_ERROR,   &storage_error},
1226   {&ADA$_DATA_ERROR,      &Data_Error},
1227   {&ADA$_DEVICE_ERROR,    &Device_Error},
1228   {&ADA$_END_ERROR,       &End_Error},
1229   {&ADA$_MODE_ERROR,      &Mode_Error},
1230   {&ADA$_NAME_ERROR,      &Name_Error},
1231   {&ADA$_STATUS_ERROR,    &Status_Error},
1232   {&ADA$_NOT_OPEN,        &Use_Error},
1233   {&ADA$_ALREADY_OPEN,    &Use_Error},
1234   {&ADA$_USE_ERROR,       &Use_Error},
1235   {&ADA$_UNSUPPORTED,     &Use_Error},
1236   {&ADA$_FAC_MODE_MISMAT, &Use_Error},
1237   {&ADA$_ORG_MISMATCH,    &Use_Error},
1238   {&ADA$_RFM_MISMATCH,    &Use_Error},
1239   {&ADA$_RAT_MISMATCH,    &Use_Error},
1240   {&ADA$_MRS_MISMATCH,    &Use_Error},
1241   {&ADA$_MRN_MISMATCH,    &Use_Error},
1242   {&ADA$_KEY_MISMATCH,    &Use_Error},
1243   {&ADA$_MAXLINEXC,       &constraint_error},
1244   {&ADA$_LINEXCMRS,       &constraint_error},
1245   {0,                     0}
1246 };
1247
1248 #if 0
1249    /* Already handled by a pragma Import_Exception
1250       in Aux_IO_Exceptions */
1251   {&ADA$_LOCK_ERROR,      &Lock_Error},
1252   {&ADA$_EXISTENCE_ERROR, &Existence_Error},
1253   {&ADA$_KEY_ERROR,       &Key_Error},
1254 #endif
1255
1256 #endif /* IN_RTS */
1257
1258 /* Non-DEC Ada specific conditions.  We could probably also put
1259    SS$_HPARITH here and possibly SS$_ACCVIO, SS$_STKOVF.  */
1260 static const struct cond_except cond_except_table [] = {
1261   {&MTH$_FLOOVEMAT, &constraint_error},
1262   {&SS$_INTDIV,     &constraint_error},
1263   {0,               0}
1264 };
1265
1266 /* To deal with VMS conditions and their mapping to Ada exceptions,
1267    the __gnat_error_handler routine below is installed as an exception
1268    vector having precedence over DEC frame handlers.  Some conditions
1269    still need to be handled by such handlers, however, in which case
1270    __gnat_error_handler needs to return SS$_RESIGNAL.  Consider for
1271    instance the use of a third party library compiled with DECAda and
1272    performing its own exception handling internally.
1273
1274    To allow some user-level flexibility, which conditions should be
1275    resignaled is controlled by a predicate function, provided with the
1276    condition value and returning a boolean indication stating whether
1277    this condition should be resignaled or not.
1278
1279    That predicate function is called indirectly, via a function pointer,
1280    by __gnat_error_handler, and changing that pointer is allowed to the
1281    user code by way of the __gnat_set_resignal_predicate interface.
1282
1283    The user level function may then implement what it likes, including
1284    for instance the maintenance of a dynamic data structure if the set
1285    of to be resignalled conditions has to change over the program's
1286    lifetime.
1287
1288    ??? This is not a perfect solution to deal with the possible
1289    interactions between the GNAT and the DECAda exception handling
1290    models and better (more general) schemes are studied.  This is so
1291    just provided as a convenient workaround in the meantime, and
1292    should be use with caution since the implementation has been kept
1293    very simple.  */
1294
1295 typedef int
1296 resignal_predicate (int code);
1297
1298 static const int * const cond_resignal_table [] = {
1299   &C$_SIGKILL,
1300   &CMA$_EXIT_THREAD,
1301   &SS$_DEBUG,
1302   &LIB$_KEYNOTFOU,
1303   &LIB$_ACTIMAGE,
1304   (int *) RDB$_STREAM_EOF,
1305   (int *) FDL$_UNPRIKW,
1306   0
1307 };
1308
1309 static const int facility_resignal_table [] = {
1310   0x1380000, /* RDB */
1311   0x2220000, /* SQL */
1312   0
1313 };
1314
1315 /* Default GNAT predicate for resignaling conditions.  */
1316
1317 static int
1318 __gnat_default_resignal_p (int code)
1319 {
1320   int i, iexcept;
1321
1322   for (i = 0; facility_resignal_table [i]; i++)
1323     if ((code & 0xfff0000) == facility_resignal_table [i])
1324       return 1;
1325
1326   for (i = 0, iexcept = 0;
1327        cond_resignal_table [i] &&
1328        !(iexcept = LIB$MATCH_COND (&code, &cond_resignal_table [i]));
1329        i++);
1330
1331   return iexcept;
1332 }
1333
1334 /* Static pointer to predicate that the __gnat_error_handler exception
1335    vector invokes to determine if it should resignal a condition.  */
1336
1337 static resignal_predicate *__gnat_resignal_p = __gnat_default_resignal_p;
1338
1339 /* User interface to change the predicate pointer to PREDICATE. Reset to
1340    the default if PREDICATE is null.  */
1341
1342 void
1343 __gnat_set_resignal_predicate (resignal_predicate *predicate)
1344 {
1345   if (predicate == NULL)
1346     __gnat_resignal_p = __gnat_default_resignal_p;
1347   else
1348     __gnat_resignal_p = predicate;
1349 }
1350
1351 /* Should match System.Parameters.Default_Exception_Msg_Max_Length.  */
1352 #define Default_Exception_Msg_Max_Length 512
1353
1354 /* Action routine for SYS$PUTMSG. There may be multiple
1355    conditions, each with text to be appended to MESSAGE
1356    and separated by line termination.  */
1357
1358 static int
1359 copy_msg (struct descriptor_s *msgdesc, char *message)
1360 {
1361   int len = strlen (message);
1362   int copy_len;
1363
1364   /* Check for buffer overflow and skip.  */
1365   if (len > 0 && len <= Default_Exception_Msg_Max_Length - 3)
1366     {
1367       strcat (message, "\r\n");
1368       len += 2;
1369     }
1370
1371   /* Check for buffer overflow and truncate if necessary.  */
1372   copy_len = (len + msgdesc->len <= Default_Exception_Msg_Max_Length - 1 ?
1373               msgdesc->len :
1374               Default_Exception_Msg_Max_Length - 1 - len);
1375   strncpy (&message [len], msgdesc->adr, copy_len);
1376   message [len + copy_len] = 0;
1377
1378   return 0;
1379 }
1380
1381 long
1382 __gnat_handle_vms_condition (int *sigargs, void *mechargs)
1383 {
1384   struct Exception_Data *exception = 0;
1385   Exception_Code base_code;
1386   struct descriptor_s gnat_facility = {4, 0, "GNAT"};
1387   char message [Default_Exception_Msg_Max_Length];
1388
1389   const char *msg = "";
1390
1391   /* Check for conditions to resignal which aren't effected by pragma
1392      Import_Exception.  */
1393   if (__gnat_resignal_p (sigargs [1]))
1394     return SS$_RESIGNAL;
1395
1396 #ifdef IN_RTS
1397   /* See if it's an imported exception.  Beware that registered exceptions
1398      are bound to their base code, with the severity bits masked off.  */
1399   base_code = Base_Code_In ((Exception_Code) sigargs[1]);
1400   exception = Coded_Exception (base_code);
1401
1402   if (exception)
1403     {
1404       message[0] = 0;
1405
1406       /* Subtract PC & PSL fields which messes with PUTMSG.  */
1407       sigargs[0] -= 2;
1408       SYS$PUTMSG (sigargs, copy_msg, &gnat_facility, message);
1409       sigargs[0] += 2;
1410       msg = message;
1411
1412       exception->Name_Length = 19;
1413       /* ??? The full name really should be get sys$getmsg returns.  */
1414       exception->Full_Name = "IMPORTED_EXCEPTION";
1415       exception->Import_Code = base_code;
1416
1417 #ifdef __IA64
1418       /* Do not adjust the program counter as already points to the next
1419          instruction (just after the call to LIB$STOP).  */
1420       Raise_From_Signal_Handler (exception, msg);
1421 #endif
1422     }
1423 #endif
1424
1425   if (exception == 0)
1426     switch (sigargs[1])
1427       {
1428       case SS$_ACCVIO:
1429         if (sigargs[3] == 0)
1430           {
1431             exception = &constraint_error;
1432             msg = "access zero";
1433           }
1434         else
1435           {
1436             exception = &storage_error;
1437             msg = "stack overflow or erroneous memory access";
1438           }
1439         __gnat_adjust_context_for_raise (SS$_ACCVIO, (void *)mechargs);
1440         break;
1441
1442       case SS$_STKOVF:
1443         exception = &storage_error;
1444         msg = "stack overflow";
1445         __gnat_adjust_context_for_raise (SS$_STKOVF, (void *)mechargs);
1446         break;
1447
1448       case SS$_HPARITH:
1449 #ifndef IN_RTS
1450         return SS$_RESIGNAL; /* toplev.c handles for compiler */
1451 #else
1452         exception = &constraint_error;
1453         msg = "arithmetic error";
1454         __gnat_adjust_context_for_raise (SS$_HPARITH, (void *)mechargs);
1455 #endif
1456         break;
1457
1458       default:
1459 #ifdef IN_RTS
1460         {
1461           int i;
1462
1463           /* Scan the DEC Ada exception condition table for a match and fetch
1464              the associated GNAT exception pointer.  */
1465           for (i = 0;
1466                dec_ada_cond_except_table [i].cond &&
1467                !LIB$MATCH_COND (&sigargs [1],
1468                                 &dec_ada_cond_except_table [i].cond);
1469                i++);
1470           exception = (struct Exception_Data *)
1471             dec_ada_cond_except_table [i].except;
1472
1473           if (!exception)
1474             {
1475               /* Scan the VMS standard condition table for a match and fetch
1476                  the associated GNAT exception pointer.  */
1477               for (i = 0;
1478                    cond_except_table[i].cond &&
1479                    !LIB$MATCH_COND (&sigargs[1], &cond_except_table[i].cond);
1480                    i++);
1481               exception = (struct Exception_Data *)
1482                 cond_except_table [i].except;
1483
1484               if (!exception)
1485                 /* User programs expect Non_Ada_Error to be raised, reference
1486                    DEC Ada test CXCONDHAN.  */
1487                 exception = &Non_Ada_Error;
1488             }
1489         }
1490 #else
1491         exception = &program_error;
1492 #endif
1493         message[0] = 0;
1494         /* Subtract PC & PSL fields which messes with PUTMSG.  */
1495         sigargs[0] -= 2;
1496         SYS$PUTMSG (sigargs, copy_msg, &gnat_facility, message);
1497         sigargs[0] += 2;
1498         msg = message;
1499         break;
1500       }
1501
1502   Raise_From_Signal_Handler (exception, msg);
1503 }
1504
1505 void
1506 __gnat_install_handler (void)
1507 {
1508   long prvhnd ATTRIBUTE_UNUSED;
1509
1510 #if !defined (IN_RTS)
1511   SYS$SETEXV (1, __gnat_handle_vms_condition, 3, &prvhnd);
1512 #endif
1513
1514   __gnat_handler_installed = 1;
1515 }
1516
1517 /* __gnat_adjust_context_for_raise for Alpha - see comments along with the
1518    default version later in this file.  */
1519
1520 #if defined (IN_RTS) && defined (__alpha__)
1521
1522 #include <vms/chfctxdef.h>
1523 #include <vms/chfdef.h>
1524
1525 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
1526
1527 void
1528 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
1529 {
1530   if (signo == SS$_HPARITH)
1531     {
1532       /* Sub one to the address of the instruction signaling the condition,
1533          located in the sigargs array.  */
1534
1535       CHF$MECH_ARRAY * mechargs = (CHF$MECH_ARRAY *) ucontext;
1536       CHF$SIGNAL_ARRAY * sigargs
1537         = (CHF$SIGNAL_ARRAY *) mechargs->chf$q_mch_sig_addr;
1538
1539       int vcount = sigargs->chf$is_sig_args;
1540       int * pc_slot = & (&sigargs->chf$l_sig_name)[vcount-2];
1541
1542       (*pc_slot)--;
1543     }
1544 }
1545
1546 #endif
1547
1548 /* __gnat_adjust_context_for_raise for ia64.  */
1549
1550 #if defined (IN_RTS) && defined (__IA64)
1551
1552 #include <vms/chfctxdef.h>
1553 #include <vms/chfdef.h>
1554
1555 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
1556
1557 typedef unsigned long long u64;
1558
1559 void
1560 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
1561 {
1562   /* Add one to the address of the instruction signaling the condition,
1563      located in the 64bits sigargs array.  */
1564
1565   CHF$MECH_ARRAY * mechargs = (CHF$MECH_ARRAY *) ucontext;
1566
1567   CHF64$SIGNAL_ARRAY *chfsig64
1568     = (CHF64$SIGNAL_ARRAY *) mechargs->chf$ph_mch_sig64_addr;
1569
1570   u64 * post_sigarray
1571     = (u64 *)chfsig64 + 1 + chfsig64->chf64$l_sig_args;
1572
1573   u64 * ih_pc_loc = post_sigarray - 2;
1574
1575   (*ih_pc_loc) ++;
1576 }
1577
1578 #endif
1579
1580 /* Easier interface for LIB$GET_LOGICAL: put the equivalence of NAME into BUF,
1581    always NUL terminated.  In case of error or if the result is longer than
1582    LEN (length of BUF) an empty string is written info BUF.  */
1583
1584 static void
1585 __gnat_vms_get_logical (const char *name, char *buf, int len)
1586 {
1587   struct descriptor_s name_desc, result_desc;
1588   int status;
1589   unsigned short rlen;
1590
1591   /* Build the descriptor for NAME.  */
1592   name_desc.len = strlen (name);
1593   name_desc.mbz = 0;
1594   name_desc.adr = (char *)name;
1595
1596   /* Build the descriptor for the result.  */
1597   result_desc.len = len;
1598   result_desc.mbz = 0;
1599   result_desc.adr = buf;
1600
1601   status = LIB$GET_LOGICAL (&name_desc, &result_desc, &rlen);
1602
1603   if ((status & 1) == 1 && rlen < len)
1604     buf[rlen] = 0;
1605   else
1606     buf[0] = 0;
1607 }
1608
1609 /* Size of a page on ia64 and alpha VMS.  */
1610 #define VMS_PAGESIZE 8192
1611
1612 /* User mode.  */
1613 #define PSL__C_USER 3
1614
1615 /* No access.  */
1616 #define PRT__C_NA 0
1617
1618 /* Descending region.  */
1619 #define VA__M_DESCEND 1
1620
1621 /* Get by virtual address.  */
1622 #define VA___REGSUM_BY_VA 1
1623
1624 /* Memory region summary.  */
1625 struct regsum
1626 {
1627   unsigned long long q_region_id;
1628   unsigned int l_flags;
1629   unsigned int l_region_protection;
1630   void *pq_start_va;
1631   unsigned long long q_region_size;
1632   void *pq_first_free_va;
1633 };
1634
1635 extern int SYS$GET_REGION_INFO (unsigned int, unsigned long long *,
1636                                 void *, void *, unsigned int,
1637                                 void *, unsigned int *);
1638 extern int SYS$EXPREG_64 (unsigned long long *, unsigned long long,
1639                           unsigned int, unsigned int, void **,
1640                           unsigned long long *);
1641 extern int SYS$SETPRT_64 (void *, unsigned long long, unsigned int,
1642                           unsigned int, void **, unsigned long long *,
1643                           unsigned int *);
1644 extern int SYS$PUTMSG (void *, int (*)(), void *, unsigned long long);
1645
1646 /* Add a guard page in the memory region containing ADDR at ADDR +/- SIZE.
1647    (The sign depends on the kind of the memory region).  */
1648
1649 static int
1650 __gnat_set_stack_guard_page (void *addr, unsigned long size)
1651 {
1652   int status;
1653   void *ret_va;
1654   unsigned long long ret_len;
1655   unsigned int ret_prot;
1656   void *start_va;
1657   unsigned long long length;
1658   unsigned int retlen;
1659   struct regsum buffer;
1660
1661   /* Get the region for ADDR.  */
1662   status = SYS$GET_REGION_INFO
1663     (VA___REGSUM_BY_VA, NULL, addr, NULL, sizeof (buffer), &buffer, &retlen);
1664
1665   if ((status & 1) != 1)
1666     return -1;
1667
1668   /* Extend the region.  */
1669   status = SYS$EXPREG_64 (&buffer.q_region_id,
1670                           size, 0, 0, &start_va, &length);
1671
1672   if ((status & 1) != 1)
1673     return -1;
1674
1675   /* Create a guard page.  */
1676   if (!(buffer.l_flags & VA__M_DESCEND))
1677     start_va = (void *)((unsigned long long)start_va + length - VMS_PAGESIZE);
1678
1679   status = SYS$SETPRT_64 (start_va, VMS_PAGESIZE, PSL__C_USER, PRT__C_NA,
1680                           &ret_va, &ret_len, &ret_prot);
1681
1682   if ((status & 1) != 1)
1683     return -1;
1684   return 0;
1685 }
1686
1687 /* Read logicals to limit the stack(s) size.  */
1688
1689 static void
1690 __gnat_set_stack_limit (void)
1691 {
1692 #ifdef __ia64__
1693   void *sp;
1694   unsigned long size;
1695   char value[16];
1696   char *e;
1697
1698   /* The main stack.  */
1699   __gnat_vms_get_logical ("GNAT_STACK_SIZE", value, sizeof (value));
1700   size = strtoul (value, &e, 0);
1701   if (e > value && *e == 0)
1702     {
1703       asm ("mov %0=sp" : "=r" (sp));
1704       __gnat_set_stack_guard_page (sp, size * 1024);
1705     }
1706
1707   /* The register stack.  */
1708   __gnat_vms_get_logical ("GNAT_RBS_SIZE", value, sizeof (value));
1709   size = strtoul (value, &e, 0);
1710   if (e > value && *e == 0)
1711     {
1712       asm ("mov %0=ar.bsp" : "=r" (sp));
1713       __gnat_set_stack_guard_page (sp, size * 1024);
1714     }
1715 #endif
1716 }
1717
1718 /* Feature logical name and global variable address pair.
1719    If we ever add another feature logical to this list, the
1720    feature struct will need to be enhanced to take into account
1721    possible values for *gl_addr.  */
1722 struct feature {
1723   const char *name;
1724   int *gl_addr;
1725 };
1726
1727 /* Default values for GNAT features set by environment.  */
1728 int __gl_heap_size = 64;
1729
1730 /* Array feature logical names and global variable addresses.  */
1731 static const struct feature features[] = {
1732   {"GNAT$NO_MALLOC_64", &__gl_heap_size},
1733   {0, 0}
1734 };
1735
1736 void
1737 __gnat_set_features (void)
1738 {
1739   int i;
1740   char buff[16];
1741
1742   /* Loop through features array and test name for enable/disable.  */
1743   for (i = 0; features[i].name; i++)
1744     {
1745       __gnat_vms_get_logical (features[i].name, buff, sizeof (buff));
1746
1747       if (strcmp (buff, "ENABLE") == 0
1748           || strcmp (buff, "TRUE") == 0
1749           || strcmp (buff, "1") == 0)
1750         *features[i].gl_addr = 32;
1751       else if (strcmp (buff, "DISABLE") == 0
1752                || strcmp (buff, "FALSE") == 0
1753                || strcmp (buff, "0") == 0)
1754         *features[i].gl_addr = 64;
1755     }
1756
1757   /* Features to artificially limit the stack size.  */
1758   __gnat_set_stack_limit ();
1759
1760   __gnat_features_set = 1;
1761 }
1762
1763 /* Return true if the VMS version is 7.x.  */
1764
1765 extern unsigned int LIB$GETSYI (int *, ...);
1766
1767 #define SYI$_VERSION 0x1000
1768
1769 int
1770 __gnat_is_vms_v7 (void)
1771 {
1772   struct descriptor_s desc;
1773   char version[8];
1774   int status;
1775   int code = SYI$_VERSION;
1776
1777   desc.len = sizeof (version);
1778   desc.mbz = 0;
1779   desc.adr = version;
1780
1781   status = LIB$GETSYI (&code, 0, &desc);
1782   if ((status & 1) == 1 && version[1] == '7' && version[2] == '.')
1783     return 1;
1784   else
1785     return 0;
1786 }
1787
1788 /*******************/
1789 /* FreeBSD Section */
1790 /*******************/
1791
1792 #elif defined (__FreeBSD__)
1793
1794 #include <signal.h>
1795 #include <sys/ucontext.h>
1796 #include <unistd.h>
1797
1798 static void
1799 __gnat_error_handler (int sig,
1800                       siginfo_t *si ATTRIBUTE_UNUSED,
1801                       void *ucontext ATTRIBUTE_UNUSED)
1802 {
1803   struct Exception_Data *exception;
1804   const char *msg;
1805
1806   switch (sig)
1807     {
1808     case SIGFPE:
1809       exception = &constraint_error;
1810       msg = "SIGFPE";
1811       break;
1812
1813     case SIGILL:
1814       exception = &constraint_error;
1815       msg = "SIGILL";
1816       break;
1817
1818     case SIGSEGV:
1819       exception = &storage_error;
1820       msg = "stack overflow or erroneous memory access";
1821       break;
1822
1823     case SIGBUS:
1824       exception = &storage_error;
1825       msg = "SIGBUS: possible stack overflow";
1826       break;
1827
1828     default:
1829       exception = &program_error;
1830       msg = "unhandled signal";
1831     }
1832
1833   Raise_From_Signal_Handler (exception, msg);
1834 }
1835
1836 void
1837 __gnat_install_handler ()
1838 {
1839   struct sigaction act;
1840
1841   /* Set up signal handler to map synchronous signals to appropriate
1842      exceptions.  Make sure that the handler isn't interrupted by another
1843      signal that might cause a scheduling event!  */
1844
1845   act.sa_sigaction
1846     = (void (*)(int, struct __siginfo *, void*)) __gnat_error_handler;
1847   act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
1848   (void) sigemptyset (&act.sa_mask);
1849
1850   (void) sigaction (SIGILL,  &act, NULL);
1851   (void) sigaction (SIGFPE,  &act, NULL);
1852   (void) sigaction (SIGSEGV, &act, NULL);
1853   (void) sigaction (SIGBUS,  &act, NULL);
1854
1855   __gnat_handler_installed = 1;
1856 }
1857
1858 /*******************/
1859 /* VxWorks Section */
1860 /*******************/
1861
1862 #elif defined(__vxworks)
1863
1864 #include <signal.h>
1865 #include <taskLib.h>
1866
1867 #ifndef __RTP__
1868 #include <intLib.h>
1869 #include <iv.h>
1870 #endif
1871
1872 #ifdef VTHREADS
1873 #include "private/vThreadsP.h"
1874 #endif
1875
1876 void __gnat_error_handler (int, void *, struct sigcontext *);
1877
1878 #ifndef __RTP__
1879
1880 /* Directly vectored Interrupt routines are not supported when using RTPs.  */
1881
1882 extern int __gnat_inum_to_ivec (int);
1883
1884 /* This is needed by the GNAT run time to handle Vxworks interrupts.  */
1885 int
1886 __gnat_inum_to_ivec (int num)
1887 {
1888   return INUM_TO_IVEC (num);
1889 }
1890 #endif
1891
1892 #if !defined(__alpha_vxworks) && (_WRS_VXWORKS_MAJOR != 6) && !defined(__RTP__)
1893
1894 /* getpid is used by s-parint.adb, but is not defined by VxWorks, except
1895    on Alpha VxWorks and VxWorks 6.x (including RTPs).  */
1896
1897 extern long getpid (void);
1898
1899 long
1900 getpid (void)
1901 {
1902   return taskIdSelf ();
1903 }
1904 #endif
1905
1906 /* VxWorks 653 vThreads expects the field excCnt to be zeroed when a signal is.
1907    handled. The VxWorks version of longjmp does this; GCC's builtin_longjmp
1908    doesn't.  */
1909 void
1910 __gnat_clear_exception_count (void)
1911 {
1912 #ifdef VTHREADS
1913   WIND_TCB *currentTask = (WIND_TCB *) taskIdSelf();
1914
1915   currentTask->vThreads.excCnt = 0;
1916 #endif
1917 }
1918
1919 /* Handle different SIGnal to exception mappings in different VxWorks
1920    versions.   */
1921 static void
1922 __gnat_map_signal (int sig, void *si ATTRIBUTE_UNUSED,
1923                    struct sigcontext *sc ATTRIBUTE_UNUSED)
1924 {
1925   struct Exception_Data *exception;
1926   const char *msg;
1927
1928   switch (sig)
1929     {
1930     case SIGFPE:
1931       exception = &constraint_error;
1932       msg = "SIGFPE";
1933       break;
1934 #ifdef VTHREADS
1935 #ifdef __VXWORKSMILS__
1936     case SIGILL:
1937       exception = &storage_error;
1938       msg = "SIGILL: possible stack overflow";
1939       break;
1940     case SIGSEGV:
1941       exception = &storage_error;
1942       msg = "SIGSEGV";
1943       break;
1944     case SIGBUS:
1945       exception = &program_error;
1946       msg = "SIGBUS";
1947       break;
1948 #else
1949     case SIGILL:
1950       exception = &constraint_error;
1951       msg = "Floating point exception or SIGILL";
1952       break;
1953     case SIGSEGV:
1954       exception = &storage_error;
1955       msg = "SIGSEGV";
1956       break;
1957     case SIGBUS:
1958       exception = &storage_error;
1959       msg = "SIGBUS: possible stack overflow";
1960       break;
1961 #endif
1962 #elif (_WRS_VXWORKS_MAJOR == 6)
1963     case SIGILL:
1964       exception = &constraint_error;
1965       msg = "SIGILL";
1966       break;
1967 #ifdef __RTP__
1968     /* In RTP mode a SIGSEGV is most likely due to a stack overflow,
1969        since stack checking uses the probing mechanism.  */
1970     case SIGSEGV:
1971       exception = &storage_error;
1972       msg = "SIGSEGV: possible stack overflow";
1973       break;
1974     case SIGBUS:
1975       exception = &program_error;
1976       msg = "SIGBUS";
1977       break;
1978 #else
1979       /* VxWorks 6 kernel mode with probing. SIGBUS for guard page hit */
1980     case SIGSEGV:
1981       exception = &storage_error;
1982       msg = "SIGSEGV";
1983       break;
1984     case SIGBUS:
1985       exception = &storage_error;
1986       msg = "SIGBUS: possible stack overflow";
1987       break;
1988 #endif
1989 #else
1990     /* VxWorks 5: a SIGILL is most likely due to a stack overflow,
1991        since stack checking uses the stack limit mechanism.  */
1992     case SIGILL:
1993       exception = &storage_error;
1994       msg = "SIGILL: possible stack overflow";
1995       break;
1996     case SIGSEGV:
1997       exception = &storage_error;
1998       msg = "SIGSEGV";
1999       break;
2000     case SIGBUS:
2001       exception = &program_error;
2002       msg = "SIGBUS";
2003       break;
2004 #endif
2005     default:
2006       exception = &program_error;
2007       msg = "unhandled signal";
2008     }
2009
2010   __gnat_clear_exception_count ();
2011   Raise_From_Signal_Handler (exception, msg);
2012 }
2013
2014 /* Tasking and Non-tasking signal handler.  Map SIGnal to Ada exception
2015    propagation after the required low level adjustments.  */
2016
2017 void
2018 __gnat_error_handler (int sig, void *si, struct sigcontext *sc)
2019 {
2020   sigset_t mask;
2021
2022   /* VxWorks will always mask out the signal during the signal handler and
2023      will reenable it on a longjmp.  GNAT does not generate a longjmp to
2024      return from a signal handler so the signal will still be masked unless
2025      we unmask it.  */
2026   sigprocmask (SIG_SETMASK, NULL, &mask);
2027   sigdelset (&mask, sig);
2028   sigprocmask (SIG_SETMASK, &mask, NULL);
2029
2030 #if defined (__PPC__) && defined(_WRS_KERNEL)
2031   /* On PowerPC, kernel mode, we process signals through a Call Frame Info
2032      trampoline, voiding the need for myriads of fallback_frame_state
2033      variants in the ZCX runtime.  We have no simple way to distinguish ZCX
2034      from SJLJ here, so we do this for SJLJ as well even though this is not
2035      necessary.  This only incurs a few extra instructions and a tiny
2036      amount of extra stack usage.  */
2037
2038   #include "sigtramp.h"
2039
2040   __gnat_sigtramp (sig, (void *)si, (void *)sc,
2041                    (sighandler_t *)&__gnat_map_signal);
2042
2043 #else
2044   __gnat_map_signal (sig, si, sc);
2045 #endif
2046 }
2047
2048 void
2049 __gnat_install_handler (void)
2050 {
2051   struct sigaction act;
2052
2053   /* Setup signal handler to map synchronous signals to appropriate
2054      exceptions.  Make sure that the handler isn't interrupted by another
2055      signal that might cause a scheduling event!  */
2056
2057   act.sa_handler = __gnat_error_handler;
2058   act.sa_flags = SA_SIGINFO | SA_ONSTACK;
2059   sigemptyset (&act.sa_mask);
2060
2061   /* For VxWorks, install all signal handlers, since pragma Interrupt_State
2062      applies to vectored hardware interrupts, not signals.  */
2063   sigaction (SIGFPE,  &act, NULL);
2064   sigaction (SIGILL,  &act, NULL);
2065   sigaction (SIGSEGV, &act, NULL);
2066   sigaction (SIGBUS,  &act, NULL);
2067
2068   __gnat_handler_installed = 1;
2069 }
2070
2071 #define HAVE_GNAT_INIT_FLOAT
2072
2073 void
2074 __gnat_init_float (void)
2075 {
2076   /* Disable overflow/underflow exceptions on the PPC processor, needed
2077      to get correct Ada semantics.  Note that for AE653 vThreads, the HW
2078      overflow settings are an OS configuration issue.  The instructions
2079      below have no effect.  */
2080 #if defined (_ARCH_PPC) && !defined (_SOFT_FLOAT) && (!defined (VTHREADS) || defined (__VXWORKSMILS__))
2081 #if defined (__SPE__)
2082   {
2083      const unsigned long spefscr_mask = 0xfffffff3;
2084      unsigned long spefscr;
2085      asm ("mfspr  %0, 512" : "=r" (spefscr));
2086      spefscr = spefscr & spefscr_mask;
2087      asm ("mtspr 512, %0\n\tisync" : : "r" (spefscr));
2088   }
2089 #else
2090   asm ("mtfsb0 25");
2091   asm ("mtfsb0 26");
2092 #endif
2093 #endif
2094
2095 #if (defined (__i386__) || defined (i386)) && !defined (VTHREADS)
2096   /* This is used to properly initialize the FPU on an x86 for each
2097      process thread.  */
2098   asm ("finit");
2099 #endif
2100
2101   /* Similarly for SPARC64.  Achieved by masking bits in the Trap Enable Mask
2102      field of the Floating-point Status Register (see the SPARC Architecture
2103      Manual Version 9, p 48).  */
2104 #if defined (sparc64)
2105
2106 #define FSR_TEM_NVM (1 << 27)  /* Invalid operand  */
2107 #define FSR_TEM_OFM (1 << 26)  /* Overflow  */
2108 #define FSR_TEM_UFM (1 << 25)  /* Underflow  */
2109 #define FSR_TEM_DZM (1 << 24)  /* Division by Zero  */
2110 #define FSR_TEM_NXM (1 << 23)  /* Inexact result  */
2111   {
2112     unsigned int fsr;
2113
2114     __asm__("st %%fsr, %0" : "=m" (fsr));
2115     fsr &= ~(FSR_TEM_OFM | FSR_TEM_UFM);
2116     __asm__("ld %0, %%fsr" : : "m" (fsr));
2117   }
2118 #endif
2119 }
2120
2121 /* This subprogram is called by System.Task_Primitives.Operations.Enter_Task
2122    (if not null) when a new task is created.  It is initialized by
2123    System.Stack_Checking.Operations.Initialize_Stack_Limit.
2124    The use of a hook avoids to drag stack checking subprograms if stack
2125    checking is not used.  */
2126 void (*__gnat_set_stack_limit_hook)(void) = (void (*)(void))0;
2127
2128 /******************/
2129 /* NetBSD Section */
2130 /******************/
2131
2132 #elif defined(__NetBSD__)
2133
2134 #include <signal.h>
2135 #include <unistd.h>
2136
2137 static void
2138 __gnat_error_handler (int sig)
2139 {
2140   struct Exception_Data *exception;
2141   const char *msg;
2142
2143   switch(sig)
2144   {
2145     case SIGFPE:
2146       exception = &constraint_error;
2147       msg = "SIGFPE";
2148       break;
2149     case SIGILL:
2150       exception = &constraint_error;
2151       msg = "SIGILL";
2152       break;
2153     case SIGSEGV:
2154       exception = &storage_error;
2155       msg = "stack overflow or erroneous memory access";
2156       break;
2157     case SIGBUS:
2158       exception = &constraint_error;
2159       msg = "SIGBUS";
2160       break;
2161     default:
2162       exception = &program_error;
2163       msg = "unhandled signal";
2164     }
2165
2166     Raise_From_Signal_Handler(exception, msg);
2167 }
2168
2169 void
2170 __gnat_install_handler(void)
2171 {
2172   struct sigaction act;
2173
2174   act.sa_handler = __gnat_error_handler;
2175   act.sa_flags = SA_NODEFER | SA_RESTART;
2176   sigemptyset (&act.sa_mask);
2177
2178   /* Do not install handlers if interrupt state is "System".  */
2179   if (__gnat_get_interrupt_state (SIGFPE) != 's')
2180     sigaction (SIGFPE,  &act, NULL);
2181   if (__gnat_get_interrupt_state (SIGILL) != 's')
2182     sigaction (SIGILL,  &act, NULL);
2183   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
2184     sigaction (SIGSEGV, &act, NULL);
2185   if (__gnat_get_interrupt_state (SIGBUS) != 's')
2186     sigaction (SIGBUS,  &act, NULL);
2187
2188   __gnat_handler_installed = 1;
2189 }
2190
2191 /*******************/
2192 /* OpenBSD Section */
2193 /*******************/
2194
2195 #elif defined(__OpenBSD__)
2196
2197 #include <signal.h>
2198 #include <unistd.h>
2199
2200 static void
2201 __gnat_error_handler (int sig)
2202 {
2203   struct Exception_Data *exception;
2204   const char *msg;
2205
2206   switch(sig)
2207   {
2208     case SIGFPE:
2209       exception = &constraint_error;
2210       msg = "SIGFPE";
2211       break;
2212     case SIGILL:
2213       exception = &constraint_error;
2214       msg = "SIGILL";
2215       break;
2216     case SIGSEGV:
2217       exception = &storage_error;
2218       msg = "stack overflow or erroneous memory access";
2219       break;
2220     case SIGBUS:
2221       exception = &constraint_error;
2222       msg = "SIGBUS";
2223       break;
2224     default:
2225       exception = &program_error;
2226       msg = "unhandled signal";
2227     }
2228
2229     Raise_From_Signal_Handler(exception, msg);
2230 }
2231
2232 void
2233 __gnat_install_handler(void)
2234 {
2235   struct sigaction act;
2236
2237   act.sa_handler = __gnat_error_handler;
2238   act.sa_flags = SA_NODEFER | SA_RESTART;
2239   sigemptyset (&act.sa_mask);
2240
2241   /* Do not install handlers if interrupt state is "System" */
2242   if (__gnat_get_interrupt_state (SIGFPE) != 's')
2243     sigaction (SIGFPE,  &act, NULL);
2244   if (__gnat_get_interrupt_state (SIGILL) != 's')
2245     sigaction (SIGILL,  &act, NULL);
2246   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
2247     sigaction (SIGSEGV, &act, NULL);
2248   if (__gnat_get_interrupt_state (SIGBUS) != 's')
2249     sigaction (SIGBUS,  &act, NULL);
2250
2251   __gnat_handler_installed = 1;
2252 }
2253
2254 /******************/
2255 /* Darwin Section */
2256 /******************/
2257
2258 #elif defined(__APPLE__)
2259
2260 #include <signal.h>
2261 #include <sys/syscall.h>
2262 #include <mach/mach_vm.h>
2263 #include <mach/mach_init.h>
2264 #include <mach/vm_statistics.h>
2265
2266 /* This must be in keeping with System.OS_Interface.Alternate_Stack_Size.  */
2267 char __gnat_alternate_stack[32 * 1024]; /* 1 * MINSIGSTKSZ */
2268
2269 /* Defined in xnu unix_signal.c.
2270    Tell the kernel to re-use alt stack when delivering a signal.  */
2271 #define UC_RESET_ALT_STACK      0x80000000
2272
2273 /* Return true if ADDR is within a stack guard area.  */
2274 static int
2275 __gnat_is_stack_guard (mach_vm_address_t addr)
2276 {
2277   kern_return_t kret;
2278   vm_region_submap_info_data_64_t info;
2279   mach_vm_address_t start;
2280   mach_vm_size_t size;
2281   natural_t depth;
2282   mach_msg_type_number_t count;
2283
2284   count = VM_REGION_SUBMAP_INFO_COUNT_64;
2285   start = addr;
2286   size = -1;
2287   depth = 9999;
2288   kret = mach_vm_region_recurse (mach_task_self (), &start, &size, &depth,
2289                                  (vm_region_recurse_info_t) &info, &count);
2290   if (kret == KERN_SUCCESS
2291       && addr >= start && addr < (start + size)
2292       && info.protection == VM_PROT_NONE
2293       && info.user_tag == VM_MEMORY_STACK)
2294     return 1;
2295   return 0;
2296 }
2297
2298 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
2299
2300 void
2301 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED,
2302                                  void *ucontext ATTRIBUTE_UNUSED)
2303 {
2304 #if defined (__x86_64__)
2305   /* Work around radar #10302855/pr50678, where the unwinders (libunwind or
2306      libgcc_s depending on the system revision) and the DWARF unwind data for
2307      the sigtramp have different ideas about register numbering (causing rbx
2308      and rdx to be transposed)..  */
2309   ucontext_t *uc = (ucontext_t *)ucontext ;
2310   unsigned long t = uc->uc_mcontext->__ss.__rbx;
2311
2312   uc->uc_mcontext->__ss.__rbx = uc->uc_mcontext->__ss.__rdx;
2313   uc->uc_mcontext->__ss.__rdx = t;
2314 #endif
2315 }
2316
2317 static void
2318 __gnat_error_handler (int sig, siginfo_t *si, void *ucontext)
2319 {
2320   struct Exception_Data *exception;
2321   const char *msg;
2322
2323   __gnat_adjust_context_for_raise (sig, ucontext);
2324
2325   switch (sig)
2326     {
2327     case SIGSEGV:
2328     case SIGBUS:
2329       if (__gnat_is_stack_guard ((unsigned long)si->si_addr))
2330         {
2331           exception = &storage_error;
2332           msg = "stack overflow";
2333         }
2334       else
2335         {
2336           exception = &constraint_error;
2337           msg = "erroneous memory access";
2338         }
2339       /* Reset the use of alt stack, so that the alt stack will be used
2340          for the next signal delivery.
2341          The stack can't be used in case of stack checking.  */
2342       syscall (SYS_sigreturn, NULL, UC_RESET_ALT_STACK);
2343       break;
2344
2345     case SIGFPE:
2346       exception = &constraint_error;
2347       msg = "SIGFPE";
2348       break;
2349
2350     default:
2351       exception = &program_error;
2352       msg = "unhandled signal";
2353     }
2354
2355   Raise_From_Signal_Handler (exception, msg);
2356 }
2357
2358 void
2359 __gnat_install_handler (void)
2360 {
2361   struct sigaction act;
2362
2363   /* Set up signal handler to map synchronous signals to appropriate
2364      exceptions.  Make sure that the handler isn't interrupted by another
2365      signal that might cause a scheduling event!  Also setup an alternate
2366      stack region for the handler execution so that stack overflows can be
2367      handled properly, avoiding a SEGV generation from stack usage by the
2368      handler itself (and it is required by Darwin).  */
2369
2370   stack_t stack;
2371   stack.ss_sp = __gnat_alternate_stack;
2372   stack.ss_size = sizeof (__gnat_alternate_stack);
2373   stack.ss_flags = 0;
2374   sigaltstack (&stack, NULL);
2375
2376   act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
2377   act.sa_sigaction = __gnat_error_handler;
2378   sigemptyset (&act.sa_mask);
2379
2380   /* Do not install handlers if interrupt state is "System".  */
2381   if (__gnat_get_interrupt_state (SIGABRT) != 's')
2382     sigaction (SIGABRT, &act, NULL);
2383   if (__gnat_get_interrupt_state (SIGFPE) != 's')
2384     sigaction (SIGFPE,  &act, NULL);
2385   if (__gnat_get_interrupt_state (SIGILL) != 's')
2386     sigaction (SIGILL,  &act, NULL);
2387
2388   act.sa_flags |= SA_ONSTACK;
2389   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
2390     sigaction (SIGSEGV, &act, NULL);
2391   if (__gnat_get_interrupt_state (SIGBUS) != 's')
2392     sigaction (SIGBUS,  &act, NULL);
2393
2394   __gnat_handler_installed = 1;
2395 }
2396
2397 #else
2398
2399 /* For all other versions of GNAT, the handler does nothing.  */
2400
2401 /*******************/
2402 /* Default Section */
2403 /*******************/
2404
2405 void
2406 __gnat_install_handler (void)
2407 {
2408   __gnat_handler_installed = 1;
2409 }
2410
2411 #endif
2412
2413 /*********************/
2414 /* __gnat_init_float */
2415 /*********************/
2416
2417 /* This routine is called as each process thread is created, for possible
2418    initialization of the FP processor.  This version is used under INTERIX
2419    and WIN32.  */
2420
2421 #if defined (_WIN32) || defined (__INTERIX) \
2422   || defined (__Lynx__) || defined(__NetBSD__) || defined(__FreeBSD__) \
2423   || defined (__OpenBSD__)
2424
2425 #define HAVE_GNAT_INIT_FLOAT
2426
2427 void
2428 __gnat_init_float (void)
2429 {
2430 #if defined (__i386__) || defined (i386) || defined (__x86_64)
2431
2432   /* This is used to properly initialize the FPU on an x86 for each
2433      process thread.  */
2434
2435   asm ("finit");
2436
2437 #endif  /* Defined __i386__ */
2438 }
2439 #endif
2440
2441 #ifndef HAVE_GNAT_INIT_FLOAT
2442
2443 /* All targets without a specific __gnat_init_float will use an empty one.  */
2444 void
2445 __gnat_init_float (void)
2446 {
2447 }
2448 #endif
2449
2450 /***********************************/
2451 /* __gnat_adjust_context_for_raise */
2452 /***********************************/
2453
2454 #ifndef HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
2455
2456 /* All targets without a specific version will use an empty one.  */
2457
2458 /* Given UCONTEXT a pointer to a context structure received by a signal
2459    handler for SIGNO, perform the necessary adjustments to let the handler
2460    raise an exception.  Calls to this routine are not conditioned by the
2461    propagation scheme in use.  */
2462
2463 void
2464 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED,
2465                                  void *ucontext ATTRIBUTE_UNUSED)
2466 {
2467   /* We used to compensate here for the raised from call vs raised from signal
2468      exception discrepancy with the GCC ZCX scheme, but this now can be dealt
2469      with generically in the unwinder (see GCC PR other/26208).  This however
2470      requires the use of the _Unwind_GetIPInfo routine in raise-gcc.c, which
2471      is predicated on the definition of HAVE_GETIPINFO at compile time.  Only
2472      the VMS ports still do the compensation described in the few lines below.
2473
2474      *** Call vs signal exception discrepancy with GCC ZCX scheme ***
2475
2476      The GCC unwinder expects to be dealing with call return addresses, since
2477      this is the "nominal" case of what we retrieve while unwinding a regular
2478      call chain.
2479
2480      To evaluate if a handler applies at some point identified by a return
2481      address, the propagation engine needs to determine what region the
2482      corresponding call instruction pertains to.  Because the return address
2483      may not be attached to the same region as the call, the unwinder always
2484      subtracts "some" amount from a return address to search the region
2485      tables, amount chosen to ensure that the resulting address is inside the
2486      call instruction.
2487
2488      When we raise an exception from a signal handler, e.g. to transform a
2489      SIGSEGV into Storage_Error, things need to appear as if the signal
2490      handler had been "called" by the instruction which triggered the signal,
2491      so that exception handlers that apply there are considered.  What the
2492      unwinder will retrieve as the return address from the signal handler is
2493      what it will find as the faulting instruction address in the signal
2494      context pushed by the kernel.  Leaving this address untouched looses, if
2495      the triggering instruction happens to be the very first of a region, as
2496      the later adjustments performed by the unwinder would yield an address
2497      outside that region.  We need to compensate for the unwinder adjustments
2498      at some point, and this is what this routine is expected to do.
2499
2500      signo is passed because on some targets for some signals the PC in
2501      context points to the instruction after the faulting one, in which case
2502      the unwinder adjustment is still desired.  */
2503 }
2504
2505 #endif
2506
2507 #ifdef __cplusplus
2508 }
2509 #endif