1 /****************************************************************************
3 * GNAT COMPILER COMPONENTS *
7 * C Implementation File *
9 * Copyright (C) 1992-2010, Free Software Foundation, Inc. *
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 3, 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. *
18 * As a special exception under Section 7 of GPL version 3, you are granted *
19 * additional permissions described in the GCC Runtime Library Exception, *
20 * version 3.1, as published by the Free Software Foundation. *
22 * You should have received a copy of the GNU General Public License and *
23 * a copy of the GCC Runtime Library Exception along with this program; *
24 * see the files COPYING3 and COPYING.RUNTIME respectively. If not, see *
25 * <http://www.gnu.org/licenses/>. *
27 * GNAT was originally developed by the GNAT team at New York University. *
28 * Extensive contributions were provided by Ada Core Technologies Inc. *
30 ****************************************************************************/
32 /* This unit contains initialization circuits that are system dependent.
33 A major part of the functionality involves stack overflow checking.
34 The GCC backend generates probe instructions to test for stack overflow.
35 For details on the exact approach used to generate these probes, see the
36 "Using and Porting GCC" manual, in particular the "Stack Checking" section
37 and the subsection "Specifying How Stack Checking is Done". The handlers
38 installed by this file are used to catch the resulting signals that come
39 from these probes failing (i.e. touching protected pages). */
41 /* This file should be kept synchronized with 2sinit.ads, 2sinit.adb,
42 s-init-ae653-cert.adb and s-init-xi-sparc.adb. All these files implement
43 the required functionality for different targets. */
45 /* The following include is here to meet the published VxWorks requirement
46 that the __vxworks header appear before any other include. */
56 /* We don't have libiberty, so use malloc. */
57 #define xmalloc(S) malloc (S)
66 extern void __gnat_raise_program_error (const char *, int);
68 /* Addresses of exception data blocks for predefined exceptions. Tasking_Error
69 is not used in this unit, and the abort signal is only used on IRIX. */
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;
75 /* For the Cert run time we use the regular raise exception routine because
76 Raise_From_Signal_Handler is not available. */
78 #define Raise_From_Signal_Handler \
79 __gnat_raise_exception
80 extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *);
82 #define Raise_From_Signal_Handler \
83 ada__exceptions__raise_from_signal_handler
84 extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *);
87 /* Global values computed by the binder. */
88 int __gl_main_priority = -1;
89 int __gl_main_cpu = -1;
90 int __gl_time_slice_val = -1;
91 char __gl_wc_encoding = 'n';
92 char __gl_locking_policy = ' ';
93 char __gl_queuing_policy = ' ';
94 char __gl_task_dispatching_policy = ' ';
95 char *__gl_priority_specific_dispatching = 0;
96 int __gl_num_specific_dispatching = 0;
97 char *__gl_interrupt_states = 0;
98 int __gl_num_interrupt_states = 0;
99 int __gl_unreserve_all_interrupts = 0;
100 int __gl_exception_tracebacks = 0;
101 int __gl_zero_cost_exceptions = 0;
102 int __gl_detect_blocking = 0;
103 int __gl_default_stack_size = -1;
104 int __gl_leap_seconds_support = 0;
105 int __gl_canonical_streams = 0;
107 /* Indication of whether synchronous signal handler has already been
108 installed by a previous call to adainit. */
109 int __gnat_handler_installed = 0;
112 int __gnat_inside_elab_final_code = 0;
113 /* ??? This variable is obsolete since 2001-08-29 but is kept to allow
114 bootstrap from old GNAT versions (< 3.15). */
117 /* HAVE_GNAT_INIT_FLOAT must be set on every targets where a __gnat_init_float
118 is defined. If this is not set then a void implementation will be defined
119 at the end of this unit. */
120 #undef HAVE_GNAT_INIT_FLOAT
122 /******************************/
123 /* __gnat_get_interrupt_state */
124 /******************************/
126 char __gnat_get_interrupt_state (int);
128 /* This routine is called from the runtime as needed to determine the state
129 of an interrupt, as set by an Interrupt_State pragma appearing anywhere
130 in the current partition. The input argument is the interrupt number,
131 and the result is one of the following:
133 'n' this interrupt not set by any Interrupt_State pragma
134 'u' Interrupt_State pragma set state to User
135 'r' Interrupt_State pragma set state to Runtime
136 's' Interrupt_State pragma set state to System */
139 __gnat_get_interrupt_state (int intrup)
141 if (intrup >= __gl_num_interrupt_states)
144 return __gl_interrupt_states [intrup];
147 /***********************************/
148 /* __gnat_get_specific_dispatching */
149 /***********************************/
151 char __gnat_get_specific_dispatching (int);
153 /* This routine is called from the runtime as needed to determine the
154 priority specific dispatching policy, as set by a
155 Priority_Specific_Dispatching pragma appearing anywhere in the current
156 partition. The input argument is the priority number, and the result
157 is the upper case first character of the policy name, e.g. 'F' for
158 FIFO_Within_Priorities. A space ' ' is returned if no
159 Priority_Specific_Dispatching pragma is used in the partition. */
162 __gnat_get_specific_dispatching (int priority)
164 if (__gl_num_specific_dispatching == 0)
166 else if (priority >= __gl_num_specific_dispatching)
169 return __gl_priority_specific_dispatching [priority];
174 /**********************/
175 /* __gnat_set_globals */
176 /**********************/
178 /* This routine is kept for bootstrapping purposes, since the binder generated
179 file now sets the __gl_* variables directly. */
182 __gnat_set_globals (void)
195 #include <sys/time.h>
197 /* Some versions of AIX don't define SA_NODEFER. */
201 #endif /* SA_NODEFER */
203 /* Versions of AIX before 4.3 don't have nanosleep but provide
206 #ifndef _AIXVERSION_430
208 extern int nanosleep (struct timestruc_t *, struct timestruc_t *);
211 nanosleep (struct timestruc_t *Rqtp, struct timestruc_t *Rmtp)
213 return nsleep (Rqtp, Rmtp);
216 #endif /* _AIXVERSION_430 */
219 __gnat_error_handler (int sig,
220 siginfo_t *si ATTRIBUTE_UNUSED,
221 void *ucontext ATTRIBUTE_UNUSED)
223 struct Exception_Data *exception;
229 /* FIXME: we need to detect the case of a *real* SIGSEGV. */
230 exception = &storage_error;
231 msg = "stack overflow or erroneous memory access";
235 exception = &constraint_error;
240 exception = &constraint_error;
245 exception = &program_error;
246 msg = "unhandled signal";
249 Raise_From_Signal_Handler (exception, msg);
253 __gnat_install_handler (void)
255 struct sigaction act;
257 /* Set up signal handler to map synchronous signals to appropriate
258 exceptions. Make sure that the handler isn't interrupted by another
259 signal that might cause a scheduling event! */
261 act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
262 act.sa_sigaction = __gnat_error_handler;
263 sigemptyset (&act.sa_mask);
265 /* Do not install handlers if interrupt state is "System". */
266 if (__gnat_get_interrupt_state (SIGABRT) != 's')
267 sigaction (SIGABRT, &act, NULL);
268 if (__gnat_get_interrupt_state (SIGFPE) != 's')
269 sigaction (SIGFPE, &act, NULL);
270 if (__gnat_get_interrupt_state (SIGILL) != 's')
271 sigaction (SIGILL, &act, NULL);
272 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
273 sigaction (SIGSEGV, &act, NULL);
274 if (__gnat_get_interrupt_state (SIGBUS) != 's')
275 sigaction (SIGBUS, &act, NULL);
277 __gnat_handler_installed = 1;
284 #elif defined(__alpha__) && defined(__osf__)
287 #include <sys/siginfo.h>
289 extern char *__gnat_get_code_loc (struct sigcontext *);
290 extern void __gnat_set_code_loc (struct sigcontext *, char *);
291 extern size_t __gnat_machine_state_length (void);
293 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
296 __gnat_adjust_context_for_raise (int signo, void *ucontext)
298 struct sigcontext *sigcontext = (struct sigcontext *) ucontext;
300 /* The unwinder expects the signal context to contain the address of the
301 faulting instruction. For SIGFPE, this depends on the trap shadow
302 situation (see man ieee). We nonetheless always compensate for it,
303 considering that PC designates the instruction following the one that
304 trapped. This is not necessarily true but corresponds to what we have
311 __gnat_error_handler (int sig, siginfo_t *si, void *ucontext)
313 struct Exception_Data *exception;
314 static int recurse = 0;
317 /* Adjusting is required for every fault context, so adjust for this one
318 now, before we possibly trigger a recursive fault below. */
319 __gnat_adjust_context_for_raise (sig, ucontext);
321 /* If this was an explicit signal from a "kill", just resignal it. */
322 if (SI_FROMUSER (si))
324 signal (sig, SIG_DFL);
325 kill (getpid(), sig);
328 /* Otherwise, treat it as something we handle. */
332 /* If the problem was permissions, this is a constraint error.
333 Likewise if the failing address isn't maximally aligned or if
336 ??? Using a static variable here isn't task-safe, but it's
337 much too hard to do anything else and we're just determining
338 which exception to raise. */
339 if (si->si_code == SEGV_ACCERR
340 || (long) si->si_addr == 0
341 || (((long) si->si_addr) & 3) != 0
344 exception = &constraint_error;
349 /* See if the page before the faulting page is accessible. Do that
350 by trying to access it. We'd like to simply try to access
351 4096 + the faulting address, but it's not guaranteed to be
352 the actual address, just to be on the same page. */
355 ((long) si->si_addr & - getpagesize ()))[getpagesize ()];
356 exception = &storage_error;
357 msg = "stack overflow (or erroneous memory access)";
362 exception = &program_error;
367 exception = &constraint_error;
372 exception = &program_error;
373 msg = "unhandled signal";
377 Raise_From_Signal_Handler (exception, (const char *) msg);
381 __gnat_install_handler (void)
383 struct sigaction act;
385 /* Setup signal handler to map synchronous signals to appropriate
386 exceptions. Make sure that the handler isn't interrupted by another
387 signal that might cause a scheduling event! */
389 act.sa_handler = (void (*) (int)) __gnat_error_handler;
390 act.sa_flags = SA_RESTART | SA_NODEFER | SA_SIGINFO;
391 sigemptyset (&act.sa_mask);
393 /* Do not install handlers if interrupt state is "System". */
394 if (__gnat_get_interrupt_state (SIGABRT) != 's')
395 sigaction (SIGABRT, &act, NULL);
396 if (__gnat_get_interrupt_state (SIGFPE) != 's')
397 sigaction (SIGFPE, &act, NULL);
398 if (__gnat_get_interrupt_state (SIGILL) != 's')
399 sigaction (SIGILL, &act, NULL);
400 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
401 sigaction (SIGSEGV, &act, NULL);
402 if (__gnat_get_interrupt_state (SIGBUS) != 's')
403 sigaction (SIGBUS, &act, NULL);
405 __gnat_handler_installed = 1;
408 /* Routines called by s-mastop-tru64.adb. */
413 __gnat_get_code_loc (struct sigcontext *context)
415 return (char *) context->sc_pc;
419 __gnat_set_code_loc (struct sigcontext *context, char *pc)
421 context->sc_pc = (long) pc;
425 __gnat_machine_state_length (void)
427 return sizeof (struct sigcontext);
434 #elif defined (__hpux__)
437 #include <sys/ucontext.h>
440 __gnat_error_handler (int sig,
441 siginfo_t *si ATTRIBUTE_UNUSED,
442 void *ucontext ATTRIBUTE_UNUSED)
444 struct Exception_Data *exception;
450 /* FIXME: we need to detect the case of a *real* SIGSEGV. */
451 exception = &storage_error;
452 msg = "stack overflow or erroneous memory access";
456 exception = &constraint_error;
461 exception = &constraint_error;
466 exception = &program_error;
467 msg = "unhandled signal";
470 Raise_From_Signal_Handler (exception, msg);
473 /* This must be in keeping with System.OS_Interface.Alternate_Stack_Size. */
474 #if defined (__hppa__)
475 char __gnat_alternate_stack[16 * 1024]; /* 2 * SIGSTKSZ */
477 char __gnat_alternate_stack[128 * 1024]; /* MINSIGSTKSZ */
481 __gnat_install_handler (void)
483 struct sigaction act;
485 /* Set up signal handler to map synchronous signals to appropriate
486 exceptions. Make sure that the handler isn't interrupted by another
487 signal that might cause a scheduling event! Also setup an alternate
488 stack region for the handler execution so that stack overflows can be
489 handled properly, avoiding a SEGV generation from stack usage by the
493 stack.ss_sp = __gnat_alternate_stack;
494 stack.ss_size = sizeof (__gnat_alternate_stack);
496 sigaltstack (&stack, NULL);
498 act.sa_sigaction = __gnat_error_handler;
499 act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
500 sigemptyset (&act.sa_mask);
502 /* Do not install handlers if interrupt state is "System". */
503 if (__gnat_get_interrupt_state (SIGABRT) != 's')
504 sigaction (SIGABRT, &act, NULL);
505 if (__gnat_get_interrupt_state (SIGFPE) != 's')
506 sigaction (SIGFPE, &act, NULL);
507 if (__gnat_get_interrupt_state (SIGILL) != 's')
508 sigaction (SIGILL, &act, NULL);
509 if (__gnat_get_interrupt_state (SIGBUS) != 's')
510 sigaction (SIGBUS, &act, NULL);
511 act.sa_flags |= SA_ONSTACK;
512 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
513 sigaction (SIGSEGV, &act, NULL);
515 __gnat_handler_installed = 1;
518 /*********************/
519 /* GNU/Linux Section */
520 /*********************/
522 #elif defined (linux)
526 #define __USE_GNU 1 /* required to get REG_EIP/RIP from glibc's ucontext.h */
527 #include <sys/ucontext.h>
529 /* GNU/Linux, which uses glibc, does not define NULL in included
533 #define NULL ((void *) 0)
538 /* MaRTE OS provides its own version of sigaction, sigfillset, and
539 sigemptyset (overriding these symbol names). We want to make sure that
540 the versions provided by the underlying C library are used here (these
541 versions are renamed by MaRTE to linux_sigaction, fake_linux_sigfillset,
542 and fake_linux_sigemptyset, respectively). The MaRTE library will not
543 always be present (it will not be linked if no tasking constructs are
544 used), so we use the weak symbol mechanism to point always to the symbols
545 defined within the C library. */
547 #pragma weak linux_sigaction
548 int linux_sigaction (int signum, const struct sigaction *act,
549 struct sigaction *oldact) {
550 return sigaction (signum, act, oldact);
552 #define sigaction(signum, act, oldact) linux_sigaction (signum, act, oldact)
554 #pragma weak fake_linux_sigfillset
555 void fake_linux_sigfillset (sigset_t *set) {
558 #define sigfillset(set) fake_linux_sigfillset (set)
560 #pragma weak fake_linux_sigemptyset
561 void fake_linux_sigemptyset (sigset_t *set) {
564 #define sigemptyset(set) fake_linux_sigemptyset (set)
568 #if defined (i386) || defined (__x86_64__) || defined (__ia64__)
570 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
573 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
575 mcontext_t *mcontext = &((ucontext_t *) ucontext)->uc_mcontext;
577 /* On the i386 and x86-64 architectures, stack checking is performed by
578 means of probes with moving stack pointer, that is to say the probed
579 address is always the value of the stack pointer. Upon hitting the
580 guard page, the stack pointer therefore points to an inaccessible
581 address and an alternate signal stack is needed to run the handler.
582 But there is an additional twist: on these architectures, the EH
583 return code writes the address of the handler at the target CFA's
584 value on the stack before doing the jump. As a consequence, if
585 there is an active handler in the frame whose stack has overflowed,
586 the stack pointer must nevertheless point to an accessible address
587 by the time the EH return is executed.
589 We therefore adjust the saved value of the stack pointer by the size
590 of one page + a small dope of 4 words, in order to make sure that it
591 points to an accessible address in case it's used as the target CFA.
592 The stack checking code guarantees that this address is unused by the
593 time this happens. */
596 unsigned long *pc = (unsigned long *)mcontext->gregs[REG_EIP];
597 /* The pattern is "orl $0x0,(%esp)" for a probe in 32-bit mode. */
598 if (signo == SIGSEGV && pc && *pc == 0x00240c83)
599 mcontext->gregs[REG_ESP] += 4096 + 4 * sizeof (unsigned long);
600 #elif defined (__x86_64__)
601 unsigned long *pc = (unsigned long *)mcontext->gregs[REG_RIP];
602 /* The pattern is "orq $0x0,(%rsp)" for a probe in 64-bit mode. */
603 if (signo == SIGSEGV && pc && (*pc & 0xffffffffff) == 0x00240c8348)
604 mcontext->gregs[REG_RSP] += 4096 + 4 * sizeof (unsigned long);
605 #elif defined (__ia64__)
606 /* ??? The IA-64 unwinder doesn't compensate for signals. */
614 __gnat_error_handler (int sig, siginfo_t *si ATTRIBUTE_UNUSED, void *ucontext)
616 struct Exception_Data *exception;
619 /* Adjusting is required for every fault context, so adjust for this one
620 now, before we possibly trigger a recursive fault below. */
621 __gnat_adjust_context_for_raise (sig, ucontext);
626 /* Here we would like a discrimination test to see whether the page
627 before the faulting address is accessible. Unfortunately, Linux
628 seems to have no way of giving us the faulting address.
630 In old versions of init.c, we had a test of the page before the
634 ((long) si->esp_at_signal & - getpagesize ()))[getpagesize ()];
636 but that's wrong since it tests the stack pointer location and the
637 stack probing code may not move it until all probes succeed.
639 For now we simply do not attempt any discrimination at all. Note
640 that this is quite acceptable, since a "real" SIGSEGV can only
641 occur as the result of an erroneous program. */
642 exception = &storage_error;
643 msg = "stack overflow (or erroneous memory access)";
647 exception = &constraint_error;
652 exception = &constraint_error;
657 exception = &program_error;
658 msg = "unhandled signal";
661 Raise_From_Signal_Handler (exception, msg);
664 #if defined (i386) || defined (__x86_64__) || defined (__powerpc__)
665 /* This must be in keeping with System.OS_Interface.Alternate_Stack_Size. */
666 char __gnat_alternate_stack[16 * 1024]; /* 2 * SIGSTKSZ */
670 #include <sys/mman.h>
671 #include <native/task.h>
677 __gnat_install_handler (void)
679 struct sigaction act;
684 if (__gl_main_priority == -1)
687 prio = __gl_main_priority;
689 /* Avoid memory swapping for this program */
691 mlockall (MCL_CURRENT|MCL_FUTURE);
693 /* Turn the current Linux task into a native Xenomai task */
695 rt_task_shadow(&main_task, "environment_task", prio, T_FPU);
698 /* Set up signal handler to map synchronous signals to appropriate
699 exceptions. Make sure that the handler isn't interrupted by another
700 signal that might cause a scheduling event! Also setup an alternate
701 stack region for the handler execution so that stack overflows can be
702 handled properly, avoiding a SEGV generation from stack usage by the
705 #if defined (i386) || defined (__x86_64__) || defined (__powerpc__)
707 stack.ss_sp = __gnat_alternate_stack;
708 stack.ss_size = sizeof (__gnat_alternate_stack);
710 sigaltstack (&stack, NULL);
713 act.sa_sigaction = __gnat_error_handler;
714 act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
715 sigemptyset (&act.sa_mask);
717 /* Do not install handlers if interrupt state is "System". */
718 if (__gnat_get_interrupt_state (SIGABRT) != 's')
719 sigaction (SIGABRT, &act, NULL);
720 if (__gnat_get_interrupt_state (SIGFPE) != 's')
721 sigaction (SIGFPE, &act, NULL);
722 if (__gnat_get_interrupt_state (SIGILL) != 's')
723 sigaction (SIGILL, &act, NULL);
724 if (__gnat_get_interrupt_state (SIGBUS) != 's')
725 sigaction (SIGBUS, &act, NULL);
726 #if defined (i386) || defined (__x86_64__) || defined (__powerpc__)
727 act.sa_flags |= SA_ONSTACK;
729 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
730 sigaction (SIGSEGV, &act, NULL);
732 __gnat_handler_installed = 1;
748 #define SIGADAABORT 48
749 #define SIGNAL_STACK_SIZE 4096
750 #define SIGNAL_STACK_ALIGNMENT 64
752 #define Check_Abort_Status \
753 system__soft_links__check_abort_status
754 extern int (*Check_Abort_Status) (void);
756 extern struct Exception_Data _abort_signal;
758 /* We are not setting the SA_SIGINFO bit in the sigaction flags when
759 connecting that handler, with the effects described in the sigaction
763 If cleared and the signal is caught, the first argument is
764 also the signal number but the second argument is the signal
765 code identifying the cause of the signal. The third argument
766 points to a sigcontext_t structure containing the receiving
767 process's context when the signal was delivered. */
770 __gnat_error_handler (int sig, int code, sigcontext_t *sc ATTRIBUTE_UNUSED)
772 struct Exception_Data *exception;
780 exception = &program_error;
781 msg = "SIGSEGV: (Invalid virtual address)";
783 else if (code == ENXIO)
785 exception = &program_error;
786 msg = "SIGSEGV: (Read beyond mapped object)";
788 else if (code == ENOSPC)
790 exception = &program_error; /* ??? storage_error ??? */
791 msg = "SIGSEGV: (Autogrow for file failed)";
793 else if (code == EACCES || code == EEXIST)
795 /* ??? We handle stack overflows here, some of which do trigger
796 SIGSEGV + EEXIST on Irix 6.5 although EEXIST is not part of
797 the documented valid codes for SEGV in the signal(5) man
800 /* ??? Re-add smarts to further verify that we launched
801 the stack into a guard page, not an attempt to
802 write to .text or something. */
803 exception = &storage_error;
804 msg = "SIGSEGV: (stack overflow or erroneous memory access)";
808 /* Just in case the OS guys did it to us again. Sometimes
809 they fail to document all of the valid codes that are
810 passed to signal handlers, just in case someone depends
811 on knowing all the codes. */
812 exception = &program_error;
813 msg = "SIGSEGV: (Undocumented reason)";
818 /* Map all bus errors to Program_Error. */
819 exception = &program_error;
824 /* Map all fpe errors to Constraint_Error. */
825 exception = &constraint_error;
830 if ((*Check_Abort_Status) ())
832 exception = &_abort_signal;
841 /* Everything else is a Program_Error. */
842 exception = &program_error;
843 msg = "unhandled signal";
846 Raise_From_Signal_Handler (exception, msg);
850 __gnat_install_handler (void)
852 struct sigaction act;
854 /* Setup signal handler to map synchronous signals to appropriate
855 exceptions. Make sure that the handler isn't interrupted by another
856 signal that might cause a scheduling event! */
858 act.sa_handler = __gnat_error_handler;
859 act.sa_flags = SA_NODEFER + SA_RESTART;
860 sigfillset (&act.sa_mask);
861 sigemptyset (&act.sa_mask);
863 /* Do not install handlers if interrupt state is "System". */
864 if (__gnat_get_interrupt_state (SIGABRT) != 's')
865 sigaction (SIGABRT, &act, NULL);
866 if (__gnat_get_interrupt_state (SIGFPE) != 's')
867 sigaction (SIGFPE, &act, NULL);
868 if (__gnat_get_interrupt_state (SIGILL) != 's')
869 sigaction (SIGILL, &act, NULL);
870 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
871 sigaction (SIGSEGV, &act, NULL);
872 if (__gnat_get_interrupt_state (SIGBUS) != 's')
873 sigaction (SIGBUS, &act, NULL);
874 if (__gnat_get_interrupt_state (SIGADAABORT) != 's')
875 sigaction (SIGADAABORT, &act, NULL);
877 __gnat_handler_installed = 1;
880 /*******************/
882 /*******************/
884 #elif defined (__Lynx__)
890 __gnat_error_handler (int sig)
892 struct Exception_Data *exception;
898 exception = &constraint_error;
902 exception = &constraint_error;
906 exception = &storage_error;
907 msg = "stack overflow or erroneous memory access";
910 exception = &constraint_error;
914 exception = &program_error;
915 msg = "unhandled signal";
918 Raise_From_Signal_Handler(exception, msg);
922 __gnat_install_handler(void)
924 struct sigaction act;
926 act.sa_handler = __gnat_error_handler;
928 sigemptyset (&act.sa_mask);
930 /* Do not install handlers if interrupt state is "System". */
931 if (__gnat_get_interrupt_state (SIGFPE) != 's')
932 sigaction (SIGFPE, &act, NULL);
933 if (__gnat_get_interrupt_state (SIGILL) != 's')
934 sigaction (SIGILL, &act, NULL);
935 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
936 sigaction (SIGSEGV, &act, NULL);
937 if (__gnat_get_interrupt_state (SIGBUS) != 's')
938 sigaction (SIGBUS, &act, NULL);
940 __gnat_handler_installed = 1;
943 /*******************/
944 /* Solaris Section */
945 /*******************/
947 #elif defined (sun) && defined (__SVR4) && !defined (__vxworks)
951 #include <sys/ucontext.h>
952 #include <sys/regset.h>
954 /* The code below is common to SPARC and x86. Beware of the delay slot
955 differences for signal context adjustments. */
957 #if defined (__sparc)
958 #define RETURN_ADDR_OFFSET 8
960 #define RETURN_ADDR_OFFSET 0
964 __gnat_error_handler (int sig, siginfo_t *si, void *ucontext ATTRIBUTE_UNUSED)
966 struct Exception_Data *exception;
967 static int recurse = 0;
973 /* If the problem was permissions, this is a constraint error.
974 Likewise if the failing address isn't maximally aligned or if
977 ??? Using a static variable here isn't task-safe, but it's
978 much too hard to do anything else and we're just determining
979 which exception to raise. */
980 if (si->si_code == SEGV_ACCERR
981 || (long) si->si_addr == 0
982 || (((long) si->si_addr) & 3) != 0
985 exception = &constraint_error;
990 /* See if the page before the faulting page is accessible. Do that
991 by trying to access it. We'd like to simply try to access
992 4096 + the faulting address, but it's not guaranteed to be
993 the actual address, just to be on the same page. */
996 ((long) si->si_addr & - getpagesize ()))[getpagesize ()];
997 exception = &storage_error;
998 msg = "stack overflow (or erroneous memory access)";
1003 exception = &program_error;
1008 exception = &constraint_error;
1013 exception = &program_error;
1014 msg = "unhandled signal";
1018 Raise_From_Signal_Handler (exception, msg);
1022 __gnat_install_handler (void)
1024 struct sigaction act;
1026 /* Set up signal handler to map synchronous signals to appropriate
1027 exceptions. Make sure that the handler isn't interrupted by another
1028 signal that might cause a scheduling event! */
1030 act.sa_handler = __gnat_error_handler;
1031 act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
1032 sigemptyset (&act.sa_mask);
1034 /* Do not install handlers if interrupt state is "System". */
1035 if (__gnat_get_interrupt_state (SIGABRT) != 's')
1036 sigaction (SIGABRT, &act, NULL);
1037 if (__gnat_get_interrupt_state (SIGFPE) != 's')
1038 sigaction (SIGFPE, &act, NULL);
1039 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1040 sigaction (SIGSEGV, &act, NULL);
1041 if (__gnat_get_interrupt_state (SIGBUS) != 's')
1042 sigaction (SIGBUS, &act, NULL);
1044 __gnat_handler_installed = 1;
1053 /* Routine called from binder to override default feature values. */
1054 void __gnat_set_features (void);
1055 int __gnat_features_set = 0;
1058 #define lib_get_curr_invo_context LIB$I64_GET_CURR_INVO_CONTEXT
1059 #define lib_get_prev_invo_context LIB$I64_GET_PREV_INVO_CONTEXT
1060 #define lib_get_invo_handle LIB$I64_GET_INVO_HANDLE
1062 #define lib_get_curr_invo_context LIB$GET_CURR_INVO_CONTEXT
1063 #define lib_get_prev_invo_context LIB$GET_PREV_INVO_CONTEXT
1064 #define lib_get_invo_handle LIB$GET_INVO_HANDLE
1067 /* Define macro symbols for the VMS conditions that become Ada exceptions.
1068 Most of these are also defined in the header file ssdef.h which has not
1069 yet been converted to be recognized by GNU C. */
1071 /* Defining these as macros, as opposed to external addresses, allows
1072 them to be used in a case statement below. */
1073 #define SS$_ACCVIO 12
1074 #define SS$_HPARITH 1284
1075 #define SS$_STKOVF 1364
1076 #define SS$_RESIGNAL 2328
1078 /* These codes are in standard message libraries. */
1079 extern int C$_SIGKILL;
1080 extern int CMA$_EXIT_THREAD;
1081 extern int SS$_DEBUG;
1082 extern int SS$_INTDIV;
1083 extern int LIB$_KEYNOTFOU;
1084 extern int LIB$_ACTIMAGE;
1085 extern int MTH$_FLOOVEMAT; /* Some ACVC_21 CXA tests */
1087 /* These codes are non standard, which is to say the author is
1088 not sure if they are defined in the standard message libraries
1089 so keep them as macros for now. */
1090 #define RDB$_STREAM_EOF 20480426
1091 #define FDL$_UNPRIKW 11829410
1093 struct cond_except {
1095 const struct Exception_Data *except;
1098 struct descriptor_s {
1099 unsigned short len, mbz;
1103 /* Conditions that don't have an Ada exception counterpart must raise
1104 Non_Ada_Error. Since this is defined in s-auxdec, it should only be
1105 referenced by user programs, not the compiler or tools. Hence the
1110 #define Status_Error ada__io_exceptions__status_error
1111 extern struct Exception_Data Status_Error;
1113 #define Mode_Error ada__io_exceptions__mode_error
1114 extern struct Exception_Data Mode_Error;
1116 #define Name_Error ada__io_exceptions__name_error
1117 extern struct Exception_Data Name_Error;
1119 #define Use_Error ada__io_exceptions__use_error
1120 extern struct Exception_Data Use_Error;
1122 #define Device_Error ada__io_exceptions__device_error
1123 extern struct Exception_Data Device_Error;
1125 #define End_Error ada__io_exceptions__end_error
1126 extern struct Exception_Data End_Error;
1128 #define Data_Error ada__io_exceptions__data_error
1129 extern struct Exception_Data Data_Error;
1131 #define Layout_Error ada__io_exceptions__layout_error
1132 extern struct Exception_Data Layout_Error;
1134 #define Non_Ada_Error system__aux_dec__non_ada_error
1135 extern struct Exception_Data Non_Ada_Error;
1137 #define Coded_Exception system__vms_exception_table__coded_exception
1138 extern struct Exception_Data *Coded_Exception (Exception_Code);
1140 #define Base_Code_In system__vms_exception_table__base_code_in
1141 extern Exception_Code Base_Code_In (Exception_Code);
1143 /* DEC Ada exceptions are not defined in a header file, so they
1144 must be declared as external addresses. */
1146 extern int ADA$_PROGRAM_ERROR;
1147 extern int ADA$_LOCK_ERROR;
1148 extern int ADA$_EXISTENCE_ERROR;
1149 extern int ADA$_KEY_ERROR;
1150 extern int ADA$_KEYSIZERR;
1151 extern int ADA$_STAOVF;
1152 extern int ADA$_CONSTRAINT_ERRO;
1153 extern int ADA$_IOSYSFAILED;
1154 extern int ADA$_LAYOUT_ERROR;
1155 extern int ADA$_STORAGE_ERROR;
1156 extern int ADA$_DATA_ERROR;
1157 extern int ADA$_DEVICE_ERROR;
1158 extern int ADA$_END_ERROR;
1159 extern int ADA$_MODE_ERROR;
1160 extern int ADA$_NAME_ERROR;
1161 extern int ADA$_STATUS_ERROR;
1162 extern int ADA$_NOT_OPEN;
1163 extern int ADA$_ALREADY_OPEN;
1164 extern int ADA$_USE_ERROR;
1165 extern int ADA$_UNSUPPORTED;
1166 extern int ADA$_FAC_MODE_MISMAT;
1167 extern int ADA$_ORG_MISMATCH;
1168 extern int ADA$_RFM_MISMATCH;
1169 extern int ADA$_RAT_MISMATCH;
1170 extern int ADA$_MRS_MISMATCH;
1171 extern int ADA$_MRN_MISMATCH;
1172 extern int ADA$_KEY_MISMATCH;
1173 extern int ADA$_MAXLINEXC;
1174 extern int ADA$_LINEXCMRS;
1176 /* DEC Ada specific conditions. */
1177 static const struct cond_except dec_ada_cond_except_table [] = {
1178 {&ADA$_PROGRAM_ERROR, &program_error},
1179 {&ADA$_USE_ERROR, &Use_Error},
1180 {&ADA$_KEYSIZERR, &program_error},
1181 {&ADA$_STAOVF, &storage_error},
1182 {&ADA$_CONSTRAINT_ERRO, &constraint_error},
1183 {&ADA$_IOSYSFAILED, &Device_Error},
1184 {&ADA$_LAYOUT_ERROR, &Layout_Error},
1185 {&ADA$_STORAGE_ERROR, &storage_error},
1186 {&ADA$_DATA_ERROR, &Data_Error},
1187 {&ADA$_DEVICE_ERROR, &Device_Error},
1188 {&ADA$_END_ERROR, &End_Error},
1189 {&ADA$_MODE_ERROR, &Mode_Error},
1190 {&ADA$_NAME_ERROR, &Name_Error},
1191 {&ADA$_STATUS_ERROR, &Status_Error},
1192 {&ADA$_NOT_OPEN, &Use_Error},
1193 {&ADA$_ALREADY_OPEN, &Use_Error},
1194 {&ADA$_USE_ERROR, &Use_Error},
1195 {&ADA$_UNSUPPORTED, &Use_Error},
1196 {&ADA$_FAC_MODE_MISMAT, &Use_Error},
1197 {&ADA$_ORG_MISMATCH, &Use_Error},
1198 {&ADA$_RFM_MISMATCH, &Use_Error},
1199 {&ADA$_RAT_MISMATCH, &Use_Error},
1200 {&ADA$_MRS_MISMATCH, &Use_Error},
1201 {&ADA$_MRN_MISMATCH, &Use_Error},
1202 {&ADA$_KEY_MISMATCH, &Use_Error},
1203 {&ADA$_MAXLINEXC, &constraint_error},
1204 {&ADA$_LINEXCMRS, &constraint_error},
1209 /* Already handled by a pragma Import_Exception
1210 in Aux_IO_Exceptions */
1211 {&ADA$_LOCK_ERROR, &Lock_Error},
1212 {&ADA$_EXISTENCE_ERROR, &Existence_Error},
1213 {&ADA$_KEY_ERROR, &Key_Error},
1218 /* Non-DEC Ada specific conditions. We could probably also put
1219 SS$_HPARITH here and possibly SS$_ACCVIO, SS$_STKOVF. */
1220 static const struct cond_except cond_except_table [] = {
1221 {&MTH$_FLOOVEMAT, &constraint_error},
1222 {&SS$_INTDIV, &constraint_error},
1226 /* To deal with VMS conditions and their mapping to Ada exceptions,
1227 the __gnat_error_handler routine below is installed as an exception
1228 vector having precedence over DEC frame handlers. Some conditions
1229 still need to be handled by such handlers, however, in which case
1230 __gnat_error_handler needs to return SS$_RESIGNAL. Consider for
1231 instance the use of a third party library compiled with DECAda and
1232 performing its own exception handling internally.
1234 To allow some user-level flexibility, which conditions should be
1235 resignaled is controlled by a predicate function, provided with the
1236 condition value and returning a boolean indication stating whether
1237 this condition should be resignaled or not.
1239 That predicate function is called indirectly, via a function pointer,
1240 by __gnat_error_handler, and changing that pointer is allowed to the
1241 the user code by way of the __gnat_set_resignal_predicate interface.
1243 The user level function may then implement what it likes, including
1244 for instance the maintenance of a dynamic data structure if the set
1245 of to be resignalled conditions has to change over the program's
1248 ??? This is not a perfect solution to deal with the possible
1249 interactions between the GNAT and the DECAda exception handling
1250 models and better (more general) schemes are studied. This is so
1251 just provided as a convenient workaround in the meantime, and
1252 should be use with caution since the implementation has been kept
1256 resignal_predicate (int code);
1258 static const int * const cond_resignal_table [] = {
1264 (int *) RDB$_STREAM_EOF,
1265 (int *) FDL$_UNPRIKW,
1269 static const int facility_resignal_table [] = {
1270 0x1380000, /* RDB */
1271 0x2220000, /* SQL */
1275 /* Default GNAT predicate for resignaling conditions. */
1278 __gnat_default_resignal_p (int code)
1282 for (i = 0; facility_resignal_table [i]; i++)
1283 if ((code & 0xfff0000) == facility_resignal_table [i])
1286 for (i = 0, iexcept = 0;
1287 cond_resignal_table [i] &&
1288 !(iexcept = LIB$MATCH_COND (&code, &cond_resignal_table [i]));
1294 /* Static pointer to predicate that the __gnat_error_handler exception
1295 vector invokes to determine if it should resignal a condition. */
1297 static resignal_predicate *__gnat_resignal_p = __gnat_default_resignal_p;
1299 /* User interface to change the predicate pointer to PREDICATE. Reset to
1300 the default if PREDICATE is null. */
1303 __gnat_set_resignal_predicate (resignal_predicate *predicate)
1305 if (predicate == NULL)
1306 __gnat_resignal_p = __gnat_default_resignal_p;
1308 __gnat_resignal_p = predicate;
1311 /* Should match System.Parameters.Default_Exception_Msg_Max_Length. */
1312 #define Default_Exception_Msg_Max_Length 512
1314 /* Action routine for SYS$PUTMSG. There may be multiple
1315 conditions, each with text to be appended to MESSAGE
1316 and separated by line termination. */
1319 copy_msg (struct descriptor_s *msgdesc, char *message)
1321 int len = strlen (message);
1324 /* Check for buffer overflow and skip. */
1325 if (len > 0 && len <= Default_Exception_Msg_Max_Length - 3)
1327 strcat (message, "\r\n");
1331 /* Check for buffer overflow and truncate if necessary. */
1332 copy_len = (len + msgdesc->len <= Default_Exception_Msg_Max_Length - 1 ?
1334 Default_Exception_Msg_Max_Length - 1 - len);
1335 strncpy (&message [len], msgdesc->adr, copy_len);
1336 message [len + copy_len] = 0;
1342 __gnat_handle_vms_condition (int *sigargs, void *mechargs)
1344 struct Exception_Data *exception = 0;
1345 Exception_Code base_code;
1346 struct descriptor_s gnat_facility = {4, 0, "GNAT"};
1347 char message [Default_Exception_Msg_Max_Length];
1349 const char *msg = "";
1351 /* Check for conditions to resignal which aren't effected by pragma
1352 Import_Exception. */
1353 if (__gnat_resignal_p (sigargs [1]))
1354 return SS$_RESIGNAL;
1357 /* See if it's an imported exception. Beware that registered exceptions
1358 are bound to their base code, with the severity bits masked off. */
1359 base_code = Base_Code_In ((Exception_Code) sigargs[1]);
1360 exception = Coded_Exception (base_code);
1366 /* Subtract PC & PSL fields which messes with PUTMSG. */
1368 SYS$PUTMSG (sigargs, copy_msg, &gnat_facility, message);
1372 exception->Name_Length = 19;
1373 /* ??? The full name really should be get sys$getmsg returns. */
1374 exception->Full_Name = "IMPORTED_EXCEPTION";
1375 exception->Import_Code = base_code;
1378 /* Do not adjust the program counter as already points to the next
1379 instruction (just after the call to LIB$STOP). */
1380 Raise_From_Signal_Handler (exception, msg);
1389 if (sigargs[3] == 0)
1391 exception = &constraint_error;
1392 msg = "access zero";
1396 exception = &storage_error;
1397 msg = "stack overflow (or erroneous memory access)";
1399 __gnat_adjust_context_for_raise (SS$_ACCVIO, (void *)mechargs);
1403 exception = &storage_error;
1404 msg = "stack overflow";
1405 __gnat_adjust_context_for_raise (SS$_STKOVF, (void *)mechargs);
1410 return SS$_RESIGNAL; /* toplev.c handles for compiler */
1412 exception = &constraint_error;
1413 msg = "arithmetic error";
1414 __gnat_adjust_context_for_raise (SS$_HPARITH, (void *)mechargs);
1423 /* Scan the DEC Ada exception condition table for a match and fetch
1424 the associated GNAT exception pointer. */
1426 dec_ada_cond_except_table [i].cond &&
1427 !LIB$MATCH_COND (&sigargs [1],
1428 &dec_ada_cond_except_table [i].cond);
1430 exception = (struct Exception_Data *)
1431 dec_ada_cond_except_table [i].except;
1435 /* Scan the VMS standard condition table for a match and fetch
1436 the associated GNAT exception pointer. */
1438 cond_except_table[i].cond &&
1439 !LIB$MATCH_COND (&sigargs[1], &cond_except_table[i].cond);
1441 exception = (struct Exception_Data *)
1442 cond_except_table [i].except;
1445 /* User programs expect Non_Ada_Error to be raised, reference
1446 DEC Ada test CXCONDHAN. */
1447 exception = &Non_Ada_Error;
1451 exception = &program_error;
1454 /* Subtract PC & PSL fields which messes with PUTMSG. */
1456 SYS$PUTMSG (sigargs, copy_msg, &gnat_facility, message);
1462 Raise_From_Signal_Handler (exception, msg);
1466 __gnat_install_handler (void)
1468 long prvhnd ATTRIBUTE_UNUSED;
1470 #if !defined (IN_RTS)
1471 SYS$SETEXV (1, __gnat_handle_vms_condition, 3, &prvhnd);
1474 __gnat_handler_installed = 1;
1477 /* __gnat_adjust_context_for_raise for Alpha - see comments along with the
1478 default version later in this file. */
1480 #if defined (IN_RTS) && defined (__alpha__)
1482 #include <vms/chfctxdef.h>
1483 #include <vms/chfdef.h>
1485 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
1488 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
1490 if (signo == SS$_HPARITH)
1492 /* Sub one to the address of the instruction signaling the condition,
1493 located in the sigargs array. */
1495 CHF$MECH_ARRAY * mechargs = (CHF$MECH_ARRAY *) ucontext;
1496 CHF$SIGNAL_ARRAY * sigargs
1497 = (CHF$SIGNAL_ARRAY *) mechargs->chf$q_mch_sig_addr;
1499 int vcount = sigargs->chf$is_sig_args;
1500 int * pc_slot = & (&sigargs->chf$l_sig_name)[vcount-2];
1508 /* __gnat_adjust_context_for_raise for ia64. */
1510 #if defined (IN_RTS) && defined (__IA64)
1512 #include <vms/chfctxdef.h>
1513 #include <vms/chfdef.h>
1515 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
1517 typedef unsigned long long u64;
1520 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
1522 /* Add one to the address of the instruction signaling the condition,
1523 located in the 64bits sigargs array. */
1525 CHF$MECH_ARRAY * mechargs = (CHF$MECH_ARRAY *) ucontext;
1527 CHF64$SIGNAL_ARRAY *chfsig64
1528 = (CHF64$SIGNAL_ARRAY *) mechargs->chf$ph_mch_sig64_addr;
1531 = (u64 *)chfsig64 + 1 + chfsig64->chf64$l_sig_args;
1533 u64 * ih_pc_loc = post_sigarray - 2;
1540 /* Easier interface for LIB$GET_LOGICAL: put the equivalence of NAME into BUF,
1541 always NUL terminated. In case of error or if the result is longer than
1542 LEN (length of BUF) an empty string is written info BUF. */
1545 __gnat_vms_get_logical (const char *name, char *buf, int len)
1547 struct descriptor_s name_desc, result_desc;
1549 unsigned short rlen;
1551 /* Build the descriptor for NAME. */
1552 name_desc.len = strlen (name);
1554 name_desc.adr = (char *)name;
1556 /* Build the descriptor for the result. */
1557 result_desc.len = len;
1558 result_desc.mbz = 0;
1559 result_desc.adr = buf;
1561 status = LIB$GET_LOGICAL (&name_desc, &result_desc, &rlen);
1563 if ((status & 1) == 1 && rlen < len)
1569 /* Size of a page on ia64 and alpha VMS. */
1570 #define VMS_PAGESIZE 8192
1573 #define PSL__C_USER 3
1578 /* Descending region. */
1579 #define VA__M_DESCEND 1
1581 /* Get by virtual address. */
1582 #define VA___REGSUM_BY_VA 1
1584 /* Memory region summary. */
1587 unsigned long long q_region_id;
1588 unsigned int l_flags;
1589 unsigned int l_region_protection;
1591 unsigned long long q_region_size;
1592 void *pq_first_free_va;
1595 extern int SYS$GET_REGION_INFO (unsigned int, unsigned long long *,
1596 void *, void *, unsigned int,
1597 void *, unsigned int *);
1598 extern int SYS$EXPREG_64 (unsigned long long *, unsigned long long,
1599 unsigned int, unsigned int, void **,
1600 unsigned long long *);
1601 extern int SYS$SETPRT_64 (void *, unsigned long long, unsigned int,
1602 unsigned int, void **, unsigned long long *,
1604 extern int SYS$PUTMSG (void *, int (*)(), void *, unsigned long long);
1606 /* Add a guard page in the memory region containing ADDR at ADDR +/- SIZE.
1607 (The sign depends on the kind of the memory region). */
1610 __gnat_set_stack_guard_page (void *addr, unsigned long size)
1614 unsigned long long ret_len;
1615 unsigned int ret_prot;
1617 unsigned long long length;
1618 unsigned int retlen;
1619 struct regsum buffer;
1621 /* Get the region for ADDR. */
1622 status = SYS$GET_REGION_INFO
1623 (VA___REGSUM_BY_VA, NULL, addr, NULL, sizeof (buffer), &buffer, &retlen);
1625 if ((status & 1) != 1)
1628 /* Extend the region. */
1629 status = SYS$EXPREG_64 (&buffer.q_region_id,
1630 size, 0, 0, &start_va, &length);
1632 if ((status & 1) != 1)
1635 /* Create a guard page. */
1636 if (!(buffer.l_flags & VA__M_DESCEND))
1637 start_va = (void *)((unsigned long long)start_va + length - VMS_PAGESIZE);
1639 status = SYS$SETPRT_64 (start_va, VMS_PAGESIZE, PSL__C_USER, PRT__C_NA,
1640 &ret_va, &ret_len, &ret_prot);
1642 if ((status & 1) != 1)
1647 /* Read logicals to limit the stack(s) size. */
1650 __gnat_set_stack_limit (void)
1658 /* The main stack. */
1659 __gnat_vms_get_logical ("GNAT_STACK_SIZE", value, sizeof (value));
1660 size = strtoul (value, &e, 0);
1661 if (e > value && *e == 0)
1663 asm ("mov %0=sp" : "=r" (sp));
1664 __gnat_set_stack_guard_page (sp, size * 1024);
1667 /* The register stack. */
1668 __gnat_vms_get_logical ("GNAT_RBS_SIZE", value, sizeof (value));
1669 size = strtoul (value, &e, 0);
1670 if (e > value && *e == 0)
1672 asm ("mov %0=ar.bsp" : "=r" (sp));
1673 __gnat_set_stack_guard_page (sp, size * 1024);
1678 /* Feature logical name and global variable address pair.
1679 If we ever add another feature logical to this list, the
1680 feature struct will need to be enhanced to take into account
1681 possible values for *gl_addr. */
1687 /* Default values for GNAT features set by environment. */
1688 int __gl_heap_size = 64;
1690 /* Array feature logical names and global variable addresses. */
1691 static const struct feature features[] = {
1692 {"GNAT$NO_MALLOC_64", &__gl_heap_size},
1697 __gnat_set_features (void)
1702 /* Loop through features array and test name for enable/disable. */
1703 for (i = 0; features[i].name; i++)
1705 __gnat_vms_get_logical (features[i].name, buff, sizeof (buff));
1707 if (strcmp (buff, "ENABLE") == 0
1708 || strcmp (buff, "TRUE") == 0
1709 || strcmp (buff, "1") == 0)
1710 *features[i].gl_addr = 32;
1711 else if (strcmp (buff, "DISABLE") == 0
1712 || strcmp (buff, "FALSE") == 0
1713 || strcmp (buff, "0") == 0)
1714 *features[i].gl_addr = 64;
1717 /* Features to artificially limit the stack size. */
1718 __gnat_set_stack_limit ();
1720 __gnat_features_set = 1;
1723 /*******************/
1724 /* FreeBSD Section */
1725 /*******************/
1727 #elif defined (__FreeBSD__)
1730 #include <sys/ucontext.h>
1734 __gnat_error_handler (int sig,
1735 siginfo_t *si ATTRIBUTE_UNUSED,
1736 void *ucontext ATTRIBUTE_UNUSED)
1738 struct Exception_Data *exception;
1744 exception = &constraint_error;
1749 exception = &constraint_error;
1754 exception = &storage_error;
1755 msg = "stack overflow or erroneous memory access";
1759 exception = &constraint_error;
1764 exception = &program_error;
1765 msg = "unhandled signal";
1768 Raise_From_Signal_Handler (exception, msg);
1772 __gnat_install_handler ()
1774 struct sigaction act;
1776 /* Set up signal handler to map synchronous signals to appropriate
1777 exceptions. Make sure that the handler isn't interrupted by another
1778 signal that might cause a scheduling event! */
1781 = (void (*)(int, struct __siginfo *, void*)) __gnat_error_handler;
1782 act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
1783 (void) sigemptyset (&act.sa_mask);
1785 (void) sigaction (SIGILL, &act, NULL);
1786 (void) sigaction (SIGFPE, &act, NULL);
1787 (void) sigaction (SIGSEGV, &act, NULL);
1788 (void) sigaction (SIGBUS, &act, NULL);
1790 __gnat_handler_installed = 1;
1793 /*******************/
1794 /* VxWorks Section */
1795 /*******************/
1797 #elif defined(__vxworks)
1800 #include <taskLib.h>
1808 #include "private/vThreadsP.h"
1811 void __gnat_error_handler (int, void *, struct sigcontext *);
1815 /* Directly vectored Interrupt routines are not supported when using RTPs. */
1817 extern int __gnat_inum_to_ivec (int);
1819 /* This is needed by the GNAT run time to handle Vxworks interrupts. */
1821 __gnat_inum_to_ivec (int num)
1823 return INUM_TO_IVEC (num);
1827 #if !defined(__alpha_vxworks) && (_WRS_VXWORKS_MAJOR != 6) && !defined(__RTP__)
1829 /* getpid is used by s-parint.adb, but is not defined by VxWorks, except
1830 on Alpha VxWorks and VxWorks 6.x (including RTPs). */
1832 extern long getpid (void);
1837 return taskIdSelf ();
1841 /* VxWorks 653 vThreads expects the field excCnt to be zeroed when a signal is.
1842 handled. The VxWorks version of longjmp does this; GCC's builtin_longjmp
1845 __gnat_clear_exception_count (void)
1848 WIND_TCB *currentTask = (WIND_TCB *) taskIdSelf();
1850 currentTask->vThreads.excCnt = 0;
1854 /* Handle different SIGnal to exception mappings in different VxWorks
1857 __gnat_map_signal (int sig)
1859 struct Exception_Data *exception;
1865 exception = &constraint_error;
1869 #ifdef __VXWORKSMILS__
1871 exception = &storage_error;
1872 msg = "SIGILL: possible stack overflow";
1875 exception = &storage_error;
1879 exception = &program_error;
1884 exception = &constraint_error;
1885 msg = "Floating point exception or SIGILL";
1888 exception = &storage_error;
1892 exception = &storage_error;
1893 msg = "SIGBUS: possible stack overflow";
1896 #elif (_WRS_VXWORKS_MAJOR == 6)
1898 exception = &constraint_error;
1902 /* In RTP mode a SIGSEGV is most likely due to a stack overflow,
1903 since stack checking uses the probing mechanism. */
1905 exception = &storage_error;
1906 msg = "SIGSEGV: possible stack overflow";
1909 exception = &program_error;
1913 /* VxWorks 6 kernel mode with probing. SIGBUS for guard page hit */
1915 exception = &storage_error;
1919 exception = &storage_error;
1920 msg = "SIGBUS: possible stack overflow";
1924 /* VxWorks 5: a SIGILL is most likely due to a stack overflow,
1925 since stack checking uses the stack limit mechanism. */
1927 exception = &storage_error;
1928 msg = "SIGILL: possible stack overflow";
1931 exception = &storage_error;
1935 exception = &program_error;
1940 exception = &program_error;
1941 msg = "unhandled signal";
1944 __gnat_clear_exception_count ();
1945 Raise_From_Signal_Handler (exception, msg);
1948 /* Tasking and Non-tasking signal handler. Map SIGnal to Ada exception
1949 propagation after the required low level adjustments. */
1952 __gnat_error_handler (int sig,
1953 void *si ATTRIBUTE_UNUSED,
1954 struct sigcontext *sc ATTRIBUTE_UNUSED)
1958 /* VxWorks will always mask out the signal during the signal handler and
1959 will reenable it on a longjmp. GNAT does not generate a longjmp to
1960 return from a signal handler so the signal will still be masked unless
1962 sigprocmask (SIG_SETMASK, NULL, &mask);
1963 sigdelset (&mask, sig);
1964 sigprocmask (SIG_SETMASK, &mask, NULL);
1966 __gnat_map_signal (sig);
1970 __gnat_install_handler (void)
1972 struct sigaction act;
1974 /* Setup signal handler to map synchronous signals to appropriate
1975 exceptions. Make sure that the handler isn't interrupted by another
1976 signal that might cause a scheduling event! */
1978 act.sa_handler = __gnat_error_handler;
1979 act.sa_flags = SA_SIGINFO | SA_ONSTACK;
1980 sigemptyset (&act.sa_mask);
1982 /* For VxWorks, install all signal handlers, since pragma Interrupt_State
1983 applies to vectored hardware interrupts, not signals. */
1984 sigaction (SIGFPE, &act, NULL);
1985 sigaction (SIGILL, &act, NULL);
1986 sigaction (SIGSEGV, &act, NULL);
1987 sigaction (SIGBUS, &act, NULL);
1989 __gnat_handler_installed = 1;
1992 #define HAVE_GNAT_INIT_FLOAT
1995 __gnat_init_float (void)
1997 /* Disable overflow/underflow exceptions on the PPC processor, needed
1998 to get correct Ada semantics. Note that for AE653 vThreads, the HW
1999 overflow settings are an OS configuration issue. The instructions
2000 below have no effect. */
2001 #if defined (_ARCH_PPC) && !defined (_SOFT_FLOAT) && !defined (VTHREADS)
2002 #if defined (__SPE__)
2004 const unsigned long spefscr_mask = 0xfffffff3;
2005 unsigned long spefscr;
2006 asm ("mfspr %0, 512" : "=r" (spefscr));
2007 spefscr = spefscr & spefscr_mask;
2008 asm ("mtspr 512, %0\n\tisync" : : "r" (spefscr));
2016 #if (defined (__i386__) || defined (i386)) && !defined (VTHREADS)
2017 /* This is used to properly initialize the FPU on an x86 for each
2022 /* Similarly for SPARC64. Achieved by masking bits in the Trap Enable Mask
2023 field of the Floating-point Status Register (see the SPARC Architecture
2024 Manual Version 9, p 48). */
2025 #if defined (sparc64)
2027 #define FSR_TEM_NVM (1 << 27) /* Invalid operand */
2028 #define FSR_TEM_OFM (1 << 26) /* Overflow */
2029 #define FSR_TEM_UFM (1 << 25) /* Underflow */
2030 #define FSR_TEM_DZM (1 << 24) /* Division by Zero */
2031 #define FSR_TEM_NXM (1 << 23) /* Inexact result */
2035 __asm__("st %%fsr, %0" : "=m" (fsr));
2036 fsr &= ~(FSR_TEM_OFM | FSR_TEM_UFM);
2037 __asm__("ld %0, %%fsr" : : "m" (fsr));
2042 /* This subprogram is called by System.Task_Primitives.Operations.Enter_Task
2043 (if not null) when a new task is created. It is initialized by
2044 System.Stack_Checking.Operations.Initialize_Stack_Limit.
2045 The use of a hook avoids to drag stack checking subprograms if stack
2046 checking is not used. */
2047 void (*__gnat_set_stack_limit_hook)(void) = (void (*)(void))0;
2049 /******************/
2050 /* NetBSD Section */
2051 /******************/
2053 #elif defined(__NetBSD__)
2059 __gnat_error_handler (int sig)
2061 struct Exception_Data *exception;
2067 exception = &constraint_error;
2071 exception = &constraint_error;
2075 exception = &storage_error;
2076 msg = "stack overflow or erroneous memory access";
2079 exception = &constraint_error;
2083 exception = &program_error;
2084 msg = "unhandled signal";
2087 Raise_From_Signal_Handler(exception, msg);
2091 __gnat_install_handler(void)
2093 struct sigaction act;
2095 act.sa_handler = __gnat_error_handler;
2096 act.sa_flags = SA_NODEFER | SA_RESTART;
2097 sigemptyset (&act.sa_mask);
2099 /* Do not install handlers if interrupt state is "System". */
2100 if (__gnat_get_interrupt_state (SIGFPE) != 's')
2101 sigaction (SIGFPE, &act, NULL);
2102 if (__gnat_get_interrupt_state (SIGILL) != 's')
2103 sigaction (SIGILL, &act, NULL);
2104 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
2105 sigaction (SIGSEGV, &act, NULL);
2106 if (__gnat_get_interrupt_state (SIGBUS) != 's')
2107 sigaction (SIGBUS, &act, NULL);
2109 __gnat_handler_installed = 1;
2112 /*******************/
2113 /* OpenBSD Section */
2114 /*******************/
2116 #elif defined(__OpenBSD__)
2122 __gnat_error_handler (int sig)
2124 struct Exception_Data *exception;
2130 exception = &constraint_error;
2134 exception = &constraint_error;
2138 exception = &storage_error;
2139 msg = "stack overflow or erroneous memory access";
2142 exception = &constraint_error;
2146 exception = &program_error;
2147 msg = "unhandled signal";
2150 Raise_From_Signal_Handler(exception, msg);
2154 __gnat_install_handler(void)
2156 struct sigaction act;
2158 act.sa_handler = __gnat_error_handler;
2159 act.sa_flags = SA_NODEFER | SA_RESTART;
2160 sigemptyset (&act.sa_mask);
2162 /* Do not install handlers if interrupt state is "System" */
2163 if (__gnat_get_interrupt_state (SIGFPE) != 's')
2164 sigaction (SIGFPE, &act, NULL);
2165 if (__gnat_get_interrupt_state (SIGILL) != 's')
2166 sigaction (SIGILL, &act, NULL);
2167 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
2168 sigaction (SIGSEGV, &act, NULL);
2169 if (__gnat_get_interrupt_state (SIGBUS) != 's')
2170 sigaction (SIGBUS, &act, NULL);
2172 __gnat_handler_installed = 1;
2175 /******************/
2176 /* Darwin Section */
2177 /******************/
2179 #elif defined(__APPLE__)
2182 #include <sys/syscall.h>
2183 #include <mach/mach_vm.h>
2184 #include <mach/mach_init.h>
2185 #include <mach/vm_statistics.h>
2187 /* This must be in keeping with System.OS_Interface.Alternate_Stack_Size. */
2188 char __gnat_alternate_stack[32 * 1024]; /* 1 * MINSIGSTKSZ */
2190 /* Defined in xnu unix_signal.c.
2191 Tell the kernel to re-use alt stack when delivering a signal. */
2192 #define UC_RESET_ALT_STACK 0x80000000
2194 /* Return true if ADDR is within a stack guard area. */
2196 __gnat_is_stack_guard (mach_vm_address_t addr)
2199 vm_region_submap_info_data_64_t info;
2200 mach_vm_address_t start;
2201 mach_vm_size_t size;
2203 mach_msg_type_number_t count;
2205 count = VM_REGION_SUBMAP_INFO_COUNT_64;
2209 kret = mach_vm_region_recurse (mach_task_self (), &start, &size, &depth,
2210 (vm_region_recurse_info_t) &info, &count);
2211 if (kret == KERN_SUCCESS
2212 && addr >= start && addr < (start + size)
2213 && info.protection == VM_PROT_NONE
2214 && info.user_tag == VM_MEMORY_STACK)
2220 __gnat_error_handler (int sig, siginfo_t *si, void *ucontext ATTRIBUTE_UNUSED)
2222 struct Exception_Data *exception;
2229 if (__gnat_is_stack_guard ((unsigned long)si->si_addr))
2231 exception = &storage_error;
2232 msg = "stack overflow";
2236 exception = &constraint_error;
2237 msg = "erroneous memory access";
2239 /* Reset the use of alt stack, so that the alt stack will be used
2240 for the next signal delivery.
2241 The stack can't be used in case of stack checking. */
2242 syscall (SYS_sigreturn, NULL, UC_RESET_ALT_STACK);
2246 exception = &constraint_error;
2251 exception = &program_error;
2252 msg = "unhandled signal";
2255 Raise_From_Signal_Handler (exception, msg);
2259 __gnat_install_handler (void)
2261 struct sigaction act;
2263 /* Set up signal handler to map synchronous signals to appropriate
2264 exceptions. Make sure that the handler isn't interrupted by another
2265 signal that might cause a scheduling event! Also setup an alternate
2266 stack region for the handler execution so that stack overflows can be
2267 handled properly, avoiding a SEGV generation from stack usage by the
2268 handler itself (and it is required by Darwin). */
2271 stack.ss_sp = __gnat_alternate_stack;
2272 stack.ss_size = sizeof (__gnat_alternate_stack);
2274 sigaltstack (&stack, NULL);
2276 act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
2277 act.sa_sigaction = __gnat_error_handler;
2278 sigemptyset (&act.sa_mask);
2280 /* Do not install handlers if interrupt state is "System". */
2281 if (__gnat_get_interrupt_state (SIGABRT) != 's')
2282 sigaction (SIGABRT, &act, NULL);
2283 if (__gnat_get_interrupt_state (SIGFPE) != 's')
2284 sigaction (SIGFPE, &act, NULL);
2285 if (__gnat_get_interrupt_state (SIGILL) != 's')
2286 sigaction (SIGILL, &act, NULL);
2288 act.sa_flags |= SA_ONSTACK;
2289 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
2290 sigaction (SIGSEGV, &act, NULL);
2291 if (__gnat_get_interrupt_state (SIGBUS) != 's')
2292 sigaction (SIGBUS, &act, NULL);
2294 __gnat_handler_installed = 1;
2299 /* For all other versions of GNAT, the handler does nothing. */
2301 /*******************/
2302 /* Default Section */
2303 /*******************/
2306 __gnat_install_handler (void)
2308 __gnat_handler_installed = 1;
2313 /*********************/
2314 /* __gnat_init_float */
2315 /*********************/
2317 /* This routine is called as each process thread is created, for possible
2318 initialization of the FP processor. This version is used under INTERIX
2321 #if defined (_WIN32) || defined (__INTERIX) \
2322 || defined (__Lynx__) || defined(__NetBSD__) || defined(__FreeBSD__) \
2323 || defined (__OpenBSD__)
2325 #define HAVE_GNAT_INIT_FLOAT
2328 __gnat_init_float (void)
2330 #if defined (__i386__) || defined (i386) || defined (__x86_64)
2332 /* This is used to properly initialize the FPU on an x86 for each
2337 #endif /* Defined __i386__ */
2341 #ifndef HAVE_GNAT_INIT_FLOAT
2343 /* All targets without a specific __gnat_init_float will use an empty one. */
2345 __gnat_init_float (void)
2350 /***********************************/
2351 /* __gnat_adjust_context_for_raise */
2352 /***********************************/
2354 #ifndef HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
2356 /* All targets without a specific version will use an empty one. */
2358 /* Given UCONTEXT a pointer to a context structure received by a signal
2359 handler for SIGNO, perform the necessary adjustments to let the handler
2360 raise an exception. Calls to this routine are not conditioned by the
2361 propagation scheme in use. */
2364 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED,
2365 void *ucontext ATTRIBUTE_UNUSED)
2367 /* We used to compensate here for the raised from call vs raised from signal
2368 exception discrepancy with the GCC ZCX scheme, but this now can be dealt
2369 with generically in the unwinder (see GCC PR other/26208). This however
2370 requires the use of the _Unwind_GetIPInfo routine in raise-gcc.c, which
2371 is predicated on the definition of HAVE_GETIPINFO at compile time. Only
2372 the VMS ports still do the compensation described in the few lines below.
2374 *** Call vs signal exception discrepancy with GCC ZCX scheme ***
2376 The GCC unwinder expects to be dealing with call return addresses, since
2377 this is the "nominal" case of what we retrieve while unwinding a regular
2380 To evaluate if a handler applies at some point identified by a return
2381 address, the propagation engine needs to determine what region the
2382 corresponding call instruction pertains to. Because the return address
2383 may not be attached to the same region as the call, the unwinder always
2384 subtracts "some" amount from a return address to search the region
2385 tables, amount chosen to ensure that the resulting address is inside the
2388 When we raise an exception from a signal handler, e.g. to transform a
2389 SIGSEGV into Storage_Error, things need to appear as if the signal
2390 handler had been "called" by the instruction which triggered the signal,
2391 so that exception handlers that apply there are considered. What the
2392 unwinder will retrieve as the return address from the signal handler is
2393 what it will find as the faulting instruction address in the signal
2394 context pushed by the kernel. Leaving this address untouched looses, if
2395 the triggering instruction happens to be the very first of a region, as
2396 the later adjustments performed by the unwinder would yield an address
2397 outside that region. We need to compensate for the unwinder adjustments
2398 at some point, and this is what this routine is expected to do.
2400 signo is passed because on some targets for some signals the PC in
2401 context points to the instruction after the faulting one, in which case
2402 the unwinder adjustment is still desired. */