gcc/ada/init.c

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