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