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