diff options
| author | shannonjr <shannonjr@pkgsrc.org> | 2004-06-01 18:32:03 +0000 |
|---|---|---|
| committer | shannonjr <shannonjr@pkgsrc.org> | 2004-06-01 18:32:03 +0000 |
| commit | a6dbbc98f5d9149b901c1275e54a3f57861dde56 (patch) | |
| tree | 04a45ea327af87f98d1d529f02617587010617fb /lang | |
| parent | 2f2969cfbd58a21375a0abc29279db34d73124e5 (diff) | |
| download | pkgsrc-a6dbbc98f5d9149b901c1275e54a3f57861dde56.tar.gz | |
gccAda-3.4.0 This is the gcc 3.4 Ada compiler
This package conflicts with no other package.
Diffstat (limited to 'lang')
32 files changed, 4486 insertions, 0 deletions
diff --git a/lang/gccAda-3.4/DESCR b/lang/gccAda-3.4/DESCR new file mode 100644 index 00000000000..f91e31bc4b7 --- /dev/null +++ b/lang/gccAda-3.4/DESCR @@ -0,0 +1,5 @@ +This is the Ada compiler from the gcc 3.4 compiler suite. + +This package has a test target. For testing (only), this +package requires dejagnu. As part of the tests, acats +(the Ada compiler validation suite) is run. diff --git a/lang/gccAda-3.4/MESSAGE b/lang/gccAda-3.4/MESSAGE new file mode 100644 index 00000000000..ec890592ab9 --- /dev/null +++ b/lang/gccAda-3.4/MESSAGE @@ -0,0 +1,10 @@ +=========================================================================== +$NetBSD: MESSAGE,v 1.1.1.1 2004/06/01 18:32:03 shannonjr Exp $ + +A wrapper, "ada", has been placed in ${LOCALBASE}/bin to setup the +environment and call the tools in this package. So, to make a program +with a main program file "main.adb" you would type: + + ada gnatmake main.adb + +=========================================================================== diff --git a/lang/gccAda-3.4/Makefile b/lang/gccAda-3.4/Makefile new file mode 100644 index 00000000000..d545f631198 --- /dev/null +++ b/lang/gccAda-3.4/Makefile @@ -0,0 +1,144 @@ +# $NetBSD: Makefile,v 1.1.1.1 2004/06/01 18:32:03 shannonjr Exp $ +# + +DISTNAME= gccAda${GCC34_PKGMODIF}-${GCC_VERSION} +CATEGORIES= lang +MASTER_SITES= ${MASTER_SITE_GNU:=gcc/gcc-${GCC_VERSION}/} +DISTFILES= gcc-${GCC_VERSION}.tar.bz2 + +MAINTAINER= shannonjr@NetBSD.org +HOMEPAGE= http://www.gnu.org/software/gcc/gcc.html +COMMENT= This is the gcc 3.4 Ada compiler + +BUILD_USES_MSGFMT= YES + +GCC_VERSION= 3.4.0 + +USE_BUILDLINK3= YES +USE_PKGINSTALL= YES +USE_GNU_TOOLS+= make +HAS_CONFIGURE= YES +CONFIGURE_ARGS+= --enable-languages="c,ada" +WRKSRC= ${WRKDIR}/gcc-${GCC_VERSION} +PLIST_SRC= ${WRKDIR}/PLIST_DYNAMIC + +.include "../../mk/bsd.prefs.mk" + +# Ada bootstrap compiler section +# An Ada compiler is required to build the Ada compiler. Two +may be used: +#USE_GCC3 =# Define to use lang/gcc3-ada +#USE_GCC34 =# Define to use gcc-3.4 +# You may also specify the path of a gcc/gnat Ada compiler +# outside of the pkgsrc system by specifying the full path +# of the compiler (example) below: +#ALT_GCC= prefix/bin/gcc +.if defined(ALT_GCC) +. if exists(${ALT_GCC}) +ALT_GCC_PREFIX:= ${ALT_GCC:H}/.. +ALT_GCC_RTS!= ${FIND} ${ALT_GCC_PREFIX} -name adalib +RALT_GCC_RTS= ${ALT_GCC_RTS:S%${LOCALBASE}%%:S%/%%} +. else +PKG_SKIP_REASON= "Missing bootstrap Ada compiler" +. endif +.endif +.if !defined(USE_GCC3) && !defined(USE_GCC34) && !defined(ALT_GCC) +PKG_SKIP_REASON= "An Ada bootstrap compiler must be specified" +.endif + +# Make location overridable, to allow ping-pong bootstraps. +GCC34_DEFAULT_SUBPREFIX= ${PKGNAME_NOREV} +GCC34_INSTALLTO_SUBPREFIX?= ${GCC34_DEFAULT_SUBPREFIX} +.if ${GCC34_INSTALLTO_SUBPREFIX} != ${GCC34_DEFAULT_SUBPREFIX} +GCC34_PKGMODIF= ${GCC34_INSTALLTO_SUBPREFIX} +.endif + +GCC_SUBPREFIX= ${GCC34_INSTALLTO_SUBPREFIX} +GCC_PREFIX= ${PREFIX}/${GCC_SUBPREFIX} +PLIST_SUBST+= GCC_SUBPREFIX=${GCC_SUBPREFIX} +FILES_SUBST+= GCC_PREFIX=${GCC_PREFIX} +FILES_SUBST+= PKGNAME=${PKGNAME} +MESSAGE_SUBST+= GCC_PREFIX=${GCC_PREFIX} +CONFIGURE_ARGS+= --prefix=${GCC_PREFIX} +GCC_PLATFORM= ${MACHINE_GNU_ARCH}--netbsdelf2.0 +PTHREAD_OPTS+= require native +CPPFLAGS+= -I${BUILDLINK_DIR}/include +CFLAGS+= -I${BUILDLINK_DIR}/include +CONFIGURE_ARGS+= --host=${GCC_PLATFORM} +CONFIGURE_ARGS+= --enable-threads=gnat +GCC_DIR= ${WRKDIR}/.gcc + +post-patch: + (cd files; \ + ${CP} adasignal.c ${WRKSRC}/gcc/ada; \ + ${CP} ada_lwp_self.c ${WRKSRC}/gcc/ada; \ + ${CP} dummy_pthreads.c ${WRKSRC}/gcc/ada; \ + for i in *.adb *.ads ; do \ + ${CP} $$i ${WRKSRC}/gcc/ada; \ + done ) + +.if defined(USE_GCC34) +pre-configure: +.include "../../lang/gcc-3.4/preconfigure.mk" +.elif defined(ALT_GCC) +pre-configure: + (cd ${WRKDIR}/.buildlink && ${MKDIR} ${RALT_GCC_RTS} && \ + cd ${RALT_GCC_RTS} && ${LN} -s ${ALT_GCC_RTS}/libgnat.a .) + (cd ${ALT_GCC:H} && \ + files=`${FIND} . -type f \( -perm -0100 \)` && \ + cd ${GCC_DIR}/bin/ && \ + for file in ${ALT_GCC:T} $${files} ; do \ + $(ECHO) '#!/bin/sh' > $${file}; \ + $(ECHO) -n "exec ${ALT_GCC:H}/$${file} " >>$${file}; \ + $(ECHO) '"$$@"' >>$${file}; \ + $(CHMOD) +x $${file}; \ + done ) +.endif + +do-configure: + ((${TEST} -d ${WRKDIR}/obj || ${MKDIR} ${WRKDIR}/obj) && \ + (cd ${WRKDIR}/obj && ${SETENV} ${CONFIGURE_ENV} ${WRKSRC}/configure ${CONFIGURE_ARGS})) + +do-build: + (cd ${WRKDIR}/obj && ${SETENV} ${MAKE_ENV} ${GMAKE} bootstrap) + (cd ${WRKDIR}/obj/gcc && ${SETENV} ${MAKE_ENV} ${GMAKE} gnatlib_and_tools) + +do-test: +.if (${MACHINE_GNU_ARCH} == "x86_64") + (cd files && ${CP} netbsd64macro.dfs ${WRKSRC}/gcc/testsuite/ada/acats/support/macro.dfs) +.endif + (cd ${WRKDIR}/obj/gcc && ${GMAKE} check-ada) + +do-install: + (cd ${WRKDIR}/obj && ${SETENV} ${MAKE_ENV} ${GMAKE} ${INSTALL} \ + && ${TEST} -f ${GCC_PREFIX}/bin/cc || ${LN} -f ${GCC_PREFIX}/bin/gcc ${GCC_PREFIX}/bin/cc) + (SPECPATH=`${GCC_PREFIX}/bin/gcc -print-file-name=specs` && \ + for EXPANDEDSPECPATH in $${SPECPATH} ; do \ + SPECDIR=`${DIRNAME} $${EXPANDEDSPECPATH}`; \ + ${ECHO} $${SPECDIR}/adainclude > $${SPECDIR}/ada_source_path; \ + ${ECHO} $${SPECDIR}/adalib > $${SPECDIR}/ada_object_path; \ + done ) + +post-install: + @${SED} ${FILES_SUBST_SED} ${FILESDIR}/ada > ${WRKDIR}/ada + ${ECHO} '"$$@"' >> ${WRKDIR}/ada + ${INSTALL_DATA} ${WRKDIR}/ada ${LOCALBASE}/bin/ada + ${CHMOD} +x ${WRKDIR}/ada ${LOCALBASE}/bin/ada + ${CP} -f ${PKGDIR}/PLIST ${PLIST_SRC} + ${FIND} ${GCC_PREFIX} \( -type f -o -type l \) -print \ + | ${SORT} | ${SED} -e "s,${PREFIX}/,,g" \ + >> ${PLIST_SRC} + ${FIND} ${GCC_PREFIX} -type d -print \ + | ${SORT} -r | ${SED} -e "s,${PREFIX}/,@dirrm ,g" \ + >> ${PLIST_SRC} + +.if defined(USE_GCC3) +.include "../../lang/gcc3-ada/buildlink3.mk" +.elif defined(USE_GCC34) +BUILDLINK_DEPMETHOD.gcc-3.4= build +.include "../../lang/gcc-3.4/buildlink3.mk" +.endif +.include "../../converters/libiconv/buildlink3.mk" +.include "../../devel/gettext-lib/buildlink3.mk" +.include "../../mk/pthread.buildlink3.mk" +.include "../../mk/bsd.pkg.mk" diff --git a/lang/gccAda-3.4/PLIST b/lang/gccAda-3.4/PLIST new file mode 100644 index 00000000000..4f712d2cefc --- /dev/null +++ b/lang/gccAda-3.4/PLIST @@ -0,0 +1,2 @@ +@comment $NetBSD: PLIST,v 1.1.1.1 2004/06/01 18:32:03 shannonjr Exp $ +bin/ada diff --git a/lang/gccAda-3.4/README b/lang/gccAda-3.4/README new file mode 100644 index 00000000000..b7d2b9d33b3 --- /dev/null +++ b/lang/gccAda-3.4/README @@ -0,0 +1,22 @@ +The Ada compiler front-end of gcc is itself written +in Ada. Consequently, an Ada compiler must be used +to build this pkg. In pkgsrc, lang/gcc3-ada is version +3.3 of the gcc Ada compiler; it also requires an Ada +compiler to build. This pkg may also be built using +lang/gcc-3.4.0 (which contains Ada). + +You can download a pre-built version this package +(suitable for bootstrapping lang/gcc-3.4.0) from: + +http://www.johnrshannon.com/NetBSD/ix86/gccAda-3.4.0.tgz +http://www.johnrshannon.com/NetBSD/pentium4/gccAda-3.4.0.tgz +http://www.johnrshannon.com/NetBSD/x86_64/gccAda-3.4.0.tgz + +The first two pkgs were built on NetBSD 2.0-BETA. The AMD64 +pkg was built under NetBSD 1.6ZL. + +Full Ada language support is provided for: + Intel Ix86 on NetBSD with native pthread support + AMD 64 on NetBSD with native pthread support + +See comments in Makefile on selecting a bootstrap compiler. diff --git a/lang/gccAda-3.4/buildlink3.mk b/lang/gccAda-3.4/buildlink3.mk new file mode 100644 index 00000000000..7af4e313c04 --- /dev/null +++ b/lang/gccAda-3.4/buildlink3.mk @@ -0,0 +1,41 @@ +# $NetBSD: buildlink3.mk,v 1.1.1.1 2004/06/01 18:32:03 shannonjr Exp $ + +BUILDLINK_DEPTH:= ${BUILDLINK_DEPTH}+ +GCCADA_BUILDLINK3_MK:= ${GCCADA_BUILDLINK3_MK}+ +BUILDLINK_PREFIX.gccAda-3.4.0:=${LOCALBASE}/gccAda-3.4.0 + +.if !empty(BUILDLINK_DEPTH:M+) +BUILDLINK_DEPENDS+= gccAda-3.4.0 +.endif + +BUILDLINK_PACKAGES:= ${BUILDLINK_PACKAGES:NgccAda-3.4.0} +BUILDLINK_PACKAGES+= gccAda-3.4.0 + +.if !empty(GCCADA_BUILDLINK3_MK:M+) +BUILDLINK_DEPENDS.gccAda-3.4.0+= gccAda>=3.4.0 +BUILDLINK_PKGSRCDIR.gccAda-3.4.0?= ../../lang/gccAda-3.4 +BUILDLINK_ENV+= ADAC=${LOCALBASE}/gccAda-3.4.0/bin/gcc +_GCC_ARCHDIR!= ${DIRNAME} `${LOCALBASE}/gccAda-3.4.0/bin/gcc --print-libgcc-file-name` +. if empty(_GCC_ARCHDIR:M*not_found*) +BUILDLINK_LIBDIRS.gccAda-3.4.0+= lib ${_GCC_ARCHDIR:S/^${BUILDLINK_PREFIX.gccAda-3.4.0}\///} +BUILDLINK_LIBDIRS.gccAda-3.4.0+= ${_GCC_ARCHDIR:S/^${BUILDLINK_PREFIX.gccAda-3.4.0}\///}/adalib +BUILDLINK_INCDIRS.gccAda-3.4.0+= include ${_GCC_ARCHDIR:S/^${BUILDLINK_PREFIX.gccAda-3.4.0}\///}/adainclude +. endif +.endif # GCCADA_BUILDLINK3_MK + +BUILDLINK_PKGSRCDIR.gccAda-3.4.0?= ../../lang/gccAda-3.4.0 +BUILDLINK_FILES_CMD.gccAda-3.4.0= (cd ${BUILDLINK_PREFIX.gccAda-3.4.0} && \ + ${FIND} bin libexec lib \( -type file -o -type link \) -print) +BUILDLINK_TRANSFORM.gccAda-3.4.0= -e s:\buildlink:buildlink/gccAda-3.4.0: + +# Packages that link against shared libraries need a full dependency. +. if defined(USE_GCC_SHLIB) +BUILDLINK_DEPMETHOD.gccAda-3.4.0?= full +. else +BUILDLINK_DEPMETHOD.gccAda-3.4.0?= build +. endif + +.include "../../mk/pthread.buildlink3.mk" +.include "../../converters/libiconv/buildlink3.mk" + +BUILDLINK_DEPTH:= ${BUILDLINK_DEPTH:S/+$//} diff --git a/lang/gccAda-3.4/distinfo b/lang/gccAda-3.4/distinfo new file mode 100644 index 00000000000..cb18a24b6b1 --- /dev/null +++ b/lang/gccAda-3.4/distinfo @@ -0,0 +1,11 @@ +$NetBSD: distinfo,v 1.1.1.1 2004/06/01 18:32:03 shannonjr Exp $ + +SHA1 (gcc-3.4.0.tar.bz2) = 8e4630a95ecc71533969d8415dbe063ca33572ee +Size (gcc-3.4.0.tar.bz2) = 27258902 bytes +SHA1 (patch-ae) = 36931541dea6ffa431142f801e0675122454ebff +SHA1 (patch-af) = cdd6b0d13c557996cb6582d7fa5dc651d37ee0ee +SHA1 (patch-ag) = beee5294d387faafa640ab048823499da629e715 +SHA1 (patch-ba) = 6fc03fc155f630329f7dc831eece6b6464b453a6 +SHA1 (patch-bb) = aa088194fb073fcde8d2f558ed55ec36106d60d0 +SHA1 (patch-function_c) = 64398f40f62ad4c8b9c8f861b802403a4f5aa3be +SHA1 (patch-varasm) = 3dfe9a56ebd464d573104511e63dc3599ab5c834 diff --git a/lang/gccAda-3.4/files/4netbsdintnam.ads b/lang/gccAda-3.4/files/4netbsdintnam.ads new file mode 100644 index 00000000000..265f9ae3dce --- /dev/null +++ b/lang/gccAda-3.4/files/4netbsdintnam.ads @@ -0,0 +1,117 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA 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-2002 Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This is a NetBSD version of this package. +-- +with System.OS_Interface; +-- used for names of interrupts + +package Ada.Interrupts.Names is + + -- 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 a 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.sigchld; + -- child status change + Sigchld : constant Interrupt_ID := System.OS_Interface.sigchld; + -- 4.3BSD's/POSIX name for SIGCLD + 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.sigio; + -- pollable event occurred + Sigio : constant Interrupt_ID := System.OS_Interface.sigio; + -- input/output possible,-- SIGPOLL alias (Solaris) + 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 + Sigpwr : constant Interrupt_ID := System.OS_Interface.sigpwr; + -- power-fail restart + Siginfo : constant Interrupt_ID := System.OS_Interface.siginfo; + +end Ada.Interrupts.Names; diff --git a/lang/gccAda-3.4/files/5netbsd64osinte.adb b/lang/gccAda-3.4/files/5netbsd64osinte.adb new file mode 100644 index 00000000000..f2a2646016f --- /dev/null +++ b/lang/gccAda-3.4/files/5netbsd64osinte.adb @@ -0,0 +1,115 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA 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) 1991-2001 Florida State University -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. It is -- +-- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- +-- State University (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is the NetBSD 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; + + function To_Duration (TV : struct_timeval) return Duration is + begin + return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6; + 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; + + function To_Timeval (D : Duration) return struct_timeval 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 struct_timeval'(tv_sec => S, + tv_usec => suseconds_t (Long_Long_Integer (F * 10#1#E6))); + end To_Timeval; + +end System.OS_Interface; diff --git a/lang/gccAda-3.4/files/5netbsd64osinte.ads b/lang/gccAda-3.4/files/5netbsd64osinte.ads new file mode 100644 index 00000000000..2bad26a3cc5 --- /dev/null +++ b/lang/gccAda-3.4/files/5netbsd64osinte.ads @@ -0,0 +1,646 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- S Y S T E M . O S _ I N T E R F A C E -- +-- -- +-- S p e c -- +-- -- +-- -- +-- Copyright (C) 1997-2001 Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This package includes all direct interfaces to OS services +-- that are needed by children of System. + +-- PLEASE DO NOT add any with-clauses to this package +-- or remove the pragma Elaborate_Body. +-- It is designed to be a bottom-level (leaf) package. + +with Interfaces.C; +package System.OS_Interface is + pragma Preelaborate; + + pragma Linker_Options ("-lposix"); + 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; + + type int32_t is range -2**31 .. (2**31)-1; + for int32_t'Size use 32; + + ----------- + -- Errno -- + ----------- + + function Errno return int; + pragma Import (C, Errno, "__get_errno"); + + EPERM : constant := 1; -- Operation not permitted + ENOENT : constant := 2; -- No such file or directory + ESRCH : constant := 3; -- No such process + EINTR : constant := 4; -- Interrupted system call + EIO : constant := 5; -- Input/output error + ENXIO : constant := 6; -- Device not configured + E2BIG : constant := 7; -- Argument list too long + ENOEXEC : constant := 8; -- Exec format error + EBADF : constant := 9; -- Bad file descriptor + ECHILD : constant := 10; -- No child processes + EDEADLK : constant := 11; -- Resource deadlock avoided + ENOMEM : constant := 12; -- Cannot allocate memory + EACCES : constant := 13; -- Permission denied + EFAULT : constant := 14; -- Bad address + ENOTBLK : constant := 15; -- Block device required + EBUSY : constant := 16; -- Device busy + EEXIST : constant := 17; -- File exists + EXDEV : constant := 18; -- Cross-device link + ENODEV : constant := 19; + ENOTDIR : constant := 20; -- Not a directory + EISDIR : constant := 21; -- Is a directory + EINVAL : constant := 22; -- Invalid argument + ENFILE : constant := 23; + EMFILE : constant := 24; -- Too many open files + ENOTTY : constant := 25; + ETXTBSY : constant := 26; -- Text file busy + EFBIG : constant := 27; -- File too large + ENOSPC : constant := 28; -- No space left on device + ESPIPE : constant := 29; -- Illegal seek + EROFS : constant := 30; -- Read-only file system + EMLINK : constant := 31; -- Too many links + EPIPE : constant := 32; -- Broken pipe + EDOM : constant := 33; + ERANGE : constant := 34; + EAGAIN : constant := 35; + EWOULDBLOCK : constant := EAGAIN; -- Operation would block + EINPROGRESS : constant := 36; -- Operation now in progress + EALREADY : constant := 37; + ENOTSOCK : constant := 38; + EDESTADDRREQ : constant := 39; + EMSGSIZE : constant := 40; -- Message too long + EPROTOTYPE : constant := 41; + ENOPROTOOPT : constant := 42; -- Protocol not available + EPROTONOSUPPORT : constant := 43; -- Protocol not supported + ESOCKTNOSUPPORT : constant := 44; -- Socket type not supported + EOPNOTSUPP : constant := 45; -- Operation not supported + EPFNOSUPPORT : constant := 46; + EAFNOSUPPORT : constant := 47; + EADDRINUSE : constant := 48; -- Address already in use + EADDRNOTAVAIL : constant := 49; + ENETDOWN : constant := 50; -- Network is down + ENETUNREACH : constant := 51; -- Network is unreachable + ENETRESET : constant := 52; + ECONNABORTED : constant := 53; + ECONNRESET : constant := 54; -- Connection reset by peer + ENOBUFS : constant := 55; -- No buffer space available + EISCONN : constant := 56; + ENOTCONN : constant := 57; -- Socket is not connected + ESHUTDOWN : constant := 58; + ETOOMANYREFS : constant := 59; + ETIMEDOUT : constant := 60; -- Operation timed out + ECONNREFUSED : constant := 61; -- Connection refused + ELOOP : constant := 62; + ENAMETOOLONG : constant := 63; -- File name too long + EHOSTDOWN : constant := 64; -- Host is down + EHOSTUNREACH : constant := 65; -- No route to host + ENOTEMPTY : constant := 66; -- Directory not empty + EPROCLIM : constant := 67; -- Too many processes + EUSERS : constant := 68; -- Too many users + EDQUOT : constant := 69; -- Disc quota exceeded + ESTALE : constant := 70; -- Stale NFS file handle + EREMOTE : constant := 71; + EBADRPC : constant := 72; -- RPC struct is bad + ERPCMISMATCH : constant := 73; -- RPC version wrong + EPROGUNAVAIL : constant := 74; -- RPC prog. not avail + EPROGMISMATCH : constant := 75; -- Program version wrong + EPROCUNAVAIL : constant := 76; -- Bad procedure for program + ENOLCK : constant := 77; -- No locks available + ENOSYS : constant := 78; -- Function not implemented + EFTYPE : constant := 79; + EAUTH : constant := 80; -- Authentication error + ENEEDAUTH : constant := 81; -- Need authenticator + EIDRM : constant := 82; -- Identifier removed + ENOMSG : constant := 83; -- No message of desired type + EOVERFLOW : constant := 84; + EILSEQ : constant := 85; -- Illegal byte sequence + ENOTSUP : constant := 86; -- Not supported + ECANCELED : constant := 87; -- Operation canceled + EBADMSG : constant := 88; -- Bad or Corrupt message + ENODATA : constant := 89; -- No message available + ENOSR : constant := 90; -- No STREAM resources + ENOSTR : constant := 91; -- Not a STREAM + ETIME : constant := 92; -- STREAM ioctl timeout + ELAST : constant := 92; -- Must equal largest errno + + ------------- + -- 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 + sigquit : constant := 3; -- quit + sigill : constant := 4; -- illegal instruction (not reset when caught) + sigtrap : constant := 5; -- trace trap (not reset when caught) + SIGABRT : constant := 6; -- abort() + sigiot : constant := SIGABRT; -- compatibility + 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 + sigurg : constant := 16; -- urgent condition on IO channel + sigstop : constant := 17; -- sendable stop signal not from tty + sigtstp : constant := 18; -- stop signal from tty + sigcont : constant := 19; -- continue a stopped process + sigchld : constant := 20; -- to parent on child stop or exit + sigttin : constant := 21; -- to readers pgrp upon background tty read + sigttou : constant := 22; -- like TTIN for output if (tp->t_local<OSTOP) + sigio : constant := 23; -- input/output possible signal + sigxcpu : constant := 24; -- exceeded CPU time limit + sigxfsz : constant := 25; -- exceeded file size limit + sigvtalrm : constant := 26; -- virtual time alarm + sigprof : constant := 27; -- profiling time alarm + sigwinch : constant := 28; -- window size changes + siginfo : constant := 29; -- information request + sigusr1 : constant := 30; -- user defined signal 1 + sigusr2 : constant := 31; -- user defined signal 2 + sigpwr : constant := 32; -- power fail/restart (not reset when caught) + sigwaiting : constant := 0; -- process's lwps blocked (Solaris) + sigcancel : constant := 0; -- thread cancellation signal (libthread) + + SIGADAABORT : constant := SIGABRT; + + type signal_set is array (Natural range <>) of Signal; + + Unmasked : constant signal_set := (sigkill, sigill, sigprof, sigtrap, + sigpwr); + + -- Following signals should not be disturbed. + -- See c-posix-signals.c in FLORIST + Reserved : constant signal_set := (sigalrm, sigbus, sigill, sigsegv, + sigfpe, SIGABRT, sigkill, sigstop); + + -- PTHREAD_SIGMASK(3) + SIG_BLOCK : constant := 1; + SIG_SETMASK : constant := 3; + SIG_UNBLOCK : constant := 2; + + type sigset_t is private; + type sigset_t_ptr is access all sigset_t; + + -- Binding to macros defined in <signal.h> + function sigaddset (set : access sigset_t; sig : Signal) return int; + pragma Import (C, sigaddset, "adasigaddset"); + + function sigdelset (set : access sigset_t; sig : Signal) return int; + pragma Import (C, sigdelset, "adasigdelset"); + + function sigfillset (set : access sigset_t) return int; + pragma Import (C, sigfillset, "adasigfillset"); + + function sigismember (set : access sigset_t; sig : Signal) return int; + pragma Import (C, sigismember, "adasigismember"); + + function sigemptyset (set : access sigset_t) return int; + pragma Import (C, sigemptyset, "adasigemptyset"); + + type struct_sigaction is record + sa_handler : System.Address; + sa_mask : sigset_t; + sa_flags : int; + end record; + pragma Convention (C, struct_sigaction); + type struct_sigaction_ptr is access all struct_sigaction; + + 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, "adasigaction"); + + ---------- + -- Time -- + ---------- + + type clockid_t is new int; + CLOCK_REALTIME : constant := 0; + + type timespec is private; + + function To_Duration ( + TS : timespec) + return Duration; + pragma Inline (To_Duration); + + function To_Timespec ( + D : Duration) + return timespec; + pragma Inline (To_Timespec); + + type Struct_Timeval is private; + + function To_Duration ( + TV : Struct_Timeval) + return Duration; + pragma Inline (To_Duration); + + function To_Timeval ( + D : Duration) + return Struct_Timeval; + pragma Inline (To_Timeval); + + function Gettimeofday ( + Tv : access Struct_Timeval; + Tz : System.Address := System.Null_Address) + return int; + pragma Import (C, Gettimeofday, "gettimeofday"); + + function clock_gettime + (clock_id : clockid_t; + tp : access timespec) return int; + pragma Import (C, clock_gettime, "clock_gettime"); + + + --------- + -- LWP -- + --------- + + -- From <sys/types.h> + type lwpid_t is new int32_t; + + function lwp_self return System.Address; + pragma Import (C, lwp_self, "ada_lwp_self"); + + + ------------------------- + -- 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; + 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; + subtype cond_t is pthread_cond_t; + + PTHREAD_CREATE_DETACHED : constant := 1; + + --------------------------------------- + -- 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, "adasigwait"); + + function pthread_kill + (thread : pthread_t; + sig : Signal) return int; + pragma Import (C, pthread_kill, "pthread_kill"); + + function pthread_sigmask + (how : int; + set : sigset_t_ptr; + oset : sigset_t_ptr) 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, "pthread_mutexattr_setprotocol"); + + function pthread_mutexattr_setprioceiling + (attr : access pthread_mutexattr_t; + prioceiling : int) return int; + pragma Import + (C, pthread_mutexattr_setprioceiling, "pthread_mutexattr_setprioceiling"); + + type struct_sched_param is record + sched_priority : int; + end record; + for struct_sched_param use record + sched_priority at 0 range 0 .. 31; + 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); + + function pthread_key_create + (key : access pthread_key_t; + destructor : destructor_pointer) return int; + pragma Import (C, pthread_key_create, "pthread_key_create"); + + --------------------------------------------------------------- + -- 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); + + -- From <sys/ansi.h> + type pid_t is new int32_t; + + type time_t is new int32_t; + + type timespec is record + tv_sec : time_t; + tv_nsec : long; + end record; + for timespec use record + tv_sec at 0 range 0 .. 63; + tv_nsec at 8 range 0 .. 63; + end record; + pragma Warnings (Off); + -- There may be holes in the record, due to + -- components not defined by POSIX standard. + for timespec'Size use 128; + pragma Convention (C, timespec); + + type suseconds_t is range -2**63 .. (2**63)-1; + for suseconds_t'Size use 64; + type struct_timeval is record + tv_sec : time_t; + tv_usec : suseconds_t; + end record; + for struct_timeval use record + tv_sec at 0 range 0 .. 63; + tv_usec at 8 range 0 .. 63; + end record; + pragma Convention (C, struct_timeval); + pragma Warnings (Off); + -- There may be holes in the record, due to + -- components not defined by POSIX standard. + for struct_timeval'Size use 128; + pragma Warnings (On); + + + 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 System.Address; + + 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/lang/gccAda-3.4/files/5netbsd64system.ads b/lang/gccAda-3.4/files/5netbsd64system.ads new file mode 100644 index 00000000000..518d547925e --- /dev/null +++ b/lang/gccAda-3.4/files/5netbsd64system.ads @@ -0,0 +1,150 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- S Y S T E M -- +-- -- +-- S p e c -- +-- (GNU-Linux/x86 Version) -- +-- -- +-- Copyright (C) 1992-2003 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 2, 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 COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- 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 (System); +-- Note that we take advantage of the implementation permission to +-- make this unit Pure instead of Preelaborable, see RM 13.7(36) + + 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 := Integer'Last; + + 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.000_001; + + -- Storage-related Declarations + + type Address is private; + 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 := Low_Order_First; + + -- 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. + + AAMP : constant Boolean := False; + 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 := True; + Duration_32_Bits : constant Boolean := False; + Exit_Status_Supported : constant Boolean := True; + Fractional_Fixed_Ops : constant Boolean := False; + Frontend_Layout : constant Boolean := False; + Functions_Return_By_DSP : constant Boolean := False; + Machine_Overflows : constant Boolean := False; + Machine_Rounds : constant Boolean := True; + OpenVMS : constant Boolean := False; + Signed_Zeros : constant Boolean := True; + Stack_Check_Default : constant Boolean := False; + Stack_Check_Probes : 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; + Suppress_Standard_Library : constant Boolean := False; + Use_Ada_Main_Program_Name : constant Boolean := False; + ZCX_By_Default : constant Boolean := False; + GCC_ZCX_Support : constant Boolean := False; + Front_End_ZCX_Support : constant Boolean := False; + + -- Obsolete entries, to be removed eventually (bootstrap issues!) + + High_Integrity_Mode : constant Boolean := False; + Long_Shifts_Inlined : constant Boolean := True; + +end System; diff --git a/lang/gccAda-3.4/files/5netbsdintman.adb b/lang/gccAda-3.4/files/5netbsdintman.adb new file mode 100644 index 00000000000..0a40921e564 --- /dev/null +++ b/lang/gccAda-3.4/files/5netbsdintman.adb @@ -0,0 +1,274 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA 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) 1992-2002, Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. -- +-- Extensive contributions were provided by Ada Core Technologies, Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This is the NetBSD threads version of this package + +-- PLEASE DO NOT add any dependences on other packages. ??? why not ??? +-- This package is designed to work with or without tasking support. + +-- See the other warnings in the package specification before making +-- any modifications to this file. + +-- 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. + +-- Since this is a multi target file, the signal <-> exception mapping +-- is simple minded. If you need a more precise and target specific +-- signal handling, create a new s-intman.adb that will fit your needs. + +-- This file assumes that: + +-- sigfpe, sigill, sigsegv and sigbus exist. They are mapped as follows: +-- sigfpe => Constraint_Error +-- sigill => Program_Error +-- sigill => Storage_Error +-- sigbus => Storage_Error + +-- sigint exists and will be kept unmasked unless the pragma +-- Unreserve_All_Interrupts is specified anywhere in the application. + +-- System.OS_Interface contains the following: +-- SIGADAABORT: the signal that will be used to abort tasks. +-- Unmasked: the OS specific set of signals that should be unmasked in +-- all the threads. SIGADAABORT is unmasked by +-- default +-- Reserved: the OS specific set of signals that are reserved. + +with Interfaces.C; +-- used for int and other types + +with System.OS_Interface; +-- used for various Constants, Signal and types + +package body System.Interrupt_Management is + + use Interfaces.C; + use System.OS_Interface; + + type Interrupt_List is array (Interrupt_ID range <>) of Interrupt_ID; + Exception_Interrupts : constant Interrupt_List := + (sigfpe, sigill, sigsegv, sigbus); + + Unreserve_All_Interrupts : Interfaces.C.int; + pragma Import + (C, Unreserve_All_Interrupts, "__gl_unreserve_all_interrupts"); + + ----------------------- + -- Local Subprograms -- + ----------------------- + + procedure Notify_Exception (signo : Signal); + -- This function identifies the Ada exception to be raised using + -- the information when the system received a synchronous signal. + -- Since this function is machine and OS dependent, different code + -- has to be provided for different target. + + ---------------------- + -- Notify_Exception -- + ---------------------- + + Signal_Mask : aliased sigset_t; + -- The set of signals handled by Notify_Exception + + procedure Notify_Exception (signo : Signal) is + Result : Interfaces.C.int; + + begin + -- With the __builtin_longjmp, the signal mask is not restored, so we + -- need to restore it explicitely. + + Result := pthread_sigmask (SIG_UNBLOCK, Signal_Mask'Access, null); + pragma Assert (Result = 0); + + -- Check that treatment of exception propagation here + -- is consistent with treatment of the abort signal in + -- System.Task_Primitives.Operations. + + case signo is + when sigfpe => + raise Constraint_Error; + when sigill => + raise Program_Error; + when sigbus | sigsegv => + raise Storage_Error; + when others => + null; + end case; + end Notify_Exception; + + --------------------------- + -- Initialize_Interrupts -- + --------------------------- + + -- Nothing needs to be done on this platform. + + procedure Initialize_Interrupts is + begin + null; + end Initialize_Interrupts; + +------------------------- +-- Package Elaboration -- +------------------------- + +begin + declare + act : aliased struct_sigaction; + old_act : aliased struct_sigaction; + Result : System.OS_Interface.int; + + 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) + + begin + -- Need to call pthread_init very early because it is doing signal + -- initializations. + + pthread_init; + + Abort_Task_Interrupt := SIGADAABORT; + + act.sa_handler := Notify_Exception'Address; + + act.sa_flags := 0; + + -- On some targets, we set sa_flags to SA_NODEFER so that during the + -- handler execution we do not change the Signal_Mask to be masked for + -- the Signal. + + -- This is a temporary fix to the problem that the Signal_Mask is + -- not restored after the exception (longjmp) from the handler. + -- The right fix should be made in sigsetjmp so that we save + -- the Signal_Set and restore it after a longjmp. + + -- Since SA_NODEFER is obsolete, instead we reset explicitely + -- the mask in the exception handler. + + Result := sigemptyset (Signal_Mask'Access); + pragma Assert (Result = 0); + + -- Add signals that map to Ada exceptions to the mask. + for J in Exception_Interrupts'Range loop + if State (Exception_Interrupts (J)) /= Default then + Result := + sigaddset (Signal_Mask'Access, Signal (Exception_Interrupts (J))); + pragma Assert (Result = 0); + end if; + end loop; + + act.sa_mask := Signal_Mask; + + 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; + + if State (Exception_Interrupts (J)) /= Default then + Result := + sigaction + (Signal (Exception_Interrupts (J)), act'Unchecked_Access, + old_act'Unchecked_Access); + pragma Assert (Result = 0); + end if; + 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 is not in "User" + -- state. Check for Unreserve_All_Interrupts last + + if State (sigint) /= User then + Keep_Unmasked (sigint) := True; + Reserve (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; + + -- Add the set of signals that must always be unmasked for this target + + for J in Unmasked'Range loop + Keep_Unmasked (Interrupt_ID (Unmasked (J))) := True; + Reserve (Interrupt_ID (Unmasked (J))) := True; + end loop; + + -- Add target-specific reserved signals + + for J in Reserved'Range loop + Reserve (Interrupt_ID (Reserved (J))) := True; + 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 non-existent 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; +end System.Interrupt_Management; diff --git a/lang/gccAda-3.4/files/5netbsdosinte.adb b/lang/gccAda-3.4/files/5netbsdosinte.adb new file mode 100644 index 00000000000..f2a2646016f --- /dev/null +++ b/lang/gccAda-3.4/files/5netbsdosinte.adb @@ -0,0 +1,115 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA 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) 1991-2001 Florida State University -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. It is -- +-- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- +-- State University (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is the NetBSD 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; + + function To_Duration (TV : struct_timeval) return Duration is + begin + return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6; + 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; + + function To_Timeval (D : Duration) return struct_timeval 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 struct_timeval'(tv_sec => S, + tv_usec => suseconds_t (Long_Long_Integer (F * 10#1#E6))); + end To_Timeval; + +end System.OS_Interface; diff --git a/lang/gccAda-3.4/files/5netbsdosinte.ads b/lang/gccAda-3.4/files/5netbsdosinte.ads new file mode 100644 index 00000000000..6dbe7b96dfb --- /dev/null +++ b/lang/gccAda-3.4/files/5netbsdosinte.ads @@ -0,0 +1,634 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- S Y S T E M . O S _ I N T E R F A C E -- +-- -- +-- S p e c -- +-- -- +-- -- +-- Copyright (C) 1997-2001 Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This package includes all direct interfaces to OS services +-- that are needed by children of System. + +-- PLEASE DO NOT add any with-clauses to this package +-- or remove the pragma Elaborate_Body. +-- It is designed to be a bottom-level (leaf) package. + +with Interfaces.C; +package System.OS_Interface is + pragma Preelaborate; + + pragma Linker_Options ("-lposix"); + 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; + + type int32_t is range -2**31 .. (2**31)-1; + for int32_t'Size use 32; + + ----------- + -- Errno -- + ----------- + + function Errno return int; + pragma Import (C, Errno, "__get_errno"); + + EPERM : constant := 1; -- Operation not permitted + ENOENT : constant := 2; -- No such file or directory + ESRCH : constant := 3; -- No such process + EINTR : constant := 4; -- Interrupted system call + EIO : constant := 5; -- Input/output error + ENXIO : constant := 6; -- Device not configured + E2BIG : constant := 7; -- Argument list too long + ENOEXEC : constant := 8; -- Exec format error + EBADF : constant := 9; -- Bad file descriptor + ECHILD : constant := 10; -- No child processes + EDEADLK : constant := 11; -- Resource deadlock avoided + ENOMEM : constant := 12; -- Cannot allocate memory + EACCES : constant := 13; -- Permission denied + EFAULT : constant := 14; -- Bad address + ENOTBLK : constant := 15; -- Block device required + EBUSY : constant := 16; -- Device busy + EEXIST : constant := 17; -- File exists + EXDEV : constant := 18; -- Cross-device link + ENODEV : constant := 19; + ENOTDIR : constant := 20; -- Not a directory + EISDIR : constant := 21; -- Is a directory + EINVAL : constant := 22; -- Invalid argument + ENFILE : constant := 23; + EMFILE : constant := 24; -- Too many open files + ENOTTY : constant := 25; + ETXTBSY : constant := 26; -- Text file busy + EFBIG : constant := 27; -- File too large + ENOSPC : constant := 28; -- No space left on device + ESPIPE : constant := 29; -- Illegal seek + EROFS : constant := 30; -- Read-only file system + EMLINK : constant := 31; -- Too many links + EPIPE : constant := 32; -- Broken pipe + EDOM : constant := 33; + ERANGE : constant := 34; + EAGAIN : constant := 35; + EWOULDBLOCK : constant := EAGAIN; -- Operation would block + EINPROGRESS : constant := 36; -- Operation now in progress + EALREADY : constant := 37; + ENOTSOCK : constant := 38; + EDESTADDRREQ : constant := 39; + EMSGSIZE : constant := 40; -- Message too long + EPROTOTYPE : constant := 41; + ENOPROTOOPT : constant := 42; -- Protocol not available + EPROTONOSUPPORT : constant := 43; -- Protocol not supported + ESOCKTNOSUPPORT : constant := 44; -- Socket type not supported + EOPNOTSUPP : constant := 45; -- Operation not supported + EPFNOSUPPORT : constant := 46; + EAFNOSUPPORT : constant := 47; + EADDRINUSE : constant := 48; -- Address already in use + EADDRNOTAVAIL : constant := 49; + ENETDOWN : constant := 50; -- Network is down + ENETUNREACH : constant := 51; -- Network is unreachable + ENETRESET : constant := 52; + ECONNABORTED : constant := 53; + ECONNRESET : constant := 54; -- Connection reset by peer + ENOBUFS : constant := 55; -- No buffer space available + EISCONN : constant := 56; + ENOTCONN : constant := 57; -- Socket is not connected + ESHUTDOWN : constant := 58; + ETOOMANYREFS : constant := 59; + ETIMEDOUT : constant := 60; -- Operation timed out + ECONNREFUSED : constant := 61; -- Connection refused + ELOOP : constant := 62; + ENAMETOOLONG : constant := 63; -- File name too long + EHOSTDOWN : constant := 64; -- Host is down + EHOSTUNREACH : constant := 65; -- No route to host + ENOTEMPTY : constant := 66; -- Directory not empty + EPROCLIM : constant := 67; -- Too many processes + EUSERS : constant := 68; -- Too many users + EDQUOT : constant := 69; -- Disc quota exceeded + ESTALE : constant := 70; -- Stale NFS file handle + EREMOTE : constant := 71; + EBADRPC : constant := 72; -- RPC struct is bad + ERPCMISMATCH : constant := 73; -- RPC version wrong + EPROGUNAVAIL : constant := 74; -- RPC prog. not avail + EPROGMISMATCH : constant := 75; -- Program version wrong + EPROCUNAVAIL : constant := 76; -- Bad procedure for program + ENOLCK : constant := 77; -- No locks available + ENOSYS : constant := 78; -- Function not implemented + EFTYPE : constant := 79; + EAUTH : constant := 80; -- Authentication error + ENEEDAUTH : constant := 81; -- Need authenticator + EIDRM : constant := 82; -- Identifier removed + ENOMSG : constant := 83; -- No message of desired type + EOVERFLOW : constant := 84; + EILSEQ : constant := 85; -- Illegal byte sequence + ENOTSUP : constant := 86; -- Not supported + ECANCELED : constant := 87; -- Operation canceled + EBADMSG : constant := 88; -- Bad or Corrupt message + ENODATA : constant := 89; -- No message available + ENOSR : constant := 90; -- No STREAM resources + ENOSTR : constant := 91; -- Not a STREAM + ETIME : constant := 92; -- STREAM ioctl timeout + ELAST : constant := 92; -- Must equal largest errno + + ------------- + -- 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 + sigquit : constant := 3; -- quit + sigill : constant := 4; -- illegal instruction (not reset when caught) + sigtrap : constant := 5; -- trace trap (not reset when caught) + SIGABRT : constant := 6; -- abort() + sigiot : constant := SIGABRT; -- compatibility + 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 + sigurg : constant := 16; -- urgent condition on IO channel + sigstop : constant := 17; -- sendable stop signal not from tty + sigtstp : constant := 18; -- stop signal from tty + sigcont : constant := 19; -- continue a stopped process + sigchld : constant := 20; -- to parent on child stop or exit + sigttin : constant := 21; -- to readers pgrp upon background tty read + sigttou : constant := 22; -- like TTIN for output if (tp->t_local<OSTOP) + sigio : constant := 23; -- input/output possible signal + sigxcpu : constant := 24; -- exceeded CPU time limit + sigxfsz : constant := 25; -- exceeded file size limit + sigvtalrm : constant := 26; -- virtual time alarm + sigprof : constant := 27; -- profiling time alarm + sigwinch : constant := 28; -- window size changes + siginfo : constant := 29; -- information request + sigusr1 : constant := 30; -- user defined signal 1 + sigusr2 : constant := 31; -- user defined signal 2 + sigpwr : constant := 32; -- power fail/restart (not reset when caught) + sigwaiting : constant := 0; -- process's lwps blocked (Solaris) + sigcancel : constant := 0; -- thread cancellation signal (libthread) + + SIGADAABORT : constant := SIGABRT; + + type signal_set is array (Natural range <>) of Signal; + + Unmasked : constant signal_set := (sigkill, sigill, sigprof, sigtrap, + sigpwr); + + -- Following signals should not be disturbed. + -- See c-posix-signals.c in FLORIST + Reserved : constant signal_set := (sigalrm, sigbus, sigill, sigsegv, + sigfpe, SIGABRT, sigkill, sigstop); + + -- PTHREAD_SIGMASK(3) + SIG_BLOCK : constant := 1; + SIG_SETMASK : constant := 3; + SIG_UNBLOCK : constant := 2; + + type sigset_t is private; + type sigset_t_ptr is access all sigset_t; + + -- Binding to macros defined in <signal.h> + function sigaddset (set : access sigset_t; sig : Signal) return int; + pragma Import (C, sigaddset, "adasigaddset"); + + function sigdelset (set : access sigset_t; sig : Signal) return int; + pragma Import (C, sigdelset, "adasigdelset"); + + function sigfillset (set : access sigset_t) return int; + pragma Import (C, sigfillset, "adasigfillset"); + + function sigismember (set : access sigset_t; sig : Signal) return int; + pragma Import (C, sigismember, "adasigismember"); + + function sigemptyset (set : access sigset_t) return int; + pragma Import (C, sigemptyset, "adasigemptyset"); + + type struct_sigaction is record + sa_handler : System.Address; + sa_mask : sigset_t; + sa_flags : int; + end record; + pragma Convention (C, struct_sigaction); + type struct_sigaction_ptr is access all struct_sigaction; + + 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, "adasigaction"); + + ---------- + -- Time -- + ---------- + + type clockid_t is new int; + CLOCK_REALTIME : constant := 0; + + type timespec is private; + + function To_Duration ( + TS : timespec) + return Duration; + pragma Inline (To_Duration); + + function To_Timespec ( + D : Duration) + return timespec; + pragma Inline (To_Timespec); + + type Struct_Timeval is private; + + function To_Duration ( + TV : Struct_Timeval) + return Duration; + pragma Inline (To_Duration); + + function To_Timeval ( + D : Duration) + return Struct_Timeval; + pragma Inline (To_Timeval); + + function Gettimeofday ( + Tv : access Struct_Timeval; + Tz : System.Address := System.Null_Address) + return int; + pragma Import (C, Gettimeofday, "gettimeofday"); + + function clock_gettime + (clock_id : clockid_t; + tp : access timespec) return int; + pragma Import (C, clock_gettime, "clock_gettime"); + + + --------- + -- LWP -- + --------- + + type lwpid_t is new int32_t; + + function lwp_self return System.Address; + pragma Import (C, lwp_self, "ada_lwp_self"); + + + ------------------------- + -- 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; + 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; + subtype cond_t is pthread_cond_t; + + PTHREAD_CREATE_DETACHED : constant := 1; + + --------------------------------------- + -- 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, "adasigwait"); + + function pthread_kill + (thread : pthread_t; + sig : Signal) return int; + pragma Import (C, pthread_kill, "pthread_kill"); + + function pthread_sigmask + (how : int; + set : sigset_t_ptr; + oset : sigset_t_ptr) 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, "pthread_mutexattr_setprotocol"); + + function pthread_mutexattr_setprioceiling + (attr : access pthread_mutexattr_t; + prioceiling : int) return int; + pragma Import + (C, pthread_mutexattr_setprioceiling, "pthread_mutexattr_setprioceiling"); + + type struct_sched_param is record + sched_priority : int; + end record; + for struct_sched_param use record + sched_priority at 0 range 0 .. 31; + 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); + + function pthread_key_create + (key : access pthread_key_t; + destructor : destructor_pointer) return int; + pragma Import (C, pthread_key_create, "pthread_key_create"); + + --------------------------------------------------------------- + -- 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 int32_t; + + type time_t is new int32_t; + + type suseconds_t is new int32_t; + + type timespec is record + tv_sec : time_t; + tv_nsec : long; + end record; + for timespec use record + tv_sec at 0 range 0 .. 31; + tv_nsec at 4 range 0 .. 31; + end record; + pragma Convention (C, timespec); + + type struct_timeval is record + tv_sec : time_t; + tv_usec : suseconds_t; + end record; + for struct_timeval use record + tv_sec at 0 range 0 .. 31; + tv_usec at 4 range 0 .. 31; + end record; + pragma Convention (C, struct_timeval); + + 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/lang/gccAda-3.4/files/5netbsdparame.adb b/lang/gccAda-3.4/files/5netbsdparame.adb new file mode 100644 index 00000000000..027db72e58d --- /dev/null +++ b/lang/gccAda-3.4/files/5netbsdparame.adb @@ -0,0 +1,79 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S Y S T E M . P A R A M E T E R S -- +-- -- +-- B o d y -- +-- -- +-- -- +-- Copyright (C) 1998-2001 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 2, 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 COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This is the Solaris (native) specific version + +package body System.Parameters is + + ------------------------ + -- Default_Stack_Size -- + ------------------------ + + function Default_Stack_Size return Size_Type is + begin + return 8318976; + end Default_Stack_Size; + + ------------------------ + -- Minimum_Stack_Size -- + ------------------------ + + function Minimum_Stack_Size return Size_Type is + + thr_min_stack : constant Size_Type := 1160; + -- This value does not really matter anyway, since this is checked + -- and adjusted at the library level when creating a thread. + + begin + return thr_min_stack; + end Minimum_Stack_Size; + + ------------------------- + -- Adjust_Storage_Size -- + ------------------------- + + function Adjust_Storage_Size (Size : Size_Type) return Size_Type is + begin + if Size = Unspecified_Size then + return Default_Stack_Size; + + elsif Size < Minimum_Stack_Size then + return Minimum_Stack_Size; + + else + return Size; + end if; + end Adjust_Storage_Size; + +end System.Parameters; diff --git a/lang/gccAda-3.4/files/5netbsdsystem.ads b/lang/gccAda-3.4/files/5netbsdsystem.ads new file mode 100644 index 00000000000..abdfe1929de --- /dev/null +++ b/lang/gccAda-3.4/files/5netbsdsystem.ads @@ -0,0 +1,150 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- S Y S T E M -- +-- -- +-- S p e c -- +-- (GNU-Linux/x86 Version) -- +-- -- +-- Copyright (C) 1992-2003 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 2, 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 COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- 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 (System); +-- Note that we take advantage of the implementation permission to +-- make this unit Pure instead of Preelaborable, see RM 13.7(36) + + 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 := Integer'Last; + + 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.000_001; + + -- Storage-related Declarations + + type Address is private; + 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 := Low_Order_First; + + -- 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. + + AAMP : constant Boolean := False; + 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 := True; + Duration_32_Bits : constant Boolean := False; + Exit_Status_Supported : constant Boolean := True; + Fractional_Fixed_Ops : constant Boolean := False; + Frontend_Layout : constant Boolean := False; + Functions_Return_By_DSP : constant Boolean := False; + Machine_Overflows : constant Boolean := False; + Machine_Rounds : constant Boolean := True; + OpenVMS : constant Boolean := False; + Signed_Zeros : constant Boolean := True; + Stack_Check_Default : constant Boolean := False; + Stack_Check_Probes : 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; + Suppress_Standard_Library : constant Boolean := False; + Use_Ada_Main_Program_Name : constant Boolean := False; + ZCX_By_Default : constant Boolean := False; + GCC_ZCX_Support : constant Boolean := False; + Front_End_ZCX_Support : constant Boolean := False; + + -- Obsolete entries, to be removed eventually (bootstrap issues!) + + High_Integrity_Mode : constant Boolean := False; + Long_Shifts_Inlined : constant Boolean := True; + +end System; diff --git a/lang/gccAda-3.4/files/5netbsdtaprop.adb b/lang/gccAda-3.4/files/5netbsdtaprop.adb new file mode 100644 index 00000000000..298e88ef74c --- /dev/null +++ b/lang/gccAda-3.4/files/5netbsdtaprop.adb @@ -0,0 +1,1136 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA 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-2003, Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. -- +-- Extensive contributions were provided by Ada Core Technologies, Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This is the NetBSD version of this package + +-- This package contains all the GNULL primitives that interface directly +-- with the underlying OS. + +-- Note: this file can only be used for POSIX compliant systems that +-- implement SCHED_FIFO and Ceiling Locking correctly. + +-- For configurations where SCHED_FIFO and priority ceiling are not a +-- requirement, this file can also be used (e.g AiX threads) + +pragma Polling (Off); +-- Turn off polling, we do not want ATC polling to take place during +-- tasking operations. It causes infinite loops and other problems. + +with System.Tasking.Debug; +-- used for Known_Tasks + +with System.Task_Info; +-- used for Task_Info_Type + +with Interfaces.C; +-- used for int +-- size_t + +with System.Interrupt_Management; +-- used for Keep_Unmasked +-- Abort_Task_Interrupt +-- Interrupt_ID + +with System.Interrupt_Management.Operations; +-- used for Set_Interrupt_Mask +-- All_Tasks_Mask +pragma Elaborate_All (System.Interrupt_Management.Operations); + +with System.Parameters; +-- used for Size_Type + +with System.Tasking; +-- used for Ada_Task_Control_Block +-- Task_ID + +with System.Soft_Links; +-- used for Defer/Undefer_Abort + +-- Note that we do not use System.Tasking.Initialization directly since +-- this 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.Initialization + +with System.OS_Primitives; +-- used for Delay_Modes + +with Unchecked_Conversion; +with Unchecked_Deallocation; + +package body System.Task_Primitives.Operations is + + use System.Tasking.Debug; + use System.Tasking; + use Interfaces.C; + use System.OS_Interface; + use System.Parameters; + use System.OS_Primitives; + + package SSL renames System.Soft_Links; + + ---------------- + -- 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 + + ATCB_Key : aliased pthread_key_t; + -- Key used to find the Ada Task_ID associated with a thread + pragma Warnings (Off, ATCB_Key); + + 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"); + -- Value of the pragma Locking_Policy: + -- 'C' for Ceiling_Locking + -- 'I' for Inherit_Locking + -- ' ' for none. + + Unblocked_Signal_Mask : aliased sigset_t; + -- The set of signals that should unblocked in all tasks + + -- The followings are internal configuration constants needed. + + Next_Serial_Number : Task_Serial_Number := 100; + -- We start at 100, to reserve some special values for + -- using in error checking. + + Foreign_Task_Elaborated : aliased Boolean := True; + -- Used to identified fake tasks (i.e., non-Ada Threads). + + -------------------- + -- 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. + + --------------------------------- + -- 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 -- + ----------------------- + + procedure Abort_Handler (Sig : Signal); + -- Signal handler used to implement asynchronous abort. + -- See also comment before body, below. + + function To_Address is new Unchecked_Conversion (Task_ID, System.Address); + + ------------------- + -- Abort_Handler -- + ------------------- + + -- Target-dependent binding of inter-thread Abort signal to + -- the raising of the Abort_Signal exception. + + -- The technical issues and alternatives here are essentially + -- the same as for raising exceptions in response to other + -- signals (e.g. Storage_Error). See code and comments in + -- the package body System.Interrupt_Management. + + -- Some implementations may not allow an exception to be propagated + -- out of a handler, and others might leave the signal or + -- interrupt that invoked this handler masked after the exceptional + -- return to the application code. + + -- GNAT exceptions are originally implemented using setjmp()/longjmp(). + -- On most UNIX systems, this will allow transfer out of a signal handler, + -- which is usually the only mechanism available for implementing + -- asynchronous handlers of this kind. However, some + -- systems do not restore the signal mask on longjmp(), leaving the + -- abort signal masked. + + procedure Abort_Handler (Sig : Signal) is + pragma Warnings (Off, Sig); + + T : Task_ID := Self; + Result : Interfaces.C.int; + Old_Set : aliased sigset_t; + + begin + -- It is not safe to raise an exception when using ZCX and the GCC + -- exception handling mechanism. + + if ZCX_By_Default and then GCC_ZCX_Support then + return; + end if; + + if T.Deferral_Level = 0 + and then T.Pending_ATC_Level < T.ATC_Nesting_Level and then + not T.Aborting + then + T.Aborting := True; + + -- Make sure signals used for RTS internal purpose are unmasked + + Result := pthread_sigmask (SIG_UNBLOCK, + Unblocked_Signal_Mask'Unchecked_Access, Old_Set'Unchecked_Access); + pragma Assert (Result = 0); + + raise Standard'Abort_Signal; + end if; + end Abort_Handler; + + ----------------- + -- Stack_Guard -- + ----------------- + + procedure Stack_Guard (T : ST.Task_ID; On : Boolean) is + pragma Warnings (Off, T); + pragma Warnings (Off, On); + begin + -- This functionality is not supported so we provide a dummy + 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 Intialize_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 rasing Storage_Error in the following routines + -- should be able to be handled safely. + + procedure Initialize_Lock + (Prio : System.Any_Priority; + L : 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); + + elsif Locking_Policy = 'I' then + Result := pthread_mutexattr_setprotocol + (Attributes'Access, PTHREAD_PRIO_INHERIT); + 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 + raise Storage_Error; + end if; + + Result := pthread_mutexattr_destroy (Attributes'Access); + pragma Assert (Result = 0); + end Initialize_Lock; + + procedure Initialize_Lock (L : access RTS_Lock; Level : Lock_Level) is + pragma Warnings (Off, 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); + + elsif Locking_Policy = 'I' then + Result := pthread_mutexattr_setprotocol + (Attributes'Access, PTHREAD_PRIO_INHERIT); + 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 : access Lock) is + Result : Interfaces.C.int; + + begin + Result := pthread_mutex_destroy (L); + pragma Assert (Result = 0); + end Finalize_Lock; + + procedure Finalize_Lock (L : 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 : access Lock; Ceiling_Violation : out Boolean) is + Result : Interfaces.C.int; + + begin + Result := pthread_mutex_lock (L); + + -- Assume that the cause of EINVAL is a priority ceiling violation + + Ceiling_Violation := (Result = EINVAL); + pragma Assert (Result = 0 or else Result = EINVAL); + end Write_Lock; + + procedure Write_Lock + (L : 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 : access Lock; Ceiling_Violation : out Boolean) is + begin + Write_Lock (L, Ceiling_Violation); + end Read_Lock; + + ------------ + -- Unlock -- + ------------ + + procedure Unlock (L : access Lock) is + Result : Interfaces.C.int; + + begin + Result := pthread_mutex_unlock (L); + pragma Assert (Result = 0); + end Unlock; + + procedure Unlock (L : 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; + + ----------- + -- Sleep -- + ----------- + + procedure Sleep + (Self_ID : Task_ID; + Reason : System.Tasking.Task_States) + is + pragma Warnings (Off, Reason); + + Result : Interfaces.C.int; + + begin + if Single_Lock then + Result := pthread_cond_wait + (Self_ID.Common.LL.CV'Access, Single_RTS_Lock'Access); + else + Result := pthread_cond_wait + (Self_ID.Common.LL.CV'Access, Self_ID.Common.LL.L'Access); + end if; + + -- EINTR is not considered a failure. + + pragma Assert (Result = 0 or else Result = EINTR); + end Sleep; + + ----------------- + -- Timed_Sleep -- + ----------------- + + -- This is for use within the run-time system, so abort is + -- assumed to be already deferred, and the caller should be + -- holding its own ATCB lock. + + procedure Timed_Sleep + (Self_ID : Task_ID; + Time : Duration; + Mode : ST.Delay_Modes; + Reason : Task_States; + Timedout : out Boolean; + Yielded : out Boolean) + is + pragma Warnings (Off, Reason); + + Check_Time : constant Duration := Monotonic_Clock; + Abs_Time : Duration; + Request : aliased timespec; + Result : Interfaces.C.int; + + begin + Timedout := True; + Yielded := False; + + if Mode = Relative then + Abs_Time := Duration'Min (Time, Max_Sensible_Delay) + Check_Time; + + else + Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time); + + end if; + + if Abs_Time > Check_Time then + Request := To_Timespec (Abs_Time); + + loop + exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level + or else Self_ID.Pending_Priority_Change; + + if Single_Lock then + Result := pthread_cond_timedwait + (Self_ID.Common.LL.CV'Access, Single_RTS_Lock'Access, + Request'Access); + + else + Result := pthread_cond_timedwait + (Self_ID.Common.LL.CV'Access, Self_ID.Common.LL.L'Access, + Request'Access); + end if; + + exit when Abs_Time <= Monotonic_Clock; + + if Result = 0 or Result = EINTR then + + -- Somebody may have called Wakeup for us + + Timedout := False; + exit; + end if; + + pragma Assert (Result = ETIMEDOUT); + 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 + Check_Time : constant Duration := Monotonic_Clock; + Abs_Time : Duration; + Request : aliased timespec; + Result : Interfaces.C.int; + + begin + -- Only the little window between deferring abort and + -- locking Self_ID is the reason we need to + -- check for pending abort and priority change below! :( + + SSL.Abort_Defer.all; + + if Single_Lock then + Lock_RTS; + end if; + + Write_Lock (Self_ID); + + if Mode = Relative then + Abs_Time := Duration'Min (Time, Max_Sensible_Delay) + Check_Time; + + else + Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time); + + end if; + + if Abs_Time > Check_Time then + Request := To_Timespec (Abs_Time); + Self_ID.Common.State := Delay_Sleep; + + loop + if Self_ID.Pending_Priority_Change then + Self_ID.Pending_Priority_Change := False; + Self_ID.Common.Base_Priority := Self_ID.New_Base_Priority; + Set_Priority (Self_ID, Self_ID.Common.Base_Priority); + end if; + + exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level; + + if Single_Lock then + Result := pthread_cond_timedwait (Self_ID.Common.LL.CV'Access, + Single_RTS_Lock'Access, Request'Access); + else + Result := pthread_cond_timedwait (Self_ID.Common.LL.CV'Access, + Self_ID.Common.LL.L'Access, Request'Access); + end if; + + exit when Abs_Time <= Monotonic_Clock; + + 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; + + Result := sched_yield; + SSL.Abort_Undefer.all; + end Timed_Delay; + + --------------------- + -- Monotonic_Clock -- + --------------------- + + function Monotonic_Clock return Duration is + TS : aliased timespec; + Result : Interfaces.C.int; + + begin + Result := clock_gettime + (clock_id => CLOCK_REALTIME, tp => TS'Unchecked_Access); + pragma Assert (Result = 0); + return To_Duration (TS); + end Monotonic_Clock; + + ------------------- + -- RT_Resolution -- + ------------------- + + function RT_Resolution return Duration is + begin + return 10#1.0#E-6; + end RT_Resolution; + + ------------ + -- Wakeup -- + ------------ + + procedure Wakeup (T : Task_ID; Reason : System.Tasking.Task_States) is + pragma Warnings (Off, 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 Warnings (Off, 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 Warnings (Off, Loss_Of_Inheritance); + + Result : Interfaces.C.int; + Param : aliased struct_sched_param; + + begin + T.Common.Current_Priority := Prio; + Param.sched_priority := Interfaces.C.int (Prio); + + -- Only time slicing is supported + Result := pthread_setschedparam + (T.Common.LL.Thread, SCHED_RR, 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 + begin + Self_ID.Common.LL.Thread := pthread_self; + Self_ID.Common.LL.LWP := lwp_self; + + Specific.Set (Self_ID); + + Lock_RTS; + + for J in Known_Tasks'Range loop + if Known_Tasks (J) = null then + Known_Tasks (J) := Self_ID; + Self_ID.Known_Tasks_Index := J; + exit; + end if; + end loop; + + Unlock_RTS; + end Enter_Task; + + -------------- + -- New_ATCB -- + -------------- + + function New_ATCB (Entry_Num : Task_Entry_Index) return Task_ID is + begin + return new Ada_Task_Control_Block (Entry_Num); + end New_ATCB; + + ------------------- + -- 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 + Mutex_Attr : aliased pthread_mutexattr_t; + Result : Interfaces.C.int; + Cond_Attr : aliased pthread_condattr_t; + + begin + -- Give the task a unique serial number. + + Self_ID.Serial_Number := Next_Serial_Number; + Next_Serial_Number := Next_Serial_Number + 1; + pragma Assert (Next_Serial_Number /= 0); + + if not Single_Lock then + Result := pthread_mutexattr_init (Mutex_Attr'Access); + pragma Assert (Result = 0 or else Result = ENOMEM); + + if Result = 0 then + if Locking_Policy = 'C' then + Result := pthread_mutexattr_setprotocol + (Mutex_Attr'Access, PTHREAD_PRIO_PROTECT); + pragma Assert (Result = 0); + + Result := pthread_mutexattr_setprioceiling + (Mutex_Attr'Access, + Interfaces.C.int (System.Any_Priority'Last)); + pragma Assert (Result = 0); + + elsif Locking_Policy = 'I' then + Result := pthread_mutexattr_setprotocol + (Mutex_Attr'Access, PTHREAD_PRIO_INHERIT); + pragma Assert (Result = 0); + end if; + + Result := pthread_mutex_init (Self_ID.Common.LL.L'Access, + Mutex_Attr'Access); + pragma Assert (Result = 0 or else Result = ENOMEM); + end if; + + if Result /= 0 then + Succeeded := False; + return; + end if; + + Result := pthread_mutexattr_destroy (Mutex_Attr'Access); + pragma Assert (Result = 0); + 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 + Attributes : aliased pthread_attr_t; + Adjusted_Stack_Size : Interfaces.C.size_t; + Result : Interfaces.C.int; + + function Thread_Body_Access is new + Unchecked_Conversion (System.Address, Thread_Body); + + use System.Task_Info; + + begin + if Stack_Size = Unspecified_Size then + Adjusted_Stack_Size := Interfaces.C.size_t (Default_Stack_Size); + + elsif Stack_Size < Minimum_Stack_Size then + Adjusted_Stack_Size := Interfaces.C.size_t (Minimum_Stack_Size); + + else + Adjusted_Stack_Size := Interfaces.C.size_t (Stack_Size); + end if; + + 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, Adjusted_Stack_Size); + pragma Assert (Result = 0); + + -- 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. + + Result := pthread_create + (T.Common.LL.Thread'Access, + Attributes'Access, + Thread_Body_Access (Wrapper), + To_Address (T)); + pragma Assert (Result = 0 or else Result = EAGAIN); + + Succeeded := Result = 0; + + Result := pthread_attr_destroy (Attributes'Access); + pragma Assert (Result = 0); + + Set_Priority (T, Priority); + end Create_Task; + + ------------------ + -- Finalize_TCB -- + ------------------ + + procedure Finalize_TCB (T : Task_ID) is + Result : Interfaces.C.int; + Tmp : Task_ID := T; + Is_Self : constant Boolean := T = Self; + + procedure Free is new + Unchecked_Deallocation (Ada_Task_Control_Block, Task_ID); + + 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; + + Free (Tmp); + + if Is_Self then + Result := pthread_setspecific (ATCB_Key, System.Null_Address); + pragma Assert (Result = 0); + end if; + + end Finalize_TCB; + + --------------- + -- Exit_Task -- + --------------- + + procedure Exit_Task is + begin + -- Mark this task as unknown, so that if Self is called, it won't + -- return a dangling pointer. + + Specific.Set (null); + end Exit_Task; + + ---------------- + -- Abort_Task -- + ---------------- + + procedure Abort_Task (T : Task_ID) is + Result : Interfaces.C.int; + + begin + Result := pthread_kill (T.Common.LL.Thread, + Signal (System.Interrupt_Management.Abort_Task_Interrupt)); + pragma Assert (Result = 0); + end Abort_Task; + + ---------------- + -- Check_Exit -- + ---------------- + + -- Dummy version + + function Check_Exit (Self_ID : ST.Task_ID) return Boolean is + pragma Warnings (Off, Self_ID); + + begin + return True; + end Check_Exit; + + -------------------- + -- Check_No_Locks -- + -------------------- + + function Check_No_Locks (Self_ID : ST.Task_ID) return Boolean is + pragma Warnings (Off, 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 Warnings (Off, T); + pragma Warnings (Off, 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 Warnings (Off, T); + pragma Warnings (Off, Thread_Self); + + begin + return False; + end Resume_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; + + -- Initialize the lock used to synchronize chain of all ATCBs. + + Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level); + + Specific.Initialize (Environment_Task); + + Enter_Task (Environment_Task); + + -- Install the abort-signal handler + + 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); + end if; + end Initialize; + +begin + declare + Result : Interfaces.C.int; + begin + -- Mask Environment task for all signals. The original mask of the + -- Environment task will be recovered by Interrupt_Server task + -- during the elaboration of s-interr.adb. + + System.Interrupt_Management.Operations.Set_Interrupt_Mask + (System.Interrupt_Management.Operations.All_Tasks_Mask'Access); + + -- 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; + end; +end System.Task_Primitives.Operations; diff --git a/lang/gccAda-3.4/files/5netbsdtasinf.ads b/lang/gccAda-3.4/files/5netbsdtasinf.ads new file mode 100644 index 00000000000..fdd93c95beb --- /dev/null +++ b/lang/gccAda-3.4/files/5netbsdtasinf.ads @@ -0,0 +1,143 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S Y S T E M . T A S K _ I N F O -- +-- -- +-- S p e c -- +-- -- +-- -- +-- Copyright (C) 1992-2000 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 2, 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 COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- 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 of the Task_Info pragma. + +-- This is the NetBSD (native) version of this module. + +with System.OS_Interface; +with Unchecked_Deallocation; +package System.Task_Info is +pragma Elaborate_Body; +-- To ensure that a body is allowed + + ----------------------------------------------------- + -- Binding of Tasks to LWPs and LWPs to processors -- + ----------------------------------------------------- + + -- The NetBSD implementation of the GNU Low-Level Interface (GNULLI) + -- implements each Ada task as a NetBSD thread. The NetBSD thread + -- library distributes threads across one or more LWPs (Light Weight + -- Process) that are members of the same process. NetBSD distributes + -- processes and LWPs across the available CPUs on a given machine. The + -- pragma Task_Info provides the mechanism to control the distribution + -- of tasks to LWPs, and LWPs to processors. + + -- Each thread has a number of attributes that dictate it's scheduling. + -- These attributes are: + -- + -- New_LWP: whether a new LWP is created for this thread. + -- + -- Bound_To_LWP: whether the thread is bound to a specific LWP + -- for its entire lifetime. + -- + -- CPU: the CPU number associated to the LWP + -- + + -- The Task_Info pragma: + + -- pragma Task_Info (EXPRESSION); + + -- allows the specification on a task by task basis of a value of type + -- System.Task_Info.Task_Info_Type to be passed to a task when it is + -- created. The specification of this type, and the effect on the task + -- that is created is target dependent. + + -- The Task_Info pragma appears within a task definition (compare the + -- definition and implementation of pragma Priority). If no such pragma + -- appears, then the value Task_Info_Unspecified is passed. If a pragma + -- is present, then it supplies an alternative value. If the argument of + -- the pragma is a discriminant reference, then the value can be set on + -- a task by task basis by supplying the appropriate discriminant value. + + -- Note that this means that the type used for Task_Info_Type must be + -- suitable for use as a discriminant (i.e. a scalar or access type). + + ----------------------- + -- Thread Attributes -- + ----------------------- + + subtype CPU_Number is System.OS_Interface.processorid_t; + + CPU_UNCHANGED : constant CPU_Number := System.OS_Interface.PBIND_QUERY; + -- Do not bind the LWP to a specific processor + + ANY_CPU : constant CPU_Number := System.OS_Interface.PBIND_NONE; + -- Bind the LWP to any processor + + Invalid_CPU_Number : exception; + + type Thread_Attributes (New_LWP : Boolean) is record + Bound_To_LWP : Boolean := True; + case New_LWP is + when False => + null; + when True => + CPU : CPU_Number := CPU_UNCHANGED; + end case; + end record; + + Default_Thread_Attributes : constant Thread_Attributes := (False, True); + + function Unbound_Thread_Attributes + return Thread_Attributes; + + function Bound_Thread_Attributes + return Thread_Attributes; + + function Bound_Thread_Attributes (CPU : CPU_Number) + return Thread_Attributes; + + type Task_Info_Type is access all Thread_Attributes; + + function New_Unbound_Thread_Attributes + return Task_Info_Type; + + function New_Bound_Thread_Attributes + return Task_Info_Type; + + function New_Bound_Thread_Attributes (CPU : CPU_Number) + return Task_Info_Type; + + type Task_Image_Type is access String; + -- Used to generate a meaningful identifier for tasks that are variables + -- and components of variables. + + procedure Free_Task_Image is new + Unchecked_Deallocation (String, Task_Image_Type); + + Unspecified_Task_Info : constant Task_Info_Type := null; + +end System.Task_Info; diff --git a/lang/gccAda-3.4/files/5netbsdtpopse.adb b/lang/gccAda-3.4/files/5netbsdtpopse.adb new file mode 100644 index 00000000000..acf53db789b --- /dev/null +++ b/lang/gccAda-3.4/files/5netbsdtpopse.adb @@ -0,0 +1,52 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- SYSTEM.TASK_PRIMITIVES.OPERATIONS.SELF -- +-- -- +-- B o d y -- +-- -- +-- -- +-- Copyright (C) 1991-1998, Florida State University -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. It is -- +-- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- +-- State University (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is a NetBSD/X86 (native) version of this package. + +separate (System.Task_Primitives.Operations) + +---------- +-- Self -- +---------- + +function Self return Task_ID is + Temp : aliased System.Address; + Result : Interfaces.C.int; + +begin + Result := pthread_getspecific (ATCB_Key, Temp'Unchecked_Access); + pragma Assert (Result = 0); + return To_Task_ID (Temp); +end Self; diff --git a/lang/gccAda-3.4/files/7netbsdtpopsp.adb b/lang/gccAda-3.4/files/7netbsdtpopsp.adb new file mode 100644 index 00000000000..3ad9a82a285 --- /dev/null +++ b/lang/gccAda-3.4/files/7netbsdtpopsp.adb @@ -0,0 +1,100 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- SYSTEM.TASK_PRIMITIVES.OPERATIONS.SPECIFIC -- +-- -- +-- B o d y -- +-- -- +-- -- +-- Copyright (C) 1991-2001, Florida State University -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. It is -- +-- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- +-- State University (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is a NetBSD version of this package. + +separate (System.Task_Primitives.Operations) +package body Specific is + + ------------------ + -- Local Data -- + ------------------ + + -- The followings are logically constants, but need to be initialized + -- at run time. + + ATCB_Key : aliased pthread_key_t; + -- Key used to find the Ada Task_ID associated with a thread + + ---------------- + -- Initialize -- + ---------------- + + procedure Initialize (Environment_Task : Task_ID) is + Result : Interfaces.C.int; + begin + Result := pthread_key_create (ATCB_Key'Access, null); + pragma Assert (Result = 0); + Result := pthread_setspecific (ATCB_Key, To_Address (Environment_Task)); + pragma Assert (Result = 0); + end Initialize; + + --------- + -- Set -- + --------- + + procedure Set (Self_Id : Task_ID) is + Result : Interfaces.C.int; + + begin + Result := pthread_setspecific (ATCB_Key, To_Address (Self_Id)); + pragma Assert (Result = 0); + end Set; + + ---------- + -- Self -- + ---------- + + function Self return Task_ID is + Result : System.Address; + + begin + Result := pthread_getspecific (ATCB_Key); + pragma Assert (Result /= System.Null_Address); + return To_Task_Id (Result); + end Self; + + ------------------- + -- Is_Valid_Task -- + ------------------- + + function Is_Valid_Task return Boolean is + begin + return pthread_getspecific (ATCB_Key) /= System.Null_Address; + end Is_Valid_Task; + + + +end Specific; diff --git a/lang/gccAda-3.4/files/ada b/lang/gccAda-3.4/files/ada new file mode 100644 index 00000000000..9c6ca6e213b --- /dev/null +++ b/lang/gccAda-3.4/files/ada @@ -0,0 +1,8 @@ +#!/bin/sh +# Wrapper to setup environment for using gcc 3.4 Ada compiler +echo $@ +env \ +CC=@GCC_PREFIX@/bin/cc \ +CPP=@GCC_PREFIX@/bin/cpp \ +ADAC=@GCC_PREFIX@/bin/gcc \ +PATH=@GCC_PREFIX@/bin:${PATH} \ diff --git a/lang/gccAda-3.4/files/ada_lwp_self.c b/lang/gccAda-3.4/files/ada_lwp_self.c new file mode 100644 index 00000000000..c4b205c60ca --- /dev/null +++ b/lang/gccAda-3.4/files/ada_lwp_self.c @@ -0,0 +1,6 @@ +/* Binding to _lwp_self for the Ada RTS */ +#include <lwp.h> + +lwpid_t ada_lwp_self(void) { + return _lwp_self(); +} diff --git a/lang/gccAda-3.4/files/adasignal.c b/lang/gccAda-3.4/files/adasignal.c new file mode 100644 index 00000000000..ce6cafc3b7c --- /dev/null +++ b/lang/gccAda-3.4/files/adasignal.c @@ -0,0 +1,34 @@ +#include <signal.h> + +/* <signal.h> defines macros for a number of + signal handling functions. Bindings are + provided here, that expand the macros, + for use by the Ada RTS. */ + +int adasigaddset(sigset_t *set, int signo) { + return sigaddset(set, signo); +} + +int adasigdelset(sigset_t *set, int signo) { + return sigdelset(set, signo); +} + +int adasigemptyset(sigset_t *set) { + return sigemptyset(set); +} + +int adasigfillset(sigset_t *set) { + return sigfillset(set); +} + +int adasigismember(sigset_t *set, int signo) { + return sigismember(set, signo); +} + +int adasigaction(int sig, const struct sigaction *act, struct sigaction *oact) { + return sigaction(sig, act, oact); +} + +int adasigwait(const sigset_t *set, int *sig) { + return sigwait(set, sig); +} diff --git a/lang/gccAda-3.4/files/dummy_pthreads.c b/lang/gccAda-3.4/files/dummy_pthreads.c new file mode 100644 index 00000000000..73a1608b3eb --- /dev/null +++ b/lang/gccAda-3.4/files/dummy_pthreads.c @@ -0,0 +1,30 @@ +#include <pthread.h> +#include <errno.h> + +/* These are some dummy replacements for functions missing in the pthread library */ + +int pthread_mutexattr_setprotocol(pthread_mutexattr_t *attr, int protocol) { + return 0; +} + +int pthread_mutexattr_getprioceiling(const pthread_mutexattr_t *attr, int *prioceiling) { + return 0; +} + +int +pthread_setschedparam(pthread_t thread, int policy, + const struct sched_param *param) +{ + if (param == NULL || policy < SCHED_FIFO || policy > SCHED_RR) + return EINVAL; + if (param->sched_priority > 0 || policy != SCHED_RR) + return ENOTSUP; + return 0; +} + + +int pthread_mutexattr_setprioceiling(pthread_mutexattr_t *attr, + int prioceiling) +{ + return 0; +} diff --git a/lang/gccAda-3.4/files/netbsd64macro.dfs b/lang/gccAda-3.4/files/netbsd64macro.dfs new file mode 100644 index 00000000000..09eec72d054 --- /dev/null +++ b/lang/gccAda-3.4/files/netbsd64macro.dfs @@ -0,0 +1,301 @@ +-- MACRO.DFS +-- THIS FILE CONTAINS THE MACRO DEFINITIONS USED IN THE ACVC TESTS. +-- THESE DEFINITIONS ARE USED BY THE ACVC TEST PRE-PROCESSOR, +-- MACROSUB. MACROSUB WILL CALCULATE VALUES FOR THOSE MACRO SYMBOLS +-- WHOSE DEFINITIONS DEPEND ON THE VALUE OF MAX_IN_LEN (NAMELY, THE +-- VALUES OF THE MACRO SYMBOLS BIG_ID1, BIG_ID2, BIG_ID3, BIG_ID4, +-- BIG_STRING1, BIG_STRING2, MAX_STRING_LITERAL, BIG_INT_LIT, BIG_REAL_LIT, +-- AND BLANKS). THEREFORE, ANY VALUES GIVEN IN THIS FILE FOR THOSE +-- MACRO SYMBOLS WILL BE IGNORED BY MACROSUB. + +-- NOTE: AS REQUIRED BY THE MACROSUB PROGRAM, THE FIRST MACRO DEFINED +-- IN THIS FILE IS $MAX_IN_LEN. THE NEXT 5 MACRO DEFINITIONS +-- ARE FOR THOSE MACRO SYMBOLS THAT DEPEND ON THE VALUE OF +-- MAX_IN_LEN. THESE ARE IN ALPHABETIC ORDER. FOLLOWING THESE +-- ARE 36 MORE DEFINITIONS, ALSO IN ALPHABETIC ORDER. + +-- EACH DEFINITION IS ACCORDING TO THE FOLLOWING FORMAT: + +-- A. A NUMBER OF LINES PRECEDED BY THE ADA COMMENT DELIMITER, --. +-- THE FIRST OF THESE LINES CONTAINS THE MACRO SYMBOL AS IT APPEARS +-- IN THE TEST FILES (WITH THE DOLLAR SIGN). THE NEXT FEW "COMMENT" +-- LINES CONTAIN A DESCRIPTION OF THE VALUE TO BE SUBSTITUTED. +-- THE REMAINING "COMMENT" LINES, THE FIRST OF WHICH BEGINS WITH THE +-- WORDS "USED IN: " (NO QUOTES), CONTAIN A LIST OF THE TEST FILES +-- (WITHOUT THE .TST EXTENSION) IN WHICH THE MACRO SYMBOL APPEARS. +-- EACH TEST FILE NAME IS PRECEDED BY ONE OR MORE BLANKS. +-- B. A LINE, WITHOUT THE COMMENT DELIMITER, CONSISTING OF THE +-- IDENTIFIER (WITHOUT THE DOLLAR SIGN) OF THE MACRO SYMBOL, +-- FOLLOWED BY A SPACE OR TAB, FOLLOWED BY THE VALUE TO BE +-- SUBSTITUTED. IN THE DISTRIBUTION FILE, A SAMPLE VALUE IS +-- PROVIDED; THIS VALUE MUST BE REPLACED BY A VALUE APPROPRIATE TO +-- THE IMPLEMENTATION. + +-- DEFINITIONS ARE SEPARATED BY ONE OR MORE EMPTY LINES. +-- THE LIST OF DEFINITIONS BEGINS AFTER THE FOLLOWING EMPTY LINE. + +-- $MAX_IN_LEN +-- AN INTEGER LITERAL GIVING THE MAXIMUM LENGTH PERMITTED BY THE +-- COMPILER FOR A LINE OF ADA SOURCE CODE (NOT INCLUDING AN END-OF-LINE +-- CHARACTER). +-- USED IN: A26007A +MAX_IN_LEN 200 + +-- $MAX_STRING_LITERAL +-- A STRING LITERAL CONSISTING OF $MAX_IN_LEN CHARACTERS (INCLUDING THE +-- QUOTE CHARACTERS). +-- USED IN: A26007A +MAX_STRING_LITERAL "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" + +-- $BIG_ID1 +-- AN IDENTIFIER IN WHICH THE NUMBER OF CHARACTERS IS $MAX_IN_LEN. +-- THE MACROSUB PROGRAM WILL SUPPLY AN IDENTIFIER IN WHICH THE +-- LAST CHARACTER IS '1' AND ALL OTHERS ARE 'A'. +-- USED IN: C23003A C23003B C23003G C23003I +-- C35502D C35502F +BIG_ID1 AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA1 + +-- $BIG_ID2 +-- AN IDENTIFIER IN WHICH THE NUMBER OF CHARACTERS IS $MAX_IN_LEN, +-- DIFFERING FROM $BIG_ID1 ONLY IN THE LAST CHARACTER. THE MACROSUB +-- PROGRAM WILL USE '2' AS THE LAST CHARACTER. +-- USED IN: C23003A C23003B B23003F C23003G C23003I +BIG_ID2 AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA2 + +-- $BIG_ID3 +-- AN IDENTIFIER IN WHICH THE NUMBER OF CHARACTERS IS $MAX_IN_LEN. +-- MACROSUB WILL USE '3' AS THE "MIDDLE" CHARACTER; ALL OTHERS ARE 'A'. +-- USED IN: C23003A C23003B C23003G C23003I +BIG_ID3 AAAAAAAAAAAAAAAAAAAAAAAAAAAAA3AAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + +-- $BIG_ID4 +-- AN IDENTIFIER IN WHICH THE NUMBER OF CHARACTERS IS $MAX_IN_LEN, +-- DIFFERING FROM $BIG_ID3 ONLY IN THE MIDDLE CHARACTER. MACROSUB +-- WILL USE '4' AS THE MIDDLE CHARACTER. +-- USED IN: C23003A C23003B C23003G C23003I +BIG_ID4 AAAAAAAAAAAAAAAAAAAAAAAAAAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + +-- $BIG_STRING1 +-- A STRING LITERAL (WITH QUOTES) WHOSE CATENATION WITH $BIG_STRING2 +-- ($BIG_STRING1 & $BIG_STRING2) PRODUCES THE IMAGE OF $BIG_ID1. +-- USED IN: C35502D C35502F +BIG_STRING1 "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" + +-- $BIG_STRING2 +-- A STRING LITERAL (WITH QUOTES) WHOSE CATENATION WITH $BIG_STRING1 +-- ($BIG_STRING1 & $BIG_STRING2) PRODUCES THE IMAGE OF $BIG_ID1. +-- USED IN: C35502D C35502F +BIG_STRING2 "AAAAAAAAAAAAAAAAAAAAAAAAAAAAA1" + +-- $BLANKS +-- A SEQUENCE OF ($MAX_IN_LEN - 20) BLANKS. +-- USED IN: B22001A B22001B B22001C B22001D B22001E B22001F +-- B22001G B22001I B22001J B22001K B22001L B22001M +-- B22001N +-- < LIMITS OF SAMPLE SHOWN BY ANGLE BRACKETS > +BLANKS + +-- $ACC_SIZE +-- AN INTEGER LITERAL WHOSE VALUE IS THE MINIMUM NUMBER OF BITS +-- SUFFICIENT TO HOLD ANY VALUE OF AN ACCESS TYPE. +-- USED IN: CD2A83C BD2A02A +ACC_SIZE 64 + +-- $ALIGNMENT +-- A VALUE THAT IS LEGITIMATE FOR USE IN A RECORD ALIGNMENT CLAUSE. +-- USED IN: CD4041A BD4006A +ALIGNMENT 4 + +-- $COUNT_LAST +-- AN INTEGER LITERAL WHOSE VALUE IS TEXT_IO.COUNT'LAST. +-- USED IN: CE3002B +COUNT_LAST 2147483647 + +-- $ENTRY_ADDRESS +-- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A TASK ENTRY +-- (I.E., FOR AN INTERRUPT) FOR THIS IMPLEMENTATION. +-- USED IN: SPPRT13SP +ENTRY_ADDRESS ENTRY_ADDR + +-- $ENTRY_ADDRESS1 +-- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A TASK ENTRY +-- (I.E., FOR AN INTERRUPT) FOR THIS IMPLEMENTATION. THE ADDRESS +-- MUST BE DISTINCT FROM THAT USED IN $ENTRY_ADDRESS. +-- USED IN: SPPRT13SP +ENTRY_ADDRESS1 ENTRY_ADDR1 + +-- $ENTRY_ADDRESS2 +-- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A TASK ENTRY +-- (I.E., FOR AN INTERRUPT) FOR THIS IMPLEMENTATION. THE ADDRESS +-- MUST BE DISTINCT FROM THOSE USED IN $ENTRY_ADDRESS +-- AND $ENTRY_ADDRESS1. +-- USED IN: SPPRT13SP +ENTRY_ADDRESS2 ENTRY_ADDR2 + +-- $FIELD_LAST +-- AN INTEGER LITERAL WHOSE VALUE IS TEXT_IO.FIELD'LAST. +-- USED IN: CE3002C +FIELD_LAST 255 + +-- $FORM_STRING +-- A STRING LITERAL SPECIFYING THAT THE EXTERNAL FILE MEETS BOTH +-- CONDITIONS: (1) THERE IS A VALUE OF TYPE TEXT_IO.COUNT THAT IS NOT +-- AN APPROPRIATE LINE-LENGTH FOR THE FILE, (2) THERE IS A VALUE +-- OF TYPE TEXT_IO.COUNT THAT IS NOT AN APPROPRIATE PAGE-LENGTH +-- FOR THE FILE. +-- IF IT IS NOT POSSIBLE TO SATISFY BOTH CONDITIONS, THEN SUBSTITUTE +-- A STRING LITERAL SPECIFYING THAT THE EXTERNAL FILE SATISFIES ONE +-- OF THE CONDITIONS. IF IT IS NOT POSSIBLE TO SATISFY EITHER CONDITION, +-- THEN SUBSTITUTE THE NULL STRING (""). +-- USED IN: CE3304A +FORM_STRING "" + +-- $FORM_STRING2 +-- A STRING LITERAL SPECIFYING THAT THE CAPACITY OF THE FILE IS +-- RESTRICTED TO 4096 CHARACTERS OR LESS. IF THE IMPLEMENTATION +-- CANNOT RESTRICT FILE CAPACITY, $FORM_STRING2 SHOULD EQUAL +-- "CANNOT_RESTRICT_FILE_CAPACITY". +-- USED IN: CE2203A CE2403A +FORM_STRING2 "CANNOT_RESTRICT_FILE_CAPACITY" + +-- $GREATER_THAN_DURATION +-- A REAL LITERAL WHOSE VALUE (NOT SUBJECT TO ROUND-OFF ERROR +-- IF POSSIBLE) LIES BETWEEN DURATION'BASE'LAST AND DURATION'LAST. IF +-- NO SUCH VALUES EXIST, USE A VALUE IN DURATION'RANGE. +-- USED IN: C96005B +GREATER_THAN_DURATION 86_000.0 + + + + +-- $ILLEGAL_EXTERNAL_FILE_NAME1 +-- AN ILLEGAL EXTERNAL FILE NAME (E.G., TOO LONG, CONTAINING INVALID +-- CHARACTERS, CONTAINING WILD-CARD CHARACTERS, OR SPECIFYING A +-- NONEXISTENT DIRECTORY). +-- USED IN: CE2102C CE2102H CE2103A CE2103B CE3102B CE3107A +ILLEGAL_EXTERNAL_FILE_NAME1 /NODIRECTORY/FILENAME + +-- $ILLEGAL_EXTERNAL_FILE_NAME2 +-- AN ILLEGAL EXTERNAL FILE NAME, DIFFERENT FROM $ILLEGAL_EXTERNAL_FILE_NAME1. +-- USED IN: CE2102C CE2102H CE2103A CE2103B CE3102B +ILLEGAL_EXTERNAL_FILE_NAME2 /@@/@@/@@\@@\@@\@@ + +-- $INAPPROPRIATE_LINE_LENGTH +-- A LITERAL OF TYPE COUNT THAT IS INAPPROPRIATE AS THE LINE-LENGTH +-- FOR THE EXTERNAL FILE. IF THERE IS NO SUCH VALUE, THEN USE -1. +-- USED IN: CE3304A +INAPPROPRIATE_LINE_LENGTH -1 + +-- $INAPPROPRIATE_PAGE_LENGTH +-- A LITERAL OF TYPE COUNT THAT IS INAPPROPRIATE AS THE PAGE-LENGTH +-- FOR THE EXTERNAL FILE. IF THERE IS NO SUCH VALUE, THEN USE -1. +-- USED IN: CE3304A +INAPPROPRIATE_PAGE_LENGTH -1 + +-- $INTEGER_FIRST +-- AN INTEGER LITERAL, WITH SIGN, WHOSE VALUE IS INTEGER'FIRST. +-- THE LITERAL MUST NOT INCLUDE UNDERSCORES OR LEADING OR TRAILING +-- BLANKS. +-- USED IN: C35503F B54B01B +INTEGER_FIRST -2147483648 + +-- $INTEGER_LAST +-- AN INTEGER LITERAL WHOSE VALUE IS INTEGER'LAST. THE LITERAL MUST +-- NOT INCLUDE UNDERSCORES OR LEADING OR TRAILING BLANKS. +-- USED IN: C35503F B54B01B +INTEGER_LAST 2147483647 + + +-- $LESS_THAN_DURATION +-- A REAL LITERAL (WITH SIGN) WHOSE VALUE (NOT SUBJECT TO +-- ROUND-OFF ERROR IF POSSIBLE) LIES BETWEEN DURATION'BASE'FIRST AND +-- DURATION'FIRST. IF NO SUCH VALUES EXIST, USE A VALUE IN +-- DURATION'RANGE. +-- USED IN: C96005B +LESS_THAN_DURATION -86_400.0 + + +-- $MACHINE_CODE_STATEMENT +-- A VALID MACHINE CODE STATEMENT AS SPECIFIED IN THE PACKAGE +-- MACHINE_CODE. IF THE IMPLEMENTATION DOES NOT SUPPORT MACHINE +-- CODE THEN USE THE ADA NULL STATEMENT (I.E. NULL; ). +-- USED IN: AD8011A BD8001A BD8002A BD8004A BD8004B +MACHINE_CODE_STATEMENT Asm_Insn'(Asm ("nop")); + +-- $MAX_INT +-- AN INTEGER LITERAL WHOSE VALUE IS SYSTEM.MAX_INT. +-- THE LITERAL MUST NOT INCLUDE UNDERSCORES OR LEADING OR TRAILING +-- BLANKS. +-- USED IN: C35503D C35503F C4A007A +MAX_INT 9223372036854775807 + + +-- $MIN_INT +-- AN INTEGER LITERAL, WITH SIGN, WHOSE VALUE IS SYSTEM.MIN_INT. +-- THE LITERAL MUST NOT CONTAIN UNDERSCORES OR LEADING OR TRAILING +-- BLANKS. +-- USED IN: C35503D C35503F +MIN_INT -9223372036854775808 + +-- $NAME +-- THE NAME OF A PREDEFINED INTEGER TYPE OTHER THAN INTEGER, +-- SHORT_INTEGER, OR LONG_INTEGER. +-- (IMPLEMENTATIONS WHICH HAVE NO SUCH TYPES SHOULD USE AN UNDEFINED +-- IDENTIFIER SUCH AS NO_SUCH_TYPE_AVAILABLE.) +-- USED IN: C45231D CD7101G +NAME LONG_LONG_INTEGER + +-- $OPTIONAL_DISC +-- A DISCRIMINANT USED AS THE DISCRIMINANT PART OF $RECORD_NAME. +-- IF MACHINE CODE INSERTIONS ARE NOT SUPPORTED THEN SUBSTITUTE +-- NO_SUCH_MACHINE_CODE_DISC. +-- USED IN: BD8002A +OPTIONAL_DISC + +-- $RECORD_DEFINITION +-- THE RECORD TYPE DEFINITION (WITH FINAL SEMICOLON) FOR THE TYPE THAT +-- WAS USED IN THE MACRO $RECORD_NAME, AS DECLARED IN PACKAGE +-- MACHINE_CODE. IF THE IMPLEMENTATION DOES NOT SUPPORT MACHINE CODE, +-- THEN USE A NULL RECORD DEFINITION +-- USED IN: BD8002A +RECORD_DEFINITION RECORD ASM : STRING (1..4); END RECORD; + +-- $RECORD_NAME +-- A VALID RECORD TYPE NAME THAT IS DEFINED IN PACKAGE MACHINE_CODE. +-- IF THE IMPLEMENTATION DOES NOT SUPPORT MACHINE CODE THEN +-- USE THE NAME "NO_SUCH_MACHINE_CODE_TYPE" +-- USED IN: BD8002A +RECORD_NAME Asm_Insn + +-- $TASK_SIZE +-- AN INTEGER LITERAL WHOSE VALUE IS THE NUMBER OF BITS REQUIRED TO +-- HOLD A TASK OBJECT. +-- USED IN: CD2A91C +TASK_SIZE 64 + +-- $TASK_STORAGE_SIZE +-- THE NUMBER OF STORAGE UNITS REQUIRED FOR A TASK ACTIVATION. +-- USED IN: BD2C01D BD2C02A BD2C03A C87B62D CD1009K CD1009T +-- CD1009U CD1C03E CD1C06A CD2C11A CC1225A CD2C11D +TASK_STORAGE_SIZE 65536 + +-- $VARIABLE_ADDRESS +-- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A VARIABLE FOR THIS +-- IMPLEMENTATION. +-- USED IN: SPPRT13SP +VARIABLE_ADDRESS VAR_ADDR + +-- $VARIABLE_ADDRESS1 +-- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A VARIABLE FOR THIS +-- IMPLEMENTATION. THE ADDRESS MUST BE DISTINCT FROM THAT USED IN +-- THE MACRO $VARIABLE_ADDRESS. +-- USED IN: SPPRT13SP +VARIABLE_ADDRESS1 VAR_ADDR1 + +-- $VARIABLE_ADDRESS2 +-- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A VARIABLE FOR THIS +-- IMPLEMENTATION. THE ADDRESS MUST BE DISTINCT FROM THOSE USED IN +-- THE MACROS $VARIABLE_ADDRESS AND $VARIABLE_ADDRESS1. +-- USED IN: SPPRT13SP +VARIABLE_ADDRESS2 VAR_ADDR2 + diff --git a/lang/gccAda-3.4/patches/patch-ae b/lang/gccAda-3.4/patches/patch-ae new file mode 100644 index 00000000000..0ba04f4bd2e --- /dev/null +++ b/lang/gccAda-3.4/patches/patch-ae @@ -0,0 +1,59 @@ +$NetBSD: patch-ae,v 1.1.1.1 2004/06/01 18:32:04 shannonjr Exp $ + +--- gcc/ada/Makefile.in.orig 2004-01-26 14:57:32.000000000 -0700 ++++ gcc/ada/Makefile.in +@@ -1292,6 +1292,54 @@ ifeq ($(strip $(filter-out %x86_64 linux + LIBRARY_VERSION := $(LIB_VERSION) + endif + ++ifeq ($(strip $(filter-out %86 netbsdelf%,$(arch) $(osys))),) ++ LIBGNAT_TARGET_PAIRS = \ ++ a-numaux.adb<86numaux.adb \ ++ a-numaux.ads<86numaux.ads \ ++ a-intnam.ads<4netbsdintnam.ads \ ++ s-inmaop.adb<7sinmaop.adb \ ++ s-intman.adb<5netbsdintman.adb \ ++ s-mastop.adb<5omastop.adb \ ++ s-osinte.adb<5netbsdosinte.adb \ ++ s-osinte.ads<5netbsdosinte.ads \ ++ s-osprim.adb<5posprim.adb \ ++ s-parame.adb<5netbsdparame.adb \ ++ s-taprop.adb<5netbsdtaprop.adb \ ++ s-tasinf.ads<5ftasinf.ads \ ++ s-taspri.ads<7staspri.ads \ ++ s-tpopse.adb<5netbsdtpopse.adb \ ++ s-tpopsp.adb<7netbsdtpopsp.adb \ ++ system.ads<5netbsdsystem.ads ++ ++ THREADSLIB=-pthread ++ EXTRA_GNATRTL_TASKING_OBJS=adasignal.o ada_lwp_self.o dummy_pthreads.o ++ ++endif ++ ++ifeq ($(strip $(filter-out %x86_64 netbsdelf%,$(arch) $(osys))),) ++ LIBGNAT_TARGET_PAIRS = \ ++ a-numaux.adb<86numaux.adb \ ++ a-numaux.ads<86numaux.ads \ ++ a-intnam.ads<4netbsdintnam.ads \ ++ s-inmaop.adb<7sinmaop.adb \ ++ s-intman.adb<5netbsdintman.adb \ ++ s-osinte.adb<5netbsd64osinte.adb \ ++ s-osinte.ads<5netbsd64osinte.ads \ ++ s-osprim.adb<5posprim.adb \ ++ s-parame.adb<5netbsdparame.adb \ ++ s-taprop.adb<5netbsdtaprop.adb \ ++ s-tasinf.ads<5ftasinf.ads \ ++ s-taspri.ads<7staspri.ads \ ++ s-tpopse.adb<5netbsdtpopse.adb \ ++ s-tpopsp.adb<7netbsdtpopsp.adb \ ++ system.ads<5netbsd64system.ads ++ ++ THREADSLIB=-pthread ++ EXTRA_GNATRTL_TASKING_OBJS=adasignal.o ada_lwp_self.o dummy_pthreads.o ++ ++endif ++ ++ + # The runtime library for gnat comprises two directories. One contains the + # Ada source files that the compiler (gnat1) needs -- these files are listed + # by ADA_INCLUDE_SRCS -- and the other contains the object files and their diff --git a/lang/gccAda-3.4/patches/patch-af b/lang/gccAda-3.4/patches/patch-af new file mode 100644 index 00000000000..4c24d7da17f --- /dev/null +++ b/lang/gccAda-3.4/patches/patch-af @@ -0,0 +1,13 @@ +$NetBSD: patch-af,v 1.1.1.1 2004/06/01 18:32:04 shannonjr Exp $ + +--- gcc/ada/cstreams.c.orig 2003-11-18 03:00:42.000000000 -0700 ++++ gcc/ada/cstreams.c +@@ -175,7 +175,7 @@ __gnat_full_name (char *nam, char *buffe + #elif defined (MSDOS) + _fixpath (nam, buffer); + +-#elif defined (sgi) || defined (__FreeBSD__) ++#elif defined (sgi) || defined (__FreeBSD__) || defined(__NetBSD__) + + /* 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/lang/gccAda-3.4/patches/patch-ag b/lang/gccAda-3.4/patches/patch-ag new file mode 100644 index 00000000000..d80f3575416 --- /dev/null +++ b/lang/gccAda-3.4/patches/patch-ag @@ -0,0 +1,22 @@ +$NetBSD: patch-ag,v 1.1.1.1 2004/06/01 18:32:04 shannonjr Exp $ + +--- gcc/ada/adaint.c.orig 2003-12-03 04:47:52.000000000 -0700 ++++ gcc/ada/adaint.c +@@ -671,6 +671,8 @@ __gnat_open_new_temp (char *path, int fm + return mkstemp (path); + #elif defined (__Lynx__) + mktemp (path); ++#elif defined(__NetBSD__) ++ return mkstemp (path); + #else + if (mktemp (path) == NULL) + return -1; +@@ -742,7 +744,7 @@ __gnat_tmp_name (char *tmp_filename) + free (pname); + } + +-#elif defined (linux) || defined (__FreeBSD__) ++#elif defined (linux) || defined (__FreeBSD__) || defined(__NetBSD__) + #define MAX_SAFE_PATH 1000 + char *tmpdir = getenv ("TMPDIR"); + diff --git a/lang/gccAda-3.4/patches/patch-ba b/lang/gccAda-3.4/patches/patch-ba new file mode 100644 index 00000000000..1c85b8677c7 --- /dev/null +++ b/lang/gccAda-3.4/patches/patch-ba @@ -0,0 +1,32 @@ +$NetBSD: patch-ba,v 1.1.1.1 2004/06/01 18:32:04 shannonjr Exp $ + +--- gcc/ada/5posprim.adb.orig 2003-10-21 15:41:52.000000000 +0200 ++++ gcc/ada/5posprim.adb 2004-04-26 17:00:57.000000000 +0200 +@@ -42,8 +42,8 @@ + -- the spec. + + type struct_timeval is record +- tv_sec : Integer; +- tv_usec : Integer; ++ tv_sec : Long_Integer; ++ tv_usec : Long_Integer; + end record; + pragma Convention (C, struct_timeval); + +@@ -102,14 +102,14 @@ + + if Rel_Time > 0.0 then + loop +- timeval.tv_sec := Integer (Rel_Time); ++ timeval.tv_sec := Long_Integer (Rel_Time); + + if Duration (timeval.tv_sec) > Rel_Time then + timeval.tv_sec := timeval.tv_sec - 1; + end if; + + timeval.tv_usec := +- Integer ((Rel_Time - Duration (timeval.tv_sec)) * 10#1#E6); ++ Long_Integer ((Rel_Time - Duration (timeval.tv_sec)) * 10#1#E6); + + C_select (timeout => timeval'Unchecked_Access); + Check_Time := Clock; diff --git a/lang/gccAda-3.4/patches/patch-bb b/lang/gccAda-3.4/patches/patch-bb new file mode 100644 index 00000000000..12503b3ca91 --- /dev/null +++ b/lang/gccAda-3.4/patches/patch-bb @@ -0,0 +1,13 @@ +$NetBSD: patch-bb,v 1.1.1.1 2004/06/01 18:32:04 shannonjr Exp $ + +--- gcc/ada/init.c.orig 2004-04-26 21:32:09.000000000 +0200 ++++ gcc/ada/init.c 2004-04-26 21:33:31.000000000 +0200 +@@ -1840,7 +1840,7 @@ + void + __gnat_init_float (void) + { +-#if defined (__i386__) || defined (i386) ++#if defined (__i386__) || defined (i386) || defined(__x86_64__) + + /* This is used to properly initialize the FPU on an x86 for each + process thread. */ diff --git a/lang/gccAda-3.4/patches/patch-varasm b/lang/gccAda-3.4/patches/patch-varasm new file mode 100644 index 00000000000..0a834fbeab1 --- /dev/null +++ b/lang/gccAda-3.4/patches/patch-varasm @@ -0,0 +1,13 @@ +$NetBSD: patch-varasm,v 1.1.1.1 2004/06/01 18:32:04 shannonjr Exp $ + +--- gcc/varasm.c.orig 2004-04-14 15:14:08.000000000 -0600 ++++ gcc/varasm.c +@@ -2331,6 +2331,7 @@ compare_constant (const tree t1, const t + case NOP_EXPR: + case CONVERT_EXPR: + case NON_LVALUE_EXPR: ++ case VIEW_CONVERT_EXPR: + return compare_constant (TREE_OPERAND (t1, 0), TREE_OPERAND (t2, 0)); + + default: + diff --git a/lang/gccAda-3.4/preconfigure.mk b/lang/gccAda-3.4/preconfigure.mk new file mode 100644 index 00000000000..f7a1379ddd9 --- /dev/null +++ b/lang/gccAda-3.4/preconfigure.mk @@ -0,0 +1,9 @@ + # Create compiler driver scripts in ${WRKDIR}. + (cd ${BUILDLINK_PREFIX.gccAda-3.4.0}/bin && bin_files=`${FIND} . -type f \( -perm -0100 \)` && \ + cd ${WRKDIR}/.gcc/bin && \ + for _target_ in $${bin_files} ; do \ + ${ECHO} '#!${TOOLS_SHELL}' > $${_target_} && \ + ${ECHO} -n "exec ${LOCALBASE}/gccAda-3.4.0/bin/$${_target_}" >> $${_target_} && \ + ${ECHO} ' "$$@"' >> $${_target_} && \ + ${CHMOD} +x $${_target_}; \ + done ) |