Imported from mainline FSF repositories

From-SVN: r94600

gcc/config/dsp16xx/dsp16xx-modes.def

+/* DSP16xx extra modes.
+   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.  */
+
+/* HFmode is the DSP16xx's equivalent of SFmode.
+   FIXME: What format is this anyway? */ 
+FLOAT_MODE (HF, 2, 0);

gcc/config/dsp16xx/dsp16xx-protos.h

+/* Definitions of target machine for GNU compiler.  AT&T DSP1600.
+   Copyright (C) 2000 Free Software Foundation, Inc.
+   Contributed by Michael Collison (collison@world.std.com).
+
+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.  */
+
+#ifdef RTX_CODE
+extern struct rtx_def *gen_compare_reg (enum rtx_code, rtx, rtx);
+extern int call_address_operand (rtx, enum machine_mode);
+extern int arith_reg_operand (rtx, enum machine_mode);
+extern int symbolic_address_operand (rtx, enum machine_mode);
+extern int Y_address_operand (rtx, enum machine_mode);
+extern int sp_operand (rtx, enum machine_mode);
+extern int sp_operand2 (rtx, enum machine_mode);
+extern int nonmemory_arith_operand (rtx, enum machine_mode);
+extern int dsp16xx_comparison_operator (rtx, enum machine_mode);
+extern int unx_comparison_operator (rtx, enum machine_mode);
+extern int signed_comparison_operator (rtx, enum machine_mode);
+
+extern void notice_update_cc (rtx);
+extern void double_reg_from_memory (rtx[]);
+extern void double_reg_to_memory (rtx[]);
+extern enum rtx_code next_cc_user_code (rtx);
+extern int next_cc_user_unsigned (rtx);
+extern struct rtx_def *gen_tst_reg (rtx);
+extern const char *output_block_move (rtx[]);
+extern enum reg_class preferred_reload_class (rtx, enum reg_class);
+extern enum reg_class secondary_reload_class (enum reg_class,
+					      enum machine_mode, rtx);
+extern int emit_move_sequence (rtx *, enum machine_mode);
+extern void print_operand (FILE *, rtx, int);
+extern void print_operand_address (FILE *, rtx);
+extern void output_dsp16xx_float_const (rtx *);
+extern void emit_1600_core_shift (enum rtx_code, rtx *, int);
+extern int symbolic_address_p (rtx);
+extern int uns_comparison_operator (rtx, enum machine_mode);
+#endif /* RTX_CODE */
+
+
+#ifdef TREE_CODE
+extern struct rtx_def *dsp16xx_function_arg (CUMULATIVE_ARGS,
+					     enum machine_mode,
+					     tree, int);
+extern void dsp16xx_function_arg_advance (CUMULATIVE_ARGS *,
+					  enum machine_mode,
+					  tree, int);
+#endif /* TREE_CODE */
+
+extern void dsp16xx_invalid_register_for_compare (void);
+extern int class_max_nregs (enum reg_class, enum machine_mode);
+extern enum reg_class limit_reload_class (enum reg_class, enum machine_mode);
+extern int dsp16xx_register_move_cost (enum reg_class, enum reg_class);
+extern int dsp16xx_makes_calls (void);
+extern long compute_frame_size (int);
+extern int dsp16xx_call_saved_register (int);
+extern int dsp16xx_call_saved_register (int);
+extern void init_emulation_routines (void);
+extern int ybase_regs_ever_used (void);
+extern void override_options (void);
+extern int dsp16xx_starting_frame_offset (void);
+extern int initial_frame_pointer_offset (void);
+extern void asm_output_common (FILE *, const char *, int, int);
+extern void asm_output_local (FILE *, const char *, int, int);
+extern void asm_output_float (FILE *, double);
+extern bool dsp16xx_compare_gen;
+extern int hard_regno_mode_ok (int, enum machine_mode);
+extern enum reg_class dsp16xx_reg_class_from_letter (int);
+extern int regno_reg_class (int);
+extern void function_prologue (FILE *, int);
+extern void function_epilogue (FILE *, int);
+extern int num_1600_core_shifts (int);

gcc/config/i370/README

