gcc/ada/init.c

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