kpriv/freebsd-ports
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Upgrade to 3.09. This port is no longer broken.

Browse source 
Note you need an existing gnat compiler to build this.  (A package will do.)

PR:		3687
Submitted by:	Maurice Castro <maurice@planet.serc.rmit.edu.au> and
		Daniel M. Eischen <deischen@iworks.InterWorks.org>
This commit is contained in:
Satoshi Asami 1997-09-25 08:48:00 +00:00
parent 9b7d271eca
commit 31f08be6a3
Notes: svn2git 2021-03-31 03:12:20 +00:00 
svn path=/head/; revision=8025
16 changed files with 3104 additions and 304 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

122
lang/gnat/Makefile
View file

@ -1,61 +1,99 @@
# -*- Mode: Makefile -*-
# Port of: GNU Ada gnat
# Version required: 2.03
# Space required: >= 23MB
# New ports collection makefile for: GNU Ada gnat
# Version required: 3.09
# Date created: Sat Mar 18 02:16:45 1995
# Porter: nils@guru.ims.uni-stuttgart.de
# Porter (original): nils@guru.ims.uni-stuttgart.de
# Porter (version 3): maurice@serc.rmit.edu.au
#
# $Id: Makefile,v 1.10 1996/12/07 13:28:30 asami Exp $
# $Id: Makefile,v 1.11 1997/08/11 18:02:08 fenner Exp $
DISTNAME= gnat-2.03-src
PKGNAME= gnat-2.03
# Note:
# - FreeBSD tasking libraries created by Dan Eischen have been incorportated
# into this edition
# - The default names of a number of binaries have been altered to avoid
# conflict with other gcc based products. Standard names can be provided using
# symbolic links.
DISTNAME= gnat-3.09-src
PKGNAME= gnat-3.09
CATEGORIES= lang
MASTER_SITES= ftp://cs.nyu.edu/pub/gnat/
MASTER_SITES= ftp://cs.nyu.edu/pub/gnat/ \
${MASTER_SITE_GNU}
DISTFILES= gnat-3.09-src.tar.gz gcc-2.7.2.1.tar.gz
MAINTAINER= ports@FreeBSD.ORG
MAINTAINER= maurice@serc.rmit.edu.au
BROKEN= "Not updated for gcc-2.7.x"
# following three lines commented out because BROKEN is already defined
#.if !exists(/usr/local/bin/gnatf)
#BROKEN= "requires existing gnat compiler"
#.endif
# You need a compiler who calls an existing gnat compiler:
.if !exists(/usr/local/bin/gnatf)
BROKEN= "requires existing gnat compiler"
.endif
.if !exists(/usr/local/bin/adagcc)
BROKEN= "requires patched gcc compiler"
.endif
# You need a compiler who calls an existing gnat compiler (3.08 or greater):
# if you have one, if you have one put it here, otherwise,
# you will need to install from a package first, the Makefile
# in ${SRCDIR}/ada is configured to call gcc with -B/usr/local/libexec/
# so that the normal gcc will find gnat1 there. Alternatively
# you can install it in /usr and avoid the hassles.
CC = gcc
# you will need to install from a package first
# You have to tell me where your gcc 2.6.3 source is located
COMPILERSOURCE = /usr/src/gnu/usr.bin/cc
# Make sure we use the patched gcc compiler
CC = /usr/local/bin/adagcc
# Which version of gcc do we have? Must be either 2.6.2 or 2.6.3.
CCVERSION= 2.6.3
# Which version of gcc do we have? Must be 2.7.2.1
CCVERSION= 2.7.2.1
USE_GMAKE= true
# which language set
LANG = c ada
pre-build:
@echo "===> Building patched gcc library for ${DISTNAME}"
cd ${WRKSRC}/gcc && \
${MAKE} CC="${CC} -I. -I${COMPILERSOURCE}/include" \
COMPILERSOURCE="${COMPILERSOURCE}" PREFIX=${PREFIX}
pre-patch:
@echo "===> Applying FreeBSD patches to gcc for ${DISTNAME}"
-( cd ${WRKDIR}/gcc-2.7.2.1; \
patch -s -f < ${PATCHDIR}/patch-freebsdgcc; )
@echo "===> Fixing ${DISTNAME} patches to gcc"
-( cd ${WRKSRC}/src; \
patch -s -f < ${PATCHDIR}/patch-gnat; )
@echo "===> Patching gcc for ${DISTNAME}"
-( cd ${WRKDIR}/gcc-2.7.2.1; \
patch -s -f < ${WRKSRC}/src/gcc-272.dif; )
(cd ${WRKDIR}/gcc-2.7.2.1; \
cp -R ${WRKSRC}/src/ada ada; )
pre-configure:
(cd ${WRKDIR}/gcc-2.7.2.1/ada; \
touch treeprs.ads a-[es]info.h nmake.ad[bs] )
do-build:
cd ${WRKSRC}/ada; \
${GMAKE} CC="${CC}" PREFIX=${PREFIX} COMPILERSOURCE="${COMPILERSOURCE}"
(cd ${WRKDIR}/gcc-2.7.2.1; ${GMAKE} CC="${CC}" CFLAGS="-O2" LANGUAGES="${LANG}" )
(cd ${WRKDIR}/gcc-2.7.2.1; ${GMAKE} CC="${CC}" CFLAGS="-O2" LANGUAGES="${LANG}" bootstrap )
(cd ${WRKDIR}/gcc-2.7.2.1; ${GMAKE} CC="${CC}" CFLAGS="-O2" gnatlib_and_tools )
# patch the src that we are going to use and copy any additional files
# required into the correct locations
# use version specific patches where necessary
do-patch:
(cd ${WRKDIR}; \
FILES="${PATCHDIR}/patch-[a-z][a-z]" ; \
SORTEDFILES=`echo $$FILES | tr " " "\n" | sort` ; \
for i in $$SORTEDFILES ; do \
echo Applying ---- $$i ;\
patch -s < $$i ;\
done )
(cd ${FILESDIR}; \
for i in *.adb *.ads ; do \
cp $$i ${WRKDIR}/gcc-2.7.2.1/ada; \
done )
do-configure:
@env CURDIR=${.CURDIR} DISTDIR=${DISTDIR} WRKDIR=${WRKDIR} \
WRKSRC=${WRKSRC} PATCHDIR=${PATCHDIR} SCRIPTDIR=${SCRIPTDIR} \
FILESDIR=${FILESDIR} PORTSDIR=${PORTSDIR} PREFIX=${PREFIX} \
DEPENDS="${DEPENDS}" \
COMPILERSOURCE="${COMPILERSOURCE}" CCVERSION="${CCVERSION}" \
${SHELL} ${SCRIPTDIR}/configure;
(cd ${WRKDIR}/gcc-2.7.2.1; \
./configure --prefix=${PREFIX} --program-prefix=ada )
do-install:
(cd ${WRKSRC}/ada; \
${MAKE} PREFIX=${PREFIX} ${MAKE_FLAGS} ${MAKEFILE} \
${INSTALL_TARGET})
(cd ${WRKDIR}/gcc-2.7.2.1; \
${GMAKE} CC="${CC}" LANGUAGES="${LANG}" install )
post-install:
@(echo "-----------------------------------------------------------" )
@(echo "" )
@(echo "For information about using the tasking library please read" )
@(echo "the README.Tasking file" )
@(echo "" )
@(echo "-----------------------------------------------------------" )
@(echo "" )
.include <bsd.port.mk>

3
lang/gnat/distinfo
View file

@ -1 +1,2 @@
MD5 (gnat-2.03-src.tar.gz) = 65c2f6458b3fb9de2cda0c4ab8bcf4fc
MD5 (gnat-3.09-src.tar.gz) = bd8a3526ee8b55dd10db11d4485e1e21
MD5 (gcc-2.7.2.1.tar.gz) = 655b43dbb48f611fc667ec21584a4460

154
lang/gnat/files/4fintnam.ads Normal file
View file