+
+This directory contains code for building a compiler for the
+32-bit ESA/390 architecture.  It supports three different styles 
+of assembly:
+
+-- MVS for use with the HLASM assembler
+-- Open Edition (USS Unix System Services) 
+-- ELF/Linux for use with the binutils/gas GNU assembler.
+
+
+Cross-compiling Hints
+---------------------
+When building a cross-compiler on AIX, set the environment variable CC
+and be sure to set the -ma and -qcpluscmt flags; i.e.
+
+   export CC="cc -ma -qcpluscmt"
+
+do this *before* running configure, e.g.
+
+   configure --target=i370-ibm-linux --prefix=/where/to/install/usr
+
+The Objective-C and FORTRAN front ends don't build.  To avoid looking at
+errors, do only 
+
+   make LANGUAGES=c
+
+
+OpenEdition Hints
+-----------------
+The shell script "install" is handy for users of OpenEdition.
+
+
+The ELF ABI
+-----------
+This compiler, in conjunction with the gas/binutils assembler, defines
+a defacto ELF-based ABI for the ESA/390 architecture.  Be warned: this 
+ABI has several major faults.  It should be fixed.  As it is fixed,
+it is subject to change without warning.  You should not commit to major
+software systems without further exploring and fixing these problems.
+Here are some of the problems:
+
+-- No support for shared libraries or dynamically loadable objects.
+   This is because the compiler currently places address literals in 
+   the text section.  Although the GAS assembler supports a syntax for 
+   USING that will place address literals in the data section, this forces
+   the use of two base registers, one for branches and one for the literal 
+   pool. Work is needed to redesign the function prologue, epilogue and the 
+   base register reloads to minimize the currently excessive use of reserved 
+   registers. 
+
+   I beleive the best solution would be to add a toc or plt, and extending
+   the meaning of the USING directive to encompass this.  This would 
+   allow the continued use of the human-readable and familiar practice
+   of using =A() and =F'' to denote address literals, as opposed to more 
+   difficult jump-table notation.
+
+-- the stackframe is almost twice as big as it needs to be.
+
+-- currently, r15 is used to return 32-bit values.  Because this is the
+   last register, it prevents 64-bit ints and small structures from being 
+   returned in registers, forcing return in memory.  It would be more
+   efficient to use r14 to return 32-bit values, and r14+r15 to return
+   64-bit values.
+
+-- all arguments are currently passed in memory.  It would be more efficient 
+   to pass arguments in registers.
+
+
+
+
+ChangeLog
+---------
+Oct98-Dec98 -- add ELF back end; work on getting ABI more or less functional.
+98.12.05 -- fix numerous MVC bugs
+99.02.06 -- multiply insn sometimes not generated when needed.
+         -- extendsidi bugs, bad literal values printed
+         -- remove broken adddi subdi patterns
+99.02.15 -- add clrstrsi pattern
+         -- fix -O2 divide bug
+99.03.04 -- base & index reg usage bugs
+99.03.15 -- fixes for returning long longs and structs (struct value return)
+99.03.29 -- fix handling & alignment of shorts
+99.03.31 -- clobbered register 14 is not always clobbered
+99.04.02 -- operand constraints for cmphi
+99.04.07 -- function pointer fixes for call, call_value patterns,
+            function pointers derefed once too often.
+99.04.14 -- add pattern to print double-wide int
+         -- check intval<4096 for misc operands
+         -- add clrstrsi pattern
+         -- movstrsi fixes
+99.04.16 -- use r2 to pass args into r11 in subroutine call.
+         -- fixes to movsi; some operand combinations impossible;
+            rework constraints
+         -- start work on forward jump optimization
+         -- char alignment bug
+99.04.25 -- add untyped_call pattern so that builtin_apply works
+99.04.27 -- fixes to compare logical under mask
+99.04.28 -- reg 2 is clobbered by calls
+99.04.30 -- fix rare mulsi bug
+99.04.30 -- add constraints so that all RS, SI, SS forms insns have valid
+            addressing modes
+99.04.30 -- major condition code fixes. The old code was just way off 
+            w.r.t. which insns set condition code, and the codes that
+            were set.  The extent of this damage was unbeleivable.
+99.05.01 -- restructuring of operand constraints on many patterns,
+            many lead to invalid instructions being genned.
+99.05.02 -- float pt fixes
+         -- fix movdi issue bugs
+99.05.03 -- fix divide insn; was dividing incorrectly
+99.05.05 -- fix sign extension problems on andhi
+         -- deprecate some constraints
+99.05.06 -- add set_attr insn lengths; fix misc litpool sizes
+         -- add notes about how unsigned jumps work (i.e. 
+            arithmetic vs. logical vs. signed vs unsigned).
+99.05.11 -- use insn length to predict forward branch target;
+            use relative branchining where possible,
+            remove un-needed base register reload.
+99.05.15 -- fix movstrsi, clrstrsi, cmpstrsi patterns as per conversation 
+            w/ Richard Henderson
+
+
+
+
+
+

gcc/config/i370/i370-c.c

+/* Subroutines for the C front end for System/370.
+   Copyright (C) 1989, 1993, 1995, 1997, 1998, 1999, 2000
+   Free Software Foundation, Inc.
+   Contributed by Jan Stein (jan@cd.chalmers.se).
+   Modified for OS/390 LanguageEnvironment C by Dave Pitts (dpitts@cozx.com)
+   Hacked for Linux-ELF/390 by Linas Vepstas (linas@linas.org) 
+
+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.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tm.h"
+#include "tree.h"
+#include "toplev.h"
+#include "cpplib.h"
+#include "c-pragma.h"
+#include "tm_p.h"
+
+#ifdef TARGET_HLASM
+
+/* #pragma map (name, alias) -
+   In this implementation both name and alias are required to be
+   identifiers.  The older code seemed to be more permissive.  Can
+   anyone clarify?  */
+
+void
+i370_pr_map (pfile)
+     cpp_reader *pfile ATTRIBUTE_UNUSED;
+{
+  tree name, alias, x;
+
+  if (c_lex (&x)        == CPP_OPEN_PAREN
+      && c_lex (&name)  == CPP_NAME
+      && c_lex (&x)     == CPP_COMMA
+      && c_lex (&alias) == CPP_NAME
+      && c_lex (&x)     == CPP_CLOSE_PAREN)
+    {
+      if (c_lex (&x) != CPP_EOF)
+	warning ("junk at end of #pragma map");
+
+      mvs_add_alias (IDENTIFIER_POINTER (name), IDENTIFIER_POINTER (alias), 1);
+      return;
+    }
+
+  warning ("malformed #pragma map, ignored");
+}
+
+#endif

gcc/config/i370/i370-protos.h

+/* Definitions of target machine for GNU compiler.  System/370 version.
+   Copyright (C) 2000 Free Software Foundation, Inc.
+   Contributed by Jan Stein (jan@cd.chalmers.se).
+   Modified for OS/390 LanguageEnvironment C by Dave Pitts (dpitts@cozx.com)
+   Hacked for Linux-ELF/390 by Linas Vepstas (linas@linas.org)
+
+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.  */
+
+#ifndef GCC_I370_PROTOS_H
+#define GCC_I370_PROTOS_H
+
+extern void override_options (void);
+
+#ifdef RTX_CODE
+extern int i370_branch_dest (rtx);
+extern int i370_branch_length (rtx);
+extern int i370_short_branch (rtx);
+extern int s_operand (rtx, enum machine_mode);
+extern int r_or_s_operand (rtx, enum machine_mode);
+extern int unsigned_jump_follows_p (rtx);
+#endif /* RTX_CODE */
+
+#ifdef TREE_CODE
+extern int handle_pragma (int (*)(void), void (*)(int), const char *);
+#endif /* TREE_CODE */
+
+extern void mvs_add_label (int);
+extern int mvs_check_label (int);
+extern int mvs_check_page (FILE *, int, int);
+extern int mvs_function_check (const char *);
+extern void mvs_add_alias (const char *, const char *, int);
+extern int mvs_need_alias (const char *);
+extern int mvs_get_alias (const char *, char *);
+extern int mvs_check_alias (const char *, char *);
+extern void check_label_emit (void);
+extern void mvs_free_label_list (void);
+
+extern void i370_pr_map (struct cpp_reader *);
+
+#endif /* ! GCC_I370_PROTOS_H */

gcc/config/i370/linux.h

+/* Definitions of target machine for GNU compiler.  System/370 version.
+   Copyright (C) 1989, 1993, 1995, 1996, 1997, 2003
+   Free Software Foundation, Inc.
+   Contributed by Jan Stein (jan@cd.chalmers.se).
+   Modified for Linux/390 by Linas Vepstas (linas@linas.org)
+
+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.  */
+
+
+#define TARGET_VERSION fprintf (stderr, " (i370 GNU/Linux with ELF)");
+
+/* Specify that we're generating code for a Linux port to 370 */
+
+#define TARGET_ELF_ABI
+
+/* Target OS preprocessor built-ins.  */
+#define TARGET_OS_CPP_BUILTINS() LINUX_TARGET_OS_CPP_BUILTINS()
+
+/* Options for this target machine.  */
+
+#define LIBGCC_SPEC "libgcc.a%s"
+
+#ifdef SOME_FUTURE_DAY
+ 
+#define CPP_SPEC "%{posix: -D_POSIX_SOURCE} %(cpp_sysv) %(cpp_endian_big) \
+%{mcall-linux: %(cpp_os_linux) } \
+%{!mcall-linux: %(cpp_os_default) }"
+
+#define LIB_SPEC "\
+%{mcall-linux: %(lib_linux) } \
+%{!mcall-linux:%(lib_default) }"
+
+#define STARTFILE_SPEC "\
+%{mcall-linux: %(startfile_linux) } \
+%{!mcall-linux: %(startfile_default) }"
+
+#define ENDFILE_SPEC "\
+%{mcall-linux: %(endfile_linux) } \
+%{!mcall-linux: %(endfile_default) }"
+
+/* GNU/Linux support.  */
+#ifndef LIB_LINUX_SPEC
+#define LIB_LINUX_SPEC "%{mnewlib: --start-group -llinux -lc --end-group } %{!mnewlib: -lc }"
+#endif
+
+#ifndef STARTFILE_LINUX_SPEC
+#define STARTFILE_LINUX_SPEC "\
+%{!shared: %{pg:gcrt1.o%s} %{!pg:%{p:gcrt1.o%s} %{!p:crt1.o%s}}} \
+%{mnewlib: ecrti.o%s} \
+%{!mnewlib: crti.o%s %{!shared:crtbegin.o%s} %{shared:crtbeginS.o%s}}"
+#endif
+
+#ifndef ENDFILE_LINUX_SPEC
+#define ENDFILE_LINUX_SPEC "\
+%{mnewlib: ecrtn.o%s} \
+%{!mnewlib: %{!shared:crtend.o%s} %{shared:crtendS.o%s} crtn.o%s}"
+#endif
+
+#ifndef LINK_START_LINUX_SPEC
+#define LINK_START_LINUX_SPEC "-Ttext 0x10000"
+#endif
+
+#ifndef LINK_OS_LINUX_SPEC
+#define LINK_OS_LINUX_SPEC ""
+#endif
+
+#ifndef CPP_OS_LINUX_SPEC
+#define CPP_OS_LINUX_SPEC "-D__unix__ -D__gnu_linux__ -D__linux__ \
+%{!ansi: -Dunix -Dlinux } \
+-Asystem=unix -Asystem=linux"
+#endif
+
+#ifndef CPP_OS_LINUX_SPEC
+#define CPP_OS_LINUX_SPEC ""
+#endif
+
+
+/* Define any extra SPECS that the compiler needs to generate.  */
+#undef  SUBTARGET_EXTRA_SPECS
+#define SUBTARGET_EXTRA_SPECS                                           \
+  { "lib_linux",                LIB_LINUX_SPEC },                       \
+  { "lib_default",              LIB_DEFAULT_SPEC },                     \
+  { "startfile_linux",          STARTFILE_LINUX_SPEC },                 \
+  { "startfile_default",        STARTFILE_DEFAULT_SPEC },               \
+  { "endfile_linux",            ENDFILE_LINUX_SPEC },                   \
+  { "endfile_default",          ENDFILE_DEFAULT_SPEC },                 \
+  { "link_shlib",               LINK_SHLIB_SPEC },                      \
+  { "link_target",              LINK_TARGET_SPEC },                     \
+  { "link_start",               LINK_START_SPEC },                      \
+  { "link_start_linux",         LINK_START_LINUX_SPEC },                \
+  { "link_os",                  LINK_OS_SPEC },                         \
+  { "link_os_linux",            LINK_OS_LINUX_SPEC },                   \
+  { "link_os_default",          LINK_OS_DEFAULT_SPEC },                 \
+  { "cpp_endian_big",           CPP_ENDIAN_BIG_SPEC },                  \
+  { "cpp_os_linux",             CPP_OS_LINUX_SPEC },                    \
+  { "cpp_os_default",           CPP_OS_DEFAULT_SPEC },
+
+#endif /* SOME_FUTURE_DAY */

gcc/config/i370/mvs.h

+/* Definitions of target machine for GNU compiler.  System/370 version.
+   Copyright (C) 1989, 1993, 1995, 1996, 1997, 2003
+   Free Software Foundation, Inc.
+   Contributed by Jan Stein (jan@cd.chalmers.se).
+   Modified for OS/390 LanguageEnvironment C by Dave Pitts (dpitts@cozx.com)
+
+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.  */
+
+#define TARGET_VERSION printf (" (370/MVS)");
+
+/* Specify that we're generating code for the Language Environment */
+
+#define LE370 1
+#define TARGET_EBCDIC 1
+#define TARGET_HLASM 1
+
+/* Options for the preprocessor for this target machine.  */
+
+#define CPP_SPEC "-trigraphs"
+
+/* Target OS preprocessor built-ins.  */
+#define TARGET_OS_CPP_BUILTINS()		\
+    do {					\
+	builtin_define_std ("MVS");		\
+	builtin_define_std ("mvs");		\
+	MAYBE_LE370_MACROS();			\
+	builtin_assert ("system=mvs");		\
+    } while (0)
+
+#if defined(LE370)
+# define MAYBE_LE370_MACROS() do {builtin_define_std ("LE370");} while (0)
+#else
+# define MAYBE_LE370_MACROS()
+#endif

