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