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-2003 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,  59 Temple Place - Suite 330,  Boston, *
  20  * MA 02111-1307, 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. A
  34     major part of the functionality involved 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 handle resulting signals that come
  40     from these probes failing (i.e. touching protected pages) */
  41
  42 /* The following include is here to meet the published VxWorks requirement
  43    that the __vxworks header appear before any other include. */
  44 #ifdef __vxworks
  45 #include "vxWorks.h"
  46 #endif
  47
  48 #ifdef IN_RTS
  49 #include "tconfig.h"
  50 #include "tsystem.h"
  51 #include <sys/stat.h>
  52
  53 /* We don't have libiberty, so us malloc.  */
  54 #define xmalloc(S) malloc (S)
  55 #else
  56 #include "config.h"
  57 #include "system.h"
  58 #endif
  59
  60 #include "adaint.h"
  61 #include "raise.h"
  62
  63 extern void __gnat_raise_program_error (const char *, int);
  64
  65 /* Addresses of exception data blocks for predefined exceptions. */
  66 extern struct Exception_Data constraint_error;
  67 extern struct Exception_Data numeric_error;
  68 extern struct Exception_Data program_error;
  69 extern struct Exception_Data storage_error;
  70 extern struct Exception_Data tasking_error;
  71 extern struct Exception_Data _abort_signal;
  72
  73 #define Lock_Task system__soft_links__lock_task
  74 extern void (*Lock_Task) (void);
  75
  76 #define Unlock_Task system__soft_links__unlock_task
  77 extern void (*Unlock_Task) (void);
  78
  79 #define Get_Machine_State_Addr \
  80                       system__soft_links__get_machine_state_addr
  81 extern struct Machine_State *(*Get_Machine_State_Addr) (void);
  82
  83 #define Check_Abort_Status     \
  84                       system__soft_links__check_abort_status
  85 extern int (*Check_Abort_Status) (void);
  86
  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
  91 #define Propagate_Signal_Exception \
  92                       __gnat_propagate_sig_exc
  93 extern void Propagate_Signal_Exception (struct Machine_State *,
  94                                         struct Exception_Data *,
  95                                         const char *);
  96
  97 /* Copies of global values computed by the binder */
  98 int   __gl_main_priority            = -1;
  99 int   __gl_time_slice_val           = -1;
 100 char  __gl_wc_encoding              = 'n';
 101 char  __gl_locking_policy           = ' ';
 102 char  __gl_queuing_policy           = ' ';
 103 char  __gl_task_dispatching_policy  = ' ';
 104 char *__gl_restrictions             = 0;
 105 char *__gl_interrupt_states         = 0;
 106 int   __gl_num_interrupt_states     = 0;
 107 int   __gl_unreserve_all_interrupts = 0;
 108 int   __gl_exception_tracebacks     = 0;
 109 int   __gl_zero_cost_exceptions     = 0;
 110
 111 /* Indication of whether synchronous signal handler has already been
 112    installed by a previous call to adainit */
 113 int  __gnat_handler_installed      = 0;
 114
 115 /* HAVE_GNAT_INIT_FLOAT must be set on every targets where a __gnat_init_float
 116    is defined. If this is not set them a void implementation will be defined
 117    at the end of this unit. */
 118 #undef HAVE_GNAT_INIT_FLOAT
 119
 120 /******************************/
 121 /* __gnat_get_interrupt_state */
 122 /******************************/
 123
 124 char __gnat_get_interrupt_state (int);
 125
 126 /* This routine is called from the runtime as needed to determine the state
 127    of an interrupt, as set by an Interrupt_State pragma appearing anywhere
 128    in the current partition. The input argument is the interrupt number,
 129    and the result is one of the following:
 130
 131        'n'   this interrupt not set by any Interrupt_State pragma
 132        'u'   Interrupt_State pragma set state to User
 133        'r'   Interrupt_State pragma set state to Runtime
 134        's'   Interrupt_State pragma set state to System */
 135
 136 char
 137 __gnat_get_interrupt_state (int intrup)
 138 {
 139   if (intrup >= __gl_num_interrupt_states)
 140     return 'n';
 141   else
 142     return __gl_interrupt_states [intrup];
 143 }
 144
 145 /**********************/
 146 /* __gnat_set_globals */
 147 /**********************/
 148
 149 /* This routine is called from the binder generated main program.  It copies
 150    the values for global quantities computed by the binder into the following
 151    global locations. The reason that we go through this copy, rather than just
 152    define the global locations in the binder generated file, is that they are
 153    referenced from the runtime, which may be in a shared library, and the
 154    binder file is not in the shared library. Global references across library
 155    boundaries like this are not handled correctly in all systems.  */
 156
 157 void
 158 __gnat_set_globals (int main_priority,
 159                     int time_slice_val,
 160                     char wc_encoding,
 161                     char locking_policy,
 162                     char queuing_policy,
 163                     char task_dispatching_policy,
 164                     char *restrictions,
 165                     char *interrupt_states,
 166                     int num_interrupt_states,
 167                     int unreserve_all_interrupts,
 168                     int exception_tracebacks,
 169                     int zero_cost_exceptions)
 170 {
 171   static int already_called = 0;
 172
 173   /* If this procedure has been already called once, check that the
 174      arguments in this call are consistent with the ones in the previous
 175      calls. Otherwise, raise a Program_Error exception.
 176
 177      We do not check for consistency of the wide character encoding
 178      method. This default affects only Wide_Text_IO where no explicit
 179      coding method is given, and there is no particular reason to let
 180      this default be affected by the source representation of a library
 181      in any case.
 182
 183      We do not check either for the consistency of exception tracebacks,
 184      because exception tracebacks are not normally set in Stand-Alone
 185      libraries. If a library or the main program set the exception
 186      tracebacks, then they are never reset afterwards (see below).
 187
 188      The value of main_priority is meaningful only when we are invoked
 189      from the main program elaboration routine of an Ada application.
 190      Checking the consistency of this parameter should therefore not be
 191      done. Since it is assured that the main program elaboration will
 192      always invoke this procedure before any library elaboration
 193      routine, only the value of main_priority during the first call
 194      should be taken into account and all the subsequent ones should be
 195      ignored. Note that the case where the main program is not written
 196      in Ada is also properly handled, since the default value will then
 197      be used for this parameter.
 198
 199      For identical reasons, the consistency of time_slice_val should not
 200      be checked. */
 201
 202   if (already_called)
 203     {
 204       if (__gl_locking_policy              != locking_policy
 205           || __gl_queuing_policy           != queuing_policy
 206           || __gl_task_dispatching_policy  != task_dispatching_policy
 207           || __gl_unreserve_all_interrupts != unreserve_all_interrupts
 208           || __gl_zero_cost_exceptions     != zero_cost_exceptions)
 209         __gnat_raise_program_error (__FILE__, __LINE__);
 210
 211       /* If either a library or the main program set the exception traceback
 212          flag, it is never reset later */
 213
 214       if (exception_tracebacks != 0)
 215          __gl_exception_tracebacks = exception_tracebacks;
 216
 217       return;
 218     }
 219   already_called = 1;
 220
 221   __gl_main_priority            = main_priority;
 222   __gl_time_slice_val           = time_slice_val;
 223   __gl_wc_encoding              = wc_encoding;
 224   __gl_locking_policy           = locking_policy;
 225   __gl_queuing_policy           = queuing_policy;
 226   __gl_restrictions             = restrictions;
 227   __gl_interrupt_states         = interrupt_states;
 228   __gl_num_interrupt_states     = num_interrupt_states;
 229   __gl_task_dispatching_policy  = task_dispatching_policy;
 230   __gl_unreserve_all_interrupts = unreserve_all_interrupts;
 231   __gl_exception_tracebacks     = exception_tracebacks;
 232
 233   /* ??? __gl_zero_cost_exceptions is new in 3.15 and is referenced from
 234      a-except.adb, which is also part of the compiler sources. Since the
 235      compiler is built with an older release of GNAT, the call generated by
 236      the old binder to this function does not provide any value for the
 237      corresponding argument, so the global has to be initialized in some
 238      reasonable other way. This could be removed as soon as the next major
 239      release is out.  */
 240
 241 #ifdef IN_RTS
 242   __gl_zero_cost_exceptions = zero_cost_exceptions;
 243 #else
 244   __gl_zero_cost_exceptions = 0;
 245   /* We never build the compiler to run in ZCX mode currently anyway.  */
 246 #endif
 247 }
 248
 249 /*********************/
 250 /* __gnat_initialize */
 251 /*********************/
 252
 253 /* __gnat_initialize is called at the start of execution of an Ada program
 254    (the call is generated by the binder). The standard routine does nothing
 255    at all; the intention is that this be replaced by system specific
 256    code where initialization is required. */
 257
 258 /***********************************/
 259 /* __gnat_initialize (AIX Version) */
 260 /***********************************/
 261
 262 #if defined (_AIX)
 263
 264 #include <signal.h>
 265 #include <sys/time.h>
 266
 267 /* Some versions of AIX don't define SA_NODEFER. */
 268
 269 #ifndef SA_NODEFER
 270 #define SA_NODEFER 0
 271 #endif /* SA_NODEFER */
 272
 273 /* Versions of AIX before 4.3 don't have nanosleep but provide
 274    nsleep instead. */
 275
 276 #ifndef _AIXVERSION_430
 277
 278 extern int nanosleep (struct timestruc_t *, struct timestruc_t *);
 279
 280 int
 281 nanosleep (struct timestruc_t *Rqtp, struct timestruc_t *Rmtp)
 282 {
 283   return nsleep (Rqtp, Rmtp);
 284 }
 285
 286 #endif /* _AIXVERSION_430 */
 287
 288 static void __gnat_error_handler (int);
 289
 290 static void
 291 __gnat_error_handler (int sig)
 292 {
 293   struct Exception_Data *exception;
 294   const char *msg;
 295
 296   switch (sig)
 297     {
 298     case SIGSEGV:
 299       /* FIXME: we need to detect the case of a *real* SIGSEGV */
 300       exception = &storage_error;
 301       msg = "stack overflow or erroneous memory access";
 302       break;
 303
 304     case SIGBUS:
 305       exception = &constraint_error;
 306       msg = "SIGBUS";
 307       break;
 308
 309     case SIGFPE:
 310       exception = &constraint_error;
 311       msg = "SIGFPE";
 312       break;
 313
 314     default:
 315       exception = &program_error;
 316       msg = "unhandled signal";
 317     }
 318
 319   Raise_From_Signal_Handler (exception, msg);
 320 }
 321
 322 void
 323 __gnat_install_handler (void)
 324 {
 325   struct sigaction act;
 326
 327   /* Set up signal handler to map synchronous signals to appropriate
 328      exceptions.  Make sure that the handler isn't interrupted by another
 329      signal that might cause a scheduling event! */
 330
 331   act.sa_handler = __gnat_error_handler;
 332   act.sa_flags = SA_NODEFER | SA_RESTART;
 333   sigemptyset (&act.sa_mask);
 334
 335   /* Do not install handlers if interrupt state is "System" */
 336   if (__gnat_get_interrupt_state (SIGABRT) != 's')
 337     sigaction (SIGABRT, &act, NULL);
 338   if (__gnat_get_interrupt_state (SIGFPE) != 's')
 339     sigaction (SIGFPE,  &act, NULL);
 340   if (__gnat_get_interrupt_state (SIGILL) != 's')
 341     sigaction (SIGILL,  &act, NULL);
 342   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 343     sigaction (SIGSEGV, &act, NULL);
 344   if (__gnat_get_interrupt_state (SIGBUS) != 's')
 345     sigaction (SIGBUS,  &act, NULL);
 346
 347   __gnat_handler_installed = 1;
 348 }
 349
 350 void
 351 __gnat_initialize (void)
 352 {
 353 }
 354
 355 /***************************************/
 356 /* __gnat_initialize (RTEMS version) */
 357 /***************************************/
 358
 359 #elif defined(__rtems__)
 360
 361 extern void __gnat_install_handler (void);
 362
 363 /* For RTEMS, each bsp will provide a custom __gnat_install_handler (). */
 364
 365 void
 366 __gnat_initialize (void)
 367 {
 368    __gnat_install_handler ();
 369 }
 370
 371 /****************************************/
 372 /* __gnat_initialize (Dec Unix Version) */
 373 /****************************************/
 374
 375 #elif defined(__alpha__) && defined(__osf__) && ! defined(__alpha_vxworks)
 376
 377 /* Note: it seems that __osf__ is defined for the Alpha VXWorks case. Not
 378    clear that this is reasonable, but in any case we have to be sure to
 379    exclude this case in the above test.  */
 380
 381 #include <signal.h>
 382 #include <sys/siginfo.h>
 383
 384 static void __gnat_error_handler (int, siginfo_t *, struct sigcontext *);
 385 extern char *__gnat_get_code_loc (struct sigcontext *);
 386 extern void __gnat_enter_handler (struct sigcontext *, char *);
 387 extern size_t __gnat_machine_state_length (void);
 388
 389 extern long exc_lookup_gp (char *);
 390 extern void exc_resume (struct sigcontext *);
 391
 392 static void
 393 __gnat_error_handler (int sig, siginfo_t *sip, struct sigcontext *context)
 394 {
 395   struct Exception_Data *exception;
 396   static int recurse = 0;
 397   struct sigcontext *mstate;
 398   const char *msg;
 399
 400   /* If this was an explicit signal from a "kill", just resignal it.  */
 401   if (SI_FROMUSER (sip))
 402     {
 403       signal (sig, SIG_DFL);
 404       kill (getpid(), sig);
 405     }
 406
 407   /* Otherwise, treat it as something we handle.  */
 408   switch (sig)
 409     {
 410     case SIGSEGV:
 411       /* If the problem was permissions, this is a constraint error.
 412          Likewise if the failing address isn't maximally aligned or if
 413          we've recursed.
 414
 415          ??? Using a static variable here isn't task-safe, but it's
 416          much too hard to do anything else and we're just determining
 417          which exception to raise.  */
 418       if (sip->si_code == SEGV_ACCERR
 419           || (((long) sip->si_addr) & 3) != 0
 420           || recurse)
 421         {
 422           exception = &constraint_error;
 423           msg = "SIGSEGV";
 424         }
 425       else
 426         {
 427           /* See if the page before the faulting page is accessible.  Do that
 428              by trying to access it.  We'd like to simply try to access
 429              4096 + the faulting address, but it's not guaranteed to be
 430              the actual address, just to be on the same page.  */
 431           recurse++;
 432           ((volatile char *)
 433            ((long) sip->si_addr & - getpagesize ()))[getpagesize ()];
 434           msg = "stack overflow (or erroneous memory access)";
 435           exception = &storage_error;
 436         }
 437       break;
 438
 439     case SIGBUS:
 440       exception = &program_error;
 441       msg = "SIGBUS";
 442       break;
 443
 444     case SIGFPE:
 445       exception = &constraint_error;
 446       msg = "SIGFPE";
 447       break;
 448
 449     default:
 450       exception = &program_error;
 451       msg = "unhandled signal";
 452     }
 453
 454   recurse = 0;
 455   mstate = (struct sigcontext *) (*Get_Machine_State_Addr) ();
 456   if (mstate != 0)
 457     *mstate = *context;
 458
 459   Raise_From_Signal_Handler (exception, (char *) msg);
 460 }
 461
 462 void
 463 __gnat_install_handler (void)
 464 {
 465   struct sigaction act;
 466
 467   /* Setup signal handler to map synchronous signals to appropriate
 468      exceptions. Make sure that the handler isn't interrupted by another
 469      signal that might cause a scheduling event! */
 470
 471   act.sa_handler = (void (*) (int)) __gnat_error_handler;
 472   act.sa_flags = SA_ONSTACK | SA_RESTART | SA_NODEFER | SA_SIGINFO;
 473   sigemptyset (&act.sa_mask);
 474
 475   /* Do not install handlers if interrupt state is "System" */
 476   if (__gnat_get_interrupt_state (SIGABRT) != 's')
 477     sigaction (SIGABRT, &act, NULL);
 478   if (__gnat_get_interrupt_state (SIGFPE) != 's')
 479     sigaction (SIGFPE,  &act, NULL);
 480   if (__gnat_get_interrupt_state (SIGILL) != 's')
 481     sigaction (SIGILL,  &act, NULL);
 482   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 483     sigaction (SIGSEGV, &act, NULL);
 484   if (__gnat_get_interrupt_state (SIGBUS) != 's')
 485     sigaction (SIGBUS,  &act, NULL);
 486
 487   __gnat_handler_installed = 1;
 488 }
 489
 490 void
 491 __gnat_initialize (void)
 492 {
 493 }
 494
 495 /* Routines called by 5amastop.adb.  */
 496
 497 #define SC_GP 29
 498
 499 char *
 500 __gnat_get_code_loc (struct sigcontext *context)
 501 {
 502   return (char *) context->sc_pc;
 503 }
 504
 505 void
 506 __gnat_enter_handler ( struct sigcontext *context, char *pc)
 507 {
 508   context->sc_pc = (long) pc;
 509   context->sc_regs[SC_GP] = exc_lookup_gp (pc);
 510   exc_resume (context);
 511 }
 512
 513 size_t
 514 __gnat_machine_state_length (void)
 515 {
 516   return sizeof (struct sigcontext);
 517 }
 518
 519 /************************************/
 520 /* __gnat_initialize (HPUX Version) */
 521 /************************************/
 522
 523 #elif defined (hpux)
 524
 525 #include <signal.h>
 526
 527 static void __gnat_error_handler (int);
 528
 529 static void
 530 __gnat_error_handler (int sig)
 531 {
 532   struct Exception_Data *exception;
 533   char *msg;
 534
 535   switch (sig)
 536     {
 537     case SIGSEGV:
 538       /* FIXME: we need to detect the case of a *real* SIGSEGV */
 539       exception = &storage_error;
 540       msg = "stack overflow or erroneous memory access";
 541       break;
 542
 543     case SIGBUS:
 544       exception = &constraint_error;
 545       msg = "SIGBUS";
 546       break;
 547
 548     case SIGFPE:
 549       exception = &constraint_error;
 550       msg = "SIGFPE";
 551       break;
 552
 553     default:
 554       exception = &program_error;
 555       msg = "unhandled signal";
 556     }
 557
 558   Raise_From_Signal_Handler (exception, msg);
 559 }
 560
 561 void
 562 __gnat_install_handler (void)
 563 {
 564   struct sigaction act;
 565
 566   /* Set up signal handler to map synchronous signals to appropriate
 567      exceptions.  Make sure that the handler isn't interrupted by another
 568      signal that might cause a scheduling event! Also setup an alternate
 569      stack region for the handler execution so that stack overflows can be
 570      handled properly, avoiding a SEGV generation from stack usage by the
 571      handler itself. */
 572
 573   static char handler_stack[SIGSTKSZ*2];
 574   /* SIGSTKSZ appeared to be "short" for the needs in some contexts
 575      (e.g. experiments with GCC ZCX exceptions).  */
 576
 577   stack_t stack;
 578
 579   stack.ss_sp    = handler_stack;
 580   stack.ss_size  = sizeof (handler_stack);
 581   stack.ss_flags = 0;
 582
 583   sigaltstack (&stack, NULL);
 584
 585   act.sa_handler = __gnat_error_handler;
 586   act.sa_flags = SA_NODEFER | SA_RESTART | SA_ONSTACK;
 587   sigemptyset (&act.sa_mask);
 588
 589   /* Do not install handlers if interrupt state is "System" */
 590   if (__gnat_get_interrupt_state (SIGABRT) != 's')
 591     sigaction (SIGABRT, &act, NULL);
 592   if (__gnat_get_interrupt_state (SIGFPE) != 's')
 593     sigaction (SIGFPE,  &act, NULL);
 594   if (__gnat_get_interrupt_state (SIGILL) != 's')
 595     sigaction (SIGILL,  &act, NULL);
 596   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 597     sigaction (SIGSEGV, &act, NULL);
 598   if (__gnat_get_interrupt_state (SIGBUS) != 's')
 599     sigaction (SIGBUS,  &act, NULL);
 600
 601   __gnat_handler_installed = 1;
 602 }
 603
 604 void
 605 __gnat_initialize (void)
 606 {
 607 }
 608
 609 /*****************************************/
 610 /* __gnat_initialize (GNU/Linux Version) */
 611 /*****************************************/
 612
 613 #elif defined (linux) && defined (i386) && !defined (__RT__)
 614
 615 #include <signal.h>
 616 #include <asm/sigcontext.h>
 617
 618 /* GNU/Linux, which uses glibc, does not define NULL in included
 619    header files */
 620
 621 #if !defined (NULL)
 622 #define NULL ((void *) 0)
 623 #endif
 624
 625 struct Machine_State
 626 {
 627   unsigned long eip;
 628   unsigned long ebx;
 629   unsigned long esp;
 630   unsigned long ebp;
 631   unsigned long esi;
 632   unsigned long edi;
 633 };
 634
 635 static void __gnat_error_handler (int);
 636
 637 static void
 638 __gnat_error_handler (int sig)
 639 {
 640   struct Exception_Data *exception;
 641   const char *msg;
 642   static int recurse = 0;
 643
 644   struct sigcontext *info
 645     = (struct sigcontext *) (((char *) &sig) + sizeof (int));
 646
 647   /* The Linux kernel does not document how to get the machine state in a
 648      signal handler, but in fact the necessary data is in a sigcontext_struct
 649      value that is on the stack immediately above the signal number
 650      parameter, and the above messing accesses this value on the stack. */
 651
 652   struct Machine_State *mstate;
 653
 654   switch (sig)
 655     {
 656     case SIGSEGV:
 657       /* If the problem was permissions, this is a constraint error.
 658        Likewise if the failing address isn't maximally aligned or if
 659        we've recursed.
 660
 661        ??? Using a static variable here isn't task-safe, but it's
 662        much too hard to do anything else and we're just determining
 663        which exception to raise.  */
 664       if (recurse)
 665       {
 666         exception = &constraint_error;
 667         msg = "SIGSEGV";
 668       }
 669       else
 670       {
 671         /* Here we would like a discrimination test to see whether the
 672            page before the faulting address is accessible. Unfortunately
 673            Linux seems to have no way of giving us the faulting address.
 674
 675            In versions of a-init.c before 1.95, we had a test of the page
 676            before the stack pointer using:
 677
 678             recurse++;
 679              ((volatile char *)
 680               ((long) info->esp_at_signal & - getpagesize ()))[getpagesize ()];
 681
 682            but that's wrong, since it tests the stack pointer location, and
 683            the current stack probe code does not move the stack pointer
 684            until all probes succeed.
 685
 686            For now we simply do not attempt any discrimination at all. Note
 687            that this is quite acceptable, since a "real" SIGSEGV can only
 688            occur as the result of an erroneous program */
 689
 690         msg = "stack overflow (or erroneous memory access)";
 691         exception = &storage_error;
 692       }
 693       break;
 694
 695     case SIGBUS:
 696       exception = &constraint_error;
 697       msg = "SIGBUS";
 698       break;
 699
 700     case SIGFPE:
 701       exception = &constraint_error;
 702       msg = "SIGFPE";
 703       break;
 704
 705     default:
 706       exception = &program_error;
 707       msg = "unhandled signal";
 708     }
 709
 710   mstate = (*Get_Machine_State_Addr) ();
 711   if (mstate)
 712     {
 713       mstate->eip = info->eip;
 714       mstate->ebx = info->ebx;
 715       mstate->esp = info->esp_at_signal;
 716       mstate->ebp = info->ebp;
 717       mstate->esi = info->esi;
 718       mstate->edi = info->edi;
 719     }
 720
 721   recurse = 0;
 722   Raise_From_Signal_Handler (exception, msg);
 723 }
 724
 725 void
 726 __gnat_install_handler (void)
 727 {
 728   struct sigaction act;
 729
 730   /* Set up signal handler to map synchronous signals to appropriate
 731      exceptions.  Make sure that the handler isn't interrupted by another
 732      signal that might cause a scheduling event! */
 733
 734   act.sa_handler = __gnat_error_handler;
 735   act.sa_flags = SA_NODEFER | SA_RESTART;
 736   sigemptyset (&act.sa_mask);
 737
 738   /* Do not install handlers if interrupt state is "System" */
 739   if (__gnat_get_interrupt_state (SIGABRT) != 's')
 740     sigaction (SIGABRT, &act, NULL);
 741   if (__gnat_get_interrupt_state (SIGFPE) != 's')
 742     sigaction (SIGFPE,  &act, NULL);
 743   if (__gnat_get_interrupt_state (SIGILL) != 's')
 744     sigaction (SIGILL,  &act, NULL);
 745   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 746     sigaction (SIGSEGV, &act, NULL);
 747   if (__gnat_get_interrupt_state (SIGBUS) != 's')
 748     sigaction (SIGBUS,  &act, NULL);
 749
 750   __gnat_handler_installed = 1;
 751 }
 752
 753 void
 754 __gnat_initialize (void)
 755 {
 756 }
 757
 758 /******************************************/
 759 /* __gnat_initialize (NT-mingw32 Version) */
 760 /******************************************/
 761
 762 #elif defined (__MINGW32__)
 763 #include <windows.h>
 764
 765 static LONG WINAPI __gnat_error_handler (PEXCEPTION_POINTERS);
 766
 767 /* __gnat_initialize (mingw32).  */
 768
 769 static LONG WINAPI
 770 __gnat_error_handler (PEXCEPTION_POINTERS info)
 771 {
 772   static int recurse;
 773   struct Exception_Data *exception;
 774   const char *msg;
 775
 776   switch (info->ExceptionRecord->ExceptionCode)
 777     {
 778     case EXCEPTION_ACCESS_VIOLATION:
 779       /* If the failing address isn't maximally-aligned or if we've
 780          recursed, this is a program error.  */
 781       if ((info->ExceptionRecord->ExceptionInformation[1] & 3) != 0
 782           || recurse)
 783         {
 784           exception = &program_error;
 785           msg = "EXCEPTION_ACCESS_VIOLATION";
 786         }
 787       else
 788         {
 789           /* See if the page before the faulting page is accessible.  Do that
 790              by trying to access it. */
 791           recurse++;
 792           * ((volatile char *) (info->ExceptionRecord->ExceptionInformation[1]
 793                                 + 4096));
 794           exception = &storage_error;
 795           msg = "stack overflow (or erroneous memory access)";
 796         }
 797       break;
 798
 799     case EXCEPTION_ARRAY_BOUNDS_EXCEEDED:
 800       exception = &constraint_error;
 801       msg = "EXCEPTION_ARRAY_BOUNDS_EXCEEDED";
 802       break;
 803
 804     case EXCEPTION_DATATYPE_MISALIGNMENT:
 805       exception = &constraint_error;
 806       msg = "EXCEPTION_DATATYPE_MISALIGNMENT";
 807       break;
 808
 809     case EXCEPTION_FLT_DENORMAL_OPERAND:
 810       exception = &constraint_error;
 811       msg = "EXCEPTION_FLT_DENORMAL_OPERAND";
 812       break;
 813
 814     case EXCEPTION_FLT_DIVIDE_BY_ZERO:
 815       exception = &constraint_error;
 816       msg = "EXCEPTION_FLT_DENORMAL_OPERAND";
 817       break;
 818
 819     case EXCEPTION_FLT_INVALID_OPERATION:
 820       exception = &constraint_error;
 821       msg = "EXCEPTION_FLT_INVALID_OPERATION";
 822       break;
 823
 824     case EXCEPTION_FLT_OVERFLOW:
 825       exception = &constraint_error;
 826       msg = "EXCEPTION_FLT_OVERFLOW";
 827       break;
 828
 829     case EXCEPTION_FLT_STACK_CHECK:
 830       exception = &program_error;
 831       msg = "EXCEPTION_FLT_STACK_CHECK";
 832       break;
 833
 834     case EXCEPTION_FLT_UNDERFLOW:
 835       exception = &constraint_error;
 836       msg = "EXCEPTION_FLT_UNDERFLOW";
 837       break;
 838
 839     case EXCEPTION_INT_DIVIDE_BY_ZERO:
 840       exception = &constraint_error;
 841       msg = "EXCEPTION_INT_DIVIDE_BY_ZERO";
 842       break;
 843
 844     case EXCEPTION_INT_OVERFLOW:
 845       exception = &constraint_error;
 846       msg = "EXCEPTION_INT_OVERFLOW";
 847       break;
 848
 849     case EXCEPTION_INVALID_DISPOSITION:
 850       exception = &program_error;
 851       msg = "EXCEPTION_INVALID_DISPOSITION";
 852       break;
 853
 854     case EXCEPTION_NONCONTINUABLE_EXCEPTION:
 855       exception = &program_error;
 856       msg = "EXCEPTION_NONCONTINUABLE_EXCEPTION";
 857       break;
 858
 859     case EXCEPTION_PRIV_INSTRUCTION:
 860       exception = &program_error;
 861       msg = "EXCEPTION_PRIV_INSTRUCTION";
 862       break;
 863
 864     case EXCEPTION_SINGLE_STEP:
 865       exception = &program_error;
 866       msg = "EXCEPTION_SINGLE_STEP";
 867       break;
 868
 869     case EXCEPTION_STACK_OVERFLOW:
 870       exception = &storage_error;
 871       msg = "EXCEPTION_STACK_OVERFLOW";
 872       break;
 873
 874    default:
 875       exception = &program_error;
 876       msg = "unhandled signal";
 877     }
 878
 879   recurse = 0;
 880   Raise_From_Signal_Handler (exception, msg);
 881   return 0; /* This is never reached, avoid compiler warning */
 882 }
 883
 884 void
 885 __gnat_install_handler (void)
 886 {
 887   SetUnhandledExceptionFilter (__gnat_error_handler);
 888   __gnat_handler_installed = 1;
 889 }
 890
 891 void
 892 __gnat_initialize (void)
 893 {
 894
 895    /* Initialize floating-point coprocessor. This call is needed because
 896       the MS libraries default to 64-bit precision instead of 80-bit
 897       precision, and we require the full precision for proper operation,
 898       given that we have set Max_Digits etc with this in mind */
 899
 900    __gnat_init_float ();
 901
 902    /* initialize a lock for a process handle list - see a-adaint.c for the
 903       implementation of __gnat_portable_no_block_spawn, __gnat_portable_wait */
 904    __gnat_plist_init();
 905 }
 906
 907 /***************************************/
 908 /* __gnat_initialize (Interix Version) */
 909 /***************************************/
 910
 911 #elif defined (__INTERIX)
 912
 913 #include <signal.h>
 914
 915 static void __gnat_error_handler (int);
 916
 917 static void
 918 __gnat_error_handler (int sig)
 919 {
 920   struct Exception_Data *exception;
 921   char *msg;
 922
 923   switch (sig)
 924     {
 925     case SIGSEGV:
 926       exception = &storage_error;
 927       msg = "stack overflow or erroneous memory access";
 928       break;
 929
 930     case SIGBUS:
 931       exception = &constraint_error;
 932       msg = "SIGBUS";
 933       break;
 934
 935     case SIGFPE:
 936       exception = &constraint_error;
 937       msg = "SIGFPE";
 938       break;
 939
 940     default:
 941       exception = &program_error;
 942       msg = "unhandled signal";
 943     }
 944
 945   Raise_From_Signal_Handler (exception, msg);
 946 }
 947
 948 void
 949 __gnat_install_handler (void)
 950 {
 951   struct sigaction act;
 952
 953   /* Set up signal handler to map synchronous signals to appropriate
 954      exceptions.  Make sure that the handler isn't interrupted by another
 955      signal that might cause a scheduling event! */
 956
 957   act.sa_handler = __gnat_error_handler;
 958   act.sa_flags = 0;
 959   sigemptyset (&act.sa_mask);
 960
 961   /* Handlers for signals besides SIGSEGV cause c974013 to hang */
 962 /*  sigaction (SIGILL,  &act, NULL); */
 963 /*  sigaction (SIGABRT, &act, NULL); */
 964 /*  sigaction (SIGFPE,  &act, NULL); */
 965 /*  sigaction (SIGBUS,  &act, NULL); */
 966
 967   /* Do not install handlers if interrupt state is "System" */
 968   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
 969     sigaction (SIGSEGV, &act, NULL);
 970
 971   __gnat_handler_installed = 1;
 972 }
 973
 974 void
 975 __gnat_initialize (void)
 976 {
 977    __gnat_init_float ();
 978 }
 979
 980 /**************************************/
 981 /* __gnat_initialize (LynxOS Version) */
 982 /**************************************/
 983
 984 #elif defined (__Lynx__)
 985
 986 void
 987 __gnat_initialize (void)
 988 {
 989    __gnat_init_float ();
 990 }
 991
 992 /*********************************/
 993 /* __gnat_install_handler (Lynx) */
 994 /*********************************/
 995
 996 void
 997 __gnat_install_handler (void)
 998 {
 999   __gnat_handler_installed = 1;
1000 }
1001
1002 /****************************/
1003 /* __gnat_initialize (OS/2) */
1004 /****************************/
1005
1006 #elif defined (__EMX__) /* OS/2 dependent initialization */
1007
1008 void
1009 __gnat_initialize (void)
1010 {
1011 }
1012
1013 /*********************************/
1014 /* __gnat_install_handler (OS/2) */
1015 /*********************************/
1016
1017 void
1018 __gnat_install_handler (void)
1019 {
1020   __gnat_handler_installed = 1;
1021 }
1022
1023 /***********************************/
1024 /* __gnat_initialize (SGI Version) */
1025 /***********************************/
1026
1027 #elif defined (sgi)
1028
1029 #include <signal.h>
1030 #include <siginfo.h>
1031
1032 #ifndef NULL
1033 #define NULL 0
1034 #endif
1035
1036 #define SIGADAABORT 48
1037 #define SIGNAL_STACK_SIZE 4096
1038 #define SIGNAL_STACK_ALIGNMENT 64
1039
1040 struct Machine_State
1041 {
1042   sigcontext_t context;
1043 };
1044
1045 static void __gnat_error_handler (int, int, sigcontext_t *);
1046
1047 static void
1048 __gnat_error_handler (int sig, int code, sigcontext_t *sc)
1049 {
1050   struct Machine_State  *mstate;
1051   struct Exception_Data *exception;
1052   const char *msg;
1053
1054   switch (sig)
1055     {
1056     case SIGSEGV:
1057       if (code == EFAULT)
1058         {
1059           exception = &program_error;
1060           msg = "SIGSEGV: (Invalid virtual address)";
1061         }
1062       else if (code == ENXIO)
1063         {
1064           exception = &program_error;
1065           msg = "SIGSEGV: (Read beyond mapped object)";
1066         }
1067       else if (code == ENOSPC)
1068         {
1069           exception = &program_error; /* ??? storage_error ??? */
1070           msg = "SIGSEGV: (Autogrow for file failed)";
1071         }
1072       else if (code == EACCES)
1073         {
1074           /* ??? Re-add smarts to further verify that we launched
1075                  the stack into a guard page, not an attempt to
1076                  write to .text or something */
1077           exception = &storage_error;
1078           msg = "SIGSEGV: (stack overflow or erroneous memory access)";
1079         }
1080       else
1081         {
1082           /* Just in case the OS guys did it to us again.  Sometimes
1083              they fail to document all of the valid codes that are
1084              passed to signal handlers, just in case someone depends
1085              on knowing all the codes */
1086           exception = &program_error;
1087           msg = "SIGSEGV: (Undocumented reason)";
1088         }
1089       break;
1090
1091     case SIGBUS:
1092       /* Map all bus errors to Program_Error.  */
1093       exception = &program_error;
1094       msg = "SIGBUS";
1095       break;
1096
1097     case SIGFPE:
1098       /* Map all fpe errors to Constraint_Error.  */
1099       exception = &constraint_error;
1100       msg = "SIGFPE";
1101       break;
1102
1103     case SIGADAABORT:
1104       if ((*Check_Abort_Status) ())
1105         {
1106           exception = &_abort_signal;
1107           msg = "";
1108         }
1109       else
1110         return;
1111
1112       break;
1113
1114     default:
1115       /* Everything else is a Program_Error. */
1116       exception = &program_error;
1117       msg = "unhandled signal";
1118     }
1119
1120   mstate = (*Get_Machine_State_Addr) ();
1121   if (mstate != 0)
1122     memcpy ((void *) mstate, (const void *) sc, sizeof (sigcontext_t));
1123
1124   Raise_From_Signal_Handler (exception, msg);
1125 }
1126
1127 void
1128 __gnat_install_handler (void)
1129 {
1130   struct sigaction act;
1131
1132   /* Setup signal handler to map synchronous signals to appropriate
1133      exceptions.  Make sure that the handler isn't interrupted by another
1134      signal that might cause a scheduling event! */
1135
1136   act.sa_handler = __gnat_error_handler;
1137   act.sa_flags = SA_NODEFER + SA_RESTART;
1138   sigfillset (&act.sa_mask);
1139   sigemptyset (&act.sa_mask);
1140
1141   /* Do not install handlers if interrupt state is "System" */
1142   if (__gnat_get_interrupt_state (SIGABRT) != 's')
1143     sigaction (SIGABRT, &act, NULL);
1144   if (__gnat_get_interrupt_state (SIGFPE) != 's')
1145     sigaction (SIGFPE,  &act, NULL);
1146   if (__gnat_get_interrupt_state (SIGILL) != 's')
1147     sigaction (SIGILL,  &act, NULL);
1148   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1149     sigaction (SIGSEGV, &act, NULL);
1150   if (__gnat_get_interrupt_state (SIGBUS) != 's')
1151     sigaction (SIGBUS,  &act, NULL);
1152   if (__gnat_get_interrupt_state (SIGADAABORT) != 's')
1153     sigaction (SIGADAABORT,  &act, NULL);
1154
1155   __gnat_handler_installed = 1;
1156 }
1157
1158 void
1159 __gnat_initialize (void)
1160 {
1161 }
1162
1163 /*************************************************/
1164 /* __gnat_initialize (Solaris and SunOS Version) */
1165 /*************************************************/
1166
1167 #elif defined (sun) && defined (__SVR4) && !defined (__vxworks)
1168
1169 #include <signal.h>
1170 #include <siginfo.h>
1171
1172 static void __gnat_error_handler (int, siginfo_t *);
1173
1174 static void
1175 __gnat_error_handler (int sig, siginfo_t *sip)
1176 {
1177   struct Exception_Data *exception;
1178   static int recurse = 0;
1179   const char *msg;
1180
1181   /* If this was an explicit signal from a "kill", just resignal it.  */
1182   if (SI_FROMUSER (sip))
1183     {
1184       signal (sig, SIG_DFL);
1185       kill (getpid(), sig);
1186     }
1187
1188   /* Otherwise, treat it as something we handle.  */
1189   switch (sig)
1190     {
1191     case SIGSEGV:
1192       /* If the problem was permissions, this is a constraint error.
1193          Likewise if the failing address isn't maximally aligned or if
1194          we've recursed.
1195
1196          ??? Using a static variable here isn't task-safe, but it's
1197          much too hard to do anything else and we're just determining
1198          which exception to raise.  */
1199       if (sip->si_code == SEGV_ACCERR
1200           || (((long) sip->si_addr) & 3) != 0
1201           || recurse)
1202         {
1203           exception = &constraint_error;
1204           msg = "SIGSEGV";
1205         }
1206       else
1207         {
1208           /* See if the page before the faulting page is accessible.  Do that
1209              by trying to access it.  We'd like to simply try to access
1210              4096 + the faulting address, but it's not guaranteed to be
1211              the actual address, just to be on the same page.  */
1212           recurse++;
1213           ((volatile char *)
1214            ((long) sip->si_addr & - getpagesize ()))[getpagesize ()];
1215           exception = &storage_error;
1216           msg = "stack overflow (or erroneous memory access)";
1217         }
1218       break;
1219
1220     case SIGBUS:
1221       exception = &program_error;
1222       msg = "SIGBUS";
1223       break;
1224
1225     case SIGFPE:
1226       exception = &constraint_error;
1227       msg = "SIGFPE";
1228       break;
1229
1230     default:
1231       exception = &program_error;
1232       msg = "unhandled signal";
1233     }
1234
1235   recurse = 0;
1236
1237   Raise_From_Signal_Handler (exception, msg);
1238 }
1239
1240 void
1241 __gnat_install_handler (void)
1242 {
1243   struct sigaction act;
1244
1245   /* Set up signal handler to map synchronous signals to appropriate
1246      exceptions.  Make sure that the handler isn't interrupted by another
1247      signal that might cause a scheduling event! */
1248
1249   act.sa_handler = __gnat_error_handler;
1250   act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
1251   sigemptyset (&act.sa_mask);
1252
1253   /* Do not install handlers if interrupt state is "System" */
1254   if (__gnat_get_interrupt_state (SIGABRT) != 's')
1255     sigaction (SIGABRT, &act, NULL);
1256   if (__gnat_get_interrupt_state (SIGFPE) != 's')
1257     sigaction (SIGFPE,  &act, NULL);
1258   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1259     sigaction (SIGSEGV, &act, NULL);
1260   if (__gnat_get_interrupt_state (SIGBUS) != 's')
1261     sigaction (SIGBUS,  &act, NULL);
1262
1263   __gnat_handler_installed = 1;
1264 }
1265
1266 void
1267 __gnat_initialize (void)
1268 {
1269 }
1270
1271 /***********************************/
1272 /* __gnat_initialize (VMS Version) */
1273 /***********************************/
1274
1275 #elif defined (VMS)
1276
1277 /* The prehandler actually gets control first on a condition. It swaps the
1278    stack pointer and calls the handler (__gnat_error_handler). */
1279 extern long __gnat_error_prehandler (void);
1280
1281 extern char *__gnat_error_prehandler_stack;   /* Alternate signal stack */
1282
1283 /* Conditions that don't have an Ada exception counterpart must raise
1284    Non_Ada_Error.  Since this is defined in s-auxdec, it should only be
1285    referenced by user programs, not the compiler or tools. Hence the
1286    #ifdef IN_RTS. */
1287
1288 #ifdef IN_RTS
1289 #define Non_Ada_Error system__aux_dec__non_ada_error
1290 extern struct Exception_Data Non_Ada_Error;
1291
1292 #define Coded_Exception system__vms_exception_table__coded_exception
1293 extern struct Exception_Data *Coded_Exception (int);
1294 #endif
1295
1296 /* Define macro symbols for the VMS conditions that become Ada exceptions.
1297    Most of these are also defined in the header file ssdef.h which has not
1298    yet been converted to be recoginized by Gnu C. Some, which couldn't be
1299    located, are assigned names based on the DEC test suite tests which
1300    raise them. */
1301
1302 #define SS$_ACCVIO            12
1303 #define SS$_DEBUG           1132
1304 #define SS$_INTDIV          1156
1305 #define SS$_HPARITH         1284
1306 #define SS$_STKOVF          1364
1307 #define SS$_RESIGNAL        2328
1308 #define MTH$_FLOOVEMAT   1475268       /* Some ACVC_21 CXA tests */
1309 #define SS$_CE24VRU      3253636       /* Write to unopened file */
1310 #define SS$_C980VTE      3246436       /* AST requests time slice */
1311 #define CMA$_EXIT_THREAD 4227492
1312 #define CMA$_EXCCOPLOS   4228108
1313 #define CMA$_ALERTED     4227460
1314
1315 struct descriptor_s {unsigned short len, mbz; char *adr; };
1316
1317 long __gnat_error_handler (int *, void *);
1318
1319 long
1320 __gnat_error_handler (int *sigargs, void *mechargs)
1321 {
1322   struct Exception_Data *exception = 0;
1323   char *msg = "";
1324   char message[256];
1325   long prvhnd;
1326   struct descriptor_s msgdesc;
1327   int msg_flag = 0x000f; /* 1 bit for each of the four message parts */
1328   unsigned short outlen;
1329   char curr_icb[544];
1330   long curr_invo_handle;
1331   long *mstate;
1332
1333   /* Resignaled condtions aren't effected by by pragma Import_Exception */
1334
1335   switch (sigargs[1])
1336   {
1337
1338     case CMA$_EXIT_THREAD:
1339       return SS$_RESIGNAL;
1340
1341     case SS$_DEBUG: /* Gdb attach, resignal to merge activate gdbstub. */
1342       return SS$_RESIGNAL;
1343
1344     case 1409786: /* Nickerson bug #33 ??? */
1345       return SS$_RESIGNAL;
1346
1347     case 1381050: /* Nickerson bug #33 ??? */
1348       return SS$_RESIGNAL;
1349
1350     case 11829410: /* Resignalled as Use_Error for CE10VRC */
1351       return SS$_RESIGNAL;
1352
1353   }
1354
1355 #ifdef IN_RTS
1356   /* See if it's an imported exception. Mask off severity bits. */
1357   exception = Coded_Exception (sigargs[1] & 0xfffffff8);
1358   if (exception)
1359     {
1360       msgdesc.len = 256;
1361       msgdesc.mbz = 0;
1362       msgdesc.adr = message;
1363       SYS$GETMSG (sigargs[1], &outlen, &msgdesc, msg_flag, 0);
1364       message[outlen] = 0;
1365       msg = message;
1366
1367       exception->Name_Length = 19;
1368       /* The full name really should be get sys$getmsg returns. ??? */
1369       exception->Full_Name = "IMPORTED_EXCEPTION";
1370       exception->Import_Code = sigargs[1] & 0xfffffff8;
1371     }
1372 #endif
1373
1374   if (exception == 0)
1375     switch (sigargs[1])
1376       {
1377       case SS$_ACCVIO:
1378         if (sigargs[3] == 0)
1379           {
1380             exception = &constraint_error;
1381             msg = "access zero";
1382           }
1383         else
1384           {
1385             exception = &storage_error;
1386             msg = "stack overflow (or erroneous memory access)";
1387           }
1388         break;
1389
1390       case SS$_STKOVF:
1391         exception = &storage_error;
1392         msg = "stack overflow";
1393         break;
1394
1395       case SS$_INTDIV:
1396         exception = &constraint_error;
1397         msg = "division by zero";
1398         break;
1399
1400       case SS$_HPARITH:
1401 #ifndef IN_RTS
1402         return SS$_RESIGNAL; /* toplev.c handles for compiler */
1403 #else
1404         {
1405           exception = &constraint_error;
1406           msg = "arithmetic error";
1407         }
1408 #endif
1409         break;
1410
1411       case MTH$_FLOOVEMAT:
1412         exception = &constraint_error;
1413         msg = "floating overflow in math library";
1414         break;
1415
1416       case SS$_CE24VRU:
1417         exception = &constraint_error;
1418         msg = "";
1419         break;
1420
1421       case SS$_C980VTE:
1422         exception = &program_error;
1423         msg = "";
1424         break;
1425
1426       default:
1427 #ifndef IN_RTS
1428         exception = &program_error;
1429 #else
1430         /* User programs expect Non_Ada_Error to be raised, reference
1431            DEC Ada test CXCONDHAN. */
1432         exception = &Non_Ada_Error;
1433 #endif
1434         msgdesc.len = 256;
1435         msgdesc.mbz = 0;
1436         msgdesc.adr = message;
1437         SYS$GETMSG (sigargs[1], &outlen, &msgdesc, msg_flag, 0);
1438         message[outlen] = 0;
1439         msg = message;
1440         break;
1441       }
1442
1443   mstate = (long *) (*Get_Machine_State_Addr) ();
1444   if (mstate != 0)
1445     {
1446       LIB$GET_CURR_INVO_CONTEXT (&curr_icb);
1447       LIB$GET_PREV_INVO_CONTEXT (&curr_icb);
1448       LIB$GET_PREV_INVO_CONTEXT (&curr_icb);
1449       curr_invo_handle = LIB$GET_INVO_HANDLE (&curr_icb);
1450       *mstate = curr_invo_handle;
1451     }
1452   Raise_From_Signal_Handler (exception, msg);
1453 }
1454
1455 void
1456 __gnat_install_handler (void)
1457 {
1458   long prvhnd;
1459   char *c;
1460
1461   c = (char *) xmalloc (2049);
1462
1463   __gnat_error_prehandler_stack = &c[2048];
1464
1465   /* __gnat_error_prehandler is an assembly function.  */
1466   SYS$SETEXV (1, __gnat_error_prehandler, 3, &prvhnd);
1467   __gnat_handler_installed = 1;
1468 }
1469
1470 void
1471 __gnat_initialize(void)
1472 {
1473 }
1474
1475 /*************************************************/
1476 /* __gnat_initialize (FreeBSD version) */
1477 /*************************************************/
1478
1479 #elif defined (__FreeBSD__)
1480
1481 #include <signal.h>
1482 #include <unistd.h>
1483
1484 static void
1485 __gnat_error_handler (sig, code, sc)
1486      int sig;
1487      int code;
1488      struct sigcontext *sc;
1489 {
1490   struct Exception_Data *exception;
1491   char *msg;
1492
1493   switch (sig)
1494     {
1495     case SIGFPE:
1496       exception = &constraint_error;
1497       msg = "SIGFPE";
1498       break;
1499
1500     case SIGILL:
1501       exception = &constraint_error;
1502       msg = "SIGILL";
1503       break;
1504
1505     case SIGSEGV:
1506       exception = &storage_error;
1507       msg = "stack overflow or erroneous memory access";
1508       break;
1509
1510     case SIGBUS:
1511       exception = &constraint_error;
1512       msg = "SIGBUS";
1513       break;
1514
1515     default:
1516       exception = &program_error;
1517       msg = "unhandled signal";
1518     }
1519
1520   Raise_From_Signal_Handler (exception, msg);
1521 }
1522
1523 void
1524 __gnat_install_handler ()
1525 {
1526   struct sigaction act;
1527
1528   /* Set up signal handler to map synchronous signals to appropriate
1529      exceptions.  Make sure that the handler isn't interrupted by another
1530      signal that might cause a scheduling event! */
1531
1532   act.sa_handler = __gnat_error_handler;
1533   act.sa_flags = SA_NODEFER | SA_RESTART;
1534   (void) sigemptyset (&act.sa_mask);
1535
1536   (void) sigaction (SIGILL,  &act, NULL);
1537   (void) sigaction (SIGFPE,  &act, NULL);
1538   (void) sigaction (SIGSEGV, &act, NULL);
1539   (void) sigaction (SIGBUS,  &act, NULL);
1540 }
1541
1542 void __gnat_init_float ();
1543
1544 void
1545 __gnat_initialize ()
1546 {
1547    __gnat_install_handler ();
1548
1549    /* XXX - Initialize floating-point coprocessor. This call is
1550       needed because FreeBSD defaults to 64-bit precision instead
1551       of 80-bit precision?  We require the full precision for
1552       proper operation, given that we have set Max_Digits etc
1553       with this in mind */
1554    __gnat_init_float ();
1555 }
1556
1557 /***************************************/
1558 /* __gnat_initialize (VXWorks Version) */
1559 /***************************************/
1560
1561 #elif defined(__vxworks)
1562
1563 #include <signal.h>
1564 #include <taskLib.h>
1565 #include <intLib.h>
1566 #include <iv.h>
1567
1568 extern int __gnat_inum_to_ivec (int);
1569 static void __gnat_error_handler (int, int, struct sigcontext *);
1570 void __gnat_map_signal (int);
1571
1572 #ifndef __alpha_vxworks
1573
1574 /* getpid is used by s-parint.adb, but is not defined by VxWorks, except
1575    on Alpha VxWorks */
1576
1577 extern long getpid (void);
1578
1579 long
1580 getpid (void)
1581 {
1582   return taskIdSelf ();
1583 }
1584 #endif
1585
1586 /* This is needed by the GNAT run time to handle Vxworks interrupts */
1587 int
1588 __gnat_inum_to_ivec (int num)
1589 {
1590   return INUM_TO_IVEC (num);
1591 }
1592
1593 /* Exported to 5zintman.adb in order to handle different signal
1594    to exception mappings in different VxWorks versions */
1595 void
1596 __gnat_map_signal (int sig)
1597 {
1598   struct Exception_Data *exception;
1599   char *msg;
1600
1601   switch (sig)
1602     {
1603     case SIGFPE:
1604       exception = &constraint_error;
1605       msg = "SIGFPE";
1606       break;
1607     case SIGILL:
1608       exception = &constraint_error;
1609       msg = "SIGILL";
1610       break;
1611     case SIGSEGV:
1612       exception = &program_error;
1613       msg = "SIGSEGV";
1614       break;
1615     case SIGBUS:
1616 #ifdef VTHREADS
1617       exception = &storage_error;
1618       msg = "SIGBUS: possible stack overflow";
1619 #else
1620       exception = &program_error;
1621       msg = "SIGBUS";
1622 #endif
1623       break;
1624     default:
1625       exception = &program_error;
1626       msg = "unhandled signal";
1627     }
1628
1629   Raise_From_Signal_Handler (exception, msg);
1630 }
1631
1632 static void
1633 __gnat_error_handler (int sig, int code, struct sigcontext *sc)
1634 {
1635   sigset_t mask;
1636   int result;
1637
1638   /* VxWorks will always mask out the signal during the signal handler and
1639      will reenable it on a longjmp.  GNAT does not generate a longjmp to
1640      return from a signal handler so the signal will still be masked unless
1641      we unmask it. */
1642   sigprocmask (SIG_SETMASK, NULL, &mask);
1643   sigdelset (&mask, sig);
1644   sigprocmask (SIG_SETMASK, &mask, NULL);
1645
1646   /* VxWorks will suspend the task when it gets a hardware exception.  We
1647      take the liberty of resuming the task for the application. */
1648   if (taskIsSuspended (taskIdSelf ()) != 0)
1649     taskResume (taskIdSelf ());
1650
1651   __gnat_map_signal (sig);
1652
1653 }
1654
1655 void
1656 __gnat_install_handler (void)
1657 {
1658   struct sigaction act;
1659
1660   /* Setup signal handler to map synchronous signals to appropriate
1661      exceptions.  Make sure that the handler isn't interrupted by another
1662      signal that might cause a scheduling event! */
1663
1664   act.sa_handler = __gnat_error_handler;
1665   act.sa_flags = SA_SIGINFO | SA_ONSTACK;
1666   sigemptyset (&act.sa_mask);
1667
1668   /* For VxWorks, install all signal handlers, since pragma Interrupt_State
1669      applies to vectored hardware interrupts, not signals */
1670   sigaction (SIGFPE,  &act, NULL);
1671   sigaction (SIGILL,  &act, NULL);
1672   sigaction (SIGSEGV, &act, NULL);
1673   sigaction (SIGBUS,  &act, NULL);
1674
1675   __gnat_handler_installed = 1;
1676 }
1677
1678 #define HAVE_GNAT_INIT_FLOAT
1679
1680 void
1681 __gnat_init_float (void)
1682 {
1683   /* Disable overflow/underflow exceptions on the PPC processor, this is needed
1684      to get correct Ada semantic.  */
1685 #if defined (_ARCH_PPC) && !defined (_SOFT_FLOAT)
1686   asm ("mtfsb0 25");
1687   asm ("mtfsb0 26");
1688 #endif
1689
1690   /* Similarily for sparc64. Achieved by masking bits in the Trap Enable Mask
1691      field of the Floating-point Status Register (see the Sparc Architecture
1692      Manual Version 9, p 48).  */
1693 #if defined (sparc64)
1694
1695 #define FSR_TEM_NVM (1 << 27)  /* Invalid operand  */
1696 #define FSR_TEM_OFM (1 << 26)  /* Overflow  */
1697 #define FSR_TEM_UFM (1 << 25)  /* Underflow  */
1698 #define FSR_TEM_DZM (1 << 24)  /* Division by Zero  */
1699 #define FSR_TEM_NXM (1 << 23)  /* Inexact result  */
1700   {
1701     unsigned int fsr;
1702
1703     __asm__("st %%fsr, %0" : "=m" (fsr));
1704     fsr &= ~(FSR_TEM_OFM | FSR_TEM_UFM);
1705     __asm__("ld %0, %%fsr" : : "m" (fsr));
1706   }
1707 #endif
1708 }
1709
1710 void
1711 __gnat_initialize (void)
1712 {
1713   __gnat_init_float ();
1714
1715   /* Assume an environment task stack size of 20kB.
1716
1717      Using a constant is necessary because we do not want each Ada application
1718      to depend on the optional taskShow library,
1719      which is required to get the actual stack information.
1720
1721      The consequence of this is that with -fstack-check
1722      the environment task must have an actual stack size
1723      of at least 20kB and the usable size will be about 14kB.
1724   */
1725
1726   __gnat_set_stack_size (14336);
1727   /* Allow some head room for the stack checking code, and for
1728      stack space consumed during initialization */
1729 }
1730
1731 /********************************/
1732 /* __gnat_initialize for NetBSD */
1733 /********************************/
1734
1735 #elif defined(__NetBSD__)
1736
1737 #include <signal.h>
1738 #include <unistd.h>
1739
1740 static void
1741 __gnat_error_handler (int sig)
1742 {
1743   struct Exception_Data *exception;
1744   const char *msg;
1745
1746   switch(sig)
1747   {
1748     case SIGFPE:
1749       exception = &constraint_error;
1750       msg = "SIGFPE";
1751       break;
1752     case SIGILL:
1753       exception = &constraint_error;
1754       msg = "SIGILL";
1755       break;
1756     case SIGSEGV:
1757       exception = &storage_error;
1758       msg = "stack overflow or erroneous memory access";
1759       break;
1760     case SIGBUS:
1761       exception = &constraint_error;
1762       msg = "SIGBUS";
1763       break;
1764     default:
1765       exception = &program_error;
1766       msg = "unhandled signal";
1767     }
1768
1769     Raise_From_Signal_Handler(exception, msg);
1770 }
1771
1772 void
1773 __gnat_install_handler(void)
1774 {
1775   struct sigaction act;
1776
1777   act.sa_handler = __gnat_error_handler;
1778   act.sa_flags = SA_NODEFER | SA_RESTART;
1779   sigemptyset (&act.sa_mask);
1780
1781   /* Do not install handlers if interrupt state is "System" */
1782   if (__gnat_get_interrupt_state (SIGFPE) != 's')
1783     sigaction (SIGFPE,  &act, NULL);
1784   if (__gnat_get_interrupt_state (SIGILL) != 's')
1785     sigaction (SIGILL,  &act, NULL);
1786   if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1787     sigaction (SIGSEGV, &act, NULL);
1788   if (__gnat_get_interrupt_state (SIGBUS) != 's')
1789     sigaction (SIGBUS,  &act, NULL);
1790
1791   __gnat_handler_installed = 1;
1792 }
1793
1794 void
1795 __gnat_initialize (void)
1796 {
1797   __gnat_install_handler ();
1798   __gnat_init_float ();
1799 }
1800
1801 #else
1802
1803 /* For all other versions of GNAT, the initialize routine and handler
1804    installation do nothing */
1805
1806 /***************************************/
1807 /* __gnat_initialize (Default Version) */
1808 /***************************************/
1809
1810 void
1811 __gnat_initialize (void)
1812 {
1813 }
1814
1815 /********************************************/
1816 /* __gnat_install_handler (Default Version) */
1817 /********************************************/
1818
1819 void
1820 __gnat_install_handler (void)
1821 {
1822   __gnat_handler_installed = 1;
1823 }
1824
1825 #endif
1826
1827 /*********************/
1828 /* __gnat_init_float */
1829 /*********************/
1830
1831 /* This routine is called as each process thread is created, for possible
1832    initialization of the FP processor. This version is used under INTERIX,
1833    WIN32 and could be used under OS/2 */
1834
1835 #if defined (_WIN32) || defined (__INTERIX) || defined (__EMX__) \
1836   || defined (__Lynx__) || defined(__NetBSD__) || defined(__FreeBSD__)
1837
1838 #define HAVE_GNAT_INIT_FLOAT
1839
1840 void
1841 __gnat_init_float (void)
1842 {
1843 #if defined (__i386__) || defined (i386)
1844
1845   /* This is used to properly initialize the FPU on an x86 for each
1846      process thread. */
1847
1848   asm ("finit");
1849
1850 #endif  /* Defined __i386__ */
1851 }
1852 #endif
1853
1854 #ifndef HAVE_GNAT_INIT_FLOAT
1855
1856 /* All targets without a specific __gnat_init_float will use an empty one */
1857 void
1858 __gnat_init_float (void)
1859 {
1860 }
1861 #endif