procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Makefile.def, [...]: Remove all mention of libf2c.

Browse source 
top:
	* Makefile.def, Makefile.tpl, configure.in: Remove all mention
	of libf2c.
	* configure, Makefile.in: Regenerate.
contrib:
	* gcc_update: Remove gcc/f/intdoc.texi and all libf2c files
	from list of files to be touched.
	* convert_to_f2c, convert_to_g2c, download_f2c: Delete.
gcc:
	* f: Entire directory removed

	* c-common.h (CTI_G77_INTEGER_TYPE, CTI_G77_UINTEGER_TYPE)
	(CTI_G77_LONGINT_TYPE, CTI_G77_ULONGINT_TYPE)
	(g77_integer_type_node, g77_uinteger_type_node)
	(g77_longint_type_node, or g77_ulongint_type_node): Delete.
	* c-common.c (c_common_nodes_and_builtins): Do not initialize
	the above set of variables.

	* config/i386/uwin.h: No need to define WIN32_UWIN_TARGET.
	* doc/invoke.texi, doc/standards.texi: Remove cross-references
	to g77 manual.
gcc/po:
	* exgettext (spec_error_string): Do not scan beyond the end of
	the string for a close brace.  Do not bail out at the first
	incidence of %%e.
	* gcc.pot: Regenerate.

From-SVN: r81967
This commit is contained in:
Zack Weinberg 2004-05-18 01:26:21 +00:00
parent 54b4ba60f2
commit b4117c3061
137 changed files with 729 additions and 174469 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

74
ChangeLog
View file

@ -1,3 +1,9 @@
2004-05-17 Zack Weinberg <zack@codesourcery.com>
* Makefile.def, Makefile.tpl, configure.in: Remove all mention
of libf2c.
* configure, Makefile.in: Regenerate.
2004-05-13 Tobias Schlüter <tobi@gcc.gnu.org>
* MAINTAINERS (Write After Approval): Add myself.
@ -29,15 +35,15 @@
2004-05-04 Vladimir Makarov <vmakarov@redhat.com>
* MAINTAINERS (Various Maintainers): Add myself.
* MAINTAINERS (Various Maintainers): Add myself.
2004-04-30 Brian Ford <ford@vss.fsi.com>
* MAINTAINERS (Write After Approval): Add myself.
* MAINTAINERS (Write After Approval): Add myself.
2004-04-29 Uros Bizjak <uros@kss-loka.si>
* MAINTAINERS (Write After Approval): Add myself.
* MAINTAINERS (Write After Approval): Add myself.
2004-04-28 Paolo Bonzini <bonzini@gnu.org>
@ -79,11 +85,11 @@
2004-04-26 Paolo Bonzini <bonzini@gnu.org>
* configure.in: Invoke ACX_PROG_CMP_IGNORE_INITIAL.
* configure: Regenerate.
* config/acx.m4: Mutuate ACX_PROG_CMP_IGNORE_INITIAL from gcc.
* gcc/Makefile.tpl (compare): Use the result of the test.
* gcc/Makefile.in: Regenerate.
* configure.in: Invoke ACX_PROG_CMP_IGNORE_INITIAL.
* configure: Regenerate.
* config/acx.m4: Mutuate ACX_PROG_CMP_IGNORE_INITIAL from gcc.
* gcc/Makefile.tpl (compare): Use the result of the test.
* gcc/Makefile.in: Regenerate.
2004-04-23 Paolo Bonzini <bonzini@gnu.org>
@ -96,7 +102,7 @@
2004-04-23 Laurent GUERBY <laurent@guerby.net>
* MAINTAINERS: Update my email address.
2004-04-19 Rainer Orth <ro@TechFak.Uni-Bielefeld.DE>
* configure.in (mips*-*-irix5*): Enable ld.
@ -115,7 +121,7 @@
2004-04-12 Michael Chastain <mec.gnu@mindspring.com>
* MAINTAINERS: Add myself to write-after-approval.
* MAINTAINERS: Add myself to write-after-approval.
2004-04-09 Nathanael Nerode <neroden@gcc.gnu.org>
@ -139,17 +145,17 @@
2004-04-06 David Edelsohn <edelsohn@gnu.org>
* configure.in (powerpc-*-aix*): Remove target-libada from noconfigdirs.
(rs6000-*-aix*): Same.
* configure: Regenerate.
* configure.in (powerpc-*-aix*): Remove target-libada from noconfigdirs.
(rs6000-*-aix*): Same.
* configure: Regenerate.
2004-04-05 Ranjit Mathew <rmathew@hotmail.com>
* MAINTAINERS: Add myself to write-after-approval.
* MAINTAINERS: Add myself to write-after-approval.
2004-04-03 Bud Davis <bdavis9659@comcast.net>
* MAINTAINERS: Add myself to write-after-approval.
* MAINTAINERS: Add myself to write-after-approval.
2004-03-24 Nathanael Nerode <neroden@gcc.gnu.org>
@ -209,10 +215,10 @@
* Makefile.in: Regenerate.
2004-03-15 Paolo Bonzini <bonzini@gnu.org>
Nathanael Nerode <neroden@gcc.gnu.org>
Nathanael Nerode <neroden@gcc.gnu.org>
* configure.in (DEFAULT_YACC, DEFAULT_M4, DEFAULT_LEX):
Set with AC_CHECK_PROGS.
Set with AC_CHECK_PROGS.
* configure.in: Fix comment typo from last patch.
* configure: Regenerate.
@ -224,14 +230,14 @@
* configure: Regenerate.
2004-03-12 Eric Botcazou <ebotcazou@gcc.gnu.org>
Paolo Bonzini <bonzini@gnu.org>
Paolo Bonzini <bonzini@gnu.org>
PR bootstrap/14522
* configure.in: Cope with shells that do not support unquoted ^
* configure: Regenerate.
2004-03-11 Eric Botcazou <ebotcazou@gcc.gnu.org>
Paolo Bonzini <bonzini@gnu.org>
Paolo Bonzini <bonzini@gnu.org>
PR bootstrap/14522
* configure.in: Cope with shells that do not support nesting
@ -280,7 +286,7 @@
2004-03-01 Paolo Bonzini <bonzini@gnu.org>
* MAINTAINERS: Add myself to write-after-approval.
2004-02-28 Nathanael Nerode <neroden@gcc.gnu.org>
PR bootstrap/7087
@ -332,7 +338,7 @@
2004-02-12 Paolo Bonzini <bonzini@gnu.org>
* MAINTAINERS: Remove myself.
2004-02-11 David Edelsohn <edelsohn@gnu.org>
* configure.in (powerpc-*-aix*): Add target-libada to noconfigdirs.
@ -348,7 +354,7 @@
Nathanael Nerode <neroden@gcc.gnu.org>
PR ada/6637, PR ada/5911
Merge with libada-branch:
Merge with libada-branch:
* configure.in, Makefile.tpl, Makefile.def: Add target-libada,
with appropriate dependencies. Add --enable-libada configure switch.
* configure, Makefile.in: Regenerate.
@ -356,7 +362,7 @@
2004-02-09 Paolo Bonzini <bonzini@gnu.org>
* MAINTAINERS: Add myself to write-after-approval.
2004-02-05 Rainer Orth <ro@TechFak.Uni-Bielefeld.DE>
* configure.in: Don't pass --with-stabs on IRIX 5 either.
@ -387,7 +393,7 @@
2004-01-20 Caroline Tice <ctice@apple.com>
* MAINTAINERS: Add myself to write-after-approval.
2004-01-19 Paolo Carlini <pcarlini@suse.de>
* MAINTAINERS: Update my email address.
@ -395,7 +401,7 @@
2004-01-18 James A. Morrison <ja2morri@uwaterloo.ca>
* MAINTAINERS: Add myself to write-after-approval.
2004-01-17 Volker Reichelt <reichelt@igpm.rwth-aachen.de>
* MAINTAINERS: Remove entries without email address.
@ -465,7 +471,7 @@
* MAINTAINERS: Remove the mn10200 maintainer.
2003-12-21 Bernardo Innocenti <bernie@develer.com>
* configure.in (*-*-uclinux): Exclude newlib, libgloss and rda.
* configure: Regenerated.
@ -514,8 +520,8 @@
2003-11-14 Arnaud Charlet <charlet@act-europe.fr>
* Makefile.tpl (EXTRA_GCC_FLAGS): Pass BOOT_ADAFLAGS.
* Makefile.in: Regenerate.
* Makefile.tpl (EXTRA_GCC_FLAGS): Pass BOOT_ADAFLAGS.
* Makefile.in: Regenerate.
2003-11-03 Ulrich Weigand <uweigand@de.ibm.com>
@ -663,7 +669,7 @@
2003-09-04 Robert Millan <robertmh@gnu.org>
* configure.in: Match GNU/KFreeBSD with new kfreebsd*-gnu triplet.
2003-09-02 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
* configure.in: Ensure arguments to sed are properly spaced.
@ -702,7 +708,7 @@
* configure.in: When testing with_libs and with_headers, treat
'no' as unset. Based on a patch by Dan Kegel <dank@kegel.com>.
* configure: Regenerate.
* configure.in (TOPLEVEL_CONFIGURE_ARGUMENTS): Quote properly for
make, shell, etc.
(baseargs): Likewise.
@ -721,8 +727,8 @@
* config-ml.in, symlink-tree: Add license.
2003-08-03 Richard Stallman <rms@gnu.org>
Eben Moglen <moglen@columbia.edu>
2003-08-03 Richard Stallman <rms@gnu.org>
Eben Moglen <moglen@columbia.edu>
* README.SCO: New file.

1
Makefile.def
View file

@ -101,7 +101,6 @@ host_modules= { module= utils; no_check=true; };
target_modules = { module= libstdc++-v3; raw_cxx=true; };
target_modules = { module= libmudflap; };
target_modules = { module= newlib; };
target_modules = { module= libf2c; };
target_modules = { module= libgfortran; };
target_modules = { module= libobjc; };
target_modules = { module= libtermcap; no_check=true; stage=true;

294
Makefile.in
View file

@ -612,7 +612,6 @@ configure-target: \
maybe-configure-target-libstdc++-v3 \
maybe-configure-target-libmudflap \
maybe-configure-target-newlib \
maybe-configure-target-libf2c \
maybe-configure-target-libgfortran \
maybe-configure-target-libobjc \
maybe-configure-target-libtermcap \
@ -705,7 +704,6 @@ all-target: \
maybe-all-target-libstdc++-v3 \
maybe-all-target-libmudflap \
maybe-all-target-newlib \
maybe-all-target-libf2c \
maybe-all-target-libgfortran \
maybe-all-target-libobjc \
maybe-all-target-libtermcap \
@ -803,7 +801,6 @@ info-target: \
maybe-info-target-libstdc++-v3 \
maybe-info-target-libmudflap \
maybe-info-target-newlib \
maybe-info-target-libf2c \
maybe-info-target-libgfortran \
maybe-info-target-libobjc \
maybe-info-target-libtermcap \
@ -896,7 +893,6 @@ dvi-target: \
maybe-dvi-target-libstdc++-v3 \
maybe-dvi-target-libmudflap \
maybe-dvi-target-newlib \
maybe-dvi-target-libf2c \
maybe-dvi-target-libgfortran \
maybe-dvi-target-libobjc \
maybe-dvi-target-libtermcap \
@ -989,7 +985,6 @@ TAGS-target: \
maybe-TAGS-target-libstdc++-v3 \
maybe-TAGS-target-libmudflap \
maybe-TAGS-target-newlib \
maybe-TAGS-target-libf2c \
maybe-TAGS-target-libgfortran \
maybe-TAGS-target-libobjc \
maybe-TAGS-target-libtermcap \
@ -1082,7 +1077,6 @@ install-info-target: \
maybe-install-info-target-libstdc++-v3 \
maybe-install-info-target-libmudflap \
maybe-install-info-target-newlib \
maybe-install-info-target-libf2c \
maybe-install-info-target-libgfortran \
maybe-install-info-target-libobjc \
maybe-install-info-target-libtermcap \
@ -1175,7 +1169,6 @@ installcheck-target: \
maybe-installcheck-target-libstdc++-v3 \
maybe-installcheck-target-libmudflap \
maybe-installcheck-target-newlib \
maybe-installcheck-target-libf2c \
maybe-installcheck-target-libgfortran \
maybe-installcheck-target-libobjc \
maybe-installcheck-target-libtermcap \
@ -1268,7 +1261,6 @@ mostlyclean-target: \
maybe-mostlyclean-target-libstdc++-v3 \
maybe-mostlyclean-target-libmudflap \
maybe-mostlyclean-target-newlib \
maybe-mostlyclean-target-libf2c \
maybe-mostlyclean-target-libgfortran \
maybe-mostlyclean-target-libobjc \
maybe-mostlyclean-target-libtermcap \
@ -1361,7 +1353,6 @@ clean-target: \
maybe-clean-target-libstdc++-v3 \
maybe-clean-target-libmudflap \
maybe-clean-target-newlib \
maybe-clean-target-libf2c \
maybe-clean-target-libgfortran \
maybe-clean-target-libobjc \
maybe-clean-target-libtermcap \
@ -1454,7 +1445,6 @@ distclean-target: \
maybe-distclean-target-libstdc++-v3 \
maybe-distclean-target-libmudflap \
maybe-distclean-target-newlib \
maybe-distclean-target-libf2c \
maybe-distclean-target-libgfortran \
maybe-distclean-target-libobjc \
maybe-distclean-target-libtermcap \
@ -1547,7 +1537,6 @@ maintainer-clean-target: \
maybe-maintainer-clean-target-libstdc++-v3 \
maybe-maintainer-clean-target-libmudflap \
maybe-maintainer-clean-target-newlib \
maybe-maintainer-clean-target-libf2c \
maybe-maintainer-clean-target-libgfortran \
maybe-maintainer-clean-target-libobjc \
maybe-maintainer-clean-target-libtermcap \
@ -1694,7 +1683,6 @@ do-check: maybe-check-gcc \
maybe-check-target-libstdc++-v3 \
maybe-check-target-libmudflap \
maybe-check-target-newlib \
maybe-check-target-libf2c \
maybe-check-target-libgfortran \
maybe-check-target-libobjc \
maybe-check-target-libtermcap \
@ -1878,7 +1866,6 @@ install-target: \
maybe-install-target-libstdc++-v3 \
maybe-install-target-libmudflap \
maybe-install-target-newlib \
maybe-install-target-libf2c \
maybe-install-target-libgfortran \
maybe-install-target-libobjc \
maybe-install-target-libtermcap \
@ -20132,285 +20119,6 @@ maintainer-clean-target-newlib:
.PHONY: configure-target-libf2c maybe-configure-target-libf2c
maybe-configure-target-libf2c:
# There's only one multilib.out. Cleverer subdirs shouldn't need it copied.
$(TARGET_SUBDIR)/libf2c/multilib.out: multilib.out
$(SHELL) $(srcdir)/mkinstalldirs $(TARGET_SUBDIR)/libf2c ; \
rm -f $(TARGET_SUBDIR)/libf2c/Makefile || : ; \
cp multilib.out $(TARGET_SUBDIR)/libf2c/multilib.out
configure-target-libf2c: $(TARGET_SUBDIR)/libf2c/multilib.out
@test ! -f $(TARGET_SUBDIR)/libf2c/Makefile || exit 0; \
$(SHELL) $(srcdir)/mkinstalldirs $(TARGET_SUBDIR)/libf2c ; \
r=`${PWD_COMMAND}`; export r; \
s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
$(SET_LIB_PATH) \
AR="$(AR_FOR_TARGET)"; export AR; \
AS="$(AS_FOR_TARGET)"; export AS; \
CC="$(CC_FOR_TARGET)"; export CC; \
CFLAGS="$(CFLAGS_FOR_TARGET)"; export CFLAGS; \
CONFIG_SHELL="$(SHELL)"; export CONFIG_SHELL; \
CPPFLAGS="$(CFLAGS_FOR_TARGET)"; export CPPFLAGS; \
CXX="$(CXX_FOR_TARGET)"; export CXX; \
CXXFLAGS="$(CXXFLAGS_FOR_TARGET)"; export CXXFLAGS; \
GCJ="$(GCJ_FOR_TARGET)"; export GCJ; \
GFORTRAN="$(GFORTRAN_FOR_TARGET)"; export GFORTRAN; \
DLLTOOL="$(DLLTOOL_FOR_TARGET)"; export DLLTOOL; \
LD="$(LD_FOR_TARGET)"; export LD; \
LDFLAGS="$(LDFLAGS_FOR_TARGET)"; export LDFLAGS; \
NM="$(NM_FOR_TARGET)"; export NM; \
RANLIB="$(RANLIB_FOR_TARGET)"; export RANLIB; \
WINDRES="$(WINDRES_FOR_TARGET)"; export WINDRES; \
echo Configuring in $(TARGET_SUBDIR)/libf2c; \
cd "$(TARGET_SUBDIR)/libf2c" || exit 1; \
case $(srcdir) in \
/* | [A-Za-z]:[\\/]*) \
topdir=$(srcdir) ;; \
*) \
case "$(TARGET_SUBDIR)" in \
.) topdir="../$(srcdir)" ;; \
*) topdir="../../$(srcdir)" ;; \
esac ;; \
esac; \
srcdiroption="--srcdir=$${topdir}/libf2c"; \
libsrcdir="$$s/libf2c"; \
rm -f no-such-file || : ; \
CONFIG_SITE=no-such-file $(SHELL) $${libsrcdir}/configure \
$(TARGET_CONFIGARGS) $${srcdiroption} \
--with-target-subdir="$(TARGET_SUBDIR)" \
|| exit 1
.PHONY: all-target-libf2c maybe-all-target-libf2c
maybe-all-target-libf2c:
all-target-libf2c: configure-target-libf2c
@r=`${PWD_COMMAND}`; export r; \
s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
$(SET_LIB_PATH) \
(cd $(TARGET_SUBDIR)/libf2c && \
$(MAKE) $(TARGET_FLAGS_TO_PASS) all)
.PHONY: check-target-libf2c maybe-check-target-libf2c
maybe-check-target-libf2c:
check-target-libf2c:
@r=`${PWD_COMMAND}`; export r; \
s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
$(SET_LIB_PATH) \
(cd $(TARGET_SUBDIR)/libf2c && \
$(MAKE) $(TARGET_FLAGS_TO_PASS) check)
.PHONY: install-target-libf2c maybe-install-target-libf2c
maybe-install-target-libf2c:
install-target-libf2c: installdirs
@r=`${PWD_COMMAND}`; export r; \
s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
$(SET_LIB_PATH) \
(cd $(TARGET_SUBDIR)/libf2c && \
$(MAKE) $(TARGET_FLAGS_TO_PASS) install)
# Other targets (info, dvi, etc.)
.PHONY: maybe-info-target-libf2c info-target-libf2c
maybe-info-target-libf2c:
info-target-libf2c: \
configure-target-libf2c
@[ -f $(TARGET_SUBDIR)/libf2c/Makefile ] || exit 0 ; \
r=`${PWD_COMMAND}`; export r; \
s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
$(SET_LIB_PATH) \
echo "Doing info in $(TARGET_SUBDIR)/libf2c" ; \
for flag in $(EXTRA_TARGET_FLAGS); do \
eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
done; \
(cd $(TARGET_SUBDIR)/libf2c && \
$(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \
"CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \
"RANLIB=$${RANLIB}" \
"DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" \
info) \
|| exit 1
.PHONY: maybe-dvi-target-libf2c dvi-target-libf2c
maybe-dvi-target-libf2c:
dvi-target-libf2c: \
configure-target-libf2c
@[ -f $(TARGET_SUBDIR)/libf2c/Makefile ] || exit 0 ; \
r=`${PWD_COMMAND}`; export r; \
s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
$(SET_LIB_PATH) \
echo "Doing dvi in $(TARGET_SUBDIR)/libf2c" ; \
for flag in $(EXTRA_TARGET_FLAGS); do \
eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
done; \
(cd $(TARGET_SUBDIR)/libf2c && \
$(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \
"CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \
"RANLIB=$${RANLIB}" \
"DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" \
dvi) \
|| exit 1
.PHONY: maybe-TAGS-target-libf2c TAGS-target-libf2c
maybe-TAGS-target-libf2c:
TAGS-target-libf2c: \
configure-target-libf2c
@[ -f $(TARGET_SUBDIR)/libf2c/Makefile ] || exit 0 ; \
r=`${PWD_COMMAND}`; export r; \
s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
$(SET_LIB_PATH) \
echo "Doing TAGS in $(TARGET_SUBDIR)/libf2c" ; \
for flag in $(EXTRA_TARGET_FLAGS); do \
eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
done; \
(cd $(TARGET_SUBDIR)/libf2c && \
$(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \
"CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \
"RANLIB=$${RANLIB}" \
"DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" \
TAGS) \
|| exit 1
.PHONY: maybe-install-info-target-libf2c install-info-target-libf2c
maybe-install-info-target-libf2c:
install-info-target-libf2c: \
configure-target-libf2c \
info-target-libf2c
@[ -f $(TARGET_SUBDIR)/libf2c/Makefile ] || exit 0 ; \
r=`${PWD_COMMAND}`; export r; \
s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
$(SET_LIB_PATH) \
echo "Doing install-info in $(TARGET_SUBDIR)/libf2c" ; \
for flag in $(EXTRA_TARGET_FLAGS); do \
eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
done; \
(cd $(TARGET_SUBDIR)/libf2c && \
$(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \
"CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \
"RANLIB=$${RANLIB}" \
"DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" \
install-info) \
|| exit 1
.PHONY: maybe-installcheck-target-libf2c installcheck-target-libf2c
maybe-installcheck-target-libf2c:
installcheck-target-libf2c: \
configure-target-libf2c
@[ -f $(TARGET_SUBDIR)/libf2c/Makefile ] || exit 0 ; \
r=`${PWD_COMMAND}`; export r; \
s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
$(SET_LIB_PATH) \
echo "Doing installcheck in $(TARGET_SUBDIR)/libf2c" ; \
for flag in $(EXTRA_TARGET_FLAGS); do \
eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
done; \
(cd $(TARGET_SUBDIR)/libf2c && \
$(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \
"CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \
"RANLIB=$${RANLIB}" \
"DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" \
installcheck) \
|| exit 1
.PHONY: maybe-mostlyclean-target-libf2c mostlyclean-target-libf2c
maybe-mostlyclean-target-libf2c:
mostlyclean-target-libf2c:
@[ -f $(TARGET_SUBDIR)/libf2c/Makefile ] || exit 0 ; \
r=`${PWD_COMMAND}`; export r; \
s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
$(SET_LIB_PATH) \
echo "Doing mostlyclean in $(TARGET_SUBDIR)/libf2c" ; \
for flag in $(EXTRA_TARGET_FLAGS); do \
eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
done; \
(cd $(TARGET_SUBDIR)/libf2c && \
$(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \
"CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \
"RANLIB=$${RANLIB}" \
"DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" \
mostlyclean) \
|| exit 1
.PHONY: maybe-clean-target-libf2c clean-target-libf2c
maybe-clean-target-libf2c:
clean-target-libf2c:
@[ -f $(TARGET_SUBDIR)/libf2c/Makefile ] || exit 0 ; \
r=`${PWD_COMMAND}`; export r; \
s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
$(SET_LIB_PATH) \
echo "Doing clean in $(TARGET_SUBDIR)/libf2c" ; \
for flag in $(EXTRA_TARGET_FLAGS); do \
eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
done; \
(cd $(TARGET_SUBDIR)/libf2c && \
$(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \
"CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \
"RANLIB=$${RANLIB}" \
"DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" \
clean) \
|| exit 1
.PHONY: maybe-distclean-target-libf2c distclean-target-libf2c
maybe-distclean-target-libf2c:
distclean-target-libf2c:
@[ -f $(TARGET_SUBDIR)/libf2c/Makefile ] || exit 0 ; \
r=`${PWD_COMMAND}`; export r; \
s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
$(SET_LIB_PATH) \
echo "Doing distclean in $(TARGET_SUBDIR)/libf2c" ; \
for flag in $(EXTRA_TARGET_FLAGS); do \
eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
done; \
(cd $(TARGET_SUBDIR)/libf2c && \
$(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \
"CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \
"RANLIB=$${RANLIB}" \
"DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" \
distclean) \
|| exit 1
.PHONY: maybe-maintainer-clean-target-libf2c maintainer-clean-target-libf2c
maybe-maintainer-clean-target-libf2c:
maintainer-clean-target-libf2c:
@[ -f $(TARGET_SUBDIR)/libf2c/Makefile ] || exit 0 ; \
r=`${PWD_COMMAND}`; export r; \
s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
$(SET_LIB_PATH) \
echo "Doing maintainer-clean in $(TARGET_SUBDIR)/libf2c" ; \
for flag in $(EXTRA_TARGET_FLAGS); do \
eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
done; \
(cd $(TARGET_SUBDIR)/libf2c && \
$(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \
"CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \
"RANLIB=$${RANLIB}" \
"DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" \
maintainer-clean) \
|| exit 1
.PHONY: configure-target-libgfortran maybe-configure-target-libgfortran
maybe-configure-target-libgfortran:
@ -25368,8 +25076,6 @@ configure-target-boehm-gc: $(ALL_GCC_C) maybe-configure-target-qthreads
configure-target-fastjar: maybe-configure-target-zlib
all-target-fastjar: maybe-all-target-zlib maybe-all-target-libiberty
configure-target-libada: $(ALL_GCC_C)
configure-target-libf2c: $(ALL_GCC_C)
all-target-libf2c: maybe-all-target-libiberty
configure-target-libgfortran: $(ALL_GCC_C)
configure-target-libffi: $(ALL_GCC_C)
configure-target-libjava: $(ALL_GCC_C) maybe-configure-target-zlib maybe-configure-target-boehm-gc maybe-configure-target-qthreads maybe-configure-target-libffi

2
Makefile.tpl
View file

@ -1686,8 +1686,6 @@ configure-target-boehm-gc: $(ALL_GCC_C) maybe-configure-target-qthreads
configure-target-fastjar: maybe-configure-target-zlib
all-target-fastjar: maybe-all-target-zlib maybe-all-target-libiberty
configure-target-libada: $(ALL_GCC_C)
configure-target-libf2c: $(ALL_GCC_C)
all-target-libf2c: maybe-all-target-libiberty
configure-target-libgfortran: $(ALL_GCC_C)
configure-target-libffi: $(ALL_GCC_C)
configure-target-libjava: $(ALL_GCC_C) maybe-configure-target-zlib maybe-configure-target-boehm-gc maybe-configure-target-qthreads maybe-configure-target-libffi

125
configure vendored
View file

@ -910,7 +910,6 @@ target_libraries="target-libiberty \
target-newlib \
target-libstdc++-v3 \
target-libmudflap \
target-libf2c \
target-libgfortran \
${libgcj} \
target-libobjc \
@ -1179,7 +1178,7 @@ case "${target}" in
;;
*-*-kaos*)
# Remove unsupported stuff on all kaOS configurations.
skipdirs="target-libiberty ${libgcj} target-libstdc++-v3 target-libf2c target-librx"
skipdirs="target-libiberty ${libgcj} target-libstdc++-v3 target-librx"
skipdirs="$skipdirs target-libobjc target-examples target-groff target-gperf"
skipdirs="$skipdirs zlib fastjar target-libjava target-boehm-gc target-zlib"
noconfigdirs="$noconfigdirs target-libgloss"
@ -1202,12 +1201,6 @@ case "${target}" in
;;
*-*-rtems*)
noconfigdirs="$noconfigdirs target-libgloss ${libgcj}"
case ${target} in
h8300*-*-* | h8500-*-*)
noconfigdirs="$noconfigdirs target-libf2c"
;;
*) ;;
esac
;;
*-*-uclinux*)
noconfigdirs="$noconfigdirs target-newlib target-libgloss target-rda ${libgcj}"
@ -1308,10 +1301,10 @@ case "${target}" in
noconfigdirs="$noconfigdirs ${libgcj}"
;;
h8300*-*-*)
noconfigdirs="$noconfigdirs target-libgloss ${libgcj} target-libf2c"
noconfigdirs="$noconfigdirs target-libgloss ${libgcj}"
;;
h8500-*-*)
noconfigdirs="$noconfigdirs target-libstdc++-v3 target-libgloss ${libgcj} target-libf2c"
noconfigdirs="$noconfigdirs target-libstdc++-v3 target-libgloss ${libgcj}"
;;
hppa*64*-*-linux* | parisc*64*-*-linux*)
# In this case, it's because the hppa64-linux target is for
@ -1901,7 +1894,7 @@ fi
# Extract the first word of "gcc", so it can be a program name with args.
set dummy gcc; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:1905: checking for $ac_word" >&5
echo "configure:1898: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -1931,7 +1924,7 @@ if test -z "$CC"; then
# Extract the first word of "cc", so it can be a program name with args.
set dummy cc; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:1935: checking for $ac_word" >&5
echo "configure:1928: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -1982,7 +1975,7 @@ fi
# Extract the first word of "cl", so it can be a program name with args.
set dummy cl; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:1986: checking for $ac_word" >&5
echo "configure:1979: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -2014,7 +2007,7 @@ fi
fi
echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
echo "configure:2018: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
echo "configure:2011: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
ac_ext=c
# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
@ -2025,12 +2018,12 @@ cross_compiling=$ac_cv_prog_cc_cross
cat > conftest.$ac_ext << EOF
#line 2029 "configure"
#line 2022 "configure"
#include "confdefs.h"
main(){return(0);}
EOF
if { (eval echo configure:2034: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
if { (eval echo configure:2027: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
ac_cv_prog_cc_works=yes
# If we can't run a trivial program, we are probably using a cross compiler.
if (./conftest; exit) 2>/dev/null; then
@ -2056,12 +2049,12 @@ if test $ac_cv_prog_cc_works = no; then
{ echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
fi
echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
echo "configure:2060: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
echo "configure:2053: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
cross_compiling=$ac_cv_prog_cc_cross
echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
echo "configure:2065: checking whether we are using GNU C" >&5
echo "configure:2058: checking whether we are using GNU C" >&5
if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -2070,7 +2063,7 @@ else
yes;
#endif
EOF
if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:2074: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:2067: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
ac_cv_prog_gcc=yes
else
ac_cv_prog_gcc=no
@ -2089,7 +2082,7 @@ ac_test_CFLAGS="${CFLAGS+set}"
ac_save_CFLAGS="$CFLAGS"
CFLAGS=
echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
echo "configure:2093: checking whether ${CC-cc} accepts -g" >&5
echo "configure:2086: checking whether ${CC-cc} accepts -g" >&5
if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -2125,7 +2118,7 @@ fi
# Extract the first word of "${ac_tool_prefix}gnatbind", so it can be a program name with args.
set dummy ${ac_tool_prefix}gnatbind; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:2129: checking for $ac_word" >&5
echo "configure:2122: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_GNATBIND'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -2157,7 +2150,7 @@ if test -n "$ac_tool_prefix"; then
# Extract the first word of "gnatbind", so it can be a program name with args.
set dummy gnatbind; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:2161: checking for $ac_word" >&5
echo "configure:2154: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_GNATBIND'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -2190,7 +2183,7 @@ fi
fi
echo $ac_n "checking whether compiler driver understands Ada""... $ac_c" 1>&6
echo "configure:2194: checking whether compiler driver understands Ada" >&5
echo "configure:2187: checking whether compiler driver understands Ada" >&5
if eval "test \"`echo '$''{'acx_cv_cc_gcc_supports_ada'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -2223,7 +2216,7 @@ else
fi
echo $ac_n "checking how to compare bootstrapped objects""... $ac_c" 1>&6
echo "configure:2227: checking how to compare bootstrapped objects" >&5
echo "configure:2220: checking how to compare bootstrapped objects" >&5
if eval "test \"`echo '$''{'gcc_cv_prog_cmp_skip'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -2296,9 +2289,9 @@ saved_CFLAGS="$CFLAGS"
CFLAGS="$CFLAGS $gmpinc"
# Check GMP actually works
echo $ac_n "checking for correct version of gmp.h""... $ac_c" 1>&6
echo "configure:2300: checking for correct version of gmp.h" >&5
echo "configure:2293: checking for correct version of gmp.h" >&5
cat > conftest.$ac_ext <<EOF
#line 2302 "configure"
#line 2295 "configure"
#include "confdefs.h"
#include "gmp.h"
int main() {
@ -2309,7 +2302,7 @@ choke me
; return 0; }
EOF
if { (eval echo configure:2313: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
if { (eval echo configure:2306: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
echo "$ac_t""yes" 1>&6
else
@ -2322,19 +2315,19 @@ rm -f conftest*
if test x"$have_gmp" = xyes; then
echo $ac_n "checking for mpf_init in -lgmp""... $ac_c" 1>&6
echo "configure:2326: checking for mpf_init in -lgmp" >&5
echo "configure:2319: checking for mpf_init in -lgmp" >&5
saved_LIBS="$LIBS"
LIBS="$LIBS $gmplibs"
cat > conftest.$ac_ext <<EOF
#line 2331 "configure"
#line 2324 "configure"
#include "confdefs.h"
#include <gmp.h>
int main() {
mpf_t n; mpf_init(n);
; return 0; }
EOF
if { (eval echo configure:2338: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
if { (eval echo configure:2331: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
echo "$ac_t""yes" 1>&6
else
@ -2796,7 +2789,7 @@ do
# Extract the first word of "$ac_prog", so it can be a program name with args.
set dummy $ac_prog; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:2800: checking for $ac_word" >&5
echo "configure:2793: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_DEFAULT_YACC'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -2831,7 +2824,7 @@ do
# Extract the first word of "$ac_prog", so it can be a program name with args.
set dummy $ac_prog; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:2835: checking for $ac_word" >&5
echo "configure:2828: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_DEFAULT_M4'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -2866,7 +2859,7 @@ do
# Extract the first word of "$ac_prog", so it can be a program name with args.
set dummy $ac_prog; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:2870: checking for $ac_word" >&5
echo "configure:2863: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_DEFAULT_LEX'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -3444,7 +3437,7 @@ test -n "$target_alias" && ncn_target_tool_prefix=$target_alias-
# Extract the first word of "${ncn_tool_prefix}ar", so it can be a program name with args.
set dummy ${ncn_tool_prefix}ar; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:3448: checking for $ac_word" >&5
echo "configure:3441: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_AR'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -3477,7 +3470,7 @@ if test -z "$ac_cv_prog_AR" ; then
# Extract the first word of "ar", so it can be a program name with args.
set dummy ar; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:3481: checking for $ac_word" >&5
echo "configure:3474: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_ncn_cv_AR'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -3516,7 +3509,7 @@ fi
# Extract the first word of "${ncn_tool_prefix}as", so it can be a program name with args.
set dummy ${ncn_tool_prefix}as; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:3520: checking for $ac_word" >&5
echo "configure:3513: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_AS'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -3549,7 +3542,7 @@ if test -z "$ac_cv_prog_AS" ; then
# Extract the first word of "as", so it can be a program name with args.
set dummy as; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:3553: checking for $ac_word" >&5
echo "configure:3546: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_ncn_cv_AS'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -3588,7 +3581,7 @@ fi
# Extract the first word of "${ncn_tool_prefix}dlltool", so it can be a program name with args.
set dummy ${ncn_tool_prefix}dlltool; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:3592: checking for $ac_word" >&5
echo "configure:3585: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_DLLTOOL'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -3621,7 +3614,7 @@ if test -z "$ac_cv_prog_DLLTOOL" ; then
# Extract the first word of "dlltool", so it can be a program name with args.
set dummy dlltool; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:3625: checking for $ac_word" >&5
echo "configure:3618: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_ncn_cv_DLLTOOL'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -3660,7 +3653,7 @@ fi
# Extract the first word of "${ncn_tool_prefix}ld", so it can be a program name with args.
set dummy ${ncn_tool_prefix}ld; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:3664: checking for $ac_word" >&5
echo "configure:3657: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_LD'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -3693,7 +3686,7 @@ if test -z "$ac_cv_prog_LD" ; then
# Extract the first word of "ld", so it can be a program name with args.
set dummy ld; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:3697: checking for $ac_word" >&5
echo "configure:3690: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_ncn_cv_LD'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -3732,7 +3725,7 @@ fi
# Extract the first word of "${ncn_tool_prefix}nm", so it can be a program name with args.
set dummy ${ncn_tool_prefix}nm; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:3736: checking for $ac_word" >&5
echo "configure:3729: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_NM'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -3765,7 +3758,7 @@ if test -z "$ac_cv_prog_NM" ; then
# Extract the first word of "nm", so it can be a program name with args.
set dummy nm; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:3769: checking for $ac_word" >&5
echo "configure:3762: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_ncn_cv_NM'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -3804,7 +3797,7 @@ fi
# Extract the first word of "${ncn_tool_prefix}ranlib", so it can be a program name with args.
set dummy ${ncn_tool_prefix}ranlib; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:3808: checking for $ac_word" >&5
echo "configure:3801: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -3837,7 +3830,7 @@ if test -z "$ac_cv_prog_RANLIB" ; then
# Extract the first word of "ranlib", so it can be a program name with args.
set dummy ranlib; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:3841: checking for $ac_word" >&5
echo "configure:3834: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_ncn_cv_RANLIB'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -3876,7 +3869,7 @@ fi
# Extract the first word of "${ncn_tool_prefix}windres", so it can be a program name with args.
set dummy ${ncn_tool_prefix}windres; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:3880: checking for $ac_word" >&5
echo "configure:3873: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_WINDRES'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -3909,7 +3902,7 @@ if test -z "$ac_cv_prog_WINDRES" ; then
# Extract the first word of "windres", so it can be a program name with args.
set dummy windres; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:3913: checking for $ac_word" >&5
echo "configure:3906: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_ncn_cv_WINDRES'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -3948,7 +3941,7 @@ fi
# Extract the first word of "${ncn_tool_prefix}objcopy", so it can be a program name with args.
set dummy ${ncn_tool_prefix}objcopy; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:3952: checking for $ac_word" >&5
echo "configure:3945: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_OBJCOPY'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -3981,7 +3974,7 @@ if test -z "$ac_cv_prog_OBJCOPY" ; then
# Extract the first word of "objcopy", so it can be a program name with args.
set dummy objcopy; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:3985: checking for $ac_word" >&5
echo "configure:3978: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_ncn_cv_OBJCOPY'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -4020,7 +4013,7 @@ fi
# Extract the first word of "${ncn_tool_prefix}objdump", so it can be a program name with args.
set dummy ${ncn_tool_prefix}objdump; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:4024: checking for $ac_word" >&5
echo "configure:4017: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_OBJDUMP'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -4053,7 +4046,7 @@ if test -z "$ac_cv_prog_OBJDUMP" ; then
# Extract the first word of "objdump", so it can be a program name with args.
set dummy objdump; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:4057: checking for $ac_word" >&5
echo "configure:4050: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_ncn_cv_OBJDUMP'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -4102,7 +4095,7 @@ fi
# Extract the first word of "${ncn_target_tool_prefix}ar", so it can be a program name with args.
set dummy ${ncn_target_tool_prefix}ar; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:4106: checking for $ac_word" >&5
echo "configure:4099: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_CONFIGURED_AR_FOR_TARGET'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -4135,7 +4128,7 @@ if test -z "$ac_cv_prog_CONFIGURED_AR_FOR_TARGET" ; then
# Extract the first word of "ar", so it can be a program name with args.
set dummy ar; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:4139: checking for $ac_word" >&5
echo "configure:4132: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_ncn_cv_CONFIGURED_AR_FOR_TARGET'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -4174,7 +4167,7 @@ fi
# Extract the first word of "${ncn_target_tool_prefix}as", so it can be a program name with args.
set dummy ${ncn_target_tool_prefix}as; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:4178: checking for $ac_word" >&5
echo "configure:4171: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_CONFIGURED_AS_FOR_TARGET'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -4207,7 +4200,7 @@ if test -z "$ac_cv_prog_CONFIGURED_AS_FOR_TARGET" ; then
# Extract the first word of "as", so it can be a program name with args.
set dummy as; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:4211: checking for $ac_word" >&5
echo "configure:4204: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_ncn_cv_CONFIGURED_AS_FOR_TARGET'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -4246,7 +4239,7 @@ fi
# Extract the first word of "${ncn_target_tool_prefix}dlltool", so it can be a program name with args.
set dummy ${ncn_target_tool_prefix}dlltool; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:4250: checking for $ac_word" >&5
echo "configure:4243: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_CONFIGURED_DLLTOOL_FOR_TARGET'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -4279,7 +4272,7 @@ if test -z "$ac_cv_prog_CONFIGURED_DLLTOOL_FOR_TARGET" ; then
# Extract the first word of "dlltool", so it can be a program name with args.
set dummy dlltool; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:4283: checking for $ac_word" >&5
echo "configure:4276: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_ncn_cv_CONFIGURED_DLLTOOL_FOR_TARGET'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -4318,7 +4311,7 @@ fi
# Extract the first word of "${ncn_target_tool_prefix}ld", so it can be a program name with args.
set dummy ${ncn_target_tool_prefix}ld; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:4322: checking for $ac_word" >&5
echo "configure:4315: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_CONFIGURED_LD_FOR_TARGET'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -4351,7 +4344,7 @@ if test -z "$ac_cv_prog_CONFIGURED_LD_FOR_TARGET" ; then
# Extract the first word of "ld", so it can be a program name with args.
set dummy ld; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:4355: checking for $ac_word" >&5
echo "configure:4348: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_ncn_cv_CONFIGURED_LD_FOR_TARGET'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -4390,7 +4383,7 @@ fi
# Extract the first word of "${ncn_target_tool_prefix}nm", so it can be a program name with args.
set dummy ${ncn_target_tool_prefix}nm; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:4394: checking for $ac_word" >&5
echo "configure:4387: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_CONFIGURED_NM_FOR_TARGET'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -4423,7 +4416,7 @@ if test -z "$ac_cv_prog_CONFIGURED_NM_FOR_TARGET" ; then
# Extract the first word of "nm", so it can be a program name with args.
set dummy nm; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:4427: checking for $ac_word" >&5
echo "configure:4420: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_ncn_cv_CONFIGURED_NM_FOR_TARGET'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -4462,7 +4455,7 @@ fi
# Extract the first word of "${ncn_target_tool_prefix}ranlib", so it can be a program name with args.
set dummy ${ncn_target_tool_prefix}ranlib; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:4466: checking for $ac_word" >&5
echo "configure:4459: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_CONFIGURED_RANLIB_FOR_TARGET'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -4495,7 +4488,7 @@ if test -z "$ac_cv_prog_CONFIGURED_RANLIB_FOR_TARGET" ; then
# Extract the first word of "ranlib", so it can be a program name with args.
set dummy ranlib; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:4499: checking for $ac_word" >&5
echo "configure:4492: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_ncn_cv_CONFIGURED_RANLIB_FOR_TARGET'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -4534,7 +4527,7 @@ fi
# Extract the first word of "${ncn_target_tool_prefix}windres", so it can be a program name with args.
set dummy ${ncn_target_tool_prefix}windres; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:4538: checking for $ac_word" >&5
echo "configure:4531: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_CONFIGURED_WINDRES_FOR_TARGET'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -4567,7 +4560,7 @@ if test -z "$ac_cv_prog_CONFIGURED_WINDRES_FOR_TARGET" ; then
# Extract the first word of "windres", so it can be a program name with args.
set dummy windres; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:4571: checking for $ac_word" >&5
echo "configure:4564: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_ncn_cv_CONFIGURED_WINDRES_FOR_TARGET'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -4652,7 +4645,7 @@ RANLIB_FOR_TARGET=${RANLIB_FOR_TARGET}${extra_ranlibflags_for_target}
NM_FOR_TARGET=${NM_FOR_TARGET}${extra_nmflags_for_target}
echo $ac_n "checking whether to enable maintainer-specific portions of Makefiles""... $ac_c" 1>&6
echo "configure:4656: checking whether to enable maintainer-specific portions of Makefiles" >&5
echo "configure:4649: checking whether to enable maintainer-specific portions of Makefiles" >&5
# Check whether --enable-maintainer-mode or --disable-maintainer-mode was given.
if test "${enable_maintainer_mode+set}" = set; then
enableval="$enable_maintainer_mode"

13
configure.in
View file

@ -150,7 +150,6 @@ target_libraries="target-libiberty \
target-newlib \
target-libstdc++-v3 \
target-libmudflap \
target-libf2c \
target-libgfortran \
${libgcj} \
target-libobjc \
@ -390,7 +389,7 @@ case "${target}" in
;;
*-*-kaos*)
# Remove unsupported stuff on all kaOS configurations.
skipdirs="target-libiberty ${libgcj} target-libstdc++-v3 target-libf2c target-librx"
skipdirs="target-libiberty ${libgcj} target-libstdc++-v3 target-librx"
skipdirs="$skipdirs target-libobjc target-examples target-groff target-gperf"
skipdirs="$skipdirs zlib fastjar target-libjava target-boehm-gc target-zlib"
noconfigdirs="$noconfigdirs target-libgloss"
@ -413,12 +412,6 @@ case "${target}" in
;;
*-*-rtems*)
noconfigdirs="$noconfigdirs target-libgloss ${libgcj}"
case ${target} in
h8300*-*-* | h8500-*-*)
noconfigdirs="$noconfigdirs target-libf2c"
;;
*) ;;
esac
;;
*-*-uclinux*)
noconfigdirs="$noconfigdirs target-newlib target-libgloss target-rda ${libgcj}"
@ -519,10 +512,10 @@ case "${target}" in
noconfigdirs="$noconfigdirs ${libgcj}"
;;
h8300*-*-*)
noconfigdirs="$noconfigdirs target-libgloss ${libgcj} target-libf2c"
noconfigdirs="$noconfigdirs target-libgloss ${libgcj}"
;;
h8500-*-*)
noconfigdirs="$noconfigdirs target-libstdc++-v3 target-libgloss ${libgcj} target-libf2c"
noconfigdirs="$noconfigdirs target-libstdc++-v3 target-libgloss ${libgcj}"
;;
hppa*64*-*-linux* | parisc*64*-*-linux*)
# In this case, it's because the hppa64-linux target is for

8
contrib/ChangeLog
View file

@ -1,3 +1,9 @@
2004-05-17 Zack Weinberg <zack@codesourcery.com>
* gcc_update: Remove gcc/f/intdoc.texi and all libf2c files
from list of files to be touched.
* convert_to_f2c, convert_to_g2c, download_f2c: Delete.
2004-05-15 Joseph S. Myers <jsm@polyomino.org.uk>
* gennews: Update for GCC 3.4.
@ -14,7 +20,7 @@
libbanshee and libmudflap.
2004-04-12 Kelley Cook <kcook@gcc.gnu.org>
Andreas Jaeger <aj@suse.de>
Andreas Jaeger <aj@suse.de>
* gcc_update (files_and_dependencies): Insert zlib dependencies.

48
contrib/convert_to_f2c
View file

@ -1,48 +0,0 @@
#!/bin/sh
#
# convert_to_f2c [g2c-dir]
#
# Renames certain files in a g2c (libg2c) directory so they no longer have the
# `.netlib' suffix, a la netlib's f2c distribution. If `g2c-dir' is not
# specified, `g2c-YYYYMMDD' is the default, where YYYYMMDD is the current
# date. The directory is renamed such that the first `g' becomes an `f',
# usually `g2c-YYYYMMDD' -> `f2c-YYYYMMDD'.
#
# (C) 1999 Free Software Foundation
# Originally by James Craig Burley <craig@jcb-sc.com>, September 1999.
#
# This script is Free Software, and it can be copied, distributed and
# modified as defined in the GNU General Public License. A copy of
# its license can be downloaded from http://www.gnu.org/copyleft/gpl.html
set -e
if [ x$1 = x ]
then
dir=g2c-`date +%Y%m%d`
else
dir=$1
fi
newdir=`echo $dir | sed -e "s:g:f:"`
cd $dir
set +e
mv -i changes.netlib changes
mv -i disclaimer.netlib disclaimer
mv -i g2c.hin f2c.h
mv -i permission.netlib permission
mv -i readme.netlib readme
cd libF77
mv -i README.netlib README
mv -i makefile.netlib makefile
cd ../libI77
mv -i README.netlib README
mv -i makefile.netlib makefile
cd ..
cd ..
mv -iv $dir $newdir

48
contrib/convert_to_g2c
View file

@ -1,48 +0,0 @@
#!/bin/sh
#
# convert_to_g2c [f2c-dir]
#
# Renames certain files in a netlib f2c directory so they have the `.netlib'
# suffix, a la g77's version of f2c (libg2c). If `f2c-dir' is not specified,
# `f2c-YYYYMMDD' is the default, where YYYYMMDD is the current date.
# The directory is renamed such that the first `f' becomes a `g',
# usually `f2c-YYYYMMDD' -> `g2c-YYYYMMDD'.
#
# (C) 1999 Free Software Foundation
# Originally by James Craig Burley <craig@jcb-sc.com>, September 1999.
#
# This script is Free Software, and it can be copied, distributed and
# modified as defined in the GNU General Public License. A copy of
# its license can be downloaded from http://www.gnu.org/copyleft/gpl.html
set -e
if [ x$1 = x ]
then
dir=f2c-`date +%Y%m%d`
else
dir=$1
fi
newdir=`echo $dir | sed -e "s:f:g:"`
cd $dir
set +e
mv -i changes changes.netlib
mv -i disclaimer disclaimer.netlib
mv -i f2c.h g2c.hin
mv -i permission permission.netlib
mv -i readme readme.netlib
cd libF77
mv -i README README.netlib
mv -i makefile makefile.netlib
cd ../libI77
mv -i README README.netlib
mv -i makefile makefile.netlib
cd ..
cd ..
mv -iv $dir $newdir

77
contrib/download_f2c
View file

@ -1,77 +0,0 @@
#!/bin/sh
#
# download_f2c
#
# Unpacks a directory full of f2c stuff obtained from netlib, naming
# the directory f2c-YYYYMMDD (YYYYMMDD being the current date),
# leaving it in current working directory.
#
# This shell script downloads the tarball from netlib, unpacks everything,
# and strips off the redundant files, leaving a bare-bones (but fully
# reproducible) f2c source directory. (You must have yacc/bison to rebuild
# gram.c, by the way.)
#
# (C) 1999 Free Software Foundation
# Originally by James Craig Burley <craig@jcb-sc.com>, September 1999.
#
# This script is Free Software, and it can be copied, distributed and
# modified as defined in the GNU General Public License. A copy of
# its license can be downloaded from http://www.gnu.org/copyleft/gpl.html
#
# FIXME: Replace WHOAMI with whatever is the canonical way to
# obtain the user's email address these days.
dir=f2c-`date +%Y%m%d`
if [ ! -d $dir ]
then
mkdir $dir
fi
cd $dir
echo Preparing $dir...
if [ ! -d tmp ]
then
mkdir tmp
fi
if [ ! -f tmp/f2c.tar ]
then
cd tmp
echo Downloading f2c.tar via ftp...
ftp -n netlib.bell-labs.com <<EOF
user ftp WHOAMI
type binary
cd netlib
get f2c.tar
quit
EOF
cd ..
fi
echo Unpacking f2c.tar...
tar xf tmp/f2c.tar
cd f2c
find . -name "*.gz" -print | sed -e "s:^\(.*\).gz:rm -f \1.Z:g" | sh
mv src libf77.gz libi77.gz f2c.1t.gz f2c.h.gz changes.gz disclaimer.gz readme.gz permission.gz ..
cd ..
rm -fr f2c
gunzip *.gz
(cd src; rm -f MD5 MD5.gz gram.c.gz .depend .depend.gz f2c.1.gz index.html index.html.gz; gunzip *.gz)
sh libf77 > /dev/null && rm libf77
rm -f libF77/xsum0.out libF77/libF77.xsum
sh libi77 > /dev/null && rm libi77
rm -f libI77/xsum0.out libI77/libI77.xsum
rm -f src/xsum0.out
touch src/xsum.out
cmp f2c.h src/f2c.h && rm -fv src/f2c.h
cmp src/readme src/README && rm -fv src/readme
echo Deleting f2c.tar...
rm tmp/f2c.tar
rmdir tmp
cd ..
echo Latest f2c now in $dir.

8
contrib/gcc_update
View file

@ -66,20 +66,12 @@ gcc/cstamp-h.in: gcc/configure.ac
gcc/config.in: gcc/cstamp-h.in
gcc/fixinc/fixincl.x: gcc/fixinc/fixincl.tpl gcc/fixinc/inclhack.def
# And then, language-specific files
gcc/f/intdoc.texi: gcc/f/intdoc.in gcc/f/intdoc.c gcc/f/intrin.h gcc/f/intrin.def
gcc/cp/cfns.h: gcc/cp/cfns.gperf
gcc/java/keyword.h: gcc/java/keyword.gperf
# testsuite
# Without this, _Pragma3.c can have a false negative.
gcc/testsuite/gcc.dg/cpp/_Pragma3.c: gcc/testsuite/gcc.dg/cpp/mi1c.h
# And libraries, at last
libf2c/configure: libf2c/configure.in
libf2c/libF77/configure: libf2c/libF77/configure.in
libf2c/libI77/configure: libf2c/libI77/configure.in
libf2c/libI77/stamp-h.in: libf2c/libI77/configure.in
libf2c/libI77/config.h.in: libf2c/libI77/configure.in libf2c/libI77/stamp-h.in
libf2c/libU77/configure: libf2c/libU77/configure.in
libf2c/libU77/stamp-h.in: libf2c/libU77/configure.in libf2c/libU77/acconfig.h
libbanshee/configure: libbanshee/configure.in
libmudflap/configure: libmudflap/configure.in
libobjc/configure: libobjc/configure.ac

19
gcc/ChangeLog
View file

@ -1,3 +1,18 @@
2004-05-17 Zack Weinberg <zack@codesourcery.com>
* f: Entire directory removed
* c-common.h (CTI_G77_INTEGER_TYPE, CTI_G77_UINTEGER_TYPE)
(CTI_G77_LONGINT_TYPE, CTI_G77_ULONGINT_TYPE)
(g77_integer_type_node, g77_uinteger_type_node)
(g77_longint_type_node, or g77_ulongint_type_node): Delete.
* c-common.c (c_common_nodes_and_builtins): Do not initialize
the above set of variables.
* config/i386/uwin.h: No need to define WIN32_UWIN_TARGET.
* doc/invoke.texi, doc/standards.texi: Remove cross-references
to g77 manual.
2004-05-17 Steven Bosscher <stevenb@suse.de>
PR tree-optimization/15438
@ -99,7 +114,7 @@
2004-05-15 Richard Earnshaw <reanrsha@arm.com>
* arm/lib1funcs.asm (_lshrdi3, _ashrdi3, _ashldi3): Add ASM
* arm/lib1funcs.asm (_lshrdi3, _ashrdi3, _ashldi3): Add ASM
implementations for ARM and Thumb.
* arm/t-arm-elf (LIB1ASMFUNCS): Use them.
@ -136,7 +151,7 @@
* arm/crtn.asm: (FUNC_END): Simplify.
* arm/lib1funcs.asm: Remove APCS-26 return macros.
* arm/aof.h, arm/coff.h arm/elf.h arm/linux-elf.h arm/netbsd-elf.h
* arm/netbsd.h arm/pe.h arm/semi.h arm/semiaof.h arm/unknown-elf.h
* arm/netbsd.h arm/pe.h arm/semi.h arm/semiaof.h arm/unknown-elf.h
* arm/vxworks.h arm/wince-pe.h: Tidy TARGET_DEFAULTS and
MULTILIB_DEFAULTS as required.
* arm/t-arm-elf arm/t-linux arm/t-pe arm/t-semi arm/t-wince-pe

53
gcc/c-common.c
View file

@ -3253,59 +3253,6 @@ c_common_nodes_and_builtins (void)
(build_decl (TYPE_DECL, get_identifier ("complex long double"),
complex_long_double_type_node));
/* Types which are common to the fortran compiler and libf2c. When
changing these, you also need to be concerned with f/com.h. */
if (TYPE_PRECISION (float_type_node)
== TYPE_PRECISION (long_integer_type_node))
{
g77_integer_type_node = long_integer_type_node;
g77_uinteger_type_node = long_unsigned_type_node;
}
else if (TYPE_PRECISION (float_type_node)
== TYPE_PRECISION (integer_type_node))
{
g77_integer_type_node = integer_type_node;
g77_uinteger_type_node = unsigned_type_node;
}
else
g77_integer_type_node = g77_uinteger_type_node = NULL_TREE;
if (g77_integer_type_node != NULL_TREE)
{
lang_hooks.decls.pushdecl (build_decl (TYPE_DECL,
get_identifier ("__g77_integer"),
g77_integer_type_node));
lang_hooks.decls.pushdecl (build_decl (TYPE_DECL,
get_identifier ("__g77_uinteger"),
g77_uinteger_type_node));
}
if (TYPE_PRECISION (float_type_node) * 2
== TYPE_PRECISION (long_integer_type_node))
{
g77_longint_type_node = long_integer_type_node;
g77_ulongint_type_node = long_unsigned_type_node;
}
else if (TYPE_PRECISION (float_type_node) * 2
== TYPE_PRECISION (long_long_integer_type_node))
{
g77_longint_type_node = long_long_integer_type_node;
g77_ulongint_type_node = long_long_unsigned_type_node;
}
else
g77_longint_type_node = g77_ulongint_type_node = NULL_TREE;
if (g77_longint_type_node != NULL_TREE)
{
lang_hooks.decls.pushdecl (build_decl (TYPE_DECL,
get_identifier ("__g77_longint"),
g77_longint_type_node));
lang_hooks.decls.pushdecl (build_decl (TYPE_DECL,
get_identifier ("__g77_ulongint"),
g77_ulongint_type_node));
}
record_builtin_type (RID_VOID, NULL, void_type_node);
void_zero_node = build_int_2 (0, 0);

11
gcc/c-common.h
View file

@ -156,11 +156,6 @@ enum c_tree_index
CTI_DEFAULT_FUNCTION_TYPE,
CTI_G77_INTEGER_TYPE,
CTI_G77_UINTEGER_TYPE,
CTI_G77_LONGINT_TYPE,
CTI_G77_ULONGINT_TYPE,
/* These are not types, but we have to look them up all the time. */
CTI_FUNCTION_NAME_DECL,
CTI_PRETTY_FUNCTION_NAME_DECL,
@ -205,12 +200,6 @@ struct c_common_identifier GTY(())
#define default_function_type c_global_trees[CTI_DEFAULT_FUNCTION_TYPE]
/* g77 integer types, which must be kept in sync with f/com.h */
#define g77_integer_type_node c_global_trees[CTI_G77_INTEGER_TYPE]
#define g77_uinteger_type_node c_global_trees[CTI_G77_UINTEGER_TYPE]
#define g77_longint_type_node c_global_trees[CTI_G77_LONGINT_TYPE]
#define g77_ulongint_type_node c_global_trees[CTI_G77_ULONGINT_TYPE]
#define function_name_decl_node c_global_trees[CTI_FUNCTION_NAME_DECL]
#define pretty_function_name_decl_node c_global_trees[CTI_PRETTY_FUNCTION_NAME_DECL]
#define c99_function_name_decl_node c_global_trees[CTI_C99_FUNCTION_NAME_DECL]

3
gcc/config/i386/uwin.h
View file

@ -55,9 +55,6 @@ Boston, MA 02111-1307, USA. */
#define LIB_SPEC \
"%{pg:-lgmon} %{mwindows:-luser32 -lgdi32 -lcomdlg32} -lkernel32 -ladvapi32"
/* This is needed in g77spec.c for now. Will be removed in the future. */
#define WIN32_UWIN_TARGET 1
/* Include in the mingw32 libraries with libgcc */
#undef LIBGCC_SPEC
#define LIBGCC_SPEC "-lgnuwin -lposix -lgcc -last -lmoldname -lmsvcrt"

8
gcc/doc/invoke.texi
View file

@ -43,8 +43,8 @@ remainder. @samp{g++} accepts mostly the same options as @samp{gcc}.
@c man end
@c man begin SEEALSO
gpl(7), gfdl(7), fsf-funding(7),
cpp(1), gcov(1), g77(1), as(1), ld(1), gdb(1), adb(1), dbx(1), sdb(1)
and the Info entries for @file{gcc}, @file{cpp}, @file{g77}, @file{as},
cpp(1), gcov(1), as(1), ld(1), gdb(1), adb(1), dbx(1), sdb(1)
and the Info entries for @file{gcc}, @file{cpp}, @file{as},
@file{ld}, @file{binutils} and @file{gdb}.
@c man end
@c man begin BUGS
@ -773,10 +773,6 @@ preprocessor (not included with GCC)@.
@itemx @var{file}.f95
Fortran 90/95 source code which should not be preprocessed.
@xref{Overall Options,,Options Controlling the Kind of Output, g77,
Using and Porting GNU Fortran}, for more details of the handling of
Fortran input files.
@c FIXME: Descriptions of Java file types.
@c @var{file}.java
@c @var{file}.class

3
gcc/doc/standards.texi
View file

@ -185,9 +185,6 @@ HTML format.
GNAT Reference Manual}, for information on standard
conformance and compatibility of the Ada compiler.
@xref{Language,,The GNU Fortran Language, g77, Using and Porting GNU
Fortran}, for details of the Fortran language supported by @command{g77}.
@xref{Standards,,Standards, gfortran, The GNU Fortran 95 Compiler}, for details
of standards supported by @command{gfortran}.

7304
gcc/f/ChangeLog
View file

File diff suppressed because it is too large Load diff

4806
gcc/f/ChangeLog.0
View file

File diff suppressed because it is too large Load diff

21
gcc/f/ChangeLog.tree-ssa
View file

@ -1,21 +0,0 @@
2003-11-16 Toon Moene <toon@moene.indiv.nluug.nl>
* config-lang.in: Re-add.
2003-10-26 Richard Henderson <rth@redhat.com>
* config-lang.in: Remove.
2003-09-24 Jason Merrill <jason@redhat.com>
* com.c, ste.c: Revert earlier change.
2003-01-15 Jeff Law <law@redhat.com>
* com.c (duplicate_decls): Use TREE_FILENAME and TREE_LINENO
to extract file/line information from nodes. Use TREE_LOCUS
to copy file/line information from one node to another.
Make sure to copy TREE_LOCUS from the old decl to the new decl.
(pushdecl): Similarly.
* ste.c: Likewise.

545
gcc/f/Make-lang.in
View file

@ -1,545 +0,0 @@
# Top level -*- makefile -*- fragment for GNU Fortran.
# Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004
# Free Software Foundation, Inc.
#This file is part of GNU Fortran.
#GNU Fortran is free software; you can redistribute it and/or modify
#it under the terms of the GNU General Public License as published by
#the Free Software Foundation; either version 2, or (at your option)
#any later version.
#GNU Fortran is distributed in the hope that it will be useful,
#but WITHOUT 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
#along with GNU Fortran; see the file COPYING. If not, write to
#the Free Software Foundation, 59 Temple Place - Suite 330,
#Boston, MA 02111-1307, USA.
# This file provides the language dependent support in the main Makefile.
# Each language makefile fragment must provide the following targets:
#
# foo.all.build, foo.all.cross, foo.start.encap, foo.rest.encap,
# foo.install-normal, foo.install-common, foo.install-man,
# foo.uninstall,
# foo.mostlyclean, foo.clean, foo.distclean,
# foo.maintainer-clean, foo.stage1, foo.stage2, foo.stage3, foo.stage4
#
# where `foo' is the name of the language.
#
# It should also provide rules for:
#
# - making any compiler driver (eg: g++)
# - the compiler proper (eg: cc1plus)
# - define the names for selecting the language in LANGUAGES.
#
# $(srcdir) must be set to the gcc/ source directory (not gcc/f/).
#
# Actual name to use when installing a native compiler.
G77_INSTALL_NAME := $(shell echo g77|sed '$(program_transform_name)')
# Some versions of `touch' (such as the version on Solaris 2.8)
# do not correctly set the timestamp due to buggy versions of `utime'
# in the kernel. So, we use `echo' instead.
STAMP = echo timestamp >
#
# Define the names for selecting f77 in LANGUAGES.
# Note that it would be nice to move the dependency on g77
# into the F77 rule, but that needs a little bit of work
# to do the right thing within all.cross.
F77 f77: f771$(exeext)
# Tell GNU make to ignore these if they exist.
.PHONY: F77 f77 f77.all.build f77.all.cross \
f77.start.encap f77.rest.encap f77.dvi \
f77.install-normal \
f77.install-common f77.install-man \
f77.uninstall f77.mostlyclean f77.clean f77.distclean \
f77.maintainer-clean \
f77.stage1 f77.stage2 f77.stage3 f77.stage4 \
f77.stageprofile f77.stagefeedback
g77spec.o: $(srcdir)/f/g77spec.c $(SYSTEM_H) coretypes.h $(TM_H) $(GCC_H) \
$(CONFIG_H) intl.h
(SHLIB_LINK='$(SHLIB_LINK)' \
SHLIB_MULTILIB='$(SHLIB_MULTILIB)'; \
$(CC) -c $(ALL_CFLAGS) $(ALL_CPPFLAGS) $(DRIVER_DEFINES) \
$(INCLUDES) $(srcdir)/f/g77spec.c)
# Create the compiler driver for g77.
g77$(exeext): gcc.o g77spec.o version.o prefix.o intl.o \
$(LIBDEPS) $(EXTRA_GCC_OBJS)
$(CC) $(ALL_CFLAGS) $(LDFLAGS) -o $@ gcc.o g77spec.o \
version.o prefix.o intl.o $(EXTRA_GCC_OBJS) $(LIBS)
# Create a version of the g77 driver which calls the cross-compiler.
g77-cross$(exeext): g77$(exeext)
rm -f g77-cross$(exeext); \
cp g77$(exeext) g77-cross$(exeext)
# The compiler itself.
F77_OBJS = f/bad.o f/bit.o f/bld.o f/com.o f/data.o f/equiv.o f/expr.o \
f/global.o f/implic.o f/info.o f/intrin.o f/lab.o f/lex.o f/malloc.o \
f/name.o f/parse.o f/src.o f/st.o f/sta.o f/stb.o f/stc.o \
f/std.o f/ste.o f/storag.o f/stp.o f/str.o f/sts.o f/stt.o f/stu.o \
f/stv.o f/stw.o f/symbol.o f/target.o f/top.o f/type.o f/where.o
# Use loose warnings for this front end.
f-warn = $(WERROR)
f771$(exeext): $(F77_OBJS) $(BACKEND) $(LIBDEPS)
rm -f f771$(exeext)
$(CC) $(ALL_CFLAGS) $(LDFLAGS) -o $@ $(F77_OBJS) $(BACKEND) $(LIBS)
# Keyword tables.
f/stamp-str: f/str-1t.h f/str-1t.j f/str-2t.h f/str-2t.j \
f/str-fo.h f/str-fo.j f/str-io.h f/str-io.j f/str-nq.h f/str-nq.j \
f/str-op.h f/str-op.j f/str-ot.h f/str-ot.j
$(STAMP) f/stamp-str
f/str-1t.h f/str-1t.j: f/stamp-1t ; @true
f/stamp-1t: f/fini$(build_exeext) f/str-1t.fin
./f/fini$(build_exeext) $(srcdir)/f/str-1t.fin f/tmp-str-1t.j f/tmp-str-1t.h
$(SHELL) $(srcdir)/../move-if-change f/tmp-str-1t.j f/str-1t.j
$(SHELL) $(srcdir)/../move-if-change f/tmp-str-1t.h f/str-1t.h
$(STAMP) f/stamp-1t
f/str-2t.h f/str-2t.j: f/stamp-2t ; @true
f/stamp-2t: f/fini$(build_exeext) f/str-2t.fin
./f/fini$(build_exeext) $(srcdir)/f/str-2t.fin f/tmp-str-2t.j f/tmp-str-2t.h
$(SHELL) $(srcdir)/../move-if-change f/tmp-str-2t.j f/str-2t.j
$(SHELL) $(srcdir)/../move-if-change f/tmp-str-2t.h f/str-2t.h
$(STAMP) f/stamp-2t
f/str-fo.h f/str-fo.j: f/stamp-fo ; @true
f/stamp-fo: f/fini$(build_exeext) f/str-fo.fin
./f/fini$(build_exeext) $(srcdir)/f/str-fo.fin f/tmp-str-fo.j f/tmp-str-fo.h
$(SHELL) $(srcdir)/../move-if-change f/tmp-str-fo.j f/str-fo.j
$(SHELL) $(srcdir)/../move-if-change f/tmp-str-fo.h f/str-fo.h
$(STAMP) f/stamp-fo
f/str-io.h f/str-io.j: f/stamp-io ; @true
f/stamp-io: f/fini$(build_exeext) f/str-io.fin
./f/fini$(build_exeext) $(srcdir)/f/str-io.fin f/tmp-str-io.j f/tmp-str-io.h
$(SHELL) $(srcdir)/../move-if-change f/tmp-str-io.j f/str-io.j
$(SHELL) $(srcdir)/../move-if-change f/tmp-str-io.h f/str-io.h
$(STAMP) f/stamp-io
f/str-nq.h f/str-nq.j: f/stamp-nq ; @true
f/stamp-nq: f/fini$(build_exeext) f/str-nq.fin
./f/fini$(build_exeext) $(srcdir)/f/str-nq.fin f/tmp-str-nq.j f/tmp-str-nq.h
$(SHELL) $(srcdir)/../move-if-change f/tmp-str-nq.j f/str-nq.j
$(SHELL) $(srcdir)/../move-if-change f/tmp-str-nq.h f/str-nq.h
$(STAMP) f/stamp-nq
f/str-op.h f/str-op.j: f/stamp-op ; @true
f/stamp-op: f/fini$(build_exeext) f/str-op.fin
./f/fini$(build_exeext) $(srcdir)/f/str-op.fin f/tmp-str-op.j f/tmp-str-op.h
$(SHELL) $(srcdir)/../move-if-change f/tmp-str-op.j f/str-op.j
$(SHELL) $(srcdir)/../move-if-change f/tmp-str-op.h f/str-op.h
$(STAMP) f/stamp-op
f/str-ot.h f/str-ot.j: f/stamp-ot ; @true
f/stamp-ot: f/fini$(build_exeext) f/str-ot.fin
./f/fini$(build_exeext) $(srcdir)/f/str-ot.fin f/tmp-str-ot.j f/tmp-str-ot.h
$(SHELL) $(srcdir)/../move-if-change f/tmp-str-ot.j f/str-ot.j
$(SHELL) $(srcdir)/../move-if-change f/tmp-str-ot.h f/str-ot.h
$(STAMP) f/stamp-ot
f/fini$(build_exeext): f/fini.o $(BUILD_LIBDEPS)
$(CC_FOR_BUILD) $(BUILD_CFLAGS) $(BUILD_LDFLAGS) -o f/fini$(build_exeext) \
f/fini.o $(BUILD_LIBS)
f/fini.o:
$(CC_FOR_BUILD) $(BUILD_CFLAGS) $(BUILD_CPPFLAGS) $(INCLUDES) \
-c $(srcdir)/f/fini.c $(OUTPUT_OPTION)
gt-f-lex.h gt-f-where.h gt-f-com.h gt-f-ste.h gtype-f.h : s-gtype; @true
#
# Build hooks:
f77.all.build: g77$(exeext)
f77.all.cross: g77-cross$(exeext)
f77.start.encap: g77$(exeext)
f77.rest.encap:
f77.srcinfo: doc/g77.info
-cp -p $^ $(srcdir)/doc
f77.srcman: doc/g77.1
-cp -p $^ $(srcdir)/doc
f77.srcextra: f/BUGS f/NEWS
-cp -p $^ $(srcdir)/f
f77.tags: force
cd $(srcdir)/f; etags -o TAGS.sub *.c *.h; \
etags --include TAGS.sub --include ../TAGS.sub
f77.info: doc/g77.info
dvi:: doc/g77.dvi
f77.man: doc/g77.1
check-f77 : check-g77
lang_checks += check-g77
# g77 documentation.
TEXI_G77_FILES = f/g77.texi f/bugs.texi f/ffe.texi f/invoke.texi \
f/news.texi f/root.texi $(docdir)/include/fdl.texi \
$(docdir)/include/gpl.texi $(docdir)/include/funding.texi \
$(docdir)/include/gcc-common.texi $(srcdir)/f/intdoc.texi
doc/g77.info: $(TEXI_G77_FILES)
if test "x$(BUILD_INFO)" = xinfo; then \
rm -f $(@)*; \
$(MAKEINFO) $(MAKEINFOFLAGS) -I$(docdir)/include -I$(srcdir)/f \
-o$@ $<; \
else true; fi
doc/g77.dvi: $(TEXI_G77_FILES)
$(TEXI2DVI) -I $(srcdir)/f -I $(abs_docdir)/include -I $(objdir)/f -o $@ $<
.INTERMEDIATE: g77.pod
g77.pod: f/invoke.texi
-$(TEXI2POD) < $< > $@
# This dance is all about producing accurate documentation for g77's
# intrinsics with minimum fuss. f/ansify appends "\n\" to C strings
# so ANSI C compilers can compile f/intdoc.h -- gcc can compile f/intdoc.in
# directly, if f/intdoc.c #include'd that, but we don't want to force
# people to install gcc just to build the documentation. We use the
# C format for f/intdoc.in in the first place to allow a fairly "free",
# but widely known format for documentation -- basically anyone who knows
# how to write texinfo source and enclose it in C constants can handle
# it, and f/ansify allows them to not even end lines with "\n\". So,
# essentially, the C preprocessor and compiler are used to enter the
# document snippets into a data base via name lookup, rather than duplicating
# that kind of code here. And we use f/intdoc.c instead of straight
# texinfo in the first place so that as much information as possible
# contained in f/intrin.def can be inserted directly and reliably into
# the documentation. That's better than replicating it, because it
# reduces the likelihood of discrepancies between the docs and the compiler
# itself, which uses f/intrin.def; in fact, many bugs in f/intrin.def have
# been found only upon reading the documentation that was automatically
# produced from it.
# If the documentation files depended on executables in the build
# tree, there'd be no way to ship a source tree with the documentation
# already generated such that `make' wouldn't attempt to rebuild it.
# So, we punt and arrange for the documentation files to depend on the
# dependencies of the executables, not on the executables themselves.
# But then, we have to build the executables explicitly in their build
# rules.
INTDOC_DEPS = f/intdoc.c f/intrin.h f/intrin.def
$(srcdir)/f/intdoc.texi: $(INTDOC_DEPS) f/intdoc.in
$(MAKE) f/intdoc$(build_exeext)
f/intdoc$(build_exeext) > $(srcdir)/f/intdoc.texi
f/intdoc$(build_exeext): $(INTDOC_DEPS) f/intdoc.h0 bconfig.h \
$(SYSTEM_H) coretypes.h $(TM_H) $(BUILD_LIBDEPS)
$(CC_FOR_BUILD) $(BUILD_CFLAGS) $(BUILD_LDFLAGS) $(INCLUDES) $< \
$(BUILD_LIBS) -o $@
f/intdoc.h0: f/intdoc.in f/ansify$(build_exeext)
f/ansify$(build_exeext) $< < $< > $@
f/ansify$(build_exeext): f/ansify.c bconfig.h $(SYSTEM_H) coretypes.h $(TM_H)
$(CC_FOR_BUILD) $(BUILD_CFLAGS) $(BUILD_LDFLAGS) $(INCLUDES) $< \
-o $@
f/BUGS: f/bugs0.texi f/bugs.texi f/root.texi
if [ x$(BUILD_INFO) = xinfo ]; then \
rm -f $(@)*; \
$(MAKEINFO) $(MAKEINFOFLAGS) -D BUGSONLY --no-header --no-split \
--no-validate -I$(docdir)/include -I$(srcdir)/f -o $@ bugs0.texi; \
else true; fi
f/NEWS: f/news0.texi f/news.texi f/root.texi
if [ x$(BUILD_INFO) = xinfo ]; then \
rm -f $(@)*; \
$(MAKEINFO) $(MAKEINFOFLAGS) -D NEWSONLY --no-header --no-split \
--no-validate -I$(docdir)/include -I$(srcdir)/f -o $@ news0.texi; \
else true; fi
#
# Install hooks:
# f771 is installed elsewhere as part of $(COMPILERS).
f77.install-normal:
# Install the driver program as $(target)-g77
# and also as either g77 (if native) or $(tooldir)/bin/g77.
f77.install-common: installdirs
-if [ -f f771$(exeext) ] ; then \
rm -f $(DESTDIR)$(bindir)/$(G77_INSTALL_NAME)$(exeext); \
$(INSTALL_PROGRAM) g77$(exeext) $(DESTDIR)$(bindir)/$(G77_INSTALL_NAME)$(exeext); \
chmod a+x $(DESTDIR)$(bindir)/$(G77_INSTALL_NAME)$(exeext); \
else true; fi
@if [ -f f77-install-ok -o -f $(srcdir)/f77-install-ok ]; then \
echo ''; \
echo 'Warning: gcc no longer installs an f77 command.'; \
echo ' You must do so yourself. For more information,'; \
echo ' read "Distributing Binaries" in the g77 docs.'; \
echo ' (To turn off this warning, delete the file'; \
echo ' f77-install-ok in the source or build directory.)'; \
echo ''; \
else true; fi
install-info:: $(DESTDIR)$(infodir)/g77.info
f77.install-man: installdirs $(DESTDIR)$(man1dir)/$(G77_INSTALL_NAME)$(man1ext)
$(DESTDIR)$(man1dir)/$(G77_INSTALL_NAME)$(man1ext): doc/g77.1
-rm -f $@
-$(INSTALL_DATA) $< $@
-chmod a-x $@
f77.uninstall: installdirs
if $(SHELL) -c 'install-info --version | sed 1q | fgrep -s -v -i debian' >/dev/null 2>&1; then \
echo " install-info --delete --info-dir=$(DESTDIR)$(infodir) $(DESTDIR)$(infodir)/g77.info"; \
install-info --delete --info-dir=$(DESTDIR)$(infodir) $(DESTDIR)$(infodir)/g77.info || : ; \
else : ; fi
rm -rf $(DESTDIR)$(bindir)/$(G77_INSTALL_NAME)$(exeext); \
rm -rf $(DESTDIR)$(man1dir)/$(G77_INSTALL_NAME)$(man1ext); \
rm -rf $(DESTDIR)$(infodir)/g77.info*
#
# Clean hooks:
# A lot of the ancillary files are deleted by the main makefile.
# We just have to delete files specific to us.
f77.mostlyclean:
-rm -f f/*$(objext)
-rm -f f/*$(coverageexts)
-rm -f f/fini$(build_exeext) f/stamp-str f/str-*.h f/str-*.j
-rm -f f/BUGS f/NEWS
-rm -f g77.aux g77.cps g77.ky g77.toc g77.vr g77.fn g77.kys \
g77.pg g77.tp g77.vrs g77.cp g77.fns g77.log g77.pgs g77.tps
f77.clean:
-rm -f g77spec.o
f77.distclean:
-rm -f f/Makefile
f77.maintainer-clean:
-rm -f $(srcdir)/f/BUGS $(srcdir)/f/TAGS $(srcdir)/f/TAGS.SUB
-rm -f $(srcdir)/f/NEWS $(srcdir)/f/intdoc.texi
#
# Stage hooks:
# The main makefile has already created stage?/f.
G77STAGESTUFF = f/*$(objext) f/fini$(build_exeext) f/stamp-* \
f/str-*.h f/str-*.j g77spec.o
f77.stage1: stage1-start
-mv -f $(G77STAGESTUFF) stage1/f
f77.stage2: stage2-start
-mv -f $(G77STAGESTUFF) stage2/f
f77.stage3: stage3-start
-mv -f $(G77STAGESTUFF) stage3/f
f77.stage4: stage4-start
-mv -f $(G77STAGESTUFF) stage4/f
f77.stageprofile: stageprofile-start
-mv -f $(G77STAGESTUFF) stageprofile/f
f77.stagefeedback: stageprofile-start
-mv -f $(G77STAGESTUFF) stagefeedback/f
#
# .o: .h dependencies.
f/bad.o: f/bad.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/bad.h f/bad.def f/where.h \
glimits.h f/top.h f/malloc.h flags.h f/com.h f/com-rt.def $(TREE_H) f/bld.h \
f/bld-op.def f/bit.h f/info.h f/info-b.def f/info-k.def f/info-w.def \
f/target.h f/lex.h f/type.h f/intrin.h f/intrin.def f/lab.h f/symbol.h \
f/symbol.def f/equiv.h f/storag.h f/global.h f/name.h toplev.h intl.h \
diagnostic.h coretypes.h $(TM_H)
f/bit.o: f/bit.c f/proj.h $(CONFIG_H) $(SYSTEM_H) glimits.h f/bit.h \
f/malloc.h coretypes.h $(TM_H)
f/bld.o: f/bld.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/bld.h f/bld-op.def f/bit.h \
f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def \
f/info-w.def f/target.h f/bad.h f/bad.def f/where.h glimits.h f/top.h f/lex.h \
f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h f/global.h \
f/name.h f/intrin.h f/intrin.def real.h coretypes.h $(TM_H)
f/com.o: f/com.c f/proj.h $(CONFIG_H) $(SYSTEM_H) flags.h $(RTL_H) $(TREE_H) \
output.h convert.h f/com.h f/com-rt.def f/bld.h f/bld-op.def f/bit.h \
f/malloc.h f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h \
f/bad.def f/where.h glimits.h f/top.h f/lex.h f/type.h f/intrin.h \
f/intrin.def f/lab.h f/symbol.h f/symbol.def f/equiv.h f/storag.h f/global.h \
f/name.h f/expr.h f/implic.h f/src.h f/st.h $(GGC_H) toplev.h diagnostic.h \
$(LANGHOOKS_DEF) langhooks.h intl.h real.h debug.h gt-f-com.h gtype-f.h \
coretypes.h $(TM_H) function.h
f/data.o: f/data.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/data.h f/bld.h f/bld-op.def \
f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def \
f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def f/where.h glimits.h \
f/top.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h \
f/global.h f/name.h f/intrin.h f/intrin.def f/expr.h f/st.h coretypes.h $(TM_H)
f/equiv.o: f/equiv.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/equiv.h f/bld.h \
f/bld-op.def f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h \
f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def f/where.h \
glimits.h f/top.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def \
f/global.h f/name.h f/intrin.h f/intrin.def f/data.h coretypes.h $(TM_H)
f/expr.o: f/expr.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/expr.h f/bld.h f/bld-op.def \
f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def \
f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def f/where.h glimits.h \
f/top.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h \
f/global.h f/name.h f/intrin.h f/intrin.def f/implic.h f/src.h f/st.h \
f/stamp-str real.h coretypes.h $(TM_H)
f/fini.o: f/fini.c f/proj.h bconfig.h $(SYSTEM_H) f/malloc.h coretypes.h $(TM_H)
f/global.o: f/global.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/global.h f/info.h \
f/info-b.def f/info-k.def f/info-w.def f/target.h $(TREE_H) f/bad.h f/bad.def \
f/where.h glimits.h f/top.h f/malloc.h f/lex.h f/type.h f/name.h f/symbol.h \
f/symbol.def f/bld.h f/bld-op.def f/bit.h f/com.h f/com-rt.def f/lab.h \
f/storag.h f/intrin.h f/intrin.def f/equiv.h coretypes.h $(TM_H)
f/implic.o: f/implic.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/implic.h f/info.h \
f/info-b.def f/info-k.def f/info-w.def f/target.h $(TREE_H) f/bad.h f/bad.def \
f/where.h glimits.h f/top.h f/malloc.h f/lex.h f/type.h f/symbol.h \
f/symbol.def f/bld.h f/bld-op.def f/bit.h f/com.h f/com-rt.def f/lab.h \
f/storag.h f/intrin.h f/intrin.def f/equiv.h f/global.h f/name.h f/src.h \
coretypes.h $(TM_H)
f/info.o: f/info.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/info.h f/info-b.def \
f/info-k.def f/info-w.def f/target.h $(TREE_H) f/bad.h f/bad.def f/where.h \
glimits.h f/top.h f/malloc.h f/lex.h f/type.h coretypes.h $(TM_H)
f/intrin.o: f/intrin.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/intrin.h \
f/intrin.def f/bld.h f/bld-op.def f/bit.h f/malloc.h f/com.h f/com-rt.def \
$(TREE_H) f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h \
f/bad.def f/where.h glimits.h f/top.h f/lex.h f/type.h f/lab.h f/storag.h \
f/symbol.h f/symbol.def f/equiv.h f/global.h f/name.h f/expr.h f/src.h \
coretypes.h $(TM_H)
f/lab.o: f/lab.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/lab.h f/com.h f/com-rt.def \
$(TREE_H) f/bld.h f/bld-op.def f/bit.h f/malloc.h f/info.h f/info-b.def \
f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def f/where.h glimits.h \
f/top.h f/lex.h f/type.h f/intrin.h f/intrin.def f/symbol.h f/symbol.def \
f/equiv.h f/storag.h f/global.h f/name.h coretypes.h $(TM_H)
f/lex.o: f/lex.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/top.h f/malloc.h f/where.h \
glimits.h f/bad.h f/bad.def f/com.h f/com-rt.def $(TREE_H) f/bld.h \
f/bld-op.def f/bit.h f/info.h f/info-b.def f/info-k.def f/info-w.def \
f/target.h f/lex.h f/type.h f/intrin.h f/intrin.def f/lab.h f/symbol.h \
f/symbol.def f/equiv.h f/storag.h f/global.h f/name.h f/src.h flags.h \
debug.h input.h toplev.h output.h $(GGC_H) gt-f-lex.h coretypes.h $(TM_H)
f/malloc.o: f/malloc.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/malloc.h \
coretypes.h $(TM_H)
f/name.o: f/name.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/bad.h f/bad.def f/where.h \
glimits.h f/top.h f/malloc.h f/name.h f/global.h f/info.h f/info-b.def \
f/info-k.def f/info-w.def f/target.h $(TREE_H) f/lex.h f/type.h f/symbol.h \
f/symbol.def f/bld.h f/bld-op.def f/bit.h f/com.h f/com-rt.def f/lab.h \
f/storag.h f/intrin.h f/intrin.def f/equiv.h f/src.h coretypes.h $(TM_H)
f/parse.o: f/parse.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/top.h f/malloc.h \
f/where.h glimits.h f/com.h f/com-rt.def $(TREE_H) f/bld.h f/bld-op.def \
f/bit.h f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h \
f/bad.def f/lex.h f/type.h f/intrin.h f/intrin.def f/lab.h f/symbol.h \
f/symbol.def f/equiv.h f/storag.h f/global.h f/name.h version.h flags.h \
coretypes.h $(TM_H)
f/src.o: f/src.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/src.h f/bad.h f/bad.def \
f/where.h glimits.h f/top.h f/malloc.h coretypes.h $(TM_H)
f/st.o: f/st.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/st.h f/bad.h f/bad.def \
f/where.h glimits.h f/top.h f/malloc.h f/lex.h f/symbol.h f/symbol.def \
f/bld.h f/bld-op.def f/bit.h f/com.h f/com-rt.def $(TREE_H) f/info.h \
f/info-b.def f/info-k.def f/info-w.def f/target.h f/type.h f/lab.h \
f/storag.h f/intrin.h f/intrin.def f/equiv.h f/global.h f/name.h f/sta.h \
f/stamp-str f/stb.h f/expr.h f/stp.h f/stt.h f/stc.h f/std.h \
f/stv.h f/stw.h f/ste.h f/sts.h f/stu.h coretypes.h $(TM_H)
f/sta.o: f/sta.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/sta.h f/bad.h f/bad.def \
f/where.h glimits.h f/top.h f/malloc.h f/lex.h f/stamp-str f/symbol.h \
f/symbol.def f/bld.h f/bld-op.def f/bit.h f/com.h f/com-rt.def $(TREE_H) \
f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/type.h f/lab.h \
f/storag.h f/intrin.h f/intrin.def f/equiv.h f/global.h f/name.h f/implic.h \
f/stb.h f/expr.h f/stp.h f/stt.h f/stc.h f/std.h f/stv.h f/stw.h coretypes.h \
$(TM_H)
f/stb.o: f/stb.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/stb.h f/bad.h f/bad.def \
f/where.h glimits.h f/top.h f/malloc.h f/expr.h f/bld.h f/bld-op.def f/bit.h \
f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def \
f/info-w.def f/target.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h \
f/symbol.def f/equiv.h f/global.h f/name.h f/intrin.h f/intrin.def f/stp.h \
f/stt.h f/stamp-str f/src.h f/sta.h f/stc.h coretypes.h $(TM_H)
f/stc.o: f/stc.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/stc.h f/bad.h f/bad.def \
f/where.h glimits.h f/top.h f/malloc.h f/bld.h f/bld-op.def f/bit.h f/com.h \
f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def f/info-w.def \
f/target.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def \
f/equiv.h f/global.h f/name.h f/intrin.h f/intrin.def f/expr.h f/stp.h \
f/stt.h f/stamp-str f/data.h f/implic.h f/src.h f/sta.h f/std.h f/stv.h \
f/stw.h coretypes.h $(TM_H)
f/std.o: f/std.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/std.h f/bld.h f/bld-op.def \
f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def \
f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def f/where.h glimits.h \
f/top.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h \
f/global.h f/name.h f/intrin.h f/intrin.def f/stp.h f/stt.h f/stamp-str \
f/stv.h f/stw.h f/sta.h f/ste.h f/sts.h coretypes.h $(TM_H)
f/ste.o: f/ste.c f/proj.h $(CONFIG_H) $(SYSTEM_H) $(RTL_H) toplev.h f/ste.h \
f/bld.h f/bld-op.def f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) \
f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def \
f/where.h glimits.h f/top.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h \
f/symbol.def f/equiv.h f/global.h f/name.h f/intrin.h f/intrin.def f/stp.h \
f/stt.h f/stamp-str f/sts.h f/stv.h f/stw.h f/expr.h f/sta.h $(GGC_H) \
gt-f-ste.h coretypes.h $(TM_H)
f/storag.o: f/storag.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/storag.h f/bld.h \
f/bld-op.def f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) \
f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h \
f/bad.def f/where.h glimits.h f/top.h f/lex.h f/type.h f/lab.h \
f/symbol.h f/symbol.def f/equiv.h f/global.h f/name.h f/intrin.h \
f/intrin.def f/data.h coretypes.h $(TM_H)
f/stp.o: f/stp.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/stp.h f/bld.h f/bld-op.def \
f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h \
f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def \
f/where.h glimits.h f/top.h f/lex.h f/type.h f/lab.h f/storag.h \
f/symbol.h f/symbol.def f/equiv.h f/global.h f/name.h f/intrin.h \
f/intrin.def f/stt.h coretypes.h $(TM_H)
f/str.o: f/str.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/src.h f/bad.h f/bad.def \
f/where.h glimits.h f/top.h f/malloc.h f/stamp-str f/lex.h coretypes.h $(TM_H)
f/sts.o: f/sts.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/sts.h f/malloc.h f/com.h \
f/com-rt.def $(TREE_H) f/bld.h f/bld-op.def f/bit.h f/info.h \
f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def \
f/where.h glimits.h f/top.h f/lex.h f/type.h f/intrin.h f/intrin.def \
f/lab.h f/symbol.h f/symbol.def f/equiv.h f/storag.h f/global.h \
f/name.h coretypes.h $(TM_H)
f/stt.o: f/stt.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/stt.h f/top.h f/malloc.h \
f/where.h glimits.h f/bld.h f/bld-op.def f/bit.h f/com.h f/com-rt.def \
$(TREE_H) f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h \
f/bad.h f/bad.def f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h \
f/symbol.def f/equiv.h f/global.h f/name.h f/intrin.h f/intrin.def \
f/stp.h f/expr.h f/sta.h f/stamp-str coretypes.h $(TM_H)
f/stu.o: f/stu.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/bld.h f/bld-op.def f/bit.h \
f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def \
f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def f/where.h \
glimits.h f/top.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h \
f/symbol.def f/equiv.h f/global.h f/name.h f/intrin.h f/intrin.def \
f/implic.h f/stu.h f/sta.h f/stamp-str coretypes.h $(TM_H)
f/stv.o: f/stv.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/stv.h f/lab.h f/com.h \
f/com-rt.def $(TREE_H) f/bld.h f/bld-op.def f/bit.h f/malloc.h \
f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h \
f/bad.def f/where.h glimits.h f/top.h f/lex.h f/type.h f/intrin.h \
f/intrin.def f/symbol.h f/symbol.def f/equiv.h f/storag.h f/global.h \
f/name.h coretypes.h $(TM_H)
f/stw.o: f/stw.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/stw.h f/bld.h f/bld-op.def \
f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h \
f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def \
f/where.h glimits.h f/top.h f/lex.h f/type.h f/lab.h f/storag.h \
f/symbol.h f/symbol.def f/equiv.h f/global.h f/name.h f/intrin.h \
f/intrin.def f/stv.h f/sta.h f/stamp-str coretypes.h $(TM_H)
f/symbol.o: f/symbol.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/symbol.h \
f/symbol.def f/bld.h f/bld-op.def f/bit.h f/malloc.h f/com.h \
f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def \
f/info-w.def f/target.h f/bad.h f/bad.def f/where.h glimits.h f/top.h \
f/lex.h f/type.h f/lab.h f/storag.h f/intrin.h f/intrin.def f/equiv.h \
f/global.h f/name.h f/src.h f/st.h coretypes.h $(TM_H)
f/target.o: f/target.c f/proj.h $(CONFIG_H) $(SYSTEM_H) glimits.h f/target.h \
$(TREE_H) f/bad.h f/bad.def f/where.h f/top.h f/malloc.h f/info.h real.h \
f/info-b.def f/info-k.def f/info-w.def f/type.h f/lex.h diagnostic.h \
coretypes.h $(TM_H) toplev.h
f/top.o: f/top.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/top.h f/malloc.h f/where.h \
glimits.h f/bad.h f/bad.def f/bit.h f/bld.h f/bld-op.def f/com.h \
f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def \
f/info-w.def f/target.h f/lex.h f/type.h f/lab.h f/storag.h \
f/symbol.h f/symbol.def f/equiv.h f/global.h f/name.h f/intrin.h \
f/intrin.def f/data.h f/expr.h f/implic.h f/src.h f/st.h flags.h \
toplev.h coretypes.h $(TM_H) opts.h options.h
f/type.o: f/type.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/type.h f/malloc.h \
coretypes.h $(TM_H)
f/where.o: f/where.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/where.h glimits.h \
f/top.h f/malloc.h f/lex.h $(GGC_H) gt-f-where.h coretypes.h $(TM_H)

5
gcc/f/RELEASE-PREP
View file

@ -1,5 +0,0 @@
1999-03-13 RELEASE-PREP
Things to do to prepare a g77 release.
- Update root.texi: clear DEVELOPMENT flag, set version info.

190
gcc/f/ansify.c
View file

@ -1,190 +0,0 @@
/* ansify.c
Copyright (C) 1997, 2003 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA. */
#include "bconfig.h"
#include "system.h"
#include "coretypes.h"
#include "tm.h"
#define die_unless(c) \
do if (!(c)) \
{ \
fprintf (stderr, "%s:%lu: %s\n", argv[1], lineno, #c); \
die (); \
} \
while(0)
static void ATTRIBUTE_NORETURN
die (void)
{
exit (1);
}
int
main(int argc, char **argv)
{
int c;
static unsigned long lineno = 1;
die_unless (argc == 2);
printf ("\
/* This file is automatically generated from `%s',\n\
which you should modify instead. */\n\
#line 1 \"%s\"\n\
",
argv[1], argv[1]);
while ((c = getchar ()) != EOF)
{
switch (c)
{
default:
putchar (c);
break;
case '\n':
++lineno;
putchar (c);
break;
case '"':
putchar (c);
for (;;)
{
c = getchar ();
die_unless (c != EOF);
switch (c)
{
case '"':
putchar (c);
goto next_char;
case '\n':
putchar ('\\');
putchar ('n');
putchar ('\\');
putchar ('\n');
++lineno;
break;
case '\\':
putchar (c);
c = getchar ();
die_unless (c != EOF);
putchar (c);
if (c == '\n')
++lineno;
break;
default:
putchar (c);
break;
}
}
break;
case '\'':
putchar (c);
for (;;)
{
c = getchar ();
die_unless (c != EOF);
switch (c)
{
case '\'':
putchar (c);
goto next_char;
case '\n':
putchar ('\\');
putchar ('n');
putchar ('\\');
putchar ('\n');
++lineno;
break;
case '\\':
putchar (c);
c = getchar ();
die_unless (c != EOF);
putchar (c);
if (c == '\n')
++lineno;
break;
default:
putchar (c);
break;
}
}
break;
case '/':
putchar (c);
c = getchar ();
putchar (c);
if (c != '*')
break;
for (;;)
{
c = getchar ();
die_unless (c != EOF);
switch (c)
{
case '\n':
++lineno;
putchar (c);
break;
case '*':
c = getchar ();
die_unless (c != EOF);
if (c == '/')
{
putchar ('*');
putchar ('/');
goto next_char;
}
if (c == '\n')
{
++lineno;
putchar (c);
}
break;
default:
/* Don't bother outputting content of comments. */
break;
}
}
break;
}
next_char:
;
}
die_unless (c == EOF);
return 0;
}

537
gcc/f/bad.c
View file

@ -1,537 +0,0 @@
/* bad.c -- Implementation File (module.c template V1.0)
Copyright (C) 1995, 2002, 2003 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Related Modules:
None
Description:
Handles the displaying of diagnostic messages regarding the user's source
files.
Modifications:
*/
/* If there's a %E or %4 in the messages, set this to at least 5,
for example. */
#define FFEBAD_MAX_ 6
/* Include files. */
#include "proj.h"
#include "bad.h"
#include "flags.h"
#include "com.h"
#include "toplev.h"
#include "where.h"
#include "intl.h"
#include "diagnostic.h"
/* Externals defined here. */
bool ffebad_is_inhibited_ = FALSE;
/* Simple definitions and enumerations. */
#define FFEBAD_LONG_MSGS_ 1 /* 0 to use short (or same) messages. */
/* Internal typedefs. */
/* Private include files. */
/* Internal structure definitions. */
struct _ffebad_message_
{
const ffebadSeverity severity;
const char *const message;
};
/* Static objects accessed by functions in this module. */
static const struct _ffebad_message_ ffebad_messages_[]
=
{
#define FFEBAD_MSG(kwd,sev,msgid) { sev, msgid },
#if FFEBAD_LONG_MSGS_ == 0
#define LONG(m)
#define SHORT(m) m
#else
#define LONG(m) m
#define SHORT(m)
#endif
#include "bad.def"
#undef FFEBAD_MSG
#undef LONG
#undef SHORT
};
static struct
{
ffewhereLine line;
ffewhereColumn col;
ffebadIndex tag;
}
ffebad_here_[FFEBAD_MAX_];
static const char *ffebad_string_[FFEBAD_MAX_];
static ffebadIndex ffebad_order_[FFEBAD_MAX_];
static ffebad ffebad_errnum_;
static ffebadSeverity ffebad_severity_;
static const char *ffebad_message_;
static unsigned char ffebad_index_;
static ffebadIndex ffebad_places_;
static bool ffebad_is_temp_inhibited_; /* Effective setting of
_is_inhibited_ for this
_start/_finish invocation. */
/* Static functions (internal). */
static int ffebad_bufputs_ (char buf[], int bufi, const char *s);
/* Internal macros. */
#define ffebad_bufflush_(buf, bufi) \
(((buf)[bufi] = '\0'), fputs ((buf), stderr), 0)
#define ffebad_bufputc_(buf, bufi, c) \
(((bufi) == ARRAY_SIZE (buf)) \
? (ffebad_bufflush_ ((buf), (bufi)), ((buf)[0] = (c)), 1) \
: (((buf)[bufi] = (c)), (bufi) + 1))
static int
ffebad_bufputs_ (char buf[], int bufi, const char *s)
{
for (; *s != '\0'; ++s)
bufi = ffebad_bufputc_ (buf, bufi, *s);
return bufi;
}
/* ffebad_init_0 -- Initialize
ffebad_init_0(); */
void
ffebad_init_0 (void)
{
assert (FFEBAD == ARRAY_SIZE (ffebad_messages_));
}
ffebadSeverity
ffebad_severity (ffebad errnum)
{
return ffebad_messages_[errnum].severity;
}
/* ffebad_start_ -- Start displaying an error message
ffebad_start(FFEBAD_SOME_ERROR_CODE);
Call ffebad_start to establish the message, ffebad_here and ffebad_string
to send run-time data to it as necessary, then ffebad_finish when through
to actually get it to print (to stderr).
Note: ffebad_start(errnum) turns into ffebad_start_(FALSE,errnum). No
outside caller should call ffebad_start_ directly (as indicated by the
trailing underscore).
Call ffebad_start to start a normal message, one that might be inhibited
by the current state of statement guessing. Call ffebad_start_lex
instead to start a message that is global to all statement guesses and
happens only once for all guesses (i.e. the lexer).
sev and message are overrides for the severity and messages when errnum
is FFEBAD, meaning the caller didn't want to have to put a message in
bad.def to produce a diagnostic. */
bool
ffebad_start_ (bool lex_override, ffebad errnum, ffebadSeverity sev,
const char *msgid)
{
unsigned char i;
if (ffebad_is_inhibited_ && !lex_override)
{
ffebad_is_temp_inhibited_ = TRUE;
return FALSE;
}
if (errnum != FFEBAD)
{
ffebad_severity_ = ffebad_messages_[errnum].severity;
ffebad_message_ = gettext (ffebad_messages_[errnum].message);
}
else
{
ffebad_severity_ = sev;
ffebad_message_ = gettext (msgid);
}
switch (ffebad_severity_)
{ /* Tell toplev.c about this message. */
case FFEBAD_severityINFORMATIONAL:
case FFEBAD_severityTRIVIAL:
if (inhibit_warnings)
{ /* User wants no warnings. */
ffebad_is_temp_inhibited_ = TRUE;
return FALSE;
}
/* Fall through. */
case FFEBAD_severityWARNING:
case FFEBAD_severityPECULIAR:
case FFEBAD_severityPEDANTIC:
if ((ffebad_severity_ != FFEBAD_severityPEDANTIC)
|| !flag_pedantic_errors)
{
if (!diagnostic_report_warnings_p ())
{ /* User wants no warnings. */
ffebad_is_temp_inhibited_ = TRUE;
return FALSE;
}
diagnostic_kind_count (global_dc, DK_WARNING)++;
break;
}
/* Fall through (PEDANTIC && flag_pedantic_errors). */
case FFEBAD_severityFATAL:
case FFEBAD_severityWEIRD:
case FFEBAD_severitySEVERE:
case FFEBAD_severityDISASTER:
diagnostic_kind_count (global_dc, DK_ERROR)++;
break;
default:
break;
}
ffebad_is_temp_inhibited_ = FALSE;
ffebad_errnum_ = errnum;
ffebad_index_ = 0;
ffebad_places_ = 0;
for (i = 0; i < FFEBAD_MAX_; ++i)
{
ffebad_string_[i] = NULL;
ffebad_here_[i].line = ffewhere_line_unknown ();
ffebad_here_[i].col = ffewhere_column_unknown ();
}
return TRUE;
}
/* ffebad_here -- Establish source location of some diagnostic concern
ffebad_here(ffebadIndex i,ffewhereLine line,ffewhereColumn col);
Call ffebad_start to establish the message, ffebad_here and ffebad_string
to send run-time data to it as necessary, then ffebad_finish when through
to actually get it to print (to stderr). */
void
ffebad_here (ffebadIndex index, ffewhereLine line, ffewhereColumn col)
{
ffewhereLineNumber line_num;
ffewhereLineNumber ln;
ffewhereColumnNumber col_num;
ffewhereColumnNumber cn;
ffebadIndex i;
ffebadIndex j;
if (ffebad_is_temp_inhibited_)
return;
assert (index < FFEBAD_MAX_);
ffebad_here_[index].line = ffewhere_line_use (line);
ffebad_here_[index].col = ffewhere_column_use (col);
if (ffewhere_line_is_unknown (line)
|| ffewhere_column_is_unknown (col))
{
ffebad_here_[index].tag = FFEBAD_MAX_;
return;
}
ffebad_here_[index].tag = 0; /* For now, though it shouldn't matter. */
/* Sort the source line/col points into the order they occur in the source
file. Deal with duplicates appropriately. */
line_num = ffewhere_line_number (line);
col_num = ffewhere_column_number (col);
/* Determine where in the ffebad_order_ array this new place should go. */
for (i = 0; i < ffebad_places_; ++i)
{
ln = ffewhere_line_number (ffebad_here_[ffebad_order_[i]].line);
cn = ffewhere_column_number (ffebad_here_[ffebad_order_[i]].col);
if (line_num < ln)
break;
if (line_num == ln)
{
if (col_num == cn)
{
ffebad_here_[index].tag = i;
return; /* Shouldn't go in, has equivalent. */
}
else if (col_num < cn)
break;
}
}
/* Before putting new place in ffebad_order_[i], first increment all tags
that are i or greater. */
if (i != ffebad_places_)
{
for (j = 0; j < FFEBAD_MAX_; ++j)
{
if (ffebad_here_[j].tag >= i)
++ffebad_here_[j].tag;
}
}
/* Then slide all ffebad_order_[] entries at and above i up one entry. */
for (j = ffebad_places_; j > i; --j)
ffebad_order_[j] = ffebad_order_[j - 1];
/* Finally can put new info in ffebad_order_[i]. */
ffebad_order_[i] = index;
ffebad_here_[index].tag = i;
++ffebad_places_;
}
/* Establish string for next index (always in order) of message
ffebad_string(const char *string);
Call ffebad_start to establish the message, ffebad_here and ffebad_string
to send run-time data to it as necessary, then ffebad_finish when through
to actually get it to print (to stderr). Note: don't trash the string
until after calling ffebad_finish, since we just maintain a pointer to
the argument passed in until then. */
void
ffebad_string (const char *string)
{
if (ffebad_is_temp_inhibited_)
return;
assert (ffebad_index_ != FFEBAD_MAX_);
ffebad_string_[ffebad_index_++] = string;
}
/* ffebad_finish -- Display error message with where & run-time info
ffebad_finish();
Call ffebad_start to establish the message, ffebad_here and ffebad_string
to send run-time data to it as necessary, then ffebad_finish when through
to actually get it to print (to stderr). */
void
ffebad_finish (void)
{
#define MAX_SPACES 132
static const char *const spaces
= "...>\
\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
\040\040\040"; /* MAX_SPACES - 1 spaces. */
ffewhereLineNumber last_line_num;
ffewhereLineNumber ln;
ffewhereLineNumber rn;
ffewhereColumnNumber last_col_num;
ffewhereColumnNumber cn;
ffewhereColumnNumber cnt;
ffewhereLine l;
ffebadIndex bi;
unsigned short i;
char pointer;
unsigned char c;
unsigned const char *s;
const char *fn;
static char buf[1024];
int bufi;
int index;
if (ffebad_is_temp_inhibited_)
return;
switch (ffebad_severity_)
{
case FFEBAD_severityINFORMATIONAL:
s = _("note:");
break;
case FFEBAD_severityWARNING:
s = _("warning:");
break;
case FFEBAD_severitySEVERE:
s = _("fatal:");
break;
default:
s = "";
break;
}
/* Display the annoying source references. */
last_line_num = 0;
last_col_num = 0;
for (bi = 0; bi < ffebad_places_; ++bi)
{
if (ffebad_places_ == 1)
pointer = '^';
else
pointer = '1' + bi;
l = ffebad_here_[ffebad_order_[bi]].line;
ln = ffewhere_line_number (l);
rn = ffewhere_line_filelinenum (l);
cn = ffewhere_column_number (ffebad_here_[ffebad_order_[bi]].col);
fn = ffewhere_line_filename (l);
if (ln != last_line_num)
{
if (bi != 0)
fputc ('\n', stderr);
diagnostic_report_current_function (global_dc);
fprintf (stderr,
/* the trailing space on the <file>:<line>: line
fools emacs19 compilation mode into finding the
report */
"%s:%" ffewhereLineNumber_f "u: %s\n %s\n %s%c",
fn, rn,
s,
ffewhere_line_content (l),
&spaces[cn > MAX_SPACES ? 0 : MAX_SPACES - cn + 4],
pointer);
last_line_num = ln;
last_col_num = cn;
s = _("(continued):");
}
else
{
cnt = cn - last_col_num;
fprintf (stderr,
"%s%c", &spaces[cnt > MAX_SPACES
? 0 : MAX_SPACES - cnt + 4],
pointer);
last_col_num = cn;
}
}
if (ffebad_places_ == 0)
{
/* Didn't output "warning:" string, capitalize it for message. */
if (s[0] != '\0')
{
char c;
c = TOUPPER (s[0]);
fprintf (stderr, "%c%s ", c, &s[1]);
}
else if (s[0] != '\0')
fprintf (stderr, "%s ", s);
}
else
fputc ('\n', stderr);
/* Release the ffewhere info. */
for (bi = 0; bi < FFEBAD_MAX_; ++bi)
{
ffewhere_line_kill (ffebad_here_[bi].line);
ffewhere_column_kill (ffebad_here_[bi].col);
}
/* Now display the message. */
bufi = 0;
for (i = 0; (c = ffebad_message_[i]) != '\0'; ++i)
{
if (c == '%')
{
c = ffebad_message_[++i];
if (ISUPPER (c))
{
index = c - 'A';
if ((index < 0) || (index >= FFEBAD_MAX_))
{
bufi = ffebad_bufputs_ (buf, bufi, _("[REPORT BUG!!] %"));
bufi = ffebad_bufputc_ (buf, bufi, c);
}
else
{
s = ffebad_string_[index];
if (s == NULL)
bufi = ffebad_bufputs_ (buf, bufi, _("[REPORT BUG!!]"));
else
bufi = ffebad_bufputs_ (buf, bufi, s);
}
}
else if (ISDIGIT (c))
{
index = c - '0';
if ((index < 0) || (index >= FFEBAD_MAX_))
{
bufi = ffebad_bufputs_ (buf, bufi, _("[REPORT BUG!!] %"));
bufi = ffebad_bufputc_ (buf, bufi, c);
}
else
{
pointer = ffebad_here_[index].tag + '1';
if (pointer == FFEBAD_MAX_ + '1')
pointer = '?';
else if (ffebad_places_ == 1)
pointer = '^';
bufi = ffebad_bufputc_ (buf, bufi, '(');
bufi = ffebad_bufputc_ (buf, bufi, pointer);
bufi = ffebad_bufputc_ (buf, bufi, ')');
}
}
else if (c == '\0')
break;
else if (c == '%')
bufi = ffebad_bufputc_ (buf, bufi, '%');
else
{
bufi = ffebad_bufputs_ (buf, bufi, _("[REPORT BUG!!]"));
bufi = ffebad_bufputc_ (buf, bufi, '%');
bufi = ffebad_bufputc_ (buf, bufi, c);
}
}
else
bufi = ffebad_bufputc_ (buf, bufi, c);
}
bufi = ffebad_bufputc_ (buf, bufi, '\n');
bufi = ffebad_bufflush_ (buf, bufi);
}

1103
gcc/f/bad.def
View file

File diff suppressed because it is too large Load diff

106
gcc/f/bad.h
View file

@ -1,106 +0,0 @@
/* bad.h -- Public #include File (module.h template V1.0)
Copyright (C) 1995, 2002 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Owning Modules:
bad.c
Modifications:
*/
/* Allow multiple inclusion to work. */
#ifndef GCC_F_BAD_H
#define GCC_F_BAD_H
/* Simple definitions and enumerations. */
typedef enum
{
#define FFEBAD_MSG(KWD,SEV,MSG) KWD,
#include "bad.def"
#undef FFEBAD_MSG
FFEBAD
} ffebad;
typedef enum
{
/* Order important; must be increasing severity. */
FFEBAD_severityINFORMATIONAL, /* User notice. */
FFEBAD_severityTRIVIAL, /* Internal notice. */
FFEBAD_severityWARNING, /* User warning. */
FFEBAD_severityPECULIAR, /* Internal warning. */
FFEBAD_severityPEDANTIC, /* Pedantic, could be warning or error. */
FFEBAD_severityFATAL, /* User error. */
FFEBAD_severityWEIRD, /* Internal error. */
FFEBAD_severitySEVERE, /* User error, cannot continue. */
FFEBAD_severityDISASTER, /* Internal error, cannot continue. */
FFEBAD_severity
} ffebadSeverity;
/* Typedefs. */
typedef unsigned char ffebadIndex;
/* Include files needed by this one. */
#include "where.h"
/* Structure definitions. */
/* Global objects accessed by users of this module. */
extern bool ffebad_is_inhibited_;
/* Declare functions with prototypes. */
void ffebad_finish (void);
void ffebad_here (ffebadIndex i, ffewhereLine wl, ffewhereColumn wc);
void ffebad_init_0 (void);
bool ffebad_is_fatal (ffebad errnum);
ffebadSeverity ffebad_severity (ffebad errnum);
bool ffebad_start_ (bool lex_override, ffebad errnum, ffebadSeverity sev,
const char *msgid);
void ffebad_string (const char *string);
/* Define macros. */
#define ffebad_inhibit() (ffebad_is_inhibited_)
#define ffebad_init_1()
#define ffebad_init_2()
#define ffebad_init_3()
#define ffebad_init_4()
#define ffebad_set_inhibit(f) (ffebad_is_inhibited_ = (f))
#define ffebad_start(e) ffebad_start_ (FALSE, (e), FFEBAD_severity, NULL)
#define ffebad_start_lex(e) ffebad_start_ (TRUE, (e), FFEBAD_severity, NULL)
#define ffebad_start_msg(msgid,s) ffebad_start_ (FALSE, FFEBAD, (s), (msgid))
#define ffebad_start_msg_lex(msgid,s) ffebad_start_ (TRUE, FFEBAD, (s), (msgid))
#define ffebad_terminate_0()
#define ffebad_terminate_1()
#define ffebad_terminate_2()
#define ffebad_terminate_3()
#define ffebad_terminate_4()
/* End of #include file. */
#endif /* ! GCC_F_BAD_H */

200
gcc/f/bit.c
View file

@ -1,200 +0,0 @@
/* bit.c -- Implementation File (module.c template V1.0)
Copyright (C) 1995 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Related Modules:
None
Description:
Tracks arrays of booleans in useful ways.
Modifications:
*/
/* Include files. */
#include "proj.h"
#include "bit.h"
#include "malloc.h"
/* Externals defined here. */
/* Simple definitions and enumerations. */
/* Internal typedefs. */
/* Private include files. */
/* Internal structure definitions. */
/* Static objects accessed by functions in this module. */
/* Static functions (internal). */
/* Internal macros. */
/* ffebit_count -- Count # of bits set a particular way
ffebit b; // the ffebit object
ffebitCount offset; // 0..size-1
bool value; // FALSE (0), TRUE (1)
ffebitCount range; // # bits to test
ffebitCount number; // # bits equal to value
ffebit_count(b,offset,value,range,&number);
Sets <number> to # bits at <offset> through <offset + range - 1> set to
<value>. If <range> is 0, <number> is set to 0. */
void
ffebit_count (ffebit b, ffebitCount offset, bool value, ffebitCount range,
ffebitCount *number)
{
ffebitCount element;
ffebitCount bitno;
assert (offset + range <= b->size);
for (*number = 0; range != 0; --range, ++offset)
{
element = offset / CHAR_BIT;
bitno = offset % CHAR_BIT;
if (value
== ((b->bits[element] & ((unsigned char) 1 << bitno)) == 0 ? FALSE : TRUE))
++ * number;
}
}
/* ffebit_new -- Create a new ffebit object
ffebit b;
ffebit_kill(b);
Destroys an ffebit object obtained via ffebit_new. */
void
ffebit_kill (ffebit b)
{
malloc_kill_ks (b->pool, b,
offsetof (struct _ffebit_, bits)
+ (b->size + CHAR_BIT - 1) / CHAR_BIT);
}
/* ffebit_new -- Create a new ffebit object
ffebit b;
mallocPool pool;
ffebitCount size;
b = ffebit_new(pool,size);
Allocates an ffebit object that holds the values of <size> bits in pool
<pool>. */
ffebit
ffebit_new (mallocPool pool, ffebitCount size)
{
ffebit b;
b = malloc_new_zks (pool, "ffebit",
offsetof (struct _ffebit_, bits)
+ (size + CHAR_BIT - 1) / CHAR_BIT,
0);
b->pool = pool;
b->size = size;
return b;
}
/* ffebit_set -- Set value of # of bits
ffebit b; // the ffebit object
ffebitCount offset; // 0..size-1
bool value; // FALSE (0), TRUE (1)
ffebitCount length; // # bits to set starting at offset (usually 1)
ffebit_set(b,offset,value,length);
Sets bit #s <offset> through <offset + length - 1> to <value>. */
void
ffebit_set (ffebit b, ffebitCount offset, bool value, ffebitCount length)
{
ffebitCount i;
ffebitCount element;
ffebitCount bitno;
assert (offset + length <= b->size);
for (i = 0; i < length; ++i, ++offset)
{
element = offset / CHAR_BIT;
bitno = offset % CHAR_BIT;
b->bits[element] = (((unsigned char) (value ? 1 : 0)) << bitno)
| (b->bits[element] & ~((unsigned char) 1 << bitno));
}
}
/* ffebit_test -- Test value of # of bits
ffebit b; // the ffebit object
ffebitCount offset; // 0..size-1
bool value; // FALSE (0), TRUE (1)
ffebitCount length; // # bits with same value
ffebit_test(b,offset,&value,&length);
Returns value of bits at <offset> through <offset + length - 1> in
<value>. If <offset> is already at the end of the bit array (if
offset == ffebit_size(b)), <length> is set to 0 and <value> is
undefined. */
void
ffebit_test (ffebit b, ffebitCount offset, bool *value, ffebitCount *length)
{
ffebitCount i;
ffebitCount element;
ffebitCount bitno;
if (offset >= b->size)
{
assert (offset == b->size);
*length = 0;
return;
}
element = offset / CHAR_BIT;
bitno = offset % CHAR_BIT;
*value = (b->bits[element] & ((unsigned char) 1 << bitno)) == 0 ? FALSE : TRUE;
*length = 1;
for (i = b->size - offset - 1, ++offset; i != 0; --i, ++offset, ++*length)
{
element = offset / CHAR_BIT;
bitno = offset % CHAR_BIT;
if (*value
!= ((b->bits[element] & ((unsigned char) 1 << bitno)) == 0 ? FALSE : TRUE))
break;
}
}

84
gcc/f/bit.h
View file

@ -1,84 +0,0 @@
/* bit.h -- Public #include File (module.h template V1.0)
Copyright (C) 1995 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Owning Modules:
bit.c
Modifications:
*/
/* Allow multiple inclusion to work. */
#ifndef GCC_F_BIT_H
#define GCC_F_BIT_H
/* Simple definitions and enumerations. */
/* Typedefs. */
typedef struct _ffebit_ *ffebit;
typedef unsigned long ffebitCount;
#define ffebitCount_f "l"
/* Include files needed by this one. */
#include "malloc.h"
/* Structure definitions. */
struct _ffebit_
{
mallocPool pool;
ffebitCount size;
unsigned char bits[1];
};
/* Global objects accessed by users of this module. */
/* Declare functions with prototypes. */
void ffebit_count (ffebit b, ffebitCount offset, bool value, ffebitCount range,
ffebitCount *number);
void ffebit_kill (ffebit b);
ffebit ffebit_new (mallocPool pool, ffebitCount size);
void ffebit_set (ffebit b, ffebitCount offset, bool value, ffebitCount length);
void ffebit_test (ffebit b, ffebitCount offset, bool *value, ffebitCount *length);
/* Define macros. */
#define ffebit_init_0()
#define ffebit_init_1()
#define ffebit_init_2()
#define ffebit_init_3()
#define ffebit_init_4()
#define ffebit_pool(b) ((b)->pool)
#define ffebit_size(b) ((b)->size)
#define ffebit_terminate_0()
#define ffebit_terminate_1()
#define ffebit_terminate_2()
#define ffebit_terminate_3()
#define ffebit_terminate_4()
/* End of #include file. */
#endif /* ! GCC_F_BIT_H */

69
gcc/f/bld-op.def
View file

@ -1,69 +0,0 @@
/* bld-op.def -- Public #include File (module.h template V1.0)
Copyright (C) 1995 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Owning Modules:
bad.c
Modifications:
*/
FFEBLD_OP (FFEBLD_opANY, "ANY", 0)
FFEBLD_OP (FFEBLD_opSTAR, "STAR", 0) /* For adjustable arrays, alternate return dummies, etc. */
FFEBLD_OP (FFEBLD_opCONTER, "CONTER", 0)
FFEBLD_OP (FFEBLD_opARRTER, "ARRTER", 0) /* Array of constants (DATA...). */
FFEBLD_OP (FFEBLD_opACCTER, "ACCTER", 0) /* Accreting ARRTER. */
FFEBLD_OP (FFEBLD_opSYMTER, "SYMTER", 0)
FFEBLD_OP (FFEBLD_opITEM, "ITEM", 0)
FFEBLD_OP (FFEBLD_opUPLUS, "UPLUS", 1)
FFEBLD_OP (FFEBLD_opUMINUS, "UMINUS", 1)
FFEBLD_OP (FFEBLD_opADD, "ADD", 2)
FFEBLD_OP (FFEBLD_opSUBTRACT, "SUBTRACT", 2)
FFEBLD_OP (FFEBLD_opMULTIPLY, "MULTIPLY", 2)
FFEBLD_OP (FFEBLD_opDIVIDE, "DIVIDE", 2)
FFEBLD_OP (FFEBLD_opPOWER, "POWER", 2)
FFEBLD_OP (FFEBLD_opCONCATENATE, "CONCATENATE", 2)
FFEBLD_OP (FFEBLD_opNOT, "NOT", 1)
FFEBLD_OP (FFEBLD_opLT, "LT", 2)
FFEBLD_OP (FFEBLD_opLE, "LE", 2)
FFEBLD_OP (FFEBLD_opEQ, "EQ", 2)
FFEBLD_OP (FFEBLD_opNE, "NE", 2)
FFEBLD_OP (FFEBLD_opGT, "GT", 2)
FFEBLD_OP (FFEBLD_opGE, "GE", 2)
FFEBLD_OP (FFEBLD_opAND, "AND", 2)
FFEBLD_OP (FFEBLD_opOR, "OR", 2)
FFEBLD_OP (FFEBLD_opXOR, "XOR", 2)
FFEBLD_OP (FFEBLD_opEQV, "EQV", 2)
FFEBLD_OP (FFEBLD_opNEQV, "NEQV", 2)
FFEBLD_OP (FFEBLD_opPAREN, "PAREN", 1)
FFEBLD_OP (FFEBLD_opPERCENT_LOC, "%LOC", 1)
FFEBLD_OP (FFEBLD_opPERCENT_VAL, "%VAL", 1)
FFEBLD_OP (FFEBLD_opPERCENT_REF, "%REF", 1)
FFEBLD_OP (FFEBLD_opPERCENT_DESCR, "%DESCR", 1)
FFEBLD_OP (FFEBLD_opCONVERT, "CONVERT", 1)
FFEBLD_OP (FFEBLD_opREPEAT, "REPEAT", 2)
FFEBLD_OP (FFEBLD_opBOUNDS, "BOUNDS", 2) /* For low:high in dimension lists. */
FFEBLD_OP (FFEBLD_opFUNCREF, "FUNCREF", 2)
FFEBLD_OP (FFEBLD_opSUBRREF, "SUBRREF", 2)
FFEBLD_OP (FFEBLD_opARRAYREF, "ARRAYREF", 2)
FFEBLD_OP (FFEBLD_opSUBSTR, "SUBSTR", 2)
FFEBLD_OP (FFEBLD_opLABTER, "LABTER", 0)
FFEBLD_OP (FFEBLD_opLABTOK, "LABTOK", 0) /* Like LABTER but contains ffelexToken instead. */
FFEBLD_OP (FFEBLD_opIMPDO, "IMPDO", 2)

2809
gcc/f/bld.c
View file

File diff suppressed because it is too large Load diff

748
gcc/f/bld.h
View file

@ -1,748 +0,0 @@
/* bld.h -- Public #include File (module.h template V1.0)
Copyright (C) 1995, 1996, 2003 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Owning Modules:
bld.c
Modifications:
*/
/* Allow multiple inclusion to work. */
#ifndef GCC_F_BLD_H
#define GCC_F_BLD_H
/* Simple definitions and enumerations. */
typedef enum
{
FFEBLD_constNONE,
FFEBLD_constINTEGER1,
FFEBLD_constINTEGER2,
FFEBLD_constINTEGER3,
FFEBLD_constINTEGER4,
FFEBLD_constINTEGER5,
FFEBLD_constINTEGER6,
FFEBLD_constINTEGER7,
FFEBLD_constINTEGER8,
FFEBLD_constLOGICAL1,
FFEBLD_constLOGICAL2,
FFEBLD_constLOGICAL3,
FFEBLD_constLOGICAL4,
FFEBLD_constLOGICAL5,
FFEBLD_constLOGICAL6,
FFEBLD_constLOGICAL7,
FFEBLD_constLOGICAL8,
FFEBLD_constREAL1,
FFEBLD_constREAL2,
FFEBLD_constREAL3,
FFEBLD_constREAL4,
FFEBLD_constREAL5,
FFEBLD_constREAL6,
FFEBLD_constREAL7,
FFEBLD_constREAL8,
FFEBLD_constCOMPLEX1,
FFEBLD_constCOMPLEX2,
FFEBLD_constCOMPLEX3,
FFEBLD_constCOMPLEX4,
FFEBLD_constCOMPLEX5,
FFEBLD_constCOMPLEX6,
FFEBLD_constCOMPLEX7,
FFEBLD_constCOMPLEX8,
FFEBLD_constCHARACTER1,
FFEBLD_constCHARACTER2,
FFEBLD_constCHARACTER3,
FFEBLD_constCHARACTER4,
FFEBLD_constCHARACTER5,
FFEBLD_constCHARACTER6,
FFEBLD_constCHARACTER7,
FFEBLD_constCHARACTER8,
FFEBLD_constHOLLERITH,
FFEBLD_constTYPELESS_FIRST,
FFEBLD_constBINARY_MIL = FFEBLD_constTYPELESS_FIRST,
FFEBLD_constBINARY_VXT,
FFEBLD_constOCTAL_MIL,
FFEBLD_constOCTAL_VXT,
FFEBLD_constHEX_X_MIL,
FFEBLD_constHEX_X_VXT,
FFEBLD_constHEX_Z_MIL,
FFEBLD_constHEX_Z_VXT,
FFEBLD_constTYPELESS_LAST = FFEBLD_constHEX_Z_VXT,
FFEBLD_const
} ffebldConst;
typedef enum
{
#define FFEBLD_OP(KWD,NAME,ARITY) KWD,
#include "bld-op.def"
#undef FFEBLD_OP
FFEBLD_op
} ffebldOp;
/* Typedefs. */
typedef struct _ffebld_ *ffebld;
typedef unsigned char ffebldArity;
typedef union _ffebld_constant_array_ ffebldConstantArray;
typedef struct _ffebld_constant_ *ffebldConstant;
typedef union _ffebld_constant_union_ ffebldConstantUnion;
typedef ffebld *ffebldListBottom;
typedef unsigned int ffebldListLength;
#define ffebldListLength_f ""
typedef struct _ffebld_pool_stack_ *ffebldPoolstack_;
/* Include files needed by this one. */
#include "bit.h"
#include "com.h"
#include "info.h"
#include "intrin.h"
#include "lab.h"
#include "lex.h"
#include "malloc.h"
#include "symbol.h"
#include "target.h"
#define FFEBLD_whereconstPROGUNIT_ 1
#define FFEBLD_whereconstFILE_ 2
#define FFEBLD_whereconstCURRENT_ FFEBLD_whereconstFILE_
/* Structure definitions. */
#define FFEBLD_constINTEGERDEFAULT FFEBLD_constINTEGER1
#define FFEBLD_constLOGICALDEFAULT FFEBLD_constLOGICAL1
#define FFEBLD_constREALDEFAULT FFEBLD_constREAL1
#define FFEBLD_constREALDOUBLE FFEBLD_constREAL2
#define FFEBLD_constREALQUAD FFEBLD_constREAL3
#define FFEBLD_constCOMPLEX FFEBLD_constCOMPLEX1
#define FFEBLD_constCOMPLEXDOUBLE FFEBLD_constCOMPLEX2
#define FFEBLD_constCOMPLEXQUAD FFEBLD_constCOMPLEX3
#define FFEBLD_constCHARACTERDEFAULT FFEBLD_constCHARACTER1
union _ffebld_constant_union_
{
ffetargetTypeless typeless;
ffetargetHollerith hollerith;
#if FFETARGET_okINTEGER1
ffetargetInteger1 integer1;
#endif
#if FFETARGET_okINTEGER2
ffetargetInteger2 integer2;
#endif
#if FFETARGET_okINTEGER3
ffetargetInteger3 integer3;
#endif
#if FFETARGET_okINTEGER4
ffetargetInteger4 integer4;
#endif
#if FFETARGET_okLOGICAL1
ffetargetLogical1 logical1;
#endif
#if FFETARGET_okLOGICAL2
ffetargetLogical2 logical2;
#endif
#if FFETARGET_okLOGICAL3
ffetargetLogical3 logical3;
#endif
#if FFETARGET_okLOGICAL4
ffetargetLogical4 logical4;
#endif
#if FFETARGET_okREAL1
ffetargetReal1 real1;
#endif
#if FFETARGET_okREAL2
ffetargetReal2 real2;
#endif
#if FFETARGET_okREAL3
ffetargetReal3 real3;
#endif
#if FFETARGET_okCOMPLEX1
ffetargetComplex1 complex1;
#endif
#if FFETARGET_okCOMPLEX2
ffetargetComplex2 complex2;
#endif
#if FFETARGET_okCOMPLEX3
ffetargetComplex3 complex3;
#endif
#if FFETARGET_okCHARACTER1
ffetargetCharacter1 character1;
#endif
};
union _ffebld_constant_array_
{
#if FFETARGET_okINTEGER1
ffetargetInteger1 *integer1;
#endif
#if FFETARGET_okINTEGER2
ffetargetInteger2 *integer2;
#endif
#if FFETARGET_okINTEGER3
ffetargetInteger3 *integer3;
#endif
#if FFETARGET_okINTEGER4
ffetargetInteger4 *integer4;
#endif
#if FFETARGET_okLOGICAL1
ffetargetLogical1 *logical1;
#endif
#if FFETARGET_okLOGICAL2
ffetargetLogical2 *logical2;
#endif
#if FFETARGET_okLOGICAL3
ffetargetLogical3 *logical3;
#endif
#if FFETARGET_okLOGICAL4
ffetargetLogical4 *logical4;
#endif
#if FFETARGET_okREAL1
ffetargetReal1 *real1;
#endif
#if FFETARGET_okREAL2
ffetargetReal2 *real2;
#endif
#if FFETARGET_okREAL3
ffetargetReal3 *real3;
#endif
#if FFETARGET_okCOMPLEX1
ffetargetComplex1 *complex1;
#endif
#if FFETARGET_okCOMPLEX2
ffetargetComplex2 *complex2;
#endif
#if FFETARGET_okCOMPLEX3
ffetargetComplex3 *complex3;
#endif
#if FFETARGET_okCHARACTER1
ffetargetCharacterUnit1 *character1;
#endif
};
struct _ffebld_
{
ffebldOp op;
ffeinfo info; /* Not used or valid for
op=={STAR,ITEM,BOUNDS,REPEAT,LABTER,
LABTOK,IMPDO}. */
union
{
struct
{
ffebld left;
ffebld right;
ffecomNonter hook; /* Whatever the compiler/backend wants! */
}
nonter;
struct
{
ffebld head;
ffebld trail;
}
item;
struct
{
ffebldConstant expr;
ffebld orig; /* Original expression, or NULL if none. */
ffetargetAlign pad; /* Initial padding (for DATA, etc.). */
}
conter;
struct
{
ffebldConstantArray array;
ffetargetOffset size;
ffetargetAlign pad; /* Initial padding (for DATA, etc.). */
}
arrter;
struct
{
ffebldConstantArray array;
ffebit bits;
ffetargetAlign pad; /* Initial padding (for DATA, etc.). */
}
accter;
struct
{
ffesymbol symbol;
ffeintrinGen generic; /* Id for generic intrinsic. */
ffeintrinSpec specific; /* Id for specific intrinsic. */
ffeintrinImp implementation; /* Id for implementation. */
bool do_iter; /* TRUE if this ref is a read-only ref by
definition (ref within DO loop using this
var as iterator). */
}
symter;
ffelab labter;
ffelexToken labtok;
}
u;
};
struct _ffebld_constant_
{
ffebldConstant next;
ffebldConstant first_complex; /* First complex const with me as
real. */
ffebldConstant negated; /* We point to each other through here. */
ffebldConst consttype;
ffecomConstant hook; /* Whatever the compiler/backend wants! */
bool numeric; /* A numeric kind of constant. */
ffebldConstantUnion u;
};
struct _ffebld_pool_stack_
{
ffebldPoolstack_ next;
mallocPool pool;
};
/* Global objects accessed by users of this module. */
extern const ffebldArity ffebld_arity_op_[(int) FFEBLD_op];
extern struct _ffebld_pool_stack_ ffebld_pool_stack_;
/* Declare functions with prototypes. */
int ffebld_constant_cmp (ffebldConstant c1, ffebldConstant c2);
bool ffebld_constant_is_magical (ffebldConstant c);
bool ffebld_constant_is_zero (ffebldConstant c);
#if FFETARGET_okCHARACTER1
ffebldConstant ffebld_constant_new_character1 (ffelexToken t);
ffebldConstant ffebld_constant_new_character1_val (ffetargetCharacter1 val);
#endif
#if FFETARGET_okCOMPLEX1
ffebldConstant ffebld_constant_new_complex1 (ffebldConstant real,
ffebldConstant imaginary);
ffebldConstant ffebld_constant_new_complex1_val (ffetargetComplex1 val);
#endif
#if FFETARGET_okCOMPLEX2
ffebldConstant ffebld_constant_new_complex2 (ffebldConstant real,
ffebldConstant imaginary);
ffebldConstant ffebld_constant_new_complex2_val (ffetargetComplex2 val);
#endif
#if FFETARGET_okCOMPLEX3
ffebldConstant ffebld_constant_new_complex3 (ffebldConstant real,
ffebldConstant imaginary);
ffebldConstant ffebld_constant_new_complex3_val (ffetargetComplex3 val);
#endif
ffebldConstant ffebld_constant_new_hollerith (ffelexToken t);
ffebldConstant ffebld_constant_new_hollerith_val (ffetargetHollerith val);
#if FFETARGET_okINTEGER1
ffebldConstant ffebld_constant_new_integer1 (ffelexToken t);
ffebldConstant ffebld_constant_new_integer1_val (ffetargetInteger1 val);
#endif
#if FFETARGET_okINTEGER2
ffebldConstant ffebld_constant_new_integer2 (ffelexToken t);
ffebldConstant ffebld_constant_new_integer2_val (ffetargetInteger2 val);
#endif
#if FFETARGET_okINTEGER3
ffebldConstant ffebld_constant_new_integer3 (ffelexToken t);
ffebldConstant ffebld_constant_new_integer3_val (ffetargetInteger3 val);
#endif
#if FFETARGET_okINTEGER4
ffebldConstant ffebld_constant_new_integer4 (ffelexToken t);
ffebldConstant ffebld_constant_new_integer4_val (ffetargetInteger4 val);
#endif
ffebldConstant ffebld_constant_new_integerbinary (ffelexToken t);
ffebldConstant ffebld_constant_new_integerhex (ffelexToken t);
ffebldConstant ffebld_constant_new_integeroctal (ffelexToken t);
#if FFETARGET_okLOGICAL1
ffebldConstant ffebld_constant_new_logical1 (bool truth);
ffebldConstant ffebld_constant_new_logical1_val (ffetargetLogical1 val);
#endif
#if FFETARGET_okLOGICAL2
ffebldConstant ffebld_constant_new_logical2 (bool truth);
ffebldConstant ffebld_constant_new_logical2_val (ffetargetLogical2 val);
#endif
#if FFETARGET_okLOGICAL3
ffebldConstant ffebld_constant_new_logical3 (bool truth);
ffebldConstant ffebld_constant_new_logical3_val (ffetargetLogical3 val);
#endif
#if FFETARGET_okLOGICAL4
ffebldConstant ffebld_constant_new_logical4 (bool truth);
ffebldConstant ffebld_constant_new_logical4_val (ffetargetLogical4 val);
#endif
#if FFETARGET_okREAL1
ffebldConstant ffebld_constant_new_real1 (ffelexToken integer,
ffelexToken decimal, ffelexToken fraction, ffelexToken exponent,
ffelexToken exponent_sign, ffelexToken exponent_digits);
ffebldConstant ffebld_constant_new_real1_val (ffetargetReal1 val);
#endif
#if FFETARGET_okREAL2
ffebldConstant ffebld_constant_new_real2 (ffelexToken integer,
ffelexToken decimal, ffelexToken fraction, ffelexToken exponent,
ffelexToken exponent_sign, ffelexToken exponent_digits);
ffebldConstant ffebld_constant_new_real2_val (ffetargetReal2 val);
#endif
#if FFETARGET_okREAL3
ffebldConstant ffebld_constant_new_real3 (ffelexToken integer,
ffelexToken decimal, ffelexToken fraction, ffelexToken exponent,
ffelexToken exponent_sign, ffelexToken exponent_digits);
ffebldConstant ffebld_constant_new_real3_val (ffetargetReal3 val);
#endif
ffebldConstant ffebld_constant_new_typeless_bm (ffelexToken t);
ffebldConstant ffebld_constant_new_typeless_bv (ffelexToken t);
ffebldConstant ffebld_constant_new_typeless_hxm (ffelexToken t);
ffebldConstant ffebld_constant_new_typeless_hxv (ffelexToken t);
ffebldConstant ffebld_constant_new_typeless_hzm (ffelexToken t);
ffebldConstant ffebld_constant_new_typeless_hzv (ffelexToken t);
ffebldConstant ffebld_constant_new_typeless_om (ffelexToken t);
ffebldConstant ffebld_constant_new_typeless_ov (ffelexToken t);
ffebldConstant ffebld_constant_new_typeless_val (ffebldConst type,
ffetargetTypeless val);
ffebldConstant ffebld_constant_negated (ffebldConstant c);
ffebldConstantUnion ffebld_constantarray_get (ffebldConstantArray array,
ffeinfoBasictype bt, ffeinfoKindtype kt, ffetargetOffset offset);
void ffebld_constantarray_kill (ffebldConstantArray array, ffeinfoBasictype bt,
ffeinfoKindtype kt, ffetargetOffset size);
ffebldConstantArray ffebld_constantarray_new (ffeinfoBasictype bt,
ffeinfoKindtype kt, ffetargetOffset size);
void ffebld_constantarray_prepare (void **aptr, void **cptr, size_t *size,
ffebldConstantArray array, ffeinfoBasictype abt, ffeinfoKindtype akt,
ffetargetOffset offset, ffebldConstantUnion *constant,
ffeinfoBasictype cbt, ffeinfoKindtype ckt);
void ffebld_constantarray_preparray (void **aptr, void **cptr, size_t *size,
ffebldConstantArray array, ffeinfoBasictype abt, ffeinfoKindtype akt,
ffetargetOffset offset, ffebldConstantArray source_array,
ffeinfoBasictype cbt, ffeinfoKindtype ckt);
void ffebld_constantarray_put (ffebldConstantArray array, ffeinfoBasictype bt,
ffeinfoKindtype kt, ffetargetOffset offset, ffebldConstantUnion constant);
void ffebld_init_0 (void);
void ffebld_init_1 (void);
void ffebld_init_2 (void);
ffebldListLength ffebld_list_length (ffebld l);
ffebld ffebld_new_accter (ffebldConstantArray array, ffebit b);
ffebld ffebld_new_arrter (ffebldConstantArray array, ffetargetOffset size);
ffebld ffebld_new_conter_with_orig (ffebldConstant c, ffebld orig);
ffebld ffebld_new_item (ffebld head, ffebld trail);
ffebld ffebld_new_labter (ffelab l);
ffebld ffebld_new_labtok (ffelexToken t);
ffebld ffebld_new_none (ffebldOp o);
ffebld ffebld_new_symter (ffesymbol s, ffeintrinGen gen, ffeintrinSpec spec,
ffeintrinImp imp);
ffebld ffebld_new_one (ffebldOp o, ffebld left);
ffebld ffebld_new_two (ffebldOp o, ffebld left, ffebld right);
const char *ffebld_op_string (ffebldOp o);
void ffebld_pool_pop (void);
void ffebld_pool_push (mallocPool pool);
ffetargetCharacterSize ffebld_size_max (ffebld b);
/* Define macros. */
#define ffebld_accter(b) ((b)->u.accter.array)
#define ffebld_accter_bits(b) ((b)->u.accter.bits)
#define ffebld_accter_pad(b) ((b)->u.accter.pad)
#define ffebld_accter_set_bits(b,bt) ((b)->u.accter.bits = (bt))
#define ffebld_accter_set_pad(b,p) ((b)->u.accter.pad = (p))
#define ffebld_accter_size(b) ffebit_size((b)->u.accter.bits)
#define ffebld_append_item(b,i) (**(b) = ffebld_new_item((i),NULL), \
*(b) = &((**(b))->u.item.trail))
#define ffebld_arity(b) ffebld_arity_op(ffebld_op(b))
#define ffebld_arity_op(o) (ffebld_arity_op_[o])
#define ffebld_arrter(b) ((b)->u.arrter.array)
#define ffebld_arrter_pad(b) ((b)->u.arrter.pad)
#define ffebld_arrter_set_pad(b,p) ((b)->u.arrter.pad = (p))
#define ffebld_arrter_set_size(b,s) ((b)->u.arrter.size = (s))
#define ffebld_arrter_size(b) ((b)->u.arrter.size)
#define ffebld_basictype(b) (ffeinfo_basictype (ffebld_info ((b))))
#if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstPROGUNIT_
#define ffebld_constant_pool() ffe_pool_program_unit()
#elif FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstFILE_
#define ffebld_constant_pool() ffe_pool_file()
#else
#error
#endif
#define ffebld_constant_character1(c) ((c)->u.character1)
#define ffebld_constant_character2(c) ((c)->u.character2)
#define ffebld_constant_character3(c) ((c)->u.character3)
#define ffebld_constant_character4(c) ((c)->u.character4)
#define ffebld_constant_character5(c) ((c)->u.character5)
#define ffebld_constant_character6(c) ((c)->u.character6)
#define ffebld_constant_character7(c) ((c)->u.character7)
#define ffebld_constant_character8(c) ((c)->u.character8)
#define ffebld_constant_characterdefault ffebld_constant_character1
#define ffebld_constant_complex1(c) ((c)->u.complex1)
#define ffebld_constant_complex2(c) ((c)->u.complex2)
#define ffebld_constant_complex3(c) ((c)->u.complex3)
#define ffebld_constant_complex4(c) ((c)->u.complex4)
#define ffebld_constant_complex5(c) ((c)->u.complex5)
#define ffebld_constant_complex6(c) ((c)->u.complex6)
#define ffebld_constant_complex7(c) ((c)->u.complex7)
#define ffebld_constant_complex8(c) ((c)->u.complex8)
#define ffebld_constant_complexdefault ffebld_constant_complex1
#define ffebld_constant_complexdouble ffebld_constant_complex2
#define ffebld_constant_complexquad ffebld_constant_complex3
#define ffebld_constant_copy(c) (c)
#define ffebld_constant_hollerith(c) ((c)->u.hollerith)
#define ffebld_constant_hook(c) ((c)->hook)
#define ffebld_constant_integer1(c) ((c)->u.integer1)
#define ffebld_constant_integer2(c) ((c)->u.integer2)
#define ffebld_constant_integer3(c) ((c)->u.integer3)
#define ffebld_constant_integer4(c) ((c)->u.integer4)
#define ffebld_constant_integer5(c) ((c)->u.integer5)
#define ffebld_constant_integer6(c) ((c)->u.integer6)
#define ffebld_constant_integer7(c) ((c)->u.integer7)
#define ffebld_constant_integer8(c) ((c)->u.integer8)
#define ffebld_constant_integerdefault ffebld_constant_integer1
#define ffebld_constant_is_numeric(c) ((c)->numeric)
#define ffebld_constant_logical1(c) ((c)->u.logical1)
#define ffebld_constant_logical2(c) ((c)->u.logical2)
#define ffebld_constant_logical3(c) ((c)->u.logical3)
#define ffebld_constant_logical4(c) ((c)->u.logical4)
#define ffebld_constant_logical5(c) ((c)->u.logical5)
#define ffebld_constant_logical6(c) ((c)->u.logical6)
#define ffebld_constant_logical7(c) ((c)->u.logical7)
#define ffebld_constant_logical8(c) ((c)->u.logical8)
#define ffebld_constant_logicaldefault ffebld_constant_logical1
#define ffebld_constant_new_characterdefault ffebld_constant_new_character1
#define ffebld_constant_new_characterdefault_val ffebld_constant_new_character1_val
#define ffebld_constant_new_complexdefault ffebld_constant_new_complex1
#define ffebld_constant_new_complexdefault_val ffebld_constant_new_complex1_val
#define ffebld_constant_new_complexdouble ffebld_constant_new_complex2
#define ffebld_constant_new_complexdouble_val ffebld_constant_new_complex2_val
#define ffebld_constant_new_complexquad ffebld_constant_new_complex3
#define ffebld_constant_new_complexquad_valffebld_constant_new_complex3_val
#define ffebld_constant_new_integerdefault ffebld_constant_new_integer1
#define ffebld_constant_new_integerdefault_val ffebld_constant_new_integer1_val
#define ffebld_constant_new_logicaldefault ffebld_constant_new_logical1
#define ffebld_constant_new_logicaldefault_val ffebld_constant_new_logical1_val
#define ffebld_constant_new_realdefault ffebld_constant_new_real1
#define ffebld_constant_new_realdefault_val ffebld_constant_new_real1_val
#define ffebld_constant_new_realdouble ffebld_constant_new_real2
#define ffebld_constant_new_realdouble_val ffebld_constant_new_real2_val
#define ffebld_constant_new_realquad ffebld_constant_new_real3
#define ffebld_constant_new_realquad_val ffebld_constant_new_real3_val
#define ffebld_constant_ptr_to_union(c) (&(c)->u)
#define ffebld_constant_real1(c) ((c)->u.real1)
#define ffebld_constant_real2(c) ((c)->u.real2)
#define ffebld_constant_real3(c) ((c)->u.real3)
#define ffebld_constant_real4(c) ((c)->u.real4)
#define ffebld_constant_real5(c) ((c)->u.real5)
#define ffebld_constant_real6(c) ((c)->u.real6)
#define ffebld_constant_real7(c) ((c)->u.real7)
#define ffebld_constant_real8(c) ((c)->u.real8)
#define ffebld_constant_realdefault ffebld_constant_real1
#define ffebld_constant_realdouble ffebld_constant_real2
#define ffebld_constant_realquad ffebld_constant_real3
#define ffebld_constant_set_hook(c,h) ((c)->hook = (h))
#define ffebld_constant_set_union(c,un) ((c)->u = (un))
#define ffebld_constant_type(c) ((c)->consttype)
#define ffebld_constant_typeless(c) ((c)->u.typeless)
#define ffebld_constant_union(c) ((c)->u)
#define ffebld_conter(b) ((b)->u.conter.expr)
#define ffebld_conter_orig(b) ((b)->u.conter.orig)
#define ffebld_conter_pad(b) ((b)->u.conter.pad)
#define ffebld_conter_set_orig(b,o) ((b)->u.conter.orig = (o))
#define ffebld_conter_set_pad(b,p) ((b)->u.conter.pad = (p))
#define ffebld_copy(b) (b) /* ~~~Someday really make a copy. */
#define ffebld_cu_ptr_typeless(u) &(u).typeless
#define ffebld_cu_ptr_hollerith(u) &(u).hollerith
#define ffebld_cu_ptr_integer1(u) &(u).integer1
#define ffebld_cu_ptr_integer2(u) &(u).integer2
#define ffebld_cu_ptr_integer3(u) &(u).integer3
#define ffebld_cu_ptr_integer4(u) &(u).integer4
#define ffebld_cu_ptr_integer5(u) &(u).integer5
#define ffebld_cu_ptr_integer6(u) &(u).integer6
#define ffebld_cu_ptr_integer7(u) &(u).integer7
#define ffebld_cu_ptr_integer8(u) &(u).integer8
#define ffebld_cu_ptr_integerdefault ffebld_cu_ptr_integer1
#define ffebld_cu_ptr_logical1(u) &(u).logical1
#define ffebld_cu_ptr_logical2(u) &(u).logical2
#define ffebld_cu_ptr_logical3(u) &(u).logical3
#define ffebld_cu_ptr_logical4(u) &(u).logical4
#define ffebld_cu_ptr_logical5(u) &(u).logical5
#define ffebld_cu_ptr_logical6(u) &(u).logical6
#define ffebld_cu_ptr_logical7(u) &(u).logical7
#define ffebld_cu_ptr_logical8(u) &(u).logical8
#define ffebld_cu_ptr_logicaldefault ffebld_cu_ptr_logical1
#define ffebld_cu_ptr_real1(u) &(u).real1
#define ffebld_cu_ptr_real2(u) &(u).real2
#define ffebld_cu_ptr_real3(u) &(u).real3
#define ffebld_cu_ptr_real4(u) &(u).real4
#define ffebld_cu_ptr_real5(u) &(u).real5
#define ffebld_cu_ptr_real6(u) &(u).real6
#define ffebld_cu_ptr_real7(u) &(u).real7
#define ffebld_cu_ptr_real8(u) &(u).real8
#define ffebld_cu_ptr_realdefault ffebld_cu_ptr_real1
#define ffebld_cu_ptr_realdouble ffebld_cu_ptr_real2
#define ffebld_cu_ptr_realquad ffebld_cu_ptr_real3
#define ffebld_cu_ptr_complex1(u) &(u).complex1
#define ffebld_cu_ptr_complex2(u) &(u).complex2
#define ffebld_cu_ptr_complex3(u) &(u).complex3
#define ffebld_cu_ptr_complex4(u) &(u).complex4
#define ffebld_cu_ptr_complex5(u) &(u).complex5
#define ffebld_cu_ptr_complex6(u) &(u).complex6
#define ffebld_cu_ptr_complex7(u) &(u).complex7
#define ffebld_cu_ptr_complex8(u) &(u).complex8
#define ffebld_cu_ptr_complexdefault ffebld_cu_ptr_complex1
#define ffebld_cu_ptr_complexdouble ffebld_cu_ptr_complex2
#define ffebld_cu_ptr_complexquad ffebld_cu_ptr_complex3
#define ffebld_cu_ptr_character1(u) &(u).character1
#define ffebld_cu_ptr_character2(u) &(u).character2
#define ffebld_cu_ptr_character3(u) &(u).character3
#define ffebld_cu_ptr_character4(u) &(u).character4
#define ffebld_cu_ptr_character5(u) &(u).character5
#define ffebld_cu_ptr_character6(u) &(u).character6
#define ffebld_cu_ptr_character7(u) &(u).character7
#define ffebld_cu_ptr_character8(u) &(u).character8
#define ffebld_cu_val_typeless(u) (u).typeless
#define ffebld_cu_val_hollerith(u) (u).hollerith
#define ffebld_cu_val_integer1(u) (u).integer1
#define ffebld_cu_val_integer2(u) (u).integer2
#define ffebld_cu_val_integer3(u) (u).integer3
#define ffebld_cu_val_integer4(u) (u).integer4
#define ffebld_cu_val_integer5(u) (u).integer5
#define ffebld_cu_val_integer6(u) (u).integer6
#define ffebld_cu_val_integer7(u) (u).integer7
#define ffebld_cu_val_integer8(u) (u).integer8
#define ffebld_cu_val_integerdefault ffebld_cu_val_integer1
#define ffebld_cu_val_logical1(u) (u).logical1
#define ffebld_cu_val_logical2(u) (u).logical2
#define ffebld_cu_val_logical3(u) (u).logical3
#define ffebld_cu_val_logical4(u) (u).logical4
#define ffebld_cu_val_logical5(u) (u).logical5
#define ffebld_cu_val_logical6(u) (u).logical6
#define ffebld_cu_val_logical7(u) (u).logical7
#define ffebld_cu_val_logical8(u) (u).logical8
#define ffebld_cu_val_logicaldefault ffebld_cu_val_logical
#define ffebld_cu_val_real1(u) (u).real1
#define ffebld_cu_val_real2(u) (u).real2
#define ffebld_cu_val_real3(u) (u).real3
#define ffebld_cu_val_real4(u) (u).real4
#define ffebld_cu_val_real5(u) (u).real5
#define ffebld_cu_val_real6(u) (u).real6
#define ffebld_cu_val_real7(u) (u).real7
#define ffebld_cu_val_real8(u) (u).real8
#define ffebld_cu_val_realdefault ffebld_cu_val_real1
#define ffebld_cu_val_realdouble ffebld_cu_val_real2
#define ffebld_cu_val_realquad ffebld_cu_val_real3
#define ffebld_cu_val_complex1(u) (u).complex1
#define ffebld_cu_val_complex2(u) (u).complex2
#define ffebld_cu_val_complex3(u) (u).complex3
#define ffebld_cu_val_complex4(u) (u).complex4
#define ffebld_cu_val_complex5(u) (u).complex5
#define ffebld_cu_val_complex6(u) (u).complex6
#define ffebld_cu_val_complex7(u) (u).complex7
#define ffebld_cu_val_complex8(u) (u).complex8
#define ffebld_cu_val_complexdefault ffebld_cu_val_complex1
#define ffebld_cu_val_complexdouble ffebld_cu_val_complex2
#define ffebld_cu_val_complexquad ffebld_cu_val_complex3
#define ffebld_cu_val_character1(u) (u).character1
#define ffebld_cu_val_character2(u) (u).character2
#define ffebld_cu_val_character3(u) (u).character3
#define ffebld_cu_val_character4(u) (u).character4
#define ffebld_cu_val_character5(u) (u).character5
#define ffebld_cu_val_character6(u) (u).character6
#define ffebld_cu_val_character7(u) (u).character7
#define ffebld_cu_val_character8(u) (u).character8
#define ffebld_end_list(b) (*(b) = NULL)
#define ffebld_head(b) ((b)->u.item.head)
#define ffebld_info(b) ((b)->info)
#define ffebld_init_3()
#define ffebld_init_4()
#define ffebld_init_list(l,b) (*(l) = NULL, *(b) = (l))
#define ffebld_item_hook(b) ((b)->u.item.hook)
#define ffebld_item_set_hook(b,h) ((b)->u.item.hook = (h))
#define ffebld_kind(b) (ffeinfo_kind (ffebld_info ((b))))
#define ffebld_kindtype(b) (ffeinfo_kindtype (ffebld_info ((b))))
#define ffebld_labter(b) ((b)->u.labter)
#define ffebld_labtok(b) ((b)->u.labtok)
#define ffebld_left(b) ((b)->u.nonter.left)
#define ffebld_name_string(n) ((n)->name)
#define ffebld_new() \
((ffebld) malloc_new_kp(ffebld_pool(), "FFEBLD",sizeof(struct _ffebld_)))
#define ffebld_new_any() ffebld_new_none(FFEBLD_opANY)
#define ffebld_new_conter(c) ffebld_new_conter_with_orig((c),NULL)
#define ffebld_new_star() ffebld_new_none(FFEBLD_opSTAR)
#define ffebld_new_uplus(l) ffebld_new_one(FFEBLD_opUPLUS,(l))
#define ffebld_new_uminus(l) ffebld_new_one(FFEBLD_opUMINUS,(l))
#define ffebld_new_add(l,r) ffebld_new_two(FFEBLD_opADD,(l),(r))
#define ffebld_new_subtract(l,r) ffebld_new_two(FFEBLD_opSUBTRACT,(l),(r))
#define ffebld_new_multiply(l,r) ffebld_new_two(FFEBLD_opMULTIPLY,(l),(r))
#define ffebld_new_divide(l,r) ffebld_new_two(FFEBLD_opDIVIDE,(l),(r))
#define ffebld_new_power(l,r) ffebld_new_two(FFEBLD_opPOWER,(l),(r))
#define ffebld_new_bounds(l,r) ffebld_new_two(FFEBLD_opBOUNDS,(l),(r))
#define ffebld_new_concatenate(l,r) ffebld_new_two(FFEBLD_opCONCATENATE,(l),(r))
#define ffebld_new_not(l) ffebld_new_one(FFEBLD_opNOT,(l))
#define ffebld_new_lt(l,r) ffebld_new_two(FFEBLD_opLT,(l),(r))
#define ffebld_new_le(l,r) ffebld_new_two(FFEBLD_opLE,(l),(r))
#define ffebld_new_eq(l,r) ffebld_new_two(FFEBLD_opEQ,(l),(r))
#define ffebld_new_ne(l,r) ffebld_new_two(FFEBLD_opNE,(l),(r))
#define ffebld_new_gt(l,r) ffebld_new_two(FFEBLD_opGT,(l),(r))
#define ffebld_new_ge(l,r) ffebld_new_two(FFEBLD_opGE,(l),(r))
#define ffebld_new_and(l,r) ffebld_new_two(FFEBLD_opAND,(l),(r))
#define ffebld_new_or(l,r) ffebld_new_two(FFEBLD_opOR,(l),(r))
#define ffebld_new_xor(l,r) ffebld_new_two(FFEBLD_opXOR,(l),(r))
#define ffebld_new_eqv(l,r) ffebld_new_two(FFEBLD_opEQV,(l),(r))
#define ffebld_new_neqv(l,r) ffebld_new_two(FFEBLD_opNEQV,(l),(r))
#define ffebld_new_paren(l) ffebld_new_one(FFEBLD_opPAREN,(l))
#define ffebld_new_repeat(l,r) ffebld_new_two(FFEBLD_opREPEAT,(l),(r))
#define ffebld_new_percent_descr(l) ffebld_new_one(FFEBLD_opPERCENT_DESCR,(l))
#define ffebld_new_percent_loc(l) ffebld_new_one(FFEBLD_opPERCENT_LOC,(l))
#define ffebld_new_percent_ref(l) ffebld_new_one(FFEBLD_opPERCENT_REF,(l))
#define ffebld_new_percent_val(l) ffebld_new_one(FFEBLD_opPERCENT_VAL,(l))
#define ffebld_new_complex(l,r) ffebld_new_two(FFEBLD_opCOMPLEX,(l),(r))
#define ffebld_new_convert(l) ffebld_new_one(FFEBLD_opCONVERT,(l))
#define ffebld_new_funcref(l,r) ffebld_new_two(FFEBLD_opFUNCREF,(l),(r))
#define ffebld_new_subrref(l,r) ffebld_new_two(FFEBLD_opSUBRREF,(l),(r))
#define ffebld_new_arrayref(l,r) ffebld_new_two(FFEBLD_opARRAYREF,(l),(r))
#define ffebld_new_substr(l,r) ffebld_new_two(FFEBLD_opSUBSTR,(l),(r))
#define ffebld_new_impdo(l,r) ffebld_new_two(FFEBLD_opIMPDO,(l),(r))
#define ffebld_nonter_hook(b) ((b)->u.nonter.hook)
#define ffebld_nonter_set_hook(b,h) ((b)->u.nonter.hook = (h))
#define ffebld_op(b) ((b)->op)
#define ffebld_pool() (ffebld_pool_stack_.pool)
#define ffebld_rank(b) (ffeinfo_rank (ffebld_info ((b))))
#define ffebld_right(b) ((b)->u.nonter.right)
#define ffebld_set_accter(b,a) ((b)->u.accter.array = (a))
#define ffebld_set_arrter(b,a) ((b)->u.arrter.array = (a))
#define ffebld_set_conter(b,c) ((b)->u.conter.expr = (c))
#define ffebld_set_info(b,i) ((b)->info = (i))
#define ffebld_set_labter(b,l) ((b)->u.labter = (l))
#define ffebld_set_op(b,o) ((b)->op = (o))
#define ffebld_set_head(b,h) ((b)->u.item.head = (h))
#define ffebld_set_left(b,l) ((b)->u.nonter.left = (l))
#define ffebld_set_right(b,r) ((b)->u.nonter.right = (r))
#define ffebld_set_trail(b,t) ((b)->u.item.trail = (t))
#define ffebld_size(b) (ffeinfo_size (ffebld_info ((b))))
#define ffebld_size_known(b) ffebld_size((b))
#define ffebld_symter(b) ((b)->u.symter.symbol)
#define ffebld_symter_generic(b) ((b)->u.symter.generic)
#define ffebld_symter_doiter(b) ((b)->u.symter.do_iter)
#define ffebld_symter_implementation(b) ((b)->u.symter.implementation)
#define ffebld_symter_specific(b) ((b)->u.symter.specific)
#define ffebld_symter_set_generic(b,g) ((b)->u.symter.generic = (g))
#define ffebld_symter_set_implementation(b,i) \
((b)->u.symter.implementation = (i))
#define ffebld_symter_set_is_doiter(b,f) ((b)->u.symter.do_iter = (f))
#define ffebld_symter_set_specific(b,s) ((b)->u.symter.specific = (s))
#define ffebld_terminate_0()
#define ffebld_terminate_1()
#define ffebld_terminate_2()
#define ffebld_terminate_3()
#define ffebld_terminate_4()
#define ffebld_trail(b) ((b)->u.item.trail)
#define ffebld_where(b) (ffeinfo_where (ffebld_info ((b))))
/* End of #include file. */
#endif /* ! GCC_F_BLD_H */

267
gcc/f/bugs.texi
View file

@ -1,267 +0,0 @@
@c Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
@c This is part of the G77 manual.
@c For copying conditions, see the file g77.texi.
@c The text of this file appears in the file BUGS
@c in the G77 distribution, as well as in the G77 manual.
@c Keep this the same as the dates above, since it's used
@c in the standalone derivations of this file (e.g. BUGS).
@set copyrights-bugs 1995,1996,1997,1998,1999,2000,2001,2002
@set last-update-bugs 2002-02-01
@ifset DOC-BUGS
@include root.texi
@c The immediately following lines apply to the BUGS file
@c which is derived from this file.
@emph{Note:} This file is automatically generated from the files
@file{bugs0.texi} and @file{bugs.texi}.
@file{BUGS} is @emph{not} a source file,
although it is normally included within source distributions.
This file lists known bugs in the @value{which-g77} version
of the GNU Fortran compiler.
Copyright (C) @value{copyrights-bugs} Free Software Foundation, Inc.
You may copy, distribute, and modify it freely as long as you preserve
this copyright notice and permission notice.
@node Top,,, (dir)
@chapter Known Bugs In GNU Fortran
@end ifset
@ifset DOC-G77
@node Known Bugs
@section Known Bugs In GNU Fortran
@end ifset
This section identifies bugs that @code{g77} @emph{users}
might run into in the @value{which-g77} version
of @code{g77}.
This includes bugs that are actually in the @code{gcc}
back end (GBE) or in @code{libf2c}, because those
sets of code are at least somewhat under the control
of (and necessarily intertwined with) @code{g77},
so it isn't worth separating them out.
@ifset DOC-G77
For information on bugs in @emph{other} versions of @code{g77},
see @ref{News,,News About GNU Fortran}.
There, lists of bugs fixed in various versions of @code{g77}
can help determine what bugs existed in prior versions.
@end ifset
@ifset DOC-BUGS
For information on bugs in @emph{other} versions of @code{g77},
see @file{@value{path-g77}/NEWS}.
There, lists of bugs fixed in various versions of @code{g77}
can help determine what bugs existed in prior versions.
@end ifset
@ifset DEVELOPMENT
@emph{Warning:} The information below is still under development,
and might not accurately reflect the @code{g77} code base
of which it is a part.
Efforts are made to keep it somewhat up-to-date,
but they are particularly concentrated
on any version of this information
that is distributed as part of a @emph{released} @code{g77}.
In particular, while this information is intended to apply to
the @value{which-g77} version of @code{g77},
only an official @emph{release} of that version
is expected to contain documentation that is
most consistent with the @code{g77} product in that version.
@end ifset
An online, ``live'' version of this document
(derived directly from the mainline, development version
of @code{g77} within @code{gcc})
is available via
@uref{http://gcc.gnu.org/onlinedocs/g77/Trouble.html}.
Follow the ``Known Bugs'' link.
The following information was last updated on @value{last-update-bugs}:
@itemize @bullet
@item
@code{g77} fails to warn about
use of a ``live'' iterative-DO variable
as an implied-DO variable
in a @code{WRITE} or @code{PRINT} statement
(although it does warn about this in a @code{READ} statement).
@item
Something about @code{g77}'s straightforward handling of
label references and definitions sometimes prevents the GBE
from unrolling loops.
Until this is solved, try inserting or removing @code{CONTINUE}
statements as the terminal statement, using the @code{END DO}
form instead, and so on.
@item
Some confusion in diagnostics concerning failing @code{INCLUDE}
statements from within @code{INCLUDE}'d or @code{#include}'d files.
@cindex integer constants
@cindex constants, integer
@item
@code{g77} assumes that @code{INTEGER(KIND=1)} constants range
from @samp{-2**31} to @samp{2**31-1} (the range for
two's-complement 32-bit values),
instead of determining their range from the actual range of the
type for the configuration (and, someday, for the constant).
Further, it generally doesn't implement the handling
of constants very well in that it makes assumptions about the
configuration that it no longer makes regarding variables (types).
Included with this item is the fact that @code{g77} doesn't recognize
that, on IEEE-754/854-compliant systems, @samp{0./0.} should produce a NaN
and no warning instead of the value @samp{0.} and a warning.
@cindex compiler speed
@cindex speed, of compiler
@cindex compiler memory usage
@cindex memory usage, of compiler
@cindex large aggregate areas
@cindex initialization, bug
@cindex DATA statement
@cindex statements, DATA
@item
@code{g77} uses way too much memory and CPU time to process large aggregate
areas having any initialized elements.
For example, @samp{REAL A(1000000)} followed by @samp{DATA A(1)/1/}
takes up way too much time and space, including
the size of the generated assembler file.
Version 0.5.18 improves cases like this---specifically,
cases of @emph{sparse} initialization that leave large, contiguous
areas uninitialized---significantly.
However, even with the improvements, these cases still
require too much memory and CPU time.
(Version 0.5.18 also improves cases where the initial values are
zero to a much greater degree, so if the above example
ends with @samp{DATA A(1)/0/}, the compile-time performance
will be about as good as it will ever get, aside from unrelated
improvements to the compiler.)
Note that @code{g77} does display a warning message to
notify the user before the compiler appears to hang.
@ifset DOC-G77
A warning message is issued when @code{g77} sees code that provides
initial values (e.g. via @code{DATA}) to an aggregate area (@code{COMMON}
or @code{EQUIVALENCE}, or even a large enough array or @code{CHARACTER}
variable)
that is large enough to increase @code{g77}'s compile time by roughly
a factor of 10.
This size currently is quite small, since @code{g77}
currently has a known bug requiring too much memory
and time to handle such cases.
In @file{@value{path-g77}/data.c}, the macro
@code{FFEDATA_sizeTOO_BIG_INIT_} is defined
to the minimum size for the warning to appear.
The size is specified in storage units,
which can be bytes, words, or whatever, on a case-by-case basis.
After changing this macro definition, you must
(of course) rebuild and reinstall @code{g77} for
the change to take effect.
Note that, as of version 0.5.18, improvements have
reduced the scope of the problem for @emph{sparse}
initialization of large arrays, especially those
with large, contiguous uninitialized areas.
However, the warning is issued at a point prior to
when @code{g77} knows whether the initialization is sparse,
and delaying the warning could mean it is produced
too late to be helpful.
Therefore, the macro definition should not be adjusted to
reflect sparse cases.
Instead, adjust it to generate the warning when densely
initialized arrays begin to cause responses noticeably slower
than linear performance would suggest.
@end ifset
@cindex code, displaying main source
@cindex displaying main source code
@cindex debugging main source code
@cindex printing main source
@item
When debugging, after starting up the debugger but before being able
to see the source code for the main program unit, the user must currently
set a breakpoint at @code{MAIN__} (or @code{MAIN___} or @code{MAIN_} if
@code{MAIN__} doesn't exist)
and run the program until it hits the breakpoint.
At that point, the
main program unit is activated and about to execute its first
executable statement, but that's the state in which the debugger should
start up, as is the case for languages like C.
@cindex debugger
@item
Debugging @code{g77}-compiled code using debuggers other than
@code{gdb} is likely not to work.
Getting @code{g77} and @code{gdb} to work together is a known
problem---getting @code{g77} to work properly with other
debuggers, for which source code often is unavailable to @code{g77}
developers, seems like a much larger, unknown problem,
and is a lower priority than making @code{g77} and @code{gdb}
work together properly.
On the other hand, information about problems other debuggers
have with @code{g77} output might make it easier to properly
fix @code{g77}, and perhaps even improve @code{gdb}, so it
is definitely welcome.
Such information might even lead to all relevant products
working together properly sooner.
@cindex Alpha, support
@cindex support, Alpha
@item
@code{g77} doesn't work perfectly on 64-bit configurations
such as the Digital Semiconductor (``DEC'') Alpha.
This problem is largely resolved as of version 0.5.23.
@cindex padding
@cindex structures
@cindex common blocks
@cindex equivalence areas
@item
@code{g77} currently inserts needless padding for things like
@samp{COMMON A,IPAD} where @samp{A} is @code{CHARACTER*1} and @samp{IPAD}
is @code{INTEGER(KIND=1)} on machines like x86,
because the back end insists that @samp{IPAD}
be aligned to a 4-byte boundary,
but the processor has no such requirement
(though it is usually good for performance).
The @code{gcc} back end needs to provide a wider array
of specifications of alignment requirements and preferences for targets,
and front ends like @code{g77} should take advantage of this
when it becomes available.
@cindex complex performance
@cindex aliasing
@item
The @code{libf2c} routines that perform some run-time
arithmetic on @code{COMPLEX} operands
were modified circa version 0.5.20 of @code{g77}
to work properly even in the presence of aliased operands.
While the @code{g77} and @code{netlib} versions of @code{libf2c}
differ on how this is accomplished,
the main differences are that we believe
the @code{g77} version works properly
even in the presence of @emph{partially} aliased operands.
However, these modifications have reduced performance
on targets such as x86,
due to the extra copies of operands involved.
@end itemize

9
gcc/f/bugs0.texi
View file

@ -1,9 +0,0 @@
\input texinfo @c -*-texinfo-*-
@c %**start of header
@setfilename BUGS
@c %**end of header
@c This tells bugs.texi that it's generating just the BUGS file.
@set DOC-BUGS
@include bugs.texi
@bye

289
gcc/f/com-rt.def
View file

@ -1,289 +0,0 @@
/* com-rt.def -- Public #include File (module.h template V1.0)
Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Owning Modules:
com.c
Modifications:
*/
/* DEFGFRT(CODE,NAME,TYPE,VOLATILE,COMPLEX,CONST):
CODE -- the #define name to use to refer to the function in g77 code
NAME -- the name as seen by the back end and, with whatever massaging
is normal, the linker
TYPE -- a code for the tree for the type, assigned when first encountered
(NOTE: There's a distinction made between the semantic return
value for the function, and the actual return mechanism; e.g.
`r_abs()' computes a single-precision `float' return value
but returns it as a `double'. This distinction is important
and is flagged via the _F2C_ versus _GNU_ suffix.)
ARGS -- a string of codes representing the types of the arguments; the
last type specifies the type for that and all following args,
and the null pointer (0) means the same as "0":
0 Not applicable at and beyond this point
& Pointer to type that follows
a char
c complex
d doublereal
e doublecomplex
f real
i integer
j longint
VOLATILE -- TRUE if the function never returns (gen's emit_barrier in
g77 back end)
COMPLEX -- TRUE if the return value is COMPLEX or DOUBLE COMPLEX and
thus might need to be returned as ptr-to-1st-arg
CONST -- TRUE if the function is const
(does not have side effects and only depends on its arguments).
*/
DEFGFRT (FFECOM_gfrtCAT, "s_cat", FFECOM_rttypeVOID_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtCMP, "s_cmp", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtCOPY, "s_copy", FFECOM_rttypeVOID_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtPAUSE, "s_paus", FFECOM_rttypeVOID_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSTOP, "s_stop", FFECOM_rttypeVOID_, 0, TRUE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtRANGE, "s_rnge", FFECOM_rttypeINTEGER_, 0, TRUE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSRDUE, "s_rdue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtERDUE, "e_rdue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSRSUE, "s_rsue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtERSUE, "e_rsue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSRDFE, "s_rdfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtERDFE, "e_rdfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSRSFI, "s_rsfi", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtERSFI, "e_rsfi", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSRSFE, "s_rsfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtERSFE, "e_rsfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSRSLI, "s_rsli", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtERSLI, "e_rsli", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSRSLE, "s_rsle", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtERSLE, "e_rsle", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSRSNE, "s_rsne", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSWDUE, "s_wdue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtEWDUE, "e_wdue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSWSUE, "s_wsue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtEWSUE, "e_wsue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSWDFE, "s_wdfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtEWDFE, "e_wdfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSWSFI, "s_wsfi", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtEWSFI, "e_wsfi", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSWSFE, "s_wsfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtEWSFE, "e_wsfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSWSLI, "s_wsli", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtEWSLI, "e_wsli", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSWSLE, "s_wsle", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtEWSLE, "e_wsle", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSWSNE, "s_wsne", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDOFIO, "do_fio", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDOLIO, "do_lio", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDOUIO, "do_uio", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtFOPEN, "f_open", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtFCLOS, "f_clos", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtFINQU, "f_inqu", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtFBACK, "f_back", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtFEND, "f_end", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtFREW, "f_rew", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtABORT, "G77_abort_0", FFECOM_rttypeVOID_, 0, TRUE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtABS, "r_abs", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtACCESS, "G77_access_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtACOS, "r_acos", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtAIMAG, "r_imag", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtAINT, "r_int", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtALARM, "G77_alarm_0", FFECOM_rttypeINTEGER_, "&i0", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtALOG, "r_log", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtALOG10, "r_lg10", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtAMOD, "r_mod", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtANINT, "r_nint", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtASIN, "r_asin", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtATAN, "r_atan", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtATAN2, "r_atn2", FFECOM_rttypeREAL_F2C_, "&f&f", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtCABS, "c_abs", FFECOM_rttypeREAL_F2C_, "&c", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtCCOS, "c_cos", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE, FALSE)
DEFGFRT (FFECOM_gfrtCEXP, "c_exp", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE, FALSE)
DEFGFRT (FFECOM_gfrtCHDIR, "G77_chdir_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtCLOG, "c_log", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE, FALSE)
DEFGFRT (FFECOM_gfrtCHMOD, "G77_chmod_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtCONJG, "r_cnjg", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE, FALSE)
DEFGFRT (FFECOM_gfrtCOS, "r_cos", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtCOSH, "r_cosh", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtCSIN, "c_sin", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE, FALSE)
DEFGFRT (FFECOM_gfrtCSQRT, "c_sqrt", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE, FALSE)
DEFGFRT (FFECOM_gfrtCTIME, "G77_ctime_0", FFECOM_rttypeCHARACTER_, "&j", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDABS, "d_abs", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDACOS, "d_acos", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDASIN, "d_asin", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDATAN, "d_atan", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDATAN2, "d_atn2", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDATE, "G77_date_y2kbug_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDATE_AND_TIME, "G77_date_and_time_0", FFECOM_rttypeVOID_, "&a&a&a&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtL_BESJ0, "j0", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
DEFGFRT (FFECOM_gfrtL_BESJ1, "j1", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
DEFGFRT (FFECOM_gfrtL_BESJN, "jn", FFECOM_rttypeDOUBLE_, "id", FALSE, FALSE, TRUE)
DEFGFRT (FFECOM_gfrtL_BESY0, "y0", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
DEFGFRT (FFECOM_gfrtL_BESY1, "y1", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
DEFGFRT (FFECOM_gfrtL_BESYN, "yn", FFECOM_rttypeDOUBLE_, "id", FALSE, FALSE, TRUE)
DEFGFRT (FFECOM_gfrtDCOS, "d_cos", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDCOSH, "d_cosh", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDDIM, "d_dim", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDERF, "G77_derf_0", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDERFC, "G77_derfc_0", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDEXP, "d_exp", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDIM, "r_dim", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDINT, "d_int", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDLOG, "d_log", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDLOG10, "d_lg10", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDMOD, "d_mod", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDNINT, "d_nint", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDPROD, "d_prod", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDSIGN, "d_sign", FFECOM_rttypeDOUBLE_, "&d&d", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDSIN, "d_sin", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDSINH, "d_sinh", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDSQRT, "d_sqrt", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDTAN, "d_tan", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDTANH, "d_tanh", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtDTIME, "G77_dtime_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtERF, "G77_erf_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtERFC, "G77_erfc_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtETIME, "G77_etime_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtEXIT, "G77_exit_0", FFECOM_rttypeVOID_, "&i", TRUE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtEXP, "r_exp", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtFDATE, "G77_fdate_0", FFECOM_rttypeCHARACTER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtFGET, "G77_fget_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtFGETC, "G77_fgetc_0", FFECOM_rttypeINTEGER_, "&i&a", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtFLUSH, "G77_flush_0", FFECOM_rttypeVOID_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtFLUSH1, "G77_flush1_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtFNUM, "G77_fnum_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtFPUT, "G77_fput_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtFPUTC, "G77_fputc_0", FFECOM_rttypeINTEGER_, "&i&a", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtFSTAT, "G77_fstat_0", FFECOM_rttypeINTEGER_, "&i&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtFTELL, "G77_ftell_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtFSEEK, "G77_fseek_0", FFECOM_rttypeINTEGER_, "&i&i&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtGERROR, "G77_gerror_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtGETARG, "G77_getarg_0", FFECOM_rttypeVOID_, "&i&a", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtGETCWD, "G77_getcwd_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtGETGID, "G77_getgid_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtGETLOG, "G77_getlog_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtGETPID, "G77_getpid_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtGETUID, "G77_getuid_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtGETENV, "G77_getenv_0", FFECOM_rttypeVOID_, "&a&a", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtGMTIME, "G77_gmtime_0", FFECOM_rttypeVOID_, "&i&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtHOSTNM, "G77_hostnm_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtIABS, "i_abs", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtIARGC, "G77_iargc_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtIDATE, "G77_idate_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtIDIM, "i_dim", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtIDNINT, "i_dnnt", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtIERRNO, "G77_ierrno_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtINDEX, "i_indx", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtIRAND, "G77_irand_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtISIGN, "i_sign", FFECOM_rttypeINTEGER_, "&i&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtISATTY, "G77_isatty_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtITIME, "G77_itime_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtKILL, "G77_kill_0", FFECOM_rttypeINTEGER_, "&i&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtLEN, "i_len", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE, TRUE)
DEFGFRT (FFECOM_gfrtLGE, "l_ge", FFECOM_rttypeLOGICAL_, "&a", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtLGT, "l_gt", FFECOM_rttypeLOGICAL_, "&a", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtLINK, "G77_link_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtLLE, "l_le", FFECOM_rttypeLOGICAL_, "&a", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtLLT, "l_lt", FFECOM_rttypeLOGICAL_, "&a", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtLNBLNK, "G77_lnblnk_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtLSTAT, "G77_lstat_0", FFECOM_rttypeINTEGER_, "&a&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtLTIME, "G77_ltime_0", FFECOM_rttypeVOID_, "&i&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtMCLOCK, "G77_mclock_0", FFECOM_rttypeLONGINT_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtMOD, "i_mod", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtNINT, "i_nint", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtPERROR, "G77_perror_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtRAND, "G77_rand_0", FFECOM_rttypeREAL_F2C_, "&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtRENAME, "G77_rename_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSECNDS, "G77_secnds_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSECOND, "G77_second_0", FFECOM_rttypeREAL_F2C_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSIGN, "r_sign", FFECOM_rttypeREAL_F2C_, "&f&f", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtL_SIGNAL, "G77_signal_0", FFECOM_rttypeVOIDSTAR_, "&i0", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSIN, "r_sin", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSINH, "r_sinh", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSLEEP, "G77_sleep_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSQRT, "r_sqrt", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSRAND, "G77_srand_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSTAT, "G77_stat_0", FFECOM_rttypeINTEGER_, "&a&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSYMLNK, "G77_symlnk_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSYSTEM, "G77_system_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtSYSTEM_CLOCK, "G77_system_clock_0", FFECOM_rttypeVOID_, "&i&i&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtTAN, "r_tan", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtTANH, "r_tanh", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtTIME, "G77_time_0", FFECOM_rttypeLONGINT_, 0, FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtTTYNAM, "G77_ttynam_0", FFECOM_rttypeCHARACTER_, "&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtUNLINK, "G77_unlink_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtUMASK, "G77_umask_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtVXTIDATE, "G77_vxtidate_y2kbug_0", FFECOM_rttypeVOID_, "&i&i&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtVXTTIME, "G77_vxttime_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtCDABS, "z_abs", FFECOM_rttypeDOUBLE_, "&e", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtCDCOS, "z_cos", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE, FALSE)
DEFGFRT (FFECOM_gfrtCDEXP, "z_exp", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE, FALSE)
DEFGFRT (FFECOM_gfrtCDLOG, "z_log", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE, FALSE)
DEFGFRT (FFECOM_gfrtDCONJG, "d_cnjg", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE, FALSE)
DEFGFRT (FFECOM_gfrtCDSIN, "z_sin", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE, FALSE)
DEFGFRT (FFECOM_gfrtCDSQRT, "z_sqrt", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE, FALSE)
DEFGFRT (FFECOM_gfrtDIMAG, "d_imag", FFECOM_rttypeDOUBLE_, "&e", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtL_ACOS, "acos", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
DEFGFRT (FFECOM_gfrtL_ASIN, "asin", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
DEFGFRT (FFECOM_gfrtL_ATAN, "__builtin_atan", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
DEFGFRT (FFECOM_gfrtL_ATAN2, "__builtin_atan2", FFECOM_rttypeDOUBLE_, "dd", FALSE, FALSE, TRUE)
DEFGFRT (FFECOM_gfrtL_COS, "__builtin_cos", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
DEFGFRT (FFECOM_gfrtL_COSH, "cosh", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
DEFGFRT (FFECOM_gfrtL_ERF, "erf", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
DEFGFRT (FFECOM_gfrtL_ERFC, "erfc", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
DEFGFRT (FFECOM_gfrtL_EXP, "__builtin_exp", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
DEFGFRT (FFECOM_gfrtL_FLOOR, "__builtin_floor", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
DEFGFRT (FFECOM_gfrtL_FMOD, "__builtin_fmod", FFECOM_rttypeDOUBLE_, "dd", FALSE, FALSE, TRUE)
DEFGFRT (FFECOM_gfrtL_LOG, "__builtin_log", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
DEFGFRT (FFECOM_gfrtL_LOG10, "log10", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
DEFGFRT (FFECOM_gfrtL_POW, "__builtin_pow", FFECOM_rttypeDOUBLE_, "dd", FALSE, FALSE, TRUE)
DEFGFRT (FFECOM_gfrtL_SIN, "__builtin_sin", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
DEFGFRT (FFECOM_gfrtL_SINH, "sinh", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
DEFGFRT (FFECOM_gfrtL_SQRT, "__builtin_sqrt", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
DEFGFRT (FFECOM_gfrtL_TAN, "__builtin_tan", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
DEFGFRT (FFECOM_gfrtL_TANH, "tanh", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
DEFGFRT (FFECOM_gfrtPOW_CI, "pow_ci", FFECOM_rttypeCOMPLEX_F2C_, "&c&i", FALSE, TRUE, FALSE)
DEFGFRT (FFECOM_gfrtPOW_DD, "pow_dd", FFECOM_rttypeDOUBLE_, "&d&d", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtPOW_DI, "pow_di", FFECOM_rttypeDOUBLE_, "&d&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtPOW_II, "pow_ii", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtPOW_QQ, "pow_qq", FFECOM_rttypeLONGINT_, "&j&j", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtPOW_RI, "pow_ri", FFECOM_rttypeREAL_F2C_, "&f&i", FALSE, FALSE, FALSE)
DEFGFRT (FFECOM_gfrtPOW_ZI, "pow_zi", FFECOM_rttypeDBLCMPLX_F2C_, "&e&i", FALSE, TRUE, FALSE)
DEFGFRT (FFECOM_gfrtPOW_ZZ, "pow_zz", FFECOM_rttypeDBLCMPLX_F2C_, "&e&e", FALSE, TRUE, FALSE)
DEFGFRT (FFECOM_gfrtDIV_CC, "c_div", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE, FALSE)
DEFGFRT (FFECOM_gfrtDIV_ZZ, "z_div", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE, FALSE)

16532
gcc/f/com.c
View file

File diff suppressed because it is too large Load diff

290
gcc/f/com.h
View file

@ -1,290 +0,0 @@
/* com.h -- Public #include File (module.h template V1.0)
Copyright (C) 1995, 1996, 1997, 2000, 2003, 2004
Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Owning Modules:
com.c
Modifications:
*/
/* Allow multiple inclusion to work. */
#ifndef GCC_F_COM_H
#define GCC_F_COM_H
/* Simple definitions and enumerations. */
#define FFECOM_dimensionsMAX 7 /* Max # dimensions (quick hack). */
#define FFECOM_SIZE_UNIT "byte" /* Singular form. */
#define FFECOM_SIZE_UNITS "bytes" /* Plural form. */
#define FFECOM_constantNULL NULL_TREE
#define FFECOM_nonterNULL NULL_TREE
#define FFECOM_globalNULL NULL_TREE
#define FFECOM_labelNULL NULL_TREE
#define FFECOM_storageNULL NULL_TREE
#define FFECOM_symbolNULL ffecom_symbol_null_
/* Shorthand for types used in f2c.h and that g77 perhaps allows some
flexibility regarding in the section below. I.e. the actual numbers
below aren't important, as long as they're unique. */
#define FFECOM_f2ccodeCHAR 1
#define FFECOM_f2ccodeSHORT 2
#define FFECOM_f2ccodeINT 3
#define FFECOM_f2ccodeLONG 4
#define FFECOM_f2ccodeLONGLONG 5
#define FFECOM_f2ccodeCHARPTR 6 /* char * */
#define FFECOM_f2ccodeFLOAT 7
#define FFECOM_f2ccodeDOUBLE 8
#define FFECOM_f2ccodeLONGDOUBLE 9
#define FFECOM_f2ccodeTWOREALS 10
#define FFECOM_f2ccodeTWODOUBLEREALS 11
#if FFECOM_DETERMINE_TYPES /* only for com.c and configure */
/* Begin f2c.h information. This must match the info in the f2c.h used
to build the libf2c with which g77-generated code is linked, or there
will probably be bugs, some of them difficult to detect or even trigger. */
/* The C front-end provides __g77_integer and __g77_uinteger types so that
the appropriately-sized signed and unsigned integer types are available
for libf2c. If you change this, also the definitions of those types
in ../c-decl.c. */
#define FFECOM_f2cINTEGER \
(LONG_TYPE_SIZE == FLOAT_TYPE_SIZE \
? FFECOM_f2ccodeLONG \
: (INT_TYPE_SIZE == FLOAT_TYPE_SIZE \
? FFECOM_f2ccodeINT \
: (abort (), -1)))
#define FFECOM_f2cLOGICAL FFECOM_f2cINTEGER
/* The C front-end provides __g77_longint and __g77_ulongint types so that
the appropriately-sized signed and unsigned integer types are available
for libf2c. If you change this, also the definitions of those types
in ../c-decl.c. */
#define FFECOM_f2cLONGINT \
(LONG_TYPE_SIZE == (FLOAT_TYPE_SIZE * 2) \
? FFECOM_f2ccodeLONG \
: (LONG_LONG_TYPE_SIZE == (FLOAT_TYPE_SIZE * 2) \
? FFECOM_f2ccodeLONGLONG \
: (abort (), -1)))
#define FFECOM_f2cADDRESS FFECOM_f2ccodeCHARPTR
#define FFECOM_f2cSHORTINT FFECOM_f2ccodeSHORT
#define FFECOM_f2cREAL FFECOM_f2ccodeFLOAT
#define FFECOM_f2cDOUBLEREAL FFECOM_f2ccodeDOUBLE
#define FFECOM_f2cCOMPLEX FFECOM_f2ccodeTWOREALS
#define FFECOM_f2cDOUBLECOMPLEX FFECOM_f2ccodeTWODOUBLEREALS
#define FFECOM_f2cSHORTLOGICAL FFECOM_f2ccodeSHORT
#define FFECOM_f2cLOGICAL1 FFECOM_f2ccodeCHAR
#define FFECOM_f2cINTEGER1 FFECOM_f2ccodeCHAR
/* These must be f2c's INTEGER type, to match runtime/f2c.h.in. */
#define FFECOM_f2cFLAG FFECOM_f2cINTEGER
#define FFECOM_f2cFTNINT FFECOM_f2cINTEGER
#define FFECOM_f2cFTNLEN FFECOM_f2cINTEGER
#endif /* #if FFECOM_DETERMINE_TYPES */
/* Everything else in f2c.h, specifically the structures used in
interfacing compiled code with the library, must remain exactly
as delivered, or g77 internals (mostly com.c and ste.c) must
be modified accordingly to compensate. Or there will be...trouble. */
typedef enum
{
#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX,CONST) CODE,
#include "com-rt.def"
#undef DEFGFRT
FFECOM_gfrt
} ffecomGfrt;
/* Typedefs. */
#ifndef TREE_CODE
#include "tree.h"
#endif
typedef tree ffecomConstant;
typedef tree ffecomNonter;
typedef tree ffecomLabel;
typedef tree ffecomGlobal;
typedef tree ffecomStorage;
typedef struct _ffecom_symbol_ ffecomSymbol;
struct _ffecom_symbol_
{
tree decl_tree;
tree length_tree; /* For CHARACTER dummies. */
tree vardesc_tree; /* For NAMELIST. */
tree assign_tree; /* For ASSIGN'ed vars. */
bool addr; /* Is address of item instead of item. */
};
/* Include files needed by this one. */
#include "bld.h"
#include "info.h"
#include "lab.h"
#include "storag.h"
#include "symbol.h"
extern int global_bindings_p (void);
extern tree getdecls (void);
extern void pushlevel (int);
extern tree poplevel (int,int, int);
extern void insert_block (tree);
extern void set_block (tree);
extern tree pushdecl (tree);
/* Global objects accessed by users of this module. */
extern GTY(()) tree string_type_node;
extern GTY(()) tree ffecom_integer_type_node;
extern GTY(()) tree ffecom_integer_zero_node;
extern GTY(()) tree ffecom_integer_one_node;
extern GTY(()) tree ffecom_tree_type[FFEINFO_basictype][FFEINFO_kindtype];
extern ffecomSymbol ffecom_symbol_null_;
extern ffeinfoKindtype ffecom_pointer_kind_;
extern ffeinfoKindtype ffecom_label_kind_;
extern int ffecom_f2c_typecode_[FFEINFO_basictype][FFEINFO_kindtype];
extern GTY(()) tree ffecom_f2c_integer_type_node;
extern GTY(()) tree ffecom_f2c_address_type_node;
extern GTY(()) tree ffecom_f2c_real_type_node;
extern GTY(()) tree ffecom_f2c_doublereal_type_node;
extern GTY(()) tree ffecom_f2c_complex_type_node;
extern GTY(()) tree ffecom_f2c_doublecomplex_type_node;
extern GTY(()) tree ffecom_f2c_longint_type_node;
extern GTY(()) tree ffecom_f2c_logical_type_node;
extern GTY(()) tree ffecom_f2c_flag_type_node;
extern GTY(()) tree ffecom_f2c_ftnlen_type_node;
extern GTY(()) tree ffecom_f2c_ftnlen_zero_node;
extern GTY(()) tree ffecom_f2c_ftnlen_one_node;
extern GTY(()) tree ffecom_f2c_ftnlen_two_node;
extern GTY(()) tree ffecom_f2c_ptr_to_ftnlen_type_node;
extern GTY(()) tree ffecom_f2c_ftnint_type_node;
extern GTY(()) tree ffecom_f2c_ptr_to_ftnint_type_node;
/* Declare functions with prototypes. */
tree ffecom_1 (enum tree_code code, tree type, tree node);
tree ffecom_1_fn (tree node);
tree ffecom_2 (enum tree_code code, tree type, tree node1, tree node2);
bool ffecom_2pass_advise_entrypoint (ffesymbol entry);
void ffecom_2pass_do_entrypoint (ffesymbol entry);
tree ffecom_2s (enum tree_code code, tree type, tree node1, tree node2);
tree ffecom_3 (enum tree_code code, tree type, tree node1, tree node2,
tree node3);
tree ffecom_3s (enum tree_code code, tree type, tree node1, tree node2,
tree node3);
tree ffecom_arg_expr (ffebld expr, tree *length);
tree ffecom_arg_ptr_to_const_expr (ffebld expr, tree *length);
tree ffecom_arg_ptr_to_expr (ffebld expr, tree *length);
tree ffecom_call_gfrt (ffecomGfrt ix, tree args, tree hook);
tree ffecom_constantunion_with_type (ffebldConstantUnion *cu,
tree tree_type,ffebldConst ct);
tree ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt,
ffeinfoKindtype kt, tree tree_type);
tree ffecom_const_expr (ffebld expr);
tree ffecom_decl_field (tree context, tree prevfield, const char *name,
tree type);
void ffecom_close_include (FILE *f);
void ffecom_decode_include_option (const char *dir);
tree ffecom_end_compstmt (void);
void ffecom_end_transition (void);
void ffecom_exec_transition (void);
void ffecom_expand_let_stmt (ffebld dest, ffebld source);
tree ffecom_expr (ffebld expr);
tree ffecom_expr_assign (ffebld expr);
tree ffecom_expr_assign_w (ffebld expr);
tree ffecom_expr_rw (tree type, ffebld expr);
tree ffecom_expr_w (tree type, ffebld expr);
void ffecom_finish_compile (void);
void ffecom_finish_decl (tree decl, tree init, bool is_top_level);
void ffecom_finish_progunit (void);
tree ffecom_get_invented_identifier (const char *pattern, ...)
ATTRIBUTE_PRINTF_1;
ffeinfoBasictype ffecom_gfrt_basictype (ffecomGfrt ix);
ffeinfoKindtype ffecom_gfrt_kindtype (ffecomGfrt ix);
void ffecom_init_0 (void);
void ffecom_init_2 (void);
tree ffecom_list_expr (ffebld list);
tree ffecom_list_ptr_to_expr (ffebld list);
tree ffecom_lookup_label (ffelab label);
tree ffecom_make_tempvar (const char *commentary, tree type,
ffetargetCharacterSize size, int elements);
tree ffecom_modify (tree newtype, tree lhs, tree rhs);
void ffecom_save_tree_forever (tree t);
void ffecom_file (const char *name);
void ffecom_notify_init_storage (ffestorag st);
void ffecom_notify_init_symbol (ffesymbol s);
void ffecom_notify_primary_entry (ffesymbol fn);
FILE *ffecom_open_include (char *name, ffewhereLine l, ffewhereColumn c);
void ffecom_prepare_arg_ptr_to_expr (ffebld expr);
bool ffecom_prepare_end (void);
void ffecom_prepare_expr_ (ffebld expr, ffebld dest);
void ffecom_prepare_expr_rw (tree type, ffebld expr);
void ffecom_prepare_expr_w (tree type, ffebld expr);
void ffecom_prepare_ptr_to_expr (ffebld expr);
void ffecom_prepare_return_expr (ffebld expr);
tree ffecom_ptr_to_const_expr (ffebld expr);
tree ffecom_ptr_to_expr (ffebld expr);
tree ffecom_return_expr (ffebld expr);
tree ffecom_save_tree (tree t);
void ffecom_start_compstmt (void);
tree ffecom_start_decl (tree decl, bool is_init);
void ffecom_sym_commit (ffesymbol s);
ffesymbol ffecom_sym_end_transition (ffesymbol s);
ffesymbol ffecom_sym_exec_transition (ffesymbol s);
ffesymbol ffecom_sym_learned (ffesymbol s);
void ffecom_sym_retract (ffesymbol s);
tree ffecom_temp_label (void);
tree ffecom_truth_value (tree expr);
tree ffecom_truth_value_invert (tree expr);
tree ffecom_type_expr (ffebld expr);
tree ffecom_which_entrypoint_decl (void);
void ffe_parse_file (int);
/* Define macros. */
#define ffecom_f2c_typecode(bt,kt) ffecom_f2c_typecode_[(bt)][(kt)]
#define ffecom_label_kind() ffecom_label_kind_
#define ffecom_pointer_kind() ffecom_pointer_kind_
#define ffecom_prepare_expr(e) ffecom_prepare_expr_ ((e), NULL)
#define ffecom_init_1()
#define ffecom_init_3()
#define ffecom_init_4()
#define ffecom_terminate_0()
#define ffecom_terminate_1()
#define ffecom_terminate_2()
#define ffecom_terminate_3()
#define ffecom_terminate_4()
/* End of #include file. */
#endif /* ! GCC_F_COM_H */

38
gcc/f/config-lang.in
View file

@ -1,38 +0,0 @@
# Top level configure fragment for GNU FORTRAN.
# Copyright (C) 1995, 1996, 1997, 2000, 2001, 2002 Free Software Foundation, Inc.
#This file is part of GNU Fortran.
#GNU Fortran is free software; you can redistribute it and/or modify
#it under the terms of the GNU General Public License as published by
#the Free Software Foundation; either version 2, or (at your option)
#any later version.
#GNU Fortran is distributed in the hope that it will be useful,
#but WITHOUT 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
#along with GNU Fortran; see the file COPYING. If not, write to
#the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
#02111-1307, USA.
# Configure looks for the existence of this file to auto-config each language.
# We define several parameters used by configure:
#
# language - name of language as it would appear in $(LANGUAGES)
# compilers - value to add to $(COMPILERS)
# stagestuff - files to add to $(STAGESTUFF)
language="f77"
compilers="f771\$(exeext)"
stagestuff="g77\$(exeext) g77-cross\$(exeext) f771\$(exeext)"
target_libs=target-libf2c
gtfiles="\$(srcdir)/f/com.c \$(srcdir)/f/com.h \$(srcdir)/f/ste.c \$(srcdir)/f/where.h \$(srcdir)/f/where.c \$(srcdir)/f/lex.c"
build_by_default=no

1877
gcc/f/data.c
View file

File diff suppressed because it is too large Load diff

74
gcc/f/data.h
View file

@ -1,74 +0,0 @@
/* data.h -- Public #include File (module.h template V1.0)
Copyright (C) 1995 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Owning Modules:
data.c
Modifications:
*/
/* Allow multiple inclusion to work. */
#ifndef GCC_F_DATA_H
#define GCC_F_DATA_H
/* Simple definitions and enumerations. */
/* Typedefs. */
/* Include files needed by this one. */
#include "bld.h"
#include "lex.h"
#include "storag.h"
/* Structure definitions. */
/* Global objects accessed by users of this module. */
/* Declare functions with prototypes. */
void ffedata_begin (ffebld list);
bool ffedata_end (bool report_errors, ffelexToken t);
void ffedata_gather (ffestorag st);
bool ffedata_value (ffetargetIntegerDefault rpt, ffebld value,
ffelexToken value_token);
/* Define macros. */
#define ffedata_init_0()
#define ffedata_init_1()
#define ffedata_init_2()
#define ffedata_init_3()
#define ffedata_init_4()
#define ffedata_terminate_0()
#define ffedata_terminate_1()
#define ffedata_terminate_2()
#define ffedata_terminate_3()
#define ffedata_terminate_4()
/* End of #include file. */
#endif /* ! GCC_F_DATA_H */

1484
gcc/f/equiv.c
View file

File diff suppressed because it is too large Load diff

100
gcc/f/equiv.h
View file

@ -1,100 +0,0 @@
/* equiv.h -- Public #include File (module.h template V1.0)
Copyright (C) 1995, 1996 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Owning Modules:
equiv.c
Modifications:
*/
/* Allow multiple inclusion to work. */
#ifndef GCC_F_EQUIV_H
#define GCC_F_EQUIV_H
/* Simple definitions and enumerations. */
/* Typedefs. */
typedef struct _ffeequiv_ *ffeequiv;
/* Include files needed by this one. */
#include "bld.h"
#include "lex.h"
#include "storag.h"
#include "symbol.h"
/* Structure definitions. */
struct _ffeequiv_
{
ffeequiv next;
ffeequiv previous;
ffesymbol common; /* Common area for this equiv, if any. */
ffebld list; /* List of lists of equiv exprs. */
bool is_save; /* Any SAVEd members? */
bool is_init; /* Any initialized members? */
};
/* Global objects accessed by users of this module. */
/* Declare functions with prototypes. */
void ffeequiv_add (ffeequiv eq, ffebld list, ffelexToken t);
void ffeequiv_exec_transition (void);
void ffeequiv_init_2 (void);
void ffeequiv_kill (ffeequiv victim);
bool ffeequiv_layout_cblock (ffestorag st);
ffeequiv ffeequiv_merge (ffeequiv eq1, ffeequiv eq2, ffelexToken t);
ffeequiv ffeequiv_new (void);
ffesymbol ffeequiv_symbol (ffebld expr);
void ffeequiv_update_init (ffeequiv eq);
void ffeequiv_update_save (ffeequiv eq);
/* Define macros. */
#define ffeequiv_common(e) ((e)->common)
#define ffeequiv_init_0()
#define ffeequiv_init_1()
#define ffeequiv_init_3()
#define ffeequiv_init_4()
#define ffeequiv_is_init(e) ((e)->is_init)
#define ffeequiv_is_save(e) ((e)->is_save)
#define ffeequiv_list(e) ((e)->list)
#define ffeequiv_next(e) ((e)->next)
#define ffeequiv_previous(e) ((e)->previous)
#define ffeequiv_set_common(e,c) ((e)->common = (c))
#define ffeequiv_set_init(e,i) ((e)->init = (i))
#define ffeequiv_set_is_init(e,in) ((e)->is_init = (in))
#define ffeequiv_set_is_save(e,sa) ((e)->is_save = (sa))
#define ffeequiv_set_list(e,l) ((e)->list = (l))
#define ffeequiv_terminate_0()
#define ffeequiv_terminate_1()
#define ffeequiv_terminate_2()
#define ffeequiv_terminate_3()
#define ffeequiv_terminate_4()
/* End of #include file. */
#endif /* ! GCC_F_EQUIV_H */

18571
gcc/f/expr.c
View file

File diff suppressed because it is too large Load diff

194
gcc/f/expr.h
View file

@ -1,194 +0,0 @@
/* expr.h -- Public #include File (module.h template V1.0)
Copyright (C) 1995, 1996 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Owning Modules:
expr.c
Modifications:
*/
/* Allow multiple inclusion to work. */
#ifndef GCC_F_EXPR_H
#define GCC_F_EXPR_H
/* Simple definitions and enumerations. */
typedef enum
{
FFEEXPR_contextLET,
FFEEXPR_contextASSIGN,
FFEEXPR_contextIOLIST,
FFEEXPR_contextPARAMETER,
FFEEXPR_contextSUBROUTINEREF,
FFEEXPR_contextDATA,
FFEEXPR_contextIF,
FFEEXPR_contextARITHIF,
FFEEXPR_contextDO,
FFEEXPR_contextDOWHILE,
FFEEXPR_contextFORMAT,
FFEEXPR_contextAGOTO,
FFEEXPR_contextCGOTO,
FFEEXPR_contextCHARACTERSIZE,
FFEEXPR_contextEQUIVALENCE,
FFEEXPR_contextSTOP,
FFEEXPR_contextRETURN,
FFEEXPR_contextSFUNCDEF,
FFEEXPR_contextINCLUDE,
FFEEXPR_contextWHERE,
FFEEXPR_contextSELECTCASE,
FFEEXPR_contextCASE,
FFEEXPR_contextDIMLIST,
FFEEXPR_contextDIMLISTCOMMON, /* Dim list in COMMON stmt. */
FFEEXPR_contextFILEASSOC, /* ASSOCIATEVARIABLE=. */
FFEEXPR_contextFILEINT, /* IOSTAT=. */
FFEEXPR_contextFILEDFINT, /* NEXTREC=. */
FFEEXPR_contextFILELOG, /* NAMED=. */
FFEEXPR_contextFILENUM, /* Numerical expression. */
FFEEXPR_contextFILECHAR, /* Character expression. */
FFEEXPR_contextFILENUMCHAR, /* READ KEYxyz=. */
FFEEXPR_contextFILEDFCHAR, /* Default kind character expression. */
FFEEXPR_contextFILEKEY, /* OPEN KEY=. */
FFEEXPR_contextFILEEXTFUNC, /* USEROPEN=. */
FFEEXPR_contextFILEUNIT, /* READ/WRITE UNIT=. */
FFEEXPR_contextFILEUNIT_DF, /* DEFINE FILE unit (no "(" after it). */
FFEEXPR_contextFILEFORMATNML, /* [FMT=] or [NML=]. */
FFEEXPR_contextFILEFORMAT, /* FMT=. */
FFEEXPR_contextFILENAMELIST,/* NML=. */
FFEEXPR_contextFILENUMAMBIG,/* BACKSPACE, ENDFILE, REWIND, UNLOCK...
where at e.g. BACKSPACE(, if COMMA seen
before ), it is ok. */
FFEEXPR_contextFILEUNITAMBIG, /* READ(, if COMMA seen before ), ok. */
FFEEXPR_contextFILEVXTCODE, /* ENCODE/DECODE third arg (scalar/array). */
FFEEXPR_contextALLOCATE, /* ALLOCATE objects (weird). */
FFEEXPR_contextDEALLOCATE, /* DEALLOCATE objects (weird). */
FFEEXPR_contextHEAPSTAT, /* ALLOCATE/DEALLOCATE STAT= variable. */
FFEEXPR_contextKINDTYPE, /* KIND=. */
FFEEXPR_contextINITVAL, /* R426 =initialization-expr. */
FFEEXPR_contextNULLIFY, /* Pointer names only (F90) or pointers. */
FFEEXPR_contextIOLISTDF, /* IOLIST w/internal file (V112 9-14 30,31). */
FFEEXPR_contextINDEX_, /* Element dimension or substring value. */
FFEEXPR_contextEQVINDEX_, /* EQUIVALENCE element dimension. */
FFEEXPR_contextDATAIMPDOINDEX_, /* INDEX in DATAIMPDO context. */
FFEEXPR_contextIMPDOITEM_,
FFEEXPR_contextIMPDOITEMDF_,/* to ...ITEM_ as IOLISTDF is to IOLIST. */
FFEEXPR_contextIMPDOCTRL_,
FFEEXPR_contextDATAIMPDOITEM_,
FFEEXPR_contextDATAIMPDOCTRL_,
FFEEXPR_contextLOC_,
FFEEXPR_contextACTUALARG_, /* Actual arg to function or subroutine;
turns into ACTUALARGEXPR_ if tokens not
NAME (CLOSE_PAREN/COMMA) or PERCENT.... */
FFEEXPR_contextACTUALARGEXPR_, /* Like LET but disallow CHAR*(*)
concats. */
FFEEXPR_contextINDEXORACTUALARG_, /* "CHARACTER FOO; PRINT *,FOO(?". */
FFEEXPR_contextINDEXORACTUALARGEXPR_, /* ? not NAME
(CLOSE_PAREN/COMMA). */
FFEEXPR_contextSFUNCDEFINDEX_, /* INDEX_ within stmt-func def. */
FFEEXPR_contextSFUNCDEFACTUALARG_,
FFEEXPR_contextSFUNCDEFACTUALARGEXPR_,
FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_,
FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_,
FFEEXPR_contextPAREN_, /* Rhs paren except in LET context. */
FFEEXPR_contextPARENFILENUM_, /* Either PAREN or FILENUM context. */
FFEEXPR_contextPARENFILEUNIT_, /* Either PAREN or FILEUNIT context. */
FFEEXPR_context
} ffeexprContext;
/* Typedefs. */
/* Include files needed by this one. */
#include "bld.h"
#include "lex.h"
#include "malloc.h"
/* Structure definitions. */
typedef ffelexHandler (*ffeexprCallback) (ffelexToken ft, ffebld expr,
ffelexToken t);
/* Global objects accessed by users of this module. */
/* Declare functions with prototypes. */
ffebld ffeexpr_collapse_convert (ffebld expr, ffelexToken t);
ffebld ffeexpr_collapse_paren (ffebld expr, ffelexToken t);
ffebld ffeexpr_collapse_uplus (ffebld expr, ffelexToken t);
ffebld ffeexpr_collapse_uminus (ffebld expr, ffelexToken t);
ffebld ffeexpr_collapse_not (ffebld expr, ffelexToken t);
ffebld ffeexpr_collapse_add (ffebld expr, ffelexToken t);
ffebld ffeexpr_collapse_subtract (ffebld expr, ffelexToken t);
ffebld ffeexpr_collapse_multiply (ffebld expr, ffelexToken t);
ffebld ffeexpr_collapse_divide (ffebld expr, ffelexToken t);
ffebld ffeexpr_collapse_power (ffebld expr, ffelexToken t);
ffebld ffeexpr_collapse_concatenate (ffebld expr, ffelexToken t);
ffebld ffeexpr_collapse_lt (ffebld expr, ffelexToken t);
ffebld ffeexpr_collapse_le (ffebld expr, ffelexToken t);
ffebld ffeexpr_collapse_eq (ffebld expr, ffelexToken t);
ffebld ffeexpr_collapse_ne (ffebld expr, ffelexToken t);
ffebld ffeexpr_collapse_gt (ffebld expr, ffelexToken t);
ffebld ffeexpr_collapse_ge (ffebld expr, ffelexToken t);
ffebld ffeexpr_collapse_and (ffebld expr, ffelexToken t);
ffebld ffeexpr_collapse_or (ffebld expr, ffelexToken t);
ffebld ffeexpr_collapse_xor (ffebld expr, ffelexToken t);
ffebld ffeexpr_collapse_eqv (ffebld expr, ffelexToken t);
ffebld ffeexpr_collapse_neqv (ffebld expr, ffelexToken t);
ffebld ffeexpr_collapse_symter (ffebld expr, ffelexToken t);
ffebld ffeexpr_collapse_funcref (ffebld expr, ffelexToken t);
ffebld ffeexpr_collapse_arrayref (ffebld expr, ffelexToken t);
ffebld ffeexpr_collapse_substr (ffebld expr, ffelexToken t);
ffebld ffeexpr_convert (ffebld source, ffelexToken source_token,
ffelexToken dest_token, ffeinfoBasictype bt, ffeinfoKindtype kt,
ffeinfoRank rk, ffetargetCharacterSize sz,
ffeexprContext context);
ffebld ffeexpr_convert_expr (ffebld source, ffelexToken source_token,
ffebld dest, ffelexToken dest_token,
ffeexprContext context);
ffebld ffeexpr_convert_to_sym (ffebld source, ffelexToken source_token,
ffesymbol dest, ffelexToken dest_token);
void ffeexpr_init_2 (void);
ffelexHandler ffeexpr_rhs (mallocPool pool, ffeexprContext context,
ffeexprCallback callback);
ffelexHandler ffeexpr_lhs (mallocPool pool, ffeexprContext context,
ffeexprCallback callback);
void ffeexpr_terminate_2 (void);
void ffeexpr_type_combine (ffeinfoBasictype *nbt, ffeinfoKindtype *nkt,
ffeinfoBasictype lbt, ffeinfoKindtype lkt,
ffeinfoBasictype rbt, ffeinfoKindtype rkt,
ffelexToken t);
/* Define macros. */
#define ffeexpr_init_0()
#define ffeexpr_init_1()
#define ffeexpr_init_3()
#define ffeexpr_init_4()
#define ffeexpr_terminate_0()
#define ffeexpr_terminate_1()
#define ffeexpr_terminate_3()
#define ffeexpr_terminate_4()
/* End of #include file. */
#endif /* ! GCC_F_EXPR_H */

2063
gcc/f/ffe.texi
View file

File diff suppressed because it is too large Load diff

772
gcc/f/fini.c
View file

@ -1,772 +0,0 @@
/* fini.c
Copyright (C) 1995 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA. */
#define USE_BCONFIG
#include "proj.h"
#include "malloc.h"
#undef MAXNAMELEN
#define MAXNAMELEN 100
typedef struct _name_ *name;
struct _name_
{
name next;
name previous;
name next_alpha;
name previous_alpha;
int namelen;
int kwlen;
char kwname[MAXNAMELEN];
char name_uc[MAXNAMELEN];
char name_lc[MAXNAMELEN];
char name_ic[MAXNAMELEN];
};
struct _name_root_
{
name first;
name last;
};
struct _name_alpha_
{
name ign1;
name ign2;
name first;
name last;
};
static FILE *in;
static FILE *out;
static char prefix[32];
static char postfix[32];
static char storage[32];
static const char *const xspaces[]
=
{
"", /* 0 */
" ", /* 1 */
" ", /* 2 */
" ", /* 3 */
" ", /* 4 */
" ", /* 5 */
" ", /* 6 */
" ", /* 7 */
"\t", /* 8 */
"\t ", /* 9 */
"\t ", /* 10 */
"\t ", /* 11 */
"\t ", /* 12 */
"\t ", /* 13 */
"\t ", /* 14 */
"\t ", /* 15 */
"\t\t", /* 16 */
"\t\t ", /* 17 */
"\t\t ", /* 18 */
"\t\t ", /* 19 */
"\t\t ", /* 20 */
"\t\t ", /* 21 */
"\t\t ", /* 22 */
"\t\t ", /* 23 */
"\t\t\t", /* 24 */
"\t\t\t ", /* 25 */
"\t\t\t ", /* 26 */
"\t\t\t ", /* 27 */
"\t\t\t ", /* 28 */
"\t\t\t ", /* 29 */
"\t\t\t ", /* 30 */
"\t\t\t ", /* 31 */
"\t\t\t\t", /* 32 */
"\t\t\t\t ", /* 33 */
"\t\t\t\t ", /* 34 */
"\t\t\t\t ", /* 35 */
"\t\t\t\t ", /* 36 */
"\t\t\t\t ", /* 37 */
"\t\t\t\t ", /* 38 */
"\t\t\t\t ", /* 39 */
"\t\t\t\t\t", /* 40 */
"\t\t\t\t\t ", /* 41 */
"\t\t\t\t\t ", /* 42 */
"\t\t\t\t\t ", /* 43 */
"\t\t\t\t\t ", /* 44 */
"\t\t\t\t\t ", /* 45 */
"\t\t\t\t\t ", /* 46 */
"\t\t\t\t\t ", /* 47 */
"\t\t\t\t\t\t", /* 48 */
"\t\t\t\t\t\t ", /* 49 */
"\t\t\t\t\t\t ", /* 50 */
"\t\t\t\t\t\t ", /* 51 */
"\t\t\t\t\t\t ", /* 52 */
"\t\t\t\t\t\t ", /* 53 */
"\t\t\t\t\t\t ", /* 54 */
"\t\t\t\t\t\t ", /* 55 */
"\t\t\t\t\t\t\t", /* 56 */
"\t\t\t\t\t\t\t ", /* 57 */
"\t\t\t\t\t\t\t ", /* 58 */
"\t\t\t\t\t\t\t ", /* 59 */
"\t\t\t\t\t\t\t ", /* 60 */
"\t\t\t\t\t\t\t ", /* 61 */
"\t\t\t\t\t\t\t ", /* 62 */
"\t\t\t\t\t\t\t ", /* 63 */
"\t\t\t\t\t\t\t\t", /* 64 */
"\t\t\t\t\t\t\t\t ", /* 65 */
"\t\t\t\t\t\t\t\t ", /* 66 */
"\t\t\t\t\t\t\t\t ", /* 67 */
"\t\t\t\t\t\t\t\t ", /* 68 */
"\t\t\t\t\t\t\t\t ", /* 69 */
"\t\t\t\t\t\t\t\t ", /* 70 */
"\t\t\t\t\t\t\t\t ", /* 71 */
"\t\t\t\t\t\t\t\t\t", /* 72 */
"\t\t\t\t\t\t\t\t\t ", /* 73 */
"\t\t\t\t\t\t\t\t\t ", /* 74 */
"\t\t\t\t\t\t\t\t\t ", /* 75 */
"\t\t\t\t\t\t\t\t\t ", /* 76 */
"\t\t\t\t\t\t\t\t\t ", /* 77 */
"\t\t\t\t\t\t\t\t\t ", /* 78 */
"\t\t\t\t\t\t\t\t\t ", /* 79 */
"\t\t\t\t\t\t\t\t\t\t", /* 80 */
"\t\t\t\t\t\t\t\t\t\t ", /* 81 */
"\t\t\t\t\t\t\t\t\t\t ", /* 82 */
"\t\t\t\t\t\t\t\t\t\t ", /* 83 */
"\t\t\t\t\t\t\t\t\t\t ", /* 84 */
"\t\t\t\t\t\t\t\t\t\t ", /* 85 */
"\t\t\t\t\t\t\t\t\t\t ", /* 86 */
"\t\t\t\t\t\t\t\t\t\t ",/* 87 */
"\t\t\t\t\t\t\t\t\t\t\t", /* 88 */
"\t\t\t\t\t\t\t\t\t\t\t ", /* 89 */
"\t\t\t\t\t\t\t\t\t\t\t ", /* 90 */
"\t\t\t\t\t\t\t\t\t\t\t ", /* 91 */
"\t\t\t\t\t\t\t\t\t\t\t ", /* 92 */
"\t\t\t\t\t\t\t\t\t\t\t ",/* 93 */
"\t\t\t\t\t\t\t\t\t\t\t ", /* 94 */
"\t\t\t\t\t\t\t\t\t\t\t ", /* 95 */
"\t\t\t\t\t\t\t\t\t\t\t\t", /* 96 */
"\t\t\t\t\t\t\t\t\t\t\t\t ", /* 97 */
"\t\t\t\t\t\t\t\t\t\t\t\t ", /* 98 */
"\t\t\t\t\t\t\t\t\t\t\t\t ",/* 99 */
"\t\t\t\t\t\t\t\t\t\t\t\t ", /* 100 */
"\t\t\t\t\t\t\t\t\t\t\t\t ", /* 101 */
"\t\t\t\t\t\t\t\t\t\t\t\t ", /* 102 */
"\t\t\t\t\t\t\t\t\t\t\t\t ", /* 103 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t", /* 104 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t ",/* 105 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 106 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 107 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 108 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 109 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 110 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 111 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t", /* 112 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 113 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 114 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 115 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 116 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 117 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 118 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 119 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t", /* 120 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 121 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 122 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 123 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 124 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 125 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 126 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 127 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t", /* 128 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 129 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 130 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 131 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 132 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 133 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 134 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 135 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t", /* 136 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 137 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 138 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 139 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 140 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 141 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 142 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 143 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t", /* 144 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 145 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 146 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 147 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 148 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 149 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 150 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 151 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t", /* 152 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 153 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 154 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 155 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 156 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 157 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 158 */
"\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 159 */
};
void testname (bool nested, int indent, name first, name last);
void testnames (bool nested, int indent, int len, name first, name last);
int
main (int argc, char **argv)
{
char buf[MAXNAMELEN];
char last_buf[MAXNAMELEN];
char kwname[MAXNAMELEN];
char routine[32];
char type[32];
int i;
int count;
int len;
struct _name_root_ names[200];
struct _name_alpha_ names_alpha;
name n;
name newname;
char *input_name;
char *output_name;
char *include_name;
FILE *incl;
int fixlengths;
int total_length;
int do_name; /* TRUE if token may be NAME. */
int do_names; /* TRUE if token may be NAMES. */
int cc;
bool do_exit = FALSE;
last_buf[0] = '\0';
for (i = 0; ((size_t) i) < ARRAY_SIZE (names); ++i)
{ /* Initialize length/name ordered list roots. */
names[i].first = (name) &names[i];
names[i].last = (name) &names[i];
}
names_alpha.first = (name) &names_alpha; /* Initialize name order. */
names_alpha.last = (name) &names_alpha;
if (argc != 4)
{
fprintf (stderr, "Command form: fini input output-code output-include\n");
return (1);
}
input_name = argv[1];
output_name = argv[2];
include_name = argv[3];
in = fopen (input_name, "r");
if (in == NULL)
{
fprintf (stderr, "Cannot open \"%s\"\n", input_name);
return (1);
}
out = fopen (output_name, "w");
if (out == NULL)
{
fclose (in);
fprintf (stderr, "Cannot open \"%s\"\n", output_name);
return (1);
}
incl = fopen (include_name, "w");
if (incl == NULL)
{
fclose (in);
fprintf (stderr, "Cannot open \"%s\"\n", include_name);
return (1);
}
/* Get past the initial block-style comment (man, this parsing code is just
_so_ lame, but I'm too lazy to improve it). */
for (;;)
{
cc = getc (in);
if (cc == '{')
{
while (((cc = getc (in)) != '}') && (cc != EOF))
;
}
else if (cc != EOF)
{
while (((cc = getc (in)) != EOF) && (! ISALNUM (cc)))
;
ungetc (cc, in);
break;
}
else
{
assert ("EOF too soon!" == NULL);
return (1);
}
}
fscanf (in, "%s %s %s %s %s %d %d", prefix, postfix, storage, type, routine,
&do_name, &do_names);
if (storage[0] == '\0')
storage[1] = '\0';
else
/* Assume string is quoted somehow, replace ending quote with space. */
{
if (storage[2] == '\0')
storage[1] = '\0';
else
storage[strlen (storage) - 1] = ' ';
}
if (postfix[0] == '\0')
postfix[1] = '\0';
else /* Assume string is quoted somehow, strip off
ending quote. */
postfix[strlen (postfix) - 1] = '\0';
for (i = 1; storage[i] != '\0'; ++i)
storage[i - 1] = storage[i];
storage[i - 1] = '\0';
for (i = 1; postfix[i] != '\0'; ++i)
postfix[i - 1] = postfix[i];
postfix[i - 1] = '\0';
fixlengths = strlen (prefix) + strlen (postfix);
while (TRUE)
{
count = fscanf (in, "%s %s", buf, kwname);
if (count == EOF)
break;
len = strlen (buf);
if (len == 0)
continue; /* Skip empty lines. */
if (buf[0] == ';')
continue; /* Skip commented-out lines. */
for (i = strlen (buf) - 1; i > 0; --i)
cc = buf[i];
/* Make new name object to store name and its keyword. */
newname = xmalloc (sizeof (*newname));
newname->namelen = strlen (buf);
newname->kwlen = strlen (kwname);
total_length = newname->kwlen + fixlengths;
if (total_length >= 32) /* Else resulting keyword name too long. */
{
fprintf (stderr, "%s: %s%s%s is 31+%d chars long\n", input_name,
prefix, kwname, postfix, total_length - 31);
do_exit = TRUE;
}
strcpy (newname->kwname, kwname);
for (i = 0; i < newname->namelen; ++i)
{
cc = buf[i];
newname->name_uc[i] = TOUPPER (cc);
newname->name_lc[i] = TOLOWER (cc);
newname->name_ic[i] = cc;
}
newname->name_uc[i] = newname->name_lc[i] = newname->name_ic[i] = '\0';
/* Warn user if names aren't alphabetically ordered. */
if ((last_buf[0] != '\0')
&& (strcmp (last_buf, newname->name_uc) >= 0))
{
fprintf (stderr, "%s: \"%s\" precedes \"%s\"\n", input_name,
last_buf, newname->name_uc);
do_exit = TRUE;
}
strcpy (last_buf, newname->name_uc);
/* Append name to end of alpha-sorted list (assumes names entered in
alpha order wrt name, not kwname, even though kwname is output from
this list). */
n = names_alpha.last;
newname->next_alpha = n->next_alpha;
newname->previous_alpha = n;
n->next_alpha->previous_alpha = newname;
n->next_alpha = newname;
/* Insert name in appropriate length/name ordered list. */
n = (name) &names[len];
while ((n->next != (name) &names[len])
&& (strcmp (buf, n->next->name_uc) > 0))
n = n->next;
if (strcmp (buf, n->next->name_uc) == 0)
{
fprintf (stderr, "%s: extraneous \"%s\"\n", input_name, buf);
do_exit = TRUE;
}
newname->next = n->next;
newname->previous = n;
n->next->previous = newname;
n->next = newname;
}
#if 0
for (len = 0; len < ARRAY_SIZE (name); ++len)
{
if (names[len].first == (name) &names[len])
continue;
printf ("Length %d:\n", len);
for (n = names[len].first; n != (name) &names[len]; n = n->next)
printf (" %s %s %s\n", n->name_uc, n->name_lc, n->name_ic);
}
#endif
if (do_exit)
return (1);
/* First output the #include file. */
for (n = names_alpha.first; n != (name) &names_alpha; n = n->next_alpha)
{
fprintf (incl, "#define %sl%s%s %d\n", prefix, n->kwname, postfix,
n->namelen);
}
fprintf (incl,
"\
\n\
enum %s_\n\
{\n\
%sNone%s,\n\
",
type, prefix, postfix);
for (n = names_alpha.first; n != (name) &names_alpha; n = n->next_alpha)
{
fprintf (incl,
"\
%s%s%s,\n\
",
prefix, n->kwname, postfix);
}
fprintf (incl,
"\
%s%s\n\
};\n\
typedef enum %s_ %s;\n\
",
prefix, postfix, type, type);
/* Now output the C program. */
fprintf (out,
"\
%s%s\n\
%s (ffelexToken t)\n\
%c\n\
char *p;\n\
int c;\n\
\n\
p = ffelex_token_text (t);\n\
\n\
",
storage, type, routine, '{');
if (do_name)
{
if (do_names)
fprintf (out,
"\
if (ffelex_token_type (t) == FFELEX_typeNAME)\n\
{\n\
switch (ffelex_token_length (t))\n\
\t{\n\
"
);
else
fprintf (out,
"\
assert (ffelex_token_type (t) == FFELEX_typeNAME);\n\
\n\
switch (ffelex_token_length (t))\n\
{\n\
"
);
/* Now output the length as a case, followed by the binary search within that length. */
for (len = 0; ((size_t) len) < ARRAY_SIZE (names); ++len)
{
if (names[len].first != (name) &names[len])
{
if (do_names)
fprintf (out,
"\
\tcase %d:\n\
",
len);
else
fprintf (out,
"\
case %d:\n\
",
len);
testname (FALSE, do_names ? 10 : 6, names[len].first, names[len].last);
if (do_names)
fprintf (out,
"\
\t break;\n\
"
);
else
fprintf (out,
"\
break;\n\
"
);
}
}
if (do_names)
fprintf (out,
"\
\t}\n\
return %sNone%s;\n\
}\n\
\n\
",
prefix, postfix);
else
fprintf (out,
"\
}\n\
\n\
return %sNone%s;\n\
}\n\
",
prefix, postfix);
}
if (do_names)
{
fputs ("\
assert (ffelex_token_type (t) == FFELEX_typeNAMES);\n\
\n\
switch (ffelex_token_length (t))\n\
{\n\
default:\n\
",
out);
/* Find greatest non-empty length list. */
for (len = ARRAY_SIZE (names) - 1;
names[len].first == (name) &names[len];
--len)
;
/* Now output the length as a case, followed by the binary search within that length. */
if (len > 0)
{
for (; len != 0; --len)
{
fprintf (out,
"\
case %d:\n\
",
len);
if (names[len].first != (name) &names[len])
testnames (FALSE, 6, len, names[len].first, names[len].last);
}
if (names[1].first == (name) &names[1])
fprintf (out,
"\
;\n\
"
); /* Need empty statement after an empty case
1: */
}
fprintf (out,
"\
}\n\
\n\
return %sNone%s;\n\
}\n\
",
prefix, postfix);
}
if (out != stdout)
fclose (out);
if (incl != stdout)
fclose (incl);
if (in != stdin)
fclose (in);
return (0);
}
void
testname (bool nested, int indent, name first, name last)
{
name n;
name nhalf;
int num;
int numhalf;
assert (!nested || indent >= 2);
assert (((size_t) indent) + 4 < ARRAY_SIZE (xspaces));
num = 0;
numhalf = 0;
for (n = first, nhalf = first; n != last->next; n = n->next)
{
if ((++num & 1) == 0)
{
nhalf = nhalf->next;
++numhalf;
}
}
if (nested)
fprintf (out,
"\
%s{\n\
",
xspaces[indent - 2]);
fprintf (out,
"\
%sif ((c = ffesrc_strcmp_2c (ffe_case_match (), p, \"%s\", \"%s\", \"%s\")) == 0)\n\
%sreturn %s%s%s;\n\
",
xspaces[indent], nhalf->name_uc, nhalf->name_lc, nhalf->name_ic,
xspaces[indent + 2], prefix, nhalf->kwname, postfix);
if (num != 1)
{
fprintf (out,
"\
%selse if (c < 0)\n\
",
xspaces[indent]);
if (numhalf == 0)
fprintf (out,
"\
%s;\n\
",
xspaces[indent + 2]);
else
testname (TRUE, indent + 4, first, nhalf->previous);
if (num - numhalf > 1)
{
fprintf (out,
"\
%selse\n\
",
xspaces[indent]);
testname (TRUE, indent + 4, nhalf->next, last);
}
}
if (nested)
fprintf (out,
"\
%s}\n\
",
xspaces[indent - 2]);
}
void
testnames (bool nested, int indent, int len, name first, name last)
{
name n;
name nhalf;
int num;
int numhalf;
assert (!nested || indent >= 2);
assert (((size_t) indent) + 4 < ARRAY_SIZE (xspaces));
num = 0;
numhalf = 0;
for (n = first, nhalf = first; n != last->next; n = n->next)
{
if ((++num & 1) == 0)
{
nhalf = nhalf->next;
++numhalf;
}
}
if (nested)
fprintf (out,
"\
%s{\n\
",
xspaces[indent - 2]);
fprintf (out,
"\
%sif ((c = ffesrc_strncmp_2c (ffe_case_match (), p, \"%s\", \"%s\", \"%s\", %d)) == 0)\n\
%sreturn %s%s%s;\n\
",
xspaces[indent], nhalf->name_uc, nhalf->name_lc, nhalf->name_ic,
len, xspaces[indent + 2], prefix, nhalf->kwname, postfix);
if (num != 1)
{
fprintf (out,
"\
%selse if (c < 0)\n\
",
xspaces[indent]);
if (numhalf == 0)
fprintf (out,
"\
%s;\n\
",
xspaces[indent + 2]);
else
testnames (TRUE, indent + 4, len, first, nhalf->previous);
if (num - numhalf > 1)
{
fprintf (out,
"\
%selse\n\
",
xspaces[indent]);
testnames (TRUE, indent + 4, len, nhalf->next, last);
}
}
if (nested)
fprintf (out,
"\
%s}\n\
",
xspaces[indent - 2]);
}

11848
gcc/f/g77.texi
View file

File diff suppressed because it is too large Load diff

541
gcc/f/g77spec.c
View file

@ -1,541 +0,0 @@
/* Specific flags and argument handling of the Fortran front-end.
Copyright (C) 1997, 1999, 2000, 2001, 2002, 2003, 2004
Free Software Foundation, Inc.
This file is part of GCC.
GCC is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GCC is distributed in the hope that it will be useful,
but WITHOUT 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
along with GCC; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
/* This file contains a filter for the main `gcc' driver, which is
replicated for the `g77' driver by adding this filter. The purpose
of this filter is to be basically identical to gcc (in that
it faithfully passes all of the original arguments to gcc) but,
unless explicitly overridden by the user in certain ways, ensure
that the needs of the language supported by this wrapper are met.
For GNU Fortran (g77), we do the following to the argument list
before passing it to `gcc':
1. Make sure `-lg2c -lm' is at the end of the list.
2. Make sure each time `-lg2c' or `-lm' is seen, it forms
part of the series `-lg2c -lm'.
#1 and #2 are not done if `-nostdlib' or any option that disables
the linking phase is present, or if `-xfoo' is in effect. Note that
a lack of source files or -l options disables linking.
This program was originally made out of gcc/cp/g++spec.c, but the
way it builds the new argument list was rewritten so it is much
easier to maintain, improve the way it decides to add or not add
extra arguments, etc. And several improvements were made in the
handling of arguments, primarily to make it more consistent with
`gcc' itself. */
#include "config.h"
#include "system.h"
#include "coretypes.h"
#include "tm.h"
#include "gcc.h"
#include "intl.h"
#ifndef MATH_LIBRARY
#define MATH_LIBRARY "-lm"
#endif
#ifndef FORTRAN_INIT
#define FORTRAN_INIT "-lfrtbegin"
#endif
#ifndef FORTRAN_LIBRARY
#define FORTRAN_LIBRARY "-lg2c"
#endif
/* Options this driver needs to recognize, not just know how to
skip over. */
typedef enum
{
OPTION_b, /* Aka --prefix. */
OPTION_B, /* Aka --target. */
OPTION_c, /* Aka --compile. */
OPTION_driver, /* Wrapper-specific option. */
OPTION_E, /* Aka --preprocess. */
OPTION_help, /* --help. */
OPTION_i, /* -imacros, -include, -include-*. */
OPTION_l,
OPTION_L, /* Aka --library-directory. */
OPTION_M, /* Aka --dependencies. */
OPTION_MM, /* Aka --user-dependencies. */
OPTION_nostdlib, /* Aka --no-standard-libraries, or
-nodefaultlibs. */
OPTION_o, /* Aka --output. */
OPTION_S, /* Aka --assemble. */
OPTION_syntax_only, /* -fsyntax-only. */
OPTION_v, /* Aka --verbose. */
OPTION_version, /* --version. */
OPTION_V, /* Aka --use-version. */
OPTION_x, /* Aka --language. */
OPTION_ /* Unrecognized or unimportant. */
} Option;
/* The original argument list and related info is copied here. */
static int g77_xargc;
static const char *const *g77_xargv;
static void lookup_option (Option *, int *, const char **, const char *);
static void append_arg (const char *);
/* The new argument list will be built here. */
static int g77_newargc;
static const char **g77_newargv;
#ifndef SWITCH_TAKES_ARG
#define SWITCH_TAKES_ARG(CHAR) DEFAULT_SWITCH_TAKES_ARG(CHAR)
#endif
#ifndef WORD_SWITCH_TAKES_ARG
#define WORD_SWITCH_TAKES_ARG(STR) DEFAULT_WORD_SWITCH_TAKES_ARG (STR)
#endif
/* Assumes text[0] == '-'. Returns number of argv items that belong to
(and follow) this one, an option id for options important to the
caller, and a pointer to the first char of the arg, if embedded (else
returns NULL, meaning no arg or it's the next argv).
Note that this also assumes gcc.c's pass converting long options
to short ones, where available, has already been run. */
static void
lookup_option (Option *xopt, int *xskip, const char **xarg, const char *text)
{
Option opt = OPTION_;
int skip;
const char *arg = NULL;
if ((skip = SWITCH_TAKES_ARG (text[1])))
skip -= (text[2] != '\0'); /* See gcc.c. */
if (text[1] == 'B')
opt = OPTION_B, skip = (text[2] == '\0'), arg = text + 2;
else if (text[1] == 'b')
opt = OPTION_b, skip = (text[2] == '\0'), arg = text + 2;
else if ((text[1] == 'c') && (text[2] == '\0'))
opt = OPTION_c, skip = 0;
else if ((text[1] == 'E') && (text[2] == '\0'))
opt = OPTION_E, skip = 0;
else if (text[1] == 'i')
opt = OPTION_i, skip = 0;
else if (text[1] == 'l')
opt = OPTION_l;
else if (text[1] == 'L')
opt = OPTION_L, arg = text + 2;
else if (text[1] == 'o')
opt = OPTION_o;
else if ((text[1] == 'S') && (text[2] == '\0'))
opt = OPTION_S, skip = 0;
else if (text[1] == 'V')
opt = OPTION_V, skip = (text[2] == '\0');
else if ((text[1] == 'v') && (text[2] == '\0'))
opt = OPTION_v, skip = 0;
else if (text[1] == 'x')
opt = OPTION_x, arg = text + 2;
else
{
if ((skip = WORD_SWITCH_TAKES_ARG (text + 1)) != 0) /* See gcc.c. */
;
else if (! strncmp (text, "-fdriver", 8)) /* Really --driver!! */
opt = OPTION_driver; /* Never mind arg, this is unsupported. */
else if (! strcmp (text, "-fhelp")) /* Really --help!! */
opt = OPTION_help;
else if (! strcmp (text, "-M"))
opt = OPTION_M;
else if (! strcmp (text, "-MM"))
opt = OPTION_MM;
else if (! strcmp (text, "-nostdlib")
|| ! strcmp (text, "-nodefaultlibs"))
opt = OPTION_nostdlib;
else if (! strcmp (text, "-fsyntax-only"))
opt = OPTION_syntax_only;
else if (! strcmp (text, "-dumpversion"))
opt = OPTION_version;
else if (! strcmp (text, "-fversion")) /* Really --version!! */
opt = OPTION_version;
else if (! strcmp (text, "-Xlinker")
|| ! strcmp (text, "-specs"))
skip = 1;
else
skip = 0;
}
if (xopt != NULL)
*xopt = opt;
if (xskip != NULL)
*xskip = skip;
if (xarg != NULL)
{
if ((arg != NULL)
&& (arg[0] == '\0'))
*xarg = NULL;
else
*xarg = arg;
}
}
/* Append another argument to the list being built. As long as it is
identical to the corresponding arg in the original list, just increment
the new arg count. Otherwise allocate a new list, etc. */
static void
append_arg (const char *arg)
{
static int newargsize;
#if 0
fprintf (stderr, "`%s'\n", arg);
#endif
if (g77_newargv == g77_xargv
&& g77_newargc < g77_xargc
&& (arg == g77_xargv[g77_newargc]
|| ! strcmp (arg, g77_xargv[g77_newargc])))
{
++g77_newargc;
return; /* Nothing new here. */
}
if (g77_newargv == g77_xargv)
{ /* Make new arglist. */
int i;
newargsize = (g77_xargc << 2) + 20; /* This should handle all. */
g77_newargv = xmalloc (newargsize * sizeof (char *));
/* Copy what has been done so far. */
for (i = 0; i < g77_newargc; ++i)
g77_newargv[i] = g77_xargv[i];
}
if (g77_newargc == newargsize)
fatal ("overflowed output arg list for `%s'", arg);
g77_newargv[g77_newargc++] = arg;
}
void
lang_specific_driver (int *in_argc, const char *const **in_argv,
int *in_added_libraries ATTRIBUTE_UNUSED)
{
int argc = *in_argc;
const char *const *argv = *in_argv;
int i;
int verbose = 0;
Option opt;
int skip;
const char *arg;
/* This will be NULL if we encounter a situation where we should not
link in libf2c. */
const char *library = FORTRAN_LIBRARY;
/* 0 => -xnone in effect.
1 => -xfoo in effect. */
int saw_speclang = 0;
/* 0 => initial/reset state
1 => last arg was -l<library>
2 => last two args were -l<library> -lm. */
int saw_library = 0;
/* 0 => initial/reset state
1 => FORTRAN_INIT linked in */
int use_init = 0;
/* By default, we throw on the math library if we have one. */
int need_math = (MATH_LIBRARY[0] != '\0');
/* The number of input and output files in the incoming arg list. */
int n_infiles = 0;
int n_outfiles = 0;
#if 0
fprintf (stderr, "Incoming:");
for (i = 0; i < argc; i++)
fprintf (stderr, " %s", argv[i]);
fprintf (stderr, "\n");
#endif
g77_xargc = argc;
g77_xargv = argv;
g77_newargc = 0;
g77_newargv = (const char **) argv;
/* First pass through arglist.
If -nostdlib or a "turn-off-linking" option is anywhere in the
command line, don't do any library-option processing (except
relating to -x). Also, if -v is specified, but no other options
that do anything special (allowing -V version, etc.), remember
to add special stuff to make gcc command actually invoke all
the different phases of the compilation process so all the version
numbers can be seen.
Also, here is where all problems with missing arguments to options
are caught. If this loop is exited normally, it means all options
have the appropriate number of arguments as far as the rest of this
program is concerned. */
for (i = 1; i < argc; ++i)
{
if ((argv[i][0] == '+') && (argv[i][1] == 'e'))
{
continue;
}
if ((argv[i][0] != '-') || (argv[i][1] == '\0'))
{
++n_infiles;
continue;
}
lookup_option (&opt, &skip, NULL, argv[i]);
switch (opt)
{
case OPTION_nostdlib:
case OPTION_c:
case OPTION_S:
case OPTION_syntax_only:
case OPTION_E:
case OPTION_M:
case OPTION_MM:
/* These options disable linking entirely or linking of the
standard libraries. */
library = 0;
break;
case OPTION_l:
++n_infiles;
break;
case OPTION_o:
++n_outfiles;
break;
case OPTION_v:
verbose = 1;
break;
case OPTION_b:
case OPTION_B:
case OPTION_L:
case OPTION_i:
case OPTION_V:
/* These options are useful in conjunction with -v to get
appropriate version info. */
break;
case OPTION_version:
printf ("GNU Fortran (GCC) %s\n", version_string);
printf ("Copyright %s 2004 Free Software Foundation, Inc.\n",
_("(C)"));
printf ("\n");
printf (_("\
GNU Fortran comes with NO WARRANTY, to the extent permitted by law.\n\
You may redistribute copies of GNU Fortran\n\
under the terms of the GNU General Public License.\n\
For more information about these matters, see the file named COPYING\n\
or type the command `info -f g77 Copying'.\n\
"));
exit (0);
break;
case OPTION_help:
/* Let gcc.c handle this, as it has a really
cool facility for handling --help and --verbose --help. */
return;
case OPTION_driver:
fatal ("--driver no longer supported");
break;
default:
break;
}
/* This is the one place we check for missing arguments in the
program. */
if (i + skip < argc)
i += skip;
else
fatal ("argument to `%s' missing", argv[i]);
}
if ((n_outfiles != 0) && (n_infiles == 0))
fatal ("no input files; unwilling to write output files");
/* If there are no input files, no need for the library. */
if (n_infiles == 0)
library = 0;
/* Second pass through arglist, transforming arguments as appropriate. */
append_arg (argv[0]); /* Start with command name, of course. */
for (i = 1; i < argc; ++i)
{
if (argv[i][0] == '\0')
{
append_arg (argv[i]); /* Interesting. Just append as is. */
continue;
}
if ((argv[i][0] == '-') && (argv[i][1] != 'l'))
{
/* Not a filename or library. */
if (saw_library == 1 && need_math) /* -l<library>. */
append_arg (MATH_LIBRARY);
saw_library = 0;
lookup_option (&opt, &skip, &arg, argv[i]);
if (argv[i][1] == '\0')
{
append_arg (argv[i]); /* "-" == Standard input. */
continue;
}
if (opt == OPTION_x)
{
/* Track input language. */
const char *lang;
if (arg == NULL)
lang = argv[i+1];
else
lang = arg;
saw_speclang = (strcmp (lang, "none") != 0);
}
append_arg (argv[i]);
for (; skip != 0; --skip)
append_arg (argv[++i]);
continue;
}
/* A filename/library, not an option. */
if (saw_speclang)
saw_library = 0; /* -xfoo currently active. */
else
{ /* -lfoo or filename. */
if (strcmp (argv[i], MATH_LIBRARY) == 0)
{
if (saw_library == 1)
saw_library = 2; /* -l<library> -lm. */
else
{
if (0 == use_init)
{
append_arg (FORTRAN_INIT);
use_init = 1;
}
append_arg (FORTRAN_LIBRARY);
}
}
else if (strcmp (argv[i], FORTRAN_LIBRARY) == 0)
saw_library = 1; /* -l<library>. */
else
{ /* Other library, or filename. */
if (saw_library == 1 && need_math)
append_arg (MATH_LIBRARY);
saw_library = 0;
}
}
append_arg (argv[i]);
}
/* Append `-lg2c -lm' as necessary. */
if (library)
{ /* Doing a link and no -nostdlib. */
if (saw_speclang)
append_arg ("-xnone");
switch (saw_library)
{
case 0:
if (0 == use_init)
{
append_arg (FORTRAN_INIT);
use_init = 1;
}
append_arg (library);
case 1:
if (need_math)
append_arg (MATH_LIBRARY);
default:
break;
}
}
#ifdef ENABLE_SHARED_LIBGCC
if (library)
{
int i;
for (i = 1; i < g77_newargc; i++)
if (g77_newargv[i][0] == '-')
if (strcmp (g77_newargv[i], "-static-libgcc") == 0
|| strcmp (g77_newargv[i], "-static") == 0)
break;
if (i == g77_newargc)
append_arg ("-shared-libgcc");
}
#endif
if (verbose
&& g77_newargv != g77_xargv)
{
fprintf (stderr, "Driving:");
for (i = 0; i < g77_newargc; i++)
fprintf (stderr, " %s", g77_newargv[i]);
fprintf (stderr, "\n");
}
*in_argc = g77_newargc;
*in_argv = g77_newargv;
}
/* Called before linking. Returns 0 on success and -1 on failure. */
int lang_specific_pre_link (void) /* Not used for F77. */
{
return 0;
}
/* Number of extra output files that lang_specific_pre_link may generate. */
int lang_specific_extra_outfiles = 0; /* Not used for F77. */
/* Table of language-specific spec functions. */
const struct spec_function lang_specific_spec_functions[] =
{
{ 0, 0 }
};

1586
gcc/f/global.c
View file

File diff suppressed because it is too large Load diff

193
gcc/f/global.h
View file

@ -1,193 +0,0 @@
/* global.h -- Public #include File (module.h template V1.0)
Copyright (C) 1995, 1997, 2003 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Owning Modules:
global.c
Modifications:
*/
/* Allow multiple inclusion to work. */
#ifndef GCC_F_GLOBAL_H
#define GCC_F_GLOBAL_H
/* Simple definitions and enumerations. */
typedef enum
{
FFEGLOBAL_typeNONE,
FFEGLOBAL_typeMAIN,
FFEGLOBAL_typeEXT, /* EXTERNAL is all we know. */
FFEGLOBAL_typeSUBR,
FFEGLOBAL_typeFUNC,
FFEGLOBAL_typeBDATA,
FFEGLOBAL_typeCOMMON,
FFEGLOBAL_typeANY, /* Confusion reigns, so just ignore. */
FFEGLOBAL_type
} ffeglobalType;
typedef enum
{
FFEGLOBAL_argsummaryNONE, /* No arg present. */
FFEGLOBAL_argsummaryVAL, /* Pass-by-value. */
FFEGLOBAL_argsummaryREF, /* Pass-by-reference. */
FFEGLOBAL_argsummaryDESCR, /* Pass-by-descriptor. */
FFEGLOBAL_argsummaryPROC, /* Procedure (intrinsic, external). */
FFEGLOBAL_argsummarySUBR, /* Subroutine (intrinsic, external). */
FFEGLOBAL_argsummaryFUNC, /* Function (intrinsic, external). */
FFEGLOBAL_argsummaryALTRTN, /* Alternate-return (label). */
FFEGLOBAL_argsummaryANY,
FFEGLOBAL_argsummary
} ffeglobalArgSummary;
/* Typedefs. */
typedef struct _ffeglobal_arginfo_ *ffeglobalArgInfo_;
typedef struct _ffeglobal_ *ffeglobal;
/* Include files needed by this one. */
#include "info.h"
#include "lex.h"
#include "name.h"
#include "symbol.h"
#include "target.h"
#include "top.h"
/* Structure definitions. */
struct _ffeglobal_arginfo_
{
ffelexToken t; /* Different from master token when difference is important. */
char *name; /* Name of dummy arg, or NULL if not yet known. */
ffeglobalArgSummary as;
ffeinfoBasictype bt;
ffeinfoKindtype kt;
bool array;
};
struct _ffeglobal_
{
ffelexToken t;
ffename n;
ffecomGlobal hook;
ffeCounter tick; /* Recent transition in this progunit. */
ffeglobalType type;
bool intrinsic; /* Known as intrinsic? */
bool explicit_intrinsic; /* Explicit intrinsic? */
union {
struct {
ffelexToken initt; /* First initial value. */
bool have_pad; /* Padding info avail for COMMON? */
ffetargetAlign pad; /* Initial padding for COMMON. */
ffewhereLine pad_where_line;
ffewhereColumn pad_where_col;
bool have_save; /* Save info avail for COMMON? */
bool save; /* Save info for COMMON. */
ffewhereLine save_where_line;
ffewhereColumn save_where_col;
bool have_size; /* Size info avail for COMMON? */
ffetargetOffset size; /* Size info for COMMON. */
bool blank; /* TRUE if blank COMMON. */
} common;
struct {
bool defined; /* Seen actual code yet? */
ffeinfoBasictype bt; /* NONE for non-function. */
ffeinfoKindtype kt; /* NONE for non-function. */
ffetargetCharacterSize sz;
int n_args; /* 0 for main/blockdata. */
ffelexToken other_t; /* Location of reference. */
ffeglobalArgInfo_ arg_info; /* Info on each argument. */
} proc;
} u;
};
/* Global objects accessed by users of this module. */
/* Declare functions with prototypes. */
void ffeglobal_drive (ffeglobal (*fn) (ffeglobal));
void ffeglobal_init_1 (void);
void ffeglobal_init_common (ffesymbol s, ffelexToken t);
void ffeglobal_new_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type);
void ffeglobal_new_common (ffesymbol s, ffelexToken t, bool blank);
void ffeglobal_pad_common (ffesymbol s, ffetargetAlign pad, ffewhereLine wl,
ffewhereColumn wc);
void ffeglobal_proc_def_arg (ffesymbol s, int argno, const char *name, ffeglobalArgSummary as,
ffeinfoBasictype bt, ffeinfoKindtype kt,
bool array);
void ffeglobal_proc_def_nargs (ffesymbol s, int n_args);
bool ffeglobal_proc_ref_arg (ffesymbol s, int argno, ffeglobalArgSummary as,
ffeinfoBasictype bt, ffeinfoKindtype kt,
bool array, ffelexToken t);
bool ffeglobal_proc_ref_nargs (ffesymbol s, int n_args, ffelexToken t);
ffeglobal ffeglobal_promoted (ffesymbol s);
void ffeglobal_ref_intrinsic (ffesymbol s, ffelexToken t, bool explicit);
bool ffeglobal_ref_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type);
void ffeglobal_save_common (ffesymbol s, bool save, ffewhereLine wl,
ffewhereColumn wc);
bool ffeglobal_size_common (ffesymbol s, ffetargetOffset size);
void ffeglobal_terminate_1 (void);
/* Define macros. */
#define FFEGLOBAL_ENABLED 1
#define ffeglobal_common_init(g) ((g)->tick != 0)
#define ffeglobal_common_have_pad(g) ((g)->u.common.have_pad)
#define ffeglobal_common_have_size(g) ((g)->u.common.have_size)
#define ffeglobal_common_pad(g) ((g)->u.common.pad)
#define ffeglobal_common_size(g) ((g)->u.common.size)
#define ffeglobal_hook(g) ((g)->hook)
#define ffeglobal_init_0()
#define ffeglobal_init_2()
#define ffeglobal_init_3()
#define ffeglobal_init_4()
#define ffeglobal_new_blockdata(s,t) \
ffeglobal_new_progunit_(s,t,FFEGLOBAL_typeBDATA)
#define ffeglobal_new_function(s,t) \
ffeglobal_new_progunit_(s,t,FFEGLOBAL_typeFUNC)
#define ffeglobal_new_program(s,t) \
ffeglobal_new_progunit_(s,t,FFEGLOBAL_typeMAIN)
#define ffeglobal_new_subroutine(s,t) \
ffeglobal_new_progunit_(s,t,FFEGLOBAL_typeSUBR)
#define ffeglobal_ref_blockdata(s,t) \
ffeglobal_ref_progunit_(s,t,FFEGLOBAL_typeBDATA)
#define ffeglobal_ref_external(s,t) \
ffeglobal_ref_progunit_(s,t,FFEGLOBAL_typeEXT)
#define ffeglobal_ref_function(s,t) \
ffeglobal_ref_progunit_(s,t,FFEGLOBAL_typeFUNC)
#define ffeglobal_ref_subroutine(s,t) \
ffeglobal_ref_progunit_(s,t,FFEGLOBAL_typeSUBR)
#define ffeglobal_set_hook(g,h) ((g)->hook = (h))
#define ffeglobal_terminate_0()
#define ffeglobal_terminate_2()
#define ffeglobal_terminate_3()
#define ffeglobal_terminate_4()
#define ffeglobal_text(g) ffename_text((g)->n)
#define ffeglobal_type(g) ((g)->type)
/* End of #include file. */
#endif /* ! GCC_F_GLOBAL_H */

383
gcc/f/implic.c
View file

@ -1,383 +0,0 @@
/* implic.c -- Implementation File (module.c template V1.0)
Copyright (C) 1995, 2002, 2003 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Related Modules:
None.
Description:
The GNU Fortran Front End.
Modifications:
*/
/* Include files. */
#include "proj.h"
#include "implic.h"
#include "info.h"
#include "src.h"
#include "symbol.h"
#include "target.h"
/* Externals defined here. */
/* Simple definitions and enumerations. */
typedef enum
{
FFEIMPLIC_stateINITIAL_,
FFEIMPLIC_stateASSUMED_,
FFEIMPLIC_stateESTABLISHED_,
FFEIMPLIC_state
} ffeimplicState_;
/* Internal typedefs. */
typedef struct _ffeimplic_ *ffeimplic_;
/* Private include files. */
/* Internal structure definitions. */
struct _ffeimplic_
{
ffeimplicState_ state;
ffeinfo info;
};
/* Static objects accessed by functions in this module. */
/* NOTE: This is definitely ASCII-specific!! */
static struct _ffeimplic_ ffeimplic_table_['z' - 'A' + 1];
/* Static functions (internal). */
static ffeimplic_ ffeimplic_lookup_ (unsigned char c);
/* Internal macros. */
/* ffeimplic_lookup_ -- Look up implicit descriptor for initial character
ffeimplic_ imp;
if ((imp = ffeimplic_lookup_('A')) == NULL)
// error
Returns a pointer to an implicit descriptor block based on the character
passed, or NULL if it is not a valid initial character for an implicit
data type. */
static ffeimplic_
ffeimplic_lookup_ (unsigned char c)
{
/* NOTE: This is definitely ASCII-specific!! */
if (ISIDST (c))
return &ffeimplic_table_[c - 'A'];
return NULL;
}
/* ffeimplic_establish_initial -- Establish type of implicit initial letter
ffesymbol s;
if (!ffeimplic_establish_initial(s))
// error
Assigns implicit type information to the symbol based on the first
character of the symbol's name. */
bool
ffeimplic_establish_initial (char c, ffeinfoBasictype basic_type,
ffeinfoKindtype kind_type, ffetargetCharacterSize size)
{
ffeimplic_ imp;
imp = ffeimplic_lookup_ (c);
if (imp == NULL)
return FALSE; /* Character not A-Z or some such thing. */
if (ffeinfo_basictype (imp->info) == FFEINFO_basictypeNONE)
return FALSE; /* IMPLICIT NONE in effect here. */
switch (imp->state)
{
case FFEIMPLIC_stateINITIAL_:
imp->info = ffeinfo_new (basic_type,
kind_type,
0,
FFEINFO_kindNONE,
FFEINFO_whereNONE,
size);
imp->state = FFEIMPLIC_stateESTABLISHED_;
return TRUE;
case FFEIMPLIC_stateASSUMED_:
if ((ffeinfo_basictype (imp->info) != basic_type)
|| (ffeinfo_kindtype (imp->info) != kind_type)
|| (ffeinfo_size (imp->info) != size))
return FALSE;
imp->state = FFEIMPLIC_stateESTABLISHED_;
return TRUE;
case FFEIMPLIC_stateESTABLISHED_:
return FALSE;
default:
assert ("Weird state for implicit object" == NULL);
return FALSE;
}
}
/* ffeimplic_establish_symbol -- Establish implicit type of a symbol
ffesymbol s;
if (!ffeimplic_establish_symbol(s))
// error
Assigns implicit type information to the symbol based on the first
character of the symbol's name.
If symbol already has a type, return TRUE.
Get first character of symbol's name.
Get ffeimplic_ object for it (return FALSE if NULL returned).
Return FALSE if object has no assigned type (IMPLICIT NONE).
Copy the type information from the object to the symbol.
If the object is state "INITIAL", set to state "ASSUMED" so no
subsequent IMPLICIT statement may change the state.
Return TRUE. */
bool
ffeimplic_establish_symbol (ffesymbol s)
{
char c;
ffeimplic_ imp;
if (ffesymbol_basictype (s) != FFEINFO_basictypeNONE)
return TRUE;
c = *(ffesymbol_text (s));
imp = ffeimplic_lookup_ (c);
if (imp == NULL)
return FALSE; /* First character not A-Z or some such
thing. */
if (ffeinfo_basictype (imp->info) == FFEINFO_basictypeNONE)
return FALSE; /* IMPLICIT NONE in effect here. */
ffesymbol_signal_change (s); /* Gonna change, save existing? */
/* Establish basictype, kindtype, size; preserve rank, kind, where. */
ffesymbol_set_info (s,
ffeinfo_new (ffeinfo_basictype (imp->info),
ffeinfo_kindtype (imp->info),
ffesymbol_rank (s),
ffesymbol_kind (s),
ffesymbol_where (s),
ffeinfo_size (imp->info)));
if (imp->state == FFEIMPLIC_stateINITIAL_)
imp->state = FFEIMPLIC_stateASSUMED_;
if (ffe_is_warn_implicit ())
{
/* xgettext:no-c-format */
ffebad_start_msg ("Implicit declaration of `%A' at %0",
FFEBAD_severityWARNING);
ffebad_here (0, ffesymbol_where_line (s),
ffesymbol_where_column (s));
ffebad_string (ffesymbol_text (s));
ffebad_finish ();
}
return TRUE;
}
/* ffeimplic_init_2 -- Initialize table
ffeimplic_init_2();
Assigns initial type information to all initial letters.
Allows for holes in the sequence of letters (i.e. EBCDIC). */
void
ffeimplic_init_2 (void)
{
ffeimplic_ imp;
char c;
for (c = 'A'; c <= 'z'; ++c)
{
imp = &ffeimplic_table_[c - 'A'];
imp->state = FFEIMPLIC_stateINITIAL_;
switch (c)
{
case 'A':
case 'B':
case 'C':
case 'D':
case 'E':
case 'F':
case 'G':
case 'H':
case 'O':
case 'P':
case 'Q':
case 'R':
case 'S':
case 'T':
case 'U':
case 'V':
case 'W':
case 'X':
case 'Y':
case 'Z':
case '_':
case 'a':
case 'b':
case 'c':
case 'd':
case 'e':
case 'f':
case 'g':
case 'h':
case 'o':
case 'p':
case 'q':
case 'r':
case 's':
case 't':
case 'u':
case 'v':
case 'w':
case 'x':
case 'y':
case 'z':
imp->info = ffeinfo_new (FFEINFO_basictypeREAL,
FFEINFO_kindtypeREALDEFAULT,
0,
FFEINFO_kindNONE,
FFEINFO_whereNONE,
FFETARGET_charactersizeNONE);
break;
case 'I':
case 'J':
case 'K':
case 'L':
case 'M':
case 'N':
case 'i':
case 'j':
case 'k':
case 'l':
case 'm':
case 'n':
imp->info = ffeinfo_new (FFEINFO_basictypeINTEGER,
FFEINFO_kindtypeINTEGERDEFAULT, 0, FFEINFO_kindNONE, FFEINFO_whereNONE,
FFETARGET_charactersizeNONE);
break;
default:
imp->info = ffeinfo_new (FFEINFO_basictypeNONE, FFEINFO_kindtypeNONE, 0,
FFEINFO_kindNONE, FFEINFO_whereNONE, FFETARGET_charactersizeNONE);
break;
}
}
}
/* ffeimplic_none -- Implement IMPLICIT NONE statement
ffeimplic_none();
Assigns null type information to all initial letters. */
void
ffeimplic_none (void)
{
ffeimplic_ imp;
for (imp = &ffeimplic_table_[0];
imp != &ffeimplic_table_[ARRAY_SIZE (ffeimplic_table_)];
imp++)
{
imp->info = ffeinfo_new (FFEINFO_basictypeNONE,
FFEINFO_kindtypeNONE,
0,
FFEINFO_kindNONE,
FFEINFO_whereNONE,
FFETARGET_charactersizeNONE);
}
}
/* ffeimplic_peek_symbol_type -- Determine implicit type of a symbol
ffesymbol s;
const char *name; // name for s in case it is NULL, or NULL if s never NULL
if (ffeimplic_peek_symbol_type(s,name) == FFEINFO_basictypeCHARACTER)
// is or will be a CHARACTER-typed name
Like establish_symbol, but doesn't change anything.
If symbol is non-NULL and already has a type, return it.
Get first character of symbol's name or from name arg if symbol is NULL.
Get ffeimplic_ object for it (return FALSE if NULL returned).
Return NONE if object has no assigned type (IMPLICIT NONE).
Return the data type indicated in the object.
24-Oct-91 JCB 2.0
Take a char * instead of ffelexToken, since the latter isn't always
needed anyway (as when ffecom calls it). */
ffeinfoBasictype
ffeimplic_peek_symbol_type (ffesymbol s, const char *name)
{
char c;
ffeimplic_ imp;
if (s == NULL)
c = *name;
else
{
if (ffesymbol_basictype (s) != FFEINFO_basictypeNONE)
return ffesymbol_basictype (s);
c = *(ffesymbol_text (s));
}
imp = ffeimplic_lookup_ (c);
if (imp == NULL)
return FFEINFO_basictypeNONE; /* First character not A-Z or
something. */
return ffeinfo_basictype (imp->info);
}
/* ffeimplic_terminate_2 -- Terminate table
ffeimplic_terminate_2();
Kills info object for each entry in table. */
void
ffeimplic_terminate_2 (void)
{
}

74
gcc/f/implic.h
View file

@ -1,74 +0,0 @@
/* implic.h -- Public #include File (module.h template V1.0)
Copyright (C) 1995 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Owning Modules:
implic.c
Modifications:
*/
/* Allow multiple inclusion to work. */
#ifndef GCC_F_IMPLIC_H
#define GCC_F_IMPLIC_H
/* Simple definitions and enumerations. */
/* Typedefs. */
/* Include files needed by this one. */
#include "info.h"
#include "symbol.h"
#include "target.h"
/* Structure definitions. */
/* Global objects accessed by users of this module. */
/* Declare functions with prototypes. */
bool ffeimplic_establish_initial (char c, ffeinfoBasictype basic_type,
ffeinfoKindtype kind_type, ffetargetCharacterSize size);
bool ffeimplic_establish_symbol (ffesymbol s);
void ffeimplic_init_2 (void);
void ffeimplic_none (void);
ffeinfoBasictype ffeimplic_peek_symbol_type (ffesymbol s, const char *name);
void ffeimplic_terminate_2 (void);
/* Define macros. */
#define ffeimplic_init_0()
#define ffeimplic_init_1()
#define ffeimplic_init_3()
#define ffeimplic_init_4()
#define ffeimplic_terminate_0()
#define ffeimplic_terminate_1()
#define ffeimplic_terminate_3()
#define ffeimplic_terminate_4()
/* End of #include file. */
#endif /* ! GCC_F_IMPLIC_H */

36
gcc/f/info-b.def
View file

@ -1,36 +0,0 @@
/* info-b.def -- Public #include File (module.h template V1.0)
Copyright (C) 1995 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Owning Modules:
info.c
Modifications:
*/
FFEINFO_BASICTYPE (FFEINFO_basictypeNONE, "None", "")
FFEINFO_BASICTYPE (FFEINFO_basictypeINTEGER, "INTEGER", "i")
FFEINFO_BASICTYPE (FFEINFO_basictypeLOGICAL, "LOGICAL", "l")
FFEINFO_BASICTYPE (FFEINFO_basictypeREAL, "REAL", "r")
FFEINFO_BASICTYPE (FFEINFO_basictypeCOMPLEX, "COMPLEX", "c")
FFEINFO_BASICTYPE (FFEINFO_basictypeCHARACTER, "CHARACTER", "a")
FFEINFO_BASICTYPE (FFEINFO_basictypeHOLLERITH, "Hollerith", "h")
FFEINFO_BASICTYPE (FFEINFO_basictypeTYPELESS, "Typeless", "t")
FFEINFO_BASICTYPE (FFEINFO_basictypeANY, "Any", "~")

41
gcc/f/info-k.def
View file

@ -1,41 +0,0 @@
/* info-k.def -- Public #include File (module.h template V1.0)
Copyright (C) 1995, 2002 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Owning Modules:
info.c
Modifications:
*/
#
/* Kind messages are used in diagnostic location reports of the
form "<file>: In function `foo': <error message>". */
FFEINFO_KIND (FFEINFO_kindNONE, "In unknown kind", "")
FFEINFO_KIND (FFEINFO_kindENTITY, "In entity", "e")
FFEINFO_KIND (FFEINFO_kindFUNCTION, "In function", "f")
FFEINFO_KIND (FFEINFO_kindSUBROUTINE, "In subroutine", "u")
FFEINFO_KIND (FFEINFO_kindPROGRAM, "In program", "p")
FFEINFO_KIND (FFEINFO_kindBLOCKDATA, "In block-data unit", "b")
FFEINFO_KIND (FFEINFO_kindCOMMON, "In common block", "c")
FFEINFO_KIND (FFEINFO_kindCONSTRUCT, "In construct", ":")
FFEINFO_KIND (FFEINFO_kindNAMELIST, "In namelist", "n")
FFEINFO_KIND (FFEINFO_kindANY, "In anything", "~")

41
gcc/f/info-w.def
View file

@ -1,41 +0,0 @@
/* info-w.def -- Public #include File (module.h template V1.0)
Copyright (C) 1995 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Owning Modules:
info.c
Modifications:
*/
FFEINFO_WHERE (FFEINFO_whereNONE, "None", "")
FFEINFO_WHERE (FFEINFO_whereLOCAL, "Local", "l") /* Defined locally. */
FFEINFO_WHERE (FFEINFO_whereCOMMON, "Common", "c") /* In a common area. */
FFEINFO_WHERE (FFEINFO_whereDUMMY, "Dummy", "d") /* A dummy argument. */
FFEINFO_WHERE (FFEINFO_whereGLOBAL, "Global", "g") /* Reference to external global like FUNCTION, SUBR. */
FFEINFO_WHERE (FFEINFO_whereRESULT, "Result", "r") /* Result of this function. */
FFEINFO_WHERE (FFEINFO_whereFLEETING, "Fleeting", "f") /* Result of "X*Y", "FUNCREF(5,1.3)", "ARRAY(X)", etc. */
FFEINFO_WHERE (FFEINFO_whereFLEETING_CADDR, "Fleet-Const", "fp") /* "A(3)", "CHARS(4:5)". */
FFEINFO_WHERE (FFEINFO_whereFLEETING_IADDR, "Fleet-Immed", "fi") /* A(IX) in "DATA (A(IX),IX=1,100)/.../". */
FFEINFO_WHERE (FFEINFO_whereIMMEDIATE, "Immediate", "i") /* IX in "DATA (A(IX),IX=1,100)/.../". */
FFEINFO_WHERE (FFEINFO_whereINTRINSIC, "Intrinsic", "b")
FFEINFO_WHERE (FFEINFO_whereCONSTANT, "Constant", "p") /* For kindFUNCTION, means statement function! */
FFEINFO_WHERE (FFEINFO_whereCONSTANT_SUBOBJECT, "Const-subobj", "q") /* As in "'FOO'(I:J)". */
FFEINFO_WHERE (FFEINFO_whereANY, "Any", "~")

303
gcc/f/info.c
View file

@ -1,303 +0,0 @@
/* info.c -- Implementation File (module.c template V1.0)
Copyright (C) 1995, 2002, 2003 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Related Modules:
None
Description:
An abstraction for information maintained on a per-operator and per-
operand basis in expression trees.
Modifications:
30-Aug-90 JCB 2.0
Extensive rewrite for new cleaner approach.
*/
/* Include files. */
#include "proj.h"
#include "info.h"
#include "target.h"
#include "type.h"
/* Externals defined here. */
/* Simple definitions and enumerations. */
/* Internal typedefs. */
/* Private include files. */
/* Internal structure definitions. */
/* Static objects accessed by functions in this module. */
static const char *const ffeinfo_basictype_string_[]
=
{
#define FFEINFO_BASICTYPE(KWD,LNAM,SNAM) SNAM,
#include "info-b.def"
#undef FFEINFO_BASICTYPE
};
static const char *const ffeinfo_kind_message_[]
=
{
#define FFEINFO_KIND(kwd,msgid,snam) msgid,
#include "info-k.def"
#undef FFEINFO_KIND
};
static const char *const ffeinfo_kind_string_[]
=
{
#define FFEINFO_KIND(KWD,LNAM,SNAM) SNAM,
#include "info-k.def"
#undef FFEINFO_KIND
};
static ffeinfoBasictype ffeinfo_combine_[FFEINFO_basictype][FFEINFO_basictype];
static const char *const ffeinfo_kindtype_string_[]
=
{
"",
"1",
"2",
"3",
"4",
"5",
"6",
"7",
"8",
"*",
};
static const char *const ffeinfo_where_string_[]
=
{
#define FFEINFO_WHERE(KWD,LNAM,SNAM) SNAM,
#include "info-w.def"
#undef FFEINFO_WHERE
};
static ffetype ffeinfo_types_[FFEINFO_basictype][FFEINFO_kindtype];
/* Static functions (internal). */
/* Internal macros. */
/* ffeinfo_basictype_combine -- Combine two basictypes into highest rank type
ffeinfoBasictype i, j, k;
k = ffeinfo_basictype_combine(i,j);
Returns a type based on "standard" operation between two given types. */
ffeinfoBasictype
ffeinfo_basictype_combine (ffeinfoBasictype l, ffeinfoBasictype r)
{
assert (l < FFEINFO_basictype);
assert (r < FFEINFO_basictype);
return ffeinfo_combine_[l][r];
}
/* ffeinfo_basictype_string -- Return tiny string showing the basictype
ffeinfoBasictype i;
printf("%s",ffeinfo_basictype_string(dt));
Returns the string based on the basic type. */
const char *
ffeinfo_basictype_string (ffeinfoBasictype basictype)
{
if (basictype >= ARRAY_SIZE (ffeinfo_basictype_string_))
return "?\?\?";
return ffeinfo_basictype_string_[basictype];
}
/* ffeinfo_init_0 -- Initialize
ffeinfo_init_0(); */
void
ffeinfo_init_0 (void)
{
ffeinfoBasictype i;
ffeinfoBasictype j;
assert (FFEINFO_basictype == ARRAY_SIZE (ffeinfo_basictype_string_));
assert (FFEINFO_kind == ARRAY_SIZE (ffeinfo_kind_message_));
assert (FFEINFO_kind == ARRAY_SIZE (ffeinfo_kind_string_));
assert (FFEINFO_kindtype == ARRAY_SIZE (ffeinfo_kindtype_string_));
assert (FFEINFO_where == ARRAY_SIZE (ffeinfo_where_string_));
/* Make array that, given two basic types, produces resulting basic type. */
for (i = 0; i < FFEINFO_basictype; ++i)
for (j = 0; j < FFEINFO_basictype; ++j)
if ((i == FFEINFO_basictypeANY) || (j == FFEINFO_basictypeANY))
ffeinfo_combine_[i][j] = FFEINFO_basictypeANY;
else
ffeinfo_combine_[i][j] = FFEINFO_basictypeNONE;
#define same(bt) ffeinfo_combine_[bt][bt] = bt
#define use2(bt1,bt2) ffeinfo_combine_[bt1][bt2] \
= ffeinfo_combine_[bt2][bt1] = bt2
same (FFEINFO_basictypeINTEGER);
same (FFEINFO_basictypeLOGICAL);
same (FFEINFO_basictypeREAL);
same (FFEINFO_basictypeCOMPLEX);
same (FFEINFO_basictypeCHARACTER);
use2 (FFEINFO_basictypeINTEGER, FFEINFO_basictypeREAL);
use2 (FFEINFO_basictypeINTEGER, FFEINFO_basictypeCOMPLEX);
use2 (FFEINFO_basictypeREAL, FFEINFO_basictypeCOMPLEX);
#undef same
#undef use2
}
/* ffeinfo_kind_message -- Return helpful string showing the kind
ffeinfoKind kind;
printf("%s",ffeinfo_kind_message(kind));
Returns the string based on the kind. */
const char *
ffeinfo_kind_message (ffeinfoKind kind)
{
if (kind >= ARRAY_SIZE (ffeinfo_kind_message_))
return "?\?\?";
return ffeinfo_kind_message_[kind];
}
/* ffeinfo_kind_string -- Return tiny string showing the kind
ffeinfoKind kind;
printf("%s",ffeinfo_kind_string(kind));
Returns the string based on the kind. */
const char *
ffeinfo_kind_string (ffeinfoKind kind)
{
if (kind >= ARRAY_SIZE (ffeinfo_kind_string_))
return "?\?\?";
return ffeinfo_kind_string_[kind];
}
ffeinfoKindtype
ffeinfo_kindtype_max(ffeinfoBasictype bt,
ffeinfoKindtype k1,
ffeinfoKindtype k2)
{
if ((bt == FFEINFO_basictypeANY)
|| (k1 == FFEINFO_kindtypeANY)
|| (k2 == FFEINFO_kindtypeANY))
return FFEINFO_kindtypeANY;
if (ffetype_size (ffeinfo_types_[bt][k1])
> ffetype_size (ffeinfo_types_[bt][k2]))
return k1;
return k2;
}
/* ffeinfo_kindtype_string -- Return tiny string showing the kind type
ffeinfoKindtype kind_type;
printf("%s",ffeinfo_kindtype_string(kind));
Returns the string based on the kind type. */
const char *
ffeinfo_kindtype_string (ffeinfoKindtype kind_type)
{
if (kind_type >= ARRAY_SIZE (ffeinfo_kindtype_string_))
return "?\?\?";
return ffeinfo_kindtype_string_[kind_type];
}
void
ffeinfo_set_type (ffeinfoBasictype basictype, ffeinfoKindtype kindtype,
ffetype type)
{
assert (basictype < FFEINFO_basictype);
assert (kindtype < FFEINFO_kindtype);
assert (ffeinfo_types_[basictype][kindtype] == NULL);
ffeinfo_types_[basictype][kindtype] = type;
}
ffetype
ffeinfo_type (ffeinfoBasictype basictype, ffeinfoKindtype kindtype)
{
assert (basictype < FFEINFO_basictype);
assert (kindtype < FFEINFO_kindtype);
return ffeinfo_types_[basictype][kindtype];
}
/* ffeinfo_where_string -- Return tiny string showing the where
ffeinfoWhere where;
printf("%s",ffeinfo_where_string(where));
Returns the string based on the where. */
const char *
ffeinfo_where_string (ffeinfoWhere where)
{
if (where >= ARRAY_SIZE (ffeinfo_where_string_))
return "?\?\?";
return ffeinfo_where_string_[where];
}
/* ffeinfo_new -- Return object representing datatype, kind, and where info
ffeinfo i;
i = ffeinfo_new(FFEINFO_datatypeINTEGER,FFEINFO_kindSCALAR,
FFEINFO_whereLOCAL);
Returns the string based on the data type. */
#ifndef __GNUC__
ffeinfo
ffeinfo_new (ffeinfoBasictype basictype, ffeinfoKindtype kindtype,
ffeinfoRank rank, ffeinfoKind kind, ffeinfoWhere where,
ffetargetCharacterSize size)
{
ffeinfo i;
i.basictype = basictype;
i.kindtype = kindtype;
i.rank = rank;
i.size = size;
i.kind = kind;
i.where = where;
i.size = size;
return i;
}
#endif

186
gcc/f/info.h
View file

@ -1,186 +0,0 @@
/* info.h -- Public #include File (module.h template V1.0)
Copyright (C) 1995 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Owning Modules:
info.c
Modifications:
30-Aug-90 JCB 2.0
Extensive rewrite for new cleaner approach.
*/
/* Allow multiple inclusion to work. */
#ifndef GCC_F_INFO_H
#define GCC_F_INFO_H
/* Simple definitions and enumerations. */
typedef enum
{
#define FFEINFO_BASICTYPE(KWD,LNAM,SNAM) KWD,
#include "info-b.def"
#undef FFEINFO_BASICTYPE
FFEINFO_basictype
} ffeinfoBasictype;
typedef enum
{ /* If these kindtypes aren't in size order,
change _kindtype_max. */
FFEINFO_kindtypeNONE,
FFEINFO_kindtypeINTEGER1,
FFEINFO_kindtypeINTEGER2,
FFEINFO_kindtypeINTEGER3,
FFEINFO_kindtypeINTEGER4,
FFEINFO_kindtypeINTEGER5,
FFEINFO_kindtypeINTEGER6,
FFEINFO_kindtypeINTEGER7,
FFEINFO_kindtypeINTEGER8,
FFEINFO_kindtypeLOGICAL1 = 1, /* Ok to omit, but ok to overlap. */
FFEINFO_kindtypeLOGICAL2,
FFEINFO_kindtypeLOGICAL3,
FFEINFO_kindtypeLOGICAL4,
FFEINFO_kindtypeLOGICAL5,
FFEINFO_kindtypeLOGICAL6,
FFEINFO_kindtypeLOGICAL7,
FFEINFO_kindtypeLOGICAL8,
FFEINFO_kindtypeREAL1 = 1, /* Ok to omit, but ok to overlap. */
FFEINFO_kindtypeREAL2,
FFEINFO_kindtypeREAL3,
FFEINFO_kindtypeREAL4,
FFEINFO_kindtypeREAL5,
FFEINFO_kindtypeREAL6,
FFEINFO_kindtypeREAL7,
FFEINFO_kindtypeREAL8,
FFEINFO_kindtypeCHARACTER1 = 1, /* Ok to omit, but ok to overlap. */
FFEINFO_kindtypeCHARACTER2,
FFEINFO_kindtypeCHARACTER3,
FFEINFO_kindtypeCHARACTER4,
FFEINFO_kindtypeCHARACTER5,
FFEINFO_kindtypeCHARACTER6,
FFEINFO_kindtypeCHARACTER7,
FFEINFO_kindtypeCHARACTER8,
FFEINFO_kindtypeANY,
FFEINFO_kindtype
} ffeinfoKindtype;
typedef enum
{
#define FFEINFO_KIND(KWD,LNAM,SNAM) KWD,
#include "info-k.def"
#undef FFEINFO_KIND
FFEINFO_kind
} ffeinfoKind;
typedef enum
{
#define FFEINFO_WHERE(KWD,LNAM,SNAM) KWD,
#include "info-w.def"
#undef FFEINFO_WHERE
FFEINFO_where
} ffeinfoWhere;
/* Typedefs. */
typedef struct _ffeinfo_ ffeinfo;
typedef char ffeinfoRank;
/* Include files needed by this one. */
#include "target.h"
#include "type.h"
/* Structure definitions. */
struct _ffeinfo_
{
ffeinfoBasictype basictype;
ffeinfoKindtype kindtype;
ffeinfoRank rank;
ffeinfoKind kind;
ffeinfoWhere where;
ffetargetCharacterSize size;
};
/* Global objects accessed by users of this module. */
/* Declare functions with prototypes. */
ffeinfoBasictype ffeinfo_basictype_combine (ffeinfoBasictype l,
ffeinfoBasictype r);
const char *ffeinfo_basictype_string (ffeinfoBasictype basictype);
void ffeinfo_init_0 (void);
const char *ffeinfo_kind_message (ffeinfoKind kind);
const char *ffeinfo_kind_string (ffeinfoKind kind);
ffeinfoKindtype ffeinfo_kindtype_max(ffeinfoBasictype bt,
ffeinfoKindtype k1,
ffeinfoKindtype k2);
const char *ffeinfo_kindtype_string (ffeinfoKindtype kind_type);
const char *ffeinfo_where_string (ffeinfoWhere where);
ffeinfo ffeinfo_new (ffeinfoBasictype basictype, ffeinfoKindtype kindtype,
ffeinfoRank rank, ffeinfoKind kind, ffeinfoWhere where,
ffetargetCharacterSize size);
void ffeinfo_set_type (ffeinfoBasictype basictype, ffeinfoKindtype kindtype,
ffetype type);
ffetype ffeinfo_type (ffeinfoBasictype basictype, ffeinfoKindtype kindtype);
/* Define macros. */
#define ffeinfo_basictype(i) (i.basictype)
#define ffeinfo_init_1()
#define ffeinfo_init_2()
#define ffeinfo_init_3()
#define ffeinfo_init_4()
#define ffeinfo_kind(i) (i.kind)
#define ffeinfo_kindtype(i) (i.kindtype)
#ifdef __GNUC__
#define ffeinfo_new(bt,kt,r,k,w,sz) \
((ffeinfo) {(bt), (kt), (r), (k), (w), (sz)})
#endif
#define ffeinfo_new_any() \
ffeinfo_new (FFEINFO_basictypeANY, FFEINFO_kindtypeANY, 0, \
FFEINFO_kindANY, FFEINFO_whereANY, \
FFETARGET_charactersizeNONE)
#define ffeinfo_new_null() \
ffeinfo_new (FFEINFO_basictypeNONE, FFEINFO_kindtypeNONE, 0, \
FFEINFO_kindNONE, FFEINFO_whereNONE, \
FFETARGET_charactersizeNONE)
#define ffeinfo_rank(i) (i.rank)
#define ffeinfo_size(i) (i.size)
#define ffeinfo_terminate_0()
#define ffeinfo_terminate_1()
#define ffeinfo_terminate_2()
#define ffeinfo_terminate_3()
#define ffeinfo_terminate_4()
#define ffeinfo_use(i) i
#define ffeinfo_where(i) (i.where)
#define FFEINFO_kindtypeINTEGERDEFAULT FFEINFO_kindtypeINTEGER1
#define FFEINFO_kindtypeLOGICALDEFAULT FFEINFO_kindtypeLOGICAL1
#define FFEINFO_kindtypeREALDEFAULT FFEINFO_kindtypeREAL1
#define FFEINFO_kindtypeREALDOUBLE FFEINFO_kindtypeREAL2
#define FFEINFO_kindtypeREALQUAD FFEINFO_kindtypeREAL3
#define FFEINFO_kindtypeCHARACTERDEFAULT FFEINFO_kindtypeCHARACTER1
/* End of #include file. */
#endif /* ! GCC_F_INFO_H */

1325
gcc/f/intdoc.c
View file

File diff suppressed because it is too large Load diff

2705
gcc/f/intdoc.in
View file

File diff suppressed because it is too large Load diff

10931
gcc/f/intdoc.texi
View file

File diff suppressed because it is too large Load diff

2119
gcc/f/intrin.c
View file

File diff suppressed because it is too large Load diff

3358
gcc/f/intrin.def
View file

File diff suppressed because it is too large Load diff

135
gcc/f/intrin.h
View file

@ -1,135 +0,0 @@
/* intrin.h -- Public interface for intrin.c
Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
*/
#ifndef GCC_F_INTRIN_H
#define GCC_F_INTRIN_H
#ifndef FFEINTRIN_DOC
#define FFEINTRIN_DOC 0 /* 1 means intrinsic documentation only (intdoc.c). */
#endif
typedef enum
{
FFEINTRIN_familyNONE, /* Not in any family. */
FFEINTRIN_familyF77, /* ANSI FORTRAN 77. */
FFEINTRIN_familyGNU, /* GNU Fortran intrinsics. */
FFEINTRIN_familyF2C, /* f2c intrinsics. */
FFEINTRIN_familyF90, /* Fortran 90. */
FFEINTRIN_familyF95 = FFEINTRIN_familyF90,
FFEINTRIN_familyVXT, /* VAX/VMS FORTRAN. */
FFEINTRIN_familyMIL, /* MIL STD 1753 (MVBITS, etc), in mil, vxt, and f90. */
FFEINTRIN_familyASC, /* ASCII-related (ACHAR, IACHAR), both f2c and f90. */
FFEINTRIN_familyFVZ, /* in both f2c and VAX/VMS FORTRAN. */
FFEINTRIN_familyF2U, /* libf2c/libU77 UNIX system intrinsics. */
FFEINTRIN_familyBADU77, /* libU77 UNIX system intrinsics with bad form. */
FFEINTRIN_family
} ffeintrinFamily;
typedef enum
{
#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
#define DEFGEN(CODE,NAME,SPEC1,SPEC2) FFEINTRIN_gen ## CODE,
#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
#include "intrin.def"
#undef DEFNAME
#undef DEFGEN
#undef DEFSPEC
#undef DEFIMP
#undef DEFIMPY
FFEINTRIN_gen
} ffeintrinGen;
typedef enum
{
#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) FFEINTRIN_spec ## CODE,
#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
#include "intrin.def"
#undef DEFNAME
#undef DEFGEN
#undef DEFSPEC
#undef DEFIMP
#undef DEFIMPY
FFEINTRIN_spec
} ffeintrinSpec;
typedef enum
{
#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \
FFEINTRIN_imp ## CODE,
#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) \
FFEINTRIN_imp ## CODE,
#include "intrin.def"
#undef DEFNAME
#undef DEFGEN
#undef DEFSPEC
#undef DEFIMP
#undef DEFIMPY
FFEINTRIN_imp
} ffeintrinImp;
#if !FFEINTRIN_DOC
#include "bld.h"
#include "info.h"
ffeinfoBasictype ffeintrin_basictype (ffeintrinSpec spec);
ffeintrinFamily ffeintrin_family (ffeintrinSpec spec);
void ffeintrin_fulfill_generic (ffebld *expr, ffeinfo *info, ffelexToken t);
void ffeintrin_fulfill_specific (ffebld *expr, ffeinfo *info,
bool *check_intrin, ffelexToken t);
ffecomGfrt ffeintrin_gfrt_direct (ffeintrinImp imp);
ffecomGfrt ffeintrin_gfrt_indirect (ffeintrinImp imp);
void ffeintrin_init_0 (void);
#define ffeintrin_init_1()
#define ffeintrin_init_2()
#define ffeintrin_init_3()
#define ffeintrin_init_4()
bool ffeintrin_is_actualarg (ffeintrinSpec spec);
bool ffeintrin_is_intrinsic (const char *name, ffelexToken t, bool explicit,
ffeintrinGen *gen, ffeintrinSpec *spec,
ffeintrinImp *imp);
bool ffeintrin_is_standard (ffeintrinGen gen, ffeintrinSpec spec);
ffeinfoKindtype ffeintrin_kindtype (ffeintrinSpec spec);
const char *ffeintrin_name_generic (ffeintrinGen gen);
const char *ffeintrin_name_implementation (ffeintrinImp imp);
const char *ffeintrin_name_specific (ffeintrinSpec spec);
ffeIntrinsicState ffeintrin_state_family (ffeintrinFamily family);
#define ffeintrin_terminate_0()
#define ffeintrin_terminate_1()
#define ffeintrin_terminate_2()
#define ffeintrin_terminate_3()
#define ffeintrin_terminate_4()
#endif /* !FFEINTRIN_DOC */
/* End of #include file. */
#endif /* ! GCC_F_INTRIN_H */

2233
gcc/f/invoke.texi
View file

File diff suppressed because it is too large Load diff

157
gcc/f/lab.c
View file

@ -1,157 +0,0 @@
/* lab.c -- Implementation File (module.c template V1.0)
Copyright (C) 1995, 2003 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Related Modules:
Description:
Complex data abstraction for Fortran labels. Maintains a single master
list for all labels; it is expected initialization and termination of
this list will occur on program-unit boundaries.
Modifications:
22-Aug-89 JCB 1.1
Change ffelab_new for new ffewhere interface.
*/
/* Include files. */
#include "proj.h"
#include "lab.h"
#include "malloc.h"
/* Externals defined here. */
ffelab ffelab_list_;
ffelabNumber ffelab_num_news_;
/* Simple definitions and enumerations. */
/* Internal typedefs. */
/* Private include files. */
/* Internal structure definitions. */
/* Static objects accessed by functions in this module. */
/* Static functions (internal). */
/* Internal macros. */
/* ffelab_find -- Find the ffelab object having the desired label value
ffelab l;
ffelabValue v;
l = ffelab_find(v);
If the desired ffelab object doesn't exist, returns NULL.
Straightforward search of list of ffelabs. */
ffelab
ffelab_find (ffelabValue v)
{
ffelab l;
for (l = ffelab_list_; (l != NULL) && (ffelab_value (l) != v); l = l->next)
;
return l;
}
/* ffelab_finish -- Shut down label management
ffelab_finish();
At the end of processing a program unit, call this routine to shut down
label management.
Kill all the labels on the list. */
void
ffelab_finish (void)
{
ffelab l;
ffelab pl;
for (pl = NULL, l = ffelab_list_; l != NULL; pl = l, l = l->next)
if (pl != NULL)
malloc_kill_ks (ffe_pool_any_unit (), pl, sizeof (*pl));
if (pl != NULL)
malloc_kill_ks (ffe_pool_any_unit (), pl, sizeof (*pl));
}
/* ffelab_init_3 -- Initialize label management system
ffelab_init_3();
Initialize the label management system. Do this before a new program
unit is going to be processed. */
void
ffelab_init_3 (void)
{
ffelab_list_ = NULL;
ffelab_num_news_ = 0;
}
/* ffelab_new -- Create an ffelab object.
ffelab l;
ffelabValue v;
l = ffelab_new(v);
Create a label having a given value. If the value isn't known, pass
FFELAB_valueNONE, and set it later with ffelab_set_value.
Allocate, initialize, and stick at top of label list.
22-Aug-89 JCB 1.1
Change for new ffewhere interface. */
ffelab
ffelab_new (ffelabValue v)
{
ffelab l;
++ffelab_num_news_;
l = malloc_new_ks (ffe_pool_any_unit (), "FFELAB label", sizeof (*l));
l->next = ffelab_list_;
l->hook = FFECOM_labelNULL;
l->value = v;
l->firstref_line = ffewhere_line_unknown ();
l->firstref_col = ffewhere_column_unknown ();
l->doref_line = ffewhere_line_unknown ();
l->doref_col = ffewhere_column_unknown ();
l->definition_line = ffewhere_line_unknown ();
l->definition_col = ffewhere_column_unknown ();
l->type = FFELAB_typeUNKNOWN;
ffelab_list_ = l;
return l;
}

152
gcc/f/lab.h
View file

@ -1,152 +0,0 @@
/* lab.h -- Public #include File (module.h template V1.0)
Copyright (C) 1995, 2003 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Owning Modules:
lab.c
Modifications:
22-Aug-89 JCB 1.1
Change for new ffewhere interface.
*/
/* Allow multiple inclusion to work. */
#ifndef GCC_F_LAB_H
#define GCC_F_LAB_H
/* Simple definitions and enumerations. */
typedef enum
{
FFELAB_typeUNKNOWN, /* No info yet on label. */
FFELAB_typeANY, /* Label valid for anything, no msgs. */
FFELAB_typeUSELESS, /* No valid way to reference this label. */
FFELAB_typeASSIGNABLE, /* Target of ASSIGN: so FORMAT or BRANCH. */
FFELAB_typeFORMAT, /* FORMAT label. */
FFELAB_typeLOOPEND, /* Target of a labeled DO statement. */
FFELAB_typeNOTLOOP, /* Branch target statement not valid DO
target. */
FFELAB_typeENDIF, /* END IF label. */
FFELAB_type
} ffelabType;
#define FFELAB_valueNONE 0
#define FFELAB_valueMAX 99999
/* Typedefs. */
typedef struct _ffelab_ *ffelab;
typedef ffelab ffelabHandle;
typedef unsigned long ffelabNumber; /* Count of new labels. */
#define ffelabNumber_f "l"
typedef unsigned long ffelabValue;
#define ffelabValue_f "l"
/* Include files needed by this one. */
#include "com.h"
#include "where.h"
/* Structure definitions. */
struct _ffelab_
{
ffelab next;
ffecomLabel hook;
ffelabValue value; /* 1 through 99999, or 100000+ for temp
labels. */
unsigned long blocknum; /* Managed entirely by user of module. */
ffewhereLine firstref_line;
ffewhereColumn firstref_col;
ffewhereLine doref_line;
ffewhereColumn doref_col;
ffewhereLine definition_line; /* ffewhere_line_unknown() if not
defined. */
ffewhereColumn definition_col;
ffelabType type;
};
/* Global objects accessed by users of this module. */
extern ffelab ffelab_list_;
extern ffelabNumber ffelab_num_news_;
/* Declare functions with prototypes. */
ffelab ffelab_find (ffelabValue v);
void ffelab_finish (void);
void ffelab_init_3 (void);
ffelab ffelab_new (ffelabValue v);
/* Define macros. */
#define ffelab_blocknum(l) ((l)->blocknum)
#define ffelab_definition_column(l) ((l)->definition_col)
#define ffelab_definition_filename(l) \
ffewhere_line_filename((l)->definition_line)
#define ffelab_definition_filelinenum(l) \
ffewhere_line_filelinenum((l)->definition_line)
#define ffelab_definition_line(l) ((l)->definition_line)
#define ffelab_definition_line_number(l) \
ffewhere_line_number((l)->definition_line)
#define ffelab_doref_column(l) ((l)->doref_col)
#define ffelab_doref_filename(l) ffewhere_line_filename((l)->doref_line)
#define ffelab_doref_filelinenum(l) ffewhere_line_filelinenum((l)->doref_line)
#define ffelab_doref_line(l) ((l)->doref_line)
#define ffelab_doref_line_number(l) ffewhere_line_number((l)->doref_line)
#define ffelab_firstref_column(l) ((l)->firstref_col)
#define ffelab_firstref_filename(l) ffewhere_line_filename((l)->firstref_line)
#define ffelab_firstref_filelinenum(l) \
ffewhere_line_filelinenum((l)->firstref_line)
#define ffelab_firstref_line(l) ((l)->firstref_line)
#define ffelab_firstref_line_number(l) ffewhere_line_number((l)->firstref_line)
#define ffelab_handle_done(h)
#define ffelab_handle_first() ((ffelabHandle) ffelab_list_)
#define ffelab_handle_next(h) ((ffelabHandle) (((ffelab) h)->next))
#define ffelab_handle_target(h) ((ffelab) h)
#define ffelab_hook(l) ((l)->hook)
#define ffelab_init_0()
#define ffelab_init_1()
#define ffelab_init_2()
#define ffelab_init_4()
#define ffelab_kill(l) ffelab_set_value(l,FFELAB_valueNONE);
#define ffelab_new_generated() (ffelab_new(ffelab_generated_++))
#define ffelab_number() (ffelab_num_news_)
#define ffelab_set_blocknum(l,b) ((l)->blocknum = (b))
#define ffelab_set_definition_column(l,cn) ((l)->definition_col = (cn))
#define ffelab_set_definition_line(l,ln) ((l)->definition_line = (ln))
#define ffelab_set_doref_column(l,cn) ((l)->doref_col = (cn))
#define ffelab_set_doref_line(l,ln) ((l)->doref_line = (ln))
#define ffelab_set_firstref_column(l,cn) ((l)->firstref_col = (cn))
#define ffelab_set_firstref_line(l,ln) ((l)->firstref_line = (ln))
#define ffelab_set_hook(l,h) ((l)->hook = (h))
#define ffelab_set_type(l,t) ((l)->type = (t))
#define ffelab_terminate_0()
#define ffelab_terminate_1()
#define ffelab_terminate_2()
#define ffelab_terminate_3()
#define ffelab_terminate_4()
#define ffelab_type(l) ((l)->type)
#define ffelab_value(l) ((l)->value)
/* End of #include file. */
#endif /* ! GCC_F_LAB_H */

47
gcc/f/lang-specs.h
View file

@ -1,47 +0,0 @@
/* lang-specs.h file for Fortran
Copyright (C) 1995, 1996, 1997, 1999, 2000, 2002, 2003
Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
*/
/* This is the contribution to the `default_compilers' array in gcc.c for
g77. */
{".F", "@f77-cpp-input", 0, 0, 0},
{".fpp", "@f77-cpp-input", 0, 0, 0},
{".FPP", "@f77-cpp-input", 0, 0, 0},
{"@f77-cpp-input",
"cc1 -E -traditional-cpp -D_LANGUAGE_FORTRAN %(cpp_options) \
%{E|M|MM:%(cpp_debug_options)}\
%{!M:%{!MM:%{!E: -o %|.f |\n\
f771 %|.f %(cc1_options) %{I*} %{!fsyntax-only:%(invoke_as)}}}}", 0, 0, 0},
{".r", "@ratfor", 0, 0, 0},
{"@ratfor",
"%{C:%{!E:%eGCC does not support -C without using -E}}\
%{CC:%{!E:%eGCC does not support -CC without using -E}}\
ratfor %{C} %{CC} %{v} %{E:%W{o*}} %{!E: %{!pipe:-o %g.f} %i |\n\
f771 %m.f %(cc1_options) %{I*} %{!fsyntax-only:%(invoke_as)}}", 0, 0, 0},
{".f", "@f77", 0, 0, 0},
{".for", "@f77", 0, 0, 0},
{".FOR", "@f77", 0, 0, 0},
{"@f77",
"%{!M:%{!MM:%{!E:f771 %i %(cc1_options) %{I*}\
%{!fsyntax-only:%(invoke_as)}}}}", 0, 0, 0},

402
gcc/f/lang.opt
View file

@ -1,402 +0,0 @@
; Options for the Fortran 77 front end.
; Copyright (C) 2003 Free Software Foundation, Inc.
;
; This file is part of GCC.
;
; GCC is free software; you can redistribute it and/or modify it under
; the terms of the GNU General Public License as published by the Free
; Software Foundation; either version 2, or (at your option) any later
; version.
;
; GCC is distributed in the hope that it will be useful, but WITHOUT 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
; along with GCC; see the file COPYING. If not, write to the Free
; Software Foundation, 59 Temple Place - Suite 330, Boston, MA
; 02111-1307, USA.
; See c.opt for a description of this file's format.
; Please try to keep this file in ASCII collating order.
Language
F77
I
F77 Joined
Add a directory for INCLUDE searching
Wall
F77
; Documented in C
Wcomment
F77
Wcomments
F77
Wglobals
F77
Enable warnings about inter-procedural problems
Wimplicit
F77
Wimport
F77
Wsurprising
F77
Warn about constructs with surprising meanings
Wtrigraphs
F77
fautomatic
F77
Do not treat local variables and COMMON blocks as if they were named in SAVE statements
fbackslash
F77
Backslashes in character and hollerith constants are special (not C-style)
fbadu77-intrinsics-delete
F77 RejectNegative
Delete libU77 intrinsics with bad interfaces
fbadu77-intrinsics-disable
F77 RejectNegative
Disable libU77 intrinsics with bad interfaces
fbadu77-intrinsics-enable
F77 RejectNegative
Enable libU77 intrinsics with bad interfaces
fbadu77-intrinsics-hide
F77 RejectNegative
Hide libU77 intrinsics with bad interfaces
fcase-initcap
F77 RejectNegative
Program written in strict mixed-case
fcase-lower
F77 RejectNegative
Compile as if program written in lowercase
fcase-preserve
F77 RejectNegative
Preserve case used in program
fcase-strict-lower
F77 RejectNegative
Program written in lowercase
fcase-strict-upper
F77 RejectNegative
Program written in uppercase
fcase-upper
F77 RejectNegative
Compile as if program written in uppercase
fdebug-kludge
F77
Emit special debugging information for COMMON and EQUIVALENCE (disabled)
fdollar-ok
F77
Allow '$' in symbol names
femulate-complex
F77
Have front end emulate COMPLEX arithmetic to avoid bugs
ff2c
F77
f2c-compatible code can be generated
ff2c-intrinsics-delete
F77 RejectNegative
Delete non-FORTRAN-77 intrinsics f2c supports
ff2c-intrinsics-disable
F77 RejectNegative
Disable non-FORTRAN-77 intrinsics f2c supports
ff2c-intrinsics-enable
F77 RejectNegative
Enable non-FORTRAN-77 intrinsics f2c supports
ff2c-intrinsics-hide
F77 RejectNegative
Hide non-FORTRAN-77 intrinsics f2c supports
ff2c-library
F77
Unsupported; generate libf2c-calling code
ff66
F77
Program is written in typical FORTRAN 66 dialect
ff77
F77
Program is written in typical Unix-f77 dialect
ff90
F77
Program is written in Fortran-90-ish dialect
ff90-intrinsics-delete
F77 RejectNegative
Delete non-FORTRAN-77 intrinsics F90 supports
ff90-intrinsics-disable
F77 RejectNegative
Disable non-FORTRAN-77 intrinsics F90 supports
ff90-intrinsics-enable
F77 RejectNegative
Enable non-FORTRAN-77 intrinsics F90 supports
ff90-intrinsics-hide
F77 RejectNegative
Hide non-FORTRAN-77 intrinsics F90 supports
ff90-not-vxt
F77 RejectNegative
ffixed-form
F77
ffixed-line-length-
F77 Joined
ffixed-line-length-<number> Set the maximum line length to <number>
fflatten-arrays
F77
Unsupported; affects code generation of arrays
ffortran-bounds-check
F77
Generate code to check subscript and substring bounds
ffree-form
F77
Program is written in Fortran-90-ish free form
fglobals
F77
Enable fatal diagnostics about inter-procedural problems
fgnu-intrinsics-delete
F77 RejectNegative
Delete non-FORTRAN-77 intrinsics g77 supports
fgnu-intrinsics-disable
F77 RejectNegative
Disable non-FORTRAN 77 intrinsics F90 supports
fgnu-intrinsics-enable
F77 RejectNegative
Enable non-FORTRAN 77 intrinsics F90 supports
fgnu-intrinsics-hide
F77 RejectNegative
Hide non-FORTRAN 77 intrinsics F90 supports
finit-local-zero
F77
Initialize local vars and arrays to zero
fintrin-case-any
F77 RejectNegative
Intrinsics letters in arbitrary cases
fintrin-case-initcap
F77 RejectNegative
Intrinsics spelled as e.g. SqRt
fintrin-case-lower
F77 RejectNegative
Intrinsics in lowercase
fintrin-case-upper
F77 RejectNegative
Intrinsics in uppercase
fmatch-case-any
F77 RejectNegative
Language keyword letters in arbitrary cases
fmatch-case-initcap
F77 RejectNegative
Language keywords spelled as e.g. IOStat
fmatch-case-lower
F77 RejectNegative
Language keywords in lowercase
fmatch-case-upper
F77 RejectNegative
Language keywords in uppercase
fmil-intrinsics-delete
F77 RejectNegative
Delete MIL-STD 1753 intrinsics
fmil-intrinsics-disable
F77 RejectNegative
Disable MIL-STD 1753 intrinsics
fmil-intrinsics-enable
F77 RejectNegative
Enable MIL-STD 1753 intrinsics
fmil-intrinsics-hide
F77 RejectNegative
Hide MIL-STD 1753 intrinsics
fonetrip
F77
Take at least one trip through each iterative DO loop
fpedantic
F77
Warn about use of (only a few for now) Fortran extensions
fpreprocessed
F77
fsecond-underscore
F77
Allow appending a second underscore to externals
fsilent
F77
Do not print names of program units as they are compiled
fsource-case-lower
F77 RejectNegative
Internally convert most source to lowercase
fsource-case-preserve
F77 RejectNegative
Internally preserve source case
fsource-case-upper
F77 RejectNegative
Internally convert most source to uppercase
fsymbol-case-any
F77 RejectNegative
fsymbol-case-initcap
F77 RejectNegative
Symbol names spelled in mixed case
fsymbol-case-lower
F77 RejectNegative
Symbol names in lowercase
fsymbol-case-upper
F77 RejectNegative
Symbol names in uppercase
ftypeless-boz
F77
Make prefix-radix non-decimal constants be typeless
fugly
F77
Allow all ugly features
fugly-args
F77
Hollerith and typeless can be passed as arguments
fugly-assign
F77
Allow ordinary copying of ASSIGN'ed vars
fugly-assumed
F77
Dummy array dimensioned to (1) is assumed-size
fugly-comma
F77
Trailing comma in procedure call denotes null argument
fugly-complex
F77
Allow REAL(Z) and AIMAG(Z) given DOUBLE COMPLEX Z
fugly-init
F77
Initialization via DATA and PARAMETER is not type-compatible
fugly-logint
F77
Allow INTEGER and LOGICAL interchangeability
funderscoring
F77
Append underscores to externals
funix-intrinsics-delete
F77 RejectNegative
Delete libU77 intrinsics
funix-intrinsics-disable
F77 RejectNegative
Disable libU77 intrinsics
funix-intrinsics-enable
F77 RejectNegative
Enable libU77 intrinsics
funix-intrinsics-hide
F77 RejectNegative
Hide libU77 intrinsics
fversion
F77 RejectNegative
Print g77-specific version information and run internal tests
fvxt
F77
Program is written in VXT (Digital-like) FORTRAN
fvxt-intrinsics-delete
F77 RejectNegative
Delete non-FORTRAN-77 intrinsics VXT FORTRAN supports
fvxt-intrinsics-disable
F77 RejectNegative
Disable non-FORTRAN-77 intrinsics VXT FORTRAN supports
fvxt-intrinsics-enable
F77 RejectNegative
Enable non-FORTRAN-77 intrinsics VXT FORTRAN supports
fvxt-intrinsics-hide
F77 RejectNegative
Hide non-FORTRAN-77 intrinsics VXT FORTRAN supports
fvxt-not-f90
F77 RejectNegative
fxyzzy
F77
Print internal debugging-related information
fzeros
F77
Treat initial values of 0 like non-zero values
; This comment is to ensure we retain the blank line above.

4575
gcc/f/lex.c
View file

File diff suppressed because it is too large Load diff

200
gcc/f/lex.h
View file

@ -1,200 +0,0 @@
/* lex.h -- Public #include File (module.h template V1.0)
Copyright (C) 1995 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Owning Modules:
lex.c
Modifications:
22-Aug-89 JCB 1.1
Change for new ffewhere interface.
*/
/* Allow multiple inclusion to work. */
#ifndef GCC_F_LEX_H
#define GCC_F_LEX_H
/* Simple definitions and enumerations. */
typedef enum
{
FFELEX_typeNONE,
FFELEX_typeCOMMENT,
FFELEX_typeEOS,
FFELEX_typeEOF,
FFELEX_typeERROR,
FFELEX_typeRAW,
FFELEX_typeQUOTE,
FFELEX_typeDOLLAR,
FFELEX_typeHASH,
FFELEX_typePERCENT,
FFELEX_typeAMPERSAND,
FFELEX_typeAPOSTROPHE,
FFELEX_typeOPEN_PAREN,
FFELEX_typeCLOSE_PAREN,
FFELEX_typeASTERISK,
FFELEX_typePLUS,
FFELEX_typeMINUS,
FFELEX_typePERIOD,
FFELEX_typeSLASH,
FFELEX_typeNUMBER, /* Grep: [0-9][0-9]*. */
FFELEX_typeOPEN_ANGLE,
FFELEX_typeEQUALS,
FFELEX_typeCLOSE_ANGLE,
FFELEX_typeNAME, /* Grep: [A-Za-z][A-Za-z0-9_]*. */
FFELEX_typeCOMMA,
FFELEX_typePOWER, /* "**". */
FFELEX_typeCONCAT, /* "//". */
FFELEX_typeDEBUG,
FFELEX_typeNAMES, /* Same as FFELEX_typeNAME in initial
context. */
FFELEX_typeHOLLERITH, /* <text> part of <nn>H<text>. */
FFELEX_typeCHARACTER, /* <text> part of '<text>' or "<text>". */
FFELEX_typeCOLON,
FFELEX_typeSEMICOLON,
FFELEX_typeUNDERSCORE,
FFELEX_typeQUESTION,
FFELEX_typeOPEN_ARRAY, /* "(/". */
FFELEX_typeCLOSE_ARRAY, /* "/)". */
FFELEX_typeCOLONCOLON, /* "::". */
FFELEX_typeREL_LE, /* "<=". */
FFELEX_typeREL_NE, /* "<>". */
FFELEX_typeREL_EQ, /* "==". */
FFELEX_typePOINTS, /* "=>". */
FFELEX_typeREL_GE, /* ">=". */
FFELEX_type
} ffelexType;
/* Typedefs. */
typedef struct _lextoken_ *ffelexToken;
typedef void *lex_sigh_;
typedef lex_sigh_ (*lex_sigh__) (ffelexToken);
typedef lex_sigh__ (*ffelexHandler) (ffelexToken);
/* Include files needed by this one. */
#include "top.h"
#include "where.h"
/* Structure definitions. */
struct _lextoken_
{
long int id_; /* DEBUG ONLY. */
ffeTokenLength size;
ffeTokenLength length;
unsigned short uses;
char *text;
ffelexType type;
ffewhereLine where_line;
ffewhereColumn where_col;
ffewhereLine currentnames_line; /* For tracking NAMES tokens. */
ffewhereColumn currentnames_col; /* For tracking NAMES tokens. */
ffewhereTrack wheretrack; /* For tracking NAMES tokens. */
};
/* Global objects accessed by users of this module. */
/* Declare functions with prototypes. */
void ffelex_display_token (ffelexToken t);
bool ffelex_expecting_character (void);
ffelexHandler ffelex_file_fixed (ffewhereFile wf, FILE *f);
ffelexHandler ffelex_file_free (ffewhereFile wf, FILE *f);
void ffelex_hash_kludge (FILE *f);
void ffelex_init_1 (void);
bool ffelex_is_names_expected (void);
char *ffelex_line (void);
ffewhereColumnNumber ffelex_line_length (void);
ffewhereLineNumber ffelex_line_number (void);
void ffelex_set_expecting_hollerith (long length, char which,
ffewhereLine line,
ffewhereColumn column);
void ffelex_set_handler (ffelexHandler first);
void ffelex_set_hexnum (bool on);
void ffelex_set_include (ffewhereFile wf, bool free_form, FILE *fi);
void ffelex_set_names (bool on);
void ffelex_set_names_pure (bool on);
ffelexHandler ffelex_splice_tokens (ffelexHandler first, ffelexToken master,
ffeTokenLength start);
ffelexHandler ffelex_swallow_tokens (ffelexToken t, ffelexHandler handler);
ffelexToken ffelex_token_dollar_from_names (ffelexToken t,
ffeTokenLength start);
void ffelex_token_kill (ffelexToken t);
ffelexToken ffelex_token_name_from_names (ffelexToken t,
ffeTokenLength start,
ffeTokenLength len);
ffelexToken ffelex_token_names_from_names (ffelexToken t,
ffeTokenLength start,
ffeTokenLength len);
ffelexToken ffelex_token_new (void);
ffelexToken ffelex_token_new_character (const char *s, ffewhereLine l,
ffewhereColumn c);
ffelexToken ffelex_token_new_eof (void);
ffelexToken ffelex_token_new_name (const char *s, ffewhereLine l,
ffewhereColumn c);
ffelexToken ffelex_token_new_names (const char *s, ffewhereLine l,
ffewhereColumn c);
ffelexToken ffelex_token_new_number (const char *s, ffewhereLine l,
ffewhereColumn c);
ffelexToken ffelex_token_new_simple_ (ffelexType type, ffewhereLine l,
ffewhereColumn c);
ffelexToken ffelex_token_number_from_names (ffelexToken t,
ffeTokenLength start);
ffelexToken ffelex_token_uscore_from_names (ffelexToken t,
ffeTokenLength start);
ffelexToken ffelex_token_use (ffelexToken t);
/* Define macros. */
#define ffelex_init_0()
#define ffelex_init_2()
#define ffelex_init_3()
#define ffelex_init_4()
#define ffelex_is_firstnamechar(c) ISIDST (c)
#define ffelex_terminate_0()
#define ffelex_terminate_1()
#define ffelex_terminate_2()
#define ffelex_terminate_3()
#define ffelex_terminate_4()
#define ffelex_token_length(t) ((t)->length)
#define ffelex_token_new_eos(l,c) \
ffelex_token_new_simple_ (FFELEX_typeEOS, (l), (c))
#define ffelex_token_new_period(l,c) \
ffelex_token_new_simple_ (FFELEX_typePERIOD, (l), (c))
#define ffelex_token_strcmp(t1,t2) strcmp ((t1)->text, (t2)->text)
#define ffelex_token_text(t) ((t)->text)
#define ffelex_token_type(t) ((t)->type)
#define ffelex_token_where_column(t) ((t)->where_col)
#define ffelex_token_where_filename(t) \
ffewhere_line_filename ((t)->where_line)
#define ffelex_token_where_filelinenum(t) \
ffewhere_line_filelinenum((t)->where_line)
#define ffelex_token_where_line(t) ((t)->where_line)
#define ffelex_token_where_line_number(t) \
ffewhere_line_number ((t)->where_line)
#define ffelex_token_wheretrack(t) ((t)->wheretrack)
/* End of #include file. */
#endif /* ! GCC_F_LEX_H */

551
gcc/f/malloc.c
View file

@ -1,551 +0,0 @@
/* malloc.c -- Implementation File (module.c template V1.0)
Copyright (C) 1995, 2003 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Related Modules:
None
Description:
Fast pool-based memory allocation.
Modifications:
*/
/* Include files. */
#include "proj.h"
#include "malloc.h"
/* Externals defined here. */
struct _malloc_root_ malloc_root_
=
{
{
&malloc_root_.malloc_pool_image_,
&malloc_root_.malloc_pool_image_,
(mallocPool) &malloc_root_.malloc_pool_image_.eldest,
(mallocPool) &malloc_root_.malloc_pool_image_.eldest,
(mallocArea_) &malloc_root_.malloc_pool_image_.first,
(mallocArea_) &malloc_root_.malloc_pool_image_.first,
0,
#if MALLOC_DEBUG
0, 0, 0, 0, 0, 0, 0, { '/' }
#else
{ 0 }
#endif
},
};
/* Simple definitions and enumerations. */
/* Internal typedefs. */
/* Private include files. */
/* Internal structure definitions. */
/* Static objects accessed by functions in this module. */
static void *malloc_reserve_ = NULL; /* For crashes. */
#if MALLOC_DEBUG
static const char *const malloc_types_[] =
{"KS", "KSR", "NF", "NFR", "US", "USR"};
#endif
/* Static functions (internal). */
static void malloc_kill_area_ (mallocPool pool, mallocArea_ a);
#if MALLOC_DEBUG
static void malloc_verify_area_ (mallocPool pool, mallocArea_ a);
#endif
/* Internal macros. */
#if MALLOC_DEBUG
#define malloc_kill_(ptr,s) do {memset((ptr),127,(s));free((ptr));} while(0)
#else
#define malloc_kill_(ptr,s) free((ptr))
#endif
/* malloc_kill_area_ -- Kill storage area and its object
malloc_kill_area_(mallocPool pool,mallocArea_ area);
Does the actual killing of a storage area. */
static void
malloc_kill_area_ (mallocPool pool UNUSED, mallocArea_ a)
{
#if MALLOC_DEBUG
assert (strcmp (a->name, ((char *) (a->where)) + a->size) == 0);
#endif
malloc_kill_ (a->where, a->size);
a->next->previous = a->previous;
a->previous->next = a->next;
#if MALLOC_DEBUG
pool->freed += a->size;
pool->frees++;
#endif
malloc_kill_ (a,
offsetof (struct _malloc_area_, name)
+ strlen (a->name) + 1);
}
/* malloc_verify_area_ -- Verify storage area and its object
malloc_verify_area_(mallocPool pool,mallocArea_ area);
Does the actual verifying of a storage area. */
#if MALLOC_DEBUG
static void
malloc_verify_area_ (mallocPool pool UNUSED, mallocArea_ a UNUSED)
{
mallocSize s = a->size;
assert (strcmp (a->name, ((char *) (a->where)) + s) == 0);
}
#endif
/* malloc_init -- Initialize malloc cluster
malloc_init();
Call malloc_init before you do anything else. */
void
malloc_init (void)
{
if (malloc_reserve_ != NULL)
return;
malloc_reserve_ = xmalloc (20 * 1024); /* In case of crash, free this first. */
}
/* malloc_pool_display -- Display a pool
mallocPool p;
malloc_pool_display(p);
Displays information associated with the pool and its subpools. */
void
malloc_pool_display (mallocPool p UNUSED)
{
#if MALLOC_DEBUG
mallocPool q;
mallocArea_ a;
fprintf (dmpout, "Pool \"%s\": bytes allocated=%lu, freed=%lu, old sizes=%lu, new sizes\
=%lu,\n allocations=%lu, frees=%lu, resizes=%lu, uses=%lu\n Subpools:\n",
p->name, p->allocated, p->freed, p->old_sizes, p->new_sizes, p->allocations,
p->frees, p->resizes, p->uses);
for (q = p->eldest; q != (mallocPool) & p->eldest; q = q->next)
fprintf (dmpout, " \"%s\"\n", q->name);
fprintf (dmpout, " Storage areas:\n");
for (a = p->first; a != (mallocArea_) & p->first; a = a->next)
{
fprintf (dmpout, " ");
malloc_display_ (a);
}
#endif
}
/* malloc_pool_kill -- Destroy a pool
mallocPool p;
malloc_pool_kill(p);
Releases all storage associated with the pool and its subpools. */
void
malloc_pool_kill (mallocPool p)
{
mallocPool q;
mallocArea_ a;
if (--p->uses != 0)
return;
#if 0
malloc_pool_display (p);
#endif
assert (p->next->previous == p);
assert (p->previous->next == p);
/* Kill off all the subpools. */
while ((q = p->eldest) != (mallocPool) &p->eldest)
{
q->uses = 1; /* Force the kill. */
malloc_pool_kill (q);
}
/* Now free all the storage areas. */
while ((a = p->first) != (mallocArea_) & p->first)
{
malloc_kill_area_ (p, a);
}
/* Now remove from list of sibling pools. */
p->next->previous = p->previous;
p->previous->next = p->next;
/* Finally, free the pool itself. */
malloc_kill_ (p,
offsetof (struct _malloc_pool_, name)
+ strlen (p->name) + 1);
}
/* malloc_pool_new -- Make a new pool
mallocPool p;
p = malloc_pool_new("My new pool",malloc_pool_image(),1024);
Makes a new pool with the given name and default new-chunk allocation. */
mallocPool
malloc_pool_new (const char *name, mallocPool parent,
unsigned long chunks UNUSED)
{
mallocPool p;
if (parent == NULL)
parent = malloc_pool_image ();
p = malloc_new_ (offsetof (struct _malloc_pool_, name)
+ (MALLOC_DEBUG ? strlen (name) + 1 : 0));
p->next = (mallocPool) &(parent->eldest);
p->previous = parent->youngest;
parent->youngest->next = p;
parent->youngest = p;
p->eldest = (mallocPool) &(p->eldest);
p->youngest = (mallocPool) &(p->eldest);
p->first = (mallocArea_) &(p->first);
p->last = (mallocArea_) &(p->first);
p->uses = 1;
#if MALLOC_DEBUG
p->allocated = p->freed = p->old_sizes = p->new_sizes = p->allocations
= p->frees = p->resizes = 0;
strcpy (p->name, name);
#endif
return p;
}
/* malloc_pool_use -- Use an existing pool
mallocPool p;
p = malloc_pool_new(pool);
Increments use count for pool; means a matching malloc_pool_kill must
be performed before a subsequent one will actually kill the pool. */
mallocPool
malloc_pool_use (mallocPool pool)
{
++pool->uses;
return pool;
}
/* malloc_display_ -- Display info on a mallocArea_
mallocArea_ a;
malloc_display_(a);
Simple. */
void
malloc_display_ (mallocArea_ a UNUSED)
{
#if MALLOC_DEBUG
fprintf (dmpout, "At %08lX, size=%" mallocSize_f "u, type=%s, \"%s\"\n",
(unsigned long) a->where, a->size, malloc_types_[a->type], a->name);
#endif
}
/* malloc_find_inpool_ -- Find mallocArea_ for object in pool
mallocPool pool;
void *ptr;
mallocArea_ a;
a = malloc_find_inpool_(pool,ptr);
Search for object in list of mallocArea_s, die if not found. */
mallocArea_
malloc_find_inpool_ (mallocPool pool, void *ptr)
{
mallocArea_ a;
mallocArea_ b = (mallocArea_) &pool->first;
int n = 0;
for (a = pool->first; a != (mallocArea_) &pool->first; a = a->next)
{
assert (("Infinite loop detected" != NULL) && (a != b));
if (a->where == ptr)
return a;
++n;
if (n & 1)
b = b->next;
}
assert ("Couldn't find object in pool!" == NULL);
return NULL;
}
/* malloc_kill_inpool_ -- Kill object
malloc_kill_inpool_(NULL,MALLOC_typeUS_,ptr,size_in_bytes);
Find the mallocArea_ for the pointer, make sure the type is proper, and
kill both of them. */
void
malloc_kill_inpool_ (mallocPool pool, mallocType_ type UNUSED,
void *ptr, mallocSize s UNUSED)
{
mallocArea_ a;
if (pool == NULL)
pool = malloc_pool_image ();
#if MALLOC_DEBUG
assert ((pool == malloc_pool_image ())
|| malloc_pool_find_ (pool, malloc_pool_image ()));
#endif
a = malloc_find_inpool_ (pool, ptr);
#if MALLOC_DEBUG
assert (a->type == type);
if ((type != MALLOC_typeUS_) && (type != MALLOC_typeUSR_))
assert (a->size == s);
#endif
malloc_kill_area_ (pool, a);
}
/* malloc_new_ -- Allocate new object, die if unable
ptr = malloc_new_(size_in_bytes);
Call malloc, bomb if it returns NULL. */
void *
malloc_new_ (mallocSize s)
{
void *ptr;
unsigned ss = s;
#if MALLOC_DEBUG && 0
assert (s == (mallocSize) ss);/* Else alloc is too big for this
library/sys. */
#endif
ptr = xmalloc (ss);
#if MALLOC_DEBUG
memset (ptr, 126, ss); /* Catch some kinds of errors more
quickly/reliably. */
#endif
return ptr;
}
/* malloc_new_inpool_ -- Allocate new object, die if unable
ptr = malloc_new_inpool_(NULL,MALLOC_typeUS_,"object",size_in_bytes);
Allocate the structure and allocate a mallocArea_ to describe it, then
add it to the list of mallocArea_s for the pool. */
void *
malloc_new_inpool_ (mallocPool pool, mallocType_ type, const char *name, mallocSize s)
{
void *ptr;
mallocArea_ a;
unsigned short i;
if (pool == NULL)
pool = malloc_pool_image ();
#if MALLOC_DEBUG
assert ((pool == malloc_pool_image ())
|| malloc_pool_find_ (pool, malloc_pool_image ()));
#endif
ptr = malloc_new_ (s + (i = (MALLOC_DEBUG ? strlen (name) + 1 : 0)));
#if MALLOC_DEBUG
strcpy (((char *) (ptr)) + s, name);
#endif
a = malloc_new_ (offsetof (struct _malloc_area_, name) + i);
switch (type)
{ /* A little optimization to speed up killing
of non-permanent stuff. */
case MALLOC_typeKP_:
case MALLOC_typeKPR_:
a->next = (mallocArea_) &pool->first;
break;
default:
a->next = pool->first;
break;
}
a->previous = a->next->previous;
a->next->previous = a;
a->previous->next = a;
a->where = ptr;
#if MALLOC_DEBUG
a->size = s;
a->type = type;
strcpy (a->name, name);
pool->allocated += s;
pool->allocations++;
#endif
return ptr;
}
/* malloc_new_zinpool_ -- Allocate new zeroed object, die if unable
ptr = malloc_new_zinpool_(NULL,MALLOC_typeUS_,"object",size_in_bytes,0);
Like malloc_new_inpool_, but zeros out all the bytes in the area (assuming
you pass it a 0). */
void *
malloc_new_zinpool_ (mallocPool pool, mallocType_ type, const char *name, mallocSize s,
int z)
{
void *ptr;
ptr = malloc_new_inpool_ (pool, type, name, s);
memset (ptr, z, s);
return ptr;
}
/* malloc_pool_find_ -- See if pool is a descendant of another pool
if (malloc_pool_find_(target_pool,parent_pool)) ...;
Recursive descent on each of the children of the parent pool, after
first checking the children themselves. */
char
malloc_pool_find_ (mallocPool pool, mallocPool parent)
{
mallocPool p;
for (p = parent->eldest; p != (mallocPool) & parent->eldest; p = p->next)
{
if ((p == pool) || malloc_pool_find_ (pool, p))
return 1;
}
return 0;
}
/* malloc_resize_inpool_ -- Resize existing object in pool
ptr = malloc_resize_inpool_(NULL,MALLOC_typeUSR_,ptr,new_size,old_size);
Find the object's mallocArea_, check it out, then do the resizing. */
void *
malloc_resize_inpool_ (mallocPool pool, mallocType_ type UNUSED,
void *ptr, mallocSize ns, mallocSize os UNUSED)
{
mallocArea_ a;
if (pool == NULL)
pool = malloc_pool_image ();
#if MALLOC_DEBUG
assert ((pool == malloc_pool_image ())
|| malloc_pool_find_ (pool, malloc_pool_image ()));
#endif
a = malloc_find_inpool_ (pool, ptr);
#if MALLOC_DEBUG
assert (a->type == type);
if ((type == MALLOC_typeKSR_) || (type == MALLOC_typeKPR_))
assert (a->size == os);
assert (strcmp (a->name, ((char *) (ptr)) + os) == 0);
#endif
ptr = malloc_resize_ (ptr, ns + (MALLOC_DEBUG ? strlen (a->name) + 1: 0));
a->where = ptr;
#if MALLOC_DEBUG
a->size = ns;
strcpy (((char *) (ptr)) + ns, a->name);
pool->old_sizes += os;
pool->new_sizes += ns;
pool->resizes++;
#endif
return ptr;
}
/* malloc_resize_ -- Reallocate object, die if unable
ptr = malloc_resize_(ptr,size_in_bytes);
Call realloc, bomb if it returns NULL. */
void *
malloc_resize_ (void *ptr, mallocSize s)
{
int ss = s;
#if MALLOC_DEBUG && 0
assert (s == (mallocSize) ss);/* Too big if failure here. */
#endif
ptr = xrealloc (ptr, ss);
return ptr;
}
/* malloc_verify_inpool_ -- Verify object
Find the mallocArea_ for the pointer, make sure the type is proper, and
verify both of them. */
void
malloc_verify_inpool_ (mallocPool pool UNUSED, mallocType_ type UNUSED,
void *ptr UNUSED, mallocSize s UNUSED)
{
#if MALLOC_DEBUG
mallocArea_ a;
if (pool == NULL)
pool = malloc_pool_image ();
assert ((pool == malloc_pool_image ())
|| malloc_pool_find_ (pool, malloc_pool_image ()));
a = malloc_find_inpool_ (pool, ptr);
assert (a->type == type);
if ((type != MALLOC_typeUS_) && (type != MALLOC_typeUSR_))
assert (a->size == s);
malloc_verify_area_ (pool, a);
#endif
}

183
gcc/f/malloc.h
View file

@ -1,183 +0,0 @@
/* malloc.h -- Public #include File (module.h template V1.0)
Copyright (C) 1995 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Owning Modules:
malloc.c
Modifications:
*/
/* Allow multiple inclusion to work. */
#ifndef GCC_F_MALLOC_H
#define GCC_F_MALLOC_H
#ifndef MALLOC_DEBUG
#define MALLOC_DEBUG 0 /* 1 means check caller's use of this module. */
#endif
/* Simple definitions and enumerations. */
typedef enum
{
MALLOC_typeKS_,
MALLOC_typeKSR_,
MALLOC_typeKP_,
MALLOC_typeKPR_,
MALLOC_typeUS_,
MALLOC_typeUSR_,
MALLOC_type_
} mallocType_;
/* Typedefs. */
typedef struct _malloc_area_ *mallocArea_;
typedef struct _malloc_pool_ *mallocPool;
typedef unsigned long int mallocSize;
#define mallocSize_f "l"
/* Include files needed by this one. */
/* Structure definitions. */
struct _malloc_area_
{
mallocArea_ next;
mallocArea_ previous;
void *where;
#if MALLOC_DEBUG
mallocSize size;
mallocType_ type;
#endif
char name[1];
};
struct _malloc_pool_
{
mallocPool next;
mallocPool previous;
mallocPool eldest;
mallocPool youngest;
mallocArea_ first;
mallocArea_ last;
unsigned long uses;
#if MALLOC_DEBUG
mallocSize allocated;
mallocSize freed;
mallocSize old_sizes;
mallocSize new_sizes;
unsigned long allocations;
unsigned long frees;
unsigned long resizes;
#endif
char name[1];
};
struct _malloc_root_
{
struct _malloc_pool_ malloc_pool_image_;
};
/* Global objects accessed by users of this module. */
extern struct _malloc_root_ malloc_root_;
/* Declare functions with prototypes. */
void malloc_display_ (mallocArea_ a);
mallocArea_ malloc_find_inpool_ (mallocPool pool, void *ptr);
void malloc_init (void);
void malloc_kill_inpool_ (mallocPool pool, mallocType_ type, void *ptr,
mallocSize size);
void *malloc_new_ (mallocSize size);
void *malloc_new_inpool_ (mallocPool pool, mallocType_ type, const char *name,
mallocSize size);
void *malloc_new_zinpool_ (mallocPool pool, mallocType_ type, const char *name,
mallocSize size, int z);
void malloc_pool_display (mallocPool p);
char malloc_pool_find_ (mallocPool p, mallocPool parent);
void malloc_pool_kill (mallocPool p);
mallocPool malloc_pool_new (const char *name, mallocPool parent, unsigned long chunks);
mallocPool malloc_pool_use (mallocPool p);
void *malloc_resize_ (void *ptr, mallocSize new_size);
void *malloc_resize_inpool_ (mallocPool pool, mallocType_ type, void *ptr,
mallocSize new_size, mallocSize old_size);
void malloc_verify_inpool_ (mallocPool pool, mallocType_ type, void *ptr,
mallocSize size);
/* Define macros. */
#define malloc_new_ks(pool,name,size) \
malloc_new_inpool_ (pool,MALLOC_typeKS_,name,size)
#define malloc_new_ksr(pool,name,size) \
malloc_new_inpool_ (pool,MALLOC_typeKSR_,name,size)
#define malloc_new_kp(pool,name,size) \
malloc_new_inpool_ (pool,MALLOC_typeKP_,name,size)
#define malloc_new_kpr(pool,name,size) \
malloc_new_inpool_ (pool,MALLOC_typeKPR_,name,size)
#define malloc_new_us(pool,name,size) \
malloc_new_inpool_ (pool,MALLOC_typeUS_,name,size)
#define malloc_new_usr(pool,name,size) \
malloc_new_inpool_ (pool,MALLOC_typeUSR_,name,size)
#define malloc_new_zks(pool,name,size,z) \
malloc_new_zinpool_ (pool,MALLOC_typeKS_,name,size,z)
#define malloc_new_zksr(pool,name,size,z) \
malloc_new_zinpool_ (pool,MALLOC_typeKSR_,name,size,z)
#define malloc_new_zkp(pool,name,size,z) \
malloc_new_zinpool_ (pool,MALLOC_typeKP_,name,size,z)
#define malloc_new_zkpr(pool,name,size,z) \
malloc_new_zinpool_ (pool,MALLOC_typeKPR_,name,size,z)
#define malloc_new_zus(pool,name,size,z) \
malloc_new_zinpool_ (pool,MALLOC_typeUS_,name,size,z)
#define malloc_new_zusr(pool,name,size,z) \
malloc_new_zinpool_ (pool,MALLOC_typeUSR_,name,size,z)
#define malloc_kill_ks(pool,ptr,size) \
malloc_kill_inpool_ (pool,MALLOC_typeKS_,ptr,size)
#define malloc_kill_ksr(pool,ptr,size) \
malloc_kill_inpool_ (pool,MALLOC_typeKSR_,ptr,size)
#define malloc_kill_us(pool,ptr) \
malloc_kill_inpool_ (pool,MALLOC_typeUS_,ptr,0)
#define malloc_kill_usr(pool,ptr) \
malloc_kill_inpool_ (pool,MALLOC_typeUSR_,ptr,0)
#define malloc_pool_image() (&malloc_root_.malloc_pool_image_)
#define malloc_resize_ksr(pool,ptr,new_size,old_size) \
malloc_resize_inpool_ (pool,MALLOC_typeKSR_,ptr,new_size,old_size)
#define malloc_resize_kpr(pool,ptr,new_size,old_size) \
malloc_resize_inpool_ (pool,MALLOC_typeKPR_,ptr,new_size,old_size)
#define malloc_resize_usr(pool,ptr,new_size) \
malloc_resize_inpool_ (pool,MALLOC_typeUSR_,ptr,new_size,0)
#define malloc_verify_kp(pool,name,size) \
malloc_verify_inpool_ (pool,MALLOC_typeKP_,name,size)
#define malloc_verify_kpr(pool,name,size) \
malloc_verify_inpool_ (pool,MALLOC_typeKPR_,name,size)
#define malloc_verify_ks(pool,ptr,size) \
malloc_verify_inpool_ (pool,MALLOC_typeKS_,ptr,size)
#define malloc_verify_ksr(pool,ptr,size) \
malloc_verify_inpool_ (pool,MALLOC_typeKSR_,ptr,size)
#define malloc_verify_us(pool,ptr) \
malloc_verify_inpool_ (pool,MALLOC_typeUS_,ptr,0)
#define malloc_verify_usr(pool,ptr) \
malloc_verify_inpool_ (pool,MALLOC_typeUSR_,ptr,0)
/* End of #include file. */
#endif /* ! GCC_F_MALLOC_H */

241
gcc/f/name.c
View file

@ -1,241 +0,0 @@
/* name.c -- Implementation File (module.c template V1.0)
Copyright (C) 1995 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Related Modules:
None.
Description:
Name and name space abstraction.
Modifications:
*/
/* Include files. */
#include "proj.h"
#include "bad.h"
#include "name.h"
#include "lex.h"
#include "malloc.h"
#include "src.h"
#include "where.h"
/* Externals defined here. */
/* Simple definitions and enumerations. */
/* Internal typedefs. */
/* Private include files. */
/* Internal structure definitions. */
/* Static objects accessed by functions in this module. */
/* Static functions (internal). */
static ffename ffename_lookup_ (ffenameSpace ns, ffelexToken t, bool *found);
/* Internal macros. */
/* Searches for and returns the matching ffename object, or returns a
pointer to the name before which the new name should go. */
static ffename
ffename_lookup_ (ffenameSpace ns, ffelexToken t, bool *found)
{
ffename n;
for (n = ns->first; n != (ffename) &ns->first; n = n->next)
{
if (ffelex_token_strcmp (t, n->t) == 0)
{
*found = TRUE;
return n;
}
}
*found = FALSE;
return n; /* (n == (ffename) &ns->first) */
}
/* Searches for and returns the matching ffename object, or creates a new
one (with a NULL ffesymbol) and returns that. If last arg is TRUE,
check whether token meets character-content requirements (such as
"all characters must be uppercase", as determined by
ffesrc_bad_char_symbol (), issue diagnostic if it doesn't. */
ffename
ffename_find (ffenameSpace ns, ffelexToken t)
{
ffename n;
ffename newn;
bool found;
assert (ns != NULL);
assert ((t != NULL) && ((ffelex_token_type (t) == FFELEX_typeNAME)
|| (ffelex_token_type (t) == FFELEX_typeNAMES)));
n = ffename_lookup_ (ns, t, &found);
if (found)
return n;
newn = malloc_new_ks (ns->pool, "FFENAME name", sizeof (*n));
newn->next = n;
newn->previous = n->previous;
n->previous = newn;
newn->previous->next = newn;
newn->t = ffelex_token_use (t);
newn->u.s = NULL;
return newn;
}
/* ffename_kill -- Kill name from name space
ffenameSpace ns;
ffename s;
ffename_kill(ns,s);
Removes the name from the name space. */
void
ffename_kill (ffenameSpace ns, ffename n)
{
assert (ns != NULL);
assert (n != NULL);
ffelex_token_kill (n->t);
n->next->previous = n->previous;
n->previous->next = n->next;
malloc_kill_ks (ns->pool, n, sizeof (*n));
}
/* ffename_lookup -- Look up name in name space
ffenameSpace ns;
ffelexToken t;
ffename s;
n = ffename_lookup(ns,t);
Searches for and returns the matching ffename object, or returns NULL. */
ffename
ffename_lookup (ffenameSpace ns, ffelexToken t)
{
ffename n;
bool found;
assert (ns != NULL);
assert ((t != NULL) && ((ffelex_token_type (t) == FFELEX_typeNAME)
|| (ffelex_token_type (t) == FFELEX_typeNAMES)));
n = ffename_lookup_ (ns, t, &found);
return found ? n : NULL;
}
/* ffename_space_drive_global -- Call given fn for each global in name space
ffenameSpace ns;
ffeglobal (*fn)();
ffename_space_drive_global(ns,fn); */
void
ffename_space_drive_global (ffenameSpace ns, ffeglobal (*fn) (ffeglobal))
{
ffename n;
if (ns == NULL)
return;
for (n = ns->first; n != (ffename) &ns->first; n = n->next)
{
if (n->u.g != NULL)
n->u.g = (*fn) (n->u.g);
}
}
/* ffename_space_drive_symbol -- Call given fn for each symbol in name space
ffenameSpace ns;
ffesymbol (*fn)();
ffename_space_drive_symbol(ns,fn); */
void
ffename_space_drive_symbol (ffenameSpace ns, ffesymbol (*fn) (ffesymbol))
{
ffename n;
if (ns == NULL)
return;
for (n = ns->first; n != (ffename) &ns->first; n = n->next)
{
if (n->u.s != NULL)
n->u.s = (*fn) (n->u.s);
}
}
/* ffename_space_kill -- Kill name space
ffenameSpace ns;
ffename_space_kill(ns);
Removes the names from the name space; kills the name space. */
void
ffename_space_kill (ffenameSpace ns)
{
assert (ns != NULL);
while (ns->first != (ffename) &ns->first)
ffename_kill (ns, ns->first);
malloc_kill_ks (ns->pool, ns, sizeof (*ns));
}
/* ffename_space_new -- Create name space
ffenameSpace ns;
ns = ffename_space_new(malloc_pool_image());
Create new name space. */
ffenameSpace
ffename_space_new (mallocPool pool)
{
ffenameSpace ns;
ns = malloc_new_ks (pool, "FFENAME space", sizeof (*ns));
ns->first = (ffename) &ns->first;
ns->last = (ffename) &ns->first;
ns->pool = pool;
return ns;
}

109
gcc/f/name.h
View file

@ -1,109 +0,0 @@
/* name.h -- Public #include File (module.h template V1.0)
Copyright (C) 1995 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Owning Modules:
name.c
Modifications:
*/
/* Allow multiple inclusion to work. */
#ifndef GCC_F_NAME_H
#define GCC_F_NAME_H
/* Simple definitions and enumerations. */
/* Typedefs. */
typedef struct _ffename_ *ffename;
typedef struct _ffename_space_ *ffenameSpace;
/* Include files needed by this one. */
#include "global.h"
#include "lex.h"
#include "malloc.h"
#include "symbol.h"
/* Structure definitions. */
struct _ffename_
{
ffename next;
ffename previous;
ffelexToken t;
union
{
ffesymbol s;
ffeglobal g;
}
u;
};
struct _ffename_space_
{
ffename first;
ffename last;
mallocPool pool;
};
/* Global objects accessed by users of this module. */
/* Declare functions with prototypes. */
ffename ffename_find (ffenameSpace ns, ffelexToken t);
void ffename_kill (ffenameSpace ns, ffename n);
ffename ffename_lookup (ffenameSpace ns, ffelexToken t);
void ffename_space_drive_global (ffenameSpace ns, ffeglobal (*fn) (ffeglobal));
void ffename_space_drive_symbol (ffenameSpace ns, ffesymbol (*fn) (ffesymbol));
void ffename_space_kill (ffenameSpace ns);
ffenameSpace ffename_space_new (mallocPool pool);
/* Define macros. */
#define ffename_first_token(n) ((n)->t)
#define ffename_global(n) ((n)->u.g)
#define ffename_init_0()
#define ffename_init_1()
#define ffename_init_2()
#define ffename_init_3()
#define ffename_init_4()
#define ffename_set_global(n,glob) ((n)->u.g = (glob))
#define ffename_set_symbol(n,sym) ((n)->u.s = (sym))
#define ffename_symbol(n) ((n)->u.s)
#define ffename_terminate_0()
#define ffename_terminate_1()
#define ffename_terminate_2()
#define ffename_terminate_3()
#define ffename_terminate_4()
#define ffename_text(n) ffelex_token_text((n)->t)
#define ffename_token(n) ((n)->t)
#define ffename_where_filename(n) ffelex_token_where_filename((n)->t)
#define ffename_where_filelinenum(n) ffelex_token_where_filelinenum((n)->t)
#define ffename_where_line(n) ffelex_token_where_line((n)->t)
#define ffename_where_column(n) ffelex_token_where_column((n)->t)
/* End of #include file. */
#endif /* ! GCC_F_NAME_H */

3182
gcc/f/news.texi
View file

File diff suppressed because it is too large Load diff

9
gcc/f/news0.texi
View file

@ -1,9 +0,0 @@
\input texinfo @c -*-texinfo-*-
@c %**start of header
@setfilename NEWS
@c %**end of header
@c This tells news.texi that it's generating just the NEWS file.
@set DOC-NEWS
@include news.texi
@bye

49
gcc/f/parse.c
View file

@ -1,49 +0,0 @@
/* GNU Fortran
Copyright (C) 1995 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA. */
#include "proj.h"
#include "top.h"
#include "com.h"
#include "where.h"
#include "version.h"
#include "flags.h"
extern FILE *finput;
void
ffe_parse_file (int set_yydebug ATTRIBUTE_UNUSED)
{
const char *fname;
ffewhereFile wf;
if (ffe_is_version ())
fprintf (stderr, "GNU Fortran Front End version %s\n", version_string);
if (!ffe_is_pedantic ())
ffe_set_is_pedantic (pedantic);
fname = main_input_filename ? main_input_filename : "<stdin>";
wf = ffewhere_file_new (fname, strlen (fname));
ffecom_file (fname);
ffe_file (wf, finput);
ffecom_finish_compile ();
}

52
gcc/f/proj.h
View file

@ -1,52 +0,0 @@
/* proj.h file for Gnu Fortran
Copyright (C) 1995, 1996, 2000, 2001, 2002 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
*/
#ifndef GCC_F_PROJ_H
#define GCC_F_PROJ_H
#ifdef USE_BCONFIG
#include "bconfig.h"
#else
#include "config.h"
#endif
#include "system.h"
#include "coretypes.h"
#include "tm.h"
#if (GCC_VERSION < 2000)
#error "You have to use gcc 2.x to build g77."
#endif
/* Include files everyone gets. <assert.h> is needed for assert(). */
#include "assert.h"
#ifndef UNUSED /* Compile with -DUNUSED= if cc doesn't support this. */
#define UNUSED ATTRIBUTE_UNUSED
#endif /* !defined (UNUSED) */
#ifndef dmpout
#define dmpout stderr
#endif
#endif /* ! GCC_F_PROJ_H */

14
gcc/f/root.texi
View file

@ -1,14 +0,0 @@
@include gcc-common.texi
@set email-general gcc@@gcc.gnu.org
@set email-help gcc-help@@gcc.gnu.org
@set email-bugs gcc-bugs@@gcc.gnu.org or bug-gcc@@gnu.org
@set email-patch gcc-patches@@gcc.gnu.org
@set path-g77 gcc/gcc/f
@set path-libf2c gcc/libf2c
@set which-g77 GCC-@value{version-GCC}
@set which-gcc GCC
@set email-burley craig@@jcb-sc.com
@set www-burley http://world.std.com/%7Eburley/

427
gcc/f/src.c
View file

@ -1,427 +0,0 @@
/* src.c -- Implementation File
Copyright (C) 1995, 2003 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Related Modules:
Description:
Source-file functions to handle various combinations of case sensitivity
and insensitivity at run time.
Modifications:
*/
#include "proj.h"
#include "src.h"
#include "top.h"
/* This array is set up so that, given a source-mapped character, the result
of indexing into this array will match an upper-cased character depending
on the source-mapped character's case and the established ffe_case_match()
setting. So the uppercase cells contain identies (e.g. ['A'] == 'A')
as long as uppercase matching is permitted (!FFE_caseLOWER) and the
lowercase cells contain uppercased identities (e.g. ['a'] == 'A') as long
as lowercase matching is permitted (!FFE_caseUPPER). Else the case
cells contain -1. _init_ is for the first character of a keyword,
and _noninit_ is for other characters. */
char ffesrc_char_match_init_[256];
char ffesrc_char_match_noninit_[256];
/* This array is used to map input source according to the established
ffe_case_source() setting: for FFE_caseNONE, the array is all
identities; for FFE_caseUPPER, the lowercase cells contain
uppercased identities; and vice versa for FFE_caseLOWER. */
char ffesrc_char_source_[256];
/* This array is used to map an internally generated character so that it
will be accepted as an initial character in a keyword. The assumption
is that the incoming character is uppercase. */
char ffesrc_char_internal_init_[256];
/* This array is used to determine if a particular character is valid in
a symbol name according to the established ffe_case_symbol() setting:
for FFE_caseNONE, the array is all FFEBAD; for FFE_caseUPPER, the
lowercase cells contain a non-FFEBAD error code (FFEBAD_SYMBOL_UPPER_CASE);
and vice versa for FFE_caseLOWER. _init_ and _noninit_ distinguish
between initial and subsequent characters for the caseINITCAP case,
and their error codes are different for appropriate messages --
specifically, _noninit_ contains a non-FFEBAD error code for all
except lowercase characters for the caseINITCAP case.
See ffesrc_check_symbol_, it must be TRUE if this array is not all
FFEBAD. */
ffebad ffesrc_bad_symbol_init_[256];
ffebad ffesrc_bad_symbol_noninit_[256];
/* Set TRUE if any element in ffesrc_bad_symbol (with an index representing
a character that can also be in the text of a token passed to
ffename_find, strictly speaking) is not FFEBAD. I.e., TRUE if it is
necessary to check token characters against the ffesrc_bad_symbol_
array. */
bool ffesrc_check_symbol_;
/* These are set TRUE if the kind of character (upper/lower) is ok as a match
in the context (initial/noninitial character of keyword). */
bool ffesrc_ok_match_init_upper_;
bool ffesrc_ok_match_init_lower_;
bool ffesrc_ok_match_noninit_upper_;
bool ffesrc_ok_match_noninit_lower_;
/* Initialize table of alphabetic matches. */
void
ffesrc_init_1 (void)
{
int i;
for (i = 0; i < 256; ++i)
{
ffesrc_char_match_init_[i] = i;
ffesrc_char_match_noninit_[i] = i;
ffesrc_char_source_[i] = i;
ffesrc_char_internal_init_[i] = i;
ffesrc_bad_symbol_init_[i] = FFEBAD;
ffesrc_bad_symbol_noninit_[i] = FFEBAD;
}
ffesrc_check_symbol_ = (ffe_case_symbol () != FFE_caseNONE);
ffesrc_ok_match_init_upper_ = (ffe_case_match () != FFE_caseLOWER);
ffesrc_ok_match_init_lower_ = (ffe_case_match () != FFE_caseUPPER)
&& (ffe_case_match () != FFE_caseINITCAP);
ffesrc_ok_match_noninit_upper_ = (ffe_case_match () != FFE_caseLOWER)
&& (ffe_case_match () != FFE_caseINITCAP);
ffesrc_ok_match_noninit_lower_ = (ffe_case_match () != FFE_caseUPPER);
/* Note that '-' is used to flag an invalid match character. '-' is
somewhat arbitrary, actually. -1 was used, but that's not wise on a
system with unsigned chars as default -- it'd turn into 255 or some such
large positive number, which would sort higher than the alphabetics and
thus possibly cause problems. So '-' is picked just because it's never
likely to be a symbol character in Fortran and because it's "less than"
any alphabetic character. EBCDIC might see things differently, I don't
remember it well enough, but that's just tough -- lots of other things
might have to change to support EBCDIC -- anyway, some other character
could easily be picked. */
#define FFESRC_INVALID_SYMBOL_CHAR_ '-'
if (!ffesrc_ok_match_init_upper_)
for (i = 'A'; i <= 'Z'; ++i)
ffesrc_char_match_init_[i] = FFESRC_INVALID_SYMBOL_CHAR_;
if (ffesrc_ok_match_init_lower_)
for (i = 'a'; i <= 'z'; ++i)
ffesrc_char_match_init_[i] = TOUPPER (i);
else
for (i = 'a'; i <= 'z'; ++i)
ffesrc_char_match_init_[i] = FFESRC_INVALID_SYMBOL_CHAR_;
if (!ffesrc_ok_match_noninit_upper_)
for (i = 'A'; i <= 'Z'; ++i)
ffesrc_char_match_noninit_[i] = FFESRC_INVALID_SYMBOL_CHAR_;
if (ffesrc_ok_match_noninit_lower_)
for (i = 'a'; i <= 'z'; ++i)
ffesrc_char_match_noninit_[i] = TOUPPER (i);
else
for (i = 'a'; i <= 'z'; ++i)
ffesrc_char_match_noninit_[i] = FFESRC_INVALID_SYMBOL_CHAR_;
if (ffe_case_source () == FFE_caseLOWER)
for (i = 'A'; i <= 'Z'; ++i)
ffesrc_char_source_[i] = TOLOWER (i);
else if (ffe_case_source () == FFE_caseUPPER)
for (i = 'a'; i <= 'z'; ++i)
ffesrc_char_source_[i] = TOUPPER (i);
if (ffe_case_match () == FFE_caseLOWER)
for (i = 'A'; i <= 'Z'; ++i)
ffesrc_char_internal_init_[i] = TOLOWER (i);
switch (ffe_case_symbol ())
{
case FFE_caseLOWER:
for (i = 'A'; i <= 'Z'; ++i)
{
ffesrc_bad_symbol_init_[i] = FFEBAD_SYMBOL_UPPER_CASE;
ffesrc_bad_symbol_noninit_[i] = FFEBAD_SYMBOL_UPPER_CASE;
}
break;
case FFE_caseUPPER:
for (i = 'a'; i <= 'z'; ++i)
{
ffesrc_bad_symbol_init_[i] = FFEBAD_SYMBOL_LOWER_CASE;
ffesrc_bad_symbol_noninit_[i] = FFEBAD_SYMBOL_LOWER_CASE;
}
break;
case FFE_caseINITCAP:
for (i = 0; i < 256; ++i)
ffesrc_bad_symbol_noninit_[i] = FFEBAD_SYMBOL_NOLOWER_INITCAP;
for (i = 'a'; i <= 'z'; ++i)
{
ffesrc_bad_symbol_init_[i] = FFEBAD_SYMBOL_LOWER_INITCAP;
ffesrc_bad_symbol_noninit_[i] = FFEBAD;
}
break;
default:
break;
}
}
/* Compare two strings a la strcmp, the first being a source string with its
length passed, and the second being a constant string passed
in InitialCaps form. Also, the return value is always -1, 0, or 1. */
int
ffesrc_strcmp_1ns2i (ffeCase mcase, const char *var, int len,
const char *str_ic)
{
char c;
char d;
switch (mcase)
{
case FFE_caseNONE:
for (; len > 0; --len, ++var, ++str_ic)
{
c = ffesrc_char_source (*var); /* Transform source. */
c = TOUPPER (c); /* Upcase source. */
d = TOUPPER (*str_ic); /* Upcase InitialCaps char. */
if (c != d)
{
if ((d != '\0') && (c < d))
return -1;
else
return 1;
}
}
break;
case FFE_caseUPPER:
for (; len > 0; --len, ++var, ++str_ic)
{
c = ffesrc_char_source (*var); /* Transform source. */
d = TOUPPER (*str_ic); /* Transform InitialCaps char. */
if (c != d)
{
if ((d != '\0') && (c < d))
return -1;
else
return 1;
}
}
break;
case FFE_caseLOWER:
for (; len > 0; --len, ++var, ++str_ic)
{
c = ffesrc_char_source (*var); /* Transform source. */
d = TOLOWER (*str_ic); /* Transform InitialCaps char. */
if (c != d)
{
if ((d != '\0') && (c < d))
return -1;
else
return 1;
}
}
break;
case FFE_caseINITCAP:
for (; len > 0; --len, ++var, ++str_ic)
{
c = ffesrc_char_source (*var); /* Transform source. */
d = *str_ic; /* No transform of InitialCaps char. */
if (c != d)
{
c = TOUPPER (c);
d = TOUPPER (d);
while ((len > 0) && (c == d))
{ /* Skip past equivalent (case-ins) chars. */
--len, ++var, ++str_ic;
if (len > 0)
c = TOUPPER (*var);
d = TOUPPER (*str_ic);
}
if ((d != '\0') && (c < d))
return -1;
else
return 1;
}
}
break;
default:
assert ("bad case value" == NULL);
return -1;
}
if (*str_ic == '\0')
return 0;
return -1;
}
/* Compare two strings a la strcmp, the second being a constant string passed
in both uppercase and lowercase form. If not equal, the uppercase string
is used to determine the sign of the return value. Also, the return
value is always -1, 0, or 1. */
int
ffesrc_strcmp_2c (ffeCase mcase, const char *var, const char *str_uc,
const char *str_lc, const char *str_ic)
{
int i;
char c;
switch (mcase)
{
case FFE_caseNONE:
for (; *var != '\0'; ++var, ++str_uc)
{
c = TOUPPER (*var); /* Upcase source. */
if (c != *str_uc)
{
if ((*str_uc != '\0') && (c < *str_uc))
return -1;
else
return 1;
}
}
if (*str_uc == '\0')
return 0;
return -1;
case FFE_caseUPPER:
i = strcmp (var, str_uc);
break;
case FFE_caseLOWER:
i = strcmp (var, str_lc);
break;
case FFE_caseINITCAP:
for (; *var != '\0'; ++var, ++str_ic, ++str_uc)
{
if (*var != *str_ic)
{
c = TOUPPER (*var);
while ((c != '\0') && (c == *str_uc))
{ /* Skip past equivalent (case-ins) chars. */
++var, ++str_uc;
c = TOUPPER (*var);
}
if ((*str_uc != '\0') && (c < *str_uc))
return -1;
else
return 1;
}
}
if (*str_ic == '\0')
return 0;
return -1;
default:
assert ("bad case value" == NULL);
return -1;
}
if (i == 0)
return 0;
else if (i < 0)
return -1;
return 1;
}
/* Compare two strings a la strncmp, the second being a constant string passed
in uppercase, lowercase, and InitialCaps form. If not equal, the
uppercase string is used to determine the sign of the return value. */
int
ffesrc_strncmp_2c (ffeCase mcase, const char *var, const char *str_uc,
const char *str_lc, const char *str_ic, int len)
{
int i;
char c;
switch (mcase)
{
case FFE_caseNONE:
for (; len > 0; ++var, ++str_uc, --len)
{
c = TOUPPER (*var); /* Upcase source. */
if (c != *str_uc)
{
if (c < *str_uc)
return -1;
else
return 1;
}
}
return 0;
case FFE_caseUPPER:
i = strncmp (var, str_uc, len);
break;
case FFE_caseLOWER:
i = strncmp (var, str_lc, len);
break;
case FFE_caseINITCAP:
for (; len > 0; ++var, ++str_ic, ++str_uc, --len)
{
if (*var != *str_ic)
{
c = TOUPPER (*var);
while ((len > 0) && (c == *str_uc))
{ /* Skip past equivalent (case-ins) chars. */
--len, ++var, ++str_uc;
if (len > 0)
c = TOUPPER (*var);
}
if ((len > 0) && (c < *str_uc))
return -1;
else
return 1;
}
}
return 0;
default:
assert ("bad case value" == NULL);
return -1;
}
if (i == 0)
return 0;
else if (i < 0)
return -1;
return 1;
}

140
gcc/f/src.h
View file

@ -1,140 +0,0 @@
/* src.h -- Public #include File
Copyright (C) 1995 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Owning Modules:
src.c
Modifications:
*/
/* Allow multiple inclusion to work. */
#ifndef GCC_F_SRC_H
#define GCC_F_SRC_H
#include "bad.h"
#include "top.h"
extern char ffesrc_char_match_init_[256];
extern char ffesrc_char_match_noninit_[256];
extern char ffesrc_char_source_[256];
extern char ffesrc_char_internal_init_[256];
extern ffebad ffesrc_bad_symbol_init_[256];
extern ffebad ffesrc_bad_symbol_noninit_[256];
extern bool ffesrc_check_symbol_;
extern bool ffesrc_ok_match_init_upper_;
extern bool ffesrc_ok_match_init_lower_;
extern bool ffesrc_ok_match_noninit_upper_;
extern bool ffesrc_ok_match_noninit_lower_;
/* These C-language-syntax modifiers could avoid the match arg if gcc's
extension allowing macros to generate dynamic labels was used. They
could use the no_match arg (and the "caller's" label defs) if there
was a way to say "goto default" in a switch statement. Oh well.
NOTE: These macro assume "case FFESRC_CASE_MATCH_[NON]INIT(...):" is used
to invoke them, and thus assume the "above" case does not fall through to
this one. This syntax was chosen to keep indenting tools working. */
#define FFESRC_CASE_MATCH_INIT(upper, lower, match, no_match) \
upper: if (!ffesrc_ok_match_init_upper_) goto no_match; \
else goto match; \
case lower: if (!ffesrc_ok_match_init_lower_) goto no_match; \
match
#define FFESRC_CASE_MATCH_NONINIT(upper, lower, match, no_match) \
upper: if (!ffesrc_ok_match_noninit_upper_) goto no_match; \
else goto match; \
case lower: if (!ffesrc_ok_match_noninit_lower_) goto no_match; \
match
/* If character is ok in a symbol name (not including intrinsic names),
returns FFEBAD, else returns something else, type ffebad. */
#define ffesrc_bad_char_symbol_init(c) \
(ffesrc_bad_symbol_init_[(unsigned int) (c)])
#define ffesrc_bad_char_symbol_noninit(c) \
(ffesrc_bad_symbol_noninit_[(unsigned int) (c)])
/* Returns TRUE if character is ok in a symbol name (including
intrinsic names). Doesn't care about case settings, this is
used just for parsing (before semantic complaints about symbol-
name casing and such). One specific usage is to decide whether
an underscore is valid as the first or subsequent character in
some symbol name -- if not, an underscore is a separate token
(while lexing, for example). Note that ffesrc_is_name_init
must return TRUE for a (not necessarily proper) subset of
characters for which ffelex_is_firstnamechar returns TRUE. */
#define ffesrc_is_name_init(c) \
((ISALPHA ((c))) || (! (1 || ffe_is_90 ()) && ((c) == '_')))
#define ffesrc_is_name_noninit(c) \
((ISALNUM ((c))) || (! (1 || ffe_is_90 ()) && ((c) == '_')))
/* Test if source-translated character matches given alphabetic character
(passed in both uppercase and lowercase, to allow for custom speedup
of compilation in environments where compile-time options aren't needed
for casing). */
#define ffesrc_char_match_init(c, up, low) \
(ffesrc_char_match_init_[(unsigned int) (c)] == up)
#define ffesrc_char_match_noninit(c, up, low) \
(ffesrc_char_match_noninit_[(unsigned int) (c)] == up)
/* Translate character from input-file form to source form. */
#define ffesrc_char_source(c) (ffesrc_char_source_[(unsigned int) (c)])
/* Translate internal character (upper/lower) to source form in an
initial-character context (i.e. ffesrc_char_match_init of the result
will always succeed). */
#define ffesrc_char_internal_init(up, low) \
(ffesrc_char_internal_init_[(unsigned int) (up)])
/* Returns TRUE if a name representing a symbol should be checked for
validity according to compile-time options. That is, if it is possible
that ffesrc_bad_char_symbol(c) can return something other than FFEBAD
for any valid character in an ffelex NAME(S) token. */
#define ffesrc_check_symbol() ffesrc_check_symbol_
#define ffesrc_init_0()
void ffesrc_init_1 (void);
#define ffesrc_init_2()
#define ffesrc_init_3()
#define ffesrc_init_4()
int ffesrc_strcmp_1ns2i (ffeCase mcase, const char *var, int len,
const char *str_ic);
int ffesrc_strcmp_2c (ffeCase mcase, const char *var, const char *str_uc,
const char *str_lc, const char *str_ic);
int ffesrc_strncmp_2c (ffeCase mcase, const char *var, const char *str_uc,
const char *str_lc, const char *str_ic, int len);
#define ffesrc_terminate_0()
#define ffesrc_terminate_1()
#define ffesrc_terminate_2()
#define ffesrc_terminate_3()
#define ffesrc_terminate_4()
/* End of #include file. */
#endif /* ! GCC_F_SRC_H */

554
gcc/f/st.c
View file

@ -1,554 +0,0 @@
/* st.c -- Implementation File (module.c template V1.0)
Copyright (C) 1995, 2003 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Related Modules:
None
Description:
The high-level input level to statement handling for the rest of the
FFE. ffest_first is the first state for the lexer to invoke to start
a statement. A statement normally starts with a NUMBER token (to indicate
a label def) followed by a NAME token (to indicate what kind of statement
it is), though of course the NUMBER token may be omitted. ffest_first
gathers the first NAME token and returns a state of ffest_second_,
where the trailing underscore means "internal to ffest" and thus outside
users should not depend on this. ffest_second_ then looks at the second
token in conjunction with the first, decides what possible statements are
meant, and tries each possible statement in turn, from most likely to
least likely. A successful attempt currently is recorded, and further
successful attempts by other possibilities raise an assertion error in
ffest_confirmed (this is to detect ambiguities). A failure in an
attempt is signaled by calling ffest_ffebad_start; this results in the
next token sent by ffest_save_ (the intermediary when more than one
possible statement exists) being EOS to shut down processing and the next
possibility tried.
When all possibilities have been tried, the successful one is retried with
inhibition turned off (FALSE) as reported by ffest_is_inhibited(). If
there is no successful one, the first one is retried so the user gets to
see the error messages.
In the future, after syntactic bugs have been reasonably shaken out and
ambiguities thus detected, the first successful possibility will be
enabled (inhibited goes FALSE) as soon as it confirms success by calling
ffest_confirmed, thus retrying the possibility will not be necessary.
The only complication in all this is that expression handling is
happening while possibilities are inhibited. It is up to the expression
handler, conceptually, to not make any changes to its knowledge base for
variable names and so on when inhibited that cannot be undone if
the current possibility fails (shuts down via ffest_ffebad_start). In
fact, this business is handled not be ffeexpr, but by lower levels.
ffesta functions serve only to provide information used in syntactic
processing of possible statements, and thus may not make changes to the
knowledge base for variables and such.
ffestb functions perform the syntactic analysis for possible statements,
and thus again may not make changes to the knowledge base except under the
auspices of ffeexpr and its subordinates, changes which can be undone when
necessary.
ffestc functions perform the semantic analysis for the chosen statement,
and thus may change the knowledge base as necessary since they are invoked
by ffestb functions only after a given statement is confirmed and
enabled. Note, however, that a few ffestc functions (identified by
their statement names rather than grammar numbers) indicate valid forms
that are, outside of any context, ambiguous, such as ELSE WHERE and
PRIVATE; these functions should make a quick decision as to what is
intended and dispatch to the appropriate specific ffestc function.
ffestd functions actually implement statements. When called, the
statement is considered valid and is either an executable statement or
a nonexecutable statement with direct-output results. For example, CALL,
GOTO, and assignment statements pass through ffestd because they are
executable; DATA statements pass through because they map directly to the
output file (or at least might so map); ENTRY statements also pass through
because they essentially affect code generation in an immediate way;
whereas INTEGER, SAVE, and SUBROUTINE statements do not go through
ffestd functions because they merely update the knowledge base.
Modifications:
*/
/* Include files. */
#include "proj.h"
#include "st.h"
#include "bad.h"
#include "lex.h"
#include "sta.h"
#include "stb.h"
#include "stc.h"
#include "std.h"
#include "ste.h"
#include "stp.h"
#include "str.h"
#include "sts.h"
#include "stt.h"
#include "stu.h"
#include "stv.h"
#include "stw.h"
/* Externals defined here. */
/* Simple definitions and enumerations. */
/* Internal typedefs. */
/* Private include files. */
/* Internal structure definitions. */
/* Static objects accessed by functions in this module. */
/* Static functions (internal). */
/* Internal macros. */
/* ffest_confirmed -- Confirm current possibility as only one
ffest_confirmed();
Sets the confirmation flag. During debugging for ambiguous constructs,
asserts that the confirmation flag for a previous possibility has not
yet been set. */
void
ffest_confirmed (void)
{
ffesta_confirmed ();
}
/* ffest_eof -- End of (non-INCLUDEd) source file
ffest_eof();
Call after piping tokens through ffest_first, where the most recent
token sent through must be EOS.
20-Feb-91 JCB 1.1
Put new EOF token in ffesta_tokens[0], not NULL, because too much
code expects something there for error reporting and the like. Also,
do basically the same things ffest_second and ffesta_zero do for
processing a statement (make and destroy pools, et cetera). */
void
ffest_eof (void)
{
ffesta_eof ();
}
/* ffest_ffebad_here_current_stmt -- ffebad_here with ptr to current stmt
ffest_ffebad_here_current_stmt(0);
Outsiders can call this fn if they have no more convenient place to
point to (via a token or pair of ffewhere objects) and they know a
current, useful statement is being evaluted by ffest (i.e. they are
being called from ffestb, ffestc, ffestd, ... functions). */
void
ffest_ffebad_here_current_stmt (ffebadIndex i)
{
ffesta_ffebad_here_current_stmt (i);
}
/* ffest_ffebad_here_doiter -- Calls ffebad_here with ptr to DO iter var
ffesymbol s;
// call ffebad_start first, of course.
ffest_ffebad_here_doiter(0,s);
// call ffebad_finish afterwards, naturally.
Searches the stack of blocks backwards for a DO loop that has s
as its iteration variable, then calls ffebad_here with pointers to
that particular reference to the variable. Crashes if the DO loop
can't be found. */
void
ffest_ffebad_here_doiter (ffebadIndex i, ffesymbol s)
{
ffestc_ffebad_here_doiter (i, s);
}
/* ffest_ffebad_start -- Start a possibly inhibited error report
if (ffest_ffebad_start(FFEBAD_SOME_ERROR))
{
ffebad_here, ffebad_string ...;
ffebad_finish();
}
Call if the error might indicate that ffest is evaluating the wrong
statement form, instead of calling ffebad_start directly. If ffest
is choosing between forms, it will return FALSE, send an EOS/SEMICOLON
token through as the next token (if the current one isn't already one
of those), and try another possible form. Otherwise, ffebad_start is
called with the argument and TRUE returned. */
bool
ffest_ffebad_start (ffebad errnum)
{
return ffesta_ffebad_start (errnum);
}
/* ffest_first -- Parse the first token in a statement
return ffest_first; // to lexer. */
ffelexHandler
ffest_first (ffelexToken t)
{
return ffesta_first (t);
}
/* ffest_init_0 -- Initialize for entire image invocation
ffest_init_0();
Call just once per invocation of the compiler (not once per invocation
of the front end).
Gets memory for the list of possibles once and for all, since this
list never gets larger than a certain size (FFEST_maxPOSSIBLES_)
and is not particularly large. Initializes the array of pointers to
this list. Initializes the executable and nonexecutable lists. */
void
ffest_init_0 (void)
{
ffesta_init_0 ();
ffestb_init_0 ();
ffestc_init_0 ();
ffestd_init_0 ();
ffeste_init_0 ();
ffestp_init_0 ();
ffestr_init_0 ();
ffests_init_0 ();
ffestt_init_0 ();
ffestu_init_0 ();
ffestv_init_0 ();
ffestw_init_0 ();
}
/* ffest_init_1 -- Initialize for entire image invocation
ffest_init_1();
Call just once per invocation of the compiler (not once per invocation
of the front end).
Gets memory for the list of possibles once and for all, since this
list never gets larger than a certain size (FFEST_maxPOSSIBLES_)
and is not particularly large. Initializes the array of pointers to
this list. Initializes the executable and nonexecutable lists. */
void
ffest_init_1 (void)
{
ffesta_init_1 ();
ffestb_init_1 ();
ffestc_init_1 ();
ffestd_init_1 ();
ffeste_init_1 ();
ffestp_init_1 ();
ffestr_init_1 ();
ffests_init_1 ();
ffestt_init_1 ();
ffestu_init_1 ();
ffestv_init_1 ();
ffestw_init_1 ();
}
/* ffest_init_2 -- Initialize for entire image invocation
ffest_init_2();
Call just once per invocation of the compiler (not once per invocation
of the front end).
Gets memory for the list of possibles once and for all, since this
list never gets larger than a certain size (FFEST_maxPOSSIBLES_)
and is not particularly large. Initializes the array of pointers to
this list. Initializes the executable and nonexecutable lists. */
void
ffest_init_2 (void)
{
ffesta_init_2 ();
ffestb_init_2 ();
ffestc_init_2 ();
ffestd_init_2 ();
ffeste_init_2 ();
ffestp_init_2 ();
ffestr_init_2 ();
ffests_init_2 ();
ffestt_init_2 ();
ffestu_init_2 ();
ffestv_init_2 ();
ffestw_init_2 ();
}
/* ffest_init_3 -- Initialize for any program unit
ffest_init_3(); */
void
ffest_init_3 (void)
{
ffesta_init_3 ();
ffestb_init_3 ();
ffestc_init_3 ();
ffestd_init_3 ();
ffeste_init_3 ();
ffestp_init_3 ();
ffestr_init_3 ();
ffests_init_3 ();
ffestt_init_3 ();
ffestu_init_3 ();
ffestv_init_3 ();
ffestw_init_3 ();
ffestw_display_state ();
}
/* ffest_init_4 -- Initialize for statement functions
ffest_init_4(); */
void
ffest_init_4 (void)
{
ffesta_init_4 ();
ffestb_init_4 ();
ffestc_init_4 ();
ffestd_init_4 ();
ffeste_init_4 ();
ffestp_init_4 ();
ffestr_init_4 ();
ffests_init_4 ();
ffestt_init_4 ();
ffestu_init_4 ();
ffestv_init_4 ();
ffestw_init_4 ();
}
/* Test whether ENTRY statement is valid.
Returns TRUE if current program unit is known to be FUNCTION or SUBROUTINE.
Else returns FALSE. */
bool
ffest_is_entry_valid (void)
{
return ffesta_is_entry_valid;
}
/* ffest_is_inhibited -- Test whether the current possibility is inhibited
if (!ffest_is_inhibited())
// implement the statement.
Just make sure the current possibility has been confirmed. If anyone
really needs to test whether the current possibility is inhibited prior
to confirming it, that indicates a need to begin statement processing
before it is certain that the given possibility is indeed the statement
to be processed. As of this writing, there does not appear to be such
a need. If there is, then when confirming a statement would normally
immediately disable the inhibition (whereas currently we leave the
confirmed statement disabled until we've tried the other possibilities,
to check for ambiguities), we must check to see if the possibility has
already tested for inhibition prior to confirmation and, if so, maintain
inhibition until the end of the statement (which may be forced right
away) and then rerun the entire statement from the beginning. Otherwise,
initial calls to ffestb functions won't have been made, but subsequent
calls (after confirmation) will, which is wrong. Of course, this all
applies only to those statements implemented via multiple calls to
ffestb, although if a statement requiring only a single ffestb call
tested for inhibition prior to confirmation, it would likely mean that
the ffestb call would be completely dropped without this mechanism. */
bool
ffest_is_inhibited (void)
{
return ffesta_is_inhibited ();
}
/* ffest_seen_first_exec -- Test whether first executable stmt has been seen
if (ffest_seen_first_exec())
// No more spec stmts can be seen.
In a case where, say, the first statement is PARAMETER(A)=B, FALSE
will be returned while the PARAMETER statement is being run, and TRUE
will be returned if it doesn't confirm and the assignment statement
is being run. */
bool
ffest_seen_first_exec (void)
{
return ffesta_seen_first_exec;
}
/* Shut down current parsing possibility, but without bothering the
user with a diagnostic if we're not inhibited. */
void
ffest_shutdown (void)
{
ffesta_shutdown ();
}
/* ffest_sym_end_transition -- Update symbol info just before end of unit
ffesymbol s;
ffest_sym_end_transition(s); */
ffesymbol
ffest_sym_end_transition (ffesymbol s)
{
return ffestu_sym_end_transition (s);
}
/* ffest_sym_exec_transition -- Update symbol just before first exec stmt
ffesymbol s;
ffest_sym_exec_transition(s); */
ffesymbol
ffest_sym_exec_transition (ffesymbol s)
{
return ffestu_sym_exec_transition (s);
}
/* ffest_terminate_0 -- Terminate for entire image invocation
ffest_terminate_0(); */
void
ffest_terminate_0 (void)
{
ffesta_terminate_0 ();
ffestb_terminate_0 ();
ffestc_terminate_0 ();
ffestd_terminate_0 ();
ffeste_terminate_0 ();
ffestp_terminate_0 ();
ffestr_terminate_0 ();
ffests_terminate_0 ();
ffestt_terminate_0 ();
ffestu_terminate_0 ();
ffestv_terminate_0 ();
ffestw_terminate_0 ();
}
/* ffest_terminate_1 -- Terminate for source file
ffest_terminate_1(); */
void
ffest_terminate_1 (void)
{
ffesta_terminate_1 ();
ffestb_terminate_1 ();
ffestc_terminate_1 ();
ffestd_terminate_1 ();
ffeste_terminate_1 ();
ffestp_terminate_1 ();
ffestr_terminate_1 ();
ffests_terminate_1 ();
ffestt_terminate_1 ();
ffestu_terminate_1 ();
ffestv_terminate_1 ();
ffestw_terminate_1 ();
}
/* ffest_terminate_2 -- Terminate for outer program unit
ffest_terminate_2(); */
void
ffest_terminate_2 (void)
{
ffesta_terminate_2 ();
ffestb_terminate_2 ();
ffestc_terminate_2 ();
ffestd_terminate_2 ();
ffeste_terminate_2 ();
ffestp_terminate_2 ();
ffestr_terminate_2 ();
ffests_terminate_2 ();
ffestt_terminate_2 ();
ffestu_terminate_2 ();
ffestv_terminate_2 ();
ffestw_terminate_2 ();
}
/* ffest_terminate_3 -- Terminate for any program unit
ffest_terminate_3(); */
void
ffest_terminate_3 (void)
{
ffesta_terminate_3 ();
ffestb_terminate_3 ();
ffestc_terminate_3 ();
ffestd_terminate_3 ();
ffeste_terminate_3 ();
ffestp_terminate_3 ();
ffestr_terminate_3 ();
ffests_terminate_3 ();
ffestt_terminate_3 ();
ffestu_terminate_3 ();
ffestv_terminate_3 ();
ffestw_terminate_3 ();
}
/* ffest_terminate_4 -- Terminate for statement functions
ffest_terminate_4(); */
void
ffest_terminate_4 (void)
{
ffesta_terminate_4 ();
ffestb_terminate_4 ();
ffestc_terminate_4 ();
ffestd_terminate_4 ();
ffeste_terminate_4 ();
ffestp_terminate_4 ();
ffestr_terminate_4 ();
ffests_terminate_4 ();
ffestt_terminate_4 ();
ffestu_terminate_4 ();
ffestv_terminate_4 ();
ffestw_terminate_4 ();
}

81
gcc/f/st.h
View file

@ -1,81 +0,0 @@
/* st.h -- Public #include File (module.h template V1.0)
Copyright (C) 1995 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Owning Modules:
st.c
Modifications:
*/
/* Allow multiple inclusion to work. */
#ifndef GCC_F_ST_H
#define GCC_F_ST_H
/* Simple definitions and enumerations. */
/* Typedefs. */
/* Include files needed by this one. */
#include "bad.h"
#include "lex.h"
#include "symbol.h"
/* Structure definitions. */
/* Global objects accessed by users of this module. */
/* Declare functions with prototypes. */
void ffest_confirmed (void);
void ffest_eof (void);
bool ffest_ffebad_start (ffebad errnum);
void ffest_ffebad_here_current_stmt (ffebadIndex i);
void ffest_ffebad_here_doiter (ffebadIndex i, ffesymbol s);
ffelexHandler ffest_first (ffelexToken t);
void ffest_init_0 (void);
void ffest_init_1 (void);
void ffest_init_2 (void);
void ffest_init_3 (void);
void ffest_init_4 (void);
bool ffest_is_entry_valid (void);
bool ffest_is_inhibited (void);
bool ffest_seen_first_exec (void);
void ffest_shutdown (void);
ffesymbol ffest_sym_end_transition (ffesymbol s);
ffesymbol ffest_sym_exec_transition (ffesymbol s);
void ffest_terminate_0 (void);
void ffest_terminate_1 (void);
void ffest_terminate_2 (void);
void ffest_terminate_3 (void);
void ffest_terminate_4 (void);
/* Define macros. */
/* End of #include file. */
#endif /* ! GCC_F_ST_H */

1722
gcc/f/sta.c
View file

File diff suppressed because it is too large Load diff

117
gcc/f/sta.h
View file

@ -1,117 +0,0 @@
/* sta.h -- Private #include File (module.h template V1.0)
Copyright (C) 1995 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Owning Modules:
sta.c
Modifications:
*/
/* Allow multiple inclusion to work. */
#ifndef GCC_F_STA_H
#define GCC_F_STA_H
/* Simple definitions and enumerations. */
typedef enum
{
FFESTA_pooldispDISCARD, /* Default state. */
FFESTA_pooldispPRESERVE, /* Preserve through end of program unit. */
FFESTA_pooldisp
} ffestaPooldisp;
#define FFESTA_tokensMAX 10 /* Max # tokens in fixed positions. */
/* Typedefs. */
/* Include files needed by this one. */
#include "bad.h"
#include "lex.h"
#include "malloc.h"
#include "str.h"
#include "symbol.h"
typedef mallocPool ffestaPool; /* No need for use count yet. */
/* Structure definitions. */
/* Global objects accessed by users of this module. */
extern ffelexToken ffesta_tokens[FFESTA_tokensMAX];
extern ffestrFirst ffesta_first_kw;
extern ffestrSecond ffesta_second_kw;
extern mallocPool ffesta_output_pool;
extern mallocPool ffesta_scratch_pool;
extern ffelexToken ffesta_construct_name;
extern ffelexToken ffesta_label_token;
extern bool ffesta_seen_first_exec;
extern bool ffesta_is_entry_valid;
extern bool ffesta_line_has_semicolons;
/* Declare functions with prototypes. */
void ffesta_confirmed (void);
void ffesta_eof (void);
bool ffesta_ffebad_start (ffebad errnum);
void ffesta_ffebad_here_current_stmt (ffebadIndex i);
ffelexHandler ffesta_first (ffelexToken t);
void ffesta_init_0 (void);
void ffesta_init_3 (void);
bool ffesta_is_inhibited (void);
void ffesta_terminate_0 (void);
void ffesta_terminate_1 (void);
void ffesta_terminate_2 (void);
void ffesta_terminate_3 (void);
void ffesta_terminate_4 (void);
void ffesta_ffebad_here_doiter (ffebadIndex i, ffesymbol s);
void ffesta_shutdown (void);
ffesymbol ffesta_sym_end_transition (ffesymbol s);
ffesymbol ffesta_sym_exec_transition (ffesymbol s);
void ffesta_ffebad_1p (ffebad msg, ffelexToken names_token,
ffeTokenLength index, ffelexToken next_token);
void ffesta_ffebad_1sp (ffebad msg, const char *s, ffelexToken names_token,
ffeTokenLength index, ffelexToken next_token);
void ffesta_ffebad_1st (ffebad msg, const char *s, ffelexToken t);
void ffesta_ffebad_1t (ffebad msg, ffelexToken t);
void ffesta_ffebad_2st (ffebad msg, const char *s, ffelexToken t1, ffelexToken t2);
void ffesta_ffebad_2t (ffebad msg, ffelexToken t1, ffelexToken t2);
ffelexHandler ffesta_zero (ffelexToken t);
ffelexHandler ffesta_two (ffelexToken first, ffelexToken second);
ffestaPooldisp ffesta_outpooldisp (void);
void ffesta_set_outpooldisp (ffestaPooldisp d);
/* Define macros. */
#define ffesta_init_1()
#define ffesta_init_2()
#define ffesta_init_4()
#define ffesta_terminate_0()
#define ffesta_terminate_1()
#define ffesta_terminate_2()
#define ffesta_terminate_3()
#define ffesta_terminate_4()
/* End of #include file. */
#endif /* ! GCC_F_STA_H */

17812
gcc/f/stb.c
View file

File diff suppressed because it is too large Load diff

177
gcc/f/stb.h
View file

@ -1,177 +0,0 @@
/* stb.h -- Private #include File (module.h template V1.0)
Copyright (C) 1995, 1996, 2003 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Owning Modules:
stb.c
Modifications:
*/
/* Allow multiple inclusion to work. */
#ifndef GCC_F_STB_H
#define GCC_F_STB_H
/* Simple definitions and enumerations. */
/* Typedefs. */
/* Include files needed by this one. */
#include "bad.h"
#include "expr.h"
#include "lex.h"
#include "stp.h"
#include "str.h"
/* Structure definitions. */
struct _ffestb_args_
{
struct
{
const char *badname;
ffeTokenLength len; /* Length of "ENTRY/FUNCTION/SUBROUTINE". */
bool is_subr; /* TRUE if SUBROUTINE or if ENTRY within
SUBROUTINE. */
}
dummy;
struct
{
const char *badname;
ffeTokenLength len; /* Length of
"BACKSPACE/ENDFILE/REWIND/UNLOCK". */
}
beru;
struct
{
ffeTokenLength len; /* Length of keyword including "END". */
ffestrSecond second; /* Second keyword. */
}
endxyz;
struct
{
ffestrSecond second; /* Second keyword. */
}
elsexyz;
struct
{
ffeTokenLength len; /* Length of "STOP/PAUSE". */
}
halt;
struct
{
const char *badname;
ffeTokenLength len; /* Length of
"EXTERNAL/INTENT/INTRINSIC/OPTIONAL/PUBLIC/
PRIVATE". */
}
varlist;
struct
{
const char *badname;
ffeTokenLength len; /* Length of "DIMENSION/VIRTUAL". */
}
R524;
struct
{
ffeTokenLength len; /* Length of first keyword. */
ffestpType type; /* Type of declaration. */
}
decl;
};
/* Global objects accessed by users of this module. */
extern struct _ffestb_args_ ffestb_args;
/* Declare functions with prototypes. */
ffelexHandler ffestb_beru (ffelexToken t);
ffelexHandler ffestb_block (ffelexToken t);
ffelexHandler ffestb_blockdata (ffelexToken t);
ffelexHandler ffestb_decl_chartype (ffelexToken t);
ffelexHandler ffestb_construct (ffelexToken t);
ffelexHandler ffestb_decl_dbltype (ffelexToken t);
ffelexHandler ffestb_decl_double (ffelexToken t);
ffelexHandler ffestb_dimlist (ffelexToken t);
ffelexHandler ffestb_do (ffelexToken t);
ffelexHandler ffestb_dowhile (ffelexToken t);
ffelexHandler ffestb_dummy (ffelexToken t);
ffelexHandler ffestb_else (ffelexToken t);
ffelexHandler ffestb_elsexyz (ffelexToken t);
ffelexHandler ffestb_end (ffelexToken t);
ffelexHandler ffestb_endxyz (ffelexToken t);
ffelexHandler ffestb_decl_gentype (ffelexToken t);
ffelexHandler ffestb_goto (ffelexToken t);
ffelexHandler ffestb_halt (ffelexToken t);
ffelexHandler ffestb_if (ffelexToken t);
ffelexHandler ffestb_let (ffelexToken t);
ffelexHandler ffestb_varlist (ffelexToken t);
ffelexHandler ffestb_R522 (ffelexToken t);
ffelexHandler ffestb_R524 (ffelexToken t);
ffelexHandler ffestb_R528 (ffelexToken t);
ffelexHandler ffestb_R537 (ffelexToken t);
ffelexHandler ffestb_decl_R539 (ffelexToken t);
ffelexHandler ffestb_R542 (ffelexToken t);
ffelexHandler ffestb_R544 (ffelexToken t);
ffelexHandler ffestb_R547 (ffelexToken t);
ffelexHandler ffestb_R809 (ffelexToken t);
ffelexHandler ffestb_R810 (ffelexToken t);
ffelexHandler ffestb_R834 (ffelexToken t);
ffelexHandler ffestb_R835 (ffelexToken t);
ffelexHandler ffestb_R838 (ffelexToken t);
ffelexHandler ffestb_R840 (ffelexToken t);
ffelexHandler ffestb_R841 (ffelexToken t);
ffelexHandler ffestb_R904 (ffelexToken t);
ffelexHandler ffestb_R907 (ffelexToken t);
ffelexHandler ffestb_R909 (ffelexToken t);
ffelexHandler ffestb_R910 (ffelexToken t);
ffelexHandler ffestb_R911 (ffelexToken t);
ffelexHandler ffestb_R923 (ffelexToken t);
ffelexHandler ffestb_R1001 (ffelexToken t);
ffelexHandler ffestb_R1102 (ffelexToken t);
ffelexHandler ffestb_R1212 (ffelexToken t);
ffelexHandler ffestb_R1227 (ffelexToken t);
ffelexHandler ffestb_R1229 (ffelexToken t);
ffelexHandler ffestb_S3P4 (ffelexToken t);
ffelexHandler ffestb_V014 (ffelexToken t);
ffelexHandler ffestb_V020 (ffelexToken t);
ffelexHandler ffestb_V027 (ffelexToken t);
/* Define macros. */
#define ffestb_init_0()
#define ffestb_init_1()
#define ffestb_init_2()
#define ffestb_init_3()
#define ffestb_init_4()
#define ffestb_terminate_0()
#define ffestb_terminate_1()
#define ffestb_terminate_2()
#define ffestb_terminate_3()
#define ffestb_terminate_4()
/* End of #include file. */
#endif /* ! GCC_F_STB_H */

10459
gcc/f/stc.c
View file

File diff suppressed because it is too large Load diff

234
gcc/f/stc.h
View file

@ -1,234 +0,0 @@
/* stc.h -- Private #include File (module.h template V1.0)
Copyright (C) 1995, 2003 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Owning Modules:
stc.c
Modifications:
*/
/* Allow multiple inclusion to work. */
#ifndef GCC_F_STC_H
#define GCC_F_STC_H
/* Simple definitions and enumerations. */
/* Typedefs. */
/* Include files needed by this one. */
#include "bad.h"
#include "bld.h"
#include "expr.h"
#include "lex.h"
#include "stp.h"
#include "str.h"
#include "stt.h"
/* Structure definitions. */
/* Global objects accessed by users of this module. */
extern ffeexprContext ffestc_iolist_context_;
/* Declare functions with prototypes. */
void ffestc_decl_start (ffestpType type, ffelexToken typet, ffebld kind,
ffelexToken kindt, ffebld len, ffelexToken lent);
void ffestc_decl_attrib (ffestpAttrib attrib, ffelexToken attribt,
ffestrOther intent_kw, ffesttDimList dims);
void ffestc_decl_item (ffelexToken name, ffebld kind, ffelexToken kindt,
ffesttDimList dims, ffebld len, ffelexToken lent,
ffebld init, ffelexToken initt, bool clist);
void ffestc_decl_itemstartvals (void);
void ffestc_decl_itemvalue (ffebld repeat, ffelexToken repeat_token,
ffebld value, ffelexToken value_token);
void ffestc_decl_itemendvals (ffelexToken t);
void ffestc_decl_finish (void);
void ffestc_elsewhere (ffelexToken where_token);
void ffestc_end (void);
void ffestc_eof (void);
bool ffestc_exec_transition (void);
void ffestc_ffebad_here_doiter (ffebadIndex i, ffesymbol s);
void ffestc_init_3 (void);
void ffestc_init_4 (void);
bool ffestc_is_decl_not_R1219 (void);
bool ffestc_is_entry_in_subr (void);
bool ffestc_is_let_not_V027 (void);
#define ffestc_let ffestc_R737
void ffestc_terminate_4 (void);
void ffestc_R501_start (ffestpType type, ffelexToken typet, ffebld kind,
ffelexToken kindt, ffebld len, ffelexToken lent);
void ffestc_R501_attrib (ffestpAttrib attrib, ffelexToken attribt,
ffestrOther intent_kw, ffesttDimList dims);
void ffestc_R501_item (ffelexToken name, ffebld kind, ffelexToken kindt,
ffesttDimList dims, ffebld len, ffelexToken lent, ffebld init,
ffelexToken initt, bool clist);
void ffestc_R501_itemstartvals (void);
void ffestc_R501_itemvalue (ffebld repeat, ffelexToken repeat_token,
ffebld value, ffelexToken value_token);
void ffestc_R501_itemendvals (ffelexToken t);
void ffestc_R501_finish (void);
void ffestc_R522 (void);
void ffestc_R522start (void);
void ffestc_R522item_object (ffelexToken name);
void ffestc_R522item_cblock (ffelexToken name);
void ffestc_R522finish (void);
void ffestc_R524_start (bool virtual);
void ffestc_R524_item (ffelexToken name, ffesttDimList dims);
void ffestc_R524_finish (void);
void ffestc_R528_start (void);
void ffestc_R528_item_object (ffebld expr, ffelexToken expr_token);
void ffestc_R528_item_startvals (void);
void ffestc_R528_item_value (ffebld repeat, ffelexToken repeat_token,
ffebld value, ffelexToken value_token);
void ffestc_R528_item_endvals (ffelexToken t);
void ffestc_R528_finish (void);
void ffestc_R537_start (void);
void ffestc_R537_item (ffebld dest, ffelexToken dest_token, ffebld source,
ffelexToken source_token);
void ffestc_R537_finish (void);
void ffestc_R539 (void);
void ffestc_R539start (void);
void ffestc_R539item (ffestpType type, ffebld kind, ffelexToken kindt,
ffebld len, ffelexToken lent, ffesttImpList letters);
void ffestc_R539finish (void);
void ffestc_R542_start (void);
void ffestc_R542_item_nlist (ffelexToken name);
void ffestc_R542_item_nitem (ffelexToken name);
void ffestc_R542_finish (void);
void ffestc_R544_start (void);
void ffestc_R544_item (ffesttExprList exprlist);
void ffestc_R544_finish (void);
void ffestc_R547_start (void);
void ffestc_R547_item_object (ffelexToken name, ffesttDimList dims);
void ffestc_R547_item_cblock (ffelexToken name);
void ffestc_R547_finish (void);
void ffestc_R737 (ffebld dest, ffebld source, ffelexToken source_token);
void ffestc_R803 (ffelexToken construct_name, ffebld expr,
ffelexToken expr_token);
void ffestc_R804 (ffebld expr, ffelexToken expr_token, ffelexToken name);
void ffestc_R805 (ffelexToken name);
void ffestc_R806 (ffelexToken name);
void ffestc_R807 (ffebld expr, ffelexToken expr_token);
void ffestc_R809 (ffelexToken construct_name, ffebld expr,
ffelexToken expr_token);
void ffestc_R810 (ffesttCaseList cases, ffelexToken name);
void ffestc_R811 (ffelexToken name);
void ffestc_R819A (ffelexToken construct_name, ffelexToken label, ffebld var,
ffelexToken var_token, ffebld start, ffelexToken start_token, ffebld end,
ffelexToken end_token, ffebld incr, ffelexToken incr_token);
void ffestc_R819B (ffelexToken construct_name, ffelexToken label, ffebld expr,
ffelexToken expr_token);
void ffestc_R820A (ffelexToken construct_name, ffebld var,
ffelexToken var_token, ffebld start, ffelexToken start_token, ffebld end,
ffelexToken end_token, ffebld incr, ffelexToken incr_token);
void ffestc_R820B (ffelexToken construct_name, ffebld expr,
ffelexToken expr_token);
void ffestc_R825 (ffelexToken name);
void ffestc_R834 (ffelexToken name);
void ffestc_R835 (ffelexToken name);
void ffestc_R836 (ffelexToken label);
void ffestc_R837 (ffesttTokenList label_toks, ffebld expr,
ffelexToken expr_token);
void ffestc_R838 (ffelexToken label, ffebld target, ffelexToken target_token);
void ffestc_R839 (ffebld target, ffelexToken target_token,
ffesttTokenList label_toks);
void ffestc_R840 (ffebld expr, ffelexToken expr_token, ffelexToken neg,
ffelexToken zero, ffelexToken pos);
void ffestc_R841 (void);
void ffestc_R842 (ffebld expr, ffelexToken expr_token);
void ffestc_R843 (ffebld expr, ffelexToken expr_token);
void ffestc_R904 (void);
void ffestc_R907 (void);
void ffestc_R909_start (bool only_format);
void ffestc_R909_item (ffebld expr, ffelexToken expr_token);
void ffestc_R909_finish (void);
void ffestc_R910_start (void);
void ffestc_R910_item (ffebld expr, ffelexToken expr_token);
void ffestc_R910_finish (void);
void ffestc_R911_start (void);
void ffestc_R911_item (ffebld expr, ffelexToken expr_token);
void ffestc_R911_finish (void);
void ffestc_R919 (void);
void ffestc_R920 (void);
void ffestc_R921 (void);
void ffestc_R923A (void);
void ffestc_R923B_start (void);
void ffestc_R923B_item (ffebld expr, ffelexToken expr_token);
void ffestc_R923B_finish (void);
void ffestc_R1001 (ffesttFormatList f);
void ffestc_R1102 (ffelexToken name);
void ffestc_R1103 (ffelexToken name);
void ffestc_R1111 (ffelexToken name);
void ffestc_R1112 (ffelexToken name);
void ffestc_R1207_start (void);
void ffestc_R1207_item (ffelexToken name);
void ffestc_R1207_finish (void);
void ffestc_R1208_start (void);
void ffestc_R1208_item (ffelexToken name);
void ffestc_R1208_finish (void);
void ffestc_R1212 (ffebld expr, ffelexToken expr_token);
void ffestc_R1219 (ffelexToken funcname, ffesttTokenList args,
ffelexToken final, ffestpType type, ffebld kind, ffelexToken kindt,
ffebld len, ffelexToken lent, ffelexToken recursive, ffelexToken result);
void ffestc_R1221 (ffelexToken name);
void ffestc_R1223 (ffelexToken subrname, ffesttTokenList args,
ffelexToken final, ffelexToken recursive);
void ffestc_R1225 (ffelexToken name);
void ffestc_R1226 (ffelexToken entryname, ffesttTokenList args,
ffelexToken final);
void ffestc_R1227 (ffebld expr, ffelexToken expr_token);
void ffestc_R1229_start (ffelexToken name, ffesttTokenList args,
ffelexToken final);
void ffestc_R1229_finish (ffebld expr, ffelexToken expr_token);
void ffestc_S3P4 (ffebld filename, ffelexToken filename_token);
void ffestc_V014_start (void);
void ffestc_V014_item_object (ffelexToken name);
void ffestc_V014_item_cblock (ffelexToken name);
void ffestc_V014_finish (void);
void ffestc_V020_start (void);
void ffestc_V020_item (ffebld expr, ffelexToken expr_token);
void ffestc_V020_finish (void);
void ffestc_V027_start (void);
void ffestc_V027_item (ffelexToken dest_token, ffebld source,
ffelexToken source_token);
void ffestc_V027_finish (void);
void ffestc_any (void);
/* Define macros. */
#define ffestc_context_iolist() ffestc_iolist_context_
#define ffestc_init_0()
#define ffestc_init_1()
#define ffestc_init_2()
#define ffestc_terminate_0()
#define ffestc_terminate_1()
#define ffestc_terminate_2()
#define ffestc_terminate_3()
/* End of #include file. */
#endif /* ! GCC_F_STC_H */

3623
gcc/f/std.c
View file

File diff suppressed because it is too large Load diff

194
gcc/f/std.h
View file

@ -1,194 +0,0 @@
/* std.h -- Private #include File (module.h template V1.0)
Copyright (C) 1995, 2003 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Owning Modules:
std.c
Modifications:
*/
/* Allow multiple inclusion to work. */
#ifndef GCC_F_STD_H
#define GCC_F_STD_H
/* Simple definitions and enumerations. */
/* Typedefs. */
/* Include files needed by this one. */
#include "bld.h"
#include "lab.h"
#include "lex.h"
#include "stp.h"
#include "str.h"
#include "stt.h"
#include "stv.h"
#include "stw.h"
#include "symbol.h"
/* Structure definitions. */
/* Global objects accessed by users of this module. */
/* Declare functions with prototypes. */
void ffestd_begin_uses (void);
void ffestd_do (bool ok);
void ffestd_end_R807 (bool ok);
void ffestd_exec_begin (void);
void ffestd_exec_end (void);
void ffestd_init_3 (void);
void ffestd_labeldef_any (ffelab label);
void ffestd_labeldef_branch (ffelab label);
void ffestd_labeldef_format (ffelab label);
void ffestd_labeldef_useless (ffelab label);
void ffestd_R522 (void);
void ffestd_R522start (void);
void ffestd_R522item_object (ffelexToken name);
void ffestd_R522item_cblock (ffelexToken name);
void ffestd_R522finish (void);
void ffestd_R524_start (bool virtual);
void ffestd_R524_item (ffelexToken name, ffesttDimList dims);
void ffestd_R524_finish (void);
void ffestd_R537_start (void);
void ffestd_R537_item (ffebld dest, ffebld source);
void ffestd_R537_finish (void);
void ffestd_R539 (void);
void ffestd_R539start (void);
void ffestd_R539item (ffestpType type, ffebld kind, ffelexToken kindt,
ffebld len, ffelexToken lent, ffesttImpList letters);
void ffestd_R539finish (void);
void ffestd_R542_start (void);
void ffestd_R542_item_nlist (ffelexToken name);
void ffestd_R542_item_nitem (ffelexToken name);
void ffestd_R542_finish (void);
void ffestd_R544_start (void);
void ffestd_R544_item (ffesttExprList exprlist);
void ffestd_R544_finish (void);
void ffestd_R547_start (void);
void ffestd_R547_item_object (ffelexToken name, ffesttDimList dims);
void ffestd_R547_item_cblock (ffelexToken name);
void ffestd_R547_finish (void);
void ffestd_R737A (ffebld dest, ffebld source);
void ffestd_R803 (ffelexToken construct_name, ffebld expr);
void ffestd_R804 (ffebld expr, ffelexToken name);
void ffestd_R805 (ffelexToken name);
void ffestd_R806 (bool ok);
void ffestd_R807 (ffebld expr);
void ffestd_R809 (ffelexToken construct_name, ffebld expr);
void ffestd_R810 (unsigned long casenum);
void ffestd_R811 (bool ok);
void ffestd_R819A (ffelexToken construct_name, ffelab label, ffebld var,
ffebld start, ffelexToken start_token,
ffebld end, ffelexToken end_token,
ffebld incr, ffelexToken incr_token);
void ffestd_R819B (ffelexToken construct_name, ffelab label, ffebld expr);
void ffestd_R825 (ffelexToken name);
void ffestd_R834 (ffestw block);
void ffestd_R835 (ffestw block);
void ffestd_R836 (ffelab label);
void ffestd_R837 (ffelab *labels, int count, ffebld expr);
void ffestd_R838 (ffelab label, ffebld target);
void ffestd_R839 (ffebld target, ffelab *labels, int count);
void ffestd_R840 (ffebld expr, ffelab neg, ffelab zero, ffelab pos);
void ffestd_R841 (bool in_where);
void ffestd_R842 (ffebld expr);
void ffestd_R843 (ffebld expr);
void ffestd_R904 (void);
void ffestd_R907 (void);
void ffestd_R909_start (bool only_format, ffestvUnit unit,
ffestvFormat format, bool rec, bool key);
void ffestd_R909_item (ffebld expr, ffelexToken expr_token);
void ffestd_R909_finish (void);
void ffestd_R910_start (ffestvUnit unit, ffestvFormat format, bool rec);
void ffestd_R910_item (ffebld expr, ffelexToken expr_token);
void ffestd_R910_finish (void);
void ffestd_R911_start (ffestvFormat format);
void ffestd_R911_item (ffebld expr, ffelexToken expr_token);
void ffestd_R911_finish (void);
void ffestd_R919 (void);
void ffestd_R920 (void);
void ffestd_R921 (void);
void ffestd_R923A (bool by_file);
void ffestd_R923B_start (void);
void ffestd_R923B_item (ffebld expr);
void ffestd_R923B_finish (void);
void ffestd_R1001 (ffesttFormatList f);
void ffestd_R1102 (ffesymbol s, ffelexToken name);
void ffestd_R1103 (bool ok);
void ffestd_R1111 (ffesymbol s, ffelexToken name);
void ffestd_R1112 (bool ok);
void ffestd_R1207_start (void);
void ffestd_R1207_item (ffelexToken name);
void ffestd_R1207_finish (void);
void ffestd_R1208_start (void);
void ffestd_R1208_item (ffelexToken name);
void ffestd_R1208_finish (void);
void ffestd_R1212 (ffebld expr);
void ffestd_R1219 (ffesymbol s, ffelexToken funcname,
ffesttTokenList args, ffestpType type, ffebld kind,
ffelexToken kindt, ffebld len, ffelexToken lent,
bool recursive, ffelexToken result,
bool separate_result);
void ffestd_R1221 (bool ok);
void ffestd_R1223 (ffesymbol s, ffelexToken subrname, ffesttTokenList args,
ffelexToken final, bool recursive);
void ffestd_R1225 (bool ok);
void ffestd_R1226 (ffesymbol entry);
void ffestd_R1227 (ffebld expr);
void ffestd_R1229_start (ffelexToken name, ffesttTokenList args);
void ffestd_R1229_finish (ffesymbol s);
void ffestd_S3P4 (ffebld filename);
void ffestd_V014_start (void);
void ffestd_V014_item_object (ffelexToken name);
void ffestd_V014_item_cblock (ffelexToken name);
void ffestd_V014_finish (void);
void ffestd_V020_start (ffestvFormat format);
void ffestd_V020_item (ffebld expr);
void ffestd_V020_finish (void);
void ffestd_V027_start (void);
void ffestd_V027_item (ffelexToken dest_token, ffebld source);
void ffestd_V027_finish (void);
void ffestd_any (void);
/* Define macros. */
#define ffestd_init_0()
#define ffestd_init_1()
#define ffestd_init_2()
#define ffestd_init_4()
#define ffestd_labeldef_notloop(l) ffestd_labeldef_branch(l)
#define ffestd_labeldef_endif(l) ffestd_labeldef_branch(l)
#define ffestd_terminate_0()
#define ffestd_terminate_1()
#define ffestd_terminate_2()
#define ffestd_terminate_3()
#define ffestd_terminate_4()
/* End of #include file. */
#endif /* ! GCC_F_STD_H */

4475
gcc/f/ste.c
View file

File diff suppressed because it is too large Load diff

144
gcc/f/ste.h
View file

@ -1,144 +0,0 @@
/* ste.h -- Private #include File (module.h template V1.0)
Copyright (C) 1995, 2003 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Owning Modules:
ste.c
Modifications:
*/
/* Allow multiple inclusion to work. */
#ifndef GCC_F_STE_H
#define GCC_F_STE_H
/* Simple definitions and enumerations. */
/* Typedefs. */
/* Include files needed by this one. */
#include "bld.h"
#include "lab.h"
#include "lex.h"
#include "stp.h"
#include "str.h"
#include "sts.h"
#include "stt.h"
#include "stv.h"
#include "stw.h"
#include "symbol.h"
/* Structure definitions. */
/* Global objects accessed by users of this module. */
/* Declare functions with prototypes. */
void ffeste_do (ffestw block);
void ffeste_end_R807 (void);
void ffeste_labeldef_branch (ffelab label);
void ffeste_labeldef_format (ffelab label);
void ffeste_R737A (ffebld dest, ffebld source);
void ffeste_R803 (ffestw block, ffebld expr);
void ffeste_R804 (ffestw block, ffebld expr);
void ffeste_R805 (ffestw block);
void ffeste_R806 (ffestw block);
void ffeste_R807 (ffebld expr);
void ffeste_R809 (ffestw block, ffebld expr);
void ffeste_R810 (ffestw block, unsigned long casenum);
void ffeste_R811 (ffestw block);
void ffeste_R819A (ffestw block, ffelab label, ffebld var,
ffebld start, ffelexToken start_token,
ffebld end, ffelexToken end_token,
ffebld incr, ffelexToken incr_token);
void ffeste_R819B (ffestw block, ffelab label, ffebld expr);
void ffeste_R825 (void);
void ffeste_R834 (ffestw block);
void ffeste_R835 (ffestw block);
void ffeste_R836 (ffelab label);
void ffeste_R837 (ffelab *labels, int count, ffebld expr);
void ffeste_R838 (ffelab label, ffebld target);
void ffeste_R839 (ffebld target);
void ffeste_R840 (ffebld expr, ffelab neg, ffelab zero, ffelab pos);
void ffeste_R841 (void);
void ffeste_R842 (ffebld expr);
void ffeste_R843 (ffebld expr);
void ffeste_R904 (ffestpOpenStmt *info);
void ffeste_R907 (ffestpCloseStmt *info);
void ffeste_R909_start (ffestpReadStmt *info, bool only_format,
ffestvUnit unit, ffestvFormat format, bool rec, bool key);
void ffeste_R909_item (ffebld expr, ffelexToken expr_token);
void ffeste_R909_finish (void);
void ffeste_R910_start (ffestpWriteStmt *info, ffestvUnit unit,
ffestvFormat format, bool rec);
void ffeste_R910_item (ffebld expr, ffelexToken expr_token);
void ffeste_R910_finish (void);
void ffeste_R911_start (ffestpPrintStmt *info, ffestvFormat format);
void ffeste_R911_item (ffebld expr, ffelexToken expr_token);
void ffeste_R911_finish (void);
void ffeste_R919 (ffestpBeruStmt *info);
void ffeste_R920 (ffestpBeruStmt *info);
void ffeste_R921 (ffestpBeruStmt *info);
void ffeste_R923A (ffestpInquireStmt *info, bool by_file);
void ffeste_R923B_start (ffestpInquireStmt *info);
void ffeste_R923B_item (ffebld expr);
void ffeste_R923B_finish (void);
void ffeste_R1001 (ffests s);
void ffeste_R1103 (void);
void ffeste_R1112 (void);
void ffeste_R1212 (ffebld expr);
void ffeste_R1221 (void);
void ffeste_R1225 (void);
void ffeste_R1226 (ffesymbol entry);
void ffeste_R1227 (ffestw block, ffebld expr);
void ffeste_V020_start (ffestpTypeStmt *info, ffestvFormat format);
void ffeste_V020_item (ffebld expr);
void ffeste_V020_finish (void);
/* Define macros. */
#define ffeste_init_0()
#define ffeste_init_1()
#define ffeste_init_2()
#define ffeste_init_3()
#define ffeste_init_4()
#define ffeste_filename() input_filename
#define ffeste_filelinenum() input_line
#define ffeste_set_line(name,num) \
(input_filename = (name), input_line = (num))
#define ffeste_terminate_0()
#define ffeste_terminate_1()
#ifdef ENABLE_CHECKING
void ffeste_terminate_2 (void);
#else
#define ffeste_terminate_2()
#endif
#define ffeste_terminate_3()
#define ffeste_terminate_4()
/* End of #include file. */
#endif /* ! GCC_F_STE_H */

570
gcc/f/storag.c
View file

@ -1,570 +0,0 @@
/* storag.c -- Implementation File (module.c template V1.0)
Copyright (C) 1995, 1996, 2003 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Related Modules:
None
Description:
Maintains information on storage (memory) relationships between
COMMON, dummy, and local variables, plus their equivalences (dummies
don't have equivalences, however).
Modifications:
*/
/* Include files. */
#include "proj.h"
#include "storag.h"
#include "data.h"
#include "malloc.h"
#include "symbol.h"
#include "target.h"
/* Externals defined here. */
ffestoragList_ ffestorag_list_;
/* Simple definitions and enumerations. */
/* Internal typedefs. */
/* Private include files. */
/* Internal structure definitions. */
/* Static objects accessed by functions in this module. */
static ffetargetOffset ffestorag_local_size_; /* #units allocated so far. */
static bool ffestorag_reported_;/* Reports happen only once. */
/* Static functions (internal). */
/* Internal macros. */
#define ffestorag_next_(s) ((s)->next)
#define ffestorag_previous_(s) ((s)->previous)
/* ffestorag_drive -- Drive fn from list of storage objects
ffestoragList sl;
void (*fn)(ffestorag mst,ffestorag st);
ffestorag mst; // the master ffestorag object (or whatever)
ffestorag_drive(sl,fn,mst);
Calls (*fn)(mst,st) for every st in the list sl. */
void
ffestorag_drive (ffestoragList sl, void (*fn) (ffestorag mst, ffestorag st),
ffestorag mst)
{
ffestorag st;
for (st = sl->first;
st != (ffestorag) &sl->first;
st = st->next)
(*fn) (mst, st);
}
/* ffestorag_dump -- Dump information on storage object
ffestorag s; // the ffestorag object
ffestorag_dump(s);
Dumps information in the storage object. */
void
ffestorag_dump (ffestorag s)
{
if (s == NULL)
{
fprintf (dmpout, "(no storage object)");
return;
}
switch (s->type)
{
case FFESTORAG_typeCBLOCK:
fprintf (dmpout, "CBLOCK ");
break;
case FFESTORAG_typeCOMMON:
fprintf (dmpout, "COMMON ");
break;
case FFESTORAG_typeLOCAL:
fprintf (dmpout, "LOCAL ");
break;
case FFESTORAG_typeEQUIV:
fprintf (dmpout, "EQUIV ");
break;
default:
fprintf (dmpout, "?%d? ", s->type);
break;
}
if (s->symbol != NULL)
fprintf (dmpout, "\"%s\" ", ffesymbol_text (s->symbol));
fprintf (dmpout, "at %" ffetargetOffset_f "d size %" ffetargetOffset_f
"d, align loc%%%"
ffetargetAlign_f "u=%" ffetargetAlign_f "u, bt=%s, kt=%s",
s->offset,
s->size, (unsigned int) s->alignment, (unsigned int) s->modulo,
ffeinfo_basictype_string (s->basic_type),
ffeinfo_kindtype_string (s->kind_type));
if (s->equivs_.first != (ffestorag) &s->equivs_.first)
{
ffestorag sq;
fprintf (dmpout, " with equivs");
for (sq = s->equivs_.first;
sq != (ffestorag) &s->equivs_.first;
sq = ffestorag_next_ (sq))
{
if (ffestorag_previous_ (sq) == (ffestorag) &s->equivs_.first)
fputc (' ', dmpout);
else
fputc (',', dmpout);
fprintf (dmpout, "%s", ffesymbol_text (ffestorag_symbol (sq)));
}
}
}
/* ffestorag_init_2 -- Initialize for new program unit
ffestorag_init_2(); */
void
ffestorag_init_2 (void)
{
ffestorag_list_.first = ffestorag_list_.last
= (ffestorag) &ffestorag_list_.first;
ffestorag_local_size_ = 0;
ffestorag_reported_ = FALSE;
}
/* ffestorag_end_layout -- Do final layout for symbol
ffesymbol s;
ffestorag_end_layout(s); */
void
ffestorag_end_layout (ffesymbol s)
{
if (ffesymbol_storage (s) != NULL)
return; /* Already laid out. */
ffestorag_exec_layout (s); /* Do what we have in common. */
#if 0
assert (ffesymbol_storage (s) == NULL); /* I'd like to know what
cases miss going through
ffecom_sym_learned, and
why; I don't think we
should have to do the
exec_layout thing at all
here. */
/* Now I think I know: we have to do exec_layout here, because equivalence
handling could encounter an error that takes a variable off of its
equivalence object (and vice versa), and we should then layout the var
as a local entity. */
#endif
}
/* ffestorag_exec_layout -- Do initial layout for symbol
ffesymbol s;
ffestorag_exec_layout(s); */
void
ffestorag_exec_layout (ffesymbol s)
{
ffetargetAlign alignment;
ffetargetAlign modulo;
ffetargetOffset size;
ffetargetOffset num_elements;
ffetargetAlign pad;
ffestorag st;
ffestorag stv;
ffebld list;
ffebld item;
ffesymbol var;
bool init;
if (ffesymbol_storage (s) != NULL)
return; /* Already laid out. */
switch (ffesymbol_kind (s))
{
default:
return; /* Do nothing. */
case FFEINFO_kindENTITY:
switch (ffesymbol_where (s))
{
case FFEINFO_whereLOCAL:
if (ffesymbol_equiv (s) != NULL)
return; /* Let ffeequiv handle this guy. */
if (ffesymbol_rank (s) == 0)
num_elements = 1;
else
{
if (ffebld_op (ffesymbol_arraysize (s))
!= FFEBLD_opCONTER)
return; /* An adjustable local array, just like a dummy. */
num_elements
= ffebld_constant_integerdefault (ffebld_conter
(ffesymbol_arraysize (s)));
}
ffetarget_layout (ffesymbol_text (s), &alignment, &modulo,
&size, ffesymbol_basictype (s),
ffesymbol_kindtype (s), ffesymbol_size (s),
num_elements);
st = ffestorag_new (ffestorag_list_master ());
st->parent = NULL; /* Initializations happen at sym level. */
st->init = NULL;
st->accretion = NULL;
st->symbol = s;
st->size = size;
st->offset = 0;
st->alignment = alignment;
st->modulo = modulo;
st->type = FFESTORAG_typeLOCAL;
st->basic_type = ffesymbol_basictype (s);
st->kind_type = ffesymbol_kindtype (s);
st->type_symbol = s;
st->is_save = ffesymbol_is_save (s);
st->is_init = ffesymbol_is_init (s);
ffesymbol_set_storage (s, st);
if (ffesymbol_is_init (s))
ffecom_notify_init_symbol (s); /* Init completed before, but
we didn't have a storage
object for it; maybe back
end wants to see the sym
again now. */
ffesymbol_signal_unreported (s);
return;
case FFEINFO_whereCOMMON:
return; /* Allocate storage for entire common block
at once. */
case FFEINFO_whereDUMMY:
return; /* Don't do anything about dummies for now. */
case FFEINFO_whereRESULT:
case FFEINFO_whereIMMEDIATE:
case FFEINFO_whereCONSTANT:
case FFEINFO_whereNONE:
return; /* These don't get storage (esp. NONE, which
is UNCERTAIN). */
default:
assert ("bad ENTITY where" == NULL);
return;
}
break;
case FFEINFO_kindCOMMON:
assert (ffesymbol_where (s) == FFEINFO_whereLOCAL);
st = ffestorag_new (ffestorag_list_master ());
st->parent = NULL; /* Initializations happen here. */
st->init = NULL;
st->accretion = NULL;
st->symbol = s;
st->size = 0;
st->offset = 0;
st->alignment = 1;
st->modulo = 0;
st->type = FFESTORAG_typeCBLOCK;
if (ffesymbol_commonlist (s) != NULL)
{
var = ffebld_symter (ffebld_head (ffesymbol_commonlist (s)));
st->basic_type = ffesymbol_basictype (var);
st->kind_type = ffesymbol_kindtype (var);
st->type_symbol = var;
}
else
{ /* Special case for empty common area:
NONE/NONE means nothing. */
st->basic_type = FFEINFO_basictypeNONE;
st->kind_type = FFEINFO_kindtypeNONE;
st->type_symbol = NULL;
}
st->is_save = ffesymbol_is_save (s);
st->is_init = ffesymbol_is_init (s);
if (!ffe_is_mainprog ())
ffeglobal_save_common (s,
st->is_save || ffe_is_saveall (),
ffesymbol_where_line (s),
ffesymbol_where_column (s));
ffesymbol_set_storage (s, st);
init = FALSE;
for (list = ffesymbol_commonlist (s);
list != NULL;
list = ffebld_trail (list))
{
item = ffebld_head (list);
assert (ffebld_op (item) == FFEBLD_opSYMTER);
var = ffebld_symter (item);
if (ffesymbol_basictype (var) == FFEINFO_basictypeANY)
continue; /* Ignore any symbols that have errors. */
if (ffesymbol_rank (var) == 0)
num_elements = 1;
else
num_elements = ffebld_constant_integerdefault (ffebld_conter
(ffesymbol_arraysize (var)));
ffetarget_layout (ffesymbol_text (var), &alignment, &modulo,
&size, ffesymbol_basictype (var),
ffesymbol_kindtype (var), ffesymbol_size (var),
num_elements);
pad = ffetarget_align (&st->alignment, &st->modulo, st->size,
alignment, modulo);
if (pad != 0)
{ /* Warn about padding in the midst of a
common area. */
char padding[20];
sprintf (&padding[0], "%" ffetargetAlign_f "u", pad);
ffebad_start (FFEBAD_COMMON_PAD);
ffebad_string (padding);
ffebad_string (ffesymbol_text (var));
ffebad_string (ffesymbol_text (s));
ffebad_string ((pad == 1)
? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
ffebad_here (0, ffesymbol_where_line (s), ffesymbol_where_column (s));
ffebad_finish ();
}
stv = ffestorag_new (ffestorag_list_master ());
stv->parent = st; /* Initializations happen in COMMON block. */
stv->init = NULL;
stv->accretion = NULL;
stv->symbol = var;
stv->size = size;
if (!ffetarget_offset_add (&stv->offset, st->size, pad))
{ /* Common block size plus pad, complain if
overflow. */
ffetarget_offset_overflow (ffesymbol_text (s));
}
if (!ffetarget_offset_add (&st->size, stv->offset, stv->size))
{ /* Adjust size of common block, complain if
overflow. */
ffetarget_offset_overflow (ffesymbol_text (s));
}
stv->alignment = alignment;
stv->modulo = modulo;
stv->type = FFESTORAG_typeCOMMON;
stv->basic_type = ffesymbol_basictype (var);
stv->kind_type = ffesymbol_kindtype (var);
stv->type_symbol = var;
stv->is_save = st->is_save;
stv->is_init = st->is_init;
ffesymbol_set_storage (var, stv);
ffesymbol_signal_unreported (var);
ffestorag_update (st, var, ffesymbol_basictype (var),
ffesymbol_kindtype (var));
if (ffesymbol_is_init (var))
init = TRUE; /* Must move inits over to COMMON's
ffestorag. */
}
if (ffeequiv_layout_cblock (st))
init = TRUE;
ffeglobal_pad_common (s, st->modulo, ffesymbol_where_line (s),
ffesymbol_where_column (s));
if (init)
ffedata_gather (st); /* Gather subordinate inits into one init. */
ffesymbol_signal_unreported (s);
return;
}
}
/* ffestorag_new -- Create new ffestorag object, append to list
ffestorag s;
ffestoragList sl;
s = ffestorag_new(sl); */
ffestorag
ffestorag_new (ffestoragList sl)
{
ffestorag s;
s = malloc_new_kp (ffe_pool_program_unit (), "ffestorag", sizeof (*s));
s->next = (ffestorag) &sl->first;
s->previous = sl->last;
s->hook = FFECOM_storageNULL;
s->previous->next = s;
sl->last = s;
s->equivs_.first = s->equivs_.last = (ffestorag) &s->equivs_.first;
return s;
}
/* Report info on LOCAL non-sym-assoc'ed entities if needed. */
void
ffestorag_report (void)
{
ffestorag s;
if (ffestorag_reported_)
return;
for (s = ffestorag_list_.first;
s != (ffestorag) &ffestorag_list_.first;
s = s->next)
{
if (s->symbol == NULL)
{
ffestorag_reported_ = TRUE;
fputs ("Storage area: ", dmpout);
ffestorag_dump (s);
fputc ('\n', dmpout);
}
}
}
/* ffestorag_update -- Update type info for ffestorag object
ffestorag s; // existing object
ffeinfoBasictype bt; // basic type for newly added member of object
ffeinfoKindtype kt; // kind type for it
ffestorag_update(s,bt,kt);
If the existing type for the storage object agrees with the new type
info, just returns. If the basic types agree but not the kind types,
sets the kind type for the object to NONE. If the basic types
disagree, sets the kind type to NONE, and the basic type to NONE if the
basic types both are not CHARACTER, otherwise to ANY. If the basic
type for the object already is NONE, it is set to ANY if the new basic
type is CHARACTER. Any time a transition is made to ANY and pedantic
mode is on, a message is issued that mixing CHARACTER and non-CHARACTER
stuff in the same COMMON/EQUIVALENCE is invalid. */
void
ffestorag_update (ffestorag s, ffesymbol sym, ffeinfoBasictype bt,
ffeinfoKindtype kt)
{
if (s->basic_type == bt)
{
if (s->kind_type == kt)
return;
s->kind_type = FFEINFO_kindtypeNONE;
return;
}
switch (s->basic_type)
{
case FFEINFO_basictypeANY:
return; /* No need to do anything further. */
case FFEINFO_basictypeCHARACTER:
any: /* :::::::::::::::::::: */
s->basic_type = FFEINFO_basictypeANY;
s->kind_type = FFEINFO_kindtypeANY;
if (ffe_is_pedantic ())
{
ffebad_start (FFEBAD_MIXED_TYPES);
ffebad_string (ffesymbol_text (s->type_symbol));
ffebad_string (ffesymbol_text (sym));
ffebad_finish ();
}
return;
default:
if (bt == FFEINFO_basictypeCHARACTER)
goto any; /* :::::::::::::::::::: */
s->basic_type = FFEINFO_basictypeNONE;
s->kind_type = FFEINFO_kindtypeNONE;
return;
}
}
/* Update INIT flag for storage object.
If the INIT flag for the <s> object is already TRUE, return. Else,
set it to TRUE and call ffe*_update_init for all contained objects. */
void
ffestorag_update_init (ffestorag s)
{
ffestorag sq;
if (s->is_init)
return;
s->is_init = TRUE;
if ((s->symbol != NULL)
&& !ffesymbol_is_init (s->symbol))
ffesymbol_update_init (s->symbol);
if (s->parent != NULL)
ffestorag_update_init (s->parent);
for (sq = s->equivs_.first;
sq != (ffestorag) &s->equivs_.first;
sq = ffestorag_next_ (sq))
{
if (!sq->is_init)
ffestorag_update_init (sq);
}
}
/* Update SAVE flag for storage object.
If the SAVE flag for the <s> object is already TRUE, return. Else,
set it to TRUE and call ffe*_update_save for all contained objects. */
void
ffestorag_update_save (ffestorag s)
{
ffestorag sq;
if (s->is_save)
return;
s->is_save = TRUE;
if ((s->symbol != NULL)
&& !ffesymbol_is_save (s->symbol))
ffesymbol_update_save (s->symbol);
if (s->parent != NULL)
ffestorag_update_save (s->parent);
for (sq = s->equivs_.first;
sq != (ffestorag) &s->equivs_.first;
sq = ffestorag_next_ (sq))
{
if (!sq->is_save)
ffestorag_update_save (sq);
}
}

165
gcc/f/storag.h
View file

@ -1,165 +0,0 @@
/* storag.h -- Public #include File (module.h template V1.0)
Copyright (C) 1995, 1996, 2003 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Owning Modules:
storag.c
Modifications:
*/
/* Allow multiple inclusion to work. */
#ifndef GCC_F_STORAG_H
#define GCC_F_STORAG_H
/* Simple definitions and enumerations. */
typedef enum
{
FFESTORAG_typeNONE,
FFESTORAG_typeCBLOCK, /* A COMMON block. */
FFESTORAG_typeCOMMON, /* A COMMON variable. */
FFESTORAG_typeLOCAL, /* A local entity (var/array/equivalence). */
FFESTORAG_typeEQUIV, /* An entity equivalenced into a COMMON/LOCAL
entity. */
FFESTORAG_type
} ffestoragType;
/* Typedefs. */
typedef struct _ffestorag_ *ffestorag;
typedef struct _ffestorag_list_ *ffestoragList;
typedef struct _ffestorag_list_ ffestoragList_;
/* Include files needed by this one. */
#include "bld.h"
#include "info.h"
#include "symbol.h"
#include "target.h"
/* Structure definitions. */
struct _ffestorag_list_
{
ffestorag first; /* First storage area in list. */
ffestorag last; /* Last storage area in list. */
};
struct _ffestorag_
{
ffestorag next; /* Next storage area in list. */
ffestorag previous; /* Previous storage area in list. */
ffestorag parent; /* Parent who holds aggregate
initializations. */
ffebld init; /* Initialization expression. */
ffebld accretion; /* Initializations seen so far for aggregate. */
ffetargetOffset accretes; /* # inits needed to fill entire aggregate. */
ffesymbol symbol; /* NULL if typeLOCAL and non-NULL equivs
and the first "rooted" symbol not known. */
ffestoragList_ equivs_; /* NULL if typeLOCAL and not an EQUIVALENCE
area. */
ffetargetOffset size; /* Size of area. */
ffetargetOffset offset; /* Offset of entity within area, 0 for CBLOCK
and non-equivalence LOCAL, <= 0 for equivalence
LOCAL. */
ffetargetAlign alignment; /* Initial alignment for entity. */
ffetargetAlign modulo; /* Modulo within alignment. */
ffecomStorage hook; /* Whatever the backend needs here. */
ffestoragType type;
ffeinfoBasictype basic_type;/* NONE= >1 non-CHARACTER; ANY=
CHAR+non-CHAR. */
ffeinfoKindtype kind_type; /* NONE= >1 kind type or NONE/ANY basic_type. */
ffesymbol type_symbol; /* First symbol for basic_type/kind_type. */
bool is_save; /* SAVE flag set for this storage area. */
bool is_init; /* INIT flag set for this storage area. */
};
/* Global objects accessed by users of this module. */
extern ffestoragList_ ffestorag_list_;
/* Declare functions with prototypes. */
void ffestorag_drive (ffestoragList sl, void (*fn) (ffestorag mst, ffestorag st),
ffestorag mst);
void ffestorag_dump (ffestorag s);
void ffestorag_end_layout (ffesymbol s);
void ffestorag_exec_layout (ffesymbol s);
void ffestorag_init_2 (void);
ffestorag ffestorag_new (ffestoragList sl);
void ffestorag_report (void);
void ffestorag_update (ffestorag s, ffesymbol sym, ffeinfoBasictype bt,
ffeinfoKindtype kt);
void ffestorag_update_init (ffestorag s);
void ffestorag_update_save (ffestorag s);
/* Define macros. */
#define ffestorag_accretes(s) ((s)->accretes)
#define ffestorag_accretion(s) ((s)->accretion)
#define ffestorag_alignment(s) ((s)->alignment)
#define ffestorag_basictype(s) ((s)->basic_type)
#define ffestorag_hook(s) ((s)->hook)
#define ffestorag_init(s) ((s)->init)
#define ffestorag_init_0()
#define ffestorag_init_1()
#define ffestorag_init_3()
#define ffestorag_init_4()
#define ffestorag_is_init(s) ((s)->is_init)
#define ffestorag_is_save(s) ((s)->is_save)
#define ffestorag_kindtype(s) ((s)->kind_type)
#define ffestorag_list_equivs(s) (&(s)->equivs_)
#define ffestorag_list_master() (&ffestorag_list_)
#define ffestorag_modulo(s) ((s)->modulo)
#define ffestorag_offset(s) ((s)->offset)
#define ffestorag_parent(s) ((s)->parent)
#define ffestorag_ptr_to_alignment(s) (&(s)->alignment)
#define ffestorag_ptr_to_modulo(s) (&(s)->modulo)
#define ffestorag_set_accretes(s,a) ((s)->accretes = (a))
#define ffestorag_set_accretion(s,a) ((s)->accretion = (a))
#define ffestorag_set_alignment(s,a) ((s)->alignment = (a))
#define ffestorag_set_basictype(s,b) ((s)->basic_type = (b))
#define ffestorag_set_hook(s,h) ((s)->hook = (h))
#define ffestorag_set_init(s,i) ((s)->init = (i))
#define ffestorag_set_is_init(s,in) ((s)->is_init = (in))
#define ffestorag_set_is_save(s,sa) ((s)->is_save = (sa))
#define ffestorag_set_kindtype(s,k) ((s)->kind_type = (k))
#define ffestorag_set_modulo(s,m) ((s)->modulo = (m))
#define ffestorag_set_offset(s,o) ((s)->offset = (o))
#define ffestorag_set_parent(s,p) ((s)->parent = (p))
#define ffestorag_set_size(s,si) ((s)->size = (si))
#define ffestorag_set_symbol(s,sy) ((s)->symbol = (sy))
#define ffestorag_set_type(s,t) ((s)->type = (t))
#define ffestorag_set_typesymbol(s,sy) ((s)->type_symbol = (sy))
#define ffestorag_size(s) ((s)->size)
#define ffestorag_symbol(s) ((s)->symbol)
#define ffestorag_terminate_0()
#define ffestorag_terminate_1()
#define ffestorag_terminate_2()
#define ffestorag_terminate_3()
#define ffestorag_terminate_4()
#define ffestorag_type(s) ((s)->type)
#define ffestorag_typesymbol(s) ((s)->type_symbol)
/* End of #include file. */
#endif /* ! GCC_F_STORAG_H */

59
gcc/f/stp.c
View file

@ -1,59 +0,0 @@
/* stp.c -- Implementation File (module.c template V1.0)
Copyright (C) 1995 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Related Modules:
None
Description:
Keeps track of some information needed while parsing (and usually
before the exact statement is not confirmed).
Modifications:
*/
/* Include files. */
#include "proj.h"
#include "stp.h"
/* Externals defined here. */
union _ffestp_fileu_ ffestp_file;
/* Simple definitions and enumerations. */
/* Internal typedefs. */
/* Private include files. */
/* Internal structure definitions. */
/* Static objects accessed by functions in this module. */
/* Static functions (internal). */
/* Internal macros. */

508
gcc/f/stp.h
View file

@ -1,508 +0,0 @@
/* stp.h -- Private #include File (module.h template V1.0)
Copyright (C) 1995 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
Owning Modules:
stp.c
Modifications:
*/
/* Allow multiple inclusion to work. */
#ifndef GCC_F_STP_H
#define GCC_F_STP_H
/* Simple definitions and enumerations. */
enum _ffestp_acceptix_
{
FFESTP_acceptixFORMAT,
FFESTP_acceptix
};
typedef enum _ffestp_acceptix_ ffestpAcceptIx;
enum _ffestp_attrib_
{
#if FFESTR_F90
FFESTP_attribALLOCATABLE,
#endif
FFESTP_attribDIMENSION,
FFESTP_attribEXTERNAL,
#if FFESTR_F90
FFESTP_attribINTENT,
#endif
FFESTP_attribINTRINSIC,
#if FFESTR_F90
FFESTP_attribOPTIONAL,
#endif
FFESTP_attribPARAMETER,
#if FFESTR_F90
FFESTP_attribPOINTER,
#endif
#if FFESTR_F90
FFESTP_attribPRIVATE,
FFESTP_attribPUBLIC,
#endif
FFESTP_attribSAVE,
#if FFESTR_F90
FFESTP_attribTARGET,
#endif
FFESTP_attrib
};
typedef enum _ffestp_attrib_ ffestpAttrib;
enum _ffestp_beruix_
{
FFESTP_beruixERR,
FFESTP_beruixIOSTAT,
FFESTP_beruixUNIT,
FFESTP_beruix
};
typedef enum _ffestp_beruix_ ffestpBeruIx;
enum _ffestp_closeix_
{
FFESTP_closeixERR,
FFESTP_closeixIOSTAT,
FFESTP_closeixSTATUS,
FFESTP_closeixUNIT,
FFESTP_closeix
};
typedef enum _ffestp_closeix_ ffestpCloseIx;
enum _ffestp_deleteix_
{
FFESTP_deleteixERR,
FFESTP_deleteixIOSTAT,
FFESTP_deleteixREC,
FFESTP_deleteixUNIT,
FFESTP_deleteix
};
typedef enum _ffestp_deleteix_ ffestpDeleteIx;
enum _ffestp_findix_
{
FFESTP_findixERR,
FFESTP_findixIOSTAT,
FFESTP_findixREC,
FFESTP_findixUNIT,
FFESTP_findix
};
typedef enum _ffestp_findix_ ffestpFindIx;
enum _ffestp_inquireix_
{
FFESTP_inquireixACCESS,
FFESTP_inquireixACTION,
FFESTP_inquireixBLANK,
FFESTP_inquireixCARRIAGECONTROL,
FFESTP_inquireixDEFAULTFILE,
FFESTP_inquireixDELIM,
FFESTP_inquireixDIRECT,
FFESTP_inquireixERR,
FFESTP_inquireixEXIST,
FFESTP_inquireixFILE,
FFESTP_inquireixFORM,
FFESTP_inquireixFORMATTED,
FFESTP_inquireixIOLENGTH,
FFESTP_inquireixIOSTAT,
FFESTP_inquireixKEYED,
FFESTP_inquireixNAME,
FFESTP_inquireixNAMED,
FFESTP_inquireixNEXTREC,
FFESTP_inquireixNUMBER,
FFESTP_inquireixOPENED,
FFESTP_inquireixORGANIZATION,
FFESTP_inquireixPAD,
FFESTP_inquireixPOSITION,
FFESTP_inquireixREAD,
FFESTP_inquireixREADWRITE,
FFESTP_inquireixRECL,
FFESTP_inquireixRECORDTYPE,
FFESTP_inquireixSEQUENTIAL,
FFESTP_inquireixUNFORMATTED,
FFESTP_inquireixUNIT,
FFESTP_inquireixWRITE,
FFESTP_inquireix
};
typedef enum _ffestp_inquireix_ ffestpInquireIx;
enum _ffestp_openix_
{
FFESTP_openixACCESS,
FFESTP_openixACTION,
FFESTP_openixASSOCIATEVARIABLE,
FFESTP_openixBLANK,
FFESTP_openixBLOCKSIZE,
FFESTP_openixBUFFERCOUNT,
FFESTP_openixCARRIAGECONTROL,
FFESTP_openixDEFAULTFILE,
FFESTP_openixDELIM,
FFESTP_openixDISPOSE,
FFESTP_openixERR,
FFESTP_openixEXTENDSIZE,
FFESTP_openixFILE,
FFESTP_openixFORM,
FFESTP_openixINITIALSIZE,
FFESTP_openixIOSTAT,
FFESTP_openixKEY,
FFESTP_openixMAXREC,
FFESTP_openixNOSPANBLOCKS,
FFESTP_openixORGANIZATION,
FFESTP_openixPAD,
FFESTP_openixPOSITION,
FFESTP_openixREADONLY,
FFESTP_openixRECL,
FFESTP_openixRECORDTYPE,
FFESTP_openixSHARED,
FFESTP_openixSTATUS,
FFESTP_openixUNIT,
FFESTP_openixUSEROPEN,
FFESTP_openix
};
typedef enum _ffestp_openix_ ffestpOpenIx;
enum _ffestp_printix_
{
FFESTP_printixFORMAT,
FFESTP_printix
};
typedef enum _ffestp_printix_ ffestpPrintIx;
enum _ffestp_readix_
{
FFESTP_readixADVANCE,
FFESTP_readixEND,
FFESTP_readixEOR,
FFESTP_readixERR,
FFESTP_readixFORMAT, /* Or NAMELIST (use expr info to
distinguish). */
FFESTP_readixIOSTAT,
FFESTP_readixKEYEQ,
FFESTP_readixKEYGE,
FFESTP_readixKEYGT,
FFESTP_readixKEYID,
FFESTP_readixNULLS,
FFESTP_readixREC,
FFESTP_readixSIZE,
FFESTP_readixUNIT,
FFESTP_readix
};
typedef enum _ffestp_readix_ ffestpReadIx;
enum _ffestp_rewriteix_
{
FFESTP_rewriteixERR,
FFESTP_rewriteixFMT,
FFESTP_rewriteixIOSTAT,
FFESTP_rewriteixUNIT,
FFESTP_rewriteix
};
typedef enum _ffestp_rewriteix_ ffestpRewriteIx;
enum _ffestp_typeix_
{
FFESTP_typeixFORMAT,
FFESTP_typeix
};
typedef enum _ffestp_typeix_ ffestpTypeIx;
enum _ffestp_vxtcodeix_
{
FFESTP_vxtcodeixB,
FFESTP_vxtcodeixC,
FFESTP_vxtcodeixERR,
FFESTP_vxtcodeixF,
FFESTP_vxtcodeixIOSTAT,
FFESTP_vxtcodeix
};
typedef enum _ffestp_vxtcodeix_ ffestpVxtcodeIx;
enum _ffestp_writeix_
{
FFESTP_writeixADVANCE,
FFESTP_writeixEOR,
FFESTP_writeixERR,
FFESTP_writeixFORMAT, /* Or NAMELIST (use expr info to
distinguish). */
FFESTP_writeixIOSTAT,
FFESTP_writeixREC,
FFESTP_writeixUNIT,
FFESTP_writeix
};
typedef enum _ffestp_writeix_ ffestpWriteIx;
#if FFESTR_F90
enum _ffestp_definedoperator_
{
FFESTP_definedoperatorNone, /* INTERFACE generic-name. */
FFESTP_definedoperatorOPERATOR, /* INTERFACE
OPERATOR(defined-operator). */
FFESTP_definedoperatorASSIGNMENT, /* INTERFACE ASSIGNMENT(=). */
FFESTP_definedoperatorPOWER,
FFESTP_definedoperatorMULT,
FFESTP_definedoperatorADD,
FFESTP_definedoperatorCONCAT,
FFESTP_definedoperatorDIVIDE,
FFESTP_definedoperatorSUBTRACT,
FFESTP_definedoperatorNOT,
FFESTP_definedoperatorAND,
FFESTP_definedoperatorOR,
FFESTP_definedoperatorEQV,
FFESTP_definedoperatorNEQV,
FFESTP_definedoperatorEQ,
FFESTP_definedoperatorNE,
FFESTP_definedoperatorLT,
FFESTP_definedoperatorLE,
FFESTP_definedoperatorGT,
FFESTP_definedoperatorGE,
FFESTP_definedoperator
};
typedef enum _ffestp_definedoperator_ ffestpDefinedOperator;
#endif
enum _ffestp_dimtype_
{
FFESTP_dimtypeNONE,
FFESTP_dimtypeKNOWN, /* Known-bounds dimension list. */
FFESTP_dimtypeADJUSTABLE, /* Adjustable dimension list. */
FFESTP_dimtypeASSUMED, /* Assumed dimension list (known except for
last). */
FFESTP_dimtypeADJUSTABLEASSUMED, /* Both. */
FFESTP_dimtype
};
typedef enum _ffestp_dimtype_ ffestpDimtype;
enum _ffestp_formattype_
{
FFESTP_formattypeNone,
FFESTP_formattypeI,
FFESTP_formattypeB,
FFESTP_formattypeO,
FFESTP_formattypeZ,
FFESTP_formattypeF,
FFESTP_formattypeE,
FFESTP_formattypeEN,
FFESTP_formattypeG,
FFESTP_formattypeL,
FFESTP_formattypeA,
FFESTP_formattypeD,
FFESTP_formattypeQ,
FFESTP_formattypeDOLLAR, /* $ (V-extension). */
FFESTP_formattypeP,
FFESTP_formattypeT,
FFESTP_formattypeTL,
FFESTP_formattypeTR,
FFESTP_formattypeX,
FFESTP_formattypeS,
FFESTP_formattypeSP,
FFESTP_formattypeSS,
FFESTP_formattypeBN,
FFESTP_formattypeBZ,
FFESTP_formattypeH, /* Hollerith, used only for error-reporting. */
FFESTP_formattypeSLASH,
FFESTP_formattypeCOLON,
FFESTP_formattypeR1016, /* char-literal-constant or cHchars. */
FFESTP_formattypeFORMAT, /* [r](format-item-list). */
FFESTP_formattype
};
typedef enum _ffestp_formattype_ ffestpFormatType;
enum _ffestp_type_
{
FFESTP_typeNone,
FFESTP_typeINTEGER,
FFESTP_typeREAL,
FFESTP_typeCOMPLEX,
FFESTP_typeLOGICAL,
FFESTP_typeCHARACTER,
FFESTP_typeDBLPRCSN,
FFESTP_typeDBLCMPLX,
FFESTP_typeBYTE,
FFESTP_typeWORD,
#if FFESTR_F90
FFESTP_typeTYPE,
#endif
FFESTP_type
};
typedef enum _ffestp_type_ ffestpType;
/* Typedefs. */
typedef struct _ffest_accept_stmt_ ffestpAcceptStmt;
typedef struct _ffest_beru_stmt_ ffestpBeruStmt;
typedef struct _ffest_close_stmt_ ffestpCloseStmt;
typedef struct _ffest_delete_stmt_ ffestpDeleteStmt;
typedef struct _ffestp_file ffestpFile;
typedef struct _ffest_find_stmt_ ffestpFindStmt;
typedef struct _ffest_inquire_stmt_ ffestpInquireStmt;
typedef struct _ffest_open_stmt_ ffestpOpenStmt;
typedef struct _ffest_print_stmt_ ffestpPrintStmt;
typedef struct _ffest_read_stmt_ ffestpReadStmt;
typedef struct _ffest_rewrite_stmt_ ffestpRewriteStmt;
typedef struct _ffest_type_stmt_ ffestpTypeStmt;
typedef struct _ffest_vxtcode_stmt_ ffestpVxtcodeStmt;
typedef struct _ffest_write_stmt_ ffestpWriteStmt;
/* Include files needed by this one. */
#include "bld.h"
#include "lab.h"
#include "lex.h"
#include "stp.h"
#include "stt.h"
/* Structure definitions. */
struct _ffestp_file
{
bool kw_or_val_present; /* If FALSE, all else is n/a. */
bool kw_present; /* Indicates whether kw has a token. */
bool value_present; /* Indicates whether value/expr are valid. */
bool value_is_label; /* TRUE if expr has no expression, value is
NUMBER. */
ffelexToken kw; /* The keyword, iff kw_or_val_present &&
kw_present. */
ffelexToken value; /* The value, iff kw_or_val_present &&
value_present. */
union
{
ffebld expr; /* The expr, iff kw_or_val_present &&
value_present && !value_is_label. */
ffelab label; /* The label, iff kw_or_val_present &&
value_present && value_is_label. */
}
u;
};
struct _ffest_accept_stmt_
{
ffestpFile accept_spec[FFESTP_acceptix];
};
struct _ffest_beru_stmt_
{
ffestpFile beru_spec[FFESTP_beruix];
};
struct _ffest_close_stmt_
{
ffestpFile close_spec[FFESTP_closeix];
};
struct _ffest_delete_stmt_
{
ffestpFile delete_spec[FFESTP_deleteix];
};
struct _ffest_find_stmt_
{
ffestpFile find_spec[FFESTP_findix];
};
struct _ffest_imp_list_
{
ffesttImpList next;
ffesttImpList previous;
ffelexToken first;
ffelexToken last; /* NULL if a single letter. */
};
struct _ffest_inquire_stmt_
{
ffestpFile inquire_spec[FFESTP_inquireix];
};
struct _ffest_open_stmt_
{
ffestpFile open_spec[FFESTP_openix];
};
struct _ffest_print_stmt_
{
ffestpFile print_spec[FFESTP_printix];
};
struct _ffest_read_stmt_
{
ffestpFile read_spec[FFESTP_readix];
};
struct _ffest_rewrite_stmt_
{
ffestpFile rewrite_spec[FFESTP_rewriteix];
};
struct _ffest_type_stmt_
{
ffestpFile type_spec[FFESTP_typeix];
};
struct _ffest_vxtcode_stmt_
{
ffestpFile vxtcode_spec[FFESTP_vxtcodeix];
};
struct _ffest_write_stmt_
{
ffestpFile write_spec[FFESTP_writeix];
};
union _ffestp_fileu_
{
ffestpAcceptStmt accept;
ffestpBeruStmt beru;
ffestpCloseStmt close;
ffestpDeleteStmt delete;
ffestpFindStmt find;
ffestpInquireStmt inquire;
ffestpOpenStmt open;
ffestpPrintStmt print;
ffestpReadStmt read;
ffestpRewriteStmt rewrite;
ffestpTypeStmt type;
ffestpVxtcodeStmt vxtcode;
ffestpWriteStmt write;
};
/* Global objects accessed by users of this module. */
extern union _ffestp_fileu_ ffestp_file;
/* Declare functions with prototypes. */
/* Define macros. */
#define ffestp_init_0()
#define ffestp_init_1()
#define ffestp_init_2()
#define ffestp_init_3()
#define ffestp_init_4()
#define ffestp_terminate_0()
#define ffestp_terminate_1()
#define ffestp_terminate_2()
#define ffestp_terminate_3()
#define ffestp_terminate_4()
/* End of #include file. */
#endif /* ! GCC_F_STP_H */

135
gcc/f/str-1t.fin
View file

@ -1,135 +0,0 @@
{
Copyright (C) 1995 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
}
FFESTR_first // // ffestrFirst ffestr_first 1 1
;Accept ACCEPT
;Allocatable ALLOCATABLE
;Allocate ALLOCATE
Assign ASSIGN
Backspace BACKSPACE
Block BLOCK
BlockData BLOCKDATA
Byte BYTE
Call CALL
Case CASE
CaseDefault CASEDEFAULT
Character CHRCTR
Close CLOSE
Common COMMON
Complex CMPLX
;Contains CONTAINS
Continue CONTINUE
Cycle CYCLE
Data DATA
;Deallocate DEALLOCATE
Decode DECODE
Define DEFINE
;DefineFile DEFINEFILE
Delete DELETE
Dimension DIMENSION
Do DO
Double DBL
DoubleComplex DBLCMPLX
DoublePrecision DBLPRCSN
DoWhile DOWHILE
Else ELSE
ElseIf ELSEIF
;ElseWhere ELSEWHERE
Encode ENCODE
End END
EndBlock ENDBLOCK
EndBlockData ENDBLOCKDATA
EndDo ENDDO
EndFile ENDFILE
EndFunction ENDFUNCTION
EndIf ENDIF
;EndInterface ENDINTERFACE
;EndMap ENDMAP
;EndModule ENDMODULE
EndProgram ENDPROGRAM
EndSelect ENDSELECT
;EndStructure ENDSTRUCTURE
EndSubroutine ENDSUBROUTINE
;EndType ENDTYPE
;EndUnion ENDUNION
;EndWhere ENDWHERE
Entry ENTRY
Equivalence EQUIVALENCE
Exit EXIT
External EXTERNAL
Find FIND
Format FORMAT
Function FUNCTION
Go GO
GoTo GOTO
If IF
Implicit IMPLICIT
Include INCLUDE
Inquire INQUIRE
Integer INTGR
;Intent INTENT
;Interface INTERFACE
;InterfaceAssignment INTERFACEASSGNMNT
;InterfaceOperator INTERFACEOPERATOR
Intrinsic INTRINSIC
Logical LGCL
;Map MAP
;Module MODULE
;ModuleProcedure MODULEPROCEDURE
NameList NAMELIST
;Nullify NULLIFY
Open OPEN
;Optional OPTIONAL
Parameter PARAMETER
Pause PAUSE
;Pointer POINTER
Print PRINT
;Private PRIVATE
Program PROGRAM
;Public PUBLIC
Read READ
Real REAL
;Record RECORD
;Recursive RECURSIVE
;RecursiveFunction RECURSIVEFNCTN
Return RETURN
Rewind REWIND
;Rewrite REWRITE
Save SAVE
Select SELECT
SelectCase SELECTCASE
;Sequence SEQUENCE
Stop STOP
;Structure STRUCTURE
Subroutine SUBROUTINE
;Target TARGET
Then THEN
Type TYPE
;Union UNION
;Unlock UNLOCK
;Use USE
Virtual VIRTUAL
Volatile VOLATILE
;Where WHERE
Word WORD
Write WRITE

60
gcc/f/str-2t.fin
View file

@ -1,60 +0,0 @@
{
Copyright (C) 1995 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
}
FFESTR_second // // ffestrSecond ffestr_second 1 0
;Assignment ASSIGNMENT
Block BLOCK
BlockData BLOCKDATA
Byte BYTE
Case CASE
Character CHARACTER
Complex COMPLEX
Data DATA
Default DEFAULT
Do DO
Double DOUBLE
DoubleComplex DOUBLECOMPLEX
DoublePrecision DOUBLEPRECISION
File FILE
Function FUNCTION
If IF
Integer INTEGER
;Interface INTERFACE
Logical LOGICAL
;Map MAP
;Module MODULE
None NONE
;Operator OPERATOR
Precision PRECISION
;Procedure PROCEDURE
Program PROGRAM
Real REAL
Select SELECT
;Structure STRUCTURE
Subroutine SUBROUTINE
To TO
;Type TYPE
;Union UNION
;Where WHERE
While WHILE
Word WORD

55
gcc/f/str-fo.fin
View file

@ -1,55 +0,0 @@
{
Copyright (C) 1995 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
}
FFESTR_format // // ffestrFormat ffestr_format 0 1
$ DOLLAR
A A
B B
BN BN
BZ BZ
D D
E E
En EN
F F
G G
H H
I I
L L
N N
O O
P P
PD PD
PE PE
PEn PEN
PF PF
PG PG
Q Q
R R
S S
SP SP
SS SS
T T
TL TL
TR TR
X X
Z Z

43
gcc/f/str-io.fin
View file

@ -1,43 +0,0 @@
{
Copyright (C) 1995 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT 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
along with GNU Fortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
}
FFESTR_genio // // ffestrGenio ffestr_genio 1 0
Advance ADVANCE
Disp DISP
Dispose DISPOSE
End END
EoR EOR
Err ERR
Fmt FMT
IOStat IOSTAT
Key KEY
KeyEQ KEYEQ
KeyGE KEYGE
KeyGT KEYGT
KeyID KEYID
Nml NML
Nulls NULLS
Rec REC
Size SIZE
Status STATUS
Unit UNIT

Some files were not shown because too many files have changed in this diff Show more