d/freebsd-dev
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
ec7ef67042
freebsd-dev/contrib/gcc/f/stb.c

25205 lines
704 KiB
C
Raw Normal View History

Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
/* stb.c -- Implementation File (module.c template V1.0)
Copyright (C) 1995, 1996 Free Software Foundation, Inc.
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
Contributed by James Craig Burley.
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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
{
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *badname;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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. */
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *badname;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
ffestrOther kw; /* INTENT(IN/OUT/INOUT). */
ffestpType type;
bool parameter; /* If PARAMETER attribute seen (governs =expr
context). */
bool coloncolon; /* If COLONCOLON seen (allows =expr). */
bool aster_after; /* "*" seen after, not before,
[RECURSIVE]FUNCTIONxyz. */
bool empty; /* Ambig function dummy arg list empty so
far? */
bool imp_started; /* Started IMPLICIT statement already. */
bool imp_seen_comma; /* TRUE if next COMMA within parens means not
R541. */
}
decl;
struct
{
bool started;
}
vxtparam;
}; /* Merge with the one in ffestb later. */
/* Private include files. */
/* Internal structure definitions. */
/* Static objects accessed by functions in this module. */
static union ffestb_subrargs_u_ ffestb_subrargs_;
static union ffestb_local_u_ ffestb_local_;
/* Static functions (internal). */
static void ffestb_subr_ambig_to_ents_ (void);
static ffelexHandler ffestb_subr_ambig_nope_ (ffelexToken t);
static ffelexHandler ffestb_subr_dimlist_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_subr_dimlist_1_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_subr_dimlist_2_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_subr_name_list_ (ffelexToken t);
static ffelexHandler ffestb_subr_name_list_1_ (ffelexToken t);
static void ffestb_subr_R1001_append_p_ (void);
static ffelexHandler ffestb_decl_kindparam_ (ffelexToken t);
static ffelexHandler ffestb_decl_kindparam_1_ (ffelexToken t);
static ffelexHandler ffestb_decl_kindparam_2_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_decl_starkind_ (ffelexToken t);
static ffelexHandler ffestb_decl_starlen_ (ffelexToken t);
static ffelexHandler ffestb_decl_starlen_1_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_decl_typeparams_ (ffelexToken t);
static ffelexHandler ffestb_decl_typeparams_1_ (ffelexToken t);
static ffelexHandler ffestb_decl_typeparams_2_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_decl_typeparams_3_ (ffelexToken ft, ffebld expr,
ffelexToken t);
#if FFESTR_F90
static ffelexHandler ffestb_decl_typetype1_ (ffelexToken t);
static ffelexHandler ffestb_decl_typetype2_ (ffelexToken t);
#endif
static ffelexHandler ffestb_subr_label_list_ (ffelexToken t);
static ffelexHandler ffestb_subr_label_list_1_ (ffelexToken t);
static ffelexHandler ffestb_do1_ (ffelexToken t);
static ffelexHandler ffestb_do2_ (ffelexToken t);
static ffelexHandler ffestb_do3_ (ffelexToken t);
static ffelexHandler ffestb_do4_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_do5_ (ffelexToken t);
static ffelexHandler ffestb_do6_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_do7_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_do8_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_do9_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_else1_ (ffelexToken t);
static ffelexHandler ffestb_else2_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_else3_ (ffelexToken t);
static ffelexHandler ffestb_else4_ (ffelexToken t);
static ffelexHandler ffestb_else5_ (ffelexToken t);
static ffelexHandler ffestb_end1_ (ffelexToken t);
static ffelexHandler ffestb_end2_ (ffelexToken t);
static ffelexHandler ffestb_end3_ (ffelexToken t);
static ffelexHandler ffestb_goto1_ (ffelexToken t);
static ffelexHandler ffestb_goto2_ (ffelexToken t);
static ffelexHandler ffestb_goto3_ (ffelexToken t);
static ffelexHandler ffestb_goto4_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_goto5_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_goto6_ (ffelexToken t);
static ffelexHandler ffestb_goto7_ (ffelexToken t);
static ffelexHandler ffestb_halt1_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_if1_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_if2_ (ffelexToken t);
static ffelexHandler ffestb_if3_ (ffelexToken t);
static ffelexHandler ffestb_let1_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_let2_ (ffelexToken ft, ffebld expr,
ffelexToken t);
#if FFESTR_F90
static ffelexHandler ffestb_type1_ (ffelexToken t);
static ffelexHandler ffestb_type2_ (ffelexToken t);
static ffelexHandler ffestb_type3_ (ffelexToken t);
static ffelexHandler ffestb_type4_ (ffelexToken t);
#endif
#if FFESTR_F90
static ffelexHandler ffestb_varlist1_ (ffelexToken t);
static ffelexHandler ffestb_varlist2_ (ffelexToken t);
static ffelexHandler ffestb_varlist3_ (ffelexToken t);
static ffelexHandler ffestb_varlist4_ (ffelexToken t);
#endif
static ffelexHandler ffestb_varlist5_ (ffelexToken t);
static ffelexHandler ffestb_varlist6_ (ffelexToken t);
#if FFESTR_F90
static ffelexHandler ffestb_where1_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_where2_ (ffelexToken t);
static ffelexHandler ffestb_where3_ (ffelexToken t);
#endif
static ffelexHandler ffestb_R5221_ (ffelexToken t);
static ffelexHandler ffestb_R5222_ (ffelexToken t);
static ffelexHandler ffestb_R5223_ (ffelexToken t);
static ffelexHandler ffestb_R5224_ (ffelexToken t);
static ffelexHandler ffestb_R5281_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R5282_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R5283_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R5284_ (ffelexToken t);
static ffelexHandler ffestb_R5371_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R5372_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R5373_ (ffelexToken t);
static ffelexHandler ffestb_R5421_ (ffelexToken t);
static ffelexHandler ffestb_R5422_ (ffelexToken t);
static ffelexHandler ffestb_R5423_ (ffelexToken t);
static ffelexHandler ffestb_R5424_ (ffelexToken t);
static ffelexHandler ffestb_R5425_ (ffelexToken t);
static ffelexHandler ffestb_R5441_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R5442_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R5443_ (ffelexToken t);
static ffelexHandler ffestb_R5444_ (ffelexToken t);
static ffelexHandler ffestb_R8341_ (ffelexToken t);
static ffelexHandler ffestb_R8351_ (ffelexToken t);
static ffelexHandler ffestb_R8381_ (ffelexToken t);
static ffelexHandler ffestb_R8382_ (ffelexToken t);
static ffelexHandler ffestb_R8383_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R8401_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R8402_ (ffelexToken t);
static ffelexHandler ffestb_R8403_ (ffelexToken t);
static ffelexHandler ffestb_R8404_ (ffelexToken t);
static ffelexHandler ffestb_R8405_ (ffelexToken t);
static ffelexHandler ffestb_R8406_ (ffelexToken t);
static ffelexHandler ffestb_R8407_ (ffelexToken t);
static ffelexHandler ffestb_R11021_ (ffelexToken t);
static ffelexHandler ffestb_R1111_1_ (ffelexToken t);
static ffelexHandler ffestb_R1111_2_ (ffelexToken t);
static ffelexHandler ffestb_R12121_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R12271_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_construct1_ (ffelexToken t);
static ffelexHandler ffestb_construct2_ (ffelexToken t);
#if FFESTR_F90
static ffelexHandler ffestb_heap1_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_heap2_ (ffelexToken t);
static ffelexHandler ffestb_heap3_ (ffelexToken t);
static ffelexHandler ffestb_heap4_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_heap5_ (ffelexToken t);
#endif
#if FFESTR_F90
static ffelexHandler ffestb_module1_ (ffelexToken t);
static ffelexHandler ffestb_module2_ (ffelexToken t);
static ffelexHandler ffestb_module3_ (ffelexToken t);
#endif
static ffelexHandler ffestb_R8091_ (ffelexToken t);
static ffelexHandler ffestb_R8092_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R8093_ (ffelexToken t);
static ffelexHandler ffestb_R8101_ (ffelexToken t);
static ffelexHandler ffestb_R8102_ (ffelexToken t);
static ffelexHandler ffestb_R8103_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R8104_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R10011_ (ffelexToken t);
static ffelexHandler ffestb_R10012_ (ffelexToken t);
static ffelexHandler ffestb_R10013_ (ffelexToken t);
static ffelexHandler ffestb_R10014_ (ffelexToken t);
static ffelexHandler ffestb_R10015_ (ffelexToken t);
static ffelexHandler ffestb_R10016_ (ffelexToken t);
static ffelexHandler ffestb_R10017_ (ffelexToken t);
static ffelexHandler ffestb_R10018_ (ffelexToken t);
static ffelexHandler ffestb_R10019_ (ffelexToken t);
static ffelexHandler ffestb_R100110_ (ffelexToken t);
static ffelexHandler ffestb_R100111_ (ffelexToken t);
static ffelexHandler ffestb_R100112_ (ffelexToken t);
static ffelexHandler ffestb_R100113_ (ffelexToken t);
static ffelexHandler ffestb_R100114_ (ffelexToken t);
static ffelexHandler ffestb_R100115_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R100116_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R100117_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R100118_ (ffelexToken ft, ffebld expr,
ffelexToken t);
#if FFESTR_F90
static ffelexHandler ffestb_R11071_ (ffelexToken t);
static ffelexHandler ffestb_R11072_ (ffelexToken t);
static ffelexHandler ffestb_R11073_ (ffelexToken t);
static ffelexHandler ffestb_R11074_ (ffelexToken t);
static ffelexHandler ffestb_R11075_ (ffelexToken t);
static ffelexHandler ffestb_R11076_ (ffelexToken t);
static ffelexHandler ffestb_R11077_ (ffelexToken t);
static ffelexHandler ffestb_R11078_ (ffelexToken t);
static ffelexHandler ffestb_R11079_ (ffelexToken t);
static ffelexHandler ffestb_R110710_ (ffelexToken t);
static ffelexHandler ffestb_R110711_ (ffelexToken t);
static ffelexHandler ffestb_R110712_ (ffelexToken t);
#endif
#if FFESTR_F90
static ffelexHandler ffestb_R12021_ (ffelexToken t);
static ffelexHandler ffestb_R12022_ (ffelexToken t);
static ffelexHandler ffestb_R12023_ (ffelexToken t);
static ffelexHandler ffestb_R12024_ (ffelexToken t);
static ffelexHandler ffestb_R12025_ (ffelexToken t);
static ffelexHandler ffestb_R12026_ (ffelexToken t);
#endif
static ffelexHandler ffestb_S3P41_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_V0141_ (ffelexToken t);
static ffelexHandler ffestb_V0142_ (ffelexToken t);
static ffelexHandler ffestb_V0143_ (ffelexToken t);
static ffelexHandler ffestb_V0144_ (ffelexToken t);
#if FFESTR_VXT
static ffelexHandler ffestb_V0251_ (ffelexToken t);
static ffelexHandler ffestb_V0252_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_V0253_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_V0254_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_V0255_ (ffelexToken t);
static ffelexHandler ffestb_V0256_ (ffelexToken t);
static ffelexHandler ffestb_V0257_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_V0258_ (ffelexToken t);
#endif
#if FFESTB_KILL_EASY_
static void ffestb_subr_kill_easy_ (ffestpInquireIx max);
#else
static void ffestb_subr_kill_accept_ (void);
static void ffestb_subr_kill_beru_ (void);
static void ffestb_subr_kill_close_ (void);
static void ffestb_subr_kill_delete_ (void);
static void ffestb_subr_kill_find_ (void); /* Not written yet. */
static void ffestb_subr_kill_inquire_ (void);
static void ffestb_subr_kill_open_ (void);
static void ffestb_subr_kill_print_ (void);
static void ffestb_subr_kill_read_ (void);
static void ffestb_subr_kill_rewrite_ (void);
static void ffestb_subr_kill_type_ (void);
static void ffestb_subr_kill_vxtcode_ (void); /* Not written yet. */
static void ffestb_subr_kill_write_ (void);
#endif
static ffelexHandler ffestb_beru1_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_beru2_ (ffelexToken t);
static ffelexHandler ffestb_beru3_ (ffelexToken t);
static ffelexHandler ffestb_beru4_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_beru5_ (ffelexToken t);
static ffelexHandler ffestb_beru6_ (ffelexToken t);
static ffelexHandler ffestb_beru7_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_beru8_ (ffelexToken t);
static ffelexHandler ffestb_beru9_ (ffelexToken t);
static ffelexHandler ffestb_beru10_ (ffelexToken t);
#if FFESTR_VXT
static ffelexHandler ffestb_vxtcode1_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_vxtcode2_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_vxtcode3_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_vxtcode4_ (ffelexToken t);
static ffelexHandler ffestb_vxtcode5_ (ffelexToken t);
static ffelexHandler ffestb_vxtcode6_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_vxtcode7_ (ffelexToken t);
static ffelexHandler ffestb_vxtcode8_ (ffelexToken t);
static ffelexHandler ffestb_vxtcode9_ (ffelexToken t);
static ffelexHandler ffestb_vxtcode10_ (ffelexToken ft, ffebld expr,
ffelexToken t);
#endif
static ffelexHandler ffestb_R9041_ (ffelexToken t);
static ffelexHandler ffestb_R9042_ (ffelexToken t);
static ffelexHandler ffestb_R9043_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R9044_ (ffelexToken t);
static ffelexHandler ffestb_R9045_ (ffelexToken t);
static ffelexHandler ffestb_R9046_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R9047_ (ffelexToken t);
static ffelexHandler ffestb_R9048_ (ffelexToken t);
static ffelexHandler ffestb_R9049_ (ffelexToken t);
static ffelexHandler ffestb_R9071_ (ffelexToken t);
static ffelexHandler ffestb_R9072_ (ffelexToken t);
static ffelexHandler ffestb_R9073_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R9074_ (ffelexToken t);
static ffelexHandler ffestb_R9075_ (ffelexToken t);
static ffelexHandler ffestb_R9076_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R9077_ (ffelexToken t);
static ffelexHandler ffestb_R9078_ (ffelexToken t);
static ffelexHandler ffestb_R9079_ (ffelexToken t);
static ffelexHandler ffestb_R9091_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R9092_ (ffelexToken t);
static ffelexHandler ffestb_R9093_ (ffelexToken t);
static ffelexHandler ffestb_R9094_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R9095_ (ffelexToken t);
static ffelexHandler ffestb_R9096_ (ffelexToken t);
static ffelexHandler ffestb_R9097_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R9098_ (ffelexToken t);
static ffelexHandler ffestb_R9099_ (ffelexToken t);
static ffelexHandler ffestb_R90910_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R90911_ (ffelexToken t);
static ffelexHandler ffestb_R90912_ (ffelexToken t);
static ffelexHandler ffestb_R90913_ (ffelexToken t);
static ffelexHandler ffestb_R90914_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R90915_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R9101_ (ffelexToken t);
static ffelexHandler ffestb_R9102_ (ffelexToken t);
static ffelexHandler ffestb_R9103_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R9104_ (ffelexToken t);
static ffelexHandler ffestb_R9105_ (ffelexToken t);
static ffelexHandler ffestb_R9106_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R9107_ (ffelexToken t);
static ffelexHandler ffestb_R9108_ (ffelexToken t);
static ffelexHandler ffestb_R9109_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R91010_ (ffelexToken t);
static ffelexHandler ffestb_R91011_ (ffelexToken t);
static ffelexHandler ffestb_R91012_ (ffelexToken t);
static ffelexHandler ffestb_R91013_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R91014_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R9111_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R9112_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R9231_ (ffelexToken t);
static ffelexHandler ffestb_R9232_ (ffelexToken t);
static ffelexHandler ffestb_R9233_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R9234_ (ffelexToken t);
static ffelexHandler ffestb_R9235_ (ffelexToken t);
static ffelexHandler ffestb_R9236_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R9237_ (ffelexToken t);
static ffelexHandler ffestb_R9238_ (ffelexToken t);
static ffelexHandler ffestb_R9239_ (ffelexToken t);
static ffelexHandler ffestb_R92310_ (ffelexToken t);
static ffelexHandler ffestb_R92311_ (ffelexToken ft, ffebld expr,
ffelexToken t);
#if FFESTR_VXT
static ffelexHandler ffestb_V0181_ (ffelexToken t);
static ffelexHandler ffestb_V0182_ (ffelexToken t);
static ffelexHandler ffestb_V0183_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_V0184_ (ffelexToken t);
static ffelexHandler ffestb_V0185_ (ffelexToken t);
static ffelexHandler ffestb_V0186_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_V0187_ (ffelexToken t);
static ffelexHandler ffestb_V0188_ (ffelexToken t);
static ffelexHandler ffestb_V0189_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_V01810_ (ffelexToken t);
static ffelexHandler ffestb_V01811_ (ffelexToken t);
static ffelexHandler ffestb_V01812_ (ffelexToken t);
static ffelexHandler ffestb_V01813_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_V0191_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_V0192_ (ffelexToken ft, ffebld expr,
ffelexToken t);
#endif
static ffelexHandler ffestb_V0201_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_V0202_ (ffelexToken ft, ffebld expr,
ffelexToken t);
#if FFESTR_VXT
static ffelexHandler ffestb_V0211_ (ffelexToken t);
static ffelexHandler ffestb_V0212_ (ffelexToken t);
static ffelexHandler ffestb_V0213_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_V0214_ (ffelexToken t);
static ffelexHandler ffestb_V0215_ (ffelexToken t);
static ffelexHandler ffestb_V0216_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_V0217_ (ffelexToken t);
static ffelexHandler ffestb_V0218_ (ffelexToken t);
static ffelexHandler ffestb_V0219_ (ffelexToken t);
static ffelexHandler ffestb_V0261_ (ffelexToken t);
static ffelexHandler ffestb_V0262_ (ffelexToken t);
static ffelexHandler ffestb_V0263_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_V0264_ (ffelexToken t);
static ffelexHandler ffestb_V0265_ (ffelexToken t);
static ffelexHandler ffestb_V0266_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_V0267_ (ffelexToken t);
static ffelexHandler ffestb_V0268_ (ffelexToken t);
static ffelexHandler ffestb_V0269_ (ffelexToken t);
#endif
#if FFESTR_F90
static ffelexHandler ffestb_dimlist1_ (ffelexToken t);
static ffelexHandler ffestb_dimlist2_ (ffelexToken t);
static ffelexHandler ffestb_dimlist3_ (ffelexToken t);
static ffelexHandler ffestb_dimlist4_ (ffelexToken t);
#endif
static ffelexHandler ffestb_dummy1_ (ffelexToken t);
static ffelexHandler ffestb_dummy2_ (ffelexToken t);
static ffelexHandler ffestb_R5241_ (ffelexToken t);
static ffelexHandler ffestb_R5242_ (ffelexToken t);
static ffelexHandler ffestb_R5243_ (ffelexToken t);
static ffelexHandler ffestb_R5244_ (ffelexToken t);
static ffelexHandler ffestb_R5471_ (ffelexToken t);
static ffelexHandler ffestb_R5472_ (ffelexToken t);
static ffelexHandler ffestb_R5473_ (ffelexToken t);
static ffelexHandler ffestb_R5474_ (ffelexToken t);
static ffelexHandler ffestb_R5475_ (ffelexToken t);
static ffelexHandler ffestb_R5476_ (ffelexToken t);
static ffelexHandler ffestb_R5477_ (ffelexToken t);
#if FFESTR_F90
static ffelexHandler ffestb_R6241_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_R6242_ (ffelexToken t);
#endif
static ffelexHandler ffestb_R12291_ (ffelexToken t);
static ffelexHandler ffestb_R12292_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_decl_chartype1_ (ffelexToken t);
#if FFESTR_F90
static ffelexHandler ffestb_decl_recursive1_ (ffelexToken t);
static ffelexHandler ffestb_decl_recursive2_ (ffelexToken t);
static ffelexHandler ffestb_decl_recursive3_ (ffelexToken t);
static ffelexHandler ffestb_decl_recursive4_ (ffelexToken t);
#endif
static ffelexHandler ffestb_decl_attrs_ (ffelexToken t);
static ffelexHandler ffestb_decl_attrs_1_ (ffelexToken t);
static ffelexHandler ffestb_decl_attrs_2_ (ffelexToken t);
#if FFESTR_F90
static ffelexHandler ffestb_decl_attrs_3_ (ffelexToken t);
static ffelexHandler ffestb_decl_attrs_4_ (ffelexToken t);
static ffelexHandler ffestb_decl_attrs_5_ (ffelexToken t);
static ffelexHandler ffestb_decl_attrs_6_ (ffelexToken t);
#endif
static ffelexHandler ffestb_decl_attrs_7_ (ffelexToken t);
static ffelexHandler ffestb_decl_attrsp_ (ffelexToken t);
static ffelexHandler ffestb_decl_ents_ (ffelexToken t);
static ffelexHandler ffestb_decl_ents_1_ (ffelexToken t);
static ffelexHandler ffestb_decl_ents_2_ (ffelexToken t);
static ffelexHandler ffestb_decl_ents_3_ (ffelexToken t);
static ffelexHandler ffestb_decl_ents_4_ (ffelexToken t);
static ffelexHandler ffestb_decl_ents_5_ (ffelexToken t);
static ffelexHandler ffestb_decl_ents_6_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_decl_ents_7_ (ffelexToken t);
static ffelexHandler ffestb_decl_ents_8_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_decl_ents_9_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_decl_ents_10_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_decl_ents_11_ (ffelexToken t);
static ffelexHandler ffestb_decl_entsp_ (ffelexToken t);
static ffelexHandler ffestb_decl_entsp_1_ (ffelexToken t);
static ffelexHandler ffestb_decl_entsp_2_ (ffelexToken t);
static ffelexHandler ffestb_decl_entsp_3_ (ffelexToken t);
static ffelexHandler ffestb_decl_entsp_4_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_decl_entsp_5_ (ffelexToken t);
static ffelexHandler ffestb_decl_entsp_6_ (ffelexToken t);
static ffelexHandler ffestb_decl_entsp_7_ (ffelexToken t);
static ffelexHandler ffestb_decl_entsp_8_ (ffelexToken t);
#if FFESTR_F90
static ffelexHandler ffestb_decl_func_ (ffelexToken t);
#endif
static ffelexHandler ffestb_decl_funcname_ (ffelexToken t);
static ffelexHandler ffestb_decl_funcname_1_ (ffelexToken t);
static ffelexHandler ffestb_decl_funcname_2_ (ffelexToken t);
static ffelexHandler ffestb_decl_funcname_3_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_decl_funcname_4_ (ffelexToken t);
static ffelexHandler ffestb_decl_funcname_5_ (ffelexToken t);
static ffelexHandler ffestb_decl_funcname_6_ (ffelexToken t);
static ffelexHandler ffestb_decl_funcname_7_ (ffelexToken t);
static ffelexHandler ffestb_decl_funcname_8_ (ffelexToken t);
static ffelexHandler ffestb_decl_funcname_9_ (ffelexToken t);
#if FFESTR_VXT
static ffelexHandler ffestb_V0031_ (ffelexToken t);
static ffelexHandler ffestb_V0032_ (ffelexToken t);
static ffelexHandler ffestb_V0033_ (ffelexToken t);
static ffelexHandler ffestb_V0034_ (ffelexToken t);
static ffelexHandler ffestb_V0035_ (ffelexToken t);
static ffelexHandler ffestb_V0036_ (ffelexToken t);
static ffelexHandler ffestb_V0161_ (ffelexToken t);
static ffelexHandler ffestb_V0162_ (ffelexToken t);
static ffelexHandler ffestb_V0163_ (ffelexToken t);
static ffelexHandler ffestb_V0164_ (ffelexToken t);
static ffelexHandler ffestb_V0165_ (ffelexToken t);
static ffelexHandler ffestb_V0166_ (ffelexToken t);
#endif
static ffelexHandler ffestb_V0271_ (ffelexToken t);
static ffelexHandler ffestb_V0272_ (ffelexToken ft, ffebld expr,
ffelexToken t);
static ffelexHandler ffestb_V0273_ (ffelexToken t);
static ffelexHandler ffestb_decl_R5391_ (ffelexToken t);
static ffelexHandler ffestb_decl_R5392_ (ffelexToken t);
#if FFESTR_F90
static ffelexHandler ffestb_decl_R5393_ (ffelexToken t);
#endif
static ffelexHandler ffestb_decl_R5394_ (ffelexToken t);
static ffelexHandler ffestb_decl_R5395_ (ffelexToken t);
static ffelexHandler ffestb_decl_R539letters_ (ffelexToken t);
static ffelexHandler ffestb_decl_R539letters_1_ (ffelexToken t);
static ffelexHandler ffestb_decl_R539letters_2_ (ffelexToken t);
static ffelexHandler ffestb_decl_R539letters_3_ (ffelexToken t);
static ffelexHandler ffestb_decl_R539letters_4_ (ffelexToken t);
static ffelexHandler ffestb_decl_R539letters_5_ (ffelexToken t);
static ffelexHandler ffestb_decl_R539maybe_ (ffelexToken t);
static ffelexHandler ffestb_decl_R539maybe_1_ (ffelexToken t);
static ffelexHandler ffestb_decl_R539maybe_2_ (ffelexToken t);
static ffelexHandler ffestb_decl_R539maybe_3_ (ffelexToken t);
static ffelexHandler ffestb_decl_R539maybe_4_ (ffelexToken t);
static ffelexHandler ffestb_decl_R539maybe_5_ (ffelexToken t);
/* Internal macros. */
#if FFESTB_KILL_EASY_
#define ffestb_subr_kill_accept_() \
ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_acceptix)
#define ffestb_subr_kill_beru_() \
ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_beruix)
#define ffestb_subr_kill_close_() \
ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_closeix)
#define ffestb_subr_kill_delete_() \
ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_deleteix)
#define ffestb_subr_kill_find_() \
ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_findix)
#define ffestb_subr_kill_inquire_() \
ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_inquireix)
#define ffestb_subr_kill_open_() \
ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_openix)
#define ffestb_subr_kill_print_() \
ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_printix)
#define ffestb_subr_kill_read_() \
ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_readix)
#define ffestb_subr_kill_rewrite_() \
ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_rewriteix)
#define ffestb_subr_kill_type_() \
ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_typeix)
#define ffestb_subr_kill_vxtcode_() \
ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_vxtcodeix)
#define ffestb_subr_kill_write_() \
ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_writeix)
#endif
/* ffestb_subr_ambig_nope_ -- Cleans up and aborts ambig w/o confirming
ffestb_subr_ambig_nope_();
Switch from ambiguity handling in _entsp_ functions to handling entities
in _ents_ (perform housekeeping tasks). */
static ffelexHandler
ffestb_subr_ambig_nope_ (ffelexToken t)
{
if (ffestb_local_.decl.recursive != NULL)
ffelex_token_kill (ffestb_local_.decl.recursive);
if (ffestb_local_.decl.kindt != NULL)
ffelex_token_kill (ffestb_local_.decl.kindt);
if (ffestb_local_.decl.lent != NULL)
ffelex_token_kill (ffestb_local_.decl.lent);
ffelex_token_kill (ffesta_tokens[1]);
ffelex_token_kill (ffesta_tokens[2]);
ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
}
/* ffestb_subr_ambig_to_ents_ -- Switches from ambiguity to entity decl
ffestb_subr_ambig_to_ents_();
Switch from ambiguity handling in _entsp_ functions to handling entities
in _ents_ (perform housekeeping tasks). */
static void
ffestb_subr_ambig_to_ents_ ()
{
ffelexToken nt;
nt = ffelex_token_name_from_names (ffesta_tokens[1], 0, 0);
ffelex_token_kill (ffesta_tokens[1]);
ffelex_token_kill (ffesta_tokens[2]);
ffesta_tokens[1] = nt;
if (ffestb_local_.decl.recursive != NULL)
ffelex_token_kill (ffestb_local_.decl.recursive);
if (!ffestb_local_.decl.aster_after)
{
if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
{
if (!ffesta_is_inhibited ())
ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
ffestb_local_.decl.len, ffestb_local_.decl.lent);
if (ffestb_local_.decl.kindt != NULL)
{
ffelex_token_kill (ffestb_local_.decl.kindt);
ffestb_local_.decl.kind = NULL;
ffestb_local_.decl.kindt = NULL;
}
if (ffestb_local_.decl.lent != NULL)
{
ffelex_token_kill (ffestb_local_.decl.lent);
ffestb_local_.decl.len = NULL;
ffestb_local_.decl.lent = NULL;
}
}
else
{
if (!ffesta_is_inhibited ())
ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
ffestb_local_.decl.kind, ffestb_local_.decl.kindt, NULL,
NULL);
if (ffestb_local_.decl.kindt != NULL)
{
ffelex_token_kill (ffestb_local_.decl.kindt);
ffestb_local_.decl.kind = NULL;
ffestb_local_.decl.kindt = NULL;
}
}
return;
}
if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
{
if (!ffesta_is_inhibited ())
ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
ffestb_local_.decl.kind, ffestb_local_.decl.kindt, NULL, NULL);
if (ffestb_local_.decl.kindt != NULL)
{
ffelex_token_kill (ffestb_local_.decl.kindt);
ffestb_local_.decl.kind = NULL;
ffestb_local_.decl.kindt = NULL;
}
}
else if (!ffesta_is_inhibited ())
ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
NULL, NULL, NULL, NULL);
/* NAME/NAMES token already in ffesta_tokens[1]. */
}
/* ffestb_subr_dimlist_ -- OPEN_PAREN expr
(ffestb_subr_dimlist_) // to expression handler
Deal with a dimension list.
19-Dec-90 JCB 1.1
Detect too many dimensions if backend wants it. */
static ffelexHandler
ffestb_subr_dimlist_ (ffelexToken ft, ffebld expr, ffelexToken t)
{
switch (ffelex_token_type (t))
{
case FFELEX_typeCLOSE_PAREN:
if (expr == NULL)
break;
#ifdef FFECOM_dimensionsMAX
if (ffestb_subrargs_.dim_list.ndims++ == FFECOM_dimensionsMAX)
{
ffesta_ffebad_1t (FFEBAD_TOO_MANY_DIMS, ft);
ffestb_subrargs_.dim_list.ok = TRUE; /* Not a parse error, really. */
return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
}
#endif
ffestt_dimlist_append (ffestb_subrargs_.dim_list.dims, NULL, expr,
ffelex_token_use (t));
ffestb_subrargs_.dim_list.ok = TRUE;
return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
case FFELEX_typeCOMMA:
if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
break;
#ifdef FFECOM_dimensionsMAX
if (ffestb_subrargs_.dim_list.ndims++ == FFECOM_dimensionsMAX)
{
ffesta_ffebad_1t (FFEBAD_TOO_MANY_DIMS, ft);
return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
ffestb_subrargs_.dim_list.ctx,
(ffeexprCallback) ffestb_subr_dimlist_2_);
}
#endif
ffestt_dimlist_append (ffestb_subrargs_.dim_list.dims, NULL, expr,
ffelex_token_use (t));
return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
ffestb_subrargs_.dim_list.ctx,
(ffeexprCallback) ffestb_subr_dimlist_);
case FFELEX_typeCOLON:
if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
break;
#ifdef FFECOM_dimensionsMAX
if (ffestb_subrargs_.dim_list.ndims++ == FFECOM_dimensionsMAX)
{
ffesta_ffebad_1t (FFEBAD_TOO_MANY_DIMS, ft);
return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
ffestb_subrargs_.dim_list.ctx,
(ffeexprCallback) ffestb_subr_dimlist_2_);
}
#endif
ffestt_dimlist_append (ffestb_subrargs_.dim_list.dims, expr, NULL,
ffelex_token_use (t)); /* NULL second expr for
now, just plug in. */
return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
ffestb_subrargs_.dim_list.ctx,
(ffeexprCallback) ffestb_subr_dimlist_1_);
default:
break;
}
ffestb_subrargs_.dim_list.ok = FALSE;
return (ffelexHandler) ffestb_subrargs_.dim_list.handler (t);
}
/* ffestb_subr_dimlist_1_ -- OPEN_PAREN expr COLON expr
(ffestb_subr_dimlist_1_) // to expression handler
Get the upper bound. */
static ffelexHandler
ffestb_subr_dimlist_1_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
{
switch (ffelex_token_type (t))
{
case FFELEX_typeCLOSE_PAREN:
ffestb_subrargs_.dim_list.dims->previous->upper = expr;
ffestb_subrargs_.dim_list.ok = TRUE;
return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
case FFELEX_typeCOMMA:
if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
break;
ffestb_subrargs_.dim_list.dims->previous->upper = expr;
return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
ffestb_subrargs_.dim_list.ctx, (ffeexprCallback) ffestb_subr_dimlist_);
default:
break;
}
ffestb_subrargs_.dim_list.ok = FALSE;
return (ffelexHandler) ffestb_subrargs_.dim_list.handler (t);
}
/* ffestb_subr_dimlist_2_ -- OPEN_PAREN too-many-dim-exprs
(ffestb_subr_dimlist_2_) // to expression handler
Get the upper bound. */
static ffelexHandler
ffestb_subr_dimlist_2_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
{
switch (ffelex_token_type (t))
{
case FFELEX_typeCLOSE_PAREN:
ffestb_subrargs_.dim_list.ok = TRUE; /* Not a parse error, really. */
return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
case FFELEX_typeCOMMA:
case FFELEX_typeCOLON:
if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
break;
return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
ffestb_subrargs_.dim_list.ctx,
(ffeexprCallback) ffestb_subr_dimlist_2_);
default:
break;
}
ffestb_subrargs_.dim_list.ok = FALSE;
return (ffelexHandler) ffestb_subrargs_.dim_list.handler (t);
}
/* ffestb_subr_name_list_ -- Collect a list of name args and close-paren
return ffestb_subr_name_list_; // to lexer after seeing OPEN_PAREN
This implements R1224 in the Fortran 90 spec. The arg list may be
empty, or be a comma-separated list (an optional trailing comma currently
results in a warning but no other effect) of arguments. For functions,
however, "*" is invalid (we implement dummy-arg-name, rather than R1224
dummy-arg, which itself is either dummy-arg-name or "*"). */
static ffelexHandler
ffestb_subr_name_list_ (ffelexToken t)
{
switch (ffelex_token_type (t))
{
case FFELEX_typeCLOSE_PAREN:
if (ffestt_tokenlist_count (ffestb_subrargs_.name_list.args) != 0)
{ /* Trailing comma, warn. */
ffebad_start (FFEBAD_TRAILING_COMMA);
ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
ffebad_finish ();
}
ffestb_subrargs_.name_list.ok = TRUE;
ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
if (ffestb_subrargs_.name_list.names)
ffelex_set_names (TRUE);
return (ffelexHandler) ffestb_subrargs_.name_list.handler;
case FFELEX_typeASTERISK:
if (!ffestb_subrargs_.name_list.is_subr)
break;
case FFELEX_typeNAME:
ffestt_tokenlist_append (ffestb_subrargs_.name_list.args,
ffelex_token_use (t));
return (ffelexHandler) ffestb_subr_name_list_1_;
default:
break;
}
ffestb_subrargs_.name_list.ok = FALSE;
ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
if (ffestb_subrargs_.name_list.names)
ffelex_set_names (TRUE);
return (ffelexHandler) (*ffestb_subrargs_.name_list.handler) (t);
}
/* ffestb_subr_name_list_1_ -- NAME or ASTERISK
return ffestb_subr_name_list_1_; // to lexer
The next token must be COMMA or CLOSE_PAREN, either way go to original
state, but only after adding the appropriate name list item. */
static ffelexHandler
ffestb_subr_name_list_1_ (ffelexToken t)
{
switch (ffelex_token_type (t))
{
case FFELEX_typeCOMMA:
return (ffelexHandler) ffestb_subr_name_list_;
case FFELEX_typeCLOSE_PAREN:
ffestb_subrargs_.name_list.ok = TRUE;
ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
if (ffestb_subrargs_.name_list.names)
ffelex_set_names (TRUE);
return (ffelexHandler) ffestb_subrargs_.name_list.handler;
default:
ffestb_subrargs_.name_list.ok = FALSE;
ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
if (ffestb_subrargs_.name_list.names)
ffelex_set_names (TRUE);
return (ffelexHandler) (*ffestb_subrargs_.name_list.handler) (t);
}
}
static void
ffestb_subr_R1001_append_p_ (void)
{
ffesttFormatList f;
if (!ffestb_local_.format.pre.present)
{
ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_P_SPEC, ffestb_local_.format.t);
ffelex_token_kill (ffestb_local_.format.t);
return;
}
f = ffestt_formatlist_append (ffestb_local_.format.f);
f->type = FFESTP_formattypeP;
f->t = ffestb_local_.format.t;
f->u.R1010.val = ffestb_local_.format.pre;
}
/* ffestb_decl_kindparam_ -- "type" OPEN_PAREN
return ffestb_decl_kindparam_; // to lexer
Handle "[KIND=]expr)". */
static ffelexHandler
ffestb_decl_kindparam_ (ffelexToken t)
{
switch (ffelex_token_type (t))
{
case FFELEX_typeNAME:
ffesta_tokens[1] = ffelex_token_use (t);
return (ffelexHandler) ffestb_decl_kindparam_1_;
default:
return (ffelexHandler) (*((ffelexHandler)
ffeexpr_rhs (ffesta_output_pool,
FFEEXPR_contextKINDTYPE,
(ffeexprCallback) ffestb_decl_kindparam_2_)))
(t);
}
}
/* ffestb_decl_kindparam_1_ -- "type" OPEN_PAREN NAME
return ffestb_decl_kindparam_1_; // to lexer
Handle "[KIND=]expr)". */
static ffelexHandler
ffestb_decl_kindparam_1_ (ffelexToken t)
{
ffelexHandler next;
ffelexToken nt;
switch (ffelex_token_type (t))
{
case FFELEX_typeEQUALS:
ffesta_confirmed ();
if (ffestr_other (ffesta_tokens[1]) != FFESTR_otherKIND)
break;
ffelex_token_kill (ffesta_tokens[1]);
return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
FFEEXPR_contextKINDTYPE, (ffeexprCallback) ffestb_decl_kindparam_2_);
default:
nt = ffesta_tokens[1];
next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
FFEEXPR_contextKINDTYPE, (ffeexprCallback) ffestb_decl_kindparam_2_)))
(nt);
ffelex_token_kill (nt);
return (ffelexHandler) (*next) (t);
}
if (ffestb_local_.decl.recursive != NULL)
ffelex_token_kill (ffestb_local_.decl.recursive);
ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
ffestb_local_.decl.badname,
ffesta_tokens[1]);
ffelex_token_kill (ffesta_tokens[1]);
return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
}
/* ffestb_decl_kindparam_2_ -- "type" OPEN_PAREN ["KIND="] expr
(ffestb_decl_kindparam_2_) // to expression handler
Handle "[KIND=]expr)". */
static ffelexHandler
ffestb_decl_kindparam_2_ (ffelexToken ft, ffebld expr, ffelexToken t)
{
switch (ffelex_token_type (t))
{
case FFELEX_typeCLOSE_PAREN:
ffestb_local_.decl.kind = expr;
ffestb_local_.decl.kindt = ffelex_token_use (ft);
ffestb_local_.decl.len = NULL;
ffestb_local_.decl.lent = NULL;
ffelex_set_names (TRUE);
return (ffelexHandler) ffestb_local_.decl.handler;
default:
break;
}
if (ffestb_local_.decl.recursive != NULL)
ffelex_token_kill (ffestb_local_.decl.recursive);
ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
ffestb_local_.decl.badname,
t);
return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
}
/* ffestb_decl_starkind_ -- "type" ASTERISK
return ffestb_decl_starkind_; // to lexer
Handle NUMBER. */
static ffelexHandler
ffestb_decl_starkind_ (ffelexToken t)
{
switch (ffelex_token_type (t))
{
case FFELEX_typeNUMBER:
ffestb_local_.decl.kindt = ffelex_token_use (t);
ffestb_local_.decl.kind = NULL;
ffestb_local_.decl.len = NULL;
ffestb_local_.decl.lent = NULL;
ffelex_set_names (TRUE);
return (ffelexHandler) ffestb_local_.decl.handler;
default:
break;
}
if (ffestb_local_.decl.recursive != NULL)
ffelex_token_kill (ffestb_local_.decl.recursive);
ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
ffestb_local_.decl.badname,
t);
return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
}
/* ffestb_decl_starlen_ -- "CHARACTER" ASTERISK
return ffestb_decl_starlen_; // to lexer
Handle NUMBER. */
static ffelexHandler
ffestb_decl_starlen_ (ffelexToken t)
{
switch (ffelex_token_type (t))
{
case FFELEX_typeNUMBER:
ffestb_local_.decl.kind = NULL;
ffestb_local_.decl.kindt = NULL;
ffestb_local_.decl.len = NULL;
ffestb_local_.decl.lent = ffelex_token_use (t);
ffelex_set_names (TRUE);
return (ffelexHandler) ffestb_local_.decl.handler;
case FFELEX_typeOPEN_PAREN:
ffestb_local_.decl.kind = NULL;
ffestb_local_.decl.kindt = NULL;
return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
FFEEXPR_contextCHARACTERSIZE,
(ffeexprCallback) ffestb_decl_starlen_1_);
default:
break;
}
if (ffestb_local_.decl.recursive != NULL)
ffelex_token_kill (ffestb_local_.decl.recursive);
ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
ffestb_local_.decl.badname,
t);
return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
}
/* ffestb_decl_starlen_1_ -- "CHARACTER" ASTERISK OPEN_PAREN expr
(ffestb_decl_starlen_1_) // to expression handler
Handle CLOSE_PAREN. */
static ffelexHandler
ffestb_decl_starlen_1_ (ffelexToken ft, ffebld expr, ffelexToken t)
{
switch (ffelex_token_type (t))
{
case FFELEX_typeCLOSE_PAREN:
if (expr == NULL)
break;
ffestb_local_.decl.len = expr;
ffestb_local_.decl.lent = ffelex_token_use (ft);
ffelex_set_names (TRUE);
return (ffelexHandler) ffestb_local_.decl.handler;
default:
break;
}
if (ffestb_local_.decl.recursive != NULL)
ffelex_token_kill (ffestb_local_.decl.recursive);
ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
ffestb_local_.decl.badname,
t);
return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
}
/* ffestb_decl_typeparams_ -- "CHARACTER" OPEN_PAREN
return ffestb_decl_typeparams_; // to lexer
Handle "[KIND=]expr)". */
static ffelexHandler
ffestb_decl_typeparams_ (ffelexToken t)
{
switch (ffelex_token_type (t))
{
case FFELEX_typeNAME:
ffesta_tokens[1] = ffelex_token_use (t);
return (ffelexHandler) ffestb_decl_typeparams_1_;
default:
if (ffestb_local_.decl.lent == NULL)
return (ffelexHandler) (*((ffelexHandler)
ffeexpr_rhs (ffesta_output_pool,
FFEEXPR_contextCHARACTERSIZE,
(ffeexprCallback) ffestb_decl_typeparams_2_)))
(t);
if (ffestb_local_.decl.kindt != NULL)
break;
return (ffelexHandler) (*((ffelexHandler)
ffeexpr_rhs (ffesta_output_pool,
FFEEXPR_contextKINDTYPE,
(ffeexprCallback) ffestb_decl_typeparams_3_)))
(t);
}
if (ffestb_local_.decl.recursive != NULL)
ffelex_token_kill (ffestb_local_.decl.recursive);
if (ffestb_local_.decl.kindt != NULL)
ffelex_token_kill (ffestb_local_.decl.kindt);
if (ffestb_local_.decl.lent != NULL)
ffelex_token_kill (ffestb_local_.decl.lent);
ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
ffestb_local_.decl.badname,
t);
return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
}
/* ffestb_decl_typeparams_1_ -- "CHARACTER" OPEN_PAREN NAME
return ffestb_decl_typeparams_1_; // to lexer
Handle "[KIND=]expr)". */
static ffelexHandler
ffestb_decl_typeparams_1_ (ffelexToken t)
{
ffelexHandler next;
ffelexToken nt;
switch (ffelex_token_type (t))
{
case FFELEX_typeEQUALS:
ffesta_confirmed ();
switch (ffestr_other (ffesta_tokens[1]))
{
case FFESTR_otherLEN:
if (ffestb_local_.decl.lent != NULL)
break;
ffelex_token_kill (ffesta_tokens[1]);
return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
FFEEXPR_contextCHARACTERSIZE,
(ffeexprCallback) ffestb_decl_typeparams_2_);
case FFESTR_otherKIND:
if (ffestb_local_.decl.kindt != NULL)
break;
ffelex_token_kill (ffesta_tokens[1]);
return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
FFEEXPR_contextKINDTYPE,
(ffeexprCallback) ffestb_decl_typeparams_3_);
default:
break;
}
break;
default:
nt = ffesta_tokens[1];
if (ffestb_local_.decl.lent == NULL)
next = (ffelexHandler) (*((ffelexHandler)
ffeexpr_rhs (ffesta_output_pool,
FFEEXPR_contextCHARACTERSIZE,
(ffeexprCallback) ffestb_decl_typeparams_2_)))
(nt);
else if (ffestb_local_.decl.kindt == NULL)
next = (ffelexHandler) (*((ffelexHandler)
ffeexpr_rhs (ffesta_output_pool,
FFEEXPR_contextKINDTYPE,
(ffeexprCallback) ffestb_decl_typeparams_3_)))
(nt);
else
{
ffesta_tokens[1] = nt;
break;
}
ffelex_token_kill (nt);
return (ffelexHandler) (*next) (t);
}
if (ffestb_local_.decl.recursive != NULL)
ffelex_token_kill (ffestb_local_.decl.recursive);
if (ffestb_local_.decl.kindt != NULL)
ffelex_token_kill (ffestb_local_.decl.kindt);
if (ffestb_local_.decl.lent != NULL)
ffelex_token_kill (ffestb_local_.decl.lent);
ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
ffestb_local_.decl.badname,
ffesta_tokens[1]);
ffelex_token_kill (ffesta_tokens[1]);
return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
}
/* ffestb_decl_typeparams_2_ -- "CHARACTER" OPEN_PAREN ["LEN="] expr
(ffestb_decl_typeparams_2_) // to expression handler
Handle "[LEN=]expr)". */
static ffelexHandler
ffestb_decl_typeparams_2_ (ffelexToken ft, ffebld expr, ffelexToken t)
{
switch (ffelex_token_type (t))
{
case FFELEX_typeCLOSE_PAREN:
ffestb_local_.decl.len = expr;
ffestb_local_.decl.lent = ffelex_token_use (ft);
ffelex_set_names (TRUE);
return (ffelexHandler) ffestb_local_.decl.handler;
case FFELEX_typeCOMMA:
ffestb_local_.decl.len = expr;
ffestb_local_.decl.lent = ffelex_token_use (ft);
return (ffelexHandler) ffestb_decl_typeparams_;
default:
break;
}
if (ffestb_local_.decl.recursive != NULL)
ffelex_token_kill (ffestb_local_.decl.recursive);
if (ffestb_local_.decl.kindt != NULL)
ffelex_token_kill (ffestb_local_.decl.kindt);
if (ffestb_local_.decl.lent != NULL)
ffelex_token_kill (ffestb_local_.decl.lent);
ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
ffestb_local_.decl.badname,
t);
return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
}
/* ffestb_decl_typeparams_3_ -- "CHARACTER" OPEN_PAREN ["KIND="] expr
(ffestb_decl_typeparams_3_) // to expression handler
Handle "[KIND=]expr)". */
static ffelexHandler
ffestb_decl_typeparams_3_ (ffelexToken ft, ffebld expr, ffelexToken t)
{
switch (ffelex_token_type (t))
{
case FFELEX_typeCLOSE_PAREN:
ffestb_local_.decl.kind = expr;
ffestb_local_.decl.kindt = ffelex_token_use (ft);
ffelex_set_names (TRUE);
return (ffelexHandler) ffestb_local_.decl.handler;
case FFELEX_typeCOMMA:
ffestb_local_.decl.kind = expr;
ffestb_local_.decl.kindt = ffelex_token_use (ft);
return (ffelexHandler) ffestb_decl_typeparams_;
default:
break;
}
if (ffestb_local_.decl.recursive != NULL)
ffelex_token_kill (ffestb_local_.decl.recursive);
if (ffestb_local_.decl.kindt != NULL)
ffelex_token_kill (ffestb_local_.decl.kindt);
if (ffestb_local_.decl.lent != NULL)
ffelex_token_kill (ffestb_local_.decl.lent);
ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
ffestb_local_.decl.badname,
t);
return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
}
/* ffestb_decl_typetype1_ -- "TYPE" OPEN_PAREN
return ffestb_decl_typetype1_; // to lexer
Handle NAME. */
#if FFESTR_F90
static ffelexHandler
ffestb_decl_typetype1_ (ffelexToken t)
{
switch (ffelex_token_type (t))
{
case FFELEX_typeNAME:
ffestb_local_.decl.kindt = ffelex_token_use (t);
return (ffelexHandler) ffestb_decl_typetype2_;
default:
break;
}
if (ffestb_local_.decl.recursive != NULL)
ffelex_token_kill (ffestb_local_.decl.recursive);
ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
ffestb_local_.decl.badname,
t);
return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
}
/* ffestb_decl_typetype2_ -- "TYPE" OPEN_PAREN NAME
return ffestb_decl_typetype2_; // to lexer
Handle CLOSE_PAREN. */
static ffelexHandler
ffestb_decl_typetype2_ (ffelexToken t)
{
switch (ffelex_token_type (t))
{
case FFELEX_typeCLOSE_PAREN:
ffestb_local_.decl.type = FFESTP_typeTYPE;
ffestb_local_.decl.kind = NULL;
ffestb_local_.decl.len = NULL;
ffestb_local_.decl.lent = NULL;
ffelex_set_names (TRUE);
return (ffelexHandler) ffestb_local_.decl.handler;
default:
break;
}
if (ffestb_local_.decl.recursive != NULL)
ffelex_token_kill (ffestb_local_.decl.recursive);
ffelex_token_kill (ffestb_local_.decl.kindt);
ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
ffestb_local_.decl.badname,
t);
return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
}
#endif
/* ffestb_subr_label_list_ -- Collect a tokenlist of labels and close-paren
return ffestb_subr_label_list_; // to lexer after seeing OPEN_PAREN
First token must be a NUMBER. Must be followed by zero or more COMMA
NUMBER pairs. Must then be followed by a CLOSE_PAREN. If all ok, put
the NUMBER tokens in a token list and return via the handler for the
token after CLOSE_PAREN. Else return via
same handler, but with the ok return value set FALSE. */
static ffelexHandler
ffestb_subr_label_list_ (ffelexToken t)
{
if (ffelex_token_type (t) == FFELEX_typeNUMBER)
{
ffestt_tokenlist_append (ffestb_subrargs_.label_list.labels,
ffelex_token_use (t));
return (ffelexHandler) ffestb_subr_label_list_1_;
}
ffestb_subrargs_.label_list.ok = FALSE;
return (ffelexHandler) (*ffestb_subrargs_.label_list.handler) (t);
}
/* ffestb_subr_label_list_1_ -- NUMBER
return ffestb_subr_label_list_1_; // to lexer after seeing NUMBER
The next token must be COMMA, in which case go back to
ffestb_subr_label_list_, or CLOSE_PAREN, in which case set ok to TRUE
and go to the handler. */
static ffelexHandler
ffestb_subr_label_list_1_ (ffelexToken t)
{
switch (ffelex_token_type (t))
{
case FFELEX_typeCOMMA:
return (ffelexHandler) ffestb_subr_label_list_;
case FFELEX_typeCLOSE_PAREN:
ffestb_subrargs_.label_list.ok = TRUE;
return (ffelexHandler) ffestb_subrargs_.label_list.handler;
default:
ffestb_subrargs_.label_list.ok = FALSE;
return (ffelexHandler) (*ffestb_subrargs_.label_list.handler) (t);
}
}
/* ffestb_do -- Parse the DO statement
return ffestb_do; // to lexer
Make sure the statement has a valid form for the DO statement. If it
does, implement the statement. */
ffelexHandler
ffestb_do (ffelexToken t)
{
ffeTokenLength i;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
unsigned const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
unsigned const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
unsigned const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
unsigned const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
unsigned const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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. */
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
unsigned const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
unsigned const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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)
{
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
unsigned const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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)
{
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
unsigned const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
ffestb_local_.data.expr = ffeexpr_convert (expr, ft, t,
FFEINFO_basictypeINTEGER,
FFEINFO_kindtypeINTEGER1,
0,
FFETARGET_charactersizeNONE,
FFEEXPR_contextLET);
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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)
{
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
unsigned const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
unsigned const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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)
{
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
unsigned const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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)
{
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
unsigned const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
unsigned const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
unsigned const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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)
{
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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)
{
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
unsigned const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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_;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
if ((kw != FFESTR_formatP) ||
!ffelex_is_firstnamechar ((unsigned char)*p))
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
{
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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)
{
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
ffelexHandler next;
ffelexToken nt;
ffelexToken ut;
switch (ffelex_token_type (ffesta_tokens[0]))
{
case FFELEX_typeNAME:
if (ffesta_first_kw != FFESTR_firstINCLUDE)
goto bad_0; /* :::::::::::::::::::: */
switch (ffelex_token_type (t))
{
case FFELEX_typeNUMBER:
case FFELEX_typeAPOSTROPHE:
case FFELEX_typeQUOTE:
break;
default:
goto bad_1; /* :::::::::::::::::::: */
}
ffesta_confirmed ();
return (ffelexHandler) (*((ffelexHandler)
ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextINCLUDE,
(ffeexprCallback) ffestb_S3P41_)))
(t);
case FFELEX_typeNAMES:
if (ffesta_first_kw != FFESTR_firstINCLUDE)
goto bad_0; /* :::::::::::::::::::: */
p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlINCLUDE);
switch (ffelex_token_type (t))
{
default:
goto bad_1; /* :::::::::::::::::::: */
case FFELEX_typeAPOSTROPHE:
case FFELEX_typeQUOTE:
break;
}
ffesta_confirmed ();
if (*p == '\0')
return (ffelexHandler) (*((ffelexHandler)
ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextINCLUDE,
(ffeexprCallback) ffestb_S3P41_)))
(t);
if (! ISDIGIT (*p))
goto bad_i; /* :::::::::::::::::::: */
nt = ffelex_token_number_from_names (ffesta_tokens[0], i);
p += ffelex_token_length (nt);
i += ffelex_token_length (nt);
if ((*p != '_') || (++i, *++p != '\0'))
{
ffelex_token_kill (nt);
goto bad_i; /* :::::::::::::::::::: */
}
ut = ffelex_token_uscore_from_names (ffesta_tokens[0], i - 1);
next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs
(ffesta_output_pool, FFEEXPR_contextINCLUDE,
(ffeexprCallback) ffestb_S3P41_)))
(nt);
ffelex_token_kill (nt);
next = (ffelexHandler) (*next) (ut);
ffelex_token_kill (ut);
return (ffelexHandler) (*next) (t);
default:
goto bad_0; /* :::::::::::::::::::: */
}
bad_0: /* :::::::::::::::::::: */
ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INCLUDE", ffesta_tokens[0]);
return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
bad_1: /* :::::::::::::::::::: */
ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INCLUDE", t);
return (ffelexHandler) ffelex_swallow_tokens (t,
(ffelexHandler) ffesta_zero); /* Invalid second token. */
bad_i: /* :::::::::::::::::::: */
ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "INCLUDE", ffesta_tokens[0], i, t);
return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
}
/* ffestb_S3P41_ -- "INCLUDE" [NUMBER "_"] expr
(ffestb_S3P41_) // to expression handler
Make sure the next token is an EOS, but not a SEMICOLON. */
static ffelexHandler
ffestb_S3P41_ (ffelexToken ft, ffebld expr, ffelexToken t)
{
switch (ffelex_token_type (t))
{
case FFELEX_typeEOS:
case FFELEX_typeSEMICOLON:
if (expr == NULL)
break;
if (!ffesta_is_inhibited ())
{
if (ffe_is_pedantic ()
&& ((ffelex_token_type (t) == FFELEX_typeSEMICOLON)
|| ffesta_line_has_semicolons))
{
ffebad_start_msg ("INCLUDE at %0 not the only statement on the source line", FFEBAD_severityWARNING);
ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
ffelex_token_where_column (ffesta_tokens[0]));
ffebad_finish ();
}
ffestc_S3P4 (expr, ft);
}
return (ffelexHandler) ffesta_zero (t);
default:
ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INCLUDE", t);
break;
}
return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
}
/* ffestb_V012 -- Parse the MAP statement
return ffestb_V012; // to lexer
Make sure the statement has a valid form for the MAP statement. If
it does, implement the statement. */
#if FFESTR_VXT
ffelexHandler
ffestb_V012 (ffelexToken t)
{
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
unsigned const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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)
{
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
unsigned const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
unsigned const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
unsigned const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
unsigned const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
unsigned const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
unsigned const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
unsigned const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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)
{
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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)
{
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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)
{
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
unsigned const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
unsigned const char *p;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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);
}
Reference in New Issue Copy Permalink