projects / gcc.git / blob
? search:


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