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