gcc/ada/init.c

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