/* stb.c -- Implementation File (module.c template V1.0) Copyright (C) 1995, 1996, 2002, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. GNU Fortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. GNU Fortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Fortran; see the file COPYING. If not, write to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. Related Modules: 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 "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; 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; struct { ffebld expr; } selectcase; struct { ffesttCaseList cases; } case_stmt; struct { bool is_cblock; } V014; 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; struct { bool started; } common; struct { bool started; } dimension; struct { bool started; } dimlist; struct { const 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. */ const 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); 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); static ffelexHandler ffestb_varlist5_ (ffelexToken t); static ffelexHandler ffestb_varlist6_ (ffelexToken t); 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); 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); 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 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); 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); static ffelexHandler ffestb_V0201_ (ffelexToken ft, ffebld expr, ffelexToken t); static ffelexHandler ffestb_V0202_ (ffelexToken ft, ffebld expr, ffelexToken t); 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); static ffelexHandler ffestb_R12291_ (ffelexToken t); static ffelexHandler ffestb_R12292_ (ffelexToken ft, ffebld expr, ffelexToken t); static ffelexHandler ffestb_decl_chartype1_ (ffelexToken t); static ffelexHandler ffestb_decl_attrs_ (ffelexToken t); static ffelexHandler ffestb_decl_attrs_1_ (ffelexToken t); static ffelexHandler ffestb_decl_attrs_2_ (ffelexToken t); 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); 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); 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); 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_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; unsigned const 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; const 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; unsigned const 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; const 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); 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) { 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; unsigned const 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_; 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; unsigned const 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) { 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); 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" 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" (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) { 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; case FFESTR_secondBLOCK: case FFESTR_secondBLOCKDATA: if (!ffesta_is_inhibited ()) ffestc_R1112 (ffesta_tokens[1]); break; 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; 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; unsigned const 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_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. */ unsigned const 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)) { 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 ()) ffestc_let (ffestb_local_.let.dest, expr, ft); 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_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; unsigned const 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 (); goto bad_1; /* :::::::::::::::::::: */ case FFELEX_typeCOMMA: ffesta_confirmed (); /* Error, but clearly intended. */ goto bad_1; /* :::::::::::::::::::: */ case FFELEX_typeCOLONCOLON: ffesta_confirmed (); ffesta_confirmed (); /* Error, but clearly intended. */ goto bad_1; /* :::::::::::::::::::: */ default: goto bad_1; /* :::::::::::::::::::: */ case FFELEX_typeOPEN_PAREN: goto bad_1; /* :::::::::::::::::::: */ case FFELEX_typeNAME: ffesta_confirmed (); switch (ffesta_first_kw) { case FFESTR_firstEXTERNAL: if (!ffesta_is_inhibited ()) ffestc_R1207_start (); break; case FFESTR_firstINTRINSIC: if (!ffesta_is_inhibited ()) ffestc_R1208_start (); break; 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 (); if (*p != '\0') break; goto bad_1; /* :::::::::::::::::::: */ case FFELEX_typeCOMMA: ffesta_confirmed (); /* Error, but clearly intended. */ if (*p != '\0') break; goto bad_1; /* :::::::::::::::::::: */ case FFELEX_typeCOLONCOLON: ffesta_confirmed (); goto bad_1; /* :::::::::::::::::::: */ case FFELEX_typeOPEN_PAREN: goto bad_1; /* :::::::::::::::::::: */ case FFELEX_typeNAME: ffesta_confirmed (); switch (ffesta_first_kw) { case FFESTR_firstEXTERNAL: if (!ffesta_is_inhibited ()) ffestc_R1207_start (); break; case FFESTR_firstINTRINSIC: if (!ffesta_is_inhibited ()) ffestc_R1208_start (); break; 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; 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_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; case FFESTR_firstINTRINSIC: ffestc_R1208_finish (); break; 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; case FFESTR_firstINTRINSIC: ffestc_R1208_item (ffesta_tokens[1]); break; 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; case FFESTR_firstINTRINSIC: ffestc_R1208_item (ffesta_tokens[1]); ffestc_R1208_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.varlist.badname, t); break; } if (!ffesta_is_inhibited ()) { switch (ffesta_first_kw) { case FFESTR_firstEXTERNAL: ffestc_R1207_finish (); break; case FFESTR_firstINTRINSIC: ffestc_R1208_finish (); break; default: assert (FALSE); } } ffelex_token_kill (ffesta_tokens[1]); return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); } /* 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; unsigned const 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) { unsigned const 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 = ffeexpr_convert (expr, ft, t, FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER1, 0, FFETARGET_charactersizeNONE, FFEEXPR_contextLET); 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: case FFELEX_typeOPEN_PAREN: 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) { const 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; unsigned const 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; unsigned const 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) { unsigned const 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) { const 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; unsigned const 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; unsigned const 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; unsigned const 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_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_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; const 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; unsigned const 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; const 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 = ffelex_token_length (t) + 1; i > 0; --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 = ffelex_token_length (t) + 1; i > 0; --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 "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 ((unsigned char)*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; const 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 = ffelex_token_length (t) + 1; i > 0; --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; const 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 = ffelex_token_length (t) + 1; i > 0; --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 = ffelex_token_length (t) + 1; i > 0; --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 = ffe_is_pedantic() ? required : optional; 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 ("bad format item" == NULL); 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_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; const 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)) { /* xgettext:no-c-format */ 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_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; unsigned const 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_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; 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; 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_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_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; const 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_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; unsigned const 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_ -- 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; unsigned const 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; unsigned const 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_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; unsigned const 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; unsigned const 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; unsigned const 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_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)) { 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_; case FFESTR_firstINTRINSIC: if (!ffesta_is_inhibited ()) ffestc_decl_attrib (FFESTP_attribINTRINSIC, t, FFESTR_otherNone, NULL); return (ffelexHandler) ffestb_decl_attrs_7_; 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_; case FFESTR_firstSAVE: if (!ffesta_is_inhibited ()) ffestc_decl_attrib (FFESTP_attribSAVE, t, FFESTR_otherNone, NULL); return (ffelexHandler) ffestb_decl_attrs_7_; 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_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])) { 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; unsigned const 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])) { 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])) { 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_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_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) { unsigned const 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; unsigned const 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_; 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); 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_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_; 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); }