@ -0,0 +1,154 @@
------------------------------------------------------------------------------
-- --
-- GNU ADA RUNTIME 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 --
-- (Version for new GNARL) --
-- --
-- $Revision: 1.1 $ --
-- --
-- Copyright (C) 1991,92,93,94,95,1996 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. It is --
-- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
-- State University (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This is the FreeBSD THREADS version of this package
-- This is only a first approximation.
-- It should be autogenerated by the m4 macro processor.
-- Contributed by Daniel Eischen (deischen@iworks.InterWorks.org)
with System.OS_Interface;
-- used for names of interrupts
package Ada.Interrupts.Names is
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 := -- used by abort,
System.OS_Interface.SIGABRT; -- 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 := -- write on a pipe with
System.OS_Interface.SIGPIPE; -- 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
SIGURG : constant Interrupt_ID :=
System.OS_Interface.SIGURG; -- urgent condition on IO channel
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
SIGCHLD : constant Interrupt_ID :=
System.OS_Interface.SIGCHLD; -- 4.3BSD's/POSIX name for SIGCLD
SIGCLD : constant Interrupt_ID :=
System.OS_Interface.SIGCLD; -- child status change
SIGTTIN : constant Interrupt_ID :=
System.OS_Interface.SIGTTIN; -- background tty read attempted
SIGTTOU : constant Interrupt_ID :=
System.OS_Interface.SIGTTOU; -- background tty write attempted
SIGIO : constant Interrupt_ID := -- input/output possible,
System.OS_Interface.SIGIO; -- SIGPOLL alias (Solaris)
SIGXCPU : constant Interrupt_ID :=
System.OS_Interface.SIGXCPU; -- CPU time limit exceeded
SIGXFSZ : constant Interrupt_ID :=
System.OS_Interface.SIGXFSZ; -- filesize limit exceeded
SIGVTALRM : constant Interrupt_ID :=
System.OS_Interface.SIGVTALRM; -- virtual timer expired
SIGPROF : constant Interrupt_ID :=
System.OS_Interface.SIGPROF; -- profiling timer expired
SIGWINCH : constant Interrupt_ID :=
System.OS_Interface.SIGWINCH; -- window size change
SIGINFO : constant Interrupt_ID := -- information request
System.OS_Interface.SIGINFO; -- (NetBSD/FreeBSD)
SIGUSR1 : constant Interrupt_ID :=
System.OS_Interface.SIGUSR1; -- user defined signal 1
SIGUSR2 : constant Interrupt_ID :=
System.OS_Interface.SIGUSR2; -- user defined signal 2
-- 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.
end Ada.Interrupts.Names;

234
lang/gnat/files/5fintman.adb Normal file
View file

@ -0,0 +1,234 @@
------------------------------------------------------------------------------
-- --
-- GNU ADA RUNTIME 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 --
-- (Version for new GNARL) --
-- --
-- $Revision: 1.3 $ --
-- --
-- Copyright (C) 1991,1992,1993,1994,1995,1996 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 FreeBSD PTHREADS version of this package
-- This is only a first approximation.
-- It should be autogenerated by the m4 macro processor.
-- Contributed by Peter Burwood (gnat@arcangel.dircon.co.uk).
-- This file performs the system-dependent translation between machine
-- exceptions and the Ada exceptions, if any, that should be raised when
-- they occur. This version works for FreeBSD. Contributed by
-- Daniel M. Eischen (deischen@iworks.InterWorks.org).
-- PLEASE DO NOT add any dependences on other packages.
-- 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.
with Interfaces.C;
-- used for int and other types
with System.Error_Reporting;
-- used for Shutdown
with System.OS_Interface;
-- used for various Constants, Signal and types
package body System.Interrupt_Management is
use Interfaces.C;
use System.Error_Reporting;
use System.OS_Interface;
type Interrupt_List is array (Interrupt_ID range <>) of Interrupt_ID;
Exception_Interrupts : constant Interrupt_List :=
(SIGFPE, SIGILL, SIGSEGV, SIGBUS);
----------------------
-- Notify_Exception --
----------------------
-- 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.
-- Language specs say signal handlers take exactly one arg, even
-- though FreeBSD actually supplies three. Ugh!
procedure Notify_Exception
(signo : Signal;
code : Interfaces.C.int;
context : access struct_sigcontext);
procedure Notify_Exception
(signo : Signal;
code : Interfaces.C.int;
context : access struct_sigcontext) is
begin
-- As long as we are using a longjmp to return control to the
-- exception handler on the runtime stack, we are safe. The original
-- signal mask (the one we had before coming into this signal catching
-- function) will be restored by the longjmp. Therefore, raising
-- an exception in this handler should be a safe operation.
-- Check that treatment of exception propagation here
-- is consistent with treatment of the abort signal in
-- System.Task_Primitives.Operations.
-- ?????
-- The code below is first approximation.
-- It would be nice to figure out more
-- precisely what exception has occurred.
-- One also should arrange to use an alternate stack for
-- recovery from stack overflow.
-- I don't understand the Linux kernel code well
-- enough to figure out how to do this yet.
-- I hope someone will look at this. --Ted Baker
-- How can SIGSEGV be split into constraint and storage errors ?
-- What should SIGILL really raise ? Some implemenations have
-- codes for different types of SIGILL and some raise Storage_Error.
-- What causes SIGBUS and should it be caught ?
-- Peter Burwood
case signo is
when SIGFPE =>
raise Constraint_Error;
when SIGILL =>
raise Constraint_Error;
when SIGSEGV =>
raise Storage_Error;
when SIGBUS =>
raise Storage_Error;
when others =>
pragma Assert (Shutdown ("Unexpected signal"));
null;
end case;
end Notify_Exception;
----------------
-- Initialize --
----------------
procedure Initialize is
act : aliased struct_sigaction;
old_act : aliased struct_sigaction;
mask : aliased sigset_t;
Result : Interfaces.C.int;
begin
Abort_Task_Interrupt := SIGABRT;
-- Change this if you want to use another signal for task abort.
-- SIGTERM might be a good one.
act.sa_handler := Notify_Exception'Address;
act.sa_flags := 16#010#;
-- 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.
-- In that case, this field should be changed back to 0. ??? (Dong-Ik)
Result := sigemptyset (mask'Access);
pragma Assert (Result = 0
or else Shutdown ("GNULLI failure---sigemptyset"));
for I in Exception_Interrupts'Range loop
Result := sigaddset (mask'Access, Signal (Exception_Interrupts (I)));
pragma Assert (Result = 0
or else Shutdown ("GNULLI failure---sigaddset"));
end loop;
act.sa_mask := mask;
for I in Exception_Interrupts'Range loop
Keep_Unmasked (Exception_Interrupts (I)) := True;
Result :=
sigaction
(Signal (Exception_Interrupts (I)), act'Access, old_act'Access);
pragma Assert (Result = 0
or else Shutdown ("GNULLI failure---sigaction"));
end loop;
Keep_Unmasked (Abort_Task_Interrupt) := true;
-- Keep_Unmasked (SIGBUS) := true;
Keep_Unmasked (SIGSTOP) := true;
Keep_Unmasked (SIGKILL) := true;
Keep_Unmasked (SIGINT) := true;
-- Keep_Unmasked (SIGEMT) := true;
-- Keep_Unmasked (SIGCHLD) := true;
-- Keep_Unmasked (SIGALRM) := true;
-- ???? The above signals have been found to need to be
-- kept unmasked on some systems, per Dong-Ik Oh.
-- I don't know whether the MIT/Provenzano threads
-- need these or any other signals unmasked at the thread level.
-- I hope somebody will take
-- the time to look it up. -- Ted Baker
-- FreeBSD uses SIGINFO to dump thread status to stdout. If
-- the user really wants to attach his own handler, let him.
-- FreeBSD pthreads uses setitimer/getitimer for thread scheduling.
-- It's not clear, but it looks as if it only needs SIGVTALRM
-- in order to handle the setitimer/getitimer operations. We
-- could probably allow SIGALARM, but we'll leave it as unmasked
-- for now. FreeBSD pthreads also needs SIGCHLD.
Keep_Unmasked (SIGCHLD) := true;
Keep_Unmasked (SIGALRM) := true;
Keep_Unmasked (SIGVTALRM) := true;
Reserve := Reserve or Keep_Unmasked or Keep_Masked;
Reserve (0) := true;
-- 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.
end Initialize;
begin
Initialize;
end System.Interrupt_Management;

139
lang/gnat/files/5fosinte.adb Normal file
View file

@ -0,0 +1,139 @@
------------------------------------------------------------------------------
-- --
-- GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . O S _ I N T E R F A C E --
-- --
-- B o d y --
-- (Version for new GNARL) --
-- --
-- $Revision: 1.2 $ --
-- --
-- Copyright (C) 1991,1992,1993,1994,1995,1996 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 FreeBSD THREADS version of this package
-- This is only a first approximation.
-- It should be autogenerated by the m4 macro processor.
-- Contributed by Daniel M. Eischen (deischen@iworks.InterWorks.org)
-- DO NOT EDIT this file.
-- It was automatically generated from another file by the m4 macro processor.
-- The name of the file you should edit is the same as this one, but with
-- ".ads" replaced by ".sm4", or
-- ".adb" replaced by ".bm4", or
-- ".c" replaced by ".cm4", or
-- ".dat" replaced by ".tm4"
-- Local options selected:
-- __TARGET = i386-unknown-freebsd
-- __ARCH = I386
-- __OS = FREEBSD
-- __HAS_SIGCONTEXT = 1
-- __HAS_UCONTEXT = 0
-- __THREADS = POSIX_THREADS
-- __THREAD_VARIANT = ??
-- __HAS_TIMESPEC = 1
-- __HAS_NANOSLEEP = 1
-- __HAS_CLOCK_GETTIME = 0
-- __HAS_GETTIMEOFDAY = 1
-- __POSIX_THREAD_PRIO_PROTECT = 0
-- __POSIX_THREAD_PRIO_INHERIT = 0
-- __POSIX_THREAD_ATTR_STACKADDR = 1
-- __POSIX_THREAD_ATTR_STACKSIZE = 1
-- __POSIX_THREAD_PRIORITY_SCHEDULING = 0
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- This version is for POSIX-like operating systems
-- The original file "s-osinte.ads_m4" contains conditional
-- macro calls that allow selection of various options.
with Interfaces.C; use Interfaces.C;
package body System.OS_Interface is
-----------------
-- To_Duration --
-----------------
function To_Duration (TS : timespec) return Duration is
begin
return Duration (TS.ts_sec) + Duration (TS.ts_nsec) / 10#1#E9;
end To_Duration;
-----------------
-- To_Timespec --
-----------------
function To_Timespec (D : Duration) return timespec is
S : time_t;
F : Duration;
begin
S := time_t (Long_Long_Integer (D));
F := D - Duration (S);
-- If F has negative value due to a round-up, adjust for positive F
-- value.
if F < 0.0 then S := S - 1; F := F + 1.0; end if;
return timespec' (ts_sec => S,
ts_nsec => long (Long_Long_Integer (F * 10#1#E9)));
end To_Timespec;
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;
function To_Timeval (D : Duration) return struct_timeval is
S : long;
F : Duration;
begin
S := long (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 => long (Long_Long_Integer (F * 10#1#E6)));
end To_Timeval;
-- FreeBSD Pthreads has pthread_yield and it is imported as
-- sched_yield in 5fosinte.ads. The FreeBSD pthread_yield does
-- not have any parameters, so the import may be used directly
-- without the need for a wrapper as shown below.
-- function sched_yield return int is
-- procedure sched_yield_base (arg : System.Address);
-- pragma Import (C, sched_yield_base, "pthread_yield");
-- begin
-- sched_yield_base (System.Null_Address);
-- return 0;
-- end sched_yield;
end System.OS_Interface;

742
lang/gnat/files/5fosinte.ads Normal file
View file

@ -0,0 +1,742 @@
------------------------------------------------------------------------------
-- --
-- GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . O S _ I N T E R F A C E --
-- --
-- S p e c --
-- (Version for new GNARL) --
-- --
-- $Revision: 1.5 $ --
-- --
-- Copyright (C) 1991,92,93,94,95,1996 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. It is --
-- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
-- State University (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This is the FreeBSD PTHREADS version of this package
-- This is only a first approximation.
-- It should be autogenerated by the m4 macro processor.
-- Contributed by Daniel Eischen (deischen@iworks.InterWorks.org)
-- DO NOT EDIT this file.
-- It was automatically generated from another file by the m4 macro processor.
-- The name of the file you should edit is the same as this one, but with
-- ".ads" replaced by ".sm4", or
-- ".adb" replaced by ".bm4", or
-- ".c" replaced by ".cm4", or
-- ".dat" replaced by ".tm4"
-- Local options selected:
-- __TARGET = i386-unknown-freebsd
-- __ARCH = I386
-- __OS = FREEBSD
-- __HAS_SIGCONTEXT = 1
-- __HAS_UCONTEXT = 0
-- __THREADS = POSIX_THREADS
-- __THREAD_VARIANT = ??
-- __HAS_TIMESPEC = 1
-- __HAS_NANOSLEEP = 1
-- __HAS_CLOCK_GETTIME = 0
-- __HAS_GETTIMEOFDAY = 1
-- __POSIX_THREAD_PRIO_PROTECT = 0
-- __POSIX_THREAD_PRIO_INHERIT = 0
-- __POSIX_THREAD_ATTR_STACKADDR = 1
-- __POSIX_THREAD_ATTR_STACKSIZE = 1
-- __POSIX_THREAD_PRIORITY_SCHEDULING = 0
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- PLEASE DO NOT add any with-clauses to this package
-- or remove the pragma Elaborate_Body.
-- It is designed to be a bottom-level (leaf) package.
-- This version is for POSIX-like operating systems
-- The original file "s-osinte.sm4" contains conditional
-- macro calls that allow selection of various options.
-- The options selected for this expansion were:
-- When adding new signals to s-osinte.sm4, don't forget to update
-- cconst.dat (m4 macro definition data-file) and the files
-- s-intnam.ads (package Ada.Interrupt_Names) for the various ports.
with Interfaces.C;
package System.OS_Interface is
pragma Preelaborate;
pragma Linker_Options ("-lc_r");
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");
-- NAMEs not used are commented-out
-- NAMEs not supported on this system have __NAME for value
-- E2BIG : constant := 7;
-- EACCES : constant := 13;
EAGAIN : constant := 35;
-- EBADF : constant := 9;
-- EBUSY : constant := 16;
-- ECHILD : constant := 10;
-- EDEADLK : constant := 11;
-- EDOM : constant := 33;
-- EEXIST : constant := 17;
-- EFAULT : constant := 14;
-- EFBIG : constant := 27;
EINTR : constant := 4;
EINVAL : constant := 22;
-- EIO : constant := 5;
-- EISDIR : constant := 21;
-- EMFILE : constant := 24;
-- EMLINK : constant := 31;
-- ENAMETOOLONG : constant := 63;
-- ENFILE : constant := 23;
-- ENODEV : constant := 19;
-- ENOENT : constant := 2;
-- ENOEXEC : constant := 8;
-- ENOLCK : constant := 37;
ENOMEM : constant := 12;
-- ENOSPC : constant := 28;
-- ENOSYS : constant := 78;
-- ENOTDIR : constant := 20;
-- ENOTEMPTY : constant := 66;
-- ENOTTY : constant := 25;
-- ENXIO : constant := 6;
-- EPERM : constant := 1;
-- EPIPE : constant := 32;
-- ERANGE : constant := 34;
-- EROFS : constant := 30;
-- ESPIPE : constant := 29;
-- ESRCH : constant := 3;
ETIMEDOUT : constant := 60;
-- EXDEV : constant := 18;
-------------
-- Signals --
-------------
NSIG : constant := 32;
type Signal is new int range 0 .. Interfaces.C."-" (NSIG, 1);
-- NAMEs not used are commented-out
-- NAMEs not supported on this system have __NAME for value
SIGHUP : constant := 1; -- hangup
SIGINT : constant := 2; -- interrupt (rubout)
SIGQUIT : constant := 3; -- quit (ASCD FS)
SIGILL : constant := 4; -- illegal instruction (not reset)
SIGTRAP : constant := 5; -- trace trap (not reset)
SIGIOT : constant := 6; -- IOT instruction
SIGABRT : constant := 6; -- used by abort, replace SIGIOT in the future
SIGEMT : constant := 7; -- EMT instruction
SIGFPE : constant := 8; -- floating point exception
SIGKILL : constant := 9; -- kill (cannot be caught or ignored)
SIGBUS : constant := 10; -- bus error
SIGSEGV : constant := 11; -- segmentation violation
SIGSYS : constant := 12; -- bad argument to system call
SIGPIPE : constant := 13; -- write on a pipe with no one to read it
SIGALRM : constant := 14; -- alarm clock
SIGTERM : constant := 15; -- software termination signal from kill
SIGURG : constant := 16; -- urgent condition on IO channel
SIGSTOP : constant := 17; -- stop (cannot be caught or ignored)
SIGTSTP : constant := 18; -- user stop requested from tty
SIGCONT : constant := 19; -- stopped process has been continued
SIGCLD : constant := 20; -- alias for SIGCHLD
SIGCHLD : constant := 20; -- child status change
SIGTTIN : constant := 21; -- background tty read attempted
SIGTTOU : constant := 22; -- background tty write attempted
SIGIO : constant := 23; -- I/O possible (Solaris SIGPOLL alias)
SIGXCPU : constant := 24; -- CPU time limit exceeded
SIGXFSZ : constant := 25; -- filesize limit exceeded
SIGVTALRM : constant := 26; -- virtual timer expired
SIGPROF : constant := 27; -- profiling timer expired
SIGWINCH : constant := 28; -- window size change
SIGINFO : constant := 29; -- information request (NetBSD/FreeBSD)
SIGUSR1 : constant := 30; -- user defined signal 1
SIGUSR2 : constant := 31; -- user defined signal 2
type sigset_t is private;
function sigaddset
(set : access sigset_t;
sig : Signal)
return int;
pragma Import (C, sigaddset, "sigaddset");
function sigdelset
(set : access sigset_t;
sig : Signal)
return int;
pragma Import (C, sigdelset, "sigdelset");
function sigfillset
(set : access sigset_t)
return int;
pragma Import (C, sigfillset, "sigfillset");
function sigismember
(set : access sigset_t;
sig : Signal)
return int;
pragma Import (C, sigismember, "sigismember");
function sigemptyset
(set : access sigset_t)
return int;
pragma Import (C, sigemptyset, "sigemptyset");
-- sigcontext is architecture dependent, so define it private
type struct_sigcontext is private;
type struct_sigaction is record
sa_handler : System.Address;
sa_mask : sigset_t;
sa_flags : int;
end record;
pragma Convention (C, struct_sigaction);
SIG_BLOCK : constant := 1;
SIG_UNBLOCK : constant := 2;
SIG_SETMASK : constant := 3;
-- SA_NOCLDSTOP : constant := 8;
-- not used
-- SA_SIGINFO : constant := __SA_SIGINFO;
-- not used
SIG_DFL : constant := 0;
SIG_IGN : constant := 1;
-- SIG_ERR : constatn := -1;
-- not used
function sigaction
(sig : Signal;
act : access struct_sigaction;
oact : access struct_sigaction)
return int;
pragma Import (C, sigaction, "sigaction");
----------
-- Time --
----------
type timespec is private;
function nanosleep (rqtp, rmtp : access timespec) return int;
pragma Import (C, nanosleep, "nanosleep");
function To_Duration (TS : timespec) return Duration;
pragma Inline (To_Duration);
function To_Timespec (D : Duration) return timespec;
pragma Inline (To_Timespec);
type struct_timezone is record
tz_minuteswest : int;
tz_dsttime : int;
end record;
pragma Convention (C, struct_timezone);
type struct_timeval is private;
-- This is needed on systems that do not have clock_gettime()
-- but do have gettimeofday().
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 : access struct_timezone) return int;
pragma Import (C, gettimeofday, "gettimeofday");
procedure usleep (useconds : unsigned_long);
pragma Import (C, usleep, "usleep");
-- add a hook to locate the Epoch, for use with Calendar????
-------------------------
-- Priority Scheduling --
-------------------------
MIN_PRIO : constant := 0;
MAX_PRIO : constant := 126;
SCHED_RR : constant := 0;
SCHED_IO : constant := 1;
SCHED_FIFO : constant := 2;
SCHED_OTHER : constant := 3;
-------------
-- 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;
type pthread_mutex_t is limited private;
type pthread_cond_t is limited private;
type pthread_attr_t is limited private;
type pthread_mutexattr_t is limited private;
type pthread_condattr_t is limited private;
type pthread_key_t is private;
PTHREAD_CREATE_DETACHED : constant := 1;
PTHREAD_CREATE_JOINABLE : constant := 0;
---------------------------
-- POSIX.1c Section 3 --
---------------------------
function sigwait
(set : access sigset_t;
sig : access Signal)
return int;
pragma Import (C, sigwait, "sigwait");
function pthread_kill
(thread : pthread_t;
sig : Signal)
return int;
pragma Import (C, pthread_kill, "pthread_kill");
function pthread_sigmask
(how : int;
set : access sigset_t;
oset : access sigset_t)
return int;
pragma Import (C, pthread_sigmask, "pthread_sigmask");
----------------------------
-- POSIX.1c Section 11 --
----------------------------
function pthread_mutexattr_init
(attr : access pthread_mutexattr_t)
return int;
pragma Import (C, pthread_mutexattr_init, "pthread_mutexattr_init");
function pthread_mutexattr_destroy
(attr : access pthread_mutexattr_t)
return int;
pragma Import (C, pthread_mutexattr_destroy, "pthread_mutexattr_destroy");
function pthread_mutex_init
(mutex : access pthread_mutex_t;
attr : access pthread_mutexattr_t)
return int;
pragma Import (C, pthread_mutex_init, "pthread_mutex_init");
function pthread_mutex_destroy
(mutex : access pthread_mutex_t)
return int;
pragma Import (C, pthread_mutex_destroy, "pthread_mutex_destroy");
function pthread_mutex_lock
(mutex : access pthread_mutex_t)
return int;
pragma Import (C, pthread_mutex_lock, "pthread_mutex_lock");
function pthread_mutex_unlock
(mutex : access pthread_mutex_t)
return int;
pragma Import (C, pthread_mutex_unlock, "pthread_mutex_unlock");
function pthread_condattr_init
(attr : access pthread_condattr_t)
return int;
pragma Import (C, pthread_condattr_init, "pthread_condattr_init");
function pthread_condattr_destroy
(attr : access pthread_condattr_t)
return int;
pragma Import (C, pthread_condattr_destroy, "pthread_condattr_destroy");
function pthread_cond_init
(cond : access pthread_cond_t;
attr : access pthread_condattr_t)
return int;
pragma Import (C, pthread_cond_init, "pthread_cond_init");
function pthread_cond_destroy
(cond : access pthread_cond_t)
return int;
pragma Import (C, pthread_cond_destroy, "pthread_cond_destroy");
function pthread_cond_signal
(cond : access pthread_cond_t)
return int;
pragma Import (C, pthread_cond_signal, "pthread_cond_signal");
function pthread_cond_wait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t)
return int;
pragma Import (C, pthread_cond_wait, "pthread_cond_wait");
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
abstime : access timespec)
return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
----------------------------
-- POSIX.1c Section 13 --
----------------------------
-- FreeBSD pthreads does not support these yet.
-- PTHREAD_PRIO_NONE : constant := 0;
-- PTHREAD_PRIO_PROTECT : constant := 2;
-- PTHREAD_PRIO_INHERIT : constant := 1;
-- FreeBSD doesn't have pthread_getschedparam or pthread_setschedparam
-- yet. It has pthread_getprio and pthread_setprio, so we use these
-- instead.
-- type struct_sched_param is record
-- prio : int;
-- no_data : System.Address;
-- end record;
-- pragma Convention (C, struct_sched_param);
--
-- function pthread_getschedparam
-- (thread : pthread_t;
-- policy : access int;
-- param : access struct_sched_param)
-- return int;
-- pragma Import (C, pthread_getschedparam, "pthread_getschedparam");
--
-- function pthread_setschedparam
-- (thread : pthread_t;
-- policy : int;
-- param : access struct_sched_param)
-- return int;
-- pragma Import (C, pthread_setschedparam, "pthread_setschedparam");
function pthread_getschedparam
(thread : pthread_t)
return int;
pragma Import (C, pthread_getschedparam, "pthread_getprio");
function pthread_setschedparam
(thread : pthread_t;
priority : int)
return int;
pragma Import (C, pthread_setschedparam, "pthread_setprio");
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_getscope
(attr : access pthread_attr_t;
contentionscope : access int)
return int;
pragma Import (C, pthread_attr_getscope, "pthread_attr_getscope");
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_getinheritsched
(attr : access pthread_attr_t;
inheritsched : access int)
return int;
pragma Import
(C, pthread_attr_getinheritsched, "pthread_attr_getinheritsched");
function pthread_attr_setschedpolicy
(attr : access pthread_attr_t;
policy : int)
return int;
pragma Import
(C, pthread_attr_setschedpolicy,
"pthread_attr_setschedpolicy");
function pthread_attr_getschedpolicy
(attr : access pthread_attr_t;
policy : access int)
return int;
pragma Import (C, pthread_attr_getschedpolicy,
"pthread_attr_getschedpolicy");
-- FreeBSD doesn't have pthread_attr_setschedparm and
-- pthread_attr_getschedparm yet. It has pthread_attr_setprio and
-- pthread_attr_getprio instead. It seems we don't need either one
-- of these, though.
-- 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 pthread_attr_getschedparam
-- (attr : access pthread_attr_t;
-- sched_param : access struct_sched_param)
-- return int;
-- pragma Import (C, pthread_attr_getschedparam,
-- "pthread_attr_getschedparam");
function pthread_attr_setschedparam
(attr : access pthread_attr_t;
priority : int)
return int;
pragma Import (C, pthread_attr_setschedparam, "pthread_attr_setprio");
function pthread_attr_getschedparam
(attr : access pthread_attr_t)
return int;
pragma Import (C, pthread_attr_getschedparam, "pthread_attr_getprio");
function sched_yield return int;
pragma Import (C, sched_yield, "pthread_yield");
-----------------------------
-- P1003.1c - Section 16 --
-----------------------------
function pthread_attr_init
(attributes : access pthread_attr_t)
return int;
pragma Import (C, pthread_attr_init, "pthread_attr_init");
function pthread_attr_destroy
(attributes : access pthread_attr_t)
return int;
pragma Import (C, pthread_attr_destroy, "pthread_attr_destroy");
function pthread_attr_setdetachstate
(attr : access pthread_attr_t;
detachstate : int)
return int;
pragma Import
(C, pthread_attr_setdetachstate, "pthread_attr_setdetachstate");
function pthread_attr_getdetachstate
(attr : access pthread_attr_t;
detachstate : access int)
return int;
pragma Import
(C, pthread_attr_getdetachstate, "pthread_attr_getdetachstate");
function pthread_attr_getstacksize
(attr : access pthread_attr_t;
stacksize : access size_t)
return int;
pragma Import
(C, pthread_attr_getstacksize, "pthread_attr_getstacksize");
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");
function pthread_detach (thread : pthread_t) return int;
pragma Import (C, pthread_detach, "pthread_detach");
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");
function pthread_equal (t1 : pthread_t; t2 : pthread_t)
return int;
-- be careful not to use "=" on thread_t!
pragma Import (C, pthread_equal, "pthread_equal");
----------------------------
-- POSIX.1c Section 17 --
----------------------------
function pthread_setspecific
(key : pthread_key_t;
value : System.Address)
return int;
pragma Import (C, pthread_setspecific, "pthread_setspecific");
function pthread_getspecific (key : pthread_key_t) return System.Address;
pragma Import (C, pthread_getspecific, "pthread_getspecific");
type destructor_pointer is access
procedure (arg : System.Address);
function pthread_key_create
(key : access pthread_key_t;
destructor : destructor_pointer)
return int;
pragma Import (C, pthread_key_create, "pthread_key_create");
private
type sigset_t is new unsigned_long;
-- Should we add a signal_context type here ?
-- How could it be done independent of the CPU architecture ?
-- sigcontext type is opaque, so it is architecturally neutral.
-- It is always passed as an access type, so define it as an empty record
-- since the contents are not used anywhere.
type struct_sigcontext is null record;
pragma Convention (C, struct_sigcontext);
-- In Solaris 2.4 the component sa_handler turns out to
-- be one a union type, and the selector is a macro:
-- #define sa_handler __funcptr._handler
-- #define sa_sigaction __funcptr._sigaction
type pid_t is new int;
type time_t is new long;
type timespec is record
ts_sec : time_t;
ts_nsec : long;
end record;
pragma Convention (C, timespec);
type struct_timeval is record
tv_sec : long;
tv_usec : long;
end record;
pragma Convention (C, struct_timeval);
type enumeral_type_3 is new int;
type pthread_attr_t is record
schedparam_policy : enumeral_type_3;
prio : int;
suspend : int;
flags : int;
arg_attr : System.Address;
cleanup_attr : System.Address;
stackaddr_attr : System.Address;
stacksize_attr : size_t;
end record;
pragma Convention (C, pthread_attr_t);
type enumeral_type_2 is new int;
type pthread_condattr_t is record
c_type : enumeral_type_2;
c_flags : long;
end record;
pragma Convention (C, pthread_condattr_t);
type enumeral_type_1 is new int;
type pthread_mutexattr_t is record
m_type : enumeral_type_1;
m_flags : long;
end record;
pragma Convention (C, pthread_mutexattr_t);
type record_type_3 is null record;
pragma Convention (C, record_type_3);
type pthread_t is access record_type_3;
type enumeral_type_4 is new int;
type pthread_queue_t is record
q_next : System.Address;
q_last : System.Address;
q_data : System.Address;
end record;
pragma Convention (C, pthread_queue_t);
type union_type_1 is new int;
type pthread_mutex_t is record
m_type : enumeral_type_4;
m_queue : pthread_queue_t;
m_owner : System.Address;
-- m_lock : long;
m_data : union_type_1;
m_flags : long;
end record;
pragma Convention (C, pthread_mutex_t);
type enumeral_type_5 is new int;
type pthread_cond_t is record
c_type : enumeral_type_5;
c_queue : pthread_queue_t;
-- c_lock : long;
c_data : System.Address;
c_flags : long;
end record;
pragma Convention (C, pthread_cond_t);
type pthread_key_t is new int;
end System.OS_Interface;

779
lang/gnat/files/5ftaprop.adb Normal file
View file

@ -0,0 +1,779 @@
------------------------------------------------------------------------------
-- --
-- GNU ADA RUNTIME 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 --
-- (Version for new GNARL) --
-- --
-- $Revision: 1.4 $ --
-- --
-- Copyright (C) 1991,1992,1993,1994,1995,1996 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 FreeBSD PTHREADS version of this package. Contributed
-- by Daniel M. Eischen (deischen@iworks.InterWorks.org).
with Interfaces.C;
-- used for int
-- size_t
with System.Error_Reporting;
-- used for Shutdown
with System.Interrupt_Management;
-- used for Keep_Unmasked
-- Abort_Task_Interrupt
-- Interrupt_ID
with System.OS_Interface;
-- used for various type, constant, and operations
with System.Parameters;
-- used for Size_Type
with System.Storage_Elements;
-- used for To_Address
-- Integer_Address
with System.Tasking;
-- used for Ada_Task_Control_Block
-- Task_ID
with System.Time_Operations;
-- used for Clock
-- Clock_Delay_Correction
with Unchecked_Conversion;
with Unchecked_Deallocation;
package body System.Task_Primitives.Operations is
use System.Tasking;
use Interfaces.C;
use System.Error_Reporting;
use System.OS_Interface;
use System.Parameters;
use System.Time_Operations;
pragma Linker_Options ("-lc_r");
------------------
-- 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
All_Signal_Mask,
-- The set of all signals
Unblocked_Signal_Mask : aliased sigset_t;
-- The set of signals that should unblocked in all tasks
-----------------------
-- Local Subprograms --
-----------------------
procedure Abort_Handler
(signo : Signal;
code : Interfaces.C.int;
context : access struct_sigcontext);
function To_Task_ID is new Unchecked_Conversion (System.Address, Task_ID);
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.
-- Alternative solutions include:
-- 1. Change the PC saved in the system-dependent Context
-- parameter to point to code that raises the exception.
-- Normal return from this handler will then raise
-- the exception after the mask and other system state has
-- been restored (see example below).
-- 2. Use siglongjmp()/sigsetjmp() to implement exceptions.
-- 3. Unmask the signal in the Abortion_Signal exception handler
-- (in the RTS).
-- The following procedure would be needed if we can't lonjmp out of
-- a signal handler. (See below.)
-- procedure Raise_Abort_Signal is
-- begin
-- raise Standard'Abort_Signal;
-- end if;
procedure Abort_Handler
(signo : Signal;
code : Interfaces.C.int;
context : access struct_sigcontext) is
T : Task_ID := Self;
begin
-- Assuming it is safe to longjmp out of a signal handler, the
-- following code can be used:
if T.Deferral_Level = 0
and then T.Pending_ATC_Level < T.ATC_Nesting_Level then
raise Standard'Abort_Signal;
end if;
-- Otherwise, something like this is required:
-- if not Abort_Is_Deferred.all then
-- -- Overwrite the return PC address with the address of the
-- -- special raise routine, and "return" to that routine's
-- -- starting address.
-- Context.PC := Raise_Abort_Signal'Address;
-- return;
-- end if;
end Abort_Handler;
----------
-- Self --
----------
function Self return Task_ID is
Result : System.Address;
begin
Result := pthread_getspecific (ATCB_Key);
pragma Assert (Result /= System.Null_Address
or else Shutdown ("GNULLI failure---pthread_getspecific"));
return To_Task_ID (Result);
end 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 All_Tasks_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
or else Shutdown ("GNULLI failure---pthread_mutexattr_init"));
if Result = ENOMEM then
raise STORAGE_ERROR;
end if;
Result := pthread_mutex_init (L, Attributes'Access);
pragma Assert (Result = 0 or else Result = ENOMEM
or else Shutdown ("GNULLI failure---pthread_mutex_init"));
if Result = ENOMEM then
raise STORAGE_ERROR;
end if;
end Initialize_Lock;
procedure Initialize_Lock (L : access RTS_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
or else Shutdown ("GNULLI failure---pthread_mutexattr_init"));
if Result = ENOMEM then
raise STORAGE_ERROR;
end if;
Result := pthread_mutex_init (L, Attributes'Access);
pragma Assert (Result = 0 or else Result = ENOMEM
or else Shutdown ("GNULLI failure---pthread_mutex_init"));
if Result = ENOMEM then
raise STORAGE_ERROR;
end if;
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
or else Shutdown ("GNULLI failure---pthread_mutex_destroy"));
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
or else Shutdown ("GNULLI failure---pthread_mutex_destroy"));
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);
Ceiling_Violation := Result = EINVAL;
-- assumes the cause of EINVAL is a priority ceiling violation
pragma Assert (Result = 0 or else Result = EINVAL
or else Shutdown ("GNULLI failure---pthread_mutex_lock"));
end Write_Lock;
procedure Write_Lock (L : access RTS_Lock) is
Result : Interfaces.C.int;
begin
Result := pthread_mutex_lock (L);
pragma Assert (Result = 0
or else Shutdown ("GNULLI failure---pthread_mutex_lock"));
end Write_Lock;
procedure Write_Lock (T : Task_ID) is
Result : Interfaces.C.int;
begin
Result := pthread_mutex_lock (T.LL.L'Access);
pragma Assert (Result = 0
or else Shutdown ("GNULLI failure---pthread_mutex_lock"));
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
or else Shutdown ("GNULLI failure---pthread_mutex_unlock"));
end Unlock;
procedure Unlock (L : access RTS_Lock) is
Result : Interfaces.C.int;
begin
Result := pthread_mutex_unlock (L);
pragma Assert (Result = 0
or else Shutdown ("GNULLI failure---pthread_mutex_unlock"));
end Unlock;
procedure Unlock (T : Task_ID) is
Result : Interfaces.C.int;
begin
Result := pthread_mutex_unlock (T.LL.L'Access);
pragma Assert (Result = 0
or else Shutdown ("GNULLI failure---pthread_mutex_unlock"));
end Unlock;
-------------
-- Sleep --
-------------
procedure Sleep (Self_ID : Task_ID) is
Result : Interfaces.C.int;
begin
pragma Assert (Self_ID = Self
or else Shutdown ("GNULLI failure---Self in Sleep"));
Result := pthread_cond_wait (Self_ID.LL.CV'Access, Self_ID.LL.L'Access);
-- EINTR is not considered a failure.
pragma Assert (Result = 0 or else Result = EINTR
or else Shutdown ("GNULLI failure---Sleep"));
end Sleep;
---------------
-- Sleep_For --
---------------
procedure Sleep_For (Self_ID : Task_ID; Rel_Time : Duration) is
Result : Interfaces.C.Int;
Request : aliased timespec;
begin
pragma Assert (Self_ID = Self
or else Shutdown ("GNULLI failure---Self in Sleep_For"));
Request := To_Timespec (Rel_Time + Clock + Clock_Delay_Correction);
Result := pthread_cond_timedwait
(Self_ID.LL.CV'Access, Self_ID.LL.L'Access, Request'Access);
pragma Assert
(Result = 0
or else (Clock >= To_Duration (Request) - Clock_Delay_Correction)
or else Shutdown ("GNULLI failure---Sleep_For"));
end Sleep_For;
-----------------
-- Sleep_Until --
-----------------
procedure Sleep_Until (Self_ID : Task_ID; Abs_Time : Duration) is
Result : Interfaces.C.Int;
Request : aliased timespec;
begin
pragma Assert (Self_ID = Self
or else Shutdown ("GNULLI failure---Self in Sleep_Until"));
Request := To_Timespec (Abs_Time + Clock_Delay_Correction);
Result := pthread_cond_timedwait
(Self_ID.LL.CV'Access, Self_ID.LL.L'Access, Request'Access);
pragma Assert
(Result = 0 or else Clock >= Abs_Time
or else Shutdown ("GNULLI failure---Sleep_Until (early)"));
end Sleep_Until;
------------
-- Wakeup --
------------
procedure Wakeup (T : Task_ID) is
Result : Interfaces.C.int;
begin
Result := pthread_cond_signal (T.LL.CV'Access);
pragma Assert (Result = 0
or else Shutdown ("GNULLI failure---Wakeup"));
end Wakeup;
-----------
-- Yield --
-----------
procedure Yield is
Result : Interfaces.C.int;
begin
Result := sched_yield;
end Yield;
------------------
-- Set_Priority --
------------------
-- FreeBSD doesn't have the correct pthread_setschedparam routine
-- yet. Instead, pthread_setschedparam is imported from pthread_setprio
-- which only takes a pthread_t and integer as arguments.
-- procedure Set_Priority (T : Task_ID; Prio : System.Any_Priority) is
-- Result : Interfaces.C.int;
-- Param : aliased struct_sched_param;
-- begin
-- T.LL.Current_Priority := Interfaces.C.int (Prio);
-- Param.prio := Interfaces.C.int (Prio);
--
-- Result := pthread_setschedparam (T.LL.Thread, SCHED_FIFO,
-- Param'Access);
-- pragma Assert (Result = 0
-- or else Shutdown ("GNULLI failure---Set_Priority"));
--
-- end Set_Priority;
procedure Set_Priority (T : Task_ID; Prio : System.Any_Priority) is
Result : Interfaces.C.int;
begin
T.LL.Current_Priority := Interfaces.C.int (Prio);
Result := pthread_setschedparam (T.LL.Thread, Interfaces.C.int (Prio));
pragma Assert (Result = 0
or else Shutdown ("GNULLI failure---Set_Priority"));
end Set_Priority;
------------------
-- Get_Priority --
------------------
function Get_Priority (T : Task_ID) return System.Any_Priority is
begin
return System.Any_Priority (T.LL.Current_Priority);
end Get_Priority;
----------------
-- Enter_Task --
----------------
procedure Enter_Task (Self_ID : Task_ID) is
Result : Interfaces.C.int;
Old_Set : aliased sigset_t;
begin
Self_ID.LL.Thread := pthread_self;
-- It is not safe for the new task accept signals until it
-- has bound its TCB pointer to the thread with pthread_setspecific (),
-- since the handler wrappers use the TCB pointer
-- to restore the stack limit.
Result := pthread_setspecific (ATCB_Key, To_Address (Self_ID));
pragma Assert (Result = 0 or else
Shutdown ("GNULLI failure---Enter_Task (pthread_setspecific)"));
-- Must wait until the above operation is done to unmask signals,
-- since signal handler for abort will try to access the ATCB to
-- check whether abort is deferred, and exception propagation will
-- try to use task-specific data as mentioned above.
Result := pthread_sigmask
(SIG_UNBLOCK, Unblocked_Signal_Mask'Access, Old_Set'Access);
pragma Assert (Result = 0
or else Shutdown ("GNULLI failure---Enter_Task (pthread_sigmask)"));
end Enter_Task;
----------------------
-- 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
Result := pthread_mutexattr_init (Mutex_Attr'Access);
pragma Assert (Result = 0 or else Result = ENOMEM
or else Shutdown ("GNULLI failure---pthread_mutexattr_init"));
if Result /= 0 then
Succeeded := False;
return;
end if;
Result := pthread_mutex_init (Self_ID.LL.L'Access, Mutex_Attr'Access);
pragma Assert (Result = 0 or else Result = ENOMEM
or else Shutdown ("GNULLI failure---pthread_mutex_init"));
if Result /= 0 then
Succeeded := False;
return;
end if;
Result := pthread_condattr_init (Cond_Attr'Access);
pragma Assert (Result = 0 or else Result = ENOMEM
or else Shutdown ("GNULLI failure---pthread_condattr_init"));
if Result /= 0 then
Result := pthread_mutex_destroy (Self_ID.LL.L'Access);
pragma Assert (Result = 0
or else Shutdown ("GNULLI failure---pthread_mutex_destory"));
Succeeded := False;
return;
end if;
Result := pthread_cond_init (Self_ID.LL.CV'Access, Cond_Attr'Access);
pragma Assert (Result = 0 or else Result = ENOMEM
or else Shutdown ("GNULLI failure---pthread_cond_init"));
if Result /= 0 then
Result := pthread_mutex_destroy (Self_ID.LL.L'Access);
pragma Assert (Result = 0
or else Shutdown ("GNULLI failure---pthread_mutex_destory"));
Succeeded := False;
return;
end if;
Succeeded := True;
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;
Old_Set : aliased sigset_t;
function Thread_Body_Access is new
Unchecked_Conversion (System.Address, Thread_Body);
begin
if Stack_Size = System.Parameters.Unspecified_Size then
Adjusted_Stack_Size := Interfaces.C.size_t (2 * Default_Stack_Size);
-- Let's change the s-parame.adb to give a larger Stack_Size ?????
else
if Stack_Size < Size_Type (Minimum_Stack_Size) then
Adjusted_Stack_Size :=
Interfaces.C.size_t (Stack_Size + Minimum_Stack_Size);
-- sum, instead of max: may be overkill, but should be safe
-- thr_min_stack is a function call.
-- Actually, we want to get the Default_Stack_Size and
-- Minimum_Stack_Size from the file System.Parameters.
-- Right now the package is not made target specific.
-- We use our own local definitions for now ???
else
Adjusted_Stack_Size := Interfaces.C.size_t (Stack_Size);
end if;
-- Ask for 4 extra bytes of stack space so that the ATCB
-- pointer can be stored below the stack limit, plus extra
-- space for the frame of Task_Wrapper. This is so the user
-- gets the amount of stack requested exclusive of the needs
-- of the runtime.
end if;
Adjusted_Stack_Size := Adjusted_Stack_Size + 4;
-- Since the initial signal mask of a thread is inherited from the
-- creator, we need to set our local signal mask mask all signals
-- during the creation operation, to make sure the new thread is
-- not disturbed by signals before it has set its own Task_ID.
Result := pthread_attr_init (Attributes'Access);
pragma Assert (Result = 0 or else Result = ENOMEM
or else Shutdown ("GNULLI failure---pthread_attr_init"));
if Result /= 0 then
Succeeded := False;
return;
end if;
-- Create threads detached following email to report@gnat.com
-- confirming this is correct (should be fixed for GNAT after 3.09).
-- (Peter Burwood)
Result := pthread_attr_setdetachstate
(Attributes'Access, PTHREAD_CREATE_DETACHED);
pragma Assert (Result = 0
or else Shutdown ("GNULLI failure---pthread_setdetachstate"));
Result := pthread_attr_setstacksize
(Attributes'Access, Interfaces.C.size_t (Adjusted_Stack_Size));
pragma Assert (Result = 0
or else Shutdown ("GNULLI failure---pthread_attr_setstacksize"));
Result := pthread_sigmask
(SIG_SETMASK, All_Signal_Mask'Access, Old_Set'Access);
pragma Assert (Result = 0 or else
Shutdown ("GNULLI failure---Create_Task (pthread_sigmask)"));
Result := pthread_create
(T.LL.Thread'Access,
Attributes'Access,
Thread_Body_Access (Wrapper),
To_Address (T));
pragma Assert (Result = 0 or else Result = EAGAIN
or else Shutdown ("GNULLI failure---Create_Task (pthread_create)"));
Succeeded := Result = 0;
Result := pthread_sigmask
(SIG_SETMASK, Old_Set'Unchecked_Access, null);
pragma Assert (Result = 0 or else
Shutdown ("GNULLI failure---Create_Task (pthread_sigmask)"));
Set_Priority (T, Priority);
end Create_Task;
------------------
-- Finalize_TCB --
------------------
procedure Finalize_TCB (T : Task_ID) is
Result : Interfaces.C.int;
Tmp : Task_ID := T;
procedure Free is new Unchecked_Deallocation
(Ada_Task_Control_Block, Task_ID);
begin
Result := pthread_mutex_destroy (T.LL.L'Access);
pragma Assert (Result = 0 or else
Shutdown ("GNULLI failure---Finalize_TCB (pthread_mutex_destroy)"));
Result := pthread_cond_destroy (T.LL.CV'Access);
pragma Assert (Result = 0 or else
Shutdown ("GNULLI failure---Finalize_TCB (pthread_cond_destroy)"));
-- Following report to report@gnat.com regarding ATCB memory leak
-- this Free is now called. The answer back from ACT didn't give
-- the source for a fix, but I calling this Free is sufficient.
-- (Peter Burwood)
Free (Tmp);
end Finalize_TCB;
---------------
-- Exit_Task --
---------------
procedure Exit_Task is
begin
pthread_exit (System.Null_Address);
end Exit_Task;
----------------
-- Abort_Task --
----------------
procedure Abort_Task (T : Task_ID) is
Result : Interfaces.C.int;
begin
Result := pthread_kill (T.LL.Thread,
Signal (System.Interrupt_Management.Abort_Task_Interrupt));
pragma Assert (Result = 0
or else Shutdown ("GNULLI failure---Abort_Task"));
end Abort_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;
begin
Enter_Task (Environment_Task);
-- Install the abort-signal handler
act.sa_flags := 0;
act.sa_handler := Abort_Handler'Address;
Result := sigemptyset (Tmp_Set'Access);
pragma Assert (Result = 0
or else Shutdown ("GNULLI failure---Initialize (sigemptyset)"));
act.sa_mask := Tmp_Set;
Result :=
sigaction (
Signal (System.Interrupt_Management.Abort_Task_Interrupt),
act'Access,
old_act'Access);
pragma Assert (Result = 0
or else Shutdown ("GNULLI failure---Initialize (sigaction)"));
end Initialize;
begin
declare
Result : Interfaces.C.int;
begin
-- pthread_init;
-- This call is needed for MIT thread library. We wish
-- we could move this to s-osinte.adb and be executed during
-- the package elaboration. However, in doing so we get an
-- elaboration problem.
-- It doesn't appear necessary to call it because pthread_init is
-- called before any Ada elaboration occurs.
Result := sigfillset (All_Signal_Mask'Access);
pragma Assert (Result = 0
or else Shutdown ("GNULLI failure---Initialize (sigfillset)"));
Result := sigemptyset (Unblocked_Signal_Mask'Access);
pragma Assert (Result = 0
or else Shutdown ("GNULLI failure---Initialize (sigemptyset)"));
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
or else Shutdown ("GNULLI failure---Initialize (sigaddset)"));
end if;
end loop;
Result := pthread_key_create (ATCB_Key'Access, null);
pragma Assert (Result = 0
or else Shutdown ("GNULLI failure---Initialize (pthread_keycreate)"));
end;
end System.Task_Primitives.Operations;

138
lang/gnat/files/5ftaspri.ads Normal file
View file

@ -0,0 +1,138 @@
------------------------------------------------------------------------------
-- --
-- GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . T A S K _ P R I M I T I V E S --
-- --
-- S p e c --
-- (Version for new GNARL) --
-- --
-- $Revision: 1.1 $ --
-- --
-- Copyright (C) 1991,92,93,94,95,1996 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. It is --
-- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
-- State University (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This is the FreeBSD PTHREADS version of this package. Contributed
-- by Daniel M. Eischen (deischen@iworks.InterWorks.org).
-- DO NOT EDIT this file.
-- It was automatically generated from another file by the m4 macro processor.
-- The name of the file you should edit is the same as this one, but with
-- ".ads" replaced by ".sm4", or
-- ".adb" replaced by ".bm4", or
-- ".c" replaced by ".cm4", or
-- ".dat" replaced by ".tm4"
-- Local options selected:
-- __TARGET = i386-unknown-freebsd
-- __ARCH = I386
-- __OS = FREEBSD
-- __HAS_SIGCONTEXT = 1
-- __HAS_UCONTEXT = 0
-- __THREADS = POSIX_THREADS
-- __THREAD_VARIANT = ??
-- __HAS_TIMESPEC = 1
-- __HAS_NANOSLEEP = 1
-- __HAS_CLOCK_GETTIME = 0
-- __HAS_GETTIMEOFDAY = 1
-- __POSIX_THREAD_PRIO_PROTECT = 0
-- __POSIX_THREAD_PRIO_INHERIT = 0
-- __POSIX_THREAD_ATTR_STACKADDR = 1
-- __POSIX_THREAD_ATTR_STACKSIZE = 1
-- __POSIX_THREAD_PRIORITY_SCHEDULING = 0
-- This package provides low-level support for most tasking features.
with Interfaces.C;
-- used for int
-- size_t
with System.OS_Interface;
-- used for pthread_mutex_t
-- pthread_cond_t
-- pthread_t
package System.Task_Primitives is
type Lock is limited private;
-- Should be used for implementation of protected objects.
type RTS_Lock is limited private;
-- Should be used inside the runtime system.
-- The difference between Lock and the RTS_Lock is that the later
-- one serves only as a semaphore so that do not check for
-- ceiling violations.
type Task_Body_Access is access procedure;
-- Pointer to the task body's entry point (or possibly a wrapper
-- declared local to the GNARL).
type Private_Data is limited private;
-- Any information that the GNULLI needs maintained on a per-task
-- basis. A component of this type is guaranteed to be included
-- in the Ada_Task_Control_Block.
private
type Lock is new System.OS_Interface.pthread_mutex_t;
type RTS_Lock is new System.OS_Interface.pthread_mutex_t;
type Private_Data is record
Thread : aliased System.OS_Interface.pthread_t;
pragma Atomic (Thread);
-- Thread field may be updated by two different threads of control.
-- (See, Enter_Task and Create_Task in s-taprop.adb).
-- They put the same value (thr_self value). We do not want to
-- use lock on those operations and the only thing we have to
-- make sure is that they are updated in atomic fashion.
CV : aliased System.OS_Interface.pthread_cond_t;
L : aliased RTS_Lock;
-- protection for all components is lock L
Current_Priority : Interfaces.C.int := 0;
-- Active priority, except that the effects of protected object
-- priority ceilings are not reflected. This only reflects explicit
-- priority changes and priority inherited through task activation
-- and rendezvous.
-- Ada 95 notes: In Ada 95, this field will be transferred to the
-- Priority field of an Entry_Calls component when an entry call
-- is initiated. The Priority of the Entry_Calls component will not
-- change for the duration of the call. The accepting task can
-- use it to boost its own priority without fear of its changing in
-- the meantime.
-- This can safely be used in the priority ordering
-- of entry queues. Once a call is queued, its priority does not
-- change.
-- Since an entry call cannot be made while executing
-- a protected action, the priority of a task will never reflect a
-- priority ceiling change at the point of an entry call.
-- Protection: Only written by Self, and only accessed when Acceptor
-- accepts an entry or when Created activates, at which points Self is
-- suspended.
Stack_Size : Interfaces.c.size_t;
-- Requested stack size.
-- Protection: Only used by Self.
end record;
end System.Task_Primitives;

141
lang/gnat/files/patch-aa Normal file
View file

@ -0,0 +1,141 @@
diff -c orig/Makefile.in gcc/Makefile.in
*** orig/Makefile.in Thu Mar 27 17:32:15 1997
--- gcc-2.7.2.1/Makefile.in Fri Apr 4 19:55:09 1997
***************
*** 189,200 ****
local_prefix = /usr/local
# Directory in which to put host dependent programs and libraries
exec_prefix = $(prefix)
# Directory in which to put the executable for the command `gcc'
bindir = $(exec_prefix)/bin
# Directory in which to put the directories used by the compiler.
libdir = $(exec_prefix)/lib
# Directory in which the compiler finds executables, libraries, etc.
! libsubdir = $(libdir)/gcc-lib/$(target)/$(version)
# Directory in which the compiler finds g++ includes.
gxx_include_dir= $(libdir)/g++-include
# Directory to search for site-specific includes.
--- 189,202 ----
local_prefix = /usr/local
# Directory in which to put host dependent programs and libraries
exec_prefix = $(prefix)
+ # directory to hold compilers
+ compdir = $(prefix)/libexec/ada
# Directory in which to put the executable for the command `gcc'
bindir = $(exec_prefix)/bin
# Directory in which to put the directories used by the compiler.
libdir = $(exec_prefix)/lib
# Directory in which the compiler finds executables, libraries, etc.
! libsubdir = $(libdir)
# Directory in which the compiler finds g++ includes.
gxx_include_dir= $(libdir)/g++-include
# Directory to search for site-specific includes.
***************
*** 213,219 ****
mandir = $(prefix)/man/man1
# Directory in which to find other cross-compilation tools and headers.
# Used in install-cross.
! tooldir = $(exec_prefix)/$(target)
# Dir for temp files.
tmpdir = /tmp
--- 215,221 ----
mandir = $(prefix)/man/man1
# Directory in which to find other cross-compilation tools and headers.
# Used in install-cross.
! tooldir = $(exec_prefix)
# Dir for temp files.
tmpdir = /tmp
***************
*** 1141,1148 ****
gcc.o: gcc.c $(CONFIG_H) multilib.h config.status $(lang_specs_files)
$(CC) $(ALL_CFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \
-DSTANDARD_STARTFILE_PREFIX=\"$(libdir)/\" \
! -DSTANDARD_EXEC_PREFIX=\"$(libdir)/gcc-lib/\" \
-DDEFAULT_TARGET_VERSION=\"$(version)\" \
-DDEFAULT_TARGET_MACHINE=\"$(target)\" \
-DTOOLDIR_BASE_PREFIX=\"$(exec_prefix)/\" \
--- 1143,1152 ----
gcc.o: gcc.c $(CONFIG_H) multilib.h config.status $(lang_specs_files)
$(CC) $(ALL_CFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \
+ -DFREEBSD_NATIVE \
+ -DFREEBSD_PREFIX=\"$(prefix)\" \
-DSTANDARD_STARTFILE_PREFIX=\"$(libdir)/\" \
! -DSTANDARD_EXEC_PREFIX=\"$(libdir)/\" \
-DDEFAULT_TARGET_VERSION=\"$(version)\" \
-DDEFAULT_TARGET_MACHINE=\"$(target)\" \
-DTOOLDIR_BASE_PREFIX=\"$(exec_prefix)/\" \
***************
*** 2055,2069 ****
# Create the installation directory.
install-dir:
-if [ -d $(libdir) ] ; then true ; else mkdir $(libdir) ; chmod a+rx $(libdir) ; fi
- -if [ -d $(libdir)/gcc-lib ] ; then true ; else mkdir $(libdir)/gcc-lib ; chmod a+rx $(libdir)/gcc-lib ; fi
# This dir isn't currently searched by cpp.
# -if [ -d $(libdir)/gcc-lib/include ] ; then true ; else mkdir $(libdir)/gcc-lib/include ; chmod a+rx $(libdir)/gcc-lib/include ; fi
! -if [ -d $(libdir)/gcc-lib/$(target) ] ; then true ; else mkdir $(libdir)/gcc-lib/$(target) ; chmod a+rx $(libdir)/gcc-lib/$(target) ; fi
! -if [ -d $(libdir)/gcc-lib/$(target)/$(version) ] ; then true ; else mkdir $(libdir)/gcc-lib/$(target)/$(version) ; chmod a+rx $(libdir)/gcc-lib/$(target)/$(version) ; fi
! -if [ -d $(libdir)/gcc-lib/$(target)/$(version)/include ] ; then true ; else mkdir $(libdir)/gcc-lib/$(target)/$(version)/include ; chmod a+rx $(libdir)/gcc-lib/$(target)/$(version)/include ; fi
-if [ -d $(bindir) ] ; then true ; else mkdir $(bindir) ; chmod a+rx $(bindir) ; fi
-if [ -d $(includedir) ] ; then true ; else mkdir $(includedir) ; chmod a+rx $(includedir) ; fi
-if [ -d $(tooldir) ] ; then true ; else mkdir $(tooldir) ; chmod a+rx $(tooldir) ; fi
-if [ -d $(assertdir) ] ; then true ; else mkdir $(assertdir) ; chmod a+rx $(assertdir) ; fi
-if [ -d $(infodir) ] ; then true ; else mkdir $(infodir) ; chmod a+rx $(infodir) ; fi
# We don't use mkdir -p to create the parents of mandir,
--- 2059,2073 ----
# Create the installation directory.
install-dir:
-if [ -d $(libdir) ] ; then true ; else mkdir $(libdir) ; chmod a+rx $(libdir) ; fi
# This dir isn't currently searched by cpp.
# -if [ -d $(libdir)/gcc-lib/include ] ; then true ; else mkdir $(libdir)/gcc-lib/include ; chmod a+rx $(libdir)/gcc-lib/include ; fi
! # -if [ -d $(libdir)/gcc-lib/$(target) ] ; then true ; else mkdir $(libdir)/gcc-lib/$(target) ; chmod a+rx $(libdir)/gcc-lib/$(target) ; fi
! # -if [ -d $(libdir)/gcc-lib/$(target)/$(version) ] ; then true ; else mkdir $(libdir)/gcc-lib/$(target)/$(version) ; chmod a+rx $(libdir)/gcc-lib/$(target)/$(version) ; fi
! # -if [ -d $(libdir)/gcc-lib/$(target)/$(version)/include ] ; then true ; else mkdir $(libdir)/gcc-lib/$(target)/$(version)/include ; chmod a+rx $(libdir)/gcc-lib/$(target)/$(version)/include ; fi
-if [ -d $(bindir) ] ; then true ; else mkdir $(bindir) ; chmod a+rx $(bindir) ; fi
-if [ -d $(includedir) ] ; then true ; else mkdir $(includedir) ; chmod a+rx $(includedir) ; fi
-if [ -d $(tooldir) ] ; then true ; else mkdir $(tooldir) ; chmod a+rx $(tooldir) ; fi
+ -if [ -d $(compdir) ] ; then true ; else mkdir $(compdir) ; chmod a+rx $(compdir) ; fi
-if [ -d $(assertdir) ] ; then true ; else mkdir $(assertdir) ; chmod a+rx $(assertdir) ; fi
-if [ -d $(infodir) ] ; then true ; else mkdir $(infodir) ; chmod a+rx $(infodir) ; fi
# We don't use mkdir -p to create the parents of mandir,
***************
*** 2077,2084 ****
install-common: native install-dir $(EXTRA_PARTS) lang.install-common
for file in $(COMPILERS); do \
if [ -f $$file ] ; then \
! rm -f $(libsubdir)/$$file; \
! $(INSTALL_PROGRAM) $$file $(libsubdir)/$$file; \
else true; \
fi; \
done
--- 2081,2088 ----
install-common: native install-dir $(EXTRA_PARTS) lang.install-common
for file in $(COMPILERS); do \
if [ -f $$file ] ; then \
! rm -f $(compdir)/$$file; \
! $(INSTALL_PROGRAM) $$file $(compdir)/$$file; \
else true; \
fi; \
done
***************
*** 2110,2117 ****
$(INSTALL_DATA) SYSCALLS.c.X $(libsubdir)/SYSCALLS.c.X; \
chmod a-x $(libsubdir)/SYSCALLS.c.X; \
fi
! -rm -f $(libsubdir)/cpp$(exeext)
! $(INSTALL_PROGRAM) cpp$(exeext) $(libsubdir)/cpp$(exeext)
# Install the driver program as $(target)-gcc
# and also as either gcc (if native) or $(tooldir)/bin/gcc.
--- 2114,2121 ----
$(INSTALL_DATA) SYSCALLS.c.X $(libsubdir)/SYSCALLS.c.X; \
chmod a-x $(libsubdir)/SYSCALLS.c.X; \
fi
! -rm -f $(compdir)/cpp$(exeext)
! $(INSTALL_PROGRAM) cpp$(exeext) $(compdir)/cpp$(exeext)
# Install the driver program as $(target)-gcc
# and also as either gcc (if native) or $(tooldir)/bin/gcc.

36
lang/gnat/files/patch-ab Normal file
View file

@ -0,0 +1,36 @@
diff -c orig/gcc.c gcc/gcc.c
*** orig/gcc.c Thu Apr 3 08:37:06 1997
--- gcc-2.7.2.1/gcc.c Fri Apr 4 23:21:00 1997
***************
*** 1354,1362 ****
#undef MD_STARTFILE_PREFIX_1
#endif
! #ifndef STANDARD_EXEC_PREFIX
! #define STANDARD_EXEC_PREFIX "/usr/local/lib/gcc-lib/"
! #endif /* !defined STANDARD_EXEC_PREFIX */
static char *standard_exec_prefix = STANDARD_EXEC_PREFIX;
static char *standard_exec_prefix_1 = "/usr/lib/gcc/";
--- 1354,1360 ----
#undef MD_STARTFILE_PREFIX_1
#endif
! #define STANDARD_EXEC_PREFIX FREEBSD_PREFIX "/libexec/"
static char *standard_exec_prefix = STANDARD_EXEC_PREFIX;
static char *standard_exec_prefix_1 = "/usr/lib/gcc/";
***************
*** 2708,2715 ****
--- 2706,2716 ----
/* Use 2 as fourth arg meaning try just the machine as a suffix,
as well as trying the machine and the version. */
#ifdef FREEBSD_NATIVE
+ add_prefix (&exec_prefixes, FREEBSD_PREFIX "/libexec/ada/", 0, 0, NULL_PTR);
+ add_prefix (&exec_prefixes, FREEBSD_PREFIX "/libexec/", 0, 0, NULL_PTR);
add_prefix (&exec_prefixes, "/usr/libexec/", 0, 0, NULL_PTR);
add_prefix (&exec_prefixes, "/usr/bin/", 0, 0, NULL_PTR);
+ add_prefix (&startfile_prefixes, FREEBSD_PREFIX "/lib/", 0, 0, NULL_PTR);
add_prefix (&startfile_prefixes, "/usr/libdata/gcc/", 0, 0, NULL_PTR);
#else /* not FREEBSD_NATIVE */
#ifndef OS2

20
lang/gnat/files/patch-ac Normal file
View file

@ -0,0 +1,20 @@
diff -c orig/ada/Makefile.in gcc/ada/Makefile.in
*** orig/ada/Makefile.in Thu Apr 3 12:40:23 1997
--- gcc-2.7.2.1/ada/Makefile.in Thu Apr 3 12:41:49 1997
***************
*** 956,962 ****
$(srcdir)/../move-if-change tmp-ttypef.ads ttypef.ads
touch stamp-ttypef
! ADA_INCLUDE_DIR = $(prefix)/adainclude
ADA_RTL_OBJ_DIR = $(libsubdir)/adalib
# Note: the strings below do not make sense for Ada strings in the OS/2
--- 956,962 ----
$(srcdir)/../move-if-change tmp-ttypef.ads ttypef.ads
touch stamp-ttypef
! ADA_INCLUDE_DIR = $(prefix)/include/adainclude
ADA_RTL_OBJ_DIR = $(libsubdir)/adalib
# Note: the strings below do not make sense for Ada strings in the OS/2

46
lang/gnat/files/patch-ad Normal file
View file

@ -0,0 +1,46 @@
diff -c orig/ada/Makefile.in gcc/ada/Makefile.in
*** orig/ada/Makefile.in Tue Jan 21 00:01:54 1997
--- gcc-2.7.2.1/ada/Makefile.in Sat May 10 22:42:27 1997
***************
*** 189,193 ****
$(CC) -c $(ALL_ADAFLAGS) $<
.ads.o:
! $(CC) -c $(ALL_ADAFLAGS) $<
# This tells GNU make version 3 not to export all the variables
--- 189,199 ----
$(CC) -c $(ALL_ADAFLAGS) $<
.ads.o:
! @if [ -f $*.adb ]; then \
! echo "$(CC) -c $(ALL_ADAFLAGS) $*.adb"; \
! $(CC) -c $(ALL_ADAFLAGS) $*.adb; \
! else \
! echo "$(CC) -c $(ALL_ADAFLAGS) $*.ads"; \
! $(CC) -c $(ALL_ADAFLAGS) $*.ads; \
! fi
# This tells GNU make version 3 not to export all the variables
***************
*** 738,741 ****
--- 744,748 ----
sparc-sun-sunos5*) letter=s ;;\
*86*-linux*) letter=l ;;\
+ *86*-freebsd*) letter=f ;;\
mips-sgi-irix*) letter=g ;;\
hppa*-hp-hpux*) letter=h ;;\
***************
*** 779,782 ****
--- 786,790 ----
*-go32-msdos | *-go32 |\
*86*-linux* |\
+ *86*-freebsd* |\
*) \
\
***************
*** 845,848 ****
--- 853,857 ----
*-go32-msdos | *-go32 |\
*86*-linux* |\
+ *86*-freebsd* |\
*) \
\

36
lang/gnat/files/patch-ae Normal file
View file

@ -0,0 +1,36 @@
*** gcc/ada/make.adb.orig Thu Jun 5 08:37:34 1997
--- gcc-2.7.2.1/ada/make.adb Thu Jun 5 11:30:57 1997
***************
*** 191,197 ****
-- Compiler, Binder & Linker Data and Subprograms --
----------------------------------------------------
! Gcc : String_Access := GNAT.OS_Lib.Locate_Exec_On_Path ("gcc");
Gnatbind : String_Access := GNAT.OS_Lib.Locate_Exec_On_Path ("gnatbind");
Gnatlink : String_Access := GNAT.OS_Lib.Locate_Exec_On_Path ("gnatlink");
--- 191,197 ----
-- Compiler, Binder & Linker Data and Subprograms --
----------------------------------------------------
! Gcc : String_Access := GNAT.OS_Lib.Locate_Exec_On_Path ("adagcc");
Gnatbind : String_Access := GNAT.OS_Lib.Locate_Exec_On_Path ("gnatbind");
Gnatlink : String_Access := GNAT.OS_Lib.Locate_Exec_On_Path ("gnatlink");
***************
*** 778,784 ****
Comp_Last := Comp_Last + 1;
Comp_Args (Comp_Last) := new String'(Name_Buffer (1 .. Name_Len));
! Display ("gcc", Comp_Args (Args'First .. Comp_Last));
return
GNAT.OS_Lib.Non_Blocking_Spawn
--- 778,784 ----
Comp_Last := Comp_Last + 1;
Comp_Args (Comp_Last) := new String'(Name_Buffer (1 .. Name_Len));
! Display ("adagcc", Comp_Args (Args'First .. Comp_Last));
return
GNAT.OS_Lib.Non_Blocking_Spawn

19
lang/gnat/files/patch-af Normal file
View file

@ -0,0 +1,19 @@
*** gcc/ada/gnatcmd.adb.orig Wed Jun 4 17:47:51 1997
--- gcc-2.7.2.1/ada/gnatcmd.adb Wed Jun 4 17:48:17 1997
***************
*** 899,905 ****
(Cname => new S'("COMPILE"),
Usage => new S'("GNAT COMPILE file file .. file /qualifiers"),
! Unixcmd => new S'("gcc -c"),
Switches => GCC_Switches'Access,
Minfile => 1,
Maxfile => 0,
--- 899,905 ----
(Cname => new S'("COMPILE"),
Usage => new S'("GNAT COMPILE file file .. file /qualifiers"),
! Unixcmd => new S'("adagcc -c"),
Switches => GCC_Switches'Access,
Minfile => 1,
Maxfile => 0,

184
lang/gnat/pkg-descr
View file

@ -1,181 +1,7 @@
GNAT IMPLEMENTED FEATURES LIST
Current as of 01/26/95
The GNU ada compiler Gnat 3.09 built on GCC 2.7.2.1.
Here is the list of implemented and not implemented features. A more precise
description of the GNAT system is provided in the file 'gnatinfo.txt', which
is part of the GNAT distribution.
Latest features in GNAT version 2.02
====================================
Extension aggregates are implemented (not much tested so far)
The Storage_Pool mechanism is in place
Functions returning unconstrained values shouldn't leak anymore
Enumeration representation clauses are fully implemented
Record representation clauses are implemented (currently there is
a restriction that all fields must be given a position and tagged
records cannot yet be given representation clauses)
The constrained attribute is implemented
Conformance checking is fully implemented
Shared variables (pragmas Shared, Atomic, Atomic_Components,
Volatile, and Volatile_Components) are implemented
User-defined Initialize/Adjust/Finalize is now almost complete for
controlled types as well as for types containing controlled components.
(aggregates involving controlled types and functions returning objects
with controlled components may still cause trouble).
Alignment attribute and attribute definition clause are implemented
Pred and Succ for fixed-point types are implemented
Discard_Names pragma is implemented
Arrays are passed properly to convention C routines
Pragma Inspection_Point is implemented
Pragma Locking_Policy is implemented
Pragma Task_Dispatching_Policy is implemented
Pragma Memory_Size is implemented (it is ignored anyway)
Derived types from private types are impelmented
Floating-point attribute functions are implemented:
Adjacent, Ceiling, Compose, Copy_Sign, Exponent, Floor, Fraction,
Leading_Part, Machine, Model, Pred, Remainder, Rounding, Scaling, Succ,
Truncation, Unbiased_Rounding
Pragma Optimize is implemented (checks that GCC optimization level is
consistent)
Pragma Reviewable is implemented (checks that GCC debug option "-g" is set)
Pragma Controlled is implemented (but ignored so far)
The attributes Version and Body_Version are implemented
Pragma Linker_Options is implemented
Attribute Max_Size_In_Storage_Elements is implemented
The attribute Valid is implemented
Requeue without abort is implemented
Delay statement on OS/2 is now working correctly.
The attribute Bit_Order is implemented
Range checking for modular types
Length checks are now implemented
Pragma Import Fortran and COBOL are implemented
Pragma Convention is now fully implemented (for C, Fortran, COBOL),
Pragma Convention for Fortran correctly maps multi-dimensional arrays
=======================================================================
Status of Features
============================================================================
= All of Ada 83 is implemented EXCEPT the following unimplemented features =
============================================================================
The following language-defined checks are not implemented:
Discriminant Checks
Elaboration Checks
Range Checks on the elaboration of a subtype_indication
Stack overflow checking
Language-Defined Pragmas
Pack for arrays
Input-Output for Integer for type Long_Long_Integer.
(only Put currently supported for Long_Long_Integer not Get)
Delay is not yet fixed-point as required (the current temporary
implementation uses floating-point to represent Delay).
Tasking is currently implemented only on the following platforms
SGI IRIX 5.2, Sun Sparc (SunOS 4.1), i386 running IBM OS/2
=========================================================================
= All of Ada 95 implemented EXCEPT the following unimplemented features =
=========================================================================
CORE
Protected entry families
Protected subprogram pointers
Condition protected entry calls
Requeue Statement involving task entries
Delay until
Input-Output for Modular Types
(Only Put is supported currently, Get not yet supported)
Input-Output for Decimal Types
Input-Output for Wide Text
Objects of type with unknown discriminants
Unimplemented subprograms in package Ada.Text_IO
Flush
Look_Ahead
Get_Immediate
Accessibility checks
Stream-Oriented Attributes of Specific Types
Stream-Oriented Attributes of Class-Wide Types
ANNEX A. PREDEFINED LANGUAGE ENVIRONMENT
Ada.Exceptions
Ada.Interrupts
Ada.Streams.Stream_IO
Ada.Wide_Text_IO
Ada.Wide_Text_IO.Complex_IO
ANNEX B. INTERFACING TO OTHER LANGUAGES
The body of Interfaces.COBOL is not yet implemented
ANNEX C. SYSTEMS PROGRAMMING
Machine intrinsic subprograms
Interrupt support
The body of package Interrupts is not implemented
Preelaboration requirements are not fully met
ANNEX D. REAL-TIME SYSTEMS
Tasking restrictions
Synchronous task control
ANNEX E. DISTRIBUTED SYSTEMS
The distribution annex is under active development. Stub generation
is not yet implemented, and there is no configuration control program.
All pragmas are fully implemented.
ANNEX F. INFORMATION SYSTEMS
Ada.Text_IO.Editing
Ada.Wide_Text_IO.Editing
ANNEX G. NUMERICS
Accuracy requirements for floating-point and complex not fully met
ANNEX H. SAFETY AND SECURITY
pragma Normalize_Scalars
Safety and security restrictions
ANNEX I. OBSOLESCENT FEATURES
Interrupt entries
ANNEX J. LANGUAGE-DEFINED ATTRIBUTES
Caller
Definite
External_Tag
Identity
Input
Output
Read
Storage_Pool
Write
ANNEX K. LANGUAGE DEFINED PRAGMAS
Attach_Handler
Export
Interrupt_Handler
Normalize_Scalars
Queuing_Policy
Restrictions
The libraries supplied with this version of GNAT support tasking if
minor modifications are made to FreeBSD's libc_r.
Maurice Castro
maurice@serc.rmit.edu.au

615
lang/gnat/pkg-plist
View file

File diff suppressed because it is too large Load diff