?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Wno-frame-address.c: Skip on hppa*-*-*.
[official-gcc.git] / gcc / ada / init.c
blob243f3b80d57f4397d7e7257022fdd899c67f7379
1 /****************************************************************************
2 * *
3 * GNAT COMPILER COMPONENTS *
4 * *
5 * I N I T *
6 * *
7 * C Implementation File *
8 * *
9 * Copyright (C) 1992-2015, Free Software Foundation, Inc. *
10 * *
11 * GNAT is free software; you can redistribute it and/or modify it under *
12 * terms of the GNU General Public License as published by the Free Soft- *
13 * ware Foundation; either version 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. *
17 * *
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. *
21 * *
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/>. *
26 * *
27 * GNAT was originally developed by the GNAT team at New York University. *
28 * Extensive contributions were provided by Ada Core Technologies Inc. *
29 * *
30 ****************************************************************************/
31
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). */
40
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. */
44
45 /* The following include is here to meet the published VxWorks requirement
46 that the __vxworks header appear before any other include. */
47 #ifdef __vxworks
48 #include "vxWorks.h"
49 #include "version.h" /* for _WRS_VXWORKS_MAJOR */
50 #endif
51
52 #ifdef __ANDROID__
53 #undef __linux__
54 #endif
55
56 #ifdef IN_RTS
57 #include "tconfig.h"
58 #include "tsystem.h"
59 #include <sys/stat.h>
60
61 /* We don't have libiberty, so use malloc. */
62 #define xmalloc(S) malloc (S)
63 #else
64 #include "config.h"
65 #include "system.h"
66 #endif
67
68 #include "adaint.h"
69 #include "raise.h"
70
71 #ifdef __cplusplus
72 extern "C" {
73 #endif
74
75 extern void __gnat_raise_program_error (const char *, int);
76
77 /* Addresses of exception data blocks for predefined exceptions. Tasking_Error
78 is not used in this unit, and the abort signal is only used on IRIX.
79 ??? Revisit this part since IRIX is no longer supported. */
80 extern struct Exception_Data constraint_error;
81 extern struct Exception_Data numeric_error;
82 extern struct Exception_Data program_error;
83 extern struct Exception_Data storage_error;
84
85 /* For the Cert run time we use the regular raise exception routine because
86 Raise_From_Signal_Handler is not available. */
87 #ifdef CERT
88 #define Raise_From_Signal_Handler \
89 __gnat_raise_exception
90 extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *);
91 #else
92 #define Raise_From_Signal_Handler \
93 ada__exceptions__raise_from_signal_handler
94 extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *);
95 #endif
96
97 /* Global values computed by the binder. Note that these variables are
98 declared here, not in the binder file, to avoid having unresolved
99 references in the shared libgnat. */
100 int __gl_main_priority = -1;
101 int __gl_main_cpu = -1;
102 int __gl_time_slice_val = -1;
103 char __gl_wc_encoding = 'n';
104 char __gl_locking_policy = ' ';
105 char __gl_queuing_policy = ' ';
106 char __gl_task_dispatching_policy = ' ';
107 char *__gl_priority_specific_dispatching = 0;
108 int __gl_num_specific_dispatching = 0;
109 char *__gl_interrupt_states = 0;
110 int __gl_num_interrupt_states = 0;
111 int __gl_unreserve_all_interrupts = 0;
112 int __gl_exception_tracebacks = 0;
113 int __gl_exception_tracebacks_symbolic = 0;
114 int __gl_detect_blocking = 0;
115 int __gl_default_stack_size = -1;
116 int __gl_leap_seconds_support = 0;
117 int __gl_canonical_streams = 0;
118 char *__gl_bind_env_addr = NULL;
119
120 /* This value is not used anymore, but kept for bootstrapping purpose. */
121 int __gl_zero_cost_exceptions = 0;
122
123 /* Indication of whether synchronous signal handler has already been
124 installed by a previous call to adainit. */
125 int __gnat_handler_installed = 0;
126
127 #ifndef IN_RTS
128 int __gnat_inside_elab_final_code = 0;
129 /* ??? This variable is obsolete since 2001-08-29 but is kept to allow
130 bootstrap from old GNAT versions (< 3.15). */
131 #endif
132
133 /* HAVE_GNAT_INIT_FLOAT must be set on every targets where a __gnat_init_float
134 is defined. If this is not set then a void implementation will be defined
135 at the end of this unit. */
136 #undef HAVE_GNAT_INIT_FLOAT
137
138 /******************************/
139 /* __gnat_get_interrupt_state */
140 /******************************/
141
142 char __gnat_get_interrupt_state (int);
143
144 /* This routine is called from the runtime as needed to determine the state
145 of an interrupt, as set by an Interrupt_State pragma appearing anywhere
146 in the current partition. The input argument is the interrupt number,
147 and the result is one of the following:
148
149 'n' this interrupt not set by any Interrupt_State pragma
150 'u' Interrupt_State pragma set state to User
151 'r' Interrupt_State pragma set state to Runtime
152 's' Interrupt_State pragma set state to System */
153
154 char
155 __gnat_get_interrupt_state (int intrup)
156 {
157 if (intrup >= __gl_num_interrupt_states)
158 return 'n';
159 else
160 return __gl_interrupt_states [intrup];
161 }
162
163 /***********************************/
164 /* __gnat_get_specific_dispatching */
165 /***********************************/
166
167 char __gnat_get_specific_dispatching (int);
168
169 /* This routine is called from the runtime as needed to determine the
170 priority specific dispatching policy, as set by a
171 Priority_Specific_Dispatching pragma appearing anywhere in the current
172 partition. The input argument is the priority number, and the result
173 is the upper case first character of the policy name, e.g. 'F' for
174 FIFO_Within_Priorities. A space ' ' is returned if no
175 Priority_Specific_Dispatching pragma is used in the partition. */
176
177 char
178 __gnat_get_specific_dispatching (int priority)
179 {
180 if (__gl_num_specific_dispatching == 0)
181 return ' ';
182 else if (priority >= __gl_num_specific_dispatching)
183 return 'F';
184 else
185 return __gl_priority_specific_dispatching [priority];
186 }
187
188 #ifndef IN_RTS
189
190 /**********************/
191 /* __gnat_set_globals */
192 /**********************/
193
194 /* This routine is kept for bootstrapping purposes, since the binder generated
195 file now sets the __gl_* variables directly. */
196
197 void
198 __gnat_set_globals (void)
199 {
200 }
201
202 #endif
203
204 /***************/
205 /* AIX Section */
206 /***************/
207
208 #if defined (_AIX)
209
210 #include <signal.h>
211 #include <sys/time.h>
212
213 /* Some versions of AIX don't define SA_NODEFER. */
214
215 #ifndef SA_NODEFER
216 #define SA_NODEFER 0
217 #endif /* SA_NODEFER */
218
219 /* Versions of AIX before 4.3 don't have nanosleep but provide
220 nsleep instead. */
221
222 #ifndef _AIXVERSION_430
223
224 extern int nanosleep (struct timestruc_t *, struct timestruc_t *);
225
226 int
227 nanosleep (struct timestruc_t *Rqtp, struct timestruc_t *Rmtp)
228 {
229 return nsleep (Rqtp, Rmtp);
230 }
231
232 #endif /* _AIXVERSION_430 */
233
234 static void
235 __gnat_error_handler (int sig,
236 siginfo_t *si ATTRIBUTE_UNUSED,
237 void *ucontext ATTRIBUTE_UNUSED)
238 {
239 struct Exception_Data *exception;
240 const char *msg;
241
242 switch (sig)
243 {
244 case SIGSEGV:
245 /* FIXME: we need to detect the case of a *real* SIGSEGV. */
246 exception = &storage_error;
247 msg = "stack overflow or erroneous memory access";
248 break;
249
250 case SIGBUS:
251 exception = &constraint_error;
252 msg = "SIGBUS";
253 break;
254
255 case SIGFPE:
256 exception = &constraint_error;
257 msg = "SIGFPE";
258 break;
259
260 default:
261 exception = &program_error;
262 msg = "unhandled signal";
263 }
264
265 Raise_From_Signal_Handler (exception, msg);
266 }
267
268 void
269 __gnat_install_handler (void)
270 {
271 struct sigaction act;
272
273 /* Set up signal handler to map synchronous signals to appropriate
274 exceptions. Make sure that the handler isn't interrupted by another
275 signal that might cause a scheduling event! */
276
277 act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
278 act.sa_sigaction = __gnat_error_handler;
279 sigemptyset (&act.sa_mask);
280
281 /* Do not install handlers if interrupt state is "System". */
282 if (__gnat_get_interrupt_state (SIGABRT) != 's')
283 sigaction (SIGABRT, &act, NULL);
284 if (__gnat_get_interrupt_state (SIGFPE) != 's')
285 sigaction (SIGFPE, &act, NULL);
286 if (__gnat_get_interrupt_state (SIGILL) != 's')
287 sigaction (SIGILL, &act, NULL);
288 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
289 sigaction (SIGSEGV, &act, NULL);
290 if (__gnat_get_interrupt_state (SIGBUS) != 's')
291 sigaction (SIGBUS, &act, NULL);
292
293 __gnat_handler_installed = 1;
294 }
295
296 /*****************/
297 /* HP-UX section */
298 /*****************/
299
300 #elif defined (__hpux__)
301
302 #include <signal.h>
303 #include <sys/ucontext.h>
304
305 #if defined (IN_RTS) && defined (__ia64__)
306
307 #include <sys/uc_access.h>
308
309 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
310
311 void
312 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
313 {
314 ucontext_t *uc = (ucontext_t *) ucontext;
315 uint64_t ip;
316
317 /* Adjust on itanium, as GetIPInfo is not supported. */
318 __uc_get_ip (uc, &ip);
319 __uc_set_ip (uc, ip + 1);
320 }
321 #endif /* IN_RTS && __ia64__ */
322
323 /* Tasking and Non-tasking signal handler. Map SIGnal to Ada exception
324 propagation after the required low level adjustments. */
325
326 static void
327 __gnat_error_handler (int sig,
328 siginfo_t *si ATTRIBUTE_UNUSED,
329 void *ucontext ATTRIBUTE_UNUSED)
330 {
331 struct Exception_Data *exception;
332 const char *msg;
333
334 __gnat_adjust_context_for_raise (sig, ucontext);
335
336 switch (sig)
337 {
338 case SIGSEGV:
339 /* FIXME: we need to detect the case of a *real* SIGSEGV. */
340 exception = &storage_error;
341 msg = "stack overflow or erroneous memory access";
342 break;
343
344 case SIGBUS:
345 exception = &constraint_error;
346 msg = "SIGBUS";
347 break;
348
349 case SIGFPE:
350 exception = &constraint_error;
351 msg = "SIGFPE";
352 break;
353
354 default:
355 exception = &program_error;
356 msg = "unhandled signal";
357 }
358
359 Raise_From_Signal_Handler (exception, msg);
360 }
361
362 /* This must be in keeping with System.OS_Interface.Alternate_Stack_Size. */
363 #if defined (__hppa__)
364 char __gnat_alternate_stack[16 * 1024]; /* 2 * SIGSTKSZ */
365 #else
366 char __gnat_alternate_stack[128 * 1024]; /* MINSIGSTKSZ */
367 #endif
368
369 void
370 __gnat_install_handler (void)
371 {
372 struct sigaction act;
373
374 /* Set up signal handler to map synchronous signals to appropriate
375 exceptions. Make sure that the handler isn't interrupted by another
376 signal that might cause a scheduling event! Also setup an alternate
377 stack region for the handler execution so that stack overflows can be
378 handled properly, avoiding a SEGV generation from stack usage by the
379 handler itself. */
380
381 stack_t stack;
382 stack.ss_sp = __gnat_alternate_stack;
383 stack.ss_size = sizeof (__gnat_alternate_stack);
384 stack.ss_flags = 0;
385 sigaltstack (&stack, NULL);
386
387 act.sa_sigaction = __gnat_error_handler;
388 act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
389 sigemptyset (&act.sa_mask);
390
391 /* Do not install handlers if interrupt state is "System". */
392 if (__gnat_get_interrupt_state (SIGABRT) != 's')
393 sigaction (SIGABRT, &act, NULL);
394 if (__gnat_get_interrupt_state (SIGFPE) != 's')
395 sigaction (SIGFPE, &act, NULL);
396 if (__gnat_get_interrupt_state (SIGILL) != 's')
397 sigaction (SIGILL, &act, NULL);
398 if (__gnat_get_interrupt_state (SIGBUS) != 's')
399 sigaction (SIGBUS, &act, NULL);
400 act.sa_flags |= SA_ONSTACK;
401 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
402 sigaction (SIGSEGV, &act, NULL);
403
404 __gnat_handler_installed = 1;
405 }
406
407 /*********************/
408 /* GNU/Linux Section */
409 /*********************/
410
411 #elif defined (__linux__)
412
413 #include <signal.h>
414
415 #define __USE_GNU 1 /* required to get REG_EIP/RIP from glibc's ucontext.h */
416 #include <sys/ucontext.h>
417
418 /* GNU/Linux, which uses glibc, does not define NULL in included
419 header files. */
420
421 #if !defined (NULL)
422 #define NULL ((void *) 0)
423 #endif
424
425 #if defined (MaRTE)
426
427 /* MaRTE OS provides its own version of sigaction, sigfillset, and
428 sigemptyset (overriding these symbol names). We want to make sure that
429 the versions provided by the underlying C library are used here (these
430 versions are renamed by MaRTE to linux_sigaction, fake_linux_sigfillset,
431 and fake_linux_sigemptyset, respectively). The MaRTE library will not
432 always be present (it will not be linked if no tasking constructs are
433 used), so we use the weak symbol mechanism to point always to the symbols
434 defined within the C library. */
435
436 #pragma weak linux_sigaction
437 int linux_sigaction (int signum, const struct sigaction *act,
438 struct sigaction *oldact)
439 {
440 return sigaction (signum, act, oldact);
441 }
442 #define sigaction(signum, act, oldact) linux_sigaction (signum, act, oldact)
443
444 #pragma weak fake_linux_sigfillset
445 void fake_linux_sigfillset (sigset_t *set)
446 {
447 sigfillset (set);
448 }
449 #define sigfillset(set) fake_linux_sigfillset (set)
450
451 #pragma weak fake_linux_sigemptyset
452 void fake_linux_sigemptyset (sigset_t *set)
453 {
454 sigemptyset (set);
455 }
456 #define sigemptyset(set) fake_linux_sigemptyset (set)
457
458 #endif
459
460 #if defined (__i386__) || defined (__x86_64__) || defined (__ia64__) \
461 || defined (__ARMEL__)
462
463 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
464
465 void
466 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
467 {
468 mcontext_t *mcontext = &((ucontext_t *) ucontext)->uc_mcontext;
469
470 /* On the i386 and x86-64 architectures, stack checking is performed by
471 means of probes with moving stack pointer, that is to say the probed
472 address is always the value of the stack pointer. Upon hitting the
473 guard page, the stack pointer therefore points to an inaccessible
474 address and an alternate signal stack is needed to run the handler.
475 But there is an additional twist: on these architectures, the EH
476 return code writes the address of the handler at the target CFA's
477 value on the stack before doing the jump. As a consequence, if
478 there is an active handler in the frame whose stack has overflowed,
479 the stack pointer must nevertheless point to an accessible address
480 by the time the EH return is executed.
481
482 We therefore adjust the saved value of the stack pointer by the size
483 of one page + a small dope of 4 words, in order to make sure that it
484 points to an accessible address in case it's used as the target CFA.
485 The stack checking code guarantees that this address is unused by the
486 time this happens. */
487
488 #if defined (__i386__)
489 unsigned long *pc = (unsigned long *)mcontext->gregs[REG_EIP];
490 /* The pattern is "orl $0x0,(%esp)" for a probe in 32-bit mode. */
491 if (signo == SIGSEGV && pc && *pc == 0x00240c83)
492 mcontext->gregs[REG_ESP] += 4096 + 4 * sizeof (unsigned long);
493 #elif defined (__x86_64__)
494 unsigned long long *pc = (unsigned long long *)mcontext->gregs[REG_RIP];
495 if (signo == SIGSEGV && pc
496 /* The pattern is "orq $0x0,(%rsp)" for a probe in 64-bit mode. */
497 && ((*pc & 0xffffffffffLL) == 0x00240c8348LL
498 /* The pattern may also be "orl $0x0,(%esp)" for a probe in
499 x32 mode. */
500 || (*pc & 0xffffffffLL) == 0x00240c83LL))
501 mcontext->gregs[REG_RSP] += 4096 + 4 * sizeof (unsigned long);
502 #elif defined (__ia64__)
503 /* ??? The IA-64 unwinder doesn't compensate for signals. */
504 mcontext->sc_ip++;
505 #elif defined (__ARMEL__)
506 /* ARM Bump has to be an even number because of odd/even architecture. */
507 mcontext->arm_pc+=2;
508 #endif
509 }
510
511 #endif
512
513 static void
514 __gnat_error_handler (int sig, siginfo_t *si ATTRIBUTE_UNUSED, void *ucontext)
515 {
516 struct Exception_Data *exception;
517 const char *msg;
518
519 /* Adjusting is required for every fault context, so adjust for this one
520 now, before we possibly trigger a recursive fault below. */
521 __gnat_adjust_context_for_raise (sig, ucontext);
522
523 switch (sig)
524 {
525 case SIGSEGV:
526 /* Here we would like a discrimination test to see whether the page
527 before the faulting address is accessible. Unfortunately, Linux
528 seems to have no way of giving us the faulting address.
529
530 In old versions of init.c, we had a test of the page before the
531 stack pointer:
532
533 ((volatile char *)
534 ((long) si->esp_at_signal & - getpagesize ()))[getpagesize ()];
535
536 but that's wrong since it tests the stack pointer location and the
537 stack probing code may not move it until all probes succeed.
538
539 For now we simply do not attempt any discrimination at all. Note
540 that this is quite acceptable, since a "real" SIGSEGV can only
541 occur as the result of an erroneous program. */
542 exception = &storage_error;
543 msg = "stack overflow or erroneous memory access";
544 break;
545
546 case SIGBUS:
547 exception = &storage_error;
548 msg = "SIGBUS: possible stack overflow";
549 break;
550
551 case SIGFPE:
552 exception = &constraint_error;
553 msg = "SIGFPE";
554 break;
555
556 default:
557 exception = &program_error;
558 msg = "unhandled signal";
559 }
560
561 Raise_From_Signal_Handler (exception, msg);
562 }
563
564 #ifndef __ia64__
565 #define HAVE_GNAT_ALTERNATE_STACK 1
566 /* This must be in keeping with System.OS_Interface.Alternate_Stack_Size.
567 It must be larger than MINSIGSTKSZ and hopefully near 2 * SIGSTKSZ. */
568 # if 16 * 1024 < MINSIGSTKSZ
569 # error "__gnat_alternate_stack too small"
570 # endif
571 char __gnat_alternate_stack[16 * 1024];
572 #endif
573
574 #ifdef __XENO__
575 #include <sys/mman.h>
576 #include <native/task.h>
577
578 RT_TASK main_task;
579 #endif
580
581 void
582 __gnat_install_handler (void)
583 {
584 struct sigaction act;
585
586 #ifdef __XENO__
587 int prio;
588
589 if (__gl_main_priority == -1)
590 prio = 49;
591 else
592 prio = __gl_main_priority;
593
594 /* Avoid memory swapping for this program */
595
596 mlockall (MCL_CURRENT|MCL_FUTURE);
597
598 /* Turn the current Linux task into a native Xenomai task */
599
600 rt_task_shadow (&main_task, "environment_task", prio, T_FPU);
601 #endif
602
603 /* Set up signal handler to map synchronous signals to appropriate
604 exceptions. Make sure that the handler isn't interrupted by another
605 signal that might cause a scheduling event! Also setup an alternate
606 stack region for the handler execution so that stack overflows can be
607 handled properly, avoiding a SEGV generation from stack usage by the
608 handler itself. */
609
610 act.sa_sigaction = __gnat_error_handler;
611 act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
612 sigemptyset (&act.sa_mask);
613
614 /* Do not install handlers if interrupt state is "System". */
615 if (__gnat_get_interrupt_state (SIGABRT) != 's')
616 sigaction (SIGABRT, &act, NULL);
617 if (__gnat_get_interrupt_state (SIGFPE) != 's')
618 sigaction (SIGFPE, &act, NULL);
619 if (__gnat_get_interrupt_state (SIGILL) != 's')
620 sigaction (SIGILL, &act, NULL);
621 if (__gnat_get_interrupt_state (SIGBUS) != 's')
622 sigaction (SIGBUS, &act, NULL);
623 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
624 {
625 #ifdef HAVE_GNAT_ALTERNATE_STACK
626 /* Setup an alternate stack region for the handler execution so that
627 stack overflows can be handled properly, avoiding a SEGV generation
628 from stack usage by the handler itself. */
629 stack_t stack;
630
631 stack.ss_sp = __gnat_alternate_stack;
632 stack.ss_size = sizeof (__gnat_alternate_stack);
633 stack.ss_flags = 0;
634 sigaltstack (&stack, NULL);
635
636 act.sa_flags |= SA_ONSTACK;
637 #endif
638 sigaction (SIGSEGV, &act, NULL);
639 }
640
641 __gnat_handler_installed = 1;
642 }
643
644 /*******************/
645 /* LynxOS Section */
646 /*******************/
647
648 #elif defined (__Lynx__)
649
650 #include <signal.h>
651 #include <unistd.h>
652
653 static void
654 __gnat_error_handler (int sig)
655 {
656 struct Exception_Data *exception;
657 const char *msg;
658
659 switch(sig)
660 {
661 case SIGFPE:
662 exception = &constraint_error;
663 msg = "SIGFPE";
664 break;
665 case SIGILL:
666 exception = &constraint_error;
667 msg = "SIGILL";
668 break;
669 case SIGSEGV:
670 exception = &storage_error;
671 msg = "stack overflow or erroneous memory access";
672 break;
673 case SIGBUS:
674 exception = &constraint_error;
675 msg = "SIGBUS";
676 break;
677 default:
678 exception = &program_error;
679 msg = "unhandled signal";
680 }
681
682 Raise_From_Signal_Handler (exception, msg);
683 }
684
685 void
686 __gnat_install_handler(void)
687 {
688 struct sigaction act;
689
690 act.sa_handler = __gnat_error_handler;
691 act.sa_flags = 0x0;
692 sigemptyset (&act.sa_mask);
693
694 /* Do not install handlers if interrupt state is "System". */
695 if (__gnat_get_interrupt_state (SIGFPE) != 's')
696 sigaction (SIGFPE, &act, NULL);
697 if (__gnat_get_interrupt_state (SIGILL) != 's')
698 sigaction (SIGILL, &act, NULL);
699 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
700 sigaction (SIGSEGV, &act, NULL);
701 if (__gnat_get_interrupt_state (SIGBUS) != 's')
702 sigaction (SIGBUS, &act, NULL);
703
704 __gnat_handler_installed = 1;
705 }
706
707 /*******************/
708 /* Solaris Section */
709 /*******************/
710
711 #elif defined (__sun__) && !defined (__vxworks)
712
713 #include <signal.h>
714 #include <siginfo.h>
715 #include <sys/ucontext.h>
716 #include <sys/regset.h>
717
718 static void
719 __gnat_error_handler (int sig, siginfo_t *si, void *ucontext ATTRIBUTE_UNUSED)
720 {
721 struct Exception_Data *exception;
722 static int recurse = 0;
723 const char *msg;
724
725 switch (sig)
726 {
727 case SIGSEGV:
728 /* If the problem was permissions, this is a constraint error.
729 Likewise if the failing address isn't maximally aligned or if
730 we've recursed.
731
732 ??? Using a static variable here isn't task-safe, but it's
733 much too hard to do anything else and we're just determining
734 which exception to raise. */
735 if (si->si_code == SEGV_ACCERR
736 || (long) si->si_addr == 0
737 || (((long) si->si_addr) & 3) != 0
738 || recurse)
739 {
740 exception = &constraint_error;
741 msg = "SIGSEGV";
742 }
743 else
744 {
745 /* See if the page before the faulting page is accessible. Do that
746 by trying to access it. We'd like to simply try to access
747 4096 + the faulting address, but it's not guaranteed to be
748 the actual address, just to be on the same page. */
749 recurse++;
750 ((volatile char *)
751 ((long) si->si_addr & - getpagesize ()))[getpagesize ()];
752 exception = &storage_error;
753 msg = "stack overflow or erroneous memory access";
754 }
755 break;
756
757 case SIGBUS:
758 exception = &program_error;
759 msg = "SIGBUS";
760 break;
761
762 case SIGFPE:
763 exception = &constraint_error;
764 msg = "SIGFPE";
765 break;
766
767 default:
768 exception = &program_error;
769 msg = "unhandled signal";
770 }
771
772 recurse = 0;
773 Raise_From_Signal_Handler (exception, msg);
774 }
775
776 void
777 __gnat_install_handler (void)
778 {
779 struct sigaction act;
780
781 /* Set up signal handler to map synchronous signals to appropriate
782 exceptions. Make sure that the handler isn't interrupted by another
783 signal that might cause a scheduling event! */
784
785 act.sa_sigaction = __gnat_error_handler;
786 act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
787 sigemptyset (&act.sa_mask);
788
789 /* Do not install handlers if interrupt state is "System". */
790 if (__gnat_get_interrupt_state (SIGABRT) != 's')
791 sigaction (SIGABRT, &act, NULL);
792 if (__gnat_get_interrupt_state (SIGFPE) != 's')
793 sigaction (SIGFPE, &act, NULL);
794 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
795 sigaction (SIGSEGV, &act, NULL);
796 if (__gnat_get_interrupt_state (SIGBUS) != 's')
797 sigaction (SIGBUS, &act, NULL);
798
799 __gnat_handler_installed = 1;
800 }
801
802 /***************/
803 /* VMS Section */
804 /***************/
805
806 #elif defined (VMS)
807
808 /* Routine called from binder to override default feature values. */
809 void __gnat_set_features (void);
810 int __gnat_features_set = 0;
811 void (*__gnat_ctrl_c_handler) (void) = 0;
812
813 #ifdef __IA64
814 #define lib_get_curr_invo_context LIB$I64_GET_CURR_INVO_CONTEXT
815 #define lib_get_prev_invo_context LIB$I64_GET_PREV_INVO_CONTEXT
816 #define lib_get_invo_handle LIB$I64_GET_INVO_HANDLE
817 #else
818 #define lib_get_curr_invo_context LIB$GET_CURR_INVO_CONTEXT
819 #define lib_get_prev_invo_context LIB$GET_PREV_INVO_CONTEXT
820 #define lib_get_invo_handle LIB$GET_INVO_HANDLE
821 #endif
822
823 /* Masks for facility identification. */
824 #define FAC_MASK 0x0fff0000
825 #define DECADA_M_FACILITY 0x00310000
826
827 /* Define macro symbols for the VMS conditions that become Ada exceptions.
828 It would be better to just include <ssdef.h> */
829
830 #define SS$_CONTINUE 1
831 #define SS$_ACCVIO 12
832 #define SS$_HPARITH 1284
833 #define SS$_INTDIV 1156
834 #define SS$_STKOVF 1364
835 #define SS$_CONTROLC 1617
836 #define SS$_RESIGNAL 2328
837
838 #define MTH$_FLOOVEMAT 1475268 /* Some ACVC_21 CXA tests */
839
840 /* The following codes must be resignalled, and not handled here. */
841
842 /* These codes are in standard message libraries. */
843 extern int C$_SIGKILL;
844 extern int C$_SIGINT;
845 extern int SS$_DEBUG;
846 extern int LIB$_KEYNOTFOU;
847 extern int LIB$_ACTIMAGE;
848
849 /* These codes are non standard, which is to say the author is
850 not sure if they are defined in the standard message libraries
851 so keep them as macros for now. */
852 #define RDB$_STREAM_EOF 20480426
853 #define FDL$_UNPRIKW 11829410
854 #define CMA$_EXIT_THREAD 4227492
855
856 struct cond_sigargs
857 {
858 unsigned int sigarg;
859 unsigned int sigargval;
860 };
861
862 struct cond_subtests
863 {
864 unsigned int num;
865 const struct cond_sigargs sigargs[];
866 };
867
868 struct cond_except
869 {
870 unsigned int cond;
871 const struct Exception_Data *except;
872 unsigned int needs_adjust; /* 1 = adjust PC, 0 = no adjust */
873 const struct cond_subtests *subtests;
874 };
875
876 struct descriptor_s
877 {
878 unsigned short len, mbz;
879 __char_ptr32 adr;
880 };
881
882 /* Conditions that don't have an Ada exception counterpart must raise
883 Non_Ada_Error. Since this is defined in s-auxdec, it should only be
884 referenced by user programs, not the compiler or tools. Hence the
885 #ifdef IN_RTS. */
886
887 #ifdef IN_RTS
888
889 #define Status_Error ada__io_exceptions__status_error
890 extern struct Exception_Data Status_Error;
891
892 #define Mode_Error ada__io_exceptions__mode_error
893 extern struct Exception_Data Mode_Error;
894
895 #define Name_Error ada__io_exceptions__name_error
896 extern struct Exception_Data Name_Error;
897
898 #define Use_Error ada__io_exceptions__use_error
899 extern struct Exception_Data Use_Error;
900
901 #define Device_Error ada__io_exceptions__device_error
902 extern struct Exception_Data Device_Error;
903
904 #define End_Error ada__io_exceptions__end_error
905 extern struct Exception_Data End_Error;
906
907 #define Data_Error ada__io_exceptions__data_error
908 extern struct Exception_Data Data_Error;
909
910 #define Layout_Error ada__io_exceptions__layout_error
911 extern struct Exception_Data Layout_Error;
912
913 #define Non_Ada_Error system__aux_dec__non_ada_error
914 extern struct Exception_Data Non_Ada_Error;
915
916 #define Coded_Exception system__vms_exception_table__coded_exception
917 extern struct Exception_Data *Coded_Exception (void *);
918
919 #define Base_Code_In system__vms_exception_table__base_code_in
920 extern void *Base_Code_In (void *);
921
922 /* DEC Ada exceptions are not defined in a header file, so they
923 must be declared. */
924
925 #define ADA$_ALREADY_OPEN 0x0031a594
926 #define ADA$_CONSTRAINT_ERRO 0x00318324
927 #define ADA$_DATA_ERROR 0x003192c4
928 #define ADA$_DEVICE_ERROR 0x003195e4
929 #define ADA$_END_ERROR 0x00319904
930 #define ADA$_FAC_MODE_MISMAT 0x0031a8b3
931 #define ADA$_IOSYSFAILED 0x0031af04
932 #define ADA$_KEYSIZERR 0x0031aa3c
933 #define ADA$_KEY_MISMATCH 0x0031a8e3
934 #define ADA$_LAYOUT_ERROR 0x00319c24
935 #define ADA$_LINEXCMRS 0x0031a8f3
936 #define ADA$_MAXLINEXC 0x0031a8eb
937 #define ADA$_MODE_ERROR 0x00319f44
938 #define ADA$_MRN_MISMATCH 0x0031a8db
939 #define ADA$_MRS_MISMATCH 0x0031a8d3
940 #define ADA$_NAME_ERROR 0x0031a264
941 #define ADA$_NOT_OPEN 0x0031a58c
942 #define ADA$_ORG_MISMATCH 0x0031a8bb
943 #define ADA$_PROGRAM_ERROR 0x00318964
944 #define ADA$_RAT_MISMATCH 0x0031a8cb
945 #define ADA$_RFM_MISMATCH 0x0031a8c3
946 #define ADA$_STAOVF 0x00318cac
947 #define ADA$_STATUS_ERROR 0x0031a584
948 #define ADA$_STORAGE_ERROR 0x00318c84
949 #define ADA$_UNSUPPORTED 0x0031a8ab
950 #define ADA$_USE_ERROR 0x0031a8a4
951
952 /* DEC Ada specific conditions. */
953 static const struct cond_except dec_ada_cond_except_table [] =
954 {
955 {ADA$_PROGRAM_ERROR, &program_error, 0, 0},
956 {ADA$_USE_ERROR, &Use_Error, 0, 0},
957 {ADA$_KEYSIZERR, &program_error, 0, 0},
958 {ADA$_STAOVF, &storage_error, 0, 0},
959 {ADA$_CONSTRAINT_ERRO, &constraint_error, 0, 0},
960 {ADA$_IOSYSFAILED, &Device_Error, 0, 0},
961 {ADA$_LAYOUT_ERROR, &Layout_Error, 0, 0},
962 {ADA$_STORAGE_ERROR, &storage_error, 0, 0},
963 {ADA$_DATA_ERROR, &Data_Error, 0, 0},
964 {ADA$_DEVICE_ERROR, &Device_Error, 0, 0},
965 {ADA$_END_ERROR, &End_Error, 0, 0},
966 {ADA$_MODE_ERROR, &Mode_Error, 0, 0},
967 {ADA$_NAME_ERROR, &Name_Error, 0, 0},
968 {ADA$_STATUS_ERROR, &Status_Error, 0, 0},
969 {ADA$_NOT_OPEN, &Use_Error, 0, 0},
970 {ADA$_ALREADY_OPEN, &Use_Error, 0, 0},
971 {ADA$_USE_ERROR, &Use_Error, 0, 0},
972 {ADA$_UNSUPPORTED, &Use_Error, 0, 0},
973 {ADA$_FAC_MODE_MISMAT, &Use_Error, 0, 0},
974 {ADA$_ORG_MISMATCH, &Use_Error, 0, 0},
975 {ADA$_RFM_MISMATCH, &Use_Error, 0, 0},
976 {ADA$_RAT_MISMATCH, &Use_Error, 0, 0},
977 {ADA$_MRS_MISMATCH, &Use_Error, 0, 0},
978 {ADA$_MRN_MISMATCH, &Use_Error, 0, 0},
979 {ADA$_KEY_MISMATCH, &Use_Error, 0, 0},
980 {ADA$_MAXLINEXC, &constraint_error, 0, 0},
981 {ADA$_LINEXCMRS, &constraint_error, 0, 0},
982
983 #if 0
984 /* Already handled by a pragma Import_Exception
985 in Aux_IO_Exceptions */
986 {ADA$_LOCK_ERROR, &Lock_Error, 0, 0},
987 {ADA$_EXISTENCE_ERROR, &Existence_Error, 0, 0},
988 {ADA$_KEY_ERROR, &Key_Error, 0, 0},
989 #endif
990
991 {0, 0, 0, 0}
992 };
993
994 #endif /* IN_RTS */
995
996 /* Non-DEC Ada specific conditions that map to Ada exceptions. */
997
998 /* Subtest for ACCVIO Constraint_Error, kept for compatibility,
999 in hindsight should have just made ACCVIO == Storage_Error. */
1000 #define ACCVIO_VIRTUAL_ADDR 3
1001 static const struct cond_subtests accvio_c_e =
1002 {1, /* number of subtests below */
1003 {
1004 { ACCVIO_VIRTUAL_ADDR, 0 }
1005 }
1006 };
1007
1008 /* Macro flag to adjust PC which gets off by one for some conditions,
1009 not sure if this is reliably true, PC could be off by more for
1010 HPARITH for example, unless a trapb is inserted. */
1011 #define NEEDS_ADJUST 1
1012
1013 static const struct cond_except system_cond_except_table [] =
1014 {
1015 {MTH$_FLOOVEMAT, &constraint_error, 0, 0},
1016 {SS$_INTDIV, &constraint_error, 0, 0},
1017 {SS$_HPARITH, &constraint_error, NEEDS_ADJUST, 0},
1018 {SS$_ACCVIO, &constraint_error, NEEDS_ADJUST, &accvio_c_e},
1019 {SS$_ACCVIO, &storage_error, NEEDS_ADJUST, 0},
1020 {SS$_STKOVF, &storage_error, NEEDS_ADJUST, 0},
1021 {0, 0, 0, 0}
1022 };
1023
1024 /* To deal with VMS conditions and their mapping to Ada exceptions,
1025 the __gnat_error_handler routine below is installed as an exception
1026 vector having precedence over DEC frame handlers. Some conditions
1027 still need to be handled by such handlers, however, in which case
1028 __gnat_error_handler needs to return SS$_RESIGNAL. Consider for
1029 instance the use of a third party library compiled with DECAda and
1030 performing its own exception handling internally.
1031
1032 To allow some user-level flexibility, which conditions should be
1033 resignaled is controlled by a predicate function, provided with the
1034 condition value and returning a boolean indication stating whether
1035 this condition should be resignaled or not.
1036
1037 That predicate function is called indirectly, via a function pointer,
1038 by __gnat_error_handler, and changing that pointer is allowed to the
1039 user code by way of the __gnat_set_resignal_predicate interface.
1040
1041 The user level function may then implement what it likes, including
1042 for instance the maintenance of a dynamic data structure if the set
1043 of to be resignalled conditions has to change over the program's
1044 lifetime.
1045
1046 ??? This is not a perfect solution to deal with the possible
1047 interactions between the GNAT and the DECAda exception handling
1048 models and better (more general) schemes are studied. This is so
1049 just provided as a convenient workaround in the meantime, and
1050 should be use with caution since the implementation has been kept
1051 very simple. */
1052
1053 typedef int resignal_predicate (int code);
1054
1055 static const int * const cond_resignal_table [] =
1056 {
1057 &C$_SIGKILL,
1058 (int *)CMA$_EXIT_THREAD,
1059 &SS$_DEBUG,
1060 &LIB$_KEYNOTFOU,
1061 &LIB$_ACTIMAGE,
1062 (int *) RDB$_STREAM_EOF,
1063 (int *) FDL$_UNPRIKW,
1064 0
1065 };
1066
1067 static const int facility_resignal_table [] =
1068 {
1069 0x1380000, /* RDB */
1070 0x2220000, /* SQL */
1071 0
1072 };
1073
1074 /* Default GNAT predicate for resignaling conditions. */
1075
1076 static int
1077 __gnat_default_resignal_p (int code)
1078 {
1079 int i, iexcept;
1080
1081 for (i = 0; facility_resignal_table [i]; i++)
1082 if ((code & FAC_MASK) == facility_resignal_table [i])
1083 return 1;
1084
1085 for (i = 0, iexcept = 0;
1086 cond_resignal_table [i]
1087 && !(iexcept = LIB$MATCH_COND (&code, &cond_resignal_table [i]));
1088 i++);
1089
1090 return iexcept;
1091 }
1092
1093 /* Static pointer to predicate that the __gnat_error_handler exception
1094 vector invokes to determine if it should resignal a condition. */
1095
1096 static resignal_predicate *__gnat_resignal_p = __gnat_default_resignal_p;
1097
1098 /* User interface to change the predicate pointer to PREDICATE. Reset to
1099 the default if PREDICATE is null. */
1100
1101 void
1102 __gnat_set_resignal_predicate (resignal_predicate *predicate)
1103 {
1104 if (predicate == NULL)
1105 __gnat_resignal_p = __gnat_default_resignal_p;
1106 else
1107 __gnat_resignal_p = predicate;
1108 }
1109
1110 /* Should match System.Parameters.Default_Exception_Msg_Max_Length. */
1111 #define Default_Exception_Msg_Max_Length 512
1112
1113 /* Action routine for SYS$PUTMSG. There may be multiple
1114 conditions, each with text to be appended to MESSAGE
1115 and separated by line termination. */
1116 static int
1117 copy_msg (struct descriptor_s *msgdesc, char *message)
1118 {
1119 int len = strlen (message);
1120 int copy_len;
1121
1122 /* Check for buffer overflow and skip. */
1123 if (len > 0 && len <= Default_Exception_Msg_Max_Length - 3)
1124 {
1125 strcat (message, "\r\n");
1126 len += 2;
1127 }
1128
1129 /* Check for buffer overflow and truncate if necessary. */
1130 copy_len = (len + msgdesc->len <= Default_Exception_Msg_Max_Length - 1 ?
1131 msgdesc->len :
1132 Default_Exception_Msg_Max_Length - 1 - len);
1133 strncpy (&message [len], msgdesc->adr, copy_len);
1134 message [len + copy_len] = 0;
1135
1136 return 0;
1137 }
1138
1139 /* Scan TABLE for a match for the condition contained in SIGARGS,
1140 and return the entry, or the empty entry if no match found. */
1141 static const struct cond_except *
1142 scan_conditions ( int *sigargs, const struct cond_except *table [])
1143 {
1144 int i;
1145 struct cond_except entry;
1146
1147 /* Scan the exception condition table for a match and fetch
1148 the associated GNAT exception pointer. */
1149 for (i = 0; (*table) [i].cond; i++)
1150 {
1151 unsigned int match = LIB$MATCH_COND (&sigargs [1], &(*table) [i].cond);
1152 const struct cond_subtests *subtests = (*table) [i].subtests;
1153
1154 if (match)
1155 {
1156 if (!subtests)
1157 {
1158 return &(*table) [i];
1159 }
1160 else
1161 {
1162 unsigned int ii;
1163 int num = (*subtests).num;
1164
1165 /* Perform subtests to differentiate exception. */
1166 for (ii = 0; ii < num; ii++)
1167 {
1168 unsigned int arg = (*subtests).sigargs [ii].sigarg;
1169 unsigned int argval = (*subtests).sigargs [ii].sigargval;
1170
1171 if (sigargs [arg] != argval)
1172 {
1173 num = 0;
1174 break;
1175 }
1176 }
1177
1178 /* All subtests passed. */
1179 if (num == (*subtests).num)
1180 return &(*table) [i];
1181 }
1182 }
1183 }
1184
1185 /* No match, return the null terminating entry. */
1186 return &(*table) [i];
1187 }
1188
1189 /* __gnat_handle_vms_condtition is both a frame based handler
1190 for the runtime, and an exception vector for the compiler. */
1191 long
1192 __gnat_handle_vms_condition (int *sigargs, void *mechargs)
1193 {
1194 struct Exception_Data *exception = 0;
1195 unsigned int needs_adjust = 0;
1196 void *base_code;
1197 struct descriptor_s gnat_facility = {4, 0, "GNAT"};
1198 char message [Default_Exception_Msg_Max_Length];
1199
1200 const char *msg = "";
1201
1202 /* Check for conditions to resignal which aren't effected by pragma
1203 Import_Exception. */
1204 if (__gnat_resignal_p (sigargs [1]))
1205 return SS$_RESIGNAL;
1206 #ifndef IN_RTS
1207 /* toplev.c handles this for compiler. */
1208 if (sigargs [1] == SS$_HPARITH)
1209 return SS$_RESIGNAL;
1210 #endif
1211
1212 #ifdef IN_RTS
1213 /* See if it's an imported exception. Beware that registered exceptions
1214 are bound to their base code, with the severity bits masked off. */
1215 base_code = Base_Code_In ((void *) sigargs[1]);
1216 exception = Coded_Exception (base_code);
1217 #endif
1218
1219 if (exception == 0)
1220 #ifdef IN_RTS
1221 {
1222 int i;
1223 struct cond_except cond;
1224 const struct cond_except *cond_table;
1225 const struct cond_except *cond_tables [] = {dec_ada_cond_except_table,
1226 system_cond_except_table,
1227 0};
1228 unsigned int ctrlc = SS$_CONTROLC;
1229 unsigned int *sigint = &C$_SIGINT;
1230 int ctrlc_match = LIB$MATCH_COND (&sigargs [1], &ctrlc);
1231 int sigint_match = LIB$MATCH_COND (&sigargs [1], &sigint);
1232
1233 extern int SYS$DCLAST (void (*astadr)(), unsigned long long astprm,
1234 unsigned int acmode);
1235
1236 /* If SS$_CONTROLC has been imported as an exception, it will take
1237 priority over a Ctrl/C handler. See above. SIGINT has a
1238 different condition value due to it's DECCCRTL roots and it's
1239 the condition that gets raised for a "kill -INT". */
1240 if ((ctrlc_match || sigint_match) && __gnat_ctrl_c_handler)
1241 {
1242 SYS$DCLAST (__gnat_ctrl_c_handler, 0, 0);
1243 return SS$_CONTINUE;
1244 }
1245
1246 i = 0;
1247 while ((cond_table = cond_tables[i++]) && !exception)
1248 {
1249 cond = *scan_conditions (sigargs, &cond_table);
1250 exception = (struct Exception_Data *) cond.except;
1251 }
1252
1253 if (exception)
1254 needs_adjust = cond.needs_adjust;
1255 else
1256 /* User programs expect Non_Ada_Error to be raised if no match,
1257 reference DEC Ada test CXCONDHAN. */
1258 exception = &Non_Ada_Error;
1259 }
1260 #else
1261 {
1262 /* Pretty much everything is just a program error in the compiler */
1263 exception = &program_error;
1264 }
1265 #endif
1266
1267 message[0] = 0;
1268 /* Subtract PC & PSL fields as per ABI for SYS$PUTMSG. */
1269 sigargs[0] -= 2;
1270
1271 extern int SYS$PUTMSG (void *, int (*)(), void *, unsigned long long);
1272
1273 /* If it was a DEC Ada specific condtiion, make it GNAT otherwise
1274 keep the old facility. */
1275 if (sigargs [1] & FAC_MASK == DECADA_M_FACILITY)
1276 SYS$PUTMSG (sigargs, copy_msg, &gnat_facility,
1277 (unsigned long long ) message);
1278 else
1279 SYS$PUTMSG (sigargs, copy_msg, 0,
1280 (unsigned long long ) message);
1281
1282 /* Add back PC & PSL fields as per ABI for SYS$PUTMSG. */
1283 sigargs[0] += 2;
1284 msg = message;
1285
1286 if (needs_adjust)
1287 __gnat_adjust_context_for_raise (sigargs [1], (void *)mechargs);
1288
1289 Raise_From_Signal_Handler (exception, msg);
1290 }
1291
1292 #if defined (IN_RTS) && defined (__IA64)
1293 /* Called only from adasigio.b32. This is a band aid to avoid going
1294 through the VMS signal handling code which results in a 0x8000 per
1295 handled exception memory leak in P2 space (see VMS source listing
1296 sys/lis/exception.lis) due to the allocation of working space that
1297 is expected to be deallocated upon return from the condition handler,
1298 which doesn't return in GNAT compiled code. */
1299 void
1300 GNAT$STOP (int *sigargs)
1301 {
1302 /* Note that there are no mechargs. We rely on the fact that condtions
1303 raised from DEClib I/O do not require an "adjust". Also the count
1304 will be off by 2, since LIB$STOP didn't get a chance to add the
1305 PC and PSL fields, so we bump it so PUTMSG comes out right. */
1306 sigargs [0] += 2;
1307 __gnat_handle_vms_condition (sigargs, 0);
1308 }
1309 #endif
1310
1311 void
1312 __gnat_install_handler (void)
1313 {
1314 long prvhnd ATTRIBUTE_UNUSED;
1315
1316 #if !defined (IN_RTS)
1317 extern int SYS$SETEXV (unsigned int vector, int (*addres)(),
1318 unsigned int accmode, void *(*(prvhnd)));
1319 SYS$SETEXV (1, __gnat_handle_vms_condition, 3, &prvhnd);
1320 #endif
1321
1322 __gnat_handler_installed = 1;
1323 }
1324
1325 /* __gnat_adjust_context_for_raise for Alpha - see comments along with the
1326 default version later in this file. */
1327
1328 #if defined (IN_RTS) && defined (__alpha__)
1329
1330 #include <vms/chfctxdef.h>
1331 #include <vms/chfdef.h>
1332
1333 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
1334
1335 void
1336 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
1337 {
1338 if (signo == SS$_HPARITH)
1339 {
1340 /* Sub one to the address of the instruction signaling the condition,
1341 located in the sigargs array. */
1342
1343 CHF$MECH_ARRAY * mechargs = (CHF$MECH_ARRAY *) ucontext;
1344 CHF$SIGNAL_ARRAY * sigargs
1345 = (CHF$SIGNAL_ARRAY *) mechargs->chf$q_mch_sig_addr;
1346
1347 int vcount = sigargs->chf$is_sig_args;
1348 int * pc_slot = & (&sigargs->chf$l_sig_name)[vcount-2];
1349
1350 (*pc_slot)--;
1351 }
1352 }
1353
1354 #endif
1355
1356 /* __gnat_adjust_context_for_raise for ia64. */
1357
1358 #if defined (IN_RTS) && defined (__IA64)
1359
1360 #include <vms/chfctxdef.h>
1361 #include <vms/chfdef.h>
1362
1363 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
1364
1365 typedef unsigned long long u64;
1366
1367 void
1368 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
1369 {
1370 /* Add one to the address of the instruction signaling the condition,
1371 located in the 64bits sigargs array. */
1372
1373 CHF$MECH_ARRAY * mechargs = (CHF$MECH_ARRAY *) ucontext;
1374
1375 CHF64$SIGNAL_ARRAY *chfsig64
1376 = (CHF64$SIGNAL_ARRAY *) mechargs->chf$ph_mch_sig64_addr;
1377
1378 u64 * post_sigarray
1379 = (u64 *)chfsig64 + 1 + chfsig64->chf64$l_sig_args;
1380
1381 u64 * ih_pc_loc = post_sigarray - 2;
1382
1383 (*ih_pc_loc) ++;
1384 }
1385
1386 #endif
1387
1388 /* Easier interface for LIB$GET_LOGICAL: put the equivalence of NAME into BUF,
1389 always NUL terminated. In case of error or if the result is longer than
1390 LEN (length of BUF) an empty string is written info BUF. */
1391
1392 static void
1393 __gnat_vms_get_logical (const char *name, char *buf, int len)
1394 {
1395 struct descriptor_s name_desc, result_desc;
1396 int status;
1397 unsigned short rlen;
1398
1399 /* Build the descriptor for NAME. */
1400 name_desc.len = strlen (name);
1401 name_desc.mbz = 0;
1402 name_desc.adr = (char *)name;
1403
1404 /* Build the descriptor for the result. */
1405 result_desc.len = len;
1406 result_desc.mbz = 0;
1407 result_desc.adr = buf;
1408
1409 status = LIB$GET_LOGICAL (&name_desc, &result_desc, &rlen);
1410
1411 if ((status & 1) == 1 && rlen < len)
1412 buf[rlen] = 0;
1413 else
1414 buf[0] = 0;
1415 }
1416
1417 /* Size of a page on ia64 and alpha VMS. */
1418 #define VMS_PAGESIZE 8192
1419
1420 /* User mode. */
1421 #define PSL__C_USER 3
1422
1423 /* No access. */
1424 #define PRT__C_NA 0
1425
1426 /* Descending region. */
1427 #define VA__M_DESCEND 1
1428
1429 /* Get by virtual address. */
1430 #define VA___REGSUM_BY_VA 1
1431
1432 /* Memory region summary. */
1433 struct regsum
1434 {
1435 unsigned long long q_region_id;
1436 unsigned int l_flags;
1437 unsigned int l_region_protection;
1438 void *pq_start_va;
1439 unsigned long long q_region_size;
1440 void *pq_first_free_va;
1441 };
1442
1443 extern int SYS$GET_REGION_INFO (unsigned int, unsigned long long *,
1444 void *, void *, unsigned int,
1445 void *, unsigned int *);
1446 extern int SYS$EXPREG_64 (unsigned long long *, unsigned long long,
1447 unsigned int, unsigned int, void **,
1448 unsigned long long *);
1449 extern int SYS$SETPRT_64 (void *, unsigned long long, unsigned int,
1450 unsigned int, void **, unsigned long long *,
1451 unsigned int *);
1452
1453 /* Add a guard page in the memory region containing ADDR at ADDR +/- SIZE.
1454 (The sign depends on the kind of the memory region). */
1455
1456 static int
1457 __gnat_set_stack_guard_page (void *addr, unsigned long size)
1458 {
1459 int status;
1460 void *ret_va;
1461 unsigned long long ret_len;
1462 unsigned int ret_prot;
1463 void *start_va;
1464 unsigned long long length;
1465 unsigned int retlen;
1466 struct regsum buffer;
1467
1468 /* Get the region for ADDR. */
1469 status = SYS$GET_REGION_INFO
1470 (VA___REGSUM_BY_VA, NULL, addr, NULL, sizeof (buffer), &buffer, &retlen);
1471
1472 if ((status & 1) != 1)
1473 return -1;
1474
1475 /* Extend the region. */
1476 status = SYS$EXPREG_64 (&buffer.q_region_id,
1477 size, 0, 0, &start_va, &length);
1478
1479 if ((status & 1) != 1)
1480 return -1;
1481
1482 /* Create a guard page. */
1483 if (!(buffer.l_flags & VA__M_DESCEND))
1484 start_va = (void *)((unsigned long long)start_va + length - VMS_PAGESIZE);
1485
1486 status = SYS$SETPRT_64 (start_va, VMS_PAGESIZE, PSL__C_USER, PRT__C_NA,
1487 &ret_va, &ret_len, &ret_prot);
1488
1489 if ((status & 1) != 1)
1490 return -1;
1491 return 0;
1492 }
1493
1494 /* Read logicals to limit the stack(s) size. */
1495
1496 static void
1497 __gnat_set_stack_limit (void)
1498 {
1499 #ifdef __ia64__
1500 void *sp;
1501 unsigned long size;
1502 char value[16];
1503 char *e;
1504
1505 /* The main stack. */
1506 __gnat_vms_get_logical ("GNAT_STACK_SIZE", value, sizeof (value));
1507 size = strtoul (value, &e, 0);
1508 if (e > value && *e == 0)
1509 {
1510 asm ("mov %0=sp" : "=r" (sp));
1511 __gnat_set_stack_guard_page (sp, size * 1024);
1512 }
1513
1514 /* The register stack. */
1515 __gnat_vms_get_logical ("GNAT_RBS_SIZE", value, sizeof (value));
1516 size = strtoul (value, &e, 0);
1517 if (e > value && *e == 0)
1518 {
1519 asm ("mov %0=ar.bsp" : "=r" (sp));
1520 __gnat_set_stack_guard_page (sp, size * 1024);
1521 }
1522 #endif
1523 }
1524
1525 #ifdef IN_RTS
1526 extern int SYS$IEEE_SET_FP_CONTROL (void *, void *, void *);
1527 #define K_TRUE 1
1528 #define __int64 long long
1529 #define __NEW_STARLET
1530 #include <vms/ieeedef.h>
1531 #endif
1532
1533 /* Feature logical name and global variable address pair.
1534 If we ever add another feature logical to this list, the
1535 feature struct will need to be enhanced to take into account
1536 possible values for *gl_addr. */
1537 struct feature {
1538 const char *name;
1539 int *gl_addr;
1540 };
1541
1542 /* Default values for GNAT features set by environment or binder. */
1543 int __gl_heap_size = 64;
1544
1545 /* Default float format is 'I' meaning IEEE. If gnatbind detetcts that a
1546 VAX Float format is specified, it will set this global variable to 'V'.
1547 Subsequently __gnat_set_features will test the variable and if set for
1548 VAX Float will call a Starlet function to enable trapping for invalid
1549 operation, drivide by zero, and overflow. This will prevent the VMS runtime
1550 (specifically OTS$CHECK_FP_MODE) from complaining about inconsistent
1551 floating point settings in a mixed language program. Ideally the setting
1552 would be determined at link time based on setttings in the object files,
1553 however the VMS linker seems to take the setting from the first object
1554 in the link, e.g. pcrt0.o which is float representation neutral. */
1555 char __gl_float_format = 'I';
1556
1557 /* Array feature logical names and global variable addresses. */
1558 static const struct feature features[] =
1559 {
1560 {"GNAT$NO_MALLOC_64", &__gl_heap_size},
1561 {0, 0}
1562 };
1563
1564 void
1565 __gnat_set_features (void)
1566 {
1567 int i;
1568 char buff[16];
1569 #ifdef IN_RTS
1570 IEEE clrmsk, setmsk, prvmsk;
1571
1572 clrmsk.ieee$q_flags = 0LL;
1573 setmsk.ieee$q_flags = 0LL;
1574 #endif
1575
1576 /* Loop through features array and test name for enable/disable. */
1577 for (i = 0; features[i].name; i++)
1578 {
1579 __gnat_vms_get_logical (features[i].name, buff, sizeof (buff));
1580
1581 if (strcmp (buff, "ENABLE") == 0
1582 || strcmp (buff, "TRUE") == 0
1583 || strcmp (buff, "1") == 0)
1584 *features[i].gl_addr = 32;
1585 else if (strcmp (buff, "DISABLE") == 0
1586 || strcmp (buff, "FALSE") == 0
1587 || strcmp (buff, "0") == 0)
1588 *features[i].gl_addr = 64;
1589 }
1590
1591 /* Features to artificially limit the stack size. */
1592 __gnat_set_stack_limit ();
1593
1594 #ifdef IN_RTS
1595 if (__gl_float_format == 'V')
1596 {
1597 setmsk.ieee$v_trap_enable_inv = K_TRUE;
1598 setmsk.ieee$v_trap_enable_dze = K_TRUE;
1599 setmsk.ieee$v_trap_enable_ovf = K_TRUE;
1600 SYS$IEEE_SET_FP_CONTROL (&clrmsk, &setmsk, &prvmsk);
1601 }
1602 #endif
1603
1604 __gnat_features_set = 1;
1605 }
1606
1607 /* Return true if the VMS version is 7.x. */
1608
1609 extern unsigned int LIB$GETSYI (int *, ...);
1610
1611 #define SYI$_VERSION 0x1000
1612
1613 int
1614 __gnat_is_vms_v7 (void)
1615 {
1616 struct descriptor_s desc;
1617 char version[8];
1618 int status;
1619 int code = SYI$_VERSION;
1620
1621 desc.len = sizeof (version);
1622 desc.mbz = 0;
1623 desc.adr = version;
1624
1625 status = LIB$GETSYI (&code, 0, &desc);
1626 if ((status & 1) == 1 && version[1] == '7' && version[2] == '.')
1627 return 1;
1628 else
1629 return 0;
1630 }
1631
1632 /*******************/
1633 /* FreeBSD Section */
1634 /*******************/
1635
1636 #elif defined (__FreeBSD__) || defined (__DragonFly__)
1637
1638 #include <signal.h>
1639 #include <sys/ucontext.h>
1640 #include <unistd.h>
1641
1642 static void
1643 __gnat_error_handler (int sig,
1644 siginfo_t *si ATTRIBUTE_UNUSED,
1645 void *ucontext ATTRIBUTE_UNUSED)
1646 {
1647 struct Exception_Data *exception;
1648 const char *msg;
1649
1650 switch (sig)
1651 {
1652 case SIGFPE:
1653 exception = &constraint_error;
1654 msg = "SIGFPE";
1655 break;
1656
1657 case SIGILL:
1658 exception = &constraint_error;
1659 msg = "SIGILL";
1660 break;
1661
1662 case SIGSEGV:
1663 exception = &storage_error;
1664 msg = "stack overflow or erroneous memory access";
1665 break;
1666
1667 case SIGBUS:
1668 exception = &storage_error;
1669 msg = "SIGBUS: possible stack overflow";
1670 break;
1671
1672 default:
1673 exception = &program_error;
1674 msg = "unhandled signal";
1675 }
1676
1677 Raise_From_Signal_Handler (exception, msg);
1678 }
1679
1680 void
1681 __gnat_install_handler (void)
1682 {
1683 struct sigaction act;
1684
1685 /* Set up signal handler to map synchronous signals to appropriate
1686 exceptions. Make sure that the handler isn't interrupted by another
1687 signal that might cause a scheduling event! */
1688
1689 act.sa_sigaction
1690 = (void (*)(int, struct __siginfo *, void*)) __gnat_error_handler;
1691 act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
1692 (void) sigemptyset (&act.sa_mask);
1693
1694 (void) sigaction (SIGILL, &act, NULL);
1695 (void) sigaction (SIGFPE, &act, NULL);
1696 (void) sigaction (SIGSEGV, &act, NULL);
1697 (void) sigaction (SIGBUS, &act, NULL);
1698
1699 __gnat_handler_installed = 1;
1700 }
1701
1702 /*************************************/
1703 /* VxWorks Section (including Vx653) */
1704 /*************************************/
1705
1706 #elif defined(__vxworks)
1707
1708 #include <signal.h>
1709 #include <taskLib.h>
1710 #if defined (__i386__) && !defined (VTHREADS)
1711 #include <sysLib.h>
1712 #endif
1713
1714 #ifndef __RTP__
1715 #include <intLib.h>
1716 #include <iv.h>
1717 #endif
1718
1719 #if defined (ARMEL) && (_WRS_VXWORKS_MAJOR == 6) && !defined(__RTP__)
1720 #include <vmLib.h>
1721 #endif
1722
1723 #ifdef VTHREADS
1724 #include "private/vThreadsP.h"
1725 #endif
1726
1727 #ifndef __RTP__
1728
1729 /* Directly vectored Interrupt routines are not supported when using RTPs. */
1730
1731 extern int __gnat_inum_to_ivec (int);
1732
1733 /* This is needed by the GNAT run time to handle Vxworks interrupts. */
1734 int
1735 __gnat_inum_to_ivec (int num)
1736 {
1737 return (int) INUM_TO_IVEC (num);
1738 }
1739 #endif
1740
1741 #if !defined(__alpha_vxworks) && ((_WRS_VXWORKS_MAJOR != 6) && (_WRS_VXWORKS_MAJOR != 7)) && !defined(__RTP__)
1742
1743 /* getpid is used by s-parint.adb, but is not defined by VxWorks, except
1744 on Alpha VxWorks and VxWorks 6.x (including RTPs). */
1745
1746 extern long getpid (void);
1747
1748 long
1749 getpid (void)
1750 {
1751 return taskIdSelf ();
1752 }
1753 #endif
1754
1755 /* VxWorks 653 vThreads expects the field excCnt to be zeroed when a signal is.
1756 handled. The VxWorks version of longjmp does this; GCC's builtin_longjmp
1757 doesn't. */
1758 void
1759 __gnat_clear_exception_count (void)
1760 {
1761 #ifdef VTHREADS
1762 WIND_TCB *currentTask = (WIND_TCB *) taskIdSelf();
1763
1764 currentTask->vThreads.excCnt = 0;
1765 #endif
1766 }
1767
1768 /* Handle different SIGnal to exception mappings in different VxWorks
1769 versions. */
1770 void
1771 __gnat_map_signal (int sig, siginfo_t *si ATTRIBUTE_UNUSED,
1772 void *sc ATTRIBUTE_UNUSED)
1773 {
1774 struct Exception_Data *exception;
1775 const char *msg;
1776
1777 switch (sig)
1778 {
1779 case SIGFPE:
1780 exception = &constraint_error;
1781 msg = "SIGFPE";
1782 break;
1783 #ifdef VTHREADS
1784 #ifdef __VXWORKSMILS__
1785 case SIGILL:
1786 exception = &storage_error;
1787 msg = "SIGILL: possible stack overflow";
1788 break;
1789 case SIGSEGV:
1790 exception = &storage_error;
1791 msg = "SIGSEGV";
1792 break;
1793 case SIGBUS:
1794 exception = &program_error;
1795 msg = "SIGBUS";
1796 break;
1797 #else
1798 case SIGILL:
1799 exception = &constraint_error;
1800 msg = "Floating point exception or SIGILL";
1801 break;
1802 case SIGSEGV:
1803 exception = &storage_error;
1804 msg = "SIGSEGV";
1805 break;
1806 case SIGBUS:
1807 exception = &storage_error;
1808 msg = "SIGBUS: possible stack overflow";
1809 break;
1810 #endif
1811 #elif (_WRS_VXWORKS_MAJOR >= 6)
1812 case SIGILL:
1813 exception = &constraint_error;
1814 msg = "SIGILL";
1815 break;
1816 #ifdef __RTP__
1817 /* In RTP mode a SIGSEGV is most likely due to a stack overflow,
1818 since stack checking uses the probing mechanism. */
1819 case SIGSEGV:
1820 exception = &storage_error;
1821 msg = "SIGSEGV: possible stack overflow";
1822 break;
1823 case SIGBUS:
1824 exception = &program_error;
1825 msg = "SIGBUS";
1826 break;
1827 #else
1828 /* VxWorks 6 kernel mode with probing. SIGBUS for guard page hit */
1829 case SIGSEGV:
1830 exception = &storage_error;
1831 msg = "SIGSEGV";
1832 break;
1833 case SIGBUS:
1834 exception = &storage_error;
1835 msg = "SIGBUS: possible stack overflow";
1836 break;
1837 #endif
1838 #else
1839 /* VxWorks 5: a SIGILL is most likely due to a stack overflow,
1840 since stack checking uses the stack limit mechanism. */
1841 case SIGILL:
1842 exception = &storage_error;
1843 msg = "SIGILL: possible stack overflow";
1844 break;
1845 case SIGSEGV:
1846 exception = &storage_error;
1847 msg = "SIGSEGV";
1848 break;
1849 case SIGBUS:
1850 exception = &program_error;
1851 msg = "SIGBUS";
1852 break;
1853 #endif
1854 default:
1855 exception = &program_error;
1856 msg = "unhandled signal";
1857 }
1858
1859 /* On ARM VxWorks 6.x, the guard page is left un-armed by the kernel
1860 after being violated, so subsequent violations aren't detected.
1861 so we retrieve the address of the guard page from the TCB and compare it
1862 with the page that is violated (pREG 12 in the context) and re-arm that
1863 page if there's a match. Additionally we're are assured this is a
1864 genuine stack overflow condition and and set the message and exception
1865 to that effect. */
1866 #if defined (ARMEL) && (_WRS_VXWORKS_MAJOR == 6) && !defined(__RTP__)
1867
1868 /* We re-arm the guard page by marking it invalid */
1869
1870 #define PAGE_SIZE 4096
1871 #define REG_IP 12
1872
1873 if (sig == SIGSEGV || sig == SIGBUS || sig == SIGILL)
1874 {
1875 TASK_ID tid = taskIdSelf ();
1876 WIND_TCB *pTcb = taskTcb (tid);
1877 unsigned long violated_page
1878 = ((struct sigcontext *) sc)->sc_pregs->r[REG_IP] & ~(PAGE_SIZE - 1);
1879
1880 if ((unsigned long) (pTcb->pStackEnd - PAGE_SIZE) == violated_page)
1881 {
1882 vmStateSet (NULL, violated_page,
1883 PAGE_SIZE, VM_STATE_MASK_VALID, VM_STATE_VALID_NOT);
1884 exception = &storage_error;
1885
1886 switch (sig)
1887 {
1888 case SIGSEGV:
1889 msg = "SIGSEGV: stack overflow";
1890 break;
1891 case SIGBUS:
1892 msg = "SIGBUS: stack overflow";
1893 break;
1894 case SIGILL:
1895 msg = "SIGILL: stack overflow";
1896 break;
1897 }
1898 }
1899 }
1900 #endif /* defined (ARMEL) && (_WRS_VXWORKS_MAJOR == 6) && !defined(__RTP__) */
1901
1902 __gnat_clear_exception_count ();
1903 Raise_From_Signal_Handler (exception, msg);
1904 }
1905
1906 #if defined (__i386__) && !defined (VTHREADS) && _WRS_VXWORKS_MAJOR < 7
1907
1908 extern void
1909 __gnat_vxsim_error_handler (int sig, siginfo_t *si, void *sc);
1910
1911 static int is_vxsim = 0;
1912 #endif
1913
1914 /* Tasking and Non-tasking signal handler. Map SIGnal to Ada exception
1915 propagation after the required low level adjustments. */
1916
1917 static void
1918 __gnat_error_handler (int sig, siginfo_t *si, void *sc)
1919 {
1920 sigset_t mask;
1921
1922 /* VxWorks 7 on e500v2 clears the SPE bit of the MSR when entering CPU
1923 exception state. To allow the handler and exception to work properly
1924 when they contain SPE instructions, we need to set it back before doing
1925 anything else. */
1926 #if (CPU == PPCE500V2) && (_WRS_VXWORKS_MAJOR == 7)
1927 register unsigned msr;
1928 /* Read the MSR value */
1929 asm volatile ("mfmsr %0" : "=r" (msr));
1930 /* Force the SPE bit */
1931 msr |= 0x02000000;
1932 /* Store to MSR */
1933 asm volatile ("mtmsr %0" : : "r" (msr));
1934 #endif
1935
1936 /* VxWorks will always mask out the signal during the signal handler and
1937 will reenable it on a longjmp. GNAT does not generate a longjmp to
1938 return from a signal handler so the signal will still be masked unless
1939 we unmask it. */
1940 sigprocmask (SIG_SETMASK, NULL, &mask);
1941 sigdelset (&mask, sig);
1942 sigprocmask (SIG_SETMASK, &mask, NULL);
1943
1944 #if defined (__ARMEL__) || defined (__PPC__) || (defined (__i386__) && _WRS_VXWORKS_MAJOR < 7)
1945 /* On certain targets, kernel mode, we process signals through a Call Frame
1946 Info trampoline, voiding the need for myriads of fallback_frame_state
1947 variants in the ZCX runtime. We have no simple way to distinguish ZCX
1948 from SJLJ here, so we do this for SJLJ as well even though this is not
1949 necessary. This only incurs a few extra instructions and a tiny
1950 amount of extra stack usage. */
1951
1952 #if defined (__i386__) && !defined (VTHREADS)
1953 /* On x86, the vxsim signal context is subtly different and is processeed
1954 by a handler compiled especially for vxsim. */
1955
1956 if (is_vxsim)
1957 __gnat_vxsim_error_handler (sig, si, sc);
1958 #endif
1959
1960 #include "sigtramp.h"
1961
1962 __gnat_sigtramp (sig, (void *)si, (void *)sc,
1963 (__sigtramphandler_t *)&__gnat_map_signal);
1964
1965 #else
1966 __gnat_map_signal (sig, si, sc);
1967 #endif
1968 }
1969
1970 #if defined(__leon__) && defined(_WRS_KERNEL)
1971 /* For LEON VxWorks we need to install a trap handler for stack overflow */
1972
1973 extern void excEnt (void);
1974 /* VxWorks exception handler entry */
1975
1976 struct trap_entry {
1977 unsigned long inst_first;
1978 unsigned long inst_second;
1979 unsigned long inst_third;
1980 unsigned long inst_fourth;
1981 };
1982 /* Four instructions representing entries in the trap table */
1983
1984 struct trap_entry *trap_0_entry;
1985 /* We will set the location of the entry for software trap 0 in the trap
1986 table. */
1987 #endif
1988
1989 void
1990 __gnat_install_handler (void)
1991 {
1992 struct sigaction act;
1993 char *model ATTRIBUTE_UNUSED;
1994
1995 /* Setup signal handler to map synchronous signals to appropriate
1996 exceptions. Make sure that the handler isn't interrupted by another
1997 signal that might cause a scheduling event! */
1998
1999 act.sa_sigaction = __gnat_error_handler;
2000 act.sa_flags = SA_SIGINFO | SA_ONSTACK;
2001 sigemptyset (&act.sa_mask);
2002
2003 /* For VxWorks, install all signal handlers, since pragma Interrupt_State
2004 applies to vectored hardware interrupts, not signals. */
2005 sigaction (SIGFPE, &act, NULL);
2006 sigaction (SIGILL, &act, NULL);
2007 sigaction (SIGSEGV, &act, NULL);
2008 sigaction (SIGBUS, &act, NULL);
2009
2010 #if defined(__leon__) && defined(_WRS_KERNEL)
2011 /* Specific to the LEON VxWorks kernel run-time library */
2012
2013 /* For stack checking the compiler triggers a software trap 0 (ta 0) in
2014 case of overflow (we use the stack limit mechanism). We need to install
2015 the trap handler here for this software trap (the OS does not handle
2016 it) as if it were a data_access_exception (trap 9). We do the same as
2017 if we put in the trap table a VXSPARC_BAD_TRAP(9). Software trap 0 is
2018 located at vector 0x80, and each entry takes 4 words. */
2019
2020 trap_0_entry = (struct trap_entry *)(intVecBaseGet () + 0x80 * 4);
2021
2022 /* mov 0x9, %l7 */
2023
2024 trap_0_entry->inst_first = 0xae102000 + 9;
2025
2026 /* sethi %hi(excEnt), %l6 */
2027
2028 /* The 22 most significant bits of excEnt are obtained shifting 10 times
2029 to the right. */
2030
2031 trap_0_entry->inst_second = 0x2d000000 + ((unsigned long)excEnt >> 10);
2032
2033 /* jmp %l6+%lo(excEnt) */
2034
2035 /* The 10 least significant bits of excEnt are obtained by masking */
2036
2037 trap_0_entry->inst_third = 0x81c5a000 + ((unsigned long)excEnt & 0x3ff);
2038
2039 /* rd %psr, %l0 */
2040
2041 trap_0_entry->inst_fourth = 0xa1480000;
2042 #endif
2043
2044 #if defined (__i386__) && !defined (VTHREADS) && _WRS_VXWORKS_MAJOR != 7
2045 /* By experiment, found that sysModel () returns the following string
2046 prefix for vxsim when running on Linux and Windows. */
2047 model = sysModel ();
2048 if ((strncmp (model, "Linux", 5) == 0)
2049 || (strncmp (model, "Windows", 7) == 0))
2050 is_vxsim = 1;
2051 #endif
2052
2053 __gnat_handler_installed = 1;
2054 }
2055
2056 #define HAVE_GNAT_INIT_FLOAT
2057
2058 void
2059 __gnat_init_float (void)
2060 {
2061 /* Disable overflow/underflow exceptions on the PPC processor, needed
2062 to get correct Ada semantics. Note that for AE653 vThreads, the HW
2063 overflow settings are an OS configuration issue. The instructions
2064 below have no effect. */
2065 #if defined (_ARCH_PPC) && !defined (_SOFT_FLOAT) && (!defined (VTHREADS) || defined (__VXWORKSMILS__))
2066 #if defined (__SPE__)
2067 {
2068 /* For e500v2, do nothing and leave the responsibility to install the
2069 handler and enable the exceptions to the BSP. */
2070 }
2071 #else
2072 asm ("mtfsb0 25");
2073 asm ("mtfsb0 26");
2074 #endif
2075 #endif
2076
2077 #if defined (__i386__) && !defined (VTHREADS)
2078 /* This is used to properly initialize the FPU on an x86 for each
2079 process thread. */
2080 asm ("finit");
2081 #endif
2082
2083 /* Similarly for SPARC64. Achieved by masking bits in the Trap Enable Mask
2084 field of the Floating-point Status Register (see the SPARC Architecture
2085 Manual Version 9, p 48). */
2086 #if defined (sparc64)
2087
2088 #define FSR_TEM_NVM (1 << 27) /* Invalid operand */
2089 #define FSR_TEM_OFM (1 << 26) /* Overflow */
2090 #define FSR_TEM_UFM (1 << 25) /* Underflow */
2091 #define FSR_TEM_DZM (1 << 24) /* Division by Zero */
2092 #define FSR_TEM_NXM (1 << 23) /* Inexact result */
2093 {
2094 unsigned int fsr;
2095
2096 __asm__("st %%fsr, %0" : "=m" (fsr));
2097 fsr &= ~(FSR_TEM_OFM | FSR_TEM_UFM);
2098 __asm__("ld %0, %%fsr" : : "m" (fsr));
2099 }
2100 #endif
2101 }
2102
2103 /* This subprogram is called by System.Task_Primitives.Operations.Enter_Task
2104 (if not null) when a new task is created. It is initialized by
2105 System.Stack_Checking.Operations.Initialize_Stack_Limit.
2106 The use of a hook avoids to drag stack checking subprograms if stack
2107 checking is not used. */
2108 void (*__gnat_set_stack_limit_hook)(void) = (void (*)(void))0;
2109
2110 /******************/
2111 /* NetBSD Section */
2112 /******************/
2113
2114 #elif defined(__NetBSD__)
2115
2116 #include <signal.h>
2117 #include <unistd.h>
2118
2119 static void
2120 __gnat_error_handler (int sig)
2121 {
2122 struct Exception_Data *exception;
2123 const char *msg;
2124
2125 switch(sig)
2126 {
2127 case SIGFPE:
2128 exception = &constraint_error;
2129 msg = "SIGFPE";
2130 break;
2131 case SIGILL:
2132 exception = &constraint_error;
2133 msg = "SIGILL";
2134 break;
2135 case SIGSEGV:
2136 exception = &storage_error;
2137 msg = "stack overflow or erroneous memory access";
2138 break;
2139 case SIGBUS:
2140 exception = &constraint_error;
2141 msg = "SIGBUS";
2142 break;
2143 default:
2144 exception = &program_error;
2145 msg = "unhandled signal";
2146 }
2147
2148 Raise_From_Signal_Handler (exception, msg);
2149 }
2150
2151 void
2152 __gnat_install_handler(void)
2153 {
2154 struct sigaction act;
2155
2156 act.sa_handler = __gnat_error_handler;
2157 act.sa_flags = SA_NODEFER | SA_RESTART;
2158 sigemptyset (&act.sa_mask);
2159
2160 /* Do not install handlers if interrupt state is "System". */
2161 if (__gnat_get_interrupt_state (SIGFPE) != 's')
2162 sigaction (SIGFPE, &act, NULL);
2163 if (__gnat_get_interrupt_state (SIGILL) != 's')
2164 sigaction (SIGILL, &act, NULL);
2165 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
2166 sigaction (SIGSEGV, &act, NULL);
2167 if (__gnat_get_interrupt_state (SIGBUS) != 's')
2168 sigaction (SIGBUS, &act, NULL);
2169
2170 __gnat_handler_installed = 1;
2171 }
2172
2173 /*******************/
2174 /* OpenBSD Section */
2175 /*******************/
2176
2177 #elif defined(__OpenBSD__)
2178
2179 #include <signal.h>
2180 #include <unistd.h>
2181
2182 static void
2183 __gnat_error_handler (int sig)
2184 {
2185 struct Exception_Data *exception;
2186 const char *msg;
2187
2188 switch(sig)
2189 {
2190 case SIGFPE:
2191 exception = &constraint_error;
2192 msg = "SIGFPE";
2193 break;
2194 case SIGILL:
2195 exception = &constraint_error;
2196 msg = "SIGILL";
2197 break;
2198 case SIGSEGV:
2199 exception = &storage_error;
2200 msg = "stack overflow or erroneous memory access";
2201 break;
2202 case SIGBUS:
2203 exception = &constraint_error;
2204 msg = "SIGBUS";
2205 break;
2206 default:
2207 exception = &program_error;
2208 msg = "unhandled signal";
2209 }
2210
2211 Raise_From_Signal_Handler (exception, msg);
2212 }
2213
2214 void
2215 __gnat_install_handler(void)
2216 {
2217 struct sigaction act;
2218
2219 act.sa_handler = __gnat_error_handler;
2220 act.sa_flags = SA_NODEFER | SA_RESTART;
2221 sigemptyset (&act.sa_mask);
2222
2223 /* Do not install handlers if interrupt state is "System" */
2224 if (__gnat_get_interrupt_state (SIGFPE) != 's')
2225 sigaction (SIGFPE, &act, NULL);
2226 if (__gnat_get_interrupt_state (SIGILL) != 's')
2227 sigaction (SIGILL, &act, NULL);
2228 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
2229 sigaction (SIGSEGV, &act, NULL);
2230 if (__gnat_get_interrupt_state (SIGBUS) != 's')
2231 sigaction (SIGBUS, &act, NULL);
2232
2233 __gnat_handler_installed = 1;
2234 }
2235
2236 /******************/
2237 /* Darwin Section */
2238 /******************/
2239
2240 #elif defined(__APPLE__)
2241
2242 #include <signal.h>
2243 #include <stdlib.h>
2244 #include <sys/syscall.h>
2245 #include <sys/sysctl.h>
2246
2247 /* This must be in keeping with System.OS_Interface.Alternate_Stack_Size. */
2248 char __gnat_alternate_stack[32 * 1024]; /* 1 * MINSIGSTKSZ */
2249
2250 /* Defined in xnu unix_signal.c.
2251 Tell the kernel to re-use alt stack when delivering a signal. */
2252 #define UC_RESET_ALT_STACK 0x80000000
2253
2254 #if !(defined (__arm__) || defined (__arm64__))
2255 #include <mach/mach_vm.h>
2256 #include <mach/mach_init.h>
2257 #include <mach/vm_statistics.h>
2258 #endif
2259
2260 #ifdef __arm64__
2261 #include <sys/ucontext.h>
2262
2263 /* Trampoline inserted before raising the exception. It modifies the
2264 stack so that PROC (D, M) looks to be called from the fault point. Note
2265 that LR may be incorrectly set. */
2266 void __gnat_sigtramp (struct Exception_Data *d, const char *m,
2267 mcontext_t ctxt,
2268 void (*proc)(struct Exception_Data *, const char *));
2269
2270 asm("\n"
2271 " .section __TEXT,__text,regular,pure_instructions\n"
2272 " .align 2\n"
2273 "___gnat_sigtramp:\n"
2274 " .cfi_startproc\n"
2275 /* Restore callee saved registers. */
2276 " ldp x19, x20, [x2, #168]\n"
2277 " ldp x21, x22, [x2, #184]\n"
2278 " ldp x23, x24, [x2, #200]\n"
2279 " ldp x25, x26, [x2, #216]\n"
2280 " ldp x27, x28, [x2, #232]\n"
2281 " ldp q8, q9, [x2, #416]\n"
2282 " ldp q10, q11, [x2, #448]\n"
2283 " ldp q12, q13, [x2, #480]\n"
2284 " ldp q14, q15, [x2, #512]\n"
2285 /* Read FP from mcontext. */
2286 " ldp fp, lr, [x2, #248]\n"
2287 /* Read SP and PC from mcontext. */
2288 " ldp x6, x7, [x2, #264]\n"
2289 " add lr, x7, #1\n"
2290 " mov sp, x6\n"
2291 /* Create a standard frame. */
2292 " stp fp, lr, [sp, #-16]!\n"
2293 " .cfi_def_cfa w29, 16\n"
2294 " .cfi_offset w30, -8\n"
2295 " .cfi_offset w29, -16\n"
2296 " br x3\n"
2297 " .cfi_endproc\n"
2298 );
2299 #endif
2300
2301 /* Return true if ADDR is within a stack guard area. */
2302 static int
2303 __gnat_is_stack_guard (mach_vm_address_t addr)
2304 {
2305 #if !(defined (__arm__) || defined (__arm64__))
2306 kern_return_t kret;
2307 vm_region_submap_info_data_64_t info;
2308 mach_vm_address_t start;
2309 mach_vm_size_t size;
2310 natural_t depth;
2311 mach_msg_type_number_t count;
2312
2313 count = VM_REGION_SUBMAP_INFO_COUNT_64;
2314 start = addr;
2315 size = -1;
2316 depth = 9999;
2317 kret = mach_vm_region_recurse (mach_task_self (), &start, &size, &depth,
2318 (vm_region_recurse_info_t) &info, &count);
2319 if (kret == KERN_SUCCESS
2320 && addr >= start && addr < (start + size)
2321 && info.protection == VM_PROT_NONE
2322 && info.user_tag == VM_MEMORY_STACK)
2323 return 1;
2324 return 0;
2325 #else
2326 /* Pagezero for arm. */
2327 return addr >= 4096;
2328 #endif
2329 }
2330
2331 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
2332
2333 #if defined (__x86_64__)
2334 static int
2335 __darwin_major_version (void)
2336 {
2337 static int cache = -1;
2338 if (cache < 0)
2339 {
2340 int mib[2] = {CTL_KERN, KERN_OSRELEASE};
2341 size_t len;
2342
2343 /* Find out how big the buffer needs to be (and set cache to 0
2344 on failure). */
2345 if (sysctl (mib, 2, NULL, &len, NULL, 0) == 0)
2346 {
2347 char release[len];
2348 sysctl (mib, 2, release, &len, NULL, 0);
2349 /* Darwin releases are of the form L.M.N where L is the major
2350 version, so strtol will return L. */
2351 cache = (int) strtol (release, NULL, 10);
2352 }
2353 else
2354 {
2355 cache = 0;
2356 }
2357 }
2358 return cache;
2359 }
2360 #endif
2361
2362 void
2363 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED,
2364 void *ucontext ATTRIBUTE_UNUSED)
2365 {
2366 #if defined (__x86_64__)
2367 if (__darwin_major_version () < 12)
2368 {
2369 /* Work around radar #10302855, where the unwinders (libunwind or
2370 libgcc_s depending on the system revision) and the DWARF unwind
2371 data for sigtramp have different ideas about register numbering,
2372 causing rbx and rdx to be transposed. */
2373 ucontext_t *uc = (ucontext_t *)ucontext;
2374 unsigned long t = uc->uc_mcontext->__ss.__rbx;
2375
2376 uc->uc_mcontext->__ss.__rbx = uc->uc_mcontext->__ss.__rdx;
2377 uc->uc_mcontext->__ss.__rdx = t;
2378 }
2379 #endif
2380 }
2381
2382 static void
2383 __gnat_error_handler (int sig, siginfo_t *si, void *ucontext)
2384 {
2385 struct Exception_Data *exception;
2386 const char *msg;
2387
2388 __gnat_adjust_context_for_raise (sig, ucontext);
2389
2390 switch (sig)
2391 {
2392 case SIGSEGV:
2393 case SIGBUS:
2394 if (__gnat_is_stack_guard ((unsigned long)si->si_addr))
2395 {
2396 exception = &storage_error;
2397 msg = "stack overflow";
2398 }
2399 else
2400 {
2401 exception = &constraint_error;
2402 msg = "erroneous memory access";
2403 }
2404 /* Reset the use of alt stack, so that the alt stack will be used
2405 for the next signal delivery.
2406 The stack can't be used in case of stack checking. */
2407 syscall (SYS_sigreturn, NULL, UC_RESET_ALT_STACK);
2408
2409 #ifdef __arm64__
2410 /* On arm64, use a trampoline so that the unwinder won't see the
2411 signal frame. */
2412 __gnat_sigtramp (exception, msg,
2413 ((ucontext_t *)ucontext)->uc_mcontext,
2414 Raise_From_Signal_Handler);
2415 return;
2416 #endif
2417 break;
2418
2419 case SIGFPE:
2420 exception = &constraint_error;
2421 msg = "SIGFPE";
2422 break;
2423
2424 default:
2425 exception = &program_error;
2426 msg = "unhandled signal";
2427 }
2428
2429 Raise_From_Signal_Handler (exception, msg);
2430 }
2431
2432 void
2433 __gnat_install_handler (void)
2434 {
2435 struct sigaction act;
2436
2437 /* Set up signal handler to map synchronous signals to appropriate
2438 exceptions. Make sure that the handler isn't interrupted by another
2439 signal that might cause a scheduling event! Also setup an alternate
2440 stack region for the handler execution so that stack overflows can be
2441 handled properly, avoiding a SEGV generation from stack usage by the
2442 handler itself (and it is required by Darwin). */
2443
2444 stack_t stack;
2445 stack.ss_sp = __gnat_alternate_stack;
2446 stack.ss_size = sizeof (__gnat_alternate_stack);
2447 stack.ss_flags = 0;
2448 sigaltstack (&stack, NULL);
2449
2450 act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
2451 act.sa_sigaction = __gnat_error_handler;
2452 sigemptyset (&act.sa_mask);
2453
2454 /* Do not install handlers if interrupt state is "System". */
2455 if (__gnat_get_interrupt_state (SIGABRT) != 's')
2456 sigaction (SIGABRT, &act, NULL);
2457 if (__gnat_get_interrupt_state (SIGFPE) != 's')
2458 sigaction (SIGFPE, &act, NULL);
2459 if (__gnat_get_interrupt_state (SIGILL) != 's')
2460 sigaction (SIGILL, &act, NULL);
2461
2462 act.sa_flags |= SA_ONSTACK;
2463 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
2464 sigaction (SIGSEGV, &act, NULL);
2465 if (__gnat_get_interrupt_state (SIGBUS) != 's')
2466 sigaction (SIGBUS, &act, NULL);
2467
2468 __gnat_handler_installed = 1;
2469 }
2470
2471 #elif defined(__ANDROID__)
2472
2473 /*******************/
2474 /* Android Section */
2475 /*******************/
2476
2477 #include <signal.h>
2478 #include "sigtramp.h"
2479
2480 #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
2481
2482 void
2483 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
2484 {
2485 mcontext_t *mcontext = &((ucontext_t *) ucontext)->uc_mcontext;
2486
2487 /* ARM Bump has to be an even number because of odd/even architecture. */
2488 ((mcontext_t *) mcontext)->arm_pc += 2;
2489 }
2490
2491 static void
2492 __gnat_map_signal (int sig,
2493 siginfo_t *si ATTRIBUTE_UNUSED,
2494 void *ucontext ATTRIBUTE_UNUSED)
2495 {
2496 struct Exception_Data *exception;
2497 const char *msg;
2498
2499 switch (sig)
2500 {
2501 case SIGSEGV:
2502 exception = &storage_error;
2503 msg = "stack overflow or erroneous memory access";
2504 break;
2505
2506 case SIGBUS:
2507 exception = &constraint_error;
2508 msg = "SIGBUS";
2509 break;
2510
2511 case SIGFPE:
2512 exception = &constraint_error;
2513 msg = "SIGFPE";
2514 break;
2515
2516 default:
2517 exception = &program_error;
2518 msg = "unhandled signal";
2519 }
2520
2521 Raise_From_Signal_Handler (exception, msg);
2522 }
2523
2524 static void
2525 __gnat_error_handler (int sig,
2526 siginfo_t *si ATTRIBUTE_UNUSED,
2527 void *ucontext ATTRIBUTE_UNUSED)
2528 {
2529 __gnat_adjust_context_for_raise (sig, ucontext);
2530
2531 __gnat_sigtramp (sig, (void *) si, (void *) ucontext,
2532 (__sigtramphandler_t *)&__gnat_map_signal);
2533 }
2534
2535 /* This must be in keeping with System.OS_Interface.Alternate_Stack_Size. */
2536 char __gnat_alternate_stack[16 * 1024];
2537
2538 void
2539 __gnat_install_handler (void)
2540 {
2541 struct sigaction act;
2542
2543 /* Set up signal handler to map synchronous signals to appropriate
2544 exceptions. Make sure that the handler isn't interrupted by another
2545 signal that might cause a scheduling event! Also setup an alternate
2546 stack region for the handler execution so that stack overflows can be
2547 handled properly, avoiding a SEGV generation from stack usage by the
2548 handler itself. */
2549
2550 stack_t stack;
2551 stack.ss_sp = __gnat_alternate_stack;
2552 stack.ss_size = sizeof (__gnat_alternate_stack);
2553 stack.ss_flags = 0;
2554 sigaltstack (&stack, NULL);
2555
2556 act.sa_sigaction = __gnat_error_handler;
2557 act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
2558 sigemptyset (&act.sa_mask);
2559
2560 sigaction (SIGABRT, &act, NULL);
2561 sigaction (SIGFPE, &act, NULL);
2562 sigaction (SIGILL, &act, NULL);
2563 sigaction (SIGBUS, &act, NULL);
2564 act.sa_flags |= SA_ONSTACK;
2565 sigaction (SIGSEGV, &act, NULL);
2566
2567 __gnat_handler_installed = 1;
2568 }
2569
2570 #else
2571
2572 /* For all other versions of GNAT, the handler does nothing. */
2573
2574 /*******************/
2575 /* Default Section */
2576 /*******************/
2577
2578 void
2579 __gnat_install_handler (void)
2580 {
2581 __gnat_handler_installed = 1;
2582 }
2583
2584 #endif
2585
2586 /*********************/
2587 /* __gnat_init_float */
2588 /*********************/
2589
2590 /* This routine is called as each process thread is created, for possible
2591 initialization of the FP processor. This version is used under INTERIX
2592 and WIN32. */
2593
2594 #if defined (_WIN32) || defined (__INTERIX) \
2595 || defined (__Lynx__) || defined(__NetBSD__) || defined(__FreeBSD__) \
2596 || defined (__OpenBSD__) || defined (__DragonFly__)
2597
2598 #define HAVE_GNAT_INIT_FLOAT
2599
2600 void
2601 __gnat_init_float (void)
2602 {
2603 #if defined (__i386__) || defined (__x86_64__)
2604
2605 /* This is used to properly initialize the FPU on an x86 for each
2606 process thread. */
2607
2608 asm ("finit");
2609
2610 #endif /* Defined __i386__ */
2611 }
2612 #endif
2613
2614 #ifndef HAVE_GNAT_INIT_FLOAT
2615
2616 /* All targets without a specific __gnat_init_float will use an empty one. */
2617 void
2618 __gnat_init_float (void)
2619 {
2620 }
2621 #endif
2622
2623 /***********************************/
2624 /* __gnat_adjust_context_for_raise */
2625 /***********************************/
2626
2627 #ifndef HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
2628
2629 /* All targets without a specific version will use an empty one. */
2630
2631 /* Given UCONTEXT a pointer to a context structure received by a signal
2632 handler for SIGNO, perform the necessary adjustments to let the handler
2633 raise an exception. Calls to this routine are not conditioned by the
2634 propagation scheme in use. */
2635
2636 void
2637 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED,
2638 void *ucontext ATTRIBUTE_UNUSED)
2639 {
2640 /* We used to compensate here for the raised from call vs raised from signal
2641 exception discrepancy with the GCC ZCX scheme, but this now can be dealt
2642 with generically in the unwinder (see GCC PR other/26208). This however
2643 requires the use of the _Unwind_GetIPInfo routine in raise-gcc.c, which
2644 is predicated on the definition of HAVE_GETIPINFO at compile time. Only
2645 the VMS ports still do the compensation described in the few lines below.
2646
2647 *** Call vs signal exception discrepancy with GCC ZCX scheme ***
2648
2649 The GCC unwinder expects to be dealing with call return addresses, since
2650 this is the "nominal" case of what we retrieve while unwinding a regular
2651 call chain.
2652
2653 To evaluate if a handler applies at some point identified by a return
2654 address, the propagation engine needs to determine what region the
2655 corresponding call instruction pertains to. Because the return address
2656 may not be attached to the same region as the call, the unwinder always
2657 subtracts "some" amount from a return address to search the region
2658 tables, amount chosen to ensure that the resulting address is inside the
2659 call instruction.
2660
2661 When we raise an exception from a signal handler, e.g. to transform a
2662 SIGSEGV into Storage_Error, things need to appear as if the signal
2663 handler had been "called" by the instruction which triggered the signal,
2664 so that exception handlers that apply there are considered. What the
2665 unwinder will retrieve as the return address from the signal handler is
2666 what it will find as the faulting instruction address in the signal
2667 context pushed by the kernel. Leaving this address untouched looses, if
2668 the triggering instruction happens to be the very first of a region, as
2669 the later adjustments performed by the unwinder would yield an address
2670 outside that region. We need to compensate for the unwinder adjustments
2671 at some point, and this is what this routine is expected to do.
2672
2673 signo is passed because on some targets for some signals the PC in
2674 context points to the instruction after the faulting one, in which case
2675 the unwinder adjustment is still desired. */
2676 }
2677
2678 #endif
2679
2680 #ifdef __cplusplus
2681 }
2682 #endif
Mirror of the offical gcc git repository hosted at gcc.gnu.org