gcc/config/i370/oe.h

+/* Definitions of target machine for GNU compiler.  System/370 version.
+   Copyright (C) 1989, 1993, 1995, 1996, 1997, 2003
+   Free Software Foundation, Inc.
+   Contributed by Jan Stein (jan@cd.chalmers.se).
+   Modified for OS/390 OpenEdition by Dave Pitts (dpitts@cozx.com)
+
+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.  */
+
+#define TARGET_VERSION printf (" (370/OpenEdition)");
+
+/* Specify that we're generating code for the Language Environment */
+
+#define LE370 1
+#define LONGEXTERNAL 1
+#define TARGET_EBCDIC 1
+#define TARGET_HLASM 1
+
+/* Options for the preprocessor for this target machine.  */
+
+#define CPP_SPEC "-trigraphs"
+
+/* Options for this target machine.  */
+
+#define LIB_SPEC ""
+#define LIBGCC_SPEC ""
+#define STARTFILE_SPEC "/usr/local/lib/gccmain.o"
+
+/* Target OS preprocessor built-ins.  */
+#define TARGET_OS_CPP_BUILTINS()		\
+    do {					\
+	builtin_define_std ("unix");		\
+	builtin_define_std ("UNIX");		\
+	builtin_define_std ("openedition");	\
+	builtin_define ("__i370__");		\
+	builtin_assert ("system=openedition");	\
+	builtin_assert ("system=unix");		\
+    } while (0)
+

gcc/config/i370/t-i370

+i370-c.o: $(srcdir)/config/i370/i370-c.c $(CONFIG_H) $(SYSTEM_H) coretypes.h \
+  $(TM_H) $(TREE_H) toplev.h $(CPPLIB_H) c-pragma.h $(TM_P_H)
+	$(CC) -c $(ALL_CFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) $(srcdir)/config/i370/i370-c.c

gcc/config/i960/i960-c.c

+/* Intel 80960 specific, C compiler specific functions.
+   Copyright (C) 1992, 1995, 1996, 1997, 1998, 1999, 2000
+   Free Software Foundation, Inc.
+   Contributed by Steven McGeady, Intel Corp.
+   Additional Work by Glenn Colon-Bonet, Jonathan Shapiro, Andy Wilson
+   Converted to GCC 2.0 by Jim Wilson and Michael Tiemann, Cygnus Support.
+
+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.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tm.h"
+#include "cpplib.h"
+#include "tree.h"
+#include "c-pragma.h"
+#include "toplev.h"
+#include "ggc.h"
+#include "tm_p.h"
+
+/* Handle pragmas for compatibility with Intel's compilers.  */
+
+/* NOTE: ic960 R3.0 pragma align definition:
+
+   #pragma align [(size)] | (identifier=size[,...])
+   #pragma noalign [(identifier)[,...]]
+     
+   (all parens are optional)
+     
+   - size is [1,2,4,8,16]
+   - noalign means size==1
+   - applies only to component elements of a struct (and union?)
+   - identifier applies to structure tag (only)
+   - missing identifier means next struct
+     
+   - alignment rules for bitfields need more investigation.
+
+   This implementation only handles the case of no identifiers.  */
+
+void
+i960_pr_align (pfile)
+     cpp_reader *pfile ATTRIBUTE_UNUSED;
+{
+  tree number;
+  enum cpp_ttype type;
+  int align;
+
+  type = c_lex (&number);
+  if (type == CPP_OPEN_PAREN)
+    type = c_lex (&number);
+  if (type == CPP_NAME)
+    {
+      warning ("sorry, not implemented: #pragma align NAME=SIZE");
+      return;
+    }
+  if (type != CPP_NUMBER)
+    {
+      warning ("malformed #pragma align - ignored");
+      return;
+    }
+
+  align = TREE_INT_CST_LOW (number);
+  switch (align)
+    {
+    case 0:
+      /* Return to last alignment.  */
+      align = i960_last_maxbitalignment / 8;
+      /* Fall through.  */
+    case 16:
+    case 8:
+    case 4:
+    case 2:
+    case 1:
+      i960_last_maxbitalignment = i960_maxbitalignment;
+      i960_maxbitalignment = align * 8;
+      break;
+      
+    default:
+      /* Silently ignore bad values.  */
+      break;
+    }
+}
+
+void
+i960_pr_noalign (pfile)
+     cpp_reader *pfile ATTRIBUTE_UNUSED;
+{
+  enum cpp_ttype type;
+  tree number;
+
+  type = c_lex (&number);
+  if (type == CPP_OPEN_PAREN)
+    type = c_lex (&number);
+  if (type == CPP_NAME)
+    {
+      warning ("sorry, not implemented: #pragma noalign NAME");
+      return;
+    }
+
+  i960_last_maxbitalignment = i960_maxbitalignment;
+  i960_maxbitalignment = 8;
+}

gcc/config/i960/i960-coff.h

+/* Definitions of target machine for GNU compiler, for "naked" Intel
+   80960 using coff object format and coff debugging symbols.
+   Copyright (C) 1988, 1989, 1991, 1996, 2000 Free Software Foundation.
+   Contributed by Steven McGeady (mcg@omepd.intel.com)
+   Additional work by Glenn Colon-Bonet, Jonathan Shapiro, Andy Wilson
+   Converted to GCC 2.0 by Michael Tiemann, Cygnus Support.
+
+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.  */
+
+/* Support -gstabs using stabs in COFF sections.  */
+
+/* Generate SDB_DEBUGGING_INFO by default.  */
+#undef PREFERRED_DEBUGGING_TYPE
+#define PREFERRED_DEBUGGING_TYPE SDB_DEBUG
+
+/* This is intended to be used with Cygnus's newlib library, so we want to
+   use the standard definition of LIB_SPEC.  */
+#undef LIB_SPEC
+
+/* Emit a .file directive.  */
+#define TARGET_ASM_FILE_START_FILE_DIRECTIVE true
+
+/* Support the ctors and dtors sections for g++.  */
+
+#define CTORS_SECTION_ASM_OP	"\t.section\t.ctors,\"x\""
+#define DTORS_SECTION_ASM_OP	"\t.section\t.dtors,\"x\""
+
+/* end of i960-coff.h */

