kpriv/pkgsrc-wip
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

This is the Ada compiler from the gcc 3.4 compiler collection. All but 8 of

Browse source 
the tests in the Ada compiler valication suite (acats) pass including all of
the chapter 9 (tasking) tests when run under NetBSD-CURRENT on Intel x86
hardware.
This commit is contained in:
John R. Shannon 2004-01-07 22:49:46 +00:00 committed by Thomas Klausner
parent 2d3c619eee
commit df369ab74c
23 changed files with 3037 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
gcc-3.4-ada/DESCR Normal file
View file

@ -0,0 +1,7 @@
This is the Ada compiler from the
gcc 3.4 compiler suite. The gcc compiler
suite is experimental; it has not been released.
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.

75
gcc-3.4-ada/Makefile Normal file
View file

@ -0,0 +1,75 @@
# $NetBSD: Makefile,v 1.1 2004/01/07 22:49:46 johnrshannon Exp $
#
SNAPDATE= 20040107
GCC_VERSION= 3.4
DISTNAME= gcc-${GCC_VERSION}-ada
WRKSRC= ${WRKDIR}/gcc-${GCC_VERSION}-${SNAPDATE}
CATEGORIES= lang
MASTER_SITES= ftp://gcc.gnu.org/pub/gcc/snapshots/${GCC_VERSION}-${SNAPDATE}/ \
ftp://mirrors.rcn.net/pub/sourceware/gcc/snapshots/${GCC_VERSION}-${SNAPDATE}/
DISTFILES= gcc-${GCC_VERSION}-${SNAPDATE}.tar.bz2
MAINTAINER= john@johnrshannon.com
HOMEPAGE= http://www.gnu.org/software/gcc/gcc.html
COMMENT= This is the developmental gcc 3.4 Ada compiler
USE_BUILDLINK2= YES
USE_PKGINSTALL= YES
USE_GMAKE= YES
HAS_CONFIGURE= YES
PTHREAD_OPTS+= require native
CONFIGURE_ARGS+= --enable-languages=ada
EXTRA_ENV+= ADAC=/usr/pkg/gcc3/bin/gcc
CONFIGURE_ENV+= ${EXTRA_ENV}
MAKE_ENV+= ${EXTRA_ENV}
# Make location overridable, to allow ping-pong bootstraps.
GCC3_DEFAULT_SUBPREFIX= gcc3devel
GCC3_INSTALLTO_SUBPREFIX?= ${GCC3_DEFAULT_SUBPREFIX}
.if ${GCC3_INSTALLTO_SUBPREFIX} != ${GCC3_DEFAULT_SUBPREFIX}
GCC3_PKGMODIF= _${GCC3_INSTALLTO_SUBPREFIX}
.endif
GCC_SUBPREFIX= ${GCC3_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}
GCC_ARCHSUBDIR= ${GCC_SUBPREFIX}/lib/gcc/${GCC_PLATFORM}/${GCC_VERSION}
GCC_ARCHDIR= ${PREFIX}/${GCC_ARCHSUBDIR}
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 )
post-buildlink:
${LN} -sf ${ADA_BOOT_GNATBIND} ${BUILDLINK_DIR}/bin
do-configure:
(test -d ${WRKDIR}/obj || mkdir ${WRKDIR}/obj && cd ${WRKDIR}/obj && ${SETENV} ${MAKE_ENV} ${WRKSRC}/configure ${CONFIGURE_ARGS})
do-build:
(cd ${WRKDIR}/obj && ${GMAKE} bootstrap && cd gcc && ${GMAKE} gnatlib_and_tools)
do-test:
(cd ${WRKDIR}/obj && ${GMAKE} -k check)
do-install:
(cd ${WRKDIR}/obj && ${SETENV} ${MAKE_ENV} ${GMAKE} install && test -f ${GCC_PREFIX}/bin/gcc || ln -s ${GCC_PREFIX}/bin/gcc ${GCC_PREFIX}/bin/cc)
.include "../../mk/bsd.prefs.mk"
.include "../../mk/pthread.buildlink2.mk"
.include "../../mk/bsd.pkg.mk"

1
gcc-3.4-ada/PLIST Normal file
View file

@ -0,0 +1 @@
@comment $NetBSD: PLIST,v 1.1 2004/01/07 22:49:46 johnrshannon Exp $

6
gcc-3.4-ada/TODO Normal file
View file

