Another bunch of patches from Craig. See ChangeLogs for details.

From-SVN: r18188

gcc/f/ChangeLog

@@ -8,6 +8,15 @@ Fri Feb 20 10:11:20 1998  Craig Burley  <burley@gnu.org>
 
 Sun Jan 11 02:14:47 1998  Craig Burley  <burley@gnu.org>
 
+	Fix 970626-2.f by not doing most back-end processing
+	when current_function_decl is an ERROR_MARK, and by
+	making that the case when its type would be an ERROR_MARK:
+	* com.c (ffecom_start_progunit_, finish_function,
+	lang_printable_name, start_function,
+	ffecom_finish_symbol_transform_): Test for ERROR_MARK.
+	* std.c (ffestd_stmt_pass_): Don't do any downstream
+	processing if ERROR_MARK.
+
 	Support FORMAT(I<1+2>) (constant variable-FORMAT
 	expressions):
 	* bad.def (FFEBAD_FORMAT_VARIABLE): New diagnostic.
@@ -106,6 +115,22 @@ Sun Nov 30 22:22:22 1997  Craig Burley  <burley@gnu.org>
 	* com.c (ffecom_arglist_expr_): Pass null pointers for optional
 	args which aren't supplied.
 
+Sun Oct 26 02:36:21 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* com.c (lang_print_error_function): Fix to more
+	reliably notice when the diagnosed region changes.
+
+Sat Oct 25 23:43:36 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Fix 950327-0.f:
+	* sta.c, sta.h (ffesta_outpooldisp): New function.
+	* std.c (ffestd_stmt_pass_): Don't kill NULL pool.
+	(ffestd_R842): If pool already preserved, save NULL
+	for pool, because it should be killed only once.
+
+	* malloc.c [MALLOC_DEBUG]: Put initializer for `name'
+	component in braces, to avoid compiler warning.
+
 Fri Oct 10 13:00:48 1997  Craig Burley  <burley@gnu.ai.mit.edu>
 
 	* ste.c (ffeste_begin_iterdo_): Fix loop setup so iteration

gcc/f/com.c

@@ -6659,7 +6659,7 @@ ffecom_finish_global_ (ffeglobal global)
 static ffesymbol
 ffecom_finish_symbol_transform_ (ffesymbol s)
 {
-  if (s == NULL)
+  if ((s == NULL) || (TREE_CODE (current_function_decl) == ERROR_MARK))
     return s;
 
   /* It's easy to know to transform an untransformed symbol, to make sure
@@ -7948,6 +7948,7 @@ ffecom_start_progunit_ ()
 
   resume_momentary (yes);
 
+  if (TREE_CODE (current_function_decl) != ERROR_MARK)
     store_parm_decls (main_program ? 1 : 0);
 
   ffecom_start_compstmt_ ();
@@ -14206,16 +14207,22 @@ finish_function (int nested)
   register tree fndecl = current_function_decl;
 
   assert (fndecl != NULL_TREE);
+  if (TREE_CODE (fndecl) != ERROR_MARK)
+    {
       if (nested)
 	assert (DECL_CONTEXT (fndecl) != NULL_TREE);
       else
 	assert (DECL_CONTEXT (fndecl) == NULL_TREE);
+    }
 
 /*  TREE_READONLY (fndecl) = 1;
     This caused &foo to be of type ptr-to-const-function
     which then got a warning when stored in a ptr-to-function variable.  */
 
   poplevel (1, 0, 1);
+
+  if (TREE_CODE (fndecl) != ERROR_MARK)
+    {
       BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl;
 
       /* Must mark the RESULT_DECL as being in this function.  */
@@ -14231,6 +14238,7 @@ finish_function (int nested)
 
       /* Run the optimizers and output the assembler code for this function.  */
       rest_of_compilation (fndecl);
+    }
 
   /* Free all the tree nodes making up this function.  */
   /* Switch back to allocating nodes permanently until we start another
@@ -14238,7 +14246,7 @@ finish_function (int nested)
   if (!nested)
     permanent_allocation (1);
 
-  if (DECL_SAVED_INSNS (fndecl) == 0 && !nested)
+  if (DECL_SAVED_INSNS (fndecl) == 0 && !nested && (TREE_CODE (fndecl) != ERROR_MARK))
     {
       /* Stop pointing to the local nodes about to be freed.  */
       /* But DECL_INITIAL must remain nonzero so we know this was an actual
@@ -14276,6 +14284,8 @@ lang_printable_name (tree decl, int v)
   switch (v)
     {
     default:
+      if (TREE_CODE (decl) == ERROR_MARK)
+	return "erroneous code";
       return IDENTIFIER_POINTER (DECL_NAME (decl));
     }
 }
@@ -14288,16 +14298,23 @@ void
 lang_print_error_function (file)
      char *file;
 {
+  static ffeglobal last_g = NULL;
   static ffesymbol last_s = NULL;
+  ffeglobal g;
   ffesymbol s;
   char *kind;
 
-  if (ffecom_primary_entry_ == NULL)
+  if ((ffecom_primary_entry_ == NULL)
+      || (ffesymbol_global (ffecom_primary_entry_) == NULL))
     {
+      g = NULL;
       s = NULL;
       kind = NULL;
     }
-  else if (ffecom_nested_entry_ == NULL)
+  else
+    {
+      g = ffesymbol_global (ffecom_primary_entry_);
+      if (ffecom_nested_entry_ == NULL)
 	{
 	  s = ffecom_primary_entry_;
 	  switch (ffesymbol_kind (s))
@@ -14328,8 +14345,9 @@ lang_print_error_function (file)
 	  s = ffecom_nested_entry_;
 	  kind = "statement function";
 	}
+    }
 
-  if (last_s != s)
+  if ((last_g != g) || (last_s != s))
     {
       if (file)
 	fprintf (stderr, "%s: ", file);
@@ -14343,6 +14361,7 @@ lang_print_error_function (file)
 	  fprintf (stderr, "In %s `%s':\n", kind, name);
 	}
 