gcc/config/i960/i960-modes.def

+/* Definitions of target machine for GNU compiler, for Intel 80960
+   Copyright (C) 2002 Free Software Foundation, Inc.
+   Contributed by Steven McGeady, Intel Corp.
+   Additional Work by Glenn Colon-Bonet, Jonathan Shapiro, Andy Wilson
+   Converted to GCC 2.0 by Jim Wilson and Michael Tiemann, Cygnus Support.
+
+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.  */
+
+/* long double */
+FLOAT_MODE (TF, 16, ieee_extended_intel_128_format);
+
+/* Add any extra modes needed to represent the condition code.
+
+   Also, signed and unsigned comparisons are distinguished, as
+   are operations which are compatible with chkbit insns.  */
+
+CC_MODE (CC_UNS);
+CC_MODE (CC_CHK);

gcc/config/i960/i960-protos.h

+/* Definitions of target machine for GNU compiler, for Intel 80960
+   Copyright (C) 2000
+   Free Software Foundation, Inc.
+   Contributed by Steven McGeady, Intel Corp.
+   Additional Work by Glenn Colon-Bonet, Jonathan Shapiro, Andy Wilson
+   Converted to GCC 2.0 by Jim Wilson and Michael Tiemann, Cygnus Support.
+
+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.  */
+
+#ifndef GCC_I960_PROTOS_H
+#define GCC_I960_PROTOS_H
+
+#ifdef RTX_CODE
+extern struct rtx_def *legitimize_address (rtx, rtx, enum machine_mode);
+/* Define the function that build the compare insn for scc and bcc.  */
+
+extern struct rtx_def *gen_compare_reg (enum rtx_code, rtx, rtx);
+
+/* Define functions in i960.c and used in insn-output.c.  */
+
+extern const char *i960_output_ldconst (rtx, rtx);
+extern const char *i960_output_call_insn (rtx, rtx, rtx, rtx);
+extern const char *i960_output_ret_insn (rtx);
+extern const char *i960_output_move_double (rtx, rtx);
+extern const char *i960_output_move_double_zero (rtx);
+extern const char *i960_output_move_quad (rtx, rtx);
+extern const char *i960_output_move_quad_zero (rtx);
+
+extern int literal (rtx, enum machine_mode);
+extern int hard_regno_mode_ok (int, enum machine_mode);
+extern int fp_literal (rtx, enum machine_mode);
+extern int signed_literal (rtx, enum machine_mode);
+extern int legitimate_address_p (enum machine_mode, rtx, int);
+extern void i960_print_operand (FILE *, rtx, int);
+extern int fpmove_src_operand (rtx, enum machine_mode);
+extern int arith_operand (rtx, enum machine_mode);
+extern int logic_operand (rtx, enum machine_mode);
+extern int fp_arith_operand (rtx, enum machine_mode);
+extern int signed_arith_operand (rtx, enum machine_mode);
+extern int fp_literal_one (rtx, enum machine_mode);
+extern int fp_literal_zero (rtx, enum machine_mode);
+extern int symbolic_memory_operand (rtx, enum machine_mode);
+extern int eq_or_neq (rtx, enum machine_mode);
+extern int arith32_operand (rtx, enum machine_mode);
+extern int power2_operand (rtx, enum machine_mode);
+extern int cmplpower2_operand (rtx, enum machine_mode);
+extern enum machine_mode select_cc_mode (RTX_CODE, rtx);
+extern int emit_move_sequence (rtx *, enum machine_mode);
+extern int i960_bypass (rtx, rtx, rtx, int);
+extern void i960_print_operand_addr (FILE *, rtx);
+extern int i960_expr_alignment (rtx, int);
+extern int i960_improve_align (rtx, rtx, int);
+extern int i960_si_ti (rtx, rtx);
+extern int i960_si_di (rtx, rtx);
+#ifdef TREE_CODE
+extern struct rtx_def *i960_function_arg (CUMULATIVE_ARGS *,
+					  enum machine_mode,
+					  tree, int);
+extern rtx i960_va_arg (tree, tree);
+extern void i960_va_start (tree, rtx);
+#endif /* TREE_CODE */
+extern enum reg_class secondary_reload_class (enum reg_class, enum machine_mode, rtx);
+#endif /* RTX_CODE */
+
+#ifdef TREE_CODE
+extern void i960_function_name_declare (FILE *, const char *, tree);
+extern void i960_function_arg_advance (CUMULATIVE_ARGS *, enum machine_mode, tree, int);
+extern int i960_round_align (int, tree);
+extern void i960_setup_incoming_varargs (CUMULATIVE_ARGS *, enum machine_mode, tree, int *, int);
+extern int i960_final_reg_parm_stack_space (int, tree);
+extern int i960_reg_parm_stack_space (tree);
+#endif /* TREE_CODE */
+
+extern int process_pragma (int(*)(void), void(*)(int), const char *);
+extern int i960_object_bytes_bitalign (int);
+extern void i960_initialize (void);
+extern int bitpos (unsigned int);
+extern int is_mask (unsigned int);
+extern int bitstr (unsigned int, int *, int *);
+extern int compute_frame_size (int);
+extern void output_function_profiler (FILE *, int);
+extern void i960_scan_opcode (const char *);
+
+extern void i960_pr_align (struct cpp_reader *);
+extern void i960_pr_noalign (struct cpp_reader *);
+
+#endif /* ! GCC_I960_PROTOS_H  */

gcc/config/i960/rtems.h

+/* Definitions for rtems targeting an Intel i960.
+   Copyright (C) 1996, 1997, 2000, 2002 Free Software Foundation, Inc.
+   Contributed by Joel Sherrill (joel@OARcorp.com).
+
+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.  */
+
+/* Target OS builtins.  */
+#define TARGET_OS_CPP_BUILTINS()		\
+  do						\
+    {						\
+	builtin_define ("__rtems__");		\
+	builtin_assert ("system=rtems");	\
+    }						\
+  while (0)

