Commit b4117c30 by Zack Weinberg

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

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
parent 54b4ba60
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.
......
......@@ -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;
......
......@@ -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
......
......@@ -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
......
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.
......
#!/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
#!/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
#!/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.
......@@ -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
......
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
......
......@@ -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);
......
......@@ -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]
......
......@@ -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"
......
......@@ -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
......
......@@ -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}.
......
This source diff could not be displayed because it is too large. You can view the blob instead.
This source diff could not be displayed because it is too large. You can view the blob instead.
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.
1999-03-13 RELEASE-PREP
Things to do to prepare a g77 release.
- Update root.texi: clear DEVELOPMENT flag, set version info.
/* 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;
}
/* 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 */
/* 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;
}
}
/* 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 */
/* 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)
\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
This source diff could not be displayed because it is too large. You can view the blob instead.
# 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
/* 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 */
/* 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 */
This source diff could not be displayed because it is too large. You can view the blob instead.
/* 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 */
This source diff could not be displayed because it is too large. You can view the blob instead.
/* 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 */
/* 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)
{
}
/* 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 */
/* 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", "~")
/* 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", "~")
/* 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", "~")
/* 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
/* 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 */
This source diff could not be displayed because it is too large. You can view the blob instead.
/* 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 */
/* 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;
}
/* 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 */
/* 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},
; 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.
This source diff could not be displayed because it is too large. You can view the blob instead.
/* 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 */
/* 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 */
/* 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;
}
/* 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 */
This source diff could not be displayed because it is too large. You can view the blob instead.
This source diff could not be displayed because it is too large. You can view the blob instead.
This source diff could not be displayed because it is too large. You can view the blob instead.
This source diff could not be displayed because it is too large. You can view the blob instead.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment