projects / gcc.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
[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-2004 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, 59 Temple Place - Suite 330, Boston, *
20 * MA 02111-1307, 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. A
34 major part of the functionality involved 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 handle resulting signals that come
40 from these probes failing (i.e. touching protected pages) */
41
42 /* This file should be kept synchronized with 2sinit.ads, 2sinit.adb, and
43 5zinit.adb. All these files implement the required functionality for
44 different targets. */
45
46 /* The following include is here to meet the published VxWorks requirement
47 that the __vxworks header appear before any other include. */
48 #ifdef __vxworks
49 #include "vxWorks.h"
50 #endif
51
52 #ifdef IN_RTS
53 #include "tconfig.h"
54 #include "tsystem.h"
55 #include <sys/stat.h>
56
57 /* We don't have libiberty, so us malloc. */
58 #define xmalloc(S) malloc (S)
59 #else
60 #include "config.h"
61 #include "system.h"
62 #endif
63
64 #include "adaint.h"
65 #include "raise.h"
66
67 extern void __gnat_raise_program_error (const char *, int);
68
69 /* Addresses of exception data blocks for predefined exceptions. */
70 extern struct Exception_Data constraint_error;
71 extern struct Exception_Data numeric_error;
72 extern struct Exception_Data program_error;
73 extern struct Exception_Data storage_error;
74 extern struct Exception_Data tasking_error;
75 extern struct Exception_Data _abort_signal;
76
77 #define Lock_Task system__soft_links__lock_task
78 extern void (*Lock_Task) (void);
79
80 #define Unlock_Task system__soft_links__unlock_task
81 extern void (*Unlock_Task) (void);
82
83 #define Get_Machine_State_Addr \
84 system__soft_links__get_machine_state_addr
85 extern struct Machine_State *(*Get_Machine_State_Addr) (void);
86
87 #define Check_Abort_Status \
88 system__soft_links__check_abort_status
89 extern int (*Check_Abort_Status) (void);
90
91 #define Raise_From_Signal_Handler \
92 ada__exceptions__raise_from_signal_handler
93 extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *);
94
95 #define Propagate_Signal_Exception \
96 __gnat_propagate_sig_exc
97 extern void Propagate_Signal_Exception (struct Machine_State *,
98 struct Exception_Data *,
99 const char *);
100
101 /* Copies of global values computed by the binder */
102 int __gl_main_priority = -1;
103 int __gl_time_slice_val = -1;
104 char __gl_wc_encoding = 'n';
105 char __gl_locking_policy = ' ';
106 char __gl_queuing_policy = ' ';
107 char __gl_task_dispatching_policy = ' ';
108 char *__gl_restrictions = 0;
109 char *__gl_interrupt_states = 0;
110 int __gl_num_interrupt_states = 0;
111 int __gl_unreserve_all_interrupts = 0;
112 int __gl_exception_tracebacks = 0;
113 int __gl_zero_cost_exceptions = 0;
114
115 /* Indication of whether synchronous signal handler has already been
116 installed by a previous call to adainit */
117 int __gnat_handler_installed = 0;
118
119 /* HAVE_GNAT_INIT_FLOAT must be set on every targets where a __gnat_init_float
120 is defined. If this is not set them a void implementation will be defined
121 at the end of this unit. */
122 #undef HAVE_GNAT_INIT_FLOAT
123
124 /******************************/
125 /* __gnat_get_interrupt_state */
126 /******************************/
127
128 char __gnat_get_interrupt_state (int);
129
130 /* This routine is called from the runtime as needed to determine the state
131 of an interrupt, as set by an Interrupt_State pragma appearing anywhere
132 in the current partition. The input argument is the interrupt number,
133 and the result is one of the following:
134
135 'n' this interrupt not set by any Interrupt_State pragma
136 'u' Interrupt_State pragma set state to User
137 'r' Interrupt_State pragma set state to Runtime
138 's' Interrupt_State pragma set state to System */
139
140 char
141 __gnat_get_interrupt_state (int intrup)
142 {
143 if (intrup >= __gl_num_interrupt_states)
144 return 'n';
145 else
146 return __gl_interrupt_states [intrup];
147 }
148
149 /**********************/
150 /* __gnat_set_globals */
151 /**********************/
152
153 /* This routine is called from the binder generated main program. It copies
154 the values for global quantities computed by the binder into the following
155 global locations. The reason that we go through this copy, rather than just
156 define the global locations in the binder generated file, is that they are
157 referenced from the runtime, which may be in a shared library, and the
158 binder file is not in the shared library. Global references across library
159 boundaries like this are not handled correctly in all systems. */
160
161 /* For detailed description of the parameters to this routine, see the
162 section titled Run-Time Globals in package Bindgen (bindgen.adb) */
163
164 void
165 __gnat_set_globals (int main_priority,
166 int time_slice_val,
167 char wc_encoding,
168 char locking_policy,
169 char queuing_policy,
170 char task_dispatching_policy,
171 char *restrictions,
172 char *interrupt_states,
173 int num_interrupt_states,
174 int unreserve_all_interrupts,
175 int exception_tracebacks,
176 int zero_cost_exceptions)
177 {
178 static int already_called = 0;
179
180 /* If this procedure has been already called once, check that the
181 arguments in this call are consistent with the ones in the previous
182 calls. Otherwise, raise a Program_Error exception.
183
184 We do not check for consistency of the wide character encoding
185 method. This default affects only Wide_Text_IO where no explicit
186 coding method is given, and there is no particular reason to let
187 this default be affected by the source representation of a library
188 in any case.
189
190 We do not check either for the consistency of exception tracebacks,
191 because exception tracebacks are not normally set in Stand-Alone
192 libraries. If a library or the main program set the exception
193 tracebacks, then they are never reset afterwards (see below).
194
195 The value of main_priority is meaningful only when we are invoked
196 from the main program elaboration routine of an Ada application.
197 Checking the consistency of this parameter should therefore not be
198 done. Since it is assured that the main program elaboration will
199 always invoke this procedure before any library elaboration
200 routine, only the value of main_priority during the first call
201 should be taken into account and all the subsequent ones should be
202 ignored. Note that the case where the main program is not written
203 in Ada is also properly handled, since the default value will then
204 be used for this parameter.
205
206 For identical reasons, the consistency of time_slice_val should not
207 be checked. */
208
209 if (already_called)
210 {
211 if (__gl_locking_policy != locking_policy
212 || __gl_queuing_policy != queuing_policy
213 || __gl_task_dispatching_policy != task_dispatching_policy
214 || __gl_unreserve_all_interrupts != unreserve_all_interrupts
215 || __gl_zero_cost_exceptions != zero_cost_exceptions)
216 __gnat_raise_program_error (__FILE__, __LINE__);
217
218 /* If either a library or the main program set the exception traceback
219 flag, it is never reset later */
220
221 if (exception_tracebacks != 0)
222 __gl_exception_tracebacks = exception_tracebacks;
223
224 return;
225 }
226 already_called = 1;
227
228 __gl_main_priority = main_priority;
229 __gl_time_slice_val = time_slice_val;
230 __gl_wc_encoding = wc_encoding;
231 __gl_locking_policy = locking_policy;
232 __gl_queuing_policy = queuing_policy;
233 __gl_restrictions = restrictions;
234 __gl_interrupt_states = interrupt_states;
235 __gl_num_interrupt_states = num_interrupt_states;
236 __gl_task_dispatching_policy = task_dispatching_policy;
237 __gl_unreserve_all_interrupts = unreserve_all_interrupts;
238 __gl_exception_tracebacks = exception_tracebacks;
239
240 /* ??? __gl_zero_cost_exceptions is new in 3.15 and is referenced from
241 a-except.adb, which is also part of the compiler sources. Since the
242 compiler is built with an older release of GNAT, the call generated by
243 the old binder to this function does not provide any value for the
244 corresponding argument, so the global has to be initialized in some
245 reasonable other way. This could be removed as soon as the next major
246 release is out. */
247
248 #ifdef IN_RTS
249 __gl_zero_cost_exceptions = zero_cost_exceptions;
250 #else
251 __gl_zero_cost_exceptions = 0;
252 /* We never build the compiler to run in ZCX mode currently anyway. */
253 #endif
254 }
255
256 /*********************/
257 /* __gnat_initialize */
258 /*********************/
259
260 /* __gnat_initialize is called at the start of execution of an Ada program
261 (the call is generated by the binder). The standard routine does nothing
262 at all; the intention is that this be replaced by system specific
263 code where initialization is required. */
264
265 /* Notes on the Zero Cost Exceptions scheme and its impact on the signal
266 handlers implemented below :
267
268 What we call Zero Cost Exceptions is implemented using the GCC eh
269 circuitry, even if the underlying implementation is setjmp/longjmp
270 based. In any case ...
271
272 The GCC unwinder expects to be dealing with call return addresses, since
273 this is the "nominal" case of what we retrieve while unwinding a regular
274 call chain. To evaluate if a handler applies at some point in this chain,
275 the propagation engine needs to determine what region the corresponding
276 call instruction pertains to. The return address may not be attached to the
277 same region as the call, so the unwinder unconditionally substracts "some"
278 amount to the return addresses it gets to search the region tables. The
279 exact amount is computed to ensure that the resulting address is inside the
280 call instruction, and is thus target dependant (think about delay slots for
281 instance).
282
283 When we raise an exception from a signal handler, e.g. to transform a
284 SIGSEGV into Storage_Error, things need to appear as if the signal handler
285 had been "called" by the instruction which triggered the signal, so that
286 exception handlers that apply there are considered. What the unwinder will
287 retrieve as the return address from the signal handler is what it will find
288 as the faulting instruction address in the corresponding signal context
289 pushed by the kernel. Leaving this address untouched may loose, because if
290 the triggering instruction happens to be the very first of a region, the
291 later adjustements performed by the unwinder would yield an address outside
292 that region. We need to compensate for those adjustments at some point,
293 which we currently do in the GCC unwinding fallback macro.
294
295 The thread at http://gcc.gnu.org/ml/gcc-patches/2004-05/msg00343.html
296 describes a couple of issues with our current approach. Basically: on some
297 targets the adjustment to apply depends on the triggering signal, which is
298 not easily accessible from the macro, and we actually do not tackle this as
299 of today. Besides, other languages, e.g. Java, deal with this by performing
300 the adjustment in the signal handler before the raise, so our adjustments
301 may break those front-ends.
302
303 To have it all right, we should either find a way to deal with the signal
304 variants from the macro and convert Java on all targets (ugh), or remove
305 our macro adjustments and update our signal handlers a-la-java way. The
306 latter option appears the simplest, although some targets have their share
307 of subtleties to account for. See for instance the syscall(SYS_sigaction)
308 story in libjava/include/i386-signal.h. */
309
310 /***********************************/
311 /* __gnat_initialize (AIX Version) */
312 /***********************************/
313
314 #if defined (_AIX)
315
316 #include <signal.h>
317 #include <sys/time.h>
318
319 /* Some versions of AIX don't define SA_NODEFER. */
320
321 #ifndef SA_NODEFER
322 #define SA_NODEFER 0
323 #endif /* SA_NODEFER */
324
325 /* Versions of AIX before 4.3 don't have nanosleep but provide
326 nsleep instead. */
327
328 #ifndef _AIXVERSION_430
329
330 extern int nanosleep (struct timestruc_t *, struct timestruc_t *);
331
332 int
333 nanosleep (struct timestruc_t *Rqtp, struct timestruc_t *Rmtp)
334 {
335 return nsleep (Rqtp, Rmtp);
336 }
337
338 #endif /* _AIXVERSION_430 */
339
340 static void __gnat_error_handler (int);
341
342 static void
343 __gnat_error_handler (int sig)
344 {
345 struct Exception_Data *exception;
346 const char *msg;
347
348 switch (sig)
349 {
350 case SIGSEGV:
351 /* FIXME: we need to detect the case of a *real* SIGSEGV */
352 exception = &storage_error;
353 msg = "stack overflow or erroneous memory access";
354 break;
355
356 case SIGBUS:
357 exception = &constraint_error;
358 msg = "SIGBUS";
359 break;
360
361 case SIGFPE:
362 exception = &constraint_error;
363 msg = "SIGFPE";
364 break;
365
366 default:
367 exception = &program_error;
368 msg = "unhandled signal";
369 }
370
371 Raise_From_Signal_Handler (exception, msg);
372 }
373
374 void
375 __gnat_install_handler (void)
376 {
377 struct sigaction act;
378
379 /* Set up signal handler to map synchronous signals to appropriate
380 exceptions. Make sure that the handler isn't interrupted by another
381 signal that might cause a scheduling event! */
382
383 act.sa_handler = __gnat_error_handler;
384 act.sa_flags = SA_NODEFER | SA_RESTART;
385 sigemptyset (&act.sa_mask);
386
387 /* Do not install handlers if interrupt state is "System" */
388 if (__gnat_get_interrupt_state (SIGABRT) != 's')
389 sigaction (SIGABRT, &act, NULL);
390 if (__gnat_get_interrupt_state (SIGFPE) != 's')
391 sigaction (SIGFPE, &act, NULL);
392 if (__gnat_get_interrupt_state (SIGILL) != 's')
393 sigaction (SIGILL, &act, NULL);
394 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
395 sigaction (SIGSEGV, &act, NULL);
396 if (__gnat_get_interrupt_state (SIGBUS) != 's')
397 sigaction (SIGBUS, &act, NULL);
398
399 __gnat_handler_installed = 1;
400 }
401
402 void
403 __gnat_initialize (void)
404 {
405 }
406
407 /***************************************/
408 /* __gnat_initialize (RTEMS version) */
409 /***************************************/
410
411 #elif defined(__rtems__)
412
413 extern void __gnat_install_handler (void);
414
415 /* For RTEMS, each bsp will provide a custom __gnat_install_handler (). */
416
417 void
418 __gnat_initialize (void)
419 {
420 __gnat_install_handler ();
421 }
422
423 /****************************************/
424 /* __gnat_initialize (Dec Unix Version) */
425 /****************************************/
426
427 #elif defined(__alpha__) && defined(__osf__) && ! defined(__alpha_vxworks)
428
429 /* Note: it seems that __osf__ is defined for the Alpha VXWorks case. Not
430 clear that this is reasonable, but in any case we have to be sure to
431 exclude this case in the above test. */
432
433 #include <signal.h>
434 #include <sys/siginfo.h>
435
436 static void __gnat_error_handler (int, siginfo_t *, struct sigcontext *);
437 extern char *__gnat_get_code_loc (struct sigcontext *);
438 extern void __gnat_enter_handler (struct sigcontext *, char *);
439 extern size_t __gnat_machine_state_length (void);
440
441 extern long exc_lookup_gp (char *);
442 extern void exc_resume (struct sigcontext *);
443
444 static void
445 __gnat_error_handler (int sig, siginfo_t *sip, struct sigcontext *context)
446 {
447 struct Exception_Data *exception;
448 static int recurse = 0;
449 struct sigcontext *mstate;
450 const char *msg;
451
452 /* If this was an explicit signal from a "kill", just resignal it. */
453 if (SI_FROMUSER (sip))
454 {
455 signal (sig, SIG_DFL);
456 kill (getpid(), sig);
457 }
458
459 /* Otherwise, treat it as something we handle. */
460 switch (sig)
461 {
462 case SIGSEGV:
463 /* If the problem was permissions, this is a constraint error.
464 Likewise if the failing address isn't maximally aligned or if
465 we've recursed.
466
467 ??? Using a static variable here isn't task-safe, but it's
468 much too hard to do anything else and we're just determining
469 which exception to raise. */
470 if (sip->si_code == SEGV_ACCERR
471 || (((long) sip->si_addr) & 3) != 0
472 || recurse)
473 {
474 exception = &constraint_error;
475 msg = "SIGSEGV";
476 }
477 else
478 {
479 /* See if the page before the faulting page is accessible. Do that
480 by trying to access it. We'd like to simply try to access
481 4096 + the faulting address, but it's not guaranteed to be
482 the actual address, just to be on the same page. */
483 recurse++;
484 ((volatile char *)
485 ((long) sip->si_addr & - getpagesize ()))[getpagesize ()];
486 msg = "stack overflow (or erroneous memory access)";
487 exception = &storage_error;
488 }
489 break;
490
491 case SIGBUS:
492 exception = &program_error;
493 msg = "SIGBUS";
494 break;
495
496 case SIGFPE:
497 exception = &constraint_error;
498 msg = "SIGFPE";
499 break;
500
501 default:
502 exception = &program_error;
503 msg = "unhandled signal";
504 }
505
506 recurse = 0;
507 mstate = (struct sigcontext *) (*Get_Machine_State_Addr) ();
508 if (mstate != 0)
509 *mstate = *context;
510
511 Raise_From_Signal_Handler (exception, (char *) msg);
512 }
513
514 void
515 __gnat_install_handler (void)
516 {
517 struct sigaction act;
518
519 /* Setup signal handler to map synchronous signals to appropriate
520 exceptions. Make sure that the handler isn't interrupted by another
521 signal that might cause a scheduling event! */
522
523 act.sa_handler = (void (*) (int)) __gnat_error_handler;
524 act.sa_flags = SA_RESTART | SA_NODEFER | SA_SIGINFO;
525 sigemptyset (&act.sa_mask);
526
527 /* Do not install handlers if interrupt state is "System" */
528 if (__gnat_get_interrupt_state (SIGABRT) != 's')
529 sigaction (SIGABRT, &act, NULL);
530 if (__gnat_get_interrupt_state (SIGFPE) != 's')
531 sigaction (SIGFPE, &act, NULL);
532 if (__gnat_get_interrupt_state (SIGILL) != 's')
533 sigaction (SIGILL, &act, NULL);
534 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
535 sigaction (SIGSEGV, &act, NULL);
536 if (__gnat_get_interrupt_state (SIGBUS) != 's')
537 sigaction (SIGBUS, &act, NULL);
538
539 __gnat_handler_installed = 1;
540 }
541
542 void
543 __gnat_initialize (void)
544 {
545 }
546
547 /* Routines called by 5amastop.adb. */
548
549 #define SC_GP 29
550
551 char *
552 __gnat_get_code_loc (struct sigcontext *context)
553 {
554 return (char *) context->sc_pc;
555 }
556
557 void
558 __gnat_enter_handler ( struct sigcontext *context, char *pc)
559 {
560 context->sc_pc = (long) pc;
561 context->sc_regs[SC_GP] = exc_lookup_gp (pc);
562 exc_resume (context);
563 }
564
565 size_t
566 __gnat_machine_state_length (void)
567 {
568 return sizeof (struct sigcontext);
569 }
570
571 /************************************/
572 /* __gnat_initialize (HPUX Version) */
573 /************************************/
574
575 #elif defined (hpux)
576
577 #include <signal.h>
578
579 static void __gnat_error_handler (int);
580
581 static void
582 __gnat_error_handler (int sig)
583 {
584 struct Exception_Data *exception;
585 char *msg;
586
587 switch (sig)
588 {
589 case SIGSEGV:
590 /* FIXME: we need to detect the case of a *real* SIGSEGV */
591 exception = &storage_error;
592 msg = "stack overflow or erroneous memory access";
593 break;
594
595 case SIGBUS:
596 exception = &constraint_error;
597 msg = "SIGBUS";
598 break;
599
600 case SIGFPE:
601 exception = &constraint_error;
602 msg = "SIGFPE";
603 break;
604
605 default:
606 exception = &program_error;
607 msg = "unhandled signal";
608 }
609
610 Raise_From_Signal_Handler (exception, msg);
611 }
612
613 void
614 __gnat_install_handler (void)
615 {
616 struct sigaction act;
617
618 /* Set up signal handler to map synchronous signals to appropriate
619 exceptions. Make sure that the handler isn't interrupted by another
620 signal that might cause a scheduling event! Also setup an alternate
621 stack region for the handler execution so that stack overflows can be
622 handled properly, avoiding a SEGV generation from stack usage by the
623 handler itself. */
624
625 static char handler_stack[SIGSTKSZ*2];
626 /* SIGSTKSZ appeared to be "short" for the needs in some contexts
627 (e.g. experiments with GCC ZCX exceptions). */
628
629 stack_t stack;
630
631 stack.ss_sp = handler_stack;
632 stack.ss_size = sizeof (handler_stack);
633 stack.ss_flags = 0;
634
635 sigaltstack (&stack, NULL);
636
637 act.sa_handler = __gnat_error_handler;
638 act.sa_flags = SA_NODEFER | SA_RESTART | SA_ONSTACK;
639 sigemptyset (&act.sa_mask);
640
641 /* Do not install handlers if interrupt state is "System" */
642 if (__gnat_get_interrupt_state (SIGABRT) != 's')
643 sigaction (SIGABRT, &act, NULL);
644 if (__gnat_get_interrupt_state (SIGFPE) != 's')
645 sigaction (SIGFPE, &act, NULL);
646 if (__gnat_get_interrupt_state (SIGILL) != 's')
647 sigaction (SIGILL, &act, NULL);
648 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
649 sigaction (SIGSEGV, &act, NULL);
650 if (__gnat_get_interrupt_state (SIGBUS) != 's')
651 sigaction (SIGBUS, &act, NULL);
652
653 __gnat_handler_installed = 1;
654 }
655
656 void
657 __gnat_initialize (void)
658 {
659 }
660
661 /*****************************************/
662 /* __gnat_initialize (GNU/Linux Version) */
663 /*****************************************/
664
665 #elif defined (linux) && defined (i386) && !defined (__RT__)
666
667 #include <signal.h>
668 #include <asm/sigcontext.h>
669
670 /* GNU/Linux, which uses glibc, does not define NULL in included
671 header files */
672
673 #if !defined (NULL)
674 #define NULL ((void *) 0)
675 #endif
676
677 struct Machine_State
678 {
679 unsigned long eip;
680 unsigned long ebx;
681 unsigned long esp;
682 unsigned long ebp;
683 unsigned long esi;
684 unsigned long edi;
685 };
686
687 static void __gnat_error_handler (int);
688
689 static void
690 __gnat_error_handler (int sig)
691 {
692 struct Exception_Data *exception;
693 const char *msg;
694 static int recurse = 0;
695
696 struct sigcontext *info
697 = (struct sigcontext *) (((char *) &sig) + sizeof (int));
698
699 /* The Linux kernel does not document how to get the machine state in a
700 signal handler, but in fact the necessary data is in a sigcontext_struct
701 value that is on the stack immediately above the signal number
702 parameter, and the above messing accesses this value on the stack. */
703
704 struct Machine_State *mstate;
705
706 switch (sig)
707 {
708 case SIGSEGV:
709 /* If the problem was permissions, this is a constraint error.
710 Likewise if the failing address isn't maximally aligned or if
711 we've recursed.
712
713 ??? Using a static variable here isn't task-safe, but it's
714 much too hard to do anything else and we're just determining
715 which exception to raise. */
716 if (recurse)
717 {
718 exception = &constraint_error;
719 msg = "SIGSEGV";
720 }
721 else
722 {
723 /* Here we would like a discrimination test to see whether the
724 page before the faulting address is accessible. Unfortunately
725 Linux seems to have no way of giving us the faulting address.
726
727 In versions of a-init.c before 1.95, we had a test of the page
728 before the stack pointer using:
729
730 recurse++;
731 ((volatile char *)
732 ((long) info->esp_at_signal & - getpagesize ()))[getpagesize ()];
733
734 but that's wrong, since it tests the stack pointer location, and
735 the current stack probe code does not move the stack pointer
736 until all probes succeed.
737
738 For now we simply do not attempt any discrimination at all. Note
739 that this is quite acceptable, since a "real" SIGSEGV can only
740 occur as the result of an erroneous program */
741
742 msg = "stack overflow (or erroneous memory access)";
743 exception = &storage_error;
744 }
745 break;
746
747 case SIGBUS:
748 exception = &constraint_error;
749 msg = "SIGBUS";
750 break;
751
752 case SIGFPE:
753 exception = &constraint_error;
754 msg = "SIGFPE";
755 break;
756
757 default:
758 exception = &program_error;
759 msg = "unhandled signal";
760 }
761
762 mstate = (*Get_Machine_State_Addr) ();
763 if (mstate)
764 {
765 mstate->eip = info->eip;
766 mstate->ebx = info->ebx;
767 mstate->esp = info->esp_at_signal;
768 mstate->ebp = info->ebp;
769 mstate->esi = info->esi;
770 mstate->edi = info->edi;
771 }
772
773 recurse = 0;
774 Raise_From_Signal_Handler (exception, msg);
775 }
776
777 void
778 __gnat_install_handler (void)
779 {
780 struct sigaction act;
781
782 /* Set up signal handler to map synchronous signals to appropriate
783 exceptions. Make sure that the handler isn't interrupted by another
784 signal that might cause a scheduling event! */
785
786 act.sa_handler = __gnat_error_handler;
787 act.sa_flags = SA_NODEFER | SA_RESTART;
788 sigemptyset (&act.sa_mask);
789
790 /* Do not install handlers if interrupt state is "System" */
791 if (__gnat_get_interrupt_state (SIGABRT) != 's')
792 sigaction (SIGABRT, &act, NULL);
793 if (__gnat_get_interrupt_state (SIGFPE) != 's')
794 sigaction (SIGFPE, &act, NULL);
795 if (__gnat_get_interrupt_state (SIGILL) != 's')
796 sigaction (SIGILL, &act, NULL);
797 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
798 sigaction (SIGSEGV, &act, NULL);
799 if (__gnat_get_interrupt_state (SIGBUS) != 's')
800 sigaction (SIGBUS, &act, NULL);
801
802 __gnat_handler_installed = 1;
803 }
804
805 void
806 __gnat_initialize (void)
807 {
808 }
809
810 /******************************************/
811 /* __gnat_initialize (NT-mingw32 Version) */
812 /******************************************/
813
814 #elif defined (__MINGW32__)
815 #include <windows.h>
816
817 static LONG WINAPI __gnat_error_handler (PEXCEPTION_POINTERS);
818
819 /* __gnat_initialize (mingw32). */
820
821 static LONG WINAPI
822 __gnat_error_handler (PEXCEPTION_POINTERS info)
823 {
824 static int recurse;
825 struct Exception_Data *exception;
826 const char *msg;
827
828 switch (info->ExceptionRecord->ExceptionCode)
829 {
830 case EXCEPTION_ACCESS_VIOLATION:
831 /* If the failing address isn't maximally-aligned or if we've
832 recursed, this is a program error. */
833 if ((info->ExceptionRecord->ExceptionInformation[1] & 3) != 0
834 || recurse)
835 {
836 exception = &program_error;
837 msg = "EXCEPTION_ACCESS_VIOLATION";
838 }
839 else
840 {
841 /* See if the page before the faulting page is accessible. Do that
842 by trying to access it. */
843 recurse++;
844 * ((volatile char *) (info->ExceptionRecord->ExceptionInformation[1]
845 + 4096));
846 exception = &storage_error;
847 msg = "stack overflow (or erroneous memory access)";
848 }
849 break;
850
851 case EXCEPTION_ARRAY_BOUNDS_EXCEEDED:
852 exception = &constraint_error;
853 msg = "EXCEPTION_ARRAY_BOUNDS_EXCEEDED";
854 break;
855
856 case EXCEPTION_DATATYPE_MISALIGNMENT:
857 exception = &constraint_error;
858 msg = "EXCEPTION_DATATYPE_MISALIGNMENT";
859 break;
860
861 case EXCEPTION_FLT_DENORMAL_OPERAND:
862 exception = &constraint_error;
863 msg = "EXCEPTION_FLT_DENORMAL_OPERAND";
864 break;
865
866 case EXCEPTION_FLT_DIVIDE_BY_ZERO:
867 exception = &constraint_error;
868 msg = "EXCEPTION_FLT_DENORMAL_OPERAND";
869 break;
870
871 case EXCEPTION_FLT_INVALID_OPERATION:
872 exception = &constraint_error;
873 msg = "EXCEPTION_FLT_INVALID_OPERATION";
874 break;
875
876 case EXCEPTION_FLT_OVERFLOW:
877 exception = &constraint_error;
878 msg = "EXCEPTION_FLT_OVERFLOW";
879 break;
880
881 case EXCEPTION_FLT_STACK_CHECK:
882 exception = &program_error;
883 msg = "EXCEPTION_FLT_STACK_CHECK";
884 break;
885
886 case EXCEPTION_FLT_UNDERFLOW:
887 exception = &constraint_error;
888 msg = "EXCEPTION_FLT_UNDERFLOW";
889 break;
890
891 case EXCEPTION_INT_DIVIDE_BY_ZERO:
892 exception = &constraint_error;
893 msg = "EXCEPTION_INT_DIVIDE_BY_ZERO";
894 break;
895
896 case EXCEPTION_INT_OVERFLOW:
897 exception = &constraint_error;
898 msg = "EXCEPTION_INT_OVERFLOW";
899 break;
900
901 case EXCEPTION_INVALID_DISPOSITION:
902 exception = &program_error;
903 msg = "EXCEPTION_INVALID_DISPOSITION";
904 break;
905
906 case EXCEPTION_NONCONTINUABLE_EXCEPTION:
907 exception = &program_error;
908 msg = "EXCEPTION_NONCONTINUABLE_EXCEPTION";
909 break;
910
911 case EXCEPTION_PRIV_INSTRUCTION:
912 exception = &program_error;
913 msg = "EXCEPTION_PRIV_INSTRUCTION";
914 break;
915
916 case EXCEPTION_SINGLE_STEP:
917 exception = &program_error;
918 msg = "EXCEPTION_SINGLE_STEP";
919 break;
920
921 case EXCEPTION_STACK_OVERFLOW:
922 exception = &storage_error;
923 msg = "EXCEPTION_STACK_OVERFLOW";
924 break;
925
926 default:
927 exception = &program_error;
928 msg = "unhandled signal";
929 }
930
931 recurse = 0;
932 Raise_From_Signal_Handler (exception, msg);
933 return 0; /* This is never reached, avoid compiler warning */
934 }
935
936 void
937 __gnat_install_handler (void)
938 {
939 SetUnhandledExceptionFilter (__gnat_error_handler);
940 __gnat_handler_installed = 1;
941 }
942
943 void
944 __gnat_initialize (void)
945 {
946
947 /* Initialize floating-point coprocessor. This call is needed because
948 the MS libraries default to 64-bit precision instead of 80-bit
949 precision, and we require the full precision for proper operation,
950 given that we have set Max_Digits etc with this in mind */
951
952 __gnat_init_float ();
953
954 /* initialize a lock for a process handle list - see a-adaint.c for the
955 implementation of __gnat_portable_no_block_spawn, __gnat_portable_wait */
956 __gnat_plist_init();
957 }
958
959 /***************************************/
960 /* __gnat_initialize (Interix Version) */
961 /***************************************/
962
963 #elif defined (__INTERIX)
964
965 #include <signal.h>
966
967 static void __gnat_error_handler (int);
968
969 static void
970 __gnat_error_handler (int sig)
971 {
972 struct Exception_Data *exception;
973 char *msg;
974
975 switch (sig)
976 {
977 case SIGSEGV:
978 exception = &storage_error;
979 msg = "stack overflow or erroneous memory access";
980 break;
981
982 case SIGBUS:
983 exception = &constraint_error;
984 msg = "SIGBUS";
985 break;
986
987 case SIGFPE:
988 exception = &constraint_error;
989 msg = "SIGFPE";
990 break;
991
992 default:
993 exception = &program_error;
994 msg = "unhandled signal";
995 }
996
997 Raise_From_Signal_Handler (exception, msg);
998 }
999
1000 void
1001 __gnat_install_handler (void)
1002 {
1003 struct sigaction act;
1004
1005 /* Set up signal handler to map synchronous signals to appropriate
1006 exceptions. Make sure that the handler isn't interrupted by another
1007 signal that might cause a scheduling event! */
1008
1009 act.sa_handler = __gnat_error_handler;
1010 act.sa_flags = 0;
1011 sigemptyset (&act.sa_mask);
1012
1013 /* Handlers for signals besides SIGSEGV cause c974013 to hang */
1014 /* sigaction (SIGILL, &act, NULL); */
1015 /* sigaction (SIGABRT, &act, NULL); */
1016 /* sigaction (SIGFPE, &act, NULL); */
1017 /* sigaction (SIGBUS, &act, NULL); */
1018
1019 /* Do not install handlers if interrupt state is "System" */
1020 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1021 sigaction (SIGSEGV, &act, NULL);
1022
1023 __gnat_handler_installed = 1;
1024 }
1025
1026 void
1027 __gnat_initialize (void)
1028 {
1029 __gnat_init_float ();
1030 }
1031
1032 /**************************************/
1033 /* __gnat_initialize (LynxOS Version) */
1034 /**************************************/
1035
1036 #elif defined (__Lynx__)
1037
1038 void
1039 __gnat_initialize (void)
1040 {
1041 __gnat_init_float ();
1042 }
1043
1044 /*********************************/
1045 /* __gnat_install_handler (Lynx) */
1046 /*********************************/
1047
1048 void
1049 __gnat_install_handler (void)
1050 {
1051 __gnat_handler_installed = 1;
1052 }
1053
1054 /****************************/
1055 /* __gnat_initialize (OS/2) */
1056 /****************************/
1057
1058 #elif defined (__EMX__) /* OS/2 dependent initialization */
1059
1060 void
1061 __gnat_initialize (void)
1062 {
1063 }
1064
1065 /*********************************/
1066 /* __gnat_install_handler (OS/2) */
1067 /*********************************/
1068
1069 void
1070 __gnat_install_handler (void)
1071 {
1072 __gnat_handler_installed = 1;
1073 }
1074
1075 /***********************************/
1076 /* __gnat_initialize (SGI Version) */
1077 /***********************************/
1078
1079 #elif defined (sgi)
1080
1081 #include <signal.h>
1082 #include <siginfo.h>
1083
1084 #ifndef NULL
1085 #define NULL 0
1086 #endif
1087
1088 #define SIGADAABORT 48
1089 #define SIGNAL_STACK_SIZE 4096
1090 #define SIGNAL_STACK_ALIGNMENT 64
1091
1092 struct Machine_State
1093 {
1094 sigcontext_t context;
1095 };
1096
1097 static void __gnat_error_handler (int, int, sigcontext_t *);
1098
1099 /* We are not setting the SA_SIGINFO bit in the sigaction flags when
1100 connecting that handler, with the effects described in the sigaction
1101 man page:
1102
1103 SA_SIGINFO [...]
1104 If cleared and the signal is caught, the first argument is
1105 also the signal number but the second argument is the signal
1106 code identifying the cause of the signal. The third argument
1107 points to a sigcontext_t structure containing the receiving
1108 process's context when the signal was delivered.
1109 */
1110
1111 static void
1112 __gnat_error_handler (int sig, int code, sigcontext_t *sc)
1113 {
1114 struct Machine_State *mstate;
1115 struct Exception_Data *exception;
1116 const char *msg;
1117
1118 switch (sig)
1119 {
1120 case SIGSEGV:
1121 if (code == EFAULT)
1122 {
1123 exception = &program_error;
1124 msg = "SIGSEGV: (Invalid virtual address)";
1125 }
1126 else if (code == ENXIO)
1127 {
1128 exception = &program_error;
1129 msg = "SIGSEGV: (Read beyond mapped object)";
1130 }
1131 else if (code == ENOSPC)
1132 {
1133 exception = &program_error; /* ??? storage_error ??? */
1134 msg = "SIGSEGV: (Autogrow for file failed)";
1135 }
1136 else if (code == EACCES || code == EEXIST)
1137 {
1138 /* ??? We handle stack overflows here, some of which do trigger
1139 SIGSEGV + EEXIST on Irix 6.5 although EEXIST is not part of
1140 the documented valid codes for SEGV in the signal(5) man
1141 page. */
1142
1143 /* ??? Re-add smarts to further verify that we launched
1144 the stack into a guard page, not an attempt to
1145 write to .text or something */
1146 exception = &storage_error;
1147 msg = "SIGSEGV: (stack overflow or erroneous memory access)";
1148 }
1149 else
1150 {
1151 /* Just in case the OS guys did it to us again. Sometimes
1152 they fail to document all of the valid codes that are
1153 passed to signal handlers, just in case someone depends
1154 on knowing all the codes */
1155 exception = &program_error;
1156 msg = "SIGSEGV: (Undocumented reason)";
1157 }
1158 break;
1159
1160 case SIGBUS:
1161 /* Map all bus errors to Program_Error. */
1162 exception = &program_error;
1163 msg = "SIGBUS";
1164 break;
1165
1166 case SIGFPE:
1167 /* Map all fpe errors to Constraint_Error. */
1168 exception = &constraint_error;
1169 msg = "SIGFPE";
1170 break;
1171
1172 case SIGADAABORT:
1173 if ((*Check_Abort_Status) ())
1174 {
1175 exception = &_abort_signal;
1176 msg = "";
1177 }
1178 else
1179 return;
1180
1181 break;
1182
1183 default:
1184 /* Everything else is a Program_Error. */
1185 exception = &program_error;
1186 msg = "unhandled signal";
1187 }
1188
1189 mstate = (*Get_Machine_State_Addr) ();
1190 if (mstate != 0)
1191 memcpy ((void *) mstate, (const void *) sc, sizeof (sigcontext_t));
1192
1193 Raise_From_Signal_Handler (exception, msg);
1194 }
1195
1196 void
1197 __gnat_install_handler (void)
1198 {
1199 struct sigaction act;
1200
1201 /* Setup signal handler to map synchronous signals to appropriate
1202 exceptions. Make sure that the handler isn't interrupted by another
1203 signal that might cause a scheduling event! */
1204
1205 act.sa_handler = __gnat_error_handler;
1206 act.sa_flags = SA_NODEFER + SA_RESTART;
1207 sigfillset (&act.sa_mask);
1208 sigemptyset (&act.sa_mask);
1209
1210 /* Do not install handlers if interrupt state is "System" */
1211 if (__gnat_get_interrupt_state (SIGABRT) != 's')
1212 sigaction (SIGABRT, &act, NULL);
1213 if (__gnat_get_interrupt_state (SIGFPE) != 's')
1214 sigaction (SIGFPE, &act, NULL);
1215 if (__gnat_get_interrupt_state (SIGILL) != 's')
1216 sigaction (SIGILL, &act, NULL);
1217 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1218 sigaction (SIGSEGV, &act, NULL);
1219 if (__gnat_get_interrupt_state (SIGBUS) != 's')
1220 sigaction (SIGBUS, &act, NULL);
1221 if (__gnat_get_interrupt_state (SIGADAABORT) != 's')
1222 sigaction (SIGADAABORT, &act, NULL);
1223
1224 __gnat_handler_installed = 1;
1225 }
1226
1227 void
1228 __gnat_initialize (void)
1229 {
1230 }
1231
1232 /*************************************************/
1233 /* __gnat_initialize (Solaris and SunOS Version) */
1234 /*************************************************/
1235
1236 #elif defined (sun) && defined (__SVR4) && !defined (__vxworks)
1237
1238 #include <signal.h>
1239 #include <siginfo.h>
1240
1241 static void __gnat_error_handler (int, siginfo_t *);
1242
1243 static void
1244 __gnat_error_handler (int sig, siginfo_t *sip)
1245 {
1246 struct Exception_Data *exception;
1247 static int recurse = 0;
1248 const char *msg;
1249
1250 /* If this was an explicit signal from a "kill", just resignal it. */
1251 if (SI_FROMUSER (sip))
1252 {
1253 signal (sig, SIG_DFL);
1254 kill (getpid(), sig);
1255 }
1256
1257 /* Otherwise, treat it as something we handle. */
1258 switch (sig)
1259 {
1260 case SIGSEGV:
1261 /* If the problem was permissions, this is a constraint error.
1262 Likewise if the failing address isn't maximally aligned or if
1263 we've recursed.
1264
1265 ??? Using a static variable here isn't task-safe, but it's
1266 much too hard to do anything else and we're just determining
1267 which exception to raise. */
1268 if (sip->si_code == SEGV_ACCERR
1269 || (((long) sip->si_addr) & 3) != 0
1270 || recurse)
1271 {
1272 exception = &constraint_error;
1273 msg = "SIGSEGV";
1274 }
1275 else
1276 {
1277 /* See if the page before the faulting page is accessible. Do that
1278 by trying to access it. We'd like to simply try to access
1279 4096 + the faulting address, but it's not guaranteed to be
1280 the actual address, just to be on the same page. */
1281 recurse++;
1282 ((volatile char *)
1283 ((long) sip->si_addr & - getpagesize ()))[getpagesize ()];
1284 exception = &storage_error;
1285 msg = "stack overflow (or erroneous memory access)";
1286 }
1287 break;
1288
1289 case SIGBUS:
1290 exception = &program_error;
1291 msg = "SIGBUS";
1292 break;
1293
1294 case SIGFPE:
1295 exception = &constraint_error;
1296 msg = "SIGFPE";
1297 break;
1298
1299 default:
1300 exception = &program_error;
1301 msg = "unhandled signal";
1302 }
1303
1304 recurse = 0;
1305
1306 Raise_From_Signal_Handler (exception, msg);
1307 }
1308
1309 void
1310 __gnat_install_handler (void)
1311 {
1312 struct sigaction act;
1313
1314 /* Set up signal handler to map synchronous signals to appropriate
1315 exceptions. Make sure that the handler isn't interrupted by another
1316 signal that might cause a scheduling event! */
1317
1318 act.sa_handler = __gnat_error_handler;
1319 act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
1320 sigemptyset (&act.sa_mask);
1321
1322 /* Do not install handlers if interrupt state is "System" */
1323 if (__gnat_get_interrupt_state (SIGABRT) != 's')
1324 sigaction (SIGABRT, &act, NULL);
1325 if (__gnat_get_interrupt_state (SIGFPE) != 's')
1326 sigaction (SIGFPE, &act, NULL);
1327 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1328 sigaction (SIGSEGV, &act, NULL);
1329 if (__gnat_get_interrupt_state (SIGBUS) != 's')
1330 sigaction (SIGBUS, &act, NULL);
1331
1332 __gnat_handler_installed = 1;
1333 }
1334
1335 void
1336 __gnat_initialize (void)
1337 {
1338 }
1339
1340 /***********************************/
1341 /* __gnat_initialize (VMS Version) */
1342 /***********************************/
1343
1344 #elif defined (VMS)
1345
1346 #ifdef __IA64
1347 #define lib_get_curr_invo_context LIB$I64_GET_CURR_INVO_CONTEXT
1348 #define lib_get_prev_invo_context LIB$I64_GET_PREV_INVO_CONTEXT
1349 #define lib_get_invo_handle LIB$I64_GET_INVO_HANDLE
1350 #else
1351 #define lib_get_curr_invo_context LIB$GET_CURR_INVO_CONTEXT
1352 #define lib_get_prev_invo_context LIB$GET_PREV_INVO_CONTEXT
1353 #define lib_get_invo_handle LIB$GET_INVO_HANDLE
1354 #endif
1355
1356 #if defined (IN_RTS) && !defined (__IA64)
1357
1358 /* The prehandler actually gets control first on a condition. It swaps the
1359 stack pointer and calls the handler (__gnat_error_handler). */
1360 extern long __gnat_error_prehandler (void);
1361
1362 extern char *__gnat_error_prehandler_stack; /* Alternate signal stack */
1363 #endif
1364
1365 /* Conditions that don't have an Ada exception counterpart must raise
1366 Non_Ada_Error. Since this is defined in s-auxdec, it should only be
1367 referenced by user programs, not the compiler or tools. Hence the
1368 #ifdef IN_RTS. */
1369
1370 #ifdef IN_RTS
1371 #define Non_Ada_Error system__aux_dec__non_ada_error
1372 extern struct Exception_Data Non_Ada_Error;
1373
1374 #define Coded_Exception system__vms_exception_table__coded_exception
1375 extern struct Exception_Data *Coded_Exception (Exception_Code);
1376
1377 #define Base_Code_In system__vms_exception_table__base_code_in
1378 extern Exception_Code Base_Code_In (Exception_Code);
1379 #endif
1380
1381 /* Define macro symbols for the VMS conditions that become Ada exceptions.
1382 Most of these are also defined in the header file ssdef.h which has not
1383 yet been converted to be recoginized by Gnu C. Some, which couldn't be
1384 located, are assigned names based on the DEC test suite tests which
1385 raise them. */
1386
1387 #define SS$_ACCVIO 12
1388 #define SS$_DEBUG 1132
1389 #define SS$_INTDIV 1156
1390 #define SS$_HPARITH 1284
1391 #define SS$_STKOVF 1364
1392 #define SS$_RESIGNAL 2328
1393 #define MTH$_FLOOVEMAT 1475268 /* Some ACVC_21 CXA tests */
1394 #define SS$_CE24VRU 3253636 /* Write to unopened file */
1395 #define SS$_C980VTE 3246436 /* AST requests time slice */
1396 #define CMA$_EXIT_THREAD 4227492
1397 #define CMA$_EXCCOPLOS 4228108
1398 #define CMA$_ALERTED 4227460
1399
1400 struct descriptor_s {unsigned short len, mbz; char *adr; };
1401
1402 long __gnat_error_handler (int *, void *);
1403
1404 long
1405 __gnat_error_handler (int *sigargs, void *mechargs)
1406 {
1407 struct Exception_Data *exception = 0;
1408 Exception_Code base_code;
1409
1410 char *msg = "";
1411 char message[256];
1412 long prvhnd;
1413 struct descriptor_s msgdesc;
1414 int msg_flag = 0x000f; /* 1 bit for each of the four message parts */
1415 unsigned short outlen;
1416 char curr_icb[544];
1417 long curr_invo_handle;
1418 long *mstate;
1419
1420 /* Resignaled condtions aren't effected by by pragma Import_Exception */
1421
1422 switch (sigargs[1])
1423 {
1424
1425 case CMA$_EXIT_THREAD:
1426 return SS$_RESIGNAL;
1427
1428 case SS$_DEBUG: /* Gdb attach, resignal to merge activate gdbstub. */
1429 return SS$_RESIGNAL;
1430
1431 case 1409786: /* Nickerson bug #33 ??? */
1432 return SS$_RESIGNAL;
1433
1434 case 1381050: /* Nickerson bug #33 ??? */
1435 return SS$_RESIGNAL;
1436
1437 case 20480426: /* RDB-E-STREAM_EOF */
1438 return SS$_RESIGNAL;
1439
1440 case 11829410: /* Resignalled as Use_Error for CE10VRC */
1441 return SS$_RESIGNAL;
1442
1443 }
1444
1445 #ifdef IN_RTS
1446 /* See if it's an imported exception. Beware that registered exceptions
1447 are bound to their base code, with the severity bits masked off. */
1448 base_code = Base_Code_In ((Exception_Code) sigargs [1]);
1449 exception = Coded_Exception (base_code);
1450
1451 if (exception)
1452 {
1453 msgdesc.len = 256;
1454 msgdesc.mbz = 0;
1455 msgdesc.adr = message;
1456 SYS$GETMSG (sigargs[1], &outlen, &msgdesc, msg_flag, 0);
1457 message[outlen] = 0;
1458 msg = message;
1459
1460 exception->Name_Length = 19;
1461 /* The full name really should be get sys$getmsg returns. ??? */
1462 exception->Full_Name = "IMPORTED_EXCEPTION";
1463 exception->Import_Code = base_code;
1464 }
1465 #endif
1466
1467 if (exception == 0)
1468 switch (sigargs[1])
1469 {
1470 case SS$_ACCVIO:
1471 if (sigargs[3] == 0)
1472 {
1473 exception = &constraint_error;
1474 msg = "access zero";
1475 }
1476 else
1477 {
1478 exception = &storage_error;
1479 msg = "stack overflow (or erroneous memory access)";
1480 }
1481 break;
1482
1483 case SS$_STKOVF:
1484 exception = &storage_error;
1485 msg = "stack overflow";
1486 break;
1487
1488 case SS$_INTDIV:
1489 exception = &constraint_error;
1490 msg = "division by zero";
1491 break;
1492
1493 case SS$_HPARITH:
1494 #ifndef IN_RTS
1495 return SS$_RESIGNAL; /* toplev.c handles for compiler */
1496 #else
1497 {
1498 exception = &constraint_error;
1499 msg = "arithmetic error";
1500 }
1501 #endif
1502 break;
1503
1504 case MTH$_FLOOVEMAT:
1505 exception = &constraint_error;
1506 msg = "floating overflow in math library";
1507 break;
1508
1509 case SS$_CE24VRU:
1510 exception = &constraint_error;
1511 msg = "";
1512 break;
1513
1514 case SS$_C980VTE:
1515 exception = &program_error;
1516 msg = "";
1517 break;
1518
1519 default:
1520 #ifndef IN_RTS
1521 exception = &program_error;
1522 #else
1523 /* User programs expect Non_Ada_Error to be raised, reference
1524 DEC Ada test CXCONDHAN. */
1525 exception = &Non_Ada_Error;
1526 #endif
1527 msgdesc.len = 256;
1528 msgdesc.mbz = 0;
1529 msgdesc.adr = message;
1530 SYS$GETMSG (sigargs[1], &outlen, &msgdesc, msg_flag, 0);
1531 message[outlen] = 0;
1532 msg = message;
1533 break;
1534 }
1535
1536 mstate = (long *) (*Get_Machine_State_Addr) ();
1537 if (mstate != 0)
1538 {
1539 lib_get_curr_invo_context (&curr_icb);
1540 lib_get_prev_invo_context (&curr_icb);
1541 lib_get_prev_invo_context (&curr_icb);
1542 curr_invo_handle = lib_get_invo_handle (&curr_icb);
1543 *mstate = curr_invo_handle;
1544 }
1545 Raise_From_Signal_Handler (exception, msg);
1546 }
1547
1548 void
1549 __gnat_install_handler (void)
1550 {
1551 long prvhnd;
1552 #if defined (IN_RTS) && !defined (__IA64)
1553 char *c;
1554
1555 c = (char *) xmalloc (2049);
1556
1557 __gnat_error_prehandler_stack = &c[2048];
1558
1559 /* __gnat_error_prehandler is an assembly function. */
1560 SYS$SETEXV (1, __gnat_error_prehandler, 3, &prvhnd);
1561 #else
1562 SYS$SETEXV (1, __gnat_error_handler, 3, &prvhnd);
1563 #endif
1564 __gnat_handler_installed = 1;
1565 }
1566
1567 void
1568 __gnat_initialize(void)
1569 {
1570 }
1571
1572 /*************************************************/
1573 /* __gnat_initialize (FreeBSD version) */
1574 /*************************************************/
1575
1576 #elif defined (__FreeBSD__)
1577
1578 #include <signal.h>
1579 #include <unistd.h>
1580
1581 static void
1582 __gnat_error_handler (sig, code, sc)
1583 int sig;
1584 int code;
1585 struct sigcontext *sc;
1586 {
1587 struct Exception_Data *exception;
1588 char *msg;
1589
1590 switch (sig)
1591 {
1592 case SIGFPE:
1593 exception = &constraint_error;
1594 msg = "SIGFPE";
1595 break;
1596
1597 case SIGILL:
1598 exception = &constraint_error;
1599 msg = "SIGILL";
1600 break;
1601
1602 case SIGSEGV:
1603 exception = &storage_error;
1604 msg = "stack overflow or erroneous memory access";
1605 break;
1606
1607 case SIGBUS:
1608 exception = &constraint_error;
1609 msg = "SIGBUS";
1610 break;
1611
1612 default:
1613 exception = &program_error;
1614 msg = "unhandled signal";
1615 }
1616
1617 Raise_From_Signal_Handler (exception, msg);
1618 }
1619
1620 void
1621 __gnat_install_handler ()
1622 {
1623 struct sigaction act;
1624
1625 /* Set up signal handler to map synchronous signals to appropriate
1626 exceptions. Make sure that the handler isn't interrupted by another
1627 signal that might cause a scheduling event! */
1628
1629 act.sa_handler = __gnat_error_handler;
1630 act.sa_flags = SA_NODEFER | SA_RESTART;
1631 (void) sigemptyset (&act.sa_mask);
1632
1633 (void) sigaction (SIGILL, &act, NULL);
1634 (void) sigaction (SIGFPE, &act, NULL);
1635 (void) sigaction (SIGSEGV, &act, NULL);
1636 (void) sigaction (SIGBUS, &act, NULL);
1637 }
1638
1639 void __gnat_init_float ();
1640
1641 void
1642 __gnat_initialize ()
1643 {
1644 __gnat_install_handler ();
1645
1646 /* XXX - Initialize floating-point coprocessor. This call is
1647 needed because FreeBSD defaults to 64-bit precision instead
1648 of 80-bit precision? We require the full precision for
1649 proper operation, given that we have set Max_Digits etc
1650 with this in mind */
1651 __gnat_init_float ();
1652 }
1653
1654 /***************************************/
1655 /* __gnat_initialize (VXWorks Version) */
1656 /***************************************/
1657
1658 #elif defined(__vxworks)
1659
1660 #include <signal.h>
1661 #include <taskLib.h>
1662 #include <intLib.h>
1663 #include <iv.h>
1664
1665 extern int __gnat_inum_to_ivec (int);
1666 static void __gnat_error_handler (int, int, struct sigcontext *);
1667 void __gnat_map_signal (int);
1668
1669 #ifndef __alpha_vxworks
1670
1671 /* getpid is used by s-parint.adb, but is not defined by VxWorks, except
1672 on Alpha VxWorks */
1673
1674 extern long getpid (void);
1675
1676 long
1677 getpid (void)
1678 {
1679 return taskIdSelf ();
1680 }
1681 #endif
1682
1683 /* This is needed by the GNAT run time to handle Vxworks interrupts */
1684 int
1685 __gnat_inum_to_ivec (int num)
1686 {
1687 return INUM_TO_IVEC (num);
1688 }
1689
1690 /* Exported to 5zintman.adb in order to handle different signal
1691 to exception mappings in different VxWorks versions */
1692 void
1693 __gnat_map_signal (int sig)
1694 {
1695 struct Exception_Data *exception;
1696 char *msg;
1697
1698 switch (sig)
1699 {
1700 case SIGFPE:
1701 exception = &constraint_error;
1702 msg = "SIGFPE";
1703 break;
1704 case SIGILL:
1705 exception = &constraint_error;
1706 msg = "SIGILL";
1707 break;
1708 case SIGSEGV:
1709 exception = &program_error;
1710 msg = "SIGSEGV";
1711 break;
1712 case SIGBUS:
1713 #ifdef VTHREADS
1714 exception = &storage_error;
1715 msg = "SIGBUS: possible stack overflow";
1716 #else
1717 exception = &program_error;
1718 msg = "SIGBUS";
1719 #endif
1720 break;
1721 default:
1722 exception = &program_error;
1723 msg = "unhandled signal";
1724 }
1725
1726 Raise_From_Signal_Handler (exception, msg);
1727 }
1728
1729 static void
1730 __gnat_error_handler (int sig, int code, struct sigcontext *sc)
1731 {
1732 sigset_t mask;
1733 int result;
1734
1735 /* VxWorks will always mask out the signal during the signal handler and
1736 will reenable it on a longjmp. GNAT does not generate a longjmp to
1737 return from a signal handler so the signal will still be masked unless
1738 we unmask it. */
1739 sigprocmask (SIG_SETMASK, NULL, &mask);
1740 sigdelset (&mask, sig);
1741 sigprocmask (SIG_SETMASK, &mask, NULL);
1742
1743 /* VxWorks will suspend the task when it gets a hardware exception. We
1744 take the liberty of resuming the task for the application. */
1745 if (taskIsSuspended (taskIdSelf ()) != 0)
1746 taskResume (taskIdSelf ());
1747
1748 __gnat_map_signal (sig);
1749
1750 }
1751
1752 void
1753 __gnat_install_handler (void)
1754 {
1755 struct sigaction act;
1756
1757 /* Setup signal handler to map synchronous signals to appropriate
1758 exceptions. Make sure that the handler isn't interrupted by another
1759 signal that might cause a scheduling event! */
1760
1761 act.sa_handler = __gnat_error_handler;
1762 act.sa_flags = SA_SIGINFO | SA_ONSTACK;
1763 sigemptyset (&act.sa_mask);
1764
1765 /* For VxWorks, install all signal handlers, since pragma Interrupt_State
1766 applies to vectored hardware interrupts, not signals */
1767 sigaction (SIGFPE, &act, NULL);
1768 sigaction (SIGILL, &act, NULL);
1769 sigaction (SIGSEGV, &act, NULL);
1770 sigaction (SIGBUS, &act, NULL);
1771
1772 __gnat_handler_installed = 1;
1773 }
1774
1775 #define HAVE_GNAT_INIT_FLOAT
1776
1777 void
1778 __gnat_init_float (void)
1779 {
1780 /* Disable overflow/underflow exceptions on the PPC processor, this is needed
1781 to get correct Ada semantic. */
1782 #if defined (_ARCH_PPC) && !defined (_SOFT_FLOAT)
1783 asm ("mtfsb0 25");
1784 asm ("mtfsb0 26");
1785 #endif
1786
1787 /* Similarily for sparc64. Achieved by masking bits in the Trap Enable Mask
1788 field of the Floating-point Status Register (see the Sparc Architecture
1789 Manual Version 9, p 48). */
1790 #if defined (sparc64)
1791
1792 #define FSR_TEM_NVM (1 << 27) /* Invalid operand */
1793 #define FSR_TEM_OFM (1 << 26) /* Overflow */
1794 #define FSR_TEM_UFM (1 << 25) /* Underflow */
1795 #define FSR_TEM_DZM (1 << 24) /* Division by Zero */
1796 #define FSR_TEM_NXM (1 << 23) /* Inexact result */
1797 {
1798 unsigned int fsr;
1799
1800 __asm__("st %%fsr, %0" : "=m" (fsr));
1801 fsr &= ~(FSR_TEM_OFM | FSR_TEM_UFM);
1802 __asm__("ld %0, %%fsr" : : "m" (fsr));
1803 }
1804 #endif
1805 }
1806
1807 void
1808 __gnat_initialize (void)
1809 {
1810 __gnat_init_float ();
1811
1812 /* On targets where we might be using the ZCX scheme, we need to register
1813 the frame tables.
1814
1815 For application "modules", the crtstuff objects linked in (crtbegin/endS)
1816 are tailored to provide this service a-la C++ constructor fashion,
1817 typically triggered by the dynamic loader. This is achieved by way of a
1818 special variable declaration in the crt object, the name of which has
1819 been deduced by analyzing the output of the "munching" step documented
1820 for C++. The de-registration call is handled symetrically, a-la C++
1821 destructor fashion and typically triggered by the dynamic unloader. With
1822 this scheme, a mixed Ada/C++ application has to be linked and loaded as
1823 separate modules for each language, which is not unreasonable anyway.
1824
1825 For applications statically linked with the kernel, the module scheme
1826 above would lead to duplicated symbols because the VxWorks kernel build
1827 "munches" by default. To prevent those conflicts, we link against
1828 crtbegin/end objects that don't include the special variable and directly
1829 call the appropriate function here. We'll never unload that, so there is
1830 no de-registration to worry about.
1831
1832 We can differentiate by looking at the __module_has_ctors value provided
1833 by each class of crt objects. As of today, selecting the crt set intended
1834 for applications to be statically linked with the kernel is triggered by
1835 adding "-static" to the gcc *link* command line options.
1836
1837 This is a first approach, tightly synchronized with a number of GCC
1838 configuration and crtstuff changes. We need to ensure that those changes
1839 are there to activate this circuitry. */
1840
1841 #if DWARF2_UNWIND_INFO && defined (_ARCH_PPC)
1842 {
1843 extern const int __module_has_ctors;
1844 extern void __do_global_ctors ();
1845
1846 if (! __module_has_ctors)
1847 __do_global_ctors ();
1848 }
1849 #endif
1850 }
1851
1852 /********************************/
1853 /* __gnat_initialize for NetBSD */
1854 /********************************/
1855
1856 #elif defined(__NetBSD__)
1857
1858 #include <signal.h>
1859 #include <unistd.h>
1860
1861 static void
1862 __gnat_error_handler (int sig)
1863 {
1864 struct Exception_Data *exception;
1865 const char *msg;
1866
1867 switch(sig)
1868 {
1869 case SIGFPE:
1870 exception = &constraint_error;
1871 msg = "SIGFPE";
1872 break;
1873 case SIGILL:
1874 exception = &constraint_error;
1875 msg = "SIGILL";
1876 break;
1877 case SIGSEGV:
1878 exception = &storage_error;
1879 msg = "stack overflow or erroneous memory access";
1880 break;
1881 case SIGBUS:
1882 exception = &constraint_error;
1883 msg = "SIGBUS";
1884 break;
1885 default:
1886 exception = &program_error;
1887 msg = "unhandled signal";
1888 }
1889
1890 Raise_From_Signal_Handler(exception, msg);
1891 }
1892
1893 void
1894 __gnat_install_handler(void)
1895 {
1896 struct sigaction act;
1897
1898 act.sa_handler = __gnat_error_handler;
1899 act.sa_flags = SA_NODEFER | SA_RESTART;
1900 sigemptyset (&act.sa_mask);
1901
1902 /* Do not install handlers if interrupt state is "System" */
1903 if (__gnat_get_interrupt_state (SIGFPE) != 's')
1904 sigaction (SIGFPE, &act, NULL);
1905 if (__gnat_get_interrupt_state (SIGILL) != 's')
1906 sigaction (SIGILL, &act, NULL);
1907 if (__gnat_get_interrupt_state (SIGSEGV) != 's')
1908 sigaction (SIGSEGV, &act, NULL);
1909 if (__gnat_get_interrupt_state (SIGBUS) != 's')
1910 sigaction (SIGBUS, &act, NULL);
1911
1912 __gnat_handler_installed = 1;
1913 }
1914
1915 void
1916 __gnat_initialize (void)
1917 {
1918 __gnat_install_handler ();
1919 __gnat_init_float ();
1920 }
1921
1922 #else
1923
1924 /* For all other versions of GNAT, the initialize routine and handler
1925 installation do nothing */
1926
1927 /***************************************/
1928 /* __gnat_initialize (Default Version) */
1929 /***************************************/
1930
1931 void
1932 __gnat_initialize (void)
1933 {
1934 }
1935
1936 /********************************************/
1937 /* __gnat_install_handler (Default Version) */
1938 /********************************************/
1939
1940 void
1941 __gnat_install_handler (void)
1942 {
1943 __gnat_handler_installed = 1;
1944 }
1945
1946 #endif
1947
1948 /*********************/
1949 /* __gnat_init_float */
1950 /*********************/
1951
1952 /* This routine is called as each process thread is created, for possible
1953 initialization of the FP processor. This version is used under INTERIX,
1954 WIN32 and could be used under OS/2 */
1955
1956 #if defined (_WIN32) || defined (__INTERIX) || defined (__EMX__) \
1957 || defined (__Lynx__) || defined(__NetBSD__) || defined(__FreeBSD__)
1958
1959 #define HAVE_GNAT_INIT_FLOAT
1960
1961 void
1962 __gnat_init_float (void)
1963 {
1964 #if defined (__i386__) || defined (i386)
1965
1966 /* This is used to properly initialize the FPU on an x86 for each
1967 process thread. */
1968
1969 asm ("finit");
1970
1971 #endif /* Defined __i386__ */
1972 }
1973 #endif
1974
1975 #ifndef HAVE_GNAT_INIT_FLOAT
1976
1977 /* All targets without a specific __gnat_init_float will use an empty one */
1978 void
1979 __gnat_init_float (void)
1980 {
1981 }
1982 #endif