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 /* Routine called from binder to override default feature values. */
1110 void __gnat_set_features ();
1111 int __gnat_features_set = 0;
1112
1113 long __gnat_error_handler (int *, void *);
1114
1115 #ifdef __IA64
1116 #define lib_get_curr_invo_context LIB$I64_GET_CURR_INVO_CONTEXT
1117 #define lib_get_prev_invo_context LIB$I64_GET_PREV_INVO_CONTEXT
1118 #define lib_get_invo_handle LIB$I64_GET_INVO_HANDLE
1119 #else
1120 #define lib_get_curr_invo_context LIB$GET_CURR_INVO_CONTEXT
1121 #define lib_get_prev_invo_context LIB$GET_PREV_INVO_CONTEXT
1122 #define lib_get_invo_handle LIB$GET_INVO_HANDLE
1123 #endif
1124
1125 #if defined (IN_RTS) && !defined (__IA64)
1126
1127 /* The prehandler actually gets control first on a condition.  It swaps the
1128    stack pointer and calls the handler (__gnat_error_handler).  */
1129 extern long __gnat_error_prehandler (void);
1130
1131 extern char *__gnat_error_prehandler_stack;   /* Alternate signal stack */
1132 #endif
1133
1134 /* Define macro symbols for the VMS conditions that become Ada exceptions.
1135    Most of these are also defined in the header file ssdef.h which has not
1136    yet been converted to be recognized by GNU C.  */
1137
1138 /* Defining these as macros, as opposed to external addresses, allows
1139    them to be used in a case statement below.  */
1140 #define SS$_ACCVIO            12
1141 #define SS$_HPARITH         1284
1142 #define SS$_STKOVF          1364
1143 #define SS$_RESIGNAL        2328
1144
1145 /* These codes are in standard message libraries.  */
1146 extern int CMA$_EXIT_THREAD;
1147 extern int SS$_DEBUG;
1148 extern int SS$_INTDIV;
1149 extern int LIB$_KEYNOTFOU;
1150 extern int LIB$_ACTIMAGE;
1151 extern int MTH$_FLOOVEMAT;       /* Some ACVC_21 CXA tests */
1152
1153 /* These codes are non standard, which is to say the author is
1154    not sure if they are defined in the standard message libraries
1155    so keep them as macros for now.  */
1156 #define RDB$_STREAM_EOF 20480426
1157 #define FDL$_UNPRIKW 11829410
1158
1159 struct cond_except {
1160   const int *cond;
1161   const struct Exception_Data *except;
1162 };
1163
1164 struct descriptor_s {unsigned short len, mbz; __char_ptr32 adr; };
1165
1166 /* Conditions that don't have an Ada exception counterpart must raise
1167    Non_Ada_Error.  Since this is defined in s-auxdec, it should only be
1168    referenced by user programs, not the compiler or tools.  Hence the
1169    #ifdef IN_RTS.  */
1170
1171 #ifdef IN_RTS
1172
1173 #define Status_Error ada__io_exceptions__status_error
1174 extern struct Exception_Data Status_Error;
1175
1176 #define Mode_Error ada__io_exceptions__mode_error
1177 extern struct Exception_Data Mode_Error;
1178
1179 #define Name_Error ada__io_exceptions__name_error
1180 extern struct Exception_Data Name_Error;
1181
1182 #define Use_Error ada__io_exceptions__use_error
1183 extern struct Exception_Data Use_Error;
1184
1185 #define Device_Error ada__io_exceptions__device_error
1186 extern struct Exception_Data Device_Error;
1187
1188 #define End_Error ada__io_exceptions__end_error
1189 extern struct Exception_Data End_Error;
1190
1191 #define Data_Error ada__io_exceptions__data_error
1192 extern struct Exception_Data Data_Error;
1193
1194 #define Layout_Error ada__io_exceptions__layout_error
1195 extern struct Exception_Data Layout_Error;
1196
1197 #define Non_Ada_Error system__aux_dec__non_ada_error
1198 extern struct Exception_Data Non_Ada_Error;
1199
1200 #define Coded_Exception system__vms_exception_table__coded_exception
1201 extern struct Exception_Data *Coded_Exception (Exception_Code);
1202
1203 #define Base_Code_In system__vms_exception_table__base_code_in
1204 extern Exception_Code Base_Code_In (Exception_Code);
1205
1206 /* DEC Ada exceptions are not defined in a header file, so they
1207    must be declared as external addresses.  */
1208
1209 extern int ADA$_PROGRAM_ERROR;
1210 extern int ADA$_LOCK_ERROR;
1211 extern int ADA$_EXISTENCE_ERROR;
1212 extern int ADA$_KEY_ERROR;
1213 extern int ADA$_KEYSIZERR;
1214 extern int ADA$_STAOVF;
1215 extern int ADA$_CONSTRAINT_ERRO;
1216 extern int ADA$_IOSYSFAILED;
1217 extern int ADA$_LAYOUT_ERROR;
1218 extern int ADA$_STORAGE_ERROR;
1219 extern int ADA$_DATA_ERROR;
1220 extern int ADA$_DEVICE_ERROR;
1221 extern int ADA$_END_ERROR;
1222 extern int ADA$_MODE_ERROR;
1223 extern int ADA$_NAME_ERROR;
1224 extern int ADA$_STATUS_ERROR;
1225 extern int ADA$_NOT_OPEN;
1226 extern int ADA$_ALREADY_OPEN;
1227 extern int ADA$_USE_ERROR;
1228 extern int ADA$_UNSUPPORTED;
1229 extern int ADA$_FAC_MODE_MISMAT;
1230 extern int ADA$_ORG_MISMATCH;
1231 extern int ADA$_RFM_MISMATCH;
1232 extern int ADA$_RAT_MISMATCH;
1233 extern int ADA$_MRS_MISMATCH;
1234 extern int ADA$_MRN_MISMATCH;
1235 extern int ADA$_KEY_MISMATCH;
1236 extern int ADA$_MAXLINEXC;
1237 extern int ADA$_LINEXCMRS;
1238
1239 /* DEC Ada specific conditions.  */
1240 static const struct cond_except dec_ada_cond_except_table [] = {
1241   {&ADA$_PROGRAM_ERROR,   &program_error},
1242   {&ADA$_USE_ERROR,       &Use_Error},
1243   {&ADA$_KEYSIZERR,       &program_error},
1244   {&ADA$_STAOVF,          &storage_error},
1245   {&ADA$_CONSTRAINT_ERRO, &constraint_error},
1246   {&ADA$_IOSYSFAILED,     &Device_Error},
1247   {&ADA$_LAYOUT_ERROR,    &Layout_Error},
1248   {&ADA$_STORAGE_ERROR,   &storage_error},
1249   {&ADA$_DATA_ERROR,      &Data_Error},
1250   {&ADA$_DEVICE_ERROR,    &Device_Error},
1251   {&ADA$_END_ERROR,       &End_Error},
1252   {&ADA$_MODE_ERROR,      &Mode_Error},
1253   {&ADA$_NAME_ERROR,      &Name_Error},
1254   {&ADA$_STATUS_ERROR,    &Status_Error},
1255   {&ADA$_NOT_OPEN,        &Use_Error},
1256   {&ADA$_ALREADY_OPEN,    &Use_Error},
1257   {&ADA$_USE_ERROR,       &Use_Error},
1258   {&ADA$_UNSUPPORTED,     &Use_Error},
1259   {&ADA$_FAC_MODE_MISMAT, &Use_Error},
1260   {&ADA$_ORG_MISMATCH,    &Use_Error},
1261   {&ADA$_RFM_MISMATCH,    &Use_Error},
1262   {&ADA$_RAT_MISMATCH,    &Use_Error},
1263   {&ADA$_MRS_MISMATCH,    &Use_Error},
1264   {&ADA$_MRN_MISMATCH,    &Use_Error},
1265   {&ADA$_KEY_MISMATCH,    &Use_Error},
1266   {&ADA$_MAXLINEXC,       &constraint_error},
1267   {&ADA$_LINEXCMRS,       &constraint_error},
1268   {0,                     0}
1269 };
1270
1271 #if 0
1272    /* Already handled by a pragma Import_Exception
1273       in Aux_IO_Exceptions */
1274   {&ADA$_LOCK_ERROR,      &Lock_Error},
1275   {&ADA$_EXISTENCE_ERROR, &Existence_Error},
1276   {&ADA$_KEY_ERROR,       &Key_Error},
1277 #endif
1278
1279 #endif /* IN_RTS */
1280
1281 /* Non-DEC Ada specific conditions.  We could probably also put
1282    SS$_HPARITH here and possibly SS$_ACCVIO, SS$_STKOVF.  */
1283 static const struct cond_except cond_except_table [] = {
1284   {&MTH$_FLOOVEMAT, &constraint_error},
1285   {&SS$_INTDIV,     &constraint_error},
1286   {0,               0}
1287 };
1288
1289 /* To deal with VMS conditions and their mapping to Ada exceptions,
1290    the __gnat_error_handler routine below is installed as an exception
1291    vector having precedence over DEC frame handlers.  Some conditions
1292    still need to be handled by such handlers, however, in which case
1293    __gnat_error_handler needs to return SS$_RESIGNAL.  Consider for
1294    instance the use of a third party library compiled with DECAda and
1295    performing its own exception handling internally.
1296
1297    To allow some user-level flexibility, which conditions should be
1298    resignaled is controlled by a predicate function, provided with the
1299    condition value and returning a boolean indication stating whether
1300    this condition should be resignaled or not.
1301
1302    That predicate function is called indirectly, via a function pointer,
1303    by __gnat_error_handler, and changing that pointer is allowed to the
1304    the user code by way of the __gnat_set_resignal_predicate interface.
1305
1306    The user level function may then implement what it likes, including
1307    for instance the maintenance of a dynamic data structure if the set
1308    of to be resignalled conditions has to change over the program's
1309    lifetime.
1310
1311    ??? This is not a perfect solution to deal with the possible
1312    interactions between the GNAT and the DECAda exception handling
1313    models and better (more general) schemes are studied.  This is so
1314    just provided as a convenient workaround in the meantime, and
1315    should be use with caution since the implementation has been kept
1316    very simple.  */
1317
1318 typedef int
1319 resignal_predicate (int code);
1320
1321 const int *cond_resignal_table [] = {
1322   &CMA$_EXIT_THREAD,
1323   &SS$_DEBUG,
1324   &LIB$_KEYNOTFOU,
1325   &LIB$_ACTIMAGE,
1326   (int *) RDB$_STREAM_EOF,
1327   (int *) FDL$_UNPRIKW,
1328   0
1329 };
1330
1331 const int facility_resignal_table [] = {
1332   0x1380000, /* RDB */
1333   0x2220000, /* SQL */
1334   0
1335 };
1336
1337 /* Default GNAT predicate for resignaling conditions.  */
1338
1339 static int
1340 __gnat_default_resignal_p (int code)
1341 {
1342   int i, iexcept;
1343
1344   for (i = 0; facility_resignal_table [i]; i++)
1345     if ((code & 0xfff0000) == facility_resignal_table [i])
1346       return 1;
1347
1348   for (i = 0, iexcept = 0;
1349        cond_resignal_table [i] &&
1350        !(iexcept = LIB$MATCH_COND (&code, &cond_resignal_table [i]));
1351        i++);
1352
1353   return iexcept;
1354 }
1355
1356 /* Static pointer to predicate that the __gnat_error_handler exception
1357    vector invokes to determine if it should resignal a condition.  */
1358
1359 static resignal_predicate * __gnat_resignal_p = __gnat_default_resignal_p;
1360
1361 /* User interface to change the predicate pointer to PREDICATE. Reset to
1362    the default if PREDICATE is null.  */
1363
1364 void
1365 __gnat_set_resignal_predicate (resignal_predicate * predicate)
1366 {
1367   if (predicate == 0)
1368     __gnat_resignal_p = __gnat_default_resignal_p;
1369   else
1370     __gnat_resignal_p = predicate;
1371 }
1372
1373 /* Should match System.Parameters.Default_Exception_Msg_Max_Length.  */
1374 #define Default_Exception_Msg_Max_Length 512
1375
1376 /* Action routine for SYS$PUTMSG. There may be multiple
1377    conditions, each with text to be appended to MESSAGE
1378    and separated by line termination.  */
1379
1380 static int
1381 copy_msg (msgdesc, message)
1382      struct descriptor_s *msgdesc;
1383      char *message;
1384 {
1385   int len = strlen (message);
1386   int copy_len;
1387
1388   /* Check for buffer overflow and skip.  */
1389   if (len > 0 && len <= Default_Exception_Msg_Max_Length - 3)
1390     {
1391       strcat (message, "\r\n");
1392       len += 2;
1393     }
1394
1395   /* Check for buffer overflow and truncate if necessary.  */
1396   copy_len = (len + msgdesc->len <= Default_Exception_Msg_Max_Length - 1 ?
1397               msgdesc->len :
1398               Default_Exception_Msg_Max_Length - 1 - len);
1399   strncpy (&message [len], msgdesc->adr, copy_len);
1400   message [len + copy_len] = 0;
1401
1402   return 0;
1403 }
1404
1405 long
1406 __gnat_handle_vms_condition (int *sigargs, void *mechargs)
1407 {
1408   struct Exception_Data *exception = 0;
1409   Exception_Code base_code;
1410   struct descriptor_s gnat_facility = {4,0,"GNAT"};
1411   char message [Default_Exception_Msg_Max_Length];
1412
1413   const char *msg = "";
1414
1415   /* Check for conditions to resignal which aren't effected by pragma
1416      Import_Exception.  */
1417   if (__gnat_resignal_p (sigargs [1]))
1418     return SS$_RESIGNAL;
1419
1420 #ifdef IN_RTS
1421   /* See if it's an imported exception.  Beware that registered exceptions
1422      are bound to their base code, with the severity bits masked off.  */
1423   base_code = Base_Code_In ((Exception_Code) sigargs [1]);
1424   exception = Coded_Exception (base_code);
1425
1426   if (exception)
1427     {
1428       message [0] = 0;
1429
1430       /* Subtract PC & PSL fields which messes with PUTMSG.  */
1431       sigargs [0] -= 2;
1432       SYS$PUTMSG (sigargs, copy_msg, &gnat_facility, message);
1433       sigargs [0] += 2;
1434       msg = message;
1435
1436       exception->Name_Length = 19;
1437       /* ??? The full name really should be get sys$getmsg returns.  */
1438       exception->Full_Name = "IMPORTED_EXCEPTION";
1439       exception->Import_Code = base_code;
1440
1441 #ifdef __IA64
1442       /* Do not adjust the program counter as already points to the next
1443          instruction (just after the call to LIB$STOP).  */
1444       Raise_From_Signal_Handler (exception, msg);
1445 #endif
1446     }
1447 #endif
1448
1449   if (exception == 0)
1450     switch (sigargs[1])
1451       {
1452       case SS$_ACCVIO:
1453         if (sigargs[3] == 0)
1454           {
1455             exception = &constraint_error;
1456             msg = "access zero";
1457           }
1458         else
1459           {
1460             exception = &storage_error;
1461             msg = "stack overflow (or erroneous memory access)";
1462           }
1463         __gnat_adjust_context_for_raise (0, (void *)mechargs);
1464         break;
1465
1466       case SS$_STKOVF:
1467         exception = &storage_error;
1468         msg = "stack overflow";
1469         __gnat_adjust_context_for_raise (0, (void *)mechargs);
1470         break;
1471
1472       case SS$_HPARITH:
1473 #ifndef IN_RTS
1474         return SS$_RESIGNAL; /* toplev.c handles for compiler */
1475 #else
1476         exception = &constraint_error;
1477         msg = "arithmetic error";
1478 #ifndef __alpha__
1479         /* No need to adjust pc on Alpha: the pc is already on the instruction
1480            after the trapping one.  */
1481         __gnat_adjust_context_for_raise (0, (void *)mechargs);
1482 #endif
1483 #endif
1484         break;
1485
1486       default:
1487 #ifdef IN_RTS
1488         {
1489           int i;
1490
1491           /* Scan the DEC Ada exception condition table for a match and fetch
1492              the associated GNAT exception pointer.  */
1493           for (i = 0;
1494                dec_ada_cond_except_table [i].cond &&
1495                !LIB$MATCH_COND (&sigargs [1],
1496                                 &dec_ada_cond_except_table [i].cond);
1497                i++);
1498           exception = (struct Exception_Data *)
1499             dec_ada_cond_except_table [i].except;
1500
1501           if (!exception)
1502             {
1503               /* Scan the VMS standard condition table for a match and fetch
1504                  the associated GNAT exception pointer.  */
1505               for (i = 0;
1506                    cond_except_table [i].cond &&
1507                    !LIB$MATCH_COND (&sigargs [1], &cond_except_table [i].cond);
1508                    i++);
1509               exception = (struct Exception_Data *)
1510                 cond_except_table [i].except;
1511
1512               if (!exception)
1513                 /* User programs expect Non_Ada_Error to be raised, reference
1514                    DEC Ada test CXCONDHAN.  */
1515                 exception = &Non_Ada_Error;
1516             }
1517         }
1518 #else
1519         exception = &program_error;
1520 #endif
1521         message [0] = 0;
1522         /* Subtract PC & PSL fields which messes with PUTMSG.  */
1523         sigargs [0] -= 2;
1524         SYS$PUTMSG (sigargs, copy_msg, &gnat_facility, message);
1525         sigargs [0] += 2;
1526         msg = message;
1527         break;
1528       }
1529
1530   Raise_From_Signal_Handler (exception, msg);
1531 }
1532
1533 long
1534 __gnat_error_handler (int *sigargs, void *mechargs)
1535 {
1536   return __gnat_handle_vms_condition (sigargs, mechargs);
1537 }
1538
1539 void
1540 __gnat_install_handler (void)
1541 {
1542   long prvhnd ATTRIBUTE_UNUSED;
1543
1544 #if !defined (IN_RTS)
1545   SYS$SETEXV (1, __gnat_error_handler, 3, &prvhnd);
1546 #endif
1547
1548   /* On alpha-vms, we avoid the global vector annoyance thanks to frame based
1549      handlers to turn conditions into exceptions since GCC 3.4.  The global
1550      vector is still required for earlier GCC versions.  We're resorting to
1551      the __gnat_error_prehandler assembly function in this case.  */
1552
1553 #if defined (IN_RTS) && defined (__alpha__)
1554   if ((__GNUC__ * 10 + __GNUC_MINOR__) < 34)
1555     {
1556       char * c = (char *) xmalloc (2049);
1557
1558       __gnat_error_prehandler_stack = &c[2048];
1559       SYS$SETEXV (1, __gnat_error_prehandler, 3, &prvhnd);
1560     }
1561 #endif
1562
1563   __gnat_handler_installed = 1;
1564 }
1565
1566 /* __gnat_adjust_context_for_raise for Alpha - see comments along with the
1567    default version later in this file.  */
1568
1569 #if defined (IN_RTS) && defined (__alpha__)
1570
1571 #include <vms/chfctxdef.h>
1572 #include <vms/chfdef.h>
1573
1574 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
1575
1576 void
1577 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
1578 {
1579   /* Add one to the address of the instruction signaling the condition,
1580      located in the sigargs array.  */
1581
1582   CHF$MECH_ARRAY * mechargs = (CHF$MECH_ARRAY *) ucontext;
1583   CHF$SIGNAL_ARRAY * sigargs
1584     = (CHF$SIGNAL_ARRAY *) mechargs->chf$q_mch_sig_addr;
1585
1586   int vcount = sigargs->chf$is_sig_args;
1587   int * pc_slot = & (&sigargs->chf$l_sig_name)[vcount-2];
1588
1589   (*pc_slot) ++;
1590 }
1591
1592 #endif
1593
1594 /* __gnat_adjust_context_for_raise for ia64.  */
1595
1596 #if defined (IN_RTS) && defined (__IA64)
1597
1598 #include <vms/chfctxdef.h>
1599 #include <vms/chfdef.h>
1600
1601 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
1602
1603 typedef unsigned long long u64;
1604
1605 void
1606 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
1607 {
1608   /* Add one to the address of the instruction signaling the condition,
1609      located in the 64bits sigargs array.  */
1610
1611   CHF$MECH_ARRAY * mechargs = (CHF$MECH_ARRAY *) ucontext;
1612
1613   CHF64$SIGNAL_ARRAY *chfsig64
1614     = (CHF64$SIGNAL_ARRAY *) mechargs->chf$ph_mch_sig64_addr;
1615
1616   u64 * post_sigarray
1617     = (u64 *)chfsig64 + 1 + chfsig64->chf64$l_sig_args;
1618
1619   u64 * ih_pc_loc = post_sigarray - 2;
1620
1621   (*ih_pc_loc) ++;
1622 }
1623
1624 #endif
1625
1626 /* Feature logical name and global variable address pair */
1627 struct feature {char *name; int* gl_addr;};
1628
1629 /* Default values for GNAT features set by environment. */
1630 int __gl_no_malloc_64 = 0;
1631
1632 /* Array feature logical names and global variable addresses */
1633 static struct feature features[] = {
1634   {"GNAT$NO_MALLOC_64", &__gl_no_malloc_64},
1635   {0, 0}
1636 };
1637
1638 void __gnat_set_features ()
1639 {
1640   struct descriptor_s name_desc, result_desc;
1641   int i, status;
1642   unsigned short rlen;
1643
1644 #define MAXEQUIV 10
1645   char buff [MAXEQUIV];
1646
1647   /* Loop through features array and test name for enable/disable */
1648   for (i=0; features [i].name; i++)
1649     {
1650        name_desc.len = strlen (features [i].name);
1651        name_desc.mbz = 0;
1652        name_desc.adr = features [i].name;
1653
1654        result_desc.len = MAXEQUIV - 1;
1655        result_desc.mbz = 0;
1656        result_desc.adr = buff;
1657
1658        status = LIB$GET_LOGICAL (&name_desc, &result_desc, &rlen);
1659
1660        if (((status & 1) == 1) && (rlen < MAXEQUIV))
1661          buff [rlen] = 0;
1662        else
1663          strcpy (buff, "");
1664
1665        if (strcmp (buff, "ENABLE") == 0)
1666           *features [i].gl_addr = 1;
1667        else if (strcmp (buff, "DISABLE") == 0)
1668           *features [i].gl_addr = 0;
1669     }
1670
1671     __gnat_features_set = 1;
1672 }
1673
1674 /*******************/
1675 /* FreeBSD Section */
1676 /*******************/
1677
1678 #elif defined (__FreeBSD__)
1679
1680 #include <signal.h>
1681 #include <sys/ucontext.h>
1682 #include <unistd.h>
1683
1684 static void __gnat_error_handler (int, siginfo_t *, ucontext_t *);
1685
1686 static void
1687 __gnat_error_handler (int sig, siginfo_t *info __attribute__ ((unused)),
1688                       ucontext_t *ucontext)
1689 {
1690   struct Exception_Data *exception;
1691   const char *msg;
1692
1693   switch (sig)
1694     {
1695     case SIGFPE:
1696       exception = &constraint_error;
1697       msg = "SIGFPE";
1698       break;
1699
1700     case SIGILL:
1701       exception = &constraint_error;
1702       msg = "SIGILL";
1703       break;
1704
1705     case SIGSEGV:
1706       exception = &storage_error;
1707       msg = "stack overflow or erroneous memory access";
1708       break;
1709
1710     case SIGBUS:
1711       exception = &constraint_error;
1712       msg = "SIGBUS";
1713       break;
1714
1715     default:
1716       exception = &program_error;
1717       msg = "unhandled signal";
1718     }
1719
1720   Raise_From_Signal_Handler (exception, msg);
1721 }
1722
1723 void
1724 __gnat_install_handler ()
1725 {
1726   struct sigaction act;
1727
1728   /* Set up signal handler to map synchronous signals to appropriate
1729      exceptions.  Make sure that the handler isn't interrupted by another
1730      signal that might cause a scheduling event!  */
1731
1732   act.sa_sigaction
1733     = (void (*)(int, struct __siginfo *, void*)) __gnat_error_handler;
1734   act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
1735   (void) sigemptyset (&act.sa_mask);
1736
1737   (void) sigaction (SIGILL,  &act, NULL);
1738   (void) sigaction (SIGFPE,  &act, NULL);
1739   (void) sigaction (SIGSEGV, &act, NULL);
1740   (void) sigaction (SIGBUS,  &act, NULL);
1741
1742   __gnat_handler_installed = 1;
1743 }
1744
1745 /*******************/
1746 /* VxWorks Section */
1747 /*******************/
1748
1749 #elif defined(__vxworks)
1750
1751 #include <signal.h>
1752 #include <taskLib.h>
1753
1754 #ifndef __RTP__
1755 #include <intLib.h>
1756 #include <iv.h>
1757 #endif
1758
1759 #ifdef VTHREADS
1760 #include "private/vThreadsP.h"
1761 #endif
1762
1763 void __gnat_error_handler (int, void *, struct sigcontext *);
1764
1765 #ifndef __RTP__
1766
1767 /* Directly vectored Interrupt routines are not supported when using RTPs.  */
1768
1769 extern int __gnat_inum_to_ivec (int);
1770
1771 /* This is needed by the GNAT run time to handle Vxworks interrupts.  */
1772 int
1773 __gnat_inum_to_ivec (int num)
1774 {
1775   return INUM_TO_IVEC (num);
1776 }
1777 #endif
1778
1779 #if !defined(__alpha_vxworks) && (_WRS_VXWORKS_MAJOR != 6) && !defined(__RTP__)
1780
1781 /* getpid is used by s-parint.adb, but is not defined by VxWorks, except
1782    on Alpha VxWorks and VxWorks 6.x (including RTPs).  */
1783
1784 extern long getpid (void);
1785
1786 long
1787 getpid (void)
1788 {
1789   return taskIdSelf ();
1790 }
1791 #endif
1792
1793 /* VxWorks expects the field excCnt to be zeroed when a signal is handled.
1794    The VxWorks version of longjmp does this; GCC's builtin_longjmp doesn't.  */
1795 void
1796 __gnat_clear_exception_count (void)
1797 {
1798 #ifdef VTHREADS
1799   WIND_TCB *currentTask = (WIND_TCB *) taskIdSelf();
1800
1801   currentTask->vThreads.excCnt = 0;
1802 #endif
1803 }
1804
1805 /* Handle different SIGnal to exception mappings in different VxWorks
1806    versions.   */
1807 static void
1808 __gnat_map_signal (int sig)
1809 {
1810   struct Exception_Data *exception;
1811   const char *msg;
1812
1813   switch (sig)
1814     {
1815     case SIGFPE:
1816       exception = &constraint_error;
1817       msg = "SIGFPE";
1818       break;
1819 #ifdef VTHREADS
1820     case SIGILL:
1821       exception = &constraint_error;
1822       msg = "Floating point exception or SIGILL";
1823       break;
1824     case SIGSEGV:
1825       exception = &storage_error;
1826       msg = "SIGSEGV: possible stack overflow";
1827       break;
1828     case SIGBUS:
1829       exception = &storage_error;
1830       msg = "SIGBUS: possible stack overflow";
1831       break;
1832 #else
1833 #ifdef __RTP__
1834     /* In RTP mode a SIGSEGV is most likely due to a stack overflow,
1835        since stack checking uses the probing mechanism.  */
1836     case SIGILL:
1837       exception = &constraint_error;
1838       msg = "SIGILL";
1839       break;
1840     case SIGSEGV:
1841       exception = &storage_error;
1842       msg = "SIGSEGV: possible stack overflow";
1843       break;
1844 #else
1845     /* In kernel mode a SIGILL is most likely due to a stack overflow,
1846        since stack checking uses the stack limit mechanism.  */
1847     case SIGILL:
1848       exception = &storage_error;
1849       msg = "SIGILL: possible stack overflow";
1850       break;
1851     case SIGSEGV:
1852       exception = &program_error;
1853       msg = "SIGSEGV";
1854       break;
1855 #endif
1856     case SIGBUS:
1857       exception = &program_error;
1858       msg = "SIGBUS";
1859       break;
1860 #endif
1861     default:
1862       exception = &program_error;
1863       msg = "unhandled signal";
1864     }
1865
1866   __gnat_clear_exception_count ();
1867   Raise_From_Signal_Handler (exception, msg);
1868 }
1869
1870 /* Tasking and Non-tasking signal handler.  Map SIGnal to Ada exception
1871    propagation after the required low level adjustments.  */
1872
1873 void
1874 __gnat_error_handler (int sig, void * si ATTRIBUTE_UNUSED,
1875                       struct sigcontext * sc)
1876 {
1877   sigset_t mask;
1878
1879   /* VxWorks will always mask out the signal during the signal handler and
1880      will reenable it on a longjmp.  GNAT does not generate a longjmp to
1881      return from a signal handler so the signal will still be masked unless
1882      we unmask it.  */
1883   sigprocmask (SIG_SETMASK, NULL, &mask);
1884   sigdelset (&mask, sig);
1885   sigprocmask (SIG_SETMASK, &mask, NULL);
1886
1887   __gnat_map_signal (sig);
1888 }
1889
1890 void
1891 __gnat_install_handler (void)
1892 {
1893   struct sigaction act;
1894
1895   /* Setup signal handler to map synchronous signals to appropriate
1896      exceptions.  Make sure that the handler isn't interrupted by another
1897      signal that might cause a scheduling event!  */
1898
1899   act.sa_handler = __gnat_error_handler;
1900   act.sa_flags = SA_SIGINFO | SA_ONSTACK;
1901   sigemptyset (&act.sa_mask);
1902
1903   /* For VxWorks, install all signal handlers, since pragma Interrupt_State
1904      applies to vectored hardware interrupts, not signals.  */
1905   sigaction (SIGFPE,  &act, NULL);
1906   sigaction (SIGILL,  &act, NULL);
1907   sigaction (SIGSEGV, &act, NULL);
1908   sigaction (SIGBUS,  &act, NULL);
1909
1910   __gnat_handler_installed = 1;
1911 }
1912
1913 #define HAVE_GNAT_INIT_FLOAT
1914
1915 void
1916 __gnat_init_float (void)
1917 {
1918   /* Disable overflow/underflow exceptions on the PPC processor, needed
1919      to get correct Ada semantics.  Note that for AE653 vThreads, the HW
1920      overflow settings are an OS configuration issue.  The instructions
1921      below have no effect.  */
1922 #if defined (_ARCH_PPC) && !defined (_SOFT_FLOAT) && !defined (VTHREADS)
1923   asm ("mtfsb0 25");
1924   asm ("mtfsb0 26");
1925 #endif
1926
1927 #if (defined (__i386__) || defined (i386)) && !defined (VTHREADS)
1928   /* This is used to properly initialize the FPU on an x86 for each
1929      process thread.  */
1930   asm ("finit");
1931 #endif
1932
1933   /* Similarly for SPARC64.  Achieved by masking bits in the Trap Enable Mask
1934      field of the Floating-point Status Register (see the SPARC Architecture
1935      Manual Version 9, p 48).  */
1936 #if defined (sparc64)
1937
1938 #define FSR_TEM_NVM (1 << 27)  /* Invalid operand  */
1939 #define FSR_TEM_OFM (1 << 26)  /* Overflow  */
1940 #define FSR_TEM_UFM (1 << 25)  /* Underflow  */
1941 #define FSR_TEM_DZM (1 << 24)  /* Division by Zero  */
1942 #define FSR_TEM_NXM (1 << 23)  /* Inexact result  */
1943   {
1944     unsigned int fsr;
1945
1946     __asm__("st %%fsr, %0" : "=m" (fsr));
1947     fsr &= ~(FSR_TEM_OFM | FSR_TEM_UFM);
1948     __asm__("ld %0, %%fsr" : : "m" (fsr));
1949   }
1950 #endif
1951 }
1952
1953 /* This subprogram is called by System.Task_Primitives.Operations.Enter_Task
1954    (if not null) when a new task is created.  It is initialized by
1955    System.Stack_Checking.Operations.Initialize_Stack_Limit.
1956    The use of a hook avoids to drag stack checking subprograms if stack
1957    checking is not used.  */
1958 void (*__gnat_set_stack_limit_hook)(void) = (void (*)(void))0;
1959
1960
1961 /******************/
1962 /* NetBSD Section */
1963 /******************/
1964
1965 #elif defined(__NetBSD__)
1966
1967 #include <signal.h>
1968 #include <unistd.h>
1969
1970 static void
1971 __gnat_error_handler (int sig)
1972 {
1973   struct Exception_Data *exception;
1974   const char *msg;
1975
1976   switch(sig)
1977   {
1978     case SIGFPE:
1979       exception = &constraint_error;
1980       msg = "SIGFPE";
1981       break;
1982     case SIGILL:
1983       exception = &constraint_error;
1984       msg = "SIGILL";
1985       break;
1986     case SIGSEGV:
1987       exception = &storage_error;
1988       msg = "stack overflow or erroneous memory access";
1989       break;
1990     case SIGBUS:
1991       exception = &constraint_error;
1992       msg = "SIGBUS";
1993       break;
1994     default:
1995       exception = &program_error;
1996       msg = "unhandled signal";
1997     }
1998
1999     Raise_From_Signal_Handler(exception, msg);
2000 }
2001
2002 void
2003 __gnat_install_handler(void)
2004 {
2005   struct sigaction act;
2006
2007   act.sa_handler = __gnat_error_handler;
2008   act.sa_flags = SA_NODEFER | SA_RESTART;
2009   sigemptyset (&act.sa_mask);
2010
2011   /* Do not install handlers if interrupt state is "System".  */
2012   if (__gnat_get_interrupt_state (SIGFPE) != 's')
2013     sigaction (SIGFPE,  &act, NULL);
2014   if (__gnat_get_interrupt_state (SIGILL) != 's')
2015     sigaction (SIGILL,  &act, NULL);
2016   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
2017     sigaction (SIGSEGV, &act, NULL);
2018   if (__gnat_get_interrupt_state (SIGBUS) != 's')
2019     sigaction (SIGBUS,  &act, NULL);
2020
2021   __gnat_handler_installed = 1;
2022 }
2023
2024 /*******************/
2025 /* OpenBSD Section */
2026 /*******************/
2027
2028 #elif defined(__OpenBSD__)
2029
2030 #include <signal.h>
2031 #include <unistd.h>
2032
2033 static void
2034 __gnat_error_handler (int sig)
2035 {
2036   struct Exception_Data *exception;
2037   const char *msg;
2038
2039   switch(sig)
2040   {
2041     case SIGFPE:
2042       exception = &constraint_error;
2043       msg = "SIGFPE";
2044       break;
2045     case SIGILL:
2046       exception = &constraint_error;
2047       msg = "SIGILL";
2048       break;
2049     case SIGSEGV:
2050       exception = &storage_error;
2051       msg = "stack overflow or erroneous memory access";
2052       break;
2053     case SIGBUS:
2054       exception = &constraint_error;
2055       msg = "SIGBUS";
2056       break;
2057     default:
2058       exception = &program_error;
2059       msg = "unhandled signal";
2060     }
2061
2062     Raise_From_Signal_Handler(exception, msg);
2063 }
2064
2065 void
2066 __gnat_install_handler(void)
2067 {
2068   struct sigaction act;
2069
2070   act.sa_handler = __gnat_error_handler;
2071   act.sa_flags = SA_NODEFER | SA_RESTART;
2072   sigemptyset (&act.sa_mask);
2073
2074   /* Do not install handlers if interrupt state is "System" */
2075   if (__gnat_get_interrupt_state (SIGFPE) != 's')
2076     sigaction (SIGFPE,  &act, NULL);
2077   if (__gnat_get_interrupt_state (SIGILL) != 's')
2078     sigaction (SIGILL,  &act, NULL);
2079   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
2080     sigaction (SIGSEGV, &act, NULL);
2081   if (__gnat_get_interrupt_state (SIGBUS) != 's')
2082     sigaction (SIGBUS,  &act, NULL);
2083
2084   __gnat_handler_installed = 1;
2085 }
2086
2087 #else
2088
2089 /* For all other versions of GNAT, the handler does nothing.  */
2090
2091 /*******************/
2092 /* Default Section */
2093 /*******************/
2094
2095 void
2096 __gnat_install_handler (void)
2097 {
2098   __gnat_handler_installed = 1;
2099 }
2100
2101 #endif
2102
2103 /*********************/
2104 /* __gnat_init_float */
2105 /*********************/
2106
2107 /* This routine is called as each process thread is created, for possible
2108    initialization of the FP processor.  This version is used under INTERIX,
2109    WIN32 and could be used under OS/2.  */
2110
2111 #if defined (_WIN32) || defined (__INTERIX) || defined (__EMX__) \
2112   || defined (__Lynx__) || defined(__NetBSD__) || defined(__FreeBSD__) \
2113   || defined (__OpenBSD__)
2114
2115 #define HAVE_GNAT_INIT_FLOAT
2116
2117 void
2118 __gnat_init_float (void)
2119 {
2120 #if defined (__i386__) || defined (i386)
2121
2122   /* This is used to properly initialize the FPU on an x86 for each
2123      process thread.  */
2124
2125   asm ("finit");
2126
2127 #endif  /* Defined __i386__ */
2128 }
2129 #endif
2130
2131 #ifndef HAVE_GNAT_INIT_FLOAT
2132
2133 /* All targets without a specific __gnat_init_float will use an empty one.  */
2134 void
2135 __gnat_init_float (void)
2136 {
2137 }
2138 #endif
2139
2140 /***********************************/
2141 /* __gnat_adjust_context_for_raise */
2142 /***********************************/
2143
2144 #ifndef HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
2145
2146 /* All targets without a specific version will use an empty one.  */
2147
2148 /* Given UCONTEXT a pointer to a context structure received by a signal
2149    handler for SIGNO, perform the necessary adjustments to let the handler
2150    raise an exception.  Calls to this routine are not conditioned by the
2151    propagation scheme in use.  */
2152
2153 void
2154 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED,
2155                                  void *ucontext ATTRIBUTE_UNUSED)
2156 {
2157   /* We used to compensate here for the raised from call vs raised from signal
2158      exception discrepancy with the GCC ZCX scheme, but this is now dealt with
2159      generically (except for the Alpha and IA-64), see GCC PR other/26208.
2160
2161      *** Call vs signal exception discrepancy with GCC ZCX scheme ***
2162
2163      The GCC unwinder expects to be dealing with call return addresses, since
2164      this is the "nominal" case of what we retrieve while unwinding a regular
2165      call chain.
2166
2167      To evaluate if a handler applies at some point identified by a return
2168      address, the propagation engine needs to determine what region the
2169      corresponding call instruction pertains to.  Because the return address
2170      may not be attached to the same region as the call, the unwinder always
2171      subtracts "some" amount from a return address to search the region
2172      tables, amount chosen to ensure that the resulting address is inside the
2173      call instruction.
2174
2175      When we raise an exception from a signal handler, e.g. to transform a
2176      SIGSEGV into Storage_Error, things need to appear as if the signal
2177      handler had been "called" by the instruction which triggered the signal,
2178      so that exception handlers that apply there are considered.  What the
2179      unwinder will retrieve as the return address from the signal handler is
2180      what it will find as the faulting instruction address in the signal
2181      context pushed by the kernel.  Leaving this address untouched looses, if
2182      the triggering instruction happens to be the very first of a region, as
2183      the later adjustments performed by the unwinder would yield an address
2184      outside that region.  We need to compensate for the unwinder adjustments
2185      at some point, and this is what this routine is expected to do.
2186
2187      signo is passed because on some targets for some signals the PC in
2188      context points to the instruction after the faulting one, in which case
2189      the unwinder adjustment is still desired.  */
2190 }
2191
2192 #endif