From 770db697e62902a236c8cb4cf0e8b6cc52051703 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 8 Apr 2008 08:43:15 +0200 Subject: [PATCH] s-osinte-linux-alpha.ads, [...]: Removed. 2008-04-08 Eric Botcazou Arnaud Charlet * s-osinte-linux-alpha.ads, s-osinte-linux-hppa.ads: Removed. s-taspri-posix-noaltstack.ads, s-linux.ads, s-linux-alpha.ads, s-linux-hppa.ads: New files. Disable alternate stack on ia64-hpux. * s-osinte-lynxos-3.ads, (Alternate_Stack): Remove when not needed. Simplify declaration otherwise. (Alternate_Stack_Size): New constant. s-osinte-mingw.ads, s-taprop-mingw.adb: Code clean up: avoid use of 'Unrestricted_Access. * s-osinte-hpux.ads, s-osinte-solaris-posix.ads, s-osinte-aix.ads, s-osinte-lynxos.ads, s-osinte-freebsd.ads s-osinte-darwin.ads, s-osinte-tru64.ads, s-osinte-irix.ads, s-osinte-linux.ads, s-osinte-solaris.ads, s-osinte-vms.ads (SA_ONSTACK): New constant. (stack_t): New record type. (sigaltstack): New imported function. (Alternate_Stack): New imported variable. (Alternate_Stack_Size): New constant. * system-linux-x86_64.ads: (Stack_Check_Probes): Set to True. * s-taspri-lynxos.ads, s-taspri-solaris.ads, s-taspri-tru64.ads, s-taspri-hpux-dce.ads (Task_Address): New subtype of System.Address (Task_Address_Size): New constant size of System.Address (Alternate_Stack_Size): New constant. * s-taprop-posix.adb, s-taprop-linux.adb (Get_Stack_Attributes): Delete. (Enter_Task): Do not notify stack to System.Stack_Checking.Operations. Establish the alternate stack if the platform makes use of n alternate signal stack for stack overflows. (Create_Task): Take into account the alternate stack in the stack size. (Initialize): Save the address of the alternate stack into the ATCB for the environment task. (Create_Task): Fix assertions for NPTL library (vs old LinuxThreads). * s-parame.adb (Minimum_Stack_Size): Increase value to 16K to * system-linux-x86.ads: (Stack_Check_Probes): Set to True. * s-intman-posix.adb: (Initialize): Set SA_ONSTACK for SIGSEGV if the platform makes use of an alternate signal stack for stack overflows. * init.c (__gnat_adjust_context_for_raise, Linux version): On i386 and x86-64, adjust the saved value of the stack pointer if the signal was raised by a stack checking probe. (HP-UX section): Use global __gnat_alternate_stack as signal handler stack and only for SIGSEGV. (Linux section): Likewise on x86 and x86-64. [VxWorks section] (__gnat_map_signal): Now static. (__gnat_error_handler): Not static any more. (__gnat_adjust_context_for_raise): New function. Signal context adjustment for PPC && !VTHREADS && !RTP, as required by the zcx propagation circuitry. (__gnat_error_handler): Second argument of a sigaction handler is a pointer, not an int, and is unused. Adjust signal context before mapping to exception. Install signal handlers for LynxOS case. * s-taskin.ads (Common_ATCB): New field Task_Alternate_Stack. (Task_Id): Set size to Task_Address_Size (To_Task_id): Unchecked convert from Task_Address vice System.Address (To_Address): Unchecked convert to Task_Address vice System.Address * s-tassta.adb (Task_Wrapper): Define the alternate stack and save its address into the ATCB if the platform makes use of an alternate signal stack for stack overflows. (Free_Task): Add call to Finalize_Attributes_Link. Add argument Relative_Deadline to pass the value specified for the task. This is not yet used for any target. * s-tassta.ads (Create_Task): Add argument Relative_Deadline to pass the value specified for the task. From-SVN: r134004 --- gcc/ada/init.c | 384 ++++++++++++------ gcc/ada/s-intman-posix.adb | 30 +- gcc/ada/s-linux-alpha.ads | 119 ++++++ gcc/ada/s-linux-hppa.ads | 131 ++++++ gcc/ada/s-linux.ads | 119 ++++++ gcc/ada/s-osinte-aix.ads | 22 +- gcc/ada/s-osinte-darwin.ads | 50 ++- gcc/ada/s-osinte-freebsd.ads | 42 +- gcc/ada/s-osinte-hpux.ads | 30 +- gcc/ada/s-osinte-linux-alpha.ads | 508 ----------------------- gcc/ada/s-osinte-linux-hppa.ads | 560 -------------------------- gcc/ada/s-osinte-linux.ads | 150 ++++--- gcc/ada/s-osinte-lynxos-3.ads | 3 + gcc/ada/s-osinte-lynxos.ads | 10 +- gcc/ada/s-osinte-mingw.ads | 300 ++++---------- gcc/ada/s-osinte-solaris-posix.ads | 27 +- gcc/ada/s-osinte-tru64.ads | 1 + gcc/ada/s-taprop-linux.adb | 104 ++--- gcc/ada/s-taprop-mingw.adb | 71 ++-- gcc/ada/s-taprop-posix.adb | 24 +- gcc/ada/s-taskin.ads | 17 +- gcc/ada/s-taspri-hpux-dce.ads | 12 + gcc/ada/s-taspri-lynxos.ads | 12 + gcc/ada/s-taspri-posix-noaltstack.ads | 124 ++++++ gcc/ada/s-taspri-solaris.ads | 12 + gcc/ada/s-taspri-tru64.ads | 12 + gcc/ada/s-tassta.adb | 69 ++-- gcc/ada/s-tassta.ads | 31 +- gcc/ada/system-linux-x86.ads | 4 +- gcc/ada/system-linux-x86_64.ads | 4 +- 30 files changed, 1308 insertions(+), 1674 deletions(-) create mode 100644 gcc/ada/s-linux-alpha.ads create mode 100644 gcc/ada/s-linux-hppa.ads create mode 100644 gcc/ada/s-linux.ads delete mode 100644 gcc/ada/s-osinte-linux-alpha.ads delete mode 100644 gcc/ada/s-osinte-linux-hppa.ads create mode 100644 gcc/ada/s-taspri-posix-noaltstack.ads diff --git a/gcc/ada/init.c b/gcc/ada/init.c index 2210ec89559..5dd78155688 100644 --- a/gcc/ada/init.c +++ b/gcc/ada/init.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2007, Free Software Foundation, Inc. * + * Copyright (C) 1992-2008, Free Software Foundation, Inc. * * * * GNAT is free software; you can redistribute it and/or modify it under * * terms of the GNU General Public License as published by the Free Soft- * @@ -30,21 +30,21 @@ * * ****************************************************************************/ -/* This unit contains initialization circuits that are system dependent. A - major part of the functionality involved involves stack overflow checking. +/* This unit contains initialization circuits that are system dependent. + A major part of the functionality involves stack overflow checking. The GCC backend generates probe instructions to test for stack overflow. For details on the exact approach used to generate these probes, see the "Using and Porting GCC" manual, in particular the "Stack Checking" section - and the subsection "Specifying How Stack Checking is Done". The handlers - installed by this file are used to handle resulting signals that come - from these probes failing (i.e. touching protected pages) */ + and the subsection "Specifying How Stack Checking is Done". The handlers + installed by this file are used to catch the resulting signals that come + from these probes failing (i.e. touching protected pages). */ /* This file should be kept synchronized with 2sinit.ads, 2sinit.adb, - s-init-ae653-cert.adb and s-init-xi-sparc.adb. All these files implement - the required functionality for different targets. */ + s-init-ae653-cert.adb and s-init-xi-sparc.adb. All these files implement + the required functionality for different targets. */ /* The following include is here to meet the published VxWorks requirement - that the __vxworks header appear before any other include. */ + that the __vxworks header appear before any other include. */ #ifdef __vxworks #include "vxWorks.h" #endif @@ -66,15 +66,15 @@ extern void __gnat_raise_program_error (const char *, int); -/* Addresses of exception data blocks for predefined exceptions. Tasking_Error - is not used in this unit, and the abort signal is only used on IRIX. */ +/* Addresses of exception data blocks for predefined exceptions. Tasking_Error + is not used in this unit, and the abort signal is only used on IRIX. */ extern struct Exception_Data constraint_error; extern struct Exception_Data numeric_error; extern struct Exception_Data program_error; extern struct Exception_Data storage_error; /* For the Cert run time we use the regular raise exception routine because - Raise_From_Signal_Handler is not available. */ + Raise_From_Signal_Handler is not available. */ #ifdef CERT #define Raise_From_Signal_Handler \ __gnat_raise_exception @@ -85,7 +85,7 @@ extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *); extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *); #endif -/* Global values computed by the binder */ +/* Global values computed by the binder. */ int __gl_main_priority = -1; int __gl_time_slice_val = -1; char __gl_wc_encoding = 'n'; @@ -104,18 +104,18 @@ int __gl_default_stack_size = -1; int __gl_leap_seconds_support = 0; /* Indication of whether synchronous signal handler has already been - installed by a previous call to adainit */ + installed by a previous call to adainit. */ int __gnat_handler_installed = 0; #ifndef IN_RTS int __gnat_inside_elab_final_code = 0; /* ??? This variable is obsolete since 2001-08-29 but is kept to allow - bootstrap from old GNAT versions (< 3.15). */ + bootstrap from old GNAT versions (< 3.15). */ #endif /* HAVE_GNAT_INIT_FLOAT must be set on every targets where a __gnat_init_float - is defined. If this is not set them a void implementation will be defined - at the end of this unit. */ + is defined. If this is not set then a void implementation will be defined + at the end of this unit. */ #undef HAVE_GNAT_INIT_FLOAT /******************************/ @@ -126,13 +126,13 @@ char __gnat_get_interrupt_state (int); /* This routine is called from the runtime as needed to determine the state of an interrupt, as set by an Interrupt_State pragma appearing anywhere - in the current partition. The input argument is the interrupt number, + in the current partition. The input argument is the interrupt number, and the result is one of the following: 'n' this interrupt not set by any Interrupt_State pragma 'u' Interrupt_State pragma set state to User 'r' Interrupt_State pragma set state to Runtime - 's' Interrupt_State pragma set state to System */ + 's' Interrupt_State pragma set state to System */ char __gnat_get_interrupt_state (int intrup) @@ -149,13 +149,13 @@ __gnat_get_interrupt_state (int intrup) char __gnat_get_specific_dispatching (int); -/* This routine is called from the run time as needed to determine the +/* This routine is called from the runtime as needed to determine the priority specific dispatching policy, as set by a Priority_Specific_Dispatching pragma appearing anywhere in the current - partition. The input argument is the priority number, and the result is - the upper case first character of the policy name, e.g. 'F' for + partition. The input argument is the priority number, and the result + is the upper case first character of the policy name, e.g. 'F' for FIFO_Within_Priorities. A space ' ' is returned if no - Priority_Specific_Dispatching pragma is used in the partition. */ + Priority_Specific_Dispatching pragma is used in the partition. */ char __gnat_get_specific_dispatching (int priority) @@ -175,7 +175,7 @@ __gnat_get_specific_dispatching (int priority) /**********************/ /* This routine is kept for bootstrapping purposes, since the binder generated - file now sets the __gl_* variables directly. */ + file now sets the __gl_* variables directly. */ void __gnat_set_globals () @@ -193,14 +193,14 @@ __gnat_set_globals () #include #include -/* Some versions of AIX don't define SA_NODEFER. */ +/* Some versions of AIX don't define SA_NODEFER. */ #ifndef SA_NODEFER #define SA_NODEFER 0 #endif /* SA_NODEFER */ /* Versions of AIX before 4.3 don't have nanosleep but provide - nsleep instead. */ + nsleep instead. */ #ifndef _AIXVERSION_430 @@ -241,7 +241,7 @@ __gnat_error_handler (int sig, siginfo_t * si, void * uc) switch (sig) { case SIGSEGV: - /* FIXME: we need to detect the case of a *real* SIGSEGV */ + /* FIXME: we need to detect the case of a *real* SIGSEGV. */ exception = &storage_error; msg = "stack overflow or erroneous memory access"; break; @@ -272,13 +272,13 @@ __gnat_install_handler (void) /* Set up signal handler to map synchronous signals to appropriate exceptions. Make sure that the handler isn't interrupted by another - signal that might cause a scheduling event! */ + signal that might cause a scheduling event! */ act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO; act.sa_sigaction = __gnat_error_handler; sigemptyset (&act.sa_mask); - /* Do not install handlers if interrupt state is "System" */ + /* Do not install handlers if interrupt state is "System". */ if (__gnat_get_interrupt_state (SIGABRT) != 's') sigaction (SIGABRT, &act, NULL); if (__gnat_get_interrupt_state (SIGFPE) != 's') @@ -408,13 +408,13 @@ __gnat_install_handler (void) /* Setup signal handler to map synchronous signals to appropriate exceptions. Make sure that the handler isn't interrupted by another - signal that might cause a scheduling event! */ + signal that might cause a scheduling event! */ act.sa_handler = (void (*) (int)) __gnat_error_handler; act.sa_flags = SA_RESTART | SA_NODEFER | SA_SIGINFO; sigemptyset (&act.sa_mask); - /* Do not install handlers if interrupt state is "System" */ + /* Do not install handlers if interrupt state is "System". */ if (__gnat_get_interrupt_state (SIGABRT) != 's') sigaction (SIGABRT, &act, NULL); if (__gnat_get_interrupt_state (SIGFPE) != 's') @@ -493,7 +493,7 @@ __gnat_error_handler switch (sig) { case SIGSEGV: - /* FIXME: we need to detect the case of a *real* SIGSEGV */ + /* FIXME: we need to detect the case of a *real* SIGSEGV. */ exception = &storage_error; msg = "stack overflow or erroneous memory access"; break; @@ -518,6 +518,13 @@ __gnat_error_handler Raise_From_Signal_Handler (exception, msg); } +/* This must be in keeping with System.OS_Interface.Alternate_Stack_Size. */ +#if defined (__hppa__) +char __gnat_alternate_stack[16 * 1024]; /* 2 * SIGSTKSZ */ +#else +char __gnat_alternate_stack[128 * 1024]; /* MINSIGSTKSZ */ +#endif + void __gnat_install_handler (void) { @@ -525,38 +532,33 @@ __gnat_install_handler (void) /* Set up signal handler to map synchronous signals to appropriate exceptions. Make sure that the handler isn't interrupted by another - signal that might cause a scheduling event! Also setup an alternate + signal that might cause a scheduling event! Also setup an alternate stack region for the handler execution so that stack overflows can be handled properly, avoiding a SEGV generation from stack usage by the - handler itself. */ - - static char handler_stack[SIGSTKSZ*2]; - /* SIGSTKSZ appeared to be "short" for the needs in some contexts - (e.g. experiments with GCC ZCX exceptions). */ + handler itself. */ stack_t stack; - - stack.ss_sp = handler_stack; - stack.ss_size = sizeof (handler_stack); + stack.ss_sp = __gnat_alternate_stack; + stack.ss_size = sizeof (__gnat_alternate_stack); stack.ss_flags = 0; - sigaltstack (&stack, NULL); act.sa_sigaction = __gnat_error_handler; - act.sa_flags = SA_NODEFER | SA_RESTART | SA_ONSTACK | SA_SIGINFO; + act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO; sigemptyset (&act.sa_mask); - /* Do not install handlers if interrupt state is "System" */ + /* Do not install handlers if interrupt state is "System". */ if (__gnat_get_interrupt_state (SIGABRT) != 's') sigaction (SIGABRT, &act, NULL); if (__gnat_get_interrupt_state (SIGFPE) != 's') sigaction (SIGFPE, &act, NULL); if (__gnat_get_interrupt_state (SIGILL) != 's') sigaction (SIGILL, &act, NULL); - if (__gnat_get_interrupt_state (SIGSEGV) != 's') - sigaction (SIGSEGV, &act, NULL); if (__gnat_get_interrupt_state (SIGBUS) != 's') sigaction (SIGBUS, &act, NULL); + act.sa_flags |= SA_ONSTACK; + if (__gnat_get_interrupt_state (SIGSEGV) != 's') + sigaction (SIGSEGV, &act, NULL); __gnat_handler_installed = 1; } @@ -574,7 +576,7 @@ __gnat_install_handler (void) #include /* GNU/Linux, which uses glibc, does not define NULL in included - header files */ + header files. */ #if !defined (NULL) #define NULL ((void *) 0) @@ -583,13 +585,13 @@ __gnat_install_handler (void) #if defined (MaRTE) /* MaRTE OS provides its own version of sigaction, sigfillset, and - sigemptyset (overriding these symbol names). We want to make sure that + sigemptyset (overriding these symbol names). We want to make sure that the versions provided by the underlying C library are used here (these versions are renamed by MaRTE to linux_sigaction, fake_linux_sigfillset, - and fake_linux_sigemptyset, respectively). The MaRTE library will not + and fake_linux_sigemptyset, respectively). The MaRTE library will not always be present (it will not be linked if no tasking constructs are used), so we use the weak symbol mechanism to point always to the symbols - defined within the C library. */ + defined within the C library. */ #pragma weak linux_sigaction int linux_sigaction (int signum, const struct sigaction *act, @@ -624,9 +626,34 @@ __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext) { mcontext_t *mcontext = &((ucontext_t *) ucontext)->uc_mcontext; + /* On the i386 and x86-64 architectures, stack checking is performed by + means of probes with moving stack pointer, that is to say the probed + address is always the value of the stack pointer. Upon hitting the + guard page, the stack pointer therefore points to an inaccessible + address and an alternate signal stack is needed to run the handler. + But there is an additional twist: on these architectures, the EH + return code writes the address of the handler at the target CFA's + value on the stack before doing the jump. As a consequence, if + there is an active handler in the frame whose stack has overflowed, + the stack pointer must nevertheless point to an accessible address + by the time the EH return is executed. + + We therefore adjust the saved value of the stack pointer by the size + of one page, in order to make sure that it points to an accessible + address in case it's used as the target CFA. The stack checking code + guarantees that this page is unused by the time this happens. */ + #if defined (i386) + unsigned long pattern = *(unsigned long *)mcontext->gregs[REG_EIP]; + /* The pattern is "orl $0x0,(%esp)" for a probe in 32-bit mode. */ + if (signo == SIGSEGV && pattern == 0x00240c83) + mcontext->gregs[REG_ESP] += 4096; mcontext->gregs[REG_EIP]++; #elif defined (__x86_64__) + unsigned long pattern = *(unsigned long *)mcontext->gregs[REG_RIP]; + /* The pattern is "orq $0x0,(%rsp)" for a probe in 64-bit mode. */ + if (signo == SIGSEGV && (pattern & 0xffffffffff) == 0x00240c8348) + mcontext->gregs[REG_RSP] += 4096; mcontext->gregs[REG_RIP]++; #elif defined (__ia64__) mcontext->sc_ip++; @@ -676,7 +703,7 @@ __gnat_error_handler (int sig, For now we simply do not attempt any discrimination at all. Note that this is quite acceptable, since a "real" SIGSEGV can only - occur as the result of an erroneous program */ + occur as the result of an erroneous program. */ msg = "stack overflow (or erroneous memory access)"; exception = &storage_error; @@ -701,14 +728,19 @@ __gnat_error_handler (int sig, /* We adjust the interrupted context here (and not in the MD_FALLBACK_FRAME_STATE_FOR macro) because recent versions of the Native - POSIX Thread Library (NPTL) are compiled with DWARF 2 unwind information, - and hence the later macro is never executed for signal frames. */ + POSIX Thread Library (NPTL) are compiled with DWARF-2 unwind information, + and hence the later macro is never executed for signal frames. */ __gnat_adjust_context_for_raise (sig, ucontext); Raise_From_Signal_Handler (exception, msg); } +#if defined (i386) || defined (__x86_64__) +/* This must be in keeping with System.OS_Interface.Alternate_Stack_Size. */ +char __gnat_alternate_stack[16 * 1024]; /* 2 * SIGSTKSZ */ +#endif + void __gnat_install_handler (void) { @@ -716,23 +748,37 @@ __gnat_install_handler (void) /* Set up signal handler to map synchronous signals to appropriate exceptions. Make sure that the handler isn't interrupted by another - signal that might cause a scheduling event! */ + signal that might cause a scheduling event! Also setup an alternate + stack region for the handler execution so that stack overflows can be + handled properly, avoiding a SEGV generation from stack usage by the + handler itself. */ + +#if defined (i386) || defined (__x86_64__) + stack_t stack; + stack.ss_sp = __gnat_alternate_stack; + stack.ss_size = sizeof (__gnat_alternate_stack); + stack.ss_flags = 0; + sigaltstack (&stack, NULL); +#endif act.sa_sigaction = __gnat_error_handler; act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO; sigemptyset (&act.sa_mask); - /* Do not install handlers if interrupt state is "System" */ + /* Do not install handlers if interrupt state is "System". */ if (__gnat_get_interrupt_state (SIGABRT) != 's') sigaction (SIGABRT, &act, NULL); if (__gnat_get_interrupt_state (SIGFPE) != 's') sigaction (SIGFPE, &act, NULL); if (__gnat_get_interrupt_state (SIGILL) != 's') sigaction (SIGILL, &act, NULL); - if (__gnat_get_interrupt_state (SIGSEGV) != 's') - sigaction (SIGSEGV, &act, NULL); if (__gnat_get_interrupt_state (SIGBUS) != 's') sigaction (SIGBUS, &act, NULL); +#if defined (i386) || defined (__x86_64__) + act.sa_flags |= SA_ONSTACK; +#endif + if (__gnat_get_interrupt_state (SIGSEGV) != 's') + sigaction (SIGSEGV, &act, NULL); __gnat_handler_installed = 1; } @@ -771,8 +817,7 @@ static void __gnat_error_handler (int, int, sigcontext_t *); also the signal number but the second argument is the signal code identifying the cause of the signal. The third argument points to a sigcontext_t structure containing the receiving - process's context when the signal was delivered. -*/ + process's context when the signal was delivered. */ static void __gnat_error_handler (int sig, int code, sigcontext_t *sc ATTRIBUTE_UNUSED) @@ -807,7 +852,7 @@ __gnat_error_handler (int sig, int code, sigcontext_t *sc ATTRIBUTE_UNUSED) /* ??? Re-add smarts to further verify that we launched the stack into a guard page, not an attempt to - write to .text or something */ + write to .text or something. */ exception = &storage_error; msg = "SIGSEGV: (stack overflow or erroneous memory access)"; } @@ -816,7 +861,7 @@ __gnat_error_handler (int sig, int code, sigcontext_t *sc ATTRIBUTE_UNUSED) /* Just in case the OS guys did it to us again. Sometimes they fail to document all of the valid codes that are passed to signal handlers, just in case someone depends - on knowing all the codes */ + on knowing all the codes. */ exception = &program_error; msg = "SIGSEGV: (Undocumented reason)"; } @@ -846,7 +891,7 @@ __gnat_error_handler (int sig, int code, sigcontext_t *sc ATTRIBUTE_UNUSED) break; default: - /* Everything else is a Program_Error. */ + /* Everything else is a Program_Error. */ exception = &program_error; msg = "unhandled signal"; } @@ -861,14 +906,14 @@ __gnat_install_handler (void) /* Setup signal handler to map synchronous signals to appropriate exceptions. Make sure that the handler isn't interrupted by another - signal that might cause a scheduling event! */ + signal that might cause a scheduling event! */ act.sa_handler = __gnat_error_handler; act.sa_flags = SA_NODEFER + SA_RESTART; sigfillset (&act.sa_mask); sigemptyset (&act.sa_mask); - /* Do not install handlers if interrupt state is "System" */ + /* Do not install handlers if interrupt state is "System". */ if (__gnat_get_interrupt_state (SIGABRT) != 's') sigaction (SIGABRT, &act, NULL); if (__gnat_get_interrupt_state (SIGFPE) != 's') @@ -885,6 +930,69 @@ __gnat_install_handler (void) __gnat_handler_installed = 1; } +/*******************/ +/* LynxOS Section */ +/*******************/ + +#elif defined (__Lynx__) + +#include +#include + +static void +__gnat_error_handler (int sig) +{ + struct Exception_Data *exception; + const char *msg; + + switch(sig) + { + case SIGFPE: + exception = &constraint_error; + msg = "SIGFPE"; + break; + case SIGILL: + exception = &constraint_error; + msg = "SIGILL"; + break; + case SIGSEGV: + exception = &storage_error; + msg = "stack overflow or erroneous memory access"; + break; + case SIGBUS: + exception = &constraint_error; + msg = "SIGBUS"; + break; + default: + exception = &program_error; + msg = "unhandled signal"; + } + + Raise_From_Signal_Handler(exception, msg); +} + +void +__gnat_install_handler(void) +{ + struct sigaction act; + + act.sa_handler = __gnat_error_handler; + act.sa_flags = 0x0; + sigemptyset (&act.sa_mask); + + /* Do not install handlers if interrupt state is "System". */ + if (__gnat_get_interrupt_state (SIGFPE) != 's') + sigaction (SIGFPE, &act, NULL); + if (__gnat_get_interrupt_state (SIGILL) != 's') + sigaction (SIGILL, &act, NULL); + if (__gnat_get_interrupt_state (SIGSEGV) != 's') + sigaction (SIGSEGV, &act, NULL); + if (__gnat_get_interrupt_state (SIGBUS) != 's') + sigaction (SIGBUS, &act, NULL); + + __gnat_handler_installed = 1; +} + /*******************/ /* Solaris Section */ /*******************/ @@ -896,7 +1004,7 @@ __gnat_install_handler (void) #include #include -/* The code below is common to sparc and x86. Beware of the delay slot +/* The code below is common to SPARC and x86. Beware of the delay slot differences for signal context adjustments. */ #if defined (__sparc) @@ -907,7 +1015,7 @@ __gnat_install_handler (void) /* Likewise regarding how the "instruction pointer" register slot can be identified in signal machine contexts. We have either "REG_PC" - or "PC" at hand, depending on the target CPU and solaris version. */ + or "PC" at hand, depending on the target CPU and Solaris version. */ #if !defined (REG_PC) #define REG_PC PC @@ -1005,13 +1113,13 @@ __gnat_install_handler (void) /* Set up signal handler to map synchronous signals to appropriate exceptions. Make sure that the handler isn't interrupted by another - signal that might cause a scheduling event! */ + signal that might cause a scheduling event! */ act.sa_handler = __gnat_error_handler; act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO; sigemptyset (&act.sa_mask); - /* Do not install handlers if interrupt state is "System" */ + /* Do not install handlers if interrupt state is "System". */ if (__gnat_get_interrupt_state (SIGABRT) != 's') sigaction (SIGABRT, &act, NULL); if (__gnat_get_interrupt_state (SIGFPE) != 's') @@ -1044,8 +1152,8 @@ long __gnat_error_handler (int *, void *); #if defined (IN_RTS) && !defined (__IA64) -/* The prehandler actually gets control first on a condition. It swaps the - stack pointer and calls the handler (__gnat_error_handler). */ +/* The prehandler actually gets control first on a condition. It swaps the + stack pointer and calls the handler (__gnat_error_handler). */ extern long __gnat_error_prehandler (void); extern char *__gnat_error_prehandler_stack; /* Alternate signal stack */ @@ -1053,16 +1161,16 @@ extern char *__gnat_error_prehandler_stack; /* Alternate signal stack */ /* Define macro symbols for the VMS conditions that become Ada exceptions. Most of these are also defined in the header file ssdef.h which has not - yet been converted to be recognized by Gnu C. */ + yet been converted to be recognized by GNU C. */ /* Defining these as macros, as opposed to external addresses, allows - them to be used in a case statement (below */ + them to be used in a case statement below. */ #define SS$_ACCVIO 12 #define SS$_HPARITH 1284 #define SS$_STKOVF 1364 #define SS$_RESIGNAL 2328 -/* These codes are in standard message libraries */ +/* These codes are in standard message libraries. */ extern int CMA$_EXIT_THREAD; extern int SS$_DEBUG; extern int SS$_INTDIV; @@ -1072,7 +1180,7 @@ extern int MTH$_FLOOVEMAT; /* Some ACVC_21 CXA tests */ /* These codes are non standard, which is to say the author is not sure if they are defined in the standard message libraries - so keep them as macros for now. */ + so keep them as macros for now. */ #define RDB$_STREAM_EOF 20480426 #define FDL$_UNPRIKW 11829410 @@ -1085,8 +1193,8 @@ struct descriptor_s {unsigned short len, mbz; __char_ptr32 adr; }; /* Conditions that don't have an Ada exception counterpart must raise Non_Ada_Error. Since this is defined in s-auxdec, it should only be - referenced by user programs, not the compiler or tools. Hence the - #ifdef IN_RTS. */ + referenced by user programs, not the compiler or tools. Hence the + #ifdef IN_RTS. */ #ifdef IN_RTS @@ -1124,7 +1232,7 @@ extern struct Exception_Data *Coded_Exception (Exception_Code); extern Exception_Code Base_Code_In (Exception_Code); /* DEC Ada exceptions are not defined in a header file, so they - must be declared as external addresses */ + must be declared as external addresses. */ extern int ADA$_PROGRAM_ERROR; extern int ADA$_LOCK_ERROR; @@ -1156,7 +1264,7 @@ extern int ADA$_KEY_MISMATCH; extern int ADA$_MAXLINEXC; extern int ADA$_LINEXCMRS; -/* DEC Ada specific conditions */ +/* DEC Ada specific conditions. */ static const struct cond_except dec_ada_cond_except_table [] = { {&ADA$_PROGRAM_ERROR, &program_error}, {&ADA$_USE_ERROR, &Use_Error}, @@ -1198,8 +1306,8 @@ static const struct cond_except dec_ada_cond_except_table [] = { #endif /* IN_RTS */ -/* Non DEC Ada specific conditions. We could probably also put - SS$_HPARITH here and possibly SS$_ACCVIO, SS$_STKOVF. */ +/* Non-DEC Ada specific conditions. We could probably also put + SS$_HPARITH here and possibly SS$_ACCVIO, SS$_STKOVF. */ static const struct cond_except cond_except_table [] = { {&MTH$_FLOOVEMAT, &constraint_error}, {&SS$_INTDIV, &constraint_error}, @@ -1212,7 +1320,7 @@ static const struct cond_except cond_except_table [] = { still need to be handled by such handlers, however, in which case __gnat_error_handler needs to return SS$_RESIGNAL. Consider for instance the use of a third party library compiled with DECAda and - performing it's own exception handling internally. + performing its own exception handling internally. To allow some user-level flexibility, which conditions should be resignaled is controlled by a predicate function, provided with the @@ -1290,12 +1398,12 @@ __gnat_set_resignal_predicate (resignal_predicate * predicate) __gnat_resignal_p = predicate; } -/* Should match System.Parameters.Default_Exception_Msg_Max_Length */ +/* Should match System.Parameters.Default_Exception_Msg_Max_Length. */ #define Default_Exception_Msg_Max_Length 512 -/* Action routine for SYS$PUTMSG. There may be - multiple conditions, each with text to be appended to - MESSAGE and separated by line termination. */ +/* Action routine for SYS$PUTMSG. There may be multiple + conditions, each with text to be appended to MESSAGE + and separated by line termination. */ static int copy_msg (msgdesc, message) @@ -1305,14 +1413,14 @@ copy_msg (msgdesc, message) int len = strlen (message); int copy_len; - /* Check for buffer overflow and skip */ + /* Check for buffer overflow and skip. */ if (len > 0 && len <= Default_Exception_Msg_Max_Length - 3) { strcat (message, "\r\n"); len += 2; } - /* Check for buffer overflow and truncate if necessary */ + /* Check for buffer overflow and truncate if necessary. */ copy_len = (len + msgdesc->len <= Default_Exception_Msg_Max_Length - 1 ? msgdesc->len : Default_Exception_Msg_Max_Length - 1 - len); @@ -1338,7 +1446,7 @@ __gnat_handle_vms_condition (int *sigargs, void *mechargs) return SS$_RESIGNAL; #ifdef IN_RTS - /* See if it's an imported exception. Beware that registered exceptions + /* See if it's an imported exception. Beware that registered exceptions are bound to their base code, with the severity bits masked off. */ base_code = Base_Code_In ((Exception_Code) sigargs [1]); exception = Coded_Exception (base_code); @@ -1347,14 +1455,14 @@ __gnat_handle_vms_condition (int *sigargs, void *mechargs) { message [0] = 0; - /* Subtract PC & PSL fields which messes with PUTMSG */ + /* Subtract PC & PSL fields which messes with PUTMSG. */ sigargs [0] -= 2; SYS$PUTMSG (sigargs, copy_msg, &gnat_facility, message); sigargs [0] += 2; msg = message; exception->Name_Length = 19; - /* The full name really should be get sys$getmsg returns. ??? */ + /* ??? The full name really should be get sys$getmsg returns. */ exception->Full_Name = "IMPORTED_EXCEPTION"; exception->Import_Code = base_code; @@ -1396,7 +1504,7 @@ __gnat_handle_vms_condition (int *sigargs, void *mechargs) exception = &constraint_error; msg = "arithmetic error"; #ifndef __alpha__ - /* No need to adjust pc on alpha: the pc is already on the instruction + /* No need to adjust pc on Alpha: the pc is already on the instruction after the trapping one. */ __gnat_adjust_context_for_raise (0, (void *)mechargs); #endif @@ -1409,7 +1517,7 @@ __gnat_handle_vms_condition (int *sigargs, void *mechargs) int i; /* Scan the DEC Ada exception condition table for a match and fetch - the associated GNAT exception pointer */ + the associated GNAT exception pointer. */ for (i = 0; dec_ada_cond_except_table [i].cond && !LIB$MATCH_COND (&sigargs [1], @@ -1421,7 +1529,7 @@ __gnat_handle_vms_condition (int *sigargs, void *mechargs) if (!exception) { /* Scan the VMS standard condition table for a match and fetch - the associated GNAT exception pointer */ + the associated GNAT exception pointer. */ for (i = 0; cond_except_table [i].cond && !LIB$MATCH_COND (&sigargs [1], &cond_except_table [i].cond); @@ -1431,7 +1539,7 @@ __gnat_handle_vms_condition (int *sigargs, void *mechargs) if (!exception) /* User programs expect Non_Ada_Error to be raised, reference - DEC Ada test CXCONDHAN. */ + DEC Ada test CXCONDHAN. */ exception = &Non_Ada_Error; } } @@ -1439,7 +1547,7 @@ __gnat_handle_vms_condition (int *sigargs, void *mechargs) exception = &program_error; #endif message [0] = 0; - /* Subtract PC & PSL fields which messes with PUTMSG */ + /* Subtract PC & PSL fields which messes with PUTMSG. */ sigargs [0] -= 2; SYS$PUTMSG (sigargs, copy_msg, &gnat_facility, message); sigargs [0] += 2; @@ -1483,7 +1591,7 @@ __gnat_install_handler (void) __gnat_handler_installed = 1; } -/* __gnat_adjust_context_for_raise for alpha - see comments along with the +/* __gnat_adjust_context_for_raise for Alpha - see comments along with the default version later in this file. */ #if defined (IN_RTS) && defined (__alpha__) @@ -1613,7 +1721,7 @@ __gnat_install_handler () /* Set up signal handler to map synchronous signals to appropriate exceptions. Make sure that the handler isn't interrupted by another - signal that might cause a scheduling event! */ + signal that might cause a scheduling event! */ act.sa_sigaction = (void (*)(int, struct __siginfo *, void*)) __gnat_error_handler; @@ -1646,16 +1754,15 @@ __gnat_install_handler () #include "private/vThreadsP.h" #endif -static void __gnat_error_handler (int, int, struct sigcontext *); -void __gnat_map_signal (int); +void __gnat_error_handler (int, void *, struct sigcontext *); #ifndef __RTP__ -/* Directly vectored Interrupt routines are not supported when using RTPs */ +/* Directly vectored Interrupt routines are not supported when using RTPs. */ extern int __gnat_inum_to_ivec (int); -/* This is needed by the GNAT run time to handle Vxworks interrupts */ +/* This is needed by the GNAT run time to handle Vxworks interrupts. */ int __gnat_inum_to_ivec (int num) { @@ -1666,7 +1773,7 @@ __gnat_inum_to_ivec (int num) #if !defined(__alpha_vxworks) && (_WRS_VXWORKS_MAJOR != 6) && !defined(__RTP__) /* getpid is used by s-parint.adb, but is not defined by VxWorks, except - on Alpha VxWorks and VxWorks 6.x (including RTPs). */ + on Alpha VxWorks and VxWorks 6.x (including RTPs). */ extern long getpid (void); @@ -1678,7 +1785,7 @@ getpid (void) #endif /* VxWorks expects the field excCnt to be zeroed when a signal is handled. - The VxWorks version of longjmp does this; gcc's builtin_longjmp does not */ + The VxWorks version of longjmp does this; GCC's builtin_longjmp doesn't. */ void __gnat_clear_exception_count (void) { @@ -1689,9 +1796,37 @@ __gnat_clear_exception_count (void) #endif } -/* Exported to s-intman-vxworks.adb in order to handle different signal - to exception mappings in different VxWorks versions */ + +/* VxWorks context adjustment for targets that need/support it. */ + +void __gnat_adjust_context_for_raise (int, void*); + +#if defined (_ARCH_PPC) && !defined (VTHREADS) && !defined (__RTP__) + +#define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE + +/* We need the constant and structure definitions describing the machine + state. Part of this is normally retrieved from the VxWorks "regs.h" but + #including it here gets the GCC internals instance of this file instead. + We need to #include the version we need directly here, and prevent the + possibly indirect inclusion of the GCC one, as its contents is useless to + us and it depends on several other headers that we don't have at hand. */ +#include +#define GCC_REGS_H +#include + void +__gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *sigcontext) +{ + REG_SET * mcontext = ((struct sigcontext *) sigcontext)->sc_pregs; + mcontext->pc++; +} + +#endif + +/* Handle different SIGnal to exception mappings in different VxWorks + versions. */ +static void __gnat_map_signal (int sig) { struct Exception_Data *exception; @@ -1754,22 +1889,25 @@ __gnat_map_signal (int sig) Raise_From_Signal_Handler (exception, msg); } -static void -__gnat_error_handler (int sig, int code, struct sigcontext *sc) +/* Tasking and Non-tasking signal handler. Map SIGnal to Ada exception + propagation after the required low level adjustments. */ + +void +__gnat_error_handler (int sig, void * si ATTRIBUTE_UNUSED, + struct sigcontext * sc) { sigset_t mask; - int result; /* VxWorks will always mask out the signal during the signal handler and will reenable it on a longjmp. GNAT does not generate a longjmp to return from a signal handler so the signal will still be masked unless - we unmask it. */ + we unmask it. */ sigprocmask (SIG_SETMASK, NULL, &mask); sigdelset (&mask, sig); sigprocmask (SIG_SETMASK, &mask, NULL); + __gnat_adjust_context_for_raise (sig, (void *)sc); __gnat_map_signal (sig); - } void @@ -1779,14 +1917,14 @@ __gnat_install_handler (void) /* Setup signal handler to map synchronous signals to appropriate exceptions. Make sure that the handler isn't interrupted by another - signal that might cause a scheduling event! */ + signal that might cause a scheduling event! */ act.sa_handler = __gnat_error_handler; act.sa_flags = SA_SIGINFO | SA_ONSTACK; sigemptyset (&act.sa_mask); /* For VxWorks, install all signal handlers, since pragma Interrupt_State - applies to vectored hardware interrupts, not signals */ + applies to vectored hardware interrupts, not signals. */ sigaction (SIGFPE, &act, NULL); sigaction (SIGILL, &act, NULL); sigaction (SIGSEGV, &act, NULL); @@ -1800,10 +1938,10 @@ __gnat_install_handler (void) void __gnat_init_float (void) { - /* Disable overflow/underflow exceptions on the PPC processor, this is needed + /* Disable overflow/underflow exceptions on the PPC processor, needed to get correct Ada semantics. Note that for AE653 vThreads, the HW overflow settings are an OS configuration issue. The instructions - below have no effect */ + below have no effect. */ #if defined (_ARCH_PPC) && !defined (_SOFT_FLOAT) && !defined (VTHREADS) asm ("mtfsb0 25"); asm ("mtfsb0 26"); @@ -1811,11 +1949,11 @@ __gnat_init_float (void) #if (defined (__i386__) || defined (i386)) && !defined (VTHREADS) /* This is used to properly initialize the FPU on an x86 for each - process thread. */ + process thread. */ asm ("finit"); #endif - /* Similarly for sparc64. Achieved by masking bits in the Trap Enable Mask + /* Similarly for SPARC64. Achieved by masking bits in the Trap Enable Mask field of the Floating-point Status Register (see the SPARC Architecture Manual Version 9, p 48). */ #if defined (sparc64) @@ -1893,7 +2031,7 @@ __gnat_install_handler(void) act.sa_flags = SA_NODEFER | SA_RESTART; sigemptyset (&act.sa_mask); - /* Do not install handlers if interrupt state is "System" */ + /* Do not install handlers if interrupt state is "System". */ if (__gnat_get_interrupt_state (SIGFPE) != 's') sigaction (SIGFPE, &act, NULL); if (__gnat_get_interrupt_state (SIGILL) != 's') @@ -1971,7 +2109,7 @@ __gnat_install_handler(void) #else -/* For all other versions of GNAT, the handler does nothing */ +/* For all other versions of GNAT, the handler does nothing. */ /*******************/ /* Default Section */ @@ -1990,8 +2128,8 @@ __gnat_install_handler (void) /*********************/ /* This routine is called as each process thread is created, for possible - initialization of the FP processor. This version is used under INTERIX, - WIN32 and could be used under OS/2 */ + initialization of the FP processor. This version is used under INTERIX, + WIN32 and could be used under OS/2. */ #if defined (_WIN32) || defined (__INTERIX) || defined (__EMX__) \ || defined (__Lynx__) || defined(__NetBSD__) || defined(__FreeBSD__) \ @@ -2005,7 +2143,7 @@ __gnat_init_float (void) #if defined (__i386__) || defined (i386) /* This is used to properly initialize the FPU on an x86 for each - process thread. */ + process thread. */ asm ("finit"); @@ -2015,7 +2153,7 @@ __gnat_init_float (void) #ifndef HAVE_GNAT_INIT_FLOAT -/* All targets without a specific __gnat_init_float will use an empty one */ +/* All targets without a specific __gnat_init_float will use an empty one. */ void __gnat_init_float (void) { @@ -2028,7 +2166,7 @@ __gnat_init_float (void) #ifndef HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE -/* All targets without a specific version will use an empty one */ +/* All targets without a specific version will use an empty one. */ /* Given UCONTEXT a pointer to a context structure received by a signal handler for SIGNO, perform the necessary adjustments to let the handler diff --git a/gcc/ada/s-intman-posix.adb b/gcc/ada/s-intman-posix.adb index 38379dd1ecb..06a7b450029 100644 --- a/gcc/ada/s-intman-posix.adb +++ b/gcc/ada/s-intman-posix.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -59,6 +59,8 @@ -- default -- Reserved: the OS specific set of signals that are reserved. +with System.Task_Primitives; + package body System.Interrupt_Management is use Interfaces.C; @@ -117,7 +119,7 @@ package body System.Interrupt_Management is begin -- With the __builtin_longjmp, the signal mask is not restored, so we - -- need to restore it explicitely. + -- need to restore it explicitly. Result := pthread_sigmask (SIG_UNBLOCK, Signal_Mask'Access, null); pragma Assert (Result = 0); @@ -155,6 +157,10 @@ package body System.Interrupt_Management is old_act : aliased struct_sigaction; Result : System.OS_Interface.int; + Use_Alternate_Stack : constant Boolean := + System.Task_Primitives.Alternate_Stack_Size /= 0; + -- Whether to use an alternate signal stack for stack overflows + begin if Initialized then return; @@ -171,8 +177,6 @@ package body System.Interrupt_Management is act.sa_handler := Notify_Exception'Address; - act.sa_flags := SA_SIGINFO; - -- Setting SA_SIGINFO asks the kernel to pass more than just the signal -- number argument to the handler when it is called. The set of extra -- parameters includes a pointer to the interrupted context, which the @@ -191,7 +195,7 @@ package body System.Interrupt_Management is -- fix should be made in sigsetjmp so that we save the Signal_Set and -- restore it after a longjmp. - -- Since SA_NODEFER is obsolete, instead we reset explicitely the mask + -- Since SA_NODEFER is obsolete, instead we reset explicitly the mask -- in the exception handler. Result := sigemptyset (Signal_Mask'Access); @@ -220,10 +224,18 @@ package body System.Interrupt_Management is Reserve (Exception_Interrupts (J)) := True; if State (Exception_Interrupts (J)) /= Default then + act.sa_flags := SA_SIGINFO; + + if Use_Alternate_Stack + and then Exception_Interrupts (J) = SIGSEGV + then + act.sa_flags := act.sa_flags + SA_ONSTACK; + end if; + Result := sigaction - (Signal (Exception_Interrupts (J)), act'Unchecked_Access, - old_act'Unchecked_Access); + (Signal (Exception_Interrupts (J)), act'Unchecked_Access, + old_act'Unchecked_Access); pragma Assert (Result = 0); end if; end if; @@ -235,7 +247,7 @@ package body System.Interrupt_Management is end if; -- Set SIGINT to unmasked state as long as it is not in "User" state. - -- Check for Unreserve_All_Interrupts last + -- Check for Unreserve_All_Interrupts last. if State (SIGINT) /= User then Keep_Unmasked (SIGINT) := True; @@ -243,7 +255,7 @@ package body System.Interrupt_Management is end if; -- Check all signals for state that requires keeping them unmasked and - -- reserved + -- reserved. for J in Interrupt_ID'Range loop if State (J) = Default or else State (J) = Runtime then diff --git a/gcc/ada/s-linux-alpha.ads b/gcc/ada/s-linux-alpha.ads new file mode 100644 index 00000000000..b2fd28f5672 --- /dev/null +++ b/gcc/ada/s-linux-alpha.ads @@ -0,0 +1,119 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- S Y S T E M . L I N U X -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2008, Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +------------------------------------------------------------------------------ + +-- This is the alpha version of this package + +-- This package encapsulates cpu specific differences between implementations +-- of GNU/Linux, in order to share s-osinte-linux.ads. + +-- PLEASE DO NOT add any with-clauses to this package or remove the pragma +-- Preelaborate. This package is designed to be a bottom-level (leaf) package. + +with Interfaces.C; + +package System.Linux is + pragma Preelaborate; + + ----------- + -- Errno -- + ----------- + + EAGAIN : constant := 35; + EINTR : constant := 4; + EINVAL : constant := 22; + ENOMEM : constant := 12; + EPERM : constant := 1; + ETIMEDOUT : constant := 60; + + ------------- + -- Signals -- + ------------- + + SIGHUP : constant := 1; -- hangup + SIGINT : constant := 2; -- interrupt (rubout) + SIGQUIT : constant := 3; -- quit (ASCD FS) + SIGILL : constant := 4; -- illegal instruction (not reset) + SIGTRAP : constant := 5; -- trace trap (not reset) + SIGIOT : constant := 6; -- IOT instruction + SIGABRT : constant := 6; -- used by abort, replace SIGIOT in the future + SIGFPE : constant := 8; -- floating point exception + SIGKILL : constant := 9; -- kill (cannot be caught or ignored) + SIGBUS : constant := 10; -- bus error + SIGSEGV : constant := 11; -- segmentation violation + SIGPIPE : constant := 13; -- write on a pipe with no one to read it + SIGALRM : constant := 14; -- alarm clock + SIGTERM : constant := 15; -- software termination signal from kill + SIGURG : constant := 16; -- urgent condition on IO channel + SIGSTOP : constant := 17; -- stop (cannot be caught or ignored) + SIGTSTP : constant := 18; -- user stop requested from tty + SIGCONT : constant := 19; -- stopped process has been continued + SIGCLD : constant := 20; -- alias for SIGCHLD + SIGCHLD : constant := 20; -- child status change + SIGTTIN : constant := 21; -- background tty read attempted + SIGTTOU : constant := 22; -- background tty write attempted + SIGIO : constant := 23; -- I/O now possible (4.2 BSD) + SIGPOLL : constant := 23; -- pollable event occurred + SIGXCPU : constant := 24; -- CPU time limit exceeded + SIGXFSZ : constant := 25; -- filesize limit exceeded + SIGVTALRM : constant := 26; -- virtual timer expired + SIGPROF : constant := 27; -- profiling timer expired + SIGWINCH : constant := 28; -- window size change + SIGPWR : constant := 29; -- power-fail restart + SIGUSR1 : constant := 30; -- user defined signal 1 + SIGUSR2 : constant := 31; -- user defined signal 2 + + SIGLTHRRES : constant := 32; -- GNU/LinuxThreads restart signal + SIGLTHRCAN : constant := 33; -- GNU/LinuxThreads cancel signal + SIGLTHRDBG : constant := 34; -- GNU/LinuxThreads debugger signal + + SIGADAABORT : constant := SIGABRT; + -- Change this if you want to use another signal for task abort. + -- SIGTERM might be a good one. + + SIGUNUSED : constant := 0; + SIGSTKFLT : constant := 0; + SIGLOST : constant := 0; + -- These don't exist for Linux/Alpha. The constants are present + -- so that we can continue to use a-intnam-linux.ads. + + -- struct_sigaction offsets + + sa_mask_pos : constant := Standard'Address_Size / 8; + sa_flags_pos : constant := 128 + sa_mask_pos; + + SA_SIGINFO : constant := 16#40#; + SA_ONSTACK : constant := 16#01#; + + type pthread_mutex_t is record + dum0, dum1, dum2, dum3, dum4 : Interfaces.C.unsigned_long; + end record; + pragma Convention (C, pthread_mutex_t); + +end System.Linux; diff --git a/gcc/ada/s-linux-hppa.ads b/gcc/ada/s-linux-hppa.ads new file mode 100644 index 00000000000..841ff78c17e --- /dev/null +++ b/gcc/ada/s-linux-hppa.ads @@ -0,0 +1,131 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- S Y S T E M . L I N U X -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2008, Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +------------------------------------------------------------------------------ + +-- This is the hppa version of this package + +-- This package encapsulates cpu specific differences between implementations +-- of GNU/Linux, in order to share s-osinte-linux.ads. + +-- PLEASE DO NOT add any with-clauses to this package or remove the pragma +-- Preelaborate. This package is designed to be a bottom-level (leaf) package. + +package System.Linux is + pragma Preelaborate; + + ----------- + -- Errno -- + ----------- + + EAGAIN : constant := 11; + EINTR : constant := 4; + EINVAL : constant := 22; + ENOMEM : constant := 12; + EPERM : constant := 1; + ETIMEDOUT : constant := 238; + + ------------- + -- Signals -- + ------------- + + SIGHUP : constant := 1; -- hangup + SIGINT : constant := 2; -- interrupt (rubout) + SIGQUIT : constant := 3; -- quit (ASCD FS) + SIGILL : constant := 4; -- illegal instruction (not reset) + SIGTRAP : constant := 5; -- trace trap (not reset) + SIGIOT : constant := 6; -- IOT instruction + SIGABRT : constant := 6; -- used by abort, replace SIGIOT in the future + SIGEMT : constant := 7; -- EMT + SIGFPE : constant := 8; -- floating point exception + SIGKILL : constant := 9; -- kill (cannot be caught or ignored) + SIGBUS : constant := 10; -- bus error + SIGSEGV : constant := 11; -- segmentation violation + SIGSYS : constant := 12; -- bad system call + SIGPIPE : constant := 13; -- write on a pipe with no one to read it + SIGALRM : constant := 14; -- alarm clock + SIGTERM : constant := 15; -- software termination signal from kill + SIGUSR1 : constant := 16; -- user defined signal 1 + SIGUSR2 : constant := 17; -- user defined signal 2 + SIGCLD : constant := 18; -- alias for SIGCHLD + SIGCHLD : constant := 18; -- child status change + SIGPWR : constant := 19; -- power-fail restart + SIGVTALRM : constant := 20; -- virtual timer expired + SIGPROF : constant := 21; -- profiling timer expired + SIGPOLL : constant := 22; -- pollable event occurred + SIGIO : constant := 22; -- I/O now possible (4.2 BSD) + SIGWINCH : constant := 23; -- window size change + SIGSTOP : constant := 24; -- stop (cannot be caught or ignored) + SIGTSTP : constant := 25; -- user stop requested from tty + SIGCONT : constant := 26; -- stopped process has been continued + SIGTTIN : constant := 27; -- background tty read attempted + SIGTTOU : constant := 28; -- background tty write attempted + SIGURG : constant := 29; -- urgent condition on IO channel + SIGLOST : constant := 30; -- File lock lost + SIGUNUSED : constant := 31; -- unused signal (GNU/Linux) + SIGXCPU : constant := 33; -- CPU time limit exceeded + SIGXFSZ : constant := 34; -- filesize limit exceeded + SIGSTKFLT : constant := 36; -- coprocessor stack fault (Linux) + SIGLTHRRES : constant := 37; -- GNU/LinuxThreads restart signal + SIGLTHRCAN : constant := 38; -- GNU/LinuxThreads cancel signal + SIGLTHRDBG : constant := 39; -- GNU/LinuxThreads debugger signal + + -- struct_sigaction offsets + + sa_flags_pos : constant := Standard'Address_Size / 8; + sa_mask_pos : constant := sa_flags_pos * 2; + + SA_SIGINFO : constant := 16#10#; + SA_ONSTACK : constant := 16#01#; + + type lock_array is array (1 .. 4) of int; + type atomic_lock_t is record + lock : lock_array; + end record; + pragma Convention (C, atomic_lock_t); + -- ??? Alignment should be 16 but this is larger than BIGGEST_ALIGNMENT. + -- This causes an erroneous pointer value to sometimes be passed to free + -- during deallocation. See PR ada/24533 for more details. + for atomic_lock_t'Alignment use 8; + + type struct_pthread_fast_lock is record + spinlock : atomic_lock_t; + status : Long_Integer; + end record; + pragma Convention (C, struct_pthread_fast_lock); + + type pthread_mutex_t is record + m_reserved : Integer; + m_count : Integer; + m_owner : System.Address; + m_kind : Integer; + m_lock : struct_pthread_fast_lock; + end record; + pragma Convention (C, pthread_mutex_t); + +end System.Linux; diff --git a/gcc/ada/s-linux.ads b/gcc/ada/s-linux.ads new file mode 100644 index 00000000000..cb9ad42b018 --- /dev/null +++ b/gcc/ada/s-linux.ads @@ -0,0 +1,119 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- S Y S T E M . L I N U X -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2008, Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +------------------------------------------------------------------------------ + +-- This is the default version of this package + +-- This package encapsulates cpu specific differences between implementations +-- of GNU/Linux, in order to share s-osinte-linux.ads. + +-- PLEASE DO NOT add any with-clauses to this package or remove the pragma +-- Preelaborate. This package is designed to be a bottom-level (leaf) package + +package System.Linux is + pragma Preelaborate; + + ----------- + -- Errno -- + ----------- + + EAGAIN : constant := 11; + EINTR : constant := 4; + EINVAL : constant := 22; + ENOMEM : constant := 12; + EPERM : constant := 1; + ETIMEDOUT : constant := 110; + + ------------- + -- Signals -- + ------------- + + SIGHUP : constant := 1; -- hangup + SIGINT : constant := 2; -- interrupt (rubout) + SIGQUIT : constant := 3; -- quit (ASCD FS) + SIGILL : constant := 4; -- illegal instruction (not reset) + SIGTRAP : constant := 5; -- trace trap (not reset) + SIGIOT : constant := 6; -- IOT instruction + SIGABRT : constant := 6; -- used by abort, replace SIGIOT in the future + SIGFPE : constant := 8; -- floating point exception + SIGKILL : constant := 9; -- kill (cannot be caught or ignored) + SIGBUS : constant := 7; -- bus error + SIGSEGV : constant := 11; -- segmentation violation + SIGPIPE : constant := 13; -- write on a pipe with no one to read it + SIGALRM : constant := 14; -- alarm clock + SIGTERM : constant := 15; -- software termination signal from kill + SIGUSR1 : constant := 10; -- user defined signal 1 + SIGUSR2 : constant := 12; -- user defined signal 2 + SIGCLD : constant := 17; -- alias for SIGCHLD + SIGCHLD : constant := 17; -- child status change + SIGPWR : constant := 30; -- power-fail restart + SIGWINCH : constant := 28; -- window size change + SIGURG : constant := 23; -- urgent condition on IO channel + SIGPOLL : constant := 29; -- pollable event occurred + SIGIO : constant := 29; -- I/O now possible (4.2 BSD) + SIGLOST : constant := 29; -- File lock lost + SIGSTOP : constant := 19; -- stop (cannot be caught or ignored) + SIGTSTP : constant := 20; -- user stop requested from tty + SIGCONT : constant := 18; -- stopped process has been continued + SIGTTIN : constant := 21; -- background tty read attempted + SIGTTOU : constant := 22; -- background tty write attempted + SIGVTALRM : constant := 26; -- virtual timer expired + SIGPROF : constant := 27; -- profiling timer expired + SIGXCPU : constant := 24; -- CPU time limit exceeded + SIGXFSZ : constant := 25; -- filesize limit exceeded + SIGUNUSED : constant := 31; -- unused signal (GNU/Linux) + SIGSTKFLT : constant := 16; -- coprocessor stack fault (Linux) + SIGLTHRRES : constant := 32; -- GNU/LinuxThreads restart signal + SIGLTHRCAN : constant := 33; -- GNU/LinuxThreads cancel signal + SIGLTHRDBG : constant := 34; -- GNU/LinuxThreads debugger signal + + -- struct_sigaction offsets + + sa_mask_pos : constant := Standard'Address_Size / 8; + sa_flags_pos : constant := 128 + sa_mask_pos; + + SA_SIGINFO : constant := 16#04#; + SA_ONSTACK : constant := 16#08000000#; + + type struct_pthread_fast_lock is record + status : Long_Integer; + spinlock : Integer; + end record; + pragma Convention (C, struct_pthread_fast_lock); + + type pthread_mutex_t is record + m_reserved : Integer; + m_count : Integer; + m_owner : System.Address; + m_kind : Integer; + m_lock : struct_pthread_fast_lock; + end record; + pragma Convention (C, pthread_mutex_t); + +end System.Linux; diff --git a/gcc/ada/s-osinte-aix.ads b/gcc/ada/s-osinte-aix.ads index 65db80a49de..6985915869d 100644 --- a/gcc/ada/s-osinte-aix.ads +++ b/gcc/ada/s-osinte-aix.ads @@ -174,7 +174,8 @@ package System.OS_Interface is pragma Convention (C, struct_sigaction); type struct_sigaction_ptr is access all struct_sigaction; - SA_SIGINFO : constant := 16#0100#; + SA_SIGINFO : constant := 16#0100#; + SA_ONSTACK : constant := 16#0001#; SIG_BLOCK : constant := 0; SIG_UNBLOCK : constant := 1; @@ -291,6 +292,24 @@ package System.OS_Interface is -- Stack -- ----------- + type stack_t is record + ss_sp : System.Address; + ss_size : size_t; + ss_flags : int; + end record; + pragma Convention (C, stack_t); + + function sigaltstack + (ss : not null access stack_t; + oss : access stack_t) return int; + pragma Import (C, sigaltstack, "sigaltstack"); + + Alternate_Stack : aliased System.Address; + -- This is a dummy definition, never used (Alternate_Stack_Size is null) + + Alternate_Stack_Size : constant := 0; + -- No alternate signal stack is used on this platform + Stack_Base_Available : constant Boolean := False; -- Indicates wether the stack base is available on this target @@ -309,7 +328,6 @@ package System.OS_Interface is PROT_WRITE : constant := 2; PROT_EXEC : constant := 4; PROT_ALL : constant := PROT_READ + PROT_WRITE + PROT_EXEC; - PROT_ON : constant := PROT_READ; PROT_OFF : constant := PROT_ALL; diff --git a/gcc/ada/s-osinte-darwin.ads b/gcc/ada/s-osinte-darwin.ads index da97aa0323c..8dd28dbd0e5 100644 --- a/gcc/ada/s-osinte-darwin.ads +++ b/gcc/ada/s-osinte-darwin.ads @@ -162,6 +162,7 @@ package System.OS_Interface is SIG_IGN : constant := 1; SA_SIGINFO : constant := 16#0040#; + SA_ONSTACK : constant := 16#0001#; function sigaction (sig : Signal; @@ -229,10 +230,10 @@ package System.OS_Interface is --------- function lwp_self return System.Address; + pragma Import (C, lwp_self, "pthread_self"); -- lwp_self does not exist on this thread library, revert to pthread_self -- which is the closest approximation (with getpid). This function is -- needed to share 7staprop.adb across POSIX-like targets. - pragma Import (C, lwp_self, "pthread_self"); ------------- -- Threads -- @@ -264,22 +265,39 @@ package System.OS_Interface is -- Stack -- ----------- + type stack_t is record + ss_sp : System.Address; + ss_size : size_t; + ss_flags : int; + end record; + pragma Convention (C, stack_t); + + function sigaltstack + (ss : not null access stack_t; + oss : access stack_t) return int; + pragma Import (C, sigaltstack, "sigaltstack"); + + Alternate_Stack : aliased System.Address; + -- This is a dummy definition, never used (Alternate_Stack_Size is null) + + Alternate_Stack_Size : constant := 0; + -- No alternate signal stack is used on this platform + Stack_Base_Available : constant Boolean := False; - -- Indicates wether the stack base is available on this target. - -- This allows us to share s-osinte.adb between all the FSU run time. - -- Note that this value can only be true if pthread_t has a complete - -- definition that corresponds exactly to the C header files. + -- Indicates wether the stack base is available on this target. This allows + -- us to share s-osinte.adb between all the FSU run time. Note that this + -- value can only be true if pthread_t has a complete definition that + -- corresponds exactly to the C header files. function Get_Stack_Base (thread : pthread_t) return System.Address; pragma Inline (Get_Stack_Base); - -- returns the stack base of the specified thread. - -- Only call this function when Stack_Base_Available is True. + -- returns the stack base of the specified thread. Only call this function + -- when Stack_Base_Available is True. function Get_Page_Size return size_t; function Get_Page_Size return System.Address; pragma Import (C, Get_Page_Size, "getpagesize"); - -- returns the size of a page, or 0 if this is not relevant on this - -- target + -- Returns the size of a page, or 0 if this is not relevant on this target PROT_NONE : constant := 0; PROT_READ : constant := 1; @@ -290,9 +308,10 @@ package System.OS_Interface is PROT_ON : constant := PROT_NONE; PROT_OFF : constant := PROT_ALL; - function mprotect (addr : System.Address; - len : size_t; - prot : int) return int; + function mprotect + (addr : System.Address; + len : size_t; + prot : int) return int; pragma Import (C, mprotect); --------------------------------------- @@ -528,13 +547,6 @@ private end record; pragma Convention (C, siginfo_t); - type stack_t is record - ss_sp : System.Address; - ss_size : int; - ss_flags : int; - end record; - pragma Convention (C, stack_t); - type mcontext_t is new System.Address; type ucontext_t is record diff --git a/gcc/ada/s-osinte-freebsd.ads b/gcc/ada/s-osinte-freebsd.ads index 8794e995bd8..e0453ca90b4 100644 --- a/gcc/ada/s-osinte-freebsd.ads +++ b/gcc/ada/s-osinte-freebsd.ads @@ -182,6 +182,7 @@ package System.OS_Interface is SIG_IGN : constant := 1; SA_SIGINFO : constant := 16#0040#; + SA_ONSTACK : constant := 16#0001#; function sigaction (sig : Signal; @@ -293,42 +294,57 @@ package System.OS_Interface is -- Stack -- ----------- + type stack_t is record + ss_sp : System.Address; + ss_size : size_t; + ss_flags : int; + end record; + pragma Convention (C, stack_t); + + function sigaltstack + (ss : not null access stack_t; + oss : access stack_t) return int; + pragma Import (C, sigaltstack, "sigaltstack"); + + Alternate_Stack : aliased System.Address; + -- This is a dummy definition, never used (Alternate_Stack_Size is null) + + Alternate_Stack_Size : constant := 0; + -- No alternate signal stack is used on this platform + Stack_Base_Available : constant Boolean := False; - -- Indicates wether the stack base is available on this target. - -- This allows us to share s-osinte.adb between all the FSU run time. - -- Note that this value can only be true if pthread_t has a complete - -- definition that corresponds exactly to the C header files. + -- Indicates wether the stack base is available on this target. This allows + -- us to share s-osinte.adb between all the FSU run time. Note that this + -- value can only be true if pthread_t has a complete definition that + -- corresponds exactly to the C header files. function Get_Stack_Base (thread : pthread_t) return Address; pragma Inline (Get_Stack_Base); - -- returns the stack base of the specified thread. - -- Only call this function when Stack_Base_Available is True. + -- returns the stack base of the specified thread. Only call this function + -- when Stack_Base_Available is True. function Get_Page_Size return size_t; function Get_Page_Size return Address; pragma Import (C, Get_Page_Size, "getpagesize"); - -- returns the size of a page, or 0 if this is not relevant on this - -- target + -- returns the size of a page, or 0 if this is not relevant on this target PROT_NONE : constant := 0; PROT_READ : constant := 1; PROT_WRITE : constant := 2; PROT_EXEC : constant := 4; PROT_ALL : constant := PROT_READ + PROT_WRITE + PROT_EXEC; - PROT_ON : constant := PROT_NONE; PROT_OFF : constant := PROT_ALL; - function mprotect - (addr : Address; len : size_t; prot : int) return int; + function mprotect (addr : Address; len : size_t; prot : int) return int; pragma Import (C, mprotect); --------------------------------------- -- Nonstandard Thread Initialization -- --------------------------------------- - -- FSU_THREADS requires pthread_init, which is nonstandard and - -- this should be invoked during the elaboration of s-taprop.adb + -- FSU_THREADS requires pthread_init, which is nonstandard and this should + -- be invoked during the elaboration of s-taprop.adb. -- FreeBSD does not require this so we provide an empty Ada body diff --git a/gcc/ada/s-osinte-hpux.ads b/gcc/ada/s-osinte-hpux.ads index 0e368919eeb..b22e20d81cf 100644 --- a/gcc/ada/s-osinte-hpux.ads +++ b/gcc/ada/s-osinte-hpux.ads @@ -156,7 +156,8 @@ package System.OS_Interface is pragma Convention (C, struct_sigaction); type struct_sigaction_ptr is access all struct_sigaction; - SA_SIGINFO : constant := 16#10#; + SA_SIGINFO : constant := 16#10#; + SA_ONSTACK : constant := 16#01#; SIG_BLOCK : constant := 0; SIG_UNBLOCK : constant := 1; @@ -278,26 +279,43 @@ package System.OS_Interface is -- Stack -- ----------- + type stack_t is record + ss_sp : System.Address; + ss_flags : int; + ss_size : size_t; + end record; + pragma Convention (C, stack_t); + + function sigaltstack + (ss : not null access stack_t; + oss : access stack_t) return int; + pragma Import (C, sigaltstack, "sigaltstack"); + + Alternate_Stack : aliased System.Address; + pragma Import (C, Alternate_Stack, "__gnat_alternate_stack"); + -- The alternate signal stack for stack overflows + + Alternate_Stack_Size : constant := 16 * 1024; + -- This must be in keeping with init.c:__gnat_alternate_stack + Stack_Base_Available : constant Boolean := False; -- Indicates wether the stack base is available on this target function Get_Stack_Base (thread : pthread_t) return Address; pragma Inline (Get_Stack_Base); - -- returns the stack base of the specified thread. - -- Only call this function when Stack_Base_Available is True. + -- Returns the stack base of the specified thread. Only call this function + -- when Stack_Base_Available is True. function Get_Page_Size return size_t; function Get_Page_Size return Address; pragma Import (C, Get_Page_Size, "getpagesize"); - -- returns the size of a page, or 0 if this is not relevant on this - -- target + -- Returns the size of a page, or 0 if this is not relevant on this target PROT_NONE : constant := 0; PROT_READ : constant := 1; PROT_WRITE : constant := 2; PROT_EXEC : constant := 4; PROT_ALL : constant := PROT_READ + PROT_WRITE + PROT_EXEC; - PROT_ON : constant := PROT_READ; PROT_OFF : constant := PROT_ALL; diff --git a/gcc/ada/s-osinte-linux-alpha.ads b/gcc/ada/s-osinte-linux-alpha.ads deleted file mode 100644 index 7925a5e0558..00000000000 --- a/gcc/ada/s-osinte-linux-alpha.ads +++ /dev/null @@ -1,508 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- --- -- --- S Y S T E M . O S _ I N T E R F A C E -- --- -- --- S p e c -- --- -- --- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2006, Free Software Foundation, Inc. -- --- -- --- GNARL is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 2, or (at your option) any later ver- -- --- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNARL; see file COPYING. If not, write -- --- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- --- Boston, MA 02110-1301, USA. -- --- -- --- As a special exception, if other files instantiate generics from this -- --- unit, or you link this unit with other files to produce an executable, -- --- this unit does not by itself cause the resulting executable to be -- --- covered by the GNU General Public License. This exception does not -- --- however invalidate any other reasons why the executable file might be -- --- covered by the GNU Public License. -- --- -- --- GNARL was developed by the GNARL team at Florida State University. -- --- Extensive contributions were provided by Ada Core Technologies, Inc. -- --- -- ------------------------------------------------------------------------------- - --- This is a GNU/Linux (GNU/LinuxThreads) version of this package - --- This package encapsulates all direct interfaces to OS services --- that are needed by children of System. - --- PLEASE DO NOT add any with-clauses to this package or remove the pragma --- Preelaborate. This package is designed to be a bottom-level (leaf) package. - -with Interfaces.C; -with Unchecked_Conversion; - -package System.OS_Interface is - pragma Preelaborate; - - pragma Linker_Options ("-lpthread"); - - subtype int is Interfaces.C.int; - subtype char is Interfaces.C.char; - subtype short is Interfaces.C.short; - subtype long is Interfaces.C.long; - subtype unsigned is Interfaces.C.unsigned; - subtype unsigned_short is Interfaces.C.unsigned_short; - subtype unsigned_long is Interfaces.C.unsigned_long; - subtype unsigned_char is Interfaces.C.unsigned_char; - subtype plain_char is Interfaces.C.plain_char; - subtype size_t is Interfaces.C.size_t; - - ----------- - -- Errno -- - ----------- - - function errno return int; - pragma Import (C, errno, "__get_errno"); - - EAGAIN : constant := 35; - EINTR : constant := 4; - EINVAL : constant := 22; - ENOMEM : constant := 12; - EPERM : constant := 1; - ETIMEDOUT : constant := 60; - - ------------- - -- Signals -- - ------------- - - Max_Interrupt : constant := 63; - type Signal is new int range 0 .. Max_Interrupt; - for Signal'Size use int'Size; - - SIGHUP : constant := 1; -- hangup - SIGINT : constant := 2; -- interrupt (rubout) - SIGQUIT : constant := 3; -- quit (ASCD FS) - SIGILL : constant := 4; -- illegal instruction (not reset) - SIGTRAP : constant := 5; -- trace trap (not reset) - SIGIOT : constant := 6; -- IOT instruction - SIGABRT : constant := 6; -- used by abort, replace SIGIOT in the future - SIGFPE : constant := 8; -- floating point exception - SIGKILL : constant := 9; -- kill (cannot be caught or ignored) - SIGBUS : constant := 10; -- bus error - SIGSEGV : constant := 11; -- segmentation violation - SIGPIPE : constant := 13; -- write on a pipe with no one to read it - SIGALRM : constant := 14; -- alarm clock - SIGTERM : constant := 15; -- software termination signal from kill - SIGURG : constant := 16; -- urgent condition on IO channel - SIGSTOP : constant := 17; -- stop (cannot be caught or ignored) - SIGTSTP : constant := 18; -- user stop requested from tty - SIGCONT : constant := 19; -- stopped process has been continued - SIGCLD : constant := 20; -- alias for SIGCHLD - SIGCHLD : constant := 20; -- child status change - SIGTTIN : constant := 21; -- background tty read attempted - SIGTTOU : constant := 22; -- background tty write attempted - SIGIO : constant := 23; -- I/O now possible (4.2 BSD) - SIGPOLL : constant := 23; -- pollable event occurred - SIGXCPU : constant := 24; -- CPU time limit exceeded - SIGXFSZ : constant := 25; -- filesize limit exceeded - SIGVTALRM : constant := 26; -- virtual timer expired - SIGPROF : constant := 27; -- profiling timer expired - SIGWINCH : constant := 28; -- window size change - SIGPWR : constant := 29; -- power-fail restart - SIGUSR1 : constant := 30; -- user defined signal 1 - SIGUSR2 : constant := 31; -- user defined signal 2 - - SIGLTHRRES : constant := 32; -- GNU/LinuxThreads restart signal - SIGLTHRCAN : constant := 33; -- GNU/LinuxThreads cancel signal - SIGLTHRDBG : constant := 34; -- GNU/LinuxThreads debugger signal - - SIGADAABORT : constant := SIGABRT; - -- Change this if you want to use another signal for task abort. - -- SIGTERM might be a good one. - - SIGUNUSED : constant := 0; - SIGSTKFLT : constant := 0; - SIGLOST : constant := 0; - -- These don't exist for Linux/Alpha. The constants are present - -- so that we can continue to use a-intnam-linux.ads. - - type Signal_Set is array (Natural range <>) of Signal; - - Unmasked : constant Signal_Set := ( - SIGTRAP, - -- To enable debugging on multithreaded applications, mark SIGTRAP to - -- be kept unmasked. - - SIGBUS, - - SIGTTIN, SIGTTOU, SIGTSTP, - -- Keep these three signals unmasked so that background processes - -- and IO behaves as normal "C" applications - - SIGPROF, - -- To avoid confusing the profiler - - SIGKILL, SIGSTOP, - -- These two signals actually cannot be masked; - -- POSIX simply won't allow it. - - SIGLTHRRES, SIGLTHRCAN, SIGLTHRDBG); - -- These three signals are used by GNU/LinuxThreads starting from - -- glibc 2.1 (future 2.2). - - Reserved : constant Signal_Set := (SIGKILL, SIGSTOP); - - type sigset_t is private; - - function sigaddset (set : access sigset_t; sig : Signal) return int; - pragma Import (C, sigaddset, "sigaddset"); - - function sigdelset (set : access sigset_t; sig : Signal) return int; - pragma Import (C, sigdelset, "sigdelset"); - - function sigfillset (set : access sigset_t) return int; - pragma Import (C, sigfillset, "sigfillset"); - - function sigismember (set : access sigset_t; sig : Signal) return int; - pragma Import (C, sigismember, "sigismember"); - - function sigemptyset (set : access sigset_t) return int; - pragma Import (C, sigemptyset, "sigemptyset"); - - type union_type_3 is new String (1 .. 116); - type siginfo_t is record - si_signo : int; - si_code : int; - si_errno : int; - X_data : union_type_3; - end record; - pragma Convention (C, siginfo_t); - - type struct_sigaction is record - sa_handler : System.Address; - sa_mask : sigset_t; - sa_flags : unsigned_long; - end record; - pragma Convention (C, struct_sigaction); - type struct_sigaction_ptr is access all struct_sigaction; - - type Machine_State is record - dummy : unsigned_long; - end record; - type Machine_State_Ptr is access all Machine_State; - - SA_SIGINFO : constant := 16#40#; - - SIG_BLOCK : constant := 0; - SIG_UNBLOCK : constant := 1; - SIG_SETMASK : constant := 2; - - SIG_DFL : constant := 0; - SIG_IGN : constant := 1; - - function sigaction - (sig : Signal; - act : struct_sigaction_ptr; - oact : struct_sigaction_ptr) return int; - pragma Import (C, sigaction, "sigaction"); - - ---------- - -- Time -- - ---------- - - type timespec is private; - - function To_Duration (TS : timespec) return Duration; - pragma Inline (To_Duration); - - function To_Timespec (D : Duration) return timespec; - pragma Inline (To_Timespec); - - type struct_timeval is private; - - function To_Duration (TV : struct_timeval) return Duration; - pragma Inline (To_Duration); - - function To_Timeval (D : Duration) return struct_timeval; - pragma Inline (To_Timeval); - - function gettimeofday - (tv : access struct_timeval; - tz : System.Address := System.Null_Address) return int; - pragma Import (C, gettimeofday, "gettimeofday"); - - function sysconf (name : int) return long; - pragma Import (C, sysconf); - - SC_CLK_TCK : constant := 2; - - ------------------------- - -- Priority Scheduling -- - ------------------------- - - SCHED_OTHER : constant := 0; - SCHED_FIFO : constant := 1; - SCHED_RR : constant := 2; - - function To_Target_Priority - (Prio : System.Any_Priority) return Interfaces.C.int; - -- Maps System.Any_Priority to a POSIX priority. - - ------------- - -- Process -- - ------------- - - type pid_t is private; - - function kill (pid : pid_t; sig : Signal) return int; - pragma Import (C, kill, "kill"); - - function getpid return pid_t; - pragma Import (C, getpid, "getpid"); - - ------------- - -- Threads -- - ------------- - - type Thread_Body is access - function (arg : System.Address) return System.Address; - - function Thread_Body_Access is new - Unchecked_Conversion (System.Address, Thread_Body); - - type pthread_t is new unsigned_long; - subtype Thread_Id is pthread_t; - - function To_pthread_t is new Unchecked_Conversion - (unsigned_long, pthread_t); - - type pthread_mutex_t is limited private; - type pthread_cond_t is limited private; - type pthread_attr_t is limited private; - type pthread_mutexattr_t is limited private; - type pthread_condattr_t is limited private; - type pthread_key_t is private; - - PTHREAD_CREATE_DETACHED : constant := 1; - - ----------- - -- Stack -- - ----------- - - function Get_Stack_Base (thread : pthread_t) return Address; - pragma Inline (Get_Stack_Base); - -- This is a dummy procedure to share some GNULLI files - - --------------------------------------- - -- Nonstandard Thread Initialization -- - --------------------------------------- - - procedure pthread_init; - pragma Inline (pthread_init); - -- This is a dummy procedure to share some GNULLI files - - ------------------------- - -- POSIX.1c Section 3 -- - ------------------------- - - function sigwait (set : access sigset_t; sig : access Signal) return int; - pragma Import (C, sigwait, "sigwait"); - - function pthread_kill (thread : pthread_t; sig : Signal) return int; - pragma Import (C, pthread_kill, "pthread_kill"); - - function pthread_sigmask - (how : int; - set : access sigset_t; - oset : access sigset_t) return int; - pragma Import (C, pthread_sigmask, "pthread_sigmask"); - - -------------------------- - -- POSIX.1c Section 11 -- - -------------------------- - - function pthread_mutexattr_init - (attr : access pthread_mutexattr_t) return int; - pragma Import (C, pthread_mutexattr_init, "pthread_mutexattr_init"); - - function pthread_mutexattr_destroy - (attr : access pthread_mutexattr_t) return int; - pragma Import (C, pthread_mutexattr_destroy, "pthread_mutexattr_destroy"); - - function pthread_mutex_init - (mutex : access pthread_mutex_t; - attr : access pthread_mutexattr_t) return int; - pragma Import (C, pthread_mutex_init, "pthread_mutex_init"); - - function pthread_mutex_destroy (mutex : access pthread_mutex_t) return int; - pragma Import (C, pthread_mutex_destroy, "pthread_mutex_destroy"); - - function pthread_mutex_lock (mutex : access pthread_mutex_t) return int; - pragma Import (C, pthread_mutex_lock, "pthread_mutex_lock"); - - function pthread_mutex_unlock (mutex : access pthread_mutex_t) return int; - pragma Import (C, pthread_mutex_unlock, "pthread_mutex_unlock"); - - function pthread_condattr_init - (attr : access pthread_condattr_t) return int; - pragma Import (C, pthread_condattr_init, "pthread_condattr_init"); - - function pthread_condattr_destroy - (attr : access pthread_condattr_t) return int; - pragma Import (C, pthread_condattr_destroy, "pthread_condattr_destroy"); - - function pthread_cond_init - (cond : access pthread_cond_t; - attr : access pthread_condattr_t) return int; - pragma Import (C, pthread_cond_init, "pthread_cond_init"); - - function pthread_cond_destroy (cond : access pthread_cond_t) return int; - pragma Import (C, pthread_cond_destroy, "pthread_cond_destroy"); - - function pthread_cond_signal (cond : access pthread_cond_t) return int; - pragma Import (C, pthread_cond_signal, "pthread_cond_signal"); - - function pthread_cond_wait - (cond : access pthread_cond_t; - mutex : access pthread_mutex_t) return int; - pragma Import (C, pthread_cond_wait, "pthread_cond_wait"); - - function pthread_cond_timedwait - (cond : access pthread_cond_t; - mutex : access pthread_mutex_t; - abstime : access timespec) return int; - pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait"); - - -------------------------- - -- POSIX.1c Section 13 -- - -------------------------- - - type struct_sched_param is record - sched_priority : int; -- scheduling priority - end record; - pragma Convention (C, struct_sched_param); - - function pthread_setschedparam - (thread : pthread_t; - policy : int; - param : access struct_sched_param) return int; - pragma Import (C, pthread_setschedparam, "pthread_setschedparam"); - - function pthread_attr_setschedpolicy - (attr : access pthread_attr_t; - policy : int) return int; - pragma Import - (C, pthread_attr_setschedpolicy, "pthread_attr_setschedpolicy"); - - function sched_yield return int; - pragma Import (C, sched_yield, "sched_yield"); - - --------------------------- - -- P1003.1c - Section 16 -- - --------------------------- - - function pthread_attr_init - (attributes : access pthread_attr_t) return int; - pragma Import (C, pthread_attr_init, "pthread_attr_init"); - - function pthread_attr_destroy - (attributes : access pthread_attr_t) return int; - pragma Import (C, pthread_attr_destroy, "pthread_attr_destroy"); - - function pthread_attr_setdetachstate - (attr : access pthread_attr_t; - detachstate : int) return int; - pragma Import - (C, pthread_attr_setdetachstate, "pthread_attr_setdetachstate"); - - function pthread_attr_setstacksize - (attr : access pthread_attr_t; - stacksize : size_t) return int; - pragma Import (C, pthread_attr_setstacksize, "pthread_attr_setstacksize"); - - function pthread_create - (thread : access pthread_t; - attributes : access pthread_attr_t; - start_routine : Thread_Body; - arg : System.Address) return int; - pragma Import (C, pthread_create, "pthread_create"); - - procedure pthread_exit (status : System.Address); - pragma Import (C, pthread_exit, "pthread_exit"); - - function pthread_self return pthread_t; - pragma Import (C, pthread_self, "pthread_self"); - - -------------------------- - -- POSIX.1c Section 17 -- - -------------------------- - - function pthread_setspecific - (key : pthread_key_t; - value : System.Address) return int; - pragma Import (C, pthread_setspecific, "pthread_setspecific"); - - function pthread_getspecific (key : pthread_key_t) return System.Address; - pragma Import (C, pthread_getspecific, "pthread_getspecific"); - - type destructor_pointer is access procedure (arg : System.Address); - - function pthread_key_create - (key : access pthread_key_t; - destructor : destructor_pointer) return int; - pragma Import (C, pthread_key_create, "pthread_key_create"); - -private - - type sigset_t is record - dum0, dum1, dum2, dum3, dum4, dum5, dum6, dum7 : unsigned_long; - dum8, dum9, dum10, dum11, dum12, dum13, dum14, dum15 : unsigned_long; - end record; - pragma Convention (C, sigset_t); - - type pid_t is new int; - - type time_t is new long; - - type timespec is record - tv_sec : time_t; - tv_nsec : long; - end record; - pragma Convention (C, timespec); - - type struct_timeval is record - tv_sec : time_t; - tv_usec : time_t; - end record; - pragma Convention (C, struct_timeval); - - type pthread_attr_t is record - dum0, dum1, dum2, dum3, dum4, dum5, dum6 : unsigned_long; - end record; - pragma Convention (C, pthread_attr_t); - - type pthread_condattr_t is record - dummy : int; - end record; - pragma Convention (C, pthread_condattr_t); - - type pthread_mutexattr_t is record - mutexkind : int; - end record; - pragma Convention (C, pthread_mutexattr_t); - - type pthread_mutex_t is record - dum0, dum1, dum2, dum3, dum4 : unsigned_long; - end record; - pragma Convention (C, pthread_mutex_t); - - type pthread_cond_t is record - dum0, dum1, dum2, dum3, dum4, dum5 : unsigned_long; - end record; - pragma Convention (C, pthread_cond_t); - - type pthread_key_t is new unsigned; - -end System.OS_Interface; diff --git a/gcc/ada/s-osinte-linux-hppa.ads b/gcc/ada/s-osinte-linux-hppa.ads deleted file mode 100644 index 2467f09cf5b..00000000000 --- a/gcc/ada/s-osinte-linux-hppa.ads +++ /dev/null @@ -1,560 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- --- -- --- S Y S T E M . O S _ I N T E R F A C E -- --- -- --- S p e c -- --- (GNU/Linux-HPPA Version) -- --- -- --- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2008, Free Software Foundation, Inc. -- --- -- --- GNARL is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 2, or (at your option) any later ver- -- --- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNARL; see file COPYING. If not, write -- --- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- --- Boston, MA 02110-1301, USA. -- --- -- --- As a special exception, if other files instantiate generics from this -- --- unit, or you link this unit with other files to produce an executable, -- --- this unit does not by itself cause the resulting executable to be -- --- covered by the GNU General Public License. This exception does not -- --- however invalidate any other reasons why the executable file might be -- --- covered by the GNU Public License. -- --- -- --- GNARL was developed by the GNARL team at Florida State University. -- --- Extensive contributions were provided by Ada Core Technologies, Inc. -- --- -- ------------------------------------------------------------------------------- - --- This is a GNU/Linux (GNU/LinuxThreads) version of this package - --- This package encapsulates all direct interfaces to OS services that are --- needed by the tasking run-time (libgnarl). - --- PLEASE DO NOT add any with-clauses to this package or remove the pragma --- Preelaborate. This package is designed to be a bottom-level (leaf) package. - -with Ada.Unchecked_Conversion; - -with Interfaces.C; - -package System.OS_Interface is - pragma Preelaborate; - - pragma Linker_Options ("-lpthread"); - - subtype int is Interfaces.C.int; - subtype char is Interfaces.C.char; - subtype short is Interfaces.C.short; - subtype long is Interfaces.C.long; - subtype unsigned is Interfaces.C.unsigned; - subtype unsigned_short is Interfaces.C.unsigned_short; - subtype unsigned_long is Interfaces.C.unsigned_long; - subtype unsigned_char is Interfaces.C.unsigned_char; - subtype plain_char is Interfaces.C.plain_char; - subtype size_t is Interfaces.C.size_t; - - ----------- - -- Errno -- - ----------- - - function errno return int; - pragma Import (C, errno, "__get_errno"); - - EAGAIN : constant := 11; - EINTR : constant := 4; - EINVAL : constant := 22; - ENOMEM : constant := 12; - EPERM : constant := 1; - ETIMEDOUT : constant := 238; - - ------------- - -- Signals -- - ------------- - - Max_Interrupt : constant := 63; - type Signal is new int range 0 .. Max_Interrupt; - for Signal'Size use int'Size; - - SIGHUP : constant := 1; -- hangup - SIGINT : constant := 2; -- interrupt (rubout) - SIGQUIT : constant := 3; -- quit (ASCD FS) - SIGILL : constant := 4; -- illegal instruction (not reset) - SIGTRAP : constant := 5; -- trace trap (not reset) - SIGIOT : constant := 6; -- IOT instruction - SIGABRT : constant := 6; -- used by abort, replace SIGIOT in the future - SIGEMT : constant := 7; -- EMT - SIGFPE : constant := 8; -- floating point exception - SIGKILL : constant := 9; -- kill (cannot be caught or ignored) - SIGBUS : constant := 10; -- bus error - SIGSEGV : constant := 11; -- segmentation violation - SIGSYS : constant := 12; -- bad system call - SIGPIPE : constant := 13; -- write on a pipe with no one to read it - SIGALRM : constant := 14; -- alarm clock - SIGTERM : constant := 15; -- software termination signal from kill - SIGUSR1 : constant := 16; -- user defined signal 1 - SIGUSR2 : constant := 17; -- user defined signal 2 - SIGCLD : constant := 18; -- alias for SIGCHLD - SIGCHLD : constant := 18; -- child status change - SIGPWR : constant := 19; -- power-fail restart - SIGVTALRM : constant := 20; -- virtual timer expired - SIGPROF : constant := 21; -- profiling timer expired - SIGPOLL : constant := 22; -- pollable event occurred - SIGIO : constant := 22; -- I/O now possible (4.2 BSD) - SIGWINCH : constant := 23; -- window size change - SIGSTOP : constant := 24; -- stop (cannot be caught or ignored) - SIGTSTP : constant := 25; -- user stop requested from tty - SIGCONT : constant := 26; -- stopped process has been continued - SIGTTIN : constant := 27; -- background tty read attempted - SIGTTOU : constant := 28; -- background tty write attempted - SIGURG : constant := 29; -- urgent condition on IO channel - SIGLOST : constant := 30; -- File lock lost - SIGUNUSED : constant := 31; -- unused signal (GNU/Linux) - SIGXCPU : constant := 33; -- CPU time limit exceeded - SIGXFSZ : constant := 34; -- filesize limit exceeded - SIGSTKFLT : constant := 36; -- coprocessor stack fault (Linux) - SIGLTHRRES : constant := 37; -- GNU/LinuxThreads restart signal - SIGLTHRCAN : constant := 38; -- GNU/LinuxThreads cancel signal - SIGLTHRDBG : constant := 39; -- GNU/LinuxThreads debugger signal - - SIGADAABORT : constant := SIGABRT; - -- Change this if you want to use another signal for task abort. - -- SIGTERM might be a good one. - - type Signal_Set is array (Natural range <>) of Signal; - - Unmasked : constant Signal_Set := ( - SIGTRAP, - -- To enable debugging on multithreaded applications, mark SIGTRAP to - -- be kept unmasked. - - SIGBUS, - - SIGTTIN, SIGTTOU, SIGTSTP, - -- Keep these three signals unmasked so that background processes - -- and IO behaves as normal "C" applications - - SIGPROF, - -- To avoid confusing the profiler - - SIGKILL, SIGSTOP, - -- These two signals actually cannot be masked; - -- POSIX simply won't allow it. - - SIGLTHRRES, SIGLTHRCAN, SIGLTHRDBG); - -- These three signals are used by GNU/LinuxThreads starting from - -- glibc 2.1 (future 2.2). - - Reserved : constant Signal_Set := - -- I am not sure why the following two signals are reserved. - -- I guess they are not supported by this version of GNU/Linux. - (SIGVTALRM, SIGUNUSED); - - type sigset_t is private; - - function sigaddset (set : access sigset_t; sig : Signal) return int; - pragma Import (C, sigaddset, "sigaddset"); - - function sigdelset (set : access sigset_t; sig : Signal) return int; - pragma Import (C, sigdelset, "sigdelset"); - - function sigfillset (set : access sigset_t) return int; - pragma Import (C, sigfillset, "sigfillset"); - - function sigismember (set : access sigset_t; sig : Signal) return int; - pragma Import (C, sigismember, "sigismember"); - - function sigemptyset (set : access sigset_t) return int; - pragma Import (C, sigemptyset, "sigemptyset"); - - type union_type_3 is new String (1 .. 116); - type siginfo_t is record - si_signo : int; - si_code : int; - si_errno : int; - X_data : union_type_3; - end record; - pragma Convention (C, siginfo_t); - - type struct_sigaction is record - sa_handler : System.Address; - sa_flags : unsigned_long; - sa_mask : sigset_t; - end record; - pragma Convention (C, struct_sigaction); - type struct_sigaction_ptr is access all struct_sigaction; - - type Machine_State is record - eip : unsigned_long; - ebx : unsigned_long; - esp : unsigned_long; - ebp : unsigned_long; - esi : unsigned_long; - edi : unsigned_long; - end record; - type Machine_State_Ptr is access all Machine_State; - - SA_SIGINFO : constant := 16; - - SIG_BLOCK : constant := 0; - SIG_UNBLOCK : constant := 1; - SIG_SETMASK : constant := 2; - - SIG_DFL : constant := 0; - SIG_IGN : constant := 1; - - function sigaction - (sig : Signal; - act : struct_sigaction_ptr; - oact : struct_sigaction_ptr) return int; - pragma Import (C, sigaction, "sigaction"); - - ---------- - -- Time -- - ---------- - - type timespec is private; - - function To_Duration (TS : timespec) return Duration; - pragma Inline (To_Duration); - - function To_Timespec (D : Duration) return timespec; - pragma Inline (To_Timespec); - - type struct_timeval is private; - - function To_Duration (TV : struct_timeval) return Duration; - pragma Inline (To_Duration); - - function To_Timeval (D : Duration) return struct_timeval; - pragma Inline (To_Timeval); - - function gettimeofday - (tv : access struct_timeval; - tz : System.Address := System.Null_Address) return int; - pragma Import (C, gettimeofday, "gettimeofday"); - - function sysconf (name : int) return long; - pragma Import (C, sysconf); - - SC_CLK_TCK : constant := 2; - SC_NPROCESSORS_ONLN : constant := 84; - - ------------------------- - -- Priority Scheduling -- - ------------------------- - - SCHED_OTHER : constant := 0; - SCHED_FIFO : constant := 1; - SCHED_RR : constant := 2; - - function To_Target_Priority - (Prio : System.Any_Priority) return Interfaces.C.int; - -- Maps System.Any_Priority to a POSIX priority - - ------------- - -- Process -- - ------------- - - type pid_t is private; - - function kill (pid : pid_t; sig : Signal) return int; - pragma Import (C, kill, "kill"); - - function getpid return pid_t; - pragma Import (C, getpid, "getpid"); - - ------------- - -- Threads -- - ------------- - - type Thread_Body is access - function (arg : System.Address) return System.Address; - pragma Convention (C, Thread_Body); - - function Thread_Body_Access is new - Ada.Unchecked_Conversion (System.Address, Thread_Body); - - type pthread_t is new unsigned_long; - subtype Thread_Id is pthread_t; - - function To_pthread_t is new Ada.Unchecked_Conversion - (unsigned_long, pthread_t); - - type pthread_mutex_t is limited private; - type pthread_cond_t is limited private; - type pthread_attr_t is limited private; - type pthread_mutexattr_t is limited private; - type pthread_condattr_t is limited private; - type pthread_key_t is private; - - PTHREAD_CREATE_DETACHED : constant := 1; - - ----------- - -- Stack -- - ----------- - - function Get_Stack_Base (thread : pthread_t) return Address; - pragma Inline (Get_Stack_Base); - -- This is a dummy procedure to share some GNULLI files - - --------------------------------------- - -- Nonstandard Thread Initialization -- - --------------------------------------- - - procedure pthread_init; - pragma Inline (pthread_init); - -- This is a dummy procedure to share some GNULLI files - - ------------------------- - -- POSIX.1c Section 3 -- - ------------------------- - - function sigwait (set : access sigset_t; sig : access Signal) return int; - pragma Import (C, sigwait, "sigwait"); - - function pthread_kill (thread : pthread_t; sig : Signal) return int; - pragma Import (C, pthread_kill, "pthread_kill"); - - function pthread_sigmask - (how : int; - set : access sigset_t; - oset : access sigset_t) return int; - pragma Import (C, pthread_sigmask, "pthread_sigmask"); - - -------------------------- - -- POSIX.1c Section 11 -- - -------------------------- - - function pthread_mutexattr_init - (attr : access pthread_mutexattr_t) return int; - pragma Import (C, pthread_mutexattr_init, "pthread_mutexattr_init"); - - function pthread_mutexattr_destroy - (attr : access pthread_mutexattr_t) return int; - pragma Import (C, pthread_mutexattr_destroy, "pthread_mutexattr_destroy"); - - function pthread_mutex_init - (mutex : access pthread_mutex_t; - attr : access pthread_mutexattr_t) return int; - pragma Import (C, pthread_mutex_init, "pthread_mutex_init"); - - function pthread_mutex_destroy (mutex : access pthread_mutex_t) return int; - pragma Import (C, pthread_mutex_destroy, "pthread_mutex_destroy"); - - function pthread_mutex_lock (mutex : access pthread_mutex_t) return int; - pragma Import (C, pthread_mutex_lock, "pthread_mutex_lock"); - - function pthread_mutex_unlock (mutex : access pthread_mutex_t) return int; - pragma Import (C, pthread_mutex_unlock, "pthread_mutex_unlock"); - - function pthread_condattr_init - (attr : access pthread_condattr_t) return int; - pragma Import (C, pthread_condattr_init, "pthread_condattr_init"); - - function pthread_condattr_destroy - (attr : access pthread_condattr_t) return int; - pragma Import (C, pthread_condattr_destroy, "pthread_condattr_destroy"); - - function pthread_cond_init - (cond : access pthread_cond_t; - attr : access pthread_condattr_t) return int; - pragma Import (C, pthread_cond_init, "pthread_cond_init"); - - function pthread_cond_destroy (cond : access pthread_cond_t) return int; - pragma Import (C, pthread_cond_destroy, "pthread_cond_destroy"); - - function pthread_cond_signal (cond : access pthread_cond_t) return int; - pragma Import (C, pthread_cond_signal, "pthread_cond_signal"); - - function pthread_cond_wait - (cond : access pthread_cond_t; - mutex : access pthread_mutex_t) return int; - pragma Import (C, pthread_cond_wait, "pthread_cond_wait"); - - function pthread_cond_timedwait - (cond : access pthread_cond_t; - mutex : access pthread_mutex_t; - abstime : access timespec) return int; - pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait"); - - -------------------------- - -- POSIX.1c Section 13 -- - -------------------------- - - type struct_sched_param is record - sched_priority : int; -- scheduling priority - end record; - pragma Convention (C, struct_sched_param); - - function pthread_setschedparam - (thread : pthread_t; - policy : int; - param : access struct_sched_param) return int; - pragma Import (C, pthread_setschedparam, "pthread_setschedparam"); - - function pthread_attr_setschedpolicy - (attr : access pthread_attr_t; - policy : int) return int; - pragma Import - (C, pthread_attr_setschedpolicy, "pthread_attr_setschedpolicy"); - - function sched_yield return int; - pragma Import (C, sched_yield, "sched_yield"); - - --------------------------- - -- P1003.1c - Section 16 -- - --------------------------- - - function pthread_attr_init - (attributes : access pthread_attr_t) return int; - pragma Import (C, pthread_attr_init, "pthread_attr_init"); - - function pthread_attr_destroy - (attributes : access pthread_attr_t) return int; - pragma Import (C, pthread_attr_destroy, "pthread_attr_destroy"); - - function pthread_attr_setdetachstate - (attr : access pthread_attr_t; - detachstate : int) return int; - pragma Import - (C, pthread_attr_setdetachstate, "pthread_attr_setdetachstate"); - - function pthread_attr_setstacksize - (attr : access pthread_attr_t; - stacksize : size_t) return int; - pragma Import (C, pthread_attr_setstacksize, "pthread_attr_setstacksize"); - - function pthread_create - (thread : access pthread_t; - attributes : access pthread_attr_t; - start_routine : Thread_Body; - arg : System.Address) return int; - pragma Import (C, pthread_create, "pthread_create"); - - procedure pthread_exit (status : System.Address); - pragma Import (C, pthread_exit, "pthread_exit"); - - function pthread_self return pthread_t; - pragma Import (C, pthread_self, "pthread_self"); - - -------------------------- - -- POSIX.1c Section 17 -- - -------------------------- - - function pthread_setspecific - (key : pthread_key_t; - value : System.Address) return int; - pragma Import (C, pthread_setspecific, "pthread_setspecific"); - - function pthread_getspecific (key : pthread_key_t) return System.Address; - pragma Import (C, pthread_getspecific, "pthread_getspecific"); - - type destructor_pointer is access procedure (arg : System.Address); - pragma Convention (C, destructor_pointer); - - function pthread_key_create - (key : access pthread_key_t; - destructor : destructor_pointer) return int; - pragma Import (C, pthread_key_create, "pthread_key_create"); - - CPU_SETSIZE : constant := 1_024; - - type bit_field is array (1 .. CPU_SETSIZE) of Boolean; - for bit_field'Size use CPU_SETSIZE; - pragma Pack (bit_field); - pragma Convention (C, bit_field); - - type cpu_set_t is record - bits : bit_field; - end record; - pragma Convention (C, cpu_set_t); - - function pthread_setaffinity_np - (thread : pthread_t; - cpusetsize : size_t; - cpuset : access cpu_set_t) return int; - pragma Import (C, pthread_setaffinity_np, "__gnat_pthread_setaffinity_np"); - -private - - type sigset_t is array (0 .. 31) of unsigned_long; - pragma Convention (C, sigset_t); - - type pid_t is new int; - - type time_t is new long; - - type timespec is record - tv_sec : time_t; - tv_nsec : long; - end record; - pragma Convention (C, timespec); - - type struct_timeval is record - tv_sec : time_t; - tv_usec : time_t; - end record; - pragma Convention (C, struct_timeval); - - type pthread_attr_t is record - detachstate : int; - schedpolicy : int; - schedparam : struct_sched_param; - inheritsched : int; - scope : int; - guardsize : size_t; - stackaddr_set : int; - stackaddr : System.Address; - stacksize : size_t; - end record; - pragma Convention (C, pthread_attr_t); - - type pthread_condattr_t is record - dummy : int; - end record; - pragma Convention (C, pthread_condattr_t); - - type pthread_mutexattr_t is record - mutexkind : int; - end record; - pragma Convention (C, pthread_mutexattr_t); - - type lock_array is array (1 .. 4) of int; - type atomic_lock_t is record - lock : lock_array; - end record; - pragma Convention (C, atomic_lock_t); - -- ??? Alignment should be 16 but this is larger than BIGGEST_ALIGNMENT. - -- This causes an erroneous pointer value to sometimes be passed to free - -- during deallocation. See PR ada/24533 for more details. - for atomic_lock_t'Alignment use 8; - - type struct_pthread_fast_lock is record - spinlock : atomic_lock_t; - status : long; - end record; - pragma Convention (C, struct_pthread_fast_lock); - - type pthread_mutex_t is record - m_reserved : int; - m_count : int; - m_owner : System.Address; - m_kind : int; - m_lock : struct_pthread_fast_lock; - end record; - pragma Convention (C, pthread_mutex_t); - - type pthread_cond_t is array (0 .. 47) of unsigned_char; - pragma Convention (C, pthread_cond_t); - - type pthread_key_t is new unsigned; - -end System.OS_Interface; diff --git a/gcc/ada/s-osinte-linux.ads b/gcc/ada/s-osinte-linux.ads index bb06c01a0b8..bbaa0b4282e 100644 --- a/gcc/ada/s-osinte-linux.ads +++ b/gcc/ada/s-osinte-linux.ads @@ -41,8 +41,8 @@ -- Preelaborate. This package is designed to be a bottom-level (leaf) package. with Ada.Unchecked_Conversion; - with Interfaces.C; +with System.Linux; package System.OS_Interface is pragma Preelaborate; @@ -67,12 +67,12 @@ package System.OS_Interface is function errno return int; pragma Import (C, errno, "__get_errno"); - EAGAIN : constant := 11; - EINTR : constant := 4; - EINVAL : constant := 22; - ENOMEM : constant := 12; - EPERM : constant := 1; - ETIMEDOUT : constant := 110; + EAGAIN : constant := System.Linux.EAGAIN; + EINTR : constant := System.Linux.EINTR; + EINVAL : constant := System.Linux.EINVAL; + ENOMEM : constant := System.Linux.ENOMEM; + EPERM : constant := System.Linux.EPERM; + ETIMEDOUT : constant := System.Linux.ETIMEDOUT; ------------- -- Signals -- @@ -82,44 +82,44 @@ package System.OS_Interface is type Signal is new int range 0 .. Max_Interrupt; for Signal'Size use int'Size; - SIGHUP : constant := 1; -- hangup - SIGINT : constant := 2; -- interrupt (rubout) - SIGQUIT : constant := 3; -- quit (ASCD FS) - SIGILL : constant := 4; -- illegal instruction (not reset) - SIGTRAP : constant := 5; -- trace trap (not reset) - SIGIOT : constant := 6; -- IOT instruction - SIGABRT : constant := 6; -- used by abort, replace SIGIOT in the future - SIGFPE : constant := 8; -- floating point exception - SIGKILL : constant := 9; -- kill (cannot be caught or ignored) - SIGBUS : constant := 7; -- bus error - SIGSEGV : constant := 11; -- segmentation violation - SIGPIPE : constant := 13; -- write on a pipe with no one to read it - SIGALRM : constant := 14; -- alarm clock - SIGTERM : constant := 15; -- software termination signal from kill - SIGUSR1 : constant := 10; -- user defined signal 1 - SIGUSR2 : constant := 12; -- user defined signal 2 - SIGCLD : constant := 17; -- alias for SIGCHLD - SIGCHLD : constant := 17; -- child status change - SIGPWR : constant := 30; -- power-fail restart - SIGWINCH : constant := 28; -- window size change - SIGURG : constant := 23; -- urgent condition on IO channel - SIGPOLL : constant := 29; -- pollable event occurred - SIGIO : constant := 29; -- I/O now possible (4.2 BSD) - SIGLOST : constant := 29; -- File lock lost - SIGSTOP : constant := 19; -- stop (cannot be caught or ignored) - SIGTSTP : constant := 20; -- user stop requested from tty - SIGCONT : constant := 18; -- stopped process has been continued - SIGTTIN : constant := 21; -- background tty read attempted - SIGTTOU : constant := 22; -- background tty write attempted - SIGVTALRM : constant := 26; -- virtual timer expired - SIGPROF : constant := 27; -- profiling timer expired - SIGXCPU : constant := 24; -- CPU time limit exceeded - SIGXFSZ : constant := 25; -- filesize limit exceeded - SIGUNUSED : constant := 31; -- unused signal (GNU/Linux) - SIGSTKFLT : constant := 16; -- coprocessor stack fault (Linux) - SIGLTHRRES : constant := 32; -- GNU/LinuxThreads restart signal - SIGLTHRCAN : constant := 33; -- GNU/LinuxThreads cancel signal - SIGLTHRDBG : constant := 34; -- GNU/LinuxThreads debugger signal + SIGHUP : constant := System.Linux.SIGHUP; + SIGINT : constant := System.Linux.SIGINT; + SIGQUIT : constant := System.Linux.SIGQUIT; + SIGILL : constant := System.Linux.SIGILL; + SIGTRAP : constant := System.Linux.SIGTRAP; + SIGIOT : constant := System.Linux.SIGIOT; + SIGABRT : constant := System.Linux.SIGABRT; + SIGFPE : constant := System.Linux.SIGFPE; + SIGKILL : constant := System.Linux.SIGKILL; + SIGBUS : constant := System.Linux.SIGBUS; + SIGSEGV : constant := System.Linux.SIGSEGV; + SIGPIPE : constant := System.Linux.SIGPIPE; + SIGALRM : constant := System.Linux.SIGALRM; + SIGTERM : constant := System.Linux.SIGTERM; + SIGUSR1 : constant := System.Linux.SIGUSR1; + SIGUSR2 : constant := System.Linux.SIGUSR2; + SIGCLD : constant := System.Linux.SIGCLD; + SIGCHLD : constant := System.Linux.SIGCHLD; + SIGPWR : constant := System.Linux.SIGPWR; + SIGWINCH : constant := System.Linux.SIGWINCH; + SIGURG : constant := System.Linux.SIGURG; + SIGPOLL : constant := System.Linux.SIGPOLL; + SIGIO : constant := System.Linux.SIGIO; + SIGLOST : constant := System.Linux.SIGLOST; + SIGSTOP : constant := System.Linux.SIGSTOP; + SIGTSTP : constant := System.Linux.SIGTSTP; + SIGCONT : constant := System.Linux.SIGCONT; + SIGTTIN : constant := System.Linux.SIGTTIN; + SIGTTOU : constant := System.Linux.SIGTTOU; + SIGVTALRM : constant := System.Linux.SIGVTALRM; + SIGPROF : constant := System.Linux.SIGPROF; + SIGXCPU : constant := System.Linux.SIGXCPU; + SIGXFSZ : constant := System.Linux.SIGXFSZ; + SIGUNUSED : constant := System.Linux.SIGUNUSED; + SIGSTKFLT : constant := System.Linux.SIGSTKFLT; + SIGLTHRRES : constant := System.Linux.SIGLTHRRES; + SIGLTHRCAN : constant := System.Linux.SIGLTHRCAN; + SIGLTHRDBG : constant := System.Linux.SIGLTHRDBG; SIGADAABORT : constant := SIGABRT; -- Change this if you want to use another signal for task abort. @@ -181,12 +181,13 @@ package System.OS_Interface is pragma Convention (C, siginfo_t); type struct_sigaction is record - sa_handler : System.Address; - sa_mask : sigset_t; - sa_flags : unsigned_long; - sa_restorer : System.Address; + sa_handler : System.Address; + sa_mask : sigset_t; + sa_flags : Interfaces.C.unsigned_long; + sa_restorer : System.Address; end record; pragma Convention (C, struct_sigaction); + type struct_sigaction_ptr is access all struct_sigaction; type Machine_State is record @@ -199,7 +200,8 @@ package System.OS_Interface is end record; type Machine_State_Ptr is access all Machine_State; - SA_SIGINFO : constant := 16#04#; + SA_SIGINFO : constant := System.Linux.SA_SIGINFO; + SA_ONSTACK : constant := System.Linux.SA_ONSTACK; SIG_BLOCK : constant := 0; SIG_UNBLOCK : constant := 1; @@ -299,6 +301,25 @@ package System.OS_Interface is -- Stack -- ----------- + type stack_t is record + ss_sp : System.Address; + ss_flags : int; + ss_size : size_t; + end record; + pragma Convention (C, stack_t); + + function sigaltstack + (ss : not null access stack_t; + oss : access stack_t) return int; + pragma Import (C, sigaltstack, "sigaltstack"); + + Alternate_Stack : aliased System.Address; + pragma Import (C, Alternate_Stack, "__gnat_alternate_stack"); + -- The alternate signal stack for stack overflows + + Alternate_Stack_Size : constant := 16 * 1024; + -- This must be in keeping with init.c:__gnat_alternate_stack + function Get_Stack_Base (thread : pthread_t) return Address; pragma Inline (Get_Stack_Base); -- This is a dummy procedure to share some GNULLI files @@ -483,9 +504,19 @@ package System.OS_Interface is private - type sigset_t is array (0 .. 127) of unsigned_char; + type sigset_t is array (0 .. 127) of Interfaces.C.unsigned_char; pragma Convention (C, sigset_t); - for sigset_t'Alignment use unsigned_long'Alignment; + for sigset_t'Alignment use Interfaces.C.unsigned_long'Alignment; + + pragma Warnings (Off); + for struct_sigaction use record + sa_handler at 0 range 0 .. Standard'Address_Size - 1; + sa_mask at Linux.sa_mask_pos range 0 .. 1023; + sa_flags at Linux.sa_flags_pos range 0 .. Standard'Address_Size - 1; + end record; + -- We intentionally leave sa_restorer unspecified and let the compiler + -- append it after the last field, so disable corresponding warning. + pragma Warnings (On); type pid_t is new int; @@ -526,20 +557,7 @@ private end record; pragma Convention (C, pthread_mutexattr_t); - type struct_pthread_fast_lock is record - status : long; - spinlock : int; - end record; - pragma Convention (C, struct_pthread_fast_lock); - - type pthread_mutex_t is record - m_reserved : int; - m_count : int; - m_owner : System.Address; - m_kind : int; - m_lock : struct_pthread_fast_lock; - end record; - pragma Convention (C, pthread_mutex_t); + type pthread_mutex_t is new System.Linux.pthread_mutex_t; type pthread_cond_t is array (0 .. 47) of unsigned_char; pragma Convention (C, pthread_cond_t); diff --git a/gcc/ada/s-osinte-lynxos-3.ads b/gcc/ada/s-osinte-lynxos-3.ads index f6ceec0790a..37c183b1f69 100644 --- a/gcc/ada/s-osinte-lynxos-3.ads +++ b/gcc/ada/s-osinte-lynxos-3.ads @@ -267,6 +267,9 @@ package System.OS_Interface is -- Stack -- ----------- + Alternate_Stack_Size : constant := 0; + -- No alternate signal stack is used on this platform + Stack_Base_Available : constant Boolean := False; -- Indicates wether the stack base is available on this target diff --git a/gcc/ada/s-osinte-lynxos.ads b/gcc/ada/s-osinte-lynxos.ads index 90107631261..13c2b88fcdb 100644 --- a/gcc/ada/s-osinte-lynxos.ads +++ b/gcc/ada/s-osinte-lynxos.ads @@ -170,7 +170,12 @@ package System.OS_Interface is pragma Convention (C, struct_sigaction); type struct_sigaction_ptr is access all struct_sigaction; - SA_SIGINFO : constant := 16#80#; + SA_SIGINFO : constant := 16#80#; + + SA_ONSTACK : constant := 16#00#; + -- SA_ONSTACK is not defined on LynxOS, but it is refered to in the POSIX + -- implementation of System.Interrupt_Management. Therefore we define a + -- dummy value of zero here so that setting this flag is a nop. SIG_BLOCK : constant := 0; SIG_UNBLOCK : constant := 1; @@ -276,6 +281,9 @@ package System.OS_Interface is -- Stack -- ----------- + Alternate_Stack_Size : constant := 0; + -- No alternate signal stack is used on this platform + Stack_Base_Available : constant Boolean := False; -- Indicates whether the stack base is available on this target diff --git a/gcc/ada/s-osinte-mingw.ads b/gcc/ada/s-osinte-mingw.ads index e0a3d7c75df..f526c77df8c 100644 --- a/gcc/ada/s-osinte-mingw.ads +++ b/gcc/ada/s-osinte-mingw.ads @@ -35,16 +35,17 @@ -- This is a NT (native) version of this package -- This package encapsulates all direct interfaces to OS services --- that are needed by the tasking run-time (libgnarl). +-- that are needed by the tasking run-time (libgnarl). For non tasking +-- oriented services consider declaring them into system-win32. -- PLEASE DO NOT add any with-clauses to this package or remove the pragma -- Preelaborate. This package is designed to be a bottom-level (leaf) package. -with Interfaces.C; +with Ada.Unchecked_Conversion; +with Interfaces.C; with Interfaces.C.Strings; - -with Ada.Unchecked_Conversion; +with System.Win32; package System.OS_Interface is pragma Preelaborate; @@ -58,39 +59,15 @@ package System.OS_Interface is -- General Types -- ------------------- - type DWORD is new Interfaces.C.unsigned_long; - type WORD is new Interfaces.C.unsigned_short; - - -- The LARGE_INTEGER type is actually a fixed point type - -- that only can represent integers. The reason for this is - -- easier conversion to Duration or other fixed point types. - -- (See Operations.Clock) - - type LARGE_INTEGER is delta 1.0 range -2.0**63 .. 2.0**63 - 1.0; - subtype PSZ is Interfaces.C.Strings.chars_ptr; - subtype PCHAR is Interfaces.C.Strings.chars_ptr; - - subtype PVOID is System.Address; - - Null_Void : constant PVOID := System.Null_Address; - type PLONG is access all Interfaces.C.long; - type PDWORD is access all DWORD; - type BYTE is new Interfaces.C.unsigned_char; - subtype CHAR is Interfaces.C.char; - - type BOOL is new Boolean; - for BOOL'Size use Interfaces.C.unsigned_long'Size; + Null_Void : constant Win32.PVOID := System.Null_Address; ------------------------- -- Handles for objects -- ------------------------- - type HANDLE is new Interfaces.C.long; - type PHANDLE is access all HANDLE; - - subtype Thread_Id is HANDLE; + subtype Thread_Id is Win32.HANDLE; ----------- -- Errno -- @@ -99,38 +76,6 @@ package System.OS_Interface is NO_ERROR : constant := 0; FUNC_ERR : constant := -1; - ----------- - -- Files -- - ----------- - - type SECURITY_ATTRIBUTES is record - nLength : DWORD; - pSecurityDescriptor : PVOID; - bInheritHandle : BOOL; - end record; - - function CloseHandle (hObject : HANDLE) return BOOL; - pragma Import (Stdcall, CloseHandle, "CloseHandle"); - - ------------------------ - -- System Information -- - ------------------------ - - type SYSTEM_INFO is record - dwOemId : DWORD; - dwPageSize : DWORD; - lpMinimumApplicationAddress : PVOID; - lpMaximumApplicationAddress : PVOID; - dwActiveProcessorMask : DWORD; - dwNumberOfProcessors : DWORD; - dwProcessorType : DWORD; - dwAllocationGranularity : DWORD; - dwReserved : DWORD; - end record; - - procedure GetSystemInfo (SI : access SYSTEM_INFO); - pragma Import (Stdcall, GetSystemInfo, "GetSystemInfo"); - ------------- -- Signals -- ------------- @@ -161,63 +106,6 @@ package System.OS_Interface is procedure kill (sig : Signal); pragma Import (C, kill, "raise"); - --------------------- - -- Time Management -- - --------------------- - - procedure Sleep (dwMilliseconds : DWORD); - pragma Import (Stdcall, Sleep, External_Name => "Sleep"); - - type SYSTEMTIME is record - wYear : WORD; - wMonth : WORD; - wDayOfWeek : WORD; - wDay : WORD; - wHour : WORD; - wMinute : WORD; - wSecond : WORD; - wMilliseconds : WORD; - end record; - - procedure GetSystemTime (pSystemTime : access SYSTEMTIME); - pragma Import (Stdcall, GetSystemTime, "GetSystemTime"); - - procedure GetSystemTimeAsFileTime (lpFileTime : access Long_Long_Integer); - pragma Import (Stdcall, GetSystemTimeAsFileTime, "GetSystemTimeAsFileTime"); - - function SetSystemTime (pSystemTime : access SYSTEMTIME) return BOOL; - pragma Import (Stdcall, SetSystemTime, "SetSystemTime"); - - function FileTimeToSystemTime - (lpFileTime : access Long_Long_Integer; - lpSystemTime : access SYSTEMTIME) return BOOL; - pragma Import (Stdcall, FileTimeToSystemTime, "FileTimeToSystemTime"); - - function SystemTimeToFileTime - (lpSystemTime : access SYSTEMTIME; - lpFileTime : access Long_Long_Integer) return BOOL; - pragma Import (Stdcall, SystemTimeToFileTime, "SystemTimeToFileTime"); - - function FileTimeToLocalFileTime - (lpFileTime : access Long_Long_Integer; - lpLocalFileTime : access Long_Long_Integer) return BOOL; - pragma Import (Stdcall, FileTimeToLocalFileTime, "FileTimeToLocalFileTime"); - - function LocalFileTimeToFileTime - (lpFileTime : access Long_Long_Integer; - lpLocalFileTime : access Long_Long_Integer) return BOOL; - pragma Import (Stdcall, LocalFileTimeToFileTime, "LocalFileTimeToFileTime"); - - function QueryPerformanceCounter - (lpPerformanceCount : access LARGE_INTEGER) return BOOL; - pragma Import - (Stdcall, QueryPerformanceCounter, "QueryPerformanceCounter"); - - function QueryPerformanceFrequency - (lpFrequency : access LARGE_INTEGER) return BOOL; - pragma Import - (Stdcall, QueryPerformanceFrequency, "QueryPerformanceFrequency"); - ------------- -- Threads -- ------------- @@ -233,11 +121,11 @@ package System.OS_Interface is pragma Import (Stdcall, SwitchToThread, "SwitchToThread"); function GetThreadTimes - (hThread : HANDLE; + (hThread : Win32.HANDLE; lpCreationTime : access Long_Long_Integer; lpExitTime : access Long_Long_Integer; lpKernelTime : access Long_Long_Integer; - lpUserTime : access Long_Long_Integer) return BOOL; + lpUserTime : access Long_Long_Integer) return Win32.BOOL; pragma Import (Stdcall, GetThreadTimes, "GetThreadTimes"); ----------------------- @@ -246,52 +134,33 @@ package System.OS_Interface is type CRITICAL_SECTION is private; - procedure InitializeCriticalSection - (pCriticalSection : access CRITICAL_SECTION); - pragma Import - (Stdcall, InitializeCriticalSection, "InitializeCriticalSection"); - - procedure EnterCriticalSection - (pCriticalSection : access CRITICAL_SECTION); - pragma Import (Stdcall, EnterCriticalSection, "EnterCriticalSection"); - - procedure LeaveCriticalSection - (pCriticalSection : access CRITICAL_SECTION); - pragma Import (Stdcall, LeaveCriticalSection, "LeaveCriticalSection"); - - procedure DeleteCriticalSection - (pCriticalSection : access CRITICAL_SECTION); - pragma Import (Stdcall, DeleteCriticalSection, "DeleteCriticalSection"); - ------------------------------------------------------------- -- Thread Creation, Activation, Suspension And Termination -- ------------------------------------------------------------- - subtype ProcessorId is DWORD; - type PTHREAD_START_ROUTINE is access function - (pThreadParameter : PVOID) return DWORD; + (pThreadParameter : Win32.PVOID) return Win32.DWORD; pragma Convention (Stdcall, PTHREAD_START_ROUTINE); function To_PTHREAD_START_ROUTINE is new Ada.Unchecked_Conversion (System.Address, PTHREAD_START_ROUTINE); function CreateThread - (pThreadAttributes : access SECURITY_ATTRIBUTES; - dwStackSize : DWORD; + (pThreadAttributes : access Win32.SECURITY_ATTRIBUTES; + dwStackSize : Win32.DWORD; pStartAddress : PTHREAD_START_ROUTINE; - pParameter : PVOID; - dwCreationFlags : DWORD; - pThreadId : PDWORD) return HANDLE; + pParameter : Win32.PVOID; + dwCreationFlags : Win32.DWORD; + pThreadId : access Win32.DWORD) return Win32.HANDLE; pragma Import (Stdcall, CreateThread, "CreateThread"); function BeginThreadEx - (pThreadAttributes : access SECURITY_ATTRIBUTES; - dwStackSize : DWORD; + (pThreadAttributes : access Win32.SECURITY_ATTRIBUTES; + dwStackSize : Win32.DWORD; pStartAddress : PTHREAD_START_ROUTINE; - pParameter : PVOID; - dwCreationFlags : DWORD; - pThreadId : PDWORD) return HANDLE; + pParameter : Win32.PVOID; + dwCreationFlags : Win32.DWORD; + pThreadId : not null access Win32.DWORD) return Win32.HANDLE; pragma Import (C, BeginThreadEx, "_beginthreadex"); Debug_Process : constant := 16#00000001#; @@ -311,70 +180,66 @@ package System.OS_Interface is Stack_Size_Param_Is_A_Reservation : constant := 16#00010000#; function GetExitCodeThread - (hThread : HANDLE; - pExitCode : PDWORD) return BOOL; + (hThread : Win32.HANDLE; + pExitCode : not null access Win32.DWORD) return Win32.BOOL; pragma Import (Stdcall, GetExitCodeThread, "GetExitCodeThread"); - function ResumeThread (hThread : HANDLE) return DWORD; + function ResumeThread (hThread : Win32.HANDLE) return Win32.DWORD; pragma Import (Stdcall, ResumeThread, "ResumeThread"); - function SuspendThread (hThread : HANDLE) return DWORD; + function SuspendThread (hThread : Win32.HANDLE) return Win32.DWORD; pragma Import (Stdcall, SuspendThread, "SuspendThread"); - procedure ExitThread (dwExitCode : DWORD); + procedure ExitThread (dwExitCode : Win32.DWORD); pragma Import (Stdcall, ExitThread, "ExitThread"); - procedure EndThreadEx (dwExitCode : DWORD); + procedure EndThreadEx (dwExitCode : Win32.DWORD); pragma Import (C, EndThreadEx, "_endthreadex"); function TerminateThread - (hThread : HANDLE; - dwExitCode : DWORD) return BOOL; + (hThread : Win32.HANDLE; + dwExitCode : Win32.DWORD) return Win32.BOOL; pragma Import (Stdcall, TerminateThread, "TerminateThread"); - function GetCurrentThread return HANDLE; + function GetCurrentThread return Win32.HANDLE; pragma Import (Stdcall, GetCurrentThread, "GetCurrentThread"); - function GetCurrentProcess return HANDLE; + function GetCurrentProcess return Win32.HANDLE; pragma Import (Stdcall, GetCurrentProcess, "GetCurrentProcess"); - function GetCurrentThreadId return DWORD; + function GetCurrentThreadId return Win32.DWORD; pragma Import (Stdcall, GetCurrentThreadId, "GetCurrentThreadId"); - function TlsAlloc return DWORD; + function TlsAlloc return Win32.DWORD; pragma Import (Stdcall, TlsAlloc, "TlsAlloc"); - function TlsGetValue (dwTlsIndex : DWORD) return PVOID; + function TlsGetValue (dwTlsIndex : Win32.DWORD) return Win32.PVOID; pragma Import (Stdcall, TlsGetValue, "TlsGetValue"); - function TlsSetValue (dwTlsIndex : DWORD; pTlsValue : PVOID) return BOOL; + function TlsSetValue + (dwTlsIndex : Win32.DWORD; pTlsValue : Win32.PVOID) return Win32.BOOL; pragma Import (Stdcall, TlsSetValue, "TlsSetValue"); - function TlsFree (dwTlsIndex : DWORD) return BOOL; + function TlsFree (dwTlsIndex : Win32.DWORD) return Win32.BOOL; pragma Import (Stdcall, TlsFree, "TlsFree"); - TLS_Nothing : constant := DWORD'Last; + TLS_Nothing : constant := Win32.DWORD'Last; procedure ExitProcess (uExitCode : Interfaces.C.unsigned); pragma Import (Stdcall, ExitProcess, "ExitProcess"); function WaitForSingleObject - (hHandle : HANDLE; - dwMilliseconds : DWORD) return DWORD; + (hHandle : Win32.HANDLE; + dwMilliseconds : Win32.DWORD) return Win32.DWORD; pragma Import (Stdcall, WaitForSingleObject, "WaitForSingleObject"); function WaitForSingleObjectEx - (hHandle : HANDLE; - dwMilliseconds : DWORD; - fAlertable : BOOL) return DWORD; + (hHandle : Win32.HANDLE; + dwMilliseconds : Win32.DWORD; + fAlertable : Win32.BOOL) return Win32.DWORD; pragma Import (Stdcall, WaitForSingleObjectEx, "WaitForSingleObjectEx"); - function SetThreadIdealProcessor - (hThread : HANDLE; - dwIdealProcessor : ProcessorId) return DWORD; - pragma Import (Stdcall, SetThreadIdealProcessor, "SetThreadIdealProcessor"); - - Wait_Infinite : constant := DWORD'Last; + Wait_Infinite : constant := Win32.DWORD'Last; WAIT_TIMEOUT : constant := 16#0000_0102#; WAIT_FAILED : constant := 16#FFFF_FFFF#; @@ -383,59 +248,59 @@ package System.OS_Interface is ------------------------------------ function CreateSemaphore - (pSemaphoreAttributes : access SECURITY_ATTRIBUTES; + (pSemaphoreAttributes : access Win32.SECURITY_ATTRIBUTES; lInitialCount : Interfaces.C.long; lMaximumCount : Interfaces.C.long; - pName : PSZ) return HANDLE; + pName : PSZ) return Win32.HANDLE; pragma Import (Stdcall, CreateSemaphore, "CreateSemaphoreA"); function OpenSemaphore - (dwDesiredAccess : DWORD; - bInheritHandle : BOOL; - pName : PSZ) return HANDLE; + (dwDesiredAccess : Win32.DWORD; + bInheritHandle : Win32.BOOL; + pName : PSZ) return Win32.HANDLE; pragma Import (Stdcall, OpenSemaphore, "OpenSemaphoreA"); function ReleaseSemaphore - (hSemaphore : HANDLE; + (hSemaphore : Win32.HANDLE; lReleaseCount : Interfaces.C.long; - pPreviousCount : PLONG) return BOOL; + pPreviousCount : access Win32.LONG) return Win32.BOOL; pragma Import (Stdcall, ReleaseSemaphore, "ReleaseSemaphore"); function CreateEvent - (pEventAttributes : access SECURITY_ATTRIBUTES; - bManualReset : BOOL; - bInitialState : BOOL; - pName : PSZ) return HANDLE; + (pEventAttributes : access Win32.SECURITY_ATTRIBUTES; + bManualReset : Win32.BOOL; + bInitialState : Win32.BOOL; + pName : PSZ) return Win32.HANDLE; pragma Import (Stdcall, CreateEvent, "CreateEventA"); function OpenEvent - (dwDesiredAccess : DWORD; - bInheritHandle : BOOL; - pName : PSZ) return HANDLE; + (dwDesiredAccess : Win32.DWORD; + bInheritHandle : Win32.BOOL; + pName : PSZ) return Win32.HANDLE; pragma Import (Stdcall, OpenEvent, "OpenEventA"); - function SetEvent (hEvent : HANDLE) return BOOL; + function SetEvent (hEvent : Win32.HANDLE) return Win32.BOOL; pragma Import (Stdcall, SetEvent, "SetEvent"); - function ResetEvent (hEvent : HANDLE) return BOOL; + function ResetEvent (hEvent : Win32.HANDLE) return Win32.BOOL; pragma Import (Stdcall, ResetEvent, "ResetEvent"); - function PulseEvent (hEvent : HANDLE) return BOOL; + function PulseEvent (hEvent : Win32.HANDLE) return Win32.BOOL; pragma Import (Stdcall, PulseEvent, "PulseEvent"); function CreateMutex - (pMutexAttributes : access SECURITY_ATTRIBUTES; - bInitialOwner : BOOL; - pName : PSZ) return HANDLE; + (pMutexAttributes : access Win32.SECURITY_ATTRIBUTES; + bInitialOwner : Win32.BOOL; + pName : PSZ) return Win32.HANDLE; pragma Import (Stdcall, CreateMutex, "CreateMutexA"); function OpenMutex - (dwDesiredAccess : DWORD; - bInheritHandle : BOOL; - pName : PSZ) return HANDLE; + (dwDesiredAccess : Win32.DWORD; + bInheritHandle : Win32.BOOL; + pName : PSZ) return Win32.HANDLE; pragma Import (Stdcall, OpenMutex, "OpenMutexA"); - function ReleaseMutex (hMutex : HANDLE) return BOOL; + function ReleaseMutex (hMutex : Win32.HANDLE) return Win32.BOOL; pragma Import (Stdcall, ReleaseMutex, "ReleaseMutex"); --------------------------------------------------- @@ -447,21 +312,21 @@ package System.OS_Interface is ----------------- function SetThreadPriority - (hThread : HANDLE; - nPriority : Interfaces.C.int) return BOOL; + (hThread : Win32.HANDLE; + nPriority : Interfaces.C.int) return Win32.BOOL; pragma Import (Stdcall, SetThreadPriority, "SetThreadPriority"); - function GetThreadPriority (hThread : HANDLE) return Interfaces.C.int; + function GetThreadPriority (hThread : Win32.HANDLE) return Interfaces.C.int; pragma Import (Stdcall, GetThreadPriority, "GetThreadPriority"); function SetPriorityClass - (hProcess : HANDLE; - dwPriorityClass : DWORD) return BOOL; + (hProcess : Win32.HANDLE; + dwPriorityClass : Win32.DWORD) return Win32.BOOL; pragma Import (Stdcall, SetPriorityClass, "SetPriorityClass"); procedure SetThreadPriorityBoost - (hThread : HANDLE; - DisablePriorityBoost : BOOL); + (hThread : Win32.HANDLE; + DisablePriorityBoost : Win32.BOOL); pragma Import (Stdcall, SetThreadPriorityBoost, "SetThreadPriorityBoost"); Normal_Priority_Class : constant := 16#00000020#; @@ -478,22 +343,21 @@ package System.OS_Interface is Thread_Priority_Time_Critical : constant := 15; Thread_Priority_Error_Return : constant := Interfaces.C.long'Last; - function GetLastError return DWORD; - pragma Import (Stdcall, GetLastError, "GetLastError"); - private type sigset_t is new Interfaces.C.unsigned_long; type CRITICAL_SECTION is record - DebugInfo : System.Address; - -- The following three fields control entering and - -- exiting the critical section for the resource + DebugInfo : System.Address; + LockCount : Long_Integer; RecursionCount : Long_Integer; - OwningThread : HANDLE; - LockSemaphore : HANDLE; - Reserved : DWORD; + OwningThread : Win32.HANDLE; + -- The above three fields control entering and exiting the critical + -- section for the resource. + + LockSemaphore : Win32.HANDLE; + Reserved : Win32.DWORD; end record; end System.OS_Interface; diff --git a/gcc/ada/s-osinte-solaris-posix.ads b/gcc/ada/s-osinte-solaris-posix.ads index c45dca19cfc..05b328df26a 100644 --- a/gcc/ada/s-osinte-solaris-posix.ads +++ b/gcc/ada/s-osinte-solaris-posix.ads @@ -165,6 +165,7 @@ package System.OS_Interface is type struct_sigaction_ptr is access all struct_sigaction; SA_SIGINFO : constant := 16#0008#; + SA_ONSTACK : constant := 16#0001#; SIG_BLOCK : constant := 1; SIG_UNBLOCK : constant := 2; @@ -272,26 +273,42 @@ package System.OS_Interface is -- Stack -- ----------- + type stack_t is record + ss_sp : System.Address; + ss_size : size_t; + ss_flags : int; + end record; + pragma Convention (C, stack_t); + + function sigaltstack + (ss : not null access stack_t; + oss : access stack_t) return int; + pragma Import (C, sigaltstack, "sigaltstack"); + + Alternate_Stack : aliased System.Address; + -- This is a dummy definition, never used (Alternate_Stack_Size is null) + + Alternate_Stack_Size : constant := 0; + -- No alternate signal stack is used on this platform + Stack_Base_Available : constant Boolean := False; -- Indicates whether the stack base is available on this target function Get_Stack_Base (thread : pthread_t) return Address; pragma Inline (Get_Stack_Base); - -- returns the stack base of the specified thread. - -- Only call this function when Stack_Base_Available is True. + -- Returns the stack base of the specified thread. Only call this function + -- when Stack_Base_Available is True. function Get_Page_Size return size_t; function Get_Page_Size return Address; pragma Import (C, Get_Page_Size, "getpagesize"); - -- returns the size of a page, or 0 if this is not relevant on this - -- target + -- Returns the size of a page, or 0 if this is not relevant on this target PROT_NONE : constant := 0; PROT_READ : constant := 1; PROT_WRITE : constant := 2; PROT_EXEC : constant := 4; PROT_ALL : constant := PROT_READ + PROT_WRITE + PROT_EXEC; - PROT_ON : constant := PROT_READ; PROT_OFF : constant := PROT_ALL; diff --git a/gcc/ada/s-osinte-tru64.ads b/gcc/ada/s-osinte-tru64.ads index 512267780b0..efb739f8f50 100644 --- a/gcc/ada/s-osinte-tru64.ads +++ b/gcc/ada/s-osinte-tru64.ads @@ -176,6 +176,7 @@ package System.OS_Interface is SA_NODEFER : constant := 8; SA_SIGINFO : constant := 16#40#; + SA_ONSTACK : constant := 16#01#; function sigaction (sig : Signal; diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb index 6c64f341eec..a4bc9495719 100644 --- a/gcc/ada/s-taprop-linux.adb +++ b/gcc/ada/s-taprop-linux.adb @@ -49,7 +49,6 @@ with System.Task_Info; with System.Tasking.Debug; with System.Interrupt_Management; with System.OS_Primitives; -with System.Storage_Elements; with System.Stack_Checking.Operations; with System.Soft_Links; @@ -69,9 +68,11 @@ package body System.Task_Primitives.Operations is use System.OS_Interface; use System.Parameters; use System.OS_Primitives; - use System.Storage_Elements; use System.Task_Info; + Use_Alternate_Stack : constant Boolean := Alternate_Stack_Size /= 0; + -- Whether to use an alternate signal stack for stack overflows + ---------------- -- Local Data -- ---------------- @@ -161,13 +162,6 @@ package body System.Task_Primitives.Operations is function To_pthread_t is new Ada.Unchecked_Conversion (unsigned_long, System.OS_Interface.pthread_t); - procedure Get_Stack_Attributes - (T : Task_Id; - ISP : out System.Address; - Size : out Storage_Offset); - -- Fill ISP and Size with the Initial Stack Pointer value and the - -- thread stack size for task T. - ------------------- -- Abort_Handler -- ------------------- @@ -696,50 +690,6 @@ package body System.Task_Primitives.Operations is return T.Common.Current_Priority; end Get_Priority; - -------------------------- - -- Get_Stack_Attributes -- - -------------------------- - - procedure Get_Stack_Attributes - (T : Task_Id; - ISP : out System.Address; - Size : out Storage_Offset) - is - function pthread_getattr_np - (thread : pthread_t; - attr : System.Address) return Interfaces.C.int; - pragma Import (C, pthread_getattr_np, "pthread_getattr_np"); - - function pthread_attr_getstack - (attr : System.Address; - base : System.Address; - size : System.Address) return Interfaces.C.int; - pragma Import (C, pthread_attr_getstack, "pthread_attr_getstack"); - - Result : Interfaces.C.int; - - Attributes : aliased pthread_attr_t; - Stack_Base : aliased System.Address; - Stack_Size : aliased Storage_Offset; - - begin - Result := - pthread_getattr_np - (T.Common.LL.Thread, Attributes'Address); - pragma Assert (Result = 0); - - Result := - pthread_attr_getstack - (Attributes'Address, Stack_Base'Address, Stack_Size'Address); - pragma Assert (Result = 0); - - Result := pthread_attr_destroy (Attributes'Access); - pragma Assert (Result = 0); - - ISP := Stack_Base + Stack_Size; - Size := Stack_Size; - end Get_Stack_Attributes; - ---------------- -- Enter_Task -- ---------------- @@ -747,8 +697,7 @@ package body System.Task_Primitives.Operations is procedure Enter_Task (Self_ID : Task_Id) is begin if Self_ID.Common.Task_Info /= null - and then - Self_ID.Common.Task_Info.CPU_Affinity = No_CPU + and then Self_ID.Common.Task_Info.CPU_Affinity = No_CPU then raise Invalid_CPU_Number; end if; @@ -769,17 +718,18 @@ package body System.Task_Primitives.Operations is Unlock_RTS; - -- Determine where the task stack starts, how large it is, and let the - -- stack checking engine know about it. - - declare - Initial_SP : System.Address; - Stack_Size : Storage_Offset; - begin - Get_Stack_Attributes (Self_ID, Initial_SP, Stack_Size); - System.Stack_Checking.Operations.Notify_Stack_Attributes - (Initial_SP, Stack_Size); - end; + if Use_Alternate_Stack then + declare + Stack : aliased stack_t; + Result : Interfaces.C.int; + begin + Stack.ss_sp := Self_ID.Common.Task_Alternate_Stack; + Stack.ss_size := Alternate_Stack_Size; + Stack.ss_flags := 0; + Result := sigaltstack (Stack'Access, null); + pragma Assert (Result = 0); + end; + end if; end Enter_Task; -------------- @@ -864,10 +814,14 @@ package body System.Task_Primitives.Operations is Priority : System.Any_Priority; Succeeded : out Boolean) is - Attributes : aliased pthread_attr_t; - Result : Interfaces.C.int; + Attributes : aliased pthread_attr_t; + Adjusted_Stack_Size : Interfaces.C.size_t; + Result : Interfaces.C.int; begin + Adjusted_Stack_Size := + Interfaces.C.size_t (Stack_Size + Alternate_Stack_Size); + Result := pthread_attr_init (Attributes'Access); pragma Assert (Result = 0 or else Result = ENOMEM); @@ -878,7 +832,7 @@ package body System.Task_Primitives.Operations is Result := pthread_attr_setstacksize - (Attributes'Access, Interfaces.C.size_t (Stack_Size)); + (Attributes'Access, Adjusted_Stack_Size); pragma Assert (Result = 0); Result := @@ -896,7 +850,8 @@ package body System.Task_Primitives.Operations is Attributes'Access, Thread_Body_Access (Wrapper), To_Address (T)); - pragma Assert (Result = 0 or else Result = EAGAIN); + pragma Assert + (Result = 0 or else Result = EAGAIN or else Result = ENOMEM); if Result /= 0 then Succeeded := False; @@ -1148,8 +1103,7 @@ package body System.Task_Primitives.Operations is pragma Assert (Result = 0); SSL.Abort_Undefer.all; - end - if; + end if; end Suspend_Until_True; ---------------- @@ -1253,6 +1207,7 @@ package body System.Task_Primitives.Operations is old_act : aliased struct_sigaction; Tmp_Set : aliased sigset_t; Result : Interfaces.C.int; + -- Whether to use an alternate signal stack for stack overflows function State (Int : System.Interrupt_Management.Interrupt_ID) return Character; @@ -1297,6 +1252,11 @@ package body System.Task_Primitives.Operations is Specific.Initialize (Environment_Task); + if Use_Alternate_Stack then + Environment_Task.Common.Task_Alternate_Stack := + Alternate_Stack'Address; + end if; + Enter_Task (Environment_Task); -- Install the abort-signal handler diff --git a/gcc/ada/s-taprop-mingw.adb b/gcc/ada/s-taprop-mingw.adb index adf1a31ec45..898b75e2173 100644 --- a/gcc/ada/s-taprop-mingw.adb +++ b/gcc/ada/s-taprop-mingw.adb @@ -49,6 +49,7 @@ with System.Tasking.Debug; with System.OS_Primitives; with System.Task_Info; with System.Interrupt_Management; +with System.Win32.Ext; with System.Soft_Links; -- We use System.Soft_Links instead of System.Tasking.Initialization because @@ -68,6 +69,8 @@ package body System.Task_Primitives.Operations is use System.Parameters; use System.OS_Primitives; use System.Task_Info; + use System.Win32; + use System.Win32.Ext; pragma Link_With ("-Xlinker --stack=0x200000,0x1000"); -- Change the default stack size (2 MB) for tasking programs on Windows. @@ -76,6 +79,30 @@ package body System.Task_Primitives.Operations is -- Also note that under Windows XP, we use a Windows XP extension to -- specify the stack size on a per task basis, as done under other OSes. + --------------------- + -- Local Functions -- + --------------------- + + procedure InitializeCriticalSection (pCriticalSection : access RTS_Lock); + procedure InitializeCriticalSection + (pCriticalSection : access CRITICAL_SECTION); + pragma Import + (Stdcall, InitializeCriticalSection, "InitializeCriticalSection"); + + procedure EnterCriticalSection (pCriticalSection : access RTS_Lock); + procedure EnterCriticalSection + (pCriticalSection : access CRITICAL_SECTION); + pragma Import (Stdcall, EnterCriticalSection, "EnterCriticalSection"); + + procedure LeaveCriticalSection (pCriticalSection : access RTS_Lock); + procedure LeaveCriticalSection (pCriticalSection : access CRITICAL_SECTION); + pragma Import (Stdcall, LeaveCriticalSection, "LeaveCriticalSection"); + + procedure DeleteCriticalSection (pCriticalSection : access RTS_Lock); + procedure DeleteCriticalSection + (pCriticalSection : access CRITICAL_SECTION); + pragma Import (Stdcall, DeleteCriticalSection, "DeleteCriticalSection"); + ---------------- -- Local Data -- ---------------- @@ -140,7 +167,7 @@ package body System.Task_Primitives.Operations is Succeeded : BOOL; begin Succeeded := TlsSetValue (TlsIndex, To_Address (Self_Id)); - pragma Assert (Succeeded = True); + pragma Assert (Succeeded = Win32.TRUE); end Set; end Specific; @@ -192,7 +219,7 @@ package body System.Task_Primitives.Operations is procedure Initialize_Cond (Cond : not null access Condition_Variable) is hEvent : HANDLE; begin - hEvent := CreateEvent (null, True, False, Null_Ptr); + hEvent := CreateEvent (null, Win32.TRUE, Win32.FALSE, Null_Ptr); pragma Assert (hEvent /= 0); Cond.all := Condition_Variable (hEvent); end Initialize_Cond; @@ -208,7 +235,7 @@ package body System.Task_Primitives.Operations is Result : BOOL; begin Result := CloseHandle (HANDLE (Cond.all)); - pragma Assert (Result = True); + pragma Assert (Result = Win32.TRUE); end Finalize_Cond; ----------------- @@ -219,7 +246,7 @@ package body System.Task_Primitives.Operations is Result : BOOL; begin Result := SetEvent (HANDLE (Cond.all)); - pragma Assert (Result = True); + pragma Assert (Result = Win32.TRUE); end Cond_Signal; --------------- @@ -243,7 +270,7 @@ package body System.Task_Primitives.Operations is -- Must reset Cond BEFORE L is unlocked Result_Bool := ResetEvent (HANDLE (Cond.all)); - pragma Assert (Result_Bool = True); + pragma Assert (Result_Bool = Win32.TRUE); Unlock (L, Global_Lock => True); -- No problem if we are interrupted here: if the condition is signaled, @@ -283,7 +310,7 @@ package body System.Task_Primitives.Operations is -- Must reset Cond BEFORE L is unlocked Result := ResetEvent (HANDLE (Cond.all)); - pragma Assert (Result = True); + pragma Assert (Result = Win32.TRUE); Unlock (L, Global_Lock => True); -- No problem if we are interrupted here: if the condition is signaled, @@ -316,7 +343,7 @@ package body System.Task_Primitives.Operations is if Timed_Out then Result := SetEvent (HANDLE (Cond.all)); - pragma Assert (Result = True); + pragma Assert (Result = Win32.TRUE); end if; Status := Integer (Wait_Result); @@ -384,7 +411,7 @@ package body System.Task_Primitives.Operations is is pragma Unreferenced (Level); begin - InitializeCriticalSection (CRITICAL_SECTION (L.all)'Unrestricted_Access); + InitializeCriticalSection (L); end Initialize_Lock; ------------------- @@ -398,7 +425,7 @@ package body System.Task_Primitives.Operations is procedure Finalize_Lock (L : not null access RTS_Lock) is begin - DeleteCriticalSection (CRITICAL_SECTION (L.all)'Unrestricted_Access); + DeleteCriticalSection (L); end Finalize_Lock; ---------------- @@ -426,15 +453,14 @@ package body System.Task_Primitives.Operations is is begin if not Single_Lock or else Global_Lock then - EnterCriticalSection (CRITICAL_SECTION (L.all)'Unrestricted_Access); + EnterCriticalSection (L); end if; end Write_Lock; procedure Write_Lock (T : Task_Id) is begin if not Single_Lock then - EnterCriticalSection - (CRITICAL_SECTION (T.Common.LL.L)'Unrestricted_Access); + EnterCriticalSection (T.Common.LL.L'Access); end if; end Write_Lock; @@ -461,15 +487,14 @@ package body System.Task_Primitives.Operations is (L : not null access RTS_Lock; Global_Lock : Boolean := False) is begin if not Single_Lock or else Global_Lock then - LeaveCriticalSection (CRITICAL_SECTION (L.all)'Unrestricted_Access); + LeaveCriticalSection (L); end if; end Unlock; procedure Unlock (T : Task_Id) is begin if not Single_Lock then - LeaveCriticalSection - (CRITICAL_SECTION (T.Common.LL.L)'Unrestricted_Access); + LeaveCriticalSection (T.Common.LL.L'Access); end if; end Unlock; @@ -708,7 +733,7 @@ package body System.Task_Primitives.Operations is begin Res := SetThreadPriority (T.Common.LL.Thread, Interfaces.C.int (Underlying_Priorities (Prio))); - pragma Assert (Res = True); + pragma Assert (Res = Win32.TRUE); if Dispatching_Policy = 'F' or else Get_Policy (Prio) = 'F' then @@ -869,7 +894,7 @@ package body System.Task_Primitives.Operations is hTask : HANDLE; TaskId : aliased DWORD; - pTaskParameter : System.OS_Interface.PVOID; + pTaskParameter : Win32.PVOID; Result : DWORD; Entry_Point : PTHREAD_START_ROUTINE; @@ -920,7 +945,7 @@ package body System.Task_Primitives.Operations is -- boost. A priority boost is temporarily given by the system to a -- thread when it is taken out of a wait state. - SetThreadPriorityBoost (hTask, DisablePriorityBoost => True); + SetThreadPriorityBoost (hTask, DisablePriorityBoost => Win32.TRUE); end if; -- Step 4: Handle Task_Info @@ -972,7 +997,7 @@ package body System.Task_Primitives.Operations is Result := WaitForSingleObject (T.Common.LL.Thread, Wait_Infinite); pragma Assert (Result /= WAIT_FAILED); Succeeded := CloseHandle (T.Common.LL.Thread); - pragma Assert (Succeeded = True); + pragma Assert (Succeeded = Win32.TRUE); end if; Free (Self_ID); @@ -1095,7 +1120,7 @@ package body System.Task_Primitives.Operations is -- Initialize internal condition variable - S.CV := CreateEvent (null, True, False, Null_Ptr); + S.CV := CreateEvent (null, Win32.TRUE, Win32.FALSE, Null_Ptr); pragma Assert (S.CV /= 0); end Initialize; @@ -1113,7 +1138,7 @@ package body System.Task_Primitives.Operations is -- Destroy internal condition variable Result := CloseHandle (S.CV); - pragma Assert (Result = True); + pragma Assert (Result = Win32.TRUE); end Finalize; ------------------- @@ -1166,7 +1191,7 @@ package body System.Task_Primitives.Operations is S.State := False; Result := SetEvent (S.CV); - pragma Assert (Result = True); + pragma Assert (Result = Win32.TRUE); else S.State := True; end if; @@ -1215,7 +1240,7 @@ package body System.Task_Primitives.Operations is -- Must reset CV BEFORE L is unlocked Result_Bool := ResetEvent (S.CV); - pragma Assert (Result_Bool = True); + pragma Assert (Result_Bool = Win32.TRUE); LeaveCriticalSection (S.L'Access); diff --git a/gcc/ada/s-taprop-posix.adb b/gcc/ada/s-taprop-posix.adb index 816bb50a7b6..5b677bf539f 100644 --- a/gcc/ada/s-taprop-posix.adb +++ b/gcc/ada/s-taprop-posix.adb @@ -73,6 +73,9 @@ package body System.Task_Primitives.Operations is use System.Parameters; use System.OS_Primitives; + Use_Alternate_Stack : constant Boolean := Alternate_Stack_Size /= 0; + -- Whether to use an alternate signal stack for stack overflows + ---------------- -- Local Data -- ---------------- @@ -798,6 +801,19 @@ package body System.Task_Primitives.Operations is end loop; Unlock_RTS; + + if Use_Alternate_Stack then + declare + Stack : aliased stack_t; + Result : Interfaces.C.int; + begin + Stack.ss_sp := Self_ID.Common.Task_Alternate_Stack; + Stack.ss_size := Alternate_Stack_Size; + Stack.ss_flags := 0; + Result := sigaltstack (Stack'Access, null); + pragma Assert (Result = 0); + end; + end if; end Enter_Task; -------------- @@ -932,7 +948,8 @@ package body System.Task_Primitives.Operations is use System.Task_Info; begin - Adjusted_Stack_Size := Interfaces.C.size_t (Stack_Size); + Adjusted_Stack_Size := + Interfaces.C.size_t (Stack_Size + Alternate_Stack_Size); if Stack_Base_Available then @@ -1415,6 +1432,11 @@ package body System.Task_Primitives.Operations is Specific.Initialize (Environment_Task); + if Use_Alternate_Stack then + Environment_Task.Common.Task_Alternate_Stack := + Alternate_Stack'Address; + end if; + Enter_Task (Environment_Task); -- Install the abort-signal handler diff --git a/gcc/ada/s-taskin.ads b/gcc/ada/s-taskin.ads index 045f176db02..85f8dfc6af7 100644 --- a/gcc/ada/s-taskin.ads +++ b/gcc/ada/s-taskin.ads @@ -106,6 +106,7 @@ package System.Tasking is type Ada_Task_Control_Block; type Task_Id is access all Ada_Task_Control_Block; + for Task_Id'Size use System.Task_Primitives.Task_Address_Size; Null_Task : constant Task_Id; @@ -117,9 +118,11 @@ package System.Tasking is -- from the run-time system. function To_Task_Id is - new Ada.Unchecked_Conversion (System.Address, Task_Id); + new Ada.Unchecked_Conversion + (System.Task_Primitives.Task_Address, Task_Id); function To_Address is - new Ada.Unchecked_Conversion (Task_Id, System.Address); + new Ada.Unchecked_Conversion + (Task_Id, System.Task_Primitives.Task_Address); ----------------------- -- Enumeration types -- @@ -340,7 +343,7 @@ package System.Tasking is -- Abnormal means that the task terminates because it is being aborted -- handled_Exception means that the task terminates because of exception - -- raised by by the execution of its task_body. + -- raised by the execution of its task_body. type Termination_Handler is access protected procedure (Cause : Cause_Of_Termination; @@ -492,6 +495,11 @@ package System.Tasking is -- Activator writes it, once, before Self starts executing. Thereafter, -- Self only reads it. + Task_Alternate_Stack : System.Address; + -- The address of the alternate signal stack for this task, if any + -- + -- Protection: Only accessed by Self + Task_Entry_Point : Task_Procedure_Access; -- Information needed to call the procedure containing the code for -- the body of this task. @@ -801,7 +809,8 @@ package System.Tasking is ------------------------------------ type Access_Address is access all System.Address; - -- Comment on what this is used for ??? + -- Anonymous pointer used to implement task attributes (see s-tataat.adb + -- and a-tasatt.adb) pragma No_Strict_Aliasing (Access_Address); -- This type is used in contexts where aliasing may be an issue (see diff --git a/gcc/ada/s-taspri-hpux-dce.ads b/gcc/ada/s-taspri-hpux-dce.ads index 9ed8b011129..822b1b76ba1 100644 --- a/gcc/ada/s-taspri-hpux-dce.ads +++ b/gcc/ada/s-taspri-hpux-dce.ads @@ -64,6 +64,18 @@ package System.Task_Primitives is -- A component of this type is guaranteed to be included in the -- Ada_Task_Control_Block. + subtype Task_Address is System.Address; + -- In some versions of Task_Primitives, notably for VMS, Task_Address is + -- the short version of address defined in System.Aux_DEC. To avoid + -- dragging Aux_DEC into tasking packages a tasking specific subtype is + -- defined here. + + Task_Address_Size : constant := Standard'Address_Size; + -- The size of Task_Address + + Alternate_Stack_Size : constant := 0; + -- No alternate signal stack is used on this platform + private type Lock is record L : aliased System.OS_Interface.pthread_mutex_t; diff --git a/gcc/ada/s-taspri-lynxos.ads b/gcc/ada/s-taspri-lynxos.ads index 7d85e67392f..4e08865d831 100644 --- a/gcc/ada/s-taspri-lynxos.ads +++ b/gcc/ada/s-taspri-lynxos.ads @@ -63,6 +63,18 @@ package System.Task_Primitives is -- A component of this type is guaranteed to be included in the -- Ada_Task_Control_Block. + subtype Task_Address is System.Address; + -- In some versions of Task_Primitives, notably for VMS, Task_Address is + -- the short version of address defined in System.Aux_DEC. To avoid + -- dragging Aux_DEC into tasking packages a tasking specific subtype is + -- defined here. + + Task_Address_Size : constant := Standard'Address_Size; + -- The size of Task_Address + + Alternate_Stack_Size : constant := 0; + -- No alternate signal stack is used on this platform + private type Lock is record diff --git a/gcc/ada/s-taspri-posix-noaltstack.ads b/gcc/ada/s-taspri-posix-noaltstack.ads new file mode 100644 index 00000000000..2fb8655eb83 --- /dev/null +++ b/gcc/ada/s-taspri-posix-noaltstack.ads @@ -0,0 +1,124 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- S Y S T E M . T A S K _ P R I M I T I V E S -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 1991-1994, Florida State University -- +-- Copyright (C) 1995-2008, AdaCore -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. -- +-- Extensive contributions were provided by Ada Core Technologies, Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This is a POSIX-like version of this package where no alternate stack +-- is needed for stack checking. + +-- Note: this file can only be used for POSIX compliant systems + +pragma Polling (Off); +-- Turn off polling, we do not want ATC polling to take place during tasking +-- operations. It causes infinite loops and other problems. + +with System.OS_Interface; + +package System.Task_Primitives is + pragma Preelaborate; + + type Lock is limited private; + -- Should be used for implementation of protected objects + + type RTS_Lock is limited private; + -- Should be used inside the runtime system. The difference between Lock + -- and the RTS_Lock is that the later one serves only as a semaphore so + -- that do not check for ceiling violations. + + type Suspension_Object is limited private; + -- Should be used for the implementation of Ada.Synchronous_Task_Control + + type Task_Body_Access is access procedure; + -- Pointer to the task body's entry point (or possibly a wrapper declared + -- local to the GNARL). + + type Private_Data is limited private; + -- Any information that the GNULLI needs maintained on a per-task basis. + -- A component of this type is guaranteed to be included in the + -- Ada_Task_Control_Block. + + subtype Task_Address is System.Address; + -- In some versions of Task_Primitives, notably for VMS, Task_Address is + -- the short version of address defined in System.Aux_DEC. To avoid + -- dragging Aux_DEC into tasking packages a tasking specific subtype is + -- defined here. + + Task_Address_Size : constant := Standard'Address_Size; + -- The size of Task_Address + + Alternate_Stack_Size : constant := 0; + -- No alternate signal stack is used on this platform + +private + + type Lock is new System.OS_Interface.pthread_mutex_t; + type RTS_Lock is new System.OS_Interface.pthread_mutex_t; + + type Suspension_Object is record + State : Boolean; + pragma Atomic (State); + -- Boolean that indicates whether the object is open. This field is + -- marked Atomic to ensure that we can read its value without locking + -- the access to the Suspension_Object. + + Waiting : Boolean; + -- Flag showing if there is a task already suspended on this object + + L : aliased System.OS_Interface.pthread_mutex_t; + -- Protection for ensuring mutual exclusion on the Suspension_Object + + CV : aliased System.OS_Interface.pthread_cond_t; + -- Condition variable used to queue threads until condition is signaled + end record; + + type Private_Data is record + Thread : aliased System.OS_Interface.pthread_t; + pragma Atomic (Thread); + -- Thread field may be updated by two different threads of control. + -- (See, Enter_Task and Create_Task in s-taprop.adb). They put the same + -- value (thr_self value). We do not want to use lock on those + -- operations and the only thing we have to make sure is that they are + -- updated in atomic fashion. + + LWP : aliased System.Address; + -- The purpose of this field is to provide a better tasking support on + -- gdb. The order of the two first fields (Thread and LWP) is important. + -- On targets where lwp is not relevant, this is equivalent to Thread. + + CV : aliased System.OS_Interface.pthread_cond_t; + -- Should be commented ??? (in all versions of taspri) + + L : aliased RTS_Lock; + -- Protection for all components is lock L + end record; + +end System.Task_Primitives; diff --git a/gcc/ada/s-taspri-solaris.ads b/gcc/ada/s-taspri-solaris.ads index 810f89c61a6..0bf5139ef15 100644 --- a/gcc/ada/s-taspri-solaris.ads +++ b/gcc/ada/s-taspri-solaris.ads @@ -71,6 +71,18 @@ package System.Task_Primitives is -- A component of this type is guaranteed to be included in the -- Ada_Task_Control_Block. + subtype Task_Address is System.Address; + -- In some versions of Task_Primitives, notably for VMS, Task_Address is + -- the short version of address defined in System.Aux_DEC. To avoid + -- dragging Aux_DEC into tasking packages a tasking specific subtype is + -- defined here. + + Task_Address_Size : constant := Standard'Address_Size; + -- The size of Task_Address + + Alternate_Stack_Size : constant := 0; + -- No alternate signal stack is used on this platform + private type Private_Task_Serial_Number is mod 2 ** 64; diff --git a/gcc/ada/s-taspri-tru64.ads b/gcc/ada/s-taspri-tru64.ads index d666dfea396..50760c5d651 100644 --- a/gcc/ada/s-taspri-tru64.ads +++ b/gcc/ada/s-taspri-tru64.ads @@ -65,6 +65,18 @@ package System.Task_Primitives is -- Any information that the GNULLI needs maintained on a per-task basis. -- A component of this type is guaranteed to be included + subtype Task_Address is System.Address; + -- In some versions of Task_Primitives, notably for VMS, Task_Address is + -- the short version of address defined in System.Aux_DEC. To avoid + -- dragging Aux_DEC into tasking packages a tasking specific subtype is + -- defined here. + + Task_Address_Size : constant := Standard'Address_Size; + -- The size of Task_Address + + Alternate_Stack_Size : constant := 0; + -- No alternate signal stack is used on this platform + private type Lock is record diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb index 22da42bb08f..f0af3e06c3a 100644 --- a/gcc/ada/s-tassta.adb +++ b/gcc/ada/s-tassta.adb @@ -40,6 +40,7 @@ with Ada.Unchecked_Deallocation; with System.Tasking.Debug; with System.Address_Image; +with System.Task_Primitives; with System.Task_Primitives.Operations; with System.Tasking.Utilities; with System.Tasking.Queuing; @@ -135,9 +136,6 @@ package body System.Tasking.Stages is -- For tasks created by an allocator that fails, due to an exception, it is -- called from Expunge_Unactivated_Tasks. -- - -- It is also called from Ada.Unchecked_Deallocation, for objects that are - -- or contain tasks. - -- -- Different code is used at master completion, in Terminate_Dependents, -- due to a need for tighter synchronization with the master. @@ -408,8 +406,7 @@ package body System.Tasking.Stages is Initialization.Undefer_Abort_Nestable (Self_ID); - -- ??? - -- Why do we need to allow for nested deferral here? + -- ??? Why do we need to allow for nested deferral here? if Runtime_Traces then Send_Trace_Info (T_Activate); @@ -457,17 +454,18 @@ package body System.Tasking.Stages is -- called to create a new task. procedure Create_Task - (Priority : Integer; - Size : System.Parameters.Size_Type; - Task_Info : System.Task_Info.Task_Info_Type; - Num_Entries : Task_Entry_Index; - Master : Master_Level; - State : Task_Procedure_Access; - Discriminants : System.Address; - Elaborated : Access_Boolean; - Chain : in out Activation_Chain; - Task_Image : String; - Created_Task : out Task_Id) + (Priority : Integer; + Size : System.Parameters.Size_Type; + Task_Info : System.Task_Info.Task_Info_Type; + Relative_Deadline : Ada.Real_Time.Time_Span; + Num_Entries : Task_Entry_Index; + Master : Master_Level; + State : Task_Procedure_Access; + Discriminants : System.Address; + Elaborated : Access_Boolean; + Chain : in out Activation_Chain; + Task_Image : String; + Created_Task : out Task_Id) is T, P : Task_Id; Self_ID : constant Task_Id := STPO.Self; @@ -475,6 +473,10 @@ package body System.Tasking.Stages is Base_Priority : System.Any_Priority; Len : Natural; + pragma Unreferenced (Relative_Deadline); + -- EDF scheduling is not supported by any of the target platforms so + -- this parameter is not passed any further. + begin -- If Master is greater than the current master, it means that Master -- has already awaited its dependent tasks. This raises Program_Error, @@ -749,7 +751,7 @@ package body System.Tasking.Stages is Unlock_RTS; end if; - -- We need to explicitely wait for the task to be terminated here + -- We need to explicitly wait for the task to be terminated here -- because on true concurrent system, we may end this procedure before -- the tasks are really terminated. @@ -829,6 +831,7 @@ package body System.Tasking.Stages is Initialization.Task_Lock (Self_Id); Lock_RTS; + Initialization.Finalize_Attributes_Link.all (T); Initialization.Remove_From_All_Tasks_List (T); Unlock_RTS; @@ -896,12 +899,12 @@ package body System.Tasking.Stages is -- Task_Wrapper -- ------------------ - -- The task wrapper is a procedure that is called first for each task - -- task body, and which in turn calls the compiler-generated task body - -- procedure. The wrapper's main job is to do initialization for the task. - -- It also has some locally declared objects that server as per-task local - -- data. Task finalization is done by Complete_Task, which is called from - -- an at-end handler that the compiler generates. + -- The task wrapper is a procedure that is called first for each task body + -- and which in turn calls the compiler-generated task body procedure. + -- The wrapper's main job is to do initialization for the task. It also + -- has some locally declared objects that serve as per-task local data. + -- Task finalization is done by Complete_Task, which is called from an + -- at-end handler that the compiler generates. procedure Task_Wrapper (Self_ID : Task_Id) is use type SSE.Storage_Offset; @@ -910,6 +913,13 @@ package body System.Tasking.Stages is Bottom_Of_Stack : aliased Integer; + Task_Alternate_Stack : + aliased SSE.Storage_Array (1 .. Alternate_Stack_Size); + -- The alternate signal stack for this task, if any + + Use_Alternate_Stack : constant Boolean := Alternate_Stack_Size /= 0; + -- Whether to use above alternate signal stack for stack overflows + Secondary_Stack_Size : constant SSE.Storage_Offset := Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size * @@ -921,6 +931,9 @@ package body System.Tasking.Stages is -- Why are warnings being turned off here??? Secondary_Stack_Address : System.Address := Secondary_Stack'Address; + -- Address of secondary stack. In the fixed secondary stack case, this + -- value is not modified, causing a warning, hence the bracketing with + -- Warnings (Off/On). But why is so much *more* bracketed??? Small_Overflow_Guard : constant := 12 * 1024; -- Note: this used to be 4K, but was changed to 12K, since smaller @@ -939,9 +952,6 @@ package body System.Tasking.Stages is -- Size of the overflow guard, used by dynamic stack usage analysis pragma Warnings (On); - -- Address of secondary stack. In the fixed secondary stack case, this - -- value is not modified, causing a warning, hence the bracketing with - -- Warnings (Off/On). But why is so much *more* bracketed ??? SEH_Table : aliased SSE.Storage_Array (1 .. 8); -- Structured Exception Registration table (2 words) @@ -1017,6 +1027,10 @@ package body System.Tasking.Stages is Size := Size - Natural (Secondary_Stack_Size); end if; + if Use_Alternate_Stack then + Self_ID.Common.Task_Alternate_Stack := Task_Alternate_Stack'Address; + end if; + if System.Stack_Usage.Is_Enabled then STPO.Lock_RTS; Initialize_Analyzer (Self_ID.Common.Analyzer, @@ -1309,7 +1323,8 @@ package body System.Tasking.Stages is use System.Standard_Library; function To_Address is new - Ada.Unchecked_Conversion (Task_Id, System.Address); + Ada.Unchecked_Conversion + (Task_Id, System.Task_Primitives.Task_Address); function Tailored_Exception_Information (E : Exception_Occurrence) return String; diff --git a/gcc/ada/s-tassta.ads b/gcc/ada/s-tassta.ads index e96e2d906e7..e535a53be54 100644 --- a/gcc/ada/s-tassta.ads +++ b/gcc/ada/s-tassta.ads @@ -44,6 +44,8 @@ with System.Task_Info; with System.Parameters; +with Ada.Real_Time; + package System.Tasking.Stages is pragma Elaborate_Body; @@ -81,8 +83,8 @@ package System.Tasking.Stages is -- _init.discr := discr; -- _init._task_id := null; -- create_task (unspecified_priority, tZ, - -- unspecified_task_info, 0, _master, - -- task_procedure_access!(tB'address), + -- unspecified_task_info, ada__real_time__time_span_zero, 0, + -- _master, task_procedure_access!(tB'address), -- _init'address, tE'unchecked_access, _chain, _task_id, _init. -- _task_id); -- return; @@ -167,17 +169,18 @@ package System.Tasking.Stages is -- now in order to wake up the activator (the environment task). procedure Create_Task - (Priority : Integer; - Size : System.Parameters.Size_Type; - Task_Info : System.Task_Info.Task_Info_Type; - Num_Entries : Task_Entry_Index; - Master : Master_Level; - State : Task_Procedure_Access; - Discriminants : System.Address; - Elaborated : Access_Boolean; - Chain : in out Activation_Chain; - Task_Image : String; - Created_Task : out Task_Id); + (Priority : Integer; + Size : System.Parameters.Size_Type; + Task_Info : System.Task_Info.Task_Info_Type; + Relative_Deadline : Ada.Real_Time.Time_Span; + Num_Entries : Task_Entry_Index; + Master : Master_Level; + State : Task_Procedure_Access; + Discriminants : System.Address; + Elaborated : Access_Boolean; + Chain : in out Activation_Chain; + Task_Image : String; + Created_Task : out Task_Id); -- Compiler interface only. Do not call from within the RTS. -- This must be called to create a new task. -- @@ -186,6 +189,8 @@ package System.Tasking.Stages is -- Size is the stack size of the task to create -- Task_Info is the task info associated with the created task, or -- Unspecified_Task_Info if none. + -- Relative_Deadline is the relative deadline associated with the created + -- task by means of a pragma Relative_Deadline, or 0.0 if none. -- State is the compiler generated task's procedure body -- Discriminants is a pointer to a limited record whose discriminants -- are those of the task to create. This parameter should be passed as diff --git a/gcc/ada/system-linux-x86.ads b/gcc/ada/system-linux-x86.ads index a212fd24faa..f46da46fdaf 100644 --- a/gcc/ada/system-linux-x86.ads +++ b/gcc/ada/system-linux-x86.ads @@ -7,7 +7,7 @@ -- S p e c -- -- (GNU-Linux/x86 Version) -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -139,7 +139,7 @@ private Preallocated_Stacks : constant Boolean := False; Signed_Zeros : constant Boolean := True; Stack_Check_Default : constant Boolean := False; - Stack_Check_Probes : constant Boolean := False; + Stack_Check_Probes : constant Boolean := True; Stack_Check_Limits : constant Boolean := False; Support_64_Bit_Divides : constant Boolean := True; Support_Aggregates : constant Boolean := True; diff --git a/gcc/ada/system-linux-x86_64.ads b/gcc/ada/system-linux-x86_64.ads index e309435d0c2..7ee41803340 100644 --- a/gcc/ada/system-linux-x86_64.ads +++ b/gcc/ada/system-linux-x86_64.ads @@ -7,7 +7,7 @@ -- S p e c -- -- (GNU-Linux/x86-64 Version) -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -139,7 +139,7 @@ private Preallocated_Stacks : constant Boolean := False; Signed_Zeros : constant Boolean := True; Stack_Check_Default : constant Boolean := False; - Stack_Check_Probes : constant Boolean := False; + Stack_Check_Probes : constant Boolean := True; Stack_Check_Limits : constant Boolean := False; Support_64_Bit_Divides : constant Boolean := True; Support_Aggregates : constant Boolean := True; -- 2.30.2