+      last_g = g;
       last_s = s;
     }
 }
@@ -14615,6 +14634,10 @@ start_function (tree name, tree type, int nested, int public)
       assert (current_function_decl == NULL_TREE);
     }
 
+  if (TREE_CODE (type) == ERROR_MARK)
+    decl1 = current_function_decl = error_mark_node;
+  else
+    {
       decl1 = build_decl (FUNCTION_DECL,
 			  name,
 			  type);
@@ -14634,23 +14657,28 @@ start_function (tree name, tree type, int nested, int public)
 	 a decl for this name, and it is a FUNCTION_DECL, use the old decl.  */
 
       current_function_decl = pushdecl (decl1);
+    }
+
   if (!nested)
     ffecom_outer_function_decl_ = current_function_decl;
 
   pushlevel (0);
 
+  if (TREE_CODE (current_function_decl) != ERROR_MARK)
+    {
       make_function_rtl (current_function_decl);
 
       restype = TREE_TYPE (TREE_TYPE (current_function_decl));
       DECL_RESULT (current_function_decl)
 	= build_decl (RESULT_DECL, NULL_TREE, restype);
+    }
 
   if (!nested)
     /* Allocate further tree nodes temporarily during compilation of this
        function only.  */
     temporary_allocation ();
 
-  if (!nested)
+  if (!nested && (TREE_CODE (current_function_decl) != ERROR_MARK))
     TREE_ADDRESSABLE (current_function_decl) = 1;
 
   immediate_size_expand = old_immediate_size_expand;

gcc/f/g77.texi

@@ -1345,6 +1345,8 @@ by type.  Explanations are in the following sections.
 -fcase-initcap  -fcase-upper  -fcase-lower  -fcase-preserve
 -ff2c-intrinsics-delete  -ff2c-intrinsics-hide
 -ff2c-intrinsics-disable  -ff2c-intrinsics-enable
+-fbadu77-intrinsics-delete  -fbadu77-intrinsics-hide
+-fbadu77-intrinsics-disable  -fbadu77-intrinsics-enable
 -ff90-intrinsics-delete  -ff90-intrinsics-hide
 -ff90-intrinsics-disable  -ff90-intrinsics-enable
 -fgnu-intrinsics-delete  -fgnu-intrinsics-hide
@@ -1827,9 +1829,11 @@ had read @samp{DIMENSION X(*)}.
 @cindex -fugly-comma option
 @cindex options, -fugly-comma
 @item -fugly-comma
-Treat a trailing comma in an argument list as specification
-of a trailing null argument, and treat an empty argument
-list as specification of a single null argument.
+In an external-procedure invocation,
+treat a trailing comma in the argument list
+as specification of a trailing null argument,
+and treat an empty argument list
+as specification of a single null argument.
 
 For example, @samp{CALL FOO(,)} is treated as
 @samp{CALL FOO(%VAL(0), %VAL(0))}.
@@ -1839,6 +1843,8 @@ And @samp{F = FUNC()} is treated as @samp{F = FUNC(%VAL(0))}.
 
 The default behavior, @samp{-fno-ugly-comma}, is to ignore
 a single trailing comma in an argument list.
+So, by default, @samp{CALL FOO(X,)} is treated
+exactly the same as @samp{CALL FOO(X)}.
 
 @xref{Ugly Null Arguments}, for more information.
 
@@ -2046,6 +2052,24 @@ while allowing any-case matching of intrinsics and keywords.
 For example, @samp{call Foo(i,I)} would pass two @emph{different}
 variables named @samp{i} and @samp{I} to a procedure named @samp{Foo}.)
 
+@cindex -fbadu77-intrinsics-delete option
+@cindex options, -fbadu77-intrinsics-delete
+@item -fbadu77-intrinsics-delete
+@cindex -fbadu77-intrinsics-hide option
+@cindex options, -fbadu77-intrinsics-hide
+@item -fbadu77-intrinsics-hide
+@cindex -fbadu77-intrinsics-disable option
+@cindex options, -fbadu77-intrinsics-disable
+@item -fbadu77-intrinsics-disable
+@cindex -fbadu77-intrinsics-enable option
+@cindex options, -fbadu77-intrinsics-enable
+@item -fbadu77-intrinsics-enable
+@cindex badu77 intrinsics
+@cindex intrinsics, badu77
+Specify status of UNIX intrinsics having inappropriate forms.
+@samp{-fbadu77-intrinsics-enable} is the default.
+@xref{Intrinsic Groups}.
+
 @cindex -ff2c-intrinsics-delete option
 @cindex options, -ff2c-intrinsics-delete
 @item -ff2c-intrinsics-delete
