Merge reload-branch up to revision 101000
[official-gcc.git] / gcc / ada / init.c
blob7ca680040bde11f0c249676b1b402bc225e92a06
1 /****************************************************************************
2 * *
3 * GNAT COMPILER COMPONENTS *
4 * *
5 * I N I T *
6 * *
7 * C Implementation File *
8 * *
9 * Copyright (C) 1992-2005, 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;
114 int __gl_detect_blocking = 0;
116 /* Indication of whether synchronous signal handler has already been
117 installed by a previous call to adainit */
118 int __gnat_handler_installed = 0;
120 /* HAVE_GNAT_INIT_FLOAT must be set on every targets where a __gnat_init_float
121 is defined. If this is not set them a void implementation will be defined
122 at the end of this unit. */
123 #undef HAVE_GNAT_INIT_FLOAT
125 /******************************/
126 /* __gnat_get_interrupt_state */
127 /******************************/
129 char __gnat_get_interrupt_state (int);
131 /* This routine is called from the runtime as needed to determine the state
132 of an interrupt, as set by an Interrupt_State pragma appearing anywhere
133 in the current partition. The input argument is the interrupt number,
134 and the result is one of the following:
136 'n' this interrupt not set by any Interrupt_State pragma
137 'u' Interrupt_State pragma set state to User
138 'r' Interrupt_State pragma set state to Runtime
139 's' Interrupt_State pragma set state to System */
141 char
142 __gnat_get_interrupt_state (int intrup)
144 if (intrup >= __gl_num_interrupt_states)
145 return 'n';
146 else
147 return __gl_interrupt_states [intrup];
150 /**********************/
151 /* __gnat_set_globals */
152 /**********************/
154 /* This routine is called from the binder generated main program. It copies
155 the values for global quantities computed by the binder into the following
156 global locations. The reason that we go through this copy, rather than just
157 define the global locations in the binder generated file, is that they are
158 referenced from the runtime, which may be in a shared library, and the
159 binder file is not in the shared library. Global references across library
160 boundaries like this are not handled correctly in all systems. */
162 /* For detailed description of the parameters to this routine, see the
163 section titled Run-Time Globals in package Bindgen (bindgen.adb) */
165 void
166 __gnat_set_globals (int main_priority,
167 int time_slice_val,
168 char wc_encoding,
169 char locking_policy,
170 char queuing_policy,
171 char task_dispatching_policy,
172 char *restrictions,
173 char *interrupt_states,
174 int num_interrupt_states,
175 int unreserve_all_interrupts,
176 int exception_tracebacks,
177 int zero_cost_exceptions,
178 int detect_blocking)
180 static int already_called = 0;
182 /* If this procedure has been already called once, check that the
183 arguments in this call are consistent with the ones in the previous
184 calls. Otherwise, raise a Program_Error exception.
186 We do not check for consistency of the wide character encoding
187 method. This default affects only Wide_Text_IO where no explicit
188 coding method is given, and there is no particular reason to let
189 this default be affected by the source representation of a library
190 in any case.
192 We do not check either for the consistency of exception tracebacks,
193 because exception tracebacks are not normally set in Stand-Alone
194 libraries. If a library or the main program set the exception
195 tracebacks, then they are never reset afterwards (see below).
197 The value of main_priority is meaningful only when we are invoked
198 from the main program elaboration routine of an Ada application.
199 Checking the consistency of this parameter should therefore not be
200 done. Since it is assured that the main program elaboration will
201 always invoke this procedure before any library elaboration
202 routine, only the value of main_priority during the first call
203 should be taken into account and all the subsequent ones should be
204 ignored. Note that the case where the main program is not written
205 in Ada is also properly handled, since the default value will then
206 be used for this parameter.
208 For identical reasons, the consistency of time_slice_val should not
209 be checked. */
211 if (already_called)
213 if (__gl_locking_policy != locking_policy
214 || __gl_queuing_policy != queuing_policy
215 || __gl_task_dispatching_policy != task_dispatching_policy
216 || __gl_unreserve_all_interrupts != unreserve_all_interrupts
217 || __gl_zero_cost_exceptions != zero_cost_exceptions)
218 __gnat_raise_program_error (__FILE__, __LINE__);
220 /* If either a library or the main program set the exception traceback
221 flag, it is never reset later */
223 if (exception_tracebacks != 0)
224 __gl_exception_tracebacks = exception_tracebacks;
226 return;
228 already_called = 1;
230 __gl_main_priority = main_priority;
231 __gl_time_slice_val = time_slice_val;
232 __gl_wc_encoding = wc_encoding;
233 __gl_locking_policy = locking_policy;
234 __gl_queuing_policy = queuing_policy;
235 __gl_restrictions = restrictions;
236 __gl_interrupt_states = interrupt_states;
237 __gl_num_interrupt_states = num_interrupt_states;
238 __gl_task_dispatching_policy = task_dispatching_policy;
239 __gl_unreserve_all_interrupts = unreserve_all_interrupts;
240 __gl_exception_tracebacks = exception_tracebacks;
241 __gl_detect_blocking = detect_blocking;
243 /* ??? __gl_zero_cost_exceptions is new in 3.15 and is referenced from
244 a-except.adb, which is also part of the compiler sources. Since the
245 compiler is built with an older release of GNAT, the call generated by
246 the old binder to this function does not provide any value for the
247 corresponding argument, so the global has to be initialized in some
248 reasonable other way. This could be removed as soon as the next major
249 release is out. */
251 #ifdef IN_RTS
252 __gl_zero_cost_exceptions = zero_cost_exceptions;
253 #else
254 __gl_zero_cost_exceptions = 0;
255 /* We never build the compiler to run in ZCX mode currently anyway. */
256 #endif
259 /*********************/
260 /* __gnat_initialize */
261 /*********************/
263 /* __gnat_initialize is called at the start of execution of an Ada program
264 (the call is generated by the binder). The standard routine does nothing
265 at all; the intention is that this be replaced by system specific
266 code where initialization is required. */
268 /* Notes on the Zero Cost Exceptions scheme and its impact on the signal
269 handlers implemented below :
271 What we call Zero Cost Exceptions is implemented using the GCC eh
272 circuitry, even if the underlying implementation is setjmp/longjmp
273 based. In any case ...
275 The GCC unwinder expects to be dealing with call return addresses, since
276 this is the "nominal" case of what we retrieve while unwinding a regular
277 call chain. To evaluate if a handler applies at some point in this chain,
278 the propagation engine needs to determine what region the corresponding
279 call instruction pertains to. The return address may not be attached to the
280 same region as the call, so the unwinder unconditionally subtracts "some"
281 amount to the return addresses it gets to search the region tables. The
282 exact amount is computed to ensure that the resulting address is inside the
283 call instruction, and is thus target dependent (think about delay slots for
284 instance).
286 When we raise an exception from a signal handler, e.g. to transform a
287 SIGSEGV into Storage_Error, things need to appear as if the signal handler
288 had been "called" by the instruction which triggered the signal, so that
289 exception handlers that apply there are considered. What the unwinder will
290 retrieve as the return address from the signal handler is what it will find
291 as the faulting instruction address in the corresponding signal context
292 pushed by the kernel. Leaving this address untouched may loose, because if
293 the triggering instruction happens to be the very first of a region, the
294 later adjustments performed by the unwinder would yield an address outside
295 that region. We need to compensate for those adjustments at some point,
296 which we currently do in the GCC unwinding fallback macro.
298 The thread at http://gcc.gnu.org/ml/gcc-patches/2004-05/msg00343.html
299 describes a couple of issues with our current approach. Basically: on some
300 targets the adjustment to apply depends on the triggering signal, which is
301 not easily accessible from the macro, and we actually do not tackle this as
302 of today. Besides, other languages, e.g. Java, deal with this by performing
303 the adjustment in the signal handler before the raise, so our adjustments
304 may break those front-ends.
306 To have it all right, we should either find a way to deal with the signal
307 variants from the macro and convert Java on all targets (ugh), or remove
308 our macro adjustments and update our signal handlers a-la-java way. The
309 latter option appears the simplest, although some targets have their share
310 of subtleties to account for. See for instance the syscall(SYS_sigaction)
311 story in libjava/include/i386-signal.h. */
313 /***********************************/
314 /* __gnat_initialize (AIX Version) */
315 /***********************************/
317 #if defined (_AIX)
319 #include <signal.h>
320 #include <sys/time.h>
322 /* Some versions of AIX don't define SA_NODEFER. */
324 #ifndef SA_NODEFER
325 #define SA_NODEFER 0
326 #endif /* SA_NODEFER */
328 /* Versions of AIX before 4.3 don't have nanosleep but provide
329 nsleep instead. */
331 #ifndef _AIXVERSION_430
333 extern int nanosleep (struct timestruc_t *, struct timestruc_t *);
336 nanosleep (struct timestruc_t *Rqtp, struct timestruc_t *Rmtp)
338 return nsleep (Rqtp, Rmtp);
341 #endif /* _AIXVERSION_430 */
343 static void __gnat_error_handler (int);
345 static void
346 __gnat_error_handler (int sig)
348 struct Exception_Data *exception;
349 const char *msg;
351 switch (sig)
353 case SIGSEGV:
354 /* FIXME: we need to detect the case of a *real* SIGSEGV */
355 exception = &storage_error;
356 msg = "stack overflow or erroneous memory access";
357 break;
359 case SIGBUS:
360 exception = &constraint_error;
361 msg = "SIGBUS";
362 break;
364 case SIGFPE:
365 exception = &constraint_error;
366 msg = "SIGFPE";
367 break;
369 default:
370 exception = &program_error;
371 msg = "unhandled signal";
374 Raise_From_Signal_Handler (exception, msg);
377 void
378 __gnat_install_handler (void)
380 struct sigaction act;
382 /* Set up signal handler to map synchronous signals to appropriate
383 exceptions. Make sure that the handler isn't interrupted by another
384 signal that might cause a scheduling event! */
386 act.sa_handler = __gnat_error_handler;
387 act.sa_flags = SA_NODEFER | SA_RESTART;
388 sigemptyset (&act.sa_mask);
390 /* Do not install handlers if interrupt state is "System" */
391 if (__gnat_get_interrupt_state (SIGABRT) != 's')
392 sigaction (SIGABRT, &act, NULL);
393 if (__gnat_get_interrupt_state (SIGFPE) != 's')
394 sigaction (SIGFPE, &act, NULL);
395 if (__gnat_get_interrupt_state (SIGILL) != 's')
396 sigaction (SIGILL, &act, NULL);
397 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
398 sigaction (SIGSEGV, &act, NULL);
399 if (__gnat_get_interrupt_state (SIGBUS) != 's')
400 sigaction (SIGBUS, &act, NULL);
402 __gnat_handler_installed = 1;
405 void
406 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
410 /***************************************/
411 /* __gnat_initialize (RTEMS version) */
412 /***************************************/
414 #elif defined(__rtems__)
416 extern void __gnat_install_handler (void);
418 /* For RTEMS, each bsp will provide a custom __gnat_install_handler (). */
420 void
421 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
423 __gnat_install_handler ();
426 /****************************************/
427 /* __gnat_initialize (Dec Unix Version) */
428 /****************************************/
430 #elif defined(__alpha__) && defined(__osf__) && ! defined(__alpha_vxworks)
432 /* Note: it seems that __osf__ is defined for the Alpha VXWorks case. Not
433 clear that this is reasonable, but in any case we have to be sure to
434 exclude this case in the above test. */
436 #include <signal.h>
437 #include <sys/siginfo.h>
439 static void __gnat_error_handler (int, siginfo_t *, struct sigcontext *);
440 extern char *__gnat_get_code_loc (struct sigcontext *);
441 extern void __gnat_enter_handler (struct sigcontext *, char *);
442 extern size_t __gnat_machine_state_length (void);
444 extern long exc_lookup_gp (char *);
445 extern void exc_resume (struct sigcontext *);
447 static void
448 __gnat_error_handler (int sig, siginfo_t *sip, struct sigcontext *context)
450 struct Exception_Data *exception;
451 static int recurse = 0;
452 struct sigcontext *mstate;
453 const char *msg;
455 /* If this was an explicit signal from a "kill", just resignal it. */
456 if (SI_FROMUSER (sip))
458 signal (sig, SIG_DFL);
459 kill (getpid(), sig);
462 /* Otherwise, treat it as something we handle. */
463 switch (sig)
465 case SIGSEGV:
466 /* If the problem was permissions, this is a constraint error.
467 Likewise if the failing address isn't maximally aligned or if
468 we've recursed.
470 ??? Using a static variable here isn't task-safe, but it's
471 much too hard to do anything else and we're just determining
472 which exception to raise. */
473 if (sip->si_code == SEGV_ACCERR
474 || (((long) sip->si_addr) & 3) != 0
475 || recurse)
477 exception = &constraint_error;
478 msg = "SIGSEGV";
480 else
482 /* See if the page before the faulting page is accessible. Do that
483 by trying to access it. We'd like to simply try to access
484 4096 + the faulting address, but it's not guaranteed to be
485 the actual address, just to be on the same page. */
486 recurse++;
487 ((volatile char *)
488 ((long) sip->si_addr & - getpagesize ()))[getpagesize ()];
489 msg = "stack overflow (or erroneous memory access)";
490 exception = &storage_error;
492 break;
494 case SIGBUS:
495 exception = &program_error;
496 msg = "SIGBUS";
497 break;
499 case SIGFPE:
500 exception = &constraint_error;
501 msg = "SIGFPE";
502 break;
504 default:
505 exception = &program_error;
506 msg = "unhandled signal";
509 recurse = 0;
510 mstate = (struct sigcontext *) (*Get_Machine_State_Addr) ();
511 if (mstate != 0)
512 *mstate = *context;
514 Raise_From_Signal_Handler (exception, (char *) msg);
517 void
518 __gnat_install_handler (void)
520 struct sigaction act;
522 /* Setup signal handler to map synchronous signals to appropriate
523 exceptions. Make sure that the handler isn't interrupted by another
524 signal that might cause a scheduling event! */
526 act.sa_handler = (void (*) (int)) __gnat_error_handler;
527 act.sa_flags = SA_RESTART | SA_NODEFER | SA_SIGINFO;
528 sigemptyset (&act.sa_mask);
530 /* Do not install handlers if interrupt state is "System" */
531 if (__gnat_get_interrupt_state (SIGABRT) != 's')
532 sigaction (SIGABRT, &act, NULL);
533 if (__gnat_get_interrupt_state (SIGFPE) != 's')
534 sigaction (SIGFPE, &act, NULL);
535 if (__gnat_get_interrupt_state (SIGILL) != 's')
536 sigaction (SIGILL, &act, NULL);
537 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
538 sigaction (SIGSEGV, &act, NULL);
539 if (__gnat_get_interrupt_state (SIGBUS) != 's')
540 sigaction (SIGBUS, &act, NULL);
542 __gnat_handler_installed = 1;
545 void
546 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
550 /* Routines called by s-mastop-tru64.adb. */
552 #define SC_GP 29
554 char *
555 __gnat_get_code_loc (struct sigcontext *context)
557 return (char *) context->sc_pc;
560 void
561 __gnat_enter_handler (struct sigcontext *context, char *pc)
563 context->sc_pc = (long) pc;
564 context->sc_regs[SC_GP] = exc_lookup_gp (pc);
565 exc_resume (context);
568 size_t
569 __gnat_machine_state_length (void)
571 return sizeof (struct sigcontext);
574 /************************************/
575 /* __gnat_initialize (HPUX Version) */
576 /************************************/
578 #elif defined (__hpux__)
580 #include <signal.h>
581 #include <sys/ucontext.h>
583 static void
584 __gnat_error_handler (int sig, siginfo_t *siginfo, void *ucontext);
586 /* __gnat_adjust_context_for_raise - see comments along with the default
587 version later in this file. */
589 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
591 void
592 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
594 mcontext_t *mcontext = &((ucontext_t *) ucontext)->uc_mcontext;
596 if (UseWideRegs (mcontext))
597 mcontext->ss_wide.ss_32.ss_pcoq_head_lo ++;
598 else
599 mcontext->ss_narrow.ss_pcoq_head ++;
602 static void
603 __gnat_error_handler (int sig, siginfo_t *siginfo, void *ucontext)
605 struct Exception_Data *exception;
606 char *msg;
608 switch (sig)
610 case SIGSEGV:
611 /* FIXME: we need to detect the case of a *real* SIGSEGV */
612 exception = &storage_error;
613 msg = "stack overflow or erroneous memory access";
614 break;
616 case SIGBUS:
617 exception = &constraint_error;
618 msg = "SIGBUS";
619 break;
621 case SIGFPE:
622 exception = &constraint_error;
623 msg = "SIGFPE";
624 break;
626 default:
627 exception = &program_error;
628 msg = "unhandled signal";
631 __gnat_adjust_context_for_raise (sig, ucontext);
633 Raise_From_Signal_Handler (exception, msg);
636 void
637 __gnat_install_handler (void)
639 struct sigaction act;
641 /* Set up signal handler to map synchronous signals to appropriate
642 exceptions. Make sure that the handler isn't interrupted by another
643 signal that might cause a scheduling event! Also setup an alternate
644 stack region for the handler execution so that stack overflows can be
645 handled properly, avoiding a SEGV generation from stack usage by the
646 handler itself. */
648 static char handler_stack[SIGSTKSZ*2];
649 /* SIGSTKSZ appeared to be "short" for the needs in some contexts
650 (e.g. experiments with GCC ZCX exceptions). */
652 stack_t stack;
654 stack.ss_sp = handler_stack;
655 stack.ss_size = sizeof (handler_stack);
656 stack.ss_flags = 0;
658 sigaltstack (&stack, NULL);
660 act.sa_sigaction = __gnat_error_handler;
661 act.sa_flags = SA_NODEFER | SA_RESTART | SA_ONSTACK | SA_SIGINFO;
662 sigemptyset (&act.sa_mask);
664 /* Do not install handlers if interrupt state is "System" */
665 if (__gnat_get_interrupt_state (SIGABRT) != 's')
666 sigaction (SIGABRT, &act, NULL);
667 if (__gnat_get_interrupt_state (SIGFPE) != 's')
668 sigaction (SIGFPE, &act, NULL);
669 if (__gnat_get_interrupt_state (SIGILL) != 's')
670 sigaction (SIGILL, &act, NULL);
671 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
672 sigaction (SIGSEGV, &act, NULL);
673 if (__gnat_get_interrupt_state (SIGBUS) != 's')
674 sigaction (SIGBUS, &act, NULL);
676 __gnat_handler_installed = 1;
679 void
680 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
684 /*****************************************/
685 /* __gnat_initialize (GNU/Linux Version) */
686 /*****************************************/
688 #elif defined (linux) && defined (i386) && !defined (__RT__)
690 #include <signal.h>
691 #include <asm/sigcontext.h>
693 /* GNU/Linux, which uses glibc, does not define NULL in included
694 header files */
696 #if !defined (NULL)
697 #define NULL ((void *) 0)
698 #endif
700 struct Machine_State
702 unsigned long eip;
703 unsigned long ebx;
704 unsigned long esp;
705 unsigned long ebp;
706 unsigned long esi;
707 unsigned long edi;
710 static void __gnat_error_handler (int);
712 static void
713 __gnat_error_handler (int sig)
715 struct Exception_Data *exception;
716 const char *msg;
717 static int recurse = 0;
719 struct sigcontext *info
720 = (struct sigcontext *) (((char *) &sig) + sizeof (int));
722 /* The Linux kernel does not document how to get the machine state in a
723 signal handler, but in fact the necessary data is in a sigcontext_struct
724 value that is on the stack immediately above the signal number
725 parameter, and the above messing accesses this value on the stack. */
727 struct Machine_State *mstate;
729 switch (sig)
731 case SIGSEGV:
732 /* If the problem was permissions, this is a constraint error.
733 Likewise if the failing address isn't maximally aligned or if
734 we've recursed.
736 ??? Using a static variable here isn't task-safe, but it's
737 much too hard to do anything else and we're just determining
738 which exception to raise. */
739 if (recurse)
741 exception = &constraint_error;
742 msg = "SIGSEGV";
744 else
746 /* Here we would like a discrimination test to see whether the
747 page before the faulting address is accessible. Unfortunately
748 Linux seems to have no way of giving us the faulting address.
750 In versions of a-init.c before 1.95, we had a test of the page
751 before the stack pointer using:
753 recurse++;
754 ((volatile char *)
755 ((long) info->esp_at_signal & - getpagesize ()))[getpagesize ()];
757 but that's wrong, since it tests the stack pointer location, and
758 the current stack probe code does not move the stack pointer
759 until all probes succeed.
761 For now we simply do not attempt any discrimination at all. Note
762 that this is quite acceptable, since a "real" SIGSEGV can only
763 occur as the result of an erroneous program */
765 msg = "stack overflow (or erroneous memory access)";
766 exception = &storage_error;
768 break;
770 case SIGBUS:
771 exception = &constraint_error;
772 msg = "SIGBUS";
773 break;
775 case SIGFPE:
776 exception = &constraint_error;
777 msg = "SIGFPE";
778 break;
780 default:
781 exception = &program_error;
782 msg = "unhandled signal";
785 mstate = (*Get_Machine_State_Addr) ();
786 if (mstate)
788 mstate->eip = info->eip;
789 mstate->ebx = info->ebx;
790 mstate->esp = info->esp_at_signal;
791 mstate->ebp = info->ebp;
792 mstate->esi = info->esi;
793 mstate->edi = info->edi;
796 recurse = 0;
797 Raise_From_Signal_Handler (exception, msg);
800 void
801 __gnat_install_handler (void)
803 struct sigaction act;
805 /* Set up signal handler to map synchronous signals to appropriate
806 exceptions. Make sure that the handler isn't interrupted by another
807 signal that might cause a scheduling event! */
809 act.sa_handler = __gnat_error_handler;
810 act.sa_flags = SA_NODEFER | SA_RESTART;
811 sigemptyset (&act.sa_mask);
813 /* Do not install handlers if interrupt state is "System" */
814 if (__gnat_get_interrupt_state (SIGABRT) != 's')
815 sigaction (SIGABRT, &act, NULL);
816 if (__gnat_get_interrupt_state (SIGFPE) != 's')
817 sigaction (SIGFPE, &act, NULL);
818 if (__gnat_get_interrupt_state (SIGILL) != 's')
819 sigaction (SIGILL, &act, NULL);
820 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
821 sigaction (SIGSEGV, &act, NULL);
822 if (__gnat_get_interrupt_state (SIGBUS) != 's')
823 sigaction (SIGBUS, &act, NULL);
825 __gnat_handler_installed = 1;
828 void
829 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
833 /******************************************/
834 /* __gnat_initialize (NT-mingw32 Version) */
835 /******************************************/
837 #elif defined (__MINGW32__)
838 #include <windows.h>
840 void
841 __gnat_install_handler (void)
845 void
846 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
848 /* Initialize floating-point coprocessor. This call is needed because
849 the MS libraries default to 64-bit precision instead of 80-bit
850 precision, and we require the full precision for proper operation,
851 given that we have set Max_Digits etc with this in mind */
852 __gnat_init_float ();
854 /* Initialize a lock for a process handle list - see a-adaint.c for the
855 implementation of __gnat_portable_no_block_spawn, __gnat_portable_wait */
856 __gnat_plist_init();
858 /* Note that we do not activate this for the compiler itself to avoid a
859 bootstrap path problem. Older version of gnatbind will generate a call
860 to __gnat_initialize() without argument. Therefore we cannot use eh in
861 this case. It will be possible to remove the following #ifdef at some
862 point. */
863 #ifdef IN_RTS
864 /* Install the Structured Exception handler. */
865 if (eh)
866 __gnat_install_SEH_handler (eh);
867 #endif
870 /***************************************/
871 /* __gnat_initialize (Interix Version) */
872 /***************************************/
874 #elif defined (__INTERIX)
876 #include <signal.h>
878 static void __gnat_error_handler (int);
880 static void
881 __gnat_error_handler (int sig)
883 struct Exception_Data *exception;
884 char *msg;
886 switch (sig)
888 case SIGSEGV:
889 exception = &storage_error;
890 msg = "stack overflow or erroneous memory access";
891 break;
893 case SIGBUS:
894 exception = &constraint_error;
895 msg = "SIGBUS";
896 break;
898 case SIGFPE:
899 exception = &constraint_error;
900 msg = "SIGFPE";
901 break;
903 default:
904 exception = &program_error;
905 msg = "unhandled signal";
908 Raise_From_Signal_Handler (exception, msg);
911 void
912 __gnat_install_handler (void)
914 struct sigaction act;
916 /* Set up signal handler to map synchronous signals to appropriate
917 exceptions. Make sure that the handler isn't interrupted by another
918 signal that might cause a scheduling event! */
920 act.sa_handler = __gnat_error_handler;
921 act.sa_flags = 0;
922 sigemptyset (&act.sa_mask);
924 /* Handlers for signals besides SIGSEGV cause c974013 to hang */
925 /* sigaction (SIGILL, &act, NULL); */
926 /* sigaction (SIGABRT, &act, NULL); */
927 /* sigaction (SIGFPE, &act, NULL); */
928 /* sigaction (SIGBUS, &act, NULL); */
930 /* Do not install handlers if interrupt state is "System" */
931 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
932 sigaction (SIGSEGV, &act, NULL);
934 __gnat_handler_installed = 1;
937 void
938 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
940 __gnat_init_float ();
943 /**************************************/
944 /* __gnat_initialize (LynxOS Version) */
945 /**************************************/
947 #elif defined (__Lynx__)
949 void
950 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
952 __gnat_init_float ();
955 /*********************************/
956 /* __gnat_install_handler (Lynx) */
957 /*********************************/
959 void
960 __gnat_install_handler (void)
962 __gnat_handler_installed = 1;
965 /****************************/
966 /* __gnat_initialize (OS/2) */
967 /****************************/
969 #elif defined (__EMX__) /* OS/2 dependent initialization */
971 void
972 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
976 /*********************************/
977 /* __gnat_install_handler (OS/2) */
978 /*********************************/
980 void
981 __gnat_install_handler (void)
983 __gnat_handler_installed = 1;
986 /***********************************/
987 /* __gnat_initialize (SGI Version) */
988 /***********************************/
990 #elif defined (sgi)
992 #include <signal.h>
993 #include <siginfo.h>
995 #ifndef NULL
996 #define NULL 0
997 #endif
999 #define SIGADAABORT 48
1000 #define SIGNAL_STACK_SIZE 4096
1001 #define SIGNAL_STACK_ALIGNMENT 64
1003 struct Machine_State
1005 sigcontext_t context;
1008 static void __gnat_error_handler (int, int, sigcontext_t *);
1010 /* We are not setting the SA_SIGINFO bit in the sigaction flags when
1011 connecting that handler, with the effects described in the sigaction
1012 man page:
1014 SA_SIGINFO [...]
1015 If cleared and the signal is caught, the first argument is
1016 also the signal number but the second argument is the signal
1017 code identifying the cause of the signal. The third argument
1018 points to a sigcontext_t structure containing the receiving
1019 process's context when the signal was delivered.
1022 static void
1023 __gnat_error_handler (int sig, int code, sigcontext_t *sc)
1025 struct Machine_State *mstate;
1026 struct Exception_Data *exception;
1027 const char *msg;
1029 switch (sig)
1031 case SIGSEGV:
1032 if (code == EFAULT)
1034 exception = &program_error;
1035 msg = "SIGSEGV: (Invalid virtual address)";
1037 else if (code == ENXIO)
1039 exception = &program_error;
1040 msg = "SIGSEGV: (Read beyond mapped object)";
1042 else if (code == ENOSPC)
1044 exception = &program_error; /* ??? storage_error ??? */
1045 msg = "SIGSEGV: (Autogrow for file failed)";
1047 else if (code == EACCES || code == EEXIST)
1049 /* ??? We handle stack overflows here, some of which do trigger
1050 SIGSEGV + EEXIST on Irix 6.5 although EEXIST is not part of
1051 the documented valid codes for SEGV in the signal(5) man
1052 page. */
1054 /* ??? Re-add smarts to further verify that we launched
1055 the stack into a guard page, not an attempt to
1056 write to .text or something */
1057 exception = &storage_error;
1058 msg = "SIGSEGV: (stack overflow or erroneous memory access)";
1060 else
1062 /* Just in case the OS guys did it to us again. Sometimes
1063 they fail to document all of the valid codes that are
1064 passed to signal handlers, just in case someone depends
1065 on knowing all the codes */
1066 exception = &program_error;
1067 msg = "SIGSEGV: (Undocumented reason)";
1069 break;
1071 case SIGBUS:
1072 /* Map all bus errors to Program_Error. */
1073 exception = &program_error;
1074 msg = "SIGBUS";
1075 break;
1077 case SIGFPE:
1078 /* Map all fpe errors to Constraint_Error. */
1079 exception = &constraint_error;
1080 msg = "SIGFPE";
1081 break;
1083 case SIGADAABORT:
1084 if ((*Check_Abort_Status) ())
1086 exception = &_abort_signal;
1087 msg = "";
1089 else
1090 return;
1092 break;
1094 default:
1095 /* Everything else is a Program_Error. */
1096 exception = &program_error;
1097 msg = "unhandled signal";
1100 mstate = (*Get_Machine_State_Addr) ();
1101 if (mstate != 0)
1102 memcpy ((void *) mstate, (const void *) sc, sizeof (sigcontext_t));
1104 Raise_From_Signal_Handler (exception, msg);
1107 void
1108 __gnat_install_handler (void)
1110 struct sigaction act;
1112 /* Setup signal handler to map synchronous signals to appropriate
1113 exceptions. Make sure that the handler isn't interrupted by another
1114 signal that might cause a scheduling event! */
1116 act.sa_handler = __gnat_error_handler;
1117 act.sa_flags = SA_NODEFER + SA_RESTART;
1118 sigfillset (&act.sa_mask);
1119 sigemptyset (&act.sa_mask);
1121 /* Do not install handlers if interrupt state is "System" */
1122 if (__gnat_get_interrupt_state (SIGABRT) != 's')
1123 sigaction (SIGABRT, &act, NULL);
1124 if (__gnat_get_interrupt_state (SIGFPE) != 's')
1125 sigaction (SIGFPE, &act, NULL);
1126 if (__gnat_get_interrupt_state (SIGILL) != 's')
1127 sigaction (SIGILL, &act, NULL);
1128 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1129 sigaction (SIGSEGV, &act, NULL);
1130 if (__gnat_get_interrupt_state (SIGBUS) != 's')
1131 sigaction (SIGBUS, &act, NULL);
1132 if (__gnat_get_interrupt_state (SIGADAABORT) != 's')
1133 sigaction (SIGADAABORT, &act, NULL);
1135 __gnat_handler_installed = 1;
1138 void
1139 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
1143 /*************************************************/
1144 /* __gnat_initialize (Solaris and SunOS Version) */
1145 /*************************************************/
1147 #elif defined (sun) && defined (__SVR4) && !defined (__vxworks)
1149 #include <signal.h>
1150 #include <siginfo.h>
1152 static void __gnat_error_handler (int, siginfo_t *);
1154 static void
1155 __gnat_error_handler (int sig, siginfo_t *sip)
1157 struct Exception_Data *exception;
1158 static int recurse = 0;
1159 const char *msg;
1161 /* If this was an explicit signal from a "kill", just resignal it. */
1162 if (SI_FROMUSER (sip))
1164 signal (sig, SIG_DFL);
1165 kill (getpid(), sig);
1168 /* Otherwise, treat it as something we handle. */
1169 switch (sig)
1171 case SIGSEGV:
1172 /* If the problem was permissions, this is a constraint error.
1173 Likewise if the failing address isn't maximally aligned or if
1174 we've recursed.
1176 ??? Using a static variable here isn't task-safe, but it's
1177 much too hard to do anything else and we're just determining
1178 which exception to raise. */
1179 if (sip->si_code == SEGV_ACCERR
1180 || (((long) sip->si_addr) & 3) != 0
1181 || recurse)
1183 exception = &constraint_error;
1184 msg = "SIGSEGV";
1186 else
1188 /* See if the page before the faulting page is accessible. Do that
1189 by trying to access it. We'd like to simply try to access
1190 4096 + the faulting address, but it's not guaranteed to be
1191 the actual address, just to be on the same page. */
1192 recurse++;
1193 ((volatile char *)
1194 ((long) sip->si_addr & - getpagesize ()))[getpagesize ()];
1195 exception = &storage_error;
1196 msg = "stack overflow (or erroneous memory access)";
1198 break;
1200 case SIGBUS:
1201 exception = &program_error;
1202 msg = "SIGBUS";
1203 break;
1205 case SIGFPE:
1206 exception = &constraint_error;
1207 msg = "SIGFPE";
1208 break;
1210 default:
1211 exception = &program_error;
1212 msg = "unhandled signal";
1215 recurse = 0;
1217 Raise_From_Signal_Handler (exception, msg);
1220 void
1221 __gnat_install_handler (void)
1223 struct sigaction act;
1225 /* Set up signal handler to map synchronous signals to appropriate
1226 exceptions. Make sure that the handler isn't interrupted by another
1227 signal that might cause a scheduling event! */
1229 act.sa_handler = __gnat_error_handler;
1230 act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
1231 sigemptyset (&act.sa_mask);
1233 /* Do not install handlers if interrupt state is "System" */
1234 if (__gnat_get_interrupt_state (SIGABRT) != 's')
1235 sigaction (SIGABRT, &act, NULL);
1236 if (__gnat_get_interrupt_state (SIGFPE) != 's')
1237 sigaction (SIGFPE, &act, NULL);
1238 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1239 sigaction (SIGSEGV, &act, NULL);
1240 if (__gnat_get_interrupt_state (SIGBUS) != 's')
1241 sigaction (SIGBUS, &act, NULL);
1243 __gnat_handler_installed = 1;
1246 void
1247 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
1251 /***********************************/
1252 /* __gnat_initialize (VMS Version) */
1253 /***********************************/
1255 #elif defined (VMS)
1257 #ifdef __IA64
1258 #define lib_get_curr_invo_context LIB$I64_GET_CURR_INVO_CONTEXT
1259 #define lib_get_prev_invo_context LIB$I64_GET_PREV_INVO_CONTEXT
1260 #define lib_get_invo_handle LIB$I64_GET_INVO_HANDLE
1261 #else
1262 #define lib_get_curr_invo_context LIB$GET_CURR_INVO_CONTEXT
1263 #define lib_get_prev_invo_context LIB$GET_PREV_INVO_CONTEXT
1264 #define lib_get_invo_handle LIB$GET_INVO_HANDLE
1265 #endif
1267 #if defined (IN_RTS) && !defined (__IA64)
1269 /* The prehandler actually gets control first on a condition. It swaps the
1270 stack pointer and calls the handler (__gnat_error_handler). */
1271 extern long __gnat_error_prehandler (void);
1273 extern char *__gnat_error_prehandler_stack; /* Alternate signal stack */
1274 #endif
1276 /* Conditions that don't have an Ada exception counterpart must raise
1277 Non_Ada_Error. Since this is defined in s-auxdec, it should only be
1278 referenced by user programs, not the compiler or tools. Hence the
1279 #ifdef IN_RTS. */
1281 #ifdef IN_RTS
1282 #define Non_Ada_Error system__aux_dec__non_ada_error
1283 extern struct Exception_Data Non_Ada_Error;
1285 #define Coded_Exception system__vms_exception_table__coded_exception
1286 extern struct Exception_Data *Coded_Exception (Exception_Code);
1288 #define Base_Code_In system__vms_exception_table__base_code_in
1289 extern Exception_Code Base_Code_In (Exception_Code);
1290 #endif
1292 /* Define macro symbols for the VMS conditions that become Ada exceptions.
1293 Most of these are also defined in the header file ssdef.h which has not
1294 yet been converted to be recognized by Gnu C. Some, which couldn't be
1295 located, are assigned names based on the DEC test suite tests which
1296 raise them. */
1298 #define SS$_ACCVIO 12
1299 #define SS$_DEBUG 1132
1300 #define SS$_INTDIV 1156
1301 #define SS$_HPARITH 1284
1302 #define SS$_STKOVF 1364
1303 #define SS$_RESIGNAL 2328
1304 #define MTH$_FLOOVEMAT 1475268 /* Some ACVC_21 CXA tests */
1305 #define SS$_CE24VRU 3253636 /* Write to unopened file */
1306 #define SS$_C980VTE 3246436 /* AST requests time slice */
1307 #define CMA$_EXIT_THREAD 4227492
1308 #define CMA$_EXCCOPLOS 4228108
1309 #define CMA$_ALERTED 4227460
1311 struct descriptor_s {unsigned short len, mbz; char *adr; };
1313 long __gnat_error_handler (int *, void *);
1315 /* To deal with VMS conditions and their mapping to Ada exceptions,
1316 the __gnat_error_handler routine below is installed as an exception
1317 vector having precedence over DEC frame handlers. Some conditions
1318 still need to be handled by such handlers, however, in which case
1319 __gnat_error_handler needs to return SS$_RESIGNAL. Consider for
1320 instance the use of a third party library compiled with DECAda and
1321 performing its own exception handling internally.
1323 To allow some user-level flexibility, which conditions should be
1324 resignaled is controlled by a predicate function, provided with the
1325 condition value and returning a boolean indication stating whether
1326 this condition should be resignaled or not.
1328 That predicate function is called indirectly, via a function pointer,
1329 by __gnat_error_handler, and changing that pointer is allowed to the
1330 the user code by way of the __gnat_set_resignal_predicate interface.
1332 The user level function may then implement what it likes, including
1333 for instance the maintenance of a dynamic data structure if the set
1334 of to be resignalled conditions has to change over the program's
1335 lifetime.
1337 ??? This is not a perfect solution to deal with the possible
1338 interactions between the GNAT and the DECAda exception handling
1339 models and better (more general) schemes are studied. This is so
1340 just provided as a convenient workaround in the meantime, and
1341 should be use with caution since the implementation has been kept
1342 very simple. */
1344 typedef int
1345 resignal_predicate (int code);
1347 /* Default GNAT predicate for resignaling conditions. */
1349 static int
1350 __gnat_default_resignal_p (int code)
1352 return
1353 code == CMA$_EXIT_THREAD
1354 || code == SS$_DEBUG /* Gdb attach, resignal to merge activate gdbstub. */
1355 || code == 1409786 /* Nickerson bug #33 ??? */
1356 || code == 1381050 /* Nickerson bug #33 ??? */
1357 || code == 20480426 /* RDB-E-STREAM_EOF */
1358 || code == 11829410 /* Resignalled as Use_Error for CE10VRC */
1362 /* Static pointer to predicate that the __gnat_error_handler exception
1363 vector invokes to determine if it should resignal a condition. */
1365 static resignal_predicate * __gnat_resignal_p = __gnat_default_resignal_p;
1367 /* User interface to change the predicate pointer to PREDICATE. Reset to
1368 the default if PREDICATE is null. */
1370 void
1371 __gnat_set_resignal_predicate (resignal_predicate * predicate)
1373 if (predicate == 0)
1374 __gnat_resignal_p = __gnat_default_resignal_p;
1375 else
1376 __gnat_resignal_p = predicate;
1379 long
1380 __gnat_error_handler (int *sigargs, void *mechargs)
1382 struct Exception_Data *exception = 0;
1383 Exception_Code base_code;
1385 char *msg = "";
1386 char message[256];
1387 long prvhnd;
1388 struct descriptor_s msgdesc;
1389 int msg_flag = 0x000f; /* 1 bit for each of the four message parts */
1390 unsigned short outlen;
1391 char curr_icb[544];
1392 long curr_invo_handle;
1393 long *mstate;
1395 /* Check for conditions to resignal which aren't effected by pragma
1396 Import_Exception. */
1397 if (__gnat_resignal_p (sigargs [1]))
1398 return SS$_RESIGNAL;
1400 #ifdef IN_RTS
1401 /* See if it's an imported exception. Beware that registered exceptions
1402 are bound to their base code, with the severity bits masked off. */
1403 base_code = Base_Code_In ((Exception_Code) sigargs [1]);
1404 exception = Coded_Exception (base_code);
1406 if (exception)
1408 msgdesc.len = 256;
1409 msgdesc.mbz = 0;
1410 msgdesc.adr = message;
1411 SYS$GETMSG (sigargs[1], &outlen, &msgdesc, msg_flag, 0);
1412 message[outlen] = 0;
1413 msg = message;
1415 exception->Name_Length = 19;
1416 /* The full name really should be get sys$getmsg returns. ??? */
1417 exception->Full_Name = "IMPORTED_EXCEPTION";
1418 exception->Import_Code = base_code;
1420 #endif
1422 if (exception == 0)
1423 switch (sigargs[1])
1425 case SS$_ACCVIO:
1426 if (sigargs[3] == 0)
1428 exception = &constraint_error;
1429 msg = "access zero";
1431 else
1433 exception = &storage_error;
1434 msg = "stack overflow (or erroneous memory access)";
1436 break;
1438 case SS$_STKOVF:
1439 exception = &storage_error;
1440 msg = "stack overflow";
1441 break;
1443 case SS$_INTDIV:
1444 exception = &constraint_error;
1445 msg = "division by zero";
1446 break;
1448 case SS$_HPARITH:
1449 #ifndef IN_RTS
1450 return SS$_RESIGNAL; /* toplev.c handles for compiler */
1451 #else
1453 exception = &constraint_error;
1454 msg = "arithmetic error";
1456 #endif
1457 break;
1459 case MTH$_FLOOVEMAT:
1460 exception = &constraint_error;
1461 msg = "floating overflow in math library";
1462 break;
1464 case SS$_CE24VRU:
1465 exception = &constraint_error;
1466 msg = "";
1467 break;
1469 case SS$_C980VTE:
1470 exception = &program_error;
1471 msg = "";
1472 break;
1474 default:
1475 #ifndef IN_RTS
1476 exception = &program_error;
1477 #else
1478 /* User programs expect Non_Ada_Error to be raised, reference
1479 DEC Ada test CXCONDHAN. */
1480 exception = &Non_Ada_Error;
1481 #endif
1482 msgdesc.len = 256;
1483 msgdesc.mbz = 0;
1484 msgdesc.adr = message;
1485 SYS$GETMSG (sigargs[1], &outlen, &msgdesc, msg_flag, 0);
1486 message[outlen] = 0;
1487 msg = message;
1488 break;
1491 mstate = (long *) (*Get_Machine_State_Addr) ();
1492 if (mstate != 0)
1494 lib_get_curr_invo_context (&curr_icb);
1495 lib_get_prev_invo_context (&curr_icb);
1496 lib_get_prev_invo_context (&curr_icb);
1497 curr_invo_handle = lib_get_invo_handle (&curr_icb);
1498 *mstate = curr_invo_handle;
1500 Raise_From_Signal_Handler (exception, msg);
1503 void
1504 __gnat_install_handler (void)
1506 long prvhnd;
1507 #if defined (IN_RTS) && !defined (__IA64)
1508 char *c;
1510 c = (char *) xmalloc (2049);
1512 __gnat_error_prehandler_stack = &c[2048];
1514 /* __gnat_error_prehandler is an assembly function. */
1515 SYS$SETEXV (1, __gnat_error_prehandler, 3, &prvhnd);
1516 #else
1517 SYS$SETEXV (1, __gnat_error_handler, 3, &prvhnd);
1518 #endif
1519 __gnat_handler_installed = 1;
1522 void
1523 __gnat_initialize(void *eh ATTRIBUTE_UNUSED)
1527 /*************************************************/
1528 /* __gnat_initialize (FreeBSD version) */
1529 /*************************************************/
1531 #elif defined (__FreeBSD__)
1533 #include <signal.h>
1534 #include <unistd.h>
1536 static void __gnat_error_handler (int, int, struct sigcontext *);
1538 static void
1539 __gnat_error_handler (int sig, int code __attribute__ ((unused)),
1540 struct sigcontext *sc __attribute__ ((unused)))
1542 struct Exception_Data *exception;
1543 const char *msg;
1545 switch (sig)
1547 case SIGFPE:
1548 exception = &constraint_error;
1549 msg = "SIGFPE";
1550 break;
1552 case SIGILL:
1553 exception = &constraint_error;
1554 msg = "SIGILL";
1555 break;
1557 case SIGSEGV:
1558 exception = &storage_error;
1559 msg = "stack overflow or erroneous memory access";
1560 break;
1562 case SIGBUS:
1563 exception = &constraint_error;
1564 msg = "SIGBUS";
1565 break;
1567 default:
1568 exception = &program_error;
1569 msg = "unhandled signal";
1572 Raise_From_Signal_Handler (exception, msg);
1575 void
1576 __gnat_install_handler ()
1578 struct sigaction act;
1580 /* Set up signal handler to map synchronous signals to appropriate
1581 exceptions. Make sure that the handler isn't interrupted by another
1582 signal that might cause a scheduling event! */
1584 act.sa_handler = __gnat_error_handler;
1585 act.sa_flags = SA_NODEFER | SA_RESTART;
1586 (void) sigemptyset (&act.sa_mask);
1588 (void) sigaction (SIGILL, &act, NULL);
1589 (void) sigaction (SIGFPE, &act, NULL);
1590 (void) sigaction (SIGSEGV, &act, NULL);
1591 (void) sigaction (SIGBUS, &act, NULL);
1594 void
1595 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
1597 __gnat_install_handler ();
1599 /* XXX - Initialize floating-point coprocessor. This call is
1600 needed because FreeBSD defaults to 64-bit precision instead
1601 of 80-bit precision? We require the full precision for
1602 proper operation, given that we have set Max_Digits etc
1603 with this in mind */
1604 __gnat_init_float ();
1607 /***************************************/
1608 /* __gnat_initialize (VXWorks Version) */
1609 /***************************************/
1611 #elif defined(__vxworks)
1613 #include <signal.h>
1614 #include <taskLib.h>
1615 #include <intLib.h>
1616 #include <iv.h>
1618 #ifdef VTHREADS
1619 #include "private/vThreadsP.h"
1620 #endif
1622 extern int __gnat_inum_to_ivec (int);
1623 static void __gnat_error_handler (int, int, struct sigcontext *);
1624 void __gnat_map_signal (int);
1626 #ifndef __alpha_vxworks
1628 /* getpid is used by s-parint.adb, but is not defined by VxWorks, except
1629 on Alpha VxWorks */
1631 extern long getpid (void);
1633 long
1634 getpid (void)
1636 return taskIdSelf ();
1638 #endif
1640 /* This is needed by the GNAT run time to handle Vxworks interrupts */
1642 __gnat_inum_to_ivec (int num)
1644 return INUM_TO_IVEC (num);
1647 /* VxWorks expects the field excCnt to be zeroed when a signal is handled.
1648 The VxWorks version of longjmp does this; gcc's builtin_longjmp does not */
1649 void
1650 __gnat_clear_exception_count (void)
1652 #ifdef VTHREADS
1653 WIND_TCB *currentTask = (WIND_TCB *) taskIdSelf();
1655 currentTask->vThreads.excCnt = 0;
1656 #endif
1659 /* Exported to 5zintman.adb in order to handle different signal
1660 to exception mappings in different VxWorks versions */
1661 void
1662 __gnat_map_signal (int sig)
1664 struct Exception_Data *exception;
1665 char *msg;
1667 switch (sig)
1669 case SIGFPE:
1670 exception = &constraint_error;
1671 msg = "SIGFPE";
1672 break;
1673 #ifdef VTHREADS
1674 case SIGILL:
1675 exception = &constraint_error;
1676 msg = "Floating point exception or SIGILL";
1677 break;
1678 case SIGSEGV:
1679 exception = &storage_error;
1680 msg = "SIGSEGV: possible stack overflow";
1681 break;
1682 case SIGBUS:
1683 exception = &storage_error;
1684 msg = "SIGBUS: possible stack overflow";
1685 break;
1686 #else
1687 case SIGILL:
1688 exception = &constraint_error;
1689 msg = "SIGILL";
1690 break;
1691 case SIGSEGV:
1692 exception = &program_error;
1693 msg = "SIGSEGV";
1694 break;
1695 case SIGBUS:
1696 exception = &program_error;
1697 msg = "SIGBUS";
1698 break;
1699 #endif
1700 default:
1701 exception = &program_error;
1702 msg = "unhandled signal";
1705 __gnat_clear_exception_count ();
1706 Raise_From_Signal_Handler (exception, msg);
1709 static void
1710 __gnat_error_handler (int sig, int code, struct sigcontext *sc)
1712 sigset_t mask;
1713 int result;
1715 /* VxWorks will always mask out the signal during the signal handler and
1716 will reenable it on a longjmp. GNAT does not generate a longjmp to
1717 return from a signal handler so the signal will still be masked unless
1718 we unmask it. */
1719 sigprocmask (SIG_SETMASK, NULL, &mask);
1720 sigdelset (&mask, sig);
1721 sigprocmask (SIG_SETMASK, &mask, NULL);
1723 __gnat_map_signal (sig);
1727 void
1728 __gnat_install_handler (void)
1730 struct sigaction act;
1732 /* Setup signal handler to map synchronous signals to appropriate
1733 exceptions. Make sure that the handler isn't interrupted by another
1734 signal that might cause a scheduling event! */
1736 act.sa_handler = __gnat_error_handler;
1737 act.sa_flags = SA_SIGINFO | SA_ONSTACK;
1738 sigemptyset (&act.sa_mask);
1740 /* For VxWorks, install all signal handlers, since pragma Interrupt_State
1741 applies to vectored hardware interrupts, not signals */
1742 sigaction (SIGFPE, &act, NULL);
1743 sigaction (SIGILL, &act, NULL);
1744 sigaction (SIGSEGV, &act, NULL);
1745 sigaction (SIGBUS, &act, NULL);
1747 __gnat_handler_installed = 1;
1750 #define HAVE_GNAT_INIT_FLOAT
1752 void
1753 __gnat_init_float (void)
1755 /* Disable overflow/underflow exceptions on the PPC processor, this is needed
1756 to get correct Ada semantics. Note that for AE653 vThreads, the HW
1757 overflow settings are an OS configuration issue. The instructions
1758 below have no effect */
1759 #if defined (_ARCH_PPC) && !defined (_SOFT_FLOAT) && !defined (VTHREADS)
1760 asm ("mtfsb0 25");
1761 asm ("mtfsb0 26");
1762 #endif
1764 /* Similarly for sparc64. Achieved by masking bits in the Trap Enable Mask
1765 field of the Floating-point Status Register (see the Sparc Architecture
1766 Manual Version 9, p 48). */
1767 #if defined (sparc64)
1769 #define FSR_TEM_NVM (1 << 27) /* Invalid operand */
1770 #define FSR_TEM_OFM (1 << 26) /* Overflow */
1771 #define FSR_TEM_UFM (1 << 25) /* Underflow */
1772 #define FSR_TEM_DZM (1 << 24) /* Division by Zero */
1773 #define FSR_TEM_NXM (1 << 23) /* Inexact result */
1775 unsigned int fsr;
1777 __asm__("st %%fsr, %0" : "=m" (fsr));
1778 fsr &= ~(FSR_TEM_OFM | FSR_TEM_UFM);
1779 __asm__("ld %0, %%fsr" : : "m" (fsr));
1781 #endif
1784 void
1785 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
1787 __gnat_init_float ();
1789 /* On targets where we might be using the ZCX scheme, we need to register
1790 the frame tables.
1792 For applications loaded as a set of "modules", the crtstuff objects
1793 linked in (crtbegin/end) are tailored to provide this service a-la C++
1794 constructor fashion, typically triggered by the VxWorks loader. This is
1795 achieved by way of a special variable declaration in the crt object, the
1796 name of which has been deduced by analyzing the output of the "munching"
1797 step documented for C++. The de-registration is handled symmetrically,
1798 a-la C++ destructor fashion and typically triggered by the dynamic
1799 unloader. Note that since the tables shall be registered against a
1800 common datastructure, libgcc should be one of the modules (vs being
1801 partially linked against all the others at build time) and shall be
1802 loaded first.
1804 For applications linked with the kernel, the scheme above would lead to
1805 duplicated symbols because the VxWorks kernel build "munches" by default.
1806 To prevent those conflicts, we link against crtbegin/endS objects that
1807 don't include the special variable and directly call the appropriate
1808 function here. We'll never unload that, so there is no de-registration to
1809 worry about.
1811 For whole applications loaded as a single module, we may use one scheme
1812 or the other, except for the mixed Ada/C++ case in which the first scheme
1813 would fail for the same reason as in the linked-with-kernel situation.
1815 We can differentiate by looking at the __module_has_ctors value provided
1816 by each class of crt objects. As of today, selecting the crt set with the
1817 ctors/dtors capabilities (first scheme above) is triggered by adding
1818 "-dynamic" to the gcc *link* command line options. Selecting the other
1819 set of crt objects is achieved by "-static" instead.
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 (__GNUC__ >= 3) && (defined (_ARCH_PPC) || defined (__ppc))
1827 /* The scheme described above is only useful for the actual ZCX case, and
1828 we don't want any reference to the crt provided symbols otherwise. We
1829 may not link with any of the crt objects in the non-ZCX case, e.g. from
1830 documented procedures instructing the use of -nostdlib, and references
1831 to the ctors symbols here would just remain unsatisfied.
1833 We have no way to avoid those references in the right conditions in this
1834 C module, because we have nothing like a IN_ZCX_RTS macro. This aspect
1835 is then deferred to an Ada routine, which can do that based on a test
1836 against a constant System flag value. */
1838 extern void __gnat_vxw_setup_for_eh (void);
1839 __gnat_vxw_setup_for_eh ();
1841 #endif
1844 /********************************/
1845 /* __gnat_initialize for NetBSD */
1846 /********************************/
1848 #elif defined(__NetBSD__)
1850 #include <signal.h>
1851 #include <unistd.h>
1853 static void
1854 __gnat_error_handler (int sig)
1856 struct Exception_Data *exception;
1857 const char *msg;
1859 switch(sig)
1861 case SIGFPE:
1862 exception = &constraint_error;
1863 msg = "SIGFPE";
1864 break;
1865 case SIGILL:
1866 exception = &constraint_error;
1867 msg = "SIGILL";
1868 break;
1869 case SIGSEGV:
1870 exception = &storage_error;
1871 msg = "stack overflow or erroneous memory access";
1872 break;
1873 case SIGBUS:
1874 exception = &constraint_error;
1875 msg = "SIGBUS";
1876 break;
1877 default:
1878 exception = &program_error;
1879 msg = "unhandled signal";
1882 Raise_From_Signal_Handler(exception, msg);
1885 void
1886 __gnat_install_handler(void)
1888 struct sigaction act;
1890 act.sa_handler = __gnat_error_handler;
1891 act.sa_flags = SA_NODEFER | SA_RESTART;
1892 sigemptyset (&act.sa_mask);
1894 /* Do not install handlers if interrupt state is "System" */
1895 if (__gnat_get_interrupt_state (SIGFPE) != 's')
1896 sigaction (SIGFPE, &act, NULL);
1897 if (__gnat_get_interrupt_state (SIGILL) != 's')
1898 sigaction (SIGILL, &act, NULL);
1899 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1900 sigaction (SIGSEGV, &act, NULL);
1901 if (__gnat_get_interrupt_state (SIGBUS) != 's')
1902 sigaction (SIGBUS, &act, NULL);
1904 __gnat_handler_installed = 1;
1907 void
1908 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
1910 __gnat_install_handler ();
1911 __gnat_init_float ();
1914 #else
1916 /* For all other versions of GNAT, the initialize routine and handler
1917 installation do nothing */
1919 /***************************************/
1920 /* __gnat_initialize (Default Version) */
1921 /***************************************/
1923 void
1924 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
1928 /********************************************/
1929 /* __gnat_install_handler (Default Version) */
1930 /********************************************/
1932 void
1933 __gnat_install_handler (void)
1935 __gnat_handler_installed = 1;
1938 #endif
1940 /*********************/
1941 /* __gnat_init_float */
1942 /*********************/
1944 /* This routine is called as each process thread is created, for possible
1945 initialization of the FP processor. This version is used under INTERIX,
1946 WIN32 and could be used under OS/2 */
1948 #if defined (_WIN32) || defined (__INTERIX) || defined (__EMX__) \
1949 || defined (__Lynx__) || defined(__NetBSD__) || defined(__FreeBSD__)
1951 #define HAVE_GNAT_INIT_FLOAT
1953 void
1954 __gnat_init_float (void)
1956 #if defined (__i386__) || defined (i386)
1958 /* This is used to properly initialize the FPU on an x86 for each
1959 process thread. */
1961 asm ("finit");
1963 #endif /* Defined __i386__ */
1965 #endif
1967 #ifndef HAVE_GNAT_INIT_FLOAT
1969 /* All targets without a specific __gnat_init_float will use an empty one */
1970 void
1971 __gnat_init_float (void)
1974 #endif
1976 /***********************************/
1977 /* __gnat_adjust_context_for_raise */
1978 /***********************************/
1980 #ifndef HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
1982 /* All targets without a specific version will use an empty one */
1984 /* UCONTEXT is a pointer to a context structure received by a signal handler
1985 about to propagate an exception. Adjust it to compensate the fact that the
1986 generic unwinder thinks the corresponding PC is a call return address. */
1988 void
1989 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED,
1990 void *ucontext ATTRIBUTE_UNUSED)
1992 /* The point is that the interrupted context PC typically is the address
1993 that we should search an EH region for, which is different from the call
1994 return address case. The target independent part of the GCC unwinder
1995 don't differentiate the two situations, so we compensate here for the
1996 adjustments it will blindly make.
1998 signo is passed because on some targets for some signals the PC in
1999 context points to the instruction after the faulting one, in which case
2000 the unwinder adjustment is still desired. */
2002 /* On a number of targets, we have arranged for the adjustment to be
2003 performed by the MD_FALLBACK_FRAME_STATE circuitry, so we don't provide a
2004 specific instance of this routine. The MD_FALLBACK doesn't have access
2005 to the signal number, though, so the compensation is systematic there and
2006 might be wrong in some cases. */
2008 /* Having the compensation wrong leads to potential failures. A very
2009 typical case is what happens when there is no compensation and a signal
2010 triggers for the first instruction in a region : the unwinder adjustment
2011 has it search in the wrong EH region. */
2014 #endif