summaryrefslogtreecommitdiff
path: root/gcc/f/stb.c
diff options
context:
space:
mode:
authorlaw <law@138bc75d-0d04-0410-961f-82ee72b054a4>1997-08-12 07:47:32 +0000
committerlaw <law@138bc75d-0d04-0410-961f-82ee72b054a4>1997-08-12 07:47:32 +0000
commitb2f877e9db26ec43ff364a9ed1b43d2012023222 (patch)
tree9338aae2651126a7f5a07aba373f5643beb8dfde /gcc/f/stb.c
parenta66ed8d6cf7db67b6d94735f61a57bd2ac583bea (diff)
downloadgcc-b2f877e9db26ec43ff364a9ed1b43d2012023222.tar.gz
Initial revision
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@14772 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/f/stb.c')
-rw-r--r--gcc/f/stb.c25192
1 files changed, 25192 insertions, 0 deletions
diff --git a/gcc/f/stb.c b/gcc/f/stb.c
new file mode 100644
index 00000000000..90ecc5f8f47
--- /dev/null
+++ b/gcc/f/stb.c
@@ -0,0 +1,25192 @@
+/* stb.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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:
+ st.c
+
+ Description:
+ Parses the proper form for statements, builds up expression trees for
+ them, but does not actually implement them. Uses ffebad (primarily via
+ ffesta_ffebad_start) to indicate errors in form. In many cases, an invalid
+ statement form indicates another possible statement needs to be looked at
+ by ffest. In a few cases, a valid statement form might not completely
+ determine the nature of the statement, as in REALFUNCTIONA(B), which is
+ a valid form for either the first statement of a function named A taking
+ an argument named B or for the declaration of a real array named FUNCTIONA
+ with an adjustable size of B. A similar (though somewhat easier) choice
+ must be made for the statement-function-def vs. assignment forms, as in
+ the case of FOO(A) = A+2.0.
+
+ A given parser consists of one or more state handlers, the first of which
+ is the initial state, and the last of which (for any given input) returns
+ control to a final state handler (ffesta_zero or ffesta_two, explained
+ below). The functions handling the states for a given parser usually have
+ the same names, differing only in the final number, as in ffestb_foo_
+ (handles the initial state), ffestb_foo_1_, ffestb_foo_2_ (handle
+ subsequent states), although liberties sometimes are taken with the "foo"
+ part either when keywords are clarified into given statements or are
+ transferred into other possible areas. (For example, the type-name
+ states can hop over to _dummy_ functions when the FUNCTION or RECURSIVE
+ keywords are seen, though this kind of thing is kept to a minimum.) Only
+ the names without numbers are exported to the rest of ffest; the others
+ are local (static).
+
+ Each initial state is provided with the first token in ffesta_tokens[0],
+ which will be killed upon return to the final state (ffesta_zero or
+ ffelex_swallow_tokens passed through to ffesta_zero), so while it may
+ be changed to another token, a valid token must be left there to be
+ killed. Also, a "convenient" array of tokens are left in
+ ffesta_tokens[1..FFESTA_tokensMAX]. The initial state of this set of
+ elements is undefined, thus, if tokens are stored here, they must be
+ killed before returning to the final state. Any parser may also use
+ cross-state local variables by sticking a structure containing storage
+ for those variables in the local union ffestb_local_ (unless the union
+ goes on strike). Furthermore, parsers that handle more than one first or
+ second tokens (like _varlist_, which handles EXTERNAL, INTENT, INTRINSIC,
+ OPTIONAL,
+ PUBLIC, or PRIVATE, and _endxyz_, which handles ENDBLOCK, ENDBLOCKDATA,
+ ENDDO, ENDIF, and so on) may expect arguments from ffest in the
+ ffest-wide union ffest_args_, the substructure specific to the parser.
+
+ A parser's responsibility is: to call either ffesta_confirmed or
+ ffest_ffebad_start before returning to the final state; to be the only
+ parser that can possibly call ffesta_confirmed for a given statement;
+ to call ffest_ffebad_start immediately upon recognizing a bad token
+ (specifically one that another statement parser might confirm upon);
+ to call ffestc functions only after calling ffesta_confirmed and only
+ when ffesta_is_inhibited returns FALSE; and to call ffesta_is_inhibited
+ only after calling ffesta_confirmed. Confirm as early as reasonably
+ possible, even when only one ffestc function is called for the statement
+ later on, because early confirmation can enhance the error-reporting
+ capabilities if a subsequent error is detected and this parser isn't
+ the first possibility for the statement.
+
+ To assist the parser, functions like ffesta_ffebad_1t and _1p_ have
+ been provided to make use of ffest_ffebad_start fairly easy.
+
+ Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include <ctype.h>
+#include "stb.h"
+#include "bad.h"
+#include "expr.h"
+#include "lex.h"
+#include "malloc.h"
+#include "src.h"
+#include "sta.h"
+#include "stc.h"
+#include "stp.h"
+#include "str.h"
+
+/* Externals defined here. */
+
+struct _ffestb_args_ ffestb_args;
+
+/* Simple definitions and enumerations. */
+
+#define FFESTB_KILL_EASY_ 1 /* 1 for only one _subr_kill_xyz_ fn. */
+
+/* Internal typedefs. */
+
+union ffestb_subrargs_u_
+ {
+ struct
+ {
+ ffesttTokenList labels; /* Input arg, must not be NULL. */
+ ffelexHandler handler; /* Input arg, call me when done. */
+ bool ok; /* Output arg, TRUE if list ended in
+ CLOSE_PAREN. */
+ }
+ label_list;
+ struct
+ {
+ ffesttDimList dims; /* Input arg, must not be NULL. */
+ ffelexHandler handler; /* Input arg, call me when done. */
+ mallocPool pool; /* Pool to allocate into. */
+ bool ok; /* Output arg, TRUE if list ended in
+ CLOSE_PAREN. */
+ ffeexprContext ctx; /* DIMLIST or DIMLISTCOMMON. */
+#ifdef FFECOM_dimensionsMAX
+ int ndims; /* For backends that really can't have
+ infinite dims. */
+#endif
+ }
+ dim_list;
+ struct
+ {
+ ffesttTokenList args; /* Input arg, must not be NULL. */
+ ffelexHandler handler; /* Input arg, call me when done. */
+ ffelexToken close_paren;/* Output arg if ok, CLOSE_PAREN token. */
+ bool is_subr; /* Input arg, TRUE if list in subr-def
+ context. */
+ bool ok; /* Output arg, TRUE if list ended in
+ CLOSE_PAREN. */
+ bool names; /* Do ffelex_set_names(TRUE) before return. */
+ }
+ name_list;
+ };
+
+union ffestb_local_u_
+ {
+ struct
+ {
+ ffebld expr;
+ }
+ call_stmt;
+ struct
+ {
+ ffebld expr;
+ }
+ go_to;
+ struct
+ {
+ ffebld dest;
+ bool vxtparam; /* If assignment might really be VXT
+ PARAMETER stmt. */
+ }
+ let;
+ struct
+ {
+ ffebld expr;
+ }
+ if_stmt;
+ struct
+ {
+ ffebld expr;
+ }
+ else_stmt;
+ struct
+ {
+ ffebld expr;
+ }
+ dowhile;
+ struct
+ {
+ ffebld var;
+ ffebld start;
+ ffebld end;
+ }
+ do_stmt;
+ struct
+ {
+ bool is_cblock;
+ }
+ R522;
+ struct
+ {
+ ffebld expr;
+ bool started;
+ }
+ parameter;
+ struct
+ {
+ ffesttExprList exprs;
+ bool started;
+ }
+ equivalence;
+ struct
+ {
+ ffebld expr;
+ bool started;
+ }
+ data;
+ struct
+ {
+ ffestrOther kw;
+ }
+ varlist;
+#if FFESTR_F90
+ struct
+ {
+ ffestrOther kw;
+ }
+ type;
+#endif
+ struct
+ {
+ ffelexHandler next;
+ }
+ construct;
+ struct
+ {
+ ffesttFormatList f;
+ ffestpFormatType current; /* What we're currently working on. */
+ ffelexToken t; /* Token of what we're currently working on. */
+ ffesttFormatValue pre;
+ ffesttFormatValue post;
+ ffesttFormatValue dot;
+ ffesttFormatValue exp;
+ bool sign; /* _3_, pos/neg; elsewhere, signed/unsigned. */
+ bool complained; /* If run-time expr seen in nonexec context. */
+ }
+ format;
+#if FFESTR_F90
+ struct
+ {
+ bool started;
+ }
+ moduleprocedure;
+#endif
+ struct
+ {
+ ffebld expr;
+ }
+ selectcase;
+ struct
+ {
+ ffesttCaseList cases;
+ }
+ case_stmt;
+#if FFESTR_F90
+ struct
+ {
+ ffesttExprList exprs;
+ ffebld expr;
+ }
+ heap;
+#endif
+#if FFESTR_F90
+ struct
+ {
+ ffesttExprList exprs;
+ }
+ R624;
+#endif
+#if FFESTR_F90
+ struct
+ {
+ ffestpDefinedOperator operator;
+ bool assignment; /* TRUE for INTERFACE ASSIGNMENT, FALSE for
+ ...OPERATOR. */
+ bool slash; /* TRUE if OPEN_ARRAY, FALSE if OPEN_PAREN. */
+ }
+ interface;
+#endif
+ struct
+ {
+ bool is_cblock;
+ }
+ V014;
+#if FFESTR_VXT
+ struct
+ {
+ bool started;
+ ffebld u;
+ ffebld m;
+ ffebld n;
+ ffebld asv;
+ }
+ V025;
+#endif
+ struct
+ {
+ ffestpBeruIx ix;
+ bool label;
+ bool left;
+ ffeexprContext context;
+ }
+ beru;
+ struct
+ {
+ ffestpCloseIx ix;
+ bool label;
+ bool left;
+ ffeexprContext context;
+ }
+ close;
+ struct
+ {
+ ffestpDeleteIx ix;
+ bool label;
+ bool left;
+ ffeexprContext context;
+ }
+ delete;
+ struct
+ {
+ ffestpDeleteIx ix;
+ bool label;
+ bool left;
+ ffeexprContext context;
+ }
+ find;
+ struct
+ {
+ ffestpInquireIx ix;
+ bool label;
+ bool left;
+ ffeexprContext context;
+ bool may_be_iolength;
+ }
+ inquire;
+ struct
+ {
+ ffestpOpenIx ix;
+ bool label;
+ bool left;
+ ffeexprContext context;
+ }
+ open;
+ struct
+ {
+ ffestpReadIx ix;
+ bool label;
+ bool left;
+ ffeexprContext context;
+ }
+ read;
+ struct
+ {
+ ffestpRewriteIx ix;
+ bool label;
+ bool left;
+ ffeexprContext context;
+ }
+ rewrite;
+ struct
+ {
+ ffestpWriteIx ix;
+ bool label;
+ bool left;
+ ffeexprContext context;
+ }
+ vxtcode;
+ struct
+ {
+ ffestpWriteIx ix;
+ bool label;
+ bool left;
+ ffeexprContext context;
+ }
+ write;
+#if FFESTR_F90
+ struct
+ {
+ bool started;
+ }
+ structure;
+#endif
+ struct
+ {
+ bool started;
+ }
+ common;
+ struct
+ {
+ bool started;
+ }
+ dimension;
+ struct
+ {
+ bool started;
+ }
+ dimlist;
+ struct
+ {
+ char *badname;
+ ffestrFirst first_kw;
+ bool is_subr;
+ }
+ dummy;
+ struct
+ {
+ ffebld kind; /* Kind type parameter, if any. */
+ ffelexToken kindt; /* Kind type first token, if any. */
+ ffebld len; /* Length type parameter, if any. */
+ ffelexToken lent; /* Length type parameter, if any. */
+ ffelexHandler handler;
+ ffelexToken recursive;
+ ffebld expr;
+ ffesttTokenList toklist;/* For ambiguity resolution. */
+ ffesttImpList imps; /* List of IMPLICIT letters. */
+ ffelexHandler imp_handler; /* Call if paren list wasn't letters. */
+ char *badname;
+ ffestrOther kw; /* INTENT(IN/OUT/INOUT). */
+ ffestpType type;
+ bool parameter; /* If PARAMETER attribute seen (governs =expr
+ context). */
+ bool coloncolon; /* If COLONCOLON seen (allows =expr). */
+ bool aster_after; /* "*" seen after, not before,
+ [RECURSIVE]FUNCTIONxyz. */
+ bool empty; /* Ambig function dummy arg list empty so
+ far? */
+ bool imp_started; /* Started IMPLICIT statement already. */
+ bool imp_seen_comma; /* TRUE if next COMMA within parens means not
+ R541. */
+ }
+ decl;
+ struct
+ {
+ bool started;
+ }
+ vxtparam;
+ }; /* Merge with the one in ffestb later. */
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module. */
+
+static union ffestb_subrargs_u_ ffestb_subrargs_;
+static union ffestb_local_u_ ffestb_local_;
+
+/* Static functions (internal). */
+
+static void ffestb_subr_ambig_to_ents_ (void);
+static ffelexHandler ffestb_subr_ambig_nope_ (ffelexToken t);
+static ffelexHandler ffestb_subr_dimlist_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_subr_dimlist_1_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_subr_dimlist_2_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_subr_name_list_ (ffelexToken t);
+static ffelexHandler ffestb_subr_name_list_1_ (ffelexToken t);
+static void ffestb_subr_R1001_append_p_ (void);
+static ffelexHandler ffestb_decl_kindparam_ (ffelexToken t);
+static ffelexHandler ffestb_decl_kindparam_1_ (ffelexToken t);
+static ffelexHandler ffestb_decl_kindparam_2_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_decl_starkind_ (ffelexToken t);
+static ffelexHandler ffestb_decl_starlen_ (ffelexToken t);
+static ffelexHandler ffestb_decl_starlen_1_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_decl_typeparams_ (ffelexToken t);
+static ffelexHandler ffestb_decl_typeparams_1_ (ffelexToken t);
+static ffelexHandler ffestb_decl_typeparams_2_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_decl_typeparams_3_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+#if FFESTR_F90
+static ffelexHandler ffestb_decl_typetype1_ (ffelexToken t);
+static ffelexHandler ffestb_decl_typetype2_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_subr_label_list_ (ffelexToken t);
+static ffelexHandler ffestb_subr_label_list_1_ (ffelexToken t);
+static ffelexHandler ffestb_do1_ (ffelexToken t);
+static ffelexHandler ffestb_do2_ (ffelexToken t);
+static ffelexHandler ffestb_do3_ (ffelexToken t);
+static ffelexHandler ffestb_do4_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_do5_ (ffelexToken t);
+static ffelexHandler ffestb_do6_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_do7_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_do8_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_do9_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_else1_ (ffelexToken t);
+static ffelexHandler ffestb_else2_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_else3_ (ffelexToken t);
+static ffelexHandler ffestb_else4_ (ffelexToken t);
+static ffelexHandler ffestb_else5_ (ffelexToken t);
+static ffelexHandler ffestb_end1_ (ffelexToken t);
+static ffelexHandler ffestb_end2_ (ffelexToken t);
+static ffelexHandler ffestb_end3_ (ffelexToken t);
+static ffelexHandler ffestb_goto1_ (ffelexToken t);
+static ffelexHandler ffestb_goto2_ (ffelexToken t);
+static ffelexHandler ffestb_goto3_ (ffelexToken t);
+static ffelexHandler ffestb_goto4_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_goto5_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_goto6_ (ffelexToken t);
+static ffelexHandler ffestb_goto7_ (ffelexToken t);
+static ffelexHandler ffestb_halt1_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_if1_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_if2_ (ffelexToken t);
+static ffelexHandler ffestb_if3_ (ffelexToken t);
+static ffelexHandler ffestb_let1_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_let2_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+#if FFESTR_F90
+static ffelexHandler ffestb_type1_ (ffelexToken t);
+static ffelexHandler ffestb_type2_ (ffelexToken t);
+static ffelexHandler ffestb_type3_ (ffelexToken t);
+static ffelexHandler ffestb_type4_ (ffelexToken t);
+#endif
+#if FFESTR_F90
+static ffelexHandler ffestb_varlist1_ (ffelexToken t);
+static ffelexHandler ffestb_varlist2_ (ffelexToken t);
+static ffelexHandler ffestb_varlist3_ (ffelexToken t);
+static ffelexHandler ffestb_varlist4_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_varlist5_ (ffelexToken t);
+static ffelexHandler ffestb_varlist6_ (ffelexToken t);
+#if FFESTR_F90
+static ffelexHandler ffestb_where1_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_where2_ (ffelexToken t);
+static ffelexHandler ffestb_where3_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_R5221_ (ffelexToken t);
+static ffelexHandler ffestb_R5222_ (ffelexToken t);
+static ffelexHandler ffestb_R5223_ (ffelexToken t);
+static ffelexHandler ffestb_R5224_ (ffelexToken t);
+static ffelexHandler ffestb_R5281_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R5282_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R5283_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R5284_ (ffelexToken t);
+static ffelexHandler ffestb_R5371_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R5372_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R5373_ (ffelexToken t);
+static ffelexHandler ffestb_R5421_ (ffelexToken t);
+static ffelexHandler ffestb_R5422_ (ffelexToken t);
+static ffelexHandler ffestb_R5423_ (ffelexToken t);
+static ffelexHandler ffestb_R5424_ (ffelexToken t);
+static ffelexHandler ffestb_R5425_ (ffelexToken t);
+static ffelexHandler ffestb_R5441_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R5442_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R5443_ (ffelexToken t);
+static ffelexHandler ffestb_R5444_ (ffelexToken t);
+static ffelexHandler ffestb_R8341_ (ffelexToken t);
+static ffelexHandler ffestb_R8351_ (ffelexToken t);
+static ffelexHandler ffestb_R8381_ (ffelexToken t);
+static ffelexHandler ffestb_R8382_ (ffelexToken t);
+static ffelexHandler ffestb_R8383_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R8401_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R8402_ (ffelexToken t);
+static ffelexHandler ffestb_R8403_ (ffelexToken t);
+static ffelexHandler ffestb_R8404_ (ffelexToken t);
+static ffelexHandler ffestb_R8405_ (ffelexToken t);
+static ffelexHandler ffestb_R8406_ (ffelexToken t);
+static ffelexHandler ffestb_R8407_ (ffelexToken t);
+static ffelexHandler ffestb_R11021_ (ffelexToken t);
+static ffelexHandler ffestb_R1111_1_ (ffelexToken t);
+static ffelexHandler ffestb_R1111_2_ (ffelexToken t);
+static ffelexHandler ffestb_R12121_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R12271_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_construct1_ (ffelexToken t);
+static ffelexHandler ffestb_construct2_ (ffelexToken t);
+#if FFESTR_F90
+static ffelexHandler ffestb_heap1_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_heap2_ (ffelexToken t);
+static ffelexHandler ffestb_heap3_ (ffelexToken t);
+static ffelexHandler ffestb_heap4_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_heap5_ (ffelexToken t);
+#endif
+#if FFESTR_F90
+static ffelexHandler ffestb_module1_ (ffelexToken t);
+static ffelexHandler ffestb_module2_ (ffelexToken t);
+static ffelexHandler ffestb_module3_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_R8091_ (ffelexToken t);
+static ffelexHandler ffestb_R8092_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R8093_ (ffelexToken t);
+static ffelexHandler ffestb_R8101_ (ffelexToken t);
+static ffelexHandler ffestb_R8102_ (ffelexToken t);
+static ffelexHandler ffestb_R8103_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R8104_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R10011_ (ffelexToken t);
+static ffelexHandler ffestb_R10012_ (ffelexToken t);
+static ffelexHandler ffestb_R10013_ (ffelexToken t);
+static ffelexHandler ffestb_R10014_ (ffelexToken t);
+static ffelexHandler ffestb_R10015_ (ffelexToken t);
+static ffelexHandler ffestb_R10016_ (ffelexToken t);
+static ffelexHandler ffestb_R10017_ (ffelexToken t);
+static ffelexHandler ffestb_R10018_ (ffelexToken t);
+static ffelexHandler ffestb_R10019_ (ffelexToken t);
+static ffelexHandler ffestb_R100110_ (ffelexToken t);
+static ffelexHandler ffestb_R100111_ (ffelexToken t);
+static ffelexHandler ffestb_R100112_ (ffelexToken t);
+static ffelexHandler ffestb_R100113_ (ffelexToken t);
+static ffelexHandler ffestb_R100114_ (ffelexToken t);
+static ffelexHandler ffestb_R100115_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R100116_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R100117_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R100118_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+#if FFESTR_F90
+static ffelexHandler ffestb_R11071_ (ffelexToken t);
+static ffelexHandler ffestb_R11072_ (ffelexToken t);
+static ffelexHandler ffestb_R11073_ (ffelexToken t);
+static ffelexHandler ffestb_R11074_ (ffelexToken t);
+static ffelexHandler ffestb_R11075_ (ffelexToken t);
+static ffelexHandler ffestb_R11076_ (ffelexToken t);
+static ffelexHandler ffestb_R11077_ (ffelexToken t);
+static ffelexHandler ffestb_R11078_ (ffelexToken t);
+static ffelexHandler ffestb_R11079_ (ffelexToken t);
+static ffelexHandler ffestb_R110710_ (ffelexToken t);
+static ffelexHandler ffestb_R110711_ (ffelexToken t);
+static ffelexHandler ffestb_R110712_ (ffelexToken t);
+#endif
+#if FFESTR_F90
+static ffelexHandler ffestb_R12021_ (ffelexToken t);
+static ffelexHandler ffestb_R12022_ (ffelexToken t);
+static ffelexHandler ffestb_R12023_ (ffelexToken t);
+static ffelexHandler ffestb_R12024_ (ffelexToken t);
+static ffelexHandler ffestb_R12025_ (ffelexToken t);
+static ffelexHandler ffestb_R12026_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_S3P41_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0141_ (ffelexToken t);
+static ffelexHandler ffestb_V0142_ (ffelexToken t);
+static ffelexHandler ffestb_V0143_ (ffelexToken t);
+static ffelexHandler ffestb_V0144_ (ffelexToken t);
+#if FFESTR_VXT
+static ffelexHandler ffestb_V0251_ (ffelexToken t);
+static ffelexHandler ffestb_V0252_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0253_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0254_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0255_ (ffelexToken t);
+static ffelexHandler ffestb_V0256_ (ffelexToken t);
+static ffelexHandler ffestb_V0257_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0258_ (ffelexToken t);
+#endif
+#if FFESTB_KILL_EASY_
+static void ffestb_subr_kill_easy_ (ffestpInquireIx max);
+#else
+static void ffestb_subr_kill_accept_ (void);
+static void ffestb_subr_kill_beru_ (void);
+static void ffestb_subr_kill_close_ (void);
+static void ffestb_subr_kill_delete_ (void);
+static void ffestb_subr_kill_find_ (void); /* Not written yet. */
+static void ffestb_subr_kill_inquire_ (void);
+static void ffestb_subr_kill_open_ (void);
+static void ffestb_subr_kill_print_ (void);
+static void ffestb_subr_kill_read_ (void);
+static void ffestb_subr_kill_rewrite_ (void);
+static void ffestb_subr_kill_type_ (void);
+static void ffestb_subr_kill_vxtcode_ (void); /* Not written yet. */
+static void ffestb_subr_kill_write_ (void);
+#endif
+static ffelexHandler ffestb_beru1_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_beru2_ (ffelexToken t);
+static ffelexHandler ffestb_beru3_ (ffelexToken t);
+static ffelexHandler ffestb_beru4_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_beru5_ (ffelexToken t);
+static ffelexHandler ffestb_beru6_ (ffelexToken t);
+static ffelexHandler ffestb_beru7_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_beru8_ (ffelexToken t);
+static ffelexHandler ffestb_beru9_ (ffelexToken t);
+static ffelexHandler ffestb_beru10_ (ffelexToken t);
+#if FFESTR_VXT
+static ffelexHandler ffestb_vxtcode1_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_vxtcode2_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_vxtcode3_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_vxtcode4_ (ffelexToken t);
+static ffelexHandler ffestb_vxtcode5_ (ffelexToken t);
+static ffelexHandler ffestb_vxtcode6_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_vxtcode7_ (ffelexToken t);
+static ffelexHandler ffestb_vxtcode8_ (ffelexToken t);
+static ffelexHandler ffestb_vxtcode9_ (ffelexToken t);
+static ffelexHandler ffestb_vxtcode10_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+#endif
+static ffelexHandler ffestb_R9041_ (ffelexToken t);
+static ffelexHandler ffestb_R9042_ (ffelexToken t);
+static ffelexHandler ffestb_R9043_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9044_ (ffelexToken t);
+static ffelexHandler ffestb_R9045_ (ffelexToken t);
+static ffelexHandler ffestb_R9046_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9047_ (ffelexToken t);
+static ffelexHandler ffestb_R9048_ (ffelexToken t);
+static ffelexHandler ffestb_R9049_ (ffelexToken t);
+static ffelexHandler ffestb_R9071_ (ffelexToken t);
+static ffelexHandler ffestb_R9072_ (ffelexToken t);
+static ffelexHandler ffestb_R9073_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9074_ (ffelexToken t);
+static ffelexHandler ffestb_R9075_ (ffelexToken t);
+static ffelexHandler ffestb_R9076_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9077_ (ffelexToken t);
+static ffelexHandler ffestb_R9078_ (ffelexToken t);
+static ffelexHandler ffestb_R9079_ (ffelexToken t);
+static ffelexHandler ffestb_R9091_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9092_ (ffelexToken t);
+static ffelexHandler ffestb_R9093_ (ffelexToken t);
+static ffelexHandler ffestb_R9094_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9095_ (ffelexToken t);
+static ffelexHandler ffestb_R9096_ (ffelexToken t);
+static ffelexHandler ffestb_R9097_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9098_ (ffelexToken t);
+static ffelexHandler ffestb_R9099_ (ffelexToken t);
+static ffelexHandler ffestb_R90910_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R90911_ (ffelexToken t);
+static ffelexHandler ffestb_R90912_ (ffelexToken t);
+static ffelexHandler ffestb_R90913_ (ffelexToken t);
+static ffelexHandler ffestb_R90914_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R90915_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9101_ (ffelexToken t);
+static ffelexHandler ffestb_R9102_ (ffelexToken t);
+static ffelexHandler ffestb_R9103_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9104_ (ffelexToken t);
+static ffelexHandler ffestb_R9105_ (ffelexToken t);
+static ffelexHandler ffestb_R9106_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9107_ (ffelexToken t);
+static ffelexHandler ffestb_R9108_ (ffelexToken t);
+static ffelexHandler ffestb_R9109_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R91010_ (ffelexToken t);
+static ffelexHandler ffestb_R91011_ (ffelexToken t);
+static ffelexHandler ffestb_R91012_ (ffelexToken t);
+static ffelexHandler ffestb_R91013_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R91014_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9111_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9112_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9231_ (ffelexToken t);
+static ffelexHandler ffestb_R9232_ (ffelexToken t);
+static ffelexHandler ffestb_R9233_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9234_ (ffelexToken t);
+static ffelexHandler ffestb_R9235_ (ffelexToken t);
+static ffelexHandler ffestb_R9236_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9237_ (ffelexToken t);
+static ffelexHandler ffestb_R9238_ (ffelexToken t);
+static ffelexHandler ffestb_R9239_ (ffelexToken t);
+static ffelexHandler ffestb_R92310_ (ffelexToken t);
+static ffelexHandler ffestb_R92311_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+#if FFESTR_VXT
+static ffelexHandler ffestb_V0181_ (ffelexToken t);
+static ffelexHandler ffestb_V0182_ (ffelexToken t);
+static ffelexHandler ffestb_V0183_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0184_ (ffelexToken t);
+static ffelexHandler ffestb_V0185_ (ffelexToken t);
+static ffelexHandler ffestb_V0186_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0187_ (ffelexToken t);
+static ffelexHandler ffestb_V0188_ (ffelexToken t);
+static ffelexHandler ffestb_V0189_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V01810_ (ffelexToken t);
+static ffelexHandler ffestb_V01811_ (ffelexToken t);
+static ffelexHandler ffestb_V01812_ (ffelexToken t);
+static ffelexHandler ffestb_V01813_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0191_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0192_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+#endif
+static ffelexHandler ffestb_V0201_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0202_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+#if FFESTR_VXT
+static ffelexHandler ffestb_V0211_ (ffelexToken t);
+static ffelexHandler ffestb_V0212_ (ffelexToken t);
+static ffelexHandler ffestb_V0213_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0214_ (ffelexToken t);
+static ffelexHandler ffestb_V0215_ (ffelexToken t);
+static ffelexHandler ffestb_V0216_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0217_ (ffelexToken t);
+static ffelexHandler ffestb_V0218_ (ffelexToken t);
+static ffelexHandler ffestb_V0219_ (ffelexToken t);
+static ffelexHandler ffestb_V0261_ (ffelexToken t);
+static ffelexHandler ffestb_V0262_ (ffelexToken t);
+static ffelexHandler ffestb_V0263_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0264_ (ffelexToken t);
+static ffelexHandler ffestb_V0265_ (ffelexToken t);
+static ffelexHandler ffestb_V0266_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0267_ (ffelexToken t);
+static ffelexHandler ffestb_V0268_ (ffelexToken t);
+static ffelexHandler ffestb_V0269_ (ffelexToken t);
+#endif
+#if FFESTR_F90
+static ffelexHandler ffestb_dimlist1_ (ffelexToken t);
+static ffelexHandler ffestb_dimlist2_ (ffelexToken t);
+static ffelexHandler ffestb_dimlist3_ (ffelexToken t);
+static ffelexHandler ffestb_dimlist4_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_dummy1_ (ffelexToken t);
+static ffelexHandler ffestb_dummy2_ (ffelexToken t);
+static ffelexHandler ffestb_R5241_ (ffelexToken t);
+static ffelexHandler ffestb_R5242_ (ffelexToken t);
+static ffelexHandler ffestb_R5243_ (ffelexToken t);
+static ffelexHandler ffestb_R5244_ (ffelexToken t);
+static ffelexHandler ffestb_R5471_ (ffelexToken t);
+static ffelexHandler ffestb_R5472_ (ffelexToken t);
+static ffelexHandler ffestb_R5473_ (ffelexToken t);
+static ffelexHandler ffestb_R5474_ (ffelexToken t);
+static ffelexHandler ffestb_R5475_ (ffelexToken t);
+static ffelexHandler ffestb_R5476_ (ffelexToken t);
+static ffelexHandler ffestb_R5477_ (ffelexToken t);
+#if FFESTR_F90
+static ffelexHandler ffestb_R6241_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R6242_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_R12291_ (ffelexToken t);
+static ffelexHandler ffestb_R12292_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_decl_chartype1_ (ffelexToken t);
+#if FFESTR_F90
+static ffelexHandler ffestb_decl_recursive1_ (ffelexToken t);
+static ffelexHandler ffestb_decl_recursive2_ (ffelexToken t);
+static ffelexHandler ffestb_decl_recursive3_ (ffelexToken t);
+static ffelexHandler ffestb_decl_recursive4_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_decl_attrs_ (ffelexToken t);
+static ffelexHandler ffestb_decl_attrs_1_ (ffelexToken t);
+static ffelexHandler ffestb_decl_attrs_2_ (ffelexToken t);
+#if FFESTR_F90
+static ffelexHandler ffestb_decl_attrs_3_ (ffelexToken t);
+static ffelexHandler ffestb_decl_attrs_4_ (ffelexToken t);
+static ffelexHandler ffestb_decl_attrs_5_ (ffelexToken t);
+static ffelexHandler ffestb_decl_attrs_6_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_decl_attrs_7_ (ffelexToken t);
+static ffelexHandler ffestb_decl_attrsp_ (ffelexToken t);
+static ffelexHandler ffestb_decl_ents_ (ffelexToken t);
+static ffelexHandler ffestb_decl_ents_1_ (ffelexToken t);
+static ffelexHandler ffestb_decl_ents_2_ (ffelexToken t);
+static ffelexHandler ffestb_decl_ents_3_ (ffelexToken t);
+static ffelexHandler ffestb_decl_ents_4_ (ffelexToken t);
+static ffelexHandler ffestb_decl_ents_5_ (ffelexToken t);
+static ffelexHandler ffestb_decl_ents_6_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_decl_ents_7_ (ffelexToken t);
+static ffelexHandler ffestb_decl_ents_8_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_decl_ents_9_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_decl_ents_10_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_decl_ents_11_ (ffelexToken t);
+static ffelexHandler ffestb_decl_entsp_ (ffelexToken t);
+static ffelexHandler ffestb_decl_entsp_1_ (ffelexToken t);
+static ffelexHandler ffestb_decl_entsp_2_ (ffelexToken t);
+static ffelexHandler ffestb_decl_entsp_3_ (ffelexToken t);
+static ffelexHandler ffestb_decl_entsp_4_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_decl_entsp_5_ (ffelexToken t);
+static ffelexHandler ffestb_decl_entsp_6_ (ffelexToken t);
+static ffelexHandler ffestb_decl_entsp_7_ (ffelexToken t);
+static ffelexHandler ffestb_decl_entsp_8_ (ffelexToken t);
+#if FFESTR_F90
+static ffelexHandler ffestb_decl_func_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_decl_funcname_ (ffelexToken t);
+static ffelexHandler ffestb_decl_funcname_1_ (ffelexToken t);
+static ffelexHandler ffestb_decl_funcname_2_ (ffelexToken t);
+static ffelexHandler ffestb_decl_funcname_3_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_decl_funcname_4_ (ffelexToken t);
+static ffelexHandler ffestb_decl_funcname_5_ (ffelexToken t);
+static ffelexHandler ffestb_decl_funcname_6_ (ffelexToken t);
+static ffelexHandler ffestb_decl_funcname_7_ (ffelexToken t);
+static ffelexHandler ffestb_decl_funcname_8_ (ffelexToken t);
+static ffelexHandler ffestb_decl_funcname_9_ (ffelexToken t);
+#if FFESTR_VXT
+static ffelexHandler ffestb_V0031_ (ffelexToken t);
+static ffelexHandler ffestb_V0032_ (ffelexToken t);
+static ffelexHandler ffestb_V0033_ (ffelexToken t);
+static ffelexHandler ffestb_V0034_ (ffelexToken t);
+static ffelexHandler ffestb_V0035_ (ffelexToken t);
+static ffelexHandler ffestb_V0036_ (ffelexToken t);
+static ffelexHandler ffestb_V0161_ (ffelexToken t);
+static ffelexHandler ffestb_V0162_ (ffelexToken t);
+static ffelexHandler ffestb_V0163_ (ffelexToken t);
+static ffelexHandler ffestb_V0164_ (ffelexToken t);
+static ffelexHandler ffestb_V0165_ (ffelexToken t);
+static ffelexHandler ffestb_V0166_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_V0271_ (ffelexToken t);
+static ffelexHandler ffestb_V0272_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0273_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R5391_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R5392_ (ffelexToken t);
+#if FFESTR_F90
+static ffelexHandler ffestb_decl_R5393_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_decl_R5394_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R5395_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R539letters_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R539letters_1_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R539letters_2_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R539letters_3_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R539letters_4_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R539letters_5_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R539maybe_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R539maybe_1_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R539maybe_2_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R539maybe_3_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R539maybe_4_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R539maybe_5_ (ffelexToken t);
+
+/* Internal macros. */
+
+#if FFESTB_KILL_EASY_
+#define ffestb_subr_kill_accept_() \
+ ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_acceptix)
+#define ffestb_subr_kill_beru_() \
+ ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_beruix)
+#define ffestb_subr_kill_close_() \
+ ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_closeix)
+#define ffestb_subr_kill_delete_() \
+ ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_deleteix)
+#define ffestb_subr_kill_find_() \
+ ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_findix)
+#define ffestb_subr_kill_inquire_() \
+ ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_inquireix)
+#define ffestb_subr_kill_open_() \
+ ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_openix)
+#define ffestb_subr_kill_print_() \
+ ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_printix)
+#define ffestb_subr_kill_read_() \
+ ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_readix)
+#define ffestb_subr_kill_rewrite_() \
+ ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_rewriteix)
+#define ffestb_subr_kill_type_() \
+ ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_typeix)
+#define ffestb_subr_kill_vxtcode_() \
+ ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_vxtcodeix)
+#define ffestb_subr_kill_write_() \
+ ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_writeix)
+#endif
+
+/* ffestb_subr_ambig_nope_ -- Cleans up and aborts ambig w/o confirming
+
+ ffestb_subr_ambig_nope_();
+
+ Switch from ambiguity handling in _entsp_ functions to handling entities
+ in _ents_ (perform housekeeping tasks). */
+
+static ffelexHandler
+ffestb_subr_ambig_nope_ (ffelexToken t)
+{
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_subr_ambig_to_ents_ -- Switches from ambiguity to entity decl
+
+ ffestb_subr_ambig_to_ents_();
+
+ Switch from ambiguity handling in _entsp_ functions to handling entities
+ in _ents_ (perform housekeeping tasks). */
+
+static void
+ffestb_subr_ambig_to_ents_ ()
+{
+ ffelexToken nt;
+
+ nt = ffelex_token_name_from_names (ffesta_tokens[1], 0, 0);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffesta_tokens[1] = nt;
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (!ffestb_local_.decl.aster_after)
+ {
+ if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
+ {
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
+ ffestb_local_.decl.len, ffestb_local_.decl.lent);
+ if (ffestb_local_.decl.kindt != NULL)
+ {
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ }
+ if (ffestb_local_.decl.lent != NULL)
+ {
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ }
+ }
+ else
+ {
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ ffestb_local_.decl.kind, ffestb_local_.decl.kindt, NULL,
+ NULL);
+ if (ffestb_local_.decl.kindt != NULL)
+ {
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ }
+ }
+ return;
+ }
+ if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
+ {
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ ffestb_local_.decl.kind, ffestb_local_.decl.kindt, NULL, NULL);
+ if (ffestb_local_.decl.kindt != NULL)
+ {
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ }
+ }
+ else if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, NULL, NULL);
+ /* NAME/NAMES token already in ffesta_tokens[1]. */
+}
+
+/* ffestb_subr_dimlist_ -- OPEN_PAREN expr
+
+ (ffestb_subr_dimlist_) // to expression handler
+
+ Deal with a dimension list.
+
+ 19-Dec-90 JCB 1.1
+ Detect too many dimensions if backend wants it. */
+
+static ffelexHandler
+ffestb_subr_dimlist_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+#ifdef FFECOM_dimensionsMAX
+ if (ffestb_subrargs_.dim_list.ndims++ == FFECOM_dimensionsMAX)
+ {
+ ffesta_ffebad_1t (FFEBAD_TOO_MANY_DIMS, ft);
+ ffestb_subrargs_.dim_list.ok = TRUE; /* Not a parse error, really. */
+ return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
+ }
+#endif
+ ffestt_dimlist_append (ffestb_subrargs_.dim_list.dims, NULL, expr,
+ ffelex_token_use (t));
+ ffestb_subrargs_.dim_list.ok = TRUE;
+ return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
+
+ case FFELEX_typeCOMMA:
+ if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
+ break;
+#ifdef FFECOM_dimensionsMAX
+ if (ffestb_subrargs_.dim_list.ndims++ == FFECOM_dimensionsMAX)
+ {
+ ffesta_ffebad_1t (FFEBAD_TOO_MANY_DIMS, ft);
+ return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
+ ffestb_subrargs_.dim_list.ctx,
+ (ffeexprCallback) ffestb_subr_dimlist_2_);
+ }
+#endif
+ ffestt_dimlist_append (ffestb_subrargs_.dim_list.dims, NULL, expr,
+ ffelex_token_use (t));
+ return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
+ ffestb_subrargs_.dim_list.ctx,
+ (ffeexprCallback) ffestb_subr_dimlist_);
+
+ case FFELEX_typeCOLON:
+ if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
+ break;
+#ifdef FFECOM_dimensionsMAX
+ if (ffestb_subrargs_.dim_list.ndims++ == FFECOM_dimensionsMAX)
+ {
+ ffesta_ffebad_1t (FFEBAD_TOO_MANY_DIMS, ft);
+ return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
+ ffestb_subrargs_.dim_list.ctx,
+ (ffeexprCallback) ffestb_subr_dimlist_2_);
+ }
+#endif
+ ffestt_dimlist_append (ffestb_subrargs_.dim_list.dims, expr, NULL,
+ ffelex_token_use (t)); /* NULL second expr for
+ now, just plug in. */
+ return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
+ ffestb_subrargs_.dim_list.ctx,
+ (ffeexprCallback) ffestb_subr_dimlist_1_);
+
+ default:
+ break;
+ }
+
+ ffestb_subrargs_.dim_list.ok = FALSE;
+ return (ffelexHandler) ffestb_subrargs_.dim_list.handler (t);
+}
+
+/* ffestb_subr_dimlist_1_ -- OPEN_PAREN expr COLON expr
+
+ (ffestb_subr_dimlist_1_) // to expression handler
+
+ Get the upper bound. */
+
+static ffelexHandler
+ffestb_subr_dimlist_1_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ ffestb_subrargs_.dim_list.dims->previous->upper = expr;
+ ffestb_subrargs_.dim_list.ok = TRUE;
+ return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
+
+ case FFELEX_typeCOMMA:
+ if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
+ break;
+ ffestb_subrargs_.dim_list.dims->previous->upper = expr;
+ return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
+ ffestb_subrargs_.dim_list.ctx, (ffeexprCallback) ffestb_subr_dimlist_);
+
+ default:
+ break;
+ }
+
+ ffestb_subrargs_.dim_list.ok = FALSE;
+ return (ffelexHandler) ffestb_subrargs_.dim_list.handler (t);
+}
+
+/* ffestb_subr_dimlist_2_ -- OPEN_PAREN too-many-dim-exprs
+
+ (ffestb_subr_dimlist_2_) // to expression handler
+
+ Get the upper bound. */
+
+static ffelexHandler
+ffestb_subr_dimlist_2_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ ffestb_subrargs_.dim_list.ok = TRUE; /* Not a parse error, really. */
+ return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLON:
+ if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
+ break;
+ return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
+ ffestb_subrargs_.dim_list.ctx,
+ (ffeexprCallback) ffestb_subr_dimlist_2_);
+
+ default:
+ break;
+ }
+
+ ffestb_subrargs_.dim_list.ok = FALSE;
+ return (ffelexHandler) ffestb_subrargs_.dim_list.handler (t);
+}
+
+/* ffestb_subr_name_list_ -- Collect a list of name args and close-paren
+
+ return ffestb_subr_name_list_; // to lexer after seeing OPEN_PAREN
+
+ This implements R1224 in the Fortran 90 spec. The arg list may be
+ empty, or be a comma-separated list (an optional trailing comma currently
+ results in a warning but no other effect) of arguments. For functions,
+ however, "*" is invalid (we implement dummy-arg-name, rather than R1224
+ dummy-arg, which itself is either dummy-arg-name or "*"). */
+
+static ffelexHandler
+ffestb_subr_name_list_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (ffestt_tokenlist_count (ffestb_subrargs_.name_list.args) != 0)
+ { /* Trailing comma, warn. */
+ ffebad_start (FFEBAD_TRAILING_COMMA);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+ ffestb_subrargs_.name_list.ok = TRUE;
+ ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
+ if (ffestb_subrargs_.name_list.names)
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) ffestb_subrargs_.name_list.handler;
+
+ case FFELEX_typeASTERISK:
+ if (!ffestb_subrargs_.name_list.is_subr)
+ break;
+
+ case FFELEX_typeNAME:
+ ffestt_tokenlist_append (ffestb_subrargs_.name_list.args,
+ ffelex_token_use (t));
+ return (ffelexHandler) ffestb_subr_name_list_1_;
+
+ default:
+ break;
+ }
+
+ ffestb_subrargs_.name_list.ok = FALSE;
+ ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
+ if (ffestb_subrargs_.name_list.names)
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) (*ffestb_subrargs_.name_list.handler) (t);
+}
+
+/* ffestb_subr_name_list_1_ -- NAME or ASTERISK
+
+ return ffestb_subr_name_list_1_; // to lexer
+
+ The next token must be COMMA or CLOSE_PAREN, either way go to original
+ state, but only after adding the appropriate name list item. */
+
+static ffelexHandler
+ffestb_subr_name_list_1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_subr_name_list_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ ffestb_subrargs_.name_list.ok = TRUE;
+ ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
+ if (ffestb_subrargs_.name_list.names)
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) ffestb_subrargs_.name_list.handler;
+
+ default:
+ ffestb_subrargs_.name_list.ok = FALSE;
+ ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
+ if (ffestb_subrargs_.name_list.names)
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) (*ffestb_subrargs_.name_list.handler) (t);
+ }
+}
+
+static void
+ffestb_subr_R1001_append_p_ (void)
+{
+ ffesttFormatList f;
+
+ if (!ffestb_local_.format.pre.present)
+ {
+ ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_P_SPEC, ffestb_local_.format.t);
+ ffelex_token_kill (ffestb_local_.format.t);
+ return;
+ }
+
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeP;
+ f->t = ffestb_local_.format.t;
+ f->u.R1010.val = ffestb_local_.format.pre;
+}
+
+/* ffestb_decl_kindparam_ -- "type" OPEN_PAREN
+
+ return ffestb_decl_kindparam_; // to lexer
+
+ Handle "[KIND=]expr)". */
+
+static ffelexHandler
+ffestb_decl_kindparam_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_decl_kindparam_1_;
+
+ default:
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextKINDTYPE,
+ (ffeexprCallback) ffestb_decl_kindparam_2_)))
+ (t);
+ }
+}
+
+/* ffestb_decl_kindparam_1_ -- "type" OPEN_PAREN NAME
+
+ return ffestb_decl_kindparam_1_; // to lexer
+
+ Handle "[KIND=]expr)". */
+
+static ffelexHandler
+ffestb_decl_kindparam_1_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ if (ffestr_other (ffesta_tokens[1]) != FFESTR_otherKIND)
+ break;
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextKINDTYPE, (ffeexprCallback) ffestb_decl_kindparam_2_);
+
+ default:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextKINDTYPE, (ffeexprCallback) ffestb_decl_kindparam_2_)))
+ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ ffestb_local_.decl.badname,
+ ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_kindparam_2_ -- "type" OPEN_PAREN ["KIND="] expr
+
+ (ffestb_decl_kindparam_2_) // to expression handler
+
+ Handle "[KIND=]expr)". */
+
+static ffelexHandler
+ffestb_decl_kindparam_2_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ ffestb_local_.decl.kind = expr;
+ ffestb_local_.decl.kindt = ffelex_token_use (ft);
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) ffestb_local_.decl.handler;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ ffestb_local_.decl.badname,
+ t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_starkind_ -- "type" ASTERISK
+
+ return ffestb_decl_starkind_; // to lexer
+
+ Handle NUMBER. */
+
+static ffelexHandler
+ffestb_decl_starkind_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffestb_local_.decl.kindt = ffelex_token_use (t);
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) ffestb_local_.decl.handler;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ ffestb_local_.decl.badname,
+ t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_starlen_ -- "CHARACTER" ASTERISK
+
+ return ffestb_decl_starlen_; // to lexer
+
+ Handle NUMBER. */
+
+static ffelexHandler
+ffestb_decl_starlen_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = ffelex_token_use (t);
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) ffestb_local_.decl.handler;
+
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextCHARACTERSIZE,
+ (ffeexprCallback) ffestb_decl_starlen_1_);
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ ffestb_local_.decl.badname,
+ t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_starlen_1_ -- "CHARACTER" ASTERISK OPEN_PAREN expr
+
+ (ffestb_decl_starlen_1_) // to expression handler
+
+ Handle CLOSE_PAREN. */
+
+static ffelexHandler
+ffestb_decl_starlen_1_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestb_local_.decl.len = expr;
+ ffestb_local_.decl.lent = ffelex_token_use (ft);
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) ffestb_local_.decl.handler;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ ffestb_local_.decl.badname,
+ t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_typeparams_ -- "CHARACTER" OPEN_PAREN
+
+ return ffestb_decl_typeparams_; // to lexer
+
+ Handle "[KIND=]expr)". */
+
+static ffelexHandler
+ffestb_decl_typeparams_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_decl_typeparams_1_;
+
+ default:
+ if (ffestb_local_.decl.lent == NULL)
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextCHARACTERSIZE,
+ (ffeexprCallback) ffestb_decl_typeparams_2_)))
+ (t);
+ if (ffestb_local_.decl.kindt != NULL)
+ break;
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextKINDTYPE,
+ (ffeexprCallback) ffestb_decl_typeparams_3_)))
+ (t);
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ ffestb_local_.decl.badname,
+ t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_typeparams_1_ -- "CHARACTER" OPEN_PAREN NAME
+
+ return ffestb_decl_typeparams_1_; // to lexer
+
+ Handle "[KIND=]expr)". */
+
+static ffelexHandler
+ffestb_decl_typeparams_1_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ switch (ffestr_other (ffesta_tokens[1]))
+ {
+ case FFESTR_otherLEN:
+ if (ffestb_local_.decl.lent != NULL)
+ break;
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextCHARACTERSIZE,
+ (ffeexprCallback) ffestb_decl_typeparams_2_);
+
+ case FFESTR_otherKIND:
+ if (ffestb_local_.decl.kindt != NULL)
+ break;
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextKINDTYPE,
+ (ffeexprCallback) ffestb_decl_typeparams_3_);
+
+ default:
+ break;
+ }
+ break;
+
+ default:
+ nt = ffesta_tokens[1];
+ if (ffestb_local_.decl.lent == NULL)
+ next = (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextCHARACTERSIZE,
+ (ffeexprCallback) ffestb_decl_typeparams_2_)))
+ (nt);
+ else if (ffestb_local_.decl.kindt == NULL)
+ next = (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextKINDTYPE,
+ (ffeexprCallback) ffestb_decl_typeparams_3_)))
+ (nt);
+ else
+ {
+ ffesta_tokens[1] = nt;
+ break;
+ }
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ ffestb_local_.decl.badname,
+ ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_typeparams_2_ -- "CHARACTER" OPEN_PAREN ["LEN="] expr
+
+ (ffestb_decl_typeparams_2_) // to expression handler
+
+ Handle "[LEN=]expr)". */
+
+static ffelexHandler
+ffestb_decl_typeparams_2_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ ffestb_local_.decl.len = expr;
+ ffestb_local_.decl.lent = ffelex_token_use (ft);
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) ffestb_local_.decl.handler;
+
+ case FFELEX_typeCOMMA:
+ ffestb_local_.decl.len = expr;
+ ffestb_local_.decl.lent = ffelex_token_use (ft);
+ return (ffelexHandler) ffestb_decl_typeparams_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ ffestb_local_.decl.badname,
+ t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_typeparams_3_ -- "CHARACTER" OPEN_PAREN ["KIND="] expr
+
+ (ffestb_decl_typeparams_3_) // to expression handler
+
+ Handle "[KIND=]expr)". */
+
+static ffelexHandler
+ffestb_decl_typeparams_3_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ ffestb_local_.decl.kind = expr;
+ ffestb_local_.decl.kindt = ffelex_token_use (ft);
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) ffestb_local_.decl.handler;
+
+ case FFELEX_typeCOMMA:
+ ffestb_local_.decl.kind = expr;
+ ffestb_local_.decl.kindt = ffelex_token_use (ft);
+ return (ffelexHandler) ffestb_decl_typeparams_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ ffestb_local_.decl.badname,
+ t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_typetype1_ -- "TYPE" OPEN_PAREN
+
+ return ffestb_decl_typetype1_; // to lexer
+
+ Handle NAME. */
+
+#if FFESTR_F90
+static ffelexHandler
+ffestb_decl_typetype1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffestb_local_.decl.kindt = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_decl_typetype2_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ ffestb_local_.decl.badname,
+ t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_typetype2_ -- "TYPE" OPEN_PAREN NAME
+
+ return ffestb_decl_typetype2_; // to lexer
+
+ Handle CLOSE_PAREN. */
+
+static ffelexHandler
+ffestb_decl_typetype2_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ ffestb_local_.decl.type = FFESTP_typeTYPE;
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) ffestb_local_.decl.handler;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ ffestb_local_.decl.badname,
+ t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_subr_label_list_ -- Collect a tokenlist of labels and close-paren
+
+ return ffestb_subr_label_list_; // to lexer after seeing OPEN_PAREN
+
+ First token must be a NUMBER. Must be followed by zero or more COMMA
+ NUMBER pairs. Must then be followed by a CLOSE_PAREN. If all ok, put
+ the NUMBER tokens in a token list and return via the handler for the
+ token after CLOSE_PAREN. Else return via
+ same handler, but with the ok return value set FALSE. */
+
+static ffelexHandler
+ffestb_subr_label_list_ (ffelexToken t)
+{
+ if (ffelex_token_type (t) == FFELEX_typeNUMBER)
+ {
+ ffestt_tokenlist_append (ffestb_subrargs_.label_list.labels,
+ ffelex_token_use (t));
+ return (ffelexHandler) ffestb_subr_label_list_1_;
+ }
+
+ ffestb_subrargs_.label_list.ok = FALSE;
+ return (ffelexHandler) (*ffestb_subrargs_.label_list.handler) (t);
+}
+
+/* ffestb_subr_label_list_1_ -- NUMBER
+
+ return ffestb_subr_label_list_1_; // to lexer after seeing NUMBER
+
+ The next token must be COMMA, in which case go back to
+ ffestb_subr_label_list_, or CLOSE_PAREN, in which case set ok to TRUE
+ and go to the handler. */
+
+static ffelexHandler
+ffestb_subr_label_list_1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_subr_label_list_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ ffestb_subrargs_.label_list.ok = TRUE;
+ return (ffelexHandler) ffestb_subrargs_.label_list.handler;
+
+ default:
+ ffestb_subrargs_.label_list.ok = FALSE;
+ return (ffelexHandler) (*ffestb_subrargs_.label_list.handler) (t);
+ }
+}
+
+/* ffestb_do -- Parse the DO statement
+
+ return ffestb_do; // to lexer
+
+ Make sure the statement has a valid form for the DO statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_do (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexHandler next;
+ ffelexToken nt;
+ ffestrSecond kw;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstDO)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffesta_confirmed ();
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_do1_;
+
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_do2_;
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ ffesta_tokens[1] = NULL;
+ ffesta_tokens[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_do3_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_do1_ (t);
+
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstDO)
+ goto bad_0; /* :::::::::::::::::::: */
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDO);
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN: /* Must be "DO" label "WHILE". */
+ if (!isdigit (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1] = ffelex_token_number_from_names (ffesta_tokens[0],
+ i);
+ p += ffelex_token_length (ffesta_tokens[1]);
+ i += ffelex_token_length (ffesta_tokens[1]);
+ if (((*p) != 'W') && ((*p) != 'w'))
+ goto bad_i1; /* :::::::::::::::::::: */
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ kw = ffestr_second (nt);
+ ffelex_token_kill (nt);
+ if (kw != FFESTR_secondWHILE)
+ goto bad_i1; /* :::::::::::::::::::: */
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextDOWHILE, (ffeexprCallback) ffestb_do4_);
+
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (*p == '\0')
+ {
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_do2_;
+ }
+ if (!isdigit (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1] = ffelex_token_number_from_names (ffesta_tokens[0],
+ i);
+ p += ffelex_token_length (ffesta_tokens[1]);
+ i += ffelex_token_length (ffesta_tokens[1]);
+ if (*p != '\0')
+ goto bad_i1; /* :::::::::::::::::::: */
+ return (ffelexHandler) ffestb_do2_;
+
+ case FFELEX_typeEQUALS:
+ if (isdigit (*p))
+ {
+ ffesta_tokens[1]
+ = ffelex_token_number_from_names (ffesta_tokens[0], i);
+ p += ffelex_token_length (ffesta_tokens[1]);
+ i += ffelex_token_length (ffesta_tokens[1]);
+ }
+ else
+ ffesta_tokens[1] = NULL;
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i1; /* :::::::::::::::::::: */
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_lhs
+ (ffesta_output_pool, FFEEXPR_contextDO,
+ (ffeexprCallback) ffestb_do6_)))
+ (nt);
+ ffelex_token_kill (nt); /* Will get it back in _6_... */
+ return (ffelexHandler) (*next) (t);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (isdigit (*p))
+ {
+ ffesta_tokens[1]
+ = ffelex_token_number_from_names (ffesta_tokens[0], i);
+ p += ffelex_token_length (ffesta_tokens[1]);
+ i += ffelex_token_length (ffesta_tokens[1]);
+ }
+ else
+ ffesta_tokens[1] = NULL;
+ if (*p != '\0')
+ goto bad_i1; /* :::::::::::::::::::: */
+ return (ffelexHandler) ffestb_do1_ (t);
+ }
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i1: /* :::::::::::::::::::: */
+ if (ffesta_tokens[1])
+ ffelex_token_kill (ffesta_tokens[1]);
+
+bad_i: /* :::::::::::::::::::: */
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_dowhile -- Parse the DOWHILE statement
+
+ return ffestb_dowhile; // to lexer
+
+ Make sure the statement has a valid form for the DOWHILE statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_dowhile (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstDOWHILE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDOWHILE);
+ if (*p != '\0')
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextDOWHILE, (ffeexprCallback) ffestb_do4_);
+
+ case FFELEX_typeEQUALS:/* Not really DOWHILE, but DOWHILExyz=.... */
+ ffesta_tokens[1] = NULL;
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], FFESTR_firstlDO,
+ 0);
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_lhs
+ (ffesta_output_pool, FFEEXPR_contextDO,
+ (ffeexprCallback) ffestb_do6_)))
+ (nt);
+ ffelex_token_kill (nt); /* Will get it back in _6_... */
+ return (ffelexHandler) (*next) (t);
+ }
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_do1_ -- "DO" [label]
+
+ return ffestb_do1_; // to lexer
+
+ Make sure the statement has a valid form for the DO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_do1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ return (ffelexHandler) ffestb_do2_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (ffesta_tokens[1] != NULL)
+ ffestc_R819B (ffesta_construct_name, ffesta_tokens[1], NULL,
+ NULL);
+ else
+ ffestc_R820B (ffesta_construct_name, NULL, NULL);
+ }
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeNAME:
+ return (ffelexHandler) ffestb_do2_ (t);
+
+ default:
+ break;
+ }
+
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_do2_ -- "DO" [label] [,]
+
+ return ffestb_do2_; // to lexer
+
+ Make sure the statement has a valid form for the DO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_do2_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_do3_;
+
+ default:
+ break;
+ }
+
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_do3_ -- "DO" [label] [,] NAME
+
+ return ffestb_do3_; // to lexer
+
+ Make sure the statement has a valid form for the DO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_do3_ (ffelexToken t)
+{
+ ffelexHandler next;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextDO, (ffeexprCallback) ffestb_do6_)))
+ (ffesta_tokens[2]);
+ ffelex_token_kill (ffesta_tokens[2]); /* Will get it back in _6_... */
+ return (ffelexHandler) (*next) (t);
+
+ case FFELEX_typeOPEN_PAREN:
+ if (ffestr_second (ffesta_tokens[2]) != FFESTR_secondWHILE)
+ {
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[2]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid token. */
+ }
+ ffelex_token_kill (ffesta_tokens[2]);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextDOWHILE, (ffeexprCallback) ffestb_do4_);
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[2]);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_do4_ -- "DO" [label] [,] "WHILE" OPEN_PAREN expr
+
+ (ffestb_do4_) // to expression handler
+
+ Make sure the statement has a valid form for the DO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_do4_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffesta_tokens[2] = ffelex_token_use (ft);
+ ffestb_local_.dowhile.expr = expr;
+ return (ffelexHandler) ffestb_do5_;
+
+ default:
+ break;
+ }
+
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_do5_ -- "DO" [label] [,] "WHILE" OPEN_PAREN expr CLOSE_PAREN
+
+ return ffestb_do5_; // to lexer
+
+ Make sure the statement has a valid form for the DO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_do5_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (ffesta_tokens[1] != NULL)
+ ffestc_R819B (ffesta_construct_name, ffesta_tokens[1],
+ ffestb_local_.dowhile.expr, ffesta_tokens[2]);
+ else
+ ffestc_R820B (ffesta_construct_name, ffestb_local_.dowhile.expr,
+ ffesta_tokens[2]);
+ }
+ ffelex_token_kill (ffesta_tokens[2]);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[2]);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_do6_ -- "DO" [label] [,] var-expr
+
+ (ffestb_do6_) // to expression handler
+
+ Make sure the statement has a valid form for the DO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_do6_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ /* _3_ already ensured that this would be an EQUALS token. If not, it is a
+ bug in the FFE. */
+
+ assert (ffelex_token_type (t) == FFELEX_typeEQUALS);
+
+ ffesta_tokens[2] = ffelex_token_use (ft);
+ ffestb_local_.do_stmt.var = expr;
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextDO, (ffeexprCallback) ffestb_do7_);
+}
+
+/* ffestb_do7_ -- "DO" [label] [,] var-expr EQUALS expr
+
+ (ffestb_do7_) // to expression handler
+
+ Make sure the statement has a valid form for the DO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_do7_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (expr == NULL)
+ break;
+ ffesta_tokens[3] = ffelex_token_use (ft);
+ ffestb_local_.do_stmt.start = expr;
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextDO, (ffeexprCallback) ffestb_do8_);
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[2]);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_do8_ -- "DO" [label] [,] var-expr EQUALS expr COMMA expr
+
+ (ffestb_do8_) // to expression handler
+
+ Make sure the statement has a valid form for the DO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_do8_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ ffesta_tokens[4] = ffelex_token_use (ft);
+ ffestb_local_.do_stmt.end = expr;
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextDO, (ffeexprCallback) ffestb_do9_);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+ ffesta_tokens[4] = ffelex_token_use (ft);
+ ffestb_local_.do_stmt.end = expr;
+ return (ffelexHandler) ffestb_do9_ (NULL, NULL, t);
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[3]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_do9_ -- "DO" [label] [,] var-expr EQUALS expr COMMA expr
+ [COMMA expr]
+
+ (ffestb_do9_) // to expression handler
+
+ Make sure the statement has a valid form for the DO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_do9_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if ((expr == NULL) && (ft != NULL))
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ if (ffesta_tokens[1] != NULL)
+ ffestc_R819A (ffesta_construct_name, ffesta_tokens[1],
+ ffestb_local_.do_stmt.var, ffesta_tokens[2],
+ ffestb_local_.do_stmt.start, ffesta_tokens[3],
+ ffestb_local_.do_stmt.end, ffesta_tokens[4], expr, ft);
+ else
+ ffestc_R820A (ffesta_construct_name, ffestb_local_.do_stmt.var,
+ ffesta_tokens[2], ffestb_local_.do_stmt.start,
+ ffesta_tokens[3], ffestb_local_.do_stmt.end,
+ ffesta_tokens[4], expr, ft);
+ }
+ ffelex_token_kill (ffesta_tokens[4]);
+ ffelex_token_kill (ffesta_tokens[3]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[4]);
+ ffelex_token_kill (ffesta_tokens[3]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_else -- Parse the ELSE statement
+
+ return ffestb_else; // to lexer
+
+ Make sure the statement has a valid form for the ELSE statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_else (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstELSE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ ffesta_tokens[1] = NULL;
+ ffestb_args.elsexyz.second = FFESTR_secondNone;
+ return (ffelexHandler) ffestb_else1_ (t);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ break;
+ }
+
+ ffesta_confirmed ();
+ ffestb_args.elsexyz.second = ffesta_second_kw;
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_else1_;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstELSE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ break;
+ }
+ ffesta_confirmed ();
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlELSE)
+ {
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlELSE);
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1]
+ = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ }
+ else
+ ffesta_tokens[1] = NULL;
+ ffestb_args.elsexyz.second = FFESTR_secondNone;
+ return (ffelexHandler) ffestb_else1_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "ELSE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_elsexyz -- Parse an ELSEIF/ELSEWHERE statement
+
+ return ffestb_elsexyz; // to lexer
+
+ Expects len and second to be set in ffestb_args.elsexyz to the length
+ of the ELSExyz keyword involved and the corresponding ffestrSecond value. */
+
+ffelexHandler
+ffestb_elsexyz (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (ffesta_first_kw == FFESTR_firstELSEIF)
+ goto bad_0; /* :::::::::::::::::::: */
+ ffesta_confirmed ();
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_else1_ (t);
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ if (ffesta_first_kw != FFESTR_firstELSEIF)
+ goto bad_0; /* :::::::::::::::::::: */
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_else1_ (t);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ case FFELEX_typeNAMES:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ if (ffesta_first_kw != FFESTR_firstELSEIF)
+ goto bad_1; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlELSEIF)
+ {
+ i = FFESTR_firstlELSEIF;
+ goto bad_i; /* :::::::::::::::::::: */
+ }
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_else1_ (t);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ break;
+ }
+ ffesta_confirmed ();
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlELSE);
+ ffesta_tokens[1]
+ = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+#if FFESTR_F90
+ if ((ffestb_args.elsexyz.second == FFESTR_secondWHERE)
+ && (ffelex_token_length (ffesta_tokens[1]) != FFESTR_secondlWHERE))
+ ffestb_args.elsexyz.second = FFESTR_secondNone;
+#endif
+ return (ffelexHandler) ffestb_else1_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "ELSE IF", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_else1_ -- "ELSE" (NAME)
+
+ return ffestb_else1_; // to lexer
+
+ If EOS/SEMICOLON, implement the appropriate statement (keep in mind that
+ "ELSE WHERE" is ambiguous at the syntactic level). If OPEN_PAREN, start
+ expression analysis with callback at _2_. */
+
+static ffelexHandler
+ffestb_else1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ if (ffestb_args.elsexyz.second == FFESTR_secondIF)
+ {
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextIF, (ffeexprCallback) ffestb_else2_);
+ }
+ /* Fall through. */
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", t);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ break;
+
+ }
+
+ switch (ffestb_args.elsexyz.second)
+ {
+#if FFESTR_F90
+ case FFESTR_secondWHERE:
+ if (!ffesta_is_inhibited ())
+ if ((ffesta_first_kw == FFESTR_firstELSEWHERE)
+ && (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME))
+ ffestc_R744 ();
+ else
+ ffestc_elsewhere (ffesta_tokens[1]); /* R744 or R805. */
+ break;
+#endif
+
+ default:
+ if (!ffesta_is_inhibited ())
+ ffestc_R805 (ffesta_tokens[1]);
+ break;
+ }
+
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+}
+
+/* ffestb_else2_ -- "ELSE" "IF" OPEN_PAREN expr
+
+ (ffestb_else2_) // to expression handler
+
+ Make sure the next token is CLOSE_PAREN. */
+
+static ffelexHandler
+ffestb_else2_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ ffestb_local_.else_stmt.expr = expr;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffesta_tokens[1] = ffelex_token_use (ft);
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) ffestb_else3_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_else3_ -- "ELSE" "IF" OPEN_PAREN expr CLOSE_PAREN
+
+ return ffestb_else3_; // to lexer
+
+ Make sure the next token is "THEN". */
+
+static ffelexHandler
+ffestb_else3_ (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ ffelex_set_names (FALSE);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ if (ffestr_first (t) == FFESTR_firstTHEN)
+ return (ffelexHandler) ffestb_else4_;
+ break;
+
+ case FFELEX_typeNAMES:
+ ffesta_confirmed ();
+ if (ffestr_first (t) != FFESTR_firstTHEN)
+ break;
+ if (ffelex_token_length (t) == FFESTR_firstlTHEN)
+ return (ffelexHandler) ffestb_else4_;
+ p = ffelex_token_text (t) + (i = FFESTR_firstlTHEN);
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[2] = ffelex_token_name_from_names (t, i, 0);
+ return (ffelexHandler) ffestb_else5_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t, i, NULL);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_else4_ -- "ELSE" "IF" OPEN_PAREN expr CLOSE_PAREN "THEN"
+
+ return ffestb_else4_; // to lexer
+
+ Handle a NAME or EOS/SEMICOLON, then go to state _5_. */
+
+static ffelexHandler
+ffestb_else4_ (ffelexToken t)
+{
+ ffelex_set_names (FALSE);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_tokens[2] = NULL;
+ return (ffelexHandler) ffestb_else5_ (t);
+
+ case FFELEX_typeNAME:
+ ffesta_tokens[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_else5_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_else5_ -- "ELSE" "IF" OPEN_PAREN expr CLOSE_PAREN "THEN"
+
+ return ffestb_else5_; // to lexer
+
+ Make sure the next token is EOS or SEMICOLON; implement R804. */
+
+static ffelexHandler
+ffestb_else5_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_R804 (ffestb_local_.else_stmt.expr, ffesta_tokens[1],
+ ffesta_tokens[2]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_tokens[2] != NULL)
+ ffelex_token_kill (ffesta_tokens[2]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_tokens[2] != NULL)
+ ffelex_token_kill (ffesta_tokens[2]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_end -- Parse the END statement
+
+ return ffestb_end; // to lexer
+
+ Make sure the statement has a valid form for the END statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_end (ffelexToken t)
+{
+ ffeTokenLength i;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstEND)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_tokens[1] = NULL;
+ ffestb_args.endxyz.second = FFESTR_secondNone;
+ return (ffelexHandler) ffestb_end3_ (t);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ break;
+ }
+
+ ffesta_confirmed ();
+ ffestb_args.endxyz.second = ffesta_second_kw;
+ switch (ffesta_second_kw)
+ {
+ case FFESTR_secondFILE:
+ ffestb_args.beru.badname = "ENDFILE";
+ return (ffelexHandler) ffestb_beru;
+
+ case FFESTR_secondBLOCK:
+ return (ffelexHandler) ffestb_end1_;
+
+#if FFESTR_F90
+ case FFESTR_secondINTERFACE:
+#endif
+#if FFESTR_VXT
+ case FFESTR_secondMAP:
+ case FFESTR_secondSTRUCTURE:
+ case FFESTR_secondUNION:
+#endif
+#if FFESTR_F90
+ case FFESTR_secondWHERE:
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_end3_;
+#endif
+
+ case FFESTR_secondNone:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ return (ffelexHandler) ffestb_end2_;
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstEND)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ break;
+ }
+ ffesta_confirmed ();
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlEND)
+ {
+ i = FFESTR_firstlEND;
+ goto bad_i; /* :::::::::::::::::::: */
+ }
+ ffesta_tokens[1] = NULL;
+ ffestb_args.endxyz.second = FFESTR_secondNone;
+ return (ffelexHandler) ffestb_end3_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_endxyz -- Parse an ENDxyz statement
+
+ return ffestb_endxyz; // to lexer
+
+ Expects len and second to be set in ffestb_args.endxyz to the length
+ of the ENDxyz keyword involved and the corresponding ffestrSecond value. */
+
+ffelexHandler
+ffestb_endxyz (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_end3_ (t);
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ switch (ffestb_args.endxyz.second)
+ {
+#if FFESTR_F90
+ case FFESTR_secondINTERFACE:
+#endif
+#if FFESTR_VXT
+ case FFESTR_secondMAP:
+ case FFESTR_secondSTRUCTURE:
+ case FFESTR_secondUNION:
+#endif
+#if FFESTR_F90
+ case FFESTR_secondWHERE:
+ goto bad_1; /* :::::::::::::::::::: */
+#endif
+
+ case FFESTR_secondBLOCK:
+ if (ffesta_second_kw != FFESTR_secondDATA)
+ goto bad_1; /* :::::::::::::::::::: */
+ return (ffelexHandler) ffestb_end2_;
+
+ default:
+ return (ffelexHandler) ffestb_end2_ (t);
+ }
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ case FFELEX_typeNAMES:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ break;
+ }
+ ffesta_confirmed ();
+ if (ffestb_args.endxyz.second == FFESTR_secondBLOCK)
+ {
+ i = FFESTR_firstlEND;
+ goto bad_i; /* :::::::::::::::::::: */
+ }
+ if (ffelex_token_length (ffesta_tokens[0]) != ffestb_args.endxyz.len)
+ {
+ p = ffelex_token_text (ffesta_tokens[0])
+ + (i = ffestb_args.endxyz.len);
+ switch (ffestb_args.endxyz.second)
+ {
+#if FFESTR_F90
+ case FFESTR_secondINTERFACE:
+#endif
+#if FFESTR_VXT
+ case FFESTR_secondMAP:
+ case FFESTR_secondSTRUCTURE:
+ case FFESTR_secondUNION:
+#endif
+#if FFESTR_F90
+ case FFESTR_secondWHERE:
+ goto bad_i; /* :::::::::::::::::::: */
+#endif
+
+ default:
+ break;
+ }
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1]
+ = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ return (ffelexHandler) ffestb_end3_ (t);
+ }
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_end3_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_end1_ -- "END" "BLOCK"
+
+ return ffestb_end1_; // to lexer
+
+ Make sure the next token is "DATA". */
+
+static ffelexHandler
+ffestb_end1_ (ffelexToken t)
+{
+ if ((ffelex_token_type (t) == FFELEX_typeNAME)
+ && (ffesrc_strcmp_2c (ffe_case_match (), ffelex_token_text (t), "DATA",
+ "data", "Data")
+ == 0))
+ {
+ return (ffelexHandler) ffestb_end2_;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_end2_ -- "END" <unit-kind>
+
+ return ffestb_end2_; // to lexer
+
+ Make sure the next token is a NAME or EOS. */
+
+static ffelexHandler
+ffestb_end2_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_end3_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_end3_ (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ }
+}
+
+/* ffestb_end3_ -- "END" <unit-kind> (NAME)
+
+ return ffestb_end3_; // to lexer
+
+ Make sure the next token is an EOS, then implement the statement. */
+
+static ffelexHandler
+ffestb_end3_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (ffestb_args.endxyz.second == FFESTR_secondNone)
+ {
+ if (!ffesta_is_inhibited ())
+ ffestc_end ();
+ return (ffelexHandler) ffesta_zero (t);
+ }
+ break;
+ }
+
+ switch (ffestb_args.endxyz.second)
+ {
+#if FFESTR_F90
+ case FFESTR_secondTYPE:
+ if (!ffesta_is_inhibited ())
+ ffestc_R425 (ffesta_tokens[1]);
+ break;
+#endif
+
+#if FFESTR_F90
+ case FFESTR_secondWHERE:
+ if (!ffesta_is_inhibited ())
+ ffestc_R745 ();
+ break;
+#endif
+
+ case FFESTR_secondIF:
+ if (!ffesta_is_inhibited ())
+ ffestc_R806 (ffesta_tokens[1]);
+ break;
+
+ case FFESTR_secondSELECT:
+ if (!ffesta_is_inhibited ())
+ ffestc_R811 (ffesta_tokens[1]);
+ break;
+
+ case FFESTR_secondDO:
+ if (!ffesta_is_inhibited ())
+ ffestc_R825 (ffesta_tokens[1]);
+ break;
+
+ case FFESTR_secondPROGRAM:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1103 (ffesta_tokens[1]);
+ break;
+
+#if FFESTR_F90
+ case FFESTR_secondMODULE:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1106 (ffesta_tokens[1]);
+ break;
+#endif
+ case FFESTR_secondBLOCK:
+ case FFESTR_secondBLOCKDATA:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1112 (ffesta_tokens[1]);
+ break;
+
+#if FFESTR_F90
+ case FFESTR_secondINTERFACE:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1203 ();
+ break;
+#endif
+
+ case FFESTR_secondFUNCTION:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1221 (ffesta_tokens[1]);
+ break;
+
+ case FFESTR_secondSUBROUTINE:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1225 (ffesta_tokens[1]);
+ break;
+
+#if FFESTR_VXT
+ case FFESTR_secondSTRUCTURE:
+ if (!ffesta_is_inhibited ())
+ ffestc_V004 ();
+ break;
+#endif
+
+#if FFESTR_VXT
+ case FFESTR_secondUNION:
+ if (!ffesta_is_inhibited ())
+ ffestc_V010 ();
+ break;
+#endif
+
+#if FFESTR_VXT
+ case FFESTR_secondMAP:
+ if (!ffesta_is_inhibited ())
+ ffestc_V013 ();
+ break;
+#endif
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0]);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ }
+
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+}
+
+/* ffestb_goto -- Parse the GOTO statement
+
+ return ffestb_goto; // to lexer
+
+ Make sure the statement has a valid form for the GOTO statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_goto (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstGO:
+ if ((ffelex_token_type (t) != FFELEX_typeNAME)
+ || (ffesta_second_kw != FFESTR_secondTO))
+ goto bad_1; /* :::::::::::::::::::: */
+ ffesta_confirmed ();
+ return (ffelexHandler) ffestb_goto1_;
+
+ case FFESTR_firstGOTO:
+ return (ffelexHandler) ffestb_goto1_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstGOTO)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ case FFELEX_typePERCENT: /* Since GOTO I%J is apparently valid
+ in '90. */
+ case FFELEX_typeCOMMA:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ break;
+ }
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlGOTO)
+ {
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlGOTO);
+ if (isdigit (*p))
+ {
+ nt = ffelex_token_number_from_names (ffesta_tokens[0], i);
+ p += ffelex_token_length (nt);
+ i += ffelex_token_length (nt);
+ if (*p != '\0')
+ {
+ ffelex_token_kill (nt);
+ goto bad_i; /* :::::::::::::::::::: */
+ }
+ }
+ else if (ffesrc_is_name_init (*p))
+ {
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ }
+ else
+ goto bad_i; /* :::::::::::::::::::: */
+ next = (ffelexHandler) ffestb_goto1_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+ }
+ return (ffelexHandler) ffestb_goto1_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "GO TO", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "GO TO", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "GO TO", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_goto1_ -- "GOTO" or "GO" "TO"
+
+ return ffestb_goto1_; // to lexer
+
+ Make sure the statement has a valid form for the GOTO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_goto1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ if (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME)
+ ffesta_confirmed ();
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_goto2_;
+
+ case FFELEX_typeOPEN_PAREN:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ ffestb_subrargs_.label_list.labels = ffestt_tokenlist_create ();
+ ffestb_subrargs_.label_list.handler = (ffelexHandler) ffestb_goto3_;
+ return (ffelexHandler) ffestb_subr_label_list_;
+
+ case FFELEX_typeNAME:
+ if (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME)
+ ffesta_confirmed ();
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextAGOTO,
+ (ffeexprCallback) ffestb_goto4_)))
+ (t);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ break;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "GO TO", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_goto2_ -- "GO/TO" NUMBER
+
+ return ffestb_goto2_; // to lexer
+
+ Make sure the statement has a valid form for the GOTO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_goto2_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R836 (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "GO TO", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_goto3_ -- "GO/TO" OPEN_PAREN label-list CLOSE_PAREN
+
+ return ffestb_goto3_; // to lexer
+
+ Make sure the statement has a valid form for the GOTO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_goto3_ (ffelexToken t)
+{
+ if (!ffestb_subrargs_.label_list.ok)
+ goto bad; /* :::::::::::::::::::: */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextCGOTO,
+ (ffeexprCallback) ffestb_goto5_);
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ break;
+
+ default:
+ ffesta_confirmed ();
+ /* Fall through. */
+ case FFELEX_typeOPEN_PAREN: /* Could still be assignment!! */
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextCGOTO,
+ (ffeexprCallback) ffestb_goto5_)))
+ (t);
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "computed-GOTO", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_goto4_ -- "GO/TO" expr
+
+ (ffestb_goto4_) // to expression handler
+
+ Make sure the statement has a valid form for the GOTO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_goto4_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (expr == NULL)
+ break;
+ ffesta_tokens[1] = ffelex_token_use (ft);
+ ffestb_local_.go_to.expr = expr;
+ return (ffelexHandler) ffestb_goto6_;
+
+ case FFELEX_typeOPEN_PAREN:
+ if (expr == NULL)
+ break;
+ ffesta_tokens[1] = ffelex_token_use (ft);
+ ffestb_local_.go_to.expr = expr;
+ return (ffelexHandler) ffestb_goto6_ (t);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_R839 (expr, ft, NULL);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assigned-GOTO", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_goto5_ -- "GO/TO" OPEN_PAREN label-list CLOSE_PAREN (COMMA) expr
+
+ (ffestb_goto5_) // to expression handler
+
+ Make sure the statement has a valid form for the GOTO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_goto5_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R837 (ffestb_subrargs_.label_list.labels, expr, ft);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "computed-GOTO", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_goto6_ -- "GO/TO" expr (COMMA)
+
+ return ffestb_goto6_; // to lexer
+
+ Make sure the statement has a valid form for the GOTO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_goto6_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ ffesta_tokens[2] = ffelex_token_use (t);
+ ffestb_subrargs_.label_list.labels = ffestt_tokenlist_create ();
+ ffestb_subrargs_.label_list.handler = (ffelexHandler) ffestb_goto7_;
+ return (ffelexHandler) ffestb_subr_label_list_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assigned-GOTO", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_goto7_ -- "GO/TO" expr (COMMA) OPEN_PAREN label-list CLOSE_PAREN
+
+ return ffestb_goto7_; // to lexer
+
+ Make sure the statement has a valid form for the GOTO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_goto7_ (ffelexToken t)
+{
+ if (!ffestb_subrargs_.label_list.ok)
+ goto bad; /* :::::::::::::::::::: */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R839 (ffestb_local_.go_to.expr, ffesta_tokens[1],
+ ffestb_subrargs_.label_list.labels);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assigned-GOTO", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_halt -- Parse the STOP/PAUSE statement
+
+ return ffestb_halt; // to lexer
+
+ Make sure the statement has a valid form for the STOP/PAUSE statement. If
+ it does, implement the statement. */
+
+ffelexHandler
+ffestb_halt (ffelexToken t)
+{
+ ffelexHandler next;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeNAME:
+ case FFELEX_typeNUMBER:
+ case FFELEX_typeAPOSTROPHE:
+ case FFELEX_typeQUOTE:
+ ffesta_confirmed ();
+ break;
+ }
+
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextSTOP,
+ (ffeexprCallback) ffestb_halt1_)))
+ (t);
+
+ case FFELEX_typeNAMES:
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeNAME:
+ case FFELEX_typeNUMBER:
+ case FFELEX_typeAPOSTROPHE:
+ case FFELEX_typeQUOTE:
+ ffesta_confirmed ();
+ break;
+ }
+ next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextSTOP,
+ (ffeexprCallback) ffestb_halt1_);
+ next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
+ ffestb_args.halt.len);
+ if (next == NULL)
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ (ffesta_first_kw == FFESTR_firstSTOP)
+ ? "STOP" : "PAUSE",
+ ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ (ffesta_first_kw == FFESTR_firstSTOP)
+ ? "STOP" : "PAUSE",
+ t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_halt1_ -- "STOP/PAUSE" expr
+
+ (ffestb_halt1_) // to expression handler
+
+ Make sure the next token is an EOS or SEMICOLON. */
+
+static ffelexHandler
+ffestb_halt1_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ if (ffesta_first_kw == FFESTR_firstSTOP)
+ ffestc_R842 (expr, ft);
+ else
+ ffestc_R843 (expr, ft);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ (ffesta_first_kw == FFESTR_firstSTOP)
+ ? "STOP" : "PAUSE",
+ t);
+ break;
+ }
+
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_if -- Parse an IF statement
+
+ return ffestb_if; // to lexer
+
+ Make sure the statement has a valid form for an IF statement.
+ If it does, implement the statement. */
+
+ffelexHandler
+ffestb_if (ffelexToken t)
+{
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstIF)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstIF)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlIF)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextIF,
+ (ffeexprCallback) ffestb_if1_);
+
+bad_0: /* :::::::::::::::::::: */
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IF", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IF", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_if1_ -- "IF" OPEN_PAREN expr
+
+ (ffestb_if1_) // to expression handler
+
+ Make sure the next token is CLOSE_PAREN. */
+
+static ffelexHandler
+ffestb_if1_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ ffestb_local_.if_stmt.expr = expr;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffesta_tokens[1] = ffelex_token_use (ft);
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) ffestb_if2_;
+
+ default:
+ break;
+ }
+
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IF", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_if2_ -- "IF" OPEN_PAREN expr CLOSE_PAREN
+
+ return ffestb_if2_; // to lexer
+
+ Make sure the next token is NAME. */
+
+static ffelexHandler
+ffestb_if2_ (ffelexToken t)
+{
+ ffelex_set_names (FALSE);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ case FFELEX_typeNAMES:
+ ffesta_confirmed ();
+ ffesta_tokens[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_if3_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ if ((ffesta_construct_name == NULL)
+ || (ffelex_token_type (t) != FFELEX_typeNUMBER))
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IF", t);
+ else
+ ffesta_ffebad_2st (FFEBAD_INVALID_STMT_FORM, "CONSTRUCT",
+ ffesta_construct_name, t);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_if3_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NAME
+
+ return ffestb_if3_; // to lexer
+
+ If the next token is EOS or SEMICOLON and the preceding NAME was "THEN",
+ implement R803. Else, implement R807 and send the preceding NAME followed
+ by the current token. */
+
+static ffelexHandler
+ffestb_if3_ (ffelexToken t)
+{
+ ffelexHandler next;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (ffestr_first (ffesta_tokens[2]) == FFESTR_firstTHEN)
+ {
+ if (!ffesta_is_inhibited ())
+ ffestc_R803 (ffesta_construct_name, ffestb_local_.if_stmt.expr,
+ ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ return (ffelexHandler) ffesta_zero (t);
+ }
+ break;
+
+ default:
+ break;
+ }
+
+ if (ffesta_construct_name != NULL)
+ {
+ if (!ffesta_is_inhibited ())
+ ffesta_ffebad_2st (FFEBAD_INVALID_STMT_FORM, "CONSTRUCT",
+ ffesta_construct_name, ffesta_tokens[2]);
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R807 (ffestb_local_.if_stmt.expr, ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ {
+ ffelexToken my_2 = ffesta_tokens[2];
+
+ next = (ffelexHandler) ffesta_two (my_2, t);
+ ffelex_token_kill (my_2);
+ }
+ return (ffelexHandler) next;
+}
+
+/* ffestb_where -- Parse a WHERE statement
+
+ return ffestb_where; // to lexer
+
+ Make sure the statement has a valid form for a WHERE statement.
+ If it does, implement the statement. */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_where (ffelexToken t)
+{
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstWHERE)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstWHERE)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlWHERE)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextWHERE,
+ (ffeexprCallback) ffestb_where1_);
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+#endif
+/* ffestb_where1_ -- "WHERE" OPEN_PAREN expr
+
+ (ffestb_where1_) // to expression handler
+
+ Make sure the next token is CLOSE_PAREN. */
+
+#if FFESTR_F90
+static ffelexHandler
+ffestb_where1_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ ffestb_local_.if_stmt.expr = expr;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffesta_tokens[1] = ffelex_token_use (ft);
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) ffestb_where2_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_where2_ -- "WHERE" OPEN_PAREN expr CLOSE_PAREN
+
+ return ffestb_where2_; // to lexer
+
+ Make sure the next token is NAME. */
+
+#if FFESTR_F90
+static ffelexHandler
+ffestb_where2_ (ffelexToken t)
+{
+ ffelex_set_names (FALSE);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ case FFELEX_typeNAMES:
+ ffesta_confirmed ();
+ ffesta_tokens[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_where3_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R742 (ffestb_local_.if_stmt.expr, ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_where3_ -- "WHERE" OPEN_PAREN expr CLOSE_PAREN NAME
+
+ return ffestb_where3_; // to lexer
+
+ Implement R742. */
+
+#if FFESTR_F90
+static ffelexHandler
+ffestb_where3_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken my_2 = ffesta_tokens[2];
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R740 (ffestb_local_.if_stmt.expr, ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ next = (ffelexHandler) ffesta_two (my_2, t);
+ ffelex_token_kill (my_2);
+ return (ffelexHandler) next;
+}
+
+#endif
+/* ffestb_let -- Parse an assignment statement
+
+ return ffestb_let; // to lexer
+
+ Make sure the statement has a valid form for an assignment statement. If
+ it does, implement the statement. */
+
+ffelexHandler
+ffestb_let (ffelexToken t)
+{
+ ffelexHandler next;
+ bool vxtparam; /* TRUE if it might really be a VXT PARAMETER
+ stmt. */
+ char *p;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ vxtparam = FALSE;
+ break;
+
+ case FFELEX_typeNAMES:
+ vxtparam = TRUE;
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ case FFELEX_typePERCENT:
+ case FFELEX_typePOINTS:
+ ffestb_local_.let.vxtparam = FALSE;
+ break;
+
+ case FFELEX_typeEQUALS:
+ if (!vxtparam || (ffesta_first_kw != FFESTR_firstPARAMETER))
+ {
+ ffestb_local_.let.vxtparam = FALSE;
+ break;
+ }
+ p = ffelex_token_text (ffesta_tokens[0]) + FFESTR_firstlPARAMETER;
+ ffestb_local_.let.vxtparam = ffesrc_is_name_init (*p);
+ break;
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ next = (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextLET,
+ (ffeexprCallback) ffestb_let1_)))
+ (ffesta_tokens[0]);
+ return (ffelexHandler) (*next) (t);
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assignment", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assignment", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_let1_ -- expr
+
+ (ffestb_let1_) // to expression handler
+
+ Make sure the next token is EQUALS or POINTS. */
+
+static ffelexHandler
+ffestb_let1_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
+{
+ ffestb_local_.let.dest = expr;
+
+ switch (ffelex_token_type (t))
+ {
+#if FFESTR_F90
+ case FFELEX_typePOINTS:
+#endif
+ case FFELEX_typeEQUALS:
+ if (expr == NULL)
+ break;
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextLET, (ffeexprCallback) ffestb_let2_);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assignment", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_let2_ -- expr EQUALS/POINTS expr
+
+ (ffestb_end2_) // to expression handler
+
+ Make sure the next token is EOS or SEMICOLON; implement the statement. */
+
+static ffelexHandler
+ffestb_let2_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+ if (ffestb_local_.let.vxtparam && !ffestc_is_let_not_V027 ())
+ break;
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+#if FFESTR_F90
+ if (ffelex_token_type (ffesta_tokens[1]) == FFELEX_typeEQUALS)
+#endif
+ ffestc_let (ffestb_local_.let.dest, expr, ft);
+#if FFESTR_F90
+ else
+ ffestc_R738 (ffestb_local_.let.dest, expr, ft);
+#endif
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ (ffelex_token_type (ffesta_tokens[1]) == FFELEX_typeEQUALS)
+ ? "assignment" : "pointer-assignment",
+ t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_type -- Parse the TYPE statement
+
+ return ffestb_type; // to lexer
+
+ Make sure the statement has a valid form for the TYPE statement. If
+ it does, implement the statement. */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_type (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstTYPE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ return (ffelexHandler) ffestb_type1_;
+
+ case FFELEX_typeNAME: /* No confirm here, because ambig w/V020 VXT
+ TYPE. */
+ ffesta_tokens[1] = NULL;
+ ffesta_tokens[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_type4_;
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstTYPE)
+ goto bad_0; /* :::::::::::::::::::: */
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlTYPE);
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOMMA:
+ if (*p != '\0')
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_confirmed ();
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) ffestb_type1_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ break;
+ }
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1] = NULL;
+ ffesta_tokens[2]
+ = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ return (ffelexHandler) ffestb_type4_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "TYPE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_type1_ -- "TYPE" COMMA
+
+ return ffestb_type1_; // to lexer
+
+ Make sure the next token is a NAME. */
+
+static ffelexHandler
+ffestb_type1_ (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ ffelex_set_names (FALSE);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ ffestb_local_.type.kw = ffestr_other (t);
+ switch (ffestb_local_.varlist.kw)
+ {
+ case FFESTR_otherPUBLIC:
+ case FFESTR_otherPRIVATE:
+ return (ffelexHandler) ffestb_type2_;
+
+ default:
+ ffelex_token_kill (ffesta_tokens[1]);
+ break;
+ }
+ break;
+
+ case FFELEX_typeNAMES:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ ffestb_local_.type.kw = ffestr_other (t);
+ switch (ffestb_local_.varlist.kw)
+ {
+ case FFESTR_otherPUBLIC:
+ p = ffelex_token_text (t) + (i = FFESTR_otherlPUBLIC);
+ if (*p == '\0')
+ return (ffelexHandler) ffestb_type2_;
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i1; /* :::::::::::::::::::: */
+ ffesta_tokens[2] = ffelex_token_name_from_names (t, i, 0);
+ return (ffelexHandler) ffestb_type4_;
+
+ case FFESTR_otherPRIVATE:
+ p = ffelex_token_text (t) + (i = FFESTR_otherlPRIVATE);
+ if (*p == '\0')
+ return (ffelexHandler) ffestb_type2_;
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i1; /* :::::::::::::::::::: */
+ ffesta_tokens[2] = ffelex_token_name_from_names (t, i, 0);
+ return (ffelexHandler) ffestb_type4_;
+
+ default:
+ ffelex_token_kill (ffesta_tokens[1]);
+ break;
+ }
+ break;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_i1: /* :::::::::::::::::::: */
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "TYPE", t, i, NULL);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_type2_ -- "TYPE" COMMA NAME
+
+ return ffestb_type2_; // to lexer
+
+ Handle COLONCOLON or NAME. */
+
+static ffelexHandler
+ffestb_type2_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOLONCOLON:
+ return (ffelexHandler) ffestb_type3_;
+
+ case FFELEX_typeNAME:
+ return (ffelexHandler) ffestb_type3_ (t);
+
+ default:
+ break;
+ }
+
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_type3_ -- "TYPE" [COMMA NAME [COLONCOLON]]
+
+ return ffestb_type3_; // to lexer
+
+ Make sure the next token is a NAME. */
+
+static ffelexHandler
+ffestb_type3_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_type4_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
+ break;
+ }
+
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_type4_ -- "TYPE" [COMMA NAME [COLONCOLON]] NAME
+
+ return ffestb_type4_; // to lexer
+
+ Make sure the next token is an EOS or SEMICOLON. */
+
+static ffelexHandler
+ffestb_type4_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R424 (ffesta_tokens[1], ffestb_local_.type.kw,
+ ffesta_tokens[2]);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
+ break;
+ }
+
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_varlist -- Parse EXTERNAL/INTENT/INTRINSIC/OPTIONAL/PUBLIC/PRIVATE
+ statement
+
+ return ffestb_varlist; // to lexer
+
+ Make sure the statement has a valid form. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_varlist (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexToken nt;
+ ffelexHandler next;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ switch (ffesta_first_kw)
+ {
+#if FFESTR_F90
+ case FFESTR_firstPUBLIC:
+ if (!ffesta_is_inhibited ())
+ ffestc_R521A ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFESTR_firstPRIVATE:
+ if (!ffesta_is_inhibited ())
+ ffestc_private (); /* Either R523A or R521B. */
+ return (ffelexHandler) ffesta_zero (t);
+#endif
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed ();
+ switch (ffesta_first_kw)
+ {
+#if FFESTR_F90
+ case FFESTR_firstOPTIONAL:
+ if (!ffesta_is_inhibited ())
+ ffestc_R520_start ();
+ break;
+
+ case FFESTR_firstPUBLIC:
+ if (!ffesta_is_inhibited ())
+ ffestc_R521Astart ();
+ break;
+
+ case FFESTR_firstPRIVATE:
+ if (!ffesta_is_inhibited ())
+ ffestc_R521Bstart ();
+ break;
+#endif
+
+ default:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+ return (ffelexHandler) ffestb_varlist5_;
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ switch (ffesta_first_kw)
+ {
+#if FFESTR_F90
+ case FFESTR_firstINTENT:
+ return (ffelexHandler) ffestb_varlist1_;
+#endif
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstEXTERNAL:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1207_start ();
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstINTENT:
+ goto bad_1; /* :::::::::::::::::::: */
+#endif
+
+ case FFESTR_firstINTRINSIC:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1208_start ();
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstOPTIONAL:
+ if (!ffesta_is_inhibited ())
+ ffestc_R520_start ();
+ break;
+#endif
+
+#if FFESTR_F90
+ case FFESTR_firstPUBLIC:
+ if (!ffesta_is_inhibited ())
+ ffestc_R521Astart ();
+ break;
+
+ case FFESTR_firstPRIVATE:
+ if (!ffesta_is_inhibited ())
+ ffestc_R521Bstart ();
+ break;
+#endif
+
+ default:
+ break;
+ }
+ return (ffelexHandler) ffestb_varlist5_ (t);
+ }
+
+ case FFELEX_typeNAMES:
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.varlist.len);
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ switch (ffesta_first_kw)
+ {
+#if FFESTR_F90
+ case FFESTR_firstINTENT:
+ goto bad_1; /* :::::::::::::::::::: */
+#endif
+
+ default:
+ break;
+ }
+ if (*p != '\0')
+ break;
+ switch (ffesta_first_kw)
+ {
+#if FFESTR_F90
+ case FFESTR_firstPUBLIC:
+ if (!ffesta_is_inhibited ())
+ ffestc_R521A ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFESTR_firstPRIVATE:
+ if (!ffesta_is_inhibited ())
+ ffestc_private (); /* Either R423A or R521B. */
+ return (ffelexHandler) ffesta_zero (t);
+#endif
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ switch (ffesta_first_kw)
+ {
+#if FFESTR_F90
+ case FFESTR_firstINTENT:
+ goto bad_1; /* :::::::::::::::::::: */
+#endif
+
+ default:
+ break;
+ }
+ if (*p != '\0')
+ break;
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed ();
+ switch (ffesta_first_kw)
+ {
+#if FFESTR_F90
+ case FFESTR_firstOPTIONAL:
+ if (!ffesta_is_inhibited ())
+ ffestc_R520_start ();
+ break;
+#endif
+
+#if FFESTR_F90
+ case FFESTR_firstPUBLIC:
+ if (!ffesta_is_inhibited ())
+ ffestc_R521Astart ();
+ break;
+
+ case FFESTR_firstPRIVATE:
+ if (!ffesta_is_inhibited ())
+ ffestc_R521Bstart ();
+ break;
+#endif
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+ return (ffelexHandler) ffestb_varlist5_;
+
+ case FFELEX_typeOPEN_PAREN:
+ switch (ffesta_first_kw)
+ {
+#if FFESTR_F90
+ case FFESTR_firstINTENT:
+ if (*p != '\0')
+ goto bad_1; /* :::::::::::::::::::: */
+ return (ffelexHandler) ffestb_varlist1_;
+#endif
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstEXTERNAL:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1207_start ();
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstINTENT:
+ goto bad_1; /* :::::::::::::::::::: */
+#endif
+
+ case FFESTR_firstINTRINSIC:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1208_start ();
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstOPTIONAL:
+ if (!ffesta_is_inhibited ())
+ ffestc_R520_start ();
+ break;
+#endif
+
+#if FFESTR_F90
+ case FFESTR_firstPUBLIC:
+ if (!ffesta_is_inhibited ())
+ ffestc_R521Astart ();
+ break;
+
+ case FFESTR_firstPRIVATE:
+ if (!ffesta_is_inhibited ())
+ ffestc_R521Bstart ();
+ break;
+#endif
+
+ default:
+ break;
+ }
+ return (ffelexHandler) ffestb_varlist5_ (t);
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ /* Here, we have at least one char after the first keyword and t is
+ COMMA or EOS/SEMICOLON. Also we know that this form is valid for
+ only the statements reaching here (specifically, INTENT won't reach
+ here). */
+
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstEXTERNAL:
+ ffestc_R1207_start ();
+ break;
+
+ case FFESTR_firstINTRINSIC:
+ ffestc_R1208_start ();
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstOPTIONAL:
+ ffestc_R520_start ();
+ break;
+#endif
+
+#if FFESTR_F90
+ case FFESTR_firstPUBLIC:
+ ffestc_R521Astart ();
+ break;
+
+ case FFESTR_firstPRIVATE:
+ ffestc_R521Bstart ();
+ break;
+#endif
+
+ default:
+ assert (FALSE);
+ }
+ }
+ next = (ffelexHandler) ffestb_varlist5_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_varlist1_ -- "INTENT" OPEN_PAREN
+
+ return ffestb_varlist1_; // to lexer
+
+ Handle NAME. */
+
+#if FFESTR_F90
+static ffelexHandler
+ffestb_varlist1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ ffestb_local_.varlist.kw = ffestr_other (t);
+ switch (ffestb_local_.varlist.kw)
+ {
+ case FFESTR_otherIN:
+ return (ffelexHandler) ffestb_varlist2_;
+
+ case FFESTR_otherINOUT:
+ return (ffelexHandler) ffestb_varlist3_;
+
+ case FFESTR_otherOUT:
+ return (ffelexHandler) ffestb_varlist3_;
+
+ default:
+ ffelex_token_kill (ffesta_tokens[1]);
+ break;
+ }
+ break;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_varlist2_ -- "INTENT" OPEN_PAREN "IN"
+
+ return ffestb_varlist2_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_varlist2_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ switch (ffestr_other (t))
+ {
+ case FFESTR_otherOUT:
+ ffestb_local_.varlist.kw = FFESTR_otherINOUT;
+ return (ffelexHandler) ffestb_varlist3_;
+
+ default:
+ break;
+ }
+ break;
+
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_varlist4_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_varlist3_ -- "INTENT" OPEN_PAREN NAME ["OUT"]
+
+ return ffestb_varlist3_; // to lexer
+
+ Handle CLOSE_PAREN. */
+
+static ffelexHandler
+ffestb_varlist3_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_varlist4_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_varlist4_ -- "INTENT" OPEN_PAREN NAME ["OUT"] CLOSE_PAREN
+
+ return ffestb_varlist4_; // to lexer
+
+ Handle COLONCOLON or NAME. */
+
+static ffelexHandler
+ffestb_varlist4_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R519_start (ffesta_tokens[1], ffestb_local_.varlist.kw);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_varlist5_;
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R519_start (ffesta_tokens[1], ffestb_local_.varlist.kw);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_varlist5_ (t);
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_varlist5_ -- Handles the list of variable names
+
+ return ffestb_varlist5_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_varlist5_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_varlist6_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstEXTERNAL:
+ ffestc_R1207_finish ();
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstINTENT:
+ ffestc_R519_finish ();
+ break;
+#endif
+
+ case FFESTR_firstINTRINSIC:
+ ffestc_R1208_finish ();
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstOPTIONAL:
+ ffestc_R520_finish ();
+ break;
+#endif
+
+#if FFESTR_F90
+ case FFESTR_firstPUBLIC:
+ ffestc_R521Afinish ();
+ break;
+
+ case FFESTR_firstPRIVATE:
+ ffestc_R521Bfinish ();
+ break;
+#endif
+
+ default:
+ assert (FALSE);
+ }
+ }
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_varlist6_ -- (whatever) NAME
+
+ return ffestb_varlist6_; // to lexer
+
+ Handle COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_varlist6_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstEXTERNAL:
+ ffestc_R1207_item (ffesta_tokens[1]);
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstINTENT:
+ ffestc_R519_item (ffesta_tokens[1]);
+ break;
+#endif
+
+ case FFESTR_firstINTRINSIC:
+ ffestc_R1208_item (ffesta_tokens[1]);
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstOPTIONAL:
+ ffestc_R520_item (ffesta_tokens[1]);
+ break;
+#endif
+
+#if FFESTR_F90
+ case FFESTR_firstPUBLIC:
+ ffestc_R521Aitem (ffesta_tokens[1]);
+ break;
+
+ case FFESTR_firstPRIVATE:
+ ffestc_R521Bitem (ffesta_tokens[1]);
+ break;
+#endif
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_varlist5_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstEXTERNAL:
+ ffestc_R1207_item (ffesta_tokens[1]);
+ ffestc_R1207_finish ();
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstINTENT:
+ ffestc_R519_item (ffesta_tokens[1]);
+ ffestc_R519_finish ();
+ break;
+#endif
+
+ case FFESTR_firstINTRINSIC:
+ ffestc_R1208_item (ffesta_tokens[1]);
+ ffestc_R1208_finish ();
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstOPTIONAL:
+ ffestc_R520_item (ffesta_tokens[1]);
+ ffestc_R520_finish ();
+ break;
+#endif
+
+#if FFESTR_F90
+ case FFESTR_firstPUBLIC:
+ ffestc_R521Aitem (ffesta_tokens[1]);
+ ffestc_R521Afinish ();
+ break;
+
+ case FFESTR_firstPRIVATE:
+ ffestc_R521Bitem (ffesta_tokens[1]);
+ ffestc_R521Bfinish ();
+ break;
+#endif
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstEXTERNAL:
+ ffestc_R1207_finish ();
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstINTENT:
+ ffestc_R519_finish ();
+ break;
+#endif
+
+ case FFESTR_firstINTRINSIC:
+ ffestc_R1208_finish ();
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstOPTIONAL:
+ ffestc_R520_finish ();
+ break;
+#endif
+
+#if FFESTR_F90
+ case FFESTR_firstPUBLIC:
+ ffestc_R521Afinish ();
+ break;
+
+ case FFESTR_firstPRIVATE:
+ ffestc_R521Bfinish ();
+ break;
+#endif
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R423B -- Parse the SEQUENCE statement
+
+ return ffestb_R423B; // to lexer
+
+ Make sure the statement has a valid form for the SEQUENCE statement. If
+ it does, implement the statement. */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_R423B (ffelexToken t)
+{
+ char *p;
+ ffeTokenLength i;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstSEQUENCE)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstSEQUENCE)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlSEQUENCE)
+ {
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSEQUENCE);
+ goto bad_i; /* :::::::::::::::::::: */
+ }
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R423B ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SEQUENCE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid first token. */
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SEQUENCE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "SEQUENCE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_R522 -- Parse the SAVE statement
+
+ return ffestb_R522; // to lexer
+
+ Make sure the statement has a valid form for the SAVE statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_R522 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexToken nt;
+ ffelexHandler next;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstSAVE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R522 ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeNAME:
+ case FFELEX_typeSLASH:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R522start ();
+ return (ffelexHandler) ffestb_R5221_ (t);
+
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R522start ();
+ return (ffelexHandler) ffestb_R5221_;
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstSAVE)
+ goto bad_0; /* :::::::::::::::::::: */
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSAVE);
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_R522 ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeSLASH:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ goto bad_i; /* :::::::::::::::::::: */
+ if (!ffesta_is_inhibited ())
+ ffestc_R522start ();
+ return (ffelexHandler) ffestb_R5221_ (t);
+
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ goto bad_i; /* :::::::::::::::::::: */
+ if (!ffesta_is_inhibited ())
+ ffestc_R522start ();
+ return (ffelexHandler) ffestb_R5221_;
+ }
+
+ /* Here, we have at least one char after "SAVE" and t is COMMA or
+ EOS/SEMICOLON. */
+
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ if (!ffesta_is_inhibited ())
+ ffestc_R522start ();
+ next = (ffelexHandler) ffestb_R5221_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "SAVE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5221_ -- "SAVE" [COLONCOLON]
+
+ return ffestb_R5221_; // to lexer
+
+ Handle NAME or SLASH. */
+
+static ffelexHandler
+ffestb_R5221_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffestb_local_.R522.is_cblock = FALSE;
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R5224_;
+
+ case FFELEX_typeSLASH:
+ ffestb_local_.R522.is_cblock = TRUE;
+ return (ffelexHandler) ffestb_R5222_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R522finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5222_ -- "SAVE" [COLONCOLON] SLASH
+
+ return ffestb_R5222_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_R5222_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R5223_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R522finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5223_ -- "SAVE" [COLONCOLON] SLASH NAME
+
+ return ffestb_R5223_; // to lexer
+
+ Handle SLASH. */
+
+static ffelexHandler
+ffestb_R5223_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeSLASH:
+ return (ffelexHandler) ffestb_R5224_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R522finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5224_ -- "SAVE" [COLONCOLON] R523
+
+ return ffestb_R5224_; // to lexer
+
+ Handle COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_R5224_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (!ffesta_is_inhibited ())
+ {
+ if (ffestb_local_.R522.is_cblock)
+ ffestc_R522item_cblock (ffesta_tokens[1]);
+ else
+ ffestc_R522item_object (ffesta_tokens[1]);
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_R5221_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ if (ffestb_local_.R522.is_cblock)
+ ffestc_R522item_cblock (ffesta_tokens[1]);
+ else
+ ffestc_R522item_object (ffesta_tokens[1]);
+ ffestc_R522finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R522finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R528 -- Parse the DATA statement
+
+ return ffestb_R528; // to lexer
+
+ Make sure the statement has a valid form for the DATA statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_R528 (ffelexToken t)
+{
+ char *p;
+ ffeTokenLength i;
+ ffelexToken nt;
+ ffelexHandler next;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstDATA)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeSLASH:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ break;
+
+ case FFELEX_typeOPEN_PAREN:
+ break;
+ }
+ ffestb_local_.data.started = FALSE;
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextDATA,
+ (ffeexprCallback) ffestb_R5281_)))
+ (t);
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstDATA)
+ goto bad_0; /* :::::::::::::::::::: */
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDATA);
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ if (*p == '\0')
+ {
+ ffestb_local_.data.started = FALSE;
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextDATA,
+ (ffeexprCallback)
+ ffestb_R5281_)))
+ (t);
+ }
+ break;
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeSLASH:
+ ffesta_confirmed ();
+ break;
+ }
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffestb_local_.data.started = FALSE;
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ next = (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextDATA,
+ (ffeexprCallback) ffestb_R5281_)))
+ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DATA", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5281_ -- "DATA" expr-list
+
+ (ffestb_R5281_) // to expression handler
+
+ Handle COMMA or SLASH. */
+
+static ffelexHandler
+ffestb_R5281_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.data.started)
+ {
+ ffestc_R528_start ();
+ ffestb_local_.data.started = TRUE;
+ }
+ ffestc_R528_item_object (expr, ft);
+ }
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextDATA,
+ (ffeexprCallback) ffestb_R5281_);
+
+ case FFELEX_typeSLASH:
+ ffesta_confirmed ();
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.data.started)
+ {
+ ffestc_R528_start ();
+ ffestb_local_.data.started = TRUE;
+ }
+ ffestc_R528_item_object (expr, ft);
+ ffestc_R528_item_startvals ();
+ }
+ return (ffelexHandler) ffeexpr_rhs
+ (ffesta_output_pool, FFEEXPR_contextDATA,
+ (ffeexprCallback) ffestb_R5282_);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
+ break;
+ }
+
+ if (ffestb_local_.data.started && !ffesta_is_inhibited ())
+ ffestc_R528_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5282_ -- "DATA" expr-list SLASH expr-list
+
+ (ffestb_R5282_) // to expression handler
+
+ Handle ASTERISK, COMMA, or SLASH. */
+
+static ffelexHandler
+ffestb_R5282_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_R528_item_value (NULL, NULL, expr, ft);
+ return (ffelexHandler) ffeexpr_rhs
+ (ffesta_output_pool, FFEEXPR_contextDATA,
+ (ffeexprCallback) ffestb_R5282_);
+
+ case FFELEX_typeASTERISK:
+ if (expr == NULL)
+ break;
+ ffestb_local_.data.expr = expr;
+ ffesta_tokens[1] = ffelex_token_use (ft);
+ return (ffelexHandler) ffeexpr_rhs
+ (ffesta_output_pool, FFEEXPR_contextDATA,
+ (ffeexprCallback) ffestb_R5283_);
+
+ case FFELEX_typeSLASH:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R528_item_value (NULL, NULL, expr, ft);
+ ffestc_R528_item_endvals (t);
+ }
+ return (ffelexHandler) ffestb_R5284_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R528_item_endvals (t);
+ ffestc_R528_finish ();
+ }
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5283_ -- "DATA" expr-list SLASH expr ASTERISK expr
+
+ (ffestb_R5283_) // to expression handler
+
+ Handle COMMA or SLASH. */
+
+static ffelexHandler
+ffestb_R5283_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_R528_item_value (ffestb_local_.data.expr, ffesta_tokens[1],
+ expr, ft);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffeexpr_rhs
+ (ffesta_output_pool, FFEEXPR_contextDATA,
+ (ffeexprCallback) ffestb_R5282_);
+
+ case FFELEX_typeSLASH:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R528_item_value (ffestb_local_.data.expr, ffesta_tokens[1],
+ expr, ft);
+ ffestc_R528_item_endvals (t);
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_R5284_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R528_item_endvals (t);
+ ffestc_R528_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5284_ -- "DATA" expr-list SLASH expr-list SLASH
+
+ return ffestb_R5284_; // to lexer
+
+ Handle [COMMA] NAME or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_R5284_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextDATA,
+ (ffeexprCallback) ffestb_R5281_);
+
+ case FFELEX_typeNAME:
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextDATA,
+ (ffeexprCallback) ffestb_R5281_)))
+ (t);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_R528_finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R528_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R537 -- Parse a PARAMETER statement
+
+ return ffestb_R537; // to lexer
+
+ Make sure the statement has a valid form for an PARAMETER statement.
+ If it does, implement the statement. */
+
+ffelexHandler
+ffestb_R537 (ffelexToken t)
+{
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstPARAMETER)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstPARAMETER)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlPARAMETER)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ ffestb_local_.parameter.started = FALSE;
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextPARAMETER,
+ (ffeexprCallback) ffestb_R5371_);
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_R5371_ -- "PARAMETER" OPEN_PAREN expr
+
+ (ffestb_R5371_) // to expression handler
+
+ Make sure the next token is EQUALS. */
+
+static ffelexHandler
+ffestb_R5371_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ ffestb_local_.parameter.expr = expr;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ if (expr == NULL)
+ break;
+ ffesta_tokens[1] = ffelex_token_use (ft);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextPARAMETER, (ffeexprCallback) ffestb_R5372_);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
+ if (ffestb_local_.parameter.started)
+ ffestc_R537_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5372_ -- "PARAMETER" OPEN_PAREN expr EQUALS expr
+
+ (ffestb_R5372_) // to expression handler
+
+ Make sure the next token is COMMA or CLOSE_PAREN. */
+
+static ffelexHandler
+ffestb_R5372_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.parameter.started)
+ {
+ ffestc_R537_start ();
+ ffestb_local_.parameter.started = TRUE;
+ }
+ ffestc_R537_item (ffestb_local_.parameter.expr, ffesta_tokens[1],
+ expr, ft);
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextPARAMETER,
+ (ffeexprCallback) ffestb_R5371_);
+
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.parameter.started)
+ {
+ ffestc_R537_start ();
+ ffestb_local_.parameter.started = TRUE;
+ }
+ ffestc_R537_item (ffestb_local_.parameter.expr, ffesta_tokens[1],
+ expr, ft);
+ ffestc_R537_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_R5373_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
+ if (ffestb_local_.parameter.started)
+ ffestc_R537_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5373_ -- "PARAMETER" OPEN_PAREN expr EQUALS expr CLOSE_PAREN
+
+ return ffestb_R5373_; // to lexer
+
+ Make sure the next token is EOS or SEMICOLON, or generate an error. All
+ cleanup has already been done, by the way. */
+
+static ffelexHandler
+ffestb_R5373_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R542 -- Parse the NAMELIST statement
+
+ return ffestb_R542; // to lexer
+
+ Make sure the statement has a valid form for the NAMELIST statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_R542 (ffelexToken t)
+{
+ char *p;
+ ffeTokenLength i;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstNAMELIST)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstNAMELIST)
+ goto bad_0; /* :::::::::::::::::::: */
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlNAMELIST);
+ if (*p != '\0')
+ goto bad_i; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeSLASH:
+ break;
+ }
+
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R542_start ();
+ return (ffelexHandler) ffestb_R5421_;
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "NAMELIST", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5421_ -- "NAMELIST" SLASH
+
+ return ffestb_R5421_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_R5421_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ if (!ffesta_is_inhibited ())
+ ffestc_R542_item_nlist (t);
+ return (ffelexHandler) ffestb_R5422_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R542_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5422_ -- "NAMELIST" SLASH NAME
+
+ return ffestb_R5422_; // to lexer
+
+ Handle SLASH. */
+
+static ffelexHandler
+ffestb_R5422_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeSLASH:
+ return (ffelexHandler) ffestb_R5423_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R542_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5423_ -- "NAMELIST" SLASH NAME SLASH
+
+ return ffestb_R5423_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_R5423_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ if (!ffesta_is_inhibited ())
+ ffestc_R542_item_nitem (t);
+ return (ffelexHandler) ffestb_R5424_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R542_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5424_ -- "NAMELIST" SLASH NAME SLASH NAME
+
+ return ffestb_R5424_; // to lexer
+
+ Handle COMMA, EOS/SEMICOLON, or SLASH. */
+
+static ffelexHandler
+ffestb_R5424_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_R5425_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_R542_finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeSLASH:
+ return (ffelexHandler) ffestb_R5421_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R542_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5425_ -- "NAMELIST" SLASH NAME SLASH NAME COMMA
+
+ return ffestb_R5425_; // to lexer
+
+ Handle NAME or SLASH. */
+
+static ffelexHandler
+ffestb_R5425_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ if (!ffesta_is_inhibited ())
+ ffestc_R542_item_nitem (t);
+ return (ffelexHandler) ffestb_R5424_;
+
+ case FFELEX_typeSLASH:
+ return (ffelexHandler) ffestb_R5421_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R542_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R544 -- Parse an EQUIVALENCE statement
+
+ return ffestb_R544; // to lexer
+
+ Make sure the statement has a valid form for an EQUIVALENCE statement.
+ If it does, implement the statement. */
+
+ffelexHandler
+ffestb_R544 (ffelexToken t)
+{
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstEQUIVALENCE)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstEQUIVALENCE)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlEQUIVALENCE)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ ffestb_local_.equivalence.started = FALSE;
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextEQUIVALENCE,
+ (ffeexprCallback) ffestb_R5441_);
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_R5441_ -- "EQUIVALENCE" OPEN_PAREN expr
+
+ (ffestb_R5441_) // to expression handler
+
+ Make sure the next token is COMMA. */
+
+static ffelexHandler
+ffestb_R5441_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ ffestb_local_.equivalence.exprs = ffestt_exprlist_create ();
+ ffestt_exprlist_append (ffestb_local_.equivalence.exprs, expr,
+ ffelex_token_use (ft));
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextEQUIVALENCE,
+ (ffeexprCallback) ffestb_R5442_);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
+ if (ffestb_local_.equivalence.started)
+ ffestc_R544_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5442_ -- "EQUIVALENCE" OPEN_PAREN expr COMMA expr
+
+ (ffestb_R5442_) // to expression handler
+
+ Make sure the next token is COMMA or CLOSE_PAREN. For COMMA, we just
+ append the expression to our list and continue; for CLOSE_PAREN, we
+ append the expression and move to _3_. */
+
+static ffelexHandler
+ffestb_R5442_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ ffestt_exprlist_append (ffestb_local_.equivalence.exprs, expr,
+ ffelex_token_use (ft));
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextEQUIVALENCE,
+ (ffeexprCallback) ffestb_R5442_);
+
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestt_exprlist_append (ffestb_local_.equivalence.exprs, expr,
+ ffelex_token_use (ft));
+ return (ffelexHandler) ffestb_R5443_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
+ if (ffestb_local_.equivalence.started)
+ ffestc_R544_finish ();
+ ffestt_exprlist_kill (ffestb_local_.equivalence.exprs);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5443_ -- "EQUIVALENCE" OPEN_PAREN expr COMMA expr CLOSE_PAREN
+
+ return ffestb_R5443_; // to lexer
+
+ Make sure the next token is COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_R5443_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.equivalence.started)
+ {
+ ffestc_R544_start ();
+ ffestb_local_.equivalence.started = TRUE;
+ }
+ ffestc_R544_item (ffestb_local_.equivalence.exprs);
+ }
+ ffestt_exprlist_kill (ffestb_local_.equivalence.exprs);
+ return (ffelexHandler) ffestb_R5444_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.equivalence.started)
+ {
+ ffestc_R544_start ();
+ ffestb_local_.equivalence.started = TRUE;
+ }
+ ffestc_R544_item (ffestb_local_.equivalence.exprs);
+ ffestc_R544_finish ();
+ }
+ ffestt_exprlist_kill (ffestb_local_.equivalence.exprs);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
+ if (ffestb_local_.equivalence.started)
+ ffestc_R544_finish ();
+ ffestt_exprlist_kill (ffestb_local_.equivalence.exprs);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5444_ -- "EQUIVALENCE" OPEN_PAREN expr COMMA expr CLOSE_PAREN COMMA
+
+ return ffestb_R5444_; // to lexer
+
+ Make sure the next token is OPEN_PAREN, or generate an error. */
+
+static ffelexHandler
+ffestb_R5444_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextEQUIVALENCE,
+ (ffeexprCallback) ffestb_R5441_);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
+ if (ffestb_local_.equivalence.started)
+ ffestc_R544_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R834 -- Parse the CYCLE statement
+
+ return ffestb_R834; // to lexer
+
+ Make sure the statement has a valid form for the CYCLE statement. If
+ it does, implement the statement. */
+
+ffelexHandler
+ffestb_R834 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstCYCLE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R8341_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_R8341_ (t);
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstCYCLE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ break;
+ }
+ ffesta_confirmed ();
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCYCLE);
+ if (*p == '\0')
+ {
+ ffesta_tokens[1] = NULL;
+ }
+ else
+ {
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1]
+ = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ }
+ return (ffelexHandler) ffestb_R8341_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CYCLE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CYCLE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CYCLE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8341_ -- "CYCLE" [NAME]
+
+ return ffestb_R8341_; // to lexer
+
+ Make sure the next token is an EOS or SEMICOLON. */
+
+static ffelexHandler
+ffestb_R8341_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R834 (ffesta_tokens[1]);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CYCLE", t);
+ break;
+ }
+
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R835 -- Parse the EXIT statement
+
+ return ffestb_R835; // to lexer
+
+ Make sure the statement has a valid form for the EXIT statement. If
+ it does, implement the statement. */
+
+ffelexHandler
+ffestb_R835 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstEXIT)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R8351_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_R8351_ (t);
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstEXIT)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ break;
+ }
+ ffesta_confirmed ();
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlEXIT);
+ if (*p == '\0')
+ {
+ ffesta_tokens[1] = NULL;
+ }
+ else
+ {
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1]
+ = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ }
+ return (ffelexHandler) ffestb_R8351_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EXIT", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EXIT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "EXIT", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8351_ -- "EXIT" [NAME]
+
+ return ffestb_R8351_; // to lexer
+
+ Make sure the next token is an EOS or SEMICOLON. */
+
+static ffelexHandler
+ffestb_R8351_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R835 (ffesta_tokens[1]);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EXIT", t);
+ break;
+ }
+
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R838 -- Parse the ASSIGN statement
+
+ return ffestb_R838; // to lexer
+
+ Make sure the statement has a valid form for the ASSIGN statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_R838 (ffelexToken t)
+{
+ char *p;
+ ffeTokenLength i;
+ ffelexHandler next;
+ ffelexToken et; /* First token in target. */
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstASSIGN)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNUMBER:
+ break;
+ }
+ ffesta_tokens[1] = ffelex_token_use (t);
+ ffesta_confirmed ();
+ return (ffelexHandler) ffestb_R8381_;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstASSIGN)
+ goto bad_0; /* :::::::::::::::::::: */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ /* Fall through. */
+ case FFELEX_typePERCENT:
+ case FFELEX_typeOPEN_PAREN:
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlASSIGN);
+ if (!isdigit (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1]
+ = ffelex_token_number_from_names (ffesta_tokens[0], i);
+ p += ffelex_token_length (ffesta_tokens[1]); /* Skip to "TO". */
+ i += ffelex_token_length (ffesta_tokens[1]);
+ if (!ffesrc_char_match_init (*p, 'T', 't') /* "TO". */
+ || (++i, !ffesrc_char_match_noninit (*++p, 'O', 'o')))
+ {
+ bad_i_1: /* :::::::::::::::::::: */
+ ffelex_token_kill (ffesta_tokens[1]);
+ goto bad_i; /* :::::::::::::::::::: */
+ }
+ ++p, ++i;
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i_1; /* :::::::::::::::::::: */
+ et = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ next = (ffelexHandler)
+ (*((ffelexHandler)
+ ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextASSIGN,
+ (ffeexprCallback)
+ ffestb_R8383_)))
+ (et);
+ ffelex_token_kill (et);
+ return (ffelexHandler) (*next) (t);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid first token. */
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "ASSIGN", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8381_ -- "ASSIGN" NUMBER
+
+ return ffestb_R8381_; // to lexer
+
+ Make sure the next token is "TO". */
+
+static ffelexHandler
+ffestb_R8381_ (ffelexToken t)
+{
+ if ((ffelex_token_type (t) == FFELEX_typeNAME)
+ && (ffesrc_strcmp_2c (ffe_case_match (), ffelex_token_text (t), "TO", "to",
+ "To") == 0))
+ {
+ return (ffelexHandler) ffestb_R8382_;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", t);
+ if (ffelex_token_type (t) == FFELEX_typeNAME)
+ return (ffelexHandler) ffestb_R8382_ (t); /* Maybe user forgot "TO". */
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8382_ -- "ASSIGN" NUMBER ("TO")
+
+ return ffestb_R8382_; // to lexer
+
+ Make sure the next token is a name, then pass it along to the expression
+ evaluator as an LHS expression. The callback function is _3_. */
+
+static ffelexHandler
+ffestb_R8382_ (ffelexToken t)
+{
+ if (ffelex_token_type (t) == FFELEX_typeNAME)
+ {
+ return (ffelexHandler)
+ (*((ffelexHandler)
+ ffeexpr_lhs (ffesta_output_pool, FFEEXPR_contextASSIGN,
+ (ffeexprCallback) ffestb_R8383_)))
+ (t);
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8383_ -- "ASSIGN" NUMBER ("TO") expression
+
+ (ffestb_R8383_) // to expression handler
+
+ Make sure the next token is an EOS or SEMICOLON. */
+
+static ffelexHandler
+ffestb_R8383_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_R838 (ffesta_tokens[1], expr, ft);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", t);
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R840 -- Parse an arithmetic-IF statement
+
+ return ffestb_R840; // to lexer
+
+ Make sure the statement has a valid form for an arithmetic-IF statement.
+ If it does, implement the statement. */
+
+ffelexHandler
+ffestb_R840 (ffelexToken t)
+{
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlIF)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffesta_first_kw != FFESTR_firstIF)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstIF)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextARITHIF,
+ (ffeexprCallback) ffestb_R8401_);
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_R8401_ -- "IF" OPEN_PAREN expr
+
+ (ffestb_R8401_) // to expression handler
+
+ Make sure the next token is CLOSE_PAREN. */
+
+static ffelexHandler
+ffestb_R8401_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ ffestb_local_.if_stmt.expr = expr;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffesta_tokens[1] = ffelex_token_use (ft);
+ ffelex_set_names (TRUE); /* In case it's a logical IF instead. */
+ return (ffelexHandler) ffestb_R8402_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8402_ -- "IF" OPEN_PAREN expr CLOSE_PAREN
+
+ return ffestb_R8402_; // to lexer
+
+ Make sure the next token is NUMBER. */
+
+static ffelexHandler
+ffestb_R8402_ (ffelexToken t)
+{
+ ffelex_set_names (FALSE);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffesta_confirmed ();
+ ffesta_tokens[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R8403_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8403_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER
+
+ return ffestb_R8403_; // to lexer
+
+ Make sure the next token is COMMA. */
+
+static ffelexHandler
+ffestb_R8403_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_R8404_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8404_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER COMMA
+
+ return ffestb_R8404_; // to lexer
+
+ Make sure the next token is NUMBER. */
+
+static ffelexHandler
+ffestb_R8404_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffesta_tokens[3] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R8405_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8405_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER COMMA NUMBER
+
+ return ffestb_R8405_; // to lexer
+
+ Make sure the next token is COMMA. */
+
+static ffelexHandler
+ffestb_R8405_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_R8406_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffelex_token_kill (ffesta_tokens[3]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8406_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER COMMA NUMBER COMMA
+
+ return ffestb_R8406_; // to lexer
+
+ Make sure the next token is NUMBER. */
+
+static ffelexHandler
+ffestb_R8406_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffesta_tokens[4] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R8407_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffelex_token_kill (ffesta_tokens[3]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8407_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER COMMA NUMBER COMMA
+ NUMBER
+
+ return ffestb_R8407_; // to lexer
+
+ Make sure the next token is EOS or SEMICOLON. */
+
+static ffelexHandler
+ffestb_R8407_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_R840 (ffestb_local_.if_stmt.expr, ffesta_tokens[1],
+ ffesta_tokens[2], ffesta_tokens[3], ffesta_tokens[4]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffelex_token_kill (ffesta_tokens[3]);
+ ffelex_token_kill (ffesta_tokens[4]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffelex_token_kill (ffesta_tokens[3]);
+ ffelex_token_kill (ffesta_tokens[4]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R841 -- Parse the CONTINUE statement
+
+ return ffestb_R841; // to lexer
+
+ Make sure the statement has a valid form for the CONTINUE statement. If
+ it does, implement the statement. */
+
+ffelexHandler
+ffestb_R841 (ffelexToken t)
+{
+ char *p;
+ ffeTokenLength i;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstCONTINUE)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstCONTINUE)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlCONTINUE)
+ {
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCONTINUE);
+ goto bad_i; /* :::::::::::::::::::: */
+ }
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R841 ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CONTINUE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid first token. */
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CONTINUE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CONTINUE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R1102 -- Parse the PROGRAM statement
+
+ return ffestb_R1102; // to lexer
+
+ Make sure the statement has a valid form for the PROGRAM statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_R1102 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstPROGRAM)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ break;
+ }
+
+ ffesta_confirmed ();
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R11021_;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstPROGRAM)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ break;
+ }
+ ffesta_confirmed ();
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlPROGRAM);
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1]
+ = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ return (ffelexHandler) ffestb_R11021_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PROGRAM", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PROGRAM", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "PROGRAM", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R11021_ -- "PROGRAM" NAME
+
+ return ffestb_R11021_; // to lexer
+
+ Make sure the next token is an EOS or SEMICOLON. */
+
+static ffelexHandler
+ffestb_R11021_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R1102 (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PROGRAM", t);
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_block -- Parse the BLOCK DATA statement
+
+ return ffestb_block; // to lexer
+
+ Make sure the statement has a valid form for the BLOCK DATA statement. If
+ it does, implement the statement. */
+
+ffelexHandler
+ffestb_block (ffelexToken t)
+{
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstBLOCK)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ if (ffesta_second_kw != FFESTR_secondDATA)
+ goto bad_1; /* :::::::::::::::::::: */
+ break;
+ }
+
+ ffesta_confirmed ();
+ return (ffelexHandler) ffestb_R1111_1_;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_blockdata -- Parse the BLOCKDATA statement
+
+ return ffestb_blockdata; // to lexer
+
+ Make sure the statement has a valid form for the BLOCKDATA statement. If
+ it does, implement the statement. */
+
+ffelexHandler
+ffestb_blockdata (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstBLOCKDATA)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R1111_2_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_R1111_2_ (t);
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstBLOCKDATA)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ break;
+ }
+ ffesta_confirmed ();
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlBLOCKDATA);
+ if (*p == '\0')
+ {
+ ffesta_tokens[1] = NULL;
+ }
+ else
+ {
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1]
+ = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ }
+ return (ffelexHandler) ffestb_R1111_2_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R1111_1_ -- "BLOCK" "DATA"
+
+ return ffestb_R1111_1_; // to lexer
+
+ Make sure the next token is a NAME, EOS, or SEMICOLON token. */
+
+static ffelexHandler
+ffestb_R1111_1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R1111_2_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_R1111_2_ (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", t);
+ break;
+ }
+
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R1111_2_ -- "BLOCK/DATA" NAME
+
+ return ffestb_R1111_2_; // to lexer
+
+ Make sure the next token is an EOS or SEMICOLON. */
+
+static ffelexHandler
+ffestb_R1111_2_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R1111 (ffesta_tokens[1]);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", t);
+ break;
+ }
+
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R1212 -- Parse the CALL statement
+
+ return ffestb_R1212; // to lexer
+
+ Make sure the statement has a valid form for the CALL statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_R1212 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstCALL)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ break;
+ }
+ ffesta_confirmed ();
+ return (ffelexHandler)
+ (*((ffelexHandler)
+ ffeexpr_lhs (ffesta_output_pool, FFEEXPR_contextSUBROUTINEREF,
+ (ffeexprCallback) ffestb_R12121_)))
+ (t);
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstCALL)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ break;
+ }
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCALL);
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ next = (ffelexHandler)
+ (*((ffelexHandler)
+ ffeexpr_lhs (ffesta_output_pool, FFEEXPR_contextSUBROUTINEREF,
+ (ffeexprCallback) ffestb_R12121_)))
+ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CALL", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CALL", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CALL", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R12121_ -- "CALL" expr
+
+ (ffestb_R12121_) // to expression handler
+
+ Make sure the statement has a valid form for the CALL statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R12121_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_R1212 (expr, ft);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CALL", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R1227 -- Parse the RETURN statement
+
+ return ffestb_R1227; // to lexer
+
+ Make sure the statement has a valid form for the RETURN statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_R1227 (ffelexToken t)
+{
+ ffelexHandler next;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstRETURN)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typeCOLON:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeNAME:
+ case FFELEX_typeNUMBER:
+ ffesta_confirmed ();
+ break;
+
+ default:
+ break;
+ }
+
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextRETURN,
+ (ffeexprCallback) ffestb_R12271_)))
+ (t);
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstRETURN)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typeCOLON:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ break;
+
+ default:
+ break;
+ }
+ next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextRETURN, (ffeexprCallback) ffestb_R12271_);
+ next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
+ FFESTR_firstlRETURN);
+ if (next == NULL)
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RETURN", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RETURN", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_R12271_ -- "RETURN" expr
+
+ (ffestb_R12271_) // to expression handler
+
+ Make sure the next token is an EOS or SEMICOLON. */
+
+static ffelexHandler
+ffestb_R12271_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R1227 (expr, ft);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RETURN", t);
+ break;
+ }
+
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R1228 -- Parse the CONTAINS statement
+
+ return ffestb_R1228; // to lexer
+
+ Make sure the statement has a valid form for the CONTAINS statement. If
+ it does, implement the statement. */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_R1228 (ffelexToken t)
+{
+ char *p;
+ ffeTokenLength i;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstCONTAINS)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstCONTAINS)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlCONTAINS)
+ {
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCONTAINS);
+ goto bad_i; /* :::::::::::::::::::: */
+ }
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R1228 ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CONTAINS", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid first token. */
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CONTAINS", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CONTAINS", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_V009 -- Parse the UNION statement
+
+ return ffestb_V009; // to lexer
+
+ Make sure the statement has a valid form for the UNION statement. If
+ it does, implement the statement. */
+
+#if FFESTR_VXT
+ffelexHandler
+ffestb_V009 (ffelexToken t)
+{
+ char *p;
+ ffeTokenLength i;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstUNION)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstUNION)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlUNION)
+ {
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlUNION);
+ goto bad_i; /* :::::::::::::::::::: */
+ }
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_V009 ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "UNION", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid first token. */
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "UNION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "UNION", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_construct -- Parse a construct name
+
+ return ffestb_construct; // to lexer
+
+ Make sure the statement can have a construct name (if-then-stmt, do-stmt,
+ select-case-stmt). */
+
+ffelexHandler
+ffestb_construct (ffelexToken t UNUSED)
+{
+ /* This handler gets invoked only when token 0 is NAME/NAMES and token 1 is
+ COLON. */
+
+ ffesta_confirmed ();
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) ffestb_construct1_;
+}
+
+/* ffestb_construct1_ -- NAME COLON
+
+ return ffestb_construct1_; // to lexer
+
+ Make sure we've got a NAME that is DO, DOWHILE, IF, SELECT, or SELECTCASE. */
+
+static ffelexHandler
+ffestb_construct1_ (ffelexToken t)
+{
+ ffelex_set_names (FALSE);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_first_kw = ffestr_first (t);
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstIF:
+ ffestb_local_.construct.next = (ffelexHandler) ffestb_if;
+ break;
+
+ case FFESTR_firstDO:
+ ffestb_local_.construct.next = (ffelexHandler) ffestb_do;
+ break;
+
+ case FFESTR_firstDOWHILE:
+ ffestb_local_.construct.next = (ffelexHandler) ffestb_dowhile;
+ break;
+
+ case FFESTR_firstSELECT:
+ case FFESTR_firstSELECTCASE:
+ ffestb_local_.construct.next = (ffelexHandler) ffestb_R809;
+ break;
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ ffesta_construct_name = ffesta_tokens[0];
+ ffesta_tokens[0] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_construct2_;
+
+ case FFELEX_typeNAMES:
+ ffesta_first_kw = ffestr_first (t);
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstIF:
+ if (ffelex_token_length (t) != FFESTR_firstlIF)
+ goto bad; /* :::::::::::::::::::: */
+ ffestb_local_.construct.next = (ffelexHandler) ffestb_if;
+ break;
+
+ case FFESTR_firstDO:
+ ffestb_local_.construct.next = (ffelexHandler) ffestb_do;
+ break;
+
+ case FFESTR_firstDOWHILE:
+ if (ffelex_token_length (t) != FFESTR_firstlDOWHILE)
+ goto bad; /* :::::::::::::::::::: */
+ ffestb_local_.construct.next = (ffelexHandler) ffestb_dowhile;
+ break;
+
+ case FFESTR_firstSELECTCASE:
+ if (ffelex_token_length (t) != FFESTR_firstlSELECTCASE)
+ goto bad; /* :::::::::::::::::::: */
+ ffestb_local_.construct.next = (ffelexHandler) ffestb_R809;
+ break;
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ ffesta_construct_name = ffesta_tokens[0];
+ ffesta_tokens[0] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_construct2_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffesta_ffebad_2st (FFEBAD_INVALID_STMT_FORM, "CONSTRUCT",
+ ffesta_tokens[0], t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_construct2_ -- NAME COLON "DO/DOWHILE/IF/SELECT/SELECTCASE"
+
+ return ffestb_construct2_; // to lexer
+
+ This extra step is needed to set ffesta_second_kw if the second token
+ (here) is a NAME, so DO and SELECT can continue to expect it. */
+
+static ffelexHandler
+ffestb_construct2_ (ffelexToken t)
+{
+ if (ffelex_token_type (t) == FFELEX_typeNAME)
+ ffesta_second_kw = ffestr_second (t);
+ return (ffelexHandler) (*ffestb_local_.construct.next) (t);
+}
+
+/* ffestb_heap -- Parse an ALLOCATE/DEALLOCATE statement
+
+ return ffestb_heap; // to lexer
+
+ Make sure the statement has a valid form for an ALLOCATE/DEALLOCATE
+ statement. If it does, implement the statement. */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_heap (ffelexToken t)
+{
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffelex_token_length (ffesta_tokens[0]) != ffestb_args.heap.len)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ ffestb_local_.heap.exprs = ffestt_exprlist_create ();
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ ffestb_args.heap.ctx,
+ (ffeexprCallback) ffestb_heap1_);
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_heap1_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN expr
+
+ (ffestb_heap1_) // to expression handler
+
+ Make sure the next token is COMMA. */
+
+static ffelexHandler
+ffestb_heap1_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ ffestt_exprlist_append (ffestb_local_.heap.exprs, expr,
+ ffelex_token_use (t));
+ return (ffelexHandler) ffestb_heap2_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestt_exprlist_append (ffestb_local_.heap.exprs, expr,
+ ffelex_token_use (t));
+ ffesta_tokens[1] = NULL;
+ ffestb_local_.heap.expr = NULL;
+ return (ffelexHandler) ffestb_heap5_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
+ ffestt_exprlist_kill (ffestb_local_.heap.exprs);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_heap2_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN expr COMMA
+
+ return ffestb_heap2_; // to lexer
+
+ Make sure the next token is NAME. */
+
+static ffelexHandler
+ffestb_heap2_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_heap3_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
+ ffestt_exprlist_kill (ffestb_local_.heap.exprs);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_heap3_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN expr COMMA NAME
+
+ return ffestb_heap3_; // to lexer
+
+ If token is EQUALS, make sure NAME was "STAT" and handle STAT variable;
+ else pass NAME and token to expression handler. */
+
+static ffelexHandler
+ffestb_heap3_ (ffelexToken t)
+{
+ ffelexHandler next;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ if (ffestr_other (ffesta_tokens[1]) != FFESTR_otherSTAT)
+ break;
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextHEAPSTAT,
+ (ffeexprCallback) ffestb_heap4_);
+
+ default:
+ next = (ffelexHandler)
+ (*((ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ ffestb_args.heap.ctx,
+ (ffeexprCallback) ffestb_heap1_)))
+ (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) (*next) (t);
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
+ ffestt_exprlist_kill (ffestb_local_.heap.exprs);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_heap4_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN ... COMMA "STAT" EQUALS
+ expr
+
+ (ffestb_heap4_) // to expression handler
+
+ Make sure the next token is CLOSE_PAREN. */
+
+static ffelexHandler
+ffestb_heap4_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffesta_tokens[1] = ffelex_token_use (ft);
+ ffestb_local_.heap.expr = expr;
+ return (ffelexHandler) ffestb_heap5_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
+ ffestt_exprlist_kill (ffestb_local_.heap.exprs);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_heap5_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN ... CLOSE_PAREN
+
+ return ffestb_heap5_; // to lexer
+
+ Make sure the next token is EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_heap5_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ if (ffesta_first_kw == FFESTR_firstALLOCATE)
+ ffestc_R620 (ffestb_local_.heap.exprs, ffestb_local_.heap.expr,
+ ffesta_tokens[1]);
+ else
+ ffestc_R625 (ffestb_local_.heap.exprs, ffestb_local_.heap.expr,
+ ffesta_tokens[1]);
+ ffestt_exprlist_kill (ffestb_local_.heap.exprs);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
+ ffestt_exprlist_kill (ffestb_local_.heap.exprs);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_module -- Parse the MODULEPROCEDURE statement
+
+ return ffestb_module; // to lexer
+
+ Make sure the statement has a valid form for the MODULEPROCEDURE statement.
+ If it does, implement the statement.
+
+ 31-May-90 JCB 1.1
+ Confirm NAME==MODULE followed by standard four invalid tokens, so we
+ get decent message if somebody forgets that MODULE requires a name. */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_module (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexToken nt;
+ ffelexToken mt; /* Name in MODULE PROCEDUREname, i.e.
+ includes "PROCEDURE". */
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstMODULE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ break;
+
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ goto bad_1m; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1m; /* :::::::::::::::::::: */
+ }
+
+ ffesta_confirmed ();
+ if (ffesta_second_kw != FFESTR_secondPROCEDURE)
+ {
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_module3_;
+ }
+ ffestb_local_.moduleprocedure.started = FALSE;
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_module1_;
+
+ case FFELEX_typeNAMES:
+ p = ffelex_token_text (ffesta_tokens[0])
+ + (i = FFESTR_firstlMODULEPROCEDURE);
+ if ((ffesta_first_kw == FFESTR_firstMODULE)
+ || ((ffesta_first_kw == FFESTR_firstMODULEPROCEDURE)
+ && !ffesrc_is_name_init (*p)))
+ { /* Definitely not "MODULE PROCEDURE name". */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1m; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1m; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ break;
+ }
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlMODULE);
+ if (!ffesrc_is_name_init (*p))
+ goto bad_im; /* :::::::::::::::::::: */
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ if (!ffesta_is_inhibited ())
+ ffestc_R1105 (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) ffesta_zero (t);
+ }
+
+ /* Here we know that we're indeed looking at a MODULEPROCEDURE
+ statement rather than MODULE and that the character following
+ MODULEPROCEDURE in the NAMES token is a valid first character for a
+ NAME. This means that unless the second token is COMMA, we have an
+ ambiguous statement that can be read either as MODULE PROCEDURE name
+ or MODULE PROCEDUREname, the former being an R1205, the latter an
+ R1105. */
+
+ if (ffesta_first_kw != FFESTR_firstMODULEPROCEDURE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOMMA: /* Aha, clearly not MODULE PROCEDUREname. */
+ ffesta_confirmed ();
+ ffestb_local_.moduleprocedure.started = FALSE;
+ ffesta_tokens[1]
+ = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ return (ffelexHandler) ffestb_module2_ (t);
+
+ case FFELEX_typeEOS: /* MODULE PROCEDURE name or MODULE
+ PROCEDUREname. */
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ break;
+ }
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ mt = ffelex_token_name_from_names (ffesta_tokens[0], FFESTR_firstlMODULE,
+ 0);
+ if (!ffesta_is_inhibited ())
+ ffestc_module (mt, nt); /* Implement ambiguous statement. */
+ ffelex_token_kill (nt);
+ ffelex_token_kill (mt);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_1m: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_im: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "MODULE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_module1_ -- "MODULEPROCEDURE" or "MODULE" "PROCEDURE"
+
+ return ffestb_module1_; // to lexer
+
+ Make sure the statement has a valid form for the MODULEPROCEDURE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_module1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ if (!ffestb_local_.moduleprocedure.started
+ && (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME))
+ {
+ ffesta_confirmed ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ }
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_module2_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (ffestb_local_.moduleprocedure.started)
+ break; /* Error if we've already seen NAME COMMA. */
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R1105 (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ break;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.moduleprocedure.started && !ffesta_is_inhibited ())
+ ffestc_R1205_finish ();
+ else if (!ffestb_local_.moduleprocedure.started)
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_module2_ -- "MODULE/PROCEDURE" NAME
+
+ return ffestb_module2_; // to lexer
+
+ Make sure the statement has a valid form for the MODULEPROCEDURE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_module2_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffestb_local_.moduleprocedure.started)
+ {
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R1205_start ();
+ }
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R1205_item (ffesta_tokens[1]);
+ ffestc_R1205_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ if (!ffestb_local_.moduleprocedure.started)
+ {
+ ffestb_local_.moduleprocedure.started = TRUE;
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R1205_start ();
+ }
+ if (!ffesta_is_inhibited ())
+ ffestc_R1205_item (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_module1_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.moduleprocedure.started && !ffesta_is_inhibited ())
+ ffestc_R1205_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_module3_ -- "MODULE" NAME
+
+ return ffestb_module3_; // to lexer
+
+ Make sure the statement has a valid form for the MODULE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_module3_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1105 (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_R809 -- Parse the SELECTCASE statement
+
+ return ffestb_R809; // to lexer
+
+ Make sure the statement has a valid form for the SELECTCASE statement.
+ If it does, implement the statement. */
+
+ffelexHandler
+ffestb_R809 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstSELECT:
+ if ((ffelex_token_type (t) != FFELEX_typeNAME)
+ || (ffesta_second_kw != FFESTR_secondCASE))
+ goto bad_1; /* :::::::::::::::::::: */
+ ffesta_confirmed ();
+ return (ffelexHandler) ffestb_R8091_;
+
+ case FFESTR_firstSELECTCASE:
+ return (ffelexHandler) ffestb_R8091_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstSELECTCASE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ break;
+ }
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSELECTCASE);
+ if (*p != '\0')
+ goto bad_i; /* :::::::::::::::::::: */
+ return (ffelexHandler) ffestb_R8091_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8091_ -- "SELECTCASE" or "SELECT" "CASE"
+
+ return ffestb_R8091_; // to lexer
+
+ Make sure the statement has a valid form for the SELECTCASE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R8091_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextSELECTCASE, (ffeexprCallback) ffestb_R8092_);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ break;
+
+ default:
+ break;
+ }
+
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8092_ -- "SELECT/CASE" OPEN_PAREN expr
+
+ (ffestb_R8092_) // to expression handler
+
+ Make sure the statement has a valid form for the SELECTCASE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R8092_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffesta_tokens[1] = ffelex_token_use (ft);
+ ffestb_local_.selectcase.expr = expr;
+ return (ffelexHandler) ffestb_R8093_;
+
+ default:
+ break;
+ }
+
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8093_ -- "SELECT/CASE" OPEN_PAREN expr CLOSE_PAREN
+
+ return ffestb_R8093_; // to lexer
+
+ Make sure the statement has a valid form for the SELECTCASE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R8093_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R809 (ffesta_construct_name, ffestb_local_.selectcase.expr,
+ ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ return ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ break;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R810 -- Parse the CASE statement
+
+ return ffestb_R810; // to lexer
+
+ Make sure the statement has a valid form for the CASE statement.
+ If it does, implement the statement. */
+
+ffelexHandler
+ffestb_R810 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstCASE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ if (ffesta_second_kw != FFESTR_secondDEFAULT)
+ goto bad_1; /* :::::::::::::::::::: */
+ ffestb_local_.case_stmt.cases = NULL;
+ return (ffelexHandler) ffestb_R8101_;
+
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_local_.case_stmt.cases = ffestt_caselist_create ();
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8103_);
+ }
+
+ case FFELEX_typeNAMES:
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstCASEDEFAULT:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ break;
+ }
+ ffestb_local_.case_stmt.cases = NULL;
+ p = ffelex_token_text (ffesta_tokens[0])
+ + (i = FFESTR_firstlCASEDEFAULT);
+ if (*p == '\0')
+ return (ffelexHandler) ffestb_R8101_ (t);
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1] = ffelex_token_name_from_names (ffesta_tokens[0], i,
+ 0);
+ return (ffelexHandler) ffestb_R8102_ (t);
+
+ case FFESTR_firstCASE:
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ break;
+ }
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCASE);
+ if (*p != '\0')
+ goto bad_i; /* :::::::::::::::::::: */
+ ffestb_local_.case_stmt.cases = ffestt_caselist_create ();
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8103_);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CASE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8101_ -- "CASE" case-selector
+
+ return ffestb_R8101_; // to lexer
+
+ Make sure the statement has a valid form for the CASE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R8101_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R8102_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_R8102_ (t);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ break;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.case_stmt.cases != NULL)
+ ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8102_ -- "CASE" case-selector [NAME]
+
+ return ffestb_R8102_; // to lexer
+
+ Make sure the statement has a valid form for the CASE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R8102_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R810 (ffestb_local_.case_stmt.cases, ffesta_tokens[1]);
+ if (ffestb_local_.case_stmt.cases != NULL)
+ ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ break;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.case_stmt.cases != NULL)
+ ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8103_ -- "CASE" OPEN_PAREN expr
+
+ (ffestb_R8103_) // to expression handler
+
+ Make sure the statement has a valid form for the CASE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R8103_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ ffestt_caselist_append (ffestb_local_.case_stmt.cases, FALSE, expr, NULL,
+ ffelex_token_use (ft));
+ return (ffelexHandler) ffestb_R8101_;
+
+ case FFELEX_typeCOMMA:
+ ffestt_caselist_append (ffestb_local_.case_stmt.cases, FALSE, expr, NULL,
+ ffelex_token_use (ft));
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8103_);
+
+ case FFELEX_typeCOLON:
+ ffestt_caselist_append (ffestb_local_.case_stmt.cases, TRUE, expr, NULL,
+ ffelex_token_use (ft)); /* NULL second expr for
+ now, just plug in. */
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8104_);
+
+ default:
+ break;
+ }
+
+ ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8104_ -- "CASE" OPEN_PAREN expr COLON expr
+
+ (ffestb_R8104_) // to expression handler
+
+ Make sure the statement has a valid form for the CASE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R8104_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ ffestb_local_.case_stmt.cases->previous->expr2 = expr;
+ return (ffelexHandler) ffestb_R8101_;
+
+ case FFELEX_typeCOMMA:
+ ffestb_local_.case_stmt.cases->previous->expr2 = expr;
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8103_);
+
+ default:
+ break;
+ }
+
+ ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R1001 -- Parse a FORMAT statement
+
+ return ffestb_R1001; // to lexer
+
+ Make sure the statement has a valid form for an FORMAT statement.
+ If it does, implement the statement. */
+
+ffelexHandler
+ffestb_R1001 (ffelexToken t)
+{
+ ffesttFormatList f;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstFORMAT)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstFORMAT)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlFORMAT)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_local_.format.complained = FALSE;
+ ffestb_local_.format.f = NULL; /* No parent yet. */
+ ffestb_local_.format.f = ffestt_formatlist_create (NULL,
+ ffelex_token_use (t));
+ ffelex_set_names_pure (TRUE); /* Have even free-form lexer give us
+ NAMES. */
+ return (ffelexHandler) ffestb_R10011_;
+
+ case FFELEX_typeOPEN_ARRAY:/* "(/". */
+ ffesta_confirmed ();
+ ffestb_local_.format.complained = FALSE;
+ ffestb_local_.format.f = ffestt_formatlist_create (NULL,
+ ffelex_token_use (t));
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeSLASH;
+ f->t = ffelex_token_use (t);
+ f->u.R1010.val.present = FALSE;
+ f->u.R1010.val.rtexpr = FALSE;
+ f->u.R1010.val.t = NULL;
+ f->u.R1010.val.u.unsigned_val = 1;
+ ffelex_set_names_pure (TRUE); /* Have even free-form lexer give us
+ NAMES. */
+ return (ffelexHandler) ffestb_R100112_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_R10011_ -- "FORMAT" OPEN_PAREN expr
+
+ return ffestb_R10011_; // to lexer
+
+ For CLOSE_PAREN, wrap up the format list and if it is the top-level one,
+ exit. For anything else, pass it to _2_. */
+
+static ffelexHandler
+ffestb_R10011_ (ffelexToken t)
+{
+ ffesttFormatList f;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ break;
+
+ default:
+ return (ffelexHandler) ffestb_R10012_ (t);
+ }
+
+ /* If we have a format we're working on, continue working on it. */
+
+ f = ffestb_local_.format.f->u.root.parent;
+
+ if (f != NULL)
+ {
+ ffestb_local_.format.f = f->next;
+ return (ffelexHandler) ffestb_R100111_;
+ }
+
+ return (ffelexHandler) ffestb_R100114_;
+}
+
+/* ffestb_R10012_ -- "FORMAT" OPEN_PAREN [format-item-list]
+
+ return ffestb_R10012_; // to lexer
+
+ The initial state for a format-item. Here, just handle the initial
+ number, sign for number, or run-time expression. Also handle spurious
+ comma, close-paren (indicating spurious comma), close-array (like
+ close-paren but preceded by slash), and quoted strings. */
+
+static ffelexHandler
+ffestb_R10012_ (ffelexToken t)
+{
+ unsigned long unsigned_val;
+ ffesttFormatList f;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_ANGLE:
+ ffesta_confirmed ();
+ ffestb_local_.format.pre.t = ffelex_token_use (t);
+ ffelex_set_names_pure (FALSE);
+ if (!ffesta_seen_first_exec && !ffestb_local_.format.complained)
+ {
+ ffestb_local_.format.complained = TRUE;
+ ffebad_start (FFEBAD_FORMAT_EXPR_SPEC);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFORMAT, (ffeexprCallback) ffestb_R100115_);
+
+ case FFELEX_typeNUMBER:
+ ffestb_local_.format.sign = FALSE; /* No sign present. */
+ ffestb_local_.format.pre.present = TRUE;
+ ffestb_local_.format.pre.rtexpr = FALSE;
+ ffestb_local_.format.pre.t = ffelex_token_use (t);
+ ffestb_local_.format.pre.u.unsigned_val = unsigned_val
+ = strtoul (ffelex_token_text (t), NULL, 10);
+ ffelex_set_expecting_hollerith (unsigned_val, '\0',
+ ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ return (ffelexHandler) ffestb_R10014_;
+
+ case FFELEX_typePLUS:
+ ffestb_local_.format.sign = TRUE; /* Positive. */
+ ffestb_local_.format.pre.t = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R10013_;
+
+ case FFELEX_typeMINUS:
+ ffestb_local_.format.sign = FALSE; /* Negative. */
+ ffestb_local_.format.pre.t = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R10013_;
+
+ case FFELEX_typeCOLON:
+ case FFELEX_typeCOLONCOLON:/* "::". */
+ case FFELEX_typeSLASH:
+ case FFELEX_typeCONCAT: /* "//". */
+ case FFELEX_typeNAMES:
+ case FFELEX_typeDOLLAR:
+ case FFELEX_typeOPEN_PAREN:
+ case FFELEX_typeOPEN_ARRAY:/* "(/". */
+ ffestb_local_.format.sign = FALSE; /* No sign present. */
+ ffestb_local_.format.pre.present = FALSE;
+ ffestb_local_.format.pre.rtexpr = FALSE;
+ ffestb_local_.format.pre.t = NULL;
+ ffestb_local_.format.pre.u.unsigned_val = 1;
+ return (ffelexHandler) ffestb_R10014_ (t);
+
+ case FFELEX_typeCOMMA:
+ ffebad_start (FFEBAD_FORMAT_EXTRA_COMMA);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ return (ffelexHandler) ffestb_R10012_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ ffebad_start (FFEBAD_FORMAT_EXTRA_COMMA);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ f = ffestb_local_.format.f->u.root.parent;
+ if (f == NULL)
+ return (ffelexHandler) ffestb_R100114_;
+ ffestb_local_.format.f = f->next;
+ return (ffelexHandler) ffestb_R100111_;
+
+ case FFELEX_typeCLOSE_ARRAY: /* "/)". */
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeSLASH;
+ f->t = ffelex_token_use (t);
+ f->u.R1010.val.present = FALSE;
+ f->u.R1010.val.rtexpr = FALSE;
+ f->u.R1010.val.t = NULL;
+ f->u.R1010.val.u.unsigned_val = 1;
+ f = ffestb_local_.format.f->u.root.parent;
+ if (f == NULL)
+ return (ffelexHandler) ffestb_R100114_;
+ ffestb_local_.format.f = f->next;
+ return (ffelexHandler) ffestb_R100111_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_PAREN, t);
+ for (f = ffestb_local_.format.f;
+ f->u.root.parent != NULL;
+ f = f->u.root.parent->next)
+ ;
+ ffestb_local_.format.f = f;
+ return (ffelexHandler) ffestb_R100114_ (t);
+
+ case FFELEX_typeQUOTE:
+ if (ffe_is_vxt ())
+ break; /* Error, probably something like FORMAT("17)
+ = X. */
+ ffelex_set_expecting_hollerith (-1, '\"',
+ ffelex_token_where_line (t),
+ ffelex_token_where_column (t)); /* Don't have to unset
+ this one. */
+ return (ffelexHandler) ffestb_R100113_;
+
+ case FFELEX_typeAPOSTROPHE:
+#if 0 /* No apparent need for this, and not killed
+ anywhere. */
+ ffesta_tokens[1] = ffelex_token_use (t);
+#endif
+ ffelex_set_expecting_hollerith (-1, '\'',
+ ffelex_token_where_line (t),
+ ffelex_token_where_column (t)); /* Don't have to unset
+ this one. */
+ return (ffelexHandler) ffestb_R100113_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
+ ffestt_formatlist_kill (ffestb_local_.format.f);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R10013_ -- "FORMAT" OPEN_PAREN [format-item-list] PLUS/MINUS
+
+ return ffestb_R10013_; // to lexer
+
+ Expect a NUMBER or complain about and then ignore the PLUS/MINUS. */
+
+static ffelexHandler
+ffestb_R10013_ (ffelexToken t)
+{
+ unsigned long unsigned_val;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffestb_local_.format.pre.present = TRUE;
+ ffestb_local_.format.pre.rtexpr = FALSE;
+ unsigned_val = strtoul (ffelex_token_text (t), NULL, 10);
+ ffestb_local_.format.pre.u.signed_val = ffestb_local_.format.sign
+ ? unsigned_val : -unsigned_val;
+ ffestb_local_.format.sign = TRUE; /* Sign present. */
+ return (ffelexHandler) ffestb_R10014_;
+
+ default:
+ ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
+ ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
+ ffelex_token_where_column (ffestb_local_.format.pre.t));
+ ffebad_finish ();
+ ffelex_token_kill (ffestb_local_.format.pre.t);
+ return (ffelexHandler) ffestb_R10012_ (t);
+ }
+}
+
+/* ffestb_R10014_ -- "FORMAT" OPEN_PAREN [format-item-list] [[+/-] NUMBER]
+
+ return ffestb_R10014_; // to lexer
+
+ Here is where we expect to see the actual NAMES, COLON, SLASH, OPEN_PAREN,
+ OPEN_ARRAY, COLONCOLON, CONCAT, DOLLAR, or HOLLERITH that identifies what
+ kind of format-item we're dealing with. But if we see a NUMBER instead, it
+ means free-form spaces number like "5 6 X", so scale the current number
+ accordingly and reenter this state. (I really wouldn't be surprised if
+ they change this spacing rule in the F90 spec so that you can't embed
+ spaces within numbers or within keywords like BN in a free-source-form
+ program.) */
+
+static ffelexHandler
+ffestb_R10014_ (ffelexToken t)
+{
+ ffesttFormatList f;
+ ffeTokenLength i;
+ char *p;
+ ffestrFormat kw;
+
+ ffelex_set_expecting_hollerith (0, '\0',
+ ffewhere_line_unknown (),
+ ffewhere_column_unknown ());
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeHOLLERITH:
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeR1016;
+ f->t = ffelex_token_use (t);
+ ffelex_token_kill (ffestb_local_.format.pre.t); /* It WAS present! */
+ return (ffelexHandler) ffestb_R100111_;
+
+ case FFELEX_typeNUMBER:
+ assert (ffestb_local_.format.pre.present);
+ ffesta_confirmed ();
+ if (ffestb_local_.format.pre.rtexpr)
+ {
+ ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ return (ffelexHandler) ffestb_R10014_;
+ }
+ if (ffestb_local_.format.sign)
+ {
+ for (i = 0; i < ffelex_token_length (t); ++i)
+ ffestb_local_.format.pre.u.signed_val *= 10;
+ ffestb_local_.format.pre.u.signed_val += strtoul (ffelex_token_text (t),
+ NULL, 10);
+ }
+ else
+ {
+ for (i = 0; i < ffelex_token_length (t); ++i)
+ ffestb_local_.format.pre.u.unsigned_val *= 10;
+ ffestb_local_.format.pre.u.unsigned_val += strtoul (ffelex_token_text (t),
+ NULL, 10);
+ ffelex_set_expecting_hollerith (ffestb_local_.format.pre.u.unsigned_val,
+ '\0',
+ ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ }
+ return (ffelexHandler) ffestb_R10014_;
+
+ case FFELEX_typeCOLONCOLON: /* "::". */
+ if (ffestb_local_.format.pre.present)
+ {
+ ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_COLON_SPEC,
+ ffestb_local_.format.pre.t);
+ ffelex_token_kill (ffestb_local_.format.pre.t);
+ ffestb_local_.format.pre.present = FALSE;
+ }
+ else
+ {
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeCOLON;
+ f->t = ffelex_token_use (t);
+ f->u.R1010.val.present = FALSE;
+ f->u.R1010.val.rtexpr = FALSE;
+ f->u.R1010.val.t = NULL;
+ f->u.R1010.val.u.unsigned_val = 1;
+ }
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeCOLON;
+ f->t = ffelex_token_use (t);
+ f->u.R1010.val.present = FALSE;
+ f->u.R1010.val.rtexpr = FALSE;
+ f->u.R1010.val.t = NULL;
+ f->u.R1010.val.u.unsigned_val = 1;
+ return (ffelexHandler) ffestb_R100112_;
+
+ case FFELEX_typeCOLON:
+ if (ffestb_local_.format.pre.present)
+ {
+ ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_COLON_SPEC,
+ ffestb_local_.format.pre.t);
+ ffelex_token_kill (ffestb_local_.format.pre.t);
+ return (ffelexHandler) ffestb_R100112_;
+ }
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeCOLON;
+ f->t = ffelex_token_use (t);
+ f->u.R1010.val.present = FALSE;
+ f->u.R1010.val.rtexpr = FALSE;
+ f->u.R1010.val.t = NULL;
+ f->u.R1010.val.u.unsigned_val = 1;
+ return (ffelexHandler) ffestb_R100112_;
+
+ case FFELEX_typeCONCAT: /* "//". */
+ if (ffestb_local_.format.sign)
+ {
+ ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
+ ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
+ ffelex_token_where_column (ffestb_local_.format.pre.t));
+ ffebad_finish ();
+ ffestb_local_.format.pre.u.unsigned_val
+ = (ffestb_local_.format.pre.u.signed_val < 0)
+ ? -ffestb_local_.format.pre.u.signed_val
+ : ffestb_local_.format.pre.u.signed_val;
+ }
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeSLASH;
+ f->t = ffelex_token_use (t);
+ f->u.R1010.val = ffestb_local_.format.pre;
+ ffestb_local_.format.pre.present = FALSE;
+ ffestb_local_.format.pre.rtexpr = FALSE;
+ ffestb_local_.format.pre.t = NULL;
+ ffestb_local_.format.pre.u.unsigned_val = 1;
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeSLASH;
+ f->t = ffelex_token_use (t);
+ f->u.R1010.val = ffestb_local_.format.pre;
+ return (ffelexHandler) ffestb_R100112_;
+
+ case FFELEX_typeSLASH:
+ if (ffestb_local_.format.sign)
+ {
+ ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
+ ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
+ ffelex_token_where_column (ffestb_local_.format.pre.t));
+ ffebad_finish ();
+ ffestb_local_.format.pre.u.unsigned_val
+ = (ffestb_local_.format.pre.u.signed_val < 0)
+ ? -ffestb_local_.format.pre.u.signed_val
+ : ffestb_local_.format.pre.u.signed_val;
+ }
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeSLASH;
+ f->t = ffelex_token_use (t);
+ f->u.R1010.val = ffestb_local_.format.pre;
+ return (ffelexHandler) ffestb_R100112_;
+
+ case FFELEX_typeOPEN_PAREN:
+ if (ffestb_local_.format.sign)
+ {
+ ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
+ ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
+ ffelex_token_where_column (ffestb_local_.format.pre.t));
+ ffebad_finish ();
+ ffestb_local_.format.pre.u.unsigned_val
+ = (ffestb_local_.format.pre.u.signed_val < 0)
+ ? -ffestb_local_.format.pre.u.signed_val
+ : ffestb_local_.format.pre.u.signed_val;
+ }
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeFORMAT;
+ f->t = ffelex_token_use (t);
+ f->u.R1003D.R1004 = ffestb_local_.format.pre;
+ f->u.R1003D.format = ffestb_local_.format.f
+ = ffestt_formatlist_create (f, ffelex_token_use (t));
+ return (ffelexHandler) ffestb_R10011_;
+
+ case FFELEX_typeOPEN_ARRAY:/* "(/". */
+ if (ffestb_local_.format.sign)
+ {
+ ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
+ ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
+ ffelex_token_where_column (ffestb_local_.format.pre.t));
+ ffebad_finish ();
+ ffestb_local_.format.pre.u.unsigned_val
+ = (ffestb_local_.format.pre.u.signed_val < 0)
+ ? -ffestb_local_.format.pre.u.signed_val
+ : ffestb_local_.format.pre.u.signed_val;
+ }
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeFORMAT;
+ f->t = ffelex_token_use (t);
+ f->u.R1003D.R1004 = ffestb_local_.format.pre;
+ f->u.R1003D.format = ffestb_local_.format.f
+ = ffestt_formatlist_create (f, ffelex_token_use (t));
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeSLASH;
+ f->t = ffelex_token_use (t);
+ f->u.R1010.val.present = FALSE;
+ f->u.R1010.val.rtexpr = FALSE;
+ f->u.R1010.val.t = NULL;
+ f->u.R1010.val.u.unsigned_val = 1;
+ return (ffelexHandler) ffestb_R100112_;
+
+ case FFELEX_typeCLOSE_ARRAY: /* "/)". */
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeSLASH;
+ f->t = ffelex_token_use (t);
+ f->u.R1010.val = ffestb_local_.format.pre;
+ f = ffestb_local_.format.f->u.root.parent;
+ if (f == NULL)
+ return (ffelexHandler) ffestb_R100114_;
+ ffestb_local_.format.f = f->next;
+ return (ffelexHandler) ffestb_R100111_;
+
+ case FFELEX_typeQUOTE:
+ if (ffe_is_vxt ())
+ break; /* A totally bad character in a VXT FORMAT. */
+ ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
+ ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
+ ffelex_token_where_column (ffestb_local_.format.pre.t));
+ ffebad_finish ();
+ ffelex_token_kill (ffestb_local_.format.pre.t);
+ ffesta_confirmed ();
+#if 0 /* No apparent need for this, and not killed
+ anywhere. */
+ ffesta_tokens[1] = ffelex_token_use (t);
+#endif
+ ffelex_set_expecting_hollerith (-1, '\"',
+ ffelex_token_where_line (t),
+ ffelex_token_where_column (t)); /* Don't have to unset
+ this one. */
+ return (ffelexHandler) ffestb_R100113_;
+
+ case FFELEX_typeAPOSTROPHE:
+ ffesta_confirmed ();
+ ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
+ ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
+ ffelex_token_where_column (ffestb_local_.format.pre.t));
+ ffebad_finish ();
+ ffelex_token_kill (ffestb_local_.format.pre.t);
+#if 0 /* No apparent need for this, and not killed
+ anywhere. */
+ ffesta_tokens[1] = ffelex_token_use (t);
+#endif
+ ffelex_set_expecting_hollerith (-1, '\'', ffelex_token_where_line (t),
+ ffelex_token_where_column (t)); /* Don't have to unset
+ this one. */
+ return (ffelexHandler) ffestb_R100113_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_PAREN, t);
+ for (f = ffestb_local_.format.f;
+ f->u.root.parent != NULL;
+ f = f->u.root.parent->next)
+ ;
+ ffestb_local_.format.f = f;
+ ffelex_token_kill (ffestb_local_.format.pre.t);
+ return (ffelexHandler) ffestb_R100114_ (t);
+
+ case FFELEX_typeDOLLAR:
+ ffestb_local_.format.t = ffelex_token_use (t);
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed (); /* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeDOLLAR;
+ return (ffelexHandler) ffestb_R10015_;
+
+ case FFELEX_typeNAMES:
+ kw = ffestr_format (t);
+ ffestb_local_.format.t = ffelex_token_use (t);
+ switch (kw)
+ {
+ case FFESTR_formatI:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeI;
+ i = FFESTR_formatlI;
+ break;
+
+ case FFESTR_formatB:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeB;
+ i = FFESTR_formatlB;
+ break;
+
+ case FFESTR_formatO:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeO;
+ i = FFESTR_formatlO;
+ break;
+
+ case FFESTR_formatZ:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeZ;
+ i = FFESTR_formatlZ;
+ break;
+
+ case FFESTR_formatF:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeF;
+ i = FFESTR_formatlF;
+ break;
+
+ case FFESTR_formatE:
+ ffestb_local_.format.current = FFESTP_formattypeE;
+ i = FFESTR_formatlE;
+ break;
+
+ case FFESTR_formatEN:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeEN;
+ i = FFESTR_formatlEN;
+ break;
+
+ case FFESTR_formatG:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeG;
+ i = FFESTR_formatlG;
+ break;
+
+ case FFESTR_formatL:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeL;
+ i = FFESTR_formatlL;
+ break;
+
+ case FFESTR_formatA:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeA;
+ i = FFESTR_formatlA;
+ break;
+
+ case FFESTR_formatD:
+ ffestb_local_.format.current = FFESTP_formattypeD;
+ i = FFESTR_formatlD;
+ break;
+
+ case FFESTR_formatQ:
+ ffestb_local_.format.current = FFESTP_formattypeQ;
+ i = FFESTR_formatlQ;
+ break;
+
+ case FFESTR_formatDOLLAR:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeDOLLAR;
+ i = FFESTR_formatlDOLLAR;
+ break;
+
+ case FFESTR_formatP:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeP;
+ i = FFESTR_formatlP;
+ break;
+
+ case FFESTR_formatT:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeT;
+ i = FFESTR_formatlT;
+ break;
+
+ case FFESTR_formatTL:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeTL;
+ i = FFESTR_formatlTL;
+ break;
+
+ case FFESTR_formatTR:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeTR;
+ i = FFESTR_formatlTR;
+ break;
+
+ case FFESTR_formatX:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeX;
+ i = FFESTR_formatlX;
+ break;
+
+ case FFESTR_formatS:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeS;
+ i = FFESTR_formatlS;
+ break;
+
+ case FFESTR_formatSP:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeSP;
+ i = FFESTR_formatlSP;
+ break;
+
+ case FFESTR_formatSS:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeSS;
+ i = FFESTR_formatlSS;
+ break;
+
+ case FFESTR_formatBN:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeBN;
+ i = FFESTR_formatlBN;
+ break;
+
+ case FFESTR_formatBZ:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeBZ;
+ i = FFESTR_formatlBZ;
+ break;
+
+ case FFESTR_formatH: /* Error, either "H" or "<expr>H". */
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeH;
+ i = FFESTR_formatlH;
+ break;
+
+ case FFESTR_formatPD:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_subr_R1001_append_p_ ();
+ ffestb_local_.format.t = ffelex_token_name_from_names (t,
+ FFESTR_formatlP, 1);
+ ffestb_local_.format.sign = FALSE;
+ ffestb_local_.format.pre.present = FALSE;
+ ffestb_local_.format.pre.rtexpr = FALSE;
+ ffestb_local_.format.pre.t = NULL;
+ ffestb_local_.format.pre.u.unsigned_val = 1;
+ ffestb_local_.format.current = FFESTP_formattypeD;
+ i = FFESTR_formatlPD;
+ break;
+
+ case FFESTR_formatPE:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_subr_R1001_append_p_ ();
+ ffestb_local_.format.t = ffelex_token_name_from_names (t,
+ FFESTR_formatlP, 1);
+ ffestb_local_.format.sign = FALSE;
+ ffestb_local_.format.pre.present = FALSE;
+ ffestb_local_.format.pre.rtexpr = FALSE;
+ ffestb_local_.format.pre.t = NULL;
+ ffestb_local_.format.pre.u.unsigned_val = 1;
+ ffestb_local_.format.current = FFESTP_formattypeE;
+ i = FFESTR_formatlPE;
+ break;
+
+ case FFESTR_formatPEN:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_subr_R1001_append_p_ ();
+ ffestb_local_.format.t = ffelex_token_name_from_names (t,
+ FFESTR_formatlP, 1);
+ ffestb_local_.format.sign = FALSE;
+ ffestb_local_.format.pre.present = FALSE;
+ ffestb_local_.format.pre.rtexpr = FALSE;
+ ffestb_local_.format.pre.t = NULL;
+ ffestb_local_.format.pre.u.unsigned_val = 1;
+ ffestb_local_.format.current = FFESTP_formattypeEN;
+ i = FFESTR_formatlPEN;
+ break;
+
+ case FFESTR_formatPF:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_subr_R1001_append_p_ ();
+ ffestb_local_.format.t = ffelex_token_name_from_names (t,
+ FFESTR_formatlP, 1);
+ ffestb_local_.format.sign = FALSE;
+ ffestb_local_.format.pre.present = FALSE;
+ ffestb_local_.format.pre.rtexpr = FALSE;
+ ffestb_local_.format.pre.t = NULL;
+ ffestb_local_.format.pre.u.unsigned_val = 1;
+ ffestb_local_.format.current = FFESTP_formattypeF;
+ i = FFESTR_formatlPF;
+ break;
+
+ case FFESTR_formatPG:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_subr_R1001_append_p_ ();
+ ffestb_local_.format.t = ffelex_token_name_from_names (t,
+ FFESTR_formatlP, 1);
+ ffestb_local_.format.sign = FALSE;
+ ffestb_local_.format.pre.present = FALSE;
+ ffestb_local_.format.pre.rtexpr = FALSE;
+ ffestb_local_.format.pre.t = NULL;
+ ffestb_local_.format.pre.u.unsigned_val = 1;
+ ffestb_local_.format.current = FFESTP_formattypeG;
+ i = FFESTR_formatlPG;
+ break;
+
+ default:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ p = strpbrk (ffelex_token_text (t), "0123456789");
+ if (p == NULL)
+ i = ffelex_token_length (t);
+ else
+ i = p - ffelex_token_text (t);
+ break;
+ }
+ p = ffelex_token_text (t) + i;
+ if (*p == '\0')
+ return (ffelexHandler) ffestb_R10015_;
+ if (!isdigit (*p))
+ {
+ if (ffestb_local_.format.current == FFESTP_formattypeH)
+ p = strpbrk (p, "0123456789");
+ else
+ {
+ p = NULL;
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ }
+ if (p == NULL)
+ return (ffelexHandler) ffestb_R10015_;
+ i = p - ffelex_token_text (t); /* Collect digits. */
+ }
+ ffestb_local_.format.post.present = TRUE;
+ ffestb_local_.format.post.rtexpr = FALSE;
+ ffestb_local_.format.post.t = ffelex_token_number_from_names (t, i);
+ ffestb_local_.format.post.u.unsigned_val
+ = strtoul (ffelex_token_text (ffestb_local_.format.post.t), NULL, 10);
+ p += ffelex_token_length (ffestb_local_.format.post.t);
+ i += ffelex_token_length (ffestb_local_.format.post.t);
+ if (*p == '\0')
+ return (ffelexHandler) ffestb_R10016_;
+ if ((kw != FFESTR_formatP) || !ffelex_is_firstnamechar (*p))
+ {
+ if (ffestb_local_.format.current != FFESTP_formattypeH)
+ ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL);
+ return (ffelexHandler) ffestb_R10016_;
+ }
+
+ /* Here we have [number]P[number][text]. Treat as
+ [number]P,[number][text]. */
+
+ ffestb_subr_R1001_append_p_ ();
+ t = ffestb_local_.format.t = ffelex_token_names_from_names (t, i, 0);
+ ffestb_local_.format.sign = FALSE;
+ ffestb_local_.format.pre = ffestb_local_.format.post;
+ kw = ffestr_format (t);
+ switch (kw)
+ { /* Only a few possibilities here. */
+ case FFESTR_formatD:
+ ffestb_local_.format.current = FFESTP_formattypeD;
+ i = FFESTR_formatlD;
+ break;
+
+ case FFESTR_formatE:
+ ffestb_local_.format.current = FFESTP_formattypeE;
+ i = FFESTR_formatlE;
+ break;
+
+ case FFESTR_formatEN:
+ ffestb_local_.format.current = FFESTP_formattypeEN;
+ i = FFESTR_formatlEN;
+ break;
+
+ case FFESTR_formatF:
+ ffestb_local_.format.current = FFESTP_formattypeF;
+ i = FFESTR_formatlF;
+ break;
+
+ case FFESTR_formatG:
+ ffestb_local_.format.current = FFESTP_formattypeG;
+ i = FFESTR_formatlG;
+ break;
+
+ default:
+ ffebad_start (FFEBAD_FORMAT_P_NOCOMMA);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ p = strpbrk (ffelex_token_text (t), "0123456789");
+ if (p == NULL)
+ i = ffelex_token_length (t);
+ else
+ i = p - ffelex_token_text (t);
+ }
+ p = ffelex_token_text (t) + i;
+ if (*p == '\0')
+ return (ffelexHandler) ffestb_R10015_;
+ if (!isdigit (*p))
+ {
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ p = strpbrk (p, "0123456789");
+ if (p == NULL)
+ return (ffelexHandler) ffestb_R10015_;
+ i = p - ffelex_token_text (t); /* Collect digits anyway. */
+ }
+ ffestb_local_.format.post.present = TRUE;
+ ffestb_local_.format.post.rtexpr = FALSE;
+ ffestb_local_.format.post.t = ffelex_token_number_from_names (t, i);
+ ffestb_local_.format.post.u.unsigned_val
+ = strtoul (ffelex_token_text (ffestb_local_.format.post.t), NULL, 10);
+ p += ffelex_token_length (ffestb_local_.format.post.t);
+ i += ffelex_token_length (ffestb_local_.format.post.t);
+ if (*p == '\0')
+ return (ffelexHandler) ffestb_R10016_;
+ ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL);
+ return (ffelexHandler) ffestb_R10016_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
+ if (ffestb_local_.format.pre.present)
+ ffelex_token_kill (ffestb_local_.format.pre.t);
+ ffestt_formatlist_kill (ffestb_local_.format.f);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R10015_ -- [[+/-] NUMBER] NAMES
+
+ return ffestb_R10015_; // to lexer
+
+ Here we've gotten at least the initial mnemonic for the edit descriptor.
+ We expect either a NUMBER, for the post-mnemonic value, a NAMES, for
+ further clarification (in free-form only, sigh) of the mnemonic, or
+ anything else. In all cases we go to _6_, with the difference that for
+ NUMBER and NAMES we send the next token rather than the current token. */
+
+static ffelexHandler
+ffestb_R10015_ (ffelexToken t)
+{
+ bool split_pea; /* New NAMES requires splitting kP from new
+ edit desc. */
+ ffestrFormat kw;
+ char *p;
+ ffeTokenLength i;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_ANGLE:
+ ffesta_confirmed ();
+ ffestb_local_.format.post.t = ffelex_token_use (t);
+ ffelex_set_names_pure (FALSE);
+ if (!ffesta_seen_first_exec && !ffestb_local_.format.complained)
+ {
+ ffestb_local_.format.complained = TRUE;
+ ffebad_start (FFEBAD_FORMAT_EXPR_SPEC);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFORMAT, (ffeexprCallback) ffestb_R100116_);
+
+ case FFELEX_typeNUMBER:
+ ffestb_local_.format.post.present = TRUE;
+ ffestb_local_.format.post.rtexpr = FALSE;
+ ffestb_local_.format.post.t = ffelex_token_use (t);
+ ffestb_local_.format.post.u.unsigned_val
+ = strtoul (ffelex_token_text (t), NULL, 10);
+ return (ffelexHandler) ffestb_R10016_;
+
+ case FFELEX_typeNAMES:
+ ffesta_confirmed (); /* NAMES " " NAMES invalid elsewhere in
+ free-form. */
+ kw = ffestr_format (t);
+ switch (ffestb_local_.format.current)
+ {
+ case FFESTP_formattypeP:
+ split_pea = TRUE;
+ break;
+
+ case FFESTP_formattypeH: /* An error, maintain this indicator. */
+ kw = FFESTR_formatNone;
+ split_pea = FALSE;
+ break;
+
+ default:
+ split_pea = FALSE;
+ break;
+ }
+
+ switch (kw)
+ {
+ case FFESTR_formatF:
+ switch (ffestb_local_.format.current)
+ {
+ case FFESTP_formattypeP:
+ ffestb_local_.format.current = FFESTP_formattypeF;
+ break;
+
+ default:
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ break;
+ }
+ i = FFESTR_formatlF;
+ break;
+
+ case FFESTR_formatE:
+ switch (ffestb_local_.format.current)
+ {
+ case FFESTP_formattypeP:
+ ffestb_local_.format.current = FFESTP_formattypeE;
+ break;
+
+ default:
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ break;
+ }
+ i = FFESTR_formatlE;
+ break;
+
+ case FFESTR_formatEN:
+ switch (ffestb_local_.format.current)
+ {
+ case FFESTP_formattypeP:
+ ffestb_local_.format.current = FFESTP_formattypeEN;
+ break;
+
+ default:
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ break;
+ }
+ i = FFESTR_formatlEN;
+ break;
+
+ case FFESTR_formatG:
+ switch (ffestb_local_.format.current)
+ {
+ case FFESTP_formattypeP:
+ ffestb_local_.format.current = FFESTP_formattypeG;
+ break;
+
+ default:
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ break;
+ }
+ i = FFESTR_formatlG;
+ break;
+
+ case FFESTR_formatL:
+ switch (ffestb_local_.format.current)
+ {
+ case FFESTP_formattypeT:
+ ffestb_local_.format.current = FFESTP_formattypeTL;
+ break;
+
+ default:
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ break;
+ }
+ i = FFESTR_formatlL;
+ break;
+
+ case FFESTR_formatD:
+ switch (ffestb_local_.format.current)
+ {
+ case FFESTP_formattypeP:
+ ffestb_local_.format.current = FFESTP_formattypeD;
+ break;
+
+ default:
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ break;
+ }
+ i = FFESTR_formatlD;
+ break;
+
+ case FFESTR_formatS:
+ switch (ffestb_local_.format.current)
+ {
+ case FFESTP_formattypeS:
+ ffestb_local_.format.current = FFESTP_formattypeSS;
+ break;
+
+ default:
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ break;
+ }
+ i = FFESTR_formatlS;
+ break;
+
+ case FFESTR_formatP:
+ switch (ffestb_local_.format.current)
+ {
+ case FFESTP_formattypeS:
+ ffestb_local_.format.current = FFESTP_formattypeSP;
+ break;
+
+ default:
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ break;
+ }
+ i = FFESTR_formatlP;
+ break;
+
+ case FFESTR_formatR:
+ switch (ffestb_local_.format.current)
+ {
+ case FFESTP_formattypeT:
+ ffestb_local_.format.current = FFESTP_formattypeTR;
+ break;
+
+ default:
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ break;
+ }
+ i = FFESTR_formatlR;
+ break;
+
+ case FFESTR_formatZ:
+ switch (ffestb_local_.format.current)
+ {
+ case FFESTP_formattypeB:
+ ffestb_local_.format.current = FFESTP_formattypeBZ;
+ break;
+
+ default:
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ break;
+ }
+ i = FFESTR_formatlZ;
+ break;
+
+ case FFESTR_formatN:
+ switch (ffestb_local_.format.current)
+ {
+ case FFESTP_formattypeE:
+ ffestb_local_.format.current = FFESTP_formattypeEN;
+ break;
+
+ case FFESTP_formattypeB:
+ ffestb_local_.format.current = FFESTP_formattypeBN;
+ break;
+
+ default:
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ break;
+ }
+ i = FFESTR_formatlN;
+ break;
+
+ default:
+ if (ffestb_local_.format.current != FFESTP_formattypeH)
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ split_pea = FALSE; /* Go ahead and let the P be in the party. */
+ p = strpbrk (ffelex_token_text (t), "0123456789");
+ if (p == NULL)
+ i = ffelex_token_length (t);
+ else
+ i = p - ffelex_token_text (t);
+ }
+
+ if (split_pea)
+ {
+ ffestb_subr_R1001_append_p_ ();
+ ffestb_local_.format.t = ffelex_token_use (t);
+ ffestb_local_.format.sign = FALSE;
+ ffestb_local_.format.pre.present = FALSE;
+ ffestb_local_.format.pre.rtexpr = FALSE;
+ ffestb_local_.format.pre.t = NULL;
+ ffestb_local_.format.pre.u.unsigned_val = 1;
+ }
+
+ p = ffelex_token_text (t) + i;
+ if (*p == '\0')
+ return (ffelexHandler) ffestb_R10015_;
+ if (!isdigit (*p))
+ {
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ p = strpbrk (p, "0123456789");
+ if (p == NULL)
+ return (ffelexHandler) ffestb_R10015_;
+ i = p - ffelex_token_text (t); /* Collect digits anyway. */
+ }
+ ffestb_local_.format.post.present = TRUE;
+ ffestb_local_.format.post.rtexpr = FALSE;
+ ffestb_local_.format.post.t = ffelex_token_number_from_names (t, i);
+ ffestb_local_.format.post.u.unsigned_val
+ = strtoul (ffelex_token_text (ffestb_local_.format.post.t), NULL, 10);
+ p += ffelex_token_length (ffestb_local_.format.post.t);
+ i += ffelex_token_length (ffestb_local_.format.post.t);
+ if (*p == '\0')
+ return (ffelexHandler) ffestb_R10016_;
+ ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL);
+ return (ffelexHandler) ffestb_R10016_;
+
+ default:
+ ffestb_local_.format.post.present = FALSE;
+ ffestb_local_.format.post.rtexpr = FALSE;
+ ffestb_local_.format.post.t = NULL;
+ ffestb_local_.format.post.u.unsigned_val = 1;
+ return (ffelexHandler) ffestb_R10016_ (t);
+ }
+}
+
+/* ffestb_R10016_ -- [[+/-] NUMBER] NAMES NUMBER
+
+ return ffestb_R10016_; // to lexer
+
+ Expect a PERIOD here. Maybe find a NUMBER to append to the current
+ number, in which case return to this state. Maybe find a NAMES to switch
+ from a kP descriptor to a new descriptor (else the NAMES is spurious),
+ in which case generator the P item and go to state _4_. Anything
+ else, pass token on to state _8_. */
+
+static ffelexHandler
+ffestb_R10016_ (ffelexToken t)
+{
+ ffeTokenLength i;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typePERIOD:
+ return (ffelexHandler) ffestb_R10017_;
+
+ case FFELEX_typeNUMBER:
+ assert (ffestb_local_.format.post.present);
+ ffesta_confirmed ();
+ if (ffestb_local_.format.post.rtexpr)
+ {
+ ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ return (ffelexHandler) ffestb_R10016_;
+ }
+ for (i = 0; i < ffelex_token_length (t); ++i)
+ ffestb_local_.format.post.u.unsigned_val *= 10;
+ ffestb_local_.format.post.u.unsigned_val += strtoul (ffelex_token_text (t),
+ NULL, 10);
+ return (ffelexHandler) ffestb_R10016_;
+
+ case FFELEX_typeNAMES:
+ ffesta_confirmed (); /* NUMBER " " NAMES invalid elsewhere. */
+ if (ffestb_local_.format.current != FFESTP_formattypeP)
+ {
+ ffesta_ffebad_1t (FFEBAD_FORMAT_TEXT_IN_NUMBER, t);
+ return (ffelexHandler) ffestb_R10016_;
+ }
+ ffestb_subr_R1001_append_p_ ();
+ ffestb_local_.format.sign = FALSE;
+ ffestb_local_.format.pre = ffestb_local_.format.post;
+ return (ffelexHandler) ffestb_R10014_ (t);
+
+ default:
+ ffestb_local_.format.dot.present = FALSE;
+ ffestb_local_.format.dot.rtexpr = FALSE;
+ ffestb_local_.format.dot.t = NULL;
+ ffestb_local_.format.dot.u.unsigned_val = 1;
+ return (ffelexHandler) ffestb_R10018_ (t);
+ }
+}
+
+/* ffestb_R10017_ -- [[+/-] NUMBER] NAMES NUMBER PERIOD
+
+ return ffestb_R10017_; // to lexer
+
+ Here we've gotten the period following the edit descriptor.
+ We expect either a NUMBER, for the dot value, or something else, which
+ probably means we're not even close to being in a real FORMAT statement. */
+
+static ffelexHandler
+ffestb_R10017_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_ANGLE:
+ ffestb_local_.format.dot.t = ffelex_token_use (t);
+ ffelex_set_names_pure (FALSE);
+ if (!ffesta_seen_first_exec && !ffestb_local_.format.complained)
+ {
+ ffestb_local_.format.complained = TRUE;
+ ffebad_start (FFEBAD_FORMAT_EXPR_SPEC);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFORMAT, (ffeexprCallback) ffestb_R100117_);
+
+ case FFELEX_typeNUMBER:
+ ffestb_local_.format.dot.present = TRUE;
+ ffestb_local_.format.dot.rtexpr = FALSE;
+ ffestb_local_.format.dot.t = ffelex_token_use (t);
+ ffestb_local_.format.dot.u.unsigned_val
+ = strtoul (ffelex_token_text (t), NULL, 10);
+ return (ffelexHandler) ffestb_R10018_;
+
+ default:
+ ffelex_token_kill (ffestb_local_.format.t);
+ if (ffestb_local_.format.pre.present)
+ ffelex_token_kill (ffestb_local_.format.pre.t);
+ if (ffestb_local_.format.post.present)
+ ffelex_token_kill (ffestb_local_.format.post.t);
+ ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_DOT, t);
+ ffestt_formatlist_kill (ffestb_local_.format.f);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ }
+}
+
+/* ffestb_R10018_ -- [[+/-] NUMBER] NAMES NUMBER PERIOD NUMBER
+
+ return ffestb_R10018_; // to lexer
+
+ Expect a NAMES here, which must begin with "E" to be valid. Maybe find a
+ NUMBER to append to the current number, in which case return to this state.
+ Anything else, pass token on to state _10_. */
+
+static ffelexHandler
+ffestb_R10018_ (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ assert (ffestb_local_.format.dot.present);
+ ffesta_confirmed ();
+ if (ffestb_local_.format.dot.rtexpr)
+ {
+ ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ return (ffelexHandler) ffestb_R10018_;
+ }
+ for (i = 0; i < ffelex_token_length (t); ++i)
+ ffestb_local_.format.dot.u.unsigned_val *= 10;
+ ffestb_local_.format.dot.u.unsigned_val += strtoul (ffelex_token_text (t),
+ NULL, 10);
+ return (ffelexHandler) ffestb_R10018_;
+
+ case FFELEX_typeNAMES:
+ if (!ffesrc_char_match_init (*(p = ffelex_token_text (t)), 'E', 'e'))
+ {
+ ffesta_ffebad_1t (FFEBAD_FORMAT_TEXT_IN_NUMBER, t);
+ return (ffelexHandler) ffestb_R10018_;
+ }
+ if (*++p == '\0')
+ return (ffelexHandler) ffestb_R10019_; /* Go get NUMBER. */
+ i = 1;
+ if (!isdigit (*p))
+ {
+ ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, 1, NULL);
+ return (ffelexHandler) ffestb_R10018_;
+ }
+ ffestb_local_.format.exp.present = TRUE;
+ ffestb_local_.format.exp.rtexpr = FALSE;
+ ffestb_local_.format.exp.t = ffelex_token_number_from_names (t, i);
+ ffestb_local_.format.exp.u.unsigned_val
+ = strtoul (ffelex_token_text (ffestb_local_.format.exp.t), NULL, 10);
+ p += ffelex_token_length (ffestb_local_.format.exp.t);
+ i += ffelex_token_length (ffestb_local_.format.exp.t);
+ if (*p == '\0')
+ return (ffelexHandler) ffestb_R100110_;
+ ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL);
+ return (ffelexHandler) ffestb_R100110_;
+
+ default:
+ ffestb_local_.format.exp.present = FALSE;
+ ffestb_local_.format.exp.rtexpr = FALSE;
+ ffestb_local_.format.exp.t = NULL;
+ ffestb_local_.format.exp.u.unsigned_val = 1;
+ return (ffelexHandler) ffestb_R100110_ (t);
+ }
+}
+
+/* ffestb_R10019_ -- [[+/-] NUMBER] NAMES NUMBER PERIOD NUMBER "E"
+
+ return ffestb_R10019_; // to lexer
+
+ Here we've gotten the "E" following the edit descriptor.
+ We expect either a NUMBER, for the exponent value, or something else. */
+
+static ffelexHandler
+ffestb_R10019_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_ANGLE:
+ ffestb_local_.format.exp.t = ffelex_token_use (t);
+ ffelex_set_names_pure (FALSE);
+ if (!ffesta_seen_first_exec && !ffestb_local_.format.complained)
+ {
+ ffestb_local_.format.complained = TRUE;
+ ffebad_start (FFEBAD_FORMAT_EXPR_SPEC);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFORMAT, (ffeexprCallback) ffestb_R100118_);
+
+ case FFELEX_typeNUMBER:
+ ffestb_local_.format.exp.present = TRUE;
+ ffestb_local_.format.exp.rtexpr = FALSE;
+ ffestb_local_.format.exp.t = ffelex_token_use (t);
+ ffestb_local_.format.exp.u.unsigned_val
+ = strtoul (ffelex_token_text (t), NULL, 10);
+ return (ffelexHandler) ffestb_R100110_;
+
+ default:
+ ffelex_token_kill (ffestb_local_.format.t);
+ if (ffestb_local_.format.pre.present)
+ ffelex_token_kill (ffestb_local_.format.pre.t);
+ if (ffestb_local_.format.post.present)
+ ffelex_token_kill (ffestb_local_.format.post.t);
+ if (ffestb_local_.format.dot.present)
+ ffelex_token_kill (ffestb_local_.format.dot.t);
+ ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_EXP, t);
+ ffestt_formatlist_kill (ffestb_local_.format.f);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ }
+}
+
+/* ffestb_R100110_ -- [[+/-] NUMBER] NAMES NUMBER [PERIOD NUMBER ["E" NUMBER]]
+
+ return ffestb_R100110_; // to lexer
+
+ Maybe find a NUMBER to append to the current number, in which case return
+ to this state. Anything else, handle current descriptor, then pass token
+ on to state _10_. */
+
+static ffelexHandler
+ffestb_R100110_ (ffelexToken t)
+{
+ ffeTokenLength i;
+ enum expect
+ {
+ required,
+ optional,
+ disallowed
+ };
+ ffebad err;
+ enum expect pre;
+ enum expect post;
+ enum expect dot;
+ enum expect exp;
+ bool R1005;
+ ffesttFormatList f;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ assert (ffestb_local_.format.exp.present);
+ ffesta_confirmed ();
+ if (ffestb_local_.format.exp.rtexpr)
+ {
+ ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ return (ffelexHandler) ffestb_R100110_;
+ }
+ for (i = 0; i < ffelex_token_length (t); ++i)
+ ffestb_local_.format.exp.u.unsigned_val *= 10;
+ ffestb_local_.format.exp.u.unsigned_val += strtoul (ffelex_token_text (t),
+ NULL, 10);
+ return (ffelexHandler) ffestb_R100110_;
+
+ default:
+ if (ffestb_local_.format.sign
+ && (ffestb_local_.format.current != FFESTP_formattypeP)
+ && (ffestb_local_.format.current != FFESTP_formattypeH))
+ {
+ ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
+ ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
+ ffelex_token_where_column (ffestb_local_.format.pre.t));
+ ffebad_finish ();
+ ffestb_local_.format.pre.u.unsigned_val
+ = (ffestb_local_.format.pre.u.signed_val < 0)
+ ? -ffestb_local_.format.pre.u.signed_val
+ : ffestb_local_.format.pre.u.signed_val;
+ }
+ switch (ffestb_local_.format.current)
+ {
+ case FFESTP_formattypeI:
+ err = FFEBAD_FORMAT_BAD_I_SPEC;
+ pre = optional;
+ post = required;
+ dot = optional;
+ exp = disallowed;
+ R1005 = TRUE;
+ break;
+
+ case FFESTP_formattypeB:
+ err = FFEBAD_FORMAT_BAD_B_SPEC;
+ pre = optional;
+ post = required;
+ dot = optional;
+ exp = disallowed;
+ R1005 = TRUE;
+ break;
+
+ case FFESTP_formattypeO:
+ err = FFEBAD_FORMAT_BAD_O_SPEC;
+ pre = optional;
+ post = required;
+ dot = optional;
+ exp = disallowed;
+ R1005 = TRUE;
+ break;
+
+ case FFESTP_formattypeZ:
+ err = FFEBAD_FORMAT_BAD_Z_SPEC;
+ pre = optional;
+ post = required;
+ dot = optional;
+ exp = disallowed;
+ R1005 = TRUE;
+ break;
+
+ case FFESTP_formattypeF:
+ err = FFEBAD_FORMAT_BAD_F_SPEC;
+ pre = optional;
+ post = required;
+ dot = required;
+ exp = disallowed;
+ R1005 = TRUE;
+ break;
+
+ case FFESTP_formattypeE:
+ err = FFEBAD_FORMAT_BAD_E_SPEC;
+ pre = optional;
+ post = required;
+ dot = required;
+ exp = optional;
+ R1005 = TRUE;
+ break;
+
+ case FFESTP_formattypeEN:
+ err = FFEBAD_FORMAT_BAD_EN_SPEC;
+ pre = optional;
+ post = required;
+ dot = required;
+ exp = optional;
+ R1005 = TRUE;
+ break;
+
+ case FFESTP_formattypeG:
+ err = FFEBAD_FORMAT_BAD_G_SPEC;
+ pre = optional;
+ post = required;
+ dot = required;
+ exp = optional;
+ R1005 = TRUE;
+ break;
+
+ case FFESTP_formattypeL:
+ err = FFEBAD_FORMAT_BAD_L_SPEC;
+ pre = optional;
+ post = required;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = TRUE;
+ break;
+
+ case FFESTP_formattypeA:
+ err = FFEBAD_FORMAT_BAD_A_SPEC;
+ pre = optional;
+ post = optional;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = TRUE;
+ break;
+
+ case FFESTP_formattypeD:
+ err = FFEBAD_FORMAT_BAD_D_SPEC;
+ pre = optional;
+ post = required;
+ dot = required;
+ exp = disallowed;
+ R1005 = TRUE;
+ break;
+
+ case FFESTP_formattypeQ:
+ err = FFEBAD_FORMAT_BAD_Q_SPEC;
+ pre = disallowed;
+ post = disallowed;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = FALSE;
+ break;
+
+ case FFESTP_formattypeDOLLAR:
+ err = FFEBAD_FORMAT_BAD_DOLLAR_SPEC;
+ pre = disallowed;
+ post = disallowed;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = FALSE;
+ break;
+
+ case FFESTP_formattypeP:
+ err = FFEBAD_FORMAT_BAD_P_SPEC;
+ pre = required;
+ post = disallowed;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = FALSE;
+ break;
+
+ case FFESTP_formattypeT:
+ err = FFEBAD_FORMAT_BAD_T_SPEC;
+ pre = disallowed;
+ post = required;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = FALSE;
+ break;
+
+ case FFESTP_formattypeTL:
+ err = FFEBAD_FORMAT_BAD_TL_SPEC;
+ pre = disallowed;
+ post = required;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = FALSE;
+ break;
+
+ case FFESTP_formattypeTR:
+ err = FFEBAD_FORMAT_BAD_TR_SPEC;
+ pre = disallowed;
+ post = required;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = FALSE;
+ break;
+
+ case FFESTP_formattypeX:
+ err = FFEBAD_FORMAT_BAD_X_SPEC;
+ pre = required;
+ post = disallowed;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = FALSE;
+ break;
+
+ case FFESTP_formattypeS:
+ err = FFEBAD_FORMAT_BAD_S_SPEC;
+ pre = disallowed;
+ post = disallowed;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = FALSE;
+ break;
+
+ case FFESTP_formattypeSP:
+ err = FFEBAD_FORMAT_BAD_SP_SPEC;
+ pre = disallowed;
+ post = disallowed;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = FALSE;
+ break;
+
+ case FFESTP_formattypeSS:
+ err = FFEBAD_FORMAT_BAD_SS_SPEC;
+ pre = disallowed;
+ post = disallowed;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = FALSE;
+ break;
+
+ case FFESTP_formattypeBN:
+ err = FFEBAD_FORMAT_BAD_BN_SPEC;
+ pre = disallowed;
+ post = disallowed;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = FALSE;
+ break;
+
+ case FFESTP_formattypeBZ:
+ err = FFEBAD_FORMAT_BAD_BZ_SPEC;
+ pre = disallowed;
+ post = disallowed;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = FALSE;
+ break;
+
+ case FFESTP_formattypeH: /* Definitely an error, make sure of
+ it. */
+ err = FFEBAD_FORMAT_BAD_H_SPEC;
+ pre = ffestb_local_.format.pre.present ? disallowed : required;
+ post = disallowed;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = FALSE;
+ break;
+
+ case FFESTP_formattypeNone:
+ ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_SPEC,
+ ffestb_local_.format.t);
+
+ clean_up_to_11_: /* :::::::::::::::::::: */
+
+ ffelex_token_kill (ffestb_local_.format.t);
+ if (ffestb_local_.format.pre.present)
+ ffelex_token_kill (ffestb_local_.format.pre.t);
+ if (ffestb_local_.format.post.present)
+ ffelex_token_kill (ffestb_local_.format.post.t);
+ if (ffestb_local_.format.dot.present)
+ ffelex_token_kill (ffestb_local_.format.dot.t);
+ if (ffestb_local_.format.exp.present)
+ ffelex_token_kill (ffestb_local_.format.exp.t);
+ return (ffelexHandler) ffestb_R100111_ (t);
+
+ default:
+ assert (FALSE);
+ err = FFEBAD_FORMAT_BAD_H_SPEC;
+ pre = disallowed;
+ post = disallowed;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = FALSE;
+ break;
+ }
+ if (((pre == disallowed) && ffestb_local_.format.pre.present)
+ || ((pre == required) && !ffestb_local_.format.pre.present))
+ {
+ ffesta_ffebad_1t (err, (pre == required)
+ ? ffestb_local_.format.t : ffestb_local_.format.pre.t);
+ goto clean_up_to_11_; /* :::::::::::::::::::: */
+ }
+ if (((post == disallowed) && ffestb_local_.format.post.present)
+ || ((post == required) && !ffestb_local_.format.post.present))
+ {
+ ffesta_ffebad_1t (err, (post == required)
+ ? ffestb_local_.format.t : ffestb_local_.format.post.t);
+ goto clean_up_to_11_; /* :::::::::::::::::::: */
+ }
+ if (((dot == disallowed) && ffestb_local_.format.dot.present)
+ || ((dot == required) && !ffestb_local_.format.dot.present))
+ {
+ ffesta_ffebad_1t (err, (dot == required)
+ ? ffestb_local_.format.t : ffestb_local_.format.dot.t);
+ goto clean_up_to_11_; /* :::::::::::::::::::: */
+ }
+ if (((exp == disallowed) && ffestb_local_.format.exp.present)
+ || ((exp == required) && !ffestb_local_.format.exp.present))
+ {
+ ffesta_ffebad_1t (err, (exp == required)
+ ? ffestb_local_.format.t : ffestb_local_.format.exp.t);
+ goto clean_up_to_11_; /* :::::::::::::::::::: */
+ }
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = ffestb_local_.format.current;
+ f->t = ffestb_local_.format.t;
+ if (R1005)
+ {
+ f->u.R1005.R1004 = ffestb_local_.format.pre;
+ f->u.R1005.R1006 = ffestb_local_.format.post;
+ f->u.R1005.R1007_or_R1008 = ffestb_local_.format.dot;
+ f->u.R1005.R1009 = ffestb_local_.format.exp;
+ }
+ else
+ /* Must be R1010. */
+ {
+ if (pre == disallowed)
+ f->u.R1010.val = ffestb_local_.format.post;
+ else
+ f->u.R1010.val = ffestb_local_.format.pre;
+ }
+ return (ffelexHandler) ffestb_R100111_ (t);
+ }
+}
+
+/* ffestb_R100111_ -- edit-descriptor
+
+ return ffestb_R100111_; // to lexer
+
+ Expect a COMMA, CLOSE_PAREN, CLOSE_ARRAY, COLON, COLONCOLON, SLASH, or
+ CONCAT, or complain about missing comma. */
+
+static ffelexHandler
+ffestb_R100111_ (ffelexToken t)
+{
+ ffesttFormatList f;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_R10012_;
+
+ case FFELEX_typeCOLON:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeSLASH:
+ case FFELEX_typeCONCAT:
+ return (ffelexHandler) ffestb_R10012_ (t);
+
+ case FFELEX_typeCLOSE_PAREN:
+ f = ffestb_local_.format.f->u.root.parent;
+ if (f == NULL)
+ return (ffelexHandler) ffestb_R100114_;
+ ffestb_local_.format.f = f->next;
+ return (ffelexHandler) ffestb_R100111_;
+
+ case FFELEX_typeCLOSE_ARRAY: /* "/)". */
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeSLASH;
+ f->t = ffelex_token_use (t);
+ f->u.R1010.val.present = FALSE;
+ f->u.R1010.val.rtexpr = FALSE;
+ f->u.R1010.val.t = NULL;
+ f->u.R1010.val.u.unsigned_val = 1;
+ f = ffestb_local_.format.f->u.root.parent;
+ if (f == NULL)
+ return (ffelexHandler) ffestb_R100114_;
+ ffestb_local_.format.f = f->next;
+ return (ffelexHandler) ffestb_R100111_;
+
+ case FFELEX_typeOPEN_ANGLE:
+ case FFELEX_typeDOLLAR:
+ case FFELEX_typeNUMBER:
+ case FFELEX_typeOPEN_PAREN:
+ case FFELEX_typeOPEN_ARRAY:
+ case FFELEX_typeQUOTE:
+ case FFELEX_typeAPOSTROPHE:
+ case FFELEX_typeNAMES:
+ ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_COMMA, t);
+ return (ffelexHandler) ffestb_R10012_ (t);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_PAREN, t);
+ for (f = ffestb_local_.format.f;
+ f->u.root.parent != NULL;
+ f = f->u.root.parent->next)
+ ;
+ ffestb_local_.format.f = f;
+ return (ffelexHandler) ffestb_R100114_ (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
+ ffestt_formatlist_kill (ffestb_local_.format.f);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ }
+}
+
+/* ffestb_R100112_ -- COLON, COLONCOLON, SLASH, OPEN_ARRAY, or CONCAT
+
+ return ffestb_R100112_; // to lexer
+
+ Like _11_ except the COMMA is optional. */
+
+static ffelexHandler
+ffestb_R100112_ (ffelexToken t)
+{
+ ffesttFormatList f;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_R10012_;
+
+ case FFELEX_typeCOLON:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeSLASH:
+ case FFELEX_typeCONCAT:
+ case FFELEX_typeOPEN_ANGLE:
+ case FFELEX_typeNAMES:
+ case FFELEX_typeDOLLAR:
+ case FFELEX_typeNUMBER:
+ case FFELEX_typeOPEN_PAREN:
+ case FFELEX_typeOPEN_ARRAY:
+ case FFELEX_typeQUOTE:
+ case FFELEX_typeAPOSTROPHE:
+ case FFELEX_typePLUS:
+ case FFELEX_typeMINUS:
+ return (ffelexHandler) ffestb_R10012_ (t);
+
+ case FFELEX_typeCLOSE_PAREN:
+ f = ffestb_local_.format.f->u.root.parent;
+ if (f == NULL)
+ return (ffelexHandler) ffestb_R100114_;
+ ffestb_local_.format.f = f->next;
+ return (ffelexHandler) ffestb_R100111_;
+
+ case FFELEX_typeCLOSE_ARRAY: /* "/)". */
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeSLASH;
+ f->t = ffelex_token_use (t);
+ f->u.R1010.val.present = FALSE;
+ f->u.R1010.val.rtexpr = FALSE;
+ f->u.R1010.val.t = NULL;
+ f->u.R1010.val.u.unsigned_val = 1;
+ f = ffestb_local_.format.f->u.root.parent;
+ if (f == NULL)
+ return (ffelexHandler) ffestb_R100114_;
+ ffestb_local_.format.f = f->next;
+ return (ffelexHandler) ffestb_R100111_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_PAREN, t);
+ for (f = ffestb_local_.format.f;
+ f->u.root.parent != NULL;
+ f = f->u.root.parent->next)
+ ;
+ ffestb_local_.format.f = f;
+ return (ffelexHandler) ffestb_R100114_ (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
+ ffestt_formatlist_kill (ffestb_local_.format.f);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ }
+}
+
+/* ffestb_R100113_ -- Handle CHARACTER token.
+
+ return ffestb_R100113_; // to lexer
+
+ Append the format item to the list, go to _11_. */
+
+static ffelexHandler
+ffestb_R100113_ (ffelexToken t)
+{
+ ffesttFormatList f;
+
+ assert (ffelex_token_type (t) == FFELEX_typeCHARACTER);
+
+ if (ffe_is_pedantic_not_90 () && (ffelex_token_length (t) == 0))
+ {
+ ffebad_start (FFEBAD_NULL_CHAR_CONST);
+ ffebad_here (0, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeR1016;
+ f->t = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R100111_;
+}
+
+/* ffestb_R100114_ -- "FORMAT" OPEN_PAREN format-item-list CLOSE_PAREN
+
+ return ffestb_R100114_; // to lexer
+
+ Handle EOS/SEMICOLON or something else. */
+
+static ffelexHandler
+ffestb_R100114_ (ffelexToken t)
+{
+ ffelex_set_names_pure (FALSE);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited () && !ffestb_local_.format.complained)
+ ffestc_R1001 (ffestb_local_.format.f);
+ ffestt_formatlist_kill (ffestb_local_.format.f);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
+ ffestt_formatlist_kill (ffestb_local_.format.f);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ }
+}
+
+/* ffestb_R100115_ -- OPEN_ANGLE expr
+
+ (ffestb_R100115_) // to expression handler
+
+ Handle expression prior to the edit descriptor. */
+
+static ffelexHandler
+ffestb_R100115_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_ANGLE:
+ ffestb_local_.format.pre.present = TRUE;
+ ffestb_local_.format.pre.rtexpr = TRUE;
+ ffestb_local_.format.pre.u.expr = expr;
+ ffelex_set_names_pure (TRUE);
+ return (ffelexHandler) ffestb_R10014_;
+
+ default:
+ ffelex_token_kill (ffestb_local_.format.pre.t);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
+ ffestt_formatlist_kill (ffestb_local_.format.f);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ }
+}
+
+/* ffestb_R100116_ -- "[n]X" OPEN_ANGLE expr
+
+ (ffestb_R100116_) // to expression handler
+
+ Handle expression after the edit descriptor. */
+
+static ffelexHandler
+ffestb_R100116_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_ANGLE:
+ ffestb_local_.format.post.present = TRUE;
+ ffestb_local_.format.post.rtexpr = TRUE;
+ ffestb_local_.format.post.u.expr = expr;
+ ffelex_set_names_pure (TRUE);
+ return (ffelexHandler) ffestb_R10016_;
+
+ default:
+ ffelex_token_kill (ffestb_local_.format.t);
+ ffelex_token_kill (ffestb_local_.format.post.t);
+ if (ffestb_local_.format.pre.present)
+ ffelex_token_kill (ffestb_local_.format.pre.t);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
+ ffestt_formatlist_kill (ffestb_local_.format.f);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ }
+}
+
+/* ffestb_R100117_ -- "[n]X[n]." OPEN_ANGLE expr
+
+ (ffestb_R100117_) // to expression handler
+
+ Handle expression after the PERIOD. */
+
+static ffelexHandler
+ffestb_R100117_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_ANGLE:
+ ffestb_local_.format.dot.present = TRUE;
+ ffestb_local_.format.dot.rtexpr = TRUE;
+ ffestb_local_.format.dot.u.expr = expr;
+ ffelex_set_names_pure (TRUE);
+ return (ffelexHandler) ffestb_R10018_;
+
+ default:
+ ffelex_token_kill (ffestb_local_.format.t);
+ ffelex_token_kill (ffestb_local_.format.dot.t);
+ if (ffestb_local_.format.pre.present)
+ ffelex_token_kill (ffestb_local_.format.pre.t);
+ if (ffestb_local_.format.post.present)
+ ffelex_token_kill (ffestb_local_.format.post.t);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
+ ffestt_formatlist_kill (ffestb_local_.format.f);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ }
+}
+
+/* ffestb_R100118_ -- "[n]X[n].[n]E" OPEN_ANGLE expr
+
+ (ffestb_R100118_) // to expression handler
+
+ Handle expression after the "E". */
+
+static ffelexHandler
+ffestb_R100118_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_ANGLE:
+ ffestb_local_.format.exp.present = TRUE;
+ ffestb_local_.format.exp.rtexpr = TRUE;
+ ffestb_local_.format.exp.u.expr = expr;
+ ffelex_set_names_pure (TRUE);
+ return (ffelexHandler) ffestb_R100110_;
+
+ default:
+ ffelex_token_kill (ffestb_local_.format.t);
+ ffelex_token_kill (ffestb_local_.format.exp.t);
+ if (ffestb_local_.format.pre.present)
+ ffelex_token_kill (ffestb_local_.format.pre.t);
+ if (ffestb_local_.format.post.present)
+ ffelex_token_kill (ffestb_local_.format.post.t);
+ if (ffestb_local_.format.dot.present)
+ ffelex_token_kill (ffestb_local_.format.dot.t);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
+ ffestt_formatlist_kill (ffestb_local_.format.f);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ }
+}
+
+/* ffestb_R1107 -- Parse the USE statement
+
+ return ffestb_R1107; // to lexer
+
+ Make sure the statement has a valid form for the USE statement.
+ If it does, implement the statement. */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_R1107 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstUSE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+ ffesta_confirmed ();
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R11071_;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstUSE)
+ goto bad_0; /* :::::::::::::::::::: */
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlUSE);
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ break;
+ }
+ ffesta_confirmed ();
+ ffesta_tokens[1]
+ = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ return (ffelexHandler) ffestb_R11071_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "USE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R11071_ -- "USE" NAME
+
+ return ffestb_R11071_; // to lexer
+
+ Make sure the statement has a valid form for the USE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R11071_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R1107_start (ffesta_tokens[1], FALSE);
+ ffestc_R1107_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_R11072_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R11072_ -- "USE" NAME COMMA
+
+ return ffestb_R11072_; // to lexer
+
+ Make sure the statement has a valid form for the USE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R11072_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R11073_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R11073_ -- "USE" NAME COMMA NAME
+
+ return ffestb_R11073_; // to lexer
+
+ Make sure the statement has a valid form for the USE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R11073_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOLON:
+ if (ffestr_other (ffesta_tokens[2]) != FFESTR_otherONLY)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_R1107_start (ffesta_tokens[1], TRUE);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ return (ffelexHandler) ffestb_R11074_;
+
+ case FFELEX_typePOINTS:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1107_start (ffesta_tokens[1], FALSE);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_tokens[1] = ffesta_tokens[2];
+ return (ffelexHandler) ffestb_R110711_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R11074_ -- "USE" NAME COMMA "ONLY" COLON
+
+ return ffestb_R11074_; // to lexer
+
+ Make sure the statement has a valid form for the USE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R11074_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R11075_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1107_finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+ ffestc_R1107_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R11075_ -- "USE" NAME COMMA "ONLY" COLON NAME
+
+ return ffestb_R11075_; // to lexer
+
+ Make sure the statement has a valid form for the USE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R11075_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R1107_item (NULL, ffesta_tokens[1]);
+ ffestc_R1107_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1107_item (NULL, ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_R11078_;
+
+ case FFELEX_typePOINTS:
+ return (ffelexHandler) ffestb_R11076_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+ ffestc_R1107_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R11076_ -- "USE" NAME COMMA "ONLY" COLON NAME POINTS
+
+ return ffestb_R11076_; // to lexer
+
+ Make sure the statement has a valid form for the USE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R11076_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1107_item (ffesta_tokens[1], t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_R11077_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+ ffestc_R1107_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R11077_ -- "USE" NAME COMMA "ONLY" COLON NAME POINTS NAME
+
+ return ffestb_R11077_; // to lexer
+
+ Make sure the statement has a valid form for the USE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R11077_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1107_finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_R11078_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+ ffestc_R1107_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R11078_ -- "USE" NAME COMMA "ONLY" COLON NAME POINTS NAME COMMA
+
+ return ffestb_R11078_; // to lexer
+
+ Make sure the statement has a valid form for the USE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R11078_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R11075_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+ ffestc_R1107_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R11079_ -- "USE" NAME COMMA
+
+ return ffestb_R11079_; // to lexer
+
+ Make sure the statement has a valid form for the USE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R11079_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R110710_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+ ffestc_R1107_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R110710_ -- "USE" NAME COMMA NAME
+
+ return ffestb_R110710_; // to lexer
+
+ Make sure the statement has a valid form for the USE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R110710_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typePOINTS:
+ return (ffelexHandler) ffestb_R110711_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+ ffestc_R1107_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R110711_ -- "USE" NAME COMMA NAME POINTS
+
+ return ffestb_R110711_; // to lexer
+
+ Make sure the statement has a valid form for the USE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R110711_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1107_item (ffesta_tokens[1], t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_R110712_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+ ffestc_R1107_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R110712_ -- "USE" NAME COMMA NAME POINTS NAME
+
+ return ffestb_R110712_; // to lexer
+
+ Make sure the statement has a valid form for the USE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R110712_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1107_finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_R11079_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+ ffestc_R1107_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_R1202 -- Parse the INTERFACE statement
+
+ return ffestb_R1202; // to lexer
+
+ Make sure the statement has a valid form for the INTERFACE statement.
+ If it does, implement the statement.
+
+ 15-May-90 JCB 1.1
+ Allow INTERFACE by itself; missed this
+ valid form when originally doing syntactic analysis code. */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_R1202 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstINTERFACE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorNone, NULL);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ ffesta_confirmed ();
+ switch (ffesta_second_kw)
+ {
+ case FFESTR_secondOPERATOR:
+ ffestb_local_.interface.operator = FFESTP_definedoperatorOPERATOR;
+ break;
+
+ case FFESTR_secondASSIGNMENT:
+ ffestb_local_.interface.operator = FFESTP_definedoperatorASSIGNMENT;
+ break;
+
+ default:
+ ffestb_local_.interface.operator = FFESTP_definedoperatorNone;
+ break;
+ }
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R12021_;
+
+ case FFELEX_typeNAMES:
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlINTERFACE);
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstINTERFACEOPERATOR:
+ if (*(ffelex_token_text (ffesta_tokens[0])
+ + FFESTR_firstlINTERFACEOPERATOR) == '\0')
+ ffestb_local_.interface.operator
+ = FFESTP_definedoperatorOPERATOR;
+ break;
+
+ case FFESTR_firstINTERFACEASSGNMNT:
+ if (*(ffelex_token_text (ffesta_tokens[0])
+ + FFESTR_firstlINTERFACEASSGNMNT) == '\0')
+ ffestb_local_.interface.operator
+ = FFESTP_definedoperatorASSIGNMENT;
+ break;
+
+ case FFESTR_firstINTERFACE:
+ ffestb_local_.interface.operator = FFESTP_definedoperatorNone;
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ case FFELEX_typeOPEN_ARRAY: /* Sigh. */
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (*p == '\0')
+ {
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorNone, NULL);
+ return (ffelexHandler) ffesta_zero (t);
+ }
+ break;
+ }
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1] = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ return (ffelexHandler) ffestb_R12021_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "INTERFACE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R12021_ -- "INTERFACE" NAME
+
+ return ffestb_R12021_; // to lexer
+
+ Make sure the statement has a valid form for the INTERFACE statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_R12021_ (ffelexToken t)
+{
+ ffestb_local_.interface.slash = TRUE; /* Slash follows open paren. */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorNone, ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_local_.interface.slash = FALSE; /* Slash doesn't follow. */
+ /* Fall through. */
+ case FFELEX_typeOPEN_ARRAY:
+ switch (ffestb_local_.interface.operator)
+ {
+ case FFESTP_definedoperatorNone:
+ break;
+
+ case FFESTP_definedoperatorOPERATOR:
+ ffestb_local_.interface.assignment = FALSE;
+ return (ffelexHandler) ffestb_R12022_;
+
+ case FFESTP_definedoperatorASSIGNMENT:
+ ffestb_local_.interface.assignment = TRUE;
+ return (ffelexHandler) ffestb_R12022_;
+
+ default:
+ assert (FALSE);
+ }
+ break;
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ break;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R12022_ -- "INTERFACE" "OPERATOR/ASSIGNMENT" OPEN_PAREN
+
+ return ffestb_R12022_; // to lexer
+
+ Make sure the statement has a valid form for the INTERFACE statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_R12022_ (ffelexToken t)
+{
+ ffesta_tokens[2] = ffelex_token_use (t);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typePERIOD:
+ if (ffestb_local_.interface.slash)
+ break;
+ return (ffelexHandler) ffestb_R12023_;
+
+ case FFELEX_typePOWER:
+ if (ffestb_local_.interface.slash)
+ break;
+ ffestb_local_.interface.operator = FFESTP_definedoperatorPOWER;
+ return (ffelexHandler) ffestb_R12025_;
+
+ case FFELEX_typeASTERISK:
+ if (ffestb_local_.interface.slash)
+ break;
+ ffestb_local_.interface.operator = FFESTP_definedoperatorMULT;
+ return (ffelexHandler) ffestb_R12025_;
+
+ case FFELEX_typePLUS:
+ if (ffestb_local_.interface.slash)
+ break;
+ ffestb_local_.interface.operator = FFESTP_definedoperatorADD;
+ return (ffelexHandler) ffestb_R12025_;
+
+ case FFELEX_typeCONCAT:
+ if (ffestb_local_.interface.slash)
+ break;
+ ffestb_local_.interface.operator = FFESTP_definedoperatorCONCAT;
+ return (ffelexHandler) ffestb_R12025_;
+
+ case FFELEX_typeSLASH:
+ if (ffestb_local_.interface.slash)
+ {
+ ffestb_local_.interface.operator = FFESTP_definedoperatorCONCAT;
+ return (ffelexHandler) ffestb_R12025_;
+ }
+ ffestb_local_.interface.operator = FFESTP_definedoperatorDIVIDE;
+ return (ffelexHandler) ffestb_R12025_;
+
+ case FFELEX_typeMINUS:
+ if (ffestb_local_.interface.slash)
+ break;
+ ffestb_local_.interface.operator = FFESTP_definedoperatorSUBTRACT;
+ return (ffelexHandler) ffestb_R12025_;
+
+ case FFELEX_typeREL_EQ:
+ if (ffestb_local_.interface.slash)
+ break;
+ ffestb_local_.interface.operator = FFESTP_definedoperatorEQ;
+ return (ffelexHandler) ffestb_R12025_;
+
+ case FFELEX_typeREL_NE:
+ if (ffestb_local_.interface.slash)
+ break;
+ ffestb_local_.interface.operator = FFESTP_definedoperatorNE;
+ return (ffelexHandler) ffestb_R12025_;
+
+ case FFELEX_typeOPEN_ANGLE:
+ if (ffestb_local_.interface.slash)
+ break;
+ ffestb_local_.interface.operator = FFESTP_definedoperatorLT;
+ return (ffelexHandler) ffestb_R12025_;
+
+ case FFELEX_typeREL_LE:
+ if (ffestb_local_.interface.slash)
+ break;
+ ffestb_local_.interface.operator = FFESTP_definedoperatorLE;
+ return (ffelexHandler) ffestb_R12025_;
+
+ case FFELEX_typeCLOSE_ANGLE:
+ if (ffestb_local_.interface.slash)
+ break;
+ ffestb_local_.interface.operator = FFESTP_definedoperatorGT;
+ return (ffelexHandler) ffestb_R12025_;
+
+ case FFELEX_typeREL_GE:
+ if (ffestb_local_.interface.slash)
+ break;
+ ffestb_local_.interface.operator = FFESTP_definedoperatorGE;
+ return (ffelexHandler) ffestb_R12025_;
+
+ case FFELEX_typeEQUALS:
+ if (ffestb_local_.interface.slash)
+ {
+ ffestb_local_.interface.operator = FFESTP_definedoperatorNE;
+ return (ffelexHandler) ffestb_R12025_;
+ }
+ ffestb_local_.interface.operator = FFESTP_definedoperatorASSIGNMENT;
+ return (ffelexHandler) ffestb_R12025_;
+
+ case FFELEX_typeCLOSE_ARRAY:
+ if (!ffestb_local_.interface.slash)
+ {
+ ffestb_local_.interface.operator = FFESTP_definedoperatorDIVIDE;
+ return (ffelexHandler) ffestb_R12026_;
+ }
+ ffestb_local_.interface.operator = FFESTP_definedoperatorCONCAT;
+ return (ffelexHandler) ffestb_R12026_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ if (!ffestb_local_.interface.slash)
+ break;
+ ffestb_local_.interface.operator = FFESTP_definedoperatorDIVIDE;
+ return (ffelexHandler) ffestb_R12026_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R12023_ -- "INTERFACE" NAME OPEN_PAREN PERIOD
+
+ return ffestb_R12023_; // to lexer
+
+ Make sure the statement has a valid form for the INTERFACE statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_R12023_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffesta_tokens[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R12024_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R12024_ -- "INTERFACE" NAME OPEN_PAREN PERIOD NAME
+
+ return ffestb_R12024_; // to lexer
+
+ Make sure the statement has a valid form for the INTERFACE statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_R12024_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typePERIOD:
+ return (ffelexHandler) ffestb_R12025_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R12025_ -- "INTERFACE" NAME OPEN_PAREN operator
+
+ return ffestb_R12025_; // to lexer
+
+ Make sure the statement has a valid form for the INTERFACE statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_R12025_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_R12026_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R12026_ -- "INTERFACE" NAME OPEN_PAREN operator CLOSE_PAREN
+
+ return ffestb_R12026_; // to lexer
+
+ Make sure the statement has a valid form for the INTERFACE statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_R12026_ (ffelexToken t)
+{
+ char *p;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (ffestb_local_.interface.assignment
+ && (ffestb_local_.interface.operator
+ != FFESTP_definedoperatorASSIGNMENT))
+ {
+ ffebad_start (FFEBAD_INTERFACE_ASSIGNMENT);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[1]),
+ ffelex_token_where_column (ffesta_tokens[1]));
+ ffebad_here (1, ffelex_token_where_line (ffesta_tokens[2]),
+ ffelex_token_where_column (ffesta_tokens[2]));
+ ffebad_finish ();
+ }
+ switch (ffelex_token_type (ffesta_tokens[2]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffestr_other (ffesta_tokens[2]))
+ {
+ case FFESTR_otherNOT:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorNOT, NULL);
+ break;
+
+ case FFESTR_otherAND:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorAND, NULL);
+ break;
+
+ case FFESTR_otherOR:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorOR, NULL);
+ break;
+
+ case FFESTR_otherEQV:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorEQV, NULL);
+ break;
+
+ case FFESTR_otherNEQV:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorNEQV, NULL);
+ break;
+
+ case FFESTR_otherEQ:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorEQ, NULL);
+ break;
+
+ case FFESTR_otherNE:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorNE, NULL);
+ break;
+
+ case FFESTR_otherLT:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorLT, NULL);
+ break;
+
+ case FFESTR_otherLE:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorLE, NULL);
+ break;
+
+ case FFESTR_otherGT:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorGT, NULL);
+ break;
+
+ case FFESTR_otherGE:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorGE, NULL);
+ break;
+
+ default:
+ for (p = ffelex_token_text (ffesta_tokens[2]); *p != '\0'; ++p)
+ {
+ if (!isalpha (*p))
+ {
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffesta_ffebad_1t (FFEBAD_INTERFACE_NONLETTER,
+ ffesta_tokens[2]);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ }
+ }
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorOPERATOR,
+ ffesta_tokens[2]);
+ }
+ break;
+
+ case FFELEX_typeEQUALS:
+ if (!ffestb_local_.interface.assignment
+ && (ffestb_local_.interface.operator
+ == FFESTP_definedoperatorASSIGNMENT))
+ {
+ ffebad_start (FFEBAD_INTERFACE_OPERATOR);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[1]),
+ ffelex_token_where_column (ffesta_tokens[1]));
+ ffebad_here (1, ffelex_token_where_line (ffesta_tokens[2]),
+ ffelex_token_where_column (ffesta_tokens[2]));
+ ffebad_finish ();
+ }
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (ffestb_local_.interface.operator, NULL);
+ break;
+
+ default:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (ffestb_local_.interface.operator, NULL);
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_S3P4 -- Parse the INCLUDE line
+
+ return ffestb_S3P4; // to lexer
+
+ Make sure the statement has a valid form for the INCLUDE line. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_S3P4 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexHandler next;
+ ffelexToken nt;
+ ffelexToken ut;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstINCLUDE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ case FFELEX_typeAPOSTROPHE:
+ case FFELEX_typeQUOTE:
+ break;
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+ ffesta_confirmed ();
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextINCLUDE,
+ (ffeexprCallback) ffestb_S3P41_)))
+ (t);
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstINCLUDE)
+ goto bad_0; /* :::::::::::::::::::: */
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlINCLUDE);
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeAPOSTROPHE:
+ case FFELEX_typeQUOTE:
+ break;
+ }
+ ffesta_confirmed ();
+ if (*p == '\0')
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextINCLUDE,
+ (ffeexprCallback) ffestb_S3P41_)))
+ (t);
+ if (!isdigit (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ nt = ffelex_token_number_from_names (ffesta_tokens[0], i);
+ p += ffelex_token_length (nt);
+ i += ffelex_token_length (nt);
+ if ((*p != '_') || (++i, *++p != '\0'))
+ {
+ ffelex_token_kill (nt);
+ goto bad_i; /* :::::::::::::::::::: */
+ }
+ ut = ffelex_token_uscore_from_names (ffesta_tokens[0], i - 1);
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs
+ (ffesta_output_pool, FFEEXPR_contextINCLUDE,
+ (ffeexprCallback) ffestb_S3P41_)))
+ (nt);
+ ffelex_token_kill (nt);
+ next = (ffelexHandler) (*next) (ut);
+ ffelex_token_kill (ut);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INCLUDE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INCLUDE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "INCLUDE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_S3P41_ -- "INCLUDE" [NUMBER "_"] expr
+
+ (ffestb_S3P41_) // to expression handler
+
+ Make sure the next token is an EOS, but not a SEMICOLON. */
+
+static ffelexHandler
+ffestb_S3P41_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ if (ffe_is_pedantic ()
+ && ((ffelex_token_type (t) == FFELEX_typeSEMICOLON)
+ || ffesta_line_has_semicolons))
+ {
+ ffebad_start_msg ("INCLUDE at %0 not the only statement on the source line", FFEBAD_severityWARNING);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_finish ();
+ }
+ ffestc_S3P4 (expr, ft);
+ }
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INCLUDE", t);
+ break;
+ }
+
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V012 -- Parse the MAP statement
+
+ return ffestb_V012; // to lexer
+
+ Make sure the statement has a valid form for the MAP statement. If
+ it does, implement the statement. */
+
+#if FFESTR_VXT
+ffelexHandler
+ffestb_V012 (ffelexToken t)
+{
+ char *p;
+ ffeTokenLength i;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstMAP)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstMAP)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlMAP)
+ {
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlMAP);
+ goto bad_i; /* :::::::::::::::::::: */
+ }
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_V012 ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MAP", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid first token. */
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MAP", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "MAP", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_V014 -- Parse the VOLATILE statement
+
+ return ffestb_V014; // to lexer
+
+ Make sure the statement has a valid form for the VOLATILE statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_V014 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexToken nt;
+ ffelexHandler next;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstVOLATILE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ case FFELEX_typeSLASH:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_V014_start ();
+ return (ffelexHandler) ffestb_V0141_ (t);
+
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_V014_start ();
+ return (ffelexHandler) ffestb_V0141_;
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstVOLATILE)
+ goto bad_0; /* :::::::::::::::::::: */
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlVOLATILE);
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ break;
+
+ case FFELEX_typeSLASH:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ goto bad_i; /* :::::::::::::::::::: */
+ if (!ffesta_is_inhibited ())
+ ffestc_V014_start ();
+ return (ffelexHandler) ffestb_V0141_ (t);
+
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ goto bad_i; /* :::::::::::::::::::: */
+ if (!ffesta_is_inhibited ())
+ ffestc_V014_start ();
+ return (ffelexHandler) ffestb_V0141_;
+ }
+
+ /* Here, we have at least one char after "VOLATILE" and t is COMMA or
+ EOS/SEMICOLON. */
+
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ if (!ffesta_is_inhibited ())
+ ffestc_V014_start ();
+ next = (ffelexHandler) ffestb_V0141_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "VOLATILE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0141_ -- "VOLATILE" [COLONCOLON]
+
+ return ffestb_V0141_; // to lexer
+
+ Handle NAME or SLASH. */
+
+static ffelexHandler
+ffestb_V0141_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffestb_local_.V014.is_cblock = FALSE;
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0144_;
+
+ case FFELEX_typeSLASH:
+ ffestb_local_.V014.is_cblock = TRUE;
+ return (ffelexHandler) ffestb_V0142_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_V014_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0142_ -- "VOLATILE" [COLONCOLON] SLASH
+
+ return ffestb_V0142_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_V0142_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0143_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_V014_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0143_ -- "VOLATILE" [COLONCOLON] SLASH NAME
+
+ return ffestb_V0143_; // to lexer
+
+ Handle SLASH. */
+
+static ffelexHandler
+ffestb_V0143_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeSLASH:
+ return (ffelexHandler) ffestb_V0144_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_V014_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0144_ -- "VOLATILE" [COLONCOLON] R523
+
+ return ffestb_V0144_; // to lexer
+
+ Handle COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_V0144_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (!ffesta_is_inhibited ())
+ {
+ if (ffestb_local_.V014.is_cblock)
+ ffestc_V014_item_cblock (ffesta_tokens[1]);
+ else
+ ffestc_V014_item_object (ffesta_tokens[1]);
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_V0141_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ if (ffestb_local_.V014.is_cblock)
+ ffestc_V014_item_cblock (ffesta_tokens[1]);
+ else
+ ffestc_V014_item_object (ffesta_tokens[1]);
+ ffestc_V014_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_V014_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V025 -- Parse the DEFINEFILE statement
+
+ return ffestb_V025; // to lexer
+
+ Make sure the statement has a valid form for the DEFINEFILE statement.
+ If it does, implement the statement. */
+
+#if FFESTR_VXT
+ffelexHandler
+ffestb_V025 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexToken nt;
+ ffelexHandler next;
+
+ ffestb_local_.V025.started = FALSE;
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstDEFINE:
+ if ((ffelex_token_type (t) != FFELEX_typeNAME)
+ || (ffesta_second_kw != FFESTR_secondFILE))
+ goto bad_1; /* :::::::::::::::::::: */
+ ffesta_confirmed ();
+ return (ffelexHandler) ffestb_V0251_;
+
+ case FFESTR_firstDEFINEFILE:
+ return (ffelexHandler) ffestb_V0251_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstDEFINEFILE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ break;
+ }
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDEFINEFILE);
+ if (isdigit (*p))
+ nt = ffelex_token_number_from_names (ffesta_tokens[0], i);
+ else if (ffesrc_is_name_init (*p))
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ else
+ goto bad_i; /* :::::::::::::::::::: */
+ next = (ffelexHandler) ffestb_V0251_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0251_ -- "DEFINEFILE" or "DEFINE" "FILE"
+
+ return ffestb_V0251_; // to lexer
+
+ Make sure the statement has a valid form for the DEFINEFILE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_V0251_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ case FFELEX_typeNUMBER:
+ if (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME)
+ ffesta_confirmed ();
+ return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEUNIT_DF, (ffeexprCallback) ffestb_V0252_)))
+ (t);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ break;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0252_ -- "DEFINEFILE" expr
+
+ (ffestb_V0252_) // to expression handler
+
+ Make sure the statement has a valid form for the DEFINEFILE statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_V0252_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_local_.V025.u = expr;
+ ffesta_tokens[1] = ffelex_token_use (ft);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0253_);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0253_ -- "DEFINEFILE" expr OPEN_PAREN expr
+
+ (ffestb_V0253_) // to expression handler
+
+ Make sure the statement has a valid form for the DEFINEFILE statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_V0253_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffestb_local_.V025.m = expr;
+ ffesta_tokens[2] = ffelex_token_use (ft);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0254_);
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0254_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr
+
+ (ffestb_V0254_) // to expression handler
+
+ Make sure the statement has a valid form for the DEFINEFILE statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_V0254_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffestb_local_.V025.n = expr;
+ ffesta_tokens[3] = ffelex_token_use (ft);
+ return (ffelexHandler) ffestb_V0255_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0255_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA
+
+ return ffestb_V0255_; // to lexer
+
+ Make sure the statement has a valid form for the DEFINEFILE statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_V0255_ (ffelexToken t)
+{
+ char *p;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ p = ffelex_token_text (t);
+ if (!ffesrc_char_match_init (*p, 'U', 'u') || (*++p != '\0'))
+ break;
+ return (ffelexHandler) ffestb_V0256_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffelex_token_kill (ffesta_tokens[3]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0256_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA "U"
+
+ return ffestb_V0256_; // to lexer
+
+ Make sure the statement has a valid form for the DEFINEFILE statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_V0256_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextFILEASSOC,
+ (ffeexprCallback) ffestb_V0257_);
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffelex_token_kill (ffesta_tokens[3]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0257_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA "U"
+ COMMA expr
+
+ (ffestb_V0257_) // to expression handler
+
+ Make sure the statement has a valid form for the DEFINEFILE statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_V0257_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ ffestb_local_.V025.asv = expr;
+ ffesta_tokens[4] = ffelex_token_use (ft);
+ return (ffelexHandler) ffestb_V0258_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffelex_token_kill (ffesta_tokens[3]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0258_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA "U"
+ COMMA expr CLOSE_PAREN
+
+ return ffestb_V0258_; // to lexer
+
+ Make sure the statement has a valid form for the DEFINEFILE statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_V0258_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffestb_local_.V025.started)
+ {
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_V025_start ();
+ ffestb_local_.V025.started = TRUE;
+ }
+ if (!ffesta_is_inhibited ())
+ ffestc_V025_item (ffestb_local_.V025.u, ffesta_tokens[1],
+ ffestb_local_.V025.m, ffesta_tokens[2],
+ ffestb_local_.V025.n, ffesta_tokens[3],
+ ffestb_local_.V025.asv, ffesta_tokens[4]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffelex_token_kill (ffesta_tokens[3]);
+ ffelex_token_kill (ffesta_tokens[4]);
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEUNIT_DF, (ffeexprCallback) ffestb_V0252_);
+ if (!ffesta_is_inhibited ())
+ ffestc_V025_finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffelex_token_kill (ffesta_tokens[3]);
+ ffelex_token_kill (ffesta_tokens[4]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_subr_kill_easy_ -- Kill I/O statement data structure
+
+ ffestb_subr_kill_easy_();
+
+ Kills all tokens in the I/O data structure. Assumes that they are
+ overlaid with each other (union) in ffest_private.h and the typing
+ and structure references assume (though not necessarily dangerous if
+ FALSE) that INQUIRE has the most file elements. */
+
+#if FFESTB_KILL_EASY_
+static void
+ffestb_subr_kill_easy_ (ffestpInquireIx max)
+{
+ ffestpInquireIx ix;
+
+ for (ix = 0; ix < max; ++ix)
+ {
+ if (ffestp_file.inquire.inquire_spec[ix].kw_or_val_present)
+ {
+ if (ffestp_file.inquire.inquire_spec[ix].kw_present)
+ ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].kw);
+ if (ffestp_file.inquire.inquire_spec[ix].value_present)
+ ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].value);
+ }
+ }
+}
+
+#endif
+/* ffestb_subr_kill_accept_ -- Kill ACCEPT statement data structure
+
+ ffestb_subr_kill_accept_();
+
+ Kills all tokens in the ACCEPT data structure. */
+
+#if !FFESTB_KILL_EASY_
+static void
+ffestb_subr_kill_accept_ ()
+{
+ ffestpAcceptIx ix;
+
+ for (ix = 0; ix < FFESTP_acceptix; ++ix)
+ {
+ if (ffestp_file.accept.accept_spec[ix].kw_or_val_present)
+ {
+ if (ffestp_file.accept.accept_spec[ix].kw_present)
+ ffelex_token_kill (ffestp_file.accept.accept_spec[ix].kw);
+ if (ffestp_file.accept.accept_spec[ix].value_present)
+ ffelex_token_kill (ffestp_file.accept.accept_spec[ix].value);
+ }
+ }
+}
+
+#endif
+/* ffestb_subr_kill_beru_ -- Kill BACKSPACE/ENDFILE/REWIND/UNLOCK statement
+ data structure
+
+ ffestb_subr_kill_beru_();
+
+ Kills all tokens in the BACKSPACE/ENDFILE/REWIND/UNLOCK data structure. */
+
+#if !FFESTB_KILL_EASY_
+static void
+ffestb_subr_kill_beru_ ()
+{
+ ffestpBeruIx ix;
+
+ for (ix = 0; ix < FFESTP_beruix; ++ix)
+ {
+ if (ffestp_file.beru.beru_spec[ix].kw_or_val_present)
+ {
+ if (ffestp_file.beru.beru_spec[ix].kw_present)
+ ffelex_token_kill (ffestp_file.beru.beru_spec[ix].kw);
+ if (ffestp_file.beru.beru_spec[ix].value_present)
+ ffelex_token_kill (ffestp_file.beru.beru_spec[ix].value);
+ }
+ }
+}
+
+#endif
+/* ffestb_subr_kill_close_ -- Kill CLOSE statement data structure
+
+ ffestb_subr_kill_close_();
+
+ Kills all tokens in the CLOSE data structure. */
+
+#if !FFESTB_KILL_EASY_
+static void
+ffestb_subr_kill_close_ ()
+{
+ ffestpCloseIx ix;
+
+ for (ix = 0; ix < FFESTP_closeix; ++ix)
+ {
+ if (ffestp_file.close.close_spec[ix].kw_or_val_present)
+ {
+ if (ffestp_file.close.close_spec[ix].kw_present)
+ ffelex_token_kill (ffestp_file.close.close_spec[ix].kw);
+ if (ffestp_file.close.close_spec[ix].value_present)
+ ffelex_token_kill (ffestp_file.close.close_spec[ix].value);
+ }
+ }
+}
+
+#endif
+/* ffestb_subr_kill_delete_ -- Kill DELETE statement data structure
+
+ ffestb_subr_kill_delete_();
+
+ Kills all tokens in the DELETE data structure. */
+
+#if !FFESTB_KILL_EASY_
+static void
+ffestb_subr_kill_delete_ ()
+{
+ ffestpDeleteIx ix;
+
+ for (ix = 0; ix < FFESTP_deleteix; ++ix)
+ {
+ if (ffestp_file.delete.delete_spec[ix].kw_or_val_present)
+ {
+ if (ffestp_file.delete.delete_spec[ix].kw_present)
+ ffelex_token_kill (ffestp_file.delete.delete_spec[ix].kw);
+ if (ffestp_file.delete.delete_spec[ix].value_present)
+ ffelex_token_kill (ffestp_file.delete.delete_spec[ix].value);
+ }
+ }
+}
+
+#endif
+/* ffestb_subr_kill_inquire_ -- Kill INQUIRE statement data structure
+
+ ffestb_subr_kill_inquire_();
+
+ Kills all tokens in the INQUIRE data structure. */
+
+#if !FFESTB_KILL_EASY_
+static void
+ffestb_subr_kill_inquire_ ()
+{
+ ffestpInquireIx ix;
+
+ for (ix = 0; ix < FFESTP_inquireix; ++ix)
+ {
+ if (ffestp_file.inquire.inquire_spec[ix].kw_or_val_present)
+ {
+ if (ffestp_file.inquire.inquire_spec[ix].kw_present)
+ ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].kw);
+ if (ffestp_file.inquire.inquire_spec[ix].value_present)
+ ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].value);
+ }
+ }
+}
+
+#endif
+/* ffestb_subr_kill_open_ -- Kill OPEN statement data structure
+
+ ffestb_subr_kill_open_();
+
+ Kills all tokens in the OPEN data structure. */
+
+#if !FFESTB_KILL_EASY_
+static void
+ffestb_subr_kill_open_ ()
+{
+ ffestpOpenIx ix;
+
+ for (ix = 0; ix < FFESTP_openix; ++ix)
+ {
+ if (ffestp_file.open.open_spec[ix].kw_or_val_present)
+ {
+ if (ffestp_file.open.open_spec[ix].kw_present)
+ ffelex_token_kill (ffestp_file.open.open_spec[ix].kw);
+ if (ffestp_file.open.open_spec[ix].value_present)
+ ffelex_token_kill (ffestp_file.open.open_spec[ix].value);
+ }
+ }
+}
+
+#endif
+/* ffestb_subr_kill_print_ -- Kill PRINT statement data structure
+
+ ffestb_subr_kill_print_();
+
+ Kills all tokens in the PRINT data structure. */
+
+#if !FFESTB_KILL_EASY_
+static void
+ffestb_subr_kill_print_ ()
+{
+ ffestpPrintIx ix;
+
+ for (ix = 0; ix < FFESTP_printix; ++ix)
+ {
+ if (ffestp_file.print.print_spec[ix].kw_or_val_present)
+ {
+ if (ffestp_file.print.print_spec[ix].kw_present)
+ ffelex_token_kill (ffestp_file.print.print_spec[ix].kw);
+ if (ffestp_file.print.print_spec[ix].value_present)
+ ffelex_token_kill (ffestp_file.print.print_spec[ix].value);
+ }
+ }
+}
+
+#endif
+/* ffestb_subr_kill_read_ -- Kill READ statement data structure
+
+ ffestb_subr_kill_read_();
+
+ Kills all tokens in the READ data structure. */
+
+#if !FFESTB_KILL_EASY_
+static void
+ffestb_subr_kill_read_ ()
+{
+ ffestpReadIx ix;
+
+ for (ix = 0; ix < FFESTP_readix; ++ix)
+ {
+ if (ffestp_file.read.read_spec[ix].kw_or_val_present)
+ {
+ if (ffestp_file.read.read_spec[ix].kw_present)
+ ffelex_token_kill (ffestp_file.read.read_spec[ix].kw);
+ if (ffestp_file.read.read_spec[ix].value_present)
+ ffelex_token_kill (ffestp_file.read.read_spec[ix].value);
+ }
+ }
+}
+
+#endif
+/* ffestb_subr_kill_rewrite_ -- Kill REWRITE statement data structure
+
+ ffestb_subr_kill_rewrite_();
+
+ Kills all tokens in the REWRITE data structure. */
+
+#if !FFESTB_KILL_EASY_
+static void
+ffestb_subr_kill_rewrite_ ()
+{
+ ffestpRewriteIx ix;
+
+ for (ix = 0; ix < FFESTP_rewriteix; ++ix)
+ {
+ if (ffestp_file.rewrite.rewrite_spec[ix].kw_or_val_present)
+ {
+ if (ffestp_file.rewrite.rewrite_spec[ix].kw_present)
+ ffelex_token_kill (ffestp_file.rewrite.rewrite_spec[ix].kw);
+ if (ffestp_file.rewrite.rewrite_spec[ix].value_present)
+ ffelex_token_kill (ffestp_file.rewrite.rewrite_spec[ix].value);
+ }
+ }
+}
+
+#endif
+/* ffestb_subr_kill_type_ -- Kill TYPE statement data structure
+
+ ffestb_subr_kill_type_();
+
+ Kills all tokens in the TYPE data structure. */
+
+#if !FFESTB_KILL_EASY_
+static void
+ffestb_subr_kill_type_ ()
+{
+ ffestpTypeIx ix;
+
+ for (ix = 0; ix < FFESTP_typeix; ++ix)
+ {
+ if (ffestp_file.type.type_spec[ix].kw_or_val_present)
+ {
+ if (ffestp_file.type.type_spec[ix].kw_present)
+ ffelex_token_kill (ffestp_file.type.type_spec[ix].kw);
+ if (ffestp_file.type.type_spec[ix].value_present)
+ ffelex_token_kill (ffestp_file.type.type_spec[ix].value);
+ }
+ }
+}
+
+#endif
+/* ffestb_subr_kill_write_ -- Kill WRITE statement data structure
+
+ ffestb_subr_kill_write_();
+
+ Kills all tokens in the WRITE data structure. */
+
+#if !FFESTB_KILL_EASY_
+static void
+ffestb_subr_kill_write_ ()
+{
+ ffestpWriteIx ix;
+
+ for (ix = 0; ix < FFESTP_writeix; ++ix)
+ {
+ if (ffestp_file.write.write_spec[ix].kw_or_val_present)
+ {
+ if (ffestp_file.write.write_spec[ix].kw_present)
+ ffelex_token_kill (ffestp_file.write.write_spec[ix].kw);
+ if (ffestp_file.write.write_spec[ix].value_present)
+ ffelex_token_kill (ffestp_file.write.write_spec[ix].value);
+ }
+ }
+}
+
+#endif
+/* ffestb_beru -- Parse the BACKSPACE/ENDFILE/REWIND/UNLOCK statement
+
+ return ffestb_beru; // to lexer
+
+ Make sure the statement has a valid form for the BACKSPACE/ENDFILE/REWIND/
+ UNLOCK statement. If it does, implement the statement. */
+
+ffelexHandler
+ffestb_beru (ffelexToken t)
+{
+ ffelexHandler next;
+ ffestpBeruIx ix;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typeCOLON:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ case FFELEX_typeNUMBER:
+ ffesta_confirmed ();
+ break;
+
+ case FFELEX_typeOPEN_PAREN:
+ for (ix = 0; ix < FFESTP_beruix; ++ix)
+ ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_beru2_;
+
+ default:
+ break;
+ }
+
+ for (ix = 0; ix < FFESTP_beruix; ++ix)
+ ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM,
+ (ffeexprCallback) ffestb_beru1_)))
+ (t);
+
+ case FFELEX_typeNAMES:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typeCOLON:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ break;
+
+ case FFELEX_typeOPEN_PAREN:
+ if (ffelex_token_length (ffesta_tokens[0])
+ != ffestb_args.beru.len)
+ break;
+
+ for (ix = 0; ix < FFESTP_beruix; ++ix)
+ ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_beru2_;
+
+ default:
+ break;
+ }
+ for (ix = 0; ix < FFESTP_beruix; ++ix)
+ ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
+ next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_beru1_);
+ next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
+ ffestb_args.beru.len);
+ if (next == NULL)
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_beru1_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" expr
+
+ (ffestb_beru1_) // to expression handler
+
+ Make sure the next token is an EOS or SEMICOLON. */
+
+static ffelexHandler
+ffestb_beru1_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+ ffesta_confirmed ();
+ ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_or_val_present
+ = TRUE;
+ ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_present = FALSE;
+ ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_present = TRUE;
+ ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_is_label
+ = FALSE;
+ ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value
+ = ffelex_token_use (ft);
+ ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].u.expr = expr;
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstBACKSPACE:
+ ffestc_R919 ();
+ break;
+
+ case FFESTR_firstENDFILE:
+ case FFESTR_firstEND:
+ ffestc_R920 ();
+ break;
+
+ case FFESTR_firstREWIND:
+ ffestc_R921 ();
+ break;
+
+#if FFESTR_VXT
+ case FFESTR_firstUNLOCK:
+ ffestc_V022 ();
+ break;
+#endif
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffestb_subr_kill_beru_ ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_beru_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_beru2_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN
+
+ return ffestb_beru2_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_beru2_ (ffelexToken t)
+{
+ ffelexToken nt;
+ ffelexHandler next;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_beru3_;
+
+ default:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUMAMBIG, (ffeexprCallback) ffestb_beru4_)))
+ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+ }
+}
+
+/* ffestb_beru3_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN NAME
+
+ return ffestb_beru3_; // to lexer
+
+ If EQUALS here, go to states that handle it. Else, send NAME and this
+ token thru expression handler. */
+
+static ffelexHandler
+ffestb_beru3_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken nt;
+ ffelexToken ot;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffelex_token_kill (ffesta_tokens[1]);
+ nt = ffesta_tokens[2];
+ next = (ffelexHandler) ffestb_beru5_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ nt = ffesta_tokens[1];
+ ot = ffesta_tokens[2];
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUMAMBIG, (ffeexprCallback) ffestb_beru4_)))
+ (nt);
+ ffelex_token_kill (nt);
+ next = (ffelexHandler) (*next) (ot);
+ ffelex_token_kill (ot);
+ return (ffelexHandler) (*next) (t);
+ }
+}
+
+/* ffestb_beru4_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN expr [CLOSE_PAREN]
+
+ (ffestb_beru4_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON here.
+
+ 15-Feb-91 JCB 1.2
+ Now using new mechanism whereby expr comes back as opITEM if the
+ expr is considered part (or all) of an I/O control list (and should
+ be stripped of its outer opITEM node) or not if it is considered
+ a plain unit number that happens to have been enclosed in parens.
+ 26-Mar-90 JCB 1.1
+ No longer expecting close-paren here because of constructs like
+ BACKSPACE (5)+2, so now expecting either COMMA because it was a
+ construct like BACKSPACE (5+2,... or EOS/SEMICOLON because it is like
+ the former construct. Ah, the vagaries of Fortran. */
+
+static ffelexHandler
+ffestb_beru4_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ bool inlist;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ if (ffebld_op (expr) == FFEBLD_opITEM)
+ {
+ inlist = TRUE;
+ expr = ffebld_head (expr);
+ }
+ else
+ inlist = FALSE;
+ ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_or_val_present
+ = TRUE;
+ ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_present = FALSE;
+ ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_present = TRUE;
+ ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_is_label
+ = FALSE;
+ ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value
+ = ffelex_token_use (ft);
+ ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].u.expr = expr;
+ if (inlist)
+ return (ffelexHandler) ffestb_beru9_ (t);
+ return (ffelexHandler) ffestb_beru10_ (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_beru_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_beru5_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN [external-file-unit
+ COMMA]
+
+ return ffestb_beru5_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_beru5_ (ffelexToken t)
+{
+ ffestrGenio kw;
+
+ ffestb_local_.beru.label = FALSE;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ kw = ffestr_genio (t);
+ switch (kw)
+ {
+ case FFESTR_genioERR:
+ ffestb_local_.beru.ix = FFESTP_beruixERR;
+ ffestb_local_.beru.label = TRUE;
+ break;
+
+ case FFESTR_genioIOSTAT:
+ ffestb_local_.beru.ix = FFESTP_beruixIOSTAT;
+ ffestb_local_.beru.left = TRUE;
+ ffestb_local_.beru.context = FFEEXPR_contextFILEINT;
+ break;
+
+ case FFESTR_genioUNIT:
+ ffestb_local_.beru.ix = FFESTP_beruixUNIT;
+ ffestb_local_.beru.left = FALSE;
+ ffestb_local_.beru.context = FFEEXPR_contextFILENUM;
+ break;
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
+ .kw_or_val_present)
+ break; /* Can't specify a keyword twice! */
+ ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
+ .kw_or_val_present = TRUE;
+ ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
+ .kw_present = TRUE;
+ ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
+ .value_present = FALSE;
+ ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value_is_label
+ = ffestb_local_.beru.label;
+ ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].kw
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_beru6_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffestb_subr_kill_beru_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_beru6_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN [external-file-unit
+ COMMA] NAME
+
+ return ffestb_beru6_; // to lexer
+
+ Make sure EQUALS here, send next token to expression handler. */
+
+static ffelexHandler
+ffestb_beru6_ (ffelexToken t)
+{
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ if (ffestb_local_.beru.label)
+ return (ffelexHandler) ffestb_beru8_;
+ if (ffestb_local_.beru.left)
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ ffestb_local_.beru.context,
+ (ffeexprCallback) ffestb_beru7_);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestb_local_.beru.context,
+ (ffeexprCallback) ffestb_beru7_);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_beru_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_beru7_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... NAME EQUALS expr
+
+ (ffestb_beru7_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_beru7_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value_present
+ = TRUE;
+ ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value
+ = ffelex_token_use (ft);
+ ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_beru5_;
+ return (ffelexHandler) ffestb_beru10_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_beru_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_beru8_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... NAME EQUALS
+
+ return ffestb_beru8_; // to lexer
+
+ Handle NUMBER for label here. */
+
+static ffelexHandler
+ffestb_beru8_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value_present
+ = TRUE;
+ ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_beru9_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_beru_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_beru9_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... NAME EQUALS
+ NUMBER
+
+ return ffestb_beru9_; // to lexer
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_beru9_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_beru5_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_beru10_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_beru_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_beru10_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... CLOSE_PAREN
+
+ return ffestb_beru10_; // to lexer
+
+ Handle EOS or SEMICOLON here. */
+
+static ffelexHandler
+ffestb_beru10_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstBACKSPACE:
+ ffestc_R919 ();
+ break;
+
+ case FFESTR_firstENDFILE:
+ case FFESTR_firstEND:
+ ffestc_R920 ();
+ break;
+
+ case FFESTR_firstREWIND:
+ ffestc_R921 ();
+ break;
+
+#if FFESTR_VXT
+ case FFESTR_firstUNLOCK:
+ ffestc_V022 ();
+ break;
+#endif
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffestb_subr_kill_beru_ ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_beru_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_vxtcode -- Parse the VXT DECODE/ENCODE statement
+
+ return ffestb_vxtcode; // to lexer
+
+ Make sure the statement has a valid form for the VXT DECODE/ENCODE
+ statement. If it does, implement the statement. */
+
+#if FFESTR_VXT
+ffelexHandler
+ffestb_vxtcode (ffelexToken t)
+{
+ ffestpVxtcodeIx ix;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeNAME:
+ case FFELEX_typeNUMBER:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ for (ix = 0; ix < FFESTP_vxtcodeix; ++ix)
+ ffestp_file.vxtcode.vxtcode_spec[ix].kw_or_val_present = FALSE;
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_vxtcode1_);
+ }
+
+ case FFELEX_typeNAMES:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ if (ffelex_token_length (ffesta_tokens[0])
+ != ffestb_args.vxtcode.len)
+ goto bad_0; /* :::::::::::::::::::: */
+
+ for (ix = 0; ix < FFESTP_vxtcodeix; ++ix)
+ ffestp_file.vxtcode.vxtcode_spec[ix].kw_or_val_present = FALSE;
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_vxtcode1_);
+ }
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_vxtcode1_ -- "VXTCODE" OPEN_PAREN expr
+
+ (ffestb_vxtcode1_) // to expression handler
+
+ Handle COMMA here. */
+
+static ffelexHandler
+ffestb_vxtcode1_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].kw_or_val_present
+ = TRUE;
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].kw_present = FALSE;
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].value_present = TRUE;
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].value_is_label
+ = FALSE;
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].value
+ = ffelex_token_use (ft);
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].u.expr = expr;
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMAT, (ffeexprCallback) ffestb_vxtcode2_);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_vxtcode_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_vxtcode2_ -- "VXTCODE" OPEN_PAREN expr COMMA expr
+
+ (ffestb_vxtcode2_) // to expression handler
+
+ Handle COMMA here. */
+
+static ffelexHandler
+ffestb_vxtcode2_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].kw_or_val_present
+ = TRUE;
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].kw_present = FALSE;
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].value_present = TRUE;
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].value_is_label
+ = (expr == NULL);
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].value
+ = ffelex_token_use (ft);
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].u.expr = expr;
+ if (ffesta_first_kw == FFESTR_firstENCODE)
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextFILEVXTCODE,
+ (ffeexprCallback) ffestb_vxtcode3_);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEVXTCODE,
+ (ffeexprCallback) ffestb_vxtcode3_);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_vxtcode_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_vxtcode3_ -- "VXTCODE" OPEN_PAREN expr COMMA expr COMMA expr
+
+ (ffestb_vxtcode3_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_vxtcode3_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].kw_or_val_present
+ = TRUE;
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].kw_present = FALSE;
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].value_present = TRUE;
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].value_is_label
+ = FALSE;
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].value
+ = ffelex_token_use (ft);
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_vxtcode4_;
+ return (ffelexHandler) ffestb_vxtcode9_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_vxtcode_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_vxtcode4_ -- "VXTCODE" OPEN_PAREN ...
+
+ return ffestb_vxtcode4_; // to lexer
+
+ Handle NAME=expr construct here. */
+
+static ffelexHandler
+ffestb_vxtcode4_ (ffelexToken t)
+{
+ ffestrGenio kw;
+
+ ffestb_local_.vxtcode.label = FALSE;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ kw = ffestr_genio (t);
+ switch (kw)
+ {
+ case FFESTR_genioERR:
+ ffestb_local_.vxtcode.ix = FFESTP_vxtcodeixERR;
+ ffestb_local_.vxtcode.label = TRUE;
+ break;
+
+ case FFESTR_genioIOSTAT:
+ ffestb_local_.vxtcode.ix = FFESTP_vxtcodeixIOSTAT;
+ ffestb_local_.vxtcode.left = TRUE;
+ ffestb_local_.vxtcode.context = FFEEXPR_contextFILEINT;
+ break;
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix]
+ .kw_or_val_present)
+ break; /* Can't specify a keyword twice! */
+ ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix]
+ .kw_or_val_present = TRUE;
+ ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix]
+ .kw_present = TRUE;
+ ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix]
+ .value_present = FALSE;
+ ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value_is_label
+ = ffestb_local_.vxtcode.label;
+ ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].kw
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_vxtcode5_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffestb_subr_kill_vxtcode_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_vxtcode5_ -- "VXTCODE" OPEN_PAREN [external-file-unit COMMA [format
+ COMMA]] NAME
+
+ return ffestb_vxtcode5_; // to lexer
+
+ Make sure EQUALS here, send next token to expression handler. */
+
+static ffelexHandler
+ffestb_vxtcode5_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ if (ffestb_local_.vxtcode.label)
+ return (ffelexHandler) ffestb_vxtcode7_;
+ if (ffestb_local_.vxtcode.left)
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ ffestb_local_.vxtcode.context,
+ (ffeexprCallback) ffestb_vxtcode6_);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestb_local_.vxtcode.context,
+ (ffeexprCallback) ffestb_vxtcode6_);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_vxtcode_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_vxtcode6_ -- "VXTCODE" OPEN_PAREN ... NAME EQUALS expr
+
+ (ffestb_vxtcode6_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_vxtcode6_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value_present
+ = TRUE;
+ ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value
+ = ffelex_token_use (ft);
+ ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_vxtcode4_;
+ return (ffelexHandler) ffestb_vxtcode9_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_vxtcode_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_vxtcode7_ -- "VXTCODE" OPEN_PAREN ... NAME EQUALS
+
+ return ffestb_vxtcode7_; // to lexer
+
+ Handle NUMBER for label here. */
+
+static ffelexHandler
+ffestb_vxtcode7_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value_present
+ = TRUE;
+ ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_vxtcode8_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_vxtcode_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_vxtcode8_ -- "VXTCODE" OPEN_PAREN ... NAME EQUALS NUMBER
+
+ return ffestb_vxtcode8_; // to lexer
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_vxtcode8_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_vxtcode4_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_vxtcode9_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_vxtcode_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_vxtcode9_ -- "VXTCODE" OPEN_PAREN ... CLOSE_PAREN
+
+ return ffestb_vxtcode9_; // to lexer
+
+ Handle EOS or SEMICOLON here.
+
+ 07-Jun-90 JCB 1.1
+ Context for ENCODE/DECODE expressions is now IOLISTDF instead of IOLIST
+ since they apply to internal files. */
+
+static ffelexHandler
+ffestb_vxtcode9_ (ffelexToken t)
+{
+ ffelexHandler next;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (ffesta_first_kw == FFESTR_firstENCODE)
+ {
+ ffestc_V023_start ();
+ ffestc_V023_finish ();
+ }
+ else
+ {
+ ffestc_V024_start ();
+ ffestc_V024_finish ();
+ }
+ }
+ ffestb_subr_kill_vxtcode_ ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeNAME:
+ case FFELEX_typeOPEN_PAREN:
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ if (ffesta_first_kw == FFESTR_firstENCODE)
+ ffestc_V023_start ();
+ else
+ ffestc_V024_start ();
+ ffestb_subr_kill_vxtcode_ ();
+ if (ffesta_first_kw == FFESTR_firstDECODE)
+ next = (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextIOLISTDF,
+ (ffeexprCallback) ffestb_vxtcode10_);
+ else
+ next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextIOLISTDF,
+ (ffeexprCallback) ffestb_vxtcode10_);
+
+ /* EXTENSION: Allow an optional preceding COMMA here if not pedantic.
+ (f2c provides this extension, as do other compilers, supposedly.) */
+
+ if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA))
+ return next;
+
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_vxtcode_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_vxtcode10_ -- "VXTCODE(...)" expr
+
+ (ffestb_vxtcode10_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON here.
+
+ 07-Jun-90 JCB 1.1
+ Context for ENCODE/DECODE expressions is now IOLISTDF instead of IOLIST
+ since they apply to internal files. */
+
+static ffelexHandler
+ffestb_vxtcode10_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ if (ffesta_first_kw == FFESTR_firstENCODE)
+ ffestc_V023_item (expr, ft);
+ else
+ ffestc_V024_item (expr, ft);
+ if (ffesta_first_kw == FFESTR_firstDECODE)
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextIOLISTDF,
+ (ffeexprCallback) ffestb_vxtcode10_);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextIOLISTDF,
+ (ffeexprCallback) ffestb_vxtcode10_);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ if (ffesta_first_kw == FFESTR_firstENCODE)
+ {
+ ffestc_V023_item (expr, ft);
+ ffestc_V023_finish ();
+ }
+ else
+ {
+ ffestc_V024_item (expr, ft);
+ ffestc_V024_finish ();
+ }
+ }
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ if (ffesta_first_kw == FFESTR_firstENCODE)
+ ffestc_V023_finish ();
+ else
+ ffestc_V024_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_R904 -- Parse an OPEN statement
+
+ return ffestb_R904; // to lexer
+
+ Make sure the statement has a valid form for an OPEN statement.
+ If it does, implement the statement. */
+
+ffelexHandler
+ffestb_R904 (ffelexToken t)
+{
+ ffestpOpenIx ix;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstOPEN)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstOPEN)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlOPEN)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ for (ix = 0; ix < FFESTP_openix; ++ix)
+ ffestp_file.open.open_spec[ix].kw_or_val_present = FALSE;
+
+ return (ffelexHandler) ffestb_R9041_;
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_R9041_ -- "OPEN" OPEN_PAREN
+
+ return ffestb_R9041_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_R9041_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9042_;
+
+ default:
+ return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9043_)))
+ (t);
+ }
+}
+
+/* ffestb_R9042_ -- "OPEN" OPEN_PAREN NAME
+
+ return ffestb_R9042_; // to lexer
+
+ If EQUALS here, go to states that handle it. Else, send NAME and this
+ token thru expression handler. */
+
+static ffelexHandler
+ffestb_R9042_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) ffestb_R9044_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9043_)))
+ (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) (*next) (t);
+ }
+}
+
+/* ffestb_R9043_ -- "OPEN" OPEN_PAREN expr
+
+ (ffestb_R9043_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R9043_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.open.open_spec[FFESTP_openixUNIT].kw_or_val_present
+ = TRUE;
+ ffestp_file.open.open_spec[FFESTP_openixUNIT].kw_present = FALSE;
+ ffestp_file.open.open_spec[FFESTP_openixUNIT].value_present = TRUE;
+ ffestp_file.open.open_spec[FFESTP_openixUNIT].value_is_label
+ = FALSE;
+ ffestp_file.open.open_spec[FFESTP_openixUNIT].value
+ = ffelex_token_use (ft);
+ ffestp_file.open.open_spec[FFESTP_openixUNIT].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_R9044_;
+ return (ffelexHandler) ffestb_R9049_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_open_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9044_ -- "OPEN" OPEN_PAREN [external-file-unit COMMA]
+
+ return ffestb_R9044_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_R9044_ (ffelexToken t)
+{
+ ffestrOpen kw;
+
+ ffestb_local_.open.label = FALSE;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ kw = ffestr_open (t);
+ switch (kw)
+ {
+ case FFESTR_openACCESS:
+ ffestb_local_.open.ix = FFESTP_openixACCESS;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_openACTION:
+ ffestb_local_.open.ix = FFESTP_openixACTION;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_openASSOCIATEVARIABLE:
+ ffestb_local_.open.ix = FFESTP_openixASSOCIATEVARIABLE;
+ ffestb_local_.open.left = TRUE;
+ ffestb_local_.open.context = FFEEXPR_contextFILEASSOC;
+ break;
+
+ case FFESTR_openBLANK:
+ ffestb_local_.open.ix = FFESTP_openixBLANK;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_openBLOCKSIZE:
+ ffestb_local_.open.ix = FFESTP_openixBLOCKSIZE;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILENUM;
+ break;
+
+ case FFESTR_openBUFFERCOUNT:
+ ffestb_local_.open.ix = FFESTP_openixBUFFERCOUNT;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILENUM;
+ break;
+
+ case FFESTR_openCARRIAGECONTROL:
+ ffestb_local_.open.ix = FFESTP_openixCARRIAGECONTROL;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
+ break;
+
+ case FFESTR_openDEFAULTFILE:
+ ffestb_local_.open.ix = FFESTP_openixDEFAULTFILE;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
+ break;
+
+ case FFESTR_openDELIM:
+ ffestb_local_.open.ix = FFESTP_openixDELIM;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_openDISP:
+ case FFESTR_openDISPOSE:
+ ffestb_local_.open.ix = FFESTP_openixDISPOSE;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
+ break;
+
+ case FFESTR_openERR:
+ ffestb_local_.open.ix = FFESTP_openixERR;
+ ffestb_local_.open.label = TRUE;
+ break;
+
+ case FFESTR_openEXTENDSIZE:
+ ffestb_local_.open.ix = FFESTP_openixEXTENDSIZE;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILENUM;
+ break;
+
+ case FFESTR_openFILE:
+ case FFESTR_openNAME:
+ ffestb_local_.open.ix = FFESTP_openixFILE;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
+ break;
+
+ case FFESTR_openFORM:
+ ffestb_local_.open.ix = FFESTP_openixFORM;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_openINITIALSIZE:
+ ffestb_local_.open.ix = FFESTP_openixINITIALSIZE;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILENUM;
+ break;
+
+ case FFESTR_openIOSTAT:
+ ffestb_local_.open.ix = FFESTP_openixIOSTAT;
+ ffestb_local_.open.left = TRUE;
+ ffestb_local_.open.context = FFEEXPR_contextFILEINT;
+ break;
+
+#if 0 /* Haven't added support for expression
+ context yet (though easy). */
+ case FFESTR_openKEY:
+ ffestb_local_.open.ix = FFESTP_openixKEY;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILEKEY;
+ break;
+#endif
+
+ case FFESTR_openMAXREC:
+ ffestb_local_.open.ix = FFESTP_openixMAXREC;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILENUM;
+ break;
+
+ case FFESTR_openNOSPANBLOCKS:
+ if (ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
+ .kw_or_val_present)
+ goto bad; /* :::::::::::::::::::: */
+ ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
+ .kw_or_val_present = TRUE;
+ ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
+ .kw_present = TRUE;
+ ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
+ .value_present = FALSE;
+ ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS].kw
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9048_;
+
+ case FFESTR_openORGANIZATION:
+ ffestb_local_.open.ix = FFESTP_openixORGANIZATION;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
+ break;
+
+ case FFESTR_openPAD:
+ ffestb_local_.open.ix = FFESTP_openixPAD;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_openPOSITION:
+ ffestb_local_.open.ix = FFESTP_openixPOSITION;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_openREADONLY:
+ if (ffestp_file.open.open_spec[FFESTP_openixREADONLY]
+ .kw_or_val_present)
+ goto bad; /* :::::::::::::::::::: */
+ ffestp_file.open.open_spec[FFESTP_openixREADONLY]
+ .kw_or_val_present = TRUE;
+ ffestp_file.open.open_spec[FFESTP_openixREADONLY]
+ .kw_present = TRUE;
+ ffestp_file.open.open_spec[FFESTP_openixREADONLY]
+ .value_present = FALSE;
+ ffestp_file.open.open_spec[FFESTP_openixREADONLY].kw
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9048_;
+
+ case FFESTR_openRECL:
+ case FFESTR_openRECORDSIZE:
+ ffestb_local_.open.ix = FFESTP_openixRECL;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILENUM;
+ break;
+
+ case FFESTR_openRECORDTYPE:
+ ffestb_local_.open.ix = FFESTP_openixRECORDTYPE;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
+ break;
+
+ case FFESTR_openSHARED:
+ if (ffestp_file.open.open_spec[FFESTP_openixSHARED]
+ .kw_or_val_present)
+ goto bad; /* :::::::::::::::::::: */
+ ffestp_file.open.open_spec[FFESTP_openixSHARED]
+ .kw_or_val_present = TRUE;
+ ffestp_file.open.open_spec[FFESTP_openixSHARED]
+ .kw_present = TRUE;
+ ffestp_file.open.open_spec[FFESTP_openixSHARED]
+ .value_present = FALSE;
+ ffestp_file.open.open_spec[FFESTP_openixSHARED].kw
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9048_;
+
+ case FFESTR_openSTATUS:
+ case FFESTR_openTYPE:
+ ffestb_local_.open.ix = FFESTP_openixSTATUS;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_openUNIT:
+ ffestb_local_.open.ix = FFESTP_openixUNIT;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILENUM;
+ break;
+
+ case FFESTR_openUSEROPEN:
+ ffestb_local_.open.ix = FFESTP_openixUSEROPEN;
+ ffestb_local_.open.left = TRUE;
+ ffestb_local_.open.context = FFEEXPR_contextFILEEXTFUNC;
+ break;
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.open.open_spec[ffestb_local_.open.ix]
+ .kw_or_val_present)
+ break; /* Can't specify a keyword twice! */
+ ffestp_file.open.open_spec[ffestb_local_.open.ix]
+ .kw_or_val_present = TRUE;
+ ffestp_file.open.open_spec[ffestb_local_.open.ix]
+ .kw_present = TRUE;
+ ffestp_file.open.open_spec[ffestb_local_.open.ix]
+ .value_present = FALSE;
+ ffestp_file.open.open_spec[ffestb_local_.open.ix].value_is_label
+ = ffestb_local_.open.label;
+ ffestp_file.open.open_spec[ffestb_local_.open.ix].kw
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9045_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffestb_subr_kill_open_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9045_ -- "OPEN" OPEN_PAREN [external-file-unit COMMA] NAME
+
+ return ffestb_R9045_; // to lexer
+
+ Make sure EQUALS here, send next token to expression handler. */
+
+static ffelexHandler
+ffestb_R9045_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ if (ffestb_local_.open.label)
+ return (ffelexHandler) ffestb_R9047_;
+ if (ffestb_local_.open.left)
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ ffestb_local_.open.context,
+ (ffeexprCallback) ffestb_R9046_);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestb_local_.open.context,
+ (ffeexprCallback) ffestb_R9046_);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_open_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9046_ -- "OPEN" OPEN_PAREN ... NAME EQUALS expr
+
+ (ffestb_R9046_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R9046_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.open.open_spec[ffestb_local_.open.ix].value_present
+ = TRUE;
+ ffestp_file.open.open_spec[ffestb_local_.open.ix].value
+ = ffelex_token_use (ft);
+ ffestp_file.open.open_spec[ffestb_local_.open.ix].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_R9044_;
+ return (ffelexHandler) ffestb_R9049_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_open_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9047_ -- "OPEN" OPEN_PAREN ... NAME EQUALS
+
+ return ffestb_R9047_; // to lexer
+
+ Handle NUMBER for label here. */
+
+static ffelexHandler
+ffestb_R9047_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffestp_file.open.open_spec[ffestb_local_.open.ix].value_present
+ = TRUE;
+ ffestp_file.open.open_spec[ffestb_local_.open.ix].value
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9048_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_open_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9048_ -- "OPEN" OPEN_PAREN ... NAME EQUALS NUMBER
+
+ return ffestb_R9048_; // to lexer
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R9048_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_R9044_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_R9049_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_open_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9049_ -- "OPEN" OPEN_PAREN ... CLOSE_PAREN
+
+ return ffestb_R9049_; // to lexer
+
+ Handle EOS or SEMICOLON here. */
+
+static ffelexHandler
+ffestb_R9049_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R904 ();
+ ffestb_subr_kill_open_ ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_open_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R907 -- Parse a CLOSE statement
+
+ return ffestb_R907; // to lexer
+
+ Make sure the statement has a valid form for a CLOSE statement.
+ If it does, implement the statement. */
+
+ffelexHandler
+ffestb_R907 (ffelexToken t)
+{
+ ffestpCloseIx ix;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstCLOSE)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstCLOSE)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlCLOSE)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ for (ix = 0; ix < FFESTP_closeix; ++ix)
+ ffestp_file.close.close_spec[ix].kw_or_val_present = FALSE;
+
+ return (ffelexHandler) ffestb_R9071_;
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_R9071_ -- "CLOSE" OPEN_PAREN
+
+ return ffestb_R9071_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_R9071_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9072_;
+
+ default:
+ return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9073_)))
+ (t);
+ }
+}
+
+/* ffestb_R9072_ -- "CLOSE" OPEN_PAREN NAME
+
+ return ffestb_R9072_; // to lexer
+
+ If EQUALS here, go to states that handle it. Else, send NAME and this
+ token thru expression handler. */
+
+static ffelexHandler
+ffestb_R9072_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) ffestb_R9074_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9073_)))
+ (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) (*next) (t);
+ }
+}
+
+/* ffestb_R9073_ -- "CLOSE" OPEN_PAREN expr
+
+ (ffestb_R9073_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R9073_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.close.close_spec[FFESTP_closeixUNIT].kw_or_val_present
+ = TRUE;
+ ffestp_file.close.close_spec[FFESTP_closeixUNIT].kw_present = FALSE;
+ ffestp_file.close.close_spec[FFESTP_closeixUNIT].value_present = TRUE;
+ ffestp_file.close.close_spec[FFESTP_closeixUNIT].value_is_label
+ = FALSE;
+ ffestp_file.close.close_spec[FFESTP_closeixUNIT].value
+ = ffelex_token_use (ft);
+ ffestp_file.close.close_spec[FFESTP_closeixUNIT].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_R9074_;
+ return (ffelexHandler) ffestb_R9079_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_close_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9074_ -- "CLOSE" OPEN_PAREN [external-file-unit COMMA]
+
+ return ffestb_R9074_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_R9074_ (ffelexToken t)
+{
+ ffestrGenio kw;
+
+ ffestb_local_.close.label = FALSE;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ kw = ffestr_genio (t);
+ switch (kw)
+ {
+ case FFESTR_genioERR:
+ ffestb_local_.close.ix = FFESTP_closeixERR;
+ ffestb_local_.close.label = TRUE;
+ break;
+
+ case FFESTR_genioIOSTAT:
+ ffestb_local_.close.ix = FFESTP_closeixIOSTAT;
+ ffestb_local_.close.left = TRUE;
+ ffestb_local_.close.context = FFEEXPR_contextFILEINT;
+ break;
+
+ case FFESTR_genioSTATUS:
+ case FFESTR_genioDISP:
+ case FFESTR_genioDISPOSE:
+ ffestb_local_.close.ix = FFESTP_closeixSTATUS;
+ ffestb_local_.close.left = FALSE;
+ ffestb_local_.close.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_genioUNIT:
+ ffestb_local_.close.ix = FFESTP_closeixUNIT;
+ ffestb_local_.close.left = FALSE;
+ ffestb_local_.close.context = FFEEXPR_contextFILENUM;
+ break;
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.close.close_spec[ffestb_local_.close.ix]
+ .kw_or_val_present)
+ break; /* Can't specify a keyword twice! */
+ ffestp_file.close.close_spec[ffestb_local_.close.ix]
+ .kw_or_val_present = TRUE;
+ ffestp_file.close.close_spec[ffestb_local_.close.ix]
+ .kw_present = TRUE;
+ ffestp_file.close.close_spec[ffestb_local_.close.ix]
+ .value_present = FALSE;
+ ffestp_file.close.close_spec[ffestb_local_.close.ix].value_is_label
+ = ffestb_local_.close.label;
+ ffestp_file.close.close_spec[ffestb_local_.close.ix].kw
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9075_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffestb_subr_kill_close_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9075_ -- "CLOSE" OPEN_PAREN [external-file-unit COMMA] NAME
+
+ return ffestb_R9075_; // to lexer
+
+ Make sure EQUALS here, send next token to expression handler. */
+
+static ffelexHandler
+ffestb_R9075_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ if (ffestb_local_.close.label)
+ return (ffelexHandler) ffestb_R9077_;
+ if (ffestb_local_.close.left)
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ ffestb_local_.close.context,
+ (ffeexprCallback) ffestb_R9076_);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestb_local_.close.context,
+ (ffeexprCallback) ffestb_R9076_);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_close_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9076_ -- "CLOSE" OPEN_PAREN ... NAME EQUALS expr
+
+ (ffestb_R9076_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R9076_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.close.close_spec[ffestb_local_.close.ix].value_present
+ = TRUE;
+ ffestp_file.close.close_spec[ffestb_local_.close.ix].value
+ = ffelex_token_use (ft);
+ ffestp_file.close.close_spec[ffestb_local_.close.ix].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_R9074_;
+ return (ffelexHandler) ffestb_R9079_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_close_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9077_ -- "CLOSE" OPEN_PAREN ... NAME EQUALS
+
+ return ffestb_R9077_; // to lexer
+
+ Handle NUMBER for label here. */
+
+static ffelexHandler
+ffestb_R9077_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffestp_file.close.close_spec[ffestb_local_.close.ix].value_present
+ = TRUE;
+ ffestp_file.close.close_spec[ffestb_local_.close.ix].value
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9078_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_close_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9078_ -- "CLOSE" OPEN_PAREN ... NAME EQUALS NUMBER
+
+ return ffestb_R9078_; // to lexer
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R9078_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_R9074_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_R9079_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_close_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9079_ -- "CLOSE" OPEN_PAREN ... CLOSE_PAREN
+
+ return ffestb_R9079_; // to lexer
+
+ Handle EOS or SEMICOLON here. */
+
+static ffelexHandler
+ffestb_R9079_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R907 ();
+ ffestb_subr_kill_close_ ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_close_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R909 -- Parse the READ statement
+
+ return ffestb_R909; // to lexer
+
+ Make sure the statement has a valid form for the READ
+ statement. If it does, implement the statement. */
+
+ffelexHandler
+ffestb_R909 (ffelexToken t)
+{
+ ffelexHandler next;
+ ffestpReadIx ix;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstREAD)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typeCOLON:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ case FFELEX_typeNUMBER:
+ ffesta_confirmed ();
+ break;
+
+ case FFELEX_typeOPEN_PAREN:
+ for (ix = 0; ix < FFESTP_readix; ++ix)
+ ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9092_;
+
+ default:
+ break;
+ }
+
+ for (ix = 0; ix < FFESTP_readix; ++ix)
+ ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9091_)))
+ (t);
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstREAD)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlREAD)
+ break;
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typeCOLON:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlREAD)
+ break;
+
+ for (ix = 0; ix < FFESTP_readix; ++ix)
+ ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9092_;
+
+ default:
+ break;
+ }
+ for (ix = 0; ix < FFESTP_readix; ++ix)
+ ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
+ next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9091_);
+ next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
+ FFESTR_firstlREAD);
+ if (next == NULL)
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_R9091_ -- "READ" expr
+
+ (ffestb_R9091_) // to expression handler
+
+ Make sure the next token is a COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_R9091_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_or_val_present
+ = TRUE;
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_present = FALSE;
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_present = TRUE;
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_is_label
+ = (expr == NULL);
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].value
+ = ffelex_token_use (ft);
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].u.expr = expr;
+ if (!ffesta_is_inhibited ())
+ ffestc_R909_start (TRUE);
+ ffestb_subr_kill_read_ ();
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ ffestc_context_iolist (),
+ (ffeexprCallback) ffestb_R90915_);
+ if (!ffesta_is_inhibited ())
+ ffestc_R909_finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_read_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9092_ -- "READ" OPEN_PAREN
+
+ return ffestb_R9092_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_R9092_ (ffelexToken t)
+{
+ ffelexToken nt;
+ ffelexHandler next;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9093_;
+
+ default:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEUNITAMBIG, (ffeexprCallback) ffestb_R9094_)))
+ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+ }
+}
+
+/* ffestb_R9093_ -- "READ" OPEN_PAREN NAME
+
+ return ffestb_R9093_; // to lexer
+
+ If EQUALS here, go to states that handle it. Else, send NAME and this
+ token thru expression handler. */
+
+static ffelexHandler
+ffestb_R9093_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken nt;
+ ffelexToken ot;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffelex_token_kill (ffesta_tokens[1]);
+ nt = ffesta_tokens[2];
+ next = (ffelexHandler) ffestb_R9098_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ nt = ffesta_tokens[1];
+ ot = ffesta_tokens[2];
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEUNITAMBIG, (ffeexprCallback) ffestb_R9094_)))
+ (nt);
+ ffelex_token_kill (nt);
+ next = (ffelexHandler) (*next) (ot);
+ ffelex_token_kill (ot);
+ return (ffelexHandler) (*next) (t);
+ }
+}
+
+/* ffestb_R9094_ -- "READ" OPEN_PAREN expr [CLOSE_PAREN]
+
+ (ffestb_R9094_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON here.
+
+ 15-Feb-91 JCB 1.1
+ Use new ffeexpr mechanism whereby the expr is encased in an opITEM if
+ ffeexpr decided it was an item in a control list (hence a unit
+ specifier), or a format specifier otherwise. */
+
+static ffelexHandler
+ffestb_R9094_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ if (expr == NULL)
+ goto bad; /* :::::::::::::::::::: */
+
+ if (ffebld_op (expr) != FFEBLD_opITEM)
+ {
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_or_val_present
+ = TRUE;
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_present = FALSE;
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_present = TRUE;
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_is_label
+ = FALSE;
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].value
+ = ffelex_token_use (ft);
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].u.expr = expr;
+ if (!ffesta_is_inhibited ())
+ ffestc_R909_start (TRUE);
+ ffestb_subr_kill_read_ ();
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler)
+ ffeexpr_lhs (ffesta_output_pool,
+ ffestc_context_iolist (),
+ (ffeexprCallback) ffestb_R90915_);
+ if (!ffesta_is_inhibited ())
+ ffestc_R909_finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ }
+
+ expr = ffebld_head (expr);
+
+ if (expr == NULL)
+ goto bad; /* :::::::::::::::::::: */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ ffestp_file.read.read_spec[FFESTP_readixUNIT].kw_or_val_present
+ = TRUE;
+ ffestp_file.read.read_spec[FFESTP_readixUNIT].kw_present = FALSE;
+ ffestp_file.read.read_spec[FFESTP_readixUNIT].value_present = TRUE;
+ ffestp_file.read.read_spec[FFESTP_readixUNIT].value_is_label
+ = FALSE;
+ ffestp_file.read.read_spec[FFESTP_readixUNIT].value
+ = ffelex_token_use (ft);
+ ffestp_file.read.read_spec[FFESTP_readixUNIT].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_R9095_;
+ return (ffelexHandler) ffestb_R90913_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffestb_subr_kill_read_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9095_ -- "READ" OPEN_PAREN expr COMMA
+
+ return ffestb_R9095_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_R9095_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9096_;
+
+ default:
+ return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9097_)))
+ (t);
+ }
+}
+
+/* ffestb_R9096_ -- "READ" OPEN_PAREN expr COMMA NAME
+
+ return ffestb_R9096_; // to lexer
+
+ If EQUALS here, go to states that handle it. Else, send NAME and this
+ token thru expression handler. */
+
+static ffelexHandler
+ffestb_R9096_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) ffestb_R9098_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9097_)))
+ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+ }
+}
+
+/* ffestb_R9097_ -- "READ" OPEN_PAREN expr COMMA expr
+
+ (ffestb_R9097_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R9097_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_or_val_present
+ = TRUE;
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_present = FALSE;
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_present = TRUE;
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_is_label
+ = (expr == NULL);
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].value
+ = ffelex_token_use (ft);
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_R9098_;
+ return (ffelexHandler) ffestb_R90913_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_read_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9098_ -- "READ" OPEN_PAREN [external-file-unit COMMA [format
+ COMMA]]
+
+ return ffestb_R9098_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_R9098_ (ffelexToken t)
+{
+ ffestrGenio kw;
+
+ ffestb_local_.read.label = FALSE;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ kw = ffestr_genio (t);
+ switch (kw)
+ {
+ case FFESTR_genioADVANCE:
+ ffestb_local_.read.ix = FFESTP_readixADVANCE;
+ ffestb_local_.read.left = FALSE;
+ ffestb_local_.read.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_genioEOR:
+ ffestb_local_.read.ix = FFESTP_readixEOR;
+ ffestb_local_.read.label = TRUE;
+ break;
+
+ case FFESTR_genioERR:
+ ffestb_local_.read.ix = FFESTP_readixERR;
+ ffestb_local_.read.label = TRUE;
+ break;
+
+ case FFESTR_genioEND:
+ ffestb_local_.read.ix = FFESTP_readixEND;
+ ffestb_local_.read.label = TRUE;
+ break;
+
+ case FFESTR_genioFMT:
+ ffestb_local_.read.ix = FFESTP_readixFORMAT;
+ ffestb_local_.read.left = FALSE;
+ ffestb_local_.read.context = FFEEXPR_contextFILEFORMAT;
+ break;
+
+ case FFESTR_genioIOSTAT:
+ ffestb_local_.read.ix = FFESTP_readixIOSTAT;
+ ffestb_local_.read.left = TRUE;
+ ffestb_local_.read.context = FFEEXPR_contextFILEINT;
+ break;
+
+ case FFESTR_genioKEY:
+ case FFESTR_genioKEYEQ:
+ ffestb_local_.read.ix = FFESTP_readixKEYEQ;
+ ffestb_local_.read.left = FALSE;
+ ffestb_local_.read.context = FFEEXPR_contextFILENUMCHAR;
+ break;
+
+ case FFESTR_genioKEYGE:
+ ffestb_local_.read.ix = FFESTP_readixKEYGE;
+ ffestb_local_.read.left = FALSE;
+ ffestb_local_.read.context = FFEEXPR_contextFILENUMCHAR;
+ break;
+
+ case FFESTR_genioKEYGT:
+ ffestb_local_.read.ix = FFESTP_readixKEYGT;
+ ffestb_local_.read.left = FALSE;
+ ffestb_local_.read.context = FFEEXPR_contextFILENUMCHAR;
+ break;
+
+ case FFESTR_genioKEYID:
+ ffestb_local_.read.ix = FFESTP_readixKEYID;
+ ffestb_local_.read.left = FALSE;
+ ffestb_local_.read.context = FFEEXPR_contextFILENUM;
+ break;
+
+ case FFESTR_genioNML:
+ ffestb_local_.read.ix = FFESTP_readixFORMAT;
+ ffestb_local_.read.left = TRUE;
+ ffestb_local_.read.context = FFEEXPR_contextFILENAMELIST;
+ break;
+
+ case FFESTR_genioNULLS:
+ ffestb_local_.read.ix = FFESTP_readixNULLS;
+ ffestb_local_.read.left = TRUE;
+ ffestb_local_.read.context = FFEEXPR_contextFILEINT;
+ break;
+
+ case FFESTR_genioREC:
+ ffestb_local_.read.ix = FFESTP_readixREC;
+ ffestb_local_.read.left = FALSE;
+ ffestb_local_.read.context = FFEEXPR_contextFILENUM;
+ break;
+
+ case FFESTR_genioSIZE:
+ ffestb_local_.read.ix = FFESTP_readixSIZE;
+ ffestb_local_.read.left = TRUE;
+ ffestb_local_.read.context = FFEEXPR_contextFILEINT;
+ break;
+
+ case FFESTR_genioUNIT:
+ ffestb_local_.read.ix = FFESTP_readixUNIT;
+ ffestb_local_.read.left = FALSE;
+ ffestb_local_.read.context = FFEEXPR_contextFILEUNIT;
+ break;
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.read.read_spec[ffestb_local_.read.ix]
+ .kw_or_val_present)
+ break; /* Can't specify a keyword twice! */
+ ffestp_file.read.read_spec[ffestb_local_.read.ix]
+ .kw_or_val_present = TRUE;
+ ffestp_file.read.read_spec[ffestb_local_.read.ix]
+ .kw_present = TRUE;
+ ffestp_file.read.read_spec[ffestb_local_.read.ix]
+ .value_present = FALSE;
+ ffestp_file.read.read_spec[ffestb_local_.read.ix].value_is_label
+ = ffestb_local_.read.label;
+ ffestp_file.read.read_spec[ffestb_local_.read.ix].kw
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9099_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffestb_subr_kill_read_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9099_ -- "READ" OPEN_PAREN [external-file-unit COMMA [format
+ COMMA]] NAME
+
+ return ffestb_R9099_; // to lexer
+
+ Make sure EQUALS here, send next token to expression handler. */
+
+static ffelexHandler
+ffestb_R9099_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ if (ffestb_local_.read.label)
+ return (ffelexHandler) ffestb_R90911_;
+ if (ffestb_local_.read.left)
+ return (ffelexHandler)
+ ffeexpr_lhs (ffesta_output_pool,
+ ffestb_local_.read.context,
+ (ffeexprCallback) ffestb_R90910_);
+ return (ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool,
+ ffestb_local_.read.context,
+ (ffeexprCallback) ffestb_R90910_);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_read_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R90910_ -- "READ" OPEN_PAREN ... NAME EQUALS expr
+
+ (ffestb_R90910_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R90910_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ if (ffestb_local_.read.context == FFEEXPR_contextFILEFORMAT)
+ ffestp_file.read.read_spec[ffestb_local_.read.ix]
+ .value_is_label = TRUE;
+ else
+ break;
+ ffestp_file.read.read_spec[ffestb_local_.read.ix].value_present
+ = TRUE;
+ ffestp_file.read.read_spec[ffestb_local_.read.ix].value
+ = ffelex_token_use (ft);
+ ffestp_file.read.read_spec[ffestb_local_.read.ix].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_R9098_;
+ return (ffelexHandler) ffestb_R90913_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_read_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R90911_ -- "READ" OPEN_PAREN ... NAME EQUALS
+
+ return ffestb_R90911_; // to lexer
+
+ Handle NUMBER for label here. */
+
+static ffelexHandler
+ffestb_R90911_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffestp_file.read.read_spec[ffestb_local_.read.ix].value_present
+ = TRUE;
+ ffestp_file.read.read_spec[ffestb_local_.read.ix].value
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R90912_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_read_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R90912_ -- "READ" OPEN_PAREN ... NAME EQUALS NUMBER
+
+ return ffestb_R90912_; // to lexer
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R90912_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_R9098_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_R90913_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_read_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R90913_ -- "READ" OPEN_PAREN ... CLOSE_PAREN
+
+ return ffestb_R90913_; // to lexer
+
+ Handle EOS or SEMICOLON here.
+
+ 15-Feb-91 JCB 1.1
+ Fix to allow implied-DO construct here (OPEN_PAREN) -- actually,
+ don't presume knowledge of what an initial token in an lhs context
+ is going to be, let ffeexpr_lhs handle that as much as possible. */
+
+static ffelexHandler
+ffestb_R90913_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R909_start (FALSE);
+ ffestc_R909_finish ();
+ }
+ ffestb_subr_kill_read_ ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_confirmed ();
+ /* Fall through. */
+ case FFELEX_typeOPEN_PAREN: /* Could still be assignment!! */
+ break;
+ }
+
+ /* If token isn't NAME or OPEN_PAREN, ffeexpr_lhs will ultimately whine
+ about it, so leave it up to that code. */
+
+ /* EXTENSION: Allow an optional preceding COMMA here if not pedantic. (f2c
+ provides this extension, as do other compilers, supposedly.) */
+
+ if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA))
+ return (ffelexHandler)
+ ffeexpr_lhs (ffesta_output_pool,
+ ffestc_context_iolist (),
+ (ffeexprCallback) ffestb_R90914_);
+
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_lhs (ffesta_output_pool,
+ ffestc_context_iolist (),
+ (ffeexprCallback) ffestb_R90914_)))
+ (t);
+}
+
+/* ffestb_R90914_ -- "READ(...)" expr
+
+ (ffestb_R90914_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON here. */
+
+static ffelexHandler
+ffestb_R90914_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R909_start (FALSE);
+ ffestb_subr_kill_read_ ();
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R909_item (expr, ft);
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ ffestc_context_iolist (),
+ (ffeexprCallback) ffestb_R90915_);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R909_start (FALSE);
+ ffestb_subr_kill_read_ ();
+
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R909_item (expr, ft);
+ ffestc_R909_finish ();
+ }
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_read_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R90915_ -- "READ(...)" expr COMMA expr
+
+ (ffestb_R90915_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON here. */
+
+static ffelexHandler
+ffestb_R90915_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_R909_item (expr, ft);
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ ffestc_context_iolist (),
+ (ffeexprCallback) ffestb_R90915_);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R909_item (expr, ft);
+ ffestc_R909_finish ();
+ }
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R909_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R910 -- Parse the WRITE statement
+
+ return ffestb_R910; // to lexer
+
+ Make sure the statement has a valid form for the WRITE
+ statement. If it does, implement the statement. */
+
+ffelexHandler
+ffestb_R910 (ffelexToken t)
+{
+ ffestpWriteIx ix;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstWRITE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeNAME:
+ case FFELEX_typeNUMBER:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ for (ix = 0; ix < FFESTP_writeix; ++ix)
+ ffestp_file.write.write_spec[ix].kw_or_val_present = FALSE;
+ return (ffelexHandler) ffestb_R9101_;
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstWRITE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlWRITE)
+ goto bad_0; /* :::::::::::::::::::: */
+
+ for (ix = 0; ix < FFESTP_writeix; ++ix)
+ ffestp_file.write.write_spec[ix].kw_or_val_present = FALSE;
+ return (ffelexHandler) ffestb_R9101_;
+ }
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_R9101_ -- "WRITE" OPEN_PAREN
+
+ return ffestb_R9101_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_R9101_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9102_;
+
+ default:
+ return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEUNIT, (ffeexprCallback) ffestb_R9103_)))
+ (t);
+ }
+}
+
+/* ffestb_R9102_ -- "WRITE" OPEN_PAREN NAME
+
+ return ffestb_R9102_; // to lexer
+
+ If EQUALS here, go to states that handle it. Else, send NAME and this
+ token thru expression handler. */
+
+static ffelexHandler
+ffestb_R9102_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) ffestb_R9107_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEUNIT, (ffeexprCallback) ffestb_R9103_)))
+ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+ }
+}
+
+/* ffestb_R9103_ -- "WRITE" OPEN_PAREN expr [CLOSE_PAREN]
+
+ (ffestb_R9103_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON here. */
+
+static ffelexHandler
+ffestb_R9103_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.write.write_spec[FFESTP_writeixUNIT].kw_or_val_present
+ = TRUE;
+ ffestp_file.write.write_spec[FFESTP_writeixUNIT].kw_present = FALSE;
+ ffestp_file.write.write_spec[FFESTP_writeixUNIT].value_present = TRUE;
+ ffestp_file.write.write_spec[FFESTP_writeixUNIT].value_is_label
+ = FALSE;
+ ffestp_file.write.write_spec[FFESTP_writeixUNIT].value
+ = ffelex_token_use (ft);
+ ffestp_file.write.write_spec[FFESTP_writeixUNIT].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_R9104_;
+ return (ffelexHandler) ffestb_R91012_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_write_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9104_ -- "WRITE" OPEN_PAREN expr COMMA
+
+ return ffestb_R9104_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_R9104_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9105_;
+
+ default:
+ return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9106_)))
+ (t);
+ }
+}
+
+/* ffestb_R9105_ -- "WRITE" OPEN_PAREN expr COMMA NAME
+
+ return ffestb_R9105_; // to lexer
+
+ If EQUALS here, go to states that handle it. Else, send NAME and this
+ token thru expression handler. */
+
+static ffelexHandler
+ffestb_R9105_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) ffestb_R9107_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9106_)))
+ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+ }
+}
+
+/* ffestb_R9106_ -- "WRITE" OPEN_PAREN expr COMMA expr
+
+ (ffestb_R9106_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R9106_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ ffestp_file.write.write_spec[FFESTP_writeixFORMAT].kw_or_val_present
+ = TRUE;
+ ffestp_file.write.write_spec[FFESTP_writeixFORMAT].kw_present = FALSE;
+ ffestp_file.write.write_spec[FFESTP_writeixFORMAT].value_present = TRUE;
+ ffestp_file.write.write_spec[FFESTP_writeixFORMAT].value_is_label
+ = (expr == NULL);
+ ffestp_file.write.write_spec[FFESTP_writeixFORMAT].value
+ = ffelex_token_use (ft);
+ ffestp_file.write.write_spec[FFESTP_writeixFORMAT].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_R9107_;
+ return (ffelexHandler) ffestb_R91012_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_write_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9107_ -- "WRITE" OPEN_PAREN [external-file-unit COMMA [format
+ COMMA]]
+
+ return ffestb_R9107_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_R9107_ (ffelexToken t)
+{
+ ffestrGenio kw;
+
+ ffestb_local_.write.label = FALSE;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ kw = ffestr_genio (t);
+ switch (kw)
+ {
+ case FFESTR_genioADVANCE:
+ ffestb_local_.write.ix = FFESTP_writeixADVANCE;
+ ffestb_local_.write.left = FALSE;
+ ffestb_local_.write.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_genioEOR:
+ ffestb_local_.write.ix = FFESTP_writeixEOR;
+ ffestb_local_.write.label = TRUE;
+ break;
+
+ case FFESTR_genioERR:
+ ffestb_local_.write.ix = FFESTP_writeixERR;
+ ffestb_local_.write.label = TRUE;
+ break;
+
+ case FFESTR_genioFMT:
+ ffestb_local_.write.ix = FFESTP_writeixFORMAT;
+ ffestb_local_.write.left = FALSE;
+ ffestb_local_.write.context = FFEEXPR_contextFILEFORMAT;
+ break;
+
+ case FFESTR_genioIOSTAT:
+ ffestb_local_.write.ix = FFESTP_writeixIOSTAT;
+ ffestb_local_.write.left = TRUE;
+ ffestb_local_.write.context = FFEEXPR_contextFILEINT;
+ break;
+
+ case FFESTR_genioNML:
+ ffestb_local_.write.ix = FFESTP_writeixFORMAT;
+ ffestb_local_.write.left = TRUE;
+ ffestb_local_.write.context = FFEEXPR_contextFILENAMELIST;
+ break;
+
+ case FFESTR_genioREC:
+ ffestb_local_.write.ix = FFESTP_writeixREC;
+ ffestb_local_.write.left = FALSE;
+ ffestb_local_.write.context = FFEEXPR_contextFILENUM;
+ break;
+
+ case FFESTR_genioUNIT:
+ ffestb_local_.write.ix = FFESTP_writeixUNIT;
+ ffestb_local_.write.left = FALSE;
+ ffestb_local_.write.context = FFEEXPR_contextFILEUNIT;
+ break;
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.write.write_spec[ffestb_local_.write.ix]
+ .kw_or_val_present)
+ break; /* Can't specify a keyword twice! */
+ ffestp_file.write.write_spec[ffestb_local_.write.ix]
+ .kw_or_val_present = TRUE;
+ ffestp_file.write.write_spec[ffestb_local_.write.ix]
+ .kw_present = TRUE;
+ ffestp_file.write.write_spec[ffestb_local_.write.ix]
+ .value_present = FALSE;
+ ffestp_file.write.write_spec[ffestb_local_.write.ix].value_is_label
+ = ffestb_local_.write.label;
+ ffestp_file.write.write_spec[ffestb_local_.write.ix].kw
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9108_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffestb_subr_kill_write_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9108_ -- "WRITE" OPEN_PAREN [external-file-unit COMMA [format
+ COMMA]] NAME
+
+ return ffestb_R9108_; // to lexer
+
+ Make sure EQUALS here, send next token to expression handler. */
+
+static ffelexHandler
+ffestb_R9108_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ if (ffestb_local_.write.label)
+ return (ffelexHandler) ffestb_R91010_;
+ if (ffestb_local_.write.left)
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ ffestb_local_.write.context,
+ (ffeexprCallback) ffestb_R9109_);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestb_local_.write.context,
+ (ffeexprCallback) ffestb_R9109_);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_write_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9109_ -- "WRITE" OPEN_PAREN ... NAME EQUALS expr
+
+ (ffestb_R9109_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R9109_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ if (ffestb_local_.write.context == FFEEXPR_contextFILEFORMAT)
+ ffestp_file.write.write_spec[ffestb_local_.write.ix]
+ .value_is_label = TRUE;
+ else
+ break;
+ ffestp_file.write.write_spec[ffestb_local_.write.ix].value_present
+ = TRUE;
+ ffestp_file.write.write_spec[ffestb_local_.write.ix].value
+ = ffelex_token_use (ft);
+ ffestp_file.write.write_spec[ffestb_local_.write.ix].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_R9107_;
+ return (ffelexHandler) ffestb_R91012_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_write_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R91010_ -- "WRITE" OPEN_PAREN ... NAME EQUALS
+
+ return ffestb_R91010_; // to lexer
+
+ Handle NUMBER for label here. */
+
+static ffelexHandler
+ffestb_R91010_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffestp_file.write.write_spec[ffestb_local_.write.ix].value_present
+ = TRUE;
+ ffestp_file.write.write_spec[ffestb_local_.write.ix].value
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R91011_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_write_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R91011_ -- "WRITE" OPEN_PAREN ... NAME EQUALS NUMBER
+
+ return ffestb_R91011_; // to lexer
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R91011_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_R9107_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_R91012_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_write_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R91012_ -- "WRITE" OPEN_PAREN ... CLOSE_PAREN
+
+ return ffestb_R91012_; // to lexer
+
+ Handle EOS or SEMICOLON here. */
+
+static ffelexHandler
+ffestb_R91012_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R910_start ();
+ ffestc_R910_finish ();
+ }
+ ffestb_subr_kill_write_ ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_confirmed ();
+ /* Fall through. */
+ case FFELEX_typeOPEN_PAREN: /* Could still be assignment!! */
+
+ /* EXTENSION: Allow an optional preceding COMMA here if not pedantic.
+ (f2c provides this extension, as do other compilers, supposedly.) */
+
+ if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA))
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestc_context_iolist (), (ffeexprCallback) ffestb_R91013_);
+
+ return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestc_context_iolist (), (ffeexprCallback) ffestb_R91013_)))
+ (t);
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ break;
+ }
+
+ ffestb_subr_kill_write_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R91013_ -- "WRITE(...)" expr
+
+ (ffestb_R91013_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON here. */
+
+static ffelexHandler
+ffestb_R91013_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R910_start ();
+ ffestb_subr_kill_write_ ();
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R910_item (expr, ft);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestc_context_iolist (), (ffeexprCallback) ffestb_R91014_);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R910_start ();
+ ffestb_subr_kill_write_ ();
+
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R910_item (expr, ft);
+ ffestc_R910_finish ();
+ }
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_write_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R91014_ -- "WRITE(...)" expr COMMA expr
+
+ (ffestb_R91014_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON here. */
+
+static ffelexHandler
+ffestb_R91014_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_R910_item (expr, ft);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestc_context_iolist (), (ffeexprCallback) ffestb_R91014_);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R910_item (expr, ft);
+ ffestc_R910_finish ();
+ }
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R910_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R911 -- Parse the PRINT statement
+
+ return ffestb_R911; // to lexer
+
+ Make sure the statement has a valid form for the PRINT
+ statement. If it does, implement the statement. */
+
+ffelexHandler
+ffestb_R911 (ffelexToken t)
+{
+ ffelexHandler next;
+ ffestpPrintIx ix;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstPRINT)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typeCOLON:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ case FFELEX_typeNUMBER:
+ ffesta_confirmed ();
+ break;
+
+ default:
+ break;
+ }
+
+ for (ix = 0; ix < FFESTP_printix; ++ix)
+ ffestp_file.print.print_spec[ix].kw_or_val_present = FALSE;
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9111_)))
+ (t);
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstPRINT)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlPRINT)
+ break;
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typeCOLON:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ break;
+ }
+ for (ix = 0; ix < FFESTP_printix; ++ix)
+ ffestp_file.print.print_spec[ix].kw_or_val_present = FALSE;
+ next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9111_);
+ next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
+ FFESTR_firstlPRINT);
+ if (next == NULL)
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_R9111_ -- "PRINT" expr
+
+ (ffestb_R9111_) // to expression handler
+
+ Make sure the next token is a COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_R9111_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ ffestp_file.print.print_spec[FFESTP_printixFORMAT].kw_or_val_present
+ = TRUE;
+ ffestp_file.print.print_spec[FFESTP_printixFORMAT].kw_present = FALSE;
+ ffestp_file.print.print_spec[FFESTP_printixFORMAT].value_present = TRUE;
+ ffestp_file.print.print_spec[FFESTP_printixFORMAT].value_is_label
+ = (expr == NULL);
+ ffestp_file.print.print_spec[FFESTP_printixFORMAT].value
+ = ffelex_token_use (ft);
+ ffestp_file.print.print_spec[FFESTP_printixFORMAT].u.expr = expr;
+ if (!ffesta_is_inhibited ())
+ ffestc_R911_start ();
+ ffestb_subr_kill_print_ ();
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R9112_);
+ if (!ffesta_is_inhibited ())
+ ffestc_R911_finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_print_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9112_ -- "PRINT" expr COMMA expr
+
+ (ffestb_R9112_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON here. */
+
+static ffelexHandler
+ffestb_R9112_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_R911_item (expr, ft);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R9112_);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R911_item (expr, ft);
+ ffestc_R911_finish ();
+ }
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R911_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R923 -- Parse an INQUIRE statement
+
+ return ffestb_R923; // to lexer
+
+ Make sure the statement has a valid form for an INQUIRE statement.
+ If it does, implement the statement. */
+
+ffelexHandler
+ffestb_R923 (ffelexToken t)
+{
+ ffestpInquireIx ix;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstINQUIRE)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstINQUIRE)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlINQUIRE)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ for (ix = 0; ix < FFESTP_inquireix; ++ix)
+ ffestp_file.inquire.inquire_spec[ix].kw_or_val_present = FALSE;
+
+ ffestb_local_.inquire.may_be_iolength = TRUE;
+ return (ffelexHandler) ffestb_R9231_;
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_R9231_ -- "INQUIRE" OPEN_PAREN
+
+ return ffestb_R9231_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_R9231_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9232_;
+
+ default:
+ ffestb_local_.inquire.may_be_iolength = FALSE;
+ return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9233_)))
+ (t);
+ }
+}
+
+/* ffestb_R9232_ -- "INQUIRE" OPEN_PAREN NAME
+
+ return ffestb_R9232_; // to lexer
+
+ If EQUALS here, go to states that handle it. Else, send NAME and this
+ token thru expression handler. */
+
+static ffelexHandler
+ffestb_R9232_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) ffestb_R9234_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ ffestb_local_.inquire.may_be_iolength = FALSE;
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9233_)))
+ (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) (*next) (t);
+ }
+}
+
+/* ffestb_R9233_ -- "INQUIRE" OPEN_PAREN expr
+
+ (ffestb_R9233_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R9233_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw_or_val_present
+ = TRUE;
+ ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw_present = FALSE;
+ ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value_present = TRUE;
+ ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value_is_label
+ = FALSE;
+ ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value
+ = ffelex_token_use (ft);
+ ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_R9234_;
+ return (ffelexHandler) ffestb_R9239_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_inquire_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9234_ -- "INQUIRE" OPEN_PAREN [external-file-unit COMMA]
+
+ return ffestb_R9234_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_R9234_ (ffelexToken t)
+{
+ ffestrInquire kw;
+
+ ffestb_local_.inquire.label = FALSE;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ kw = ffestr_inquire (t);
+ if (kw != FFESTR_inquireIOLENGTH)
+ ffestb_local_.inquire.may_be_iolength = FALSE;
+ switch (kw)
+ {
+ case FFESTR_inquireACCESS:
+ ffestb_local_.inquire.ix = FFESTP_inquireixACCESS;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_inquireACTION:
+ ffestb_local_.inquire.ix = FFESTP_inquireixACTION;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_inquireBLANK:
+ ffestb_local_.inquire.ix = FFESTP_inquireixBLANK;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_inquireCARRIAGECONTROL:
+ ffestb_local_.inquire.ix = FFESTP_inquireixCARRIAGECONTROL;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
+ break;
+
+ case FFESTR_inquireDEFAULTFILE:
+ ffestb_local_.inquire.ix = FFESTP_inquireixDEFAULTFILE;
+ ffestb_local_.inquire.left = FALSE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
+ break;
+
+ case FFESTR_inquireDELIM:
+ ffestb_local_.inquire.ix = FFESTP_inquireixDELIM;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_inquireDIRECT:
+ ffestb_local_.inquire.ix = FFESTP_inquireixDIRECT;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_inquireERR:
+ ffestb_local_.inquire.ix = FFESTP_inquireixERR;
+ ffestb_local_.inquire.label = TRUE;
+ break;
+
+ case FFESTR_inquireEXIST:
+ ffestb_local_.inquire.ix = FFESTP_inquireixEXIST;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILELOG;
+ break;
+
+ case FFESTR_inquireFILE:
+ ffestb_local_.inquire.ix = FFESTP_inquireixFILE;
+ ffestb_local_.inquire.left = FALSE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
+ break;
+
+ case FFESTR_inquireFORM:
+ ffestb_local_.inquire.ix = FFESTP_inquireixFORM;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_inquireFORMATTED:
+ ffestb_local_.inquire.ix = FFESTP_inquireixFORMATTED;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_inquireIOLENGTH:
+ if (!ffestb_local_.inquire.may_be_iolength)
+ goto bad; /* :::::::::::::::::::: */
+ ffestb_local_.inquire.ix = FFESTP_inquireixIOLENGTH;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
+ break;
+
+ case FFESTR_inquireIOSTAT:
+ ffestb_local_.inquire.ix = FFESTP_inquireixIOSTAT;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
+ break;
+
+ case FFESTR_inquireKEYED:
+ ffestb_local_.inquire.ix = FFESTP_inquireixKEYED;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
+ break;
+
+ case FFESTR_inquireNAME:
+ ffestb_local_.inquire.ix = FFESTP_inquireixNAME;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
+ break;
+
+ case FFESTR_inquireNAMED:
+ ffestb_local_.inquire.ix = FFESTP_inquireixNAMED;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILELOG;
+ break;
+
+ case FFESTR_inquireNEXTREC:
+ ffestb_local_.inquire.ix = FFESTP_inquireixNEXTREC;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFINT;
+ break;
+
+ case FFESTR_inquireNUMBER:
+ ffestb_local_.inquire.ix = FFESTP_inquireixNUMBER;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
+ break;
+
+ case FFESTR_inquireOPENED:
+ ffestb_local_.inquire.ix = FFESTP_inquireixOPENED;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILELOG;
+ break;
+
+ case FFESTR_inquireORGANIZATION:
+ ffestb_local_.inquire.ix = FFESTP_inquireixORGANIZATION;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
+ break;
+
+ case FFESTR_inquirePAD:
+ ffestb_local_.inquire.ix = FFESTP_inquireixPAD;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_inquirePOSITION:
+ ffestb_local_.inquire.ix = FFESTP_inquireixPOSITION;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_inquireREAD:
+ ffestb_local_.inquire.ix = FFESTP_inquireixREAD;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_inquireREADWRITE:
+ ffestb_local_.inquire.ix = FFESTP_inquireixREADWRITE;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_inquireRECL:
+ ffestb_local_.inquire.ix = FFESTP_inquireixRECL;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
+ break;
+
+ case FFESTR_inquireRECORDTYPE:
+ ffestb_local_.inquire.ix = FFESTP_inquireixRECORDTYPE;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
+ break;
+
+ case FFESTR_inquireSEQUENTIAL:
+ ffestb_local_.inquire.ix = FFESTP_inquireixSEQUENTIAL;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_inquireUNFORMATTED:
+ ffestb_local_.inquire.ix = FFESTP_inquireixUNFORMATTED;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_inquireUNIT:
+ ffestb_local_.inquire.ix = FFESTP_inquireixUNIT;
+ ffestb_local_.inquire.left = FALSE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILENUM;
+ break;
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
+ .kw_or_val_present)
+ break; /* Can't specify a keyword twice! */
+ ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
+ .kw_or_val_present = TRUE;
+ ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
+ .kw_present = TRUE;
+ ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
+ .value_present = FALSE;
+ ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value_is_label
+ = ffestb_local_.inquire.label;
+ ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].kw
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9235_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffestb_subr_kill_inquire_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9235_ -- "INQUIRE" OPEN_PAREN [external-file-unit COMMA] NAME
+
+ return ffestb_R9235_; // to lexer
+
+ Make sure EQUALS here, send next token to expression handler. */
+
+static ffelexHandler
+ffestb_R9235_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ if (ffestb_local_.inquire.label)
+ return (ffelexHandler) ffestb_R9237_;
+ if (ffestb_local_.inquire.left)
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ ffestb_local_.inquire.context,
+ (ffeexprCallback) ffestb_R9236_);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestb_local_.inquire.context,
+ (ffeexprCallback) ffestb_R9236_);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_inquire_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9236_ -- "INQUIRE" OPEN_PAREN ... NAME EQUALS expr
+
+ (ffestb_R9236_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R9236_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (ffestb_local_.inquire.ix == FFESTP_inquireixIOLENGTH)
+ break; /* IOLENGTH=expr must be followed by
+ CLOSE_PAREN. */
+ /* Fall through. */
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value_present
+ = TRUE;
+ ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value
+ = ffelex_token_use (ft);
+ ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_R9234_;
+ if (ffestb_local_.inquire.ix == FFESTP_inquireixIOLENGTH)
+ return (ffelexHandler) ffestb_R92310_;
+ return (ffelexHandler) ffestb_R9239_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_inquire_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9237_ -- "INQUIRE" OPEN_PAREN ... NAME EQUALS
+
+ return ffestb_R9237_; // to lexer
+
+ Handle NUMBER for label here. */
+
+static ffelexHandler
+ffestb_R9237_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value_present
+ = TRUE;
+ ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9238_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_inquire_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9238_ -- "INQUIRE" OPEN_PAREN ... NAME EQUALS NUMBER
+
+ return ffestb_R9238_; // to lexer
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R9238_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_R9234_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_R9239_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_inquire_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9239_ -- "INQUIRE" OPEN_PAREN ... CLOSE_PAREN
+
+ return ffestb_R9239_; // to lexer
+
+ Handle EOS or SEMICOLON here. */
+
+static ffelexHandler
+ffestb_R9239_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R923A ();
+ ffestb_subr_kill_inquire_ ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_inquire_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R92310_ -- "INQUIRE(IOLENGTH=expr)"
+
+ return ffestb_R92310_; // to lexer
+
+ Make sure EOS or SEMICOLON not here; begin R923B processing and expect
+ output IO list. */
+
+static ffelexHandler
+ffestb_R92310_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ break;
+
+ default:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R923B_start ();
+ ffestb_subr_kill_inquire_ ();
+ return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R92311_)))
+ (t);
+ }
+
+ ffestb_subr_kill_inquire_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R92311_ -- "INQUIRE(IOLENGTH=expr)" expr
+
+ (ffestb_R92311_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON here. */
+
+static ffelexHandler
+ffestb_R92311_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_R923B_item (expr, ft);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R92311_);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R923B_item (expr, ft);
+ ffestc_R923B_finish ();
+ }
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R923B_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V018 -- Parse the REWRITE statement
+
+ return ffestb_V018; // to lexer
+
+ Make sure the statement has a valid form for the REWRITE
+ statement. If it does, implement the statement. */
+
+#if FFESTR_VXT
+ffelexHandler
+ffestb_V018 (ffelexToken t)
+{
+ ffestpRewriteIx ix;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstREWRITE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeNAME:
+ case FFELEX_typeNUMBER:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ for (ix = 0; ix < FFESTP_rewriteix; ++ix)
+ ffestp_file.rewrite.rewrite_spec[ix].kw_or_val_present = FALSE;
+ return (ffelexHandler) ffestb_V0181_;
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstREWRITE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlREWRITE)
+ goto bad_0; /* :::::::::::::::::::: */
+
+ for (ix = 0; ix < FFESTP_rewriteix; ++ix)
+ ffestp_file.rewrite.rewrite_spec[ix].kw_or_val_present = FALSE;
+ return (ffelexHandler) ffestb_V0181_;
+ }
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_V0181_ -- "REWRITE" OPEN_PAREN
+
+ return ffestb_V0181_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_V0181_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0182_;
+
+ default:
+ return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0183_)))
+ (t);
+ }
+}
+
+/* ffestb_V0182_ -- "REWRITE" OPEN_PAREN NAME
+
+ return ffestb_V0182_; // to lexer
+
+ If EQUALS here, go to states that handle it. Else, send NAME and this
+ token thru expression handler. */
+
+static ffelexHandler
+ffestb_V0182_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) ffestb_V0187_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0183_)))
+ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+ }
+}
+
+/* ffestb_V0183_ -- "REWRITE" OPEN_PAREN expr [CLOSE_PAREN]
+
+ (ffestb_V0183_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON here. */
+
+static ffelexHandler
+ffestb_V0183_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].kw_or_val_present
+ = TRUE;
+ ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].kw_present = FALSE;
+ ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].value_present = TRUE;
+ ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].value_is_label
+ = FALSE;
+ ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].value
+ = ffelex_token_use (ft);
+ ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_V0184_;
+ return (ffelexHandler) ffestb_V01812_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_rewrite_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0184_ -- "REWRITE" OPEN_PAREN expr COMMA
+
+ return ffestb_V0184_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_V0184_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0185_;
+
+ default:
+ return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMAT, (ffeexprCallback) ffestb_V0186_)))
+ (t);
+ }
+}
+
+/* ffestb_V0185_ -- "REWRITE" OPEN_PAREN expr COMMA NAME
+
+ return ffestb_V0185_; // to lexer
+
+ If EQUALS here, go to states that handle it. Else, send NAME and this
+ token thru expression handler. */
+
+static ffelexHandler
+ffestb_V0185_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) ffestb_V0187_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMAT, (ffeexprCallback) ffestb_V0186_)))
+ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+ }
+}
+
+/* ffestb_V0186_ -- "REWRITE" OPEN_PAREN expr COMMA expr
+
+ (ffestb_V0186_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_V0186_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw_or_val_present
+ = TRUE;
+ ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw_present = FALSE;
+ ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value_present = TRUE;
+ ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value_is_label
+ = (expr == NULL);
+ ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value
+ = ffelex_token_use (ft);
+ ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_V0187_;
+ return (ffelexHandler) ffestb_V01812_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_rewrite_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0187_ -- "REWRITE" OPEN_PAREN [external-file-unit COMMA [format
+ COMMA]]
+
+ return ffestb_V0187_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_V0187_ (ffelexToken t)
+{
+ ffestrGenio kw;
+
+ ffestb_local_.rewrite.label = FALSE;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ kw = ffestr_genio (t);
+ switch (kw)
+ {
+ case FFESTR_genioERR:
+ ffestb_local_.rewrite.ix = FFESTP_rewriteixERR;
+ ffestb_local_.rewrite.label = TRUE;
+ break;
+
+ case FFESTR_genioFMT:
+ ffestb_local_.rewrite.ix = FFESTP_rewriteixFMT;
+ ffestb_local_.rewrite.left = FALSE;
+ ffestb_local_.rewrite.context = FFEEXPR_contextFILEFORMAT;
+ break;
+
+ case FFESTR_genioIOSTAT:
+ ffestb_local_.rewrite.ix = FFESTP_rewriteixIOSTAT;
+ ffestb_local_.rewrite.left = TRUE;
+ ffestb_local_.rewrite.context = FFEEXPR_contextFILEINT;
+ break;
+
+ case FFESTR_genioUNIT:
+ ffestb_local_.rewrite.ix = FFESTP_rewriteixUNIT;
+ ffestb_local_.rewrite.left = FALSE;
+ ffestb_local_.rewrite.context = FFEEXPR_contextFILENUM;
+ break;
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
+ .kw_or_val_present)
+ break; /* Can't specify a keyword twice! */
+ ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
+ .kw_or_val_present = TRUE;
+ ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
+ .kw_present = TRUE;
+ ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
+ .value_present = FALSE;
+ ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value_is_label
+ = ffestb_local_.rewrite.label;
+ ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].kw
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0188_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffestb_subr_kill_rewrite_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0188_ -- "REWRITE" OPEN_PAREN [external-file-unit COMMA [format
+ COMMA]] NAME
+
+ return ffestb_V0188_; // to lexer
+
+ Make sure EQUALS here, send next token to expression handler. */
+
+static ffelexHandler
+ffestb_V0188_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ if (ffestb_local_.rewrite.label)
+ return (ffelexHandler) ffestb_V01810_;
+ if (ffestb_local_.rewrite.left)
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ ffestb_local_.rewrite.context,
+ (ffeexprCallback) ffestb_V0189_);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestb_local_.rewrite.context,
+ (ffeexprCallback) ffestb_V0189_);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_rewrite_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0189_ -- "REWRITE" OPEN_PAREN ... NAME EQUALS expr
+
+ (ffestb_V0189_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_V0189_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ if (ffestb_local_.rewrite.context == FFEEXPR_contextFILEFORMAT)
+ ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
+ .value_is_label = TRUE;
+ else
+ break;
+ ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value_present
+ = TRUE;
+ ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value
+ = ffelex_token_use (ft);
+ ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_V0187_;
+ return (ffelexHandler) ffestb_V01812_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_rewrite_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V01810_ -- "REWRITE" OPEN_PAREN ... NAME EQUALS
+
+ return ffestb_V01810_; // to lexer
+
+ Handle NUMBER for label here. */
+
+static ffelexHandler
+ffestb_V01810_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value_present
+ = TRUE;
+ ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V01811_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_rewrite_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V01811_ -- "REWRITE" OPEN_PAREN ... NAME EQUALS NUMBER
+
+ return ffestb_V01811_; // to lexer
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_V01811_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_V0187_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_V01812_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_rewrite_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V01812_ -- "REWRITE" OPEN_PAREN ... CLOSE_PAREN
+
+ return ffestb_V01812_; // to lexer
+
+ Handle EOS or SEMICOLON here. */
+
+static ffelexHandler
+ffestb_V01812_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_V018_start ();
+ ffestc_V018_finish ();
+ }
+ ffestb_subr_kill_rewrite_ ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeNAME:
+ case FFELEX_typeOPEN_PAREN:
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_V018_start ();
+ ffestb_subr_kill_rewrite_ ();
+
+ /* EXTENSION: Allow an optional preceding COMMA here if not pedantic.
+ (f2c provides this extension, as do other compilers, supposedly.) */
+
+ if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA))
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V01813_);
+
+ return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V01813_)))
+ (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_rewrite_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V01813_ -- "REWRITE(...)" expr
+
+ (ffestb_V01813_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON here. */
+
+static ffelexHandler
+ffestb_V01813_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_V018_item (expr, ft);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V01813_);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_V018_item (expr, ft);
+ ffestc_V018_finish ();
+ }
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_V018_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V019 -- Parse the ACCEPT statement
+
+ return ffestb_V019; // to lexer
+
+ Make sure the statement has a valid form for the ACCEPT
+ statement. If it does, implement the statement. */
+
+ffelexHandler
+ffestb_V019 (ffelexToken t)
+{
+ ffelexHandler next;
+ ffestpAcceptIx ix;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstACCEPT)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typeCOLON:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ case FFELEX_typeNUMBER:
+ ffesta_confirmed ();
+ break;
+
+ default:
+ break;
+ }
+
+ for (ix = 0; ix < FFESTP_acceptix; ++ix)
+ ffestp_file.accept.accept_spec[ix].kw_or_val_present = FALSE;
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0191_)))
+ (t);
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstACCEPT)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlACCEPT)
+ break;
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typeCOLON:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ break;
+ }
+ for (ix = 0; ix < FFESTP_acceptix; ++ix)
+ ffestp_file.accept.accept_spec[ix].kw_or_val_present = FALSE;
+ next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0191_);
+ next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
+ FFESTR_firstlACCEPT);
+ if (next == NULL)
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_V0191_ -- "ACCEPT" expr
+
+ (ffestb_V0191_) // to expression handler
+
+ Make sure the next token is a COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_V0191_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].kw_or_val_present
+ = TRUE;
+ ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].kw_present = FALSE;
+ ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].value_present = TRUE;
+ ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].value_is_label
+ = (expr == NULL);
+ ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].value
+ = ffelex_token_use (ft);
+ ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].u.expr = expr;
+ if (!ffesta_is_inhibited ())
+ ffestc_V019_start ();
+ ffestb_subr_kill_accept_ ();
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextIOLIST,
+ (ffeexprCallback) ffestb_V0192_);
+ if (!ffesta_is_inhibited ())
+ ffestc_V019_finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_accept_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0192_ -- "ACCEPT" expr COMMA expr
+
+ (ffestb_V0192_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON here. */
+
+static ffelexHandler
+ffestb_V0192_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_V019_item (expr, ft);
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextIOLIST,
+ (ffeexprCallback) ffestb_V0192_);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_V019_item (expr, ft);
+ ffestc_V019_finish ();
+ }
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_V019_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_V020 -- Parse the TYPE statement
+
+ return ffestb_V020; // to lexer
+
+ Make sure the statement has a valid form for the TYPE
+ statement. If it does, implement the statement. */
+
+ffelexHandler
+ffestb_V020 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexHandler next;
+ ffestpTypeIx ix;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstTYPE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typeCOLON:
+ case FFELEX_typeCOMMA: /* Because "TYPE,PUBLIC::A" is ambiguous with
+ '90. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNUMBER:
+ ffesta_confirmed ();
+ break;
+
+ case FFELEX_typeNAME: /* Because TYPE A is ambiguous with '90. */
+ default:
+ break;
+ }
+
+ for (ix = 0; ix < FFESTP_typeix; ++ix)
+ ffestp_file.type.type_spec[ix].kw_or_val_present = FALSE;
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0201_)))
+ (t);
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstTYPE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlTYPE)
+ break;
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ if (ffelex_token_length (ffesta_tokens[0]) == FFESTR_firstlTYPE)
+ break; /* Else might be assignment/stmtfuncdef. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typeCOLON:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ break;
+ }
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlTYPE);
+ if (isdigit (*p))
+ ffesta_confirmed (); /* Else might be '90 TYPE statement. */
+ for (ix = 0; ix < FFESTP_typeix; ++ix)
+ ffestp_file.type.type_spec[ix].kw_or_val_present = FALSE;
+ next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0201_);
+ next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
+ FFESTR_firstlTYPE);
+ if (next == NULL)
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_V0201_ -- "TYPE" expr
+
+ (ffestb_V0201_) // to expression handler
+
+ Make sure the next token is a COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_V0201_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ bool comma = TRUE;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffe_is_vxt () && (expr != NULL)
+ && (ffebld_op (expr) == FFEBLD_opSYMTER))
+ break;
+ comma = FALSE;
+ /* Fall through. */
+ case FFELEX_typeCOMMA:
+ if (!ffe_is_vxt () && comma && (expr != NULL)
+ && (ffebld_op (expr) == FFEBLD_opPAREN)
+ && (ffebld_op (ffebld_left (expr)) == FFEBLD_opSYMTER))
+ break;
+ ffesta_confirmed ();
+ ffestp_file.type.type_spec[FFESTP_typeixFORMAT].kw_or_val_present
+ = TRUE;
+ ffestp_file.type.type_spec[FFESTP_typeixFORMAT].kw_present = FALSE;
+ ffestp_file.type.type_spec[FFESTP_typeixFORMAT].value_present = TRUE;
+ ffestp_file.type.type_spec[FFESTP_typeixFORMAT].value_is_label
+ = (expr == NULL);
+ ffestp_file.type.type_spec[FFESTP_typeixFORMAT].value
+ = ffelex_token_use (ft);
+ ffestp_file.type.type_spec[FFESTP_typeixFORMAT].u.expr = expr;
+ if (!ffesta_is_inhibited ())
+ ffestc_V020_start ();
+ ffestb_subr_kill_type_ ();
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V0202_);
+ if (!ffesta_is_inhibited ())
+ ffestc_V020_finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_type_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0202_ -- "TYPE" expr COMMA expr
+
+ (ffestb_V0202_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON here. */
+
+static ffelexHandler
+ffestb_V0202_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_V020_item (expr, ft);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V0202_);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_V020_item (expr, ft);
+ ffestc_V020_finish ();
+ }
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_V020_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V021 -- Parse a DELETE statement
+
+ return ffestb_V021; // to lexer
+
+ Make sure the statement has a valid form for a DELETE statement.
+ If it does, implement the statement. */
+
+#if FFESTR_VXT
+ffelexHandler
+ffestb_V021 (ffelexToken t)
+{
+ ffestpDeleteIx ix;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstDELETE)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstDELETE)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlDELETE)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ for (ix = 0; ix < FFESTP_deleteix; ++ix)
+ ffestp_file.delete.delete_spec[ix].kw_or_val_present = FALSE;
+
+ return (ffelexHandler) ffestb_V0211_;
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_V0211_ -- "DELETE" OPEN_PAREN
+
+ return ffestb_V0211_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_V0211_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0212_;
+
+ default:
+ return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0213_)))
+ (t);
+ }
+}
+
+/* ffestb_V0212_ -- "DELETE" OPEN_PAREN NAME
+
+ return ffestb_V0212_; // to lexer
+
+ If EQUALS here, go to states that handle it. Else, send NAME and this
+ token thru expression handler. */
+
+static ffelexHandler
+ffestb_V0212_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) ffestb_V0214_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0213_)))
+ (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) (*next) (t);
+ }
+}
+
+/* ffestb_V0213_ -- "DELETE" OPEN_PAREN expr
+
+ (ffestb_V0213_) // to expression handler
+
+ Handle COMMA or DELETE_PAREN here. */
+
+static ffelexHandler
+ffestb_V0213_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].kw_or_val_present
+ = TRUE;
+ ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].kw_present = FALSE;
+ ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].value_present = TRUE;
+ ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].value_is_label
+ = FALSE;
+ ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].value
+ = ffelex_token_use (ft);
+ ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_V0214_;
+ return (ffelexHandler) ffestb_V0219_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_delete_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0214_ -- "DELETE" OPEN_PAREN [external-file-unit COMMA]
+
+ return ffestb_V0214_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_V0214_ (ffelexToken t)
+{
+ ffestrGenio kw;
+
+ ffestb_local_.delete.label = FALSE;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ kw = ffestr_genio (t);
+ switch (kw)
+ {
+ case FFESTR_genioERR:
+ ffestb_local_.delete.ix = FFESTP_deleteixERR;
+ ffestb_local_.delete.label = TRUE;
+ break;
+
+ case FFESTR_genioIOSTAT:
+ ffestb_local_.delete.ix = FFESTP_deleteixIOSTAT;
+ ffestb_local_.delete.left = TRUE;
+ ffestb_local_.delete.context = FFEEXPR_contextFILEINT;
+ break;
+
+ case FFESTR_genioREC:
+ ffestb_local_.delete.ix = FFESTP_deleteixREC;
+ ffestb_local_.delete.left = FALSE;
+ ffestb_local_.delete.context = FFEEXPR_contextFILENUM;
+ break;
+
+ case FFESTR_genioUNIT:
+ ffestb_local_.delete.ix = FFESTP_deleteixUNIT;
+ ffestb_local_.delete.left = FALSE;
+ ffestb_local_.delete.context = FFEEXPR_contextFILENUM;
+ break;
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.delete.delete_spec[ffestb_local_.delete.ix]
+ .kw_or_val_present)
+ break; /* Can't specify a keyword twice! */
+ ffestp_file.delete.delete_spec[ffestb_local_.delete.ix]
+ .kw_or_val_present = TRUE;
+ ffestp_file.delete.delete_spec[ffestb_local_.delete.ix]
+ .kw_present = TRUE;
+ ffestp_file.delete.delete_spec[ffestb_local_.delete.ix]
+ .value_present = FALSE;
+ ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value_is_label
+ = ffestb_local_.delete.label;
+ ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].kw
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0215_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffestb_subr_kill_delete_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0215_ -- "DELETE" OPEN_PAREN [external-file-unit COMMA] NAME
+
+ return ffestb_V0215_; // to lexer
+
+ Make sure EQUALS here, send next token to expression handler. */
+
+static ffelexHandler
+ffestb_V0215_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ if (ffestb_local_.delete.label)
+ return (ffelexHandler) ffestb_V0217_;
+ if (ffestb_local_.delete.left)
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ ffestb_local_.delete.context,
+ (ffeexprCallback) ffestb_V0216_);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestb_local_.delete.context, (ffeexprCallback) ffestb_V0216_);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_delete_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0216_ -- "DELETE" OPEN_PAREN ... NAME EQUALS expr
+
+ (ffestb_V0216_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_V0216_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value_present
+ = TRUE;
+ ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value
+ = ffelex_token_use (ft);
+ ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_V0214_;
+ return (ffelexHandler) ffestb_V0219_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_delete_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0217_ -- "DELETE" OPEN_PAREN ... NAME EQUALS
+
+ return ffestb_V0217_; // to lexer
+
+ Handle NUMBER for label here. */
+
+static ffelexHandler
+ffestb_V0217_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value_present
+ = TRUE;
+ ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0218_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_delete_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0218_ -- "DELETE" OPEN_PAREN ... NAME EQUALS NUMBER
+
+ return ffestb_V0218_; // to lexer
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_V0218_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_V0214_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_V0219_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_delete_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0219_ -- "DELETE" OPEN_PAREN ... CLOSE_PAREN
+
+ return ffestb_V0219_; // to lexer
+
+ Handle EOS or SEMICOLON here. */
+
+static ffelexHandler
+ffestb_V0219_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_V021 ();
+ ffestb_subr_kill_delete_ ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_delete_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V026 -- Parse a FIND statement
+
+ return ffestb_V026; // to lexer
+
+ Make sure the statement has a valid form for a FIND statement.
+ If it does, implement the statement. */
+
+ffelexHandler
+ffestb_V026 (ffelexToken t)
+{
+ ffestpFindIx ix;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstFIND)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstFIND)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlFIND)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ for (ix = 0; ix < FFESTP_findix; ++ix)
+ ffestp_file.find.find_spec[ix].kw_or_val_present = FALSE;
+
+ return (ffelexHandler) ffestb_V0261_;
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_V0261_ -- "FIND" OPEN_PAREN
+
+ return ffestb_V0261_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_V0261_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0262_;
+
+ default:
+ return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0263_)))
+ (t);
+ }
+}
+
+/* ffestb_V0262_ -- "FIND" OPEN_PAREN NAME
+
+ return ffestb_V0262_; // to lexer
+
+ If EQUALS here, go to states that handle it. Else, send NAME and this
+ token thru expression handler. */
+
+static ffelexHandler
+ffestb_V0262_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) ffestb_V0264_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0263_)))
+ (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) (*next) (t);
+ }
+}
+
+/* ffestb_V0263_ -- "FIND" OPEN_PAREN expr
+
+ (ffestb_V0263_) // to expression handler
+
+ Handle COMMA or FIND_PAREN here. */
+
+static ffelexHandler
+ffestb_V0263_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.find.find_spec[FFESTP_findixUNIT].kw_or_val_present
+ = TRUE;
+ ffestp_file.find.find_spec[FFESTP_findixUNIT].kw_present = FALSE;
+ ffestp_file.find.find_spec[FFESTP_findixUNIT].value_present = TRUE;
+ ffestp_file.find.find_spec[FFESTP_findixUNIT].value_is_label
+ = FALSE;
+ ffestp_file.find.find_spec[FFESTP_findixUNIT].value
+ = ffelex_token_use (ft);
+ ffestp_file.find.find_spec[FFESTP_findixUNIT].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_V0264_;
+ return (ffelexHandler) ffestb_V0269_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_find_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0264_ -- "FIND" OPEN_PAREN [external-file-unit COMMA]
+
+ return ffestb_V0264_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_V0264_ (ffelexToken t)
+{
+ ffestrGenio kw;
+
+ ffestb_local_.find.label = FALSE;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ kw = ffestr_genio (t);
+ switch (kw)
+ {
+ case FFESTR_genioERR:
+ ffestb_local_.find.ix = FFESTP_findixERR;
+ ffestb_local_.find.label = TRUE;
+ break;
+
+ case FFESTR_genioIOSTAT:
+ ffestb_local_.find.ix = FFESTP_findixIOSTAT;
+ ffestb_local_.find.left = TRUE;
+ ffestb_local_.find.context = FFEEXPR_contextFILEINT;
+ break;
+
+ case FFESTR_genioREC:
+ ffestb_local_.find.ix = FFESTP_findixREC;
+ ffestb_local_.find.left = FALSE;
+ ffestb_local_.find.context = FFEEXPR_contextFILENUM;
+ break;
+
+ case FFESTR_genioUNIT:
+ ffestb_local_.find.ix = FFESTP_findixUNIT;
+ ffestb_local_.find.left = FALSE;
+ ffestb_local_.find.context = FFEEXPR_contextFILENUM;
+ break;
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.find.find_spec[ffestb_local_.find.ix]
+ .kw_or_val_present)
+ break; /* Can't specify a keyword twice! */
+ ffestp_file.find.find_spec[ffestb_local_.find.ix]
+ .kw_or_val_present = TRUE;
+ ffestp_file.find.find_spec[ffestb_local_.find.ix]
+ .kw_present = TRUE;
+ ffestp_file.find.find_spec[ffestb_local_.find.ix]
+ .value_present = FALSE;
+ ffestp_file.find.find_spec[ffestb_local_.find.ix].value_is_label
+ = ffestb_local_.find.label;
+ ffestp_file.find.find_spec[ffestb_local_.find.ix].kw
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0265_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffestb_subr_kill_find_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0265_ -- "FIND" OPEN_PAREN [external-file-unit COMMA] NAME
+
+ return ffestb_V0265_; // to lexer
+
+ Make sure EQUALS here, send next token to expression handler. */
+
+static ffelexHandler
+ffestb_V0265_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ if (ffestb_local_.find.label)
+ return (ffelexHandler) ffestb_V0267_;
+ if (ffestb_local_.find.left)
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ ffestb_local_.find.context,
+ (ffeexprCallback) ffestb_V0266_);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestb_local_.find.context,
+ (ffeexprCallback) ffestb_V0266_);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_find_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0266_ -- "FIND" OPEN_PAREN ... NAME EQUALS expr
+
+ (ffestb_V0266_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_V0266_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.find.find_spec[ffestb_local_.find.ix].value_present
+ = TRUE;
+ ffestp_file.find.find_spec[ffestb_local_.find.ix].value
+ = ffelex_token_use (ft);
+ ffestp_file.find.find_spec[ffestb_local_.find.ix].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_V0264_;
+ return (ffelexHandler) ffestb_V0269_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_find_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0267_ -- "FIND" OPEN_PAREN ... NAME EQUALS
+
+ return ffestb_V0267_; // to lexer
+
+ Handle NUMBER for label here. */
+
+static ffelexHandler
+ffestb_V0267_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffestp_file.find.find_spec[ffestb_local_.find.ix].value_present
+ = TRUE;
+ ffestp_file.find.find_spec[ffestb_local_.find.ix].value
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0268_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_find_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0268_ -- "FIND" OPEN_PAREN ... NAME EQUALS NUMBER
+
+ return ffestb_V0268_; // to lexer
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_V0268_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_V0264_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_V0269_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_find_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0269_ -- "FIND" OPEN_PAREN ... CLOSE_PAREN
+
+ return ffestb_V0269_; // to lexer
+
+ Handle EOS or SEMICOLON here. */
+
+static ffelexHandler
+ffestb_V0269_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_V026 ();
+ ffestb_subr_kill_find_ ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_find_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_dimlist -- Parse the ALLOCATABLE/POINTER/TARGET statement
+
+ return ffestb_dimlist; // to lexer
+
+ Make sure the statement has a valid form for the ALLOCATABLE/POINTER/
+ TARGET statement. If it does, implement the statement. */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_dimlist (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexToken nt;
+ ffelexHandler next;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_start ();
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_start ();
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_start ();
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffestb_local_.dimlist.started = TRUE;
+ return (ffelexHandler) ffestb_dimlist1_;
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_start ();
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_start ();
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_start ();
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffestb_local_.dimlist.started = TRUE;
+ return (ffelexHandler) ffestb_dimlist1_ (t);
+ }
+
+ case FFELEX_typeNAMES:
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.dimlist.len);
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_start ();
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_start ();
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_start ();
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffestb_local_.dimlist.started = TRUE;
+ next = (ffelexHandler) ffestb_dimlist1_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ goto bad_i; /* :::::::::::::::::::: */
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_start ();
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_start ();
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_start ();
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffestb_local_.dimlist.started = TRUE;
+ return (ffelexHandler) ffestb_dimlist1_;
+
+ case FFELEX_typeOPEN_PAREN:
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ ffestb_local_.dimlist.started = FALSE;
+ next = (ffelexHandler) ffestb_dimlist1_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+ }
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_dimlist1_ -- "ALLOCATABLE/POINTER/TARGET" [COLONCOLON]
+
+ return ffestb_dimlist1_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_dimlist1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_dimlist2_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_finish ();
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_finish ();
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_finish ();
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_dimlist2_ -- "ALLOCATABLE/POINTER/TARGET" ... NAME
+
+ return ffestb_dimlist2_; // to lexer
+
+ Handle OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_dimlist2_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
+ ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_dimlist3_;
+ ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
+ ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLIST;
+#ifdef FFECOM_dimensionsMAX
+ ffestb_subrargs_.dim_list.ndims = 0;
+#endif
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextDIMLIST, (ffeexprCallback) ffestb_subr_dimlist_);
+
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.dimlist.started)
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_start ();
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_start ();
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_start ();
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ ffestb_local_.dimlist.started = TRUE;
+ }
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_item (ffesta_tokens[1], NULL);
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_item (ffesta_tokens[1], NULL);
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_item (ffesta_tokens[1], NULL);
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_dimlist4_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.dimlist.started)
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_start ();
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_start ();
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_start ();
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_item (ffesta_tokens[1], NULL);
+ ffestc_R525_finish ();
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_item (ffesta_tokens[1], NULL);
+ ffestc_R526_finish ();
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_item (ffesta_tokens[1], NULL);
+ ffestc_R527_finish ();
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_finish ();
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_finish ();
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_finish ();
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_dimlist3_ -- "ALLOCATABLE/POINTER/TARGET" ... NAME OPEN_PAREN
+ dimlist CLOSE_PAREN
+
+ return ffestb_dimlist3_; // to lexer
+
+ Handle COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_dimlist3_ (ffelexToken t)
+{
+ if (!ffestb_subrargs_.dim_list.ok)
+ goto bad; /* :::::::::::::::::::: */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.dimlist.started)
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_start ();
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_start ();
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_start ();
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ ffestb_local_.dimlist.started = TRUE;
+ }
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_item (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_item (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_item (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ return (ffelexHandler) ffestb_dimlist4_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.dimlist.started)
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_start ();
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_start ();
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_start ();
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_item (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ ffestc_R525_finish ();
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_item (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ ffestc_R526_finish ();
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_item (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ ffestc_R527_finish ();
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
+ if (ffestb_local_.dimlist.started && !ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_finish ();
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_finish ();
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_finish ();
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_dimlist4_ -- "ALLOCATABLE/POINTER/TARGET" ... COMMA
+
+ return ffestb_dimlist4_; // to lexer
+
+ Make sure we don't have EOS or SEMICOLON. */
+
+static ffelexHandler
+ffestb_dimlist4_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_finish ();
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_finish ();
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_finish ();
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ return (ffelexHandler) ffestb_dimlist1_ (t);
+ }
+}
+
+#endif
+/* ffestb_dummy -- Parse an ENTRY/FUNCTION/SUBROUTINE statement
+
+ return ffestb_dummy; // to lexer
+
+ Make sure the statement has a valid form for an ENTRY/FUNCTION/SUBROUTINE
+ statement. If it does, implement the statement. */
+
+ffelexHandler
+ffestb_dummy (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ break;
+ }
+
+ ffesta_confirmed ();
+ ffesta_tokens[1] = ffelex_token_use (t);
+ ffestb_local_.decl.recursive = NULL;
+ ffestb_local_.dummy.badname = ffestb_args.dummy.badname;
+ ffestb_local_.dummy.is_subr = ffestb_args.dummy.is_subr;
+ ffestb_local_.dummy.first_kw = ffesta_first_kw;
+ return (ffelexHandler) ffestb_dummy1_;
+
+ case FFELEX_typeNAMES:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ break;
+
+ case FFELEX_typeOPEN_PAREN:
+ break;
+ }
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.dummy.len);
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1]
+ = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ ffestb_local_.decl.recursive = NULL;
+ ffestb_local_.dummy.badname = ffestb_args.dummy.badname;
+ ffestb_local_.dummy.is_subr = ffestb_args.dummy.is_subr;
+ ffestb_local_.dummy.first_kw = ffesta_first_kw;
+ return (ffelexHandler) ffestb_dummy1_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dummy.badname, ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dummy.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.dummy.badname, ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_dummy1_ -- "ENTRY/FUNCTION/SUBROUTINE" NAME
+
+ return ffestb_dummy1_; // to lexer
+
+ Make sure the next token is an EOS, SEMICOLON, or OPEN_PAREN. In the
+ former case, just implement a null arg list, else get the arg list and
+ then implement. */
+
+static ffelexHandler
+ffestb_dummy1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (ffestb_local_.dummy.first_kw == FFESTR_firstFUNCTION)
+ {
+ ffesta_confirmed (); /* Later, not if typename w/o RECURSIVE. */
+ break; /* Produce an error message, need that open
+ paren. */
+ }
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ { /* Pretend as though we got a truly NULL
+ list. */
+ ffestb_subrargs_.name_list.args = NULL;
+ ffestb_subrargs_.name_list.ok = TRUE;
+ ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_dummy2_ (t);
+ }
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_subrargs_.name_list.args = ffestt_tokenlist_create ();
+ ffestb_subrargs_.name_list.handler = (ffelexHandler) ffestb_dummy2_;
+ ffestb_subrargs_.name_list.is_subr = ffestb_local_.dummy.is_subr;
+ ffestb_subrargs_.name_list.names = FALSE;
+ return (ffelexHandler) ffestb_subr_name_list_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_local_.dummy.badname, t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_dummy2_ -- <dummy-keyword> NAME OPEN_PAREN arg-list CLOSE_PAREN
+
+ return ffestb_dummy2_; // to lexer
+
+ Make sure the statement has a valid form for a dummy-def statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_dummy2_ (ffelexToken t)
+{
+ if (!ffestb_subrargs_.name_list.ok)
+ goto bad; /* :::::::::::::::::::: */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffestb_local_.dummy.first_kw)
+ {
+ case FFESTR_firstFUNCTION:
+ ffestc_R1219 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
+ ffestb_subrargs_.name_list.close_paren, FFESTP_typeNone,
+ NULL, NULL, NULL, NULL, ffestb_local_.decl.recursive, NULL);
+ break;
+
+ case FFESTR_firstSUBROUTINE:
+ ffestc_R1223 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
+ ffestb_subrargs_.name_list.close_paren,
+ ffestb_local_.decl.recursive);
+ break;
+
+ case FFESTR_firstENTRY:
+ ffestc_R1226 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
+ ffestb_subrargs_.name_list.close_paren);
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
+ if (ffestb_subrargs_.name_list.args != NULL)
+ ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ if ((ffestb_local_.dummy.first_kw != FFESTR_firstFUNCTION)
+ || (ffestr_other (t) != FFESTR_otherRESULT))
+ break;
+ ffestb_local_.decl.type = FFESTP_typeNone;
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_funcname_6_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_local_.dummy.badname, t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
+ if (ffestb_subrargs_.name_list.args != NULL)
+ ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R524 -- Parse the DIMENSION statement
+
+ return ffestb_R524; // to lexer
+
+ Make sure the statement has a valid form for the DIMENSION statement. If
+ it does, implement the statement. */
+
+ffelexHandler
+ffestb_R524 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexToken nt;
+ ffelexHandler next;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R524_start (ffesta_first_kw == FFESTR_firstVIRTUAL);
+ ffestb_local_.dimension.started = TRUE;
+ return (ffelexHandler) ffestb_R5241_ (t);
+ }
+
+ case FFELEX_typeNAMES:
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.R524.len);
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed ();
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ break;
+ }
+
+ /* Here, we have at least one char after "DIMENSION" and t is
+ OPEN_PAREN. */
+
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ ffestb_local_.dimension.started = FALSE;
+ next = (ffelexHandler) ffestb_R5241_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5241_ -- "DIMENSION"
+
+ return ffestb_R5241_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_R5241_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R5242_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R524_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5242_ -- "DIMENSION" ... NAME
+
+ return ffestb_R5242_; // to lexer
+
+ Handle OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_R5242_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
+ ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_R5243_;
+ ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
+ ffestb_subrargs_.dim_list.ctx = ffesta_is_entry_valid
+ ? FFEEXPR_contextDIMLIST : FFEEXPR_contextDIMLISTCOMMON;
+#ifdef FFECOM_dimensionsMAX
+ ffestb_subrargs_.dim_list.ndims = 0;
+#endif
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestb_subrargs_.dim_list.ctx,
+ (ffeexprCallback) ffestb_subr_dimlist_);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R524_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5243_ -- "DIMENSION" ... NAME OPEN_PAREN dimlist CLOSE_PAREN
+
+ return ffestb_R5243_; // to lexer
+
+ Handle COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_R5243_ (ffelexToken t)
+{
+ if (!ffestb_subrargs_.dim_list.ok)
+ goto bad; /* :::::::::::::::::::: */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.dimension.started)
+ {
+ ffestc_R524_start (ffesta_first_kw == FFESTR_firstVIRTUAL);
+ ffestb_local_.dimension.started = TRUE;
+ }
+ ffestc_R524_item (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ return (ffelexHandler) ffestb_R5244_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.dimension.started)
+ {
+ ffestc_R524_start (ffesta_first_kw == FFESTR_firstVIRTUAL);
+ ffestb_local_.dimension.started = TRUE;
+ }
+ ffestc_R524_item (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ ffestc_R524_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
+ if (ffestb_local_.dimension.started && !ffesta_is_inhibited ())
+ ffestc_R524_finish ();
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5244_ -- "DIMENSION" ... COMMA
+
+ return ffestb_R5244_; // to lexer
+
+ Make sure we don't have EOS or SEMICOLON. */
+
+static ffelexHandler
+ffestb_R5244_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_R524_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ return (ffelexHandler) ffestb_R5241_ (t);
+ }
+}
+
+/* ffestb_R547 -- Parse the COMMON statement
+
+ return ffestb_R547; // to lexer
+
+ Make sure the statement has a valid form for the COMMON statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_R547 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexToken nt;
+ ffelexHandler next;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstCOMMON)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ case FFELEX_typeSLASH:
+ case FFELEX_typeCONCAT:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R547_start ();
+ ffestb_local_.common.started = TRUE;
+ return (ffelexHandler) ffestb_R5471_ (t);
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstCOMMON)
+ goto bad_0; /* :::::::::::::::::::: */
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCOMMON);
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed ();
+ break;
+
+ case FFELEX_typeSLASH:
+ case FFELEX_typeCONCAT:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_R547_start ();
+ ffestb_local_.common.started = TRUE;
+ return (ffelexHandler) ffestb_R5471_ (t);
+
+ case FFELEX_typeOPEN_PAREN:
+ break;
+ }
+
+ /* Here, we have at least one char after "COMMON" and t is COMMA,
+ EOS/SEMICOLON, OPEN_PAREN, SLASH, or CONCAT. */
+
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ if (ffelex_token_type (t) == FFELEX_typeOPEN_PAREN)
+ ffestb_local_.common.started = FALSE;
+ else
+ {
+ if (!ffesta_is_inhibited ())
+ ffestc_R547_start ();
+ ffestb_local_.common.started = TRUE;
+ }
+ next = (ffelexHandler) ffestb_R5471_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "COMMON", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5471_ -- "COMMON"
+
+ return ffestb_R5471_; // to lexer
+
+ Handle NAME, SLASH, or CONCAT. */
+
+static ffelexHandler
+ffestb_R5471_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ return (ffelexHandler) ffestb_R5474_ (t);
+
+ case FFELEX_typeSLASH:
+ return (ffelexHandler) ffestb_R5472_;
+
+ case FFELEX_typeCONCAT:
+ if (!ffesta_is_inhibited ())
+ ffestc_R547_item_cblock (NULL);
+ return (ffelexHandler) ffestb_R5474_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R547_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5472_ -- "COMMON" SLASH
+
+ return ffestb_R5472_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_R5472_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R5473_;
+
+ case FFELEX_typeSLASH:
+ if (!ffesta_is_inhibited ())
+ ffestc_R547_item_cblock (NULL);
+ return (ffelexHandler) ffestb_R5474_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R547_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5473_ -- "COMMON" SLASH NAME
+
+ return ffestb_R5473_; // to lexer
+
+ Handle SLASH. */
+
+static ffelexHandler
+ffestb_R5473_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeSLASH:
+ if (!ffesta_is_inhibited ())
+ ffestc_R547_item_cblock (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_R5474_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R547_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5474_ -- "COMMON" [SLASH NAME SLASH] or "COMMON" CONCAT
+
+ return ffestb_R5474_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_R5474_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R5475_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R547_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5475_ -- "COMMON" ... NAME
+
+ return ffestb_R5475_; // to lexer
+
+ Handle OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_R5475_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
+ ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_R5476_;
+ ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
+ ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLISTCOMMON;
+#ifdef FFECOM_dimensionsMAX
+ ffestb_subrargs_.dim_list.ndims = 0;
+#endif
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextDIMLISTCOMMON, (ffeexprCallback) ffestb_subr_dimlist_);
+
+ case FFELEX_typeCOMMA:
+ if (!ffesta_is_inhibited ())
+ ffestc_R547_item_object (ffesta_tokens[1], NULL);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_R5477_;
+
+ case FFELEX_typeSLASH:
+ case FFELEX_typeCONCAT:
+ if (!ffesta_is_inhibited ())
+ ffestc_R547_item_object (ffesta_tokens[1], NULL);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_R5471_ (t);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R547_item_object (ffesta_tokens[1], NULL);
+ ffestc_R547_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R547_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5476_ -- "COMMON" ... NAME OPEN_PAREN dimlist CLOSE_PAREN
+
+ return ffestb_R5476_; // to lexer
+
+ Handle COMMA, SLASH, CONCAT, EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_R5476_ (ffelexToken t)
+{
+ if (!ffestb_subrargs_.dim_list.ok)
+ goto bad; /* :::::::::::::::::::: */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.common.started)
+ {
+ ffestc_R547_start ();
+ ffestb_local_.common.started = TRUE;
+ }
+ ffestc_R547_item_object (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ return (ffelexHandler) ffestb_R5477_;
+
+ case FFELEX_typeSLASH:
+ case FFELEX_typeCONCAT:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.common.started)
+ {
+ ffestc_R547_start ();
+ ffestb_local_.common.started = TRUE;
+ }
+ ffestc_R547_item_object (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ return (ffelexHandler) ffestb_R5471_ (t);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.common.started)
+ ffestc_R547_start ();
+ ffestc_R547_item_object (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ ffestc_R547_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
+ if (ffestb_local_.common.started && !ffesta_is_inhibited ())
+ ffestc_R547_finish ();
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5477_ -- "COMMON" ... COMMA
+
+ return ffestb_R5477_; // to lexer
+
+ Make sure we don't have EOS or SEMICOLON. */
+
+static ffelexHandler
+ffestb_R5477_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_R547_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ return (ffelexHandler) ffestb_R5471_ (t);
+ }
+}
+
+/* ffestb_R624 -- Parse a NULLIFY statement
+
+ return ffestb_R624; // to lexer
+
+ Make sure the statement has a valid form for a NULLIFY
+ statement. If it does, implement the statement.
+
+ 31-May-90 JCB 2.0
+ Rewrite to produce a list of expressions rather than just names; this
+ eases semantic checking, putting it in expression handling where that
+ kind of thing gets done anyway, and makes it easier to support more
+ flexible extensions to Fortran 90 like NULLIFY(FOO%BAR). */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_R624 (ffelexToken t)
+{
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstNULLIFY)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstNULLIFY)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlNULLIFY)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeNAME:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ ffestb_local_.R624.exprs = ffestt_exprlist_create ();
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextNULLIFY,
+ (ffeexprCallback) ffestb_R6241_);
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_R6241_ -- "NULLIFY" OPEN_PAREN expr
+
+ return ffestb_R6241_; // to lexer
+
+ Make sure the statement has a valid form for a NULLIFY statement. If it
+ does, implement the statement.
+
+ 31-May-90 JCB 2.0
+ Rewrite to produce a list of expressions rather than just names; this
+ eases semantic checking, putting it in expression handling where that
+ kind of thing gets done anyway, and makes it easier to support more
+ flexible extensions to Fortran 90 like NULLIFY(FOO%BAR). */
+
+static ffelexHandler
+ffestb_R6241_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestt_exprlist_append (ffestb_local_.R624.exprs, expr,
+ ffelex_token_use (t));
+ return (ffelexHandler) ffestb_R6242_;
+
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ ffestt_exprlist_append (ffestb_local_.R624.exprs, expr,
+ ffelex_token_use (t));
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextNULLIFY,
+ (ffeexprCallback) ffestb_R6241_);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", t);
+ ffestt_exprlist_kill (ffestb_local_.R624.exprs);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R6242_ -- "NULLIFY" OPEN_PAREN expr-list CLOSE_PAREN
+
+ return ffestb_R6242_; // to lexer
+
+ Make sure the statement has a valid form for a NULLIFY statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R6242_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R624 (ffestb_local_.R624.exprs);
+ ffestt_exprlist_kill (ffestb_local_.R624.exprs);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", t);
+ ffestt_exprlist_kill (ffestb_local_.R624.exprs);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_R1229 -- Parse a STMTFUNCTION statement
+
+ return ffestb_R1229; // to lexer
+
+ Make sure the statement has a valid form for a STMTFUNCTION
+ statement. If it does, implement the statement. */
+
+ffelexHandler
+ffestb_R1229 (ffelexToken t)
+{
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ case FFELEX_typeNAMES:
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeNAME:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ ffestb_subrargs_.name_list.args = ffestt_tokenlist_create ();
+ ffestb_subrargs_.name_list.handler = (ffelexHandler) ffestb_R12291_;
+ ffestb_subrargs_.name_list.is_subr = FALSE; /* No "*" items in list! */
+ ffestb_subrargs_.name_list.names = TRUE; /* In case "IF(FOO)CALL
+ FOO...". */
+ return (ffelexHandler) ffestb_subr_name_list_;
+
+bad_0: /* :::::::::::::::::::: */
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_2t (FFEBAD_UNREC_STMT, ffesta_tokens[0], t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R12291_ -- "STMTFUNCTION" OPEN_PAREN dummy-name-list CLOSE_PAREN
+
+ return ffestb_R12291_; // to lexer
+
+ Make sure the statement has a valid form for a STMTFUNCTION statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_R12291_ (ffelexToken t)
+{
+ ffelex_set_names (FALSE);
+
+ if (!ffestb_subrargs_.name_list.ok)
+ goto bad; /* :::::::::::::::::::: */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R1229_start (ffesta_tokens[0],
+ ffestb_subrargs_.name_list.args,
+ ffestb_subrargs_.name_list.close_paren);
+ ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
+ ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextSFUNCDEF, (ffeexprCallback) ffestb_R12292_);
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffesta_ffebad_2t (FFEBAD_UNREC_STMT, ffesta_tokens[0], t);
+ ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
+ ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R12292_ -- "STMTFUNCTION" OPEN_PAREN dummy-name-list CLOSE_PAREN
+ EQUALS expr
+
+ (ffestb_R12292_) // to expression handler
+
+ Make sure the statement has a valid form for a STMTFUNCTION statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_R12292_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ if (expr == NULL)
+ goto bad; /* :::::::::::::::::::: */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1229_finish (expr, ft);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffestc_R1229_finish (NULL, NULL);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "statement-function-definition", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_chartype -- Parse the CHARACTER statement
+
+ return ffestb_decl_chartype; // to lexer
+
+ Make sure the statement has a valid form for the CHARACTER statement. If
+ it does, implement the statement. */
+
+ffelexHandler
+ffestb_decl_chartype (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ ffestb_local_.decl.type = FFESTP_typeCHARACTER;
+ ffestb_local_.decl.recursive = NULL;
+ ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
+ ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstCHRCTR)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, NULL, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_;
+
+ case FFELEX_typeCOLONCOLON:
+ ffestb_local_.decl.coloncolon = TRUE;
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, NULL, NULL);
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ case FFELEX_typeASTERISK:
+ ffesta_confirmed ();
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_chartype1_;
+ ffestb_local_.decl.badname = "TYPEDECL";
+ return (ffelexHandler) ffestb_decl_starlen_;
+
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
+ ffestb_local_.decl.badname = "_TYPEDECL";
+ return (ffelexHandler) ffestb_decl_typeparams_;
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_entsp_ (t);
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstCHRCTR)
+ goto bad_0; /* :::::::::::::::::::: */
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCHRCTR);
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ break;
+
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, NULL, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_;
+
+ case FFELEX_typeCOLONCOLON:
+ ffestb_local_.decl.coloncolon = TRUE;
+ ffesta_confirmed ();
+ if (*p != '\0')
+ goto bad_i; /* :::::::::::::::::::: */
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, NULL, NULL);
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ case FFELEX_typeASTERISK:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ break;
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_chartype1_;
+ ffestb_local_.decl.badname = "TYPEDECL";
+ return (ffelexHandler) ffestb_decl_starlen_;
+
+ case FFELEX_typeSLASH:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ break;
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ if (*p != '\0')
+ break;
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
+ ffestb_local_.decl.badname = "TYPEDECL";
+ return (ffelexHandler) ffestb_decl_typeparams_;
+ }
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ ffesta_tokens[1] = ffelex_token_names_from_names (ffesta_tokens[0], i, 0);
+ return (ffelexHandler) ffestb_decl_entsp_2_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_chartype1_ -- "CHARACTER" ASTERISK char-length
+
+ return ffestb_decl_chartype1_; // to lexer
+
+ Handle COMMA, COLONCOLON, or anything else. */
+
+static ffelexHandler
+ffestb_decl_chartype1_ (ffelexToken t)
+{
+ ffelex_set_names (FALSE);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOLONCOLON:
+ ffestb_local_.decl.coloncolon = TRUE;
+ /* Fall through. */
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, ffestb_local_.decl.len, ffestb_local_.decl.lent);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ default:
+ return (ffelexHandler) ffestb_decl_entsp_ (t);
+ }
+}
+
+/* ffestb_decl_dbltype -- Parse the DOUBLEPRECISION/DOUBLECOMPLEX statement
+
+ return ffestb_decl_dbltype; // to lexer
+
+ Make sure the statement has a valid form for the DOUBLEPRECISION/
+ DOUBLECOMPLEX statement. If it does, implement the statement. */
+
+ffelexHandler
+ffestb_decl_dbltype (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ ffestb_local_.decl.type = ffestb_args.decl.type;
+ ffestb_local_.decl.recursive = NULL;
+ ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
+ ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, NULL, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_;
+
+ case FFELEX_typeCOLONCOLON:
+ ffestb_local_.decl.coloncolon = TRUE;
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, NULL, NULL);
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_entsp_ (t);
+ }
+
+ case FFELEX_typeNAMES:
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.decl.len);
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ break;
+
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, NULL, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_;
+
+ case FFELEX_typeCOLONCOLON:
+ ffestb_local_.decl.coloncolon = TRUE;
+ ffesta_confirmed ();
+ if (*p != '\0')
+ goto bad_i; /* :::::::::::::::::::: */
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, NULL, NULL);
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ case FFELEX_typeSLASH:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ break;
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ if (*p != '\0')
+ break;
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ ffesta_tokens[1] = ffelex_token_names_from_names (ffesta_tokens[0], i, 0);
+ return (ffelexHandler) ffestb_decl_entsp_2_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_double -- Parse the DOUBLE PRECISION/DOUBLE COMPLEX statement
+
+ return ffestb_decl_double; // to lexer
+
+ Make sure the statement has a valid form for the DOUBLE PRECISION/
+ DOUBLE COMPLEX statement. If it does, implement the statement. */
+
+ffelexHandler
+ffestb_decl_double (ffelexToken t)
+{
+ ffestb_local_.decl.recursive = NULL;
+ ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
+ ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstDBL)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ switch (ffestr_second (t))
+ {
+ case FFESTR_secondCOMPLEX:
+ ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
+ break;
+
+ case FFESTR_secondPRECISION:
+ ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
+ break;
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_attrsp_;
+ }
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_decl_gentype -- Parse the INTEGER/REAL/COMPLEX/LOGICAL statement
+
+ return ffestb_decl_gentype; // to lexer
+
+ Make sure the statement has a valid form for the INTEGER/REAL/COMPLEX/
+ LOGICAL statement. If it does, implement the statement. */
+
+ffelexHandler
+ffestb_decl_gentype (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ ffestb_local_.decl.type = ffestb_args.decl.type;
+ ffestb_local_.decl.recursive = NULL;
+ ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
+ ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, NULL, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_;
+
+ case FFELEX_typeCOLONCOLON:
+ ffestb_local_.decl.coloncolon = TRUE;
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, NULL, NULL);
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ case FFELEX_typeASTERISK:
+ ffesta_confirmed ();
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
+ ffestb_local_.decl.badname = "TYPEDECL";
+ return (ffelexHandler) ffestb_decl_starkind_;
+
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
+ ffestb_local_.decl.badname = "TYPEDECL";
+ return (ffelexHandler) ffestb_decl_kindparam_;
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_entsp_ (t);
+ }
+
+ case FFELEX_typeNAMES:
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.decl.len);
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ break;
+
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, NULL, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_;
+
+ case FFELEX_typeCOLONCOLON:
+ ffestb_local_.decl.coloncolon = TRUE;
+ ffesta_confirmed ();
+ if (*p != '\0')
+ goto bad_i; /* :::::::::::::::::::: */
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, NULL, NULL);
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ case FFELEX_typeSLASH:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ break;
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeASTERISK:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ break;
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
+ ffestb_local_.decl.badname = "TYPEDECL";
+ return (ffelexHandler) ffestb_decl_starkind_;
+
+ case FFELEX_typeOPEN_PAREN:
+ if (*p != '\0')
+ break;
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
+ ffestb_local_.decl.badname = "TYPEDECL";
+ return (ffelexHandler) ffestb_decl_kindparam_;
+ }
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ ffesta_tokens[1] = ffelex_token_names_from_names (ffesta_tokens[0], i, 0);
+ return (ffelexHandler) ffestb_decl_entsp_2_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_recursive -- Parse the RECURSIVE FUNCTION statement
+
+ return ffestb_decl_recursive; // to lexer
+
+ Make sure the statement has a valid form for the RECURSIVE FUNCTION
+ statement. If it does, implement the statement. */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_decl_recursive (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexToken nt;
+ ffelexToken ot;
+ ffelexHandler next;
+ bool needfunc;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstRECURSIVE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ break;
+ }
+ ffesta_confirmed ();
+ ffestb_local_.decl.recursive = ffelex_token_use (ffesta_tokens[0]);
+ switch (ffesta_second_kw)
+ {
+ case FFESTR_secondINTEGER:
+ ffestb_local_.decl.type = FFESTP_typeINTEGER;
+ return (ffelexHandler) ffestb_decl_recursive1_;
+
+ case FFESTR_secondBYTE:
+ ffestb_local_.decl.type = FFESTP_typeBYTE;
+ return (ffelexHandler) ffestb_decl_recursive1_;
+
+ case FFESTR_secondWORD:
+ ffestb_local_.decl.type = FFESTP_typeWORD;
+ return (ffelexHandler) ffestb_decl_recursive1_;
+
+ case FFESTR_secondREAL:
+ ffestb_local_.decl.type = FFESTP_typeREAL;
+ return (ffelexHandler) ffestb_decl_recursive1_;
+
+ case FFESTR_secondCOMPLEX:
+ ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
+ return (ffelexHandler) ffestb_decl_recursive1_;
+
+ case FFESTR_secondLOGICAL:
+ ffestb_local_.decl.type = FFESTP_typeLOGICAL;
+ return (ffelexHandler) ffestb_decl_recursive1_;
+
+ case FFESTR_secondCHARACTER:
+ ffestb_local_.decl.type = FFESTP_typeCHARACTER;
+ return (ffelexHandler) ffestb_decl_recursive1_;
+
+ case FFESTR_secondDOUBLE:
+ return (ffelexHandler) ffestb_decl_recursive2_;
+
+ case FFESTR_secondDOUBLEPRECISION:
+ ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_func_;
+
+ case FFESTR_secondDOUBLECOMPLEX:
+ ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_func_;
+
+ case FFESTR_secondTYPE:
+ ffestb_local_.decl.type = FFESTP_typeTYPE;
+ return (ffelexHandler) ffestb_decl_recursive3_;
+
+ case FFESTR_secondFUNCTION:
+ ffestb_local_.dummy.first_kw = FFESTR_firstFUNCTION;
+ ffestb_local_.dummy.badname = "FUNCTION";
+ ffestb_local_.dummy.is_subr = FALSE;
+ return (ffelexHandler) ffestb_decl_recursive4_;
+
+ case FFESTR_secondSUBROUTINE:
+ ffestb_local_.dummy.first_kw = FFESTR_firstSUBROUTINE;
+ ffestb_local_.dummy.badname = "SUBROUTINE";
+ ffestb_local_.dummy.is_subr = TRUE;
+ return (ffelexHandler) ffestb_decl_recursive4_;
+
+ default:
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstRECURSIVE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeASTERISK:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeEOS:
+ ffesta_confirmed ();
+ break;
+
+ default:
+ break;
+ }
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlRECURSIVE);
+ if (!ffesrc_is_name_init (*p))
+ goto bad_0; /* :::::::::::::::::::: */
+ ffestb_local_.decl.recursive
+ = ffelex_token_name_from_names (ffesta_tokens[0], 0,
+ FFESTR_firstlRECURSIVE);
+ nt = ffelex_token_names_from_names (ffesta_tokens[0],
+ FFESTR_firstlRECURSIVE, 0);
+ switch (ffestr_first (nt))
+ {
+ case FFESTR_firstINTGR:
+ p = ffelex_token_text (nt) + (i = FFESTR_firstlINTGR);
+ ffestb_local_.decl.type = FFESTP_typeINTEGER;
+ needfunc = FALSE;
+ goto typefunc; /* :::::::::::::::::::: */
+
+ case FFESTR_firstBYTE:
+ p = ffelex_token_text (nt) + (i = FFESTR_firstlBYTE);
+ ffestb_local_.decl.type = FFESTP_typeBYTE;
+ needfunc = FALSE;
+ goto typefunc; /* :::::::::::::::::::: */
+
+ case FFESTR_firstWORD:
+ p = ffelex_token_text (nt) + (i = FFESTR_firstlWORD);
+ ffestb_local_.decl.type = FFESTP_typeWORD;
+ needfunc = FALSE;
+ goto typefunc; /* :::::::::::::::::::: */
+
+ case FFESTR_firstREAL:
+ p = ffelex_token_text (nt) + (i = FFESTR_firstlREAL);
+ ffestb_local_.decl.type = FFESTP_typeREAL;
+ needfunc = FALSE;
+ goto typefunc; /* :::::::::::::::::::: */
+
+ case FFESTR_firstCMPLX:
+ p = ffelex_token_text (nt) + (i = FFESTR_firstlCMPLX);
+ ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
+ needfunc = FALSE;
+ goto typefunc; /* :::::::::::::::::::: */
+
+ case FFESTR_firstLGCL:
+ p = ffelex_token_text (nt) + (i = FFESTR_firstlLGCL);
+ ffestb_local_.decl.type = FFESTP_typeLOGICAL;
+ needfunc = FALSE;
+ goto typefunc; /* :::::::::::::::::::: */
+
+ case FFESTR_firstCHRCTR:
+ p = ffelex_token_text (nt) + (i = FFESTR_firstlCHRCTR);
+ ffestb_local_.decl.type = FFESTP_typeCHARACTER;
+ needfunc = FALSE;
+ goto typefunc; /* :::::::::::::::::::: */
+
+ case FFESTR_firstDBLPRCSN:
+ p = ffelex_token_text (nt) + (i = FFESTR_firstlDBLPRCSN);
+ ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
+ needfunc = TRUE;
+ goto typefunc; /* :::::::::::::::::::: */
+
+ case FFESTR_firstDBLCMPLX:
+ p = ffelex_token_text (nt) + (i = FFESTR_firstlDBLCMPLX);
+ ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
+ needfunc = TRUE;
+ goto typefunc; /* :::::::::::::::::::: */
+
+ case FFESTR_firstTYPE:
+ p = ffelex_token_text (nt) + (i = FFESTR_firstlTYPE);
+ ffestb_local_.decl.type = FFESTP_typeTYPE;
+ next = (ffelexHandler) ffestb_decl_recursive3_;
+ break;
+
+ case FFESTR_firstFUNCTION:
+ p = ffelex_token_text (nt) + (i = FFESTR_firstlFUNCTION);
+ ffestb_local_.dummy.first_kw = FFESTR_firstFUNCTION;
+ ffestb_local_.dummy.badname = "FUNCTION";
+ ffestb_local_.dummy.is_subr = FALSE;
+ next = (ffelexHandler) ffestb_decl_recursive4_;
+ break;
+
+ case FFESTR_firstSUBROUTINE:
+ p = ffelex_token_text (nt) + (i = FFESTR_firstlSUBROUTINE);
+ ffestb_local_.dummy.first_kw = FFESTR_firstSUBROUTINE;
+ ffestb_local_.dummy.badname = "SUBROUTINE";
+ ffestb_local_.dummy.is_subr = TRUE;
+ next = (ffelexHandler) ffestb_decl_recursive4_;
+ break;
+
+ default:
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffelex_token_kill (nt);
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+ if (*p == '\0')
+ {
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+ }
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ot = ffelex_token_name_from_names (nt, i, 0);
+ ffelex_token_kill (nt);
+ next = (ffelexHandler) (*next) (ot);
+ ffelex_token_kill (ot);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+typefunc: /* :::::::::::::::::::: */
+ if (*p == '\0')
+ {
+ ffelex_token_kill (nt);
+ if (needfunc) /* DOUBLE PRECISION or DOUBLE COMPLEX? */
+ {
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+ return (ffelexHandler) ffestb_decl_recursive1_ (t);
+ }
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ot = ffelex_token_names_from_names (nt, i, 0);
+ ffelex_token_kill (nt);
+ if (ffestr_first (ot) != FFESTR_firstFUNCTION)
+ goto bad_o; /* :::::::::::::::::::: */
+ p = ffelex_token_text (ot) + (i = FFESTR_firstlFUNCTION);
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1] = ffelex_token_name_from_names (ot, i, 0);
+ ffelex_token_kill (ot);
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_funcname_1_ (t);
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", nt, i, t);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_o: /* :::::::::::::::::::: */
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", ot);
+ ffelex_token_kill (ot);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_recursive1_ -- "RECURSIVE" generic-type
+
+ return ffestb_decl_recursive1_; // to lexer
+
+ Handle ASTERISK, OPEN_PAREN, or NAME. */
+
+static ffelexHandler
+ffestb_decl_recursive1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeASTERISK:
+ ffesta_confirmed ();
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_func_;
+ ffestb_local_.decl.badname = "TYPEFUNC";
+ if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
+ return (ffelexHandler) ffestb_decl_starlen_;
+ return (ffelexHandler) ffestb_decl_starkind_;
+
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_func_;
+ ffestb_local_.decl.badname = "TYPEFUNC";
+ if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
+ {
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_typeparams_;
+ }
+ return (ffelexHandler) ffestb_decl_kindparam_;
+
+ case FFELEX_typeNAME:
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_func_ (t);
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_recursive2_ -- "RECURSIVE" "DOUBLE"
+
+ return ffestb_decl_recursive2_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_decl_recursive2_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ switch (ffestr_second (t))
+ {
+ case FFESTR_secondPRECISION:
+ ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
+ break;
+
+ case FFESTR_secondCOMPLEX:
+ ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
+ break;
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_func_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_recursive3_ -- "RECURSIVE" "TYPE"
+
+ return ffestb_decl_recursive3_; // to lexer
+
+ Handle OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_decl_recursive3_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_func_;
+ ffestb_local_.decl.badname = "TYPEFUNC";
+ return (ffelexHandler) ffestb_decl_typetype1_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_recursive4_ -- "RECURSIVE" "FUNCTION/SUBROUTINE"
+
+ return ffestb_decl_recursive4_; // to lexer
+
+ Handle OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_decl_recursive4_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_dummy1_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_decl_typetype -- Parse the R426/R501/R1219 TYPE statement
+
+ return ffestb_decl_typetype; // to lexer
+
+ Make sure the statement has a valid form for the TYPE statement. If it
+ does, implement the statement. */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_decl_typetype (ffelexToken t)
+{
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstTYPE)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstTYPE)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlTYPE)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOLONCOLON:/* Not COMMA: R424 "TYPE,PUBLIC::A". */
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ ffestb_local_.decl.recursive = NULL;
+ ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
+ ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
+
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
+ ffestb_local_.decl.badname = "type-declaration";
+ return (ffelexHandler) ffestb_decl_typetype1_;
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+#endif
+/* ffestb_decl_attrs_ -- "type" [type parameters] COMMA
+
+ return ffestb_decl_attrs_; // to lexer
+
+ Handle NAME of an attribute. */
+
+static ffelexHandler
+ffestb_decl_attrs_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ switch (ffestr_first (t))
+ {
+#if FFESTR_F90
+ case FFESTR_firstALLOCATABLE:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_attrib (FFESTP_attribALLOCATABLE, t,
+ FFESTR_otherNone, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_7_;
+#endif
+
+ case FFESTR_firstDIMENSION:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_decl_attrs_1_;
+
+ case FFESTR_firstEXTERNAL:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_attrib (FFESTP_attribEXTERNAL, t,
+ FFESTR_otherNone, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_7_;
+
+#if FFESTR_F90
+ case FFESTR_firstINTENT:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_decl_attrs_3_;
+#endif
+
+ case FFESTR_firstINTRINSIC:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_attrib (FFESTP_attribINTRINSIC, t,
+ FFESTR_otherNone, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_7_;
+
+#if FFESTR_F90
+ case FFESTR_firstOPTIONAL:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_attrib (FFESTP_attribOPTIONAL, t,
+ FFESTR_otherNone, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_7_;
+#endif
+
+ case FFESTR_firstPARAMETER:
+ ffestb_local_.decl.parameter = TRUE;
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_attrib (FFESTP_attribPARAMETER, t,
+ FFESTR_otherNone, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_7_;
+
+#if FFESTR_F90
+ case FFESTR_firstPOINTER:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_attrib (FFESTP_attribPOINTER, t,
+ FFESTR_otherNone, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_7_;
+#endif
+
+#if FFESTR_F90
+ case FFESTR_firstPRIVATE:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_attrib (FFESTP_attribPRIVATE, t,
+ FFESTR_otherNone, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_7_;
+
+ case FFESTR_firstPUBLIC:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_attrib (FFESTP_attribPUBLIC, t,
+ FFESTR_otherNone, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_7_;
+#endif
+
+ case FFESTR_firstSAVE:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_attrib (FFESTP_attribSAVE, t,
+ FFESTR_otherNone, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_7_;
+
+#if FFESTR_F90
+ case FFESTR_firstTARGET:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_attrib (FFESTP_attribTARGET, t,
+ FFESTR_otherNone, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_7_;
+#endif
+
+ default:
+ ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
+ return (ffelexHandler) ffestb_decl_attrs_7_;
+ }
+ break;
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_attrs_1_ -- "type" [type parameters] ",DIMENSION"
+
+ return ffestb_decl_attrs_1_; // to lexer
+
+ Handle OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_decl_attrs_1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
+ ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_decl_attrs_2_;
+ ffestb_subrargs_.dim_list.pool = ffesta_scratch_pool;
+ ffestb_subrargs_.dim_list.ctx = ffesta_is_entry_valid
+ ? FFEEXPR_contextDIMLIST : FFEEXPR_contextDIMLISTCOMMON;
+#ifdef FFECOM_dimensionsMAX
+ ffestb_subrargs_.dim_list.ndims = 0;
+#endif
+ return (ffelexHandler) ffeexpr_rhs (ffesta_scratch_pool,
+ ffestb_subrargs_.dim_list.ctx,
+ (ffeexprCallback) ffestb_subr_dimlist_);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_decl_attrs_7_ (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_attrs_2_ -- "type" [type parameters] ",DIMENSION" OPEN_PAREN
+ dimlist CLOSE_PAREN
+
+ return ffestb_decl_attrs_2_; // to lexer
+
+ Handle COMMA or COLONCOLON. */
+
+static ffelexHandler
+ffestb_decl_attrs_2_ (ffelexToken t)
+{
+ if (!ffestb_subrargs_.dim_list.ok)
+ goto bad; /* :::::::::::::::::::: */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_attrib (FFESTP_attribDIMENSION, ffesta_tokens[1],
+ FFESTR_otherNone, ffestb_subrargs_.dim_list.dims);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ return (ffelexHandler) ffestb_decl_attrs_7_ (t);
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_attrs_3_ -- "type" [type parameters] ",INTENT"
+
+ return ffestb_decl_attrs_3_; // to lexer
+
+ Handle OPEN_PAREN. */
+
+#if FFESTR_F90
+static ffelexHandler
+ffestb_decl_attrs_3_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ return (ffelexHandler) ffestb_decl_attrs_4_;
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_decl_attrs_7_ (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_attrs_4_ -- "type" [type parameters] ",INTENT" OPEN_PAREN
+
+ return ffestb_decl_attrs_4_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_decl_attrs_4_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffestb_local_.decl.kw = ffestr_other (t);
+ switch (ffestb_local_.decl.kw)
+ {
+ case FFESTR_otherIN:
+ return (ffelexHandler) ffestb_decl_attrs_5_;
+
+ case FFESTR_otherINOUT:
+ return (ffelexHandler) ffestb_decl_attrs_6_;
+
+ case FFESTR_otherOUT:
+ return (ffelexHandler) ffestb_decl_attrs_6_;
+
+ default:
+ ffestb_local_.decl.kw = FFESTR_otherNone;
+ ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
+ return (ffelexHandler) ffestb_decl_attrs_5_;
+ }
+ break;
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_attrs_5_ -- "type" [type parameters] ",INTENT" OPEN_PAREN "IN"
+
+ return ffestb_decl_attrs_5_; // to lexer
+
+ Handle NAME or CLOSE_PAREN. */
+
+static ffelexHandler
+ffestb_decl_attrs_5_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ switch (ffestr_other (t))
+ {
+ case FFESTR_otherOUT:
+ if (ffestb_local_.decl.kw != FFESTR_otherNone)
+ ffestb_local_.decl.kw = FFESTR_otherINOUT;
+ return (ffelexHandler) ffestb_decl_attrs_6_;
+
+ default:
+ if (ffestb_local_.decl.kw != FFESTR_otherNone)
+ {
+ ffestb_local_.decl.kw = FFESTR_otherNone;
+ ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
+ }
+ return (ffelexHandler) ffestb_decl_attrs_5_;
+ }
+ break;
+
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_decl_attrs_6_ (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_attrs_6_ -- "type" [type parameters] ",INTENT" OPEN_PAREN "IN"
+ ["OUT"]
+
+ return ffestb_decl_attrs_6_; // to lexer
+
+ Handle CLOSE_PAREN. */
+
+static ffelexHandler
+ffestb_decl_attrs_6_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if ((ffestb_local_.decl.kw != FFESTR_otherNone)
+ && !ffesta_is_inhibited ())
+ ffestc_decl_attrib (FFESTP_attribINTENT, ffesta_tokens[1],
+ ffestb_local_.decl.kw, NULL);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_decl_attrs_7_;
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_decl_attrs_7_ -- "type" [type parameters] attribute
+
+ return ffestb_decl_attrs_7_; // to lexer
+
+ Handle COMMA (another attribute) or COLONCOLON (entities). */
+
+static ffelexHandler
+ffestb_decl_attrs_7_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_decl_attrs_;
+
+ case FFELEX_typeCOLONCOLON:
+ ffestb_local_.decl.coloncolon = TRUE;
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_attrsp_ -- "type" [type parameters]
+
+ return ffestb_decl_attrsp_; // to lexer
+
+ Handle COMMA (meaning we have attributes), COLONCOLON (meaning we have
+ no attributes but entities), or go to entsp to see about functions or
+ entities. */
+
+static ffelexHandler
+ffestb_decl_attrsp_ (ffelexToken t)
+{
+ ffelex_set_names (FALSE);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
+ ffestb_local_.decl.len, ffestb_local_.decl.lent);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ return (ffelexHandler) ffestb_decl_attrs_;
+
+ case FFELEX_typeCOLONCOLON:
+ ffestb_local_.decl.coloncolon = TRUE;
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
+ ffestb_local_.decl.len, ffestb_local_.decl.lent);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ default:
+ return (ffelexHandler) ffestb_decl_entsp_ (t);
+ }
+}
+
+/* ffestb_decl_ents_ -- "type" [type parameters] [attributes "::"]
+
+ return ffestb_decl_ents_; // to lexer
+
+ Handle NAME of an entity. */
+
+static ffelexHandler
+ffestb_decl_ents_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_decl_ents_1_;
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_ents_1_ -- "type" [type parameters] [attributes "::"] NAME
+
+ return ffestb_decl_ents_1_; // to lexer
+
+ Handle ASTERISK, OPEN_PAREN, EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_decl_ents_1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_item (ffesta_tokens[1], NULL, NULL, NULL, NULL, NULL, NULL,
+ NULL, FALSE);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_decl_item (ffesta_tokens[1], NULL, NULL, NULL, NULL, NULL, NULL,
+ NULL, FALSE);
+ ffestc_decl_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeASTERISK:
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_ents_2_;
+
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_ents_3_ (t);
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typeSLASH:
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_subrargs_.dim_list.dims = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_ents_7_ (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_ents_2_ -- "type" [type parameters] [attributes "::"] NAME
+ ASTERISK
+
+ return ffestb_decl_ents_2_; // to lexer
+
+ Handle NUMBER or OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_decl_ents_2_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ if (ffestb_local_.decl.type != FFESTP_typeCHARACTER)
+ {
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_decl_ents_3_;
+ }
+ /* Fall through. *//* (CHARACTER's *n is always a len spec. */
+ case FFELEX_typeOPEN_PAREN:/* "*(" is after the (omitted)
+ "(array-spec)". */
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_subrargs_.dim_list.dims = NULL;
+ return (ffelexHandler) ffestb_decl_ents_5_ (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_ents_3_ -- "type" [type parameters] [attributes "::"] NAME
+ [ASTERISK NUMBER]
+
+ return ffestb_decl_ents_3_; // to lexer
+
+ Handle ASTERISK, OPEN_PAREN, EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_decl_ents_3_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
+ ffestb_local_.decl.kindt, NULL, NULL, NULL, NULL, NULL, FALSE);
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
+ ffestb_local_.decl.kindt, NULL, NULL, NULL, NULL, NULL, FALSE);
+ ffestc_decl_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeASTERISK:
+ ffestb_subrargs_.dim_list.dims = NULL;
+ return (ffelexHandler) ffestb_decl_ents_5_;
+
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
+ ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_decl_ents_4_;
+ ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
+ ffestb_subrargs_.dim_list.ctx = ffesta_is_entry_valid
+ ? FFEEXPR_contextDIMLIST : FFEEXPR_contextDIMLISTCOMMON;
+#ifdef FFECOM_dimensionsMAX
+ ffestb_subrargs_.dim_list.ndims = 0;
+#endif
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestb_subrargs_.dim_list.ctx,
+ (ffeexprCallback) ffestb_subr_dimlist_);
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typeSLASH:
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_subrargs_.dim_list.dims = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_ents_7_ (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_ents_4_ -- "type" [type parameters] [attributes "::"] NAME
+ [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
+
+ return ffestb_decl_ents_4_; // to lexer
+
+ Handle ASTERISK, EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_decl_ents_4_ (ffelexToken t)
+{
+ ffelexToken nt;
+
+ if (!ffestb_subrargs_.dim_list.ok)
+ goto bad; /* :::::::::::::::::::: */
+
+ if (ffelex_token_type (ffesta_tokens[1]) == FFELEX_typeNAMES)
+ {
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeASTERISK:
+ case FFELEX_typeSLASH: /* But NOT FFELEX_typeEQUALS. */
+ case FFELEX_typeCOLONCOLON: /* Actually an error. */
+ break; /* Confirm and handle. */
+
+ default: /* Perhaps EQUALS, as in
+ INTEGERFUNCTIONX(A)=B. */
+ goto bad; /* :::::::::::::::::::: */
+ }
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ nt = ffelex_token_name_from_names (ffesta_tokens[1], 0, 0);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_tokens[1] = nt;
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, NULL, NULL);
+ }
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
+ ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
+ ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
+ FALSE);
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
+ ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
+ ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
+ FALSE);
+ ffestc_decl_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeASTERISK:
+ if (ffestb_local_.decl.lent != NULL)
+ break; /* Can't specify "*length" twice. */
+ return (ffelexHandler) ffestb_decl_ents_5_;
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typeSLASH:
+ return (ffelexHandler) ffestb_decl_ents_7_ (t);
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ if ((ffelex_token_type (ffesta_tokens[1]) != FFELEX_typeNAMES)
+ && !ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_ents_5_ -- "type" [type parameters] [attributes "::"] NAME
+ [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
+ ASTERISK
+
+ return ffestb_decl_ents_5_; // to lexer
+
+ Handle NUMBER or OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_decl_ents_5_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_decl_ents_7_;
+
+ case FFELEX_typeOPEN_PAREN:
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextCHARACTERSIZE, (ffeexprCallback) ffestb_decl_ents_6_);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_subrargs_.dim_list.dims != NULL)
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_ents_6_ -- "type" [type parameters] [attributes "::"] NAME
+ [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
+ ASTERISK OPEN_PAREN expr
+
+ (ffestb_decl_ents_6_) // to expression handler
+
+ Handle CLOSE_PAREN. */
+
+static ffelexHandler
+ffestb_decl_ents_6_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestb_local_.decl.len = expr;
+ ffestb_local_.decl.lent = ffelex_token_use (ft);
+ return (ffelexHandler) ffestb_decl_ents_7_;
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_subrargs_.dim_list.dims != NULL)
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_ents_7_ -- "type" [type parameters] [attributes "::"] NAME
+ [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
+ [ASTERISK charlength]
+
+ return ffestb_decl_ents_7_; // to lexer
+
+ Handle EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_decl_ents_7_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
+ ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
+ ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
+ FALSE);
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_subrargs_.dim_list.dims != NULL)
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
+ ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
+ ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
+ FALSE);
+ ffestc_decl_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_subrargs_.dim_list.dims != NULL)
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeEQUALS:
+ if (!ffestb_local_.decl.coloncolon)
+ ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_INIT, t);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestb_local_.decl.parameter ? FFEEXPR_contextPARAMETER
+ : FFEEXPR_contextINITVAL, (ffeexprCallback) ffestb_decl_ents_8_);
+
+ case FFELEX_typeSLASH:
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
+ ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
+ ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
+ TRUE);
+ ffestc_decl_itemstartvals ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_subrargs_.dim_list.dims != NULL)
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ return (ffelexHandler) ffeexpr_rhs
+ (ffesta_output_pool, FFEEXPR_contextDATA,
+ (ffeexprCallback) ffestb_decl_ents_9_);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_subrargs_.dim_list.dims != NULL)
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_ents_8_ -- "type" [type parameters] [attributes "::"] NAME
+ [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
+ [ASTERISK charlength] EQUALS expr
+
+ (ffestb_decl_ents_8_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_decl_ents_8_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
+ ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
+ ffestb_local_.decl.len, ffestb_local_.decl.lent, expr, ft,
+ FALSE);
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_subrargs_.dim_list.dims != NULL)
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
+ ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
+ ffestb_local_.decl.len, ffestb_local_.decl.lent, expr, ft,
+ FALSE);
+ ffestc_decl_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_subrargs_.dim_list.dims != NULL)
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_subrargs_.dim_list.dims != NULL)
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_ents_9_ -- "type" ... SLASH expr
+
+ (ffestb_decl_ents_9_) // to expression handler
+
+ Handle ASTERISK, COMMA, or SLASH. */
+
+static ffelexHandler
+ffestb_decl_ents_9_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_itemvalue (NULL, NULL, expr, ft);
+ return (ffelexHandler) ffeexpr_rhs
+ (ffesta_output_pool, FFEEXPR_contextDATA,
+ (ffeexprCallback) ffestb_decl_ents_9_);
+
+ case FFELEX_typeASTERISK:
+ if (expr == NULL)
+ break;
+ ffestb_local_.decl.expr = expr;
+ ffesta_tokens[1] = ffelex_token_use (ft);
+ return (ffelexHandler) ffeexpr_rhs
+ (ffesta_output_pool, FFEEXPR_contextDATA,
+ (ffeexprCallback) ffestb_decl_ents_10_);
+
+ case FFELEX_typeSLASH:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_decl_itemvalue (NULL, NULL, expr, ft);
+ ffestc_decl_itemendvals (t);
+ }
+ return (ffelexHandler) ffestb_decl_ents_11_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_decl_itemendvals (t);
+ ffestc_decl_finish ();
+ }
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_ents_10_ -- "type" ... SLASH expr ASTERISK expr
+
+ (ffestb_decl_ents_10_) // to expression handler
+
+ Handle COMMA or SLASH. */
+
+static ffelexHandler
+ffestb_decl_ents_10_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_itemvalue (ffestb_local_.decl.expr, ffesta_tokens[1],
+ expr, ft);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffeexpr_rhs
+ (ffesta_output_pool, FFEEXPR_contextDATA,
+ (ffeexprCallback) ffestb_decl_ents_9_);
+
+ case FFELEX_typeSLASH:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_decl_itemvalue (ffestb_local_.decl.expr, ffesta_tokens[1],
+ expr, ft);
+ ffestc_decl_itemendvals (t);
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_decl_ents_11_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_decl_itemendvals (t);
+ ffestc_decl_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_ents_11_ -- "type" [type parameters] [attributes "::"] NAME
+ [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
+ [ASTERISK charlength] SLASH initvals SLASH
+
+ return ffestb_decl_ents_11_; // to lexer
+
+ Handle COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_decl_ents_11_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_entsp_ -- "type" [type parameters]
+
+ return ffestb_decl_entsp_; // to lexer
+
+ Handle NAME or NAMES beginning either an entity (object) declaration or
+ a function definition.. */
+
+static ffelexHandler
+ffestb_decl_entsp_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_decl_entsp_1_;
+
+ case FFELEX_typeNAMES:
+ ffesta_confirmed ();
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_decl_entsp_2_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_entsp_1_ -- "type" [type parameters] NAME
+
+ return ffestb_decl_entsp_1_; // to lexer
+
+ If we get another NAME token here, then the previous one must be
+ "RECURSIVE" or "FUNCTION" and we handle it accordingly. Otherwise,
+ we send the previous and current token through to _ents_. */
+
+static ffelexHandler
+ffestb_decl_entsp_1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ switch (ffestr_first (ffesta_tokens[1]))
+ {
+#if FFESTR_F90
+ case FFESTR_firstRECURSIVE:
+ if (ffestr_first (t) != FFESTR_firstFUNCTION)
+ {
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ break;
+ }
+ ffestb_local_.decl.recursive = ffesta_tokens[1];
+ return (ffelexHandler) ffestb_decl_funcname_;
+#endif
+
+ case FFESTR_firstFUNCTION:
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_decl_funcname_ (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", ffesta_tokens[1]);
+ break;
+ }
+ break;
+
+ default:
+ if ((ffelex_token_type (ffesta_tokens[1]) != FFELEX_typeNAMES)
+ && !ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
+ ffestb_local_.decl.len, ffestb_local_.decl.lent);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ /* NAME/NAMES token already in ffesta_tokens[1]. */
+ return (ffelexHandler) ffestb_decl_ents_1_ (t);
+ }
+
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_entsp_2_ -- "type" [type parameters] NAMES
+
+ return ffestb_decl_entsp_2_; // to lexer
+
+ If we get an ASTERISK or OPEN_PAREN here, then if the previous NAMES
+ begins with "FUNCTION" or "RECURSIVEFUNCTION" and is followed by a
+ first-name-char, we have a possible syntactically ambiguous situation.
+ Otherwise, we have a straightforward situation just as if we went
+ through _entsp_1_ instead of here. */
+
+static ffelexHandler
+ffestb_decl_entsp_2_ (ffelexToken t)
+{
+ ffelexToken nt;
+ bool asterisk_ok;
+ char *p;
+ ffeTokenLength i;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeASTERISK:
+ ffesta_confirmed ();
+ switch (ffestb_local_.decl.type)
+ {
+ case FFESTP_typeINTEGER:
+ case FFESTP_typeREAL:
+ case FFESTP_typeCOMPLEX:
+ case FFESTP_typeLOGICAL:
+ asterisk_ok = (ffestb_local_.decl.kindt == NULL);
+ break;
+
+ case FFESTP_typeCHARACTER:
+ asterisk_ok = (ffestb_local_.decl.lent == NULL);
+ break;
+
+ case FFESTP_typeBYTE:
+ case FFESTP_typeWORD:
+ default:
+ asterisk_ok = FALSE;
+ break;
+ }
+ switch (ffestr_first (ffesta_tokens[1]))
+ {
+#if FFESTR_F90
+ case FFESTR_firstRECURSIVEFNCTN:
+ if (!asterisk_ok)
+ break; /* For our own convenience, treat as non-FN
+ stmt. */
+ p = ffelex_token_text (ffesta_tokens[1])
+ + (i = FFESTR_firstlRECURSIVEFNCTN);
+ if (!ffesrc_is_name_init (*p))
+ break;
+ ffestb_local_.decl.recursive
+ = ffelex_token_name_from_names (ffesta_tokens[1], 0,
+ FFESTR_firstlRECURSIVEFNCTN);
+ ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
+ FFESTR_firstlRECURSIVEFNCTN, 0);
+ return (ffelexHandler) ffestb_decl_entsp_3_;
+#endif
+
+ case FFESTR_firstFUNCTION:
+ if (!asterisk_ok)
+ break; /* For our own convenience, treat as non-FN
+ stmt. */
+ p = ffelex_token_text (ffesta_tokens[1])
+ + (i = FFESTR_firstlFUNCTION);
+ if (!ffesrc_is_name_init (*p))
+ break;
+ ffestb_local_.decl.recursive = NULL;
+ ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
+ FFESTR_firstlFUNCTION, 0);
+ return (ffelexHandler) ffestb_decl_entsp_3_;
+
+ default:
+ break;
+ }
+ break;
+
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_local_.decl.aster_after = FALSE;
+ switch (ffestr_first (ffesta_tokens[1]))
+ {
+#if FFESTR_F90
+ case FFESTR_firstRECURSIVEFNCTN:
+ p = ffelex_token_text (ffesta_tokens[1])
+ + (i = FFESTR_firstlRECURSIVEFNCTN);
+ if (!ffesrc_is_name_init (*p))
+ break;
+ ffestb_local_.decl.recursive
+ = ffelex_token_name_from_names (ffesta_tokens[1], 0,
+ FFESTR_firstlRECURSIVEFNCTN);
+ ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
+ FFESTR_firstlRECURSIVEFNCTN, 0);
+ return (ffelexHandler) ffestb_decl_entsp_5_ (t);
+#endif
+
+ case FFESTR_firstFUNCTION:
+ p = ffelex_token_text (ffesta_tokens[1])
+ + (i = FFESTR_firstlFUNCTION);
+ if (!ffesrc_is_name_init (*p))
+ break;
+ ffestb_local_.decl.recursive = NULL;
+ ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
+ FFESTR_firstlFUNCTION, 0);
+ return (ffelexHandler) ffestb_decl_entsp_5_ (t);
+
+ default:
+ break;
+ }
+ if ((ffestb_local_.decl.kindt != NULL)
+ || (ffestb_local_.decl.lent != NULL))
+ break; /* Have kind/len type param, definitely not
+ assignment stmt. */
+ return (ffelexHandler) ffestb_decl_entsp_1_ (t);
+
+ default:
+ break;
+ }
+
+ nt = ffelex_token_name_from_names (ffesta_tokens[1], 0, 0);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_tokens[1] = nt; /* Change NAMES to NAME. */
+ return (ffelexHandler) ffestb_decl_entsp_1_ (t);
+}
+
+/* ffestb_decl_entsp_3_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME ASTERISK
+
+ return ffestb_decl_entsp_3_; // to lexer
+
+ Handle NUMBER or OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_decl_entsp_3_ (ffelexToken t)
+{
+ ffestb_local_.decl.aster_after = TRUE;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ switch (ffestb_local_.decl.type)
+ {
+ case FFESTP_typeINTEGER:
+ case FFESTP_typeREAL:
+ case FFESTP_typeCOMPLEX:
+ case FFESTP_typeLOGICAL:
+ ffestb_local_.decl.kindt = ffelex_token_use (t);
+ break;
+
+ case FFESTP_typeCHARACTER:
+ ffestb_local_.decl.lent = ffelex_token_use (t);
+ break;
+
+ case FFESTP_typeBYTE:
+ case FFESTP_typeWORD:
+ default:
+ assert (FALSE);
+ }
+ return (ffelexHandler) ffestb_decl_entsp_5_;
+
+ case FFELEX_typeOPEN_PAREN:
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextCHARACTERSIZE,
+ (ffeexprCallback) ffestb_decl_entsp_4_);
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_entsp_4_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME ASTERISK OPEN_PAREN expr
+
+ (ffestb_decl_entsp_4_) // to expression handler
+
+ Allow only CLOSE_PAREN; and deal with character-length expression. */
+
+static ffelexHandler
+ffestb_decl_entsp_4_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ switch (ffestb_local_.decl.type)
+ {
+ case FFESTP_typeCHARACTER:
+ ffestb_local_.decl.len = expr;
+ ffestb_local_.decl.lent = ffelex_token_use (ft);
+ break;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ break;
+ }
+ return (ffelexHandler) ffestb_decl_entsp_5_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_entsp_5_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME [type parameter]
+
+ return ffestb_decl_entsp_5_; // to lexer
+
+ Make sure the next token is an OPEN_PAREN. Get the arg list or dimension
+ list. If it can't be an arg list, or if the CLOSE_PAREN is followed by
+ something other than EOS/SEMICOLON or NAME, then treat as dimension list
+ and handle statement as an R426/R501. If it can't be a dimension list, or
+ if the CLOSE_PAREN is followed by NAME, treat as an arg list and handle
+ statement as an R1219. If it can be either an arg list or a dimension
+ list and if the CLOSE_PAREN is followed by EOS/SEMICOLON, ask FFESTC
+ whether to treat the statement as an R426/R501 or an R1219 and act
+ accordingly. */
+
+static ffelexHandler
+ffestb_decl_entsp_5_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ if (ffestb_local_.decl.aster_after && (ffestb_local_.decl.len != NULL))
+ { /* "CHARACTER[RECURSIVE]FUNCTIONxyz*(len-expr)
+ (..." must be a function-stmt, since the
+ (len-expr) cannot precede (array-spec) in
+ an object declaration but can precede
+ (name-list) in a function stmt. */
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_tokens[1] = ffesta_tokens[2];
+ return (ffelexHandler) ffestb_decl_funcname_4_ (t);
+ }
+ ffestb_local_.decl.toklist = ffestt_tokenlist_create ();
+ ffestb_local_.decl.empty = TRUE;
+ ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
+ return (ffelexHandler) ffestb_decl_entsp_6_;
+
+ default:
+ break;
+ }
+
+ assert (ffestb_local_.decl.aster_after);
+ ffesta_confirmed (); /* We've seen an ASTERISK, so even EQUALS
+ confirmed. */
+ ffestb_subr_ambig_to_ents_ ();
+ ffestb_subrargs_.dim_list.dims = NULL;
+ return (ffelexHandler) ffestb_decl_ents_7_ (t);
+}
+
+/* ffestb_decl_entsp_6_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME [type parameter] OPEN_PAREN
+
+ return ffestb_decl_entsp_6_; // to lexer
+
+ If CLOSE_PAREN, we definitely have an R1219 function-stmt, since
+ the notation "name()" is invalid for a declaration. */
+
+static ffelexHandler
+ffestb_decl_entsp_6_ (ffelexToken t)
+{
+ ffelexHandler next;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (!ffestb_local_.decl.empty)
+ { /* Trailing comma, just a warning for
+ stmt func def, so allow ambiguity. */
+ ffestt_tokenlist_append (ffestb_local_.decl.toklist,
+ ffelex_token_use (t));
+ return (ffelexHandler) ffestb_decl_entsp_8_;
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_tokens[1] = ffesta_tokens[2];
+ next = (ffelexHandler) ffestt_tokenlist_handle
+ (ffestb_local_.decl.toklist, (ffelexHandler) ffestb_decl_funcname_4_);
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ return (ffelexHandler) (*next) (t);
+
+ case FFELEX_typeNAME:
+ ffestb_local_.decl.empty = FALSE;
+ ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
+ return (ffelexHandler) ffestb_decl_entsp_7_;
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typePERCENT:
+ case FFELEX_typePERIOD:
+ case FFELEX_typeOPEN_PAREN:
+ if ((ffestb_local_.decl.kindt != NULL)
+ || (ffestb_local_.decl.lent != NULL))
+ break; /* type(params)name or type*val name, either
+ way confirmed. */
+ return (ffelexHandler) ffestb_subr_ambig_nope_ (t);
+
+ default:
+ break;
+ }
+
+ ffesta_confirmed ();
+ ffestb_subr_ambig_to_ents_ ();
+ next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
+ (ffelexHandler) ffestb_decl_ents_3_);
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ return (ffelexHandler) (*next) (t);
+}
+
+/* ffestb_decl_entsp_7_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME [type parameter] OPEN_PAREN NAME
+
+ return ffestb_decl_entsp_7_; // to lexer
+
+ Expect COMMA or CLOSE_PAREN to remain ambiguous, else not an R1219
+ function-stmt. */
+
+static ffelexHandler
+ffestb_decl_entsp_7_ (ffelexToken t)
+{
+ ffelexHandler next;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
+ return (ffelexHandler) ffestb_decl_entsp_8_;
+
+ case FFELEX_typeCOMMA:
+ ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
+ return (ffelexHandler) ffestb_decl_entsp_6_;
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typePERCENT:
+ case FFELEX_typePERIOD:
+ case FFELEX_typeOPEN_PAREN:
+ if ((ffestb_local_.decl.kindt != NULL)
+ || (ffestb_local_.decl.lent != NULL))
+ break; /* type(params)name or type*val name, either
+ way confirmed. */
+ return (ffelexHandler) ffestb_subr_ambig_nope_ (t);
+
+ default:
+ break;
+ }
+
+ ffesta_confirmed ();
+ ffestb_subr_ambig_to_ents_ ();
+ next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
+ (ffelexHandler) ffestb_decl_ents_3_);
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ return (ffelexHandler) (*next) (t);
+}
+
+/* ffestb_decl_entsp_8_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME [type parameter] OPEN_PAREN name-list
+ CLOSE_PAREN
+
+ return ffestb_decl_entsp_8_; // to lexer
+
+ If EOS/SEMICOLON, situation remains ambiguous, ask FFESTC to resolve
+ it. If NAME (must be "RESULT", but that is checked later on),
+ definitely an R1219 function-stmt. Anything else, handle as entity decl. */
+
+static ffelexHandler
+ffestb_decl_entsp_8_ (ffelexToken t)
+{
+ ffelexHandler next;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (ffestc_is_decl_not_R1219 ())
+ break;
+ /* Fall through. */
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_tokens[1] = ffesta_tokens[2];
+ next = (ffelexHandler) ffestt_tokenlist_handle
+ (ffestb_local_.decl.toklist, (ffelexHandler) ffestb_decl_funcname_4_);
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ return (ffelexHandler) (*next) (t);
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typePERCENT:
+ case FFELEX_typePERIOD:
+ case FFELEX_typeOPEN_PAREN:
+ if ((ffestb_local_.decl.kindt != NULL)
+ || (ffestb_local_.decl.lent != NULL))
+ break; /* type(params)name or type*val name, either
+ way confirmed. */
+ return (ffelexHandler) ffestb_subr_ambig_nope_ (t);
+
+ default:
+ break;
+ }
+
+ ffesta_confirmed ();
+ ffestb_subr_ambig_to_ents_ ();
+ next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
+ (ffelexHandler) ffestb_decl_ents_3_);
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ return (ffelexHandler) (*next) (t);
+}
+
+/* ffestb_decl_func_ -- ["type" [type parameters]] RECURSIVE
+
+ return ffestb_decl_func_; // to lexer
+
+ Handle "FUNCTION". */
+
+#if FFESTR_F90
+static ffelexHandler
+ffestb_decl_func_ (ffelexToken t)
+{
+ char *p;
+ ffeTokenLength i;
+
+ ffelex_set_names (FALSE);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ if (ffestr_first (t) != FFESTR_firstFUNCTION)
+ break;
+ return (ffelexHandler) ffestb_decl_funcname_;
+
+ case FFELEX_typeNAMES:
+ ffesta_confirmed ();
+ if (ffestr_first (t) != FFESTR_firstFUNCTION)
+ break;
+ p = ffelex_token_text (t) + (i = FFESTR_firstlFUNCTION);
+ if (*p == '\0')
+ break;
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1] = ffelex_token_name_from_names (t, i, 0);
+ return (ffelexHandler) ffestb_decl_funcname_1_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_i: /* :::::::::::::::::::: */
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t, i, NULL);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_decl_funcname_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+
+ return ffestb_decl_funcname_; // to lexer
+
+ Handle NAME of a function. */
+
+static ffelexHandler
+ffestb_decl_funcname_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_decl_funcname_1_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_funcname_1_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME
+
+ return ffestb_decl_funcname_1_; // to lexer
+
+ Handle ASTERISK or OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_decl_funcname_1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeASTERISK:
+ return (ffelexHandler) ffestb_decl_funcname_2_;
+
+ case FFELEX_typeOPEN_PAREN:
+ return (ffelexHandler) ffestb_decl_funcname_4_ (t);
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_funcname_2_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME ASTERISK
+
+ return ffestb_decl_funcname_2_; // to lexer
+
+ Handle NUMBER or OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_decl_funcname_2_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ switch (ffestb_local_.decl.type)
+ {
+ case FFESTP_typeINTEGER:
+ case FFESTP_typeREAL:
+ case FFESTP_typeCOMPLEX:
+ case FFESTP_typeLOGICAL:
+ if (ffestb_local_.decl.kindt == NULL)
+ ffestb_local_.decl.kindt = ffelex_token_use (t);
+ else
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ break;
+
+ case FFESTP_typeCHARACTER:
+ if (ffestb_local_.decl.lent == NULL)
+ ffestb_local_.decl.lent = ffelex_token_use (t);
+ else
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ break;
+
+ case FFESTP_typeBYTE:
+ case FFESTP_typeWORD:
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ break;
+ }
+ return (ffelexHandler) ffestb_decl_funcname_4_;
+
+ case FFELEX_typeOPEN_PAREN:
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextCHARACTERSIZE,
+ (ffeexprCallback) ffestb_decl_funcname_3_);
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_funcname_3_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME ASTERISK OPEN_PAREN expr
+
+ (ffestb_decl_funcname_3_) // to expression handler
+
+ Allow only CLOSE_PAREN; and deal with character-length expression. */
+
+static ffelexHandler
+ffestb_decl_funcname_3_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ switch (ffestb_local_.decl.type)
+ {
+ case FFESTP_typeCHARACTER:
+ if (ffestb_local_.decl.lent == NULL)
+ {
+ ffestb_local_.decl.len = expr;
+ ffestb_local_.decl.lent = ffelex_token_use (ft);
+ }
+ else
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ break;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ break;
+ }
+ return (ffelexHandler) ffestb_decl_funcname_4_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_funcname_4_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME [type parameter]
+
+ return ffestb_decl_funcname_4_; // to lexer
+
+ Make sure the next token is an OPEN_PAREN. Get the arg list and
+ then implement. */
+
+static ffelexHandler
+ffestb_decl_funcname_4_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_subrargs_.name_list.args = ffestt_tokenlist_create ();
+ ffestb_subrargs_.name_list.handler
+ = (ffelexHandler) ffestb_decl_funcname_5_;
+ ffestb_subrargs_.name_list.is_subr = FALSE;
+ ffestb_subrargs_.name_list.names = FALSE;
+ return (ffelexHandler) ffestb_subr_name_list_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_funcname_5_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME [type parameter] OPEN_PAREN arg-list
+ CLOSE_PAREN
+
+ return ffestb_decl_funcname_5_; // to lexer
+
+ Must have EOS/SEMICOLON or "RESULT" here. */
+
+static ffelexHandler
+ffestb_decl_funcname_5_ (ffelexToken t)
+{
+ if (!ffestb_subrargs_.name_list.ok)
+ goto bad; /* :::::::::::::::::::: */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R1219 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
+ ffestb_subrargs_.name_list.close_paren, ffestb_local_.decl.type,
+ ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
+ ffestb_local_.decl.len, ffestb_local_.decl.lent,
+ ffestb_local_.decl.recursive, NULL);
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
+ ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeNAME:
+ if (ffestr_other (t) != FFESTR_otherRESULT)
+ break;
+ return (ffelexHandler) ffestb_decl_funcname_6_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
+ ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_funcname_6_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME [type parameter] OPEN_PAREN arglist
+ CLOSE_PAREN "RESULT"
+
+ return ffestb_decl_funcname_6_; // to lexer
+
+ Make sure the next token is an OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_decl_funcname_6_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ return (ffelexHandler) ffestb_decl_funcname_7_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
+ ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_funcname_7_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME [type parameter] OPEN_PAREN arglist
+ CLOSE_PAREN "RESULT" OPEN_PAREN
+
+ return ffestb_decl_funcname_7_; // to lexer
+
+ Make sure the next token is a NAME. */
+
+static ffelexHandler
+ffestb_decl_funcname_7_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_decl_funcname_8_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
+ ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_funcname_8_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME [type parameter] OPEN_PAREN arglist
+ CLOSE_PAREN "RESULT" OPEN_PAREN NAME
+
+ return ffestb_decl_funcname_8_; // to lexer
+
+ Make sure the next token is a CLOSE_PAREN. */
+
+static ffelexHandler
+ffestb_decl_funcname_8_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_decl_funcname_9_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
+ ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_funcname_9_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME [type parameter] OPEN_PAREN arg-list
+ CLOSE_PAREN "RESULT" OPEN_PAREN NAME CLOSE_PAREN
+
+ return ffestb_decl_funcname_9_; // to lexer
+
+ Must have EOS/SEMICOLON here. */
+
+static ffelexHandler
+ffestb_decl_funcname_9_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1219 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
+ ffestb_subrargs_.name_list.close_paren, ffestb_local_.decl.type,
+ ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
+ ffestb_local_.decl.len, ffestb_local_.decl.lent,
+ ffestb_local_.decl.recursive, ffesta_tokens[2]);
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
+ ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
+ ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V003 -- Parse the STRUCTURE statement
+
+ return ffestb_V003; // to lexer
+
+ Make sure the statement has a valid form for the STRUCTURE statement.
+ If it does, implement the statement. */
+
+#if FFESTR_VXT
+ffelexHandler
+ffestb_V003 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexToken nt;
+ ffelexHandler next;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstSTRUCTURE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_V003_start (NULL);
+ ffestb_local_.structure.started = TRUE;
+ return (ffelexHandler) ffestb_V0034_ (t);
+
+ case FFELEX_typeSLASH:
+ ffesta_confirmed ();
+ return (ffelexHandler) ffestb_V0031_;
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstSTRUCTURE)
+ goto bad_0; /* :::::::::::::::::::: */
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSTRUCTURE);
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed ();
+ break;
+
+ case FFELEX_typeSLASH:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ goto bad_1; /* :::::::::::::::::::: */
+ return (ffelexHandler) ffestb_V0031_;
+
+ case FFELEX_typeOPEN_PAREN:
+ break;
+ }
+
+ /* Here, we have at least one char after "STRUCTURE" and t is COMMA,
+ EOS/SEMICOLON, or OPEN_PAREN. */
+
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ if (ffelex_token_type (t) == FFELEX_typeOPEN_PAREN)
+ ffestb_local_.structure.started = FALSE;
+ else
+ {
+ if (!ffesta_is_inhibited ())
+ ffestc_V003_start (NULL);
+ ffestb_local_.structure.started = TRUE;
+ }
+ next = (ffelexHandler) ffestb_V0034_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0031_ -- "STRUCTURE" SLASH
+
+ return ffestb_V0031_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_V0031_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0032_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
+ break;
+ }
+
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0032_ -- "STRUCTURE" SLASH NAME
+
+ return ffestb_V0032_; // to lexer
+
+ Handle SLASH. */
+
+static ffelexHandler
+ffestb_V0032_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeSLASH:
+ if (!ffesta_is_inhibited ())
+ ffestc_V003_start (ffesta_tokens[1]);
+ ffestb_local_.structure.started = TRUE;
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_V0033_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0033_ -- "STRUCTURE" SLASH NAME SLASH
+
+ return ffestb_V0033_; // to lexer
+
+ Handle NAME or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_V0033_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ return (ffelexHandler) ffestb_V0034_ (t);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_V003_finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0034_ -- "STRUCTURE" [SLASH NAME SLASH]
+
+ return ffestb_V0034_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_V0034_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0035_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_V003_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0035_ -- "STRUCTURE" ... NAME
+
+ return ffestb_V0035_; // to lexer
+
+ Handle OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_V0035_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
+ ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_V0036_;
+ ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
+ ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLISTCOMMON;
+#ifdef FFECOM_dimensionsMAX
+ ffestb_subrargs_.dim_list.ndims = 0;
+#endif
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextDIMLISTCOMMON, (ffeexprCallback) ffestb_subr_dimlist_);
+
+ case FFELEX_typeCOMMA:
+ if (!ffesta_is_inhibited ())
+ ffestc_V003_item (ffesta_tokens[1], NULL);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_V0034_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_V003_item (ffesta_tokens[1], NULL);
+ ffestc_V003_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_V003_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0036_ -- "STRUCTURE" ... NAME OPEN_PAREN dimlist CLOSE_PAREN
+
+ return ffestb_V0036_; // to lexer
+
+ Handle COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_V0036_ (ffelexToken t)
+{
+ if (!ffestb_subrargs_.dim_list.ok)
+ goto bad; /* :::::::::::::::::::: */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.structure.started)
+ {
+ ffestc_V003_start (NULL);
+ ffestb_local_.structure.started = TRUE;
+ }
+ ffestc_V003_item (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ return (ffelexHandler) ffestb_V0034_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.structure.started)
+ ffestc_V003_start (NULL);
+ ffestc_V003_item (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ ffestc_V003_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
+ if (ffestb_local_.structure.started && !ffesta_is_inhibited ())
+ ffestc_V003_finish ();
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V016 -- Parse the RECORD statement
+
+ return ffestb_V016; // to lexer
+
+ Make sure the statement has a valid form for the RECORD statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_V016 (ffelexToken t)
+{
+ char *p;
+ ffeTokenLength i;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstRECORD)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstRECORD)
+ goto bad_0; /* :::::::::::::::::::: */
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlRECORD);
+ if (*p != '\0')
+ goto bad_i; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeSLASH:
+ break;
+ }
+
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_V016_start ();
+ return (ffelexHandler) ffestb_V0161_;
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "RECORD", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0161_ -- "RECORD" SLASH
+
+ return ffestb_V0161_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_V0161_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ if (!ffesta_is_inhibited ())
+ ffestc_V016_item_structure (t);
+ return (ffelexHandler) ffestb_V0162_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_V016_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0162_ -- "RECORD" SLASH NAME
+
+ return ffestb_V0162_; // to lexer
+
+ Handle SLASH. */
+
+static ffelexHandler
+ffestb_V0162_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeSLASH:
+ return (ffelexHandler) ffestb_V0163_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_V016_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0163_ -- "RECORD" SLASH NAME SLASH
+
+ return ffestb_V0163_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_V0163_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0164_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_V016_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0164_ -- "RECORD" ... NAME
+
+ return ffestb_V0164_; // to lexer
+
+ Handle OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_V0164_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
+ ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_V0165_;
+ ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
+ ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLISTCOMMON;
+#ifdef FFECOM_dimensionsMAX
+ ffestb_subrargs_.dim_list.ndims = 0;
+#endif
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextDIMLISTCOMMON, (ffeexprCallback) ffestb_subr_dimlist_);
+
+ case FFELEX_typeCOMMA:
+ if (!ffesta_is_inhibited ())
+ ffestc_V016_item_object (ffesta_tokens[1], NULL);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_V0166_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_V016_item_object (ffesta_tokens[1], NULL);
+ ffestc_V016_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_V016_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0165_ -- "RECORD" ... NAME OPEN_PAREN dimlist CLOSE_PAREN
+
+ return ffestb_V0165_; // to lexer
+
+ Handle COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_V0165_ (ffelexToken t)
+{
+ if (!ffestb_subrargs_.dim_list.ok)
+ goto bad; /* :::::::::::::::::::: */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (!ffesta_is_inhibited ())
+ ffestc_V016_item_object (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ return (ffelexHandler) ffestb_V0166_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_V016_item_object (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ ffestc_V016_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
+ if (ffestb_local_.structure.started && !ffesta_is_inhibited ())
+ ffestc_V016_finish ();
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0166_ -- "RECORD" SLASH NAME SLASH NAME [OPEN_PAREN dimlist
+ CLOSE_PAREN] COMMA
+
+ return ffestb_V0166_; // to lexer
+
+ Handle NAME or SLASH. */
+
+static ffelexHandler
+ffestb_V0166_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0164_;
+
+ case FFELEX_typeSLASH:
+ return (ffelexHandler) ffestb_V0161_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_V016_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_V027 -- Parse the VXT PARAMETER statement
+
+ return ffestb_V027; // to lexer
+
+ Make sure the statement has a valid form for the VXT PARAMETER statement.
+ If it does, implement the statement. */
+
+ffelexHandler
+ffestb_V027 (ffelexToken t)
+{
+ char *p;
+ ffeTokenLength i;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstPARAMETER)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ break;
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+ ffesta_confirmed ();
+ ffestb_local_.vxtparam.started = TRUE;
+ if (!ffesta_is_inhibited ())
+ ffestc_V027_start ();
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0271_;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstPARAMETER)
+ goto bad_0; /* :::::::::::::::::::: */
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlPARAMETER);
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ break;
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffestb_local_.vxtparam.started = FALSE;
+ ffesta_tokens[1] = ffelex_token_name_from_names (ffesta_tokens[0], i,
+ 0);
+ return (ffelexHandler) ffestb_V0271_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "PARAMETER", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0271_ -- "PARAMETER" NAME
+
+ return ffestb_V0271_; // to lexer
+
+ Handle EQUALS. */
+
+static ffelexHandler
+ffestb_V0271_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextPARAMETER, (ffeexprCallback) ffestb_V0272_);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.vxtparam.started && !ffesta_is_inhibited ())
+ ffestc_V027_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0272_ -- "PARAMETER" NAME EQUALS expr
+
+ (ffestb_V0272_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_V0272_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffestb_local_.vxtparam.started)
+ {
+ if (ffestc_is_let_not_V027 ())
+ break; /* Not a valid VXTPARAMETER stmt. */
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_V027_start ();
+ ffestb_local_.vxtparam.started = TRUE;
+ }
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_V027_item (ffesta_tokens[1], expr, ft);
+ ffestc_V027_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffestb_local_.vxtparam.started)
+ {
+ if (!ffesta_is_inhibited ())
+ ffestc_V027_start ();
+ ffestb_local_.vxtparam.started = TRUE;
+ }
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_V027_item (ffesta_tokens[1], expr, ft);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_V0273_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.vxtparam.started && !ffesta_is_inhibited ())
+ ffestc_V027_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0273_ -- "PARAMETER" NAME EQUALS expr COMMA
+
+ return ffestb_V0273_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_V0273_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0271_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
+ break;
+ }
+
+ if (ffestb_local_.vxtparam.started && !ffesta_is_inhibited ())
+ ffestc_V027_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_R539 -- Parse the IMPLICIT FUNCTION statement
+
+ return ffestb_decl_R539; // to lexer
+
+ Make sure the statement has a valid form for the IMPLICIT
+ statement. If it does, implement the statement. */
+
+ffelexHandler
+ffestb_decl_R539 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexToken nt;
+ ffestrSecond kw;
+
+ ffestb_local_.decl.recursive = NULL;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstIMPLICIT)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ break;
+ }
+ ffesta_confirmed ();
+ ffestb_local_.decl.imp_started = FALSE;
+ switch (ffesta_second_kw)
+ {
+ case FFESTR_secondINTEGER:
+ ffestb_local_.decl.type = FFESTP_typeINTEGER;
+ return (ffelexHandler) ffestb_decl_R5391_;
+
+ case FFESTR_secondBYTE:
+ ffestb_local_.decl.type = FFESTP_typeBYTE;
+ return (ffelexHandler) ffestb_decl_R5391_;
+
+ case FFESTR_secondWORD:
+ ffestb_local_.decl.type = FFESTP_typeWORD;
+ return (ffelexHandler) ffestb_decl_R5391_;
+
+ case FFESTR_secondREAL:
+ ffestb_local_.decl.type = FFESTP_typeREAL;
+ return (ffelexHandler) ffestb_decl_R5391_;
+
+ case FFESTR_secondCOMPLEX:
+ ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
+ return (ffelexHandler) ffestb_decl_R5391_;
+
+ case FFESTR_secondLOGICAL:
+ ffestb_local_.decl.type = FFESTP_typeLOGICAL;
+ return (ffelexHandler) ffestb_decl_R5391_;
+
+ case FFESTR_secondCHARACTER:
+ ffestb_local_.decl.type = FFESTP_typeCHARACTER;
+ return (ffelexHandler) ffestb_decl_R5391_;
+
+ case FFESTR_secondDOUBLE:
+ return (ffelexHandler) ffestb_decl_R5392_;
+
+ case FFESTR_secondDOUBLEPRECISION:
+ ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_R539letters_;
+
+ case FFESTR_secondDOUBLECOMPLEX:
+ ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_R539letters_;
+
+ case FFESTR_secondNONE:
+ return (ffelexHandler) ffestb_decl_R5394_;
+
+#if FFESTR_F90
+ case FFESTR_secondTYPE:
+ ffestb_local_.decl.type = FFESTP_typeTYPE;
+ return (ffelexHandler) ffestb_decl_R5393_;
+#endif
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstIMPLICIT)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeASTERISK:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeEOS:
+ ffesta_confirmed ();
+ break;
+
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlIMPLICIT);
+ if (!ffesrc_is_name_init (*p))
+ goto bad_0; /* :::::::::::::::::::: */
+ ffestb_local_.decl.imp_started = FALSE;
+ nt = ffelex_token_name_from_names (ffesta_tokens[0],
+ FFESTR_firstlIMPLICIT, 0);
+ kw = ffestr_second (nt);
+ ffelex_token_kill (nt);
+ switch (kw)
+ {
+ case FFESTR_secondINTEGER:
+ ffestb_local_.decl.type = FFESTP_typeINTEGER;
+ return (ffelexHandler) ffestb_decl_R5391_ (t);
+
+ case FFESTR_secondBYTE:
+ ffestb_local_.decl.type = FFESTP_typeBYTE;
+ return (ffelexHandler) ffestb_decl_R5391_ (t);
+
+ case FFESTR_secondWORD:
+ ffestb_local_.decl.type = FFESTP_typeWORD;
+ return (ffelexHandler) ffestb_decl_R5391_ (t);
+
+ case FFESTR_secondREAL:
+ ffestb_local_.decl.type = FFESTP_typeREAL;
+ return (ffelexHandler) ffestb_decl_R5391_ (t);
+
+ case FFESTR_secondCOMPLEX:
+ ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
+ return (ffelexHandler) ffestb_decl_R5391_ (t);
+
+ case FFESTR_secondLOGICAL:
+ ffestb_local_.decl.type = FFESTP_typeLOGICAL;
+ return (ffelexHandler) ffestb_decl_R5391_ (t);
+
+ case FFESTR_secondCHARACTER:
+ ffestb_local_.decl.type = FFESTP_typeCHARACTER;
+ return (ffelexHandler) ffestb_decl_R5391_ (t);
+
+ case FFESTR_secondDOUBLEPRECISION:
+ ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_R539letters_ (t);
+
+ case FFESTR_secondDOUBLECOMPLEX:
+ ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_R539letters_ (t);
+
+ case FFESTR_secondNONE:
+ return (ffelexHandler) ffestb_decl_R5394_ (t);
+
+#if FFESTR_F90
+ case FFESTR_secondTYPE:
+ ffestb_local_.decl.type = FFESTP_typeTYPE;
+ return (ffelexHandler) ffestb_decl_R5393_ (t);
+#endif
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_decl_R5391_ -- "IMPLICIT" generic-type
+
+ return ffestb_decl_R5391_; // to lexer
+
+ Handle ASTERISK or OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_decl_R5391_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeASTERISK:
+ ffesta_confirmed ();
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_R539letters_;
+ ffestb_local_.decl.badname = "IMPLICIT";
+ if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
+ return (ffelexHandler) ffestb_decl_starlen_;
+ return (ffelexHandler) ffestb_decl_starkind_;
+
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_R539letters_;
+ ffestb_local_.decl.badname = "IMPLICIT";
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
+ ffestb_local_.decl.imp_handler
+ = (ffelexHandler) ffestb_decl_typeparams_;
+ else
+ ffestb_local_.decl.imp_handler
+ = (ffelexHandler) ffestb_decl_kindparam_;
+ return (ffelexHandler) ffestb_decl_R539maybe_ (t);
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
+ ffestc_R539finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_R5392_ -- "IMPLICIT" "DOUBLE"
+
+ return ffestb_decl_R5392_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_decl_R5392_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ switch (ffestr_second (t))
+ {
+ case FFESTR_secondPRECISION:
+ ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
+ break;
+
+ case FFESTR_secondCOMPLEX:
+ ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
+ break;
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_R539letters_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
+ ffestc_R539finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_R5393_ -- "IMPLICIT" "TYPE"
+
+ return ffestb_decl_R5393_; // to lexer
+
+ Handle OPEN_PAREN. */
+
+#if FFESTR_F90
+static ffelexHandler
+ffestb_decl_R5393_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_R539letters_;
+ ffestb_local_.decl.badname = "IMPLICIT";
+ return (ffelexHandler) ffestb_decl_typetype1_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
+ ffestc_R539finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_decl_R5394_ -- "IMPLICIT" "NONE"
+
+ return ffestb_decl_R5394_; // to lexer
+
+ Handle EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_decl_R5394_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R539 (); /* IMPLICIT NONE. */
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_R5395_ -- "IMPLICIT" implicit-spec-list COMMA
+
+ return ffestb_decl_R5395_; // to lexer
+
+ Handle NAME for next type-spec. */
+
+static ffelexHandler
+ffestb_decl_R5395_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ switch (ffestr_second (t))
+ {
+ case FFESTR_secondINTEGER:
+ ffestb_local_.decl.type = FFESTP_typeINTEGER;
+ return (ffelexHandler) ffestb_decl_R5391_;
+
+ case FFESTR_secondBYTE:
+ ffestb_local_.decl.type = FFESTP_typeBYTE;
+ return (ffelexHandler) ffestb_decl_R5391_;
+
+ case FFESTR_secondWORD:
+ ffestb_local_.decl.type = FFESTP_typeWORD;
+ return (ffelexHandler) ffestb_decl_R5391_;
+
+ case FFESTR_secondREAL:
+ ffestb_local_.decl.type = FFESTP_typeREAL;
+ return (ffelexHandler) ffestb_decl_R5391_;
+
+ case FFESTR_secondCOMPLEX:
+ ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
+ return (ffelexHandler) ffestb_decl_R5391_;
+
+ case FFESTR_secondLOGICAL:
+ ffestb_local_.decl.type = FFESTP_typeLOGICAL;
+ return (ffelexHandler) ffestb_decl_R5391_;
+
+ case FFESTR_secondCHARACTER:
+ ffestb_local_.decl.type = FFESTP_typeCHARACTER;
+ return (ffelexHandler) ffestb_decl_R5391_;
+
+ case FFESTR_secondDOUBLE:
+ return (ffelexHandler) ffestb_decl_R5392_;
+
+ case FFESTR_secondDOUBLEPRECISION:
+ ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_R539letters_;
+
+ case FFESTR_secondDOUBLECOMPLEX:
+ ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_R539letters_;
+
+#if FFESTR_F90
+ case FFESTR_secondTYPE:
+ ffestb_local_.decl.type = FFESTP_typeTYPE;
+ return (ffelexHandler) ffestb_decl_R5393_;
+#endif
+
+ default:
+ break;
+ }
+ break;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
+ ffestc_R539finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_R539letters_ -- "IMPLICIT" type-spec
+
+ return ffestb_decl_R539letters_; // to lexer
+
+ Handle OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_decl_R539letters_ (ffelexToken t)
+{
+ ffelex_set_names (FALSE);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_local_.decl.imps = ffestt_implist_create ();
+ return (ffelexHandler) ffestb_decl_R539letters_1_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
+ ffestc_R539finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_R539letters_1_ -- "IMPLICIT" type-spec OPEN_PAREN
+
+ return ffestb_decl_R539letters_1_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_decl_R539letters_1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ if (ffelex_token_length (t) != 1)
+ break;
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_decl_R539letters_2_;
+
+ default:
+ break;
+ }
+
+ ffestt_implist_kill (ffestb_local_.decl.imps);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
+ ffestc_R539finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_R539letters_2_ -- "IMPLICIT" type-spec OPEN_PAREN NAME
+
+ return ffestb_decl_R539letters_2_; // to lexer
+
+ Handle COMMA or MINUS. */
+
+static ffelexHandler
+ffestb_decl_R539letters_2_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
+ return (ffelexHandler) ffestb_decl_R539letters_1_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
+ return (ffelexHandler) ffestb_decl_R539letters_5_;
+
+ case FFELEX_typeMINUS:
+ return (ffelexHandler) ffestb_decl_R539letters_3_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_implist_kill (ffestb_local_.decl.imps);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
+ ffestc_R539finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_R539letters_3_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
+
+ return ffestb_decl_R539letters_3_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_decl_R539letters_3_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ if (ffelex_token_length (t) != 1)
+ break;
+ ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1],
+ ffelex_token_use (t));
+ return (ffelexHandler) ffestb_decl_R539letters_4_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_implist_kill (ffestb_local_.decl.imps);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
+ ffestc_R539finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_R539letters_4_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
+ NAME
+
+ return ffestb_decl_R539letters_4_; // to lexer
+
+ Handle COMMA or CLOSE_PAREN. */
+
+static ffelexHandler
+ffestb_decl_R539letters_4_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_decl_R539letters_1_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_decl_R539letters_5_;
+
+ default:
+ break;
+ }
+
+ ffestt_implist_kill (ffestb_local_.decl.imps);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
+ ffestc_R539finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_R539letters_5_ -- "IMPLICIT" type-spec OPEN_PAREN
+ letter-spec-list CLOSE_PAREN
+
+ return ffestb_decl_R539letters_5_; // to lexer
+
+ Handle COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_decl_R539letters_5_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffestb_local_.decl.imp_started)
+ {
+ ffestb_local_.decl.imp_started = TRUE;
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R539start ();
+ }
+ if (!ffesta_is_inhibited ())
+ ffestc_R539item (ffestb_local_.decl.type, ffestb_local_.decl.kind,
+ ffestb_local_.decl.kindt, ffestb_local_.decl.len,
+ ffestb_local_.decl.lent, ffestb_local_.decl.imps);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffestt_implist_kill (ffestb_local_.decl.imps);
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_decl_R5395_;
+ if (!ffesta_is_inhibited ())
+ ffestc_R539finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffestt_implist_kill (ffestb_local_.decl.imps);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
+ ffestc_R539finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_R539maybe_ -- "IMPLICIT" generic-type-spec
+
+ return ffestb_decl_R539maybe_; // to lexer
+
+ Handle OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_decl_R539maybe_ (ffelexToken t)
+{
+ assert (ffelex_token_type (t) == FFELEX_typeOPEN_PAREN);
+ ffestb_local_.decl.imps = ffestt_implist_create ();
+ ffestb_local_.decl.toklist = ffestt_tokenlist_create ();
+ ffestb_local_.decl.imp_seen_comma
+ = (ffestb_local_.decl.type != FFESTP_typeCHARACTER);
+ return (ffelexHandler) ffestb_decl_R539maybe_1_;
+}
+
+/* ffestb_decl_R539maybe_1_ -- "IMPLICIT" generic-type-spec OPEN_PAREN
+
+ return ffestb_decl_R539maybe_1_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_decl_R539maybe_1_ (ffelexToken t)
+{
+ ffelexHandler next;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ if (ffelex_token_length (t) != 1)
+ break;
+ ffesta_tokens[1] = ffelex_token_use (t);
+ ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
+ return (ffelexHandler) ffestb_decl_R539maybe_2_;
+
+ default:
+ break;
+ }
+
+ ffestt_implist_kill (ffestb_local_.decl.imps);
+ next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
+ (ffelexHandler) ffestb_local_.decl.imp_handler);
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ return (ffelexHandler) (*next) (t);
+}
+
+/* ffestb_decl_R539maybe_2_ -- "IMPLICIT" generic-type-spec OPEN_PAREN NAME
+
+ return ffestb_decl_R539maybe_2_; // to lexer
+
+ Handle COMMA or MINUS. */
+
+static ffelexHandler
+ffestb_decl_R539maybe_2_ (ffelexToken t)
+{
+ ffelexHandler next;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
+ if (ffestb_local_.decl.imp_seen_comma)
+ {
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ return (ffelexHandler) ffestb_decl_R539letters_1_;
+ }
+ ffestb_local_.decl.imp_seen_comma = TRUE;
+ ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
+ return (ffelexHandler) ffestb_decl_R539maybe_1_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
+ ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
+ return (ffelexHandler) ffestb_decl_R539maybe_5_;
+
+ case FFELEX_typeMINUS:
+ ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
+ return (ffelexHandler) ffestb_decl_R539maybe_3_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_implist_kill (ffestb_local_.decl.imps);
+ next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
+ (ffelexHandler) ffestb_local_.decl.imp_handler);
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ return (ffelexHandler) (*next) (t);
+}
+
+/* ffestb_decl_R539maybe_3_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
+
+ return ffestb_decl_R539maybe_3_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_decl_R539maybe_3_ (ffelexToken t)
+{
+ ffelexHandler next;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ if (ffelex_token_length (t) != 1)
+ break;
+ ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1],
+ ffelex_token_use (t));
+ ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
+ return (ffelexHandler) ffestb_decl_R539maybe_4_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_implist_kill (ffestb_local_.decl.imps);
+ next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
+ (ffelexHandler) ffestb_local_.decl.imp_handler);
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ return (ffelexHandler) (*next) (t);
+}
+
+/* ffestb_decl_R539maybe_4_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
+ NAME
+
+ return ffestb_decl_R539maybe_4_; // to lexer
+
+ Handle COMMA or CLOSE_PAREN. */
+
+static ffelexHandler
+ffestb_decl_R539maybe_4_ (ffelexToken t)
+{
+ ffelexHandler next;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (ffestb_local_.decl.imp_seen_comma)
+ {
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ return (ffelexHandler) ffestb_decl_R539letters_1_;
+ }
+ ffestb_local_.decl.imp_seen_comma = TRUE;
+ ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
+ return (ffelexHandler) ffestb_decl_R539maybe_1_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
+ return (ffelexHandler) ffestb_decl_R539maybe_5_;
+
+ default:
+ break;
+ }
+
+ ffestt_implist_kill (ffestb_local_.decl.imps);
+ next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
+ (ffelexHandler) ffestb_local_.decl.imp_handler);
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ return (ffelexHandler) (*next) (t);
+}
+
+/* ffestb_decl_R539maybe_5_ -- "IMPLICIT" type-spec OPEN_PAREN
+ letter-spec-list CLOSE_PAREN
+
+ return ffestb_decl_R539maybe_5_; // to lexer
+
+ Handle COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_decl_R539maybe_5_ (ffelexToken t)
+{
+ ffelexHandler next;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ if (!ffestb_local_.decl.imp_started)
+ {
+ ffestb_local_.decl.imp_started = TRUE;
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R539start ();
+ }
+ if (!ffesta_is_inhibited ())
+ ffestc_R539item (ffestb_local_.decl.type, ffestb_local_.decl.kind,
+ ffestb_local_.decl.kindt, ffestb_local_.decl.len,
+ ffestb_local_.decl.lent, ffestb_local_.decl.imps);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffestt_implist_kill (ffestb_local_.decl.imps);
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_decl_R5395_;
+ if (!ffesta_is_inhibited ())
+ ffestc_R539finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeOPEN_PAREN:
+ ffesta_confirmed ();
+ ffestt_implist_kill (ffestb_local_.decl.imps);
+ next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
+ (ffelexHandler) ffestb_local_.decl.imp_handler);
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ break;
+ }
+
+ ffestt_implist_kill (ffestb_local_.decl.imps);
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
+ ffestc_R539finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
View Lorry Controller Status