@@ -2062,6 +2086,7 @@ variables named @samp{i} and @samp{I} to a procedure named @samp{Foo}.)
 @cindex intrinsics, f2c
 Specify status of f2c-specific intrinsics.
 @samp{-ff2c-intrinsics-enable} is the default.
+@xref{Intrinsic Groups}.
 
 @cindex -ff90-intrinsics-delete option
 @cindex options, -ff90-intrinsics-delete
@@ -2079,6 +2104,7 @@ Specify status of f2c-specific intrinsics.
 @cindex intrinsics, Fortran 90
 Specify status of F90-specific intrinsics.
 @samp{-ff90-intrinsics-enable} is the default.
+@xref{Intrinsic Groups}.
 
 @cindex -fgnu-intrinsics-delete option
 @cindex options, -fgnu-intrinsics-delete
@@ -2097,6 +2123,7 @@ Specify status of F90-specific intrinsics.
 @cindex intrinsics, COMPLEX
 Specify status of Digital's COMPLEX-related intrinsics.
 @samp{-fgnu-intrinsics-enable} is the default.
+@xref{Intrinsic Groups}.
 
 @cindex -fmil-intrinsics-delete option
 @cindex options, -fmil-intrinsics-delete
@@ -2114,6 +2141,7 @@ Specify status of Digital's COMPLEX-related intrinsics.
 @cindex intrinsics, MIL-STD 1753
 Specify status of MIL-STD-1753-specific intrinsics.
 @samp{-fmil-intrinsics-enable} is the default.
+@xref{Intrinsic Groups}.
 
 @cindex -funix-intrinsics-delete option
 @cindex options, -funix-intrinsics-delete
@@ -2131,6 +2159,7 @@ Specify status of MIL-STD-1753-specific intrinsics.
 @cindex intrinsics, UNIX
 Specify status of UNIX intrinsics.
 @samp{-funix-intrinsics-enable} is the default.
+@xref{Intrinsic Groups}.
 
 @cindex -fvxt-intrinsics-delete option
 @cindex options, -fvxt-intrinsics-delete
@@ -2148,6 +2177,7 @@ Specify status of UNIX intrinsics.
 @cindex intrinsics, VXT
 Specify status of VXT intrinsics.
 @samp{-fvxt-intrinsics-enable} is the default.
+@xref{Intrinsic Groups}.
 
 @cindex -ffixed-line-length-@var{n} option
 @cindex options, -ffixed-line-length-@var{n}
@@ -3251,7 +3281,7 @@ users use @code{g77}.
 such changes to @code{g77}.
 
 To find out about existing bugs and ongoing plans for GNU
