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