gcc/ada/init.c

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