-Fortran, retrieve @code{ftp://alpha.gnu.org/g77.plan}
+Fortran, retrieve @uref{ftp://alpha.gnu.org/g77.plan}
 or, if you cannot do that, email
 @email{fortran@@gnu.org} asking for a recent copy of the
 GNU Fortran @file{.plan} file.
@@ -3699,8 +3729,8 @@ way through the compilation process instead of being lost.
 GNU Fortran supports a variety of extensions to, and dialects
 of, the Fortran language.
 Its primary base is the ANSI FORTRAN 77 standard, currently available on
-the network at @code{http://kumo.swcp.com/fortran/F77_std/f77_std.html}
-or in @code{ftp://ftp.ast.cam.ac.uk/pub/michael/}.
+the network at @uref{http://kumo.swcp.com/fortran/F77_std/f77_std.html}
+or in @uref{ftp://ftp.ast.cam.ac.uk/pub/michael/}.
 It offers some extensions that are popular among users
 of UNIX @code{f77} and @code{f2c} compilers, some that
 are popular among users of other compilers (such as Digital
@@ -5726,7 +5756,7 @@ C INT(I1-I2) as INT(I1)-INT(I2) given INTEGER*2 I1,I2.
 C
 C Version 0:
 C Written by James Craig Burley 1997-02-20.
-C Contact via Internet email: burley@@gnu.ai.mit.edu
+C Contact via Internet email: burley@@gnu.org
 C
 C Purpose:
 C Determine how compilers handle non-standard IDIM
@@ -7060,11 +7090,11 @@ without conversion.
 @cindex null arguments
 @cindex arguments, null
 
-The @samp{-fugly-comma} option enables
-use of a single trailing comma to mean ``pass an extra trailing null
-argument'' in a list of actual arguments to a procedure other than a
-statement function, and use of an empty list of arguments to
-mean ``pass a single null argument''.
+The @samp{-fugly-comma} option enables use of a single trailing comma
+to mean ``pass an extra trailing null argument''
+in a list of actual arguments to an external procedure,
+and use of an empty list of arguments to such a procedure
+to mean ``pass a single null argument''.
 
 @cindex omitting arguments
 @cindex arguments, omitting
@@ -7598,26 +7628,33 @@ The groups are:
 @cindex intrinsics, groups of
 @cindex groups of intrinsics
 @table @code
+@cindex @code{badu77} intrinsics group
 @item badu77
 UNIX intrinsics having inappropriate forms (usually functions that
 have intended side effects).
 
+@cindex @code{gnu} intrinsics group
 @item gnu
 Intrinsics the GNU Fortran language supports that are extensions to
 the Fortran standards (77 and 90).
 
+@cindex @code{f2c} intrinsics group
 @item f2c
 Intrinsics supported by AT&T's @code{f2c} converter and/or @code{libf2c}.
 
+@cindex @code{f90} intrinsics group
 @item f90
 Fortran 90 intrinsics.
 
+@cindex @code{mil} intrinsics group
 @item mil
 MIL-STD 1753 intrinsics (@code{MVBITS}, @code{IAND}, @code{BTEST}, and so on).
 
+@cindex @code{mil} intrinsics group
 @item unix
 UNIX intrinsics (@code{IARGC}, @code{EXIT}, @code{ERF}, and so on).
 
+@cindex @code{mil} intrinsics group
 @item vxt
 VAX/VMS FORTRAN (current as of v4) intrinsics.
 @end table
@@ -7867,7 +7904,7 @@ options @code{g77} passes by running @samp{g77 -v}.
 @cindex cfortran.h
 @cindex Netlib
 Even if you don't actually use it as a compiler, @samp{f2c} from
-@code{ftp://ftp.netlib.org/f2c/src}, can be a useful tool when you're
+@uref{ftp://ftp.netlib.org/f2c/src}, can be a useful tool when you're
 interfacing (linking) Fortran and C@.
 @xref{f2c Skeletons and Prototypes,,Generating Skeletons and Prototypes with @code{f2c}}.
 
@@ -7877,7 +7914,7 @@ build the @file{src} directory from the distribution, consult the
 @code{f2c} program on your path.
 
 Something else that might be useful is @samp{cfortran.h} from
-@code{ftp://zebra/desy.de/cfortran}.
+@uref{ftp://zebra/desy.de/cfortran}.
 This is a fairly general tool which
 can be used to generate interfaces for calling in both directions
 between Fortran and C@.
@@ -7921,8 +7958,8 @@ the return type of a @code{REAL} @code{FUNCTION}.)
 @samp{-P} option to generate C prototypes appropriate for calling the
 Fortran.@footnote{The files generated like this can also be used for
 inter-unit consistency checking of dummy and actual arguments, although
-the @samp{ftnchek} tool from @code{ftp://ftp.netlib.org/fortran}
-or @code{ftp://ftp.dsm.fordham.edu} is
+the @samp{ftnchek} tool from @uref{ftp://ftp.netlib.org/fortran}
+or @uref{ftp://ftp.dsm.fordham.edu} is
 probably better for this purpose.}
 If the Fortran code containing any
 routines to be called from C is in file @file{joe.f}, use the command
@@ -10164,7 +10201,7 @@ or installing @code{g77} is not provided here.
 
 To find out about major bugs discovered in the current release and
 possible workarounds for them, retrieve
-@code{ftp://alpha.gnu.org/g77.plan}.
+@uref{ftp://alpha.gnu.org/g77.plan}.
 
 (Note that some of this portion of the manual is lifted
 directly from the @code{gcc} manual, with minor modifications
@@ -10541,7 +10578,7 @@ In the meantime, finding and fixing the programming
 bugs that lead to these behaviors is, ultimately, the user's
 responsibility, as difficult as that task can sometimes be.
 
-@cindex `infinite spaces' printed
+@cindex ``infinite spaces'' printed
 @cindex spaces, endless printing of
 @cindex libc, non-ANSI or non-default
 @cindex C library
@@ -11029,16 +11066,17 @@ specifiers.
 Supporting this requires a significant redesign or replacement
 of @code{libf2c}.
 
-However, a future version of @code{g77} might support
-this construct when the expression is constant.  For
-example:
+However, @code{g77} does support
+this construct when the expression is constant
+(as of version 0.5.22).
+For example:
 
 @smallexample
       PARAMETER (IWIDTH = 12)
 10    FORMAT (I<IWIDTH>)
 @end smallexample
 
-In the meantime, at least for output (@code{PRINT} and
+Otherwise, at least for output (@code{PRINT} and
 @code{WRITE}), Fortran code making use of this feature can
 be rewritten to avoid it by constructing the @code{FORMAT}
 string in a @code{CHARACTER} variable or array, then
@@ -12272,8 +12310,65 @@ their use into selective changes in your own code.
 @pindex ftncheck
 Validate your code with @code{ftnchek} or a similar code-checking
 tool.
-@code{ftncheck} can be found at @code{ftp://ftp.netlib.org/fortran}
-or @code{ftp://ftp.dsm.fordham.edu}.
+@code{ftncheck} can be found at @uref{ftp://ftp.netlib.org/fortran}
+or @uref{ftp://ftp.dsm.fordham.edu}.
+
+@pindex make
+@cindex Makefile example
+Here are some sample @file{Makefile} rules using @code{ftnchek}
+``project'' files to do cross-file checking and @code{sfmakedepend}
+(from @uref{ftp://ahab.rutgers.edu/pub/perl/sfmakedepend})
+to maintain dependencies automatically.
+These assume the use of GNU @code{make}.
+
+@smallexample
+# Dummy suffix for ftnchek targets:
+.SUFFIXES: .chek
+.PHONY: chekall
+
+# How to compile .f files (for implicit rule):
+FC = g77
+# Assume `include' directory:
+FFLAGS = -Iinclude -g -O -Wall
+
+# Flags for ftnchek:
+CHEK1 = -array=0 -include=includes -noarray
+CHEK2 = -nonovice -usage=1 -notruncation
+CHEKFLAGS = $(CHEK1) $(CHEK2)
+
+# Run ftnchek with all the .prj files except the one corresponding
+# to the target's root:
+%.chek : %.f ; \
+  ftnchek $(filter-out $*.prj,$(PRJS)) $(CHEKFLAGS) \
+    -noextern -library $<
+
+# Derive a project file from a source file:
+%.prj : %.f ; \
+  ftnchek $(CHEKFLAGS) -noextern -project -library $<
+
+# The list of objects is assumed to be in variable OBJS.
+# Sources corresponding to the objects:
+SRCS = $(OBJS:%.o=%.f)
+# ftnchek project files:
+PRJS = $(OBJS:%.o=%.prj)
+
+# Build the program
+prog: $(OBJS) ; \
+  $(FC) -o $@ $(OBJS)
+
+chekall: $(PRJS) ; \
+  ftnchek $(CHEKFLAGS) $(PRJS)
+
+prjs: $(PRJS)
+
+# For Emacs M-x find-tag:
+TAGS: $(SRCS) ; \
+  etags $(SRCS)
+
+# Rebuild dependencies:
+depend: ; \
+  sfmakedepend -I $(PLTLIBDIR) -I includes -a prj $(SRCS1)
+@end smallexample
 
 @item
 Try your code out using other Fortran compilers, such as @code{f2c}.
@@ -13352,7 +13447,7 @@ that the explanations are given below, and the diagnostics themselves
 identify the appropriate explanation.
 
 Identification uses the GNU Info format---specifically, the @code{info}
-command that displays the explanation is given in within square
+command that displays the explanation is given within square
 brackets in the diagnostic.
 For example:
 
@@ -13556,7 +13651,7 @@ The following sample program might help:
       PROGRAM JCB003
 C
 C Written by James Craig Burley 1997-02-23.
-C Contact via Internet email: burley@@gnu.ai.mit.edu
+C Contact via Internet email: burley@@gnu.org
 C
 C Determine how compilers handle non-standard REAL
 C and AIMAG on DOUBLE COMPLEX operands.

gcc/f/g77install.texi

@@ -5,7 +5,7 @@
 @c The text of this file appears in the file INSTALL
 @c in the G77 distribution, as well as in the G77 manual.
 
-@c 1997-09-09
+@c 1997-12-23
 
 Note most of this information is out of date and superceded by the EGCS
 install procedures.  It is provided for historical reference only.
@@ -66,9 +66,9 @@ most systems, if desired.
 
 =======
 The version of GNU @code{gzip} used to package this release
-is 1.24.
+is 1.2.4.
 (The version of GNU @code{tar} used to package this release
-is 1.11.2.)
+is 1.12.)
 
 @item @file{gcc-2.7.2.3.tar.gz}
 You need to have this, or some other applicable, version
@@ -202,7 +202,7 @@ In any case, you can apply patches by hand---patch files
 are designed for humans to read them.
 
 The version of GNU @code{patch} used to develop this release
-is 2.4.
+is 2.5.
 
 @item @code{make}
 Your system must have @code{make}, and you will probably save
@@ -210,7 +210,7 @@ yourself a lot of trouble if it is GNU @code{make} (sometimes
 referred to as @code{gmake}).
 
 The version of GNU @code{make} used to develop this release
-is 3.73.
+is 3.76.1.
 
 @item @code{cc}
 Your system must have a working C compiler.

gcc/f/malloc.c

@@ -51,7 +51,7 @@ struct _malloc_root_ malloc_root_
     (mallocArea_) &malloc_root_.malloc_pool_image_.first,
     0,
 #if MALLOC_DEBUG
-    0, 0, 0, 0, 0, 0, 0, '/'
+    0, 0, 0, 0, 0, 0, 0, { '/' }
 #endif
   },
 };

gcc/f/sta.c

@@ -1792,9 +1792,11 @@ ffesta_ffebad_2t (ffebad errnum, ffelexToken t1, ffelexToken t2)
     }
 }
 
-/* ffesta_set_outpooldisp -- Set disposition of statement output pool
-
-   ffesta_set_outpooldisp(FFESTA_pooldispPRESERVE);  */
+ffestaPooldisp
+ffesta_outpooldisp ()
+{
+  return ffesta_outpooldisp_;
+}
 
 void
 ffesta_set_outpooldisp (ffestaPooldisp d)

gcc/f/sta.h

@@ -98,6 +98,7 @@ void ffesta_ffebad_2st (ffebad msg, char *s, ffelexToken t1, ffelexToken t2);
 void ffesta_ffebad_2t (ffebad msg, ffelexToken t1, ffelexToken t2);
 ffelexHandler ffesta_zero (ffelexToken t);
 ffelexHandler ffesta_two (ffelexToken first, ffelexToken second);
+ffestaPooldisp ffesta_outpooldisp (void);
 void ffesta_set_outpooldisp (ffestaPooldisp d);
 
 /* Define macros. */

gcc/f/std.c

@@ -662,9 +662,10 @@ ffestd_stmt_pass_ ()
 {
   ffestdStmt_ stmt;
   ffestdExprItem_ expr;		/* For traversing lists. */
+  bool okay = (TREE_CODE (current_function_decl) != ERROR_MARK);
 
 #if FFECOM_targetCURRENT == FFECOM_targetGCC
-  if (ffestd_2pass_entrypoints_ != 0)
+  if ((ffestd_2pass_entrypoints_ != 0) && okay)
     {
       tree which = ffecom_which_entrypoint_decl ();
       tree value;
@@ -718,71 +719,84 @@ ffestd_stmt_pass_ ()
 	{
 	case FFESTD_stmtidENDDOLOOP_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_do (stmt->u.enddoloop.block);
 	  ffestw_kill (stmt->u.enddoloop.block);
 	  break;
 
 	case FFESTD_stmtidENDLOGIF_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_end_R807 ();
 	  break;
 
 	case FFESTD_stmtidEXECLABEL_:
+	  if (okay)
 	    ffeste_labeldef_branch (stmt->u.execlabel.label);
 	  break;
 
 	case FFESTD_stmtidFORMATLABEL_:
+	  if (okay)
 	    ffeste_labeldef_format (stmt->u.formatlabel.label);
 	  break;
 
 	case FFESTD_stmtidR737A_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R737A (stmt->u.R737A.dest, stmt->u.R737A.source);
 	  malloc_pool_kill (stmt->u.R737A.pool);
 	  break;
 
 	case FFESTD_stmtidR803_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R803 (stmt->u.R803.expr);
 	  malloc_pool_kill (stmt->u.R803.pool);
 	  break;
 
 	case FFESTD_stmtidR804_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R804 (stmt->u.R804.expr);
 	  malloc_pool_kill (stmt->u.R804.pool);
 	  break;
 
 	case FFESTD_stmtidR805_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R805 ();
 	  break;
 
 	case FFESTD_stmtidR806_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R806 ();
 	  break;
 
 	case FFESTD_stmtidR807_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R807 (stmt->u.R807.expr);
 	  malloc_pool_kill (stmt->u.R807.pool);
 	  break;
 
 	case FFESTD_stmtidR809_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R809 (stmt->u.R809.block, stmt->u.R809.expr);
 	  malloc_pool_kill (stmt->u.R809.pool);
 	  break;
 
 	case FFESTD_stmtidR810_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R810 (stmt->u.R810.block, stmt->u.R810.casenum);
 	  malloc_pool_kill (stmt->u.R810.pool);
 	  break;
 
 	case FFESTD_stmtidR811_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R811 (stmt->u.R811.block);
 	  malloc_pool_kill (ffestw_select (stmt->u.R811.block)->pool);
 	  ffestw_kill (stmt->u.R811.block);
@@ -790,6 +804,7 @@ ffestd_stmt_pass_ ()
 
 	case FFESTD_stmtidR819A_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R819A (stmt->u.R819A.block, stmt->u.R819A.label,
 			  stmt->u.R819A.var,
 			  stmt->u.R819A.start, stmt->u.R819A.start_token,
@@ -804,6 +819,7 @@ ffestd_stmt_pass_ ()
 
 	case FFESTD_stmtidR819B_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R819B (stmt->u.R819B.block, stmt->u.R819B.label,
 			  stmt->u.R819B.expr);
 	  malloc_pool_kill (stmt->u.R819B.pool);
@@ -811,26 +827,31 @@ ffestd_stmt_pass_ ()
 
 	case FFESTD_stmtidR825_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R825 ();
 	  break;
 
 	case FFESTD_stmtidR834_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R834 (stmt->u.R834.block);
 	  break;
 
 	case FFESTD_stmtidR835_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R835 (stmt->u.R835.block);
 	  break;
 
 	case FFESTD_stmtidR836_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R836 (stmt->u.R836.label);
 	  break;
 
 	case FFESTD_stmtidR837_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R837 (stmt->u.R837.labels, stmt->u.R837.count,
 			 stmt->u.R837.expr);
 	  malloc_pool_kill (stmt->u.R837.pool);
@@ -838,18 +859,21 @@ ffestd_stmt_pass_ ()
 
 	case FFESTD_stmtidR838_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R838 (stmt->u.R838.label, stmt->u.R838.target);
 	  malloc_pool_kill (stmt->u.R838.pool);
 	  break;
 
 	case FFESTD_stmtidR839_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R839 (stmt->u.R839.target);
 	  malloc_pool_kill (stmt->u.R839.pool);
 	  break;
 
 	case FFESTD_stmtidR840_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R840 (stmt->u.R840.expr, stmt->u.R840.neg, stmt->u.R840.zero,
 			 stmt->u.R840.pos);
 	  malloc_pool_kill (stmt->u.R840.pool);
@@ -857,140 +881,174 @@ ffestd_stmt_pass_ ()
 
 	case FFESTD_stmtidR841_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R841 ();
 	  break;
 
 	case FFESTD_stmtidR842_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R842 (stmt->u.R842.expr);
+	  if (stmt->u.R842.pool != NULL)
 	    malloc_pool_kill (stmt->u.R842.pool);
 	  break;
 
 	case FFESTD_stmtidR843_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R843 (stmt->u.R843.expr);
 	  malloc_pool_kill (stmt->u.R843.pool);
 	  break;
 
 	case FFESTD_stmtidR904_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R904 (stmt->u.R904.params);
 	  malloc_pool_kill (stmt->u.R904.pool);
 	  break;
 
 	case FFESTD_stmtidR907_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R907 (stmt->u.R907.params);
 	  malloc_pool_kill (stmt->u.R907.pool);
 	  break;
 
 	case FFESTD_stmtidR909_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R909_start (stmt->u.R909.params, stmt->u.R909.only_format,
 			       stmt->u.R909.unit, stmt->u.R909.format,
 			       stmt->u.R909.rec, stmt->u.R909.key);
 	  for (expr = stmt->u.R909.list; expr != NULL; expr = expr->next)
 	    {
+	      if (okay)
 		ffeste_R909_item (expr->expr, expr->token);
 	      ffelex_token_kill (expr->token);
 	    }
+	  if (okay)
 	    ffeste_R909_finish ();
 	  malloc_pool_kill (stmt->u.R909.pool);
 	  break;
 
 	case FFESTD_stmtidR910_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R910_start (stmt->u.R910.params, stmt->u.R910.unit,
 			       stmt->u.R910.format, stmt->u.R910.rec);
 	  for (expr = stmt->u.R910.list; expr != NULL; expr = expr->next)
 	    {
+	      if (okay)
 		ffeste_R910_item (expr->expr, expr->token);
 	      ffelex_token_kill (expr->token);
 	    }
+	  if (okay)
 	    ffeste_R910_finish ();
 	  malloc_pool_kill (stmt->u.R910.pool);
 	  break;
 
 	case FFESTD_stmtidR911_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R911_start (stmt->u.R911.params, stmt->u.R911.format);
 	  for (expr = stmt->u.R911.list; expr != NULL; expr = expr->next)
 	    {
+	      if (okay)
 		ffeste_R911_item (expr->expr, expr->token);
 	      ffelex_token_kill (expr->token);
 	    }
+	  if (okay)
 	    ffeste_R911_finish ();
 	  malloc_pool_kill (stmt->u.R911.pool);
 	  break;
 
 	case FFESTD_stmtidR919_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R919 (stmt->u.R919.params);
 	  malloc_pool_kill (stmt->u.R919.pool);
 	  break;
 
 	case FFESTD_stmtidR920_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R920 (stmt->u.R920.params);
 	  malloc_pool_kill (stmt->u.R920.pool);
 	  break;
 
 	case FFESTD_stmtidR921_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R921 (stmt->u.R921.params);
 	  malloc_pool_kill (stmt->u.R921.pool);
 	  break;
 
 	case FFESTD_stmtidR923A_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R923A (stmt->u.R923A.params, stmt->u.R923A.by_file);
 	  malloc_pool_kill (stmt->u.R923A.pool);
 	  break;
 
 	case FFESTD_stmtidR923B_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R923B_start (stmt->u.R923B.params);
 	  for (expr = stmt->u.R923B.list; expr != NULL; expr = expr->next)
+	    {
+	      if (okay)
 		ffeste_R923B_item (expr->expr);
+	    }
+	  if (okay)
 	    ffeste_R923B_finish ();
 	  malloc_pool_kill (stmt->u.R923B.pool);
 	  break;
 
 	case FFESTD_stmtidR1001_:
+	  if (okay)
 	    ffeste_R1001 (&stmt->u.R1001.str);
 	  ffests_kill (&stmt->u.R1001.str);
 	  break;
 
 	case FFESTD_stmtidR1103_:
+	  if (okay)
 	    ffeste_R1103 ();
 	  break;
 
 	case FFESTD_stmtidR1112_:
+	  if (okay)
 	    ffeste_R1112 ();
 	  break;
 
 	case FFESTD_stmtidR1212_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R1212 (stmt->u.R1212.expr);
 	  malloc_pool_kill (stmt->u.R1212.pool);
 	  break;
 
 	case FFESTD_stmtidR1221_:
+	  if (okay)
 	    ffeste_R1221 ();
 	  break;
 
 	case FFESTD_stmtidR1225_:
+	  if (okay)
 	    ffeste_R1225 ();
 	  break;
 
 	case FFESTD_stmtidR1226_:
 	  ffestd_subr_line_restore_ (stmt);
 	  if (stmt->u.R1226.entry != NULL)
+	    {
+	      if (okay)
 		ffeste_R1226 (stmt->u.R1226.entry);
+	    }
 	  break;
 
 	case FFESTD_stmtidR1227_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_R1227 (stmt->u.R1227.block, stmt->u.R1227.expr);
 	  malloc_pool_kill (stmt->u.R1227.pool);
 	  break;
@@ -998,18 +1056,28 @@ ffestd_stmt_pass_ ()
 #if FFESTR_VXT
 	case FFESTD_stmtidV018_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_V018_start (stmt->u.V018.params, stmt->u.V018.format);
 	  for (expr = stmt->u.V018.list; expr != NULL; expr = expr->next)
+	    {
+	      if (okay)
 		ffeste_V018_item (expr->expr);
+	    }
+	  if (okay)
 	    ffeste_V018_finish ();
 	  malloc_pool_kill (stmt->u.V018.pool);
 	  break;
 
 	case FFESTD_stmtidV019_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_V019_start (stmt->u.V019.params, stmt->u.V019.format);
 	  for (expr = stmt->u.V019.list; expr != NULL; expr = expr->next)
+	    {
+	      if (okay)
 		ffeste_V019_item (expr->expr);
+	    }
+	  if (okay)
 	    ffeste_V019_finish ();
 	  malloc_pool_kill (stmt->u.V019.pool);
 	  break;
@@ -1017,9 +1085,14 @@ ffestd_stmt_pass_ ()
 
 	case FFESTD_stmtidV020_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_V020_start (stmt->u.V020.params, stmt->u.V020.format);
 	  for (expr = stmt->u.V020.list; expr != NULL; expr = expr->next)
+	    {
+	      if (okay)
 		ffeste_V020_item (expr->expr);
+	    }
+	  if (okay)
 	    ffeste_V020_finish ();
 	  malloc_pool_kill (stmt->u.V020.pool);
 	  break;
@@ -1027,45 +1100,60 @@ ffestd_stmt_pass_ ()
 #if FFESTR_VXT
 	case FFESTD_stmtidV021_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_V021 (stmt->u.V021.params);
 	  malloc_pool_kill (stmt->u.V021.pool);
 	  break;
 
 	case FFESTD_stmtidV023_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_V023_start (stmt->u.V023.params);
 	  for (expr = stmt->u.V023.list; expr != NULL; expr = expr->next)
+	    {
+	      if (okay)
 		ffeste_V023_item (expr->expr);
+	    }
+	  if (okay)
 	    ffeste_V023_finish ();
 	  malloc_pool_kill (stmt->u.V023.pool);
 	  break;
 
 	case FFESTD_stmtidV024_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_V024_start (stmt->u.V024.params);
 	  for (expr = stmt->u.V024.list; expr != NULL; expr = expr->next)
+	    {
+	      if (okay)
 		ffeste_V024_item (expr->expr);
+	    }
+	  if (okay)
 	    ffeste_V024_finish ();
 	  malloc_pool_kill (stmt->u.V024.pool);
 	  break;
 
 	case FFESTD_stmtidV025start_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_V025_start ();
 	  break;
 
 	case FFESTD_stmtidV025item_:
+	  if (okay)
 	    ffeste_V025_item (stmt->u.V025item.u, stmt->u.V025item.m,
 			      stmt->u.V025item.n, stmt->u.V025item.asv);
 	  break;
 
 	case FFESTD_stmtidV025finish_:
+	  if (okay)
 	    ffeste_V025_finish ();
 	  malloc_pool_kill (stmt->u.V025finish.pool);
 	  break;
 
 	case FFESTD_stmtidV026_:
 	  ffestd_subr_line_restore_ (stmt);
+	  if (okay)
 	    ffeste_V026 (stmt->u.V026.params);
 	  malloc_pool_kill (stmt->u.V026.pool);
 	  break;
@@ -3516,10 +3604,23 @@ ffestd_R842 (ffebld expr)
     stmt = ffestd_stmt_new_ (FFESTD_stmtidR842_);
     ffestd_stmt_append_ (stmt);
     ffestd_subr_line_save_ (stmt);
+    if (ffesta_outpooldisp () == FFESTA_pooldispPRESERVE)
+      {
+	/* This is a "spurious" (automatically-generated) STOP
+	   that follows a previous STOP or other statement.
+	   Make sure we don't have an expression in the pool,
+	   and then mark that the pool has already been killed.  */
+	assert (expr == NULL);
+	stmt->u.R842.pool = NULL;
+	stmt->u.R842.expr = NULL;
+      }
+    else
+      {
 	stmt->u.R842.pool = ffesta_output_pool;
 	stmt->u.R842.expr = expr;
 	ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
       }
+  }
 #endif
 
   if (ffestd_block_level_ == 0)

libf2c/ChangeLog

@@ -5,6 +5,10 @@ Tue Dec 23 22:56:01 1997  Craig Burley  <burley@gnu.org>
 	handler on 64-bit systems like Alphas.
 	* f2cext.c (signal_): Changed accordingly.
 
+Wed Oct 29 01:01:04 1997  Mumit Khan  <khan@brahma.xraylith.wisc.edu>
+
+	* configure.in: Set CC to CC_FOR_TARGET when cross-compiling.
+
 Tue Sep 30 00:41:39 1997  Craig Burley  <burley@gnu.ai.mit.edu>
 
 	Do a better job of printing the offending FORMAT string

libf2c/configure.in

@@ -23,15 +23,20 @@ AC_INIT(libF77/Version.c)
 
 AC_REVISION(1.10)
 
-dnl Checks for programs.
-# For g77 we'll set CC to point at the built gcc, but this will get it into
-# the makefiles
-AC_PROG_CC
 dnl AC_C_CROSS
 dnl Gives misleading `(cached)' message from the check.
 if test "$CROSS";then
+  if test "$CC_FOR_TARGET"; then
+    CC="$CC_FOR_TARGET"
+  else
+    CC="../../xgcc -B../../xgcc/"
+  fi
   ac_cv_c_cross=yes
 else
+  dnl Checks for programs.
+  # For g77 we'll set CC to point at the built gcc, but this will get it into
+  # the makefiles
+  AC_PROG_CC
   ac_cv_c_cross=no
 fi
 

libf2c/libI77/close.c

@@ -75,9 +75,12 @@ f_exit(void)
 	static cllist xx;
 	if (! (f__init & 1))
 		return;		/* Not initialized, so no open units. */
-	/* no more I/O to be done. If this is not done, then if the
-	   program is interrupted during I/O, f_clos thinks, incorrectly,
-	   that there is an I/O recursion. */
+	/* I/O no longer in progress.  If, during an I/O operation (such
+	   as waiting for the user to enter a line), there is an
+	   interrupt (such as ^C to stop the program on a UNIX system),
+	   f_exit() is called, but there is no longer any I/O in
+	   progress.  Without turning off this flag, f_clos() would
+	   think that there is an I/O recursion in this circumstance. */
 	f__init &= ~2;
 	if (!xx.cerr) {
 		xx.cerr=1;