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.
* 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
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
resume_momentary (yes);
- store_parm_decls (main_program ? 1 : 0);
+ if (TREE_CODE (current_function_decl) != ERROR_MARK)
+ store_parm_decls (main_program ? 1 : 0);
ffecom_start_compstmt_ ();
register tree fndecl = current_function_decl;
assert (fndecl != NULL_TREE);
- if (nested)
- assert (DECL_CONTEXT (fndecl) != NULL_TREE);
- else
- assert (DECL_CONTEXT (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);
- BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl;
- /* Must mark the RESULT_DECL as being in this function. */
+ if (TREE_CODE (fndecl) != ERROR_MARK)
+ {
+ BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl;
+
+ /* Must mark the RESULT_DECL as being in this function. */
- DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl;
+ DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl;
- /* Obey `register' declarations if `setjmp' is called in this fn. */
- /* Generate rtl for function exit. */
- expand_function_end (input_filename, lineno, 0);
+ /* Obey `register' declarations if `setjmp' is called in this fn. */
+ /* Generate rtl for function exit. */
+ expand_function_end (input_filename, lineno, 0);
- /* So we can tell if jump_optimize sets it to 1. */
- can_reach_end = 0;
+ /* So we can tell if jump_optimize sets it to 1. */
+ can_reach_end = 0;
- /* Run the optimizers and output the assembler code for this function. */
- rest_of_compilation (fndecl);
+ /* 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
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
switch (v)
{
default:
+ if (TREE_CODE (decl) == ERROR_MARK)
+ return "erroneous code";
return IDENTIFIER_POINTER (DECL_NAME (decl));
}
}
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
{
- s = ffecom_primary_entry_;
- switch (ffesymbol_kind (s))
+ g = ffesymbol_global (ffecom_primary_entry_);
+ if (ffecom_nested_entry_ == NULL)
{
- case FFEINFO_kindFUNCTION:
- kind = "function";
- break;
+ s = ffecom_primary_entry_;
+ switch (ffesymbol_kind (s))
+ {
+ case FFEINFO_kindFUNCTION:
+ kind = "function";
+ break;
- case FFEINFO_kindSUBROUTINE:
- kind = "subroutine";
- break;
+ case FFEINFO_kindSUBROUTINE:
+ kind = "subroutine";
+ break;
- case FFEINFO_kindPROGRAM:
- kind = "program";
- break;
+ case FFEINFO_kindPROGRAM:
+ kind = "program";
+ break;
- case FFEINFO_kindBLOCKDATA:
- kind = "block-data";
- break;
+ case FFEINFO_kindBLOCKDATA:
+ kind = "block-data";
+ break;
- default:
- kind = ffeinfo_kind_message (ffesymbol_kind (s));
- break;
+ default:
+ kind = ffeinfo_kind_message (ffesymbol_kind (s));
+ break;
+ }
+ }
+ else
+ {
+ s = ffecom_nested_entry_;
+ kind = "statement function";
}
- }
- else
- {
- s = ffecom_nested_entry_;
- kind = "statement function";
}
- if (last_s != s)
+ if ((last_g != g) || (last_s != s))
{
if (file)
fprintf (stderr, "%s: ", file);
fprintf (stderr, "In %s `%s':\n", kind, name);
}
+ last_g = g;
last_s = s;
}
}
assert (current_function_decl == NULL_TREE);
}
- decl1 = build_decl (FUNCTION_DECL,
- name,
- type);
- TREE_PUBLIC (decl1) = public ? 1 : 0;
- if (nested)
- DECL_INLINE (decl1) = 1;
- TREE_STATIC (decl1) = 1;
- DECL_EXTERNAL (decl1) = 0;
+ if (TREE_CODE (type) == ERROR_MARK)
+ decl1 = current_function_decl = error_mark_node;
+ else
+ {
+ decl1 = build_decl (FUNCTION_DECL,
+ name,
+ type);
+ TREE_PUBLIC (decl1) = public ? 1 : 0;
+ if (nested)
+ DECL_INLINE (decl1) = 1;
+ TREE_STATIC (decl1) = 1;
+ DECL_EXTERNAL (decl1) = 0;
- announce_function (decl1);
+ announce_function (decl1);
- /* Make the init_value nonzero so pushdecl knows this is not tentative.
- error_mark_node is replaced below (in poplevel) with the BLOCK. */
- DECL_INITIAL (decl1) = error_mark_node;
+ /* Make the init_value nonzero so pushdecl knows this is not tentative.
+ error_mark_node is replaced below (in poplevel) with the BLOCK. */
+ DECL_INITIAL (decl1) = error_mark_node;
- /* Record the decl so that the function name is defined. If we already have
- a decl for this name, and it is a FUNCTION_DECL, use the old decl. */
+ /* Record the decl so that the function name is defined. If we already have
+ a decl for this name, and it is a FUNCTION_DECL, use the old decl. */
+
+ current_function_decl = pushdecl (decl1);
+ }
- current_function_decl = pushdecl (decl1);
if (!nested)
ffecom_outer_function_decl_ = current_function_decl;
pushlevel (0);
- make_function_rtl (current_function_decl);
+ 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);
+ 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;
-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
@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))}.
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.
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
@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
@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
@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
@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
@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
@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}
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.
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
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
@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
@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
@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}}.
@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@.
@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
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
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
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
@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}.
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:
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.
@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.
=======
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
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
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.
These problems can occur on most or all systems.
@menu
-* GNU C Required:: Why even ANSI C is not enough.
+* GNU C Required:: Why even ANSI C is not enough.
* Patching GNU CC Necessary:: Why @code{gcc} must be patched first.
* Building GNU CC Necessary:: Why you can't build @emph{just} Fortran.
-* Missing strtoul:: If linking @code{f771} fails due to an
+* Missing strtoul:: If linking @code{f771} fails due to an
unresolved reference to @code{strtoul}.
* Cleanup Kills Stage Directories:: A minor nit for @code{g77} developers.
* Missing gperf?:: When building requires @code{gperf}.
(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
},
};
}
}
-/* 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)
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. */
{
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;
{
case FFESTD_stmtidENDDOLOOP_:
ffestd_subr_line_restore_ (stmt);
- ffeste_do (stmt->u.enddoloop.block);
+ if (okay)
+ ffeste_do (stmt->u.enddoloop.block);
ffestw_kill (stmt->u.enddoloop.block);
break;
case FFESTD_stmtidENDLOGIF_:
ffestd_subr_line_restore_ (stmt);
- ffeste_end_R807 ();
+ if (okay)
+ ffeste_end_R807 ();
break;
case FFESTD_stmtidEXECLABEL_:
- ffeste_labeldef_branch (stmt->u.execlabel.label);
+ if (okay)
+ ffeste_labeldef_branch (stmt->u.execlabel.label);
break;
case FFESTD_stmtidFORMATLABEL_:
- ffeste_labeldef_format (stmt->u.formatlabel.label);
+ if (okay)
+ ffeste_labeldef_format (stmt->u.formatlabel.label);
break;
case FFESTD_stmtidR737A_:
ffestd_subr_line_restore_ (stmt);
- ffeste_R737A (stmt->u.R737A.dest, stmt->u.R737A.source);
+ 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);
- ffeste_R803 (stmt->u.R803.expr);
+ if (okay)
+ ffeste_R803 (stmt->u.R803.expr);
malloc_pool_kill (stmt->u.R803.pool);
break;
case FFESTD_stmtidR804_:
ffestd_subr_line_restore_ (stmt);
- ffeste_R804 (stmt->u.R804.expr);
+ if (okay)
+ ffeste_R804 (stmt->u.R804.expr);
malloc_pool_kill (stmt->u.R804.pool);
break;
case FFESTD_stmtidR805_:
ffestd_subr_line_restore_ (stmt);
- ffeste_R805 ();
+ if (okay)
+ ffeste_R805 ();
break;
case FFESTD_stmtidR806_:
ffestd_subr_line_restore_ (stmt);
- ffeste_R806 ();
+ if (okay)
+ ffeste_R806 ();
break;
case FFESTD_stmtidR807_:
ffestd_subr_line_restore_ (stmt);
- ffeste_R807 (stmt->u.R807.expr);
+ if (okay)
+ ffeste_R807 (stmt->u.R807.expr);
malloc_pool_kill (stmt->u.R807.pool);
break;
case FFESTD_stmtidR809_:
ffestd_subr_line_restore_ (stmt);
- ffeste_R809 (stmt->u.R809.block, stmt->u.R809.expr);
+ 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);
- ffeste_R810 (stmt->u.R810.block, stmt->u.R810.casenum);
+ 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);
- ffeste_R811 (stmt->u.R811.block);
+ if (okay)
+ ffeste_R811 (stmt->u.R811.block);
malloc_pool_kill (ffestw_select (stmt->u.R811.block)->pool);
ffestw_kill (stmt->u.R811.block);
break;
case FFESTD_stmtidR819A_:
ffestd_subr_line_restore_ (stmt);
- ffeste_R819A (stmt->u.R819A.block, stmt->u.R819A.label,
- stmt->u.R819A.var,
- stmt->u.R819A.start, stmt->u.R819A.start_token,
- stmt->u.R819A.end, stmt->u.R819A.end_token,
- stmt->u.R819A.incr, stmt->u.R819A.incr_token);
+ 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,
+ stmt->u.R819A.end, stmt->u.R819A.end_token,
+ stmt->u.R819A.incr, stmt->u.R819A.incr_token);
ffelex_token_kill (stmt->u.R819A.start_token);
ffelex_token_kill (stmt->u.R819A.end_token);
if (stmt->u.R819A.incr_token != NULL)
case FFESTD_stmtidR819B_:
ffestd_subr_line_restore_ (stmt);
- ffeste_R819B (stmt->u.R819B.block, stmt->u.R819B.label,
- stmt->u.R819B.expr);
+ if (okay)
+ ffeste_R819B (stmt->u.R819B.block, stmt->u.R819B.label,
+ stmt->u.R819B.expr);
malloc_pool_kill (stmt->u.R819B.pool);
break;
case FFESTD_stmtidR825_:
ffestd_subr_line_restore_ (stmt);
- ffeste_R825 ();
+ if (okay)
+ ffeste_R825 ();
break;
case FFESTD_stmtidR834_:
ffestd_subr_line_restore_ (stmt);
- ffeste_R834 (stmt->u.R834.block);
+ if (okay)
+ ffeste_R834 (stmt->u.R834.block);
break;
case FFESTD_stmtidR835_:
ffestd_subr_line_restore_ (stmt);
- ffeste_R835 (stmt->u.R835.block);
+ if (okay)
+ ffeste_R835 (stmt->u.R835.block);
break;
case FFESTD_stmtidR836_:
ffestd_subr_line_restore_ (stmt);
- ffeste_R836 (stmt->u.R836.label);
+ if (okay)
+ ffeste_R836 (stmt->u.R836.label);
break;
case FFESTD_stmtidR837_:
ffestd_subr_line_restore_ (stmt);
- ffeste_R837 (stmt->u.R837.labels, stmt->u.R837.count,
- stmt->u.R837.expr);
+ if (okay)
+ ffeste_R837 (stmt->u.R837.labels, stmt->u.R837.count,
+ stmt->u.R837.expr);
malloc_pool_kill (stmt->u.R837.pool);
break;
case FFESTD_stmtidR838_:
ffestd_subr_line_restore_ (stmt);
- ffeste_R838 (stmt->u.R838.label, stmt->u.R838.target);
+ 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);
- ffeste_R839 (stmt->u.R839.target);
+ if (okay)
+ ffeste_R839 (stmt->u.R839.target);
malloc_pool_kill (stmt->u.R839.pool);
break;
case FFESTD_stmtidR840_:
ffestd_subr_line_restore_ (stmt);
- ffeste_R840 (stmt->u.R840.expr, stmt->u.R840.neg, stmt->u.R840.zero,
- stmt->u.R840.pos);
+ 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);
break;
case FFESTD_stmtidR841_:
ffestd_subr_line_restore_ (stmt);
- ffeste_R841 ();
+ if (okay)
+ ffeste_R841 ();
break;
case FFESTD_stmtidR842_:
ffestd_subr_line_restore_ (stmt);
- ffeste_R842 (stmt->u.R842.expr);
- malloc_pool_kill (stmt->u.R842.pool);
+ 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);
- ffeste_R843 (stmt->u.R843.expr);
+ if (okay)
+ ffeste_R843 (stmt->u.R843.expr);
malloc_pool_kill (stmt->u.R843.pool);
break;
case FFESTD_stmtidR904_:
ffestd_subr_line_restore_ (stmt);
- ffeste_R904 (stmt->u.R904.params);
+ if (okay)
+ ffeste_R904 (stmt->u.R904.params);
malloc_pool_kill (stmt->u.R904.pool);
break;
case FFESTD_stmtidR907_:
ffestd_subr_line_restore_ (stmt);
- ffeste_R907 (stmt->u.R907.params);
+ if (okay)
+ ffeste_R907 (stmt->u.R907.params);
malloc_pool_kill (stmt->u.R907.pool);
break;
case FFESTD_stmtidR909_:
ffestd_subr_line_restore_ (stmt);
- 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);
+ 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)
{
- ffeste_R909_item (expr->expr, expr->token);
+ if (okay)
+ ffeste_R909_item (expr->expr, expr->token);
ffelex_token_kill (expr->token);
}
- ffeste_R909_finish ();
+ if (okay)
+ ffeste_R909_finish ();
malloc_pool_kill (stmt->u.R909.pool);
break;
case FFESTD_stmtidR910_:
ffestd_subr_line_restore_ (stmt);
- ffeste_R910_start (stmt->u.R910.params, stmt->u.R910.unit,
- stmt->u.R910.format, stmt->u.R910.rec);
+ 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)
{
- ffeste_R910_item (expr->expr, expr->token);
+ if (okay)
+ ffeste_R910_item (expr->expr, expr->token);
ffelex_token_kill (expr->token);
}
- ffeste_R910_finish ();
+ if (okay)
+ ffeste_R910_finish ();
malloc_pool_kill (stmt->u.R910.pool);
break;
case FFESTD_stmtidR911_:
ffestd_subr_line_restore_ (stmt);
- ffeste_R911_start (stmt->u.R911.params, stmt->u.R911.format);
+ if (okay)
+ ffeste_R911_start (stmt->u.R911.params, stmt->u.R911.format);
for (expr = stmt->u.R911.list; expr != NULL; expr = expr->next)
{
- ffeste_R911_item (expr->expr, expr->token);
+ if (okay)
+ ffeste_R911_item (expr->expr, expr->token);
ffelex_token_kill (expr->token);
}
- ffeste_R911_finish ();
+ if (okay)
+ ffeste_R911_finish ();
malloc_pool_kill (stmt->u.R911.pool);
break;
case FFESTD_stmtidR919_:
ffestd_subr_line_restore_ (stmt);
- ffeste_R919 (stmt->u.R919.params);
+ if (okay)
+ ffeste_R919 (stmt->u.R919.params);
malloc_pool_kill (stmt->u.R919.pool);
break;
case FFESTD_stmtidR920_:
ffestd_subr_line_restore_ (stmt);
- ffeste_R920 (stmt->u.R920.params);
+ if (okay)
+ ffeste_R920 (stmt->u.R920.params);
malloc_pool_kill (stmt->u.R920.pool);
break;
case FFESTD_stmtidR921_:
ffestd_subr_line_restore_ (stmt);
- ffeste_R921 (stmt->u.R921.params);
+ if (okay)
+ ffeste_R921 (stmt->u.R921.params);
malloc_pool_kill (stmt->u.R921.pool);
break;
case FFESTD_stmtidR923A_:
ffestd_subr_line_restore_ (stmt);
- ffeste_R923A (stmt->u.R923A.params, stmt->u.R923A.by_file);
+ 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);
- ffeste_R923B_start (stmt->u.R923B.params);
+ if (okay)
+ ffeste_R923B_start (stmt->u.R923B.params);
for (expr = stmt->u.R923B.list; expr != NULL; expr = expr->next)
- ffeste_R923B_item (expr->expr);
- ffeste_R923B_finish ();
+ {
+ if (okay)
+ ffeste_R923B_item (expr->expr);
+ }
+ if (okay)
+ ffeste_R923B_finish ();
malloc_pool_kill (stmt->u.R923B.pool);
break;
case FFESTD_stmtidR1001_:
- ffeste_R1001 (&stmt->u.R1001.str);
+ if (okay)
+ ffeste_R1001 (&stmt->u.R1001.str);
ffests_kill (&stmt->u.R1001.str);
break;
case FFESTD_stmtidR1103_:
- ffeste_R1103 ();
+ if (okay)
+ ffeste_R1103 ();
break;
case FFESTD_stmtidR1112_:
- ffeste_R1112 ();
+ if (okay)
+ ffeste_R1112 ();
break;
case FFESTD_stmtidR1212_:
ffestd_subr_line_restore_ (stmt);
- ffeste_R1212 (stmt->u.R1212.expr);
+ if (okay)
+ ffeste_R1212 (stmt->u.R1212.expr);
malloc_pool_kill (stmt->u.R1212.pool);
break;
case FFESTD_stmtidR1221_:
- ffeste_R1221 ();
+ if (okay)
+ ffeste_R1221 ();
break;
case FFESTD_stmtidR1225_:
- ffeste_R1225 ();
+ if (okay)
+ ffeste_R1225 ();
break;
case FFESTD_stmtidR1226_:
ffestd_subr_line_restore_ (stmt);
if (stmt->u.R1226.entry != NULL)
- ffeste_R1226 (stmt->u.R1226.entry);
+ {
+ if (okay)
+ ffeste_R1226 (stmt->u.R1226.entry);
+ }
break;
case FFESTD_stmtidR1227_:
ffestd_subr_line_restore_ (stmt);
- ffeste_R1227 (stmt->u.R1227.block, stmt->u.R1227.expr);
+ if (okay)
+ ffeste_R1227 (stmt->u.R1227.block, stmt->u.R1227.expr);
malloc_pool_kill (stmt->u.R1227.pool);
break;
#if FFESTR_VXT
case FFESTD_stmtidV018_:
ffestd_subr_line_restore_ (stmt);
- ffeste_V018_start (stmt->u.V018.params, stmt->u.V018.format);
+ if (okay)
+ ffeste_V018_start (stmt->u.V018.params, stmt->u.V018.format);
for (expr = stmt->u.V018.list; expr != NULL; expr = expr->next)
- ffeste_V018_item (expr->expr);
- ffeste_V018_finish ();
+ {
+ 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);
- ffeste_V019_start (stmt->u.V019.params, stmt->u.V019.format);
+ if (okay)
+ ffeste_V019_start (stmt->u.V019.params, stmt->u.V019.format);
for (expr = stmt->u.V019.list; expr != NULL; expr = expr->next)
- ffeste_V019_item (expr->expr);
- ffeste_V019_finish ();
+ {
+ if (okay)
+ ffeste_V019_item (expr->expr);
+ }
+ if (okay)
+ ffeste_V019_finish ();
malloc_pool_kill (stmt->u.V019.pool);
break;
#endif
case FFESTD_stmtidV020_:
ffestd_subr_line_restore_ (stmt);
- ffeste_V020_start (stmt->u.V020.params, stmt->u.V020.format);
+ if (okay)
+ ffeste_V020_start (stmt->u.V020.params, stmt->u.V020.format);
for (expr = stmt->u.V020.list; expr != NULL; expr = expr->next)
- ffeste_V020_item (expr->expr);
- ffeste_V020_finish ();
+ {
+ if (okay)
+ ffeste_V020_item (expr->expr);
+ }
+ if (okay)
+ ffeste_V020_finish ();
malloc_pool_kill (stmt->u.V020.pool);
break;
#if FFESTR_VXT
case FFESTD_stmtidV021_:
ffestd_subr_line_restore_ (stmt);
- ffeste_V021 (stmt->u.V021.params);
+ if (okay)
+ ffeste_V021 (stmt->u.V021.params);
malloc_pool_kill (stmt->u.V021.pool);
break;
case FFESTD_stmtidV023_:
ffestd_subr_line_restore_ (stmt);
- ffeste_V023_start (stmt->u.V023.params);
+ if (okay)
+ ffeste_V023_start (stmt->u.V023.params);
for (expr = stmt->u.V023.list; expr != NULL; expr = expr->next)
- ffeste_V023_item (expr->expr);
- ffeste_V023_finish ();
+ {
+ 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);
- ffeste_V024_start (stmt->u.V024.params);
+ if (okay)
+ ffeste_V024_start (stmt->u.V024.params);
for (expr = stmt->u.V024.list; expr != NULL; expr = expr->next)
- ffeste_V024_item (expr->expr);
- ffeste_V024_finish ();
+ {
+ 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);
- ffeste_V025_start ();
+ if (okay)
+ ffeste_V025_start ();
break;
case FFESTD_stmtidV025item_:
- ffeste_V025_item (stmt->u.V025item.u, stmt->u.V025item.m,
- stmt->u.V025item.n, stmt->u.V025item.asv);
+ 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_:
- ffeste_V025_finish ();
+ if (okay)
+ ffeste_V025_finish ();
malloc_pool_kill (stmt->u.V025finish.pool);
break;
case FFESTD_stmtidV026_:
ffestd_subr_line_restore_ (stmt);
- ffeste_V026 (stmt->u.V026.params);
+ if (okay)
+ ffeste_V026 (stmt->u.V026.params);
malloc_pool_kill (stmt->u.V026.pool);
break;
#endif
stmt = ffestd_stmt_new_ (FFESTD_stmtidR842_);
ffestd_stmt_append_ (stmt);
ffestd_subr_line_save_ (stmt);
- stmt->u.R842.pool = ffesta_output_pool;
- stmt->u.R842.expr = expr;
- ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ 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
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
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
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;
projects / gcc.git / commitdiff