gcc/config/i960/t-960bare

+LIB2FUNCS_EXTRA = xp-bit.c
+
+# We want fine grained libraries, so use the new code to build the
+# floating point emulation libraries.
+FPBIT = fp-bit.c
+DPBIT = dp-bit.c
+
+dp-bit.c: $(srcdir)/config/fp-bit.c
+	echo '#define FLOAT_BIT_ORDER_MISMATCH' > dp-bit.c
+	cat $(srcdir)/config/fp-bit.c >> dp-bit.c
+
+fp-bit.c: $(srcdir)/config/fp-bit.c
+	echo '#define FLOAT' > fp-bit.c
+	echo '#define FLOAT_BIT_ORDER_MISMATCH' >> fp-bit.c
+	cat $(srcdir)/config/fp-bit.c >> fp-bit.c
+
+xp-bit.c: $(srcdir)/config/fp-bit.c
+	echo '#define EXTENDED_FLOAT_STUBS' > xp-bit.c
+	cat $(srcdir)/config/fp-bit.c >> xp-bit.c
+
+i960-c.o: $(srcdir)/config/i960/i960-c.c $(CONFIG_H) $(SYSTEM_H) \
+  coretypes.h $(TM_H) $(CPPLIB_H) $(TREE_H) c-pragma.h toplev.h $(GGC_H) $(TM_P_H)
+	$(CC) -c $(ALL_CFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) $(srcdir)/config/i960/i960-c.c
+
+MULTILIB_OPTIONS=mnumerics/msoft-float mlong-double-64
+MULTILIB_DIRNAMES=float soft-float ld64
+MULTILIB_MATCHES=mnumerics=msb mnumerics=msc mnumerics=mkb mnumerics=mkc mnumerics=mmc mnumerics=mcb mnumerics=mcc mnumerics=mjf msoft-float=msa msoft-float=mka msoft-float=mca msoft-float=mcf
+
+LIBGCC = stmp-multilib
+INSTALL_LIBGCC = install-multilib

gcc/f/RELEASE-PREP

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

gcc/f/ansify.c

+/* 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;
+}

gcc/f/bad.h

+/* 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 */

gcc/f/bit.c

+/* 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;
+    }
+}

gcc/f/bit.h

+/* 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 */

gcc/f/bld-op.def

+/* 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)

gcc/f/bugs.texi

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

gcc/f/bugs0.texi

+\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

gcc/f/config-lang.in

+# 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"

gcc/f/data.h

+/* 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 */

gcc/f/equiv.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 */

gcc/f/expr.h

+/* 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 */

gcc/f/global.h

+/* 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 */
+

gcc/f/implic.c

+/* 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)
+{
+}

gcc/f/implic.h

+/* 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 */

gcc/f/info-b.def

+/* 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", "~")

gcc/f/info-k.def

+/* 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", "~")

gcc/f/info-w.def

+/* 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", "~")

gcc/f/info.c

+/* 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

gcc/f/info.h

+/* 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 */

gcc/f/intrin.h

+/* 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 */

gcc/f/lab.c

+/* 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;
+}

gcc/f/lab.h

+/* 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 */

gcc/f/lang-specs.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},
+  {".fpp", "@f77-cpp-input", 0},
+  {".FPP", "@f77-cpp-input", 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},
+  {".r", "@ratfor", 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},
+  {".f",   "@f77", 0},
+  {".for", "@f77", 0},
+  {".FOR", "@f77", 0},
+  {"@f77",
+   "%{!M:%{!MM:%{!E:f771 %i %(cc1_options) %{I*}\
+	%{!fsyntax-only:%(invoke_as)}}}}", 0},

gcc/f/lang.opt

+; 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.

gcc/testsuite/g77.f-torture/execute/io1.f

+*     Fixed by 1998-09-28 libI77/open.c change.
+      open(90,status='scratch')
+      write(90, '(1X, I1 / 1X, I1)') 1, 2
+      rewind 90
+      write(90, '(1X, I1)') 1
+      rewind 90                 ! implicit ENDFILE expected
+      read(90, *) i
+      read(90, *, end=10) j
+      call abort()
+ 10   end

gcc/testsuite/g77.f-torture/execute/io1.x

+# Scratch files aren't implemented for mmixware
+# (_stat is a stub and files can't be deleted).
+# Similar restrictions exist for most simulators.
+
+if { [istarget "mmix-knuth-mmixware"]
+     || [istarget "arm*-*-elf"]
+     || [istarget "strongarm*-*-elf"]
+     || [istarget "xscale*-*-elf"]
+     || [istarget "cris-*-elf"] } {
+	set torture_execute_xfail [istarget]
+}
+
+return 0

gcc/testsuite/g77.f-torture/execute/labug1.f

+      PROGRAM LABUG1
+
+*  This program core dumps on mips-sgi-irix6.2 when compiled
+*  with egcs-19981101, egcs-19981109 and egcs-19981122 snapshots
+*  with -O2
+*
+*  Originally derived from LAPACK test suite.
+*  Almost any change allows it to run.
+*
+*  David Billinghurst, (David.Billinghurst@riotinto.com.au)
+*  25 November 1998
+* 
+*     .. Parameters ..
+      INTEGER   LDA, LDE
+      PARAMETER ( LDA = 2500, LDE = 50  )
+      COMPLEX   CZERO 
+      PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ) )
+
+      INTEGER   I, J, M, N
+      REAL      V
+      COMPLEX   A(LDA),B(LDA),C(LDA),E(LDE,LDE),F(LDE,LDE)  
+      COMPLEX   Z
+
+      N=2
+      M=1
+*
+      do i = 1, m
+         do j = 1, n
+            e(i,j) = czero
+            f(i,j) = czero
+        end do
+      end do
+*
+      DO J = 1, N
+         DO I = 1, M
+            V =  ABS( E(I,J) - F(I,J) )
+         END DO
+      END DO
+ 
+      CALL SUB2(M,Z)
+
+      END
+
+      subroutine SUB2(I,A)
+      integer i
+      complex a
+      end
+
+
+
+
+
+
+
+
+
+

