mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-04 23:01:19 +08:00
Code Issues Packages Projects Releases Wiki Activity

bld.ads, [...]: Remove gpr2make, replaced by gprmake.

Browse Source 
* bld.ads, bld.adb, bld-io.ads, bld-io.adb, gprcmd.adb,
	gpr2make.ads, gpr2make.adb: Remove gpr2make, replaced by gprmake.

	* Makefile.in: Add support to build shared Ada libraries on solaris x86
	Remove gpr2make, replaced by gprmake.
	Remove references to gnatmem and libaddr2line.
	Add indepsw.adb<indepsw-linux.adb to TOOLS_TARGET_PAIRS for IA64 linux.
	(gnatlib-shared-darwin): Add "-fno-common" to GNATLIBCFLAGS.
	Add support for specialized version of Ada.Numerics.Aux for Darwin: use
	a-numaux-darwin.ads and a-numaux-darwin.adb
	Enable mlib-tgt-lynxos.adb on lynxos.

	* Make-lang.in: Remove rules for gpr2make.
	When generating sdefault.adb, do not call Relocate_Path
	on S3 for function Target_Name, as it is not a path.
	Remove references to gnatmem and libaddr2line.

	* a-numaux-darwin.ads, a-numaux-darwin.adb, g-soccon-darwin.ads: New
	files.

From-SVN: r92831
This commit is contained in:
Arnaud Charlet 2005-01-03 16:34:18 +01:00
parent 165eab5ffc
commit e6d50a9e9d
12 changed files with 481 additions and 4784 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
gcc/ada/Make-lang.in
View File

@ -321,10 +321,6 @@ ada.all.cross:
then \
$(MV) gnatmake$(exeext) gnatmake-cross$(exeext); \
fi
-if [ -f gnatmem$(exeext) ] ; \
then \
$(MV) gnatmem$(exeext) gnatmem-cross$(exeext); \
fi
-if [ -f gnatname$(exeext) ] ; \
then \
$(MV) gnatname$(exeext) gnatname-cross$(exeext); \
@ -353,14 +349,6 @@ ada.all.cross:
then \
$(MV) gprmake$(exeext) gprmake-cross$(exeext); \
fi
-if [ -f gpr2make$(exeext) ] ; \
then \
$(MV) gpr2make$(exeext) gpr2make-cross$(exeext); \
fi
-if [ -f gprcmd$(exeext) ] ; \
then \
$(MV) gprcmd$(exeext) gprcmd-cross$(exeext); \
fi
ada.start.encap:
ada.rest.encap:
@ -447,7 +435,7 @@ ada.install-normal:
# and also as either gnatbind (if native) or $(tooldir)/bin/gnatbind
# likewise for gnatf, gnatchop, and gnatlink, gnatkr, gnatmake, gnat,
# gnatprep, gnatbl, gnatls, gnatxref, gnatfind, gnatname, gnatclean,
# gnatsym, gprmake, gpr2make, gprcmd
# gnatsym, gprmake
ada.install-common:
$(MKDIR) $(DESTDIR)$(bindir)
-if [ -f gnat1$(exeext) ] ; \
@ -571,17 +559,6 @@ ada.install-common:
fi ; \
fi
-if [ -f gnat1$(exeext) ] ; \
then \
if [ -f gnatmem-cross$(exeext) ] ; \
then \
$(RM) $(DESTDIR)$(bindir)/$(target_noncanonical)-gnatmem$(exeext); \
$(INSTALL_PROGRAM) gnatmem-cross$(exeext) $(DESTDIR)$(bindir)/$(target_noncanonical)-gnatmem$(exeext); \
else \
$(RM) $(DESTDIR)$(bindir)/gnatmem$(exeext); \
$(INSTALL_PROGRAM) gnatmem$(exeext) $(DESTDIR)$(bindir)/gnatmem$(exeext); \
fi ; \
fi
-if [ -f gnat1$(exeext) ] ; \
then \
if [ -f gnatname-cross$(exeext) ] ; \
then \
@ -651,22 +628,6 @@ ada.install-common:
$(INSTALL_PROGRAM) gprmake$(exeext) $(DESTDIR)$(bindir)/gprmake$(exeext); \
fi ; \
fi
-if [ -f gnat1$(exeext) ] ; \
then \
if [ -f gpr2make$(exeext) ] ; \
then \
$(RM) $(DESTDIR)$(bindir)/gpr2make$(exeext); \
$(INSTALL_PROGRAM) gpr2make$(exeext) $(DESTDIR)$(bindir)/gpr2make$(exeext); \
fi ; \
fi
-if [ -f gnat1$(exeext) ] ; \
then \
if [ -f gprcmd$(exeext) ] ; \
then \
$(RM) $(DESTDIR)$(bindir)/gprcmd$(exeext); \
$(INSTALL_PROGRAM) gprcmd$(exeext) $(DESTDIR)$(bindir)/gprcmd$(exeext); \
fi ; \
fi
#
# Gnatsym is only built on some platforms, including VMS
#
@ -738,7 +699,6 @@ ada.uninstall:
-$(RM) $(DESTDIR)$(bindir)/gnatlink$(exeext)
-$(RM) $(DESTDIR)$(bindir)/gnatls$(exeext)
-$(RM) $(DESTDIR)$(bindir)/gnatmake$(exeext)
-$(RM) $(DESTDIR)$(bindir)/gnatmem$(exeext)
-$(RM) $(DESTDIR)$(bindir)/gnatname$(exeext)
-$(RM) $(DESTDIR)$(bindir)/gnatprep$(exeext)
-$(RM) $(DESTDIR)$(bindir)/gnatxref$(exeext)
@ -755,7 +715,6 @@ ada.uninstall:
-$(RM) $(DESTDIR)$(bindir)/$(target_noncanonical)-gnatlink$(exeext)
-$(RM) $(DESTDIR)$(bindir)/$(target_noncanonical)-gnatls$(exeext)
-$(RM) $(DESTDIR)$(bindir)/$(target_noncanonical)-gnatmake$(exeext)
-$(RM) $(DESTDIR)$(bindir)/$(target_noncanonical)-gnatmem$(exeext)
-$(RM) $(DESTDIR)$(bindir)/$(target_noncanonical)-gnatname$(exeext)
-$(RM) $(DESTDIR)$(bindir)/$(target_noncanonical)-gnatprep$(exeext)
-$(RM) $(DESTDIR)$(bindir)/$(target_noncanonical)-gnatxref$(exeext)
@ -772,7 +731,6 @@ ada.uninstall:
-$(RM) $(DESTDIR)$(tooldir)/bin/gnatlink$(exeext)
-$(RM) $(DESTDIR)$(tooldir)/bin/gnatls$(exeext)
-$(RM) $(DESTDIR)$(tooldir)/bin/gnatmake$(exeext)
-$(RM) $(DESTDIR)$(tooldir)/bin/gnatmem$(exeext)
-$(RM) $(DESTDIR)$(tooldir)/bin/gnatname$(exeext)
-$(RM) $(DESTDIR)$(tooldir)/bin/gnatprep$(exeext)
-$(RM) $(DESTDIR)$(tooldir)/bin/gnatxref$(exeext)
@ -801,14 +759,12 @@ ada.distclean:
-$(RM) gnatlink$(exeext)
-$(RM) gnatls$(exeext)
-$(RM) gnatmake$(exeext)
-$(RM) gnatmem$(exeext)
-$(RM) gnatname$(exeext)
-$(RM) gnatprep$(exeext)
-$(RM) gnatfind$(exeext)
-$(RM) gnatxref$(exeext)
-$(RM) gnatclean$(exeext)
-$(RM) gnatsym$(exeext)
-$(RM) gpr2make$(exeext)
-$(RM) gprmake$(exeext)
# Gnatlbr is only used on VMS
-$(RM) gnatlbr$(exeext)
@ -969,7 +925,7 @@ ada/stamp-sdefault : $(srcdir)/version.c Makefile
$(ECHO) " end Object_Dir_Default_Name;" >>tmp-sdefault.adb
$(ECHO) " function Target_Name return String_Ptr is" >>tmp-sdefault.adb
$(ECHO) " begin" >>tmp-sdefault.adb
$(ECHO) " return Relocate_Path (S0, S3);" >>tmp-sdefault.adb
$(ECHO) " return new String'(S3);" >>tmp-sdefault.adb
$(ECHO) " end Target_Name;" >>tmp-sdefault.adb
$(ECHO) " function Search_Dir_Prefix return String_Ptr is" >>tmp-sdefault.adb
$(ECHO) " begin" >>tmp-sdefault.adb

