gcc/ada/init.c

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