gcc/testsuite/g77.f-torture/execute/large_vec.f

+      parameter (nmax=165000)
+      double precision x(nmax)
+      end

gcc/testsuite/g77.f-torture/execute/le.f

+      program fool
+
+      real     foo
+      integer  n
+      logical  t
+
+      foo = 2.5
+      n = 5
+
+      t = (n > foo)
+      if (t .neqv. .true.) call abort
+      t = (n >= foo)
+      if (t .neqv. .true.) call abort
+      t = (n < foo)
+      if (t .neqv. .false.) call abort
+      t = (n <= 5)
+      if (t .neqv. .true.) call abort
+      t = (n >= 5 )
+      if (t .neqv. .true.) call abort
+      t = (n == 5)
+      if (t .neqv. .true.) call abort
+      t = (n /= 5)
+      if (t .neqv. .false.) call abort
+      t = (n /= foo)
+      if (t .neqv. .true.) call abort
+      t = (n == foo)
+      if (t .neqv. .false.) call abort
+
+      end

gcc/testsuite/g77.f-torture/execute/select.f

+C   integer byte case with integer byte parameters as case(s)
+        subroutine ib
+        integer *1 a /1/
+        integer *1  one,two,three
+        parameter (one=1,two=2,three=3)
+        select case (a)
+        case (one)
+        case (two)
+           call abort
+        case (three)
+           call abort
+        case default
+           call abort
+        end select
+        print*,'normal ib'
+        end
+C   integer halfword case with integer halfword parameters
+        subroutine ih
+        integer *2 a /1/
+        integer *2  one,two,three
+        parameter (one=1,two=2,three=3)
+        select case (a)
+        case (one)
+        case (two)
+           call abort
+        case (three)
+           call abort
+        case default
+           call abort
+        end select
+        print*,'normal ih'
+        end
+C   integer case with integer parameters
+        subroutine iw
+        integer *4 a /1/
+        integer *4  one,two,three
+        parameter (one=1,two=2,three=3)
+        select case (a)
+        case (one)
+        case (two)
+           call abort
+        case (three)
+           call abort
+        case default
+           call abort
+        end select
+        print*,'normal iw'
+        end
+C   integer double case with integer double parameters
+        subroutine id
+        integer *8 a /1/
+        integer *8  one,two,three
+        parameter (one=1,two=2,three=3)
+        select case (a)
+        case (one)
+        case (two)
+           call abort
+        case (three)
+           call abort
+        case default
+           call abort
+        end select
+        print*,'normal id'
+        end
+C   integer byte select with integer case
+       subroutine ib_mixed
+       integer*1 s /1/
+       select case (s)
+       case (1)
+       case (2)
+         call abort
+       end select
+       print*,'ib ok'
+       end
+C   integer halfword with integer case
+       subroutine ih_mixed
+       integer*2 s /1/
+       select case (s)
+       case (1)
+       case default
+         call abort
+       end select
+       print*,'ih ok'
+       end
+C   integer word with integer case
+       subroutine iw_mixed
+       integer s /5/
+       select case (s)
+       case (1)
+          call abort
+       case (2)
+          call abort
+       case (3)
+          call abort
+       case (4)
+          call abort
+       case (5)
+C                   
+       case (6)
+           call abort
+       case default
+           call abort
+       end select
+       print*,'iw ok'
+       end
+C   integer doubleword with integer case
+       subroutine id_mixed
+       integer *8 s /1024/
+       select case (s)
+       case (1)
+           call abort
+       case (1023)
+           call abort
+       case (1025)
+           call abort
+       case (1024)
+C
+       end select
+       print*,'i8 ok'
+       end
+       subroutine l1_mixed
+       logical*1 s /.TRUE./
+       select case (s)
+       case (.TRUE.)
+       case (.FALSE.)
+          call abort
+       end select
+       print*,'l1 ok'
+       end
+       subroutine l2_mixed
+       logical*2 s /.FALSE./
+       select case (s)
+       case (.TRUE.)
+           call abort
+       case (.FALSE.)
+       end select
+       print*,'lh ok'
+       end
+       subroutine l4_mixed
+       logical*4 s /.TRUE./
+       select case (s)
+       case (.FALSE.)
+         call abort
+       case (.TRUE.)
+       end select
+       print*,'lw ok'
+       end
+       subroutine l8_mixed
+       logical*8 s /.TRUE./
+       select case (s)
+       case (.TRUE.)
+       case (.FALSE.)
+          call abort
+       end select
+       print*,'ld ok'
+       end
+C   main
+C -- regression cases
+        call ib
+        call ih
+        call iw
+        call id
+C -- new functionality
+        call ib_mixed
+        call ih_mixed
+        call iw_mixed
+        call id_mixed
+        end
+        
+
+
+
+

gcc/testsuite/g77.f-torture/execute/short.f

+      program short
+
+      parameter   (   N=2  )
+      common /chb/    pi,sig(0:N)
+      common /parm/   h(2,2)
+
+c  initialize some variables
+      h(2,2) = 1117
+      h(2,1) = 1178
+      h(1,2) = 1568
+      h(1,1) = 1621
+      sig(0) = -1.
+      sig(1) = 0.
+      sig(2) = 1.
+
+      call printout
+      stop
+      end
+
+c ******************************************************************
+
+      subroutine printout
+      parameter   (   N=2  )
+      common /chb/    pi,sig(0:N)
+      common /parm/   h(2,2)
+      dimension       yzin1(0:N), yzin2(0:N)
+
+c  function subprograms
+      z(i,j,k) = 0.5*h(i,j)*(sig(k)-1.)
+
+c  a four-way average of rhobar
+      do 260  k=0,N
+        yzin1(k) = 0.25 * 
+     &       ( z(2,2,k) + z(1,2,k) +
+     &         z(2,1,k) + z(1,1,k) )
+  260       continue
+
+c  another four-way average of rhobar
+      do 270  k=0,N
+	rtmp1 = z(2,2,k)
+	rtmp2 = z(1,2,k)
+	rtmp3 = z(2,1,k)
+	rtmp4 = z(1,1,k)
+        yzin2(k) = 0.25 * 
+     &       ( rtmp1 + rtmp2 + rtmp3 + rtmp4 )
+  270       continue
+
+      do k=0,N
+	if (yzin1(k) .ne. yzin2(k)) call abort
+      enddo
+      if (yzin1(0) .ne. -1371.) call abort
+      if (yzin1(1) .ne. -685.5) call abort
+      if (yzin1(2) .ne. 0.) call abort
+
+      return
+      end
+

