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