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