65
gcc/ada/Makefile.in
View File

@ -133,8 +133,6 @@ THREAD_KIND = native
THREADSLIB =
GMEM_LIB =
MISCLIB =
SYMLIB =
ADDR2LINE_SYMLIB = -laddr2line -lbfd -liberty $(LIBINTL)
SYMDEPS = $(LIBINTL_DEP)
OUTPUT_OPTION = @OUTPUT_OPTION@
@ -716,7 +714,6 @@ ifeq ($(strip $(filter-out sparc sun solaris%,$(targ))),)
THREADSLIB = -lposix4 -lthread
MISCLIB = -lposix4 -lnsl -lsocket
SYMLIB = $(ADDR2LINE_SYMLIB)
SO_OPTS = -Wl,-h,
GNATLIB_SHARED = gnatlib-shared-dual
GMEM_LIB = gmemlib
@ -800,10 +797,13 @@ ifeq ($(strip $(filter-out %86 solaris2%,$(arch) $(osys))),)
g-soliop.ads<g-soliop-solaris.ads \
system.ads<system-solaris-x86.ads
TOOLS_TARGET_PAIRS=mlib-tgt.adb<mlib-tgt-solaris.adb
THREADSLIB = -lposix4 -lthread
MISCLIB = -lposix4 -lnsl -lsocket
SO_OPTS = -Wl,-h,
GNATLIB_SHARED = gnatlib-shared-dual
GMEM_LIB = gmemlib
PREFIX_OBJS = $(PREFIX_REAL_OBJS)
LIBRARY_VERSION := $(LIB_VERSION)
endif
@ -829,7 +829,6 @@ ifeq ($(strip $(filter-out %86 linux%,$(arch) $(osys))),)
mlib-tgt.adb<mlib-tgt-linux.adb \
indepsw.adb<indepsw-linux.adb
SYMLIB = $(ADDR2LINE_SYMLIB)
THREADSLIB = -lpthread
GNATLIB_SHARED = gnatlib-shared-dual
GMEM_LIB = gmemlib
@ -877,7 +876,6 @@ ifeq ($(strip $(filter-out %86 freebsd%,$(arch) $(osys))),)
mlib-tgt.adb<mlib-tgt-linux.adb
GNATLIB_SHARED = gnatlib-shared-dual
SYMLIB = $(ADDR2LINE_SYMLIB)
THREADSLIB= -lc_r
GMEM_LIB = gmemlib
PREFIX_OBJS = $(PREFIX_REAL_OBJS)
@ -1012,7 +1010,6 @@ ifeq ($(strip $(filter-out hppa% hp hpux11%,$(targ))),)
TOOLS_TARGET_PAIRS = mlib-tgt.adb<mlib-tgt-hpux.adb
TGT_LIB = /usr/lib/libcl.a
THREADSLIB = -lpthread
SYMLIB = $(ADDR2LINE_SYMLIB)
GMEM_LIB = gmemlib
soext = .sl
SO_OPTS = -Wl,+h,
@ -1081,11 +1078,11 @@ ifeq ($(strip $(filter-out ibm aix%,$(manu) $(osys))),)
indepsw.adb<indepsw-aix.adb
GMEM_LIB = gmemlib
SYMLIB = $(ADDR2LINE_SYMLIB)
endif
ifeq ($(strip $(filter-out lynxos,$(osys))),)
TOOLS_TARGET_PAIRS=mlib-tgt.adb<mlib-tgt-lynxos.adb
ifeq ($(strip $(filter-out %86 lynxos,$(arch) $(osys))),)
LIBGNAT_TARGET_PAIRS = \
a-numaux.adb<a-numaux-x86.adb \
@ -1130,7 +1127,6 @@ ifeq ($(strip $(filter-out lynxos,$(osys))),)
s-tpopsp.adb<s-tpopsp-lynxos.adb \
system.ads<system-lynxos-ppc.ads
endif
endif
endif
@ -1168,7 +1164,6 @@ ifeq ($(strip $(filter-out alpha% dec osf%,$(targ))),)
TOOLS_TARGET_PAIRS=mlib-tgt.adb<mlib-tgt-tru64.adb
GMEM_LIB=gmemlib
SYMLIB = $(ADDR2LINE_SYMLIB)
THREADSLIB = -lpthread -lmach -lexc -lrt
PREFIX_OBJS = $(PREFIX_REAL_OBJS)
GNATLIB_SHARED = gnatlib-shared-default
@ -1304,7 +1299,6 @@ ifeq ($(strip $(filter-out cygwin32% mingw32% pe,$(osys))),)
indepsw.adb<indepsw-mingw.adb
MISCLIB = -lwsock32
SYMLIB = $(ADDR2LINE_SYMLIB)
GMEM_LIB = gmemlib
PREFIX_OBJS = $(PREFIX_REAL_OBJS)
EXTRA_GNATTOOLS = ../../gnatdll$(exeext)
@ -1335,7 +1329,6 @@ ifeq ($(strip $(filter-out powerpc% linux%,$(arch) $(osys))),)
mlib-tgt.adb<mlib-tgt-linux.adb \
indepsw.adb<indepsw-linux.adb
SYMLIB = $(ADDR2LINE_SYMLIB)
THREADSLIB = -lpthread
GNATLIB_SHARED = gnatlib-shared-dual
GMEM_LIB = gmemlib
@ -1358,7 +1351,10 @@ ifeq ($(strip $(filter-out %ia64 linux%,$(arch) $(osys))),)
s-taspri.ads<s-taspri-linux.ads \
system.ads<system-linux-ia64.ads
TOOLS_TARGET_PAIRS=mlib-tgt.adb<mlib-tgt-linux.adb
TOOLS_TARGET_PAIRS = \
mlib-tgt.adb<mlib-tgt-linux.adb \
indepsw.adb<indepsw-linux.adb
MISCLIB=
THREADSLIB=-lpthread
GNATLIB_SHARED=gnatlib-shared-dual
@ -1382,7 +1378,6 @@ ifeq ($(strip $(filter-out %x86_64 linux%,$(arch) $(osys))),)
system.ads<system-linux-x86_64.ads
TOOLS_TARGET_PAIRS=mlib-tgt.adb<mlib-tgt-linux.adb
SYMLIB = $(ADDR2LINE_SYMLIB)
THREADSLIB=-lpthread
GNATLIB_SHARED=gnatlib-shared-dual
GMEM_LIB = gmemlib
@ -1401,7 +1396,9 @@ ifeq ($(strip $(filter-out powerpc darwin%,$(arch) $(osys))),)
s-taprop.adb<s-taprop-posix.adb \
s-taspri.ads<s-taspri-posix.ads \
s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
g-soccon.ads<g-soccon-aix.ads \
g-soccon.ads<g-soccon-darwin.ads \
a-numaux.ads<a-numaux-darwin.ads \
a-numaux.adb<a-numaux-darwin.adb \
system.ads<system-darwin-ppc.ads
TOOLS_TARGET_PAIRS = \
@ -1413,9 +1410,7 @@ ifeq ($(strip $(filter-out powerpc darwin%,$(arch) $(osys))),)
GMEM_LIB = gmemlib
LIBRARY_VERSION := $(LIB_VERSION)
soext = .dylib
endif
# The runtime library for gnat comprises two directories. One contains the
@ -1430,7 +1425,7 @@ endif
LIBGNAT_SRCS = ada.h adaint.c adaint.h argv.c cio.c cstreams.c \
errno.c exit.c cal.c ctrl_c.c \
raise.h raise.c sysdep.c aux-io.c init.c \
final.c tracebak.c tb-alvms.c tb-alvxw.c expect.c mkdir.c socket.c \
final.c tracebak.c tb-alvms.c tb-alvxw.c expect.c mkdir.c socket.c gsocket.h \
$(EXTRA_LIBGNAT_SRCS)
LIBGNAT_OBJS = adaint.o argv.o cio.o cstreams.o ctrl_c.o errno.o exit.o \
@ -1537,14 +1532,14 @@ gnattools2: ../stamp-tools
../../gnatls$(exeext) ../../gnatprep$(exeext) \
../../gnatxref$(exeext) \
../../gnatfind$(exeext) ../../gnatname$(exeext) \
../../gnatclean$(exeext) ../../gprmake$(exeext) \
../../gprcmd$(exeext) ../../gpr2make$(exeext)
../../gnatclean$(exeext) ../../gprmake$(exeext)
# These tools are only built for the native version.
gnattools3: ../stamp-tools
# $(MAKE) -C tools -f ../Makefile $(TOOLS_FLAGS_TO_PASS) \
# TOOLSCASE=native top_builddir=../../.. \
# ../../gnatmem$(exeext) $(EXTRA_GNATTOOLS)
ifneq ($(EXTRA_GNATTOOLS),)
$(MAKE) -C tools -f ../Makefile $(TOOLS_FLAGS_TO_PASS) \
TOOLSCASE=native top_builddir=../../.. $(EXTRA_GNATTOOLS)
endif
# those tools are only built for the cross version
gnattools4: ../stamp-tools
@ -1585,12 +1580,6 @@ gnattools4: ../stamp-tools
$(GNATLINK) -v gprmake -o $@ --GCC="$(CC) $(ADA_INCLUDES)" \
$(TOOLS_LIBS)
../../gpr2make$(exeext): ../stamp-tools
$(GNATMAKE) -c $(ADA_INCLUDES) gpr2make --GCC="$(CC) $(ALL_ADAFLAGS)"
$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gpr2make
$(GNATLINK) -v gpr2make -o $@ --GCC="$(CC) $(ADA_INCLUDES)" \
$(TOOLS_LIBS)
../../gnatprep$(exeext): ../stamp-tools
$(GNATMAKE) -c $(ADA_INCLUDES) gnatprep --GCC="$(CC) $(ALL_ADAFLAGS)"
$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatprep
@ -1621,25 +1610,12 @@ gnattools4: ../stamp-tools
$(GNATLINK) -v gnatsym -o $@ --GCC="$(CC) $(ADA_INCLUDES)" \
$(TOOLS_LIBS)
../../gnatmem$(exeext): ../stamp-tools gmem.o $(SYMDEPS)
ifeq ($(GMEM_LIB),gmemlib)
$(GNATMAKE) -c $(ADA_INCLUDES) gnatmem --GCC="$(CC) $(ALL_ADAFLAGS)"
$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatmem
$(GNATLINK) -v gnatmem -o $@ --GCC="$(CC) $(ADA_INCLUDES)" \
gmem.o $(SYMLIB) $(TOOLS_LIBS)
endif
../../gnatdll$(exeext): ../stamp-tools
$(GNATMAKE) -c $(ADA_INCLUDES) gnatdll --GCC="$(CC) $(ALL_ADAFLAGS)"
$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) $(GNATBIND_FLAGS) gnatdll
$(GNATLINK) -v gnatdll -o $@ --GCC="$(CC) $(ADA_INCLUDES)" \
$(TOOLS_LIBS)
../../gprcmd$(exeext): ../stamp-tools
$(GNATMAKE) -c $(ADA_INCLUDES) gprcmd --GCC="$(CC) $(ALL_ADAFLAGS)"
$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gprcmd
$(GNATLINK) -v gprcmd -o $@ --GCC="$(CC) $(ADA_INCLUDES)" $(TOOLS_LIBS)
../../vxaddr2line$(exeext): ../stamp-tools
$(GNATMAKE) -c $(ADA_INCLUDES) vxaddr2line --GCC="$(CC) $(ALL_ADAFLAGS)"
$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) vxaddr2line
@ -1890,7 +1866,8 @@ gnatlib-shared-win32:
gnatlib-shared-darwin:
$(MAKE) $(FLAGS_TO_PASS) \
GNATLIBFLAGS="$(GNATLIBFLAGS)" \
GNATLIBCFLAGS="$(GNATLIBCFLAGS) $(TARGET_LIBGCC2_CFLAGS)" \
GNATLIBCFLAGS="$(GNATLIBCFLAGS) $(TARGET_LIBGCC2_CFLAGS) \
-fno-common" \
THREAD_KIND="$(THREAD_KIND)" \
gnatlib
$(RM) rts/libgnat$(soext) rts/libgnarl$(soext)
@ -2039,7 +2016,7 @@ final.o : raise.h final.c
gmem.o : gmem.c
link.o : link.c
mkdir.o : mkdir.c
socket.o : socket.c
socket.o : socket.c gsocket.h
sysdep.o : sysdep.c
cio.o : cio.c

