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