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