]> gcc.gnu.org Git - gcc.git/blame - gcc/f/stb.c
git://gcc.gnu.org / gcc.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
cse.c (rtx_cost): Add default case in enumeration switch.
[gcc.git] / gcc / f / stb.c
CommitLineData
5ff904cd
JL		 1/* stb.c -- Implementation File (module.c template V1.0)
2 Copyright (C) 1995, 1996 Free Software Foundation, Inc.
3 Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
4
5This file is part of GNU Fortran.
6
7GNU Fortran is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
9the Free Software Foundation; either version 2, or (at your option)
10any later version.
11
12GNU Fortran is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Fortran; see the file COPYING. If not, write to
19the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
2002111-1307, USA.
21
22 Related Modules:
23 st.c
24
25 Description:
26 Parses the proper form for statements, builds up expression trees for
27 them, but does not actually implement them. Uses ffebad (primarily via
28 ffesta_ffebad_start) to indicate errors in form. In many cases, an invalid
29 statement form indicates another possible statement needs to be looked at
30 by ffest. In a few cases, a valid statement form might not completely
31 determine the nature of the statement, as in REALFUNCTIONA(B), which is
32 a valid form for either the first statement of a function named A taking
33 an argument named B or for the declaration of a real array named FUNCTIONA
34 with an adjustable size of B. A similar (though somewhat easier) choice
35 must be made for the statement-function-def vs. assignment forms, as in
36 the case of FOO(A) = A+2.0.
37
38 A given parser consists of one or more state handlers, the first of which
39 is the initial state, and the last of which (for any given input) returns
40 control to a final state handler (ffesta_zero or ffesta_two, explained
41 below). The functions handling the states for a given parser usually have
42 the same names, differing only in the final number, as in ffestb_foo_
43 (handles the initial state), ffestb_foo_1_, ffestb_foo_2_ (handle
44 subsequent states), although liberties sometimes are taken with the "foo"
45 part either when keywords are clarified into given statements or are
46 transferred into other possible areas. (For example, the type-name
47 states can hop over to _dummy_ functions when the FUNCTION or RECURSIVE
48 keywords are seen, though this kind of thing is kept to a minimum.) Only
49 the names without numbers are exported to the rest of ffest; the others
50 are local (static).
51
52 Each initial state is provided with the first token in ffesta_tokens[0],
53 which will be killed upon return to the final state (ffesta_zero or
54 ffelex_swallow_tokens passed through to ffesta_zero), so while it may
55 be changed to another token, a valid token must be left there to be
56 killed. Also, a "convenient" array of tokens are left in
57 ffesta_tokens[1..FFESTA_tokensMAX]. The initial state of this set of
58 elements is undefined, thus, if tokens are stored here, they must be
59 killed before returning to the final state. Any parser may also use
60 cross-state local variables by sticking a structure containing storage
61 for those variables in the local union ffestb_local_ (unless the union
62 goes on strike). Furthermore, parsers that handle more than one first or
63 second tokens (like _varlist_, which handles EXTERNAL, INTENT, INTRINSIC,
64 OPTIONAL,
65 PUBLIC, or PRIVATE, and _endxyz_, which handles ENDBLOCK, ENDBLOCKDATA,
66 ENDDO, ENDIF, and so on) may expect arguments from ffest in the
67 ffest-wide union ffest_args_, the substructure specific to the parser.
68
69 A parser's responsibility is: to call either ffesta_confirmed or
70 ffest_ffebad_start before returning to the final state; to be the only
71 parser that can possibly call ffesta_confirmed for a given statement;
72 to call ffest_ffebad_start immediately upon recognizing a bad token
73 (specifically one that another statement parser might confirm upon);
74 to call ffestc functions only after calling ffesta_confirmed and only
75 when ffesta_is_inhibited returns FALSE; and to call ffesta_is_inhibited
76 only after calling ffesta_confirmed. Confirm as early as reasonably
77 possible, even when only one ffestc function is called for the statement
78 later on, because early confirmation can enhance the error-reporting
79 capabilities if a subsequent error is detected and this parser isn't
80 the first possibility for the statement.
81
82 To assist the parser, functions like ffesta_ffebad_1t and _1p_ have
83 been provided to make use of ffest_ffebad_start fairly easy.
84
85 Modifications:
86*/
87
88/* Include files. */
89
90#include "proj.h"
91#include <ctype.h>
92#include "stb.h"
93#include "bad.h"
94#include "expr.h"
95#include "lex.h"
96#include "malloc.h"
97#include "src.h"
98#include "sta.h"
99#include "stc.h"
100#include "stp.h"
101#include "str.h"
102
103/* Externals defined here. */
104
105struct _ffestb_args_ ffestb_args;
106
107/* Simple definitions and enumerations. */
108
109#define FFESTB_KILL_EASY_ 1 /* 1 for only one _subr_kill_xyz_ fn. */
110
111/* Internal typedefs. */
112
113union ffestb_subrargs_u_
114 {
115 struct
116 {
117 ffesttTokenList labels; /* Input arg, must not be NULL. */
118 ffelexHandler handler; /* Input arg, call me when done. */
119 bool ok; /* Output arg, TRUE if list ended in
120 CLOSE_PAREN. */
121 }
122 label_list;
123 struct
124 {
125 ffesttDimList dims; /* Input arg, must not be NULL. */
126 ffelexHandler handler; /* Input arg, call me when done. */
127 mallocPool pool; /* Pool to allocate into. */
128 bool ok; /* Output arg, TRUE if list ended in
129 CLOSE_PAREN. */
130 ffeexprContext ctx; /* DIMLIST or DIMLISTCOMMON. */
131#ifdef FFECOM_dimensionsMAX
132 int ndims; /* For backends that really can't have
133 infinite dims. */
134#endif
135 }
136 dim_list;
137 struct
138 {
139 ffesttTokenList args; /* Input arg, must not be NULL. */
140 ffelexHandler handler; /* Input arg, call me when done. */
141 ffelexToken close_paren;/* Output arg if ok, CLOSE_PAREN token. */
142 bool is_subr; /* Input arg, TRUE if list in subr-def
143 context. */
144 bool ok; /* Output arg, TRUE if list ended in
145 CLOSE_PAREN. */
146 bool names; /* Do ffelex_set_names(TRUE) before return. */
147 }
148 name_list;
149 };
150
151union ffestb_local_u_
152 {
153 struct
154 {
155 ffebld expr;
156 }
157 call_stmt;
158 struct
159 {
160 ffebld expr;
161 }
162 go_to;
163 struct
164 {
165 ffebld dest;
166 bool vxtparam; /* If assignment might really be VXT
167 PARAMETER stmt. */
168 }
169 let;
170 struct
171 {
172 ffebld expr;
173 }
174 if_stmt;
175 struct
176 {
177 ffebld expr;
178 }
179 else_stmt;
180 struct
181 {
182 ffebld expr;
183 }
184 dowhile;
185 struct
186 {
187 ffebld var;
188 ffebld start;
189 ffebld end;
190 }
191 do_stmt;
192 struct
193 {
194 bool is_cblock;
195 }
196 R522;
197 struct
198 {
199 ffebld expr;
200 bool started;
201 }
202 parameter;
203 struct
204 {
205 ffesttExprList exprs;
206 bool started;
207 }
208 equivalence;
209 struct
210 {
211 ffebld expr;
212 bool started;
213 }
214 data;
215 struct
216 {
217 ffestrOther kw;
218 }
219 varlist;
220#if FFESTR_F90
221 struct
222 {
223 ffestrOther kw;
224 }
225 type;
226#endif
227 struct
228 {
229 ffelexHandler next;
230 }
231 construct;
232 struct
233 {
234 ffesttFormatList f;
235 ffestpFormatType current; /* What we're currently working on. */
236 ffelexToken t; /* Token of what we're currently working on. */
237 ffesttFormatValue pre;
238 ffesttFormatValue post;
239 ffesttFormatValue dot;
240 ffesttFormatValue exp;
241 bool sign; /* _3_, pos/neg; elsewhere, signed/unsigned. */
242 bool complained; /* If run-time expr seen in nonexec context. */
243 }
244 format;
245#if FFESTR_F90
246 struct
247 {
248 bool started;
249 }
250 moduleprocedure;
251#endif
252 struct
253 {
254 ffebld expr;
255 }
256 selectcase;
257 struct
258 {
259 ffesttCaseList cases;
260 }
261 case_stmt;
262#if FFESTR_F90
263 struct
264 {
265 ffesttExprList exprs;
266 ffebld expr;
267 }
268 heap;
269#endif
270#if FFESTR_F90
271 struct
272 {
273 ffesttExprList exprs;
274 }
275 R624;
276#endif
277#if FFESTR_F90
278 struct
279 {
280 ffestpDefinedOperator operator;
281 bool assignment; /* TRUE for INTERFACE ASSIGNMENT, FALSE for
282 ...OPERATOR. */
283 bool slash; /* TRUE if OPEN_ARRAY, FALSE if OPEN_PAREN. */
284 }
285 interface;
286#endif
287 struct
288 {
289 bool is_cblock;
290 }
291 V014;
292#if FFESTR_VXT
293 struct
294 {
295 bool started;
296 ffebld u;
297 ffebld m;
298 ffebld n;
299 ffebld asv;
300 }
301 V025;
302#endif
303 struct
304 {
305 ffestpBeruIx ix;
306 bool label;
307 bool left;
308 ffeexprContext context;
309 }
310 beru;
311 struct
312 {
313 ffestpCloseIx ix;
314 bool label;
315 bool left;
316 ffeexprContext context;
317 }
318 close;
319 struct
320 {
321 ffestpDeleteIx ix;
322 bool label;
323 bool left;
324 ffeexprContext context;
325 }
326 delete;
327 struct
328 {
329 ffestpDeleteIx ix;
330 bool label;
331 bool left;
332 ffeexprContext context;
333 }
334 find;
335 struct
336 {
337 ffestpInquireIx ix;
338 bool label;
339 bool left;
340 ffeexprContext context;
341 bool may_be_iolength;
342 }
343 inquire;
344 struct
345 {
346 ffestpOpenIx ix;
347 bool label;
348 bool left;
349 ffeexprContext context;
350 }
351 open;
352 struct
353 {
354 ffestpReadIx ix;
355 bool label;
356 bool left;
357 ffeexprContext context;
358 }
359 read;
360 struct
361 {
362 ffestpRewriteIx ix;
363 bool label;
364 bool left;
365 ffeexprContext context;
366 }
367 rewrite;
368 struct
369 {
370 ffestpWriteIx ix;
371 bool label;
372 bool left;
373 ffeexprContext context;
374 }
375 vxtcode;
376 struct
377 {
378 ffestpWriteIx ix;
379 bool label;
380 bool left;
381 ffeexprContext context;
382 }
383 write;
384#if FFESTR_F90
385 struct
386 {
387 bool started;
388 }
389 structure;
390#endif
391 struct
392 {
393 bool started;
394 }
395 common;
396 struct
397 {
398 bool started;
399 }
400 dimension;
401 struct
402 {
403 bool started;
404 }
405 dimlist;
406 struct
407 {
408 char *badname;
409 ffestrFirst first_kw;
410 bool is_subr;
411 }
412 dummy;
413 struct
414 {
415 ffebld kind; /* Kind type parameter, if any. */
416 ffelexToken kindt; /* Kind type first token, if any. */
417 ffebld len; /* Length type parameter, if any. */
418 ffelexToken lent; /* Length type parameter, if any. */
419 ffelexHandler handler;
420 ffelexToken recursive;
421 ffebld expr;
422 ffesttTokenList toklist;/* For ambiguity resolution. */
423 ffesttImpList imps; /* List of IMPLICIT letters. */
424 ffelexHandler imp_handler; /* Call if paren list wasn't letters. */
425 char *badname;
426 ffestrOther kw; /* INTENT(IN/OUT/INOUT). */
427 ffestpType type;
428 bool parameter; /* If PARAMETER attribute seen (governs =expr
429 context). */
430 bool coloncolon; /* If COLONCOLON seen (allows =expr). */
431 bool aster_after; /* "*" seen after, not before,
432 [RECURSIVE]FUNCTIONxyz. */
433 bool empty; /* Ambig function dummy arg list empty so
434 far? */
435 bool imp_started; /* Started IMPLICIT statement already. */
436 bool imp_seen_comma; /* TRUE if next COMMA within parens means not
437 R541. */
438 }
439 decl;
440 struct
441 {
442 bool started;
443 }
444 vxtparam;
445 }; /* Merge with the one in ffestb later. */
446
447/* Private include files. */
448
449
450/* Internal structure definitions. */
451
452
453/* Static objects accessed by functions in this module. */
454
455static union ffestb_subrargs_u_ ffestb_subrargs_;
456static union ffestb_local_u_ ffestb_local_;
457
458/* Static functions (internal). */
459
460static void ffestb_subr_ambig_to_ents_ (void);
461static ffelexHandler ffestb_subr_ambig_nope_ (ffelexToken t);
462static ffelexHandler ffestb_subr_dimlist_ (ffelexToken ft, ffebld expr,
463 ffelexToken t);
464static ffelexHandler ffestb_subr_dimlist_1_ (ffelexToken ft, ffebld expr,
465 ffelexToken t);
466static ffelexHandler ffestb_subr_dimlist_2_ (ffelexToken ft, ffebld expr,
467 ffelexToken t);
468static ffelexHandler ffestb_subr_name_list_ (ffelexToken t);
469static ffelexHandler ffestb_subr_name_list_1_ (ffelexToken t);
470static void ffestb_subr_R1001_append_p_ (void);
471static ffelexHandler ffestb_decl_kindparam_ (ffelexToken t);
472static ffelexHandler ffestb_decl_kindparam_1_ (ffelexToken t);
473static ffelexHandler ffestb_decl_kindparam_2_ (ffelexToken ft, ffebld expr,
474 ffelexToken t);
475static ffelexHandler ffestb_decl_starkind_ (ffelexToken t);
476static ffelexHandler ffestb_decl_starlen_ (ffelexToken t);
477static ffelexHandler ffestb_decl_starlen_1_ (ffelexToken ft, ffebld expr,
478 ffelexToken t);
479static ffelexHandler ffestb_decl_typeparams_ (ffelexToken t);
480static ffelexHandler ffestb_decl_typeparams_1_ (ffelexToken t);
481static ffelexHandler ffestb_decl_typeparams_2_ (ffelexToken ft, ffebld expr,
482 ffelexToken t);
483static ffelexHandler ffestb_decl_typeparams_3_ (ffelexToken ft, ffebld expr,
484 ffelexToken t);
485#if FFESTR_F90
486static ffelexHandler ffestb_decl_typetype1_ (ffelexToken t);
487static ffelexHandler ffestb_decl_typetype2_ (ffelexToken t);
488#endif
489static ffelexHandler ffestb_subr_label_list_ (ffelexToken t);
490static ffelexHandler ffestb_subr_label_list_1_ (ffelexToken t);
491static ffelexHandler ffestb_do1_ (ffelexToken t);
492static ffelexHandler ffestb_do2_ (ffelexToken t);
493static ffelexHandler ffestb_do3_ (ffelexToken t);
494static ffelexHandler ffestb_do4_ (ffelexToken ft, ffebld expr,
495 ffelexToken t);
496static ffelexHandler ffestb_do5_ (ffelexToken t);
497static ffelexHandler ffestb_do6_ (ffelexToken ft, ffebld expr,
498 ffelexToken t);
499static ffelexHandler ffestb_do7_ (ffelexToken ft, ffebld expr,
500 ffelexToken t);
501static ffelexHandler ffestb_do8_ (ffelexToken ft, ffebld expr,
502 ffelexToken t);
503static ffelexHandler ffestb_do9_ (ffelexToken ft, ffebld expr,
504 ffelexToken t);
505static ffelexHandler ffestb_else1_ (ffelexToken t);
506static ffelexHandler ffestb_else2_ (ffelexToken ft, ffebld expr,
507 ffelexToken t);
508static ffelexHandler ffestb_else3_ (ffelexToken t);
509static ffelexHandler ffestb_else4_ (ffelexToken t);
510static ffelexHandler ffestb_else5_ (ffelexToken t);
511static ffelexHandler ffestb_end1_ (ffelexToken t);
512static ffelexHandler ffestb_end2_ (ffelexToken t);
513static ffelexHandler ffestb_end3_ (ffelexToken t);
514static ffelexHandler ffestb_goto1_ (ffelexToken t);
515static ffelexHandler ffestb_goto2_ (ffelexToken t);
516static ffelexHandler ffestb_goto3_ (ffelexToken t);
517static ffelexHandler ffestb_goto4_ (ffelexToken ft, ffebld expr,
518 ffelexToken t);
519static ffelexHandler ffestb_goto5_ (ffelexToken ft, ffebld expr,
520 ffelexToken t);
521static ffelexHandler ffestb_goto6_ (ffelexToken t);
522static ffelexHandler ffestb_goto7_ (ffelexToken t);
523static ffelexHandler ffestb_halt1_ (ffelexToken ft, ffebld expr,
524 ffelexToken t);
525static ffelexHandler ffestb_if1_ (ffelexToken ft, ffebld expr,
526 ffelexToken t);
527static ffelexHandler ffestb_if2_ (ffelexToken t);
528static ffelexHandler ffestb_if3_ (ffelexToken t);
529static ffelexHandler ffestb_let1_ (ffelexToken ft, ffebld expr,
530 ffelexToken t);
531static ffelexHandler ffestb_let2_ (ffelexToken ft, ffebld expr,
532 ffelexToken t);
533#if FFESTR_F90
534static ffelexHandler ffestb_type1_ (ffelexToken t);
535static ffelexHandler ffestb_type2_ (ffelexToken t);
536static ffelexHandler ffestb_type3_ (ffelexToken t);
537static ffelexHandler ffestb_type4_ (ffelexToken t);
538#endif
539#if FFESTR_F90
540static ffelexHandler ffestb_varlist1_ (ffelexToken t);
541static ffelexHandler ffestb_varlist2_ (ffelexToken t);
542static ffelexHandler ffestb_varlist3_ (ffelexToken t);
543static ffelexHandler ffestb_varlist4_ (ffelexToken t);
544#endif
545static ffelexHandler ffestb_varlist5_ (ffelexToken t);
546static ffelexHandler ffestb_varlist6_ (ffelexToken t);
547#if FFESTR_F90
548static ffelexHandler ffestb_where1_ (ffelexToken ft, ffebld expr,
549 ffelexToken t);
550static ffelexHandler ffestb_where2_ (ffelexToken t);
551static ffelexHandler ffestb_where3_ (ffelexToken t);
552#endif
553static ffelexHandler ffestb_R5221_ (ffelexToken t);
554static ffelexHandler ffestb_R5222_ (ffelexToken t);
555static ffelexHandler ffestb_R5223_ (ffelexToken t);
556static ffelexHandler ffestb_R5224_ (ffelexToken t);
557static ffelexHandler ffestb_R5281_ (ffelexToken ft, ffebld expr,
558 ffelexToken t);
559static ffelexHandler ffestb_R5282_ (ffelexToken ft, ffebld expr,
560 ffelexToken t);
561static ffelexHandler ffestb_R5283_ (ffelexToken ft, ffebld expr,
562 ffelexToken t);
563static ffelexHandler ffestb_R5284_ (ffelexToken t);
564static ffelexHandler ffestb_R5371_ (ffelexToken ft, ffebld expr,
565 ffelexToken t);
566static ffelexHandler ffestb_R5372_ (ffelexToken ft, ffebld expr,
567 ffelexToken t);
568static ffelexHandler ffestb_R5373_ (ffelexToken t);
569static ffelexHandler ffestb_R5421_ (ffelexToken t);
570static ffelexHandler ffestb_R5422_ (ffelexToken t);
571static ffelexHandler ffestb_R5423_ (ffelexToken t);
572static ffelexHandler ffestb_R5424_ (ffelexToken t);
573static ffelexHandler ffestb_R5425_ (ffelexToken t);
574static ffelexHandler ffestb_R5441_ (ffelexToken ft, ffebld expr,
575 ffelexToken t);
576static ffelexHandler ffestb_R5442_ (ffelexToken ft, ffebld expr,
577 ffelexToken t);
578static ffelexHandler ffestb_R5443_ (ffelexToken t);
579static ffelexHandler ffestb_R5444_ (ffelexToken t);
580static ffelexHandler ffestb_R8341_ (ffelexToken t);
581static ffelexHandler ffestb_R8351_ (ffelexToken t);
582static ffelexHandler ffestb_R8381_ (ffelexToken t);
583static ffelexHandler ffestb_R8382_ (ffelexToken t);
584static ffelexHandler ffestb_R8383_ (ffelexToken ft, ffebld expr,
585 ffelexToken t);
586static ffelexHandler ffestb_R8401_ (ffelexToken ft, ffebld expr,
587 ffelexToken t);
588static ffelexHandler ffestb_R8402_ (ffelexToken t);
589static ffelexHandler ffestb_R8403_ (ffelexToken t);
590static ffelexHandler ffestb_R8404_ (ffelexToken t);
591static ffelexHandler ffestb_R8405_ (ffelexToken t);
592static ffelexHandler ffestb_R8406_ (ffelexToken t);
593static ffelexHandler ffestb_R8407_ (ffelexToken t);
594static ffelexHandler ffestb_R11021_ (ffelexToken t);
595static ffelexHandler ffestb_R1111_1_ (ffelexToken t);
596static ffelexHandler ffestb_R1111_2_ (ffelexToken t);
597static ffelexHandler ffestb_R12121_ (ffelexToken ft, ffebld expr,
598 ffelexToken t);
599static ffelexHandler ffestb_R12271_ (ffelexToken ft, ffebld expr,
600 ffelexToken t);
601static ffelexHandler ffestb_construct1_ (ffelexToken t);
602static ffelexHandler ffestb_construct2_ (ffelexToken t);
603#if FFESTR_F90
604static ffelexHandler ffestb_heap1_ (ffelexToken ft, ffebld expr,
605 ffelexToken t);
606static ffelexHandler ffestb_heap2_ (ffelexToken t);
607static ffelexHandler ffestb_heap3_ (ffelexToken t);
608static ffelexHandler ffestb_heap4_ (ffelexToken ft, ffebld expr,
609 ffelexToken t);
610static ffelexHandler ffestb_heap5_ (ffelexToken t);
611#endif
612#if FFESTR_F90
613static ffelexHandler ffestb_module1_ (ffelexToken t);
614static ffelexHandler ffestb_module2_ (ffelexToken t);
615static ffelexHandler ffestb_module3_ (ffelexToken t);
616#endif
617static ffelexHandler ffestb_R8091_ (ffelexToken t);
618static ffelexHandler ffestb_R8092_ (ffelexToken ft, ffebld expr,
619 ffelexToken t);
620static ffelexHandler ffestb_R8093_ (ffelexToken t);
621static ffelexHandler ffestb_R8101_ (ffelexToken t);
622static ffelexHandler ffestb_R8102_ (ffelexToken t);
623static ffelexHandler ffestb_R8103_ (ffelexToken ft, ffebld expr,
624 ffelexToken t);
625static ffelexHandler ffestb_R8104_ (ffelexToken ft, ffebld expr,
626 ffelexToken t);
627static ffelexHandler ffestb_R10011_ (ffelexToken t);
628static ffelexHandler ffestb_R10012_ (ffelexToken t);
629static ffelexHandler ffestb_R10013_ (ffelexToken t);
630static ffelexHandler ffestb_R10014_ (ffelexToken t);
631static ffelexHandler ffestb_R10015_ (ffelexToken t);
632static ffelexHandler ffestb_R10016_ (ffelexToken t);
633static ffelexHandler ffestb_R10017_ (ffelexToken t);
634static ffelexHandler ffestb_R10018_ (ffelexToken t);
635static ffelexHandler ffestb_R10019_ (ffelexToken t);
636static ffelexHandler ffestb_R100110_ (ffelexToken t);
637static ffelexHandler ffestb_R100111_ (ffelexToken t);
638static ffelexHandler ffestb_R100112_ (ffelexToken t);
639static ffelexHandler ffestb_R100113_ (ffelexToken t);
640static ffelexHandler ffestb_R100114_ (ffelexToken t);
641static ffelexHandler ffestb_R100115_ (ffelexToken ft, ffebld expr,
642 ffelexToken t);
643static ffelexHandler ffestb_R100116_ (ffelexToken ft, ffebld expr,
644 ffelexToken t);
645static ffelexHandler ffestb_R100117_ (ffelexToken ft, ffebld expr,
646 ffelexToken t);
647static ffelexHandler ffestb_R100118_ (ffelexToken ft, ffebld expr,
648 ffelexToken t);
649#if FFESTR_F90
650static ffelexHandler ffestb_R11071_ (ffelexToken t);
651static ffelexHandler ffestb_R11072_ (ffelexToken t);
652static ffelexHandler ffestb_R11073_ (ffelexToken t);
653static ffelexHandler ffestb_R11074_ (ffelexToken t);
654static ffelexHandler ffestb_R11075_ (ffelexToken t);
655static ffelexHandler ffestb_R11076_ (ffelexToken t);
656static ffelexHandler ffestb_R11077_ (ffelexToken t);
657static ffelexHandler ffestb_R11078_ (ffelexToken t);
658static ffelexHandler ffestb_R11079_ (ffelexToken t);
659static ffelexHandler ffestb_R110710_ (ffelexToken t);
660static ffelexHandler ffestb_R110711_ (ffelexToken t);
661static ffelexHandler ffestb_R110712_ (ffelexToken t);
662#endif
663#if FFESTR_F90
664static ffelexHandler ffestb_R12021_ (ffelexToken t);
665static ffelexHandler ffestb_R12022_ (ffelexToken t);
666static ffelexHandler ffestb_R12023_ (ffelexToken t);
667static ffelexHandler ffestb_R12024_ (ffelexToken t);
668static ffelexHandler ffestb_R12025_ (ffelexToken t);
669static ffelexHandler ffestb_R12026_ (ffelexToken t);
670#endif
671static ffelexHandler ffestb_S3P41_ (ffelexToken ft, ffebld expr,
672 ffelexToken t);
673static ffelexHandler ffestb_V0141_ (ffelexToken t);
674static ffelexHandler ffestb_V0142_ (ffelexToken t);
675static ffelexHandler ffestb_V0143_ (ffelexToken t);
676static ffelexHandler ffestb_V0144_ (ffelexToken t);
677#if FFESTR_VXT
678static ffelexHandler ffestb_V0251_ (ffelexToken t);
679static ffelexHandler ffestb_V0252_ (ffelexToken ft, ffebld expr,
680 ffelexToken t);
681static ffelexHandler ffestb_V0253_ (ffelexToken ft, ffebld expr,
682 ffelexToken t);
683static ffelexHandler ffestb_V0254_ (ffelexToken ft, ffebld expr,
684 ffelexToken t);
685static ffelexHandler ffestb_V0255_ (ffelexToken t);
686static ffelexHandler ffestb_V0256_ (ffelexToken t);
687static ffelexHandler ffestb_V0257_ (ffelexToken ft, ffebld expr,
688 ffelexToken t);
689static ffelexHandler ffestb_V0258_ (ffelexToken t);
690#endif
691#if FFESTB_KILL_EASY_
692static void ffestb_subr_kill_easy_ (ffestpInquireIx max);
693#else
694static void ffestb_subr_kill_accept_ (void);
695static void ffestb_subr_kill_beru_ (void);
696static void ffestb_subr_kill_close_ (void);
697static void ffestb_subr_kill_delete_ (void);
698static void ffestb_subr_kill_find_ (void); /* Not written yet. */
699static void ffestb_subr_kill_inquire_ (void);
700static void ffestb_subr_kill_open_ (void);
701static void ffestb_subr_kill_print_ (void);
702static void ffestb_subr_kill_read_ (void);
703static void ffestb_subr_kill_rewrite_ (void);
704static void ffestb_subr_kill_type_ (void);
705static void ffestb_subr_kill_vxtcode_ (void); /* Not written yet. */
706static void ffestb_subr_kill_write_ (void);
707#endif
708static ffelexHandler ffestb_beru1_ (ffelexToken ft, ffebld expr,
709 ffelexToken t);
710static ffelexHandler ffestb_beru2_ (ffelexToken t);
711static ffelexHandler ffestb_beru3_ (ffelexToken t);
712static ffelexHandler ffestb_beru4_ (ffelexToken ft, ffebld expr,
713 ffelexToken t);
714static ffelexHandler ffestb_beru5_ (ffelexToken t);
715static ffelexHandler ffestb_beru6_ (ffelexToken t);
716static ffelexHandler ffestb_beru7_ (ffelexToken ft, ffebld expr,
717 ffelexToken t);
718static ffelexHandler ffestb_beru8_ (ffelexToken t);
719static ffelexHandler ffestb_beru9_ (ffelexToken t);
720static ffelexHandler ffestb_beru10_ (ffelexToken t);
721#if FFESTR_VXT
722static ffelexHandler ffestb_vxtcode1_ (ffelexToken ft, ffebld expr,
723 ffelexToken t);
724static ffelexHandler ffestb_vxtcode2_ (ffelexToken ft, ffebld expr,
725 ffelexToken t);
726static ffelexHandler ffestb_vxtcode3_ (ffelexToken ft, ffebld expr,
727 ffelexToken t);
728static ffelexHandler ffestb_vxtcode4_ (ffelexToken t);
729static ffelexHandler ffestb_vxtcode5_ (ffelexToken t);
730static ffelexHandler ffestb_vxtcode6_ (ffelexToken ft, ffebld expr,
731 ffelexToken t);
732static ffelexHandler ffestb_vxtcode7_ (ffelexToken t);
733static ffelexHandler ffestb_vxtcode8_ (ffelexToken t);
734static ffelexHandler ffestb_vxtcode9_ (ffelexToken t);
735static ffelexHandler ffestb_vxtcode10_ (ffelexToken ft, ffebld expr,
736 ffelexToken t);
737#endif
738static ffelexHandler ffestb_R9041_ (ffelexToken t);
739static ffelexHandler ffestb_R9042_ (ffelexToken t);
740static ffelexHandler ffestb_R9043_ (ffelexToken ft, ffebld expr,
741 ffelexToken t);
742static ffelexHandler ffestb_R9044_ (ffelexToken t);
743static ffelexHandler ffestb_R9045_ (ffelexToken t);
744static ffelexHandler ffestb_R9046_ (ffelexToken ft, ffebld expr,
745 ffelexToken t);
746static ffelexHandler ffestb_R9047_ (ffelexToken t);
747static ffelexHandler ffestb_R9048_ (ffelexToken t);
748static ffelexHandler ffestb_R9049_ (ffelexToken t);
749static ffelexHandler ffestb_R9071_ (ffelexToken t);
750static ffelexHandler ffestb_R9072_ (ffelexToken t);
751static ffelexHandler ffestb_R9073_ (ffelexToken ft, ffebld expr,
752 ffelexToken t);
753static ffelexHandler ffestb_R9074_ (ffelexToken t);
754static ffelexHandler ffestb_R9075_ (ffelexToken t);
755static ffelexHandler ffestb_R9076_ (ffelexToken ft, ffebld expr,
756 ffelexToken t);
757static ffelexHandler ffestb_R9077_ (ffelexToken t);
758static ffelexHandler ffestb_R9078_ (ffelexToken t);
759static ffelexHandler ffestb_R9079_ (ffelexToken t);
760static ffelexHandler ffestb_R9091_ (ffelexToken ft, ffebld expr,
761 ffelexToken t);
762static ffelexHandler ffestb_R9092_ (ffelexToken t);
763static ffelexHandler ffestb_R9093_ (ffelexToken t);
764static ffelexHandler ffestb_R9094_ (ffelexToken ft, ffebld expr,
765 ffelexToken t);
766static ffelexHandler ffestb_R9095_ (ffelexToken t);
767static ffelexHandler ffestb_R9096_ (ffelexToken t);
768static ffelexHandler ffestb_R9097_ (ffelexToken ft, ffebld expr,
769 ffelexToken t);
770static ffelexHandler ffestb_R9098_ (ffelexToken t);
771static ffelexHandler ffestb_R9099_ (ffelexToken t);
772static ffelexHandler ffestb_R90910_ (ffelexToken ft, ffebld expr,
773 ffelexToken t);
774static ffelexHandler ffestb_R90911_ (ffelexToken t);
775static ffelexHandler ffestb_R90912_ (ffelexToken t);
776static ffelexHandler ffestb_R90913_ (ffelexToken t);
777static ffelexHandler ffestb_R90914_ (ffelexToken ft, ffebld expr,
778 ffelexToken t);
779static ffelexHandler ffestb_R90915_ (ffelexToken ft, ffebld expr,
780 ffelexToken t);
781static ffelexHandler ffestb_R9101_ (ffelexToken t);
782static ffelexHandler ffestb_R9102_ (ffelexToken t);
783static ffelexHandler ffestb_R9103_ (ffelexToken ft, ffebld expr,
784 ffelexToken t);
785static ffelexHandler ffestb_R9104_ (ffelexToken t);
786static ffelexHandler ffestb_R9105_ (ffelexToken t);
787static ffelexHandler ffestb_R9106_ (ffelexToken ft, ffebld expr,
788 ffelexToken t);
789static ffelexHandler ffestb_R9107_ (ffelexToken t);
790static ffelexHandler ffestb_R9108_ (ffelexToken t);
791static ffelexHandler ffestb_R9109_ (ffelexToken ft, ffebld expr,
792 ffelexToken t);
793static ffelexHandler ffestb_R91010_ (ffelexToken t);
794static ffelexHandler ffestb_R91011_ (ffelexToken t);
795static ffelexHandler ffestb_R91012_ (ffelexToken t);
796static ffelexHandler ffestb_R91013_ (ffelexToken ft, ffebld expr,
797 ffelexToken t);
798static ffelexHandler ffestb_R91014_ (ffelexToken ft, ffebld expr,
799 ffelexToken t);
800static ffelexHandler ffestb_R9111_ (ffelexToken ft, ffebld expr,
801 ffelexToken t);
802static ffelexHandler ffestb_R9112_ (ffelexToken ft, ffebld expr,
803 ffelexToken t);
804static ffelexHandler ffestb_R9231_ (ffelexToken t);
805static ffelexHandler ffestb_R9232_ (ffelexToken t);
806static ffelexHandler ffestb_R9233_ (ffelexToken ft, ffebld expr,
807 ffelexToken t);
808static ffelexHandler ffestb_R9234_ (ffelexToken t);
809static ffelexHandler ffestb_R9235_ (ffelexToken t);
810static ffelexHandler ffestb_R9236_ (ffelexToken ft, ffebld expr,
811 ffelexToken t);
812static ffelexHandler ffestb_R9237_ (ffelexToken t);
813static ffelexHandler ffestb_R9238_ (ffelexToken t);
814static ffelexHandler ffestb_R9239_ (ffelexToken t);
815static ffelexHandler ffestb_R92310_ (ffelexToken t);
816static ffelexHandler ffestb_R92311_ (ffelexToken ft, ffebld expr,
817 ffelexToken t);
818#if FFESTR_VXT
819static ffelexHandler ffestb_V0181_ (ffelexToken t);
820static ffelexHandler ffestb_V0182_ (ffelexToken t);
821static ffelexHandler ffestb_V0183_ (ffelexToken ft, ffebld expr,
822 ffelexToken t);
823static ffelexHandler ffestb_V0184_ (ffelexToken t);
824static ffelexHandler ffestb_V0185_ (ffelexToken t);
825static ffelexHandler ffestb_V0186_ (ffelexToken ft, ffebld expr,
826 ffelexToken t);
827static ffelexHandler ffestb_V0187_ (ffelexToken t);
828static ffelexHandler ffestb_V0188_ (ffelexToken t);
829static ffelexHandler ffestb_V0189_ (ffelexToken ft, ffebld expr,
830 ffelexToken t);
831static ffelexHandler ffestb_V01810_ (ffelexToken t);
832static ffelexHandler ffestb_V01811_ (ffelexToken t);
833static ffelexHandler ffestb_V01812_ (ffelexToken t);
834static ffelexHandler ffestb_V01813_ (ffelexToken ft, ffebld expr,
835 ffelexToken t);
836static ffelexHandler ffestb_V0191_ (ffelexToken ft, ffebld expr,
837 ffelexToken t);
838static ffelexHandler ffestb_V0192_ (ffelexToken ft, ffebld expr,
839 ffelexToken t);
840#endif
841static ffelexHandler ffestb_V0201_ (ffelexToken ft, ffebld expr,
842 ffelexToken t);
843static ffelexHandler ffestb_V0202_ (ffelexToken ft, ffebld expr,
844 ffelexToken t);
845#if FFESTR_VXT
846static ffelexHandler ffestb_V0211_ (ffelexToken t);
847static ffelexHandler ffestb_V0212_ (ffelexToken t);
848static ffelexHandler ffestb_V0213_ (ffelexToken ft, ffebld expr,
849 ffelexToken t);
850static ffelexHandler ffestb_V0214_ (ffelexToken t);
851static ffelexHandler ffestb_V0215_ (ffelexToken t);
852static ffelexHandler ffestb_V0216_ (ffelexToken ft, ffebld expr,
853 ffelexToken t);
854static ffelexHandler ffestb_V0217_ (ffelexToken t);
855static ffelexHandler ffestb_V0218_ (ffelexToken t);
856static ffelexHandler ffestb_V0219_ (ffelexToken t);
857static ffelexHandler ffestb_V0261_ (ffelexToken t);
858static ffelexHandler ffestb_V0262_ (ffelexToken t);
859static ffelexHandler ffestb_V0263_ (ffelexToken ft, ffebld expr,
860 ffelexToken t);
861static ffelexHandler ffestb_V0264_ (ffelexToken t);
862static ffelexHandler ffestb_V0265_ (ffelexToken t);
863static ffelexHandler ffestb_V0266_ (ffelexToken ft, ffebld expr,
864 ffelexToken t);
865static ffelexHandler ffestb_V0267_ (ffelexToken t);
866static ffelexHandler ffestb_V0268_ (ffelexToken t);
867static ffelexHandler ffestb_V0269_ (ffelexToken t);
868#endif
869#if FFESTR_F90
870static ffelexHandler ffestb_dimlist1_ (ffelexToken t);
871static ffelexHandler ffestb_dimlist2_ (ffelexToken t);
872static ffelexHandler ffestb_dimlist3_ (ffelexToken t);
873static ffelexHandler ffestb_dimlist4_ (ffelexToken t);
874#endif
875static ffelexHandler ffestb_dummy1_ (ffelexToken t);
876static ffelexHandler ffestb_dummy2_ (ffelexToken t);
877static ffelexHandler ffestb_R5241_ (ffelexToken t);
878static ffelexHandler ffestb_R5242_ (ffelexToken t);
879static ffelexHandler ffestb_R5243_ (ffelexToken t);
880static ffelexHandler ffestb_R5244_ (ffelexToken t);
881static ffelexHandler ffestb_R5471_ (ffelexToken t);
882static ffelexHandler ffestb_R5472_ (ffelexToken t);
883static ffelexHandler ffestb_R5473_ (ffelexToken t);
884static ffelexHandler ffestb_R5474_ (ffelexToken t);
885static ffelexHandler ffestb_R5475_ (ffelexToken t);
886static ffelexHandler ffestb_R5476_ (ffelexToken t);
887static ffelexHandler ffestb_R5477_ (ffelexToken t);
888#if FFESTR_F90
889static ffelexHandler ffestb_R6241_ (ffelexToken ft, ffebld expr,
890 ffelexToken t);
891static ffelexHandler ffestb_R6242_ (ffelexToken t);
892#endif
893static ffelexHandler ffestb_R12291_ (ffelexToken t);
894static ffelexHandler ffestb_R12292_ (ffelexToken ft, ffebld expr,
895 ffelexToken t);
896static ffelexHandler ffestb_decl_chartype1_ (ffelexToken t);
897#if FFESTR_F90
898static ffelexHandler ffestb_decl_recursive1_ (ffelexToken t);
899static ffelexHandler ffestb_decl_recursive2_ (ffelexToken t);
900static ffelexHandler ffestb_decl_recursive3_ (ffelexToken t);
901static ffelexHandler ffestb_decl_recursive4_ (ffelexToken t);
902#endif
903static ffelexHandler ffestb_decl_attrs_ (ffelexToken t);
904static ffelexHandler ffestb_decl_attrs_1_ (ffelexToken t);
905static ffelexHandler ffestb_decl_attrs_2_ (ffelexToken t);
906#if FFESTR_F90
907static ffelexHandler ffestb_decl_attrs_3_ (ffelexToken t);
908static ffelexHandler ffestb_decl_attrs_4_ (ffelexToken t);
909static ffelexHandler ffestb_decl_attrs_5_ (ffelexToken t);
910static ffelexHandler ffestb_decl_attrs_6_ (ffelexToken t);
911#endif
912static ffelexHandler ffestb_decl_attrs_7_ (ffelexToken t);
913static ffelexHandler ffestb_decl_attrsp_ (ffelexToken t);
914static ffelexHandler ffestb_decl_ents_ (ffelexToken t);
915static ffelexHandler ffestb_decl_ents_1_ (ffelexToken t);
916static ffelexHandler ffestb_decl_ents_2_ (ffelexToken t);
917static ffelexHandler ffestb_decl_ents_3_ (ffelexToken t);
918static ffelexHandler ffestb_decl_ents_4_ (ffelexToken t);
919static ffelexHandler ffestb_decl_ents_5_ (ffelexToken t);
920static ffelexHandler ffestb_decl_ents_6_ (ffelexToken ft, ffebld expr,
921 ffelexToken t);
922static ffelexHandler ffestb_decl_ents_7_ (ffelexToken t);
923static ffelexHandler ffestb_decl_ents_8_ (ffelexToken ft, ffebld expr,
924 ffelexToken t);
925static ffelexHandler ffestb_decl_ents_9_ (ffelexToken ft, ffebld expr,
926 ffelexToken t);
927static ffelexHandler ffestb_decl_ents_10_ (ffelexToken ft, ffebld expr,
928 ffelexToken t);
929static ffelexHandler ffestb_decl_ents_11_ (ffelexToken t);
930static ffelexHandler ffestb_decl_entsp_ (ffelexToken t);
931static ffelexHandler ffestb_decl_entsp_1_ (ffelexToken t);
932static ffelexHandler ffestb_decl_entsp_2_ (ffelexToken t);
933static ffelexHandler ffestb_decl_entsp_3_ (ffelexToken t);
934static ffelexHandler ffestb_decl_entsp_4_ (ffelexToken ft, ffebld expr,
935 ffelexToken t);
936static ffelexHandler ffestb_decl_entsp_5_ (ffelexToken t);
937static ffelexHandler ffestb_decl_entsp_6_ (ffelexToken t);
938static ffelexHandler ffestb_decl_entsp_7_ (ffelexToken t);
939static ffelexHandler ffestb_decl_entsp_8_ (ffelexToken t);
940#if FFESTR_F90
941static ffelexHandler ffestb_decl_func_ (ffelexToken t);
942#endif
943static ffelexHandler ffestb_decl_funcname_ (ffelexToken t);
944static ffelexHandler ffestb_decl_funcname_1_ (ffelexToken t);
945static ffelexHandler ffestb_decl_funcname_2_ (ffelexToken t);
946static ffelexHandler ffestb_decl_funcname_3_ (ffelexToken ft, ffebld expr,
947 ffelexToken t);
948static ffelexHandler ffestb_decl_funcname_4_ (ffelexToken t);
949static ffelexHandler ffestb_decl_funcname_5_ (ffelexToken t);
950static ffelexHandler ffestb_decl_funcname_6_ (ffelexToken t);
951static ffelexHandler ffestb_decl_funcname_7_ (ffelexToken t);
952static ffelexHandler ffestb_decl_funcname_8_ (ffelexToken t);
953static ffelexHandler ffestb_decl_funcname_9_ (ffelexToken t);
954#if FFESTR_VXT
955static ffelexHandler ffestb_V0031_ (ffelexToken t);
956static ffelexHandler ffestb_V0032_ (ffelexToken t);
957static ffelexHandler ffestb_V0033_ (ffelexToken t);
958static ffelexHandler ffestb_V0034_ (ffelexToken t);
959static ffelexHandler ffestb_V0035_ (ffelexToken t);
960static ffelexHandler ffestb_V0036_ (ffelexToken t);
961static ffelexHandler ffestb_V0161_ (ffelexToken t);
962static ffelexHandler ffestb_V0162_ (ffelexToken t);
963static ffelexHandler ffestb_V0163_ (ffelexToken t);
964static ffelexHandler ffestb_V0164_ (ffelexToken t);
965static ffelexHandler ffestb_V0165_ (ffelexToken t);
966static ffelexHandler ffestb_V0166_ (ffelexToken t);
967#endif
968static ffelexHandler ffestb_V0271_ (ffelexToken t);
969static ffelexHandler ffestb_V0272_ (ffelexToken ft, ffebld expr,
970 ffelexToken t);
971static ffelexHandler ffestb_V0273_ (ffelexToken t);
972static ffelexHandler ffestb_decl_R5391_ (ffelexToken t);
973static ffelexHandler ffestb_decl_R5392_ (ffelexToken t);
974#if FFESTR_F90
975static ffelexHandler ffestb_decl_R5393_ (ffelexToken t);
976#endif
977static ffelexHandler ffestb_decl_R5394_ (ffelexToken t);
978static ffelexHandler ffestb_decl_R5395_ (ffelexToken t);
979static ffelexHandler ffestb_decl_R539letters_ (ffelexToken t);
980static ffelexHandler ffestb_decl_R539letters_1_ (ffelexToken t);
981static ffelexHandler ffestb_decl_R539letters_2_ (ffelexToken t);
982static ffelexHandler ffestb_decl_R539letters_3_ (ffelexToken t);
983static ffelexHandler ffestb_decl_R539letters_4_ (ffelexToken t);
984static ffelexHandler ffestb_decl_R539letters_5_ (ffelexToken t);
985static ffelexHandler ffestb_decl_R539maybe_ (ffelexToken t);
986static ffelexHandler ffestb_decl_R539maybe_1_ (ffelexToken t);
987static ffelexHandler ffestb_decl_R539maybe_2_ (ffelexToken t);
988static ffelexHandler ffestb_decl_R539maybe_3_ (ffelexToken t);
989static ffelexHandler ffestb_decl_R539maybe_4_ (ffelexToken t);
990static ffelexHandler ffestb_decl_R539maybe_5_ (ffelexToken t);
991
992/* Internal macros. */
993
994#if FFESTB_KILL_EASY_
995#define ffestb_subr_kill_accept_() \
996 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_acceptix)
997#define ffestb_subr_kill_beru_() \
998 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_beruix)
999#define ffestb_subr_kill_close_() \
1000 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_closeix)
1001#define ffestb_subr_kill_delete_() \
1002 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_deleteix)
1003#define ffestb_subr_kill_find_() \
1004 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_findix)
1005#define ffestb_subr_kill_inquire_() \
1006 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_inquireix)
1007#define ffestb_subr_kill_open_() \
1008 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_openix)
1009#define ffestb_subr_kill_print_() \
1010 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_printix)
1011#define ffestb_subr_kill_read_() \
1012 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_readix)
1013#define ffestb_subr_kill_rewrite_() \
1014 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_rewriteix)
1015#define ffestb_subr_kill_type_() \
1016 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_typeix)
1017#define ffestb_subr_kill_vxtcode_() \
1018 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_vxtcodeix)
1019#define ffestb_subr_kill_write_() \
1020 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_writeix)
1021#endif
1022\f
1023/* ffestb_subr_ambig_nope_ -- Cleans up and aborts ambig w/o confirming
1024
1025 ffestb_subr_ambig_nope_();
1026
1027 Switch from ambiguity handling in _entsp_ functions to handling entities
1028 in _ents_ (perform housekeeping tasks). */
1029
1030static ffelexHandler
1031ffestb_subr_ambig_nope_ (ffelexToken t)
1032{
1033 if (ffestb_local_.decl.recursive != NULL)
1034 ffelex_token_kill (ffestb_local_.decl.recursive);
1035 if (ffestb_local_.decl.kindt != NULL)
1036 ffelex_token_kill (ffestb_local_.decl.kindt);
1037 if (ffestb_local_.decl.lent != NULL)
1038 ffelex_token_kill (ffestb_local_.decl.lent);
1039 ffelex_token_kill (ffesta_tokens[1]);
1040 ffelex_token_kill (ffesta_tokens[2]);
1041 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
1042 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
1043 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1044}
1045
1046/* ffestb_subr_ambig_to_ents_ -- Switches from ambiguity to entity decl
1047
1048 ffestb_subr_ambig_to_ents_();
1049
1050 Switch from ambiguity handling in _entsp_ functions to handling entities
1051 in _ents_ (perform housekeeping tasks). */
1052
1053static void
1054ffestb_subr_ambig_to_ents_ ()
1055{
1056 ffelexToken nt;
1057
1058 nt = ffelex_token_name_from_names (ffesta_tokens[1], 0, 0);
1059 ffelex_token_kill (ffesta_tokens[1]);
1060 ffelex_token_kill (ffesta_tokens[2]);
1061 ffesta_tokens[1] = nt;
1062 if (ffestb_local_.decl.recursive != NULL)
1063 ffelex_token_kill (ffestb_local_.decl.recursive);
1064 if (!ffestb_local_.decl.aster_after)
1065 {
1066 if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
1067 {
1068 if (!ffesta_is_inhibited ())
1069 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
1070 ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
1071 ffestb_local_.decl.len, ffestb_local_.decl.lent);
1072 if (ffestb_local_.decl.kindt != NULL)
1073 {
1074 ffelex_token_kill (ffestb_local_.decl.kindt);
1075 ffestb_local_.decl.kind = NULL;
1076 ffestb_local_.decl.kindt = NULL;
1077 }
1078 if (ffestb_local_.decl.lent != NULL)
1079 {
1080 ffelex_token_kill (ffestb_local_.decl.lent);
1081 ffestb_local_.decl.len = NULL;
1082 ffestb_local_.decl.lent = NULL;
1083 }
1084 }
1085 else
1086 {
1087 if (!ffesta_is_inhibited ())
1088 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
1089 ffestb_local_.decl.kind, ffestb_local_.decl.kindt, NULL,
1090 NULL);
1091 if (ffestb_local_.decl.kindt != NULL)
1092 {
1093 ffelex_token_kill (ffestb_local_.decl.kindt);
1094 ffestb_local_.decl.kind = NULL;
1095 ffestb_local_.decl.kindt = NULL;
1096 }
1097 }
1098 return;
1099 }
1100 if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
1101 {
1102 if (!ffesta_is_inhibited ())
1103 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
1104 ffestb_local_.decl.kind, ffestb_local_.decl.kindt, NULL, NULL);
1105 if (ffestb_local_.decl.kindt != NULL)
1106 {
1107 ffelex_token_kill (ffestb_local_.decl.kindt);
1108 ffestb_local_.decl.kind = NULL;
1109 ffestb_local_.decl.kindt = NULL;
1110 }
1111 }
1112 else if (!ffesta_is_inhibited ())
1113 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
1114 NULL, NULL, NULL, NULL);
1115 /* NAME/NAMES token already in ffesta_tokens[1]. */
1116}
1117
1118/* ffestb_subr_dimlist_ -- OPEN_PAREN expr
1119
1120 (ffestb_subr_dimlist_) // to expression handler
1121
1122 Deal with a dimension list.
1123
1124 19-Dec-90 JCB 1.1
1125 Detect too many dimensions if backend wants it. */
1126
1127static ffelexHandler
1128ffestb_subr_dimlist_ (ffelexToken ft, ffebld expr, ffelexToken t)
1129{
1130 switch (ffelex_token_type (t))
1131 {
1132 case FFELEX_typeCLOSE_PAREN:
1133 if (expr == NULL)
1134 break;
1135#ifdef FFECOM_dimensionsMAX
1136 if (ffestb_subrargs_.dim_list.ndims++ == FFECOM_dimensionsMAX)
1137 {
1138 ffesta_ffebad_1t (FFEBAD_TOO_MANY_DIMS, ft);
1139 ffestb_subrargs_.dim_list.ok = TRUE; /* Not a parse error, really. */
1140 return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
1141 }
1142#endif
1143 ffestt_dimlist_append (ffestb_subrargs_.dim_list.dims, NULL, expr,
1144 ffelex_token_use (t));
1145 ffestb_subrargs_.dim_list.ok = TRUE;
1146 return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
1147
1148 case FFELEX_typeCOMMA:
1149 if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
1150 break;
1151#ifdef FFECOM_dimensionsMAX
1152 if (ffestb_subrargs_.dim_list.ndims++ == FFECOM_dimensionsMAX)
1153 {
1154 ffesta_ffebad_1t (FFEBAD_TOO_MANY_DIMS, ft);
1155 return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
1156 ffestb_subrargs_.dim_list.ctx,
1157 (ffeexprCallback) ffestb_subr_dimlist_2_);
1158 }
1159#endif
1160 ffestt_dimlist_append (ffestb_subrargs_.dim_list.dims, NULL, expr,
1161 ffelex_token_use (t));
1162 return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
1163 ffestb_subrargs_.dim_list.ctx,
1164 (ffeexprCallback) ffestb_subr_dimlist_);
1165
1166 case FFELEX_typeCOLON:
1167 if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
1168 break;
1169#ifdef FFECOM_dimensionsMAX
1170 if (ffestb_subrargs_.dim_list.ndims++ == FFECOM_dimensionsMAX)
1171 {
1172 ffesta_ffebad_1t (FFEBAD_TOO_MANY_DIMS, ft);
1173 return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
1174 ffestb_subrargs_.dim_list.ctx,
1175 (ffeexprCallback) ffestb_subr_dimlist_2_);
1176 }
1177#endif
1178 ffestt_dimlist_append (ffestb_subrargs_.dim_list.dims, expr, NULL,
1179 ffelex_token_use (t)); /* NULL second expr for
1180 now, just plug in. */
1181 return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
1182 ffestb_subrargs_.dim_list.ctx,
1183 (ffeexprCallback) ffestb_subr_dimlist_1_);
1184
1185 default:
1186 break;
1187 }
1188
1189 ffestb_subrargs_.dim_list.ok = FALSE;
1190 return (ffelexHandler) ffestb_subrargs_.dim_list.handler (t);
1191}
1192
1193/* ffestb_subr_dimlist_1_ -- OPEN_PAREN expr COLON expr
1194
1195 (ffestb_subr_dimlist_1_) // to expression handler
1196
1197 Get the upper bound. */
1198
1199static ffelexHandler
1200ffestb_subr_dimlist_1_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
1201{
1202 switch (ffelex_token_type (t))
1203 {
1204 case FFELEX_typeCLOSE_PAREN:
1205 ffestb_subrargs_.dim_list.dims->previous->upper = expr;
1206 ffestb_subrargs_.dim_list.ok = TRUE;
1207 return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
1208
1209 case FFELEX_typeCOMMA:
1210 if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
1211 break;
1212 ffestb_subrargs_.dim_list.dims->previous->upper = expr;
1213 return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
1214 ffestb_subrargs_.dim_list.ctx, (ffeexprCallback) ffestb_subr_dimlist_);
1215
1216 default:
1217 break;
1218 }
1219
1220 ffestb_subrargs_.dim_list.ok = FALSE;
1221 return (ffelexHandler) ffestb_subrargs_.dim_list.handler (t);
1222}
1223
1224/* ffestb_subr_dimlist_2_ -- OPEN_PAREN too-many-dim-exprs
1225
1226 (ffestb_subr_dimlist_2_) // to expression handler
1227
1228 Get the upper bound. */
1229
1230static ffelexHandler
1231ffestb_subr_dimlist_2_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
1232{
1233 switch (ffelex_token_type (t))
1234 {
1235 case FFELEX_typeCLOSE_PAREN:
1236 ffestb_subrargs_.dim_list.ok = TRUE; /* Not a parse error, really. */
1237 return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
1238
1239 case FFELEX_typeCOMMA:
1240 case FFELEX_typeCOLON:
1241 if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
1242 break;
1243 return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
1244 ffestb_subrargs_.dim_list.ctx,
1245 (ffeexprCallback) ffestb_subr_dimlist_2_);
1246
1247 default:
1248 break;
1249 }
1250
1251 ffestb_subrargs_.dim_list.ok = FALSE;
1252 return (ffelexHandler) ffestb_subrargs_.dim_list.handler (t);
1253}
1254
1255/* ffestb_subr_name_list_ -- Collect a list of name args and close-paren
1256
1257 return ffestb_subr_name_list_; // to lexer after seeing OPEN_PAREN
1258
1259 This implements R1224 in the Fortran 90 spec. The arg list may be
1260 empty, or be a comma-separated list (an optional trailing comma currently
1261 results in a warning but no other effect) of arguments. For functions,
1262 however, "*" is invalid (we implement dummy-arg-name, rather than R1224
1263 dummy-arg, which itself is either dummy-arg-name or "*"). */
1264
1265static ffelexHandler
1266ffestb_subr_name_list_ (ffelexToken t)
1267{
1268 switch (ffelex_token_type (t))
1269 {
1270 case FFELEX_typeCLOSE_PAREN:
1271 if (ffestt_tokenlist_count (ffestb_subrargs_.name_list.args) != 0)
1272 { /* Trailing comma, warn. */
1273 ffebad_start (FFEBAD_TRAILING_COMMA);
1274 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
1275 ffebad_finish ();
1276 }
1277 ffestb_subrargs_.name_list.ok = TRUE;
1278 ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
1279 if (ffestb_subrargs_.name_list.names)
1280 ffelex_set_names (TRUE);
1281 return (ffelexHandler) ffestb_subrargs_.name_list.handler;
1282
1283 case FFELEX_typeASTERISK:
1284 if (!ffestb_subrargs_.name_list.is_subr)
1285 break;
1286
1287 case FFELEX_typeNAME:
1288 ffestt_tokenlist_append (ffestb_subrargs_.name_list.args,
1289 ffelex_token_use (t));
1290 return (ffelexHandler) ffestb_subr_name_list_1_;
1291
1292 default:
1293 break;
1294 }
1295
1296 ffestb_subrargs_.name_list.ok = FALSE;
1297 ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
1298 if (ffestb_subrargs_.name_list.names)
1299 ffelex_set_names (TRUE);
1300 return (ffelexHandler) (*ffestb_subrargs_.name_list.handler) (t);
1301}
1302
1303/* ffestb_subr_name_list_1_ -- NAME or ASTERISK
1304
1305 return ffestb_subr_name_list_1_; // to lexer
1306
1307 The next token must be COMMA or CLOSE_PAREN, either way go to original
1308 state, but only after adding the appropriate name list item. */
1309
1310static ffelexHandler
1311ffestb_subr_name_list_1_ (ffelexToken t)
1312{
1313 switch (ffelex_token_type (t))
1314 {
1315 case FFELEX_typeCOMMA:
1316 return (ffelexHandler) ffestb_subr_name_list_;
1317
1318 case FFELEX_typeCLOSE_PAREN:
1319 ffestb_subrargs_.name_list.ok = TRUE;
1320 ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
1321 if (ffestb_subrargs_.name_list.names)
1322 ffelex_set_names (TRUE);
1323 return (ffelexHandler) ffestb_subrargs_.name_list.handler;
1324
1325 default:
1326 ffestb_subrargs_.name_list.ok = FALSE;
1327 ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
1328 if (ffestb_subrargs_.name_list.names)
1329 ffelex_set_names (TRUE);
1330 return (ffelexHandler) (*ffestb_subrargs_.name_list.handler) (t);
1331 }
1332}
1333
1334static void
1335ffestb_subr_R1001_append_p_ (void)
1336{
1337 ffesttFormatList f;
1338
1339 if (!ffestb_local_.format.pre.present)
1340 {
1341 ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_P_SPEC, ffestb_local_.format.t);
1342 ffelex_token_kill (ffestb_local_.format.t);
1343 return;
1344 }
1345
1346 f = ffestt_formatlist_append (ffestb_local_.format.f);
1347 f->type = FFESTP_formattypeP;
1348 f->t = ffestb_local_.format.t;
1349 f->u.R1010.val = ffestb_local_.format.pre;
1350}
1351
1352/* ffestb_decl_kindparam_ -- "type" OPEN_PAREN
1353
1354 return ffestb_decl_kindparam_; // to lexer
1355
1356 Handle "[KIND=]expr)". */
1357
1358static ffelexHandler
1359ffestb_decl_kindparam_ (ffelexToken t)
1360{
1361 switch (ffelex_token_type (t))
1362 {
1363 case FFELEX_typeNAME:
1364 ffesta_tokens[1] = ffelex_token_use (t);
1365 return (ffelexHandler) ffestb_decl_kindparam_1_;
1366
1367 default:
1368 return (ffelexHandler) (*((ffelexHandler)
1369 ffeexpr_rhs (ffesta_output_pool,
1370 FFEEXPR_contextKINDTYPE,
1371 (ffeexprCallback) ffestb_decl_kindparam_2_)))
1372 (t);
1373 }
1374}
1375
1376/* ffestb_decl_kindparam_1_ -- "type" OPEN_PAREN NAME
1377
1378 return ffestb_decl_kindparam_1_; // to lexer
1379
1380 Handle "[KIND=]expr)". */
1381
1382static ffelexHandler
1383ffestb_decl_kindparam_1_ (ffelexToken t)
1384{
1385 ffelexHandler next;
1386 ffelexToken nt;
1387
1388 switch (ffelex_token_type (t))
1389 {
1390 case FFELEX_typeEQUALS:
1391 ffesta_confirmed ();
1392 if (ffestr_other (ffesta_tokens[1]) != FFESTR_otherKIND)
1393 break;
1394 ffelex_token_kill (ffesta_tokens[1]);
1395 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
1396 FFEEXPR_contextKINDTYPE, (ffeexprCallback) ffestb_decl_kindparam_2_);
1397
1398 default:
1399 nt = ffesta_tokens[1];
1400 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
1401 FFEEXPR_contextKINDTYPE, (ffeexprCallback) ffestb_decl_kindparam_2_)))
1402 (nt);
1403 ffelex_token_kill (nt);
1404 return (ffelexHandler) (*next) (t);
1405 }
1406
1407 if (ffestb_local_.decl.recursive != NULL)
1408 ffelex_token_kill (ffestb_local_.decl.recursive);
1409 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1410 ffestb_local_.decl.badname,
1411 ffesta_tokens[1]);
1412 ffelex_token_kill (ffesta_tokens[1]);
1413 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1414}
1415
1416/* ffestb_decl_kindparam_2_ -- "type" OPEN_PAREN ["KIND="] expr
1417
1418 (ffestb_decl_kindparam_2_) // to expression handler
1419
1420 Handle "[KIND=]expr)". */
1421
1422static ffelexHandler
1423ffestb_decl_kindparam_2_ (ffelexToken ft, ffebld expr, ffelexToken t)
1424{
1425 switch (ffelex_token_type (t))
1426 {
1427 case FFELEX_typeCLOSE_PAREN:
1428 ffestb_local_.decl.kind = expr;
1429 ffestb_local_.decl.kindt = ffelex_token_use (ft);
1430 ffestb_local_.decl.len = NULL;
1431 ffestb_local_.decl.lent = NULL;
1432 ffelex_set_names (TRUE);
1433 return (ffelexHandler) ffestb_local_.decl.handler;
1434
1435 default:
1436 break;
1437 }
1438
1439 if (ffestb_local_.decl.recursive != NULL)
1440 ffelex_token_kill (ffestb_local_.decl.recursive);
1441 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1442 ffestb_local_.decl.badname,
1443 t);
1444 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1445}
1446
1447/* ffestb_decl_starkind_ -- "type" ASTERISK
1448
1449 return ffestb_decl_starkind_; // to lexer
1450
1451 Handle NUMBER. */
1452
1453static ffelexHandler
1454ffestb_decl_starkind_ (ffelexToken t)
1455{
1456 switch (ffelex_token_type (t))
1457 {
1458 case FFELEX_typeNUMBER:
1459 ffestb_local_.decl.kindt = ffelex_token_use (t);
1460 ffestb_local_.decl.kind = NULL;
1461 ffestb_local_.decl.len = NULL;
1462 ffestb_local_.decl.lent = NULL;
1463 ffelex_set_names (TRUE);
1464 return (ffelexHandler) ffestb_local_.decl.handler;
1465
1466 default:
1467 break;
1468 }
1469
1470 if (ffestb_local_.decl.recursive != NULL)
1471 ffelex_token_kill (ffestb_local_.decl.recursive);
1472 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1473 ffestb_local_.decl.badname,
1474 t);
1475 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1476}
1477
1478/* ffestb_decl_starlen_ -- "CHARACTER" ASTERISK
1479
1480 return ffestb_decl_starlen_; // to lexer
1481
1482 Handle NUMBER. */
1483
1484static ffelexHandler
1485ffestb_decl_starlen_ (ffelexToken t)
1486{
1487 switch (ffelex_token_type (t))
1488 {
1489 case FFELEX_typeNUMBER:
1490 ffestb_local_.decl.kind = NULL;
1491 ffestb_local_.decl.kindt = NULL;
1492 ffestb_local_.decl.len = NULL;
1493 ffestb_local_.decl.lent = ffelex_token_use (t);
1494 ffelex_set_names (TRUE);
1495 return (ffelexHandler) ffestb_local_.decl.handler;
1496
1497 case FFELEX_typeOPEN_PAREN:
1498 ffestb_local_.decl.kind = NULL;
1499 ffestb_local_.decl.kindt = NULL;
1500 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
1501 FFEEXPR_contextCHARACTERSIZE,
1502 (ffeexprCallback) ffestb_decl_starlen_1_);
1503
1504 default:
1505 break;
1506 }
1507
1508 if (ffestb_local_.decl.recursive != NULL)
1509 ffelex_token_kill (ffestb_local_.decl.recursive);
1510 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1511 ffestb_local_.decl.badname,
1512 t);
1513 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1514}
1515
1516/* ffestb_decl_starlen_1_ -- "CHARACTER" ASTERISK OPEN_PAREN expr
1517
1518 (ffestb_decl_starlen_1_) // to expression handler
1519
1520 Handle CLOSE_PAREN. */
1521
1522static ffelexHandler
1523ffestb_decl_starlen_1_ (ffelexToken ft, ffebld expr, ffelexToken t)
1524{
1525 switch (ffelex_token_type (t))
1526 {
1527 case FFELEX_typeCLOSE_PAREN:
1528 if (expr == NULL)
1529 break;
1530 ffestb_local_.decl.len = expr;
1531 ffestb_local_.decl.lent = ffelex_token_use (ft);
1532 ffelex_set_names (TRUE);
1533 return (ffelexHandler) ffestb_local_.decl.handler;
1534
1535 default:
1536 break;
1537 }
1538
1539 if (ffestb_local_.decl.recursive != NULL)
1540 ffelex_token_kill (ffestb_local_.decl.recursive);
1541 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1542 ffestb_local_.decl.badname,
1543 t);
1544 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1545}
1546
1547/* ffestb_decl_typeparams_ -- "CHARACTER" OPEN_PAREN
1548
1549 return ffestb_decl_typeparams_; // to lexer
1550
1551 Handle "[KIND=]expr)". */
1552
1553static ffelexHandler
1554ffestb_decl_typeparams_ (ffelexToken t)
1555{
1556 switch (ffelex_token_type (t))
1557 {
1558 case FFELEX_typeNAME:
1559 ffesta_tokens[1] = ffelex_token_use (t);
1560 return (ffelexHandler) ffestb_decl_typeparams_1_;
1561
1562 default:
1563 if (ffestb_local_.decl.lent == NULL)
1564 return (ffelexHandler) (*((ffelexHandler)
1565 ffeexpr_rhs (ffesta_output_pool,
1566 FFEEXPR_contextCHARACTERSIZE,
1567 (ffeexprCallback) ffestb_decl_typeparams_2_)))
1568 (t);
1569 if (ffestb_local_.decl.kindt != NULL)
1570 break;
1571 return (ffelexHandler) (*((ffelexHandler)
1572 ffeexpr_rhs (ffesta_output_pool,
1573 FFEEXPR_contextKINDTYPE,
1574 (ffeexprCallback) ffestb_decl_typeparams_3_)))
1575 (t);
1576 }
1577
1578 if (ffestb_local_.decl.recursive != NULL)
1579 ffelex_token_kill (ffestb_local_.decl.recursive);
1580 if (ffestb_local_.decl.kindt != NULL)
1581 ffelex_token_kill (ffestb_local_.decl.kindt);
1582 if (ffestb_local_.decl.lent != NULL)
1583 ffelex_token_kill (ffestb_local_.decl.lent);
1584 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1585 ffestb_local_.decl.badname,
1586 t);
1587 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1588}
1589
1590/* ffestb_decl_typeparams_1_ -- "CHARACTER" OPEN_PAREN NAME
1591
1592 return ffestb_decl_typeparams_1_; // to lexer
1593
1594 Handle "[KIND=]expr)". */
1595
1596static ffelexHandler
1597ffestb_decl_typeparams_1_ (ffelexToken t)
1598{
1599 ffelexHandler next;
1600 ffelexToken nt;
1601
1602 switch (ffelex_token_type (t))
1603 {
1604 case FFELEX_typeEQUALS:
1605 ffesta_confirmed ();
1606 switch (ffestr_other (ffesta_tokens[1]))
1607 {
1608 case FFESTR_otherLEN:
1609 if (ffestb_local_.decl.lent != NULL)
1610 break;
1611 ffelex_token_kill (ffesta_tokens[1]);
1612 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
1613 FFEEXPR_contextCHARACTERSIZE,
1614 (ffeexprCallback) ffestb_decl_typeparams_2_);
1615
1616 case FFESTR_otherKIND:
1617 if (ffestb_local_.decl.kindt != NULL)
1618 break;
1619 ffelex_token_kill (ffesta_tokens[1]);
1620 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
1621 FFEEXPR_contextKINDTYPE,
1622 (ffeexprCallback) ffestb_decl_typeparams_3_);
1623
1624 default:
1625 break;
1626 }
1627 break;
1628
1629 default:
1630 nt = ffesta_tokens[1];
1631 if (ffestb_local_.decl.lent == NULL)
1632 next = (ffelexHandler) (*((ffelexHandler)
1633 ffeexpr_rhs (ffesta_output_pool,
1634 FFEEXPR_contextCHARACTERSIZE,
1635 (ffeexprCallback) ffestb_decl_typeparams_2_)))
1636 (nt);
1637 else if (ffestb_local_.decl.kindt == NULL)
1638 next = (ffelexHandler) (*((ffelexHandler)
1639 ffeexpr_rhs (ffesta_output_pool,
1640 FFEEXPR_contextKINDTYPE,
1641 (ffeexprCallback) ffestb_decl_typeparams_3_)))
1642 (nt);
1643 else
1644 {
1645 ffesta_tokens[1] = nt;
1646 break;
1647 }
1648 ffelex_token_kill (nt);
1649 return (ffelexHandler) (*next) (t);
1650 }
1651
1652 if (ffestb_local_.decl.recursive != NULL)
1653 ffelex_token_kill (ffestb_local_.decl.recursive);
1654 if (ffestb_local_.decl.kindt != NULL)
1655 ffelex_token_kill (ffestb_local_.decl.kindt);
1656 if (ffestb_local_.decl.lent != NULL)
1657 ffelex_token_kill (ffestb_local_.decl.lent);
1658 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1659 ffestb_local_.decl.badname,
1660 ffesta_tokens[1]);
1661 ffelex_token_kill (ffesta_tokens[1]);
1662 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1663}
1664
1665/* ffestb_decl_typeparams_2_ -- "CHARACTER" OPEN_PAREN ["LEN="] expr
1666
1667 (ffestb_decl_typeparams_2_) // to expression handler
1668
1669 Handle "[LEN=]expr)". */
1670
1671static ffelexHandler
1672ffestb_decl_typeparams_2_ (ffelexToken ft, ffebld expr, ffelexToken t)
1673{
1674 switch (ffelex_token_type (t))
1675 {
1676 case FFELEX_typeCLOSE_PAREN:
1677 ffestb_local_.decl.len = expr;
1678 ffestb_local_.decl.lent = ffelex_token_use (ft);
1679 ffelex_set_names (TRUE);
1680 return (ffelexHandler) ffestb_local_.decl.handler;
1681
1682 case FFELEX_typeCOMMA:
1683 ffestb_local_.decl.len = expr;
1684 ffestb_local_.decl.lent = ffelex_token_use (ft);
1685 return (ffelexHandler) ffestb_decl_typeparams_;
1686
1687 default:
1688 break;
1689 }
1690
1691 if (ffestb_local_.decl.recursive != NULL)
1692 ffelex_token_kill (ffestb_local_.decl.recursive);
1693 if (ffestb_local_.decl.kindt != NULL)
1694 ffelex_token_kill (ffestb_local_.decl.kindt);
1695 if (ffestb_local_.decl.lent != NULL)
1696 ffelex_token_kill (ffestb_local_.decl.lent);
1697 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1698 ffestb_local_.decl.badname,
1699 t);
1700 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1701}
1702
1703/* ffestb_decl_typeparams_3_ -- "CHARACTER" OPEN_PAREN ["KIND="] expr
1704
1705 (ffestb_decl_typeparams_3_) // to expression handler
1706
1707 Handle "[KIND=]expr)". */
1708
1709static ffelexHandler
1710ffestb_decl_typeparams_3_ (ffelexToken ft, ffebld expr, ffelexToken t)
1711{
1712 switch (ffelex_token_type (t))
1713 {
1714 case FFELEX_typeCLOSE_PAREN:
1715 ffestb_local_.decl.kind = expr;
1716 ffestb_local_.decl.kindt = ffelex_token_use (ft);
1717 ffelex_set_names (TRUE);
1718 return (ffelexHandler) ffestb_local_.decl.handler;
1719
1720 case FFELEX_typeCOMMA:
1721 ffestb_local_.decl.kind = expr;
1722 ffestb_local_.decl.kindt = ffelex_token_use (ft);
1723 return (ffelexHandler) ffestb_decl_typeparams_;
1724
1725 default:
1726 break;
1727 }
1728
1729 if (ffestb_local_.decl.recursive != NULL)
1730 ffelex_token_kill (ffestb_local_.decl.recursive);
1731 if (ffestb_local_.decl.kindt != NULL)
1732 ffelex_token_kill (ffestb_local_.decl.kindt);
1733 if (ffestb_local_.decl.lent != NULL)
1734 ffelex_token_kill (ffestb_local_.decl.lent);
1735 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1736 ffestb_local_.decl.badname,
1737 t);
1738 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1739}
1740
1741/* ffestb_decl_typetype1_ -- "TYPE" OPEN_PAREN
1742
1743 return ffestb_decl_typetype1_; // to lexer
1744
1745 Handle NAME. */
1746
1747#if FFESTR_F90
1748static ffelexHandler
1749ffestb_decl_typetype1_ (ffelexToken t)
1750{
1751 switch (ffelex_token_type (t))
1752 {
1753 case FFELEX_typeNAME:
1754 ffestb_local_.decl.kindt = ffelex_token_use (t);
1755 return (ffelexHandler) ffestb_decl_typetype2_;
1756
1757 default:
1758 break;
1759 }
1760
1761 if (ffestb_local_.decl.recursive != NULL)
1762 ffelex_token_kill (ffestb_local_.decl.recursive);
1763 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1764 ffestb_local_.decl.badname,
1765 t);
1766 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1767}
1768
1769/* ffestb_decl_typetype2_ -- "TYPE" OPEN_PAREN NAME
1770
1771 return ffestb_decl_typetype2_; // to lexer
1772
1773 Handle CLOSE_PAREN. */
1774
1775static ffelexHandler
1776ffestb_decl_typetype2_ (ffelexToken t)
1777{
1778 switch (ffelex_token_type (t))
1779 {
1780 case FFELEX_typeCLOSE_PAREN:
1781 ffestb_local_.decl.type = FFESTP_typeTYPE;
1782 ffestb_local_.decl.kind = NULL;
1783 ffestb_local_.decl.len = NULL;
1784 ffestb_local_.decl.lent = NULL;
1785 ffelex_set_names (TRUE);
1786 return (ffelexHandler) ffestb_local_.decl.handler;
1787
1788 default:
1789 break;
1790 }
1791
1792 if (ffestb_local_.decl.recursive != NULL)
1793 ffelex_token_kill (ffestb_local_.decl.recursive);
1794 ffelex_token_kill (ffestb_local_.decl.kindt);
1795 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1796 ffestb_local_.decl.badname,
1797 t);
1798 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1799}
1800
1801#endif
1802/* ffestb_subr_label_list_ -- Collect a tokenlist of labels and close-paren
1803
1804 return ffestb_subr_label_list_; // to lexer after seeing OPEN_PAREN
1805
1806 First token must be a NUMBER. Must be followed by zero or more COMMA
1807 NUMBER pairs. Must then be followed by a CLOSE_PAREN. If all ok, put
1808 the NUMBER tokens in a token list and return via the handler for the
1809 token after CLOSE_PAREN. Else return via
1810 same handler, but with the ok return value set FALSE. */
1811
1812static ffelexHandler
1813ffestb_subr_label_list_ (ffelexToken t)
1814{
1815 if (ffelex_token_type (t) == FFELEX_typeNUMBER)
1816 {
1817 ffestt_tokenlist_append (ffestb_subrargs_.label_list.labels,
1818 ffelex_token_use (t));
1819 return (ffelexHandler) ffestb_subr_label_list_1_;
1820 }
1821
1822 ffestb_subrargs_.label_list.ok = FALSE;
1823 return (ffelexHandler) (*ffestb_subrargs_.label_list.handler) (t);
1824}
1825
1826/* ffestb_subr_label_list_1_ -- NUMBER
1827
1828 return ffestb_subr_label_list_1_; // to lexer after seeing NUMBER
1829
1830 The next token must be COMMA, in which case go back to
1831 ffestb_subr_label_list_, or CLOSE_PAREN, in which case set ok to TRUE
1832 and go to the handler. */
1833
1834static ffelexHandler
1835ffestb_subr_label_list_1_ (ffelexToken t)
1836{
1837 switch (ffelex_token_type (t))
1838 {
1839 case FFELEX_typeCOMMA:
1840 return (ffelexHandler) ffestb_subr_label_list_;
1841
1842 case FFELEX_typeCLOSE_PAREN:
1843 ffestb_subrargs_.label_list.ok = TRUE;
1844 return (ffelexHandler) ffestb_subrargs_.label_list.handler;
1845
1846 default:
1847 ffestb_subrargs_.label_list.ok = FALSE;
1848 return (ffelexHandler) (*ffestb_subrargs_.label_list.handler) (t);
1849 }
1850}
1851
1852/* ffestb_do -- Parse the DO statement
1853
1854 return ffestb_do; // to lexer
1855
1856 Make sure the statement has a valid form for the DO statement. If it
1857 does, implement the statement. */
1858
1859ffelexHandler
1860ffestb_do (ffelexToken t)
1861{
1862 ffeTokenLength i;
1863 char *p;
1864 ffelexHandler next;
1865 ffelexToken nt;
1866 ffestrSecond kw;
1867
1868 switch (ffelex_token_type (ffesta_tokens[0]))
1869 {
1870 case FFELEX_typeNAME:
1871 if (ffesta_first_kw != FFESTR_firstDO)
1872 goto bad_0; /* :::::::::::::::::::: */
1873 switch (ffelex_token_type (t))
1874 {
1875 case FFELEX_typeNUMBER:
1876 ffesta_confirmed ();
1877 ffesta_tokens[1] = ffelex_token_use (t);
1878 return (ffelexHandler) ffestb_do1_;
1879
1880 case FFELEX_typeCOMMA:
1881 ffesta_confirmed ();
1882 ffesta_tokens[1] = NULL;
1883 return (ffelexHandler) ffestb_do2_;
1884
1885 case FFELEX_typeNAME:
1886 ffesta_confirmed ();
1887 ffesta_tokens[1] = NULL;
1888 ffesta_tokens[2] = ffelex_token_use (t);
1889 return (ffelexHandler) ffestb_do3_;
1890
1891 case FFELEX_typeEOS:
1892 case FFELEX_typeSEMICOLON:
1893 ffesta_confirmed ();
1894 ffesta_tokens[1] = NULL;
1895 return (ffelexHandler) ffestb_do1_ (t);
1896
1897 case FFELEX_typeCOLONCOLON:
1898 ffesta_confirmed (); /* Error, but clearly intended. */
1899 goto bad_1; /* :::::::::::::::::::: */
1900
1901 default:
1902 goto bad_1; /* :::::::::::::::::::: */
1903 }
1904
1905 case FFELEX_typeNAMES:
1906 if (ffesta_first_kw != FFESTR_firstDO)
1907 goto bad_0; /* :::::::::::::::::::: */
1908 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDO);
1909 switch (ffelex_token_type (t))
1910 {
1911 case FFELEX_typeCOLONCOLON:
1912 ffesta_confirmed (); /* Error, but clearly intended. */
1913 goto bad_1; /* :::::::::::::::::::: */
1914
1915 default:
1916 goto bad_1; /* :::::::::::::::::::: */
1917
1918 case FFELEX_typeOPEN_PAREN: /* Must be "DO" label "WHILE". */
1919 if (!isdigit (*p))
1920 goto bad_i; /* :::::::::::::::::::: */
1921 ffesta_tokens[1] = ffelex_token_number_from_names (ffesta_tokens[0],
1922 i);
1923 p += ffelex_token_length (ffesta_tokens[1]);
1924 i += ffelex_token_length (ffesta_tokens[1]);
1925 if (((*p) != 'W') && ((*p) != 'w'))
1926 goto bad_i1; /* :::::::::::::::::::: */
1927 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
1928 kw = ffestr_second (nt);
1929 ffelex_token_kill (nt);
1930 if (kw != FFESTR_secondWHILE)
1931 goto bad_i1; /* :::::::::::::::::::: */
1932 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
1933 FFEEXPR_contextDOWHILE, (ffeexprCallback) ffestb_do4_);
1934
1935 case FFELEX_typeCOMMA:
1936 ffesta_confirmed ();
1937 if (*p == '\0')
1938 {
1939 ffesta_tokens[1] = NULL;
1940 return (ffelexHandler) ffestb_do2_;
1941 }
1942 if (!isdigit (*p))
1943 goto bad_i; /* :::::::::::::::::::: */
1944 ffesta_tokens[1] = ffelex_token_number_from_names (ffesta_tokens[0],
1945 i);
1946 p += ffelex_token_length (ffesta_tokens[1]);
1947 i += ffelex_token_length (ffesta_tokens[1]);
1948 if (*p != '\0')
1949 goto bad_i1; /* :::::::::::::::::::: */
1950 return (ffelexHandler) ffestb_do2_;
1951
1952 case FFELEX_typeEQUALS:
1953 if (isdigit (*p))
1954 {
1955 ffesta_tokens[1]
1956 = ffelex_token_number_from_names (ffesta_tokens[0], i);
1957 p += ffelex_token_length (ffesta_tokens[1]);
1958 i += ffelex_token_length (ffesta_tokens[1]);
1959 }
1960 else
1961 ffesta_tokens[1] = NULL;
1962 if (!ffesrc_is_name_init (*p))
1963 goto bad_i1; /* :::::::::::::::::::: */
1964 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
1965 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_lhs
1966 (ffesta_output_pool, FFEEXPR_contextDO,
1967 (ffeexprCallback) ffestb_do6_)))
1968 (nt);
1969 ffelex_token_kill (nt); /* Will get it back in _6_... */
1970 return (ffelexHandler) (*next) (t);
1971
1972 case FFELEX_typeEOS:
1973 case FFELEX_typeSEMICOLON:
1974 ffesta_confirmed ();
1975 if (isdigit (*p))
1976 {
1977 ffesta_tokens[1]
1978 = ffelex_token_number_from_names (ffesta_tokens[0], i);
1979 p += ffelex_token_length (ffesta_tokens[1]);
1980 i += ffelex_token_length (ffesta_tokens[1]);
1981 }
1982 else
1983 ffesta_tokens[1] = NULL;
1984 if (*p != '\0')
1985 goto bad_i1; /* :::::::::::::::::::: */
1986 return (ffelexHandler) ffestb_do1_ (t);
1987 }
1988
1989 default:
1990 goto bad_0; /* :::::::::::::::::::: */
1991 }
1992
1993bad_0: /* :::::::::::::::::::: */
1994 if (ffesta_construct_name != NULL)
1995 {
1996 ffelex_token_kill (ffesta_construct_name);
1997 ffesta_construct_name = NULL;
1998 }
1999 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[0]);
2000 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2001
2002bad_1: /* :::::::::::::::::::: */
2003 if (ffesta_construct_name != NULL)
2004 {
2005 ffelex_token_kill (ffesta_construct_name);
2006 ffesta_construct_name = NULL;
2007 }
2008 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
2009 return (ffelexHandler) ffelex_swallow_tokens (t,
2010 (ffelexHandler) ffesta_zero); /* Invalid second token. */
2011
2012bad_i1: /* :::::::::::::::::::: */
2013 if (ffesta_tokens[1])
2014 ffelex_token_kill (ffesta_tokens[1]);
2015
2016bad_i: /* :::::::::::::::::::: */
2017 if (ffesta_construct_name != NULL)
2018 {
2019 ffelex_token_kill (ffesta_construct_name);
2020 ffesta_construct_name = NULL;
2021 }
2022 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[0], i, t);
2023 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2024}
2025
2026/* ffestb_dowhile -- Parse the DOWHILE statement
2027
2028 return ffestb_dowhile; // to lexer
2029
2030 Make sure the statement has a valid form for the DOWHILE statement. If it
2031 does, implement the statement. */
2032
2033ffelexHandler
2034ffestb_dowhile (ffelexToken t)
2035{
2036 ffeTokenLength i;
2037 char *p;
2038 ffelexHandler next;
2039 ffelexToken nt;
2040
2041 switch (ffelex_token_type (ffesta_tokens[0]))
2042 {
2043 case FFELEX_typeNAMES:
2044 if (ffesta_first_kw != FFESTR_firstDOWHILE)
2045 goto bad_0; /* :::::::::::::::::::: */
2046 switch (ffelex_token_type (t))
2047 {
2048 case FFELEX_typeEOS:
2049 case FFELEX_typeSEMICOLON:
2050 case FFELEX_typeCOMMA:
2051 case FFELEX_typeCOLONCOLON:
2052 ffesta_confirmed (); /* Error, but clearly intended. */
2053 goto bad_1; /* :::::::::::::::::::: */
2054
2055 default:
2056 goto bad_1; /* :::::::::::::::::::: */
2057
2058 case FFELEX_typeOPEN_PAREN:
2059 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDOWHILE);
2060 if (*p != '\0')
2061 goto bad_i; /* :::::::::::::::::::: */
2062 ffesta_tokens[1] = NULL;
2063 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
2064 FFEEXPR_contextDOWHILE, (ffeexprCallback) ffestb_do4_);
2065
2066 case FFELEX_typeEQUALS:/* Not really DOWHILE, but DOWHILExyz=.... */
2067 ffesta_tokens[1] = NULL;
2068 nt = ffelex_token_name_from_names (ffesta_tokens[0], FFESTR_firstlDO,
2069 0);
2070 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_lhs
2071 (ffesta_output_pool, FFEEXPR_contextDO,
2072 (ffeexprCallback) ffestb_do6_)))
2073 (nt);
2074 ffelex_token_kill (nt); /* Will get it back in _6_... */
2075 return (ffelexHandler) (*next) (t);
2076 }
2077
2078 default:
2079 goto bad_0; /* :::::::::::::::::::: */
2080 }
2081
2082bad_0: /* :::::::::::::::::::: */
2083 if (ffesta_construct_name != NULL)
2084 {
2085 ffelex_token_kill (ffesta_construct_name);
2086 ffesta_construct_name = NULL;
2087 }
2088 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[0]);
2089 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2090
2091bad_1: /* :::::::::::::::::::: */
2092 if (ffesta_construct_name != NULL)
2093 {
2094 ffelex_token_kill (ffesta_construct_name);
2095 ffesta_construct_name = NULL;
2096 }
2097 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
2098 return (ffelexHandler) ffelex_swallow_tokens (t,
2099 (ffelexHandler) ffesta_zero); /* Invalid second token. */
2100
2101bad_i: /* :::::::::::::::::::: */
2102 if (ffesta_construct_name != NULL)
2103 {
2104 ffelex_token_kill (ffesta_construct_name);
2105 ffesta_construct_name = NULL;
2106 }
2107 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[0], i, t);
2108 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2109}
2110
2111/* ffestb_do1_ -- "DO" [label]
2112
2113 return ffestb_do1_; // to lexer
2114
2115 Make sure the statement has a valid form for the DO statement. If it
2116 does, implement the statement. */
2117
2118static ffelexHandler
2119ffestb_do1_ (ffelexToken t)
2120{
2121 switch (ffelex_token_type (t))
2122 {
2123 case FFELEX_typeCOMMA:
2124 ffesta_confirmed ();
2125 return (ffelexHandler) ffestb_do2_;
2126
2127 case FFELEX_typeEOS:
2128 case FFELEX_typeSEMICOLON:
2129 ffesta_confirmed ();
2130 if (!ffesta_is_inhibited ())
2131 {
2132 if (ffesta_tokens[1] != NULL)
2133 ffestc_R819B (ffesta_construct_name, ffesta_tokens[1], NULL,
2134 NULL);
2135 else
2136 ffestc_R820B (ffesta_construct_name, NULL, NULL);
2137 }
2138 if (ffesta_tokens[1] != NULL)
2139 ffelex_token_kill (ffesta_tokens[1]);
2140 if (ffesta_construct_name != NULL)
2141 {
2142 ffelex_token_kill (ffesta_construct_name);
2143 ffesta_construct_name = NULL;
2144 }
2145 return (ffelexHandler) ffesta_zero (t);
2146
2147 case FFELEX_typeNAME:
2148 return (ffelexHandler) ffestb_do2_ (t);
2149
2150 default:
2151 break;
2152 }
2153
2154 if (ffesta_tokens[1] != NULL)
2155 ffelex_token_kill (ffesta_tokens[1]);
2156 if (ffesta_construct_name != NULL)
2157 {
2158 ffelex_token_kill (ffesta_construct_name);
2159 ffesta_construct_name = NULL;
2160 }
2161 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
2162 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2163}
2164
2165/* ffestb_do2_ -- "DO" [label] [,]
2166
2167 return ffestb_do2_; // to lexer
2168
2169 Make sure the statement has a valid form for the DO statement. If it
2170 does, implement the statement. */
2171
2172static ffelexHandler
2173ffestb_do2_ (ffelexToken t)
2174{
2175 switch (ffelex_token_type (t))
2176 {
2177 case FFELEX_typeNAME:
2178 ffesta_tokens[2] = ffelex_token_use (t);
2179 return (ffelexHandler) ffestb_do3_;
2180
2181 default:
2182 break;
2183 }
2184
2185 if (ffesta_tokens[1] != NULL)
2186 ffelex_token_kill (ffesta_tokens[1]);
2187 if (ffesta_construct_name != NULL)
2188 {
2189 ffelex_token_kill (ffesta_construct_name);
2190 ffesta_construct_name = NULL;
2191 }
2192 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
2193 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2194}
2195
2196/* ffestb_do3_ -- "DO" [label] [,] NAME
2197
2198 return ffestb_do3_; // to lexer
2199
2200 Make sure the statement has a valid form for the DO statement. If it
2201 does, implement the statement. */
2202
2203static ffelexHandler
2204ffestb_do3_ (ffelexToken t)
2205{
2206 ffelexHandler next;
2207
2208 switch (ffelex_token_type (t))
2209 {
2210 case FFELEX_typeEQUALS:
2211 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
2212 FFEEXPR_contextDO, (ffeexprCallback) ffestb_do6_)))
2213 (ffesta_tokens[2]);
2214 ffelex_token_kill (ffesta_tokens[2]); /* Will get it back in _6_... */
2215 return (ffelexHandler) (*next) (t);
2216
2217 case FFELEX_typeOPEN_PAREN:
2218 if (ffestr_second (ffesta_tokens[2]) != FFESTR_secondWHILE)
2219 {
2220 if (ffesta_tokens[1] != NULL)
2221 ffelex_token_kill (ffesta_tokens[1]);
2222 if (ffesta_construct_name != NULL)
2223 {
2224 ffelex_token_kill (ffesta_construct_name);
2225 ffesta_construct_name = NULL;
2226 }
2227 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[2]);
2228 ffelex_token_kill (ffesta_tokens[2]);
2229 return (ffelexHandler) ffelex_swallow_tokens (t,
2230 (ffelexHandler) ffesta_zero); /* Invalid token. */
2231 }
2232 ffelex_token_kill (ffesta_tokens[2]);
2233 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
2234 FFEEXPR_contextDOWHILE, (ffeexprCallback) ffestb_do4_);
2235
2236 default:
2237 break;
2238 }
2239
2240 ffelex_token_kill (ffesta_tokens[2]);
2241 if (ffesta_tokens[1] != NULL)
2242 ffelex_token_kill (ffesta_tokens[1]);
2243 if (ffesta_construct_name != NULL)
2244 {
2245 ffelex_token_kill (ffesta_construct_name);
2246 ffesta_construct_name = NULL;
2247 }
2248 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
2249 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2250}
2251
2252/* ffestb_do4_ -- "DO" [label] [,] "WHILE" OPEN_PAREN expr
2253
2254 (ffestb_do4_) // to expression handler
2255
2256 Make sure the statement has a valid form for the DO statement. If it
2257 does, implement the statement. */
2258
2259static ffelexHandler
2260ffestb_do4_ (ffelexToken ft, ffebld expr, ffelexToken t)
2261{
2262 switch (ffelex_token_type (t))
2263 {
2264 case FFELEX_typeCLOSE_PAREN:
2265 if (expr == NULL)
2266 break;
2267 ffesta_tokens[2] = ffelex_token_use (ft);
2268 ffestb_local_.dowhile.expr = expr;
2269 return (ffelexHandler) ffestb_do5_;
2270
2271 default:
2272 break;
2273 }
2274
2275 if (ffesta_tokens[1] != NULL)
2276 ffelex_token_kill (ffesta_tokens[1]);
2277 if (ffesta_construct_name != NULL)
2278 {
2279 ffelex_token_kill (ffesta_construct_name);
2280 ffesta_construct_name = NULL;
2281 }
2282 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
2283 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2284}
2285
2286/* ffestb_do5_ -- "DO" [label] [,] "WHILE" OPEN_PAREN expr CLOSE_PAREN
2287
2288 return ffestb_do5_; // to lexer
2289
2290 Make sure the statement has a valid form for the DO statement. If it
2291 does, implement the statement. */
2292
2293static ffelexHandler
2294ffestb_do5_ (ffelexToken t)
2295{
2296 switch (ffelex_token_type (t))
2297 {
2298 case FFELEX_typeEOS:
2299 case FFELEX_typeSEMICOLON:
2300 ffesta_confirmed ();
2301 if (!ffesta_is_inhibited ())
2302 {
2303 if (ffesta_tokens[1] != NULL)
2304 ffestc_R819B (ffesta_construct_name, ffesta_tokens[1],
2305 ffestb_local_.dowhile.expr, ffesta_tokens[2]);
2306 else
2307 ffestc_R820B (ffesta_construct_name, ffestb_local_.dowhile.expr,
2308 ffesta_tokens[2]);
2309 }
2310 ffelex_token_kill (ffesta_tokens[2]);
2311 if (ffesta_tokens[1] != NULL)
2312 ffelex_token_kill (ffesta_tokens[1]);
2313 if (ffesta_construct_name != NULL)
2314 {
2315 ffelex_token_kill (ffesta_construct_name);
2316 ffesta_construct_name = NULL;
2317 }
2318 return (ffelexHandler) ffesta_zero (t);
2319
2320 default:
2321 break;
2322 }
2323
2324 ffelex_token_kill (ffesta_tokens[2]);
2325 if (ffesta_tokens[1] != NULL)
2326 ffelex_token_kill (ffesta_tokens[1]);
2327 if (ffesta_construct_name != NULL)
2328 {
2329 ffelex_token_kill (ffesta_construct_name);
2330 ffesta_construct_name = NULL;
2331 }
2332 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
2333 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2334}
2335
2336/* ffestb_do6_ -- "DO" [label] [,] var-expr
2337
2338 (ffestb_do6_) // to expression handler
2339
2340 Make sure the statement has a valid form for the DO statement. If it
2341 does, implement the statement. */
2342
2343static ffelexHandler
2344ffestb_do6_ (ffelexToken ft, ffebld expr, ffelexToken t)
2345{
2346 /* _3_ already ensured that this would be an EQUALS token. If not, it is a
2347 bug in the FFE. */
2348
2349 assert (ffelex_token_type (t) == FFELEX_typeEQUALS);
2350
2351 ffesta_tokens[2] = ffelex_token_use (ft);
2352 ffestb_local_.do_stmt.var = expr;
2353 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
2354 FFEEXPR_contextDO, (ffeexprCallback) ffestb_do7_);
2355}
2356
2357/* ffestb_do7_ -- "DO" [label] [,] var-expr EQUALS expr
2358
2359 (ffestb_do7_) // to expression handler
2360
2361 Make sure the statement has a valid form for the DO statement. If it
2362 does, implement the statement. */
2363
2364static ffelexHandler
2365ffestb_do7_ (ffelexToken ft, ffebld expr, ffelexToken t)
2366{
2367 switch (ffelex_token_type (t))
2368 {
2369 case FFELEX_typeCOMMA:
2370 ffesta_confirmed ();
2371 if (expr == NULL)
2372 break;
2373 ffesta_tokens[3] = ffelex_token_use (ft);
2374 ffestb_local_.do_stmt.start = expr;
2375 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
2376 FFEEXPR_contextDO, (ffeexprCallback) ffestb_do8_);
2377
2378 default:
2379 break;
2380 }
2381
2382 ffelex_token_kill (ffesta_tokens[2]);
2383 if (ffesta_tokens[1] != NULL)
2384 ffelex_token_kill (ffesta_tokens[1]);
2385 if (ffesta_construct_name != NULL)
2386 {
2387 ffelex_token_kill (ffesta_construct_name);
2388 ffesta_construct_name = NULL;
2389 }
2390 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
2391 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2392}
2393
2394/* ffestb_do8_ -- "DO" [label] [,] var-expr EQUALS expr COMMA expr
2395
2396 (ffestb_do8_) // to expression handler
2397
2398 Make sure the statement has a valid form for the DO statement. If it
2399 does, implement the statement. */
2400
2401static ffelexHandler
2402ffestb_do8_ (ffelexToken ft, ffebld expr, ffelexToken t)
2403{
2404 switch (ffelex_token_type (t))
2405 {
2406 case FFELEX_typeCOMMA:
2407 if (expr == NULL)
2408 break;
2409 ffesta_tokens[4] = ffelex_token_use (ft);
2410 ffestb_local_.do_stmt.end = expr;
2411 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
2412 FFEEXPR_contextDO, (ffeexprCallback) ffestb_do9_);
2413
2414 case FFELEX_typeEOS:
2415 case FFELEX_typeSEMICOLON:
2416 if (expr == NULL)
2417 break;
2418 ffesta_tokens[4] = ffelex_token_use (ft);
2419 ffestb_local_.do_stmt.end = expr;
2420 return (ffelexHandler) ffestb_do9_ (NULL, NULL, t);
2421
2422 default:
2423 break;
2424 }
2425
2426 ffelex_token_kill (ffesta_tokens[3]);
2427 ffelex_token_kill (ffesta_tokens[2]);
2428 if (ffesta_tokens[1] != NULL)
2429 ffelex_token_kill (ffesta_tokens[1]);
2430 if (ffesta_construct_name != NULL)
2431 {
2432 ffelex_token_kill (ffesta_construct_name);
2433 ffesta_construct_name = NULL;
2434 }
2435 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
2436 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2437}
2438
2439/* ffestb_do9_ -- "DO" [label] [,] var-expr EQUALS expr COMMA expr
2440 [COMMA expr]
2441
2442 (ffestb_do9_) // to expression handler
2443
2444 Make sure the statement has a valid form for the DO statement. If it
2445 does, implement the statement. */
2446
2447static ffelexHandler
2448ffestb_do9_ (ffelexToken ft, ffebld expr, ffelexToken t)
2449{
2450 switch (ffelex_token_type (t))
2451 {
2452 case FFELEX_typeEOS:
2453 case FFELEX_typeSEMICOLON:
2454 if ((expr == NULL) && (ft != NULL))
2455 break;
2456 if (!ffesta_is_inhibited ())
2457 {
2458 if (ffesta_tokens[1] != NULL)
2459 ffestc_R819A (ffesta_construct_name, ffesta_tokens[1],
2460 ffestb_local_.do_stmt.var, ffesta_tokens[2],
2461 ffestb_local_.do_stmt.start, ffesta_tokens[3],
2462 ffestb_local_.do_stmt.end, ffesta_tokens[4], expr, ft);
2463 else
2464 ffestc_R820A (ffesta_construct_name, ffestb_local_.do_stmt.var,
2465 ffesta_tokens[2], ffestb_local_.do_stmt.start,
2466 ffesta_tokens[3], ffestb_local_.do_stmt.end,
2467 ffesta_tokens[4], expr, ft);
2468 }
2469 ffelex_token_kill (ffesta_tokens[4]);
2470 ffelex_token_kill (ffesta_tokens[3]);
2471 ffelex_token_kill (ffesta_tokens[2]);
2472 if (ffesta_tokens[1] != NULL)
2473 ffelex_token_kill (ffesta_tokens[1]);
2474 if (ffesta_construct_name != NULL)
2475 {
2476 ffelex_token_kill (ffesta_construct_name);
2477 ffesta_construct_name = NULL;
2478 }
2479
2480 return (ffelexHandler) ffesta_zero (t);
2481
2482 default:
2483 break;
2484 }
2485
2486 ffelex_token_kill (ffesta_tokens[4]);
2487 ffelex_token_kill (ffesta_tokens[3]);
2488 ffelex_token_kill (ffesta_tokens[2]);
2489 if (ffesta_tokens[1] != NULL)
2490 ffelex_token_kill (ffesta_tokens[1]);
2491 if (ffesta_construct_name != NULL)
2492 {
2493 ffelex_token_kill (ffesta_construct_name);
2494 ffesta_construct_name = NULL;
2495 }
2496 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
2497 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2498}
2499
2500/* ffestb_else -- Parse the ELSE statement
2501
2502 return ffestb_else; // to lexer
2503
2504 Make sure the statement has a valid form for the ELSE statement. If it
2505 does, implement the statement. */
2506
2507ffelexHandler
2508ffestb_else (ffelexToken t)
2509{
2510 ffeTokenLength i;
2511 char *p;
2512
2513 switch (ffelex_token_type (ffesta_tokens[0]))
2514 {
2515 case FFELEX_typeNAME:
2516 if (ffesta_first_kw != FFESTR_firstELSE)
2517 goto bad_0; /* :::::::::::::::::::: */
2518 switch (ffelex_token_type (t))
2519 {
2520 case FFELEX_typeEOS:
2521 case FFELEX_typeSEMICOLON:
2522 ffesta_confirmed ();
2523 ffesta_tokens[1] = NULL;
2524 ffestb_args.elsexyz.second = FFESTR_secondNone;
2525 return (ffelexHandler) ffestb_else1_ (t);
2526
2527 case FFELEX_typeCOMMA:
2528 case FFELEX_typeCOLONCOLON:
2529 ffesta_confirmed (); /* Error, but clearly intended. */
2530 goto bad_1; /* :::::::::::::::::::: */
2531
2532 default:
2533 goto bad_1; /* :::::::::::::::::::: */
2534
2535 case FFELEX_typeNAME:
2536 break;
2537 }
2538
2539 ffesta_confirmed ();
2540 ffestb_args.elsexyz.second = ffesta_second_kw;
2541 ffesta_tokens[1] = ffelex_token_use (t);
2542 return (ffelexHandler) ffestb_else1_;
2543
2544 case FFELEX_typeNAMES:
2545 if (ffesta_first_kw != FFESTR_firstELSE)
2546 goto bad_0; /* :::::::::::::::::::: */
2547 switch (ffelex_token_type (t))
2548 {
2549 case FFELEX_typeCOMMA:
2550 case FFELEX_typeCOLONCOLON:
2551 ffesta_confirmed (); /* Error, but clearly intended. */
2552 goto bad_1; /* :::::::::::::::::::: */
2553
2554 default:
2555 goto bad_1; /* :::::::::::::::::::: */
2556
2557 case FFELEX_typeEOS:
2558 case FFELEX_typeSEMICOLON:
2559 break;
2560 }
2561 ffesta_confirmed ();
2562 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlELSE)
2563 {
2564 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlELSE);
2565 if (!ffesrc_is_name_init (*p))
2566 goto bad_i; /* :::::::::::::::::::: */
2567 ffesta_tokens[1]
2568 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
2569 }
2570 else
2571 ffesta_tokens[1] = NULL;
2572 ffestb_args.elsexyz.second = FFESTR_secondNone;
2573 return (ffelexHandler) ffestb_else1_ (t);
2574
2575 default:
2576 goto bad_0; /* :::::::::::::::::::: */
2577 }
2578
2579bad_0: /* :::::::::::::::::::: */
2580 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", ffesta_tokens[0]);
2581 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2582
2583bad_1: /* :::::::::::::::::::: */
2584 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", t);
2585 return (ffelexHandler) ffelex_swallow_tokens (t,
2586 (ffelexHandler) ffesta_zero); /* Invalid second token. */
2587
2588bad_i: /* :::::::::::::::::::: */
2589 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "ELSE", ffesta_tokens[0], i, t);
2590 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2591}
2592
2593/* ffestb_elsexyz -- Parse an ELSEIF/ELSEWHERE statement
2594
2595 return ffestb_elsexyz; // to lexer
2596
2597 Expects len and second to be set in ffestb_args.elsexyz to the length
2598 of the ELSExyz keyword involved and the corresponding ffestrSecond value. */
2599
2600ffelexHandler
2601ffestb_elsexyz (ffelexToken t)
2602{
2603 ffeTokenLength i;
2604 char *p;
2605
2606 switch (ffelex_token_type (ffesta_tokens[0]))
2607 {
2608 case FFELEX_typeNAME:
2609 switch (ffelex_token_type (t))
2610 {
2611 case FFELEX_typeEOS:
2612 case FFELEX_typeSEMICOLON:
2613 if (ffesta_first_kw == FFESTR_firstELSEIF)
2614 goto bad_0; /* :::::::::::::::::::: */
2615 ffesta_confirmed ();
2616 ffesta_tokens[1] = NULL;
2617 return (ffelexHandler) ffestb_else1_ (t);
2618
2619 case FFELEX_typeNAME:
2620 ffesta_confirmed ();
2621 goto bad_1; /* :::::::::::::::::::: */
2622
2623 case FFELEX_typeOPEN_PAREN:
2624 if (ffesta_first_kw != FFESTR_firstELSEIF)
2625 goto bad_0; /* :::::::::::::::::::: */
2626 ffesta_tokens[1] = NULL;
2627 return (ffelexHandler) ffestb_else1_ (t);
2628
2629 case FFELEX_typeCOMMA:
2630 case FFELEX_typeCOLONCOLON:
2631 ffesta_confirmed (); /* Error, but clearly intended. */
2632 goto bad_1; /* :::::::::::::::::::: */
2633
2634 default:
2635 goto bad_1; /* :::::::::::::::::::: */
2636 }
2637
2638 case FFELEX_typeNAMES:
2639 switch (ffelex_token_type (t))
2640 {
2641 case FFELEX_typeCOMMA:
2642 case FFELEX_typeCOLONCOLON:
2643 ffesta_confirmed (); /* Error, but clearly intended. */
2644 goto bad_1; /* :::::::::::::::::::: */
2645
2646 default:
2647 goto bad_1; /* :::::::::::::::::::: */
2648
2649 case FFELEX_typeOPEN_PAREN:
2650 if (ffesta_first_kw != FFESTR_firstELSEIF)
2651 goto bad_1; /* :::::::::::::::::::: */
2652 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlELSEIF)
2653 {
2654 i = FFESTR_firstlELSEIF;
2655 goto bad_i; /* :::::::::::::::::::: */
2656 }
2657 ffesta_tokens[1] = NULL;
2658 return (ffelexHandler) ffestb_else1_ (t);
2659
2660 case FFELEX_typeEOS:
2661 case FFELEX_typeSEMICOLON:
2662 break;
2663 }
2664 ffesta_confirmed ();
2665 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlELSE);
2666 ffesta_tokens[1]
2667 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
2668#if FFESTR_F90
2669 if ((ffestb_args.elsexyz.second == FFESTR_secondWHERE)
2670 && (ffelex_token_length (ffesta_tokens[1]) != FFESTR_secondlWHERE))
2671 ffestb_args.elsexyz.second = FFESTR_secondNone;
2672#endif
2673 return (ffelexHandler) ffestb_else1_ (t);
2674
2675 default:
2676 goto bad_0; /* :::::::::::::::::::: */
2677 }
2678
2679bad_0: /* :::::::::::::::::::: */
2680 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", ffesta_tokens[0]);
2681 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2682
2683bad_1: /* :::::::::::::::::::: */
2684 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", t);
2685 return (ffelexHandler) ffelex_swallow_tokens (t,
2686 (ffelexHandler) ffesta_zero); /* Invalid second token. */
2687
2688bad_i: /* :::::::::::::::::::: */
2689 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "ELSE IF", ffesta_tokens[0], i, t);
2690 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2691}
2692
2693/* ffestb_else1_ -- "ELSE" (NAME)
2694
2695 return ffestb_else1_; // to lexer
2696
2697 If EOS/SEMICOLON, implement the appropriate statement (keep in mind that
2698 "ELSE WHERE" is ambiguous at the syntactic level). If OPEN_PAREN, start
2699 expression analysis with callback at _2_. */
2700
2701static ffelexHandler
2702ffestb_else1_ (ffelexToken t)
2703{
2704 switch (ffelex_token_type (t))
2705 {
2706 case FFELEX_typeOPEN_PAREN:
2707 if (ffestb_args.elsexyz.second == FFESTR_secondIF)
2708 {
2709 if (ffesta_tokens[1] != NULL)
2710 ffelex_token_kill (ffesta_tokens[1]);
2711 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
2712 FFEEXPR_contextIF, (ffeexprCallback) ffestb_else2_);
2713 }
2714 /* Fall through. */
2715 default:
2716 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", t);
2717 if (ffesta_tokens[1] != NULL)
2718 ffelex_token_kill (ffesta_tokens[1]);
2719 return (ffelexHandler) ffelex_swallow_tokens (t,
2720 (ffelexHandler) ffesta_zero);
2721
2722 case FFELEX_typeEOS:
2723 case FFELEX_typeSEMICOLON:
2724 ffesta_confirmed ();
2725 break;
2726
2727 }
2728
2729 switch (ffestb_args.elsexyz.second)
2730 {
2731#if FFESTR_F90
2732 case FFESTR_secondWHERE:
2733 if (!ffesta_is_inhibited ())
2734 if ((ffesta_first_kw == FFESTR_firstELSEWHERE)
2735 && (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME))
2736 ffestc_R744 ();
2737 else
2738 ffestc_elsewhere (ffesta_tokens[1]); /* R744 or R805. */
2739 break;
2740#endif
2741
2742 default:
2743 if (!ffesta_is_inhibited ())
2744 ffestc_R805 (ffesta_tokens[1]);
2745 break;
2746 }
2747
2748 if (ffesta_tokens[1] != NULL)
2749 ffelex_token_kill (ffesta_tokens[1]);
2750 return (ffelexHandler) ffesta_zero (t);
2751}
2752
2753/* ffestb_else2_ -- "ELSE" "IF" OPEN_PAREN expr
2754
2755 (ffestb_else2_) // to expression handler
2756
2757 Make sure the next token is CLOSE_PAREN. */
2758
2759static ffelexHandler
2760ffestb_else2_ (ffelexToken ft, ffebld expr, ffelexToken t)
2761{
2762 ffestb_local_.else_stmt.expr = expr;
2763
2764 switch (ffelex_token_type (t))
2765 {
2766 case FFELEX_typeCLOSE_PAREN:
2767 if (expr == NULL)
2768 break;
2769 ffesta_tokens[1] = ffelex_token_use (ft);
2770 ffelex_set_names (TRUE);
2771 return (ffelexHandler) ffestb_else3_;
2772
2773 default:
2774 break;
2775 }
2776
2777 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t);
2778 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2779}
2780
2781/* ffestb_else3_ -- "ELSE" "IF" OPEN_PAREN expr CLOSE_PAREN
2782
2783 return ffestb_else3_; // to lexer
2784
2785 Make sure the next token is "THEN". */
2786
2787static ffelexHandler
2788ffestb_else3_ (ffelexToken t)
2789{
2790 ffeTokenLength i;
2791 char *p;
2792
2793 ffelex_set_names (FALSE);
2794
2795 switch (ffelex_token_type (t))
2796 {
2797 case FFELEX_typeNAME:
2798 ffesta_confirmed ();
2799 if (ffestr_first (t) == FFESTR_firstTHEN)
2800 return (ffelexHandler) ffestb_else4_;
2801 break;
2802
2803 case FFELEX_typeNAMES:
2804 ffesta_confirmed ();
2805 if (ffestr_first (t) != FFESTR_firstTHEN)
2806 break;
2807 if (ffelex_token_length (t) == FFESTR_firstlTHEN)
2808 return (ffelexHandler) ffestb_else4_;
2809 p = ffelex_token_text (t) + (i = FFESTR_firstlTHEN);
2810 if (!ffesrc_is_name_init (*p))
2811 goto bad_i; /* :::::::::::::::::::: */
2812 ffesta_tokens[2] = ffelex_token_name_from_names (t, i, 0);
2813 return (ffelexHandler) ffestb_else5_;
2814
2815 default:
2816 break;
2817 }
2818
2819 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t);
2820 ffelex_token_kill (ffesta_tokens[1]);
2821 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2822
2823bad_i: /* :::::::::::::::::::: */
2824 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t, i, NULL);
2825 ffelex_token_kill (ffesta_tokens[1]);
2826 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2827}
2828
2829/* ffestb_else4_ -- "ELSE" "IF" OPEN_PAREN expr CLOSE_PAREN "THEN"
2830
2831 return ffestb_else4_; // to lexer
2832
2833 Handle a NAME or EOS/SEMICOLON, then go to state _5_. */
2834
2835static ffelexHandler
2836ffestb_else4_ (ffelexToken t)
2837{
2838 ffelex_set_names (FALSE);
2839
2840 switch (ffelex_token_type (t))
2841 {
2842 case FFELEX_typeEOS:
2843 case FFELEX_typeSEMICOLON:
2844 ffesta_tokens[2] = NULL;
2845 return (ffelexHandler) ffestb_else5_ (t);
2846
2847 case FFELEX_typeNAME:
2848 ffesta_tokens[2] = ffelex_token_use (t);
2849 return (ffelexHandler) ffestb_else5_;
2850
2851 default:
2852 break;
2853 }
2854
2855 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t);
2856 ffelex_token_kill (ffesta_tokens[1]);
2857 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2858}
2859
2860/* ffestb_else5_ -- "ELSE" "IF" OPEN_PAREN expr CLOSE_PAREN "THEN"
2861
2862 return ffestb_else5_; // to lexer
2863
2864 Make sure the next token is EOS or SEMICOLON; implement R804. */
2865
2866static ffelexHandler
2867ffestb_else5_ (ffelexToken t)
2868{
2869 switch (ffelex_token_type (t))
2870 {
2871 case FFELEX_typeEOS:
2872 case FFELEX_typeSEMICOLON:
2873 if (!ffesta_is_inhibited ())
2874 ffestc_R804 (ffestb_local_.else_stmt.expr, ffesta_tokens[1],
2875 ffesta_tokens[2]);
2876 ffelex_token_kill (ffesta_tokens[1]);
2877 if (ffesta_tokens[2] != NULL)
2878 ffelex_token_kill (ffesta_tokens[2]);
2879 return (ffelexHandler) ffesta_zero (t);
2880
2881 default:
2882 break;
2883 }
2884
2885 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t);
2886 ffelex_token_kill (ffesta_tokens[1]);
2887 if (ffesta_tokens[2] != NULL)
2888 ffelex_token_kill (ffesta_tokens[2]);
2889 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2890}
2891
2892/* ffestb_end -- Parse the END statement
2893
2894 return ffestb_end; // to lexer
2895
2896 Make sure the statement has a valid form for the END statement. If it
2897 does, implement the statement. */
2898
2899ffelexHandler
2900ffestb_end (ffelexToken t)
2901{
2902 ffeTokenLength i;
2903
2904 switch (ffelex_token_type (ffesta_tokens[0]))
2905 {
2906 case FFELEX_typeNAME:
2907 if (ffesta_first_kw != FFESTR_firstEND)
2908 goto bad_0; /* :::::::::::::::::::: */
2909 switch (ffelex_token_type (t))
2910 {
2911 case FFELEX_typeEOS:
2912 case FFELEX_typeSEMICOLON:
2913 ffesta_tokens[1] = NULL;
2914 ffestb_args.endxyz.second = FFESTR_secondNone;
2915 return (ffelexHandler) ffestb_end3_ (t);
2916
2917 case FFELEX_typeCOMMA:
2918 case FFELEX_typeCOLONCOLON:
2919 ffesta_confirmed (); /* Error, but clearly intended. */
2920 goto bad_1; /* :::::::::::::::::::: */
2921
2922 default:
2923 goto bad_1; /* :::::::::::::::::::: */
2924
2925 case FFELEX_typeNAME:
2926 break;
2927 }
2928
2929 ffesta_confirmed ();
2930 ffestb_args.endxyz.second = ffesta_second_kw;
2931 switch (ffesta_second_kw)
2932 {
2933 case FFESTR_secondFILE:
2934 ffestb_args.beru.badname = "ENDFILE";
2935 return (ffelexHandler) ffestb_beru;
2936
2937 case FFESTR_secondBLOCK:
2938 return (ffelexHandler) ffestb_end1_;
2939
2940#if FFESTR_F90
2941 case FFESTR_secondINTERFACE:
2942#endif
2943#if FFESTR_VXT
2944 case FFESTR_secondMAP:
2945 case FFESTR_secondSTRUCTURE:
2946 case FFESTR_secondUNION:
2947#endif
2948#if FFESTR_F90
2949 case FFESTR_secondWHERE:
2950 ffesta_tokens[1] = NULL;
2951 return (ffelexHandler) ffestb_end3_;
2952#endif
2953
2954 case FFESTR_secondNone:
2955 goto bad_1; /* :::::::::::::::::::: */
2956
2957 default:
2958 return (ffelexHandler) ffestb_end2_;
2959 }
2960
2961 case FFELEX_typeNAMES:
2962 if (ffesta_first_kw != FFESTR_firstEND)
2963 goto bad_0; /* :::::::::::::::::::: */
2964 switch (ffelex_token_type (t))
2965 {
2966 case FFELEX_typeCOMMA:
2967 case FFELEX_typeCOLONCOLON:
2968 ffesta_confirmed (); /* Error, but clearly intended. */
2969 goto bad_1; /* :::::::::::::::::::: */
2970
2971 default:
2972 goto bad_1; /* :::::::::::::::::::: */
2973
2974 case FFELEX_typeEOS:
2975 case FFELEX_typeSEMICOLON:
2976 break;
2977 }
2978 ffesta_confirmed ();
2979 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlEND)
2980 {
2981 i = FFESTR_firstlEND;
2982 goto bad_i; /* :::::::::::::::::::: */
2983 }
2984 ffesta_tokens[1] = NULL;
2985 ffestb_args.endxyz.second = FFESTR_secondNone;
2986 return (ffelexHandler) ffestb_end3_ (t);
2987
2988 default:
2989 goto bad_0; /* :::::::::::::::::::: */
2990 }
2991
2992bad_0: /* :::::::::::::::::::: */
2993 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0]);
2994 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2995
2996bad_1: /* :::::::::::::::::::: */
2997 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
2998 return (ffelexHandler) ffelex_swallow_tokens (t,
2999 (ffelexHandler) ffesta_zero); /* Invalid second token. */
3000
3001bad_i: /* :::::::::::::::::::: */
3002 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0], i, t);
3003 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3004}
3005
3006/* ffestb_endxyz -- Parse an ENDxyz statement
3007
3008 return ffestb_endxyz; // to lexer
3009
3010 Expects len and second to be set in ffestb_args.endxyz to the length
3011 of the ENDxyz keyword involved and the corresponding ffestrSecond value. */
3012
3013ffelexHandler
3014ffestb_endxyz (ffelexToken t)
3015{
3016 ffeTokenLength i;
3017 char *p;
3018
3019 switch (ffelex_token_type (ffesta_tokens[0]))
3020 {
3021 case FFELEX_typeNAME:
3022 switch (ffelex_token_type (t))
3023 {
3024 case FFELEX_typeEOS:
3025 case FFELEX_typeSEMICOLON:
3026 ffesta_confirmed ();
3027 ffesta_tokens[1] = NULL;
3028 return (ffelexHandler) ffestb_end3_ (t);
3029
3030 case FFELEX_typeNAME:
3031 ffesta_confirmed ();
3032 switch (ffestb_args.endxyz.second)
3033 {
3034#if FFESTR_F90
3035 case FFESTR_secondINTERFACE:
3036#endif
3037#if FFESTR_VXT
3038 case FFESTR_secondMAP:
3039 case FFESTR_secondSTRUCTURE:
3040 case FFESTR_secondUNION:
3041#endif
3042#if FFESTR_F90
3043 case FFESTR_secondWHERE:
3044 goto bad_1; /* :::::::::::::::::::: */
3045#endif
3046
3047 case FFESTR_secondBLOCK:
3048 if (ffesta_second_kw != FFESTR_secondDATA)
3049 goto bad_1; /* :::::::::::::::::::: */
3050 return (ffelexHandler) ffestb_end2_;
3051
3052 default:
3053 return (ffelexHandler) ffestb_end2_ (t);
3054 }
3055
3056 case FFELEX_typeCOMMA:
3057 case FFELEX_typeCOLONCOLON:
3058 ffesta_confirmed (); /* Error, but clearly intended. */
3059 goto bad_1; /* :::::::::::::::::::: */
3060
3061 default:
3062 goto bad_1; /* :::::::::::::::::::: */
3063 }
3064
3065 case FFELEX_typeNAMES:
3066 switch (ffelex_token_type (t))
3067 {
3068 case FFELEX_typeCOMMA:
3069 case FFELEX_typeCOLONCOLON:
3070 ffesta_confirmed (); /* Error, but clearly intended. */
3071 goto bad_1; /* :::::::::::::::::::: */
3072
3073 default:
3074 goto bad_1; /* :::::::::::::::::::: */
3075
3076 case FFELEX_typeEOS:
3077 case FFELEX_typeSEMICOLON:
3078 break;
3079 }
3080 ffesta_confirmed ();
3081 if (ffestb_args.endxyz.second == FFESTR_secondBLOCK)
3082 {
3083 i = FFESTR_firstlEND;
3084 goto bad_i; /* :::::::::::::::::::: */
3085 }
3086 if (ffelex_token_length (ffesta_tokens[0]) != ffestb_args.endxyz.len)
3087 {
3088 p = ffelex_token_text (ffesta_tokens[0])
3089 + (i = ffestb_args.endxyz.len);
3090 switch (ffestb_args.endxyz.second)
3091 {
3092#if FFESTR_F90
3093 case FFESTR_secondINTERFACE:
3094#endif
3095#if FFESTR_VXT
3096 case FFESTR_secondMAP:
3097 case FFESTR_secondSTRUCTURE:
3098 case FFESTR_secondUNION:
3099#endif
3100#if FFESTR_F90
3101 case FFESTR_secondWHERE:
3102 goto bad_i; /* :::::::::::::::::::: */
3103#endif
3104
3105 default:
3106 break;
3107 }
3108 if (!ffesrc_is_name_init (*p))
3109 goto bad_i; /* :::::::::::::::::::: */
3110 ffesta_tokens[1]
3111 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
3112 return (ffelexHandler) ffestb_end3_ (t);
3113 }
3114 ffesta_tokens[1] = NULL;
3115 return (ffelexHandler) ffestb_end3_ (t);
3116
3117 default:
3118 goto bad_0; /* :::::::::::::::::::: */
3119 }
3120
3121bad_0: /* :::::::::::::::::::: */
3122 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0]);
3123 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3124
3125bad_1: /* :::::::::::::::::::: */
3126 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
3127 return (ffelexHandler) ffelex_swallow_tokens (t,
3128 (ffelexHandler) ffesta_zero); /* Invalid second token. */
3129
3130bad_i: /* :::::::::::::::::::: */
3131 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0], i, t);
3132 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3133}
3134
3135/* ffestb_end1_ -- "END" "BLOCK"
3136
3137 return ffestb_end1_; // to lexer
3138
3139 Make sure the next token is "DATA". */
3140
3141static ffelexHandler
3142ffestb_end1_ (ffelexToken t)
3143{
3144 if ((ffelex_token_type (t) == FFELEX_typeNAME)
3145 && (ffesrc_strcmp_2c (ffe_case_match (), ffelex_token_text (t), "DATA",
3146 "data", "Data")
3147 == 0))
3148 {
3149 return (ffelexHandler) ffestb_end2_;
3150 }
3151
3152 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
3153 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3154}
3155
3156/* ffestb_end2_ -- "END" <unit-kind>
3157
3158 return ffestb_end2_; // to lexer
3159
3160 Make sure the next token is a NAME or EOS. */
3161
3162static ffelexHandler
3163ffestb_end2_ (ffelexToken t)
3164{
3165 switch (ffelex_token_type (t))
3166 {
3167 case FFELEX_typeNAME:
3168 ffesta_tokens[1] = ffelex_token_use (t);
3169 return (ffelexHandler) ffestb_end3_;
3170
3171 case FFELEX_typeEOS:
3172 case FFELEX_typeSEMICOLON:
3173 ffesta_tokens[1] = NULL;
3174 return (ffelexHandler) ffestb_end3_ (t);
3175
3176 default:
3177 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
3178 return (ffelexHandler) ffelex_swallow_tokens (t,
3179 (ffelexHandler) ffesta_zero);
3180 }
3181}
3182
3183/* ffestb_end3_ -- "END" <unit-kind> (NAME)
3184
3185 return ffestb_end3_; // to lexer
3186
3187 Make sure the next token is an EOS, then implement the statement. */
3188
3189static ffelexHandler
3190ffestb_end3_ (ffelexToken t)
3191{
3192 switch (ffelex_token_type (t))
3193 {
3194 default:
3195 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
3196 if (ffesta_tokens[1] != NULL)
3197 ffelex_token_kill (ffesta_tokens[1]);
3198 return (ffelexHandler) ffelex_swallow_tokens (t,
3199 (ffelexHandler) ffesta_zero);
3200
3201 case FFELEX_typeEOS:
3202 case FFELEX_typeSEMICOLON:
3203 ffesta_confirmed ();
3204 if (ffestb_args.endxyz.second == FFESTR_secondNone)
3205 {
3206 if (!ffesta_is_inhibited ())
3207 ffestc_end ();
3208 return (ffelexHandler) ffesta_zero (t);
3209 }
3210 break;
3211 }
3212
3213 switch (ffestb_args.endxyz.second)
3214 {
3215#if FFESTR_F90
3216 case FFESTR_secondTYPE:
3217 if (!ffesta_is_inhibited ())
3218 ffestc_R425 (ffesta_tokens[1]);
3219 break;
3220#endif
3221
3222#if FFESTR_F90
3223 case FFESTR_secondWHERE:
3224 if (!ffesta_is_inhibited ())
3225 ffestc_R745 ();
3226 break;
3227#endif
3228
3229 case FFESTR_secondIF:
3230 if (!ffesta_is_inhibited ())
3231 ffestc_R806 (ffesta_tokens[1]);
3232 break;
3233
3234 case FFESTR_secondSELECT:
3235 if (!ffesta_is_inhibited ())
3236 ffestc_R811 (ffesta_tokens[1]);
3237 break;
3238
3239 case FFESTR_secondDO:
3240 if (!ffesta_is_inhibited ())
3241 ffestc_R825 (ffesta_tokens[1]);
3242 break;
3243
3244 case FFESTR_secondPROGRAM:
3245 if (!ffesta_is_inhibited ())
3246 ffestc_R1103 (ffesta_tokens[1]);
3247 break;
3248
3249#if FFESTR_F90
3250 case FFESTR_secondMODULE:
3251 if (!ffesta_is_inhibited ())
3252 ffestc_R1106 (ffesta_tokens[1]);
3253 break;
3254#endif
3255 case FFESTR_secondBLOCK:
3256 case FFESTR_secondBLOCKDATA:
3257 if (!ffesta_is_inhibited ())
3258 ffestc_R1112 (ffesta_tokens[1]);
3259 break;
3260
3261#if FFESTR_F90
3262 case FFESTR_secondINTERFACE:
3263 if (!ffesta_is_inhibited ())
3264 ffestc_R1203 ();
3265 break;
3266#endif
3267
3268 case FFESTR_secondFUNCTION:
3269 if (!ffesta_is_inhibited ())
3270 ffestc_R1221 (ffesta_tokens[1]);
3271 break;
3272
3273 case FFESTR_secondSUBROUTINE:
3274 if (!ffesta_is_inhibited ())
3275 ffestc_R1225 (ffesta_tokens[1]);
3276 break;
3277
3278#if FFESTR_VXT
3279 case FFESTR_secondSTRUCTURE:
3280 if (!ffesta_is_inhibited ())
3281 ffestc_V004 ();
3282 break;
3283#endif
3284
3285#if FFESTR_VXT
3286 case FFESTR_secondUNION:
3287 if (!ffesta_is_inhibited ())
3288 ffestc_V010 ();
3289 break;
3290#endif
3291
3292#if FFESTR_VXT
3293 case FFESTR_secondMAP:
3294 if (!ffesta_is_inhibited ())
3295 ffestc_V013 ();
3296 break;
3297#endif
3298
3299 default:
3300 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0]);
3301 if (ffesta_tokens[1] != NULL)
3302 ffelex_token_kill (ffesta_tokens[1]);
3303 return (ffelexHandler) ffelex_swallow_tokens (t,
3304 (ffelexHandler) ffesta_zero);
3305 }
3306
3307 if (ffesta_tokens[1] != NULL)
3308 ffelex_token_kill (ffesta_tokens[1]);
3309 return (ffelexHandler) ffesta_zero (t);
3310}
3311
3312/* ffestb_goto -- Parse the GOTO statement
3313
3314 return ffestb_goto; // to lexer
3315
3316 Make sure the statement has a valid form for the GOTO statement. If it
3317 does, implement the statement. */
3318
3319ffelexHandler
3320ffestb_goto (ffelexToken t)
3321{
3322 ffeTokenLength i;
3323 char *p;
3324 ffelexHandler next;
3325 ffelexToken nt;
3326
3327 switch (ffelex_token_type (ffesta_tokens[0]))
3328 {
3329 case FFELEX_typeNAME:
3330 switch (ffesta_first_kw)
3331 {
3332 case FFESTR_firstGO:
3333 if ((ffelex_token_type (t) != FFELEX_typeNAME)
3334 || (ffesta_second_kw != FFESTR_secondTO))
3335 goto bad_1; /* :::::::::::::::::::: */
3336 ffesta_confirmed ();
3337 return (ffelexHandler) ffestb_goto1_;
3338
3339 case FFESTR_firstGOTO:
3340 return (ffelexHandler) ffestb_goto1_ (t);
3341
3342 default:
3343 goto bad_0; /* :::::::::::::::::::: */
3344 }
3345
3346 case FFELEX_typeNAMES:
3347 if (ffesta_first_kw != FFESTR_firstGOTO)
3348 goto bad_0; /* :::::::::::::::::::: */
3349 switch (ffelex_token_type (t))
3350 {
3351 case FFELEX_typeCOLONCOLON:
3352 ffesta_confirmed (); /* Error, but clearly intended. */
3353 goto bad_1; /* :::::::::::::::::::: */
3354
3355 default:
3356 goto bad_1; /* :::::::::::::::::::: */
3357
3358 case FFELEX_typeOPEN_PAREN:
3359 case FFELEX_typePERCENT: /* Since GOTO I%J is apparently valid
3360 in '90. */
3361 case FFELEX_typeCOMMA:
3362 break;
3363
3364 case FFELEX_typeEOS:
3365 case FFELEX_typeSEMICOLON:
3366 ffesta_confirmed ();
3367 break;
3368 }
3369 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlGOTO)
3370 {
3371 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlGOTO);
3372 if (isdigit (*p))
3373 {
3374 nt = ffelex_token_number_from_names (ffesta_tokens[0], i);
3375 p += ffelex_token_length (nt);
3376 i += ffelex_token_length (nt);
3377 if (*p != '\0')
3378 {
3379 ffelex_token_kill (nt);
3380 goto bad_i; /* :::::::::::::::::::: */
3381 }
3382 }
3383 else if (ffesrc_is_name_init (*p))
3384 {
3385 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
3386 }
3387 else
3388 goto bad_i; /* :::::::::::::::::::: */
3389 next = (ffelexHandler) ffestb_goto1_ (nt);
3390 ffelex_token_kill (nt);
3391 return (ffelexHandler) (*next) (t);
3392 }
3393 return (ffelexHandler) ffestb_goto1_ (t);
3394
3395 default:
3396 goto bad_0; /* :::::::::::::::::::: */
3397 }
3398
3399bad_0: /* :::::::::::::::::::: */
3400 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "GO TO", ffesta_tokens[0]);
3401 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3402
3403bad_1: /* :::::::::::::::::::: */
3404 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "GO TO", t);
3405 return (ffelexHandler) ffelex_swallow_tokens (t,
3406 (ffelexHandler) ffesta_zero); /* Invalid second token. */
3407
3408bad_i: /* :::::::::::::::::::: */
3409 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "GO TO", ffesta_tokens[0], i, t);
3410 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3411}
3412
3413/* ffestb_goto1_ -- "GOTO" or "GO" "TO"
3414
3415 return ffestb_goto1_; // to lexer
3416
3417 Make sure the statement has a valid form for the GOTO statement. If it
3418 does, implement the statement. */
3419
3420static ffelexHandler
3421ffestb_goto1_ (ffelexToken t)
3422{
3423 switch (ffelex_token_type (t))
3424 {
3425 case FFELEX_typeNUMBER:
3426 if (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME)
3427 ffesta_confirmed ();
3428 ffesta_tokens[1] = ffelex_token_use (t);
3429 return (ffelexHandler) ffestb_goto2_;
3430
3431 case FFELEX_typeOPEN_PAREN:
3432 ffesta_tokens[1] = ffelex_token_use (t);
3433 ffestb_subrargs_.label_list.labels = ffestt_tokenlist_create ();
3434 ffestb_subrargs_.label_list.handler = (ffelexHandler) ffestb_goto3_;
3435 return (ffelexHandler) ffestb_subr_label_list_;
3436
3437 case FFELEX_typeNAME:
3438 if (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME)
3439 ffesta_confirmed ();
3440 return (ffelexHandler) (*((ffelexHandler)
3441 ffeexpr_lhs (ffesta_output_pool,
3442 FFEEXPR_contextAGOTO,
3443 (ffeexprCallback) ffestb_goto4_)))
3444 (t);
3445
3446 case FFELEX_typeEOS:
3447 case FFELEX_typeSEMICOLON:
3448 case FFELEX_typeCOMMA:
3449 case FFELEX_typeCOLONCOLON:
3450 ffesta_confirmed (); /* Error, but clearly intended. */
3451 break;
3452
3453 default:
3454 break;
3455 }
3456
3457 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "GO TO", t);
3458 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3459}
3460
3461/* ffestb_goto2_ -- "GO/TO" NUMBER
3462
3463 return ffestb_goto2_; // to lexer
3464
3465 Make sure the statement has a valid form for the GOTO statement. If it
3466 does, implement the statement. */
3467
3468static ffelexHandler
3469ffestb_goto2_ (ffelexToken t)
3470{
3471 switch (ffelex_token_type (t))
3472 {
3473 case FFELEX_typeEOS:
3474 case FFELEX_typeSEMICOLON:
3475 ffesta_confirmed ();
3476 if (!ffesta_is_inhibited ())
3477 ffestc_R836 (ffesta_tokens[1]);
3478 ffelex_token_kill (ffesta_tokens[1]);
3479 return (ffelexHandler) ffesta_zero (t);
3480
3481 default:
3482 break;
3483 }
3484
3485 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "GO TO", t);
3486 ffelex_token_kill (ffesta_tokens[1]);
3487 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3488}
3489
3490/* ffestb_goto3_ -- "GO/TO" OPEN_PAREN label-list CLOSE_PAREN
3491
3492 return ffestb_goto3_; // to lexer
3493
3494 Make sure the statement has a valid form for the GOTO statement. If it
3495 does, implement the statement. */
3496
3497static ffelexHandler
3498ffestb_goto3_ (ffelexToken t)
3499{
3500 if (!ffestb_subrargs_.label_list.ok)
3501 goto bad; /* :::::::::::::::::::: */
3502
3503 switch (ffelex_token_type (t))
3504 {
3505 case FFELEX_typeCOMMA:
3506 ffesta_confirmed ();
3507 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextCGOTO,
3508 (ffeexprCallback) ffestb_goto5_);
3509
3510 case FFELEX_typeEQUALS:
3511 case FFELEX_typePOINTS:
3512 case FFELEX_typeEOS:
3513 case FFELEX_typeSEMICOLON:
3514 break;
3515
3516 default:
3517 ffesta_confirmed ();
3518 /* Fall through. */
3519 case FFELEX_typeOPEN_PAREN: /* Could still be assignment!! */
3520 return (ffelexHandler) (*((ffelexHandler)
3521 ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextCGOTO,
3522 (ffeexprCallback) ffestb_goto5_)))
3523 (t);
3524 }
3525
3526bad: /* :::::::::::::::::::: */
3527 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "computed-GOTO", t);
3528 ffelex_token_kill (ffesta_tokens[1]);
3529 ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
3530 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3531}
3532
3533/* ffestb_goto4_ -- "GO/TO" expr
3534
3535 (ffestb_goto4_) // to expression handler
3536
3537 Make sure the statement has a valid form for the GOTO statement. If it
3538 does, implement the statement. */
3539
3540static ffelexHandler
3541ffestb_goto4_ (ffelexToken ft, ffebld expr, ffelexToken t)
3542{
3543 switch (ffelex_token_type (t))
3544 {
3545 case FFELEX_typeCOMMA:
3546 ffesta_confirmed ();
3547 if (expr == NULL)
3548 break;
3549 ffesta_tokens[1] = ffelex_token_use (ft);
3550 ffestb_local_.go_to.expr = expr;
3551 return (ffelexHandler) ffestb_goto6_;
3552
3553 case FFELEX_typeOPEN_PAREN:
3554 if (expr == NULL)
3555 break;
3556 ffesta_tokens[1] = ffelex_token_use (ft);
3557 ffestb_local_.go_to.expr = expr;
3558 return (ffelexHandler) ffestb_goto6_ (t);
3559
3560 case FFELEX_typeEOS:
3561 case FFELEX_typeSEMICOLON:
3562 ffesta_confirmed ();
3563 if (expr == NULL)
3564 break;
3565 if (!ffesta_is_inhibited ())
3566 ffestc_R839 (expr, ft, NULL);
3567 return (ffelexHandler) ffesta_zero (t);
3568
3569 default:
3570 break;
3571 }
3572
3573 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assigned-GOTO", t);
3574 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3575}
3576
3577/* ffestb_goto5_ -- "GO/TO" OPEN_PAREN label-list CLOSE_PAREN (COMMA) expr
3578
3579 (ffestb_goto5_) // to expression handler
3580
3581 Make sure the statement has a valid form for the GOTO statement. If it
3582 does, implement the statement. */
3583
3584static ffelexHandler
3585ffestb_goto5_ (ffelexToken ft, ffebld expr, ffelexToken t)
3586{
3587 switch (ffelex_token_type (t))
3588 {
3589 case FFELEX_typeEOS:
3590 case FFELEX_typeSEMICOLON:
3591 if (expr == NULL)
3592 break;
3593 ffesta_confirmed ();
3594 if (!ffesta_is_inhibited ())
3595 ffestc_R837 (ffestb_subrargs_.label_list.labels, expr, ft);
3596 ffelex_token_kill (ffesta_tokens[1]);
3597 ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
3598 return (ffelexHandler) ffesta_zero (t);
3599
3600 default:
3601 break;
3602 }
3603
3604 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "computed-GOTO", t);
3605 ffelex_token_kill (ffesta_tokens[1]);
3606 ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
3607 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3608}
3609
3610/* ffestb_goto6_ -- "GO/TO" expr (COMMA)
3611
3612 return ffestb_goto6_; // to lexer
3613
3614 Make sure the statement has a valid form for the GOTO statement. If it
3615 does, implement the statement. */
3616
3617static ffelexHandler
3618ffestb_goto6_ (ffelexToken t)
3619{
3620 switch (ffelex_token_type (t))
3621 {
3622 case FFELEX_typeOPEN_PAREN:
3623 ffesta_tokens[2] = ffelex_token_use (t);
3624 ffestb_subrargs_.label_list.labels = ffestt_tokenlist_create ();
3625 ffestb_subrargs_.label_list.handler = (ffelexHandler) ffestb_goto7_;
3626 return (ffelexHandler) ffestb_subr_label_list_;
3627
3628 default:
3629 break;
3630 }
3631
3632 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assigned-GOTO", t);
3633 ffelex_token_kill (ffesta_tokens[1]);
3634 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3635}
3636
3637/* ffestb_goto7_ -- "GO/TO" expr (COMMA) OPEN_PAREN label-list CLOSE_PAREN
3638
3639 return ffestb_goto7_; // to lexer
3640
3641 Make sure the statement has a valid form for the GOTO statement. If it
3642 does, implement the statement. */
3643
3644static ffelexHandler
3645ffestb_goto7_ (ffelexToken t)
3646{
3647 if (!ffestb_subrargs_.label_list.ok)
3648 goto bad; /* :::::::::::::::::::: */
3649
3650 switch (ffelex_token_type (t))
3651 {
3652 case FFELEX_typeEOS:
3653 case FFELEX_typeSEMICOLON:
3654 ffesta_confirmed ();
3655 if (!ffesta_is_inhibited ())
3656 ffestc_R839 (ffestb_local_.go_to.expr, ffesta_tokens[1],
3657 ffestb_subrargs_.label_list.labels);
3658 ffelex_token_kill (ffesta_tokens[1]);
3659 ffelex_token_kill (ffesta_tokens[2]);
3660 ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
3661 return (ffelexHandler) ffesta_zero (t);
3662
3663 default:
3664 break;
3665 }
3666
3667bad: /* :::::::::::::::::::: */
3668 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assigned-GOTO", t);
3669 ffelex_token_kill (ffesta_tokens[1]);
3670 ffelex_token_kill (ffesta_tokens[2]);
3671 ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
3672 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3673}
3674
3675/* ffestb_halt -- Parse the STOP/PAUSE statement
3676
3677 return ffestb_halt; // to lexer
3678
3679 Make sure the statement has a valid form for the STOP/PAUSE statement. If
3680 it does, implement the statement. */
3681
3682ffelexHandler
3683ffestb_halt (ffelexToken t)
3684{
3685 ffelexHandler next;
3686
3687 switch (ffelex_token_type (ffesta_tokens[0]))
3688 {
3689 case FFELEX_typeNAME:
3690 switch (ffelex_token_type (t))
3691 {
3692 case FFELEX_typeCOMMA:
3693 case FFELEX_typeCOLONCOLON:
3694 ffesta_confirmed (); /* Error, but clearly intended. */
3695 goto bad_1; /* :::::::::::::::::::: */
3696
3697 default:
3698 goto bad_1; /* :::::::::::::::::::: */
3699
3700 case FFELEX_typeEOS:
3701 case FFELEX_typeSEMICOLON:
3702 case FFELEX_typeNAME:
3703 case FFELEX_typeNUMBER:
3704 case FFELEX_typeAPOSTROPHE:
3705 case FFELEX_typeQUOTE:
3706 ffesta_confirmed ();
3707 break;
3708 }
3709
3710 return (ffelexHandler) (*((ffelexHandler)
3711 ffeexpr_rhs (ffesta_output_pool,
3712 FFEEXPR_contextSTOP,
3713 (ffeexprCallback) ffestb_halt1_)))
3714 (t);
3715
3716 case FFELEX_typeNAMES:
3717 switch (ffelex_token_type (t))
3718 {
3719 default:
3720 goto bad_1; /* :::::::::::::::::::: */
3721
3722 case FFELEX_typeEOS:
3723 case FFELEX_typeSEMICOLON:
3724 case FFELEX_typeNAME:
3725 case FFELEX_typeNUMBER:
3726 case FFELEX_typeAPOSTROPHE:
3727 case FFELEX_typeQUOTE:
3728 ffesta_confirmed ();
3729 break;
3730 }
3731 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
3732 FFEEXPR_contextSTOP,
3733 (ffeexprCallback) ffestb_halt1_);
3734 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
3735 ffestb_args.halt.len);
3736 if (next == NULL)
3737 return (ffelexHandler) ffelex_swallow_tokens (t,
3738 (ffelexHandler) ffesta_zero);
3739 return (ffelexHandler) (*next) (t);
3740
3741 default:
3742 goto bad_0; /* :::::::::::::::::::: */
3743 }
3744
3745bad_0: /* :::::::::::::::::::: */
3746 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
3747 (ffesta_first_kw == FFESTR_firstSTOP)
3748 ? "STOP" : "PAUSE",
3749 ffesta_tokens[0]);
3750 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3751
3752bad_1: /* :::::::::::::::::::: */
3753 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
3754 (ffesta_first_kw == FFESTR_firstSTOP)
3755 ? "STOP" : "PAUSE",
3756 t);
3757 return (ffelexHandler) ffelex_swallow_tokens (t,
3758 (ffelexHandler) ffesta_zero); /* Invalid second token. */
3759}
3760
3761/* ffestb_halt1_ -- "STOP/PAUSE" expr
3762
3763 (ffestb_halt1_) // to expression handler
3764
3765 Make sure the next token is an EOS or SEMICOLON. */
3766
3767static ffelexHandler
3768ffestb_halt1_ (ffelexToken ft, ffebld expr, ffelexToken t)
3769{
3770 switch (ffelex_token_type (t))
3771 {
3772 case FFELEX_typeEOS:
3773 case FFELEX_typeSEMICOLON:
3774 ffesta_confirmed ();
3775 if (!ffesta_is_inhibited ())
3776 if (ffesta_first_kw == FFESTR_firstSTOP)
3777 ffestc_R842 (expr, ft);
3778 else
3779 ffestc_R843 (expr, ft);
3780 return (ffelexHandler) ffesta_zero (t);
3781
3782 default:
3783 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
3784 (ffesta_first_kw == FFESTR_firstSTOP)
3785 ? "STOP" : "PAUSE",
3786 t);
3787 break;
3788 }
3789
3790 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3791}
3792
3793/* ffestb_if -- Parse an IF statement
3794
3795 return ffestb_if; // to lexer
3796
3797 Make sure the statement has a valid form for an IF statement.
3798 If it does, implement the statement. */
3799
3800ffelexHandler
3801ffestb_if (ffelexToken t)
3802{
3803 switch (ffelex_token_type (ffesta_tokens[0]))
3804 {
3805 case FFELEX_typeNAME:
3806 if (ffesta_first_kw != FFESTR_firstIF)
3807 goto bad_0; /* :::::::::::::::::::: */
3808 break;
3809
3810 case FFELEX_typeNAMES:
3811 if (ffesta_first_kw != FFESTR_firstIF)
3812 goto bad_0; /* :::::::::::::::::::: */
3813 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlIF)
3814 goto bad_0; /* :::::::::::::::::::: */
3815 break;
3816
3817 default:
3818 goto bad_0; /* :::::::::::::::::::: */
3819 }
3820
3821 switch (ffelex_token_type (t))
3822 {
3823 case FFELEX_typeOPEN_PAREN:
3824 break;
3825
3826 case FFELEX_typeEOS:
3827 case FFELEX_typeSEMICOLON:
3828 case FFELEX_typeCOMMA:
3829 case FFELEX_typeCOLONCOLON:
3830 ffesta_confirmed (); /* Error, but clearly intended. */
3831 goto bad_1; /* :::::::::::::::::::: */
3832
3833 default:
3834 goto bad_1; /* :::::::::::::::::::: */
3835 }
3836
3837 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextIF,
3838 (ffeexprCallback) ffestb_if1_);
3839
3840bad_0: /* :::::::::::::::::::: */
3841 if (ffesta_construct_name != NULL)
3842 {
3843 ffelex_token_kill (ffesta_construct_name);
3844 ffesta_construct_name = NULL;
3845 }
3846 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IF", ffesta_tokens[0]);
3847 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3848
3849bad_1: /* :::::::::::::::::::: */
3850 if (ffesta_construct_name != NULL)
3851 {
3852 ffelex_token_kill (ffesta_construct_name);
3853 ffesta_construct_name = NULL;
3854 }
3855 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IF", t);
3856 return (ffelexHandler) ffelex_swallow_tokens (t,
3857 (ffelexHandler) ffesta_zero); /* Invalid second token. */
3858}
3859
3860/* ffestb_if1_ -- "IF" OPEN_PAREN expr
3861
3862 (ffestb_if1_) // to expression handler
3863
3864 Make sure the next token is CLOSE_PAREN. */
3865
3866static ffelexHandler
3867ffestb_if1_ (ffelexToken ft, ffebld expr, ffelexToken t)
3868{
3869 ffestb_local_.if_stmt.expr = expr;
3870
3871 switch (ffelex_token_type (t))
3872 {
3873 case FFELEX_typeCLOSE_PAREN:
3874 if (expr == NULL)
3875 break;
3876 ffesta_tokens[1] = ffelex_token_use (ft);
3877 ffelex_set_names (TRUE);
3878 return (ffelexHandler) ffestb_if2_;
3879
3880 default:
3881 break;
3882 }
3883
3884 if (ffesta_construct_name != NULL)
3885 {
3886 ffelex_token_kill (ffesta_construct_name);
3887 ffesta_construct_name = NULL;
3888 }
3889 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IF", t);
3890 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3891}
3892
3893/* ffestb_if2_ -- "IF" OPEN_PAREN expr CLOSE_PAREN
3894
3895 return ffestb_if2_; // to lexer
3896
3897 Make sure the next token is NAME. */
3898
3899static ffelexHandler
3900ffestb_if2_ (ffelexToken t)
3901{
3902 ffelex_set_names (FALSE);
3903
3904 switch (ffelex_token_type (t))
3905 {
3906 case FFELEX_typeNAME:
3907 case FFELEX_typeNAMES:
3908 ffesta_confirmed ();
3909 ffesta_tokens[2] = ffelex_token_use (t);
3910 return (ffelexHandler) ffestb_if3_;
3911
3912 default:
3913 break;
3914 }
3915
3916 ffelex_token_kill (ffesta_tokens[1]);
3917 if ((ffesta_construct_name == NULL)
3918 || (ffelex_token_type (t) != FFELEX_typeNUMBER))
3919 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IF", t);
3920 else
3921 ffesta_ffebad_2st (FFEBAD_INVALID_STMT_FORM, "CONSTRUCT",
3922 ffesta_construct_name, t);
3923 if (ffesta_construct_name != NULL)
3924 {
3925 ffelex_token_kill (ffesta_construct_name);
3926 ffesta_construct_name = NULL;
3927 }
3928 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3929}
3930
3931/* ffestb_if3_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NAME
3932
3933 return ffestb_if3_; // to lexer
3934
3935 If the next token is EOS or SEMICOLON and the preceding NAME was "THEN",
3936 implement R803. Else, implement R807 and send the preceding NAME followed
3937 by the current token. */
3938
3939static ffelexHandler
3940ffestb_if3_ (ffelexToken t)
3941{
3942 ffelexHandler next;
3943
3944 switch (ffelex_token_type (t))
3945 {
3946 case FFELEX_typeEOS:
3947 case FFELEX_typeSEMICOLON:
3948 if (ffestr_first (ffesta_tokens[2]) == FFESTR_firstTHEN)
3949 {
3950 if (!ffesta_is_inhibited ())
3951 ffestc_R803 (ffesta_construct_name, ffestb_local_.if_stmt.expr,
3952 ffesta_tokens[1]);
3953 ffelex_token_kill (ffesta_tokens[1]);
3954 ffelex_token_kill (ffesta_tokens[2]);
3955 if (ffesta_construct_name != NULL)
3956 {
3957 ffelex_token_kill (ffesta_construct_name);
3958 ffesta_construct_name = NULL;
3959 }
3960 return (ffelexHandler) ffesta_zero (t);
3961 }
3962 break;
3963
3964 default:
3965 break;
3966 }
3967
3968 if (ffesta_construct_name != NULL)
3969 {
3970 if (!ffesta_is_inhibited ())
3971 ffesta_ffebad_2st (FFEBAD_INVALID_STMT_FORM, "CONSTRUCT",
3972 ffesta_construct_name, ffesta_tokens[2]);
3973 ffelex_token_kill (ffesta_construct_name);
3974 ffesta_construct_name = NULL;
3975 ffelex_token_kill (ffesta_tokens[1]);
3976 ffelex_token_kill (ffesta_tokens[2]);
3977 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3978 }
3979
3980 if (!ffesta_is_inhibited ())
3981 ffestc_R807 (ffestb_local_.if_stmt.expr, ffesta_tokens[1]);
3982 ffelex_token_kill (ffesta_tokens[1]);
3983 {
3984 ffelexToken my_2 = ffesta_tokens[2];
3985
3986 next = (ffelexHandler) ffesta_two (my_2, t);
3987 ffelex_token_kill (my_2);
3988 }
3989 return (ffelexHandler) next;
3990}
3991
3992/* ffestb_where -- Parse a WHERE statement
3993
3994 return ffestb_where; // to lexer
3995
3996 Make sure the statement has a valid form for a WHERE statement.
3997 If it does, implement the statement. */
3998
3999#if FFESTR_F90
4000ffelexHandler
4001ffestb_where (ffelexToken t)
4002{
4003 switch (ffelex_token_type (ffesta_tokens[0]))
4004 {
4005 case FFELEX_typeNAME:
4006 if (ffesta_first_kw != FFESTR_firstWHERE)
4007 goto bad_0; /* :::::::::::::::::::: */
4008 break;
4009
4010 case FFELEX_typeNAMES:
4011 if (ffesta_first_kw != FFESTR_firstWHERE)
4012 goto bad_0; /* :::::::::::::::::::: */
4013 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlWHERE)
4014 goto bad_0; /* :::::::::::::::::::: */
4015 break;
4016
4017 default:
4018 goto bad_0; /* :::::::::::::::::::: */
4019 }
4020
4021 switch (ffelex_token_type (t))
4022 {
4023 case FFELEX_typeOPEN_PAREN:
4024 break;
4025
4026 case FFELEX_typeEOS:
4027 case FFELEX_typeSEMICOLON:
4028 case FFELEX_typeCOMMA:
4029 case FFELEX_typeCOLONCOLON:
4030 ffesta_confirmed (); /* Error, but clearly intended. */
4031 goto bad_1; /* :::::::::::::::::::: */
4032
4033 default:
4034 goto bad_1; /* :::::::::::::::::::: */
4035 }
4036
4037 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextWHERE,
4038 (ffeexprCallback) ffestb_where1_);
4039
4040bad_0: /* :::::::::::::::::::: */
4041 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", ffesta_tokens[0]);
4042 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4043
4044bad_1: /* :::::::::::::::::::: */
4045 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", t);
4046 return (ffelexHandler) ffelex_swallow_tokens (t,
4047 (ffelexHandler) ffesta_zero); /* Invalid second token. */
4048}
4049
4050#endif
4051/* ffestb_where1_ -- "WHERE" OPEN_PAREN expr
4052
4053 (ffestb_where1_) // to expression handler
4054
4055 Make sure the next token is CLOSE_PAREN. */
4056
4057#if FFESTR_F90
4058static ffelexHandler
4059ffestb_where1_ (ffelexToken ft, ffebld expr, ffelexToken t)
4060{
4061 ffestb_local_.if_stmt.expr = expr;
4062
4063 switch (ffelex_token_type (t))
4064 {
4065 case FFELEX_typeCLOSE_PAREN:
4066 if (expr == NULL)
4067 break;
4068 ffesta_tokens[1] = ffelex_token_use (ft);
4069 ffelex_set_names (TRUE);
4070 return (ffelexHandler) ffestb_where2_;
4071
4072 default:
4073 break;
4074 }
4075
4076 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", t);
4077 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4078}
4079
4080#endif
4081/* ffestb_where2_ -- "WHERE" OPEN_PAREN expr CLOSE_PAREN
4082
4083 return ffestb_where2_; // to lexer
4084
4085 Make sure the next token is NAME. */
4086
4087#if FFESTR_F90
4088static ffelexHandler
4089ffestb_where2_ (ffelexToken t)
4090{
4091 ffelex_set_names (FALSE);
4092
4093 switch (ffelex_token_type (t))
4094 {
4095 case FFELEX_typeNAME:
4096 case FFELEX_typeNAMES:
4097 ffesta_confirmed ();
4098 ffesta_tokens[2] = ffelex_token_use (t);
4099 return (ffelexHandler) ffestb_where3_;
4100
4101 case FFELEX_typeEOS:
4102 case FFELEX_typeSEMICOLON:
4103 ffesta_confirmed ();
4104 if (!ffesta_is_inhibited ())
4105 ffestc_R742 (ffestb_local_.if_stmt.expr, ffesta_tokens[1]);
4106 ffelex_token_kill (ffesta_tokens[1]);
4107 return (ffelexHandler) ffesta_zero (t);
4108
4109 default:
4110 break;
4111 }
4112
4113 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", t);
4114 ffelex_token_kill (ffesta_tokens[1]);
4115 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4116}
4117
4118#endif
4119/* ffestb_where3_ -- "WHERE" OPEN_PAREN expr CLOSE_PAREN NAME
4120
4121 return ffestb_where3_; // to lexer
4122
4123 Implement R742. */
4124
4125#if FFESTR_F90
4126static ffelexHandler
4127ffestb_where3_ (ffelexToken t)
4128{
4129 ffelexHandler next;
4130 ffelexToken my_2 = ffesta_tokens[2];
4131
4132 if (!ffesta_is_inhibited ())
4133 ffestc_R740 (ffestb_local_.if_stmt.expr, ffesta_tokens[1]);
4134 ffelex_token_kill (ffesta_tokens[1]);
4135 next = (ffelexHandler) ffesta_two (my_2, t);
4136 ffelex_token_kill (my_2);
4137 return (ffelexHandler) next;
4138}
4139
4140#endif
4141/* ffestb_let -- Parse an assignment statement
4142
4143 return ffestb_let; // to lexer
4144
4145 Make sure the statement has a valid form for an assignment statement. If
4146 it does, implement the statement. */
4147
4148ffelexHandler
4149ffestb_let (ffelexToken t)
4150{
4151 ffelexHandler next;
4152 bool vxtparam; /* TRUE if it might really be a VXT PARAMETER
4153 stmt. */
4154 char *p;
4155
4156 switch (ffelex_token_type (ffesta_tokens[0]))
4157 {
4158 case FFELEX_typeNAME:
4159 vxtparam = FALSE;
4160 break;
4161
4162 case FFELEX_typeNAMES:
4163 vxtparam = TRUE;
4164 break;
4165
4166 default:
4167 goto bad_0; /* :::::::::::::::::::: */
4168 }
4169
4170 switch (ffelex_token_type (t))
4171 {
4172 case FFELEX_typeOPEN_PAREN:
4173 case FFELEX_typePERCENT:
4174 case FFELEX_typePOINTS:
4175 ffestb_local_.let.vxtparam = FALSE;
4176 break;
4177
4178 case FFELEX_typeEQUALS:
4179 if (!vxtparam || (ffesta_first_kw != FFESTR_firstPARAMETER))
4180 {
4181 ffestb_local_.let.vxtparam = FALSE;
4182 break;
4183 }
4184 p = ffelex_token_text (ffesta_tokens[0]) + FFESTR_firstlPARAMETER;
4185 ffestb_local_.let.vxtparam = ffesrc_is_name_init (*p);
4186 break;
4187
4188 default:
4189 goto bad_1; /* :::::::::::::::::::: */
4190 }
4191
4192 next = (ffelexHandler) (*((ffelexHandler)
4193 ffeexpr_lhs (ffesta_output_pool,
4194 FFEEXPR_contextLET,
4195 (ffeexprCallback) ffestb_let1_)))
4196 (ffesta_tokens[0]);
4197 return (ffelexHandler) (*next) (t);
4198
4199bad_0: /* :::::::::::::::::::: */
4200 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assignment", ffesta_tokens[0]);
4201 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4202
4203bad_1: /* :::::::::::::::::::: */
4204 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assignment", t);
4205 return (ffelexHandler) ffelex_swallow_tokens (t,
4206 (ffelexHandler) ffesta_zero); /* Invalid second token. */
4207}
4208
4209/* ffestb_let1_ -- expr
4210
4211 (ffestb_let1_) // to expression handler
4212
4213 Make sure the next token is EQUALS or POINTS. */
4214
4215static ffelexHandler
4216ffestb_let1_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
4217{
4218 ffestb_local_.let.dest = expr;
4219
4220 switch (ffelex_token_type (t))
4221 {
4222#if FFESTR_F90
4223 case FFELEX_typePOINTS:
4224#endif
4225 case FFELEX_typeEQUALS:
4226 if (expr == NULL)
4227 break;
4228 ffesta_tokens[1] = ffelex_token_use (t);
4229 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
4230 FFEEXPR_contextLET, (ffeexprCallback) ffestb_let2_);
4231
4232 default:
4233 break;
4234 }
4235
4236 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assignment", t);
4237 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4238}
4239
4240/* ffestb_let2_ -- expr EQUALS/POINTS expr
4241
4242 (ffestb_end2_) // to expression handler
4243
4244 Make sure the next token is EOS or SEMICOLON; implement the statement. */
4245
4246static ffelexHandler
4247ffestb_let2_ (ffelexToken ft, ffebld expr, ffelexToken t)
4248{
4249 switch (ffelex_token_type (t))
4250 {
4251 case FFELEX_typeEOS:
4252 case FFELEX_typeSEMICOLON:
4253 if (expr == NULL)
4254 break;
4255 if (ffestb_local_.let.vxtparam && !ffestc_is_let_not_V027 ())
4256 break;
4257 ffesta_confirmed ();
4258 if (!ffesta_is_inhibited ())
4259#if FFESTR_F90
4260 if (ffelex_token_type (ffesta_tokens[1]) == FFELEX_typeEQUALS)
4261#endif
4262 ffestc_let (ffestb_local_.let.dest, expr, ft);
4263#if FFESTR_F90
4264 else
4265 ffestc_R738 (ffestb_local_.let.dest, expr, ft);
4266#endif
4267 ffelex_token_kill (ffesta_tokens[1]);
4268 return (ffelexHandler) ffesta_zero (t);
4269
4270 default:
4271 break;
4272 }
4273
4274 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
4275 (ffelex_token_type (ffesta_tokens[1]) == FFELEX_typeEQUALS)
4276 ? "assignment" : "pointer-assignment",
4277 t);
4278 ffelex_token_kill (ffesta_tokens[1]);
4279 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4280}
4281
4282/* ffestb_type -- Parse the TYPE statement
4283
4284 return ffestb_type; // to lexer
4285
4286 Make sure the statement has a valid form for the TYPE statement. If
4287 it does, implement the statement. */
4288
4289#if FFESTR_F90
4290ffelexHandler
4291ffestb_type (ffelexToken t)
4292{
4293 ffeTokenLength i;
4294 char *p;
4295
4296 switch (ffelex_token_type (ffesta_tokens[0]))
4297 {
4298 case FFELEX_typeNAME:
4299 if (ffesta_first_kw != FFESTR_firstTYPE)
4300 goto bad_0; /* :::::::::::::::::::: */
4301 switch (ffelex_token_type (t))
4302 {
4303 case FFELEX_typeEOS:
4304 case FFELEX_typeSEMICOLON:
4305 case FFELEX_typeCOLONCOLON:
4306 ffesta_confirmed (); /* Error, but clearly intended. */
4307 goto bad_1; /* :::::::::::::::::::: */
4308
4309 default:
4310 goto bad_1; /* :::::::::::::::::::: */
4311
4312 case FFELEX_typeCOMMA:
4313 ffesta_confirmed ();
4314 return (ffelexHandler) ffestb_type1_;
4315
4316 case FFELEX_typeNAME: /* No confirm here, because ambig w/V020 VXT
4317 TYPE. */
4318 ffesta_tokens[1] = NULL;
4319 ffesta_tokens[2] = ffelex_token_use (t);
4320 return (ffelexHandler) ffestb_type4_;
4321 }
4322
4323 case FFELEX_typeNAMES:
4324 if (ffesta_first_kw != FFESTR_firstTYPE)
4325 goto bad_0; /* :::::::::::::::::::: */
4326 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlTYPE);
4327 switch (ffelex_token_type (t))
4328 {
4329 default:
4330 goto bad_1; /* :::::::::::::::::::: */
4331
4332 case FFELEX_typeCOMMA:
4333 if (*p != '\0')
4334 goto bad_i; /* :::::::::::::::::::: */
4335 ffesta_confirmed ();
4336 ffelex_set_names (TRUE);
4337 return (ffelexHandler) ffestb_type1_;
4338
4339 case FFELEX_typeEOS:
4340 case FFELEX_typeSEMICOLON:
4341 break;
4342 }
4343 if (!ffesrc_is_name_init (*p))
4344 goto bad_i; /* :::::::::::::::::::: */
4345 ffesta_tokens[1] = NULL;
4346 ffesta_tokens[2]
4347 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
4348 return (ffelexHandler) ffestb_type4_ (t);
4349
4350 default:
4351 goto bad_0; /* :::::::::::::::::::: */
4352 }
4353
4354bad_0: /* :::::::::::::::::::: */
4355 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", ffesta_tokens[0]);
4356 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4357
4358bad_1: /* :::::::::::::::::::: */
4359 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
4360 return (ffelexHandler) ffelex_swallow_tokens (t,
4361 (ffelexHandler) ffesta_zero); /* Invalid second token. */
4362
4363bad_i: /* :::::::::::::::::::: */
4364 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "TYPE", ffesta_tokens[0], i, t);
4365 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4366}
4367
4368/* ffestb_type1_ -- "TYPE" COMMA
4369
4370 return ffestb_type1_; // to lexer
4371
4372 Make sure the next token is a NAME. */
4373
4374static ffelexHandler
4375ffestb_type1_ (ffelexToken t)
4376{
4377 ffeTokenLength i;
4378 char *p;
4379
4380 ffelex_set_names (FALSE);
4381
4382 switch (ffelex_token_type (t))
4383 {
4384 case FFELEX_typeNAME:
4385 ffesta_tokens[1] = ffelex_token_use (t);
4386 ffestb_local_.type.kw = ffestr_other (t);
4387 switch (ffestb_local_.varlist.kw)
4388 {
4389 case FFESTR_otherPUBLIC:
4390 case FFESTR_otherPRIVATE:
4391 return (ffelexHandler) ffestb_type2_;
4392
4393 default:
4394 ffelex_token_kill (ffesta_tokens[1]);
4395 break;
4396 }
4397 break;
4398
4399 case FFELEX_typeNAMES:
4400 ffesta_tokens[1] = ffelex_token_use (t);
4401 ffestb_local_.type.kw = ffestr_other (t);
4402 switch (ffestb_local_.varlist.kw)
4403 {
4404 case FFESTR_otherPUBLIC:
4405 p = ffelex_token_text (t) + (i = FFESTR_otherlPUBLIC);
4406 if (*p == '\0')
4407 return (ffelexHandler) ffestb_type2_;
4408 if (!ffesrc_is_name_init (*p))
4409 goto bad_i1; /* :::::::::::::::::::: */
4410 ffesta_tokens[2] = ffelex_token_name_from_names (t, i, 0);
4411 return (ffelexHandler) ffestb_type4_;
4412
4413 case FFESTR_otherPRIVATE:
4414 p = ffelex_token_text (t) + (i = FFESTR_otherlPRIVATE);
4415 if (*p == '\0')
4416 return (ffelexHandler) ffestb_type2_;
4417 if (!ffesrc_is_name_init (*p))
4418 goto bad_i1; /* :::::::::::::::::::: */
4419 ffesta_tokens[2] = ffelex_token_name_from_names (t, i, 0);
4420 return (ffelexHandler) ffestb_type4_;
4421
4422 default:
4423 ffelex_token_kill (ffesta_tokens[1]);
4424 break;
4425 }
4426 break;
4427
4428 default:
4429 break;
4430 }
4431
4432 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
4433 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4434
4435bad_i1: /* :::::::::::::::::::: */
4436 ffelex_token_kill (ffesta_tokens[1]);
4437 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "TYPE", t, i, NULL);
4438 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4439}
4440
4441/* ffestb_type2_ -- "TYPE" COMMA NAME
4442
4443 return ffestb_type2_; // to lexer
4444
4445 Handle COLONCOLON or NAME. */
4446
4447static ffelexHandler
4448ffestb_type2_ (ffelexToken t)
4449{
4450 switch (ffelex_token_type (t))
4451 {
4452 case FFELEX_typeCOLONCOLON:
4453 return (ffelexHandler) ffestb_type3_;
4454
4455 case FFELEX_typeNAME:
4456 return (ffelexHandler) ffestb_type3_ (t);
4457
4458 default:
4459 break;
4460 }
4461
4462 if (ffesta_tokens[1] != NULL)
4463 ffelex_token_kill (ffesta_tokens[1]);
4464 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
4465 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4466}
4467
4468/* ffestb_type3_ -- "TYPE" [COMMA NAME [COLONCOLON]]
4469
4470 return ffestb_type3_; // to lexer
4471
4472 Make sure the next token is a NAME. */
4473
4474static ffelexHandler
4475ffestb_type3_ (ffelexToken t)
4476{
4477 switch (ffelex_token_type (t))
4478 {
4479 case FFELEX_typeNAME:
4480 ffesta_tokens[2] = ffelex_token_use (t);
4481 return (ffelexHandler) ffestb_type4_;
4482
4483 default:
4484 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
4485 break;
4486 }
4487
4488 if (ffesta_tokens[1] != NULL)
4489 ffelex_token_kill (ffesta_tokens[1]);
4490 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4491}
4492
4493/* ffestb_type4_ -- "TYPE" [COMMA NAME [COLONCOLON]] NAME
4494
4495 return ffestb_type4_; // to lexer
4496
4497 Make sure the next token is an EOS or SEMICOLON. */
4498
4499static ffelexHandler
4500ffestb_type4_ (ffelexToken t)
4501{
4502 switch (ffelex_token_type (t))
4503 {
4504 case FFELEX_typeEOS:
4505 case FFELEX_typeSEMICOLON:
4506 ffesta_confirmed ();
4507 if (!ffesta_is_inhibited ())
4508 ffestc_R424 (ffesta_tokens[1], ffestb_local_.type.kw,
4509 ffesta_tokens[2]);
4510 if (ffesta_tokens[1] != NULL)
4511 ffelex_token_kill (ffesta_tokens[1]);
4512 ffelex_token_kill (ffesta_tokens[2]);
4513 return (ffelexHandler) ffesta_zero (t);
4514
4515 default:
4516 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
4517 break;
4518 }
4519
4520 if (ffesta_tokens[1] != NULL)
4521 ffelex_token_kill (ffesta_tokens[1]);
4522 ffelex_token_kill (ffesta_tokens[2]);
4523 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4524}
4525
4526#endif
4527/* ffestb_varlist -- Parse EXTERNAL/INTENT/INTRINSIC/OPTIONAL/PUBLIC/PRIVATE
4528 statement
4529
4530 return ffestb_varlist; // to lexer
4531
4532 Make sure the statement has a valid form. If it
4533 does, implement the statement. */
4534
4535ffelexHandler
4536ffestb_varlist (ffelexToken t)
4537{
4538 ffeTokenLength i;
4539 char *p;
4540 ffelexToken nt;
4541 ffelexHandler next;
4542
4543 switch (ffelex_token_type (ffesta_tokens[0]))
4544 {
4545 case FFELEX_typeNAME:
4546 switch (ffelex_token_type (t))
4547 {
4548 case FFELEX_typeEOS:
4549 case FFELEX_typeSEMICOLON:
4550 ffesta_confirmed ();
4551 switch (ffesta_first_kw)
4552 {
4553#if FFESTR_F90
4554 case FFESTR_firstPUBLIC:
4555 if (!ffesta_is_inhibited ())
4556 ffestc_R521A ();
4557 return (ffelexHandler) ffesta_zero (t);
4558
4559 case FFESTR_firstPRIVATE:
4560 if (!ffesta_is_inhibited ())
4561 ffestc_private (); /* Either R523A or R521B. */
4562 return (ffelexHandler) ffesta_zero (t);
4563#endif
4564
4565 default:
4566 goto bad_1; /* :::::::::::::::::::: */
4567 }
4568
4569 case FFELEX_typeCOMMA:
4570 ffesta_confirmed (); /* Error, but clearly intended. */
4571 goto bad_1; /* :::::::::::::::::::: */
4572
4573 case FFELEX_typeCOLONCOLON:
4574 ffesta_confirmed ();
4575 switch (ffesta_first_kw)
4576 {
4577#if FFESTR_F90
4578 case FFESTR_firstOPTIONAL:
4579 if (!ffesta_is_inhibited ())
4580 ffestc_R520_start ();
4581 break;
4582
4583 case FFESTR_firstPUBLIC:
4584 if (!ffesta_is_inhibited ())
4585 ffestc_R521Astart ();
4586 break;
4587
4588 case FFESTR_firstPRIVATE:
4589 if (!ffesta_is_inhibited ())
4590 ffestc_R521Bstart ();
4591 break;
4592#endif
4593
4594 default:
4595 ffesta_confirmed (); /* Error, but clearly intended. */
4596 goto bad_1; /* :::::::::::::::::::: */
4597 }
4598 return (ffelexHandler) ffestb_varlist5_;
4599
4600 default:
4601 goto bad_1; /* :::::::::::::::::::: */
4602
4603 case FFELEX_typeOPEN_PAREN:
4604 switch (ffesta_first_kw)
4605 {
4606#if FFESTR_F90
4607 case FFESTR_firstINTENT:
4608 return (ffelexHandler) ffestb_varlist1_;
4609#endif
4610
4611 default:
4612 goto bad_1; /* :::::::::::::::::::: */
4613 }
4614
4615 case FFELEX_typeNAME:
4616 ffesta_confirmed ();
4617 switch (ffesta_first_kw)
4618 {
4619 case FFESTR_firstEXTERNAL:
4620 if (!ffesta_is_inhibited ())
4621 ffestc_R1207_start ();
4622 break;
4623
4624#if FFESTR_F90
4625 case FFESTR_firstINTENT:
4626 goto bad_1; /* :::::::::::::::::::: */
4627#endif
4628
4629 case FFESTR_firstINTRINSIC:
4630 if (!ffesta_is_inhibited ())
4631 ffestc_R1208_start ();
4632 break;
4633
4634#if FFESTR_F90
4635 case FFESTR_firstOPTIONAL:
4636 if (!ffesta_is_inhibited ())
4637 ffestc_R520_start ();
4638 break;
4639#endif
4640
4641#if FFESTR_F90
4642 case FFESTR_firstPUBLIC:
4643 if (!ffesta_is_inhibited ())
4644 ffestc_R521Astart ();
4645 break;
4646
4647 case FFESTR_firstPRIVATE:
4648 if (!ffesta_is_inhibited ())
4649 ffestc_R521Bstart ();
4650 break;
4651#endif
4652
4653 default:
4654 break;
4655 }
4656 return (ffelexHandler) ffestb_varlist5_ (t);
4657 }
4658
4659 case FFELEX_typeNAMES:
4660 p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.varlist.len);
4661 switch (ffelex_token_type (t))
4662 {
4663 case FFELEX_typeEOS:
4664 case FFELEX_typeSEMICOLON:
4665 ffesta_confirmed ();
4666 switch (ffesta_first_kw)
4667 {
4668#if FFESTR_F90
4669 case FFESTR_firstINTENT:
4670 goto bad_1; /* :::::::::::::::::::: */
4671#endif
4672
4673 default:
4674 break;
4675 }
4676 if (*p != '\0')
4677 break;
4678 switch (ffesta_first_kw)
4679 {
4680#if FFESTR_F90
4681 case FFESTR_firstPUBLIC:
4682 if (!ffesta_is_inhibited ())
4683 ffestc_R521A ();
4684 return (ffelexHandler) ffesta_zero (t);
4685
4686 case FFESTR_firstPRIVATE:
4687 if (!ffesta_is_inhibited ())
4688 ffestc_private (); /* Either R423A or R521B. */
4689 return (ffelexHandler) ffesta_zero (t);
4690#endif
4691
4692 default:
4693 goto bad_1; /* :::::::::::::::::::: */
4694 }
4695
4696 case FFELEX_typeCOMMA:
4697 ffesta_confirmed (); /* Error, but clearly intended. */
4698 switch (ffesta_first_kw)
4699 {
4700#if FFESTR_F90
4701 case FFESTR_firstINTENT:
4702 goto bad_1; /* :::::::::::::::::::: */
4703#endif
4704
4705 default:
4706 break;
4707 }
4708 if (*p != '\0')
4709 break;
4710 goto bad_1; /* :::::::::::::::::::: */
4711
4712 case FFELEX_typeCOLONCOLON:
4713 ffesta_confirmed ();
4714 switch (ffesta_first_kw)
4715 {
4716#if FFESTR_F90
4717 case FFESTR_firstOPTIONAL:
4718 if (!ffesta_is_inhibited ())
4719 ffestc_R520_start ();
4720 break;
4721#endif
4722
4723#if FFESTR_F90
4724 case FFESTR_firstPUBLIC:
4725 if (!ffesta_is_inhibited ())
4726 ffestc_R521Astart ();
4727 break;
4728
4729 case FFESTR_firstPRIVATE:
4730 if (!ffesta_is_inhibited ())
4731 ffestc_R521Bstart ();
4732 break;
4733#endif
4734
4735 default:
4736 goto bad_1; /* :::::::::::::::::::: */
4737 }
4738 return (ffelexHandler) ffestb_varlist5_;
4739
4740 case FFELEX_typeOPEN_PAREN:
4741 switch (ffesta_first_kw)
4742 {
4743#if FFESTR_F90
4744 case FFESTR_firstINTENT:
4745 if (*p != '\0')
4746 goto bad_1; /* :::::::::::::::::::: */
4747 return (ffelexHandler) ffestb_varlist1_;
4748#endif
4749
4750 default:
4751 goto bad_1; /* :::::::::::::::::::: */
4752 }
4753
4754 case FFELEX_typeNAME:
4755 ffesta_confirmed ();
4756 switch (ffesta_first_kw)
4757 {
4758 case FFESTR_firstEXTERNAL:
4759 if (!ffesta_is_inhibited ())
4760 ffestc_R1207_start ();
4761 break;
4762
4763#if FFESTR_F90
4764 case FFESTR_firstINTENT:
4765 goto bad_1; /* :::::::::::::::::::: */
4766#endif
4767
4768 case FFESTR_firstINTRINSIC:
4769 if (!ffesta_is_inhibited ())
4770 ffestc_R1208_start ();
4771 break;
4772
4773#if FFESTR_F90
4774 case FFESTR_firstOPTIONAL:
4775 if (!ffesta_is_inhibited ())
4776 ffestc_R520_start ();
4777 break;
4778#endif
4779
4780#if FFESTR_F90
4781 case FFESTR_firstPUBLIC:
4782 if (!ffesta_is_inhibited ())
4783 ffestc_R521Astart ();
4784 break;
4785
4786 case FFESTR_firstPRIVATE:
4787 if (!ffesta_is_inhibited ())
4788 ffestc_R521Bstart ();
4789 break;
4790#endif
4791
4792 default:
4793 break;
4794 }
4795 return (ffelexHandler) ffestb_varlist5_ (t);
4796
4797 default:
4798 goto bad_1; /* :::::::::::::::::::: */
4799 }
4800
4801 /* Here, we have at least one char after the first keyword and t is
4802 COMMA or EOS/SEMICOLON. Also we know that this form is valid for
4803 only the statements reaching here (specifically, INTENT won't reach
4804 here). */
4805
4806 if (!ffesrc_is_name_init (*p))
4807 goto bad_i; /* :::::::::::::::::::: */
4808 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
4809 if (!ffesta_is_inhibited ())
4810 {
4811 switch (ffesta_first_kw)
4812 {
4813 case FFESTR_firstEXTERNAL:
4814 ffestc_R1207_start ();
4815 break;
4816
4817 case FFESTR_firstINTRINSIC:
4818 ffestc_R1208_start ();
4819 break;
4820
4821#if FFESTR_F90
4822 case FFESTR_firstOPTIONAL:
4823 ffestc_R520_start ();
4824 break;
4825#endif
4826
4827#if FFESTR_F90
4828 case FFESTR_firstPUBLIC:
4829 ffestc_R521Astart ();
4830 break;
4831
4832 case FFESTR_firstPRIVATE:
4833 ffestc_R521Bstart ();
4834 break;
4835#endif
4836
4837 default:
4838 assert (FALSE);
4839 }
4840 }
4841 next = (ffelexHandler) ffestb_varlist5_ (nt);
4842 ffelex_token_kill (nt);
4843 return (ffelexHandler) (*next) (t);
4844
4845 default:
4846 goto bad_0; /* :::::::::::::::::::: */
4847 }
4848
4849bad_0: /* :::::::::::::::::::: */
4850 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, ffesta_tokens[0]);
4851 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4852
4853bad_1: /* :::::::::::::::::::: */
4854 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
4855 return (ffelexHandler) ffelex_swallow_tokens (t,
4856 (ffelexHandler) ffesta_zero); /* Invalid second token. */
4857
4858bad_i: /* :::::::::::::::::::: */
4859 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, ffesta_tokens[0], i, t);
4860 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4861}
4862
4863/* ffestb_varlist1_ -- "INTENT" OPEN_PAREN
4864
4865 return ffestb_varlist1_; // to lexer
4866
4867 Handle NAME. */
4868
4869#if FFESTR_F90
4870static ffelexHandler
4871ffestb_varlist1_ (ffelexToken t)
4872{
4873 switch (ffelex_token_type (t))
4874 {
4875 case FFELEX_typeNAME:
4876 ffesta_tokens[1] = ffelex_token_use (t);
4877 ffestb_local_.varlist.kw = ffestr_other (t);
4878 switch (ffestb_local_.varlist.kw)
4879 {
4880 case FFESTR_otherIN:
4881 return (ffelexHandler) ffestb_varlist2_;
4882
4883 case FFESTR_otherINOUT:
4884 return (ffelexHandler) ffestb_varlist3_;
4885
4886 case FFESTR_otherOUT:
4887 return (ffelexHandler) ffestb_varlist3_;
4888
4889 default:
4890 ffelex_token_kill (ffesta_tokens[1]);
4891 break;
4892 }
4893 break;
4894
4895 default:
4896 break;
4897 }
4898
4899 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
4900 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4901}
4902
4903/* ffestb_varlist2_ -- "INTENT" OPEN_PAREN "IN"
4904
4905 return ffestb_varlist2_; // to lexer
4906
4907 Handle NAME. */
4908
4909static ffelexHandler
4910ffestb_varlist2_ (ffelexToken t)
4911{
4912 switch (ffelex_token_type (t))
4913 {
4914 case FFELEX_typeNAME:
4915 switch (ffestr_other (t))
4916 {
4917 case FFESTR_otherOUT:
4918 ffestb_local_.varlist.kw = FFESTR_otherINOUT;
4919 return (ffelexHandler) ffestb_varlist3_;
4920
4921 default:
4922 break;
4923 }
4924 break;
4925
4926 case FFELEX_typeCLOSE_PAREN:
4927 return (ffelexHandler) ffestb_varlist4_;
4928
4929 default:
4930 break;
4931 }
4932
4933 ffelex_token_kill (ffesta_tokens[1]);
4934 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
4935 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4936}
4937
4938/* ffestb_varlist3_ -- "INTENT" OPEN_PAREN NAME ["OUT"]
4939
4940 return ffestb_varlist3_; // to lexer
4941
4942 Handle CLOSE_PAREN. */
4943
4944static ffelexHandler
4945ffestb_varlist3_ (ffelexToken t)
4946{
4947 switch (ffelex_token_type (t))
4948 {
4949 case FFELEX_typeCLOSE_PAREN:
4950 return (ffelexHandler) ffestb_varlist4_;
4951
4952 default:
4953 break;
4954 }
4955
4956 ffelex_token_kill (ffesta_tokens[1]);
4957 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
4958 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4959}
4960
4961/* ffestb_varlist4_ -- "INTENT" OPEN_PAREN NAME ["OUT"] CLOSE_PAREN
4962
4963 return ffestb_varlist4_; // to lexer
4964
4965 Handle COLONCOLON or NAME. */
4966
4967static ffelexHandler
4968ffestb_varlist4_ (ffelexToken t)
4969{
4970 switch (ffelex_token_type (t))
4971 {
4972 case FFELEX_typeCOLONCOLON:
4973 ffesta_confirmed ();
4974 if (!ffesta_is_inhibited ())
4975 ffestc_R519_start (ffesta_tokens[1], ffestb_local_.varlist.kw);
4976 ffelex_token_kill (ffesta_tokens[1]);
4977 return (ffelexHandler) ffestb_varlist5_;
4978
4979 case FFELEX_typeNAME:
4980 ffesta_confirmed ();
4981 if (!ffesta_is_inhibited ())
4982 ffestc_R519_start (ffesta_tokens[1], ffestb_local_.varlist.kw);
4983 ffelex_token_kill (ffesta_tokens[1]);
4984 return (ffelexHandler) ffestb_varlist5_ (t);
4985
4986 default:
4987 break;
4988 }
4989
4990 ffelex_token_kill (ffesta_tokens[1]);
4991 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
4992 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4993}
4994
4995#endif
4996/* ffestb_varlist5_ -- Handles the list of variable names
4997
4998 return ffestb_varlist5_; // to lexer
4999
5000 Handle NAME. */
5001
5002static ffelexHandler
5003ffestb_varlist5_ (ffelexToken t)
5004{
5005 switch (ffelex_token_type (t))
5006 {
5007 case FFELEX_typeNAME:
5008 ffesta_tokens[1] = ffelex_token_use (t);
5009 return (ffelexHandler) ffestb_varlist6_;
5010
5011 default:
5012 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
5013 break;
5014 }
5015
5016 if (!ffesta_is_inhibited ())
5017 {
5018 switch (ffesta_first_kw)
5019 {
5020 case FFESTR_firstEXTERNAL:
5021 ffestc_R1207_finish ();
5022 break;
5023
5024#if FFESTR_F90
5025 case FFESTR_firstINTENT:
5026 ffestc_R519_finish ();
5027 break;
5028#endif
5029
5030 case FFESTR_firstINTRINSIC:
5031 ffestc_R1208_finish ();
5032 break;
5033
5034#if FFESTR_F90
5035 case FFESTR_firstOPTIONAL:
5036 ffestc_R520_finish ();
5037 break;
5038#endif
5039
5040#if FFESTR_F90
5041 case FFESTR_firstPUBLIC:
5042 ffestc_R521Afinish ();
5043 break;
5044
5045 case FFESTR_firstPRIVATE:
5046 ffestc_R521Bfinish ();
5047 break;
5048#endif
5049
5050 default:
5051 assert (FALSE);
5052 }
5053 }
5054 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5055}
5056
5057/* ffestb_varlist6_ -- (whatever) NAME
5058
5059 return ffestb_varlist6_; // to lexer
5060
5061 Handle COMMA or EOS/SEMICOLON. */
5062
5063static ffelexHandler
5064ffestb_varlist6_ (ffelexToken t)
5065{
5066 switch (ffelex_token_type (t))
5067 {
5068 case FFELEX_typeCOMMA:
5069 if (!ffesta_is_inhibited ())
5070 {
5071 switch (ffesta_first_kw)
5072 {
5073 case FFESTR_firstEXTERNAL:
5074 ffestc_R1207_item (ffesta_tokens[1]);
5075 break;
5076
5077#if FFESTR_F90
5078 case FFESTR_firstINTENT:
5079 ffestc_R519_item (ffesta_tokens[1]);
5080 break;
5081#endif
5082
5083 case FFESTR_firstINTRINSIC:
5084 ffestc_R1208_item (ffesta_tokens[1]);
5085 break;
5086
5087#if FFESTR_F90
5088 case FFESTR_firstOPTIONAL:
5089 ffestc_R520_item (ffesta_tokens[1]);
5090 break;
5091#endif
5092
5093#if FFESTR_F90
5094 case FFESTR_firstPUBLIC:
5095 ffestc_R521Aitem (ffesta_tokens[1]);
5096 break;
5097
5098 case FFESTR_firstPRIVATE:
5099 ffestc_R521Bitem (ffesta_tokens[1]);
5100 break;
5101#endif
5102
5103 default:
5104 assert (FALSE);
5105 }
5106 }
5107 ffelex_token_kill (ffesta_tokens[1]);
5108 return (ffelexHandler) ffestb_varlist5_;
5109
5110 case FFELEX_typeEOS:
5111 case FFELEX_typeSEMICOLON:
5112 if (!ffesta_is_inhibited ())
5113 {
5114 switch (ffesta_first_kw)
5115 {
5116 case FFESTR_firstEXTERNAL:
5117 ffestc_R1207_item (ffesta_tokens[1]);
5118 ffestc_R1207_finish ();
5119 break;
5120
5121#if FFESTR_F90
5122 case FFESTR_firstINTENT:
5123 ffestc_R519_item (ffesta_tokens[1]);
5124 ffestc_R519_finish ();
5125 break;
5126#endif
5127
5128 case FFESTR_firstINTRINSIC:
5129 ffestc_R1208_item (ffesta_tokens[1]);
5130 ffestc_R1208_finish ();
5131 break;
5132
5133#if FFESTR_F90
5134 case FFESTR_firstOPTIONAL:
5135 ffestc_R520_item (ffesta_tokens[1]);
5136 ffestc_R520_finish ();
5137 break;
5138#endif
5139
5140#if FFESTR_F90
5141 case FFESTR_firstPUBLIC:
5142 ffestc_R521Aitem (ffesta_tokens[1]);
5143 ffestc_R521Afinish ();
5144 break;
5145
5146 case FFESTR_firstPRIVATE:
5147 ffestc_R521Bitem (ffesta_tokens[1]);
5148 ffestc_R521Bfinish ();
5149 break;
5150#endif
5151
5152 default:
5153 assert (FALSE);
5154 }
5155 }
5156 ffelex_token_kill (ffesta_tokens[1]);
5157 return (ffelexHandler) ffesta_zero (t);
5158
5159 default:
5160 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
5161 break;
5162 }
5163
5164 if (!ffesta_is_inhibited ())
5165 {
5166 switch (ffesta_first_kw)
5167 {
5168 case FFESTR_firstEXTERNAL:
5169 ffestc_R1207_finish ();
5170 break;
5171
5172#if FFESTR_F90
5173 case FFESTR_firstINTENT:
5174 ffestc_R519_finish ();
5175 break;
5176#endif
5177
5178 case FFESTR_firstINTRINSIC:
5179 ffestc_R1208_finish ();
5180 break;
5181
5182#if FFESTR_F90
5183 case FFESTR_firstOPTIONAL:
5184 ffestc_R520_finish ();
5185 break;
5186#endif
5187
5188#if FFESTR_F90
5189 case FFESTR_firstPUBLIC:
5190 ffestc_R521Afinish ();
5191 break;
5192
5193 case FFESTR_firstPRIVATE:
5194 ffestc_R521Bfinish ();
5195 break;
5196#endif
5197
5198 default:
5199 assert (FALSE);
5200 }
5201 }
5202 ffelex_token_kill (ffesta_tokens[1]);
5203 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5204}
5205
5206/* ffestb_R423B -- Parse the SEQUENCE statement
5207
5208 return ffestb_R423B; // to lexer
5209
5210 Make sure the statement has a valid form for the SEQUENCE statement. If
5211 it does, implement the statement. */
5212
5213#if FFESTR_F90
5214ffelexHandler
5215ffestb_R423B (ffelexToken t)
5216{
5217 char *p;
5218 ffeTokenLength i;
5219
5220 switch (ffelex_token_type (ffesta_tokens[0]))
5221 {
5222 case FFELEX_typeNAME:
5223 if (ffesta_first_kw != FFESTR_firstSEQUENCE)
5224 goto bad_0; /* :::::::::::::::::::: */
5225 break;
5226
5227 case FFELEX_typeNAMES:
5228 if (ffesta_first_kw != FFESTR_firstSEQUENCE)
5229 goto bad_0; /* :::::::::::::::::::: */
5230 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlSEQUENCE)
5231 {
5232 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSEQUENCE);
5233 goto bad_i; /* :::::::::::::::::::: */
5234 }
5235 break;
5236
5237 default:
5238 goto bad_0; /* :::::::::::::::::::: */
5239 }
5240
5241 switch (ffelex_token_type (t))
5242 {
5243 case FFELEX_typeEOS:
5244 case FFELEX_typeSEMICOLON:
5245 ffesta_confirmed ();
5246 if (!ffesta_is_inhibited ())
5247 ffestc_R423B ();
5248 return (ffelexHandler) ffesta_zero (t);
5249
5250 case FFELEX_typeCOMMA:
5251 case FFELEX_typeCOLONCOLON:
5252 ffesta_confirmed (); /* Error, but clearly intended. */
5253 goto bad_1; /* :::::::::::::::::::: */
5254
5255 default:
5256 goto bad_1; /* :::::::::::::::::::: */
5257 }
5258
5259bad_0: /* :::::::::::::::::::: */
5260 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SEQUENCE", ffesta_tokens[0]);
5261 return (ffelexHandler) ffelex_swallow_tokens (t,
5262 (ffelexHandler) ffesta_zero); /* Invalid first token. */
5263
5264bad_1: /* :::::::::::::::::::: */
5265 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SEQUENCE", t);
5266 return (ffelexHandler) ffelex_swallow_tokens (t,
5267 (ffelexHandler) ffesta_zero); /* Invalid second token. */
5268
5269bad_i: /* :::::::::::::::::::: */
5270 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "SEQUENCE", ffesta_tokens[0], i, t);
5271 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5272}
5273
5274#endif
5275/* ffestb_R522 -- Parse the SAVE statement
5276
5277 return ffestb_R522; // to lexer
5278
5279 Make sure the statement has a valid form for the SAVE statement. If it
5280 does, implement the statement. */
5281
5282ffelexHandler
5283ffestb_R522 (ffelexToken t)
5284{
5285 ffeTokenLength i;
5286 char *p;
5287 ffelexToken nt;
5288 ffelexHandler next;
5289
5290 switch (ffelex_token_type (ffesta_tokens[0]))
5291 {
5292 case FFELEX_typeNAME:
5293 if (ffesta_first_kw != FFESTR_firstSAVE)
5294 goto bad_0; /* :::::::::::::::::::: */
5295 switch (ffelex_token_type (t))
5296 {
5297 case FFELEX_typeCOMMA:
5298 ffesta_confirmed (); /* Error, but clearly intended. */
5299 goto bad_1; /* :::::::::::::::::::: */
5300
5301 default:
5302 goto bad_1; /* :::::::::::::::::::: */
5303
5304 case FFELEX_typeEOS:
5305 case FFELEX_typeSEMICOLON:
5306 ffesta_confirmed ();
5307 if (!ffesta_is_inhibited ())
5308 ffestc_R522 ();
5309 return (ffelexHandler) ffesta_zero (t);
5310
5311 case FFELEX_typeNAME:
5312 case FFELEX_typeSLASH:
5313 ffesta_confirmed ();
5314 if (!ffesta_is_inhibited ())
5315 ffestc_R522start ();
5316 return (ffelexHandler) ffestb_R5221_ (t);
5317
5318 case FFELEX_typeCOLONCOLON:
5319 ffesta_confirmed ();
5320 if (!ffesta_is_inhibited ())
5321 ffestc_R522start ();
5322 return (ffelexHandler) ffestb_R5221_;
5323 }
5324
5325 case FFELEX_typeNAMES:
5326 if (ffesta_first_kw != FFESTR_firstSAVE)
5327 goto bad_0; /* :::::::::::::::::::: */
5328 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSAVE);
5329 switch (ffelex_token_type (t))
5330 {
5331 default:
5332 goto bad_1; /* :::::::::::::::::::: */
5333
5334 case FFELEX_typeCOMMA:
5335 ffesta_confirmed ();
5336 break;
5337
5338 case FFELEX_typeEOS:
5339 case FFELEX_typeSEMICOLON:
5340 ffesta_confirmed ();
5341 if (*p != '\0')
5342 break;
5343 if (!ffesta_is_inhibited ())
5344 ffestc_R522 ();
5345 return (ffelexHandler) ffesta_zero (t);
5346
5347 case FFELEX_typeSLASH:
5348 ffesta_confirmed ();
5349 if (*p != '\0')
5350 goto bad_i; /* :::::::::::::::::::: */
5351 if (!ffesta_is_inhibited ())
5352 ffestc_R522start ();
5353 return (ffelexHandler) ffestb_R5221_ (t);
5354
5355 case FFELEX_typeCOLONCOLON:
5356 ffesta_confirmed ();
5357 if (*p != '\0')
5358 goto bad_i; /* :::::::::::::::::::: */
5359 if (!ffesta_is_inhibited ())
5360 ffestc_R522start ();
5361 return (ffelexHandler) ffestb_R5221_;
5362 }
5363
5364 /* Here, we have at least one char after "SAVE" and t is COMMA or
5365 EOS/SEMICOLON. */
5366
5367 if (!ffesrc_is_name_init (*p))
5368 goto bad_i; /* :::::::::::::::::::: */
5369 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
5370 if (!ffesta_is_inhibited ())
5371 ffestc_R522start ();
5372 next = (ffelexHandler) ffestb_R5221_ (nt);
5373 ffelex_token_kill (nt);
5374 return (ffelexHandler) (*next) (t);
5375
5376 default:
5377 goto bad_0; /* :::::::::::::::::::: */
5378 }
5379
5380bad_0: /* :::::::::::::::::::: */
5381 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", ffesta_tokens[0]);
5382 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5383
5384bad_1: /* :::::::::::::::::::: */
5385 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
5386 return (ffelexHandler) ffelex_swallow_tokens (t,
5387 (ffelexHandler) ffesta_zero); /* Invalid second token. */
5388
5389bad_i: /* :::::::::::::::::::: */
5390 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "SAVE", ffesta_tokens[0], i, t);
5391 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5392}
5393
5394/* ffestb_R5221_ -- "SAVE" [COLONCOLON]
5395
5396 return ffestb_R5221_; // to lexer
5397
5398 Handle NAME or SLASH. */
5399
5400static ffelexHandler
5401ffestb_R5221_ (ffelexToken t)
5402{
5403 switch (ffelex_token_type (t))
5404 {
5405 case FFELEX_typeNAME:
5406 ffestb_local_.R522.is_cblock = FALSE;
5407 ffesta_tokens[1] = ffelex_token_use (t);
5408 return (ffelexHandler) ffestb_R5224_;
5409
5410 case FFELEX_typeSLASH:
5411 ffestb_local_.R522.is_cblock = TRUE;
5412 return (ffelexHandler) ffestb_R5222_;
5413
5414 default:
5415 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
5416 break;
5417 }
5418
5419 if (!ffesta_is_inhibited ())
5420 ffestc_R522finish ();
5421 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5422}
5423
5424/* ffestb_R5222_ -- "SAVE" [COLONCOLON] SLASH
5425
5426 return ffestb_R5222_; // to lexer
5427
5428 Handle NAME. */
5429
5430static ffelexHandler
5431ffestb_R5222_ (ffelexToken t)
5432{
5433 switch (ffelex_token_type (t))
5434 {
5435 case FFELEX_typeNAME:
5436 ffesta_tokens[1] = ffelex_token_use (t);
5437 return (ffelexHandler) ffestb_R5223_;
5438
5439 default:
5440 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
5441 break;
5442 }
5443
5444 if (!ffesta_is_inhibited ())
5445 ffestc_R522finish ();
5446 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5447}
5448
5449/* ffestb_R5223_ -- "SAVE" [COLONCOLON] SLASH NAME
5450
5451 return ffestb_R5223_; // to lexer
5452
5453 Handle SLASH. */
5454
5455static ffelexHandler
5456ffestb_R5223_ (ffelexToken t)
5457{
5458 switch (ffelex_token_type (t))
5459 {
5460 case FFELEX_typeSLASH:
5461 return (ffelexHandler) ffestb_R5224_;
5462
5463 default:
5464 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
5465 break;
5466 }
5467
5468 if (!ffesta_is_inhibited ())
5469 ffestc_R522finish ();
5470 ffelex_token_kill (ffesta_tokens[1]);
5471 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5472}
5473
5474/* ffestb_R5224_ -- "SAVE" [COLONCOLON] R523
5475
5476 return ffestb_R5224_; // to lexer
5477
5478 Handle COMMA or EOS/SEMICOLON. */
5479
5480static ffelexHandler
5481ffestb_R5224_ (ffelexToken t)
5482{
5483 switch (ffelex_token_type (t))
5484 {
5485 case FFELEX_typeCOMMA:
5486 if (!ffesta_is_inhibited ())
5487 {
5488 if (ffestb_local_.R522.is_cblock)
5489 ffestc_R522item_cblock (ffesta_tokens[1]);
5490 else
5491 ffestc_R522item_object (ffesta_tokens[1]);
5492 }
5493 ffelex_token_kill (ffesta_tokens[1]);
5494 return (ffelexHandler) ffestb_R5221_;
5495
5496 case FFELEX_typeEOS:
5497 case FFELEX_typeSEMICOLON:
5498 if (!ffesta_is_inhibited ())
5499 {
5500 if (ffestb_local_.R522.is_cblock)
5501 ffestc_R522item_cblock (ffesta_tokens[1]);
5502 else
5503 ffestc_R522item_object (ffesta_tokens[1]);
5504 ffestc_R522finish ();
5505 }
5506 ffelex_token_kill (ffesta_tokens[1]);
5507 return (ffelexHandler) ffesta_zero (t);
5508
5509 default:
5510 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
5511 break;
5512 }
5513
5514 if (!ffesta_is_inhibited ())
5515 ffestc_R522finish ();
5516 ffelex_token_kill (ffesta_tokens[1]);
5517 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5518}
5519
5520/* ffestb_R528 -- Parse the DATA statement
5521
5522 return ffestb_R528; // to lexer
5523
5524 Make sure the statement has a valid form for the DATA statement. If it
5525 does, implement the statement. */
5526
5527ffelexHandler
5528ffestb_R528 (ffelexToken t)
5529{
5530 char *p;
5531 ffeTokenLength i;
5532 ffelexToken nt;
5533 ffelexHandler next;
5534
5535 switch (ffelex_token_type (ffesta_tokens[0]))
5536 {
5537 case FFELEX_typeNAME:
5538 if (ffesta_first_kw != FFESTR_firstDATA)
5539 goto bad_0; /* :::::::::::::::::::: */
5540 switch (ffelex_token_type (t))
5541 {
5542 case FFELEX_typeCOMMA:
5543 case FFELEX_typeEOS:
5544 case FFELEX_typeSEMICOLON:
5545 case FFELEX_typeSLASH:
5546 case FFELEX_typeCOLONCOLON:
5547 ffesta_confirmed (); /* Error, but clearly intended. */
5548 goto bad_1; /* :::::::::::::::::::: */
5549
5550 default:
5551 goto bad_1; /* :::::::::::::::::::: */
5552
5553 case FFELEX_typeNAME:
5554 ffesta_confirmed ();
5555 break;
5556
5557 case FFELEX_typeOPEN_PAREN:
5558 break;
5559 }
5560 ffestb_local_.data.started = FALSE;
5561 return (ffelexHandler) (*((ffelexHandler)
5562 ffeexpr_lhs (ffesta_output_pool,
5563 FFEEXPR_contextDATA,
5564 (ffeexprCallback) ffestb_R5281_)))
5565 (t);
5566
5567 case FFELEX_typeNAMES:
5568 if (ffesta_first_kw != FFESTR_firstDATA)
5569 goto bad_0; /* :::::::::::::::::::: */
5570 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDATA);
5571 switch (ffelex_token_type (t))
5572 {
5573 case FFELEX_typeEOS:
5574 case FFELEX_typeSEMICOLON:
5575 case FFELEX_typeCOLONCOLON:
5576 ffesta_confirmed (); /* Error, but clearly intended. */
5577 goto bad_1; /* :::::::::::::::::::: */
5578
5579 default:
5580 goto bad_1; /* :::::::::::::::::::: */
5581
5582 case FFELEX_typeOPEN_PAREN:
5583 if (*p == '\0')
5584 {
5585 ffestb_local_.data.started = FALSE;
5586 return (ffelexHandler) (*((ffelexHandler)
5587 ffeexpr_lhs (ffesta_output_pool,
5588 FFEEXPR_contextDATA,
5589 (ffeexprCallback)
5590 ffestb_R5281_)))
5591 (t);
5592 }
5593 break;
5594
5595 case FFELEX_typeCOMMA:
5596 case FFELEX_typeSLASH:
5597 ffesta_confirmed ();
5598 break;
5599 }
5600 if (!ffesrc_is_name_init (*p))
5601 goto bad_i; /* :::::::::::::::::::: */
5602 ffestb_local_.data.started = FALSE;
5603 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
5604 next = (ffelexHandler) (*((ffelexHandler)
5605 ffeexpr_lhs (ffesta_output_pool,
5606 FFEEXPR_contextDATA,
5607 (ffeexprCallback) ffestb_R5281_)))
5608 (nt);
5609 ffelex_token_kill (nt);
5610 return (ffelexHandler) (*next) (t);
5611
5612 default:
5613 goto bad_0; /* :::::::::::::::::::: */
5614 }
5615
5616bad_0: /* :::::::::::::::::::: */
5617 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", ffesta_tokens[0]);
5618 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5619
5620bad_1: /* :::::::::::::::::::: */
5621 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
5622 return (ffelexHandler) ffelex_swallow_tokens (t,
5623 (ffelexHandler) ffesta_zero); /* Invalid second token. */
5624
5625bad_i: /* :::::::::::::::::::: */
5626 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DATA", ffesta_tokens[0], i, t);
5627 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5628}
5629
5630/* ffestb_R5281_ -- "DATA" expr-list
5631
5632 (ffestb_R5281_) // to expression handler
5633
5634 Handle COMMA or SLASH. */
5635
5636static ffelexHandler
5637ffestb_R5281_ (ffelexToken ft, ffebld expr, ffelexToken t)
5638{
5639 switch (ffelex_token_type (t))
5640 {
5641 case FFELEX_typeCOMMA:
5642 ffesta_confirmed ();
5643 if (expr == NULL)
5644 break;
5645 if (!ffesta_is_inhibited ())
5646 {
5647 if (!ffestb_local_.data.started)
5648 {
5649 ffestc_R528_start ();
5650 ffestb_local_.data.started = TRUE;
5651 }
5652 ffestc_R528_item_object (expr, ft);
5653 }
5654 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
5655 FFEEXPR_contextDATA,
5656 (ffeexprCallback) ffestb_R5281_);
5657
5658 case FFELEX_typeSLASH:
5659 ffesta_confirmed ();
5660 if (expr == NULL)
5661 break;
5662 if (!ffesta_is_inhibited ())
5663 {
5664 if (!ffestb_local_.data.started)
5665 {
5666 ffestc_R528_start ();
5667 ffestb_local_.data.started = TRUE;
5668 }
5669 ffestc_R528_item_object (expr, ft);
5670 ffestc_R528_item_startvals ();
5671 }
5672 return (ffelexHandler) ffeexpr_rhs
5673 (ffesta_output_pool, FFEEXPR_contextDATA,
5674 (ffeexprCallback) ffestb_R5282_);
5675
5676 default:
5677 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
5678 break;
5679 }
5680
5681 if (ffestb_local_.data.started && !ffesta_is_inhibited ())
5682 ffestc_R528_finish ();
5683 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5684}
5685
5686/* ffestb_R5282_ -- "DATA" expr-list SLASH expr-list
5687
5688 (ffestb_R5282_) // to expression handler
5689
5690 Handle ASTERISK, COMMA, or SLASH. */
5691
5692static ffelexHandler
5693ffestb_R5282_ (ffelexToken ft, ffebld expr, ffelexToken t)
5694{
5695 switch (ffelex_token_type (t))
5696 {
5697 case FFELEX_typeCOMMA:
5698 if (expr == NULL)
5699 break;
5700 if (!ffesta_is_inhibited ())
5701 ffestc_R528_item_value (NULL, NULL, expr, ft);
5702 return (ffelexHandler) ffeexpr_rhs
5703 (ffesta_output_pool, FFEEXPR_contextDATA,
5704 (ffeexprCallback) ffestb_R5282_);
5705
5706 case FFELEX_typeASTERISK:
5707 if (expr == NULL)
5708 break;
5709 ffestb_local_.data.expr = expr;
5710 ffesta_tokens[1] = ffelex_token_use (ft);
5711 return (ffelexHandler) ffeexpr_rhs
5712 (ffesta_output_pool, FFEEXPR_contextDATA,
5713 (ffeexprCallback) ffestb_R5283_);
5714
5715 case FFELEX_typeSLASH:
5716 if (expr == NULL)
5717 break;
5718 if (!ffesta_is_inhibited ())
5719 {
5720 ffestc_R528_item_value (NULL, NULL, expr, ft);
5721 ffestc_R528_item_endvals (t);
5722 }
5723 return (ffelexHandler) ffestb_R5284_;
5724
5725 default:
5726 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
5727 break;
5728 }
5729
5730 if (!ffesta_is_inhibited ())
5731 {
5732 ffestc_R528_item_endvals (t);
5733 ffestc_R528_finish ();
5734 }
5735 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5736}
5737
5738/* ffestb_R5283_ -- "DATA" expr-list SLASH expr ASTERISK expr
5739
5740 (ffestb_R5283_) // to expression handler
5741
5742 Handle COMMA or SLASH. */
5743
5744static ffelexHandler
5745ffestb_R5283_ (ffelexToken ft, ffebld expr, ffelexToken t)
5746{
5747 switch (ffelex_token_type (t))
5748 {
5749 case FFELEX_typeCOMMA:
5750 if (expr == NULL)
5751 break;
5752 if (!ffesta_is_inhibited ())
5753 ffestc_R528_item_value (ffestb_local_.data.expr, ffesta_tokens[1],
5754 expr, ft);
5755 ffelex_token_kill (ffesta_tokens[1]);
5756 return (ffelexHandler) ffeexpr_rhs
5757 (ffesta_output_pool, FFEEXPR_contextDATA,
5758 (ffeexprCallback) ffestb_R5282_);
5759
5760 case FFELEX_typeSLASH:
5761 if (expr == NULL)
5762 break;
5763 if (!ffesta_is_inhibited ())
5764 {
5765 ffestc_R528_item_value (ffestb_local_.data.expr, ffesta_tokens[1],
5766 expr, ft);
5767 ffestc_R528_item_endvals (t);
5768 }
5769 ffelex_token_kill (ffesta_tokens[1]);
5770 return (ffelexHandler) ffestb_R5284_;
5771
5772 default:
5773 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
5774 break;
5775 }
5776
5777 if (!ffesta_is_inhibited ())
5778 {
5779 ffestc_R528_item_endvals (t);
5780 ffestc_R528_finish ();
5781 }
5782 ffelex_token_kill (ffesta_tokens[1]);
5783 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5784}
5785
5786/* ffestb_R5284_ -- "DATA" expr-list SLASH expr-list SLASH
5787
5788 return ffestb_R5284_; // to lexer
5789
5790 Handle [COMMA] NAME or EOS/SEMICOLON. */
5791
5792static ffelexHandler
5793ffestb_R5284_ (ffelexToken t)
5794{
5795 switch (ffelex_token_type (t))
5796 {
5797 case FFELEX_typeCOMMA:
5798 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
5799 FFEEXPR_contextDATA,
5800 (ffeexprCallback) ffestb_R5281_);
5801
5802 case FFELEX_typeNAME:
795232f7 5803 case FFELEX_typeOPEN_PAREN:
5ff904cd
JL		 5804 return (ffelexHandler) (*((ffelexHandler)
5805 ffeexpr_lhs (ffesta_output_pool,
5806 FFEEXPR_contextDATA,
5807 (ffeexprCallback) ffestb_R5281_)))
5808 (t);
5809
5810 case FFELEX_typeEOS:
5811 case FFELEX_typeSEMICOLON:
5812 if (!ffesta_is_inhibited ())
5813 ffestc_R528_finish ();
5814 return (ffelexHandler) ffesta_zero (t);
5815
5816 default:
5817 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
5818 break;
5819 }
5820
5821 if (!ffesta_is_inhibited ())
5822 ffestc_R528_finish ();
5823 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5824}
5825
5826/* ffestb_R537 -- Parse a PARAMETER statement
5827
5828 return ffestb_R537; // to lexer
5829
5830 Make sure the statement has a valid form for an PARAMETER statement.
5831 If it does, implement the statement. */
5832
5833ffelexHandler
5834ffestb_R537 (ffelexToken t)
5835{
5836 switch (ffelex_token_type (ffesta_tokens[0]))
5837 {
5838 case FFELEX_typeNAME:
5839 if (ffesta_first_kw != FFESTR_firstPARAMETER)
5840 goto bad_0; /* :::::::::::::::::::: */
5841 break;
5842
5843 case FFELEX_typeNAMES:
5844 if (ffesta_first_kw != FFESTR_firstPARAMETER)
5845 goto bad_0; /* :::::::::::::::::::: */
5846 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlPARAMETER)
5847 goto bad_0; /* :::::::::::::::::::: */
5848 break;
5849
5850 default:
5851 goto bad_0; /* :::::::::::::::::::: */
5852 }
5853
5854 switch (ffelex_token_type (t))
5855 {
5856 case FFELEX_typeOPEN_PAREN:
5857 break;
5858
5859 case FFELEX_typeEOS:
5860 case FFELEX_typeSEMICOLON:
5861 case FFELEX_typeCOMMA:
5862 case FFELEX_typeCOLONCOLON:
5863 ffesta_confirmed (); /* Error, but clearly intended. */
5864 goto bad_1; /* :::::::::::::::::::: */
5865
5866 default:
5867 goto bad_1; /* :::::::::::::::::::: */
5868 }
5869
5870 ffestb_local_.parameter.started = FALSE;
5871 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
5872 FFEEXPR_contextPARAMETER,
5873 (ffeexprCallback) ffestb_R5371_);
5874
5875bad_0: /* :::::::::::::::::::: */
5876 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", ffesta_tokens[0]);
5877 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5878
5879bad_1: /* :::::::::::::::::::: */
5880 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
5881 return (ffelexHandler) ffelex_swallow_tokens (t,
5882 (ffelexHandler) ffesta_zero); /* Invalid second token. */
5883}
5884
5885/* ffestb_R5371_ -- "PARAMETER" OPEN_PAREN expr
5886
5887 (ffestb_R5371_) // to expression handler
5888
5889 Make sure the next token is EQUALS. */
5890
5891static ffelexHandler
5892ffestb_R5371_ (ffelexToken ft, ffebld expr, ffelexToken t)
5893{
5894 ffestb_local_.parameter.expr = expr;
5895
5896 switch (ffelex_token_type (t))
5897 {
5898 case FFELEX_typeEQUALS:
5899 ffesta_confirmed ();
5900 if (expr == NULL)
5901 break;
5902 ffesta_tokens[1] = ffelex_token_use (ft);
5903 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
5904 FFEEXPR_contextPARAMETER, (ffeexprCallback) ffestb_R5372_);
5905
5906 default:
5907 break;
5908 }
5909
5910 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
5911 if (ffestb_local_.parameter.started)
5912 ffestc_R537_finish ();
5913 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5914}
5915
5916/* ffestb_R5372_ -- "PARAMETER" OPEN_PAREN expr EQUALS expr
5917
5918 (ffestb_R5372_) // to expression handler
5919
5920 Make sure the next token is COMMA or CLOSE_PAREN. */
5921
5922static ffelexHandler
5923ffestb_R5372_ (ffelexToken ft, ffebld expr, ffelexToken t)
5924{
5925 switch (ffelex_token_type (t))
5926 {
5927 case FFELEX_typeCOMMA:
5928 if (expr == NULL)
5929 break;
5930 if (!ffesta_is_inhibited ())
5931 {
5932 if (!ffestb_local_.parameter.started)
5933 {
5934 ffestc_R537_start ();
5935 ffestb_local_.parameter.started = TRUE;
5936 }
5937 ffestc_R537_item (ffestb_local_.parameter.expr, ffesta_tokens[1],
5938 expr, ft);
5939 }
5940 ffelex_token_kill (ffesta_tokens[1]);
5941 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
5942 FFEEXPR_contextPARAMETER,
5943 (ffeexprCallback) ffestb_R5371_);
5944
5945 case FFELEX_typeCLOSE_PAREN:
5946 if (expr == NULL)
5947 break;
5948 if (!ffesta_is_inhibited ())
5949 {
5950 if (!ffestb_local_.parameter.started)
5951 {
5952 ffestc_R537_start ();
5953 ffestb_local_.parameter.started = TRUE;
5954 }
5955 ffestc_R537_item (ffestb_local_.parameter.expr, ffesta_tokens[1],
5956 expr, ft);
5957 ffestc_R537_finish ();
5958 }
5959 ffelex_token_kill (ffesta_tokens[1]);
5960 return (ffelexHandler) ffestb_R5373_;
5961
5962 default:
5963 break;
5964 }
5965
5966 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
5967 if (ffestb_local_.parameter.started)
5968 ffestc_R537_finish ();
5969 ffelex_token_kill (ffesta_tokens[1]);
5970 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5971}
5972
5973/* ffestb_R5373_ -- "PARAMETER" OPEN_PAREN expr EQUALS expr CLOSE_PAREN
5974
5975 return ffestb_R5373_; // to lexer
5976
5977 Make sure the next token is EOS or SEMICOLON, or generate an error. All
5978 cleanup has already been done, by the way. */
5979
5980static ffelexHandler
5981ffestb_R5373_ (ffelexToken t)
5982{
5983 switch (ffelex_token_type (t))
5984 {
5985 case FFELEX_typeEOS:
5986 case FFELEX_typeSEMICOLON:
5987 return (ffelexHandler) ffesta_zero (t);
5988
5989 default:
5990 break;
5991 }
5992
5993 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
5994 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5995}
5996
5997/* ffestb_R542 -- Parse the NAMELIST statement
5998
5999 return ffestb_R542; // to lexer
6000
6001 Make sure the statement has a valid form for the NAMELIST statement. If it
6002 does, implement the statement. */
6003
6004ffelexHandler
6005ffestb_R542 (ffelexToken t)
6006{
6007 char *p;
6008 ffeTokenLength i;
6009
6010 switch (ffelex_token_type (ffesta_tokens[0]))
6011 {
6012 case FFELEX_typeNAME:
6013 if (ffesta_first_kw != FFESTR_firstNAMELIST)
6014 goto bad_0; /* :::::::::::::::::::: */
6015 break;
6016
6017 case FFELEX_typeNAMES:
6018 if (ffesta_first_kw != FFESTR_firstNAMELIST)
6019 goto bad_0; /* :::::::::::::::::::: */
6020 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlNAMELIST);
6021 if (*p != '\0')
6022 goto bad_i; /* :::::::::::::::::::: */
6023 break;
6024
6025 default:
6026 goto bad_0; /* :::::::::::::::::::: */
6027 }
6028
6029 switch (ffelex_token_type (t))
6030 {
6031 case FFELEX_typeCOMMA:
6032 case FFELEX_typeEOS:
6033 case FFELEX_typeSEMICOLON:
6034 case FFELEX_typeCOLONCOLON:
6035 ffesta_confirmed (); /* Error, but clearly intended. */
6036 goto bad_1; /* :::::::::::::::::::: */
6037
6038 default:
6039 goto bad_1; /* :::::::::::::::::::: */
6040
6041 case FFELEX_typeSLASH:
6042 break;
6043 }
6044
6045 ffesta_confirmed ();
6046 if (!ffesta_is_inhibited ())
6047 ffestc_R542_start ();
6048 return (ffelexHandler) ffestb_R5421_;
6049
6050bad_0: /* :::::::::::::::::::: */
6051 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", ffesta_tokens[0]);
6052 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6053
6054bad_1: /* :::::::::::::::::::: */
6055 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
6056 return (ffelexHandler) ffelex_swallow_tokens (t,
6057 (ffelexHandler) ffesta_zero); /* Invalid second token. */
6058
6059bad_i: /* :::::::::::::::::::: */
6060 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "NAMELIST", ffesta_tokens[0], i, t);
6061 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6062}
6063
6064/* ffestb_R5421_ -- "NAMELIST" SLASH
6065
6066 return ffestb_R5421_; // to lexer
6067
6068 Handle NAME. */
6069
6070static ffelexHandler
6071ffestb_R5421_ (ffelexToken t)
6072{
6073 switch (ffelex_token_type (t))
6074 {
6075 case FFELEX_typeNAME:
6076 if (!ffesta_is_inhibited ())
6077 ffestc_R542_item_nlist (t);
6078 return (ffelexHandler) ffestb_R5422_;
6079
6080 default:
6081 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
6082 break;
6083 }
6084
6085 if (!ffesta_is_inhibited ())
6086 ffestc_R542_finish ();
6087 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6088}
6089
6090/* ffestb_R5422_ -- "NAMELIST" SLASH NAME
6091
6092 return ffestb_R5422_; // to lexer
6093
6094 Handle SLASH. */
6095
6096static ffelexHandler
6097ffestb_R5422_ (ffelexToken t)
6098{
6099 switch (ffelex_token_type (t))
6100 {
6101 case FFELEX_typeSLASH:
6102 return (ffelexHandler) ffestb_R5423_;
6103
6104 default:
6105 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
6106 break;
6107 }
6108
6109 if (!ffesta_is_inhibited ())
6110 ffestc_R542_finish ();
6111 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6112}
6113
6114/* ffestb_R5423_ -- "NAMELIST" SLASH NAME SLASH
6115
6116 return ffestb_R5423_; // to lexer
6117
6118 Handle NAME. */
6119
6120static ffelexHandler
6121ffestb_R5423_ (ffelexToken t)
6122{
6123 switch (ffelex_token_type (t))
6124 {
6125 case FFELEX_typeNAME:
6126 if (!ffesta_is_inhibited ())
6127 ffestc_R542_item_nitem (t);
6128 return (ffelexHandler) ffestb_R5424_;
6129
6130 default:
6131 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
6132 break;
6133 }
6134
6135 if (!ffesta_is_inhibited ())
6136 ffestc_R542_finish ();
6137 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6138}
6139
6140/* ffestb_R5424_ -- "NAMELIST" SLASH NAME SLASH NAME
6141
6142 return ffestb_R5424_; // to lexer
6143
6144 Handle COMMA, EOS/SEMICOLON, or SLASH. */
6145
6146static ffelexHandler
6147ffestb_R5424_ (ffelexToken t)
6148{
6149 switch (ffelex_token_type (t))
6150 {
6151 case FFELEX_typeCOMMA:
6152 return (ffelexHandler) ffestb_R5425_;
6153
6154 case FFELEX_typeEOS:
6155 case FFELEX_typeSEMICOLON:
6156 if (!ffesta_is_inhibited ())
6157 ffestc_R542_finish ();
6158 return (ffelexHandler) ffesta_zero (t);
6159
6160 case FFELEX_typeSLASH:
6161 return (ffelexHandler) ffestb_R5421_;
6162
6163 default:
6164 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
6165 break;
6166 }
6167
6168 if (!ffesta_is_inhibited ())
6169 ffestc_R542_finish ();
6170 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6171}
6172
6173/* ffestb_R5425_ -- "NAMELIST" SLASH NAME SLASH NAME COMMA
6174
6175 return ffestb_R5425_; // to lexer
6176
6177 Handle NAME or SLASH. */
6178
6179static ffelexHandler
6180ffestb_R5425_ (ffelexToken t)
6181{
6182 switch (ffelex_token_type (t))
6183 {
6184 case FFELEX_typeNAME:
6185 if (!ffesta_is_inhibited ())
6186 ffestc_R542_item_nitem (t);
6187 return (ffelexHandler) ffestb_R5424_;
6188
6189 case FFELEX_typeSLASH:
6190 return (ffelexHandler) ffestb_R5421_;
6191
6192 default:
6193 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
6194 break;
6195 }
6196
6197 if (!ffesta_is_inhibited ())
6198 ffestc_R542_finish ();
6199 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6200}
6201
6202/* ffestb_R544 -- Parse an EQUIVALENCE statement
6203
6204 return ffestb_R544; // to lexer
6205
6206 Make sure the statement has a valid form for an EQUIVALENCE statement.
6207 If it does, implement the statement. */
6208
6209ffelexHandler
6210ffestb_R544 (ffelexToken t)
6211{
6212 switch (ffelex_token_type (ffesta_tokens[0]))
6213 {
6214 case FFELEX_typeNAME:
6215 if (ffesta_first_kw != FFESTR_firstEQUIVALENCE)
6216 goto bad_0; /* :::::::::::::::::::: */
6217 break;
6218
6219 case FFELEX_typeNAMES:
6220 if (ffesta_first_kw != FFESTR_firstEQUIVALENCE)
6221 goto bad_0; /* :::::::::::::::::::: */
6222 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlEQUIVALENCE)
6223 goto bad_0; /* :::::::::::::::::::: */
6224 break;
6225
6226 default:
6227 goto bad_0; /* :::::::::::::::::::: */
6228 }
6229
6230 switch (ffelex_token_type (t))
6231 {
6232 case FFELEX_typeOPEN_PAREN:
6233 break;
6234
6235 case FFELEX_typeEOS:
6236 case FFELEX_typeSEMICOLON:
6237 case FFELEX_typeCOMMA:
6238 case FFELEX_typeCOLONCOLON:
6239 ffesta_confirmed (); /* Error, but clearly intended. */
6240 goto bad_1; /* :::::::::::::::::::: */
6241
6242 default:
6243 goto bad_1; /* :::::::::::::::::::: */
6244 }
6245
6246 ffestb_local_.equivalence.started = FALSE;
6247 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
6248 FFEEXPR_contextEQUIVALENCE,
6249 (ffeexprCallback) ffestb_R5441_);
6250
6251bad_0: /* :::::::::::::::::::: */
6252 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", ffesta_tokens[0]);
6253 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6254
6255bad_1: /* :::::::::::::::::::: */
6256 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
6257 return (ffelexHandler) ffelex_swallow_tokens (t,
6258 (ffelexHandler) ffesta_zero); /* Invalid second token. */
6259}
6260
6261/* ffestb_R5441_ -- "EQUIVALENCE" OPEN_PAREN expr
6262
6263 (ffestb_R5441_) // to expression handler
6264
6265 Make sure the next token is COMMA. */
6266
6267static ffelexHandler
6268ffestb_R5441_ (ffelexToken ft, ffebld expr, ffelexToken t)
6269{
6270 switch (ffelex_token_type (t))
6271 {
6272 case FFELEX_typeCOMMA:
6273 if (expr == NULL)
6274 break;
6275 ffestb_local_.equivalence.exprs = ffestt_exprlist_create ();
6276 ffestt_exprlist_append (ffestb_local_.equivalence.exprs, expr,
6277 ffelex_token_use (ft));
6278 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
6279 FFEEXPR_contextEQUIVALENCE,
6280 (ffeexprCallback) ffestb_R5442_);
6281
6282 default:
6283 break;
6284 }
6285
6286 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
6287 if (ffestb_local_.equivalence.started)
6288 ffestc_R544_finish ();
6289 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6290}
6291
6292/* ffestb_R5442_ -- "EQUIVALENCE" OPEN_PAREN expr COMMA expr
6293
6294 (ffestb_R5442_) // to expression handler
6295
6296 Make sure the next token is COMMA or CLOSE_PAREN. For COMMA, we just
6297 append the expression to our list and continue; for CLOSE_PAREN, we
6298 append the expression and move to _3_. */
6299
6300static ffelexHandler
6301ffestb_R5442_ (ffelexToken ft, ffebld expr, ffelexToken t)
6302{
6303 switch (ffelex_token_type (t))
6304 {
6305 case FFELEX_typeCOMMA:
6306 if (expr == NULL)
6307 break;
6308 ffestt_exprlist_append (ffestb_local_.equivalence.exprs, expr,
6309 ffelex_token_use (ft));
6310 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
6311 FFEEXPR_contextEQUIVALENCE,
6312 (ffeexprCallback) ffestb_R5442_);
6313
6314 case FFELEX_typeCLOSE_PAREN:
6315 if (expr == NULL)
6316 break;
6317 ffestt_exprlist_append (ffestb_local_.equivalence.exprs, expr,
6318 ffelex_token_use (ft));
6319 return (ffelexHandler) ffestb_R5443_;
6320
6321 default:
6322 break;
6323 }
6324
6325 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
6326 if (ffestb_local_.equivalence.started)
6327 ffestc_R544_finish ();
6328 ffestt_exprlist_kill (ffestb_local_.equivalence.exprs);
6329 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6330}
6331
6332/* ffestb_R5443_ -- "EQUIVALENCE" OPEN_PAREN expr COMMA expr CLOSE_PAREN
6333
6334 return ffestb_R5443_; // to lexer
6335
6336 Make sure the next token is COMMA or EOS/SEMICOLON. */
6337
6338static ffelexHandler
6339ffestb_R5443_ (ffelexToken t)
6340{
6341 switch (ffelex_token_type (t))
6342 {
6343 case FFELEX_typeCOMMA:
6344 ffesta_confirmed ();
6345 if (!ffesta_is_inhibited ())
6346 {
6347 if (!ffestb_local_.equivalence.started)
6348 {
6349 ffestc_R544_start ();
6350 ffestb_local_.equivalence.started = TRUE;
6351 }
6352 ffestc_R544_item (ffestb_local_.equivalence.exprs);
6353 }
6354 ffestt_exprlist_kill (ffestb_local_.equivalence.exprs);
6355 return (ffelexHandler) ffestb_R5444_;
6356
6357 case FFELEX_typeEOS:
6358 case FFELEX_typeSEMICOLON:
6359 ffesta_confirmed ();
6360 if (!ffesta_is_inhibited ())
6361 {
6362 if (!ffestb_local_.equivalence.started)
6363 {
6364 ffestc_R544_start ();
6365 ffestb_local_.equivalence.started = TRUE;
6366 }
6367 ffestc_R544_item (ffestb_local_.equivalence.exprs);
6368 ffestc_R544_finish ();
6369 }
6370 ffestt_exprlist_kill (ffestb_local_.equivalence.exprs);
6371 return (ffelexHandler) ffesta_zero (t);
6372
6373 default:
6374 break;
6375 }
6376
6377 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
6378 if (ffestb_local_.equivalence.started)
6379 ffestc_R544_finish ();
6380 ffestt_exprlist_kill (ffestb_local_.equivalence.exprs);
6381 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6382}
6383
6384/* ffestb_R5444_ -- "EQUIVALENCE" OPEN_PAREN expr COMMA expr CLOSE_PAREN COMMA
6385
6386 return ffestb_R5444_; // to lexer
6387
6388 Make sure the next token is OPEN_PAREN, or generate an error. */
6389
6390static ffelexHandler
6391ffestb_R5444_ (ffelexToken t)
6392{
6393 switch (ffelex_token_type (t))
6394 {
6395 case FFELEX_typeOPEN_PAREN:
6396 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
6397 FFEEXPR_contextEQUIVALENCE,
6398 (ffeexprCallback) ffestb_R5441_);
6399
6400 default:
6401 break;
6402 }
6403
6404 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
6405 if (ffestb_local_.equivalence.started)
6406 ffestc_R544_finish ();
6407 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6408}
6409
6410/* ffestb_R834 -- Parse the CYCLE statement
6411
6412 return ffestb_R834; // to lexer
6413
6414 Make sure the statement has a valid form for the CYCLE statement. If
6415 it does, implement the statement. */
6416
6417ffelexHandler
6418ffestb_R834 (ffelexToken t)
6419{
6420 ffeTokenLength i;
6421 char *p;
6422
6423 switch (ffelex_token_type (ffesta_tokens[0]))
6424 {
6425 case FFELEX_typeNAME:
6426 if (ffesta_first_kw != FFESTR_firstCYCLE)
6427 goto bad_0; /* :::::::::::::::::::: */
6428 switch (ffelex_token_type (t))
6429 {
6430 case FFELEX_typeCOMMA:
6431 case FFELEX_typeCOLONCOLON:
6432 ffesta_confirmed (); /* Error, but clearly intended. */
6433 goto bad_1; /* :::::::::::::::::::: */
6434
6435 default:
6436 goto bad_1; /* :::::::::::::::::::: */
6437
6438 case FFELEX_typeNAME:
6439 ffesta_confirmed ();
6440 ffesta_tokens[1] = ffelex_token_use (t);
6441 return (ffelexHandler) ffestb_R8341_;
6442
6443 case FFELEX_typeEOS:
6444 case FFELEX_typeSEMICOLON:
6445 ffesta_confirmed ();
6446 ffesta_tokens[1] = NULL;
6447 return (ffelexHandler) ffestb_R8341_ (t);
6448 }
6449
6450 case FFELEX_typeNAMES:
6451 if (ffesta_first_kw != FFESTR_firstCYCLE)
6452 goto bad_0; /* :::::::::::::::::::: */
6453 switch (ffelex_token_type (t))
6454 {
6455 default:
6456 goto bad_1; /* :::::::::::::::::::: */
6457
6458 case FFELEX_typeEOS:
6459 case FFELEX_typeSEMICOLON:
6460 break;
6461 }
6462 ffesta_confirmed ();
6463 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCYCLE);
6464 if (*p == '\0')
6465 {
6466 ffesta_tokens[1] = NULL;
6467 }
6468 else
6469 {
6470 if (!ffesrc_is_name_init (*p))
6471 goto bad_i; /* :::::::::::::::::::: */
6472 ffesta_tokens[1]
6473 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
6474 }
6475 return (ffelexHandler) ffestb_R8341_ (t);
6476
6477 default:
6478 goto bad_0; /* :::::::::::::::::::: */
6479 }
6480
6481bad_0: /* :::::::::::::::::::: */
6482 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CYCLE", ffesta_tokens[0]);
6483 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6484
6485bad_1: /* :::::::::::::::::::: */
6486 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CYCLE", t);
6487 return (ffelexHandler) ffelex_swallow_tokens (t,
6488 (ffelexHandler) ffesta_zero); /* Invalid second token. */
6489
6490bad_i: /* :::::::::::::::::::: */
6491 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CYCLE", ffesta_tokens[0], i, t);
6492 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6493}
6494
6495/* ffestb_R8341_ -- "CYCLE" [NAME]
6496
6497 return ffestb_R8341_; // to lexer
6498
6499 Make sure the next token is an EOS or SEMICOLON. */
6500
6501static ffelexHandler
6502ffestb_R8341_ (ffelexToken t)
6503{
6504 switch (ffelex_token_type (t))
6505 {
6506 case FFELEX_typeEOS:
6507 case FFELEX_typeSEMICOLON:
6508 ffesta_confirmed ();
6509 if (!ffesta_is_inhibited ())
6510 ffestc_R834 (ffesta_tokens[1]);
6511 if (ffesta_tokens[1] != NULL)
6512 ffelex_token_kill (ffesta_tokens[1]);
6513 return (ffelexHandler) ffesta_zero (t);
6514
6515 default:
6516 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CYCLE", t);
6517 break;
6518 }
6519
6520 if (ffesta_tokens[1] != NULL)
6521 ffelex_token_kill (ffesta_tokens[1]);
6522 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6523}
6524
6525/* ffestb_R835 -- Parse the EXIT statement
6526
6527 return ffestb_R835; // to lexer
6528
6529 Make sure the statement has a valid form for the EXIT statement. If
6530 it does, implement the statement. */
6531
6532ffelexHandler
6533ffestb_R835 (ffelexToken t)
6534{
6535 ffeTokenLength i;
6536 char *p;
6537
6538 switch (ffelex_token_type (ffesta_tokens[0]))
6539 {
6540 case FFELEX_typeNAME:
6541 if (ffesta_first_kw != FFESTR_firstEXIT)
6542 goto bad_0; /* :::::::::::::::::::: */
6543 switch (ffelex_token_type (t))
6544 {
6545 case FFELEX_typeCOMMA:
6546 case FFELEX_typeCOLONCOLON:
6547 ffesta_confirmed (); /* Error, but clearly intended. */
6548 goto bad_1; /* :::::::::::::::::::: */
6549
6550 default:
6551 goto bad_1; /* :::::::::::::::::::: */
6552
6553 case FFELEX_typeNAME:
6554 ffesta_confirmed ();
6555 ffesta_tokens[1] = ffelex_token_use (t);
6556 return (ffelexHandler) ffestb_R8351_;
6557
6558 case FFELEX_typeEOS:
6559 case FFELEX_typeSEMICOLON:
6560 ffesta_confirmed ();
6561 ffesta_tokens[1] = NULL;
6562 return (ffelexHandler) ffestb_R8351_ (t);
6563 }
6564
6565 case FFELEX_typeNAMES:
6566 if (ffesta_first_kw != FFESTR_firstEXIT)
6567 goto bad_0; /* :::::::::::::::::::: */
6568 switch (ffelex_token_type (t))
6569 {
6570 default:
6571 goto bad_1; /* :::::::::::::::::::: */
6572
6573 case FFELEX_typeEOS:
6574 case FFELEX_typeSEMICOLON:
6575 break;
6576 }
6577 ffesta_confirmed ();
6578 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlEXIT);
6579 if (*p == '\0')
6580 {
6581 ffesta_tokens[1] = NULL;
6582 }
6583 else
6584 {
6585 if (!ffesrc_is_name_init (*p))
6586 goto bad_i; /* :::::::::::::::::::: */
6587 ffesta_tokens[1]
6588 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
6589 }
6590 return (ffelexHandler) ffestb_R8351_ (t);
6591
6592 default:
6593 goto bad_0; /* :::::::::::::::::::: */
6594 }
6595
6596bad_0: /* :::::::::::::::::::: */
6597 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EXIT", ffesta_tokens[0]);
6598 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6599
6600bad_1: /* :::::::::::::::::::: */
6601 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EXIT", t);
6602 return (ffelexHandler) ffelex_swallow_tokens (t,
6603 (ffelexHandler) ffesta_zero); /* Invalid second token. */
6604
6605bad_i: /* :::::::::::::::::::: */
6606 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "EXIT", ffesta_tokens[0], i, t);
6607 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6608}
6609
6610/* ffestb_R8351_ -- "EXIT" [NAME]
6611
6612 return ffestb_R8351_; // to lexer
6613
6614 Make sure the next token is an EOS or SEMICOLON. */
6615
6616static ffelexHandler
6617ffestb_R8351_ (ffelexToken t)
6618{
6619 switch (ffelex_token_type (t))
6620 {
6621 case FFELEX_typeEOS:
6622 case FFELEX_typeSEMICOLON:
6623 ffesta_confirmed ();
6624 if (!ffesta_is_inhibited ())
6625 ffestc_R835 (ffesta_tokens[1]);
6626 if (ffesta_tokens[1] != NULL)
6627 ffelex_token_kill (ffesta_tokens[1]);
6628 return (ffelexHandler) ffesta_zero (t);
6629
6630 default:
6631 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EXIT", t);
6632 break;
6633 }
6634
6635 if (ffesta_tokens[1] != NULL)
6636 ffelex_token_kill (ffesta_tokens[1]);
6637 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6638}
6639
6640/* ffestb_R838 -- Parse the ASSIGN statement
6641
6642 return ffestb_R838; // to lexer
6643
6644 Make sure the statement has a valid form for the ASSIGN statement. If it
6645 does, implement the statement. */
6646
6647ffelexHandler
6648ffestb_R838 (ffelexToken t)
6649{
6650 char *p;
6651 ffeTokenLength i;
6652 ffelexHandler next;
6653 ffelexToken et; /* First token in target. */
6654
6655 switch (ffelex_token_type (ffesta_tokens[0]))
6656 {
6657 case FFELEX_typeNAME:
6658 if (ffesta_first_kw != FFESTR_firstASSIGN)
6659 goto bad_0; /* :::::::::::::::::::: */
6660 switch (ffelex_token_type (t))
6661 {
6662 case FFELEX_typeEOS:
6663 case FFELEX_typeSEMICOLON:
6664 case FFELEX_typeCOMMA:
6665 case FFELEX_typeCOLONCOLON:
6666 ffesta_confirmed (); /* Error, but clearly intended. */
6667 goto bad_1; /* :::::::::::::::::::: */
6668
6669 default:
6670 goto bad_1; /* :::::::::::::::::::: */
6671
6672 case FFELEX_typeNUMBER:
6673 break;
6674 }
6675 ffesta_tokens[1] = ffelex_token_use (t);
6676 ffesta_confirmed ();
6677 return (ffelexHandler) ffestb_R8381_;
6678
6679 case FFELEX_typeNAMES:
6680 if (ffesta_first_kw != FFESTR_firstASSIGN)
6681 goto bad_0; /* :::::::::::::::::::: */
6682
6683 switch (ffelex_token_type (t))
6684 {
6685 case FFELEX_typeEOS:
6686 case FFELEX_typeSEMICOLON:
6687 ffesta_confirmed ();
6688 /* Fall through. */
6689 case FFELEX_typePERCENT:
6690 case FFELEX_typeOPEN_PAREN:
6691 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlASSIGN);
6692 if (!isdigit (*p))
6693 goto bad_i; /* :::::::::::::::::::: */
6694 ffesta_tokens[1]
6695 = ffelex_token_number_from_names (ffesta_tokens[0], i);
6696 p += ffelex_token_length (ffesta_tokens[1]); /* Skip to "TO". */
6697 i += ffelex_token_length (ffesta_tokens[1]);
6698 if (!ffesrc_char_match_init (*p, 'T', 't') /* "TO". */
6699 || (++i, !ffesrc_char_match_noninit (*++p, 'O', 'o')))
6700 {
6701 bad_i_1: /* :::::::::::::::::::: */
6702 ffelex_token_kill (ffesta_tokens[1]);
6703 goto bad_i; /* :::::::::::::::::::: */
6704 }
6705 ++p, ++i;
6706 if (!ffesrc_is_name_init (*p))
6707 goto bad_i_1; /* :::::::::::::::::::: */
6708 et = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
6709 next = (ffelexHandler)
6710 (*((ffelexHandler)
6711 ffeexpr_lhs (ffesta_output_pool,
6712 FFEEXPR_contextASSIGN,
6713 (ffeexprCallback)
6714 ffestb_R8383_)))
6715 (et);
6716 ffelex_token_kill (et);
6717 return (ffelexHandler) (*next) (t);
6718
6719 case FFELEX_typeCOMMA:
6720 case FFELEX_typeCOLONCOLON:
6721 ffesta_confirmed (); /* Error, but clearly intended. */
6722 goto bad_1; /* :::::::::::::::::::: */
6723
6724 default:
6725 goto bad_1; /* :::::::::::::::::::: */
6726 }
6727
6728 default:
6729 goto bad_0; /* :::::::::::::::::::: */
6730 }
6731
6732bad_0: /* :::::::::::::::::::: */
6733 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", ffesta_tokens[0]);
6734 return (ffelexHandler) ffelex_swallow_tokens (t,
6735 (ffelexHandler) ffesta_zero); /* Invalid first token. */
6736
6737bad_1: /* :::::::::::::::::::: */
6738 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", t);
6739 return (ffelexHandler) ffelex_swallow_tokens (t,
6740 (ffelexHandler) ffesta_zero); /* Invalid second token. */
6741
6742bad_i: /* :::::::::::::::::::: */
6743 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "ASSIGN", ffesta_tokens[0], i, t);
6744 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6745}
6746
6747/* ffestb_R8381_ -- "ASSIGN" NUMBER
6748
6749 return ffestb_R8381_; // to lexer
6750
6751 Make sure the next token is "TO". */
6752
6753static ffelexHandler
6754ffestb_R8381_ (ffelexToken t)
6755{
6756 if ((ffelex_token_type (t) == FFELEX_typeNAME)
6757 && (ffesrc_strcmp_2c (ffe_case_match (), ffelex_token_text (t), "TO", "to",
6758 "To") == 0))
6759 {
6760 return (ffelexHandler) ffestb_R8382_;
6761 }
6762
6763 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", t);
6764 if (ffelex_token_type (t) == FFELEX_typeNAME)
6765 return (ffelexHandler) ffestb_R8382_ (t); /* Maybe user forgot "TO". */
6766
6767 ffelex_token_kill (ffesta_tokens[1]);
6768 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6769}
6770
6771/* ffestb_R8382_ -- "ASSIGN" NUMBER ("TO")
6772
6773 return ffestb_R8382_; // to lexer
6774
6775 Make sure the next token is a name, then pass it along to the expression
6776 evaluator as an LHS expression. The callback function is _3_. */
6777
6778static ffelexHandler
6779ffestb_R8382_ (ffelexToken t)
6780{
6781 if (ffelex_token_type (t) == FFELEX_typeNAME)
6782 {
6783 return (ffelexHandler)
6784 (*((ffelexHandler)
6785 ffeexpr_lhs (ffesta_output_pool, FFEEXPR_contextASSIGN,
6786 (ffeexprCallback) ffestb_R8383_)))
6787 (t);
6788 }
6789
6790 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", t);
6791 ffelex_token_kill (ffesta_tokens[1]);
6792 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6793}
6794
6795/* ffestb_R8383_ -- "ASSIGN" NUMBER ("TO") expression
6796
6797 (ffestb_R8383_) // to expression handler
6798
6799 Make sure the next token is an EOS or SEMICOLON. */
6800
6801static ffelexHandler
6802ffestb_R8383_ (ffelexToken ft, ffebld expr, ffelexToken t)
6803{
6804 switch (ffelex_token_type (t))
6805 {
6806 case FFELEX_typeEOS:
6807 case FFELEX_typeSEMICOLON:
6808 ffesta_confirmed ();
6809 if (expr == NULL)
6810 break;
6811 if (!ffesta_is_inhibited ())
6812 ffestc_R838 (ffesta_tokens[1], expr, ft);
6813 ffelex_token_kill (ffesta_tokens[1]);
6814 return (ffelexHandler) ffesta_zero (t);
6815
6816 default:
6817 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", t);
6818 break;
6819 }
6820
6821 ffelex_token_kill (ffesta_tokens[1]);
6822 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6823}
6824
6825/* ffestb_R840 -- Parse an arithmetic-IF statement
6826
6827 return ffestb_R840; // to lexer
6828
6829 Make sure the statement has a valid form for an arithmetic-IF statement.
6830 If it does, implement the statement. */
6831
6832ffelexHandler
6833ffestb_R840 (ffelexToken t)
6834{
6835 switch (ffelex_token_type (ffesta_tokens[0]))
6836 {
6837 case FFELEX_typeNAME:
6838 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlIF)
6839 goto bad_0; /* :::::::::::::::::::: */
6840 if (ffesta_first_kw != FFESTR_firstIF)
6841 goto bad_0; /* :::::::::::::::::::: */
6842 break;
6843
6844 case FFELEX_typeNAMES:
6845 if (ffesta_first_kw != FFESTR_firstIF)
6846 goto bad_0; /* :::::::::::::::::::: */
6847 break;
6848
6849 default:
6850 goto bad_0; /* :::::::::::::::::::: */
6851 }
6852
6853 switch (ffelex_token_type (t))
6854 {
6855 case FFELEX_typeOPEN_PAREN:
6856 break;
6857
6858 default:
6859 goto bad_1; /* :::::::::::::::::::: */
6860 }
6861
6862 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextARITHIF,
6863 (ffeexprCallback) ffestb_R8401_);
6864
6865bad_0: /* :::::::::::::::::::: */
6866 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", ffesta_tokens[0]);
6867 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6868
6869bad_1: /* :::::::::::::::::::: */
6870 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
6871 return (ffelexHandler) ffelex_swallow_tokens (t,
6872 (ffelexHandler) ffesta_zero); /* Invalid second token. */
6873}
6874
6875/* ffestb_R8401_ -- "IF" OPEN_PAREN expr
6876
6877 (ffestb_R8401_) // to expression handler
6878
6879 Make sure the next token is CLOSE_PAREN. */
6880
6881static ffelexHandler
6882ffestb_R8401_ (ffelexToken ft, ffebld expr, ffelexToken t)
6883{
6884 ffestb_local_.if_stmt.expr = expr;
6885
6886 switch (ffelex_token_type (t))
6887 {
6888 case FFELEX_typeCLOSE_PAREN:
6889 if (expr == NULL)
6890 break;
6891 ffesta_tokens[1] = ffelex_token_use (ft);
6892 ffelex_set_names (TRUE); /* In case it's a logical IF instead. */
6893 return (ffelexHandler) ffestb_R8402_;
6894
6895 default:
6896 break;
6897 }
6898
6899 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
6900 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6901}
6902
6903/* ffestb_R8402_ -- "IF" OPEN_PAREN expr CLOSE_PAREN
6904
6905 return ffestb_R8402_; // to lexer
6906
6907 Make sure the next token is NUMBER. */
6908
6909static ffelexHandler
6910ffestb_R8402_ (ffelexToken t)
6911{
6912 ffelex_set_names (FALSE);
6913
6914 switch (ffelex_token_type (t))
6915 {
6916 case FFELEX_typeNUMBER:
6917 ffesta_confirmed ();
6918 ffesta_tokens[2] = ffelex_token_use (t);
6919 return (ffelexHandler) ffestb_R8403_;
6920
6921 default:
6922 break;
6923 }
6924
6925 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
6926 ffelex_token_kill (ffesta_tokens[1]);
6927 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6928}
6929
6930/* ffestb_R8403_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER
6931
6932 return ffestb_R8403_; // to lexer
6933
6934 Make sure the next token is COMMA. */
6935
6936static ffelexHandler
6937ffestb_R8403_ (ffelexToken t)
6938{
6939 switch (ffelex_token_type (t))
6940 {
6941 case FFELEX_typeCOMMA:
6942 return (ffelexHandler) ffestb_R8404_;
6943
6944 default:
6945 break;
6946 }
6947
6948 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
6949 ffelex_token_kill (ffesta_tokens[1]);
6950 ffelex_token_kill (ffesta_tokens[2]);
6951 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6952}
6953
6954/* ffestb_R8404_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER COMMA
6955
6956 return ffestb_R8404_; // to lexer
6957
6958 Make sure the next token is NUMBER. */
6959
6960static ffelexHandler
6961ffestb_R8404_ (ffelexToken t)
6962{
6963 switch (ffelex_token_type (t))
6964 {
6965 case FFELEX_typeNUMBER:
6966 ffesta_tokens[3] = ffelex_token_use (t);
6967 return (ffelexHandler) ffestb_R8405_;
6968
6969 default:
6970 break;
6971 }
6972
6973 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
6974 ffelex_token_kill (ffesta_tokens[1]);
6975 ffelex_token_kill (ffesta_tokens[2]);
6976 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6977}
6978
6979/* ffestb_R8405_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER COMMA NUMBER
6980
6981 return ffestb_R8405_; // to lexer
6982
6983 Make sure the next token is COMMA. */
6984
6985static ffelexHandler
6986ffestb_R8405_ (ffelexToken t)
6987{
6988 switch (ffelex_token_type (t))
6989 {
6990 case FFELEX_typeCOMMA:
6991 return (ffelexHandler) ffestb_R8406_;
6992
6993 default:
6994 break;
6995 }
6996
6997 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
6998 ffelex_token_kill (ffesta_tokens[1]);
6999 ffelex_token_kill (ffesta_tokens[2]);
7000 ffelex_token_kill (ffesta_tokens[3]);
7001 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7002}
7003
7004/* ffestb_R8406_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER COMMA NUMBER COMMA
7005
7006 return ffestb_R8406_; // to lexer
7007
7008 Make sure the next token is NUMBER. */
7009
7010static ffelexHandler
7011ffestb_R8406_ (ffelexToken t)
7012{
7013 switch (ffelex_token_type (t))
7014 {
7015 case FFELEX_typeNUMBER:
7016 ffesta_tokens[4] = ffelex_token_use (t);
7017 return (ffelexHandler) ffestb_R8407_;
7018
7019 default:
7020 break;
7021 }
7022
7023 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
7024 ffelex_token_kill (ffesta_tokens[1]);
7025 ffelex_token_kill (ffesta_tokens[2]);
7026 ffelex_token_kill (ffesta_tokens[3]);
7027 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7028}
7029
7030/* ffestb_R8407_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER COMMA NUMBER COMMA
7031 NUMBER
7032
7033 return ffestb_R8407_; // to lexer
7034
7035 Make sure the next token is EOS or SEMICOLON. */
7036
7037static ffelexHandler
7038ffestb_R8407_ (ffelexToken t)
7039{
7040 switch (ffelex_token_type (t))
7041 {
7042 case FFELEX_typeEOS:
7043 case FFELEX_typeSEMICOLON:
7044 if (!ffesta_is_inhibited ())
7045 ffestc_R840 (ffestb_local_.if_stmt.expr, ffesta_tokens[1],
7046 ffesta_tokens[2], ffesta_tokens[3], ffesta_tokens[4]);
7047 ffelex_token_kill (ffesta_tokens[1]);
7048 ffelex_token_kill (ffesta_tokens[2]);
7049 ffelex_token_kill (ffesta_tokens[3]);
7050 ffelex_token_kill (ffesta_tokens[4]);
7051 return (ffelexHandler) ffesta_zero (t);
7052
7053 default:
7054 break;
7055 }
7056
7057 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
7058 ffelex_token_kill (ffesta_tokens[1]);
7059 ffelex_token_kill (ffesta_tokens[2]);
7060 ffelex_token_kill (ffesta_tokens[3]);
7061 ffelex_token_kill (ffesta_tokens[4]);
7062 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7063}
7064
7065/* ffestb_R841 -- Parse the CONTINUE statement
7066
7067 return ffestb_R841; // to lexer
7068
7069 Make sure the statement has a valid form for the CONTINUE statement. If
7070 it does, implement the statement. */
7071
7072ffelexHandler
7073ffestb_R841 (ffelexToken t)
7074{
7075 char *p;
7076 ffeTokenLength i;
7077
7078 switch (ffelex_token_type (ffesta_tokens[0]))
7079 {
7080 case FFELEX_typeNAME:
7081 if (ffesta_first_kw != FFESTR_firstCONTINUE)
7082 goto bad_0; /* :::::::::::::::::::: */
7083 break;
7084
7085 case FFELEX_typeNAMES:
7086 if (ffesta_first_kw != FFESTR_firstCONTINUE)
7087 goto bad_0; /* :::::::::::::::::::: */
7088 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlCONTINUE)
7089 {
7090 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCONTINUE);
7091 goto bad_i; /* :::::::::::::::::::: */
7092 }
7093 break;
7094
7095 default:
7096 goto bad_0; /* :::::::::::::::::::: */
7097 }
7098
7099 switch (ffelex_token_type (t))
7100 {
7101 case FFELEX_typeEOS:
7102 case FFELEX_typeSEMICOLON:
7103 ffesta_confirmed ();
7104 if (!ffesta_is_inhibited ())
7105 ffestc_R841 ();
7106 return (ffelexHandler) ffesta_zero (t);
7107
7108 case FFELEX_typeCOMMA:
7109 case FFELEX_typeCOLONCOLON:
7110 ffesta_confirmed (); /* Error, but clearly intended. */
7111 goto bad_1; /* :::::::::::::::::::: */
7112
7113 default:
7114 goto bad_1; /* :::::::::::::::::::: */
7115 }
7116
7117bad_0: /* :::::::::::::::::::: */
7118 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CONTINUE", ffesta_tokens[0]);
7119 return (ffelexHandler) ffelex_swallow_tokens (t,
7120 (ffelexHandler) ffesta_zero); /* Invalid first token. */
7121
7122bad_1: /* :::::::::::::::::::: */
7123 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CONTINUE", t);
7124 return (ffelexHandler) ffelex_swallow_tokens (t,
7125 (ffelexHandler) ffesta_zero); /* Invalid second token. */
7126
7127bad_i: /* :::::::::::::::::::: */
7128 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CONTINUE", ffesta_tokens[0], i, t);
7129 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7130}
7131
7132/* ffestb_R1102 -- Parse the PROGRAM statement
7133
7134 return ffestb_R1102; // to lexer
7135
7136 Make sure the statement has a valid form for the PROGRAM statement. If it
7137 does, implement the statement. */
7138
7139ffelexHandler
7140ffestb_R1102 (ffelexToken t)
7141{
7142 ffeTokenLength i;
7143 char *p;
7144
7145 switch (ffelex_token_type (ffesta_tokens[0]))
7146 {
7147 case FFELEX_typeNAME:
7148 if (ffesta_first_kw != FFESTR_firstPROGRAM)
7149 goto bad_0; /* :::::::::::::::::::: */
7150 switch (ffelex_token_type (t))
7151 {
7152 case FFELEX_typeEOS:
7153 case FFELEX_typeSEMICOLON:
7154 case FFELEX_typeCOMMA:
7155 case FFELEX_typeCOLONCOLON:
7156 ffesta_confirmed (); /* Error, but clearly intended. */
7157 goto bad_1; /* :::::::::::::::::::: */
7158
7159 default:
7160 goto bad_1; /* :::::::::::::::::::: */
7161
7162 case FFELEX_typeNAME:
7163 break;
7164 }
7165
7166 ffesta_confirmed ();
7167 ffesta_tokens[1] = ffelex_token_use (t);
7168 return (ffelexHandler) ffestb_R11021_;
7169
7170 case FFELEX_typeNAMES:
7171 if (ffesta_first_kw != FFESTR_firstPROGRAM)
7172 goto bad_0; /* :::::::::::::::::::: */
7173 switch (ffelex_token_type (t))
7174 {
7175 case FFELEX_typeCOMMA:
7176 case FFELEX_typeCOLONCOLON:
7177 ffesta_confirmed (); /* Error, but clearly intended. */
7178 goto bad_1; /* :::::::::::::::::::: */
7179
7180 default:
7181 goto bad_1; /* :::::::::::::::::::: */
7182
7183 case FFELEX_typeEOS:
7184 case FFELEX_typeSEMICOLON:
7185 break;
7186 }
7187 ffesta_confirmed ();
7188 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlPROGRAM);
7189 if (!ffesrc_is_name_init (*p))
7190 goto bad_i; /* :::::::::::::::::::: */
7191 ffesta_tokens[1]
7192 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
7193 return (ffelexHandler) ffestb_R11021_ (t);
7194
7195 default:
7196 goto bad_0; /* :::::::::::::::::::: */
7197 }
7198
7199bad_0: /* :::::::::::::::::::: */
7200 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PROGRAM", ffesta_tokens[0]);
7201 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7202
7203bad_1: /* :::::::::::::::::::: */
7204 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PROGRAM", t);
7205 return (ffelexHandler) ffelex_swallow_tokens (t,
7206 (ffelexHandler) ffesta_zero); /* Invalid second token. */
7207
7208bad_i: /* :::::::::::::::::::: */
7209 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "PROGRAM", ffesta_tokens[0], i, t);
7210 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7211}
7212
7213/* ffestb_R11021_ -- "PROGRAM" NAME
7214
7215 return ffestb_R11021_; // to lexer
7216
7217 Make sure the next token is an EOS or SEMICOLON. */
7218
7219static ffelexHandler
7220ffestb_R11021_ (ffelexToken t)
7221{
7222 switch (ffelex_token_type (t))
7223 {
7224 case FFELEX_typeEOS:
7225 case FFELEX_typeSEMICOLON:
7226 ffesta_confirmed ();
7227 if (!ffesta_is_inhibited ())
7228 ffestc_R1102 (ffesta_tokens[1]);
7229 ffelex_token_kill (ffesta_tokens[1]);
7230 return (ffelexHandler) ffesta_zero (t);
7231
7232 default:
7233 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PROGRAM", t);
7234 break;
7235 }
7236
7237 ffelex_token_kill (ffesta_tokens[1]);
7238 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7239}
7240
7241/* ffestb_block -- Parse the BLOCK DATA statement
7242
7243 return ffestb_block; // to lexer
7244
7245 Make sure the statement has a valid form for the BLOCK DATA statement. If
7246 it does, implement the statement. */
7247
7248ffelexHandler
7249ffestb_block (ffelexToken t)
7250{
7251 switch (ffelex_token_type (ffesta_tokens[0]))
7252 {
7253 case FFELEX_typeNAME:
7254 if (ffesta_first_kw != FFESTR_firstBLOCK)
7255 goto bad_0; /* :::::::::::::::::::: */
7256 switch (ffelex_token_type (t))
7257 {
7258 default:
7259 goto bad_1; /* :::::::::::::::::::: */
7260
7261 case FFELEX_typeNAME:
7262 if (ffesta_second_kw != FFESTR_secondDATA)
7263 goto bad_1; /* :::::::::::::::::::: */
7264 break;
7265 }
7266
7267 ffesta_confirmed ();
7268 return (ffelexHandler) ffestb_R1111_1_;
7269
7270 default:
7271 goto bad_0; /* :::::::::::::::::::: */
7272 }
7273
7274bad_0: /* :::::::::::::::::::: */
7275 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", ffesta_tokens[0]);
7276 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7277
7278bad_1: /* :::::::::::::::::::: */
7279 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", t);
7280 return (ffelexHandler) ffelex_swallow_tokens (t,
7281 (ffelexHandler) ffesta_zero); /* Invalid second token. */
7282}
7283
7284/* ffestb_blockdata -- Parse the BLOCKDATA statement
7285
7286 return ffestb_blockdata; // to lexer
7287
7288 Make sure the statement has a valid form for the BLOCKDATA statement. If
7289 it does, implement the statement. */
7290
7291ffelexHandler
7292ffestb_blockdata (ffelexToken t)
7293{
7294 ffeTokenLength i;
7295 char *p;
7296
7297 switch (ffelex_token_type (ffesta_tokens[0]))
7298 {
7299 case FFELEX_typeNAME:
7300 if (ffesta_first_kw != FFESTR_firstBLOCKDATA)
7301 goto bad_0; /* :::::::::::::::::::: */
7302 switch (ffelex_token_type (t))
7303 {
7304 case FFELEX_typeCOMMA:
7305 case FFELEX_typeCOLONCOLON:
7306 ffesta_confirmed (); /* Error, but clearly intended. */
7307 goto bad_1; /* :::::::::::::::::::: */
7308
7309 default:
7310 goto bad_1; /* :::::::::::::::::::: */
7311
7312 case FFELEX_typeNAME:
7313 ffesta_confirmed ();
7314 ffesta_tokens[1] = ffelex_token_use (t);
7315 return (ffelexHandler) ffestb_R1111_2_;
7316
7317 case FFELEX_typeEOS:
7318 case FFELEX_typeSEMICOLON:
7319 ffesta_confirmed ();
7320 ffesta_tokens[1] = NULL;
7321 return (ffelexHandler) ffestb_R1111_2_ (t);
7322 }
7323
7324 case FFELEX_typeNAMES:
7325 if (ffesta_first_kw != FFESTR_firstBLOCKDATA)
7326 goto bad_0; /* :::::::::::::::::::: */
7327 switch (ffelex_token_type (t))
7328 {
7329 default:
7330 goto bad_1; /* :::::::::::::::::::: */
7331
7332 case FFELEX_typeEOS:
7333 case FFELEX_typeSEMICOLON:
7334 break;
7335 }
7336 ffesta_confirmed ();
7337 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlBLOCKDATA);
7338 if (*p == '\0')
7339 {
7340 ffesta_tokens[1] = NULL;
7341 }
7342 else
7343 {
7344 if (!ffesrc_is_name_init (*p))
7345 goto bad_i; /* :::::::::::::::::::: */
7346 ffesta_tokens[1]
7347 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
7348 }
7349 return (ffelexHandler) ffestb_R1111_2_ (t);
7350
7351 default:
7352 goto bad_0; /* :::::::::::::::::::: */
7353 }
7354
7355bad_0: /* :::::::::::::::::::: */
7356 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", ffesta_tokens[0]);
7357 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7358
7359bad_1: /* :::::::::::::::::::: */
7360 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", t);
7361 return (ffelexHandler) ffelex_swallow_tokens (t,
7362 (ffelexHandler) ffesta_zero); /* Invalid second token. */
7363
7364bad_i: /* :::::::::::::::::::: */
7365 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", ffesta_tokens[0], i, t);
7366 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7367}
7368
7369/* ffestb_R1111_1_ -- "BLOCK" "DATA"
7370
7371 return ffestb_R1111_1_; // to lexer
7372
7373 Make sure the next token is a NAME, EOS, or SEMICOLON token. */
7374
7375static ffelexHandler
7376ffestb_R1111_1_ (ffelexToken t)
7377{
7378 switch (ffelex_token_type (t))
7379 {
7380 case FFELEX_typeNAME:
7381 ffesta_tokens[1] = ffelex_token_use (t);
7382 return (ffelexHandler) ffestb_R1111_2_;
7383
7384 case FFELEX_typeEOS:
7385 case FFELEX_typeSEMICOLON:
7386 ffesta_tokens[1] = NULL;
7387 return (ffelexHandler) ffestb_R1111_2_ (t);
7388
7389 default:
7390 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", t);
7391 break;
7392 }
7393
7394 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7395}
7396
7397/* ffestb_R1111_2_ -- "BLOCK/DATA" NAME
7398
7399 return ffestb_R1111_2_; // to lexer
7400
7401 Make sure the next token is an EOS or SEMICOLON. */
7402
7403static ffelexHandler
7404ffestb_R1111_2_ (ffelexToken t)
7405{
7406 switch (ffelex_token_type (t))
7407 {
7408 case FFELEX_typeEOS:
7409 case FFELEX_typeSEMICOLON:
7410 ffesta_confirmed ();
7411 if (!ffesta_is_inhibited ())
7412 ffestc_R1111 (ffesta_tokens[1]);
7413 if (ffesta_tokens[1] != NULL)
7414 ffelex_token_kill (ffesta_tokens[1]);
7415 return (ffelexHandler) ffesta_zero (t);
7416
7417 default:
7418 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", t);
7419 break;
7420 }
7421
7422 if (ffesta_tokens[1] != NULL)
7423 ffelex_token_kill (ffesta_tokens[1]);
7424 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7425}
7426
7427/* ffestb_R1212 -- Parse the CALL statement
7428
7429 return ffestb_R1212; // to lexer
7430
7431 Make sure the statement has a valid form for the CALL statement. If it
7432 does, implement the statement. */
7433
7434ffelexHandler
7435ffestb_R1212 (ffelexToken t)
7436{
7437 ffeTokenLength i;
7438 char *p;
7439 ffelexHandler next;
7440 ffelexToken nt;
7441
7442 switch (ffelex_token_type (ffesta_tokens[0]))
7443 {
7444 case FFELEX_typeNAME:
7445 if (ffesta_first_kw != FFESTR_firstCALL)
7446 goto bad_0; /* :::::::::::::::::::: */
7447 switch (ffelex_token_type (t))
7448 {
7449 case FFELEX_typeEOS:
7450 case FFELEX_typeSEMICOLON:
7451 case FFELEX_typeCOMMA:
7452 case FFELEX_typeCOLONCOLON:
7453 ffesta_confirmed (); /* Error, but clearly intended. */
7454 goto bad_1; /* :::::::::::::::::::: */
7455
7456 default:
7457 goto bad_1; /* :::::::::::::::::::: */
7458
7459 case FFELEX_typeNAME:
7460 break;
7461 }
7462 ffesta_confirmed ();
7463 return (ffelexHandler)
7464 (*((ffelexHandler)
7465 ffeexpr_lhs (ffesta_output_pool, FFEEXPR_contextSUBROUTINEREF,
7466 (ffeexprCallback) ffestb_R12121_)))
7467 (t);
7468
7469 case FFELEX_typeNAMES:
7470 if (ffesta_first_kw != FFESTR_firstCALL)
7471 goto bad_0; /* :::::::::::::::::::: */
7472 switch (ffelex_token_type (t))
7473 {
7474 case FFELEX_typeCOLONCOLON:
7475 case FFELEX_typeCOMMA:
7476 ffesta_confirmed (); /* Error, but clearly intended. */
7477 goto bad_1; /* :::::::::::::::::::: */
7478
7479 default:
7480 goto bad_1; /* :::::::::::::::::::: */
7481
7482 case FFELEX_typeOPEN_PAREN:
7483 break;
7484
7485 case FFELEX_typeEOS:
7486 case FFELEX_typeSEMICOLON:
7487 ffesta_confirmed ();
7488 break;
7489 }
7490 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCALL);
7491 if (!ffesrc_is_name_init (*p))
7492 goto bad_i; /* :::::::::::::::::::: */
7493 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
7494 next = (ffelexHandler)
7495 (*((ffelexHandler)
7496 ffeexpr_lhs (ffesta_output_pool, FFEEXPR_contextSUBROUTINEREF,
7497 (ffeexprCallback) ffestb_R12121_)))
7498 (nt);
7499 ffelex_token_kill (nt);
7500 return (ffelexHandler) (*next) (t);
7501
7502 default:
7503 goto bad_0; /* :::::::::::::::::::: */
7504 }
7505
7506bad_0: /* :::::::::::::::::::: */
7507 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CALL", ffesta_tokens[0]);
7508 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7509
7510bad_1: /* :::::::::::::::::::: */
7511 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CALL", t);
7512 return (ffelexHandler) ffelex_swallow_tokens (t,
7513 (ffelexHandler) ffesta_zero); /* Invalid second token. */
7514
7515bad_i: /* :::::::::::::::::::: */
7516 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CALL", ffesta_tokens[0], i, t);
7517 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7518}
7519
7520/* ffestb_R12121_ -- "CALL" expr
7521
7522 (ffestb_R12121_) // to expression handler
7523
7524 Make sure the statement has a valid form for the CALL statement. If it
7525 does, implement the statement. */
7526
7527static ffelexHandler
7528ffestb_R12121_ (ffelexToken ft, ffebld expr, ffelexToken t)
7529{
7530 switch (ffelex_token_type (t))
7531 {
7532 case FFELEX_typeEOS:
7533 case FFELEX_typeSEMICOLON:
7534 ffesta_confirmed ();
7535 if (expr == NULL)
7536 break;
7537 if (!ffesta_is_inhibited ())
7538 ffestc_R1212 (expr, ft);
7539 return (ffelexHandler) ffesta_zero (t);
7540
7541 default:
7542 break;
7543 }
7544
7545 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CALL", t);
7546 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7547}
7548
7549/* ffestb_R1227 -- Parse the RETURN statement
7550
7551 return ffestb_R1227; // to lexer
7552
7553 Make sure the statement has a valid form for the RETURN statement. If it
7554 does, implement the statement. */
7555
7556ffelexHandler
7557ffestb_R1227 (ffelexToken t)
7558{
7559 ffelexHandler next;
7560
7561 switch (ffelex_token_type (ffesta_tokens[0]))
7562 {
7563 case FFELEX_typeNAME:
7564 if (ffesta_first_kw != FFESTR_firstRETURN)
7565 goto bad_0; /* :::::::::::::::::::: */
7566 switch (ffelex_token_type (t))
7567 {
7568 case FFELEX_typeCOMMA:
7569 case FFELEX_typeCOLONCOLON:
7570 ffesta_confirmed (); /* Error, but clearly intended. */
7571 goto bad_1; /* :::::::::::::::::::: */
7572
7573 case FFELEX_typeEQUALS:
7574 case FFELEX_typePOINTS:
7575 case FFELEX_typeCOLON:
7576 goto bad_1; /* :::::::::::::::::::: */
7577
7578 case FFELEX_typeEOS:
7579 case FFELEX_typeSEMICOLON:
7580 case FFELEX_typeNAME:
7581 case FFELEX_typeNUMBER:
7582 ffesta_confirmed ();
7583 break;
7584
7585 default:
7586 break;
7587 }
7588
7589 return (ffelexHandler) (*((ffelexHandler)
7590 ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextRETURN,
7591 (ffeexprCallback) ffestb_R12271_)))
7592 (t);
7593
7594 case FFELEX_typeNAMES:
7595 if (ffesta_first_kw != FFESTR_firstRETURN)
7596 goto bad_0; /* :::::::::::::::::::: */
7597 switch (ffelex_token_type (t))
7598 {
7599 case FFELEX_typeCOMMA:
7600 case FFELEX_typeCOLONCOLON:
7601 ffesta_confirmed (); /* Error, but clearly intended. */
7602 goto bad_1; /* :::::::::::::::::::: */
7603
7604 case FFELEX_typeEQUALS:
7605 case FFELEX_typePOINTS:
7606 case FFELEX_typeCOLON:
7607 goto bad_1; /* :::::::::::::::::::: */
7608
7609 case FFELEX_typeEOS:
7610 case FFELEX_typeSEMICOLON:
7611 ffesta_confirmed ();
7612 break;
7613
7614 default:
7615 break;
7616 }
7617 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
7618 FFEEXPR_contextRETURN, (ffeexprCallback) ffestb_R12271_);
7619 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
7620 FFESTR_firstlRETURN);
7621 if (next == NULL)
7622 return (ffelexHandler) ffelex_swallow_tokens (t,
7623 (ffelexHandler) ffesta_zero);
7624 return (ffelexHandler) (*next) (t);
7625
7626 default:
7627 goto bad_0; /* :::::::::::::::::::: */
7628 }
7629
7630bad_0: /* :::::::::::::::::::: */
7631 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RETURN", ffesta_tokens[0]);
7632 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7633
7634bad_1: /* :::::::::::::::::::: */
7635 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RETURN", t);
7636 return (ffelexHandler) ffelex_swallow_tokens (t,
7637 (ffelexHandler) ffesta_zero); /* Invalid second token. */
7638}
7639
7640/* ffestb_R12271_ -- "RETURN" expr
7641
7642 (ffestb_R12271_) // to expression handler
7643
7644 Make sure the next token is an EOS or SEMICOLON. */
7645
7646static ffelexHandler
7647ffestb_R12271_ (ffelexToken ft, ffebld expr, ffelexToken t)
7648{
7649 switch (ffelex_token_type (t))
7650 {
7651 case FFELEX_typeEOS:
7652 case FFELEX_typeSEMICOLON:
7653 ffesta_confirmed ();
7654 if (!ffesta_is_inhibited ())
7655 ffestc_R1227 (expr, ft);
7656 return (ffelexHandler) ffesta_zero (t);
7657
7658 default:
7659 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RETURN", t);
7660 break;
7661 }
7662
7663 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7664}
7665
7666/* ffestb_R1228 -- Parse the CONTAINS statement
7667
7668 return ffestb_R1228; // to lexer
7669
7670 Make sure the statement has a valid form for the CONTAINS statement. If
7671 it does, implement the statement. */
7672
7673#if FFESTR_F90
7674ffelexHandler
7675ffestb_R1228 (ffelexToken t)
7676{
7677 char *p;
7678 ffeTokenLength i;
7679
7680 switch (ffelex_token_type (ffesta_tokens[0]))
7681 {
7682 case FFELEX_typeNAME:
7683 if (ffesta_first_kw != FFESTR_firstCONTAINS)
7684 goto bad_0; /* :::::::::::::::::::: */
7685 break;
7686
7687 case FFELEX_typeNAMES:
7688 if (ffesta_first_kw != FFESTR_firstCONTAINS)
7689 goto bad_0; /* :::::::::::::::::::: */
7690 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlCONTAINS)
7691 {
7692 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCONTAINS);
7693 goto bad_i; /* :::::::::::::::::::: */
7694 }
7695 break;
7696
7697 default:
7698 goto bad_0; /* :::::::::::::::::::: */
7699 }
7700
7701 switch (ffelex_token_type (t))
7702 {
7703 case FFELEX_typeEOS:
7704 case FFELEX_typeSEMICOLON:
7705 ffesta_confirmed ();
7706 if (!ffesta_is_inhibited ())
7707 ffestc_R1228 ();
7708 return (ffelexHandler) ffesta_zero (t);
7709
7710 case FFELEX_typeCOMMA:
7711 case FFELEX_typeCOLONCOLON:
7712 ffesta_confirmed (); /* Error, but clearly intended. */
7713 goto bad_1; /* :::::::::::::::::::: */
7714
7715 default:
7716 goto bad_1; /* :::::::::::::::::::: */
7717 }
7718
7719bad_0: /* :::::::::::::::::::: */
7720 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CONTAINS", ffesta_tokens[0]);
7721 return (ffelexHandler) ffelex_swallow_tokens (t,
7722 (ffelexHandler) ffesta_zero); /* Invalid first token. */
7723
7724bad_1: /* :::::::::::::::::::: */
7725 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CONTAINS", t);
7726 return (ffelexHandler) ffelex_swallow_tokens (t,
7727 (ffelexHandler) ffesta_zero); /* Invalid second token. */
7728
7729bad_i: /* :::::::::::::::::::: */
7730 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CONTAINS", ffesta_tokens[0], i, t);
7731 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7732}
7733
7734#endif
7735/* ffestb_V009 -- Parse the UNION statement
7736
7737 return ffestb_V009; // to lexer
7738
7739 Make sure the statement has a valid form for the UNION statement. If
7740 it does, implement the statement. */
7741
7742#if FFESTR_VXT
7743ffelexHandler
7744ffestb_V009 (ffelexToken t)
7745{
7746 char *p;
7747 ffeTokenLength i;
7748
7749 switch (ffelex_token_type (ffesta_tokens[0]))
7750 {
7751 case FFELEX_typeNAME:
7752 if (ffesta_first_kw != FFESTR_firstUNION)
7753 goto bad_0; /* :::::::::::::::::::: */
7754 break;
7755
7756 case FFELEX_typeNAMES:
7757 if (ffesta_first_kw != FFESTR_firstUNION)
7758 goto bad_0; /* :::::::::::::::::::: */
7759 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlUNION)
7760 {
7761 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlUNION);
7762 goto bad_i; /* :::::::::::::::::::: */
7763 }
7764 break;
7765
7766 default:
7767 goto bad_0; /* :::::::::::::::::::: */
7768 }
7769
7770 switch (ffelex_token_type (t))
7771 {
7772 case FFELEX_typeEOS:
7773 case FFELEX_typeSEMICOLON:
7774 ffesta_confirmed ();
7775 if (!ffesta_is_inhibited ())
7776 ffestc_V009 ();
7777 return (ffelexHandler) ffesta_zero (t);
7778
7779 case FFELEX_typeCOMMA:
7780 case FFELEX_typeCOLONCOLON:
7781 ffesta_confirmed (); /* Error, but clearly intended. */
7782 goto bad_1; /* :::::::::::::::::::: */
7783
7784 default:
7785 goto bad_1; /* :::::::::::::::::::: */
7786 }
7787
7788bad_0: /* :::::::::::::::::::: */
7789 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "UNION", ffesta_tokens[0]);
7790 return (ffelexHandler) ffelex_swallow_tokens (t,
7791 (ffelexHandler) ffesta_zero); /* Invalid first token. */
7792
7793bad_1: /* :::::::::::::::::::: */
7794 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "UNION", t);
7795 return (ffelexHandler) ffelex_swallow_tokens (t,
7796 (ffelexHandler) ffesta_zero); /* Invalid second token. */
7797
7798bad_i: /* :::::::::::::::::::: */
7799 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "UNION", ffesta_tokens[0], i, t);
7800 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7801}
7802
7803#endif
7804/* ffestb_construct -- Parse a construct name
7805
7806 return ffestb_construct; // to lexer
7807
7808 Make sure the statement can have a construct name (if-then-stmt, do-stmt,
7809 select-case-stmt). */
7810
7811ffelexHandler
7812ffestb_construct (ffelexToken t UNUSED)
7813{
7814 /* This handler gets invoked only when token 0 is NAME/NAMES and token 1 is
7815 COLON. */
7816
7817 ffesta_confirmed ();
7818 ffelex_set_names (TRUE);
7819 return (ffelexHandler) ffestb_construct1_;
7820}
7821
7822/* ffestb_construct1_ -- NAME COLON
7823
7824 return ffestb_construct1_; // to lexer
7825
7826 Make sure we've got a NAME that is DO, DOWHILE, IF, SELECT, or SELECTCASE. */
7827
7828static ffelexHandler
7829ffestb_construct1_ (ffelexToken t)
7830{
7831 ffelex_set_names (FALSE);
7832
7833 switch (ffelex_token_type (t))
7834 {
7835 case FFELEX_typeNAME:
7836 ffesta_first_kw = ffestr_first (t);
7837 switch (ffesta_first_kw)
7838 {
7839 case FFESTR_firstIF:
7840 ffestb_local_.construct.next = (ffelexHandler) ffestb_if;
7841 break;
7842
7843 case FFESTR_firstDO:
7844 ffestb_local_.construct.next = (ffelexHandler) ffestb_do;
7845 break;
7846
7847 case FFESTR_firstDOWHILE:
7848 ffestb_local_.construct.next = (ffelexHandler) ffestb_dowhile;
7849 break;
7850
7851 case FFESTR_firstSELECT:
7852 case FFESTR_firstSELECTCASE:
7853 ffestb_local_.construct.next = (ffelexHandler) ffestb_R809;
7854 break;
7855
7856 default:
7857 goto bad; /* :::::::::::::::::::: */
7858 }
7859 ffesta_construct_name = ffesta_tokens[0];
7860 ffesta_tokens[0] = ffelex_token_use (t);
7861 return (ffelexHandler) ffestb_construct2_;
7862
7863 case FFELEX_typeNAMES:
7864 ffesta_first_kw = ffestr_first (t);
7865 switch (ffesta_first_kw)
7866 {
7867 case FFESTR_firstIF:
7868 if (ffelex_token_length (t) != FFESTR_firstlIF)
7869 goto bad; /* :::::::::::::::::::: */
7870 ffestb_local_.construct.next = (ffelexHandler) ffestb_if;
7871 break;
7872
7873 case FFESTR_firstDO:
7874 ffestb_local_.construct.next = (ffelexHandler) ffestb_do;
7875 break;
7876
7877 case FFESTR_firstDOWHILE:
7878 if (ffelex_token_length (t) != FFESTR_firstlDOWHILE)
7879 goto bad; /* :::::::::::::::::::: */
7880 ffestb_local_.construct.next = (ffelexHandler) ffestb_dowhile;
7881 break;
7882
7883 case FFESTR_firstSELECTCASE:
7884 if (ffelex_token_length (t) != FFESTR_firstlSELECTCASE)
7885 goto bad; /* :::::::::::::::::::: */
7886 ffestb_local_.construct.next = (ffelexHandler) ffestb_R809;
7887 break;
7888
7889 default:
7890 goto bad; /* :::::::::::::::::::: */
7891 }
7892 ffesta_construct_name = ffesta_tokens[0];
7893 ffesta_tokens[0] = ffelex_token_use (t);
7894 return (ffelexHandler) ffestb_construct2_;
7895
7896 default:
7897 break;
7898 }
7899
7900bad: /* :::::::::::::::::::: */
7901 ffesta_ffebad_2st (FFEBAD_INVALID_STMT_FORM, "CONSTRUCT",
7902 ffesta_tokens[0], t);
7903 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7904}
7905
7906/* ffestb_construct2_ -- NAME COLON "DO/DOWHILE/IF/SELECT/SELECTCASE"
7907
7908 return ffestb_construct2_; // to lexer
7909
7910 This extra step is needed to set ffesta_second_kw if the second token
7911 (here) is a NAME, so DO and SELECT can continue to expect it. */
7912
7913static ffelexHandler
7914ffestb_construct2_ (ffelexToken t)
7915{
7916 if (ffelex_token_type (t) == FFELEX_typeNAME)
7917 ffesta_second_kw = ffestr_second (t);
7918 return (ffelexHandler) (*ffestb_local_.construct.next) (t);
7919}
7920
7921/* ffestb_heap -- Parse an ALLOCATE/DEALLOCATE statement
7922
7923 return ffestb_heap; // to lexer
7924
7925 Make sure the statement has a valid form for an ALLOCATE/DEALLOCATE
7926 statement. If it does, implement the statement. */
7927
7928#if FFESTR_F90
7929ffelexHandler
7930ffestb_heap (ffelexToken t)
7931{
7932 switch (ffelex_token_type (ffesta_tokens[0]))
7933 {
7934 case FFELEX_typeNAME:
7935 break;
7936
7937 case FFELEX_typeNAMES:
7938 if (ffelex_token_length (ffesta_tokens[0]) != ffestb_args.heap.len)
7939 goto bad_0; /* :::::::::::::::::::: */
7940 break;
7941
7942 default:
7943 goto bad_0; /* :::::::::::::::::::: */
7944 }
7945
7946 switch (ffelex_token_type (t))
7947 {
7948 case FFELEX_typeOPEN_PAREN:
7949 break;
7950
7951 case FFELEX_typeEOS:
7952 case FFELEX_typeSEMICOLON:
7953 case FFELEX_typeCOMMA:
7954 case FFELEX_typeCOLONCOLON:
7955 ffesta_confirmed (); /* Error, but clearly intended. */
7956 goto bad_1; /* :::::::::::::::::::: */
7957
7958 default:
7959 goto bad_1; /* :::::::::::::::::::: */
7960 }
7961
7962 ffestb_local_.heap.exprs = ffestt_exprlist_create ();
7963 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
7964 ffestb_args.heap.ctx,
7965 (ffeexprCallback) ffestb_heap1_);
7966
7967bad_0: /* :::::::::::::::::::: */
7968 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, ffesta_tokens[0]);
7969 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7970
7971bad_1: /* :::::::::::::::::::: */
7972 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
7973 return (ffelexHandler) ffelex_swallow_tokens (t,
7974 (ffelexHandler) ffesta_zero); /* Invalid second token. */
7975}
7976
7977/* ffestb_heap1_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN expr
7978
7979 (ffestb_heap1_) // to expression handler
7980
7981 Make sure the next token is COMMA. */
7982
7983static ffelexHandler
7984ffestb_heap1_ (ffelexToken ft, ffebld expr, ffelexToken t)
7985{
7986 switch (ffelex_token_type (t))
7987 {
7988 case FFELEX_typeCOMMA:
7989 if (expr == NULL)
7990 break;
7991 ffestt_exprlist_append (ffestb_local_.heap.exprs, expr,
7992 ffelex_token_use (t));
7993 return (ffelexHandler) ffestb_heap2_;
7994
7995 case FFELEX_typeCLOSE_PAREN:
7996 if (expr == NULL)
7997 break;
7998 ffestt_exprlist_append (ffestb_local_.heap.exprs, expr,
7999 ffelex_token_use (t));
8000 ffesta_tokens[1] = NULL;
8001 ffestb_local_.heap.expr = NULL;
8002 return (ffelexHandler) ffestb_heap5_;
8003
8004 default:
8005 break;
8006 }
8007
8008 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
8009 ffestt_exprlist_kill (ffestb_local_.heap.exprs);
8010 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8011}
8012
8013/* ffestb_heap2_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN expr COMMA
8014
8015 return ffestb_heap2_; // to lexer
8016
8017 Make sure the next token is NAME. */
8018
8019static ffelexHandler
8020ffestb_heap2_ (ffelexToken t)
8021{
8022 switch (ffelex_token_type (t))
8023 {
8024 case FFELEX_typeNAME:
8025 ffesta_tokens[1] = ffelex_token_use (t);
8026 return (ffelexHandler) ffestb_heap3_;
8027
8028 default:
8029 break;
8030 }
8031
8032 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
8033 ffestt_exprlist_kill (ffestb_local_.heap.exprs);
8034 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8035}
8036
8037/* ffestb_heap3_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN expr COMMA NAME
8038
8039 return ffestb_heap3_; // to lexer
8040
8041 If token is EQUALS, make sure NAME was "STAT" and handle STAT variable;
8042 else pass NAME and token to expression handler. */
8043
8044static ffelexHandler
8045ffestb_heap3_ (ffelexToken t)
8046{
8047 ffelexHandler next;
8048
8049 switch (ffelex_token_type (t))
8050 {
8051 case FFELEX_typeEQUALS:
8052 ffesta_confirmed ();
8053 if (ffestr_other (ffesta_tokens[1]) != FFESTR_otherSTAT)
8054 break;
8055 ffelex_token_kill (ffesta_tokens[1]);
8056 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
8057 FFEEXPR_contextHEAPSTAT,
8058 (ffeexprCallback) ffestb_heap4_);
8059
8060 default:
8061 next = (ffelexHandler)
8062 (*((ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
8063 ffestb_args.heap.ctx,
8064 (ffeexprCallback) ffestb_heap1_)))
8065 (ffesta_tokens[1]);
8066 ffelex_token_kill (ffesta_tokens[1]);
8067 return (ffelexHandler) (*next) (t);
8068 }
8069
8070 ffelex_token_kill (ffesta_tokens[1]);
8071 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
8072 ffestt_exprlist_kill (ffestb_local_.heap.exprs);
8073 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8074}
8075
8076/* ffestb_heap4_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN ... COMMA "STAT" EQUALS
8077 expr
8078
8079 (ffestb_heap4_) // to expression handler
8080
8081 Make sure the next token is CLOSE_PAREN. */
8082
8083static ffelexHandler
8084ffestb_heap4_ (ffelexToken ft, ffebld expr, ffelexToken t)
8085{
8086 switch (ffelex_token_type (t))
8087 {
8088 case FFELEX_typeCLOSE_PAREN:
8089 if (expr == NULL)
8090 break;
8091 ffesta_tokens[1] = ffelex_token_use (ft);
8092 ffestb_local_.heap.expr = expr;
8093 return (ffelexHandler) ffestb_heap5_;
8094
8095 default:
8096 break;
8097 }
8098
8099 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
8100 ffestt_exprlist_kill (ffestb_local_.heap.exprs);
8101 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8102}
8103
8104/* ffestb_heap5_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN ... CLOSE_PAREN
8105
8106 return ffestb_heap5_; // to lexer
8107
8108 Make sure the next token is EOS/SEMICOLON. */
8109
8110static ffelexHandler
8111ffestb_heap5_ (ffelexToken t)
8112{
8113 switch (ffelex_token_type (t))
8114 {
8115 case FFELEX_typeEOS:
8116 case FFELEX_typeSEMICOLON:
8117 ffesta_confirmed ();
8118 if (!ffesta_is_inhibited ())
8119 if (ffesta_first_kw == FFESTR_firstALLOCATE)
8120 ffestc_R620 (ffestb_local_.heap.exprs, ffestb_local_.heap.expr,
8121 ffesta_tokens[1]);
8122 else
8123 ffestc_R625 (ffestb_local_.heap.exprs, ffestb_local_.heap.expr,
8124 ffesta_tokens[1]);
8125 ffestt_exprlist_kill (ffestb_local_.heap.exprs);
8126 if (ffesta_tokens[1] != NULL)
8127 ffelex_token_kill (ffesta_tokens[1]);
8128 return (ffelexHandler) ffesta_zero (t);
8129
8130 default:
8131 break;
8132 }
8133
8134 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
8135 ffestt_exprlist_kill (ffestb_local_.heap.exprs);
8136 if (ffesta_tokens[1] != NULL)
8137 ffelex_token_kill (ffesta_tokens[1]);
8138 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8139}
8140
8141#endif
8142/* ffestb_module -- Parse the MODULEPROCEDURE statement
8143
8144 return ffestb_module; // to lexer
8145
8146 Make sure the statement has a valid form for the MODULEPROCEDURE statement.
8147 If it does, implement the statement.
8148
8149 31-May-90 JCB 1.1
8150 Confirm NAME==MODULE followed by standard four invalid tokens, so we
8151 get decent message if somebody forgets that MODULE requires a name. */
8152
8153#if FFESTR_F90
8154ffelexHandler
8155ffestb_module (ffelexToken t)
8156{
8157 ffeTokenLength i;
8158 char *p;
8159 ffelexToken nt;
8160 ffelexToken mt; /* Name in MODULE PROCEDUREname, i.e.
8161 includes "PROCEDURE". */
8162
8163 switch (ffelex_token_type (ffesta_tokens[0]))
8164 {
8165 case FFELEX_typeNAME:
8166 if (ffesta_first_kw != FFESTR_firstMODULE)
8167 goto bad_0; /* :::::::::::::::::::: */
8168 switch (ffelex_token_type (t))
8169 {
8170 case FFELEX_typeNAME:
8171 break;
8172
8173 case FFELEX_typeCOLONCOLON:
8174 case FFELEX_typeCOMMA:
8175 case FFELEX_typeEOS:
8176 case FFELEX_typeSEMICOLON:
8177 ffesta_confirmed ();
8178 goto bad_1m; /* :::::::::::::::::::: */
8179
8180 default:
8181 goto bad_1m; /* :::::::::::::::::::: */
8182 }
8183
8184 ffesta_confirmed ();
8185 if (ffesta_second_kw != FFESTR_secondPROCEDURE)
8186 {
8187 ffesta_tokens[1] = ffelex_token_use (t);
8188 return (ffelexHandler) ffestb_module3_;
8189 }
8190 ffestb_local_.moduleprocedure.started = FALSE;
8191 ffesta_tokens[1] = ffelex_token_use (t);
8192 return (ffelexHandler) ffestb_module1_;
8193
8194 case FFELEX_typeNAMES:
8195 p = ffelex_token_text (ffesta_tokens[0])
8196 + (i = FFESTR_firstlMODULEPROCEDURE);
8197 if ((ffesta_first_kw == FFESTR_firstMODULE)
8198 || ((ffesta_first_kw == FFESTR_firstMODULEPROCEDURE)
8199 && !ffesrc_is_name_init (*p)))
8200 { /* Definitely not "MODULE PROCEDURE name". */
8201 switch (ffelex_token_type (t))
8202 {
8203 case FFELEX_typeCOMMA:
8204 case FFELEX_typeCOLONCOLON:
8205 ffesta_confirmed (); /* Error, but clearly intended. */
8206 goto bad_1m; /* :::::::::::::::::::: */
8207
8208 default:
8209 goto bad_1m; /* :::::::::::::::::::: */
8210
8211 case FFELEX_typeEOS:
8212 case FFELEX_typeSEMICOLON:
8213 ffesta_confirmed ();
8214 break;
8215 }
8216 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlMODULE);
8217 if (!ffesrc_is_name_init (*p))
8218 goto bad_im; /* :::::::::::::::::::: */
8219 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
8220 if (!ffesta_is_inhibited ())
8221 ffestc_R1105 (nt);
8222 ffelex_token_kill (nt);
8223 return (ffelexHandler) ffesta_zero (t);
8224 }
8225
8226 /* Here we know that we're indeed looking at a MODULEPROCEDURE
8227 statement rather than MODULE and that the character following
8228 MODULEPROCEDURE in the NAMES token is a valid first character for a
8229 NAME. This means that unless the second token is COMMA, we have an
8230 ambiguous statement that can be read either as MODULE PROCEDURE name
8231 or MODULE PROCEDUREname, the former being an R1205, the latter an
8232 R1105. */
8233
8234 if (ffesta_first_kw != FFESTR_firstMODULEPROCEDURE)
8235 goto bad_0; /* :::::::::::::::::::: */
8236 switch (ffelex_token_type (t))
8237 {
8238 case FFELEX_typeCOLONCOLON:
8239 ffesta_confirmed (); /* Error, but clearly intended. */
8240 goto bad_1; /* :::::::::::::::::::: */
8241
8242 default:
8243 goto bad_1; /* :::::::::::::::::::: */
8244
8245 case FFELEX_typeCOMMA: /* Aha, clearly not MODULE PROCEDUREname. */
8246 ffesta_confirmed ();
8247 ffestb_local_.moduleprocedure.started = FALSE;
8248 ffesta_tokens[1]
8249 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
8250 return (ffelexHandler) ffestb_module2_ (t);
8251
8252 case FFELEX_typeEOS: /* MODULE PROCEDURE name or MODULE
8253 PROCEDUREname. */
8254 case FFELEX_typeSEMICOLON:
8255 ffesta_confirmed ();
8256 break;
8257 }
8258 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
8259 mt = ffelex_token_name_from_names (ffesta_tokens[0], FFESTR_firstlMODULE,
8260 0);
8261 if (!ffesta_is_inhibited ())
8262 ffestc_module (mt, nt); /* Implement ambiguous statement. */
8263 ffelex_token_kill (nt);
8264 ffelex_token_kill (mt);
8265 return (ffelexHandler) ffesta_zero (t);
8266
8267 default:
8268 goto bad_0; /* :::::::::::::::::::: */
8269 }
8270
8271bad_0: /* :::::::::::::::::::: */
8272 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", ffesta_tokens[0]);
8273 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8274
8275bad_1: /* :::::::::::::::::::: */
8276 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", t);
8277 return (ffelexHandler) ffelex_swallow_tokens (t,
8278 (ffelexHandler) ffesta_zero); /* Invalid second token. */
8279
8280bad_1m: /* :::::::::::::::::::: */
8281 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE", t);
8282 return (ffelexHandler) ffelex_swallow_tokens (t,
8283 (ffelexHandler) ffesta_zero); /* Invalid second token. */
8284
8285bad_im: /* :::::::::::::::::::: */
8286 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "MODULE", ffesta_tokens[0], i, t);
8287 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8288}
8289
8290/* ffestb_module1_ -- "MODULEPROCEDURE" or "MODULE" "PROCEDURE"
8291
8292 return ffestb_module1_; // to lexer
8293
8294 Make sure the statement has a valid form for the MODULEPROCEDURE statement. If it
8295 does, implement the statement. */
8296
8297static ffelexHandler
8298ffestb_module1_ (ffelexToken t)
8299{
8300 switch (ffelex_token_type (t))
8301 {
8302 case FFELEX_typeNAME:
8303 if (!ffestb_local_.moduleprocedure.started
8304 && (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME))
8305 {
8306 ffesta_confirmed ();
8307 ffelex_token_kill (ffesta_tokens[1]);
8308 }
8309 ffesta_tokens[1] = ffelex_token_use (t);
8310 return (ffelexHandler) ffestb_module2_;
8311
8312 case FFELEX_typeEOS:
8313 case FFELEX_typeSEMICOLON:
8314 if (ffestb_local_.moduleprocedure.started)
8315 break; /* Error if we've already seen NAME COMMA. */
8316 ffesta_confirmed ();
8317 if (!ffesta_is_inhibited ())
8318 ffestc_R1105 (ffesta_tokens[1]);
8319 ffelex_token_kill (ffesta_tokens[1]);
8320 return (ffelexHandler) ffesta_zero (t);
8321
8322 case FFELEX_typeCOMMA:
8323 case FFELEX_typeCOLONCOLON:
8324 ffesta_confirmed (); /* Error, but clearly intended. */
8325 break;
8326
8327 default:
8328 break;
8329 }
8330
8331 if (ffestb_local_.moduleprocedure.started && !ffesta_is_inhibited ())
8332 ffestc_R1205_finish ();
8333 else if (!ffestb_local_.moduleprocedure.started)
8334 ffelex_token_kill (ffesta_tokens[1]);
8335 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", t);
8336 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8337}
8338
8339/* ffestb_module2_ -- "MODULE/PROCEDURE" NAME
8340
8341 return ffestb_module2_; // to lexer
8342
8343 Make sure the statement has a valid form for the MODULEPROCEDURE statement. If it
8344 does, implement the statement. */
8345
8346static ffelexHandler
8347ffestb_module2_ (ffelexToken t)
8348{
8349 switch (ffelex_token_type (t))
8350 {
8351 case FFELEX_typeEOS:
8352 case FFELEX_typeSEMICOLON:
8353 if (!ffestb_local_.moduleprocedure.started)
8354 {
8355 ffesta_confirmed ();
8356 if (!ffesta_is_inhibited ())
8357 ffestc_R1205_start ();
8358 }
8359 if (!ffesta_is_inhibited ())
8360 {
8361 ffestc_R1205_item (ffesta_tokens[1]);
8362 ffestc_R1205_finish ();
8363 }
8364 ffelex_token_kill (ffesta_tokens[1]);
8365 return (ffelexHandler) ffesta_zero (t);
8366
8367 case FFELEX_typeCOMMA:
8368 if (!ffestb_local_.moduleprocedure.started)
8369 {
8370 ffestb_local_.moduleprocedure.started = TRUE;
8371 ffesta_confirmed ();
8372 if (!ffesta_is_inhibited ())
8373 ffestc_R1205_start ();
8374 }
8375 if (!ffesta_is_inhibited ())
8376 ffestc_R1205_item (ffesta_tokens[1]);
8377 ffelex_token_kill (ffesta_tokens[1]);
8378 return (ffelexHandler) ffestb_module1_;
8379
8380 default:
8381 break;
8382 }
8383
8384 if (ffestb_local_.moduleprocedure.started && !ffesta_is_inhibited ())
8385 ffestc_R1205_finish ();
8386 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", t);
8387 ffelex_token_kill (ffesta_tokens[1]);
8388 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8389}
8390
8391/* ffestb_module3_ -- "MODULE" NAME
8392
8393 return ffestb_module3_; // to lexer
8394
8395 Make sure the statement has a valid form for the MODULE statement. If it
8396 does, implement the statement. */
8397
8398static ffelexHandler
8399ffestb_module3_ (ffelexToken t)
8400{
8401 switch (ffelex_token_type (t))
8402 {
8403 case FFELEX_typeEOS:
8404 case FFELEX_typeSEMICOLON:
8405 if (!ffesta_is_inhibited ())
8406 ffestc_R1105 (ffesta_tokens[1]);
8407 ffelex_token_kill (ffesta_tokens[1]);
8408 return (ffelexHandler) ffesta_zero (t);
8409
8410 default:
8411 break;
8412 }
8413
8414 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE", t);
8415 ffelex_token_kill (ffesta_tokens[1]);
8416 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8417}
8418
8419#endif
8420/* ffestb_R809 -- Parse the SELECTCASE statement
8421
8422 return ffestb_R809; // to lexer
8423
8424 Make sure the statement has a valid form for the SELECTCASE statement.
8425 If it does, implement the statement. */
8426
8427ffelexHandler
8428ffestb_R809 (ffelexToken t)
8429{
8430 ffeTokenLength i;
8431 char *p;
8432
8433 switch (ffelex_token_type (ffesta_tokens[0]))
8434 {
8435 case FFELEX_typeNAME:
8436 switch (ffesta_first_kw)
8437 {
8438 case FFESTR_firstSELECT:
8439 if ((ffelex_token_type (t) != FFELEX_typeNAME)
8440 || (ffesta_second_kw != FFESTR_secondCASE))
8441 goto bad_1; /* :::::::::::::::::::: */
8442 ffesta_confirmed ();
8443 return (ffelexHandler) ffestb_R8091_;
8444
8445 case FFESTR_firstSELECTCASE:
8446 return (ffelexHandler) ffestb_R8091_ (t);
8447
8448 default:
8449 goto bad_0; /* :::::::::::::::::::: */
8450 }
8451
8452 case FFELEX_typeNAMES:
8453 if (ffesta_first_kw != FFESTR_firstSELECTCASE)
8454 goto bad_0; /* :::::::::::::::::::: */
8455 switch (ffelex_token_type (t))
8456 {
8457 case FFELEX_typeCOMMA:
8458 case FFELEX_typeEOS:
8459 case FFELEX_typeSEMICOLON:
8460 case FFELEX_typeCOLONCOLON:
8461 ffesta_confirmed (); /* Error, but clearly intended. */
8462 goto bad_1; /* :::::::::::::::::::: */
8463
8464 default:
8465 goto bad_1; /* :::::::::::::::::::: */
8466
8467 case FFELEX_typeOPEN_PAREN:
8468 break;
8469 }
8470 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSELECTCASE);
8471 if (*p != '\0')
8472 goto bad_i; /* :::::::::::::::::::: */
8473 return (ffelexHandler) ffestb_R8091_ (t);
8474
8475 default:
8476 goto bad_0; /* :::::::::::::::::::: */
8477 }
8478
8479bad_0: /* :::::::::::::::::::: */
8480 if (ffesta_construct_name != NULL)
8481 {
8482 ffelex_token_kill (ffesta_construct_name);
8483 ffesta_construct_name = NULL;
8484 }
8485 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", ffesta_tokens[0]);
8486 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8487
8488bad_1: /* :::::::::::::::::::: */
8489 if (ffesta_construct_name != NULL)
8490 {
8491 ffelex_token_kill (ffesta_construct_name);
8492 ffesta_construct_name = NULL;
8493 }
8494 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", t);
8495 return (ffelexHandler) ffelex_swallow_tokens (t,
8496 (ffelexHandler) ffesta_zero); /* Invalid second token. */
8497
8498bad_i: /* :::::::::::::::::::: */
8499 if (ffesta_construct_name != NULL)
8500 {
8501 ffelex_token_kill (ffesta_construct_name);
8502 ffesta_construct_name = NULL;
8503 }
8504 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", ffesta_tokens[0], i, t);
8505 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8506}
8507
8508/* ffestb_R8091_ -- "SELECTCASE" or "SELECT" "CASE"
8509
8510 return ffestb_R8091_; // to lexer
8511
8512 Make sure the statement has a valid form for the SELECTCASE statement. If it
8513 does, implement the statement. */
8514
8515static ffelexHandler
8516ffestb_R8091_ (ffelexToken t)
8517{
8518 switch (ffelex_token_type (t))
8519 {
8520 case FFELEX_typeOPEN_PAREN:
8521 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
8522 FFEEXPR_contextSELECTCASE, (ffeexprCallback) ffestb_R8092_);
8523
8524 case FFELEX_typeEOS:
8525 case FFELEX_typeSEMICOLON:
8526 case FFELEX_typeCOMMA:
8527 case FFELEX_typeCOLONCOLON:
8528 ffesta_confirmed (); /* Error, but clearly intended. */
8529 break;
8530
8531 default:
8532 break;
8533 }
8534
8535 if (ffesta_construct_name != NULL)
8536 {
8537 ffelex_token_kill (ffesta_construct_name);
8538 ffesta_construct_name = NULL;
8539 }
8540 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", t);
8541 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8542}
8543
8544/* ffestb_R8092_ -- "SELECT/CASE" OPEN_PAREN expr
8545
8546 (ffestb_R8092_) // to expression handler
8547
8548 Make sure the statement has a valid form for the SELECTCASE statement. If it
8549 does, implement the statement. */
8550
8551static ffelexHandler
8552ffestb_R8092_ (ffelexToken ft, ffebld expr, ffelexToken t)
8553{
8554 switch (ffelex_token_type (t))
8555 {
8556 case FFELEX_typeCLOSE_PAREN:
8557 if (expr == NULL)
8558 break;
8559 ffesta_tokens[1] = ffelex_token_use (ft);
8560 ffestb_local_.selectcase.expr = expr;
8561 return (ffelexHandler) ffestb_R8093_;
8562
8563 default:
8564 break;
8565 }
8566
8567 if (ffesta_construct_name != NULL)
8568 {
8569 ffelex_token_kill (ffesta_construct_name);
8570 ffesta_construct_name = NULL;
8571 }
8572 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", t);
8573 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8574}
8575
8576/* ffestb_R8093_ -- "SELECT/CASE" OPEN_PAREN expr CLOSE_PAREN
8577
8578 return ffestb_R8093_; // to lexer
8579
8580 Make sure the statement has a valid form for the SELECTCASE statement. If it
8581 does, implement the statement. */
8582
8583static ffelexHandler
8584ffestb_R8093_ (ffelexToken t)
8585{
8586 switch (ffelex_token_type (t))
8587 {
8588 case FFELEX_typeEOS:
8589 case FFELEX_typeSEMICOLON:
8590 ffesta_confirmed ();
8591 if (!ffesta_is_inhibited ())
8592 ffestc_R809 (ffesta_construct_name, ffestb_local_.selectcase.expr,
8593 ffesta_tokens[1]);
8594 ffelex_token_kill (ffesta_tokens[1]);
8595 if (ffesta_construct_name != NULL)
8596 {
8597 ffelex_token_kill (ffesta_construct_name);
8598 ffesta_construct_name = NULL;
8599 }
8600 return ffesta_zero (t);
8601
8602 case FFELEX_typeCOMMA:
8603 case FFELEX_typeCOLONCOLON:
8604 ffesta_confirmed (); /* Error, but clearly intended. */
8605 break;
8606
8607 default:
8608 break;
8609 }
8610
8611 ffelex_token_kill (ffesta_tokens[1]);
8612 if (ffesta_construct_name != NULL)
8613 {
8614 ffelex_token_kill (ffesta_construct_name);
8615 ffesta_construct_name = NULL;
8616 }
8617 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", t);
8618 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8619}
8620
8621/* ffestb_R810 -- Parse the CASE statement
8622
8623 return ffestb_R810; // to lexer
8624
8625 Make sure the statement has a valid form for the CASE statement.
8626 If it does, implement the statement. */
8627
8628ffelexHandler
8629ffestb_R810 (ffelexToken t)
8630{
8631 ffeTokenLength i;
8632 char *p;
8633
8634 switch (ffelex_token_type (ffesta_tokens[0]))
8635 {
8636 case FFELEX_typeNAME:
8637 if (ffesta_first_kw != FFESTR_firstCASE)
8638 goto bad_0; /* :::::::::::::::::::: */
8639 switch (ffelex_token_type (t))
8640 {
8641 case FFELEX_typeCOMMA:
8642 case FFELEX_typeEOS:
8643 case FFELEX_typeSEMICOLON:
8644 case FFELEX_typeCOLONCOLON:
8645 ffesta_confirmed (); /* Error, but clearly intended. */
8646 goto bad_1; /* :::::::::::::::::::: */
8647
8648 default:
8649 goto bad_1; /* :::::::::::::::::::: */
8650
8651 case FFELEX_typeNAME:
8652 ffesta_confirmed ();
8653 if (ffesta_second_kw != FFESTR_secondDEFAULT)
8654 goto bad_1; /* :::::::::::::::::::: */
8655 ffestb_local_.case_stmt.cases = NULL;
8656 return (ffelexHandler) ffestb_R8101_;
8657
8658 case FFELEX_typeOPEN_PAREN:
8659 ffestb_local_.case_stmt.cases = ffestt_caselist_create ();
8660 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
8661 FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8103_);
8662 }
8663
8664 case FFELEX_typeNAMES:
8665 switch (ffesta_first_kw)
8666 {
8667 case FFESTR_firstCASEDEFAULT:
8668 switch (ffelex_token_type (t))
8669 {
8670 case FFELEX_typeCOMMA:
8671 case FFELEX_typeCOLONCOLON:
8672 ffesta_confirmed (); /* Error, but clearly intended. */
8673 goto bad_1; /* :::::::::::::::::::: */
8674
8675 default:
8676 goto bad_1; /* :::::::::::::::::::: */
8677
8678 case FFELEX_typeEOS:
8679 case FFELEX_typeSEMICOLON:
8680 ffesta_confirmed ();
8681 break;
8682 }
8683 ffestb_local_.case_stmt.cases = NULL;
8684 p = ffelex_token_text (ffesta_tokens[0])
8685 + (i = FFESTR_firstlCASEDEFAULT);
8686 if (*p == '\0')
8687 return (ffelexHandler) ffestb_R8101_ (t);
8688 if (!ffesrc_is_name_init (*p))
8689 goto bad_i; /* :::::::::::::::::::: */
8690 ffesta_tokens[1] = ffelex_token_name_from_names (ffesta_tokens[0], i,
8691 0);
8692 return (ffelexHandler) ffestb_R8102_ (t);
8693
8694 case FFESTR_firstCASE:
8695 break;
8696
8697 default:
8698 goto bad_0; /* :::::::::::::::::::: */
8699 }
8700
8701 switch (ffelex_token_type (t))
8702 {
8703 case FFELEX_typeCOMMA:
8704 case FFELEX_typeEOS:
8705 case FFELEX_typeSEMICOLON:
8706 case FFELEX_typeCOLONCOLON:
8707 ffesta_confirmed (); /* Error, but clearly intended. */
8708 goto bad_1; /* :::::::::::::::::::: */
8709
8710 default:
8711 goto bad_1; /* :::::::::::::::::::: */
8712
8713 case FFELEX_typeOPEN_PAREN:
8714 break;
8715 }
8716 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCASE);
8717 if (*p != '\0')
8718 goto bad_i; /* :::::::::::::::::::: */
8719 ffestb_local_.case_stmt.cases = ffestt_caselist_create ();
8720 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
8721 FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8103_);
8722
8723 default:
8724 goto bad_0; /* :::::::::::::::::::: */
8725 }
8726
8727bad_0: /* :::::::::::::::::::: */
8728 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", ffesta_tokens[0]);
8729 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8730
8731bad_1: /* :::::::::::::::::::: */
8732 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
8733 return (ffelexHandler) ffelex_swallow_tokens (t,
8734 (ffelexHandler) ffesta_zero); /* Invalid second token. */
8735
8736bad_i: /* :::::::::::::::::::: */
8737 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CASE", ffesta_tokens[0], i, t);
8738 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8739}
8740
8741/* ffestb_R8101_ -- "CASE" case-selector
8742
8743 return ffestb_R8101_; // to lexer
8744
8745 Make sure the statement has a valid form for the CASE statement. If it
8746 does, implement the statement. */
8747
8748static ffelexHandler
8749ffestb_R8101_ (ffelexToken t)
8750{
8751 switch (ffelex_token_type (t))
8752 {
8753 case FFELEX_typeNAME:
8754 ffesta_tokens[1] = ffelex_token_use (t);
8755 return (ffelexHandler) ffestb_R8102_;
8756
8757 case FFELEX_typeEOS:
8758 case FFELEX_typeSEMICOLON:
8759 ffesta_tokens[1] = NULL;
8760 return (ffelexHandler) ffestb_R8102_ (t);
8761
8762 case FFELEX_typeCOMMA:
8763 case FFELEX_typeCOLONCOLON:
8764 ffesta_confirmed (); /* Error, but clearly intended. */
8765 break;
8766
8767 default:
8768 break;
8769 }
8770
8771 if (ffestb_local_.case_stmt.cases != NULL)
8772 ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
8773 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
8774 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8775}
8776
8777/* ffestb_R8102_ -- "CASE" case-selector [NAME]
8778
8779 return ffestb_R8102_; // to lexer
8780
8781 Make sure the statement has a valid form for the CASE statement. If it
8782 does, implement the statement. */
8783
8784static ffelexHandler
8785ffestb_R8102_ (ffelexToken t)
8786{
8787 switch (ffelex_token_type (t))
8788 {
8789 case FFELEX_typeEOS:
8790 case FFELEX_typeSEMICOLON:
8791 ffesta_confirmed ();
8792 if (!ffesta_is_inhibited ())
8793 ffestc_R810 (ffestb_local_.case_stmt.cases, ffesta_tokens[1]);
8794 if (ffestb_local_.case_stmt.cases != NULL)
8795 ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
8796 if (ffesta_tokens[1] != NULL)
8797 ffelex_token_kill (ffesta_tokens[1]);
8798 return (ffelexHandler) ffesta_zero (t);
8799
8800 case FFELEX_typeCOMMA:
8801 case FFELEX_typeCOLONCOLON:
8802 ffesta_confirmed (); /* Error, but clearly intended. */
8803 break;
8804
8805 default:
8806 break;
8807 }
8808
8809 if (ffestb_local_.case_stmt.cases != NULL)
8810 ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
8811 if (ffesta_tokens[1] != NULL)
8812 ffelex_token_kill (ffesta_tokens[1]);
8813 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
8814 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8815}
8816
8817/* ffestb_R8103_ -- "CASE" OPEN_PAREN expr
8818
8819 (ffestb_R8103_) // to expression handler
8820
8821 Make sure the statement has a valid form for the CASE statement. If it
8822 does, implement the statement. */
8823
8824static ffelexHandler
8825ffestb_R8103_ (ffelexToken ft, ffebld expr, ffelexToken t)
8826{
8827 switch (ffelex_token_type (t))
8828 {
8829 case FFELEX_typeCLOSE_PAREN:
8830 ffestt_caselist_append (ffestb_local_.case_stmt.cases, FALSE, expr, NULL,
8831 ffelex_token_use (ft));
8832 return (ffelexHandler) ffestb_R8101_;
8833
8834 case FFELEX_typeCOMMA:
8835 ffestt_caselist_append (ffestb_local_.case_stmt.cases, FALSE, expr, NULL,
8836 ffelex_token_use (ft));
8837 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
8838 FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8103_);
8839
8840 case FFELEX_typeCOLON:
8841 ffestt_caselist_append (ffestb_local_.case_stmt.cases, TRUE, expr, NULL,
8842 ffelex_token_use (ft)); /* NULL second expr for
8843 now, just plug in. */
8844 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
8845 FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8104_);
8846
8847 default:
8848 break;
8849 }
8850
8851 ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
8852 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
8853 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8854}
8855
8856/* ffestb_R8104_ -- "CASE" OPEN_PAREN expr COLON expr
8857
8858 (ffestb_R8104_) // to expression handler
8859
8860 Make sure the statement has a valid form for the CASE statement. If it
8861 does, implement the statement. */
8862
8863static ffelexHandler
8864ffestb_R8104_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
8865{
8866 switch (ffelex_token_type (t))
8867 {
8868 case FFELEX_typeCLOSE_PAREN:
8869 ffestb_local_.case_stmt.cases->previous->expr2 = expr;
8870 return (ffelexHandler) ffestb_R8101_;
8871
8872 case FFELEX_typeCOMMA:
8873 ffestb_local_.case_stmt.cases->previous->expr2 = expr;
8874 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
8875 FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8103_);
8876
8877 default:
8878 break;
8879 }
8880
8881 ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
8882 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
8883 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8884}
8885
8886/* ffestb_R1001 -- Parse a FORMAT statement
8887
8888 return ffestb_R1001; // to lexer
8889
8890 Make sure the statement has a valid form for an FORMAT statement.
8891 If it does, implement the statement. */
8892
8893ffelexHandler
8894ffestb_R1001 (ffelexToken t)
8895{
8896 ffesttFormatList f;
8897
8898 switch (ffelex_token_type (ffesta_tokens[0]))
8899 {
8900 case FFELEX_typeNAME:
8901 if (ffesta_first_kw != FFESTR_firstFORMAT)
8902 goto bad_0; /* :::::::::::::::::::: */
8903 break;
8904
8905 case FFELEX_typeNAMES:
8906 if (ffesta_first_kw != FFESTR_firstFORMAT)
8907 goto bad_0; /* :::::::::::::::::::: */
8908 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlFORMAT)
8909 goto bad_0; /* :::::::::::::::::::: */
8910 break;
8911
8912 default:
8913 goto bad_0; /* :::::::::::::::::::: */
8914 }
8915
8916 switch (ffelex_token_type (t))
8917 {
8918 case FFELEX_typeOPEN_PAREN:
8919 ffestb_local_.format.complained = FALSE;
8920 ffestb_local_.format.f = NULL; /* No parent yet. */
8921 ffestb_local_.format.f = ffestt_formatlist_create (NULL,
8922 ffelex_token_use (t));
8923 ffelex_set_names_pure (TRUE); /* Have even free-form lexer give us
8924 NAMES. */
8925 return (ffelexHandler) ffestb_R10011_;
8926
8927 case FFELEX_typeOPEN_ARRAY:/* "(/". */
8928 ffesta_confirmed ();
8929 ffestb_local_.format.complained = FALSE;
8930 ffestb_local_.format.f = ffestt_formatlist_create (NULL,
8931 ffelex_token_use (t));
8932 f = ffestt_formatlist_append (ffestb_local_.format.f);
8933 f->type = FFESTP_formattypeSLASH;
8934 f->t = ffelex_token_use (t);
8935 f->u.R1010.val.present = FALSE;
8936 f->u.R1010.val.rtexpr = FALSE;
8937 f->u.R1010.val.t = NULL;
8938 f->u.R1010.val.u.unsigned_val = 1;
8939 ffelex_set_names_pure (TRUE); /* Have even free-form lexer give us
8940 NAMES. */
8941 return (ffelexHandler) ffestb_R100112_;
8942
8943 case FFELEX_typeEOS:
8944 case FFELEX_typeSEMICOLON:
8945 case FFELEX_typeCOMMA:
8946 case FFELEX_typeCOLONCOLON:
8947 ffesta_confirmed (); /* Error, but clearly intended. */
8948 goto bad_1; /* :::::::::::::::::::: */
8949
8950 default:
8951 goto bad_1; /* :::::::::::::::::::: */
8952 }
8953
8954bad_0: /* :::::::::::::::::::: */
8955 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", ffesta_tokens[0]);
8956 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8957
8958bad_1: /* :::::::::::::::::::: */
8959 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
8960 return (ffelexHandler) ffelex_swallow_tokens (t,
8961 (ffelexHandler) ffesta_zero); /* Invalid second token. */
8962}
8963
8964/* ffestb_R10011_ -- "FORMAT" OPEN_PAREN expr
8965
8966 return ffestb_R10011_; // to lexer
8967
8968 For CLOSE_PAREN, wrap up the format list and if it is the top-level one,
8969 exit. For anything else, pass it to _2_. */
8970
8971static ffelexHandler
8972ffestb_R10011_ (ffelexToken t)
8973{
8974 ffesttFormatList f;
8975
8976 switch (ffelex_token_type (t))
8977 {
8978 case FFELEX_typeCLOSE_PAREN:
8979 break;
8980
8981 default:
8982 return (ffelexHandler) ffestb_R10012_ (t);
8983 }
8984
8985 /* If we have a format we're working on, continue working on it. */
8986
8987 f = ffestb_local_.format.f->u.root.parent;
8988
8989 if (f != NULL)
8990 {
8991 ffestb_local_.format.f = f->next;
8992 return (ffelexHandler) ffestb_R100111_;
8993 }
8994
8995 return (ffelexHandler) ffestb_R100114_;
8996}
8997
8998/* ffestb_R10012_ -- "FORMAT" OPEN_PAREN [format-item-list]
8999
9000 return ffestb_R10012_; // to lexer
9001
9002 The initial state for a format-item. Here, just handle the initial
9003 number, sign for number, or run-time expression. Also handle spurious
9004 comma, close-paren (indicating spurious comma), close-array (like
9005 close-paren but preceded by slash), and quoted strings. */
9006
9007static ffelexHandler
9008ffestb_R10012_ (ffelexToken t)
9009{
9010 unsigned long unsigned_val;
9011 ffesttFormatList f;
9012
9013 switch (ffelex_token_type (t))
9014 {
9015 case FFELEX_typeOPEN_ANGLE:
9016 ffesta_confirmed ();
9017 ffestb_local_.format.pre.t = ffelex_token_use (t);
9018 ffelex_set_names_pure (FALSE);
9019 if (!ffesta_seen_first_exec && !ffestb_local_.format.complained)
9020 {
9021 ffestb_local_.format.complained = TRUE;
9022 ffebad_start (FFEBAD_FORMAT_EXPR_SPEC);
9023 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
9024 ffebad_finish ();
9025 }
9026 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
9027 FFEEXPR_contextFORMAT, (ffeexprCallback) ffestb_R100115_);
9028
9029 case FFELEX_typeNUMBER:
9030 ffestb_local_.format.sign = FALSE; /* No sign present. */
9031 ffestb_local_.format.pre.present = TRUE;
9032 ffestb_local_.format.pre.rtexpr = FALSE;
9033 ffestb_local_.format.pre.t = ffelex_token_use (t);
9034 ffestb_local_.format.pre.u.unsigned_val = unsigned_val
9035 = strtoul (ffelex_token_text (t), NULL, 10);
9036 ffelex_set_expecting_hollerith (unsigned_val, '\0',
9037 ffelex_token_where_line (t),
9038 ffelex_token_where_column (t));
9039 return (ffelexHandler) ffestb_R10014_;
9040
9041 case FFELEX_typePLUS:
9042 ffestb_local_.format.sign = TRUE; /* Positive. */
9043 ffestb_local_.format.pre.t = ffelex_token_use (t);
9044 return (ffelexHandler) ffestb_R10013_;
9045
9046 case FFELEX_typeMINUS:
9047 ffestb_local_.format.sign = FALSE; /* Negative. */
9048 ffestb_local_.format.pre.t = ffelex_token_use (t);
9049 return (ffelexHandler) ffestb_R10013_;
9050
9051 case FFELEX_typeCOLON:
9052 case FFELEX_typeCOLONCOLON:/* "::". */
9053 case FFELEX_typeSLASH:
9054 case FFELEX_typeCONCAT: /* "//". */
9055 case FFELEX_typeNAMES:
9056 case FFELEX_typeDOLLAR:
9057 case FFELEX_typeOPEN_PAREN:
9058 case FFELEX_typeOPEN_ARRAY:/* "(/". */
9059 ffestb_local_.format.sign = FALSE; /* No sign present. */
9060 ffestb_local_.format.pre.present = FALSE;
9061 ffestb_local_.format.pre.rtexpr = FALSE;
9062 ffestb_local_.format.pre.t = NULL;
9063 ffestb_local_.format.pre.u.unsigned_val = 1;
9064 return (ffelexHandler) ffestb_R10014_ (t);
9065
9066 case FFELEX_typeCOMMA:
9067 ffebad_start (FFEBAD_FORMAT_EXTRA_COMMA);
9068 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
9069 ffebad_finish ();
9070 return (ffelexHandler) ffestb_R10012_;
9071
9072 case FFELEX_typeCLOSE_PAREN:
9073 ffebad_start (FFEBAD_FORMAT_EXTRA_COMMA);
9074 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
9075 ffebad_finish ();
9076 f = ffestb_local_.format.f->u.root.parent;
9077 if (f == NULL)
9078 return (ffelexHandler) ffestb_R100114_;
9079 ffestb_local_.format.f = f->next;
9080 return (ffelexHandler) ffestb_R100111_;
9081
9082 case FFELEX_typeCLOSE_ARRAY: /* "/)". */
9083 f = ffestt_formatlist_append (ffestb_local_.format.f);
9084 f->type = FFESTP_formattypeSLASH;
9085 f->t = ffelex_token_use (t);
9086 f->u.R1010.val.present = FALSE;
9087 f->u.R1010.val.rtexpr = FALSE;
9088 f->u.R1010.val.t = NULL;
9089 f->u.R1010.val.u.unsigned_val = 1;
9090 f = ffestb_local_.format.f->u.root.parent;
9091 if (f == NULL)
9092 return (ffelexHandler) ffestb_R100114_;
9093 ffestb_local_.format.f = f->next;
9094 return (ffelexHandler) ffestb_R100111_;
9095
9096 case FFELEX_typeEOS:
9097 case FFELEX_typeSEMICOLON:
9098 ffesta_confirmed ();
9099 ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_PAREN, t);
9100 for (f = ffestb_local_.format.f;
9101 f->u.root.parent != NULL;
9102 f = f->u.root.parent->next)
9103 ;
9104 ffestb_local_.format.f = f;
9105 return (ffelexHandler) ffestb_R100114_ (t);
9106
9107 case FFELEX_typeQUOTE:
9108 if (ffe_is_vxt ())
9109 break; /* Error, probably something like FORMAT("17)
9110 = X. */
9111 ffelex_set_expecting_hollerith (-1, '\"',
9112 ffelex_token_where_line (t),
9113 ffelex_token_where_column (t)); /* Don't have to unset
9114 this one. */
9115 return (ffelexHandler) ffestb_R100113_;
9116
9117 case FFELEX_typeAPOSTROPHE:
9118#if 0 /* No apparent need for this, and not killed
9119 anywhere. */
9120 ffesta_tokens[1] = ffelex_token_use (t);
9121#endif
9122 ffelex_set_expecting_hollerith (-1, '\'',
9123 ffelex_token_where_line (t),
9124 ffelex_token_where_column (t)); /* Don't have to unset
9125 this one. */
9126 return (ffelexHandler) ffestb_R100113_;
9127
9128 default:
9129 break;
9130 }
9131
9132 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
9133 ffestt_formatlist_kill (ffestb_local_.format.f);
9134 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
9135}
9136
9137/* ffestb_R10013_ -- "FORMAT" OPEN_PAREN [format-item-list] PLUS/MINUS
9138
9139 return ffestb_R10013_; // to lexer
9140
9141 Expect a NUMBER or complain about and then ignore the PLUS/MINUS. */
9142
9143static ffelexHandler
9144ffestb_R10013_ (ffelexToken t)
9145{
9146 unsigned long unsigned_val;
9147
9148 switch (ffelex_token_type (t))
9149 {
9150 case FFELEX_typeNUMBER:
9151 ffestb_local_.format.pre.present = TRUE;
9152 ffestb_local_.format.pre.rtexpr = FALSE;
9153 unsigned_val = strtoul (ffelex_token_text (t), NULL, 10);
9154 ffestb_local_.format.pre.u.signed_val = ffestb_local_.format.sign
9155 ? unsigned_val : -unsigned_val;
9156 ffestb_local_.format.sign = TRUE; /* Sign present. */
9157 return (ffelexHandler) ffestb_R10014_;
9158
9159 default:
9160 ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
9161 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
9162 ffelex_token_where_column (ffestb_local_.format.pre.t));
9163 ffebad_finish ();
9164 ffelex_token_kill (ffestb_local_.format.pre.t);
9165 return (ffelexHandler) ffestb_R10012_ (t);
9166 }
9167}
9168
9169/* ffestb_R10014_ -- "FORMAT" OPEN_PAREN [format-item-list] [[+/-] NUMBER]
9170
9171 return ffestb_R10014_; // to lexer
9172
9173 Here is where we expect to see the actual NAMES, COLON, SLASH, OPEN_PAREN,
9174 OPEN_ARRAY, COLONCOLON, CONCAT, DOLLAR, or HOLLERITH that identifies what
9175 kind of format-item we're dealing with. But if we see a NUMBER instead, it
9176 means free-form spaces number like "5 6 X", so scale the current number
9177 accordingly and reenter this state. (I really wouldn't be surprised if
9178 they change this spacing rule in the F90 spec so that you can't embed
9179 spaces within numbers or within keywords like BN in a free-source-form
9180 program.) */
9181
9182static ffelexHandler
9183ffestb_R10014_ (ffelexToken t)
9184{
9185 ffesttFormatList f;
9186 ffeTokenLength i;
9187 char *p;
9188 ffestrFormat kw;
9189
9190 ffelex_set_expecting_hollerith (0, '\0',
9191 ffewhere_line_unknown (),
9192 ffewhere_column_unknown ());
9193
9194 switch (ffelex_token_type (t))
9195 {
9196 case FFELEX_typeHOLLERITH:
9197 f = ffestt_formatlist_append (ffestb_local_.format.f);
9198 f->type = FFESTP_formattypeR1016;
9199 f->t = ffelex_token_use (t);
9200 ffelex_token_kill (ffestb_local_.format.pre.t); /* It WAS present! */
9201 return (ffelexHandler) ffestb_R100111_;
9202
9203 case FFELEX_typeNUMBER:
9204 assert (ffestb_local_.format.pre.present);
9205 ffesta_confirmed ();
9206 if (ffestb_local_.format.pre.rtexpr)
9207 {
9208 ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
9209 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
9210 ffebad_finish ();
9211 return (ffelexHandler) ffestb_R10014_;
9212 }
9213 if (ffestb_local_.format.sign)
9214 {
9215 for (i = 0; i < ffelex_token_length (t); ++i)
9216 ffestb_local_.format.pre.u.signed_val *= 10;
9217 ffestb_local_.format.pre.u.signed_val += strtoul (ffelex_token_text (t),
9218 NULL, 10);
9219 }
9220 else
9221 {
9222 for (i = 0; i < ffelex_token_length (t); ++i)
9223 ffestb_local_.format.pre.u.unsigned_val *= 10;
9224 ffestb_local_.format.pre.u.unsigned_val += strtoul (ffelex_token_text (t),
9225 NULL, 10);
9226 ffelex_set_expecting_hollerith (ffestb_local_.format.pre.u.unsigned_val,
9227 '\0',
9228 ffelex_token_where_line (t),
9229 ffelex_token_where_column (t));
9230 }
9231 return (ffelexHandler) ffestb_R10014_;
9232
9233 case FFELEX_typeCOLONCOLON: /* "::". */
9234 if (ffestb_local_.format.pre.present)
9235 {
9236 ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_COLON_SPEC,
9237 ffestb_local_.format.pre.t);
9238 ffelex_token_kill (ffestb_local_.format.pre.t);
9239 ffestb_local_.format.pre.present = FALSE;
9240 }
9241 else
9242 {
9243 f = ffestt_formatlist_append (ffestb_local_.format.f);
9244 f->type = FFESTP_formattypeCOLON;
9245 f->t = ffelex_token_use (t);
9246 f->u.R1010.val.present = FALSE;
9247 f->u.R1010.val.rtexpr = FALSE;
9248 f->u.R1010.val.t = NULL;
9249 f->u.R1010.val.u.unsigned_val = 1;
9250 }
9251 f = ffestt_formatlist_append (ffestb_local_.format.f);
9252 f->type = FFESTP_formattypeCOLON;
9253 f->t = ffelex_token_use (t);
9254 f->u.R1010.val.present = FALSE;
9255 f->u.R1010.val.rtexpr = FALSE;
9256 f->u.R1010.val.t = NULL;
9257 f->u.R1010.val.u.unsigned_val = 1;
9258 return (ffelexHandler) ffestb_R100112_;
9259
9260 case FFELEX_typeCOLON:
9261 if (ffestb_local_.format.pre.present)
9262 {
9263 ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_COLON_SPEC,
9264 ffestb_local_.format.pre.t);
9265 ffelex_token_kill (ffestb_local_.format.pre.t);
9266 return (ffelexHandler) ffestb_R100112_;
9267 }
9268 f = ffestt_formatlist_append (ffestb_local_.format.f);
9269 f->type = FFESTP_formattypeCOLON;
9270 f->t = ffelex_token_use (t);
9271 f->u.R1010.val.present = FALSE;
9272 f->u.R1010.val.rtexpr = FALSE;
9273 f->u.R1010.val.t = NULL;
9274 f->u.R1010.val.u.unsigned_val = 1;
9275 return (ffelexHandler) ffestb_R100112_;
9276
9277 case FFELEX_typeCONCAT: /* "//". */
9278 if (ffestb_local_.format.sign)
9279 {
9280 ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
9281 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
9282 ffelex_token_where_column (ffestb_local_.format.pre.t));
9283 ffebad_finish ();
9284 ffestb_local_.format.pre.u.unsigned_val
9285 = (ffestb_local_.format.pre.u.signed_val < 0)
9286 ? -ffestb_local_.format.pre.u.signed_val
9287 : ffestb_local_.format.pre.u.signed_val;
9288 }
9289 f = ffestt_formatlist_append (ffestb_local_.format.f);
9290 f->type = FFESTP_formattypeSLASH;
9291 f->t = ffelex_token_use (t);
9292 f->u.R1010.val = ffestb_local_.format.pre;
9293 ffestb_local_.format.pre.present = FALSE;
9294 ffestb_local_.format.pre.rtexpr = FALSE;
9295 ffestb_local_.format.pre.t = NULL;
9296 ffestb_local_.format.pre.u.unsigned_val = 1;
9297 f = ffestt_formatlist_append (ffestb_local_.format.f);
9298 f->type = FFESTP_formattypeSLASH;
9299 f->t = ffelex_token_use (t);
9300 f->u.R1010.val = ffestb_local_.format.pre;
9301 return (ffelexHandler) ffestb_R100112_;
9302
9303 case FFELEX_typeSLASH:
9304 if (ffestb_local_.format.sign)
9305 {
9306 ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
9307 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
9308 ffelex_token_where_column (ffestb_local_.format.pre.t));
9309 ffebad_finish ();
9310 ffestb_local_.format.pre.u.unsigned_val
9311 = (ffestb_local_.format.pre.u.signed_val < 0)
9312 ? -ffestb_local_.format.pre.u.signed_val
9313 : ffestb_local_.format.pre.u.signed_val;
9314 }
9315 f = ffestt_formatlist_append (ffestb_local_.format.f);
9316 f->type = FFESTP_formattypeSLASH;
9317 f->t = ffelex_token_use (t);
9318 f->u.R1010.val = ffestb_local_.format.pre;
9319 return (ffelexHandler) ffestb_R100112_;
9320
9321 case FFELEX_typeOPEN_PAREN:
9322 if (ffestb_local_.format.sign)
9323 {
9324 ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
9325 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
9326 ffelex_token_where_column (ffestb_local_.format.pre.t));
9327 ffebad_finish ();
9328 ffestb_local_.format.pre.u.unsigned_val
9329 = (ffestb_local_.format.pre.u.signed_val < 0)
9330 ? -ffestb_local_.format.pre.u.signed_val
9331 : ffestb_local_.format.pre.u.signed_val;
9332 }
9333 f = ffestt_formatlist_append (ffestb_local_.format.f);
9334 f->type = FFESTP_formattypeFORMAT;
9335 f->t = ffelex_token_use (t);
9336 f->u.R1003D.R1004 = ffestb_local_.format.pre;
9337 f->u.R1003D.format = ffestb_local_.format.f
9338 = ffestt_formatlist_create (f, ffelex_token_use (t));
9339 return (ffelexHandler) ffestb_R10011_;
9340
9341 case FFELEX_typeOPEN_ARRAY:/* "(/". */
9342 if (ffestb_local_.format.sign)
9343 {
9344 ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
9345 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
9346 ffelex_token_where_column (ffestb_local_.format.pre.t));
9347 ffebad_finish ();
9348 ffestb_local_.format.pre.u.unsigned_val
9349 = (ffestb_local_.format.pre.u.signed_val < 0)
9350 ? -ffestb_local_.format.pre.u.signed_val
9351 : ffestb_local_.format.pre.u.signed_val;
9352 }
9353 f = ffestt_formatlist_append (ffestb_local_.format.f);
9354 f->type = FFESTP_formattypeFORMAT;
9355 f->t = ffelex_token_use (t);
9356 f->u.R1003D.R1004 = ffestb_local_.format.pre;
9357 f->u.R1003D.format = ffestb_local_.format.f
9358 = ffestt_formatlist_create (f, ffelex_token_use (t));
9359 f = ffestt_formatlist_append (ffestb_local_.format.f);
9360 f->type = FFESTP_formattypeSLASH;
9361 f->t = ffelex_token_use (t);
9362 f->u.R1010.val.present = FALSE;
9363 f->u.R1010.val.rtexpr = FALSE;
9364 f->u.R1010.val.t = NULL;
9365 f->u.R1010.val.u.unsigned_val = 1;
9366 return (ffelexHandler) ffestb_R100112_;
9367
9368 case FFELEX_typeCLOSE_ARRAY: /* "/)". */
9369 f = ffestt_formatlist_append (ffestb_local_.format.f);
9370 f->type = FFESTP_formattypeSLASH;
9371 f->t = ffelex_token_use (t);
9372 f->u.R1010.val = ffestb_local_.format.pre;
9373 f = ffestb_local_.format.f->u.root.parent;
9374 if (f == NULL)
9375 return (ffelexHandler) ffestb_R100114_;
9376 ffestb_local_.format.f = f->next;
9377 return (ffelexHandler) ffestb_R100111_;
9378
9379 case FFELEX_typeQUOTE:
9380 if (ffe_is_vxt ())
9381 break; /* A totally bad character in a VXT FORMAT. */
9382 ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
9383 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
9384 ffelex_token_where_column (ffestb_local_.format.pre.t));
9385 ffebad_finish ();
9386 ffelex_token_kill (ffestb_local_.format.pre.t);
9387 ffesta_confirmed ();
9388#if 0 /* No apparent need for this, and not killed
9389 anywhere. */
9390 ffesta_tokens[1] = ffelex_token_use (t);
9391#endif
9392 ffelex_set_expecting_hollerith (-1, '\"',
9393 ffelex_token_where_line (t),
9394 ffelex_token_where_column (t)); /* Don't have to unset
9395 this one. */
9396 return (ffelexHandler) ffestb_R100113_;
9397
9398 case FFELEX_typeAPOSTROPHE:
9399 ffesta_confirmed ();
9400 ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
9401 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
9402 ffelex_token_where_column (ffestb_local_.format.pre.t));
9403 ffebad_finish ();
9404 ffelex_token_kill (ffestb_local_.format.pre.t);
9405#if 0 /* No apparent need for this, and not killed
9406 anywhere. */
9407 ffesta_tokens[1] = ffelex_token_use (t);
9408#endif
9409 ffelex_set_expecting_hollerith (-1, '\'', ffelex_token_where_line (t),
9410 ffelex_token_where_column (t)); /* Don't have to unset
9411 this one. */
9412 return (ffelexHandler) ffestb_R100113_;
9413
9414 case FFELEX_typeEOS:
9415 case FFELEX_typeSEMICOLON:
9416 ffesta_confirmed ();
9417 ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_PAREN, t);
9418 for (f = ffestb_local_.format.f;
9419 f->u.root.parent != NULL;
9420 f = f->u.root.parent->next)
9421 ;
9422 ffestb_local_.format.f = f;
9423 ffelex_token_kill (ffestb_local_.format.pre.t);
9424 return (ffelexHandler) ffestb_R100114_ (t);
9425
9426 case FFELEX_typeDOLLAR:
9427 ffestb_local_.format.t = ffelex_token_use (t);
9428 if (ffestb_local_.format.pre.present)
9429 ffesta_confirmed (); /* Number preceding this invalid elsewhere. */
9430 ffestb_local_.format.current = FFESTP_formattypeDOLLAR;
9431 return (ffelexHandler) ffestb_R10015_;
9432
9433 case FFELEX_typeNAMES:
9434 kw = ffestr_format (t);
9435 ffestb_local_.format.t = ffelex_token_use (t);
9436 switch (kw)
9437 {
9438 case FFESTR_formatI:
9439 if (ffestb_local_.format.pre.present)
9440 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9441 ffestb_local_.format.current = FFESTP_formattypeI;
9442 i = FFESTR_formatlI;
9443 break;
9444
9445 case FFESTR_formatB:
9446 if (ffestb_local_.format.pre.present)
9447 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9448 ffestb_local_.format.current = FFESTP_formattypeB;
9449 i = FFESTR_formatlB;
9450 break;
9451
9452 case FFESTR_formatO:
9453 if (ffestb_local_.format.pre.present)
9454 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9455 ffestb_local_.format.current = FFESTP_formattypeO;
9456 i = FFESTR_formatlO;
9457 break;
9458
9459 case FFESTR_formatZ:
9460 if (ffestb_local_.format.pre.present)
9461 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9462 ffestb_local_.format.current = FFESTP_formattypeZ;
9463 i = FFESTR_formatlZ;
9464 break;
9465
9466 case FFESTR_formatF:
9467 if (ffestb_local_.format.pre.present)
9468 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9469 ffestb_local_.format.current = FFESTP_formattypeF;
9470 i = FFESTR_formatlF;
9471 break;
9472
9473 case FFESTR_formatE:
9474 ffestb_local_.format.current = FFESTP_formattypeE;
9475 i = FFESTR_formatlE;
9476 break;
9477
9478 case FFESTR_formatEN:
9479 if (ffestb_local_.format.pre.present)
9480 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9481 ffestb_local_.format.current = FFESTP_formattypeEN;
9482 i = FFESTR_formatlEN;
9483 break;
9484
9485 case FFESTR_formatG:
9486 if (ffestb_local_.format.pre.present)
9487 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9488 ffestb_local_.format.current = FFESTP_formattypeG;
9489 i = FFESTR_formatlG;
9490 break;
9491
9492 case FFESTR_formatL:
9493 if (ffestb_local_.format.pre.present)
9494 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9495 ffestb_local_.format.current = FFESTP_formattypeL;
9496 i = FFESTR_formatlL;
9497 break;
9498
9499 case FFESTR_formatA:
9500 if (ffestb_local_.format.pre.present)
9501 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9502 ffestb_local_.format.current = FFESTP_formattypeA;
9503 i = FFESTR_formatlA;
9504 break;
9505
9506 case FFESTR_formatD:
9507 ffestb_local_.format.current = FFESTP_formattypeD;
9508 i = FFESTR_formatlD;
9509 break;
9510
9511 case FFESTR_formatQ:
9512 ffestb_local_.format.current = FFESTP_formattypeQ;
9513 i = FFESTR_formatlQ;
9514 break;
9515
9516 case FFESTR_formatDOLLAR:
9517 if (ffestb_local_.format.pre.present)
9518 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9519 ffestb_local_.format.current = FFESTP_formattypeDOLLAR;
9520 i = FFESTR_formatlDOLLAR;
9521 break;
9522
9523 case FFESTR_formatP:
9524 if (ffestb_local_.format.pre.present)
9525 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9526 ffestb_local_.format.current = FFESTP_formattypeP;
9527 i = FFESTR_formatlP;
9528 break;
9529
9530 case FFESTR_formatT:
9531 if (ffestb_local_.format.pre.present)
9532 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9533 ffestb_local_.format.current = FFESTP_formattypeT;
9534 i = FFESTR_formatlT;
9535 break;
9536
9537 case FFESTR_formatTL:
9538 if (ffestb_local_.format.pre.present)
9539 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9540 ffestb_local_.format.current = FFESTP_formattypeTL;
9541 i = FFESTR_formatlTL;
9542 break;
9543
9544 case FFESTR_formatTR:
9545 if (ffestb_local_.format.pre.present)
9546 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9547 ffestb_local_.format.current = FFESTP_formattypeTR;
9548 i = FFESTR_formatlTR;
9549 break;
9550
9551 case FFESTR_formatX:
9552 if (ffestb_local_.format.pre.present)
9553 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9554 ffestb_local_.format.current = FFESTP_formattypeX;
9555 i = FFESTR_formatlX;
9556 break;
9557
9558 case FFESTR_formatS:
9559 if (ffestb_local_.format.pre.present)
9560 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9561 ffestb_local_.format.current = FFESTP_formattypeS;
9562 i = FFESTR_formatlS;
9563 break;
9564
9565 case FFESTR_formatSP:
9566 if (ffestb_local_.format.pre.present)
9567 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9568 ffestb_local_.format.current = FFESTP_formattypeSP;
9569 i = FFESTR_formatlSP;
9570 break;
9571
9572 case FFESTR_formatSS:
9573 if (ffestb_local_.format.pre.present)
9574 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9575 ffestb_local_.format.current = FFESTP_formattypeSS;
9576 i = FFESTR_formatlSS;
9577 break;
9578
9579 case FFESTR_formatBN:
9580 if (ffestb_local_.format.pre.present)
9581 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9582 ffestb_local_.format.current = FFESTP_formattypeBN;
9583 i = FFESTR_formatlBN;
9584 break;
9585
9586 case FFESTR_formatBZ:
9587 if (ffestb_local_.format.pre.present)
9588 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9589 ffestb_local_.format.current = FFESTP_formattypeBZ;
9590 i = FFESTR_formatlBZ;
9591 break;
9592
9593 case FFESTR_formatH: /* Error, either "H" or "<expr>H". */
9594 if (ffestb_local_.format.pre.present)
9595 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9596 ffestb_local_.format.current = FFESTP_formattypeH;
9597 i = FFESTR_formatlH;
9598 break;
9599
9600 case FFESTR_formatPD:
9601 if (ffestb_local_.format.pre.present)
9602 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9603 ffestb_subr_R1001_append_p_ ();
9604 ffestb_local_.format.t = ffelex_token_name_from_names (t,
9605 FFESTR_formatlP, 1);
9606 ffestb_local_.format.sign = FALSE;
9607 ffestb_local_.format.pre.present = FALSE;
9608 ffestb_local_.format.pre.rtexpr = FALSE;
9609 ffestb_local_.format.pre.t = NULL;
9610 ffestb_local_.format.pre.u.unsigned_val = 1;
9611 ffestb_local_.format.current = FFESTP_formattypeD;
9612 i = FFESTR_formatlPD;
9613 break;
9614
9615 case FFESTR_formatPE:
9616 if (ffestb_local_.format.pre.present)
9617 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9618 ffestb_subr_R1001_append_p_ ();
9619 ffestb_local_.format.t = ffelex_token_name_from_names (t,
9620 FFESTR_formatlP, 1);
9621 ffestb_local_.format.sign = FALSE;
9622 ffestb_local_.format.pre.present = FALSE;
9623 ffestb_local_.format.pre.rtexpr = FALSE;
9624 ffestb_local_.format.pre.t = NULL;
9625 ffestb_local_.format.pre.u.unsigned_val = 1;
9626 ffestb_local_.format.current = FFESTP_formattypeE;
9627 i = FFESTR_formatlPE;
9628 break;
9629
9630 case FFESTR_formatPEN:
9631 if (ffestb_local_.format.pre.present)
9632 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9633 ffestb_subr_R1001_append_p_ ();
9634 ffestb_local_.format.t = ffelex_token_name_from_names (t,
9635 FFESTR_formatlP, 1);
9636 ffestb_local_.format.sign = FALSE;
9637 ffestb_local_.format.pre.present = FALSE;
9638 ffestb_local_.format.pre.rtexpr = FALSE;
9639 ffestb_local_.format.pre.t = NULL;
9640 ffestb_local_.format.pre.u.unsigned_val = 1;
9641 ffestb_local_.format.current = FFESTP_formattypeEN;
9642 i = FFESTR_formatlPEN;
9643 break;
9644
9645 case FFESTR_formatPF:
9646 if (ffestb_local_.format.pre.present)
9647 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9648 ffestb_subr_R1001_append_p_ ();
9649 ffestb_local_.format.t = ffelex_token_name_from_names (t,
9650 FFESTR_formatlP, 1);
9651 ffestb_local_.format.sign = FALSE;
9652 ffestb_local_.format.pre.present = FALSE;
9653 ffestb_local_.format.pre.rtexpr = FALSE;
9654 ffestb_local_.format.pre.t = NULL;
9655 ffestb_local_.format.pre.u.unsigned_val = 1;
9656 ffestb_local_.format.current = FFESTP_formattypeF;
9657 i = FFESTR_formatlPF;
9658 break;
9659
9660 case FFESTR_formatPG:
9661 if (ffestb_local_.format.pre.present)
9662 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9663 ffestb_subr_R1001_append_p_ ();
9664 ffestb_local_.format.t = ffelex_token_name_from_names (t,
9665 FFESTR_formatlP, 1);
9666 ffestb_local_.format.sign = FALSE;
9667 ffestb_local_.format.pre.present = FALSE;
9668 ffestb_local_.format.pre.rtexpr = FALSE;
9669 ffestb_local_.format.pre.t = NULL;
9670 ffestb_local_.format.pre.u.unsigned_val = 1;
9671 ffestb_local_.format.current = FFESTP_formattypeG;
9672 i = FFESTR_formatlPG;
9673 break;
9674
9675 default:
9676 if (ffestb_local_.format.pre.present)
9677 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9678 ffestb_local_.format.current = FFESTP_formattypeNone;
9679 p = strpbrk (ffelex_token_text (t), "0123456789");
9680 if (p == NULL)
9681 i = ffelex_token_length (t);
9682 else
9683 i = p - ffelex_token_text (t);
9684 break;
9685 }
9686 p = ffelex_token_text (t) + i;
9687 if (*p == '\0')
9688 return (ffelexHandler) ffestb_R10015_;
9689 if (!isdigit (*p))
9690 {
9691 if (ffestb_local_.format.current == FFESTP_formattypeH)
9692 p = strpbrk (p, "0123456789");
9693 else
9694 {
9695 p = NULL;
9696 ffestb_local_.format.current = FFESTP_formattypeNone;
9697 }
9698 if (p == NULL)
9699 return (ffelexHandler) ffestb_R10015_;
9700 i = p - ffelex_token_text (t); /* Collect digits. */
9701 }
9702 ffestb_local_.format.post.present = TRUE;
9703 ffestb_local_.format.post.rtexpr = FALSE;
9704 ffestb_local_.format.post.t = ffelex_token_number_from_names (t, i);
9705 ffestb_local_.format.post.u.unsigned_val
9706 = strtoul (ffelex_token_text (ffestb_local_.format.post.t), NULL, 10);
9707 p += ffelex_token_length (ffestb_local_.format.post.t);
9708 i += ffelex_token_length (ffestb_local_.format.post.t);
9709 if (*p == '\0')
9710 return (ffelexHandler) ffestb_R10016_;
9711 if ((kw != FFESTR_formatP) || !ffelex_is_firstnamechar (*p))
9712 {
9713 if (ffestb_local_.format.current != FFESTP_formattypeH)
9714 ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL);
9715 return (ffelexHandler) ffestb_R10016_;
9716 }
9717
9718 /* Here we have [number]P[number][text]. Treat as
9719 [number]P,[number][text]. */
9720
9721 ffestb_subr_R1001_append_p_ ();
9722 t = ffestb_local_.format.t = ffelex_token_names_from_names (t, i, 0);
9723 ffestb_local_.format.sign = FALSE;
9724 ffestb_local_.format.pre = ffestb_local_.format.post;
9725 kw = ffestr_format (t);
9726 switch (kw)
9727 { /* Only a few possibilities here. */
9728 case FFESTR_formatD:
9729 ffestb_local_.format.current = FFESTP_formattypeD;
9730 i = FFESTR_formatlD;
9731 break;
9732
9733 case FFESTR_formatE:
9734 ffestb_local_.format.current = FFESTP_formattypeE;
9735 i = FFESTR_formatlE;
9736 break;
9737
9738 case FFESTR_formatEN:
9739 ffestb_local_.format.current = FFESTP_formattypeEN;
9740 i = FFESTR_formatlEN;
9741 break;
9742
9743 case FFESTR_formatF:
9744 ffestb_local_.format.current = FFESTP_formattypeF;
9745 i = FFESTR_formatlF;
9746 break;
9747
9748 case FFESTR_formatG:
9749 ffestb_local_.format.current = FFESTP_formattypeG;
9750 i = FFESTR_formatlG;
9751 break;
9752
9753 default:
9754 ffebad_start (FFEBAD_FORMAT_P_NOCOMMA);
9755 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
9756 ffebad_finish ();
9757 ffestb_local_.format.current = FFESTP_formattypeNone;
9758 p = strpbrk (ffelex_token_text (t), "0123456789");
9759 if (p == NULL)
9760 i = ffelex_token_length (t);
9761 else
9762 i = p - ffelex_token_text (t);
9763 }
9764 p = ffelex_token_text (t) + i;
9765 if (*p == '\0')
9766 return (ffelexHandler) ffestb_R10015_;
9767 if (!isdigit (*p))
9768 {
9769 ffestb_local_.format.current = FFESTP_formattypeNone;
9770 p = strpbrk (p, "0123456789");
9771 if (p == NULL)
9772 return (ffelexHandler) ffestb_R10015_;
9773 i = p - ffelex_token_text (t); /* Collect digits anyway. */
9774 }
9775 ffestb_local_.format.post.present = TRUE;
9776 ffestb_local_.format.post.rtexpr = FALSE;
9777 ffestb_local_.format.post.t = ffelex_token_number_from_names (t, i);
9778 ffestb_local_.format.post.u.unsigned_val
9779 = strtoul (ffelex_token_text (ffestb_local_.format.post.t), NULL, 10);
9780 p += ffelex_token_length (ffestb_local_.format.post.t);
9781 i += ffelex_token_length (ffestb_local_.format.post.t);
9782 if (*p == '\0')
9783 return (ffelexHandler) ffestb_R10016_;
9784 ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL);
9785 return (ffelexHandler) ffestb_R10016_;
9786
9787 default:
9788 break;
9789 }
9790
9791 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
9792 if (ffestb_local_.format.pre.present)
9793 ffelex_token_kill (ffestb_local_.format.pre.t);
9794 ffestt_formatlist_kill (ffestb_local_.format.f);
9795 return (ffelexHandler) ffelex_swallow_tokens (t,
9796 (ffelexHandler) ffesta_zero);
9797}
9798
9799/* ffestb_R10015_ -- [[+/-] NUMBER] NAMES
9800
9801 return ffestb_R10015_; // to lexer
9802
9803 Here we've gotten at least the initial mnemonic for the edit descriptor.
9804 We expect either a NUMBER, for the post-mnemonic value, a NAMES, for
9805 further clarification (in free-form only, sigh) of the mnemonic, or
9806 anything else. In all cases we go to _6_, with the difference that for
9807 NUMBER and NAMES we send the next token rather than the current token. */
9808
9809static ffelexHandler
9810ffestb_R10015_ (ffelexToken t)
9811{
9812 bool split_pea; /* New NAMES requires splitting kP from new
9813 edit desc. */
9814 ffestrFormat kw;
9815 char *p;
9816 ffeTokenLength i;
9817
9818 switch (ffelex_token_type (t))
9819 {
9820 case FFELEX_typeOPEN_ANGLE:
9821 ffesta_confirmed ();
9822 ffestb_local_.format.post.t = ffelex_token_use (t);
9823 ffelex_set_names_pure (FALSE);
9824 if (!ffesta_seen_first_exec && !ffestb_local_.format.complained)
9825 {
9826 ffestb_local_.format.complained = TRUE;
9827 ffebad_start (FFEBAD_FORMAT_EXPR_SPEC);
9828 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
9829 ffebad_finish ();
9830 }
9831 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
9832 FFEEXPR_contextFORMAT, (ffeexprCallback) ffestb_R100116_);
9833
9834 case FFELEX_typeNUMBER:
9835 ffestb_local_.format.post.present = TRUE;
9836 ffestb_local_.format.post.rtexpr = FALSE;
9837 ffestb_local_.format.post.t = ffelex_token_use (t);
9838 ffestb_local_.format.post.u.unsigned_val
9839 = strtoul (ffelex_token_text (t), NULL, 10);
9840 return (ffelexHandler) ffestb_R10016_;
9841
9842 case FFELEX_typeNAMES:
9843 ffesta_confirmed (); /* NAMES " " NAMES invalid elsewhere in
9844 free-form. */
9845 kw = ffestr_format (t);
9846 switch (ffestb_local_.format.current)
9847 {
9848 case FFESTP_formattypeP:
9849 split_pea = TRUE;
9850 break;
9851
9852 case FFESTP_formattypeH: /* An error, maintain this indicator. */
9853 kw = FFESTR_formatNone;
9854 split_pea = FALSE;
9855 break;
9856
9857 default:
9858 split_pea = FALSE;
9859 break;
9860 }
9861
9862 switch (kw)
9863 {
9864 case FFESTR_formatF:
9865 switch (ffestb_local_.format.current)
9866 {
9867 case FFESTP_formattypeP:
9868 ffestb_local_.format.current = FFESTP_formattypeF;
9869 break;
9870
9871 default:
9872 ffestb_local_.format.current = FFESTP_formattypeNone;
9873 break;
9874 }
9875 i = FFESTR_formatlF;
9876 break;
9877
9878 case FFESTR_formatE:
9879 switch (ffestb_local_.format.current)
9880 {
9881 case FFESTP_formattypeP:
9882 ffestb_local_.format.current = FFESTP_formattypeE;
9883 break;
9884
9885 default:
9886 ffestb_local_.format.current = FFESTP_formattypeNone;
9887 break;
9888 }
9889 i = FFESTR_formatlE;
9890 break;
9891
9892 case FFESTR_formatEN:
9893 switch (ffestb_local_.format.current)
9894 {
9895 case FFESTP_formattypeP:
9896 ffestb_local_.format.current = FFESTP_formattypeEN;
9897 break;
9898
9899 default:
9900 ffestb_local_.format.current = FFESTP_formattypeNone;
9901 break;
9902 }
9903 i = FFESTR_formatlEN;
9904 break;
9905
9906 case FFESTR_formatG:
9907 switch (ffestb_local_.format.current)
9908 {
9909 case FFESTP_formattypeP:
9910 ffestb_local_.format.current = FFESTP_formattypeG;
9911 break;
9912
9913 default:
9914 ffestb_local_.format.current = FFESTP_formattypeNone;
9915 break;
9916 }
9917 i = FFESTR_formatlG;
9918 break;
9919
9920 case FFESTR_formatL:
9921 switch (ffestb_local_.format.current)
9922 {
9923 case FFESTP_formattypeT:
9924 ffestb_local_.format.current = FFESTP_formattypeTL;
9925 break;
9926
9927 default:
9928 ffestb_local_.format.current = FFESTP_formattypeNone;
9929 break;
9930 }
9931 i = FFESTR_formatlL;
9932 break;
9933
9934 case FFESTR_formatD:
9935 switch (ffestb_local_.format.current)
9936 {
9937 case FFESTP_formattypeP:
9938 ffestb_local_.format.current = FFESTP_formattypeD;
9939 break;
9940
9941 default:
9942 ffestb_local_.format.current = FFESTP_formattypeNone;
9943 break;
9944 }
9945 i = FFESTR_formatlD;
9946 break;
9947
9948 case FFESTR_formatS:
9949 switch (ffestb_local_.format.current)
9950 {
9951 case FFESTP_formattypeS:
9952 ffestb_local_.format.current = FFESTP_formattypeSS;
9953 break;
9954
9955 default:
9956 ffestb_local_.format.current = FFESTP_formattypeNone;
9957 break;
9958 }
9959 i = FFESTR_formatlS;
9960 break;
9961
9962 case FFESTR_formatP:
9963 switch (ffestb_local_.format.current)
9964 {
9965 case FFESTP_formattypeS:
9966 ffestb_local_.format.current = FFESTP_formattypeSP;
9967 break;
9968
9969 default:
9970 ffestb_local_.format.current = FFESTP_formattypeNone;
9971 break;
9972 }
9973 i = FFESTR_formatlP;
9974 break;
9975
9976 case FFESTR_formatR:
9977 switch (ffestb_local_.format.current)
9978 {
9979 case FFESTP_formattypeT:
9980 ffestb_local_.format.current = FFESTP_formattypeTR;
9981 break;
9982
9983 default:
9984 ffestb_local_.format.current = FFESTP_formattypeNone;
9985 break;
9986 }
9987 i = FFESTR_formatlR;
9988 break;
9989
9990 case FFESTR_formatZ:
9991 switch (ffestb_local_.format.current)
9992 {
9993 case FFESTP_formattypeB:
9994 ffestb_local_.format.current = FFESTP_formattypeBZ;
9995 break;
9996
9997 default:
9998 ffestb_local_.format.current = FFESTP_formattypeNone;
9999 break;
10000 }
10001 i = FFESTR_formatlZ;
10002 break;
10003
10004 case FFESTR_formatN:
10005 switch (ffestb_local_.format.current)
10006 {
10007 case FFESTP_formattypeE:
10008 ffestb_local_.format.current = FFESTP_formattypeEN;
10009 break;
10010
10011 case FFESTP_formattypeB:
10012 ffestb_local_.format.current = FFESTP_formattypeBN;
10013 break;
10014
10015 default:
10016 ffestb_local_.format.current = FFESTP_formattypeNone;
10017 break;
10018 }
10019 i = FFESTR_formatlN;
10020 break;
10021
10022 default:
10023 if (ffestb_local_.format.current != FFESTP_formattypeH)
10024 ffestb_local_.format.current = FFESTP_formattypeNone;
10025 split_pea = FALSE; /* Go ahead and let the P be in the party. */
10026 p = strpbrk (ffelex_token_text (t), "0123456789");
10027 if (p == NULL)
10028 i = ffelex_token_length (t);
10029 else
10030 i = p - ffelex_token_text (t);
10031 }
10032
10033 if (split_pea)
10034 {
10035 ffestb_subr_R1001_append_p_ ();
10036 ffestb_local_.format.t = ffelex_token_use (t);
10037 ffestb_local_.format.sign = FALSE;
10038 ffestb_local_.format.pre.present = FALSE;
10039 ffestb_local_.format.pre.rtexpr = FALSE;
10040 ffestb_local_.format.pre.t = NULL;
10041 ffestb_local_.format.pre.u.unsigned_val = 1;
10042 }
10043
10044 p = ffelex_token_text (t) + i;
10045 if (*p == '\0')
10046 return (ffelexHandler) ffestb_R10015_;
10047 if (!isdigit (*p))
10048 {
10049 ffestb_local_.format.current = FFESTP_formattypeNone;
10050 p = strpbrk (p, "0123456789");
10051 if (p == NULL)
10052 return (ffelexHandler) ffestb_R10015_;
10053 i = p - ffelex_token_text (t); /* Collect digits anyway. */
10054 }
10055 ffestb_local_.format.post.present = TRUE;
10056 ffestb_local_.format.post.rtexpr = FALSE;
10057 ffestb_local_.format.post.t = ffelex_token_number_from_names (t, i);
10058 ffestb_local_.format.post.u.unsigned_val
10059 = strtoul (ffelex_token_text (ffestb_local_.format.post.t), NULL, 10);
10060 p += ffelex_token_length (ffestb_local_.format.post.t);
10061 i += ffelex_token_length (ffestb_local_.format.post.t);
10062 if (*p == '\0')
10063 return (ffelexHandler) ffestb_R10016_;
10064 ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL);
10065 return (ffelexHandler) ffestb_R10016_;
10066
10067 default:
10068 ffestb_local_.format.post.present = FALSE;
10069 ffestb_local_.format.post.rtexpr = FALSE;
10070 ffestb_local_.format.post.t = NULL;
10071 ffestb_local_.format.post.u.unsigned_val = 1;
10072 return (ffelexHandler) ffestb_R10016_ (t);
10073 }
10074}
10075
10076/* ffestb_R10016_ -- [[+/-] NUMBER] NAMES NUMBER
10077
10078 return ffestb_R10016_; // to lexer
10079
10080 Expect a PERIOD here. Maybe find a NUMBER to append to the current
10081 number, in which case return to this state. Maybe find a NAMES to switch
10082 from a kP descriptor to a new descriptor (else the NAMES is spurious),
10083 in which case generator the P item and go to state _4_. Anything
10084 else, pass token on to state _8_. */
10085
10086static ffelexHandler
10087ffestb_R10016_ (ffelexToken t)
10088{
10089 ffeTokenLength i;
10090
10091 switch (ffelex_token_type (t))
10092 {
10093 case FFELEX_typePERIOD:
10094 return (ffelexHandler) ffestb_R10017_;
10095
10096 case FFELEX_typeNUMBER:
10097 assert (ffestb_local_.format.post.present);
10098 ffesta_confirmed ();
10099 if (ffestb_local_.format.post.rtexpr)
10100 {
10101 ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
10102 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
10103 ffebad_finish ();
10104 return (ffelexHandler) ffestb_R10016_;
10105 }
10106 for (i = 0; i < ffelex_token_length (t); ++i)
10107 ffestb_local_.format.post.u.unsigned_val *= 10;
10108 ffestb_local_.format.post.u.unsigned_val += strtoul (ffelex_token_text (t),
10109 NULL, 10);
10110 return (ffelexHandler) ffestb_R10016_;
10111
10112 case FFELEX_typeNAMES:
10113 ffesta_confirmed (); /* NUMBER " " NAMES invalid elsewhere. */
10114 if (ffestb_local_.format.current != FFESTP_formattypeP)
10115 {
10116 ffesta_ffebad_1t (FFEBAD_FORMAT_TEXT_IN_NUMBER, t);
10117 return (ffelexHandler) ffestb_R10016_;
10118 }
10119 ffestb_subr_R1001_append_p_ ();
10120 ffestb_local_.format.sign = FALSE;
10121 ffestb_local_.format.pre = ffestb_local_.format.post;
10122 return (ffelexHandler) ffestb_R10014_ (t);
10123
10124 default:
10125 ffestb_local_.format.dot.present = FALSE;
10126 ffestb_local_.format.dot.rtexpr = FALSE;
10127 ffestb_local_.format.dot.t = NULL;
10128 ffestb_local_.format.dot.u.unsigned_val = 1;
10129 return (ffelexHandler) ffestb_R10018_ (t);
10130 }
10131}
10132
10133/* ffestb_R10017_ -- [[+/-] NUMBER] NAMES NUMBER PERIOD
10134
10135 return ffestb_R10017_; // to lexer
10136
10137 Here we've gotten the period following the edit descriptor.
10138 We expect either a NUMBER, for the dot value, or something else, which
10139 probably means we're not even close to being in a real FORMAT statement. */
10140
10141static ffelexHandler
10142ffestb_R10017_ (ffelexToken t)
10143{
10144 switch (ffelex_token_type (t))
10145 {
10146 case FFELEX_typeOPEN_ANGLE:
10147 ffestb_local_.format.dot.t = ffelex_token_use (t);
10148 ffelex_set_names_pure (FALSE);
10149 if (!ffesta_seen_first_exec && !ffestb_local_.format.complained)
10150 {
10151 ffestb_local_.format.complained = TRUE;
10152 ffebad_start (FFEBAD_FORMAT_EXPR_SPEC);
10153 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
10154 ffebad_finish ();
10155 }
10156 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
10157 FFEEXPR_contextFORMAT, (ffeexprCallback) ffestb_R100117_);
10158
10159 case FFELEX_typeNUMBER:
10160 ffestb_local_.format.dot.present = TRUE;
10161 ffestb_local_.format.dot.rtexpr = FALSE;
10162 ffestb_local_.format.dot.t = ffelex_token_use (t);
10163 ffestb_local_.format.dot.u.unsigned_val
10164 = strtoul (ffelex_token_text (t), NULL, 10);
10165 return (ffelexHandler) ffestb_R10018_;
10166
10167 default:
10168 ffelex_token_kill (ffestb_local_.format.t);
10169 if (ffestb_local_.format.pre.present)
10170 ffelex_token_kill (ffestb_local_.format.pre.t);
10171 if (ffestb_local_.format.post.present)
10172 ffelex_token_kill (ffestb_local_.format.post.t);
10173 ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_DOT, t);
10174 ffestt_formatlist_kill (ffestb_local_.format.f);
10175 return (ffelexHandler) ffelex_swallow_tokens (t,
10176 (ffelexHandler) ffesta_zero);
10177 }
10178}
10179
10180/* ffestb_R10018_ -- [[+/-] NUMBER] NAMES NUMBER PERIOD NUMBER
10181
10182 return ffestb_R10018_; // to lexer
10183
10184 Expect a NAMES here, which must begin with "E" to be valid. Maybe find a
10185 NUMBER to append to the current number, in which case return to this state.
10186 Anything else, pass token on to state _10_. */
10187
10188static ffelexHandler
10189ffestb_R10018_ (ffelexToken t)
10190{
10191 ffeTokenLength i;
10192 char *p;
10193
10194 switch (ffelex_token_type (t))
10195 {
10196 case FFELEX_typeNUMBER:
10197 assert (ffestb_local_.format.dot.present);
10198 ffesta_confirmed ();
10199 if (ffestb_local_.format.dot.rtexpr)
10200 {
10201 ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
10202 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
10203 ffebad_finish ();
10204 return (ffelexHandler) ffestb_R10018_;
10205 }
10206 for (i = 0; i < ffelex_token_length (t); ++i)
10207 ffestb_local_.format.dot.u.unsigned_val *= 10;
10208 ffestb_local_.format.dot.u.unsigned_val += strtoul (ffelex_token_text (t),
10209 NULL, 10);
10210 return (ffelexHandler) ffestb_R10018_;
10211
10212 case FFELEX_typeNAMES:
10213 if (!ffesrc_char_match_init (*(p = ffelex_token_text (t)), 'E', 'e'))
10214 {
10215 ffesta_ffebad_1t (FFEBAD_FORMAT_TEXT_IN_NUMBER, t);
10216 return (ffelexHandler) ffestb_R10018_;
10217 }
10218 if (*++p == '\0')
10219 return (ffelexHandler) ffestb_R10019_; /* Go get NUMBER. */
10220 i = 1;
10221 if (!isdigit (*p))
10222 {
10223 ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, 1, NULL);
10224 return (ffelexHandler) ffestb_R10018_;
10225 }
10226 ffestb_local_.format.exp.present = TRUE;
10227 ffestb_local_.format.exp.rtexpr = FALSE;
10228 ffestb_local_.format.exp.t = ffelex_token_number_from_names (t, i);
10229 ffestb_local_.format.exp.u.unsigned_val
10230 = strtoul (ffelex_token_text (ffestb_local_.format.exp.t), NULL, 10);
10231 p += ffelex_token_length (ffestb_local_.format.exp.t);
10232 i += ffelex_token_length (ffestb_local_.format.exp.t);
10233 if (*p == '\0')
10234 return (ffelexHandler) ffestb_R100110_;
10235 ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL);
10236 return (ffelexHandler) ffestb_R100110_;
10237
10238 default:
10239 ffestb_local_.format.exp.present = FALSE;
10240 ffestb_local_.format.exp.rtexpr = FALSE;
10241 ffestb_local_.format.exp.t = NULL;
10242 ffestb_local_.format.exp.u.unsigned_val = 1;
10243 return (ffelexHandler) ffestb_R100110_ (t);
10244 }
10245}
10246
10247/* ffestb_R10019_ -- [[+/-] NUMBER] NAMES NUMBER PERIOD NUMBER "E"
10248
10249 return ffestb_R10019_; // to lexer
10250
10251 Here we've gotten the "E" following the edit descriptor.
10252 We expect either a NUMBER, for the exponent value, or something else. */
10253
10254static ffelexHandler
10255ffestb_R10019_ (ffelexToken t)
10256{
10257 switch (ffelex_token_type (t))
10258 {
10259 case FFELEX_typeOPEN_ANGLE:
10260 ffestb_local_.format.exp.t = ffelex_token_use (t);
10261 ffelex_set_names_pure (FALSE);
10262 if (!ffesta_seen_first_exec && !ffestb_local_.format.complained)
10263 {
10264 ffestb_local_.format.complained = TRUE;
10265 ffebad_start (FFEBAD_FORMAT_EXPR_SPEC);
10266 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
10267 ffebad_finish ();
10268 }
10269 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
10270 FFEEXPR_contextFORMAT, (ffeexprCallback) ffestb_R100118_);
10271
10272 case FFELEX_typeNUMBER:
10273 ffestb_local_.format.exp.present = TRUE;
10274 ffestb_local_.format.exp.rtexpr = FALSE;
10275 ffestb_local_.format.exp.t = ffelex_token_use (t);
10276 ffestb_local_.format.exp.u.unsigned_val
10277 = strtoul (ffelex_token_text (t), NULL, 10);
10278 return (ffelexHandler) ffestb_R100110_;
10279
10280 default:
10281 ffelex_token_kill (ffestb_local_.format.t);
10282 if (ffestb_local_.format.pre.present)
10283 ffelex_token_kill (ffestb_local_.format.pre.t);
10284 if (ffestb_local_.format.post.present)
10285 ffelex_token_kill (ffestb_local_.format.post.t);
10286 if (ffestb_local_.format.dot.present)
10287 ffelex_token_kill (ffestb_local_.format.dot.t);
10288 ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_EXP, t);
10289 ffestt_formatlist_kill (ffestb_local_.format.f);
10290 return (ffelexHandler) ffelex_swallow_tokens (t,
10291 (ffelexHandler) ffesta_zero);
10292 }
10293}
10294
10295/* ffestb_R100110_ -- [[+/-] NUMBER] NAMES NUMBER [PERIOD NUMBER ["E" NUMBER]]
10296
10297 return ffestb_R100110_; // to lexer
10298
10299 Maybe find a NUMBER to append to the current number, in which case return
10300 to this state. Anything else, handle current descriptor, then pass token
10301 on to state _10_. */
10302
10303static ffelexHandler
10304ffestb_R100110_ (ffelexToken t)
10305{
10306 ffeTokenLength i;
10307 enum expect
10308 {
10309 required,
10310 optional,
10311 disallowed
10312 };
10313 ffebad err;
10314 enum expect pre;
10315 enum expect post;
10316 enum expect dot;
10317 enum expect exp;
10318 bool R1005;
10319 ffesttFormatList f;
10320
10321 switch (ffelex_token_type (t))
10322 {
10323 case FFELEX_typeNUMBER:
10324 assert (ffestb_local_.format.exp.present);
10325 ffesta_confirmed ();
10326 if (ffestb_local_.format.exp.rtexpr)
10327 {
10328 ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
10329 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
10330 ffebad_finish ();
10331 return (ffelexHandler) ffestb_R100110_;
10332 }
10333 for (i = 0; i < ffelex_token_length (t); ++i)
10334 ffestb_local_.format.exp.u.unsigned_val *= 10;
10335 ffestb_local_.format.exp.u.unsigned_val += strtoul (ffelex_token_text (t),
10336 NULL, 10);
10337 return (ffelexHandler) ffestb_R100110_;
10338
10339 default:
10340 if (ffestb_local_.format.sign
10341 && (ffestb_local_.format.current != FFESTP_formattypeP)
10342 && (ffestb_local_.format.current != FFESTP_formattypeH))
10343 {
10344 ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
10345 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
10346 ffelex_token_where_column (ffestb_local_.format.pre.t));
10347 ffebad_finish ();
10348 ffestb_local_.format.pre.u.unsigned_val
10349 = (ffestb_local_.format.pre.u.signed_val < 0)
10350 ? -ffestb_local_.format.pre.u.signed_val
10351 : ffestb_local_.format.pre.u.signed_val;
10352 }
10353 switch (ffestb_local_.format.current)
10354 {
10355 case FFESTP_formattypeI:
10356 err = FFEBAD_FORMAT_BAD_I_SPEC;
10357 pre = optional;
10358 post = required;
10359 dot = optional;
10360 exp = disallowed;
10361 R1005 = TRUE;
10362 break;
10363
10364 case FFESTP_formattypeB:
10365 err = FFEBAD_FORMAT_BAD_B_SPEC;
10366 pre = optional;
10367 post = required;
10368 dot = optional;
10369 exp = disallowed;
10370 R1005 = TRUE;
10371 break;
10372
10373 case FFESTP_formattypeO:
10374 err = FFEBAD_FORMAT_BAD_O_SPEC;
10375 pre = optional;
10376 post = required;
10377 dot = optional;
10378 exp = disallowed;
10379 R1005 = TRUE;
10380 break;
10381
10382 case FFESTP_formattypeZ:
10383 err = FFEBAD_FORMAT_BAD_Z_SPEC;
10384 pre = optional;
10385 post = required;
10386 dot = optional;
10387 exp = disallowed;
10388 R1005 = TRUE;
10389 break;
10390
10391 case FFESTP_formattypeF:
10392 err = FFEBAD_FORMAT_BAD_F_SPEC;
10393 pre = optional;
10394 post = required;
10395 dot = required;
10396 exp = disallowed;
10397 R1005 = TRUE;
10398 break;
10399
10400 case FFESTP_formattypeE:
10401 err = FFEBAD_FORMAT_BAD_E_SPEC;
10402 pre = optional;
10403 post = required;
10404 dot = required;
10405 exp = optional;
10406 R1005 = TRUE;
10407 break;
10408
10409 case FFESTP_formattypeEN:
10410 err = FFEBAD_FORMAT_BAD_EN_SPEC;
10411 pre = optional;
10412 post = required;
10413 dot = required;
10414 exp = optional;
10415 R1005 = TRUE;
10416 break;
10417
10418 case FFESTP_formattypeG:
10419 err = FFEBAD_FORMAT_BAD_G_SPEC;
10420 pre = optional;
10421 post = required;
10422 dot = required;
10423 exp = optional;
10424 R1005 = TRUE;
10425 break;
10426
10427 case FFESTP_formattypeL:
10428 err = FFEBAD_FORMAT_BAD_L_SPEC;
10429 pre = optional;
10430 post = required;
10431 dot = disallowed;
10432 exp = disallowed;
10433 R1005 = TRUE;
10434 break;
10435
10436 case FFESTP_formattypeA:
10437 err = FFEBAD_FORMAT_BAD_A_SPEC;
10438 pre = optional;
10439 post = optional;
10440 dot = disallowed;
10441 exp = disallowed;
10442 R1005 = TRUE;
10443 break;
10444
10445 case FFESTP_formattypeD:
10446 err = FFEBAD_FORMAT_BAD_D_SPEC;
10447 pre = optional;
10448 post = required;
10449 dot = required;
10450 exp = disallowed;
10451 R1005 = TRUE;
10452 break;
10453
10454 case FFESTP_formattypeQ:
10455 err = FFEBAD_FORMAT_BAD_Q_SPEC;
10456 pre = disallowed;
10457 post = disallowed;
10458 dot = disallowed;
10459 exp = disallowed;
10460 R1005 = FALSE;
10461 break;
10462
10463 case FFESTP_formattypeDOLLAR:
10464 err = FFEBAD_FORMAT_BAD_DOLLAR_SPEC;
10465 pre = disallowed;
10466 post = disallowed;
10467 dot = disallowed;
10468 exp = disallowed;
10469 R1005 = FALSE;
10470 break;
10471
10472 case FFESTP_formattypeP:
10473 err = FFEBAD_FORMAT_BAD_P_SPEC;
10474 pre = required;
10475 post = disallowed;
10476 dot = disallowed;
10477 exp = disallowed;
10478 R1005 = FALSE;
10479 break;
10480
10481 case FFESTP_formattypeT:
10482 err = FFEBAD_FORMAT_BAD_T_SPEC;
10483 pre = disallowed;
10484 post = required;
10485 dot = disallowed;
10486 exp = disallowed;
10487 R1005 = FALSE;
10488 break;
10489
10490 case FFESTP_formattypeTL:
10491 err = FFEBAD_FORMAT_BAD_TL_SPEC;
10492 pre = disallowed;
10493 post = required;
10494 dot = disallowed;
10495 exp = disallowed;
10496 R1005 = FALSE;
10497 break;
10498
10499 case FFESTP_formattypeTR:
10500 err = FFEBAD_FORMAT_BAD_TR_SPEC;
10501 pre = disallowed;
10502 post = required;
10503 dot = disallowed;
10504 exp = disallowed;
10505 R1005 = FALSE;
10506 break;
10507
10508 case FFESTP_formattypeX:
10509 err = FFEBAD_FORMAT_BAD_X_SPEC;
10510 pre = required;
10511 post = disallowed;
10512 dot = disallowed;
10513 exp = disallowed;
10514 R1005 = FALSE;
10515 break;
10516
10517 case FFESTP_formattypeS:
10518 err = FFEBAD_FORMAT_BAD_S_SPEC;
10519 pre = disallowed;
10520 post = disallowed;
10521 dot = disallowed;
10522 exp = disallowed;
10523 R1005 = FALSE;
10524 break;
10525
10526 case FFESTP_formattypeSP:
10527 err = FFEBAD_FORMAT_BAD_SP_SPEC;
10528 pre = disallowed;
10529 post = disallowed;
10530 dot = disallowed;
10531 exp = disallowed;
10532 R1005 = FALSE;
10533 break;
10534
10535 case FFESTP_formattypeSS:
10536 err = FFEBAD_FORMAT_BAD_SS_SPEC;
10537 pre = disallowed;
10538 post = disallowed;
10539 dot = disallowed;
10540 exp = disallowed;
10541 R1005 = FALSE;
10542 break;
10543
10544 case FFESTP_formattypeBN:
10545 err = FFEBAD_FORMAT_BAD_BN_SPEC;
10546 pre = disallowed;
10547 post = disallowed;
10548 dot = disallowed;
10549 exp = disallowed;
10550 R1005 = FALSE;
10551 break;
10552
10553 case FFESTP_formattypeBZ:
10554 err = FFEBAD_FORMAT_BAD_BZ_SPEC;
10555 pre = disallowed;
10556 post = disallowed;
10557 dot = disallowed;
10558 exp = disallowed;
10559 R1005 = FALSE;
10560 break;
10561
10562 case FFESTP_formattypeH: /* Definitely an error, make sure of
10563 it. */
10564 err = FFEBAD_FORMAT_BAD_H_SPEC;
10565 pre = ffestb_local_.format.pre.present ? disallowed : required;
10566 post = disallowed;
10567 dot = disallowed;
10568 exp = disallowed;
10569 R1005 = FALSE;
10570 break;
10571
10572 case FFESTP_formattypeNone:
10573 ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_SPEC,
10574 ffestb_local_.format.t);
10575
10576 clean_up_to_11_: /* :::::::::::::::::::: */
10577
10578 ffelex_token_kill (ffestb_local_.format.t);
10579 if (ffestb_local_.format.pre.present)
10580 ffelex_token_kill (ffestb_local_.format.pre.t);
10581 if (ffestb_local_.format.post.present)
10582 ffelex_token_kill (ffestb_local_.format.post.t);
10583 if (ffestb_local_.format.dot.present)
10584 ffelex_token_kill (ffestb_local_.format.dot.t);
10585 if (ffestb_local_.format.exp.present)
10586 ffelex_token_kill (ffestb_local_.format.exp.t);
10587 return (ffelexHandler) ffestb_R100111_ (t);
10588
10589 default:
10590 assert (FALSE);
10591 err = FFEBAD_FORMAT_BAD_H_SPEC;
10592 pre = disallowed;
10593 post = disallowed;
10594 dot = disallowed;
10595 exp = disallowed;
10596 R1005 = FALSE;
10597 break;
10598 }
10599 if (((pre == disallowed) && ffestb_local_.format.pre.present)
10600 || ((pre == required) && !ffestb_local_.format.pre.present))
10601 {
10602 ffesta_ffebad_1t (err, (pre == required)
10603 ? ffestb_local_.format.t : ffestb_local_.format.pre.t);
10604 goto clean_up_to_11_; /* :::::::::::::::::::: */
10605 }
10606 if (((post == disallowed) && ffestb_local_.format.post.present)
10607 || ((post == required) && !ffestb_local_.format.post.present))
10608 {
10609 ffesta_ffebad_1t (err, (post == required)
10610 ? ffestb_local_.format.t : ffestb_local_.format.post.t);
10611 goto clean_up_to_11_; /* :::::::::::::::::::: */
10612 }
10613 if (((dot == disallowed) && ffestb_local_.format.dot.present)
10614 || ((dot == required) && !ffestb_local_.format.dot.present))
10615 {
10616 ffesta_ffebad_1t (err, (dot == required)
10617 ? ffestb_local_.format.t : ffestb_local_.format.dot.t);
10618 goto clean_up_to_11_; /* :::::::::::::::::::: */
10619 }
10620 if (((exp == disallowed) && ffestb_local_.format.exp.present)
10621 || ((exp == required) && !ffestb_local_.format.exp.present))
10622 {
10623 ffesta_ffebad_1t (err, (exp == required)
10624 ? ffestb_local_.format.t : ffestb_local_.format.exp.t);
10625 goto clean_up_to_11_; /* :::::::::::::::::::: */
10626 }
10627 f = ffestt_formatlist_append (ffestb_local_.format.f);
10628 f->type = ffestb_local_.format.current;
10629 f->t = ffestb_local_.format.t;
10630 if (R1005)
10631 {
10632 f->u.R1005.R1004 = ffestb_local_.format.pre;
10633 f->u.R1005.R1006 = ffestb_local_.format.post;
10634 f->u.R1005.R1007_or_R1008 = ffestb_local_.format.dot;
10635 f->u.R1005.R1009 = ffestb_local_.format.exp;
10636 }
10637 else
10638 /* Must be R1010. */
10639 {
10640 if (pre == disallowed)
10641 f->u.R1010.val = ffestb_local_.format.post;
10642 else
10643 f->u.R1010.val = ffestb_local_.format.pre;
10644 }
10645 return (ffelexHandler) ffestb_R100111_ (t);
10646 }
10647}
10648
10649/* ffestb_R100111_ -- edit-descriptor
10650
10651 return ffestb_R100111_; // to lexer
10652
10653 Expect a COMMA, CLOSE_PAREN, CLOSE_ARRAY, COLON, COLONCOLON, SLASH, or
10654 CONCAT, or complain about missing comma. */
10655
10656static ffelexHandler
10657ffestb_R100111_ (ffelexToken t)
10658{
10659 ffesttFormatList f;
10660
10661 switch (ffelex_token_type (t))
10662 {
10663 case FFELEX_typeCOMMA:
10664 return (ffelexHandler) ffestb_R10012_;
10665
10666 case FFELEX_typeCOLON:
10667 case FFELEX_typeCOLONCOLON:
10668 case FFELEX_typeSLASH:
10669 case FFELEX_typeCONCAT:
10670 return (ffelexHandler) ffestb_R10012_ (t);
10671
10672 case FFELEX_typeCLOSE_PAREN:
10673 f = ffestb_local_.format.f->u.root.parent;
10674 if (f == NULL)
10675 return (ffelexHandler) ffestb_R100114_;
10676 ffestb_local_.format.f = f->next;
10677 return (ffelexHandler) ffestb_R100111_;
10678
10679 case FFELEX_typeCLOSE_ARRAY: /* "/)". */
10680 f = ffestt_formatlist_append (ffestb_local_.format.f);
10681 f->type = FFESTP_formattypeSLASH;
10682 f->t = ffelex_token_use (t);
10683 f->u.R1010.val.present = FALSE;
10684 f->u.R1010.val.rtexpr = FALSE;
10685 f->u.R1010.val.t = NULL;
10686 f->u.R1010.val.u.unsigned_val = 1;
10687 f = ffestb_local_.format.f->u.root.parent;
10688 if (f == NULL)
10689 return (ffelexHandler) ffestb_R100114_;
10690 ffestb_local_.format.f = f->next;
10691 return (ffelexHandler) ffestb_R100111_;
10692
10693 case FFELEX_typeOPEN_ANGLE:
10694 case FFELEX_typeDOLLAR:
10695 case FFELEX_typeNUMBER:
10696 case FFELEX_typeOPEN_PAREN:
10697 case FFELEX_typeOPEN_ARRAY:
10698 case FFELEX_typeQUOTE:
10699 case FFELEX_typeAPOSTROPHE:
10700 case FFELEX_typeNAMES:
10701 ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_COMMA, t);
10702 return (ffelexHandler) ffestb_R10012_ (t);
10703
10704 case FFELEX_typeEOS:
10705 case FFELEX_typeSEMICOLON:
10706 ffesta_confirmed ();
10707 ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_PAREN, t);
10708 for (f = ffestb_local_.format.f;
10709 f->u.root.parent != NULL;
10710 f = f->u.root.parent->next)
10711 ;
10712 ffestb_local_.format.f = f;
10713 return (ffelexHandler) ffestb_R100114_ (t);
10714
10715 default:
10716 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
10717 ffestt_formatlist_kill (ffestb_local_.format.f);
10718 return (ffelexHandler) ffelex_swallow_tokens (t,
10719 (ffelexHandler) ffesta_zero);
10720 }
10721}
10722
10723/* ffestb_R100112_ -- COLON, COLONCOLON, SLASH, OPEN_ARRAY, or CONCAT
10724
10725 return ffestb_R100112_; // to lexer
10726
10727 Like _11_ except the COMMA is optional. */
10728
10729static ffelexHandler
10730ffestb_R100112_ (ffelexToken t)
10731{
10732 ffesttFormatList f;
10733
10734 switch (ffelex_token_type (t))
10735 {
10736 case FFELEX_typeCOMMA:
10737 return (ffelexHandler) ffestb_R10012_;
10738
10739 case FFELEX_typeCOLON:
10740 case FFELEX_typeCOLONCOLON:
10741 case FFELEX_typeSLASH:
10742 case FFELEX_typeCONCAT:
10743 case FFELEX_typeOPEN_ANGLE:
10744 case FFELEX_typeNAMES:
10745 case FFELEX_typeDOLLAR:
10746 case FFELEX_typeNUMBER:
10747 case FFELEX_typeOPEN_PAREN:
10748 case FFELEX_typeOPEN_ARRAY:
10749 case FFELEX_typeQUOTE:
10750 case FFELEX_typeAPOSTROPHE:
10751 case FFELEX_typePLUS:
10752 case FFELEX_typeMINUS:
10753 return (ffelexHandler) ffestb_R10012_ (t);
10754
10755 case FFELEX_typeCLOSE_PAREN:
10756 f = ffestb_local_.format.f->u.root.parent;
10757 if (f == NULL)
10758 return (ffelexHandler) ffestb_R100114_;
10759 ffestb_local_.format.f = f->next;
10760 return (ffelexHandler) ffestb_R100111_;
10761
10762 case FFELEX_typeCLOSE_ARRAY: /* "/)". */
10763 f = ffestt_formatlist_append (ffestb_local_.format.f);
10764 f->type = FFESTP_formattypeSLASH;
10765 f->t = ffelex_token_use (t);
10766 f->u.R1010.val.present = FALSE;
10767 f->u.R1010.val.rtexpr = FALSE;
10768 f->u.R1010.val.t = NULL;
10769 f->u.R1010.val.u.unsigned_val = 1;
10770 f = ffestb_local_.format.f->u.root.parent;
10771 if (f == NULL)
10772 return (ffelexHandler) ffestb_R100114_;
10773 ffestb_local_.format.f = f->next;
10774 return (ffelexHandler) ffestb_R100111_;
10775
10776 case FFELEX_typeEOS:
10777 case FFELEX_typeSEMICOLON:
10778 ffesta_confirmed ();
10779 ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_PAREN, t);
10780 for (f = ffestb_local_.format.f;
10781 f->u.root.parent != NULL;
10782 f = f->u.root.parent->next)
10783 ;
10784 ffestb_local_.format.f = f;
10785 return (ffelexHandler) ffestb_R100114_ (t);
10786
10787 default:
10788 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
10789 ffestt_formatlist_kill (ffestb_local_.format.f);
10790 return (ffelexHandler) ffelex_swallow_tokens (t,
10791 (ffelexHandler) ffesta_zero);
10792 }
10793}
10794
10795/* ffestb_R100113_ -- Handle CHARACTER token.
10796
10797 return ffestb_R100113_; // to lexer
10798
10799 Append the format item to the list, go to _11_. */
10800
10801static ffelexHandler
10802ffestb_R100113_ (ffelexToken t)
10803{
10804 ffesttFormatList f;
10805
10806 assert (ffelex_token_type (t) == FFELEX_typeCHARACTER);
10807
10808 if (ffe_is_pedantic_not_90 () && (ffelex_token_length (t) == 0))
10809 {
10810 ffebad_start (FFEBAD_NULL_CHAR_CONST);
10811 ffebad_here (0, ffelex_token_where_line (t),
10812 ffelex_token_where_column (t));
10813 ffebad_finish ();
10814 }
10815
10816 f = ffestt_formatlist_append (ffestb_local_.format.f);
10817 f->type = FFESTP_formattypeR1016;
10818 f->t = ffelex_token_use (t);
10819 return (ffelexHandler) ffestb_R100111_;
10820}
10821
10822/* ffestb_R100114_ -- "FORMAT" OPEN_PAREN format-item-list CLOSE_PAREN
10823
10824 return ffestb_R100114_; // to lexer
10825
10826 Handle EOS/SEMICOLON or something else. */
10827
10828static ffelexHandler
10829ffestb_R100114_ (ffelexToken t)
10830{
10831 ffelex_set_names_pure (FALSE);
10832
10833 switch (ffelex_token_type (t))
10834 {
10835 case FFELEX_typeEOS:
10836 case FFELEX_typeSEMICOLON:
10837 ffesta_confirmed ();
10838 if (!ffesta_is_inhibited () && !ffestb_local_.format.complained)
10839 ffestc_R1001 (ffestb_local_.format.f);
10840 ffestt_formatlist_kill (ffestb_local_.format.f);
10841 return (ffelexHandler) ffesta_zero (t);
10842
10843 default:
10844 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
10845 ffestt_formatlist_kill (ffestb_local_.format.f);
10846 return (ffelexHandler) ffelex_swallow_tokens (t,
10847 (ffelexHandler) ffesta_zero);
10848 }
10849}
10850
10851/* ffestb_R100115_ -- OPEN_ANGLE expr
10852
10853 (ffestb_R100115_) // to expression handler
10854
10855 Handle expression prior to the edit descriptor. */
10856
10857static ffelexHandler
10858ffestb_R100115_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
10859{
10860 switch (ffelex_token_type (t))
10861 {
10862 case FFELEX_typeCLOSE_ANGLE:
10863 ffestb_local_.format.pre.present = TRUE;
10864 ffestb_local_.format.pre.rtexpr = TRUE;
10865 ffestb_local_.format.pre.u.expr = expr;
10866 ffelex_set_names_pure (TRUE);
10867 return (ffelexHandler) ffestb_R10014_;
10868
10869 default:
10870 ffelex_token_kill (ffestb_local_.format.pre.t);
10871 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
10872 ffestt_formatlist_kill (ffestb_local_.format.f);
10873 return (ffelexHandler) ffelex_swallow_tokens (t,
10874 (ffelexHandler) ffesta_zero);
10875 }
10876}
10877
10878/* ffestb_R100116_ -- "[n]X" OPEN_ANGLE expr
10879
10880 (ffestb_R100116_) // to expression handler
10881
10882 Handle expression after the edit descriptor. */
10883
10884static ffelexHandler
10885ffestb_R100116_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
10886{
10887 switch (ffelex_token_type (t))
10888 {
10889 case FFELEX_typeCLOSE_ANGLE:
10890 ffestb_local_.format.post.present = TRUE;
10891 ffestb_local_.format.post.rtexpr = TRUE;
10892 ffestb_local_.format.post.u.expr = expr;
10893 ffelex_set_names_pure (TRUE);
10894 return (ffelexHandler) ffestb_R10016_;
10895
10896 default:
10897 ffelex_token_kill (ffestb_local_.format.t);
10898 ffelex_token_kill (ffestb_local_.format.post.t);
10899 if (ffestb_local_.format.pre.present)
10900 ffelex_token_kill (ffestb_local_.format.pre.t);
10901 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
10902 ffestt_formatlist_kill (ffestb_local_.format.f);
10903 return (ffelexHandler) ffelex_swallow_tokens (t,
10904 (ffelexHandler) ffesta_zero);
10905 }
10906}
10907
10908/* ffestb_R100117_ -- "[n]X[n]." OPEN_ANGLE expr
10909
10910 (ffestb_R100117_) // to expression handler
10911
10912 Handle expression after the PERIOD. */
10913
10914static ffelexHandler
10915ffestb_R100117_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
10916{
10917 switch (ffelex_token_type (t))
10918 {
10919 case FFELEX_typeCLOSE_ANGLE:
10920 ffestb_local_.format.dot.present = TRUE;
10921 ffestb_local_.format.dot.rtexpr = TRUE;
10922 ffestb_local_.format.dot.u.expr = expr;
10923 ffelex_set_names_pure (TRUE);
10924 return (ffelexHandler) ffestb_R10018_;
10925
10926 default:
10927 ffelex_token_kill (ffestb_local_.format.t);
10928 ffelex_token_kill (ffestb_local_.format.dot.t);
10929 if (ffestb_local_.format.pre.present)
10930 ffelex_token_kill (ffestb_local_.format.pre.t);
10931 if (ffestb_local_.format.post.present)
10932 ffelex_token_kill (ffestb_local_.format.post.t);
10933 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
10934 ffestt_formatlist_kill (ffestb_local_.format.f);
10935 return (ffelexHandler) ffelex_swallow_tokens (t,
10936 (ffelexHandler) ffesta_zero);
10937 }
10938}
10939
10940/* ffestb_R100118_ -- "[n]X[n].[n]E" OPEN_ANGLE expr
10941
10942 (ffestb_R100118_) // to expression handler
10943
10944 Handle expression after the "E". */
10945
10946static ffelexHandler
10947ffestb_R100118_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
10948{
10949 switch (ffelex_token_type (t))
10950 {
10951 case FFELEX_typeCLOSE_ANGLE:
10952 ffestb_local_.format.exp.present = TRUE;
10953 ffestb_local_.format.exp.rtexpr = TRUE;
10954 ffestb_local_.format.exp.u.expr = expr;
10955 ffelex_set_names_pure (TRUE);
10956 return (ffelexHandler) ffestb_R100110_;
10957
10958 default:
10959 ffelex_token_kill (ffestb_local_.format.t);
10960 ffelex_token_kill (ffestb_local_.format.exp.t);
10961 if (ffestb_local_.format.pre.present)
10962 ffelex_token_kill (ffestb_local_.format.pre.t);
10963 if (ffestb_local_.format.post.present)
10964 ffelex_token_kill (ffestb_local_.format.post.t);
10965 if (ffestb_local_.format.dot.present)
10966 ffelex_token_kill (ffestb_local_.format.dot.t);
10967 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
10968 ffestt_formatlist_kill (ffestb_local_.format.f);
10969 return (ffelexHandler) ffelex_swallow_tokens (t,
10970 (ffelexHandler) ffesta_zero);
10971 }
10972}
10973
10974/* ffestb_R1107 -- Parse the USE statement
10975
10976 return ffestb_R1107; // to lexer
10977
10978 Make sure the statement has a valid form for the USE statement.
10979 If it does, implement the statement. */
10980
10981#if FFESTR_F90
10982ffelexHandler
10983ffestb_R1107 (ffelexToken t)
10984{
10985 ffeTokenLength i;
10986 char *p;
10987
10988 switch (ffelex_token_type (ffesta_tokens[0]))
10989 {
10990 case FFELEX_typeNAME:
10991 if (ffesta_first_kw != FFESTR_firstUSE)
10992 goto bad_0; /* :::::::::::::::::::: */
10993 switch (ffelex_token_type (t))
10994 {
10995 case FFELEX_typeNAME:
10996 break;
10997
10998 case FFELEX_typeEOS:
10999 case FFELEX_typeSEMICOLON:
11000 case FFELEX_typeCOMMA:
11001 case FFELEX_typeCOLONCOLON:
11002 ffesta_confirmed (); /* Error, but clearly intended. */
11003 goto bad_1; /* :::::::::::::::::::: */
11004
11005 default:
11006 goto bad_0; /* :::::::::::::::::::: */
11007 }
11008 ffesta_confirmed ();
11009 ffesta_tokens[1] = ffelex_token_use (t);
11010 return (ffelexHandler) ffestb_R11071_;
11011
11012 case FFELEX_typeNAMES:
11013 if (ffesta_first_kw != FFESTR_firstUSE)
11014 goto bad_0; /* :::::::::::::::::::: */
11015 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlUSE);
11016 if (!ffesrc_is_name_init (*p))
11017 goto bad_i; /* :::::::::::::::::::: */
11018 switch (ffelex_token_type (t))
11019 {
11020 case FFELEX_typeCOLONCOLON:
11021 ffesta_confirmed (); /* Error, but clearly intended. */
11022 goto bad_1; /* :::::::::::::::::::: */
11023
11024 default:
11025 goto bad_1; /* :::::::::::::::::::: */
11026
11027 case FFELEX_typeCOMMA:
11028 case FFELEX_typeEOS:
11029 case FFELEX_typeSEMICOLON:
11030 break;
11031 }
11032 ffesta_confirmed ();
11033 ffesta_tokens[1]
11034 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
11035 return (ffelexHandler) ffestb_R11071_ (t);
11036
11037 default:
11038 goto bad_0; /* :::::::::::::::::::: */
11039 }
11040
11041bad_0: /* :::::::::::::::::::: */
11042 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", ffesta_tokens[0]);
11043 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11044
11045bad_1: /* :::::::::::::::::::: */
11046 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
11047 return (ffelexHandler) ffelex_swallow_tokens (t,
11048 (ffelexHandler) ffesta_zero); /* Invalid second token. */
11049
11050bad_i: /* :::::::::::::::::::: */
11051 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "USE", ffesta_tokens[0], i, t);
11052 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11053}
11054
11055/* ffestb_R11071_ -- "USE" NAME
11056
11057 return ffestb_R11071_; // to lexer
11058
11059 Make sure the statement has a valid form for the USE statement. If it
11060 does, implement the statement. */
11061
11062static ffelexHandler
11063ffestb_R11071_ (ffelexToken t)
11064{
11065 switch (ffelex_token_type (t))
11066 {
11067 case FFELEX_typeEOS:
11068 case FFELEX_typeSEMICOLON:
11069 if (!ffesta_is_inhibited ())
11070 {
11071 ffestc_R1107_start (ffesta_tokens[1], FALSE);
11072 ffestc_R1107_finish ();
11073 }
11074 ffelex_token_kill (ffesta_tokens[1]);
11075 return (ffelexHandler) ffesta_zero (t);
11076
11077 case FFELEX_typeCOMMA:
11078 return (ffelexHandler) ffestb_R11072_;
11079
11080 default:
11081 break;
11082 }
11083
11084 ffelex_token_kill (ffesta_tokens[1]);
11085 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
11086 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11087}
11088
11089/* ffestb_R11072_ -- "USE" NAME COMMA
11090
11091 return ffestb_R11072_; // to lexer
11092
11093 Make sure the statement has a valid form for the USE statement. If it
11094 does, implement the statement. */
11095
11096static ffelexHandler
11097ffestb_R11072_ (ffelexToken t)
11098{
11099 switch (ffelex_token_type (t))
11100 {
11101 case FFELEX_typeNAME:
11102 ffesta_tokens[2] = ffelex_token_use (t);
11103 return (ffelexHandler) ffestb_R11073_;
11104
11105 default:
11106 break;
11107 }
11108
11109 ffelex_token_kill (ffesta_tokens[1]);
11110 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
11111 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11112}
11113
11114/* ffestb_R11073_ -- "USE" NAME COMMA NAME
11115
11116 return ffestb_R11073_; // to lexer
11117
11118 Make sure the statement has a valid form for the USE statement. If it
11119 does, implement the statement. */
11120
11121static ffelexHandler
11122ffestb_R11073_ (ffelexToken t)
11123{
11124 switch (ffelex_token_type (t))
11125 {
11126 case FFELEX_typeCOLON:
11127 if (ffestr_other (ffesta_tokens[2]) != FFESTR_otherONLY)
11128 break;
11129 if (!ffesta_is_inhibited ())
11130 ffestc_R1107_start (ffesta_tokens[1], TRUE);
11131 ffelex_token_kill (ffesta_tokens[1]);
11132 ffelex_token_kill (ffesta_tokens[2]);
11133 return (ffelexHandler) ffestb_R11074_;
11134
11135 case FFELEX_typePOINTS:
11136 if (!ffesta_is_inhibited ())
11137 ffestc_R1107_start (ffesta_tokens[1], FALSE);
11138 ffelex_token_kill (ffesta_tokens[1]);
11139 ffesta_tokens[1] = ffesta_tokens[2];
11140 return (ffelexHandler) ffestb_R110711_;
11141
11142 default:
11143 break;
11144 }
11145
11146 ffelex_token_kill (ffesta_tokens[1]);
11147 ffelex_token_kill (ffesta_tokens[2]);
11148 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
11149 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11150}
11151
11152/* ffestb_R11074_ -- "USE" NAME COMMA "ONLY" COLON
11153
11154 return ffestb_R11074_; // to lexer
11155
11156 Make sure the statement has a valid form for the USE statement. If it
11157 does, implement the statement. */
11158
11159static ffelexHandler
11160ffestb_R11074_ (ffelexToken t)
11161{
11162 switch (ffelex_token_type (t))
11163 {
11164 case FFELEX_typeNAME:
11165 ffesta_tokens[1] = ffelex_token_use (t);
11166 return (ffelexHandler) ffestb_R11075_;
11167
11168 case FFELEX_typeEOS:
11169 case FFELEX_typeSEMICOLON:
11170 if (!ffesta_is_inhibited ())
11171 ffestc_R1107_finish ();
11172 return (ffelexHandler) ffesta_zero (t);
11173
11174 default:
11175 break;
11176 }
11177
11178 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
11179 ffestc_R1107_finish ();
11180 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11181}
11182
11183/* ffestb_R11075_ -- "USE" NAME COMMA "ONLY" COLON NAME
11184
11185 return ffestb_R11075_; // to lexer
11186
11187 Make sure the statement has a valid form for the USE statement. If it
11188 does, implement the statement. */
11189
11190static ffelexHandler
11191ffestb_R11075_ (ffelexToken t)
11192{
11193 switch (ffelex_token_type (t))
11194 {
11195 case FFELEX_typeEOS:
11196 case FFELEX_typeSEMICOLON:
11197 if (!ffesta_is_inhibited ())
11198 {
11199 ffestc_R1107_item (NULL, ffesta_tokens[1]);
11200 ffestc_R1107_finish ();
11201 }
11202 ffelex_token_kill (ffesta_tokens[1]);
11203 return (ffelexHandler) ffesta_zero (t);
11204
11205 case FFELEX_typeCOMMA:
11206 if (!ffesta_is_inhibited ())
11207 ffestc_R1107_item (NULL, ffesta_tokens[1]);
11208 ffelex_token_kill (ffesta_tokens[1]);
11209 return (ffelexHandler) ffestb_R11078_;
11210
11211 case FFELEX_typePOINTS:
11212 return (ffelexHandler) ffestb_R11076_;
11213
11214 default:
11215 break;
11216 }
11217
11218 ffelex_token_kill (ffesta_tokens[1]);
11219 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
11220 ffestc_R1107_finish ();
11221 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11222}
11223
11224/* ffestb_R11076_ -- "USE" NAME COMMA "ONLY" COLON NAME POINTS
11225
11226 return ffestb_R11076_; // to lexer
11227
11228 Make sure the statement has a valid form for the USE statement. If it
11229 does, implement the statement. */
11230
11231static ffelexHandler
11232ffestb_R11076_ (ffelexToken t)
11233{
11234 switch (ffelex_token_type (t))
11235 {
11236 case FFELEX_typeNAME:
11237 if (!ffesta_is_inhibited ())
11238 ffestc_R1107_item (ffesta_tokens[1], t);
11239 ffelex_token_kill (ffesta_tokens[1]);
11240 return (ffelexHandler) ffestb_R11077_;
11241
11242 default:
11243 break;
11244 }
11245
11246 ffelex_token_kill (ffesta_tokens[1]);
11247 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
11248 ffestc_R1107_finish ();
11249 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11250}
11251
11252/* ffestb_R11077_ -- "USE" NAME COMMA "ONLY" COLON NAME POINTS NAME
11253
11254 return ffestb_R11077_; // to lexer
11255
11256 Make sure the statement has a valid form for the USE statement. If it
11257 does, implement the statement. */
11258
11259static ffelexHandler
11260ffestb_R11077_ (ffelexToken t)
11261{
11262 switch (ffelex_token_type (t))
11263 {
11264 case FFELEX_typeEOS:
11265 case FFELEX_typeSEMICOLON:
11266 if (!ffesta_is_inhibited ())
11267 ffestc_R1107_finish ();
11268 return (ffelexHandler) ffesta_zero (t);
11269
11270 case FFELEX_typeCOMMA:
11271 return (ffelexHandler) ffestb_R11078_;
11272
11273 default:
11274 break;
11275 }
11276
11277 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
11278 ffestc_R1107_finish ();
11279 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11280}
11281
11282/* ffestb_R11078_ -- "USE" NAME COMMA "ONLY" COLON NAME POINTS NAME COMMA
11283
11284 return ffestb_R11078_; // to lexer
11285
11286 Make sure the statement has a valid form for the USE statement. If it
11287 does, implement the statement. */
11288
11289static ffelexHandler
11290ffestb_R11078_ (ffelexToken t)
11291{
11292 switch (ffelex_token_type (t))
11293 {
11294 case FFELEX_typeNAME:
11295 ffesta_tokens[1] = ffelex_token_use (t);
11296 return (ffelexHandler) ffestb_R11075_;
11297
11298 default:
11299 break;
11300 }
11301
11302 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
11303 ffestc_R1107_finish ();
11304 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11305}
11306
11307/* ffestb_R11079_ -- "USE" NAME COMMA
11308
11309 return ffestb_R11079_; // to lexer
11310
11311 Make sure the statement has a valid form for the USE statement. If it
11312 does, implement the statement. */
11313
11314static ffelexHandler
11315ffestb_R11079_ (ffelexToken t)
11316{
11317 switch (ffelex_token_type (t))
11318 {
11319 case FFELEX_typeNAME:
11320 ffesta_tokens[1] = ffelex_token_use (t);
11321 return (ffelexHandler) ffestb_R110710_;
11322
11323 default:
11324 break;
11325 }
11326
11327 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
11328 ffestc_R1107_finish ();
11329 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11330}
11331
11332/* ffestb_R110710_ -- "USE" NAME COMMA NAME
11333
11334 return ffestb_R110710_; // to lexer
11335
11336 Make sure the statement has a valid form for the USE statement. If it
11337 does, implement the statement. */
11338
11339static ffelexHandler
11340ffestb_R110710_ (ffelexToken t)
11341{
11342 switch (ffelex_token_type (t))
11343 {
11344 case FFELEX_typePOINTS:
11345 return (ffelexHandler) ffestb_R110711_;
11346
11347 default:
11348 break;
11349 }
11350
11351 ffelex_token_kill (ffesta_tokens[1]);
11352 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
11353 ffestc_R1107_finish ();
11354 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11355}
11356
11357/* ffestb_R110711_ -- "USE" NAME COMMA NAME POINTS
11358
11359 return ffestb_R110711_; // to lexer
11360
11361 Make sure the statement has a valid form for the USE statement. If it
11362 does, implement the statement. */
11363
11364static ffelexHandler
11365ffestb_R110711_ (ffelexToken t)
11366{
11367 switch (ffelex_token_type (t))
11368 {
11369 case FFELEX_typeNAME:
11370 if (!ffesta_is_inhibited ())
11371 ffestc_R1107_item (ffesta_tokens[1], t);
11372 ffelex_token_kill (ffesta_tokens[1]);
11373 return (ffelexHandler) ffestb_R110712_;
11374
11375 default:
11376 break;
11377 }
11378
11379 ffelex_token_kill (ffesta_tokens[1]);
11380 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
11381 ffestc_R1107_finish ();
11382 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11383}
11384
11385/* ffestb_R110712_ -- "USE" NAME COMMA NAME POINTS NAME
11386
11387 return ffestb_R110712_; // to lexer
11388
11389 Make sure the statement has a valid form for the USE statement. If it
11390 does, implement the statement. */
11391
11392static ffelexHandler
11393ffestb_R110712_ (ffelexToken t)
11394{
11395 switch (ffelex_token_type (t))
11396 {
11397 case FFELEX_typeEOS:
11398 case FFELEX_typeSEMICOLON:
11399 if (!ffesta_is_inhibited ())
11400 ffestc_R1107_finish ();
11401 return (ffelexHandler) ffesta_zero (t);
11402
11403 case FFELEX_typeCOMMA:
11404 return (ffelexHandler) ffestb_R11079_;
11405
11406 default:
11407 break;
11408 }
11409
11410 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
11411 ffestc_R1107_finish ();
11412 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11413}
11414
11415#endif
11416/* ffestb_R1202 -- Parse the INTERFACE statement
11417
11418 return ffestb_R1202; // to lexer
11419
11420 Make sure the statement has a valid form for the INTERFACE statement.
11421 If it does, implement the statement.
11422
11423 15-May-90 JCB 1.1
11424 Allow INTERFACE by itself; missed this
11425 valid form when originally doing syntactic analysis code. */
11426
11427#if FFESTR_F90
11428ffelexHandler
11429ffestb_R1202 (ffelexToken t)
11430{
11431 ffeTokenLength i;
11432 char *p;
11433
11434 switch (ffelex_token_type (ffesta_tokens[0]))
11435 {
11436 case FFELEX_typeNAME:
11437 if (ffesta_first_kw != FFESTR_firstINTERFACE)
11438 goto bad_0; /* :::::::::::::::::::: */
11439 switch (ffelex_token_type (t))
11440 {
11441 case FFELEX_typeNAME:
11442 break;
11443
11444 case FFELEX_typeEOS:
11445 case FFELEX_typeSEMICOLON:
11446 ffesta_confirmed ();
11447 if (!ffesta_is_inhibited ())
11448 ffestc_R1202 (FFESTP_definedoperatorNone, NULL);
11449 return (ffelexHandler) ffesta_zero (t);
11450
11451 case FFELEX_typeCOMMA:
11452 case FFELEX_typeCOLONCOLON:
11453 ffesta_confirmed (); /* Error, but clearly intended. */
11454 goto bad_1; /* :::::::::::::::::::: */
11455
11456 default:
11457 goto bad_1; /* :::::::::::::::::::: */
11458 }
11459
11460 ffesta_confirmed ();
11461 switch (ffesta_second_kw)
11462 {
11463 case FFESTR_secondOPERATOR:
11464 ffestb_local_.interface.operator = FFESTP_definedoperatorOPERATOR;
11465 break;
11466
11467 case FFESTR_secondASSIGNMENT:
11468 ffestb_local_.interface.operator = FFESTP_definedoperatorASSIGNMENT;
11469 break;
11470
11471 default:
11472 ffestb_local_.interface.operator = FFESTP_definedoperatorNone;
11473 break;
11474 }
11475 ffesta_tokens[1] = ffelex_token_use (t);
11476 return (ffelexHandler) ffestb_R12021_;
11477
11478 case FFELEX_typeNAMES:
11479 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlINTERFACE);
11480 switch (ffesta_first_kw)
11481 {
11482 case FFESTR_firstINTERFACEOPERATOR:
11483 if (*(ffelex_token_text (ffesta_tokens[0])
11484 + FFESTR_firstlINTERFACEOPERATOR) == '\0')
11485 ffestb_local_.interface.operator
11486 = FFESTP_definedoperatorOPERATOR;
11487 break;
11488
11489 case FFESTR_firstINTERFACEASSGNMNT:
11490 if (*(ffelex_token_text (ffesta_tokens[0])
11491 + FFESTR_firstlINTERFACEASSGNMNT) == '\0')
11492 ffestb_local_.interface.operator
11493 = FFESTP_definedoperatorASSIGNMENT;
11494 break;
11495
11496 case FFESTR_firstINTERFACE:
11497 ffestb_local_.interface.operator = FFESTP_definedoperatorNone;
11498 break;
11499
11500 default:
11501 goto bad_0; /* :::::::::::::::::::: */
11502 }
11503 switch (ffelex_token_type (t))
11504 {
11505 case FFELEX_typeCOMMA:
11506 case FFELEX_typeCOLONCOLON:
11507 ffesta_confirmed (); /* Error, but clearly intended. */
11508 goto bad_1; /* :::::::::::::::::::: */
11509
11510 default:
11511 goto bad_1; /* :::::::::::::::::::: */
11512
11513 case FFELEX_typeOPEN_PAREN:
11514 case FFELEX_typeOPEN_ARRAY: /* Sigh. */
11515 break;
11516
11517 case FFELEX_typeEOS:
11518 case FFELEX_typeSEMICOLON:
11519 ffesta_confirmed ();
11520 if (*p == '\0')
11521 {
11522 if (!ffesta_is_inhibited ())
11523 ffestc_R1202 (FFESTP_definedoperatorNone, NULL);
11524 return (ffelexHandler) ffesta_zero (t);
11525 }
11526 break;
11527 }
11528 if (!ffesrc_is_name_init (*p))
11529 goto bad_i; /* :::::::::::::::::::: */
11530 ffesta_tokens[1] = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
11531 return (ffelexHandler) ffestb_R12021_ (t);
11532
11533 default:
11534 goto bad_0; /* :::::::::::::::::::: */
11535 }
11536
11537bad_0: /* :::::::::::::::::::: */
11538 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", ffesta_tokens[0]);
11539 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11540
11541bad_1: /* :::::::::::::::::::: */
11542 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
11543 return (ffelexHandler) ffelex_swallow_tokens (t,
11544 (ffelexHandler) ffesta_zero); /* Invalid second token. */
11545
11546bad_i: /* :::::::::::::::::::: */
11547 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "INTERFACE", ffesta_tokens[0], i, t);
11548 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11549}
11550
11551/* ffestb_R12021_ -- "INTERFACE" NAME
11552
11553 return ffestb_R12021_; // to lexer
11554
11555 Make sure the statement has a valid form for the INTERFACE statement. If
11556 it does, implement the statement. */
11557
11558static ffelexHandler
11559ffestb_R12021_ (ffelexToken t)
11560{
11561 ffestb_local_.interface.slash = TRUE; /* Slash follows open paren. */
11562
11563 switch (ffelex_token_type (t))
11564 {
11565 case FFELEX_typeEOS:
11566 case FFELEX_typeSEMICOLON:
11567 if (!ffesta_is_inhibited ())
11568 ffestc_R1202 (FFESTP_definedoperatorNone, ffesta_tokens[1]);
11569 ffelex_token_kill (ffesta_tokens[1]);
11570 return (ffelexHandler) ffesta_zero (t);
11571
11572 case FFELEX_typeOPEN_PAREN:
11573 ffestb_local_.interface.slash = FALSE; /* Slash doesn't follow. */
11574 /* Fall through. */
11575 case FFELEX_typeOPEN_ARRAY:
11576 switch (ffestb_local_.interface.operator)
11577 {
11578 case FFESTP_definedoperatorNone:
11579 break;
11580
11581 case FFESTP_definedoperatorOPERATOR:
11582 ffestb_local_.interface.assignment = FALSE;
11583 return (ffelexHandler) ffestb_R12022_;
11584
11585 case FFESTP_definedoperatorASSIGNMENT:
11586 ffestb_local_.interface.assignment = TRUE;
11587 return (ffelexHandler) ffestb_R12022_;
11588
11589 default:
11590 assert (FALSE);
11591 }
11592 break;
11593
11594 case FFELEX_typeCOMMA:
11595 case FFELEX_typeCOLONCOLON:
11596 ffesta_confirmed (); /* Error, but clearly intended. */
11597 break;
11598
11599 default:
11600 break;
11601 }
11602
11603 ffelex_token_kill (ffesta_tokens[1]);
11604 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
11605 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11606}
11607
11608/* ffestb_R12022_ -- "INTERFACE" "OPERATOR/ASSIGNMENT" OPEN_PAREN
11609
11610 return ffestb_R12022_; // to lexer
11611
11612 Make sure the statement has a valid form for the INTERFACE statement. If
11613 it does, implement the statement. */
11614
11615static ffelexHandler
11616ffestb_R12022_ (ffelexToken t)
11617{
11618 ffesta_tokens[2] = ffelex_token_use (t);
11619
11620 switch (ffelex_token_type (t))
11621 {
11622 case FFELEX_typePERIOD:
11623 if (ffestb_local_.interface.slash)
11624 break;
11625 return (ffelexHandler) ffestb_R12023_;
11626
11627 case FFELEX_typePOWER:
11628 if (ffestb_local_.interface.slash)
11629 break;
11630 ffestb_local_.interface.operator = FFESTP_definedoperatorPOWER;
11631 return (ffelexHandler) ffestb_R12025_;
11632
11633 case FFELEX_typeASTERISK:
11634 if (ffestb_local_.interface.slash)
11635 break;
11636 ffestb_local_.interface.operator = FFESTP_definedoperatorMULT;
11637 return (ffelexHandler) ffestb_R12025_;
11638
11639 case FFELEX_typePLUS:
11640 if (ffestb_local_.interface.slash)
11641 break;
11642 ffestb_local_.interface.operator = FFESTP_definedoperatorADD;
11643 return (ffelexHandler) ffestb_R12025_;
11644
11645 case FFELEX_typeCONCAT:
11646 if (ffestb_local_.interface.slash)
11647 break;
11648 ffestb_local_.interface.operator = FFESTP_definedoperatorCONCAT;
11649 return (ffelexHandler) ffestb_R12025_;
11650
11651 case FFELEX_typeSLASH:
11652 if (ffestb_local_.interface.slash)
11653 {
11654 ffestb_local_.interface.operator = FFESTP_definedoperatorCONCAT;
11655 return (ffelexHandler) ffestb_R12025_;
11656 }
11657 ffestb_local_.interface.operator = FFESTP_definedoperatorDIVIDE;
11658 return (ffelexHandler) ffestb_R12025_;
11659
11660 case FFELEX_typeMINUS:
11661 if (ffestb_local_.interface.slash)
11662 break;
11663 ffestb_local_.interface.operator = FFESTP_definedoperatorSUBTRACT;
11664 return (ffelexHandler) ffestb_R12025_;
11665
11666 case FFELEX_typeREL_EQ:
11667 if (ffestb_local_.interface.slash)
11668 break;
11669 ffestb_local_.interface.operator = FFESTP_definedoperatorEQ;
11670 return (ffelexHandler) ffestb_R12025_;
11671
11672 case FFELEX_typeREL_NE:
11673 if (ffestb_local_.interface.slash)
11674 break;
11675 ffestb_local_.interface.operator = FFESTP_definedoperatorNE;
11676 return (ffelexHandler) ffestb_R12025_;
11677
11678 case FFELEX_typeOPEN_ANGLE:
11679 if (ffestb_local_.interface.slash)
11680 break;
11681 ffestb_local_.interface.operator = FFESTP_definedoperatorLT;
11682 return (ffelexHandler) ffestb_R12025_;
11683
11684 case FFELEX_typeREL_LE:
11685 if (ffestb_local_.interface.slash)
11686 break;
11687 ffestb_local_.interface.operator = FFESTP_definedoperatorLE;
11688 return (ffelexHandler) ffestb_R12025_;
11689
11690 case FFELEX_typeCLOSE_ANGLE:
11691 if (ffestb_local_.interface.slash)
11692 break;
11693 ffestb_local_.interface.operator = FFESTP_definedoperatorGT;
11694 return (ffelexHandler) ffestb_R12025_;
11695
11696 case FFELEX_typeREL_GE:
11697 if (ffestb_local_.interface.slash)
11698 break;
11699 ffestb_local_.interface.operator = FFESTP_definedoperatorGE;
11700 return (ffelexHandler) ffestb_R12025_;
11701
11702 case FFELEX_typeEQUALS:
11703 if (ffestb_local_.interface.slash)
11704 {
11705 ffestb_local_.interface.operator = FFESTP_definedoperatorNE;
11706 return (ffelexHandler) ffestb_R12025_;
11707 }
11708 ffestb_local_.interface.operator = FFESTP_definedoperatorASSIGNMENT;
11709 return (ffelexHandler) ffestb_R12025_;
11710
11711 case FFELEX_typeCLOSE_ARRAY:
11712 if (!ffestb_local_.interface.slash)
11713 {
11714 ffestb_local_.interface.operator = FFESTP_definedoperatorDIVIDE;
11715 return (ffelexHandler) ffestb_R12026_;
11716 }
11717 ffestb_local_.interface.operator = FFESTP_definedoperatorCONCAT;
11718 return (ffelexHandler) ffestb_R12026_;
11719
11720 case FFELEX_typeCLOSE_PAREN:
11721 if (!ffestb_local_.interface.slash)
11722 break;
11723 ffestb_local_.interface.operator = FFESTP_definedoperatorDIVIDE;
11724 return (ffelexHandler) ffestb_R12026_;
11725
11726 default:
11727 break;
11728 }
11729
11730 ffelex_token_kill (ffesta_tokens[1]);
11731 ffelex_token_kill (ffesta_tokens[2]);
11732 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
11733 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11734}
11735
11736/* ffestb_R12023_ -- "INTERFACE" NAME OPEN_PAREN PERIOD
11737
11738 return ffestb_R12023_; // to lexer
11739
11740 Make sure the statement has a valid form for the INTERFACE statement. If
11741 it does, implement the statement. */
11742
11743static ffelexHandler
11744ffestb_R12023_ (ffelexToken t)
11745{
11746 switch (ffelex_token_type (t))
11747 {
11748 case FFELEX_typeNAME:
11749 ffelex_token_kill (ffesta_tokens[2]);
11750 ffesta_tokens[2] = ffelex_token_use (t);
11751 return (ffelexHandler) ffestb_R12024_;
11752
11753 default:
11754 break;
11755 }
11756
11757 ffelex_token_kill (ffesta_tokens[1]);
11758 ffelex_token_kill (ffesta_tokens[2]);
11759 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
11760 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11761}
11762
11763/* ffestb_R12024_ -- "INTERFACE" NAME OPEN_PAREN PERIOD NAME
11764
11765 return ffestb_R12024_; // to lexer
11766
11767 Make sure the statement has a valid form for the INTERFACE statement. If
11768 it does, implement the statement. */
11769
11770static ffelexHandler
11771ffestb_R12024_ (ffelexToken t)
11772{
11773 switch (ffelex_token_type (t))
11774 {
11775 case FFELEX_typePERIOD:
11776 return (ffelexHandler) ffestb_R12025_;
11777
11778 default:
11779 break;
11780 }
11781
11782 ffelex_token_kill (ffesta_tokens[1]);
11783 ffelex_token_kill (ffesta_tokens[2]);
11784 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
11785 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11786}
11787
11788/* ffestb_R12025_ -- "INTERFACE" NAME OPEN_PAREN operator
11789
11790 return ffestb_R12025_; // to lexer
11791
11792 Make sure the statement has a valid form for the INTERFACE statement. If
11793 it does, implement the statement. */
11794
11795static ffelexHandler
11796ffestb_R12025_ (ffelexToken t)
11797{
11798 switch (ffelex_token_type (t))
11799 {
11800 case FFELEX_typeCLOSE_PAREN:
11801 return (ffelexHandler) ffestb_R12026_;
11802
11803 default:
11804 break;
11805 }
11806
11807 ffelex_token_kill (ffesta_tokens[1]);
11808 ffelex_token_kill (ffesta_tokens[2]);
11809 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
11810 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11811}
11812
11813/* ffestb_R12026_ -- "INTERFACE" NAME OPEN_PAREN operator CLOSE_PAREN
11814
11815 return ffestb_R12026_; // to lexer
11816
11817 Make sure the statement has a valid form for the INTERFACE statement. If
11818 it does, implement the statement. */
11819
11820static ffelexHandler
11821ffestb_R12026_ (ffelexToken t)
11822{
11823 char *p;
11824
11825 switch (ffelex_token_type (t))
11826 {
11827 case FFELEX_typeEOS:
11828 case FFELEX_typeSEMICOLON:
11829 ffesta_confirmed ();
11830 if (ffestb_local_.interface.assignment
11831 && (ffestb_local_.interface.operator
11832 != FFESTP_definedoperatorASSIGNMENT))
11833 {
11834 ffebad_start (FFEBAD_INTERFACE_ASSIGNMENT);
11835 ffebad_here (0, ffelex_token_where_line (ffesta_tokens[1]),
11836 ffelex_token_where_column (ffesta_tokens[1]));
11837 ffebad_here (1, ffelex_token_where_line (ffesta_tokens[2]),
11838 ffelex_token_where_column (ffesta_tokens[2]));
11839 ffebad_finish ();
11840 }
11841 switch (ffelex_token_type (ffesta_tokens[2]))
11842 {
11843 case FFELEX_typeNAME:
11844 switch (ffestr_other (ffesta_tokens[2]))
11845 {
11846 case FFESTR_otherNOT:
11847 if (!ffesta_is_inhibited ())
11848 ffestc_R1202 (FFESTP_definedoperatorNOT, NULL);
11849 break;
11850
11851 case FFESTR_otherAND:
11852 if (!ffesta_is_inhibited ())
11853 ffestc_R1202 (FFESTP_definedoperatorAND, NULL);
11854 break;
11855
11856 case FFESTR_otherOR:
11857 if (!ffesta_is_inhibited ())
11858 ffestc_R1202 (FFESTP_definedoperatorOR, NULL);
11859 break;
11860
11861 case FFESTR_otherEQV:
11862 if (!ffesta_is_inhibited ())
11863 ffestc_R1202 (FFESTP_definedoperatorEQV, NULL);
11864 break;
11865
11866 case FFESTR_otherNEQV:
11867 if (!ffesta_is_inhibited ())
11868 ffestc_R1202 (FFESTP_definedoperatorNEQV, NULL);
11869 break;
11870
11871 case FFESTR_otherEQ:
11872 if (!ffesta_is_inhibited ())
11873 ffestc_R1202 (FFESTP_definedoperatorEQ, NULL);
11874 break;
11875
11876 case FFESTR_otherNE:
11877 if (!ffesta_is_inhibited ())
11878 ffestc_R1202 (FFESTP_definedoperatorNE, NULL);
11879 break;
11880
11881 case FFESTR_otherLT:
11882 if (!ffesta_is_inhibited ())
11883 ffestc_R1202 (FFESTP_definedoperatorLT, NULL);
11884 break;
11885
11886 case FFESTR_otherLE:
11887 if (!ffesta_is_inhibited ())
11888 ffestc_R1202 (FFESTP_definedoperatorLE, NULL);
11889 break;
11890
11891 case FFESTR_otherGT:
11892 if (!ffesta_is_inhibited ())
11893 ffestc_R1202 (FFESTP_definedoperatorGT, NULL);
11894 break;
11895
11896 case FFESTR_otherGE:
11897 if (!ffesta_is_inhibited ())
11898 ffestc_R1202 (FFESTP_definedoperatorGE, NULL);
11899 break;
11900
11901 default:
11902 for (p = ffelex_token_text (ffesta_tokens[2]); *p != '\0'; ++p)
11903 {
11904 if (!isalpha (*p))
11905 {
11906 ffelex_token_kill (ffesta_tokens[1]);
11907 ffelex_token_kill (ffesta_tokens[2]);
11908 ffesta_ffebad_1t (FFEBAD_INTERFACE_NONLETTER,
11909 ffesta_tokens[2]);
11910 return (ffelexHandler) ffelex_swallow_tokens (t,
11911 (ffelexHandler) ffesta_zero);
11912 }
11913 }
11914 if (!ffesta_is_inhibited ())
11915 ffestc_R1202 (FFESTP_definedoperatorOPERATOR,
11916 ffesta_tokens[2]);
11917 }
11918 break;
11919
11920 case FFELEX_typeEQUALS:
11921 if (!ffestb_local_.interface.assignment
11922 && (ffestb_local_.interface.operator
11923 == FFESTP_definedoperatorASSIGNMENT))
11924 {
11925 ffebad_start (FFEBAD_INTERFACE_OPERATOR);
11926 ffebad_here (0, ffelex_token_where_line (ffesta_tokens[1]),
11927 ffelex_token_where_column (ffesta_tokens[1]));
11928 ffebad_here (1, ffelex_token_where_line (ffesta_tokens[2]),
11929 ffelex_token_where_column (ffesta_tokens[2]));
11930 ffebad_finish ();
11931 }
11932 if (!ffesta_is_inhibited ())
11933 ffestc_R1202 (ffestb_local_.interface.operator, NULL);
11934 break;
11935
11936 default:
11937 if (!ffesta_is_inhibited ())
11938 ffestc_R1202 (ffestb_local_.interface.operator, NULL);
11939 }
11940 ffelex_token_kill (ffesta_tokens[1]);
11941 ffelex_token_kill (ffesta_tokens[2]);
11942 return (ffelexHandler) ffesta_zero (t);
11943
11944 default:
11945 break;
11946 }
11947
11948 ffelex_token_kill (ffesta_tokens[1]);
11949 ffelex_token_kill (ffesta_tokens[2]);
11950 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
11951 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11952}
11953
11954#endif
11955/* ffestb_S3P4 -- Parse the INCLUDE line
11956
11957 return ffestb_S3P4; // to lexer
11958
11959 Make sure the statement has a valid form for the INCLUDE line. If it
11960 does, implement the statement. */
11961
11962ffelexHandler
11963ffestb_S3P4 (ffelexToken t)
11964{
11965 ffeTokenLength i;
11966 char *p;
11967 ffelexHandler next;
11968 ffelexToken nt;
11969 ffelexToken ut;
11970
11971 switch (ffelex_token_type (ffesta_tokens[0]))
11972 {
11973 case FFELEX_typeNAME:
11974 if (ffesta_first_kw != FFESTR_firstINCLUDE)
11975 goto bad_0; /* :::::::::::::::::::: */
11976 switch (ffelex_token_type (t))
11977 {
11978 case FFELEX_typeNUMBER:
11979 case FFELEX_typeAPOSTROPHE:
11980 case FFELEX_typeQUOTE:
11981 break;
11982
11983 default:
11984 goto bad_1; /* :::::::::::::::::::: */
11985 }
11986 ffesta_confirmed ();
11987 return (ffelexHandler) (*((ffelexHandler)
11988 ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextINCLUDE,
11989 (ffeexprCallback) ffestb_S3P41_)))
11990 (t);
11991
11992 case FFELEX_typeNAMES:
11993 if (ffesta_first_kw != FFESTR_firstINCLUDE)
11994 goto bad_0; /* :::::::::::::::::::: */
11995 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlINCLUDE);
11996 switch (ffelex_token_type (t))
11997 {
11998 default:
11999 goto bad_1; /* :::::::::::::::::::: */
12000
12001 case FFELEX_typeAPOSTROPHE:
12002 case FFELEX_typeQUOTE:
12003 break;
12004 }
12005 ffesta_confirmed ();
12006 if (*p == '\0')
12007 return (ffelexHandler) (*((ffelexHandler)
12008 ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextINCLUDE,
12009 (ffeexprCallback) ffestb_S3P41_)))
12010 (t);
12011 if (!isdigit (*p))
12012 goto bad_i; /* :::::::::::::::::::: */
12013 nt = ffelex_token_number_from_names (ffesta_tokens[0], i);
12014 p += ffelex_token_length (nt);
12015 i += ffelex_token_length (nt);
12016 if ((*p != '_') || (++i, *++p != '\0'))
12017 {
12018 ffelex_token_kill (nt);
12019 goto bad_i; /* :::::::::::::::::::: */
12020 }
12021 ut = ffelex_token_uscore_from_names (ffesta_tokens[0], i - 1);
12022 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs
12023 (ffesta_output_pool, FFEEXPR_contextINCLUDE,
12024 (ffeexprCallback) ffestb_S3P41_)))
12025 (nt);
12026 ffelex_token_kill (nt);
12027 next = (ffelexHandler) (*next) (ut);
12028 ffelex_token_kill (ut);
12029 return (ffelexHandler) (*next) (t);
12030
12031 default:
12032 goto bad_0; /* :::::::::::::::::::: */
12033 }
12034
12035bad_0: /* :::::::::::::::::::: */
12036 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INCLUDE", ffesta_tokens[0]);
12037 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12038
12039bad_1: /* :::::::::::::::::::: */
12040 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INCLUDE", t);
12041 return (ffelexHandler) ffelex_swallow_tokens (t,
12042 (ffelexHandler) ffesta_zero); /* Invalid second token. */
12043
12044bad_i: /* :::::::::::::::::::: */
12045 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "INCLUDE", ffesta_tokens[0], i, t);
12046 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12047}
12048
12049/* ffestb_S3P41_ -- "INCLUDE" [NUMBER "_"] expr
12050
12051 (ffestb_S3P41_) // to expression handler
12052
12053 Make sure the next token is an EOS, but not a SEMICOLON. */
12054
12055static ffelexHandler
12056ffestb_S3P41_ (ffelexToken ft, ffebld expr, ffelexToken t)
12057{
12058 switch (ffelex_token_type (t))
12059 {
12060 case FFELEX_typeEOS:
12061 case FFELEX_typeSEMICOLON:
12062 if (expr == NULL)
12063 break;
12064 if (!ffesta_is_inhibited ())
12065 {
12066 if (ffe_is_pedantic ()
12067 && ((ffelex_token_type (t) == FFELEX_typeSEMICOLON)
12068 || ffesta_line_has_semicolons))
12069 {
12070 ffebad_start_msg ("INCLUDE at %0 not the only statement on the source line", FFEBAD_severityWARNING);
12071 ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
12072 ffelex_token_where_column (ffesta_tokens[0]));
12073 ffebad_finish ();
12074 }
12075 ffestc_S3P4 (expr, ft);
12076 }
12077 return (ffelexHandler) ffesta_zero (t);
12078
12079 default:
12080 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INCLUDE", t);
12081 break;
12082 }
12083
12084 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12085}
12086
12087/* ffestb_V012 -- Parse the MAP statement
12088
12089 return ffestb_V012; // to lexer
12090
12091 Make sure the statement has a valid form for the MAP statement. If
12092 it does, implement the statement. */
12093
12094#if FFESTR_VXT
12095ffelexHandler
12096ffestb_V012 (ffelexToken t)
12097{
12098 char *p;
12099 ffeTokenLength i;
12100
12101 switch (ffelex_token_type (ffesta_tokens[0]))
12102 {
12103 case FFELEX_typeNAME:
12104 if (ffesta_first_kw != FFESTR_firstMAP)
12105 goto bad_0; /* :::::::::::::::::::: */
12106 break;
12107
12108 case FFELEX_typeNAMES:
12109 if (ffesta_first_kw != FFESTR_firstMAP)
12110 goto bad_0; /* :::::::::::::::::::: */
12111 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlMAP)
12112 {
12113 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlMAP);
12114 goto bad_i; /* :::::::::::::::::::: */
12115 }
12116 break;
12117
12118 default:
12119 goto bad_0; /* :::::::::::::::::::: */
12120 }
12121
12122 switch (ffelex_token_type (t))
12123 {
12124 case FFELEX_typeEOS:
12125 case FFELEX_typeSEMICOLON:
12126 ffesta_confirmed ();
12127 if (!ffesta_is_inhibited ())
12128 ffestc_V012 ();
12129 return (ffelexHandler) ffesta_zero (t);
12130
12131 case FFELEX_typeCOMMA:
12132 case FFELEX_typeCOLONCOLON:
12133 ffesta_confirmed (); /* Error, but clearly intended. */
12134 goto bad_1; /* :::::::::::::::::::: */
12135
12136 default:
12137 goto bad_1; /* :::::::::::::::::::: */
12138 }
12139
12140bad_0: /* :::::::::::::::::::: */
12141 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MAP", ffesta_tokens[0]);
12142 return (ffelexHandler) ffelex_swallow_tokens (t,
12143 (ffelexHandler) ffesta_zero); /* Invalid first token. */
12144
12145bad_1: /* :::::::::::::::::::: */
12146 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MAP", t);
12147 return (ffelexHandler) ffelex_swallow_tokens (t,
12148 (ffelexHandler) ffesta_zero); /* Invalid second token. */
12149
12150bad_i: /* :::::::::::::::::::: */
12151 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "MAP", ffesta_tokens[0], i, t);
12152 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12153}
12154
12155#endif
12156/* ffestb_V014 -- Parse the VOLATILE statement
12157
12158 return ffestb_V014; // to lexer
12159
12160 Make sure the statement has a valid form for the VOLATILE statement. If it
12161 does, implement the statement. */
12162
12163ffelexHandler
12164ffestb_V014 (ffelexToken t)
12165{
12166 ffeTokenLength i;
12167 char *p;
12168 ffelexToken nt;
12169 ffelexHandler next;
12170
12171 switch (ffelex_token_type (ffesta_tokens[0]))
12172 {
12173 case FFELEX_typeNAME:
12174 if (ffesta_first_kw != FFESTR_firstVOLATILE)
12175 goto bad_0; /* :::::::::::::::::::: */
12176 switch (ffelex_token_type (t))
12177 {
12178 case FFELEX_typeEOS:
12179 case FFELEX_typeSEMICOLON:
12180 case FFELEX_typeCOMMA:
12181 ffesta_confirmed (); /* Error, but clearly intended. */
12182 goto bad_1; /* :::::::::::::::::::: */
12183
12184 default:
12185 goto bad_1; /* :::::::::::::::::::: */
12186
12187 case FFELEX_typeNAME:
12188 case FFELEX_typeSLASH:
12189 ffesta_confirmed ();
12190 if (!ffesta_is_inhibited ())
12191 ffestc_V014_start ();
12192 return (ffelexHandler) ffestb_V0141_ (t);
12193
12194 case FFELEX_typeCOLONCOLON:
12195 ffesta_confirmed ();
12196 if (!ffesta_is_inhibited ())
12197 ffestc_V014_start ();
12198 return (ffelexHandler) ffestb_V0141_;
12199 }
12200
12201 case FFELEX_typeNAMES:
12202 if (ffesta_first_kw != FFESTR_firstVOLATILE)
12203 goto bad_0; /* :::::::::::::::::::: */
12204 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlVOLATILE);
12205 switch (ffelex_token_type (t))
12206 {
12207 default:
12208 goto bad_1; /* :::::::::::::::::::: */
12209
12210 case FFELEX_typeCOMMA:
12211 case FFELEX_typeEOS:
12212 case FFELEX_typeSEMICOLON:
12213 ffesta_confirmed ();
12214 break;
12215
12216 case FFELEX_typeSLASH:
12217 ffesta_confirmed ();
12218 if (*p != '\0')
12219 goto bad_i; /* :::::::::::::::::::: */
12220 if (!ffesta_is_inhibited ())
12221 ffestc_V014_start ();
12222 return (ffelexHandler) ffestb_V0141_ (t);
12223
12224 case FFELEX_typeCOLONCOLON:
12225 ffesta_confirmed ();
12226 if (*p != '\0')
12227 goto bad_i; /* :::::::::::::::::::: */
12228 if (!ffesta_is_inhibited ())
12229 ffestc_V014_start ();
12230 return (ffelexHandler) ffestb_V0141_;
12231 }
12232
12233 /* Here, we have at least one char after "VOLATILE" and t is COMMA or
12234 EOS/SEMICOLON. */
12235
12236 if (!ffesrc_is_name_init (*p))
12237 goto bad_i; /* :::::::::::::::::::: */
12238 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
12239 if (!ffesta_is_inhibited ())
12240 ffestc_V014_start ();
12241 next = (ffelexHandler) ffestb_V0141_ (nt);
12242 ffelex_token_kill (nt);
12243 return (ffelexHandler) (*next) (t);
12244
12245 default:
12246 goto bad_0; /* :::::::::::::::::::: */
12247 }
12248
12249bad_0: /* :::::::::::::::::::: */
12250 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", ffesta_tokens[0]);
12251 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12252
12253bad_1: /* :::::::::::::::::::: */
12254 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
12255 return (ffelexHandler) ffelex_swallow_tokens (t,
12256 (ffelexHandler) ffesta_zero); /* Invalid second token. */
12257
12258bad_i: /* :::::::::::::::::::: */
12259 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "VOLATILE", ffesta_tokens[0], i, t);
12260 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12261}
12262
12263/* ffestb_V0141_ -- "VOLATILE" [COLONCOLON]
12264
12265 return ffestb_V0141_; // to lexer
12266
12267 Handle NAME or SLASH. */
12268
12269static ffelexHandler
12270ffestb_V0141_ (ffelexToken t)
12271{
12272 switch (ffelex_token_type (t))
12273 {
12274 case FFELEX_typeNAME:
12275 ffestb_local_.V014.is_cblock = FALSE;
12276 ffesta_tokens[1] = ffelex_token_use (t);
12277 return (ffelexHandler) ffestb_V0144_;
12278
12279 case FFELEX_typeSLASH:
12280 ffestb_local_.V014.is_cblock = TRUE;
12281 return (ffelexHandler) ffestb_V0142_;
12282
12283 default:
12284 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
12285 break;
12286 }
12287
12288 if (!ffesta_is_inhibited ())
12289 ffestc_V014_finish ();
12290 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12291}
12292
12293/* ffestb_V0142_ -- "VOLATILE" [COLONCOLON] SLASH
12294
12295 return ffestb_V0142_; // to lexer
12296
12297 Handle NAME. */
12298
12299static ffelexHandler
12300ffestb_V0142_ (ffelexToken t)
12301{
12302 switch (ffelex_token_type (t))
12303 {
12304 case FFELEX_typeNAME:
12305 ffesta_tokens[1] = ffelex_token_use (t);
12306 return (ffelexHandler) ffestb_V0143_;
12307
12308 default:
12309 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
12310 break;
12311 }
12312
12313 if (!ffesta_is_inhibited ())
12314 ffestc_V014_finish ();
12315 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12316}
12317
12318/* ffestb_V0143_ -- "VOLATILE" [COLONCOLON] SLASH NAME
12319
12320 return ffestb_V0143_; // to lexer
12321
12322 Handle SLASH. */
12323
12324static ffelexHandler
12325ffestb_V0143_ (ffelexToken t)
12326{
12327 switch (ffelex_token_type (t))
12328 {
12329 case FFELEX_typeSLASH:
12330 return (ffelexHandler) ffestb_V0144_;
12331
12332 default:
12333 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
12334 break;
12335 }
12336
12337 if (!ffesta_is_inhibited ())
12338 ffestc_V014_finish ();
12339 ffelex_token_kill (ffesta_tokens[1]);
12340 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12341}
12342
12343/* ffestb_V0144_ -- "VOLATILE" [COLONCOLON] R523
12344
12345 return ffestb_V0144_; // to lexer
12346
12347 Handle COMMA or EOS/SEMICOLON. */
12348
12349static ffelexHandler
12350ffestb_V0144_ (ffelexToken t)
12351{
12352 switch (ffelex_token_type (t))
12353 {
12354 case FFELEX_typeCOMMA:
12355 if (!ffesta_is_inhibited ())
12356 {
12357 if (ffestb_local_.V014.is_cblock)
12358 ffestc_V014_item_cblock (ffesta_tokens[1]);
12359 else
12360 ffestc_V014_item_object (ffesta_tokens[1]);
12361 }
12362 ffelex_token_kill (ffesta_tokens[1]);
12363 return (ffelexHandler) ffestb_V0141_;
12364
12365 case FFELEX_typeEOS:
12366 case FFELEX_typeSEMICOLON:
12367 if (!ffesta_is_inhibited ())
12368 {
12369 if (ffestb_local_.V014.is_cblock)
12370 ffestc_V014_item_cblock (ffesta_tokens[1]);
12371 else
12372 ffestc_V014_item_object (ffesta_tokens[1]);
12373 ffestc_V014_finish ();
12374 }
12375 ffelex_token_kill (ffesta_tokens[1]);
12376 return (ffelexHandler) ffesta_zero (t);
12377
12378 default:
12379 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
12380 break;
12381 }
12382
12383 if (!ffesta_is_inhibited ())
12384 ffestc_V014_finish ();
12385 ffelex_token_kill (ffesta_tokens[1]);
12386 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12387}
12388
12389/* ffestb_V025 -- Parse the DEFINEFILE statement
12390
12391 return ffestb_V025; // to lexer
12392
12393 Make sure the statement has a valid form for the DEFINEFILE statement.
12394 If it does, implement the statement. */
12395
12396#if FFESTR_VXT
12397ffelexHandler
12398ffestb_V025 (ffelexToken t)
12399{
12400 ffeTokenLength i;
12401 char *p;
12402 ffelexToken nt;
12403 ffelexHandler next;
12404
12405 ffestb_local_.V025.started = FALSE;
12406 switch (ffelex_token_type (ffesta_tokens[0]))
12407 {
12408 case FFELEX_typeNAME:
12409 switch (ffesta_first_kw)
12410 {
12411 case FFESTR_firstDEFINE:
12412 if ((ffelex_token_type (t) != FFELEX_typeNAME)
12413 || (ffesta_second_kw != FFESTR_secondFILE))
12414 goto bad_1; /* :::::::::::::::::::: */
12415 ffesta_confirmed ();
12416 return (ffelexHandler) ffestb_V0251_;
12417
12418 case FFESTR_firstDEFINEFILE:
12419 return (ffelexHandler) ffestb_V0251_ (t);
12420
12421 default:
12422 goto bad_0; /* :::::::::::::::::::: */
12423 }
12424
12425 case FFELEX_typeNAMES:
12426 if (ffesta_first_kw != FFESTR_firstDEFINEFILE)
12427 goto bad_0; /* :::::::::::::::::::: */
12428 switch (ffelex_token_type (t))
12429 {
12430 case FFELEX_typeCOMMA:
12431 case FFELEX_typeEOS:
12432 case FFELEX_typeSEMICOLON:
12433 case FFELEX_typeCOLONCOLON:
12434 ffesta_confirmed (); /* Error, but clearly intended. */
12435 goto bad_1; /* :::::::::::::::::::: */
12436
12437 default:
12438 goto bad_1; /* :::::::::::::::::::: */
12439
12440 case FFELEX_typeOPEN_PAREN:
12441 break;
12442 }
12443 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDEFINEFILE);
12444 if (isdigit (*p))
12445 nt = ffelex_token_number_from_names (ffesta_tokens[0], i);
12446 else if (ffesrc_is_name_init (*p))
12447 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
12448 else
12449 goto bad_i; /* :::::::::::::::::::: */
12450 next = (ffelexHandler) ffestb_V0251_ (nt);
12451 ffelex_token_kill (nt);
12452 return (ffelexHandler) (*next) (t);
12453
12454 default:
12455 goto bad_0; /* :::::::::::::::::::: */
12456 }
12457
12458bad_0: /* :::::::::::::::::::: */
12459 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", ffesta_tokens[0]);
12460 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12461
12462bad_1: /* :::::::::::::::::::: */
12463 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
12464 return (ffelexHandler) ffelex_swallow_tokens (t,
12465 (ffelexHandler) ffesta_zero); /* Invalid second token. */
12466
12467bad_i: /* :::::::::::::::::::: */
12468 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", ffesta_tokens[0], i, t);
12469 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12470}
12471
12472/* ffestb_V0251_ -- "DEFINEFILE" or "DEFINE" "FILE"
12473
12474 return ffestb_V0251_; // to lexer
12475
12476 Make sure the statement has a valid form for the DEFINEFILE statement. If it
12477 does, implement the statement. */
12478
12479static ffelexHandler
12480ffestb_V0251_ (ffelexToken t)
12481{
12482 switch (ffelex_token_type (t))
12483 {
12484 case FFELEX_typeNAME:
12485 case FFELEX_typeNUMBER:
12486 if (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME)
12487 ffesta_confirmed ();
12488 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
12489 FFEEXPR_contextFILEUNIT_DF, (ffeexprCallback) ffestb_V0252_)))
12490 (t);
12491
12492 case FFELEX_typeEOS:
12493 case FFELEX_typeSEMICOLON:
12494 case FFELEX_typeCOMMA:
12495 case FFELEX_typeCOLONCOLON:
12496 ffesta_confirmed (); /* Error, but clearly intended. */
12497 break;
12498
12499 default:
12500 break;
12501 }
12502
12503 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
12504 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12505}
12506
12507/* ffestb_V0252_ -- "DEFINEFILE" expr
12508
12509 (ffestb_V0252_) // to expression handler
12510
12511 Make sure the statement has a valid form for the DEFINEFILE statement. If
12512 it does, implement the statement. */
12513
12514static ffelexHandler
12515ffestb_V0252_ (ffelexToken ft, ffebld expr, ffelexToken t)
12516{
12517 switch (ffelex_token_type (t))
12518 {
12519 case FFELEX_typeOPEN_PAREN:
12520 ffestb_local_.V025.u = expr;
12521 ffesta_tokens[1] = ffelex_token_use (ft);
12522 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
12523 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0253_);
12524
12525 default:
12526 break;
12527 }
12528
12529 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
12530 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12531}
12532
12533/* ffestb_V0253_ -- "DEFINEFILE" expr OPEN_PAREN expr
12534
12535 (ffestb_V0253_) // to expression handler
12536
12537 Make sure the statement has a valid form for the DEFINEFILE statement. If
12538 it does, implement the statement. */
12539
12540static ffelexHandler
12541ffestb_V0253_ (ffelexToken ft, ffebld expr, ffelexToken t)
12542{
12543 switch (ffelex_token_type (t))
12544 {
12545 case FFELEX_typeCOMMA:
12546 ffestb_local_.V025.m = expr;
12547 ffesta_tokens[2] = ffelex_token_use (ft);
12548 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
12549 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0254_);
12550
12551 default:
12552 break;
12553 }
12554
12555 ffelex_token_kill (ffesta_tokens[1]);
12556 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
12557 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12558}
12559
12560/* ffestb_V0254_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr
12561
12562 (ffestb_V0254_) // to expression handler
12563
12564 Make sure the statement has a valid form for the DEFINEFILE statement. If
12565 it does, implement the statement. */
12566
12567static ffelexHandler
12568ffestb_V0254_ (ffelexToken ft, ffebld expr, ffelexToken t)
12569{
12570 switch (ffelex_token_type (t))
12571 {
12572 case FFELEX_typeCOMMA:
12573 ffestb_local_.V025.n = expr;
12574 ffesta_tokens[3] = ffelex_token_use (ft);
12575 return (ffelexHandler) ffestb_V0255_;
12576
12577 default:
12578 break;
12579 }
12580
12581 ffelex_token_kill (ffesta_tokens[1]);
12582 ffelex_token_kill (ffesta_tokens[2]);
12583 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
12584 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12585}
12586
12587/* ffestb_V0255_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA
12588
12589 return ffestb_V0255_; // to lexer
12590
12591 Make sure the statement has a valid form for the DEFINEFILE statement. If
12592 it does, implement the statement. */
12593
12594static ffelexHandler
12595ffestb_V0255_ (ffelexToken t)
12596{
12597 char *p;
12598
12599 switch (ffelex_token_type (t))
12600 {
12601 case FFELEX_typeNAME:
12602 p = ffelex_token_text (t);
12603 if (!ffesrc_char_match_init (*p, 'U', 'u') || (*++p != '\0'))
12604 break;
12605 return (ffelexHandler) ffestb_V0256_;
12606
12607 default:
12608 break;
12609 }
12610
12611 ffelex_token_kill (ffesta_tokens[1]);
12612 ffelex_token_kill (ffesta_tokens[2]);
12613 ffelex_token_kill (ffesta_tokens[3]);
12614 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
12615 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12616}
12617
12618/* ffestb_V0256_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA "U"
12619
12620 return ffestb_V0256_; // to lexer
12621
12622 Make sure the statement has a valid form for the DEFINEFILE statement. If
12623 it does, implement the statement. */
12624
12625static ffelexHandler
12626ffestb_V0256_ (ffelexToken t)
12627{
12628 switch (ffelex_token_type (t))
12629 {
12630 case FFELEX_typeCOMMA:
12631 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
12632 FFEEXPR_contextFILEASSOC,
12633 (ffeexprCallback) ffestb_V0257_);
12634
12635 default:
12636 break;
12637 }
12638
12639 ffelex_token_kill (ffesta_tokens[1]);
12640 ffelex_token_kill (ffesta_tokens[2]);
12641 ffelex_token_kill (ffesta_tokens[3]);
12642 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
12643 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12644}
12645
12646/* ffestb_V0257_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA "U"
12647 COMMA expr
12648
12649 (ffestb_V0257_) // to expression handler
12650
12651 Make sure the statement has a valid form for the DEFINEFILE statement. If
12652 it does, implement the statement. */
12653
12654static ffelexHandler
12655ffestb_V0257_ (ffelexToken ft, ffebld expr, ffelexToken t)
12656{
12657 switch (ffelex_token_type (t))
12658 {
12659 case FFELEX_typeCLOSE_PAREN:
12660 ffestb_local_.V025.asv = expr;
12661 ffesta_tokens[4] = ffelex_token_use (ft);
12662 return (ffelexHandler) ffestb_V0258_;
12663
12664 default:
12665 break;
12666 }
12667
12668 ffelex_token_kill (ffesta_tokens[1]);
12669 ffelex_token_kill (ffesta_tokens[2]);
12670 ffelex_token_kill (ffesta_tokens[3]);
12671 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
12672 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12673}
12674
12675/* ffestb_V0258_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA "U"
12676 COMMA expr CLOSE_PAREN
12677
12678 return ffestb_V0258_; // to lexer
12679
12680 Make sure the statement has a valid form for the DEFINEFILE statement. If
12681 it does, implement the statement. */
12682
12683static ffelexHandler
12684ffestb_V0258_ (ffelexToken t)
12685{
12686 switch (ffelex_token_type (t))
12687 {
12688 case FFELEX_typeCOMMA:
12689 case FFELEX_typeEOS:
12690 case FFELEX_typeSEMICOLON:
12691 if (!ffestb_local_.V025.started)
12692 {
12693 ffesta_confirmed ();
12694 if (!ffesta_is_inhibited ())
12695 ffestc_V025_start ();
12696 ffestb_local_.V025.started = TRUE;
12697 }
12698 if (!ffesta_is_inhibited ())
12699 ffestc_V025_item (ffestb_local_.V025.u, ffesta_tokens[1],
12700 ffestb_local_.V025.m, ffesta_tokens[2],
12701 ffestb_local_.V025.n, ffesta_tokens[3],
12702 ffestb_local_.V025.asv, ffesta_tokens[4]);
12703 ffelex_token_kill (ffesta_tokens[1]);
12704 ffelex_token_kill (ffesta_tokens[2]);
12705 ffelex_token_kill (ffesta_tokens[3]);
12706 ffelex_token_kill (ffesta_tokens[4]);
12707 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
12708 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
12709 FFEEXPR_contextFILEUNIT_DF, (ffeexprCallback) ffestb_V0252_);
12710 if (!ffesta_is_inhibited ())
12711 ffestc_V025_finish ();
12712 return (ffelexHandler) ffesta_zero (t);
12713
12714 default:
12715 break;
12716 }
12717
12718 ffelex_token_kill (ffesta_tokens[1]);
12719 ffelex_token_kill (ffesta_tokens[2]);
12720 ffelex_token_kill (ffesta_tokens[3]);
12721 ffelex_token_kill (ffesta_tokens[4]);
12722 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
12723 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12724}
12725
12726#endif
12727/* ffestb_subr_kill_easy_ -- Kill I/O statement data structure
12728
12729 ffestb_subr_kill_easy_();
12730
12731 Kills all tokens in the I/O data structure. Assumes that they are
12732 overlaid with each other (union) in ffest_private.h and the typing
12733 and structure references assume (though not necessarily dangerous if
12734 FALSE) that INQUIRE has the most file elements. */
12735
12736#if FFESTB_KILL_EASY_
12737static void
12738ffestb_subr_kill_easy_ (ffestpInquireIx max)
12739{
12740 ffestpInquireIx ix;
12741
12742 for (ix = 0; ix < max; ++ix)
12743 {
12744 if (ffestp_file.inquire.inquire_spec[ix].kw_or_val_present)
12745 {
12746 if (ffestp_file.inquire.inquire_spec[ix].kw_present)
12747 ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].kw);
12748 if (ffestp_file.inquire.inquire_spec[ix].value_present)
12749 ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].value);
12750 }
12751 }
12752}
12753
12754#endif
12755/* ffestb_subr_kill_accept_ -- Kill ACCEPT statement data structure
12756
12757 ffestb_subr_kill_accept_();
12758
12759 Kills all tokens in the ACCEPT data structure. */
12760
12761#if !FFESTB_KILL_EASY_
12762static void
12763ffestb_subr_kill_accept_ ()
12764{
12765 ffestpAcceptIx ix;
12766
12767 for (ix = 0; ix < FFESTP_acceptix; ++ix)
12768 {
12769 if (ffestp_file.accept.accept_spec[ix].kw_or_val_present)
12770 {
12771 if (ffestp_file.accept.accept_spec[ix].kw_present)
12772 ffelex_token_kill (ffestp_file.accept.accept_spec[ix].kw);
12773 if (ffestp_file.accept.accept_spec[ix].value_present)
12774 ffelex_token_kill (ffestp_file.accept.accept_spec[ix].value);
12775 }
12776 }
12777}
12778
12779#endif
12780/* ffestb_subr_kill_beru_ -- Kill BACKSPACE/ENDFILE/REWIND/UNLOCK statement
12781 data structure
12782
12783 ffestb_subr_kill_beru_();
12784
12785 Kills all tokens in the BACKSPACE/ENDFILE/REWIND/UNLOCK data structure. */
12786
12787#if !FFESTB_KILL_EASY_
12788static void
12789ffestb_subr_kill_beru_ ()
12790{
12791 ffestpBeruIx ix;
12792
12793 for (ix = 0; ix < FFESTP_beruix; ++ix)
12794 {
12795 if (ffestp_file.beru.beru_spec[ix].kw_or_val_present)
12796 {
12797 if (ffestp_file.beru.beru_spec[ix].kw_present)
12798 ffelex_token_kill (ffestp_file.beru.beru_spec[ix].kw);
12799 if (ffestp_file.beru.beru_spec[ix].value_present)
12800 ffelex_token_kill (ffestp_file.beru.beru_spec[ix].value);
12801 }
12802 }
12803}
12804
12805#endif
12806/* ffestb_subr_kill_close_ -- Kill CLOSE statement data structure
12807
12808 ffestb_subr_kill_close_();
12809
12810 Kills all tokens in the CLOSE data structure. */
12811
12812#if !FFESTB_KILL_EASY_
12813static void
12814ffestb_subr_kill_close_ ()
12815{
12816 ffestpCloseIx ix;
12817
12818 for (ix = 0; ix < FFESTP_closeix; ++ix)
12819 {
12820 if (ffestp_file.close.close_spec[ix].kw_or_val_present)
12821 {
12822 if (ffestp_file.close.close_spec[ix].kw_present)
12823 ffelex_token_kill (ffestp_file.close.close_spec[ix].kw);
12824 if (ffestp_file.close.close_spec[ix].value_present)
12825 ffelex_token_kill (ffestp_file.close.close_spec[ix].value);
12826 }
12827 }
12828}
12829
12830#endif
12831/* ffestb_subr_kill_delete_ -- Kill DELETE statement data structure
12832
12833 ffestb_subr_kill_delete_();
12834
12835 Kills all tokens in the DELETE data structure. */
12836
12837#if !FFESTB_KILL_EASY_
12838static void
12839ffestb_subr_kill_delete_ ()
12840{
12841 ffestpDeleteIx ix;
12842
12843 for (ix = 0; ix < FFESTP_deleteix; ++ix)
12844 {
12845 if (ffestp_file.delete.delete_spec[ix].kw_or_val_present)
12846 {
12847 if (ffestp_file.delete.delete_spec[ix].kw_present)
12848 ffelex_token_kill (ffestp_file.delete.delete_spec[ix].kw);
12849 if (ffestp_file.delete.delete_spec[ix].value_present)
12850 ffelex_token_kill (ffestp_file.delete.delete_spec[ix].value);
12851 }
12852 }
12853}
12854
12855#endif
12856/* ffestb_subr_kill_inquire_ -- Kill INQUIRE statement data structure
12857
12858 ffestb_subr_kill_inquire_();
12859
12860 Kills all tokens in the INQUIRE data structure. */
12861
12862#if !FFESTB_KILL_EASY_
12863static void
12864ffestb_subr_kill_inquire_ ()
12865{
12866 ffestpInquireIx ix;
12867
12868 for (ix = 0; ix < FFESTP_inquireix; ++ix)
12869 {
12870 if (ffestp_file.inquire.inquire_spec[ix].kw_or_val_present)
12871 {
12872 if (ffestp_file.inquire.inquire_spec[ix].kw_present)
12873 ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].kw);
12874 if (ffestp_file.inquire.inquire_spec[ix].value_present)
12875 ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].value);
12876 }
12877 }
12878}
12879
12880#endif
12881/* ffestb_subr_kill_open_ -- Kill OPEN statement data structure
12882
12883 ffestb_subr_kill_open_();
12884
12885 Kills all tokens in the OPEN data structure. */
12886
12887#if !FFESTB_KILL_EASY_
12888static void
12889ffestb_subr_kill_open_ ()
12890{
12891 ffestpOpenIx ix;
12892
12893 for (ix = 0; ix < FFESTP_openix; ++ix)
12894 {
12895 if (ffestp_file.open.open_spec[ix].kw_or_val_present)
12896 {
12897 if (ffestp_file.open.open_spec[ix].kw_present)
12898 ffelex_token_kill (ffestp_file.open.open_spec[ix].kw);
12899 if (ffestp_file.open.open_spec[ix].value_present)
12900 ffelex_token_kill (ffestp_file.open.open_spec[ix].value);
12901 }
12902 }
12903}
12904
12905#endif
12906/* ffestb_subr_kill_print_ -- Kill PRINT statement data structure
12907
12908 ffestb_subr_kill_print_();
12909
12910 Kills all tokens in the PRINT data structure. */
12911
12912#if !FFESTB_KILL_EASY_
12913static void
12914ffestb_subr_kill_print_ ()
12915{
12916 ffestpPrintIx ix;
12917
12918 for (ix = 0; ix < FFESTP_printix; ++ix)
12919 {
12920 if (ffestp_file.print.print_spec[ix].kw_or_val_present)
12921 {
12922 if (ffestp_file.print.print_spec[ix].kw_present)
12923 ffelex_token_kill (ffestp_file.print.print_spec[ix].kw);
12924 if (ffestp_file.print.print_spec[ix].value_present)
12925 ffelex_token_kill (ffestp_file.print.print_spec[ix].value);
12926 }
12927 }
12928}
12929
12930#endif
12931/* ffestb_subr_kill_read_ -- Kill READ statement data structure
12932
12933 ffestb_subr_kill_read_();
12934
12935 Kills all tokens in the READ data structure. */
12936
12937#if !FFESTB_KILL_EASY_
12938static void
12939ffestb_subr_kill_read_ ()
12940{
12941 ffestpReadIx ix;
12942
12943 for (ix = 0; ix < FFESTP_readix; ++ix)
12944 {
12945 if (ffestp_file.read.read_spec[ix].kw_or_val_present)
12946 {
12947 if (ffestp_file.read.read_spec[ix].kw_present)
12948 ffelex_token_kill (ffestp_file.read.read_spec[ix].kw);
12949 if (ffestp_file.read.read_spec[ix].value_present)
12950 ffelex_token_kill (ffestp_file.read.read_spec[ix].value);
12951 }
12952 }
12953}
12954
12955#endif
12956/* ffestb_subr_kill_rewrite_ -- Kill REWRITE statement data structure
12957
12958 ffestb_subr_kill_rewrite_();
12959
12960 Kills all tokens in the REWRITE data structure. */
12961
12962#if !FFESTB_KILL_EASY_
12963static void
12964ffestb_subr_kill_rewrite_ ()
12965{
12966 ffestpRewriteIx ix;
12967
12968 for (ix = 0; ix < FFESTP_rewriteix; ++ix)
12969 {
12970 if (ffestp_file.rewrite.rewrite_spec[ix].kw_or_val_present)
12971 {
12972 if (ffestp_file.rewrite.rewrite_spec[ix].kw_present)
12973 ffelex_token_kill (ffestp_file.rewrite.rewrite_spec[ix].kw);
12974 if (ffestp_file.rewrite.rewrite_spec[ix].value_present)
12975 ffelex_token_kill (ffestp_file.rewrite.rewrite_spec[ix].value);
12976 }
12977 }
12978}
12979
12980#endif
12981/* ffestb_subr_kill_type_ -- Kill TYPE statement data structure
12982
12983 ffestb_subr_kill_type_();
12984
12985 Kills all tokens in the TYPE data structure. */
12986
12987#if !FFESTB_KILL_EASY_
12988static void
12989ffestb_subr_kill_type_ ()
12990{
12991 ffestpTypeIx ix;
12992
12993 for (ix = 0; ix < FFESTP_typeix; ++ix)
12994 {
12995 if (ffestp_file.type.type_spec[ix].kw_or_val_present)
12996 {
12997 if (ffestp_file.type.type_spec[ix].kw_present)
12998 ffelex_token_kill (ffestp_file.type.type_spec[ix].kw);
12999 if (ffestp_file.type.type_spec[ix].value_present)
13000 ffelex_token_kill (ffestp_file.type.type_spec[ix].value);
13001 }
13002 }
13003}
13004
13005#endif
13006/* ffestb_subr_kill_write_ -- Kill WRITE statement data structure
13007
13008 ffestb_subr_kill_write_();
13009
13010 Kills all tokens in the WRITE data structure. */
13011
13012#if !FFESTB_KILL_EASY_
13013static void
13014ffestb_subr_kill_write_ ()
13015{
13016 ffestpWriteIx ix;
13017
13018 for (ix = 0; ix < FFESTP_writeix; ++ix)
13019 {
13020 if (ffestp_file.write.write_spec[ix].kw_or_val_present)
13021 {
13022 if (ffestp_file.write.write_spec[ix].kw_present)
13023 ffelex_token_kill (ffestp_file.write.write_spec[ix].kw);
13024 if (ffestp_file.write.write_spec[ix].value_present)
13025 ffelex_token_kill (ffestp_file.write.write_spec[ix].value);
13026 }
13027 }
13028}
13029
13030#endif
13031/* ffestb_beru -- Parse the BACKSPACE/ENDFILE/REWIND/UNLOCK statement
13032
13033 return ffestb_beru; // to lexer
13034
13035 Make sure the statement has a valid form for the BACKSPACE/ENDFILE/REWIND/
13036 UNLOCK statement. If it does, implement the statement. */
13037
13038ffelexHandler
13039ffestb_beru (ffelexToken t)
13040{
13041 ffelexHandler next;
13042 ffestpBeruIx ix;
13043
13044 switch (ffelex_token_type (ffesta_tokens[0]))
13045 {
13046 case FFELEX_typeNAME:
13047 switch (ffelex_token_type (t))
13048 {
13049 case FFELEX_typeCOMMA:
13050 case FFELEX_typeCOLONCOLON:
13051 case FFELEX_typeEOS:
13052 case FFELEX_typeSEMICOLON:
13053 ffesta_confirmed (); /* Error, but clearly intended. */
13054 goto bad_1; /* :::::::::::::::::::: */
13055
13056 case FFELEX_typeEQUALS:
13057 case FFELEX_typePOINTS:
13058 case FFELEX_typeCOLON:
13059 goto bad_1; /* :::::::::::::::::::: */
13060
13061 case FFELEX_typeNAME:
13062 case FFELEX_typeNUMBER:
13063 ffesta_confirmed ();
13064 break;
13065
13066 case FFELEX_typeOPEN_PAREN:
13067 for (ix = 0; ix < FFESTP_beruix; ++ix)
13068 ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
13069 ffesta_tokens[1] = ffelex_token_use (t);
13070 return (ffelexHandler) ffestb_beru2_;
13071
13072 default:
13073 break;
13074 }
13075
13076 for (ix = 0; ix < FFESTP_beruix; ++ix)
13077 ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
13078 return (ffelexHandler) (*((ffelexHandler)
13079 ffeexpr_rhs (ffesta_output_pool,
13080 FFEEXPR_contextFILENUM,
13081 (ffeexprCallback) ffestb_beru1_)))
13082 (t);
13083
13084 case FFELEX_typeNAMES:
13085 switch (ffelex_token_type (t))
13086 {
13087 case FFELEX_typeCOMMA:
13088 case FFELEX_typeCOLONCOLON:
13089 ffesta_confirmed (); /* Error, but clearly intended. */
13090 goto bad_1; /* :::::::::::::::::::: */
13091
13092 case FFELEX_typeEQUALS:
13093 case FFELEX_typePOINTS:
13094 case FFELEX_typeCOLON:
13095 goto bad_1; /* :::::::::::::::::::: */
13096
13097 case FFELEX_typeEOS:
13098 case FFELEX_typeSEMICOLON:
13099 ffesta_confirmed ();
13100 break;
13101
13102 case FFELEX_typeOPEN_PAREN:
13103 if (ffelex_token_length (ffesta_tokens[0])
13104 != ffestb_args.beru.len)
13105 break;
13106
13107 for (ix = 0; ix < FFESTP_beruix; ++ix)
13108 ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
13109 ffesta_tokens[1] = ffelex_token_use (t);
13110 return (ffelexHandler) ffestb_beru2_;
13111
13112 default:
13113 break;
13114 }
13115 for (ix = 0; ix < FFESTP_beruix; ++ix)
13116 ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
13117 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13118 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_beru1_);
13119 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
13120 ffestb_args.beru.len);
13121 if (next == NULL)
13122 return (ffelexHandler) ffelex_swallow_tokens (t,
13123 (ffelexHandler) ffesta_zero);
13124 return (ffelexHandler) (*next) (t);
13125
13126 default:
13127 goto bad_0; /* :::::::::::::::::::: */
13128 }
13129
13130bad_0: /* :::::::::::::::::::: */
13131 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, ffesta_tokens[0]);
13132 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13133
13134bad_1: /* :::::::::::::::::::: */
13135 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
13136 return (ffelexHandler) ffelex_swallow_tokens (t,
13137 (ffelexHandler) ffesta_zero); /* Invalid second token. */
13138}
13139
13140/* ffestb_beru1_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" expr
13141
13142 (ffestb_beru1_) // to expression handler
13143
13144 Make sure the next token is an EOS or SEMICOLON. */
13145
13146static ffelexHandler
13147ffestb_beru1_ (ffelexToken ft, ffebld expr, ffelexToken t)
13148{
13149 switch (ffelex_token_type (t))
13150 {
13151 case FFELEX_typeEOS:
13152 case FFELEX_typeSEMICOLON:
13153 if (expr == NULL)
13154 break;
13155 ffesta_confirmed ();
13156 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_or_val_present
13157 = TRUE;
13158 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_present = FALSE;
13159 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_present = TRUE;
13160 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_is_label
13161 = FALSE;
13162 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value
13163 = ffelex_token_use (ft);
13164 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].u.expr = expr;
13165 if (!ffesta_is_inhibited ())
13166 {
13167 switch (ffesta_first_kw)
13168 {
13169 case FFESTR_firstBACKSPACE:
13170 ffestc_R919 ();
13171 break;
13172
13173 case FFESTR_firstENDFILE:
13174 case FFESTR_firstEND:
13175 ffestc_R920 ();
13176 break;
13177
13178 case FFESTR_firstREWIND:
13179 ffestc_R921 ();
13180 break;
13181
13182#if FFESTR_VXT
13183 case FFESTR_firstUNLOCK:
13184 ffestc_V022 ();
13185 break;
13186#endif
13187
13188 default:
13189 assert (FALSE);
13190 }
13191 }
13192 ffestb_subr_kill_beru_ ();
13193 return (ffelexHandler) ffesta_zero (t);
13194
13195 default:
13196 break;
13197 }
13198
13199 ffestb_subr_kill_beru_ ();
13200 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
13201 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13202}
13203
13204/* ffestb_beru2_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN
13205
13206 return ffestb_beru2_; // to lexer
13207
13208 Handle expr construct (not NAME=expr construct) here. */
13209
13210static ffelexHandler
13211ffestb_beru2_ (ffelexToken t)
13212{
13213 ffelexToken nt;
13214 ffelexHandler next;
13215
13216 switch (ffelex_token_type (t))
13217 {
13218 case FFELEX_typeNAME:
13219 ffesta_tokens[2] = ffelex_token_use (t);
13220 return (ffelexHandler) ffestb_beru3_;
13221
13222 default:
13223 nt = ffesta_tokens[1];
13224 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13225 FFEEXPR_contextFILENUMAMBIG, (ffeexprCallback) ffestb_beru4_)))
13226 (nt);
13227 ffelex_token_kill (nt);
13228 return (ffelexHandler) (*next) (t);
13229 }
13230}
13231
13232/* ffestb_beru3_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN NAME
13233
13234 return ffestb_beru3_; // to lexer
13235
13236 If EQUALS here, go to states that handle it. Else, send NAME and this
13237 token thru expression handler. */
13238
13239static ffelexHandler
13240ffestb_beru3_ (ffelexToken t)
13241{
13242 ffelexHandler next;
13243 ffelexToken nt;
13244 ffelexToken ot;
13245
13246 switch (ffelex_token_type (t))
13247 {
13248 case FFELEX_typeEQUALS:
13249 ffelex_token_kill (ffesta_tokens[1]);
13250 nt = ffesta_tokens[2];
13251 next = (ffelexHandler) ffestb_beru5_ (nt);
13252 ffelex_token_kill (nt);
13253 return (ffelexHandler) (*next) (t);
13254
13255 default:
13256 nt = ffesta_tokens[1];
13257 ot = ffesta_tokens[2];
13258 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13259 FFEEXPR_contextFILENUMAMBIG, (ffeexprCallback) ffestb_beru4_)))
13260 (nt);
13261 ffelex_token_kill (nt);
13262 next = (ffelexHandler) (*next) (ot);
13263 ffelex_token_kill (ot);
13264 return (ffelexHandler) (*next) (t);
13265 }
13266}
13267
13268/* ffestb_beru4_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN expr [CLOSE_PAREN]
13269
13270 (ffestb_beru4_) // to expression handler
13271
13272 Handle COMMA or EOS/SEMICOLON here.
13273
13274 15-Feb-91 JCB 1.2
13275 Now using new mechanism whereby expr comes back as opITEM if the
13276 expr is considered part (or all) of an I/O control list (and should
13277 be stripped of its outer opITEM node) or not if it is considered
13278 a plain unit number that happens to have been enclosed in parens.
13279 26-Mar-90 JCB 1.1
13280 No longer expecting close-paren here because of constructs like
13281 BACKSPACE (5)+2, so now expecting either COMMA because it was a
13282 construct like BACKSPACE (5+2,... or EOS/SEMICOLON because it is like
13283 the former construct. Ah, the vagaries of Fortran. */
13284
13285static ffelexHandler
13286ffestb_beru4_ (ffelexToken ft, ffebld expr, ffelexToken t)
13287{
13288 bool inlist;
13289
13290 switch (ffelex_token_type (t))
13291 {
13292 case FFELEX_typeCOMMA:
13293 case FFELEX_typeEOS:
13294 case FFELEX_typeSEMICOLON:
13295 case FFELEX_typeCLOSE_PAREN:
13296 if (expr == NULL)
13297 break;
13298 if (ffebld_op (expr) == FFEBLD_opITEM)
13299 {
13300 inlist = TRUE;
13301 expr = ffebld_head (expr);
13302 }
13303 else
13304 inlist = FALSE;
13305 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_or_val_present
13306 = TRUE;
13307 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_present = FALSE;
13308 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_present = TRUE;
13309 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_is_label
13310 = FALSE;
13311 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value
13312 = ffelex_token_use (ft);
13313 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].u.expr = expr;
13314 if (inlist)
13315 return (ffelexHandler) ffestb_beru9_ (t);
13316 return (ffelexHandler) ffestb_beru10_ (t);
13317
13318 default:
13319 break;
13320 }
13321
13322 ffestb_subr_kill_beru_ ();
13323 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
13324 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13325}
13326
13327/* ffestb_beru5_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN [external-file-unit
13328 COMMA]
13329
13330 return ffestb_beru5_; // to lexer
13331
13332 Handle expr construct (not NAME=expr construct) here. */
13333
13334static ffelexHandler
13335ffestb_beru5_ (ffelexToken t)
13336{
13337 ffestrGenio kw;
13338
13339 ffestb_local_.beru.label = FALSE;
13340
13341 switch (ffelex_token_type (t))
13342 {
13343 case FFELEX_typeNAME:
13344 kw = ffestr_genio (t);
13345 switch (kw)
13346 {
13347 case FFESTR_genioERR:
13348 ffestb_local_.beru.ix = FFESTP_beruixERR;
13349 ffestb_local_.beru.label = TRUE;
13350 break;
13351
13352 case FFESTR_genioIOSTAT:
13353 ffestb_local_.beru.ix = FFESTP_beruixIOSTAT;
13354 ffestb_local_.beru.left = TRUE;
13355 ffestb_local_.beru.context = FFEEXPR_contextFILEINT;
13356 break;
13357
13358 case FFESTR_genioUNIT:
13359 ffestb_local_.beru.ix = FFESTP_beruixUNIT;
13360 ffestb_local_.beru.left = FALSE;
13361 ffestb_local_.beru.context = FFEEXPR_contextFILENUM;
13362 break;
13363
13364 default:
13365 goto bad; /* :::::::::::::::::::: */
13366 }
13367 if (ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
13368 .kw_or_val_present)
13369 break; /* Can't specify a keyword twice! */
13370 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
13371 .kw_or_val_present = TRUE;
13372 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
13373 .kw_present = TRUE;
13374 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
13375 .value_present = FALSE;
13376 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value_is_label
13377 = ffestb_local_.beru.label;
13378 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].kw
13379 = ffelex_token_use (t);
13380 return (ffelexHandler) ffestb_beru6_;
13381
13382 default:
13383 break;
13384 }
13385
13386bad: /* :::::::::::::::::::: */
13387 ffestb_subr_kill_beru_ ();
13388 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
13389 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13390}
13391
13392/* ffestb_beru6_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN [external-file-unit
13393 COMMA] NAME
13394
13395 return ffestb_beru6_; // to lexer
13396
13397 Make sure EQUALS here, send next token to expression handler. */
13398
13399static ffelexHandler
13400ffestb_beru6_ (ffelexToken t)
13401{
13402
13403 switch (ffelex_token_type (t))
13404 {
13405 case FFELEX_typeEQUALS:
13406 ffesta_confirmed ();
13407 if (ffestb_local_.beru.label)
13408 return (ffelexHandler) ffestb_beru8_;
13409 if (ffestb_local_.beru.left)
13410 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
13411 ffestb_local_.beru.context,
13412 (ffeexprCallback) ffestb_beru7_);
13413 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13414 ffestb_local_.beru.context,
13415 (ffeexprCallback) ffestb_beru7_);
13416
13417 default:
13418 break;
13419 }
13420
13421 ffestb_subr_kill_beru_ ();
13422 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
13423 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13424}
13425
13426/* ffestb_beru7_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... NAME EQUALS expr
13427
13428 (ffestb_beru7_) // to expression handler
13429
13430 Handle COMMA or CLOSE_PAREN here. */
13431
13432static ffelexHandler
13433ffestb_beru7_ (ffelexToken ft, ffebld expr, ffelexToken t)
13434{
13435 switch (ffelex_token_type (t))
13436 {
13437 case FFELEX_typeCOMMA:
13438 case FFELEX_typeCLOSE_PAREN:
13439 if (expr == NULL)
13440 break;
13441 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value_present
13442 = TRUE;
13443 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value
13444 = ffelex_token_use (ft);
13445 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].u.expr = expr;
13446 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
13447 return (ffelexHandler) ffestb_beru5_;
13448 return (ffelexHandler) ffestb_beru10_;
13449
13450 default:
13451 break;
13452 }
13453
13454 ffestb_subr_kill_beru_ ();
13455 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
13456 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13457}
13458
13459/* ffestb_beru8_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... NAME EQUALS
13460
13461 return ffestb_beru8_; // to lexer
13462
13463 Handle NUMBER for label here. */
13464
13465static ffelexHandler
13466ffestb_beru8_ (ffelexToken t)
13467{
13468 switch (ffelex_token_type (t))
13469 {
13470 case FFELEX_typeNUMBER:
13471 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value_present
13472 = TRUE;
13473 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value
13474 = ffelex_token_use (t);
13475 return (ffelexHandler) ffestb_beru9_;
13476
13477 default:
13478 break;
13479 }
13480
13481 ffestb_subr_kill_beru_ ();
13482 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
13483 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13484}
13485
13486/* ffestb_beru9_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... NAME EQUALS
13487 NUMBER
13488
13489 return ffestb_beru9_; // to lexer
13490
13491 Handle COMMA or CLOSE_PAREN here. */
13492
13493static ffelexHandler
13494ffestb_beru9_ (ffelexToken t)
13495{
13496 switch (ffelex_token_type (t))
13497 {
13498 case FFELEX_typeCOMMA:
13499 return (ffelexHandler) ffestb_beru5_;
13500
13501 case FFELEX_typeCLOSE_PAREN:
13502 return (ffelexHandler) ffestb_beru10_;
13503
13504 default:
13505 break;
13506 }
13507
13508 ffestb_subr_kill_beru_ ();
13509 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
13510 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13511}
13512
13513/* ffestb_beru10_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... CLOSE_PAREN
13514
13515 return ffestb_beru10_; // to lexer
13516
13517 Handle EOS or SEMICOLON here. */
13518
13519static ffelexHandler
13520ffestb_beru10_ (ffelexToken t)
13521{
13522 switch (ffelex_token_type (t))
13523 {
13524 case FFELEX_typeEOS:
13525 case FFELEX_typeSEMICOLON:
13526 ffesta_confirmed ();
13527 if (!ffesta_is_inhibited ())
13528 {
13529 switch (ffesta_first_kw)
13530 {
13531 case FFESTR_firstBACKSPACE:
13532 ffestc_R919 ();
13533 break;
13534
13535 case FFESTR_firstENDFILE:
13536 case FFESTR_firstEND:
13537 ffestc_R920 ();
13538 break;
13539
13540 case FFESTR_firstREWIND:
13541 ffestc_R921 ();
13542 break;
13543
13544#if FFESTR_VXT
13545 case FFESTR_firstUNLOCK:
13546 ffestc_V022 ();
13547 break;
13548#endif
13549
13550 default:
13551 assert (FALSE);
13552 }
13553 }
13554 ffestb_subr_kill_beru_ ();
13555 return (ffelexHandler) ffesta_zero (t);
13556
13557 default:
13558 break;
13559 }
13560
13561 ffestb_subr_kill_beru_ ();
13562 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
13563 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13564}
13565
13566/* ffestb_vxtcode -- Parse the VXT DECODE/ENCODE statement
13567
13568 return ffestb_vxtcode; // to lexer
13569
13570 Make sure the statement has a valid form for the VXT DECODE/ENCODE
13571 statement. If it does, implement the statement. */
13572
13573#if FFESTR_VXT
13574ffelexHandler
13575ffestb_vxtcode (ffelexToken t)
13576{
13577 ffestpVxtcodeIx ix;
13578
13579 switch (ffelex_token_type (ffesta_tokens[0]))
13580 {
13581 case FFELEX_typeNAME:
13582 switch (ffelex_token_type (t))
13583 {
13584 case FFELEX_typeCOMMA:
13585 case FFELEX_typeCOLONCOLON:
13586 case FFELEX_typeEOS:
13587 case FFELEX_typeSEMICOLON:
13588 case FFELEX_typeNAME:
13589 case FFELEX_typeNUMBER:
13590 ffesta_confirmed (); /* Error, but clearly intended. */
13591 goto bad_1; /* :::::::::::::::::::: */
13592
13593 default:
13594 goto bad_1; /* :::::::::::::::::::: */
13595
13596 case FFELEX_typeOPEN_PAREN:
13597 for (ix = 0; ix < FFESTP_vxtcodeix; ++ix)
13598 ffestp_file.vxtcode.vxtcode_spec[ix].kw_or_val_present = FALSE;
13599 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13600 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_vxtcode1_);
13601 }
13602
13603 case FFELEX_typeNAMES:
13604 switch (ffelex_token_type (t))
13605 {
13606 case FFELEX_typeEOS:
13607 case FFELEX_typeSEMICOLON:
13608 case FFELEX_typeCOMMA:
13609 case FFELEX_typeCOLONCOLON:
13610 ffesta_confirmed (); /* Error, but clearly intended. */
13611 goto bad_1; /* :::::::::::::::::::: */
13612
13613 default:
13614 goto bad_1; /* :::::::::::::::::::: */
13615
13616 case FFELEX_typeOPEN_PAREN:
13617 if (ffelex_token_length (ffesta_tokens[0])
13618 != ffestb_args.vxtcode.len)
13619 goto bad_0; /* :::::::::::::::::::: */
13620
13621 for (ix = 0; ix < FFESTP_vxtcodeix; ++ix)
13622 ffestp_file.vxtcode.vxtcode_spec[ix].kw_or_val_present = FALSE;
13623 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13624 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_vxtcode1_);
13625 }
13626
13627 default:
13628 goto bad_0; /* :::::::::::::::::::: */
13629 }
13630
13631bad_0: /* :::::::::::::::::::: */
13632 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, ffesta_tokens[0]);
13633 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13634
13635bad_1: /* :::::::::::::::::::: */
13636 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
13637 return (ffelexHandler) ffelex_swallow_tokens (t,
13638 (ffelexHandler) ffesta_zero); /* Invalid second token. */
13639}
13640
13641/* ffestb_vxtcode1_ -- "VXTCODE" OPEN_PAREN expr
13642
13643 (ffestb_vxtcode1_) // to expression handler
13644
13645 Handle COMMA here. */
13646
13647static ffelexHandler
13648ffestb_vxtcode1_ (ffelexToken ft, ffebld expr, ffelexToken t)
13649{
13650 switch (ffelex_token_type (t))
13651 {
13652 case FFELEX_typeCOMMA:
13653 if (expr == NULL)
13654 break;
13655 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].kw_or_val_present
13656 = TRUE;
13657 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].kw_present = FALSE;
13658 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].value_present = TRUE;
13659 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].value_is_label
13660 = FALSE;
13661 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].value
13662 = ffelex_token_use (ft);
13663 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].u.expr = expr;
13664 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13665 FFEEXPR_contextFILEFORMAT, (ffeexprCallback) ffestb_vxtcode2_);
13666
13667 default:
13668 break;
13669 }
13670
13671 ffestb_subr_kill_vxtcode_ ();
13672 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
13673 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13674}
13675
13676/* ffestb_vxtcode2_ -- "VXTCODE" OPEN_PAREN expr COMMA expr
13677
13678 (ffestb_vxtcode2_) // to expression handler
13679
13680 Handle COMMA here. */
13681
13682static ffelexHandler
13683ffestb_vxtcode2_ (ffelexToken ft, ffebld expr, ffelexToken t)
13684{
13685 switch (ffelex_token_type (t))
13686 {
13687 case FFELEX_typeCOMMA:
13688 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].kw_or_val_present
13689 = TRUE;
13690 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].kw_present = FALSE;
13691 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].value_present = TRUE;
13692 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].value_is_label
13693 = (expr == NULL);
13694 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].value
13695 = ffelex_token_use (ft);
13696 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].u.expr = expr;
13697 if (ffesta_first_kw == FFESTR_firstENCODE)
13698 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
13699 FFEEXPR_contextFILEVXTCODE,
13700 (ffeexprCallback) ffestb_vxtcode3_);
13701 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13702 FFEEXPR_contextFILEVXTCODE,
13703 (ffeexprCallback) ffestb_vxtcode3_);
13704
13705 default:
13706 break;
13707 }
13708
13709 ffestb_subr_kill_vxtcode_ ();
13710 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
13711 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13712}
13713
13714/* ffestb_vxtcode3_ -- "VXTCODE" OPEN_PAREN expr COMMA expr COMMA expr
13715
13716 (ffestb_vxtcode3_) // to expression handler
13717
13718 Handle COMMA or CLOSE_PAREN here. */
13719
13720static ffelexHandler
13721ffestb_vxtcode3_ (ffelexToken ft, ffebld expr, ffelexToken t)
13722{
13723 switch (ffelex_token_type (t))
13724 {
13725 case FFELEX_typeCOMMA:
13726 case FFELEX_typeCLOSE_PAREN:
13727 if (expr == NULL)
13728 break;
13729 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].kw_or_val_present
13730 = TRUE;
13731 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].kw_present = FALSE;
13732 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].value_present = TRUE;
13733 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].value_is_label
13734 = FALSE;
13735 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].value
13736 = ffelex_token_use (ft);
13737 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].u.expr = expr;
13738 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
13739 return (ffelexHandler) ffestb_vxtcode4_;
13740 return (ffelexHandler) ffestb_vxtcode9_;
13741
13742 default:
13743 break;
13744 }
13745
13746 ffestb_subr_kill_vxtcode_ ();
13747 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
13748 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13749}
13750
13751/* ffestb_vxtcode4_ -- "VXTCODE" OPEN_PAREN ...
13752
13753 return ffestb_vxtcode4_; // to lexer
13754
13755 Handle NAME=expr construct here. */
13756
13757static ffelexHandler
13758ffestb_vxtcode4_ (ffelexToken t)
13759{
13760 ffestrGenio kw;
13761
13762 ffestb_local_.vxtcode.label = FALSE;
13763
13764 switch (ffelex_token_type (t))
13765 {
13766 case FFELEX_typeNAME:
13767 kw = ffestr_genio (t);
13768 switch (kw)
13769 {
13770 case FFESTR_genioERR:
13771 ffestb_local_.vxtcode.ix = FFESTP_vxtcodeixERR;
13772 ffestb_local_.vxtcode.label = TRUE;
13773 break;
13774
13775 case FFESTR_genioIOSTAT:
13776 ffestb_local_.vxtcode.ix = FFESTP_vxtcodeixIOSTAT;
13777 ffestb_local_.vxtcode.left = TRUE;
13778 ffestb_local_.vxtcode.context = FFEEXPR_contextFILEINT;
13779 break;
13780
13781 default:
13782 goto bad; /* :::::::::::::::::::: */
13783 }
13784 if (ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix]
13785 .kw_or_val_present)
13786 break; /* Can't specify a keyword twice! */
13787 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix]
13788 .kw_or_val_present = TRUE;
13789 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix]
13790 .kw_present = TRUE;
13791 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix]
13792 .value_present = FALSE;
13793 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value_is_label
13794 = ffestb_local_.vxtcode.label;
13795 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].kw
13796 = ffelex_token_use (t);
13797 return (ffelexHandler) ffestb_vxtcode5_;
13798
13799 default:
13800 break;
13801 }
13802
13803bad: /* :::::::::::::::::::: */
13804 ffestb_subr_kill_vxtcode_ ();
13805 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
13806 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13807}
13808
13809/* ffestb_vxtcode5_ -- "VXTCODE" OPEN_PAREN [external-file-unit COMMA [format
13810 COMMA]] NAME
13811
13812 return ffestb_vxtcode5_; // to lexer
13813
13814 Make sure EQUALS here, send next token to expression handler. */
13815
13816static ffelexHandler
13817ffestb_vxtcode5_ (ffelexToken t)
13818{
13819 switch (ffelex_token_type (t))
13820 {
13821 case FFELEX_typeEQUALS:
13822 ffesta_confirmed ();
13823 if (ffestb_local_.vxtcode.label)
13824 return (ffelexHandler) ffestb_vxtcode7_;
13825 if (ffestb_local_.vxtcode.left)
13826 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
13827 ffestb_local_.vxtcode.context,
13828 (ffeexprCallback) ffestb_vxtcode6_);
13829 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13830 ffestb_local_.vxtcode.context,
13831 (ffeexprCallback) ffestb_vxtcode6_);
13832
13833 default:
13834 break;
13835 }
13836
13837 ffestb_subr_kill_vxtcode_ ();
13838 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
13839 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13840}
13841
13842/* ffestb_vxtcode6_ -- "VXTCODE" OPEN_PAREN ... NAME EQUALS expr
13843
13844 (ffestb_vxtcode6_) // to expression handler
13845
13846 Handle COMMA or CLOSE_PAREN here. */
13847
13848static ffelexHandler
13849ffestb_vxtcode6_ (ffelexToken ft, ffebld expr, ffelexToken t)
13850{
13851 switch (ffelex_token_type (t))
13852 {
13853 case FFELEX_typeCOMMA:
13854 case FFELEX_typeCLOSE_PAREN:
13855 if (expr == NULL)
13856 break;
13857 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value_present
13858 = TRUE;
13859 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value
13860 = ffelex_token_use (ft);
13861 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].u.expr = expr;
13862 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
13863 return (ffelexHandler) ffestb_vxtcode4_;
13864 return (ffelexHandler) ffestb_vxtcode9_;
13865
13866 default:
13867 break;
13868 }
13869
13870 ffestb_subr_kill_vxtcode_ ();
13871 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
13872 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13873}
13874
13875/* ffestb_vxtcode7_ -- "VXTCODE" OPEN_PAREN ... NAME EQUALS
13876
13877 return ffestb_vxtcode7_; // to lexer
13878
13879 Handle NUMBER for label here. */
13880
13881static ffelexHandler
13882ffestb_vxtcode7_ (ffelexToken t)
13883{
13884 switch (ffelex_token_type (t))
13885 {
13886 case FFELEX_typeNUMBER:
13887 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value_present
13888 = TRUE;
13889 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value
13890 = ffelex_token_use (t);
13891 return (ffelexHandler) ffestb_vxtcode8_;
13892
13893 default:
13894 break;
13895 }
13896
13897 ffestb_subr_kill_vxtcode_ ();
13898 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
13899 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13900}
13901
13902/* ffestb_vxtcode8_ -- "VXTCODE" OPEN_PAREN ... NAME EQUALS NUMBER
13903
13904 return ffestb_vxtcode8_; // to lexer
13905
13906 Handle COMMA or CLOSE_PAREN here. */
13907
13908static ffelexHandler
13909ffestb_vxtcode8_ (ffelexToken t)
13910{
13911 switch (ffelex_token_type (t))
13912 {
13913 case FFELEX_typeCOMMA:
13914 return (ffelexHandler) ffestb_vxtcode4_;
13915
13916 case FFELEX_typeCLOSE_PAREN:
13917 return (ffelexHandler) ffestb_vxtcode9_;
13918
13919 default:
13920 break;
13921 }
13922
13923 ffestb_subr_kill_vxtcode_ ();
13924 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
13925 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13926}
13927
13928/* ffestb_vxtcode9_ -- "VXTCODE" OPEN_PAREN ... CLOSE_PAREN
13929
13930 return ffestb_vxtcode9_; // to lexer
13931
13932 Handle EOS or SEMICOLON here.
13933
13934 07-Jun-90 JCB 1.1
13935 Context for ENCODE/DECODE expressions is now IOLISTDF instead of IOLIST
13936 since they apply to internal files. */
13937
13938static ffelexHandler
13939ffestb_vxtcode9_ (ffelexToken t)
13940{
13941 ffelexHandler next;
13942
13943 switch (ffelex_token_type (t))
13944 {
13945 case FFELEX_typeEOS:
13946 case FFELEX_typeSEMICOLON:
13947 ffesta_confirmed ();
13948 if (!ffesta_is_inhibited ())
13949 {
13950 if (ffesta_first_kw == FFESTR_firstENCODE)
13951 {
13952 ffestc_V023_start ();
13953 ffestc_V023_finish ();
13954 }
13955 else
13956 {
13957 ffestc_V024_start ();
13958 ffestc_V024_finish ();
13959 }
13960 }
13961 ffestb_subr_kill_vxtcode_ ();
13962 return (ffelexHandler) ffesta_zero (t);
13963
13964 case FFELEX_typeNAME:
13965 case FFELEX_typeOPEN_PAREN:
13966 case FFELEX_typeCOMMA:
13967 ffesta_confirmed ();
13968 if (!ffesta_is_inhibited ())
13969 if (ffesta_first_kw == FFESTR_firstENCODE)
13970 ffestc_V023_start ();
13971 else
13972 ffestc_V024_start ();
13973 ffestb_subr_kill_vxtcode_ ();
13974 if (ffesta_first_kw == FFESTR_firstDECODE)
13975 next = (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
13976 FFEEXPR_contextIOLISTDF,
13977 (ffeexprCallback) ffestb_vxtcode10_);
13978 else
13979 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13980 FFEEXPR_contextIOLISTDF,
13981 (ffeexprCallback) ffestb_vxtcode10_);
13982
13983 /* EXTENSION: Allow an optional preceding COMMA here if not pedantic.
13984 (f2c provides this extension, as do other compilers, supposedly.) */
13985
13986 if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA))
13987 return next;
13988
13989 return (ffelexHandler) (*next) (t);
13990
13991 default:
13992 break;
13993 }
13994
13995 ffestb_subr_kill_vxtcode_ ();
13996 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
13997 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13998}
13999
14000/* ffestb_vxtcode10_ -- "VXTCODE(...)" expr
14001
14002 (ffestb_vxtcode10_) // to expression handler
14003
14004 Handle COMMA or EOS/SEMICOLON here.
14005
14006 07-Jun-90 JCB 1.1
14007 Context for ENCODE/DECODE expressions is now IOLISTDF instead of IOLIST
14008 since they apply to internal files. */
14009
14010static ffelexHandler
14011ffestb_vxtcode10_ (ffelexToken ft, ffebld expr, ffelexToken t)
14012{
14013 switch (ffelex_token_type (t))
14014 {
14015 case FFELEX_typeCOMMA:
14016 if (expr == NULL)
14017 break;
14018 if (!ffesta_is_inhibited ())
14019 if (ffesta_first_kw == FFESTR_firstENCODE)
14020 ffestc_V023_item (expr, ft);
14021 else
14022 ffestc_V024_item (expr, ft);
14023 if (ffesta_first_kw == FFESTR_firstDECODE)
14024 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
14025 FFEEXPR_contextIOLISTDF,
14026 (ffeexprCallback) ffestb_vxtcode10_);
14027 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
14028 FFEEXPR_contextIOLISTDF,
14029 (ffeexprCallback) ffestb_vxtcode10_);
14030
14031 case FFELEX_typeEOS:
14032 case FFELEX_typeSEMICOLON:
14033 if (expr == NULL)
14034 break;
14035 if (!ffesta_is_inhibited ())
14036 {
14037 if (ffesta_first_kw == FFESTR_firstENCODE)
14038 {
14039 ffestc_V023_item (expr, ft);
14040 ffestc_V023_finish ();
14041 }
14042 else
14043 {
14044 ffestc_V024_item (expr, ft);
14045 ffestc_V024_finish ();
14046 }
14047 }
14048 return (ffelexHandler) ffesta_zero (t);
14049
14050 default:
14051 break;
14052 }
14053
14054 if (!ffesta_is_inhibited ())
14055 if (ffesta_first_kw == FFESTR_firstENCODE)
14056 ffestc_V023_finish ();
14057 else
14058 ffestc_V024_finish ();
14059 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
14060 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14061}
14062
14063#endif
14064/* ffestb_R904 -- Parse an OPEN statement
14065
14066 return ffestb_R904; // to lexer
14067
14068 Make sure the statement has a valid form for an OPEN statement.
14069 If it does, implement the statement. */
14070
14071ffelexHandler
14072ffestb_R904 (ffelexToken t)
14073{
14074 ffestpOpenIx ix;
14075
14076 switch (ffelex_token_type (ffesta_tokens[0]))
14077 {
14078 case FFELEX_typeNAME:
14079 if (ffesta_first_kw != FFESTR_firstOPEN)
14080 goto bad_0; /* :::::::::::::::::::: */
14081 break;
14082
14083 case FFELEX_typeNAMES:
14084 if (ffesta_first_kw != FFESTR_firstOPEN)
14085 goto bad_0; /* :::::::::::::::::::: */
14086 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlOPEN)
14087 goto bad_0; /* :::::::::::::::::::: */
14088 break;
14089
14090 default:
14091 goto bad_0; /* :::::::::::::::::::: */
14092 }
14093
14094 switch (ffelex_token_type (t))
14095 {
14096 case FFELEX_typeOPEN_PAREN:
14097 break;
14098
14099 case FFELEX_typeEOS:
14100 case FFELEX_typeSEMICOLON:
14101 case FFELEX_typeCOMMA:
14102 case FFELEX_typeCOLONCOLON:
14103 ffesta_confirmed (); /* Error, but clearly intended. */
14104 goto bad_1; /* :::::::::::::::::::: */
14105
14106 default:
14107 goto bad_1; /* :::::::::::::::::::: */
14108 }
14109
14110 for (ix = 0; ix < FFESTP_openix; ++ix)
14111 ffestp_file.open.open_spec[ix].kw_or_val_present = FALSE;
14112
14113 return (ffelexHandler) ffestb_R9041_;
14114
14115bad_0: /* :::::::::::::::::::: */
14116 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", ffesta_tokens[0]);
14117 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14118
14119bad_1: /* :::::::::::::::::::: */
14120 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
14121 return (ffelexHandler) ffelex_swallow_tokens (t,
14122 (ffelexHandler) ffesta_zero); /* Invalid second token. */
14123}
14124
14125/* ffestb_R9041_ -- "OPEN" OPEN_PAREN
14126
14127 return ffestb_R9041_; // to lexer
14128
14129 Handle expr construct (not NAME=expr construct) here. */
14130
14131static ffelexHandler
14132ffestb_R9041_ (ffelexToken t)
14133{
14134 switch (ffelex_token_type (t))
14135 {
14136 case FFELEX_typeNAME:
14137 ffesta_tokens[1] = ffelex_token_use (t);
14138 return (ffelexHandler) ffestb_R9042_;
14139
14140 default:
14141 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
14142 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9043_)))
14143 (t);
14144 }
14145}
14146
14147/* ffestb_R9042_ -- "OPEN" OPEN_PAREN NAME
14148
14149 return ffestb_R9042_; // to lexer
14150
14151 If EQUALS here, go to states that handle it. Else, send NAME and this
14152 token thru expression handler. */
14153
14154static ffelexHandler
14155ffestb_R9042_ (ffelexToken t)
14156{
14157 ffelexHandler next;
14158 ffelexToken nt;
14159
14160 switch (ffelex_token_type (t))
14161 {
14162 case FFELEX_typeEQUALS:
14163 nt = ffesta_tokens[1];
14164 next = (ffelexHandler) ffestb_R9044_ (nt);
14165 ffelex_token_kill (nt);
14166 return (ffelexHandler) (*next) (t);
14167
14168 default:
14169 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
14170 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9043_)))
14171 (ffesta_tokens[1]);
14172 ffelex_token_kill (ffesta_tokens[1]);
14173 return (ffelexHandler) (*next) (t);
14174 }
14175}
14176
14177/* ffestb_R9043_ -- "OPEN" OPEN_PAREN expr
14178
14179 (ffestb_R9043_) // to expression handler
14180
14181 Handle COMMA or CLOSE_PAREN here. */
14182
14183static ffelexHandler
14184ffestb_R9043_ (ffelexToken ft, ffebld expr, ffelexToken t)
14185{
14186 switch (ffelex_token_type (t))
14187 {
14188 case FFELEX_typeCOMMA:
14189 case FFELEX_typeCLOSE_PAREN:
14190 if (expr == NULL)
14191 break;
14192 ffestp_file.open.open_spec[FFESTP_openixUNIT].kw_or_val_present
14193 = TRUE;
14194 ffestp_file.open.open_spec[FFESTP_openixUNIT].kw_present = FALSE;
14195 ffestp_file.open.open_spec[FFESTP_openixUNIT].value_present = TRUE;
14196 ffestp_file.open.open_spec[FFESTP_openixUNIT].value_is_label
14197 = FALSE;
14198 ffestp_file.open.open_spec[FFESTP_openixUNIT].value
14199 = ffelex_token_use (ft);
14200 ffestp_file.open.open_spec[FFESTP_openixUNIT].u.expr = expr;
14201 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
14202 return (ffelexHandler) ffestb_R9044_;
14203 return (ffelexHandler) ffestb_R9049_;
14204
14205 default:
14206 break;
14207 }
14208
14209 ffestb_subr_kill_open_ ();
14210 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
14211 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14212}
14213
14214/* ffestb_R9044_ -- "OPEN" OPEN_PAREN [external-file-unit COMMA]
14215
14216 return ffestb_R9044_; // to lexer
14217
14218 Handle expr construct (not NAME=expr construct) here. */
14219
14220static ffelexHandler
14221ffestb_R9044_ (ffelexToken t)
14222{
14223 ffestrOpen kw;
14224
14225 ffestb_local_.open.label = FALSE;
14226
14227 switch (ffelex_token_type (t))
14228 {
14229 case FFELEX_typeNAME:
14230 kw = ffestr_open (t);
14231 switch (kw)
14232 {
14233 case FFESTR_openACCESS:
14234 ffestb_local_.open.ix = FFESTP_openixACCESS;
14235 ffestb_local_.open.left = FALSE;
14236 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
14237 break;
14238
14239 case FFESTR_openACTION:
14240 ffestb_local_.open.ix = FFESTP_openixACTION;
14241 ffestb_local_.open.left = FALSE;
14242 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
14243 break;
14244
14245 case FFESTR_openASSOCIATEVARIABLE:
14246 ffestb_local_.open.ix = FFESTP_openixASSOCIATEVARIABLE;
14247 ffestb_local_.open.left = TRUE;
14248 ffestb_local_.open.context = FFEEXPR_contextFILEASSOC;
14249 break;
14250
14251 case FFESTR_openBLANK:
14252 ffestb_local_.open.ix = FFESTP_openixBLANK;
14253 ffestb_local_.open.left = FALSE;
14254 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
14255 break;
14256
14257 case FFESTR_openBLOCKSIZE:
14258 ffestb_local_.open.ix = FFESTP_openixBLOCKSIZE;
14259 ffestb_local_.open.left = FALSE;
14260 ffestb_local_.open.context = FFEEXPR_contextFILENUM;
14261 break;
14262
14263 case FFESTR_openBUFFERCOUNT:
14264 ffestb_local_.open.ix = FFESTP_openixBUFFERCOUNT;
14265 ffestb_local_.open.left = FALSE;
14266 ffestb_local_.open.context = FFEEXPR_contextFILENUM;
14267 break;
14268
14269 case FFESTR_openCARRIAGECONTROL:
14270 ffestb_local_.open.ix = FFESTP_openixCARRIAGECONTROL;
14271 ffestb_local_.open.left = FALSE;
14272 ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
14273 break;
14274
14275 case FFESTR_openDEFAULTFILE:
14276 ffestb_local_.open.ix = FFESTP_openixDEFAULTFILE;
14277 ffestb_local_.open.left = FALSE;
14278 ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
14279 break;
14280
14281 case FFESTR_openDELIM:
14282 ffestb_local_.open.ix = FFESTP_openixDELIM;
14283 ffestb_local_.open.left = FALSE;
14284 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
14285 break;
14286
14287 case FFESTR_openDISP:
14288 case FFESTR_openDISPOSE:
14289 ffestb_local_.open.ix = FFESTP_openixDISPOSE;
14290 ffestb_local_.open.left = FALSE;
14291 ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
14292 break;
14293
14294 case FFESTR_openERR:
14295 ffestb_local_.open.ix = FFESTP_openixERR;
14296 ffestb_local_.open.label = TRUE;
14297 break;
14298
14299 case FFESTR_openEXTENDSIZE:
14300 ffestb_local_.open.ix = FFESTP_openixEXTENDSIZE;
14301 ffestb_local_.open.left = FALSE;
14302 ffestb_local_.open.context = FFEEXPR_contextFILENUM;
14303 break;
14304
14305 case FFESTR_openFILE:
14306 case FFESTR_openNAME:
14307 ffestb_local_.open.ix = FFESTP_openixFILE;
14308 ffestb_local_.open.left = FALSE;
14309 ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
14310 break;
14311
14312 case FFESTR_openFORM:
14313 ffestb_local_.open.ix = FFESTP_openixFORM;
14314 ffestb_local_.open.left = FALSE;
14315 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
14316 break;
14317
14318 case FFESTR_openINITIALSIZE:
14319 ffestb_local_.open.ix = FFESTP_openixINITIALSIZE;
14320 ffestb_local_.open.left = FALSE;
14321 ffestb_local_.open.context = FFEEXPR_contextFILENUM;
14322 break;
14323
14324 case FFESTR_openIOSTAT:
14325 ffestb_local_.open.ix = FFESTP_openixIOSTAT;
14326 ffestb_local_.open.left = TRUE;
14327 ffestb_local_.open.context = FFEEXPR_contextFILEINT;
14328 break;
14329
14330#if 0 /* Haven't added support for expression
14331 context yet (though easy). */
14332 case FFESTR_openKEY:
14333 ffestb_local_.open.ix = FFESTP_openixKEY;
14334 ffestb_local_.open.left = FALSE;
14335 ffestb_local_.open.context = FFEEXPR_contextFILEKEY;
14336 break;
14337#endif
14338
14339 case FFESTR_openMAXREC:
14340 ffestb_local_.open.ix = FFESTP_openixMAXREC;
14341 ffestb_local_.open.left = FALSE;
14342 ffestb_local_.open.context = FFEEXPR_contextFILENUM;
14343 break;
14344
14345 case FFESTR_openNOSPANBLOCKS:
14346 if (ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
14347 .kw_or_val_present)
14348 goto bad; /* :::::::::::::::::::: */
14349 ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
14350 .kw_or_val_present = TRUE;
14351 ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
14352 .kw_present = TRUE;
14353 ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
14354 .value_present = FALSE;
14355 ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS].kw
14356 = ffelex_token_use (t);
14357 return (ffelexHandler) ffestb_R9048_;
14358
14359 case FFESTR_openORGANIZATION:
14360 ffestb_local_.open.ix = FFESTP_openixORGANIZATION;
14361 ffestb_local_.open.left = FALSE;
14362 ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
14363 break;
14364
14365 case FFESTR_openPAD:
14366 ffestb_local_.open.ix = FFESTP_openixPAD;
14367 ffestb_local_.open.left = FALSE;
14368 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
14369 break;
14370
14371 case FFESTR_openPOSITION:
14372 ffestb_local_.open.ix = FFESTP_openixPOSITION;
14373 ffestb_local_.open.left = FALSE;
14374 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
14375 break;
14376
14377 case FFESTR_openREADONLY:
14378 if (ffestp_file.open.open_spec[FFESTP_openixREADONLY]
14379 .kw_or_val_present)
14380 goto bad; /* :::::::::::::::::::: */
14381 ffestp_file.open.open_spec[FFESTP_openixREADONLY]
14382 .kw_or_val_present = TRUE;
14383 ffestp_file.open.open_spec[FFESTP_openixREADONLY]
14384 .kw_present = TRUE;
14385 ffestp_file.open.open_spec[FFESTP_openixREADONLY]
14386 .value_present = FALSE;
14387 ffestp_file.open.open_spec[FFESTP_openixREADONLY].kw
14388 = ffelex_token_use (t);
14389 return (ffelexHandler) ffestb_R9048_;
14390
14391 case FFESTR_openRECL:
14392 case FFESTR_openRECORDSIZE:
14393 ffestb_local_.open.ix = FFESTP_openixRECL;
14394 ffestb_local_.open.left = FALSE;
14395 ffestb_local_.open.context = FFEEXPR_contextFILENUM;
14396 break;
14397
14398 case FFESTR_openRECORDTYPE:
14399 ffestb_local_.open.ix = FFESTP_openixRECORDTYPE;
14400 ffestb_local_.open.left = FALSE;
14401 ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
14402 break;
14403
14404 case FFESTR_openSHARED:
14405 if (ffestp_file.open.open_spec[FFESTP_openixSHARED]
14406 .kw_or_val_present)
14407 goto bad; /* :::::::::::::::::::: */
14408 ffestp_file.open.open_spec[FFESTP_openixSHARED]
14409 .kw_or_val_present = TRUE;
14410 ffestp_file.open.open_spec[FFESTP_openixSHARED]
14411 .kw_present = TRUE;
14412 ffestp_file.open.open_spec[FFESTP_openixSHARED]
14413 .value_present = FALSE;
14414 ffestp_file.open.open_spec[FFESTP_openixSHARED].kw
14415 = ffelex_token_use (t);
14416 return (ffelexHandler) ffestb_R9048_;
14417
14418 case FFESTR_openSTATUS:
14419 case FFESTR_openTYPE:
14420 ffestb_local_.open.ix = FFESTP_openixSTATUS;
14421 ffestb_local_.open.left = FALSE;
14422 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
14423 break;
14424
14425 case FFESTR_openUNIT:
14426 ffestb_local_.open.ix = FFESTP_openixUNIT;
14427 ffestb_local_.open.left = FALSE;
14428 ffestb_local_.open.context = FFEEXPR_contextFILENUM;
14429 break;
14430
14431 case FFESTR_openUSEROPEN:
14432 ffestb_local_.open.ix = FFESTP_openixUSEROPEN;
14433 ffestb_local_.open.left = TRUE;
14434 ffestb_local_.open.context = FFEEXPR_contextFILEEXTFUNC;
14435 break;
14436
14437 default:
14438 goto bad; /* :::::::::::::::::::: */
14439 }
14440 if (ffestp_file.open.open_spec[ffestb_local_.open.ix]
14441 .kw_or_val_present)
14442 break; /* Can't specify a keyword twice! */
14443 ffestp_file.open.open_spec[ffestb_local_.open.ix]
14444 .kw_or_val_present = TRUE;
14445 ffestp_file.open.open_spec[ffestb_local_.open.ix]
14446 .kw_present = TRUE;
14447 ffestp_file.open.open_spec[ffestb_local_.open.ix]
14448 .value_present = FALSE;
14449 ffestp_file.open.open_spec[ffestb_local_.open.ix].value_is_label
14450 = ffestb_local_.open.label;
14451 ffestp_file.open.open_spec[ffestb_local_.open.ix].kw
14452 = ffelex_token_use (t);
14453 return (ffelexHandler) ffestb_R9045_;
14454
14455 default:
14456 break;
14457 }
14458
14459bad: /* :::::::::::::::::::: */
14460 ffestb_subr_kill_open_ ();
14461 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
14462 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14463}
14464
14465/* ffestb_R9045_ -- "OPEN" OPEN_PAREN [external-file-unit COMMA] NAME
14466
14467 return ffestb_R9045_; // to lexer
14468
14469 Make sure EQUALS here, send next token to expression handler. */
14470
14471static ffelexHandler
14472ffestb_R9045_ (ffelexToken t)
14473{
14474 switch (ffelex_token_type (t))
14475 {
14476 case FFELEX_typeEQUALS:
14477 ffesta_confirmed ();
14478 if (ffestb_local_.open.label)
14479 return (ffelexHandler) ffestb_R9047_;
14480 if (ffestb_local_.open.left)
14481 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
14482 ffestb_local_.open.context,
14483 (ffeexprCallback) ffestb_R9046_);
14484 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
14485 ffestb_local_.open.context,
14486 (ffeexprCallback) ffestb_R9046_);
14487
14488 default:
14489 break;
14490 }
14491
14492 ffestb_subr_kill_open_ ();
14493 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
14494 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14495}
14496
14497/* ffestb_R9046_ -- "OPEN" OPEN_PAREN ... NAME EQUALS expr
14498
14499 (ffestb_R9046_) // to expression handler
14500
14501 Handle COMMA or CLOSE_PAREN here. */
14502
14503static ffelexHandler
14504ffestb_R9046_ (ffelexToken ft, ffebld expr, ffelexToken t)
14505{
14506 switch (ffelex_token_type (t))
14507 {
14508 case FFELEX_typeCOMMA:
14509 case FFELEX_typeCLOSE_PAREN:
14510 if (expr == NULL)
14511 break;
14512 ffestp_file.open.open_spec[ffestb_local_.open.ix].value_present
14513 = TRUE;
14514 ffestp_file.open.open_spec[ffestb_local_.open.ix].value
14515 = ffelex_token_use (ft);
14516 ffestp_file.open.open_spec[ffestb_local_.open.ix].u.expr = expr;
14517 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
14518 return (ffelexHandler) ffestb_R9044_;
14519 return (ffelexHandler) ffestb_R9049_;
14520
14521 default:
14522 break;
14523 }
14524
14525 ffestb_subr_kill_open_ ();
14526 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
14527 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14528}
14529
14530/* ffestb_R9047_ -- "OPEN" OPEN_PAREN ... NAME EQUALS
14531
14532 return ffestb_R9047_; // to lexer
14533
14534 Handle NUMBER for label here. */
14535
14536static ffelexHandler
14537ffestb_R9047_ (ffelexToken t)
14538{
14539 switch (ffelex_token_type (t))
14540 {
14541 case FFELEX_typeNUMBER:
14542 ffestp_file.open.open_spec[ffestb_local_.open.ix].value_present
14543 = TRUE;
14544 ffestp_file.open.open_spec[ffestb_local_.open.ix].value
14545 = ffelex_token_use (t);
14546 return (ffelexHandler) ffestb_R9048_;
14547
14548 default:
14549 break;
14550 }
14551
14552 ffestb_subr_kill_open_ ();
14553 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
14554 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14555}
14556
14557/* ffestb_R9048_ -- "OPEN" OPEN_PAREN ... NAME EQUALS NUMBER
14558
14559 return ffestb_R9048_; // to lexer
14560
14561 Handle COMMA or CLOSE_PAREN here. */
14562
14563static ffelexHandler
14564ffestb_R9048_ (ffelexToken t)
14565{
14566 switch (ffelex_token_type (t))
14567 {
14568 case FFELEX_typeCOMMA:
14569 return (ffelexHandler) ffestb_R9044_;
14570
14571 case FFELEX_typeCLOSE_PAREN:
14572 return (ffelexHandler) ffestb_R9049_;
14573
14574 default:
14575 break;
14576 }
14577
14578 ffestb_subr_kill_open_ ();
14579 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
14580 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14581}
14582
14583/* ffestb_R9049_ -- "OPEN" OPEN_PAREN ... CLOSE_PAREN
14584
14585 return ffestb_R9049_; // to lexer
14586
14587 Handle EOS or SEMICOLON here. */
14588
14589static ffelexHandler
14590ffestb_R9049_ (ffelexToken t)
14591{
14592 switch (ffelex_token_type (t))
14593 {
14594 case FFELEX_typeEOS:
14595 case FFELEX_typeSEMICOLON:
14596 ffesta_confirmed ();
14597 if (!ffesta_is_inhibited ())
14598 ffestc_R904 ();
14599 ffestb_subr_kill_open_ ();
14600 return (ffelexHandler) ffesta_zero (t);
14601
14602 default:
14603 break;
14604 }
14605
14606 ffestb_subr_kill_open_ ();
14607 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
14608 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14609}
14610
14611/* ffestb_R907 -- Parse a CLOSE statement
14612
14613 return ffestb_R907; // to lexer
14614
14615 Make sure the statement has a valid form for a CLOSE statement.
14616 If it does, implement the statement. */
14617
14618ffelexHandler
14619ffestb_R907 (ffelexToken t)
14620{
14621 ffestpCloseIx ix;
14622
14623 switch (ffelex_token_type (ffesta_tokens[0]))
14624 {
14625 case FFELEX_typeNAME:
14626 if (ffesta_first_kw != FFESTR_firstCLOSE)
14627 goto bad_0; /* :::::::::::::::::::: */
14628 break;
14629
14630 case FFELEX_typeNAMES:
14631 if (ffesta_first_kw != FFESTR_firstCLOSE)
14632 goto bad_0; /* :::::::::::::::::::: */
14633 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlCLOSE)
14634 goto bad_0; /* :::::::::::::::::::: */
14635 break;
14636
14637 default:
14638 goto bad_0; /* :::::::::::::::::::: */
14639 }
14640
14641 switch (ffelex_token_type (t))
14642 {
14643 case FFELEX_typeOPEN_PAREN:
14644 break;
14645
14646 case FFELEX_typeEOS:
14647 case FFELEX_typeSEMICOLON:
14648 case FFELEX_typeCOMMA:
14649 case FFELEX_typeCOLONCOLON:
14650 ffesta_confirmed (); /* Error, but clearly intended. */
14651 goto bad_1; /* :::::::::::::::::::: */
14652
14653 default:
14654 goto bad_1; /* :::::::::::::::::::: */
14655 }
14656
14657 for (ix = 0; ix < FFESTP_closeix; ++ix)
14658 ffestp_file.close.close_spec[ix].kw_or_val_present = FALSE;
14659
14660 return (ffelexHandler) ffestb_R9071_;
14661
14662bad_0: /* :::::::::::::::::::: */
14663 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", ffesta_tokens[0]);
14664 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14665
14666bad_1: /* :::::::::::::::::::: */
14667 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
14668 return (ffelexHandler) ffelex_swallow_tokens (t,
14669 (ffelexHandler) ffesta_zero); /* Invalid second token. */
14670}
14671
14672/* ffestb_R9071_ -- "CLOSE" OPEN_PAREN
14673
14674 return ffestb_R9071_; // to lexer
14675
14676 Handle expr construct (not NAME=expr construct) here. */
14677
14678static ffelexHandler
14679ffestb_R9071_ (ffelexToken t)
14680{
14681 switch (ffelex_token_type (t))
14682 {
14683 case FFELEX_typeNAME:
14684 ffesta_tokens[1] = ffelex_token_use (t);
14685 return (ffelexHandler) ffestb_R9072_;
14686
14687 default:
14688 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
14689 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9073_)))
14690 (t);
14691 }
14692}
14693
14694/* ffestb_R9072_ -- "CLOSE" OPEN_PAREN NAME
14695
14696 return ffestb_R9072_; // to lexer
14697
14698 If EQUALS here, go to states that handle it. Else, send NAME and this
14699 token thru expression handler. */
14700
14701static ffelexHandler
14702ffestb_R9072_ (ffelexToken t)
14703{
14704 ffelexHandler next;
14705 ffelexToken nt;
14706
14707 switch (ffelex_token_type (t))
14708 {
14709 case FFELEX_typeEQUALS:
14710 nt = ffesta_tokens[1];
14711 next = (ffelexHandler) ffestb_R9074_ (nt);
14712 ffelex_token_kill (nt);
14713 return (ffelexHandler) (*next) (t);
14714
14715 default:
14716 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
14717 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9073_)))
14718 (ffesta_tokens[1]);
14719 ffelex_token_kill (ffesta_tokens[1]);
14720 return (ffelexHandler) (*next) (t);
14721 }
14722}
14723
14724/* ffestb_R9073_ -- "CLOSE" OPEN_PAREN expr
14725
14726 (ffestb_R9073_) // to expression handler
14727
14728 Handle COMMA or CLOSE_PAREN here. */
14729
14730static ffelexHandler
14731ffestb_R9073_ (ffelexToken ft, ffebld expr, ffelexToken t)
14732{
14733 switch (ffelex_token_type (t))
14734 {
14735 case FFELEX_typeCOMMA:
14736 case FFELEX_typeCLOSE_PAREN:
14737 if (expr == NULL)
14738 break;
14739 ffestp_file.close.close_spec[FFESTP_closeixUNIT].kw_or_val_present
14740 = TRUE;
14741 ffestp_file.close.close_spec[FFESTP_closeixUNIT].kw_present = FALSE;
14742 ffestp_file.close.close_spec[FFESTP_closeixUNIT].value_present = TRUE;
14743 ffestp_file.close.close_spec[FFESTP_closeixUNIT].value_is_label
14744 = FALSE;
14745 ffestp_file.close.close_spec[FFESTP_closeixUNIT].value
14746 = ffelex_token_use (ft);
14747 ffestp_file.close.close_spec[FFESTP_closeixUNIT].u.expr = expr;
14748 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
14749 return (ffelexHandler) ffestb_R9074_;
14750 return (ffelexHandler) ffestb_R9079_;
14751
14752 default:
14753 break;
14754 }
14755
14756 ffestb_subr_kill_close_ ();
14757 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
14758 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14759}
14760
14761/* ffestb_R9074_ -- "CLOSE" OPEN_PAREN [external-file-unit COMMA]
14762
14763 return ffestb_R9074_; // to lexer
14764
14765 Handle expr construct (not NAME=expr construct) here. */
14766
14767static ffelexHandler
14768ffestb_R9074_ (ffelexToken t)
14769{
14770 ffestrGenio kw;
14771
14772 ffestb_local_.close.label = FALSE;
14773
14774 switch (ffelex_token_type (t))
14775 {
14776 case FFELEX_typeNAME:
14777 kw = ffestr_genio (t);
14778 switch (kw)
14779 {
14780 case FFESTR_genioERR:
14781 ffestb_local_.close.ix = FFESTP_closeixERR;
14782 ffestb_local_.close.label = TRUE;
14783 break;
14784
14785 case FFESTR_genioIOSTAT:
14786 ffestb_local_.close.ix = FFESTP_closeixIOSTAT;
14787 ffestb_local_.close.left = TRUE;
14788 ffestb_local_.close.context = FFEEXPR_contextFILEINT;
14789 break;
14790
14791 case FFESTR_genioSTATUS:
14792 case FFESTR_genioDISP:
14793 case FFESTR_genioDISPOSE:
14794 ffestb_local_.close.ix = FFESTP_closeixSTATUS;
14795 ffestb_local_.close.left = FALSE;
14796 ffestb_local_.close.context = FFEEXPR_contextFILEDFCHAR;
14797 break;
14798
14799 case FFESTR_genioUNIT:
14800 ffestb_local_.close.ix = FFESTP_closeixUNIT;
14801 ffestb_local_.close.left = FALSE;
14802 ffestb_local_.close.context = FFEEXPR_contextFILENUM;
14803 break;
14804
14805 default:
14806 goto bad; /* :::::::::::::::::::: */
14807 }
14808 if (ffestp_file.close.close_spec[ffestb_local_.close.ix]
14809 .kw_or_val_present)
14810 break; /* Can't specify a keyword twice! */
14811 ffestp_file.close.close_spec[ffestb_local_.close.ix]
14812 .kw_or_val_present = TRUE;
14813 ffestp_file.close.close_spec[ffestb_local_.close.ix]
14814 .kw_present = TRUE;
14815 ffestp_file.close.close_spec[ffestb_local_.close.ix]
14816 .value_present = FALSE;
14817 ffestp_file.close.close_spec[ffestb_local_.close.ix].value_is_label
14818 = ffestb_local_.close.label;
14819 ffestp_file.close.close_spec[ffestb_local_.close.ix].kw
14820 = ffelex_token_use (t);
14821 return (ffelexHandler) ffestb_R9075_;
14822
14823 default:
14824 break;
14825 }
14826
14827bad: /* :::::::::::::::::::: */
14828 ffestb_subr_kill_close_ ();
14829 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
14830 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14831}
14832
14833/* ffestb_R9075_ -- "CLOSE" OPEN_PAREN [external-file-unit COMMA] NAME
14834
14835 return ffestb_R9075_; // to lexer
14836
14837 Make sure EQUALS here, send next token to expression handler. */
14838
14839static ffelexHandler
14840ffestb_R9075_ (ffelexToken t)
14841{
14842 switch (ffelex_token_type (t))
14843 {
14844 case FFELEX_typeEQUALS:
14845 ffesta_confirmed ();
14846 if (ffestb_local_.close.label)
14847 return (ffelexHandler) ffestb_R9077_;
14848 if (ffestb_local_.close.left)
14849 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
14850 ffestb_local_.close.context,
14851 (ffeexprCallback) ffestb_R9076_);
14852 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
14853 ffestb_local_.close.context,
14854 (ffeexprCallback) ffestb_R9076_);
14855
14856 default:
14857 break;
14858 }
14859
14860 ffestb_subr_kill_close_ ();
14861 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
14862 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14863}
14864
14865/* ffestb_R9076_ -- "CLOSE" OPEN_PAREN ... NAME EQUALS expr
14866
14867 (ffestb_R9076_) // to expression handler
14868
14869 Handle COMMA or CLOSE_PAREN here. */
14870
14871static ffelexHandler
14872ffestb_R9076_ (ffelexToken ft, ffebld expr, ffelexToken t)
14873{
14874 switch (ffelex_token_type (t))
14875 {
14876 case FFELEX_typeCOMMA:
14877 case FFELEX_typeCLOSE_PAREN:
14878 if (expr == NULL)
14879 break;
14880 ffestp_file.close.close_spec[ffestb_local_.close.ix].value_present
14881 = TRUE;
14882 ffestp_file.close.close_spec[ffestb_local_.close.ix].value
14883 = ffelex_token_use (ft);
14884 ffestp_file.close.close_spec[ffestb_local_.close.ix].u.expr = expr;
14885 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
14886 return (ffelexHandler) ffestb_R9074_;
14887 return (ffelexHandler) ffestb_R9079_;
14888
14889 default:
14890 break;
14891 }
14892
14893 ffestb_subr_kill_close_ ();
14894 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
14895 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14896}
14897
14898/* ffestb_R9077_ -- "CLOSE" OPEN_PAREN ... NAME EQUALS
14899
14900 return ffestb_R9077_; // to lexer
14901
14902 Handle NUMBER for label here. */
14903
14904static ffelexHandler
14905ffestb_R9077_ (ffelexToken t)
14906{
14907 switch (ffelex_token_type (t))
14908 {
14909 case FFELEX_typeNUMBER:
14910 ffestp_file.close.close_spec[ffestb_local_.close.ix].value_present
14911 = TRUE;
14912 ffestp_file.close.close_spec[ffestb_local_.close.ix].value
14913 = ffelex_token_use (t);
14914 return (ffelexHandler) ffestb_R9078_;
14915
14916 default:
14917 break;
14918 }
14919
14920 ffestb_subr_kill_close_ ();
14921 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
14922 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14923}
14924
14925/* ffestb_R9078_ -- "CLOSE" OPEN_PAREN ... NAME EQUALS NUMBER
14926
14927 return ffestb_R9078_; // to lexer
14928
14929 Handle COMMA or CLOSE_PAREN here. */
14930
14931static ffelexHandler
14932ffestb_R9078_ (ffelexToken t)
14933{
14934 switch (ffelex_token_type (t))
14935 {
14936 case FFELEX_typeCOMMA:
14937 return (ffelexHandler) ffestb_R9074_;
14938
14939 case FFELEX_typeCLOSE_PAREN:
14940 return (ffelexHandler) ffestb_R9079_;
14941
14942 default:
14943 break;
14944 }
14945
14946 ffestb_subr_kill_close_ ();
14947 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
14948 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14949}
14950
14951/* ffestb_R9079_ -- "CLOSE" OPEN_PAREN ... CLOSE_PAREN
14952
14953 return ffestb_R9079_; // to lexer
14954
14955 Handle EOS or SEMICOLON here. */
14956
14957static ffelexHandler
14958ffestb_R9079_ (ffelexToken t)
14959{
14960 switch (ffelex_token_type (t))
14961 {
14962 case FFELEX_typeEOS:
14963 case FFELEX_typeSEMICOLON:
14964 ffesta_confirmed ();
14965 if (!ffesta_is_inhibited ())
14966 ffestc_R907 ();
14967 ffestb_subr_kill_close_ ();
14968 return (ffelexHandler) ffesta_zero (t);
14969
14970 default:
14971 break;
14972 }
14973
14974 ffestb_subr_kill_close_ ();
14975 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
14976 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14977}
14978
14979/* ffestb_R909 -- Parse the READ statement
14980
14981 return ffestb_R909; // to lexer
14982
14983 Make sure the statement has a valid form for the READ
14984 statement. If it does, implement the statement. */
14985
14986ffelexHandler
14987ffestb_R909 (ffelexToken t)
14988{
14989 ffelexHandler next;
14990 ffestpReadIx ix;
14991
14992 switch (ffelex_token_type (ffesta_tokens[0]))
14993 {
14994 case FFELEX_typeNAME:
14995 if (ffesta_first_kw != FFESTR_firstREAD)
14996 goto bad_0; /* :::::::::::::::::::: */
14997 switch (ffelex_token_type (t))
14998 {
14999 case FFELEX_typeCOMMA:
15000 case FFELEX_typeCOLONCOLON:
15001 case FFELEX_typeEOS:
15002 case FFELEX_typeSEMICOLON:
15003 ffesta_confirmed (); /* Error, but clearly intended. */
15004 goto bad_1; /* :::::::::::::::::::: */
15005
15006 case FFELEX_typeEQUALS:
15007 case FFELEX_typePOINTS:
15008 case FFELEX_typeCOLON:
15009 goto bad_1; /* :::::::::::::::::::: */
15010
15011 case FFELEX_typeNAME:
15012 case FFELEX_typeNUMBER:
15013 ffesta_confirmed ();
15014 break;
15015
15016 case FFELEX_typeOPEN_PAREN:
15017 for (ix = 0; ix < FFESTP_readix; ++ix)
15018 ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
15019 ffesta_tokens[1] = ffelex_token_use (t);
15020 return (ffelexHandler) ffestb_R9092_;
15021
15022 default:
15023 break;
15024 }
15025
15026 for (ix = 0; ix < FFESTP_readix; ++ix)
15027 ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
15028 return (ffelexHandler) (*((ffelexHandler)
15029 ffeexpr_rhs (ffesta_output_pool,
15030 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9091_)))
15031 (t);
15032
15033 case FFELEX_typeNAMES:
15034 if (ffesta_first_kw != FFESTR_firstREAD)
15035 goto bad_0; /* :::::::::::::::::::: */
15036 switch (ffelex_token_type (t))
15037 {
15038 case FFELEX_typeEOS:
15039 case FFELEX_typeSEMICOLON:
15040 case FFELEX_typeCOMMA:
15041 ffesta_confirmed ();
15042 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlREAD)
15043 break;
15044 goto bad_1; /* :::::::::::::::::::: */
15045
15046 case FFELEX_typeCOLONCOLON:
15047 ffesta_confirmed (); /* Error, but clearly intended. */
15048 goto bad_1; /* :::::::::::::::::::: */
15049
15050 case FFELEX_typeEQUALS:
15051 case FFELEX_typePOINTS:
15052 case FFELEX_typeCOLON:
15053 goto bad_1; /* :::::::::::::::::::: */
15054
15055 case FFELEX_typeOPEN_PAREN:
15056 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlREAD)
15057 break;
15058
15059 for (ix = 0; ix < FFESTP_readix; ++ix)
15060 ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
15061 ffesta_tokens[1] = ffelex_token_use (t);
15062 return (ffelexHandler) ffestb_R9092_;
15063
15064 default:
15065 break;
15066 }
15067 for (ix = 0; ix < FFESTP_readix; ++ix)
15068 ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
15069 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15070 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9091_);
15071 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
15072 FFESTR_firstlREAD);
15073 if (next == NULL)
15074 return (ffelexHandler) ffelex_swallow_tokens (t,
15075 (ffelexHandler) ffesta_zero);
15076 return (ffelexHandler) (*next) (t);
15077
15078 default:
15079 goto bad_0; /* :::::::::::::::::::: */
15080 }
15081
15082bad_0: /* :::::::::::::::::::: */
15083 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", ffesta_tokens[0]);
15084 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15085
15086bad_1: /* :::::::::::::::::::: */
15087 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15088 return (ffelexHandler) ffelex_swallow_tokens (t,
15089 (ffelexHandler) ffesta_zero); /* Invalid second token. */
15090}
15091
15092/* ffestb_R9091_ -- "READ" expr
15093
15094 (ffestb_R9091_) // to expression handler
15095
15096 Make sure the next token is a COMMA or EOS/SEMICOLON. */
15097
15098static ffelexHandler
15099ffestb_R9091_ (ffelexToken ft, ffebld expr, ffelexToken t)
15100{
15101 switch (ffelex_token_type (t))
15102 {
15103 case FFELEX_typeEOS:
15104 case FFELEX_typeSEMICOLON:
15105 case FFELEX_typeCOMMA:
15106 ffesta_confirmed ();
15107 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_or_val_present
15108 = TRUE;
15109 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_present = FALSE;
15110 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_present = TRUE;
15111 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_is_label
15112 = (expr == NULL);
15113 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value
15114 = ffelex_token_use (ft);
15115 ffestp_file.read.read_spec[FFESTP_readixFORMAT].u.expr = expr;
15116 if (!ffesta_is_inhibited ())
15117 ffestc_R909_start (TRUE);
15118 ffestb_subr_kill_read_ ();
15119 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
15120 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
15121 ffestc_context_iolist (),
15122 (ffeexprCallback) ffestb_R90915_);
15123 if (!ffesta_is_inhibited ())
15124 ffestc_R909_finish ();
15125 return (ffelexHandler) ffesta_zero (t);
15126
15127 default:
15128 break;
15129 }
15130
15131 ffestb_subr_kill_read_ ();
15132 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15133 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15134}
15135
15136/* ffestb_R9092_ -- "READ" OPEN_PAREN
15137
15138 return ffestb_R9092_; // to lexer
15139
15140 Handle expr construct (not NAME=expr construct) here. */
15141
15142static ffelexHandler
15143ffestb_R9092_ (ffelexToken t)
15144{
15145 ffelexToken nt;
15146 ffelexHandler next;
15147
15148 switch (ffelex_token_type (t))
15149 {
15150 case FFELEX_typeNAME:
15151 ffesta_tokens[2] = ffelex_token_use (t);
15152 return (ffelexHandler) ffestb_R9093_;
15153
15154 default:
15155 nt = ffesta_tokens[1];
15156 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15157 FFEEXPR_contextFILEUNITAMBIG, (ffeexprCallback) ffestb_R9094_)))
15158 (nt);
15159 ffelex_token_kill (nt);
15160 return (ffelexHandler) (*next) (t);
15161 }
15162}
15163
15164/* ffestb_R9093_ -- "READ" OPEN_PAREN NAME
15165
15166 return ffestb_R9093_; // to lexer
15167
15168 If EQUALS here, go to states that handle it. Else, send NAME and this
15169 token thru expression handler. */
15170
15171static ffelexHandler
15172ffestb_R9093_ (ffelexToken t)
15173{
15174 ffelexHandler next;
15175 ffelexToken nt;
15176 ffelexToken ot;
15177
15178 switch (ffelex_token_type (t))
15179 {
15180 case FFELEX_typeEQUALS:
15181 ffelex_token_kill (ffesta_tokens[1]);
15182 nt = ffesta_tokens[2];
15183 next = (ffelexHandler) ffestb_R9098_ (nt);
15184 ffelex_token_kill (nt);
15185 return (ffelexHandler) (*next) (t);
15186
15187 default:
15188 nt = ffesta_tokens[1];
15189 ot = ffesta_tokens[2];
15190 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15191 FFEEXPR_contextFILEUNITAMBIG, (ffeexprCallback) ffestb_R9094_)))
15192 (nt);
15193 ffelex_token_kill (nt);
15194 next = (ffelexHandler) (*next) (ot);
15195 ffelex_token_kill (ot);
15196 return (ffelexHandler) (*next) (t);
15197 }
15198}
15199
15200/* ffestb_R9094_ -- "READ" OPEN_PAREN expr [CLOSE_PAREN]
15201
15202 (ffestb_R9094_) // to expression handler
15203
15204 Handle COMMA or EOS/SEMICOLON here.
15205
15206 15-Feb-91 JCB 1.1
15207 Use new ffeexpr mechanism whereby the expr is encased in an opITEM if
15208 ffeexpr decided it was an item in a control list (hence a unit
15209 specifier), or a format specifier otherwise. */
15210
15211static ffelexHandler
15212ffestb_R9094_ (ffelexToken ft, ffebld expr, ffelexToken t)
15213{
15214 if (expr == NULL)
15215 goto bad; /* :::::::::::::::::::: */
15216
15217 if (ffebld_op (expr) != FFEBLD_opITEM)
15218 {
15219 switch (ffelex_token_type (t))
15220 {
15221 case FFELEX_typeCOMMA:
15222 case FFELEX_typeEOS:
15223 case FFELEX_typeSEMICOLON:
15224 ffesta_confirmed ();
15225 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_or_val_present
15226 = TRUE;
15227 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_present = FALSE;
15228 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_present = TRUE;
15229 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_is_label
15230 = FALSE;
15231 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value
15232 = ffelex_token_use (ft);
15233 ffestp_file.read.read_spec[FFESTP_readixFORMAT].u.expr = expr;
15234 if (!ffesta_is_inhibited ())
15235 ffestc_R909_start (TRUE);
15236 ffestb_subr_kill_read_ ();
15237 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
15238 return (ffelexHandler)
15239 ffeexpr_lhs (ffesta_output_pool,
15240 ffestc_context_iolist (),
15241 (ffeexprCallback) ffestb_R90915_);
15242 if (!ffesta_is_inhibited ())
15243 ffestc_R909_finish ();
15244 return (ffelexHandler) ffesta_zero (t);
15245
15246 default:
15247 goto bad; /* :::::::::::::::::::: */
15248 }
15249 }
15250
15251 expr = ffebld_head (expr);
15252
15253 if (expr == NULL)
15254 goto bad; /* :::::::::::::::::::: */
15255
15256 switch (ffelex_token_type (t))
15257 {
15258 case FFELEX_typeCOMMA:
15259 case FFELEX_typeCLOSE_PAREN:
15260 ffestp_file.read.read_spec[FFESTP_readixUNIT].kw_or_val_present
15261 = TRUE;
15262 ffestp_file.read.read_spec[FFESTP_readixUNIT].kw_present = FALSE;
15263 ffestp_file.read.read_spec[FFESTP_readixUNIT].value_present = TRUE;
15264 ffestp_file.read.read_spec[FFESTP_readixUNIT].value_is_label
15265 = FALSE;
15266 ffestp_file.read.read_spec[FFESTP_readixUNIT].value
15267 = ffelex_token_use (ft);
15268 ffestp_file.read.read_spec[FFESTP_readixUNIT].u.expr = expr;
15269 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
15270 return (ffelexHandler) ffestb_R9095_;
15271 return (ffelexHandler) ffestb_R90913_;
15272
15273 default:
15274 break;
15275 }
15276
15277bad: /* :::::::::::::::::::: */
15278 ffestb_subr_kill_read_ ();
15279 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15280 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15281}
15282
15283/* ffestb_R9095_ -- "READ" OPEN_PAREN expr COMMA
15284
15285 return ffestb_R9095_; // to lexer
15286
15287 Handle expr construct (not NAME=expr construct) here. */
15288
15289static ffelexHandler
15290ffestb_R9095_ (ffelexToken t)
15291{
15292 switch (ffelex_token_type (t))
15293 {
15294 case FFELEX_typeNAME:
15295 ffesta_tokens[1] = ffelex_token_use (t);
15296 return (ffelexHandler) ffestb_R9096_;
15297
15298 default:
15299 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15300 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9097_)))
15301 (t);
15302 }
15303}
15304
15305/* ffestb_R9096_ -- "READ" OPEN_PAREN expr COMMA NAME
15306
15307 return ffestb_R9096_; // to lexer
15308
15309 If EQUALS here, go to states that handle it. Else, send NAME and this
15310 token thru expression handler. */
15311
15312static ffelexHandler
15313ffestb_R9096_ (ffelexToken t)
15314{
15315 ffelexHandler next;
15316 ffelexToken nt;
15317
15318 switch (ffelex_token_type (t))
15319 {
15320 case FFELEX_typeEQUALS:
15321 nt = ffesta_tokens[1];
15322 next = (ffelexHandler) ffestb_R9098_ (nt);
15323 ffelex_token_kill (nt);
15324 return (ffelexHandler) (*next) (t);
15325
15326 default:
15327 nt = ffesta_tokens[1];
15328 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15329 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9097_)))
15330 (nt);
15331 ffelex_token_kill (nt);
15332 return (ffelexHandler) (*next) (t);
15333 }
15334}
15335
15336/* ffestb_R9097_ -- "READ" OPEN_PAREN expr COMMA expr
15337
15338 (ffestb_R9097_) // to expression handler
15339
15340 Handle COMMA or CLOSE_PAREN here. */
15341
15342static ffelexHandler
15343ffestb_R9097_ (ffelexToken ft, ffebld expr, ffelexToken t)
15344{
15345 switch (ffelex_token_type (t))
15346 {
15347 case FFELEX_typeCOMMA:
15348 case FFELEX_typeCLOSE_PAREN:
15349 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_or_val_present
15350 = TRUE;
15351 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_present = FALSE;
15352 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_present = TRUE;
15353 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_is_label
15354 = (expr == NULL);
15355 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value
15356 = ffelex_token_use (ft);
15357 ffestp_file.read.read_spec[FFESTP_readixFORMAT].u.expr = expr;
15358 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
15359 return (ffelexHandler) ffestb_R9098_;
15360 return (ffelexHandler) ffestb_R90913_;
15361
15362 default:
15363 break;
15364 }
15365
15366 ffestb_subr_kill_read_ ();
15367 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15368 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15369}
15370
15371/* ffestb_R9098_ -- "READ" OPEN_PAREN [external-file-unit COMMA [format
15372 COMMA]]
15373
15374 return ffestb_R9098_; // to lexer
15375
15376 Handle expr construct (not NAME=expr construct) here. */
15377
15378static ffelexHandler
15379ffestb_R9098_ (ffelexToken t)
15380{
15381 ffestrGenio kw;
15382
15383 ffestb_local_.read.label = FALSE;
15384
15385 switch (ffelex_token_type (t))
15386 {
15387 case FFELEX_typeNAME:
15388 kw = ffestr_genio (t);
15389 switch (kw)
15390 {
15391 case FFESTR_genioADVANCE:
15392 ffestb_local_.read.ix = FFESTP_readixADVANCE;
15393 ffestb_local_.read.left = FALSE;
15394 ffestb_local_.read.context = FFEEXPR_contextFILEDFCHAR;
15395 break;
15396
15397 case FFESTR_genioEOR:
15398 ffestb_local_.read.ix = FFESTP_readixEOR;
15399 ffestb_local_.read.label = TRUE;
15400 break;
15401
15402 case FFESTR_genioERR:
15403 ffestb_local_.read.ix = FFESTP_readixERR;
15404 ffestb_local_.read.label = TRUE;
15405 break;
15406
15407 case FFESTR_genioEND:
15408 ffestb_local_.read.ix = FFESTP_readixEND;
15409 ffestb_local_.read.label = TRUE;
15410 break;
15411
15412 case FFESTR_genioFMT:
15413 ffestb_local_.read.ix = FFESTP_readixFORMAT;
15414 ffestb_local_.read.left = FALSE;
15415 ffestb_local_.read.context = FFEEXPR_contextFILEFORMAT;
15416 break;
15417
15418 case FFESTR_genioIOSTAT:
15419 ffestb_local_.read.ix = FFESTP_readixIOSTAT;
15420 ffestb_local_.read.left = TRUE;
15421 ffestb_local_.read.context = FFEEXPR_contextFILEINT;
15422 break;
15423
15424 case FFESTR_genioKEY:
15425 case FFESTR_genioKEYEQ:
15426 ffestb_local_.read.ix = FFESTP_readixKEYEQ;
15427 ffestb_local_.read.left = FALSE;
15428 ffestb_local_.read.context = FFEEXPR_contextFILENUMCHAR;
15429 break;
15430
15431 case FFESTR_genioKEYGE:
15432 ffestb_local_.read.ix = FFESTP_readixKEYGE;
15433 ffestb_local_.read.left = FALSE;
15434 ffestb_local_.read.context = FFEEXPR_contextFILENUMCHAR;
15435 break;
15436
15437 case FFESTR_genioKEYGT:
15438 ffestb_local_.read.ix = FFESTP_readixKEYGT;
15439 ffestb_local_.read.left = FALSE;
15440 ffestb_local_.read.context = FFEEXPR_contextFILENUMCHAR;
15441 break;
15442
15443 case FFESTR_genioKEYID:
15444 ffestb_local_.read.ix = FFESTP_readixKEYID;
15445 ffestb_local_.read.left = FALSE;
15446 ffestb_local_.read.context = FFEEXPR_contextFILENUM;
15447 break;
15448
15449 case FFESTR_genioNML:
15450 ffestb_local_.read.ix = FFESTP_readixFORMAT;
15451 ffestb_local_.read.left = TRUE;
15452 ffestb_local_.read.context = FFEEXPR_contextFILENAMELIST;
15453 break;
15454
15455 case FFESTR_genioNULLS:
15456 ffestb_local_.read.ix = FFESTP_readixNULLS;
15457 ffestb_local_.read.left = TRUE;
15458 ffestb_local_.read.context = FFEEXPR_contextFILEINT;
15459 break;
15460
15461 case FFESTR_genioREC:
15462 ffestb_local_.read.ix = FFESTP_readixREC;
15463 ffestb_local_.read.left = FALSE;
15464 ffestb_local_.read.context = FFEEXPR_contextFILENUM;
15465 break;
15466
15467 case FFESTR_genioSIZE:
15468 ffestb_local_.read.ix = FFESTP_readixSIZE;
15469 ffestb_local_.read.left = TRUE;
15470 ffestb_local_.read.context = FFEEXPR_contextFILEINT;
15471 break;
15472
15473 case FFESTR_genioUNIT:
15474 ffestb_local_.read.ix = FFESTP_readixUNIT;
15475 ffestb_local_.read.left = FALSE;
15476 ffestb_local_.read.context = FFEEXPR_contextFILEUNIT;
15477 break;
15478
15479 default:
15480 goto bad; /* :::::::::::::::::::: */
15481 }
15482 if (ffestp_file.read.read_spec[ffestb_local_.read.ix]
15483 .kw_or_val_present)
15484 break; /* Can't specify a keyword twice! */
15485 ffestp_file.read.read_spec[ffestb_local_.read.ix]
15486 .kw_or_val_present = TRUE;
15487 ffestp_file.read.read_spec[ffestb_local_.read.ix]
15488 .kw_present = TRUE;
15489 ffestp_file.read.read_spec[ffestb_local_.read.ix]
15490 .value_present = FALSE;
15491 ffestp_file.read.read_spec[ffestb_local_.read.ix].value_is_label
15492 = ffestb_local_.read.label;
15493 ffestp_file.read.read_spec[ffestb_local_.read.ix].kw
15494 = ffelex_token_use (t);
15495 return (ffelexHandler) ffestb_R9099_;
15496
15497 default:
15498 break;
15499 }
15500
15501bad: /* :::::::::::::::::::: */
15502 ffestb_subr_kill_read_ ();
15503 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15504 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15505}
15506
15507/* ffestb_R9099_ -- "READ" OPEN_PAREN [external-file-unit COMMA [format
15508 COMMA]] NAME
15509
15510 return ffestb_R9099_; // to lexer
15511
15512 Make sure EQUALS here, send next token to expression handler. */
15513
15514static ffelexHandler
15515ffestb_R9099_ (ffelexToken t)
15516{
15517 switch (ffelex_token_type (t))
15518 {
15519 case FFELEX_typeEQUALS:
15520 ffesta_confirmed ();
15521 if (ffestb_local_.read.label)
15522 return (ffelexHandler) ffestb_R90911_;
15523 if (ffestb_local_.read.left)
15524 return (ffelexHandler)
15525 ffeexpr_lhs (ffesta_output_pool,
15526 ffestb_local_.read.context,
15527 (ffeexprCallback) ffestb_R90910_);
15528 return (ffelexHandler)
15529 ffeexpr_rhs (ffesta_output_pool,
15530 ffestb_local_.read.context,
15531 (ffeexprCallback) ffestb_R90910_);
15532
15533 default:
15534 break;
15535 }
15536
15537 ffestb_subr_kill_read_ ();
15538 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15539 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15540}
15541
15542/* ffestb_R90910_ -- "READ" OPEN_PAREN ... NAME EQUALS expr
15543
15544 (ffestb_R90910_) // to expression handler
15545
15546 Handle COMMA or CLOSE_PAREN here. */
15547
15548static ffelexHandler
15549ffestb_R90910_ (ffelexToken ft, ffebld expr, ffelexToken t)
15550{
15551 switch (ffelex_token_type (t))
15552 {
15553 case FFELEX_typeCOMMA:
15554 case FFELEX_typeCLOSE_PAREN:
15555 if (expr == NULL)
15556 if (ffestb_local_.read.context == FFEEXPR_contextFILEFORMAT)
15557 ffestp_file.read.read_spec[ffestb_local_.read.ix]
15558 .value_is_label = TRUE;
15559 else
15560 break;
15561 ffestp_file.read.read_spec[ffestb_local_.read.ix].value_present
15562 = TRUE;
15563 ffestp_file.read.read_spec[ffestb_local_.read.ix].value
15564 = ffelex_token_use (ft);
15565 ffestp_file.read.read_spec[ffestb_local_.read.ix].u.expr = expr;
15566 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
15567 return (ffelexHandler) ffestb_R9098_;
15568 return (ffelexHandler) ffestb_R90913_;
15569
15570 default:
15571 break;
15572 }
15573
15574 ffestb_subr_kill_read_ ();
15575 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15576 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15577}
15578
15579/* ffestb_R90911_ -- "READ" OPEN_PAREN ... NAME EQUALS
15580
15581 return ffestb_R90911_; // to lexer
15582
15583 Handle NUMBER for label here. */
15584
15585static ffelexHandler
15586ffestb_R90911_ (ffelexToken t)
15587{
15588 switch (ffelex_token_type (t))
15589 {
15590 case FFELEX_typeNUMBER:
15591 ffestp_file.read.read_spec[ffestb_local_.read.ix].value_present
15592 = TRUE;
15593 ffestp_file.read.read_spec[ffestb_local_.read.ix].value
15594 = ffelex_token_use (t);
15595 return (ffelexHandler) ffestb_R90912_;
15596
15597 default:
15598 break;
15599 }
15600
15601 ffestb_subr_kill_read_ ();
15602 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15603 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15604}
15605
15606/* ffestb_R90912_ -- "READ" OPEN_PAREN ... NAME EQUALS NUMBER
15607
15608 return ffestb_R90912_; // to lexer
15609
15610 Handle COMMA or CLOSE_PAREN here. */
15611
15612static ffelexHandler
15613ffestb_R90912_ (ffelexToken t)
15614{
15615 switch (ffelex_token_type (t))
15616 {
15617 case FFELEX_typeCOMMA:
15618 return (ffelexHandler) ffestb_R9098_;
15619
15620 case FFELEX_typeCLOSE_PAREN:
15621 return (ffelexHandler) ffestb_R90913_;
15622
15623 default:
15624 break;
15625 }
15626
15627 ffestb_subr_kill_read_ ();
15628 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15629 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15630}
15631
15632/* ffestb_R90913_ -- "READ" OPEN_PAREN ... CLOSE_PAREN
15633
15634 return ffestb_R90913_; // to lexer
15635
15636 Handle EOS or SEMICOLON here.
15637
15638 15-Feb-91 JCB 1.1
15639 Fix to allow implied-DO construct here (OPEN_PAREN) -- actually,
15640 don't presume knowledge of what an initial token in an lhs context
15641 is going to be, let ffeexpr_lhs handle that as much as possible. */
15642
15643static ffelexHandler
15644ffestb_R90913_ (ffelexToken t)
15645{
15646 switch (ffelex_token_type (t))
15647 {
15648 case FFELEX_typeEOS:
15649 case FFELEX_typeSEMICOLON:
15650 ffesta_confirmed ();
15651 if (!ffesta_is_inhibited ())
15652 {
15653 ffestc_R909_start (FALSE);
15654 ffestc_R909_finish ();
15655 }
15656 ffestb_subr_kill_read_ ();
15657 return (ffelexHandler) ffesta_zero (t);
15658
15659 default:
15660 ffesta_confirmed ();
15661 /* Fall through. */
15662 case FFELEX_typeOPEN_PAREN: /* Could still be assignment!! */
15663 break;
15664 }
15665
15666 /* If token isn't NAME or OPEN_PAREN, ffeexpr_lhs will ultimately whine
15667 about it, so leave it up to that code. */
15668
15669 /* EXTENSION: Allow an optional preceding COMMA here if not pedantic. (f2c
15670 provides this extension, as do other compilers, supposedly.) */
15671
15672 if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA))
15673 return (ffelexHandler)
15674 ffeexpr_lhs (ffesta_output_pool,
15675 ffestc_context_iolist (),
15676 (ffeexprCallback) ffestb_R90914_);
15677
15678 return (ffelexHandler) (*((ffelexHandler)
15679 ffeexpr_lhs (ffesta_output_pool,
15680 ffestc_context_iolist (),
15681 (ffeexprCallback) ffestb_R90914_)))
15682 (t);
15683}
15684
15685/* ffestb_R90914_ -- "READ(...)" expr
15686
15687 (ffestb_R90914_) // to expression handler
15688
15689 Handle COMMA or EOS/SEMICOLON here. */
15690
15691static ffelexHandler
15692ffestb_R90914_ (ffelexToken ft, ffebld expr, ffelexToken t)
15693{
15694 switch (ffelex_token_type (t))
15695 {
15696 case FFELEX_typeCOMMA:
15697 if (expr == NULL)
15698 break;
15699
15700 ffesta_confirmed ();
15701 if (!ffesta_is_inhibited ())
15702 ffestc_R909_start (FALSE);
15703 ffestb_subr_kill_read_ ();
15704
15705 if (!ffesta_is_inhibited ())
15706 ffestc_R909_item (expr, ft);
15707 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
15708 ffestc_context_iolist (),
15709 (ffeexprCallback) ffestb_R90915_);
15710
15711 case FFELEX_typeEOS:
15712 case FFELEX_typeSEMICOLON:
15713 if (expr == NULL)
15714 break;
15715
15716 ffesta_confirmed ();
15717 if (!ffesta_is_inhibited ())
15718 ffestc_R909_start (FALSE);
15719 ffestb_subr_kill_read_ ();
15720
15721 if (!ffesta_is_inhibited ())
15722 {
15723 ffestc_R909_item (expr, ft);
15724 ffestc_R909_finish ();
15725 }
15726 return (ffelexHandler) ffesta_zero (t);
15727
15728 default:
15729 break;
15730 }
15731
15732 ffestb_subr_kill_read_ ();
15733 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15734 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15735}
15736
15737/* ffestb_R90915_ -- "READ(...)" expr COMMA expr
15738
15739 (ffestb_R90915_) // to expression handler
15740
15741 Handle COMMA or EOS/SEMICOLON here. */
15742
15743static ffelexHandler
15744ffestb_R90915_ (ffelexToken ft, ffebld expr, ffelexToken t)
15745{
15746 switch (ffelex_token_type (t))
15747 {
15748 case FFELEX_typeCOMMA:
15749 if (expr == NULL)
15750 break;
15751 if (!ffesta_is_inhibited ())
15752 ffestc_R909_item (expr, ft);
15753 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
15754 ffestc_context_iolist (),
15755 (ffeexprCallback) ffestb_R90915_);
15756
15757 case FFELEX_typeEOS:
15758 case FFELEX_typeSEMICOLON:
15759 if (expr == NULL)
15760 break;
15761 if (!ffesta_is_inhibited ())
15762 {
15763 ffestc_R909_item (expr, ft);
15764 ffestc_R909_finish ();
15765 }
15766 return (ffelexHandler) ffesta_zero (t);
15767
15768 default:
15769 break;
15770 }
15771
15772 if (!ffesta_is_inhibited ())
15773 ffestc_R909_finish ();
15774 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15775 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15776}
15777
15778/* ffestb_R910 -- Parse the WRITE statement
15779
15780 return ffestb_R910; // to lexer
15781
15782 Make sure the statement has a valid form for the WRITE
15783 statement. If it does, implement the statement. */
15784
15785ffelexHandler
15786ffestb_R910 (ffelexToken t)
15787{
15788 ffestpWriteIx ix;
15789
15790 switch (ffelex_token_type (ffesta_tokens[0]))
15791 {
15792 case FFELEX_typeNAME:
15793 if (ffesta_first_kw != FFESTR_firstWRITE)
15794 goto bad_0; /* :::::::::::::::::::: */
15795 switch (ffelex_token_type (t))
15796 {
15797 case FFELEX_typeCOMMA:
15798 case FFELEX_typeCOLONCOLON:
15799 case FFELEX_typeEOS:
15800 case FFELEX_typeSEMICOLON:
15801 case FFELEX_typeNAME:
15802 case FFELEX_typeNUMBER:
15803 ffesta_confirmed (); /* Error, but clearly intended. */
15804 goto bad_1; /* :::::::::::::::::::: */
15805
15806 default:
15807 goto bad_1; /* :::::::::::::::::::: */
15808
15809 case FFELEX_typeOPEN_PAREN:
15810 for (ix = 0; ix < FFESTP_writeix; ++ix)
15811 ffestp_file.write.write_spec[ix].kw_or_val_present = FALSE;
15812 return (ffelexHandler) ffestb_R9101_;
15813 }
15814
15815 case FFELEX_typeNAMES:
15816 if (ffesta_first_kw != FFESTR_firstWRITE)
15817 goto bad_0; /* :::::::::::::::::::: */
15818 switch (ffelex_token_type (t))
15819 {
15820 case FFELEX_typeEOS:
15821 case FFELEX_typeSEMICOLON:
15822 case FFELEX_typeCOMMA:
15823 case FFELEX_typeCOLONCOLON:
15824 ffesta_confirmed (); /* Error, but clearly intended. */
15825 goto bad_1; /* :::::::::::::::::::: */
15826
15827 default:
15828 goto bad_1; /* :::::::::::::::::::: */
15829
15830 case FFELEX_typeOPEN_PAREN:
15831 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlWRITE)
15832 goto bad_0; /* :::::::::::::::::::: */
15833
15834 for (ix = 0; ix < FFESTP_writeix; ++ix)
15835 ffestp_file.write.write_spec[ix].kw_or_val_present = FALSE;
15836 return (ffelexHandler) ffestb_R9101_;
15837 }
15838
15839 default:
15840 goto bad_0; /* :::::::::::::::::::: */
15841 }
15842
15843bad_0: /* :::::::::::::::::::: */
15844 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", ffesta_tokens[0]);
15845 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15846
15847bad_1: /* :::::::::::::::::::: */
15848 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
15849 return (ffelexHandler) ffelex_swallow_tokens (t,
15850 (ffelexHandler) ffesta_zero); /* Invalid second token. */
15851}
15852
15853/* ffestb_R9101_ -- "WRITE" OPEN_PAREN
15854
15855 return ffestb_R9101_; // to lexer
15856
15857 Handle expr construct (not NAME=expr construct) here. */
15858
15859static ffelexHandler
15860ffestb_R9101_ (ffelexToken t)
15861{
15862 switch (ffelex_token_type (t))
15863 {
15864 case FFELEX_typeNAME:
15865 ffesta_tokens[1] = ffelex_token_use (t);
15866 return (ffelexHandler) ffestb_R9102_;
15867
15868 default:
15869 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15870 FFEEXPR_contextFILEUNIT, (ffeexprCallback) ffestb_R9103_)))
15871 (t);
15872 }
15873}
15874
15875/* ffestb_R9102_ -- "WRITE" OPEN_PAREN NAME
15876
15877 return ffestb_R9102_; // to lexer
15878
15879 If EQUALS here, go to states that handle it. Else, send NAME and this
15880 token thru expression handler. */
15881
15882static ffelexHandler
15883ffestb_R9102_ (ffelexToken t)
15884{
15885 ffelexHandler next;
15886 ffelexToken nt;
15887
15888 switch (ffelex_token_type (t))
15889 {
15890 case FFELEX_typeEQUALS:
15891 nt = ffesta_tokens[1];
15892 next = (ffelexHandler) ffestb_R9107_ (nt);
15893 ffelex_token_kill (nt);
15894 return (ffelexHandler) (*next) (t);
15895
15896 default:
15897 nt = ffesta_tokens[1];
15898 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15899 FFEEXPR_contextFILEUNIT, (ffeexprCallback) ffestb_R9103_)))
15900 (nt);
15901 ffelex_token_kill (nt);
15902 return (ffelexHandler) (*next) (t);
15903 }
15904}
15905
15906/* ffestb_R9103_ -- "WRITE" OPEN_PAREN expr [CLOSE_PAREN]
15907
15908 (ffestb_R9103_) // to expression handler
15909
15910 Handle COMMA or EOS/SEMICOLON here. */
15911
15912static ffelexHandler
15913ffestb_R9103_ (ffelexToken ft, ffebld expr, ffelexToken t)
15914{
15915 switch (ffelex_token_type (t))
15916 {
15917 case FFELEX_typeCOMMA:
15918 case FFELEX_typeCLOSE_PAREN:
15919 if (expr == NULL)
15920 break;
15921 ffestp_file.write.write_spec[FFESTP_writeixUNIT].kw_or_val_present
15922 = TRUE;
15923 ffestp_file.write.write_spec[FFESTP_writeixUNIT].kw_present = FALSE;
15924 ffestp_file.write.write_spec[FFESTP_writeixUNIT].value_present = TRUE;
15925 ffestp_file.write.write_spec[FFESTP_writeixUNIT].value_is_label
15926 = FALSE;
15927 ffestp_file.write.write_spec[FFESTP_writeixUNIT].value
15928 = ffelex_token_use (ft);
15929 ffestp_file.write.write_spec[FFESTP_writeixUNIT].u.expr = expr;
15930 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
15931 return (ffelexHandler) ffestb_R9104_;
15932 return (ffelexHandler) ffestb_R91012_;
15933
15934 default:
15935 break;
15936 }
15937
15938 ffestb_subr_kill_write_ ();
15939 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
15940 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15941}
15942
15943/* ffestb_R9104_ -- "WRITE" OPEN_PAREN expr COMMA
15944
15945 return ffestb_R9104_; // to lexer
15946
15947 Handle expr construct (not NAME=expr construct) here. */
15948
15949static ffelexHandler
15950ffestb_R9104_ (ffelexToken t)
15951{
15952 switch (ffelex_token_type (t))
15953 {
15954 case FFELEX_typeNAME:
15955 ffesta_tokens[1] = ffelex_token_use (t);
15956 return (ffelexHandler) ffestb_R9105_;
15957
15958 default:
15959 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15960 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9106_)))
15961 (t);
15962 }
15963}
15964
15965/* ffestb_R9105_ -- "WRITE" OPEN_PAREN expr COMMA NAME
15966
15967 return ffestb_R9105_; // to lexer
15968
15969 If EQUALS here, go to states that handle it. Else, send NAME and this
15970 token thru expression handler. */
15971
15972static ffelexHandler
15973ffestb_R9105_ (ffelexToken t)
15974{
15975 ffelexHandler next;
15976 ffelexToken nt;
15977
15978 switch (ffelex_token_type (t))
15979 {
15980 case FFELEX_typeEQUALS:
15981 nt = ffesta_tokens[1];
15982 next = (ffelexHandler) ffestb_R9107_ (nt);
15983 ffelex_token_kill (nt);
15984 return (ffelexHandler) (*next) (t);
15985
15986 default:
15987 nt = ffesta_tokens[1];
15988 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15989 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9106_)))
15990 (nt);
15991 ffelex_token_kill (nt);
15992 return (ffelexHandler) (*next) (t);
15993 }
15994}
15995
15996/* ffestb_R9106_ -- "WRITE" OPEN_PAREN expr COMMA expr
15997
15998 (ffestb_R9106_) // to expression handler
15999
16000 Handle COMMA or CLOSE_PAREN here. */
16001
16002static ffelexHandler
16003ffestb_R9106_ (ffelexToken ft, ffebld expr, ffelexToken t)
16004{
16005 switch (ffelex_token_type (t))
16006 {
16007 case FFELEX_typeCOMMA:
16008 case FFELEX_typeCLOSE_PAREN:
16009 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].kw_or_val_present
16010 = TRUE;
16011 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].kw_present = FALSE;
16012 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].value_present = TRUE;
16013 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].value_is_label
16014 = (expr == NULL);
16015 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].value
16016 = ffelex_token_use (ft);
16017 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].u.expr = expr;
16018 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
16019 return (ffelexHandler) ffestb_R9107_;
16020 return (ffelexHandler) ffestb_R91012_;
16021
16022 default:
16023 break;
16024 }
16025
16026 ffestb_subr_kill_write_ ();
16027 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
16028 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16029}
16030
16031/* ffestb_R9107_ -- "WRITE" OPEN_PAREN [external-file-unit COMMA [format
16032 COMMA]]
16033
16034 return ffestb_R9107_; // to lexer
16035
16036 Handle expr construct (not NAME=expr construct) here. */
16037
16038static ffelexHandler
16039ffestb_R9107_ (ffelexToken t)
16040{
16041 ffestrGenio kw;
16042
16043 ffestb_local_.write.label = FALSE;
16044
16045 switch (ffelex_token_type (t))
16046 {
16047 case FFELEX_typeNAME:
16048 kw = ffestr_genio (t);
16049 switch (kw)
16050 {
16051 case FFESTR_genioADVANCE:
16052 ffestb_local_.write.ix = FFESTP_writeixADVANCE;
16053 ffestb_local_.write.left = FALSE;
16054 ffestb_local_.write.context = FFEEXPR_contextFILEDFCHAR;
16055 break;
16056
16057 case FFESTR_genioEOR:
16058 ffestb_local_.write.ix = FFESTP_writeixEOR;
16059 ffestb_local_.write.label = TRUE;
16060 break;
16061
16062 case FFESTR_genioERR:
16063 ffestb_local_.write.ix = FFESTP_writeixERR;
16064 ffestb_local_.write.label = TRUE;
16065 break;
16066
16067 case FFESTR_genioFMT:
16068 ffestb_local_.write.ix = FFESTP_writeixFORMAT;
16069 ffestb_local_.write.left = FALSE;
16070 ffestb_local_.write.context = FFEEXPR_contextFILEFORMAT;
16071 break;
16072
16073 case FFESTR_genioIOSTAT:
16074 ffestb_local_.write.ix = FFESTP_writeixIOSTAT;
16075 ffestb_local_.write.left = TRUE;
16076 ffestb_local_.write.context = FFEEXPR_contextFILEINT;
16077 break;
16078
16079 case FFESTR_genioNML:
16080 ffestb_local_.write.ix = FFESTP_writeixFORMAT;
16081 ffestb_local_.write.left = TRUE;
16082 ffestb_local_.write.context = FFEEXPR_contextFILENAMELIST;
16083 break;
16084
16085 case FFESTR_genioREC:
16086 ffestb_local_.write.ix = FFESTP_writeixREC;
16087 ffestb_local_.write.left = FALSE;
16088 ffestb_local_.write.context = FFEEXPR_contextFILENUM;
16089 break;
16090
16091 case FFESTR_genioUNIT:
16092 ffestb_local_.write.ix = FFESTP_writeixUNIT;
16093 ffestb_local_.write.left = FALSE;
16094 ffestb_local_.write.context = FFEEXPR_contextFILEUNIT;
16095 break;
16096
16097 default:
16098 goto bad; /* :::::::::::::::::::: */
16099 }
16100 if (ffestp_file.write.write_spec[ffestb_local_.write.ix]
16101 .kw_or_val_present)
16102 break; /* Can't specify a keyword twice! */
16103 ffestp_file.write.write_spec[ffestb_local_.write.ix]
16104 .kw_or_val_present = TRUE;
16105 ffestp_file.write.write_spec[ffestb_local_.write.ix]
16106 .kw_present = TRUE;
16107 ffestp_file.write.write_spec[ffestb_local_.write.ix]
16108 .value_present = FALSE;
16109 ffestp_file.write.write_spec[ffestb_local_.write.ix].value_is_label
16110 = ffestb_local_.write.label;
16111 ffestp_file.write.write_spec[ffestb_local_.write.ix].kw
16112 = ffelex_token_use (t);
16113 return (ffelexHandler) ffestb_R9108_;
16114
16115 default:
16116 break;
16117 }
16118
16119bad: /* :::::::::::::::::::: */
16120 ffestb_subr_kill_write_ ();
16121 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
16122 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16123}
16124
16125/* ffestb_R9108_ -- "WRITE" OPEN_PAREN [external-file-unit COMMA [format
16126 COMMA]] NAME
16127
16128 return ffestb_R9108_; // to lexer
16129
16130 Make sure EQUALS here, send next token to expression handler. */
16131
16132static ffelexHandler
16133ffestb_R9108_ (ffelexToken t)
16134{
16135 switch (ffelex_token_type (t))
16136 {
16137 case FFELEX_typeEQUALS:
16138 ffesta_confirmed ();
16139 if (ffestb_local_.write.label)
16140 return (ffelexHandler) ffestb_R91010_;
16141 if (ffestb_local_.write.left)
16142 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
16143 ffestb_local_.write.context,
16144 (ffeexprCallback) ffestb_R9109_);
16145 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16146 ffestb_local_.write.context,
16147 (ffeexprCallback) ffestb_R9109_);
16148
16149 default:
16150 break;
16151 }
16152
16153 ffestb_subr_kill_write_ ();
16154 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
16155 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16156}
16157
16158/* ffestb_R9109_ -- "WRITE" OPEN_PAREN ... NAME EQUALS expr
16159
16160 (ffestb_R9109_) // to expression handler
16161
16162 Handle COMMA or CLOSE_PAREN here. */
16163
16164static ffelexHandler
16165ffestb_R9109_ (ffelexToken ft, ffebld expr, ffelexToken t)
16166{
16167 switch (ffelex_token_type (t))
16168 {
16169 case FFELEX_typeCOMMA:
16170 case FFELEX_typeCLOSE_PAREN:
16171 if (expr == NULL)
16172 if (ffestb_local_.write.context == FFEEXPR_contextFILEFORMAT)
16173 ffestp_file.write.write_spec[ffestb_local_.write.ix]
16174 .value_is_label = TRUE;
16175 else
16176 break;
16177 ffestp_file.write.write_spec[ffestb_local_.write.ix].value_present
16178 = TRUE;
16179 ffestp_file.write.write_spec[ffestb_local_.write.ix].value
16180 = ffelex_token_use (ft);
16181 ffestp_file.write.write_spec[ffestb_local_.write.ix].u.expr = expr;
16182 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
16183 return (ffelexHandler) ffestb_R9107_;
16184 return (ffelexHandler) ffestb_R91012_;
16185
16186 default:
16187 break;
16188 }
16189
16190 ffestb_subr_kill_write_ ();
16191 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
16192 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16193}
16194
16195/* ffestb_R91010_ -- "WRITE" OPEN_PAREN ... NAME EQUALS
16196
16197 return ffestb_R91010_; // to lexer
16198
16199 Handle NUMBER for label here. */
16200
16201static ffelexHandler
16202ffestb_R91010_ (ffelexToken t)
16203{
16204 switch (ffelex_token_type (t))
16205 {
16206 case FFELEX_typeNUMBER:
16207 ffestp_file.write.write_spec[ffestb_local_.write.ix].value_present
16208 = TRUE;
16209 ffestp_file.write.write_spec[ffestb_local_.write.ix].value
16210 = ffelex_token_use (t);
16211 return (ffelexHandler) ffestb_R91011_;
16212
16213 default:
16214 break;
16215 }
16216
16217 ffestb_subr_kill_write_ ();
16218 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
16219 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16220}
16221
16222/* ffestb_R91011_ -- "WRITE" OPEN_PAREN ... NAME EQUALS NUMBER
16223
16224 return ffestb_R91011_; // to lexer
16225
16226 Handle COMMA or CLOSE_PAREN here. */
16227
16228static ffelexHandler
16229ffestb_R91011_ (ffelexToken t)
16230{
16231 switch (ffelex_token_type (t))
16232 {
16233 case FFELEX_typeCOMMA:
16234 return (ffelexHandler) ffestb_R9107_;
16235
16236 case FFELEX_typeCLOSE_PAREN:
16237 return (ffelexHandler) ffestb_R91012_;
16238
16239 default:
16240 break;
16241 }
16242
16243 ffestb_subr_kill_write_ ();
16244 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
16245 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16246}
16247
16248/* ffestb_R91012_ -- "WRITE" OPEN_PAREN ... CLOSE_PAREN
16249
16250 return ffestb_R91012_; // to lexer
16251
16252 Handle EOS or SEMICOLON here. */
16253
16254static ffelexHandler
16255ffestb_R91012_ (ffelexToken t)
16256{
16257 switch (ffelex_token_type (t))
16258 {
16259 case FFELEX_typeEOS:
16260 case FFELEX_typeSEMICOLON:
16261 ffesta_confirmed ();
16262 if (!ffesta_is_inhibited ())
16263 {
16264 ffestc_R910_start ();
16265 ffestc_R910_finish ();
16266 }
16267 ffestb_subr_kill_write_ ();
16268 return (ffelexHandler) ffesta_zero (t);
16269
16270 default:
16271 ffesta_confirmed ();
16272 /* Fall through. */
16273 case FFELEX_typeOPEN_PAREN: /* Could still be assignment!! */
16274
16275 /* EXTENSION: Allow an optional preceding COMMA here if not pedantic.
16276 (f2c provides this extension, as do other compilers, supposedly.) */
16277
16278 if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA))
16279 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16280 ffestc_context_iolist (), (ffeexprCallback) ffestb_R91013_);
16281
16282 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16283 ffestc_context_iolist (), (ffeexprCallback) ffestb_R91013_)))
16284 (t);
16285
16286 case FFELEX_typeEQUALS:
16287 case FFELEX_typePOINTS:
16288 break;
16289 }
16290
16291 ffestb_subr_kill_write_ ();
16292 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
16293 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16294}
16295
16296/* ffestb_R91013_ -- "WRITE(...)" expr
16297
16298 (ffestb_R91013_) // to expression handler
16299
16300 Handle COMMA or EOS/SEMICOLON here. */
16301
16302static ffelexHandler
16303ffestb_R91013_ (ffelexToken ft, ffebld expr, ffelexToken t)
16304{
16305 switch (ffelex_token_type (t))
16306 {
16307 case FFELEX_typeCOMMA:
16308 if (expr == NULL)
16309 break;
16310
16311 ffesta_confirmed ();
16312 if (!ffesta_is_inhibited ())
16313 ffestc_R910_start ();
16314 ffestb_subr_kill_write_ ();
16315
16316 if (!ffesta_is_inhibited ())
16317 ffestc_R910_item (expr, ft);
16318 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16319 ffestc_context_iolist (), (ffeexprCallback) ffestb_R91014_);
16320
16321 case FFELEX_typeEOS:
16322 case FFELEX_typeSEMICOLON:
16323 if (expr == NULL)
16324 break;
16325
16326 ffesta_confirmed ();
16327 if (!ffesta_is_inhibited ())
16328 ffestc_R910_start ();
16329 ffestb_subr_kill_write_ ();
16330
16331 if (!ffesta_is_inhibited ())
16332 {
16333 ffestc_R910_item (expr, ft);
16334 ffestc_R910_finish ();
16335 }
16336 return (ffelexHandler) ffesta_zero (t);
16337
16338 default:
16339 break;
16340 }
16341
16342 ffestb_subr_kill_write_ ();
16343 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
16344 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16345}
16346
16347/* ffestb_R91014_ -- "WRITE(...)" expr COMMA expr
16348
16349 (ffestb_R91014_) // to expression handler
16350
16351 Handle COMMA or EOS/SEMICOLON here. */
16352
16353static ffelexHandler
16354ffestb_R91014_ (ffelexToken ft, ffebld expr, ffelexToken t)
16355{
16356 switch (ffelex_token_type (t))
16357 {
16358 case FFELEX_typeCOMMA:
16359 if (expr == NULL)
16360 break;
16361 if (!ffesta_is_inhibited ())
16362 ffestc_R910_item (expr, ft);
16363 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16364 ffestc_context_iolist (), (ffeexprCallback) ffestb_R91014_);
16365
16366 case FFELEX_typeEOS:
16367 case FFELEX_typeSEMICOLON:
16368 if (expr == NULL)
16369 break;
16370 if (!ffesta_is_inhibited ())
16371 {
16372 ffestc_R910_item (expr, ft);
16373 ffestc_R910_finish ();
16374 }
16375 return (ffelexHandler) ffesta_zero (t);
16376
16377 default:
16378 break;
16379 }
16380
16381 if (!ffesta_is_inhibited ())
16382 ffestc_R910_finish ();
16383 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
16384 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16385}
16386
16387/* ffestb_R911 -- Parse the PRINT statement
16388
16389 return ffestb_R911; // to lexer
16390
16391 Make sure the statement has a valid form for the PRINT
16392 statement. If it does, implement the statement. */
16393
16394ffelexHandler
16395ffestb_R911 (ffelexToken t)
16396{
16397 ffelexHandler next;
16398 ffestpPrintIx ix;
16399
16400 switch (ffelex_token_type (ffesta_tokens[0]))
16401 {
16402 case FFELEX_typeNAME:
16403 if (ffesta_first_kw != FFESTR_firstPRINT)
16404 goto bad_0; /* :::::::::::::::::::: */
16405 switch (ffelex_token_type (t))
16406 {
16407 case FFELEX_typeCOMMA:
16408 case FFELEX_typeCOLONCOLON:
16409 case FFELEX_typeEOS:
16410 case FFELEX_typeSEMICOLON:
16411 ffesta_confirmed (); /* Error, but clearly intended. */
16412 goto bad_1; /* :::::::::::::::::::: */
16413
16414 case FFELEX_typeEQUALS:
16415 case FFELEX_typePOINTS:
16416 case FFELEX_typeCOLON:
16417 goto bad_1; /* :::::::::::::::::::: */
16418
16419 case FFELEX_typeNAME:
16420 case FFELEX_typeNUMBER:
16421 ffesta_confirmed ();
16422 break;
16423
16424 default:
16425 break;
16426 }
16427
16428 for (ix = 0; ix < FFESTP_printix; ++ix)
16429 ffestp_file.print.print_spec[ix].kw_or_val_present = FALSE;
16430 return (ffelexHandler) (*((ffelexHandler)
16431 ffeexpr_rhs (ffesta_output_pool,
16432 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9111_)))
16433 (t);
16434
16435 case FFELEX_typeNAMES:
16436 if (ffesta_first_kw != FFESTR_firstPRINT)
16437 goto bad_0; /* :::::::::::::::::::: */
16438 switch (ffelex_token_type (t))
16439 {
16440 case FFELEX_typeEOS:
16441 case FFELEX_typeSEMICOLON:
16442 case FFELEX_typeCOMMA:
16443 ffesta_confirmed ();
16444 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlPRINT)
16445 break;
16446 goto bad_1; /* :::::::::::::::::::: */
16447
16448 case FFELEX_typeCOLONCOLON:
16449 ffesta_confirmed (); /* Error, but clearly intended. */
16450 goto bad_1; /* :::::::::::::::::::: */
16451
16452 case FFELEX_typeEQUALS:
16453 case FFELEX_typePOINTS:
16454 case FFELEX_typeCOLON:
16455 goto bad_1; /* :::::::::::::::::::: */
16456
16457 default:
16458 break;
16459 }
16460 for (ix = 0; ix < FFESTP_printix; ++ix)
16461 ffestp_file.print.print_spec[ix].kw_or_val_present = FALSE;
16462 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16463 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9111_);
16464 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
16465 FFESTR_firstlPRINT);
16466 if (next == NULL)
16467 return (ffelexHandler) ffelex_swallow_tokens (t,
16468 (ffelexHandler) ffesta_zero);
16469 return (ffelexHandler) (*next) (t);
16470
16471 default:
16472 goto bad_0; /* :::::::::::::::::::: */
16473 }
16474
16475bad_0: /* :::::::::::::::::::: */
16476 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", ffesta_tokens[0]);
16477 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16478
16479bad_1: /* :::::::::::::::::::: */
16480 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", t);
16481 return (ffelexHandler) ffelex_swallow_tokens (t,
16482 (ffelexHandler) ffesta_zero); /* Invalid second token. */
16483}
16484
16485/* ffestb_R9111_ -- "PRINT" expr
16486
16487 (ffestb_R9111_) // to expression handler
16488
16489 Make sure the next token is a COMMA or EOS/SEMICOLON. */
16490
16491static ffelexHandler
16492ffestb_R9111_ (ffelexToken ft, ffebld expr, ffelexToken t)
16493{
16494 switch (ffelex_token_type (t))
16495 {
16496 case FFELEX_typeEOS:
16497 case FFELEX_typeSEMICOLON:
16498 case FFELEX_typeCOMMA:
16499 ffesta_confirmed ();
16500 ffestp_file.print.print_spec[FFESTP_printixFORMAT].kw_or_val_present
16501 = TRUE;
16502 ffestp_file.print.print_spec[FFESTP_printixFORMAT].kw_present = FALSE;
16503 ffestp_file.print.print_spec[FFESTP_printixFORMAT].value_present = TRUE;
16504 ffestp_file.print.print_spec[FFESTP_printixFORMAT].value_is_label
16505 = (expr == NULL);
16506 ffestp_file.print.print_spec[FFESTP_printixFORMAT].value
16507 = ffelex_token_use (ft);
16508 ffestp_file.print.print_spec[FFESTP_printixFORMAT].u.expr = expr;
16509 if (!ffesta_is_inhibited ())
16510 ffestc_R911_start ();
16511 ffestb_subr_kill_print_ ();
16512 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
16513 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16514 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R9112_);
16515 if (!ffesta_is_inhibited ())
16516 ffestc_R911_finish ();
16517 return (ffelexHandler) ffesta_zero (t);
16518
16519 default:
16520 break;
16521 }
16522
16523 ffestb_subr_kill_print_ ();
16524 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", t);
16525 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16526}
16527
16528/* ffestb_R9112_ -- "PRINT" expr COMMA expr
16529
16530 (ffestb_R9112_) // to expression handler
16531
16532 Handle COMMA or EOS/SEMICOLON here. */
16533
16534static ffelexHandler
16535ffestb_R9112_ (ffelexToken ft, ffebld expr, ffelexToken t)
16536{
16537 switch (ffelex_token_type (t))
16538 {
16539 case FFELEX_typeCOMMA:
16540 if (expr == NULL)
16541 break;
16542 if (!ffesta_is_inhibited ())
16543 ffestc_R911_item (expr, ft);
16544 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16545 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R9112_);
16546
16547 case FFELEX_typeEOS:
16548 case FFELEX_typeSEMICOLON:
16549 if (expr == NULL)
16550 break;
16551 if (!ffesta_is_inhibited ())
16552 {
16553 ffestc_R911_item (expr, ft);
16554 ffestc_R911_finish ();
16555 }
16556 return (ffelexHandler) ffesta_zero (t);
16557
16558 default:
16559 break;
16560 }
16561
16562 if (!ffesta_is_inhibited ())
16563 ffestc_R911_finish ();
16564 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", t);
16565 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16566}
16567
16568/* ffestb_R923 -- Parse an INQUIRE statement
16569
16570 return ffestb_R923; // to lexer
16571
16572 Make sure the statement has a valid form for an INQUIRE statement.
16573 If it does, implement the statement. */
16574
16575ffelexHandler
16576ffestb_R923 (ffelexToken t)
16577{
16578 ffestpInquireIx ix;
16579
16580 switch (ffelex_token_type (ffesta_tokens[0]))
16581 {
16582 case FFELEX_typeNAME:
16583 if (ffesta_first_kw != FFESTR_firstINQUIRE)
16584 goto bad_0; /* :::::::::::::::::::: */
16585 break;
16586
16587 case FFELEX_typeNAMES:
16588 if (ffesta_first_kw != FFESTR_firstINQUIRE)
16589 goto bad_0; /* :::::::::::::::::::: */
16590 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlINQUIRE)
16591 goto bad_0; /* :::::::::::::::::::: */
16592 break;
16593
16594 default:
16595 goto bad_0; /* :::::::::::::::::::: */
16596 }
16597
16598 switch (ffelex_token_type (t))
16599 {
16600 case FFELEX_typeOPEN_PAREN:
16601 break;
16602
16603 case FFELEX_typeEOS:
16604 case FFELEX_typeSEMICOLON:
16605 case FFELEX_typeCOMMA:
16606 case FFELEX_typeCOLONCOLON:
16607 ffesta_confirmed (); /* Error, but clearly intended. */
16608 goto bad_1; /* :::::::::::::::::::: */
16609
16610 default:
16611 goto bad_1; /* :::::::::::::::::::: */
16612 }
16613
16614 for (ix = 0; ix < FFESTP_inquireix; ++ix)
16615 ffestp_file.inquire.inquire_spec[ix].kw_or_val_present = FALSE;
16616
16617 ffestb_local_.inquire.may_be_iolength = TRUE;
16618 return (ffelexHandler) ffestb_R9231_;
16619
16620bad_0: /* :::::::::::::::::::: */
16621 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", ffesta_tokens[0]);
16622 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16623
16624bad_1: /* :::::::::::::::::::: */
16625 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
16626 return (ffelexHandler) ffelex_swallow_tokens (t,
16627 (ffelexHandler) ffesta_zero); /* Invalid second token. */
16628}
16629
16630/* ffestb_R9231_ -- "INQUIRE" OPEN_PAREN
16631
16632 return ffestb_R9231_; // to lexer
16633
16634 Handle expr construct (not NAME=expr construct) here. */
16635
16636static ffelexHandler
16637ffestb_R9231_ (ffelexToken t)
16638{
16639 switch (ffelex_token_type (t))
16640 {
16641 case FFELEX_typeNAME:
16642 ffesta_tokens[1] = ffelex_token_use (t);
16643 return (ffelexHandler) ffestb_R9232_;
16644
16645 default:
16646 ffestb_local_.inquire.may_be_iolength = FALSE;
16647 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16648 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9233_)))
16649 (t);
16650 }
16651}
16652
16653/* ffestb_R9232_ -- "INQUIRE" OPEN_PAREN NAME
16654
16655 return ffestb_R9232_; // to lexer
16656
16657 If EQUALS here, go to states that handle it. Else, send NAME and this
16658 token thru expression handler. */
16659
16660static ffelexHandler
16661ffestb_R9232_ (ffelexToken t)
16662{
16663 ffelexHandler next;
16664 ffelexToken nt;
16665
16666 switch (ffelex_token_type (t))
16667 {
16668 case FFELEX_typeEQUALS:
16669 nt = ffesta_tokens[1];
16670 next = (ffelexHandler) ffestb_R9234_ (nt);
16671 ffelex_token_kill (nt);
16672 return (ffelexHandler) (*next) (t);
16673
16674 default:
16675 ffestb_local_.inquire.may_be_iolength = FALSE;
16676 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16677 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9233_)))
16678 (ffesta_tokens[1]);
16679 ffelex_token_kill (ffesta_tokens[1]);
16680 return (ffelexHandler) (*next) (t);
16681 }
16682}
16683
16684/* ffestb_R9233_ -- "INQUIRE" OPEN_PAREN expr
16685
16686 (ffestb_R9233_) // to expression handler
16687
16688 Handle COMMA or CLOSE_PAREN here. */
16689
16690static ffelexHandler
16691ffestb_R9233_ (ffelexToken ft, ffebld expr, ffelexToken t)
16692{
16693 switch (ffelex_token_type (t))
16694 {
16695 case FFELEX_typeCOMMA:
16696 case FFELEX_typeCLOSE_PAREN:
16697 if (expr == NULL)
16698 break;
16699 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw_or_val_present
16700 = TRUE;
16701 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw_present = FALSE;
16702 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value_present = TRUE;
16703 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value_is_label
16704 = FALSE;
16705 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value
16706 = ffelex_token_use (ft);
16707 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].u.expr = expr;
16708 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
16709 return (ffelexHandler) ffestb_R9234_;
16710 return (ffelexHandler) ffestb_R9239_;
16711
16712 default:
16713 break;
16714 }
16715
16716 ffestb_subr_kill_inquire_ ();
16717 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
16718 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16719}
16720
16721/* ffestb_R9234_ -- "INQUIRE" OPEN_PAREN [external-file-unit COMMA]
16722
16723 return ffestb_R9234_; // to lexer
16724
16725 Handle expr construct (not NAME=expr construct) here. */
16726
16727static ffelexHandler
16728ffestb_R9234_ (ffelexToken t)
16729{
16730 ffestrInquire kw;
16731
16732 ffestb_local_.inquire.label = FALSE;
16733
16734 switch (ffelex_token_type (t))
16735 {
16736 case FFELEX_typeNAME:
16737 kw = ffestr_inquire (t);
16738 if (kw != FFESTR_inquireIOLENGTH)
16739 ffestb_local_.inquire.may_be_iolength = FALSE;
16740 switch (kw)
16741 {
16742 case FFESTR_inquireACCESS:
16743 ffestb_local_.inquire.ix = FFESTP_inquireixACCESS;
16744 ffestb_local_.inquire.left = TRUE;
16745 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16746 break;
16747
16748 case FFESTR_inquireACTION:
16749 ffestb_local_.inquire.ix = FFESTP_inquireixACTION;
16750 ffestb_local_.inquire.left = TRUE;
16751 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16752 break;
16753
16754 case FFESTR_inquireBLANK:
16755 ffestb_local_.inquire.ix = FFESTP_inquireixBLANK;
16756 ffestb_local_.inquire.left = TRUE;
16757 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16758 break;
16759
16760 case FFESTR_inquireCARRIAGECONTROL:
16761 ffestb_local_.inquire.ix = FFESTP_inquireixCARRIAGECONTROL;
16762 ffestb_local_.inquire.left = TRUE;
16763 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
16764 break;
16765
16766 case FFESTR_inquireDEFAULTFILE:
16767 ffestb_local_.inquire.ix = FFESTP_inquireixDEFAULTFILE;
16768 ffestb_local_.inquire.left = FALSE;
16769 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
16770 break;
16771
16772 case FFESTR_inquireDELIM:
16773 ffestb_local_.inquire.ix = FFESTP_inquireixDELIM;
16774 ffestb_local_.inquire.left = TRUE;
16775 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16776 break;
16777
16778 case FFESTR_inquireDIRECT:
16779 ffestb_local_.inquire.ix = FFESTP_inquireixDIRECT;
16780 ffestb_local_.inquire.left = TRUE;
16781 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16782 break;
16783
16784 case FFESTR_inquireERR:
16785 ffestb_local_.inquire.ix = FFESTP_inquireixERR;
16786 ffestb_local_.inquire.label = TRUE;
16787 break;
16788
16789 case FFESTR_inquireEXIST:
16790 ffestb_local_.inquire.ix = FFESTP_inquireixEXIST;
16791 ffestb_local_.inquire.left = TRUE;
16792 ffestb_local_.inquire.context = FFEEXPR_contextFILELOG;
16793 break;
16794
16795 case FFESTR_inquireFILE:
16796 ffestb_local_.inquire.ix = FFESTP_inquireixFILE;
16797 ffestb_local_.inquire.left = FALSE;
16798 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
16799 break;
16800
16801 case FFESTR_inquireFORM:
16802 ffestb_local_.inquire.ix = FFESTP_inquireixFORM;
16803 ffestb_local_.inquire.left = TRUE;
16804 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16805 break;
16806
16807 case FFESTR_inquireFORMATTED:
16808 ffestb_local_.inquire.ix = FFESTP_inquireixFORMATTED;
16809 ffestb_local_.inquire.left = TRUE;
16810 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16811 break;
16812
16813 case FFESTR_inquireIOLENGTH:
16814 if (!ffestb_local_.inquire.may_be_iolength)
16815 goto bad; /* :::::::::::::::::::: */
16816 ffestb_local_.inquire.ix = FFESTP_inquireixIOLENGTH;
16817 ffestb_local_.inquire.left = TRUE;
16818 ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
16819 break;
16820
16821 case FFESTR_inquireIOSTAT:
16822 ffestb_local_.inquire.ix = FFESTP_inquireixIOSTAT;
16823 ffestb_local_.inquire.left = TRUE;
16824 ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
16825 break;
16826
16827 case FFESTR_inquireKEYED:
16828 ffestb_local_.inquire.ix = FFESTP_inquireixKEYED;
16829 ffestb_local_.inquire.left = TRUE;
16830 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
16831 break;
16832
16833 case FFESTR_inquireNAME:
16834 ffestb_local_.inquire.ix = FFESTP_inquireixNAME;
16835 ffestb_local_.inquire.left = TRUE;
16836 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
16837 break;
16838
16839 case FFESTR_inquireNAMED:
16840 ffestb_local_.inquire.ix = FFESTP_inquireixNAMED;
16841 ffestb_local_.inquire.left = TRUE;
16842 ffestb_local_.inquire.context = FFEEXPR_contextFILELOG;
16843 break;
16844
16845 case FFESTR_inquireNEXTREC:
16846 ffestb_local_.inquire.ix = FFESTP_inquireixNEXTREC;
16847 ffestb_local_.inquire.left = TRUE;
16848 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFINT;
16849 break;
16850
16851 case FFESTR_inquireNUMBER:
16852 ffestb_local_.inquire.ix = FFESTP_inquireixNUMBER;
16853 ffestb_local_.inquire.left = TRUE;
16854 ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
16855 break;
16856
16857 case FFESTR_inquireOPENED:
16858 ffestb_local_.inquire.ix = FFESTP_inquireixOPENED;
16859 ffestb_local_.inquire.left = TRUE;
16860 ffestb_local_.inquire.context = FFEEXPR_contextFILELOG;
16861 break;
16862
16863 case FFESTR_inquireORGANIZATION:
16864 ffestb_local_.inquire.ix = FFESTP_inquireixORGANIZATION;
16865 ffestb_local_.inquire.left = TRUE;
16866 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
16867 break;
16868
16869 case FFESTR_inquirePAD:
16870 ffestb_local_.inquire.ix = FFESTP_inquireixPAD;
16871 ffestb_local_.inquire.left = TRUE;
16872 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16873 break;
16874
16875 case FFESTR_inquirePOSITION:
16876 ffestb_local_.inquire.ix = FFESTP_inquireixPOSITION;
16877 ffestb_local_.inquire.left = TRUE;
16878 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16879 break;
16880
16881 case FFESTR_inquireREAD:
16882 ffestb_local_.inquire.ix = FFESTP_inquireixREAD;
16883 ffestb_local_.inquire.left = TRUE;
16884 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16885 break;
16886
16887 case FFESTR_inquireREADWRITE:
16888 ffestb_local_.inquire.ix = FFESTP_inquireixREADWRITE;
16889 ffestb_local_.inquire.left = TRUE;
16890 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16891 break;
16892
16893 case FFESTR_inquireRECL:
16894 ffestb_local_.inquire.ix = FFESTP_inquireixRECL;
16895 ffestb_local_.inquire.left = TRUE;
16896 ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
16897 break;
16898
16899 case FFESTR_inquireRECORDTYPE:
16900 ffestb_local_.inquire.ix = FFESTP_inquireixRECORDTYPE;
16901 ffestb_local_.inquire.left = TRUE;
16902 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
16903 break;
16904
16905 case FFESTR_inquireSEQUENTIAL:
16906 ffestb_local_.inquire.ix = FFESTP_inquireixSEQUENTIAL;
16907 ffestb_local_.inquire.left = TRUE;
16908 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16909 break;
16910
16911 case FFESTR_inquireUNFORMATTED:
16912 ffestb_local_.inquire.ix = FFESTP_inquireixUNFORMATTED;
16913 ffestb_local_.inquire.left = TRUE;
16914 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16915 break;
16916
16917 case FFESTR_inquireUNIT:
16918 ffestb_local_.inquire.ix = FFESTP_inquireixUNIT;
16919 ffestb_local_.inquire.left = FALSE;
16920 ffestb_local_.inquire.context = FFEEXPR_contextFILENUM;
16921 break;
16922
16923 default:
16924 goto bad; /* :::::::::::::::::::: */
16925 }
16926 if (ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
16927 .kw_or_val_present)
16928 break; /* Can't specify a keyword twice! */
16929 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
16930 .kw_or_val_present = TRUE;
16931 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
16932 .kw_present = TRUE;
16933 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
16934 .value_present = FALSE;
16935 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value_is_label
16936 = ffestb_local_.inquire.label;
16937 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].kw
16938 = ffelex_token_use (t);
16939 return (ffelexHandler) ffestb_R9235_;
16940
16941 default:
16942 break;
16943 }
16944
16945bad: /* :::::::::::::::::::: */
16946 ffestb_subr_kill_inquire_ ();
16947 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
16948 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16949}
16950
16951/* ffestb_R9235_ -- "INQUIRE" OPEN_PAREN [external-file-unit COMMA] NAME
16952
16953 return ffestb_R9235_; // to lexer
16954
16955 Make sure EQUALS here, send next token to expression handler. */
16956
16957static ffelexHandler
16958ffestb_R9235_ (ffelexToken t)
16959{
16960 switch (ffelex_token_type (t))
16961 {
16962 case FFELEX_typeEQUALS:
16963 ffesta_confirmed ();
16964 if (ffestb_local_.inquire.label)
16965 return (ffelexHandler) ffestb_R9237_;
16966 if (ffestb_local_.inquire.left)
16967 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
16968 ffestb_local_.inquire.context,
16969 (ffeexprCallback) ffestb_R9236_);
16970 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16971 ffestb_local_.inquire.context,
16972 (ffeexprCallback) ffestb_R9236_);
16973
16974 default:
16975 break;
16976 }
16977
16978 ffestb_subr_kill_inquire_ ();
16979 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
16980 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16981}
16982
16983/* ffestb_R9236_ -- "INQUIRE" OPEN_PAREN ... NAME EQUALS expr
16984
16985 (ffestb_R9236_) // to expression handler
16986
16987 Handle COMMA or CLOSE_PAREN here. */
16988
16989static ffelexHandler
16990ffestb_R9236_ (ffelexToken ft, ffebld expr, ffelexToken t)
16991{
16992 switch (ffelex_token_type (t))
16993 {
16994 case FFELEX_typeCOMMA:
16995 if (ffestb_local_.inquire.ix == FFESTP_inquireixIOLENGTH)
16996 break; /* IOLENGTH=expr must be followed by
16997 CLOSE_PAREN. */
16998 /* Fall through. */
16999 case FFELEX_typeCLOSE_PAREN:
17000 if (expr == NULL)
17001 break;
17002 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value_present
17003 = TRUE;
17004 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value
17005 = ffelex_token_use (ft);
17006 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].u.expr = expr;
17007 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
17008 return (ffelexHandler) ffestb_R9234_;
17009 if (ffestb_local_.inquire.ix == FFESTP_inquireixIOLENGTH)
17010 return (ffelexHandler) ffestb_R92310_;
17011 return (ffelexHandler) ffestb_R9239_;
17012
17013 default:
17014 break;
17015 }
17016
17017 ffestb_subr_kill_inquire_ ();
17018 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
17019 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17020}
17021
17022/* ffestb_R9237_ -- "INQUIRE" OPEN_PAREN ... NAME EQUALS
17023
17024 return ffestb_R9237_; // to lexer
17025
17026 Handle NUMBER for label here. */
17027
17028static ffelexHandler
17029ffestb_R9237_ (ffelexToken t)
17030{
17031 switch (ffelex_token_type (t))
17032 {
17033 case FFELEX_typeNUMBER:
17034 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value_present
17035 = TRUE;
17036 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value
17037 = ffelex_token_use (t);
17038 return (ffelexHandler) ffestb_R9238_;
17039
17040 default:
17041 break;
17042 }
17043
17044 ffestb_subr_kill_inquire_ ();
17045 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
17046 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17047}
17048
17049/* ffestb_R9238_ -- "INQUIRE" OPEN_PAREN ... NAME EQUALS NUMBER
17050
17051 return ffestb_R9238_; // to lexer
17052
17053 Handle COMMA or CLOSE_PAREN here. */
17054
17055static ffelexHandler
17056ffestb_R9238_ (ffelexToken t)
17057{
17058 switch (ffelex_token_type (t))
17059 {
17060 case FFELEX_typeCOMMA:
17061 return (ffelexHandler) ffestb_R9234_;
17062
17063 case FFELEX_typeCLOSE_PAREN:
17064 return (ffelexHandler) ffestb_R9239_;
17065
17066 default:
17067 break;
17068 }
17069
17070 ffestb_subr_kill_inquire_ ();
17071 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
17072 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17073}
17074
17075/* ffestb_R9239_ -- "INQUIRE" OPEN_PAREN ... CLOSE_PAREN
17076
17077 return ffestb_R9239_; // to lexer
17078
17079 Handle EOS or SEMICOLON here. */
17080
17081static ffelexHandler
17082ffestb_R9239_ (ffelexToken t)
17083{
17084 switch (ffelex_token_type (t))
17085 {
17086 case FFELEX_typeEOS:
17087 case FFELEX_typeSEMICOLON:
17088 ffesta_confirmed ();
17089 if (!ffesta_is_inhibited ())
17090 ffestc_R923A ();
17091 ffestb_subr_kill_inquire_ ();
17092 return (ffelexHandler) ffesta_zero (t);
17093
17094 default:
17095 break;
17096 }
17097
17098 ffestb_subr_kill_inquire_ ();
17099 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
17100 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17101}
17102
17103/* ffestb_R92310_ -- "INQUIRE(IOLENGTH=expr)"
17104
17105 return ffestb_R92310_; // to lexer
17106
17107 Make sure EOS or SEMICOLON not here; begin R923B processing and expect
17108 output IO list. */
17109
17110static ffelexHandler
17111ffestb_R92310_ (ffelexToken t)
17112{
17113 switch (ffelex_token_type (t))
17114 {
17115 case FFELEX_typeEOS:
17116 case FFELEX_typeSEMICOLON:
17117 break;
17118
17119 default:
17120 ffesta_confirmed ();
17121 if (!ffesta_is_inhibited ())
17122 ffestc_R923B_start ();
17123 ffestb_subr_kill_inquire_ ();
17124 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17125 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R92311_)))
17126 (t);
17127 }
17128
17129 ffestb_subr_kill_inquire_ ();
17130 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
17131 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17132}
17133
17134/* ffestb_R92311_ -- "INQUIRE(IOLENGTH=expr)" expr
17135
17136 (ffestb_R92311_) // to expression handler
17137
17138 Handle COMMA or EOS/SEMICOLON here. */
17139
17140static ffelexHandler
17141ffestb_R92311_ (ffelexToken ft, ffebld expr, ffelexToken t)
17142{
17143 switch (ffelex_token_type (t))
17144 {
17145 case FFELEX_typeCOMMA:
17146 if (expr == NULL)
17147 break;
17148 if (!ffesta_is_inhibited ())
17149 ffestc_R923B_item (expr, ft);
17150 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17151 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R92311_);
17152
17153 case FFELEX_typeEOS:
17154 case FFELEX_typeSEMICOLON:
17155 if (expr == NULL)
17156 break;
17157 if (!ffesta_is_inhibited ())
17158 {
17159 ffestc_R923B_item (expr, ft);
17160 ffestc_R923B_finish ();
17161 }
17162 return (ffelexHandler) ffesta_zero (t);
17163
17164 default:
17165 break;
17166 }
17167
17168 if (!ffesta_is_inhibited ())
17169 ffestc_R923B_finish ();
17170 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
17171 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17172}
17173
17174/* ffestb_V018 -- Parse the REWRITE statement
17175
17176 return ffestb_V018; // to lexer
17177
17178 Make sure the statement has a valid form for the REWRITE
17179 statement. If it does, implement the statement. */
17180
17181#if FFESTR_VXT
17182ffelexHandler
17183ffestb_V018 (ffelexToken t)
17184{
17185 ffestpRewriteIx ix;
17186
17187 switch (ffelex_token_type (ffesta_tokens[0]))
17188 {
17189 case FFELEX_typeNAME:
17190 if (ffesta_first_kw != FFESTR_firstREWRITE)
17191 goto bad_0; /* :::::::::::::::::::: */
17192 switch (ffelex_token_type (t))
17193 {
17194 case FFELEX_typeCOMMA:
17195 case FFELEX_typeCOLONCOLON:
17196 case FFELEX_typeEOS:
17197 case FFELEX_typeSEMICOLON:
17198 case FFELEX_typeNAME:
17199 case FFELEX_typeNUMBER:
17200 ffesta_confirmed (); /* Error, but clearly intended. */
17201 goto bad_1; /* :::::::::::::::::::: */
17202
17203 default:
17204 goto bad_1; /* :::::::::::::::::::: */
17205
17206 case FFELEX_typeOPEN_PAREN:
17207 for (ix = 0; ix < FFESTP_rewriteix; ++ix)
17208 ffestp_file.rewrite.rewrite_spec[ix].kw_or_val_present = FALSE;
17209 return (ffelexHandler) ffestb_V0181_;
17210 }
17211
17212 case FFELEX_typeNAMES:
17213 if (ffesta_first_kw != FFESTR_firstREWRITE)
17214 goto bad_0; /* :::::::::::::::::::: */
17215 switch (ffelex_token_type (t))
17216 {
17217 case FFELEX_typeEOS:
17218 case FFELEX_typeSEMICOLON:
17219 case FFELEX_typeCOMMA:
17220 case FFELEX_typeCOLONCOLON:
17221 ffesta_confirmed (); /* Error, but clearly intended. */
17222 goto bad_1; /* :::::::::::::::::::: */
17223
17224 default:
17225 goto bad_1; /* :::::::::::::::::::: */
17226
17227 case FFELEX_typeOPEN_PAREN:
17228 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlREWRITE)
17229 goto bad_0; /* :::::::::::::::::::: */
17230
17231 for (ix = 0; ix < FFESTP_rewriteix; ++ix)
17232 ffestp_file.rewrite.rewrite_spec[ix].kw_or_val_present = FALSE;
17233 return (ffelexHandler) ffestb_V0181_;
17234 }
17235
17236 default:
17237 goto bad_0; /* :::::::::::::::::::: */
17238 }
17239
17240bad_0: /* :::::::::::::::::::: */
17241 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", ffesta_tokens[0]);
17242 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17243
17244bad_1: /* :::::::::::::::::::: */
17245 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17246 return (ffelexHandler) ffelex_swallow_tokens (t,
17247 (ffelexHandler) ffesta_zero); /* Invalid second token. */
17248}
17249
17250/* ffestb_V0181_ -- "REWRITE" OPEN_PAREN
17251
17252 return ffestb_V0181_; // to lexer
17253
17254 Handle expr construct (not NAME=expr construct) here. */
17255
17256static ffelexHandler
17257ffestb_V0181_ (ffelexToken t)
17258{
17259 switch (ffelex_token_type (t))
17260 {
17261 case FFELEX_typeNAME:
17262 ffesta_tokens[1] = ffelex_token_use (t);
17263 return (ffelexHandler) ffestb_V0182_;
17264
17265 default:
17266 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17267 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0183_)))
17268 (t);
17269 }
17270}
17271
17272/* ffestb_V0182_ -- "REWRITE" OPEN_PAREN NAME
17273
17274 return ffestb_V0182_; // to lexer
17275
17276 If EQUALS here, go to states that handle it. Else, send NAME and this
17277 token thru expression handler. */
17278
17279static ffelexHandler
17280ffestb_V0182_ (ffelexToken t)
17281{
17282 ffelexHandler next;
17283 ffelexToken nt;
17284
17285 switch (ffelex_token_type (t))
17286 {
17287 case FFELEX_typeEQUALS:
17288 nt = ffesta_tokens[1];
17289 next = (ffelexHandler) ffestb_V0187_ (nt);
17290 ffelex_token_kill (nt);
17291 return (ffelexHandler) (*next) (t);
17292
17293 default:
17294 nt = ffesta_tokens[1];
17295 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17296 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0183_)))
17297 (nt);
17298 ffelex_token_kill (nt);
17299 return (ffelexHandler) (*next) (t);
17300 }
17301}
17302
17303/* ffestb_V0183_ -- "REWRITE" OPEN_PAREN expr [CLOSE_PAREN]
17304
17305 (ffestb_V0183_) // to expression handler
17306
17307 Handle COMMA or EOS/SEMICOLON here. */
17308
17309static ffelexHandler
17310ffestb_V0183_ (ffelexToken ft, ffebld expr, ffelexToken t)
17311{
17312 switch (ffelex_token_type (t))
17313 {
17314 case FFELEX_typeCOMMA:
17315 case FFELEX_typeCLOSE_PAREN:
17316 if (expr == NULL)
17317 break;
17318 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].kw_or_val_present
17319 = TRUE;
17320 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].kw_present = FALSE;
17321 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].value_present = TRUE;
17322 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].value_is_label
17323 = FALSE;
17324 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].value
17325 = ffelex_token_use (ft);
17326 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].u.expr = expr;
17327 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
17328 return (ffelexHandler) ffestb_V0184_;
17329 return (ffelexHandler) ffestb_V01812_;
17330
17331 default:
17332 break;
17333 }
17334
17335 ffestb_subr_kill_rewrite_ ();
17336 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17337 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17338}
17339
17340/* ffestb_V0184_ -- "REWRITE" OPEN_PAREN expr COMMA
17341
17342 return ffestb_V0184_; // to lexer
17343
17344 Handle expr construct (not NAME=expr construct) here. */
17345
17346static ffelexHandler
17347ffestb_V0184_ (ffelexToken t)
17348{
17349 switch (ffelex_token_type (t))
17350 {
17351 case FFELEX_typeNAME:
17352 ffesta_tokens[1] = ffelex_token_use (t);
17353 return (ffelexHandler) ffestb_V0185_;
17354
17355 default:
17356 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17357 FFEEXPR_contextFILEFORMAT, (ffeexprCallback) ffestb_V0186_)))
17358 (t);
17359 }
17360}
17361
17362/* ffestb_V0185_ -- "REWRITE" OPEN_PAREN expr COMMA NAME
17363
17364 return ffestb_V0185_; // to lexer
17365
17366 If EQUALS here, go to states that handle it. Else, send NAME and this
17367 token thru expression handler. */
17368
17369static ffelexHandler
17370ffestb_V0185_ (ffelexToken t)
17371{
17372 ffelexHandler next;
17373 ffelexToken nt;
17374
17375 switch (ffelex_token_type (t))
17376 {
17377 case FFELEX_typeEQUALS:
17378 nt = ffesta_tokens[1];
17379 next = (ffelexHandler) ffestb_V0187_ (nt);
17380 ffelex_token_kill (nt);
17381 return (ffelexHandler) (*next) (t);
17382
17383 default:
17384 nt = ffesta_tokens[1];
17385 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17386 FFEEXPR_contextFILEFORMAT, (ffeexprCallback) ffestb_V0186_)))
17387 (nt);
17388 ffelex_token_kill (nt);
17389 return (ffelexHandler) (*next) (t);
17390 }
17391}
17392
17393/* ffestb_V0186_ -- "REWRITE" OPEN_PAREN expr COMMA expr
17394
17395 (ffestb_V0186_) // to expression handler
17396
17397 Handle COMMA or CLOSE_PAREN here. */
17398
17399static ffelexHandler
17400ffestb_V0186_ (ffelexToken ft, ffebld expr, ffelexToken t)
17401{
17402 switch (ffelex_token_type (t))
17403 {
17404 case FFELEX_typeCOMMA:
17405 case FFELEX_typeCLOSE_PAREN:
17406 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw_or_val_present
17407 = TRUE;
17408 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw_present = FALSE;
17409 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value_present = TRUE;
17410 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value_is_label
17411 = (expr == NULL);
17412 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value
17413 = ffelex_token_use (ft);
17414 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].u.expr = expr;
17415 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
17416 return (ffelexHandler) ffestb_V0187_;
17417 return (ffelexHandler) ffestb_V01812_;
17418
17419 default:
17420 break;
17421 }
17422
17423 ffestb_subr_kill_rewrite_ ();
17424 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17425 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17426}
17427
17428/* ffestb_V0187_ -- "REWRITE" OPEN_PAREN [external-file-unit COMMA [format
17429 COMMA]]
17430
17431 return ffestb_V0187_; // to lexer
17432
17433 Handle expr construct (not NAME=expr construct) here. */
17434
17435static ffelexHandler
17436ffestb_V0187_ (ffelexToken t)
17437{
17438 ffestrGenio kw;
17439
17440 ffestb_local_.rewrite.label = FALSE;
17441
17442 switch (ffelex_token_type (t))
17443 {
17444 case FFELEX_typeNAME:
17445 kw = ffestr_genio (t);
17446 switch (kw)
17447 {
17448 case FFESTR_genioERR:
17449 ffestb_local_.rewrite.ix = FFESTP_rewriteixERR;
17450 ffestb_local_.rewrite.label = TRUE;
17451 break;
17452
17453 case FFESTR_genioFMT:
17454 ffestb_local_.rewrite.ix = FFESTP_rewriteixFMT;
17455 ffestb_local_.rewrite.left = FALSE;
17456 ffestb_local_.rewrite.context = FFEEXPR_contextFILEFORMAT;
17457 break;
17458
17459 case FFESTR_genioIOSTAT:
17460 ffestb_local_.rewrite.ix = FFESTP_rewriteixIOSTAT;
17461 ffestb_local_.rewrite.left = TRUE;
17462 ffestb_local_.rewrite.context = FFEEXPR_contextFILEINT;
17463 break;
17464
17465 case FFESTR_genioUNIT:
17466 ffestb_local_.rewrite.ix = FFESTP_rewriteixUNIT;
17467 ffestb_local_.rewrite.left = FALSE;
17468 ffestb_local_.rewrite.context = FFEEXPR_contextFILENUM;
17469 break;
17470
17471 default:
17472 goto bad; /* :::::::::::::::::::: */
17473 }
17474 if (ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
17475 .kw_or_val_present)
17476 break; /* Can't specify a keyword twice! */
17477 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
17478 .kw_or_val_present = TRUE;
17479 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
17480 .kw_present = TRUE;
17481 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
17482 .value_present = FALSE;
17483 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value_is_label
17484 = ffestb_local_.rewrite.label;
17485 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].kw
17486 = ffelex_token_use (t);
17487 return (ffelexHandler) ffestb_V0188_;
17488
17489 default:
17490 break;
17491 }
17492
17493bad: /* :::::::::::::::::::: */
17494 ffestb_subr_kill_rewrite_ ();
17495 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17496 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17497}
17498
17499/* ffestb_V0188_ -- "REWRITE" OPEN_PAREN [external-file-unit COMMA [format
17500 COMMA]] NAME
17501
17502 return ffestb_V0188_; // to lexer
17503
17504 Make sure EQUALS here, send next token to expression handler. */
17505
17506static ffelexHandler
17507ffestb_V0188_ (ffelexToken t)
17508{
17509 switch (ffelex_token_type (t))
17510 {
17511 case FFELEX_typeEQUALS:
17512 ffesta_confirmed ();
17513 if (ffestb_local_.rewrite.label)
17514 return (ffelexHandler) ffestb_V01810_;
17515 if (ffestb_local_.rewrite.left)
17516 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
17517 ffestb_local_.rewrite.context,
17518 (ffeexprCallback) ffestb_V0189_);
17519 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17520 ffestb_local_.rewrite.context,
17521 (ffeexprCallback) ffestb_V0189_);
17522
17523 default:
17524 break;
17525 }
17526
17527 ffestb_subr_kill_rewrite_ ();
17528 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17529 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17530}
17531
17532/* ffestb_V0189_ -- "REWRITE" OPEN_PAREN ... NAME EQUALS expr
17533
17534 (ffestb_V0189_) // to expression handler
17535
17536 Handle COMMA or CLOSE_PAREN here. */
17537
17538static ffelexHandler
17539ffestb_V0189_ (ffelexToken ft, ffebld expr, ffelexToken t)
17540{
17541 switch (ffelex_token_type (t))
17542 {
17543 case FFELEX_typeCOMMA:
17544 case FFELEX_typeCLOSE_PAREN:
17545 if (expr == NULL)
17546 if (ffestb_local_.rewrite.context == FFEEXPR_contextFILEFORMAT)
17547 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
17548 .value_is_label = TRUE;
17549 else
17550 break;
17551 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value_present
17552 = TRUE;
17553 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value
17554 = ffelex_token_use (ft);
17555 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].u.expr = expr;
17556 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
17557 return (ffelexHandler) ffestb_V0187_;
17558 return (ffelexHandler) ffestb_V01812_;
17559
17560 default:
17561 break;
17562 }
17563
17564 ffestb_subr_kill_rewrite_ ();
17565 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17566 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17567}
17568
17569/* ffestb_V01810_ -- "REWRITE" OPEN_PAREN ... NAME EQUALS
17570
17571 return ffestb_V01810_; // to lexer
17572
17573 Handle NUMBER for label here. */
17574
17575static ffelexHandler
17576ffestb_V01810_ (ffelexToken t)
17577{
17578 switch (ffelex_token_type (t))
17579 {
17580 case FFELEX_typeNUMBER:
17581 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value_present
17582 = TRUE;
17583 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value
17584 = ffelex_token_use (t);
17585 return (ffelexHandler) ffestb_V01811_;
17586
17587 default:
17588 break;
17589 }
17590
17591 ffestb_subr_kill_rewrite_ ();
17592 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17593 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17594}
17595
17596/* ffestb_V01811_ -- "REWRITE" OPEN_PAREN ... NAME EQUALS NUMBER
17597
17598 return ffestb_V01811_; // to lexer
17599
17600 Handle COMMA or CLOSE_PAREN here. */
17601
17602static ffelexHandler
17603ffestb_V01811_ (ffelexToken t)
17604{
17605 switch (ffelex_token_type (t))
17606 {
17607 case FFELEX_typeCOMMA:
17608 return (ffelexHandler) ffestb_V0187_;
17609
17610 case FFELEX_typeCLOSE_PAREN:
17611 return (ffelexHandler) ffestb_V01812_;
17612
17613 default:
17614 break;
17615 }
17616
17617 ffestb_subr_kill_rewrite_ ();
17618 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17619 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17620}
17621
17622/* ffestb_V01812_ -- "REWRITE" OPEN_PAREN ... CLOSE_PAREN
17623
17624 return ffestb_V01812_; // to lexer
17625
17626 Handle EOS or SEMICOLON here. */
17627
17628static ffelexHandler
17629ffestb_V01812_ (ffelexToken t)
17630{
17631 switch (ffelex_token_type (t))
17632 {
17633 case FFELEX_typeEOS:
17634 case FFELEX_typeSEMICOLON:
17635 ffesta_confirmed ();
17636 if (!ffesta_is_inhibited ())
17637 {
17638 ffestc_V018_start ();
17639 ffestc_V018_finish ();
17640 }
17641 ffestb_subr_kill_rewrite_ ();
17642 return (ffelexHandler) ffesta_zero (t);
17643
17644 case FFELEX_typeNAME:
17645 case FFELEX_typeOPEN_PAREN:
17646 case FFELEX_typeCOMMA:
17647 ffesta_confirmed ();
17648 if (!ffesta_is_inhibited ())
17649 ffestc_V018_start ();
17650 ffestb_subr_kill_rewrite_ ();
17651
17652 /* EXTENSION: Allow an optional preceding COMMA here if not pedantic.
17653 (f2c provides this extension, as do other compilers, supposedly.) */
17654
17655 if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA))
17656 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17657 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V01813_);
17658
17659 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17660 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V01813_)))
17661 (t);
17662
17663 default:
17664 break;
17665 }
17666
17667 ffestb_subr_kill_rewrite_ ();
17668 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17669 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17670}
17671
17672/* ffestb_V01813_ -- "REWRITE(...)" expr
17673
17674 (ffestb_V01813_) // to expression handler
17675
17676 Handle COMMA or EOS/SEMICOLON here. */
17677
17678static ffelexHandler
17679ffestb_V01813_ (ffelexToken ft, ffebld expr, ffelexToken t)
17680{
17681 switch (ffelex_token_type (t))
17682 {
17683 case FFELEX_typeCOMMA:
17684 if (expr == NULL)
17685 break;
17686 if (!ffesta_is_inhibited ())
17687 ffestc_V018_item (expr, ft);
17688 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17689 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V01813_);
17690
17691 case FFELEX_typeEOS:
17692 case FFELEX_typeSEMICOLON:
17693 if (expr == NULL)
17694 break;
17695 if (!ffesta_is_inhibited ())
17696 {
17697 ffestc_V018_item (expr, ft);
17698 ffestc_V018_finish ();
17699 }
17700 return (ffelexHandler) ffesta_zero (t);
17701
17702 default:
17703 break;
17704 }
17705
17706 if (!ffesta_is_inhibited ())
17707 ffestc_V018_finish ();
17708 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17709 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17710}
17711
17712/* ffestb_V019 -- Parse the ACCEPT statement
17713
17714 return ffestb_V019; // to lexer
17715
17716 Make sure the statement has a valid form for the ACCEPT
17717 statement. If it does, implement the statement. */
17718
17719ffelexHandler
17720ffestb_V019 (ffelexToken t)
17721{
17722 ffelexHandler next;
17723 ffestpAcceptIx ix;
17724
17725 switch (ffelex_token_type (ffesta_tokens[0]))
17726 {
17727 case FFELEX_typeNAME:
17728 if (ffesta_first_kw != FFESTR_firstACCEPT)
17729 goto bad_0; /* :::::::::::::::::::: */
17730 switch (ffelex_token_type (t))
17731 {
17732 case FFELEX_typeCOMMA:
17733 case FFELEX_typeCOLONCOLON:
17734 case FFELEX_typeEOS:
17735 case FFELEX_typeSEMICOLON:
17736 ffesta_confirmed (); /* Error, but clearly intended. */
17737 goto bad_1; /* :::::::::::::::::::: */
17738
17739 case FFELEX_typeEQUALS:
17740 case FFELEX_typePOINTS:
17741 case FFELEX_typeCOLON:
17742 goto bad_1; /* :::::::::::::::::::: */
17743
17744 case FFELEX_typeNAME:
17745 case FFELEX_typeNUMBER:
17746 ffesta_confirmed ();
17747 break;
17748
17749 default:
17750 break;
17751 }
17752
17753 for (ix = 0; ix < FFESTP_acceptix; ++ix)
17754 ffestp_file.accept.accept_spec[ix].kw_or_val_present = FALSE;
17755 return (ffelexHandler) (*((ffelexHandler)
17756 ffeexpr_rhs (ffesta_output_pool,
17757 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0191_)))
17758 (t);
17759
17760 case FFELEX_typeNAMES:
17761 if (ffesta_first_kw != FFESTR_firstACCEPT)
17762 goto bad_0; /* :::::::::::::::::::: */
17763 switch (ffelex_token_type (t))
17764 {
17765 case FFELEX_typeEOS:
17766 case FFELEX_typeSEMICOLON:
17767 case FFELEX_typeCOMMA:
17768 ffesta_confirmed ();
17769 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlACCEPT)
17770 break;
17771 goto bad_1; /* :::::::::::::::::::: */
17772
17773 case FFELEX_typeCOLONCOLON:
17774 ffesta_confirmed (); /* Error, but clearly intended. */
17775 goto bad_1; /* :::::::::::::::::::: */
17776
17777 case FFELEX_typeEQUALS:
17778 case FFELEX_typePOINTS:
17779 case FFELEX_typeCOLON:
17780 goto bad_1; /* :::::::::::::::::::: */
17781
17782 default:
17783 break;
17784 }
17785 for (ix = 0; ix < FFESTP_acceptix; ++ix)
17786 ffestp_file.accept.accept_spec[ix].kw_or_val_present = FALSE;
17787 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17788 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0191_);
17789 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
17790 FFESTR_firstlACCEPT);
17791 if (next == NULL)
17792 return (ffelexHandler) ffelex_swallow_tokens (t,
17793 (ffelexHandler) ffesta_zero);
17794 return (ffelexHandler) (*next) (t);
17795
17796 default:
17797 goto bad_0; /* :::::::::::::::::::: */
17798 }
17799
17800bad_0: /* :::::::::::::::::::: */
17801 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", ffesta_tokens[0]);
17802 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17803
17804bad_1: /* :::::::::::::::::::: */
17805 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", t);
17806 return (ffelexHandler) ffelex_swallow_tokens (t,
17807 (ffelexHandler) ffesta_zero); /* Invalid second token. */
17808}
17809
17810/* ffestb_V0191_ -- "ACCEPT" expr
17811
17812 (ffestb_V0191_) // to expression handler
17813
17814 Make sure the next token is a COMMA or EOS/SEMICOLON. */
17815
17816static ffelexHandler
17817ffestb_V0191_ (ffelexToken ft, ffebld expr, ffelexToken t)
17818{
17819 switch (ffelex_token_type (t))
17820 {
17821 case FFELEX_typeEOS:
17822 case FFELEX_typeSEMICOLON:
17823 case FFELEX_typeCOMMA:
17824 ffesta_confirmed ();
17825 ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].kw_or_val_present
17826 = TRUE;
17827 ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].kw_present = FALSE;
17828 ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].value_present = TRUE;
17829 ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].value_is_label
17830 = (expr == NULL);
17831 ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].value
17832 = ffelex_token_use (ft);
17833 ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].u.expr = expr;
17834 if (!ffesta_is_inhibited ())
17835 ffestc_V019_start ();
17836 ffestb_subr_kill_accept_ ();
17837 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
17838 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
17839 FFEEXPR_contextIOLIST,
17840 (ffeexprCallback) ffestb_V0192_);
17841 if (!ffesta_is_inhibited ())
17842 ffestc_V019_finish ();
17843 return (ffelexHandler) ffesta_zero (t);
17844
17845 default:
17846 break;
17847 }
17848
17849 ffestb_subr_kill_accept_ ();
17850 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", t);
17851 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17852}
17853
17854/* ffestb_V0192_ -- "ACCEPT" expr COMMA expr
17855
17856 (ffestb_V0192_) // to expression handler
17857
17858 Handle COMMA or EOS/SEMICOLON here. */
17859
17860static ffelexHandler
17861ffestb_V0192_ (ffelexToken ft, ffebld expr, ffelexToken t)
17862{
17863 switch (ffelex_token_type (t))
17864 {
17865 case FFELEX_typeCOMMA:
17866 if (expr == NULL)
17867 break;
17868 if (!ffesta_is_inhibited ())
17869 ffestc_V019_item (expr, ft);
17870 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
17871 FFEEXPR_contextIOLIST,
17872 (ffeexprCallback) ffestb_V0192_);
17873
17874 case FFELEX_typeEOS:
17875 case FFELEX_typeSEMICOLON:
17876 if (expr == NULL)
17877 break;
17878 if (!ffesta_is_inhibited ())
17879 {
17880 ffestc_V019_item (expr, ft);
17881 ffestc_V019_finish ();
17882 }
17883 return (ffelexHandler) ffesta_zero (t);
17884
17885 default:
17886 break;
17887 }
17888
17889 if (!ffesta_is_inhibited ())
17890 ffestc_V019_finish ();
17891 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", t);
17892 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17893}
17894
17895#endif
17896/* ffestb_V020 -- Parse the TYPE statement
17897
17898 return ffestb_V020; // to lexer
17899
17900 Make sure the statement has a valid form for the TYPE
17901 statement. If it does, implement the statement. */
17902
17903ffelexHandler
17904ffestb_V020 (ffelexToken t)
17905{
17906 ffeTokenLength i;
17907 char *p;
17908 ffelexHandler next;
17909 ffestpTypeIx ix;
17910
17911 switch (ffelex_token_type (ffesta_tokens[0]))
17912 {
17913 case FFELEX_typeNAME:
17914 if (ffesta_first_kw != FFESTR_firstTYPE)
17915 goto bad_0; /* :::::::::::::::::::: */
17916 switch (ffelex_token_type (t))
17917 {
17918 case FFELEX_typeCOLONCOLON:
17919 case FFELEX_typeEOS:
17920 case FFELEX_typeSEMICOLON:
17921 ffesta_confirmed (); /* Error, but clearly intended. */
17922 goto bad_1; /* :::::::::::::::::::: */
17923
17924 case FFELEX_typeEQUALS:
17925 case FFELEX_typePOINTS:
17926 case FFELEX_typeCOLON:
17927 case FFELEX_typeCOMMA: /* Because "TYPE,PUBLIC::A" is ambiguous with
17928 '90. */
17929 goto bad_1; /* :::::::::::::::::::: */
17930
17931 case FFELEX_typeNUMBER:
17932 ffesta_confirmed ();
17933 break;
17934
17935 case FFELEX_typeNAME: /* Because TYPE A is ambiguous with '90. */
17936 default:
17937 break;
17938 }
17939
17940 for (ix = 0; ix < FFESTP_typeix; ++ix)
17941 ffestp_file.type.type_spec[ix].kw_or_val_present = FALSE;
17942 return (ffelexHandler) (*((ffelexHandler)
17943 ffeexpr_rhs (ffesta_output_pool,
17944 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0201_)))
17945 (t);
17946
17947 case FFELEX_typeNAMES:
17948 if (ffesta_first_kw != FFESTR_firstTYPE)
17949 goto bad_0; /* :::::::::::::::::::: */
17950 switch (ffelex_token_type (t))
17951 {
17952 case FFELEX_typeEOS:
17953 case FFELEX_typeSEMICOLON:
17954 case FFELEX_typeCOMMA:
17955 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlTYPE)
17956 break;
17957 goto bad_1; /* :::::::::::::::::::: */
17958
17959 case FFELEX_typeCOLONCOLON:
17960 ffesta_confirmed (); /* Error, but clearly intended. */
17961 goto bad_1; /* :::::::::::::::::::: */
17962
17963 case FFELEX_typeOPEN_PAREN:
17964 if (ffelex_token_length (ffesta_tokens[0]) == FFESTR_firstlTYPE)
17965 break; /* Else might be assignment/stmtfuncdef. */
17966 goto bad_1; /* :::::::::::::::::::: */
17967
17968 case FFELEX_typeEQUALS:
17969 case FFELEX_typePOINTS:
17970 case FFELEX_typeCOLON:
17971 goto bad_1; /* :::::::::::::::::::: */
17972
17973 default:
17974 break;
17975 }
17976 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlTYPE);
17977 if (isdigit (*p))
17978 ffesta_confirmed (); /* Else might be '90 TYPE statement. */
17979 for (ix = 0; ix < FFESTP_typeix; ++ix)
17980 ffestp_file.type.type_spec[ix].kw_or_val_present = FALSE;
17981 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17982 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0201_);
17983 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
17984 FFESTR_firstlTYPE);
17985 if (next == NULL)
17986 return (ffelexHandler) ffelex_swallow_tokens (t,
17987 (ffelexHandler) ffesta_zero);
17988 return (ffelexHandler) (*next) (t);
17989
17990 default:
17991 goto bad_0; /* :::::::::::::::::::: */
17992 }
17993
17994bad_0: /* :::::::::::::::::::: */
17995 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", ffesta_tokens[0]);
17996 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17997
17998bad_1: /* :::::::::::::::::::: */
17999 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", t);
18000 return (ffelexHandler) ffelex_swallow_tokens (t,
18001 (ffelexHandler) ffesta_zero); /* Invalid second token. */
18002}
18003
18004/* ffestb_V0201_ -- "TYPE" expr
18005
18006 (ffestb_V0201_) // to expression handler
18007
18008 Make sure the next token is a COMMA or EOS/SEMICOLON. */
18009
18010static ffelexHandler
18011ffestb_V0201_ (ffelexToken ft, ffebld expr, ffelexToken t)
18012{
18013 bool comma = TRUE;
18014
18015 switch (ffelex_token_type (t))
18016 {
18017 case FFELEX_typeEOS:
18018 case FFELEX_typeSEMICOLON:
18019 if (!ffe_is_vxt () && (expr != NULL)
18020 && (ffebld_op (expr) == FFEBLD_opSYMTER))
18021 break;
18022 comma = FALSE;
18023 /* Fall through. */
18024 case FFELEX_typeCOMMA:
18025 if (!ffe_is_vxt () && comma && (expr != NULL)
18026 && (ffebld_op (expr) == FFEBLD_opPAREN)
18027 && (ffebld_op (ffebld_left (expr)) == FFEBLD_opSYMTER))
18028 break;
18029 ffesta_confirmed ();
18030 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].kw_or_val_present
18031 = TRUE;
18032 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].kw_present = FALSE;
18033 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].value_present = TRUE;
18034 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].value_is_label
18035 = (expr == NULL);
18036 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].value
18037 = ffelex_token_use (ft);
18038 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].u.expr = expr;
18039 if (!ffesta_is_inhibited ())
18040 ffestc_V020_start ();
18041 ffestb_subr_kill_type_ ();
18042 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
18043 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
18044 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V0202_);
18045 if (!ffesta_is_inhibited ())
18046 ffestc_V020_finish ();
18047 return (ffelexHandler) ffesta_zero (t);
18048
18049 default:
18050 break;
18051 }
18052
18053 ffestb_subr_kill_type_ ();
18054 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", t);
18055 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18056}
18057
18058/* ffestb_V0202_ -- "TYPE" expr COMMA expr
18059
18060 (ffestb_V0202_) // to expression handler
18061
18062 Handle COMMA or EOS/SEMICOLON here. */
18063
18064static ffelexHandler
18065ffestb_V0202_ (ffelexToken ft, ffebld expr, ffelexToken t)
18066{
18067 switch (ffelex_token_type (t))
18068 {
18069 case FFELEX_typeCOMMA:
18070 if (expr == NULL)
18071 break;
18072 if (!ffesta_is_inhibited ())
18073 ffestc_V020_item (expr, ft);
18074 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
18075 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V0202_);
18076
18077 case FFELEX_typeEOS:
18078 case FFELEX_typeSEMICOLON:
18079 if (expr == NULL)
18080 break;
18081 if (!ffesta_is_inhibited ())
18082 {
18083 ffestc_V020_item (expr, ft);
18084 ffestc_V020_finish ();
18085 }
18086 return (ffelexHandler) ffesta_zero (t);
18087
18088 default:
18089 break;
18090 }
18091
18092 if (!ffesta_is_inhibited ())
18093 ffestc_V020_finish ();
18094 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", t);
18095 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18096}
18097
18098/* ffestb_V021 -- Parse a DELETE statement
18099
18100 return ffestb_V021; // to lexer
18101
18102 Make sure the statement has a valid form for a DELETE statement.
18103 If it does, implement the statement. */
18104
18105#if FFESTR_VXT
18106ffelexHandler
18107ffestb_V021 (ffelexToken t)
18108{
18109 ffestpDeleteIx ix;
18110
18111 switch (ffelex_token_type (ffesta_tokens[0]))
18112 {
18113 case FFELEX_typeNAME:
18114 if (ffesta_first_kw != FFESTR_firstDELETE)
18115 goto bad_0; /* :::::::::::::::::::: */
18116 break;
18117
18118 case FFELEX_typeNAMES:
18119 if (ffesta_first_kw != FFESTR_firstDELETE)
18120 goto bad_0; /* :::::::::::::::::::: */
18121 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlDELETE)
18122 goto bad_0; /* :::::::::::::::::::: */
18123 break;
18124
18125 default:
18126 goto bad_0; /* :::::::::::::::::::: */
18127 }
18128
18129 switch (ffelex_token_type (t))
18130 {
18131 case FFELEX_typeOPEN_PAREN:
18132 break;
18133
18134 case FFELEX_typeEOS:
18135 case FFELEX_typeSEMICOLON:
18136 case FFELEX_typeCOMMA:
18137 case FFELEX_typeCOLONCOLON:
18138 ffesta_confirmed (); /* Error, but clearly intended. */
18139 goto bad_1; /* :::::::::::::::::::: */
18140
18141 default:
18142 goto bad_1; /* :::::::::::::::::::: */
18143 }
18144
18145 for (ix = 0; ix < FFESTP_deleteix; ++ix)
18146 ffestp_file.delete.delete_spec[ix].kw_or_val_present = FALSE;
18147
18148 return (ffelexHandler) ffestb_V0211_;
18149
18150bad_0: /* :::::::::::::::::::: */
18151 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", ffesta_tokens[0]);
18152 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18153
18154bad_1: /* :::::::::::::::::::: */
18155 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
18156 return (ffelexHandler) ffelex_swallow_tokens (t,
18157 (ffelexHandler) ffesta_zero); /* Invalid second token. */
18158}
18159
18160/* ffestb_V0211_ -- "DELETE" OPEN_PAREN
18161
18162 return ffestb_V0211_; // to lexer
18163
18164 Handle expr construct (not NAME=expr construct) here. */
18165
18166static ffelexHandler
18167ffestb_V0211_ (ffelexToken t)
18168{
18169 switch (ffelex_token_type (t))
18170 {
18171 case FFELEX_typeNAME:
18172 ffesta_tokens[1] = ffelex_token_use (t);
18173 return (ffelexHandler) ffestb_V0212_;
18174
18175 default:
18176 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
18177 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0213_)))
18178 (t);
18179 }
18180}
18181
18182/* ffestb_V0212_ -- "DELETE" OPEN_PAREN NAME
18183
18184 return ffestb_V0212_; // to lexer
18185
18186 If EQUALS here, go to states that handle it. Else, send NAME and this
18187 token thru expression handler. */
18188
18189static ffelexHandler
18190ffestb_V0212_ (ffelexToken t)
18191{
18192 ffelexHandler next;
18193 ffelexToken nt;
18194
18195 switch (ffelex_token_type (t))
18196 {
18197 case FFELEX_typeEQUALS:
18198 nt = ffesta_tokens[1];
18199 next = (ffelexHandler) ffestb_V0214_ (nt);
18200 ffelex_token_kill (nt);
18201 return (ffelexHandler) (*next) (t);
18202
18203 default:
18204 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
18205 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0213_)))
18206 (ffesta_tokens[1]);
18207 ffelex_token_kill (ffesta_tokens[1]);
18208 return (ffelexHandler) (*next) (t);
18209 }
18210}
18211
18212/* ffestb_V0213_ -- "DELETE" OPEN_PAREN expr
18213
18214 (ffestb_V0213_) // to expression handler
18215
18216 Handle COMMA or DELETE_PAREN here. */
18217
18218static ffelexHandler
18219ffestb_V0213_ (ffelexToken ft, ffebld expr, ffelexToken t)
18220{
18221 switch (ffelex_token_type (t))
18222 {
18223 case FFELEX_typeCOMMA:
18224 case FFELEX_typeCLOSE_PAREN:
18225 if (expr == NULL)
18226 break;
18227 ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].kw_or_val_present
18228 = TRUE;
18229 ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].kw_present = FALSE;
18230 ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].value_present = TRUE;
18231 ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].value_is_label
18232 = FALSE;
18233 ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].value
18234 = ffelex_token_use (ft);
18235 ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].u.expr = expr;
18236 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
18237 return (ffelexHandler) ffestb_V0214_;
18238 return (ffelexHandler) ffestb_V0219_;
18239
18240 default:
18241 break;
18242 }
18243
18244 ffestb_subr_kill_delete_ ();
18245 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
18246 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18247}
18248
18249/* ffestb_V0214_ -- "DELETE" OPEN_PAREN [external-file-unit COMMA]
18250
18251 return ffestb_V0214_; // to lexer
18252
18253 Handle expr construct (not NAME=expr construct) here. */
18254
18255static ffelexHandler
18256ffestb_V0214_ (ffelexToken t)
18257{
18258 ffestrGenio kw;
18259
18260 ffestb_local_.delete.label = FALSE;
18261
18262 switch (ffelex_token_type (t))
18263 {
18264 case FFELEX_typeNAME:
18265 kw = ffestr_genio (t);
18266 switch (kw)
18267 {
18268 case FFESTR_genioERR:
18269 ffestb_local_.delete.ix = FFESTP_deleteixERR;
18270 ffestb_local_.delete.label = TRUE;
18271 break;
18272
18273 case FFESTR_genioIOSTAT:
18274 ffestb_local_.delete.ix = FFESTP_deleteixIOSTAT;
18275 ffestb_local_.delete.left = TRUE;
18276 ffestb_local_.delete.context = FFEEXPR_contextFILEINT;
18277 break;
18278
18279 case FFESTR_genioREC:
18280 ffestb_local_.delete.ix = FFESTP_deleteixREC;
18281 ffestb_local_.delete.left = FALSE;
18282 ffestb_local_.delete.context = FFEEXPR_contextFILENUM;
18283 break;
18284
18285 case FFESTR_genioUNIT:
18286 ffestb_local_.delete.ix = FFESTP_deleteixUNIT;
18287 ffestb_local_.delete.left = FALSE;
18288 ffestb_local_.delete.context = FFEEXPR_contextFILENUM;
18289 break;
18290
18291 default:
18292 goto bad; /* :::::::::::::::::::: */
18293 }
18294 if (ffestp_file.delete.delete_spec[ffestb_local_.delete.ix]
18295 .kw_or_val_present)
18296 break; /* Can't specify a keyword twice! */
18297 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix]
18298 .kw_or_val_present = TRUE;
18299 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix]
18300 .kw_present = TRUE;
18301 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix]
18302 .value_present = FALSE;
18303 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value_is_label
18304 = ffestb_local_.delete.label;
18305 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].kw
18306 = ffelex_token_use (t);
18307 return (ffelexHandler) ffestb_V0215_;
18308
18309 default:
18310 break;
18311 }
18312
18313bad: /* :::::::::::::::::::: */
18314 ffestb_subr_kill_delete_ ();
18315 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
18316 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18317}
18318
18319/* ffestb_V0215_ -- "DELETE" OPEN_PAREN [external-file-unit COMMA] NAME
18320
18321 return ffestb_V0215_; // to lexer
18322
18323 Make sure EQUALS here, send next token to expression handler. */
18324
18325static ffelexHandler
18326ffestb_V0215_ (ffelexToken t)
18327{
18328 switch (ffelex_token_type (t))
18329 {
18330 case FFELEX_typeEQUALS:
18331 ffesta_confirmed ();
18332 if (ffestb_local_.delete.label)
18333 return (ffelexHandler) ffestb_V0217_;
18334 if (ffestb_local_.delete.left)
18335 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
18336 ffestb_local_.delete.context,
18337 (ffeexprCallback) ffestb_V0216_);
18338 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
18339 ffestb_local_.delete.context, (ffeexprCallback) ffestb_V0216_);
18340
18341 default:
18342 break;
18343 }
18344
18345 ffestb_subr_kill_delete_ ();
18346 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
18347 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18348}
18349
18350/* ffestb_V0216_ -- "DELETE" OPEN_PAREN ... NAME EQUALS expr
18351
18352 (ffestb_V0216_) // to expression handler
18353
18354 Handle COMMA or CLOSE_PAREN here. */
18355
18356static ffelexHandler
18357ffestb_V0216_ (ffelexToken ft, ffebld expr, ffelexToken t)
18358{
18359 switch (ffelex_token_type (t))
18360 {
18361 case FFELEX_typeCOMMA:
18362 case FFELEX_typeCLOSE_PAREN:
18363 if (expr == NULL)
18364 break;
18365 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value_present
18366 = TRUE;
18367 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value
18368 = ffelex_token_use (ft);
18369 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].u.expr = expr;
18370 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
18371 return (ffelexHandler) ffestb_V0214_;
18372 return (ffelexHandler) ffestb_V0219_;
18373
18374 default:
18375 break;
18376 }
18377
18378 ffestb_subr_kill_delete_ ();
18379 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
18380 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18381}
18382
18383/* ffestb_V0217_ -- "DELETE" OPEN_PAREN ... NAME EQUALS
18384
18385 return ffestb_V0217_; // to lexer
18386
18387 Handle NUMBER for label here. */
18388
18389static ffelexHandler
18390ffestb_V0217_ (ffelexToken t)
18391{
18392 switch (ffelex_token_type (t))
18393 {
18394 case FFELEX_typeNUMBER:
18395 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value_present
18396 = TRUE;
18397 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value
18398 = ffelex_token_use (t);
18399 return (ffelexHandler) ffestb_V0218_;
18400
18401 default:
18402 break;
18403 }
18404
18405 ffestb_subr_kill_delete_ ();
18406 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
18407 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18408}
18409
18410/* ffestb_V0218_ -- "DELETE" OPEN_PAREN ... NAME EQUALS NUMBER
18411
18412 return ffestb_V0218_; // to lexer
18413
18414 Handle COMMA or CLOSE_PAREN here. */
18415
18416static ffelexHandler
18417ffestb_V0218_ (ffelexToken t)
18418{
18419 switch (ffelex_token_type (t))
18420 {
18421 case FFELEX_typeCOMMA:
18422 return (ffelexHandler) ffestb_V0214_;
18423
18424 case FFELEX_typeCLOSE_PAREN:
18425 return (ffelexHandler) ffestb_V0219_;
18426
18427 default:
18428 break;
18429 }
18430
18431 ffestb_subr_kill_delete_ ();
18432 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
18433 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18434}
18435
18436/* ffestb_V0219_ -- "DELETE" OPEN_PAREN ... CLOSE_PAREN
18437
18438 return ffestb_V0219_; // to lexer
18439
18440 Handle EOS or SEMICOLON here. */
18441
18442static ffelexHandler
18443ffestb_V0219_ (ffelexToken t)
18444{
18445 switch (ffelex_token_type (t))
18446 {
18447 case FFELEX_typeEOS:
18448 case FFELEX_typeSEMICOLON:
18449 ffesta_confirmed ();
18450 if (!ffesta_is_inhibited ())
18451 ffestc_V021 ();
18452 ffestb_subr_kill_delete_ ();
18453 return (ffelexHandler) ffesta_zero (t);
18454
18455 default:
18456 break;
18457 }
18458
18459 ffestb_subr_kill_delete_ ();
18460 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
18461 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18462}
18463
18464/* ffestb_V026 -- Parse a FIND statement
18465
18466 return ffestb_V026; // to lexer
18467
18468 Make sure the statement has a valid form for a FIND statement.
18469 If it does, implement the statement. */
18470
18471ffelexHandler
18472ffestb_V026 (ffelexToken t)
18473{
18474 ffestpFindIx ix;
18475
18476 switch (ffelex_token_type (ffesta_tokens[0]))
18477 {
18478 case FFELEX_typeNAME:
18479 if (ffesta_first_kw != FFESTR_firstFIND)
18480 goto bad_0; /* :::::::::::::::::::: */
18481 break;
18482
18483 case FFELEX_typeNAMES:
18484 if (ffesta_first_kw != FFESTR_firstFIND)
18485 goto bad_0; /* :::::::::::::::::::: */
18486 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlFIND)
18487 goto bad_0; /* :::::::::::::::::::: */
18488 break;
18489
18490 default:
18491 goto bad_0; /* :::::::::::::::::::: */
18492 }
18493
18494 switch (ffelex_token_type (t))
18495 {
18496 case FFELEX_typeOPEN_PAREN:
18497 break;
18498
18499 case FFELEX_typeEOS:
18500 case FFELEX_typeSEMICOLON:
18501 case FFELEX_typeCOMMA:
18502 case FFELEX_typeCOLONCOLON:
18503 ffesta_confirmed (); /* Error, but clearly intended. */
18504 goto bad_1; /* :::::::::::::::::::: */
18505
18506 default:
18507 goto bad_1; /* :::::::::::::::::::: */
18508 }
18509
18510 for (ix = 0; ix < FFESTP_findix; ++ix)
18511 ffestp_file.find.find_spec[ix].kw_or_val_present = FALSE;
18512
18513 return (ffelexHandler) ffestb_V0261_;
18514
18515bad_0: /* :::::::::::::::::::: */
18516 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", ffesta_tokens[0]);
18517 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18518
18519bad_1: /* :::::::::::::::::::: */
18520 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
18521 return (ffelexHandler) ffelex_swallow_tokens (t,
18522 (ffelexHandler) ffesta_zero); /* Invalid second token. */
18523}
18524
18525/* ffestb_V0261_ -- "FIND" OPEN_PAREN
18526
18527 return ffestb_V0261_; // to lexer
18528
18529 Handle expr construct (not NAME=expr construct) here. */
18530
18531static ffelexHandler
18532ffestb_V0261_ (ffelexToken t)
18533{
18534 switch (ffelex_token_type (t))
18535 {
18536 case FFELEX_typeNAME:
18537 ffesta_tokens[1] = ffelex_token_use (t);
18538 return (ffelexHandler) ffestb_V0262_;
18539
18540 default:
18541 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
18542 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0263_)))
18543 (t);
18544 }
18545}
18546
18547/* ffestb_V0262_ -- "FIND" OPEN_PAREN NAME
18548
18549 return ffestb_V0262_; // to lexer
18550
18551 If EQUALS here, go to states that handle it. Else, send NAME and this
18552 token thru expression handler. */
18553
18554static ffelexHandler
18555ffestb_V0262_ (ffelexToken t)
18556{
18557 ffelexHandler next;
18558 ffelexToken nt;
18559
18560 switch (ffelex_token_type (t))
18561 {
18562 case FFELEX_typeEQUALS:
18563 nt = ffesta_tokens[1];
18564 next = (ffelexHandler) ffestb_V0264_ (nt);
18565 ffelex_token_kill (nt);
18566 return (ffelexHandler) (*next) (t);
18567
18568 default:
18569 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
18570 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0263_)))
18571 (ffesta_tokens[1]);
18572 ffelex_token_kill (ffesta_tokens[1]);
18573 return (ffelexHandler) (*next) (t);
18574 }
18575}
18576
18577/* ffestb_V0263_ -- "FIND" OPEN_PAREN expr
18578
18579 (ffestb_V0263_) // to expression handler
18580
18581 Handle COMMA or FIND_PAREN here. */
18582
18583static ffelexHandler
18584ffestb_V0263_ (ffelexToken ft, ffebld expr, ffelexToken t)
18585{
18586 switch (ffelex_token_type (t))
18587 {
18588 case FFELEX_typeCOMMA:
18589 case FFELEX_typeCLOSE_PAREN:
18590 if (expr == NULL)
18591 break;
18592 ffestp_file.find.find_spec[FFESTP_findixUNIT].kw_or_val_present
18593 = TRUE;
18594 ffestp_file.find.find_spec[FFESTP_findixUNIT].kw_present = FALSE;
18595 ffestp_file.find.find_spec[FFESTP_findixUNIT].value_present = TRUE;
18596 ffestp_file.find.find_spec[FFESTP_findixUNIT].value_is_label
18597 = FALSE;
18598 ffestp_file.find.find_spec[FFESTP_findixUNIT].value
18599 = ffelex_token_use (ft);
18600 ffestp_file.find.find_spec[FFESTP_findixUNIT].u.expr = expr;
18601 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
18602 return (ffelexHandler) ffestb_V0264_;
18603 return (ffelexHandler) ffestb_V0269_;
18604
18605 default:
18606 break;
18607 }
18608
18609 ffestb_subr_kill_find_ ();
18610 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
18611 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18612}
18613
18614/* ffestb_V0264_ -- "FIND" OPEN_PAREN [external-file-unit COMMA]
18615
18616 return ffestb_V0264_; // to lexer
18617
18618 Handle expr construct (not NAME=expr construct) here. */
18619
18620static ffelexHandler
18621ffestb_V0264_ (ffelexToken t)
18622{
18623 ffestrGenio kw;
18624
18625 ffestb_local_.find.label = FALSE;
18626
18627 switch (ffelex_token_type (t))
18628 {
18629 case FFELEX_typeNAME:
18630 kw = ffestr_genio (t);
18631 switch (kw)
18632 {
18633 case FFESTR_genioERR:
18634 ffestb_local_.find.ix = FFESTP_findixERR;
18635 ffestb_local_.find.label = TRUE;
18636 break;
18637
18638 case FFESTR_genioIOSTAT:
18639 ffestb_local_.find.ix = FFESTP_findixIOSTAT;
18640 ffestb_local_.find.left = TRUE;
18641 ffestb_local_.find.context = FFEEXPR_contextFILEINT;
18642 break;
18643
18644 case FFESTR_genioREC:
18645 ffestb_local_.find.ix = FFESTP_findixREC;
18646 ffestb_local_.find.left = FALSE;
18647 ffestb_local_.find.context = FFEEXPR_contextFILENUM;
18648 break;
18649
18650 case FFESTR_genioUNIT:
18651 ffestb_local_.find.ix = FFESTP_findixUNIT;
18652 ffestb_local_.find.left = FALSE;
18653 ffestb_local_.find.context = FFEEXPR_contextFILENUM;
18654 break;
18655
18656 default:
18657 goto bad; /* :::::::::::::::::::: */
18658 }
18659 if (ffestp_file.find.find_spec[ffestb_local_.find.ix]
18660 .kw_or_val_present)
18661 break; /* Can't specify a keyword twice! */
18662 ffestp_file.find.find_spec[ffestb_local_.find.ix]
18663 .kw_or_val_present = TRUE;
18664 ffestp_file.find.find_spec[ffestb_local_.find.ix]
18665 .kw_present = TRUE;
18666 ffestp_file.find.find_spec[ffestb_local_.find.ix]
18667 .value_present = FALSE;
18668 ffestp_file.find.find_spec[ffestb_local_.find.ix].value_is_label
18669 = ffestb_local_.find.label;
18670 ffestp_file.find.find_spec[ffestb_local_.find.ix].kw
18671 = ffelex_token_use (t);
18672 return (ffelexHandler) ffestb_V0265_;
18673
18674 default:
18675 break;
18676 }
18677
18678bad: /* :::::::::::::::::::: */
18679 ffestb_subr_kill_find_ ();
18680 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
18681 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18682}
18683
18684/* ffestb_V0265_ -- "FIND" OPEN_PAREN [external-file-unit COMMA] NAME
18685
18686 return ffestb_V0265_; // to lexer
18687
18688 Make sure EQUALS here, send next token to expression handler. */
18689
18690static ffelexHandler
18691ffestb_V0265_ (ffelexToken t)
18692{
18693 switch (ffelex_token_type (t))
18694 {
18695 case FFELEX_typeEQUALS:
18696 ffesta_confirmed ();
18697 if (ffestb_local_.find.label)
18698 return (ffelexHandler) ffestb_V0267_;
18699 if (ffestb_local_.find.left)
18700 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
18701 ffestb_local_.find.context,
18702 (ffeexprCallback) ffestb_V0266_);
18703 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
18704 ffestb_local_.find.context,
18705 (ffeexprCallback) ffestb_V0266_);
18706
18707 default:
18708 break;
18709 }
18710
18711 ffestb_subr_kill_find_ ();
18712 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
18713 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18714}
18715
18716/* ffestb_V0266_ -- "FIND" OPEN_PAREN ... NAME EQUALS expr
18717
18718 (ffestb_V0266_) // to expression handler
18719
18720 Handle COMMA or CLOSE_PAREN here. */
18721
18722static ffelexHandler
18723ffestb_V0266_ (ffelexToken ft, ffebld expr, ffelexToken t)
18724{
18725 switch (ffelex_token_type (t))
18726 {
18727 case FFELEX_typeCOMMA:
18728 case FFELEX_typeCLOSE_PAREN:
18729 if (expr == NULL)
18730 break;
18731 ffestp_file.find.find_spec[ffestb_local_.find.ix].value_present
18732 = TRUE;
18733 ffestp_file.find.find_spec[ffestb_local_.find.ix].value
18734 = ffelex_token_use (ft);
18735 ffestp_file.find.find_spec[ffestb_local_.find.ix].u.expr = expr;
18736 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
18737 return (ffelexHandler) ffestb_V0264_;
18738 return (ffelexHandler) ffestb_V0269_;
18739
18740 default:
18741 break;
18742 }
18743
18744 ffestb_subr_kill_find_ ();
18745 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
18746 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18747}
18748
18749/* ffestb_V0267_ -- "FIND" OPEN_PAREN ... NAME EQUALS
18750
18751 return ffestb_V0267_; // to lexer
18752
18753 Handle NUMBER for label here. */
18754
18755static ffelexHandler
18756ffestb_V0267_ (ffelexToken t)
18757{
18758 switch (ffelex_token_type (t))
18759 {
18760 case FFELEX_typeNUMBER:
18761 ffestp_file.find.find_spec[ffestb_local_.find.ix].value_present
18762 = TRUE;
18763 ffestp_file.find.find_spec[ffestb_local_.find.ix].value
18764 = ffelex_token_use (t);
18765 return (ffelexHandler) ffestb_V0268_;
18766
18767 default:
18768 break;
18769 }
18770
18771 ffestb_subr_kill_find_ ();
18772 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
18773 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18774}
18775
18776/* ffestb_V0268_ -- "FIND" OPEN_PAREN ... NAME EQUALS NUMBER
18777
18778 return ffestb_V0268_; // to lexer
18779
18780 Handle COMMA or CLOSE_PAREN here. */
18781
18782static ffelexHandler
18783ffestb_V0268_ (ffelexToken t)
18784{
18785 switch (ffelex_token_type (t))
18786 {
18787 case FFELEX_typeCOMMA:
18788 return (ffelexHandler) ffestb_V0264_;
18789
18790 case FFELEX_typeCLOSE_PAREN:
18791 return (ffelexHandler) ffestb_V0269_;
18792
18793 default:
18794 break;
18795 }
18796
18797 ffestb_subr_kill_find_ ();
18798 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
18799 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18800}
18801
18802/* ffestb_V0269_ -- "FIND" OPEN_PAREN ... CLOSE_PAREN
18803
18804 return ffestb_V0269_; // to lexer
18805
18806 Handle EOS or SEMICOLON here. */
18807
18808static ffelexHandler
18809ffestb_V0269_ (ffelexToken t)
18810{
18811 switch (ffelex_token_type (t))
18812 {
18813 case FFELEX_typeEOS:
18814 case FFELEX_typeSEMICOLON:
18815 ffesta_confirmed ();
18816 if (!ffesta_is_inhibited ())
18817 ffestc_V026 ();
18818 ffestb_subr_kill_find_ ();
18819 return (ffelexHandler) ffesta_zero (t);
18820
18821 default:
18822 break;
18823 }
18824
18825 ffestb_subr_kill_find_ ();
18826 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
18827 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18828}
18829
18830#endif
18831/* ffestb_dimlist -- Parse the ALLOCATABLE/POINTER/TARGET statement
18832
18833 return ffestb_dimlist; // to lexer
18834
18835 Make sure the statement has a valid form for the ALLOCATABLE/POINTER/
18836 TARGET statement. If it does, implement the statement. */
18837
18838#if FFESTR_F90
18839ffelexHandler
18840ffestb_dimlist (ffelexToken t)
18841{
18842 ffeTokenLength i;
18843 char *p;
18844 ffelexToken nt;
18845 ffelexHandler next;
18846
18847 switch (ffelex_token_type (ffesta_tokens[0]))
18848 {
18849 case FFELEX_typeNAME:
18850 switch (ffelex_token_type (t))
18851 {
18852 case FFELEX_typeCOMMA:
18853 case FFELEX_typeEOS:
18854 case FFELEX_typeSEMICOLON:
18855 ffesta_confirmed (); /* Error, but clearly intended. */
18856 goto bad_1; /* :::::::::::::::::::: */
18857
18858 default:
18859 goto bad_1; /* :::::::::::::::::::: */
18860
18861 case FFELEX_typeCOLONCOLON:
18862 ffesta_confirmed ();
18863 if (!ffesta_is_inhibited ())
18864 {
18865 switch (ffesta_first_kw)
18866 {
18867 case FFESTR_firstALLOCATABLE:
18868 ffestc_R525_start ();
18869 break;
18870
18871 case FFESTR_firstPOINTER:
18872 ffestc_R526_start ();
18873 break;
18874
18875 case FFESTR_firstTARGET:
18876 ffestc_R527_start ();
18877 break;
18878
18879 default:
18880 assert (FALSE);
18881 }
18882 }
18883 ffestb_local_.dimlist.started = TRUE;
18884 return (ffelexHandler) ffestb_dimlist1_;
18885
18886 case FFELEX_typeNAME:
18887 ffesta_confirmed ();
18888 if (!ffesta_is_inhibited ())
18889 {
18890 switch (ffesta_first_kw)
18891 {
18892 case FFESTR_firstALLOCATABLE:
18893 ffestc_R525_start ();
18894 break;
18895
18896 case FFESTR_firstPOINTER:
18897 ffestc_R526_start ();
18898 break;
18899
18900 case FFESTR_firstTARGET:
18901 ffestc_R527_start ();
18902 break;
18903
18904 default:
18905 assert (FALSE);
18906 }
18907 }
18908 ffestb_local_.dimlist.started = TRUE;
18909 return (ffelexHandler) ffestb_dimlist1_ (t);
18910 }
18911
18912 case FFELEX_typeNAMES:
18913 p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.dimlist.len);
18914 switch (ffelex_token_type (t))
18915 {
18916 default:
18917 goto bad_1; /* :::::::::::::::::::: */
18918
18919 case FFELEX_typeEOS:
18920 case FFELEX_typeSEMICOLON:
18921 case FFELEX_typeCOMMA:
18922 ffesta_confirmed ();
18923 if (!ffesrc_is_name_init (*p))
18924 goto bad_i; /* :::::::::::::::::::: */
18925 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
18926 if (!ffesta_is_inhibited ())
18927 {
18928 switch (ffesta_first_kw)
18929 {
18930 case FFESTR_firstALLOCATABLE:
18931 ffestc_R525_start ();
18932 break;
18933
18934 case FFESTR_firstPOINTER:
18935 ffestc_R526_start ();
18936 break;
18937
18938 case FFESTR_firstTARGET:
18939 ffestc_R527_start ();
18940 break;
18941
18942 default:
18943 assert (FALSE);
18944 }
18945 }
18946 ffestb_local_.dimlist.started = TRUE;
18947 next = (ffelexHandler) ffestb_dimlist1_ (nt);
18948 ffelex_token_kill (nt);
18949 return (ffelexHandler) (*next) (t);
18950
18951 case FFELEX_typeCOLONCOLON:
18952 ffesta_confirmed ();
18953 if (*p != '\0')
18954 goto bad_i; /* :::::::::::::::::::: */
18955 if (!ffesta_is_inhibited ())
18956 {
18957 switch (ffesta_first_kw)
18958 {
18959 case FFESTR_firstALLOCATABLE:
18960 ffestc_R525_start ();
18961 break;
18962
18963 case FFESTR_firstPOINTER:
18964 ffestc_R526_start ();
18965 break;
18966
18967 case FFESTR_firstTARGET:
18968 ffestc_R527_start ();
18969 break;
18970
18971 default:
18972 assert (FALSE);
18973 }
18974 }
18975 ffestb_local_.dimlist.started = TRUE;
18976 return (ffelexHandler) ffestb_dimlist1_;
18977
18978 case FFELEX_typeOPEN_PAREN:
18979 if (!ffesrc_is_name_init (*p))
18980 goto bad_i; /* :::::::::::::::::::: */
18981 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
18982 ffestb_local_.dimlist.started = FALSE;
18983 next = (ffelexHandler) ffestb_dimlist1_ (nt);
18984 ffelex_token_kill (nt);
18985 return (ffelexHandler) (*next) (t);
18986 }
18987
18988 default:
18989 goto bad_0; /* :::::::::::::::::::: */
18990 }
18991
18992bad_0: /* :::::::::::::::::::: */
18993 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, ffesta_tokens[0]);
18994 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18995
18996bad_1: /* :::::::::::::::::::: */
18997 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
18998 return (ffelexHandler) ffelex_swallow_tokens (t,
18999 (ffelexHandler) ffesta_zero); /* Invalid second token. */
19000
19001bad_i: /* :::::::::::::::::::: */
19002 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, ffesta_tokens[0], i, t);
19003 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19004}
19005
19006/* ffestb_dimlist1_ -- "ALLOCATABLE/POINTER/TARGET" [COLONCOLON]
19007
19008 return ffestb_dimlist1_; // to lexer
19009
19010 Handle NAME. */
19011
19012static ffelexHandler
19013ffestb_dimlist1_ (ffelexToken t)
19014{
19015 switch (ffelex_token_type (t))
19016 {
19017 case FFELEX_typeNAME:
19018 ffesta_tokens[1] = ffelex_token_use (t);
19019 return (ffelexHandler) ffestb_dimlist2_;
19020
19021 default:
19022 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
19023 break;
19024 }
19025
19026 if (!ffesta_is_inhibited ())
19027 {
19028 switch (ffesta_first_kw)
19029 {
19030 case FFESTR_firstALLOCATABLE:
19031 ffestc_R525_finish ();
19032 break;
19033
19034 case FFESTR_firstPOINTER:
19035 ffestc_R526_finish ();
19036 break;
19037
19038 case FFESTR_firstTARGET:
19039 ffestc_R527_finish ();
19040 break;
19041
19042 default:
19043 assert (FALSE);
19044 }
19045 }
19046 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19047}
19048
19049/* ffestb_dimlist2_ -- "ALLOCATABLE/POINTER/TARGET" ... NAME
19050
19051 return ffestb_dimlist2_; // to lexer
19052
19053 Handle OPEN_PAREN. */
19054
19055static ffelexHandler
19056ffestb_dimlist2_ (ffelexToken t)
19057{
19058 switch (ffelex_token_type (t))
19059 {
19060 case FFELEX_typeOPEN_PAREN:
19061 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
19062 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_dimlist3_;
19063 ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
19064 ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLIST;
19065#ifdef FFECOM_dimensionsMAX
19066 ffestb_subrargs_.dim_list.ndims = 0;
19067#endif
19068 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
19069 FFEEXPR_contextDIMLIST, (ffeexprCallback) ffestb_subr_dimlist_);
19070
19071 case FFELEX_typeCOMMA:
19072 ffesta_confirmed ();
19073 if (!ffesta_is_inhibited ())
19074 {
19075 if (!ffestb_local_.dimlist.started)
19076 {
19077 switch (ffesta_first_kw)
19078 {
19079 case FFESTR_firstALLOCATABLE:
19080 ffestc_R525_start ();
19081 break;
19082
19083 case FFESTR_firstPOINTER:
19084 ffestc_R526_start ();
19085 break;
19086
19087 case FFESTR_firstTARGET:
19088 ffestc_R527_start ();
19089 break;
19090
19091 default:
19092 assert (FALSE);
19093 }
19094 ffestb_local_.dimlist.started = TRUE;
19095 }
19096 switch (ffesta_first_kw)
19097 {
19098 case FFESTR_firstALLOCATABLE:
19099 ffestc_R525_item (ffesta_tokens[1], NULL);
19100 break;
19101
19102 case FFESTR_firstPOINTER:
19103 ffestc_R526_item (ffesta_tokens[1], NULL);
19104 break;
19105
19106 case FFESTR_firstTARGET:
19107 ffestc_R527_item (ffesta_tokens[1], NULL);
19108 break;
19109
19110 default:
19111 assert (FALSE);
19112 }
19113 }
19114 ffelex_token_kill (ffesta_tokens[1]);
19115 return (ffelexHandler) ffestb_dimlist4_;
19116
19117 case FFELEX_typeEOS:
19118 case FFELEX_typeSEMICOLON:
19119 ffesta_confirmed ();
19120 if (!ffesta_is_inhibited ())
19121 {
19122 if (!ffestb_local_.dimlist.started)
19123 {
19124 switch (ffesta_first_kw)
19125 {
19126 case FFESTR_firstALLOCATABLE:
19127 ffestc_R525_start ();
19128 break;
19129
19130 case FFESTR_firstPOINTER:
19131 ffestc_R526_start ();
19132 break;
19133
19134 case FFESTR_firstTARGET:
19135 ffestc_R527_start ();
19136 break;
19137
19138 default:
19139 assert (FALSE);
19140 }
19141 }
19142 switch (ffesta_first_kw)
19143 {
19144 case FFESTR_firstALLOCATABLE:
19145 ffestc_R525_item (ffesta_tokens[1], NULL);
19146 ffestc_R525_finish ();
19147 break;
19148
19149 case FFESTR_firstPOINTER:
19150 ffestc_R526_item (ffesta_tokens[1], NULL);
19151 ffestc_R526_finish ();
19152 break;
19153
19154 case FFESTR_firstTARGET:
19155 ffestc_R527_item (ffesta_tokens[1], NULL);
19156 ffestc_R527_finish ();
19157 break;
19158
19159 default:
19160 assert (FALSE);
19161 }
19162 }
19163 ffelex_token_kill (ffesta_tokens[1]);
19164 return (ffelexHandler) ffesta_zero (t);
19165
19166 default:
19167 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
19168 break;
19169 }
19170
19171 if (!ffesta_is_inhibited ())
19172 {
19173 switch (ffesta_first_kw)
19174 {
19175 case FFESTR_firstALLOCATABLE:
19176 ffestc_R525_finish ();
19177 break;
19178
19179 case FFESTR_firstPOINTER:
19180 ffestc_R526_finish ();
19181 break;
19182
19183 case FFESTR_firstTARGET:
19184 ffestc_R527_finish ();
19185 break;
19186
19187 default:
19188 assert (FALSE);
19189 }
19190 }
19191 ffelex_token_kill (ffesta_tokens[1]);
19192 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19193}
19194
19195/* ffestb_dimlist3_ -- "ALLOCATABLE/POINTER/TARGET" ... NAME OPEN_PAREN
19196 dimlist CLOSE_PAREN
19197
19198 return ffestb_dimlist3_; // to lexer
19199
19200 Handle COMMA or EOS/SEMICOLON. */
19201
19202static ffelexHandler
19203ffestb_dimlist3_ (ffelexToken t)
19204{
19205 if (!ffestb_subrargs_.dim_list.ok)
19206 goto bad; /* :::::::::::::::::::: */
19207
19208 switch (ffelex_token_type (t))
19209 {
19210 case FFELEX_typeCOMMA:
19211 ffesta_confirmed ();
19212 if (!ffesta_is_inhibited ())
19213 {
19214 if (!ffestb_local_.dimlist.started)
19215 {
19216 switch (ffesta_first_kw)
19217 {
19218 case FFESTR_firstALLOCATABLE:
19219 ffestc_R525_start ();
19220 break;
19221
19222 case FFESTR_firstPOINTER:
19223 ffestc_R526_start ();
19224 break;
19225
19226 case FFESTR_firstTARGET:
19227 ffestc_R527_start ();
19228 break;
19229
19230 default:
19231 assert (FALSE);
19232 }
19233 ffestb_local_.dimlist.started = TRUE;
19234 }
19235 switch (ffesta_first_kw)
19236 {
19237 case FFESTR_firstALLOCATABLE:
19238 ffestc_R525_item (ffesta_tokens[1],
19239 ffestb_subrargs_.dim_list.dims);
19240 break;
19241
19242 case FFESTR_firstPOINTER:
19243 ffestc_R526_item (ffesta_tokens[1],
19244 ffestb_subrargs_.dim_list.dims);
19245 break;
19246
19247 case FFESTR_firstTARGET:
19248 ffestc_R527_item (ffesta_tokens[1],
19249 ffestb_subrargs_.dim_list.dims);
19250 break;
19251
19252 default:
19253 assert (FALSE);
19254 }
19255 }
19256 ffelex_token_kill (ffesta_tokens[1]);
19257 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
19258 return (ffelexHandler) ffestb_dimlist4_;
19259
19260 case FFELEX_typeEOS:
19261 case FFELEX_typeSEMICOLON:
19262 ffesta_confirmed ();
19263 if (!ffesta_is_inhibited ())
19264 {
19265 if (!ffestb_local_.dimlist.started)
19266 {
19267 switch (ffesta_first_kw)
19268 {
19269 case FFESTR_firstALLOCATABLE:
19270 ffestc_R525_start ();
19271 break;
19272
19273 case FFESTR_firstPOINTER:
19274 ffestc_R526_start ();
19275 break;
19276
19277 case FFESTR_firstTARGET:
19278 ffestc_R527_start ();
19279 break;
19280
19281 default:
19282 assert (FALSE);
19283 }
19284 }
19285 switch (ffesta_first_kw)
19286 {
19287 case FFESTR_firstALLOCATABLE:
19288 ffestc_R525_item (ffesta_tokens[1],
19289 ffestb_subrargs_.dim_list.dims);
19290 ffestc_R525_finish ();
19291 break;
19292
19293 case FFESTR_firstPOINTER:
19294 ffestc_R526_item (ffesta_tokens[1],
19295 ffestb_subrargs_.dim_list.dims);
19296 ffestc_R526_finish ();
19297 break;
19298
19299 case FFESTR_firstTARGET:
19300 ffestc_R527_item (ffesta_tokens[1],
19301 ffestb_subrargs_.dim_list.dims);
19302 ffestc_R527_finish ();
19303 break;
19304
19305 default:
19306 assert (FALSE);
19307 }
19308 }
19309 ffelex_token_kill (ffesta_tokens[1]);
19310 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
19311 return (ffelexHandler) ffesta_zero (t);
19312
19313 default:
19314 break;
19315 }
19316
19317bad: /* :::::::::::::::::::: */
19318 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
19319 if (ffestb_local_.dimlist.started && !ffesta_is_inhibited ())
19320 {
19321 switch (ffesta_first_kw)
19322 {
19323 case FFESTR_firstALLOCATABLE:
19324 ffestc_R525_finish ();
19325 break;
19326
19327 case FFESTR_firstPOINTER:
19328 ffestc_R526_finish ();
19329 break;
19330
19331 case FFESTR_firstTARGET:
19332 ffestc_R527_finish ();
19333 break;
19334
19335 default:
19336 assert (FALSE);
19337 }
19338 }
19339 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
19340 ffelex_token_kill (ffesta_tokens[1]);
19341 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19342}
19343
19344/* ffestb_dimlist4_ -- "ALLOCATABLE/POINTER/TARGET" ... COMMA
19345
19346 return ffestb_dimlist4_; // to lexer
19347
19348 Make sure we don't have EOS or SEMICOLON. */
19349
19350static ffelexHandler
19351ffestb_dimlist4_ (ffelexToken t)
19352{
19353 switch (ffelex_token_type (t))
19354 {
19355 case FFELEX_typeEOS:
19356 case FFELEX_typeSEMICOLON:
19357 if (!ffesta_is_inhibited ())
19358 {
19359 switch (ffesta_first_kw)
19360 {
19361 case FFESTR_firstALLOCATABLE:
19362 ffestc_R525_finish ();
19363 break;
19364
19365 case FFESTR_firstPOINTER:
19366 ffestc_R526_finish ();
19367 break;
19368
19369 case FFESTR_firstTARGET:
19370 ffestc_R527_finish ();
19371 break;
19372
19373 default:
19374 assert (FALSE);
19375 }
19376 }
19377 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
19378 return (ffelexHandler) ffesta_zero (t);
19379
19380 default:
19381 return (ffelexHandler) ffestb_dimlist1_ (t);
19382 }
19383}
19384
19385#endif
19386/* ffestb_dummy -- Parse an ENTRY/FUNCTION/SUBROUTINE statement
19387
19388 return ffestb_dummy; // to lexer
19389
19390 Make sure the statement has a valid form for an ENTRY/FUNCTION/SUBROUTINE
19391 statement. If it does, implement the statement. */
19392
19393ffelexHandler
19394ffestb_dummy (ffelexToken t)
19395{
19396 ffeTokenLength i;
19397 char *p;
19398
19399 switch (ffelex_token_type (ffesta_tokens[0]))
19400 {
19401 case FFELEX_typeNAME:
19402 switch (ffelex_token_type (t))
19403 {
19404 case FFELEX_typeEOS:
19405 case FFELEX_typeSEMICOLON:
19406 case FFELEX_typeCOMMA:
19407 case FFELEX_typeCOLONCOLON:
19408 ffesta_confirmed (); /* Error, but clearly intended. */
19409 goto bad_1; /* :::::::::::::::::::: */
19410
19411 default:
19412 goto bad_1; /* :::::::::::::::::::: */
19413
19414 case FFELEX_typeNAME:
19415 break;
19416 }
19417
19418 ffesta_confirmed ();
19419 ffesta_tokens[1] = ffelex_token_use (t);
19420 ffestb_local_.decl.recursive = NULL;
19421 ffestb_local_.dummy.badname = ffestb_args.dummy.badname;
19422 ffestb_local_.dummy.is_subr = ffestb_args.dummy.is_subr;
19423 ffestb_local_.dummy.first_kw = ffesta_first_kw;
19424 return (ffelexHandler) ffestb_dummy1_;
19425
19426 case FFELEX_typeNAMES:
19427 switch (ffelex_token_type (t))
19428 {
19429 case FFELEX_typeCOMMA:
19430 case FFELEX_typeCOLONCOLON:
19431 ffesta_confirmed (); /* Error, but clearly intended. */
19432 goto bad_1; /* :::::::::::::::::::: */
19433
19434 default:
19435 goto bad_1; /* :::::::::::::::::::: */
19436
19437 case FFELEX_typeEOS:
19438 case FFELEX_typeSEMICOLON:
19439 ffesta_confirmed ();
19440 break;
19441
19442 case FFELEX_typeOPEN_PAREN:
19443 break;
19444 }
19445 p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.dummy.len);
19446 if (!ffesrc_is_name_init (*p))
19447 goto bad_i; /* :::::::::::::::::::: */
19448 ffesta_tokens[1]
19449 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
19450 ffestb_local_.decl.recursive = NULL;
19451 ffestb_local_.dummy.badname = ffestb_args.dummy.badname;
19452 ffestb_local_.dummy.is_subr = ffestb_args.dummy.is_subr;
19453 ffestb_local_.dummy.first_kw = ffesta_first_kw;
19454 return (ffelexHandler) ffestb_dummy1_ (t);
19455
19456 default:
19457 goto bad_0; /* :::::::::::::::::::: */
19458 }
19459
19460bad_0: /* :::::::::::::::::::: */
19461 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dummy.badname, ffesta_tokens[0]);
19462 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19463
19464bad_1: /* :::::::::::::::::::: */
19465 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dummy.badname, t);
19466 return (ffelexHandler) ffelex_swallow_tokens (t,
19467 (ffelexHandler) ffesta_zero); /* Invalid second token. */
19468
19469bad_i: /* :::::::::::::::::::: */
19470 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.dummy.badname, ffesta_tokens[0], i, t);
19471 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19472}
19473
19474/* ffestb_dummy1_ -- "ENTRY/FUNCTION/SUBROUTINE" NAME
19475
19476 return ffestb_dummy1_; // to lexer
19477
19478 Make sure the next token is an EOS, SEMICOLON, or OPEN_PAREN. In the
19479 former case, just implement a null arg list, else get the arg list and
19480 then implement. */
19481
19482static ffelexHandler
19483ffestb_dummy1_ (ffelexToken t)
19484{
19485 switch (ffelex_token_type (t))
19486 {
19487 case FFELEX_typeEOS:
19488 case FFELEX_typeSEMICOLON:
19489 if (ffestb_local_.dummy.first_kw == FFESTR_firstFUNCTION)
19490 {
19491 ffesta_confirmed (); /* Later, not if typename w/o RECURSIVE. */
19492 break; /* Produce an error message, need that open
19493 paren. */
19494 }
19495 ffesta_confirmed ();
19496 if (!ffesta_is_inhibited ())
19497 { /* Pretend as though we got a truly NULL
19498 list. */
19499 ffestb_subrargs_.name_list.args = NULL;
19500 ffestb_subrargs_.name_list.ok = TRUE;
19501 ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
19502 return (ffelexHandler) ffestb_dummy2_ (t);
19503 }
19504 if (ffestb_local_.decl.recursive != NULL)
19505 ffelex_token_kill (ffestb_local_.decl.recursive);
19506 ffelex_token_kill (ffesta_tokens[1]);
19507 return (ffelexHandler) ffesta_zero (t);
19508
19509 case FFELEX_typeOPEN_PAREN:
19510 ffestb_subrargs_.name_list.args = ffestt_tokenlist_create ();
19511 ffestb_subrargs_.name_list.handler = (ffelexHandler) ffestb_dummy2_;
19512 ffestb_subrargs_.name_list.is_subr = ffestb_local_.dummy.is_subr;
19513 ffestb_subrargs_.name_list.names = FALSE;
19514 return (ffelexHandler) ffestb_subr_name_list_;
19515
19516 default:
19517 break;
19518 }
19519
19520 if (ffestb_local_.decl.recursive != NULL)
19521 ffelex_token_kill (ffestb_local_.decl.recursive);
19522 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_local_.dummy.badname, t);
19523 ffelex_token_kill (ffesta_tokens[1]);
19524 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19525}
19526
19527/* ffestb_dummy2_ -- <dummy-keyword> NAME OPEN_PAREN arg-list CLOSE_PAREN
19528
19529 return ffestb_dummy2_; // to lexer
19530
19531 Make sure the statement has a valid form for a dummy-def statement. If it
19532 does, implement the statement. */
19533
19534static ffelexHandler
19535ffestb_dummy2_ (ffelexToken t)
19536{
19537 if (!ffestb_subrargs_.name_list.ok)
19538 goto bad; /* :::::::::::::::::::: */
19539
19540 switch (ffelex_token_type (t))
19541 {
19542 case FFELEX_typeEOS:
19543 case FFELEX_typeSEMICOLON:
19544 ffesta_confirmed ();
19545 if (!ffesta_is_inhibited ())
19546 {
19547 switch (ffestb_local_.dummy.first_kw)
19548 {
19549 case FFESTR_firstFUNCTION:
19550 ffestc_R1219 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
19551 ffestb_subrargs_.name_list.close_paren, FFESTP_typeNone,
19552 NULL, NULL, NULL, NULL, ffestb_local_.decl.recursive, NULL);
19553 break;
19554
19555 case FFESTR_firstSUBROUTINE:
19556 ffestc_R1223 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
19557 ffestb_subrargs_.name_list.close_paren,
19558 ffestb_local_.decl.recursive);
19559 break;
19560
19561 case FFESTR_firstENTRY:
19562 ffestc_R1226 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
19563 ffestb_subrargs_.name_list.close_paren);
19564 break;
19565
19566 default:
19567 assert (FALSE);
19568 }
19569 }
19570 ffelex_token_kill (ffesta_tokens[1]);
19571 if (ffestb_local_.decl.recursive != NULL)
19572 ffelex_token_kill (ffestb_local_.decl.recursive);
19573 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
19574 if (ffestb_subrargs_.name_list.args != NULL)
19575 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
19576 return (ffelexHandler) ffesta_zero (t);
19577
19578 case FFELEX_typeNAME:
19579 ffesta_confirmed ();
19580 if ((ffestb_local_.dummy.first_kw != FFESTR_firstFUNCTION)
19581 || (ffestr_other (t) != FFESTR_otherRESULT))
19582 break;
19583 ffestb_local_.decl.type = FFESTP_typeNone;
19584 ffestb_local_.decl.kind = NULL;
19585 ffestb_local_.decl.kindt = NULL;
19586 ffestb_local_.decl.len = NULL;
19587 ffestb_local_.decl.lent = NULL;
19588 return (ffelexHandler) ffestb_decl_funcname_6_;
19589
19590 default:
19591 break;
19592 }
19593
19594bad: /* :::::::::::::::::::: */
19595 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_local_.dummy.badname, t);
19596 ffelex_token_kill (ffesta_tokens[1]);
19597 if (ffestb_local_.decl.recursive != NULL)
19598 ffelex_token_kill (ffestb_local_.decl.recursive);
19599 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
19600 if (ffestb_subrargs_.name_list.args != NULL)
19601 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
19602 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19603}
19604
19605/* ffestb_R524 -- Parse the DIMENSION statement
19606
19607 return ffestb_R524; // to lexer
19608
19609 Make sure the statement has a valid form for the DIMENSION statement. If
19610 it does, implement the statement. */
19611
19612ffelexHandler
19613ffestb_R524 (ffelexToken t)
19614{
19615 ffeTokenLength i;
19616 char *p;
19617 ffelexToken nt;
19618 ffelexHandler next;
19619
19620 switch (ffelex_token_type (ffesta_tokens[0]))
19621 {
19622 case FFELEX_typeNAME:
19623 switch (ffelex_token_type (t))
19624 {
19625 case FFELEX_typeCOMMA:
19626 case FFELEX_typeCOLONCOLON:
19627 case FFELEX_typeEOS:
19628 case FFELEX_typeSEMICOLON:
19629 ffesta_confirmed (); /* Error, but clearly intended. */
19630 goto bad_1; /* :::::::::::::::::::: */
19631
19632 default:
19633 goto bad_1; /* :::::::::::::::::::: */
19634
19635 case FFELEX_typeNAME:
19636 ffesta_confirmed ();
19637 if (!ffesta_is_inhibited ())
19638 ffestc_R524_start (ffesta_first_kw == FFESTR_firstVIRTUAL);
19639 ffestb_local_.dimension.started = TRUE;
19640 return (ffelexHandler) ffestb_R5241_ (t);
19641 }
19642
19643 case FFELEX_typeNAMES:
19644 p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.R524.len);
19645 switch (ffelex_token_type (t))
19646 {
19647 default:
19648 goto bad_1; /* :::::::::::::::::::: */
19649
19650 case FFELEX_typeEOS:
19651 case FFELEX_typeSEMICOLON:
19652 case FFELEX_typeCOMMA:
19653 case FFELEX_typeCOLONCOLON:
19654 ffesta_confirmed ();
19655 goto bad_1; /* :::::::::::::::::::: */
19656
19657 case FFELEX_typeOPEN_PAREN:
19658 break;
19659 }
19660
19661 /* Here, we have at least one char after "DIMENSION" and t is
19662 OPEN_PAREN. */
19663
19664 if (!ffesrc_is_name_init (*p))
19665 goto bad_i; /* :::::::::::::::::::: */
19666 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
19667 ffestb_local_.dimension.started = FALSE;
19668 next = (ffelexHandler) ffestb_R5241_ (nt);
19669 ffelex_token_kill (nt);
19670 return (ffelexHandler) (*next) (t);
19671
19672 default:
19673 goto bad_0; /* :::::::::::::::::::: */
19674 }
19675
19676bad_0: /* :::::::::::::::::::: */
19677 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, ffesta_tokens[0]);
19678 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19679
19680bad_1: /* :::::::::::::::::::: */
19681 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
19682 return (ffelexHandler) ffelex_swallow_tokens (t,
19683 (ffelexHandler) ffesta_zero); /* Invalid second token. */
19684
19685bad_i: /* :::::::::::::::::::: */
19686 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, ffesta_tokens[0], i, t);
19687 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19688}
19689
19690/* ffestb_R5241_ -- "DIMENSION"
19691
19692 return ffestb_R5241_; // to lexer
19693
19694 Handle NAME. */
19695
19696static ffelexHandler
19697ffestb_R5241_ (ffelexToken t)
19698{
19699 switch (ffelex_token_type (t))
19700 {
19701 case FFELEX_typeNAME:
19702 ffesta_tokens[1] = ffelex_token_use (t);
19703 return (ffelexHandler) ffestb_R5242_;
19704
19705 default:
19706 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
19707 break;
19708 }
19709
19710 if (!ffesta_is_inhibited ())
19711 ffestc_R524_finish ();
19712 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19713}
19714
19715/* ffestb_R5242_ -- "DIMENSION" ... NAME
19716
19717 return ffestb_R5242_; // to lexer
19718
19719 Handle OPEN_PAREN. */
19720
19721static ffelexHandler
19722ffestb_R5242_ (ffelexToken t)
19723{
19724 switch (ffelex_token_type (t))
19725 {
19726 case FFELEX_typeOPEN_PAREN:
19727 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
19728 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_R5243_;
19729 ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
19730 ffestb_subrargs_.dim_list.ctx = ffesta_is_entry_valid
19731 ? FFEEXPR_contextDIMLIST : FFEEXPR_contextDIMLISTCOMMON;
19732#ifdef FFECOM_dimensionsMAX
19733 ffestb_subrargs_.dim_list.ndims = 0;
19734#endif
19735 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
19736 ffestb_subrargs_.dim_list.ctx,
19737 (ffeexprCallback) ffestb_subr_dimlist_);
19738
19739 default:
19740 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
19741 break;
19742 }
19743
19744 if (!ffesta_is_inhibited ())
19745 ffestc_R524_finish ();
19746 ffelex_token_kill (ffesta_tokens[1]);
19747 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19748}
19749
19750/* ffestb_R5243_ -- "DIMENSION" ... NAME OPEN_PAREN dimlist CLOSE_PAREN
19751
19752 return ffestb_R5243_; // to lexer
19753
19754 Handle COMMA or EOS/SEMICOLON. */
19755
19756static ffelexHandler
19757ffestb_R5243_ (ffelexToken t)
19758{
19759 if (!ffestb_subrargs_.dim_list.ok)
19760 goto bad; /* :::::::::::::::::::: */
19761
19762 switch (ffelex_token_type (t))
19763 {
19764 case FFELEX_typeCOMMA:
19765 ffesta_confirmed ();
19766 if (!ffesta_is_inhibited ())
19767 {
19768 if (!ffestb_local_.dimension.started)
19769 {
19770 ffestc_R524_start (ffesta_first_kw == FFESTR_firstVIRTUAL);
19771 ffestb_local_.dimension.started = TRUE;
19772 }
19773 ffestc_R524_item (ffesta_tokens[1],
19774 ffestb_subrargs_.dim_list.dims);
19775 }
19776 ffelex_token_kill (ffesta_tokens[1]);
19777 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
19778 return (ffelexHandler) ffestb_R5244_;
19779
19780 case FFELEX_typeEOS:
19781 case FFELEX_typeSEMICOLON:
19782 ffesta_confirmed ();
19783 if (!ffesta_is_inhibited ())
19784 {
19785 if (!ffestb_local_.dimension.started)
19786 {
19787 ffestc_R524_start (ffesta_first_kw == FFESTR_firstVIRTUAL);
19788 ffestb_local_.dimension.started = TRUE;
19789 }
19790 ffestc_R524_item (ffesta_tokens[1],
19791 ffestb_subrargs_.dim_list.dims);
19792 ffestc_R524_finish ();
19793 }
19794 ffelex_token_kill (ffesta_tokens[1]);
19795 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
19796 return (ffelexHandler) ffesta_zero (t);
19797
19798 default:
19799 break;
19800 }
19801
19802bad: /* :::::::::::::::::::: */
19803 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
19804 if (ffestb_local_.dimension.started && !ffesta_is_inhibited ())
19805 ffestc_R524_finish ();
19806 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
19807 ffelex_token_kill (ffesta_tokens[1]);
19808 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19809}
19810
19811/* ffestb_R5244_ -- "DIMENSION" ... COMMA
19812
19813 return ffestb_R5244_; // to lexer
19814
19815 Make sure we don't have EOS or SEMICOLON. */
19816
19817static ffelexHandler
19818ffestb_R5244_ (ffelexToken t)
19819{
19820 switch (ffelex_token_type (t))
19821 {
19822 case FFELEX_typeEOS:
19823 case FFELEX_typeSEMICOLON:
19824 if (!ffesta_is_inhibited ())
19825 ffestc_R524_finish ();
19826 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
19827 return (ffelexHandler) ffesta_zero (t);
19828
19829 default:
19830 return (ffelexHandler) ffestb_R5241_ (t);
19831 }
19832}
19833
19834/* ffestb_R547 -- Parse the COMMON statement
19835
19836 return ffestb_R547; // to lexer
19837
19838 Make sure the statement has a valid form for the COMMON statement. If it
19839 does, implement the statement. */
19840
19841ffelexHandler
19842ffestb_R547 (ffelexToken t)
19843{
19844 ffeTokenLength i;
19845 char *p;
19846 ffelexToken nt;
19847 ffelexHandler next;
19848
19849 switch (ffelex_token_type (ffesta_tokens[0]))
19850 {
19851 case FFELEX_typeNAME:
19852 if (ffesta_first_kw != FFESTR_firstCOMMON)
19853 goto bad_0; /* :::::::::::::::::::: */
19854 switch (ffelex_token_type (t))
19855 {
19856 case FFELEX_typeCOMMA:
19857 case FFELEX_typeCOLONCOLON:
19858 case FFELEX_typeEOS:
19859 case FFELEX_typeSEMICOLON:
19860 ffesta_confirmed (); /* Error, but clearly intended. */
19861 goto bad_1; /* :::::::::::::::::::: */
19862
19863 default:
19864 goto bad_1; /* :::::::::::::::::::: */
19865
19866 case FFELEX_typeNAME:
19867 case FFELEX_typeSLASH:
19868 case FFELEX_typeCONCAT:
19869 ffesta_confirmed ();
19870 if (!ffesta_is_inhibited ())
19871 ffestc_R547_start ();
19872 ffestb_local_.common.started = TRUE;
19873 return (ffelexHandler) ffestb_R5471_ (t);
19874 }
19875
19876 case FFELEX_typeNAMES:
19877 if (ffesta_first_kw != FFESTR_firstCOMMON)
19878 goto bad_0; /* :::::::::::::::::::: */
19879 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCOMMON);
19880 switch (ffelex_token_type (t))
19881 {
19882 default:
19883 goto bad_1; /* :::::::::::::::::::: */
19884
19885 case FFELEX_typeEOS:
19886 case FFELEX_typeSEMICOLON:
19887 case FFELEX_typeCOMMA:
19888 case FFELEX_typeCOLONCOLON:
19889 ffesta_confirmed ();
19890 break;
19891
19892 case FFELEX_typeSLASH:
19893 case FFELEX_typeCONCAT:
19894 ffesta_confirmed ();
19895 if (*p != '\0')
19896 break;
19897 if (!ffesta_is_inhibited ())
19898 ffestc_R547_start ();
19899 ffestb_local_.common.started = TRUE;
19900 return (ffelexHandler) ffestb_R5471_ (t);
19901
19902 case FFELEX_typeOPEN_PAREN:
19903 break;
19904 }
19905
19906 /* Here, we have at least one char after "COMMON" and t is COMMA,
19907 EOS/SEMICOLON, OPEN_PAREN, SLASH, or CONCAT. */
19908
19909 if (!ffesrc_is_name_init (*p))
19910 goto bad_i; /* :::::::::::::::::::: */
19911 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
19912 if (ffelex_token_type (t) == FFELEX_typeOPEN_PAREN)
19913 ffestb_local_.common.started = FALSE;
19914 else
19915 {
19916 if (!ffesta_is_inhibited ())
19917 ffestc_R547_start ();
19918 ffestb_local_.common.started = TRUE;
19919 }
19920 next = (ffelexHandler) ffestb_R5471_ (nt);
19921 ffelex_token_kill (nt);
19922 return (ffelexHandler) (*next) (t);
19923
19924 default:
19925 goto bad_0; /* :::::::::::::::::::: */
19926 }
19927
19928bad_0: /* :::::::::::::::::::: */
19929 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", ffesta_tokens[0]);
19930 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19931
19932bad_1: /* :::::::::::::::::::: */
19933 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
19934 return (ffelexHandler) ffelex_swallow_tokens (t,
19935 (ffelexHandler) ffesta_zero); /* Invalid second token. */
19936
19937bad_i: /* :::::::::::::::::::: */
19938 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "COMMON", ffesta_tokens[0], i, t);
19939 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19940}
19941
19942/* ffestb_R5471_ -- "COMMON"
19943
19944 return ffestb_R5471_; // to lexer
19945
19946 Handle NAME, SLASH, or CONCAT. */
19947
19948static ffelexHandler
19949ffestb_R5471_ (ffelexToken t)
19950{
19951 switch (ffelex_token_type (t))
19952 {
19953 case FFELEX_typeNAME:
19954 return (ffelexHandler) ffestb_R5474_ (t);
19955
19956 case FFELEX_typeSLASH:
19957 return (ffelexHandler) ffestb_R5472_;
19958
19959 case FFELEX_typeCONCAT:
19960 if (!ffesta_is_inhibited ())
19961 ffestc_R547_item_cblock (NULL);
19962 return (ffelexHandler) ffestb_R5474_;
19963
19964 default:
19965 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
19966 break;
19967 }
19968
19969 if (!ffesta_is_inhibited ())
19970 ffestc_R547_finish ();
19971 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19972}
19973
19974/* ffestb_R5472_ -- "COMMON" SLASH
19975
19976 return ffestb_R5472_; // to lexer
19977
19978 Handle NAME. */
19979
19980static ffelexHandler
19981ffestb_R5472_ (ffelexToken t)
19982{
19983 switch (ffelex_token_type (t))
19984 {
19985 case FFELEX_typeNAME:
19986 ffesta_tokens[1] = ffelex_token_use (t);
19987 return (ffelexHandler) ffestb_R5473_;
19988
19989 case FFELEX_typeSLASH:
19990 if (!ffesta_is_inhibited ())
19991 ffestc_R547_item_cblock (NULL);
19992 return (ffelexHandler) ffestb_R5474_;
19993
19994 default:
19995 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
19996 break;
19997 }
19998
19999 if (!ffesta_is_inhibited ())
20000 ffestc_R547_finish ();
20001 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20002}
20003
20004/* ffestb_R5473_ -- "COMMON" SLASH NAME
20005
20006 return ffestb_R5473_; // to lexer
20007
20008 Handle SLASH. */
20009
20010static ffelexHandler
20011ffestb_R5473_ (ffelexToken t)
20012{
20013 switch (ffelex_token_type (t))
20014 {
20015 case FFELEX_typeSLASH:
20016 if (!ffesta_is_inhibited ())
20017 ffestc_R547_item_cblock (ffesta_tokens[1]);
20018 ffelex_token_kill (ffesta_tokens[1]);
20019 return (ffelexHandler) ffestb_R5474_;
20020
20021 default:
20022 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
20023 break;
20024 }
20025
20026 if (!ffesta_is_inhibited ())
20027 ffestc_R547_finish ();
20028 ffelex_token_kill (ffesta_tokens[1]);
20029 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20030}
20031
20032/* ffestb_R5474_ -- "COMMON" [SLASH NAME SLASH] or "COMMON" CONCAT
20033
20034 return ffestb_R5474_; // to lexer
20035
20036 Handle NAME. */
20037
20038static ffelexHandler
20039ffestb_R5474_ (ffelexToken t)
20040{
20041 switch (ffelex_token_type (t))
20042 {
20043 case FFELEX_typeNAME:
20044 ffesta_tokens[1] = ffelex_token_use (t);
20045 return (ffelexHandler) ffestb_R5475_;
20046
20047 default:
20048 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
20049 break;
20050 }
20051
20052 if (!ffesta_is_inhibited ())
20053 ffestc_R547_finish ();
20054 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20055}
20056
20057/* ffestb_R5475_ -- "COMMON" ... NAME
20058
20059 return ffestb_R5475_; // to lexer
20060
20061 Handle OPEN_PAREN. */
20062
20063static ffelexHandler
20064ffestb_R5475_ (ffelexToken t)
20065{
20066 switch (ffelex_token_type (t))
20067 {
20068 case FFELEX_typeOPEN_PAREN:
20069 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
20070 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_R5476_;
20071 ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
20072 ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLISTCOMMON;
20073#ifdef FFECOM_dimensionsMAX
20074 ffestb_subrargs_.dim_list.ndims = 0;
20075#endif
20076 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
20077 FFEEXPR_contextDIMLISTCOMMON, (ffeexprCallback) ffestb_subr_dimlist_);
20078
20079 case FFELEX_typeCOMMA:
20080 if (!ffesta_is_inhibited ())
20081 ffestc_R547_item_object (ffesta_tokens[1], NULL);
20082 ffelex_token_kill (ffesta_tokens[1]);
20083 return (ffelexHandler) ffestb_R5477_;
20084
20085 case FFELEX_typeSLASH:
20086 case FFELEX_typeCONCAT:
20087 if (!ffesta_is_inhibited ())
20088 ffestc_R547_item_object (ffesta_tokens[1], NULL);
20089 ffelex_token_kill (ffesta_tokens[1]);
20090 return (ffelexHandler) ffestb_R5471_ (t);
20091
20092 case FFELEX_typeEOS:
20093 case FFELEX_typeSEMICOLON:
20094 if (!ffesta_is_inhibited ())
20095 {
20096 ffestc_R547_item_object (ffesta_tokens[1], NULL);
20097 ffestc_R547_finish ();
20098 }
20099 ffelex_token_kill (ffesta_tokens[1]);
20100 return (ffelexHandler) ffesta_zero (t);
20101
20102 default:
20103 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
20104 break;
20105 }
20106
20107 if (!ffesta_is_inhibited ())
20108 ffestc_R547_finish ();
20109 ffelex_token_kill (ffesta_tokens[1]);
20110 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20111}
20112
20113/* ffestb_R5476_ -- "COMMON" ... NAME OPEN_PAREN dimlist CLOSE_PAREN
20114
20115 return ffestb_R5476_; // to lexer
20116
20117 Handle COMMA, SLASH, CONCAT, EOS/SEMICOLON. */
20118
20119static ffelexHandler
20120ffestb_R5476_ (ffelexToken t)
20121{
20122 if (!ffestb_subrargs_.dim_list.ok)
20123 goto bad; /* :::::::::::::::::::: */
20124
20125 switch (ffelex_token_type (t))
20126 {
20127 case FFELEX_typeCOMMA:
20128 ffesta_confirmed ();
20129 if (!ffesta_is_inhibited ())
20130 {
20131 if (!ffestb_local_.common.started)
20132 {
20133 ffestc_R547_start ();
20134 ffestb_local_.common.started = TRUE;
20135 }
20136 ffestc_R547_item_object (ffesta_tokens[1],
20137 ffestb_subrargs_.dim_list.dims);
20138 }
20139 ffelex_token_kill (ffesta_tokens[1]);
20140 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
20141 return (ffelexHandler) ffestb_R5477_;
20142
20143 case FFELEX_typeSLASH:
20144 case FFELEX_typeCONCAT:
20145 ffesta_confirmed ();
20146 if (!ffesta_is_inhibited ())
20147 {
20148 if (!ffestb_local_.common.started)
20149 {
20150 ffestc_R547_start ();
20151 ffestb_local_.common.started = TRUE;
20152 }
20153 ffestc_R547_item_object (ffesta_tokens[1],
20154 ffestb_subrargs_.dim_list.dims);
20155 }
20156 ffelex_token_kill (ffesta_tokens[1]);
20157 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
20158 return (ffelexHandler) ffestb_R5471_ (t);
20159
20160 case FFELEX_typeEOS:
20161 case FFELEX_typeSEMICOLON:
20162 ffesta_confirmed ();
20163 if (!ffesta_is_inhibited ())
20164 {
20165 if (!ffestb_local_.common.started)
20166 ffestc_R547_start ();
20167 ffestc_R547_item_object (ffesta_tokens[1],
20168 ffestb_subrargs_.dim_list.dims);
20169 ffestc_R547_finish ();
20170 }
20171 ffelex_token_kill (ffesta_tokens[1]);
20172 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
20173 return (ffelexHandler) ffesta_zero (t);
20174
20175 default:
20176 break;
20177 }
20178
20179bad: /* :::::::::::::::::::: */
20180 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
20181 if (ffestb_local_.common.started && !ffesta_is_inhibited ())
20182 ffestc_R547_finish ();
20183 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
20184 ffelex_token_kill (ffesta_tokens[1]);
20185 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20186}
20187
20188/* ffestb_R5477_ -- "COMMON" ... COMMA
20189
20190 return ffestb_R5477_; // to lexer
20191
20192 Make sure we don't have EOS or SEMICOLON. */
20193
20194static ffelexHandler
20195ffestb_R5477_ (ffelexToken t)
20196{
20197 switch (ffelex_token_type (t))
20198 {
20199 case FFELEX_typeEOS:
20200 case FFELEX_typeSEMICOLON:
20201 if (!ffesta_is_inhibited ())
20202 ffestc_R547_finish ();
20203 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
20204 return (ffelexHandler) ffesta_zero (t);
20205
20206 default:
20207 return (ffelexHandler) ffestb_R5471_ (t);
20208 }
20209}
20210
20211/* ffestb_R624 -- Parse a NULLIFY statement
20212
20213 return ffestb_R624; // to lexer
20214
20215 Make sure the statement has a valid form for a NULLIFY
20216 statement. If it does, implement the statement.
20217
20218 31-May-90 JCB 2.0
20219 Rewrite to produce a list of expressions rather than just names; this
20220 eases semantic checking, putting it in expression handling where that
20221 kind of thing gets done anyway, and makes it easier to support more
20222 flexible extensions to Fortran 90 like NULLIFY(FOO%BAR). */
20223
20224#if FFESTR_F90
20225ffelexHandler
20226ffestb_R624 (ffelexToken t)
20227{
20228 switch (ffelex_token_type (ffesta_tokens[0]))
20229 {
20230 case FFELEX_typeNAME:
20231 if (ffesta_first_kw != FFESTR_firstNULLIFY)
20232 goto bad_0; /* :::::::::::::::::::: */
20233 break;
20234
20235 case FFELEX_typeNAMES:
20236 if (ffesta_first_kw != FFESTR_firstNULLIFY)
20237 goto bad_0; /* :::::::::::::::::::: */
20238 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlNULLIFY)
20239 goto bad_0; /* :::::::::::::::::::: */
20240 break;
20241
20242 default:
20243 goto bad_0; /* :::::::::::::::::::: */
20244 }
20245
20246 switch (ffelex_token_type (t))
20247 {
20248 case FFELEX_typeOPEN_PAREN:
20249 break;
20250
20251 case FFELEX_typeEOS:
20252 case FFELEX_typeSEMICOLON:
20253 case FFELEX_typeCOMMA:
20254 case FFELEX_typeCOLONCOLON:
20255 case FFELEX_typeNAME:
20256 ffesta_confirmed (); /* Error, but clearly intended. */
20257 goto bad_1; /* :::::::::::::::::::: */
20258
20259 default:
20260 goto bad_1; /* :::::::::::::::::::: */
20261 }
20262
20263 ffestb_local_.R624.exprs = ffestt_exprlist_create ();
20264 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
20265 FFEEXPR_contextNULLIFY,
20266 (ffeexprCallback) ffestb_R6241_);
20267
20268bad_0: /* :::::::::::::::::::: */
20269 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", ffesta_tokens[0]);
20270 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20271
20272bad_1: /* :::::::::::::::::::: */
20273 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", t);
20274 return (ffelexHandler) ffelex_swallow_tokens (t,
20275 (ffelexHandler) ffesta_zero); /* Invalid second token. */
20276}
20277
20278/* ffestb_R6241_ -- "NULLIFY" OPEN_PAREN expr
20279
20280 return ffestb_R6241_; // to lexer
20281
20282 Make sure the statement has a valid form for a NULLIFY statement. If it
20283 does, implement the statement.
20284
20285 31-May-90 JCB 2.0
20286 Rewrite to produce a list of expressions rather than just names; this
20287 eases semantic checking, putting it in expression handling where that
20288 kind of thing gets done anyway, and makes it easier to support more
20289 flexible extensions to Fortran 90 like NULLIFY(FOO%BAR). */
20290
20291static ffelexHandler
20292ffestb_R6241_ (ffelexToken ft, ffebld expr, ffelexToken t)
20293{
20294 switch (ffelex_token_type (t))
20295 {
20296 case FFELEX_typeCLOSE_PAREN:
20297 if (expr == NULL)
20298 break;
20299 ffestt_exprlist_append (ffestb_local_.R624.exprs, expr,
20300 ffelex_token_use (t));
20301 return (ffelexHandler) ffestb_R6242_;
20302
20303 case FFELEX_typeCOMMA:
20304 if (expr == NULL)
20305 break;
20306 ffestt_exprlist_append (ffestb_local_.R624.exprs, expr,
20307 ffelex_token_use (t));
20308 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
20309 FFEEXPR_contextNULLIFY,
20310 (ffeexprCallback) ffestb_R6241_);
20311
20312 default:
20313 break;
20314 }
20315
20316 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", t);
20317 ffestt_exprlist_kill (ffestb_local_.R624.exprs);
20318 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20319}
20320
20321/* ffestb_R6242_ -- "NULLIFY" OPEN_PAREN expr-list CLOSE_PAREN
20322
20323 return ffestb_R6242_; // to lexer
20324
20325 Make sure the statement has a valid form for a NULLIFY statement. If it
20326 does, implement the statement. */
20327
20328static ffelexHandler
20329ffestb_R6242_ (ffelexToken t)
20330{
20331 switch (ffelex_token_type (t))
20332 {
20333 case FFELEX_typeEOS:
20334 case FFELEX_typeSEMICOLON:
20335 ffesta_confirmed ();
20336 if (!ffesta_is_inhibited ())
20337 ffestc_R624 (ffestb_local_.R624.exprs);
20338 ffestt_exprlist_kill (ffestb_local_.R624.exprs);
20339 return (ffelexHandler) ffesta_zero (t);
20340
20341 default:
20342 break;
20343 }
20344
20345 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", t);
20346 ffestt_exprlist_kill (ffestb_local_.R624.exprs);
20347 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20348}
20349
20350#endif
20351/* ffestb_R1229 -- Parse a STMTFUNCTION statement
20352
20353 return ffestb_R1229; // to lexer
20354
20355 Make sure the statement has a valid form for a STMTFUNCTION
20356 statement. If it does, implement the statement. */
20357
20358ffelexHandler
20359ffestb_R1229 (ffelexToken t)
20360{
20361 switch (ffelex_token_type (ffesta_tokens[0]))
20362 {
20363 case FFELEX_typeNAME:
20364 case FFELEX_typeNAMES:
20365 break;
20366
20367 default:
20368 goto bad_0; /* :::::::::::::::::::: */
20369 }
20370
20371 switch (ffelex_token_type (t))
20372 {
20373 case FFELEX_typeOPEN_PAREN:
20374 break;
20375
20376 case FFELEX_typeEOS:
20377 case FFELEX_typeSEMICOLON:
20378 case FFELEX_typeCOMMA:
20379 case FFELEX_typeCOLONCOLON:
20380 case FFELEX_typeNAME:
20381 ffesta_confirmed (); /* Error, but clearly intended. */
20382 goto bad_1; /* :::::::::::::::::::: */
20383
20384 default:
20385 goto bad_1; /* :::::::::::::::::::: */
20386 }
20387
20388 ffestb_subrargs_.name_list.args = ffestt_tokenlist_create ();
20389 ffestb_subrargs_.name_list.handler = (ffelexHandler) ffestb_R12291_;
20390 ffestb_subrargs_.name_list.is_subr = FALSE; /* No "*" items in list! */
20391 ffestb_subrargs_.name_list.names = TRUE; /* In case "IF(FOO)CALL
20392 FOO...". */
20393 return (ffelexHandler) ffestb_subr_name_list_;
20394
20395bad_0: /* :::::::::::::::::::: */
20396bad_1: /* :::::::::::::::::::: */
20397 ffesta_ffebad_2t (FFEBAD_UNREC_STMT, ffesta_tokens[0], t);
20398 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20399}
20400
20401/* ffestb_R12291_ -- "STMTFUNCTION" OPEN_PAREN dummy-name-list CLOSE_PAREN
20402
20403 return ffestb_R12291_; // to lexer
20404
20405 Make sure the statement has a valid form for a STMTFUNCTION statement. If
20406 it does, implement the statement. */
20407
20408static ffelexHandler
20409ffestb_R12291_ (ffelexToken t)
20410{
20411 ffelex_set_names (FALSE);
20412
20413 if (!ffestb_subrargs_.name_list.ok)
20414 goto bad; /* :::::::::::::::::::: */
20415
20416 switch (ffelex_token_type (t))
20417 {
20418 case FFELEX_typeEQUALS:
20419 ffesta_confirmed ();
20420 if (!ffesta_is_inhibited ())
20421 ffestc_R1229_start (ffesta_tokens[0],
20422 ffestb_subrargs_.name_list.args,
20423 ffestb_subrargs_.name_list.close_paren);
20424 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
20425 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
20426 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
20427 FFEEXPR_contextSFUNCDEF, (ffeexprCallback) ffestb_R12292_);
20428
20429 default:
20430 break;
20431 }
20432
20433bad: /* :::::::::::::::::::: */
20434 ffesta_ffebad_2t (FFEBAD_UNREC_STMT, ffesta_tokens[0], t);
20435 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
20436 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
20437 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20438}
20439
20440/* ffestb_R12292_ -- "STMTFUNCTION" OPEN_PAREN dummy-name-list CLOSE_PAREN
20441 EQUALS expr
20442
20443 (ffestb_R12292_) // to expression handler
20444
20445 Make sure the statement has a valid form for a STMTFUNCTION statement. If
20446 it does, implement the statement. */
20447
20448static ffelexHandler
20449ffestb_R12292_ (ffelexToken ft, ffebld expr, ffelexToken t)
20450{
20451 if (expr == NULL)
20452 goto bad; /* :::::::::::::::::::: */
20453
20454 switch (ffelex_token_type (t))
20455 {
20456 case FFELEX_typeEOS:
20457 case FFELEX_typeSEMICOLON:
20458 if (!ffesta_is_inhibited ())
20459 ffestc_R1229_finish (expr, ft);
20460 return (ffelexHandler) ffesta_zero (t);
20461
20462 default:
20463 break;
20464 }
20465
20466bad: /* :::::::::::::::::::: */
20467 ffestc_R1229_finish (NULL, NULL);
20468 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "statement-function-definition", t);
20469 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20470}
20471
20472/* ffestb_decl_chartype -- Parse the CHARACTER statement
20473
20474 return ffestb_decl_chartype; // to lexer
20475
20476 Make sure the statement has a valid form for the CHARACTER statement. If
20477 it does, implement the statement. */
20478
20479ffelexHandler
20480ffestb_decl_chartype (ffelexToken t)
20481{
20482 ffeTokenLength i;
20483 char *p;
20484
20485 ffestb_local_.decl.type = FFESTP_typeCHARACTER;
20486 ffestb_local_.decl.recursive = NULL;
20487 ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
20488 ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
20489
20490 switch (ffelex_token_type (ffesta_tokens[0]))
20491 {
20492 case FFELEX_typeNAME:
20493 if (ffesta_first_kw != FFESTR_firstCHRCTR)
20494 goto bad_0; /* :::::::::::::::::::: */
20495 switch (ffelex_token_type (t))
20496 {
20497 case FFELEX_typeEOS:
20498 case FFELEX_typeSEMICOLON:
20499 ffesta_confirmed (); /* Error, but clearly intended. */
20500 goto bad_1; /* :::::::::::::::::::: */
20501
20502 default:
20503 goto bad_1; /* :::::::::::::::::::: */
20504
20505 case FFELEX_typeCOMMA:
20506 ffesta_confirmed ();
20507 if (!ffesta_is_inhibited ())
20508 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20509 NULL, NULL, NULL, NULL);
20510 return (ffelexHandler) ffestb_decl_attrs_;
20511
20512 case FFELEX_typeCOLONCOLON:
20513 ffestb_local_.decl.coloncolon = TRUE;
20514 ffesta_confirmed ();
20515 if (!ffesta_is_inhibited ())
20516 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20517 NULL, NULL, NULL, NULL);
20518 return (ffelexHandler) ffestb_decl_ents_;
20519
20520 case FFELEX_typeASTERISK:
20521 ffesta_confirmed ();
20522 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_chartype1_;
20523 ffestb_local_.decl.badname = "TYPEDECL";
20524 return (ffelexHandler) ffestb_decl_starlen_;
20525
20526 case FFELEX_typeOPEN_PAREN:
20527 ffestb_local_.decl.kind = NULL;
20528 ffestb_local_.decl.kindt = NULL;
20529 ffestb_local_.decl.len = NULL;
20530 ffestb_local_.decl.lent = NULL;
20531 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
20532 ffestb_local_.decl.badname = "_TYPEDECL";
20533 return (ffelexHandler) ffestb_decl_typeparams_;
20534
20535 case FFELEX_typeNAME:
20536 ffesta_confirmed ();
20537 ffestb_local_.decl.kind = NULL;
20538 ffestb_local_.decl.kindt = NULL;
20539 ffestb_local_.decl.len = NULL;
20540 ffestb_local_.decl.lent = NULL;
20541 return (ffelexHandler) ffestb_decl_entsp_ (t);
20542 }
20543
20544 case FFELEX_typeNAMES:
20545 if (ffesta_first_kw != FFESTR_firstCHRCTR)
20546 goto bad_0; /* :::::::::::::::::::: */
20547 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCHRCTR);
20548 switch (ffelex_token_type (t))
20549 {
20550 default:
20551 goto bad_1; /* :::::::::::::::::::: */
20552
20553 case FFELEX_typeEOS:
20554 case FFELEX_typeSEMICOLON:
20555 ffesta_confirmed ();
20556 break;
20557
20558 case FFELEX_typeCOMMA:
20559 ffesta_confirmed ();
20560 if (*p != '\0')
20561 break;
20562 if (!ffesta_is_inhibited ())
20563 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20564 NULL, NULL, NULL, NULL);
20565 return (ffelexHandler) ffestb_decl_attrs_;
20566
20567 case FFELEX_typeCOLONCOLON:
20568 ffestb_local_.decl.coloncolon = TRUE;
20569 ffesta_confirmed ();
20570 if (*p != '\0')
20571 goto bad_i; /* :::::::::::::::::::: */
20572 if (!ffesta_is_inhibited ())
20573 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20574 NULL, NULL, NULL, NULL);
20575 return (ffelexHandler) ffestb_decl_ents_;
20576
20577 case FFELEX_typeASTERISK:
20578 ffesta_confirmed ();
20579 if (*p != '\0')
20580 break;
20581 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_chartype1_;
20582 ffestb_local_.decl.badname = "TYPEDECL";
20583 return (ffelexHandler) ffestb_decl_starlen_;
20584
20585 case FFELEX_typeSLASH:
20586 ffesta_confirmed ();
20587 if (*p != '\0')
20588 break;
20589 goto bad_1; /* :::::::::::::::::::: */
20590
20591 case FFELEX_typeOPEN_PAREN:
20592 if (*p != '\0')
20593 break;
20594 ffestb_local_.decl.kind = NULL;
20595 ffestb_local_.decl.kindt = NULL;
20596 ffestb_local_.decl.len = NULL;
20597 ffestb_local_.decl.lent = NULL;
20598 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
20599 ffestb_local_.decl.badname = "TYPEDECL";
20600 return (ffelexHandler) ffestb_decl_typeparams_;
20601 }
20602 if (!ffesrc_is_name_init (*p))
20603 goto bad_i; /* :::::::::::::::::::: */
20604 ffestb_local_.decl.kind = NULL;
20605 ffestb_local_.decl.kindt = NULL;
20606 ffestb_local_.decl.len = NULL;
20607 ffestb_local_.decl.lent = NULL;
20608 ffesta_tokens[1] = ffelex_token_names_from_names (ffesta_tokens[0], i, 0);
20609 return (ffelexHandler) ffestb_decl_entsp_2_ (t);
20610
20611 default:
20612 goto bad_0; /* :::::::::::::::::::: */
20613 }
20614
20615bad_0: /* :::::::::::::::::::: */
20616 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
20617 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20618
20619bad_1: /* :::::::::::::::::::: */
20620 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
20621 return (ffelexHandler) ffelex_swallow_tokens (t,
20622 (ffelexHandler) ffesta_zero); /* Invalid second token. */
20623
20624bad_i: /* :::::::::::::::::::: */
20625 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0], i, t);
20626 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20627}
20628
20629/* ffestb_decl_chartype1_ -- "CHARACTER" ASTERISK char-length
20630
20631 return ffestb_decl_chartype1_; // to lexer
20632
20633 Handle COMMA, COLONCOLON, or anything else. */
20634
20635static ffelexHandler
20636ffestb_decl_chartype1_ (ffelexToken t)
20637{
20638 ffelex_set_names (FALSE);
20639
20640 switch (ffelex_token_type (t))
20641 {
20642 case FFELEX_typeCOLONCOLON:
20643 ffestb_local_.decl.coloncolon = TRUE;
20644 /* Fall through. */
20645 case FFELEX_typeCOMMA:
20646 ffesta_confirmed ();
20647 if (!ffesta_is_inhibited ())
20648 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20649 NULL, NULL, ffestb_local_.decl.len, ffestb_local_.decl.lent);
20650 if (ffestb_local_.decl.lent != NULL)
20651 ffelex_token_kill (ffestb_local_.decl.lent);
20652 return (ffelexHandler) ffestb_decl_ents_;
20653
20654 default:
20655 return (ffelexHandler) ffestb_decl_entsp_ (t);
20656 }
20657}
20658
20659/* ffestb_decl_dbltype -- Parse the DOUBLEPRECISION/DOUBLECOMPLEX statement
20660
20661 return ffestb_decl_dbltype; // to lexer
20662
20663 Make sure the statement has a valid form for the DOUBLEPRECISION/
20664 DOUBLECOMPLEX statement. If it does, implement the statement. */
20665
20666ffelexHandler
20667ffestb_decl_dbltype (ffelexToken t)
20668{
20669 ffeTokenLength i;
20670 char *p;
20671
20672 ffestb_local_.decl.type = ffestb_args.decl.type;
20673 ffestb_local_.decl.recursive = NULL;
20674 ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
20675 ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
20676
20677 switch (ffelex_token_type (ffesta_tokens[0]))
20678 {
20679 case FFELEX_typeNAME:
20680 switch (ffelex_token_type (t))
20681 {
20682 case FFELEX_typeEOS:
20683 case FFELEX_typeSEMICOLON:
20684 ffesta_confirmed (); /* Error, but clearly intended. */
20685 goto bad_1; /* :::::::::::::::::::: */
20686
20687 default:
20688 goto bad_1; /* :::::::::::::::::::: */
20689
20690 case FFELEX_typeCOMMA:
20691 ffesta_confirmed ();
20692 if (!ffesta_is_inhibited ())
20693 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20694 NULL, NULL, NULL, NULL);
20695 return (ffelexHandler) ffestb_decl_attrs_;
20696
20697 case FFELEX_typeCOLONCOLON:
20698 ffestb_local_.decl.coloncolon = TRUE;
20699 ffesta_confirmed ();
20700 if (!ffesta_is_inhibited ())
20701 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20702 NULL, NULL, NULL, NULL);
20703 return (ffelexHandler) ffestb_decl_ents_;
20704
20705 case FFELEX_typeNAME:
20706 ffesta_confirmed ();
20707 ffestb_local_.decl.kind = NULL;
20708 ffestb_local_.decl.kindt = NULL;
20709 ffestb_local_.decl.len = NULL;
20710 ffestb_local_.decl.lent = NULL;
20711 return (ffelexHandler) ffestb_decl_entsp_ (t);
20712 }
20713
20714 case FFELEX_typeNAMES:
20715 p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.decl.len);
20716 switch (ffelex_token_type (t))
20717 {
20718 default:
20719 goto bad_1; /* :::::::::::::::::::: */
20720
20721 case FFELEX_typeEOS:
20722 case FFELEX_typeSEMICOLON:
20723 ffesta_confirmed ();
20724 break;
20725
20726 case FFELEX_typeCOMMA:
20727 ffesta_confirmed ();
20728 if (*p != '\0')
20729 break;
20730 if (!ffesta_is_inhibited ())
20731 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20732 NULL, NULL, NULL, NULL);
20733 return (ffelexHandler) ffestb_decl_attrs_;
20734
20735 case FFELEX_typeCOLONCOLON:
20736 ffestb_local_.decl.coloncolon = TRUE;
20737 ffesta_confirmed ();
20738 if (*p != '\0')
20739 goto bad_i; /* :::::::::::::::::::: */
20740 if (!ffesta_is_inhibited ())
20741 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20742 NULL, NULL, NULL, NULL);
20743 return (ffelexHandler) ffestb_decl_ents_;
20744
20745 case FFELEX_typeSLASH:
20746 ffesta_confirmed ();
20747 if (*p != '\0')
20748 break;
20749 goto bad_1; /* :::::::::::::::::::: */
20750
20751 case FFELEX_typeOPEN_PAREN:
20752 if (*p != '\0')
20753 break;
20754 goto bad_1; /* :::::::::::::::::::: */
20755 }
20756 if (!ffesrc_is_name_init (*p))
20757 goto bad_i; /* :::::::::::::::::::: */
20758 ffestb_local_.decl.kind = NULL;
20759 ffestb_local_.decl.kindt = NULL;
20760 ffestb_local_.decl.len = NULL;
20761 ffestb_local_.decl.lent = NULL;
20762 ffesta_tokens[1] = ffelex_token_names_from_names (ffesta_tokens[0], i, 0);
20763 return (ffelexHandler) ffestb_decl_entsp_2_ (t);
20764
20765 default:
20766 goto bad_0; /* :::::::::::::::::::: */
20767 }
20768
20769bad_0: /* :::::::::::::::::::: */
20770 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
20771 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20772
20773bad_1: /* :::::::::::::::::::: */
20774 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
20775 return (ffelexHandler) ffelex_swallow_tokens (t,
20776 (ffelexHandler) ffesta_zero); /* Invalid second token. */
20777
20778bad_i: /* :::::::::::::::::::: */
20779 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0], i, t);
20780 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20781}
20782
20783/* ffestb_decl_double -- Parse the DOUBLE PRECISION/DOUBLE COMPLEX statement
20784
20785 return ffestb_decl_double; // to lexer
20786
20787 Make sure the statement has a valid form for the DOUBLE PRECISION/
20788 DOUBLE COMPLEX statement. If it does, implement the statement. */
20789
20790ffelexHandler
20791ffestb_decl_double (ffelexToken t)
20792{
20793 ffestb_local_.decl.recursive = NULL;
20794 ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
20795 ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
20796
20797 switch (ffelex_token_type (ffesta_tokens[0]))
20798 {
20799 case FFELEX_typeNAME:
20800 if (ffesta_first_kw != FFESTR_firstDBL)
20801 goto bad_0; /* :::::::::::::::::::: */
20802 switch (ffelex_token_type (t))
20803 {
20804 case FFELEX_typeEOS:
20805 case FFELEX_typeSEMICOLON:
20806 case FFELEX_typeCOMMA:
20807 case FFELEX_typeCOLONCOLON:
20808 ffesta_confirmed (); /* Error, but clearly intended. */
20809 goto bad_1; /* :::::::::::::::::::: */
20810
20811 default:
20812 goto bad_1; /* :::::::::::::::::::: */
20813
20814 case FFELEX_typeNAME:
20815 ffesta_confirmed ();
20816 switch (ffestr_second (t))
20817 {
20818 case FFESTR_secondCOMPLEX:
20819 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
20820 break;
20821
20822 case FFESTR_secondPRECISION:
20823 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
20824 break;
20825
20826 default:
20827 goto bad_1; /* :::::::::::::::::::: */
20828 }
20829 ffestb_local_.decl.kind = NULL;
20830 ffestb_local_.decl.kindt = NULL;
20831 ffestb_local_.decl.len = NULL;
20832 ffestb_local_.decl.lent = NULL;
20833 return (ffelexHandler) ffestb_decl_attrsp_;
20834 }
20835
20836 default:
20837 goto bad_0; /* :::::::::::::::::::: */
20838 }
20839
20840bad_0: /* :::::::::::::::::::: */
20841 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
20842 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20843
20844bad_1: /* :::::::::::::::::::: */
20845 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
20846 return (ffelexHandler) ffelex_swallow_tokens (t,
20847 (ffelexHandler) ffesta_zero); /* Invalid second token. */
20848}
20849
20850/* ffestb_decl_gentype -- Parse the INTEGER/REAL/COMPLEX/LOGICAL statement
20851
20852 return ffestb_decl_gentype; // to lexer
20853
20854 Make sure the statement has a valid form for the INTEGER/REAL/COMPLEX/
20855 LOGICAL statement. If it does, implement the statement. */
20856
20857ffelexHandler
20858ffestb_decl_gentype (ffelexToken t)
20859{
20860 ffeTokenLength i;
20861 char *p;
20862
20863 ffestb_local_.decl.type = ffestb_args.decl.type;
20864 ffestb_local_.decl.recursive = NULL;
20865 ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
20866 ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
20867
20868 switch (ffelex_token_type (ffesta_tokens[0]))
20869 {
20870 case FFELEX_typeNAME:
20871 switch (ffelex_token_type (t))
20872 {
20873 case FFELEX_typeEOS:
20874 case FFELEX_typeSEMICOLON:
20875 ffesta_confirmed (); /* Error, but clearly intended. */
20876 goto bad_1; /* :::::::::::::::::::: */
20877
20878 default:
20879 goto bad_1; /* :::::::::::::::::::: */
20880
20881 case FFELEX_typeCOMMA:
20882 ffesta_confirmed ();
20883 if (!ffesta_is_inhibited ())
20884 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20885 NULL, NULL, NULL, NULL);
20886 return (ffelexHandler) ffestb_decl_attrs_;
20887
20888 case FFELEX_typeCOLONCOLON:
20889 ffestb_local_.decl.coloncolon = TRUE;
20890 ffesta_confirmed ();
20891 if (!ffesta_is_inhibited ())
20892 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20893 NULL, NULL, NULL, NULL);
20894 return (ffelexHandler) ffestb_decl_ents_;
20895
20896 case FFELEX_typeASTERISK:
20897 ffesta_confirmed ();
20898 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
20899 ffestb_local_.decl.badname = "TYPEDECL";
20900 return (ffelexHandler) ffestb_decl_starkind_;
20901
20902 case FFELEX_typeOPEN_PAREN:
20903 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
20904 ffestb_local_.decl.badname = "TYPEDECL";
20905 return (ffelexHandler) ffestb_decl_kindparam_;
20906
20907 case FFELEX_typeNAME:
20908 ffesta_confirmed ();
20909 ffestb_local_.decl.kind = NULL;
20910 ffestb_local_.decl.kindt = NULL;
20911 ffestb_local_.decl.len = NULL;
20912 ffestb_local_.decl.lent = NULL;
20913 return (ffelexHandler) ffestb_decl_entsp_ (t);
20914 }
20915
20916 case FFELEX_typeNAMES:
20917 p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.decl.len);
20918 switch (ffelex_token_type (t))
20919 {
20920 default:
20921 goto bad_1; /* :::::::::::::::::::: */
20922
20923 case FFELEX_typeEOS:
20924 case FFELEX_typeSEMICOLON:
20925 ffesta_confirmed ();
20926 break;
20927
20928 case FFELEX_typeCOMMA:
20929 ffesta_confirmed ();
20930 if (*p != '\0')
20931 break;
20932 if (!ffesta_is_inhibited ())
20933 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20934 NULL, NULL, NULL, NULL);
20935 return (ffelexHandler) ffestb_decl_attrs_;
20936
20937 case FFELEX_typeCOLONCOLON:
20938 ffestb_local_.decl.coloncolon = TRUE;
20939 ffesta_confirmed ();
20940 if (*p != '\0')
20941 goto bad_i; /* :::::::::::::::::::: */
20942 if (!ffesta_is_inhibited ())
20943 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20944 NULL, NULL, NULL, NULL);
20945 return (ffelexHandler) ffestb_decl_ents_;
20946
20947 case FFELEX_typeSLASH:
20948 ffesta_confirmed ();
20949 if (*p != '\0')
20950 break;
20951 goto bad_1; /* :::::::::::::::::::: */
20952
20953 case FFELEX_typeASTERISK:
20954 ffesta_confirmed ();
20955 if (*p != '\0')
20956 break;
20957 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
20958 ffestb_local_.decl.badname = "TYPEDECL";
20959 return (ffelexHandler) ffestb_decl_starkind_;
20960
20961 case FFELEX_typeOPEN_PAREN:
20962 if (*p != '\0')
20963 break;
20964 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
20965 ffestb_local_.decl.badname = "TYPEDECL";
20966 return (ffelexHandler) ffestb_decl_kindparam_;
20967 }
20968 if (!ffesrc_is_name_init (*p))
20969 goto bad_i; /* :::::::::::::::::::: */
20970 ffestb_local_.decl.kind = NULL;
20971 ffestb_local_.decl.kindt = NULL;
20972 ffestb_local_.decl.len = NULL;
20973 ffestb_local_.decl.lent = NULL;
20974 ffesta_tokens[1] = ffelex_token_names_from_names (ffesta_tokens[0], i, 0);
20975 return (ffelexHandler) ffestb_decl_entsp_2_ (t);
20976
20977 default:
20978 goto bad_0; /* :::::::::::::::::::: */
20979 }
20980
20981bad_0: /* :::::::::::::::::::: */
20982 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
20983 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20984
20985bad_1: /* :::::::::::::::::::: */
20986 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
20987 return (ffelexHandler) ffelex_swallow_tokens (t,
20988 (ffelexHandler) ffesta_zero); /* Invalid second token. */
20989
20990bad_i: /* :::::::::::::::::::: */
20991 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0], i, t);
20992 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20993}
20994
20995/* ffestb_decl_recursive -- Parse the RECURSIVE FUNCTION statement
20996
20997 return ffestb_decl_recursive; // to lexer
20998
20999 Make sure the statement has a valid form for the RECURSIVE FUNCTION
21000 statement. If it does, implement the statement. */
21001
21002#if FFESTR_F90
21003ffelexHandler
21004ffestb_decl_recursive (ffelexToken t)
21005{
21006 ffeTokenLength i;
21007 char *p;
21008 ffelexToken nt;
21009 ffelexToken ot;
21010 ffelexHandler next;
21011 bool needfunc;
21012
21013 switch (ffelex_token_type (ffesta_tokens[0]))
21014 {
21015 case FFELEX_typeNAME:
21016 if (ffesta_first_kw != FFESTR_firstRECURSIVE)
21017 goto bad_0; /* :::::::::::::::::::: */
21018 switch (ffelex_token_type (t))
21019 {
21020 case FFELEX_typeEOS:
21021 case FFELEX_typeSEMICOLON:
21022 case FFELEX_typeCOMMA:
21023 case FFELEX_typeCOLONCOLON:
21024 ffesta_confirmed (); /* Error, but clearly intended. */
21025 goto bad_1; /* :::::::::::::::::::: */
21026
21027 default:
21028 goto bad_1; /* :::::::::::::::::::: */
21029
21030 case FFELEX_typeNAME:
21031 break;
21032 }
21033 ffesta_confirmed ();
21034 ffestb_local_.decl.recursive = ffelex_token_use (ffesta_tokens[0]);
21035 switch (ffesta_second_kw)
21036 {
21037 case FFESTR_secondINTEGER:
21038 ffestb_local_.decl.type = FFESTP_typeINTEGER;
21039 return (ffelexHandler) ffestb_decl_recursive1_;
21040
21041 case FFESTR_secondBYTE:
21042 ffestb_local_.decl.type = FFESTP_typeBYTE;
21043 return (ffelexHandler) ffestb_decl_recursive1_;
21044
21045 case FFESTR_secondWORD:
21046 ffestb_local_.decl.type = FFESTP_typeWORD;
21047 return (ffelexHandler) ffestb_decl_recursive1_;
21048
21049 case FFESTR_secondREAL:
21050 ffestb_local_.decl.type = FFESTP_typeREAL;
21051 return (ffelexHandler) ffestb_decl_recursive1_;
21052
21053 case FFESTR_secondCOMPLEX:
21054 ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
21055 return (ffelexHandler) ffestb_decl_recursive1_;
21056
21057 case FFESTR_secondLOGICAL:
21058 ffestb_local_.decl.type = FFESTP_typeLOGICAL;
21059 return (ffelexHandler) ffestb_decl_recursive1_;
21060
21061 case FFESTR_secondCHARACTER:
21062 ffestb_local_.decl.type = FFESTP_typeCHARACTER;
21063 return (ffelexHandler) ffestb_decl_recursive1_;
21064
21065 case FFESTR_secondDOUBLE:
21066 return (ffelexHandler) ffestb_decl_recursive2_;
21067
21068 case FFESTR_secondDOUBLEPRECISION:
21069 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
21070 ffestb_local_.decl.kind = NULL;
21071 ffestb_local_.decl.kindt = NULL;
21072 ffestb_local_.decl.len = NULL;
21073 ffestb_local_.decl.lent = NULL;
21074 return (ffelexHandler) ffestb_decl_func_;
21075
21076 case FFESTR_secondDOUBLECOMPLEX:
21077 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
21078 ffestb_local_.decl.kind = NULL;
21079 ffestb_local_.decl.kindt = NULL;
21080 ffestb_local_.decl.len = NULL;
21081 ffestb_local_.decl.lent = NULL;
21082 return (ffelexHandler) ffestb_decl_func_;
21083
21084 case FFESTR_secondTYPE:
21085 ffestb_local_.decl.type = FFESTP_typeTYPE;
21086 return (ffelexHandler) ffestb_decl_recursive3_;
21087
21088 case FFESTR_secondFUNCTION:
21089 ffestb_local_.dummy.first_kw = FFESTR_firstFUNCTION;
21090 ffestb_local_.dummy.badname = "FUNCTION";
21091 ffestb_local_.dummy.is_subr = FALSE;
21092 return (ffelexHandler) ffestb_decl_recursive4_;
21093
21094 case FFESTR_secondSUBROUTINE:
21095 ffestb_local_.dummy.first_kw = FFESTR_firstSUBROUTINE;
21096 ffestb_local_.dummy.badname = "SUBROUTINE";
21097 ffestb_local_.dummy.is_subr = TRUE;
21098 return (ffelexHandler) ffestb_decl_recursive4_;
21099
21100 default:
21101 ffelex_token_kill (ffestb_local_.decl.recursive);
21102 goto bad_1; /* :::::::::::::::::::: */
21103 }
21104
21105 case FFELEX_typeNAMES:
21106 if (ffesta_first_kw != FFESTR_firstRECURSIVE)
21107 goto bad_0; /* :::::::::::::::::::: */
21108 switch (ffelex_token_type (t))
21109 {
21110 case FFELEX_typeCOMMA:
21111 case FFELEX_typeCOLONCOLON:
21112 case FFELEX_typeASTERISK:
21113 case FFELEX_typeSEMICOLON:
21114 case FFELEX_typeEOS:
21115 ffesta_confirmed ();
21116 break;
21117
21118 default:
21119 break;
21120 }
21121 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlRECURSIVE);
21122 if (!ffesrc_is_name_init (*p))
21123 goto bad_0; /* :::::::::::::::::::: */
21124 ffestb_local_.decl.recursive
21125 = ffelex_token_name_from_names (ffesta_tokens[0], 0,
21126 FFESTR_firstlRECURSIVE);
21127 nt = ffelex_token_names_from_names (ffesta_tokens[0],
21128 FFESTR_firstlRECURSIVE, 0);
21129 switch (ffestr_first (nt))
21130 {
21131 case FFESTR_firstINTGR:
21132 p = ffelex_token_text (nt) + (i = FFESTR_firstlINTGR);
21133 ffestb_local_.decl.type = FFESTP_typeINTEGER;
21134 needfunc = FALSE;
21135 goto typefunc; /* :::::::::::::::::::: */
21136
21137 case FFESTR_firstBYTE:
21138 p = ffelex_token_text (nt) + (i = FFESTR_firstlBYTE);
21139 ffestb_local_.decl.type = FFESTP_typeBYTE;
21140 needfunc = FALSE;
21141 goto typefunc; /* :::::::::::::::::::: */
21142
21143 case FFESTR_firstWORD:
21144 p = ffelex_token_text (nt) + (i = FFESTR_firstlWORD);
21145 ffestb_local_.decl.type = FFESTP_typeWORD;
21146 needfunc = FALSE;
21147 goto typefunc; /* :::::::::::::::::::: */
21148
21149 case FFESTR_firstREAL:
21150 p = ffelex_token_text (nt) + (i = FFESTR_firstlREAL);
21151 ffestb_local_.decl.type = FFESTP_typeREAL;
21152 needfunc = FALSE;
21153 goto typefunc; /* :::::::::::::::::::: */
21154
21155 case FFESTR_firstCMPLX:
21156 p = ffelex_token_text (nt) + (i = FFESTR_firstlCMPLX);
21157 ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
21158 needfunc = FALSE;
21159 goto typefunc; /* :::::::::::::::::::: */
21160
21161 case FFESTR_firstLGCL:
21162 p = ffelex_token_text (nt) + (i = FFESTR_firstlLGCL);
21163 ffestb_local_.decl.type = FFESTP_typeLOGICAL;
21164 needfunc = FALSE;
21165 goto typefunc; /* :::::::::::::::::::: */
21166
21167 case FFESTR_firstCHRCTR:
21168 p = ffelex_token_text (nt) + (i = FFESTR_firstlCHRCTR);
21169 ffestb_local_.decl.type = FFESTP_typeCHARACTER;
21170 needfunc = FALSE;
21171 goto typefunc; /* :::::::::::::::::::: */
21172
21173 case FFESTR_firstDBLPRCSN:
21174 p = ffelex_token_text (nt) + (i = FFESTR_firstlDBLPRCSN);
21175 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
21176 needfunc = TRUE;
21177 goto typefunc; /* :::::::::::::::::::: */
21178
21179 case FFESTR_firstDBLCMPLX:
21180 p = ffelex_token_text (nt) + (i = FFESTR_firstlDBLCMPLX);
21181 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
21182 needfunc = TRUE;
21183 goto typefunc; /* :::::::::::::::::::: */
21184
21185 case FFESTR_firstTYPE:
21186 p = ffelex_token_text (nt) + (i = FFESTR_firstlTYPE);
21187 ffestb_local_.decl.type = FFESTP_typeTYPE;
21188 next = (ffelexHandler) ffestb_decl_recursive3_;
21189 break;
21190
21191 case FFESTR_firstFUNCTION:
21192 p = ffelex_token_text (nt) + (i = FFESTR_firstlFUNCTION);
21193 ffestb_local_.dummy.first_kw = FFESTR_firstFUNCTION;
21194 ffestb_local_.dummy.badname = "FUNCTION";
21195 ffestb_local_.dummy.is_subr = FALSE;
21196 next = (ffelexHandler) ffestb_decl_recursive4_;
21197 break;
21198
21199 case FFESTR_firstSUBROUTINE:
21200 p = ffelex_token_text (nt) + (i = FFESTR_firstlSUBROUTINE);
21201 ffestb_local_.dummy.first_kw = FFESTR_firstSUBROUTINE;
21202 ffestb_local_.dummy.badname = "SUBROUTINE";
21203 ffestb_local_.dummy.is_subr = TRUE;
21204 next = (ffelexHandler) ffestb_decl_recursive4_;
21205 break;
21206
21207 default:
21208 ffelex_token_kill (ffestb_local_.decl.recursive);
21209 ffelex_token_kill (nt);
21210 goto bad_1; /* :::::::::::::::::::: */
21211 }
21212 if (*p == '\0')
21213 {
21214 ffelex_token_kill (nt);
21215 return (ffelexHandler) (*next) (t);
21216 }
21217 if (!ffesrc_is_name_init (*p))
21218 goto bad_i; /* :::::::::::::::::::: */
21219 ot = ffelex_token_name_from_names (nt, i, 0);
21220 ffelex_token_kill (nt);
21221 next = (ffelexHandler) (*next) (ot);
21222 ffelex_token_kill (ot);
21223 return (ffelexHandler) (*next) (t);
21224
21225 default:
21226 goto bad_0; /* :::::::::::::::::::: */
21227 }
21228
21229typefunc: /* :::::::::::::::::::: */
21230 if (*p == '\0')
21231 {
21232 ffelex_token_kill (nt);
21233 if (needfunc) /* DOUBLE PRECISION or DOUBLE COMPLEX? */
21234 {
21235 ffelex_token_kill (ffestb_local_.decl.recursive);
21236 goto bad_1; /* :::::::::::::::::::: */
21237 }
21238 return (ffelexHandler) ffestb_decl_recursive1_ (t);
21239 }
21240 if (!ffesrc_is_name_init (*p))
21241 goto bad_i; /* :::::::::::::::::::: */
21242 ot = ffelex_token_names_from_names (nt, i, 0);
21243 ffelex_token_kill (nt);
21244 if (ffestr_first (ot) != FFESTR_firstFUNCTION)
21245 goto bad_o; /* :::::::::::::::::::: */
21246 p = ffelex_token_text (ot) + (i = FFESTR_firstlFUNCTION);
21247 if (!ffesrc_is_name_init (*p))
21248 goto bad_i; /* :::::::::::::::::::: */
21249 ffesta_tokens[1] = ffelex_token_name_from_names (ot, i, 0);
21250 ffelex_token_kill (ot);
21251 ffestb_local_.decl.kind = NULL;
21252 ffestb_local_.decl.kindt = NULL;
21253 ffestb_local_.decl.len = NULL;
21254 ffestb_local_.decl.lent = NULL;
21255 return (ffelexHandler) ffestb_decl_funcname_1_ (t);
21256
21257bad_0: /* :::::::::::::::::::: */
21258 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", ffesta_tokens[0]);
21259 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21260
21261bad_1: /* :::::::::::::::::::: */
21262 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
21263 return (ffelexHandler) ffelex_swallow_tokens (t,
21264 (ffelexHandler) ffesta_zero); /* Invalid second token. */
21265
21266bad_i: /* :::::::::::::::::::: */
21267 ffelex_token_kill (ffestb_local_.decl.recursive);
21268 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", nt, i, t);
21269 ffelex_token_kill (nt);
21270 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21271
21272bad_o: /* :::::::::::::::::::: */
21273 ffelex_token_kill (ffestb_local_.decl.recursive);
21274 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", ot);
21275 ffelex_token_kill (ot);
21276 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21277}
21278
21279/* ffestb_decl_recursive1_ -- "RECURSIVE" generic-type
21280
21281 return ffestb_decl_recursive1_; // to lexer
21282
21283 Handle ASTERISK, OPEN_PAREN, or NAME. */
21284
21285static ffelexHandler
21286ffestb_decl_recursive1_ (ffelexToken t)
21287{
21288 switch (ffelex_token_type (t))
21289 {
21290 case FFELEX_typeASTERISK:
21291 ffesta_confirmed ();
21292 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_func_;
21293 ffestb_local_.decl.badname = "TYPEFUNC";
21294 if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
21295 return (ffelexHandler) ffestb_decl_starlen_;
21296 return (ffelexHandler) ffestb_decl_starkind_;
21297
21298 case FFELEX_typeOPEN_PAREN:
21299 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_func_;
21300 ffestb_local_.decl.badname = "TYPEFUNC";
21301 if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
21302 {
21303 ffestb_local_.decl.kind = NULL;
21304 ffestb_local_.decl.kindt = NULL;
21305 ffestb_local_.decl.len = NULL;
21306 ffestb_local_.decl.lent = NULL;
21307 return (ffelexHandler) ffestb_decl_typeparams_;
21308 }
21309 return (ffelexHandler) ffestb_decl_kindparam_;
21310
21311 case FFELEX_typeNAME:
21312 ffestb_local_.decl.kind = NULL;
21313 ffestb_local_.decl.kindt = NULL;
21314 ffestb_local_.decl.len = NULL;
21315 ffestb_local_.decl.lent = NULL;
21316 return (ffelexHandler) ffestb_decl_func_ (t);
21317
21318 default:
21319 break;
21320 }
21321
21322 if (ffestb_local_.decl.recursive != NULL)
21323 ffelex_token_kill (ffestb_local_.decl.recursive);
21324 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
21325 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21326}
21327
21328/* ffestb_decl_recursive2_ -- "RECURSIVE" "DOUBLE"
21329
21330 return ffestb_decl_recursive2_; // to lexer
21331
21332 Handle NAME. */
21333
21334static ffelexHandler
21335ffestb_decl_recursive2_ (ffelexToken t)
21336{
21337 switch (ffelex_token_type (t))
21338 {
21339 case FFELEX_typeNAME:
21340 switch (ffestr_second (t))
21341 {
21342 case FFESTR_secondPRECISION:
21343 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
21344 break;
21345
21346 case FFESTR_secondCOMPLEX:
21347 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
21348 break;
21349
21350 default:
21351 goto bad; /* :::::::::::::::::::: */
21352 }
21353 ffestb_local_.decl.kind = NULL;
21354 ffestb_local_.decl.kindt = NULL;
21355 ffestb_local_.decl.len = NULL;
21356 ffestb_local_.decl.lent = NULL;
21357 return (ffelexHandler) ffestb_decl_func_;
21358
21359 default:
21360 break;
21361 }
21362
21363bad: /* :::::::::::::::::::: */
21364 if (ffestb_local_.decl.recursive != NULL)
21365 ffelex_token_kill (ffestb_local_.decl.recursive);
21366 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
21367 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21368}
21369
21370/* ffestb_decl_recursive3_ -- "RECURSIVE" "TYPE"
21371
21372 return ffestb_decl_recursive3_; // to lexer
21373
21374 Handle OPEN_PAREN. */
21375
21376static ffelexHandler
21377ffestb_decl_recursive3_ (ffelexToken t)
21378{
21379 switch (ffelex_token_type (t))
21380 {
21381 case FFELEX_typeOPEN_PAREN:
21382 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_func_;
21383 ffestb_local_.decl.badname = "TYPEFUNC";
21384 return (ffelexHandler) ffestb_decl_typetype1_;
21385
21386 default:
21387 break;
21388 }
21389
21390 if (ffestb_local_.decl.recursive != NULL)
21391 ffelex_token_kill (ffestb_local_.decl.recursive);
21392 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
21393 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21394}
21395
21396/* ffestb_decl_recursive4_ -- "RECURSIVE" "FUNCTION/SUBROUTINE"
21397
21398 return ffestb_decl_recursive4_; // to lexer
21399
21400 Handle OPEN_PAREN. */
21401
21402static ffelexHandler
21403ffestb_decl_recursive4_ (ffelexToken t)
21404{
21405 switch (ffelex_token_type (t))
21406 {
21407 case FFELEX_typeNAME:
21408 ffesta_tokens[1] = ffelex_token_use (t);
21409 return (ffelexHandler) ffestb_dummy1_;
21410
21411 default:
21412 break;
21413 }
21414
21415 if (ffestb_local_.decl.recursive != NULL)
21416 ffelex_token_kill (ffestb_local_.decl.recursive);
21417 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
21418 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21419}
21420
21421#endif
21422/* ffestb_decl_typetype -- Parse the R426/R501/R1219 TYPE statement
21423
21424 return ffestb_decl_typetype; // to lexer
21425
21426 Make sure the statement has a valid form for the TYPE statement. If it
21427 does, implement the statement. */
21428
21429#if FFESTR_F90
21430ffelexHandler
21431ffestb_decl_typetype (ffelexToken t)
21432{
21433 switch (ffelex_token_type (ffesta_tokens[0]))
21434 {
21435 case FFELEX_typeNAME:
21436 if (ffesta_first_kw != FFESTR_firstTYPE)
21437 goto bad_0; /* :::::::::::::::::::: */
21438 break;
21439
21440 case FFELEX_typeNAMES:
21441 if (ffesta_first_kw != FFESTR_firstTYPE)
21442 goto bad_0; /* :::::::::::::::::::: */
21443 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlTYPE)
21444 goto bad_0; /* :::::::::::::::::::: */
21445 break;
21446
21447 default:
21448 goto bad_0; /* :::::::::::::::::::: */
21449 }
21450
21451 switch (ffelex_token_type (t))
21452 {
21453 case FFELEX_typeOPEN_PAREN:
21454 break;
21455
21456 case FFELEX_typeEOS:
21457 case FFELEX_typeSEMICOLON:
21458 case FFELEX_typeCOLONCOLON:/* Not COMMA: R424 "TYPE,PUBLIC::A". */
21459 ffesta_confirmed (); /* Error, but clearly intended. */
21460 goto bad_1; /* :::::::::::::::::::: */
21461
21462 default:
21463 goto bad_1; /* :::::::::::::::::::: */
21464 }
21465
21466 ffestb_local_.decl.recursive = NULL;
21467 ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
21468 ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
21469
21470 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
21471 ffestb_local_.decl.badname = "type-declaration";
21472 return (ffelexHandler) ffestb_decl_typetype1_;
21473
21474bad_0: /* :::::::::::::::::::: */
21475 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
21476 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21477
21478bad_1: /* :::::::::::::::::::: */
21479 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
21480 return (ffelexHandler) ffelex_swallow_tokens (t,
21481 (ffelexHandler) ffesta_zero); /* Invalid second token. */
21482}
21483
21484#endif
21485/* ffestb_decl_attrs_ -- "type" [type parameters] COMMA
21486
21487 return ffestb_decl_attrs_; // to lexer
21488
21489 Handle NAME of an attribute. */
21490
21491static ffelexHandler
21492ffestb_decl_attrs_ (ffelexToken t)
21493{
21494 switch (ffelex_token_type (t))
21495 {
21496 case FFELEX_typeNAME:
21497 switch (ffestr_first (t))
21498 {
21499#if FFESTR_F90
21500 case FFESTR_firstALLOCATABLE:
21501 if (!ffesta_is_inhibited ())
21502 ffestc_decl_attrib (FFESTP_attribALLOCATABLE, t,
21503 FFESTR_otherNone, NULL);
21504 return (ffelexHandler) ffestb_decl_attrs_7_;
21505#endif
21506
21507 case FFESTR_firstDIMENSION:
21508 ffesta_tokens[1] = ffelex_token_use (t);
21509 return (ffelexHandler) ffestb_decl_attrs_1_;
21510
21511 case FFESTR_firstEXTERNAL:
21512 if (!ffesta_is_inhibited ())
21513 ffestc_decl_attrib (FFESTP_attribEXTERNAL, t,
21514 FFESTR_otherNone, NULL);
21515 return (ffelexHandler) ffestb_decl_attrs_7_;
21516
21517#if FFESTR_F90
21518 case FFESTR_firstINTENT:
21519 ffesta_tokens[1] = ffelex_token_use (t);
21520 return (ffelexHandler) ffestb_decl_attrs_3_;
21521#endif
21522
21523 case FFESTR_firstINTRINSIC:
21524 if (!ffesta_is_inhibited ())
21525 ffestc_decl_attrib (FFESTP_attribINTRINSIC, t,
21526 FFESTR_otherNone, NULL);
21527 return (ffelexHandler) ffestb_decl_attrs_7_;
21528
21529#if FFESTR_F90
21530 case FFESTR_firstOPTIONAL:
21531 if (!ffesta_is_inhibited ())
21532 ffestc_decl_attrib (FFESTP_attribOPTIONAL, t,
21533 FFESTR_otherNone, NULL);
21534 return (ffelexHandler) ffestb_decl_attrs_7_;
21535#endif
21536
21537 case FFESTR_firstPARAMETER:
21538 ffestb_local_.decl.parameter = TRUE;
21539 if (!ffesta_is_inhibited ())
21540 ffestc_decl_attrib (FFESTP_attribPARAMETER, t,
21541 FFESTR_otherNone, NULL);
21542 return (ffelexHandler) ffestb_decl_attrs_7_;
21543
21544#if FFESTR_F90
21545 case FFESTR_firstPOINTER:
21546 if (!ffesta_is_inhibited ())
21547 ffestc_decl_attrib (FFESTP_attribPOINTER, t,
21548 FFESTR_otherNone, NULL);
21549 return (ffelexHandler) ffestb_decl_attrs_7_;
21550#endif
21551
21552#if FFESTR_F90
21553 case FFESTR_firstPRIVATE:
21554 if (!ffesta_is_inhibited ())
21555 ffestc_decl_attrib (FFESTP_attribPRIVATE, t,
21556 FFESTR_otherNone, NULL);
21557 return (ffelexHandler) ffestb_decl_attrs_7_;
21558
21559 case FFESTR_firstPUBLIC:
21560 if (!ffesta_is_inhibited ())
21561 ffestc_decl_attrib (FFESTP_attribPUBLIC, t,
21562 FFESTR_otherNone, NULL);
21563 return (ffelexHandler) ffestb_decl_attrs_7_;
21564#endif
21565
21566 case FFESTR_firstSAVE:
21567 if (!ffesta_is_inhibited ())
21568 ffestc_decl_attrib (FFESTP_attribSAVE, t,
21569 FFESTR_otherNone, NULL);
21570 return (ffelexHandler) ffestb_decl_attrs_7_;
21571
21572#if FFESTR_F90
21573 case FFESTR_firstTARGET:
21574 if (!ffesta_is_inhibited ())
21575 ffestc_decl_attrib (FFESTP_attribTARGET, t,
21576 FFESTR_otherNone, NULL);
21577 return (ffelexHandler) ffestb_decl_attrs_7_;
21578#endif
21579
21580 default:
21581 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
21582 return (ffelexHandler) ffestb_decl_attrs_7_;
21583 }
21584 break;
21585
21586 default:
21587 break;
21588 }
21589
21590 if (!ffesta_is_inhibited ())
21591 ffestc_decl_finish ();
21592 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
21593 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21594}
21595
21596/* ffestb_decl_attrs_1_ -- "type" [type parameters] ",DIMENSION"
21597
21598 return ffestb_decl_attrs_1_; // to lexer
21599
21600 Handle OPEN_PAREN. */
21601
21602static ffelexHandler
21603ffestb_decl_attrs_1_ (ffelexToken t)
21604{
21605 switch (ffelex_token_type (t))
21606 {
21607 case FFELEX_typeOPEN_PAREN:
21608 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
21609 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_decl_attrs_2_;
21610 ffestb_subrargs_.dim_list.pool = ffesta_scratch_pool;
21611 ffestb_subrargs_.dim_list.ctx = ffesta_is_entry_valid
21612 ? FFEEXPR_contextDIMLIST : FFEEXPR_contextDIMLISTCOMMON;
21613#ifdef FFECOM_dimensionsMAX
21614 ffestb_subrargs_.dim_list.ndims = 0;
21615#endif
21616 return (ffelexHandler) ffeexpr_rhs (ffesta_scratch_pool,
21617 ffestb_subrargs_.dim_list.ctx,
21618 (ffeexprCallback) ffestb_subr_dimlist_);
21619
21620 case FFELEX_typeCOMMA:
21621 case FFELEX_typeCOLONCOLON:
21622 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, ffesta_tokens[1]);
21623 ffelex_token_kill (ffesta_tokens[1]);
21624 return (ffelexHandler) ffestb_decl_attrs_7_ (t);
21625
21626 default:
21627 break;
21628 }
21629
21630 if (!ffesta_is_inhibited ())
21631 ffestc_decl_finish ();
21632 ffelex_token_kill (ffesta_tokens[1]);
21633 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
21634 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21635}
21636
21637/* ffestb_decl_attrs_2_ -- "type" [type parameters] ",DIMENSION" OPEN_PAREN
21638 dimlist CLOSE_PAREN
21639
21640 return ffestb_decl_attrs_2_; // to lexer
21641
21642 Handle COMMA or COLONCOLON. */
21643
21644static ffelexHandler
21645ffestb_decl_attrs_2_ (ffelexToken t)
21646{
21647 if (!ffestb_subrargs_.dim_list.ok)
21648 goto bad; /* :::::::::::::::::::: */
21649
21650 switch (ffelex_token_type (t))
21651 {
21652 case FFELEX_typeCOMMA:
21653 case FFELEX_typeCOLONCOLON:
21654 if (!ffesta_is_inhibited ())
21655 ffestc_decl_attrib (FFESTP_attribDIMENSION, ffesta_tokens[1],
21656 FFESTR_otherNone, ffestb_subrargs_.dim_list.dims);
21657 ffelex_token_kill (ffesta_tokens[1]);
21658 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
21659 return (ffelexHandler) ffestb_decl_attrs_7_ (t);
21660
21661 default:
21662 break;
21663 }
21664
21665bad: /* :::::::::::::::::::: */
21666 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
21667 if (!ffesta_is_inhibited ())
21668 ffestc_decl_finish ();
21669 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
21670 ffelex_token_kill (ffesta_tokens[1]);
21671 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21672}
21673
21674/* ffestb_decl_attrs_3_ -- "type" [type parameters] ",INTENT"
21675
21676 return ffestb_decl_attrs_3_; // to lexer
21677
21678 Handle OPEN_PAREN. */
21679
21680#if FFESTR_F90
21681static ffelexHandler
21682ffestb_decl_attrs_3_ (ffelexToken t)
21683{
21684 switch (ffelex_token_type (t))
21685 {
21686 case FFELEX_typeOPEN_PAREN:
21687 return (ffelexHandler) ffestb_decl_attrs_4_;
21688
21689 case FFELEX_typeCOMMA:
21690 case FFELEX_typeCOLONCOLON:
21691 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, ffesta_tokens[1]);
21692 ffelex_token_kill (ffesta_tokens[1]);
21693 return (ffelexHandler) ffestb_decl_attrs_7_ (t);
21694
21695 default:
21696 break;
21697 }
21698
21699 if (!ffesta_is_inhibited ())
21700 ffestc_decl_finish ();
21701 ffelex_token_kill (ffesta_tokens[1]);
21702 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
21703 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21704}
21705
21706/* ffestb_decl_attrs_4_ -- "type" [type parameters] ",INTENT" OPEN_PAREN
21707
21708 return ffestb_decl_attrs_4_; // to lexer
21709
21710 Handle NAME. */
21711
21712static ffelexHandler
21713ffestb_decl_attrs_4_ (ffelexToken t)
21714{
21715 switch (ffelex_token_type (t))
21716 {
21717 case FFELEX_typeNAME:
21718 ffestb_local_.decl.kw = ffestr_other (t);
21719 switch (ffestb_local_.decl.kw)
21720 {
21721 case FFESTR_otherIN:
21722 return (ffelexHandler) ffestb_decl_attrs_5_;
21723
21724 case FFESTR_otherINOUT:
21725 return (ffelexHandler) ffestb_decl_attrs_6_;
21726
21727 case FFESTR_otherOUT:
21728 return (ffelexHandler) ffestb_decl_attrs_6_;
21729
21730 default:
21731 ffestb_local_.decl.kw = FFESTR_otherNone;
21732 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
21733 return (ffelexHandler) ffestb_decl_attrs_5_;
21734 }
21735 break;
21736
21737 default:
21738 break;
21739 }
21740
21741 if (!ffesta_is_inhibited ())
21742 ffestc_decl_finish ();
21743 ffelex_token_kill (ffesta_tokens[1]);
21744 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
21745 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21746}
21747
21748/* ffestb_decl_attrs_5_ -- "type" [type parameters] ",INTENT" OPEN_PAREN "IN"
21749
21750 return ffestb_decl_attrs_5_; // to lexer
21751
21752 Handle NAME or CLOSE_PAREN. */
21753
21754static ffelexHandler
21755ffestb_decl_attrs_5_ (ffelexToken t)
21756{
21757 switch (ffelex_token_type (t))
21758 {
21759 case FFELEX_typeNAME:
21760 switch (ffestr_other (t))
21761 {
21762 case FFESTR_otherOUT:
21763 if (ffestb_local_.decl.kw != FFESTR_otherNone)
21764 ffestb_local_.decl.kw = FFESTR_otherINOUT;
21765 return (ffelexHandler) ffestb_decl_attrs_6_;
21766
21767 default:
21768 if (ffestb_local_.decl.kw != FFESTR_otherNone)
21769 {
21770 ffestb_local_.decl.kw = FFESTR_otherNone;
21771 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
21772 }
21773 return (ffelexHandler) ffestb_decl_attrs_5_;
21774 }
21775 break;
21776
21777 case FFELEX_typeCLOSE_PAREN:
21778 return (ffelexHandler) ffestb_decl_attrs_6_ (t);
21779
21780 default:
21781 break;
21782 }
21783
21784 if (!ffesta_is_inhibited ())
21785 ffestc_decl_finish ();
21786 ffelex_token_kill (ffesta_tokens[1]);
21787 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
21788 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21789}
21790
21791/* ffestb_decl_attrs_6_ -- "type" [type parameters] ",INTENT" OPEN_PAREN "IN"
21792 ["OUT"]
21793
21794 return ffestb_decl_attrs_6_; // to lexer
21795
21796 Handle CLOSE_PAREN. */
21797
21798static ffelexHandler
21799ffestb_decl_attrs_6_ (ffelexToken t)
21800{
21801 switch (ffelex_token_type (t))
21802 {
21803 case FFELEX_typeCLOSE_PAREN:
21804 if ((ffestb_local_.decl.kw != FFESTR_otherNone)
21805 && !ffesta_is_inhibited ())
21806 ffestc_decl_attrib (FFESTP_attribINTENT, ffesta_tokens[1],
21807 ffestb_local_.decl.kw, NULL);
21808 ffelex_token_kill (ffesta_tokens[1]);
21809 return (ffelexHandler) ffestb_decl_attrs_7_;
21810
21811 default:
21812 break;
21813 }
21814
21815 if (!ffesta_is_inhibited ())
21816 ffestc_decl_finish ();
21817 ffelex_token_kill (ffesta_tokens[1]);
21818 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
21819 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21820}
21821
21822#endif
21823/* ffestb_decl_attrs_7_ -- "type" [type parameters] attribute
21824
21825 return ffestb_decl_attrs_7_; // to lexer
21826
21827 Handle COMMA (another attribute) or COLONCOLON (entities). */
21828
21829static ffelexHandler
21830ffestb_decl_attrs_7_ (ffelexToken t)
21831{
21832 switch (ffelex_token_type (t))
21833 {
21834 case FFELEX_typeCOMMA:
21835 return (ffelexHandler) ffestb_decl_attrs_;
21836
21837 case FFELEX_typeCOLONCOLON:
21838 ffestb_local_.decl.coloncolon = TRUE;
21839 return (ffelexHandler) ffestb_decl_ents_;
21840
21841 default:
21842 break;
21843 }
21844
21845 if (!ffesta_is_inhibited ())
21846 ffestc_decl_finish ();
21847 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
21848 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21849}
21850
21851/* ffestb_decl_attrsp_ -- "type" [type parameters]
21852
21853 return ffestb_decl_attrsp_; // to lexer
21854
21855 Handle COMMA (meaning we have attributes), COLONCOLON (meaning we have
21856 no attributes but entities), or go to entsp to see about functions or
21857 entities. */
21858
21859static ffelexHandler
21860ffestb_decl_attrsp_ (ffelexToken t)
21861{
21862 ffelex_set_names (FALSE);
21863
21864 switch (ffelex_token_type (t))
21865 {
21866 case FFELEX_typeCOMMA:
21867 ffesta_confirmed ();
21868 if (!ffesta_is_inhibited ())
21869 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
21870 ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
21871 ffestb_local_.decl.len, ffestb_local_.decl.lent);
21872 if (ffestb_local_.decl.kindt != NULL)
21873 ffelex_token_kill (ffestb_local_.decl.kindt);
21874 if (ffestb_local_.decl.lent != NULL)
21875 ffelex_token_kill (ffestb_local_.decl.lent);
21876 return (ffelexHandler) ffestb_decl_attrs_;
21877
21878 case FFELEX_typeCOLONCOLON:
21879 ffestb_local_.decl.coloncolon = TRUE;
21880 ffesta_confirmed ();
21881 if (!ffesta_is_inhibited ())
21882 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
21883 ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
21884 ffestb_local_.decl.len, ffestb_local_.decl.lent);
21885 if (ffestb_local_.decl.kindt != NULL)
21886 ffelex_token_kill (ffestb_local_.decl.kindt);
21887 if (ffestb_local_.decl.lent != NULL)
21888 ffelex_token_kill (ffestb_local_.decl.lent);
21889 return (ffelexHandler) ffestb_decl_ents_;
21890
21891 default:
21892 return (ffelexHandler) ffestb_decl_entsp_ (t);
21893 }
21894}
21895
21896/* ffestb_decl_ents_ -- "type" [type parameters] [attributes "::"]
21897
21898 return ffestb_decl_ents_; // to lexer
21899
21900 Handle NAME of an entity. */
21901
21902static ffelexHandler
21903ffestb_decl_ents_ (ffelexToken t)
21904{
21905 switch (ffelex_token_type (t))
21906 {
21907 case FFELEX_typeNAME:
21908 ffesta_tokens[1] = ffelex_token_use (t);
21909 return (ffelexHandler) ffestb_decl_ents_1_;
21910
21911 default:
21912 break;
21913 }
21914
21915 if (!ffesta_is_inhibited ())
21916 ffestc_decl_finish ();
21917 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
21918 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21919}
21920
21921/* ffestb_decl_ents_1_ -- "type" [type parameters] [attributes "::"] NAME
21922
21923 return ffestb_decl_ents_1_; // to lexer
21924
21925 Handle ASTERISK, OPEN_PAREN, EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */
21926
21927static ffelexHandler
21928ffestb_decl_ents_1_ (ffelexToken t)
21929{
21930 switch (ffelex_token_type (t))
21931 {
21932 case FFELEX_typeCOMMA:
21933 if (!ffesta_is_inhibited ())
21934 ffestc_decl_item (ffesta_tokens[1], NULL, NULL, NULL, NULL, NULL, NULL,
21935 NULL, FALSE);
21936 ffelex_token_kill (ffesta_tokens[1]);
21937 return (ffelexHandler) ffestb_decl_ents_;
21938
21939 case FFELEX_typeEOS:
21940 case FFELEX_typeSEMICOLON:
21941 if (!ffesta_is_inhibited ())
21942 {
21943 ffestc_decl_item (ffesta_tokens[1], NULL, NULL, NULL, NULL, NULL, NULL,
21944 NULL, FALSE);
21945 ffestc_decl_finish ();
21946 }
21947 ffelex_token_kill (ffesta_tokens[1]);
21948 return (ffelexHandler) ffesta_zero (t);
21949
21950 case FFELEX_typeASTERISK:
21951 ffestb_local_.decl.len = NULL;
21952 ffestb_local_.decl.lent = NULL;
21953 return (ffelexHandler) ffestb_decl_ents_2_;
21954
21955 case FFELEX_typeOPEN_PAREN:
21956 ffestb_local_.decl.kind = NULL;
21957 ffestb_local_.decl.kindt = NULL;
21958 ffestb_local_.decl.len = NULL;
21959 ffestb_local_.decl.lent = NULL;
21960 return (ffelexHandler) ffestb_decl_ents_3_ (t);
21961
21962 case FFELEX_typeEQUALS:
21963 case FFELEX_typeSLASH:
21964 ffestb_local_.decl.kind = NULL;
21965 ffestb_local_.decl.kindt = NULL;
21966 ffestb_subrargs_.dim_list.dims = NULL;
21967 ffestb_local_.decl.len = NULL;
21968 ffestb_local_.decl.lent = NULL;
21969 return (ffelexHandler) ffestb_decl_ents_7_ (t);
21970
21971 default:
21972 break;
21973 }
21974
21975 if (!ffesta_is_inhibited ())
21976 ffestc_decl_finish ();
21977 ffelex_token_kill (ffesta_tokens[1]);
21978 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
21979 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21980}
21981
21982/* ffestb_decl_ents_2_ -- "type" [type parameters] [attributes "::"] NAME
21983 ASTERISK
21984
21985 return ffestb_decl_ents_2_; // to lexer
21986
21987 Handle NUMBER or OPEN_PAREN. */
21988
21989static ffelexHandler
21990ffestb_decl_ents_2_ (ffelexToken t)
21991{
21992 switch (ffelex_token_type (t))
21993 {
21994 case FFELEX_typeNUMBER:
21995 if (ffestb_local_.decl.type != FFESTP_typeCHARACTER)
21996 {
21997 ffestb_local_.decl.kind = NULL;
21998 ffestb_local_.decl.kindt = ffelex_token_use (t);
21999 return (ffelexHandler) ffestb_decl_ents_3_;
22000 }
22001 /* Fall through. *//* (CHARACTER's *n is always a len spec. */
22002 case FFELEX_typeOPEN_PAREN:/* "*(" is after the (omitted)
22003 "(array-spec)". */
22004 ffestb_local_.decl.kind = NULL;
22005 ffestb_local_.decl.kindt = NULL;
22006 ffestb_subrargs_.dim_list.dims = NULL;
22007 return (ffelexHandler) ffestb_decl_ents_5_ (t);
22008
22009 default:
22010 break;
22011 }
22012
22013 if (!ffesta_is_inhibited ())
22014 ffestc_decl_finish ();
22015 ffelex_token_kill (ffesta_tokens[1]);
22016 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22017 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22018}
22019
22020/* ffestb_decl_ents_3_ -- "type" [type parameters] [attributes "::"] NAME
22021 [ASTERISK NUMBER]
22022
22023 return ffestb_decl_ents_3_; // to lexer
22024
22025 Handle ASTERISK, OPEN_PAREN, EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */
22026
22027static ffelexHandler
22028ffestb_decl_ents_3_ (ffelexToken t)
22029{
22030 switch (ffelex_token_type (t))
22031 {
22032 case FFELEX_typeCOMMA:
22033 if (!ffesta_is_inhibited ())
22034 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
22035 ffestb_local_.decl.kindt, NULL, NULL, NULL, NULL, NULL, FALSE);
22036 ffelex_token_kill (ffesta_tokens[1]);
22037 if (ffestb_local_.decl.kindt != NULL)
22038 ffelex_token_kill (ffestb_local_.decl.kindt);
22039 return (ffelexHandler) ffestb_decl_ents_;
22040
22041 case FFELEX_typeEOS:
22042 case FFELEX_typeSEMICOLON:
22043 if (!ffesta_is_inhibited ())
22044 {
22045 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
22046 ffestb_local_.decl.kindt, NULL, NULL, NULL, NULL, NULL, FALSE);
22047 ffestc_decl_finish ();
22048 }
22049 ffelex_token_kill (ffesta_tokens[1]);
22050 if (ffestb_local_.decl.kindt != NULL)
22051 ffelex_token_kill (ffestb_local_.decl.kindt);
22052 return (ffelexHandler) ffesta_zero (t);
22053
22054 case FFELEX_typeASTERISK:
22055 ffestb_subrargs_.dim_list.dims = NULL;
22056 return (ffelexHandler) ffestb_decl_ents_5_;
22057
22058 case FFELEX_typeOPEN_PAREN:
22059 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
22060 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_decl_ents_4_;
22061 ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
22062 ffestb_subrargs_.dim_list.ctx = ffesta_is_entry_valid
22063 ? FFEEXPR_contextDIMLIST : FFEEXPR_contextDIMLISTCOMMON;
22064#ifdef FFECOM_dimensionsMAX
22065 ffestb_subrargs_.dim_list.ndims = 0;
22066#endif
22067 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
22068 ffestb_subrargs_.dim_list.ctx,
22069 (ffeexprCallback) ffestb_subr_dimlist_);
22070
22071 case FFELEX_typeEQUALS:
22072 case FFELEX_typeSLASH:
22073 ffestb_local_.decl.kind = NULL;
22074 ffestb_local_.decl.kindt = NULL;
22075 ffestb_subrargs_.dim_list.dims = NULL;
22076 ffestb_local_.decl.len = NULL;
22077 ffestb_local_.decl.lent = NULL;
22078 return (ffelexHandler) ffestb_decl_ents_7_ (t);
22079
22080 default:
22081 break;
22082 }
22083
22084 if (!ffesta_is_inhibited ())
22085 ffestc_decl_finish ();
22086 ffelex_token_kill (ffesta_tokens[1]);
22087 if (ffestb_local_.decl.kindt != NULL)
22088 ffelex_token_kill (ffestb_local_.decl.kindt);
22089 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22090 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22091}
22092
22093/* ffestb_decl_ents_4_ -- "type" [type parameters] [attributes "::"] NAME
22094 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
22095
22096 return ffestb_decl_ents_4_; // to lexer
22097
22098 Handle ASTERISK, EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */
22099
22100static ffelexHandler
22101ffestb_decl_ents_4_ (ffelexToken t)
22102{
22103 ffelexToken nt;
22104
22105 if (!ffestb_subrargs_.dim_list.ok)
22106 goto bad; /* :::::::::::::::::::: */
22107
22108 if (ffelex_token_type (ffesta_tokens[1]) == FFELEX_typeNAMES)
22109 {
22110 switch (ffelex_token_type (t))
22111 {
22112 case FFELEX_typeCOMMA:
22113 case FFELEX_typeEOS:
22114 case FFELEX_typeSEMICOLON:
22115 case FFELEX_typeASTERISK:
22116 case FFELEX_typeSLASH: /* But NOT FFELEX_typeEQUALS. */
22117 case FFELEX_typeCOLONCOLON: /* Actually an error. */
22118 break; /* Confirm and handle. */
22119
22120 default: /* Perhaps EQUALS, as in
22121 INTEGERFUNCTIONX(A)=B. */
22122 goto bad; /* :::::::::::::::::::: */
22123 }
22124 ffesta_confirmed ();
22125 if (!ffesta_is_inhibited ())
22126 {
22127 nt = ffelex_token_name_from_names (ffesta_tokens[1], 0, 0);
22128 ffelex_token_kill (ffesta_tokens[1]);
22129 ffesta_tokens[1] = nt;
22130 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
22131 NULL, NULL, NULL, NULL);
22132 }
22133 }
22134
22135 switch (ffelex_token_type (t))
22136 {
22137 case FFELEX_typeCOMMA:
22138 if (!ffesta_is_inhibited ())
22139 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
22140 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
22141 ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
22142 FALSE);
22143 ffelex_token_kill (ffesta_tokens[1]);
22144 if (ffestb_local_.decl.kindt != NULL)
22145 ffelex_token_kill (ffestb_local_.decl.kindt);
22146 if (ffestb_local_.decl.lent != NULL)
22147 ffelex_token_kill (ffestb_local_.decl.lent);
22148 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22149 return (ffelexHandler) ffestb_decl_ents_;
22150
22151 case FFELEX_typeEOS:
22152 case FFELEX_typeSEMICOLON:
22153 if (!ffesta_is_inhibited ())
22154 {
22155 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
22156 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
22157 ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
22158 FALSE);
22159 ffestc_decl_finish ();
22160 }
22161 ffelex_token_kill (ffesta_tokens[1]);
22162 if (ffestb_local_.decl.kindt != NULL)
22163 ffelex_token_kill (ffestb_local_.decl.kindt);
22164 if (ffestb_local_.decl.lent != NULL)
22165 ffelex_token_kill (ffestb_local_.decl.lent);
22166 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22167 return (ffelexHandler) ffesta_zero (t);
22168
22169 case FFELEX_typeASTERISK:
22170 if (ffestb_local_.decl.lent != NULL)
22171 break; /* Can't specify "*length" twice. */
22172 return (ffelexHandler) ffestb_decl_ents_5_;
22173
22174 case FFELEX_typeEQUALS:
22175 case FFELEX_typeSLASH:
22176 return (ffelexHandler) ffestb_decl_ents_7_ (t);
22177
22178 default:
22179 break;
22180 }
22181
22182bad: /* :::::::::::::::::::: */
22183 if ((ffelex_token_type (ffesta_tokens[1]) != FFELEX_typeNAMES)
22184 && !ffesta_is_inhibited ())
22185 ffestc_decl_finish ();
22186 ffelex_token_kill (ffesta_tokens[1]);
22187 if (ffestb_local_.decl.kindt != NULL)
22188 ffelex_token_kill (ffestb_local_.decl.kindt);
22189 if (ffestb_local_.decl.lent != NULL)
22190 ffelex_token_kill (ffestb_local_.decl.lent);
22191 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22192 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22193 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22194}
22195
22196/* ffestb_decl_ents_5_ -- "type" [type parameters] [attributes "::"] NAME
22197 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
22198 ASTERISK
22199
22200 return ffestb_decl_ents_5_; // to lexer
22201
22202 Handle NUMBER or OPEN_PAREN. */
22203
22204static ffelexHandler
22205ffestb_decl_ents_5_ (ffelexToken t)
22206{
22207 switch (ffelex_token_type (t))
22208 {
22209 case FFELEX_typeNUMBER:
22210 ffestb_local_.decl.len = NULL;
22211 ffestb_local_.decl.lent = ffelex_token_use (t);
22212 return (ffelexHandler) ffestb_decl_ents_7_;
22213
22214 case FFELEX_typeOPEN_PAREN:
22215 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
22216 FFEEXPR_contextCHARACTERSIZE, (ffeexprCallback) ffestb_decl_ents_6_);
22217
22218 default:
22219 break;
22220 }
22221
22222 if (!ffesta_is_inhibited ())
22223 ffestc_decl_finish ();
22224 ffelex_token_kill (ffesta_tokens[1]);
22225 if (ffestb_local_.decl.kindt != NULL)
22226 ffelex_token_kill (ffestb_local_.decl.kindt);
22227 if (ffestb_subrargs_.dim_list.dims != NULL)
22228 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22229 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22230 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22231}
22232
22233/* ffestb_decl_ents_6_ -- "type" [type parameters] [attributes "::"] NAME
22234 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
22235 ASTERISK OPEN_PAREN expr
22236
22237 (ffestb_decl_ents_6_) // to expression handler
22238
22239 Handle CLOSE_PAREN. */
22240
22241static ffelexHandler
22242ffestb_decl_ents_6_ (ffelexToken ft, ffebld expr, ffelexToken t)
22243{
22244 switch (ffelex_token_type (t))
22245 {
22246 case FFELEX_typeCLOSE_PAREN:
22247 if (expr == NULL)
22248 break;
22249 ffestb_local_.decl.len = expr;
22250 ffestb_local_.decl.lent = ffelex_token_use (ft);
22251 return (ffelexHandler) ffestb_decl_ents_7_;
22252
22253 default:
22254 break;
22255 }
22256
22257 if (!ffesta_is_inhibited ())
22258 ffestc_decl_finish ();
22259 ffelex_token_kill (ffesta_tokens[1]);
22260 if (ffestb_local_.decl.kindt != NULL)
22261 ffelex_token_kill (ffestb_local_.decl.kindt);
22262 if (ffestb_subrargs_.dim_list.dims != NULL)
22263 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22264 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22265 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22266}
22267
22268/* ffestb_decl_ents_7_ -- "type" [type parameters] [attributes "::"] NAME
22269 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
22270 [ASTERISK charlength]
22271
22272 return ffestb_decl_ents_7_; // to lexer
22273
22274 Handle EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */
22275
22276static ffelexHandler
22277ffestb_decl_ents_7_ (ffelexToken t)
22278{
22279 switch (ffelex_token_type (t))
22280 {
22281 case FFELEX_typeCOMMA:
22282 if (!ffesta_is_inhibited ())
22283 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
22284 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
22285 ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
22286 FALSE);
22287 ffelex_token_kill (ffesta_tokens[1]);
22288 if (ffestb_local_.decl.kindt != NULL)
22289 ffelex_token_kill (ffestb_local_.decl.kindt);
22290 if (ffestb_subrargs_.dim_list.dims != NULL)
22291 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22292 if (ffestb_local_.decl.lent != NULL)
22293 ffelex_token_kill (ffestb_local_.decl.lent);
22294 return (ffelexHandler) ffestb_decl_ents_;
22295
22296 case FFELEX_typeEOS:
22297 case FFELEX_typeSEMICOLON:
22298 if (!ffesta_is_inhibited ())
22299 {
22300 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
22301 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
22302 ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
22303 FALSE);
22304 ffestc_decl_finish ();
22305 }
22306 ffelex_token_kill (ffesta_tokens[1]);
22307 if (ffestb_local_.decl.kindt != NULL)
22308 ffelex_token_kill (ffestb_local_.decl.kindt);
22309 if (ffestb_subrargs_.dim_list.dims != NULL)
22310 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22311 if (ffestb_local_.decl.lent != NULL)
22312 ffelex_token_kill (ffestb_local_.decl.lent);
22313 return (ffelexHandler) ffesta_zero (t);
22314
22315 case FFELEX_typeEQUALS:
22316 if (!ffestb_local_.decl.coloncolon)
22317 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_INIT, t);
22318 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
22319 ffestb_local_.decl.parameter ? FFEEXPR_contextPARAMETER
22320 : FFEEXPR_contextINITVAL, (ffeexprCallback) ffestb_decl_ents_8_);
22321
22322 case FFELEX_typeSLASH:
22323 if (!ffesta_is_inhibited ())
22324 {
22325 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
22326 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
22327 ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
22328 TRUE);
22329 ffestc_decl_itemstartvals ();
22330 }
22331 ffelex_token_kill (ffesta_tokens[1]);
22332 if (ffestb_local_.decl.kindt != NULL)
22333 ffelex_token_kill (ffestb_local_.decl.kindt);
22334 if (ffestb_subrargs_.dim_list.dims != NULL)
22335 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22336 if (ffestb_local_.decl.lent != NULL)
22337 ffelex_token_kill (ffestb_local_.decl.lent);
22338 return (ffelexHandler) ffeexpr_rhs
22339 (ffesta_output_pool, FFEEXPR_contextDATA,
22340 (ffeexprCallback) ffestb_decl_ents_9_);
22341
22342 default:
22343 break;
22344 }
22345
22346 if (!ffesta_is_inhibited ())
22347 ffestc_decl_finish ();
22348 ffelex_token_kill (ffesta_tokens[1]);
22349 if (ffestb_local_.decl.kindt != NULL)
22350 ffelex_token_kill (ffestb_local_.decl.kindt);
22351 if (ffestb_subrargs_.dim_list.dims != NULL)
22352 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22353 if (ffestb_local_.decl.lent != NULL)
22354 ffelex_token_kill (ffestb_local_.decl.lent);
22355 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22356 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22357}
22358
22359/* ffestb_decl_ents_8_ -- "type" [type parameters] [attributes "::"] NAME
22360 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
22361 [ASTERISK charlength] EQUALS expr
22362
22363 (ffestb_decl_ents_8_) // to expression handler
22364
22365 Handle COMMA or EOS/SEMICOLON. */
22366
22367static ffelexHandler
22368ffestb_decl_ents_8_ (ffelexToken ft, ffebld expr, ffelexToken t)
22369{
22370 switch (ffelex_token_type (t))
22371 {
22372 case FFELEX_typeCOMMA:
22373 if (expr == NULL)
22374 break;
22375 if (!ffesta_is_inhibited ())
22376 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
22377 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
22378 ffestb_local_.decl.len, ffestb_local_.decl.lent, expr, ft,
22379 FALSE);
22380 ffelex_token_kill (ffesta_tokens[1]);
22381 if (ffestb_local_.decl.kindt != NULL)
22382 ffelex_token_kill (ffestb_local_.decl.kindt);
22383 if (ffestb_subrargs_.dim_list.dims != NULL)
22384 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22385 if (ffestb_local_.decl.lent != NULL)
22386 ffelex_token_kill (ffestb_local_.decl.lent);
22387 return (ffelexHandler) ffestb_decl_ents_;
22388
22389 case FFELEX_typeEOS:
22390 case FFELEX_typeSEMICOLON:
22391 if (!ffesta_is_inhibited ())
22392 {
22393 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
22394 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
22395 ffestb_local_.decl.len, ffestb_local_.decl.lent, expr, ft,
22396 FALSE);
22397 ffestc_decl_finish ();
22398 }
22399 ffelex_token_kill (ffesta_tokens[1]);
22400 if (ffestb_local_.decl.kindt != NULL)
22401 ffelex_token_kill (ffestb_local_.decl.kindt);
22402 if (ffestb_subrargs_.dim_list.dims != NULL)
22403 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22404 if (ffestb_local_.decl.lent != NULL)
22405 ffelex_token_kill (ffestb_local_.decl.lent);
22406 return (ffelexHandler) ffesta_zero (t);
22407
22408 default:
22409 break;
22410 }
22411
22412 if (!ffesta_is_inhibited ())
22413 ffestc_decl_finish ();
22414 ffelex_token_kill (ffesta_tokens[1]);
22415 if (ffestb_local_.decl.kindt != NULL)
22416 ffelex_token_kill (ffestb_local_.decl.kindt);
22417 if (ffestb_subrargs_.dim_list.dims != NULL)
22418 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22419 if (ffestb_local_.decl.lent != NULL)
22420 ffelex_token_kill (ffestb_local_.decl.lent);
22421 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22422 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22423}
22424
22425/* ffestb_decl_ents_9_ -- "type" ... SLASH expr
22426
22427 (ffestb_decl_ents_9_) // to expression handler
22428
22429 Handle ASTERISK, COMMA, or SLASH. */
22430
22431static ffelexHandler
22432ffestb_decl_ents_9_ (ffelexToken ft, ffebld expr, ffelexToken t)
22433{
22434 switch (ffelex_token_type (t))
22435 {
22436 case FFELEX_typeCOMMA:
22437 if (expr == NULL)
22438 break;
22439 if (!ffesta_is_inhibited ())
22440 ffestc_decl_itemvalue (NULL, NULL, expr, ft);
22441 return (ffelexHandler) ffeexpr_rhs
22442 (ffesta_output_pool, FFEEXPR_contextDATA,
22443 (ffeexprCallback) ffestb_decl_ents_9_);
22444
22445 case FFELEX_typeASTERISK:
22446 if (expr == NULL)
22447 break;
22448 ffestb_local_.decl.expr = expr;
22449 ffesta_tokens[1] = ffelex_token_use (ft);
22450 return (ffelexHandler) ffeexpr_rhs
22451 (ffesta_output_pool, FFEEXPR_contextDATA,
22452 (ffeexprCallback) ffestb_decl_ents_10_);
22453
22454 case FFELEX_typeSLASH:
22455 if (expr == NULL)
22456 break;
22457 if (!ffesta_is_inhibited ())
22458 {
22459 ffestc_decl_itemvalue (NULL, NULL, expr, ft);
22460 ffestc_decl_itemendvals (t);
22461 }
22462 return (ffelexHandler) ffestb_decl_ents_11_;
22463
22464 default:
22465 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22466 break;
22467 }
22468
22469 if (!ffesta_is_inhibited ())
22470 {
22471 ffestc_decl_itemendvals (t);
22472 ffestc_decl_finish ();
22473 }
22474 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22475}
22476
22477/* ffestb_decl_ents_10_ -- "type" ... SLASH expr ASTERISK expr
22478
22479 (ffestb_decl_ents_10_) // to expression handler
22480
22481 Handle COMMA or SLASH. */
22482
22483static ffelexHandler
22484ffestb_decl_ents_10_ (ffelexToken ft, ffebld expr, ffelexToken t)
22485{
22486 switch (ffelex_token_type (t))
22487 {
22488 case FFELEX_typeCOMMA:
22489 if (expr == NULL)
22490 break;
22491 if (!ffesta_is_inhibited ())
22492 ffestc_decl_itemvalue (ffestb_local_.decl.expr, ffesta_tokens[1],
22493 expr, ft);
22494 ffelex_token_kill (ffesta_tokens[1]);
22495 return (ffelexHandler) ffeexpr_rhs
22496 (ffesta_output_pool, FFEEXPR_contextDATA,
22497 (ffeexprCallback) ffestb_decl_ents_9_);
22498
22499 case FFELEX_typeSLASH:
22500 if (expr == NULL)
22501 break;
22502 if (!ffesta_is_inhibited ())
22503 {
22504 ffestc_decl_itemvalue (ffestb_local_.decl.expr, ffesta_tokens[1],
22505 expr, ft);
22506 ffestc_decl_itemendvals (t);
22507 }
22508 ffelex_token_kill (ffesta_tokens[1]);
22509 return (ffelexHandler) ffestb_decl_ents_11_;
22510
22511 default:
22512 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22513 break;
22514 }
22515
22516 if (!ffesta_is_inhibited ())
22517 {
22518 ffestc_decl_itemendvals (t);
22519 ffestc_decl_finish ();
22520 }
22521 ffelex_token_kill (ffesta_tokens[1]);
22522 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22523}
22524
22525/* ffestb_decl_ents_11_ -- "type" [type parameters] [attributes "::"] NAME
22526 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
22527 [ASTERISK charlength] SLASH initvals SLASH
22528
22529 return ffestb_decl_ents_11_; // to lexer
22530
22531 Handle COMMA or EOS/SEMICOLON. */
22532
22533static ffelexHandler
22534ffestb_decl_ents_11_ (ffelexToken t)
22535{
22536 switch (ffelex_token_type (t))
22537 {
22538 case FFELEX_typeCOMMA:
22539 return (ffelexHandler) ffestb_decl_ents_;
22540
22541 case FFELEX_typeEOS:
22542 case FFELEX_typeSEMICOLON:
22543 if (!ffesta_is_inhibited ())
22544 ffestc_decl_finish ();
22545 return (ffelexHandler) ffesta_zero (t);
22546
22547 default:
22548 break;
22549 }
22550
22551 if (!ffesta_is_inhibited ())
22552 ffestc_decl_finish ();
22553 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22554 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22555}
22556
22557/* ffestb_decl_entsp_ -- "type" [type parameters]
22558
22559 return ffestb_decl_entsp_; // to lexer
22560
22561 Handle NAME or NAMES beginning either an entity (object) declaration or
22562 a function definition.. */
22563
22564static ffelexHandler
22565ffestb_decl_entsp_ (ffelexToken t)
22566{
22567 switch (ffelex_token_type (t))
22568 {
22569 case FFELEX_typeNAME:
22570 ffesta_confirmed ();
22571 ffesta_tokens[1] = ffelex_token_use (t);
22572 return (ffelexHandler) ffestb_decl_entsp_1_;
22573
22574 case FFELEX_typeNAMES:
22575 ffesta_confirmed ();
22576 ffesta_tokens[1] = ffelex_token_use (t);
22577 return (ffelexHandler) ffestb_decl_entsp_2_;
22578
22579 default:
22580 break;
22581 }
22582
22583 if (ffestb_local_.decl.kindt != NULL)
22584 ffelex_token_kill (ffestb_local_.decl.kindt);
22585 if (ffestb_local_.decl.lent != NULL)
22586 ffelex_token_kill (ffestb_local_.decl.lent);
22587 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22588 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22589}
22590
22591/* ffestb_decl_entsp_1_ -- "type" [type parameters] NAME
22592
22593 return ffestb_decl_entsp_1_; // to lexer
22594
22595 If we get another NAME token here, then the previous one must be
22596 "RECURSIVE" or "FUNCTION" and we handle it accordingly. Otherwise,
22597 we send the previous and current token through to _ents_. */
22598
22599static ffelexHandler
22600ffestb_decl_entsp_1_ (ffelexToken t)
22601{
22602 switch (ffelex_token_type (t))
22603 {
22604 case FFELEX_typeNAME:
22605 switch (ffestr_first (ffesta_tokens[1]))
22606 {
22607#if FFESTR_F90
22608 case FFESTR_firstRECURSIVE:
22609 if (ffestr_first (t) != FFESTR_firstFUNCTION)
22610 {
22611 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
22612 break;
22613 }
22614 ffestb_local_.decl.recursive = ffesta_tokens[1];
22615 return (ffelexHandler) ffestb_decl_funcname_;
22616#endif
22617
22618 case FFESTR_firstFUNCTION:
22619 ffelex_token_kill (ffesta_tokens[1]);
22620 return (ffelexHandler) ffestb_decl_funcname_ (t);
22621
22622 default:
22623 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", ffesta_tokens[1]);
22624 break;
22625 }
22626 break;
22627
22628 default:
22629 if ((ffelex_token_type (ffesta_tokens[1]) != FFELEX_typeNAMES)
22630 && !ffesta_is_inhibited ())
22631 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
22632 ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
22633 ffestb_local_.decl.len, ffestb_local_.decl.lent);
22634 if (ffestb_local_.decl.kindt != NULL)
22635 ffelex_token_kill (ffestb_local_.decl.kindt);
22636 if (ffestb_local_.decl.lent != NULL)
22637 ffelex_token_kill (ffestb_local_.decl.lent);
22638 /* NAME/NAMES token already in ffesta_tokens[1]. */
22639 return (ffelexHandler) ffestb_decl_ents_1_ (t);
22640 }
22641
22642 if (ffestb_local_.decl.kindt != NULL)
22643 ffelex_token_kill (ffestb_local_.decl.kindt);
22644 if (ffestb_local_.decl.lent != NULL)
22645 ffelex_token_kill (ffestb_local_.decl.lent);
22646 ffelex_token_kill (ffesta_tokens[1]);
22647 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22648}
22649
22650/* ffestb_decl_entsp_2_ -- "type" [type parameters] NAMES
22651
22652 return ffestb_decl_entsp_2_; // to lexer
22653
22654 If we get an ASTERISK or OPEN_PAREN here, then if the previous NAMES
22655 begins with "FUNCTION" or "RECURSIVEFUNCTION" and is followed by a
22656 first-name-char, we have a possible syntactically ambiguous situation.
22657 Otherwise, we have a straightforward situation just as if we went
22658 through _entsp_1_ instead of here. */
22659
22660static ffelexHandler
22661ffestb_decl_entsp_2_ (ffelexToken t)
22662{
22663 ffelexToken nt;
22664 bool asterisk_ok;
22665 char *p;
22666 ffeTokenLength i;
22667
22668 switch (ffelex_token_type (t))
22669 {
22670 case FFELEX_typeASTERISK:
22671 ffesta_confirmed ();
22672 switch (ffestb_local_.decl.type)
22673 {
22674 case FFESTP_typeINTEGER:
22675 case FFESTP_typeREAL:
22676 case FFESTP_typeCOMPLEX:
22677 case FFESTP_typeLOGICAL:
22678 asterisk_ok = (ffestb_local_.decl.kindt == NULL);
22679 break;
22680
22681 case FFESTP_typeCHARACTER:
22682 asterisk_ok = (ffestb_local_.decl.lent == NULL);
22683 break;
22684
22685 case FFESTP_typeBYTE:
22686 case FFESTP_typeWORD:
22687 default:
22688 asterisk_ok = FALSE;
22689 break;
22690 }
22691 switch (ffestr_first (ffesta_tokens[1]))
22692 {
22693#if FFESTR_F90
22694 case FFESTR_firstRECURSIVEFNCTN:
22695 if (!asterisk_ok)
22696 break; /* For our own convenience, treat as non-FN
22697 stmt. */
22698 p = ffelex_token_text (ffesta_tokens[1])
22699 + (i = FFESTR_firstlRECURSIVEFNCTN);
22700 if (!ffesrc_is_name_init (*p))
22701 break;
22702 ffestb_local_.decl.recursive
22703 = ffelex_token_name_from_names (ffesta_tokens[1], 0,
22704 FFESTR_firstlRECURSIVEFNCTN);
22705 ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
22706 FFESTR_firstlRECURSIVEFNCTN, 0);
22707 return (ffelexHandler) ffestb_decl_entsp_3_;
22708#endif
22709
22710 case FFESTR_firstFUNCTION:
22711 if (!asterisk_ok)
22712 break; /* For our own convenience, treat as non-FN
22713 stmt. */
22714 p = ffelex_token_text (ffesta_tokens[1])
22715 + (i = FFESTR_firstlFUNCTION);
22716 if (!ffesrc_is_name_init (*p))
22717 break;
22718 ffestb_local_.decl.recursive = NULL;
22719 ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
22720 FFESTR_firstlFUNCTION, 0);
22721 return (ffelexHandler) ffestb_decl_entsp_3_;
22722
22723 default:
22724 break;
22725 }
22726 break;
22727
22728 case FFELEX_typeOPEN_PAREN:
22729 ffestb_local_.decl.aster_after = FALSE;
22730 switch (ffestr_first (ffesta_tokens[1]))
22731 {
22732#if FFESTR_F90
22733 case FFESTR_firstRECURSIVEFNCTN:
22734 p = ffelex_token_text (ffesta_tokens[1])
22735 + (i = FFESTR_firstlRECURSIVEFNCTN);
22736 if (!ffesrc_is_name_init (*p))
22737 break;
22738 ffestb_local_.decl.recursive
22739 = ffelex_token_name_from_names (ffesta_tokens[1], 0,
22740 FFESTR_firstlRECURSIVEFNCTN);
22741 ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
22742 FFESTR_firstlRECURSIVEFNCTN, 0);
22743 return (ffelexHandler) ffestb_decl_entsp_5_ (t);
22744#endif
22745
22746 case FFESTR_firstFUNCTION:
22747 p = ffelex_token_text (ffesta_tokens[1])
22748 + (i = FFESTR_firstlFUNCTION);
22749 if (!ffesrc_is_name_init (*p))
22750 break;
22751 ffestb_local_.decl.recursive = NULL;
22752 ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
22753 FFESTR_firstlFUNCTION, 0);
22754 return (ffelexHandler) ffestb_decl_entsp_5_ (t);
22755
22756 default:
22757 break;
22758 }
22759 if ((ffestb_local_.decl.kindt != NULL)
22760 || (ffestb_local_.decl.lent != NULL))
22761 break; /* Have kind/len type param, definitely not
22762 assignment stmt. */
22763 return (ffelexHandler) ffestb_decl_entsp_1_ (t);
22764
22765 default:
22766 break;
22767 }
22768
22769 nt = ffelex_token_name_from_names (ffesta_tokens[1], 0, 0);
22770 ffelex_token_kill (ffesta_tokens[1]);
22771 ffesta_tokens[1] = nt; /* Change NAMES to NAME. */
22772 return (ffelexHandler) ffestb_decl_entsp_1_ (t);
22773}
22774
22775/* ffestb_decl_entsp_3_ -- "type" [type parameters] [RECURSIVE] FUNCTION
22776 NAME ASTERISK
22777
22778 return ffestb_decl_entsp_3_; // to lexer
22779
22780 Handle NUMBER or OPEN_PAREN. */
22781
22782static ffelexHandler
22783ffestb_decl_entsp_3_ (ffelexToken t)
22784{
22785 ffestb_local_.decl.aster_after = TRUE;
22786
22787 switch (ffelex_token_type (t))
22788 {
22789 case FFELEX_typeNUMBER:
22790 switch (ffestb_local_.decl.type)
22791 {
22792 case FFESTP_typeINTEGER:
22793 case FFESTP_typeREAL:
22794 case FFESTP_typeCOMPLEX:
22795 case FFESTP_typeLOGICAL:
22796 ffestb_local_.decl.kindt = ffelex_token_use (t);
22797 break;
22798
22799 case FFESTP_typeCHARACTER:
22800 ffestb_local_.decl.lent = ffelex_token_use (t);
22801 break;
22802
22803 case FFESTP_typeBYTE:
22804 case FFESTP_typeWORD:
22805 default:
22806 assert (FALSE);
22807 }
22808 return (ffelexHandler) ffestb_decl_entsp_5_;
22809
22810 case FFELEX_typeOPEN_PAREN:
22811 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
22812 FFEEXPR_contextCHARACTERSIZE,
22813 (ffeexprCallback) ffestb_decl_entsp_4_);
22814
22815 default:
22816 break;
22817 }
22818
22819 if (ffestb_local_.decl.recursive != NULL)
22820 ffelex_token_kill (ffestb_local_.decl.recursive);
22821 if (ffestb_local_.decl.kindt != NULL)
22822 ffelex_token_kill (ffestb_local_.decl.kindt);
22823 if (ffestb_local_.decl.lent != NULL)
22824 ffelex_token_kill (ffestb_local_.decl.lent);
22825 ffelex_token_kill (ffesta_tokens[1]);
22826 ffelex_token_kill (ffesta_tokens[2]);
22827 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
22828 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22829}
22830
22831/* ffestb_decl_entsp_4_ -- "type" [type parameters] [RECURSIVE] FUNCTION
22832 NAME ASTERISK OPEN_PAREN expr
22833
22834 (ffestb_decl_entsp_4_) // to expression handler
22835
22836 Allow only CLOSE_PAREN; and deal with character-length expression. */
22837
22838static ffelexHandler
22839ffestb_decl_entsp_4_ (ffelexToken ft, ffebld expr, ffelexToken t)
22840{
22841 switch (ffelex_token_type (t))
22842 {
22843 case FFELEX_typeCLOSE_PAREN:
22844 if (expr == NULL)
22845 break;
22846 switch (ffestb_local_.decl.type)
22847 {
22848 case FFESTP_typeCHARACTER:
22849 ffestb_local_.decl.len = expr;
22850 ffestb_local_.decl.lent = ffelex_token_use (ft);
22851 break;
22852
22853 default:
22854 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
22855 break;
22856 }
22857 return (ffelexHandler) ffestb_decl_entsp_5_;
22858
22859 default:
22860 break;
22861 }
22862
22863 if (ffestb_local_.decl.recursive != NULL)
22864 ffelex_token_kill (ffestb_local_.decl.recursive);
22865 if (ffestb_local_.decl.kindt != NULL)
22866 ffelex_token_kill (ffestb_local_.decl.kindt);
22867 if (ffestb_local_.decl.lent != NULL)
22868 ffelex_token_kill (ffestb_local_.decl.lent);
22869 ffelex_token_kill (ffesta_tokens[1]);
22870 ffelex_token_kill (ffesta_tokens[2]);
22871 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
22872 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22873}
22874
22875/* ffestb_decl_entsp_5_ -- "type" [type parameters] [RECURSIVE] FUNCTION
22876 NAME [type parameter]
22877
22878 return ffestb_decl_entsp_5_; // to lexer
22879
22880 Make sure the next token is an OPEN_PAREN. Get the arg list or dimension
22881 list. If it can't be an arg list, or if the CLOSE_PAREN is followed by
22882 something other than EOS/SEMICOLON or NAME, then treat as dimension list
22883 and handle statement as an R426/R501. If it can't be a dimension list, or
22884 if the CLOSE_PAREN is followed by NAME, treat as an arg list and handle
22885 statement as an R1219. If it can be either an arg list or a dimension
22886 list and if the CLOSE_PAREN is followed by EOS/SEMICOLON, ask FFESTC
22887 whether to treat the statement as an R426/R501 or an R1219 and act
22888 accordingly. */
22889
22890static ffelexHandler
22891ffestb_decl_entsp_5_ (ffelexToken t)
22892{
22893 switch (ffelex_token_type (t))
22894 {
22895 case FFELEX_typeOPEN_PAREN:
22896 if (ffestb_local_.decl.aster_after && (ffestb_local_.decl.len != NULL))
22897 { /* "CHARACTER[RECURSIVE]FUNCTIONxyz*(len-expr)
22898 (..." must be a function-stmt, since the
22899 (len-expr) cannot precede (array-spec) in
22900 an object declaration but can precede
22901 (name-list) in a function stmt. */
22902 ffelex_token_kill (ffesta_tokens[1]);
22903 ffesta_tokens[1] = ffesta_tokens[2];
22904 return (ffelexHandler) ffestb_decl_funcname_4_ (t);
22905 }
22906 ffestb_local_.decl.toklist = ffestt_tokenlist_create ();
22907 ffestb_local_.decl.empty = TRUE;
22908 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
22909 return (ffelexHandler) ffestb_decl_entsp_6_;
22910
22911 default:
22912 break;
22913 }
22914
22915 assert (ffestb_local_.decl.aster_after);
22916 ffesta_confirmed (); /* We've seen an ASTERISK, so even EQUALS
22917 confirmed. */
22918 ffestb_subr_ambig_to_ents_ ();
22919 ffestb_subrargs_.dim_list.dims = NULL;
22920 return (ffelexHandler) ffestb_decl_ents_7_ (t);
22921}
22922
22923/* ffestb_decl_entsp_6_ -- "type" [type parameters] [RECURSIVE] FUNCTION
22924 NAME [type parameter] OPEN_PAREN
22925
22926 return ffestb_decl_entsp_6_; // to lexer
22927
22928 If CLOSE_PAREN, we definitely have an R1219 function-stmt, since
22929 the notation "name()" is invalid for a declaration. */
22930
22931static ffelexHandler
22932ffestb_decl_entsp_6_ (ffelexToken t)
22933{
22934 ffelexHandler next;
22935
22936 switch (ffelex_token_type (t))
22937 {
22938 case FFELEX_typeCLOSE_PAREN:
22939 if (!ffestb_local_.decl.empty)
22940 { /* Trailing comma, just a warning for
22941 stmt func def, so allow ambiguity. */
22942 ffestt_tokenlist_append (ffestb_local_.decl.toklist,
22943 ffelex_token_use (t));
22944 return (ffelexHandler) ffestb_decl_entsp_8_;
22945 }
22946 ffelex_token_kill (ffesta_tokens[1]);
22947 ffesta_tokens[1] = ffesta_tokens[2];
22948 next = (ffelexHandler) ffestt_tokenlist_handle
22949 (ffestb_local_.decl.toklist, (ffelexHandler) ffestb_decl_funcname_4_);
22950 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
22951 return (ffelexHandler) (*next) (t);
22952
22953 case FFELEX_typeNAME:
22954 ffestb_local_.decl.empty = FALSE;
22955 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
22956 return (ffelexHandler) ffestb_decl_entsp_7_;
22957
22958 case FFELEX_typeEQUALS:
22959 case FFELEX_typePOINTS:
22960 case FFELEX_typePERCENT:
22961 case FFELEX_typePERIOD:
22962 case FFELEX_typeOPEN_PAREN:
22963 if ((ffestb_local_.decl.kindt != NULL)
22964 || (ffestb_local_.decl.lent != NULL))
22965 break; /* type(params)name or type*val name, either
22966 way confirmed. */
22967 return (ffelexHandler) ffestb_subr_ambig_nope_ (t);
22968
22969 default:
22970 break;
22971 }
22972
22973 ffesta_confirmed ();
22974 ffestb_subr_ambig_to_ents_ ();
22975 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
22976 (ffelexHandler) ffestb_decl_ents_3_);
22977 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
22978 return (ffelexHandler) (*next) (t);
22979}
22980
22981/* ffestb_decl_entsp_7_ -- "type" [type parameters] [RECURSIVE] FUNCTION
22982 NAME [type parameter] OPEN_PAREN NAME
22983
22984 return ffestb_decl_entsp_7_; // to lexer
22985
22986 Expect COMMA or CLOSE_PAREN to remain ambiguous, else not an R1219
22987 function-stmt. */
22988
22989static ffelexHandler
22990ffestb_decl_entsp_7_ (ffelexToken t)
22991{
22992 ffelexHandler next;
22993
22994 switch (ffelex_token_type (t))
22995 {
22996 case FFELEX_typeCLOSE_PAREN:
22997 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
22998 return (ffelexHandler) ffestb_decl_entsp_8_;
22999
23000 case FFELEX_typeCOMMA:
23001 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
23002 return (ffelexHandler) ffestb_decl_entsp_6_;
23003
23004 case FFELEX_typeEQUALS:
23005 case FFELEX_typePOINTS:
23006 case FFELEX_typePERCENT:
23007 case FFELEX_typePERIOD:
23008 case FFELEX_typeOPEN_PAREN:
23009 if ((ffestb_local_.decl.kindt != NULL)
23010 || (ffestb_local_.decl.lent != NULL))
23011 break; /* type(params)name or type*val name, either
23012 way confirmed. */
23013 return (ffelexHandler) ffestb_subr_ambig_nope_ (t);
23014
23015 default:
23016 break;
23017 }
23018
23019 ffesta_confirmed ();
23020 ffestb_subr_ambig_to_ents_ ();
23021 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
23022 (ffelexHandler) ffestb_decl_ents_3_);
23023 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
23024 return (ffelexHandler) (*next) (t);
23025}
23026
23027/* ffestb_decl_entsp_8_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23028 NAME [type parameter] OPEN_PAREN name-list
23029 CLOSE_PAREN
23030
23031 return ffestb_decl_entsp_8_; // to lexer
23032
23033 If EOS/SEMICOLON, situation remains ambiguous, ask FFESTC to resolve
23034 it. If NAME (must be "RESULT", but that is checked later on),
23035 definitely an R1219 function-stmt. Anything else, handle as entity decl. */
23036
23037static ffelexHandler
23038ffestb_decl_entsp_8_ (ffelexToken t)
23039{
23040 ffelexHandler next;
23041
23042 switch (ffelex_token_type (t))
23043 {
23044 case FFELEX_typeEOS:
23045 case FFELEX_typeSEMICOLON:
23046 ffesta_confirmed ();
23047 if (ffestc_is_decl_not_R1219 ())
23048 break;
23049 /* Fall through. */
23050 case FFELEX_typeNAME:
23051 ffesta_confirmed ();
23052 ffelex_token_kill (ffesta_tokens[1]);
23053 ffesta_tokens[1] = ffesta_tokens[2];
23054 next = (ffelexHandler) ffestt_tokenlist_handle
23055 (ffestb_local_.decl.toklist, (ffelexHandler) ffestb_decl_funcname_4_);
23056 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
23057 return (ffelexHandler) (*next) (t);
23058
23059 case FFELEX_typeEQUALS:
23060 case FFELEX_typePOINTS:
23061 case FFELEX_typePERCENT:
23062 case FFELEX_typePERIOD:
23063 case FFELEX_typeOPEN_PAREN:
23064 if ((ffestb_local_.decl.kindt != NULL)
23065 || (ffestb_local_.decl.lent != NULL))
23066 break; /* type(params)name or type*val name, either
23067 way confirmed. */
23068 return (ffelexHandler) ffestb_subr_ambig_nope_ (t);
23069
23070 default:
23071 break;
23072 }
23073
23074 ffesta_confirmed ();
23075 ffestb_subr_ambig_to_ents_ ();
23076 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
23077 (ffelexHandler) ffestb_decl_ents_3_);
23078 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
23079 return (ffelexHandler) (*next) (t);
23080}
23081
23082/* ffestb_decl_func_ -- ["type" [type parameters]] RECURSIVE
23083
23084 return ffestb_decl_func_; // to lexer
23085
23086 Handle "FUNCTION". */
23087
23088#if FFESTR_F90
23089static ffelexHandler
23090ffestb_decl_func_ (ffelexToken t)
23091{
23092 char *p;
23093 ffeTokenLength i;
23094
23095 ffelex_set_names (FALSE);
23096
23097 switch (ffelex_token_type (t))
23098 {
23099 case FFELEX_typeNAME:
23100 if (ffestr_first (t) != FFESTR_firstFUNCTION)
23101 break;
23102 return (ffelexHandler) ffestb_decl_funcname_;
23103
23104 case FFELEX_typeNAMES:
23105 ffesta_confirmed ();
23106 if (ffestr_first (t) != FFESTR_firstFUNCTION)
23107 break;
23108 p = ffelex_token_text (t) + (i = FFESTR_firstlFUNCTION);
23109 if (*p == '\0')
23110 break;
23111 if (!ffesrc_is_name_init (*p))
23112 goto bad_i; /* :::::::::::::::::::: */
23113 ffesta_tokens[1] = ffelex_token_name_from_names (t, i, 0);
23114 return (ffelexHandler) ffestb_decl_funcname_1_;
23115
23116 default:
23117 break;
23118 }
23119
23120 if (ffestb_local_.decl.recursive != NULL)
23121 ffelex_token_kill (ffestb_local_.decl.recursive);
23122 if (ffestb_local_.decl.kindt != NULL)
23123 ffelex_token_kill (ffestb_local_.decl.kindt);
23124 if (ffestb_local_.decl.lent != NULL)
23125 ffelex_token_kill (ffestb_local_.decl.lent);
23126 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23127 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23128
23129bad_i: /* :::::::::::::::::::: */
23130 if (ffestb_local_.decl.recursive != NULL)
23131 ffelex_token_kill (ffestb_local_.decl.recursive);
23132 if (ffestb_local_.decl.kindt != NULL)
23133 ffelex_token_kill (ffestb_local_.decl.kindt);
23134 if (ffestb_local_.decl.lent != NULL)
23135 ffelex_token_kill (ffestb_local_.decl.lent);
23136 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t, i, NULL);
23137 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23138}
23139
23140#endif
23141/* ffestb_decl_funcname_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23142
23143 return ffestb_decl_funcname_; // to lexer
23144
23145 Handle NAME of a function. */
23146
23147static ffelexHandler
23148ffestb_decl_funcname_ (ffelexToken t)
23149{
23150 switch (ffelex_token_type (t))
23151 {
23152 case FFELEX_typeNAME:
23153 ffesta_tokens[1] = ffelex_token_use (t);
23154 return (ffelexHandler) ffestb_decl_funcname_1_;
23155
23156 default:
23157 break;
23158 }
23159
23160 if (ffestb_local_.decl.recursive != NULL)
23161 ffelex_token_kill (ffestb_local_.decl.recursive);
23162 if (ffestb_local_.decl.kindt != NULL)
23163 ffelex_token_kill (ffestb_local_.decl.kindt);
23164 if (ffestb_local_.decl.lent != NULL)
23165 ffelex_token_kill (ffestb_local_.decl.lent);
23166 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23167 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23168}
23169
23170/* ffestb_decl_funcname_1_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23171 NAME
23172
23173 return ffestb_decl_funcname_1_; // to lexer
23174
23175 Handle ASTERISK or OPEN_PAREN. */
23176
23177static ffelexHandler
23178ffestb_decl_funcname_1_ (ffelexToken t)
23179{
23180 switch (ffelex_token_type (t))
23181 {
23182 case FFELEX_typeASTERISK:
23183 return (ffelexHandler) ffestb_decl_funcname_2_;
23184
23185 case FFELEX_typeOPEN_PAREN:
23186 return (ffelexHandler) ffestb_decl_funcname_4_ (t);
23187
23188 default:
23189 break;
23190 }
23191
23192 if (ffestb_local_.decl.recursive != NULL)
23193 ffelex_token_kill (ffestb_local_.decl.recursive);
23194 if (ffestb_local_.decl.kindt != NULL)
23195 ffelex_token_kill (ffestb_local_.decl.kindt);
23196 if (ffestb_local_.decl.lent != NULL)
23197 ffelex_token_kill (ffestb_local_.decl.lent);
23198 ffelex_token_kill (ffesta_tokens[1]);
23199 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23200 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23201}
23202
23203/* ffestb_decl_funcname_2_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23204 NAME ASTERISK
23205
23206 return ffestb_decl_funcname_2_; // to lexer
23207
23208 Handle NUMBER or OPEN_PAREN. */
23209
23210static ffelexHandler
23211ffestb_decl_funcname_2_ (ffelexToken t)
23212{
23213 switch (ffelex_token_type (t))
23214 {
23215 case FFELEX_typeNUMBER:
23216 switch (ffestb_local_.decl.type)
23217 {
23218 case FFESTP_typeINTEGER:
23219 case FFESTP_typeREAL:
23220 case FFESTP_typeCOMPLEX:
23221 case FFESTP_typeLOGICAL:
23222 if (ffestb_local_.decl.kindt == NULL)
23223 ffestb_local_.decl.kindt = ffelex_token_use (t);
23224 else
23225 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23226 break;
23227
23228 case FFESTP_typeCHARACTER:
23229 if (ffestb_local_.decl.lent == NULL)
23230 ffestb_local_.decl.lent = ffelex_token_use (t);
23231 else
23232 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23233 break;
23234
23235 case FFESTP_typeBYTE:
23236 case FFESTP_typeWORD:
23237 default:
23238 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23239 break;
23240 }
23241 return (ffelexHandler) ffestb_decl_funcname_4_;
23242
23243 case FFELEX_typeOPEN_PAREN:
23244 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
23245 FFEEXPR_contextCHARACTERSIZE,
23246 (ffeexprCallback) ffestb_decl_funcname_3_);
23247
23248 default:
23249 break;
23250 }
23251
23252 if (ffestb_local_.decl.recursive != NULL)
23253 ffelex_token_kill (ffestb_local_.decl.recursive);
23254 if (ffestb_local_.decl.kindt != NULL)
23255 ffelex_token_kill (ffestb_local_.decl.kindt);
23256 if (ffestb_local_.decl.lent != NULL)
23257 ffelex_token_kill (ffestb_local_.decl.lent);
23258 ffelex_token_kill (ffesta_tokens[1]);
23259 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23260 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23261}
23262
23263/* ffestb_decl_funcname_3_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23264 NAME ASTERISK OPEN_PAREN expr
23265
23266 (ffestb_decl_funcname_3_) // to expression handler
23267
23268 Allow only CLOSE_PAREN; and deal with character-length expression. */
23269
23270static ffelexHandler
23271ffestb_decl_funcname_3_ (ffelexToken ft, ffebld expr, ffelexToken t)
23272{
23273 switch (ffelex_token_type (t))
23274 {
23275 case FFELEX_typeCLOSE_PAREN:
23276 if (expr == NULL)
23277 break;
23278 switch (ffestb_local_.decl.type)
23279 {
23280 case FFESTP_typeCHARACTER:
23281 if (ffestb_local_.decl.lent == NULL)
23282 {
23283 ffestb_local_.decl.len = expr;
23284 ffestb_local_.decl.lent = ffelex_token_use (ft);
23285 }
23286 else
23287 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23288 break;
23289
23290 default:
23291 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23292 break;
23293 }
23294 return (ffelexHandler) ffestb_decl_funcname_4_;
23295
23296 default:
23297 break;
23298 }
23299
23300 if (ffestb_local_.decl.recursive != NULL)
23301 ffelex_token_kill (ffestb_local_.decl.recursive);
23302 if (ffestb_local_.decl.kindt != NULL)
23303 ffelex_token_kill (ffestb_local_.decl.kindt);
23304 if (ffestb_local_.decl.lent != NULL)
23305 ffelex_token_kill (ffestb_local_.decl.lent);
23306 ffelex_token_kill (ffesta_tokens[1]);
23307 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23308 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23309}
23310
23311/* ffestb_decl_funcname_4_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23312 NAME [type parameter]
23313
23314 return ffestb_decl_funcname_4_; // to lexer
23315
23316 Make sure the next token is an OPEN_PAREN. Get the arg list and
23317 then implement. */
23318
23319static ffelexHandler
23320ffestb_decl_funcname_4_ (ffelexToken t)
23321{
23322 switch (ffelex_token_type (t))
23323 {
23324 case FFELEX_typeOPEN_PAREN:
23325 ffestb_subrargs_.name_list.args = ffestt_tokenlist_create ();
23326 ffestb_subrargs_.name_list.handler
23327 = (ffelexHandler) ffestb_decl_funcname_5_;
23328 ffestb_subrargs_.name_list.is_subr = FALSE;
23329 ffestb_subrargs_.name_list.names = FALSE;
23330 return (ffelexHandler) ffestb_subr_name_list_;
23331
23332 default:
23333 break;
23334 }
23335
23336 if (ffestb_local_.decl.recursive != NULL)
23337 ffelex_token_kill (ffestb_local_.decl.recursive);
23338 if (ffestb_local_.decl.kindt != NULL)
23339 ffelex_token_kill (ffestb_local_.decl.kindt);
23340 if (ffestb_local_.decl.lent != NULL)
23341 ffelex_token_kill (ffestb_local_.decl.lent);
23342 ffelex_token_kill (ffesta_tokens[1]);
23343 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23344 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23345}
23346
23347/* ffestb_decl_funcname_5_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23348 NAME [type parameter] OPEN_PAREN arg-list
23349 CLOSE_PAREN
23350
23351 return ffestb_decl_funcname_5_; // to lexer
23352
23353 Must have EOS/SEMICOLON or "RESULT" here. */
23354
23355static ffelexHandler
23356ffestb_decl_funcname_5_ (ffelexToken t)
23357{
23358 if (!ffestb_subrargs_.name_list.ok)
23359 goto bad; /* :::::::::::::::::::: */
23360
23361 switch (ffelex_token_type (t))
23362 {
23363 case FFELEX_typeEOS:
23364 case FFELEX_typeSEMICOLON:
23365 ffesta_confirmed ();
23366 if (!ffesta_is_inhibited ())
23367 ffestc_R1219 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
23368 ffestb_subrargs_.name_list.close_paren, ffestb_local_.decl.type,
23369 ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
23370 ffestb_local_.decl.len, ffestb_local_.decl.lent,
23371 ffestb_local_.decl.recursive, NULL);
23372 if (ffestb_local_.decl.recursive != NULL)
23373 ffelex_token_kill (ffestb_local_.decl.recursive);
23374 if (ffestb_local_.decl.kindt != NULL)
23375 ffelex_token_kill (ffestb_local_.decl.kindt);
23376 if (ffestb_local_.decl.lent != NULL)
23377 ffelex_token_kill (ffestb_local_.decl.lent);
23378 ffelex_token_kill (ffesta_tokens[1]);
23379 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
23380 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
23381 return (ffelexHandler) ffesta_zero (t);
23382
23383 case FFELEX_typeNAME:
23384 if (ffestr_other (t) != FFESTR_otherRESULT)
23385 break;
23386 return (ffelexHandler) ffestb_decl_funcname_6_;
23387
23388 default:
23389 break;
23390 }
23391
23392bad: /* :::::::::::::::::::: */
23393 if (ffestb_local_.decl.recursive != NULL)
23394 ffelex_token_kill (ffestb_local_.decl.recursive);
23395 if (ffestb_local_.decl.kindt != NULL)
23396 ffelex_token_kill (ffestb_local_.decl.kindt);
23397 if (ffestb_local_.decl.lent != NULL)
23398 ffelex_token_kill (ffestb_local_.decl.lent);
23399 ffelex_token_kill (ffesta_tokens[1]);
23400 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
23401 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
23402 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23403 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23404}
23405
23406/* ffestb_decl_funcname_6_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23407 NAME [type parameter] OPEN_PAREN arglist
23408 CLOSE_PAREN "RESULT"
23409
23410 return ffestb_decl_funcname_6_; // to lexer
23411
23412 Make sure the next token is an OPEN_PAREN. */
23413
23414static ffelexHandler
23415ffestb_decl_funcname_6_ (ffelexToken t)
23416{
23417 switch (ffelex_token_type (t))
23418 {
23419 case FFELEX_typeOPEN_PAREN:
23420 return (ffelexHandler) ffestb_decl_funcname_7_;
23421
23422 default:
23423 break;
23424 }
23425
23426 if (ffestb_local_.decl.recursive != NULL)
23427 ffelex_token_kill (ffestb_local_.decl.recursive);
23428 if (ffestb_local_.decl.kindt != NULL)
23429 ffelex_token_kill (ffestb_local_.decl.kindt);
23430 if (ffestb_local_.decl.lent != NULL)
23431 ffelex_token_kill (ffestb_local_.decl.lent);
23432 ffelex_token_kill (ffesta_tokens[1]);
23433 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
23434 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
23435 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23436 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23437}
23438
23439/* ffestb_decl_funcname_7_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23440 NAME [type parameter] OPEN_PAREN arglist
23441 CLOSE_PAREN "RESULT" OPEN_PAREN
23442
23443 return ffestb_decl_funcname_7_; // to lexer
23444
23445 Make sure the next token is a NAME. */
23446
23447static ffelexHandler
23448ffestb_decl_funcname_7_ (ffelexToken t)
23449{
23450 switch (ffelex_token_type (t))
23451 {
23452 case FFELEX_typeNAME:
23453 ffesta_tokens[2] = ffelex_token_use (t);
23454 return (ffelexHandler) ffestb_decl_funcname_8_;
23455
23456 default:
23457 break;
23458 }
23459
23460 if (ffestb_local_.decl.recursive != NULL)
23461 ffelex_token_kill (ffestb_local_.decl.recursive);
23462 if (ffestb_local_.decl.kindt != NULL)
23463 ffelex_token_kill (ffestb_local_.decl.kindt);
23464 if (ffestb_local_.decl.lent != NULL)
23465 ffelex_token_kill (ffestb_local_.decl.lent);
23466 ffelex_token_kill (ffesta_tokens[1]);
23467 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
23468 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
23469 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23470 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23471}
23472
23473/* ffestb_decl_funcname_8_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23474 NAME [type parameter] OPEN_PAREN arglist
23475 CLOSE_PAREN "RESULT" OPEN_PAREN NAME
23476
23477 return ffestb_decl_funcname_8_; // to lexer
23478
23479 Make sure the next token is a CLOSE_PAREN. */
23480
23481static ffelexHandler
23482ffestb_decl_funcname_8_ (ffelexToken t)
23483{
23484 switch (ffelex_token_type (t))
23485 {
23486 case FFELEX_typeCLOSE_PAREN:
23487 return (ffelexHandler) ffestb_decl_funcname_9_;
23488
23489 default:
23490 break;
23491 }
23492
23493 if (ffestb_local_.decl.recursive != NULL)
23494 ffelex_token_kill (ffestb_local_.decl.recursive);
23495 if (ffestb_local_.decl.kindt != NULL)
23496 ffelex_token_kill (ffestb_local_.decl.kindt);
23497 if (ffestb_local_.decl.lent != NULL)
23498 ffelex_token_kill (ffestb_local_.decl.lent);
23499 ffelex_token_kill (ffesta_tokens[1]);
23500 ffelex_token_kill (ffesta_tokens[2]);
23501 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
23502 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
23503 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23504 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23505}
23506
23507/* ffestb_decl_funcname_9_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23508 NAME [type parameter] OPEN_PAREN arg-list
23509 CLOSE_PAREN "RESULT" OPEN_PAREN NAME CLOSE_PAREN
23510
23511 return ffestb_decl_funcname_9_; // to lexer
23512
23513 Must have EOS/SEMICOLON here. */
23514
23515static ffelexHandler
23516ffestb_decl_funcname_9_ (ffelexToken t)
23517{
23518 switch (ffelex_token_type (t))
23519 {
23520 case FFELEX_typeEOS:
23521 case FFELEX_typeSEMICOLON:
23522 if (!ffesta_is_inhibited ())
23523 ffestc_R1219 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
23524 ffestb_subrargs_.name_list.close_paren, ffestb_local_.decl.type,
23525 ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
23526 ffestb_local_.decl.len, ffestb_local_.decl.lent,
23527 ffestb_local_.decl.recursive, ffesta_tokens[2]);
23528 if (ffestb_local_.decl.recursive != NULL)
23529 ffelex_token_kill (ffestb_local_.decl.recursive);
23530 if (ffestb_local_.decl.kindt != NULL)
23531 ffelex_token_kill (ffestb_local_.decl.kindt);
23532 if (ffestb_local_.decl.lent != NULL)
23533 ffelex_token_kill (ffestb_local_.decl.lent);
23534 ffelex_token_kill (ffesta_tokens[1]);
23535 ffelex_token_kill (ffesta_tokens[2]);
23536 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
23537 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
23538 return (ffelexHandler) ffesta_zero (t);
23539
23540 default:
23541 break;
23542 }
23543
23544 if (ffestb_local_.decl.recursive != NULL)
23545 ffelex_token_kill (ffestb_local_.decl.recursive);
23546 if (ffestb_local_.decl.kindt != NULL)
23547 ffelex_token_kill (ffestb_local_.decl.kindt);
23548 if (ffestb_local_.decl.lent != NULL)
23549 ffelex_token_kill (ffestb_local_.decl.lent);
23550 ffelex_token_kill (ffesta_tokens[1]);
23551 ffelex_token_kill (ffesta_tokens[2]);
23552 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
23553 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
23554 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23555 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23556}
23557
23558/* ffestb_V003 -- Parse the STRUCTURE statement
23559
23560 return ffestb_V003; // to lexer
23561
23562 Make sure the statement has a valid form for the STRUCTURE statement.
23563 If it does, implement the statement. */
23564
23565#if FFESTR_VXT
23566ffelexHandler
23567ffestb_V003 (ffelexToken t)
23568{
23569 ffeTokenLength i;
23570 char *p;
23571 ffelexToken nt;
23572 ffelexHandler next;
23573
23574 switch (ffelex_token_type (ffesta_tokens[0]))
23575 {
23576 case FFELEX_typeNAME:
23577 if (ffesta_first_kw != FFESTR_firstSTRUCTURE)
23578 goto bad_0; /* :::::::::::::::::::: */
23579 switch (ffelex_token_type (t))
23580 {
23581 case FFELEX_typeCOMMA:
23582 case FFELEX_typeCOLONCOLON:
23583 case FFELEX_typeEOS:
23584 case FFELEX_typeSEMICOLON:
23585 ffesta_confirmed (); /* Error, but clearly intended. */
23586 goto bad_1; /* :::::::::::::::::::: */
23587
23588 default:
23589 goto bad_1; /* :::::::::::::::::::: */
23590
23591 case FFELEX_typeNAME:
23592 ffesta_confirmed ();
23593 if (!ffesta_is_inhibited ())
23594 ffestc_V003_start (NULL);
23595 ffestb_local_.structure.started = TRUE;
23596 return (ffelexHandler) ffestb_V0034_ (t);
23597
23598 case FFELEX_typeSLASH:
23599 ffesta_confirmed ();
23600 return (ffelexHandler) ffestb_V0031_;
23601 }
23602
23603 case FFELEX_typeNAMES:
23604 if (ffesta_first_kw != FFESTR_firstSTRUCTURE)
23605 goto bad_0; /* :::::::::::::::::::: */
23606 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSTRUCTURE);
23607 switch (ffelex_token_type (t))
23608 {
23609 default:
23610 goto bad_1; /* :::::::::::::::::::: */
23611
23612 case FFELEX_typeEOS:
23613 case FFELEX_typeSEMICOLON:
23614 case FFELEX_typeCOMMA:
23615 case FFELEX_typeCOLONCOLON:
23616 ffesta_confirmed ();
23617 break;
23618
23619 case FFELEX_typeSLASH:
23620 ffesta_confirmed ();
23621 if (*p != '\0')
23622 goto bad_1; /* :::::::::::::::::::: */
23623 return (ffelexHandler) ffestb_V0031_;
23624
23625 case FFELEX_typeOPEN_PAREN:
23626 break;
23627 }
23628
23629 /* Here, we have at least one char after "STRUCTURE" and t is COMMA,
23630 EOS/SEMICOLON, or OPEN_PAREN. */
23631
23632 if (!ffesrc_is_name_init (*p))
23633 goto bad_i; /* :::::::::::::::::::: */
23634 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
23635 if (ffelex_token_type (t) == FFELEX_typeOPEN_PAREN)
23636 ffestb_local_.structure.started = FALSE;
23637 else
23638 {
23639 if (!ffesta_is_inhibited ())
23640 ffestc_V003_start (NULL);
23641 ffestb_local_.structure.started = TRUE;
23642 }
23643 next = (ffelexHandler) ffestb_V0034_ (nt);
23644 ffelex_token_kill (nt);
23645 return (ffelexHandler) (*next) (t);
23646
23647 default:
23648 goto bad_0; /* :::::::::::::::::::: */
23649 }
23650
23651bad_0: /* :::::::::::::::::::: */
23652 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", ffesta_tokens[0]);
23653 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23654
23655bad_1: /* :::::::::::::::::::: */
23656 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
23657 return (ffelexHandler) ffelex_swallow_tokens (t,
23658 (ffelexHandler) ffesta_zero); /* Invalid second token. */
23659
23660bad_i: /* :::::::::::::::::::: */
23661 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", ffesta_tokens[0], i, t);
23662 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23663}
23664
23665/* ffestb_V0031_ -- "STRUCTURE" SLASH
23666
23667 return ffestb_V0031_; // to lexer
23668
23669 Handle NAME. */
23670
23671static ffelexHandler
23672ffestb_V0031_ (ffelexToken t)
23673{
23674 switch (ffelex_token_type (t))
23675 {
23676 case FFELEX_typeNAME:
23677 ffesta_tokens[1] = ffelex_token_use (t);
23678 return (ffelexHandler) ffestb_V0032_;
23679
23680 default:
23681 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
23682 break;
23683 }
23684
23685 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23686}
23687
23688/* ffestb_V0032_ -- "STRUCTURE" SLASH NAME
23689
23690 return ffestb_V0032_; // to lexer
23691
23692 Handle SLASH. */
23693
23694static ffelexHandler
23695ffestb_V0032_ (ffelexToken t)
23696{
23697 switch (ffelex_token_type (t))
23698 {
23699 case FFELEX_typeSLASH:
23700 if (!ffesta_is_inhibited ())
23701 ffestc_V003_start (ffesta_tokens[1]);
23702 ffestb_local_.structure.started = TRUE;
23703 ffelex_token_kill (ffesta_tokens[1]);
23704 return (ffelexHandler) ffestb_V0033_;
23705
23706 default:
23707 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
23708 break;
23709 }
23710
23711 ffelex_token_kill (ffesta_tokens[1]);
23712 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23713}
23714
23715/* ffestb_V0033_ -- "STRUCTURE" SLASH NAME SLASH
23716
23717 return ffestb_V0033_; // to lexer
23718
23719 Handle NAME or EOS/SEMICOLON. */
23720
23721static ffelexHandler
23722ffestb_V0033_ (ffelexToken t)
23723{
23724 switch (ffelex_token_type (t))
23725 {
23726 case FFELEX_typeNAME:
23727 return (ffelexHandler) ffestb_V0034_ (t);
23728
23729 case FFELEX_typeEOS:
23730 case FFELEX_typeSEMICOLON:
23731 if (!ffesta_is_inhibited ())
23732 ffestc_V003_finish ();
23733 return (ffelexHandler) ffesta_zero (t);
23734
23735 default:
23736 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
23737 break;
23738 }
23739
23740 ffelex_token_kill (ffesta_tokens[1]);
23741 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23742}
23743
23744/* ffestb_V0034_ -- "STRUCTURE" [SLASH NAME SLASH]
23745
23746 return ffestb_V0034_; // to lexer
23747
23748 Handle NAME. */
23749
23750static ffelexHandler
23751ffestb_V0034_ (ffelexToken t)
23752{
23753 switch (ffelex_token_type (t))
23754 {
23755 case FFELEX_typeNAME:
23756 ffesta_tokens[1] = ffelex_token_use (t);
23757 return (ffelexHandler) ffestb_V0035_;
23758
23759 default:
23760 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
23761 break;
23762 }
23763
23764 if (!ffesta_is_inhibited ())
23765 ffestc_V003_finish ();
23766 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23767}
23768
23769/* ffestb_V0035_ -- "STRUCTURE" ... NAME
23770
23771 return ffestb_V0035_; // to lexer
23772
23773 Handle OPEN_PAREN. */
23774
23775static ffelexHandler
23776ffestb_V0035_ (ffelexToken t)
23777{
23778 switch (ffelex_token_type (t))
23779 {
23780 case FFELEX_typeOPEN_PAREN:
23781 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
23782 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_V0036_;
23783 ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
23784 ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLISTCOMMON;
23785#ifdef FFECOM_dimensionsMAX
23786 ffestb_subrargs_.dim_list.ndims = 0;
23787#endif
23788 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
23789 FFEEXPR_contextDIMLISTCOMMON, (ffeexprCallback) ffestb_subr_dimlist_);
23790
23791 case FFELEX_typeCOMMA:
23792 if (!ffesta_is_inhibited ())
23793 ffestc_V003_item (ffesta_tokens[1], NULL);
23794 ffelex_token_kill (ffesta_tokens[1]);
23795 return (ffelexHandler) ffestb_V0034_;
23796
23797 case FFELEX_typeEOS:
23798 case FFELEX_typeSEMICOLON:
23799 if (!ffesta_is_inhibited ())
23800 {
23801 ffestc_V003_item (ffesta_tokens[1], NULL);
23802 ffestc_V003_finish ();
23803 }
23804 ffelex_token_kill (ffesta_tokens[1]);
23805 return (ffelexHandler) ffesta_zero (t);
23806
23807 default:
23808 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
23809 break;
23810 }
23811
23812 if (!ffesta_is_inhibited ())
23813 ffestc_V003_finish ();
23814 ffelex_token_kill (ffesta_tokens[1]);
23815 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23816}
23817
23818/* ffestb_V0036_ -- "STRUCTURE" ... NAME OPEN_PAREN dimlist CLOSE_PAREN
23819
23820 return ffestb_V0036_; // to lexer
23821
23822 Handle COMMA or EOS/SEMICOLON. */
23823
23824static ffelexHandler
23825ffestb_V0036_ (ffelexToken t)
23826{
23827 if (!ffestb_subrargs_.dim_list.ok)
23828 goto bad; /* :::::::::::::::::::: */
23829
23830 switch (ffelex_token_type (t))
23831 {
23832 case FFELEX_typeCOMMA:
23833 ffesta_confirmed ();
23834 if (!ffesta_is_inhibited ())
23835 {
23836 if (!ffestb_local_.structure.started)
23837 {
23838 ffestc_V003_start (NULL);
23839 ffestb_local_.structure.started = TRUE;
23840 }
23841 ffestc_V003_item (ffesta_tokens[1],
23842 ffestb_subrargs_.dim_list.dims);
23843 }
23844 ffelex_token_kill (ffesta_tokens[1]);
23845 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
23846 return (ffelexHandler) ffestb_V0034_;
23847
23848 case FFELEX_typeEOS:
23849 case FFELEX_typeSEMICOLON:
23850 ffesta_confirmed ();
23851 if (!ffesta_is_inhibited ())
23852 {
23853 if (!ffestb_local_.structure.started)
23854 ffestc_V003_start (NULL);
23855 ffestc_V003_item (ffesta_tokens[1],
23856 ffestb_subrargs_.dim_list.dims);
23857 ffestc_V003_finish ();
23858 }
23859 ffelex_token_kill (ffesta_tokens[1]);
23860 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
23861 return (ffelexHandler) ffesta_zero (t);
23862
23863 default:
23864 break;
23865 }
23866
23867bad: /* :::::::::::::::::::: */
23868 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
23869 if (ffestb_local_.structure.started && !ffesta_is_inhibited ())
23870 ffestc_V003_finish ();
23871 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
23872 ffelex_token_kill (ffesta_tokens[1]);
23873 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23874}
23875
23876/* ffestb_V016 -- Parse the RECORD statement
23877
23878 return ffestb_V016; // to lexer
23879
23880 Make sure the statement has a valid form for the RECORD statement. If it
23881 does, implement the statement. */
23882
23883ffelexHandler
23884ffestb_V016 (ffelexToken t)
23885{
23886 char *p;
23887 ffeTokenLength i;
23888
23889 switch (ffelex_token_type (ffesta_tokens[0]))
23890 {
23891 case FFELEX_typeNAME:
23892 if (ffesta_first_kw != FFESTR_firstRECORD)
23893 goto bad_0; /* :::::::::::::::::::: */
23894 break;
23895
23896 case FFELEX_typeNAMES:
23897 if (ffesta_first_kw != FFESTR_firstRECORD)
23898 goto bad_0; /* :::::::::::::::::::: */
23899 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlRECORD);
23900 if (*p != '\0')
23901 goto bad_i; /* :::::::::::::::::::: */
23902 break;
23903
23904 default:
23905 goto bad_0; /* :::::::::::::::::::: */
23906 }
23907
23908 switch (ffelex_token_type (t))
23909 {
23910 case FFELEX_typeCOMMA:
23911 case FFELEX_typeEOS:
23912 case FFELEX_typeSEMICOLON:
23913 case FFELEX_typeCOLONCOLON:
23914 ffesta_confirmed (); /* Error, but clearly intended. */
23915 goto bad_1; /* :::::::::::::::::::: */
23916
23917 default:
23918 goto bad_1; /* :::::::::::::::::::: */
23919
23920 case FFELEX_typeSLASH:
23921 break;
23922 }
23923
23924 ffesta_confirmed ();
23925 if (!ffesta_is_inhibited ())
23926 ffestc_V016_start ();
23927 return (ffelexHandler) ffestb_V0161_;
23928
23929bad_0: /* :::::::::::::::::::: */
23930 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", ffesta_tokens[0]);
23931 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23932
23933bad_1: /* :::::::::::::::::::: */
23934 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
23935 return (ffelexHandler) ffelex_swallow_tokens (t,
23936 (ffelexHandler) ffesta_zero); /* Invalid second token. */
23937
23938bad_i: /* :::::::::::::::::::: */
23939 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "RECORD", ffesta_tokens[0], i, t);
23940 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23941}
23942
23943/* ffestb_V0161_ -- "RECORD" SLASH
23944
23945 return ffestb_V0161_; // to lexer
23946
23947 Handle NAME. */
23948
23949static ffelexHandler
23950ffestb_V0161_ (ffelexToken t)
23951{
23952 switch (ffelex_token_type (t))
23953 {
23954 case FFELEX_typeNAME:
23955 if (!ffesta_is_inhibited ())
23956 ffestc_V016_item_structure (t);
23957 return (ffelexHandler) ffestb_V0162_;
23958
23959 default:
23960 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
23961 break;
23962 }
23963
23964 if (!ffesta_is_inhibited ())
23965 ffestc_V016_finish ();
23966 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23967}
23968
23969/* ffestb_V0162_ -- "RECORD" SLASH NAME
23970
23971 return ffestb_V0162_; // to lexer
23972
23973 Handle SLASH. */
23974
23975static ffelexHandler
23976ffestb_V0162_ (ffelexToken t)
23977{
23978 switch (ffelex_token_type (t))
23979 {
23980 case FFELEX_typeSLASH:
23981 return (ffelexHandler) ffestb_V0163_;
23982
23983 default:
23984 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
23985 break;
23986 }
23987
23988 if (!ffesta_is_inhibited ())
23989 ffestc_V016_finish ();
23990 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23991}
23992
23993/* ffestb_V0163_ -- "RECORD" SLASH NAME SLASH
23994
23995 return ffestb_V0163_; // to lexer
23996
23997 Handle NAME. */
23998
23999static ffelexHandler
24000ffestb_V0163_ (ffelexToken t)
24001{
24002 switch (ffelex_token_type (t))
24003 {
24004 case FFELEX_typeNAME:
24005 ffesta_tokens[1] = ffelex_token_use (t);
24006 return (ffelexHandler) ffestb_V0164_;
24007
24008 default:
24009 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
24010 break;
24011 }
24012
24013 if (!ffesta_is_inhibited ())
24014 ffestc_V016_finish ();
24015 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24016}
24017
24018/* ffestb_V0164_ -- "RECORD" ... NAME
24019
24020 return ffestb_V0164_; // to lexer
24021
24022 Handle OPEN_PAREN. */
24023
24024static ffelexHandler
24025ffestb_V0164_ (ffelexToken t)
24026{
24027 switch (ffelex_token_type (t))
24028 {
24029 case FFELEX_typeOPEN_PAREN:
24030 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
24031 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_V0165_;
24032 ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
24033 ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLISTCOMMON;
24034#ifdef FFECOM_dimensionsMAX
24035 ffestb_subrargs_.dim_list.ndims = 0;
24036#endif
24037 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
24038 FFEEXPR_contextDIMLISTCOMMON, (ffeexprCallback) ffestb_subr_dimlist_);
24039
24040 case FFELEX_typeCOMMA:
24041 if (!ffesta_is_inhibited ())
24042 ffestc_V016_item_object (ffesta_tokens[1], NULL);
24043 ffelex_token_kill (ffesta_tokens[1]);
24044 return (ffelexHandler) ffestb_V0166_;
24045
24046 case FFELEX_typeEOS:
24047 case FFELEX_typeSEMICOLON:
24048 if (!ffesta_is_inhibited ())
24049 {
24050 ffestc_V016_item_object (ffesta_tokens[1], NULL);
24051 ffestc_V016_finish ();
24052 }
24053 ffelex_token_kill (ffesta_tokens[1]);
24054 return (ffelexHandler) ffesta_zero (t);
24055
24056 default:
24057 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
24058 break;
24059 }
24060
24061 if (!ffesta_is_inhibited ())
24062 ffestc_V016_finish ();
24063 ffelex_token_kill (ffesta_tokens[1]);
24064 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24065}
24066
24067/* ffestb_V0165_ -- "RECORD" ... NAME OPEN_PAREN dimlist CLOSE_PAREN
24068
24069 return ffestb_V0165_; // to lexer
24070
24071 Handle COMMA or EOS/SEMICOLON. */
24072
24073static ffelexHandler
24074ffestb_V0165_ (ffelexToken t)
24075{
24076 if (!ffestb_subrargs_.dim_list.ok)
24077 goto bad; /* :::::::::::::::::::: */
24078
24079 switch (ffelex_token_type (t))
24080 {
24081 case FFELEX_typeCOMMA:
24082 if (!ffesta_is_inhibited ())
24083 ffestc_V016_item_object (ffesta_tokens[1],
24084 ffestb_subrargs_.dim_list.dims);
24085 ffelex_token_kill (ffesta_tokens[1]);
24086 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
24087 return (ffelexHandler) ffestb_V0166_;
24088
24089 case FFELEX_typeEOS:
24090 case FFELEX_typeSEMICOLON:
24091 if (!ffesta_is_inhibited ())
24092 {
24093 ffestc_V016_item_object (ffesta_tokens[1],
24094 ffestb_subrargs_.dim_list.dims);
24095 ffestc_V016_finish ();
24096 }
24097 ffelex_token_kill (ffesta_tokens[1]);
24098 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
24099 return (ffelexHandler) ffesta_zero (t);
24100
24101 default:
24102 break;
24103 }
24104
24105bad: /* :::::::::::::::::::: */
24106 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
24107 if (ffestb_local_.structure.started && !ffesta_is_inhibited ())
24108 ffestc_V016_finish ();
24109 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
24110 ffelex_token_kill (ffesta_tokens[1]);
24111 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24112}
24113
24114/* ffestb_V0166_ -- "RECORD" SLASH NAME SLASH NAME [OPEN_PAREN dimlist
24115 CLOSE_PAREN] COMMA
24116
24117 return ffestb_V0166_; // to lexer
24118
24119 Handle NAME or SLASH. */
24120
24121static ffelexHandler
24122ffestb_V0166_ (ffelexToken t)
24123{
24124 switch (ffelex_token_type (t))
24125 {
24126 case FFELEX_typeNAME:
24127 ffesta_tokens[1] = ffelex_token_use (t);
24128 return (ffelexHandler) ffestb_V0164_;
24129
24130 case FFELEX_typeSLASH:
24131 return (ffelexHandler) ffestb_V0161_;
24132
24133 default:
24134 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
24135 break;
24136 }
24137
24138 if (!ffesta_is_inhibited ())
24139 ffestc_V016_finish ();
24140 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24141}
24142
24143#endif
24144/* ffestb_V027 -- Parse the VXT PARAMETER statement
24145
24146 return ffestb_V027; // to lexer
24147
24148 Make sure the statement has a valid form for the VXT PARAMETER statement.
24149 If it does, implement the statement. */
24150
24151ffelexHandler
24152ffestb_V027 (ffelexToken t)
24153{
24154 char *p;
24155 ffeTokenLength i;
24156
24157 switch (ffelex_token_type (ffesta_tokens[0]))
24158 {
24159 case FFELEX_typeNAME:
24160 if (ffesta_first_kw != FFESTR_firstPARAMETER)
24161 goto bad_0; /* :::::::::::::::::::: */
24162 switch (ffelex_token_type (t))
24163 {
24164 case FFELEX_typeNAME:
24165 break;
24166
24167 default:
24168 goto bad_1; /* :::::::::::::::::::: */
24169 }
24170 ffesta_confirmed ();
24171 ffestb_local_.vxtparam.started = TRUE;
24172 if (!ffesta_is_inhibited ())
24173 ffestc_V027_start ();
24174 ffesta_tokens[1] = ffelex_token_use (t);
24175 return (ffelexHandler) ffestb_V0271_;
24176
24177 case FFELEX_typeNAMES:
24178 if (ffesta_first_kw != FFESTR_firstPARAMETER)
24179 goto bad_0; /* :::::::::::::::::::: */
24180 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlPARAMETER);
24181 switch (ffelex_token_type (t))
24182 {
24183 case FFELEX_typeEQUALS:
24184 break;
24185
24186 default:
24187 goto bad_1; /* :::::::::::::::::::: */
24188 }
24189 if (!ffesrc_is_name_init (*p))
24190 goto bad_i; /* :::::::::::::::::::: */
24191 ffestb_local_.vxtparam.started = FALSE;
24192 ffesta_tokens[1] = ffelex_token_name_from_names (ffesta_tokens[0], i,
24193 0);
24194 return (ffelexHandler) ffestb_V0271_ (t);
24195
24196 default:
24197 goto bad_0; /* :::::::::::::::::::: */
24198 }
24199
24200bad_0: /* :::::::::::::::::::: */
24201 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", ffesta_tokens[0]);
24202 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24203
24204bad_1: /* :::::::::::::::::::: */
24205 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
24206 return (ffelexHandler) ffelex_swallow_tokens (t,
24207 (ffelexHandler) ffesta_zero); /* Invalid second token. */
24208
24209bad_i: /* :::::::::::::::::::: */
24210 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "PARAMETER", ffesta_tokens[0], i, t);
24211 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24212}
24213
24214/* ffestb_V0271_ -- "PARAMETER" NAME
24215
24216 return ffestb_V0271_; // to lexer
24217
24218 Handle EQUALS. */
24219
24220static ffelexHandler
24221ffestb_V0271_ (ffelexToken t)
24222{
24223 switch (ffelex_token_type (t))
24224 {
24225 case FFELEX_typeEQUALS:
24226 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
24227 FFEEXPR_contextPARAMETER, (ffeexprCallback) ffestb_V0272_);
24228
24229 default:
24230 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
24231 break;
24232 }
24233
24234 ffelex_token_kill (ffesta_tokens[1]);
24235 if (ffestb_local_.vxtparam.started && !ffesta_is_inhibited ())
24236 ffestc_V027_finish ();
24237 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24238}
24239
24240/* ffestb_V0272_ -- "PARAMETER" NAME EQUALS expr
24241
24242 (ffestb_V0272_) // to expression handler
24243
24244 Handle COMMA or EOS/SEMICOLON. */
24245
24246static ffelexHandler
24247ffestb_V0272_ (ffelexToken ft, ffebld expr, ffelexToken t)
24248{
24249 switch (ffelex_token_type (t))
24250 {
24251 case FFELEX_typeEOS:
24252 case FFELEX_typeSEMICOLON:
24253 if (!ffestb_local_.vxtparam.started)
24254 {
24255 if (ffestc_is_let_not_V027 ())
24256 break; /* Not a valid VXTPARAMETER stmt. */
24257 ffesta_confirmed ();
24258 if (!ffesta_is_inhibited ())
24259 ffestc_V027_start ();
24260 ffestb_local_.vxtparam.started = TRUE;
24261 }
24262 if (expr == NULL)
24263 break;
24264 if (!ffesta_is_inhibited ())
24265 {
24266 ffestc_V027_item (ffesta_tokens[1], expr, ft);
24267 ffestc_V027_finish ();
24268 }
24269 ffelex_token_kill (ffesta_tokens[1]);
24270 return (ffelexHandler) ffesta_zero (t);
24271
24272 case FFELEX_typeCOMMA:
24273 ffesta_confirmed ();
24274 if (!ffestb_local_.vxtparam.started)
24275 {
24276 if (!ffesta_is_inhibited ())
24277 ffestc_V027_start ();
24278 ffestb_local_.vxtparam.started = TRUE;
24279 }
24280 if (expr == NULL)
24281 break;
24282 if (!ffesta_is_inhibited ())
24283 ffestc_V027_item (ffesta_tokens[1], expr, ft);
24284 ffelex_token_kill (ffesta_tokens[1]);
24285 return (ffelexHandler) ffestb_V0273_;
24286
24287 default:
24288 break;
24289 }
24290
24291 ffelex_token_kill (ffesta_tokens[1]);
24292 if (ffestb_local_.vxtparam.started && !ffesta_is_inhibited ())
24293 ffestc_V027_finish ();
24294 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
24295 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24296}
24297
24298/* ffestb_V0273_ -- "PARAMETER" NAME EQUALS expr COMMA
24299
24300 return ffestb_V0273_; // to lexer
24301
24302 Handle NAME. */
24303
24304static ffelexHandler
24305ffestb_V0273_ (ffelexToken t)
24306{
24307 switch (ffelex_token_type (t))
24308 {
24309 case FFELEX_typeNAME:
24310 ffesta_tokens[1] = ffelex_token_use (t);
24311 return (ffelexHandler) ffestb_V0271_;
24312
24313 default:
24314 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
24315 break;
24316 }
24317
24318 if (ffestb_local_.vxtparam.started && !ffesta_is_inhibited ())
24319 ffestc_V027_finish ();
24320 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24321}
24322
24323/* ffestb_decl_R539 -- Parse the IMPLICIT FUNCTION statement
24324
24325 return ffestb_decl_R539; // to lexer
24326
24327 Make sure the statement has a valid form for the IMPLICIT
24328 statement. If it does, implement the statement. */
24329
24330ffelexHandler
24331ffestb_decl_R539 (ffelexToken t)
24332{
24333 ffeTokenLength i;
24334 char *p;
24335 ffelexToken nt;
24336 ffestrSecond kw;
24337
24338 ffestb_local_.decl.recursive = NULL;
24339
24340 switch (ffelex_token_type (ffesta_tokens[0]))
24341 {
24342 case FFELEX_typeNAME:
24343 if (ffesta_first_kw != FFESTR_firstIMPLICIT)
24344 goto bad_0; /* :::::::::::::::::::: */
24345 switch (ffelex_token_type (t))
24346 {
24347 case FFELEX_typeEOS:
24348 case FFELEX_typeSEMICOLON:
24349 case FFELEX_typeCOMMA:
24350 case FFELEX_typeCOLONCOLON:
24351 ffesta_confirmed (); /* Error, but clearly intended. */
24352 goto bad_1; /* :::::::::::::::::::: */
24353
24354 default:
24355 goto bad_1; /* :::::::::::::::::::: */
24356
24357 case FFELEX_typeNAME:
24358 break;
24359 }
24360 ffesta_confirmed ();
24361 ffestb_local_.decl.imp_started = FALSE;
24362 switch (ffesta_second_kw)
24363 {
24364 case FFESTR_secondINTEGER:
24365 ffestb_local_.decl.type = FFESTP_typeINTEGER;
24366 return (ffelexHandler) ffestb_decl_R5391_;
24367
24368 case FFESTR_secondBYTE:
24369 ffestb_local_.decl.type = FFESTP_typeBYTE;
24370 return (ffelexHandler) ffestb_decl_R5391_;
24371
24372 case FFESTR_secondWORD:
24373 ffestb_local_.decl.type = FFESTP_typeWORD;
24374 return (ffelexHandler) ffestb_decl_R5391_;
24375
24376 case FFESTR_secondREAL:
24377 ffestb_local_.decl.type = FFESTP_typeREAL;
24378 return (ffelexHandler) ffestb_decl_R5391_;
24379
24380 case FFESTR_secondCOMPLEX:
24381 ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
24382 return (ffelexHandler) ffestb_decl_R5391_;
24383
24384 case FFESTR_secondLOGICAL:
24385 ffestb_local_.decl.type = FFESTP_typeLOGICAL;
24386 return (ffelexHandler) ffestb_decl_R5391_;
24387
24388 case FFESTR_secondCHARACTER:
24389 ffestb_local_.decl.type = FFESTP_typeCHARACTER;
24390 return (ffelexHandler) ffestb_decl_R5391_;
24391
24392 case FFESTR_secondDOUBLE:
24393 return (ffelexHandler) ffestb_decl_R5392_;
24394
24395 case FFESTR_secondDOUBLEPRECISION:
24396 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
24397 ffestb_local_.decl.kind = NULL;
24398 ffestb_local_.decl.kindt = NULL;
24399 ffestb_local_.decl.len = NULL;
24400 ffestb_local_.decl.lent = NULL;
24401 return (ffelexHandler) ffestb_decl_R539letters_;
24402
24403 case FFESTR_secondDOUBLECOMPLEX:
24404 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
24405 ffestb_local_.decl.kind = NULL;
24406 ffestb_local_.decl.kindt = NULL;
24407 ffestb_local_.decl.len = NULL;
24408 ffestb_local_.decl.lent = NULL;
24409 return (ffelexHandler) ffestb_decl_R539letters_;
24410
24411 case FFESTR_secondNONE:
24412 return (ffelexHandler) ffestb_decl_R5394_;
24413
24414#if FFESTR_F90
24415 case FFESTR_secondTYPE:
24416 ffestb_local_.decl.type = FFESTP_typeTYPE;
24417 return (ffelexHandler) ffestb_decl_R5393_;
24418#endif
24419
24420 default:
24421 goto bad_1; /* :::::::::::::::::::: */
24422 }
24423
24424 case FFELEX_typeNAMES:
24425 if (ffesta_first_kw != FFESTR_firstIMPLICIT)
24426 goto bad_0; /* :::::::::::::::::::: */
24427 switch (ffelex_token_type (t))
24428 {
24429 case FFELEX_typeCOMMA:
24430 case FFELEX_typeCOLONCOLON:
24431 case FFELEX_typeASTERISK:
24432 case FFELEX_typeSEMICOLON:
24433 case FFELEX_typeEOS:
24434 ffesta_confirmed ();
24435 break;
24436
24437 case FFELEX_typeOPEN_PAREN:
24438 break;
24439
24440 default:
24441 goto bad_1; /* :::::::::::::::::::: */
24442 }
24443 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlIMPLICIT);
24444 if (!ffesrc_is_name_init (*p))
24445 goto bad_0; /* :::::::::::::::::::: */
24446 ffestb_local_.decl.imp_started = FALSE;
24447 nt = ffelex_token_name_from_names (ffesta_tokens[0],
24448 FFESTR_firstlIMPLICIT, 0);
24449 kw = ffestr_second (nt);
24450 ffelex_token_kill (nt);
24451 switch (kw)
24452 {
24453 case FFESTR_secondINTEGER:
24454 ffestb_local_.decl.type = FFESTP_typeINTEGER;
24455 return (ffelexHandler) ffestb_decl_R5391_ (t);
24456
24457 case FFESTR_secondBYTE:
24458 ffestb_local_.decl.type = FFESTP_typeBYTE;
24459 return (ffelexHandler) ffestb_decl_R5391_ (t);
24460
24461 case FFESTR_secondWORD:
24462 ffestb_local_.decl.type = FFESTP_typeWORD;
24463 return (ffelexHandler) ffestb_decl_R5391_ (t);
24464
24465 case FFESTR_secondREAL:
24466 ffestb_local_.decl.type = FFESTP_typeREAL;
24467 return (ffelexHandler) ffestb_decl_R5391_ (t);
24468
24469 case FFESTR_secondCOMPLEX:
24470 ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
24471 return (ffelexHandler) ffestb_decl_R5391_ (t);
24472
24473 case FFESTR_secondLOGICAL:
24474 ffestb_local_.decl.type = FFESTP_typeLOGICAL;
24475 return (ffelexHandler) ffestb_decl_R5391_ (t);
24476
24477 case FFESTR_secondCHARACTER:
24478 ffestb_local_.decl.type = FFESTP_typeCHARACTER;
24479 return (ffelexHandler) ffestb_decl_R5391_ (t);
24480
24481 case FFESTR_secondDOUBLEPRECISION:
24482 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
24483 ffestb_local_.decl.kind = NULL;
24484 ffestb_local_.decl.kindt = NULL;
24485 ffestb_local_.decl.len = NULL;
24486 ffestb_local_.decl.lent = NULL;
24487 return (ffelexHandler) ffestb_decl_R539letters_ (t);
24488
24489 case FFESTR_secondDOUBLECOMPLEX:
24490 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
24491 ffestb_local_.decl.kind = NULL;
24492 ffestb_local_.decl.kindt = NULL;
24493 ffestb_local_.decl.len = NULL;
24494 ffestb_local_.decl.lent = NULL;
24495 return (ffelexHandler) ffestb_decl_R539letters_ (t);
24496
24497 case FFESTR_secondNONE:
24498 return (ffelexHandler) ffestb_decl_R5394_ (t);
24499
24500#if FFESTR_F90
24501 case FFESTR_secondTYPE:
24502 ffestb_local_.decl.type = FFESTP_typeTYPE;
24503 return (ffelexHandler) ffestb_decl_R5393_ (t);
24504#endif
24505
24506 default:
24507 goto bad_1; /* :::::::::::::::::::: */
24508 }
24509
24510 default:
24511 goto bad_0; /* :::::::::::::::::::: */
24512 }
24513
24514bad_0: /* :::::::::::::::::::: */
24515 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", ffesta_tokens[0]);
24516 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24517
24518bad_1: /* :::::::::::::::::::: */
24519 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24520 return (ffelexHandler) ffelex_swallow_tokens (t,
24521 (ffelexHandler) ffesta_zero); /* Invalid second token. */
24522}
24523
24524/* ffestb_decl_R5391_ -- "IMPLICIT" generic-type
24525
24526 return ffestb_decl_R5391_; // to lexer
24527
24528 Handle ASTERISK or OPEN_PAREN. */
24529
24530static ffelexHandler
24531ffestb_decl_R5391_ (ffelexToken t)
24532{
24533 switch (ffelex_token_type (t))
24534 {
24535 case FFELEX_typeASTERISK:
24536 ffesta_confirmed ();
24537 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_R539letters_;
24538 ffestb_local_.decl.badname = "IMPLICIT";
24539 if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
24540 return (ffelexHandler) ffestb_decl_starlen_;
24541 return (ffelexHandler) ffestb_decl_starkind_;
24542
24543 case FFELEX_typeOPEN_PAREN:
24544 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_R539letters_;
24545 ffestb_local_.decl.badname = "IMPLICIT";
24546 ffestb_local_.decl.kind = NULL;
24547 ffestb_local_.decl.kindt = NULL;
24548 ffestb_local_.decl.len = NULL;
24549 ffestb_local_.decl.lent = NULL;
24550 if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
24551 ffestb_local_.decl.imp_handler
24552 = (ffelexHandler) ffestb_decl_typeparams_;
24553 else
24554 ffestb_local_.decl.imp_handler
24555 = (ffelexHandler) ffestb_decl_kindparam_;
24556 return (ffelexHandler) ffestb_decl_R539maybe_ (t);
24557
24558 default:
24559 break;
24560 }
24561
24562 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24563 ffestc_R539finish ();
24564 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24565 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24566}
24567
24568/* ffestb_decl_R5392_ -- "IMPLICIT" "DOUBLE"
24569
24570 return ffestb_decl_R5392_; // to lexer
24571
24572 Handle NAME. */
24573
24574static ffelexHandler
24575ffestb_decl_R5392_ (ffelexToken t)
24576{
24577 switch (ffelex_token_type (t))
24578 {
24579 case FFELEX_typeNAME:
24580 switch (ffestr_second (t))
24581 {
24582 case FFESTR_secondPRECISION:
24583 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
24584 break;
24585
24586 case FFESTR_secondCOMPLEX:
24587 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
24588 break;
24589
24590 default:
24591 goto bad; /* :::::::::::::::::::: */
24592 }
24593 ffestb_local_.decl.kind = NULL;
24594 ffestb_local_.decl.kindt = NULL;
24595 ffestb_local_.decl.len = NULL;
24596 ffestb_local_.decl.lent = NULL;
24597 return (ffelexHandler) ffestb_decl_R539letters_;
24598
24599 default:
24600 break;
24601 }
24602
24603bad: /* :::::::::::::::::::: */
24604 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24605 ffestc_R539finish ();
24606 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24607 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24608}
24609
24610/* ffestb_decl_R5393_ -- "IMPLICIT" "TYPE"
24611
24612 return ffestb_decl_R5393_; // to lexer
24613
24614 Handle OPEN_PAREN. */
24615
24616#if FFESTR_F90
24617static ffelexHandler
24618ffestb_decl_R5393_ (ffelexToken t)
24619{
24620 switch (ffelex_token_type (t))
24621 {
24622 case FFELEX_typeOPEN_PAREN:
24623 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_R539letters_;
24624 ffestb_local_.decl.badname = "IMPLICIT";
24625 return (ffelexHandler) ffestb_decl_typetype1_;
24626
24627 default:
24628 break;
24629 }
24630
24631 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24632 ffestc_R539finish ();
24633 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24634 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24635}
24636
24637#endif
24638/* ffestb_decl_R5394_ -- "IMPLICIT" "NONE"
24639
24640 return ffestb_decl_R5394_; // to lexer
24641
24642 Handle EOS/SEMICOLON. */
24643
24644static ffelexHandler
24645ffestb_decl_R5394_ (ffelexToken t)
24646{
24647 switch (ffelex_token_type (t))
24648 {
24649 case FFELEX_typeEOS:
24650 case FFELEX_typeSEMICOLON:
24651 ffesta_confirmed ();
24652 if (!ffesta_is_inhibited ())
24653 ffestc_R539 (); /* IMPLICIT NONE. */
24654 return (ffelexHandler) ffesta_zero (t);
24655
24656 default:
24657 break;
24658 }
24659
24660 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24661 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24662}
24663
24664/* ffestb_decl_R5395_ -- "IMPLICIT" implicit-spec-list COMMA
24665
24666 return ffestb_decl_R5395_; // to lexer
24667
24668 Handle NAME for next type-spec. */
24669
24670static ffelexHandler
24671ffestb_decl_R5395_ (ffelexToken t)
24672{
24673 switch (ffelex_token_type (t))
24674 {
24675 case FFELEX_typeNAME:
24676 switch (ffestr_second (t))
24677 {
24678 case FFESTR_secondINTEGER:
24679 ffestb_local_.decl.type = FFESTP_typeINTEGER;
24680 return (ffelexHandler) ffestb_decl_R5391_;
24681
24682 case FFESTR_secondBYTE:
24683 ffestb_local_.decl.type = FFESTP_typeBYTE;
24684 return (ffelexHandler) ffestb_decl_R5391_;
24685
24686 case FFESTR_secondWORD:
24687 ffestb_local_.decl.type = FFESTP_typeWORD;
24688 return (ffelexHandler) ffestb_decl_R5391_;
24689
24690 case FFESTR_secondREAL:
24691 ffestb_local_.decl.type = FFESTP_typeREAL;
24692 return (ffelexHandler) ffestb_decl_R5391_;
24693
24694 case FFESTR_secondCOMPLEX:
24695 ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
24696 return (ffelexHandler) ffestb_decl_R5391_;
24697
24698 case FFESTR_secondLOGICAL:
24699 ffestb_local_.decl.type = FFESTP_typeLOGICAL;
24700 return (ffelexHandler) ffestb_decl_R5391_;
24701
24702 case FFESTR_secondCHARACTER:
24703 ffestb_local_.decl.type = FFESTP_typeCHARACTER;
24704 return (ffelexHandler) ffestb_decl_R5391_;
24705
24706 case FFESTR_secondDOUBLE:
24707 return (ffelexHandler) ffestb_decl_R5392_;
24708
24709 case FFESTR_secondDOUBLEPRECISION:
24710 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
24711 ffestb_local_.decl.kind = NULL;
24712 ffestb_local_.decl.kindt = NULL;
24713 ffestb_local_.decl.len = NULL;
24714 ffestb_local_.decl.lent = NULL;
24715 return (ffelexHandler) ffestb_decl_R539letters_;
24716
24717 case FFESTR_secondDOUBLECOMPLEX:
24718 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
24719 ffestb_local_.decl.kind = NULL;
24720 ffestb_local_.decl.kindt = NULL;
24721 ffestb_local_.decl.len = NULL;
24722 ffestb_local_.decl.lent = NULL;
24723 return (ffelexHandler) ffestb_decl_R539letters_;
24724
24725#if FFESTR_F90
24726 case FFESTR_secondTYPE:
24727 ffestb_local_.decl.type = FFESTP_typeTYPE;
24728 return (ffelexHandler) ffestb_decl_R5393_;
24729#endif
24730
24731 default:
24732 break;
24733 }
24734 break;
24735
24736 default:
24737 break;
24738 }
24739
24740 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24741 ffestc_R539finish ();
24742 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24743 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24744}
24745
24746/* ffestb_decl_R539letters_ -- "IMPLICIT" type-spec
24747
24748 return ffestb_decl_R539letters_; // to lexer
24749
24750 Handle OPEN_PAREN. */
24751
24752static ffelexHandler
24753ffestb_decl_R539letters_ (ffelexToken t)
24754{
24755 ffelex_set_names (FALSE);
24756
24757 switch (ffelex_token_type (t))
24758 {
24759 case FFELEX_typeOPEN_PAREN:
24760 ffestb_local_.decl.imps = ffestt_implist_create ();
24761 return (ffelexHandler) ffestb_decl_R539letters_1_;
24762
24763 default:
24764 break;
24765 }
24766
24767 if (ffestb_local_.decl.kindt != NULL)
24768 ffelex_token_kill (ffestb_local_.decl.kindt);
24769 if (ffestb_local_.decl.lent != NULL)
24770 ffelex_token_kill (ffestb_local_.decl.lent);
24771 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24772 ffestc_R539finish ();
24773 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24774 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24775}
24776
24777/* ffestb_decl_R539letters_1_ -- "IMPLICIT" type-spec OPEN_PAREN
24778
24779 return ffestb_decl_R539letters_1_; // to lexer
24780
24781 Handle NAME. */
24782
24783static ffelexHandler
24784ffestb_decl_R539letters_1_ (ffelexToken t)
24785{
24786 switch (ffelex_token_type (t))
24787 {
24788 case FFELEX_typeNAME:
24789 if (ffelex_token_length (t) != 1)
24790 break;
24791 ffesta_tokens[1] = ffelex_token_use (t);
24792 return (ffelexHandler) ffestb_decl_R539letters_2_;
24793
24794 default:
24795 break;
24796 }
24797
24798 ffestt_implist_kill (ffestb_local_.decl.imps);
24799 if (ffestb_local_.decl.kindt != NULL)
24800 ffelex_token_kill (ffestb_local_.decl.kindt);
24801 if (ffestb_local_.decl.lent != NULL)
24802 ffelex_token_kill (ffestb_local_.decl.lent);
24803 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24804 ffestc_R539finish ();
24805 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24806 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24807}
24808
24809/* ffestb_decl_R539letters_2_ -- "IMPLICIT" type-spec OPEN_PAREN NAME
24810
24811 return ffestb_decl_R539letters_2_; // to lexer
24812
24813 Handle COMMA or MINUS. */
24814
24815static ffelexHandler
24816ffestb_decl_R539letters_2_ (ffelexToken t)
24817{
24818 switch (ffelex_token_type (t))
24819 {
24820 case FFELEX_typeCOMMA:
24821 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
24822 return (ffelexHandler) ffestb_decl_R539letters_1_;
24823
24824 case FFELEX_typeCLOSE_PAREN:
24825 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
24826 return (ffelexHandler) ffestb_decl_R539letters_5_;
24827
24828 case FFELEX_typeMINUS:
24829 return (ffelexHandler) ffestb_decl_R539letters_3_;
24830
24831 default:
24832 break;
24833 }
24834
24835 ffelex_token_kill (ffesta_tokens[1]);
24836 ffestt_implist_kill (ffestb_local_.decl.imps);
24837 if (ffestb_local_.decl.kindt != NULL)
24838 ffelex_token_kill (ffestb_local_.decl.kindt);
24839 if (ffestb_local_.decl.lent != NULL)
24840 ffelex_token_kill (ffestb_local_.decl.lent);
24841 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24842 ffestc_R539finish ();
24843 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24844 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24845}
24846
24847/* ffestb_decl_R539letters_3_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
24848
24849 return ffestb_decl_R539letters_3_; // to lexer
24850
24851 Handle NAME. */
24852
24853static ffelexHandler
24854ffestb_decl_R539letters_3_ (ffelexToken t)
24855{
24856 switch (ffelex_token_type (t))
24857 {
24858 case FFELEX_typeNAME:
24859 if (ffelex_token_length (t) != 1)
24860 break;
24861 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1],
24862 ffelex_token_use (t));
24863 return (ffelexHandler) ffestb_decl_R539letters_4_;
24864
24865 default:
24866 break;
24867 }
24868
24869 ffelex_token_kill (ffesta_tokens[1]);
24870 ffestt_implist_kill (ffestb_local_.decl.imps);
24871 if (ffestb_local_.decl.kindt != NULL)
24872 ffelex_token_kill (ffestb_local_.decl.kindt);
24873 if (ffestb_local_.decl.lent != NULL)
24874 ffelex_token_kill (ffestb_local_.decl.lent);
24875 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24876 ffestc_R539finish ();
24877 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24878 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24879}
24880
24881/* ffestb_decl_R539letters_4_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
24882 NAME
24883
24884 return ffestb_decl_R539letters_4_; // to lexer
24885
24886 Handle COMMA or CLOSE_PAREN. */
24887
24888static ffelexHandler
24889ffestb_decl_R539letters_4_ (ffelexToken t)
24890{
24891 switch (ffelex_token_type (t))
24892 {
24893 case FFELEX_typeCOMMA:
24894 return (ffelexHandler) ffestb_decl_R539letters_1_;
24895
24896 case FFELEX_typeCLOSE_PAREN:
24897 return (ffelexHandler) ffestb_decl_R539letters_5_;
24898
24899 default:
24900 break;
24901 }
24902
24903 ffestt_implist_kill (ffestb_local_.decl.imps);
24904 if (ffestb_local_.decl.kindt != NULL)
24905 ffelex_token_kill (ffestb_local_.decl.kindt);
24906 if (ffestb_local_.decl.lent != NULL)
24907 ffelex_token_kill (ffestb_local_.decl.lent);
24908 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24909 ffestc_R539finish ();
24910 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24911 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24912}
24913
24914/* ffestb_decl_R539letters_5_ -- "IMPLICIT" type-spec OPEN_PAREN
24915 letter-spec-list CLOSE_PAREN
24916
24917 return ffestb_decl_R539letters_5_; // to lexer
24918
24919 Handle COMMA or EOS/SEMICOLON. */
24920
24921static ffelexHandler
24922ffestb_decl_R539letters_5_ (ffelexToken t)
24923{
24924 switch (ffelex_token_type (t))
24925 {
24926 case FFELEX_typeCOMMA:
24927 case FFELEX_typeEOS:
24928 case FFELEX_typeSEMICOLON:
24929 if (!ffestb_local_.decl.imp_started)
24930 {
24931 ffestb_local_.decl.imp_started = TRUE;
24932 ffesta_confirmed ();
24933 if (!ffesta_is_inhibited ())
24934 ffestc_R539start ();
24935 }
24936 if (!ffesta_is_inhibited ())
24937 ffestc_R539item (ffestb_local_.decl.type, ffestb_local_.decl.kind,
24938 ffestb_local_.decl.kindt, ffestb_local_.decl.len,
24939 ffestb_local_.decl.lent, ffestb_local_.decl.imps);
24940 if (ffestb_local_.decl.kindt != NULL)
24941 ffelex_token_kill (ffestb_local_.decl.kindt);
24942 if (ffestb_local_.decl.lent != NULL)
24943 ffelex_token_kill (ffestb_local_.decl.lent);
24944 ffestt_implist_kill (ffestb_local_.decl.imps);
24945 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
24946 return (ffelexHandler) ffestb_decl_R5395_;
24947 if (!ffesta_is_inhibited ())
24948 ffestc_R539finish ();
24949 return (ffelexHandler) ffesta_zero (t);
24950
24951 default:
24952 break;
24953 }
24954
24955 ffestt_implist_kill (ffestb_local_.decl.imps);
24956 if (ffestb_local_.decl.kindt != NULL)
24957 ffelex_token_kill (ffestb_local_.decl.kindt);
24958 if (ffestb_local_.decl.lent != NULL)
24959 ffelex_token_kill (ffestb_local_.decl.lent);
24960 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24961 ffestc_R539finish ();
24962 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24963 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24964}
24965
24966/* ffestb_decl_R539maybe_ -- "IMPLICIT" generic-type-spec
24967
24968 return ffestb_decl_R539maybe_; // to lexer
24969
24970 Handle OPEN_PAREN. */
24971
24972static ffelexHandler
24973ffestb_decl_R539maybe_ (ffelexToken t)
24974{
24975 assert (ffelex_token_type (t) == FFELEX_typeOPEN_PAREN);
24976 ffestb_local_.decl.imps = ffestt_implist_create ();
24977 ffestb_local_.decl.toklist = ffestt_tokenlist_create ();
24978 ffestb_local_.decl.imp_seen_comma
24979 = (ffestb_local_.decl.type != FFESTP_typeCHARACTER);
24980 return (ffelexHandler) ffestb_decl_R539maybe_1_;
24981}
24982
24983/* ffestb_decl_R539maybe_1_ -- "IMPLICIT" generic-type-spec OPEN_PAREN
24984
24985 return ffestb_decl_R539maybe_1_; // to lexer
24986
24987 Handle NAME. */
24988
24989static ffelexHandler
24990ffestb_decl_R539maybe_1_ (ffelexToken t)
24991{
24992 ffelexHandler next;
24993
24994 switch (ffelex_token_type (t))
24995 {
24996 case FFELEX_typeNAME:
24997 if (ffelex_token_length (t) != 1)
24998 break;
24999 ffesta_tokens[1] = ffelex_token_use (t);
25000 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
25001 return (ffelexHandler) ffestb_decl_R539maybe_2_;
25002
25003 default:
25004 break;
25005 }
25006
25007 ffestt_implist_kill (ffestb_local_.decl.imps);
25008 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
25009 (ffelexHandler) ffestb_local_.decl.imp_handler);
25010 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
25011 return (ffelexHandler) (*next) (t);
25012}
25013
25014/* ffestb_decl_R539maybe_2_ -- "IMPLICIT" generic-type-spec OPEN_PAREN NAME
25015
25016 return ffestb_decl_R539maybe_2_; // to lexer
25017
25018 Handle COMMA or MINUS. */
25019
25020static ffelexHandler
25021ffestb_decl_R539maybe_2_ (ffelexToken t)
25022{
25023 ffelexHandler next;
25024
25025 switch (ffelex_token_type (t))
25026 {
25027 case FFELEX_typeCOMMA:
25028 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
25029 if (ffestb_local_.decl.imp_seen_comma)
25030 {
25031 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
25032 return (ffelexHandler) ffestb_decl_R539letters_1_;
25033 }
25034 ffestb_local_.decl.imp_seen_comma = TRUE;
25035 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
25036 return (ffelexHandler) ffestb_decl_R539maybe_1_;
25037
25038 case FFELEX_typeCLOSE_PAREN:
25039 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
25040 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
25041 return (ffelexHandler) ffestb_decl_R539maybe_5_;
25042
25043 case FFELEX_typeMINUS:
25044 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
25045 return (ffelexHandler) ffestb_decl_R539maybe_3_;
25046
25047 default:
25048 break;
25049 }
25050
25051 ffelex_token_kill (ffesta_tokens[1]);
25052 ffestt_implist_kill (ffestb_local_.decl.imps);
25053 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
25054 (ffelexHandler) ffestb_local_.decl.imp_handler);
25055 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
25056 return (ffelexHandler) (*next) (t);
25057}
25058
25059/* ffestb_decl_R539maybe_3_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
25060
25061 return ffestb_decl_R539maybe_3_; // to lexer
25062
25063 Handle NAME. */
25064
25065static ffelexHandler
25066ffestb_decl_R539maybe_3_ (ffelexToken t)
25067{
25068 ffelexHandler next;
25069
25070 switch (ffelex_token_type (t))
25071 {
25072 case FFELEX_typeNAME:
25073 if (ffelex_token_length (t) != 1)
25074 break;
25075 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1],
25076 ffelex_token_use (t));
25077 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
25078 return (ffelexHandler) ffestb_decl_R539maybe_4_;
25079
25080 default:
25081 break;
25082 }
25083
25084 ffelex_token_kill (ffesta_tokens[1]);
25085 ffestt_implist_kill (ffestb_local_.decl.imps);
25086 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
25087 (ffelexHandler) ffestb_local_.decl.imp_handler);
25088 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
25089 return (ffelexHandler) (*next) (t);
25090}
25091
25092/* ffestb_decl_R539maybe_4_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
25093 NAME
25094
25095 return ffestb_decl_R539maybe_4_; // to lexer
25096
25097 Handle COMMA or CLOSE_PAREN. */
25098
25099static ffelexHandler
25100ffestb_decl_R539maybe_4_ (ffelexToken t)
25101{
25102 ffelexHandler next;
25103
25104 switch (ffelex_token_type (t))
25105 {
25106 case FFELEX_typeCOMMA:
25107 if (ffestb_local_.decl.imp_seen_comma)
25108 {
25109 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
25110 return (ffelexHandler) ffestb_decl_R539letters_1_;
25111 }
25112 ffestb_local_.decl.imp_seen_comma = TRUE;
25113 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
25114 return (ffelexHandler) ffestb_decl_R539maybe_1_;
25115
25116 case FFELEX_typeCLOSE_PAREN:
25117 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
25118 return (ffelexHandler) ffestb_decl_R539maybe_5_;
25119
25120 default:
25121 break;
25122 }
25123
25124 ffestt_implist_kill (ffestb_local_.decl.imps);
25125 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
25126 (ffelexHandler) ffestb_local_.decl.imp_handler);
25127 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
25128 return (ffelexHandler) (*next) (t);
25129}
25130
25131/* ffestb_decl_R539maybe_5_ -- "IMPLICIT" type-spec OPEN_PAREN
25132 letter-spec-list CLOSE_PAREN
25133
25134 return ffestb_decl_R539maybe_5_; // to lexer
25135
25136 Handle COMMA or EOS/SEMICOLON. */
25137
25138static ffelexHandler
25139ffestb_decl_R539maybe_5_ (ffelexToken t)
25140{
25141 ffelexHandler next;
25142
25143 switch (ffelex_token_type (t))
25144 {
25145 case FFELEX_typeCOMMA:
25146 case FFELEX_typeEOS:
25147 case FFELEX_typeSEMICOLON:
25148 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
25149 if (!ffestb_local_.decl.imp_started)
25150 {
25151 ffestb_local_.decl.imp_started = TRUE;
25152 ffesta_confirmed ();
25153 if (!ffesta_is_inhibited ())
25154 ffestc_R539start ();
25155 }
25156 if (!ffesta_is_inhibited ())
25157 ffestc_R539item (ffestb_local_.decl.type, ffestb_local_.decl.kind,
25158 ffestb_local_.decl.kindt, ffestb_local_.decl.len,
25159 ffestb_local_.decl.lent, ffestb_local_.decl.imps);
25160 if (ffestb_local_.decl.kindt != NULL)
25161 ffelex_token_kill (ffestb_local_.decl.kindt);
25162 if (ffestb_local_.decl.lent != NULL)
25163 ffelex_token_kill (ffestb_local_.decl.lent);
25164 ffestt_implist_kill (ffestb_local_.decl.imps);
25165 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
25166 return (ffelexHandler) ffestb_decl_R5395_;
25167 if (!ffesta_is_inhibited ())
25168 ffestc_R539finish ();
25169 return (ffelexHandler) ffesta_zero (t);
25170
25171 case FFELEX_typeOPEN_PAREN:
25172 ffesta_confirmed ();
25173 ffestt_implist_kill (ffestb_local_.decl.imps);
25174 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
25175 (ffelexHandler) ffestb_local_.decl.imp_handler);
25176 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
25177 return (ffelexHandler) (*next) (t);
25178
25179 default:
25180 break;
25181 }
25182
25183 ffestt_implist_kill (ffestb_local_.decl.imps);
25184 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
25185 if (ffestb_local_.decl.kindt != NULL)
25186 ffelex_token_kill (ffestb_local_.decl.kindt);
25187 if (ffestb_local_.decl.lent != NULL)
25188 ffelex_token_kill (ffestb_local_.decl.lent);
25189 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
25190 ffestc_R539finish ();
25191 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
25192 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
25193}
GNU Compiler Collection
This page took 2.220268 seconds and 5 git commands to generate.