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