diff options
Diffstat (limited to 'gcc/ada')
32 files changed, 68 insertions, 4041 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index fc30f6a..b6e79e9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,47 @@ +2012-03-14 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE> + + * gcc-interface/Makefile.in (mips-sgi-irix6*): Remove. + + * a-intnam-irix.ads, mlib-tgt-specific-irix.adb, + s-intman-irix.adb, s-mastop-irix.adb, s-osinte-irix.adb, + s-osinte-irix.ads, s-proinf-irix-athread.adb, + s-proinf-irix-athread.ads, s-taprop-irix.adb, s-tasinf-irix.ads, + system-irix-n32.ads, system-irix-n64.ads, system-irix-o32.ads: + Remove. + + * adaint.c [__mips && __sgi]: Remove. + (__gnat_number_of_cpus) [__mips && __sgi]: Remove. + [IS_CROSS && !(__mips && __sgi)]: Remove. + * adaint.h [sgi && _LFAPI]: Remove. + * cstreams.c (__gnat_full_name) [sgi]: Remove. + * env.c (__gnat_unsetenv) [__mips && __sgi]: Remove. + (__gnat_clearenv) [__mips && __sgi]: Remove. + * errno.c (_SGI_MP_SOURCE): Remove. + * gsocket.h [sgi]: Remove. + * init.c: Remove IRIX reference. + [sgi]: Remove. + * link.c [sgi]: Remove. + * s-oscons-tmplt.c [__mips && __sgi] (IOV_MAX): Don't define. + (main) [__mips && __sgi] (MAX_tv_sec): Don't define. + (CLOCK_SGI_FAST, CLOCK_SGI_CYCLE): Remove. + * sysdep.c [sgi]: Remove. + (getc_immediate_common) [sgi]: Remove. + (__gnat_localtime_tzoff) [sgi]: Remove. + * terminals.c [__mips && __sgi] (IRIX): Don't define. + [IRIX] (USE_GETPTY): Don't define. + (allocate_pty_desc) [USE_GETPTY]: Remove. + + * g-traceb.ads: Remove IRIX reference. + * g-trasym.ads: Likewise. + * memtrack.adb: Likewise. + * s-interr-sigaction.adb: Likewise. + + * gnat_rm.texi (Implementation Advice): Remove SGI info. + (Implementation Defined Characteristics): Likewise. + * gnat_ugn.texi (Summary of Run-Time Configurations, mips-irix): + Remove. + (Irix-Specific Considerations): Remove. + 2012-03-13 Tristan Gingold <gingold@adacore.com> * gcc-interface/gigi.h (flag_vms_malloc64): Refine condition. diff --git a/gcc/ada/a-intnam-irix.ads b/gcc/ada/a-intnam-irix.ads deleted file mode 100644 index 65859c0..0000000 --- a/gcc/ada/a-intnam-irix.ads +++ /dev/null @@ -1,195 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- --- -- --- A D A . I N T E R R U P T S . N A M E S -- --- -- --- S p e c -- --- -- --- Copyright (C) 1991-2011, 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 3, or (at your option) any later ver- -- --- sion. GNAT 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. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNARL was developed by the GNARL team at Florida State University. -- --- Extensive contributions were provided by Ada Core Technologies, Inc. -- --- -- ------------------------------------------------------------------------------- - --- This is the Irix version of this package - --- The following signals are reserved by the run time (Athread library): - --- SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGSTOP, SIGKILL - --- The following signals are reserved by the run time (Pthread library): - --- SIGTSTP, SIGILL, SIGTRAP, SIGEMT, SIGFPE, SIGBUS, SIGSTOP, SIGKILL, --- SIGSEGV, SIGSYS, SIGXCPU, SIGXFSZ, SIGPROF, SIGPTINTR, SIGPTRESCHED, --- SIGABRT, SIGINT - --- The pragma Unreserve_All_Interrupts affects the following signal --- (Pthread library): - --- SIGINT: made available for Ada handler - --- This target-dependent package spec contains names of interrupts --- supported by the local system. - -with System.OS_Interface; - -package Ada.Interrupts.Names is - - -- All identifiers in this unit are implementation defined - - pragma Implementation_Defined; - - -- Beware that the mapping of names to signals may be many-to-one. There - -- may be aliases. Also, for all signal names that are not supported on - -- the current system the value of the corresponding constant will be zero. - - SIGHUP : constant Interrupt_ID := - System.OS_Interface.SIGHUP; -- hangup - - SIGINT : constant Interrupt_ID := - System.OS_Interface.SIGINT; -- interrupt (rubout) - - SIGQUIT : constant Interrupt_ID := - System.OS_Interface.SIGQUIT; -- quit (ASCD FS) - - SIGILL : constant Interrupt_ID := - System.OS_Interface.SIGILL; -- illegal instruction (not reset) - - SIGTRAP : constant Interrupt_ID := - System.OS_Interface.SIGTRAP; -- trace trap (not reset) - - SIGIOT : constant Interrupt_ID := - System.OS_Interface.SIGIOT; -- IOT instruction - - SIGABRT : constant Interrupt_ID := - System.OS_Interface.SIGABRT; -- used by abort, replace SIGIOT in the - -- future - - SIGEMT : constant Interrupt_ID := - System.OS_Interface.SIGEMT; -- EMT instruction - - SIGFPE : constant Interrupt_ID := - System.OS_Interface.SIGFPE; -- floating point exception - - SIGKILL : constant Interrupt_ID := - System.OS_Interface.SIGKILL; -- kill (cannot be caught or ignored) - - SIGBUS : constant Interrupt_ID := - System.OS_Interface.SIGBUS; -- bus error - - SIGSEGV : constant Interrupt_ID := - System.OS_Interface.SIGSEGV; -- segmentation violation - - SIGSYS : constant Interrupt_ID := - System.OS_Interface.SIGSYS; -- bad argument to system call - - SIGPIPE : constant Interrupt_ID := - System.OS_Interface.SIGPIPE; -- write on pipe with no one to read it - - SIGALRM : constant Interrupt_ID := - System.OS_Interface.SIGALRM; -- alarm clock - - SIGTERM : constant Interrupt_ID := - System.OS_Interface.SIGTERM; -- software termination signal from kill - - SIGUSR1 : constant Interrupt_ID := - System.OS_Interface.SIGUSR1; -- user defined signal 1 - - SIGUSR2 : constant Interrupt_ID := - System.OS_Interface.SIGUSR2; -- user defined signal 2 - - SIGCLD : constant Interrupt_ID := - System.OS_Interface.SIGCLD; -- alias for SIGCHLD - - SIGCHLD : constant Interrupt_ID := - System.OS_Interface.SIGCHLD; -- child status change - - SIGPWR : constant Interrupt_ID := - System.OS_Interface.SIGPWR; -- power-fail restart - - SIGWINCH : constant Interrupt_ID := - System.OS_Interface.SIGWINCH; -- window size change - - SIGURG : constant Interrupt_ID := - System.OS_Interface.SIGURG; -- urgent condition on IO channel - - SIGPOLL : constant Interrupt_ID := - System.OS_Interface.SIGPOLL; -- pollable event occurred - - SIGIO : constant Interrupt_ID := - System.OS_Interface.SIGIO; -- I/O possible (Solaris SIGPOLL alias) - - SIGSTOP : constant Interrupt_ID := - System.OS_Interface.SIGSTOP; -- stop (cannot be caught or ignored) - - SIGTSTP : constant Interrupt_ID := - System.OS_Interface.SIGTSTP; -- user stop requested from tty - - SIGCONT : constant Interrupt_ID := - System.OS_Interface.SIGCONT; -- stopped process has been continued - - SIGTTIN : constant Interrupt_ID := - System.OS_Interface.SIGTTIN; -- background tty read attempted - - SIGTTOU : constant Interrupt_ID := - System.OS_Interface.SIGTTOU; -- background tty write attempted - - SIGVTALRM : constant Interrupt_ID := - System.OS_Interface.SIGVTALRM; -- virtual timer expired - - SIGPROF : constant Interrupt_ID := - System.OS_Interface.SIGPROF; -- profiling timer expired - - SIGXCPU : constant Interrupt_ID := - System.OS_Interface.SIGXCPU; -- CPU time limit exceeded - - SIGXFSZ : constant Interrupt_ID := - System.OS_Interface.SIGXFSZ; -- filesize limit exceeded - - SIGK32 : constant Interrupt_ID := - System.OS_Interface.SIGK32; -- reserved for kernel (IRIX) - - SIGCKPT : constant Interrupt_ID := - System.OS_Interface.SIGCKPT; -- Checkpoint warning - - SIGRESTART : constant Interrupt_ID := - System.OS_Interface.SIGRESTART; -- Restart warning - - SIGUME : constant Interrupt_ID := - System.OS_Interface.SIGUME; -- Uncorrectable memory error - - -- Signals defined for Posix 1003.1c - - SIGPTINTR : constant Interrupt_ID := - System.OS_Interface.SIGPTINTR; -- Pthread Interrupt Signal - - SIGPTRESCHED : constant Interrupt_ID := - System.OS_Interface.SIGPTRESCHED; -- Pthread Rescheduling Signal - - -- Posix 1003.1b signals - - SIGRTMIN : constant Interrupt_ID := - System.OS_Interface.SIGRTMIN; -- Posix 1003.1b signals - - SIGRTMAX : constant Interrupt_ID := - System.OS_Interface.SIGRTMAX; -- Posix 1003.1b signals - -end Ada.Interrupts.Names; diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index 8309123..e13b01c 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -62,7 +62,7 @@ extern "C" { #endif /* VxWorks */ -#if (defined (__mips) && defined (__sgi)) || defined (__APPLE__) +#if defined (__APPLE__) #include <unistd.h> #endif @@ -2470,9 +2470,6 @@ __gnat_number_of_cpus (void) #if defined (linux) || defined (sun) || defined (AIX) || defined (__APPLE__) cores = (int) sysconf (_SC_NPROCESSORS_ONLN); -#elif (defined (__mips) && defined (__sgi)) - cores = (int) sysconf (_SC_NPROC_ONLN); - #elif defined (__hpux__) struct pst_dynamic psd; if (pstat_getdynamic (&psd, sizeof (psd), 1, 0) != -1) @@ -3541,8 +3538,7 @@ _flush_cache() && ! defined (__APPLE__) \ && ! defined (_AIX) \ && ! defined (VMS) \ - && ! defined (__MINGW32__) \ - && ! (defined (__mips) && defined (__sgi))) + && ! defined (__MINGW32__)) /* Dummy function to satisfy g-trasym.o. See the preprocessor conditional just above for a list of native platforms that provide a non-dummy diff --git a/gcc/ada/adaint.h b/gcc/ada/adaint.h index 12e671f..8c46aed 100644 --- a/gcc/ada/adaint.h +++ b/gcc/ada/adaint.h @@ -6,7 +6,7 @@ * * * C Header File * * * - * Copyright (C) 1992-2011, Free Software Foundation, Inc. * + * Copyright (C) 1992-2012, 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- * @@ -51,7 +51,7 @@ extern "C" { determine at compile time what support the system offers for large files. For now we just list the platforms we have manually tested. */ -#if defined (__GLIBC__) || defined (sun) || (defined (__sgi) && defined(_LFAPI)) +#if defined (__GLIBC__) || defined (sun) #define GNAT_FOPEN fopen64 #define GNAT_STAT stat64 #define GNAT_FSTAT fstat64 diff --git a/gcc/ada/cstreams.c b/gcc/ada/cstreams.c index 9b2e9b2..894b056 100644 --- a/gcc/ada/cstreams.c +++ b/gcc/ada/cstreams.c @@ -6,7 +6,7 @@ * * * Auxiliary C functions for Interfaces.C.Streams * * * - * Copyright (C) 1992-2011, Free Software Foundation, Inc. * + * Copyright (C) 1992-2012, 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- * @@ -187,7 +187,7 @@ __gnat_full_name (char *nam, char *buffer) *p = '\\'; } -#elif defined (sgi) || defined (__FreeBSD__) +#elif defined (__FreeBSD__) /* Use realpath function which resolves links and references to . and .. on those Unix systems that support it. Note that GNU/Linux provides it but diff --git a/gcc/ada/env.c b/gcc/ada/env.c index ac7ee21..78328dc 100644 --- a/gcc/ada/env.c +++ b/gcc/ada/env.c @@ -229,11 +229,10 @@ void __gnat_unsetenv (char *name) { /* Not implemented */ return; #elif defined (__hpux__) || defined (sun) \ - || (defined (__mips) && defined (__sgi)) \ || (defined (__vxworks) && ! defined (__RTP__)) \ || defined (_AIX) || defined (__Lynx__) - /* On Solaris, HP-UX and IRIX there is no function to clear an environment + /* On Solaris and HP-UX there is no function to clear an environment variable. So we look for the variable in the environ table and delete it by setting the entry to NULL. This can clearly cause some memory leaks but free cannot be used on this context as not all strings in the environ @@ -287,9 +286,9 @@ void __gnat_clearenv (void) { #if defined (VMS) /* not implemented */ return; -#elif defined (sun) || (defined (__mips) && defined (__sgi)) \ +#elif defined (sun) \ || (defined (__vxworks) && ! defined (__RTP__)) || defined (__Lynx__) - /* On Solaris, IRIX, VxWorks (not RTPs), and Lynx there is no system + /* On Solaris, VxWorks (not RTPs), and Lynx there is no system call to unset a variable or to clear the environment so set all the entries in the environ table to NULL (see comment in __gnat_unsetenv for more explanation). */ diff --git a/gcc/ada/errno.c b/gcc/ada/errno.c index 2eec9ac..93c8660 100644 --- a/gcc/ada/errno.c +++ b/gcc/ada/errno.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2009, Free Software Foundation, Inc. * + * Copyright (C) 1992-2012, 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- * @@ -38,7 +38,6 @@ #define _REENTRANT #define _THREAD_SAFE -#define _SGI_MP_SOURCE #ifdef MaRTE diff --git a/gcc/ada/g-traceb.ads b/gcc/ada/g-traceb.ads index 3397014..debb0c4 100644 --- a/gcc/ada/g-traceb.ads +++ b/gcc/ada/g-traceb.ads @@ -60,7 +60,6 @@ -- AiX PowerPC -- HP-UX -- GNU/Linux x86 --- Irix MIPS -- LynxOS x86 -- Solaris x86 -- Solaris sparc diff --git a/gcc/ada/g-trasym.ads b/gcc/ada/g-trasym.ads index 1cc6551..7b4e003 100644 --- a/gcc/ada/g-trasym.ads +++ b/gcc/ada/g-trasym.ads @@ -34,7 +34,6 @@ -- The full capability is currently supported on the following targets: -- HP-UX ia64 --- IRIX -- GNU/Linux x86, x86_64, ia64 -- FreeBSD x86, x86_64 -- Solaris sparc and x86 diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index 75d80c5..25d4d91 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -1306,49 +1306,6 @@ ifeq ($(strip $(filter-out s390% linux%,$(arch) $(osys))),) LIBRARY_VERSION := $(LIB_VERSION) endif -ifeq ($(strip $(filter-out mips sgi irix6%,$(targ))),) - LIBGNAT_TARGET_PAIRS = \ - a-intnam.ads<a-intnam-irix.ads \ - a-synbar.adb<a-synbar-posix.adb \ - a-synbar.ads<a-synbar-posix.ads \ - s-inmaop.adb<s-inmaop-posix.adb \ - s-intman.adb<s-intman-irix.adb \ - s-mastop.adb<s-mastop-irix.adb \ - s-osinte.adb<s-osinte-irix.adb \ - s-osinte.ads<s-osinte-irix.ads \ - s-osprim.adb<s-osprim-posix.adb \ - s-proinf.adb<s-proinf-irix-athread.adb \ - s-proinf.ads<s-proinf-irix-athread.ads \ - s-taprop.adb<s-taprop-irix.adb \ - s-tasinf.ads<s-tasinf-irix.ads \ - s-taspri.ads<s-taspri-posix.ads \ - s-tpopsp.adb<s-tpopsp-posix.adb \ - s-traceb.adb<s-traceb-mastop.adb - - ifeq ($(strip $(MULTISUBDIR)),/64) - LIBGNAT_TARGET_PAIRS += \ - system.ads<system-irix-n64.ads - else - ifeq ($(strip $(MULTISUBDIR)),/32) - LIBGNAT_TARGET_PAIRS += \ - system.ads<system-irix-o32.ads - else - LIBGNAT_TARGET_PAIRS += \ - system.ads<system-irix-n32.ads - endif - endif - - THREADSLIB = -lpthread - GNATLIB_SHARED = gnatlib-shared-default - - EH_MECHANISM=-gcc - TOOLS_TARGET_PAIRS = mlib-tgt-specific.adb<mlib-tgt-specific-irix.adb - TGT_LIB = -lexc - MISCLIB = -lexc - LIBRARY_VERSION := $(LIB_VERSION) - GMEM_LIB = gmemlib -endif - ifeq ($(strip $(filter-out hppa% hp hpux10%,$(targ))),) LIBGNAT_TARGET_PAIRS = \ a-excpol.adb<a-excpol-abort.adb \ diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 4fccee3..82c61f4 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -15,7 +15,7 @@ @setfilename gnat_rm.info @copying -Copyright @copyright{} 1995-2008, Free Software Foundation, Inc. +Copyright @copyright{} 1995-2012, Free Software Foundation, Inc. Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -8928,10 +8928,6 @@ of interrupt blocking. Whenever possible, the implementation should allow interrupt handlers to be called directly by the hardware. @end cartouche -@c SGI info: -@ignore -This is never possible under IRIX, so this is followed by default. -@end ignore Followed on any target where the underlying operating system permits such direct calls. @@ -9244,11 +9240,6 @@ A requirement for conforming Ada compilers is that they provide documentation describing how the implementation deals with each of these issues. In this chapter, you will find each point in Annex M listed followed by a description in italic font of how GNAT -@c SGI info: -@ignore -in the ProDev Ada -implementation on IRIX 5.3 operating system or greater -@end ignore handles the implementation dependence. You can use this chapter as a guide to minimizing implementation @@ -10515,11 +10506,6 @@ object does not keep its processor busy. on task dispatching. See D.2.1(9). @end cartouche @noindent -@c SGI info -@ignore -Tasks map to IRIX threads, and the dispatching policy is as defined by -the IRIX implementation of threads. -@end ignore Tasks map to threads in the threads package used by GNAT@. Where possible and appropriate, these threads correspond to native threads of the underlying operating system. @@ -10550,11 +10536,6 @@ of delay expirations for lower priority tasks. @strong{100}. Implementation-defined task dispatching. See D.2.2(18). @end cartouche @noindent -@c SGI info: -@ignore -Tasks map to IRIX threads, and the dispatching policy is as defined by -the IRIX implementation of threads. -@end ignore The policy is the same as that of the underlying threads implementation. @sp 1 diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index e6f368b..1f73be7 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -584,7 +584,6 @@ Platform-Specific Information for the Run-Time Libraries * Solaris-Specific Considerations:: * Linux-Specific Considerations:: * AIX-Specific Considerations:: -* Irix-Specific Considerations:: * RTX-Specific Considerations:: * HP-UX-Specific Considerations:: @@ -22150,7 +22149,6 @@ information about several specific platforms. * Solaris-Specific Considerations:: * Linux-Specific Considerations:: * AIX-Specific Considerations:: -* Irix-Specific Considerations:: * RTX-Specific Considerations:: * HP-UX-Specific Considerations:: @end menu @@ -22188,11 +22186,6 @@ information about several specific platforms. @item @code{@ @ @ @ }Tasking @tab pthread library @item @code{@ @ @ @ }Exceptions @tab ZCX @* -@item @b{mips-irix} -@item @code{@ @ }@i{rts-native (default)} -@item @code{@ @ @ @ }Tasking @tab native IRIX threads -@item @code{@ @ @ @ }Exceptions @tab ZCX -@* @item @b{pa-hpux} @item @code{@ @ }@i{rts-native (default)} @item @code{@ @ @ @ }Tasking @tab native HP-UX threads @@ -22481,24 +22474,6 @@ occurs in the environment task, or use @code{pragma Storage_Size} to specify a sufficiently large size for the stack of the task that contains this call. -@node Irix-Specific Considerations -@section Irix-Specific Considerations -@cindex Irix libraries - -@noindent -The GCC support libraries coming with the Irix compiler have moved to -their canonical place with respect to the general Irix ABI related -conventions. Running applications built with the default shared GNAT -run-time now requires the LD_LIBRARY_PATH environment variable to -include this location. A possible way to achieve this is to issue the -following command line on a bash prompt: - -@smallexample -@group -$ LD_LIBRARY_PATH=$LD_LIBRARY_PATH:`dirname \`gcc --print-file-name=libgcc_s.so\`` -@end group -@end smallexample - @node RTX-Specific Considerations @section RTX-Specific Considerations @cindex RTX libraries diff --git a/gcc/ada/gsocket.h b/gcc/ada/gsocket.h index 4dfbee7..c364fdb 100644 --- a/gcc/ada/gsocket.h +++ b/gcc/ada/gsocket.h @@ -202,7 +202,7 @@ defined (_WIN32) || defined (__APPLE__) # define HAVE_THREAD_SAFE_GETxxxBYyyy 1 -#elif defined (sgi) || defined (linux) || defined (__GLIBC__) || \ +#elif defined (linux) || defined (__GLIBC__) || \ (defined (sun) && defined (__SVR4) && !defined (__vxworks)) || \ defined(__rtems__) # define HAVE_GETxxxBYyyy_R 1 diff --git a/gcc/ada/init.c b/gcc/ada/init.c index 87124b6..4db5789 100644 --- a/gcc/ada/init.c +++ b/gcc/ada/init.c @@ -70,7 +70,8 @@ extern "C" { 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. */ + is not used in this unit, and the abort signal is only used on IRIX. + ??? Revisit this part since IRIX is no longer supported. */ extern struct Exception_Data constraint_error; extern struct Exception_Data numeric_error; extern struct Exception_Data program_error; @@ -603,174 +604,6 @@ __gnat_install_handler (void) __gnat_handler_installed = 1; } -/****************/ -/* IRIX Section */ -/****************/ - -#elif defined (sgi) - -#include <signal.h> -#include <siginfo.h> - -#ifndef NULL -#define NULL 0 -#endif - -#define SIGADAABORT 48 -#define SIGNAL_STACK_SIZE 4096 -#define SIGNAL_STACK_ALIGNMENT 64 - -#define Check_Abort_Status \ - system__soft_links__check_abort_status -extern int (*Check_Abort_Status) (void); - -extern struct Exception_Data _abort_signal; - -/* We are not setting the SA_SIGINFO bit in the sigaction flags when - connecting that handler, with the effects described in the sigaction - man page: - - SA_SIGINFO If set and the signal is caught, sig is passed as the - first argument to the signal-catching function. If the - second argument is not equal to NULL, it points to a - siginfo_t structure containing the reason why the - signal was generated [see siginfo(5)]; the third - argument points to a ucontext_t structure containing - the receiving process's context when the signal was - delivered [see ucontext(5)]. If cleared and the signal - is caught, the first argument is 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. This - is the default behavior (see signal(5) for more - details). Additionally, when SA_SIGINFO is set for a - signal, multiple occurrences of that signal will be - queued for delivery in FIFO order (see sigqueue(3) for - a more detailed explanation of this concept), if those - occurrences of that signal were generated using - sigqueue(3). */ - -static void -__gnat_error_handler (int sig, siginfo_t *reason, void *uc ATTRIBUTE_UNUSED) -{ - /* This handler is installed with SA_SIGINFO cleared, but there's no - prototype for the resulting alternative three-argument form, so we - have to hack around this by casting reason to the int actually - passed. */ - int code = (int) reason; - struct Exception_Data *exception; - const char *msg; - - switch (sig) - { - case SIGSEGV: - if (code == EFAULT) - { - exception = &program_error; - msg = "SIGSEGV: (Invalid virtual address)"; - } - else if (code == ENXIO) - { - exception = &program_error; - msg = "SIGSEGV: (Read beyond mapped object)"; - } - else if (code == ENOSPC) - { - exception = &program_error; /* ??? storage_error ??? */ - msg = "SIGSEGV: (Autogrow for file failed)"; - } - else if (code == EACCES || code == EEXIST) - { - /* ??? We handle stack overflows here, some of which do trigger - SIGSEGV + EEXIST on Irix 6.5 although EEXIST is not part of - the documented valid codes for SEGV in the signal(5) man - page. */ - - /* ??? Re-add smarts to further verify that we launched - the stack into a guard page, not an attempt to - write to .text or something. */ - exception = &storage_error; - msg = "SIGSEGV: stack overflow or erroneous memory access"; - } - else - { - /* 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. */ - exception = &program_error; - msg = "SIGSEGV: (Undocumented reason)"; - } - break; - - case SIGBUS: - /* Map all bus errors to Program_Error. */ - exception = &program_error; - msg = "SIGBUS"; - break; - - case SIGFPE: - /* Map all fpe errors to Constraint_Error. */ - exception = &constraint_error; - msg = "SIGFPE"; - break; - - case SIGADAABORT: - if ((*Check_Abort_Status) ()) - { - exception = &_abort_signal; - msg = ""; - } - else - return; - - break; - - default: - /* Everything else is a Program_Error. */ - exception = &program_error; - msg = "unhandled signal"; - } - - Raise_From_Signal_Handler (exception, msg); -} - -void -__gnat_install_handler (void) -{ - struct sigaction act; - - /* 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! - - The handler is installed with SA_SIGINFO cleared, but there's no - C++ prototype for the three-argument form, so fake it by using - sa_sigaction and casting the arguments instead. */ - - act.sa_sigaction = __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". */ - 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 (__gnat_get_interrupt_state (SIGADAABORT) != 's') - sigaction (SIGADAABORT, &act, NULL); - - __gnat_handler_installed = 1; -} - /*******************/ /* LynxOS Section */ /*******************/ diff --git a/gcc/ada/link.c b/gcc/ada/link.c index 223147d..88c4846 100644 --- a/gcc/ada/link.c +++ b/gcc/ada/link.c @@ -96,27 +96,7 @@ extern "C" { #define SHARED 'H' #define STATIC 'T' -#if defined (sgi) -const char *__gnat_object_file_option = "-Wl,-objectlist,"; -const char *__gnat_run_path_option = "-Wl,-rpath,"; -int __gnat_link_max = 5000; -unsigned char __gnat_objlist_file_supported = 1; -char __gnat_shared_libgnat_default = STATIC; -char __gnat_shared_libgcc_default = STATIC; -unsigned char __gnat_using_gnu_linker = 0; -const char *__gnat_object_library_extension = ".a"; -unsigned char __gnat_separate_run_path_options = 0; - -/* The libgcc_s locations have changed in GCC 4. The n32 version used - to be in "lib", it moved to "lib32" and "lib" became the home of - the o32 version. We are targetting n32 by default, so ... */ -#if __GNUC__ < 4 -const char *__gnat_default_libgcc_subdir = "lib"; -#else -const char *__gnat_default_libgcc_subdir = "lib32"; -#endif - -#elif defined (__WIN32) +#if defined (__WIN32) const char *__gnat_object_file_option = ""; const char *__gnat_run_path_option = ""; int __gnat_link_max = 30000; diff --git a/gcc/ada/memtrack.adb b/gcc/ada/memtrack.adb index ec490e2..2499bb7 100644 --- a/gcc/ada/memtrack.adb +++ b/gcc/ada/memtrack.adb @@ -59,7 +59,6 @@ -- AIX -- GNU/Linux -- HP-UX --- Irix -- Solaris -- Alpha OpenVMS diff --git a/gcc/ada/mlib-tgt-specific-irix.adb b/gcc/ada/mlib-tgt-specific-irix.adb deleted file mode 100644 index cba8738..0000000 --- a/gcc/ada/mlib-tgt-specific-irix.adb +++ /dev/null @@ -1,182 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- M L I B . T G T . S P E C I F I C -- --- (IRIX Version) -- --- -- --- B o d y -- --- -- --- Copyright (C) 2003-2008, AdaCore -- --- -- --- 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT 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 GNAT; see file COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This is the IRIX version of the body - -with MLib.Fil; -with MLib.Utl; -with Opt; -with Output; use Output; - -package body MLib.Tgt.Specific is - - -- Non default subprogram - - procedure Build_Dynamic_Library - (Ofiles : Argument_List; - Options : Argument_List; - Interfaces : Argument_List; - Lib_Filename : String; - Lib_Dir : String; - Symbol_Data : Symbol_Record; - Driver_Name : Name_Id := No_Name; - Lib_Version : String := ""; - Auto_Init : Boolean := False); - - function Is_Archive_Ext (Ext : String) return Boolean; - - --------------------------- - -- Build_Dynamic_Library -- - --------------------------- - - procedure Build_Dynamic_Library - (Ofiles : Argument_List; - Options : Argument_List; - Interfaces : Argument_List; - Lib_Filename : String; - Lib_Dir : String; - Symbol_Data : Symbol_Record; - Driver_Name : Name_Id := No_Name; - Lib_Version : String := ""; - Auto_Init : Boolean := False) - is - pragma Unreferenced (Interfaces); - pragma Unreferenced (Symbol_Data); - pragma Unreferenced (Auto_Init); - - Lib_File : constant String := - "lib" & MLib.Fil.Append_To (Lib_Filename, DLL_Ext); - - Lib_Path : constant String := - Lib_Dir & Directory_Separator & Lib_File; - - Version_Arg : String_Access; - Symbolic_Link_Needed : Boolean := False; - - N_Options : Argument_List := Options; - Options_Last : Natural := N_Options'Last; - -- After moving -lxxx to Options_2, N_Options up to index Options_Last - -- will contain the Options to pass to MLib.Utl.Gcc. - - Real_Options_2 : Argument_List (1 .. Options'Length); - Real_Options_2_Last : Natural := 0; - -- Real_Options_2 up to index Real_Options_2_Last will contain the - -- Options_2 to pass to MLib.Utl.Gcc. - - begin - if Opt.Verbose_Mode then - Write_Str ("building relocatable shared library "); - Write_Line (Lib_Path); - end if; - - -- Move all -lxxx to Options_2 - - declare - Index : Natural := N_Options'First; - Arg : String_Access; - - begin - while Index <= Options_Last loop - Arg := N_Options (Index); - - if Arg'Length > 2 - and then Arg (Arg'First .. Arg'First + 1) = "-l" - then - Real_Options_2_Last := Real_Options_2_Last + 1; - Real_Options_2 (Real_Options_2_Last) := Arg; - N_Options (Index .. Options_Last - 1) := - N_Options (Index + 1 .. Options_Last); - Options_Last := Options_Last - 1; - - else - Index := Index + 1; - end if; - end loop; - end; - - if Lib_Version = "" then - MLib.Utl.Gcc - (Output_File => Lib_Path, - Objects => Ofiles, - Options => N_Options (N_Options'First .. Options_Last), - Driver_Name => Driver_Name, - Options_2 => Real_Options_2 (1 .. Real_Options_2_Last)); - - else - declare - Maj_Version : constant String := - Major_Id_Name (Lib_File, Lib_Version); - begin - if Maj_Version'Length /= 0 then - Version_Arg := new String'("-Wl,-soname," & Maj_Version); - - else - Version_Arg := new String'("-Wl,-soname," & Lib_Version); - end if; - - if Is_Absolute_Path (Lib_Version) then - MLib.Utl.Gcc - (Output_File => Lib_Version, - Objects => Ofiles, - Options => N_Options (N_Options'First .. Options_Last) & - Version_Arg, - Driver_Name => Driver_Name, - Options_2 => Real_Options_2 (1 .. Real_Options_2_Last)); - Symbolic_Link_Needed := Lib_Version /= Lib_Path; - - else - MLib.Utl.Gcc - (Output_File => Lib_Dir & Directory_Separator & Lib_Version, - Objects => Ofiles, - Options => N_Options (N_Options'First .. Options_Last) & - Version_Arg, - Driver_Name => Driver_Name, - Options_2 => Real_Options_2 (1 .. Real_Options_2_Last)); - Symbolic_Link_Needed := - Lib_Dir & Directory_Separator & Lib_Version /= Lib_Path; - end if; - - if Symbolic_Link_Needed then - Create_Sym_Links - (Lib_Path, Lib_Version, Lib_Dir, Maj_Version); - end if; - end; - end if; - end Build_Dynamic_Library; - - -------------------- - -- Is_Archive_Ext -- - -------------------- - - function Is_Archive_Ext (Ext : String) return Boolean is - begin - return Ext = ".a" or else Ext = ".so"; - end Is_Archive_Ext; - -begin - Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access; - Is_Archive_Ext_Ptr := Is_Archive_Ext'Access; -end MLib.Tgt.Specific; diff --git a/gcc/ada/s-interr-sigaction.adb b/gcc/ada/s-interr-sigaction.adb index b405bb7..46d38f3 100644 --- a/gcc/ada/s-interr-sigaction.adb +++ b/gcc/ada/s-interr-sigaction.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2012, 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- -- @@ -29,7 +29,7 @@ -- -- ------------------------------------------------------------------------------ --- This is the IRIX & NT version of this package +-- This is the NT version of this package with Ada.Task_Identification; with Ada.Unchecked_Conversion; diff --git a/gcc/ada/s-intman-irix.adb b/gcc/ada/s-intman-irix.adb deleted file mode 100644 index 8084d47..0000000 --- a/gcc/ada/s-intman-irix.adb +++ /dev/null @@ -1,137 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- --- -- --- S Y S T E M . I N T E R R U P T _ M A N A G E M E N T -- --- -- --- B o d y -- --- -- --- Copyright (C) 1995-2010, AdaCore -- --- -- --- 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT 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. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNARL was developed by the GNARL team at Florida State University. -- --- Extensive contributions were provided by Ada Core Technologies, Inc. -- --- -- ------------------------------------------------------------------------------- - --- This is a SGI Pthread version of this package - --- Make a careful study of all signals available under the OS, to see which --- need to be reserved, kept always unmasked, or kept always unmasked. Be on --- the lookout for special signals that may be used by the thread library. - -package body System.Interrupt_Management is - - use System.OS_Interface; - - type Interrupt_List is array (Interrupt_ID range <>) of Interrupt_ID; - Exception_Interrupts : constant Interrupt_List := - (SIGTSTP, SIGILL, SIGTRAP, SIGEMT, SIGFPE, SIGBUS, SIGSTOP, SIGKILL, - SIGSEGV, SIGSYS, SIGXCPU, SIGXFSZ, SIGPROF, SIGPTINTR, SIGPTRESCHED, - SIGABRT, SIGPIPE); - - Unreserve_All_Interrupts : Interfaces.C.int; - pragma Import - (C, Unreserve_All_Interrupts, "__gl_unreserve_all_interrupts"); - - function State (Int : Interrupt_ID) return Character; - pragma Import (C, State, "__gnat_get_interrupt_state"); - - -- Get interrupt state. Defined in a-init.c - -- The input argument is the interrupt number, - -- and the result is one of the following: - - User : constant Character := 'u'; - Runtime : constant Character := 'r'; - Default : constant Character := 's'; - -- '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 (use "default" - -- system handler) - - ---------------- - -- Initialize -- - ---------------- - - Initialized : Boolean := False; - - procedure Initialize is - use type Interfaces.C.int; - begin - if Initialized then - return; - end if; - - Initialized := True; - Abort_Task_Interrupt := SIGABRT; - - -- Change this if you want to use another signal for task abort. - -- SIGTERM might be a good one. - - pragma Assert (Keep_Unmasked = (Interrupt_ID'Range => False)); - pragma Assert (Reserve = (Interrupt_ID'Range => False)); - - -- Process state of exception signals - - for J in Exception_Interrupts'Range loop - if State (Exception_Interrupts (J)) /= User then - Keep_Unmasked (Exception_Interrupts (J)) := True; - Reserve (Exception_Interrupts (J)) := True; - end if; - end loop; - - if State (Abort_Task_Interrupt) /= User then - Keep_Unmasked (Abort_Task_Interrupt) := True; - Reserve (Abort_Task_Interrupt) := True; - end if; - - -- Set SIGINT to unmasked state as long as it's - -- not in "User" state. Check for Unreserve_All_Interrupts last - - if State (SIGINT) /= User then - Keep_Unmasked (SIGINT) := True; - end if; - - -- Check all signals for state that requires keeping them - -- unmasked and reserved - - for J in Interrupt_ID'Range loop - if State (J) = Default or else State (J) = Runtime then - Keep_Unmasked (J) := True; - Reserve (J) := True; - end if; - end loop; - - -- Process pragma Unreserve_All_Interrupts. This overrides any - -- settings due to pragma Interrupt_State: - - if Unreserve_All_Interrupts /= 0 then - Keep_Unmasked (SIGINT) := False; - Reserve (SIGINT) := False; - end if; - - -- We do not have Signal 0 in reality. We just use this value - -- to identify not existing signals (see s-intnam.ads). Therefore, - -- Signal 0 should not be used in all signal related operations hence - -- mark it as reserved. - - Reserve (0) := True; - end Initialize; - -end System.Interrupt_Management; diff --git a/gcc/ada/s-mastop-irix.adb b/gcc/ada/s-mastop-irix.adb deleted file mode 100644 index 2c8968b..0000000 --- a/gcc/ada/s-mastop-irix.adb +++ /dev/null @@ -1,351 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- SYSTEM.MACHINE_STATE_OPERATIONS -- --- -- --- B o d y -- --- (Version for IRIX/MIPS) -- --- -- --- Copyright (C) 1999-2009, 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT 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. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This version of Ada.Exceptions.Machine_State_Operations is for use on --- SGI Irix systems. By means of compile time conditional calculations, it --- can handle both n32/n64 and o32 modes. - -with System.Machine_Code; use System.Machine_Code; -with System.Memory; -with System.Soft_Links; use System.Soft_Links; -with Ada.Unchecked_Conversion; - -package body System.Machine_State_Operations is - - use System.Storage_Elements; - - -- The exc_unwind function in libexc operates on a Sigcontext - - -- Type sigcontext_t is defined in /usr/include/sys/signal.h. - -- We define an equivalent Ada type here. From the comments in - -- signal.h: - - -- sigcontext is not part of the ABI - so this version is used to - -- handle 32 and 64 bit applications - it is a constant size regardless - -- of compilation mode, and always returns 64 bit register values - - type Uns32 is mod 2 ** 32; - type Uns64 is mod 2 ** 64; - - type Uns32_Ptr is access all Uns32; - type Uns64_Array is array (Integer range <>) of Uns64; - - type Reg_Array is array (0 .. 31) of Uns64; - - type Sigcontext is record - SC_Regmask : Uns32; -- 0 - SC_Status : Uns32; -- 4 - SC_PC : Uns64; -- 8 - SC_Regs : Reg_Array; -- 16 - SC_Fpregs : Reg_Array; -- 272 - SC_Ownedfp : Uns32; -- 528 - SC_Fpc_Csr : Uns32; -- 532 - SC_Fpc_Eir : Uns32; -- 536 - SC_Ssflags : Uns32; -- 540 - SC_Mdhi : Uns64; -- 544 - SC_Mdlo : Uns64; -- 552 - SC_Cause : Uns64; -- 560 - SC_Badvaddr : Uns64; -- 568 - SC_Triggersave : Uns64; -- 576 - SC_Sigset : Uns64; -- 584 - SC_Fp_Rounded_Result : Uns64; -- 592 - SC_Pancake : Uns64_Array (0 .. 5); - SC_Pad : Uns64_Array (0 .. 26); - end record; - - type Sigcontext_Ptr is access all Sigcontext; - - SC_Regs_Pos : constant String := "16"; - SC_Fpregs_Pos : constant String := "272"; - -- Byte offset of the Integer and Floating Point register save areas - -- within the Sigcontext. - - function To_Sigcontext_Ptr is - new Ada.Unchecked_Conversion (Machine_State, Sigcontext_Ptr); - - type Addr_Int is mod 2 ** Long_Integer'Size; - -- An unsigned integer type whose size is the same as System.Address. - -- We rely on the fact that Long_Integer'Size = System.Address'Size in - -- all ABIs. Type Addr_Int can be converted to Uns64. - - function To_Code_Loc is - new Ada.Unchecked_Conversion (Addr_Int, Code_Loc); - function To_Addr_Int is - new Ada.Unchecked_Conversion (System.Address, Addr_Int); - function To_Uns32_Ptr is - new Ada.Unchecked_Conversion (Addr_Int, Uns32_Ptr); - - -------------------------------- - -- ABI-Dependent Declarations -- - -------------------------------- - - o32 : constant Boolean := System.Word_Size = 32; - n32 : constant Boolean := System.Word_Size = 64; - o32n : constant Natural := Boolean'Pos (o32); - n32n : constant Natural := Boolean'Pos (n32); - -- Flags to indicate which ABI is in effect for this compilation. For the - -- purposes of this unit, the n32 and n64 ABIs are identical. - - LSC : constant Character := Character'Val (o32n * Character'Pos ('w') + - n32n * Character'Pos ('d')); - -- This is 'w' for o32, and 'd' for n32/n64, used for constructing the - -- load/store instructions used to save/restore machine instructions. - - Roff : constant Character := Character'Val (o32n * Character'Pos ('4') + - n32n * Character'Pos ('0')); - -- Offset from first byte of a __uint64 register save location where - -- the register value is stored. For n32/64 we store the entire 64 - -- bit register into the uint64. For o32, only 32 bits are stored - -- at an offset of 4 bytes. This is used as part of expressions with - -- '+' signs on both sides, so a null offset has to be '0' and not ' ' - -- to avoid assembler syntax errors on "X + + Y" in the latter case. - - procedure Update_GP (Scp : Sigcontext_Ptr); - - --------------- - -- Update_GP -- - --------------- - - procedure Update_GP (Scp : Sigcontext_Ptr) is - - type F_op is mod 2 ** 6; - type F_reg is mod 2 ** 5; - type F_imm is new Short_Integer; - - type I_Type is record - op : F_op; - rs : F_reg; - rt : F_reg; - imm : F_imm; - end record; - - pragma Pack (I_Type); - for I_Type'Size use 32; - - type I_Type_Ptr is access all I_Type; - - LW : constant F_op := 2#100011#; - Reg_GP : constant := 28; - - type Address_Int is mod 2 ** Standard'Address_Size; - function To_I_Type_Ptr is new - Ada.Unchecked_Conversion (Address_Int, I_Type_Ptr); - - Ret_Ins : constant I_Type_Ptr := To_I_Type_Ptr (Address_Int (Scp.SC_PC)); - GP_Ptr : Uns32_Ptr; - - begin - if Ret_Ins.op = LW and then Ret_Ins.rt = Reg_GP then - GP_Ptr := To_Uns32_Ptr - (Addr_Int (Scp.SC_Regs (Integer (Ret_Ins.rs))) - + Addr_Int (Ret_Ins.imm)); - Scp.SC_Regs (Reg_GP) := Uns64 (GP_Ptr.all); - end if; - end Update_GP; - - ---------------------------- - -- Allocate_Machine_State -- - ---------------------------- - - function Allocate_Machine_State return Machine_State is - begin - return Machine_State - (Memory.Alloc (Sigcontext'Max_Size_In_Storage_Elements)); - end Allocate_Machine_State; - - ---------------- - -- Fetch_Code -- - ---------------- - - function Fetch_Code (Loc : Code_Loc) return Code_Loc is - begin - return Loc; - end Fetch_Code; - - ------------------------ - -- Free_Machine_State -- - ------------------------ - - procedure Free_Machine_State (M : in out Machine_State) is - begin - Memory.Free (Address (M)); - M := Machine_State (Null_Address); - end Free_Machine_State; - - ------------------ - -- Get_Code_Loc -- - ------------------ - - function Get_Code_Loc (M : Machine_State) return Code_Loc is - SC : constant Sigcontext_Ptr := To_Sigcontext_Ptr (M); - begin - return To_Code_Loc (Addr_Int (SC.SC_PC)); - end Get_Code_Loc; - - -------------------------- - -- Machine_State_Length -- - -------------------------- - - function Machine_State_Length return Storage_Offset is - begin - return Sigcontext'Max_Size_In_Storage_Elements; - end Machine_State_Length; - - --------------- - -- Pop_Frame -- - --------------- - - procedure Pop_Frame (M : Machine_State) is - Scp : constant Sigcontext_Ptr := To_Sigcontext_Ptr (M); - - procedure Exc_Unwind (Scp : Sigcontext_Ptr; Fde : Long_Integer := 0); - pragma Import (C, Exc_Unwind, "exc_unwind"); - - pragma Linker_Options ("-lexc"); - - begin - -- exc_unwind is apparently not thread-safe under IRIX, so protect it - -- against race conditions within the GNAT run time. - -- ??? Note that we might want to use a fine grained lock here since - -- Lock_Task is used in many other places. - - Lock_Task.all; - - Exc_Unwind (Scp); - - Unlock_Task.all; - - if Scp.SC_PC = 0 or else Scp.SC_PC = 1 then - - -- A return value of 0 or 1 means exc_unwind couldn't find a parent - -- frame. Propagate_Exception expects a zero return address to - -- indicate TOS. - - Scp.SC_PC := 0; - - else - -- Set the GP to restore to the caller value (not callee value) - -- This is done only in o32 mode. In n32/n64 mode, GP is a normal - -- callee save register - - if o32 then - Update_GP (Scp); - end if; - - -- Adjust the return address to the call site, not the - -- instruction following the branch delay slot. This may - -- be necessary if the last instruction of a pragma No_Return - -- subprogram is a call. The first instruction following the - -- delay slot may be the start of another subprogram. We back - -- off the address by 8, which points safely into the middle - -- of the generated subprogram code, avoiding end effects. - - Scp.SC_PC := Scp.SC_PC - 8; - end if; - end Pop_Frame; - - ----------------------- - -- Set_Machine_State -- - ----------------------- - - procedure Set_Machine_State (M : Machine_State) is - - SI : constant String (1 .. 2) := 's' & LSC; - -- This is "sw" in o32 mode, and "sd" in n32 mode - - SF : constant String (1 .. 4) := 's' & LSC & "c1"; - -- This is "swc1" in o32 mode and "sdc1" in n32 mode - - PI : String renames SC_Regs_Pos; - PF : String renames SC_Fpregs_Pos; - - Scp : Sigcontext_Ptr; - - begin - -- Save the integer registers. Note that we know that $4 points - -- to M, since that is where the first parameter is passed. - -- Restore integer registers from machine state. Note that we know - -- that $4 points to M since this is the standard calling sequence - - <<Past_Prolog>> - - Asm (SI & " $16, 16*8+" & Roff & "+" & PI & "($4)", Volatile => True); - Asm (SI & " $17, 17*8+" & Roff & "+" & PI & "($4)", Volatile => True); - Asm (SI & " $18, 18*8+" & Roff & "+" & PI & "($4)", Volatile => True); - Asm (SI & " $19, 19*8+" & Roff & "+" & PI & "($4)", Volatile => True); - Asm (SI & " $20, 20*8+" & Roff & "+" & PI & "($4)", Volatile => True); - Asm (SI & " $21, 21*8+" & Roff & "+" & PI & "($4)", Volatile => True); - Asm (SI & " $22, 22*8+" & Roff & "+" & PI & "($4)", Volatile => True); - Asm (SI & " $23, 23*8+" & Roff & "+" & PI & "($4)", Volatile => True); - Asm (SI & " $24, 24*8+" & Roff & "+" & PI & "($4)", Volatile => True); - Asm (SI & " $25, 25*8+" & Roff & "+" & PI & "($4)", Volatile => True); - Asm (SI & " $26, 26*8+" & Roff & "+" & PI & "($4)", Volatile => True); - Asm (SI & " $27, 27*8+" & Roff & "+" & PI & "($4)", Volatile => True); - Asm (SI & " $28, 28*8+" & Roff & "+" & PI & "($4)", Volatile => True); - Asm (SI & " $29, 29*8+" & Roff & "+" & PI & "($4)", Volatile => True); - Asm (SI & " $30, 30*8+" & Roff & "+" & PI & "($4)", Volatile => True); - Asm (SI & " $31, 31*8+" & Roff & "+" & PI & "($4)", Volatile => True); - - -- Restore floating-point registers from machine state - - Asm (SF & " $f16, 16*8+" & Roff & "+" & PF & "($4)", Volatile => True); - Asm (SF & " $f17, 17*8+" & Roff & "+" & PF & "($4)", Volatile => True); - Asm (SF & " $f18, 18*8+" & Roff & "+" & PF & "($4)", Volatile => True); - Asm (SF & " $f19, 19*8+" & Roff & "+" & PF & "($4)", Volatile => True); - Asm (SF & " $f20, 20*8+" & Roff & "+" & PF & "($4)", Volatile => True); - Asm (SF & " $f21, 21*8+" & Roff & "+" & PF & "($4)", Volatile => True); - Asm (SF & " $f22, 22*8+" & Roff & "+" & PF & "($4)", Volatile => True); - Asm (SF & " $f23, 23*8+" & Roff & "+" & PF & "($4)", Volatile => True); - Asm (SF & " $f24, 24*8+" & Roff & "+" & PF & "($4)", Volatile => True); - Asm (SF & " $f25, 25*8+" & Roff & "+" & PF & "($4)", Volatile => True); - Asm (SF & " $f26, 26*8+" & Roff & "+" & PF & "($4)", Volatile => True); - Asm (SF & " $f27, 27*8+" & Roff & "+" & PF & "($4)", Volatile => True); - Asm (SF & " $f28, 28*8+" & Roff & "+" & PF & "($4)", Volatile => True); - Asm (SF & " $f29, 29*8+" & Roff & "+" & PF & "($4)", Volatile => True); - Asm (SF & " $f30, 30*8+" & Roff & "+" & PF & "($4)", Volatile => True); - Asm (SF & " $f31, 31*8+" & Roff & "+" & PF & "($4)", Volatile => True); - - -- Set the PC value for the context to a location after the - -- prolog has been executed. - - Scp := To_Sigcontext_Ptr (M); - Scp.SC_PC := Uns64 (To_Addr_Int (Past_Prolog'Address)); - - -- We saved the state *inside* this routine, but what we want is - -- the state at the call site. So we need to do one pop operation. - -- This pop operation will properly set the PC value in the machine - -- state, so there is no need to save PC in the above code. - - Pop_Frame (M); - end Set_Machine_State; - -end System.Machine_State_Operations; diff --git a/gcc/ada/s-oscons-tmplt.c b/gcc/ada/s-oscons-tmplt.c index 3005ba7..6ea5775 100644 --- a/gcc/ada/s-oscons-tmplt.c +++ b/gcc/ada/s-oscons-tmplt.c @@ -84,15 +84,6 @@ pragma Style_Checks ("M32766"); /** For Linux _XOPEN_SOURCE must be defined, otherwise IOV_MAX is not defined **/ #define _XOPEN_SOURCE 500 - -#elif defined (__mips) && defined (__sgi) -/** For IRIX 6, _XOPEN5 must be defined and _XOPEN_IOV_MAX must be used as - ** IOV_MAX, otherwise IOV_MAX is not defined. IRIX 5 has neither. - **/ -#ifdef _XOPEN_IOV_MAX -#define _XOPEN5 -#define IOV_MAX _XOPEN_IOV_MAX -#endif #endif /* Include gsocket.h before any system header so it can redefine FD_SETSIZE */ @@ -1233,11 +1224,11 @@ CND(SIZEOF_tv_usec, "tv_usec") */ /** - ** On Solaris and IRIX, field tv_sec in struct timeval has an undocumented + ** On Solaris, field tv_sec in struct timeval has an undocumented ** hard-wired limit of 100 million. ** On IA64 HP-UX the limit is 2**31 - 1. **/ -#if defined (sun) || (defined (__mips) && defined (__sgi)) +#if defined (sun) # define MAX_tv_sec "100_000_000" #elif defined (__hpux__) @@ -1348,11 +1339,6 @@ CND(CLOCK_MONOTONIC, "System monotonic clock") CND(CLOCK_FASTEST, "Fastest clock") #endif -#if defined (__sgi) -CND(CLOCK_SGI_FAST, "SGI fast clock") -CND(CLOCK_SGI_CYCLE, "SGI CPU clock") -#endif - #ifndef CLOCK_THREAD_CPUTIME_ID # define CLOCK_THREAD_CPUTIME_ID -1 #endif diff --git a/gcc/ada/s-osinte-irix.adb b/gcc/ada/s-osinte-irix.adb deleted file mode 100644 index cc3e015..0000000 --- a/gcc/ada/s-osinte-irix.adb +++ /dev/null @@ -1,87 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- --- -- --- S Y S T E M . O S _ I N T E R F A C E -- --- -- --- B o d y -- --- -- --- Copyright (C) 1992-2009 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 3, or (at your option) any later ver- -- --- sion. GNAT 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. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNARL was developed by the GNARL team at Florida State University. -- --- Extensive contributions were provided by Ada Core Technologies, Inc. -- --- -- ------------------------------------------------------------------------------- - --- This is the IRIX version of this package - --- This package encapsulates all direct interfaces to OS services that are --- needed by children of System. - -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 Interfaces.C; use Interfaces.C; - -package body System.OS_Interface is - - ------------------ - -- pthread_init -- - ------------------ - - procedure pthread_init is - begin - null; - end pthread_init; - - ----------------- - -- To_Duration -- - ----------------- - - function To_Duration (TS : timespec) return Duration is - begin - return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9; - end To_Duration; - - ----------------- - -- To_Timespec -- - ----------------- - - function To_Timespec (D : Duration) return timespec is - S : time_t; - F : Duration; - - begin - S := time_t (Long_Long_Integer (D)); - F := D - Duration (S); - - -- If F has negative value due to a round-up, adjust for positive F - -- value. - - if F < 0.0 then - S := S - 1; - F := F + 1.0; - end if; - - return timespec'(tv_sec => S, - tv_nsec => long (Long_Long_Integer (F * 10#1#E9))); - end To_Timespec; - -end System.OS_Interface; diff --git a/gcc/ada/s-osinte-irix.ads b/gcc/ada/s-osinte-irix.ads deleted file mode 100644 index 365a3de..0000000 --- a/gcc/ada/s-osinte-irix.ads +++ /dev/null @@ -1,519 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT 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-2011, 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT 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. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNARL was developed by the GNARL team at Florida State University. -- --- Extensive contributions were provided by Ada Core Technologies, Inc. -- --- -- ------------------------------------------------------------------------------- - --- This is the SGI Pthreads 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 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"); - - EINTR : constant := 4; -- interrupted system call - EAGAIN : constant := 11; -- No more processes - ENOMEM : constant := 12; -- Not enough core - EINVAL : constant := 22; -- Invalid argument - ETIMEDOUT : constant := 145; -- Connection timed out - - ------------- - -- Signals -- - ------------- - - Max_Interrupt : constant := 64; - 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 instruction - 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 argument to 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 - SIGWINCH : constant := 20; -- window size change - SIGURG : constant := 21; -- urgent condition on IO channel - SIGPOLL : constant := 22; -- pollable event occurred - SIGIO : constant := 22; -- I/O possible (Solaris SIGPOLL alias) - SIGSTOP : constant := 23; -- stop (cannot be caught or ignored) - SIGTSTP : constant := 24; -- user stop requested from tty - SIGCONT : constant := 25; -- stopped process has been continued - SIGTTIN : constant := 26; -- background tty read attempted - SIGTTOU : constant := 27; -- background tty write attempted - SIGVTALRM : constant := 28; -- virtual timer expired - SIGPROF : constant := 29; -- profiling timer expired - SIGXCPU : constant := 30; -- CPU time limit exceeded - SIGXFSZ : constant := 31; -- filesize limit exceeded - SIGK32 : constant := 32; -- reserved for kernel (IRIX) - SIGCKPT : constant := 33; -- Checkpoint warning - SIGRESTART : constant := 34; -- Restart warning - SIGUME : constant := 35; -- Uncorrectable memory error - -- Signals defined for Posix 1003.1c - SIGPTINTR : constant := 47; - SIGPTRESCHED : constant := 48; - -- Posix 1003.1b signals - SIGRTMIN : constant := 49; -- Posix 1003.1b signals - SIGRTMAX : constant := 64; -- Posix 1003.1b signals - - 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 array_type_2 is array (Integer range 0 .. 1) of int; - type struct_sigaction is record - sa_flags : int; - sa_handler : System.Address; - sa_mask : sigset_t; - sa_resv : array_type_2; - end record; - pragma Convention (C, struct_sigaction); - - type struct_sigaction_ptr is access all struct_sigaction; - - SIG_BLOCK : constant := 1; - SIG_UNBLOCK : constant := 2; - SIG_SETMASK : constant := 3; - - SIG_DFL : constant := 0; - SIG_IGN : constant := 1; - - function sigaction - (sig : Signal; - act : struct_sigaction_ptr; - oact : struct_sigaction_ptr := null) return int; - pragma Import (C, sigaction, "sigaction"); - - ---------- - -- Time -- - ---------- - - type timespec is private; - type timespec_ptr is access all timespec; - - type clockid_t is new int; - - SGI_CYCLECNTR_SIZE : constant := 165; - - function syssgi (request : Interfaces.C.int) return Interfaces.C.ptrdiff_t; - pragma Import (C, syssgi, "syssgi"); - - function clock_gettime - (clock_id : clockid_t; - tp : access timespec) return int; - pragma Import (C, clock_gettime, "clock_gettime"); - - function clock_getres - (clock_id : clockid_t; - tp : access timespec) return int; - pragma Import (C, clock_getres, "clock_getres"); - - function To_Duration (TS : timespec) return Duration; - pragma Inline (To_Duration); - - function To_Timespec (D : Duration) return timespec; - pragma Inline (To_Timespec); - - ------------------------- - -- Priority Scheduling -- - ------------------------- - - SCHED_FIFO : constant := 1; - SCHED_RR : constant := 2; - SCHED_TS : constant := 3; - SCHED_OTHER : constant := 3; - SCHED_NP : constant := 4; - - function sched_get_priority_min (Policy : int) return int; - pragma Import (C, sched_get_priority_min, "sched_get_priority_min"); - - function sched_get_priority_max (Policy : int) return int; - pragma Import (C, sched_get_priority_max, "sched_get_priority_max"); - - ------------- - -- 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 private; - subtype Thread_Id is 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; - - -- Read/Write lock not supported on SGI. To add support both types - -- pthread_rwlock_t and pthread_rwlockattr_t must properly be defined - -- with the associated routines pthread_rwlock_[init/destroy] and - -- pthread_rwlock_[rdlock/wrlock/unlock]. - - subtype pthread_rwlock_t is pthread_mutex_t; - subtype pthread_rwlockattr_t is pthread_mutexattr_t; - - ----------- - -- Stack -- - ----------- - - Alternate_Stack_Size : constant := 0; - -- No alternate signal stack is used on this platform - - --------------------------------------- - -- 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 -- - -------------------------- - - PTHREAD_PRIO_NONE : constant := 0; - PTHREAD_PRIO_PROTECT : constant := 2; - PTHREAD_PRIO_INHERIT : constant := 1; - - function pthread_mutexattr_setprotocol - (attr : access pthread_mutexattr_t; - protocol : int) return int; - pragma Import (C, pthread_mutexattr_setprotocol); - - function pthread_mutexattr_setprioceiling - (attr : access pthread_mutexattr_t; - prioceiling : int) return int; - pragma Import (C, pthread_mutexattr_setprioceiling); - - type struct_sched_param is record - sched_priority : int; - 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_setscope - (attr : access pthread_attr_t; - contentionscope : int) return int; - pragma Import (C, pthread_attr_setscope, "pthread_attr_setscope"); - - function pthread_attr_setinheritsched - (attr : access pthread_attr_t; - inheritsched : int) return int; - pragma Import - (C, pthread_attr_setinheritsched, "pthread_attr_setinheritsched"); - - function pthread_attr_setschedpolicy - (attr : access pthread_attr_t; - policy : int) return int; - pragma Import (C, pthread_attr_setschedpolicy); - - function pthread_attr_setschedparam - (attr : access pthread_attr_t; - sched_param : access struct_sched_param) - return int; - pragma Import (C, pthread_attr_setschedparam, "pthread_attr_setschedparam"); - - 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); - - 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"); - - ------------------- - -- SGI Additions -- - ------------------- - - -- Non portable SGI 6.5 additions to the pthread interface must be - -- executed from within the context of a system scope task. - - function pthread_setrunon_np (cpu : int) return int; - pragma Import (C, pthread_setrunon_np, "pthread_setrunon_np"); - -private - - type array_type_1 is array (Integer range 0 .. 3) of unsigned; - type sigset_t is record - X_X_sigbits : array_type_1; - end record; - pragma Convention (C, sigset_t); - - type pid_t is new long; - - type time_t is new long; - - type timespec is record - tv_sec : time_t; - tv_nsec : long; - end record; - pragma Convention (C, timespec); - - type array_type_9 is array (Integer range 0 .. 4) of long; - type pthread_attr_t is record - X_X_D : array_type_9; - end record; - pragma Convention (C, pthread_attr_t); - - type array_type_8 is array (Integer range 0 .. 1) of long; - type pthread_condattr_t is record - X_X_D : array_type_8; - end record; - pragma Convention (C, pthread_condattr_t); - - type array_type_7 is array (Integer range 0 .. 1) of long; - type pthread_mutexattr_t is record - X_X_D : array_type_7; - end record; - pragma Convention (C, pthread_mutexattr_t); - - type pthread_t is new unsigned; - - type array_type_10 is array (Integer range 0 .. 7) of long; - type pthread_mutex_t is record - X_X_D : array_type_10; - end record; - pragma Convention (C, pthread_mutex_t); - - type array_type_11 is array (Integer range 0 .. 7) of long; - type pthread_cond_t is record - X_X_D : array_type_11; - end record; - pragma Convention (C, pthread_cond_t); - - type pthread_key_t is new int; - -end System.OS_Interface; diff --git a/gcc/ada/s-proinf-irix-athread.adb b/gcc/ada/s-proinf-irix-athread.adb deleted file mode 100644 index 31e4dcc..0000000 --- a/gcc/ada/s-proinf-irix-athread.adb +++ /dev/null @@ -1,225 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- S Y S T E M . P R O G R A M _ I N F O -- --- -- --- B o d y -- --- -- --- Copyright (C) 1997-2009, 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT 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. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This is an Irix (old pthread library) version of this package - --- This package contains the parameters used by the run-time system at --- program startup. These parameters are isolated in this package body to --- facilitate replacement by the end user. --- --- To replace the default values, copy this source file into your build --- directory, edit the file to reflect your desired behavior, and recompile --- with the command: --- --- % gcc -c -O2 -gnatpg s-proinf.adb --- --- then relink your application as usual. - -pragma Warnings (Off); -- why??? -with System.OS_Lib; -pragma Warnings (On); - -package body System.Program_Info is - - Kbytes : constant := 1024; - - Default_Initial_Sproc_Count : constant := 0; - Default_Max_Sproc_Count : constant := 128; - Default_Sproc_Stack_Size : constant := 16#4000#; - Default_Stack_Guard_Pages : constant := 1; - Default_Default_Time_Slice : constant := 0.0; - Default_Default_Task_Stack : constant := 12 * Kbytes; - Default_Pthread_Sched_Signal : constant := 35; - Default_Pthread_Arena_Size : constant := 16#40000#; - Default_Os_Default_Priority : constant := 0; - - ------------------------- - -- Initial_Sproc_Count -- - ------------------------- - - function Initial_Sproc_Count return Integer is - - function sysmp (P1 : Integer) return Integer; - pragma Import (C, sysmp, "sysmp", "sysmp"); - - MP_NPROCS : constant := 1; -- # processor in complex - - Pthread_Sproc_Count : constant System.OS_Lib.String_Access := - System.OS_Lib.Getenv ("PTHREAD_SPROC_COUNT"); - - begin - if Pthread_Sproc_Count.all'Length = 0 then - return Default_Initial_Sproc_Count; - - elsif Pthread_Sproc_Count.all = "AUTO" then - return sysmp (MP_NPROCS); - - else - return Integer'Value (Pthread_Sproc_Count.all); - end if; - - exception - when others => - return Default_Initial_Sproc_Count; - end Initial_Sproc_Count; - - --------------------- - -- Max_Sproc_Count -- - --------------------- - - function Max_Sproc_Count return Integer is - Pthread_Max_Sproc_Count : constant System.OS_Lib.String_Access := - System.OS_Lib.Getenv ("PTHREAD_MAX_SPROC_COUNT"); - - begin - if Pthread_Max_Sproc_Count.all'Length = 0 then - return Default_Max_Sproc_Count; - else - return Integer'Value (Pthread_Max_Sproc_Count.all); - end if; - exception - when others => - return Default_Max_Sproc_Count; - end Max_Sproc_Count; - - ---------------------- - -- Sproc_Stack_Size -- - ---------------------- - - function Sproc_Stack_Size return Integer is - begin - return Default_Sproc_Stack_Size; - end Sproc_Stack_Size; - - ------------------------ - -- Default_Time_Slice -- - ------------------------ - - function Default_Time_Slice return Duration is - Pthread_Time_Slice_Sec : constant System.OS_Lib.String_Access := - System.OS_Lib.Getenv - ("PTHREAD_TIME_SLICE_SEC"); - Pthread_Time_Slice_Usec : constant System.OS_Lib.String_Access := - System.OS_Lib.Getenv - ("PTHREAD_TIME_SLICE_USEC"); - - Val_Sec, Val_Usec : Integer := 0; - - begin - if Pthread_Time_Slice_Sec.all'Length /= 0 or - Pthread_Time_Slice_Usec.all'Length /= 0 - then - if Pthread_Time_Slice_Sec.all'Length /= 0 then - Val_Sec := Integer'Value (Pthread_Time_Slice_Sec.all); - end if; - - if Pthread_Time_Slice_Usec.all'Length /= 0 then - Val_Usec := Integer'Value (Pthread_Time_Slice_Usec.all); - end if; - - return Duration (Val_Sec) + Duration (Val_Usec) / 1000.0; - else - return Default_Default_Time_Slice; - end if; - - exception - when others => - return Default_Default_Time_Slice; - end Default_Time_Slice; - - ------------------------ - -- Default_Task_Stack -- - ------------------------ - - function Default_Task_Stack return Integer is - begin - return Default_Default_Task_Stack; - end Default_Task_Stack; - - ----------------------- - -- Stack_Guard_Pages -- - ----------------------- - - function Stack_Guard_Pages return Integer is - Pthread_Stack_Guard_Pages : constant System.OS_Lib.String_Access := - System.OS_Lib.Getenv - ("PTHREAD_STACK_GUARD_PAGES"); - begin - if Pthread_Stack_Guard_Pages.all'Length /= 0 then - return Integer'Value (Pthread_Stack_Guard_Pages.all); - else - return Default_Stack_Guard_Pages; - end if; - exception - when others => - return Default_Stack_Guard_Pages; - end Stack_Guard_Pages; - - -------------------------- - -- Pthread_Sched_Signal -- - -------------------------- - - function Pthread_Sched_Signal return Integer is - begin - return Default_Pthread_Sched_Signal; - end Pthread_Sched_Signal; - - ------------------------ - -- Pthread_Arena_Size -- - ------------------------ - - function Pthread_Arena_Size return Integer is - Pthread_Arena_Size : constant System.OS_Lib.String_Access := - System.OS_Lib.Getenv - ("PTHREAD_ARENA_SIZE"); - - begin - if Pthread_Arena_Size.all'Length = 0 then - return Default_Pthread_Arena_Size; - else - return Integer'Value (Pthread_Arena_Size.all); - end if; - - exception - when others => - return Default_Pthread_Arena_Size; - end Pthread_Arena_Size; - - ------------------------- - -- Os_Default_Priority -- - ------------------------- - - function Os_Default_Priority return Integer is - begin - return Default_Os_Default_Priority; - end Os_Default_Priority; - -end System.Program_Info; diff --git a/gcc/ada/s-proinf-irix-athread.ads b/gcc/ada/s-proinf-irix-athread.ads deleted file mode 100644 index 8c24a55..0000000 --- a/gcc/ada/s-proinf-irix-athread.ads +++ /dev/null @@ -1,76 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- S Y S T E M . P R O G R A M _ I N F O -- --- -- --- S p e c -- --- -- --- Copyright (C) 1997-2009, 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT 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. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This package contains the definitions and routines used as parameters to --- the run-time system at program startup for the SGI implementation. - -package System.Program_Info is - pragma Preelaborate; - - function Initial_Sproc_Count return Integer; - -- The number of sproc created at program startup for scheduling threads - - function Max_Sproc_Count return Integer; - -- The maximum number of sprocs that can be created by the program for - -- servicing threads. This limit includes both the pre-created sprocs and - -- those explicitly created under program control. - - function Sproc_Stack_Size return Integer; - -- The size, in bytes, of the sproc's initial stack - - function Default_Time_Slice return Duration; - -- The default time quanta for round-robin scheduling of threads of - -- equal priority. This default value can be overridden on a per-task - -- basis by specifying an alternate value via the implementation-defined - -- Task_Info pragma. See s-tasinf.ads for more information. - - function Default_Task_Stack return Integer; - -- The default stack size for each created thread. This default value can - -- be overridden on a per-task basis by the language-defined Storage_Size - -- pragma. - - function Stack_Guard_Pages return Integer; - -- The number of non-writable, guard pages to append to the bottom of - -- each thread's stack. - - function Pthread_Sched_Signal return Integer; - -- The signal used by the Pthreads library to affect scheduling actions - -- in remote sprocs. - - function Pthread_Arena_Size return Integer; - -- The size of the shared arena from which pthread locks are allocated. - -- See the usinit(3p) man page for more information on shared arenas. - - function Os_Default_Priority return Integer; - -- The default Irix Non-Degrading priority for each sproc created to - -- service threads. - -end System.Program_Info; diff --git a/gcc/ada/s-taprop-irix.adb b/gcc/ada/s-taprop-irix.adb deleted file mode 100644 index 8893c01..0000000 --- a/gcc/ada/s-taprop-irix.adb +++ /dev/null @@ -1,1358 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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 . O P E R A T I O N S -- --- -- --- B o d y -- --- -- --- Copyright (C) 1992-2011, 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 3, or (at your option) any later ver- -- --- sion. GNAT 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. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNARL was developed by the GNARL team at Florida State University. -- --- Extensive contributions were provided by Ada Core Technologies, Inc. -- --- -- ------------------------------------------------------------------------------- - --- This is a IRIX (pthread library) version of this package - --- This package contains all the GNULL primitives that interface directly with --- the underlying OS. - -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 Ada.Unchecked_Conversion; - -with Interfaces.C; - -with System.Task_Info; -with System.Tasking.Debug; -with System.Interrupt_Management; -with System.OS_Constants; -with System.OS_Primitives; -with System.IO; - -with System.Soft_Links; --- We use System.Soft_Links instead of System.Tasking.Initialization --- because the later is a higher level package that we shouldn't depend on. --- For example when using the restricted run time, it is replaced by --- System.Tasking.Restricted.Stages. - -package body System.Task_Primitives.Operations is - - package OSC renames System.OS_Constants; - package SSL renames System.Soft_Links; - - use System.Tasking; - use System.Tasking.Debug; - use Interfaces.C; - use System.OS_Interface; - use System.OS_Primitives; - use System.Parameters; - - ---------------- - -- Local Data -- - ---------------- - - -- The followings are logically constants, but need to be initialized - -- at run time. - - Single_RTS_Lock : aliased RTS_Lock; - -- This is a lock to allow only one thread of control in the RTS at - -- a time; it is used to execute in mutual exclusion from all other tasks. - -- Used mainly in Single_Lock mode, but also to protect All_Tasks_List - - Environment_Task_Id : Task_Id; - -- A variable to hold Task_Id for the environment task - - Locking_Policy : Character; - pragma Import (C, Locking_Policy, "__gl_locking_policy"); - - Time_Slice_Val : Integer; - pragma Import (C, Time_Slice_Val, "__gl_time_slice_val"); - - Dispatching_Policy : Character; - pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy"); - - Unblocked_Signal_Mask : aliased sigset_t; - - Foreign_Task_Elaborated : aliased Boolean := True; - -- Used to identified fake tasks (i.e., non-Ada Threads) - - Abort_Handler_Installed : Boolean := False; - -- True if a handler for the abort signal is installed - - -------------------- - -- Local Packages -- - -------------------- - - package Specific is - - procedure Initialize (Environment_Task : Task_Id); - pragma Inline (Initialize); - -- Initialize various data needed by this package - - function Is_Valid_Task return Boolean; - pragma Inline (Is_Valid_Task); - -- Does executing thread have a TCB? - - procedure Set (Self_Id : Task_Id); - pragma Inline (Set); - -- Set the self id for the current task - - function Self return Task_Id; - pragma Inline (Self); - -- Return a pointer to the Ada Task Control Block of the calling task - - end Specific; - - package body Specific is separate; - -- The body of this package is target specific - - ---------------------------------- - -- ATCB allocation/deallocation -- - ---------------------------------- - - package body ATCB_Allocation is separate; - -- The body of this package is shared across several targets - - --------------------------------- - -- Support for foreign threads -- - --------------------------------- - - function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id; - -- Allocate and Initialize a new ATCB for the current Thread - - function Register_Foreign_Thread - (Thread : Thread_Id) return Task_Id is separate; - - ----------------------- - -- Local Subprograms -- - ----------------------- - - function To_Address is - new Ada.Unchecked_Conversion (Task_Id, System.Address); - - procedure Abort_Handler (Sig : Signal); - -- Signal handler used to implement asynchronous abort - - ------------------- - -- Abort_Handler -- - ------------------- - - procedure Abort_Handler (Sig : Signal) is - pragma Unreferenced (Sig); - - T : constant Task_Id := Self; - Result : Interfaces.C.int; - Old_Set : aliased sigset_t; - - begin - -- It's not safe to raise an exception when using GCC ZCX mechanism. - -- Note that we still need to install a signal handler, since in some - -- cases (e.g. shutdown of the Server_Task in System.Interrupts) we - -- need to send the Abort signal to a task. - - if ZCX_By_Default then - return; - end if; - - if T.Deferral_Level = 0 - and then T.Pending_ATC_Level < T.ATC_Nesting_Level - then - -- Make sure signals used for RTS internal purpose are unmasked - - Result := pthread_sigmask - (SIG_UNBLOCK, - Unblocked_Signal_Mask'Access, - Old_Set'Access); - pragma Assert (Result = 0); - - raise Standard'Abort_Signal; - end if; - end Abort_Handler; - - ----------------- - -- Stack_Guard -- - ----------------- - - -- The underlying thread system sets a guard page at the - -- bottom of a thread stack, so nothing is needed. - - procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is - pragma Unreferenced (On); - pragma Unreferenced (T); - begin - null; - end Stack_Guard; - - ------------------- - -- Get_Thread_Id -- - ------------------- - - function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is - begin - return T.Common.LL.Thread; - end Get_Thread_Id; - - ---------- - -- Self -- - ---------- - - function Self return Task_Id renames Specific.Self; - - --------------------- - -- Initialize_Lock -- - --------------------- - - -- Note: mutexes and cond_variables needed per-task basis are initialized - -- in Initialize_TCB and the Storage_Error is handled. Other mutexes (such - -- as RTS_Lock, Memory_Lock...) used in RTS is initialized before any - -- status change of RTS. Therefore raising Storage_Error in the following - -- routines should be able to be handled safely. - - procedure Initialize_Lock - (Prio : System.Any_Priority; - L : not null access Lock) - is - Attributes : aliased pthread_mutexattr_t; - Result : Interfaces.C.int; - - begin - Result := pthread_mutexattr_init (Attributes'Access); - pragma Assert (Result = 0 or else Result = ENOMEM); - - if Result = ENOMEM then - raise Storage_Error; - end if; - - if Locking_Policy = 'C' then - Result := - pthread_mutexattr_setprotocol - (Attributes'Access, PTHREAD_PRIO_PROTECT); - pragma Assert (Result = 0); - - Result := - pthread_mutexattr_setprioceiling - (Attributes'Access, Interfaces.C.int (Prio)); - pragma Assert (Result = 0); - end if; - - Result := pthread_mutex_init (L.WO'Access, Attributes'Access); - pragma Assert (Result = 0 or else Result = ENOMEM); - - if Result = ENOMEM then - Result := pthread_mutexattr_destroy (Attributes'Access); - raise Storage_Error; - end if; - - Result := pthread_mutexattr_destroy (Attributes'Access); - pragma Assert (Result = 0); - end Initialize_Lock; - - procedure Initialize_Lock - (L : not null access RTS_Lock; - Level : Lock_Level) - is - pragma Unreferenced (Level); - - Attributes : aliased pthread_mutexattr_t; - Result : Interfaces.C.int; - - begin - Result := pthread_mutexattr_init (Attributes'Access); - pragma Assert (Result = 0 or else Result = ENOMEM); - - if Result = ENOMEM then - raise Storage_Error; - end if; - - if Locking_Policy = 'C' then - Result := pthread_mutexattr_setprotocol - (Attributes'Access, PTHREAD_PRIO_PROTECT); - pragma Assert (Result = 0); - - Result := pthread_mutexattr_setprioceiling - (Attributes'Access, Interfaces.C.int (System.Any_Priority'Last)); - pragma Assert (Result = 0); - end if; - - Result := pthread_mutex_init (L, Attributes'Access); - - pragma Assert (Result = 0 or else Result = ENOMEM); - - if Result = ENOMEM then - Result := pthread_mutexattr_destroy (Attributes'Access); - raise Storage_Error; - end if; - - Result := pthread_mutexattr_destroy (Attributes'Access); - pragma Assert (Result = 0); - end Initialize_Lock; - - ------------------- - -- Finalize_Lock -- - ------------------- - - procedure Finalize_Lock (L : not null access Lock) is - Result : Interfaces.C.int; - begin - Result := pthread_mutex_destroy (L.WO'Access); - pragma Assert (Result = 0); - end Finalize_Lock; - - procedure Finalize_Lock (L : not null access RTS_Lock) is - Result : Interfaces.C.int; - begin - Result := pthread_mutex_destroy (L); - pragma Assert (Result = 0); - end Finalize_Lock; - - ---------------- - -- Write_Lock -- - ---------------- - - procedure Write_Lock - (L : not null access Lock; Ceiling_Violation : out Boolean) - is - Result : Interfaces.C.int; - - begin - Result := pthread_mutex_lock (L.WO'Access); - Ceiling_Violation := Result = EINVAL; - - -- Assumes the cause of EINVAL is a priority ceiling violation - - pragma Assert (Result = 0 or else Result = EINVAL); - end Write_Lock; - - procedure Write_Lock - (L : not null access RTS_Lock; - Global_Lock : Boolean := False) - is - Result : Interfaces.C.int; - begin - if not Single_Lock or else Global_Lock then - Result := pthread_mutex_lock (L); - pragma Assert (Result = 0); - end if; - end Write_Lock; - - procedure Write_Lock (T : Task_Id) is - Result : Interfaces.C.int; - begin - if not Single_Lock then - Result := pthread_mutex_lock (T.Common.LL.L'Access); - pragma Assert (Result = 0); - end if; - end Write_Lock; - - --------------- - -- Read_Lock -- - --------------- - - procedure Read_Lock - (L : not null access Lock; Ceiling_Violation : out Boolean) is - begin - Write_Lock (L, Ceiling_Violation); - end Read_Lock; - - ------------ - -- Unlock -- - ------------ - - procedure Unlock (L : not null access Lock) is - Result : Interfaces.C.int; - begin - Result := pthread_mutex_unlock (L.WO'Access); - pragma Assert (Result = 0); - end Unlock; - - procedure Unlock - (L : not null access RTS_Lock; - Global_Lock : Boolean := False) - is - Result : Interfaces.C.int; - begin - if not Single_Lock or else Global_Lock then - Result := pthread_mutex_unlock (L); - pragma Assert (Result = 0); - end if; - end Unlock; - - procedure Unlock (T : Task_Id) is - Result : Interfaces.C.int; - begin - if not Single_Lock then - Result := pthread_mutex_unlock (T.Common.LL.L'Access); - pragma Assert (Result = 0); - end if; - end Unlock; - - ----------------- - -- Set_Ceiling -- - ----------------- - - -- Dynamic priority ceilings are not supported by the underlying system - - procedure Set_Ceiling - (L : not null access Lock; - Prio : System.Any_Priority) - is - pragma Unreferenced (L, Prio); - begin - null; - end Set_Ceiling; - - ----------- - -- Sleep -- - ----------- - - procedure Sleep - (Self_ID : ST.Task_Id; - Reason : System.Tasking.Task_States) - is - pragma Unreferenced (Reason); - Result : Interfaces.C.int; - - begin - Result := - pthread_cond_wait - (cond => Self_ID.Common.LL.CV'Access, - mutex => (if Single_Lock - then Single_RTS_Lock'Access - else Self_ID.Common.LL.L'Access)); - - -- EINTR is not considered a failure - - pragma Assert (Result = 0 or else Result = EINTR); - end Sleep; - - ----------------- - -- Timed_Sleep -- - ----------------- - - procedure Timed_Sleep - (Self_ID : Task_Id; - Time : Duration; - Mode : ST.Delay_Modes; - Reason : Task_States; - Timedout : out Boolean; - Yielded : out Boolean) - is - pragma Unreferenced (Reason); - - Base_Time : constant Duration := Monotonic_Clock; - Check_Time : Duration := Base_Time; - Abs_Time : Duration; - Request : aliased timespec; - Result : Interfaces.C.int; - - begin - Timedout := True; - Yielded := False; - - Abs_Time := - (if Mode = Relative - then Duration'Min (Time, Max_Sensible_Delay) + Check_Time - else Duration'Min (Check_Time + Max_Sensible_Delay, Time)); - - if Abs_Time > Check_Time then - Request := To_Timespec (Abs_Time); - - loop - exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level; - - Result := - pthread_cond_timedwait - (cond => Self_ID.Common.LL.CV'Access, - mutex => (if Single_Lock - then Single_RTS_Lock'Access - else Self_ID.Common.LL.L'Access), - abstime => Request'Access); - - Check_Time := Monotonic_Clock; - exit when Abs_Time <= Check_Time or else Check_Time < Base_Time; - - if Result = 0 or else errno = EINTR then - Timedout := False; - exit; - end if; - end loop; - end if; - end Timed_Sleep; - - ----------------- - -- Timed_Delay -- - ----------------- - - -- This is for use in implementing delay statements, so we assume - -- the caller is abort-deferred but is holding no locks. - - procedure Timed_Delay - (Self_ID : Task_Id; - Time : Duration; - Mode : ST.Delay_Modes) - is - Base_Time : constant Duration := Monotonic_Clock; - Check_Time : Duration := Base_Time; - Abs_Time : Duration; - Request : aliased timespec; - Result : Interfaces.C.int; - - begin - if Single_Lock then - Lock_RTS; - end if; - - Write_Lock (Self_ID); - - Abs_Time := - (if Mode = Relative - then Time + Check_Time - else Duration'Min (Check_Time + Max_Sensible_Delay, Time)); - - if Abs_Time > Check_Time then - Request := To_Timespec (Abs_Time); - Self_ID.Common.State := Delay_Sleep; - - loop - exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level; - - Result := - pthread_cond_timedwait - (cond => Self_ID.Common.LL.CV'Access, - mutex => (if Single_Lock - then Single_RTS_Lock'Access - else Self_ID.Common.LL.L'Access), - abstime => Request'Access); - - Check_Time := Monotonic_Clock; - exit when Abs_Time <= Check_Time or else Check_Time < Base_Time; - - pragma Assert (Result = 0 - or else Result = ETIMEDOUT - or else Result = EINTR); - end loop; - - Self_ID.Common.State := Runnable; - end if; - - Unlock (Self_ID); - - if Single_Lock then - Unlock_RTS; - end if; - - Yield; - end Timed_Delay; - - --------------------- - -- Monotonic_Clock -- - --------------------- - - function Monotonic_Clock return Duration is - TS : aliased timespec; - Result : Interfaces.C.int; - begin - Result := clock_gettime (OSC.CLOCK_RT_Ada, TS'Unchecked_Access); - pragma Assert (Result = 0); - return To_Duration (TS); - end Monotonic_Clock; - - ------------------- - -- RT_Resolution -- - ------------------- - - function RT_Resolution return Duration is - begin - -- The clock_getres (OSC.CLOCK_RT_Ada) function appears to return - -- the interrupt resolution of the realtime clock and not the actual - -- resolution of reading the clock. Even though this last value is - -- only guaranteed to be 100 Hz, at least the Origin 200 appears to - -- have a microsecond resolution or better. - - -- ??? We should figure out a method to return the right value on - -- all SGI hardware. - - return 0.000_001; - end RT_Resolution; - - ------------ - -- Wakeup -- - ------------ - - procedure Wakeup (T : ST.Task_Id; Reason : System.Tasking.Task_States) is - pragma Unreferenced (Reason); - Result : Interfaces.C.int; - begin - Result := pthread_cond_signal (T.Common.LL.CV'Access); - pragma Assert (Result = 0); - end Wakeup; - - ----------- - -- Yield -- - ----------- - - procedure Yield (Do_Yield : Boolean := True) is - Result : Interfaces.C.int; - pragma Unreferenced (Result); - begin - if Do_Yield then - Result := sched_yield; - end if; - end Yield; - - ------------------ - -- Set_Priority -- - ------------------ - - procedure Set_Priority - (T : Task_Id; - Prio : System.Any_Priority; - Loss_Of_Inheritance : Boolean := False) - is - pragma Unreferenced (Loss_Of_Inheritance); - - Result : Interfaces.C.int; - Param : aliased struct_sched_param; - Sched_Policy : Interfaces.C.int; - - use type System.Task_Info.Task_Info_Type; - - function To_Int is new Ada.Unchecked_Conversion - (System.Task_Info.Thread_Scheduling_Policy, Interfaces.C.int); - - function Get_Policy (Prio : System.Any_Priority) return Character; - pragma Import (C, Get_Policy, "__gnat_get_specific_dispatching"); - -- Get priority specific dispatching policy - - Priority_Specific_Policy : constant Character := Get_Policy (Prio); - -- Upper case first character of the policy name corresponding to the - -- task as set by a Priority_Specific_Dispatching pragma. - - begin - T.Common.Current_Priority := Prio; - Param.sched_priority := Interfaces.C.int (Prio); - - if T.Common.Task_Info /= null then - Sched_Policy := To_Int (T.Common.Task_Info.Policy); - - elsif Dispatching_Policy = 'R' - or else Priority_Specific_Policy = 'R' - or else Time_Slice_Val > 0 - then - Sched_Policy := SCHED_RR; - - else - Sched_Policy := SCHED_FIFO; - end if; - - Result := pthread_setschedparam (T.Common.LL.Thread, Sched_Policy, - Param'Access); - pragma Assert (Result = 0); - end Set_Priority; - - ------------------ - -- Get_Priority -- - ------------------ - - function Get_Priority (T : Task_Id) return System.Any_Priority is - begin - return T.Common.Current_Priority; - end Get_Priority; - - ---------------- - -- Enter_Task -- - ---------------- - - procedure Enter_Task (Self_ID : Task_Id) is - Result : Interfaces.C.int; - - function To_Int is new Ada.Unchecked_Conversion - (System.Task_Info.CPU_Number, Interfaces.C.int); - - use System.Task_Info; - - begin - Self_ID.Common.LL.Thread := pthread_self; - Specific.Set (Self_ID); - - if Self_ID.Common.Task_Info /= null - and then Self_ID.Common.Task_Info.Scope = PTHREAD_SCOPE_SYSTEM - and then Self_ID.Common.Task_Info.Runon_CPU /= ANY_CPU - then - Result := pthread_setrunon_np - (To_Int (Self_ID.Common.Task_Info.Runon_CPU)); - pragma Assert (Result = 0); - end if; - end Enter_Task; - - ------------------- - -- Is_Valid_Task -- - ------------------- - - function Is_Valid_Task return Boolean renames Specific.Is_Valid_Task; - - ----------------------------- - -- Register_Foreign_Thread -- - ----------------------------- - - function Register_Foreign_Thread return Task_Id is - begin - if Is_Valid_Task then - return Self; - else - return Register_Foreign_Thread (pthread_self); - end if; - end Register_Foreign_Thread; - - -------------------- - -- Initialize_TCB -- - -------------------- - - procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is - Result : Interfaces.C.int; - Cond_Attr : aliased pthread_condattr_t; - - begin - if not Single_Lock then - Initialize_Lock (Self_ID.Common.LL.L'Access, ATCB_Level); - end if; - - Result := pthread_condattr_init (Cond_Attr'Access); - pragma Assert (Result = 0 or else Result = ENOMEM); - - if Result = 0 then - Result := - pthread_cond_init (Self_ID.Common.LL.CV'Access, Cond_Attr'Access); - pragma Assert (Result = 0 or else Result = ENOMEM); - end if; - - if Result = 0 then - Succeeded := True; - else - if not Single_Lock then - Result := pthread_mutex_destroy (Self_ID.Common.LL.L'Access); - pragma Assert (Result = 0); - end if; - - Succeeded := False; - end if; - - Result := pthread_condattr_destroy (Cond_Attr'Access); - pragma Assert (Result = 0); - end Initialize_TCB; - - ----------------- - -- Create_Task -- - ----------------- - - procedure Create_Task - (T : Task_Id; - Wrapper : System.Address; - Stack_Size : System.Parameters.Size_Type; - Priority : System.Any_Priority; - Succeeded : out Boolean) - is - use System.Task_Info; - - Attributes : aliased pthread_attr_t; - Sched_Param : aliased struct_sched_param; - Result : Interfaces.C.int; - - function Thread_Body_Access is new - Ada.Unchecked_Conversion (System.Address, Thread_Body); - function To_Int is new Ada.Unchecked_Conversion - (System.Task_Info.Thread_Scheduling_Scope, Interfaces.C.int); - function To_Int is new Ada.Unchecked_Conversion - (System.Task_Info.Thread_Scheduling_Inheritance, Interfaces.C.int); - function To_Int is new Ada.Unchecked_Conversion - (System.Task_Info.Thread_Scheduling_Policy, Interfaces.C.int); - - begin - Result := pthread_attr_init (Attributes'Access); - pragma Assert (Result = 0 or else Result = ENOMEM); - - if Result /= 0 then - Succeeded := False; - return; - end if; - - Result := - pthread_attr_setdetachstate - (Attributes'Access, PTHREAD_CREATE_DETACHED); - pragma Assert (Result = 0); - - Result := - pthread_attr_setstacksize - (Attributes'Access, Interfaces.C.size_t (Stack_Size)); - pragma Assert (Result = 0); - - if T.Common.Task_Info /= null then - Result := - pthread_attr_setscope - (Attributes'Access, To_Int (T.Common.Task_Info.Scope)); - pragma Assert (Result = 0); - - Result := - pthread_attr_setinheritsched - (Attributes'Access, To_Int (T.Common.Task_Info.Inheritance)); - pragma Assert (Result = 0); - - Result := - pthread_attr_setschedpolicy - (Attributes'Access, To_Int (T.Common.Task_Info.Policy)); - pragma Assert (Result = 0); - - Sched_Param.sched_priority := - Interfaces.C.int (T.Common.Task_Info.Priority); - - Result := - pthread_attr_setschedparam - (Attributes'Access, Sched_Param'Access); - pragma Assert (Result = 0); - end if; - - -- Since the initial signal mask of a thread is inherited from the - -- creator, and the Environment task has all its signals masked, we - -- do not need to manipulate caller's signal mask at this point. - -- All tasks in RTS will have All_Tasks_Mask initially. - - -- Note: the use of Unrestricted_Access in the following call is needed - -- because otherwise we have an error of getting a access-to-volatile - -- value which points to a non-volatile object. But in this case it is - -- safe to do this, since we know we have no problems with aliasing and - -- Unrestricted_Access bypasses this check. - - Result := - pthread_create - (T.Common.LL.Thread'Unrestricted_Access, - Attributes'Access, - Thread_Body_Access (Wrapper), - To_Address (T)); - - if Result /= 0 - and then T.Common.Task_Info /= null - and then T.Common.Task_Info.Scope = PTHREAD_SCOPE_SYSTEM - then - -- The pthread_create call may have failed because we asked for a - -- system scope pthread and none were available (probably because - -- the program was not executed by the superuser). Let's try for - -- a process scope pthread instead of raising Tasking_Error. - - System.IO.Put_Line - ("Request for PTHREAD_SCOPE_SYSTEM in Task_Info pragma for task"); - System.IO.Put (""""); - System.IO.Put (T.Common.Task_Image (1 .. T.Common.Task_Image_Len)); - System.IO.Put_Line (""" could not be honored. "); - System.IO.Put_Line ("Scope changed to PTHREAD_SCOPE_PROCESS"); - - T.Common.Task_Info.Scope := PTHREAD_SCOPE_PROCESS; - Result := - pthread_attr_setscope - (Attributes'Access, To_Int (T.Common.Task_Info.Scope)); - pragma Assert (Result = 0); - - -- Note: the use of Unrestricted_Access in the following call - -- is needed because otherwise we have an error of getting a - -- access-to-volatile value which points to a non-volatile object. - -- But in this case it is safe to do this, since we know we have no - -- aliasing problems and Unrestricted_Access bypasses this check. - - Result := - pthread_create - (T.Common.LL.Thread'Unrestricted_Access, - Attributes'Access, - Thread_Body_Access (Wrapper), - To_Address (T)); - end if; - - pragma Assert (Result = 0 or else Result = EAGAIN); - - Succeeded := Result = 0; - - if Succeeded then - - -- The following needs significant commenting ??? - - if T.Common.Task_Info /= null then - T.Common.Base_Priority := T.Common.Task_Info.Priority; - Set_Priority (T, T.Common.Task_Info.Priority); - else - Set_Priority (T, Priority); - end if; - end if; - - Result := pthread_attr_destroy (Attributes'Access); - pragma Assert (Result = 0); - end Create_Task; - - ------------------ - -- Finalize_TCB -- - ------------------ - - procedure Finalize_TCB (T : Task_Id) is - Result : Interfaces.C.int; - - begin - if not Single_Lock then - Result := pthread_mutex_destroy (T.Common.LL.L'Access); - pragma Assert (Result = 0); - end if; - - Result := pthread_cond_destroy (T.Common.LL.CV'Access); - pragma Assert (Result = 0); - - if T.Known_Tasks_Index /= -1 then - Known_Tasks (T.Known_Tasks_Index) := null; - end if; - - ATCB_Allocation.Free_ATCB (T); - end Finalize_TCB; - - --------------- - -- Exit_Task -- - --------------- - - procedure Exit_Task is - begin - Specific.Set (null); - end Exit_Task; - - ---------------- - -- Abort_Task -- - ---------------- - - procedure Abort_Task (T : Task_Id) is - Result : Interfaces.C.int; - begin - if Abort_Handler_Installed then - Result := - pthread_kill - (T.Common.LL.Thread, - Signal (System.Interrupt_Management.Abort_Task_Interrupt)); - pragma Assert (Result = 0); - end if; - end Abort_Task; - - ---------------- - -- Initialize -- - ---------------- - - procedure Initialize (S : in out Suspension_Object) is - Mutex_Attr : aliased pthread_mutexattr_t; - Cond_Attr : aliased pthread_condattr_t; - Result : Interfaces.C.int; - - begin - -- Initialize internal state (always to False (RM D.10(6)) - - S.State := False; - S.Waiting := False; - - -- Initialize internal mutex - - Result := pthread_mutexattr_init (Mutex_Attr'Access); - pragma Assert (Result = 0 or else Result = ENOMEM); - - if Result = ENOMEM then - raise Storage_Error; - end if; - - Result := pthread_mutex_init (S.L'Access, Mutex_Attr'Access); - pragma Assert (Result = 0 or else Result = ENOMEM); - - if Result = ENOMEM then - Result := pthread_mutexattr_destroy (Mutex_Attr'Access); - pragma Assert (Result = 0); - - raise Storage_Error; - end if; - - Result := pthread_mutexattr_destroy (Mutex_Attr'Access); - pragma Assert (Result = 0); - - -- Initialize internal condition variable - - Result := pthread_condattr_init (Cond_Attr'Access); - pragma Assert (Result = 0 or else Result = ENOMEM); - - if Result /= 0 then - Result := pthread_mutex_destroy (S.L'Access); - pragma Assert (Result = 0); - - if Result = ENOMEM then - raise Storage_Error; - end if; - end if; - - Result := pthread_cond_init (S.CV'Access, Cond_Attr'Access); - pragma Assert (Result = 0 or else Result = ENOMEM); - - if Result /= 0 then - Result := pthread_mutex_destroy (S.L'Access); - pragma Assert (Result = 0); - - if Result = ENOMEM then - Result := pthread_condattr_destroy (Cond_Attr'Access); - pragma Assert (Result = 0); - raise Storage_Error; - end if; - end if; - - Result := pthread_condattr_destroy (Cond_Attr'Access); - pragma Assert (Result = 0); - end Initialize; - - -------------- - -- Finalize -- - -------------- - - procedure Finalize (S : in out Suspension_Object) is - Result : Interfaces.C.int; - - begin - -- Destroy internal mutex - - Result := pthread_mutex_destroy (S.L'Access); - pragma Assert (Result = 0); - - -- Destroy internal condition variable - - Result := pthread_cond_destroy (S.CV'Access); - pragma Assert (Result = 0); - end Finalize; - - ------------------- - -- Current_State -- - ------------------- - - function Current_State (S : Suspension_Object) return Boolean is - begin - -- We do not want to use lock on this read operation. State is marked - -- as Atomic so that we ensure that the value retrieved is correct. - - return S.State; - end Current_State; - - --------------- - -- Set_False -- - --------------- - - procedure Set_False (S : in out Suspension_Object) is - Result : Interfaces.C.int; - - begin - SSL.Abort_Defer.all; - - Result := pthread_mutex_lock (S.L'Access); - pragma Assert (Result = 0); - - S.State := False; - - Result := pthread_mutex_unlock (S.L'Access); - pragma Assert (Result = 0); - - SSL.Abort_Undefer.all; - end Set_False; - - -------------- - -- Set_True -- - -------------- - - procedure Set_True (S : in out Suspension_Object) is - Result : Interfaces.C.int; - - begin - SSL.Abort_Defer.all; - - Result := pthread_mutex_lock (S.L'Access); - pragma Assert (Result = 0); - - -- If there is already a task waiting on this suspension object then - -- we resume it, leaving the state of the suspension object to False, - -- as it is specified in ARM D.10 par. 9. Otherwise, it just leaves - -- the state to True. - - if S.Waiting then - S.Waiting := False; - S.State := False; - - Result := pthread_cond_signal (S.CV'Access); - pragma Assert (Result = 0); - - else - S.State := True; - end if; - - Result := pthread_mutex_unlock (S.L'Access); - pragma Assert (Result = 0); - - SSL.Abort_Undefer.all; - end Set_True; - - ------------------------ - -- Suspend_Until_True -- - ------------------------ - - procedure Suspend_Until_True (S : in out Suspension_Object) is - Result : Interfaces.C.int; - - begin - SSL.Abort_Defer.all; - - Result := pthread_mutex_lock (S.L'Access); - pragma Assert (Result = 0); - - if S.Waiting then - - -- Program_Error must be raised upon calling Suspend_Until_True - -- if another task is already waiting on that suspension object - -- (RM D.10(10)). - - Result := pthread_mutex_unlock (S.L'Access); - pragma Assert (Result = 0); - - SSL.Abort_Undefer.all; - - raise Program_Error; - else - -- Suspend the task if the state is False. Otherwise, the task - -- continues its execution, and the state of the suspension object - -- is set to False (ARM D.10 par. 9). - - if S.State then - S.State := False; - else - S.Waiting := True; - - loop - -- Loop in case pthread_cond_wait returns earlier than expected - -- (e.g. in case of EINTR caused by a signal). - - Result := pthread_cond_wait (S.CV'Access, S.L'Access); - pragma Assert (Result = 0 or else Result = EINTR); - - exit when not S.Waiting; - end loop; - end if; - - Result := pthread_mutex_unlock (S.L'Access); - pragma Assert (Result = 0); - - SSL.Abort_Undefer.all; - end if; - end Suspend_Until_True; - - ---------------- - -- Check_Exit -- - ---------------- - - -- Dummy version - - function Check_Exit (Self_ID : ST.Task_Id) return Boolean is - pragma Unreferenced (Self_ID); - begin - return True; - end Check_Exit; - - -------------------- - -- Check_No_Locks -- - -------------------- - - function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is - pragma Unreferenced (Self_ID); - begin - return True; - end Check_No_Locks; - - ---------------------- - -- Environment_Task -- - ---------------------- - - function Environment_Task return Task_Id is - begin - return Environment_Task_Id; - end Environment_Task; - - -------------- - -- Lock_RTS -- - -------------- - - procedure Lock_RTS is - begin - Write_Lock (Single_RTS_Lock'Access, Global_Lock => True); - end Lock_RTS; - - ---------------- - -- Unlock_RTS -- - ---------------- - - procedure Unlock_RTS is - begin - Unlock (Single_RTS_Lock'Access, Global_Lock => True); - end Unlock_RTS; - - ------------------ - -- Suspend_Task -- - ------------------ - - function Suspend_Task - (T : ST.Task_Id; - Thread_Self : Thread_Id) return Boolean - is - pragma Unreferenced (T); - pragma Unreferenced (Thread_Self); - begin - return False; - end Suspend_Task; - - ----------------- - -- Resume_Task -- - ----------------- - - function Resume_Task - (T : ST.Task_Id; - Thread_Self : Thread_Id) return Boolean - is - pragma Unreferenced (T); - pragma Unreferenced (Thread_Self); - begin - return False; - end Resume_Task; - - -------------------- - -- Stop_All_Tasks -- - -------------------- - - procedure Stop_All_Tasks is - begin - null; - end Stop_All_Tasks; - - --------------- - -- Stop_Task -- - --------------- - - function Stop_Task (T : ST.Task_Id) return Boolean is - pragma Unreferenced (T); - begin - return False; - end Stop_Task; - - ------------------- - -- Continue_Task -- - ------------------- - - function Continue_Task (T : ST.Task_Id) return Boolean is - pragma Unreferenced (T); - begin - return False; - end Continue_Task; - - ---------------- - -- Initialize -- - ---------------- - - procedure Initialize (Environment_Task : Task_Id) is - act : aliased struct_sigaction; - old_act : aliased struct_sigaction; - Tmp_Set : aliased sigset_t; - Result : Interfaces.C.int; - - function State - (Int : System.Interrupt_Management.Interrupt_ID) return Character; - pragma Import (C, State, "__gnat_get_interrupt_state"); - -- Get interrupt state. Defined in a-init.c. The input argument is - -- the interrupt number, and the result is one of the following: - - Default : constant Character := 's'; - -- '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 (use "default" - -- system handler) - - begin - Environment_Task_Id := Environment_Task; - - Interrupt_Management.Initialize; - - -- Initialize the lock used to synchronize chain of all ATCBs - - Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level); - - Specific.Initialize (Environment_Task); - - -- Make environment task known here because it doesn't go through - -- Activate_Tasks, which does it for all other tasks. - - Known_Tasks (Known_Tasks'First) := Environment_Task; - Environment_Task.Known_Tasks_Index := Known_Tasks'First; - - Enter_Task (Environment_Task); - - -- Prepare the set of signals that should unblocked in all tasks - - Result := sigemptyset (Unblocked_Signal_Mask'Access); - pragma Assert (Result = 0); - - for J in Interrupt_Management.Interrupt_ID loop - if System.Interrupt_Management.Keep_Unmasked (J) then - Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J)); - pragma Assert (Result = 0); - end if; - end loop; - - if State - (System.Interrupt_Management.Abort_Task_Interrupt) /= Default - then - act.sa_flags := 0; - act.sa_handler := Abort_Handler'Address; - - Result := sigemptyset (Tmp_Set'Access); - pragma Assert (Result = 0); - act.sa_mask := Tmp_Set; - - Result := - sigaction - (Signal (System.Interrupt_Management.Abort_Task_Interrupt), - act'Unchecked_Access, - old_act'Unchecked_Access); - pragma Assert (Result = 0); - Abort_Handler_Installed := True; - end if; - end Initialize; - - ----------------------- - -- Set_Task_Affinity -- - ----------------------- - - procedure Set_Task_Affinity (T : ST.Task_Id) is - pragma Unreferenced (T); - - begin - -- Setting task affinity is not supported by the underlying system - - null; - end Set_Task_Affinity; - -end System.Task_Primitives.Operations; diff --git a/gcc/ada/s-tasinf-irix.ads b/gcc/ada/s-tasinf-irix.ads deleted file mode 100644 index 6e9394f..0000000 --- a/gcc/ada/s-tasinf-irix.ads +++ /dev/null @@ -1,118 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- S Y S T E M . T A S K _ I N F O -- --- -- --- S p e c -- --- -- --- Copyright (C) 1992-2009 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT 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. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This package contains the definitions and routines associated with the --- implementation and use of the Task_Info pragma. It is specialized --- appropriately for targets that make use of this pragma. - --- Note: the compiler generates direct calls to this interface, via Rtsfind. --- Any changes to this interface may require corresponding compiler changes. - --- This unit may be used directly from an application program by providing --- an appropriate WITH, and the interface can be expected to remain stable. - --- This is the IRIX (kernel threads) version of this package - -with Interfaces.C; - -package System.Task_Info is - pragma Preelaborate; - pragma Elaborate_Body; - -- To ensure that a body is allowed - - ----------------------------------------- - -- Implementation of Task_Info Feature -- - ----------------------------------------- - - -- Pragma Task_Info allows an application to set the underlying - -- pthread scheduling attributes for a specific task. - - ------------------ - -- Declarations -- - ------------------ - - type Thread_Scheduling_Scope is - (PTHREAD_SCOPE_PROCESS, PTHREAD_SCOPE_SYSTEM); - - for Thread_Scheduling_Scope'Size use Interfaces.C.int'Size; - - type Thread_Scheduling_Inheritance is - (PTHREAD_EXPLICIT_SCHED, PTHREAD_INHERIT_SCHED); - - for Thread_Scheduling_Inheritance'Size use Interfaces.C.int'Size; - - type Thread_Scheduling_Policy is - (SCHED_FIFO, -- The first-in-first-out real-time policy - SCHED_RR, -- The round-robin real-time scheduling policy - SCHED_TS); -- The timeshare earnings based scheduling policy - - for Thread_Scheduling_Policy'Size use Interfaces.C.int'Size; - for Thread_Scheduling_Policy use - (SCHED_FIFO => 1, - SCHED_RR => 2, - SCHED_TS => 3); - - function SCHED_OTHER return Thread_Scheduling_Policy renames SCHED_TS; - - No_Specified_Priority : constant := -1; - - subtype Thread_Scheduling_Priority is Integer range - No_Specified_Priority .. 255; - - subtype FIFO_Priority is Thread_Scheduling_Priority range 0 .. 255; - - subtype RR_Priority is Thread_Scheduling_Priority range 0 .. 255; - - subtype TS_Priority is Thread_Scheduling_Priority range 1 .. 40; - - subtype OTHER_Priority is Thread_Scheduling_Priority range 1 .. 40; - - subtype CPU_Number is Integer range -1 .. Integer'Last; - ANY_CPU : constant CPU_Number := CPU_Number'First; - - type Thread_Attributes is record - Scope : Thread_Scheduling_Scope := PTHREAD_SCOPE_PROCESS; - Inheritance : Thread_Scheduling_Inheritance := PTHREAD_EXPLICIT_SCHED; - Policy : Thread_Scheduling_Policy := SCHED_RR; - Priority : Thread_Scheduling_Priority := No_Specified_Priority; - Runon_CPU : CPU_Number := ANY_CPU; - end record; - - Default_Thread_Attributes : constant Thread_Attributes := - (PTHREAD_SCOPE_PROCESS, PTHREAD_EXPLICIT_SCHED, SCHED_RR, - No_Specified_Priority, ANY_CPU); - - type Task_Info_Type is access all Thread_Attributes; - - Unspecified_Task_Info : constant Task_Info_Type := null; - -- Value passed to task in the absence of a Task_Info pragma - -end System.Task_Info; diff --git a/gcc/ada/sysdep.c b/gcc/ada/sysdep.c index 3fc51f8..61e934f 100644 --- a/gcc/ada/sysdep.c +++ b/gcc/ada/sysdep.c @@ -251,7 +251,7 @@ __gnat_ttyname (int filedes) } #endif -#if defined (linux) || defined (sun) || defined (sgi) \ +#if defined (linux) || defined (sun) \ || defined (WINNT) \ || defined (__MACHTEN__) || defined (__hpux__) || defined (_AIX) \ || (defined (__svr4__) && defined (i386)) || defined (__Lynx__) \ @@ -309,7 +309,7 @@ getc_immediate_common (FILE *stream, int *avail, int waiting) { -#if defined (linux) || defined (sun) || defined (sgi) \ +#if defined (linux) || defined (sun) \ || defined (__CYGWIN32__) || defined (__MACHTEN__) || defined (__hpux__) \ || defined (_AIX) || (defined (__svr4__) && defined (i386)) \ || defined (__Lynx__) || defined (__FreeBSD__) || defined (__OpenBSD__) \ @@ -329,7 +329,7 @@ getc_immediate_common (FILE *stream, /* Set RAW mode, with no echo */ termios_rec.c_lflag = termios_rec.c_lflag & ~ICANON & ~ECHO; -#if defined(linux) || defined (sun) || defined (sgi) \ +#if defined(linux) || defined (sun) \ || defined (__MACHTEN__) || defined (__hpux__) \ || defined (_AIX) || (defined (__svr4__) && defined (i386)) \ || defined (__Lynx__) || defined (__FreeBSD__) || defined (__OpenBSD__) \ @@ -780,8 +780,8 @@ __gnat_localtime_tzoff (const time_t *timer, const int *is_historic, long *off) { struct tm tp; -/* AIX, HPUX, SGI Irix, Sun Solaris */ -#if defined (_AIX) || defined (__hpux__) || defined (sgi) || defined (sun) +/* AIX, HPUX, Sun Solaris */ +#if defined (_AIX) || defined (__hpux__) || defined (sun) { (*Lock_Task) (); diff --git a/gcc/ada/system-irix-n32.ads b/gcc/ada/system-irix-n32.ads deleted file mode 100644 index 3dd0810..0000000 --- a/gcc/ada/system-irix-n32.ads +++ /dev/null @@ -1,158 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUN-TIME COMPONENTS -- --- -- --- S Y S T E M -- --- -- --- S p e c -- --- (SGI Irix, n32 ABI) -- --- -- --- Copyright (C) 1992-2011, 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 -- --- apply solely to the contents of the part following the private keyword. -- --- -- --- 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT 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. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -package System is - pragma Pure; - -- Note that we take advantage of the implementation permission to make - -- this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada - -- 2005, this is Pure in any case (AI-362). - - type Name is (SYSTEM_NAME_GNAT); - System_Name : constant Name := SYSTEM_NAME_GNAT; - - -- System-Dependent Named Numbers - - Min_Int : constant := Long_Long_Integer'First; - Max_Int : constant := Long_Long_Integer'Last; - - Max_Binary_Modulus : constant := 2 ** Long_Long_Integer'Size; - Max_Nonbinary_Modulus : constant := 2 ** Integer'Size - 1; - - Max_Base_Digits : constant := Long_Long_Float'Digits; - Max_Digits : constant := Long_Long_Float'Digits; - - Max_Mantissa : constant := 63; - Fine_Delta : constant := 2.0 ** (-Max_Mantissa); - - Tick : constant := 0.01; - - -- Storage-related Declarations - - type Address is private; - pragma Preelaborable_Initialization (Address); - Null_Address : constant Address; - - Storage_Unit : constant := 8; - Word_Size : constant := 64; - Memory_Size : constant := 2 ** 32; - - -- Address comparison - - function "<" (Left, Right : Address) return Boolean; - function "<=" (Left, Right : Address) return Boolean; - function ">" (Left, Right : Address) return Boolean; - function ">=" (Left, Right : Address) return Boolean; - function "=" (Left, Right : Address) return Boolean; - - pragma Import (Intrinsic, "<"); - pragma Import (Intrinsic, "<="); - pragma Import (Intrinsic, ">"); - pragma Import (Intrinsic, ">="); - pragma Import (Intrinsic, "="); - - -- Other System-Dependent Declarations - - type Bit_Order is (High_Order_First, Low_Order_First); - Default_Bit_Order : constant Bit_Order := High_Order_First; - pragma Warnings (Off, Default_Bit_Order); -- kill constant condition warning - - -- Priority-related Declarations (RM D.1) - - -- IRIX priorities as defined by realtime(5): - -- - -- 255 is for system-level interrupts - -- 240 - 254 are suggested for hard real-time threads - -- 200 - 239 are used by system device driver interrupt threads - -- 110 - 199 are suggested for interactive real-time applications - -- 90 - 109 are used by system daemon threads - -- 0 - 89 are suggested for soft real-time applications - -- - -- We don't express the full range of IRIX priorities. For now, we - -- handle only the subset for soft real-time applications. - - Max_Priority : constant Positive := 88; - Max_Interrupt_Priority : constant Positive := 89; - - subtype Any_Priority is Integer range 0 .. 89; - subtype Priority is Any_Priority range 0 .. 88; - subtype Interrupt_Priority is Any_Priority range 89 .. 89; - - Default_Priority : constant Priority := 44; - -private - - type Address is mod Memory_Size; - Null_Address : constant Address := 0; - - -------------------------------------- - -- System Implementation Parameters -- - -------------------------------------- - - -- These parameters provide information about the target that is used - -- by the compiler. They are in the private part of System, where they - -- can be accessed using the special circuitry in the Targparm unit - -- whose source should be consulted for more detailed descriptions - -- of the individual switch values. - - Backend_Divide_Checks : constant Boolean := False; - Backend_Overflow_Checks : constant Boolean := True; - Command_Line_Args : constant Boolean := True; - Configurable_Run_Time : constant Boolean := False; - Denorm : constant Boolean := False; - Duration_32_Bits : constant Boolean := False; - Exit_Status_Supported : constant Boolean := True; - Fractional_Fixed_Ops : constant Boolean := False; - Frontend_Layout : constant Boolean := False; - Machine_Overflows : constant Boolean := False; - Machine_Rounds : constant Boolean := True; - Preallocated_Stacks : constant Boolean := False; - Signed_Zeros : constant Boolean := True; - Stack_Check_Default : constant Boolean := False; - Stack_Check_Probes : constant Boolean := True; - Stack_Check_Limits : constant Boolean := False; - Support_Aggregates : constant Boolean := True; - Support_Composite_Assign : constant Boolean := True; - Support_Composite_Compare : constant Boolean := True; - Support_Long_Shifts : constant Boolean := True; - Always_Compatible_Rep : constant Boolean := True; - Suppress_Standard_Library : constant Boolean := False; - Use_Ada_Main_Program_Name : constant Boolean := False; - ZCX_By_Default : constant Boolean := True; - - -- Note: Denorm is False because denormals are not supported on the - -- R10000, and we want the code to be valid for this processor. - -end System; diff --git a/gcc/ada/system-irix-n64.ads b/gcc/ada/system-irix-n64.ads deleted file mode 100644 index 916fa4d..0000000 --- a/gcc/ada/system-irix-n64.ads +++ /dev/null @@ -1,159 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUN-TIME COMPONENTS -- --- -- --- S Y S T E M -- --- -- --- S p e c -- --- (SGI Irix, n64 ABI) -- --- -- --- Copyright (C) 1992-2011, 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 -- --- apply solely to the contents of the part following the private keyword. -- --- -- --- 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT 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. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -package System is - pragma Pure; - -- Note that we take advantage of the implementation permission to make - -- this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada - -- 2005, this is Pure in any case (AI-362). - - type Name is (SYSTEM_NAME_GNAT); - System_Name : constant Name := SYSTEM_NAME_GNAT; - - -- System-Dependent Named Numbers - - Min_Int : constant := Long_Long_Integer'First; - Max_Int : constant := Long_Long_Integer'Last; - - Max_Binary_Modulus : constant := 2 ** Long_Long_Integer'Size; - Max_Nonbinary_Modulus : constant := 2 ** Integer'Size - 1; - - Max_Base_Digits : constant := Long_Long_Float'Digits; - Max_Digits : constant := Long_Long_Float'Digits; - - Max_Mantissa : constant := 63; - Fine_Delta : constant := 2.0 ** (-Max_Mantissa); - - Tick : constant := 0.01; - - -- Storage-related Declarations - - type Address is private; - pragma Preelaborable_Initialization (Address); - Null_Address : constant Address; - - Storage_Unit : constant := 8; - Word_Size : constant := 64; - Memory_Size : constant := 2 ** 64; - - -- Address comparison - - function "<" (Left, Right : Address) return Boolean; - function "<=" (Left, Right : Address) return Boolean; - function ">" (Left, Right : Address) return Boolean; - function ">=" (Left, Right : Address) return Boolean; - function "=" (Left, Right : Address) return Boolean; - - pragma Import (Intrinsic, "<"); - pragma Import (Intrinsic, "<="); - pragma Import (Intrinsic, ">"); - pragma Import (Intrinsic, ">="); - pragma Import (Intrinsic, "="); - - -- Other System-Dependent Declarations - - type Bit_Order is (High_Order_First, Low_Order_First); - Default_Bit_Order : constant Bit_Order := High_Order_First; - pragma Warnings (Off, Default_Bit_Order); -- kill constant condition warning - - -- Priority-related Declarations (RM D.1) - - -- IRIX priorities as defined by realtime(5): - -- - -- 255 is for system-level interrupts - -- 240 - 254 are suggested for hard real-time threads - -- 200 - 239 are used by system device driver interrupt threads - -- 110 - 199 are suggested for interactive real-time applications - -- 90 - 109 are used by system daemon threads - -- 0 - 89 are suggested for soft real-time applications - -- - -- We don't express the full range of IRIX priorities. For now, we - -- handle only the subset for soft real-time applications. - - Max_Priority : constant Positive := 88; - Max_Interrupt_Priority : constant Positive := 89; - - subtype Any_Priority is Integer range 0 .. 89; - subtype Priority is Any_Priority range 0 .. 88; - subtype Interrupt_Priority is Any_Priority range 89 .. 89; - - Default_Priority : constant Priority := 44; - -private - - type Address is mod Memory_Size; - Null_Address : constant Address := 0; - - -------------------------------------- - -- System Implementation Parameters -- - -------------------------------------- - - -- These parameters provide information about the target that is used - -- by the compiler. They are in the private part of System, where they - -- can be accessed using the special circuitry in the Targparm unit - -- whose source should be consulted for more detailed descriptions - -- of the individual switch values. - - Backend_Divide_Checks : constant Boolean := False; - Backend_Overflow_Checks : constant Boolean := False; - Command_Line_Args : constant Boolean := True; - Configurable_Run_Time : constant Boolean := False; - Denorm : constant Boolean := False; - Duration_32_Bits : constant Boolean := False; - Exit_Status_Supported : constant Boolean := True; - Fractional_Fixed_Ops : constant Boolean := False; - Frontend_Layout : constant Boolean := False; - Machine_Overflows : constant Boolean := False; - Machine_Rounds : constant Boolean := True; - Preallocated_Stacks : constant Boolean := False; - Signed_Zeros : constant Boolean := True; - Stack_Check_Default : 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; - Support_Composite_Assign : constant Boolean := True; - Support_Composite_Compare : constant Boolean := True; - Support_Long_Shifts : constant Boolean := True; - Always_Compatible_Rep : constant Boolean := True; - Suppress_Standard_Library : constant Boolean := False; - Use_Ada_Main_Program_Name : constant Boolean := False; - ZCX_By_Default : constant Boolean := True; - - -- Note: Denorm is False because denormals are not supported on the - -- R10000, and we want the code to be valid for this processor. - -end System; diff --git a/gcc/ada/system-irix-o32.ads b/gcc/ada/system-irix-o32.ads deleted file mode 100644 index 91d0afd..0000000 --- a/gcc/ada/system-irix-o32.ads +++ /dev/null @@ -1,146 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUN-TIME COMPONENTS -- --- -- --- S Y S T E M -- --- -- --- S p e c -- --- (SGI Irix, o32 ABI) -- --- -- --- Copyright (C) 1992-2011, 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 -- --- apply solely to the contents of the part following the private keyword. -- --- -- --- 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT 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. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -package System is - pragma Pure; - -- Note that we take advantage of the implementation permission to make - -- this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada - -- 2005, this is Pure in any case (AI-362). - - type Name is (SYSTEM_NAME_GNAT); - System_Name : constant Name := SYSTEM_NAME_GNAT; - - -- System-Dependent Named Numbers - - Min_Int : constant := Long_Long_Integer'First; - Max_Int : constant := Long_Long_Integer'Last; - - Max_Binary_Modulus : constant := 2 ** Long_Long_Integer'Size; - Max_Nonbinary_Modulus : constant := 2 ** Integer'Size - 1; - - Max_Base_Digits : constant := Long_Long_Float'Digits; - Max_Digits : constant := Long_Long_Float'Digits; - - Max_Mantissa : constant := 63; - Fine_Delta : constant := 2.0 ** (-Max_Mantissa); - - Tick : constant := 0.01; - - -- Storage-related Declarations - - type Address is private; - pragma Preelaborable_Initialization (Address); - Null_Address : constant Address; - - Storage_Unit : constant := 8; - Word_Size : constant := 32; - Memory_Size : constant := 2 ** 32; - - -- Address comparison - - function "<" (Left, Right : Address) return Boolean; - function "<=" (Left, Right : Address) return Boolean; - function ">" (Left, Right : Address) return Boolean; - function ">=" (Left, Right : Address) return Boolean; - function "=" (Left, Right : Address) return Boolean; - - pragma Import (Intrinsic, "<"); - pragma Import (Intrinsic, "<="); - pragma Import (Intrinsic, ">"); - pragma Import (Intrinsic, ">="); - pragma Import (Intrinsic, "="); - - -- Other System-Dependent Declarations - - type Bit_Order is (High_Order_First, Low_Order_First); - Default_Bit_Order : constant Bit_Order := High_Order_First; - pragma Warnings (Off, Default_Bit_Order); -- kill constant condition warning - - -- Priority-related Declarations (RM D.1) - - Max_Priority : constant Positive := 30; - Max_Interrupt_Priority : constant Positive := 31; - - subtype Any_Priority is Integer range 0 .. 31; - subtype Priority is Any_Priority range 0 .. 30; - subtype Interrupt_Priority is Any_Priority range 31 .. 31; - - Default_Priority : constant Priority := 15; - -private - - type Address is mod Memory_Size; - Null_Address : constant Address := 0; - - -------------------------------------- - -- System Implementation Parameters -- - -------------------------------------- - - -- These parameters provide information about the target that is used - -- by the compiler. They are in the private part of System, where they - -- can be accessed using the special circuitry in the Targparm unit - -- whose source should be consulted for more detailed descriptions - -- of the individual switch values. - - Backend_Divide_Checks : constant Boolean := False; - Backend_Overflow_Checks : constant Boolean := True; - Command_Line_Args : constant Boolean := True; - Configurable_Run_Time : constant Boolean := False; - Denorm : constant Boolean := False; - Duration_32_Bits : constant Boolean := False; - Exit_Status_Supported : constant Boolean := True; - Fractional_Fixed_Ops : constant Boolean := False; - Frontend_Layout : constant Boolean := False; - Machine_Overflows : constant Boolean := False; - Machine_Rounds : constant Boolean := True; - Preallocated_Stacks : constant Boolean := False; - Signed_Zeros : constant Boolean := True; - Stack_Check_Default : constant Boolean := False; - Stack_Check_Probes : constant Boolean := True; - Stack_Check_Limits : constant Boolean := False; - Support_Aggregates : constant Boolean := True; - Support_Composite_Assign : constant Boolean := True; - Support_Composite_Compare : constant Boolean := True; - Support_Long_Shifts : constant Boolean := True; - Always_Compatible_Rep : constant Boolean := True; - Suppress_Standard_Library : constant Boolean := False; - Use_Ada_Main_Program_Name : constant Boolean := False; - ZCX_By_Default : constant Boolean := True; - - -- Note: Denorm is False because denormals are not supported on the - -- R10000, and we want the code to be valid for this processor. - -end System; diff --git a/gcc/ada/terminals.c b/gcc/ada/terminals.c index cb1414a..ca672c4 100644 --- a/gcc/ada/terminals.c +++ b/gcc/ada/terminals.c @@ -976,9 +976,6 @@ __gnat_setup_winsize (void *desc, int rows, int columns) || defined (__DragonFly__) # define FREEBSD #endif -#if defined (__mips) && defined (__sgi) -# define IRIX -#endif /* Include every system header we need */ #define _GNU_SOURCE @@ -1025,7 +1022,6 @@ __gnat_setup_winsize (void *desc, int rows, int columns) 1- using a cloning device (USE_CLONE_DEVICE) 2- getpt (USE_GETPT) 3- openpty (USE_OPENPTY) - 4- _getpty (USE_GETPTY) When using the cloning device method, the macro USE_CLONE_DEVICE should contains a full path to the adequate device. @@ -1037,8 +1033,6 @@ __gnat_setup_winsize (void *desc, int rows, int columns) /* Configurable part */ #if defined (__APPLE__) || defined (FREEBSD) #define USE_OPENPTY -#elif defined (IRIX) -#define USE_GETPTY #elif defined (linux) #define USE_GETPT #elif defined (sun) @@ -1093,9 +1087,6 @@ allocate_pty_desc (pty_desc **desc) { master_fd = getpt (); #elif defined (USE_OPENPTY) status = openpty (&master_fd, &slave_fd, NULL, NULL, NULL); -#elif defined (USE_GETPTY) - slave_name = _getpty (&master_fd, O_RDWR | O_NDELAY, 0600, 0); - if (slave_name == NULL) status = -1; #elif defined (USE_CLONE_DEVICE) master_fd = open (USE_CLONE_DEVICE, O_RDWR | O_NONBLOCK, 0); #else |