186
gcc/ada/a-numaux-darwin.adb Normal file
View File

@ -0,0 +1,186 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . N U M E R I C S . A U X --
-- --
-- B o d y --
-- (Apple OS X Version) --
-- --
-- Copyright (C) 1998-2004 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. --
-- --
------------------------------------------------------------------------------
-- File a-numaux.adb <- a-numaux-darwin.adb
package body Ada.Numerics.Aux is
-----------------------
-- Local subprograms --
-----------------------
procedure Reduce (X : in out Double; Q : out Natural);
-- Implements reduction of X by Pi/2. Q is the quadrant of the final
-- result in the range 0 .. 3. The absolute value of X is at most Pi/4.
-- The following three functions implement Chebishev approximations
-- of the trigoniometric functions in their reduced domain.
-- These approximations have been computed using Maple.
function Sine_Approx (X : Double) return Double;
function Cosine_Approx (X : Double) return Double;
pragma Inline (Reduce);
pragma Inline (Sine_Approx);
pragma Inline (Cosine_Approx);
function Cosine_Approx (X : Double) return Double is
XX : constant Double := X * X;
begin
return (((((16#8.DC57FBD05F640#E-08 * XX
- 16#4.9F7D00BF25D80#E-06) * XX
+ 16#1.A019F7FDEFCC2#E-04) * XX
- 16#5.B05B058F18B20#E-03) * XX
+ 16#A.AAAAAAAA73FA8#E-02) * XX
- 16#7.FFFFFFFFFFDE4#E-01) * XX
- 16#3.655E64869ECCE#E-14 + 1.0;
end Cosine_Approx;
function Sine_Approx (X : Double) return Double is
XX : constant Double := X * X;
begin
return (((((16#A.EA2D4ABE41808#E-09 * XX
- 16#6.B974C10F9D078#E-07) * XX
+ 16#2.E3BC673425B0E#E-05) * XX
- 16#D.00D00CCA7AF00#E-04) * XX
+ 16#2.222222221B190#E-02) * XX
- 16#2.AAAAAAAAAAA44#E-01) * (XX * X) + X;
end Sine_Approx;
------------
-- Reduce --
------------
procedure Reduce (X : in out Double; Q : out Natural) is
Half_Pi : constant := Pi / 2.0;
Two_Over_Pi : constant := 2.0 / Pi;
HM : constant := Integer'Min (Double'Machine_Mantissa / 2, Natural'Size);
M : constant Double := 0.5 + 2.0**(1 - HM); -- Splitting constant
P1 : constant Double := Double'Leading_Part (Half_Pi, HM);
P2 : constant Double := Double'Leading_Part (Half_Pi - P1, HM);
P3 : constant Double := Double'Leading_Part (Half_Pi - P1 - P2, HM);
P4 : constant Double := Double'Leading_Part (Half_Pi - P1 - P2 - P3, HM);
P5 : constant Double := Double'Leading_Part (Half_Pi - P1 - P2 - P3
- P4, HM);
P6 : constant Double := Double'Model (Half_Pi - P1 - P2 - P3 - P4 - P5);
K : Double := X * Two_Over_Pi;
begin
-- For X < 2.0**HM, all products below are computed exactly.
-- Due to cancellation effects all subtractions are exact as well.
-- As no double extended floating-point number has more than 75
-- zeros after the binary point, the result will be the correctly
-- rounded result of X - K * (Pi / 2.0).
while abs K >= 2.0**HM loop
K := K * M - (K * M - K);
X := (((((X - K * P1) - K * P2) - K * P3)
- K * P4) - K * P5) - K * P6;
K := X * Two_Over_Pi;
end loop;
if K /= K then
-- K is not a number, because X was not finite
raise Constraint_Error;
end if;
K := Double'Rounding (K);
Q := Integer (K) mod 4;
X := (((((X - K * P1) - K * P2) - K * P3)
- K * P4) - K * P5) - K * P6;
end Reduce;
---------
-- Cos --
---------
function Cos (X : Double) return Double is
Reduced_X : Double := abs X;
Quadrant : Natural range 0 .. 3;
begin
if Reduced_X > Pi / 4.0 then
Reduce (Reduced_X, Quadrant);
case Quadrant is
when 0 =>
return Cosine_Approx (Reduced_X);
when 1 =>
return Sine_Approx (-Reduced_X);
when 2 =>
return -Cosine_Approx (Reduced_X);
when 3 =>
return Sine_Approx (Reduced_X);
end case;
end if;
return Cosine_Approx (Reduced_X);
end Cos;
---------
-- Sin --
---------
function Sin (X : Double) return Double is
Reduced_X : Double := X;
Quadrant : Natural range 0 .. 3;
begin
if abs X > Pi / 4.0 then
Reduce (Reduced_X, Quadrant);
case Quadrant is
when 0 =>
return Sine_Approx (Reduced_X);
when 1 =>
return Cosine_Approx (Reduced_X);
when 2 =>
return Sine_Approx (-Reduced_X);
when 3 =>
return -Cosine_Approx (Reduced_X);
end case;
end if;
return Sine_Approx (Reduced_X);
end Sin;
end Ada.Numerics.Aux;

109
gcc/ada/a-numaux-darwin.ads Normal file
View File

@ -0,0 +1,109 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . N U M E R I C S . A U X --
-- --
-- S p e c --
-- (Apple OS X Version) --
-- --
-- Copyright (C) 1992-2004 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 version is for use with normal Unix math functions, except for
-- sine/cosine which have been implemented directly in Ada to get
-- the required accuracy in OS X. Alternative packages are used
-- on OpenVMS (different import names), VxWorks (no need for the
-- -lm Linker_Options), and on the x86 (where we have two
-- versions one using inline ASM, and one importing from the C long
-- routines that take 80-bit arguments).
package Ada.Numerics.Aux is
pragma Pure (Aux);
pragma Linker_Options ("-lm");
type Double is digits 15;
-- Type Double is the type used to call the C routines
-- The following functions have been implemented in Ada, since
-- the OS X math library didn't meet accuracy requirements for
-- argument reduction. The implementation here has been tailored
-- to match Ada strict mode Numerics requirements while maintaining
-- maximum efficiency.
function Sin (X : Double) return Double;
pragma Inline (Sin);
function Cos (X : Double) return Double;
pragma Inline (Cos);
-- We import these functions directly from C. Note that we label them
-- all as pure functions, because indeed all of them are in fact pure!
function Tan (X : Double) return Double;
pragma Import (C, Tan, "tan");
pragma Pure_Function (Tan);
function Exp (X : Double) return Double;
pragma Import (C, Exp, "exp");
pragma Pure_Function (Exp);
function Sqrt (X : Double) return Double;
pragma Import (C, Sqrt, "sqrt");
pragma Pure_Function (Sqrt);
function Log (X : Double) return Double;
pragma Import (C, Log, "log");
pragma Pure_Function (Log);
function Acos (X : Double) return Double;
pragma Import (C, Acos, "acos");
pragma Pure_Function (Acos);
function Asin (X : Double) return Double;
pragma Import (C, Asin, "asin");
pragma Pure_Function (Asin);
function Atan (X : Double) return Double;
pragma Import (C, Atan, "atan");
pragma Pure_Function (Atan);
function Sinh (X : Double) return Double;
pragma Import (C, Sinh, "sinh");
pragma Pure_Function (Sinh);
function Cosh (X : Double) return Double;
pragma Import (C, Cosh, "cosh");
pragma Pure_Function (Cosh);
function Tanh (X : Double) return Double;
pragma Import (C, Tanh, "tanh");
pragma Pure_Function (Tanh);
function Pow (X, Y : Double) return Double;
pragma Import (C, Pow, "pow");
pragma Pure_Function (Pow);
end Ada.Numerics.Aux;

285
gcc/ada/bld-io.adb
View File

@ -1,285 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- B L D - I O --
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2003 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. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Ada.Exceptions;
with Ada.Text_IO;
with Ada.Unchecked_Deallocation;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with Osint;
package body Bld.IO is
use Ada;
Initial_Number_Of_Lines : constant := 100;
Initial_Length_Of_Line : constant := 50;
type Line is record
Length : Natural := 0;
Value : String_Access;
Suppressed : Boolean := False;
end record;
-- One line of a Makefile.
-- Length is the position of the last column in the line.
-- Suppressed is set to True by procedure Suppress.
type Line_Array is array (Positive range <>) of Line;
type Buffer is access Line_Array;
procedure Free is new Ada.Unchecked_Deallocation (Line_Array, Buffer);
Lines : Buffer := new Line_Array (1 .. Initial_Number_Of_Lines);
-- The lines of a Makefile
Current : Positive := 1;
-- Position of the last line in the Makefile
File : Text_IO.File_Type;
-- The current Makefile
type File_Name_Data;
type File_Name_Ref is access File_Name_Data;
type File_Name_Data is record
Value : String_Access;
Next : File_Name_Ref;
end record;
-- Used to record the names of all Makefiles created, so that we may delete
-- them if necessary.
File_Names : File_Name_Ref;
-- List of all the Makefiles created so far.
-----------
-- Close --
-----------
procedure Close is
begin
Flush;
Text_IO.Close (File);
exception
when X : others =>
Text_IO.Put_Line (Exceptions.Exception_Message (X));
Osint.Fail ("cannot close a Makefile");
end Close;
------------
-- Create --
------------
procedure Create (File_Name : String) is
begin
Text_IO.Create (File, Text_IO.Out_File, File_Name);
Current := 1;
Lines (1).Length := 0;
Lines (1).Suppressed := False;
File_Names :=
new File_Name_Data'(Value => new String'(File_Name),
Next => File_Names);
exception
when X : others =>
Text_IO.Put_Line (Exceptions.Exception_Message (X));
Osint.Fail ("cannot create """ & File_Name & '"');
end Create;
----------------
-- Delete_All --
----------------
procedure Delete_All is
Success : Boolean;
begin
if Text_IO.Is_Open (File) then
Text_IO.Delete (File);
File_Names := File_Names.Next;
end if;
while File_Names /= null loop
Delete_File (File_Names.Value.all, Success);
File_Names := File_Names.Next;
end loop;
end Delete_All;
-----------
-- Flush --
-----------
procedure Flush is
Last : Natural;
begin
if Lines (Current).Length /= 0 then
Osint.Fail ("INTERNAL ERROR: flushing before end of line: """ &
Lines (Current).Value
(1 .. Lines (Current).Length));
end if;
for J in 1 .. Current - 1 loop
if not Lines (J).Suppressed then
Last := Lines (J).Length;
-- The last character of a line cannot be a back slash ('\'),
-- otherwise make has a problem. The only real place were it
-- should happen is for directory names on Windows, and then
-- this terminal back slash is not needed.
if Last > 0 and then Lines (J).Value (Last) = '\' then
Last := Last - 1;
end if;
Text_IO.Put_Line (File, Lines (J).Value (1 .. Last));
end if;
end loop;
Current := 1;
Lines (1).Length := 0;
Lines (1).Suppressed := False;
end Flush;
----------
-- Mark --
----------
procedure Mark (Pos : out Position) is
begin
if Lines (Current).Length /= 0 then
Osint.Fail ("INTERNAL ERROR: marking before end of line: """ &
Lines (Current).Value
(1 .. Lines (Current).Length));
end if;
Pos := (Value => Current);
end Mark;
------------------
-- Name_Of_File --
------------------
function Name_Of_File return String is
begin
return Text_IO.Name (File);
end Name_Of_File;
--------------
-- New_Line --
--------------
procedure New_Line is
begin
Current := Current + 1;
if Current > Lines'Last then
declare
New_Lines : constant Buffer :=
new Line_Array (1 .. 2 * Lines'Last);
begin
New_Lines (1 .. Lines'Last) := Lines.all;
Free (Lines);
Lines := New_Lines;
end;
end if;
Lines (Current).Length := 0;
Lines (Current).Suppressed := False;
-- Allocate a new line, if necessary
if Lines (Current).Value = null then
Lines (Current).Value := new String (1 .. Initial_Length_Of_Line);
end if;
end New_Line;
---------
-- Put --
---------
procedure Put (S : String) is
Length : constant Natural := Lines (Current).Length;
begin
if Length + S'Length > Lines (Current).Value'Length then
declare
New_Line : String_Access;
New_Length : Positive := 2 * Lines (Current).Value'Length;
begin
while Length + S'Length > New_Length loop
New_Length := 2 * New_Length;
end loop;
New_Line := new String (1 .. New_Length);
New_Line (1 .. Length) := Lines (Current).Value (1 .. Length);
Free (Lines (Current).Value);
Lines (Current).Value := New_Line;
end;
end if;
Lines (Current).Value (Length + 1 .. Length + S'Length) := S;
Lines (Current).Length := Length + S'Length;
end Put;
-------------
-- Release --
-------------
procedure Release (Pos : Position) is
begin
if Lines (Current).Length /= 0 then
Osint.Fail ("INTERNAL ERROR: releasing before end of line: """ &
Lines (Current).Value
(1 .. Lines (Current).Length));
end if;
if Pos.Value > Current then
Osint.Fail ("INTERNAL ERROR: releasing ahead of current position");
end if;
Current := Pos.Value;
Lines (Current).Length := 0;
end Release;
--------------
-- Suppress --
--------------
procedure Suppress (Pos : Position) is
begin
if Pos.Value >= Current then
Osint.Fail ("INTERNAL ERROR: suppressing ahead of current position");
end if;
Lines (Pos.Value).Suppressed := True;
end Suppress;
begin
-- Allocate the first line.
-- The other ones are allocated by New_Line.
Lines (1).Value := new String (1 .. Initial_Length_Of_Line);
end Bld.IO;

73
gcc/ada/bld-io.ads
View File

@ -1,73 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- B L D - I O --
-- --
-- S p e c --
-- --
-- Copyright (C) 2002 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. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- The following private package allows the ouput of text to Makefiles
-- though buffers. It is possible to remove some lines from the buffers
-- without putting them effectively in the Makefile.
private package Bld.IO is
procedure Create (File_Name : String);
-- Create a new Makefile
procedure Flush;
-- Output all not suppressed lines to the Makefile
procedure Close;
-- Close the current Makefile
procedure Delete_All;
-- Delete all the Makefiles that have been created
function Name_Of_File return String;
-- Return the path name of the current Makefile
type Position is private;
-- Identification of a line in the Makefile
procedure Mark (Pos : out Position);
-- Record the current line.
-- No characters should have been already put on this line.
procedure Release (Pos : Position);
-- Suppress all line after this one, including this one.
procedure Suppress (Pos : Position);
-- Suppress a particular line
procedure Put (S : String);
-- Append a string to the current line
procedure New_Line;
-- End a line. Go to the next one (initially empty).
private
type Position is record
Value : Positive := 1;
end record;
end Bld.IO;

3622
gcc/ada/bld.adb
View File

File diff suppressed because it is too large Load Diff

38
gcc/ada/bld.ads
View File

@ -1,38 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- B L D --
-- --
-- S p e c --
-- --
-- Copyright (C) 2002 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. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- The following package implements the facilities to build Makefiles
-- for multi-language GNAT project files, so that building a complete
-- multi-language system can be done easily, using GNU make.
package Bld is
procedure Gpr2make;
-- Parse a project file and all the other project files it depends on
-- into a project tree; then from the project tree, produce one Makefile
-- for each project file in the project tree.
end Bld;

163
gcc/ada/g-soccon-darwin.ads Normal file
View File

@ -0,0 +1,163 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- G N A T . S O C K E T S . C O N S T A N T S --
-- --
-- S p e c --
-- --
-- Copyright (C) 2000-2004 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 provides target dependent definitions of constant for use
-- by the GNAT.Sockets package (g-socket.ads). This package should not be
-- directly with'ed by an applications program.
-- This is the version for powerpc-apple-darwin7.4.1
-- This file is generated automatically, do not modify it by hand! Instead,
-- make changes to gen-soccon.c and re-run it on each target.
package GNAT.Sockets.Constants is
--------------
-- Families --
--------------
AF_INET : constant := 2; -- IPv4 address family
AF_INET6 : constant := 30; -- IPv6 address family
-----------
-- Modes --
-----------
SOCK_STREAM : constant := 1; -- Stream socket
SOCK_DGRAM : constant := 2; -- Datagram socket
-------------------
-- Socket errors --
-------------------
EACCES : constant := 13; -- Permission denied
EADDRINUSE : constant := 48; -- Address already in use
EADDRNOTAVAIL : constant := 49; -- Cannot assign address
EAFNOSUPPORT : constant := 47; -- Addr family not supported
EALREADY : constant := 37; -- Operation in progress
EBADF : constant := 9; -- Bad file descriptor
ECONNABORTED : constant := 53; -- Connection aborted
ECONNREFUSED : constant := 61; -- Connection refused
ECONNRESET : constant := 54; -- Connection reset by peer
EDESTADDRREQ : constant := 39; -- Destination addr required
EFAULT : constant := 14; -- Bad address
EHOSTDOWN : constant := 64; -- Host is down
EHOSTUNREACH : constant := 65; -- No route to host
EINPROGRESS : constant := 36; -- Operation now in progress
EINTR : constant := 4; -- Interrupted system call
EINVAL : constant := 22; -- Invalid argument
EIO : constant := 5; -- Input output error
EISCONN : constant := 56; -- Socket already connected
ELOOP : constant := 62; -- Too many symbolic lynks
EMFILE : constant := 24; -- Too many open files
EMSGSIZE : constant := 40; -- Message too long
ENAMETOOLONG : constant := 63; -- Name too long
ENETDOWN : constant := 50; -- Network is down
ENETRESET : constant := 52; -- Disconn. on network reset
ENETUNREACH : constant := 51; -- Network is unreachable
ENOBUFS : constant := 55; -- No buffer space available
ENOPROTOOPT : constant := 42; -- Protocol not available
ENOTCONN : constant := 57; -- Socket not connected
ENOTSOCK : constant := 38; -- Operation on non socket
EOPNOTSUPP : constant := 45; -- Operation not supported
EPFNOSUPPORT : constant := 46; -- Unknown protocol family
EPROTONOSUPPORT : constant := 43; -- Unknown protocol
EPROTOTYPE : constant := 41; -- Unknown protocol type
ESHUTDOWN : constant := 58; -- Cannot send once shutdown
ESOCKTNOSUPPORT : constant := 44; -- Socket type not supported
ETIMEDOUT : constant := 60; -- Connection timed out
ETOOMANYREFS : constant := 59; -- Too many references
EWOULDBLOCK : constant := 35; -- Operation would block
-----------------
-- Host errors --
-----------------
HOST_NOT_FOUND : constant := 1; -- Unknown host
TRY_AGAIN : constant := 2; -- Host name lookup failure
NO_DATA : constant := 4; -- No data record for name
NO_RECOVERY : constant := 3; -- Non recoverable errors
-------------------
-- Control flags --
-------------------
FIONBIO : constant := -2147195266; -- Set/clear non-blocking io
FIONREAD : constant := 1074030207; -- How many bytes to read
--------------------
-- Shutdown modes --
--------------------
SHUT_RD : constant := 0; -- No more recv
SHUT_WR : constant := 1; -- No more send
SHUT_RDWR : constant := 2; -- No more recv/send
---------------------
-- Protocol levels --
---------------------
SOL_SOCKET : constant := 65535; -- Options for socket level
IPPROTO_IP : constant := 0; -- Dummy protocol for IP
IPPROTO_UDP : constant := 17; -- UDP
IPPROTO_TCP : constant := 6; -- TCP
-------------------
-- Request flags --
-------------------
MSG_OOB : constant := 1; -- Process out-of-band data
MSG_PEEK : constant := 2; -- Peek at incoming data
MSG_EOR : constant := 8; -- Send end of record
MSG_WAITALL : constant := 64; -- Wait for full reception
MSG_NOSIGNAL : constant := -1; -- No SIGPIPE on send
MSG_Forced_Flags : constant := 0;
-- Flags set on all send(2) calls
--------------------
-- Socket options --
--------------------
TCP_NODELAY : constant := 1; -- Do not coalesce packets
SO_SNDBUF : constant := 4097; -- Set/get send buffer size
SO_RCVBUF : constant := 4098; -- Set/get recv buffer size
SO_REUSEADDR : constant := 4; -- Bind reuse local address
SO_KEEPALIVE : constant := 8; -- Enable keep-alive msgs
SO_LINGER : constant := 128; -- Defer close to flush data
SO_ERROR : constant := 4103; -- Get/clear error status
SO_BROADCAST : constant := 32; -- Can send broadcast msgs
IP_ADD_MEMBERSHIP : constant := 12; -- Join a multicast group
IP_DROP_MEMBERSHIP : constant := 13; -- Leave a multicast group
IP_MULTICAST_TTL : constant := 10; -- Set/get multicast TTL
IP_MULTICAST_LOOP : constant := 11; -- Set/get mcast loopback
end GNAT.Sockets.Constants;

34
gcc/ada/gpr2make.adb
View File

@ -1,34 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- G P R 2 M A K E --
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2003 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. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Bld;
procedure Gpr2make is
begin
-- The real work is done in package Bld.
Bld.Gpr2make;
end Gpr2make;

30
gcc/ada/gpr2make.ads
View File

@ -1,30 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- G P R 2 M A K E --
-- --
-- S p e c --
-- --
-- Copyright (C) 2002 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. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
procedure Gpr2make;
-- The driver for the gpr2make tool. This utility is a Makefile generator
-- to help building multi-language applications, using multi-language
-- GNAT project files.

612
gcc/ada/gprcmd.adb
View File

@ -1,612 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- G P R C M D --
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2004 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. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- A utility used by Makefile.generic to handle multi-language builds.
-- gprcmd provides a set of commands so that the makefiles do not need
-- to depend on unix utilities not available on all targets.
-- The list of commands recognized by gprcmd are:
-- pwd display current directory
-- to_lower display next argument in lower case
-- to_absolute convert pathnames to absolute directories when needed
-- cat dump contents of a given file
-- extend handle recursive directories ("/**" notation)
-- deps post process dependency makefiles
-- stamp copy file time stamp from file1 to file2
-- prefix get the prefix of the GNAT installation
-- path convert a list of directories to a path list, inserting a
-- path separator after each directory, including the last one
-- ignore do nothing
with Gnatvsn;
with Osint; use Osint;
with Namet; use Namet;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.Regpat; use GNAT.Regpat;
procedure Gprcmd is
-- ??? comments are thin throughout this unit
Gprdebug : constant String := To_Lower (Getenv ("GPRDEBUG").all);
Debug : constant Boolean := Gprdebug = "true";
-- When Debug is True, gprcmd displays its arguments to Standard_Error.
-- This is to help to debug.
procedure Cat (File : String);
-- Print the contents of file on standard output.
-- If the file cannot be read, exit the process with an error code.
procedure Check_Args (Condition : Boolean);
-- If Condition is false, print command invoked, then the usage,
-- and exit the process.
procedure Deps (Objext : String; File : String; GCC : Boolean);
-- Process $(CC) dependency file. If GCC is True, add a rule so that make
-- will not complain when a file is removed/added. If GCC is False, add a
-- rule to recompute the dependency file when needed
procedure Extend (Dir : String);
-- If Dir ends with /**, Put all subdirs recursively on standard output,
-- otherwise put Dir.
procedure Usage;
-- Display the command line options and exit the process.
procedure Copy_Time_Stamp (From, To : String);
-- Copy file time stamp from file From to file To.
procedure Display_Command;
-- Display the invoked command to Standard_Error
---------
-- Cat --
---------
procedure Cat (File : String) is
FD : File_Descriptor;
Buffer : String_Access;
Length : Integer;
begin
FD := Open_Read (File, Fmode => Binary);
if FD = Invalid_FD then
OS_Exit (2);
end if;
Length := Integer (File_Length (FD));
Buffer := new String (1 .. Length);
Length := Read (FD, Buffer.all'Address, Length);
Close (FD);
Put (Buffer.all);
Free (Buffer);
end Cat;
----------------
-- Check_Args --
----------------
procedure Check_Args (Condition : Boolean) is
begin
if not Condition then
Put_Line
(Standard_Error,
"bad call to gprcmd with" & Argument_Count'Img & " arguments.");
for J in 0 .. Argument_Count loop
Put (Standard_Error, Argument (J) & " ");
end loop;
New_Line (Standard_Error);
Usage;
end if;
end Check_Args;
---------------------
-- Copy_Time_Stamp --
---------------------
procedure Copy_Time_Stamp (From, To : String) is
function Copy_Attributes
(From, To : String;
Mode : Integer) return Integer;
pragma Import (C, Copy_Attributes, "__gnat_copy_attribs");
-- Mode = 0 - copy only time stamps.
-- Mode = 1 - copy time stamps and read/write/execute attributes
FD : File_Descriptor;
begin
if not Is_Regular_File (From) then
return;
end if;
FD := Create_File (To, Fmode => Binary);
if FD = Invalid_FD then
OS_Exit (2);
end if;
Close (FD);
if Copy_Attributes (From & ASCII.NUL, To & ASCII.NUL, 0) /= 0 then
OS_Exit (2);
end if;
end Copy_Time_Stamp;
----------
-- Deps --
----------
procedure Deps (Objext : String; File : String; GCC : Boolean) is
Colon : constant String := ':' & ASCII.LF;
NL : constant String := (1 => ASCII.LF);
Base : constant String := ' ' & Base_Name (File) & ": ";
FD : File_Descriptor;
Buffer : String_Access;
Length : Integer;
Obj_Regexp : constant Pattern_Matcher :=
Compile ("^.*\" & Objext & ": ");
Matched : Match_Array (0 .. 0);
Start : Natural;
First : Natural;
Last : Natural;
begin
FD := Open_Read_Write (File, Fmode => Binary);
if FD = Invalid_FD then
return;
end if;
Length := Integer (File_Length (FD));
Buffer := new String (1 .. Length);
Length := Read (FD, Buffer.all'Address, Length);
if GCC then
Lseek (FD, 0, Seek_End);
else
Close (FD);
FD := Create_File (File, Fmode => Binary);
end if;
Start := Buffer'First;
while Start <= Buffer'Last loop
-- Parse Buffer line by line
while Start < Buffer'Last
and then (Buffer (Start) = ASCII.CR
or else Buffer (Start) = ASCII.LF)
loop
Start := Start + 1;
end loop;
Last := Start;
while Last < Buffer'Last
and then Buffer (Last + 1) /= ASCII.CR
and then Buffer (Last + 1) /= ASCII.LF
loop
Last := Last + 1;
end loop;
Match (Obj_Regexp, Buffer (Start .. Last), Matched);
if GCC then
if Matched (0) = No_Match then
First := Start;
else
First := Matched (0).Last + 1;
end if;
Length := Write (FD, Buffer (First)'Address, Last - First + 1);
if Start = Last or else Buffer (Last) = '\' then
Length := Write (FD, NL (1)'Address, NL'Length);
else
Length := Write (FD, Colon (1)'Address, Colon'Length);
end if;
else
if Matched (0) = No_Match then
First := Start;
else
Length :=
Write (FD, Buffer (Start)'Address,
Matched (0).Last - Start - 1);
Length := Write (FD, Base (Base'First)'Address, Base'Length);
First := Matched (0).Last + 1;
end if;
Length := Write (FD, Buffer (First)'Address, Last - First + 1);
Length := Write (FD, NL (1)'Address, NL'Length);
end if;
Start := Last + 1;
end loop;
Close (FD);
Free (Buffer);
end Deps;
---------------------
-- Display_Command --
---------------------
procedure Display_Command is
begin
for J in 0 .. Argument_Count loop
Put (Standard_Error, Argument (J) & ' ');
end loop;
New_Line (Standard_Error);
end Display_Command;
------------
-- Extend --
------------
procedure Extend (Dir : String) is
procedure Recursive_Extend (D : String);
-- Recursively display all subdirectories of D
----------------------
-- Recursive_Extend --
----------------------
procedure Recursive_Extend (D : String) is
Iter : Dir_Type;
Buffer : String (1 .. 8192);
Last : Natural;
begin
Open (Iter, D);
loop
Read (Iter, Buffer, Last);
exit when Last = 0;
if Buffer (1 .. Last) /= "."
and then Buffer (1 .. Last) /= ".."
then
declare
Abs_Dir : constant String := D & "/" & Buffer (1 .. Last);
begin
if Is_Directory (Abs_Dir)
and then not Is_Symbolic_Link (Abs_Dir)
then
Put (' ' & Abs_Dir);
Recursive_Extend (Abs_Dir);
end if;
end;
end if;
end loop;
Close (Iter);
exception
when Directory_Error =>
null;
end Recursive_Extend;
-- Start of processing for Extend
begin
if Dir'Length < 3
or else (Dir (Dir'Last - 2) /= '/'
and then Dir (Dir'Last - 2) /= Directory_Separator)
or else Dir (Dir'Last - 1 .. Dir'Last) /= "**"
then
Put (Dir);
return;
end if;
declare
D : constant String := Dir (Dir'First .. Dir'Last - 3);
begin
Put (D);
Recursive_Extend (D);
end;
end Extend;
-----------
-- Usage --
-----------
procedure Usage is
begin
Put_Line (Standard_Error, "usage: gprcmd cmd [arguments]");
Put_Line (Standard_Error, "where cmd is one of the following commands:");
Put_Line (Standard_Error, " pwd " &
"display current directory");
Put_Line (Standard_Error, " to_lower " &
"display next argument in lower case");
Put_Line (Standard_Error, " to_absolute " &
"convert pathnames to absolute " &
"directories when needed");
Put_Line (Standard_Error, " cat " &
"dump contents of a given file");
Put_Line (Standard_Error, " extend " &
"handle recursive directories " &
"(""/**"" notation)");
Put_Line (Standard_Error, " deps " &
"post process dependency makefiles");
Put_Line (Standard_Error, " stamp " &
"copy file time stamp from file1 to file2");
Put_Line (Standard_Error, " prefix " &
"get the prefix of the GNAT installation");
Put_Line (Standard_Error, " path_sep " &
"returns the path separator");
Put_Line (Standard_Error, " linkopts " &
"process attribute Linker'Linker_Options");
Put_Line (Standard_Error, " ignore " &
"do nothing");
OS_Exit (1);
end Usage;
-- Start of processing for Gprcmd
begin
if Debug then
Display_Command;
end if;
Check_Args (Argument_Count > 0);
declare
Cmd : constant String := Argument (1);
begin
if Cmd = "-v" then
-- Output on standard error, because only returned values should
-- go to standard output.
Put (Standard_Error, "GPRCMD ");
Put_Line (Standard_Error, Gnatvsn.Gnat_Version_String);
Put_Line (Standard_Error,
"Copyright 2002-2004, Free Software Fundation, Inc.");
Usage;
elsif Cmd = "pwd" then
declare
CD : constant String := Get_Current_Dir;
begin
Put (Format_Pathname (CD (CD'First .. CD'Last - 1), UNIX));
end;
elsif Cmd = "cat" then
Check_Args (Argument_Count = 2);
Cat (Argument (2));
elsif Cmd = "to_lower" then
Check_Args (Argument_Count >= 2);
for J in 2 .. Argument_Count loop
Put (To_Lower (Argument (J)));
if J < Argument_Count then
Put (' ');
end if;
end loop;
elsif Cmd = "to_absolute" then
Check_Args (Argument_Count > 2);
declare
Dir : constant String := Argument (2);
begin
for J in 3 .. Argument_Count loop
if Is_Absolute_Path (Argument (J)) then
Put (Format_Pathname (Argument (J), UNIX));
else
Put (Format_Pathname
(Normalize_Pathname
(Format_Pathname (Argument (J)),
Format_Pathname (Dir)),
UNIX));
end if;
if J < Argument_Count then
Put (' ');
end if;
end loop;
end;
elsif Cmd = "extend" then
Check_Args (Argument_Count >= 2);
declare
Dir : constant String := Argument (2);
begin
-- Loop to remove quotes that may have been added around arguments
for J in 3 .. Argument_Count loop
declare
Arg : constant String := Argument (J);
First : Natural := Arg'First;
Last : Natural := Arg'Last;
begin
if Arg (First) = '"' and then Arg (Last) = '"' then
First := First + 1;
Last := Last - 1;
end if;
if Is_Absolute_Path (Arg (First .. Last)) then
Extend (Format_Pathname (Arg (First .. Last), UNIX));
else
Extend
(Format_Pathname
(Normalize_Pathname
(Format_Pathname (Arg (First .. Last)),
Format_Pathname (Dir)),
UNIX));
end if;
if J < Argument_Count then
Put (' ');
end if;
end;
end loop;
end;
elsif Cmd = "deps" then
Check_Args (Argument_Count in 3 .. 4);
Deps (Argument (2), Argument (3), GCC => Argument_Count = 4);
elsif Cmd = "stamp" then
Check_Args (Argument_Count = 3);
Copy_Time_Stamp (Argument (2), Argument (3));
elsif Cmd = "prefix" then
-- Find the GNAT prefix. gprcmd is found in <prefix>/bin.
-- So we find the full path of gprcmd, verify that it is in a
-- subdirectory "bin", and return the <prefix> if it is the case.
-- Otherwise, nothing is returned.
Find_Program_Name;
declare
Path : constant String_Access :=
Locate_Exec_On_Path (Name_Buffer (1 .. Name_Len));
Index : Natural;
begin
if Path /= null then
Index := Path'Last;
while Index >= Path'First + 4 loop
exit when Path (Index) = Directory_Separator;
Index := Index - 1;
end loop;
if Index > Path'First + 5
and then Path (Index - 3 .. Index - 1) = "bin"
and then Path (Index - 4) = Directory_Separator
then
-- We have found the <prefix>, return it
Put (Path (Path'First .. Index - 5));
end if;
end if;
end;
-- For "path" just add path separator after each directory argument
elsif Cmd = "path_sep" then
Put (Path_Separator);
-- Check the linker options for relative paths. Insert the project
-- base dir before relative paths.
elsif Cmd = "linkopts" then
Check_Args (Argument_Count >= 2);
-- First argument is the base directory of the project file
declare
Base_Dir : constant String := Argument (2) & '/';
begin
-- process the remainder of the arguments
for J in 3 .. Argument_Count loop
declare
Arg : constant String := Argument (J);
begin
-- If it is a switch other than a -L switch, just send back
-- the argument.
if Arg (Arg'First) = '-' and then
(Arg'Length <= 2 or else Arg (Arg'First + 1) /= 'L')
then
Put (Arg);
else
-- If it is a file, check if its path is relative, and
-- if it is relative, add <project base dir>/ in front.
-- Otherwise just send back the argument.
if Arg'Length <= 2
or else Arg (Arg'First .. Arg'First + 1) /= "-L"
then
if not Is_Absolute_Path (Arg) then
Put (Base_Dir);
end if;
Put (Arg);
-- For -L switches, check if the path is relative and
-- proceed similarly.
else
Put ("-L");
if
not Is_Absolute_Path (Arg (Arg'First + 2 .. Arg'Last))
then
Put (Base_Dir);
end if;
Put (Arg (Arg'First + 2 .. Arg'Last));
end if;
end if;
end;
-- Insert a space between each processed argument
if J /= Argument_Count then
Put (' ');
end if;
end loop;
end;
-- For "ignore" do nothing
elsif Cmd = "ignore" then
null;
-- Unknown command
else
Check_Args (False);
end if;
end;
end Gprcmd;