@ -0,0 +1,6 @@
acats is the Ada compiler validation suite:
=== acats Summary ===
# of expected passes 2314
# of unexpected failures 8
*** FAILURES: c34005a c34005d c34005g c34005j cc3601a cxb3010 cxb3014 cxb3015

8
gcc-3.4-ada/distinfo Normal file
View file

@ -0,0 +1,8 @@
$NetBSD: distinfo,v 1.1 2004/01/07 22:49:46 johnrshannon Exp $
SHA1 (gcc-3.4-20040107.tar.bz2) = 1bfa895b64eba17c69e1fd6648f65d7f874518cd
Size (gcc-3.4-20040107.tar.bz2) = 24737287 bytes
SHA1 (patch-Make-lang.in) = da39a3ee5e6b4b0d3255bfef95601890afd80709
SHA1 (patch-ae) = 68aeb0825b36f07ca11879a2b3d9fcedc1ae3eb5
SHA1 (patch-af) = cdd6b0d13c557996cb6582d7fa5dc651d37ee0ee
SHA1 (patch-ag) = beee5294d387faafa640ab048823499da629e715

117
gcc-3.4-ada/files/4netbsdintnam.ads Normal file
View file

@ -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;

274
gcc-3.4-ada/files/5netbsdintman.adb Normal file
View file

@ -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;

115
gcc-3.4-ada/files/5netbsdosinte.adb Normal file
View file

@ -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 => time_t (Long_Long_Integer (F * 10#1#E6)));
end To_Timeval;
end System.OS_Interface;

625
gcc-3.4-ada/files/5netbsdosinte.ads Normal file
View file

@ -0,0 +1,625 @@
------------------------------------------------------------------------------
-- --
-- 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;
-----------
-- 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&LTOSTOP)
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 long;
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 long;
type time_t is new long;
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 : time_t;
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;

79
gcc-3.4-ada/files/5netbsdparame.adb Normal file
View file

@ -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;

150
gcc-3.4-ada/files/5netbsdsystem.ads Normal file
View file

@ -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;

1136
gcc-3.4-ada/files/5netbsdtaprop.adb Normal file
View file

File diff suppressed because it is too large Load diff

143
gcc-3.4-ada/files/5netbsdtasinf.ads Normal file
View file

@ -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;

52
gcc-3.4-ada/files/5netbsdtpopse.adb Normal file
View file

@ -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;

100
gcc-3.4-ada/files/7netbsdtpopsp.adb Normal file
View file

@ -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;

6
gcc-3.4-ada/files/ada_lwp_self.c Normal file
View file

@ -0,0 +1,6 @@
/* Binding to _lwp_self for the Ada RTS */
#include <lwp.h>
lwpid_t ada_lwp_self(void) {
return _lwp_self();
}

34
gcc-3.4-ada/files/adasignal.c Normal file
View file

@ -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);
}

30
gcc-3.4-ada/files/dummy_pthreads.c Normal file
View file

@ -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;
}

7
gcc-3.4-ada/files/gcc3.mk Normal file
View file

@ -0,0 +1,7 @@
# $NetBSD: gcc3.mk,v 1.1 2004/01/07 22:49:46 johnrshannon Exp $
#
# make configuration file for @PKGNAME@
CC= @GCC_PREFIX@/bin/cc
CPP= @GCC_PREFIX@/bin/cpp
ADAC= @GCC_PREFIX@/bin/gcc

0
gcc-3.4-ada/patches/patch-Make-lang.in Normal file
View file

37
gcc-3.4-ada/patches/patch-ae Normal file
View file

@ -0,0 +1,37 @@
$NetBSD: patch-ae,v 1.1 2004/01/07 22:49:47 johnrshannon Exp $
--- gcc/ada/Makefile.in.orig 2003-12-15 04:51:00.000000000 -0700
+++ gcc/ada/Makefile.in
@@ -1287,6 +1287,32 @@ 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_LIBGNAT_SRCS=adasignal.c ada_lwp_self.c dummy_pthreads.c
+ 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

13
gcc-3.4-ada/patches/patch-af Normal file
View file

@ -0,0 +1,13 @@
$NetBSD: patch-af,v 1.1 2004/01/07 22:49:47 johnrshannon 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

22
gcc-3.4-ada/patches/patch-ag Normal file
View file

@ -0,0 +1,22 @@
$NetBSD: patch-ag,v 1.1 2004/01/07 22:49:47 johnrshannon 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");