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