+++ /dev/null
-/* stb.c -- Implementation File (module.c template V1.0)
- Copyright (C) 1995, 1996, 2002 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;
-#if FFESTR_F90
- struct
- {
- ffestrOther kw;
- }
- type;
-#endif
- struct
- {
- ffelexHandler next;
- }
- construct;
- struct
- {
- ffesttFormatList f;
- ffestpFormatType current; /* What we're currently working on. */
- ffelexToken t; /* Token of what we're currently working on. */
- ffesttFormatValue pre;
- ffesttFormatValue post;
- ffesttFormatValue dot;
- ffesttFormatValue exp;
- bool sign; /* _3_, pos/neg; elsewhere, signed/unsigned. */
- bool complained; /* If run-time expr seen in nonexec context. */
- }
- format;
-#if FFESTR_F90
- struct
- {
- bool started;
- }
- moduleprocedure;
-#endif
- struct
- {
- ffebld expr;
- }
- selectcase;
- struct
- {
- ffesttCaseList cases;
- }
- case_stmt;
-#if FFESTR_F90
- struct
- {
- ffesttExprList exprs;
- ffebld expr;
- }
- heap;
-#endif
-#if FFESTR_F90
- struct
- {
- ffesttExprList exprs;
- }
- R624;
-#endif
-#if FFESTR_F90
- struct
- {
- ffestpDefinedOperator operator;
- bool assignment; /* TRUE for INTERFACE ASSIGNMENT, FALSE for
- ...OPERATOR. */
- bool slash; /* TRUE if OPEN_ARRAY, FALSE if OPEN_PAREN. */
- }
- interface;
-#endif
- struct
- {
- bool is_cblock;
- }
- V014;
-#if FFESTR_VXT
- struct
- {
- bool started;
- ffebld u;
- ffebld m;
- ffebld n;
- ffebld asv;
- }
- V025;
-#endif
- struct
- {
- ffestpBeruIx ix;
- bool label;
- bool left;
- ffeexprContext context;
- }
- beru;
- struct
- {
- ffestpCloseIx ix;
- bool label;
- bool left;
- ffeexprContext context;
- }
- close;
- struct
- {
- ffestpDeleteIx ix;
- bool label;
- bool left;
- ffeexprContext context;
- }
- delete;
- struct
- {
- ffestpDeleteIx ix;
- bool label;
- bool left;
- ffeexprContext context;
- }
- find;
- struct
- {
- ffestpInquireIx ix;
- bool label;
- bool left;
- ffeexprContext context;
- bool may_be_iolength;
- }
- inquire;
- struct
- {
- ffestpOpenIx ix;
- bool label;
- bool left;
- ffeexprContext context;
- }
- open;
- struct
- {
- ffestpReadIx ix;
- bool label;
- bool left;
- ffeexprContext context;
- }
- read;
- struct
- {
- ffestpRewriteIx ix;
- bool label;
- bool left;
- ffeexprContext context;
- }
- rewrite;
- struct
- {
- ffestpWriteIx ix;
- bool label;
- bool left;
- ffeexprContext context;
- }
- vxtcode;
- struct
- {
- ffestpWriteIx ix;
- bool label;
- bool left;
- ffeexprContext context;
- }
- write;
-#if FFESTR_F90
- struct
- {
- bool started;
- }
- structure;
-#endif
- struct
- {
- bool started;
- }
- common;
- struct
- {
- bool started;
- }
- dimension;
- struct
- {
- bool started;
- }
- dimlist;
- struct
- {
- 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);
-#if FFESTR_F90
-static ffelexHandler ffestb_decl_typetype1_ (ffelexToken t);
-static ffelexHandler ffestb_decl_typetype2_ (ffelexToken t);
-#endif
-static ffelexHandler ffestb_subr_label_list_ (ffelexToken t);
-static ffelexHandler ffestb_subr_label_list_1_ (ffelexToken t);
-static ffelexHandler ffestb_do1_ (ffelexToken t);
-static ffelexHandler ffestb_do2_ (ffelexToken t);
-static ffelexHandler ffestb_do3_ (ffelexToken t);
-static ffelexHandler ffestb_do4_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_do5_ (ffelexToken t);
-static ffelexHandler ffestb_do6_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_do7_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_do8_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_do9_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_else1_ (ffelexToken t);
-static ffelexHandler ffestb_else2_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_else3_ (ffelexToken t);
-static ffelexHandler ffestb_else4_ (ffelexToken t);
-static ffelexHandler ffestb_else5_ (ffelexToken t);
-static ffelexHandler ffestb_end1_ (ffelexToken t);
-static ffelexHandler ffestb_end2_ (ffelexToken t);
-static ffelexHandler ffestb_end3_ (ffelexToken t);
-static ffelexHandler ffestb_goto1_ (ffelexToken t);
-static ffelexHandler ffestb_goto2_ (ffelexToken t);
-static ffelexHandler ffestb_goto3_ (ffelexToken t);
-static ffelexHandler ffestb_goto4_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_goto5_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_goto6_ (ffelexToken t);
-static ffelexHandler ffestb_goto7_ (ffelexToken t);
-static ffelexHandler ffestb_halt1_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_if1_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_if2_ (ffelexToken t);
-static ffelexHandler ffestb_if3_ (ffelexToken t);
-static ffelexHandler ffestb_let1_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_let2_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-#if FFESTR_F90
-static ffelexHandler ffestb_type1_ (ffelexToken t);
-static ffelexHandler ffestb_type2_ (ffelexToken t);
-static ffelexHandler ffestb_type3_ (ffelexToken t);
-static ffelexHandler ffestb_type4_ (ffelexToken t);
-#endif
-#if FFESTR_F90
-static ffelexHandler ffestb_varlist1_ (ffelexToken t);
-static ffelexHandler ffestb_varlist2_ (ffelexToken t);
-static ffelexHandler ffestb_varlist3_ (ffelexToken t);
-static ffelexHandler ffestb_varlist4_ (ffelexToken t);
-#endif
-static ffelexHandler ffestb_varlist5_ (ffelexToken t);
-static ffelexHandler ffestb_varlist6_ (ffelexToken t);
-#if FFESTR_F90
-static ffelexHandler ffestb_where1_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_where2_ (ffelexToken t);
-static ffelexHandler ffestb_where3_ (ffelexToken t);
-#endif
-static ffelexHandler ffestb_R5221_ (ffelexToken t);
-static ffelexHandler ffestb_R5222_ (ffelexToken t);
-static ffelexHandler ffestb_R5223_ (ffelexToken t);
-static ffelexHandler ffestb_R5224_ (ffelexToken t);
-static ffelexHandler ffestb_R5281_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R5282_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R5283_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R5284_ (ffelexToken t);
-static ffelexHandler ffestb_R5371_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R5372_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R5373_ (ffelexToken t);
-static ffelexHandler ffestb_R5421_ (ffelexToken t);
-static ffelexHandler ffestb_R5422_ (ffelexToken t);
-static ffelexHandler ffestb_R5423_ (ffelexToken t);
-static ffelexHandler ffestb_R5424_ (ffelexToken t);
-static ffelexHandler ffestb_R5425_ (ffelexToken t);
-static ffelexHandler ffestb_R5441_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R5442_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R5443_ (ffelexToken t);
-static ffelexHandler ffestb_R5444_ (ffelexToken t);
-static ffelexHandler ffestb_R8341_ (ffelexToken t);
-static ffelexHandler ffestb_R8351_ (ffelexToken t);
-static ffelexHandler ffestb_R8381_ (ffelexToken t);
-static ffelexHandler ffestb_R8382_ (ffelexToken t);
-static ffelexHandler ffestb_R8383_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R8401_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R8402_ (ffelexToken t);
-static ffelexHandler ffestb_R8403_ (ffelexToken t);
-static ffelexHandler ffestb_R8404_ (ffelexToken t);
-static ffelexHandler ffestb_R8405_ (ffelexToken t);
-static ffelexHandler ffestb_R8406_ (ffelexToken t);
-static ffelexHandler ffestb_R8407_ (ffelexToken t);
-static ffelexHandler ffestb_R11021_ (ffelexToken t);
-static ffelexHandler ffestb_R1111_1_ (ffelexToken t);
-static ffelexHandler ffestb_R1111_2_ (ffelexToken t);
-static ffelexHandler ffestb_R12121_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R12271_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_construct1_ (ffelexToken t);
-static ffelexHandler ffestb_construct2_ (ffelexToken t);
-#if FFESTR_F90
-static ffelexHandler ffestb_heap1_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_heap2_ (ffelexToken t);
-static ffelexHandler ffestb_heap3_ (ffelexToken t);
-static ffelexHandler ffestb_heap4_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_heap5_ (ffelexToken t);
-#endif
-#if FFESTR_F90
-static ffelexHandler ffestb_module1_ (ffelexToken t);
-static ffelexHandler ffestb_module2_ (ffelexToken t);
-static ffelexHandler ffestb_module3_ (ffelexToken t);
-#endif
-static ffelexHandler ffestb_R8091_ (ffelexToken t);
-static ffelexHandler ffestb_R8092_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R8093_ (ffelexToken t);
-static ffelexHandler ffestb_R8101_ (ffelexToken t);
-static ffelexHandler ffestb_R8102_ (ffelexToken t);
-static ffelexHandler ffestb_R8103_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R8104_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R10011_ (ffelexToken t);
-static ffelexHandler ffestb_R10012_ (ffelexToken t);
-static ffelexHandler ffestb_R10013_ (ffelexToken t);
-static ffelexHandler ffestb_R10014_ (ffelexToken t);
-static ffelexHandler ffestb_R10015_ (ffelexToken t);
-static ffelexHandler ffestb_R10016_ (ffelexToken t);
-static ffelexHandler ffestb_R10017_ (ffelexToken t);
-static ffelexHandler ffestb_R10018_ (ffelexToken t);
-static ffelexHandler ffestb_R10019_ (ffelexToken t);
-static ffelexHandler ffestb_R100110_ (ffelexToken t);
-static ffelexHandler ffestb_R100111_ (ffelexToken t);
-static ffelexHandler ffestb_R100112_ (ffelexToken t);
-static ffelexHandler ffestb_R100113_ (ffelexToken t);
-static ffelexHandler ffestb_R100114_ (ffelexToken t);
-static ffelexHandler ffestb_R100115_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R100116_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R100117_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R100118_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-#if FFESTR_F90
-static ffelexHandler ffestb_R11071_ (ffelexToken t);
-static ffelexHandler ffestb_R11072_ (ffelexToken t);
-static ffelexHandler ffestb_R11073_ (ffelexToken t);
-static ffelexHandler ffestb_R11074_ (ffelexToken t);
-static ffelexHandler ffestb_R11075_ (ffelexToken t);
-static ffelexHandler ffestb_R11076_ (ffelexToken t);
-static ffelexHandler ffestb_R11077_ (ffelexToken t);
-static ffelexHandler ffestb_R11078_ (ffelexToken t);
-static ffelexHandler ffestb_R11079_ (ffelexToken t);
-static ffelexHandler ffestb_R110710_ (ffelexToken t);
-static ffelexHandler ffestb_R110711_ (ffelexToken t);
-static ffelexHandler ffestb_R110712_ (ffelexToken t);
-#endif
-#if FFESTR_F90
-static ffelexHandler ffestb_R12021_ (ffelexToken t);
-static ffelexHandler ffestb_R12022_ (ffelexToken t);
-static ffelexHandler ffestb_R12023_ (ffelexToken t);
-static ffelexHandler ffestb_R12024_ (ffelexToken t);
-static ffelexHandler ffestb_R12025_ (ffelexToken t);
-static ffelexHandler ffestb_R12026_ (ffelexToken t);
-#endif
-static ffelexHandler ffestb_S3P41_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_V0141_ (ffelexToken t);
-static ffelexHandler ffestb_V0142_ (ffelexToken t);
-static ffelexHandler ffestb_V0143_ (ffelexToken t);
-static ffelexHandler ffestb_V0144_ (ffelexToken t);
-#if FFESTR_VXT
-static ffelexHandler ffestb_V0251_ (ffelexToken t);
-static ffelexHandler ffestb_V0252_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_V0253_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_V0254_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_V0255_ (ffelexToken t);
-static ffelexHandler ffestb_V0256_ (ffelexToken t);
-static ffelexHandler ffestb_V0257_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_V0258_ (ffelexToken t);
-#endif
-#if FFESTB_KILL_EASY_
-static void ffestb_subr_kill_easy_ (ffestpInquireIx max);
-#else
-static void ffestb_subr_kill_accept_ (void);
-static void ffestb_subr_kill_beru_ (void);
-static void ffestb_subr_kill_close_ (void);
-static void ffestb_subr_kill_delete_ (void);
-static void ffestb_subr_kill_find_ (void); /* Not written yet. */
-static void ffestb_subr_kill_inquire_ (void);
-static void ffestb_subr_kill_open_ (void);
-static void ffestb_subr_kill_print_ (void);
-static void ffestb_subr_kill_read_ (void);
-static void ffestb_subr_kill_rewrite_ (void);
-static void ffestb_subr_kill_type_ (void);
-static void ffestb_subr_kill_vxtcode_ (void); /* Not written yet. */
-static void ffestb_subr_kill_write_ (void);
-#endif
-static ffelexHandler ffestb_beru1_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_beru2_ (ffelexToken t);
-static ffelexHandler ffestb_beru3_ (ffelexToken t);
-static ffelexHandler ffestb_beru4_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_beru5_ (ffelexToken t);
-static ffelexHandler ffestb_beru6_ (ffelexToken t);
-static ffelexHandler ffestb_beru7_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_beru8_ (ffelexToken t);
-static ffelexHandler ffestb_beru9_ (ffelexToken t);
-static ffelexHandler ffestb_beru10_ (ffelexToken t);
-#if FFESTR_VXT
-static ffelexHandler ffestb_vxtcode1_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_vxtcode2_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_vxtcode3_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_vxtcode4_ (ffelexToken t);
-static ffelexHandler ffestb_vxtcode5_ (ffelexToken t);
-static ffelexHandler ffestb_vxtcode6_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_vxtcode7_ (ffelexToken t);
-static ffelexHandler ffestb_vxtcode8_ (ffelexToken t);
-static ffelexHandler ffestb_vxtcode9_ (ffelexToken t);
-static ffelexHandler ffestb_vxtcode10_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-#endif
-static ffelexHandler ffestb_R9041_ (ffelexToken t);
-static ffelexHandler ffestb_R9042_ (ffelexToken t);
-static ffelexHandler ffestb_R9043_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R9044_ (ffelexToken t);
-static ffelexHandler ffestb_R9045_ (ffelexToken t);
-static ffelexHandler ffestb_R9046_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R9047_ (ffelexToken t);
-static ffelexHandler ffestb_R9048_ (ffelexToken t);
-static ffelexHandler ffestb_R9049_ (ffelexToken t);
-static ffelexHandler ffestb_R9071_ (ffelexToken t);
-static ffelexHandler ffestb_R9072_ (ffelexToken t);
-static ffelexHandler ffestb_R9073_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R9074_ (ffelexToken t);
-static ffelexHandler ffestb_R9075_ (ffelexToken t);
-static ffelexHandler ffestb_R9076_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R9077_ (ffelexToken t);
-static ffelexHandler ffestb_R9078_ (ffelexToken t);
-static ffelexHandler ffestb_R9079_ (ffelexToken t);
-static ffelexHandler ffestb_R9091_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R9092_ (ffelexToken t);
-static ffelexHandler ffestb_R9093_ (ffelexToken t);
-static ffelexHandler ffestb_R9094_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R9095_ (ffelexToken t);
-static ffelexHandler ffestb_R9096_ (ffelexToken t);
-static ffelexHandler ffestb_R9097_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R9098_ (ffelexToken t);
-static ffelexHandler ffestb_R9099_ (ffelexToken t);
-static ffelexHandler ffestb_R90910_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R90911_ (ffelexToken t);
-static ffelexHandler ffestb_R90912_ (ffelexToken t);
-static ffelexHandler ffestb_R90913_ (ffelexToken t);
-static ffelexHandler ffestb_R90914_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R90915_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R9101_ (ffelexToken t);
-static ffelexHandler ffestb_R9102_ (ffelexToken t);
-static ffelexHandler ffestb_R9103_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R9104_ (ffelexToken t);
-static ffelexHandler ffestb_R9105_ (ffelexToken t);
-static ffelexHandler ffestb_R9106_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R9107_ (ffelexToken t);
-static ffelexHandler ffestb_R9108_ (ffelexToken t);
-static ffelexHandler ffestb_R9109_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R91010_ (ffelexToken t);
-static ffelexHandler ffestb_R91011_ (ffelexToken t);
-static ffelexHandler ffestb_R91012_ (ffelexToken t);
-static ffelexHandler ffestb_R91013_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R91014_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R9111_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R9112_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R9231_ (ffelexToken t);
-static ffelexHandler ffestb_R9232_ (ffelexToken t);
-static ffelexHandler ffestb_R9233_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R9234_ (ffelexToken t);
-static ffelexHandler ffestb_R9235_ (ffelexToken t);
-static ffelexHandler ffestb_R9236_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R9237_ (ffelexToken t);
-static ffelexHandler ffestb_R9238_ (ffelexToken t);
-static ffelexHandler ffestb_R9239_ (ffelexToken t);
-static ffelexHandler ffestb_R92310_ (ffelexToken t);
-static ffelexHandler ffestb_R92311_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-#if FFESTR_VXT
-static ffelexHandler ffestb_V0181_ (ffelexToken t);
-static ffelexHandler ffestb_V0182_ (ffelexToken t);
-static ffelexHandler ffestb_V0183_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_V0184_ (ffelexToken t);
-static ffelexHandler ffestb_V0185_ (ffelexToken t);
-static ffelexHandler ffestb_V0186_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_V0187_ (ffelexToken t);
-static ffelexHandler ffestb_V0188_ (ffelexToken t);
-static ffelexHandler ffestb_V0189_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_V01810_ (ffelexToken t);
-static ffelexHandler ffestb_V01811_ (ffelexToken t);
-static ffelexHandler ffestb_V01812_ (ffelexToken t);
-static ffelexHandler ffestb_V01813_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_V0191_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_V0192_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-#endif
-static ffelexHandler ffestb_V0201_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_V0202_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-#if FFESTR_VXT
-static ffelexHandler ffestb_V0211_ (ffelexToken t);
-static ffelexHandler ffestb_V0212_ (ffelexToken t);
-static ffelexHandler ffestb_V0213_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_V0214_ (ffelexToken t);
-static ffelexHandler ffestb_V0215_ (ffelexToken t);
-static ffelexHandler ffestb_V0216_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_V0217_ (ffelexToken t);
-static ffelexHandler ffestb_V0218_ (ffelexToken t);
-static ffelexHandler ffestb_V0219_ (ffelexToken t);
-static ffelexHandler ffestb_V0261_ (ffelexToken t);
-static ffelexHandler ffestb_V0262_ (ffelexToken t);
-static ffelexHandler ffestb_V0263_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_V0264_ (ffelexToken t);
-static ffelexHandler ffestb_V0265_ (ffelexToken t);
-static ffelexHandler ffestb_V0266_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_V0267_ (ffelexToken t);
-static ffelexHandler ffestb_V0268_ (ffelexToken t);
-static ffelexHandler ffestb_V0269_ (ffelexToken t);
-#endif
-#if FFESTR_F90
-static ffelexHandler ffestb_dimlist1_ (ffelexToken t);
-static ffelexHandler ffestb_dimlist2_ (ffelexToken t);
-static ffelexHandler ffestb_dimlist3_ (ffelexToken t);
-static ffelexHandler ffestb_dimlist4_ (ffelexToken t);
-#endif
-static ffelexHandler ffestb_dummy1_ (ffelexToken t);
-static ffelexHandler ffestb_dummy2_ (ffelexToken t);
-static ffelexHandler ffestb_R5241_ (ffelexToken t);
-static ffelexHandler ffestb_R5242_ (ffelexToken t);
-static ffelexHandler ffestb_R5243_ (ffelexToken t);
-static ffelexHandler ffestb_R5244_ (ffelexToken t);
-static ffelexHandler ffestb_R5471_ (ffelexToken t);
-static ffelexHandler ffestb_R5472_ (ffelexToken t);
-static ffelexHandler ffestb_R5473_ (ffelexToken t);
-static ffelexHandler ffestb_R5474_ (ffelexToken t);
-static ffelexHandler ffestb_R5475_ (ffelexToken t);
-static ffelexHandler ffestb_R5476_ (ffelexToken t);
-static ffelexHandler ffestb_R5477_ (ffelexToken t);
-#if FFESTR_F90
-static ffelexHandler ffestb_R6241_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_R6242_ (ffelexToken t);
-#endif
-static ffelexHandler ffestb_R12291_ (ffelexToken t);
-static ffelexHandler ffestb_R12292_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_decl_chartype1_ (ffelexToken t);
-#if FFESTR_F90
-static ffelexHandler ffestb_decl_recursive1_ (ffelexToken t);
-static ffelexHandler ffestb_decl_recursive2_ (ffelexToken t);
-static ffelexHandler ffestb_decl_recursive3_ (ffelexToken t);
-static ffelexHandler ffestb_decl_recursive4_ (ffelexToken t);
-#endif
-static ffelexHandler ffestb_decl_attrs_ (ffelexToken t);
-static ffelexHandler ffestb_decl_attrs_1_ (ffelexToken t);
-static ffelexHandler ffestb_decl_attrs_2_ (ffelexToken t);
-#if FFESTR_F90
-static ffelexHandler ffestb_decl_attrs_3_ (ffelexToken t);
-static ffelexHandler ffestb_decl_attrs_4_ (ffelexToken t);
-static ffelexHandler ffestb_decl_attrs_5_ (ffelexToken t);
-static ffelexHandler ffestb_decl_attrs_6_ (ffelexToken t);
-#endif
-static ffelexHandler ffestb_decl_attrs_7_ (ffelexToken t);
-static ffelexHandler ffestb_decl_attrsp_ (ffelexToken t);
-static ffelexHandler ffestb_decl_ents_ (ffelexToken t);
-static ffelexHandler ffestb_decl_ents_1_ (ffelexToken t);
-static ffelexHandler ffestb_decl_ents_2_ (ffelexToken t);
-static ffelexHandler ffestb_decl_ents_3_ (ffelexToken t);
-static ffelexHandler ffestb_decl_ents_4_ (ffelexToken t);
-static ffelexHandler ffestb_decl_ents_5_ (ffelexToken t);
-static ffelexHandler ffestb_decl_ents_6_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_decl_ents_7_ (ffelexToken t);
-static ffelexHandler ffestb_decl_ents_8_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_decl_ents_9_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_decl_ents_10_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_decl_ents_11_ (ffelexToken t);
-static ffelexHandler ffestb_decl_entsp_ (ffelexToken t);
-static ffelexHandler ffestb_decl_entsp_1_ (ffelexToken t);
-static ffelexHandler ffestb_decl_entsp_2_ (ffelexToken t);
-static ffelexHandler ffestb_decl_entsp_3_ (ffelexToken t);
-static ffelexHandler ffestb_decl_entsp_4_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_decl_entsp_5_ (ffelexToken t);
-static ffelexHandler ffestb_decl_entsp_6_ (ffelexToken t);
-static ffelexHandler ffestb_decl_entsp_7_ (ffelexToken t);
-static ffelexHandler ffestb_decl_entsp_8_ (ffelexToken t);
-#if FFESTR_F90
-static ffelexHandler ffestb_decl_func_ (ffelexToken t);
-#endif
-static ffelexHandler ffestb_decl_funcname_ (ffelexToken t);
-static ffelexHandler ffestb_decl_funcname_1_ (ffelexToken t);
-static ffelexHandler ffestb_decl_funcname_2_ (ffelexToken t);
-static ffelexHandler ffestb_decl_funcname_3_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_decl_funcname_4_ (ffelexToken t);
-static ffelexHandler ffestb_decl_funcname_5_ (ffelexToken t);
-static ffelexHandler ffestb_decl_funcname_6_ (ffelexToken t);
-static ffelexHandler ffestb_decl_funcname_7_ (ffelexToken t);
-static ffelexHandler ffestb_decl_funcname_8_ (ffelexToken t);
-static ffelexHandler ffestb_decl_funcname_9_ (ffelexToken t);
-#if FFESTR_VXT
-static ffelexHandler ffestb_V0031_ (ffelexToken t);
-static ffelexHandler ffestb_V0032_ (ffelexToken t);
-static ffelexHandler ffestb_V0033_ (ffelexToken t);
-static ffelexHandler ffestb_V0034_ (ffelexToken t);
-static ffelexHandler ffestb_V0035_ (ffelexToken t);
-static ffelexHandler ffestb_V0036_ (ffelexToken t);
-static ffelexHandler ffestb_V0161_ (ffelexToken t);
-static ffelexHandler ffestb_V0162_ (ffelexToken t);
-static ffelexHandler ffestb_V0163_ (ffelexToken t);
-static ffelexHandler ffestb_V0164_ (ffelexToken t);
-static ffelexHandler ffestb_V0165_ (ffelexToken t);
-static ffelexHandler ffestb_V0166_ (ffelexToken t);
-#endif
-static ffelexHandler ffestb_V0271_ (ffelexToken t);
-static ffelexHandler ffestb_V0272_ (ffelexToken ft, ffebld expr,
- ffelexToken t);
-static ffelexHandler ffestb_V0273_ (ffelexToken t);
-static ffelexHandler ffestb_decl_R5391_ (ffelexToken t);
-static ffelexHandler ffestb_decl_R5392_ (ffelexToken t);
-#if FFESTR_F90
-static ffelexHandler ffestb_decl_R5393_ (ffelexToken t);
-#endif
-static ffelexHandler ffestb_decl_R5394_ (ffelexToken t);
-static ffelexHandler ffestb_decl_R5395_ (ffelexToken t);
-static ffelexHandler ffestb_decl_R539letters_ (ffelexToken t);
-static ffelexHandler ffestb_decl_R539letters_1_ (ffelexToken t);
-static ffelexHandler ffestb_decl_R539letters_2_ (ffelexToken t);
-static ffelexHandler ffestb_decl_R539letters_3_ (ffelexToken t);
-static ffelexHandler ffestb_decl_R539letters_4_ (ffelexToken t);
-static ffelexHandler ffestb_decl_R539letters_5_ (ffelexToken t);
-static ffelexHandler ffestb_decl_R539maybe_ (ffelexToken t);
-static ffelexHandler ffestb_decl_R539maybe_1_ (ffelexToken t);
-static ffelexHandler ffestb_decl_R539maybe_2_ (ffelexToken t);
-static ffelexHandler ffestb_decl_R539maybe_3_ (ffelexToken t);
-static ffelexHandler ffestb_decl_R539maybe_4_ (ffelexToken t);
-static ffelexHandler ffestb_decl_R539maybe_5_ (ffelexToken t);
-
-/* Internal macros. */
-
-#if FFESTB_KILL_EASY_
-#define ffestb_subr_kill_accept_() \
- ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_acceptix)
-#define ffestb_subr_kill_beru_() \
- ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_beruix)
-#define ffestb_subr_kill_close_() \
- ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_closeix)
-#define ffestb_subr_kill_delete_() \
- ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_deleteix)
-#define ffestb_subr_kill_find_() \
- ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_findix)
-#define ffestb_subr_kill_inquire_() \
- ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_inquireix)
-#define ffestb_subr_kill_open_() \
- ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_openix)
-#define ffestb_subr_kill_print_() \
- ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_printix)
-#define ffestb_subr_kill_read_() \
- ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_readix)
-#define ffestb_subr_kill_rewrite_() \
- ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_rewriteix)
-#define ffestb_subr_kill_type_() \
- ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_typeix)
-#define ffestb_subr_kill_vxtcode_() \
- ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_vxtcodeix)
-#define ffestb_subr_kill_write_() \
- ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_writeix)
-#endif
-\f
-/* ffestb_subr_ambig_nope_ -- Cleans up and aborts ambig w/o confirming
-
- ffestb_subr_ambig_nope_();
-
- Switch from ambiguity handling in _entsp_ functions to handling entities
- in _ents_ (perform housekeeping tasks). */
-
-static ffelexHandler
-ffestb_subr_ambig_nope_ (ffelexToken t)
-{
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffelex_token_kill (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[2]);
- ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_subr_ambig_to_ents_ -- Switches from ambiguity to entity decl
-
- ffestb_subr_ambig_to_ents_();
-
- Switch from ambiguity handling in _entsp_ functions to handling entities
- in _ents_ (perform housekeeping tasks). */
-
-static void
-ffestb_subr_ambig_to_ents_ ()
-{
- ffelexToken nt;
-
- nt = ffelex_token_name_from_names (ffesta_tokens[1], 0, 0);
- ffelex_token_kill (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[2]);
- ffesta_tokens[1] = nt;
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- if (!ffestb_local_.decl.aster_after)
- {
- if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
- {
- if (!ffesta_is_inhibited ())
- ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
- ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
- ffestb_local_.decl.len, ffestb_local_.decl.lent);
- if (ffestb_local_.decl.kindt != NULL)
- {
- ffelex_token_kill (ffestb_local_.decl.kindt);
- ffestb_local_.decl.kind = NULL;
- ffestb_local_.decl.kindt = NULL;
- }
- if (ffestb_local_.decl.lent != NULL)
- {
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffestb_local_.decl.len = NULL;
- ffestb_local_.decl.lent = NULL;
- }
- }
- else
- {
- if (!ffesta_is_inhibited ())
- ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
- ffestb_local_.decl.kind, ffestb_local_.decl.kindt, NULL,
- NULL);
- if (ffestb_local_.decl.kindt != NULL)
- {
- ffelex_token_kill (ffestb_local_.decl.kindt);
- ffestb_local_.decl.kind = NULL;
- ffestb_local_.decl.kindt = NULL;
- }
- }
- return;
- }
- if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
- {
- if (!ffesta_is_inhibited ())
- ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
- ffestb_local_.decl.kind, ffestb_local_.decl.kindt, NULL, NULL);
- if (ffestb_local_.decl.kindt != NULL)
- {
- ffelex_token_kill (ffestb_local_.decl.kindt);
- ffestb_local_.decl.kind = NULL;
- ffestb_local_.decl.kindt = NULL;
- }
- }
- else if (!ffesta_is_inhibited ())
- ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
- NULL, NULL, NULL, NULL);
- /* NAME/NAMES token already in ffesta_tokens[1]. */
-}
-
-/* ffestb_subr_dimlist_ -- OPEN_PAREN expr
-
- (ffestb_subr_dimlist_) // to expression handler
-
- Deal with a dimension list.
-
- 19-Dec-90 JCB 1.1
- Detect too many dimensions if backend wants it. */
-
-static ffelexHandler
-ffestb_subr_dimlist_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCLOSE_PAREN:
- if (expr == NULL)
- break;
-#ifdef FFECOM_dimensionsMAX
- if (ffestb_subrargs_.dim_list.ndims++ == FFECOM_dimensionsMAX)
- {
- ffesta_ffebad_1t (FFEBAD_TOO_MANY_DIMS, ft);
- ffestb_subrargs_.dim_list.ok = TRUE; /* Not a parse error, really. */
- return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
- }
-#endif
- ffestt_dimlist_append (ffestb_subrargs_.dim_list.dims, NULL, expr,
- ffelex_token_use (t));
- ffestb_subrargs_.dim_list.ok = TRUE;
- return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
-
- case FFELEX_typeCOMMA:
- if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
- break;
-#ifdef FFECOM_dimensionsMAX
- if (ffestb_subrargs_.dim_list.ndims++ == FFECOM_dimensionsMAX)
- {
- ffesta_ffebad_1t (FFEBAD_TOO_MANY_DIMS, ft);
- return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
- ffestb_subrargs_.dim_list.ctx,
- (ffeexprCallback) ffestb_subr_dimlist_2_);
- }
-#endif
- ffestt_dimlist_append (ffestb_subrargs_.dim_list.dims, NULL, expr,
- ffelex_token_use (t));
- return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
- ffestb_subrargs_.dim_list.ctx,
- (ffeexprCallback) ffestb_subr_dimlist_);
-
- case FFELEX_typeCOLON:
- if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
- break;
-#ifdef FFECOM_dimensionsMAX
- if (ffestb_subrargs_.dim_list.ndims++ == FFECOM_dimensionsMAX)
- {
- ffesta_ffebad_1t (FFEBAD_TOO_MANY_DIMS, ft);
- return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
- ffestb_subrargs_.dim_list.ctx,
- (ffeexprCallback) ffestb_subr_dimlist_2_);
- }
-#endif
- ffestt_dimlist_append (ffestb_subrargs_.dim_list.dims, expr, NULL,
- ffelex_token_use (t)); /* NULL second expr for
- now, just plug in. */
- return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
- ffestb_subrargs_.dim_list.ctx,
- (ffeexprCallback) ffestb_subr_dimlist_1_);
-
- default:
- break;
- }
-
- ffestb_subrargs_.dim_list.ok = FALSE;
- return (ffelexHandler) ffestb_subrargs_.dim_list.handler (t);
-}
-
-/* ffestb_subr_dimlist_1_ -- OPEN_PAREN expr COLON expr
-
- (ffestb_subr_dimlist_1_) // to expression handler
-
- Get the upper bound. */
-
-static ffelexHandler
-ffestb_subr_dimlist_1_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCLOSE_PAREN:
- ffestb_subrargs_.dim_list.dims->previous->upper = expr;
- ffestb_subrargs_.dim_list.ok = TRUE;
- return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
-
- case FFELEX_typeCOMMA:
- if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
- break;
- ffestb_subrargs_.dim_list.dims->previous->upper = expr;
- return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
- ffestb_subrargs_.dim_list.ctx, (ffeexprCallback) ffestb_subr_dimlist_);
-
- default:
- break;
- }
-
- ffestb_subrargs_.dim_list.ok = FALSE;
- return (ffelexHandler) ffestb_subrargs_.dim_list.handler (t);
-}
-
-/* ffestb_subr_dimlist_2_ -- OPEN_PAREN too-many-dim-exprs
-
- (ffestb_subr_dimlist_2_) // to expression handler
-
- Get the upper bound. */
-
-static ffelexHandler
-ffestb_subr_dimlist_2_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCLOSE_PAREN:
- ffestb_subrargs_.dim_list.ok = TRUE; /* Not a parse error, really. */
- return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
-
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLON:
- if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
- break;
- return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
- ffestb_subrargs_.dim_list.ctx,
- (ffeexprCallback) ffestb_subr_dimlist_2_);
-
- default:
- break;
- }
-
- ffestb_subrargs_.dim_list.ok = FALSE;
- return (ffelexHandler) ffestb_subrargs_.dim_list.handler (t);
-}
-
-/* ffestb_subr_name_list_ -- Collect a list of name args and close-paren
-
- return ffestb_subr_name_list_; // to lexer after seeing OPEN_PAREN
-
- This implements R1224 in the Fortran 90 spec. The arg list may be
- empty, or be a comma-separated list (an optional trailing comma currently
- results in a warning but no other effect) of arguments. For functions,
- however, "*" is invalid (we implement dummy-arg-name, rather than R1224
- dummy-arg, which itself is either dummy-arg-name or "*"). */
-
-static ffelexHandler
-ffestb_subr_name_list_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCLOSE_PAREN:
- if (ffestt_tokenlist_count (ffestb_subrargs_.name_list.args) != 0)
- { /* Trailing comma, warn. */
- ffebad_start (FFEBAD_TRAILING_COMMA);
- ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
- ffebad_finish ();
- }
- ffestb_subrargs_.name_list.ok = TRUE;
- ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
- if (ffestb_subrargs_.name_list.names)
- ffelex_set_names (TRUE);
- return (ffelexHandler) ffestb_subrargs_.name_list.handler;
-
- case FFELEX_typeASTERISK:
- if (!ffestb_subrargs_.name_list.is_subr)
- break;
-
- case FFELEX_typeNAME:
- ffestt_tokenlist_append (ffestb_subrargs_.name_list.args,
- ffelex_token_use (t));
- return (ffelexHandler) ffestb_subr_name_list_1_;
-
- default:
- break;
- }
-
- ffestb_subrargs_.name_list.ok = FALSE;
- ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
- if (ffestb_subrargs_.name_list.names)
- ffelex_set_names (TRUE);
- return (ffelexHandler) (*ffestb_subrargs_.name_list.handler) (t);
-}
-
-/* ffestb_subr_name_list_1_ -- NAME or ASTERISK
-
- return ffestb_subr_name_list_1_; // to lexer
-
- The next token must be COMMA or CLOSE_PAREN, either way go to original
- state, but only after adding the appropriate name list item. */
-
-static ffelexHandler
-ffestb_subr_name_list_1_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- return (ffelexHandler) ffestb_subr_name_list_;
-
- case FFELEX_typeCLOSE_PAREN:
- ffestb_subrargs_.name_list.ok = TRUE;
- ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
- if (ffestb_subrargs_.name_list.names)
- ffelex_set_names (TRUE);
- return (ffelexHandler) ffestb_subrargs_.name_list.handler;
-
- default:
- ffestb_subrargs_.name_list.ok = FALSE;
- ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
- if (ffestb_subrargs_.name_list.names)
- ffelex_set_names (TRUE);
- return (ffelexHandler) (*ffestb_subrargs_.name_list.handler) (t);
- }
-}
-
-static void
-ffestb_subr_R1001_append_p_ (void)
-{
- ffesttFormatList f;
-
- if (!ffestb_local_.format.pre.present)
- {
- ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_P_SPEC, ffestb_local_.format.t);
- ffelex_token_kill (ffestb_local_.format.t);
- return;
- }
-
- f = ffestt_formatlist_append (ffestb_local_.format.f);
- f->type = FFESTP_formattypeP;
- f->t = ffestb_local_.format.t;
- f->u.R1010.val = ffestb_local_.format.pre;
-}
-
-/* ffestb_decl_kindparam_ -- "type" OPEN_PAREN
-
- return ffestb_decl_kindparam_; // to lexer
-
- Handle "[KIND=]expr)". */
-
-static ffelexHandler
-ffestb_decl_kindparam_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_decl_kindparam_1_;
-
- default:
- return (ffelexHandler) (*((ffelexHandler)
- ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextKINDTYPE,
- (ffeexprCallback) ffestb_decl_kindparam_2_)))
- (t);
- }
-}
-
-/* ffestb_decl_kindparam_1_ -- "type" OPEN_PAREN NAME
-
- return ffestb_decl_kindparam_1_; // to lexer
-
- Handle "[KIND=]expr)". */
-
-static ffelexHandler
-ffestb_decl_kindparam_1_ (ffelexToken t)
-{
- ffelexHandler next;
- ffelexToken nt;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEQUALS:
- ffesta_confirmed ();
- if (ffestr_other (ffesta_tokens[1]) != FFESTR_otherKIND)
- break;
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextKINDTYPE, (ffeexprCallback) ffestb_decl_kindparam_2_);
-
- default:
- nt = ffesta_tokens[1];
- next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextKINDTYPE, (ffeexprCallback) ffestb_decl_kindparam_2_)))
- (nt);
- ffelex_token_kill (nt);
- return (ffelexHandler) (*next) (t);
- }
-
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
- ffestb_local_.decl.badname,
- ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_kindparam_2_ -- "type" OPEN_PAREN ["KIND="] expr
-
- (ffestb_decl_kindparam_2_) // to expression handler
-
- Handle "[KIND=]expr)". */
-
-static ffelexHandler
-ffestb_decl_kindparam_2_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCLOSE_PAREN:
- ffestb_local_.decl.kind = expr;
- ffestb_local_.decl.kindt = ffelex_token_use (ft);
- ffestb_local_.decl.len = NULL;
- ffestb_local_.decl.lent = NULL;
- ffelex_set_names (TRUE);
- return (ffelexHandler) ffestb_local_.decl.handler;
-
- default:
- break;
- }
-
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
- ffestb_local_.decl.badname,
- t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_starkind_ -- "type" ASTERISK
-
- return ffestb_decl_starkind_; // to lexer
-
- Handle NUMBER. */
-
-static ffelexHandler
-ffestb_decl_starkind_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNUMBER:
- ffestb_local_.decl.kindt = ffelex_token_use (t);
- ffestb_local_.decl.kind = NULL;
- ffestb_local_.decl.len = NULL;
- ffestb_local_.decl.lent = NULL;
- ffelex_set_names (TRUE);
- return (ffelexHandler) ffestb_local_.decl.handler;
-
- default:
- break;
- }
-
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
- ffestb_local_.decl.badname,
- t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_starlen_ -- "CHARACTER" ASTERISK
-
- return ffestb_decl_starlen_; // to lexer
-
- Handle NUMBER. */
-
-static ffelexHandler
-ffestb_decl_starlen_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNUMBER:
- ffestb_local_.decl.kind = NULL;
- ffestb_local_.decl.kindt = NULL;
- ffestb_local_.decl.len = NULL;
- ffestb_local_.decl.lent = ffelex_token_use (t);
- ffelex_set_names (TRUE);
- return (ffelexHandler) ffestb_local_.decl.handler;
-
- case FFELEX_typeOPEN_PAREN:
- ffestb_local_.decl.kind = NULL;
- ffestb_local_.decl.kindt = NULL;
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextCHARACTERSIZE,
- (ffeexprCallback) ffestb_decl_starlen_1_);
-
- default:
- break;
- }
-
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
- ffestb_local_.decl.badname,
- t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_starlen_1_ -- "CHARACTER" ASTERISK OPEN_PAREN expr
-
- (ffestb_decl_starlen_1_) // to expression handler
-
- Handle CLOSE_PAREN. */
-
-static ffelexHandler
-ffestb_decl_starlen_1_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCLOSE_PAREN:
- if (expr == NULL)
- break;
- ffestb_local_.decl.len = expr;
- ffestb_local_.decl.lent = ffelex_token_use (ft);
- ffelex_set_names (TRUE);
- return (ffelexHandler) ffestb_local_.decl.handler;
-
- default:
- break;
- }
-
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
- ffestb_local_.decl.badname,
- t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_typeparams_ -- "CHARACTER" OPEN_PAREN
-
- return ffestb_decl_typeparams_; // to lexer
-
- Handle "[KIND=]expr)". */
-
-static ffelexHandler
-ffestb_decl_typeparams_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_decl_typeparams_1_;
-
- default:
- if (ffestb_local_.decl.lent == NULL)
- return (ffelexHandler) (*((ffelexHandler)
- ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextCHARACTERSIZE,
- (ffeexprCallback) ffestb_decl_typeparams_2_)))
- (t);
- if (ffestb_local_.decl.kindt != NULL)
- break;
- return (ffelexHandler) (*((ffelexHandler)
- ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextKINDTYPE,
- (ffeexprCallback) ffestb_decl_typeparams_3_)))
- (t);
- }
-
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
- ffestb_local_.decl.badname,
- t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_typeparams_1_ -- "CHARACTER" OPEN_PAREN NAME
-
- return ffestb_decl_typeparams_1_; // to lexer
-
- Handle "[KIND=]expr)". */
-
-static ffelexHandler
-ffestb_decl_typeparams_1_ (ffelexToken t)
-{
- ffelexHandler next;
- ffelexToken nt;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEQUALS:
- ffesta_confirmed ();
- switch (ffestr_other (ffesta_tokens[1]))
- {
- case FFESTR_otherLEN:
- if (ffestb_local_.decl.lent != NULL)
- break;
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextCHARACTERSIZE,
- (ffeexprCallback) ffestb_decl_typeparams_2_);
-
- case FFESTR_otherKIND:
- if (ffestb_local_.decl.kindt != NULL)
- break;
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextKINDTYPE,
- (ffeexprCallback) ffestb_decl_typeparams_3_);
-
- default:
- break;
- }
- break;
-
- default:
- nt = ffesta_tokens[1];
- if (ffestb_local_.decl.lent == NULL)
- next = (ffelexHandler) (*((ffelexHandler)
- ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextCHARACTERSIZE,
- (ffeexprCallback) ffestb_decl_typeparams_2_)))
- (nt);
- else if (ffestb_local_.decl.kindt == NULL)
- next = (ffelexHandler) (*((ffelexHandler)
- ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextKINDTYPE,
- (ffeexprCallback) ffestb_decl_typeparams_3_)))
- (nt);
- else
- {
- ffesta_tokens[1] = nt;
- break;
- }
- ffelex_token_kill (nt);
- return (ffelexHandler) (*next) (t);
- }
-
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
- ffestb_local_.decl.badname,
- ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_typeparams_2_ -- "CHARACTER" OPEN_PAREN ["LEN="] expr
-
- (ffestb_decl_typeparams_2_) // to expression handler
-
- Handle "[LEN=]expr)". */
-
-static ffelexHandler
-ffestb_decl_typeparams_2_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCLOSE_PAREN:
- ffestb_local_.decl.len = expr;
- ffestb_local_.decl.lent = ffelex_token_use (ft);
- ffelex_set_names (TRUE);
- return (ffelexHandler) ffestb_local_.decl.handler;
-
- case FFELEX_typeCOMMA:
- ffestb_local_.decl.len = expr;
- ffestb_local_.decl.lent = ffelex_token_use (ft);
- return (ffelexHandler) ffestb_decl_typeparams_;
-
- default:
- break;
- }
-
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
- ffestb_local_.decl.badname,
- t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_typeparams_3_ -- "CHARACTER" OPEN_PAREN ["KIND="] expr
-
- (ffestb_decl_typeparams_3_) // to expression handler
-
- Handle "[KIND=]expr)". */
-
-static ffelexHandler
-ffestb_decl_typeparams_3_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCLOSE_PAREN:
- ffestb_local_.decl.kind = expr;
- ffestb_local_.decl.kindt = ffelex_token_use (ft);
- ffelex_set_names (TRUE);
- return (ffelexHandler) ffestb_local_.decl.handler;
-
- case FFELEX_typeCOMMA:
- ffestb_local_.decl.kind = expr;
- ffestb_local_.decl.kindt = ffelex_token_use (ft);
- return (ffelexHandler) ffestb_decl_typeparams_;
-
- default:
- break;
- }
-
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
- ffestb_local_.decl.badname,
- t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_typetype1_ -- "TYPE" OPEN_PAREN
-
- return ffestb_decl_typetype1_; // to lexer
-
- Handle NAME. */
-
-#if FFESTR_F90
-static ffelexHandler
-ffestb_decl_typetype1_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffestb_local_.decl.kindt = ffelex_token_use (t);
- return (ffelexHandler) ffestb_decl_typetype2_;
-
- default:
- break;
- }
-
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
- ffestb_local_.decl.badname,
- t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_typetype2_ -- "TYPE" OPEN_PAREN NAME
-
- return ffestb_decl_typetype2_; // to lexer
-
- Handle CLOSE_PAREN. */
-
-static ffelexHandler
-ffestb_decl_typetype2_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCLOSE_PAREN:
- ffestb_local_.decl.type = FFESTP_typeTYPE;
- ffestb_local_.decl.kind = NULL;
- ffestb_local_.decl.len = NULL;
- ffestb_local_.decl.lent = NULL;
- ffelex_set_names (TRUE);
- return (ffelexHandler) ffestb_local_.decl.handler;
-
- default:
- break;
- }
-
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- ffelex_token_kill (ffestb_local_.decl.kindt);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
- ffestb_local_.decl.badname,
- t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-#endif
-/* ffestb_subr_label_list_ -- Collect a tokenlist of labels and close-paren
-
- return ffestb_subr_label_list_; // to lexer after seeing OPEN_PAREN
-
- First token must be a NUMBER. Must be followed by zero or more COMMA
- NUMBER pairs. Must then be followed by a CLOSE_PAREN. If all ok, put
- the NUMBER tokens in a token list and return via the handler for the
- token after CLOSE_PAREN. Else return via
- same handler, but with the ok return value set FALSE. */
-
-static ffelexHandler
-ffestb_subr_label_list_ (ffelexToken t)
-{
- if (ffelex_token_type (t) == FFELEX_typeNUMBER)
- {
- ffestt_tokenlist_append (ffestb_subrargs_.label_list.labels,
- ffelex_token_use (t));
- return (ffelexHandler) ffestb_subr_label_list_1_;
- }
-
- ffestb_subrargs_.label_list.ok = FALSE;
- return (ffelexHandler) (*ffestb_subrargs_.label_list.handler) (t);
-}
-
-/* ffestb_subr_label_list_1_ -- NUMBER
-
- return ffestb_subr_label_list_1_; // to lexer after seeing NUMBER
-
- The next token must be COMMA, in which case go back to
- ffestb_subr_label_list_, or CLOSE_PAREN, in which case set ok to TRUE
- and go to the handler. */
-
-static ffelexHandler
-ffestb_subr_label_list_1_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- return (ffelexHandler) ffestb_subr_label_list_;
-
- case FFELEX_typeCLOSE_PAREN:
- ffestb_subrargs_.label_list.ok = TRUE;
- return (ffelexHandler) ffestb_subrargs_.label_list.handler;
-
- default:
- ffestb_subrargs_.label_list.ok = FALSE;
- return (ffelexHandler) (*ffestb_subrargs_.label_list.handler) (t);
- }
-}
-
-/* ffestb_do -- Parse the DO statement
-
- return ffestb_do; // to lexer
-
- Make sure the statement has a valid form for the DO statement. If it
- does, implement the statement. */
-
-ffelexHandler
-ffestb_do (ffelexToken t)
-{
- ffeTokenLength i;
- 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);
-#if FFESTR_F90
- if ((ffestb_args.elsexyz.second == FFESTR_secondWHERE)
- && (ffelex_token_length (ffesta_tokens[1]) != FFESTR_secondlWHERE))
- ffestb_args.elsexyz.second = FFESTR_secondNone;
-#endif
- return (ffelexHandler) ffestb_else1_ (t);
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-
-bad_i: /* :::::::::::::::::::: */
- ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "ELSE IF", ffesta_tokens[0], i, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_else1_ -- "ELSE" (NAME)
-
- return ffestb_else1_; // to lexer
-
- If EOS/SEMICOLON, implement the appropriate statement (keep in mind that
- "ELSE WHERE" is ambiguous at the syntactic level). If OPEN_PAREN, start
- expression analysis with callback at _2_. */
-
-static ffelexHandler
-ffestb_else1_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeOPEN_PAREN:
- if (ffestb_args.elsexyz.second == FFESTR_secondIF)
- {
- if (ffesta_tokens[1] != NULL)
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextIF, (ffeexprCallback) ffestb_else2_);
- }
- /* Fall through. */
- default:
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", t);
- if (ffesta_tokens[1] != NULL)
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero);
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- break;
-
- }
-
- switch (ffestb_args.elsexyz.second)
- {
-#if FFESTR_F90
- case FFESTR_secondWHERE:
- if (!ffesta_is_inhibited ())
- if ((ffesta_first_kw == FFESTR_firstELSEWHERE)
- && (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME))
- ffestc_R744 ();
- else
- ffestc_elsewhere (ffesta_tokens[1]); /* R744 or R805. */
- break;
-#endif
-
- default:
- if (!ffesta_is_inhibited ())
- ffestc_R805 (ffesta_tokens[1]);
- break;
- }
-
- if (ffesta_tokens[1] != NULL)
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffesta_zero (t);
-}
-
-/* ffestb_else2_ -- "ELSE" "IF" OPEN_PAREN expr
-
- (ffestb_else2_) // to expression handler
-
- Make sure the next token is CLOSE_PAREN. */
-
-static ffelexHandler
-ffestb_else2_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- ffestb_local_.else_stmt.expr = expr;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCLOSE_PAREN:
- if (expr == NULL)
- break;
- ffesta_tokens[1] = ffelex_token_use (ft);
- ffelex_set_names (TRUE);
- return (ffelexHandler) ffestb_else3_;
-
- default:
- break;
- }
-
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_else3_ -- "ELSE" "IF" OPEN_PAREN expr CLOSE_PAREN
-
- return ffestb_else3_; // to lexer
-
- Make sure the next token is "THEN". */
-
-static ffelexHandler
-ffestb_else3_ (ffelexToken t)
-{
- ffeTokenLength i;
- 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_;
-
-#if FFESTR_F90
- case FFESTR_secondINTERFACE:
-#endif
-#if FFESTR_VXT
- case FFESTR_secondMAP:
- case FFESTR_secondSTRUCTURE:
- case FFESTR_secondUNION:
-#endif
-#if FFESTR_F90
- case FFESTR_secondWHERE:
- ffesta_tokens[1] = NULL;
- return (ffelexHandler) ffestb_end3_;
-#endif
-
- case FFESTR_secondNone:
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- return (ffelexHandler) ffestb_end2_;
- }
-
- case FFELEX_typeNAMES:
- if (ffesta_first_kw != FFESTR_firstEND)
- goto bad_0; /* :::::::::::::::::::: */
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- break;
- }
- ffesta_confirmed ();
- if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlEND)
- {
- i = FFESTR_firstlEND;
- goto bad_i; /* :::::::::::::::::::: */
- }
- ffesta_tokens[1] = NULL;
- ffestb_args.endxyz.second = FFESTR_secondNone;
- return (ffelexHandler) ffestb_end3_ (t);
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-
-bad_i: /* :::::::::::::::::::: */
- ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0], i, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_endxyz -- Parse an ENDxyz statement
-
- return ffestb_endxyz; // to lexer
-
- Expects len and second to be set in ffestb_args.endxyz to the length
- of the ENDxyz keyword involved and the corresponding ffestrSecond value. */
-
-ffelexHandler
-ffestb_endxyz (ffelexToken t)
-{
- ffeTokenLength i;
- 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)
- {
-#if FFESTR_F90
- case FFESTR_secondINTERFACE:
-#endif
-#if FFESTR_VXT
- case FFESTR_secondMAP:
- case FFESTR_secondSTRUCTURE:
- case FFESTR_secondUNION:
-#endif
-#if FFESTR_F90
- case FFESTR_secondWHERE:
- goto bad_1; /* :::::::::::::::::::: */
-#endif
-
- case FFESTR_secondBLOCK:
- if (ffesta_second_kw != FFESTR_secondDATA)
- goto bad_1; /* :::::::::::::::::::: */
- return (ffelexHandler) ffestb_end2_;
-
- default:
- return (ffelexHandler) ffestb_end2_ (t);
- }
-
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
- }
-
- case FFELEX_typeNAMES:
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- break;
- }
- ffesta_confirmed ();
- if (ffestb_args.endxyz.second == FFESTR_secondBLOCK)
- {
- i = FFESTR_firstlEND;
- goto bad_i; /* :::::::::::::::::::: */
- }
- if (ffelex_token_length (ffesta_tokens[0]) != ffestb_args.endxyz.len)
- {
- p = ffelex_token_text (ffesta_tokens[0])
- + (i = ffestb_args.endxyz.len);
- switch (ffestb_args.endxyz.second)
- {
-#if FFESTR_F90
- case FFESTR_secondINTERFACE:
-#endif
-#if FFESTR_VXT
- case FFESTR_secondMAP:
- case FFESTR_secondSTRUCTURE:
- case FFESTR_secondUNION:
-#endif
-#if FFESTR_F90
- case FFESTR_secondWHERE:
- goto bad_i; /* :::::::::::::::::::: */
-#endif
-
- default:
- break;
- }
- if (!ffesrc_is_name_init (*p))
- goto bad_i; /* :::::::::::::::::::: */
- ffesta_tokens[1]
- = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
- return (ffelexHandler) ffestb_end3_ (t);
- }
- ffesta_tokens[1] = NULL;
- return (ffelexHandler) ffestb_end3_ (t);
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-
-bad_i: /* :::::::::::::::::::: */
- ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0], i, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_end1_ -- "END" "BLOCK"
-
- return ffestb_end1_; // to lexer
-
- Make sure the next token is "DATA". */
-
-static ffelexHandler
-ffestb_end1_ (ffelexToken t)
-{
- if ((ffelex_token_type (t) == FFELEX_typeNAME)
- && (ffesrc_strcmp_2c (ffe_case_match (), ffelex_token_text (t), "DATA",
- "data", "Data")
- == 0))
- {
- return (ffelexHandler) ffestb_end2_;
- }
-
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_end2_ -- "END" <unit-kind>
-
- return ffestb_end2_; // to lexer
-
- Make sure the next token is a NAME or EOS. */
-
-static ffelexHandler
-ffestb_end2_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_end3_;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_tokens[1] = NULL;
- return (ffelexHandler) ffestb_end3_ (t);
-
- default:
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero);
- }
-}
-
-/* ffestb_end3_ -- "END" <unit-kind> (NAME)
-
- return ffestb_end3_; // to lexer
-
- Make sure the next token is an EOS, then implement the statement. */
-
-static ffelexHandler
-ffestb_end3_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- default:
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
- if (ffesta_tokens[1] != NULL)
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero);
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- if (ffestb_args.endxyz.second == FFESTR_secondNone)
- {
- if (!ffesta_is_inhibited ())
- ffestc_end ();
- return (ffelexHandler) ffesta_zero (t);
- }
- break;
- }
-
- switch (ffestb_args.endxyz.second)
- {
-#if FFESTR_F90
- case FFESTR_secondTYPE:
- if (!ffesta_is_inhibited ())
- ffestc_R425 (ffesta_tokens[1]);
- break;
-#endif
-
-#if FFESTR_F90
- case FFESTR_secondWHERE:
- if (!ffesta_is_inhibited ())
- ffestc_R745 ();
- break;
-#endif
-
- case FFESTR_secondIF:
- if (!ffesta_is_inhibited ())
- ffestc_R806 (ffesta_tokens[1]);
- break;
-
- case FFESTR_secondSELECT:
- if (!ffesta_is_inhibited ())
- ffestc_R811 (ffesta_tokens[1]);
- break;
-
- case FFESTR_secondDO:
- if (!ffesta_is_inhibited ())
- ffestc_R825 (ffesta_tokens[1]);
- break;
-
- case FFESTR_secondPROGRAM:
- if (!ffesta_is_inhibited ())
- ffestc_R1103 (ffesta_tokens[1]);
- break;
-
-#if FFESTR_F90
- case FFESTR_secondMODULE:
- if (!ffesta_is_inhibited ())
- ffestc_R1106 (ffesta_tokens[1]);
- break;
-#endif
- case FFESTR_secondBLOCK:
- case FFESTR_secondBLOCKDATA:
- if (!ffesta_is_inhibited ())
- ffestc_R1112 (ffesta_tokens[1]);
- break;
-
-#if FFESTR_F90
- case FFESTR_secondINTERFACE:
- if (!ffesta_is_inhibited ())
- ffestc_R1203 ();
- break;
-#endif
-
- case FFESTR_secondFUNCTION:
- if (!ffesta_is_inhibited ())
- ffestc_R1221 (ffesta_tokens[1]);
- break;
-
- case FFESTR_secondSUBROUTINE:
- if (!ffesta_is_inhibited ())
- ffestc_R1225 (ffesta_tokens[1]);
- break;
-
-#if FFESTR_VXT
- case FFESTR_secondSTRUCTURE:
- if (!ffesta_is_inhibited ())
- ffestc_V004 ();
- break;
-#endif
-
-#if FFESTR_VXT
- case FFESTR_secondUNION:
- if (!ffesta_is_inhibited ())
- ffestc_V010 ();
- break;
-#endif
-
-#if FFESTR_VXT
- case FFESTR_secondMAP:
- if (!ffesta_is_inhibited ())
- ffestc_V013 ();
- break;
-#endif
-
- default:
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0]);
- if (ffesta_tokens[1] != NULL)
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero);
- }
-
- if (ffesta_tokens[1] != NULL)
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffesta_zero (t);
-}
-
-/* ffestb_goto -- Parse the GOTO statement
-
- return ffestb_goto; // to lexer
-
- Make sure the statement has a valid form for the GOTO statement. If it
- does, implement the statement. */
-
-ffelexHandler
-ffestb_goto (ffelexToken t)
-{
- ffeTokenLength i;
- 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_where -- Parse a WHERE statement
-
- return ffestb_where; // to lexer
-
- Make sure the statement has a valid form for a WHERE statement.
- If it does, implement the statement. */
-
-#if FFESTR_F90
-ffelexHandler
-ffestb_where (ffelexToken t)
-{
- switch (ffelex_token_type (ffesta_tokens[0]))
- {
- case FFELEX_typeNAME:
- if (ffesta_first_kw != FFESTR_firstWHERE)
- goto bad_0; /* :::::::::::::::::::: */
- break;
-
- case FFELEX_typeNAMES:
- if (ffesta_first_kw != FFESTR_firstWHERE)
- goto bad_0; /* :::::::::::::::::::: */
- if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlWHERE)
- goto bad_0; /* :::::::::::::::::::: */
- break;
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeOPEN_PAREN:
- break;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
- }
-
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextWHERE,
- (ffeexprCallback) ffestb_where1_);
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-}
-
-#endif
-/* ffestb_where1_ -- "WHERE" OPEN_PAREN expr
-
- (ffestb_where1_) // to expression handler
-
- Make sure the next token is CLOSE_PAREN. */
-
-#if FFESTR_F90
-static ffelexHandler
-ffestb_where1_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- ffestb_local_.if_stmt.expr = expr;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCLOSE_PAREN:
- if (expr == NULL)
- break;
- ffesta_tokens[1] = ffelex_token_use (ft);
- ffelex_set_names (TRUE);
- return (ffelexHandler) ffestb_where2_;
-
- default:
- break;
- }
-
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-#endif
-/* ffestb_where2_ -- "WHERE" OPEN_PAREN expr CLOSE_PAREN
-
- return ffestb_where2_; // to lexer
-
- Make sure the next token is NAME. */
-
-#if FFESTR_F90
-static ffelexHandler
-ffestb_where2_ (ffelexToken t)
-{
- ffelex_set_names (FALSE);
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- case FFELEX_typeNAMES:
- ffesta_confirmed ();
- ffesta_tokens[2] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_where3_;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_R742 (ffestb_local_.if_stmt.expr, ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", t);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-#endif
-/* ffestb_where3_ -- "WHERE" OPEN_PAREN expr CLOSE_PAREN NAME
-
- return ffestb_where3_; // to lexer
-
- Implement R742. */
-
-#if FFESTR_F90
-static ffelexHandler
-ffestb_where3_ (ffelexToken t)
-{
- ffelexHandler next;
- ffelexToken my_2 = ffesta_tokens[2];
-
- if (!ffesta_is_inhibited ())
- ffestc_R740 (ffestb_local_.if_stmt.expr, ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[1]);
- next = (ffelexHandler) ffesta_two (my_2, t);
- ffelex_token_kill (my_2);
- return (ffelexHandler) next;
-}
-
-#endif
-/* ffestb_let -- Parse an assignment statement
-
- return ffestb_let; // to lexer
-
- Make sure the statement has a valid form for an assignment statement. If
- it does, implement the statement. */
-
-ffelexHandler
-ffestb_let (ffelexToken t)
-{
- ffelexHandler next;
- bool vxtparam; /* TRUE if it might really be a VXT PARAMETER
- stmt. */
- 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))
- {
-#if FFESTR_F90
- case FFELEX_typePOINTS:
-#endif
- case FFELEX_typeEQUALS:
- if (expr == NULL)
- break;
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextLET, (ffeexprCallback) ffestb_let2_);
-
- default:
- break;
- }
-
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assignment", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_let2_ -- expr EQUALS/POINTS expr
-
- (ffestb_end2_) // to expression handler
-
- Make sure the next token is EOS or SEMICOLON; implement the statement. */
-
-static ffelexHandler
-ffestb_let2_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (expr == NULL)
- break;
- if (ffestb_local_.let.vxtparam && !ffestc_is_let_not_V027 ())
- break;
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
-#if FFESTR_F90
- if (ffelex_token_type (ffesta_tokens[1]) == FFELEX_typeEQUALS)
-#endif
- ffestc_let (ffestb_local_.let.dest, expr, ft);
-#if FFESTR_F90
- else
- ffestc_R738 (ffestb_local_.let.dest, expr, ft);
-#endif
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
- (ffelex_token_type (ffesta_tokens[1]) == FFELEX_typeEQUALS)
- ? "assignment" : "pointer-assignment",
- t);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_type -- Parse the TYPE statement
-
- return ffestb_type; // to lexer
-
- Make sure the statement has a valid form for the TYPE statement. If
- it does, implement the statement. */
-
-#if FFESTR_F90
-ffelexHandler
-ffestb_type (ffelexToken t)
-{
- ffeTokenLength i;
- const char *p;
-
- switch (ffelex_token_type (ffesta_tokens[0]))
- {
- case FFELEX_typeNAME:
- if (ffesta_first_kw != FFESTR_firstTYPE)
- goto bad_0; /* :::::::::::::::::::: */
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeCOMMA:
- ffesta_confirmed ();
- return (ffelexHandler) ffestb_type1_;
-
- case FFELEX_typeNAME: /* No confirm here, because ambig w/V020 VXT
- TYPE. */
- ffesta_tokens[1] = NULL;
- ffesta_tokens[2] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_type4_;
- }
-
- case FFELEX_typeNAMES:
- if (ffesta_first_kw != FFESTR_firstTYPE)
- goto bad_0; /* :::::::::::::::::::: */
- p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlTYPE);
- switch (ffelex_token_type (t))
- {
- default:
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeCOMMA:
- if (*p != '\0')
- goto bad_i; /* :::::::::::::::::::: */
- ffesta_confirmed ();
- ffelex_set_names (TRUE);
- return (ffelexHandler) ffestb_type1_;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- break;
- }
- if (!ffesrc_is_name_init (*p))
- goto bad_i; /* :::::::::::::::::::: */
- ffesta_tokens[1] = NULL;
- ffesta_tokens[2]
- = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
- return (ffelexHandler) ffestb_type4_ (t);
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-
-bad_i: /* :::::::::::::::::::: */
- ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "TYPE", ffesta_tokens[0], i, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_type1_ -- "TYPE" COMMA
-
- return ffestb_type1_; // to lexer
-
- Make sure the next token is a NAME. */
-
-static ffelexHandler
-ffestb_type1_ (ffelexToken t)
-{
- ffeTokenLength i;
- const char *p;
-
- ffelex_set_names (FALSE);
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[1] = ffelex_token_use (t);
- ffestb_local_.type.kw = ffestr_other (t);
- switch (ffestb_local_.varlist.kw)
- {
- case FFESTR_otherPUBLIC:
- case FFESTR_otherPRIVATE:
- return (ffelexHandler) ffestb_type2_;
-
- default:
- ffelex_token_kill (ffesta_tokens[1]);
- break;
- }
- break;
-
- case FFELEX_typeNAMES:
- ffesta_tokens[1] = ffelex_token_use (t);
- ffestb_local_.type.kw = ffestr_other (t);
- switch (ffestb_local_.varlist.kw)
- {
- case FFESTR_otherPUBLIC:
- p = ffelex_token_text (t) + (i = FFESTR_otherlPUBLIC);
- if (*p == '\0')
- return (ffelexHandler) ffestb_type2_;
- if (!ffesrc_is_name_init (*p))
- goto bad_i1; /* :::::::::::::::::::: */
- ffesta_tokens[2] = ffelex_token_name_from_names (t, i, 0);
- return (ffelexHandler) ffestb_type4_;
-
- case FFESTR_otherPRIVATE:
- p = ffelex_token_text (t) + (i = FFESTR_otherlPRIVATE);
- if (*p == '\0')
- return (ffelexHandler) ffestb_type2_;
- if (!ffesrc_is_name_init (*p))
- goto bad_i1; /* :::::::::::::::::::: */
- ffesta_tokens[2] = ffelex_token_name_from_names (t, i, 0);
- return (ffelexHandler) ffestb_type4_;
-
- default:
- ffelex_token_kill (ffesta_tokens[1]);
- break;
- }
- break;
-
- default:
- break;
- }
-
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_i1: /* :::::::::::::::::::: */
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "TYPE", t, i, NULL);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_type2_ -- "TYPE" COMMA NAME
-
- return ffestb_type2_; // to lexer
-
- Handle COLONCOLON or NAME. */
-
-static ffelexHandler
-ffestb_type2_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOLONCOLON:
- return (ffelexHandler) ffestb_type3_;
-
- case FFELEX_typeNAME:
- return (ffelexHandler) ffestb_type3_ (t);
-
- default:
- break;
- }
-
- if (ffesta_tokens[1] != NULL)
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_type3_ -- "TYPE" [COMMA NAME [COLONCOLON]]
-
- return ffestb_type3_; // to lexer
-
- Make sure the next token is a NAME. */
-
-static ffelexHandler
-ffestb_type3_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[2] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_type4_;
-
- default:
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
- break;
- }
-
- if (ffesta_tokens[1] != NULL)
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_type4_ -- "TYPE" [COMMA NAME [COLONCOLON]] NAME
-
- return ffestb_type4_; // to lexer
-
- Make sure the next token is an EOS or SEMICOLON. */
-
-static ffelexHandler
-ffestb_type4_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_R424 (ffesta_tokens[1], ffestb_local_.type.kw,
- ffesta_tokens[2]);
- if (ffesta_tokens[1] != NULL)
- ffelex_token_kill (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[2]);
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
- break;
- }
-
- if (ffesta_tokens[1] != NULL)
- ffelex_token_kill (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[2]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-#endif
-/* ffestb_varlist -- Parse EXTERNAL/INTENT/INTRINSIC/OPTIONAL/PUBLIC/PRIVATE
- statement
-
- return ffestb_varlist; // to lexer
-
- Make sure the statement has a valid form. If it
- does, implement the statement. */
-
-ffelexHandler
-ffestb_varlist (ffelexToken t)
-{
- ffeTokenLength i;
- 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 ();
- switch (ffesta_first_kw)
- {
-#if FFESTR_F90
- case FFESTR_firstPUBLIC:
- if (!ffesta_is_inhibited ())
- ffestc_R521A ();
- return (ffelexHandler) ffesta_zero (t);
-
- case FFESTR_firstPRIVATE:
- if (!ffesta_is_inhibited ())
- ffestc_private (); /* Either R523A or R521B. */
- return (ffelexHandler) ffesta_zero (t);
-#endif
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
- }
-
- case FFELEX_typeCOMMA:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed ();
- switch (ffesta_first_kw)
- {
-#if FFESTR_F90
- case FFESTR_firstOPTIONAL:
- if (!ffesta_is_inhibited ())
- ffestc_R520_start ();
- break;
-
- case FFESTR_firstPUBLIC:
- if (!ffesta_is_inhibited ())
- ffestc_R521Astart ();
- break;
-
- case FFESTR_firstPRIVATE:
- if (!ffesta_is_inhibited ())
- ffestc_R521Bstart ();
- break;
-#endif
-
- default:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
- }
- return (ffelexHandler) ffestb_varlist5_;
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeOPEN_PAREN:
- switch (ffesta_first_kw)
- {
-#if FFESTR_F90
- case FFESTR_firstINTENT:
- return (ffelexHandler) ffestb_varlist1_;
-#endif
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
- }
-
- case FFELEX_typeNAME:
- ffesta_confirmed ();
- switch (ffesta_first_kw)
- {
- case FFESTR_firstEXTERNAL:
- if (!ffesta_is_inhibited ())
- ffestc_R1207_start ();
- break;
-
-#if FFESTR_F90
- case FFESTR_firstINTENT:
- goto bad_1; /* :::::::::::::::::::: */
-#endif
-
- case FFESTR_firstINTRINSIC:
- if (!ffesta_is_inhibited ())
- ffestc_R1208_start ();
- break;
-
-#if FFESTR_F90
- case FFESTR_firstOPTIONAL:
- if (!ffesta_is_inhibited ())
- ffestc_R520_start ();
- break;
-#endif
-
-#if FFESTR_F90
- case FFESTR_firstPUBLIC:
- if (!ffesta_is_inhibited ())
- ffestc_R521Astart ();
- break;
-
- case FFESTR_firstPRIVATE:
- if (!ffesta_is_inhibited ())
- ffestc_R521Bstart ();
- break;
-#endif
-
- default:
- break;
- }
- return (ffelexHandler) ffestb_varlist5_ (t);
- }
-
- case FFELEX_typeNAMES:
- p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.varlist.len);
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- switch (ffesta_first_kw)
- {
-#if FFESTR_F90
- case FFESTR_firstINTENT:
- goto bad_1; /* :::::::::::::::::::: */
-#endif
-
- default:
- break;
- }
- if (*p != '\0')
- break;
- switch (ffesta_first_kw)
- {
-#if FFESTR_F90
- case FFESTR_firstPUBLIC:
- if (!ffesta_is_inhibited ())
- ffestc_R521A ();
- return (ffelexHandler) ffesta_zero (t);
-
- case FFESTR_firstPRIVATE:
- if (!ffesta_is_inhibited ())
- ffestc_private (); /* Either R423A or R521B. */
- return (ffelexHandler) ffesta_zero (t);
-#endif
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
- }
-
- case FFELEX_typeCOMMA:
- ffesta_confirmed (); /* Error, but clearly intended. */
- switch (ffesta_first_kw)
- {
-#if FFESTR_F90
- case FFESTR_firstINTENT:
- goto bad_1; /* :::::::::::::::::::: */
-#endif
-
- default:
- break;
- }
- if (*p != '\0')
- break;
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed ();
- switch (ffesta_first_kw)
- {
-#if FFESTR_F90
- case FFESTR_firstOPTIONAL:
- if (!ffesta_is_inhibited ())
- ffestc_R520_start ();
- break;
-#endif
-
-#if FFESTR_F90
- case FFESTR_firstPUBLIC:
- if (!ffesta_is_inhibited ())
- ffestc_R521Astart ();
- break;
-
- case FFESTR_firstPRIVATE:
- if (!ffesta_is_inhibited ())
- ffestc_R521Bstart ();
- break;
-#endif
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
- }
- return (ffelexHandler) ffestb_varlist5_;
-
- case FFELEX_typeOPEN_PAREN:
- switch (ffesta_first_kw)
- {
-#if FFESTR_F90
- case FFESTR_firstINTENT:
- if (*p != '\0')
- goto bad_1; /* :::::::::::::::::::: */
- return (ffelexHandler) ffestb_varlist1_;
-#endif
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
- }
-
- case FFELEX_typeNAME:
- ffesta_confirmed ();
- switch (ffesta_first_kw)
- {
- case FFESTR_firstEXTERNAL:
- if (!ffesta_is_inhibited ())
- ffestc_R1207_start ();
- break;
-
-#if FFESTR_F90
- case FFESTR_firstINTENT:
- goto bad_1; /* :::::::::::::::::::: */
-#endif
-
- case FFESTR_firstINTRINSIC:
- if (!ffesta_is_inhibited ())
- ffestc_R1208_start ();
- break;
-
-#if FFESTR_F90
- case FFESTR_firstOPTIONAL:
- if (!ffesta_is_inhibited ())
- ffestc_R520_start ();
- break;
-#endif
-
-#if FFESTR_F90
- case FFESTR_firstPUBLIC:
- if (!ffesta_is_inhibited ())
- ffestc_R521Astart ();
- break;
-
- case FFESTR_firstPRIVATE:
- if (!ffesta_is_inhibited ())
- ffestc_R521Bstart ();
- break;
-#endif
-
- default:
- break;
- }
- return (ffelexHandler) ffestb_varlist5_ (t);
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
- }
-
- /* Here, we have at least one char after the first keyword and t is
- COMMA or EOS/SEMICOLON. Also we know that this form is valid for
- only the statements reaching here (specifically, INTENT won't reach
- here). */
-
- if (!ffesrc_is_name_init (*p))
- goto bad_i; /* :::::::::::::::::::: */
- nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
- if (!ffesta_is_inhibited ())
- {
- switch (ffesta_first_kw)
- {
- case FFESTR_firstEXTERNAL:
- ffestc_R1207_start ();
- break;
-
- case FFESTR_firstINTRINSIC:
- ffestc_R1208_start ();
- break;
-
-#if FFESTR_F90
- case FFESTR_firstOPTIONAL:
- ffestc_R520_start ();
- break;
-#endif
-
-#if FFESTR_F90
- case FFESTR_firstPUBLIC:
- ffestc_R521Astart ();
- break;
-
- case FFESTR_firstPRIVATE:
- ffestc_R521Bstart ();
- break;
-#endif
-
- default:
- assert (FALSE);
- }
- }
- next = (ffelexHandler) ffestb_varlist5_ (nt);
- ffelex_token_kill (nt);
- return (ffelexHandler) (*next) (t);
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-
-bad_i: /* :::::::::::::::::::: */
- ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, ffesta_tokens[0], i, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_varlist1_ -- "INTENT" OPEN_PAREN
-
- return ffestb_varlist1_; // to lexer
-
- Handle NAME. */
-
-#if FFESTR_F90
-static ffelexHandler
-ffestb_varlist1_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[1] = ffelex_token_use (t);
- ffestb_local_.varlist.kw = ffestr_other (t);
- switch (ffestb_local_.varlist.kw)
- {
- case FFESTR_otherIN:
- return (ffelexHandler) ffestb_varlist2_;
-
- case FFESTR_otherINOUT:
- return (ffelexHandler) ffestb_varlist3_;
-
- case FFESTR_otherOUT:
- return (ffelexHandler) ffestb_varlist3_;
-
- default:
- ffelex_token_kill (ffesta_tokens[1]);
- break;
- }
- break;
-
- default:
- break;
- }
-
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_varlist2_ -- "INTENT" OPEN_PAREN "IN"
-
- return ffestb_varlist2_; // to lexer
-
- Handle NAME. */
-
-static ffelexHandler
-ffestb_varlist2_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- switch (ffestr_other (t))
- {
- case FFESTR_otherOUT:
- ffestb_local_.varlist.kw = FFESTR_otherINOUT;
- return (ffelexHandler) ffestb_varlist3_;
-
- default:
- break;
- }
- break;
-
- case FFELEX_typeCLOSE_PAREN:
- return (ffelexHandler) ffestb_varlist4_;
-
- default:
- break;
- }
-
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_varlist3_ -- "INTENT" OPEN_PAREN NAME ["OUT"]
-
- return ffestb_varlist3_; // to lexer
-
- Handle CLOSE_PAREN. */
-
-static ffelexHandler
-ffestb_varlist3_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCLOSE_PAREN:
- return (ffelexHandler) ffestb_varlist4_;
-
- default:
- break;
- }
-
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_varlist4_ -- "INTENT" OPEN_PAREN NAME ["OUT"] CLOSE_PAREN
-
- return ffestb_varlist4_; // to lexer
-
- Handle COLONCOLON or NAME. */
-
-static ffelexHandler
-ffestb_varlist4_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_R519_start (ffesta_tokens[1], ffestb_local_.varlist.kw);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffestb_varlist5_;
-
- case FFELEX_typeNAME:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_R519_start (ffesta_tokens[1], ffestb_local_.varlist.kw);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffestb_varlist5_ (t);
-
- default:
- break;
- }
-
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-#endif
-/* ffestb_varlist5_ -- Handles the list of variable names
-
- return ffestb_varlist5_; // to lexer
-
- Handle NAME. */
-
-static ffelexHandler
-ffestb_varlist5_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_varlist6_;
-
- default:
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
- break;
- }
-
- if (!ffesta_is_inhibited ())
- {
- switch (ffesta_first_kw)
- {
- case FFESTR_firstEXTERNAL:
- ffestc_R1207_finish ();
- break;
-
-#if FFESTR_F90
- case FFESTR_firstINTENT:
- ffestc_R519_finish ();
- break;
-#endif
-
- case FFESTR_firstINTRINSIC:
- ffestc_R1208_finish ();
- break;
-
-#if FFESTR_F90
- case FFESTR_firstOPTIONAL:
- ffestc_R520_finish ();
- break;
-#endif
-
-#if FFESTR_F90
- case FFESTR_firstPUBLIC:
- ffestc_R521Afinish ();
- break;
-
- case FFESTR_firstPRIVATE:
- ffestc_R521Bfinish ();
- break;
-#endif
-
- default:
- assert (FALSE);
- }
- }
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_varlist6_ -- (whatever) NAME
-
- return ffestb_varlist6_; // to lexer
-
- Handle COMMA or EOS/SEMICOLON. */
-
-static ffelexHandler
-ffestb_varlist6_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- if (!ffesta_is_inhibited ())
- {
- switch (ffesta_first_kw)
- {
- case FFESTR_firstEXTERNAL:
- ffestc_R1207_item (ffesta_tokens[1]);
- break;
-
-#if FFESTR_F90
- case FFESTR_firstINTENT:
- ffestc_R519_item (ffesta_tokens[1]);
- break;
-#endif
-
- case FFESTR_firstINTRINSIC:
- ffestc_R1208_item (ffesta_tokens[1]);
- break;
-
-#if FFESTR_F90
- case FFESTR_firstOPTIONAL:
- ffestc_R520_item (ffesta_tokens[1]);
- break;
-#endif
-
-#if FFESTR_F90
- case FFESTR_firstPUBLIC:
- ffestc_R521Aitem (ffesta_tokens[1]);
- break;
-
- case FFESTR_firstPRIVATE:
- ffestc_R521Bitem (ffesta_tokens[1]);
- break;
-#endif
-
- default:
- assert (FALSE);
- }
- }
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffestb_varlist5_;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (!ffesta_is_inhibited ())
- {
- switch (ffesta_first_kw)
- {
- case FFESTR_firstEXTERNAL:
- ffestc_R1207_item (ffesta_tokens[1]);
- ffestc_R1207_finish ();
- break;
-
-#if FFESTR_F90
- case FFESTR_firstINTENT:
- ffestc_R519_item (ffesta_tokens[1]);
- ffestc_R519_finish ();
- break;
-#endif
-
- case FFESTR_firstINTRINSIC:
- ffestc_R1208_item (ffesta_tokens[1]);
- ffestc_R1208_finish ();
- break;
-
-#if FFESTR_F90
- case FFESTR_firstOPTIONAL:
- ffestc_R520_item (ffesta_tokens[1]);
- ffestc_R520_finish ();
- break;
-#endif
-
-#if FFESTR_F90
- case FFESTR_firstPUBLIC:
- ffestc_R521Aitem (ffesta_tokens[1]);
- ffestc_R521Afinish ();
- break;
-
- case FFESTR_firstPRIVATE:
- ffestc_R521Bitem (ffesta_tokens[1]);
- ffestc_R521Bfinish ();
- break;
-#endif
-
- default:
- assert (FALSE);
- }
- }
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
- break;
- }
-
- if (!ffesta_is_inhibited ())
- {
- switch (ffesta_first_kw)
- {
- case FFESTR_firstEXTERNAL:
- ffestc_R1207_finish ();
- break;
-
-#if FFESTR_F90
- case FFESTR_firstINTENT:
- ffestc_R519_finish ();
- break;
-#endif
-
- case FFESTR_firstINTRINSIC:
- ffestc_R1208_finish ();
- break;
-
-#if FFESTR_F90
- case FFESTR_firstOPTIONAL:
- ffestc_R520_finish ();
- break;
-#endif
-
-#if FFESTR_F90
- case FFESTR_firstPUBLIC:
- ffestc_R521Afinish ();
- break;
-
- case FFESTR_firstPRIVATE:
- ffestc_R521Bfinish ();
- break;
-#endif
-
- default:
- assert (FALSE);
- }
- }
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R423B -- Parse the SEQUENCE statement
-
- return ffestb_R423B; // to lexer
-
- Make sure the statement has a valid form for the SEQUENCE statement. If
- it does, implement the statement. */
-
-#if FFESTR_F90
-ffelexHandler
-ffestb_R423B (ffelexToken t)
-{
- const char *p;
- ffeTokenLength i;
-
- switch (ffelex_token_type (ffesta_tokens[0]))
- {
- case FFELEX_typeNAME:
- if (ffesta_first_kw != FFESTR_firstSEQUENCE)
- goto bad_0; /* :::::::::::::::::::: */
- break;
-
- case FFELEX_typeNAMES:
- if (ffesta_first_kw != FFESTR_firstSEQUENCE)
- goto bad_0; /* :::::::::::::::::::: */
- if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlSEQUENCE)
- {
- p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSEQUENCE);
- goto bad_i; /* :::::::::::::::::::: */
- }
- break;
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_R423B ();
- return (ffelexHandler) ffesta_zero (t);
-
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
- }
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SEQUENCE", ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid first token. */
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SEQUENCE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-
-bad_i: /* :::::::::::::::::::: */
- ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "SEQUENCE", ffesta_tokens[0], i, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-#endif
-/* ffestb_R522 -- Parse the SAVE statement
-
- return ffestb_R522; // to lexer
-
- Make sure the statement has a valid form for the SAVE statement. If it
- does, implement the statement. */
-
-ffelexHandler
-ffestb_R522 (ffelexToken t)
-{
- ffeTokenLength i;
- 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_R1228 -- Parse the CONTAINS statement
-
- return ffestb_R1228; // to lexer
-
- Make sure the statement has a valid form for the CONTAINS statement. If
- it does, implement the statement. */
-
-#if FFESTR_F90
-ffelexHandler
-ffestb_R1228 (ffelexToken t)
-{
- const char *p;
- ffeTokenLength i;
-
- switch (ffelex_token_type (ffesta_tokens[0]))
- {
- case FFELEX_typeNAME:
- if (ffesta_first_kw != FFESTR_firstCONTAINS)
- goto bad_0; /* :::::::::::::::::::: */
- break;
-
- case FFELEX_typeNAMES:
- if (ffesta_first_kw != FFESTR_firstCONTAINS)
- goto bad_0; /* :::::::::::::::::::: */
- if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlCONTAINS)
- {
- p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCONTAINS);
- goto bad_i; /* :::::::::::::::::::: */
- }
- break;
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_R1228 ();
- return (ffelexHandler) ffesta_zero (t);
-
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
- }
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CONTAINS", ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid first token. */
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CONTAINS", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-
-bad_i: /* :::::::::::::::::::: */
- ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CONTAINS", ffesta_tokens[0], i, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-#endif
-/* ffestb_V009 -- Parse the UNION statement
-
- return ffestb_V009; // to lexer
-
- Make sure the statement has a valid form for the UNION statement. If
- it does, implement the statement. */
-
-#if FFESTR_VXT
-ffelexHandler
-ffestb_V009 (ffelexToken t)
-{
- const char *p;
- ffeTokenLength i;
-
- switch (ffelex_token_type (ffesta_tokens[0]))
- {
- case FFELEX_typeNAME:
- if (ffesta_first_kw != FFESTR_firstUNION)
- goto bad_0; /* :::::::::::::::::::: */
- break;
-
- case FFELEX_typeNAMES:
- if (ffesta_first_kw != FFESTR_firstUNION)
- goto bad_0; /* :::::::::::::::::::: */
- if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlUNION)
- {
- p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlUNION);
- goto bad_i; /* :::::::::::::::::::: */
- }
- break;
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_V009 ();
- return (ffelexHandler) ffesta_zero (t);
-
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
- }
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "UNION", ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid first token. */
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "UNION", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-
-bad_i: /* :::::::::::::::::::: */
- ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "UNION", ffesta_tokens[0], i, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-#endif
-/* ffestb_construct -- Parse a construct name
-
- return ffestb_construct; // to lexer
-
- Make sure the statement can have a construct name (if-then-stmt, do-stmt,
- select-case-stmt). */
-
-ffelexHandler
-ffestb_construct (ffelexToken t UNUSED)
-{
- /* This handler gets invoked only when token 0 is NAME/NAMES and token 1 is
- COLON. */
-
- ffesta_confirmed ();
- ffelex_set_names (TRUE);
- return (ffelexHandler) ffestb_construct1_;
-}
-
-/* ffestb_construct1_ -- NAME COLON
-
- return ffestb_construct1_; // to lexer
-
- Make sure we've got a NAME that is DO, DOWHILE, IF, SELECT, or SELECTCASE. */
-
-static ffelexHandler
-ffestb_construct1_ (ffelexToken t)
-{
- ffelex_set_names (FALSE);
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_first_kw = ffestr_first (t);
- switch (ffesta_first_kw)
- {
- case FFESTR_firstIF:
- ffestb_local_.construct.next = (ffelexHandler) ffestb_if;
- break;
-
- case FFESTR_firstDO:
- ffestb_local_.construct.next = (ffelexHandler) ffestb_do;
- break;
-
- case FFESTR_firstDOWHILE:
- ffestb_local_.construct.next = (ffelexHandler) ffestb_dowhile;
- break;
-
- case FFESTR_firstSELECT:
- case FFESTR_firstSELECTCASE:
- ffestb_local_.construct.next = (ffelexHandler) ffestb_R809;
- break;
-
- default:
- goto bad; /* :::::::::::::::::::: */
- }
- ffesta_construct_name = ffesta_tokens[0];
- ffesta_tokens[0] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_construct2_;
-
- case FFELEX_typeNAMES:
- ffesta_first_kw = ffestr_first (t);
- switch (ffesta_first_kw)
- {
- case FFESTR_firstIF:
- if (ffelex_token_length (t) != FFESTR_firstlIF)
- goto bad; /* :::::::::::::::::::: */
- ffestb_local_.construct.next = (ffelexHandler) ffestb_if;
- break;
-
- case FFESTR_firstDO:
- ffestb_local_.construct.next = (ffelexHandler) ffestb_do;
- break;
-
- case FFESTR_firstDOWHILE:
- if (ffelex_token_length (t) != FFESTR_firstlDOWHILE)
- goto bad; /* :::::::::::::::::::: */
- ffestb_local_.construct.next = (ffelexHandler) ffestb_dowhile;
- break;
-
- case FFESTR_firstSELECTCASE:
- if (ffelex_token_length (t) != FFESTR_firstlSELECTCASE)
- goto bad; /* :::::::::::::::::::: */
- ffestb_local_.construct.next = (ffelexHandler) ffestb_R809;
- break;
-
- default:
- goto bad; /* :::::::::::::::::::: */
- }
- ffesta_construct_name = ffesta_tokens[0];
- ffesta_tokens[0] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_construct2_;
-
- default:
- break;
- }
-
-bad: /* :::::::::::::::::::: */
- ffesta_ffebad_2st (FFEBAD_INVALID_STMT_FORM, "CONSTRUCT",
- ffesta_tokens[0], t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_construct2_ -- NAME COLON "DO/DOWHILE/IF/SELECT/SELECTCASE"
-
- return ffestb_construct2_; // to lexer
-
- This extra step is needed to set ffesta_second_kw if the second token
- (here) is a NAME, so DO and SELECT can continue to expect it. */
-
-static ffelexHandler
-ffestb_construct2_ (ffelexToken t)
-{
- if (ffelex_token_type (t) == FFELEX_typeNAME)
- ffesta_second_kw = ffestr_second (t);
- return (ffelexHandler) (*ffestb_local_.construct.next) (t);
-}
-
-/* ffestb_heap -- Parse an ALLOCATE/DEALLOCATE statement
-
- return ffestb_heap; // to lexer
-
- Make sure the statement has a valid form for an ALLOCATE/DEALLOCATE
- statement. If it does, implement the statement. */
-
-#if FFESTR_F90
-ffelexHandler
-ffestb_heap (ffelexToken t)
-{
- switch (ffelex_token_type (ffesta_tokens[0]))
- {
- case FFELEX_typeNAME:
- break;
-
- case FFELEX_typeNAMES:
- if (ffelex_token_length (ffesta_tokens[0]) != ffestb_args.heap.len)
- goto bad_0; /* :::::::::::::::::::: */
- break;
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeOPEN_PAREN:
- break;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
- }
-
- ffestb_local_.heap.exprs = ffestt_exprlist_create ();
- return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
- ffestb_args.heap.ctx,
- (ffeexprCallback) ffestb_heap1_);
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-}
-
-/* ffestb_heap1_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN expr
-
- (ffestb_heap1_) // to expression handler
-
- Make sure the next token is COMMA. */
-
-static ffelexHandler
-ffestb_heap1_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- if (expr == NULL)
- break;
- ffestt_exprlist_append (ffestb_local_.heap.exprs, expr,
- ffelex_token_use (t));
- return (ffelexHandler) ffestb_heap2_;
-
- case FFELEX_typeCLOSE_PAREN:
- if (expr == NULL)
- break;
- ffestt_exprlist_append (ffestb_local_.heap.exprs, expr,
- ffelex_token_use (t));
- ffesta_tokens[1] = NULL;
- ffestb_local_.heap.expr = NULL;
- return (ffelexHandler) ffestb_heap5_;
-
- default:
- break;
- }
-
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
- ffestt_exprlist_kill (ffestb_local_.heap.exprs);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_heap2_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN expr COMMA
-
- return ffestb_heap2_; // to lexer
-
- Make sure the next token is NAME. */
-
-static ffelexHandler
-ffestb_heap2_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_heap3_;
-
- default:
- break;
- }
-
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
- ffestt_exprlist_kill (ffestb_local_.heap.exprs);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_heap3_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN expr COMMA NAME
-
- return ffestb_heap3_; // to lexer
-
- If token is EQUALS, make sure NAME was "STAT" and handle STAT variable;
- else pass NAME and token to expression handler. */
-
-static ffelexHandler
-ffestb_heap3_ (ffelexToken t)
-{
- ffelexHandler next;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEQUALS:
- ffesta_confirmed ();
- if (ffestr_other (ffesta_tokens[1]) != FFESTR_otherSTAT)
- break;
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
- FFEEXPR_contextHEAPSTAT,
- (ffeexprCallback) ffestb_heap4_);
-
- default:
- next = (ffelexHandler)
- (*((ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
- ffestb_args.heap.ctx,
- (ffeexprCallback) ffestb_heap1_)))
- (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) (*next) (t);
- }
-
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
- ffestt_exprlist_kill (ffestb_local_.heap.exprs);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_heap4_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN ... COMMA "STAT" EQUALS
- expr
-
- (ffestb_heap4_) // to expression handler
-
- Make sure the next token is CLOSE_PAREN. */
-
-static ffelexHandler
-ffestb_heap4_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCLOSE_PAREN:
- if (expr == NULL)
- break;
- ffesta_tokens[1] = ffelex_token_use (ft);
- ffestb_local_.heap.expr = expr;
- return (ffelexHandler) ffestb_heap5_;
-
- default:
- break;
- }
-
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
- ffestt_exprlist_kill (ffestb_local_.heap.exprs);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_heap5_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN ... CLOSE_PAREN
-
- return ffestb_heap5_; // to lexer
-
- Make sure the next token is EOS/SEMICOLON. */
-
-static ffelexHandler
-ffestb_heap5_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- if (ffesta_first_kw == FFESTR_firstALLOCATE)
- ffestc_R620 (ffestb_local_.heap.exprs, ffestb_local_.heap.expr,
- ffesta_tokens[1]);
- else
- ffestc_R625 (ffestb_local_.heap.exprs, ffestb_local_.heap.expr,
- ffesta_tokens[1]);
- ffestt_exprlist_kill (ffestb_local_.heap.exprs);
- if (ffesta_tokens[1] != NULL)
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
- ffestt_exprlist_kill (ffestb_local_.heap.exprs);
- if (ffesta_tokens[1] != NULL)
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-#endif
-/* ffestb_module -- Parse the MODULEPROCEDURE statement
-
- return ffestb_module; // to lexer
-
- Make sure the statement has a valid form for the MODULEPROCEDURE statement.
- If it does, implement the statement.
-
- 31-May-90 JCB 1.1
- Confirm NAME==MODULE followed by standard four invalid tokens, so we
- get decent message if somebody forgets that MODULE requires a name. */
-
-#if FFESTR_F90
-ffelexHandler
-ffestb_module (ffelexToken t)
-{
- ffeTokenLength i;
- const char *p;
- ffelexToken nt;
- ffelexToken mt; /* Name in MODULE PROCEDUREname, i.e.
- includes "PROCEDURE". */
-
- switch (ffelex_token_type (ffesta_tokens[0]))
- {
- case FFELEX_typeNAME:
- if (ffesta_first_kw != FFESTR_firstMODULE)
- goto bad_0; /* :::::::::::::::::::: */
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- break;
-
- case FFELEX_typeCOLONCOLON:
- case FFELEX_typeCOMMA:
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- goto bad_1m; /* :::::::::::::::::::: */
-
- default:
- goto bad_1m; /* :::::::::::::::::::: */
- }
-
- ffesta_confirmed ();
- if (ffesta_second_kw != FFESTR_secondPROCEDURE)
- {
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_module3_;
- }
- ffestb_local_.moduleprocedure.started = FALSE;
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_module1_;
-
- case FFELEX_typeNAMES:
- p = ffelex_token_text (ffesta_tokens[0])
- + (i = FFESTR_firstlMODULEPROCEDURE);
- if ((ffesta_first_kw == FFESTR_firstMODULE)
- || ((ffesta_first_kw == FFESTR_firstMODULEPROCEDURE)
- && !ffesrc_is_name_init (*p)))
- { /* Definitely not "MODULE PROCEDURE name". */
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1m; /* :::::::::::::::::::: */
-
- default:
- goto bad_1m; /* :::::::::::::::::::: */
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- break;
- }
- p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlMODULE);
- if (!ffesrc_is_name_init (*p))
- goto bad_im; /* :::::::::::::::::::: */
- nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
- if (!ffesta_is_inhibited ())
- ffestc_R1105 (nt);
- ffelex_token_kill (nt);
- return (ffelexHandler) ffesta_zero (t);
- }
-
- /* Here we know that we're indeed looking at a MODULEPROCEDURE
- statement rather than MODULE and that the character following
- MODULEPROCEDURE in the NAMES token is a valid first character for a
- NAME. This means that unless the second token is COMMA, we have an
- ambiguous statement that can be read either as MODULE PROCEDURE name
- or MODULE PROCEDUREname, the former being an R1205, the latter an
- R1105. */
-
- if (ffesta_first_kw != FFESTR_firstMODULEPROCEDURE)
- goto bad_0; /* :::::::::::::::::::: */
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeCOMMA: /* Aha, clearly not MODULE PROCEDUREname. */
- ffesta_confirmed ();
- ffestb_local_.moduleprocedure.started = FALSE;
- ffesta_tokens[1]
- = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
- return (ffelexHandler) ffestb_module2_ (t);
-
- case FFELEX_typeEOS: /* MODULE PROCEDURE name or MODULE
- PROCEDUREname. */
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- break;
- }
- nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
- mt = ffelex_token_name_from_names (ffesta_tokens[0], FFESTR_firstlMODULE,
- 0);
- if (!ffesta_is_inhibited ())
- ffestc_module (mt, nt); /* Implement ambiguous statement. */
- ffelex_token_kill (nt);
- ffelex_token_kill (mt);
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-
-bad_1m: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-
-bad_im: /* :::::::::::::::::::: */
- ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "MODULE", ffesta_tokens[0], i, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_module1_ -- "MODULEPROCEDURE" or "MODULE" "PROCEDURE"
-
- return ffestb_module1_; // to lexer
-
- Make sure the statement has a valid form for the MODULEPROCEDURE statement. If it
- does, implement the statement. */
-
-static ffelexHandler
-ffestb_module1_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- if (!ffestb_local_.moduleprocedure.started
- && (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME))
- {
- ffesta_confirmed ();
- ffelex_token_kill (ffesta_tokens[1]);
- }
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_module2_;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (ffestb_local_.moduleprocedure.started)
- break; /* Error if we've already seen NAME COMMA. */
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_R1105 (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffesta_zero (t);
-
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- break;
-
- default:
- break;
- }
-
- if (ffestb_local_.moduleprocedure.started && !ffesta_is_inhibited ())
- ffestc_R1205_finish ();
- else if (!ffestb_local_.moduleprocedure.started)
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_module2_ -- "MODULE/PROCEDURE" NAME
-
- return ffestb_module2_; // to lexer
-
- Make sure the statement has a valid form for the MODULEPROCEDURE statement. If it
- does, implement the statement. */
-
-static ffelexHandler
-ffestb_module2_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (!ffestb_local_.moduleprocedure.started)
- {
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_R1205_start ();
- }
- if (!ffesta_is_inhibited ())
- {
- ffestc_R1205_item (ffesta_tokens[1]);
- ffestc_R1205_finish ();
- }
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffesta_zero (t);
-
- case FFELEX_typeCOMMA:
- if (!ffestb_local_.moduleprocedure.started)
- {
- ffestb_local_.moduleprocedure.started = TRUE;
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_R1205_start ();
- }
- if (!ffesta_is_inhibited ())
- ffestc_R1205_item (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffestb_module1_;
-
- default:
- break;
- }
-
- if (ffestb_local_.moduleprocedure.started && !ffesta_is_inhibited ())
- ffestc_R1205_finish ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", t);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_module3_ -- "MODULE" NAME
-
- return ffestb_module3_; // to lexer
-
- Make sure the statement has a valid form for the MODULE statement. If it
- does, implement the statement. */
-
-static ffelexHandler
-ffestb_module3_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (!ffesta_is_inhibited ())
- ffestc_R1105 (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE", t);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-#endif
-/* ffestb_R809 -- Parse the SELECTCASE statement
-
- return ffestb_R809; // to lexer
-
- Make sure the statement has a valid form for the SELECTCASE statement.
- If it does, implement the statement. */
-
-ffelexHandler
-ffestb_R809 (ffelexToken t)
-{
- ffeTokenLength i;
- 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 "<expr>H". */
- if (ffestb_local_.format.pre.present)
- ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
- ffestb_local_.format.current = FFESTP_formattypeH;
- i = FFESTR_formatlH;
- break;
-
- case FFESTR_formatPD:
- if (ffestb_local_.format.pre.present)
- ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
- ffestb_subr_R1001_append_p_ ();
- ffestb_local_.format.t = ffelex_token_name_from_names (t,
- FFESTR_formatlP, 1);
- ffestb_local_.format.sign = FALSE;
- ffestb_local_.format.pre.present = FALSE;
- ffestb_local_.format.pre.rtexpr = FALSE;
- ffestb_local_.format.pre.t = NULL;
- ffestb_local_.format.pre.u.unsigned_val = 1;
- ffestb_local_.format.current = FFESTP_formattypeD;
- i = FFESTR_formatlPD;
- break;
-
- case FFESTR_formatPE:
- if (ffestb_local_.format.pre.present)
- ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
- ffestb_subr_R1001_append_p_ ();
- ffestb_local_.format.t = ffelex_token_name_from_names (t,
- FFESTR_formatlP, 1);
- ffestb_local_.format.sign = FALSE;
- ffestb_local_.format.pre.present = FALSE;
- ffestb_local_.format.pre.rtexpr = FALSE;
- ffestb_local_.format.pre.t = NULL;
- ffestb_local_.format.pre.u.unsigned_val = 1;
- ffestb_local_.format.current = FFESTP_formattypeE;
- i = FFESTR_formatlPE;
- break;
-
- case FFESTR_formatPEN:
- if (ffestb_local_.format.pre.present)
- ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
- ffestb_subr_R1001_append_p_ ();
- ffestb_local_.format.t = ffelex_token_name_from_names (t,
- FFESTR_formatlP, 1);
- ffestb_local_.format.sign = FALSE;
- ffestb_local_.format.pre.present = FALSE;
- ffestb_local_.format.pre.rtexpr = FALSE;
- ffestb_local_.format.pre.t = NULL;
- ffestb_local_.format.pre.u.unsigned_val = 1;
- ffestb_local_.format.current = FFESTP_formattypeEN;
- i = FFESTR_formatlPEN;
- break;
-
- case FFESTR_formatPF:
- if (ffestb_local_.format.pre.present)
- ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
- ffestb_subr_R1001_append_p_ ();
- ffestb_local_.format.t = ffelex_token_name_from_names (t,
- FFESTR_formatlP, 1);
- ffestb_local_.format.sign = FALSE;
- ffestb_local_.format.pre.present = FALSE;
- ffestb_local_.format.pre.rtexpr = FALSE;
- ffestb_local_.format.pre.t = NULL;
- ffestb_local_.format.pre.u.unsigned_val = 1;
- ffestb_local_.format.current = FFESTP_formattypeF;
- i = FFESTR_formatlPF;
- break;
-
- case FFESTR_formatPG:
- if (ffestb_local_.format.pre.present)
- ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
- ffestb_subr_R1001_append_p_ ();
- ffestb_local_.format.t = ffelex_token_name_from_names (t,
- FFESTR_formatlP, 1);
- ffestb_local_.format.sign = FALSE;
- ffestb_local_.format.pre.present = FALSE;
- ffestb_local_.format.pre.rtexpr = FALSE;
- ffestb_local_.format.pre.t = NULL;
- ffestb_local_.format.pre.u.unsigned_val = 1;
- ffestb_local_.format.current = FFESTP_formattypeG;
- i = FFESTR_formatlPG;
- break;
-
- default:
- if (ffestb_local_.format.pre.present)
- ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
- ffestb_local_.format.current = FFESTP_formattypeNone;
- p = strpbrk (ffelex_token_text (t), "0123456789");
- if (p == NULL)
- i = ffelex_token_length (t);
- else
- i = p - ffelex_token_text (t);
- break;
- }
- p = ffelex_token_text (t) + i;
- if (*p == '\0')
- return (ffelexHandler) ffestb_R10015_;
- if (! ISDIGIT (*p))
- {
- if (ffestb_local_.format.current == FFESTP_formattypeH)
- p = strpbrk (p, "0123456789");
- else
- {
- p = NULL;
- ffestb_local_.format.current = FFESTP_formattypeNone;
- }
- if (p == NULL)
- return (ffelexHandler) ffestb_R10015_;
- i = p - ffelex_token_text (t); /* Collect digits. */
- }
- ffestb_local_.format.post.present = TRUE;
- ffestb_local_.format.post.rtexpr = FALSE;
- ffestb_local_.format.post.t = ffelex_token_number_from_names (t, i);
- ffestb_local_.format.post.u.unsigned_val
- = strtoul (ffelex_token_text (ffestb_local_.format.post.t), NULL, 10);
- p += ffelex_token_length (ffestb_local_.format.post.t);
- i += ffelex_token_length (ffestb_local_.format.post.t);
- if (*p == '\0')
- return (ffelexHandler) ffestb_R10016_;
- if ((kw != FFESTR_formatP) ||
- !ffelex_is_firstnamechar ((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 = required;
- post = disallowed;
- dot = disallowed;
- exp = disallowed;
- R1005 = FALSE;
- break;
-
- case FFESTP_formattypeS:
- err = FFEBAD_FORMAT_BAD_S_SPEC;
- pre = disallowed;
- post = disallowed;
- dot = disallowed;
- exp = disallowed;
- R1005 = FALSE;
- break;
-
- case FFESTP_formattypeSP:
- err = FFEBAD_FORMAT_BAD_SP_SPEC;
- pre = disallowed;
- post = disallowed;
- dot = disallowed;
- exp = disallowed;
- R1005 = FALSE;
- break;
-
- case FFESTP_formattypeSS:
- err = FFEBAD_FORMAT_BAD_SS_SPEC;
- pre = disallowed;
- post = disallowed;
- dot = disallowed;
- exp = disallowed;
- R1005 = FALSE;
- break;
-
- case FFESTP_formattypeBN:
- err = FFEBAD_FORMAT_BAD_BN_SPEC;
- pre = disallowed;
- post = disallowed;
- dot = disallowed;
- exp = disallowed;
- R1005 = FALSE;
- break;
-
- case FFESTP_formattypeBZ:
- err = FFEBAD_FORMAT_BAD_BZ_SPEC;
- pre = disallowed;
- post = disallowed;
- dot = disallowed;
- exp = disallowed;
- R1005 = FALSE;
- break;
-
- case FFESTP_formattypeH: /* Definitely an error, make sure of
- it. */
- err = FFEBAD_FORMAT_BAD_H_SPEC;
- pre = ffestb_local_.format.pre.present ? disallowed : required;
- post = disallowed;
- dot = disallowed;
- exp = disallowed;
- R1005 = FALSE;
- break;
-
- case FFESTP_formattypeNone:
- ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_SPEC,
- ffestb_local_.format.t);
-
- clean_up_to_11_: /* :::::::::::::::::::: */
-
- ffelex_token_kill (ffestb_local_.format.t);
- if (ffestb_local_.format.pre.present)
- ffelex_token_kill (ffestb_local_.format.pre.t);
- if (ffestb_local_.format.post.present)
- ffelex_token_kill (ffestb_local_.format.post.t);
- if (ffestb_local_.format.dot.present)
- ffelex_token_kill (ffestb_local_.format.dot.t);
- if (ffestb_local_.format.exp.present)
- ffelex_token_kill (ffestb_local_.format.exp.t);
- return (ffelexHandler) ffestb_R100111_ (t);
-
- default:
- assert ("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_R1107 -- Parse the USE statement
-
- return ffestb_R1107; // to lexer
-
- Make sure the statement has a valid form for the USE statement.
- If it does, implement the statement. */
-
-#if FFESTR_F90
-ffelexHandler
-ffestb_R1107 (ffelexToken t)
-{
- ffeTokenLength i;
- const char *p;
-
- switch (ffelex_token_type (ffesta_tokens[0]))
- {
- case FFELEX_typeNAME:
- if (ffesta_first_kw != FFESTR_firstUSE)
- goto bad_0; /* :::::::::::::::::::: */
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- break;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
- ffesta_confirmed ();
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_R11071_;
-
- case FFELEX_typeNAMES:
- if (ffesta_first_kw != FFESTR_firstUSE)
- goto bad_0; /* :::::::::::::::::::: */
- p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlUSE);
- if (!ffesrc_is_name_init (*p))
- goto bad_i; /* :::::::::::::::::::: */
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeCOMMA:
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- break;
- }
- ffesta_confirmed ();
- ffesta_tokens[1]
- = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
- return (ffelexHandler) ffestb_R11071_ (t);
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-
-bad_i: /* :::::::::::::::::::: */
- ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "USE", ffesta_tokens[0], i, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R11071_ -- "USE" NAME
-
- return ffestb_R11071_; // to lexer
-
- Make sure the statement has a valid form for the USE statement. If it
- does, implement the statement. */
-
-static ffelexHandler
-ffestb_R11071_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (!ffesta_is_inhibited ())
- {
- ffestc_R1107_start (ffesta_tokens[1], FALSE);
- ffestc_R1107_finish ();
- }
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffesta_zero (t);
-
- case FFELEX_typeCOMMA:
- return (ffelexHandler) ffestb_R11072_;
-
- default:
- break;
- }
-
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R11072_ -- "USE" NAME COMMA
-
- return ffestb_R11072_; // to lexer
-
- Make sure the statement has a valid form for the USE statement. If it
- does, implement the statement. */
-
-static ffelexHandler
-ffestb_R11072_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[2] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_R11073_;
-
- default:
- break;
- }
-
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R11073_ -- "USE" NAME COMMA NAME
-
- return ffestb_R11073_; // to lexer
-
- Make sure the statement has a valid form for the USE statement. If it
- does, implement the statement. */
-
-static ffelexHandler
-ffestb_R11073_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOLON:
- if (ffestr_other (ffesta_tokens[2]) != FFESTR_otherONLY)
- break;
- if (!ffesta_is_inhibited ())
- ffestc_R1107_start (ffesta_tokens[1], TRUE);
- ffelex_token_kill (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[2]);
- return (ffelexHandler) ffestb_R11074_;
-
- case FFELEX_typePOINTS:
- if (!ffesta_is_inhibited ())
- ffestc_R1107_start (ffesta_tokens[1], FALSE);
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_tokens[1] = ffesta_tokens[2];
- return (ffelexHandler) ffestb_R110711_;
-
- default:
- break;
- }
-
- ffelex_token_kill (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[2]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R11074_ -- "USE" NAME COMMA "ONLY" COLON
-
- return ffestb_R11074_; // to lexer
-
- Make sure the statement has a valid form for the USE statement. If it
- does, implement the statement. */
-
-static ffelexHandler
-ffestb_R11074_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_R11075_;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (!ffesta_is_inhibited ())
- ffestc_R1107_finish ();
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
- ffestc_R1107_finish ();
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R11075_ -- "USE" NAME COMMA "ONLY" COLON NAME
-
- return ffestb_R11075_; // to lexer
-
- Make sure the statement has a valid form for the USE statement. If it
- does, implement the statement. */
-
-static ffelexHandler
-ffestb_R11075_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (!ffesta_is_inhibited ())
- {
- ffestc_R1107_item (NULL, ffesta_tokens[1]);
- ffestc_R1107_finish ();
- }
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffesta_zero (t);
-
- case FFELEX_typeCOMMA:
- if (!ffesta_is_inhibited ())
- ffestc_R1107_item (NULL, ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffestb_R11078_;
-
- case FFELEX_typePOINTS:
- return (ffelexHandler) ffestb_R11076_;
-
- default:
- break;
- }
-
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
- ffestc_R1107_finish ();
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R11076_ -- "USE" NAME COMMA "ONLY" COLON NAME POINTS
-
- return ffestb_R11076_; // to lexer
-
- Make sure the statement has a valid form for the USE statement. If it
- does, implement the statement. */
-
-static ffelexHandler
-ffestb_R11076_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- if (!ffesta_is_inhibited ())
- ffestc_R1107_item (ffesta_tokens[1], t);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffestb_R11077_;
-
- default:
- break;
- }
-
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
- ffestc_R1107_finish ();
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R11077_ -- "USE" NAME COMMA "ONLY" COLON NAME POINTS NAME
-
- return ffestb_R11077_; // to lexer
-
- Make sure the statement has a valid form for the USE statement. If it
- does, implement the statement. */
-
-static ffelexHandler
-ffestb_R11077_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (!ffesta_is_inhibited ())
- ffestc_R1107_finish ();
- return (ffelexHandler) ffesta_zero (t);
-
- case FFELEX_typeCOMMA:
- return (ffelexHandler) ffestb_R11078_;
-
- default:
- break;
- }
-
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
- ffestc_R1107_finish ();
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R11078_ -- "USE" NAME COMMA "ONLY" COLON NAME POINTS NAME COMMA
-
- return ffestb_R11078_; // to lexer
-
- Make sure the statement has a valid form for the USE statement. If it
- does, implement the statement. */
-
-static ffelexHandler
-ffestb_R11078_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_R11075_;
-
- default:
- break;
- }
-
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
- ffestc_R1107_finish ();
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R11079_ -- "USE" NAME COMMA
-
- return ffestb_R11079_; // to lexer
-
- Make sure the statement has a valid form for the USE statement. If it
- does, implement the statement. */
-
-static ffelexHandler
-ffestb_R11079_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_R110710_;
-
- default:
- break;
- }
-
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
- ffestc_R1107_finish ();
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R110710_ -- "USE" NAME COMMA NAME
-
- return ffestb_R110710_; // to lexer
-
- Make sure the statement has a valid form for the USE statement. If it
- does, implement the statement. */
-
-static ffelexHandler
-ffestb_R110710_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typePOINTS:
- return (ffelexHandler) ffestb_R110711_;
-
- default:
- break;
- }
-
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
- ffestc_R1107_finish ();
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R110711_ -- "USE" NAME COMMA NAME POINTS
-
- return ffestb_R110711_; // to lexer
-
- Make sure the statement has a valid form for the USE statement. If it
- does, implement the statement. */
-
-static ffelexHandler
-ffestb_R110711_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- if (!ffesta_is_inhibited ())
- ffestc_R1107_item (ffesta_tokens[1], t);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffestb_R110712_;
-
- default:
- break;
- }
-
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
- ffestc_R1107_finish ();
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R110712_ -- "USE" NAME COMMA NAME POINTS NAME
-
- return ffestb_R110712_; // to lexer
-
- Make sure the statement has a valid form for the USE statement. If it
- does, implement the statement. */
-
-static ffelexHandler
-ffestb_R110712_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (!ffesta_is_inhibited ())
- ffestc_R1107_finish ();
- return (ffelexHandler) ffesta_zero (t);
-
- case FFELEX_typeCOMMA:
- return (ffelexHandler) ffestb_R11079_;
-
- default:
- break;
- }
-
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
- ffestc_R1107_finish ();
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-#endif
-/* ffestb_R1202 -- Parse the INTERFACE statement
-
- return ffestb_R1202; // to lexer
-
- Make sure the statement has a valid form for the INTERFACE statement.
- If it does, implement the statement.
-
- 15-May-90 JCB 1.1
- Allow INTERFACE by itself; missed this
- valid form when originally doing syntactic analysis code. */
-
-#if FFESTR_F90
-ffelexHandler
-ffestb_R1202 (ffelexToken t)
-{
- ffeTokenLength i;
- const char *p;
-
- switch (ffelex_token_type (ffesta_tokens[0]))
- {
- case FFELEX_typeNAME:
- if (ffesta_first_kw != FFESTR_firstINTERFACE)
- goto bad_0; /* :::::::::::::::::::: */
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- break;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_R1202 (FFESTP_definedoperatorNone, NULL);
- return (ffelexHandler) ffesta_zero (t);
-
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
- }
-
- ffesta_confirmed ();
- switch (ffesta_second_kw)
- {
- case FFESTR_secondOPERATOR:
- ffestb_local_.interface.operator = FFESTP_definedoperatorOPERATOR;
- break;
-
- case FFESTR_secondASSIGNMENT:
- ffestb_local_.interface.operator = FFESTP_definedoperatorASSIGNMENT;
- break;
-
- default:
- ffestb_local_.interface.operator = FFESTP_definedoperatorNone;
- break;
- }
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_R12021_;
-
- case FFELEX_typeNAMES:
- p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlINTERFACE);
- switch (ffesta_first_kw)
- {
- case FFESTR_firstINTERFACEOPERATOR:
- if (*(ffelex_token_text (ffesta_tokens[0])
- + FFESTR_firstlINTERFACEOPERATOR) == '\0')
- ffestb_local_.interface.operator
- = FFESTP_definedoperatorOPERATOR;
- break;
-
- case FFESTR_firstINTERFACEASSGNMNT:
- if (*(ffelex_token_text (ffesta_tokens[0])
- + FFESTR_firstlINTERFACEASSGNMNT) == '\0')
- ffestb_local_.interface.operator
- = FFESTP_definedoperatorASSIGNMENT;
- break;
-
- case FFESTR_firstINTERFACE:
- ffestb_local_.interface.operator = FFESTP_definedoperatorNone;
- break;
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeOPEN_PAREN:
- case FFELEX_typeOPEN_ARRAY: /* Sigh. */
- break;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- if (*p == '\0')
- {
- if (!ffesta_is_inhibited ())
- ffestc_R1202 (FFESTP_definedoperatorNone, NULL);
- return (ffelexHandler) ffesta_zero (t);
- }
- break;
- }
- if (!ffesrc_is_name_init (*p))
- goto bad_i; /* :::::::::::::::::::: */
- ffesta_tokens[1] = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
- return (ffelexHandler) ffestb_R12021_ (t);
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-
-bad_i: /* :::::::::::::::::::: */
- ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "INTERFACE", ffesta_tokens[0], i, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R12021_ -- "INTERFACE" NAME
-
- return ffestb_R12021_; // to lexer
-
- Make sure the statement has a valid form for the INTERFACE statement. If
- it does, implement the statement. */
-
-static ffelexHandler
-ffestb_R12021_ (ffelexToken t)
-{
- ffestb_local_.interface.slash = TRUE; /* Slash follows open paren. */
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (!ffesta_is_inhibited ())
- ffestc_R1202 (FFESTP_definedoperatorNone, ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffesta_zero (t);
-
- case FFELEX_typeOPEN_PAREN:
- ffestb_local_.interface.slash = FALSE; /* Slash doesn't follow. */
- /* Fall through. */
- case FFELEX_typeOPEN_ARRAY:
- switch (ffestb_local_.interface.operator)
- {
- case FFESTP_definedoperatorNone:
- break;
-
- case FFESTP_definedoperatorOPERATOR:
- ffestb_local_.interface.assignment = FALSE;
- return (ffelexHandler) ffestb_R12022_;
-
- case FFESTP_definedoperatorASSIGNMENT:
- ffestb_local_.interface.assignment = TRUE;
- return (ffelexHandler) ffestb_R12022_;
-
- default:
- assert (FALSE);
- }
- break;
-
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- break;
-
- default:
- break;
- }
-
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R12022_ -- "INTERFACE" "OPERATOR/ASSIGNMENT" OPEN_PAREN
-
- return ffestb_R12022_; // to lexer
-
- Make sure the statement has a valid form for the INTERFACE statement. If
- it does, implement the statement. */
-
-static ffelexHandler
-ffestb_R12022_ (ffelexToken t)
-{
- ffesta_tokens[2] = ffelex_token_use (t);
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typePERIOD:
- if (ffestb_local_.interface.slash)
- break;
- return (ffelexHandler) ffestb_R12023_;
-
- case FFELEX_typePOWER:
- if (ffestb_local_.interface.slash)
- break;
- ffestb_local_.interface.operator = FFESTP_definedoperatorPOWER;
- return (ffelexHandler) ffestb_R12025_;
-
- case FFELEX_typeASTERISK:
- if (ffestb_local_.interface.slash)
- break;
- ffestb_local_.interface.operator = FFESTP_definedoperatorMULT;
- return (ffelexHandler) ffestb_R12025_;
-
- case FFELEX_typePLUS:
- if (ffestb_local_.interface.slash)
- break;
- ffestb_local_.interface.operator = FFESTP_definedoperatorADD;
- return (ffelexHandler) ffestb_R12025_;
-
- case FFELEX_typeCONCAT:
- if (ffestb_local_.interface.slash)
- break;
- ffestb_local_.interface.operator = FFESTP_definedoperatorCONCAT;
- return (ffelexHandler) ffestb_R12025_;
-
- case FFELEX_typeSLASH:
- if (ffestb_local_.interface.slash)
- {
- ffestb_local_.interface.operator = FFESTP_definedoperatorCONCAT;
- return (ffelexHandler) ffestb_R12025_;
- }
- ffestb_local_.interface.operator = FFESTP_definedoperatorDIVIDE;
- return (ffelexHandler) ffestb_R12025_;
-
- case FFELEX_typeMINUS:
- if (ffestb_local_.interface.slash)
- break;
- ffestb_local_.interface.operator = FFESTP_definedoperatorSUBTRACT;
- return (ffelexHandler) ffestb_R12025_;
-
- case FFELEX_typeREL_EQ:
- if (ffestb_local_.interface.slash)
- break;
- ffestb_local_.interface.operator = FFESTP_definedoperatorEQ;
- return (ffelexHandler) ffestb_R12025_;
-
- case FFELEX_typeREL_NE:
- if (ffestb_local_.interface.slash)
- break;
- ffestb_local_.interface.operator = FFESTP_definedoperatorNE;
- return (ffelexHandler) ffestb_R12025_;
-
- case FFELEX_typeOPEN_ANGLE:
- if (ffestb_local_.interface.slash)
- break;
- ffestb_local_.interface.operator = FFESTP_definedoperatorLT;
- return (ffelexHandler) ffestb_R12025_;
-
- case FFELEX_typeREL_LE:
- if (ffestb_local_.interface.slash)
- break;
- ffestb_local_.interface.operator = FFESTP_definedoperatorLE;
- return (ffelexHandler) ffestb_R12025_;
-
- case FFELEX_typeCLOSE_ANGLE:
- if (ffestb_local_.interface.slash)
- break;
- ffestb_local_.interface.operator = FFESTP_definedoperatorGT;
- return (ffelexHandler) ffestb_R12025_;
-
- case FFELEX_typeREL_GE:
- if (ffestb_local_.interface.slash)
- break;
- ffestb_local_.interface.operator = FFESTP_definedoperatorGE;
- return (ffelexHandler) ffestb_R12025_;
-
- case FFELEX_typeEQUALS:
- if (ffestb_local_.interface.slash)
- {
- ffestb_local_.interface.operator = FFESTP_definedoperatorNE;
- return (ffelexHandler) ffestb_R12025_;
- }
- ffestb_local_.interface.operator = FFESTP_definedoperatorASSIGNMENT;
- return (ffelexHandler) ffestb_R12025_;
-
- case FFELEX_typeCLOSE_ARRAY:
- if (!ffestb_local_.interface.slash)
- {
- ffestb_local_.interface.operator = FFESTP_definedoperatorDIVIDE;
- return (ffelexHandler) ffestb_R12026_;
- }
- ffestb_local_.interface.operator = FFESTP_definedoperatorCONCAT;
- return (ffelexHandler) ffestb_R12026_;
-
- case FFELEX_typeCLOSE_PAREN:
- if (!ffestb_local_.interface.slash)
- break;
- ffestb_local_.interface.operator = FFESTP_definedoperatorDIVIDE;
- return (ffelexHandler) ffestb_R12026_;
-
- default:
- break;
- }
-
- ffelex_token_kill (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[2]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R12023_ -- "INTERFACE" NAME OPEN_PAREN PERIOD
-
- return ffestb_R12023_; // to lexer
-
- Make sure the statement has a valid form for the INTERFACE statement. If
- it does, implement the statement. */
-
-static ffelexHandler
-ffestb_R12023_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffelex_token_kill (ffesta_tokens[2]);
- ffesta_tokens[2] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_R12024_;
-
- default:
- break;
- }
-
- ffelex_token_kill (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[2]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R12024_ -- "INTERFACE" NAME OPEN_PAREN PERIOD NAME
-
- return ffestb_R12024_; // to lexer
-
- Make sure the statement has a valid form for the INTERFACE statement. If
- it does, implement the statement. */
-
-static ffelexHandler
-ffestb_R12024_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typePERIOD:
- return (ffelexHandler) ffestb_R12025_;
-
- default:
- break;
- }
-
- ffelex_token_kill (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[2]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R12025_ -- "INTERFACE" NAME OPEN_PAREN operator
-
- return ffestb_R12025_; // to lexer
-
- Make sure the statement has a valid form for the INTERFACE statement. If
- it does, implement the statement. */
-
-static ffelexHandler
-ffestb_R12025_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCLOSE_PAREN:
- return (ffelexHandler) ffestb_R12026_;
-
- default:
- break;
- }
-
- ffelex_token_kill (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[2]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R12026_ -- "INTERFACE" NAME OPEN_PAREN operator CLOSE_PAREN
-
- return ffestb_R12026_; // to lexer
-
- Make sure the statement has a valid form for the INTERFACE statement. If
- it does, implement the statement. */
-
-static ffelexHandler
-ffestb_R12026_ (ffelexToken t)
-{
- const char *p;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- if (ffestb_local_.interface.assignment
- && (ffestb_local_.interface.operator
- != FFESTP_definedoperatorASSIGNMENT))
- {
- ffebad_start (FFEBAD_INTERFACE_ASSIGNMENT);
- ffebad_here (0, ffelex_token_where_line (ffesta_tokens[1]),
- ffelex_token_where_column (ffesta_tokens[1]));
- ffebad_here (1, ffelex_token_where_line (ffesta_tokens[2]),
- ffelex_token_where_column (ffesta_tokens[2]));
- ffebad_finish ();
- }
- switch (ffelex_token_type (ffesta_tokens[2]))
- {
- case FFELEX_typeNAME:
- switch (ffestr_other (ffesta_tokens[2]))
- {
- case FFESTR_otherNOT:
- if (!ffesta_is_inhibited ())
- ffestc_R1202 (FFESTP_definedoperatorNOT, NULL);
- break;
-
- case FFESTR_otherAND:
- if (!ffesta_is_inhibited ())
- ffestc_R1202 (FFESTP_definedoperatorAND, NULL);
- break;
-
- case FFESTR_otherOR:
- if (!ffesta_is_inhibited ())
- ffestc_R1202 (FFESTP_definedoperatorOR, NULL);
- break;
-
- case FFESTR_otherEQV:
- if (!ffesta_is_inhibited ())
- ffestc_R1202 (FFESTP_definedoperatorEQV, NULL);
- break;
-
- case FFESTR_otherNEQV:
- if (!ffesta_is_inhibited ())
- ffestc_R1202 (FFESTP_definedoperatorNEQV, NULL);
- break;
-
- case FFESTR_otherEQ:
- if (!ffesta_is_inhibited ())
- ffestc_R1202 (FFESTP_definedoperatorEQ, NULL);
- break;
-
- case FFESTR_otherNE:
- if (!ffesta_is_inhibited ())
- ffestc_R1202 (FFESTP_definedoperatorNE, NULL);
- break;
-
- case FFESTR_otherLT:
- if (!ffesta_is_inhibited ())
- ffestc_R1202 (FFESTP_definedoperatorLT, NULL);
- break;
-
- case FFESTR_otherLE:
- if (!ffesta_is_inhibited ())
- ffestc_R1202 (FFESTP_definedoperatorLE, NULL);
- break;
-
- case FFESTR_otherGT:
- if (!ffesta_is_inhibited ())
- ffestc_R1202 (FFESTP_definedoperatorGT, NULL);
- break;
-
- case FFESTR_otherGE:
- if (!ffesta_is_inhibited ())
- ffestc_R1202 (FFESTP_definedoperatorGE, NULL);
- break;
-
- default:
- for (p = ffelex_token_text (ffesta_tokens[2]); *p != '\0'; ++p)
- {
- if (! ISALPHA (*p))
- {
- ffelex_token_kill (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[2]);
- ffesta_ffebad_1t (FFEBAD_INTERFACE_NONLETTER,
- ffesta_tokens[2]);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero);
- }
- }
- if (!ffesta_is_inhibited ())
- ffestc_R1202 (FFESTP_definedoperatorOPERATOR,
- ffesta_tokens[2]);
- }
- break;
-
- case FFELEX_typeEQUALS:
- if (!ffestb_local_.interface.assignment
- && (ffestb_local_.interface.operator
- == FFESTP_definedoperatorASSIGNMENT))
- {
- ffebad_start (FFEBAD_INTERFACE_OPERATOR);
- ffebad_here (0, ffelex_token_where_line (ffesta_tokens[1]),
- ffelex_token_where_column (ffesta_tokens[1]));
- ffebad_here (1, ffelex_token_where_line (ffesta_tokens[2]),
- ffelex_token_where_column (ffesta_tokens[2]));
- ffebad_finish ();
- }
- if (!ffesta_is_inhibited ())
- ffestc_R1202 (ffestb_local_.interface.operator, NULL);
- break;
-
- default:
- if (!ffesta_is_inhibited ())
- ffestc_R1202 (ffestb_local_.interface.operator, NULL);
- }
- ffelex_token_kill (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[2]);
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- ffelex_token_kill (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[2]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-#endif
-/* ffestb_S3P4 -- Parse the INCLUDE line
-
- return ffestb_S3P4; // to lexer
-
- Make sure the statement has a valid form for the INCLUDE line. If it
- does, implement the statement. */
-
-ffelexHandler
-ffestb_S3P4 (ffelexToken t)
-{
- ffeTokenLength i;
- 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_V012 -- Parse the MAP statement
-
- return ffestb_V012; // to lexer
-
- Make sure the statement has a valid form for the MAP statement. If
- it does, implement the statement. */
-
-#if FFESTR_VXT
-ffelexHandler
-ffestb_V012 (ffelexToken t)
-{
- const char *p;
- ffeTokenLength i;
-
- switch (ffelex_token_type (ffesta_tokens[0]))
- {
- case FFELEX_typeNAME:
- if (ffesta_first_kw != FFESTR_firstMAP)
- goto bad_0; /* :::::::::::::::::::: */
- break;
-
- case FFELEX_typeNAMES:
- if (ffesta_first_kw != FFESTR_firstMAP)
- goto bad_0; /* :::::::::::::::::::: */
- if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlMAP)
- {
- p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlMAP);
- goto bad_i; /* :::::::::::::::::::: */
- }
- break;
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_V012 ();
- return (ffelexHandler) ffesta_zero (t);
-
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
- }
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MAP", ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid first token. */
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MAP", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-
-bad_i: /* :::::::::::::::::::: */
- ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "MAP", ffesta_tokens[0], i, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-#endif
-/* ffestb_V014 -- Parse the VOLATILE statement
-
- return ffestb_V014; // to lexer
-
- Make sure the statement has a valid form for the VOLATILE statement. If it
- does, implement the statement. */
-
-ffelexHandler
-ffestb_V014 (ffelexToken t)
-{
- ffeTokenLength i;
- 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_V025 -- Parse the DEFINEFILE statement
-
- return ffestb_V025; // to lexer
-
- Make sure the statement has a valid form for the DEFINEFILE statement.
- If it does, implement the statement. */
-
-#if FFESTR_VXT
-ffelexHandler
-ffestb_V025 (ffelexToken t)
-{
- ffeTokenLength i;
- const char *p;
- ffelexToken nt;
- ffelexHandler next;
-
- ffestb_local_.V025.started = FALSE;
- switch (ffelex_token_type (ffesta_tokens[0]))
- {
- case FFELEX_typeNAME:
- switch (ffesta_first_kw)
- {
- case FFESTR_firstDEFINE:
- if ((ffelex_token_type (t) != FFELEX_typeNAME)
- || (ffesta_second_kw != FFESTR_secondFILE))
- goto bad_1; /* :::::::::::::::::::: */
- ffesta_confirmed ();
- return (ffelexHandler) ffestb_V0251_;
-
- case FFESTR_firstDEFINEFILE:
- return (ffelexHandler) ffestb_V0251_ (t);
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
- case FFELEX_typeNAMES:
- if (ffesta_first_kw != FFESTR_firstDEFINEFILE)
- goto bad_0; /* :::::::::::::::::::: */
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeOPEN_PAREN:
- break;
- }
- p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDEFINEFILE);
- if (ISDIGIT (*p))
- nt = ffelex_token_number_from_names (ffesta_tokens[0], i);
- else if (ffesrc_is_name_init (*p))
- nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
- else
- goto bad_i; /* :::::::::::::::::::: */
- next = (ffelexHandler) ffestb_V0251_ (nt);
- ffelex_token_kill (nt);
- return (ffelexHandler) (*next) (t);
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-
-bad_i: /* :::::::::::::::::::: */
- ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", ffesta_tokens[0], i, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0251_ -- "DEFINEFILE" or "DEFINE" "FILE"
-
- return ffestb_V0251_; // to lexer
-
- Make sure the statement has a valid form for the DEFINEFILE statement. If it
- does, implement the statement. */
-
-static ffelexHandler
-ffestb_V0251_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- case FFELEX_typeNUMBER:
- if (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME)
- ffesta_confirmed ();
- return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILEUNIT_DF, (ffeexprCallback) ffestb_V0252_)))
- (t);
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- break;
-
- default:
- break;
- }
-
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0252_ -- "DEFINEFILE" expr
-
- (ffestb_V0252_) // to expression handler
-
- Make sure the statement has a valid form for the DEFINEFILE statement. If
- it does, implement the statement. */
-
-static ffelexHandler
-ffestb_V0252_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeOPEN_PAREN:
- ffestb_local_.V025.u = expr;
- ffesta_tokens[1] = ffelex_token_use (ft);
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0253_);
-
- default:
- break;
- }
-
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0253_ -- "DEFINEFILE" expr OPEN_PAREN expr
-
- (ffestb_V0253_) // to expression handler
-
- Make sure the statement has a valid form for the DEFINEFILE statement. If
- it does, implement the statement. */
-
-static ffelexHandler
-ffestb_V0253_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- ffestb_local_.V025.m = expr;
- ffesta_tokens[2] = ffelex_token_use (ft);
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0254_);
-
- default:
- break;
- }
-
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0254_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr
-
- (ffestb_V0254_) // to expression handler
-
- Make sure the statement has a valid form for the DEFINEFILE statement. If
- it does, implement the statement. */
-
-static ffelexHandler
-ffestb_V0254_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- ffestb_local_.V025.n = expr;
- ffesta_tokens[3] = ffelex_token_use (ft);
- return (ffelexHandler) ffestb_V0255_;
-
- default:
- break;
- }
-
- ffelex_token_kill (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[2]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0255_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA
-
- return ffestb_V0255_; // to lexer
-
- Make sure the statement has a valid form for the DEFINEFILE statement. If
- it does, implement the statement. */
-
-static ffelexHandler
-ffestb_V0255_ (ffelexToken t)
-{
- const char *p;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- p = ffelex_token_text (t);
- if (!ffesrc_char_match_init (*p, 'U', 'u') || (*++p != '\0'))
- break;
- return (ffelexHandler) ffestb_V0256_;
-
- default:
- break;
- }
-
- ffelex_token_kill (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[2]);
- ffelex_token_kill (ffesta_tokens[3]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0256_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA "U"
-
- return ffestb_V0256_; // to lexer
-
- Make sure the statement has a valid form for the DEFINEFILE statement. If
- it does, implement the statement. */
-
-static ffelexHandler
-ffestb_V0256_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
- FFEEXPR_contextFILEASSOC,
- (ffeexprCallback) ffestb_V0257_);
-
- default:
- break;
- }
-
- ffelex_token_kill (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[2]);
- ffelex_token_kill (ffesta_tokens[3]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0257_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA "U"
- COMMA expr
-
- (ffestb_V0257_) // to expression handler
-
- Make sure the statement has a valid form for the DEFINEFILE statement. If
- it does, implement the statement. */
-
-static ffelexHandler
-ffestb_V0257_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCLOSE_PAREN:
- ffestb_local_.V025.asv = expr;
- ffesta_tokens[4] = ffelex_token_use (ft);
- return (ffelexHandler) ffestb_V0258_;
-
- default:
- break;
- }
-
- ffelex_token_kill (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[2]);
- ffelex_token_kill (ffesta_tokens[3]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0258_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA "U"
- COMMA expr CLOSE_PAREN
-
- return ffestb_V0258_; // to lexer
-
- Make sure the statement has a valid form for the DEFINEFILE statement. If
- it does, implement the statement. */
-
-static ffelexHandler
-ffestb_V0258_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (!ffestb_local_.V025.started)
- {
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_V025_start ();
- ffestb_local_.V025.started = TRUE;
- }
- if (!ffesta_is_inhibited ())
- ffestc_V025_item (ffestb_local_.V025.u, ffesta_tokens[1],
- ffestb_local_.V025.m, ffesta_tokens[2],
- ffestb_local_.V025.n, ffesta_tokens[3],
- ffestb_local_.V025.asv, ffesta_tokens[4]);
- ffelex_token_kill (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[2]);
- ffelex_token_kill (ffesta_tokens[3]);
- ffelex_token_kill (ffesta_tokens[4]);
- if (ffelex_token_type (t) == FFELEX_typeCOMMA)
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILEUNIT_DF, (ffeexprCallback) ffestb_V0252_);
- if (!ffesta_is_inhibited ())
- ffestc_V025_finish ();
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- ffelex_token_kill (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[2]);
- ffelex_token_kill (ffesta_tokens[3]);
- ffelex_token_kill (ffesta_tokens[4]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-#endif
-/* ffestb_subr_kill_easy_ -- Kill I/O statement data structure
-
- ffestb_subr_kill_easy_();
-
- Kills all tokens in the I/O data structure. Assumes that they are
- overlaid with each other (union) in ffest_private.h and the typing
- and structure references assume (though not necessarily dangerous if
- FALSE) that INQUIRE has the most file elements. */
-
-#if FFESTB_KILL_EASY_
-static void
-ffestb_subr_kill_easy_ (ffestpInquireIx max)
-{
- ffestpInquireIx ix;
-
- for (ix = 0; ix < max; ++ix)
- {
- if (ffestp_file.inquire.inquire_spec[ix].kw_or_val_present)
- {
- if (ffestp_file.inquire.inquire_spec[ix].kw_present)
- ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].kw);
- if (ffestp_file.inquire.inquire_spec[ix].value_present)
- ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].value);
- }
- }
-}
-
-#endif
-/* ffestb_subr_kill_accept_ -- Kill ACCEPT statement data structure
-
- ffestb_subr_kill_accept_();
-
- Kills all tokens in the ACCEPT data structure. */
-
-#if !FFESTB_KILL_EASY_
-static void
-ffestb_subr_kill_accept_ ()
-{
- ffestpAcceptIx ix;
-
- for (ix = 0; ix < FFESTP_acceptix; ++ix)
- {
- if (ffestp_file.accept.accept_spec[ix].kw_or_val_present)
- {
- if (ffestp_file.accept.accept_spec[ix].kw_present)
- ffelex_token_kill (ffestp_file.accept.accept_spec[ix].kw);
- if (ffestp_file.accept.accept_spec[ix].value_present)
- ffelex_token_kill (ffestp_file.accept.accept_spec[ix].value);
- }
- }
-}
-
-#endif
-/* ffestb_subr_kill_beru_ -- Kill BACKSPACE/ENDFILE/REWIND/UNLOCK statement
- data structure
-
- ffestb_subr_kill_beru_();
-
- Kills all tokens in the BACKSPACE/ENDFILE/REWIND/UNLOCK data structure. */
-
-#if !FFESTB_KILL_EASY_
-static void
-ffestb_subr_kill_beru_ ()
-{
- ffestpBeruIx ix;
-
- for (ix = 0; ix < FFESTP_beruix; ++ix)
- {
- if (ffestp_file.beru.beru_spec[ix].kw_or_val_present)
- {
- if (ffestp_file.beru.beru_spec[ix].kw_present)
- ffelex_token_kill (ffestp_file.beru.beru_spec[ix].kw);
- if (ffestp_file.beru.beru_spec[ix].value_present)
- ffelex_token_kill (ffestp_file.beru.beru_spec[ix].value);
- }
- }
-}
-
-#endif
-/* ffestb_subr_kill_close_ -- Kill CLOSE statement data structure
-
- ffestb_subr_kill_close_();
-
- Kills all tokens in the CLOSE data structure. */
-
-#if !FFESTB_KILL_EASY_
-static void
-ffestb_subr_kill_close_ ()
-{
- ffestpCloseIx ix;
-
- for (ix = 0; ix < FFESTP_closeix; ++ix)
- {
- if (ffestp_file.close.close_spec[ix].kw_or_val_present)
- {
- if (ffestp_file.close.close_spec[ix].kw_present)
- ffelex_token_kill (ffestp_file.close.close_spec[ix].kw);
- if (ffestp_file.close.close_spec[ix].value_present)
- ffelex_token_kill (ffestp_file.close.close_spec[ix].value);
- }
- }
-}
-
-#endif
-/* ffestb_subr_kill_delete_ -- Kill DELETE statement data structure
-
- ffestb_subr_kill_delete_();
-
- Kills all tokens in the DELETE data structure. */
-
-#if !FFESTB_KILL_EASY_
-static void
-ffestb_subr_kill_delete_ ()
-{
- ffestpDeleteIx ix;
-
- for (ix = 0; ix < FFESTP_deleteix; ++ix)
- {
- if (ffestp_file.delete.delete_spec[ix].kw_or_val_present)
- {
- if (ffestp_file.delete.delete_spec[ix].kw_present)
- ffelex_token_kill (ffestp_file.delete.delete_spec[ix].kw);
- if (ffestp_file.delete.delete_spec[ix].value_present)
- ffelex_token_kill (ffestp_file.delete.delete_spec[ix].value);
- }
- }
-}
-
-#endif
-/* ffestb_subr_kill_inquire_ -- Kill INQUIRE statement data structure
-
- ffestb_subr_kill_inquire_();
-
- Kills all tokens in the INQUIRE data structure. */
-
-#if !FFESTB_KILL_EASY_
-static void
-ffestb_subr_kill_inquire_ ()
-{
- ffestpInquireIx ix;
-
- for (ix = 0; ix < FFESTP_inquireix; ++ix)
- {
- if (ffestp_file.inquire.inquire_spec[ix].kw_or_val_present)
- {
- if (ffestp_file.inquire.inquire_spec[ix].kw_present)
- ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].kw);
- if (ffestp_file.inquire.inquire_spec[ix].value_present)
- ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].value);
- }
- }
-}
-
-#endif
-/* ffestb_subr_kill_open_ -- Kill OPEN statement data structure
-
- ffestb_subr_kill_open_();
-
- Kills all tokens in the OPEN data structure. */
-
-#if !FFESTB_KILL_EASY_
-static void
-ffestb_subr_kill_open_ ()
-{
- ffestpOpenIx ix;
-
- for (ix = 0; ix < FFESTP_openix; ++ix)
- {
- if (ffestp_file.open.open_spec[ix].kw_or_val_present)
- {
- if (ffestp_file.open.open_spec[ix].kw_present)
- ffelex_token_kill (ffestp_file.open.open_spec[ix].kw);
- if (ffestp_file.open.open_spec[ix].value_present)
- ffelex_token_kill (ffestp_file.open.open_spec[ix].value);
- }
- }
-}
-
-#endif
-/* ffestb_subr_kill_print_ -- Kill PRINT statement data structure
-
- ffestb_subr_kill_print_();
-
- Kills all tokens in the PRINT data structure. */
-
-#if !FFESTB_KILL_EASY_
-static void
-ffestb_subr_kill_print_ ()
-{
- ffestpPrintIx ix;
-
- for (ix = 0; ix < FFESTP_printix; ++ix)
- {
- if (ffestp_file.print.print_spec[ix].kw_or_val_present)
- {
- if (ffestp_file.print.print_spec[ix].kw_present)
- ffelex_token_kill (ffestp_file.print.print_spec[ix].kw);
- if (ffestp_file.print.print_spec[ix].value_present)
- ffelex_token_kill (ffestp_file.print.print_spec[ix].value);
- }
- }
-}
-
-#endif
-/* ffestb_subr_kill_read_ -- Kill READ statement data structure
-
- ffestb_subr_kill_read_();
-
- Kills all tokens in the READ data structure. */
-
-#if !FFESTB_KILL_EASY_
-static void
-ffestb_subr_kill_read_ ()
-{
- ffestpReadIx ix;
-
- for (ix = 0; ix < FFESTP_readix; ++ix)
- {
- if (ffestp_file.read.read_spec[ix].kw_or_val_present)
- {
- if (ffestp_file.read.read_spec[ix].kw_present)
- ffelex_token_kill (ffestp_file.read.read_spec[ix].kw);
- if (ffestp_file.read.read_spec[ix].value_present)
- ffelex_token_kill (ffestp_file.read.read_spec[ix].value);
- }
- }
-}
-
-#endif
-/* ffestb_subr_kill_rewrite_ -- Kill REWRITE statement data structure
-
- ffestb_subr_kill_rewrite_();
-
- Kills all tokens in the REWRITE data structure. */
-
-#if !FFESTB_KILL_EASY_
-static void
-ffestb_subr_kill_rewrite_ ()
-{
- ffestpRewriteIx ix;
-
- for (ix = 0; ix < FFESTP_rewriteix; ++ix)
- {
- if (ffestp_file.rewrite.rewrite_spec[ix].kw_or_val_present)
- {
- if (ffestp_file.rewrite.rewrite_spec[ix].kw_present)
- ffelex_token_kill (ffestp_file.rewrite.rewrite_spec[ix].kw);
- if (ffestp_file.rewrite.rewrite_spec[ix].value_present)
- ffelex_token_kill (ffestp_file.rewrite.rewrite_spec[ix].value);
- }
- }
-}
-
-#endif
-/* ffestb_subr_kill_type_ -- Kill TYPE statement data structure
-
- ffestb_subr_kill_type_();
-
- Kills all tokens in the TYPE data structure. */
-
-#if !FFESTB_KILL_EASY_
-static void
-ffestb_subr_kill_type_ ()
-{
- ffestpTypeIx ix;
-
- for (ix = 0; ix < FFESTP_typeix; ++ix)
- {
- if (ffestp_file.type.type_spec[ix].kw_or_val_present)
- {
- if (ffestp_file.type.type_spec[ix].kw_present)
- ffelex_token_kill (ffestp_file.type.type_spec[ix].kw);
- if (ffestp_file.type.type_spec[ix].value_present)
- ffelex_token_kill (ffestp_file.type.type_spec[ix].value);
- }
- }
-}
-
-#endif
-/* ffestb_subr_kill_write_ -- Kill WRITE statement data structure
-
- ffestb_subr_kill_write_();
-
- Kills all tokens in the WRITE data structure. */
-
-#if !FFESTB_KILL_EASY_
-static void
-ffestb_subr_kill_write_ ()
-{
- ffestpWriteIx ix;
-
- for (ix = 0; ix < FFESTP_writeix; ++ix)
- {
- if (ffestp_file.write.write_spec[ix].kw_or_val_present)
- {
- if (ffestp_file.write.write_spec[ix].kw_present)
- ffelex_token_kill (ffestp_file.write.write_spec[ix].kw);
- if (ffestp_file.write.write_spec[ix].value_present)
- ffelex_token_kill (ffestp_file.write.write_spec[ix].value);
- }
- }
-}
-
-#endif
-/* ffestb_beru -- Parse the BACKSPACE/ENDFILE/REWIND/UNLOCK statement
-
- return ffestb_beru; // to lexer
-
- Make sure the statement has a valid form for the BACKSPACE/ENDFILE/REWIND/
- UNLOCK statement. If it does, implement the statement. */
-
-ffelexHandler
-ffestb_beru (ffelexToken t)
-{
- ffelexHandler next;
- ffestpBeruIx ix;
-
- switch (ffelex_token_type (ffesta_tokens[0]))
- {
- case FFELEX_typeNAME:
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeEQUALS:
- case FFELEX_typePOINTS:
- case FFELEX_typeCOLON:
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeNAME:
- case FFELEX_typeNUMBER:
- ffesta_confirmed ();
- break;
-
- case FFELEX_typeOPEN_PAREN:
- for (ix = 0; ix < FFESTP_beruix; ++ix)
- ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_beru2_;
-
- default:
- break;
- }
-
- for (ix = 0; ix < FFESTP_beruix; ++ix)
- ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
- return (ffelexHandler) (*((ffelexHandler)
- ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILENUM,
- (ffeexprCallback) ffestb_beru1_)))
- (t);
-
- case FFELEX_typeNAMES:
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeEQUALS:
- case FFELEX_typePOINTS:
- case FFELEX_typeCOLON:
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- break;
-
- case FFELEX_typeOPEN_PAREN:
- if (ffelex_token_length (ffesta_tokens[0])
- != ffestb_args.beru.len)
- break;
-
- for (ix = 0; ix < FFESTP_beruix; ++ix)
- ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_beru2_;
-
- default:
- break;
- }
- for (ix = 0; ix < FFESTP_beruix; ++ix)
- ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
- next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_beru1_);
- next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
- ffestb_args.beru.len);
- if (next == NULL)
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero);
- return (ffelexHandler) (*next) (t);
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-}
-
-/* ffestb_beru1_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" expr
-
- (ffestb_beru1_) // to expression handler
-
- Make sure the next token is an EOS or SEMICOLON. */
-
-static ffelexHandler
-ffestb_beru1_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (expr == NULL)
- break;
- ffesta_confirmed ();
- ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_or_val_present
- = TRUE;
- ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_present = FALSE;
- ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_present = TRUE;
- ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_is_label
- = FALSE;
- ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value
- = ffelex_token_use (ft);
- ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].u.expr = expr;
- if (!ffesta_is_inhibited ())
- {
- switch (ffesta_first_kw)
- {
- case FFESTR_firstBACKSPACE:
- ffestc_R919 ();
- break;
-
- case FFESTR_firstENDFILE:
- case FFESTR_firstEND:
- ffestc_R920 ();
- break;
-
- case FFESTR_firstREWIND:
- ffestc_R921 ();
- break;
-
-#if FFESTR_VXT
- case FFESTR_firstUNLOCK:
- ffestc_V022 ();
- break;
-#endif
-
- default:
- assert (FALSE);
- }
- }
- ffestb_subr_kill_beru_ ();
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- ffestb_subr_kill_beru_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_beru2_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN
-
- return ffestb_beru2_; // to lexer
-
- Handle expr construct (not NAME=expr construct) here. */
-
-static ffelexHandler
-ffestb_beru2_ (ffelexToken t)
-{
- ffelexToken nt;
- ffelexHandler next;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[2] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_beru3_;
-
- default:
- nt = ffesta_tokens[1];
- next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILENUMAMBIG, (ffeexprCallback) ffestb_beru4_)))
- (nt);
- ffelex_token_kill (nt);
- return (ffelexHandler) (*next) (t);
- }
-}
-
-/* ffestb_beru3_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN NAME
-
- return ffestb_beru3_; // to lexer
-
- If EQUALS here, go to states that handle it. Else, send NAME and this
- token thru expression handler. */
-
-static ffelexHandler
-ffestb_beru3_ (ffelexToken t)
-{
- ffelexHandler next;
- ffelexToken nt;
- ffelexToken ot;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEQUALS:
- ffelex_token_kill (ffesta_tokens[1]);
- nt = ffesta_tokens[2];
- next = (ffelexHandler) ffestb_beru5_ (nt);
- ffelex_token_kill (nt);
- return (ffelexHandler) (*next) (t);
-
- default:
- nt = ffesta_tokens[1];
- ot = ffesta_tokens[2];
- next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILENUMAMBIG, (ffeexprCallback) ffestb_beru4_)))
- (nt);
- ffelex_token_kill (nt);
- next = (ffelexHandler) (*next) (ot);
- ffelex_token_kill (ot);
- return (ffelexHandler) (*next) (t);
- }
-}
-
-/* ffestb_beru4_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN expr [CLOSE_PAREN]
-
- (ffestb_beru4_) // to expression handler
-
- Handle COMMA or EOS/SEMICOLON here.
-
- 15-Feb-91 JCB 1.2
- Now using new mechanism whereby expr comes back as opITEM if the
- expr is considered part (or all) of an I/O control list (and should
- be stripped of its outer opITEM node) or not if it is considered
- a plain unit number that happens to have been enclosed in parens.
- 26-Mar-90 JCB 1.1
- No longer expecting close-paren here because of constructs like
- BACKSPACE (5)+2, so now expecting either COMMA because it was a
- construct like BACKSPACE (5+2,... or EOS/SEMICOLON because it is like
- the former construct. Ah, the vagaries of Fortran. */
-
-static ffelexHandler
-ffestb_beru4_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- bool inlist;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeCLOSE_PAREN:
- if (expr == NULL)
- break;
- if (ffebld_op (expr) == FFEBLD_opITEM)
- {
- inlist = TRUE;
- expr = ffebld_head (expr);
- }
- else
- inlist = FALSE;
- ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_or_val_present
- = TRUE;
- ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_present = FALSE;
- ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_present = TRUE;
- ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_is_label
- = FALSE;
- ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value
- = ffelex_token_use (ft);
- ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].u.expr = expr;
- if (inlist)
- return (ffelexHandler) ffestb_beru9_ (t);
- return (ffelexHandler) ffestb_beru10_ (t);
-
- default:
- break;
- }
-
- ffestb_subr_kill_beru_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_beru5_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN [external-file-unit
- COMMA]
-
- return ffestb_beru5_; // to lexer
-
- Handle expr construct (not NAME=expr construct) here. */
-
-static ffelexHandler
-ffestb_beru5_ (ffelexToken t)
-{
- ffestrGenio kw;
-
- ffestb_local_.beru.label = FALSE;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- kw = ffestr_genio (t);
- switch (kw)
- {
- case FFESTR_genioERR:
- ffestb_local_.beru.ix = FFESTP_beruixERR;
- ffestb_local_.beru.label = TRUE;
- break;
-
- case FFESTR_genioIOSTAT:
- ffestb_local_.beru.ix = FFESTP_beruixIOSTAT;
- ffestb_local_.beru.left = TRUE;
- ffestb_local_.beru.context = FFEEXPR_contextFILEINT;
- break;
-
- case FFESTR_genioUNIT:
- ffestb_local_.beru.ix = FFESTP_beruixUNIT;
- ffestb_local_.beru.left = FALSE;
- ffestb_local_.beru.context = FFEEXPR_contextFILENUM;
- break;
-
- default:
- goto bad; /* :::::::::::::::::::: */
- }
- if (ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
- .kw_or_val_present)
- break; /* Can't specify a keyword twice! */
- ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
- .kw_or_val_present = TRUE;
- ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
- .kw_present = TRUE;
- ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
- .value_present = FALSE;
- ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value_is_label
- = ffestb_local_.beru.label;
- ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].kw
- = ffelex_token_use (t);
- return (ffelexHandler) ffestb_beru6_;
-
- default:
- break;
- }
-
-bad: /* :::::::::::::::::::: */
- ffestb_subr_kill_beru_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_beru6_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN [external-file-unit
- COMMA] NAME
-
- return ffestb_beru6_; // to lexer
-
- Make sure EQUALS here, send next token to expression handler. */
-
-static ffelexHandler
-ffestb_beru6_ (ffelexToken t)
-{
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEQUALS:
- ffesta_confirmed ();
- if (ffestb_local_.beru.label)
- return (ffelexHandler) ffestb_beru8_;
- if (ffestb_local_.beru.left)
- return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
- ffestb_local_.beru.context,
- (ffeexprCallback) ffestb_beru7_);
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- ffestb_local_.beru.context,
- (ffeexprCallback) ffestb_beru7_);
-
- default:
- break;
- }
-
- ffestb_subr_kill_beru_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_beru7_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... NAME EQUALS expr
-
- (ffestb_beru7_) // to expression handler
-
- Handle COMMA or CLOSE_PAREN here. */
-
-static ffelexHandler
-ffestb_beru7_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCLOSE_PAREN:
- if (expr == NULL)
- break;
- ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value_present
- = TRUE;
- ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value
- = ffelex_token_use (ft);
- ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].u.expr = expr;
- if (ffelex_token_type (t) == FFELEX_typeCOMMA)
- return (ffelexHandler) ffestb_beru5_;
- return (ffelexHandler) ffestb_beru10_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_beru_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_beru8_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... NAME EQUALS
-
- return ffestb_beru8_; // to lexer
-
- Handle NUMBER for label here. */
-
-static ffelexHandler
-ffestb_beru8_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNUMBER:
- ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value_present
- = TRUE;
- ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value
- = ffelex_token_use (t);
- return (ffelexHandler) ffestb_beru9_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_beru_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_beru9_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... NAME EQUALS
- NUMBER
-
- return ffestb_beru9_; // to lexer
-
- Handle COMMA or CLOSE_PAREN here. */
-
-static ffelexHandler
-ffestb_beru9_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- return (ffelexHandler) ffestb_beru5_;
-
- case FFELEX_typeCLOSE_PAREN:
- return (ffelexHandler) ffestb_beru10_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_beru_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_beru10_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... CLOSE_PAREN
-
- return ffestb_beru10_; // to lexer
-
- Handle EOS or SEMICOLON here. */
-
-static ffelexHandler
-ffestb_beru10_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- {
- switch (ffesta_first_kw)
- {
- case FFESTR_firstBACKSPACE:
- ffestc_R919 ();
- break;
-
- case FFESTR_firstENDFILE:
- case FFESTR_firstEND:
- ffestc_R920 ();
- break;
-
- case FFESTR_firstREWIND:
- ffestc_R921 ();
- break;
-
-#if FFESTR_VXT
- case FFESTR_firstUNLOCK:
- ffestc_V022 ();
- break;
-#endif
-
- default:
- assert (FALSE);
- }
- }
- ffestb_subr_kill_beru_ ();
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- ffestb_subr_kill_beru_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_vxtcode -- Parse the VXT DECODE/ENCODE statement
-
- return ffestb_vxtcode; // to lexer
-
- Make sure the statement has a valid form for the VXT DECODE/ENCODE
- statement. If it does, implement the statement. */
-
-#if FFESTR_VXT
-ffelexHandler
-ffestb_vxtcode (ffelexToken t)
-{
- ffestpVxtcodeIx ix;
-
- switch (ffelex_token_type (ffesta_tokens[0]))
- {
- case FFELEX_typeNAME:
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeNAME:
- case FFELEX_typeNUMBER:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeOPEN_PAREN:
- for (ix = 0; ix < FFESTP_vxtcodeix; ++ix)
- ffestp_file.vxtcode.vxtcode_spec[ix].kw_or_val_present = FALSE;
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_vxtcode1_);
- }
-
- case FFELEX_typeNAMES:
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeOPEN_PAREN:
- if (ffelex_token_length (ffesta_tokens[0])
- != ffestb_args.vxtcode.len)
- goto bad_0; /* :::::::::::::::::::: */
-
- for (ix = 0; ix < FFESTP_vxtcodeix; ++ix)
- ffestp_file.vxtcode.vxtcode_spec[ix].kw_or_val_present = FALSE;
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_vxtcode1_);
- }
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-}
-
-/* ffestb_vxtcode1_ -- "VXTCODE" OPEN_PAREN expr
-
- (ffestb_vxtcode1_) // to expression handler
-
- Handle COMMA here. */
-
-static ffelexHandler
-ffestb_vxtcode1_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- if (expr == NULL)
- break;
- ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].kw_or_val_present
- = TRUE;
- ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].kw_present = FALSE;
- ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].value_present = TRUE;
- ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].value_is_label
- = FALSE;
- ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].value
- = ffelex_token_use (ft);
- ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].u.expr = expr;
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILEFORMAT, (ffeexprCallback) ffestb_vxtcode2_);
-
- default:
- break;
- }
-
- ffestb_subr_kill_vxtcode_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_vxtcode2_ -- "VXTCODE" OPEN_PAREN expr COMMA expr
-
- (ffestb_vxtcode2_) // to expression handler
-
- Handle COMMA here. */
-
-static ffelexHandler
-ffestb_vxtcode2_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].kw_or_val_present
- = TRUE;
- ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].kw_present = FALSE;
- ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].value_present = TRUE;
- ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].value_is_label
- = (expr == NULL);
- ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].value
- = ffelex_token_use (ft);
- ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].u.expr = expr;
- if (ffesta_first_kw == FFESTR_firstENCODE)
- return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
- FFEEXPR_contextFILEVXTCODE,
- (ffeexprCallback) ffestb_vxtcode3_);
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILEVXTCODE,
- (ffeexprCallback) ffestb_vxtcode3_);
-
- default:
- break;
- }
-
- ffestb_subr_kill_vxtcode_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_vxtcode3_ -- "VXTCODE" OPEN_PAREN expr COMMA expr COMMA expr
-
- (ffestb_vxtcode3_) // to expression handler
-
- Handle COMMA or CLOSE_PAREN here. */
-
-static ffelexHandler
-ffestb_vxtcode3_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCLOSE_PAREN:
- if (expr == NULL)
- break;
- ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].kw_or_val_present
- = TRUE;
- ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].kw_present = FALSE;
- ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].value_present = TRUE;
- ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].value_is_label
- = FALSE;
- ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].value
- = ffelex_token_use (ft);
- ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].u.expr = expr;
- if (ffelex_token_type (t) == FFELEX_typeCOMMA)
- return (ffelexHandler) ffestb_vxtcode4_;
- return (ffelexHandler) ffestb_vxtcode9_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_vxtcode_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_vxtcode4_ -- "VXTCODE" OPEN_PAREN ...
-
- return ffestb_vxtcode4_; // to lexer
-
- Handle NAME=expr construct here. */
-
-static ffelexHandler
-ffestb_vxtcode4_ (ffelexToken t)
-{
- ffestrGenio kw;
-
- ffestb_local_.vxtcode.label = FALSE;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- kw = ffestr_genio (t);
- switch (kw)
- {
- case FFESTR_genioERR:
- ffestb_local_.vxtcode.ix = FFESTP_vxtcodeixERR;
- ffestb_local_.vxtcode.label = TRUE;
- break;
-
- case FFESTR_genioIOSTAT:
- ffestb_local_.vxtcode.ix = FFESTP_vxtcodeixIOSTAT;
- ffestb_local_.vxtcode.left = TRUE;
- ffestb_local_.vxtcode.context = FFEEXPR_contextFILEINT;
- break;
-
- default:
- goto bad; /* :::::::::::::::::::: */
- }
- if (ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix]
- .kw_or_val_present)
- break; /* Can't specify a keyword twice! */
- ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix]
- .kw_or_val_present = TRUE;
- ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix]
- .kw_present = TRUE;
- ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix]
- .value_present = FALSE;
- ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value_is_label
- = ffestb_local_.vxtcode.label;
- ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].kw
- = ffelex_token_use (t);
- return (ffelexHandler) ffestb_vxtcode5_;
-
- default:
- break;
- }
-
-bad: /* :::::::::::::::::::: */
- ffestb_subr_kill_vxtcode_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_vxtcode5_ -- "VXTCODE" OPEN_PAREN [external-file-unit COMMA [format
- COMMA]] NAME
-
- return ffestb_vxtcode5_; // to lexer
-
- Make sure EQUALS here, send next token to expression handler. */
-
-static ffelexHandler
-ffestb_vxtcode5_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEQUALS:
- ffesta_confirmed ();
- if (ffestb_local_.vxtcode.label)
- return (ffelexHandler) ffestb_vxtcode7_;
- if (ffestb_local_.vxtcode.left)
- return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
- ffestb_local_.vxtcode.context,
- (ffeexprCallback) ffestb_vxtcode6_);
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- ffestb_local_.vxtcode.context,
- (ffeexprCallback) ffestb_vxtcode6_);
-
- default:
- break;
- }
-
- ffestb_subr_kill_vxtcode_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_vxtcode6_ -- "VXTCODE" OPEN_PAREN ... NAME EQUALS expr
-
- (ffestb_vxtcode6_) // to expression handler
-
- Handle COMMA or CLOSE_PAREN here. */
-
-static ffelexHandler
-ffestb_vxtcode6_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCLOSE_PAREN:
- if (expr == NULL)
- break;
- ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value_present
- = TRUE;
- ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value
- = ffelex_token_use (ft);
- ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].u.expr = expr;
- if (ffelex_token_type (t) == FFELEX_typeCOMMA)
- return (ffelexHandler) ffestb_vxtcode4_;
- return (ffelexHandler) ffestb_vxtcode9_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_vxtcode_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_vxtcode7_ -- "VXTCODE" OPEN_PAREN ... NAME EQUALS
-
- return ffestb_vxtcode7_; // to lexer
-
- Handle NUMBER for label here. */
-
-static ffelexHandler
-ffestb_vxtcode7_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNUMBER:
- ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value_present
- = TRUE;
- ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value
- = ffelex_token_use (t);
- return (ffelexHandler) ffestb_vxtcode8_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_vxtcode_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_vxtcode8_ -- "VXTCODE" OPEN_PAREN ... NAME EQUALS NUMBER
-
- return ffestb_vxtcode8_; // to lexer
-
- Handle COMMA or CLOSE_PAREN here. */
-
-static ffelexHandler
-ffestb_vxtcode8_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- return (ffelexHandler) ffestb_vxtcode4_;
-
- case FFELEX_typeCLOSE_PAREN:
- return (ffelexHandler) ffestb_vxtcode9_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_vxtcode_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_vxtcode9_ -- "VXTCODE" OPEN_PAREN ... CLOSE_PAREN
-
- return ffestb_vxtcode9_; // to lexer
-
- Handle EOS or SEMICOLON here.
-
- 07-Jun-90 JCB 1.1
- Context for ENCODE/DECODE expressions is now IOLISTDF instead of IOLIST
- since they apply to internal files. */
-
-static ffelexHandler
-ffestb_vxtcode9_ (ffelexToken t)
-{
- ffelexHandler next;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- {
- if (ffesta_first_kw == FFESTR_firstENCODE)
- {
- ffestc_V023_start ();
- ffestc_V023_finish ();
- }
- else
- {
- ffestc_V024_start ();
- ffestc_V024_finish ();
- }
- }
- ffestb_subr_kill_vxtcode_ ();
- return (ffelexHandler) ffesta_zero (t);
-
- case FFELEX_typeNAME:
- case FFELEX_typeOPEN_PAREN:
- case FFELEX_typeCOMMA:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- if (ffesta_first_kw == FFESTR_firstENCODE)
- ffestc_V023_start ();
- else
- ffestc_V024_start ();
- ffestb_subr_kill_vxtcode_ ();
- if (ffesta_first_kw == FFESTR_firstDECODE)
- next = (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
- FFEEXPR_contextIOLISTDF,
- (ffeexprCallback) ffestb_vxtcode10_);
- else
- next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextIOLISTDF,
- (ffeexprCallback) ffestb_vxtcode10_);
-
- /* EXTENSION: Allow an optional preceding COMMA here if not pedantic.
- (f2c provides this extension, as do other compilers, supposedly.) */
-
- if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA))
- return next;
-
- return (ffelexHandler) (*next) (t);
-
- default:
- break;
- }
-
- ffestb_subr_kill_vxtcode_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_vxtcode10_ -- "VXTCODE(...)" expr
-
- (ffestb_vxtcode10_) // to expression handler
-
- Handle COMMA or EOS/SEMICOLON here.
-
- 07-Jun-90 JCB 1.1
- Context for ENCODE/DECODE expressions is now IOLISTDF instead of IOLIST
- since they apply to internal files. */
-
-static ffelexHandler
-ffestb_vxtcode10_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- if (expr == NULL)
- break;
- if (!ffesta_is_inhibited ())
- if (ffesta_first_kw == FFESTR_firstENCODE)
- ffestc_V023_item (expr, ft);
- else
- ffestc_V024_item (expr, ft);
- if (ffesta_first_kw == FFESTR_firstDECODE)
- return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
- FFEEXPR_contextIOLISTDF,
- (ffeexprCallback) ffestb_vxtcode10_);
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextIOLISTDF,
- (ffeexprCallback) ffestb_vxtcode10_);
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (expr == NULL)
- break;
- if (!ffesta_is_inhibited ())
- {
- if (ffesta_first_kw == FFESTR_firstENCODE)
- {
- ffestc_V023_item (expr, ft);
- ffestc_V023_finish ();
- }
- else
- {
- ffestc_V024_item (expr, ft);
- ffestc_V024_finish ();
- }
- }
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- if (!ffesta_is_inhibited ())
- if (ffesta_first_kw == FFESTR_firstENCODE)
- ffestc_V023_finish ();
- else
- ffestc_V024_finish ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-#endif
-/* ffestb_R904 -- Parse an OPEN statement
-
- return ffestb_R904; // to lexer
-
- Make sure the statement has a valid form for an OPEN statement.
- If it does, implement the statement. */
-
-ffelexHandler
-ffestb_R904 (ffelexToken t)
-{
- ffestpOpenIx ix;
-
- switch (ffelex_token_type (ffesta_tokens[0]))
- {
- case FFELEX_typeNAME:
- if (ffesta_first_kw != FFESTR_firstOPEN)
- goto bad_0; /* :::::::::::::::::::: */
- break;
-
- case FFELEX_typeNAMES:
- if (ffesta_first_kw != FFESTR_firstOPEN)
- goto bad_0; /* :::::::::::::::::::: */
- if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlOPEN)
- goto bad_0; /* :::::::::::::::::::: */
- break;
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeOPEN_PAREN:
- break;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
- }
-
- for (ix = 0; ix < FFESTP_openix; ++ix)
- ffestp_file.open.open_spec[ix].kw_or_val_present = FALSE;
-
- return (ffelexHandler) ffestb_R9041_;
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-}
-
-/* ffestb_R9041_ -- "OPEN" OPEN_PAREN
-
- return ffestb_R9041_; // to lexer
-
- Handle expr construct (not NAME=expr construct) here. */
-
-static ffelexHandler
-ffestb_R9041_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_R9042_;
-
- default:
- return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9043_)))
- (t);
- }
-}
-
-/* ffestb_R9042_ -- "OPEN" OPEN_PAREN NAME
-
- return ffestb_R9042_; // to lexer
-
- If EQUALS here, go to states that handle it. Else, send NAME and this
- token thru expression handler. */
-
-static ffelexHandler
-ffestb_R9042_ (ffelexToken t)
-{
- ffelexHandler next;
- ffelexToken nt;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEQUALS:
- nt = ffesta_tokens[1];
- next = (ffelexHandler) ffestb_R9044_ (nt);
- ffelex_token_kill (nt);
- return (ffelexHandler) (*next) (t);
-
- default:
- next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9043_)))
- (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) (*next) (t);
- }
-}
-
-/* ffestb_R9043_ -- "OPEN" OPEN_PAREN expr
-
- (ffestb_R9043_) // to expression handler
-
- Handle COMMA or CLOSE_PAREN here. */
-
-static ffelexHandler
-ffestb_R9043_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCLOSE_PAREN:
- if (expr == NULL)
- break;
- ffestp_file.open.open_spec[FFESTP_openixUNIT].kw_or_val_present
- = TRUE;
- ffestp_file.open.open_spec[FFESTP_openixUNIT].kw_present = FALSE;
- ffestp_file.open.open_spec[FFESTP_openixUNIT].value_present = TRUE;
- ffestp_file.open.open_spec[FFESTP_openixUNIT].value_is_label
- = FALSE;
- ffestp_file.open.open_spec[FFESTP_openixUNIT].value
- = ffelex_token_use (ft);
- ffestp_file.open.open_spec[FFESTP_openixUNIT].u.expr = expr;
- if (ffelex_token_type (t) == FFELEX_typeCOMMA)
- return (ffelexHandler) ffestb_R9044_;
- return (ffelexHandler) ffestb_R9049_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_open_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9044_ -- "OPEN" OPEN_PAREN [external-file-unit COMMA]
-
- return ffestb_R9044_; // to lexer
-
- Handle expr construct (not NAME=expr construct) here. */
-
-static ffelexHandler
-ffestb_R9044_ (ffelexToken t)
-{
- ffestrOpen kw;
-
- ffestb_local_.open.label = FALSE;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- kw = ffestr_open (t);
- switch (kw)
- {
- case FFESTR_openACCESS:
- ffestb_local_.open.ix = FFESTP_openixACCESS;
- ffestb_local_.open.left = FALSE;
- ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
- break;
-
- case FFESTR_openACTION:
- ffestb_local_.open.ix = FFESTP_openixACTION;
- ffestb_local_.open.left = FALSE;
- ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
- break;
-
- case FFESTR_openASSOCIATEVARIABLE:
- ffestb_local_.open.ix = FFESTP_openixASSOCIATEVARIABLE;
- ffestb_local_.open.left = TRUE;
- ffestb_local_.open.context = FFEEXPR_contextFILEASSOC;
- break;
-
- case FFESTR_openBLANK:
- ffestb_local_.open.ix = FFESTP_openixBLANK;
- ffestb_local_.open.left = FALSE;
- ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
- break;
-
- case FFESTR_openBLOCKSIZE:
- ffestb_local_.open.ix = FFESTP_openixBLOCKSIZE;
- ffestb_local_.open.left = FALSE;
- ffestb_local_.open.context = FFEEXPR_contextFILENUM;
- break;
-
- case FFESTR_openBUFFERCOUNT:
- ffestb_local_.open.ix = FFESTP_openixBUFFERCOUNT;
- ffestb_local_.open.left = FALSE;
- ffestb_local_.open.context = FFEEXPR_contextFILENUM;
- break;
-
- case FFESTR_openCARRIAGECONTROL:
- ffestb_local_.open.ix = FFESTP_openixCARRIAGECONTROL;
- ffestb_local_.open.left = FALSE;
- ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
- break;
-
- case FFESTR_openDEFAULTFILE:
- ffestb_local_.open.ix = FFESTP_openixDEFAULTFILE;
- ffestb_local_.open.left = FALSE;
- ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
- break;
-
- case FFESTR_openDELIM:
- ffestb_local_.open.ix = FFESTP_openixDELIM;
- ffestb_local_.open.left = FALSE;
- ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
- break;
-
- case FFESTR_openDISP:
- case FFESTR_openDISPOSE:
- ffestb_local_.open.ix = FFESTP_openixDISPOSE;
- ffestb_local_.open.left = FALSE;
- ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
- break;
-
- case FFESTR_openERR:
- ffestb_local_.open.ix = FFESTP_openixERR;
- ffestb_local_.open.label = TRUE;
- break;
-
- case FFESTR_openEXTENDSIZE:
- ffestb_local_.open.ix = FFESTP_openixEXTENDSIZE;
- ffestb_local_.open.left = FALSE;
- ffestb_local_.open.context = FFEEXPR_contextFILENUM;
- break;
-
- case FFESTR_openFILE:
- case FFESTR_openNAME:
- ffestb_local_.open.ix = FFESTP_openixFILE;
- ffestb_local_.open.left = FALSE;
- ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
- break;
-
- case FFESTR_openFORM:
- ffestb_local_.open.ix = FFESTP_openixFORM;
- ffestb_local_.open.left = FALSE;
- ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
- break;
-
- case FFESTR_openINITIALSIZE:
- ffestb_local_.open.ix = FFESTP_openixINITIALSIZE;
- ffestb_local_.open.left = FALSE;
- ffestb_local_.open.context = FFEEXPR_contextFILENUM;
- break;
-
- case FFESTR_openIOSTAT:
- ffestb_local_.open.ix = FFESTP_openixIOSTAT;
- ffestb_local_.open.left = TRUE;
- ffestb_local_.open.context = FFEEXPR_contextFILEINT;
- break;
-
-#if 0 /* Haven't added support for expression
- context yet (though easy). */
- case FFESTR_openKEY:
- ffestb_local_.open.ix = FFESTP_openixKEY;
- ffestb_local_.open.left = FALSE;
- ffestb_local_.open.context = FFEEXPR_contextFILEKEY;
- break;
-#endif
-
- case FFESTR_openMAXREC:
- ffestb_local_.open.ix = FFESTP_openixMAXREC;
- ffestb_local_.open.left = FALSE;
- ffestb_local_.open.context = FFEEXPR_contextFILENUM;
- break;
-
- case FFESTR_openNOSPANBLOCKS:
- if (ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
- .kw_or_val_present)
- goto bad; /* :::::::::::::::::::: */
- ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
- .kw_or_val_present = TRUE;
- ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
- .kw_present = TRUE;
- ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
- .value_present = FALSE;
- ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS].kw
- = ffelex_token_use (t);
- return (ffelexHandler) ffestb_R9048_;
-
- case FFESTR_openORGANIZATION:
- ffestb_local_.open.ix = FFESTP_openixORGANIZATION;
- ffestb_local_.open.left = FALSE;
- ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
- break;
-
- case FFESTR_openPAD:
- ffestb_local_.open.ix = FFESTP_openixPAD;
- ffestb_local_.open.left = FALSE;
- ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
- break;
-
- case FFESTR_openPOSITION:
- ffestb_local_.open.ix = FFESTP_openixPOSITION;
- ffestb_local_.open.left = FALSE;
- ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
- break;
-
- case FFESTR_openREADONLY:
- if (ffestp_file.open.open_spec[FFESTP_openixREADONLY]
- .kw_or_val_present)
- goto bad; /* :::::::::::::::::::: */
- ffestp_file.open.open_spec[FFESTP_openixREADONLY]
- .kw_or_val_present = TRUE;
- ffestp_file.open.open_spec[FFESTP_openixREADONLY]
- .kw_present = TRUE;
- ffestp_file.open.open_spec[FFESTP_openixREADONLY]
- .value_present = FALSE;
- ffestp_file.open.open_spec[FFESTP_openixREADONLY].kw
- = ffelex_token_use (t);
- return (ffelexHandler) ffestb_R9048_;
-
- case FFESTR_openRECL:
- case FFESTR_openRECORDSIZE:
- ffestb_local_.open.ix = FFESTP_openixRECL;
- ffestb_local_.open.left = FALSE;
- ffestb_local_.open.context = FFEEXPR_contextFILENUM;
- break;
-
- case FFESTR_openRECORDTYPE:
- ffestb_local_.open.ix = FFESTP_openixRECORDTYPE;
- ffestb_local_.open.left = FALSE;
- ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
- break;
-
- case FFESTR_openSHARED:
- if (ffestp_file.open.open_spec[FFESTP_openixSHARED]
- .kw_or_val_present)
- goto bad; /* :::::::::::::::::::: */
- ffestp_file.open.open_spec[FFESTP_openixSHARED]
- .kw_or_val_present = TRUE;
- ffestp_file.open.open_spec[FFESTP_openixSHARED]
- .kw_present = TRUE;
- ffestp_file.open.open_spec[FFESTP_openixSHARED]
- .value_present = FALSE;
- ffestp_file.open.open_spec[FFESTP_openixSHARED].kw
- = ffelex_token_use (t);
- return (ffelexHandler) ffestb_R9048_;
-
- case FFESTR_openSTATUS:
- case FFESTR_openTYPE:
- ffestb_local_.open.ix = FFESTP_openixSTATUS;
- ffestb_local_.open.left = FALSE;
- ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
- break;
-
- case FFESTR_openUNIT:
- ffestb_local_.open.ix = FFESTP_openixUNIT;
- ffestb_local_.open.left = FALSE;
- ffestb_local_.open.context = FFEEXPR_contextFILENUM;
- break;
-
- case FFESTR_openUSEROPEN:
- ffestb_local_.open.ix = FFESTP_openixUSEROPEN;
- ffestb_local_.open.left = TRUE;
- ffestb_local_.open.context = FFEEXPR_contextFILEEXTFUNC;
- break;
-
- default:
- goto bad; /* :::::::::::::::::::: */
- }
- if (ffestp_file.open.open_spec[ffestb_local_.open.ix]
- .kw_or_val_present)
- break; /* Can't specify a keyword twice! */
- ffestp_file.open.open_spec[ffestb_local_.open.ix]
- .kw_or_val_present = TRUE;
- ffestp_file.open.open_spec[ffestb_local_.open.ix]
- .kw_present = TRUE;
- ffestp_file.open.open_spec[ffestb_local_.open.ix]
- .value_present = FALSE;
- ffestp_file.open.open_spec[ffestb_local_.open.ix].value_is_label
- = ffestb_local_.open.label;
- ffestp_file.open.open_spec[ffestb_local_.open.ix].kw
- = ffelex_token_use (t);
- return (ffelexHandler) ffestb_R9045_;
-
- default:
- break;
- }
-
-bad: /* :::::::::::::::::::: */
- ffestb_subr_kill_open_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9045_ -- "OPEN" OPEN_PAREN [external-file-unit COMMA] NAME
-
- return ffestb_R9045_; // to lexer
-
- Make sure EQUALS here, send next token to expression handler. */
-
-static ffelexHandler
-ffestb_R9045_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEQUALS:
- ffesta_confirmed ();
- if (ffestb_local_.open.label)
- return (ffelexHandler) ffestb_R9047_;
- if (ffestb_local_.open.left)
- return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
- ffestb_local_.open.context,
- (ffeexprCallback) ffestb_R9046_);
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- ffestb_local_.open.context,
- (ffeexprCallback) ffestb_R9046_);
-
- default:
- break;
- }
-
- ffestb_subr_kill_open_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9046_ -- "OPEN" OPEN_PAREN ... NAME EQUALS expr
-
- (ffestb_R9046_) // to expression handler
-
- Handle COMMA or CLOSE_PAREN here. */
-
-static ffelexHandler
-ffestb_R9046_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCLOSE_PAREN:
- if (expr == NULL)
- break;
- ffestp_file.open.open_spec[ffestb_local_.open.ix].value_present
- = TRUE;
- ffestp_file.open.open_spec[ffestb_local_.open.ix].value
- = ffelex_token_use (ft);
- ffestp_file.open.open_spec[ffestb_local_.open.ix].u.expr = expr;
- if (ffelex_token_type (t) == FFELEX_typeCOMMA)
- return (ffelexHandler) ffestb_R9044_;
- return (ffelexHandler) ffestb_R9049_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_open_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9047_ -- "OPEN" OPEN_PAREN ... NAME EQUALS
-
- return ffestb_R9047_; // to lexer
-
- Handle NUMBER for label here. */
-
-static ffelexHandler
-ffestb_R9047_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNUMBER:
- ffestp_file.open.open_spec[ffestb_local_.open.ix].value_present
- = TRUE;
- ffestp_file.open.open_spec[ffestb_local_.open.ix].value
- = ffelex_token_use (t);
- return (ffelexHandler) ffestb_R9048_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_open_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9048_ -- "OPEN" OPEN_PAREN ... NAME EQUALS NUMBER
-
- return ffestb_R9048_; // to lexer
-
- Handle COMMA or CLOSE_PAREN here. */
-
-static ffelexHandler
-ffestb_R9048_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- return (ffelexHandler) ffestb_R9044_;
-
- case FFELEX_typeCLOSE_PAREN:
- return (ffelexHandler) ffestb_R9049_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_open_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9049_ -- "OPEN" OPEN_PAREN ... CLOSE_PAREN
-
- return ffestb_R9049_; // to lexer
-
- Handle EOS or SEMICOLON here. */
-
-static ffelexHandler
-ffestb_R9049_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_R904 ();
- ffestb_subr_kill_open_ ();
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- ffestb_subr_kill_open_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R907 -- Parse a CLOSE statement
-
- return ffestb_R907; // to lexer
-
- Make sure the statement has a valid form for a CLOSE statement.
- If it does, implement the statement. */
-
-ffelexHandler
-ffestb_R907 (ffelexToken t)
-{
- ffestpCloseIx ix;
-
- switch (ffelex_token_type (ffesta_tokens[0]))
- {
- case FFELEX_typeNAME:
- if (ffesta_first_kw != FFESTR_firstCLOSE)
- goto bad_0; /* :::::::::::::::::::: */
- break;
-
- case FFELEX_typeNAMES:
- if (ffesta_first_kw != FFESTR_firstCLOSE)
- goto bad_0; /* :::::::::::::::::::: */
- if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlCLOSE)
- goto bad_0; /* :::::::::::::::::::: */
- break;
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeOPEN_PAREN:
- break;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
- }
-
- for (ix = 0; ix < FFESTP_closeix; ++ix)
- ffestp_file.close.close_spec[ix].kw_or_val_present = FALSE;
-
- return (ffelexHandler) ffestb_R9071_;
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-}
-
-/* ffestb_R9071_ -- "CLOSE" OPEN_PAREN
-
- return ffestb_R9071_; // to lexer
-
- Handle expr construct (not NAME=expr construct) here. */
-
-static ffelexHandler
-ffestb_R9071_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_R9072_;
-
- default:
- return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9073_)))
- (t);
- }
-}
-
-/* ffestb_R9072_ -- "CLOSE" OPEN_PAREN NAME
-
- return ffestb_R9072_; // to lexer
-
- If EQUALS here, go to states that handle it. Else, send NAME and this
- token thru expression handler. */
-
-static ffelexHandler
-ffestb_R9072_ (ffelexToken t)
-{
- ffelexHandler next;
- ffelexToken nt;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEQUALS:
- nt = ffesta_tokens[1];
- next = (ffelexHandler) ffestb_R9074_ (nt);
- ffelex_token_kill (nt);
- return (ffelexHandler) (*next) (t);
-
- default:
- next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9073_)))
- (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) (*next) (t);
- }
-}
-
-/* ffestb_R9073_ -- "CLOSE" OPEN_PAREN expr
-
- (ffestb_R9073_) // to expression handler
-
- Handle COMMA or CLOSE_PAREN here. */
-
-static ffelexHandler
-ffestb_R9073_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCLOSE_PAREN:
- if (expr == NULL)
- break;
- ffestp_file.close.close_spec[FFESTP_closeixUNIT].kw_or_val_present
- = TRUE;
- ffestp_file.close.close_spec[FFESTP_closeixUNIT].kw_present = FALSE;
- ffestp_file.close.close_spec[FFESTP_closeixUNIT].value_present = TRUE;
- ffestp_file.close.close_spec[FFESTP_closeixUNIT].value_is_label
- = FALSE;
- ffestp_file.close.close_spec[FFESTP_closeixUNIT].value
- = ffelex_token_use (ft);
- ffestp_file.close.close_spec[FFESTP_closeixUNIT].u.expr = expr;
- if (ffelex_token_type (t) == FFELEX_typeCOMMA)
- return (ffelexHandler) ffestb_R9074_;
- return (ffelexHandler) ffestb_R9079_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_close_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9074_ -- "CLOSE" OPEN_PAREN [external-file-unit COMMA]
-
- return ffestb_R9074_; // to lexer
-
- Handle expr construct (not NAME=expr construct) here. */
-
-static ffelexHandler
-ffestb_R9074_ (ffelexToken t)
-{
- ffestrGenio kw;
-
- ffestb_local_.close.label = FALSE;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- kw = ffestr_genio (t);
- switch (kw)
- {
- case FFESTR_genioERR:
- ffestb_local_.close.ix = FFESTP_closeixERR;
- ffestb_local_.close.label = TRUE;
- break;
-
- case FFESTR_genioIOSTAT:
- ffestb_local_.close.ix = FFESTP_closeixIOSTAT;
- ffestb_local_.close.left = TRUE;
- ffestb_local_.close.context = FFEEXPR_contextFILEINT;
- break;
-
- case FFESTR_genioSTATUS:
- case FFESTR_genioDISP:
- case FFESTR_genioDISPOSE:
- ffestb_local_.close.ix = FFESTP_closeixSTATUS;
- ffestb_local_.close.left = FALSE;
- ffestb_local_.close.context = FFEEXPR_contextFILEDFCHAR;
- break;
-
- case FFESTR_genioUNIT:
- ffestb_local_.close.ix = FFESTP_closeixUNIT;
- ffestb_local_.close.left = FALSE;
- ffestb_local_.close.context = FFEEXPR_contextFILENUM;
- break;
-
- default:
- goto bad; /* :::::::::::::::::::: */
- }
- if (ffestp_file.close.close_spec[ffestb_local_.close.ix]
- .kw_or_val_present)
- break; /* Can't specify a keyword twice! */
- ffestp_file.close.close_spec[ffestb_local_.close.ix]
- .kw_or_val_present = TRUE;
- ffestp_file.close.close_spec[ffestb_local_.close.ix]
- .kw_present = TRUE;
- ffestp_file.close.close_spec[ffestb_local_.close.ix]
- .value_present = FALSE;
- ffestp_file.close.close_spec[ffestb_local_.close.ix].value_is_label
- = ffestb_local_.close.label;
- ffestp_file.close.close_spec[ffestb_local_.close.ix].kw
- = ffelex_token_use (t);
- return (ffelexHandler) ffestb_R9075_;
-
- default:
- break;
- }
-
-bad: /* :::::::::::::::::::: */
- ffestb_subr_kill_close_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9075_ -- "CLOSE" OPEN_PAREN [external-file-unit COMMA] NAME
-
- return ffestb_R9075_; // to lexer
-
- Make sure EQUALS here, send next token to expression handler. */
-
-static ffelexHandler
-ffestb_R9075_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEQUALS:
- ffesta_confirmed ();
- if (ffestb_local_.close.label)
- return (ffelexHandler) ffestb_R9077_;
- if (ffestb_local_.close.left)
- return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
- ffestb_local_.close.context,
- (ffeexprCallback) ffestb_R9076_);
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- ffestb_local_.close.context,
- (ffeexprCallback) ffestb_R9076_);
-
- default:
- break;
- }
-
- ffestb_subr_kill_close_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9076_ -- "CLOSE" OPEN_PAREN ... NAME EQUALS expr
-
- (ffestb_R9076_) // to expression handler
-
- Handle COMMA or CLOSE_PAREN here. */
-
-static ffelexHandler
-ffestb_R9076_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCLOSE_PAREN:
- if (expr == NULL)
- break;
- ffestp_file.close.close_spec[ffestb_local_.close.ix].value_present
- = TRUE;
- ffestp_file.close.close_spec[ffestb_local_.close.ix].value
- = ffelex_token_use (ft);
- ffestp_file.close.close_spec[ffestb_local_.close.ix].u.expr = expr;
- if (ffelex_token_type (t) == FFELEX_typeCOMMA)
- return (ffelexHandler) ffestb_R9074_;
- return (ffelexHandler) ffestb_R9079_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_close_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9077_ -- "CLOSE" OPEN_PAREN ... NAME EQUALS
-
- return ffestb_R9077_; // to lexer
-
- Handle NUMBER for label here. */
-
-static ffelexHandler
-ffestb_R9077_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNUMBER:
- ffestp_file.close.close_spec[ffestb_local_.close.ix].value_present
- = TRUE;
- ffestp_file.close.close_spec[ffestb_local_.close.ix].value
- = ffelex_token_use (t);
- return (ffelexHandler) ffestb_R9078_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_close_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9078_ -- "CLOSE" OPEN_PAREN ... NAME EQUALS NUMBER
-
- return ffestb_R9078_; // to lexer
-
- Handle COMMA or CLOSE_PAREN here. */
-
-static ffelexHandler
-ffestb_R9078_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- return (ffelexHandler) ffestb_R9074_;
-
- case FFELEX_typeCLOSE_PAREN:
- return (ffelexHandler) ffestb_R9079_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_close_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9079_ -- "CLOSE" OPEN_PAREN ... CLOSE_PAREN
-
- return ffestb_R9079_; // to lexer
-
- Handle EOS or SEMICOLON here. */
-
-static ffelexHandler
-ffestb_R9079_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_R907 ();
- ffestb_subr_kill_close_ ();
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- ffestb_subr_kill_close_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R909 -- Parse the READ statement
-
- return ffestb_R909; // to lexer
-
- Make sure the statement has a valid form for the READ
- statement. If it does, implement the statement. */
-
-ffelexHandler
-ffestb_R909 (ffelexToken t)
-{
- ffelexHandler next;
- ffestpReadIx ix;
-
- switch (ffelex_token_type (ffesta_tokens[0]))
- {
- case FFELEX_typeNAME:
- if (ffesta_first_kw != FFESTR_firstREAD)
- goto bad_0; /* :::::::::::::::::::: */
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeEQUALS:
- case FFELEX_typePOINTS:
- case FFELEX_typeCOLON:
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeNAME:
- case FFELEX_typeNUMBER:
- ffesta_confirmed ();
- break;
-
- case FFELEX_typeOPEN_PAREN:
- for (ix = 0; ix < FFESTP_readix; ++ix)
- ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_R9092_;
-
- default:
- break;
- }
-
- for (ix = 0; ix < FFESTP_readix; ++ix)
- ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
- return (ffelexHandler) (*((ffelexHandler)
- ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9091_)))
- (t);
-
- case FFELEX_typeNAMES:
- if (ffesta_first_kw != FFESTR_firstREAD)
- goto bad_0; /* :::::::::::::::::::: */
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeCOMMA:
- ffesta_confirmed ();
- if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlREAD)
- break;
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeEQUALS:
- case FFELEX_typePOINTS:
- case FFELEX_typeCOLON:
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeOPEN_PAREN:
- if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlREAD)
- break;
-
- for (ix = 0; ix < FFESTP_readix; ++ix)
- ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_R9092_;
-
- default:
- break;
- }
- for (ix = 0; ix < FFESTP_readix; ++ix)
- ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
- next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9091_);
- next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
- FFESTR_firstlREAD);
- if (next == NULL)
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero);
- return (ffelexHandler) (*next) (t);
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-}
-
-/* ffestb_R9091_ -- "READ" expr
-
- (ffestb_R9091_) // to expression handler
-
- Make sure the next token is a COMMA or EOS/SEMICOLON. */
-
-static ffelexHandler
-ffestb_R9091_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeCOMMA:
- ffesta_confirmed ();
- ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_or_val_present
- = TRUE;
- ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_present = FALSE;
- ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_present = TRUE;
- ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_is_label
- = (expr == NULL);
- ffestp_file.read.read_spec[FFESTP_readixFORMAT].value
- = ffelex_token_use (ft);
- ffestp_file.read.read_spec[FFESTP_readixFORMAT].u.expr = expr;
- if (!ffesta_is_inhibited ())
- ffestc_R909_start (TRUE);
- ffestb_subr_kill_read_ ();
- if (ffelex_token_type (t) == FFELEX_typeCOMMA)
- return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
- ffestc_context_iolist (),
- (ffeexprCallback) ffestb_R90915_);
- if (!ffesta_is_inhibited ())
- ffestc_R909_finish ();
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- ffestb_subr_kill_read_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9092_ -- "READ" OPEN_PAREN
-
- return ffestb_R9092_; // to lexer
-
- Handle expr construct (not NAME=expr construct) here. */
-
-static ffelexHandler
-ffestb_R9092_ (ffelexToken t)
-{
- ffelexToken nt;
- ffelexHandler next;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[2] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_R9093_;
-
- default:
- nt = ffesta_tokens[1];
- next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILEUNITAMBIG, (ffeexprCallback) ffestb_R9094_)))
- (nt);
- ffelex_token_kill (nt);
- return (ffelexHandler) (*next) (t);
- }
-}
-
-/* ffestb_R9093_ -- "READ" OPEN_PAREN NAME
-
- return ffestb_R9093_; // to lexer
-
- If EQUALS here, go to states that handle it. Else, send NAME and this
- token thru expression handler. */
-
-static ffelexHandler
-ffestb_R9093_ (ffelexToken t)
-{
- ffelexHandler next;
- ffelexToken nt;
- ffelexToken ot;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEQUALS:
- ffelex_token_kill (ffesta_tokens[1]);
- nt = ffesta_tokens[2];
- next = (ffelexHandler) ffestb_R9098_ (nt);
- ffelex_token_kill (nt);
- return (ffelexHandler) (*next) (t);
-
- default:
- nt = ffesta_tokens[1];
- ot = ffesta_tokens[2];
- next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILEUNITAMBIG, (ffeexprCallback) ffestb_R9094_)))
- (nt);
- ffelex_token_kill (nt);
- next = (ffelexHandler) (*next) (ot);
- ffelex_token_kill (ot);
- return (ffelexHandler) (*next) (t);
- }
-}
-
-/* ffestb_R9094_ -- "READ" OPEN_PAREN expr [CLOSE_PAREN]
-
- (ffestb_R9094_) // to expression handler
-
- Handle COMMA or EOS/SEMICOLON here.
-
- 15-Feb-91 JCB 1.1
- Use new ffeexpr mechanism whereby the expr is encased in an opITEM if
- ffeexpr decided it was an item in a control list (hence a unit
- specifier), or a format specifier otherwise. */
-
-static ffelexHandler
-ffestb_R9094_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- if (expr == NULL)
- goto bad; /* :::::::::::::::::::: */
-
- if (ffebld_op (expr) != FFEBLD_opITEM)
- {
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_or_val_present
- = TRUE;
- ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_present = FALSE;
- ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_present = TRUE;
- ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_is_label
- = FALSE;
- ffestp_file.read.read_spec[FFESTP_readixFORMAT].value
- = ffelex_token_use (ft);
- ffestp_file.read.read_spec[FFESTP_readixFORMAT].u.expr = expr;
- if (!ffesta_is_inhibited ())
- ffestc_R909_start (TRUE);
- ffestb_subr_kill_read_ ();
- if (ffelex_token_type (t) == FFELEX_typeCOMMA)
- return (ffelexHandler)
- ffeexpr_lhs (ffesta_output_pool,
- ffestc_context_iolist (),
- (ffeexprCallback) ffestb_R90915_);
- if (!ffesta_is_inhibited ())
- ffestc_R909_finish ();
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- goto bad; /* :::::::::::::::::::: */
- }
- }
-
- expr = ffebld_head (expr);
-
- if (expr == NULL)
- goto bad; /* :::::::::::::::::::: */
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCLOSE_PAREN:
- ffestp_file.read.read_spec[FFESTP_readixUNIT].kw_or_val_present
- = TRUE;
- ffestp_file.read.read_spec[FFESTP_readixUNIT].kw_present = FALSE;
- ffestp_file.read.read_spec[FFESTP_readixUNIT].value_present = TRUE;
- ffestp_file.read.read_spec[FFESTP_readixUNIT].value_is_label
- = FALSE;
- ffestp_file.read.read_spec[FFESTP_readixUNIT].value
- = ffelex_token_use (ft);
- ffestp_file.read.read_spec[FFESTP_readixUNIT].u.expr = expr;
- if (ffelex_token_type (t) == FFELEX_typeCOMMA)
- return (ffelexHandler) ffestb_R9095_;
- return (ffelexHandler) ffestb_R90913_;
-
- default:
- break;
- }
-
-bad: /* :::::::::::::::::::: */
- ffestb_subr_kill_read_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9095_ -- "READ" OPEN_PAREN expr COMMA
-
- return ffestb_R9095_; // to lexer
-
- Handle expr construct (not NAME=expr construct) here. */
-
-static ffelexHandler
-ffestb_R9095_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_R9096_;
-
- default:
- return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9097_)))
- (t);
- }
-}
-
-/* ffestb_R9096_ -- "READ" OPEN_PAREN expr COMMA NAME
-
- return ffestb_R9096_; // to lexer
-
- If EQUALS here, go to states that handle it. Else, send NAME and this
- token thru expression handler. */
-
-static ffelexHandler
-ffestb_R9096_ (ffelexToken t)
-{
- ffelexHandler next;
- ffelexToken nt;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEQUALS:
- nt = ffesta_tokens[1];
- next = (ffelexHandler) ffestb_R9098_ (nt);
- ffelex_token_kill (nt);
- return (ffelexHandler) (*next) (t);
-
- default:
- nt = ffesta_tokens[1];
- next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9097_)))
- (nt);
- ffelex_token_kill (nt);
- return (ffelexHandler) (*next) (t);
- }
-}
-
-/* ffestb_R9097_ -- "READ" OPEN_PAREN expr COMMA expr
-
- (ffestb_R9097_) // to expression handler
-
- Handle COMMA or CLOSE_PAREN here. */
-
-static ffelexHandler
-ffestb_R9097_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCLOSE_PAREN:
- ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_or_val_present
- = TRUE;
- ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_present = FALSE;
- ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_present = TRUE;
- ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_is_label
- = (expr == NULL);
- ffestp_file.read.read_spec[FFESTP_readixFORMAT].value
- = ffelex_token_use (ft);
- ffestp_file.read.read_spec[FFESTP_readixFORMAT].u.expr = expr;
- if (ffelex_token_type (t) == FFELEX_typeCOMMA)
- return (ffelexHandler) ffestb_R9098_;
- return (ffelexHandler) ffestb_R90913_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_read_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9098_ -- "READ" OPEN_PAREN [external-file-unit COMMA [format
- COMMA]]
-
- return ffestb_R9098_; // to lexer
-
- Handle expr construct (not NAME=expr construct) here. */
-
-static ffelexHandler
-ffestb_R9098_ (ffelexToken t)
-{
- ffestrGenio kw;
-
- ffestb_local_.read.label = FALSE;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- kw = ffestr_genio (t);
- switch (kw)
- {
- case FFESTR_genioADVANCE:
- ffestb_local_.read.ix = FFESTP_readixADVANCE;
- ffestb_local_.read.left = FALSE;
- ffestb_local_.read.context = FFEEXPR_contextFILEDFCHAR;
- break;
-
- case FFESTR_genioEOR:
- ffestb_local_.read.ix = FFESTP_readixEOR;
- ffestb_local_.read.label = TRUE;
- break;
-
- case FFESTR_genioERR:
- ffestb_local_.read.ix = FFESTP_readixERR;
- ffestb_local_.read.label = TRUE;
- break;
-
- case FFESTR_genioEND:
- ffestb_local_.read.ix = FFESTP_readixEND;
- ffestb_local_.read.label = TRUE;
- break;
-
- case FFESTR_genioFMT:
- ffestb_local_.read.ix = FFESTP_readixFORMAT;
- ffestb_local_.read.left = FALSE;
- ffestb_local_.read.context = FFEEXPR_contextFILEFORMAT;
- break;
-
- case FFESTR_genioIOSTAT:
- ffestb_local_.read.ix = FFESTP_readixIOSTAT;
- ffestb_local_.read.left = TRUE;
- ffestb_local_.read.context = FFEEXPR_contextFILEINT;
- break;
-
- case FFESTR_genioKEY:
- case FFESTR_genioKEYEQ:
- ffestb_local_.read.ix = FFESTP_readixKEYEQ;
- ffestb_local_.read.left = FALSE;
- ffestb_local_.read.context = FFEEXPR_contextFILENUMCHAR;
- break;
-
- case FFESTR_genioKEYGE:
- ffestb_local_.read.ix = FFESTP_readixKEYGE;
- ffestb_local_.read.left = FALSE;
- ffestb_local_.read.context = FFEEXPR_contextFILENUMCHAR;
- break;
-
- case FFESTR_genioKEYGT:
- ffestb_local_.read.ix = FFESTP_readixKEYGT;
- ffestb_local_.read.left = FALSE;
- ffestb_local_.read.context = FFEEXPR_contextFILENUMCHAR;
- break;
-
- case FFESTR_genioKEYID:
- ffestb_local_.read.ix = FFESTP_readixKEYID;
- ffestb_local_.read.left = FALSE;
- ffestb_local_.read.context = FFEEXPR_contextFILENUM;
- break;
-
- case FFESTR_genioNML:
- ffestb_local_.read.ix = FFESTP_readixFORMAT;
- ffestb_local_.read.left = TRUE;
- ffestb_local_.read.context = FFEEXPR_contextFILENAMELIST;
- break;
-
- case FFESTR_genioNULLS:
- ffestb_local_.read.ix = FFESTP_readixNULLS;
- ffestb_local_.read.left = TRUE;
- ffestb_local_.read.context = FFEEXPR_contextFILEINT;
- break;
-
- case FFESTR_genioREC:
- ffestb_local_.read.ix = FFESTP_readixREC;
- ffestb_local_.read.left = FALSE;
- ffestb_local_.read.context = FFEEXPR_contextFILENUM;
- break;
-
- case FFESTR_genioSIZE:
- ffestb_local_.read.ix = FFESTP_readixSIZE;
- ffestb_local_.read.left = TRUE;
- ffestb_local_.read.context = FFEEXPR_contextFILEINT;
- break;
-
- case FFESTR_genioUNIT:
- ffestb_local_.read.ix = FFESTP_readixUNIT;
- ffestb_local_.read.left = FALSE;
- ffestb_local_.read.context = FFEEXPR_contextFILEUNIT;
- break;
-
- default:
- goto bad; /* :::::::::::::::::::: */
- }
- if (ffestp_file.read.read_spec[ffestb_local_.read.ix]
- .kw_or_val_present)
- break; /* Can't specify a keyword twice! */
- ffestp_file.read.read_spec[ffestb_local_.read.ix]
- .kw_or_val_present = TRUE;
- ffestp_file.read.read_spec[ffestb_local_.read.ix]
- .kw_present = TRUE;
- ffestp_file.read.read_spec[ffestb_local_.read.ix]
- .value_present = FALSE;
- ffestp_file.read.read_spec[ffestb_local_.read.ix].value_is_label
- = ffestb_local_.read.label;
- ffestp_file.read.read_spec[ffestb_local_.read.ix].kw
- = ffelex_token_use (t);
- return (ffelexHandler) ffestb_R9099_;
-
- default:
- break;
- }
-
-bad: /* :::::::::::::::::::: */
- ffestb_subr_kill_read_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9099_ -- "READ" OPEN_PAREN [external-file-unit COMMA [format
- COMMA]] NAME
-
- return ffestb_R9099_; // to lexer
-
- Make sure EQUALS here, send next token to expression handler. */
-
-static ffelexHandler
-ffestb_R9099_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEQUALS:
- ffesta_confirmed ();
- if (ffestb_local_.read.label)
- return (ffelexHandler) ffestb_R90911_;
- if (ffestb_local_.read.left)
- return (ffelexHandler)
- ffeexpr_lhs (ffesta_output_pool,
- ffestb_local_.read.context,
- (ffeexprCallback) ffestb_R90910_);
- return (ffelexHandler)
- ffeexpr_rhs (ffesta_output_pool,
- ffestb_local_.read.context,
- (ffeexprCallback) ffestb_R90910_);
-
- default:
- break;
- }
-
- ffestb_subr_kill_read_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R90910_ -- "READ" OPEN_PAREN ... NAME EQUALS expr
-
- (ffestb_R90910_) // to expression handler
-
- Handle COMMA or CLOSE_PAREN here. */
-
-static ffelexHandler
-ffestb_R90910_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCLOSE_PAREN:
- if (expr == NULL)
- {
- if (ffestb_local_.read.context == FFEEXPR_contextFILEFORMAT)
- ffestp_file.read.read_spec[ffestb_local_.read.ix]
- .value_is_label = TRUE;
- else
- break;
- }
- ffestp_file.read.read_spec[ffestb_local_.read.ix].value_present
- = TRUE;
- ffestp_file.read.read_spec[ffestb_local_.read.ix].value
- = ffelex_token_use (ft);
- ffestp_file.read.read_spec[ffestb_local_.read.ix].u.expr = expr;
- if (ffelex_token_type (t) == FFELEX_typeCOMMA)
- return (ffelexHandler) ffestb_R9098_;
- return (ffelexHandler) ffestb_R90913_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_read_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R90911_ -- "READ" OPEN_PAREN ... NAME EQUALS
-
- return ffestb_R90911_; // to lexer
-
- Handle NUMBER for label here. */
-
-static ffelexHandler
-ffestb_R90911_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNUMBER:
- ffestp_file.read.read_spec[ffestb_local_.read.ix].value_present
- = TRUE;
- ffestp_file.read.read_spec[ffestb_local_.read.ix].value
- = ffelex_token_use (t);
- return (ffelexHandler) ffestb_R90912_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_read_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R90912_ -- "READ" OPEN_PAREN ... NAME EQUALS NUMBER
-
- return ffestb_R90912_; // to lexer
-
- Handle COMMA or CLOSE_PAREN here. */
-
-static ffelexHandler
-ffestb_R90912_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- return (ffelexHandler) ffestb_R9098_;
-
- case FFELEX_typeCLOSE_PAREN:
- return (ffelexHandler) ffestb_R90913_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_read_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R90913_ -- "READ" OPEN_PAREN ... CLOSE_PAREN
-
- return ffestb_R90913_; // to lexer
-
- Handle EOS or SEMICOLON here.
-
- 15-Feb-91 JCB 1.1
- Fix to allow implied-DO construct here (OPEN_PAREN) -- actually,
- don't presume knowledge of what an initial token in an lhs context
- is going to be, let ffeexpr_lhs handle that as much as possible. */
-
-static ffelexHandler
-ffestb_R90913_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- {
- ffestc_R909_start (FALSE);
- ffestc_R909_finish ();
- }
- ffestb_subr_kill_read_ ();
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- ffesta_confirmed ();
- /* Fall through. */
- case FFELEX_typeOPEN_PAREN: /* Could still be assignment!! */
- break;
- }
-
- /* If token isn't NAME or OPEN_PAREN, ffeexpr_lhs will ultimately whine
- about it, so leave it up to that code. */
-
- /* EXTENSION: Allow an optional preceding COMMA here if not pedantic. (f2c
- provides this extension, as do other compilers, supposedly.) */
-
- if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA))
- return (ffelexHandler)
- ffeexpr_lhs (ffesta_output_pool,
- ffestc_context_iolist (),
- (ffeexprCallback) ffestb_R90914_);
-
- return (ffelexHandler) (*((ffelexHandler)
- ffeexpr_lhs (ffesta_output_pool,
- ffestc_context_iolist (),
- (ffeexprCallback) ffestb_R90914_)))
- (t);
-}
-
-/* ffestb_R90914_ -- "READ(...)" expr
-
- (ffestb_R90914_) // to expression handler
-
- Handle COMMA or EOS/SEMICOLON here. */
-
-static ffelexHandler
-ffestb_R90914_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- if (expr == NULL)
- break;
-
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_R909_start (FALSE);
- ffestb_subr_kill_read_ ();
-
- if (!ffesta_is_inhibited ())
- ffestc_R909_item (expr, ft);
- return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
- ffestc_context_iolist (),
- (ffeexprCallback) ffestb_R90915_);
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (expr == NULL)
- break;
-
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_R909_start (FALSE);
- ffestb_subr_kill_read_ ();
-
- if (!ffesta_is_inhibited ())
- {
- ffestc_R909_item (expr, ft);
- ffestc_R909_finish ();
- }
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- ffestb_subr_kill_read_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R90915_ -- "READ(...)" expr COMMA expr
-
- (ffestb_R90915_) // to expression handler
-
- Handle COMMA or EOS/SEMICOLON here. */
-
-static ffelexHandler
-ffestb_R90915_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- if (expr == NULL)
- break;
- if (!ffesta_is_inhibited ())
- ffestc_R909_item (expr, ft);
- return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
- ffestc_context_iolist (),
- (ffeexprCallback) ffestb_R90915_);
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (expr == NULL)
- break;
- if (!ffesta_is_inhibited ())
- {
- ffestc_R909_item (expr, ft);
- ffestc_R909_finish ();
- }
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- if (!ffesta_is_inhibited ())
- ffestc_R909_finish ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R910 -- Parse the WRITE statement
-
- return ffestb_R910; // to lexer
-
- Make sure the statement has a valid form for the WRITE
- statement. If it does, implement the statement. */
-
-ffelexHandler
-ffestb_R910 (ffelexToken t)
-{
- ffestpWriteIx ix;
-
- switch (ffelex_token_type (ffesta_tokens[0]))
- {
- case FFELEX_typeNAME:
- if (ffesta_first_kw != FFESTR_firstWRITE)
- goto bad_0; /* :::::::::::::::::::: */
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeNAME:
- case FFELEX_typeNUMBER:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeOPEN_PAREN:
- for (ix = 0; ix < FFESTP_writeix; ++ix)
- ffestp_file.write.write_spec[ix].kw_or_val_present = FALSE;
- return (ffelexHandler) ffestb_R9101_;
- }
-
- case FFELEX_typeNAMES:
- if (ffesta_first_kw != FFESTR_firstWRITE)
- goto bad_0; /* :::::::::::::::::::: */
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeOPEN_PAREN:
- if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlWRITE)
- goto bad_0; /* :::::::::::::::::::: */
-
- for (ix = 0; ix < FFESTP_writeix; ++ix)
- ffestp_file.write.write_spec[ix].kw_or_val_present = FALSE;
- return (ffelexHandler) ffestb_R9101_;
- }
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-}
-
-/* ffestb_R9101_ -- "WRITE" OPEN_PAREN
-
- return ffestb_R9101_; // to lexer
-
- Handle expr construct (not NAME=expr construct) here. */
-
-static ffelexHandler
-ffestb_R9101_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_R9102_;
-
- default:
- return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILEUNIT, (ffeexprCallback) ffestb_R9103_)))
- (t);
- }
-}
-
-/* ffestb_R9102_ -- "WRITE" OPEN_PAREN NAME
-
- return ffestb_R9102_; // to lexer
-
- If EQUALS here, go to states that handle it. Else, send NAME and this
- token thru expression handler. */
-
-static ffelexHandler
-ffestb_R9102_ (ffelexToken t)
-{
- ffelexHandler next;
- ffelexToken nt;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEQUALS:
- nt = ffesta_tokens[1];
- next = (ffelexHandler) ffestb_R9107_ (nt);
- ffelex_token_kill (nt);
- return (ffelexHandler) (*next) (t);
-
- default:
- nt = ffesta_tokens[1];
- next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILEUNIT, (ffeexprCallback) ffestb_R9103_)))
- (nt);
- ffelex_token_kill (nt);
- return (ffelexHandler) (*next) (t);
- }
-}
-
-/* ffestb_R9103_ -- "WRITE" OPEN_PAREN expr [CLOSE_PAREN]
-
- (ffestb_R9103_) // to expression handler
-
- Handle COMMA or EOS/SEMICOLON here. */
-
-static ffelexHandler
-ffestb_R9103_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCLOSE_PAREN:
- if (expr == NULL)
- break;
- ffestp_file.write.write_spec[FFESTP_writeixUNIT].kw_or_val_present
- = TRUE;
- ffestp_file.write.write_spec[FFESTP_writeixUNIT].kw_present = FALSE;
- ffestp_file.write.write_spec[FFESTP_writeixUNIT].value_present = TRUE;
- ffestp_file.write.write_spec[FFESTP_writeixUNIT].value_is_label
- = FALSE;
- ffestp_file.write.write_spec[FFESTP_writeixUNIT].value
- = ffelex_token_use (ft);
- ffestp_file.write.write_spec[FFESTP_writeixUNIT].u.expr = expr;
- if (ffelex_token_type (t) == FFELEX_typeCOMMA)
- return (ffelexHandler) ffestb_R9104_;
- return (ffelexHandler) ffestb_R91012_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_write_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9104_ -- "WRITE" OPEN_PAREN expr COMMA
-
- return ffestb_R9104_; // to lexer
-
- Handle expr construct (not NAME=expr construct) here. */
-
-static ffelexHandler
-ffestb_R9104_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_R9105_;
-
- default:
- return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9106_)))
- (t);
- }
-}
-
-/* ffestb_R9105_ -- "WRITE" OPEN_PAREN expr COMMA NAME
-
- return ffestb_R9105_; // to lexer
-
- If EQUALS here, go to states that handle it. Else, send NAME and this
- token thru expression handler. */
-
-static ffelexHandler
-ffestb_R9105_ (ffelexToken t)
-{
- ffelexHandler next;
- ffelexToken nt;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEQUALS:
- nt = ffesta_tokens[1];
- next = (ffelexHandler) ffestb_R9107_ (nt);
- ffelex_token_kill (nt);
- return (ffelexHandler) (*next) (t);
-
- default:
- nt = ffesta_tokens[1];
- next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9106_)))
- (nt);
- ffelex_token_kill (nt);
- return (ffelexHandler) (*next) (t);
- }
-}
-
-/* ffestb_R9106_ -- "WRITE" OPEN_PAREN expr COMMA expr
-
- (ffestb_R9106_) // to expression handler
-
- Handle COMMA or CLOSE_PAREN here. */
-
-static ffelexHandler
-ffestb_R9106_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCLOSE_PAREN:
- ffestp_file.write.write_spec[FFESTP_writeixFORMAT].kw_or_val_present
- = TRUE;
- ffestp_file.write.write_spec[FFESTP_writeixFORMAT].kw_present = FALSE;
- ffestp_file.write.write_spec[FFESTP_writeixFORMAT].value_present = TRUE;
- ffestp_file.write.write_spec[FFESTP_writeixFORMAT].value_is_label
- = (expr == NULL);
- ffestp_file.write.write_spec[FFESTP_writeixFORMAT].value
- = ffelex_token_use (ft);
- ffestp_file.write.write_spec[FFESTP_writeixFORMAT].u.expr = expr;
- if (ffelex_token_type (t) == FFELEX_typeCOMMA)
- return (ffelexHandler) ffestb_R9107_;
- return (ffelexHandler) ffestb_R91012_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_write_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9107_ -- "WRITE" OPEN_PAREN [external-file-unit COMMA [format
- COMMA]]
-
- return ffestb_R9107_; // to lexer
-
- Handle expr construct (not NAME=expr construct) here. */
-
-static ffelexHandler
-ffestb_R9107_ (ffelexToken t)
-{
- ffestrGenio kw;
-
- ffestb_local_.write.label = FALSE;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- kw = ffestr_genio (t);
- switch (kw)
- {
- case FFESTR_genioADVANCE:
- ffestb_local_.write.ix = FFESTP_writeixADVANCE;
- ffestb_local_.write.left = FALSE;
- ffestb_local_.write.context = FFEEXPR_contextFILEDFCHAR;
- break;
-
- case FFESTR_genioEOR:
- ffestb_local_.write.ix = FFESTP_writeixEOR;
- ffestb_local_.write.label = TRUE;
- break;
-
- case FFESTR_genioERR:
- ffestb_local_.write.ix = FFESTP_writeixERR;
- ffestb_local_.write.label = TRUE;
- break;
-
- case FFESTR_genioFMT:
- ffestb_local_.write.ix = FFESTP_writeixFORMAT;
- ffestb_local_.write.left = FALSE;
- ffestb_local_.write.context = FFEEXPR_contextFILEFORMAT;
- break;
-
- case FFESTR_genioIOSTAT:
- ffestb_local_.write.ix = FFESTP_writeixIOSTAT;
- ffestb_local_.write.left = TRUE;
- ffestb_local_.write.context = FFEEXPR_contextFILEINT;
- break;
-
- case FFESTR_genioNML:
- ffestb_local_.write.ix = FFESTP_writeixFORMAT;
- ffestb_local_.write.left = TRUE;
- ffestb_local_.write.context = FFEEXPR_contextFILENAMELIST;
- break;
-
- case FFESTR_genioREC:
- ffestb_local_.write.ix = FFESTP_writeixREC;
- ffestb_local_.write.left = FALSE;
- ffestb_local_.write.context = FFEEXPR_contextFILENUM;
- break;
-
- case FFESTR_genioUNIT:
- ffestb_local_.write.ix = FFESTP_writeixUNIT;
- ffestb_local_.write.left = FALSE;
- ffestb_local_.write.context = FFEEXPR_contextFILEUNIT;
- break;
-
- default:
- goto bad; /* :::::::::::::::::::: */
- }
- if (ffestp_file.write.write_spec[ffestb_local_.write.ix]
- .kw_or_val_present)
- break; /* Can't specify a keyword twice! */
- ffestp_file.write.write_spec[ffestb_local_.write.ix]
- .kw_or_val_present = TRUE;
- ffestp_file.write.write_spec[ffestb_local_.write.ix]
- .kw_present = TRUE;
- ffestp_file.write.write_spec[ffestb_local_.write.ix]
- .value_present = FALSE;
- ffestp_file.write.write_spec[ffestb_local_.write.ix].value_is_label
- = ffestb_local_.write.label;
- ffestp_file.write.write_spec[ffestb_local_.write.ix].kw
- = ffelex_token_use (t);
- return (ffelexHandler) ffestb_R9108_;
-
- default:
- break;
- }
-
-bad: /* :::::::::::::::::::: */
- ffestb_subr_kill_write_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9108_ -- "WRITE" OPEN_PAREN [external-file-unit COMMA [format
- COMMA]] NAME
-
- return ffestb_R9108_; // to lexer
-
- Make sure EQUALS here, send next token to expression handler. */
-
-static ffelexHandler
-ffestb_R9108_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEQUALS:
- ffesta_confirmed ();
- if (ffestb_local_.write.label)
- return (ffelexHandler) ffestb_R91010_;
- if (ffestb_local_.write.left)
- return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
- ffestb_local_.write.context,
- (ffeexprCallback) ffestb_R9109_);
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- ffestb_local_.write.context,
- (ffeexprCallback) ffestb_R9109_);
-
- default:
- break;
- }
-
- ffestb_subr_kill_write_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9109_ -- "WRITE" OPEN_PAREN ... NAME EQUALS expr
-
- (ffestb_R9109_) // to expression handler
-
- Handle COMMA or CLOSE_PAREN here. */
-
-static ffelexHandler
-ffestb_R9109_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCLOSE_PAREN:
- if (expr == NULL)
- {
- if (ffestb_local_.write.context == FFEEXPR_contextFILEFORMAT)
- ffestp_file.write.write_spec[ffestb_local_.write.ix]
- .value_is_label = TRUE;
- else
- break;
- }
- ffestp_file.write.write_spec[ffestb_local_.write.ix].value_present
- = TRUE;
- ffestp_file.write.write_spec[ffestb_local_.write.ix].value
- = ffelex_token_use (ft);
- ffestp_file.write.write_spec[ffestb_local_.write.ix].u.expr = expr;
- if (ffelex_token_type (t) == FFELEX_typeCOMMA)
- return (ffelexHandler) ffestb_R9107_;
- return (ffelexHandler) ffestb_R91012_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_write_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R91010_ -- "WRITE" OPEN_PAREN ... NAME EQUALS
-
- return ffestb_R91010_; // to lexer
-
- Handle NUMBER for label here. */
-
-static ffelexHandler
-ffestb_R91010_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNUMBER:
- ffestp_file.write.write_spec[ffestb_local_.write.ix].value_present
- = TRUE;
- ffestp_file.write.write_spec[ffestb_local_.write.ix].value
- = ffelex_token_use (t);
- return (ffelexHandler) ffestb_R91011_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_write_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R91011_ -- "WRITE" OPEN_PAREN ... NAME EQUALS NUMBER
-
- return ffestb_R91011_; // to lexer
-
- Handle COMMA or CLOSE_PAREN here. */
-
-static ffelexHandler
-ffestb_R91011_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- return (ffelexHandler) ffestb_R9107_;
-
- case FFELEX_typeCLOSE_PAREN:
- return (ffelexHandler) ffestb_R91012_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_write_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R91012_ -- "WRITE" OPEN_PAREN ... CLOSE_PAREN
-
- return ffestb_R91012_; // to lexer
-
- Handle EOS or SEMICOLON here. */
-
-static ffelexHandler
-ffestb_R91012_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- {
- ffestc_R910_start ();
- ffestc_R910_finish ();
- }
- ffestb_subr_kill_write_ ();
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- ffesta_confirmed ();
- /* Fall through. */
- case FFELEX_typeOPEN_PAREN: /* Could still be assignment!! */
-
- /* EXTENSION: Allow an optional preceding COMMA here if not pedantic.
- (f2c provides this extension, as do other compilers, supposedly.) */
-
- if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA))
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- ffestc_context_iolist (), (ffeexprCallback) ffestb_R91013_);
-
- return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- ffestc_context_iolist (), (ffeexprCallback) ffestb_R91013_)))
- (t);
-
- case FFELEX_typeEQUALS:
- case FFELEX_typePOINTS:
- break;
- }
-
- ffestb_subr_kill_write_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R91013_ -- "WRITE(...)" expr
-
- (ffestb_R91013_) // to expression handler
-
- Handle COMMA or EOS/SEMICOLON here. */
-
-static ffelexHandler
-ffestb_R91013_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- if (expr == NULL)
- break;
-
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_R910_start ();
- ffestb_subr_kill_write_ ();
-
- if (!ffesta_is_inhibited ())
- ffestc_R910_item (expr, ft);
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- ffestc_context_iolist (), (ffeexprCallback) ffestb_R91014_);
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (expr == NULL)
- break;
-
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_R910_start ();
- ffestb_subr_kill_write_ ();
-
- if (!ffesta_is_inhibited ())
- {
- ffestc_R910_item (expr, ft);
- ffestc_R910_finish ();
- }
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- ffestb_subr_kill_write_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R91014_ -- "WRITE(...)" expr COMMA expr
-
- (ffestb_R91014_) // to expression handler
-
- Handle COMMA or EOS/SEMICOLON here. */
-
-static ffelexHandler
-ffestb_R91014_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- if (expr == NULL)
- break;
- if (!ffesta_is_inhibited ())
- ffestc_R910_item (expr, ft);
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- ffestc_context_iolist (), (ffeexprCallback) ffestb_R91014_);
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (expr == NULL)
- break;
- if (!ffesta_is_inhibited ())
- {
- ffestc_R910_item (expr, ft);
- ffestc_R910_finish ();
- }
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- if (!ffesta_is_inhibited ())
- ffestc_R910_finish ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R911 -- Parse the PRINT statement
-
- return ffestb_R911; // to lexer
-
- Make sure the statement has a valid form for the PRINT
- statement. If it does, implement the statement. */
-
-ffelexHandler
-ffestb_R911 (ffelexToken t)
-{
- ffelexHandler next;
- ffestpPrintIx ix;
-
- switch (ffelex_token_type (ffesta_tokens[0]))
- {
- case FFELEX_typeNAME:
- if (ffesta_first_kw != FFESTR_firstPRINT)
- goto bad_0; /* :::::::::::::::::::: */
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeEQUALS:
- case FFELEX_typePOINTS:
- case FFELEX_typeCOLON:
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeNAME:
- case FFELEX_typeNUMBER:
- ffesta_confirmed ();
- break;
-
- default:
- break;
- }
-
- for (ix = 0; ix < FFESTP_printix; ++ix)
- ffestp_file.print.print_spec[ix].kw_or_val_present = FALSE;
- return (ffelexHandler) (*((ffelexHandler)
- ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9111_)))
- (t);
-
- case FFELEX_typeNAMES:
- if (ffesta_first_kw != FFESTR_firstPRINT)
- goto bad_0; /* :::::::::::::::::::: */
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeCOMMA:
- ffesta_confirmed ();
- if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlPRINT)
- break;
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeEQUALS:
- case FFELEX_typePOINTS:
- case FFELEX_typeCOLON:
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- break;
- }
- for (ix = 0; ix < FFESTP_printix; ++ix)
- ffestp_file.print.print_spec[ix].kw_or_val_present = FALSE;
- next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9111_);
- next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
- FFESTR_firstlPRINT);
- if (next == NULL)
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero);
- return (ffelexHandler) (*next) (t);
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-}
-
-/* ffestb_R9111_ -- "PRINT" expr
-
- (ffestb_R9111_) // to expression handler
-
- Make sure the next token is a COMMA or EOS/SEMICOLON. */
-
-static ffelexHandler
-ffestb_R9111_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeCOMMA:
- ffesta_confirmed ();
- ffestp_file.print.print_spec[FFESTP_printixFORMAT].kw_or_val_present
- = TRUE;
- ffestp_file.print.print_spec[FFESTP_printixFORMAT].kw_present = FALSE;
- ffestp_file.print.print_spec[FFESTP_printixFORMAT].value_present = TRUE;
- ffestp_file.print.print_spec[FFESTP_printixFORMAT].value_is_label
- = (expr == NULL);
- ffestp_file.print.print_spec[FFESTP_printixFORMAT].value
- = ffelex_token_use (ft);
- ffestp_file.print.print_spec[FFESTP_printixFORMAT].u.expr = expr;
- if (!ffesta_is_inhibited ())
- ffestc_R911_start ();
- ffestb_subr_kill_print_ ();
- if (ffelex_token_type (t) == FFELEX_typeCOMMA)
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R9112_);
- if (!ffesta_is_inhibited ())
- ffestc_R911_finish ();
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- ffestb_subr_kill_print_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9112_ -- "PRINT" expr COMMA expr
-
- (ffestb_R9112_) // to expression handler
-
- Handle COMMA or EOS/SEMICOLON here. */
-
-static ffelexHandler
-ffestb_R9112_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- if (expr == NULL)
- break;
- if (!ffesta_is_inhibited ())
- ffestc_R911_item (expr, ft);
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R9112_);
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (expr == NULL)
- break;
- if (!ffesta_is_inhibited ())
- {
- ffestc_R911_item (expr, ft);
- ffestc_R911_finish ();
- }
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- if (!ffesta_is_inhibited ())
- ffestc_R911_finish ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R923 -- Parse an INQUIRE statement
-
- return ffestb_R923; // to lexer
-
- Make sure the statement has a valid form for an INQUIRE statement.
- If it does, implement the statement. */
-
-ffelexHandler
-ffestb_R923 (ffelexToken t)
-{
- ffestpInquireIx ix;
-
- switch (ffelex_token_type (ffesta_tokens[0]))
- {
- case FFELEX_typeNAME:
- if (ffesta_first_kw != FFESTR_firstINQUIRE)
- goto bad_0; /* :::::::::::::::::::: */
- break;
-
- case FFELEX_typeNAMES:
- if (ffesta_first_kw != FFESTR_firstINQUIRE)
- goto bad_0; /* :::::::::::::::::::: */
- if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlINQUIRE)
- goto bad_0; /* :::::::::::::::::::: */
- break;
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeOPEN_PAREN:
- break;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
- }
-
- for (ix = 0; ix < FFESTP_inquireix; ++ix)
- ffestp_file.inquire.inquire_spec[ix].kw_or_val_present = FALSE;
-
- ffestb_local_.inquire.may_be_iolength = TRUE;
- return (ffelexHandler) ffestb_R9231_;
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-}
-
-/* ffestb_R9231_ -- "INQUIRE" OPEN_PAREN
-
- return ffestb_R9231_; // to lexer
-
- Handle expr construct (not NAME=expr construct) here. */
-
-static ffelexHandler
-ffestb_R9231_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_R9232_;
-
- default:
- ffestb_local_.inquire.may_be_iolength = FALSE;
- return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9233_)))
- (t);
- }
-}
-
-/* ffestb_R9232_ -- "INQUIRE" OPEN_PAREN NAME
-
- return ffestb_R9232_; // to lexer
-
- If EQUALS here, go to states that handle it. Else, send NAME and this
- token thru expression handler. */
-
-static ffelexHandler
-ffestb_R9232_ (ffelexToken t)
-{
- ffelexHandler next;
- ffelexToken nt;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEQUALS:
- nt = ffesta_tokens[1];
- next = (ffelexHandler) ffestb_R9234_ (nt);
- ffelex_token_kill (nt);
- return (ffelexHandler) (*next) (t);
-
- default:
- ffestb_local_.inquire.may_be_iolength = FALSE;
- next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9233_)))
- (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) (*next) (t);
- }
-}
-
-/* ffestb_R9233_ -- "INQUIRE" OPEN_PAREN expr
-
- (ffestb_R9233_) // to expression handler
-
- Handle COMMA or CLOSE_PAREN here. */
-
-static ffelexHandler
-ffestb_R9233_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCLOSE_PAREN:
- if (expr == NULL)
- break;
- ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw_or_val_present
- = TRUE;
- ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw_present = FALSE;
- ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value_present = TRUE;
- ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value_is_label
- = FALSE;
- ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value
- = ffelex_token_use (ft);
- ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].u.expr = expr;
- if (ffelex_token_type (t) == FFELEX_typeCOMMA)
- return (ffelexHandler) ffestb_R9234_;
- return (ffelexHandler) ffestb_R9239_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_inquire_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9234_ -- "INQUIRE" OPEN_PAREN [external-file-unit COMMA]
-
- return ffestb_R9234_; // to lexer
-
- Handle expr construct (not NAME=expr construct) here. */
-
-static ffelexHandler
-ffestb_R9234_ (ffelexToken t)
-{
- ffestrInquire kw;
-
- ffestb_local_.inquire.label = FALSE;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- kw = ffestr_inquire (t);
- if (kw != FFESTR_inquireIOLENGTH)
- ffestb_local_.inquire.may_be_iolength = FALSE;
- switch (kw)
- {
- case FFESTR_inquireACCESS:
- ffestb_local_.inquire.ix = FFESTP_inquireixACCESS;
- ffestb_local_.inquire.left = TRUE;
- ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
- break;
-
- case FFESTR_inquireACTION:
- ffestb_local_.inquire.ix = FFESTP_inquireixACTION;
- ffestb_local_.inquire.left = TRUE;
- ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
- break;
-
- case FFESTR_inquireBLANK:
- ffestb_local_.inquire.ix = FFESTP_inquireixBLANK;
- ffestb_local_.inquire.left = TRUE;
- ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
- break;
-
- case FFESTR_inquireCARRIAGECONTROL:
- ffestb_local_.inquire.ix = FFESTP_inquireixCARRIAGECONTROL;
- ffestb_local_.inquire.left = TRUE;
- ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
- break;
-
- case FFESTR_inquireDEFAULTFILE:
- ffestb_local_.inquire.ix = FFESTP_inquireixDEFAULTFILE;
- ffestb_local_.inquire.left = FALSE;
- ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
- break;
-
- case FFESTR_inquireDELIM:
- ffestb_local_.inquire.ix = FFESTP_inquireixDELIM;
- ffestb_local_.inquire.left = TRUE;
- ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
- break;
-
- case FFESTR_inquireDIRECT:
- ffestb_local_.inquire.ix = FFESTP_inquireixDIRECT;
- ffestb_local_.inquire.left = TRUE;
- ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
- break;
-
- case FFESTR_inquireERR:
- ffestb_local_.inquire.ix = FFESTP_inquireixERR;
- ffestb_local_.inquire.label = TRUE;
- break;
-
- case FFESTR_inquireEXIST:
- ffestb_local_.inquire.ix = FFESTP_inquireixEXIST;
- ffestb_local_.inquire.left = TRUE;
- ffestb_local_.inquire.context = FFEEXPR_contextFILELOG;
- break;
-
- case FFESTR_inquireFILE:
- ffestb_local_.inquire.ix = FFESTP_inquireixFILE;
- ffestb_local_.inquire.left = FALSE;
- ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
- break;
-
- case FFESTR_inquireFORM:
- ffestb_local_.inquire.ix = FFESTP_inquireixFORM;
- ffestb_local_.inquire.left = TRUE;
- ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
- break;
-
- case FFESTR_inquireFORMATTED:
- ffestb_local_.inquire.ix = FFESTP_inquireixFORMATTED;
- ffestb_local_.inquire.left = TRUE;
- ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
- break;
-
- case FFESTR_inquireIOLENGTH:
- if (!ffestb_local_.inquire.may_be_iolength)
- goto bad; /* :::::::::::::::::::: */
- ffestb_local_.inquire.ix = FFESTP_inquireixIOLENGTH;
- ffestb_local_.inquire.left = TRUE;
- ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
- break;
-
- case FFESTR_inquireIOSTAT:
- ffestb_local_.inquire.ix = FFESTP_inquireixIOSTAT;
- ffestb_local_.inquire.left = TRUE;
- ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
- break;
-
- case FFESTR_inquireKEYED:
- ffestb_local_.inquire.ix = FFESTP_inquireixKEYED;
- ffestb_local_.inquire.left = TRUE;
- ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
- break;
-
- case FFESTR_inquireNAME:
- ffestb_local_.inquire.ix = FFESTP_inquireixNAME;
- ffestb_local_.inquire.left = TRUE;
- ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
- break;
-
- case FFESTR_inquireNAMED:
- ffestb_local_.inquire.ix = FFESTP_inquireixNAMED;
- ffestb_local_.inquire.left = TRUE;
- ffestb_local_.inquire.context = FFEEXPR_contextFILELOG;
- break;
-
- case FFESTR_inquireNEXTREC:
- ffestb_local_.inquire.ix = FFESTP_inquireixNEXTREC;
- ffestb_local_.inquire.left = TRUE;
- ffestb_local_.inquire.context = FFEEXPR_contextFILEDFINT;
- break;
-
- case FFESTR_inquireNUMBER:
- ffestb_local_.inquire.ix = FFESTP_inquireixNUMBER;
- ffestb_local_.inquire.left = TRUE;
- ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
- break;
-
- case FFESTR_inquireOPENED:
- ffestb_local_.inquire.ix = FFESTP_inquireixOPENED;
- ffestb_local_.inquire.left = TRUE;
- ffestb_local_.inquire.context = FFEEXPR_contextFILELOG;
- break;
-
- case FFESTR_inquireORGANIZATION:
- ffestb_local_.inquire.ix = FFESTP_inquireixORGANIZATION;
- ffestb_local_.inquire.left = TRUE;
- ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
- break;
-
- case FFESTR_inquirePAD:
- ffestb_local_.inquire.ix = FFESTP_inquireixPAD;
- ffestb_local_.inquire.left = TRUE;
- ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
- break;
-
- case FFESTR_inquirePOSITION:
- ffestb_local_.inquire.ix = FFESTP_inquireixPOSITION;
- ffestb_local_.inquire.left = TRUE;
- ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
- break;
-
- case FFESTR_inquireREAD:
- ffestb_local_.inquire.ix = FFESTP_inquireixREAD;
- ffestb_local_.inquire.left = TRUE;
- ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
- break;
-
- case FFESTR_inquireREADWRITE:
- ffestb_local_.inquire.ix = FFESTP_inquireixREADWRITE;
- ffestb_local_.inquire.left = TRUE;
- ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
- break;
-
- case FFESTR_inquireRECL:
- ffestb_local_.inquire.ix = FFESTP_inquireixRECL;
- ffestb_local_.inquire.left = TRUE;
- ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
- break;
-
- case FFESTR_inquireRECORDTYPE:
- ffestb_local_.inquire.ix = FFESTP_inquireixRECORDTYPE;
- ffestb_local_.inquire.left = TRUE;
- ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
- break;
-
- case FFESTR_inquireSEQUENTIAL:
- ffestb_local_.inquire.ix = FFESTP_inquireixSEQUENTIAL;
- ffestb_local_.inquire.left = TRUE;
- ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
- break;
-
- case FFESTR_inquireUNFORMATTED:
- ffestb_local_.inquire.ix = FFESTP_inquireixUNFORMATTED;
- ffestb_local_.inquire.left = TRUE;
- ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
- break;
-
- case FFESTR_inquireUNIT:
- ffestb_local_.inquire.ix = FFESTP_inquireixUNIT;
- ffestb_local_.inquire.left = FALSE;
- ffestb_local_.inquire.context = FFEEXPR_contextFILENUM;
- break;
-
- default:
- goto bad; /* :::::::::::::::::::: */
- }
- if (ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
- .kw_or_val_present)
- break; /* Can't specify a keyword twice! */
- ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
- .kw_or_val_present = TRUE;
- ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
- .kw_present = TRUE;
- ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
- .value_present = FALSE;
- ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value_is_label
- = ffestb_local_.inquire.label;
- ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].kw
- = ffelex_token_use (t);
- return (ffelexHandler) ffestb_R9235_;
-
- default:
- break;
- }
-
-bad: /* :::::::::::::::::::: */
- ffestb_subr_kill_inquire_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9235_ -- "INQUIRE" OPEN_PAREN [external-file-unit COMMA] NAME
-
- return ffestb_R9235_; // to lexer
-
- Make sure EQUALS here, send next token to expression handler. */
-
-static ffelexHandler
-ffestb_R9235_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEQUALS:
- ffesta_confirmed ();
- if (ffestb_local_.inquire.label)
- return (ffelexHandler) ffestb_R9237_;
- if (ffestb_local_.inquire.left)
- return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
- ffestb_local_.inquire.context,
- (ffeexprCallback) ffestb_R9236_);
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- ffestb_local_.inquire.context,
- (ffeexprCallback) ffestb_R9236_);
-
- default:
- break;
- }
-
- ffestb_subr_kill_inquire_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9236_ -- "INQUIRE" OPEN_PAREN ... NAME EQUALS expr
-
- (ffestb_R9236_) // to expression handler
-
- Handle COMMA or CLOSE_PAREN here. */
-
-static ffelexHandler
-ffestb_R9236_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- if (ffestb_local_.inquire.ix == FFESTP_inquireixIOLENGTH)
- break; /* IOLENGTH=expr must be followed by
- CLOSE_PAREN. */
- /* Fall through. */
- case FFELEX_typeCLOSE_PAREN:
- if (expr == NULL)
- break;
- ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value_present
- = TRUE;
- ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value
- = ffelex_token_use (ft);
- ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].u.expr = expr;
- if (ffelex_token_type (t) == FFELEX_typeCOMMA)
- return (ffelexHandler) ffestb_R9234_;
- if (ffestb_local_.inquire.ix == FFESTP_inquireixIOLENGTH)
- return (ffelexHandler) ffestb_R92310_;
- return (ffelexHandler) ffestb_R9239_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_inquire_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9237_ -- "INQUIRE" OPEN_PAREN ... NAME EQUALS
-
- return ffestb_R9237_; // to lexer
-
- Handle NUMBER for label here. */
-
-static ffelexHandler
-ffestb_R9237_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNUMBER:
- ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value_present
- = TRUE;
- ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value
- = ffelex_token_use (t);
- return (ffelexHandler) ffestb_R9238_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_inquire_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9238_ -- "INQUIRE" OPEN_PAREN ... NAME EQUALS NUMBER
-
- return ffestb_R9238_; // to lexer
-
- Handle COMMA or CLOSE_PAREN here. */
-
-static ffelexHandler
-ffestb_R9238_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- return (ffelexHandler) ffestb_R9234_;
-
- case FFELEX_typeCLOSE_PAREN:
- return (ffelexHandler) ffestb_R9239_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_inquire_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9239_ -- "INQUIRE" OPEN_PAREN ... CLOSE_PAREN
-
- return ffestb_R9239_; // to lexer
-
- Handle EOS or SEMICOLON here. */
-
-static ffelexHandler
-ffestb_R9239_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_R923A ();
- ffestb_subr_kill_inquire_ ();
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- ffestb_subr_kill_inquire_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R92310_ -- "INQUIRE(IOLENGTH=expr)"
-
- return ffestb_R92310_; // to lexer
-
- Make sure EOS or SEMICOLON not here; begin R923B processing and expect
- output IO list. */
-
-static ffelexHandler
-ffestb_R92310_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- break;
-
- default:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_R923B_start ();
- ffestb_subr_kill_inquire_ ();
- return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R92311_)))
- (t);
- }
-
- ffestb_subr_kill_inquire_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R92311_ -- "INQUIRE(IOLENGTH=expr)" expr
-
- (ffestb_R92311_) // to expression handler
-
- Handle COMMA or EOS/SEMICOLON here. */
-
-static ffelexHandler
-ffestb_R92311_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- if (expr == NULL)
- break;
- if (!ffesta_is_inhibited ())
- ffestc_R923B_item (expr, ft);
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R92311_);
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (expr == NULL)
- break;
- if (!ffesta_is_inhibited ())
- {
- ffestc_R923B_item (expr, ft);
- ffestc_R923B_finish ();
- }
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- if (!ffesta_is_inhibited ())
- ffestc_R923B_finish ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V018 -- Parse the REWRITE statement
-
- return ffestb_V018; // to lexer
-
- Make sure the statement has a valid form for the REWRITE
- statement. If it does, implement the statement. */
-
-#if FFESTR_VXT
-ffelexHandler
-ffestb_V018 (ffelexToken t)
-{
- ffestpRewriteIx ix;
-
- switch (ffelex_token_type (ffesta_tokens[0]))
- {
- case FFELEX_typeNAME:
- if (ffesta_first_kw != FFESTR_firstREWRITE)
- goto bad_0; /* :::::::::::::::::::: */
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeNAME:
- case FFELEX_typeNUMBER:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeOPEN_PAREN:
- for (ix = 0; ix < FFESTP_rewriteix; ++ix)
- ffestp_file.rewrite.rewrite_spec[ix].kw_or_val_present = FALSE;
- return (ffelexHandler) ffestb_V0181_;
- }
-
- case FFELEX_typeNAMES:
- if (ffesta_first_kw != FFESTR_firstREWRITE)
- goto bad_0; /* :::::::::::::::::::: */
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeOPEN_PAREN:
- if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlREWRITE)
- goto bad_0; /* :::::::::::::::::::: */
-
- for (ix = 0; ix < FFESTP_rewriteix; ++ix)
- ffestp_file.rewrite.rewrite_spec[ix].kw_or_val_present = FALSE;
- return (ffelexHandler) ffestb_V0181_;
- }
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-}
-
-/* ffestb_V0181_ -- "REWRITE" OPEN_PAREN
-
- return ffestb_V0181_; // to lexer
-
- Handle expr construct (not NAME=expr construct) here. */
-
-static ffelexHandler
-ffestb_V0181_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_V0182_;
-
- default:
- return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0183_)))
- (t);
- }
-}
-
-/* ffestb_V0182_ -- "REWRITE" OPEN_PAREN NAME
-
- return ffestb_V0182_; // to lexer
-
- If EQUALS here, go to states that handle it. Else, send NAME and this
- token thru expression handler. */
-
-static ffelexHandler
-ffestb_V0182_ (ffelexToken t)
-{
- ffelexHandler next;
- ffelexToken nt;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEQUALS:
- nt = ffesta_tokens[1];
- next = (ffelexHandler) ffestb_V0187_ (nt);
- ffelex_token_kill (nt);
- return (ffelexHandler) (*next) (t);
-
- default:
- nt = ffesta_tokens[1];
- next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0183_)))
- (nt);
- ffelex_token_kill (nt);
- return (ffelexHandler) (*next) (t);
- }
-}
-
-/* ffestb_V0183_ -- "REWRITE" OPEN_PAREN expr [CLOSE_PAREN]
-
- (ffestb_V0183_) // to expression handler
-
- Handle COMMA or EOS/SEMICOLON here. */
-
-static ffelexHandler
-ffestb_V0183_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCLOSE_PAREN:
- if (expr == NULL)
- break;
- ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].kw_or_val_present
- = TRUE;
- ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].kw_present = FALSE;
- ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].value_present = TRUE;
- ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].value_is_label
- = FALSE;
- ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].value
- = ffelex_token_use (ft);
- ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].u.expr = expr;
- if (ffelex_token_type (t) == FFELEX_typeCOMMA)
- return (ffelexHandler) ffestb_V0184_;
- return (ffelexHandler) ffestb_V01812_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_rewrite_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0184_ -- "REWRITE" OPEN_PAREN expr COMMA
-
- return ffestb_V0184_; // to lexer
-
- Handle expr construct (not NAME=expr construct) here. */
-
-static ffelexHandler
-ffestb_V0184_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_V0185_;
-
- default:
- return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILEFORMAT, (ffeexprCallback) ffestb_V0186_)))
- (t);
- }
-}
-
-/* ffestb_V0185_ -- "REWRITE" OPEN_PAREN expr COMMA NAME
-
- return ffestb_V0185_; // to lexer
-
- If EQUALS here, go to states that handle it. Else, send NAME and this
- token thru expression handler. */
-
-static ffelexHandler
-ffestb_V0185_ (ffelexToken t)
-{
- ffelexHandler next;
- ffelexToken nt;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEQUALS:
- nt = ffesta_tokens[1];
- next = (ffelexHandler) ffestb_V0187_ (nt);
- ffelex_token_kill (nt);
- return (ffelexHandler) (*next) (t);
-
- default:
- nt = ffesta_tokens[1];
- next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILEFORMAT, (ffeexprCallback) ffestb_V0186_)))
- (nt);
- ffelex_token_kill (nt);
- return (ffelexHandler) (*next) (t);
- }
-}
-
-/* ffestb_V0186_ -- "REWRITE" OPEN_PAREN expr COMMA expr
-
- (ffestb_V0186_) // to expression handler
-
- Handle COMMA or CLOSE_PAREN here. */
-
-static ffelexHandler
-ffestb_V0186_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCLOSE_PAREN:
- ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw_or_val_present
- = TRUE;
- ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw_present = FALSE;
- ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value_present = TRUE;
- ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value_is_label
- = (expr == NULL);
- ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value
- = ffelex_token_use (ft);
- ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].u.expr = expr;
- if (ffelex_token_type (t) == FFELEX_typeCOMMA)
- return (ffelexHandler) ffestb_V0187_;
- return (ffelexHandler) ffestb_V01812_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_rewrite_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0187_ -- "REWRITE" OPEN_PAREN [external-file-unit COMMA [format
- COMMA]]
-
- return ffestb_V0187_; // to lexer
-
- Handle expr construct (not NAME=expr construct) here. */
-
-static ffelexHandler
-ffestb_V0187_ (ffelexToken t)
-{
- ffestrGenio kw;
-
- ffestb_local_.rewrite.label = FALSE;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- kw = ffestr_genio (t);
- switch (kw)
- {
- case FFESTR_genioERR:
- ffestb_local_.rewrite.ix = FFESTP_rewriteixERR;
- ffestb_local_.rewrite.label = TRUE;
- break;
-
- case FFESTR_genioFMT:
- ffestb_local_.rewrite.ix = FFESTP_rewriteixFMT;
- ffestb_local_.rewrite.left = FALSE;
- ffestb_local_.rewrite.context = FFEEXPR_contextFILEFORMAT;
- break;
-
- case FFESTR_genioIOSTAT:
- ffestb_local_.rewrite.ix = FFESTP_rewriteixIOSTAT;
- ffestb_local_.rewrite.left = TRUE;
- ffestb_local_.rewrite.context = FFEEXPR_contextFILEINT;
- break;
-
- case FFESTR_genioUNIT:
- ffestb_local_.rewrite.ix = FFESTP_rewriteixUNIT;
- ffestb_local_.rewrite.left = FALSE;
- ffestb_local_.rewrite.context = FFEEXPR_contextFILENUM;
- break;
-
- default:
- goto bad; /* :::::::::::::::::::: */
- }
- if (ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
- .kw_or_val_present)
- break; /* Can't specify a keyword twice! */
- ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
- .kw_or_val_present = TRUE;
- ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
- .kw_present = TRUE;
- ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
- .value_present = FALSE;
- ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value_is_label
- = ffestb_local_.rewrite.label;
- ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].kw
- = ffelex_token_use (t);
- return (ffelexHandler) ffestb_V0188_;
-
- default:
- break;
- }
-
-bad: /* :::::::::::::::::::: */
- ffestb_subr_kill_rewrite_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0188_ -- "REWRITE" OPEN_PAREN [external-file-unit COMMA [format
- COMMA]] NAME
-
- return ffestb_V0188_; // to lexer
-
- Make sure EQUALS here, send next token to expression handler. */
-
-static ffelexHandler
-ffestb_V0188_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEQUALS:
- ffesta_confirmed ();
- if (ffestb_local_.rewrite.label)
- return (ffelexHandler) ffestb_V01810_;
- if (ffestb_local_.rewrite.left)
- return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
- ffestb_local_.rewrite.context,
- (ffeexprCallback) ffestb_V0189_);
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- ffestb_local_.rewrite.context,
- (ffeexprCallback) ffestb_V0189_);
-
- default:
- break;
- }
-
- ffestb_subr_kill_rewrite_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0189_ -- "REWRITE" OPEN_PAREN ... NAME EQUALS expr
-
- (ffestb_V0189_) // to expression handler
-
- Handle COMMA or CLOSE_PAREN here. */
-
-static ffelexHandler
-ffestb_V0189_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCLOSE_PAREN:
- if (expr == NULL)
- if (ffestb_local_.rewrite.context == FFEEXPR_contextFILEFORMAT)
- ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
- .value_is_label = TRUE;
- else
- break;
- ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value_present
- = TRUE;
- ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value
- = ffelex_token_use (ft);
- ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].u.expr = expr;
- if (ffelex_token_type (t) == FFELEX_typeCOMMA)
- return (ffelexHandler) ffestb_V0187_;
- return (ffelexHandler) ffestb_V01812_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_rewrite_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V01810_ -- "REWRITE" OPEN_PAREN ... NAME EQUALS
-
- return ffestb_V01810_; // to lexer
-
- Handle NUMBER for label here. */
-
-static ffelexHandler
-ffestb_V01810_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNUMBER:
- ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value_present
- = TRUE;
- ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value
- = ffelex_token_use (t);
- return (ffelexHandler) ffestb_V01811_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_rewrite_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V01811_ -- "REWRITE" OPEN_PAREN ... NAME EQUALS NUMBER
-
- return ffestb_V01811_; // to lexer
-
- Handle COMMA or CLOSE_PAREN here. */
-
-static ffelexHandler
-ffestb_V01811_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- return (ffelexHandler) ffestb_V0187_;
-
- case FFELEX_typeCLOSE_PAREN:
- return (ffelexHandler) ffestb_V01812_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_rewrite_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V01812_ -- "REWRITE" OPEN_PAREN ... CLOSE_PAREN
-
- return ffestb_V01812_; // to lexer
-
- Handle EOS or SEMICOLON here. */
-
-static ffelexHandler
-ffestb_V01812_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- {
- ffestc_V018_start ();
- ffestc_V018_finish ();
- }
- ffestb_subr_kill_rewrite_ ();
- return (ffelexHandler) ffesta_zero (t);
-
- case FFELEX_typeNAME:
- case FFELEX_typeOPEN_PAREN:
- case FFELEX_typeCOMMA:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_V018_start ();
- ffestb_subr_kill_rewrite_ ();
-
- /* EXTENSION: Allow an optional preceding COMMA here if not pedantic.
- (f2c provides this extension, as do other compilers, supposedly.) */
-
- if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA))
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V01813_);
-
- return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V01813_)))
- (t);
-
- default:
- break;
- }
-
- ffestb_subr_kill_rewrite_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V01813_ -- "REWRITE(...)" expr
-
- (ffestb_V01813_) // to expression handler
-
- Handle COMMA or EOS/SEMICOLON here. */
-
-static ffelexHandler
-ffestb_V01813_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- if (expr == NULL)
- break;
- if (!ffesta_is_inhibited ())
- ffestc_V018_item (expr, ft);
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V01813_);
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (expr == NULL)
- break;
- if (!ffesta_is_inhibited ())
- {
- ffestc_V018_item (expr, ft);
- ffestc_V018_finish ();
- }
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- if (!ffesta_is_inhibited ())
- ffestc_V018_finish ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V019 -- Parse the ACCEPT statement
-
- return ffestb_V019; // to lexer
-
- Make sure the statement has a valid form for the ACCEPT
- statement. If it does, implement the statement. */
-
-ffelexHandler
-ffestb_V019 (ffelexToken t)
-{
- ffelexHandler next;
- ffestpAcceptIx ix;
-
- switch (ffelex_token_type (ffesta_tokens[0]))
- {
- case FFELEX_typeNAME:
- if (ffesta_first_kw != FFESTR_firstACCEPT)
- goto bad_0; /* :::::::::::::::::::: */
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeEQUALS:
- case FFELEX_typePOINTS:
- case FFELEX_typeCOLON:
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeNAME:
- case FFELEX_typeNUMBER:
- ffesta_confirmed ();
- break;
-
- default:
- break;
- }
-
- for (ix = 0; ix < FFESTP_acceptix; ++ix)
- ffestp_file.accept.accept_spec[ix].kw_or_val_present = FALSE;
- return (ffelexHandler) (*((ffelexHandler)
- ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0191_)))
- (t);
-
- case FFELEX_typeNAMES:
- if (ffesta_first_kw != FFESTR_firstACCEPT)
- goto bad_0; /* :::::::::::::::::::: */
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeCOMMA:
- ffesta_confirmed ();
- if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlACCEPT)
- break;
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeEQUALS:
- case FFELEX_typePOINTS:
- case FFELEX_typeCOLON:
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- break;
- }
- for (ix = 0; ix < FFESTP_acceptix; ++ix)
- ffestp_file.accept.accept_spec[ix].kw_or_val_present = FALSE;
- next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0191_);
- next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
- FFESTR_firstlACCEPT);
- if (next == NULL)
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero);
- return (ffelexHandler) (*next) (t);
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-}
-
-/* ffestb_V0191_ -- "ACCEPT" expr
-
- (ffestb_V0191_) // to expression handler
-
- Make sure the next token is a COMMA or EOS/SEMICOLON. */
-
-static ffelexHandler
-ffestb_V0191_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeCOMMA:
- ffesta_confirmed ();
- ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].kw_or_val_present
- = TRUE;
- ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].kw_present = FALSE;
- ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].value_present = TRUE;
- ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].value_is_label
- = (expr == NULL);
- ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].value
- = ffelex_token_use (ft);
- ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].u.expr = expr;
- if (!ffesta_is_inhibited ())
- ffestc_V019_start ();
- ffestb_subr_kill_accept_ ();
- if (ffelex_token_type (t) == FFELEX_typeCOMMA)
- return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
- FFEEXPR_contextIOLIST,
- (ffeexprCallback) ffestb_V0192_);
- if (!ffesta_is_inhibited ())
- ffestc_V019_finish ();
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- ffestb_subr_kill_accept_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0192_ -- "ACCEPT" expr COMMA expr
-
- (ffestb_V0192_) // to expression handler
-
- Handle COMMA or EOS/SEMICOLON here. */
-
-static ffelexHandler
-ffestb_V0192_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- if (expr == NULL)
- break;
- if (!ffesta_is_inhibited ())
- ffestc_V019_item (expr, ft);
- return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
- FFEEXPR_contextIOLIST,
- (ffeexprCallback) ffestb_V0192_);
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (expr == NULL)
- break;
- if (!ffesta_is_inhibited ())
- {
- ffestc_V019_item (expr, ft);
- ffestc_V019_finish ();
- }
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- if (!ffesta_is_inhibited ())
- ffestc_V019_finish ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-#endif
-/* ffestb_V020 -- Parse the TYPE statement
-
- return ffestb_V020; // to lexer
-
- Make sure the statement has a valid form for the TYPE
- statement. If it does, implement the statement. */
-
-ffelexHandler
-ffestb_V020 (ffelexToken t)
-{
- ffeTokenLength i;
- 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_V021 -- Parse a DELETE statement
-
- return ffestb_V021; // to lexer
-
- Make sure the statement has a valid form for a DELETE statement.
- If it does, implement the statement. */
-
-#if FFESTR_VXT
-ffelexHandler
-ffestb_V021 (ffelexToken t)
-{
- ffestpDeleteIx ix;
-
- switch (ffelex_token_type (ffesta_tokens[0]))
- {
- case FFELEX_typeNAME:
- if (ffesta_first_kw != FFESTR_firstDELETE)
- goto bad_0; /* :::::::::::::::::::: */
- break;
-
- case FFELEX_typeNAMES:
- if (ffesta_first_kw != FFESTR_firstDELETE)
- goto bad_0; /* :::::::::::::::::::: */
- if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlDELETE)
- goto bad_0; /* :::::::::::::::::::: */
- break;
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeOPEN_PAREN:
- break;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
- }
-
- for (ix = 0; ix < FFESTP_deleteix; ++ix)
- ffestp_file.delete.delete_spec[ix].kw_or_val_present = FALSE;
-
- return (ffelexHandler) ffestb_V0211_;
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-}
-
-/* ffestb_V0211_ -- "DELETE" OPEN_PAREN
-
- return ffestb_V0211_; // to lexer
-
- Handle expr construct (not NAME=expr construct) here. */
-
-static ffelexHandler
-ffestb_V0211_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_V0212_;
-
- default:
- return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0213_)))
- (t);
- }
-}
-
-/* ffestb_V0212_ -- "DELETE" OPEN_PAREN NAME
-
- return ffestb_V0212_; // to lexer
-
- If EQUALS here, go to states that handle it. Else, send NAME and this
- token thru expression handler. */
-
-static ffelexHandler
-ffestb_V0212_ (ffelexToken t)
-{
- ffelexHandler next;
- ffelexToken nt;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEQUALS:
- nt = ffesta_tokens[1];
- next = (ffelexHandler) ffestb_V0214_ (nt);
- ffelex_token_kill (nt);
- return (ffelexHandler) (*next) (t);
-
- default:
- next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0213_)))
- (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) (*next) (t);
- }
-}
-
-/* ffestb_V0213_ -- "DELETE" OPEN_PAREN expr
-
- (ffestb_V0213_) // to expression handler
-
- Handle COMMA or DELETE_PAREN here. */
-
-static ffelexHandler
-ffestb_V0213_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCLOSE_PAREN:
- if (expr == NULL)
- break;
- ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].kw_or_val_present
- = TRUE;
- ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].kw_present = FALSE;
- ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].value_present = TRUE;
- ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].value_is_label
- = FALSE;
- ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].value
- = ffelex_token_use (ft);
- ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].u.expr = expr;
- if (ffelex_token_type (t) == FFELEX_typeCOMMA)
- return (ffelexHandler) ffestb_V0214_;
- return (ffelexHandler) ffestb_V0219_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_delete_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0214_ -- "DELETE" OPEN_PAREN [external-file-unit COMMA]
-
- return ffestb_V0214_; // to lexer
-
- Handle expr construct (not NAME=expr construct) here. */
-
-static ffelexHandler
-ffestb_V0214_ (ffelexToken t)
-{
- ffestrGenio kw;
-
- ffestb_local_.delete.label = FALSE;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- kw = ffestr_genio (t);
- switch (kw)
- {
- case FFESTR_genioERR:
- ffestb_local_.delete.ix = FFESTP_deleteixERR;
- ffestb_local_.delete.label = TRUE;
- break;
-
- case FFESTR_genioIOSTAT:
- ffestb_local_.delete.ix = FFESTP_deleteixIOSTAT;
- ffestb_local_.delete.left = TRUE;
- ffestb_local_.delete.context = FFEEXPR_contextFILEINT;
- break;
-
- case FFESTR_genioREC:
- ffestb_local_.delete.ix = FFESTP_deleteixREC;
- ffestb_local_.delete.left = FALSE;
- ffestb_local_.delete.context = FFEEXPR_contextFILENUM;
- break;
-
- case FFESTR_genioUNIT:
- ffestb_local_.delete.ix = FFESTP_deleteixUNIT;
- ffestb_local_.delete.left = FALSE;
- ffestb_local_.delete.context = FFEEXPR_contextFILENUM;
- break;
-
- default:
- goto bad; /* :::::::::::::::::::: */
- }
- if (ffestp_file.delete.delete_spec[ffestb_local_.delete.ix]
- .kw_or_val_present)
- break; /* Can't specify a keyword twice! */
- ffestp_file.delete.delete_spec[ffestb_local_.delete.ix]
- .kw_or_val_present = TRUE;
- ffestp_file.delete.delete_spec[ffestb_local_.delete.ix]
- .kw_present = TRUE;
- ffestp_file.delete.delete_spec[ffestb_local_.delete.ix]
- .value_present = FALSE;
- ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value_is_label
- = ffestb_local_.delete.label;
- ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].kw
- = ffelex_token_use (t);
- return (ffelexHandler) ffestb_V0215_;
-
- default:
- break;
- }
-
-bad: /* :::::::::::::::::::: */
- ffestb_subr_kill_delete_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0215_ -- "DELETE" OPEN_PAREN [external-file-unit COMMA] NAME
-
- return ffestb_V0215_; // to lexer
-
- Make sure EQUALS here, send next token to expression handler. */
-
-static ffelexHandler
-ffestb_V0215_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEQUALS:
- ffesta_confirmed ();
- if (ffestb_local_.delete.label)
- return (ffelexHandler) ffestb_V0217_;
- if (ffestb_local_.delete.left)
- return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
- ffestb_local_.delete.context,
- (ffeexprCallback) ffestb_V0216_);
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- ffestb_local_.delete.context, (ffeexprCallback) ffestb_V0216_);
-
- default:
- break;
- }
-
- ffestb_subr_kill_delete_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0216_ -- "DELETE" OPEN_PAREN ... NAME EQUALS expr
-
- (ffestb_V0216_) // to expression handler
-
- Handle COMMA or CLOSE_PAREN here. */
-
-static ffelexHandler
-ffestb_V0216_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCLOSE_PAREN:
- if (expr == NULL)
- break;
- ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value_present
- = TRUE;
- ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value
- = ffelex_token_use (ft);
- ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].u.expr = expr;
- if (ffelex_token_type (t) == FFELEX_typeCOMMA)
- return (ffelexHandler) ffestb_V0214_;
- return (ffelexHandler) ffestb_V0219_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_delete_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0217_ -- "DELETE" OPEN_PAREN ... NAME EQUALS
-
- return ffestb_V0217_; // to lexer
-
- Handle NUMBER for label here. */
-
-static ffelexHandler
-ffestb_V0217_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNUMBER:
- ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value_present
- = TRUE;
- ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value
- = ffelex_token_use (t);
- return (ffelexHandler) ffestb_V0218_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_delete_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0218_ -- "DELETE" OPEN_PAREN ... NAME EQUALS NUMBER
-
- return ffestb_V0218_; // to lexer
-
- Handle COMMA or CLOSE_PAREN here. */
-
-static ffelexHandler
-ffestb_V0218_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- return (ffelexHandler) ffestb_V0214_;
-
- case FFELEX_typeCLOSE_PAREN:
- return (ffelexHandler) ffestb_V0219_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_delete_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0219_ -- "DELETE" OPEN_PAREN ... CLOSE_PAREN
-
- return ffestb_V0219_; // to lexer
-
- Handle EOS or SEMICOLON here. */
-
-static ffelexHandler
-ffestb_V0219_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_V021 ();
- ffestb_subr_kill_delete_ ();
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- ffestb_subr_kill_delete_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V026 -- Parse a FIND statement
-
- return ffestb_V026; // to lexer
-
- Make sure the statement has a valid form for a FIND statement.
- If it does, implement the statement. */
-
-ffelexHandler
-ffestb_V026 (ffelexToken t)
-{
- ffestpFindIx ix;
-
- switch (ffelex_token_type (ffesta_tokens[0]))
- {
- case FFELEX_typeNAME:
- if (ffesta_first_kw != FFESTR_firstFIND)
- goto bad_0; /* :::::::::::::::::::: */
- break;
-
- case FFELEX_typeNAMES:
- if (ffesta_first_kw != FFESTR_firstFIND)
- goto bad_0; /* :::::::::::::::::::: */
- if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlFIND)
- goto bad_0; /* :::::::::::::::::::: */
- break;
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeOPEN_PAREN:
- break;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
- }
-
- for (ix = 0; ix < FFESTP_findix; ++ix)
- ffestp_file.find.find_spec[ix].kw_or_val_present = FALSE;
-
- return (ffelexHandler) ffestb_V0261_;
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-}
-
-/* ffestb_V0261_ -- "FIND" OPEN_PAREN
-
- return ffestb_V0261_; // to lexer
-
- Handle expr construct (not NAME=expr construct) here. */
-
-static ffelexHandler
-ffestb_V0261_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_V0262_;
-
- default:
- return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0263_)))
- (t);
- }
-}
-
-/* ffestb_V0262_ -- "FIND" OPEN_PAREN NAME
-
- return ffestb_V0262_; // to lexer
-
- If EQUALS here, go to states that handle it. Else, send NAME and this
- token thru expression handler. */
-
-static ffelexHandler
-ffestb_V0262_ (ffelexToken t)
-{
- ffelexHandler next;
- ffelexToken nt;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEQUALS:
- nt = ffesta_tokens[1];
- next = (ffelexHandler) ffestb_V0264_ (nt);
- ffelex_token_kill (nt);
- return (ffelexHandler) (*next) (t);
-
- default:
- next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0263_)))
- (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) (*next) (t);
- }
-}
-
-/* ffestb_V0263_ -- "FIND" OPEN_PAREN expr
-
- (ffestb_V0263_) // to expression handler
-
- Handle COMMA or FIND_PAREN here. */
-
-static ffelexHandler
-ffestb_V0263_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCLOSE_PAREN:
- if (expr == NULL)
- break;
- ffestp_file.find.find_spec[FFESTP_findixUNIT].kw_or_val_present
- = TRUE;
- ffestp_file.find.find_spec[FFESTP_findixUNIT].kw_present = FALSE;
- ffestp_file.find.find_spec[FFESTP_findixUNIT].value_present = TRUE;
- ffestp_file.find.find_spec[FFESTP_findixUNIT].value_is_label
- = FALSE;
- ffestp_file.find.find_spec[FFESTP_findixUNIT].value
- = ffelex_token_use (ft);
- ffestp_file.find.find_spec[FFESTP_findixUNIT].u.expr = expr;
- if (ffelex_token_type (t) == FFELEX_typeCOMMA)
- return (ffelexHandler) ffestb_V0264_;
- return (ffelexHandler) ffestb_V0269_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_find_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0264_ -- "FIND" OPEN_PAREN [external-file-unit COMMA]
-
- return ffestb_V0264_; // to lexer
-
- Handle expr construct (not NAME=expr construct) here. */
-
-static ffelexHandler
-ffestb_V0264_ (ffelexToken t)
-{
- ffestrGenio kw;
-
- ffestb_local_.find.label = FALSE;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- kw = ffestr_genio (t);
- switch (kw)
- {
- case FFESTR_genioERR:
- ffestb_local_.find.ix = FFESTP_findixERR;
- ffestb_local_.find.label = TRUE;
- break;
-
- case FFESTR_genioIOSTAT:
- ffestb_local_.find.ix = FFESTP_findixIOSTAT;
- ffestb_local_.find.left = TRUE;
- ffestb_local_.find.context = FFEEXPR_contextFILEINT;
- break;
-
- case FFESTR_genioREC:
- ffestb_local_.find.ix = FFESTP_findixREC;
- ffestb_local_.find.left = FALSE;
- ffestb_local_.find.context = FFEEXPR_contextFILENUM;
- break;
-
- case FFESTR_genioUNIT:
- ffestb_local_.find.ix = FFESTP_findixUNIT;
- ffestb_local_.find.left = FALSE;
- ffestb_local_.find.context = FFEEXPR_contextFILENUM;
- break;
-
- default:
- goto bad; /* :::::::::::::::::::: */
- }
- if (ffestp_file.find.find_spec[ffestb_local_.find.ix]
- .kw_or_val_present)
- break; /* Can't specify a keyword twice! */
- ffestp_file.find.find_spec[ffestb_local_.find.ix]
- .kw_or_val_present = TRUE;
- ffestp_file.find.find_spec[ffestb_local_.find.ix]
- .kw_present = TRUE;
- ffestp_file.find.find_spec[ffestb_local_.find.ix]
- .value_present = FALSE;
- ffestp_file.find.find_spec[ffestb_local_.find.ix].value_is_label
- = ffestb_local_.find.label;
- ffestp_file.find.find_spec[ffestb_local_.find.ix].kw
- = ffelex_token_use (t);
- return (ffelexHandler) ffestb_V0265_;
-
- default:
- break;
- }
-
-bad: /* :::::::::::::::::::: */
- ffestb_subr_kill_find_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0265_ -- "FIND" OPEN_PAREN [external-file-unit COMMA] NAME
-
- return ffestb_V0265_; // to lexer
-
- Make sure EQUALS here, send next token to expression handler. */
-
-static ffelexHandler
-ffestb_V0265_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEQUALS:
- ffesta_confirmed ();
- if (ffestb_local_.find.label)
- return (ffelexHandler) ffestb_V0267_;
- if (ffestb_local_.find.left)
- return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
- ffestb_local_.find.context,
- (ffeexprCallback) ffestb_V0266_);
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- ffestb_local_.find.context,
- (ffeexprCallback) ffestb_V0266_);
-
- default:
- break;
- }
-
- ffestb_subr_kill_find_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0266_ -- "FIND" OPEN_PAREN ... NAME EQUALS expr
-
- (ffestb_V0266_) // to expression handler
-
- Handle COMMA or CLOSE_PAREN here. */
-
-static ffelexHandler
-ffestb_V0266_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCLOSE_PAREN:
- if (expr == NULL)
- break;
- ffestp_file.find.find_spec[ffestb_local_.find.ix].value_present
- = TRUE;
- ffestp_file.find.find_spec[ffestb_local_.find.ix].value
- = ffelex_token_use (ft);
- ffestp_file.find.find_spec[ffestb_local_.find.ix].u.expr = expr;
- if (ffelex_token_type (t) == FFELEX_typeCOMMA)
- return (ffelexHandler) ffestb_V0264_;
- return (ffelexHandler) ffestb_V0269_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_find_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0267_ -- "FIND" OPEN_PAREN ... NAME EQUALS
-
- return ffestb_V0267_; // to lexer
-
- Handle NUMBER for label here. */
-
-static ffelexHandler
-ffestb_V0267_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNUMBER:
- ffestp_file.find.find_spec[ffestb_local_.find.ix].value_present
- = TRUE;
- ffestp_file.find.find_spec[ffestb_local_.find.ix].value
- = ffelex_token_use (t);
- return (ffelexHandler) ffestb_V0268_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_find_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0268_ -- "FIND" OPEN_PAREN ... NAME EQUALS NUMBER
-
- return ffestb_V0268_; // to lexer
-
- Handle COMMA or CLOSE_PAREN here. */
-
-static ffelexHandler
-ffestb_V0268_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- return (ffelexHandler) ffestb_V0264_;
-
- case FFELEX_typeCLOSE_PAREN:
- return (ffelexHandler) ffestb_V0269_;
-
- default:
- break;
- }
-
- ffestb_subr_kill_find_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0269_ -- "FIND" OPEN_PAREN ... CLOSE_PAREN
-
- return ffestb_V0269_; // to lexer
-
- Handle EOS or SEMICOLON here. */
-
-static ffelexHandler
-ffestb_V0269_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_V026 ();
- ffestb_subr_kill_find_ ();
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- ffestb_subr_kill_find_ ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-#endif
-/* ffestb_dimlist -- Parse the ALLOCATABLE/POINTER/TARGET statement
-
- return ffestb_dimlist; // to lexer
-
- Make sure the statement has a valid form for the ALLOCATABLE/POINTER/
- TARGET statement. If it does, implement the statement. */
-
-#if FFESTR_F90
-ffelexHandler
-ffestb_dimlist (ffelexToken t)
-{
- ffeTokenLength i;
- 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_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- {
- switch (ffesta_first_kw)
- {
- case FFESTR_firstALLOCATABLE:
- ffestc_R525_start ();
- break;
-
- case FFESTR_firstPOINTER:
- ffestc_R526_start ();
- break;
-
- case FFESTR_firstTARGET:
- ffestc_R527_start ();
- break;
-
- default:
- assert (FALSE);
- }
- }
- ffestb_local_.dimlist.started = TRUE;
- return (ffelexHandler) ffestb_dimlist1_;
-
- case FFELEX_typeNAME:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- {
- switch (ffesta_first_kw)
- {
- case FFESTR_firstALLOCATABLE:
- ffestc_R525_start ();
- break;
-
- case FFESTR_firstPOINTER:
- ffestc_R526_start ();
- break;
-
- case FFESTR_firstTARGET:
- ffestc_R527_start ();
- break;
-
- default:
- assert (FALSE);
- }
- }
- ffestb_local_.dimlist.started = TRUE;
- return (ffelexHandler) ffestb_dimlist1_ (t);
- }
-
- case FFELEX_typeNAMES:
- p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.dimlist.len);
- switch (ffelex_token_type (t))
- {
- default:
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeCOMMA:
- ffesta_confirmed ();
- if (!ffesrc_is_name_init (*p))
- goto bad_i; /* :::::::::::::::::::: */
- nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
- if (!ffesta_is_inhibited ())
- {
- switch (ffesta_first_kw)
- {
- case FFESTR_firstALLOCATABLE:
- ffestc_R525_start ();
- break;
-
- case FFESTR_firstPOINTER:
- ffestc_R526_start ();
- break;
-
- case FFESTR_firstTARGET:
- ffestc_R527_start ();
- break;
-
- default:
- assert (FALSE);
- }
- }
- ffestb_local_.dimlist.started = TRUE;
- next = (ffelexHandler) ffestb_dimlist1_ (nt);
- ffelex_token_kill (nt);
- return (ffelexHandler) (*next) (t);
-
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed ();
- if (*p != '\0')
- goto bad_i; /* :::::::::::::::::::: */
- if (!ffesta_is_inhibited ())
- {
- switch (ffesta_first_kw)
- {
- case FFESTR_firstALLOCATABLE:
- ffestc_R525_start ();
- break;
-
- case FFESTR_firstPOINTER:
- ffestc_R526_start ();
- break;
-
- case FFESTR_firstTARGET:
- ffestc_R527_start ();
- break;
-
- default:
- assert (FALSE);
- }
- }
- ffestb_local_.dimlist.started = TRUE;
- return (ffelexHandler) ffestb_dimlist1_;
-
- case FFELEX_typeOPEN_PAREN:
- if (!ffesrc_is_name_init (*p))
- goto bad_i; /* :::::::::::::::::::: */
- nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
- ffestb_local_.dimlist.started = FALSE;
- next = (ffelexHandler) ffestb_dimlist1_ (nt);
- ffelex_token_kill (nt);
- return (ffelexHandler) (*next) (t);
- }
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-
-bad_i: /* :::::::::::::::::::: */
- ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, ffesta_tokens[0], i, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_dimlist1_ -- "ALLOCATABLE/POINTER/TARGET" [COLONCOLON]
-
- return ffestb_dimlist1_; // to lexer
-
- Handle NAME. */
-
-static ffelexHandler
-ffestb_dimlist1_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_dimlist2_;
-
- default:
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
- break;
- }
-
- if (!ffesta_is_inhibited ())
- {
- switch (ffesta_first_kw)
- {
- case FFESTR_firstALLOCATABLE:
- ffestc_R525_finish ();
- break;
-
- case FFESTR_firstPOINTER:
- ffestc_R526_finish ();
- break;
-
- case FFESTR_firstTARGET:
- ffestc_R527_finish ();
- break;
-
- default:
- assert (FALSE);
- }
- }
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_dimlist2_ -- "ALLOCATABLE/POINTER/TARGET" ... NAME
-
- return ffestb_dimlist2_; // to lexer
-
- Handle OPEN_PAREN. */
-
-static ffelexHandler
-ffestb_dimlist2_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeOPEN_PAREN:
- ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
- ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_dimlist3_;
- ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
- ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLIST;
-#ifdef FFECOM_dimensionsMAX
- ffestb_subrargs_.dim_list.ndims = 0;
-#endif
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextDIMLIST, (ffeexprCallback) ffestb_subr_dimlist_);
-
- case FFELEX_typeCOMMA:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- {
- if (!ffestb_local_.dimlist.started)
- {
- switch (ffesta_first_kw)
- {
- case FFESTR_firstALLOCATABLE:
- ffestc_R525_start ();
- break;
-
- case FFESTR_firstPOINTER:
- ffestc_R526_start ();
- break;
-
- case FFESTR_firstTARGET:
- ffestc_R527_start ();
- break;
-
- default:
- assert (FALSE);
- }
- ffestb_local_.dimlist.started = TRUE;
- }
- switch (ffesta_first_kw)
- {
- case FFESTR_firstALLOCATABLE:
- ffestc_R525_item (ffesta_tokens[1], NULL);
- break;
-
- case FFESTR_firstPOINTER:
- ffestc_R526_item (ffesta_tokens[1], NULL);
- break;
-
- case FFESTR_firstTARGET:
- ffestc_R527_item (ffesta_tokens[1], NULL);
- break;
-
- default:
- assert (FALSE);
- }
- }
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffestb_dimlist4_;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- {
- if (!ffestb_local_.dimlist.started)
- {
- switch (ffesta_first_kw)
- {
- case FFESTR_firstALLOCATABLE:
- ffestc_R525_start ();
- break;
-
- case FFESTR_firstPOINTER:
- ffestc_R526_start ();
- break;
-
- case FFESTR_firstTARGET:
- ffestc_R527_start ();
- break;
-
- default:
- assert (FALSE);
- }
- }
- switch (ffesta_first_kw)
- {
- case FFESTR_firstALLOCATABLE:
- ffestc_R525_item (ffesta_tokens[1], NULL);
- ffestc_R525_finish ();
- break;
-
- case FFESTR_firstPOINTER:
- ffestc_R526_item (ffesta_tokens[1], NULL);
- ffestc_R526_finish ();
- break;
-
- case FFESTR_firstTARGET:
- ffestc_R527_item (ffesta_tokens[1], NULL);
- ffestc_R527_finish ();
- break;
-
- default:
- assert (FALSE);
- }
- }
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
- break;
- }
-
- if (!ffesta_is_inhibited ())
- {
- switch (ffesta_first_kw)
- {
- case FFESTR_firstALLOCATABLE:
- ffestc_R525_finish ();
- break;
-
- case FFESTR_firstPOINTER:
- ffestc_R526_finish ();
- break;
-
- case FFESTR_firstTARGET:
- ffestc_R527_finish ();
- break;
-
- default:
- assert (FALSE);
- }
- }
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_dimlist3_ -- "ALLOCATABLE/POINTER/TARGET" ... NAME OPEN_PAREN
- dimlist CLOSE_PAREN
-
- return ffestb_dimlist3_; // to lexer
-
- Handle COMMA or EOS/SEMICOLON. */
-
-static ffelexHandler
-ffestb_dimlist3_ (ffelexToken t)
-{
- if (!ffestb_subrargs_.dim_list.ok)
- goto bad; /* :::::::::::::::::::: */
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- {
- if (!ffestb_local_.dimlist.started)
- {
- switch (ffesta_first_kw)
- {
- case FFESTR_firstALLOCATABLE:
- ffestc_R525_start ();
- break;
-
- case FFESTR_firstPOINTER:
- ffestc_R526_start ();
- break;
-
- case FFESTR_firstTARGET:
- ffestc_R527_start ();
- break;
-
- default:
- assert (FALSE);
- }
- ffestb_local_.dimlist.started = TRUE;
- }
- switch (ffesta_first_kw)
- {
- case FFESTR_firstALLOCATABLE:
- ffestc_R525_item (ffesta_tokens[1],
- ffestb_subrargs_.dim_list.dims);
- break;
-
- case FFESTR_firstPOINTER:
- ffestc_R526_item (ffesta_tokens[1],
- ffestb_subrargs_.dim_list.dims);
- break;
-
- case FFESTR_firstTARGET:
- ffestc_R527_item (ffesta_tokens[1],
- ffestb_subrargs_.dim_list.dims);
- break;
-
- default:
- assert (FALSE);
- }
- }
- ffelex_token_kill (ffesta_tokens[1]);
- ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
- return (ffelexHandler) ffestb_dimlist4_;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- {
- if (!ffestb_local_.dimlist.started)
- {
- switch (ffesta_first_kw)
- {
- case FFESTR_firstALLOCATABLE:
- ffestc_R525_start ();
- break;
-
- case FFESTR_firstPOINTER:
- ffestc_R526_start ();
- break;
-
- case FFESTR_firstTARGET:
- ffestc_R527_start ();
- break;
-
- default:
- assert (FALSE);
- }
- }
- switch (ffesta_first_kw)
- {
- case FFESTR_firstALLOCATABLE:
- ffestc_R525_item (ffesta_tokens[1],
- ffestb_subrargs_.dim_list.dims);
- ffestc_R525_finish ();
- break;
-
- case FFESTR_firstPOINTER:
- ffestc_R526_item (ffesta_tokens[1],
- ffestb_subrargs_.dim_list.dims);
- ffestc_R526_finish ();
- break;
-
- case FFESTR_firstTARGET:
- ffestc_R527_item (ffesta_tokens[1],
- ffestb_subrargs_.dim_list.dims);
- ffestc_R527_finish ();
- break;
-
- default:
- assert (FALSE);
- }
- }
- ffelex_token_kill (ffesta_tokens[1]);
- ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
-bad: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
- if (ffestb_local_.dimlist.started && !ffesta_is_inhibited ())
- {
- switch (ffesta_first_kw)
- {
- case FFESTR_firstALLOCATABLE:
- ffestc_R525_finish ();
- break;
-
- case FFESTR_firstPOINTER:
- ffestc_R526_finish ();
- break;
-
- case FFESTR_firstTARGET:
- ffestc_R527_finish ();
- break;
-
- default:
- assert (FALSE);
- }
- }
- ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_dimlist4_ -- "ALLOCATABLE/POINTER/TARGET" ... COMMA
-
- return ffestb_dimlist4_; // to lexer
-
- Make sure we don't have EOS or SEMICOLON. */
-
-static ffelexHandler
-ffestb_dimlist4_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (!ffesta_is_inhibited ())
- {
- switch (ffesta_first_kw)
- {
- case FFESTR_firstALLOCATABLE:
- ffestc_R525_finish ();
- break;
-
- case FFESTR_firstPOINTER:
- ffestc_R526_finish ();
- break;
-
- case FFESTR_firstTARGET:
- ffestc_R527_finish ();
- break;
-
- default:
- assert (FALSE);
- }
- }
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- return (ffelexHandler) ffestb_dimlist1_ (t);
- }
-}
-
-#endif
-/* ffestb_dummy -- Parse an ENTRY/FUNCTION/SUBROUTINE statement
-
- return ffestb_dummy; // to lexer
-
- Make sure the statement has a valid form for an ENTRY/FUNCTION/SUBROUTINE
- statement. If it does, implement the statement. */
-
-ffelexHandler
-ffestb_dummy (ffelexToken t)
-{
- ffeTokenLength i;
- 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_ -- <dummy-keyword> NAME OPEN_PAREN arg-list CLOSE_PAREN
-
- return ffestb_dummy2_; // to lexer
-
- Make sure the statement has a valid form for a dummy-def statement. If it
- does, implement the statement. */
-
-static ffelexHandler
-ffestb_dummy2_ (ffelexToken t)
-{
- if (!ffestb_subrargs_.name_list.ok)
- goto bad; /* :::::::::::::::::::: */
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- {
- switch (ffestb_local_.dummy.first_kw)
- {
- case FFESTR_firstFUNCTION:
- ffestc_R1219 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
- ffestb_subrargs_.name_list.close_paren, FFESTP_typeNone,
- NULL, NULL, NULL, NULL, ffestb_local_.decl.recursive, NULL);
- break;
-
- case FFESTR_firstSUBROUTINE:
- ffestc_R1223 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
- ffestb_subrargs_.name_list.close_paren,
- ffestb_local_.decl.recursive);
- break;
-
- case FFESTR_firstENTRY:
- ffestc_R1226 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
- ffestb_subrargs_.name_list.close_paren);
- break;
-
- default:
- assert (FALSE);
- }
- }
- ffelex_token_kill (ffesta_tokens[1]);
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
- if (ffestb_subrargs_.name_list.args != NULL)
- ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
- return (ffelexHandler) ffesta_zero (t);
-
- case FFELEX_typeNAME:
- ffesta_confirmed ();
- if ((ffestb_local_.dummy.first_kw != FFESTR_firstFUNCTION)
- || (ffestr_other (t) != FFESTR_otherRESULT))
- break;
- ffestb_local_.decl.type = FFESTP_typeNone;
- ffestb_local_.decl.kind = NULL;
- ffestb_local_.decl.kindt = NULL;
- ffestb_local_.decl.len = NULL;
- ffestb_local_.decl.lent = NULL;
- return (ffelexHandler) ffestb_decl_funcname_6_;
-
- default:
- break;
- }
-
-bad: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_local_.dummy.badname, t);
- ffelex_token_kill (ffesta_tokens[1]);
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
- if (ffestb_subrargs_.name_list.args != NULL)
- ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R524 -- Parse the DIMENSION statement
-
- return ffestb_R524; // to lexer
-
- Make sure the statement has a valid form for the DIMENSION statement. If
- it does, implement the statement. */
-
-ffelexHandler
-ffestb_R524 (ffelexToken t)
-{
- ffeTokenLength i;
- 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_R624 -- Parse a NULLIFY statement
-
- return ffestb_R624; // to lexer
-
- Make sure the statement has a valid form for a NULLIFY
- statement. If it does, implement the statement.
-
- 31-May-90 JCB 2.0
- Rewrite to produce a list of expressions rather than just names; this
- eases semantic checking, putting it in expression handling where that
- kind of thing gets done anyway, and makes it easier to support more
- flexible extensions to Fortran 90 like NULLIFY(FOO%BAR). */
-
-#if FFESTR_F90
-ffelexHandler
-ffestb_R624 (ffelexToken t)
-{
- switch (ffelex_token_type (ffesta_tokens[0]))
- {
- case FFELEX_typeNAME:
- if (ffesta_first_kw != FFESTR_firstNULLIFY)
- goto bad_0; /* :::::::::::::::::::: */
- break;
-
- case FFELEX_typeNAMES:
- if (ffesta_first_kw != FFESTR_firstNULLIFY)
- goto bad_0; /* :::::::::::::::::::: */
- if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlNULLIFY)
- goto bad_0; /* :::::::::::::::::::: */
- break;
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeOPEN_PAREN:
- break;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- case FFELEX_typeNAME:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
- }
-
- ffestb_local_.R624.exprs = ffestt_exprlist_create ();
- return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
- FFEEXPR_contextNULLIFY,
- (ffeexprCallback) ffestb_R6241_);
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-}
-
-/* ffestb_R6241_ -- "NULLIFY" OPEN_PAREN expr
-
- return ffestb_R6241_; // to lexer
-
- Make sure the statement has a valid form for a NULLIFY statement. If it
- does, implement the statement.
-
- 31-May-90 JCB 2.0
- Rewrite to produce a list of expressions rather than just names; this
- eases semantic checking, putting it in expression handling where that
- kind of thing gets done anyway, and makes it easier to support more
- flexible extensions to Fortran 90 like NULLIFY(FOO%BAR). */
-
-static ffelexHandler
-ffestb_R6241_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCLOSE_PAREN:
- if (expr == NULL)
- break;
- ffestt_exprlist_append (ffestb_local_.R624.exprs, expr,
- ffelex_token_use (t));
- return (ffelexHandler) ffestb_R6242_;
-
- case FFELEX_typeCOMMA:
- if (expr == NULL)
- break;
- ffestt_exprlist_append (ffestb_local_.R624.exprs, expr,
- ffelex_token_use (t));
- return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
- FFEEXPR_contextNULLIFY,
- (ffeexprCallback) ffestb_R6241_);
-
- default:
- break;
- }
-
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", t);
- ffestt_exprlist_kill (ffestb_local_.R624.exprs);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R6242_ -- "NULLIFY" OPEN_PAREN expr-list CLOSE_PAREN
-
- return ffestb_R6242_; // to lexer
-
- Make sure the statement has a valid form for a NULLIFY statement. If it
- does, implement the statement. */
-
-static ffelexHandler
-ffestb_R6242_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_R624 (ffestb_local_.R624.exprs);
- ffestt_exprlist_kill (ffestb_local_.R624.exprs);
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", t);
- ffestt_exprlist_kill (ffestb_local_.R624.exprs);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-#endif
-/* ffestb_R1229 -- Parse a STMTFUNCTION statement
-
- return ffestb_R1229; // to lexer
-
- Make sure the statement has a valid form for a STMTFUNCTION
- statement. If it does, implement the statement. */
-
-ffelexHandler
-ffestb_R1229 (ffelexToken t)
-{
- switch (ffelex_token_type (ffesta_tokens[0]))
- {
- case FFELEX_typeNAME:
- case FFELEX_typeNAMES:
- break;
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeOPEN_PAREN:
- break;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- case FFELEX_typeNAME:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
- }
-
- ffestb_subrargs_.name_list.args = ffestt_tokenlist_create ();
- ffestb_subrargs_.name_list.handler = (ffelexHandler) ffestb_R12291_;
- ffestb_subrargs_.name_list.is_subr = FALSE; /* No "*" items in list! */
- ffestb_subrargs_.name_list.names = TRUE; /* In case "IF(FOO)CALL
- FOO...". */
- return (ffelexHandler) ffestb_subr_name_list_;
-
-bad_0: /* :::::::::::::::::::: */
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_2t (FFEBAD_UNREC_STMT, ffesta_tokens[0], t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R12291_ -- "STMTFUNCTION" OPEN_PAREN dummy-name-list CLOSE_PAREN
-
- return ffestb_R12291_; // to lexer
-
- Make sure the statement has a valid form for a STMTFUNCTION statement. If
- it does, implement the statement. */
-
-static ffelexHandler
-ffestb_R12291_ (ffelexToken t)
-{
- ffelex_set_names (FALSE);
-
- if (!ffestb_subrargs_.name_list.ok)
- goto bad; /* :::::::::::::::::::: */
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEQUALS:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_R1229_start (ffesta_tokens[0],
- ffestb_subrargs_.name_list.args,
- ffestb_subrargs_.name_list.close_paren);
- ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
- ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextSFUNCDEF, (ffeexprCallback) ffestb_R12292_);
-
- default:
- break;
- }
-
-bad: /* :::::::::::::::::::: */
- ffesta_ffebad_2t (FFEBAD_UNREC_STMT, ffesta_tokens[0], t);
- ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
- ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R12292_ -- "STMTFUNCTION" OPEN_PAREN dummy-name-list CLOSE_PAREN
- EQUALS expr
-
- (ffestb_R12292_) // to expression handler
-
- Make sure the statement has a valid form for a STMTFUNCTION statement. If
- it does, implement the statement. */
-
-static ffelexHandler
-ffestb_R12292_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- if (expr == NULL)
- goto bad; /* :::::::::::::::::::: */
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (!ffesta_is_inhibited ())
- ffestc_R1229_finish (expr, ft);
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
-bad: /* :::::::::::::::::::: */
- ffestc_R1229_finish (NULL, NULL);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "statement-function-definition", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_chartype -- Parse the CHARACTER statement
-
- return ffestb_decl_chartype; // to lexer
-
- Make sure the statement has a valid form for the CHARACTER statement. If
- it does, implement the statement. */
-
-ffelexHandler
-ffestb_decl_chartype (ffelexToken t)
-{
- ffeTokenLength i;
- 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_recursive -- Parse the RECURSIVE FUNCTION statement
-
- return ffestb_decl_recursive; // to lexer
-
- Make sure the statement has a valid form for the RECURSIVE FUNCTION
- statement. If it does, implement the statement. */
-
-#if FFESTR_F90
-ffelexHandler
-ffestb_decl_recursive (ffelexToken t)
-{
- ffeTokenLength i;
- const char *p;
- ffelexToken nt;
- ffelexToken ot;
- ffelexHandler next;
- bool needfunc;
-
- switch (ffelex_token_type (ffesta_tokens[0]))
- {
- case FFELEX_typeNAME:
- if (ffesta_first_kw != FFESTR_firstRECURSIVE)
- goto bad_0; /* :::::::::::::::::::: */
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeNAME:
- break;
- }
- ffesta_confirmed ();
- ffestb_local_.decl.recursive = ffelex_token_use (ffesta_tokens[0]);
- switch (ffesta_second_kw)
- {
- case FFESTR_secondINTEGER:
- ffestb_local_.decl.type = FFESTP_typeINTEGER;
- return (ffelexHandler) ffestb_decl_recursive1_;
-
- case FFESTR_secondBYTE:
- ffestb_local_.decl.type = FFESTP_typeBYTE;
- return (ffelexHandler) ffestb_decl_recursive1_;
-
- case FFESTR_secondWORD:
- ffestb_local_.decl.type = FFESTP_typeWORD;
- return (ffelexHandler) ffestb_decl_recursive1_;
-
- case FFESTR_secondREAL:
- ffestb_local_.decl.type = FFESTP_typeREAL;
- return (ffelexHandler) ffestb_decl_recursive1_;
-
- case FFESTR_secondCOMPLEX:
- ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
- return (ffelexHandler) ffestb_decl_recursive1_;
-
- case FFESTR_secondLOGICAL:
- ffestb_local_.decl.type = FFESTP_typeLOGICAL;
- return (ffelexHandler) ffestb_decl_recursive1_;
-
- case FFESTR_secondCHARACTER:
- ffestb_local_.decl.type = FFESTP_typeCHARACTER;
- return (ffelexHandler) ffestb_decl_recursive1_;
-
- case FFESTR_secondDOUBLE:
- return (ffelexHandler) ffestb_decl_recursive2_;
-
- case FFESTR_secondDOUBLEPRECISION:
- ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
- ffestb_local_.decl.kind = NULL;
- ffestb_local_.decl.kindt = NULL;
- ffestb_local_.decl.len = NULL;
- ffestb_local_.decl.lent = NULL;
- return (ffelexHandler) ffestb_decl_func_;
-
- case FFESTR_secondDOUBLECOMPLEX:
- ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
- ffestb_local_.decl.kind = NULL;
- ffestb_local_.decl.kindt = NULL;
- ffestb_local_.decl.len = NULL;
- ffestb_local_.decl.lent = NULL;
- return (ffelexHandler) ffestb_decl_func_;
-
- case FFESTR_secondTYPE:
- ffestb_local_.decl.type = FFESTP_typeTYPE;
- return (ffelexHandler) ffestb_decl_recursive3_;
-
- case FFESTR_secondFUNCTION:
- ffestb_local_.dummy.first_kw = FFESTR_firstFUNCTION;
- ffestb_local_.dummy.badname = "FUNCTION";
- ffestb_local_.dummy.is_subr = FALSE;
- return (ffelexHandler) ffestb_decl_recursive4_;
-
- case FFESTR_secondSUBROUTINE:
- ffestb_local_.dummy.first_kw = FFESTR_firstSUBROUTINE;
- ffestb_local_.dummy.badname = "SUBROUTINE";
- ffestb_local_.dummy.is_subr = TRUE;
- return (ffelexHandler) ffestb_decl_recursive4_;
-
- default:
- ffelex_token_kill (ffestb_local_.decl.recursive);
- goto bad_1; /* :::::::::::::::::::: */
- }
-
- case FFELEX_typeNAMES:
- if (ffesta_first_kw != FFESTR_firstRECURSIVE)
- goto bad_0; /* :::::::::::::::::::: */
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- case FFELEX_typeASTERISK:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeEOS:
- ffesta_confirmed ();
- break;
-
- default:
- break;
- }
- p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlRECURSIVE);
- if (!ffesrc_is_name_init (*p))
- goto bad_0; /* :::::::::::::::::::: */
- ffestb_local_.decl.recursive
- = ffelex_token_name_from_names (ffesta_tokens[0], 0,
- FFESTR_firstlRECURSIVE);
- nt = ffelex_token_names_from_names (ffesta_tokens[0],
- FFESTR_firstlRECURSIVE, 0);
- switch (ffestr_first (nt))
- {
- case FFESTR_firstINTGR:
- p = ffelex_token_text (nt) + (i = FFESTR_firstlINTGR);
- ffestb_local_.decl.type = FFESTP_typeINTEGER;
- needfunc = FALSE;
- goto typefunc; /* :::::::::::::::::::: */
-
- case FFESTR_firstBYTE:
- p = ffelex_token_text (nt) + (i = FFESTR_firstlBYTE);
- ffestb_local_.decl.type = FFESTP_typeBYTE;
- needfunc = FALSE;
- goto typefunc; /* :::::::::::::::::::: */
-
- case FFESTR_firstWORD:
- p = ffelex_token_text (nt) + (i = FFESTR_firstlWORD);
- ffestb_local_.decl.type = FFESTP_typeWORD;
- needfunc = FALSE;
- goto typefunc; /* :::::::::::::::::::: */
-
- case FFESTR_firstREAL:
- p = ffelex_token_text (nt) + (i = FFESTR_firstlREAL);
- ffestb_local_.decl.type = FFESTP_typeREAL;
- needfunc = FALSE;
- goto typefunc; /* :::::::::::::::::::: */
-
- case FFESTR_firstCMPLX:
- p = ffelex_token_text (nt) + (i = FFESTR_firstlCMPLX);
- ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
- needfunc = FALSE;
- goto typefunc; /* :::::::::::::::::::: */
-
- case FFESTR_firstLGCL:
- p = ffelex_token_text (nt) + (i = FFESTR_firstlLGCL);
- ffestb_local_.decl.type = FFESTP_typeLOGICAL;
- needfunc = FALSE;
- goto typefunc; /* :::::::::::::::::::: */
-
- case FFESTR_firstCHRCTR:
- p = ffelex_token_text (nt) + (i = FFESTR_firstlCHRCTR);
- ffestb_local_.decl.type = FFESTP_typeCHARACTER;
- needfunc = FALSE;
- goto typefunc; /* :::::::::::::::::::: */
-
- case FFESTR_firstDBLPRCSN:
- p = ffelex_token_text (nt) + (i = FFESTR_firstlDBLPRCSN);
- ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
- needfunc = TRUE;
- goto typefunc; /* :::::::::::::::::::: */
-
- case FFESTR_firstDBLCMPLX:
- p = ffelex_token_text (nt) + (i = FFESTR_firstlDBLCMPLX);
- ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
- needfunc = TRUE;
- goto typefunc; /* :::::::::::::::::::: */
-
- case FFESTR_firstTYPE:
- p = ffelex_token_text (nt) + (i = FFESTR_firstlTYPE);
- ffestb_local_.decl.type = FFESTP_typeTYPE;
- next = (ffelexHandler) ffestb_decl_recursive3_;
- break;
-
- case FFESTR_firstFUNCTION:
- p = ffelex_token_text (nt) + (i = FFESTR_firstlFUNCTION);
- ffestb_local_.dummy.first_kw = FFESTR_firstFUNCTION;
- ffestb_local_.dummy.badname = "FUNCTION";
- ffestb_local_.dummy.is_subr = FALSE;
- next = (ffelexHandler) ffestb_decl_recursive4_;
- break;
-
- case FFESTR_firstSUBROUTINE:
- p = ffelex_token_text (nt) + (i = FFESTR_firstlSUBROUTINE);
- ffestb_local_.dummy.first_kw = FFESTR_firstSUBROUTINE;
- ffestb_local_.dummy.badname = "SUBROUTINE";
- ffestb_local_.dummy.is_subr = TRUE;
- next = (ffelexHandler) ffestb_decl_recursive4_;
- break;
-
- default:
- ffelex_token_kill (ffestb_local_.decl.recursive);
- ffelex_token_kill (nt);
- goto bad_1; /* :::::::::::::::::::: */
- }
- if (*p == '\0')
- {
- ffelex_token_kill (nt);
- return (ffelexHandler) (*next) (t);
- }
- if (!ffesrc_is_name_init (*p))
- goto bad_i; /* :::::::::::::::::::: */
- ot = ffelex_token_name_from_names (nt, i, 0);
- ffelex_token_kill (nt);
- next = (ffelexHandler) (*next) (ot);
- ffelex_token_kill (ot);
- return (ffelexHandler) (*next) (t);
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
-typefunc: /* :::::::::::::::::::: */
- if (*p == '\0')
- {
- ffelex_token_kill (nt);
- if (needfunc) /* DOUBLE PRECISION or DOUBLE COMPLEX? */
- {
- ffelex_token_kill (ffestb_local_.decl.recursive);
- goto bad_1; /* :::::::::::::::::::: */
- }
- return (ffelexHandler) ffestb_decl_recursive1_ (t);
- }
- if (!ffesrc_is_name_init (*p))
- goto bad_i; /* :::::::::::::::::::: */
- ot = ffelex_token_names_from_names (nt, i, 0);
- ffelex_token_kill (nt);
- if (ffestr_first (ot) != FFESTR_firstFUNCTION)
- goto bad_o; /* :::::::::::::::::::: */
- p = ffelex_token_text (ot) + (i = FFESTR_firstlFUNCTION);
- if (!ffesrc_is_name_init (*p))
- goto bad_i; /* :::::::::::::::::::: */
- ffesta_tokens[1] = ffelex_token_name_from_names (ot, i, 0);
- ffelex_token_kill (ot);
- ffestb_local_.decl.kind = NULL;
- ffestb_local_.decl.kindt = NULL;
- ffestb_local_.decl.len = NULL;
- ffestb_local_.decl.lent = NULL;
- return (ffelexHandler) ffestb_decl_funcname_1_ (t);
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-
-bad_i: /* :::::::::::::::::::: */
- ffelex_token_kill (ffestb_local_.decl.recursive);
- ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", nt, i, t);
- ffelex_token_kill (nt);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_o: /* :::::::::::::::::::: */
- ffelex_token_kill (ffestb_local_.decl.recursive);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", ot);
- ffelex_token_kill (ot);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_recursive1_ -- "RECURSIVE" generic-type
-
- return ffestb_decl_recursive1_; // to lexer
-
- Handle ASTERISK, OPEN_PAREN, or NAME. */
-
-static ffelexHandler
-ffestb_decl_recursive1_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeASTERISK:
- ffesta_confirmed ();
- ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_func_;
- ffestb_local_.decl.badname = "TYPEFUNC";
- if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
- return (ffelexHandler) ffestb_decl_starlen_;
- return (ffelexHandler) ffestb_decl_starkind_;
-
- case FFELEX_typeOPEN_PAREN:
- ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_func_;
- ffestb_local_.decl.badname = "TYPEFUNC";
- if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
- {
- ffestb_local_.decl.kind = NULL;
- ffestb_local_.decl.kindt = NULL;
- ffestb_local_.decl.len = NULL;
- ffestb_local_.decl.lent = NULL;
- return (ffelexHandler) ffestb_decl_typeparams_;
- }
- return (ffelexHandler) ffestb_decl_kindparam_;
-
- case FFELEX_typeNAME:
- ffestb_local_.decl.kind = NULL;
- ffestb_local_.decl.kindt = NULL;
- ffestb_local_.decl.len = NULL;
- ffestb_local_.decl.lent = NULL;
- return (ffelexHandler) ffestb_decl_func_ (t);
-
- default:
- break;
- }
-
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_recursive2_ -- "RECURSIVE" "DOUBLE"
-
- return ffestb_decl_recursive2_; // to lexer
-
- Handle NAME. */
-
-static ffelexHandler
-ffestb_decl_recursive2_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- switch (ffestr_second (t))
- {
- case FFESTR_secondPRECISION:
- ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
- break;
-
- case FFESTR_secondCOMPLEX:
- ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
- break;
-
- default:
- goto bad; /* :::::::::::::::::::: */
- }
- ffestb_local_.decl.kind = NULL;
- ffestb_local_.decl.kindt = NULL;
- ffestb_local_.decl.len = NULL;
- ffestb_local_.decl.lent = NULL;
- return (ffelexHandler) ffestb_decl_func_;
-
- default:
- break;
- }
-
-bad: /* :::::::::::::::::::: */
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_recursive3_ -- "RECURSIVE" "TYPE"
-
- return ffestb_decl_recursive3_; // to lexer
-
- Handle OPEN_PAREN. */
-
-static ffelexHandler
-ffestb_decl_recursive3_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeOPEN_PAREN:
- ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_func_;
- ffestb_local_.decl.badname = "TYPEFUNC";
- return (ffelexHandler) ffestb_decl_typetype1_;
-
- default:
- break;
- }
-
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_recursive4_ -- "RECURSIVE" "FUNCTION/SUBROUTINE"
-
- return ffestb_decl_recursive4_; // to lexer
-
- Handle OPEN_PAREN. */
-
-static ffelexHandler
-ffestb_decl_recursive4_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_dummy1_;
-
- default:
- break;
- }
-
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-#endif
-/* ffestb_decl_typetype -- Parse the R426/R501/R1219 TYPE statement
-
- return ffestb_decl_typetype; // to lexer
-
- Make sure the statement has a valid form for the TYPE statement. If it
- does, implement the statement. */
-
-#if FFESTR_F90
-ffelexHandler
-ffestb_decl_typetype (ffelexToken t)
-{
- switch (ffelex_token_type (ffesta_tokens[0]))
- {
- case FFELEX_typeNAME:
- if (ffesta_first_kw != FFESTR_firstTYPE)
- goto bad_0; /* :::::::::::::::::::: */
- break;
-
- case FFELEX_typeNAMES:
- if (ffesta_first_kw != FFESTR_firstTYPE)
- goto bad_0; /* :::::::::::::::::::: */
- if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlTYPE)
- goto bad_0; /* :::::::::::::::::::: */
- break;
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeOPEN_PAREN:
- break;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeCOLONCOLON:/* Not COMMA: R424 "TYPE,PUBLIC::A". */
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
- }
-
- ffestb_local_.decl.recursive = NULL;
- ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
- ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
-
- ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
- ffestb_local_.decl.badname = "type-declaration";
- return (ffelexHandler) ffestb_decl_typetype1_;
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-}
-
-#endif
-/* ffestb_decl_attrs_ -- "type" [type parameters] COMMA
-
- return ffestb_decl_attrs_; // to lexer
-
- Handle NAME of an attribute. */
-
-static ffelexHandler
-ffestb_decl_attrs_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- switch (ffestr_first (t))
- {
-#if FFESTR_F90
- case FFESTR_firstALLOCATABLE:
- if (!ffesta_is_inhibited ())
- ffestc_decl_attrib (FFESTP_attribALLOCATABLE, t,
- FFESTR_otherNone, NULL);
- return (ffelexHandler) ffestb_decl_attrs_7_;
-#endif
-
- case FFESTR_firstDIMENSION:
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_decl_attrs_1_;
-
- case FFESTR_firstEXTERNAL:
- if (!ffesta_is_inhibited ())
- ffestc_decl_attrib (FFESTP_attribEXTERNAL, t,
- FFESTR_otherNone, NULL);
- return (ffelexHandler) ffestb_decl_attrs_7_;
-
-#if FFESTR_F90
- case FFESTR_firstINTENT:
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_decl_attrs_3_;
-#endif
-
- case FFESTR_firstINTRINSIC:
- if (!ffesta_is_inhibited ())
- ffestc_decl_attrib (FFESTP_attribINTRINSIC, t,
- FFESTR_otherNone, NULL);
- return (ffelexHandler) ffestb_decl_attrs_7_;
-
-#if FFESTR_F90
- case FFESTR_firstOPTIONAL:
- if (!ffesta_is_inhibited ())
- ffestc_decl_attrib (FFESTP_attribOPTIONAL, t,
- FFESTR_otherNone, NULL);
- return (ffelexHandler) ffestb_decl_attrs_7_;
-#endif
-
- case FFESTR_firstPARAMETER:
- ffestb_local_.decl.parameter = TRUE;
- if (!ffesta_is_inhibited ())
- ffestc_decl_attrib (FFESTP_attribPARAMETER, t,
- FFESTR_otherNone, NULL);
- return (ffelexHandler) ffestb_decl_attrs_7_;
-
-#if FFESTR_F90
- case FFESTR_firstPOINTER:
- if (!ffesta_is_inhibited ())
- ffestc_decl_attrib (FFESTP_attribPOINTER, t,
- FFESTR_otherNone, NULL);
- return (ffelexHandler) ffestb_decl_attrs_7_;
-#endif
-
-#if FFESTR_F90
- case FFESTR_firstPRIVATE:
- if (!ffesta_is_inhibited ())
- ffestc_decl_attrib (FFESTP_attribPRIVATE, t,
- FFESTR_otherNone, NULL);
- return (ffelexHandler) ffestb_decl_attrs_7_;
-
- case FFESTR_firstPUBLIC:
- if (!ffesta_is_inhibited ())
- ffestc_decl_attrib (FFESTP_attribPUBLIC, t,
- FFESTR_otherNone, NULL);
- return (ffelexHandler) ffestb_decl_attrs_7_;
-#endif
-
- case FFESTR_firstSAVE:
- if (!ffesta_is_inhibited ())
- ffestc_decl_attrib (FFESTP_attribSAVE, t,
- FFESTR_otherNone, NULL);
- return (ffelexHandler) ffestb_decl_attrs_7_;
-
-#if FFESTR_F90
- case FFESTR_firstTARGET:
- if (!ffesta_is_inhibited ())
- ffestc_decl_attrib (FFESTP_attribTARGET, t,
- FFESTR_otherNone, NULL);
- return (ffelexHandler) ffestb_decl_attrs_7_;
-#endif
-
- default:
- ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
- return (ffelexHandler) ffestb_decl_attrs_7_;
- }
- break;
-
- default:
- break;
- }
-
- if (!ffesta_is_inhibited ())
- ffestc_decl_finish ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_attrs_1_ -- "type" [type parameters] ",DIMENSION"
-
- return ffestb_decl_attrs_1_; // to lexer
-
- Handle OPEN_PAREN. */
-
-static ffelexHandler
-ffestb_decl_attrs_1_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeOPEN_PAREN:
- ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
- ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_decl_attrs_2_;
- ffestb_subrargs_.dim_list.pool = ffesta_scratch_pool;
- ffestb_subrargs_.dim_list.ctx = ffesta_is_entry_valid
- ? FFEEXPR_contextDIMLIST : FFEEXPR_contextDIMLISTCOMMON;
-#ifdef FFECOM_dimensionsMAX
- ffestb_subrargs_.dim_list.ndims = 0;
-#endif
- return (ffelexHandler) ffeexpr_rhs (ffesta_scratch_pool,
- ffestb_subrargs_.dim_list.ctx,
- (ffeexprCallback) ffestb_subr_dimlist_);
-
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffestb_decl_attrs_7_ (t);
-
- default:
- break;
- }
-
- if (!ffesta_is_inhibited ())
- ffestc_decl_finish ();
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_attrs_2_ -- "type" [type parameters] ",DIMENSION" OPEN_PAREN
- dimlist CLOSE_PAREN
-
- return ffestb_decl_attrs_2_; // to lexer
-
- Handle COMMA or COLONCOLON. */
-
-static ffelexHandler
-ffestb_decl_attrs_2_ (ffelexToken t)
-{
- if (!ffestb_subrargs_.dim_list.ok)
- goto bad; /* :::::::::::::::::::: */
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- if (!ffesta_is_inhibited ())
- ffestc_decl_attrib (FFESTP_attribDIMENSION, ffesta_tokens[1],
- FFESTR_otherNone, ffestb_subrargs_.dim_list.dims);
- ffelex_token_kill (ffesta_tokens[1]);
- ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
- return (ffelexHandler) ffestb_decl_attrs_7_ (t);
-
- default:
- break;
- }
-
-bad: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
- if (!ffesta_is_inhibited ())
- ffestc_decl_finish ();
- ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_attrs_3_ -- "type" [type parameters] ",INTENT"
-
- return ffestb_decl_attrs_3_; // to lexer
-
- Handle OPEN_PAREN. */
-
-#if FFESTR_F90
-static ffelexHandler
-ffestb_decl_attrs_3_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeOPEN_PAREN:
- return (ffelexHandler) ffestb_decl_attrs_4_;
-
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffestb_decl_attrs_7_ (t);
-
- default:
- break;
- }
-
- if (!ffesta_is_inhibited ())
- ffestc_decl_finish ();
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_attrs_4_ -- "type" [type parameters] ",INTENT" OPEN_PAREN
-
- return ffestb_decl_attrs_4_; // to lexer
-
- Handle NAME. */
-
-static ffelexHandler
-ffestb_decl_attrs_4_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffestb_local_.decl.kw = ffestr_other (t);
- switch (ffestb_local_.decl.kw)
- {
- case FFESTR_otherIN:
- return (ffelexHandler) ffestb_decl_attrs_5_;
-
- case FFESTR_otherINOUT:
- return (ffelexHandler) ffestb_decl_attrs_6_;
-
- case FFESTR_otherOUT:
- return (ffelexHandler) ffestb_decl_attrs_6_;
-
- default:
- ffestb_local_.decl.kw = FFESTR_otherNone;
- ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
- return (ffelexHandler) ffestb_decl_attrs_5_;
- }
- break;
-
- default:
- break;
- }
-
- if (!ffesta_is_inhibited ())
- ffestc_decl_finish ();
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_attrs_5_ -- "type" [type parameters] ",INTENT" OPEN_PAREN "IN"
-
- return ffestb_decl_attrs_5_; // to lexer
-
- Handle NAME or CLOSE_PAREN. */
-
-static ffelexHandler
-ffestb_decl_attrs_5_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- switch (ffestr_other (t))
- {
- case FFESTR_otherOUT:
- if (ffestb_local_.decl.kw != FFESTR_otherNone)
- ffestb_local_.decl.kw = FFESTR_otherINOUT;
- return (ffelexHandler) ffestb_decl_attrs_6_;
-
- default:
- if (ffestb_local_.decl.kw != FFESTR_otherNone)
- {
- ffestb_local_.decl.kw = FFESTR_otherNone;
- ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
- }
- return (ffelexHandler) ffestb_decl_attrs_5_;
- }
- break;
-
- case FFELEX_typeCLOSE_PAREN:
- return (ffelexHandler) ffestb_decl_attrs_6_ (t);
-
- default:
- break;
- }
-
- if (!ffesta_is_inhibited ())
- ffestc_decl_finish ();
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_attrs_6_ -- "type" [type parameters] ",INTENT" OPEN_PAREN "IN"
- ["OUT"]
-
- return ffestb_decl_attrs_6_; // to lexer
-
- Handle CLOSE_PAREN. */
-
-static ffelexHandler
-ffestb_decl_attrs_6_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCLOSE_PAREN:
- if ((ffestb_local_.decl.kw != FFESTR_otherNone)
- && !ffesta_is_inhibited ())
- ffestc_decl_attrib (FFESTP_attribINTENT, ffesta_tokens[1],
- ffestb_local_.decl.kw, NULL);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffestb_decl_attrs_7_;
-
- default:
- break;
- }
-
- if (!ffesta_is_inhibited ())
- ffestc_decl_finish ();
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-#endif
-/* ffestb_decl_attrs_7_ -- "type" [type parameters] attribute
-
- return ffestb_decl_attrs_7_; // to lexer
-
- Handle COMMA (another attribute) or COLONCOLON (entities). */
-
-static ffelexHandler
-ffestb_decl_attrs_7_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- return (ffelexHandler) ffestb_decl_attrs_;
-
- case FFELEX_typeCOLONCOLON:
- ffestb_local_.decl.coloncolon = TRUE;
- return (ffelexHandler) ffestb_decl_ents_;
-
- default:
- break;
- }
-
- if (!ffesta_is_inhibited ())
- ffestc_decl_finish ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_attrsp_ -- "type" [type parameters]
-
- return ffestb_decl_attrsp_; // to lexer
-
- Handle COMMA (meaning we have attributes), COLONCOLON (meaning we have
- no attributes but entities), or go to entsp to see about functions or
- entities. */
-
-static ffelexHandler
-ffestb_decl_attrsp_ (ffelexToken t)
-{
- ffelex_set_names (FALSE);
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
- ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
- ffestb_local_.decl.len, ffestb_local_.decl.lent);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- return (ffelexHandler) ffestb_decl_attrs_;
-
- case FFELEX_typeCOLONCOLON:
- ffestb_local_.decl.coloncolon = TRUE;
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
- ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
- ffestb_local_.decl.len, ffestb_local_.decl.lent);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- return (ffelexHandler) ffestb_decl_ents_;
-
- default:
- return (ffelexHandler) ffestb_decl_entsp_ (t);
- }
-}
-
-/* ffestb_decl_ents_ -- "type" [type parameters] [attributes "::"]
-
- return ffestb_decl_ents_; // to lexer
-
- Handle NAME of an entity. */
-
-static ffelexHandler
-ffestb_decl_ents_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_decl_ents_1_;
-
- default:
- break;
- }
-
- if (!ffesta_is_inhibited ())
- ffestc_decl_finish ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_ents_1_ -- "type" [type parameters] [attributes "::"] NAME
-
- return ffestb_decl_ents_1_; // to lexer
-
- Handle ASTERISK, OPEN_PAREN, EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */
-
-static ffelexHandler
-ffestb_decl_ents_1_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- if (!ffesta_is_inhibited ())
- ffestc_decl_item (ffesta_tokens[1], NULL, NULL, NULL, NULL, NULL, NULL,
- NULL, FALSE);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffestb_decl_ents_;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (!ffesta_is_inhibited ())
- {
- ffestc_decl_item (ffesta_tokens[1], NULL, NULL, NULL, NULL, NULL, NULL,
- NULL, FALSE);
- ffestc_decl_finish ();
- }
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffesta_zero (t);
-
- case FFELEX_typeASTERISK:
- ffestb_local_.decl.len = NULL;
- ffestb_local_.decl.lent = NULL;
- return (ffelexHandler) ffestb_decl_ents_2_;
-
- case FFELEX_typeOPEN_PAREN:
- ffestb_local_.decl.kind = NULL;
- ffestb_local_.decl.kindt = NULL;
- ffestb_local_.decl.len = NULL;
- ffestb_local_.decl.lent = NULL;
- return (ffelexHandler) ffestb_decl_ents_3_ (t);
-
- case FFELEX_typeEQUALS:
- case FFELEX_typeSLASH:
- ffestb_local_.decl.kind = NULL;
- ffestb_local_.decl.kindt = NULL;
- ffestb_subrargs_.dim_list.dims = NULL;
- ffestb_local_.decl.len = NULL;
- ffestb_local_.decl.lent = NULL;
- return (ffelexHandler) ffestb_decl_ents_7_ (t);
-
- default:
- break;
- }
-
- if (!ffesta_is_inhibited ())
- ffestc_decl_finish ();
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_ents_2_ -- "type" [type parameters] [attributes "::"] NAME
- ASTERISK
-
- return ffestb_decl_ents_2_; // to lexer
-
- Handle NUMBER or OPEN_PAREN. */
-
-static ffelexHandler
-ffestb_decl_ents_2_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNUMBER:
- if (ffestb_local_.decl.type != FFESTP_typeCHARACTER)
- {
- ffestb_local_.decl.kind = NULL;
- ffestb_local_.decl.kindt = ffelex_token_use (t);
- return (ffelexHandler) ffestb_decl_ents_3_;
- }
- /* Fall through. *//* (CHARACTER's *n is always a len spec. */
- case FFELEX_typeOPEN_PAREN:/* "*(" is after the (omitted)
- "(array-spec)". */
- ffestb_local_.decl.kind = NULL;
- ffestb_local_.decl.kindt = NULL;
- ffestb_subrargs_.dim_list.dims = NULL;
- return (ffelexHandler) ffestb_decl_ents_5_ (t);
-
- default:
- break;
- }
-
- if (!ffesta_is_inhibited ())
- ffestc_decl_finish ();
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_ents_3_ -- "type" [type parameters] [attributes "::"] NAME
- [ASTERISK NUMBER]
-
- return ffestb_decl_ents_3_; // to lexer
-
- Handle ASTERISK, OPEN_PAREN, EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */
-
-static ffelexHandler
-ffestb_decl_ents_3_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- if (!ffesta_is_inhibited ())
- ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
- ffestb_local_.decl.kindt, NULL, NULL, NULL, NULL, NULL, FALSE);
- ffelex_token_kill (ffesta_tokens[1]);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- return (ffelexHandler) ffestb_decl_ents_;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (!ffesta_is_inhibited ())
- {
- ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
- ffestb_local_.decl.kindt, NULL, NULL, NULL, NULL, NULL, FALSE);
- ffestc_decl_finish ();
- }
- ffelex_token_kill (ffesta_tokens[1]);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- return (ffelexHandler) ffesta_zero (t);
-
- case FFELEX_typeASTERISK:
- ffestb_subrargs_.dim_list.dims = NULL;
- return (ffelexHandler) ffestb_decl_ents_5_;
-
- case FFELEX_typeOPEN_PAREN:
- ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
- ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_decl_ents_4_;
- ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
- ffestb_subrargs_.dim_list.ctx = ffesta_is_entry_valid
- ? FFEEXPR_contextDIMLIST : FFEEXPR_contextDIMLISTCOMMON;
-#ifdef FFECOM_dimensionsMAX
- ffestb_subrargs_.dim_list.ndims = 0;
-#endif
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- ffestb_subrargs_.dim_list.ctx,
- (ffeexprCallback) ffestb_subr_dimlist_);
-
- case FFELEX_typeEQUALS:
- case FFELEX_typeSLASH:
- ffestb_local_.decl.kind = NULL;
- ffestb_local_.decl.kindt = NULL;
- ffestb_subrargs_.dim_list.dims = NULL;
- ffestb_local_.decl.len = NULL;
- ffestb_local_.decl.lent = NULL;
- return (ffelexHandler) ffestb_decl_ents_7_ (t);
-
- default:
- break;
- }
-
- if (!ffesta_is_inhibited ())
- ffestc_decl_finish ();
- ffelex_token_kill (ffesta_tokens[1]);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_ents_4_ -- "type" [type parameters] [attributes "::"] NAME
- [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
-
- return ffestb_decl_ents_4_; // to lexer
-
- Handle ASTERISK, EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */
-
-static ffelexHandler
-ffestb_decl_ents_4_ (ffelexToken t)
-{
- ffelexToken nt;
-
- if (!ffestb_subrargs_.dim_list.ok)
- goto bad; /* :::::::::::::::::::: */
-
- if (ffelex_token_type (ffesta_tokens[1]) == FFELEX_typeNAMES)
- {
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeASTERISK:
- case FFELEX_typeSLASH: /* But NOT FFELEX_typeEQUALS. */
- case FFELEX_typeCOLONCOLON: /* Actually an error. */
- break; /* Confirm and handle. */
-
- default: /* Perhaps EQUALS, as in
- INTEGERFUNCTIONX(A)=B. */
- goto bad; /* :::::::::::::::::::: */
- }
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- {
- nt = ffelex_token_name_from_names (ffesta_tokens[1], 0, 0);
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_tokens[1] = nt;
- ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
- NULL, NULL, NULL, NULL);
- }
- }
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- if (!ffesta_is_inhibited ())
- ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
- ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
- ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
- FALSE);
- ffelex_token_kill (ffesta_tokens[1]);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
- return (ffelexHandler) ffestb_decl_ents_;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (!ffesta_is_inhibited ())
- {
- ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
- ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
- ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
- FALSE);
- ffestc_decl_finish ();
- }
- ffelex_token_kill (ffesta_tokens[1]);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
- return (ffelexHandler) ffesta_zero (t);
-
- case FFELEX_typeASTERISK:
- if (ffestb_local_.decl.lent != NULL)
- break; /* Can't specify "*length" twice. */
- return (ffelexHandler) ffestb_decl_ents_5_;
-
- case FFELEX_typeEQUALS:
- case FFELEX_typeSLASH:
- return (ffelexHandler) ffestb_decl_ents_7_ (t);
-
- default:
- break;
- }
-
-bad: /* :::::::::::::::::::: */
- if ((ffelex_token_type (ffesta_tokens[1]) != FFELEX_typeNAMES)
- && !ffesta_is_inhibited ())
- ffestc_decl_finish ();
- ffelex_token_kill (ffesta_tokens[1]);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_ents_5_ -- "type" [type parameters] [attributes "::"] NAME
- [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
- ASTERISK
-
- return ffestb_decl_ents_5_; // to lexer
-
- Handle NUMBER or OPEN_PAREN. */
-
-static ffelexHandler
-ffestb_decl_ents_5_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNUMBER:
- ffestb_local_.decl.len = NULL;
- ffestb_local_.decl.lent = ffelex_token_use (t);
- return (ffelexHandler) ffestb_decl_ents_7_;
-
- case FFELEX_typeOPEN_PAREN:
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextCHARACTERSIZE, (ffeexprCallback) ffestb_decl_ents_6_);
-
- default:
- break;
- }
-
- if (!ffesta_is_inhibited ())
- ffestc_decl_finish ();
- ffelex_token_kill (ffesta_tokens[1]);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_subrargs_.dim_list.dims != NULL)
- ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_ents_6_ -- "type" [type parameters] [attributes "::"] NAME
- [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
- ASTERISK OPEN_PAREN expr
-
- (ffestb_decl_ents_6_) // to expression handler
-
- Handle CLOSE_PAREN. */
-
-static ffelexHandler
-ffestb_decl_ents_6_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCLOSE_PAREN:
- if (expr == NULL)
- break;
- ffestb_local_.decl.len = expr;
- ffestb_local_.decl.lent = ffelex_token_use (ft);
- return (ffelexHandler) ffestb_decl_ents_7_;
-
- default:
- break;
- }
-
- if (!ffesta_is_inhibited ())
- ffestc_decl_finish ();
- ffelex_token_kill (ffesta_tokens[1]);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_subrargs_.dim_list.dims != NULL)
- ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_ents_7_ -- "type" [type parameters] [attributes "::"] NAME
- [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
- [ASTERISK charlength]
-
- return ffestb_decl_ents_7_; // to lexer
-
- Handle EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */
-
-static ffelexHandler
-ffestb_decl_ents_7_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- if (!ffesta_is_inhibited ())
- ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
- ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
- ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
- FALSE);
- ffelex_token_kill (ffesta_tokens[1]);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_subrargs_.dim_list.dims != NULL)
- ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- return (ffelexHandler) ffestb_decl_ents_;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (!ffesta_is_inhibited ())
- {
- ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
- ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
- ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
- FALSE);
- ffestc_decl_finish ();
- }
- ffelex_token_kill (ffesta_tokens[1]);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_subrargs_.dim_list.dims != NULL)
- ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- return (ffelexHandler) ffesta_zero (t);
-
- case FFELEX_typeEQUALS:
- if (!ffestb_local_.decl.coloncolon)
- ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_INIT, t);
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- ffestb_local_.decl.parameter ? FFEEXPR_contextPARAMETER
- : FFEEXPR_contextINITVAL, (ffeexprCallback) ffestb_decl_ents_8_);
-
- case FFELEX_typeSLASH:
- if (!ffesta_is_inhibited ())
- {
- ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
- ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
- ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
- TRUE);
- ffestc_decl_itemstartvals ();
- }
- ffelex_token_kill (ffesta_tokens[1]);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_subrargs_.dim_list.dims != NULL)
- ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- return (ffelexHandler) ffeexpr_rhs
- (ffesta_output_pool, FFEEXPR_contextDATA,
- (ffeexprCallback) ffestb_decl_ents_9_);
-
- default:
- break;
- }
-
- if (!ffesta_is_inhibited ())
- ffestc_decl_finish ();
- ffelex_token_kill (ffesta_tokens[1]);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_subrargs_.dim_list.dims != NULL)
- ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_ents_8_ -- "type" [type parameters] [attributes "::"] NAME
- [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
- [ASTERISK charlength] EQUALS expr
-
- (ffestb_decl_ents_8_) // to expression handler
-
- Handle COMMA or EOS/SEMICOLON. */
-
-static ffelexHandler
-ffestb_decl_ents_8_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- if (expr == NULL)
- break;
- if (!ffesta_is_inhibited ())
- ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
- ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
- ffestb_local_.decl.len, ffestb_local_.decl.lent, expr, ft,
- FALSE);
- ffelex_token_kill (ffesta_tokens[1]);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_subrargs_.dim_list.dims != NULL)
- ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- return (ffelexHandler) ffestb_decl_ents_;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (!ffesta_is_inhibited ())
- {
- ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
- ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
- ffestb_local_.decl.len, ffestb_local_.decl.lent, expr, ft,
- FALSE);
- ffestc_decl_finish ();
- }
- ffelex_token_kill (ffesta_tokens[1]);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_subrargs_.dim_list.dims != NULL)
- ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- if (!ffesta_is_inhibited ())
- ffestc_decl_finish ();
- ffelex_token_kill (ffesta_tokens[1]);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_subrargs_.dim_list.dims != NULL)
- ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_ents_9_ -- "type" ... SLASH expr
-
- (ffestb_decl_ents_9_) // to expression handler
-
- Handle ASTERISK, COMMA, or SLASH. */
-
-static ffelexHandler
-ffestb_decl_ents_9_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- if (expr == NULL)
- break;
- if (!ffesta_is_inhibited ())
- ffestc_decl_itemvalue (NULL, NULL, expr, ft);
- return (ffelexHandler) ffeexpr_rhs
- (ffesta_output_pool, FFEEXPR_contextDATA,
- (ffeexprCallback) ffestb_decl_ents_9_);
-
- case FFELEX_typeASTERISK:
- if (expr == NULL)
- break;
- ffestb_local_.decl.expr = expr;
- ffesta_tokens[1] = ffelex_token_use (ft);
- return (ffelexHandler) ffeexpr_rhs
- (ffesta_output_pool, FFEEXPR_contextDATA,
- (ffeexprCallback) ffestb_decl_ents_10_);
-
- case FFELEX_typeSLASH:
- if (expr == NULL)
- break;
- if (!ffesta_is_inhibited ())
- {
- ffestc_decl_itemvalue (NULL, NULL, expr, ft);
- ffestc_decl_itemendvals (t);
- }
- return (ffelexHandler) ffestb_decl_ents_11_;
-
- default:
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
- break;
- }
-
- if (!ffesta_is_inhibited ())
- {
- ffestc_decl_itemendvals (t);
- ffestc_decl_finish ();
- }
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_ents_10_ -- "type" ... SLASH expr ASTERISK expr
-
- (ffestb_decl_ents_10_) // to expression handler
-
- Handle COMMA or SLASH. */
-
-static ffelexHandler
-ffestb_decl_ents_10_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- if (expr == NULL)
- break;
- if (!ffesta_is_inhibited ())
- ffestc_decl_itemvalue (ffestb_local_.decl.expr, ffesta_tokens[1],
- expr, ft);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffeexpr_rhs
- (ffesta_output_pool, FFEEXPR_contextDATA,
- (ffeexprCallback) ffestb_decl_ents_9_);
-
- case FFELEX_typeSLASH:
- if (expr == NULL)
- break;
- if (!ffesta_is_inhibited ())
- {
- ffestc_decl_itemvalue (ffestb_local_.decl.expr, ffesta_tokens[1],
- expr, ft);
- ffestc_decl_itemendvals (t);
- }
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffestb_decl_ents_11_;
-
- default:
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
- break;
- }
-
- if (!ffesta_is_inhibited ())
- {
- ffestc_decl_itemendvals (t);
- ffestc_decl_finish ();
- }
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_ents_11_ -- "type" [type parameters] [attributes "::"] NAME
- [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
- [ASTERISK charlength] SLASH initvals SLASH
-
- return ffestb_decl_ents_11_; // to lexer
-
- Handle COMMA or EOS/SEMICOLON. */
-
-static ffelexHandler
-ffestb_decl_ents_11_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- return (ffelexHandler) ffestb_decl_ents_;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (!ffesta_is_inhibited ())
- ffestc_decl_finish ();
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- if (!ffesta_is_inhibited ())
- ffestc_decl_finish ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_entsp_ -- "type" [type parameters]
-
- return ffestb_decl_entsp_; // to lexer
-
- Handle NAME or NAMES beginning either an entity (object) declaration or
- a function definition.. */
-
-static ffelexHandler
-ffestb_decl_entsp_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_confirmed ();
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_decl_entsp_1_;
-
- case FFELEX_typeNAMES:
- ffesta_confirmed ();
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_decl_entsp_2_;
-
- default:
- break;
- }
-
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_entsp_1_ -- "type" [type parameters] NAME
-
- return ffestb_decl_entsp_1_; // to lexer
-
- If we get another NAME token here, then the previous one must be
- "RECURSIVE" or "FUNCTION" and we handle it accordingly. Otherwise,
- we send the previous and current token through to _ents_. */
-
-static ffelexHandler
-ffestb_decl_entsp_1_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- switch (ffestr_first (ffesta_tokens[1]))
- {
-#if FFESTR_F90
- case FFESTR_firstRECURSIVE:
- if (ffestr_first (t) != FFESTR_firstFUNCTION)
- {
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
- break;
- }
- ffestb_local_.decl.recursive = ffesta_tokens[1];
- return (ffelexHandler) ffestb_decl_funcname_;
-#endif
-
- case FFESTR_firstFUNCTION:
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffestb_decl_funcname_ (t);
-
- default:
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", ffesta_tokens[1]);
- break;
- }
- break;
-
- default:
- if ((ffelex_token_type (ffesta_tokens[1]) != FFELEX_typeNAMES)
- && !ffesta_is_inhibited ())
- ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
- ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
- ffestb_local_.decl.len, ffestb_local_.decl.lent);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- /* NAME/NAMES token already in ffesta_tokens[1]. */
- return (ffelexHandler) ffestb_decl_ents_1_ (t);
- }
-
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_entsp_2_ -- "type" [type parameters] NAMES
-
- return ffestb_decl_entsp_2_; // to lexer
-
- If we get an ASTERISK or OPEN_PAREN here, then if the previous NAMES
- begins with "FUNCTION" or "RECURSIVEFUNCTION" and is followed by a
- first-name-char, we have a possible syntactically ambiguous situation.
- Otherwise, we have a straightforward situation just as if we went
- through _entsp_1_ instead of here. */
-
-static ffelexHandler
-ffestb_decl_entsp_2_ (ffelexToken t)
-{
- ffelexToken nt;
- bool asterisk_ok;
- 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]))
- {
-#if FFESTR_F90
- case FFESTR_firstRECURSIVEFNCTN:
- if (!asterisk_ok)
- break; /* For our own convenience, treat as non-FN
- stmt. */
- p = ffelex_token_text (ffesta_tokens[1])
- + (i = FFESTR_firstlRECURSIVEFNCTN);
- if (!ffesrc_is_name_init (*p))
- break;
- ffestb_local_.decl.recursive
- = ffelex_token_name_from_names (ffesta_tokens[1], 0,
- FFESTR_firstlRECURSIVEFNCTN);
- ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
- FFESTR_firstlRECURSIVEFNCTN, 0);
- return (ffelexHandler) ffestb_decl_entsp_3_;
-#endif
-
- case FFESTR_firstFUNCTION:
- if (!asterisk_ok)
- break; /* For our own convenience, treat as non-FN
- stmt. */
- p = ffelex_token_text (ffesta_tokens[1])
- + (i = FFESTR_firstlFUNCTION);
- if (!ffesrc_is_name_init (*p))
- break;
- ffestb_local_.decl.recursive = NULL;
- ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
- FFESTR_firstlFUNCTION, 0);
- return (ffelexHandler) ffestb_decl_entsp_3_;
-
- default:
- break;
- }
- break;
-
- case FFELEX_typeOPEN_PAREN:
- ffestb_local_.decl.aster_after = FALSE;
- switch (ffestr_first (ffesta_tokens[1]))
- {
-#if FFESTR_F90
- case FFESTR_firstRECURSIVEFNCTN:
- p = ffelex_token_text (ffesta_tokens[1])
- + (i = FFESTR_firstlRECURSIVEFNCTN);
- if (!ffesrc_is_name_init (*p))
- break;
- ffestb_local_.decl.recursive
- = ffelex_token_name_from_names (ffesta_tokens[1], 0,
- FFESTR_firstlRECURSIVEFNCTN);
- ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
- FFESTR_firstlRECURSIVEFNCTN, 0);
- return (ffelexHandler) ffestb_decl_entsp_5_ (t);
-#endif
-
- case FFESTR_firstFUNCTION:
- p = ffelex_token_text (ffesta_tokens[1])
- + (i = FFESTR_firstlFUNCTION);
- if (!ffesrc_is_name_init (*p))
- break;
- ffestb_local_.decl.recursive = NULL;
- ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
- FFESTR_firstlFUNCTION, 0);
- return (ffelexHandler) ffestb_decl_entsp_5_ (t);
-
- default:
- break;
- }
- if ((ffestb_local_.decl.kindt != NULL)
- || (ffestb_local_.decl.lent != NULL))
- break; /* Have kind/len type param, definitely not
- assignment stmt. */
- return (ffelexHandler) ffestb_decl_entsp_1_ (t);
-
- default:
- break;
- }
-
- nt = ffelex_token_name_from_names (ffesta_tokens[1], 0, 0);
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_tokens[1] = nt; /* Change NAMES to NAME. */
- return (ffelexHandler) ffestb_decl_entsp_1_ (t);
-}
-
-/* ffestb_decl_entsp_3_ -- "type" [type parameters] [RECURSIVE] FUNCTION
- NAME ASTERISK
-
- return ffestb_decl_entsp_3_; // to lexer
-
- Handle NUMBER or OPEN_PAREN. */
-
-static ffelexHandler
-ffestb_decl_entsp_3_ (ffelexToken t)
-{
- ffestb_local_.decl.aster_after = TRUE;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNUMBER:
- switch (ffestb_local_.decl.type)
- {
- case FFESTP_typeINTEGER:
- case FFESTP_typeREAL:
- case FFESTP_typeCOMPLEX:
- case FFESTP_typeLOGICAL:
- ffestb_local_.decl.kindt = ffelex_token_use (t);
- break;
-
- case FFESTP_typeCHARACTER:
- ffestb_local_.decl.lent = ffelex_token_use (t);
- break;
-
- case FFESTP_typeBYTE:
- case FFESTP_typeWORD:
- default:
- assert (FALSE);
- }
- return (ffelexHandler) ffestb_decl_entsp_5_;
-
- case FFELEX_typeOPEN_PAREN:
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextCHARACTERSIZE,
- (ffeexprCallback) ffestb_decl_entsp_4_);
-
- default:
- break;
- }
-
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffelex_token_kill (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[2]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_entsp_4_ -- "type" [type parameters] [RECURSIVE] FUNCTION
- NAME ASTERISK OPEN_PAREN expr
-
- (ffestb_decl_entsp_4_) // to expression handler
-
- Allow only CLOSE_PAREN; and deal with character-length expression. */
-
-static ffelexHandler
-ffestb_decl_entsp_4_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCLOSE_PAREN:
- if (expr == NULL)
- break;
- switch (ffestb_local_.decl.type)
- {
- case FFESTP_typeCHARACTER:
- ffestb_local_.decl.len = expr;
- ffestb_local_.decl.lent = ffelex_token_use (ft);
- break;
-
- default:
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
- break;
- }
- return (ffelexHandler) ffestb_decl_entsp_5_;
-
- default:
- break;
- }
-
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffelex_token_kill (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[2]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_entsp_5_ -- "type" [type parameters] [RECURSIVE] FUNCTION
- NAME [type parameter]
-
- return ffestb_decl_entsp_5_; // to lexer
-
- Make sure the next token is an OPEN_PAREN. Get the arg list or dimension
- list. If it can't be an arg list, or if the CLOSE_PAREN is followed by
- something other than EOS/SEMICOLON or NAME, then treat as dimension list
- and handle statement as an R426/R501. If it can't be a dimension list, or
- if the CLOSE_PAREN is followed by NAME, treat as an arg list and handle
- statement as an R1219. If it can be either an arg list or a dimension
- list and if the CLOSE_PAREN is followed by EOS/SEMICOLON, ask FFESTC
- whether to treat the statement as an R426/R501 or an R1219 and act
- accordingly. */
-
-static ffelexHandler
-ffestb_decl_entsp_5_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeOPEN_PAREN:
- if (ffestb_local_.decl.aster_after && (ffestb_local_.decl.len != NULL))
- { /* "CHARACTER[RECURSIVE]FUNCTIONxyz*(len-expr)
- (..." must be a function-stmt, since the
- (len-expr) cannot precede (array-spec) in
- an object declaration but can precede
- (name-list) in a function stmt. */
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_tokens[1] = ffesta_tokens[2];
- return (ffelexHandler) ffestb_decl_funcname_4_ (t);
- }
- ffestb_local_.decl.toklist = ffestt_tokenlist_create ();
- ffestb_local_.decl.empty = TRUE;
- ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
- return (ffelexHandler) ffestb_decl_entsp_6_;
-
- default:
- break;
- }
-
- assert (ffestb_local_.decl.aster_after);
- ffesta_confirmed (); /* We've seen an ASTERISK, so even EQUALS
- confirmed. */
- ffestb_subr_ambig_to_ents_ ();
- ffestb_subrargs_.dim_list.dims = NULL;
- return (ffelexHandler) ffestb_decl_ents_7_ (t);
-}
-
-/* ffestb_decl_entsp_6_ -- "type" [type parameters] [RECURSIVE] FUNCTION
- NAME [type parameter] OPEN_PAREN
-
- return ffestb_decl_entsp_6_; // to lexer
-
- If CLOSE_PAREN, we definitely have an R1219 function-stmt, since
- the notation "name()" is invalid for a declaration. */
-
-static ffelexHandler
-ffestb_decl_entsp_6_ (ffelexToken t)
-{
- ffelexHandler next;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCLOSE_PAREN:
- if (!ffestb_local_.decl.empty)
- { /* Trailing comma, just a warning for
- stmt func def, so allow ambiguity. */
- ffestt_tokenlist_append (ffestb_local_.decl.toklist,
- ffelex_token_use (t));
- return (ffelexHandler) ffestb_decl_entsp_8_;
- }
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_tokens[1] = ffesta_tokens[2];
- next = (ffelexHandler) ffestt_tokenlist_handle
- (ffestb_local_.decl.toklist, (ffelexHandler) ffestb_decl_funcname_4_);
- ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
- return (ffelexHandler) (*next) (t);
-
- case FFELEX_typeNAME:
- ffestb_local_.decl.empty = FALSE;
- ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
- return (ffelexHandler) ffestb_decl_entsp_7_;
-
- case FFELEX_typeEQUALS:
- case FFELEX_typePOINTS:
- case FFELEX_typePERCENT:
- case FFELEX_typePERIOD:
- case FFELEX_typeOPEN_PAREN:
- if ((ffestb_local_.decl.kindt != NULL)
- || (ffestb_local_.decl.lent != NULL))
- break; /* type(params)name or type*val name, either
- way confirmed. */
- return (ffelexHandler) ffestb_subr_ambig_nope_ (t);
-
- default:
- break;
- }
-
- ffesta_confirmed ();
- ffestb_subr_ambig_to_ents_ ();
- next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
- (ffelexHandler) ffestb_decl_ents_3_);
- ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
- return (ffelexHandler) (*next) (t);
-}
-
-/* ffestb_decl_entsp_7_ -- "type" [type parameters] [RECURSIVE] FUNCTION
- NAME [type parameter] OPEN_PAREN NAME
-
- return ffestb_decl_entsp_7_; // to lexer
-
- Expect COMMA or CLOSE_PAREN to remain ambiguous, else not an R1219
- function-stmt. */
-
-static ffelexHandler
-ffestb_decl_entsp_7_ (ffelexToken t)
-{
- ffelexHandler next;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCLOSE_PAREN:
- ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
- return (ffelexHandler) ffestb_decl_entsp_8_;
-
- case FFELEX_typeCOMMA:
- ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
- return (ffelexHandler) ffestb_decl_entsp_6_;
-
- case FFELEX_typeEQUALS:
- case FFELEX_typePOINTS:
- case FFELEX_typePERCENT:
- case FFELEX_typePERIOD:
- case FFELEX_typeOPEN_PAREN:
- if ((ffestb_local_.decl.kindt != NULL)
- || (ffestb_local_.decl.lent != NULL))
- break; /* type(params)name or type*val name, either
- way confirmed. */
- return (ffelexHandler) ffestb_subr_ambig_nope_ (t);
-
- default:
- break;
- }
-
- ffesta_confirmed ();
- ffestb_subr_ambig_to_ents_ ();
- next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
- (ffelexHandler) ffestb_decl_ents_3_);
- ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
- return (ffelexHandler) (*next) (t);
-}
-
-/* ffestb_decl_entsp_8_ -- "type" [type parameters] [RECURSIVE] FUNCTION
- NAME [type parameter] OPEN_PAREN name-list
- CLOSE_PAREN
-
- return ffestb_decl_entsp_8_; // to lexer
-
- If EOS/SEMICOLON, situation remains ambiguous, ask FFESTC to resolve
- it. If NAME (must be "RESULT", but that is checked later on),
- definitely an R1219 function-stmt. Anything else, handle as entity decl. */
-
-static ffelexHandler
-ffestb_decl_entsp_8_ (ffelexToken t)
-{
- ffelexHandler next;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- if (ffestc_is_decl_not_R1219 ())
- break;
- /* Fall through. */
- case FFELEX_typeNAME:
- ffesta_confirmed ();
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_tokens[1] = ffesta_tokens[2];
- next = (ffelexHandler) ffestt_tokenlist_handle
- (ffestb_local_.decl.toklist, (ffelexHandler) ffestb_decl_funcname_4_);
- ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
- return (ffelexHandler) (*next) (t);
-
- case FFELEX_typeEQUALS:
- case FFELEX_typePOINTS:
- case FFELEX_typePERCENT:
- case FFELEX_typePERIOD:
- case FFELEX_typeOPEN_PAREN:
- if ((ffestb_local_.decl.kindt != NULL)
- || (ffestb_local_.decl.lent != NULL))
- break; /* type(params)name or type*val name, either
- way confirmed. */
- return (ffelexHandler) ffestb_subr_ambig_nope_ (t);
-
- default:
- break;
- }
-
- ffesta_confirmed ();
- ffestb_subr_ambig_to_ents_ ();
- next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
- (ffelexHandler) ffestb_decl_ents_3_);
- ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
- return (ffelexHandler) (*next) (t);
-}
-
-/* ffestb_decl_func_ -- ["type" [type parameters]] RECURSIVE
-
- return ffestb_decl_func_; // to lexer
-
- Handle "FUNCTION". */
-
-#if FFESTR_F90
-static ffelexHandler
-ffestb_decl_func_ (ffelexToken t)
-{
- const char *p;
- ffeTokenLength i;
-
- ffelex_set_names (FALSE);
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- if (ffestr_first (t) != FFESTR_firstFUNCTION)
- break;
- return (ffelexHandler) ffestb_decl_funcname_;
-
- case FFELEX_typeNAMES:
- ffesta_confirmed ();
- if (ffestr_first (t) != FFESTR_firstFUNCTION)
- break;
- p = ffelex_token_text (t) + (i = FFESTR_firstlFUNCTION);
- if (*p == '\0')
- break;
- if (!ffesrc_is_name_init (*p))
- goto bad_i; /* :::::::::::::::::::: */
- ffesta_tokens[1] = ffelex_token_name_from_names (t, i, 0);
- return (ffelexHandler) ffestb_decl_funcname_1_;
-
- default:
- break;
- }
-
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_i: /* :::::::::::::::::::: */
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t, i, NULL);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-#endif
-/* ffestb_decl_funcname_ -- "type" [type parameters] [RECURSIVE] FUNCTION
-
- return ffestb_decl_funcname_; // to lexer
-
- Handle NAME of a function. */
-
-static ffelexHandler
-ffestb_decl_funcname_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_decl_funcname_1_;
-
- default:
- break;
- }
-
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_funcname_1_ -- "type" [type parameters] [RECURSIVE] FUNCTION
- NAME
-
- return ffestb_decl_funcname_1_; // to lexer
-
- Handle ASTERISK or OPEN_PAREN. */
-
-static ffelexHandler
-ffestb_decl_funcname_1_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeASTERISK:
- return (ffelexHandler) ffestb_decl_funcname_2_;
-
- case FFELEX_typeOPEN_PAREN:
- return (ffelexHandler) ffestb_decl_funcname_4_ (t);
-
- default:
- break;
- }
-
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_funcname_2_ -- "type" [type parameters] [RECURSIVE] FUNCTION
- NAME ASTERISK
-
- return ffestb_decl_funcname_2_; // to lexer
-
- Handle NUMBER or OPEN_PAREN. */
-
-static ffelexHandler
-ffestb_decl_funcname_2_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNUMBER:
- switch (ffestb_local_.decl.type)
- {
- case FFESTP_typeINTEGER:
- case FFESTP_typeREAL:
- case FFESTP_typeCOMPLEX:
- case FFESTP_typeLOGICAL:
- if (ffestb_local_.decl.kindt == NULL)
- ffestb_local_.decl.kindt = ffelex_token_use (t);
- else
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
- break;
-
- case FFESTP_typeCHARACTER:
- if (ffestb_local_.decl.lent == NULL)
- ffestb_local_.decl.lent = ffelex_token_use (t);
- else
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
- break;
-
- case FFESTP_typeBYTE:
- case FFESTP_typeWORD:
- default:
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
- break;
- }
- return (ffelexHandler) ffestb_decl_funcname_4_;
-
- case FFELEX_typeOPEN_PAREN:
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextCHARACTERSIZE,
- (ffeexprCallback) ffestb_decl_funcname_3_);
-
- default:
- break;
- }
-
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_funcname_3_ -- "type" [type parameters] [RECURSIVE] FUNCTION
- NAME ASTERISK OPEN_PAREN expr
-
- (ffestb_decl_funcname_3_) // to expression handler
-
- Allow only CLOSE_PAREN; and deal with character-length expression. */
-
-static ffelexHandler
-ffestb_decl_funcname_3_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCLOSE_PAREN:
- if (expr == NULL)
- break;
- switch (ffestb_local_.decl.type)
- {
- case FFESTP_typeCHARACTER:
- if (ffestb_local_.decl.lent == NULL)
- {
- ffestb_local_.decl.len = expr;
- ffestb_local_.decl.lent = ffelex_token_use (ft);
- }
- else
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
- break;
-
- default:
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
- break;
- }
- return (ffelexHandler) ffestb_decl_funcname_4_;
-
- default:
- break;
- }
-
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_funcname_4_ -- "type" [type parameters] [RECURSIVE] FUNCTION
- NAME [type parameter]
-
- return ffestb_decl_funcname_4_; // to lexer
-
- Make sure the next token is an OPEN_PAREN. Get the arg list and
- then implement. */
-
-static ffelexHandler
-ffestb_decl_funcname_4_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeOPEN_PAREN:
- ffestb_subrargs_.name_list.args = ffestt_tokenlist_create ();
- ffestb_subrargs_.name_list.handler
- = (ffelexHandler) ffestb_decl_funcname_5_;
- ffestb_subrargs_.name_list.is_subr = FALSE;
- ffestb_subrargs_.name_list.names = FALSE;
- return (ffelexHandler) ffestb_subr_name_list_;
-
- default:
- break;
- }
-
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffelex_token_kill (ffesta_tokens[1]);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_funcname_5_ -- "type" [type parameters] [RECURSIVE] FUNCTION
- NAME [type parameter] OPEN_PAREN arg-list
- CLOSE_PAREN
-
- return ffestb_decl_funcname_5_; // to lexer
-
- Must have EOS/SEMICOLON or "RESULT" here. */
-
-static ffelexHandler
-ffestb_decl_funcname_5_ (ffelexToken t)
-{
- if (!ffestb_subrargs_.name_list.ok)
- goto bad; /* :::::::::::::::::::: */
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_R1219 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
- ffestb_subrargs_.name_list.close_paren, ffestb_local_.decl.type,
- ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
- ffestb_local_.decl.len, ffestb_local_.decl.lent,
- ffestb_local_.decl.recursive, NULL);
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffelex_token_kill (ffesta_tokens[1]);
- ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
- ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
- return (ffelexHandler) ffesta_zero (t);
-
- case FFELEX_typeNAME:
- if (ffestr_other (t) != FFESTR_otherRESULT)
- break;
- return (ffelexHandler) ffestb_decl_funcname_6_;
-
- default:
- break;
- }
-
-bad: /* :::::::::::::::::::: */
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffelex_token_kill (ffesta_tokens[1]);
- ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
- ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_funcname_6_ -- "type" [type parameters] [RECURSIVE] FUNCTION
- NAME [type parameter] OPEN_PAREN arglist
- CLOSE_PAREN "RESULT"
-
- return ffestb_decl_funcname_6_; // to lexer
-
- Make sure the next token is an OPEN_PAREN. */
-
-static ffelexHandler
-ffestb_decl_funcname_6_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeOPEN_PAREN:
- return (ffelexHandler) ffestb_decl_funcname_7_;
-
- default:
- break;
- }
-
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffelex_token_kill (ffesta_tokens[1]);
- ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
- ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_funcname_7_ -- "type" [type parameters] [RECURSIVE] FUNCTION
- NAME [type parameter] OPEN_PAREN arglist
- CLOSE_PAREN "RESULT" OPEN_PAREN
-
- return ffestb_decl_funcname_7_; // to lexer
-
- Make sure the next token is a NAME. */
-
-static ffelexHandler
-ffestb_decl_funcname_7_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[2] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_decl_funcname_8_;
-
- default:
- break;
- }
-
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffelex_token_kill (ffesta_tokens[1]);
- ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
- ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_funcname_8_ -- "type" [type parameters] [RECURSIVE] FUNCTION
- NAME [type parameter] OPEN_PAREN arglist
- CLOSE_PAREN "RESULT" OPEN_PAREN NAME
-
- return ffestb_decl_funcname_8_; // to lexer
-
- Make sure the next token is a CLOSE_PAREN. */
-
-static ffelexHandler
-ffestb_decl_funcname_8_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCLOSE_PAREN:
- return (ffelexHandler) ffestb_decl_funcname_9_;
-
- default:
- break;
- }
-
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffelex_token_kill (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[2]);
- ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
- ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_funcname_9_ -- "type" [type parameters] [RECURSIVE] FUNCTION
- NAME [type parameter] OPEN_PAREN arg-list
- CLOSE_PAREN "RESULT" OPEN_PAREN NAME CLOSE_PAREN
-
- return ffestb_decl_funcname_9_; // to lexer
-
- Must have EOS/SEMICOLON here. */
-
-static ffelexHandler
-ffestb_decl_funcname_9_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (!ffesta_is_inhibited ())
- ffestc_R1219 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
- ffestb_subrargs_.name_list.close_paren, ffestb_local_.decl.type,
- ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
- ffestb_local_.decl.len, ffestb_local_.decl.lent,
- ffestb_local_.decl.recursive, ffesta_tokens[2]);
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffelex_token_kill (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[2]);
- ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
- ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- if (ffestb_local_.decl.recursive != NULL)
- ffelex_token_kill (ffestb_local_.decl.recursive);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffelex_token_kill (ffesta_tokens[1]);
- ffelex_token_kill (ffesta_tokens[2]);
- ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
- ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V003 -- Parse the STRUCTURE statement
-
- return ffestb_V003; // to lexer
-
- Make sure the statement has a valid form for the STRUCTURE statement.
- If it does, implement the statement. */
-
-#if FFESTR_VXT
-ffelexHandler
-ffestb_V003 (ffelexToken t)
-{
- ffeTokenLength i;
- const char *p;
- ffelexToken nt;
- ffelexHandler next;
-
- switch (ffelex_token_type (ffesta_tokens[0]))
- {
- case FFELEX_typeNAME:
- if (ffesta_first_kw != FFESTR_firstSTRUCTURE)
- goto bad_0; /* :::::::::::::::::::: */
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeNAME:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_V003_start (NULL);
- ffestb_local_.structure.started = TRUE;
- return (ffelexHandler) ffestb_V0034_ (t);
-
- case FFELEX_typeSLASH:
- ffesta_confirmed ();
- return (ffelexHandler) ffestb_V0031_;
- }
-
- case FFELEX_typeNAMES:
- if (ffesta_first_kw != FFESTR_firstSTRUCTURE)
- goto bad_0; /* :::::::::::::::::::: */
- p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSTRUCTURE);
- switch (ffelex_token_type (t))
- {
- default:
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed ();
- break;
-
- case FFELEX_typeSLASH:
- ffesta_confirmed ();
- if (*p != '\0')
- goto bad_1; /* :::::::::::::::::::: */
- return (ffelexHandler) ffestb_V0031_;
-
- case FFELEX_typeOPEN_PAREN:
- break;
- }
-
- /* Here, we have at least one char after "STRUCTURE" and t is COMMA,
- EOS/SEMICOLON, or OPEN_PAREN. */
-
- if (!ffesrc_is_name_init (*p))
- goto bad_i; /* :::::::::::::::::::: */
- nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
- if (ffelex_token_type (t) == FFELEX_typeOPEN_PAREN)
- ffestb_local_.structure.started = FALSE;
- else
- {
- if (!ffesta_is_inhibited ())
- ffestc_V003_start (NULL);
- ffestb_local_.structure.started = TRUE;
- }
- next = (ffelexHandler) ffestb_V0034_ (nt);
- ffelex_token_kill (nt);
- return (ffelexHandler) (*next) (t);
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-
-bad_i: /* :::::::::::::::::::: */
- ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", ffesta_tokens[0], i, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0031_ -- "STRUCTURE" SLASH
-
- return ffestb_V0031_; // to lexer
-
- Handle NAME. */
-
-static ffelexHandler
-ffestb_V0031_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_V0032_;
-
- default:
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
- break;
- }
-
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0032_ -- "STRUCTURE" SLASH NAME
-
- return ffestb_V0032_; // to lexer
-
- Handle SLASH. */
-
-static ffelexHandler
-ffestb_V0032_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeSLASH:
- if (!ffesta_is_inhibited ())
- ffestc_V003_start (ffesta_tokens[1]);
- ffestb_local_.structure.started = TRUE;
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffestb_V0033_;
-
- default:
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
- break;
- }
-
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0033_ -- "STRUCTURE" SLASH NAME SLASH
-
- return ffestb_V0033_; // to lexer
-
- Handle NAME or EOS/SEMICOLON. */
-
-static ffelexHandler
-ffestb_V0033_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- return (ffelexHandler) ffestb_V0034_ (t);
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (!ffesta_is_inhibited ())
- ffestc_V003_finish ();
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
- break;
- }
-
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0034_ -- "STRUCTURE" [SLASH NAME SLASH]
-
- return ffestb_V0034_; // to lexer
-
- Handle NAME. */
-
-static ffelexHandler
-ffestb_V0034_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_V0035_;
-
- default:
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
- break;
- }
-
- if (!ffesta_is_inhibited ())
- ffestc_V003_finish ();
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0035_ -- "STRUCTURE" ... NAME
-
- return ffestb_V0035_; // to lexer
-
- Handle OPEN_PAREN. */
-
-static ffelexHandler
-ffestb_V0035_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeOPEN_PAREN:
- ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
- ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_V0036_;
- ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
- ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLISTCOMMON;
-#ifdef FFECOM_dimensionsMAX
- ffestb_subrargs_.dim_list.ndims = 0;
-#endif
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextDIMLISTCOMMON, (ffeexprCallback) ffestb_subr_dimlist_);
-
- case FFELEX_typeCOMMA:
- if (!ffesta_is_inhibited ())
- ffestc_V003_item (ffesta_tokens[1], NULL);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffestb_V0034_;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (!ffesta_is_inhibited ())
- {
- ffestc_V003_item (ffesta_tokens[1], NULL);
- ffestc_V003_finish ();
- }
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
- break;
- }
-
- if (!ffesta_is_inhibited ())
- ffestc_V003_finish ();
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0036_ -- "STRUCTURE" ... NAME OPEN_PAREN dimlist CLOSE_PAREN
-
- return ffestb_V0036_; // to lexer
-
- Handle COMMA or EOS/SEMICOLON. */
-
-static ffelexHandler
-ffestb_V0036_ (ffelexToken t)
-{
- if (!ffestb_subrargs_.dim_list.ok)
- goto bad; /* :::::::::::::::::::: */
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- {
- if (!ffestb_local_.structure.started)
- {
- ffestc_V003_start (NULL);
- ffestb_local_.structure.started = TRUE;
- }
- ffestc_V003_item (ffesta_tokens[1],
- ffestb_subrargs_.dim_list.dims);
- }
- ffelex_token_kill (ffesta_tokens[1]);
- ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
- return (ffelexHandler) ffestb_V0034_;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- {
- if (!ffestb_local_.structure.started)
- ffestc_V003_start (NULL);
- ffestc_V003_item (ffesta_tokens[1],
- ffestb_subrargs_.dim_list.dims);
- ffestc_V003_finish ();
- }
- ffelex_token_kill (ffesta_tokens[1]);
- ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
-bad: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
- if (ffestb_local_.structure.started && !ffesta_is_inhibited ())
- ffestc_V003_finish ();
- ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V016 -- Parse the RECORD statement
-
- return ffestb_V016; // to lexer
-
- Make sure the statement has a valid form for the RECORD statement. If it
- does, implement the statement. */
-
-ffelexHandler
-ffestb_V016 (ffelexToken t)
-{
- const char *p;
- ffeTokenLength i;
-
- switch (ffelex_token_type (ffesta_tokens[0]))
- {
- case FFELEX_typeNAME:
- if (ffesta_first_kw != FFESTR_firstRECORD)
- goto bad_0; /* :::::::::::::::::::: */
- break;
-
- case FFELEX_typeNAMES:
- if (ffesta_first_kw != FFESTR_firstRECORD)
- goto bad_0; /* :::::::::::::::::::: */
- p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlRECORD);
- if (*p != '\0')
- goto bad_i; /* :::::::::::::::::::: */
- break;
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeCOLONCOLON:
- ffesta_confirmed (); /* Error, but clearly intended. */
- goto bad_1; /* :::::::::::::::::::: */
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
-
- case FFELEX_typeSLASH:
- break;
- }
-
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_V016_start ();
- return (ffelexHandler) ffestb_V0161_;
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-
-bad_i: /* :::::::::::::::::::: */
- ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "RECORD", ffesta_tokens[0], i, t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0161_ -- "RECORD" SLASH
-
- return ffestb_V0161_; // to lexer
-
- Handle NAME. */
-
-static ffelexHandler
-ffestb_V0161_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- if (!ffesta_is_inhibited ())
- ffestc_V016_item_structure (t);
- return (ffelexHandler) ffestb_V0162_;
-
- default:
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
- break;
- }
-
- if (!ffesta_is_inhibited ())
- ffestc_V016_finish ();
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0162_ -- "RECORD" SLASH NAME
-
- return ffestb_V0162_; // to lexer
-
- Handle SLASH. */
-
-static ffelexHandler
-ffestb_V0162_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeSLASH:
- return (ffelexHandler) ffestb_V0163_;
-
- default:
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
- break;
- }
-
- if (!ffesta_is_inhibited ())
- ffestc_V016_finish ();
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0163_ -- "RECORD" SLASH NAME SLASH
-
- return ffestb_V0163_; // to lexer
-
- Handle NAME. */
-
-static ffelexHandler
-ffestb_V0163_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_V0164_;
-
- default:
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
- break;
- }
-
- if (!ffesta_is_inhibited ())
- ffestc_V016_finish ();
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0164_ -- "RECORD" ... NAME
-
- return ffestb_V0164_; // to lexer
-
- Handle OPEN_PAREN. */
-
-static ffelexHandler
-ffestb_V0164_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeOPEN_PAREN:
- ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
- ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_V0165_;
- ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
- ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLISTCOMMON;
-#ifdef FFECOM_dimensionsMAX
- ffestb_subrargs_.dim_list.ndims = 0;
-#endif
- return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
- FFEEXPR_contextDIMLISTCOMMON, (ffeexprCallback) ffestb_subr_dimlist_);
-
- case FFELEX_typeCOMMA:
- if (!ffesta_is_inhibited ())
- ffestc_V016_item_object (ffesta_tokens[1], NULL);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffestb_V0166_;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (!ffesta_is_inhibited ())
- {
- ffestc_V016_item_object (ffesta_tokens[1], NULL);
- ffestc_V016_finish ();
- }
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
- break;
- }
-
- if (!ffesta_is_inhibited ())
- ffestc_V016_finish ();
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0165_ -- "RECORD" ... NAME OPEN_PAREN dimlist CLOSE_PAREN
-
- return ffestb_V0165_; // to lexer
-
- Handle COMMA or EOS/SEMICOLON. */
-
-static ffelexHandler
-ffestb_V0165_ (ffelexToken t)
-{
- if (!ffestb_subrargs_.dim_list.ok)
- goto bad; /* :::::::::::::::::::: */
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- if (!ffesta_is_inhibited ())
- ffestc_V016_item_object (ffesta_tokens[1],
- ffestb_subrargs_.dim_list.dims);
- ffelex_token_kill (ffesta_tokens[1]);
- ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
- return (ffelexHandler) ffestb_V0166_;
-
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (!ffesta_is_inhibited ())
- {
- ffestc_V016_item_object (ffesta_tokens[1],
- ffestb_subrargs_.dim_list.dims);
- ffestc_V016_finish ();
- }
- ffelex_token_kill (ffesta_tokens[1]);
- ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
-bad: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
- if (ffestb_local_.structure.started && !ffesta_is_inhibited ())
- ffestc_V016_finish ();
- ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
- ffelex_token_kill (ffesta_tokens[1]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0166_ -- "RECORD" SLASH NAME SLASH NAME [OPEN_PAREN dimlist
- CLOSE_PAREN] COMMA
-
- return ffestb_V0166_; // to lexer
-
- Handle NAME or SLASH. */
-
-static ffelexHandler
-ffestb_V0166_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_V0164_;
-
- case FFELEX_typeSLASH:
- return (ffelexHandler) ffestb_V0161_;
-
- default:
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
- break;
- }
-
- if (!ffesta_is_inhibited ())
- ffestc_V016_finish ();
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-#endif
-/* ffestb_V027 -- Parse the VXT PARAMETER statement
-
- return ffestb_V027; // to lexer
-
- Make sure the statement has a valid form for the VXT PARAMETER statement.
- If it does, implement the statement. */
-
-ffelexHandler
-ffestb_V027 (ffelexToken t)
-{
- 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_;
-
-#if FFESTR_F90
- case FFESTR_secondTYPE:
- ffestb_local_.decl.type = FFESTP_typeTYPE;
- return (ffelexHandler) ffestb_decl_R5393_;
-#endif
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
- }
-
- case FFELEX_typeNAMES:
- if (ffesta_first_kw != FFESTR_firstIMPLICIT)
- goto bad_0; /* :::::::::::::::::::: */
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeCOLONCOLON:
- case FFELEX_typeASTERISK:
- case FFELEX_typeSEMICOLON:
- case FFELEX_typeEOS:
- ffesta_confirmed ();
- break;
-
- case FFELEX_typeOPEN_PAREN:
- break;
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
- }
- p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlIMPLICIT);
- if (!ffesrc_is_name_init (*p))
- goto bad_0; /* :::::::::::::::::::: */
- ffestb_local_.decl.imp_started = FALSE;
- nt = ffelex_token_name_from_names (ffesta_tokens[0],
- FFESTR_firstlIMPLICIT, 0);
- kw = ffestr_second (nt);
- ffelex_token_kill (nt);
- switch (kw)
- {
- case FFESTR_secondINTEGER:
- ffestb_local_.decl.type = FFESTP_typeINTEGER;
- return (ffelexHandler) ffestb_decl_R5391_ (t);
-
- case FFESTR_secondBYTE:
- ffestb_local_.decl.type = FFESTP_typeBYTE;
- return (ffelexHandler) ffestb_decl_R5391_ (t);
-
- case FFESTR_secondWORD:
- ffestb_local_.decl.type = FFESTP_typeWORD;
- return (ffelexHandler) ffestb_decl_R5391_ (t);
-
- case FFESTR_secondREAL:
- ffestb_local_.decl.type = FFESTP_typeREAL;
- return (ffelexHandler) ffestb_decl_R5391_ (t);
-
- case FFESTR_secondCOMPLEX:
- ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
- return (ffelexHandler) ffestb_decl_R5391_ (t);
-
- case FFESTR_secondLOGICAL:
- ffestb_local_.decl.type = FFESTP_typeLOGICAL;
- return (ffelexHandler) ffestb_decl_R5391_ (t);
-
- case FFESTR_secondCHARACTER:
- ffestb_local_.decl.type = FFESTP_typeCHARACTER;
- return (ffelexHandler) ffestb_decl_R5391_ (t);
-
- case FFESTR_secondDOUBLEPRECISION:
- ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
- ffestb_local_.decl.kind = NULL;
- ffestb_local_.decl.kindt = NULL;
- ffestb_local_.decl.len = NULL;
- ffestb_local_.decl.lent = NULL;
- return (ffelexHandler) ffestb_decl_R539letters_ (t);
-
- case FFESTR_secondDOUBLECOMPLEX:
- ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
- ffestb_local_.decl.kind = NULL;
- ffestb_local_.decl.kindt = NULL;
- ffestb_local_.decl.len = NULL;
- ffestb_local_.decl.lent = NULL;
- return (ffelexHandler) ffestb_decl_R539letters_ (t);
-
- case FFESTR_secondNONE:
- return (ffelexHandler) ffestb_decl_R5394_ (t);
-
-#if FFESTR_F90
- case FFESTR_secondTYPE:
- ffestb_local_.decl.type = FFESTP_typeTYPE;
- return (ffelexHandler) ffestb_decl_R5393_ (t);
-#endif
-
- default:
- goto bad_1; /* :::::::::::::::::::: */
- }
-
- default:
- goto bad_0; /* :::::::::::::::::::: */
- }
-
-bad_0: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", ffesta_tokens[0]);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1: /* :::::::::::::::::::: */
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
- return (ffelexHandler) ffelex_swallow_tokens (t,
- (ffelexHandler) ffesta_zero); /* Invalid second token. */
-}
-
-/* ffestb_decl_R5391_ -- "IMPLICIT" generic-type
-
- return ffestb_decl_R5391_; // to lexer
-
- Handle ASTERISK or OPEN_PAREN. */
-
-static ffelexHandler
-ffestb_decl_R5391_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeASTERISK:
- ffesta_confirmed ();
- ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_R539letters_;
- ffestb_local_.decl.badname = "IMPLICIT";
- if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
- return (ffelexHandler) ffestb_decl_starlen_;
- return (ffelexHandler) ffestb_decl_starkind_;
-
- case FFELEX_typeOPEN_PAREN:
- ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_R539letters_;
- ffestb_local_.decl.badname = "IMPLICIT";
- ffestb_local_.decl.kind = NULL;
- ffestb_local_.decl.kindt = NULL;
- ffestb_local_.decl.len = NULL;
- ffestb_local_.decl.lent = NULL;
- if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
- ffestb_local_.decl.imp_handler
- = (ffelexHandler) ffestb_decl_typeparams_;
- else
- ffestb_local_.decl.imp_handler
- = (ffelexHandler) ffestb_decl_kindparam_;
- return (ffelexHandler) ffestb_decl_R539maybe_ (t);
-
- default:
- break;
- }
-
- if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
- ffestc_R539finish ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_R5392_ -- "IMPLICIT" "DOUBLE"
-
- return ffestb_decl_R5392_; // to lexer
-
- Handle NAME. */
-
-static ffelexHandler
-ffestb_decl_R5392_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- switch (ffestr_second (t))
- {
- case FFESTR_secondPRECISION:
- ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
- break;
-
- case FFESTR_secondCOMPLEX:
- ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
- break;
-
- default:
- goto bad; /* :::::::::::::::::::: */
- }
- ffestb_local_.decl.kind = NULL;
- ffestb_local_.decl.kindt = NULL;
- ffestb_local_.decl.len = NULL;
- ffestb_local_.decl.lent = NULL;
- return (ffelexHandler) ffestb_decl_R539letters_;
-
- default:
- break;
- }
-
-bad: /* :::::::::::::::::::: */
- if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
- ffestc_R539finish ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_R5393_ -- "IMPLICIT" "TYPE"
-
- return ffestb_decl_R5393_; // to lexer
-
- Handle OPEN_PAREN. */
-
-#if FFESTR_F90
-static ffelexHandler
-ffestb_decl_R5393_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeOPEN_PAREN:
- ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_R539letters_;
- ffestb_local_.decl.badname = "IMPLICIT";
- return (ffelexHandler) ffestb_decl_typetype1_;
-
- default:
- break;
- }
-
- if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
- ffestc_R539finish ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-#endif
-/* ffestb_decl_R5394_ -- "IMPLICIT" "NONE"
-
- return ffestb_decl_R5394_; // to lexer
-
- Handle EOS/SEMICOLON. */
-
-static ffelexHandler
-ffestb_decl_R5394_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_R539 (); /* IMPLICIT NONE. */
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_R5395_ -- "IMPLICIT" implicit-spec-list COMMA
-
- return ffestb_decl_R5395_; // to lexer
-
- Handle NAME for next type-spec. */
-
-static ffelexHandler
-ffestb_decl_R5395_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- switch (ffestr_second (t))
- {
- case FFESTR_secondINTEGER:
- ffestb_local_.decl.type = FFESTP_typeINTEGER;
- return (ffelexHandler) ffestb_decl_R5391_;
-
- case FFESTR_secondBYTE:
- ffestb_local_.decl.type = FFESTP_typeBYTE;
- return (ffelexHandler) ffestb_decl_R5391_;
-
- case FFESTR_secondWORD:
- ffestb_local_.decl.type = FFESTP_typeWORD;
- return (ffelexHandler) ffestb_decl_R5391_;
-
- case FFESTR_secondREAL:
- ffestb_local_.decl.type = FFESTP_typeREAL;
- return (ffelexHandler) ffestb_decl_R5391_;
-
- case FFESTR_secondCOMPLEX:
- ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
- return (ffelexHandler) ffestb_decl_R5391_;
-
- case FFESTR_secondLOGICAL:
- ffestb_local_.decl.type = FFESTP_typeLOGICAL;
- return (ffelexHandler) ffestb_decl_R5391_;
-
- case FFESTR_secondCHARACTER:
- ffestb_local_.decl.type = FFESTP_typeCHARACTER;
- return (ffelexHandler) ffestb_decl_R5391_;
-
- case FFESTR_secondDOUBLE:
- return (ffelexHandler) ffestb_decl_R5392_;
-
- case FFESTR_secondDOUBLEPRECISION:
- ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
- ffestb_local_.decl.kind = NULL;
- ffestb_local_.decl.kindt = NULL;
- ffestb_local_.decl.len = NULL;
- ffestb_local_.decl.lent = NULL;
- return (ffelexHandler) ffestb_decl_R539letters_;
-
- case FFESTR_secondDOUBLECOMPLEX:
- ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
- ffestb_local_.decl.kind = NULL;
- ffestb_local_.decl.kindt = NULL;
- ffestb_local_.decl.len = NULL;
- ffestb_local_.decl.lent = NULL;
- return (ffelexHandler) ffestb_decl_R539letters_;
-
-#if FFESTR_F90
- case FFESTR_secondTYPE:
- ffestb_local_.decl.type = FFESTP_typeTYPE;
- return (ffelexHandler) ffestb_decl_R5393_;
-#endif
-
- default:
- break;
- }
- break;
-
- default:
- break;
- }
-
- if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
- ffestc_R539finish ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_R539letters_ -- "IMPLICIT" type-spec
-
- return ffestb_decl_R539letters_; // to lexer
-
- Handle OPEN_PAREN. */
-
-static ffelexHandler
-ffestb_decl_R539letters_ (ffelexToken t)
-{
- ffelex_set_names (FALSE);
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeOPEN_PAREN:
- ffestb_local_.decl.imps = ffestt_implist_create ();
- return (ffelexHandler) ffestb_decl_R539letters_1_;
-
- default:
- break;
- }
-
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
- ffestc_R539finish ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_R539letters_1_ -- "IMPLICIT" type-spec OPEN_PAREN
-
- return ffestb_decl_R539letters_1_; // to lexer
-
- Handle NAME. */
-
-static ffelexHandler
-ffestb_decl_R539letters_1_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- if (ffelex_token_length (t) != 1)
- break;
- ffesta_tokens[1] = ffelex_token_use (t);
- return (ffelexHandler) ffestb_decl_R539letters_2_;
-
- default:
- break;
- }
-
- ffestt_implist_kill (ffestb_local_.decl.imps);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
- ffestc_R539finish ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_R539letters_2_ -- "IMPLICIT" type-spec OPEN_PAREN NAME
-
- return ffestb_decl_R539letters_2_; // to lexer
-
- Handle COMMA or MINUS. */
-
-static ffelexHandler
-ffestb_decl_R539letters_2_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
- return (ffelexHandler) ffestb_decl_R539letters_1_;
-
- case FFELEX_typeCLOSE_PAREN:
- ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
- return (ffelexHandler) ffestb_decl_R539letters_5_;
-
- case FFELEX_typeMINUS:
- return (ffelexHandler) ffestb_decl_R539letters_3_;
-
- default:
- break;
- }
-
- ffelex_token_kill (ffesta_tokens[1]);
- ffestt_implist_kill (ffestb_local_.decl.imps);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
- ffestc_R539finish ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_R539letters_3_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
-
- return ffestb_decl_R539letters_3_; // to lexer
-
- Handle NAME. */
-
-static ffelexHandler
-ffestb_decl_R539letters_3_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- if (ffelex_token_length (t) != 1)
- break;
- ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1],
- ffelex_token_use (t));
- return (ffelexHandler) ffestb_decl_R539letters_4_;
-
- default:
- break;
- }
-
- ffelex_token_kill (ffesta_tokens[1]);
- ffestt_implist_kill (ffestb_local_.decl.imps);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
- ffestc_R539finish ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_R539letters_4_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
- NAME
-
- return ffestb_decl_R539letters_4_; // to lexer
-
- Handle COMMA or CLOSE_PAREN. */
-
-static ffelexHandler
-ffestb_decl_R539letters_4_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- return (ffelexHandler) ffestb_decl_R539letters_1_;
-
- case FFELEX_typeCLOSE_PAREN:
- return (ffelexHandler) ffestb_decl_R539letters_5_;
-
- default:
- break;
- }
-
- ffestt_implist_kill (ffestb_local_.decl.imps);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
- ffestc_R539finish ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_R539letters_5_ -- "IMPLICIT" type-spec OPEN_PAREN
- letter-spec-list CLOSE_PAREN
-
- return ffestb_decl_R539letters_5_; // to lexer
-
- Handle COMMA or EOS/SEMICOLON. */
-
-static ffelexHandler
-ffestb_decl_R539letters_5_ (ffelexToken t)
-{
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- if (!ffestb_local_.decl.imp_started)
- {
- ffestb_local_.decl.imp_started = TRUE;
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_R539start ();
- }
- if (!ffesta_is_inhibited ())
- ffestc_R539item (ffestb_local_.decl.type, ffestb_local_.decl.kind,
- ffestb_local_.decl.kindt, ffestb_local_.decl.len,
- ffestb_local_.decl.lent, ffestb_local_.decl.imps);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffestt_implist_kill (ffestb_local_.decl.imps);
- if (ffelex_token_type (t) == FFELEX_typeCOMMA)
- return (ffelexHandler) ffestb_decl_R5395_;
- if (!ffesta_is_inhibited ())
- ffestc_R539finish ();
- return (ffelexHandler) ffesta_zero (t);
-
- default:
- break;
- }
-
- ffestt_implist_kill (ffestb_local_.decl.imps);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
- ffestc_R539finish ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_R539maybe_ -- "IMPLICIT" generic-type-spec
-
- return ffestb_decl_R539maybe_; // to lexer
-
- Handle OPEN_PAREN. */
-
-static ffelexHandler
-ffestb_decl_R539maybe_ (ffelexToken t)
-{
- assert (ffelex_token_type (t) == FFELEX_typeOPEN_PAREN);
- ffestb_local_.decl.imps = ffestt_implist_create ();
- ffestb_local_.decl.toklist = ffestt_tokenlist_create ();
- ffestb_local_.decl.imp_seen_comma
- = (ffestb_local_.decl.type != FFESTP_typeCHARACTER);
- return (ffelexHandler) ffestb_decl_R539maybe_1_;
-}
-
-/* ffestb_decl_R539maybe_1_ -- "IMPLICIT" generic-type-spec OPEN_PAREN
-
- return ffestb_decl_R539maybe_1_; // to lexer
-
- Handle NAME. */
-
-static ffelexHandler
-ffestb_decl_R539maybe_1_ (ffelexToken t)
-{
- ffelexHandler next;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- if (ffelex_token_length (t) != 1)
- break;
- ffesta_tokens[1] = ffelex_token_use (t);
- ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
- return (ffelexHandler) ffestb_decl_R539maybe_2_;
-
- default:
- break;
- }
-
- ffestt_implist_kill (ffestb_local_.decl.imps);
- next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
- (ffelexHandler) ffestb_local_.decl.imp_handler);
- ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
- return (ffelexHandler) (*next) (t);
-}
-
-/* ffestb_decl_R539maybe_2_ -- "IMPLICIT" generic-type-spec OPEN_PAREN NAME
-
- return ffestb_decl_R539maybe_2_; // to lexer
-
- Handle COMMA or MINUS. */
-
-static ffelexHandler
-ffestb_decl_R539maybe_2_ (ffelexToken t)
-{
- ffelexHandler next;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
- if (ffestb_local_.decl.imp_seen_comma)
- {
- ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
- return (ffelexHandler) ffestb_decl_R539letters_1_;
- }
- ffestb_local_.decl.imp_seen_comma = TRUE;
- ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
- return (ffelexHandler) ffestb_decl_R539maybe_1_;
-
- case FFELEX_typeCLOSE_PAREN:
- ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
- ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
- return (ffelexHandler) ffestb_decl_R539maybe_5_;
-
- case FFELEX_typeMINUS:
- ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
- return (ffelexHandler) ffestb_decl_R539maybe_3_;
-
- default:
- break;
- }
-
- ffelex_token_kill (ffesta_tokens[1]);
- ffestt_implist_kill (ffestb_local_.decl.imps);
- next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
- (ffelexHandler) ffestb_local_.decl.imp_handler);
- ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
- return (ffelexHandler) (*next) (t);
-}
-
-/* ffestb_decl_R539maybe_3_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
-
- return ffestb_decl_R539maybe_3_; // to lexer
-
- Handle NAME. */
-
-static ffelexHandler
-ffestb_decl_R539maybe_3_ (ffelexToken t)
-{
- ffelexHandler next;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeNAME:
- if (ffelex_token_length (t) != 1)
- break;
- ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1],
- ffelex_token_use (t));
- ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
- return (ffelexHandler) ffestb_decl_R539maybe_4_;
-
- default:
- break;
- }
-
- ffelex_token_kill (ffesta_tokens[1]);
- ffestt_implist_kill (ffestb_local_.decl.imps);
- next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
- (ffelexHandler) ffestb_local_.decl.imp_handler);
- ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
- return (ffelexHandler) (*next) (t);
-}
-
-/* ffestb_decl_R539maybe_4_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
- NAME
-
- return ffestb_decl_R539maybe_4_; // to lexer
-
- Handle COMMA or CLOSE_PAREN. */
-
-static ffelexHandler
-ffestb_decl_R539maybe_4_ (ffelexToken t)
-{
- ffelexHandler next;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- if (ffestb_local_.decl.imp_seen_comma)
- {
- ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
- return (ffelexHandler) ffestb_decl_R539letters_1_;
- }
- ffestb_local_.decl.imp_seen_comma = TRUE;
- ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
- return (ffelexHandler) ffestb_decl_R539maybe_1_;
-
- case FFELEX_typeCLOSE_PAREN:
- ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
- return (ffelexHandler) ffestb_decl_R539maybe_5_;
-
- default:
- break;
- }
-
- ffestt_implist_kill (ffestb_local_.decl.imps);
- next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
- (ffelexHandler) ffestb_local_.decl.imp_handler);
- ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
- return (ffelexHandler) (*next) (t);
-}
-
-/* ffestb_decl_R539maybe_5_ -- "IMPLICIT" type-spec OPEN_PAREN
- letter-spec-list CLOSE_PAREN
-
- return ffestb_decl_R539maybe_5_; // to lexer
-
- Handle COMMA or EOS/SEMICOLON. */
-
-static ffelexHandler
-ffestb_decl_R539maybe_5_ (ffelexToken t)
-{
- ffelexHandler next;
-
- switch (ffelex_token_type (t))
- {
- case FFELEX_typeCOMMA:
- case FFELEX_typeEOS:
- case FFELEX_typeSEMICOLON:
- ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
- if (!ffestb_local_.decl.imp_started)
- {
- ffestb_local_.decl.imp_started = TRUE;
- ffesta_confirmed ();
- if (!ffesta_is_inhibited ())
- ffestc_R539start ();
- }
- if (!ffesta_is_inhibited ())
- ffestc_R539item (ffestb_local_.decl.type, ffestb_local_.decl.kind,
- ffestb_local_.decl.kindt, ffestb_local_.decl.len,
- ffestb_local_.decl.lent, ffestb_local_.decl.imps);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- ffestt_implist_kill (ffestb_local_.decl.imps);
- if (ffelex_token_type (t) == FFELEX_typeCOMMA)
- return (ffelexHandler) ffestb_decl_R5395_;
- if (!ffesta_is_inhibited ())
- ffestc_R539finish ();
- return (ffelexHandler) ffesta_zero (t);
-
- case FFELEX_typeOPEN_PAREN:
- ffesta_confirmed ();
- ffestt_implist_kill (ffestb_local_.decl.imps);
- next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
- (ffelexHandler) ffestb_local_.decl.imp_handler);
- ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
- return (ffelexHandler) (*next) (t);
-
- default:
- break;
- }
-
- ffestt_implist_kill (ffestb_local_.decl.imps);
- ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
- if (ffestb_local_.decl.kindt != NULL)
- ffelex_token_kill (ffestb_local_.decl.kindt);
- if (ffestb_local_.decl.lent != NULL)
- ffelex_token_kill (ffestb_local_.decl.lent);
- if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
- ffestc_R539finish ();
- ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
- return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
projects / msp430-gcc.git / blobdiff