1 /****************************************************************************
3 * GNAT COMPILER COMPONENTS *
7 * C Implementation File *
9 * Copyright (C) 1992-2021, 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 s-init.ads, s-init.adb and the
42 s-init-*.adb variants. All these files implement the required functionality
43 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. */
49 #include "version.h" /* for _WRS_VXWORKS_MAJOR */
67 /* We don't have libiberty, so use malloc. */
68 #define xmalloc(S) malloc (S)
81 extern void __gnat_raise_program_error (const void *, int);
83 /* Addresses of exception data blocks for predefined exceptions. Tasking_Error
84 is not used in this unit, and the abort signal is only used on IRIX.
85 ??? Revisit this part since IRIX is no longer supported. */
86 extern struct Exception_Data constraint_error
;
87 extern struct Exception_Data numeric_error
;
88 extern struct Exception_Data program_error
;
89 extern struct Exception_Data storage_error
;
91 /* For the Cert run time we use the regular raise exception routine because
92 __gnat_raise_from_signal_handler is not available. */
94 #define Raise_From_Signal_Handler __gnat_raise_exception
96 #define Raise_From_Signal_Handler __gnat_raise_from_signal_handler
99 extern void Raise_From_Signal_Handler (struct Exception_Data
*, const void *)
102 /* Global values computed by the binder. Note that these variables are
103 declared here, not in the binder file, to avoid having unresolved
104 references in the shared libgnat. */
105 int __gl_main_priority
= -1;
106 int __gl_main_cpu
= -1;
107 int __gl_time_slice_val
= -1;
108 char __gl_wc_encoding
= 'n';
109 char __gl_locking_policy
= ' ';
110 char __gl_queuing_policy
= ' ';
111 char __gl_task_dispatching_policy
= ' ';
112 char *__gl_priority_specific_dispatching
= 0;
113 int __gl_num_specific_dispatching
= 0;
114 char *__gl_interrupt_states
= 0;
115 int __gl_num_interrupt_states
= 0;
116 int __gl_unreserve_all_interrupts
= 0;
117 int __gl_exception_tracebacks
= 0;
118 int __gl_exception_tracebacks_symbolic
= 0;
119 int __gl_detect_blocking
= 0;
120 int __gl_default_stack_size
= -1;
121 int __gl_leap_seconds_support
= 0;
122 int __gl_canonical_streams
= 0;
123 char *__gl_bind_env_addr
= NULL
;
124 int __gl_xdr_stream
= 0;
126 /* This value is not used anymore, but kept for bootstrapping purpose. */
127 int __gl_zero_cost_exceptions
= 0;
129 /* Indication of whether synchronous signal handler has already been
130 installed by a previous call to adainit. */
131 int __gnat_handler_installed
= 0;
134 int __gnat_inside_elab_final_code
= 0;
135 /* ??? This variable is obsolete since 2001-08-29 but is kept to allow
136 bootstrap from old GNAT versions (< 3.15). */
139 /* HAVE_GNAT_INIT_FLOAT must be set on every targets where a __gnat_init_float
140 is defined. If this is not set then a void implementation will be defined
141 at the end of this unit. */
142 #undef HAVE_GNAT_INIT_FLOAT
144 /******************************/
145 /* __gnat_get_interrupt_state */
146 /******************************/
148 char __gnat_get_interrupt_state (int);
150 /* This routine is called from the runtime as needed to determine the state
151 of an interrupt, as set by an Interrupt_State pragma appearing anywhere
152 in the current partition. The input argument is the interrupt number,
153 and the result is one of the following:
155 'n' this interrupt not set by any Interrupt_State pragma
156 'u' Interrupt_State pragma set state to User
157 'r' Interrupt_State pragma set state to Runtime
158 's' Interrupt_State pragma set state to System */
161 __gnat_get_interrupt_state (int intrup
)
163 if (intrup
>= __gl_num_interrupt_states
)
166 return __gl_interrupt_states
[intrup
];
169 /***********************************/
170 /* __gnat_get_specific_dispatching */
171 /***********************************/
173 char __gnat_get_specific_dispatching (int);
175 /* This routine is called from the runtime as needed to determine the
176 priority specific dispatching policy, as set by a
177 Priority_Specific_Dispatching pragma appearing anywhere in the current
178 partition. The input argument is the priority number, and the result
179 is the upper case first character of the policy name, e.g. 'F' for
180 FIFO_Within_Priorities. A space ' ' is returned if no
181 Priority_Specific_Dispatching pragma is used in the partition. */
184 __gnat_get_specific_dispatching (int priority
)
186 if (__gl_num_specific_dispatching
== 0)
188 else if (priority
>= __gl_num_specific_dispatching
)
191 return __gl_priority_specific_dispatching
[priority
];
196 /**********************/
197 /* __gnat_set_globals */
198 /**********************/
200 /* This routine is kept for bootstrapping purposes, since the binder generated
201 file now sets the __gl_* variables directly. */
204 __gnat_set_globals (void)
217 #include <sys/time.h>
219 /* Some versions of AIX don't define SA_NODEFER. */
223 #endif /* SA_NODEFER */
225 /* Versions of AIX before 4.3 don't have nanosleep but provide
228 #ifndef _AIXVERSION_430
230 extern int nanosleep (struct timestruc_t
*, struct timestruc_t
*);
233 nanosleep (struct timestruc_t
*Rqtp
, struct timestruc_t
*Rmtp
)
235 return nsleep (Rqtp
, Rmtp
);
238 #endif /* _AIXVERSION_430 */
241 __gnat_error_handler (int sig
,
242 siginfo_t
*si ATTRIBUTE_UNUSED
,
243 void *ucontext ATTRIBUTE_UNUSED
)
245 struct Exception_Data
*exception
;
251 /* FIXME: we need to detect the case of a *real* SIGSEGV. */
252 exception
= &storage_error
;
253 msg
= "stack overflow or erroneous memory access";
257 exception
= &constraint_error
;
262 exception
= &constraint_error
;
267 exception
= &program_error
;
268 msg
= "unhandled signal";
271 Raise_From_Signal_Handler (exception
, msg
);
275 __gnat_install_handler (void)
277 struct sigaction act
;
279 /* Set up signal handler to map synchronous signals to appropriate
280 exceptions. Make sure that the handler isn't interrupted by another
281 signal that might cause a scheduling event! */
283 act
.sa_flags
= SA_NODEFER
| SA_RESTART
| SA_SIGINFO
;
284 act
.sa_sigaction
= __gnat_error_handler
;
285 sigemptyset (&act
.sa_mask
);
287 /* Do not install handlers if interrupt state is "System". */
288 if (__gnat_get_interrupt_state (SIGABRT
) != 's')
289 sigaction (SIGABRT
, &act
, NULL
);
290 if (__gnat_get_interrupt_state (SIGFPE
) != 's')
291 sigaction (SIGFPE
, &act
, NULL
);
292 if (__gnat_get_interrupt_state (SIGILL
) != 's')
293 sigaction (SIGILL
, &act
, NULL
);
294 if (__gnat_get_interrupt_state (SIGSEGV
) != 's')
295 sigaction (SIGSEGV
, &act
, NULL
);
296 if (__gnat_get_interrupt_state (SIGBUS
) != 's')
297 sigaction (SIGBUS
, &act
, NULL
);
299 __gnat_handler_installed
= 1;
306 #elif defined (__hpux__)
309 #include <sys/ucontext.h>
311 #if defined (IN_RTS) && defined (__ia64__)
313 #include <sys/uc_access.h>
315 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
318 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED
, void *ucontext
)
320 ucontext_t
*uc
= (ucontext_t
*) ucontext
;
323 /* Adjust on itanium, as GetIPInfo is not supported. */
324 __uc_get_ip (uc
, &ip
);
325 __uc_set_ip (uc
, ip
+ 1);
327 #endif /* IN_RTS && __ia64__ */
329 /* Tasking and Non-tasking signal handler. Map SIGnal to Ada exception
330 propagation after the required low level adjustments. */
333 __gnat_error_handler (int sig
, siginfo_t
*si ATTRIBUTE_UNUSED
, void *ucontext
)
335 struct Exception_Data
*exception
;
338 __gnat_adjust_context_for_raise (sig
, ucontext
);
343 /* FIXME: we need to detect the case of a *real* SIGSEGV. */
344 exception
= &storage_error
;
345 msg
= "stack overflow or erroneous memory access";
349 exception
= &constraint_error
;
354 exception
= &constraint_error
;
359 exception
= &program_error
;
360 msg
= "unhandled signal";
363 Raise_From_Signal_Handler (exception
, msg
);
366 /* This must be in keeping with System.OS_Interface.Alternate_Stack_Size. */
367 #if defined (__hppa__)
368 char __gnat_alternate_stack
[16 * 1024]; /* 2 * SIGSTKSZ */
370 char __gnat_alternate_stack
[128 * 1024]; /* MINSIGSTKSZ */
374 __gnat_install_handler (void)
376 struct sigaction act
;
378 /* Set up signal handler to map synchronous signals to appropriate
379 exceptions. Make sure that the handler isn't interrupted by another
380 signal that might cause a scheduling event! Also setup an alternate
381 stack region for the handler execution so that stack overflows can be
382 handled properly, avoiding a SEGV generation from stack usage by the
386 stack
.ss_sp
= __gnat_alternate_stack
;
387 stack
.ss_size
= sizeof (__gnat_alternate_stack
);
389 sigaltstack (&stack
, NULL
);
391 act
.sa_sigaction
= __gnat_error_handler
;
392 act
.sa_flags
= SA_NODEFER
| SA_RESTART
| SA_SIGINFO
;
393 sigemptyset (&act
.sa_mask
);
395 /* Do not install handlers if interrupt state is "System". */
396 if (__gnat_get_interrupt_state (SIGABRT
) != 's')
397 sigaction (SIGABRT
, &act
, NULL
);
398 if (__gnat_get_interrupt_state (SIGFPE
) != 's')
399 sigaction (SIGFPE
, &act
, NULL
);
400 if (__gnat_get_interrupt_state (SIGILL
) != 's')
401 sigaction (SIGILL
, &act
, NULL
);
402 if (__gnat_get_interrupt_state (SIGBUS
) != 's')
403 sigaction (SIGBUS
, &act
, NULL
);
404 act
.sa_flags
|= SA_ONSTACK
;
405 if (__gnat_get_interrupt_state (SIGSEGV
) != 's')
406 sigaction (SIGSEGV
, &act
, NULL
);
408 __gnat_handler_installed
= 1;
411 /*********************/
412 /* GNU/Linux Section */
413 /*********************/
415 #elif defined (__linux__)
419 #define __USE_GNU 1 /* required to get REG_EIP/RIP from glibc's ucontext.h */
420 #include <sys/ucontext.h>
422 /* GNU/Linux, which uses glibc, does not define NULL in included
426 #define NULL ((void *) 0)
431 /* MaRTE OS provides its own version of sigaction, sigfillset, and
432 sigemptyset (overriding these symbol names). We want to make sure that
433 the versions provided by the underlying C library are used here (these
434 versions are renamed by MaRTE to linux_sigaction, fake_linux_sigfillset,
435 and fake_linux_sigemptyset, respectively). The MaRTE library will not
436 always be present (it will not be linked if no tasking constructs are
437 used), so we use the weak symbol mechanism to point always to the symbols
438 defined within the C library. */
440 #pragma weak linux_sigaction
441 int linux_sigaction (int signum
, const struct sigaction
*act
,
442 struct sigaction
*oldact
)
444 return sigaction (signum
, act
, oldact
);
446 #define sigaction(signum, act, oldact) linux_sigaction (signum, act, oldact)
448 #pragma weak fake_linux_sigfillset
449 void fake_linux_sigfillset (sigset_t
*set
)
453 #define sigfillset(set) fake_linux_sigfillset (set)
455 #pragma weak fake_linux_sigemptyset
456 void fake_linux_sigemptyset (sigset_t
*set
)
460 #define sigemptyset(set) fake_linux_sigemptyset (set)
464 #if defined (__i386__) || defined (__x86_64__) || defined (__ia64__) \
465 || defined (__ARMEL__)
467 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
470 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED
, void *ucontext
)
473 mcontext_t
*mcontext
= &((ucontext_t
*) ucontext
)->uc_mcontext
;
475 /* On the i386 and x86-64 architectures, stack checking is performed by
476 means of probes with moving stack pointer, that is to say the probed
477 address is always the value of the stack pointer. Upon hitting the
478 guard page, the stack pointer therefore points to an inaccessible
479 address and an alternate signal stack is needed to run the handler.
480 But there is an additional twist: on these architectures, the EH
481 return code writes the address of the handler at the target CFA's
482 value on the stack before doing the jump. As a consequence, if
483 there is an active handler in the frame whose stack has overflowed,
484 the stack pointer must nevertheless point to an accessible address
485 by the time the EH return is executed.
487 We therefore adjust the saved value of the stack pointer by the size
488 of one page + a small dope of 4 words, in order to make sure that it
489 points to an accessible address in case it's used as the target CFA.
490 The stack checking code guarantees that this address is unused by the
491 time this happens. */
493 #if defined (__i386__)
494 unsigned long *pc
= (unsigned long *)mcontext
->gregs
[REG_EIP
];
495 /* The pattern is "orl $0x0,(%esp)" for a probe in 32-bit mode. */
496 if (signo
== SIGSEGV
&& pc
&& *pc
== 0x00240c83)
497 mcontext
->gregs
[REG_ESP
] += 4096 + 4 * sizeof (unsigned long);
498 #elif defined (__x86_64__)
499 unsigned long long *pc
= (unsigned long long *)mcontext
->gregs
[REG_RIP
];
500 if (signo
== SIGSEGV
&& pc
501 /* The pattern is "orq $0x0,(%rsp)" for a probe in 64-bit mode. */
502 && ((*pc
& 0xffffffffffLL
) == 0x00240c8348LL
503 /* The pattern may also be "orl $0x0,(%esp)" for a probe in
505 || (*pc
& 0xffffffffLL
) == 0x00240c83LL
))
506 mcontext
->gregs
[REG_RSP
] += 4096 + 4 * sizeof (unsigned long);
507 #elif defined (__ia64__)
508 /* ??? The IA-64 unwinder doesn't compensate for signals. */
510 #elif defined (__ARMEL__)
511 /* ARM Bump has to be an even number because of odd/even architecture. */
514 #define CPSR_THUMB_BIT 5
515 /* For thumb, the return address much have the low order bit set, otherwise
516 the unwinder will reset to "arm" mode upon return. As long as the
517 compilation unit containing the landing pad is compiled with the same
518 mode (arm vs thumb) as the signaling compilation unit, this works. */
519 if (mcontext
->arm_cpsr
& (1<<CPSR_THUMB_BIT
))
529 __gnat_error_handler (int sig
, siginfo_t
*si ATTRIBUTE_UNUSED
, void *ucontext
)
531 struct Exception_Data
*exception
;
534 /* Adjusting is required for every fault context, so adjust for this one
535 now, before we possibly trigger a recursive fault below. */
536 __gnat_adjust_context_for_raise (sig
, ucontext
);
541 /* Here we would like a discrimination test to see whether the page
542 before the faulting address is accessible. Unfortunately, Linux
543 seems to have no way of giving us the faulting address.
545 In old versions of init.c, we had a test of the page before the
549 ((long) si->esp_at_signal & - getpagesize ()))[getpagesize ()];
551 but that's wrong since it tests the stack pointer location and the
552 stack probing code may not move it until all probes succeed.
554 For now we simply do not attempt any discrimination at all. Note
555 that this is quite acceptable, since a "real" SIGSEGV can only
556 occur as the result of an erroneous program. */
557 exception
= &storage_error
;
558 msg
= "stack overflow or erroneous memory access";
562 exception
= &storage_error
;
563 msg
= "SIGBUS: possible stack overflow";
567 exception
= &constraint_error
;
572 exception
= &program_error
;
573 msg
= "unhandled signal";
576 Raise_From_Signal_Handler (exception
, msg
);
580 #define HAVE_GNAT_ALTERNATE_STACK 1
581 /* This must be in keeping with System.OS_Interface.Alternate_Stack_Size. */
582 char __gnat_alternate_stack
[32 * 1024];
586 #include <sys/mman.h>
587 #include <native/task.h>
593 __gnat_install_handler (void)
595 struct sigaction act
;
600 if (__gl_main_priority
== -1)
603 prio
= __gl_main_priority
;
605 /* Avoid memory swapping for this program */
607 mlockall (MCL_CURRENT
|MCL_FUTURE
);
609 /* Turn the current Linux task into a native Xenomai task */
611 rt_task_shadow (&main_task
, "environment_task", prio
, T_FPU
);
614 /* Set up signal handler to map synchronous signals to appropriate
615 exceptions. Make sure that the handler isn't interrupted by another
616 signal that might cause a scheduling event! Also setup an alternate
617 stack region for the handler execution so that stack overflows can be
618 handled properly, avoiding a SEGV generation from stack usage by the
621 act
.sa_sigaction
= __gnat_error_handler
;
622 act
.sa_flags
= SA_NODEFER
| SA_RESTART
| SA_SIGINFO
;
623 sigemptyset (&act
.sa_mask
);
625 /* Do not install handlers if interrupt state is "System". */
626 if (__gnat_get_interrupt_state (SIGABRT
) != 's')
627 sigaction (SIGABRT
, &act
, NULL
);
628 if (__gnat_get_interrupt_state (SIGFPE
) != 's')
629 sigaction (SIGFPE
, &act
, NULL
);
630 if (__gnat_get_interrupt_state (SIGILL
) != 's')
631 sigaction (SIGILL
, &act
, NULL
);
632 if (__gnat_get_interrupt_state (SIGBUS
) != 's')
633 sigaction (SIGBUS
, &act
, NULL
);
634 if (__gnat_get_interrupt_state (SIGSEGV
) != 's')
636 #ifdef HAVE_GNAT_ALTERNATE_STACK
637 /* Setup an alternate stack region for the handler execution so that
638 stack overflows can be handled properly, avoiding a SEGV generation
639 from stack usage by the handler itself. */
642 stack
.ss_sp
= __gnat_alternate_stack
;
643 stack
.ss_size
= sizeof (__gnat_alternate_stack
);
645 sigaltstack (&stack
, NULL
);
647 act
.sa_flags
|= SA_ONSTACK
;
649 sigaction (SIGSEGV
, &act
, NULL
);
652 __gnat_handler_installed
= 1;
655 /*******************/
657 /*******************/
659 #elif defined (__Lynx__)
664 /* SA_SIGINFO is not supported by default on LynxOS, so all we have
665 available here is the "sig" argument. On newer LynxOS versions it's
666 possible to support SA_SIGINFO by setting a kernel configuration macro.
670 #define NONPOSIX_SA_HANDLER_PROTO (0)
672 This macro must be set to 1 in either sys/bsp.<bspname>/uparam.h
673 or in the associated uparam.h customization file sys/bsp.<bspname>/xparam.h
674 (uparam.h includes xparam.h for customization)
676 The NONPOSIX_SA_HANDLER_PROTO macro makes it possible to provide
677 signal-catching function with 'info' and 'context' input parameters
678 even if SA_SIGINFO flag is not set or it is set for a non-realtime signal.
680 It also allows signal-catching function to update thread context even
681 if SA_UPDATECTX flag is not set.
683 This would be useful, but relying on that would transmit the requirement
684 to users to configure that feature as well, which is undesirable. */
687 __gnat_error_handler (int sig
)
689 struct Exception_Data
*exception
;
695 exception
= &constraint_error
;
699 exception
= &constraint_error
;
703 exception
= &storage_error
;
704 msg
= "stack overflow or erroneous memory access";
707 exception
= &constraint_error
;
711 exception
= &program_error
;
712 msg
= "unhandled signal";
715 Raise_From_Signal_Handler (exception
, msg
);
719 __gnat_install_handler (void)
721 struct sigaction act
;
723 act
.sa_handler
= __gnat_error_handler
;
725 sigemptyset (&act
.sa_mask
);
727 /* Do not install handlers if interrupt state is "System". */
728 if (__gnat_get_interrupt_state (SIGFPE
) != 's')
729 sigaction (SIGFPE
, &act
, NULL
);
730 if (__gnat_get_interrupt_state (SIGILL
) != 's')
731 sigaction (SIGILL
, &act
, NULL
);
732 if (__gnat_get_interrupt_state (SIGSEGV
) != 's')
733 sigaction (SIGSEGV
, &act
, NULL
);
734 if (__gnat_get_interrupt_state (SIGBUS
) != 's')
735 sigaction (SIGBUS
, &act
, NULL
);
737 __gnat_handler_installed
= 1;
740 /*******************/
741 /* Solaris Section */
742 /*******************/
744 #elif defined (__sun__) && !defined (__vxworks)
748 #include <sys/ucontext.h>
749 #include <sys/regset.h>
752 __gnat_error_handler (int sig
, siginfo_t
*si
, void *ucontext ATTRIBUTE_UNUSED
)
754 struct Exception_Data
*exception
;
755 static int recurse
= 0;
761 /* If the problem was permissions, this is a constraint error.
762 Likewise if the failing address isn't maximally aligned or if
765 ??? Using a static variable here isn't task-safe, but it's
766 much too hard to do anything else and we're just determining
767 which exception to raise. */
768 if (si
->si_code
== SEGV_ACCERR
769 || (long) si
->si_addr
== 0
770 || (((long) si
->si_addr
) & 3) != 0
773 exception
= &constraint_error
;
778 /* See if the page before the faulting page is accessible. Do that
779 by trying to access it. We'd like to simply try to access
780 4096 + the faulting address, but it's not guaranteed to be
781 the actual address, just to be on the same page. */
784 ((long) si
->si_addr
& - getpagesize ()))[getpagesize ()];
785 exception
= &storage_error
;
786 msg
= "stack overflow or erroneous memory access";
791 exception
= &program_error
;
796 exception
= &constraint_error
;
801 exception
= &program_error
;
802 msg
= "unhandled signal";
806 Raise_From_Signal_Handler (exception
, msg
);
810 __gnat_install_handler (void)
812 struct sigaction act
;
814 /* Set up signal handler to map synchronous signals to appropriate
815 exceptions. Make sure that the handler isn't interrupted by another
816 signal that might cause a scheduling event! */
818 act
.sa_sigaction
= __gnat_error_handler
;
819 act
.sa_flags
= SA_NODEFER
| SA_RESTART
| SA_SIGINFO
;
820 sigemptyset (&act
.sa_mask
);
822 /* Do not install handlers if interrupt state is "System". */
823 if (__gnat_get_interrupt_state (SIGABRT
) != 's')
824 sigaction (SIGABRT
, &act
, NULL
);
825 if (__gnat_get_interrupt_state (SIGFPE
) != 's')
826 sigaction (SIGFPE
, &act
, NULL
);
827 if (__gnat_get_interrupt_state (SIGSEGV
) != 's')
828 sigaction (SIGSEGV
, &act
, NULL
);
829 if (__gnat_get_interrupt_state (SIGBUS
) != 's')
830 sigaction (SIGBUS
, &act
, NULL
);
832 __gnat_handler_installed
= 1;
841 /* Routine called from binder to override default feature values. */
842 void __gnat_set_features (void);
843 int __gnat_features_set
= 0;
844 void (*__gnat_ctrl_c_handler
) (void) = 0;
847 #define lib_get_curr_invo_context LIB$I64_GET_CURR_INVO_CONTEXT
848 #define lib_get_prev_invo_context LIB$I64_GET_PREV_INVO_CONTEXT
849 #define lib_get_invo_handle LIB$I64_GET_INVO_HANDLE
851 #define lib_get_curr_invo_context LIB$GET_CURR_INVO_CONTEXT
852 #define lib_get_prev_invo_context LIB$GET_PREV_INVO_CONTEXT
853 #define lib_get_invo_handle LIB$GET_INVO_HANDLE
856 /* Masks for facility identification. */
857 #define FAC_MASK 0x0fff0000
858 #define DECADA_M_FACILITY 0x00310000
860 /* Define macro symbols for the VMS conditions that become Ada exceptions.
861 It would be better to just include <ssdef.h> */
863 #define SS$_CONTINUE 1
864 #define SS$_ACCVIO 12
865 #define SS$_HPARITH 1284
866 #define SS$_INTDIV 1156
867 #define SS$_STKOVF 1364
868 #define SS$_CONTROLC 1617
869 #define SS$_RESIGNAL 2328
871 #define MTH$_FLOOVEMAT 1475268 /* Some ACVC_21 CXA tests */
873 /* The following codes must be resignalled, and not handled here. */
875 /* These codes are in standard message libraries. */
876 extern int C$_SIGKILL
;
877 extern int C$_SIGINT
;
878 extern int SS$_DEBUG
;
879 extern int LIB$_KEYNOTFOU
;
880 extern int LIB$_ACTIMAGE
;
882 /* These codes are non standard, which is to say the author is
883 not sure if they are defined in the standard message libraries
884 so keep them as macros for now. */
885 #define RDB$_STREAM_EOF 20480426
886 #define FDL$_UNPRIKW 11829410
887 #define CMA$_EXIT_THREAD 4227492
892 unsigned int sigargval
;
898 const struct cond_sigargs sigargs
[];
904 const struct Exception_Data
*except
;
905 unsigned int needs_adjust
; /* 1 = adjust PC, 0 = no adjust */
906 const struct cond_subtests
*subtests
;
911 unsigned short len
, mbz
;
915 /* Conditions that don't have an Ada exception counterpart must raise
916 Non_Ada_Error. Since this is defined in s-auxdec, it should only be
917 referenced by user programs, not the compiler or tools. Hence the
922 #define Status_Error ada__io_exceptions__status_error
923 extern struct Exception_Data Status_Error
;
925 #define Mode_Error ada__io_exceptions__mode_error
926 extern struct Exception_Data Mode_Error
;
928 #define Name_Error ada__io_exceptions__name_error
929 extern struct Exception_Data Name_Error
;
931 #define Use_Error ada__io_exceptions__use_error
932 extern struct Exception_Data Use_Error
;
934 #define Device_Error ada__io_exceptions__device_error
935 extern struct Exception_Data Device_Error
;
937 #define End_Error ada__io_exceptions__end_error
938 extern struct Exception_Data End_Error
;
940 #define Data_Error ada__io_exceptions__data_error
941 extern struct Exception_Data Data_Error
;
943 #define Layout_Error ada__io_exceptions__layout_error
944 extern struct Exception_Data Layout_Error
;
946 #define Non_Ada_Error system__aux_dec__non_ada_error
947 extern struct Exception_Data Non_Ada_Error
;
949 #define Coded_Exception system__vms_exception_table__coded_exception
950 extern struct Exception_Data
*Coded_Exception (void *);
952 #define Base_Code_In system__vms_exception_table__base_code_in
953 extern void *Base_Code_In (void *);
955 /* DEC Ada exceptions are not defined in a header file, so they
958 #define ADA$_ALREADY_OPEN 0x0031a594
959 #define ADA$_CONSTRAINT_ERRO 0x00318324
960 #define ADA$_DATA_ERROR 0x003192c4
961 #define ADA$_DEVICE_ERROR 0x003195e4
962 #define ADA$_END_ERROR 0x00319904
963 #define ADA$_FAC_MODE_MISMAT 0x0031a8b3
964 #define ADA$_IOSYSFAILED 0x0031af04
965 #define ADA$_KEYSIZERR 0x0031aa3c
966 #define ADA$_KEY_MISMATCH 0x0031a8e3
967 #define ADA$_LAYOUT_ERROR 0x00319c24
968 #define ADA$_LINEXCMRS 0x0031a8f3
969 #define ADA$_MAXLINEXC 0x0031a8eb
970 #define ADA$_MODE_ERROR 0x00319f44
971 #define ADA$_MRN_MISMATCH 0x0031a8db
972 #define ADA$_MRS_MISMATCH 0x0031a8d3
973 #define ADA$_NAME_ERROR 0x0031a264
974 #define ADA$_NOT_OPEN 0x0031a58c
975 #define ADA$_ORG_MISMATCH 0x0031a8bb
976 #define ADA$_PROGRAM_ERROR 0x00318964
977 #define ADA$_RAT_MISMATCH 0x0031a8cb
978 #define ADA$_RFM_MISMATCH 0x0031a8c3
979 #define ADA$_STAOVF 0x00318cac
980 #define ADA$_STATUS_ERROR 0x0031a584
981 #define ADA$_STORAGE_ERROR 0x00318c84
982 #define ADA$_UNSUPPORTED 0x0031a8ab
983 #define ADA$_USE_ERROR 0x0031a8a4
985 /* DEC Ada specific conditions. */
986 static const struct cond_except dec_ada_cond_except_table
[] =
988 {ADA$_PROGRAM_ERROR
, &program_error
, 0, 0},
989 {ADA$_USE_ERROR
, &Use_Error
, 0, 0},
990 {ADA$_KEYSIZERR
, &program_error
, 0, 0},
991 {ADA$_STAOVF
, &storage_error
, 0, 0},
992 {ADA$_CONSTRAINT_ERRO
, &constraint_error
, 0, 0},
993 {ADA$_IOSYSFAILED
, &Device_Error
, 0, 0},
994 {ADA$_LAYOUT_ERROR
, &Layout_Error
, 0, 0},
995 {ADA$_STORAGE_ERROR
, &storage_error
, 0, 0},
996 {ADA$_DATA_ERROR
, &Data_Error
, 0, 0},
997 {ADA$_DEVICE_ERROR
, &Device_Error
, 0, 0},
998 {ADA$_END_ERROR
, &End_Error
, 0, 0},
999 {ADA$_MODE_ERROR
, &Mode_Error
, 0, 0},
1000 {ADA$_NAME_ERROR
, &Name_Error
, 0, 0},
1001 {ADA$_STATUS_ERROR
, &Status_Error
, 0, 0},
1002 {ADA$_NOT_OPEN
, &Use_Error
, 0, 0},
1003 {ADA$_ALREADY_OPEN
, &Use_Error
, 0, 0},
1004 {ADA$_USE_ERROR
, &Use_Error
, 0, 0},
1005 {ADA$_UNSUPPORTED
, &Use_Error
, 0, 0},
1006 {ADA$_FAC_MODE_MISMAT
, &Use_Error
, 0, 0},
1007 {ADA$_ORG_MISMATCH
, &Use_Error
, 0, 0},
1008 {ADA$_RFM_MISMATCH
, &Use_Error
, 0, 0},
1009 {ADA$_RAT_MISMATCH
, &Use_Error
, 0, 0},
1010 {ADA$_MRS_MISMATCH
, &Use_Error
, 0, 0},
1011 {ADA$_MRN_MISMATCH
, &Use_Error
, 0, 0},
1012 {ADA$_KEY_MISMATCH
, &Use_Error
, 0, 0},
1013 {ADA$_MAXLINEXC
, &constraint_error
, 0, 0},
1014 {ADA$_LINEXCMRS
, &constraint_error
, 0, 0},
1017 /* Already handled by a pragma Import_Exception
1018 in Aux_IO_Exceptions */
1019 {ADA$_LOCK_ERROR
, &Lock_Error
, 0, 0},
1020 {ADA$_EXISTENCE_ERROR
, &Existence_Error
, 0, 0},
1021 {ADA$_KEY_ERROR
, &Key_Error
, 0, 0},
1029 /* Non-DEC Ada specific conditions that map to Ada exceptions. */
1031 /* Subtest for ACCVIO Constraint_Error, kept for compatibility,
1032 in hindsight should have just made ACCVIO == Storage_Error. */
1033 #define ACCVIO_VIRTUAL_ADDR 3
1034 static const struct cond_subtests accvio_c_e
=
1035 {1, /* number of subtests below */
1037 { ACCVIO_VIRTUAL_ADDR
, 0 }
1041 /* Macro flag to adjust PC which gets off by one for some conditions,
1042 not sure if this is reliably true, PC could be off by more for
1043 HPARITH for example, unless a trapb is inserted. */
1044 #define NEEDS_ADJUST 1
1046 static const struct cond_except system_cond_except_table
[] =
1048 {MTH$_FLOOVEMAT
, &constraint_error
, 0, 0},
1049 {SS$_INTDIV
, &constraint_error
, 0, 0},
1050 {SS$_HPARITH
, &constraint_error
, NEEDS_ADJUST
, 0},
1051 {SS$_ACCVIO
, &constraint_error
, NEEDS_ADJUST
, &accvio_c_e
},
1052 {SS$_ACCVIO
, &storage_error
, NEEDS_ADJUST
, 0},
1053 {SS$_STKOVF
, &storage_error
, NEEDS_ADJUST
, 0},
1057 /* To deal with VMS conditions and their mapping to Ada exceptions,
1058 the __gnat_error_handler routine below is installed as an exception
1059 vector having precedence over DEC frame handlers. Some conditions
1060 still need to be handled by such handlers, however, in which case
1061 __gnat_error_handler needs to return SS$_RESIGNAL. Consider for
1062 instance the use of a third party library compiled with DECAda and
1063 performing its own exception handling internally.
1065 To allow some user-level flexibility, which conditions should be
1066 resignaled is controlled by a predicate function, provided with the
1067 condition value and returning a boolean indication stating whether
1068 this condition should be resignaled or not.
1070 That predicate function is called indirectly, via a function pointer,
1071 by __gnat_error_handler, and changing that pointer is allowed to the
1072 user code by way of the __gnat_set_resignal_predicate interface.
1074 The user level function may then implement what it likes, including
1075 for instance the maintenance of a dynamic data structure if the set
1076 of to be resignalled conditions has to change over the program's
1079 ??? This is not a perfect solution to deal with the possible
1080 interactions between the GNAT and the DECAda exception handling
1081 models and better (more general) schemes are studied. This is so
1082 just provided as a convenient workaround in the meantime, and
1083 should be use with caution since the implementation has been kept
1086 typedef int resignal_predicate (int code
);
1088 static const int * const cond_resignal_table
[] =
1091 (int *)CMA$_EXIT_THREAD
,
1095 (int *) RDB$_STREAM_EOF
,
1096 (int *) FDL$_UNPRIKW
,
1100 static const int facility_resignal_table
[] =
1102 0x1380000, /* RDB */
1103 0x2220000, /* SQL */
1107 /* Default GNAT predicate for resignaling conditions. */
1110 __gnat_default_resignal_p (int code
)
1114 for (i
= 0; facility_resignal_table
[i
]; i
++)
1115 if ((code
& FAC_MASK
) == facility_resignal_table
[i
])
1118 for (i
= 0, iexcept
= 0;
1119 cond_resignal_table
[i
]
1120 && !(iexcept
= LIB$
MATCH_COND (&code
, &cond_resignal_table
[i
]));
1126 /* Static pointer to predicate that the __gnat_error_handler exception
1127 vector invokes to determine if it should resignal a condition. */
1129 static resignal_predicate
*__gnat_resignal_p
= __gnat_default_resignal_p
;
1131 /* User interface to change the predicate pointer to PREDICATE. Reset to
1132 the default if PREDICATE is null. */
1135 __gnat_set_resignal_predicate (resignal_predicate
*predicate
)
1137 if (predicate
== NULL
)
1138 __gnat_resignal_p
= __gnat_default_resignal_p
;
1140 __gnat_resignal_p
= predicate
;
1143 /* Should match System.Parameters.Default_Exception_Msg_Max_Length. */
1144 #define Default_Exception_Msg_Max_Length 512
1146 /* Action routine for SYS$PUTMSG. There may be multiple
1147 conditions, each with text to be appended to MESSAGE
1148 and separated by line termination. */
1150 copy_msg (struct descriptor_s
*msgdesc
, char *message
)
1152 int len
= strlen (message
);
1155 /* Check for buffer overflow and skip. */
1156 if (len
> 0 && len
<= Default_Exception_Msg_Max_Length
- 3)
1158 strcat (message
, "\r\n");
1162 /* Check for buffer overflow and truncate if necessary. */
1163 copy_len
= (len
+ msgdesc
->len
<= Default_Exception_Msg_Max_Length
- 1 ?
1165 Default_Exception_Msg_Max_Length
- 1 - len
);
1166 strncpy (&message
[len
], msgdesc
->adr
, copy_len
);
1167 message
[len
+ copy_len
] = 0;
1172 /* Scan TABLE for a match for the condition contained in SIGARGS,
1173 and return the entry, or the empty entry if no match found. */
1174 static const struct cond_except
*
1175 scan_conditions ( int *sigargs
, const struct cond_except
*table
[])
1178 struct cond_except entry
;
1180 /* Scan the exception condition table for a match and fetch
1181 the associated GNAT exception pointer. */
1182 for (i
= 0; (*table
) [i
].cond
; i
++)
1184 unsigned int match
= LIB$
MATCH_COND (&sigargs
[1], &(*table
) [i
].cond
);
1185 const struct cond_subtests
*subtests
= (*table
) [i
].subtests
;
1191 return &(*table
) [i
];
1196 int num
= (*subtests
).num
;
1198 /* Perform subtests to differentiate exception. */
1199 for (ii
= 0; ii
< num
; ii
++)
1201 unsigned int arg
= (*subtests
).sigargs
[ii
].sigarg
;
1202 unsigned int argval
= (*subtests
).sigargs
[ii
].sigargval
;
1204 if (sigargs
[arg
] != argval
)
1211 /* All subtests passed. */
1212 if (num
== (*subtests
).num
)
1213 return &(*table
) [i
];
1218 /* No match, return the null terminating entry. */
1219 return &(*table
) [i
];
1222 /* __gnat_handle_vms_condtition is both a frame based handler
1223 for the runtime, and an exception vector for the compiler. */
1225 __gnat_handle_vms_condition (int *sigargs
, void *mechargs
)
1227 struct Exception_Data
*exception
= 0;
1228 unsigned int needs_adjust
= 0;
1230 struct descriptor_s gnat_facility
= {4, 0, "GNAT"};
1231 char message
[Default_Exception_Msg_Max_Length
];
1233 const char *msg
= "";
1235 /* Check for conditions to resignal which aren't effected by pragma
1236 Import_Exception. */
1237 if (__gnat_resignal_p (sigargs
[1]))
1238 return SS$_RESIGNAL
;
1240 /* toplev.c handles this for compiler. */
1241 if (sigargs
[1] == SS$_HPARITH
)
1242 return SS$_RESIGNAL
;
1246 /* See if it's an imported exception. Beware that registered exceptions
1247 are bound to their base code, with the severity bits masked off. */
1248 base_code
= Base_Code_In ((void *) sigargs
[1]);
1249 exception
= Coded_Exception (base_code
);
1256 struct cond_except cond
;
1257 const struct cond_except
*cond_table
;
1258 const struct cond_except
*cond_tables
[] = {dec_ada_cond_except_table
,
1259 system_cond_except_table
,
1261 unsigned int ctrlc
= SS$_CONTROLC
;
1262 unsigned int *sigint
= &C$_SIGINT
;
1263 int ctrlc_match
= LIB$
MATCH_COND (&sigargs
[1], &ctrlc
);
1264 int sigint_match
= LIB$
MATCH_COND (&sigargs
[1], &sigint
);
1266 extern int SYS$
DCLAST (void (*astadr
)(), unsigned long long astprm
,
1267 unsigned int acmode
);
1269 /* If SS$_CONTROLC has been imported as an exception, it will take
1270 priority over a Ctrl/C handler. See above. SIGINT has a
1271 different condition value due to it's DECCCRTL roots and it's
1272 the condition that gets raised for a "kill -INT". */
1273 if ((ctrlc_match
|| sigint_match
) && __gnat_ctrl_c_handler
)
1275 SYS$
DCLAST (__gnat_ctrl_c_handler
, 0, 0);
1276 return SS$_CONTINUE
;
1280 while ((cond_table
= cond_tables
[i
++]) && !exception
)
1282 cond
= *scan_conditions (sigargs
, &cond_table
);
1283 exception
= (struct Exception_Data
*) cond
.except
;
1287 needs_adjust
= cond
.needs_adjust
;
1289 /* User programs expect Non_Ada_Error to be raised if no match,
1290 reference DEC Ada test CXCONDHAN. */
1291 exception
= &Non_Ada_Error
;
1295 /* Pretty much everything is just a program error in the compiler */
1296 exception
= &program_error
;
1301 /* Subtract PC & PSL fields as per ABI for SYS$PUTMSG. */
1304 extern int SYS$
PUTMSG (void *, int (*)(), void *, unsigned long long);
1306 /* If it was a DEC Ada specific condtiion, make it GNAT otherwise
1307 keep the old facility. */
1308 if ((sigargs
[1] & FAC_MASK
) == DECADA_M_FACILITY
)
1309 SYS$
PUTMSG (sigargs
, copy_msg
, &gnat_facility
,
1310 (unsigned long long ) message
);
1312 SYS$
PUTMSG (sigargs
, copy_msg
, 0,
1313 (unsigned long long ) message
);
1315 /* Add back PC & PSL fields as per ABI for SYS$PUTMSG. */
1320 __gnat_adjust_context_for_raise (sigargs
[1], (void *)mechargs
);
1322 Raise_From_Signal_Handler (exception
, msg
);
1325 #if defined (IN_RTS) && defined (__IA64)
1326 /* Called only from adasigio.b32. This is a band aid to avoid going
1327 through the VMS signal handling code which results in a 0x8000 per
1328 handled exception memory leak in P2 space (see VMS source listing
1329 sys/lis/exception.lis) due to the allocation of working space that
1330 is expected to be deallocated upon return from the condition handler,
1331 which doesn't return in GNAT compiled code. */
1333 GNAT$
STOP (int *sigargs
)
1335 /* Note that there are no mechargs. We rely on the fact that condtions
1336 raised from DEClib I/O do not require an "adjust". Also the count
1337 will be off by 2, since LIB$STOP didn't get a chance to add the
1338 PC and PSL fields, so we bump it so PUTMSG comes out right. */
1340 __gnat_handle_vms_condition (sigargs
, 0);
1345 __gnat_install_handler (void)
1347 long prvhnd ATTRIBUTE_UNUSED
;
1349 #if !defined (IN_RTS)
1350 extern int SYS$
SETEXV (unsigned int vector
, int (*addres
)(),
1351 unsigned int accmode
, void *(*(prvhnd
)));
1352 SYS$
SETEXV (1, __gnat_handle_vms_condition
, 3, &prvhnd
);
1355 __gnat_handler_installed
= 1;
1358 /* __gnat_adjust_context_for_raise for Alpha - see comments along with the
1359 default version later in this file. */
1361 #if defined (IN_RTS) && defined (__alpha__)
1363 #include <vms/chfctxdef.h>
1364 #include <vms/chfdef.h>
1366 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
1369 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED
, void *ucontext
)
1371 if (signo
== SS$_HPARITH
)
1373 /* Sub one to the address of the instruction signaling the condition,
1374 located in the sigargs array. */
1376 CHF$MECH_ARRAY
* mechargs
= (CHF$MECH_ARRAY
*) ucontext
;
1377 CHF$SIGNAL_ARRAY
* sigargs
1378 = (CHF$SIGNAL_ARRAY
*) mechargs
->chf$q_mch_sig_addr
;
1380 int vcount
= sigargs
->chf$is_sig_args
;
1381 int * pc_slot
= & (&sigargs
->chf$l_sig_name
)[vcount
-2];
1389 /* __gnat_adjust_context_for_raise for ia64. */
1391 #if defined (IN_RTS) && defined (__IA64)
1393 #include <vms/chfctxdef.h>
1394 #include <vms/chfdef.h>
1396 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
1398 typedef unsigned long long u64
;
1401 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED
, void *ucontext
)
1403 /* Add one to the address of the instruction signaling the condition,
1404 located in the 64bits sigargs array. */
1406 CHF$MECH_ARRAY
* mechargs
= (CHF$MECH_ARRAY
*) ucontext
;
1408 CHF64$SIGNAL_ARRAY
*chfsig64
1409 = (CHF64$SIGNAL_ARRAY
*) mechargs
->chf$ph_mch_sig64_addr
;
1412 = (u64
*)chfsig64
+ 1 + chfsig64
->chf64$l_sig_args
;
1414 u64
* ih_pc_loc
= post_sigarray
- 2;
1421 /* Easier interface for LIB$GET_LOGICAL: put the equivalence of NAME into BUF,
1422 always NUL terminated. In case of error or if the result is longer than
1423 LEN (length of BUF) an empty string is written info BUF. */
1426 __gnat_vms_get_logical (const char *name
, char *buf
, int len
)
1428 struct descriptor_s name_desc
, result_desc
;
1430 unsigned short rlen
;
1432 /* Build the descriptor for NAME. */
1433 name_desc
.len
= strlen (name
);
1435 name_desc
.adr
= (char *)name
;
1437 /* Build the descriptor for the result. */
1438 result_desc
.len
= len
;
1439 result_desc
.mbz
= 0;
1440 result_desc
.adr
= buf
;
1442 status
= LIB$
GET_LOGICAL (&name_desc
, &result_desc
, &rlen
);
1444 if ((status
& 1) == 1 && rlen
< len
)
1450 /* Size of a page on ia64 and alpha VMS. */
1451 #define VMS_PAGESIZE 8192
1454 #define PSL__C_USER 3
1459 /* Descending region. */
1460 #define VA__M_DESCEND 1
1462 /* Get by virtual address. */
1463 #define VA___REGSUM_BY_VA 1
1465 /* Memory region summary. */
1468 unsigned long long q_region_id
;
1469 unsigned int l_flags
;
1470 unsigned int l_region_protection
;
1472 unsigned long long q_region_size
;
1473 void *pq_first_free_va
;
1476 extern int SYS$
GET_REGION_INFO (unsigned int, unsigned long long *,
1477 void *, void *, unsigned int,
1478 void *, unsigned int *);
1479 extern int SYS$
EXPREG_64 (unsigned long long *, unsigned long long,
1480 unsigned int, unsigned int, void **,
1481 unsigned long long *);
1482 extern int SYS$
SETPRT_64 (void *, unsigned long long, unsigned int,
1483 unsigned int, void **, unsigned long long *,
1486 /* Add a guard page in the memory region containing ADDR at ADDR +/- SIZE.
1487 (The sign depends on the kind of the memory region). */
1490 __gnat_set_stack_guard_page (void *addr
, unsigned long size
)
1494 unsigned long long ret_len
;
1495 unsigned int ret_prot
;
1497 unsigned long long length
;
1498 unsigned int retlen
;
1499 struct regsum buffer
;
1501 /* Get the region for ADDR. */
1502 status
= SYS$GET_REGION_INFO
1503 (VA___REGSUM_BY_VA
, NULL
, addr
, NULL
, sizeof (buffer
), &buffer
, &retlen
);
1505 if ((status
& 1) != 1)
1508 /* Extend the region. */
1509 status
= SYS$
EXPREG_64 (&buffer
.q_region_id
,
1510 size
, 0, 0, &start_va
, &length
);
1512 if ((status
& 1) != 1)
1515 /* Create a guard page. */
1516 if (!(buffer
.l_flags
& VA__M_DESCEND
))
1517 start_va
= (void *)((unsigned long long)start_va
+ length
- VMS_PAGESIZE
);
1519 status
= SYS$
SETPRT_64 (start_va
, VMS_PAGESIZE
, PSL__C_USER
, PRT__C_NA
,
1520 &ret_va
, &ret_len
, &ret_prot
);
1522 if ((status
& 1) != 1)
1527 /* Read logicals to limit the stack(s) size. */
1530 __gnat_set_stack_limit (void)
1538 /* The main stack. */
1539 __gnat_vms_get_logical ("GNAT_STACK_SIZE", value
, sizeof (value
));
1540 size
= strtoul (value
, &e
, 0);
1541 if (e
> value
&& *e
== 0)
1543 asm ("mov %0=sp" : "=r" (sp
));
1544 __gnat_set_stack_guard_page (sp
, size
* 1024);
1547 /* The register stack. */
1548 __gnat_vms_get_logical ("GNAT_RBS_SIZE", value
, sizeof (value
));
1549 size
= strtoul (value
, &e
, 0);
1550 if (e
> value
&& *e
== 0)
1552 asm ("mov %0=ar.bsp" : "=r" (sp
));
1553 __gnat_set_stack_guard_page (sp
, size
* 1024);
1559 extern int SYS$
IEEE_SET_FP_CONTROL (void *, void *, void *);
1561 #define __int64 long long
1562 #define __NEW_STARLET
1563 #include <vms/ieeedef.h>
1566 /* Feature logical name and global variable address pair.
1567 If we ever add another feature logical to this list, the
1568 feature struct will need to be enhanced to take into account
1569 possible values for *gl_addr. */
1575 /* Default values for GNAT features set by environment or binder. */
1576 int __gl_heap_size
= 64;
1578 /* Default float format is 'I' meaning IEEE. If gnatbind detetcts that a
1579 VAX Float format is specified, it will set this global variable to 'V'.
1580 Subsequently __gnat_set_features will test the variable and if set for
1581 VAX Float will call a Starlet function to enable trapping for invalid
1582 operation, drivide by zero, and overflow. This will prevent the VMS runtime
1583 (specifically OTS$CHECK_FP_MODE) from complaining about inconsistent
1584 floating point settings in a mixed language program. Ideally the setting
1585 would be determined at link time based on settings in the object files,
1586 however the VMS linker seems to take the setting from the first object
1587 in the link, e.g. pcrt0.o which is float representation neutral. */
1588 char __gl_float_format
= 'I';
1590 /* Array feature logical names and global variable addresses. */
1591 static const struct feature features
[] =
1593 {"GNAT$NO_MALLOC_64", &__gl_heap_size
},
1598 __gnat_set_features (void)
1603 IEEE clrmsk
, setmsk
, prvmsk
;
1605 clrmsk
.ieee$q_flags
= 0LL;
1606 setmsk
.ieee$q_flags
= 0LL;
1609 /* Loop through features array and test name for enable/disable. */
1610 for (i
= 0; features
[i
].name
; i
++)
1612 __gnat_vms_get_logical (features
[i
].name
, buff
, sizeof (buff
));
1614 if (strcmp (buff
, "ENABLE") == 0
1615 || strcmp (buff
, "TRUE") == 0
1616 || strcmp (buff
, "1") == 0)
1617 *features
[i
].gl_addr
= 32;
1618 else if (strcmp (buff
, "DISABLE") == 0
1619 || strcmp (buff
, "FALSE") == 0
1620 || strcmp (buff
, "0") == 0)
1621 *features
[i
].gl_addr
= 64;
1624 /* Features to artificially limit the stack size. */
1625 __gnat_set_stack_limit ();
1628 if (__gl_float_format
== 'V')
1630 setmsk
.ieee$v_trap_enable_inv
= K_TRUE
;
1631 setmsk
.ieee$v_trap_enable_dze
= K_TRUE
;
1632 setmsk
.ieee$v_trap_enable_ovf
= K_TRUE
;
1633 SYS$
IEEE_SET_FP_CONTROL (&clrmsk
, &setmsk
, &prvmsk
);
1637 __gnat_features_set
= 1;
1640 /* Return true if the VMS version is 7.x. */
1642 extern unsigned int LIB$
GETSYI (int *, ...);
1644 #define SYI$_VERSION 0x1000
1647 __gnat_is_vms_v7 (void)
1649 struct descriptor_s desc
;
1652 int code
= SYI$_VERSION
;
1654 desc
.len
= sizeof (version
);
1658 status
= LIB$
GETSYI (&code
, 0, &desc
);
1659 if ((status
& 1) == 1 && version
[1] == '7' && version
[2] == '.')
1665 /*******************/
1666 /* FreeBSD Section */
1667 /*******************/
1669 #elif defined (__FreeBSD__) || defined (__DragonFly__)
1672 #include <sys/ucontext.h>
1676 __gnat_error_handler (int sig
,
1677 siginfo_t
*si ATTRIBUTE_UNUSED
,
1678 void *ucontext ATTRIBUTE_UNUSED
)
1680 struct Exception_Data
*exception
;
1686 exception
= &constraint_error
;
1691 exception
= &constraint_error
;
1696 exception
= &storage_error
;
1697 msg
= "stack overflow or erroneous memory access";
1701 exception
= &storage_error
;
1702 msg
= "SIGBUS: possible stack overflow";
1706 exception
= &program_error
;
1707 msg
= "unhandled signal";
1710 Raise_From_Signal_Handler (exception
, msg
);
1714 __gnat_install_handler (void)
1716 struct sigaction act
;
1718 /* Set up signal handler to map synchronous signals to appropriate
1719 exceptions. Make sure that the handler isn't interrupted by another
1720 signal that might cause a scheduling event! */
1723 = (void (*)(int, struct __siginfo
*, void*)) __gnat_error_handler
;
1724 act
.sa_flags
= SA_NODEFER
| SA_RESTART
| SA_SIGINFO
;
1725 (void) sigemptyset (&act
.sa_mask
);
1727 (void) sigaction (SIGILL
, &act
, NULL
);
1728 (void) sigaction (SIGFPE
, &act
, NULL
);
1729 (void) sigaction (SIGSEGV
, &act
, NULL
);
1730 (void) sigaction (SIGBUS
, &act
, NULL
);
1732 __gnat_handler_installed
= 1;
1735 /*************************************/
1736 /* VxWorks Section (including Vx653) */
1737 /*************************************/
1739 #elif defined(__vxworks)
1742 #include <taskLib.h>
1743 #if (defined (__i386__) || defined (__x86_64__)) && !defined (VTHREADS)
1747 #include "sigtramp.h"
1754 #if ((defined (ARMEL) && (_WRS_VXWORKS_MAJOR == 6))) && !defined(__RTP__)
1755 #define VXWORKS_FORCE_GUARD_PAGE 1
1757 extern size_t vxIntStackOverflowSize
;
1758 #define INT_OVERFLOW_SIZE vxIntStackOverflowSize
1762 #include "private/vThreadsP.h"
1767 /* Directly vectored Interrupt routines are not supported when using RTPs. */
1769 extern void * __gnat_inum_to_ivec (int);
1771 /* This is needed by the GNAT run time to handle Vxworks interrupts. */
1773 __gnat_inum_to_ivec (int num
)
1775 return (void *) INUM_TO_IVEC (num
);
1779 #if !defined(__alpha_vxworks) && ((_WRS_VXWORKS_MAJOR != 6) && (_WRS_VXWORKS_MAJOR != 7)) && !defined(__RTP__)
1781 /* getpid is used by s-parint.adb, but is not defined by VxWorks, except
1782 on Alpha VxWorks and VxWorks 6.x (including RTPs). */
1784 extern long getpid (void);
1789 return taskIdSelf ();
1793 /* When stack checking is performed by probing a guard page on the stack,
1794 sometimes this guard page is not properly reset on VxWorks. We need to
1795 manually reset it in this case.
1796 This function returns TRUE in case the guard page was hit by the
1799 __gnat_reset_guard_page (int sig
)
1801 /* On ARM VxWorks 6.x and x86_64 VxWorks 7, the guard page is left un-armed
1802 by the kernel after being violated, so subsequent violations aren't
1804 So we retrieve the address of the guard page from the TCB and compare it
1805 with the page that is violated and re-arm that page if there's a match. */
1806 #if defined (VXWORKS_FORCE_GUARD_PAGE)
1808 /* Ignore signals that are not stack overflow signals */
1809 if (sig
!= SIGSEGV
&& sig
!= SIGBUS
&& sig
!= SIGILL
) return FALSE
;
1811 /* If the target does not support guard pages, INT_OVERFLOW_SIZE will be 0 */
1812 if (INT_OVERFLOW_SIZE
== 0) return FALSE
;
1814 TASK_ID tid
= taskIdSelf ();
1815 WIND_TCB
*pTcb
= taskTcb (tid
);
1816 VIRT_ADDR guardPage
= (VIRT_ADDR
) pTcb
->pStackEnd
- INT_OVERFLOW_SIZE
;
1817 UINT stateMask
= VM_STATE_MASK_VALID
;
1818 UINT guardState
= VM_STATE_VALID_NOT
;
1820 #if (_WRS_VXWORKS_MAJOR >= 7)
1821 stateMask
|= MMU_ATTR_SPL_MSK
;
1822 guardState
|= MMU_ATTR_NO_BLOCK
;
1826 vmStateGet (NULL
, guardPage
, &nState
);
1827 if ((nState
& VM_STATE_MASK_VALID
) != VM_STATE_VALID_NOT
)
1829 /* If the guard page has a valid state, we need to reset to
1830 invalid state here */
1831 vmStateSet (NULL
, guardPage
, INT_OVERFLOW_SIZE
, stateMask
, guardState
);
1834 #endif /* VXWORKS_FORCE_GUARD_PAGE */
1838 /* VxWorks 653 vThreads expects the field excCnt to be zeroed when a signal is.
1839 handled. The VxWorks version of longjmp does this; GCC's builtin_longjmp
1842 __gnat_clear_exception_count (void)
1845 WIND_TCB
*currentTask
= (WIND_TCB
*) taskIdSelf();
1847 currentTask
->vThreads
.excCnt
= 0;
1851 /* Handle different SIGnal to exception mappings in different VxWorks
1854 __gnat_map_signal (int sig
,
1855 siginfo_t
*si ATTRIBUTE_UNUSED
,
1856 void *sc ATTRIBUTE_UNUSED
)
1858 struct Exception_Data
*exception
;
1864 exception
= &constraint_error
;
1868 #ifdef __VXWORKSMILS__
1870 exception
= &storage_error
;
1871 msg
= "SIGILL: possible stack overflow";
1874 exception
= &storage_error
;
1878 exception
= &program_error
;
1883 exception
= &constraint_error
;
1884 msg
= "Floating point exception or SIGILL";
1887 exception
= &storage_error
;
1891 exception
= &storage_error
;
1892 msg
= "SIGBUS: possible stack overflow";
1895 #elif (_WRS_VXWORKS_MAJOR >= 6)
1897 exception
= &constraint_error
;
1901 /* In RTP mode a SIGSEGV is most likely due to a stack overflow,
1902 since stack checking uses the probing mechanism. */
1904 exception
= &storage_error
;
1905 msg
= "SIGSEGV: possible stack overflow";
1908 exception
= &program_error
;
1912 /* VxWorks 6 kernel mode with probing. SIGBUS for guard page hit */
1914 exception
= &storage_error
;
1918 exception
= &storage_error
;
1919 msg
= "SIGBUS: possible stack overflow";
1923 /* VxWorks 5: a SIGILL is most likely due to a stack overflow,
1924 since stack checking uses the stack limit mechanism. */
1926 exception
= &storage_error
;
1927 msg
= "SIGILL: possible stack overflow";
1930 exception
= &storage_error
;
1934 exception
= &program_error
;
1939 exception
= &program_error
;
1940 msg
= "unhandled signal";
1943 if (__gnat_reset_guard_page (sig
))
1945 /* Set the exception message: we know for sure that we have a
1946 stack overflow here */
1947 exception
= &storage_error
;
1952 msg
= "SIGSEGV: stack overflow";
1955 msg
= "SIGBUS: stack overflow";
1958 msg
= "SIGILL: stack overflow";
1962 __gnat_clear_exception_count ();
1963 Raise_From_Signal_Handler (exception
, msg
);
1966 #if defined (ARMEL) && (_WRS_VXWORKS_MAJOR >= 7) && !defined (__aarch64__)
1968 /* ARM-vx7 case with arm unwinding exceptions */
1969 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
1971 #include <arch/../regs.h>
1977 #include <ucontext.h>
1978 #endif /* __RTP__ */
1981 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED
,
1982 void *sc ATTRIBUTE_UNUSED
)
1984 /* In case of ARM exceptions, the registers context have the PC pointing
1985 to the instruction that raised the signal. However the unwinder expects
1986 the instruction to be in the range ]PC,PC+1]. */
1989 mcontext_t
*mcontext
= &((ucontext_t
*) sc
)->uc_mcontext
;
1990 pc_addr
= (uintptr_t*)&mcontext
->regs
.pc
;
1992 struct sigcontext
* sctx
= (struct sigcontext
*) sc
;
1993 pc_addr
= (uintptr_t*)&sctx
->sc_pregs
->pc
;
1995 /* ARM Bump has to be an even number because of odd/even architecture. */
1998 #endif /* ARMEL && _WRS_VXWORKS_MAJOR >= 7 */
2000 /* Tasking and Non-tasking signal handler. Map SIGnal to Ada exception
2001 propagation after the required low level adjustments. */
2004 __gnat_error_handler (int sig
, siginfo_t
*si
, void *sc
)
2008 /* VxWorks on e500v2 clears the SPE bit of the MSR when entering CPU
2009 exception state. To allow the handler and exception to work properly
2010 when they contain SPE instructions, we need to set it back before doing
2012 This mechanism is only need in kernel mode. */
2013 #if !(defined (__RTP__) || defined (VTHREADS)) && ((CPU == PPCE500V2) || (CPU == PPC85XX))
2015 /* Read the MSR value */
2016 asm volatile ("mfmsr %0" : "=r" (msr
));
2017 /* Force the SPE bit if not set. */
2018 if ((msr
& 0x02000000) == 0)
2022 asm volatile ("mtmsr %0" : : "r" (msr
));
2026 /* VxWorks will always mask out the signal during the signal handler and
2027 will reenable it on a longjmp. GNAT does not generate a longjmp to
2028 return from a signal handler so the signal will still be masked unless
2030 sigprocmask (SIG_SETMASK
, NULL
, &mask
);
2031 sigdelset (&mask
, sig
);
2032 sigprocmask (SIG_SETMASK
, &mask
, NULL
);
2034 #if defined (__ARMEL__) || defined (__PPC__) || defined (__i386__) || defined (__x86_64__) || defined (__aarch64__)
2035 /* On certain targets, kernel mode, we process signals through a Call Frame
2036 Info trampoline, voiding the need for myriads of fallback_frame_state
2037 variants in the ZCX runtime. We have no simple way to distinguish ZCX
2038 from SJLJ here, so we do this for SJLJ as well even though this is not
2039 necessary. This only incurs a few extra instructions and a tiny
2040 amount of extra stack usage. */
2042 #ifdef HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
2043 /* We need to sometimes to adjust the PC in case of signals so that it
2044 doesn't reference the exception that actually raised the signal but the
2045 instruction before it. */
2046 __gnat_adjust_context_for_raise (sig
, sc
);
2049 __gnat_sigtramp (sig
, (void *)si
, (void *)sc
,
2050 (__sigtramphandler_t
*)&__gnat_map_signal
);
2053 __gnat_map_signal (sig
, si
, sc
);
2057 #if defined(__leon__) && defined(_WRS_KERNEL)
2058 /* For LEON VxWorks we need to install a trap handler for stack overflow */
2060 extern void excEnt (void);
2061 /* VxWorks exception handler entry */
2064 unsigned long inst_first
;
2065 unsigned long inst_second
;
2066 unsigned long inst_third
;
2067 unsigned long inst_fourth
;
2069 /* Four instructions representing entries in the trap table */
2071 struct trap_entry
*trap_0_entry
;
2072 /* We will set the location of the entry for software trap 0 in the trap
2077 __gnat_install_handler (void)
2079 struct sigaction act
;
2081 /* Setup signal handler to map synchronous signals to appropriate
2082 exceptions. Make sure that the handler isn't interrupted by another
2083 signal that might cause a scheduling event! */
2085 act
.sa_sigaction
= __gnat_error_handler
;
2086 act
.sa_flags
= SA_SIGINFO
| SA_ONSTACK
;
2087 sigemptyset (&act
.sa_mask
);
2089 /* For VxWorks, install all signal handlers, since pragma Interrupt_State
2090 applies to vectored hardware interrupts, not signals. */
2091 sigaction (SIGFPE
, &act
, NULL
);
2092 sigaction (SIGILL
, &act
, NULL
);
2093 sigaction (SIGSEGV
, &act
, NULL
);
2094 sigaction (SIGBUS
, &act
, NULL
);
2096 #if defined(__leon__) && defined(_WRS_KERNEL)
2097 /* Specific to the LEON VxWorks kernel run-time library */
2099 /* For stack checking the compiler triggers a software trap 0 (ta 0) in
2100 case of overflow (we use the stack limit mechanism). We need to install
2101 the trap handler here for this software trap (the OS does not handle
2102 it) as if it were a data_access_exception (trap 9). We do the same as
2103 if we put in the trap table a VXSPARC_BAD_TRAP(9). Software trap 0 is
2104 located at vector 0x80, and each entry takes 4 words. */
2106 trap_0_entry
= (struct trap_entry
*)(intVecBaseGet () + 0x80 * 4);
2110 trap_0_entry
->inst_first
= 0xae102000 + 9;
2112 /* sethi %hi(excEnt), %l6 */
2114 /* The 22 most significant bits of excEnt are obtained shifting 10 times
2117 trap_0_entry
->inst_second
= 0x2d000000 + ((unsigned long)excEnt
>> 10);
2119 /* jmp %l6+%lo(excEnt) */
2121 /* The 10 least significant bits of excEnt are obtained by masking */
2123 trap_0_entry
->inst_third
= 0x81c5a000 + ((unsigned long)excEnt
& 0x3ff);
2127 trap_0_entry
->inst_fourth
= 0xa1480000;
2130 #ifdef __HANDLE_VXSIM_SC
2131 /* By experiment, found that sysModel () returns the following string
2132 prefix for vxsim when running on Linux and Windows. */
2134 char *model
= sysModel ();
2135 if ((strncmp (model
, "Linux", 5) == 0)
2136 || (strncmp (model
, "Windows", 7) == 0)
2137 || (strncmp (model
, "SIMLINUX", 8) == 0) /* vx7 */
2138 || (strncmp (model
, "SIMNT", 5) == 0)) /* ditto */
2139 __gnat_set_is_vxsim (TRUE
);
2143 __gnat_handler_installed
= 1;
2146 #define HAVE_GNAT_INIT_FLOAT
2149 __gnat_init_float (void)
2151 /* Disable overflow/underflow exceptions on the PPC processor, needed
2152 to get correct Ada semantics. Note that for AE653 vThreads, the HW
2153 overflow settings are an OS configuration issue. The instructions
2154 below have no effect. */
2155 #if defined (_ARCH_PPC) && !defined (_SOFT_FLOAT) && (!defined (VTHREADS) || defined (__VXWORKSMILS__))
2156 #if defined (__SPE__)
2158 /* For e500v2, do nothing and leave the responsibility to install the
2159 handler and enable the exceptions to the BSP. */
2167 #if (defined (__i386__) || defined (__x86_64__)) && !defined (VTHREADS)
2168 /* This is used to properly initialize the FPU on an x86 for each
2173 /* Similarly for SPARC64. Achieved by masking bits in the Trap Enable Mask
2174 field of the Floating-point Status Register (see the SPARC Architecture
2175 Manual Version 9, p 48). */
2176 #if defined (sparc64)
2178 #define FSR_TEM_NVM (1 << 27) /* Invalid operand */
2179 #define FSR_TEM_OFM (1 << 26) /* Overflow */
2180 #define FSR_TEM_UFM (1 << 25) /* Underflow */
2181 #define FSR_TEM_DZM (1 << 24) /* Division by Zero */
2182 #define FSR_TEM_NXM (1 << 23) /* Inexact result */
2186 __asm__("st %%fsr, %0" : "=m" (fsr
));
2187 fsr
&= ~(FSR_TEM_OFM
| FSR_TEM_UFM
);
2188 __asm__("ld %0, %%fsr" : : "m" (fsr
));
2193 /* This subprogram is called by System.Task_Primitives.Operations.Enter_Task
2194 (if not null) when a new task is created. It is initialized by
2195 System.Stack_Checking.Operations.Initialize_Stack_Limit.
2196 The use of a hook avoids to drag stack checking subprograms if stack
2197 checking is not used. */
2198 void (*__gnat_set_stack_limit_hook
)(void) = (void (*)(void))0;
2200 /******************/
2201 /* NetBSD Section */
2202 /******************/
2204 #elif defined(__NetBSD__)
2210 __gnat_error_handler (int sig
)
2212 struct Exception_Data
*exception
;
2218 exception
= &constraint_error
;
2222 exception
= &constraint_error
;
2226 exception
= &storage_error
;
2227 msg
= "stack overflow or erroneous memory access";
2230 exception
= &constraint_error
;
2234 exception
= &program_error
;
2235 msg
= "unhandled signal";
2238 Raise_From_Signal_Handler (exception
, msg
);
2242 __gnat_install_handler (void)
2244 struct sigaction act
;
2246 act
.sa_handler
= __gnat_error_handler
;
2247 act
.sa_flags
= SA_NODEFER
| SA_RESTART
;
2248 sigemptyset (&act
.sa_mask
);
2250 /* Do not install handlers if interrupt state is "System". */
2251 if (__gnat_get_interrupt_state (SIGFPE
) != 's')
2252 sigaction (SIGFPE
, &act
, NULL
);
2253 if (__gnat_get_interrupt_state (SIGILL
) != 's')
2254 sigaction (SIGILL
, &act
, NULL
);
2255 if (__gnat_get_interrupt_state (SIGSEGV
) != 's')
2256 sigaction (SIGSEGV
, &act
, NULL
);
2257 if (__gnat_get_interrupt_state (SIGBUS
) != 's')
2258 sigaction (SIGBUS
, &act
, NULL
);
2260 __gnat_handler_installed
= 1;
2263 /*******************/
2264 /* OpenBSD Section */
2265 /*******************/
2267 #elif defined(__OpenBSD__)
2273 __gnat_error_handler (int sig
)
2275 struct Exception_Data
*exception
;
2281 exception
= &constraint_error
;
2285 exception
= &constraint_error
;
2289 exception
= &storage_error
;
2290 msg
= "stack overflow or erroneous memory access";
2293 exception
= &constraint_error
;
2297 exception
= &program_error
;
2298 msg
= "unhandled signal";
2301 Raise_From_Signal_Handler (exception
, msg
);
2305 __gnat_install_handler (void)
2307 struct sigaction act
;
2309 act
.sa_handler
= __gnat_error_handler
;
2310 act
.sa_flags
= SA_NODEFER
| SA_RESTART
;
2311 sigemptyset (&act
.sa_mask
);
2313 /* Do not install handlers if interrupt state is "System" */
2314 if (__gnat_get_interrupt_state (SIGFPE
) != 's')
2315 sigaction (SIGFPE
, &act
, NULL
);
2316 if (__gnat_get_interrupt_state (SIGILL
) != 's')
2317 sigaction (SIGILL
, &act
, NULL
);
2318 if (__gnat_get_interrupt_state (SIGSEGV
) != 's')
2319 sigaction (SIGSEGV
, &act
, NULL
);
2320 if (__gnat_get_interrupt_state (SIGBUS
) != 's')
2321 sigaction (SIGBUS
, &act
, NULL
);
2323 __gnat_handler_installed
= 1;
2326 /******************/
2327 /* Darwin Section */
2328 /******************/
2330 #elif defined(__APPLE__)
2332 #include <TargetConditionals.h>
2335 #include <sys/syscall.h>
2336 #include <sys/sysctl.h>
2338 /* This must be in keeping with System.OS_Interface.Alternate_Stack_Size. */
2339 char __gnat_alternate_stack
[32 * 1024]; /* 1 * MINSIGSTKSZ */
2341 /* Defined in xnu unix_signal.c.
2342 Tell the kernel to re-use alt stack when delivering a signal. */
2343 #define UC_RESET_ALT_STACK 0x80000000
2345 #if !(defined (__arm__) || defined (__arm64__) || TARGET_IPHONE_SIMULATOR)
2346 #include <mach/mach_vm.h>
2347 #include <mach/mach_init.h>
2348 #include <mach/vm_statistics.h>
2352 #include <sys/ucontext.h>
2353 #include "sigtramp.h"
2356 /* Return true if ADDR is within a stack guard area. */
2358 __gnat_is_stack_guard (mach_vm_address_t addr
)
2360 #if !(defined (__arm__) || defined (__arm64__) || TARGET_IPHONE_SIMULATOR)
2362 vm_region_submap_info_data_64_t info
;
2363 mach_vm_address_t start
;
2364 mach_vm_size_t size
;
2366 mach_msg_type_number_t count
;
2368 count
= VM_REGION_SUBMAP_INFO_COUNT_64
;
2372 kret
= mach_vm_region_recurse (mach_task_self (), &start
, &size
, &depth
,
2373 (vm_region_recurse_info_t
) &info
, &count
);
2374 if (kret
== KERN_SUCCESS
2375 && addr
>= start
&& addr
< (start
+ size
)
2376 && info
.protection
== VM_PROT_NONE
2377 && info
.user_tag
== VM_MEMORY_STACK
)
2381 /* Pagezero for arm. */
2382 return addr
>= 4096;
2386 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
2388 #if defined (__x86_64__)
2390 __darwin_major_version (void)
2392 static int cache
= -1;
2395 int mib
[2] = {CTL_KERN
, KERN_OSRELEASE
};
2398 /* Find out how big the buffer needs to be (and set cache to 0
2400 if (sysctl (mib
, 2, NULL
, &len
, NULL
, 0) == 0)
2403 sysctl (mib
, 2, release
, &len
, NULL
, 0);
2404 /* Darwin releases are of the form L.M.N where L is the major
2405 version, so strtol will return L. */
2406 cache
= (int) strtol (release
, NULL
, 10);
2418 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED
,
2419 void *ucontext ATTRIBUTE_UNUSED
)
2421 #if defined (__x86_64__)
2422 if (__darwin_major_version () < 12)
2424 /* Work around radar #10302855, where the unwinders (libunwind or
2425 libgcc_s depending on the system revision) and the DWARF unwind
2426 data for sigtramp have different ideas about register numbering,
2427 causing rbx and rdx to be transposed. */
2428 ucontext_t
*uc
= (ucontext_t
*)ucontext
;
2429 unsigned long t
= uc
->uc_mcontext
->__ss
.__rbx
;
2431 uc
->uc_mcontext
->__ss
.__rbx
= uc
->uc_mcontext
->__ss
.__rdx
;
2432 uc
->uc_mcontext
->__ss
.__rdx
= t
;
2434 #elif defined(__arm64__)
2435 /* Even though the CFI is marked as a signal frame, we need this. */
2436 ucontext_t
*uc
= (ucontext_t
*)ucontext
;
2437 uc
->uc_mcontext
->__ss
.__pc
++;
2442 __gnat_map_signal (int sig
, siginfo_t
*si
, void *mcontext ATTRIBUTE_UNUSED
)
2444 struct Exception_Data
*exception
;
2451 if (__gnat_is_stack_guard ((unsigned long)si
->si_addr
))
2454 /* ??? This is a kludge to make stack checking work. The problem is
2455 that the trampoline doesn't restore LR and, consequently, doesn't
2456 make it possible to unwind past an interrupted frame which hasn"t
2457 saved LR on the stack yet. Therefore, for probes in the prologue
2458 (32-bit probes as opposed to standard 64-bit probes), we make the
2459 unwinder skip the not-yet-established frame altogether. */
2460 mcontext_t mc
= (mcontext_t
)mcontext
;
2461 if (!(*(unsigned int *)(mc
->__ss
.__pc
-1) & ((unsigned int)1 << 30)))
2462 mc
->__ss
.__pc
= mc
->__ss
.__lr
;
2464 exception
= &storage_error
;
2465 msg
= "stack overflow";
2469 exception
= &constraint_error
;
2470 msg
= "erroneous memory access";
2473 /* Reset the use of alt stack, so that the alt stack will be used
2474 for the next signal delivery.
2475 The stack can't be used in case of stack checking. */
2476 syscall (SYS_sigreturn
, NULL
, UC_RESET_ALT_STACK
);
2480 exception
= &constraint_error
;
2485 exception
= &program_error
;
2486 msg
= "unhandled signal";
2489 Raise_From_Signal_Handler (exception
, msg
);
2493 __gnat_error_handler (int sig
, siginfo_t
*si
, void *ucontext
)
2495 __gnat_adjust_context_for_raise (sig
, ucontext
);
2497 /* The Darwin libc comes with a signal trampoline, except for ARM64. */
2499 __gnat_sigtramp (sig
, (void *)si
, ucontext
,
2500 (__sigtramphandler_t
*)&__gnat_map_signal
);
2502 __gnat_map_signal (sig
, si
, ucontext
);
2507 __gnat_install_handler (void)
2509 struct sigaction act
;
2511 /* Set up signal handler to map synchronous signals to appropriate
2512 exceptions. Make sure that the handler isn't interrupted by another
2513 signal that might cause a scheduling event! Also setup an alternate
2514 stack region for the handler execution so that stack overflows can be
2515 handled properly, avoiding a SEGV generation from stack usage by the
2516 handler itself (and it is required by Darwin). */
2519 stack
.ss_sp
= __gnat_alternate_stack
;
2520 stack
.ss_size
= sizeof (__gnat_alternate_stack
);
2522 sigaltstack (&stack
, NULL
);
2524 act
.sa_flags
= SA_NODEFER
| SA_RESTART
| SA_SIGINFO
;
2525 act
.sa_sigaction
= __gnat_error_handler
;
2526 sigemptyset (&act
.sa_mask
);
2528 /* Do not install handlers if interrupt state is "System". */
2529 if (__gnat_get_interrupt_state (SIGABRT
) != 's')
2530 sigaction (SIGABRT
, &act
, NULL
);
2531 if (__gnat_get_interrupt_state (SIGFPE
) != 's')
2532 sigaction (SIGFPE
, &act
, NULL
);
2533 if (__gnat_get_interrupt_state (SIGILL
) != 's')
2534 sigaction (SIGILL
, &act
, NULL
);
2536 act
.sa_flags
|= SA_ONSTACK
;
2537 if (__gnat_get_interrupt_state (SIGSEGV
) != 's')
2538 sigaction (SIGSEGV
, &act
, NULL
);
2539 if (__gnat_get_interrupt_state (SIGBUS
) != 's')
2540 sigaction (SIGBUS
, &act
, NULL
);
2542 __gnat_handler_installed
= 1;
2545 #elif defined(__QNX__)
2555 #include "sigtramp.h"
2558 __gnat_map_signal (int sig
,
2559 siginfo_t
*si ATTRIBUTE_UNUSED
,
2560 void *mcontext ATTRIBUTE_UNUSED
)
2562 struct Exception_Data
*exception
;
2568 exception
= &constraint_error
;
2572 exception
= &constraint_error
;
2576 exception
= &storage_error
;
2577 msg
= "stack overflow or erroneous memory access";
2580 exception
= &constraint_error
;
2584 exception
= &program_error
;
2585 msg
= "unhandled signal";
2588 Raise_From_Signal_Handler (exception
, msg
);
2592 __gnat_error_handler (int sig
, siginfo_t
*si
, void *ucontext
)
2594 __gnat_sigtramp (sig
, (void *) si
, (void *) ucontext
,
2595 (__sigtramphandler_t
*)&__gnat_map_signal
);
2598 /* This must be in keeping with System.OS_Interface.Alternate_Stack_Size. */
2599 /* sigaltstack is currently not supported by QNX7 */
2600 char __gnat_alternate_stack
[0];
2603 __gnat_install_handler (void)
2605 struct sigaction act
;
2608 act
.sa_handler
= __gnat_error_handler
;
2609 act
.sa_flags
= SA_NODEFER
| SA_SIGINFO
;
2610 sigemptyset (&act
.sa_mask
);
2612 /* Do not install handlers if interrupt state is "System" */
2613 if (__gnat_get_interrupt_state (SIGFPE
) != 's') {
2614 err
= sigaction (SIGFPE
, &act
, NULL
);
2617 perror ("error while attaching SIGFPE");
2618 perror (strerror (err
));
2621 if (__gnat_get_interrupt_state (SIGILL
) != 's') {
2622 sigaction (SIGILL
, &act
, NULL
);
2625 perror ("error while attaching SIGFPE");
2626 perror (strerror (err
));
2629 if (__gnat_get_interrupt_state (SIGSEGV
) != 's') {
2630 sigaction (SIGSEGV
, &act
, NULL
);
2633 perror ("error while attaching SIGFPE");
2634 perror (strerror (err
));
2637 if (__gnat_get_interrupt_state (SIGBUS
) != 's') {
2638 sigaction (SIGBUS
, &act
, NULL
);
2641 perror ("error while attaching SIGFPE");
2642 perror (strerror (err
));
2645 __gnat_handler_installed
= 1;
2648 #elif defined (__DJGPP__)
2651 __gnat_install_handler ()
2653 __gnat_handler_installed
= 1;
2656 #elif defined(__ANDROID__)
2658 /*******************/
2659 /* Android Section */
2660 /*******************/
2663 #include <sys/ucontext.h>
2664 #include "sigtramp.h"
2666 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
2669 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED
, void *ucontext
)
2671 mcontext_t
*mcontext
= &((ucontext_t
*) ucontext
)->uc_mcontext
;
2673 /* ARM Bump has to be an even number because of odd/even architecture. */
2674 ((mcontext_t
*) mcontext
)->arm_pc
+= 2;
2678 __gnat_map_signal (int sig
,
2679 siginfo_t
*si ATTRIBUTE_UNUSED
,
2680 void *mcontext ATTRIBUTE_UNUSED
)
2682 struct Exception_Data
*exception
;
2688 exception
= &storage_error
;
2689 msg
= "stack overflow or erroneous memory access";
2693 exception
= &constraint_error
;
2698 exception
= &constraint_error
;
2703 exception
= &program_error
;
2704 msg
= "unhandled signal";
2707 Raise_From_Signal_Handler (exception
, msg
);
2711 __gnat_error_handler (int sig
, siginfo_t
*si
, void *ucontext
)
2713 __gnat_adjust_context_for_raise (sig
, ucontext
);
2715 __gnat_sigtramp (sig
, (void *) si
, (void *) ucontext
,
2716 (__sigtramphandler_t
*)&__gnat_map_signal
);
2719 /* This must be in keeping with System.OS_Interface.Alternate_Stack_Size. */
2720 char __gnat_alternate_stack
[16 * 1024];
2723 __gnat_install_handler (void)
2725 struct sigaction act
;
2727 /* Set up signal handler to map synchronous signals to appropriate
2728 exceptions. Make sure that the handler isn't interrupted by another
2729 signal that might cause a scheduling event! Also setup an alternate
2730 stack region for the handler execution so that stack overflows can be
2731 handled properly, avoiding a SEGV generation from stack usage by the
2735 stack
.ss_sp
= __gnat_alternate_stack
;
2736 stack
.ss_size
= sizeof (__gnat_alternate_stack
);
2738 sigaltstack (&stack
, NULL
);
2740 act
.sa_sigaction
= __gnat_error_handler
;
2741 act
.sa_flags
= SA_NODEFER
| SA_RESTART
| SA_SIGINFO
;
2742 sigemptyset (&act
.sa_mask
);
2744 sigaction (SIGABRT
, &act
, NULL
);
2745 sigaction (SIGFPE
, &act
, NULL
);
2746 sigaction (SIGILL
, &act
, NULL
);
2747 sigaction (SIGBUS
, &act
, NULL
);
2748 act
.sa_flags
|= SA_ONSTACK
;
2749 sigaction (SIGSEGV
, &act
, NULL
);
2751 __gnat_handler_installed
= 1;
2756 /* For all other versions of GNAT, the handler does nothing. */
2758 /*******************/
2759 /* Default Section */
2760 /*******************/
2763 __gnat_install_handler (void)
2765 __gnat_handler_installed
= 1;
2770 /*********************/
2771 /* __gnat_init_float */
2772 /*********************/
2774 #if defined (_WIN32) || defined (__INTERIX) || defined (__linux__) \
2775 || defined (__Lynx__) || defined(__NetBSD__) || defined(__FreeBSD__) \
2776 || defined (__OpenBSD__) || defined (__DragonFly__) || defined(__QNX__)
2778 #define HAVE_GNAT_INIT_FLOAT
2781 __gnat_init_float (void)
2783 #if defined (__i386__) || defined (__x86_64__)
2784 /* This is used to properly initialize the FPU to 64-bit precision on an x86
2785 for each process thread and also for floating-point I/O. */
2791 #ifndef HAVE_GNAT_INIT_FLOAT
2793 /* All targets without a specific __gnat_init_float will use an empty one. */
2795 __gnat_init_float (void)
2800 /***********************************/
2801 /* __gnat_adjust_context_for_raise */
2802 /***********************************/
2804 #ifndef HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
2806 /* All targets without a specific version will use an empty one. */
2808 /* Given UCONTEXT a pointer to a context structure received by a signal
2809 handler for SIGNO, perform the necessary adjustments to let the handler
2810 raise an exception. Calls to this routine are not conditioned by the
2811 propagation scheme in use. */
2814 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED
,
2815 void *ucontext ATTRIBUTE_UNUSED
)
2817 /* We used to compensate here for the raised from call vs raised from signal
2818 exception discrepancy with the GCC ZCX scheme, but this now can be dealt
2819 with generically in the unwinder (see GCC PR other/26208). This however
2820 requires the use of the _Unwind_GetIPInfo routine in raise-gcc.c, which
2821 is predicated on the definition of HAVE_GETIPINFO at compile time. Only
2822 the VMS ports still do the compensation described in the few lines below.
2824 *** Call vs signal exception discrepancy with GCC ZCX scheme ***
2826 The GCC unwinder expects to be dealing with call return addresses, since
2827 this is the "nominal" case of what we retrieve while unwinding a regular
2830 To evaluate if a handler applies at some point identified by a return
2831 address, the propagation engine needs to determine what region the
2832 corresponding call instruction pertains to. Because the return address
2833 may not be attached to the same region as the call, the unwinder always
2834 subtracts "some" amount from a return address to search the region
2835 tables, amount chosen to ensure that the resulting address is inside the
2838 When we raise an exception from a signal handler, e.g. to transform a
2839 SIGSEGV into Storage_Error, things need to appear as if the signal
2840 handler had been "called" by the instruction which triggered the signal,
2841 so that exception handlers that apply there are considered. What the
2842 unwinder will retrieve as the return address from the signal handler is
2843 what it will find as the faulting instruction address in the signal
2844 context pushed by the kernel. Leaving this address untouched looses, if
2845 the triggering instruction happens to be the very first of a region, as
2846 the later adjustments performed by the unwinder would yield an address
2847 outside that region. We need to compensate for the unwinder adjustments
2848 at some point, and this is what this routine is expected to do.
2850 signo is passed because on some targets for some signals the PC in
2851 context points to the instruction after the faulting one, in which case
2852 the unwinder adjustment is still desired. */