diff options
Diffstat (limited to 'gcc/f/stb.c')
| -rw-r--r-- | gcc/f/stb.c | 25192 |
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); +} |