gcc/testsuite/g77.f-torture/execute/u77-test.x

+# Various intrinsics not implemented and not implementable; will fail at
+# link time.
+
+if { [istarget "mmix-knuth-mmixware"]
+     || [istarget "arm*-*-elf"]
+     || [istarget "strongarm*-*-elf"]
+     || [istarget "xscale*-*-elf"]
+     || [istarget "cris-*-elf"] } {
+	set torture_compile_xfail [istarget]
+}
+
+return 0

gcc/testsuite/g77.f-torture/noncompile/19981216-0.f

+* Resent-From: Craig Burley <burley@gnu.org>
+* Resent-To: craig@jcb-sc.com
+* X-Delivered: at request of burley on mescaline.gnu.org
+* Date: Wed, 16 Dec 1998 18:31:24 +0100
+* From: Dieter Stueken <stueken@conterra.de>
+* Organization: con terra GmbH
+* To: fortran@gnu.org
+* Subject: possible bug
+* Content-Type: text/plain; charset=iso-8859-1
+* X-Mime-Autoconverted: from 8bit to quoted-printable by mescaline.gnu.org id KAA09085
+* X-UIDL: 72293bf7f9fac8378ec7feca2bccbce2
+* 
+* Hi,
+* 
+* I'm about to compile a very old, very ugly Fortran program.
+* For one part I got:
+* 
+* f77: Internal compiler error: program f771 got fatal signal 6
+* 
+* instead of any detailed error message. I was able to break down the
+* problem to the following source fragment:
+* 
+* -------------------------------------------
+        PROGRAM WAP
+
+        integer*2  ios
+        character*80  name
+
+        name = 'blah'
+        open(unit=8,status='unknown',file=name,form='formatted',
+     F       iostat=ios)
+
+      END
+* -------------------------------------------
+* 
+* The problem seems to be caused by the "integer*2 ios" declaration.
+* So far I solved it by simply using a plain integer instead.
+* 
+* I'm running gcc on a Linux system compiled/installed
+* with no special options:
+* 
+* -> g77 -v
+* g77 version 0.5.23
+* Driving: g77 -v -c -xf77-version /dev/null -xnone
+* Reading specs from /usr/lib/gcc-lib/i686-pc-linux-gnulibc1/2.8.1/specs
+* gcc version 2.8.1
+*  /usr/lib/gcc-lib/i686-pc-linux-gnulibc1/2.8.1/cpp -lang-c -v -undef
+* -D__GNUC__=2 -D__GNUC_MINOR__=8 -D__ELF__ -D__unix__ -D__linux__
+* -D__unix -D__linux -Asystem(posix) -D_LANGUAGE_FORTRAN -traditional
+* -Di386 -Di686 -Asystem(unix) -Acpu(i386) -Amachine(i386) -D__i386__
+* -D__i686__ -Asystem(unix) -Acpu(i386) -Amachine(i386) /dev/null
+* /dev/null
+* GNU CPP version 2.8.1 (i386 GNU/Linux with ELF)
+* #include "..." search starts here:
+* #include <...> search starts here:
+*  /usr/local/include
+*  /usr/i686-pc-linux-gnulibc1/include
+*  /usr/lib/gcc-lib/i686-pc-linux-gnulibc1/2.8.1/include
+*  /usr/include
+* End of search list.
+*  /usr/lib/gcc-lib/i686-pc-linux-gnulibc1/2.8.1/f771 -fnull-version
+* -quiet -dumpbase g77-version.f -version -fversion -o /tmp/cca24911.s
+* /dev/null
+* GNU F77 version 2.8.1 (i686-pc-linux-gnulibc1) compiled by GNU C version
+* 2.8.1.
+* GNU Fortran Front End version 0.5.23
+*  as -V -Qy -o /tmp/cca24911.o /tmp/cca24911.s
+* GNU assembler version 2.8.1 (i486-linux), using BFD version 2.8.1
+*  ld -m elf_i386 -dynamic-linker /lib/ld-linux.so.1 -o /tmp/cca24911
+* /tmp/cca24911.o /usr/lib/crt1.o /usr/lib/crti.o
+* /usr/lib/gcc-lib/i686-pc-linux-gnulibc1/2.8.1/crtbegin.o
+* -L/usr/lib/gcc-lib/i686-pc-linux-gnulibc1/2.8.1 -L/usr -lg2c -lm -lgcc
+* -lc -lgcc /usr/lib/gcc-lib/i686-pc-linux-gnulibc1/2.8.1/crtend.o
+* /usr/lib/crtn.o
+*  /tmp/cca24911
+* __G77_LIBF77_VERSION__: 0.5.23
+* @(#)LIBF77 VERSION 19970919
+* __G77_LIBI77_VERSION__: 0.5.23
+* @(#) LIBI77 VERSION pjw,dmg-mods 19980405
+* __G77_LIBU77_VERSION__: 0.5.23
+* @(#) LIBU77 VERSION 19970919
+* 
+* 
+* Regards, Dieter.
+* -- 
+* Dieter Stken, con terra GmbH, Mnster
+*     stueken@conterra.de         stueken@qgp.uni-muenster.de
+*     http://www.conterra.de/     http://qgp.uni-muenster.de/~stueken
+*     (0)251-980-2027             (0)251-83-334974

gcc/testsuite/g77.f-torture/noncompile/19990218-1.f

+        double precision function fun(a,b)
+        double precision a,b
+        print*,'in sub: a,b=',a,b
+        fun=a*b
+        print*,'in sub: fun=',fun
+        return
+        end
+        program test
+        double precision a,b,c
+        data a,b/1.0d-46,1.0d0/
+        c=fun(a,b)
+        print*,'in main: fun=',c
+        end