* config/rs6000/rs6000.md: Document why a pattern is not
[official-gcc.git] / gcc / ada / init.c
blobefc1a25fc2a47c0f706466b8e8a671a09c9d34c7
1 /****************************************************************************
2 * *
3 * GNAT COMPILER COMPONENTS *
4 * *
5 * I N I T *
6 * *
7 * C Implementation File *
8 * *
9 * Copyright (C) 1992-2004 Free Software Foundation, Inc. *
10 * *
11 * GNAT is free software; you can redistribute it and/or modify it under *
12 * terms of the GNU General Public License as published by the Free Soft- *
13 * ware Foundation; either version 2, or (at your option) any later ver- *
14 * sion. GNAT is distributed in the hope that it will be useful, but WITH- *
15 * OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
16 * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License *
17 * for more details. You should have received a copy of the GNU General *
18 * Public License distributed with GNAT; see file COPYING. If not, write *
19 * to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, *
20 * MA 02111-1307, USA. *
21 * *
22 * As a special exception, if you link this file with other files to *
23 * produce an executable, this file does not by itself cause the resulting *
24 * executable to be covered by the GNU General Public License. This except- *
25 * ion does not however invalidate any other reasons why the executable *
26 * file might be covered by the GNU Public License. *
27 * *
28 * GNAT was originally developed by the GNAT team at New York University. *
29 * Extensive contributions were provided by Ada Core Technologies Inc. *
30 * *
31 ****************************************************************************/
33 /* This unit contains initialization circuits that are system dependent. A
34 major part of the functionality involved involves stack overflow checking.
35 The GCC backend generates probe instructions to test for stack overflow.
36 For details on the exact approach used to generate these probes, see the
37 "Using and Porting GCC" manual, in particular the "Stack Checking" section
38 and the subsection "Specifying How Stack Checking is Done". The handlers
39 installed by this file are used to handle resulting signals that come
40 from these probes failing (i.e. touching protected pages) */
42 /* This file should be kept synchronized with 2sinit.ads, 2sinit.adb, and
43 5zinit.adb. All these files implement the required functionality for
44 different targets. */
46 /* The following include is here to meet the published VxWorks requirement
47 that the __vxworks header appear before any other include. */
48 #ifdef __vxworks
49 #include "vxWorks.h"
50 #endif
52 #ifdef IN_RTS
53 #include "tconfig.h"
54 #include "tsystem.h"
55 #include <sys/stat.h>
57 /* We don't have libiberty, so us malloc. */
58 #define xmalloc(S) malloc (S)
59 #else
60 #include "config.h"
61 #include "system.h"
62 #endif
64 #include "adaint.h"
65 #include "raise.h"
67 extern void __gnat_raise_program_error (const char *, int);
69 /* Addresses of exception data blocks for predefined exceptions. */
70 extern struct Exception_Data constraint_error;
71 extern struct Exception_Data numeric_error;
72 extern struct Exception_Data program_error;
73 extern struct Exception_Data storage_error;
74 extern struct Exception_Data tasking_error;
75 extern struct Exception_Data _abort_signal;
77 #define Lock_Task system__soft_links__lock_task
78 extern void (*Lock_Task) (void);
80 #define Unlock_Task system__soft_links__unlock_task
81 extern void (*Unlock_Task) (void);
83 #define Get_Machine_State_Addr \
84 system__soft_links__get_machine_state_addr
85 extern struct Machine_State *(*Get_Machine_State_Addr) (void);
87 #define Check_Abort_Status \
88 system__soft_links__check_abort_status
89 extern int (*Check_Abort_Status) (void);
91 #define Raise_From_Signal_Handler \
92 ada__exceptions__raise_from_signal_handler
93 extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *);
95 #define Propagate_Signal_Exception \
96 __gnat_propagate_sig_exc
97 extern void Propagate_Signal_Exception (struct Machine_State *,
98 struct Exception_Data *,
99 const char *);
101 /* Copies of global values computed by the binder */
102 int __gl_main_priority = -1;
103 int __gl_time_slice_val = -1;
104 char __gl_wc_encoding = 'n';
105 char __gl_locking_policy = ' ';
106 char __gl_queuing_policy = ' ';
107 char __gl_task_dispatching_policy = ' ';
108 char *__gl_restrictions = 0;
109 char *__gl_interrupt_states = 0;
110 int __gl_num_interrupt_states = 0;
111 int __gl_unreserve_all_interrupts = 0;
112 int __gl_exception_tracebacks = 0;
113 int __gl_zero_cost_exceptions = 0;
115 /* Indication of whether synchronous signal handler has already been
116 installed by a previous call to adainit */
117 int __gnat_handler_installed = 0;
119 /* HAVE_GNAT_INIT_FLOAT must be set on every targets where a __gnat_init_float
120 is defined. If this is not set them a void implementation will be defined
121 at the end of this unit. */
122 #undef HAVE_GNAT_INIT_FLOAT
124 /******************************/
125 /* __gnat_get_interrupt_state */
126 /******************************/
128 char __gnat_get_interrupt_state (int);
130 /* This routine is called from the runtime as needed to determine the state
131 of an interrupt, as set by an Interrupt_State pragma appearing anywhere
132 in the current partition. The input argument is the interrupt number,
133 and the result is one of the following:
135 'n' this interrupt not set by any Interrupt_State pragma
136 'u' Interrupt_State pragma set state to User
137 'r' Interrupt_State pragma set state to Runtime
138 's' Interrupt_State pragma set state to System */
140 char
141 __gnat_get_interrupt_state (int intrup)
143 if (intrup >= __gl_num_interrupt_states)
144 return 'n';
145 else
146 return __gl_interrupt_states [intrup];
149 /**********************/
150 /* __gnat_set_globals */
151 /**********************/
153 /* This routine is called from the binder generated main program. It copies
154 the values for global quantities computed by the binder into the following
155 global locations. The reason that we go through this copy, rather than just
156 define the global locations in the binder generated file, is that they are
157 referenced from the runtime, which may be in a shared library, and the
158 binder file is not in the shared library. Global references across library
159 boundaries like this are not handled correctly in all systems. */
161 /* For detailed description of the parameters to this routine, see the
162 section titled Run-Time Globals in package Bindgen (bindgen.adb) */
164 void
165 __gnat_set_globals (int main_priority,
166 int time_slice_val,
167 char wc_encoding,
168 char locking_policy,
169 char queuing_policy,
170 char task_dispatching_policy,
171 char *restrictions,
172 char *interrupt_states,
173 int num_interrupt_states,
174 int unreserve_all_interrupts,
175 int exception_tracebacks,
176 int zero_cost_exceptions)
178 static int already_called = 0;
180 /* If this procedure has been already called once, check that the
181 arguments in this call are consistent with the ones in the previous
182 calls. Otherwise, raise a Program_Error exception.
184 We do not check for consistency of the wide character encoding
185 method. This default affects only Wide_Text_IO where no explicit
186 coding method is given, and there is no particular reason to let
187 this default be affected by the source representation of a library
188 in any case.
190 We do not check either for the consistency of exception tracebacks,
191 because exception tracebacks are not normally set in Stand-Alone
192 libraries. If a library or the main program set the exception
193 tracebacks, then they are never reset afterwards (see below).
195 The value of main_priority is meaningful only when we are invoked
196 from the main program elaboration routine of an Ada application.
197 Checking the consistency of this parameter should therefore not be
198 done. Since it is assured that the main program elaboration will
199 always invoke this procedure before any library elaboration
200 routine, only the value of main_priority during the first call
201 should be taken into account and all the subsequent ones should be
202 ignored. Note that the case where the main program is not written
203 in Ada is also properly handled, since the default value will then
204 be used for this parameter.
206 For identical reasons, the consistency of time_slice_val should not
207 be checked. */
209 if (already_called)
211 if (__gl_locking_policy != locking_policy
212 || __gl_queuing_policy != queuing_policy
213 || __gl_task_dispatching_policy != task_dispatching_policy
214 || __gl_unreserve_all_interrupts != unreserve_all_interrupts
215 || __gl_zero_cost_exceptions != zero_cost_exceptions)
216 __gnat_raise_program_error (__FILE__, __LINE__);
218 /* If either a library or the main program set the exception traceback
219 flag, it is never reset later */
221 if (exception_tracebacks != 0)
222 __gl_exception_tracebacks = exception_tracebacks;
224 return;
226 already_called = 1;
228 __gl_main_priority = main_priority;
229 __gl_time_slice_val = time_slice_val;
230 __gl_wc_encoding = wc_encoding;
231 __gl_locking_policy = locking_policy;
232 __gl_queuing_policy = queuing_policy;
233 __gl_restrictions = restrictions;
234 __gl_interrupt_states = interrupt_states;
235 __gl_num_interrupt_states = num_interrupt_states;
236 __gl_task_dispatching_policy = task_dispatching_policy;
237 __gl_unreserve_all_interrupts = unreserve_all_interrupts;
238 __gl_exception_tracebacks = exception_tracebacks;
240 /* ??? __gl_zero_cost_exceptions is new in 3.15 and is referenced from
241 a-except.adb, which is also part of the compiler sources. Since the
242 compiler is built with an older release of GNAT, the call generated by
243 the old binder to this function does not provide any value for the
244 corresponding argument, so the global has to be initialized in some
245 reasonable other way. This could be removed as soon as the next major
246 release is out. */
248 #ifdef IN_RTS
249 __gl_zero_cost_exceptions = zero_cost_exceptions;
250 #else
251 __gl_zero_cost_exceptions = 0;
252 /* We never build the compiler to run in ZCX mode currently anyway. */
253 #endif
256 /*********************/
257 /* __gnat_initialize */
258 /*********************/
260 /* __gnat_initialize is called at the start of execution of an Ada program
261 (the call is generated by the binder). The standard routine does nothing
262 at all; the intention is that this be replaced by system specific
263 code where initialization is required. */
265 /***********************************/
266 /* __gnat_initialize (AIX Version) */
267 /***********************************/
269 #if defined (_AIX)
271 #include <signal.h>
272 #include <sys/time.h>
274 /* Some versions of AIX don't define SA_NODEFER. */
276 #ifndef SA_NODEFER
277 #define SA_NODEFER 0
278 #endif /* SA_NODEFER */
280 /* Versions of AIX before 4.3 don't have nanosleep but provide
281 nsleep instead. */
283 #ifndef _AIXVERSION_430
285 extern int nanosleep (struct timestruc_t *, struct timestruc_t *);
288 nanosleep (struct timestruc_t *Rqtp, struct timestruc_t *Rmtp)
290 return nsleep (Rqtp, Rmtp);
293 #endif /* _AIXVERSION_430 */
295 static void __gnat_error_handler (int);
297 static void
298 __gnat_error_handler (int sig)
300 struct Exception_Data *exception;
301 const char *msg;
303 switch (sig)
305 case SIGSEGV:
306 /* FIXME: we need to detect the case of a *real* SIGSEGV */
307 exception = &storage_error;
308 msg = "stack overflow or erroneous memory access";
309 break;
311 case SIGBUS:
312 exception = &constraint_error;
313 msg = "SIGBUS";
314 break;
316 case SIGFPE:
317 exception = &constraint_error;
318 msg = "SIGFPE";
319 break;
321 default:
322 exception = &program_error;
323 msg = "unhandled signal";
326 Raise_From_Signal_Handler (exception, msg);
329 void
330 __gnat_install_handler (void)
332 struct sigaction act;
334 /* Set up signal handler to map synchronous signals to appropriate
335 exceptions. Make sure that the handler isn't interrupted by another
336 signal that might cause a scheduling event! */
338 act.sa_handler = __gnat_error_handler;
339 act.sa_flags = SA_NODEFER | SA_RESTART;
340 sigemptyset (&act.sa_mask);
342 /* Do not install handlers if interrupt state is "System" */
343 if (__gnat_get_interrupt_state (SIGABRT) != 's')
344 sigaction (SIGABRT, &act, NULL);
345 if (__gnat_get_interrupt_state (SIGFPE) != 's')
346 sigaction (SIGFPE, &act, NULL);
347 if (__gnat_get_interrupt_state (SIGILL) != 's')
348 sigaction (SIGILL, &act, NULL);
349 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
350 sigaction (SIGSEGV, &act, NULL);
351 if (__gnat_get_interrupt_state (SIGBUS) != 's')
352 sigaction (SIGBUS, &act, NULL);
354 __gnat_handler_installed = 1;
357 void
358 __gnat_initialize (void)
362 /***************************************/
363 /* __gnat_initialize (RTEMS version) */
364 /***************************************/
366 #elif defined(__rtems__)
368 extern void __gnat_install_handler (void);
370 /* For RTEMS, each bsp will provide a custom __gnat_install_handler (). */
372 void
373 __gnat_initialize (void)
375 __gnat_install_handler ();
378 /****************************************/
379 /* __gnat_initialize (Dec Unix Version) */
380 /****************************************/
382 #elif defined(__alpha__) && defined(__osf__) && ! defined(__alpha_vxworks)
384 /* Note: it seems that __osf__ is defined for the Alpha VXWorks case. Not
385 clear that this is reasonable, but in any case we have to be sure to
386 exclude this case in the above test. */
388 #include <signal.h>
389 #include <setjmp.h>
390 #include <sys/siginfo.h>
392 static void __gnat_error_handler (int, siginfo_t *, struct sigcontext *);
393 extern char *__gnat_get_code_loc (struct sigcontext *);
394 extern void __gnat_enter_handler (struct sigcontext *, char *);
395 extern size_t __gnat_machine_state_length (void);
397 extern long exc_lookup_gp (char *);
398 extern void exc_resume (struct sigcontext *);
400 static void
401 __gnat_error_handler (int sig, siginfo_t *sip, struct sigcontext *context)
403 struct Exception_Data *exception;
404 static int recurse = 0;
405 struct sigcontext *mstate;
406 const char *msg;
407 jmp_buf handler_jmpbuf;
409 /* If this was an explicit signal from a "kill", just resignal it. */
410 if (SI_FROMUSER (sip))
412 signal (sig, SIG_DFL);
413 kill (getpid(), sig);
416 /* Otherwise, treat it as something we handle. */
418 /* We are now going to raise the exception corresponding to the signal we
419 caught, which may eventually end up resuming the application code if the
420 exception is handled.
422 When the exception is handled, merely arranging for the *exception*
423 handler's context (stack pointer, program counter, other registers, ...)
424 to be installed is *not* enough to let the kernel think we've left the
425 *signal* handler. This has annoying implications if an alternate stack
426 has been setup for this *signal* handler, because the kernel thinks we
427 are still running on that alternate stack even after the jump, which
428 causes trouble at least as soon as another signal is raised.
430 We deal with this by forcing a "local" longjmp within the signal handler
431 below, forcing the "on alternate stack" indication to be reset (kernel
432 wise) on the way. If no alternate stack has been setup, this should be a
433 neutral operation. Otherwise, we will be in a delicate situation for a
434 short while because we are going to run the exception propagation code
435 within the alternate stack area (that is, with the stack pointer inside
436 the alternate stack bounds), but with the corresponding flag off from the
437 kernel's standpoint. We expect this to be ok as long as the propagation
438 code does not trigger a signal itself, which is expected.
440 ??? A better approach would be to at least delay this operation until the
441 last second, that is, until just before we jump to the exception handler,
442 if any. */
444 if (setjmp (handler_jmpbuf) == 0)
446 #define JB_ONSIGSTK 0
448 /* Arrange for the "on alternate stack" flag to be reset. See the
449 comments around "jmp_buf offsets" in /usr/include/setjmp.h. */
450 handler_jmpbuf [JB_ONSIGSTK] = 0;
451 longjmp (handler_jmpbuf, 1);
454 switch (sig)
456 case SIGSEGV:
457 /* If the problem was permissions, this is a constraint error.
458 Likewise if the failing address isn't maximally aligned or if
459 we've recursed.
461 ??? Using a static variable here isn't task-safe, but it's
462 much too hard to do anything else and we're just determining
463 which exception to raise. */
464 if (sip->si_code == SEGV_ACCERR
465 || (((long) sip->si_addr) & 3) != 0
466 || recurse)
468 exception = &constraint_error;
469 msg = "SIGSEGV";
471 else
473 /* See if the page before the faulting page is accessible. Do that
474 by trying to access it. We'd like to simply try to access
475 4096 + the faulting address, but it's not guaranteed to be
476 the actual address, just to be on the same page. */
477 recurse++;
478 ((volatile char *)
479 ((long) sip->si_addr & - getpagesize ()))[getpagesize ()];
480 msg = "stack overflow (or erroneous memory access)";
481 exception = &storage_error;
483 break;
485 case SIGBUS:
486 exception = &program_error;
487 msg = "SIGBUS";
488 break;
490 case SIGFPE:
491 exception = &constraint_error;
492 msg = "SIGFPE";
493 break;
495 default:
496 exception = &program_error;
497 msg = "unhandled signal";
500 recurse = 0;
501 mstate = (struct sigcontext *) (*Get_Machine_State_Addr) ();
502 if (mstate != 0)
503 *mstate = *context;
505 Raise_From_Signal_Handler (exception, (char *) msg);
508 void
509 __gnat_install_handler (void)
511 struct sigaction act;
513 /* stack-checking on this platform is performed by the back-end and conforms
514 to what the ABI *mandates* (DEC OSF/1 Calling standard for AXP systems,
515 chapter 6: Stack Limits in Multihtreaded Execution Environments). This
516 does not include a "stack reserve" region, so nothing guarantees that
517 enough room remains on the current stack to propagate an exception when
518 a stack-overflow is signaled. We deal with this by requesting the use of
519 an alternate stack region for signal handlers.
521 ??? The actual use of this alternate region depends on the act.sa_flags
522 including SA_ONSTACK below. Care should be taken to update s-intman if
523 we want this to happen for tasks also. */
525 static char sig_stack [8*1024];
526 /* 8K is a mininum to be able to propagate an exception using the GCC/ZCX
527 scheme. */
529 struct sigaltstack ss;
531 ss.ss_sp = (void *) sig_stack;
532 ss.ss_size = sizeof (sig_stack);
533 ss.ss_flags = 0;
535 sigaltstack (&ss, 0);
537 /* Setup signal handler to map synchronous signals to appropriate
538 exceptions. Make sure that the handler isn't interrupted by another
539 signal that might cause a scheduling event! */
541 act.sa_handler = (void (*) (int)) __gnat_error_handler;
542 act.sa_flags = SA_ONSTACK | SA_RESTART | SA_NODEFER | SA_SIGINFO;
543 sigemptyset (&act.sa_mask);
545 /* Do not install handlers if interrupt state is "System" */
546 if (__gnat_get_interrupt_state (SIGABRT) != 's')
547 sigaction (SIGABRT, &act, NULL);
548 if (__gnat_get_interrupt_state (SIGFPE) != 's')
549 sigaction (SIGFPE, &act, NULL);
550 if (__gnat_get_interrupt_state (SIGILL) != 's')
551 sigaction (SIGILL, &act, NULL);
552 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
553 sigaction (SIGSEGV, &act, NULL);
554 if (__gnat_get_interrupt_state (SIGBUS) != 's')
555 sigaction (SIGBUS, &act, NULL);
557 __gnat_handler_installed = 1;
560 void
561 __gnat_initialize (void)
565 /* Routines called by 5amastop.adb. */
567 #define SC_GP 29
569 char *
570 __gnat_get_code_loc (struct sigcontext *context)
572 return (char *) context->sc_pc;
575 void
576 __gnat_enter_handler ( struct sigcontext *context, char *pc)
578 context->sc_pc = (long) pc;
579 context->sc_regs[SC_GP] = exc_lookup_gp (pc);
580 exc_resume (context);
583 size_t
584 __gnat_machine_state_length (void)
586 return sizeof (struct sigcontext);
589 /************************************/
590 /* __gnat_initialize (HPUX Version) */
591 /************************************/
593 #elif defined (hpux)
595 #include <signal.h>
597 static void __gnat_error_handler (int);
599 static void
600 __gnat_error_handler (int sig)
602 struct Exception_Data *exception;
603 char *msg;
605 switch (sig)
607 case SIGSEGV:
608 /* FIXME: we need to detect the case of a *real* SIGSEGV */
609 exception = &storage_error;
610 msg = "stack overflow or erroneous memory access";
611 break;
613 case SIGBUS:
614 exception = &constraint_error;
615 msg = "SIGBUS";
616 break;
618 case SIGFPE:
619 exception = &constraint_error;
620 msg = "SIGFPE";
621 break;
623 default:
624 exception = &program_error;
625 msg = "unhandled signal";
628 Raise_From_Signal_Handler (exception, msg);
631 void
632 __gnat_install_handler (void)
634 struct sigaction act;
636 /* Set up signal handler to map synchronous signals to appropriate
637 exceptions. Make sure that the handler isn't interrupted by another
638 signal that might cause a scheduling event! Also setup an alternate
639 stack region for the handler execution so that stack overflows can be
640 handled properly, avoiding a SEGV generation from stack usage by the
641 handler itself. */
643 static char handler_stack[SIGSTKSZ*2];
644 /* SIGSTKSZ appeared to be "short" for the needs in some contexts
645 (e.g. experiments with GCC ZCX exceptions). */
647 stack_t stack;
649 stack.ss_sp = handler_stack;
650 stack.ss_size = sizeof (handler_stack);
651 stack.ss_flags = 0;
653 sigaltstack (&stack, NULL);
655 act.sa_handler = __gnat_error_handler;
656 act.sa_flags = SA_NODEFER | SA_RESTART | SA_ONSTACK;
657 sigemptyset (&act.sa_mask);
659 /* Do not install handlers if interrupt state is "System" */
660 if (__gnat_get_interrupt_state (SIGABRT) != 's')
661 sigaction (SIGABRT, &act, NULL);
662 if (__gnat_get_interrupt_state (SIGFPE) != 's')
663 sigaction (SIGFPE, &act, NULL);
664 if (__gnat_get_interrupt_state (SIGILL) != 's')
665 sigaction (SIGILL, &act, NULL);
666 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
667 sigaction (SIGSEGV, &act, NULL);
668 if (__gnat_get_interrupt_state (SIGBUS) != 's')
669 sigaction (SIGBUS, &act, NULL);
671 __gnat_handler_installed = 1;
674 void
675 __gnat_initialize (void)
679 /*****************************************/
680 /* __gnat_initialize (GNU/Linux Version) */
681 /*****************************************/
683 #elif defined (linux) && defined (i386) && !defined (__RT__)
685 #include <signal.h>
686 #include <asm/sigcontext.h>
688 /* GNU/Linux, which uses glibc, does not define NULL in included
689 header files */
691 #if !defined (NULL)
692 #define NULL ((void *) 0)
693 #endif
695 struct Machine_State
697 unsigned long eip;
698 unsigned long ebx;
699 unsigned long esp;
700 unsigned long ebp;
701 unsigned long esi;
702 unsigned long edi;
705 static void __gnat_error_handler (int);
707 static void
708 __gnat_error_handler (int sig)
710 struct Exception_Data *exception;
711 const char *msg;
712 static int recurse = 0;
714 struct sigcontext *info
715 = (struct sigcontext *) (((char *) &sig) + sizeof (int));
717 /* The Linux kernel does not document how to get the machine state in a
718 signal handler, but in fact the necessary data is in a sigcontext_struct
719 value that is on the stack immediately above the signal number
720 parameter, and the above messing accesses this value on the stack. */
722 struct Machine_State *mstate;
724 switch (sig)
726 case SIGSEGV:
727 /* If the problem was permissions, this is a constraint error.
728 Likewise if the failing address isn't maximally aligned or if
729 we've recursed.
731 ??? Using a static variable here isn't task-safe, but it's
732 much too hard to do anything else and we're just determining
733 which exception to raise. */
734 if (recurse)
736 exception = &constraint_error;
737 msg = "SIGSEGV";
739 else
741 /* Here we would like a discrimination test to see whether the
742 page before the faulting address is accessible. Unfortunately
743 Linux seems to have no way of giving us the faulting address.
745 In versions of a-init.c before 1.95, we had a test of the page
746 before the stack pointer using:
748 recurse++;
749 ((volatile char *)
750 ((long) info->esp_at_signal & - getpagesize ()))[getpagesize ()];
752 but that's wrong, since it tests the stack pointer location, and
753 the current stack probe code does not move the stack pointer
754 until all probes succeed.
756 For now we simply do not attempt any discrimination at all. Note
757 that this is quite acceptable, since a "real" SIGSEGV can only
758 occur as the result of an erroneous program */
760 msg = "stack overflow (or erroneous memory access)";
761 exception = &storage_error;
763 break;
765 case SIGBUS:
766 exception = &constraint_error;
767 msg = "SIGBUS";
768 break;
770 case SIGFPE:
771 exception = &constraint_error;
772 msg = "SIGFPE";
773 break;
775 default:
776 exception = &program_error;
777 msg = "unhandled signal";
780 mstate = (*Get_Machine_State_Addr) ();
781 if (mstate)
783 mstate->eip = info->eip;
784 mstate->ebx = info->ebx;
785 mstate->esp = info->esp_at_signal;
786 mstate->ebp = info->ebp;
787 mstate->esi = info->esi;
788 mstate->edi = info->edi;
791 recurse = 0;
792 Raise_From_Signal_Handler (exception, msg);
795 void
796 __gnat_install_handler (void)
798 struct sigaction act;
800 /* Set up signal handler to map synchronous signals to appropriate
801 exceptions. Make sure that the handler isn't interrupted by another
802 signal that might cause a scheduling event! */
804 act.sa_handler = __gnat_error_handler;
805 act.sa_flags = SA_NODEFER | SA_RESTART;
806 sigemptyset (&act.sa_mask);
808 /* Do not install handlers if interrupt state is "System" */
809 if (__gnat_get_interrupt_state (SIGABRT) != 's')
810 sigaction (SIGABRT, &act, NULL);
811 if (__gnat_get_interrupt_state (SIGFPE) != 's')
812 sigaction (SIGFPE, &act, NULL);
813 if (__gnat_get_interrupt_state (SIGILL) != 's')
814 sigaction (SIGILL, &act, NULL);
815 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
816 sigaction (SIGSEGV, &act, NULL);
817 if (__gnat_get_interrupt_state (SIGBUS) != 's')
818 sigaction (SIGBUS, &act, NULL);
820 __gnat_handler_installed = 1;
823 void
824 __gnat_initialize (void)
828 /******************************************/
829 /* __gnat_initialize (NT-mingw32 Version) */
830 /******************************************/
832 #elif defined (__MINGW32__)
833 #include <windows.h>
835 static LONG WINAPI __gnat_error_handler (PEXCEPTION_POINTERS);
837 /* __gnat_initialize (mingw32). */
839 static LONG WINAPI
840 __gnat_error_handler (PEXCEPTION_POINTERS info)
842 static int recurse;
843 struct Exception_Data *exception;
844 const char *msg;
846 switch (info->ExceptionRecord->ExceptionCode)
848 case EXCEPTION_ACCESS_VIOLATION:
849 /* If the failing address isn't maximally-aligned or if we've
850 recursed, this is a program error. */
851 if ((info->ExceptionRecord->ExceptionInformation[1] & 3) != 0
852 || recurse)
854 exception = &program_error;
855 msg = "EXCEPTION_ACCESS_VIOLATION";
857 else
859 /* See if the page before the faulting page is accessible. Do that
860 by trying to access it. */
861 recurse++;
862 * ((volatile char *) (info->ExceptionRecord->ExceptionInformation[1]
863 + 4096));
864 exception = &storage_error;
865 msg = "stack overflow (or erroneous memory access)";
867 break;
869 case EXCEPTION_ARRAY_BOUNDS_EXCEEDED:
870 exception = &constraint_error;
871 msg = "EXCEPTION_ARRAY_BOUNDS_EXCEEDED";
872 break;
874 case EXCEPTION_DATATYPE_MISALIGNMENT:
875 exception = &constraint_error;
876 msg = "EXCEPTION_DATATYPE_MISALIGNMENT";
877 break;
879 case EXCEPTION_FLT_DENORMAL_OPERAND:
880 exception = &constraint_error;
881 msg = "EXCEPTION_FLT_DENORMAL_OPERAND";
882 break;
884 case EXCEPTION_FLT_DIVIDE_BY_ZERO:
885 exception = &constraint_error;
886 msg = "EXCEPTION_FLT_DENORMAL_OPERAND";
887 break;
889 case EXCEPTION_FLT_INVALID_OPERATION:
890 exception = &constraint_error;
891 msg = "EXCEPTION_FLT_INVALID_OPERATION";
892 break;
894 case EXCEPTION_FLT_OVERFLOW:
895 exception = &constraint_error;
896 msg = "EXCEPTION_FLT_OVERFLOW";
897 break;
899 case EXCEPTION_FLT_STACK_CHECK:
900 exception = &program_error;
901 msg = "EXCEPTION_FLT_STACK_CHECK";
902 break;
904 case EXCEPTION_FLT_UNDERFLOW:
905 exception = &constraint_error;
906 msg = "EXCEPTION_FLT_UNDERFLOW";
907 break;
909 case EXCEPTION_INT_DIVIDE_BY_ZERO:
910 exception = &constraint_error;
911 msg = "EXCEPTION_INT_DIVIDE_BY_ZERO";
912 break;
914 case EXCEPTION_INT_OVERFLOW:
915 exception = &constraint_error;
916 msg = "EXCEPTION_INT_OVERFLOW";
917 break;
919 case EXCEPTION_INVALID_DISPOSITION:
920 exception = &program_error;
921 msg = "EXCEPTION_INVALID_DISPOSITION";
922 break;
924 case EXCEPTION_NONCONTINUABLE_EXCEPTION:
925 exception = &program_error;
926 msg = "EXCEPTION_NONCONTINUABLE_EXCEPTION";
927 break;
929 case EXCEPTION_PRIV_INSTRUCTION:
930 exception = &program_error;
931 msg = "EXCEPTION_PRIV_INSTRUCTION";
932 break;
934 case EXCEPTION_SINGLE_STEP:
935 exception = &program_error;
936 msg = "EXCEPTION_SINGLE_STEP";
937 break;
939 case EXCEPTION_STACK_OVERFLOW:
940 exception = &storage_error;
941 msg = "EXCEPTION_STACK_OVERFLOW";
942 break;
944 default:
945 exception = &program_error;
946 msg = "unhandled signal";
949 recurse = 0;
950 Raise_From_Signal_Handler (exception, msg);
951 return 0; /* This is never reached, avoid compiler warning */
954 void
955 __gnat_install_handler (void)
957 SetUnhandledExceptionFilter (__gnat_error_handler);
958 __gnat_handler_installed = 1;
961 void
962 __gnat_initialize (void)
965 /* Initialize floating-point coprocessor. This call is needed because
966 the MS libraries default to 64-bit precision instead of 80-bit
967 precision, and we require the full precision for proper operation,
968 given that we have set Max_Digits etc with this in mind */
970 __gnat_init_float ();
972 /* initialize a lock for a process handle list - see a-adaint.c for the
973 implementation of __gnat_portable_no_block_spawn, __gnat_portable_wait */
974 __gnat_plist_init();
977 /***************************************/
978 /* __gnat_initialize (Interix Version) */
979 /***************************************/
981 #elif defined (__INTERIX)
983 #include <signal.h>
985 static void __gnat_error_handler (int);
987 static void
988 __gnat_error_handler (int sig)
990 struct Exception_Data *exception;
991 char *msg;
993 switch (sig)
995 case SIGSEGV:
996 exception = &storage_error;
997 msg = "stack overflow or erroneous memory access";
998 break;
1000 case SIGBUS:
1001 exception = &constraint_error;
1002 msg = "SIGBUS";
1003 break;
1005 case SIGFPE:
1006 exception = &constraint_error;
1007 msg = "SIGFPE";
1008 break;
1010 default:
1011 exception = &program_error;
1012 msg = "unhandled signal";
1015 Raise_From_Signal_Handler (exception, msg);
1018 void
1019 __gnat_install_handler (void)
1021 struct sigaction act;
1023 /* Set up signal handler to map synchronous signals to appropriate
1024 exceptions. Make sure that the handler isn't interrupted by another
1025 signal that might cause a scheduling event! */
1027 act.sa_handler = __gnat_error_handler;
1028 act.sa_flags = 0;
1029 sigemptyset (&act.sa_mask);
1031 /* Handlers for signals besides SIGSEGV cause c974013 to hang */
1032 /* sigaction (SIGILL, &act, NULL); */
1033 /* sigaction (SIGABRT, &act, NULL); */
1034 /* sigaction (SIGFPE, &act, NULL); */
1035 /* sigaction (SIGBUS, &act, NULL); */
1037 /* Do not install handlers if interrupt state is "System" */
1038 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1039 sigaction (SIGSEGV, &act, NULL);
1041 __gnat_handler_installed = 1;
1044 void
1045 __gnat_initialize (void)
1047 __gnat_init_float ();
1050 /**************************************/
1051 /* __gnat_initialize (LynxOS Version) */
1052 /**************************************/
1054 #elif defined (__Lynx__)
1056 void
1057 __gnat_initialize (void)
1059 __gnat_init_float ();
1062 /*********************************/
1063 /* __gnat_install_handler (Lynx) */
1064 /*********************************/
1066 void
1067 __gnat_install_handler (void)
1069 __gnat_handler_installed = 1;
1072 /****************************/
1073 /* __gnat_initialize (OS/2) */
1074 /****************************/
1076 #elif defined (__EMX__) /* OS/2 dependent initialization */
1078 void
1079 __gnat_initialize (void)
1083 /*********************************/
1084 /* __gnat_install_handler (OS/2) */
1085 /*********************************/
1087 void
1088 __gnat_install_handler (void)
1090 __gnat_handler_installed = 1;
1093 /***********************************/
1094 /* __gnat_initialize (SGI Version) */
1095 /***********************************/
1097 #elif defined (sgi)
1099 #include <signal.h>
1100 #include <siginfo.h>
1102 #ifndef NULL
1103 #define NULL 0
1104 #endif
1106 #define SIGADAABORT 48
1107 #define SIGNAL_STACK_SIZE 4096
1108 #define SIGNAL_STACK_ALIGNMENT 64
1110 struct Machine_State
1112 sigcontext_t context;
1115 static void __gnat_error_handler (int, int, sigcontext_t *);
1117 static void
1118 __gnat_error_handler (int sig, int code, sigcontext_t *sc)
1120 struct Machine_State *mstate;
1121 struct Exception_Data *exception;
1122 const char *msg;
1124 switch (sig)
1126 case SIGSEGV:
1127 if (code == EFAULT)
1129 exception = &program_error;
1130 msg = "SIGSEGV: (Invalid virtual address)";
1132 else if (code == ENXIO)
1134 exception = &program_error;
1135 msg = "SIGSEGV: (Read beyond mapped object)";
1137 else if (code == ENOSPC)
1139 exception = &program_error; /* ??? storage_error ??? */
1140 msg = "SIGSEGV: (Autogrow for file failed)";
1142 else if (code == EACCES)
1144 /* ??? Re-add smarts to further verify that we launched
1145 the stack into a guard page, not an attempt to
1146 write to .text or something */
1147 exception = &storage_error;
1148 msg = "SIGSEGV: (stack overflow or erroneous memory access)";
1150 else
1152 /* Just in case the OS guys did it to us again. Sometimes
1153 they fail to document all of the valid codes that are
1154 passed to signal handlers, just in case someone depends
1155 on knowing all the codes */
1156 exception = &program_error;
1157 msg = "SIGSEGV: (Undocumented reason)";
1159 break;
1161 case SIGBUS:
1162 /* Map all bus errors to Program_Error. */
1163 exception = &program_error;
1164 msg = "SIGBUS";
1165 break;
1167 case SIGFPE:
1168 /* Map all fpe errors to Constraint_Error. */
1169 exception = &constraint_error;
1170 msg = "SIGFPE";
1171 break;
1173 case SIGADAABORT:
1174 if ((*Check_Abort_Status) ())
1176 exception = &_abort_signal;
1177 msg = "";
1179 else
1180 return;
1182 break;
1184 default:
1185 /* Everything else is a Program_Error. */
1186 exception = &program_error;
1187 msg = "unhandled signal";
1190 mstate = (*Get_Machine_State_Addr) ();
1191 if (mstate != 0)
1192 memcpy ((void *) mstate, (const void *) sc, sizeof (sigcontext_t));
1194 Raise_From_Signal_Handler (exception, msg);
1197 void
1198 __gnat_install_handler (void)
1200 struct sigaction act;
1202 /* Setup signal handler to map synchronous signals to appropriate
1203 exceptions. Make sure that the handler isn't interrupted by another
1204 signal that might cause a scheduling event! */
1206 act.sa_handler = __gnat_error_handler;
1207 act.sa_flags = SA_NODEFER + SA_RESTART;
1208 sigfillset (&act.sa_mask);
1209 sigemptyset (&act.sa_mask);
1211 /* Do not install handlers if interrupt state is "System" */
1212 if (__gnat_get_interrupt_state (SIGABRT) != 's')
1213 sigaction (SIGABRT, &act, NULL);
1214 if (__gnat_get_interrupt_state (SIGFPE) != 's')
1215 sigaction (SIGFPE, &act, NULL);
1216 if (__gnat_get_interrupt_state (SIGILL) != 's')
1217 sigaction (SIGILL, &act, NULL);
1218 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1219 sigaction (SIGSEGV, &act, NULL);
1220 if (__gnat_get_interrupt_state (SIGBUS) != 's')
1221 sigaction (SIGBUS, &act, NULL);
1222 if (__gnat_get_interrupt_state (SIGADAABORT) != 's')
1223 sigaction (SIGADAABORT, &act, NULL);
1225 __gnat_handler_installed = 1;
1228 void
1229 __gnat_initialize (void)
1233 /*************************************************/
1234 /* __gnat_initialize (Solaris and SunOS Version) */
1235 /*************************************************/
1237 #elif defined (sun) && defined (__SVR4) && !defined (__vxworks)
1239 #include <signal.h>
1240 #include <siginfo.h>
1242 static void __gnat_error_handler (int, siginfo_t *);
1244 static void
1245 __gnat_error_handler (int sig, siginfo_t *sip)
1247 struct Exception_Data *exception;
1248 static int recurse = 0;
1249 const char *msg;
1251 /* If this was an explicit signal from a "kill", just resignal it. */
1252 if (SI_FROMUSER (sip))
1254 signal (sig, SIG_DFL);
1255 kill (getpid(), sig);
1258 /* Otherwise, treat it as something we handle. */
1259 switch (sig)
1261 case SIGSEGV:
1262 /* If the problem was permissions, this is a constraint error.
1263 Likewise if the failing address isn't maximally aligned or if
1264 we've recursed.
1266 ??? Using a static variable here isn't task-safe, but it's
1267 much too hard to do anything else and we're just determining
1268 which exception to raise. */
1269 if (sip->si_code == SEGV_ACCERR
1270 || (((long) sip->si_addr) & 3) != 0
1271 || recurse)
1273 exception = &constraint_error;
1274 msg = "SIGSEGV";
1276 else
1278 /* See if the page before the faulting page is accessible. Do that
1279 by trying to access it. We'd like to simply try to access
1280 4096 + the faulting address, but it's not guaranteed to be
1281 the actual address, just to be on the same page. */
1282 recurse++;
1283 ((volatile char *)
1284 ((long) sip->si_addr & - getpagesize ()))[getpagesize ()];
1285 exception = &storage_error;
1286 msg = "stack overflow (or erroneous memory access)";
1288 break;
1290 case SIGBUS:
1291 exception = &program_error;
1292 msg = "SIGBUS";
1293 break;
1295 case SIGFPE:
1296 exception = &constraint_error;
1297 msg = "SIGFPE";
1298 break;
1300 default:
1301 exception = &program_error;
1302 msg = "unhandled signal";
1305 recurse = 0;
1307 Raise_From_Signal_Handler (exception, msg);
1310 void
1311 __gnat_install_handler (void)
1313 struct sigaction act;
1315 /* Set up signal handler to map synchronous signals to appropriate
1316 exceptions. Make sure that the handler isn't interrupted by another
1317 signal that might cause a scheduling event! */
1319 act.sa_handler = __gnat_error_handler;
1320 act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
1321 sigemptyset (&act.sa_mask);
1323 /* Do not install handlers if interrupt state is "System" */
1324 if (__gnat_get_interrupt_state (SIGABRT) != 's')
1325 sigaction (SIGABRT, &act, NULL);
1326 if (__gnat_get_interrupt_state (SIGFPE) != 's')
1327 sigaction (SIGFPE, &act, NULL);
1328 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1329 sigaction (SIGSEGV, &act, NULL);
1330 if (__gnat_get_interrupt_state (SIGBUS) != 's')
1331 sigaction (SIGBUS, &act, NULL);
1333 __gnat_handler_installed = 1;
1336 void
1337 __gnat_initialize (void)
1341 /***********************************/
1342 /* __gnat_initialize (VMS Version) */
1343 /***********************************/
1345 #elif defined (VMS)
1347 /* The prehandler actually gets control first on a condition. It swaps the
1348 stack pointer and calls the handler (__gnat_error_handler). */
1349 extern long __gnat_error_prehandler (void);
1351 extern char *__gnat_error_prehandler_stack; /* Alternate signal stack */
1353 /* Conditions that don't have an Ada exception counterpart must raise
1354 Non_Ada_Error. Since this is defined in s-auxdec, it should only be
1355 referenced by user programs, not the compiler or tools. Hence the
1356 #ifdef IN_RTS. */
1358 #ifdef IN_RTS
1359 #define Non_Ada_Error system__aux_dec__non_ada_error
1360 extern struct Exception_Data Non_Ada_Error;
1362 #define Coded_Exception system__vms_exception_table__coded_exception
1363 extern struct Exception_Data *Coded_Exception (Exception_Code);
1365 #define Base_Code_In system__vms_exception_table__base_code_in
1366 extern Exception_Code Base_Code_In (Exception_Code);
1367 #endif
1369 /* Define macro symbols for the VMS conditions that become Ada exceptions.
1370 Most of these are also defined in the header file ssdef.h which has not
1371 yet been converted to be recoginized by Gnu C. Some, which couldn't be
1372 located, are assigned names based on the DEC test suite tests which
1373 raise them. */
1375 #define SS$_ACCVIO 12
1376 #define SS$_DEBUG 1132
1377 #define SS$_INTDIV 1156
1378 #define SS$_HPARITH 1284
1379 #define SS$_STKOVF 1364
1380 #define SS$_RESIGNAL 2328
1381 #define MTH$_FLOOVEMAT 1475268 /* Some ACVC_21 CXA tests */
1382 #define SS$_CE24VRU 3253636 /* Write to unopened file */
1383 #define SS$_C980VTE 3246436 /* AST requests time slice */
1384 #define CMA$_EXIT_THREAD 4227492
1385 #define CMA$_EXCCOPLOS 4228108
1386 #define CMA$_ALERTED 4227460
1388 struct descriptor_s {unsigned short len, mbz; char *adr; };
1390 long __gnat_error_handler (int *, void *);
1392 long
1393 __gnat_error_handler (int *sigargs, void *mechargs)
1395 struct Exception_Data *exception = 0;
1396 Exception_Code base_code;
1398 char *msg = "";
1399 char message[256];
1400 long prvhnd;
1401 struct descriptor_s msgdesc;
1402 int msg_flag = 0x000f; /* 1 bit for each of the four message parts */
1403 unsigned short outlen;
1404 char curr_icb[544];
1405 long curr_invo_handle;
1406 long *mstate;
1408 /* Resignaled condtions aren't effected by by pragma Import_Exception */
1410 switch (sigargs[1])
1413 case CMA$_EXIT_THREAD:
1414 return SS$_RESIGNAL;
1416 case SS$_DEBUG: /* Gdb attach, resignal to merge activate gdbstub. */
1417 return SS$_RESIGNAL;
1419 case 1409786: /* Nickerson bug #33 ??? */
1420 return SS$_RESIGNAL;
1422 case 1381050: /* Nickerson bug #33 ??? */
1423 return SS$_RESIGNAL;
1425 case 20480426: /* RDB-E-STREAM_EOF */
1426 return SS$_RESIGNAL;
1428 case 11829410: /* Resignalled as Use_Error for CE10VRC */
1429 return SS$_RESIGNAL;
1433 #ifdef IN_RTS
1434 /* See if it's an imported exception. Beware that registered exceptions
1435 are bound to their base code, with the severity bits masked off. */
1436 base_code = Base_Code_In ((Exception_Code) sigargs [1]);
1437 exception = Coded_Exception (base_code);
1439 if (exception)
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;
1448 exception->Name_Length = 19;
1449 /* The full name really should be get sys$getmsg returns. ??? */
1450 exception->Full_Name = "IMPORTED_EXCEPTION";
1451 exception->Import_Code = base_code;
1453 #endif
1455 if (exception == 0)
1456 switch (sigargs[1])
1458 case SS$_ACCVIO:
1459 if (sigargs[3] == 0)
1461 exception = &constraint_error;
1462 msg = "access zero";
1464 else
1466 exception = &storage_error;
1467 msg = "stack overflow (or erroneous memory access)";
1469 break;
1471 case SS$_STKOVF:
1472 exception = &storage_error;
1473 msg = "stack overflow";
1474 break;
1476 case SS$_INTDIV:
1477 exception = &constraint_error;
1478 msg = "division by zero";
1479 break;
1481 case SS$_HPARITH:
1482 #ifndef IN_RTS
1483 return SS$_RESIGNAL; /* toplev.c handles for compiler */
1484 #else
1486 exception = &constraint_error;
1487 msg = "arithmetic error";
1489 #endif
1490 break;
1492 case MTH$_FLOOVEMAT:
1493 exception = &constraint_error;
1494 msg = "floating overflow in math library";
1495 break;
1497 case SS$_CE24VRU:
1498 exception = &constraint_error;
1499 msg = "";
1500 break;
1502 case SS$_C980VTE:
1503 exception = &program_error;
1504 msg = "";
1505 break;
1507 default:
1508 #ifndef IN_RTS
1509 exception = &program_error;
1510 #else
1511 /* User programs expect Non_Ada_Error to be raised, reference
1512 DEC Ada test CXCONDHAN. */
1513 exception = &Non_Ada_Error;
1514 #endif
1515 msgdesc.len = 256;
1516 msgdesc.mbz = 0;
1517 msgdesc.adr = message;
1518 SYS$GETMSG (sigargs[1], &outlen, &msgdesc, msg_flag, 0);
1519 message[outlen] = 0;
1520 msg = message;
1521 break;
1524 mstate = (long *) (*Get_Machine_State_Addr) ();
1525 if (mstate != 0)
1527 LIB$GET_CURR_INVO_CONTEXT (&curr_icb);
1528 LIB$GET_PREV_INVO_CONTEXT (&curr_icb);
1529 LIB$GET_PREV_INVO_CONTEXT (&curr_icb);
1530 curr_invo_handle = LIB$GET_INVO_HANDLE (&curr_icb);
1531 *mstate = curr_invo_handle;
1533 Raise_From_Signal_Handler (exception, msg);
1536 void
1537 __gnat_install_handler (void)
1539 long prvhnd;
1540 char *c;
1542 c = (char *) xmalloc (2049);
1544 __gnat_error_prehandler_stack = &c[2048];
1546 /* __gnat_error_prehandler is an assembly function. */
1547 SYS$SETEXV (1, __gnat_error_prehandler, 3, &prvhnd);
1548 __gnat_handler_installed = 1;
1551 void
1552 __gnat_initialize(void)
1556 /*************************************************/
1557 /* __gnat_initialize (FreeBSD version) */
1558 /*************************************************/
1560 #elif defined (__FreeBSD__)
1562 #include <signal.h>
1563 #include <unistd.h>
1565 static void
1566 __gnat_error_handler (sig, code, sc)
1567 int sig;
1568 int code;
1569 struct sigcontext *sc;
1571 struct Exception_Data *exception;
1572 char *msg;
1574 switch (sig)
1576 case SIGFPE:
1577 exception = &constraint_error;
1578 msg = "SIGFPE";
1579 break;
1581 case SIGILL:
1582 exception = &constraint_error;
1583 msg = "SIGILL";
1584 break;
1586 case SIGSEGV:
1587 exception = &storage_error;
1588 msg = "stack overflow or erroneous memory access";
1589 break;
1591 case SIGBUS:
1592 exception = &constraint_error;
1593 msg = "SIGBUS";
1594 break;
1596 default:
1597 exception = &program_error;
1598 msg = "unhandled signal";
1601 Raise_From_Signal_Handler (exception, msg);
1604 void
1605 __gnat_install_handler ()
1607 struct sigaction act;
1609 /* Set up signal handler to map synchronous signals to appropriate
1610 exceptions. Make sure that the handler isn't interrupted by another
1611 signal that might cause a scheduling event! */
1613 act.sa_handler = __gnat_error_handler;
1614 act.sa_flags = SA_NODEFER | SA_RESTART;
1615 (void) sigemptyset (&act.sa_mask);
1617 (void) sigaction (SIGILL, &act, NULL);
1618 (void) sigaction (SIGFPE, &act, NULL);
1619 (void) sigaction (SIGSEGV, &act, NULL);
1620 (void) sigaction (SIGBUS, &act, NULL);
1623 void __gnat_init_float ();
1625 void
1626 __gnat_initialize ()
1628 __gnat_install_handler ();
1630 /* XXX - Initialize floating-point coprocessor. This call is
1631 needed because FreeBSD defaults to 64-bit precision instead
1632 of 80-bit precision? We require the full precision for
1633 proper operation, given that we have set Max_Digits etc
1634 with this in mind */
1635 __gnat_init_float ();
1638 /***************************************/
1639 /* __gnat_initialize (VXWorks Version) */
1640 /***************************************/
1642 #elif defined(__vxworks)
1644 #include <signal.h>
1645 #include <taskLib.h>
1646 #include <intLib.h>
1647 #include <iv.h>
1649 extern int __gnat_inum_to_ivec (int);
1650 static void __gnat_error_handler (int, int, struct sigcontext *);
1651 void __gnat_map_signal (int);
1653 #ifndef __alpha_vxworks
1655 /* getpid is used by s-parint.adb, but is not defined by VxWorks, except
1656 on Alpha VxWorks */
1658 extern long getpid (void);
1660 long
1661 getpid (void)
1663 return taskIdSelf ();
1665 #endif
1667 /* This is needed by the GNAT run time to handle Vxworks interrupts */
1669 __gnat_inum_to_ivec (int num)
1671 return INUM_TO_IVEC (num);
1674 /* Exported to 5zintman.adb in order to handle different signal
1675 to exception mappings in different VxWorks versions */
1676 void
1677 __gnat_map_signal (int sig)
1679 struct Exception_Data *exception;
1680 char *msg;
1682 switch (sig)
1684 case SIGFPE:
1685 exception = &constraint_error;
1686 msg = "SIGFPE";
1687 break;
1688 case SIGILL:
1689 exception = &constraint_error;
1690 msg = "SIGILL";
1691 break;
1692 case SIGSEGV:
1693 exception = &program_error;
1694 msg = "SIGSEGV";
1695 break;
1696 case SIGBUS:
1697 #ifdef VTHREADS
1698 exception = &storage_error;
1699 msg = "SIGBUS: possible stack overflow";
1700 #else
1701 exception = &program_error;
1702 msg = "SIGBUS";
1703 #endif
1704 break;
1705 default:
1706 exception = &program_error;
1707 msg = "unhandled signal";
1710 Raise_From_Signal_Handler (exception, msg);
1713 static void
1714 __gnat_error_handler (int sig, int code, struct sigcontext *sc)
1716 sigset_t mask;
1717 int result;
1719 /* VxWorks will always mask out the signal during the signal handler and
1720 will reenable it on a longjmp. GNAT does not generate a longjmp to
1721 return from a signal handler so the signal will still be masked unless
1722 we unmask it. */
1723 sigprocmask (SIG_SETMASK, NULL, &mask);
1724 sigdelset (&mask, sig);
1725 sigprocmask (SIG_SETMASK, &mask, NULL);
1727 /* VxWorks will suspend the task when it gets a hardware exception. We
1728 take the liberty of resuming the task for the application. */
1729 if (taskIsSuspended (taskIdSelf ()) != 0)
1730 taskResume (taskIdSelf ());
1732 __gnat_map_signal (sig);
1736 void
1737 __gnat_install_handler (void)
1739 struct sigaction act;
1741 /* Setup signal handler to map synchronous signals to appropriate
1742 exceptions. Make sure that the handler isn't interrupted by another
1743 signal that might cause a scheduling event! */
1745 act.sa_handler = __gnat_error_handler;
1746 act.sa_flags = SA_SIGINFO | SA_ONSTACK;
1747 sigemptyset (&act.sa_mask);
1749 /* For VxWorks, install all signal handlers, since pragma Interrupt_State
1750 applies to vectored hardware interrupts, not signals */
1751 sigaction (SIGFPE, &act, NULL);
1752 sigaction (SIGILL, &act, NULL);
1753 sigaction (SIGSEGV, &act, NULL);
1754 sigaction (SIGBUS, &act, NULL);
1756 __gnat_handler_installed = 1;
1759 #define HAVE_GNAT_INIT_FLOAT
1761 void
1762 __gnat_init_float (void)
1764 /* Disable overflow/underflow exceptions on the PPC processor, this is needed
1765 to get correct Ada semantic. */
1766 #if defined (_ARCH_PPC) && !defined (_SOFT_FLOAT)
1767 asm ("mtfsb0 25");
1768 asm ("mtfsb0 26");
1769 #endif
1771 /* Similarily for sparc64. Achieved by masking bits in the Trap Enable Mask
1772 field of the Floating-point Status Register (see the Sparc Architecture
1773 Manual Version 9, p 48). */
1774 #if defined (sparc64)
1776 #define FSR_TEM_NVM (1 << 27) /* Invalid operand */
1777 #define FSR_TEM_OFM (1 << 26) /* Overflow */
1778 #define FSR_TEM_UFM (1 << 25) /* Underflow */
1779 #define FSR_TEM_DZM (1 << 24) /* Division by Zero */
1780 #define FSR_TEM_NXM (1 << 23) /* Inexact result */
1782 unsigned int fsr;
1784 __asm__("st %%fsr, %0" : "=m" (fsr));
1785 fsr &= ~(FSR_TEM_OFM | FSR_TEM_UFM);
1786 __asm__("ld %0, %%fsr" : : "m" (fsr));
1788 #endif
1791 void
1792 __gnat_initialize (void)
1794 __gnat_init_float ();
1796 /* On targets where we might be using the ZCX scheme, we need to register
1797 the frame tables.
1799 For application "modules", the crtstuff objects linked in (crtbegin/endS)
1800 are tailored to provide this service a-la C++ constructor fashion,
1801 typically triggered by the dynamic loader. This is achieved by way of a
1802 special variable declaration in the crt object, the name of which has
1803 been deduced by analyzing the output of the "munching" step documented
1804 for C++. The de-registration call is handled symetrically, a-la C++
1805 destructor fashion and typically triggered by the dynamic unloader. With
1806 this scheme, a mixed Ada/C++ application has to be linked and loaded as
1807 separate modules for each language, which is not unreasonable anyway.
1809 For applications statically linked with the kernel, the module scheme
1810 above would lead to duplicated symbols because the VxWorks kernel build
1811 "munches" by default. To prevent those conflicts, we link against
1812 crtbegin/end objects that don't include the special variable and directly
1813 call the appropriate function here. We'll never unload that, so there is
1814 no de-registration to worry about.
1816 We can differentiate by looking at the __module_has_ctors value provided
1817 by each class of crt objects. As of today, selecting the crt set intended
1818 for applications to be statically linked with the kernel is triggered by
1819 adding "-static" to the gcc *link* command line options.
1821 This is a first approach, tightly synchronized with a number of GCC
1822 configuration and crtstuff changes. We need to ensure that those changes
1823 are there to activate this circuitry. */
1825 #if DWARF2_UNWIND_INFO && defined (_ARCH_PPC)
1827 extern const int __module_has_ctors;
1828 extern void __do_global_ctors ();
1830 if (! __module_has_ctors)
1831 __do_global_ctors ();
1833 #endif
1836 /********************************/
1837 /* __gnat_initialize for NetBSD */
1838 /********************************/
1840 #elif defined(__NetBSD__)
1842 #include <signal.h>
1843 #include <unistd.h>
1845 static void
1846 __gnat_error_handler (int sig)
1848 struct Exception_Data *exception;
1849 const char *msg;
1851 switch(sig)
1853 case SIGFPE:
1854 exception = &constraint_error;
1855 msg = "SIGFPE";
1856 break;
1857 case SIGILL:
1858 exception = &constraint_error;
1859 msg = "SIGILL";
1860 break;
1861 case SIGSEGV:
1862 exception = &storage_error;
1863 msg = "stack overflow or erroneous memory access";
1864 break;
1865 case SIGBUS:
1866 exception = &constraint_error;
1867 msg = "SIGBUS";
1868 break;
1869 default:
1870 exception = &program_error;
1871 msg = "unhandled signal";
1874 Raise_From_Signal_Handler(exception, msg);
1877 void
1878 __gnat_install_handler(void)
1880 struct sigaction act;
1882 act.sa_handler = __gnat_error_handler;
1883 act.sa_flags = SA_NODEFER | SA_RESTART;
1884 sigemptyset (&act.sa_mask);
1886 /* Do not install handlers if interrupt state is "System" */
1887 if (__gnat_get_interrupt_state (SIGFPE) != 's')
1888 sigaction (SIGFPE, &act, NULL);
1889 if (__gnat_get_interrupt_state (SIGILL) != 's')
1890 sigaction (SIGILL, &act, NULL);
1891 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1892 sigaction (SIGSEGV, &act, NULL);
1893 if (__gnat_get_interrupt_state (SIGBUS) != 's')
1894 sigaction (SIGBUS, &act, NULL);
1896 __gnat_handler_installed = 1;
1899 void
1900 __gnat_initialize (void)
1902 __gnat_install_handler ();
1903 __gnat_init_float ();
1906 #else
1908 /* For all other versions of GNAT, the initialize routine and handler
1909 installation do nothing */
1911 /***************************************/
1912 /* __gnat_initialize (Default Version) */
1913 /***************************************/
1915 void
1916 __gnat_initialize (void)
1920 /********************************************/
1921 /* __gnat_install_handler (Default Version) */
1922 /********************************************/
1924 void
1925 __gnat_install_handler (void)
1927 __gnat_handler_installed = 1;
1930 #endif
1932 /*********************/
1933 /* __gnat_init_float */
1934 /*********************/
1936 /* This routine is called as each process thread is created, for possible
1937 initialization of the FP processor. This version is used under INTERIX,
1938 WIN32 and could be used under OS/2 */
1940 #if defined (_WIN32) || defined (__INTERIX) || defined (__EMX__) \
1941 || defined (__Lynx__) || defined(__NetBSD__) || defined(__FreeBSD__)
1943 #define HAVE_GNAT_INIT_FLOAT
1945 void
1946 __gnat_init_float (void)
1948 #if defined (__i386__) || defined (i386)
1950 /* This is used to properly initialize the FPU on an x86 for each
1951 process thread. */
1953 asm ("finit");
1955 #endif /* Defined __i386__ */
1957 #endif
1959 #ifndef HAVE_GNAT_INIT_FLOAT
1961 /* All targets without a specific __gnat_init_float will use an empty one */
1962 void
1963 __gnat_init_float (void)
1966 #endif