?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
* Makefile.in (SYSTEM_H): Define.
[official-gcc.git] / gcc / f / stb.c
blobef523c4e11740cc165ecfd57271ee84040e6ac5e
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.
4
5 This file is part of GNU Fortran.
6
7 GNU Fortran is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
11
12 GNU Fortran is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Fortran; see the file COPYING. If not, write to
19 the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
20 02111-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 "stb.h"
92 #include "bad.h"
93 #include "expr.h"
94 #include "lex.h"
95 #include "malloc.h"
96 #include "src.h"
97 #include "sta.h"
98 #include "stc.h"
99 #include "stp.h"
100 #include "str.h"
101
102 /* Externals defined here. */
103
104 struct _ffestb_args_ ffestb_args;
105
106 /* Simple definitions and enumerations. */
107
108 #define FFESTB_KILL_EASY_ 1 /* 1 for only one _subr_kill_xyz_ fn. */
109
110 /* Internal typedefs. */
111
112 union ffestb_subrargs_u_
113 {
114 struct
115 {
116 ffesttTokenList labels; /* Input arg, must not be NULL. */
117 ffelexHandler handler; /* Input arg, call me when done. */
118 bool ok; /* Output arg, TRUE if list ended in
119 CLOSE_PAREN. */
120 }
121 label_list;
122 struct
123 {
124 ffesttDimList dims; /* Input arg, must not be NULL. */
125 ffelexHandler handler; /* Input arg, call me when done. */
126 mallocPool pool; /* Pool to allocate into. */
127 bool ok; /* Output arg, TRUE if list ended in
128 CLOSE_PAREN. */
129 ffeexprContext ctx; /* DIMLIST or DIMLISTCOMMON. */
130 #ifdef FFECOM_dimensionsMAX
131 int ndims; /* For backends that really can't have
132 infinite dims. */
133 #endif
134 }
135 dim_list;
136 struct
137 {
138 ffesttTokenList args; /* Input arg, must not be NULL. */
139 ffelexHandler handler; /* Input arg, call me when done. */
140 ffelexToken close_paren;/* Output arg if ok, CLOSE_PAREN token. */
141 bool is_subr; /* Input arg, TRUE if list in subr-def
142 context. */
143 bool ok; /* Output arg, TRUE if list ended in
144 CLOSE_PAREN. */
145 bool names; /* Do ffelex_set_names(TRUE) before return. */
146 }
147 name_list;
148 };
149
150 union ffestb_local_u_
151 {
152 struct
153 {
154 ffebld expr;
155 }
156 call_stmt;
157 struct
158 {
159 ffebld expr;
160 }
161 go_to;
162 struct
163 {
164 ffebld dest;
165 bool vxtparam; /* If assignment might really be VXT
166 PARAMETER stmt. */
167 }
168 let;
169 struct
170 {
171 ffebld expr;
172 }
173 if_stmt;
174 struct
175 {
176 ffebld expr;
177 }
178 else_stmt;
179 struct
180 {
181 ffebld expr;
182 }
183 dowhile;
184 struct
185 {
186 ffebld var;
187 ffebld start;
188 ffebld end;
189 }
190 do_stmt;
191 struct
192 {
193 bool is_cblock;
194 }
195 R522;
196 struct
197 {
198 ffebld expr;
199 bool started;
200 }
201 parameter;
202 struct
203 {
204 ffesttExprList exprs;
205 bool started;
206 }
207 equivalence;
208 struct
209 {
210 ffebld expr;
211 bool started;
212 }
213 data;
214 struct
215 {
216 ffestrOther kw;
217 }
218 varlist;
219 #if FFESTR_F90
220 struct
221 {
222 ffestrOther kw;
223 }
224 type;
225 #endif
226 struct
227 {
228 ffelexHandler next;
229 }
230 construct;
231 struct
232 {
233 ffesttFormatList f;
234 ffestpFormatType current; /* What we're currently working on. */
235 ffelexToken t; /* Token of what we're currently working on. */
236 ffesttFormatValue pre;
237 ffesttFormatValue post;
238 ffesttFormatValue dot;
239 ffesttFormatValue exp;
240 bool sign; /* _3_, pos/neg; elsewhere, signed/unsigned. */
241 bool complained; /* If run-time expr seen in nonexec context. */
242 }
243 format;
244 #if FFESTR_F90
245 struct
246 {
247 bool started;
248 }
249 moduleprocedure;
250 #endif
251 struct
252 {
253 ffebld expr;
254 }
255 selectcase;
256 struct
257 {
258 ffesttCaseList cases;
259 }
260 case_stmt;
261 #if FFESTR_F90
262 struct
263 {
264 ffesttExprList exprs;
265 ffebld expr;
266 }
267 heap;
268 #endif
269 #if FFESTR_F90
270 struct
271 {
272 ffesttExprList exprs;
273 }
274 R624;
275 #endif
276 #if FFESTR_F90
277 struct
278 {
279 ffestpDefinedOperator operator;
280 bool assignment; /* TRUE for INTERFACE ASSIGNMENT, FALSE for
281 ...OPERATOR. */
282 bool slash; /* TRUE if OPEN_ARRAY, FALSE if OPEN_PAREN. */
283 }
284 interface;
285 #endif
286 struct
287 {
288 bool is_cblock;
289 }
290 V014;
291 #if FFESTR_VXT
292 struct
293 {
294 bool started;
295 ffebld u;
296 ffebld m;
297 ffebld n;
298 ffebld asv;
299 }
300 V025;
301 #endif
302 struct
303 {
304 ffestpBeruIx ix;
305 bool label;
306 bool left;
307 ffeexprContext context;
308 }
309 beru;
310 struct
311 {
312 ffestpCloseIx ix;
313 bool label;
314 bool left;
315 ffeexprContext context;
316 }
317 close;
318 struct
319 {
320 ffestpDeleteIx ix;
321 bool label;
322 bool left;
323 ffeexprContext context;
324 }
325 delete;
326 struct
327 {
328 ffestpDeleteIx ix;
329 bool label;
330 bool left;
331 ffeexprContext context;
332 }
333 find;
334 struct
335 {
336 ffestpInquireIx ix;
337 bool label;
338 bool left;
339 ffeexprContext context;
340 bool may_be_iolength;
341 }
342 inquire;
343 struct
344 {
345 ffestpOpenIx ix;
346 bool label;
347 bool left;
348 ffeexprContext context;
349 }
350 open;
351 struct
352 {
353 ffestpReadIx ix;
354 bool label;
355 bool left;
356 ffeexprContext context;
357 }
358 read;
359 struct
360 {
361 ffestpRewriteIx ix;
362 bool label;
363 bool left;
364 ffeexprContext context;
365 }
366 rewrite;
367 struct
368 {
369 ffestpWriteIx ix;
370 bool label;
371 bool left;
372 ffeexprContext context;
373 }
374 vxtcode;
375 struct
376 {
377 ffestpWriteIx ix;
378 bool label;
379 bool left;
380 ffeexprContext context;
381 }
382 write;
383 #if FFESTR_F90
384 struct
385 {
386 bool started;
387 }
388 structure;
389 #endif
390 struct
391 {
392 bool started;
393 }
394 common;
395 struct
396 {
397 bool started;
398 }
399 dimension;
400 struct
401 {
402 bool started;
403 }
404 dimlist;
405 struct
406 {
407 const char *badname;
408 ffestrFirst first_kw;
409 bool is_subr;
410 }
411 dummy;
412 struct
413 {
414 ffebld kind; /* Kind type parameter, if any. */
415 ffelexToken kindt; /* Kind type first token, if any. */
416 ffebld len; /* Length type parameter, if any. */
417 ffelexToken lent; /* Length type parameter, if any. */
418 ffelexHandler handler;
419 ffelexToken recursive;
420 ffebld expr;
421 ffesttTokenList toklist;/* For ambiguity resolution. */
422 ffesttImpList imps; /* List of IMPLICIT letters. */
423 ffelexHandler imp_handler; /* Call if paren list wasn't letters. */
424 const char *badname;
425 ffestrOther kw; /* INTENT(IN/OUT/INOUT). */
426 ffestpType type;
427 bool parameter; /* If PARAMETER attribute seen (governs =expr
428 context). */
429 bool coloncolon; /* If COLONCOLON seen (allows =expr). */
430 bool aster_after; /* "*" seen after, not before,
431 [RECURSIVE]FUNCTIONxyz. */
432 bool empty; /* Ambig function dummy arg list empty so
433 far? */
434 bool imp_started; /* Started IMPLICIT statement already. */
435 bool imp_seen_comma; /* TRUE if next COMMA within parens means not
436 R541. */
437 }
438 decl;
439 struct
440 {
441 bool started;
442 }
443 vxtparam;
444 }; /* Merge with the one in ffestb later. */
445
446 /* Private include files. */
447
448
449 /* Internal structure definitions. */
450
451
452 /* Static objects accessed by functions in this module. */
453
454 static union ffestb_subrargs_u_ ffestb_subrargs_;
455 static union ffestb_local_u_ ffestb_local_;
456
457 /* Static functions (internal). */
458
459 static void ffestb_subr_ambig_to_ents_ (void);
460 static ffelexHandler ffestb_subr_ambig_nope_ (ffelexToken t);
461 static ffelexHandler ffestb_subr_dimlist_ (ffelexToken ft, ffebld expr,
462 ffelexToken t);
463 static ffelexHandler ffestb_subr_dimlist_1_ (ffelexToken ft, ffebld expr,
464 ffelexToken t);
465 static ffelexHandler ffestb_subr_dimlist_2_ (ffelexToken ft, ffebld expr,
466 ffelexToken t);
467 static ffelexHandler ffestb_subr_name_list_ (ffelexToken t);
468 static ffelexHandler ffestb_subr_name_list_1_ (ffelexToken t);
469 static void ffestb_subr_R1001_append_p_ (void);
470 static ffelexHandler ffestb_decl_kindparam_ (ffelexToken t);
471 static ffelexHandler ffestb_decl_kindparam_1_ (ffelexToken t);
472 static ffelexHandler ffestb_decl_kindparam_2_ (ffelexToken ft, ffebld expr,
473 ffelexToken t);
474 static ffelexHandler ffestb_decl_starkind_ (ffelexToken t);
475 static ffelexHandler ffestb_decl_starlen_ (ffelexToken t);
476 static ffelexHandler ffestb_decl_starlen_1_ (ffelexToken ft, ffebld expr,
477 ffelexToken t);
478 static ffelexHandler ffestb_decl_typeparams_ (ffelexToken t);
479 static ffelexHandler ffestb_decl_typeparams_1_ (ffelexToken t);
480 static ffelexHandler ffestb_decl_typeparams_2_ (ffelexToken ft, ffebld expr,
481 ffelexToken t);
482 static ffelexHandler ffestb_decl_typeparams_3_ (ffelexToken ft, ffebld expr,
483 ffelexToken t);
484 #if FFESTR_F90
485 static ffelexHandler ffestb_decl_typetype1_ (ffelexToken t);
486 static ffelexHandler ffestb_decl_typetype2_ (ffelexToken t);
487 #endif
488 static ffelexHandler ffestb_subr_label_list_ (ffelexToken t);
489 static ffelexHandler ffestb_subr_label_list_1_ (ffelexToken t);
490 static ffelexHandler ffestb_do1_ (ffelexToken t);
491 static ffelexHandler ffestb_do2_ (ffelexToken t);
492 static ffelexHandler ffestb_do3_ (ffelexToken t);
493 static ffelexHandler ffestb_do4_ (ffelexToken ft, ffebld expr,
494 ffelexToken t);
495 static ffelexHandler ffestb_do5_ (ffelexToken t);
496 static ffelexHandler ffestb_do6_ (ffelexToken ft, ffebld expr,
497 ffelexToken t);
498 static ffelexHandler ffestb_do7_ (ffelexToken ft, ffebld expr,
499 ffelexToken t);
500 static ffelexHandler ffestb_do8_ (ffelexToken ft, ffebld expr,
501 ffelexToken t);
502 static ffelexHandler ffestb_do9_ (ffelexToken ft, ffebld expr,
503 ffelexToken t);
504 static ffelexHandler ffestb_else1_ (ffelexToken t);
505 static ffelexHandler ffestb_else2_ (ffelexToken ft, ffebld expr,
506 ffelexToken t);
507 static ffelexHandler ffestb_else3_ (ffelexToken t);
508 static ffelexHandler ffestb_else4_ (ffelexToken t);
509 static ffelexHandler ffestb_else5_ (ffelexToken t);
510 static ffelexHandler ffestb_end1_ (ffelexToken t);
511 static ffelexHandler ffestb_end2_ (ffelexToken t);
512 static ffelexHandler ffestb_end3_ (ffelexToken t);
513 static ffelexHandler ffestb_goto1_ (ffelexToken t);
514 static ffelexHandler ffestb_goto2_ (ffelexToken t);
515 static ffelexHandler ffestb_goto3_ (ffelexToken t);
516 static ffelexHandler ffestb_goto4_ (ffelexToken ft, ffebld expr,
517 ffelexToken t);
518 static ffelexHandler ffestb_goto5_ (ffelexToken ft, ffebld expr,
519 ffelexToken t);
520 static ffelexHandler ffestb_goto6_ (ffelexToken t);
521 static ffelexHandler ffestb_goto7_ (ffelexToken t);
522 static ffelexHandler ffestb_halt1_ (ffelexToken ft, ffebld expr,
523 ffelexToken t);
524 static ffelexHandler ffestb_if1_ (ffelexToken ft, ffebld expr,
525 ffelexToken t);
526 static ffelexHandler ffestb_if2_ (ffelexToken t);
527 static ffelexHandler ffestb_if3_ (ffelexToken t);
528 static ffelexHandler ffestb_let1_ (ffelexToken ft, ffebld expr,
529 ffelexToken t);
530 static ffelexHandler ffestb_let2_ (ffelexToken ft, ffebld expr,
531 ffelexToken t);
532 #if FFESTR_F90
533 static ffelexHandler ffestb_type1_ (ffelexToken t);
534 static ffelexHandler ffestb_type2_ (ffelexToken t);
535 static ffelexHandler ffestb_type3_ (ffelexToken t);
536 static ffelexHandler ffestb_type4_ (ffelexToken t);
537 #endif
538 #if FFESTR_F90
539 static ffelexHandler ffestb_varlist1_ (ffelexToken t);
540 static ffelexHandler ffestb_varlist2_ (ffelexToken t);
541 static ffelexHandler ffestb_varlist3_ (ffelexToken t);
542 static ffelexHandler ffestb_varlist4_ (ffelexToken t);
543 #endif
544 static ffelexHandler ffestb_varlist5_ (ffelexToken t);
545 static ffelexHandler ffestb_varlist6_ (ffelexToken t);
546 #if FFESTR_F90
547 static ffelexHandler ffestb_where1_ (ffelexToken ft, ffebld expr,
548 ffelexToken t);
549 static ffelexHandler ffestb_where2_ (ffelexToken t);
550 static ffelexHandler ffestb_where3_ (ffelexToken t);
551 #endif
552 static ffelexHandler ffestb_R5221_ (ffelexToken t);
553 static ffelexHandler ffestb_R5222_ (ffelexToken t);
554 static ffelexHandler ffestb_R5223_ (ffelexToken t);
555 static ffelexHandler ffestb_R5224_ (ffelexToken t);
556 static ffelexHandler ffestb_R5281_ (ffelexToken ft, ffebld expr,
557 ffelexToken t);
558 static ffelexHandler ffestb_R5282_ (ffelexToken ft, ffebld expr,
559 ffelexToken t);
560 static ffelexHandler ffestb_R5283_ (ffelexToken ft, ffebld expr,
561 ffelexToken t);
562 static ffelexHandler ffestb_R5284_ (ffelexToken t);
563 static ffelexHandler ffestb_R5371_ (ffelexToken ft, ffebld expr,
564 ffelexToken t);
565 static ffelexHandler ffestb_R5372_ (ffelexToken ft, ffebld expr,
566 ffelexToken t);
567 static ffelexHandler ffestb_R5373_ (ffelexToken t);
568 static ffelexHandler ffestb_R5421_ (ffelexToken t);
569 static ffelexHandler ffestb_R5422_ (ffelexToken t);
570 static ffelexHandler ffestb_R5423_ (ffelexToken t);
571 static ffelexHandler ffestb_R5424_ (ffelexToken t);
572 static ffelexHandler ffestb_R5425_ (ffelexToken t);
573 static ffelexHandler ffestb_R5441_ (ffelexToken ft, ffebld expr,
574 ffelexToken t);
575 static ffelexHandler ffestb_R5442_ (ffelexToken ft, ffebld expr,
576 ffelexToken t);
577 static ffelexHandler ffestb_R5443_ (ffelexToken t);
578 static ffelexHandler ffestb_R5444_ (ffelexToken t);
579 static ffelexHandler ffestb_R8341_ (ffelexToken t);
580 static ffelexHandler ffestb_R8351_ (ffelexToken t);
581 static ffelexHandler ffestb_R8381_ (ffelexToken t);
582 static ffelexHandler ffestb_R8382_ (ffelexToken t);
583 static ffelexHandler ffestb_R8383_ (ffelexToken ft, ffebld expr,
584 ffelexToken t);
585 static ffelexHandler ffestb_R8401_ (ffelexToken ft, ffebld expr,
586 ffelexToken t);
587 static ffelexHandler ffestb_R8402_ (ffelexToken t);
588 static ffelexHandler ffestb_R8403_ (ffelexToken t);
589 static ffelexHandler ffestb_R8404_ (ffelexToken t);
590 static ffelexHandler ffestb_R8405_ (ffelexToken t);
591 static ffelexHandler ffestb_R8406_ (ffelexToken t);
592 static ffelexHandler ffestb_R8407_ (ffelexToken t);
593 static ffelexHandler ffestb_R11021_ (ffelexToken t);
594 static ffelexHandler ffestb_R1111_1_ (ffelexToken t);
595 static ffelexHandler ffestb_R1111_2_ (ffelexToken t);
596 static ffelexHandler ffestb_R12121_ (ffelexToken ft, ffebld expr,
597 ffelexToken t);
598 static ffelexHandler ffestb_R12271_ (ffelexToken ft, ffebld expr,
599 ffelexToken t);
600 static ffelexHandler ffestb_construct1_ (ffelexToken t);
601 static ffelexHandler ffestb_construct2_ (ffelexToken t);
602 #if FFESTR_F90
603 static ffelexHandler ffestb_heap1_ (ffelexToken ft, ffebld expr,
604 ffelexToken t);
605 static ffelexHandler ffestb_heap2_ (ffelexToken t);
606 static ffelexHandler ffestb_heap3_ (ffelexToken t);
607 static ffelexHandler ffestb_heap4_ (ffelexToken ft, ffebld expr,
608 ffelexToken t);
609 static ffelexHandler ffestb_heap5_ (ffelexToken t);
610 #endif
611 #if FFESTR_F90
612 static ffelexHandler ffestb_module1_ (ffelexToken t);
613 static ffelexHandler ffestb_module2_ (ffelexToken t);
614 static ffelexHandler ffestb_module3_ (ffelexToken t);
615 #endif
616 static ffelexHandler ffestb_R8091_ (ffelexToken t);
617 static ffelexHandler ffestb_R8092_ (ffelexToken ft, ffebld expr,
618 ffelexToken t);
619 static ffelexHandler ffestb_R8093_ (ffelexToken t);
620 static ffelexHandler ffestb_R8101_ (ffelexToken t);
621 static ffelexHandler ffestb_R8102_ (ffelexToken t);
622 static ffelexHandler ffestb_R8103_ (ffelexToken ft, ffebld expr,
623 ffelexToken t);
624 static ffelexHandler ffestb_R8104_ (ffelexToken ft, ffebld expr,
625 ffelexToken t);
626 static ffelexHandler ffestb_R10011_ (ffelexToken t);
627 static ffelexHandler ffestb_R10012_ (ffelexToken t);
628 static ffelexHandler ffestb_R10013_ (ffelexToken t);
629 static ffelexHandler ffestb_R10014_ (ffelexToken t);
630 static ffelexHandler ffestb_R10015_ (ffelexToken t);
631 static ffelexHandler ffestb_R10016_ (ffelexToken t);
632 static ffelexHandler ffestb_R10017_ (ffelexToken t);
633 static ffelexHandler ffestb_R10018_ (ffelexToken t);
634 static ffelexHandler ffestb_R10019_ (ffelexToken t);
635 static ffelexHandler ffestb_R100110_ (ffelexToken t);
636 static ffelexHandler ffestb_R100111_ (ffelexToken t);
637 static ffelexHandler ffestb_R100112_ (ffelexToken t);
638 static ffelexHandler ffestb_R100113_ (ffelexToken t);
639 static ffelexHandler ffestb_R100114_ (ffelexToken t);
640 static ffelexHandler ffestb_R100115_ (ffelexToken ft, ffebld expr,
641 ffelexToken t);
642 static ffelexHandler ffestb_R100116_ (ffelexToken ft, ffebld expr,
643 ffelexToken t);
644 static ffelexHandler ffestb_R100117_ (ffelexToken ft, ffebld expr,
645 ffelexToken t);
646 static ffelexHandler ffestb_R100118_ (ffelexToken ft, ffebld expr,
647 ffelexToken t);
648 #if FFESTR_F90
649 static ffelexHandler ffestb_R11071_ (ffelexToken t);
650 static ffelexHandler ffestb_R11072_ (ffelexToken t);
651 static ffelexHandler ffestb_R11073_ (ffelexToken t);
652 static ffelexHandler ffestb_R11074_ (ffelexToken t);
653 static ffelexHandler ffestb_R11075_ (ffelexToken t);
654 static ffelexHandler ffestb_R11076_ (ffelexToken t);
655 static ffelexHandler ffestb_R11077_ (ffelexToken t);
656 static ffelexHandler ffestb_R11078_ (ffelexToken t);
657 static ffelexHandler ffestb_R11079_ (ffelexToken t);
658 static ffelexHandler ffestb_R110710_ (ffelexToken t);
659 static ffelexHandler ffestb_R110711_ (ffelexToken t);
660 static ffelexHandler ffestb_R110712_ (ffelexToken t);
661 #endif
662 #if FFESTR_F90
663 static ffelexHandler ffestb_R12021_ (ffelexToken t);
664 static ffelexHandler ffestb_R12022_ (ffelexToken t);
665 static ffelexHandler ffestb_R12023_ (ffelexToken t);
666 static ffelexHandler ffestb_R12024_ (ffelexToken t);
667 static ffelexHandler ffestb_R12025_ (ffelexToken t);
668 static ffelexHandler ffestb_R12026_ (ffelexToken t);
669 #endif
670 static ffelexHandler ffestb_S3P41_ (ffelexToken ft, ffebld expr,
671 ffelexToken t);
672 static ffelexHandler ffestb_V0141_ (ffelexToken t);
673 static ffelexHandler ffestb_V0142_ (ffelexToken t);
674 static ffelexHandler ffestb_V0143_ (ffelexToken t);
675 static ffelexHandler ffestb_V0144_ (ffelexToken t);
676 #if FFESTR_VXT
677 static ffelexHandler ffestb_V0251_ (ffelexToken t);
678 static ffelexHandler ffestb_V0252_ (ffelexToken ft, ffebld expr,
679 ffelexToken t);
680 static ffelexHandler ffestb_V0253_ (ffelexToken ft, ffebld expr,
681 ffelexToken t);
682 static ffelexHandler ffestb_V0254_ (ffelexToken ft, ffebld expr,
683 ffelexToken t);
684 static ffelexHandler ffestb_V0255_ (ffelexToken t);
685 static ffelexHandler ffestb_V0256_ (ffelexToken t);
686 static ffelexHandler ffestb_V0257_ (ffelexToken ft, ffebld expr,
687 ffelexToken t);
688 static ffelexHandler ffestb_V0258_ (ffelexToken t);
689 #endif
690 #if FFESTB_KILL_EASY_
691 static void ffestb_subr_kill_easy_ (ffestpInquireIx max);
692 #else
693 static void ffestb_subr_kill_accept_ (void);
694 static void ffestb_subr_kill_beru_ (void);
695 static void ffestb_subr_kill_close_ (void);
696 static void ffestb_subr_kill_delete_ (void);
697 static void ffestb_subr_kill_find_ (void); /* Not written yet. */
698 static void ffestb_subr_kill_inquire_ (void);
699 static void ffestb_subr_kill_open_ (void);
700 static void ffestb_subr_kill_print_ (void);
701 static void ffestb_subr_kill_read_ (void);
702 static void ffestb_subr_kill_rewrite_ (void);
703 static void ffestb_subr_kill_type_ (void);
704 static void ffestb_subr_kill_vxtcode_ (void); /* Not written yet. */
705 static void ffestb_subr_kill_write_ (void);
706 #endif
707 static ffelexHandler ffestb_beru1_ (ffelexToken ft, ffebld expr,
708 ffelexToken t);
709 static ffelexHandler ffestb_beru2_ (ffelexToken t);
710 static ffelexHandler ffestb_beru3_ (ffelexToken t);
711 static ffelexHandler ffestb_beru4_ (ffelexToken ft, ffebld expr,
712 ffelexToken t);
713 static ffelexHandler ffestb_beru5_ (ffelexToken t);
714 static ffelexHandler ffestb_beru6_ (ffelexToken t);
715 static ffelexHandler ffestb_beru7_ (ffelexToken ft, ffebld expr,
716 ffelexToken t);
717 static ffelexHandler ffestb_beru8_ (ffelexToken t);
718 static ffelexHandler ffestb_beru9_ (ffelexToken t);
719 static ffelexHandler ffestb_beru10_ (ffelexToken t);
720 #if FFESTR_VXT
721 static ffelexHandler ffestb_vxtcode1_ (ffelexToken ft, ffebld expr,
722 ffelexToken t);
723 static ffelexHandler ffestb_vxtcode2_ (ffelexToken ft, ffebld expr,
724 ffelexToken t);
725 static ffelexHandler ffestb_vxtcode3_ (ffelexToken ft, ffebld expr,
726 ffelexToken t);
727 static ffelexHandler ffestb_vxtcode4_ (ffelexToken t);
728 static ffelexHandler ffestb_vxtcode5_ (ffelexToken t);
729 static ffelexHandler ffestb_vxtcode6_ (ffelexToken ft, ffebld expr,
730 ffelexToken t);
731 static ffelexHandler ffestb_vxtcode7_ (ffelexToken t);
732 static ffelexHandler ffestb_vxtcode8_ (ffelexToken t);
733 static ffelexHandler ffestb_vxtcode9_ (ffelexToken t);
734 static ffelexHandler ffestb_vxtcode10_ (ffelexToken ft, ffebld expr,
735 ffelexToken t);
736 #endif
737 static ffelexHandler ffestb_R9041_ (ffelexToken t);
738 static ffelexHandler ffestb_R9042_ (ffelexToken t);
739 static ffelexHandler ffestb_R9043_ (ffelexToken ft, ffebld expr,
740 ffelexToken t);
741 static ffelexHandler ffestb_R9044_ (ffelexToken t);
742 static ffelexHandler ffestb_R9045_ (ffelexToken t);
743 static ffelexHandler ffestb_R9046_ (ffelexToken ft, ffebld expr,
744 ffelexToken t);
745 static ffelexHandler ffestb_R9047_ (ffelexToken t);
746 static ffelexHandler ffestb_R9048_ (ffelexToken t);
747 static ffelexHandler ffestb_R9049_ (ffelexToken t);
748 static ffelexHandler ffestb_R9071_ (ffelexToken t);
749 static ffelexHandler ffestb_R9072_ (ffelexToken t);
750 static ffelexHandler ffestb_R9073_ (ffelexToken ft, ffebld expr,
751 ffelexToken t);
752 static ffelexHandler ffestb_R9074_ (ffelexToken t);
753 static ffelexHandler ffestb_R9075_ (ffelexToken t);
754 static ffelexHandler ffestb_R9076_ (ffelexToken ft, ffebld expr,
755 ffelexToken t);
756 static ffelexHandler ffestb_R9077_ (ffelexToken t);
757 static ffelexHandler ffestb_R9078_ (ffelexToken t);
758 static ffelexHandler ffestb_R9079_ (ffelexToken t);
759 static ffelexHandler ffestb_R9091_ (ffelexToken ft, ffebld expr,
760 ffelexToken t);
761 static ffelexHandler ffestb_R9092_ (ffelexToken t);
762 static ffelexHandler ffestb_R9093_ (ffelexToken t);
763 static ffelexHandler ffestb_R9094_ (ffelexToken ft, ffebld expr,
764 ffelexToken t);
765 static ffelexHandler ffestb_R9095_ (ffelexToken t);
766 static ffelexHandler ffestb_R9096_ (ffelexToken t);
767 static ffelexHandler ffestb_R9097_ (ffelexToken ft, ffebld expr,
768 ffelexToken t);
769 static ffelexHandler ffestb_R9098_ (ffelexToken t);
770 static ffelexHandler ffestb_R9099_ (ffelexToken t);
771 static ffelexHandler ffestb_R90910_ (ffelexToken ft, ffebld expr,
772 ffelexToken t);
773 static ffelexHandler ffestb_R90911_ (ffelexToken t);
774 static ffelexHandler ffestb_R90912_ (ffelexToken t);
775 static ffelexHandler ffestb_R90913_ (ffelexToken t);
776 static ffelexHandler ffestb_R90914_ (ffelexToken ft, ffebld expr,
777 ffelexToken t);
778 static ffelexHandler ffestb_R90915_ (ffelexToken ft, ffebld expr,
779 ffelexToken t);
780 static ffelexHandler ffestb_R9101_ (ffelexToken t);
781 static ffelexHandler ffestb_R9102_ (ffelexToken t);
782 static ffelexHandler ffestb_R9103_ (ffelexToken ft, ffebld expr,
783 ffelexToken t);
784 static ffelexHandler ffestb_R9104_ (ffelexToken t);
785 static ffelexHandler ffestb_R9105_ (ffelexToken t);
786 static ffelexHandler ffestb_R9106_ (ffelexToken ft, ffebld expr,
787 ffelexToken t);
788 static ffelexHandler ffestb_R9107_ (ffelexToken t);
789 static ffelexHandler ffestb_R9108_ (ffelexToken t);
790 static ffelexHandler ffestb_R9109_ (ffelexToken ft, ffebld expr,
791 ffelexToken t);
792 static ffelexHandler ffestb_R91010_ (ffelexToken t);
793 static ffelexHandler ffestb_R91011_ (ffelexToken t);
794 static ffelexHandler ffestb_R91012_ (ffelexToken t);
795 static ffelexHandler ffestb_R91013_ (ffelexToken ft, ffebld expr,
796 ffelexToken t);
797 static ffelexHandler ffestb_R91014_ (ffelexToken ft, ffebld expr,
798 ffelexToken t);
799 static ffelexHandler ffestb_R9111_ (ffelexToken ft, ffebld expr,
800 ffelexToken t);
801 static ffelexHandler ffestb_R9112_ (ffelexToken ft, ffebld expr,
802 ffelexToken t);
803 static ffelexHandler ffestb_R9231_ (ffelexToken t);
804 static ffelexHandler ffestb_R9232_ (ffelexToken t);
805 static ffelexHandler ffestb_R9233_ (ffelexToken ft, ffebld expr,
806 ffelexToken t);
807 static ffelexHandler ffestb_R9234_ (ffelexToken t);
808 static ffelexHandler ffestb_R9235_ (ffelexToken t);
809 static ffelexHandler ffestb_R9236_ (ffelexToken ft, ffebld expr,
810 ffelexToken t);
811 static ffelexHandler ffestb_R9237_ (ffelexToken t);
812 static ffelexHandler ffestb_R9238_ (ffelexToken t);
813 static ffelexHandler ffestb_R9239_ (ffelexToken t);
814 static ffelexHandler ffestb_R92310_ (ffelexToken t);
815 static ffelexHandler ffestb_R92311_ (ffelexToken ft, ffebld expr,
816 ffelexToken t);
817 #if FFESTR_VXT
818 static ffelexHandler ffestb_V0181_ (ffelexToken t);
819 static ffelexHandler ffestb_V0182_ (ffelexToken t);
820 static ffelexHandler ffestb_V0183_ (ffelexToken ft, ffebld expr,
821 ffelexToken t);
822 static ffelexHandler ffestb_V0184_ (ffelexToken t);
823 static ffelexHandler ffestb_V0185_ (ffelexToken t);
824 static ffelexHandler ffestb_V0186_ (ffelexToken ft, ffebld expr,
825 ffelexToken t);
826 static ffelexHandler ffestb_V0187_ (ffelexToken t);
827 static ffelexHandler ffestb_V0188_ (ffelexToken t);
828 static ffelexHandler ffestb_V0189_ (ffelexToken ft, ffebld expr,
829 ffelexToken t);
830 static ffelexHandler ffestb_V01810_ (ffelexToken t);
831 static ffelexHandler ffestb_V01811_ (ffelexToken t);
832 static ffelexHandler ffestb_V01812_ (ffelexToken t);
833 static ffelexHandler ffestb_V01813_ (ffelexToken ft, ffebld expr,
834 ffelexToken t);
835 static ffelexHandler ffestb_V0191_ (ffelexToken ft, ffebld expr,
836 ffelexToken t);
837 static ffelexHandler ffestb_V0192_ (ffelexToken ft, ffebld expr,
838 ffelexToken t);
839 #endif
840 static ffelexHandler ffestb_V0201_ (ffelexToken ft, ffebld expr,
841 ffelexToken t);
842 static ffelexHandler ffestb_V0202_ (ffelexToken ft, ffebld expr,
843 ffelexToken t);
844 #if FFESTR_VXT
845 static ffelexHandler ffestb_V0211_ (ffelexToken t);
846 static ffelexHandler ffestb_V0212_ (ffelexToken t);
847 static ffelexHandler ffestb_V0213_ (ffelexToken ft, ffebld expr,
848 ffelexToken t);
849 static ffelexHandler ffestb_V0214_ (ffelexToken t);
850 static ffelexHandler ffestb_V0215_ (ffelexToken t);
851 static ffelexHandler ffestb_V0216_ (ffelexToken ft, ffebld expr,
852 ffelexToken t);
853 static ffelexHandler ffestb_V0217_ (ffelexToken t);
854 static ffelexHandler ffestb_V0218_ (ffelexToken t);
855 static ffelexHandler ffestb_V0219_ (ffelexToken t);
856 static ffelexHandler ffestb_V0261_ (ffelexToken t);
857 static ffelexHandler ffestb_V0262_ (ffelexToken t);
858 static ffelexHandler ffestb_V0263_ (ffelexToken ft, ffebld expr,
859 ffelexToken t);
860 static ffelexHandler ffestb_V0264_ (ffelexToken t);
861 static ffelexHandler ffestb_V0265_ (ffelexToken t);
862 static ffelexHandler ffestb_V0266_ (ffelexToken ft, ffebld expr,
863 ffelexToken t);
864 static ffelexHandler ffestb_V0267_ (ffelexToken t);
865 static ffelexHandler ffestb_V0268_ (ffelexToken t);
866 static ffelexHandler ffestb_V0269_ (ffelexToken t);
867 #endif
868 #if FFESTR_F90
869 static ffelexHandler ffestb_dimlist1_ (ffelexToken t);
870 static ffelexHandler ffestb_dimlist2_ (ffelexToken t);
871 static ffelexHandler ffestb_dimlist3_ (ffelexToken t);
872 static ffelexHandler ffestb_dimlist4_ (ffelexToken t);
873 #endif
874 static ffelexHandler ffestb_dummy1_ (ffelexToken t);
875 static ffelexHandler ffestb_dummy2_ (ffelexToken t);
876 static ffelexHandler ffestb_R5241_ (ffelexToken t);
877 static ffelexHandler ffestb_R5242_ (ffelexToken t);
878 static ffelexHandler ffestb_R5243_ (ffelexToken t);
879 static ffelexHandler ffestb_R5244_ (ffelexToken t);
880 static ffelexHandler ffestb_R5471_ (ffelexToken t);
881 static ffelexHandler ffestb_R5472_ (ffelexToken t);
882 static ffelexHandler ffestb_R5473_ (ffelexToken t);
883 static ffelexHandler ffestb_R5474_ (ffelexToken t);
884 static ffelexHandler ffestb_R5475_ (ffelexToken t);
885 static ffelexHandler ffestb_R5476_ (ffelexToken t);
886 static ffelexHandler ffestb_R5477_ (ffelexToken t);
887 #if FFESTR_F90
888 static ffelexHandler ffestb_R6241_ (ffelexToken ft, ffebld expr,
889 ffelexToken t);
890 static ffelexHandler ffestb_R6242_ (ffelexToken t);
891 #endif
892 static ffelexHandler ffestb_R12291_ (ffelexToken t);
893 static ffelexHandler ffestb_R12292_ (ffelexToken ft, ffebld expr,
894 ffelexToken t);
895 static ffelexHandler ffestb_decl_chartype1_ (ffelexToken t);
896 #if FFESTR_F90
897 static ffelexHandler ffestb_decl_recursive1_ (ffelexToken t);
898 static ffelexHandler ffestb_decl_recursive2_ (ffelexToken t);
899 static ffelexHandler ffestb_decl_recursive3_ (ffelexToken t);
900 static ffelexHandler ffestb_decl_recursive4_ (ffelexToken t);
901 #endif
902 static ffelexHandler ffestb_decl_attrs_ (ffelexToken t);
903 static ffelexHandler ffestb_decl_attrs_1_ (ffelexToken t);
904 static ffelexHandler ffestb_decl_attrs_2_ (ffelexToken t);
905 #if FFESTR_F90
906 static ffelexHandler ffestb_decl_attrs_3_ (ffelexToken t);
907 static ffelexHandler ffestb_decl_attrs_4_ (ffelexToken t);
908 static ffelexHandler ffestb_decl_attrs_5_ (ffelexToken t);
909 static ffelexHandler ffestb_decl_attrs_6_ (ffelexToken t);
910 #endif
911 static ffelexHandler ffestb_decl_attrs_7_ (ffelexToken t);
912 static ffelexHandler ffestb_decl_attrsp_ (ffelexToken t);
913 static ffelexHandler ffestb_decl_ents_ (ffelexToken t);
914 static ffelexHandler ffestb_decl_ents_1_ (ffelexToken t);
915 static ffelexHandler ffestb_decl_ents_2_ (ffelexToken t);
916 static ffelexHandler ffestb_decl_ents_3_ (ffelexToken t);
917 static ffelexHandler ffestb_decl_ents_4_ (ffelexToken t);
918 static ffelexHandler ffestb_decl_ents_5_ (ffelexToken t);
919 static ffelexHandler ffestb_decl_ents_6_ (ffelexToken ft, ffebld expr,
920 ffelexToken t);
921 static ffelexHandler ffestb_decl_ents_7_ (ffelexToken t);
922 static ffelexHandler ffestb_decl_ents_8_ (ffelexToken ft, ffebld expr,
923 ffelexToken t);
924 static ffelexHandler ffestb_decl_ents_9_ (ffelexToken ft, ffebld expr,
925 ffelexToken t);
926 static ffelexHandler ffestb_decl_ents_10_ (ffelexToken ft, ffebld expr,
927 ffelexToken t);
928 static ffelexHandler ffestb_decl_ents_11_ (ffelexToken t);
929 static ffelexHandler ffestb_decl_entsp_ (ffelexToken t);
930 static ffelexHandler ffestb_decl_entsp_1_ (ffelexToken t);
931 static ffelexHandler ffestb_decl_entsp_2_ (ffelexToken t);
932 static ffelexHandler ffestb_decl_entsp_3_ (ffelexToken t);
933 static ffelexHandler ffestb_decl_entsp_4_ (ffelexToken ft, ffebld expr,
934 ffelexToken t);
935 static ffelexHandler ffestb_decl_entsp_5_ (ffelexToken t);
936 static ffelexHandler ffestb_decl_entsp_6_ (ffelexToken t);
937 static ffelexHandler ffestb_decl_entsp_7_ (ffelexToken t);
938 static ffelexHandler ffestb_decl_entsp_8_ (ffelexToken t);
939 #if FFESTR_F90
940 static ffelexHandler ffestb_decl_func_ (ffelexToken t);
941 #endif
942 static ffelexHandler ffestb_decl_funcname_ (ffelexToken t);
943 static ffelexHandler ffestb_decl_funcname_1_ (ffelexToken t);
944 static ffelexHandler ffestb_decl_funcname_2_ (ffelexToken t);
945 static ffelexHandler ffestb_decl_funcname_3_ (ffelexToken ft, ffebld expr,
946 ffelexToken t);
947 static ffelexHandler ffestb_decl_funcname_4_ (ffelexToken t);
948 static ffelexHandler ffestb_decl_funcname_5_ (ffelexToken t);
949 static ffelexHandler ffestb_decl_funcname_6_ (ffelexToken t);
950 static ffelexHandler ffestb_decl_funcname_7_ (ffelexToken t);
951 static ffelexHandler ffestb_decl_funcname_8_ (ffelexToken t);
952 static ffelexHandler ffestb_decl_funcname_9_ (ffelexToken t);
953 #if FFESTR_VXT
954 static ffelexHandler ffestb_V0031_ (ffelexToken t);
955 static ffelexHandler ffestb_V0032_ (ffelexToken t);
956 static ffelexHandler ffestb_V0033_ (ffelexToken t);
957 static ffelexHandler ffestb_V0034_ (ffelexToken t);
958 static ffelexHandler ffestb_V0035_ (ffelexToken t);
959 static ffelexHandler ffestb_V0036_ (ffelexToken t);
960 static ffelexHandler ffestb_V0161_ (ffelexToken t);
961 static ffelexHandler ffestb_V0162_ (ffelexToken t);
962 static ffelexHandler ffestb_V0163_ (ffelexToken t);
963 static ffelexHandler ffestb_V0164_ (ffelexToken t);
964 static ffelexHandler ffestb_V0165_ (ffelexToken t);
965 static ffelexHandler ffestb_V0166_ (ffelexToken t);
966 #endif
967 static ffelexHandler ffestb_V0271_ (ffelexToken t);
968 static ffelexHandler ffestb_V0272_ (ffelexToken ft, ffebld expr,
969 ffelexToken t);
970 static ffelexHandler ffestb_V0273_ (ffelexToken t);
971 static ffelexHandler ffestb_decl_R5391_ (ffelexToken t);
972 static ffelexHandler ffestb_decl_R5392_ (ffelexToken t);
973 #if FFESTR_F90
974 static ffelexHandler ffestb_decl_R5393_ (ffelexToken t);
975 #endif
976 static ffelexHandler ffestb_decl_R5394_ (ffelexToken t);
977 static ffelexHandler ffestb_decl_R5395_ (ffelexToken t);
978 static ffelexHandler ffestb_decl_R539letters_ (ffelexToken t);
979 static ffelexHandler ffestb_decl_R539letters_1_ (ffelexToken t);
980 static ffelexHandler ffestb_decl_R539letters_2_ (ffelexToken t);
981 static ffelexHandler ffestb_decl_R539letters_3_ (ffelexToken t);
982 static ffelexHandler ffestb_decl_R539letters_4_ (ffelexToken t);
983 static ffelexHandler ffestb_decl_R539letters_5_ (ffelexToken t);
984 static ffelexHandler ffestb_decl_R539maybe_ (ffelexToken t);
985 static ffelexHandler ffestb_decl_R539maybe_1_ (ffelexToken t);
986 static ffelexHandler ffestb_decl_R539maybe_2_ (ffelexToken t);
987 static ffelexHandler ffestb_decl_R539maybe_3_ (ffelexToken t);
988 static ffelexHandler ffestb_decl_R539maybe_4_ (ffelexToken t);
989 static ffelexHandler ffestb_decl_R539maybe_5_ (ffelexToken t);
990
991 /* Internal macros. */
992
993 #if FFESTB_KILL_EASY_
994 #define ffestb_subr_kill_accept_() \
995 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_acceptix)
996 #define ffestb_subr_kill_beru_() \
997 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_beruix)
998 #define ffestb_subr_kill_close_() \
999 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_closeix)
1000 #define ffestb_subr_kill_delete_() \
1001 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_deleteix)
1002 #define ffestb_subr_kill_find_() \
1003 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_findix)
1004 #define ffestb_subr_kill_inquire_() \
1005 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_inquireix)
1006 #define ffestb_subr_kill_open_() \
1007 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_openix)
1008 #define ffestb_subr_kill_print_() \
1009 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_printix)
1010 #define ffestb_subr_kill_read_() \
1011 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_readix)
1012 #define ffestb_subr_kill_rewrite_() \
1013 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_rewriteix)
1014 #define ffestb_subr_kill_type_() \
1015 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_typeix)
1016 #define ffestb_subr_kill_vxtcode_() \
1017 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_vxtcodeix)
1018 #define ffestb_subr_kill_write_() \
1019 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_writeix)
1020 #endif
1021 \f
1022 /* ffestb_subr_ambig_nope_ -- Cleans up and aborts ambig w/o confirming
1023
1024 ffestb_subr_ambig_nope_();
1025
1026 Switch from ambiguity handling in _entsp_ functions to handling entities
1027 in _ents_ (perform housekeeping tasks). */
1028
1029 static ffelexHandler
1030 ffestb_subr_ambig_nope_ (ffelexToken t)
1031 {
1032 if (ffestb_local_.decl.recursive != NULL)
1033 ffelex_token_kill (ffestb_local_.decl.recursive);
1034 if (ffestb_local_.decl.kindt != NULL)
1035 ffelex_token_kill (ffestb_local_.decl.kindt);
1036 if (ffestb_local_.decl.lent != NULL)
1037 ffelex_token_kill (ffestb_local_.decl.lent);
1038 ffelex_token_kill (ffesta_tokens[1]);
1039 ffelex_token_kill (ffesta_tokens[2]);
1040 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
1041 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
1042 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1043 }
1044
1045 /* ffestb_subr_ambig_to_ents_ -- Switches from ambiguity to entity decl
1046
1047 ffestb_subr_ambig_to_ents_();
1048
1049 Switch from ambiguity handling in _entsp_ functions to handling entities
1050 in _ents_ (perform housekeeping tasks). */
1051
1052 static void
1053 ffestb_subr_ambig_to_ents_ ()
1054 {
1055 ffelexToken nt;
1056
1057 nt = ffelex_token_name_from_names (ffesta_tokens[1], 0, 0);
1058 ffelex_token_kill (ffesta_tokens[1]);
1059 ffelex_token_kill (ffesta_tokens[2]);
1060 ffesta_tokens[1] = nt;
1061 if (ffestb_local_.decl.recursive != NULL)
1062 ffelex_token_kill (ffestb_local_.decl.recursive);
1063 if (!ffestb_local_.decl.aster_after)
1064 {
1065 if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
1066 {
1067 if (!ffesta_is_inhibited ())
1068 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
1069 ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
1070 ffestb_local_.decl.len, ffestb_local_.decl.lent);
1071 if (ffestb_local_.decl.kindt != NULL)
1072 {
1073 ffelex_token_kill (ffestb_local_.decl.kindt);
1074 ffestb_local_.decl.kind = NULL;
1075 ffestb_local_.decl.kindt = NULL;
1076 }
1077 if (ffestb_local_.decl.lent != NULL)
1078 {
1079 ffelex_token_kill (ffestb_local_.decl.lent);
1080 ffestb_local_.decl.len = NULL;
1081 ffestb_local_.decl.lent = NULL;
1082 }
1083 }
1084 else
1085 {
1086 if (!ffesta_is_inhibited ())
1087 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
1088 ffestb_local_.decl.kind, ffestb_local_.decl.kindt, NULL,
1089 NULL);
1090 if (ffestb_local_.decl.kindt != NULL)
1091 {
1092 ffelex_token_kill (ffestb_local_.decl.kindt);
1093 ffestb_local_.decl.kind = NULL;
1094 ffestb_local_.decl.kindt = NULL;
1095 }
1096 }
1097 return;
1098 }
1099 if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
1100 {
1101 if (!ffesta_is_inhibited ())
1102 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
1103 ffestb_local_.decl.kind, ffestb_local_.decl.kindt, NULL, NULL);
1104 if (ffestb_local_.decl.kindt != NULL)
1105 {
1106 ffelex_token_kill (ffestb_local_.decl.kindt);
1107 ffestb_local_.decl.kind = NULL;
1108 ffestb_local_.decl.kindt = NULL;
1109 }
1110 }
1111 else if (!ffesta_is_inhibited ())
1112 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
1113 NULL, NULL, NULL, NULL);
1114 /* NAME/NAMES token already in ffesta_tokens[1]. */
1115 }
1116
1117 /* ffestb_subr_dimlist_ -- OPEN_PAREN expr
1118
1119 (ffestb_subr_dimlist_) // to expression handler
1120
1121 Deal with a dimension list.
1122
1123 19-Dec-90 JCB 1.1
1124 Detect too many dimensions if backend wants it. */
1125
1126 static ffelexHandler
1127 ffestb_subr_dimlist_ (ffelexToken ft, ffebld expr, ffelexToken t)
1128 {
1129 switch (ffelex_token_type (t))
1130 {
1131 case FFELEX_typeCLOSE_PAREN:
1132 if (expr == NULL)
1133 break;
1134 #ifdef FFECOM_dimensionsMAX
1135 if (ffestb_subrargs_.dim_list.ndims++ == FFECOM_dimensionsMAX)
1136 {
1137 ffesta_ffebad_1t (FFEBAD_TOO_MANY_DIMS, ft);
1138 ffestb_subrargs_.dim_list.ok = TRUE; /* Not a parse error, really. */
1139 return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
1140 }
1141 #endif
1142 ffestt_dimlist_append (ffestb_subrargs_.dim_list.dims, NULL, expr,
1143 ffelex_token_use (t));
1144 ffestb_subrargs_.dim_list.ok = TRUE;
1145 return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
1146
1147 case FFELEX_typeCOMMA:
1148 if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
1149 break;
1150 #ifdef FFECOM_dimensionsMAX
1151 if (ffestb_subrargs_.dim_list.ndims++ == FFECOM_dimensionsMAX)
1152 {
1153 ffesta_ffebad_1t (FFEBAD_TOO_MANY_DIMS, ft);
1154 return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
1155 ffestb_subrargs_.dim_list.ctx,
1156 (ffeexprCallback) ffestb_subr_dimlist_2_);
1157 }
1158 #endif
1159 ffestt_dimlist_append (ffestb_subrargs_.dim_list.dims, NULL, expr,
1160 ffelex_token_use (t));
1161 return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
1162 ffestb_subrargs_.dim_list.ctx,
1163 (ffeexprCallback) ffestb_subr_dimlist_);
1164
1165 case FFELEX_typeCOLON:
1166 if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
1167 break;
1168 #ifdef FFECOM_dimensionsMAX
1169 if (ffestb_subrargs_.dim_list.ndims++ == FFECOM_dimensionsMAX)
1170 {
1171 ffesta_ffebad_1t (FFEBAD_TOO_MANY_DIMS, ft);
1172 return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
1173 ffestb_subrargs_.dim_list.ctx,
1174 (ffeexprCallback) ffestb_subr_dimlist_2_);
1175 }
1176 #endif
1177 ffestt_dimlist_append (ffestb_subrargs_.dim_list.dims, expr, NULL,
1178 ffelex_token_use (t)); /* NULL second expr for
1179 now, just plug in. */
1180 return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
1181 ffestb_subrargs_.dim_list.ctx,
1182 (ffeexprCallback) ffestb_subr_dimlist_1_);
1183
1184 default:
1185 break;
1186 }
1187
1188 ffestb_subrargs_.dim_list.ok = FALSE;
1189 return (ffelexHandler) ffestb_subrargs_.dim_list.handler (t);
1190 }
1191
1192 /* ffestb_subr_dimlist_1_ -- OPEN_PAREN expr COLON expr
1193
1194 (ffestb_subr_dimlist_1_) // to expression handler
1195
1196 Get the upper bound. */
1197
1198 static ffelexHandler
1199 ffestb_subr_dimlist_1_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
1200 {
1201 switch (ffelex_token_type (t))
1202 {
1203 case FFELEX_typeCLOSE_PAREN:
1204 ffestb_subrargs_.dim_list.dims->previous->upper = expr;
1205 ffestb_subrargs_.dim_list.ok = TRUE;
1206 return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
1207
1208 case FFELEX_typeCOMMA:
1209 if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
1210 break;
1211 ffestb_subrargs_.dim_list.dims->previous->upper = expr;
1212 return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
1213 ffestb_subrargs_.dim_list.ctx, (ffeexprCallback) ffestb_subr_dimlist_);
1214
1215 default:
1216 break;
1217 }
1218
1219 ffestb_subrargs_.dim_list.ok = FALSE;
1220 return (ffelexHandler) ffestb_subrargs_.dim_list.handler (t);
1221 }
1222
1223 /* ffestb_subr_dimlist_2_ -- OPEN_PAREN too-many-dim-exprs
1224
1225 (ffestb_subr_dimlist_2_) // to expression handler
1226
1227 Get the upper bound. */
1228
1229 static ffelexHandler
1230 ffestb_subr_dimlist_2_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
1231 {
1232 switch (ffelex_token_type (t))
1233 {
1234 case FFELEX_typeCLOSE_PAREN:
1235 ffestb_subrargs_.dim_list.ok = TRUE; /* Not a parse error, really. */
1236 return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
1237
1238 case FFELEX_typeCOMMA:
1239 case FFELEX_typeCOLON:
1240 if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
1241 break;
1242 return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
1243 ffestb_subrargs_.dim_list.ctx,
1244 (ffeexprCallback) ffestb_subr_dimlist_2_);
1245
1246 default:
1247 break;
1248 }
1249
1250 ffestb_subrargs_.dim_list.ok = FALSE;
1251 return (ffelexHandler) ffestb_subrargs_.dim_list.handler (t);
1252 }
1253
1254 /* ffestb_subr_name_list_ -- Collect a list of name args and close-paren
1255
1256 return ffestb_subr_name_list_; // to lexer after seeing OPEN_PAREN
1257
1258 This implements R1224 in the Fortran 90 spec. The arg list may be
1259 empty, or be a comma-separated list (an optional trailing comma currently
1260 results in a warning but no other effect) of arguments. For functions,
1261 however, "*" is invalid (we implement dummy-arg-name, rather than R1224
1262 dummy-arg, which itself is either dummy-arg-name or "*"). */
1263
1264 static ffelexHandler
1265 ffestb_subr_name_list_ (ffelexToken t)
1266 {
1267 switch (ffelex_token_type (t))
1268 {
1269 case FFELEX_typeCLOSE_PAREN:
1270 if (ffestt_tokenlist_count (ffestb_subrargs_.name_list.args) != 0)
1271 { /* Trailing comma, warn. */
1272 ffebad_start (FFEBAD_TRAILING_COMMA);
1273 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
1274 ffebad_finish ();
1275 }
1276 ffestb_subrargs_.name_list.ok = TRUE;
1277 ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
1278 if (ffestb_subrargs_.name_list.names)
1279 ffelex_set_names (TRUE);
1280 return (ffelexHandler) ffestb_subrargs_.name_list.handler;
1281
1282 case FFELEX_typeASTERISK:
1283 if (!ffestb_subrargs_.name_list.is_subr)
1284 break;
1285
1286 case FFELEX_typeNAME:
1287 ffestt_tokenlist_append (ffestb_subrargs_.name_list.args,
1288 ffelex_token_use (t));
1289 return (ffelexHandler) ffestb_subr_name_list_1_;
1290
1291 default:
1292 break;
1293 }
1294
1295 ffestb_subrargs_.name_list.ok = FALSE;
1296 ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
1297 if (ffestb_subrargs_.name_list.names)
1298 ffelex_set_names (TRUE);
1299 return (ffelexHandler) (*ffestb_subrargs_.name_list.handler) (t);
1300 }
1301
1302 /* ffestb_subr_name_list_1_ -- NAME or ASTERISK
1303
1304 return ffestb_subr_name_list_1_; // to lexer
1305
1306 The next token must be COMMA or CLOSE_PAREN, either way go to original
1307 state, but only after adding the appropriate name list item. */
1308
1309 static ffelexHandler
1310 ffestb_subr_name_list_1_ (ffelexToken t)
1311 {
1312 switch (ffelex_token_type (t))
1313 {
1314 case FFELEX_typeCOMMA:
1315 return (ffelexHandler) ffestb_subr_name_list_;
1316
1317 case FFELEX_typeCLOSE_PAREN:
1318 ffestb_subrargs_.name_list.ok = TRUE;
1319 ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
1320 if (ffestb_subrargs_.name_list.names)
1321 ffelex_set_names (TRUE);
1322 return (ffelexHandler) ffestb_subrargs_.name_list.handler;
1323
1324 default:
1325 ffestb_subrargs_.name_list.ok = FALSE;
1326 ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
1327 if (ffestb_subrargs_.name_list.names)
1328 ffelex_set_names (TRUE);
1329 return (ffelexHandler) (*ffestb_subrargs_.name_list.handler) (t);
1330 }
1331 }
1332
1333 static void
1334 ffestb_subr_R1001_append_p_ (void)
1335 {
1336 ffesttFormatList f;
1337
1338 if (!ffestb_local_.format.pre.present)
1339 {
1340 ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_P_SPEC, ffestb_local_.format.t);
1341 ffelex_token_kill (ffestb_local_.format.t);
1342 return;
1343 }
1344
1345 f = ffestt_formatlist_append (ffestb_local_.format.f);
1346 f->type = FFESTP_formattypeP;
1347 f->t = ffestb_local_.format.t;
1348 f->u.R1010.val = ffestb_local_.format.pre;
1349 }
1350
1351 /* ffestb_decl_kindparam_ -- "type" OPEN_PAREN
1352
1353 return ffestb_decl_kindparam_; // to lexer
1354
1355 Handle "[KIND=]expr)". */
1356
1357 static ffelexHandler
1358 ffestb_decl_kindparam_ (ffelexToken t)
1359 {
1360 switch (ffelex_token_type (t))
1361 {
1362 case FFELEX_typeNAME:
1363 ffesta_tokens[1] = ffelex_token_use (t);
1364 return (ffelexHandler) ffestb_decl_kindparam_1_;
1365
1366 default:
1367 return (ffelexHandler) (*((ffelexHandler)
1368 ffeexpr_rhs (ffesta_output_pool,
1369 FFEEXPR_contextKINDTYPE,
1370 (ffeexprCallback) ffestb_decl_kindparam_2_)))
1371 (t);
1372 }
1373 }
1374
1375 /* ffestb_decl_kindparam_1_ -- "type" OPEN_PAREN NAME
1376
1377 return ffestb_decl_kindparam_1_; // to lexer
1378
1379 Handle "[KIND=]expr)". */
1380
1381 static ffelexHandler
1382 ffestb_decl_kindparam_1_ (ffelexToken t)
1383 {
1384 ffelexHandler next;
1385 ffelexToken nt;
1386
1387 switch (ffelex_token_type (t))
1388 {
1389 case FFELEX_typeEQUALS:
1390 ffesta_confirmed ();
1391 if (ffestr_other (ffesta_tokens[1]) != FFESTR_otherKIND)
1392 break;
1393 ffelex_token_kill (ffesta_tokens[1]);
1394 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
1395 FFEEXPR_contextKINDTYPE, (ffeexprCallback) ffestb_decl_kindparam_2_);
1396
1397 default:
1398 nt = ffesta_tokens[1];
1399 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
1400 FFEEXPR_contextKINDTYPE, (ffeexprCallback) ffestb_decl_kindparam_2_)))
1401 (nt);
1402 ffelex_token_kill (nt);
1403 return (ffelexHandler) (*next) (t);
1404 }
1405
1406 if (ffestb_local_.decl.recursive != NULL)
1407 ffelex_token_kill (ffestb_local_.decl.recursive);
1408 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1409 ffestb_local_.decl.badname,
1410 ffesta_tokens[1]);
1411 ffelex_token_kill (ffesta_tokens[1]);
1412 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1413 }
1414
1415 /* ffestb_decl_kindparam_2_ -- "type" OPEN_PAREN ["KIND="] expr
1416
1417 (ffestb_decl_kindparam_2_) // to expression handler
1418
1419 Handle "[KIND=]expr)". */
1420
1421 static ffelexHandler
1422 ffestb_decl_kindparam_2_ (ffelexToken ft, ffebld expr, ffelexToken t)
1423 {
1424 switch (ffelex_token_type (t))
1425 {
1426 case FFELEX_typeCLOSE_PAREN:
1427 ffestb_local_.decl.kind = expr;
1428 ffestb_local_.decl.kindt = ffelex_token_use (ft);
1429 ffestb_local_.decl.len = NULL;
1430 ffestb_local_.decl.lent = NULL;
1431 ffelex_set_names (TRUE);
1432 return (ffelexHandler) ffestb_local_.decl.handler;
1433
1434 default:
1435 break;
1436 }
1437
1438 if (ffestb_local_.decl.recursive != NULL)
1439 ffelex_token_kill (ffestb_local_.decl.recursive);
1440 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1441 ffestb_local_.decl.badname,
1442 t);
1443 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1444 }
1445
1446 /* ffestb_decl_starkind_ -- "type" ASTERISK
1447
1448 return ffestb_decl_starkind_; // to lexer
1449
1450 Handle NUMBER. */
1451
1452 static ffelexHandler
1453 ffestb_decl_starkind_ (ffelexToken t)
1454 {
1455 switch (ffelex_token_type (t))
1456 {
1457 case FFELEX_typeNUMBER:
1458 ffestb_local_.decl.kindt = ffelex_token_use (t);
1459 ffestb_local_.decl.kind = NULL;
1460 ffestb_local_.decl.len = NULL;
1461 ffestb_local_.decl.lent = NULL;
1462 ffelex_set_names (TRUE);
1463 return (ffelexHandler) ffestb_local_.decl.handler;
1464
1465 default:
1466 break;
1467 }
1468
1469 if (ffestb_local_.decl.recursive != NULL)
1470 ffelex_token_kill (ffestb_local_.decl.recursive);
1471 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1472 ffestb_local_.decl.badname,
1473 t);
1474 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1475 }
1476
1477 /* ffestb_decl_starlen_ -- "CHARACTER" ASTERISK
1478
1479 return ffestb_decl_starlen_; // to lexer
1480
1481 Handle NUMBER. */
1482
1483 static ffelexHandler
1484 ffestb_decl_starlen_ (ffelexToken t)
1485 {
1486 switch (ffelex_token_type (t))
1487 {
1488 case FFELEX_typeNUMBER:
1489 ffestb_local_.decl.kind = NULL;
1490 ffestb_local_.decl.kindt = NULL;
1491 ffestb_local_.decl.len = NULL;
1492 ffestb_local_.decl.lent = ffelex_token_use (t);
1493 ffelex_set_names (TRUE);
1494 return (ffelexHandler) ffestb_local_.decl.handler;
1495
1496 case FFELEX_typeOPEN_PAREN:
1497 ffestb_local_.decl.kind = NULL;
1498 ffestb_local_.decl.kindt = NULL;
1499 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
1500 FFEEXPR_contextCHARACTERSIZE,
1501 (ffeexprCallback) ffestb_decl_starlen_1_);
1502
1503 default:
1504 break;
1505 }
1506
1507 if (ffestb_local_.decl.recursive != NULL)
1508 ffelex_token_kill (ffestb_local_.decl.recursive);
1509 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1510 ffestb_local_.decl.badname,
1511 t);
1512 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1513 }
1514
1515 /* ffestb_decl_starlen_1_ -- "CHARACTER" ASTERISK OPEN_PAREN expr
1516
1517 (ffestb_decl_starlen_1_) // to expression handler
1518
1519 Handle CLOSE_PAREN. */
1520
1521 static ffelexHandler
1522 ffestb_decl_starlen_1_ (ffelexToken ft, ffebld expr, ffelexToken t)
1523 {
1524 switch (ffelex_token_type (t))
1525 {
1526 case FFELEX_typeCLOSE_PAREN:
1527 if (expr == NULL)
1528 break;
1529 ffestb_local_.decl.len = expr;
1530 ffestb_local_.decl.lent = ffelex_token_use (ft);
1531 ffelex_set_names (TRUE);
1532 return (ffelexHandler) ffestb_local_.decl.handler;
1533
1534 default:
1535 break;
1536 }
1537
1538 if (ffestb_local_.decl.recursive != NULL)
1539 ffelex_token_kill (ffestb_local_.decl.recursive);
1540 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1541 ffestb_local_.decl.badname,
1542 t);
1543 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1544 }
1545
1546 /* ffestb_decl_typeparams_ -- "CHARACTER" OPEN_PAREN
1547
1548 return ffestb_decl_typeparams_; // to lexer
1549
1550 Handle "[KIND=]expr)". */
1551
1552 static ffelexHandler
1553 ffestb_decl_typeparams_ (ffelexToken t)
1554 {
1555 switch (ffelex_token_type (t))
1556 {
1557 case FFELEX_typeNAME:
1558 ffesta_tokens[1] = ffelex_token_use (t);
1559 return (ffelexHandler) ffestb_decl_typeparams_1_;
1560
1561 default:
1562 if (ffestb_local_.decl.lent == NULL)
1563 return (ffelexHandler) (*((ffelexHandler)
1564 ffeexpr_rhs (ffesta_output_pool,
1565 FFEEXPR_contextCHARACTERSIZE,
1566 (ffeexprCallback) ffestb_decl_typeparams_2_)))
1567 (t);
1568 if (ffestb_local_.decl.kindt != NULL)
1569 break;
1570 return (ffelexHandler) (*((ffelexHandler)
1571 ffeexpr_rhs (ffesta_output_pool,
1572 FFEEXPR_contextKINDTYPE,
1573 (ffeexprCallback) ffestb_decl_typeparams_3_)))
1574 (t);
1575 }
1576
1577 if (ffestb_local_.decl.recursive != NULL)
1578 ffelex_token_kill (ffestb_local_.decl.recursive);
1579 if (ffestb_local_.decl.kindt != NULL)
1580 ffelex_token_kill (ffestb_local_.decl.kindt);
1581 if (ffestb_local_.decl.lent != NULL)
1582 ffelex_token_kill (ffestb_local_.decl.lent);
1583 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1584 ffestb_local_.decl.badname,
1585 t);
1586 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1587 }
1588
1589 /* ffestb_decl_typeparams_1_ -- "CHARACTER" OPEN_PAREN NAME
1590
1591 return ffestb_decl_typeparams_1_; // to lexer
1592
1593 Handle "[KIND=]expr)". */
1594
1595 static ffelexHandler
1596 ffestb_decl_typeparams_1_ (ffelexToken t)
1597 {
1598 ffelexHandler next;
1599 ffelexToken nt;
1600
1601 switch (ffelex_token_type (t))
1602 {
1603 case FFELEX_typeEQUALS:
1604 ffesta_confirmed ();
1605 switch (ffestr_other (ffesta_tokens[1]))
1606 {
1607 case FFESTR_otherLEN:
1608 if (ffestb_local_.decl.lent != NULL)
1609 break;
1610 ffelex_token_kill (ffesta_tokens[1]);
1611 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
1612 FFEEXPR_contextCHARACTERSIZE,
1613 (ffeexprCallback) ffestb_decl_typeparams_2_);
1614
1615 case FFESTR_otherKIND:
1616 if (ffestb_local_.decl.kindt != NULL)
1617 break;
1618 ffelex_token_kill (ffesta_tokens[1]);
1619 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
1620 FFEEXPR_contextKINDTYPE,
1621 (ffeexprCallback) ffestb_decl_typeparams_3_);
1622
1623 default:
1624 break;
1625 }
1626 break;
1627
1628 default:
1629 nt = ffesta_tokens[1];
1630 if (ffestb_local_.decl.lent == NULL)
1631 next = (ffelexHandler) (*((ffelexHandler)
1632 ffeexpr_rhs (ffesta_output_pool,
1633 FFEEXPR_contextCHARACTERSIZE,
1634 (ffeexprCallback) ffestb_decl_typeparams_2_)))
1635 (nt);
1636 else if (ffestb_local_.decl.kindt == NULL)
1637 next = (ffelexHandler) (*((ffelexHandler)
1638 ffeexpr_rhs (ffesta_output_pool,
1639 FFEEXPR_contextKINDTYPE,
1640 (ffeexprCallback) ffestb_decl_typeparams_3_)))
1641 (nt);
1642 else
1643 {
1644 ffesta_tokens[1] = nt;
1645 break;
1646 }
1647 ffelex_token_kill (nt);
1648 return (ffelexHandler) (*next) (t);
1649 }
1650
1651 if (ffestb_local_.decl.recursive != NULL)
1652 ffelex_token_kill (ffestb_local_.decl.recursive);
1653 if (ffestb_local_.decl.kindt != NULL)
1654 ffelex_token_kill (ffestb_local_.decl.kindt);
1655 if (ffestb_local_.decl.lent != NULL)
1656 ffelex_token_kill (ffestb_local_.decl.lent);
1657 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1658 ffestb_local_.decl.badname,
1659 ffesta_tokens[1]);
1660 ffelex_token_kill (ffesta_tokens[1]);
1661 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1662 }
1663
1664 /* ffestb_decl_typeparams_2_ -- "CHARACTER" OPEN_PAREN ["LEN="] expr
1665
1666 (ffestb_decl_typeparams_2_) // to expression handler
1667
1668 Handle "[LEN=]expr)". */
1669
1670 static ffelexHandler
1671 ffestb_decl_typeparams_2_ (ffelexToken ft, ffebld expr, ffelexToken t)
1672 {
1673 switch (ffelex_token_type (t))
1674 {
1675 case FFELEX_typeCLOSE_PAREN:
1676 ffestb_local_.decl.len = expr;
1677 ffestb_local_.decl.lent = ffelex_token_use (ft);
1678 ffelex_set_names (TRUE);
1679 return (ffelexHandler) ffestb_local_.decl.handler;
1680
1681 case FFELEX_typeCOMMA:
1682 ffestb_local_.decl.len = expr;
1683 ffestb_local_.decl.lent = ffelex_token_use (ft);
1684 return (ffelexHandler) ffestb_decl_typeparams_;
1685
1686 default:
1687 break;
1688 }
1689
1690 if (ffestb_local_.decl.recursive != NULL)
1691 ffelex_token_kill (ffestb_local_.decl.recursive);
1692 if (ffestb_local_.decl.kindt != NULL)
1693 ffelex_token_kill (ffestb_local_.decl.kindt);
1694 if (ffestb_local_.decl.lent != NULL)
1695 ffelex_token_kill (ffestb_local_.decl.lent);
1696 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1697 ffestb_local_.decl.badname,
1698 t);
1699 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1700 }
1701
1702 /* ffestb_decl_typeparams_3_ -- "CHARACTER" OPEN_PAREN ["KIND="] expr
1703
1704 (ffestb_decl_typeparams_3_) // to expression handler
1705
1706 Handle "[KIND=]expr)". */
1707
1708 static ffelexHandler
1709 ffestb_decl_typeparams_3_ (ffelexToken ft, ffebld expr, ffelexToken t)
1710 {
1711 switch (ffelex_token_type (t))
1712 {
1713 case FFELEX_typeCLOSE_PAREN:
1714 ffestb_local_.decl.kind = expr;
1715 ffestb_local_.decl.kindt = ffelex_token_use (ft);
1716 ffelex_set_names (TRUE);
1717 return (ffelexHandler) ffestb_local_.decl.handler;
1718
1719 case FFELEX_typeCOMMA:
1720 ffestb_local_.decl.kind = expr;
1721 ffestb_local_.decl.kindt = ffelex_token_use (ft);
1722 return (ffelexHandler) ffestb_decl_typeparams_;
1723
1724 default:
1725 break;
1726 }
1727
1728 if (ffestb_local_.decl.recursive != NULL)
1729 ffelex_token_kill (ffestb_local_.decl.recursive);
1730 if (ffestb_local_.decl.kindt != NULL)
1731 ffelex_token_kill (ffestb_local_.decl.kindt);
1732 if (ffestb_local_.decl.lent != NULL)
1733 ffelex_token_kill (ffestb_local_.decl.lent);
1734 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1735 ffestb_local_.decl.badname,
1736 t);
1737 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1738 }
1739
1740 /* ffestb_decl_typetype1_ -- "TYPE" OPEN_PAREN
1741
1742 return ffestb_decl_typetype1_; // to lexer
1743
1744 Handle NAME. */
1745
1746 #if FFESTR_F90
1747 static ffelexHandler
1748 ffestb_decl_typetype1_ (ffelexToken t)
1749 {
1750 switch (ffelex_token_type (t))
1751 {
1752 case FFELEX_typeNAME:
1753 ffestb_local_.decl.kindt = ffelex_token_use (t);
1754 return (ffelexHandler) ffestb_decl_typetype2_;
1755
1756 default:
1757 break;
1758 }
1759
1760 if (ffestb_local_.decl.recursive != NULL)
1761 ffelex_token_kill (ffestb_local_.decl.recursive);
1762 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1763 ffestb_local_.decl.badname,
1764 t);
1765 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1766 }
1767
1768 /* ffestb_decl_typetype2_ -- "TYPE" OPEN_PAREN NAME
1769
1770 return ffestb_decl_typetype2_; // to lexer
1771
1772 Handle CLOSE_PAREN. */
1773
1774 static ffelexHandler
1775 ffestb_decl_typetype2_ (ffelexToken t)
1776 {
1777 switch (ffelex_token_type (t))
1778 {
1779 case FFELEX_typeCLOSE_PAREN:
1780 ffestb_local_.decl.type = FFESTP_typeTYPE;
1781 ffestb_local_.decl.kind = NULL;
1782 ffestb_local_.decl.len = NULL;
1783 ffestb_local_.decl.lent = NULL;
1784 ffelex_set_names (TRUE);
1785 return (ffelexHandler) ffestb_local_.decl.handler;
1786
1787 default:
1788 break;
1789 }
1790
1791 if (ffestb_local_.decl.recursive != NULL)
1792 ffelex_token_kill (ffestb_local_.decl.recursive);
1793 ffelex_token_kill (ffestb_local_.decl.kindt);
1794 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1795 ffestb_local_.decl.badname,
1796 t);
1797 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1798 }
1799
1800 #endif
1801 /* ffestb_subr_label_list_ -- Collect a tokenlist of labels and close-paren
1802
1803 return ffestb_subr_label_list_; // to lexer after seeing OPEN_PAREN
1804
1805 First token must be a NUMBER. Must be followed by zero or more COMMA
1806 NUMBER pairs. Must then be followed by a CLOSE_PAREN. If all ok, put
1807 the NUMBER tokens in a token list and return via the handler for the
1808 token after CLOSE_PAREN. Else return via
1809 same handler, but with the ok return value set FALSE. */
1810
1811 static ffelexHandler
1812 ffestb_subr_label_list_ (ffelexToken t)
1813 {
1814 if (ffelex_token_type (t) == FFELEX_typeNUMBER)
1815 {
1816 ffestt_tokenlist_append (ffestb_subrargs_.label_list.labels,
1817 ffelex_token_use (t));
1818 return (ffelexHandler) ffestb_subr_label_list_1_;
1819 }
1820
1821 ffestb_subrargs_.label_list.ok = FALSE;
1822 return (ffelexHandler) (*ffestb_subrargs_.label_list.handler) (t);
1823 }
1824
1825 /* ffestb_subr_label_list_1_ -- NUMBER
1826
1827 return ffestb_subr_label_list_1_; // to lexer after seeing NUMBER
1828
1829 The next token must be COMMA, in which case go back to
1830 ffestb_subr_label_list_, or CLOSE_PAREN, in which case set ok to TRUE
1831 and go to the handler. */
1832
1833 static ffelexHandler
1834 ffestb_subr_label_list_1_ (ffelexToken t)
1835 {
1836 switch (ffelex_token_type (t))
1837 {
1838 case FFELEX_typeCOMMA:
1839 return (ffelexHandler) ffestb_subr_label_list_;
1840
1841 case FFELEX_typeCLOSE_PAREN:
1842 ffestb_subrargs_.label_list.ok = TRUE;
1843 return (ffelexHandler) ffestb_subrargs_.label_list.handler;
1844
1845 default:
1846 ffestb_subrargs_.label_list.ok = FALSE;
1847 return (ffelexHandler) (*ffestb_subrargs_.label_list.handler) (t);
1848 }
1849 }
1850
1851 /* ffestb_do -- Parse the DO statement
1852
1853 return ffestb_do; // to lexer
1854
1855 Make sure the statement has a valid form for the DO statement. If it
1856 does, implement the statement. */
1857
1858 ffelexHandler
1859 ffestb_do (ffelexToken t)
1860 {
1861 ffeTokenLength i;
1862 unsigned const char *p;
1863 ffelexHandler next;
1864 ffelexToken nt;
1865 ffestrSecond kw;
1866
1867 switch (ffelex_token_type (ffesta_tokens[0]))
1868 {
1869 case FFELEX_typeNAME:
1870 if (ffesta_first_kw != FFESTR_firstDO)
1871 goto bad_0; /* :::::::::::::::::::: */
1872 switch (ffelex_token_type (t))
1873 {
1874 case FFELEX_typeNUMBER:
1875 ffesta_confirmed ();
1876 ffesta_tokens[1] = ffelex_token_use (t);
1877 return (ffelexHandler) ffestb_do1_;
1878
1879 case FFELEX_typeCOMMA:
1880 ffesta_confirmed ();
1881 ffesta_tokens[1] = NULL;
1882 return (ffelexHandler) ffestb_do2_;
1883
1884 case FFELEX_typeNAME:
1885 ffesta_confirmed ();
1886 ffesta_tokens[1] = NULL;
1887 ffesta_tokens[2] = ffelex_token_use (t);
1888 return (ffelexHandler) ffestb_do3_;
1889
1890 case FFELEX_typeEOS:
1891 case FFELEX_typeSEMICOLON:
1892 ffesta_confirmed ();
1893 ffesta_tokens[1] = NULL;
1894 return (ffelexHandler) ffestb_do1_ (t);
1895
1896 case FFELEX_typeCOLONCOLON:
1897 ffesta_confirmed (); /* Error, but clearly intended. */
1898 goto bad_1; /* :::::::::::::::::::: */
1899
1900 default:
1901 goto bad_1; /* :::::::::::::::::::: */
1902 }
1903
1904 case FFELEX_typeNAMES:
1905 if (ffesta_first_kw != FFESTR_firstDO)
1906 goto bad_0; /* :::::::::::::::::::: */
1907 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDO);
1908 switch (ffelex_token_type (t))
1909 {
1910 case FFELEX_typeCOLONCOLON:
1911 ffesta_confirmed (); /* Error, but clearly intended. */
1912 goto bad_1; /* :::::::::::::::::::: */
1913
1914 default:
1915 goto bad_1; /* :::::::::::::::::::: */
1916
1917 case FFELEX_typeOPEN_PAREN: /* Must be "DO" label "WHILE". */
1918 if (! ISDIGIT (*p))
1919 goto bad_i; /* :::::::::::::::::::: */
1920 ffesta_tokens[1] = ffelex_token_number_from_names (ffesta_tokens[0],
1921 i);
1922 p += ffelex_token_length (ffesta_tokens[1]);
1923 i += ffelex_token_length (ffesta_tokens[1]);
1924 if (((*p) != 'W') && ((*p) != 'w'))
1925 goto bad_i1; /* :::::::::::::::::::: */
1926 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
1927 kw = ffestr_second (nt);
1928 ffelex_token_kill (nt);
1929 if (kw != FFESTR_secondWHILE)
1930 goto bad_i1; /* :::::::::::::::::::: */
1931 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
1932 FFEEXPR_contextDOWHILE, (ffeexprCallback) ffestb_do4_);
1933
1934 case FFELEX_typeCOMMA:
1935 ffesta_confirmed ();
1936 if (*p == '\0')
1937 {
1938 ffesta_tokens[1] = NULL;
1939 return (ffelexHandler) ffestb_do2_;
1940 }
1941 if (! ISDIGIT (*p))
1942 goto bad_i; /* :::::::::::::::::::: */
1943 ffesta_tokens[1] = ffelex_token_number_from_names (ffesta_tokens[0],
1944 i);
1945 p += ffelex_token_length (ffesta_tokens[1]);
1946 i += ffelex_token_length (ffesta_tokens[1]);
1947 if (*p != '\0')
1948 goto bad_i1; /* :::::::::::::::::::: */
1949 return (ffelexHandler) ffestb_do2_;
1950
1951 case FFELEX_typeEQUALS:
1952 if (ISDIGIT (*p))
1953 {
1954 ffesta_tokens[1]
1955 = ffelex_token_number_from_names (ffesta_tokens[0], i);
1956 p += ffelex_token_length (ffesta_tokens[1]);
1957 i += ffelex_token_length (ffesta_tokens[1]);
1958 }
1959 else
1960 ffesta_tokens[1] = NULL;
1961 if (!ffesrc_is_name_init (*p))
1962 goto bad_i1; /* :::::::::::::::::::: */
1963 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
1964 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_lhs
1965 (ffesta_output_pool, FFEEXPR_contextDO,
1966 (ffeexprCallback) ffestb_do6_)))
1967 (nt);
1968 ffelex_token_kill (nt); /* Will get it back in _6_... */
1969 return (ffelexHandler) (*next) (t);
1970
1971 case FFELEX_typeEOS:
1972 case FFELEX_typeSEMICOLON:
1973 ffesta_confirmed ();
1974 if (ISDIGIT (*p))
1975 {
1976 ffesta_tokens[1]
1977 = ffelex_token_number_from_names (ffesta_tokens[0], i);
1978 p += ffelex_token_length (ffesta_tokens[1]);
1979 i += ffelex_token_length (ffesta_tokens[1]);
1980 }
1981 else
1982 ffesta_tokens[1] = NULL;
1983 if (*p != '\0')
1984 goto bad_i1; /* :::::::::::::::::::: */
1985 return (ffelexHandler) ffestb_do1_ (t);
1986 }
1987
1988 default:
1989 goto bad_0; /* :::::::::::::::::::: */
1990 }
1991
1992 bad_0: /* :::::::::::::::::::: */
1993 if (ffesta_construct_name != NULL)
1994 {
1995 ffelex_token_kill (ffesta_construct_name);
1996 ffesta_construct_name = NULL;
1997 }
1998 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[0]);
1999 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2000
2001 bad_1: /* :::::::::::::::::::: */
2002 if (ffesta_construct_name != NULL)
2003 {
2004 ffelex_token_kill (ffesta_construct_name);
2005 ffesta_construct_name = NULL;
2006 }
2007 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
2008 return (ffelexHandler) ffelex_swallow_tokens (t,
2009 (ffelexHandler) ffesta_zero); /* Invalid second token. */
2010
2011 bad_i1: /* :::::::::::::::::::: */
2012 if (ffesta_tokens[1])
2013 ffelex_token_kill (ffesta_tokens[1]);
2014
2015 bad_i: /* :::::::::::::::::::: */
2016 if (ffesta_construct_name != NULL)
2017 {
2018 ffelex_token_kill (ffesta_construct_name);
2019 ffesta_construct_name = NULL;
2020 }
2021 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[0], i, t);
2022 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2023 }
2024
2025 /* ffestb_dowhile -- Parse the DOWHILE statement
2026
2027 return ffestb_dowhile; // to lexer
2028
2029 Make sure the statement has a valid form for the DOWHILE statement. If it
2030 does, implement the statement. */
2031
2032 ffelexHandler
2033 ffestb_dowhile (ffelexToken t)
2034 {
2035 ffeTokenLength i;
2036 const char *p;
2037 ffelexHandler next;
2038 ffelexToken nt;
2039
2040 switch (ffelex_token_type (ffesta_tokens[0]))
2041 {
2042 case FFELEX_typeNAMES:
2043 if (ffesta_first_kw != FFESTR_firstDOWHILE)
2044 goto bad_0; /* :::::::::::::::::::: */
2045 switch (ffelex_token_type (t))
2046 {
2047 case FFELEX_typeEOS:
2048 case FFELEX_typeSEMICOLON:
2049 case FFELEX_typeCOMMA:
2050 case FFELEX_typeCOLONCOLON:
2051 ffesta_confirmed (); /* Error, but clearly intended. */
2052 goto bad_1; /* :::::::::::::::::::: */
2053
2054 default:
2055 goto bad_1; /* :::::::::::::::::::: */
2056
2057 case FFELEX_typeOPEN_PAREN:
2058 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDOWHILE);
2059 if (*p != '\0')
2060 goto bad_i; /* :::::::::::::::::::: */
2061 ffesta_tokens[1] = NULL;
2062 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
2063 FFEEXPR_contextDOWHILE, (ffeexprCallback) ffestb_do4_);
2064
2065 case FFELEX_typeEQUALS:/* Not really DOWHILE, but DOWHILExyz=.... */
2066 ffesta_tokens[1] = NULL;
2067 nt = ffelex_token_name_from_names (ffesta_tokens[0], FFESTR_firstlDO,
2068 0);
2069 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_lhs
2070 (ffesta_output_pool, FFEEXPR_contextDO,
2071 (ffeexprCallback) ffestb_do6_)))
2072 (nt);
2073 ffelex_token_kill (nt); /* Will get it back in _6_... */
2074 return (ffelexHandler) (*next) (t);
2075 }
2076
2077 default:
2078 goto bad_0; /* :::::::::::::::::::: */
2079 }
2080
2081 bad_0: /* :::::::::::::::::::: */
2082 if (ffesta_construct_name != NULL)
2083 {
2084 ffelex_token_kill (ffesta_construct_name);
2085 ffesta_construct_name = NULL;
2086 }
2087 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[0]);
2088 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2089
2090 bad_1: /* :::::::::::::::::::: */
2091 if (ffesta_construct_name != NULL)
2092 {
2093 ffelex_token_kill (ffesta_construct_name);
2094 ffesta_construct_name = NULL;
2095 }
2096 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
2097 return (ffelexHandler) ffelex_swallow_tokens (t,
2098 (ffelexHandler) ffesta_zero); /* Invalid second token. */
2099
2100 bad_i: /* :::::::::::::::::::: */
2101 if (ffesta_construct_name != NULL)
2102 {
2103 ffelex_token_kill (ffesta_construct_name);
2104 ffesta_construct_name = NULL;
2105 }
2106 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[0], i, t);
2107 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2108 }
2109
2110 /* ffestb_do1_ -- "DO" [label]
2111
2112 return ffestb_do1_; // to lexer
2113
2114 Make sure the statement has a valid form for the DO statement. If it
2115 does, implement the statement. */
2116
2117 static ffelexHandler
2118 ffestb_do1_ (ffelexToken t)
2119 {
2120 switch (ffelex_token_type (t))
2121 {
2122 case FFELEX_typeCOMMA:
2123 ffesta_confirmed ();
2124 return (ffelexHandler) ffestb_do2_;
2125
2126 case FFELEX_typeEOS:
2127 case FFELEX_typeSEMICOLON:
2128 ffesta_confirmed ();
2129 if (!ffesta_is_inhibited ())
2130 {
2131 if (ffesta_tokens[1] != NULL)
2132 ffestc_R819B (ffesta_construct_name, ffesta_tokens[1], NULL,
2133 NULL);
2134 else
2135 ffestc_R820B (ffesta_construct_name, NULL, NULL);
2136 }
2137 if (ffesta_tokens[1] != NULL)
2138 ffelex_token_kill (ffesta_tokens[1]);
2139 if (ffesta_construct_name != NULL)
2140 {
2141 ffelex_token_kill (ffesta_construct_name);
2142 ffesta_construct_name = NULL;
2143 }
2144 return (ffelexHandler) ffesta_zero (t);
2145
2146 case FFELEX_typeNAME:
2147 return (ffelexHandler) ffestb_do2_ (t);
2148
2149 default:
2150 break;
2151 }
2152
2153 if (ffesta_tokens[1] != NULL)
2154 ffelex_token_kill (ffesta_tokens[1]);
2155 if (ffesta_construct_name != NULL)
2156 {
2157 ffelex_token_kill (ffesta_construct_name);
2158 ffesta_construct_name = NULL;
2159 }
2160 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
2161 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2162 }
2163
2164 /* ffestb_do2_ -- "DO" [label] [,]
2165
2166 return ffestb_do2_; // to lexer
2167
2168 Make sure the statement has a valid form for the DO statement. If it
2169 does, implement the statement. */
2170
2171 static ffelexHandler
2172 ffestb_do2_ (ffelexToken t)
2173 {
2174 switch (ffelex_token_type (t))
2175 {
2176 case FFELEX_typeNAME:
2177 ffesta_tokens[2] = ffelex_token_use (t);
2178 return (ffelexHandler) ffestb_do3_;
2179
2180 default:
2181 break;
2182 }
2183
2184 if (ffesta_tokens[1] != NULL)
2185 ffelex_token_kill (ffesta_tokens[1]);
2186 if (ffesta_construct_name != NULL)
2187 {
2188 ffelex_token_kill (ffesta_construct_name);
2189 ffesta_construct_name = NULL;
2190 }
2191 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
2192 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2193 }
2194
2195 /* ffestb_do3_ -- "DO" [label] [,] NAME
2196
2197 return ffestb_do3_; // to lexer
2198
2199 Make sure the statement has a valid form for the DO statement. If it
2200 does, implement the statement. */
2201
2202 static ffelexHandler
2203 ffestb_do3_ (ffelexToken t)
2204 {
2205 ffelexHandler next;
2206
2207 switch (ffelex_token_type (t))
2208 {
2209 case FFELEX_typeEQUALS:
2210 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
2211 FFEEXPR_contextDO, (ffeexprCallback) ffestb_do6_)))
2212 (ffesta_tokens[2]);
2213 ffelex_token_kill (ffesta_tokens[2]); /* Will get it back in _6_... */
2214 return (ffelexHandler) (*next) (t);
2215
2216 case FFELEX_typeOPEN_PAREN:
2217 if (ffestr_second (ffesta_tokens[2]) != FFESTR_secondWHILE)
2218 {
2219 if (ffesta_tokens[1] != NULL)
2220 ffelex_token_kill (ffesta_tokens[1]);
2221 if (ffesta_construct_name != NULL)
2222 {
2223 ffelex_token_kill (ffesta_construct_name);
2224 ffesta_construct_name = NULL;
2225 }
2226 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[2]);
2227 ffelex_token_kill (ffesta_tokens[2]);
2228 return (ffelexHandler) ffelex_swallow_tokens (t,
2229 (ffelexHandler) ffesta_zero); /* Invalid token. */
2230 }
2231 ffelex_token_kill (ffesta_tokens[2]);
2232 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
2233 FFEEXPR_contextDOWHILE, (ffeexprCallback) ffestb_do4_);
2234
2235 default:
2236 break;
2237 }
2238
2239 ffelex_token_kill (ffesta_tokens[2]);
2240 if (ffesta_tokens[1] != NULL)
2241 ffelex_token_kill (ffesta_tokens[1]);
2242 if (ffesta_construct_name != NULL)
2243 {
2244 ffelex_token_kill (ffesta_construct_name);
2245 ffesta_construct_name = NULL;
2246 }
2247 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
2248 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2249 }
2250
2251 /* ffestb_do4_ -- "DO" [label] [,] "WHILE" OPEN_PAREN expr
2252
2253 (ffestb_do4_) // to expression handler
2254
2255 Make sure the statement has a valid form for the DO statement. If it
2256 does, implement the statement. */
2257
2258 static ffelexHandler
2259 ffestb_do4_ (ffelexToken ft, ffebld expr, ffelexToken t)
2260 {
2261 switch (ffelex_token_type (t))
2262 {
2263 case FFELEX_typeCLOSE_PAREN:
2264 if (expr == NULL)
2265 break;
2266 ffesta_tokens[2] = ffelex_token_use (ft);
2267 ffestb_local_.dowhile.expr = expr;
2268 return (ffelexHandler) ffestb_do5_;
2269
2270 default:
2271 break;
2272 }
2273
2274 if (ffesta_tokens[1] != NULL)
2275 ffelex_token_kill (ffesta_tokens[1]);
2276 if (ffesta_construct_name != NULL)
2277 {
2278 ffelex_token_kill (ffesta_construct_name);
2279 ffesta_construct_name = NULL;
2280 }
2281 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
2282 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2283 }
2284
2285 /* ffestb_do5_ -- "DO" [label] [,] "WHILE" OPEN_PAREN expr CLOSE_PAREN
2286
2287 return ffestb_do5_; // to lexer
2288
2289 Make sure the statement has a valid form for the DO statement. If it
2290 does, implement the statement. */
2291
2292 static ffelexHandler
2293 ffestb_do5_ (ffelexToken t)
2294 {
2295 switch (ffelex_token_type (t))
2296 {
2297 case FFELEX_typeEOS:
2298 case FFELEX_typeSEMICOLON:
2299 ffesta_confirmed ();
2300 if (!ffesta_is_inhibited ())
2301 {
2302 if (ffesta_tokens[1] != NULL)
2303 ffestc_R819B (ffesta_construct_name, ffesta_tokens[1],
2304 ffestb_local_.dowhile.expr, ffesta_tokens[2]);
2305 else
2306 ffestc_R820B (ffesta_construct_name, ffestb_local_.dowhile.expr,
2307 ffesta_tokens[2]);
2308 }
2309 ffelex_token_kill (ffesta_tokens[2]);
2310 if (ffesta_tokens[1] != NULL)
2311 ffelex_token_kill (ffesta_tokens[1]);
2312 if (ffesta_construct_name != NULL)
2313 {
2314 ffelex_token_kill (ffesta_construct_name);
2315 ffesta_construct_name = NULL;
2316 }
2317 return (ffelexHandler) ffesta_zero (t);
2318
2319 default:
2320 break;
2321 }
2322
2323 ffelex_token_kill (ffesta_tokens[2]);
2324 if (ffesta_tokens[1] != NULL)
2325 ffelex_token_kill (ffesta_tokens[1]);
2326 if (ffesta_construct_name != NULL)
2327 {
2328 ffelex_token_kill (ffesta_construct_name);
2329 ffesta_construct_name = NULL;
2330 }
2331 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
2332 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2333 }
2334
2335 /* ffestb_do6_ -- "DO" [label] [,] var-expr
2336
2337 (ffestb_do6_) // to expression handler
2338
2339 Make sure the statement has a valid form for the DO statement. If it
2340 does, implement the statement. */
2341
2342 static ffelexHandler
2343 ffestb_do6_ (ffelexToken ft, ffebld expr, ffelexToken t)
2344 {
2345 /* _3_ already ensured that this would be an EQUALS token. If not, it is a
2346 bug in the FFE. */
2347
2348 assert (ffelex_token_type (t) == FFELEX_typeEQUALS);
2349
2350 ffesta_tokens[2] = ffelex_token_use (ft);
2351 ffestb_local_.do_stmt.var = expr;
2352 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
2353 FFEEXPR_contextDO, (ffeexprCallback) ffestb_do7_);
2354 }
2355
2356 /* ffestb_do7_ -- "DO" [label] [,] var-expr EQUALS expr
2357
2358 (ffestb_do7_) // to expression handler
2359
2360 Make sure the statement has a valid form for the DO statement. If it
2361 does, implement the statement. */
2362
2363 static ffelexHandler
2364 ffestb_do7_ (ffelexToken ft, ffebld expr, ffelexToken t)
2365 {
2366 switch (ffelex_token_type (t))
2367 {
2368 case FFELEX_typeCOMMA:
2369 ffesta_confirmed ();
2370 if (expr == NULL)
2371 break;
2372 ffesta_tokens[3] = ffelex_token_use (ft);
2373 ffestb_local_.do_stmt.start = expr;
2374 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
2375 FFEEXPR_contextDO, (ffeexprCallback) ffestb_do8_);
2376
2377 default:
2378 break;
2379 }
2380
2381 ffelex_token_kill (ffesta_tokens[2]);
2382 if (ffesta_tokens[1] != NULL)
2383 ffelex_token_kill (ffesta_tokens[1]);
2384 if (ffesta_construct_name != NULL)
2385 {
2386 ffelex_token_kill (ffesta_construct_name);
2387 ffesta_construct_name = NULL;
2388 }
2389 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
2390 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2391 }
2392
2393 /* ffestb_do8_ -- "DO" [label] [,] var-expr EQUALS expr COMMA expr
2394
2395 (ffestb_do8_) // to expression handler
2396
2397 Make sure the statement has a valid form for the DO statement. If it
2398 does, implement the statement. */
2399
2400 static ffelexHandler
2401 ffestb_do8_ (ffelexToken ft, ffebld expr, ffelexToken t)
2402 {
2403 switch (ffelex_token_type (t))
2404 {
2405 case FFELEX_typeCOMMA:
2406 if (expr == NULL)
2407 break;
2408 ffesta_tokens[4] = ffelex_token_use (ft);
2409 ffestb_local_.do_stmt.end = expr;
2410 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
2411 FFEEXPR_contextDO, (ffeexprCallback) ffestb_do9_);
2412
2413 case FFELEX_typeEOS:
2414 case FFELEX_typeSEMICOLON:
2415 if (expr == NULL)
2416 break;
2417 ffesta_tokens[4] = ffelex_token_use (ft);
2418 ffestb_local_.do_stmt.end = expr;
2419 return (ffelexHandler) ffestb_do9_ (NULL, NULL, t);
2420
2421 default:
2422 break;
2423 }
2424
2425 ffelex_token_kill (ffesta_tokens[3]);
2426 ffelex_token_kill (ffesta_tokens[2]);
2427 if (ffesta_tokens[1] != NULL)
2428 ffelex_token_kill (ffesta_tokens[1]);
2429 if (ffesta_construct_name != NULL)
2430 {
2431 ffelex_token_kill (ffesta_construct_name);
2432 ffesta_construct_name = NULL;
2433 }
2434 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
2435 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2436 }
2437
2438 /* ffestb_do9_ -- "DO" [label] [,] var-expr EQUALS expr COMMA expr
2439 [COMMA expr]
2440
2441 (ffestb_do9_) // to expression handler
2442
2443 Make sure the statement has a valid form for the DO statement. If it
2444 does, implement the statement. */
2445
2446 static ffelexHandler
2447 ffestb_do9_ (ffelexToken ft, ffebld expr, ffelexToken t)
2448 {
2449 switch (ffelex_token_type (t))
2450 {
2451 case FFELEX_typeEOS:
2452 case FFELEX_typeSEMICOLON:
2453 if ((expr == NULL) && (ft != NULL))
2454 break;
2455 if (!ffesta_is_inhibited ())
2456 {
2457 if (ffesta_tokens[1] != NULL)
2458 ffestc_R819A (ffesta_construct_name, ffesta_tokens[1],
2459 ffestb_local_.do_stmt.var, ffesta_tokens[2],
2460 ffestb_local_.do_stmt.start, ffesta_tokens[3],
2461 ffestb_local_.do_stmt.end, ffesta_tokens[4], expr, ft);
2462 else
2463 ffestc_R820A (ffesta_construct_name, ffestb_local_.do_stmt.var,
2464 ffesta_tokens[2], ffestb_local_.do_stmt.start,
2465 ffesta_tokens[3], ffestb_local_.do_stmt.end,
2466 ffesta_tokens[4], expr, ft);
2467 }
2468 ffelex_token_kill (ffesta_tokens[4]);
2469 ffelex_token_kill (ffesta_tokens[3]);
2470 ffelex_token_kill (ffesta_tokens[2]);
2471 if (ffesta_tokens[1] != NULL)
2472 ffelex_token_kill (ffesta_tokens[1]);
2473 if (ffesta_construct_name != NULL)
2474 {
2475 ffelex_token_kill (ffesta_construct_name);
2476 ffesta_construct_name = NULL;
2477 }
2478
2479 return (ffelexHandler) ffesta_zero (t);
2480
2481 default:
2482 break;
2483 }
2484
2485 ffelex_token_kill (ffesta_tokens[4]);
2486 ffelex_token_kill (ffesta_tokens[3]);
2487 ffelex_token_kill (ffesta_tokens[2]);
2488 if (ffesta_tokens[1] != NULL)
2489 ffelex_token_kill (ffesta_tokens[1]);
2490 if (ffesta_construct_name != NULL)
2491 {
2492 ffelex_token_kill (ffesta_construct_name);
2493 ffesta_construct_name = NULL;
2494 }
2495 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
2496 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2497 }
2498
2499 /* ffestb_else -- Parse the ELSE statement
2500
2501 return ffestb_else; // to lexer
2502
2503 Make sure the statement has a valid form for the ELSE statement. If it
2504 does, implement the statement. */
2505
2506 ffelexHandler
2507 ffestb_else (ffelexToken t)
2508 {
2509 ffeTokenLength i;
2510 unsigned const char *p;
2511
2512 switch (ffelex_token_type (ffesta_tokens[0]))
2513 {
2514 case FFELEX_typeNAME:
2515 if (ffesta_first_kw != FFESTR_firstELSE)
2516 goto bad_0; /* :::::::::::::::::::: */
2517 switch (ffelex_token_type (t))
2518 {
2519 case FFELEX_typeEOS:
2520 case FFELEX_typeSEMICOLON:
2521 ffesta_confirmed ();
2522 ffesta_tokens[1] = NULL;
2523 ffestb_args.elsexyz.second = FFESTR_secondNone;
2524 return (ffelexHandler) ffestb_else1_ (t);
2525
2526 case FFELEX_typeCOMMA:
2527 case FFELEX_typeCOLONCOLON:
2528 ffesta_confirmed (); /* Error, but clearly intended. */
2529 goto bad_1; /* :::::::::::::::::::: */
2530
2531 default:
2532 goto bad_1; /* :::::::::::::::::::: */
2533
2534 case FFELEX_typeNAME:
2535 break;
2536 }
2537
2538 ffesta_confirmed ();
2539 ffestb_args.elsexyz.second = ffesta_second_kw;
2540 ffesta_tokens[1] = ffelex_token_use (t);
2541 return (ffelexHandler) ffestb_else1_;
2542
2543 case FFELEX_typeNAMES:
2544 if (ffesta_first_kw != FFESTR_firstELSE)
2545 goto bad_0; /* :::::::::::::::::::: */
2546 switch (ffelex_token_type (t))
2547 {
2548 case FFELEX_typeCOMMA:
2549 case FFELEX_typeCOLONCOLON:
2550 ffesta_confirmed (); /* Error, but clearly intended. */
2551 goto bad_1; /* :::::::::::::::::::: */
2552
2553 default:
2554 goto bad_1; /* :::::::::::::::::::: */
2555
2556 case FFELEX_typeEOS:
2557 case FFELEX_typeSEMICOLON:
2558 break;
2559 }
2560 ffesta_confirmed ();
2561 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlELSE)
2562 {
2563 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlELSE);
2564 if (!ffesrc_is_name_init (*p))
2565 goto bad_i; /* :::::::::::::::::::: */
2566 ffesta_tokens[1]
2567 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
2568 }
2569 else
2570 ffesta_tokens[1] = NULL;
2571 ffestb_args.elsexyz.second = FFESTR_secondNone;
2572 return (ffelexHandler) ffestb_else1_ (t);
2573
2574 default:
2575 goto bad_0; /* :::::::::::::::::::: */
2576 }
2577
2578 bad_0: /* :::::::::::::::::::: */
2579 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", ffesta_tokens[0]);
2580 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2581
2582 bad_1: /* :::::::::::::::::::: */
2583 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", t);
2584 return (ffelexHandler) ffelex_swallow_tokens (t,
2585 (ffelexHandler) ffesta_zero); /* Invalid second token. */
2586
2587 bad_i: /* :::::::::::::::::::: */
2588 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "ELSE", ffesta_tokens[0], i, t);
2589 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2590 }
2591
2592 /* ffestb_elsexyz -- Parse an ELSEIF/ELSEWHERE statement
2593
2594 return ffestb_elsexyz; // to lexer
2595
2596 Expects len and second to be set in ffestb_args.elsexyz to the length
2597 of the ELSExyz keyword involved and the corresponding ffestrSecond value. */
2598
2599 ffelexHandler
2600 ffestb_elsexyz (ffelexToken t)
2601 {
2602 ffeTokenLength i;
2603 const char *p;
2604
2605 switch (ffelex_token_type (ffesta_tokens[0]))
2606 {
2607 case FFELEX_typeNAME:
2608 switch (ffelex_token_type (t))
2609 {
2610 case FFELEX_typeEOS:
2611 case FFELEX_typeSEMICOLON:
2612 if (ffesta_first_kw == FFESTR_firstELSEIF)
2613 goto bad_0; /* :::::::::::::::::::: */
2614 ffesta_confirmed ();
2615 ffesta_tokens[1] = NULL;
2616 return (ffelexHandler) ffestb_else1_ (t);
2617
2618 case FFELEX_typeNAME:
2619 ffesta_confirmed ();
2620 goto bad_1; /* :::::::::::::::::::: */
2621
2622 case FFELEX_typeOPEN_PAREN:
2623 if (ffesta_first_kw != FFESTR_firstELSEIF)
2624 goto bad_0; /* :::::::::::::::::::: */
2625 ffesta_tokens[1] = NULL;
2626 return (ffelexHandler) ffestb_else1_ (t);
2627
2628 case FFELEX_typeCOMMA:
2629 case FFELEX_typeCOLONCOLON:
2630 ffesta_confirmed (); /* Error, but clearly intended. */
2631 goto bad_1; /* :::::::::::::::::::: */
2632
2633 default:
2634 goto bad_1; /* :::::::::::::::::::: */
2635 }
2636
2637 case FFELEX_typeNAMES:
2638 switch (ffelex_token_type (t))
2639 {
2640 case FFELEX_typeCOMMA:
2641 case FFELEX_typeCOLONCOLON:
2642 ffesta_confirmed (); /* Error, but clearly intended. */
2643 goto bad_1; /* :::::::::::::::::::: */
2644
2645 default:
2646 goto bad_1; /* :::::::::::::::::::: */
2647
2648 case FFELEX_typeOPEN_PAREN:
2649 if (ffesta_first_kw != FFESTR_firstELSEIF)
2650 goto bad_1; /* :::::::::::::::::::: */
2651 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlELSEIF)
2652 {
2653 i = FFESTR_firstlELSEIF;
2654 goto bad_i; /* :::::::::::::::::::: */
2655 }
2656 ffesta_tokens[1] = NULL;
2657 return (ffelexHandler) ffestb_else1_ (t);
2658
2659 case FFELEX_typeEOS:
2660 case FFELEX_typeSEMICOLON:
2661 break;
2662 }
2663 ffesta_confirmed ();
2664 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlELSE);
2665 ffesta_tokens[1]
2666 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
2667 #if FFESTR_F90
2668 if ((ffestb_args.elsexyz.second == FFESTR_secondWHERE)
2669 && (ffelex_token_length (ffesta_tokens[1]) != FFESTR_secondlWHERE))
2670 ffestb_args.elsexyz.second = FFESTR_secondNone;
2671 #endif
2672 return (ffelexHandler) ffestb_else1_ (t);
2673
2674 default:
2675 goto bad_0; /* :::::::::::::::::::: */
2676 }
2677
2678 bad_0: /* :::::::::::::::::::: */
2679 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", ffesta_tokens[0]);
2680 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2681
2682 bad_1: /* :::::::::::::::::::: */
2683 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", t);
2684 return (ffelexHandler) ffelex_swallow_tokens (t,
2685 (ffelexHandler) ffesta_zero); /* Invalid second token. */
2686
2687 bad_i: /* :::::::::::::::::::: */
2688 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "ELSE IF", ffesta_tokens[0], i, t);
2689 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2690 }
2691
2692 /* ffestb_else1_ -- "ELSE" (NAME)
2693
2694 return ffestb_else1_; // to lexer
2695
2696 If EOS/SEMICOLON, implement the appropriate statement (keep in mind that
2697 "ELSE WHERE" is ambiguous at the syntactic level). If OPEN_PAREN, start
2698 expression analysis with callback at _2_. */
2699
2700 static ffelexHandler
2701 ffestb_else1_ (ffelexToken t)
2702 {
2703 switch (ffelex_token_type (t))
2704 {
2705 case FFELEX_typeOPEN_PAREN:
2706 if (ffestb_args.elsexyz.second == FFESTR_secondIF)
2707 {
2708 if (ffesta_tokens[1] != NULL)
2709 ffelex_token_kill (ffesta_tokens[1]);
2710 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
2711 FFEEXPR_contextIF, (ffeexprCallback) ffestb_else2_);
2712 }
2713 /* Fall through. */
2714 default:
2715 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", t);
2716 if (ffesta_tokens[1] != NULL)
2717 ffelex_token_kill (ffesta_tokens[1]);
2718 return (ffelexHandler) ffelex_swallow_tokens (t,
2719 (ffelexHandler) ffesta_zero);
2720
2721 case FFELEX_typeEOS:
2722 case FFELEX_typeSEMICOLON:
2723 ffesta_confirmed ();
2724 break;
2725
2726 }
2727
2728 switch (ffestb_args.elsexyz.second)
2729 {
2730 #if FFESTR_F90
2731 case FFESTR_secondWHERE:
2732 if (!ffesta_is_inhibited ())
2733 if ((ffesta_first_kw == FFESTR_firstELSEWHERE)
2734 && (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME))
2735 ffestc_R744 ();
2736 else
2737 ffestc_elsewhere (ffesta_tokens[1]); /* R744 or R805. */
2738 break;
2739 #endif
2740
2741 default:
2742 if (!ffesta_is_inhibited ())
2743 ffestc_R805 (ffesta_tokens[1]);
2744 break;
2745 }
2746
2747 if (ffesta_tokens[1] != NULL)
2748 ffelex_token_kill (ffesta_tokens[1]);
2749 return (ffelexHandler) ffesta_zero (t);
2750 }
2751
2752 /* ffestb_else2_ -- "ELSE" "IF" OPEN_PAREN expr
2753
2754 (ffestb_else2_) // to expression handler
2755
2756 Make sure the next token is CLOSE_PAREN. */
2757
2758 static ffelexHandler
2759 ffestb_else2_ (ffelexToken ft, ffebld expr, ffelexToken t)
2760 {
2761 ffestb_local_.else_stmt.expr = expr;
2762
2763 switch (ffelex_token_type (t))
2764 {
2765 case FFELEX_typeCLOSE_PAREN:
2766 if (expr == NULL)
2767 break;
2768 ffesta_tokens[1] = ffelex_token_use (ft);
2769 ffelex_set_names (TRUE);
2770 return (ffelexHandler) ffestb_else3_;
2771
2772 default:
2773 break;
2774 }
2775
2776 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t);
2777 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2778 }
2779
2780 /* ffestb_else3_ -- "ELSE" "IF" OPEN_PAREN expr CLOSE_PAREN
2781
2782 return ffestb_else3_; // to lexer
2783
2784 Make sure the next token is "THEN". */
2785
2786 static ffelexHandler
2787 ffestb_else3_ (ffelexToken t)
2788 {
2789 ffeTokenLength i;
2790 unsigned const char *p;
2791
2792 ffelex_set_names (FALSE);
2793
2794 switch (ffelex_token_type (t))
2795 {
2796 case FFELEX_typeNAME:
2797 ffesta_confirmed ();
2798 if (ffestr_first (t) == FFESTR_firstTHEN)
2799 return (ffelexHandler) ffestb_else4_;
2800 break;
2801
2802 case FFELEX_typeNAMES:
2803 ffesta_confirmed ();
2804 if (ffestr_first (t) != FFESTR_firstTHEN)
2805 break;
2806 if (ffelex_token_length (t) == FFESTR_firstlTHEN)
2807 return (ffelexHandler) ffestb_else4_;
2808 p = ffelex_token_text (t) + (i = FFESTR_firstlTHEN);
2809 if (!ffesrc_is_name_init (*p))
2810 goto bad_i; /* :::::::::::::::::::: */
2811 ffesta_tokens[2] = ffelex_token_name_from_names (t, i, 0);
2812 return (ffelexHandler) ffestb_else5_;
2813
2814 default:
2815 break;
2816 }
2817
2818 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t);
2819 ffelex_token_kill (ffesta_tokens[1]);
2820 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2821
2822 bad_i: /* :::::::::::::::::::: */
2823 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t, i, NULL);
2824 ffelex_token_kill (ffesta_tokens[1]);
2825 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2826 }
2827
2828 /* ffestb_else4_ -- "ELSE" "IF" OPEN_PAREN expr CLOSE_PAREN "THEN"
2829
2830 return ffestb_else4_; // to lexer
2831
2832 Handle a NAME or EOS/SEMICOLON, then go to state _5_. */
2833
2834 static ffelexHandler
2835 ffestb_else4_ (ffelexToken t)
2836 {
2837 ffelex_set_names (FALSE);
2838
2839 switch (ffelex_token_type (t))
2840 {
2841 case FFELEX_typeEOS:
2842 case FFELEX_typeSEMICOLON:
2843 ffesta_tokens[2] = NULL;
2844 return (ffelexHandler) ffestb_else5_ (t);
2845
2846 case FFELEX_typeNAME:
2847 ffesta_tokens[2] = ffelex_token_use (t);
2848 return (ffelexHandler) ffestb_else5_;
2849
2850 default:
2851 break;
2852 }
2853
2854 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t);
2855 ffelex_token_kill (ffesta_tokens[1]);
2856 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2857 }
2858
2859 /* ffestb_else5_ -- "ELSE" "IF" OPEN_PAREN expr CLOSE_PAREN "THEN"
2860
2861 return ffestb_else5_; // to lexer
2862
2863 Make sure the next token is EOS or SEMICOLON; implement R804. */
2864
2865 static ffelexHandler
2866 ffestb_else5_ (ffelexToken t)
2867 {
2868 switch (ffelex_token_type (t))
2869 {
2870 case FFELEX_typeEOS:
2871 case FFELEX_typeSEMICOLON:
2872 if (!ffesta_is_inhibited ())
2873 ffestc_R804 (ffestb_local_.else_stmt.expr, ffesta_tokens[1],
2874 ffesta_tokens[2]);
2875 ffelex_token_kill (ffesta_tokens[1]);
2876 if (ffesta_tokens[2] != NULL)
2877 ffelex_token_kill (ffesta_tokens[2]);
2878 return (ffelexHandler) ffesta_zero (t);
2879
2880 default:
2881 break;
2882 }
2883
2884 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t);
2885 ffelex_token_kill (ffesta_tokens[1]);
2886 if (ffesta_tokens[2] != NULL)
2887 ffelex_token_kill (ffesta_tokens[2]);
2888 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2889 }
2890
2891 /* ffestb_end -- Parse the END statement
2892
2893 return ffestb_end; // to lexer
2894
2895 Make sure the statement has a valid form for the END statement. If it
2896 does, implement the statement. */
2897
2898 ffelexHandler
2899 ffestb_end (ffelexToken t)
2900 {
2901 ffeTokenLength i;
2902
2903 switch (ffelex_token_type (ffesta_tokens[0]))
2904 {
2905 case FFELEX_typeNAME:
2906 if (ffesta_first_kw != FFESTR_firstEND)
2907 goto bad_0; /* :::::::::::::::::::: */
2908 switch (ffelex_token_type (t))
2909 {
2910 case FFELEX_typeEOS:
2911 case FFELEX_typeSEMICOLON:
2912 ffesta_tokens[1] = NULL;
2913 ffestb_args.endxyz.second = FFESTR_secondNone;
2914 return (ffelexHandler) ffestb_end3_ (t);
2915
2916 case FFELEX_typeCOMMA:
2917 case FFELEX_typeCOLONCOLON:
2918 ffesta_confirmed (); /* Error, but clearly intended. */
2919 goto bad_1; /* :::::::::::::::::::: */
2920
2921 default:
2922 goto bad_1; /* :::::::::::::::::::: */
2923
2924 case FFELEX_typeNAME:
2925 break;
2926 }
2927
2928 ffesta_confirmed ();
2929 ffestb_args.endxyz.second = ffesta_second_kw;
2930 switch (ffesta_second_kw)
2931 {
2932 case FFESTR_secondFILE:
2933 ffestb_args.beru.badname = "ENDFILE";
2934 return (ffelexHandler) ffestb_beru;
2935
2936 case FFESTR_secondBLOCK:
2937 return (ffelexHandler) ffestb_end1_;
2938
2939 #if FFESTR_F90
2940 case FFESTR_secondINTERFACE:
2941 #endif
2942 #if FFESTR_VXT
2943 case FFESTR_secondMAP:
2944 case FFESTR_secondSTRUCTURE:
2945 case FFESTR_secondUNION:
2946 #endif
2947 #if FFESTR_F90
2948 case FFESTR_secondWHERE:
2949 ffesta_tokens[1] = NULL;
2950 return (ffelexHandler) ffestb_end3_;
2951 #endif
2952
2953 case FFESTR_secondNone:
2954 goto bad_1; /* :::::::::::::::::::: */
2955
2956 default:
2957 return (ffelexHandler) ffestb_end2_;
2958 }
2959
2960 case FFELEX_typeNAMES:
2961 if (ffesta_first_kw != FFESTR_firstEND)
2962 goto bad_0; /* :::::::::::::::::::: */
2963 switch (ffelex_token_type (t))
2964 {
2965 case FFELEX_typeCOMMA:
2966 case FFELEX_typeCOLONCOLON:
2967 ffesta_confirmed (); /* Error, but clearly intended. */
2968 goto bad_1; /* :::::::::::::::::::: */
2969
2970 default:
2971 goto bad_1; /* :::::::::::::::::::: */
2972
2973 case FFELEX_typeEOS:
2974 case FFELEX_typeSEMICOLON:
2975 break;
2976 }
2977 ffesta_confirmed ();
2978 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlEND)
2979 {
2980 i = FFESTR_firstlEND;
2981 goto bad_i; /* :::::::::::::::::::: */
2982 }
2983 ffesta_tokens[1] = NULL;
2984 ffestb_args.endxyz.second = FFESTR_secondNone;
2985 return (ffelexHandler) ffestb_end3_ (t);
2986
2987 default:
2988 goto bad_0; /* :::::::::::::::::::: */
2989 }
2990
2991 bad_0: /* :::::::::::::::::::: */
2992 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0]);
2993 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2994
2995 bad_1: /* :::::::::::::::::::: */
2996 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
2997 return (ffelexHandler) ffelex_swallow_tokens (t,
2998 (ffelexHandler) ffesta_zero); /* Invalid second token. */
2999
3000 bad_i: /* :::::::::::::::::::: */
3001 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0], i, t);
3002 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3003 }
3004
3005 /* ffestb_endxyz -- Parse an ENDxyz statement
3006
3007 return ffestb_endxyz; // to lexer
3008
3009 Expects len and second to be set in ffestb_args.endxyz to the length
3010 of the ENDxyz keyword involved and the corresponding ffestrSecond value. */
3011
3012 ffelexHandler
3013 ffestb_endxyz (ffelexToken t)
3014 {
3015 ffeTokenLength i;
3016 unsigned const char *p;
3017
3018 switch (ffelex_token_type (ffesta_tokens[0]))
3019 {
3020 case FFELEX_typeNAME:
3021 switch (ffelex_token_type (t))
3022 {
3023 case FFELEX_typeEOS:
3024 case FFELEX_typeSEMICOLON:
3025 ffesta_confirmed ();
3026 ffesta_tokens[1] = NULL;
3027 return (ffelexHandler) ffestb_end3_ (t);
3028
3029 case FFELEX_typeNAME:
3030 ffesta_confirmed ();
3031 switch (ffestb_args.endxyz.second)
3032 {
3033 #if FFESTR_F90
3034 case FFESTR_secondINTERFACE:
3035 #endif
3036 #if FFESTR_VXT
3037 case FFESTR_secondMAP:
3038 case FFESTR_secondSTRUCTURE:
3039 case FFESTR_secondUNION:
3040 #endif
3041 #if FFESTR_F90
3042 case FFESTR_secondWHERE:
3043 goto bad_1; /* :::::::::::::::::::: */
3044 #endif
3045
3046 case FFESTR_secondBLOCK:
3047 if (ffesta_second_kw != FFESTR_secondDATA)
3048 goto bad_1; /* :::::::::::::::::::: */
3049 return (ffelexHandler) ffestb_end2_;
3050
3051 default:
3052 return (ffelexHandler) ffestb_end2_ (t);
3053 }
3054
3055 case FFELEX_typeCOMMA:
3056 case FFELEX_typeCOLONCOLON:
3057 ffesta_confirmed (); /* Error, but clearly intended. */
3058 goto bad_1; /* :::::::::::::::::::: */
3059
3060 default:
3061 goto bad_1; /* :::::::::::::::::::: */
3062 }
3063
3064 case FFELEX_typeNAMES:
3065 switch (ffelex_token_type (t))
3066 {
3067 case FFELEX_typeCOMMA:
3068 case FFELEX_typeCOLONCOLON:
3069 ffesta_confirmed (); /* Error, but clearly intended. */
3070 goto bad_1; /* :::::::::::::::::::: */
3071
3072 default:
3073 goto bad_1; /* :::::::::::::::::::: */
3074
3075 case FFELEX_typeEOS:
3076 case FFELEX_typeSEMICOLON:
3077 break;
3078 }
3079 ffesta_confirmed ();
3080 if (ffestb_args.endxyz.second == FFESTR_secondBLOCK)
3081 {
3082 i = FFESTR_firstlEND;
3083 goto bad_i; /* :::::::::::::::::::: */
3084 }
3085 if (ffelex_token_length (ffesta_tokens[0]) != ffestb_args.endxyz.len)
3086 {
3087 p = ffelex_token_text (ffesta_tokens[0])
3088 + (i = ffestb_args.endxyz.len);
3089 switch (ffestb_args.endxyz.second)
3090 {
3091 #if FFESTR_F90
3092 case FFESTR_secondINTERFACE:
3093 #endif
3094 #if FFESTR_VXT
3095 case FFESTR_secondMAP:
3096 case FFESTR_secondSTRUCTURE:
3097 case FFESTR_secondUNION:
3098 #endif
3099 #if FFESTR_F90
3100 case FFESTR_secondWHERE:
3101 goto bad_i; /* :::::::::::::::::::: */
3102 #endif
3103
3104 default:
3105 break;
3106 }
3107 if (!ffesrc_is_name_init (*p))
3108 goto bad_i; /* :::::::::::::::::::: */
3109 ffesta_tokens[1]
3110 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
3111 return (ffelexHandler) ffestb_end3_ (t);
3112 }
3113 ffesta_tokens[1] = NULL;
3114 return (ffelexHandler) ffestb_end3_ (t);
3115
3116 default:
3117 goto bad_0; /* :::::::::::::::::::: */
3118 }
3119
3120 bad_0: /* :::::::::::::::::::: */
3121 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0]);
3122 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3123
3124 bad_1: /* :::::::::::::::::::: */
3125 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
3126 return (ffelexHandler) ffelex_swallow_tokens (t,
3127 (ffelexHandler) ffesta_zero); /* Invalid second token. */
3128
3129 bad_i: /* :::::::::::::::::::: */
3130 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0], i, t);
3131 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3132 }
3133
3134 /* ffestb_end1_ -- "END" "BLOCK"
3135
3136 return ffestb_end1_; // to lexer
3137
3138 Make sure the next token is "DATA". */
3139
3140 static ffelexHandler
3141 ffestb_end1_ (ffelexToken t)
3142 {
3143 if ((ffelex_token_type (t) == FFELEX_typeNAME)
3144 && (ffesrc_strcmp_2c (ffe_case_match (), ffelex_token_text (t), "DATA",
3145 "data", "Data")
3146 == 0))
3147 {
3148 return (ffelexHandler) ffestb_end2_;
3149 }
3150
3151 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
3152 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3153 }
3154
3155 /* ffestb_end2_ -- "END" <unit-kind>
3156
3157 return ffestb_end2_; // to lexer
3158
3159 Make sure the next token is a NAME or EOS. */
3160
3161 static ffelexHandler
3162 ffestb_end2_ (ffelexToken t)
3163 {
3164 switch (ffelex_token_type (t))
3165 {
3166 case FFELEX_typeNAME:
3167 ffesta_tokens[1] = ffelex_token_use (t);
3168 return (ffelexHandler) ffestb_end3_;
3169
3170 case FFELEX_typeEOS:
3171 case FFELEX_typeSEMICOLON:
3172 ffesta_tokens[1] = NULL;
3173 return (ffelexHandler) ffestb_end3_ (t);
3174
3175 default:
3176 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
3177 return (ffelexHandler) ffelex_swallow_tokens (t,
3178 (ffelexHandler) ffesta_zero);
3179 }
3180 }
3181
3182 /* ffestb_end3_ -- "END" <unit-kind> (NAME)
3183
3184 return ffestb_end3_; // to lexer
3185
3186 Make sure the next token is an EOS, then implement the statement. */
3187
3188 static ffelexHandler
3189 ffestb_end3_ (ffelexToken t)
3190 {
3191 switch (ffelex_token_type (t))
3192 {
3193 default:
3194 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
3195 if (ffesta_tokens[1] != NULL)
3196 ffelex_token_kill (ffesta_tokens[1]);
3197 return (ffelexHandler) ffelex_swallow_tokens (t,
3198 (ffelexHandler) ffesta_zero);
3199
3200 case FFELEX_typeEOS:
3201 case FFELEX_typeSEMICOLON:
3202 ffesta_confirmed ();
3203 if (ffestb_args.endxyz.second == FFESTR_secondNone)
3204 {
3205 if (!ffesta_is_inhibited ())
3206 ffestc_end ();
3207 return (ffelexHandler) ffesta_zero (t);
3208 }
3209 break;
3210 }
3211
3212 switch (ffestb_args.endxyz.second)
3213 {
3214 #if FFESTR_F90
3215 case FFESTR_secondTYPE:
3216 if (!ffesta_is_inhibited ())
3217 ffestc_R425 (ffesta_tokens[1]);
3218 break;
3219 #endif
3220
3221 #if FFESTR_F90
3222 case FFESTR_secondWHERE:
3223 if (!ffesta_is_inhibited ())
3224 ffestc_R745 ();
3225 break;
3226 #endif
3227
3228 case FFESTR_secondIF:
3229 if (!ffesta_is_inhibited ())
3230 ffestc_R806 (ffesta_tokens[1]);
3231 break;
3232
3233 case FFESTR_secondSELECT:
3234 if (!ffesta_is_inhibited ())
3235 ffestc_R811 (ffesta_tokens[1]);
3236 break;
3237
3238 case FFESTR_secondDO:
3239 if (!ffesta_is_inhibited ())
3240 ffestc_R825 (ffesta_tokens[1]);
3241 break;
3242
3243 case FFESTR_secondPROGRAM:
3244 if (!ffesta_is_inhibited ())
3245 ffestc_R1103 (ffesta_tokens[1]);
3246 break;
3247
3248 #if FFESTR_F90
3249 case FFESTR_secondMODULE:
3250 if (!ffesta_is_inhibited ())
3251 ffestc_R1106 (ffesta_tokens[1]);
3252 break;
3253 #endif
3254 case FFESTR_secondBLOCK:
3255 case FFESTR_secondBLOCKDATA:
3256 if (!ffesta_is_inhibited ())
3257 ffestc_R1112 (ffesta_tokens[1]);
3258 break;
3259
3260 #if FFESTR_F90
3261 case FFESTR_secondINTERFACE:
3262 if (!ffesta_is_inhibited ())
3263 ffestc_R1203 ();
3264 break;
3265 #endif
3266
3267 case FFESTR_secondFUNCTION:
3268 if (!ffesta_is_inhibited ())
3269 ffestc_R1221 (ffesta_tokens[1]);
3270 break;
3271
3272 case FFESTR_secondSUBROUTINE:
3273 if (!ffesta_is_inhibited ())
3274 ffestc_R1225 (ffesta_tokens[1]);
3275 break;
3276
3277 #if FFESTR_VXT
3278 case FFESTR_secondSTRUCTURE:
3279 if (!ffesta_is_inhibited ())
3280 ffestc_V004 ();
3281 break;
3282 #endif
3283
3284 #if FFESTR_VXT
3285 case FFESTR_secondUNION:
3286 if (!ffesta_is_inhibited ())
3287 ffestc_V010 ();
3288 break;
3289 #endif
3290
3291 #if FFESTR_VXT
3292 case FFESTR_secondMAP:
3293 if (!ffesta_is_inhibited ())
3294 ffestc_V013 ();
3295 break;
3296 #endif
3297
3298 default:
3299 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0]);
3300 if (ffesta_tokens[1] != NULL)
3301 ffelex_token_kill (ffesta_tokens[1]);
3302 return (ffelexHandler) ffelex_swallow_tokens (t,
3303 (ffelexHandler) ffesta_zero);
3304 }
3305
3306 if (ffesta_tokens[1] != NULL)
3307 ffelex_token_kill (ffesta_tokens[1]);
3308 return (ffelexHandler) ffesta_zero (t);
3309 }
3310
3311 /* ffestb_goto -- Parse the GOTO statement
3312
3313 return ffestb_goto; // to lexer
3314
3315 Make sure the statement has a valid form for the GOTO statement. If it
3316 does, implement the statement. */
3317
3318 ffelexHandler
3319 ffestb_goto (ffelexToken t)
3320 {
3321 ffeTokenLength i;
3322 unsigned const char *p;
3323 ffelexHandler next;
3324 ffelexToken nt;
3325
3326 switch (ffelex_token_type (ffesta_tokens[0]))
3327 {
3328 case FFELEX_typeNAME:
3329 switch (ffesta_first_kw)
3330 {
3331 case FFESTR_firstGO:
3332 if ((ffelex_token_type (t) != FFELEX_typeNAME)
3333 || (ffesta_second_kw != FFESTR_secondTO))
3334 goto bad_1; /* :::::::::::::::::::: */
3335 ffesta_confirmed ();
3336 return (ffelexHandler) ffestb_goto1_;
3337
3338 case FFESTR_firstGOTO:
3339 return (ffelexHandler) ffestb_goto1_ (t);
3340
3341 default:
3342 goto bad_0; /* :::::::::::::::::::: */
3343 }
3344
3345 case FFELEX_typeNAMES:
3346 if (ffesta_first_kw != FFESTR_firstGOTO)
3347 goto bad_0; /* :::::::::::::::::::: */
3348 switch (ffelex_token_type (t))
3349 {
3350 case FFELEX_typeCOLONCOLON:
3351 ffesta_confirmed (); /* Error, but clearly intended. */
3352 goto bad_1; /* :::::::::::::::::::: */
3353
3354 default:
3355 goto bad_1; /* :::::::::::::::::::: */
3356
3357 case FFELEX_typeOPEN_PAREN:
3358 case FFELEX_typePERCENT: /* Since GOTO I%J is apparently valid
3359 in '90. */
3360 case FFELEX_typeCOMMA:
3361 break;
3362
3363 case FFELEX_typeEOS:
3364 case FFELEX_typeSEMICOLON:
3365 ffesta_confirmed ();
3366 break;
3367 }
3368 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlGOTO)
3369 {
3370 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlGOTO);
3371 if (ISDIGIT (*p))
3372 {
3373 nt = ffelex_token_number_from_names (ffesta_tokens[0], i);
3374 p += ffelex_token_length (nt);
3375 i += ffelex_token_length (nt);
3376 if (*p != '\0')
3377 {
3378 ffelex_token_kill (nt);
3379 goto bad_i; /* :::::::::::::::::::: */
3380 }
3381 }
3382 else if (ffesrc_is_name_init (*p))
3383 {
3384 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
3385 }
3386 else
3387 goto bad_i; /* :::::::::::::::::::: */
3388 next = (ffelexHandler) ffestb_goto1_ (nt);
3389 ffelex_token_kill (nt);
3390 return (ffelexHandler) (*next) (t);
3391 }
3392 return (ffelexHandler) ffestb_goto1_ (t);
3393
3394 default:
3395 goto bad_0; /* :::::::::::::::::::: */
3396 }
3397
3398 bad_0: /* :::::::::::::::::::: */
3399 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "GO TO", ffesta_tokens[0]);
3400 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3401
3402 bad_1: /* :::::::::::::::::::: */
3403 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "GO TO", t);
3404 return (ffelexHandler) ffelex_swallow_tokens (t,
3405 (ffelexHandler) ffesta_zero); /* Invalid second token. */
3406
3407 bad_i: /* :::::::::::::::::::: */
3408 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "GO TO", ffesta_tokens[0], i, t);
3409 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3410 }
3411
3412 /* ffestb_goto1_ -- "GOTO" or "GO" "TO"
3413
3414 return ffestb_goto1_; // to lexer
3415
3416 Make sure the statement has a valid form for the GOTO statement. If it
3417 does, implement the statement. */
3418
3419 static ffelexHandler
3420 ffestb_goto1_ (ffelexToken t)
3421 {
3422 switch (ffelex_token_type (t))
3423 {
3424 case FFELEX_typeNUMBER:
3425 if (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME)
3426 ffesta_confirmed ();
3427 ffesta_tokens[1] = ffelex_token_use (t);
3428 return (ffelexHandler) ffestb_goto2_;
3429
3430 case FFELEX_typeOPEN_PAREN:
3431 ffesta_tokens[1] = ffelex_token_use (t);
3432 ffestb_subrargs_.label_list.labels = ffestt_tokenlist_create ();
3433 ffestb_subrargs_.label_list.handler = (ffelexHandler) ffestb_goto3_;
3434 return (ffelexHandler) ffestb_subr_label_list_;
3435
3436 case FFELEX_typeNAME:
3437 if (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME)
3438 ffesta_confirmed ();
3439 return (ffelexHandler) (*((ffelexHandler)
3440 ffeexpr_lhs (ffesta_output_pool,
3441 FFEEXPR_contextAGOTO,
3442 (ffeexprCallback) ffestb_goto4_)))
3443 (t);
3444
3445 case FFELEX_typeEOS:
3446 case FFELEX_typeSEMICOLON:
3447 case FFELEX_typeCOMMA:
3448 case FFELEX_typeCOLONCOLON:
3449 ffesta_confirmed (); /* Error, but clearly intended. */
3450 break;
3451
3452 default:
3453 break;
3454 }
3455
3456 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "GO TO", t);
3457 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3458 }
3459
3460 /* ffestb_goto2_ -- "GO/TO" NUMBER
3461
3462 return ffestb_goto2_; // to lexer
3463
3464 Make sure the statement has a valid form for the GOTO statement. If it
3465 does, implement the statement. */
3466
3467 static ffelexHandler
3468 ffestb_goto2_ (ffelexToken t)
3469 {
3470 switch (ffelex_token_type (t))
3471 {
3472 case FFELEX_typeEOS:
3473 case FFELEX_typeSEMICOLON:
3474 ffesta_confirmed ();
3475 if (!ffesta_is_inhibited ())
3476 ffestc_R836 (ffesta_tokens[1]);
3477 ffelex_token_kill (ffesta_tokens[1]);
3478 return (ffelexHandler) ffesta_zero (t);
3479
3480 default:
3481 break;
3482 }
3483
3484 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "GO TO", t);
3485 ffelex_token_kill (ffesta_tokens[1]);
3486 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3487 }
3488
3489 /* ffestb_goto3_ -- "GO/TO" OPEN_PAREN label-list CLOSE_PAREN
3490
3491 return ffestb_goto3_; // to lexer
3492
3493 Make sure the statement has a valid form for the GOTO statement. If it
3494 does, implement the statement. */
3495
3496 static ffelexHandler
3497 ffestb_goto3_ (ffelexToken t)
3498 {
3499 if (!ffestb_subrargs_.label_list.ok)
3500 goto bad; /* :::::::::::::::::::: */
3501
3502 switch (ffelex_token_type (t))
3503 {
3504 case FFELEX_typeCOMMA:
3505 ffesta_confirmed ();
3506 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextCGOTO,
3507 (ffeexprCallback) ffestb_goto5_);
3508
3509 case FFELEX_typeEQUALS:
3510 case FFELEX_typePOINTS:
3511 case FFELEX_typeEOS:
3512 case FFELEX_typeSEMICOLON:
3513 break;
3514
3515 default:
3516 ffesta_confirmed ();
3517 /* Fall through. */
3518 case FFELEX_typeOPEN_PAREN: /* Could still be assignment!! */
3519 return (ffelexHandler) (*((ffelexHandler)
3520 ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextCGOTO,
3521 (ffeexprCallback) ffestb_goto5_)))
3522 (t);
3523 }
3524
3525 bad: /* :::::::::::::::::::: */
3526 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "computed-GOTO", t);
3527 ffelex_token_kill (ffesta_tokens[1]);
3528 ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
3529 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3530 }
3531
3532 /* ffestb_goto4_ -- "GO/TO" expr
3533
3534 (ffestb_goto4_) // to expression handler
3535
3536 Make sure the statement has a valid form for the GOTO statement. If it
3537 does, implement the statement. */
3538
3539 static ffelexHandler
3540 ffestb_goto4_ (ffelexToken ft, ffebld expr, ffelexToken t)
3541 {
3542 switch (ffelex_token_type (t))
3543 {
3544 case FFELEX_typeCOMMA:
3545 ffesta_confirmed ();
3546 if (expr == NULL)
3547 break;
3548 ffesta_tokens[1] = ffelex_token_use (ft);
3549 ffestb_local_.go_to.expr = expr;
3550 return (ffelexHandler) ffestb_goto6_;
3551
3552 case FFELEX_typeOPEN_PAREN:
3553 if (expr == NULL)
3554 break;
3555 ffesta_tokens[1] = ffelex_token_use (ft);
3556 ffestb_local_.go_to.expr = expr;
3557 return (ffelexHandler) ffestb_goto6_ (t);
3558
3559 case FFELEX_typeEOS:
3560 case FFELEX_typeSEMICOLON:
3561 ffesta_confirmed ();
3562 if (expr == NULL)
3563 break;
3564 if (!ffesta_is_inhibited ())
3565 ffestc_R839 (expr, ft, NULL);
3566 return (ffelexHandler) ffesta_zero (t);
3567
3568 default:
3569 break;
3570 }
3571
3572 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assigned-GOTO", t);
3573 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3574 }
3575
3576 /* ffestb_goto5_ -- "GO/TO" OPEN_PAREN label-list CLOSE_PAREN (COMMA) expr
3577
3578 (ffestb_goto5_) // to expression handler
3579
3580 Make sure the statement has a valid form for the GOTO statement. If it
3581 does, implement the statement. */
3582
3583 static ffelexHandler
3584 ffestb_goto5_ (ffelexToken ft, ffebld expr, ffelexToken t)
3585 {
3586 switch (ffelex_token_type (t))
3587 {
3588 case FFELEX_typeEOS:
3589 case FFELEX_typeSEMICOLON:
3590 if (expr == NULL)
3591 break;
3592 ffesta_confirmed ();
3593 if (!ffesta_is_inhibited ())
3594 ffestc_R837 (ffestb_subrargs_.label_list.labels, expr, ft);
3595 ffelex_token_kill (ffesta_tokens[1]);
3596 ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
3597 return (ffelexHandler) ffesta_zero (t);
3598
3599 default:
3600 break;
3601 }
3602
3603 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "computed-GOTO", t);
3604 ffelex_token_kill (ffesta_tokens[1]);
3605 ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
3606 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3607 }
3608
3609 /* ffestb_goto6_ -- "GO/TO" expr (COMMA)
3610
3611 return ffestb_goto6_; // to lexer
3612
3613 Make sure the statement has a valid form for the GOTO statement. If it
3614 does, implement the statement. */
3615
3616 static ffelexHandler
3617 ffestb_goto6_ (ffelexToken t)
3618 {
3619 switch (ffelex_token_type (t))
3620 {
3621 case FFELEX_typeOPEN_PAREN:
3622 ffesta_tokens[2] = ffelex_token_use (t);
3623 ffestb_subrargs_.label_list.labels = ffestt_tokenlist_create ();
3624 ffestb_subrargs_.label_list.handler = (ffelexHandler) ffestb_goto7_;
3625 return (ffelexHandler) ffestb_subr_label_list_;
3626
3627 default:
3628 break;
3629 }
3630
3631 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assigned-GOTO", t);
3632 ffelex_token_kill (ffesta_tokens[1]);
3633 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3634 }
3635
3636 /* ffestb_goto7_ -- "GO/TO" expr (COMMA) OPEN_PAREN label-list CLOSE_PAREN
3637
3638 return ffestb_goto7_; // to lexer
3639
3640 Make sure the statement has a valid form for the GOTO statement. If it
3641 does, implement the statement. */
3642
3643 static ffelexHandler
3644 ffestb_goto7_ (ffelexToken t)
3645 {
3646 if (!ffestb_subrargs_.label_list.ok)
3647 goto bad; /* :::::::::::::::::::: */
3648
3649 switch (ffelex_token_type (t))
3650 {
3651 case FFELEX_typeEOS:
3652 case FFELEX_typeSEMICOLON:
3653 ffesta_confirmed ();
3654 if (!ffesta_is_inhibited ())
3655 ffestc_R839 (ffestb_local_.go_to.expr, ffesta_tokens[1],
3656 ffestb_subrargs_.label_list.labels);
3657 ffelex_token_kill (ffesta_tokens[1]);
3658 ffelex_token_kill (ffesta_tokens[2]);
3659 ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
3660 return (ffelexHandler) ffesta_zero (t);
3661
3662 default:
3663 break;
3664 }
3665
3666 bad: /* :::::::::::::::::::: */
3667 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assigned-GOTO", t);
3668 ffelex_token_kill (ffesta_tokens[1]);
3669 ffelex_token_kill (ffesta_tokens[2]);
3670 ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
3671 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3672 }
3673
3674 /* ffestb_halt -- Parse the STOP/PAUSE statement
3675
3676 return ffestb_halt; // to lexer
3677
3678 Make sure the statement has a valid form for the STOP/PAUSE statement. If
3679 it does, implement the statement. */
3680
3681 ffelexHandler
3682 ffestb_halt (ffelexToken t)
3683 {
3684 ffelexHandler next;
3685
3686 switch (ffelex_token_type (ffesta_tokens[0]))
3687 {
3688 case FFELEX_typeNAME:
3689 switch (ffelex_token_type (t))
3690 {
3691 case FFELEX_typeCOMMA:
3692 case FFELEX_typeCOLONCOLON:
3693 ffesta_confirmed (); /* Error, but clearly intended. */
3694 goto bad_1; /* :::::::::::::::::::: */
3695
3696 default:
3697 goto bad_1; /* :::::::::::::::::::: */
3698
3699 case FFELEX_typeEOS:
3700 case FFELEX_typeSEMICOLON:
3701 case FFELEX_typeNAME:
3702 case FFELEX_typeNUMBER:
3703 case FFELEX_typeAPOSTROPHE:
3704 case FFELEX_typeQUOTE:
3705 ffesta_confirmed ();
3706 break;
3707 }
3708
3709 return (ffelexHandler) (*((ffelexHandler)
3710 ffeexpr_rhs (ffesta_output_pool,
3711 FFEEXPR_contextSTOP,
3712 (ffeexprCallback) ffestb_halt1_)))
3713 (t);
3714
3715 case FFELEX_typeNAMES:
3716 switch (ffelex_token_type (t))
3717 {
3718 default:
3719 goto bad_1; /* :::::::::::::::::::: */
3720
3721 case FFELEX_typeEOS:
3722 case FFELEX_typeSEMICOLON:
3723 case FFELEX_typeNAME:
3724 case FFELEX_typeNUMBER:
3725 case FFELEX_typeAPOSTROPHE:
3726 case FFELEX_typeQUOTE:
3727 ffesta_confirmed ();
3728 break;
3729 }
3730 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
3731 FFEEXPR_contextSTOP,
3732 (ffeexprCallback) ffestb_halt1_);
3733 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
3734 ffestb_args.halt.len);
3735 if (next == NULL)
3736 return (ffelexHandler) ffelex_swallow_tokens (t,
3737 (ffelexHandler) ffesta_zero);
3738 return (ffelexHandler) (*next) (t);
3739
3740 default:
3741 goto bad_0; /* :::::::::::::::::::: */
3742 }
3743
3744 bad_0: /* :::::::::::::::::::: */
3745 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
3746 (ffesta_first_kw == FFESTR_firstSTOP)
3747 ? "STOP" : "PAUSE",
3748 ffesta_tokens[0]);
3749 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3750
3751 bad_1: /* :::::::::::::::::::: */
3752 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
3753 (ffesta_first_kw == FFESTR_firstSTOP)
3754 ? "STOP" : "PAUSE",
3755 t);
3756 return (ffelexHandler) ffelex_swallow_tokens (t,
3757 (ffelexHandler) ffesta_zero); /* Invalid second token. */
3758 }
3759
3760 /* ffestb_halt1_ -- "STOP/PAUSE" expr
3761
3762 (ffestb_halt1_) // to expression handler
3763
3764 Make sure the next token is an EOS or SEMICOLON. */
3765
3766 static ffelexHandler
3767 ffestb_halt1_ (ffelexToken ft, ffebld expr, ffelexToken t)
3768 {
3769 switch (ffelex_token_type (t))
3770 {
3771 case FFELEX_typeEOS:
3772 case FFELEX_typeSEMICOLON:
3773 ffesta_confirmed ();
3774 if (!ffesta_is_inhibited ())
3775 {
3776 if (ffesta_first_kw == FFESTR_firstSTOP)
3777 ffestc_R842 (expr, ft);
3778 else
3779 ffestc_R843 (expr, ft);
3780 }
3781 return (ffelexHandler) ffesta_zero (t);
3782
3783 default:
3784 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
3785 (ffesta_first_kw == FFESTR_firstSTOP)
3786 ? "STOP" : "PAUSE",
3787 t);
3788 break;
3789 }
3790
3791 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3792 }
3793
3794 /* ffestb_if -- Parse an IF statement
3795
3796 return ffestb_if; // to lexer
3797
3798 Make sure the statement has a valid form for an IF statement.
3799 If it does, implement the statement. */
3800
3801 ffelexHandler
3802 ffestb_if (ffelexToken t)
3803 {
3804 switch (ffelex_token_type (ffesta_tokens[0]))
3805 {
3806 case FFELEX_typeNAME:
3807 if (ffesta_first_kw != FFESTR_firstIF)
3808 goto bad_0; /* :::::::::::::::::::: */
3809 break;
3810
3811 case FFELEX_typeNAMES:
3812 if (ffesta_first_kw != FFESTR_firstIF)
3813 goto bad_0; /* :::::::::::::::::::: */
3814 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlIF)
3815 goto bad_0; /* :::::::::::::::::::: */
3816 break;
3817
3818 default:
3819 goto bad_0; /* :::::::::::::::::::: */
3820 }
3821
3822 switch (ffelex_token_type (t))
3823 {
3824 case FFELEX_typeOPEN_PAREN:
3825 break;
3826
3827 case FFELEX_typeEOS:
3828 case FFELEX_typeSEMICOLON:
3829 case FFELEX_typeCOMMA:
3830 case FFELEX_typeCOLONCOLON:
3831 ffesta_confirmed (); /* Error, but clearly intended. */
3832 goto bad_1; /* :::::::::::::::::::: */
3833
3834 default:
3835 goto bad_1; /* :::::::::::::::::::: */
3836 }
3837
3838 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextIF,
3839 (ffeexprCallback) ffestb_if1_);
3840
3841 bad_0: /* :::::::::::::::::::: */
3842 if (ffesta_construct_name != NULL)
3843 {
3844 ffelex_token_kill (ffesta_construct_name);
3845 ffesta_construct_name = NULL;
3846 }
3847 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IF", ffesta_tokens[0]);
3848 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3849
3850 bad_1: /* :::::::::::::::::::: */
3851 if (ffesta_construct_name != NULL)
3852 {
3853 ffelex_token_kill (ffesta_construct_name);
3854 ffesta_construct_name = NULL;
3855 }
3856 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IF", t);
3857 return (ffelexHandler) ffelex_swallow_tokens (t,
3858 (ffelexHandler) ffesta_zero); /* Invalid second token. */
3859 }
3860
3861 /* ffestb_if1_ -- "IF" OPEN_PAREN expr
3862
3863 (ffestb_if1_) // to expression handler
3864
3865 Make sure the next token is CLOSE_PAREN. */
3866
3867 static ffelexHandler
3868 ffestb_if1_ (ffelexToken ft, ffebld expr, ffelexToken t)
3869 {
3870 ffestb_local_.if_stmt.expr = expr;
3871
3872 switch (ffelex_token_type (t))
3873 {
3874 case FFELEX_typeCLOSE_PAREN:
3875 if (expr == NULL)
3876 break;
3877 ffesta_tokens[1] = ffelex_token_use (ft);
3878 ffelex_set_names (TRUE);
3879 return (ffelexHandler) ffestb_if2_;
3880
3881 default:
3882 break;
3883 }
3884
3885 if (ffesta_construct_name != NULL)
3886 {
3887 ffelex_token_kill (ffesta_construct_name);
3888 ffesta_construct_name = NULL;
3889 }
3890 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IF", t);
3891 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3892 }
3893
3894 /* ffestb_if2_ -- "IF" OPEN_PAREN expr CLOSE_PAREN
3895
3896 return ffestb_if2_; // to lexer
3897
3898 Make sure the next token is NAME. */
3899
3900 static ffelexHandler
3901 ffestb_if2_ (ffelexToken t)
3902 {
3903 ffelex_set_names (FALSE);
3904
3905 switch (ffelex_token_type (t))
3906 {
3907 case FFELEX_typeNAME:
3908 case FFELEX_typeNAMES:
3909 ffesta_confirmed ();
3910 ffesta_tokens[2] = ffelex_token_use (t);
3911 return (ffelexHandler) ffestb_if3_;
3912
3913 default:
3914 break;
3915 }
3916
3917 ffelex_token_kill (ffesta_tokens[1]);
3918 if ((ffesta_construct_name == NULL)
3919 || (ffelex_token_type (t) != FFELEX_typeNUMBER))
3920 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IF", t);
3921 else
3922 ffesta_ffebad_2st (FFEBAD_INVALID_STMT_FORM, "CONSTRUCT",
3923 ffesta_construct_name, t);
3924 if (ffesta_construct_name != NULL)
3925 {
3926 ffelex_token_kill (ffesta_construct_name);
3927 ffesta_construct_name = NULL;
3928 }
3929 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3930 }
3931
3932 /* ffestb_if3_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NAME
3933
3934 return ffestb_if3_; // to lexer
3935
3936 If the next token is EOS or SEMICOLON and the preceding NAME was "THEN",
3937 implement R803. Else, implement R807 and send the preceding NAME followed
3938 by the current token. */
3939
3940 static ffelexHandler
3941 ffestb_if3_ (ffelexToken t)
3942 {
3943 ffelexHandler next;
3944
3945 switch (ffelex_token_type (t))
3946 {
3947 case FFELEX_typeEOS:
3948 case FFELEX_typeSEMICOLON:
3949 if (ffestr_first (ffesta_tokens[2]) == FFESTR_firstTHEN)
3950 {
3951 if (!ffesta_is_inhibited ())
3952 ffestc_R803 (ffesta_construct_name, ffestb_local_.if_stmt.expr,
3953 ffesta_tokens[1]);
3954 ffelex_token_kill (ffesta_tokens[1]);
3955 ffelex_token_kill (ffesta_tokens[2]);
3956 if (ffesta_construct_name != NULL)
3957 {
3958 ffelex_token_kill (ffesta_construct_name);
3959 ffesta_construct_name = NULL;
3960 }
3961 return (ffelexHandler) ffesta_zero (t);
3962 }
3963 break;
3964
3965 default:
3966 break;
3967 }
3968
3969 if (ffesta_construct_name != NULL)
3970 {
3971 if (!ffesta_is_inhibited ())
3972 ffesta_ffebad_2st (FFEBAD_INVALID_STMT_FORM, "CONSTRUCT",
3973 ffesta_construct_name, ffesta_tokens[2]);
3974 ffelex_token_kill (ffesta_construct_name);
3975 ffesta_construct_name = NULL;
3976 ffelex_token_kill (ffesta_tokens[1]);
3977 ffelex_token_kill (ffesta_tokens[2]);
3978 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3979 }
3980
3981 if (!ffesta_is_inhibited ())
3982 ffestc_R807 (ffestb_local_.if_stmt.expr, ffesta_tokens[1]);
3983 ffelex_token_kill (ffesta_tokens[1]);
3984 {
3985 ffelexToken my_2 = ffesta_tokens[2];
3986
3987 next = (ffelexHandler) ffesta_two (my_2, t);
3988 ffelex_token_kill (my_2);
3989 }
3990 return (ffelexHandler) next;
3991 }
3992
3993 /* ffestb_where -- Parse a WHERE statement
3994
3995 return ffestb_where; // to lexer
3996
3997 Make sure the statement has a valid form for a WHERE statement.
3998 If it does, implement the statement. */
3999
4000 #if FFESTR_F90
4001 ffelexHandler
4002 ffestb_where (ffelexToken t)
4003 {
4004 switch (ffelex_token_type (ffesta_tokens[0]))
4005 {
4006 case FFELEX_typeNAME:
4007 if (ffesta_first_kw != FFESTR_firstWHERE)
4008 goto bad_0; /* :::::::::::::::::::: */
4009 break;
4010
4011 case FFELEX_typeNAMES:
4012 if (ffesta_first_kw != FFESTR_firstWHERE)
4013 goto bad_0; /* :::::::::::::::::::: */
4014 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlWHERE)
4015 goto bad_0; /* :::::::::::::::::::: */
4016 break;
4017
4018 default:
4019 goto bad_0; /* :::::::::::::::::::: */
4020 }
4021
4022 switch (ffelex_token_type (t))
4023 {
4024 case FFELEX_typeOPEN_PAREN:
4025 break;
4026
4027 case FFELEX_typeEOS:
4028 case FFELEX_typeSEMICOLON:
4029 case FFELEX_typeCOMMA:
4030 case FFELEX_typeCOLONCOLON:
4031 ffesta_confirmed (); /* Error, but clearly intended. */
4032 goto bad_1; /* :::::::::::::::::::: */
4033
4034 default:
4035 goto bad_1; /* :::::::::::::::::::: */
4036 }
4037
4038 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextWHERE,
4039 (ffeexprCallback) ffestb_where1_);
4040
4041 bad_0: /* :::::::::::::::::::: */
4042 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", ffesta_tokens[0]);
4043 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4044
4045 bad_1: /* :::::::::::::::::::: */
4046 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", t);
4047 return (ffelexHandler) ffelex_swallow_tokens (t,
4048 (ffelexHandler) ffesta_zero); /* Invalid second token. */
4049 }
4050
4051 #endif
4052 /* ffestb_where1_ -- "WHERE" OPEN_PAREN expr
4053
4054 (ffestb_where1_) // to expression handler
4055
4056 Make sure the next token is CLOSE_PAREN. */
4057
4058 #if FFESTR_F90
4059 static ffelexHandler
4060 ffestb_where1_ (ffelexToken ft, ffebld expr, ffelexToken t)
4061 {
4062 ffestb_local_.if_stmt.expr = expr;
4063
4064 switch (ffelex_token_type (t))
4065 {
4066 case FFELEX_typeCLOSE_PAREN:
4067 if (expr == NULL)
4068 break;
4069 ffesta_tokens[1] = ffelex_token_use (ft);
4070 ffelex_set_names (TRUE);
4071 return (ffelexHandler) ffestb_where2_;
4072
4073 default:
4074 break;
4075 }
4076
4077 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", t);
4078 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4079 }
4080
4081 #endif
4082 /* ffestb_where2_ -- "WHERE" OPEN_PAREN expr CLOSE_PAREN
4083
4084 return ffestb_where2_; // to lexer
4085
4086 Make sure the next token is NAME. */
4087
4088 #if FFESTR_F90
4089 static ffelexHandler
4090 ffestb_where2_ (ffelexToken t)
4091 {
4092 ffelex_set_names (FALSE);
4093
4094 switch (ffelex_token_type (t))
4095 {
4096 case FFELEX_typeNAME:
4097 case FFELEX_typeNAMES:
4098 ffesta_confirmed ();
4099 ffesta_tokens[2] = ffelex_token_use (t);
4100 return (ffelexHandler) ffestb_where3_;
4101
4102 case FFELEX_typeEOS:
4103 case FFELEX_typeSEMICOLON:
4104 ffesta_confirmed ();
4105 if (!ffesta_is_inhibited ())
4106 ffestc_R742 (ffestb_local_.if_stmt.expr, ffesta_tokens[1]);
4107 ffelex_token_kill (ffesta_tokens[1]);
4108 return (ffelexHandler) ffesta_zero (t);
4109
4110 default:
4111 break;
4112 }
4113
4114 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", t);
4115 ffelex_token_kill (ffesta_tokens[1]);
4116 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4117 }
4118
4119 #endif
4120 /* ffestb_where3_ -- "WHERE" OPEN_PAREN expr CLOSE_PAREN NAME
4121
4122 return ffestb_where3_; // to lexer
4123
4124 Implement R742. */
4125
4126 #if FFESTR_F90
4127 static ffelexHandler
4128 ffestb_where3_ (ffelexToken t)
4129 {
4130 ffelexHandler next;
4131 ffelexToken my_2 = ffesta_tokens[2];
4132
4133 if (!ffesta_is_inhibited ())
4134 ffestc_R740 (ffestb_local_.if_stmt.expr, ffesta_tokens[1]);
4135 ffelex_token_kill (ffesta_tokens[1]);
4136 next = (ffelexHandler) ffesta_two (my_2, t);
4137 ffelex_token_kill (my_2);
4138 return (ffelexHandler) next;
4139 }
4140
4141 #endif
4142 /* ffestb_let -- Parse an assignment statement
4143
4144 return ffestb_let; // to lexer
4145
4146 Make sure the statement has a valid form for an assignment statement. If
4147 it does, implement the statement. */
4148
4149 ffelexHandler
4150 ffestb_let (ffelexToken t)
4151 {
4152 ffelexHandler next;
4153 bool vxtparam; /* TRUE if it might really be a VXT PARAMETER
4154 stmt. */
4155 unsigned const char *p;
4156
4157 switch (ffelex_token_type (ffesta_tokens[0]))
4158 {
4159 case FFELEX_typeNAME:
4160 vxtparam = FALSE;
4161 break;
4162
4163 case FFELEX_typeNAMES:
4164 vxtparam = TRUE;
4165 break;
4166
4167 default:
4168 goto bad_0; /* :::::::::::::::::::: */
4169 }
4170
4171 switch (ffelex_token_type (t))
4172 {
4173 case FFELEX_typeOPEN_PAREN:
4174 case FFELEX_typePERCENT:
4175 case FFELEX_typePOINTS:
4176 ffestb_local_.let.vxtparam = FALSE;
4177 break;
4178
4179 case FFELEX_typeEQUALS:
4180 if (!vxtparam || (ffesta_first_kw != FFESTR_firstPARAMETER))
4181 {
4182 ffestb_local_.let.vxtparam = FALSE;
4183 break;
4184 }
4185 p = ffelex_token_text (ffesta_tokens[0]) + FFESTR_firstlPARAMETER;
4186 ffestb_local_.let.vxtparam = ffesrc_is_name_init (*p);
4187 break;
4188
4189 default:
4190 goto bad_1; /* :::::::::::::::::::: */
4191 }
4192
4193 next = (ffelexHandler) (*((ffelexHandler)
4194 ffeexpr_lhs (ffesta_output_pool,
4195 FFEEXPR_contextLET,
4196 (ffeexprCallback) ffestb_let1_)))
4197 (ffesta_tokens[0]);
4198 return (ffelexHandler) (*next) (t);
4199
4200 bad_0: /* :::::::::::::::::::: */
4201 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assignment", ffesta_tokens[0]);
4202 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4203
4204 bad_1: /* :::::::::::::::::::: */
4205 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assignment", t);
4206 return (ffelexHandler) ffelex_swallow_tokens (t,
4207 (ffelexHandler) ffesta_zero); /* Invalid second token. */
4208 }
4209
4210 /* ffestb_let1_ -- expr
4211
4212 (ffestb_let1_) // to expression handler
4213
4214 Make sure the next token is EQUALS or POINTS. */
4215
4216 static ffelexHandler
4217 ffestb_let1_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
4218 {
4219 ffestb_local_.let.dest = expr;
4220
4221 switch (ffelex_token_type (t))
4222 {
4223 #if FFESTR_F90
4224 case FFELEX_typePOINTS:
4225 #endif
4226 case FFELEX_typeEQUALS:
4227 if (expr == NULL)
4228 break;
4229 ffesta_tokens[1] = ffelex_token_use (t);
4230 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
4231 FFEEXPR_contextLET, (ffeexprCallback) ffestb_let2_);
4232
4233 default:
4234 break;
4235 }
4236
4237 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assignment", t);
4238 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4239 }
4240
4241 /* ffestb_let2_ -- expr EQUALS/POINTS expr
4242
4243 (ffestb_end2_) // to expression handler
4244
4245 Make sure the next token is EOS or SEMICOLON; implement the statement. */
4246
4247 static ffelexHandler
4248 ffestb_let2_ (ffelexToken ft, ffebld expr, ffelexToken t)
4249 {
4250 switch (ffelex_token_type (t))
4251 {
4252 case FFELEX_typeEOS:
4253 case FFELEX_typeSEMICOLON:
4254 if (expr == NULL)
4255 break;
4256 if (ffestb_local_.let.vxtparam && !ffestc_is_let_not_V027 ())
4257 break;
4258 ffesta_confirmed ();
4259 if (!ffesta_is_inhibited ())
4260 #if FFESTR_F90
4261 if (ffelex_token_type (ffesta_tokens[1]) == FFELEX_typeEQUALS)
4262 #endif
4263 ffestc_let (ffestb_local_.let.dest, expr, ft);
4264 #if FFESTR_F90
4265 else
4266 ffestc_R738 (ffestb_local_.let.dest, expr, ft);
4267 #endif
4268 ffelex_token_kill (ffesta_tokens[1]);
4269 return (ffelexHandler) ffesta_zero (t);
4270
4271 default:
4272 break;
4273 }
4274
4275 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
4276 (ffelex_token_type (ffesta_tokens[1]) == FFELEX_typeEQUALS)
4277 ? "assignment" : "pointer-assignment",
4278 t);
4279 ffelex_token_kill (ffesta_tokens[1]);
4280 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4281 }
4282
4283 /* ffestb_type -- Parse the TYPE statement
4284
4285 return ffestb_type; // to lexer
4286
4287 Make sure the statement has a valid form for the TYPE statement. If
4288 it does, implement the statement. */
4289
4290 #if FFESTR_F90
4291 ffelexHandler
4292 ffestb_type (ffelexToken t)
4293 {
4294 ffeTokenLength i;
4295 const char *p;
4296
4297 switch (ffelex_token_type (ffesta_tokens[0]))
4298 {
4299 case FFELEX_typeNAME:
4300 if (ffesta_first_kw != FFESTR_firstTYPE)
4301 goto bad_0; /* :::::::::::::::::::: */
4302 switch (ffelex_token_type (t))
4303 {
4304 case FFELEX_typeEOS:
4305 case FFELEX_typeSEMICOLON:
4306 case FFELEX_typeCOLONCOLON:
4307 ffesta_confirmed (); /* Error, but clearly intended. */
4308 goto bad_1; /* :::::::::::::::::::: */
4309
4310 default:
4311 goto bad_1; /* :::::::::::::::::::: */
4312
4313 case FFELEX_typeCOMMA:
4314 ffesta_confirmed ();
4315 return (ffelexHandler) ffestb_type1_;
4316
4317 case FFELEX_typeNAME: /* No confirm here, because ambig w/V020 VXT
4318 TYPE. */
4319 ffesta_tokens[1] = NULL;
4320 ffesta_tokens[2] = ffelex_token_use (t);
4321 return (ffelexHandler) ffestb_type4_;
4322 }
4323
4324 case FFELEX_typeNAMES:
4325 if (ffesta_first_kw != FFESTR_firstTYPE)
4326 goto bad_0; /* :::::::::::::::::::: */
4327 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlTYPE);
4328 switch (ffelex_token_type (t))
4329 {
4330 default:
4331 goto bad_1; /* :::::::::::::::::::: */
4332
4333 case FFELEX_typeCOMMA:
4334 if (*p != '\0')
4335 goto bad_i; /* :::::::::::::::::::: */
4336 ffesta_confirmed ();
4337 ffelex_set_names (TRUE);
4338 return (ffelexHandler) ffestb_type1_;
4339
4340 case FFELEX_typeEOS:
4341 case FFELEX_typeSEMICOLON:
4342 break;
4343 }
4344 if (!ffesrc_is_name_init (*p))
4345 goto bad_i; /* :::::::::::::::::::: */
4346 ffesta_tokens[1] = NULL;
4347 ffesta_tokens[2]
4348 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
4349 return (ffelexHandler) ffestb_type4_ (t);
4350
4351 default:
4352 goto bad_0; /* :::::::::::::::::::: */
4353 }
4354
4355 bad_0: /* :::::::::::::::::::: */
4356 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", ffesta_tokens[0]);
4357 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4358
4359 bad_1: /* :::::::::::::::::::: */
4360 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
4361 return (ffelexHandler) ffelex_swallow_tokens (t,
4362 (ffelexHandler) ffesta_zero); /* Invalid second token. */
4363
4364 bad_i: /* :::::::::::::::::::: */
4365 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "TYPE", ffesta_tokens[0], i, t);
4366 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4367 }
4368
4369 /* ffestb_type1_ -- "TYPE" COMMA
4370
4371 return ffestb_type1_; // to lexer
4372
4373 Make sure the next token is a NAME. */
4374
4375 static ffelexHandler
4376 ffestb_type1_ (ffelexToken t)
4377 {
4378 ffeTokenLength i;
4379 const char *p;
4380
4381 ffelex_set_names (FALSE);
4382
4383 switch (ffelex_token_type (t))
4384 {
4385 case FFELEX_typeNAME:
4386 ffesta_tokens[1] = ffelex_token_use (t);
4387 ffestb_local_.type.kw = ffestr_other (t);
4388 switch (ffestb_local_.varlist.kw)
4389 {
4390 case FFESTR_otherPUBLIC:
4391 case FFESTR_otherPRIVATE:
4392 return (ffelexHandler) ffestb_type2_;
4393
4394 default:
4395 ffelex_token_kill (ffesta_tokens[1]);
4396 break;
4397 }
4398 break;
4399
4400 case FFELEX_typeNAMES:
4401 ffesta_tokens[1] = ffelex_token_use (t);
4402 ffestb_local_.type.kw = ffestr_other (t);
4403 switch (ffestb_local_.varlist.kw)
4404 {
4405 case FFESTR_otherPUBLIC:
4406 p = ffelex_token_text (t) + (i = FFESTR_otherlPUBLIC);
4407 if (*p == '\0')
4408 return (ffelexHandler) ffestb_type2_;
4409 if (!ffesrc_is_name_init (*p))
4410 goto bad_i1; /* :::::::::::::::::::: */
4411 ffesta_tokens[2] = ffelex_token_name_from_names (t, i, 0);
4412 return (ffelexHandler) ffestb_type4_;
4413
4414 case FFESTR_otherPRIVATE:
4415 p = ffelex_token_text (t) + (i = FFESTR_otherlPRIVATE);
4416 if (*p == '\0')
4417 return (ffelexHandler) ffestb_type2_;
4418 if (!ffesrc_is_name_init (*p))
4419 goto bad_i1; /* :::::::::::::::::::: */
4420 ffesta_tokens[2] = ffelex_token_name_from_names (t, i, 0);
4421 return (ffelexHandler) ffestb_type4_;
4422
4423 default:
4424 ffelex_token_kill (ffesta_tokens[1]);
4425 break;
4426 }
4427 break;
4428
4429 default:
4430 break;
4431 }
4432
4433 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
4434 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4435
4436 bad_i1: /* :::::::::::::::::::: */
4437 ffelex_token_kill (ffesta_tokens[1]);
4438 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "TYPE", t, i, NULL);
4439 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4440 }
4441
4442 /* ffestb_type2_ -- "TYPE" COMMA NAME
4443
4444 return ffestb_type2_; // to lexer
4445
4446 Handle COLONCOLON or NAME. */
4447
4448 static ffelexHandler
4449 ffestb_type2_ (ffelexToken t)
4450 {
4451 switch (ffelex_token_type (t))
4452 {
4453 case FFELEX_typeCOLONCOLON:
4454 return (ffelexHandler) ffestb_type3_;
4455
4456 case FFELEX_typeNAME:
4457 return (ffelexHandler) ffestb_type3_ (t);
4458
4459 default:
4460 break;
4461 }
4462
4463 if (ffesta_tokens[1] != NULL)
4464 ffelex_token_kill (ffesta_tokens[1]);
4465 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
4466 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4467 }
4468
4469 /* ffestb_type3_ -- "TYPE" [COMMA NAME [COLONCOLON]]
4470
4471 return ffestb_type3_; // to lexer
4472
4473 Make sure the next token is a NAME. */
4474
4475 static ffelexHandler
4476 ffestb_type3_ (ffelexToken t)
4477 {
4478 switch (ffelex_token_type (t))
4479 {
4480 case FFELEX_typeNAME:
4481 ffesta_tokens[2] = ffelex_token_use (t);
4482 return (ffelexHandler) ffestb_type4_;
4483
4484 default:
4485 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
4486 break;
4487 }
4488
4489 if (ffesta_tokens[1] != NULL)
4490 ffelex_token_kill (ffesta_tokens[1]);
4491 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4492 }
4493
4494 /* ffestb_type4_ -- "TYPE" [COMMA NAME [COLONCOLON]] NAME
4495
4496 return ffestb_type4_; // to lexer
4497
4498 Make sure the next token is an EOS or SEMICOLON. */
4499
4500 static ffelexHandler
4501 ffestb_type4_ (ffelexToken t)
4502 {
4503 switch (ffelex_token_type (t))
4504 {
4505 case FFELEX_typeEOS:
4506 case FFELEX_typeSEMICOLON:
4507 ffesta_confirmed ();
4508 if (!ffesta_is_inhibited ())
4509 ffestc_R424 (ffesta_tokens[1], ffestb_local_.type.kw,
4510 ffesta_tokens[2]);
4511 if (ffesta_tokens[1] != NULL)
4512 ffelex_token_kill (ffesta_tokens[1]);
4513 ffelex_token_kill (ffesta_tokens[2]);
4514 return (ffelexHandler) ffesta_zero (t);
4515
4516 default:
4517 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
4518 break;
4519 }
4520
4521 if (ffesta_tokens[1] != NULL)
4522 ffelex_token_kill (ffesta_tokens[1]);
4523 ffelex_token_kill (ffesta_tokens[2]);
4524 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4525 }
4526
4527 #endif
4528 /* ffestb_varlist -- Parse EXTERNAL/INTENT/INTRINSIC/OPTIONAL/PUBLIC/PRIVATE
4529 statement
4530
4531 return ffestb_varlist; // to lexer
4532
4533 Make sure the statement has a valid form. If it
4534 does, implement the statement. */
4535
4536 ffelexHandler
4537 ffestb_varlist (ffelexToken t)
4538 {
4539 ffeTokenLength i;
4540 unsigned const char *p;
4541 ffelexToken nt;
4542 ffelexHandler next;
4543
4544 switch (ffelex_token_type (ffesta_tokens[0]))
4545 {
4546 case FFELEX_typeNAME:
4547 switch (ffelex_token_type (t))
4548 {
4549 case FFELEX_typeEOS:
4550 case FFELEX_typeSEMICOLON:
4551 ffesta_confirmed ();
4552 switch (ffesta_first_kw)
4553 {
4554 #if FFESTR_F90
4555 case FFESTR_firstPUBLIC:
4556 if (!ffesta_is_inhibited ())
4557 ffestc_R521A ();
4558 return (ffelexHandler) ffesta_zero (t);
4559
4560 case FFESTR_firstPRIVATE:
4561 if (!ffesta_is_inhibited ())
4562 ffestc_private (); /* Either R523A or R521B. */
4563 return (ffelexHandler) ffesta_zero (t);
4564 #endif
4565
4566 default:
4567 goto bad_1; /* :::::::::::::::::::: */
4568 }
4569
4570 case FFELEX_typeCOMMA:
4571 ffesta_confirmed (); /* Error, but clearly intended. */
4572 goto bad_1; /* :::::::::::::::::::: */
4573
4574 case FFELEX_typeCOLONCOLON:
4575 ffesta_confirmed ();
4576 switch (ffesta_first_kw)
4577 {
4578 #if FFESTR_F90
4579 case FFESTR_firstOPTIONAL:
4580 if (!ffesta_is_inhibited ())
4581 ffestc_R520_start ();
4582 break;
4583
4584 case FFESTR_firstPUBLIC:
4585 if (!ffesta_is_inhibited ())
4586 ffestc_R521Astart ();
4587 break;
4588
4589 case FFESTR_firstPRIVATE:
4590 if (!ffesta_is_inhibited ())
4591 ffestc_R521Bstart ();
4592 break;
4593 #endif
4594
4595 default:
4596 ffesta_confirmed (); /* Error, but clearly intended. */
4597 goto bad_1; /* :::::::::::::::::::: */
4598 }
4599 return (ffelexHandler) ffestb_varlist5_;
4600
4601 default:
4602 goto bad_1; /* :::::::::::::::::::: */
4603
4604 case FFELEX_typeOPEN_PAREN:
4605 switch (ffesta_first_kw)
4606 {
4607 #if FFESTR_F90
4608 case FFESTR_firstINTENT:
4609 return (ffelexHandler) ffestb_varlist1_;
4610 #endif
4611
4612 default:
4613 goto bad_1; /* :::::::::::::::::::: */
4614 }
4615
4616 case FFELEX_typeNAME:
4617 ffesta_confirmed ();
4618 switch (ffesta_first_kw)
4619 {
4620 case FFESTR_firstEXTERNAL:
4621 if (!ffesta_is_inhibited ())
4622 ffestc_R1207_start ();
4623 break;
4624
4625 #if FFESTR_F90
4626 case FFESTR_firstINTENT:
4627 goto bad_1; /* :::::::::::::::::::: */
4628 #endif
4629
4630 case FFESTR_firstINTRINSIC:
4631 if (!ffesta_is_inhibited ())
4632 ffestc_R1208_start ();
4633 break;
4634
4635 #if FFESTR_F90
4636 case FFESTR_firstOPTIONAL:
4637 if (!ffesta_is_inhibited ())
4638 ffestc_R520_start ();
4639 break;
4640 #endif
4641
4642 #if FFESTR_F90
4643 case FFESTR_firstPUBLIC:
4644 if (!ffesta_is_inhibited ())
4645 ffestc_R521Astart ();
4646 break;
4647
4648 case FFESTR_firstPRIVATE:
4649 if (!ffesta_is_inhibited ())
4650 ffestc_R521Bstart ();
4651 break;
4652 #endif
4653
4654 default:
4655 break;
4656 }
4657 return (ffelexHandler) ffestb_varlist5_ (t);
4658 }
4659
4660 case FFELEX_typeNAMES:
4661 p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.varlist.len);
4662 switch (ffelex_token_type (t))
4663 {
4664 case FFELEX_typeEOS:
4665 case FFELEX_typeSEMICOLON:
4666 ffesta_confirmed ();
4667 switch (ffesta_first_kw)
4668 {
4669 #if FFESTR_F90
4670 case FFESTR_firstINTENT:
4671 goto bad_1; /* :::::::::::::::::::: */
4672 #endif
4673
4674 default:
4675 break;
4676 }
4677 if (*p != '\0')
4678 break;
4679 switch (ffesta_first_kw)
4680 {
4681 #if FFESTR_F90
4682 case FFESTR_firstPUBLIC:
4683 if (!ffesta_is_inhibited ())
4684 ffestc_R521A ();
4685 return (ffelexHandler) ffesta_zero (t);
4686
4687 case FFESTR_firstPRIVATE:
4688 if (!ffesta_is_inhibited ())
4689 ffestc_private (); /* Either R423A or R521B. */
4690 return (ffelexHandler) ffesta_zero (t);
4691 #endif
4692
4693 default:
4694 goto bad_1; /* :::::::::::::::::::: */
4695 }
4696
4697 case FFELEX_typeCOMMA:
4698 ffesta_confirmed (); /* Error, but clearly intended. */
4699 switch (ffesta_first_kw)
4700 {
4701 #if FFESTR_F90
4702 case FFESTR_firstINTENT:
4703 goto bad_1; /* :::::::::::::::::::: */
4704 #endif
4705
4706 default:
4707 break;
4708 }
4709 if (*p != '\0')
4710 break;
4711 goto bad_1; /* :::::::::::::::::::: */
4712
4713 case FFELEX_typeCOLONCOLON:
4714 ffesta_confirmed ();
4715 switch (ffesta_first_kw)
4716 {
4717 #if FFESTR_F90
4718 case FFESTR_firstOPTIONAL:
4719 if (!ffesta_is_inhibited ())
4720 ffestc_R520_start ();
4721 break;
4722 #endif
4723
4724 #if FFESTR_F90
4725 case FFESTR_firstPUBLIC:
4726 if (!ffesta_is_inhibited ())
4727 ffestc_R521Astart ();
4728 break;
4729
4730 case FFESTR_firstPRIVATE:
4731 if (!ffesta_is_inhibited ())
4732 ffestc_R521Bstart ();
4733 break;
4734 #endif
4735
4736 default:
4737 goto bad_1; /* :::::::::::::::::::: */
4738 }
4739 return (ffelexHandler) ffestb_varlist5_;
4740
4741 case FFELEX_typeOPEN_PAREN:
4742 switch (ffesta_first_kw)
4743 {
4744 #if FFESTR_F90
4745 case FFESTR_firstINTENT:
4746 if (*p != '\0')
4747 goto bad_1; /* :::::::::::::::::::: */
4748 return (ffelexHandler) ffestb_varlist1_;
4749 #endif
4750
4751 default:
4752 goto bad_1; /* :::::::::::::::::::: */
4753 }
4754
4755 case FFELEX_typeNAME:
4756 ffesta_confirmed ();
4757 switch (ffesta_first_kw)
4758 {
4759 case FFESTR_firstEXTERNAL:
4760 if (!ffesta_is_inhibited ())
4761 ffestc_R1207_start ();
4762 break;
4763
4764 #if FFESTR_F90
4765 case FFESTR_firstINTENT:
4766 goto bad_1; /* :::::::::::::::::::: */
4767 #endif
4768
4769 case FFESTR_firstINTRINSIC:
4770 if (!ffesta_is_inhibited ())
4771 ffestc_R1208_start ();
4772 break;
4773
4774 #if FFESTR_F90
4775 case FFESTR_firstOPTIONAL:
4776 if (!ffesta_is_inhibited ())
4777 ffestc_R520_start ();
4778 break;
4779 #endif
4780
4781 #if FFESTR_F90
4782 case FFESTR_firstPUBLIC:
4783 if (!ffesta_is_inhibited ())
4784 ffestc_R521Astart ();
4785 break;
4786
4787 case FFESTR_firstPRIVATE:
4788 if (!ffesta_is_inhibited ())
4789 ffestc_R521Bstart ();
4790 break;
4791 #endif
4792
4793 default:
4794 break;
4795 }
4796 return (ffelexHandler) ffestb_varlist5_ (t);
4797
4798 default:
4799 goto bad_1; /* :::::::::::::::::::: */
4800 }
4801
4802 /* Here, we have at least one char after the first keyword and t is
4803 COMMA or EOS/SEMICOLON. Also we know that this form is valid for
4804 only the statements reaching here (specifically, INTENT won't reach
4805 here). */
4806
4807 if (!ffesrc_is_name_init (*p))
4808 goto bad_i; /* :::::::::::::::::::: */
4809 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
4810 if (!ffesta_is_inhibited ())
4811 {
4812 switch (ffesta_first_kw)
4813 {
4814 case FFESTR_firstEXTERNAL:
4815 ffestc_R1207_start ();
4816 break;
4817
4818 case FFESTR_firstINTRINSIC:
4819 ffestc_R1208_start ();
4820 break;
4821
4822 #if FFESTR_F90
4823 case FFESTR_firstOPTIONAL:
4824 ffestc_R520_start ();
4825 break;
4826 #endif
4827
4828 #if FFESTR_F90
4829 case FFESTR_firstPUBLIC:
4830 ffestc_R521Astart ();
4831 break;
4832
4833 case FFESTR_firstPRIVATE:
4834 ffestc_R521Bstart ();
4835 break;
4836 #endif
4837
4838 default:
4839 assert (FALSE);
4840 }
4841 }
4842 next = (ffelexHandler) ffestb_varlist5_ (nt);
4843 ffelex_token_kill (nt);
4844 return (ffelexHandler) (*next) (t);
4845
4846 default:
4847 goto bad_0; /* :::::::::::::::::::: */
4848 }
4849
4850 bad_0: /* :::::::::::::::::::: */
4851 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, ffesta_tokens[0]);
4852 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4853
4854 bad_1: /* :::::::::::::::::::: */
4855 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
4856 return (ffelexHandler) ffelex_swallow_tokens (t,
4857 (ffelexHandler) ffesta_zero); /* Invalid second token. */
4858
4859 bad_i: /* :::::::::::::::::::: */
4860 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, ffesta_tokens[0], i, t);
4861 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4862 }
4863
4864 /* ffestb_varlist1_ -- "INTENT" OPEN_PAREN
4865
4866 return ffestb_varlist1_; // to lexer
4867
4868 Handle NAME. */
4869
4870 #if FFESTR_F90
4871 static ffelexHandler
4872 ffestb_varlist1_ (ffelexToken t)
4873 {
4874 switch (ffelex_token_type (t))
4875 {
4876 case FFELEX_typeNAME:
4877 ffesta_tokens[1] = ffelex_token_use (t);
4878 ffestb_local_.varlist.kw = ffestr_other (t);
4879 switch (ffestb_local_.varlist.kw)
4880 {
4881 case FFESTR_otherIN:
4882 return (ffelexHandler) ffestb_varlist2_;
4883
4884 case FFESTR_otherINOUT:
4885 return (ffelexHandler) ffestb_varlist3_;
4886
4887 case FFESTR_otherOUT:
4888 return (ffelexHandler) ffestb_varlist3_;
4889
4890 default:
4891 ffelex_token_kill (ffesta_tokens[1]);
4892 break;
4893 }
4894 break;
4895
4896 default:
4897 break;
4898 }
4899
4900 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
4901 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4902 }
4903
4904 /* ffestb_varlist2_ -- "INTENT" OPEN_PAREN "IN"
4905
4906 return ffestb_varlist2_; // to lexer
4907
4908 Handle NAME. */
4909
4910 static ffelexHandler
4911 ffestb_varlist2_ (ffelexToken t)
4912 {
4913 switch (ffelex_token_type (t))
4914 {
4915 case FFELEX_typeNAME:
4916 switch (ffestr_other (t))
4917 {
4918 case FFESTR_otherOUT:
4919 ffestb_local_.varlist.kw = FFESTR_otherINOUT;
4920 return (ffelexHandler) ffestb_varlist3_;
4921
4922 default:
4923 break;
4924 }
4925 break;
4926
4927 case FFELEX_typeCLOSE_PAREN:
4928 return (ffelexHandler) ffestb_varlist4_;
4929
4930 default:
4931 break;
4932 }
4933
4934 ffelex_token_kill (ffesta_tokens[1]);
4935 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
4936 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4937 }
4938
4939 /* ffestb_varlist3_ -- "INTENT" OPEN_PAREN NAME ["OUT"]
4940
4941 return ffestb_varlist3_; // to lexer
4942
4943 Handle CLOSE_PAREN. */
4944
4945 static ffelexHandler
4946 ffestb_varlist3_ (ffelexToken t)
4947 {
4948 switch (ffelex_token_type (t))
4949 {
4950 case FFELEX_typeCLOSE_PAREN:
4951 return (ffelexHandler) ffestb_varlist4_;
4952
4953 default:
4954 break;
4955 }
4956
4957 ffelex_token_kill (ffesta_tokens[1]);
4958 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
4959 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4960 }
4961
4962 /* ffestb_varlist4_ -- "INTENT" OPEN_PAREN NAME ["OUT"] CLOSE_PAREN
4963
4964 return ffestb_varlist4_; // to lexer
4965
4966 Handle COLONCOLON or NAME. */
4967
4968 static ffelexHandler
4969 ffestb_varlist4_ (ffelexToken t)
4970 {
4971 switch (ffelex_token_type (t))
4972 {
4973 case FFELEX_typeCOLONCOLON:
4974 ffesta_confirmed ();
4975 if (!ffesta_is_inhibited ())
4976 ffestc_R519_start (ffesta_tokens[1], ffestb_local_.varlist.kw);
4977 ffelex_token_kill (ffesta_tokens[1]);
4978 return (ffelexHandler) ffestb_varlist5_;
4979
4980 case FFELEX_typeNAME:
4981 ffesta_confirmed ();
4982 if (!ffesta_is_inhibited ())
4983 ffestc_R519_start (ffesta_tokens[1], ffestb_local_.varlist.kw);
4984 ffelex_token_kill (ffesta_tokens[1]);
4985 return (ffelexHandler) ffestb_varlist5_ (t);
4986
4987 default:
4988 break;
4989 }
4990
4991 ffelex_token_kill (ffesta_tokens[1]);
4992 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
4993 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4994 }
4995
4996 #endif
4997 /* ffestb_varlist5_ -- Handles the list of variable names
4998
4999 return ffestb_varlist5_; // to lexer
5000
5001 Handle NAME. */
5002
5003 static ffelexHandler
5004 ffestb_varlist5_ (ffelexToken t)
5005 {
5006 switch (ffelex_token_type (t))
5007 {
5008 case FFELEX_typeNAME:
5009 ffesta_tokens[1] = ffelex_token_use (t);
5010 return (ffelexHandler) ffestb_varlist6_;
5011
5012 default:
5013 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
5014 break;
5015 }
5016
5017 if (!ffesta_is_inhibited ())
5018 {
5019 switch (ffesta_first_kw)
5020 {
5021 case FFESTR_firstEXTERNAL:
5022 ffestc_R1207_finish ();
5023 break;
5024
5025 #if FFESTR_F90
5026 case FFESTR_firstINTENT:
5027 ffestc_R519_finish ();
5028 break;
5029 #endif
5030
5031 case FFESTR_firstINTRINSIC:
5032 ffestc_R1208_finish ();
5033 break;
5034
5035 #if FFESTR_F90
5036 case FFESTR_firstOPTIONAL:
5037 ffestc_R520_finish ();
5038 break;
5039 #endif
5040
5041 #if FFESTR_F90
5042 case FFESTR_firstPUBLIC:
5043 ffestc_R521Afinish ();
5044 break;
5045
5046 case FFESTR_firstPRIVATE:
5047 ffestc_R521Bfinish ();
5048 break;
5049 #endif
5050
5051 default:
5052 assert (FALSE);
5053 }
5054 }
5055 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5056 }
5057
5058 /* ffestb_varlist6_ -- (whatever) NAME
5059
5060 return ffestb_varlist6_; // to lexer
5061
5062 Handle COMMA or EOS/SEMICOLON. */
5063
5064 static ffelexHandler
5065 ffestb_varlist6_ (ffelexToken t)
5066 {
5067 switch (ffelex_token_type (t))
5068 {
5069 case FFELEX_typeCOMMA:
5070 if (!ffesta_is_inhibited ())
5071 {
5072 switch (ffesta_first_kw)
5073 {
5074 case FFESTR_firstEXTERNAL:
5075 ffestc_R1207_item (ffesta_tokens[1]);
5076 break;
5077
5078 #if FFESTR_F90
5079 case FFESTR_firstINTENT:
5080 ffestc_R519_item (ffesta_tokens[1]);
5081 break;
5082 #endif
5083
5084 case FFESTR_firstINTRINSIC:
5085 ffestc_R1208_item (ffesta_tokens[1]);
5086 break;
5087
5088 #if FFESTR_F90
5089 case FFESTR_firstOPTIONAL:
5090 ffestc_R520_item (ffesta_tokens[1]);
5091 break;
5092 #endif
5093
5094 #if FFESTR_F90
5095 case FFESTR_firstPUBLIC:
5096 ffestc_R521Aitem (ffesta_tokens[1]);
5097 break;
5098
5099 case FFESTR_firstPRIVATE:
5100 ffestc_R521Bitem (ffesta_tokens[1]);
5101 break;
5102 #endif
5103
5104 default:
5105 assert (FALSE);
5106 }
5107 }
5108 ffelex_token_kill (ffesta_tokens[1]);
5109 return (ffelexHandler) ffestb_varlist5_;
5110
5111 case FFELEX_typeEOS:
5112 case FFELEX_typeSEMICOLON:
5113 if (!ffesta_is_inhibited ())
5114 {
5115 switch (ffesta_first_kw)
5116 {
5117 case FFESTR_firstEXTERNAL:
5118 ffestc_R1207_item (ffesta_tokens[1]);
5119 ffestc_R1207_finish ();
5120 break;
5121
5122 #if FFESTR_F90
5123 case FFESTR_firstINTENT:
5124 ffestc_R519_item (ffesta_tokens[1]);
5125 ffestc_R519_finish ();
5126 break;
5127 #endif
5128
5129 case FFESTR_firstINTRINSIC:
5130 ffestc_R1208_item (ffesta_tokens[1]);
5131 ffestc_R1208_finish ();
5132 break;
5133
5134 #if FFESTR_F90
5135 case FFESTR_firstOPTIONAL:
5136 ffestc_R520_item (ffesta_tokens[1]);
5137 ffestc_R520_finish ();
5138 break;
5139 #endif
5140
5141 #if FFESTR_F90
5142 case FFESTR_firstPUBLIC:
5143 ffestc_R521Aitem (ffesta_tokens[1]);
5144 ffestc_R521Afinish ();
5145 break;
5146
5147 case FFESTR_firstPRIVATE:
5148 ffestc_R521Bitem (ffesta_tokens[1]);
5149 ffestc_R521Bfinish ();
5150 break;
5151 #endif
5152
5153 default:
5154 assert (FALSE);
5155 }
5156 }
5157 ffelex_token_kill (ffesta_tokens[1]);
5158 return (ffelexHandler) ffesta_zero (t);
5159
5160 default:
5161 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
5162 break;
5163 }
5164
5165 if (!ffesta_is_inhibited ())
5166 {
5167 switch (ffesta_first_kw)
5168 {
5169 case FFESTR_firstEXTERNAL:
5170 ffestc_R1207_finish ();
5171 break;
5172
5173 #if FFESTR_F90
5174 case FFESTR_firstINTENT:
5175 ffestc_R519_finish ();
5176 break;
5177 #endif
5178
5179 case FFESTR_firstINTRINSIC:
5180 ffestc_R1208_finish ();
5181 break;
5182
5183 #if FFESTR_F90
5184 case FFESTR_firstOPTIONAL:
5185 ffestc_R520_finish ();
5186 break;
5187 #endif
5188
5189 #if FFESTR_F90
5190 case FFESTR_firstPUBLIC:
5191 ffestc_R521Afinish ();
5192 break;
5193
5194 case FFESTR_firstPRIVATE:
5195 ffestc_R521Bfinish ();
5196 break;
5197 #endif
5198
5199 default:
5200 assert (FALSE);
5201 }
5202 }
5203 ffelex_token_kill (ffesta_tokens[1]);
5204 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5205 }
5206
5207 /* ffestb_R423B -- Parse the SEQUENCE statement
5208
5209 return ffestb_R423B; // to lexer
5210
5211 Make sure the statement has a valid form for the SEQUENCE statement. If
5212 it does, implement the statement. */
5213
5214 #if FFESTR_F90
5215 ffelexHandler
5216 ffestb_R423B (ffelexToken t)
5217 {
5218 const char *p;
5219 ffeTokenLength i;
5220
5221 switch (ffelex_token_type (ffesta_tokens[0]))
5222 {
5223 case FFELEX_typeNAME:
5224 if (ffesta_first_kw != FFESTR_firstSEQUENCE)
5225 goto bad_0; /* :::::::::::::::::::: */
5226 break;
5227
5228 case FFELEX_typeNAMES:
5229 if (ffesta_first_kw != FFESTR_firstSEQUENCE)
5230 goto bad_0; /* :::::::::::::::::::: */
5231 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlSEQUENCE)
5232 {
5233 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSEQUENCE);
5234 goto bad_i; /* :::::::::::::::::::: */
5235 }
5236 break;
5237
5238 default:
5239 goto bad_0; /* :::::::::::::::::::: */
5240 }
5241
5242 switch (ffelex_token_type (t))
5243 {
5244 case FFELEX_typeEOS:
5245 case FFELEX_typeSEMICOLON:
5246 ffesta_confirmed ();
5247 if (!ffesta_is_inhibited ())
5248 ffestc_R423B ();
5249 return (ffelexHandler) ffesta_zero (t);
5250
5251 case FFELEX_typeCOMMA:
5252 case FFELEX_typeCOLONCOLON:
5253 ffesta_confirmed (); /* Error, but clearly intended. */
5254 goto bad_1; /* :::::::::::::::::::: */
5255
5256 default:
5257 goto bad_1; /* :::::::::::::::::::: */
5258 }
5259
5260 bad_0: /* :::::::::::::::::::: */
5261 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SEQUENCE", ffesta_tokens[0]);
5262 return (ffelexHandler) ffelex_swallow_tokens (t,
5263 (ffelexHandler) ffesta_zero); /* Invalid first token. */
5264
5265 bad_1: /* :::::::::::::::::::: */
5266 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SEQUENCE", t);
5267 return (ffelexHandler) ffelex_swallow_tokens (t,
5268 (ffelexHandler) ffesta_zero); /* Invalid second token. */
5269
5270 bad_i: /* :::::::::::::::::::: */
5271 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "SEQUENCE", ffesta_tokens[0], i, t);
5272 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5273 }
5274
5275 #endif
5276 /* ffestb_R522 -- Parse the SAVE statement
5277
5278 return ffestb_R522; // to lexer
5279
5280 Make sure the statement has a valid form for the SAVE statement. If it
5281 does, implement the statement. */
5282
5283 ffelexHandler
5284 ffestb_R522 (ffelexToken t)
5285 {
5286 ffeTokenLength i;
5287 unsigned const char *p;
5288 ffelexToken nt;
5289 ffelexHandler next;
5290
5291 switch (ffelex_token_type (ffesta_tokens[0]))
5292 {
5293 case FFELEX_typeNAME:
5294 if (ffesta_first_kw != FFESTR_firstSAVE)
5295 goto bad_0; /* :::::::::::::::::::: */
5296 switch (ffelex_token_type (t))
5297 {
5298 case FFELEX_typeCOMMA:
5299 ffesta_confirmed (); /* Error, but clearly intended. */
5300 goto bad_1; /* :::::::::::::::::::: */
5301
5302 default:
5303 goto bad_1; /* :::::::::::::::::::: */
5304
5305 case FFELEX_typeEOS:
5306 case FFELEX_typeSEMICOLON:
5307 ffesta_confirmed ();
5308 if (!ffesta_is_inhibited ())
5309 ffestc_R522 ();
5310 return (ffelexHandler) ffesta_zero (t);
5311
5312 case FFELEX_typeNAME:
5313 case FFELEX_typeSLASH:
5314 ffesta_confirmed ();
5315 if (!ffesta_is_inhibited ())
5316 ffestc_R522start ();
5317 return (ffelexHandler) ffestb_R5221_ (t);
5318
5319 case FFELEX_typeCOLONCOLON:
5320 ffesta_confirmed ();
5321 if (!ffesta_is_inhibited ())
5322 ffestc_R522start ();
5323 return (ffelexHandler) ffestb_R5221_;
5324 }
5325
5326 case FFELEX_typeNAMES:
5327 if (ffesta_first_kw != FFESTR_firstSAVE)
5328 goto bad_0; /* :::::::::::::::::::: */
5329 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSAVE);
5330 switch (ffelex_token_type (t))
5331 {
5332 default:
5333 goto bad_1; /* :::::::::::::::::::: */
5334
5335 case FFELEX_typeCOMMA:
5336 ffesta_confirmed ();
5337 break;
5338
5339 case FFELEX_typeEOS:
5340 case FFELEX_typeSEMICOLON:
5341 ffesta_confirmed ();
5342 if (*p != '\0')
5343 break;
5344 if (!ffesta_is_inhibited ())
5345 ffestc_R522 ();
5346 return (ffelexHandler) ffesta_zero (t);
5347
5348 case FFELEX_typeSLASH:
5349 ffesta_confirmed ();
5350 if (*p != '\0')
5351 goto bad_i; /* :::::::::::::::::::: */
5352 if (!ffesta_is_inhibited ())
5353 ffestc_R522start ();
5354 return (ffelexHandler) ffestb_R5221_ (t);
5355
5356 case FFELEX_typeCOLONCOLON:
5357 ffesta_confirmed ();
5358 if (*p != '\0')
5359 goto bad_i; /* :::::::::::::::::::: */
5360 if (!ffesta_is_inhibited ())
5361 ffestc_R522start ();
5362 return (ffelexHandler) ffestb_R5221_;
5363 }
5364
5365 /* Here, we have at least one char after "SAVE" and t is COMMA or
5366 EOS/SEMICOLON. */
5367
5368 if (!ffesrc_is_name_init (*p))
5369 goto bad_i; /* :::::::::::::::::::: */
5370 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
5371 if (!ffesta_is_inhibited ())
5372 ffestc_R522start ();
5373 next = (ffelexHandler) ffestb_R5221_ (nt);
5374 ffelex_token_kill (nt);
5375 return (ffelexHandler) (*next) (t);
5376
5377 default:
5378 goto bad_0; /* :::::::::::::::::::: */
5379 }
5380
5381 bad_0: /* :::::::::::::::::::: */
5382 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", ffesta_tokens[0]);
5383 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5384
5385 bad_1: /* :::::::::::::::::::: */
5386 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
5387 return (ffelexHandler) ffelex_swallow_tokens (t,
5388 (ffelexHandler) ffesta_zero); /* Invalid second token. */
5389
5390 bad_i: /* :::::::::::::::::::: */
5391 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "SAVE", ffesta_tokens[0], i, t);
5392 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5393 }
5394
5395 /* ffestb_R5221_ -- "SAVE" [COLONCOLON]
5396
5397 return ffestb_R5221_; // to lexer
5398
5399 Handle NAME or SLASH. */
5400
5401 static ffelexHandler
5402 ffestb_R5221_ (ffelexToken t)
5403 {
5404 switch (ffelex_token_type (t))
5405 {
5406 case FFELEX_typeNAME:
5407 ffestb_local_.R522.is_cblock = FALSE;
5408 ffesta_tokens[1] = ffelex_token_use (t);
5409 return (ffelexHandler) ffestb_R5224_;
5410
5411 case FFELEX_typeSLASH:
5412 ffestb_local_.R522.is_cblock = TRUE;
5413 return (ffelexHandler) ffestb_R5222_;
5414
5415 default:
5416 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
5417 break;
5418 }
5419
5420 if (!ffesta_is_inhibited ())
5421 ffestc_R522finish ();
5422 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5423 }
5424
5425 /* ffestb_R5222_ -- "SAVE" [COLONCOLON] SLASH
5426
5427 return ffestb_R5222_; // to lexer
5428
5429 Handle NAME. */
5430
5431 static ffelexHandler
5432 ffestb_R5222_ (ffelexToken t)
5433 {
5434 switch (ffelex_token_type (t))
5435 {
5436 case FFELEX_typeNAME:
5437 ffesta_tokens[1] = ffelex_token_use (t);
5438 return (ffelexHandler) ffestb_R5223_;
5439
5440 default:
5441 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
5442 break;
5443 }
5444
5445 if (!ffesta_is_inhibited ())
5446 ffestc_R522finish ();
5447 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5448 }
5449
5450 /* ffestb_R5223_ -- "SAVE" [COLONCOLON] SLASH NAME
5451
5452 return ffestb_R5223_; // to lexer
5453
5454 Handle SLASH. */
5455
5456 static ffelexHandler
5457 ffestb_R5223_ (ffelexToken t)
5458 {
5459 switch (ffelex_token_type (t))
5460 {
5461 case FFELEX_typeSLASH:
5462 return (ffelexHandler) ffestb_R5224_;
5463
5464 default:
5465 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
5466 break;
5467 }
5468
5469 if (!ffesta_is_inhibited ())
5470 ffestc_R522finish ();
5471 ffelex_token_kill (ffesta_tokens[1]);
5472 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5473 }
5474
5475 /* ffestb_R5224_ -- "SAVE" [COLONCOLON] R523
5476
5477 return ffestb_R5224_; // to lexer
5478
5479 Handle COMMA or EOS/SEMICOLON. */
5480
5481 static ffelexHandler
5482 ffestb_R5224_ (ffelexToken t)
5483 {
5484 switch (ffelex_token_type (t))
5485 {
5486 case FFELEX_typeCOMMA:
5487 if (!ffesta_is_inhibited ())
5488 {
5489 if (ffestb_local_.R522.is_cblock)
5490 ffestc_R522item_cblock (ffesta_tokens[1]);
5491 else
5492 ffestc_R522item_object (ffesta_tokens[1]);
5493 }
5494 ffelex_token_kill (ffesta_tokens[1]);
5495 return (ffelexHandler) ffestb_R5221_;
5496
5497 case FFELEX_typeEOS:
5498 case FFELEX_typeSEMICOLON:
5499 if (!ffesta_is_inhibited ())
5500 {
5501 if (ffestb_local_.R522.is_cblock)
5502 ffestc_R522item_cblock (ffesta_tokens[1]);
5503 else
5504 ffestc_R522item_object (ffesta_tokens[1]);
5505 ffestc_R522finish ();
5506 }
5507 ffelex_token_kill (ffesta_tokens[1]);
5508 return (ffelexHandler) ffesta_zero (t);
5509
5510 default:
5511 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
5512 break;
5513 }
5514
5515 if (!ffesta_is_inhibited ())
5516 ffestc_R522finish ();
5517 ffelex_token_kill (ffesta_tokens[1]);
5518 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5519 }
5520
5521 /* ffestb_R528 -- Parse the DATA statement
5522
5523 return ffestb_R528; // to lexer
5524
5525 Make sure the statement has a valid form for the DATA statement. If it
5526 does, implement the statement. */
5527
5528 ffelexHandler
5529 ffestb_R528 (ffelexToken t)
5530 {
5531 unsigned const char *p;
5532 ffeTokenLength i;
5533 ffelexToken nt;
5534 ffelexHandler next;
5535
5536 switch (ffelex_token_type (ffesta_tokens[0]))
5537 {
5538 case FFELEX_typeNAME:
5539 if (ffesta_first_kw != FFESTR_firstDATA)
5540 goto bad_0; /* :::::::::::::::::::: */
5541 switch (ffelex_token_type (t))
5542 {
5543 case FFELEX_typeCOMMA:
5544 case FFELEX_typeEOS:
5545 case FFELEX_typeSEMICOLON:
5546 case FFELEX_typeSLASH:
5547 case FFELEX_typeCOLONCOLON:
5548 ffesta_confirmed (); /* Error, but clearly intended. */
5549 goto bad_1; /* :::::::::::::::::::: */
5550
5551 default:
5552 goto bad_1; /* :::::::::::::::::::: */
5553
5554 case FFELEX_typeNAME:
5555 ffesta_confirmed ();
5556 break;
5557
5558 case FFELEX_typeOPEN_PAREN:
5559 break;
5560 }
5561 ffestb_local_.data.started = FALSE;
5562 return (ffelexHandler) (*((ffelexHandler)
5563 ffeexpr_lhs (ffesta_output_pool,
5564 FFEEXPR_contextDATA,
5565 (ffeexprCallback) ffestb_R5281_)))
5566 (t);
5567
5568 case FFELEX_typeNAMES:
5569 if (ffesta_first_kw != FFESTR_firstDATA)
5570 goto bad_0; /* :::::::::::::::::::: */
5571 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDATA);
5572 switch (ffelex_token_type (t))
5573 {
5574 case FFELEX_typeEOS:
5575 case FFELEX_typeSEMICOLON:
5576 case FFELEX_typeCOLONCOLON:
5577 ffesta_confirmed (); /* Error, but clearly intended. */
5578 goto bad_1; /* :::::::::::::::::::: */
5579
5580 default:
5581 goto bad_1; /* :::::::::::::::::::: */
5582
5583 case FFELEX_typeOPEN_PAREN:
5584 if (*p == '\0')
5585 {
5586 ffestb_local_.data.started = FALSE;
5587 return (ffelexHandler) (*((ffelexHandler)
5588 ffeexpr_lhs (ffesta_output_pool,
5589 FFEEXPR_contextDATA,
5590 (ffeexprCallback)
5591 ffestb_R5281_)))
5592 (t);
5593 }
5594 break;
5595
5596 case FFELEX_typeCOMMA:
5597 case FFELEX_typeSLASH:
5598 ffesta_confirmed ();
5599 break;
5600 }
5601 if (!ffesrc_is_name_init (*p))
5602 goto bad_i; /* :::::::::::::::::::: */
5603 ffestb_local_.data.started = FALSE;
5604 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
5605 next = (ffelexHandler) (*((ffelexHandler)
5606 ffeexpr_lhs (ffesta_output_pool,
5607 FFEEXPR_contextDATA,
5608 (ffeexprCallback) ffestb_R5281_)))
5609 (nt);
5610 ffelex_token_kill (nt);
5611 return (ffelexHandler) (*next) (t);
5612
5613 default:
5614 goto bad_0; /* :::::::::::::::::::: */
5615 }
5616
5617 bad_0: /* :::::::::::::::::::: */
5618 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", ffesta_tokens[0]);
5619 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5620
5621 bad_1: /* :::::::::::::::::::: */
5622 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
5623 return (ffelexHandler) ffelex_swallow_tokens (t,
5624 (ffelexHandler) ffesta_zero); /* Invalid second token. */
5625
5626 bad_i: /* :::::::::::::::::::: */
5627 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DATA", ffesta_tokens[0], i, t);
5628 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5629 }
5630
5631 /* ffestb_R5281_ -- "DATA" expr-list
5632
5633 (ffestb_R5281_) // to expression handler
5634
5635 Handle COMMA or SLASH. */
5636
5637 static ffelexHandler
5638 ffestb_R5281_ (ffelexToken ft, ffebld expr, ffelexToken t)
5639 {
5640 switch (ffelex_token_type (t))
5641 {
5642 case FFELEX_typeCOMMA:
5643 ffesta_confirmed ();
5644 if (expr == NULL)
5645 break;
5646 if (!ffesta_is_inhibited ())
5647 {
5648 if (!ffestb_local_.data.started)
5649 {
5650 ffestc_R528_start ();
5651 ffestb_local_.data.started = TRUE;
5652 }
5653 ffestc_R528_item_object (expr, ft);
5654 }
5655 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
5656 FFEEXPR_contextDATA,
5657 (ffeexprCallback) ffestb_R5281_);
5658
5659 case FFELEX_typeSLASH:
5660 ffesta_confirmed ();
5661 if (expr == NULL)
5662 break;
5663 if (!ffesta_is_inhibited ())
5664 {
5665 if (!ffestb_local_.data.started)
5666 {
5667 ffestc_R528_start ();
5668 ffestb_local_.data.started = TRUE;
5669 }
5670 ffestc_R528_item_object (expr, ft);
5671 ffestc_R528_item_startvals ();
5672 }
5673 return (ffelexHandler) ffeexpr_rhs
5674 (ffesta_output_pool, FFEEXPR_contextDATA,
5675 (ffeexprCallback) ffestb_R5282_);
5676
5677 default:
5678 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
5679 break;
5680 }
5681
5682 if (ffestb_local_.data.started && !ffesta_is_inhibited ())
5683 ffestc_R528_finish ();
5684 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5685 }
5686
5687 /* ffestb_R5282_ -- "DATA" expr-list SLASH expr-list
5688
5689 (ffestb_R5282_) // to expression handler
5690
5691 Handle ASTERISK, COMMA, or SLASH. */
5692
5693 static ffelexHandler
5694 ffestb_R5282_ (ffelexToken ft, ffebld expr, ffelexToken t)
5695 {
5696 switch (ffelex_token_type (t))
5697 {
5698 case FFELEX_typeCOMMA:
5699 if (expr == NULL)
5700 break;
5701 if (!ffesta_is_inhibited ())
5702 ffestc_R528_item_value (NULL, NULL, expr, ft);
5703 return (ffelexHandler) ffeexpr_rhs
5704 (ffesta_output_pool, FFEEXPR_contextDATA,
5705 (ffeexprCallback) ffestb_R5282_);
5706
5707 case FFELEX_typeASTERISK:
5708 if (expr == NULL)
5709 break;
5710 ffestb_local_.data.expr = ffeexpr_convert (expr, ft, t,
5711 FFEINFO_basictypeINTEGER,
5712 FFEINFO_kindtypeINTEGER1,
5713 0,
5714 FFETARGET_charactersizeNONE,
5715 FFEEXPR_contextLET);
5716 ffesta_tokens[1] = ffelex_token_use (ft);
5717 return (ffelexHandler) ffeexpr_rhs
5718 (ffesta_output_pool, FFEEXPR_contextDATA,
5719 (ffeexprCallback) ffestb_R5283_);
5720
5721 case FFELEX_typeSLASH:
5722 if (expr == NULL)
5723 break;
5724 if (!ffesta_is_inhibited ())
5725 {
5726 ffestc_R528_item_value (NULL, NULL, expr, ft);
5727 ffestc_R528_item_endvals (t);
5728 }
5729 return (ffelexHandler) ffestb_R5284_;
5730
5731 default:
5732 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
5733 break;
5734 }
5735
5736 if (!ffesta_is_inhibited ())
5737 {
5738 ffestc_R528_item_endvals (t);
5739 ffestc_R528_finish ();
5740 }
5741 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5742 }
5743
5744 /* ffestb_R5283_ -- "DATA" expr-list SLASH expr ASTERISK expr
5745
5746 (ffestb_R5283_) // to expression handler
5747
5748 Handle COMMA or SLASH. */
5749
5750 static ffelexHandler
5751 ffestb_R5283_ (ffelexToken ft, ffebld expr, ffelexToken t)
5752 {
5753 switch (ffelex_token_type (t))
5754 {
5755 case FFELEX_typeCOMMA:
5756 if (expr == NULL)
5757 break;
5758 if (!ffesta_is_inhibited ())
5759 ffestc_R528_item_value (ffestb_local_.data.expr, ffesta_tokens[1],
5760 expr, ft);
5761 ffelex_token_kill (ffesta_tokens[1]);
5762 return (ffelexHandler) ffeexpr_rhs
5763 (ffesta_output_pool, FFEEXPR_contextDATA,
5764 (ffeexprCallback) ffestb_R5282_);
5765
5766 case FFELEX_typeSLASH:
5767 if (expr == NULL)
5768 break;
5769 if (!ffesta_is_inhibited ())
5770 {
5771 ffestc_R528_item_value (ffestb_local_.data.expr, ffesta_tokens[1],
5772 expr, ft);
5773 ffestc_R528_item_endvals (t);
5774 }
5775 ffelex_token_kill (ffesta_tokens[1]);
5776 return (ffelexHandler) ffestb_R5284_;
5777
5778 default:
5779 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
5780 break;
5781 }
5782
5783 if (!ffesta_is_inhibited ())
5784 {
5785 ffestc_R528_item_endvals (t);
5786 ffestc_R528_finish ();
5787 }
5788 ffelex_token_kill (ffesta_tokens[1]);
5789 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5790 }
5791
5792 /* ffestb_R5284_ -- "DATA" expr-list SLASH expr-list SLASH
5793
5794 return ffestb_R5284_; // to lexer
5795
5796 Handle [COMMA] NAME or EOS/SEMICOLON. */
5797
5798 static ffelexHandler
5799 ffestb_R5284_ (ffelexToken t)
5800 {
5801 switch (ffelex_token_type (t))
5802 {
5803 case FFELEX_typeCOMMA:
5804 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
5805 FFEEXPR_contextDATA,
5806 (ffeexprCallback) ffestb_R5281_);
5807
5808 case FFELEX_typeNAME:
5809 case FFELEX_typeOPEN_PAREN:
5810 return (ffelexHandler) (*((ffelexHandler)
5811 ffeexpr_lhs (ffesta_output_pool,
5812 FFEEXPR_contextDATA,
5813 (ffeexprCallback) ffestb_R5281_)))
5814 (t);
5815
5816 case FFELEX_typeEOS:
5817 case FFELEX_typeSEMICOLON:
5818 if (!ffesta_is_inhibited ())
5819 ffestc_R528_finish ();
5820 return (ffelexHandler) ffesta_zero (t);
5821
5822 default:
5823 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
5824 break;
5825 }
5826
5827 if (!ffesta_is_inhibited ())
5828 ffestc_R528_finish ();
5829 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5830 }
5831
5832 /* ffestb_R537 -- Parse a PARAMETER statement
5833
5834 return ffestb_R537; // to lexer
5835
5836 Make sure the statement has a valid form for an PARAMETER statement.
5837 If it does, implement the statement. */
5838
5839 ffelexHandler
5840 ffestb_R537 (ffelexToken t)
5841 {
5842 switch (ffelex_token_type (ffesta_tokens[0]))
5843 {
5844 case FFELEX_typeNAME:
5845 if (ffesta_first_kw != FFESTR_firstPARAMETER)
5846 goto bad_0; /* :::::::::::::::::::: */
5847 break;
5848
5849 case FFELEX_typeNAMES:
5850 if (ffesta_first_kw != FFESTR_firstPARAMETER)
5851 goto bad_0; /* :::::::::::::::::::: */
5852 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlPARAMETER)
5853 goto bad_0; /* :::::::::::::::::::: */
5854 break;
5855
5856 default:
5857 goto bad_0; /* :::::::::::::::::::: */
5858 }
5859
5860 switch (ffelex_token_type (t))
5861 {
5862 case FFELEX_typeOPEN_PAREN:
5863 break;
5864
5865 case FFELEX_typeEOS:
5866 case FFELEX_typeSEMICOLON:
5867 case FFELEX_typeCOMMA:
5868 case FFELEX_typeCOLONCOLON:
5869 ffesta_confirmed (); /* Error, but clearly intended. */
5870 goto bad_1; /* :::::::::::::::::::: */
5871
5872 default:
5873 goto bad_1; /* :::::::::::::::::::: */
5874 }
5875
5876 ffestb_local_.parameter.started = FALSE;
5877 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
5878 FFEEXPR_contextPARAMETER,
5879 (ffeexprCallback) ffestb_R5371_);
5880
5881 bad_0: /* :::::::::::::::::::: */
5882 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", ffesta_tokens[0]);
5883 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5884
5885 bad_1: /* :::::::::::::::::::: */
5886 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
5887 return (ffelexHandler) ffelex_swallow_tokens (t,
5888 (ffelexHandler) ffesta_zero); /* Invalid second token. */
5889 }
5890
5891 /* ffestb_R5371_ -- "PARAMETER" OPEN_PAREN expr
5892
5893 (ffestb_R5371_) // to expression handler
5894
5895 Make sure the next token is EQUALS. */
5896
5897 static ffelexHandler
5898 ffestb_R5371_ (ffelexToken ft, ffebld expr, ffelexToken t)
5899 {
5900 ffestb_local_.parameter.expr = expr;
5901
5902 switch (ffelex_token_type (t))
5903 {
5904 case FFELEX_typeEQUALS:
5905 ffesta_confirmed ();
5906 if (expr == NULL)
5907 break;
5908 ffesta_tokens[1] = ffelex_token_use (ft);
5909 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
5910 FFEEXPR_contextPARAMETER, (ffeexprCallback) ffestb_R5372_);
5911
5912 default:
5913 break;
5914 }
5915
5916 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
5917 if (ffestb_local_.parameter.started)
5918 ffestc_R537_finish ();
5919 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5920 }
5921
5922 /* ffestb_R5372_ -- "PARAMETER" OPEN_PAREN expr EQUALS expr
5923
5924 (ffestb_R5372_) // to expression handler
5925
5926 Make sure the next token is COMMA or CLOSE_PAREN. */
5927
5928 static ffelexHandler
5929 ffestb_R5372_ (ffelexToken ft, ffebld expr, ffelexToken t)
5930 {
5931 switch (ffelex_token_type (t))
5932 {
5933 case FFELEX_typeCOMMA:
5934 if (expr == NULL)
5935 break;
5936 if (!ffesta_is_inhibited ())
5937 {
5938 if (!ffestb_local_.parameter.started)
5939 {
5940 ffestc_R537_start ();
5941 ffestb_local_.parameter.started = TRUE;
5942 }
5943 ffestc_R537_item (ffestb_local_.parameter.expr, ffesta_tokens[1],
5944 expr, ft);
5945 }
5946 ffelex_token_kill (ffesta_tokens[1]);
5947 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
5948 FFEEXPR_contextPARAMETER,
5949 (ffeexprCallback) ffestb_R5371_);
5950
5951 case FFELEX_typeCLOSE_PAREN:
5952 if (expr == NULL)
5953 break;
5954 if (!ffesta_is_inhibited ())
5955 {
5956 if (!ffestb_local_.parameter.started)
5957 {
5958 ffestc_R537_start ();
5959 ffestb_local_.parameter.started = TRUE;
5960 }
5961 ffestc_R537_item (ffestb_local_.parameter.expr, ffesta_tokens[1],
5962 expr, ft);
5963 ffestc_R537_finish ();
5964 }
5965 ffelex_token_kill (ffesta_tokens[1]);
5966 return (ffelexHandler) ffestb_R5373_;
5967
5968 default:
5969 break;
5970 }
5971
5972 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
5973 if (ffestb_local_.parameter.started)
5974 ffestc_R537_finish ();
5975 ffelex_token_kill (ffesta_tokens[1]);
5976 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5977 }
5978
5979 /* ffestb_R5373_ -- "PARAMETER" OPEN_PAREN expr EQUALS expr CLOSE_PAREN
5980
5981 return ffestb_R5373_; // to lexer
5982
5983 Make sure the next token is EOS or SEMICOLON, or generate an error. All
5984 cleanup has already been done, by the way. */
5985
5986 static ffelexHandler
5987 ffestb_R5373_ (ffelexToken t)
5988 {
5989 switch (ffelex_token_type (t))
5990 {
5991 case FFELEX_typeEOS:
5992 case FFELEX_typeSEMICOLON:
5993 return (ffelexHandler) ffesta_zero (t);
5994
5995 default:
5996 break;
5997 }
5998
5999 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
6000 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6001 }
6002
6003 /* ffestb_R542 -- Parse the NAMELIST statement
6004
6005 return ffestb_R542; // to lexer
6006
6007 Make sure the statement has a valid form for the NAMELIST statement. If it
6008 does, implement the statement. */
6009
6010 ffelexHandler
6011 ffestb_R542 (ffelexToken t)
6012 {
6013 const char *p;
6014 ffeTokenLength i;
6015
6016 switch (ffelex_token_type (ffesta_tokens[0]))
6017 {
6018 case FFELEX_typeNAME:
6019 if (ffesta_first_kw != FFESTR_firstNAMELIST)
6020 goto bad_0; /* :::::::::::::::::::: */
6021 break;
6022
6023 case FFELEX_typeNAMES:
6024 if (ffesta_first_kw != FFESTR_firstNAMELIST)
6025 goto bad_0; /* :::::::::::::::::::: */
6026 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlNAMELIST);
6027 if (*p != '\0')
6028 goto bad_i; /* :::::::::::::::::::: */
6029 break;
6030
6031 default:
6032 goto bad_0; /* :::::::::::::::::::: */
6033 }
6034
6035 switch (ffelex_token_type (t))
6036 {
6037 case FFELEX_typeCOMMA:
6038 case FFELEX_typeEOS:
6039 case FFELEX_typeSEMICOLON:
6040 case FFELEX_typeCOLONCOLON:
6041 ffesta_confirmed (); /* Error, but clearly intended. */
6042 goto bad_1; /* :::::::::::::::::::: */
6043
6044 default:
6045 goto bad_1; /* :::::::::::::::::::: */
6046
6047 case FFELEX_typeSLASH:
6048 break;
6049 }
6050
6051 ffesta_confirmed ();
6052 if (!ffesta_is_inhibited ())
6053 ffestc_R542_start ();
6054 return (ffelexHandler) ffestb_R5421_;
6055
6056 bad_0: /* :::::::::::::::::::: */
6057 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", ffesta_tokens[0]);
6058 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6059
6060 bad_1: /* :::::::::::::::::::: */
6061 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
6062 return (ffelexHandler) ffelex_swallow_tokens (t,
6063 (ffelexHandler) ffesta_zero); /* Invalid second token. */
6064
6065 bad_i: /* :::::::::::::::::::: */
6066 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "NAMELIST", ffesta_tokens[0], i, t);
6067 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6068 }
6069
6070 /* ffestb_R5421_ -- "NAMELIST" SLASH
6071
6072 return ffestb_R5421_; // to lexer
6073
6074 Handle NAME. */
6075
6076 static ffelexHandler
6077 ffestb_R5421_ (ffelexToken t)
6078 {
6079 switch (ffelex_token_type (t))
6080 {
6081 case FFELEX_typeNAME:
6082 if (!ffesta_is_inhibited ())
6083 ffestc_R542_item_nlist (t);
6084 return (ffelexHandler) ffestb_R5422_;
6085
6086 default:
6087 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
6088 break;
6089 }
6090
6091 if (!ffesta_is_inhibited ())
6092 ffestc_R542_finish ();
6093 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6094 }
6095
6096 /* ffestb_R5422_ -- "NAMELIST" SLASH NAME
6097
6098 return ffestb_R5422_; // to lexer
6099
6100 Handle SLASH. */
6101
6102 static ffelexHandler
6103 ffestb_R5422_ (ffelexToken t)
6104 {
6105 switch (ffelex_token_type (t))
6106 {
6107 case FFELEX_typeSLASH:
6108 return (ffelexHandler) ffestb_R5423_;
6109
6110 default:
6111 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
6112 break;
6113 }
6114
6115 if (!ffesta_is_inhibited ())
6116 ffestc_R542_finish ();
6117 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6118 }
6119
6120 /* ffestb_R5423_ -- "NAMELIST" SLASH NAME SLASH
6121
6122 return ffestb_R5423_; // to lexer
6123
6124 Handle NAME. */
6125
6126 static ffelexHandler
6127 ffestb_R5423_ (ffelexToken t)
6128 {
6129 switch (ffelex_token_type (t))
6130 {
6131 case FFELEX_typeNAME:
6132 if (!ffesta_is_inhibited ())
6133 ffestc_R542_item_nitem (t);
6134 return (ffelexHandler) ffestb_R5424_;
6135
6136 default:
6137 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
6138 break;
6139 }
6140
6141 if (!ffesta_is_inhibited ())
6142 ffestc_R542_finish ();
6143 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6144 }
6145
6146 /* ffestb_R5424_ -- "NAMELIST" SLASH NAME SLASH NAME
6147
6148 return ffestb_R5424_; // to lexer
6149
6150 Handle COMMA, EOS/SEMICOLON, or SLASH. */
6151
6152 static ffelexHandler
6153 ffestb_R5424_ (ffelexToken t)
6154 {
6155 switch (ffelex_token_type (t))
6156 {
6157 case FFELEX_typeCOMMA:
6158 return (ffelexHandler) ffestb_R5425_;
6159
6160 case FFELEX_typeEOS:
6161 case FFELEX_typeSEMICOLON:
6162 if (!ffesta_is_inhibited ())
6163 ffestc_R542_finish ();
6164 return (ffelexHandler) ffesta_zero (t);
6165
6166 case FFELEX_typeSLASH:
6167 return (ffelexHandler) ffestb_R5421_;
6168
6169 default:
6170 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
6171 break;
6172 }
6173
6174 if (!ffesta_is_inhibited ())
6175 ffestc_R542_finish ();
6176 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6177 }
6178
6179 /* ffestb_R5425_ -- "NAMELIST" SLASH NAME SLASH NAME COMMA
6180
6181 return ffestb_R5425_; // to lexer
6182
6183 Handle NAME or SLASH. */
6184
6185 static ffelexHandler
6186 ffestb_R5425_ (ffelexToken t)
6187 {
6188 switch (ffelex_token_type (t))
6189 {
6190 case FFELEX_typeNAME:
6191 if (!ffesta_is_inhibited ())
6192 ffestc_R542_item_nitem (t);
6193 return (ffelexHandler) ffestb_R5424_;
6194
6195 case FFELEX_typeSLASH:
6196 return (ffelexHandler) ffestb_R5421_;
6197
6198 default:
6199 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
6200 break;
6201 }
6202
6203 if (!ffesta_is_inhibited ())
6204 ffestc_R542_finish ();
6205 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6206 }
6207
6208 /* ffestb_R544 -- Parse an EQUIVALENCE statement
6209
6210 return ffestb_R544; // to lexer
6211
6212 Make sure the statement has a valid form for an EQUIVALENCE statement.
6213 If it does, implement the statement. */
6214
6215 ffelexHandler
6216 ffestb_R544 (ffelexToken t)
6217 {
6218 switch (ffelex_token_type (ffesta_tokens[0]))
6219 {
6220 case FFELEX_typeNAME:
6221 if (ffesta_first_kw != FFESTR_firstEQUIVALENCE)
6222 goto bad_0; /* :::::::::::::::::::: */
6223 break;
6224
6225 case FFELEX_typeNAMES:
6226 if (ffesta_first_kw != FFESTR_firstEQUIVALENCE)
6227 goto bad_0; /* :::::::::::::::::::: */
6228 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlEQUIVALENCE)
6229 goto bad_0; /* :::::::::::::::::::: */
6230 break;
6231
6232 default:
6233 goto bad_0; /* :::::::::::::::::::: */
6234 }
6235
6236 switch (ffelex_token_type (t))
6237 {
6238 case FFELEX_typeOPEN_PAREN:
6239 break;
6240
6241 case FFELEX_typeEOS:
6242 case FFELEX_typeSEMICOLON:
6243 case FFELEX_typeCOMMA:
6244 case FFELEX_typeCOLONCOLON:
6245 ffesta_confirmed (); /* Error, but clearly intended. */
6246 goto bad_1; /* :::::::::::::::::::: */
6247
6248 default:
6249 goto bad_1; /* :::::::::::::::::::: */
6250 }
6251
6252 ffestb_local_.equivalence.started = FALSE;
6253 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
6254 FFEEXPR_contextEQUIVALENCE,
6255 (ffeexprCallback) ffestb_R5441_);
6256
6257 bad_0: /* :::::::::::::::::::: */
6258 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", ffesta_tokens[0]);
6259 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6260
6261 bad_1: /* :::::::::::::::::::: */
6262 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
6263 return (ffelexHandler) ffelex_swallow_tokens (t,
6264 (ffelexHandler) ffesta_zero); /* Invalid second token. */
6265 }
6266
6267 /* ffestb_R5441_ -- "EQUIVALENCE" OPEN_PAREN expr
6268
6269 (ffestb_R5441_) // to expression handler
6270
6271 Make sure the next token is COMMA. */
6272
6273 static ffelexHandler
6274 ffestb_R5441_ (ffelexToken ft, ffebld expr, ffelexToken t)
6275 {
6276 switch (ffelex_token_type (t))
6277 {
6278 case FFELEX_typeCOMMA:
6279 if (expr == NULL)
6280 break;
6281 ffestb_local_.equivalence.exprs = ffestt_exprlist_create ();
6282 ffestt_exprlist_append (ffestb_local_.equivalence.exprs, expr,
6283 ffelex_token_use (ft));
6284 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
6285 FFEEXPR_contextEQUIVALENCE,
6286 (ffeexprCallback) ffestb_R5442_);
6287
6288 default:
6289 break;
6290 }
6291
6292 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
6293 if (ffestb_local_.equivalence.started)
6294 ffestc_R544_finish ();
6295 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6296 }
6297
6298 /* ffestb_R5442_ -- "EQUIVALENCE" OPEN_PAREN expr COMMA expr
6299
6300 (ffestb_R5442_) // to expression handler
6301
6302 Make sure the next token is COMMA or CLOSE_PAREN. For COMMA, we just
6303 append the expression to our list and continue; for CLOSE_PAREN, we
6304 append the expression and move to _3_. */
6305
6306 static ffelexHandler
6307 ffestb_R5442_ (ffelexToken ft, ffebld expr, ffelexToken t)
6308 {
6309 switch (ffelex_token_type (t))
6310 {
6311 case FFELEX_typeCOMMA:
6312 if (expr == NULL)
6313 break;
6314 ffestt_exprlist_append (ffestb_local_.equivalence.exprs, expr,
6315 ffelex_token_use (ft));
6316 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
6317 FFEEXPR_contextEQUIVALENCE,
6318 (ffeexprCallback) ffestb_R5442_);
6319
6320 case FFELEX_typeCLOSE_PAREN:
6321 if (expr == NULL)
6322 break;
6323 ffestt_exprlist_append (ffestb_local_.equivalence.exprs, expr,
6324 ffelex_token_use (ft));
6325 return (ffelexHandler) ffestb_R5443_;
6326
6327 default:
6328 break;
6329 }
6330
6331 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
6332 if (ffestb_local_.equivalence.started)
6333 ffestc_R544_finish ();
6334 ffestt_exprlist_kill (ffestb_local_.equivalence.exprs);
6335 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6336 }
6337
6338 /* ffestb_R5443_ -- "EQUIVALENCE" OPEN_PAREN expr COMMA expr CLOSE_PAREN
6339
6340 return ffestb_R5443_; // to lexer
6341
6342 Make sure the next token is COMMA or EOS/SEMICOLON. */
6343
6344 static ffelexHandler
6345 ffestb_R5443_ (ffelexToken t)
6346 {
6347 switch (ffelex_token_type (t))
6348 {
6349 case FFELEX_typeCOMMA:
6350 ffesta_confirmed ();
6351 if (!ffesta_is_inhibited ())
6352 {
6353 if (!ffestb_local_.equivalence.started)
6354 {
6355 ffestc_R544_start ();
6356 ffestb_local_.equivalence.started = TRUE;
6357 }
6358 ffestc_R544_item (ffestb_local_.equivalence.exprs);
6359 }
6360 ffestt_exprlist_kill (ffestb_local_.equivalence.exprs);
6361 return (ffelexHandler) ffestb_R5444_;
6362
6363 case FFELEX_typeEOS:
6364 case FFELEX_typeSEMICOLON:
6365 ffesta_confirmed ();
6366 if (!ffesta_is_inhibited ())
6367 {
6368 if (!ffestb_local_.equivalence.started)
6369 {
6370 ffestc_R544_start ();
6371 ffestb_local_.equivalence.started = TRUE;
6372 }
6373 ffestc_R544_item (ffestb_local_.equivalence.exprs);
6374 ffestc_R544_finish ();
6375 }
6376 ffestt_exprlist_kill (ffestb_local_.equivalence.exprs);
6377 return (ffelexHandler) ffesta_zero (t);
6378
6379 default:
6380 break;
6381 }
6382
6383 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
6384 if (ffestb_local_.equivalence.started)
6385 ffestc_R544_finish ();
6386 ffestt_exprlist_kill (ffestb_local_.equivalence.exprs);
6387 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6388 }
6389
6390 /* ffestb_R5444_ -- "EQUIVALENCE" OPEN_PAREN expr COMMA expr CLOSE_PAREN COMMA
6391
6392 return ffestb_R5444_; // to lexer
6393
6394 Make sure the next token is OPEN_PAREN, or generate an error. */
6395
6396 static ffelexHandler
6397 ffestb_R5444_ (ffelexToken t)
6398 {
6399 switch (ffelex_token_type (t))
6400 {
6401 case FFELEX_typeOPEN_PAREN:
6402 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
6403 FFEEXPR_contextEQUIVALENCE,
6404 (ffeexprCallback) ffestb_R5441_);
6405
6406 default:
6407 break;
6408 }
6409
6410 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
6411 if (ffestb_local_.equivalence.started)
6412 ffestc_R544_finish ();
6413 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6414 }
6415
6416 /* ffestb_R834 -- Parse the CYCLE statement
6417
6418 return ffestb_R834; // to lexer
6419
6420 Make sure the statement has a valid form for the CYCLE statement. If
6421 it does, implement the statement. */
6422
6423 ffelexHandler
6424 ffestb_R834 (ffelexToken t)
6425 {
6426 ffeTokenLength i;
6427 unsigned const char *p;
6428
6429 switch (ffelex_token_type (ffesta_tokens[0]))
6430 {
6431 case FFELEX_typeNAME:
6432 if (ffesta_first_kw != FFESTR_firstCYCLE)
6433 goto bad_0; /* :::::::::::::::::::: */
6434 switch (ffelex_token_type (t))
6435 {
6436 case FFELEX_typeCOMMA:
6437 case FFELEX_typeCOLONCOLON:
6438 ffesta_confirmed (); /* Error, but clearly intended. */
6439 goto bad_1; /* :::::::::::::::::::: */
6440
6441 default:
6442 goto bad_1; /* :::::::::::::::::::: */
6443
6444 case FFELEX_typeNAME:
6445 ffesta_confirmed ();
6446 ffesta_tokens[1] = ffelex_token_use (t);
6447 return (ffelexHandler) ffestb_R8341_;
6448
6449 case FFELEX_typeEOS:
6450 case FFELEX_typeSEMICOLON:
6451 ffesta_confirmed ();
6452 ffesta_tokens[1] = NULL;
6453 return (ffelexHandler) ffestb_R8341_ (t);
6454 }
6455
6456 case FFELEX_typeNAMES:
6457 if (ffesta_first_kw != FFESTR_firstCYCLE)
6458 goto bad_0; /* :::::::::::::::::::: */
6459 switch (ffelex_token_type (t))
6460 {
6461 default:
6462 goto bad_1; /* :::::::::::::::::::: */
6463
6464 case FFELEX_typeEOS:
6465 case FFELEX_typeSEMICOLON:
6466 break;
6467 }
6468 ffesta_confirmed ();
6469 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCYCLE);
6470 if (*p == '\0')
6471 {
6472 ffesta_tokens[1] = NULL;
6473 }
6474 else
6475 {
6476 if (!ffesrc_is_name_init (*p))
6477 goto bad_i; /* :::::::::::::::::::: */
6478 ffesta_tokens[1]
6479 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
6480 }
6481 return (ffelexHandler) ffestb_R8341_ (t);
6482
6483 default:
6484 goto bad_0; /* :::::::::::::::::::: */
6485 }
6486
6487 bad_0: /* :::::::::::::::::::: */
6488 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CYCLE", ffesta_tokens[0]);
6489 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6490
6491 bad_1: /* :::::::::::::::::::: */
6492 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CYCLE", t);
6493 return (ffelexHandler) ffelex_swallow_tokens (t,
6494 (ffelexHandler) ffesta_zero); /* Invalid second token. */
6495
6496 bad_i: /* :::::::::::::::::::: */
6497 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CYCLE", ffesta_tokens[0], i, t);
6498 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6499 }
6500
6501 /* ffestb_R8341_ -- "CYCLE" [NAME]
6502
6503 return ffestb_R8341_; // to lexer
6504
6505 Make sure the next token is an EOS or SEMICOLON. */
6506
6507 static ffelexHandler
6508 ffestb_R8341_ (ffelexToken t)
6509 {
6510 switch (ffelex_token_type (t))
6511 {
6512 case FFELEX_typeEOS:
6513 case FFELEX_typeSEMICOLON:
6514 ffesta_confirmed ();
6515 if (!ffesta_is_inhibited ())
6516 ffestc_R834 (ffesta_tokens[1]);
6517 if (ffesta_tokens[1] != NULL)
6518 ffelex_token_kill (ffesta_tokens[1]);
6519 return (ffelexHandler) ffesta_zero (t);
6520
6521 default:
6522 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CYCLE", t);
6523 break;
6524 }
6525
6526 if (ffesta_tokens[1] != NULL)
6527 ffelex_token_kill (ffesta_tokens[1]);
6528 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6529 }
6530
6531 /* ffestb_R835 -- Parse the EXIT statement
6532
6533 return ffestb_R835; // to lexer
6534
6535 Make sure the statement has a valid form for the EXIT statement. If
6536 it does, implement the statement. */
6537
6538 ffelexHandler
6539 ffestb_R835 (ffelexToken t)
6540 {
6541 ffeTokenLength i;
6542 unsigned const char *p;
6543
6544 switch (ffelex_token_type (ffesta_tokens[0]))
6545 {
6546 case FFELEX_typeNAME:
6547 if (ffesta_first_kw != FFESTR_firstEXIT)
6548 goto bad_0; /* :::::::::::::::::::: */
6549 switch (ffelex_token_type (t))
6550 {
6551 case FFELEX_typeCOMMA:
6552 case FFELEX_typeCOLONCOLON:
6553 ffesta_confirmed (); /* Error, but clearly intended. */
6554 goto bad_1; /* :::::::::::::::::::: */
6555
6556 default:
6557 goto bad_1; /* :::::::::::::::::::: */
6558
6559 case FFELEX_typeNAME:
6560 ffesta_confirmed ();
6561 ffesta_tokens[1] = ffelex_token_use (t);
6562 return (ffelexHandler) ffestb_R8351_;
6563
6564 case FFELEX_typeEOS:
6565 case FFELEX_typeSEMICOLON:
6566 ffesta_confirmed ();
6567 ffesta_tokens[1] = NULL;
6568 return (ffelexHandler) ffestb_R8351_ (t);
6569 }
6570
6571 case FFELEX_typeNAMES:
6572 if (ffesta_first_kw != FFESTR_firstEXIT)
6573 goto bad_0; /* :::::::::::::::::::: */
6574 switch (ffelex_token_type (t))
6575 {
6576 default:
6577 goto bad_1; /* :::::::::::::::::::: */
6578
6579 case FFELEX_typeEOS:
6580 case FFELEX_typeSEMICOLON:
6581 break;
6582 }
6583 ffesta_confirmed ();
6584 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlEXIT);
6585 if (*p == '\0')
6586 {
6587 ffesta_tokens[1] = NULL;
6588 }
6589 else
6590 {
6591 if (!ffesrc_is_name_init (*p))
6592 goto bad_i; /* :::::::::::::::::::: */
6593 ffesta_tokens[1]
6594 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
6595 }
6596 return (ffelexHandler) ffestb_R8351_ (t);
6597
6598 default:
6599 goto bad_0; /* :::::::::::::::::::: */
6600 }
6601
6602 bad_0: /* :::::::::::::::::::: */
6603 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EXIT", ffesta_tokens[0]);
6604 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6605
6606 bad_1: /* :::::::::::::::::::: */
6607 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EXIT", t);
6608 return (ffelexHandler) ffelex_swallow_tokens (t,
6609 (ffelexHandler) ffesta_zero); /* Invalid second token. */
6610
6611 bad_i: /* :::::::::::::::::::: */
6612 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "EXIT", ffesta_tokens[0], i, t);
6613 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6614 }
6615
6616 /* ffestb_R8351_ -- "EXIT" [NAME]
6617
6618 return ffestb_R8351_; // to lexer
6619
6620 Make sure the next token is an EOS or SEMICOLON. */
6621
6622 static ffelexHandler
6623 ffestb_R8351_ (ffelexToken t)
6624 {
6625 switch (ffelex_token_type (t))
6626 {
6627 case FFELEX_typeEOS:
6628 case FFELEX_typeSEMICOLON:
6629 ffesta_confirmed ();
6630 if (!ffesta_is_inhibited ())
6631 ffestc_R835 (ffesta_tokens[1]);
6632 if (ffesta_tokens[1] != NULL)
6633 ffelex_token_kill (ffesta_tokens[1]);
6634 return (ffelexHandler) ffesta_zero (t);
6635
6636 default:
6637 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EXIT", t);
6638 break;
6639 }
6640
6641 if (ffesta_tokens[1] != NULL)
6642 ffelex_token_kill (ffesta_tokens[1]);
6643 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6644 }
6645
6646 /* ffestb_R838 -- Parse the ASSIGN statement
6647
6648 return ffestb_R838; // to lexer
6649
6650 Make sure the statement has a valid form for the ASSIGN statement. If it
6651 does, implement the statement. */
6652
6653 ffelexHandler
6654 ffestb_R838 (ffelexToken t)
6655 {
6656 unsigned const char *p;
6657 ffeTokenLength i;
6658 ffelexHandler next;
6659 ffelexToken et; /* First token in target. */
6660
6661 switch (ffelex_token_type (ffesta_tokens[0]))
6662 {
6663 case FFELEX_typeNAME:
6664 if (ffesta_first_kw != FFESTR_firstASSIGN)
6665 goto bad_0; /* :::::::::::::::::::: */
6666 switch (ffelex_token_type (t))
6667 {
6668 case FFELEX_typeEOS:
6669 case FFELEX_typeSEMICOLON:
6670 case FFELEX_typeCOMMA:
6671 case FFELEX_typeCOLONCOLON:
6672 ffesta_confirmed (); /* Error, but clearly intended. */
6673 goto bad_1; /* :::::::::::::::::::: */
6674
6675 default:
6676 goto bad_1; /* :::::::::::::::::::: */
6677
6678 case FFELEX_typeNUMBER:
6679 break;
6680 }
6681 ffesta_tokens[1] = ffelex_token_use (t);
6682 ffesta_confirmed ();
6683 return (ffelexHandler) ffestb_R8381_;
6684
6685 case FFELEX_typeNAMES:
6686 if (ffesta_first_kw != FFESTR_firstASSIGN)
6687 goto bad_0; /* :::::::::::::::::::: */
6688
6689 switch (ffelex_token_type (t))
6690 {
6691 case FFELEX_typeEOS:
6692 case FFELEX_typeSEMICOLON:
6693 ffesta_confirmed ();
6694 /* Fall through. */
6695 case FFELEX_typePERCENT:
6696 case FFELEX_typeOPEN_PAREN:
6697 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlASSIGN);
6698 if (! ISDIGIT (*p))
6699 goto bad_i; /* :::::::::::::::::::: */
6700 ffesta_tokens[1]
6701 = ffelex_token_number_from_names (ffesta_tokens[0], i);
6702 p += ffelex_token_length (ffesta_tokens[1]); /* Skip to "TO". */
6703 i += ffelex_token_length (ffesta_tokens[1]);
6704 if (!ffesrc_char_match_init (*p, 'T', 't') /* "TO". */
6705 || (++i, !ffesrc_char_match_noninit (*++p, 'O', 'o')))
6706 {
6707 bad_i_1: /* :::::::::::::::::::: */
6708 ffelex_token_kill (ffesta_tokens[1]);
6709 goto bad_i; /* :::::::::::::::::::: */
6710 }
6711 ++p, ++i;
6712 if (!ffesrc_is_name_init (*p))
6713 goto bad_i_1; /* :::::::::::::::::::: */
6714 et = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
6715 next = (ffelexHandler)
6716 (*((ffelexHandler)
6717 ffeexpr_lhs (ffesta_output_pool,
6718 FFEEXPR_contextASSIGN,
6719 (ffeexprCallback)
6720 ffestb_R8383_)))
6721 (et);
6722 ffelex_token_kill (et);
6723 return (ffelexHandler) (*next) (t);
6724
6725 case FFELEX_typeCOMMA:
6726 case FFELEX_typeCOLONCOLON:
6727 ffesta_confirmed (); /* Error, but clearly intended. */
6728 goto bad_1; /* :::::::::::::::::::: */
6729
6730 default:
6731 goto bad_1; /* :::::::::::::::::::: */
6732 }
6733
6734 default:
6735 goto bad_0; /* :::::::::::::::::::: */
6736 }
6737
6738 bad_0: /* :::::::::::::::::::: */
6739 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", ffesta_tokens[0]);
6740 return (ffelexHandler) ffelex_swallow_tokens (t,
6741 (ffelexHandler) ffesta_zero); /* Invalid first token. */
6742
6743 bad_1: /* :::::::::::::::::::: */
6744 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", t);
6745 return (ffelexHandler) ffelex_swallow_tokens (t,
6746 (ffelexHandler) ffesta_zero); /* Invalid second token. */
6747
6748 bad_i: /* :::::::::::::::::::: */
6749 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "ASSIGN", ffesta_tokens[0], i, t);
6750 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6751 }
6752
6753 /* ffestb_R8381_ -- "ASSIGN" NUMBER
6754
6755 return ffestb_R8381_; // to lexer
6756
6757 Make sure the next token is "TO". */
6758
6759 static ffelexHandler
6760 ffestb_R8381_ (ffelexToken t)
6761 {
6762 if ((ffelex_token_type (t) == FFELEX_typeNAME)
6763 && (ffesrc_strcmp_2c (ffe_case_match (), ffelex_token_text (t), "TO", "to",
6764 "To") == 0))
6765 {
6766 return (ffelexHandler) ffestb_R8382_;
6767 }
6768
6769 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", t);
6770 if (ffelex_token_type (t) == FFELEX_typeNAME)
6771 return (ffelexHandler) ffestb_R8382_ (t); /* Maybe user forgot "TO". */
6772
6773 ffelex_token_kill (ffesta_tokens[1]);
6774 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6775 }
6776
6777 /* ffestb_R8382_ -- "ASSIGN" NUMBER ("TO")
6778
6779 return ffestb_R8382_; // to lexer
6780
6781 Make sure the next token is a name, then pass it along to the expression
6782 evaluator as an LHS expression. The callback function is _3_. */
6783
6784 static ffelexHandler
6785 ffestb_R8382_ (ffelexToken t)
6786 {
6787 if (ffelex_token_type (t) == FFELEX_typeNAME)
6788 {
6789 return (ffelexHandler)
6790 (*((ffelexHandler)
6791 ffeexpr_lhs (ffesta_output_pool, FFEEXPR_contextASSIGN,
6792 (ffeexprCallback) ffestb_R8383_)))
6793 (t);
6794 }
6795
6796 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", t);
6797 ffelex_token_kill (ffesta_tokens[1]);
6798 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6799 }
6800
6801 /* ffestb_R8383_ -- "ASSIGN" NUMBER ("TO") expression
6802
6803 (ffestb_R8383_) // to expression handler
6804
6805 Make sure the next token is an EOS or SEMICOLON. */
6806
6807 static ffelexHandler
6808 ffestb_R8383_ (ffelexToken ft, ffebld expr, ffelexToken t)
6809 {
6810 switch (ffelex_token_type (t))
6811 {
6812 case FFELEX_typeEOS:
6813 case FFELEX_typeSEMICOLON:
6814 ffesta_confirmed ();
6815 if (expr == NULL)
6816 break;
6817 if (!ffesta_is_inhibited ())
6818 ffestc_R838 (ffesta_tokens[1], expr, ft);
6819 ffelex_token_kill (ffesta_tokens[1]);
6820 return (ffelexHandler) ffesta_zero (t);
6821
6822 default:
6823 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", t);
6824 break;
6825 }
6826
6827 ffelex_token_kill (ffesta_tokens[1]);
6828 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6829 }
6830
6831 /* ffestb_R840 -- Parse an arithmetic-IF statement
6832
6833 return ffestb_R840; // to lexer
6834
6835 Make sure the statement has a valid form for an arithmetic-IF statement.
6836 If it does, implement the statement. */
6837
6838 ffelexHandler
6839 ffestb_R840 (ffelexToken t)
6840 {
6841 switch (ffelex_token_type (ffesta_tokens[0]))
6842 {
6843 case FFELEX_typeNAME:
6844 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlIF)
6845 goto bad_0; /* :::::::::::::::::::: */
6846 if (ffesta_first_kw != FFESTR_firstIF)
6847 goto bad_0; /* :::::::::::::::::::: */
6848 break;
6849
6850 case FFELEX_typeNAMES:
6851 if (ffesta_first_kw != FFESTR_firstIF)
6852 goto bad_0; /* :::::::::::::::::::: */
6853 break;
6854
6855 default:
6856 goto bad_0; /* :::::::::::::::::::: */
6857 }
6858
6859 switch (ffelex_token_type (t))
6860 {
6861 case FFELEX_typeOPEN_PAREN:
6862 break;
6863
6864 default:
6865 goto bad_1; /* :::::::::::::::::::: */
6866 }
6867
6868 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextARITHIF,
6869 (ffeexprCallback) ffestb_R8401_);
6870
6871 bad_0: /* :::::::::::::::::::: */
6872 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", ffesta_tokens[0]);
6873 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6874
6875 bad_1: /* :::::::::::::::::::: */
6876 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
6877 return (ffelexHandler) ffelex_swallow_tokens (t,
6878 (ffelexHandler) ffesta_zero); /* Invalid second token. */
6879 }
6880
6881 /* ffestb_R8401_ -- "IF" OPEN_PAREN expr
6882
6883 (ffestb_R8401_) // to expression handler
6884
6885 Make sure the next token is CLOSE_PAREN. */
6886
6887 static ffelexHandler
6888 ffestb_R8401_ (ffelexToken ft, ffebld expr, ffelexToken t)
6889 {
6890 ffestb_local_.if_stmt.expr = expr;
6891
6892 switch (ffelex_token_type (t))
6893 {
6894 case FFELEX_typeCLOSE_PAREN:
6895 if (expr == NULL)
6896 break;
6897 ffesta_tokens[1] = ffelex_token_use (ft);
6898 ffelex_set_names (TRUE); /* In case it's a logical IF instead. */
6899 return (ffelexHandler) ffestb_R8402_;
6900
6901 default:
6902 break;
6903 }
6904
6905 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
6906 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6907 }
6908
6909 /* ffestb_R8402_ -- "IF" OPEN_PAREN expr CLOSE_PAREN
6910
6911 return ffestb_R8402_; // to lexer
6912
6913 Make sure the next token is NUMBER. */
6914
6915 static ffelexHandler
6916 ffestb_R8402_ (ffelexToken t)
6917 {
6918 ffelex_set_names (FALSE);
6919
6920 switch (ffelex_token_type (t))
6921 {
6922 case FFELEX_typeNUMBER:
6923 ffesta_confirmed ();
6924 ffesta_tokens[2] = ffelex_token_use (t);
6925 return (ffelexHandler) ffestb_R8403_;
6926
6927 default:
6928 break;
6929 }
6930
6931 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
6932 ffelex_token_kill (ffesta_tokens[1]);
6933 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6934 }
6935
6936 /* ffestb_R8403_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER
6937
6938 return ffestb_R8403_; // to lexer
6939
6940 Make sure the next token is COMMA. */
6941
6942 static ffelexHandler
6943 ffestb_R8403_ (ffelexToken t)
6944 {
6945 switch (ffelex_token_type (t))
6946 {
6947 case FFELEX_typeCOMMA:
6948 return (ffelexHandler) ffestb_R8404_;
6949
6950 default:
6951 break;
6952 }
6953
6954 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
6955 ffelex_token_kill (ffesta_tokens[1]);
6956 ffelex_token_kill (ffesta_tokens[2]);
6957 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6958 }
6959
6960 /* ffestb_R8404_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER COMMA
6961
6962 return ffestb_R8404_; // to lexer
6963
6964 Make sure the next token is NUMBER. */
6965
6966 static ffelexHandler
6967 ffestb_R8404_ (ffelexToken t)
6968 {
6969 switch (ffelex_token_type (t))
6970 {
6971 case FFELEX_typeNUMBER:
6972 ffesta_tokens[3] = ffelex_token_use (t);
6973 return (ffelexHandler) ffestb_R8405_;
6974
6975 default:
6976 break;
6977 }
6978
6979 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
6980 ffelex_token_kill (ffesta_tokens[1]);
6981 ffelex_token_kill (ffesta_tokens[2]);
6982 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6983 }
6984
6985 /* ffestb_R8405_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER COMMA NUMBER
6986
6987 return ffestb_R8405_; // to lexer
6988
6989 Make sure the next token is COMMA. */
6990
6991 static ffelexHandler
6992 ffestb_R8405_ (ffelexToken t)
6993 {
6994 switch (ffelex_token_type (t))
6995 {
6996 case FFELEX_typeCOMMA:
6997 return (ffelexHandler) ffestb_R8406_;
6998
6999 default:
7000 break;
7001 }
7002
7003 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
7004 ffelex_token_kill (ffesta_tokens[1]);
7005 ffelex_token_kill (ffesta_tokens[2]);
7006 ffelex_token_kill (ffesta_tokens[3]);
7007 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7008 }
7009
7010 /* ffestb_R8406_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER COMMA NUMBER COMMA
7011
7012 return ffestb_R8406_; // to lexer
7013
7014 Make sure the next token is NUMBER. */
7015
7016 static ffelexHandler
7017 ffestb_R8406_ (ffelexToken t)
7018 {
7019 switch (ffelex_token_type (t))
7020 {
7021 case FFELEX_typeNUMBER:
7022 ffesta_tokens[4] = ffelex_token_use (t);
7023 return (ffelexHandler) ffestb_R8407_;
7024
7025 default:
7026 break;
7027 }
7028
7029 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
7030 ffelex_token_kill (ffesta_tokens[1]);
7031 ffelex_token_kill (ffesta_tokens[2]);
7032 ffelex_token_kill (ffesta_tokens[3]);
7033 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7034 }
7035
7036 /* ffestb_R8407_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER COMMA NUMBER COMMA
7037 NUMBER
7038
7039 return ffestb_R8407_; // to lexer
7040
7041 Make sure the next token is EOS or SEMICOLON. */
7042
7043 static ffelexHandler
7044 ffestb_R8407_ (ffelexToken t)
7045 {
7046 switch (ffelex_token_type (t))
7047 {
7048 case FFELEX_typeEOS:
7049 case FFELEX_typeSEMICOLON:
7050 if (!ffesta_is_inhibited ())
7051 ffestc_R840 (ffestb_local_.if_stmt.expr, ffesta_tokens[1],
7052 ffesta_tokens[2], ffesta_tokens[3], ffesta_tokens[4]);
7053 ffelex_token_kill (ffesta_tokens[1]);
7054 ffelex_token_kill (ffesta_tokens[2]);
7055 ffelex_token_kill (ffesta_tokens[3]);
7056 ffelex_token_kill (ffesta_tokens[4]);
7057 return (ffelexHandler) ffesta_zero (t);
7058
7059 default:
7060 break;
7061 }
7062
7063 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
7064 ffelex_token_kill (ffesta_tokens[1]);
7065 ffelex_token_kill (ffesta_tokens[2]);
7066 ffelex_token_kill (ffesta_tokens[3]);
7067 ffelex_token_kill (ffesta_tokens[4]);
7068 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7069 }
7070
7071 /* ffestb_R841 -- Parse the CONTINUE statement
7072
7073 return ffestb_R841; // to lexer
7074
7075 Make sure the statement has a valid form for the CONTINUE statement. If
7076 it does, implement the statement. */
7077
7078 ffelexHandler
7079 ffestb_R841 (ffelexToken t)
7080 {
7081 const char *p;
7082 ffeTokenLength i;
7083
7084 switch (ffelex_token_type (ffesta_tokens[0]))
7085 {
7086 case FFELEX_typeNAME:
7087 if (ffesta_first_kw != FFESTR_firstCONTINUE)
7088 goto bad_0; /* :::::::::::::::::::: */
7089 break;
7090
7091 case FFELEX_typeNAMES:
7092 if (ffesta_first_kw != FFESTR_firstCONTINUE)
7093 goto bad_0; /* :::::::::::::::::::: */
7094 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlCONTINUE)
7095 {
7096 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCONTINUE);
7097 goto bad_i; /* :::::::::::::::::::: */
7098 }
7099 break;
7100
7101 default:
7102 goto bad_0; /* :::::::::::::::::::: */
7103 }
7104
7105 switch (ffelex_token_type (t))
7106 {
7107 case FFELEX_typeEOS:
7108 case FFELEX_typeSEMICOLON:
7109 ffesta_confirmed ();
7110 if (!ffesta_is_inhibited ())
7111 ffestc_R841 ();
7112 return (ffelexHandler) ffesta_zero (t);
7113
7114 case FFELEX_typeCOMMA:
7115 case FFELEX_typeCOLONCOLON:
7116 ffesta_confirmed (); /* Error, but clearly intended. */
7117 goto bad_1; /* :::::::::::::::::::: */
7118
7119 default:
7120 goto bad_1; /* :::::::::::::::::::: */
7121 }
7122
7123 bad_0: /* :::::::::::::::::::: */
7124 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CONTINUE", ffesta_tokens[0]);
7125 return (ffelexHandler) ffelex_swallow_tokens (t,
7126 (ffelexHandler) ffesta_zero); /* Invalid first token. */
7127
7128 bad_1: /* :::::::::::::::::::: */
7129 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CONTINUE", t);
7130 return (ffelexHandler) ffelex_swallow_tokens (t,
7131 (ffelexHandler) ffesta_zero); /* Invalid second token. */
7132
7133 bad_i: /* :::::::::::::::::::: */
7134 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CONTINUE", ffesta_tokens[0], i, t);
7135 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7136 }
7137
7138 /* ffestb_R1102 -- Parse the PROGRAM statement
7139
7140 return ffestb_R1102; // to lexer
7141
7142 Make sure the statement has a valid form for the PROGRAM statement. If it
7143 does, implement the statement. */
7144
7145 ffelexHandler
7146 ffestb_R1102 (ffelexToken t)
7147 {
7148 ffeTokenLength i;
7149 unsigned const char *p;
7150
7151 switch (ffelex_token_type (ffesta_tokens[0]))
7152 {
7153 case FFELEX_typeNAME:
7154 if (ffesta_first_kw != FFESTR_firstPROGRAM)
7155 goto bad_0; /* :::::::::::::::::::: */
7156 switch (ffelex_token_type (t))
7157 {
7158 case FFELEX_typeEOS:
7159 case FFELEX_typeSEMICOLON:
7160 case FFELEX_typeCOMMA:
7161 case FFELEX_typeCOLONCOLON:
7162 ffesta_confirmed (); /* Error, but clearly intended. */
7163 goto bad_1; /* :::::::::::::::::::: */
7164
7165 default:
7166 goto bad_1; /* :::::::::::::::::::: */
7167
7168 case FFELEX_typeNAME:
7169 break;
7170 }
7171
7172 ffesta_confirmed ();
7173 ffesta_tokens[1] = ffelex_token_use (t);
7174 return (ffelexHandler) ffestb_R11021_;
7175
7176 case FFELEX_typeNAMES:
7177 if (ffesta_first_kw != FFESTR_firstPROGRAM)
7178 goto bad_0; /* :::::::::::::::::::: */
7179 switch (ffelex_token_type (t))
7180 {
7181 case FFELEX_typeCOMMA:
7182 case FFELEX_typeCOLONCOLON:
7183 ffesta_confirmed (); /* Error, but clearly intended. */
7184 goto bad_1; /* :::::::::::::::::::: */
7185
7186 default:
7187 goto bad_1; /* :::::::::::::::::::: */
7188
7189 case FFELEX_typeEOS:
7190 case FFELEX_typeSEMICOLON:
7191 break;
7192 }
7193 ffesta_confirmed ();
7194 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlPROGRAM);
7195 if (!ffesrc_is_name_init (*p))
7196 goto bad_i; /* :::::::::::::::::::: */
7197 ffesta_tokens[1]
7198 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
7199 return (ffelexHandler) ffestb_R11021_ (t);
7200
7201 default:
7202 goto bad_0; /* :::::::::::::::::::: */
7203 }
7204
7205 bad_0: /* :::::::::::::::::::: */
7206 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PROGRAM", ffesta_tokens[0]);
7207 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7208
7209 bad_1: /* :::::::::::::::::::: */
7210 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PROGRAM", t);
7211 return (ffelexHandler) ffelex_swallow_tokens (t,
7212 (ffelexHandler) ffesta_zero); /* Invalid second token. */
7213
7214 bad_i: /* :::::::::::::::::::: */
7215 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "PROGRAM", ffesta_tokens[0], i, t);
7216 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7217 }
7218
7219 /* ffestb_R11021_ -- "PROGRAM" NAME
7220
7221 return ffestb_R11021_; // to lexer
7222
7223 Make sure the next token is an EOS or SEMICOLON. */
7224
7225 static ffelexHandler
7226 ffestb_R11021_ (ffelexToken t)
7227 {
7228 switch (ffelex_token_type (t))
7229 {
7230 case FFELEX_typeEOS:
7231 case FFELEX_typeSEMICOLON:
7232 ffesta_confirmed ();
7233 if (!ffesta_is_inhibited ())
7234 ffestc_R1102 (ffesta_tokens[1]);
7235 ffelex_token_kill (ffesta_tokens[1]);
7236 return (ffelexHandler) ffesta_zero (t);
7237
7238 default:
7239 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PROGRAM", t);
7240 break;
7241 }
7242
7243 ffelex_token_kill (ffesta_tokens[1]);
7244 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7245 }
7246
7247 /* ffestb_block -- Parse the BLOCK DATA statement
7248
7249 return ffestb_block; // to lexer
7250
7251 Make sure the statement has a valid form for the BLOCK DATA statement. If
7252 it does, implement the statement. */
7253
7254 ffelexHandler
7255 ffestb_block (ffelexToken t)
7256 {
7257 switch (ffelex_token_type (ffesta_tokens[0]))
7258 {
7259 case FFELEX_typeNAME:
7260 if (ffesta_first_kw != FFESTR_firstBLOCK)
7261 goto bad_0; /* :::::::::::::::::::: */
7262 switch (ffelex_token_type (t))
7263 {
7264 default:
7265 goto bad_1; /* :::::::::::::::::::: */
7266
7267 case FFELEX_typeNAME:
7268 if (ffesta_second_kw != FFESTR_secondDATA)
7269 goto bad_1; /* :::::::::::::::::::: */
7270 break;
7271 }
7272
7273 ffesta_confirmed ();
7274 return (ffelexHandler) ffestb_R1111_1_;
7275
7276 default:
7277 goto bad_0; /* :::::::::::::::::::: */
7278 }
7279
7280 bad_0: /* :::::::::::::::::::: */
7281 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", ffesta_tokens[0]);
7282 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7283
7284 bad_1: /* :::::::::::::::::::: */
7285 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", t);
7286 return (ffelexHandler) ffelex_swallow_tokens (t,
7287 (ffelexHandler) ffesta_zero); /* Invalid second token. */
7288 }
7289
7290 /* ffestb_blockdata -- Parse the BLOCKDATA statement
7291
7292 return ffestb_blockdata; // to lexer
7293
7294 Make sure the statement has a valid form for the BLOCKDATA statement. If
7295 it does, implement the statement. */
7296
7297 ffelexHandler
7298 ffestb_blockdata (ffelexToken t)
7299 {
7300 ffeTokenLength i;
7301 unsigned const char *p;
7302
7303 switch (ffelex_token_type (ffesta_tokens[0]))
7304 {
7305 case FFELEX_typeNAME:
7306 if (ffesta_first_kw != FFESTR_firstBLOCKDATA)
7307 goto bad_0; /* :::::::::::::::::::: */
7308 switch (ffelex_token_type (t))
7309 {
7310 case FFELEX_typeCOMMA:
7311 case FFELEX_typeCOLONCOLON:
7312 ffesta_confirmed (); /* Error, but clearly intended. */
7313 goto bad_1; /* :::::::::::::::::::: */
7314
7315 default:
7316 goto bad_1; /* :::::::::::::::::::: */
7317
7318 case FFELEX_typeNAME:
7319 ffesta_confirmed ();
7320 ffesta_tokens[1] = ffelex_token_use (t);
7321 return (ffelexHandler) ffestb_R1111_2_;
7322
7323 case FFELEX_typeEOS:
7324 case FFELEX_typeSEMICOLON:
7325 ffesta_confirmed ();
7326 ffesta_tokens[1] = NULL;
7327 return (ffelexHandler) ffestb_R1111_2_ (t);
7328 }
7329
7330 case FFELEX_typeNAMES:
7331 if (ffesta_first_kw != FFESTR_firstBLOCKDATA)
7332 goto bad_0; /* :::::::::::::::::::: */
7333 switch (ffelex_token_type (t))
7334 {
7335 default:
7336 goto bad_1; /* :::::::::::::::::::: */
7337
7338 case FFELEX_typeEOS:
7339 case FFELEX_typeSEMICOLON:
7340 break;
7341 }
7342 ffesta_confirmed ();
7343 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlBLOCKDATA);
7344 if (*p == '\0')
7345 {
7346 ffesta_tokens[1] = NULL;
7347 }
7348 else
7349 {
7350 if (!ffesrc_is_name_init (*p))
7351 goto bad_i; /* :::::::::::::::::::: */
7352 ffesta_tokens[1]
7353 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
7354 }
7355 return (ffelexHandler) ffestb_R1111_2_ (t);
7356
7357 default:
7358 goto bad_0; /* :::::::::::::::::::: */
7359 }
7360
7361 bad_0: /* :::::::::::::::::::: */
7362 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", ffesta_tokens[0]);
7363 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7364
7365 bad_1: /* :::::::::::::::::::: */
7366 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", t);
7367 return (ffelexHandler) ffelex_swallow_tokens (t,
7368 (ffelexHandler) ffesta_zero); /* Invalid second token. */
7369
7370 bad_i: /* :::::::::::::::::::: */
7371 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", ffesta_tokens[0], i, t);
7372 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7373 }
7374
7375 /* ffestb_R1111_1_ -- "BLOCK" "DATA"
7376
7377 return ffestb_R1111_1_; // to lexer
7378
7379 Make sure the next token is a NAME, EOS, or SEMICOLON token. */
7380
7381 static ffelexHandler
7382 ffestb_R1111_1_ (ffelexToken t)
7383 {
7384 switch (ffelex_token_type (t))
7385 {
7386 case FFELEX_typeNAME:
7387 ffesta_tokens[1] = ffelex_token_use (t);
7388 return (ffelexHandler) ffestb_R1111_2_;
7389
7390 case FFELEX_typeEOS:
7391 case FFELEX_typeSEMICOLON:
7392 ffesta_tokens[1] = NULL;
7393 return (ffelexHandler) ffestb_R1111_2_ (t);
7394
7395 default:
7396 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", t);
7397 break;
7398 }
7399
7400 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7401 }
7402
7403 /* ffestb_R1111_2_ -- "BLOCK/DATA" NAME
7404
7405 return ffestb_R1111_2_; // to lexer
7406
7407 Make sure the next token is an EOS or SEMICOLON. */
7408
7409 static ffelexHandler
7410 ffestb_R1111_2_ (ffelexToken t)
7411 {
7412 switch (ffelex_token_type (t))
7413 {
7414 case FFELEX_typeEOS:
7415 case FFELEX_typeSEMICOLON:
7416 ffesta_confirmed ();
7417 if (!ffesta_is_inhibited ())
7418 ffestc_R1111 (ffesta_tokens[1]);
7419 if (ffesta_tokens[1] != NULL)
7420 ffelex_token_kill (ffesta_tokens[1]);
7421 return (ffelexHandler) ffesta_zero (t);
7422
7423 default:
7424 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", t);
7425 break;
7426 }
7427
7428 if (ffesta_tokens[1] != NULL)
7429 ffelex_token_kill (ffesta_tokens[1]);
7430 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7431 }
7432
7433 /* ffestb_R1212 -- Parse the CALL statement
7434
7435 return ffestb_R1212; // to lexer
7436
7437 Make sure the statement has a valid form for the CALL statement. If it
7438 does, implement the statement. */
7439
7440 ffelexHandler
7441 ffestb_R1212 (ffelexToken t)
7442 {
7443 ffeTokenLength i;
7444 unsigned const char *p;
7445 ffelexHandler next;
7446 ffelexToken nt;
7447
7448 switch (ffelex_token_type (ffesta_tokens[0]))
7449 {
7450 case FFELEX_typeNAME:
7451 if (ffesta_first_kw != FFESTR_firstCALL)
7452 goto bad_0; /* :::::::::::::::::::: */
7453 switch (ffelex_token_type (t))
7454 {
7455 case FFELEX_typeEOS:
7456 case FFELEX_typeSEMICOLON:
7457 case FFELEX_typeCOMMA:
7458 case FFELEX_typeCOLONCOLON:
7459 ffesta_confirmed (); /* Error, but clearly intended. */
7460 goto bad_1; /* :::::::::::::::::::: */
7461
7462 default:
7463 goto bad_1; /* :::::::::::::::::::: */
7464
7465 case FFELEX_typeNAME:
7466 break;
7467 }
7468 ffesta_confirmed ();
7469 return (ffelexHandler)
7470 (*((ffelexHandler)
7471 ffeexpr_lhs (ffesta_output_pool, FFEEXPR_contextSUBROUTINEREF,
7472 (ffeexprCallback) ffestb_R12121_)))
7473 (t);
7474
7475 case FFELEX_typeNAMES:
7476 if (ffesta_first_kw != FFESTR_firstCALL)
7477 goto bad_0; /* :::::::::::::::::::: */
7478 switch (ffelex_token_type (t))
7479 {
7480 case FFELEX_typeCOLONCOLON:
7481 case FFELEX_typeCOMMA:
7482 ffesta_confirmed (); /* Error, but clearly intended. */
7483 goto bad_1; /* :::::::::::::::::::: */
7484
7485 default:
7486 goto bad_1; /* :::::::::::::::::::: */
7487
7488 case FFELEX_typeOPEN_PAREN:
7489 break;
7490
7491 case FFELEX_typeEOS:
7492 case FFELEX_typeSEMICOLON:
7493 ffesta_confirmed ();
7494 break;
7495 }
7496 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCALL);
7497 if (!ffesrc_is_name_init (*p))
7498 goto bad_i; /* :::::::::::::::::::: */
7499 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
7500 next = (ffelexHandler)
7501 (*((ffelexHandler)
7502 ffeexpr_lhs (ffesta_output_pool, FFEEXPR_contextSUBROUTINEREF,
7503 (ffeexprCallback) ffestb_R12121_)))
7504 (nt);
7505 ffelex_token_kill (nt);
7506 return (ffelexHandler) (*next) (t);
7507
7508 default:
7509 goto bad_0; /* :::::::::::::::::::: */
7510 }
7511
7512 bad_0: /* :::::::::::::::::::: */
7513 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CALL", ffesta_tokens[0]);
7514 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7515
7516 bad_1: /* :::::::::::::::::::: */
7517 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CALL", t);
7518 return (ffelexHandler) ffelex_swallow_tokens (t,
7519 (ffelexHandler) ffesta_zero); /* Invalid second token. */
7520
7521 bad_i: /* :::::::::::::::::::: */
7522 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CALL", ffesta_tokens[0], i, t);
7523 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7524 }
7525
7526 /* ffestb_R12121_ -- "CALL" expr
7527
7528 (ffestb_R12121_) // to expression handler
7529
7530 Make sure the statement has a valid form for the CALL statement. If it
7531 does, implement the statement. */
7532
7533 static ffelexHandler
7534 ffestb_R12121_ (ffelexToken ft, ffebld expr, ffelexToken t)
7535 {
7536 switch (ffelex_token_type (t))
7537 {
7538 case FFELEX_typeEOS:
7539 case FFELEX_typeSEMICOLON:
7540 ffesta_confirmed ();
7541 if (expr == NULL)
7542 break;
7543 if (!ffesta_is_inhibited ())
7544 ffestc_R1212 (expr, ft);
7545 return (ffelexHandler) ffesta_zero (t);
7546
7547 default:
7548 break;
7549 }
7550
7551 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CALL", t);
7552 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7553 }
7554
7555 /* ffestb_R1227 -- Parse the RETURN statement
7556
7557 return ffestb_R1227; // to lexer
7558
7559 Make sure the statement has a valid form for the RETURN statement. If it
7560 does, implement the statement. */
7561
7562 ffelexHandler
7563 ffestb_R1227 (ffelexToken t)
7564 {
7565 ffelexHandler next;
7566
7567 switch (ffelex_token_type (ffesta_tokens[0]))
7568 {
7569 case FFELEX_typeNAME:
7570 if (ffesta_first_kw != FFESTR_firstRETURN)
7571 goto bad_0; /* :::::::::::::::::::: */
7572 switch (ffelex_token_type (t))
7573 {
7574 case FFELEX_typeCOMMA:
7575 case FFELEX_typeCOLONCOLON:
7576 ffesta_confirmed (); /* Error, but clearly intended. */
7577 goto bad_1; /* :::::::::::::::::::: */
7578
7579 case FFELEX_typeEQUALS:
7580 case FFELEX_typePOINTS:
7581 case FFELEX_typeCOLON:
7582 goto bad_1; /* :::::::::::::::::::: */
7583
7584 case FFELEX_typeEOS:
7585 case FFELEX_typeSEMICOLON:
7586 case FFELEX_typeNAME:
7587 case FFELEX_typeNUMBER:
7588 ffesta_confirmed ();
7589 break;
7590
7591 default:
7592 break;
7593 }
7594
7595 return (ffelexHandler) (*((ffelexHandler)
7596 ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextRETURN,
7597 (ffeexprCallback) ffestb_R12271_)))
7598 (t);
7599
7600 case FFELEX_typeNAMES:
7601 if (ffesta_first_kw != FFESTR_firstRETURN)
7602 goto bad_0; /* :::::::::::::::::::: */
7603 switch (ffelex_token_type (t))
7604 {
7605 case FFELEX_typeCOMMA:
7606 case FFELEX_typeCOLONCOLON:
7607 ffesta_confirmed (); /* Error, but clearly intended. */
7608 goto bad_1; /* :::::::::::::::::::: */
7609
7610 case FFELEX_typeEQUALS:
7611 case FFELEX_typePOINTS:
7612 case FFELEX_typeCOLON:
7613 goto bad_1; /* :::::::::::::::::::: */
7614
7615 case FFELEX_typeEOS:
7616 case FFELEX_typeSEMICOLON:
7617 ffesta_confirmed ();
7618 break;
7619
7620 default:
7621 break;
7622 }
7623 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
7624 FFEEXPR_contextRETURN, (ffeexprCallback) ffestb_R12271_);
7625 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
7626 FFESTR_firstlRETURN);
7627 if (next == NULL)
7628 return (ffelexHandler) ffelex_swallow_tokens (t,
7629 (ffelexHandler) ffesta_zero);
7630 return (ffelexHandler) (*next) (t);
7631
7632 default:
7633 goto bad_0; /* :::::::::::::::::::: */
7634 }
7635
7636 bad_0: /* :::::::::::::::::::: */
7637 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RETURN", ffesta_tokens[0]);
7638 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7639
7640 bad_1: /* :::::::::::::::::::: */
7641 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RETURN", t);
7642 return (ffelexHandler) ffelex_swallow_tokens (t,
7643 (ffelexHandler) ffesta_zero); /* Invalid second token. */
7644 }
7645
7646 /* ffestb_R12271_ -- "RETURN" expr
7647
7648 (ffestb_R12271_) // to expression handler
7649
7650 Make sure the next token is an EOS or SEMICOLON. */
7651
7652 static ffelexHandler
7653 ffestb_R12271_ (ffelexToken ft, ffebld expr, ffelexToken t)
7654 {
7655 switch (ffelex_token_type (t))
7656 {
7657 case FFELEX_typeEOS:
7658 case FFELEX_typeSEMICOLON:
7659 ffesta_confirmed ();
7660 if (!ffesta_is_inhibited ())
7661 ffestc_R1227 (expr, ft);
7662 return (ffelexHandler) ffesta_zero (t);
7663
7664 default:
7665 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RETURN", t);
7666 break;
7667 }
7668
7669 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7670 }
7671
7672 /* ffestb_R1228 -- Parse the CONTAINS statement
7673
7674 return ffestb_R1228; // to lexer
7675
7676 Make sure the statement has a valid form for the CONTAINS statement. If
7677 it does, implement the statement. */
7678
7679 #if FFESTR_F90
7680 ffelexHandler
7681 ffestb_R1228 (ffelexToken t)
7682 {
7683 const char *p;
7684 ffeTokenLength i;
7685
7686 switch (ffelex_token_type (ffesta_tokens[0]))
7687 {
7688 case FFELEX_typeNAME:
7689 if (ffesta_first_kw != FFESTR_firstCONTAINS)
7690 goto bad_0; /* :::::::::::::::::::: */
7691 break;
7692
7693 case FFELEX_typeNAMES:
7694 if (ffesta_first_kw != FFESTR_firstCONTAINS)
7695 goto bad_0; /* :::::::::::::::::::: */
7696 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlCONTAINS)
7697 {
7698 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCONTAINS);
7699 goto bad_i; /* :::::::::::::::::::: */
7700 }
7701 break;
7702
7703 default:
7704 goto bad_0; /* :::::::::::::::::::: */
7705 }
7706
7707 switch (ffelex_token_type (t))
7708 {
7709 case FFELEX_typeEOS:
7710 case FFELEX_typeSEMICOLON:
7711 ffesta_confirmed ();
7712 if (!ffesta_is_inhibited ())
7713 ffestc_R1228 ();
7714 return (ffelexHandler) ffesta_zero (t);
7715
7716 case FFELEX_typeCOMMA:
7717 case FFELEX_typeCOLONCOLON:
7718 ffesta_confirmed (); /* Error, but clearly intended. */
7719 goto bad_1; /* :::::::::::::::::::: */
7720
7721 default:
7722 goto bad_1; /* :::::::::::::::::::: */
7723 }
7724
7725 bad_0: /* :::::::::::::::::::: */
7726 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CONTAINS", ffesta_tokens[0]);
7727 return (ffelexHandler) ffelex_swallow_tokens (t,
7728 (ffelexHandler) ffesta_zero); /* Invalid first token. */
7729
7730 bad_1: /* :::::::::::::::::::: */
7731 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CONTAINS", t);
7732 return (ffelexHandler) ffelex_swallow_tokens (t,
7733 (ffelexHandler) ffesta_zero); /* Invalid second token. */
7734
7735 bad_i: /* :::::::::::::::::::: */
7736 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CONTAINS", ffesta_tokens[0], i, t);
7737 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7738 }
7739
7740 #endif
7741 /* ffestb_V009 -- Parse the UNION statement
7742
7743 return ffestb_V009; // to lexer
7744
7745 Make sure the statement has a valid form for the UNION statement. If
7746 it does, implement the statement. */
7747
7748 #if FFESTR_VXT
7749 ffelexHandler
7750 ffestb_V009 (ffelexToken t)
7751 {
7752 const char *p;
7753 ffeTokenLength i;
7754
7755 switch (ffelex_token_type (ffesta_tokens[0]))
7756 {
7757 case FFELEX_typeNAME:
7758 if (ffesta_first_kw != FFESTR_firstUNION)
7759 goto bad_0; /* :::::::::::::::::::: */
7760 break;
7761
7762 case FFELEX_typeNAMES:
7763 if (ffesta_first_kw != FFESTR_firstUNION)
7764 goto bad_0; /* :::::::::::::::::::: */
7765 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlUNION)
7766 {
7767 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlUNION);
7768 goto bad_i; /* :::::::::::::::::::: */
7769 }
7770 break;
7771
7772 default:
7773 goto bad_0; /* :::::::::::::::::::: */
7774 }
7775
7776 switch (ffelex_token_type (t))
7777 {
7778 case FFELEX_typeEOS:
7779 case FFELEX_typeSEMICOLON:
7780 ffesta_confirmed ();
7781 if (!ffesta_is_inhibited ())
7782 ffestc_V009 ();
7783 return (ffelexHandler) ffesta_zero (t);
7784
7785 case FFELEX_typeCOMMA:
7786 case FFELEX_typeCOLONCOLON:
7787 ffesta_confirmed (); /* Error, but clearly intended. */
7788 goto bad_1; /* :::::::::::::::::::: */
7789
7790 default:
7791 goto bad_1; /* :::::::::::::::::::: */
7792 }
7793
7794 bad_0: /* :::::::::::::::::::: */
7795 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "UNION", ffesta_tokens[0]);
7796 return (ffelexHandler) ffelex_swallow_tokens (t,
7797 (ffelexHandler) ffesta_zero); /* Invalid first token. */
7798
7799 bad_1: /* :::::::::::::::::::: */
7800 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "UNION", t);
7801 return (ffelexHandler) ffelex_swallow_tokens (t,
7802 (ffelexHandler) ffesta_zero); /* Invalid second token. */
7803
7804 bad_i: /* :::::::::::::::::::: */
7805 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "UNION", ffesta_tokens[0], i, t);
7806 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7807 }
7808
7809 #endif
7810 /* ffestb_construct -- Parse a construct name
7811
7812 return ffestb_construct; // to lexer
7813
7814 Make sure the statement can have a construct name (if-then-stmt, do-stmt,
7815 select-case-stmt). */
7816
7817 ffelexHandler
7818 ffestb_construct (ffelexToken t UNUSED)
7819 {
7820 /* This handler gets invoked only when token 0 is NAME/NAMES and token 1 is
7821 COLON. */
7822
7823 ffesta_confirmed ();
7824 ffelex_set_names (TRUE);
7825 return (ffelexHandler) ffestb_construct1_;
7826 }
7827
7828 /* ffestb_construct1_ -- NAME COLON
7829
7830 return ffestb_construct1_; // to lexer
7831
7832 Make sure we've got a NAME that is DO, DOWHILE, IF, SELECT, or SELECTCASE. */
7833
7834 static ffelexHandler
7835 ffestb_construct1_ (ffelexToken t)
7836 {
7837 ffelex_set_names (FALSE);
7838
7839 switch (ffelex_token_type (t))
7840 {
7841 case FFELEX_typeNAME:
7842 ffesta_first_kw = ffestr_first (t);
7843 switch (ffesta_first_kw)
7844 {
7845 case FFESTR_firstIF:
7846 ffestb_local_.construct.next = (ffelexHandler) ffestb_if;
7847 break;
7848
7849 case FFESTR_firstDO:
7850 ffestb_local_.construct.next = (ffelexHandler) ffestb_do;
7851 break;
7852
7853 case FFESTR_firstDOWHILE:
7854 ffestb_local_.construct.next = (ffelexHandler) ffestb_dowhile;
7855 break;
7856
7857 case FFESTR_firstSELECT:
7858 case FFESTR_firstSELECTCASE:
7859 ffestb_local_.construct.next = (ffelexHandler) ffestb_R809;
7860 break;
7861
7862 default:
7863 goto bad; /* :::::::::::::::::::: */
7864 }
7865 ffesta_construct_name = ffesta_tokens[0];
7866 ffesta_tokens[0] = ffelex_token_use (t);
7867 return (ffelexHandler) ffestb_construct2_;
7868
7869 case FFELEX_typeNAMES:
7870 ffesta_first_kw = ffestr_first (t);
7871 switch (ffesta_first_kw)
7872 {
7873 case FFESTR_firstIF:
7874 if (ffelex_token_length (t) != FFESTR_firstlIF)
7875 goto bad; /* :::::::::::::::::::: */
7876 ffestb_local_.construct.next = (ffelexHandler) ffestb_if;
7877 break;
7878
7879 case FFESTR_firstDO:
7880 ffestb_local_.construct.next = (ffelexHandler) ffestb_do;
7881 break;
7882
7883 case FFESTR_firstDOWHILE:
7884 if (ffelex_token_length (t) != FFESTR_firstlDOWHILE)
7885 goto bad; /* :::::::::::::::::::: */
7886 ffestb_local_.construct.next = (ffelexHandler) ffestb_dowhile;
7887 break;
7888
7889 case FFESTR_firstSELECTCASE:
7890 if (ffelex_token_length (t) != FFESTR_firstlSELECTCASE)
7891 goto bad; /* :::::::::::::::::::: */
7892 ffestb_local_.construct.next = (ffelexHandler) ffestb_R809;
7893 break;
7894
7895 default:
7896 goto bad; /* :::::::::::::::::::: */
7897 }
7898 ffesta_construct_name = ffesta_tokens[0];
7899 ffesta_tokens[0] = ffelex_token_use (t);
7900 return (ffelexHandler) ffestb_construct2_;
7901
7902 default:
7903 break;
7904 }
7905
7906 bad: /* :::::::::::::::::::: */
7907 ffesta_ffebad_2st (FFEBAD_INVALID_STMT_FORM, "CONSTRUCT",
7908 ffesta_tokens[0], t);
7909 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7910 }
7911
7912 /* ffestb_construct2_ -- NAME COLON "DO/DOWHILE/IF/SELECT/SELECTCASE"
7913
7914 return ffestb_construct2_; // to lexer
7915
7916 This extra step is needed to set ffesta_second_kw if the second token
7917 (here) is a NAME, so DO and SELECT can continue to expect it. */
7918
7919 static ffelexHandler
7920 ffestb_construct2_ (ffelexToken t)
7921 {
7922 if (ffelex_token_type (t) == FFELEX_typeNAME)
7923 ffesta_second_kw = ffestr_second (t);
7924 return (ffelexHandler) (*ffestb_local_.construct.next) (t);
7925 }
7926
7927 /* ffestb_heap -- Parse an ALLOCATE/DEALLOCATE statement
7928
7929 return ffestb_heap; // to lexer
7930
7931 Make sure the statement has a valid form for an ALLOCATE/DEALLOCATE
7932 statement. If it does, implement the statement. */
7933
7934 #if FFESTR_F90
7935 ffelexHandler
7936 ffestb_heap (ffelexToken t)
7937 {
7938 switch (ffelex_token_type (ffesta_tokens[0]))
7939 {
7940 case FFELEX_typeNAME:
7941 break;
7942
7943 case FFELEX_typeNAMES:
7944 if (ffelex_token_length (ffesta_tokens[0]) != ffestb_args.heap.len)
7945 goto bad_0; /* :::::::::::::::::::: */
7946 break;
7947
7948 default:
7949 goto bad_0; /* :::::::::::::::::::: */
7950 }
7951
7952 switch (ffelex_token_type (t))
7953 {
7954 case FFELEX_typeOPEN_PAREN:
7955 break;
7956
7957 case FFELEX_typeEOS:
7958 case FFELEX_typeSEMICOLON:
7959 case FFELEX_typeCOMMA:
7960 case FFELEX_typeCOLONCOLON:
7961 ffesta_confirmed (); /* Error, but clearly intended. */
7962 goto bad_1; /* :::::::::::::::::::: */
7963
7964 default:
7965 goto bad_1; /* :::::::::::::::::::: */
7966 }
7967
7968 ffestb_local_.heap.exprs = ffestt_exprlist_create ();
7969 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
7970 ffestb_args.heap.ctx,
7971 (ffeexprCallback) ffestb_heap1_);
7972
7973 bad_0: /* :::::::::::::::::::: */
7974 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, ffesta_tokens[0]);
7975 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7976
7977 bad_1: /* :::::::::::::::::::: */
7978 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
7979 return (ffelexHandler) ffelex_swallow_tokens (t,
7980 (ffelexHandler) ffesta_zero); /* Invalid second token. */
7981 }
7982
7983 /* ffestb_heap1_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN expr
7984
7985 (ffestb_heap1_) // to expression handler
7986
7987 Make sure the next token is COMMA. */
7988
7989 static ffelexHandler
7990 ffestb_heap1_ (ffelexToken ft, ffebld expr, ffelexToken t)
7991 {
7992 switch (ffelex_token_type (t))
7993 {
7994 case FFELEX_typeCOMMA:
7995 if (expr == NULL)
7996 break;
7997 ffestt_exprlist_append (ffestb_local_.heap.exprs, expr,
7998 ffelex_token_use (t));
7999 return (ffelexHandler) ffestb_heap2_;
8000
8001 case FFELEX_typeCLOSE_PAREN:
8002 if (expr == NULL)
8003 break;
8004 ffestt_exprlist_append (ffestb_local_.heap.exprs, expr,
8005 ffelex_token_use (t));
8006 ffesta_tokens[1] = NULL;
8007 ffestb_local_.heap.expr = NULL;
8008 return (ffelexHandler) ffestb_heap5_;
8009
8010 default:
8011 break;
8012 }
8013
8014 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
8015 ffestt_exprlist_kill (ffestb_local_.heap.exprs);
8016 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8017 }
8018
8019 /* ffestb_heap2_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN expr COMMA
8020
8021 return ffestb_heap2_; // to lexer
8022
8023 Make sure the next token is NAME. */
8024
8025 static ffelexHandler
8026 ffestb_heap2_ (ffelexToken t)
8027 {
8028 switch (ffelex_token_type (t))
8029 {
8030 case FFELEX_typeNAME:
8031 ffesta_tokens[1] = ffelex_token_use (t);
8032 return (ffelexHandler) ffestb_heap3_;
8033
8034 default:
8035 break;
8036 }
8037
8038 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
8039 ffestt_exprlist_kill (ffestb_local_.heap.exprs);
8040 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8041 }
8042
8043 /* ffestb_heap3_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN expr COMMA NAME
8044
8045 return ffestb_heap3_; // to lexer
8046
8047 If token is EQUALS, make sure NAME was "STAT" and handle STAT variable;
8048 else pass NAME and token to expression handler. */
8049
8050 static ffelexHandler
8051 ffestb_heap3_ (ffelexToken t)
8052 {
8053 ffelexHandler next;
8054
8055 switch (ffelex_token_type (t))
8056 {
8057 case FFELEX_typeEQUALS:
8058 ffesta_confirmed ();
8059 if (ffestr_other (ffesta_tokens[1]) != FFESTR_otherSTAT)
8060 break;
8061 ffelex_token_kill (ffesta_tokens[1]);
8062 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
8063 FFEEXPR_contextHEAPSTAT,
8064 (ffeexprCallback) ffestb_heap4_);
8065
8066 default:
8067 next = (ffelexHandler)
8068 (*((ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
8069 ffestb_args.heap.ctx,
8070 (ffeexprCallback) ffestb_heap1_)))
8071 (ffesta_tokens[1]);
8072 ffelex_token_kill (ffesta_tokens[1]);
8073 return (ffelexHandler) (*next) (t);
8074 }
8075
8076 ffelex_token_kill (ffesta_tokens[1]);
8077 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
8078 ffestt_exprlist_kill (ffestb_local_.heap.exprs);
8079 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8080 }
8081
8082 /* ffestb_heap4_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN ... COMMA "STAT" EQUALS
8083 expr
8084
8085 (ffestb_heap4_) // to expression handler
8086
8087 Make sure the next token is CLOSE_PAREN. */
8088
8089 static ffelexHandler
8090 ffestb_heap4_ (ffelexToken ft, ffebld expr, ffelexToken t)
8091 {
8092 switch (ffelex_token_type (t))
8093 {
8094 case FFELEX_typeCLOSE_PAREN:
8095 if (expr == NULL)
8096 break;
8097 ffesta_tokens[1] = ffelex_token_use (ft);
8098 ffestb_local_.heap.expr = expr;
8099 return (ffelexHandler) ffestb_heap5_;
8100
8101 default:
8102 break;
8103 }
8104
8105 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
8106 ffestt_exprlist_kill (ffestb_local_.heap.exprs);
8107 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8108 }
8109
8110 /* ffestb_heap5_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN ... CLOSE_PAREN
8111
8112 return ffestb_heap5_; // to lexer
8113
8114 Make sure the next token is EOS/SEMICOLON. */
8115
8116 static ffelexHandler
8117 ffestb_heap5_ (ffelexToken t)
8118 {
8119 switch (ffelex_token_type (t))
8120 {
8121 case FFELEX_typeEOS:
8122 case FFELEX_typeSEMICOLON:
8123 ffesta_confirmed ();
8124 if (!ffesta_is_inhibited ())
8125 if (ffesta_first_kw == FFESTR_firstALLOCATE)
8126 ffestc_R620 (ffestb_local_.heap.exprs, ffestb_local_.heap.expr,
8127 ffesta_tokens[1]);
8128 else
8129 ffestc_R625 (ffestb_local_.heap.exprs, ffestb_local_.heap.expr,
8130 ffesta_tokens[1]);
8131 ffestt_exprlist_kill (ffestb_local_.heap.exprs);
8132 if (ffesta_tokens[1] != NULL)
8133 ffelex_token_kill (ffesta_tokens[1]);
8134 return (ffelexHandler) ffesta_zero (t);
8135
8136 default:
8137 break;
8138 }
8139
8140 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
8141 ffestt_exprlist_kill (ffestb_local_.heap.exprs);
8142 if (ffesta_tokens[1] != NULL)
8143 ffelex_token_kill (ffesta_tokens[1]);
8144 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8145 }
8146
8147 #endif
8148 /* ffestb_module -- Parse the MODULEPROCEDURE statement
8149
8150 return ffestb_module; // to lexer
8151
8152 Make sure the statement has a valid form for the MODULEPROCEDURE statement.
8153 If it does, implement the statement.
8154
8155 31-May-90 JCB 1.1
8156 Confirm NAME==MODULE followed by standard four invalid tokens, so we
8157 get decent message if somebody forgets that MODULE requires a name. */
8158
8159 #if FFESTR_F90
8160 ffelexHandler
8161 ffestb_module (ffelexToken t)
8162 {
8163 ffeTokenLength i;
8164 const char *p;
8165 ffelexToken nt;
8166 ffelexToken mt; /* Name in MODULE PROCEDUREname, i.e.
8167 includes "PROCEDURE". */
8168
8169 switch (ffelex_token_type (ffesta_tokens[0]))
8170 {
8171 case FFELEX_typeNAME:
8172 if (ffesta_first_kw != FFESTR_firstMODULE)
8173 goto bad_0; /* :::::::::::::::::::: */
8174 switch (ffelex_token_type (t))
8175 {
8176 case FFELEX_typeNAME:
8177 break;
8178
8179 case FFELEX_typeCOLONCOLON:
8180 case FFELEX_typeCOMMA:
8181 case FFELEX_typeEOS:
8182 case FFELEX_typeSEMICOLON:
8183 ffesta_confirmed ();
8184 goto bad_1m; /* :::::::::::::::::::: */
8185
8186 default:
8187 goto bad_1m; /* :::::::::::::::::::: */
8188 }
8189
8190 ffesta_confirmed ();
8191 if (ffesta_second_kw != FFESTR_secondPROCEDURE)
8192 {
8193 ffesta_tokens[1] = ffelex_token_use (t);
8194 return (ffelexHandler) ffestb_module3_;
8195 }
8196 ffestb_local_.moduleprocedure.started = FALSE;
8197 ffesta_tokens[1] = ffelex_token_use (t);
8198 return (ffelexHandler) ffestb_module1_;
8199
8200 case FFELEX_typeNAMES:
8201 p = ffelex_token_text (ffesta_tokens[0])
8202 + (i = FFESTR_firstlMODULEPROCEDURE);
8203 if ((ffesta_first_kw == FFESTR_firstMODULE)
8204 || ((ffesta_first_kw == FFESTR_firstMODULEPROCEDURE)
8205 && !ffesrc_is_name_init (*p)))
8206 { /* Definitely not "MODULE PROCEDURE name". */
8207 switch (ffelex_token_type (t))
8208 {
8209 case FFELEX_typeCOMMA:
8210 case FFELEX_typeCOLONCOLON:
8211 ffesta_confirmed (); /* Error, but clearly intended. */
8212 goto bad_1m; /* :::::::::::::::::::: */
8213
8214 default:
8215 goto bad_1m; /* :::::::::::::::::::: */
8216
8217 case FFELEX_typeEOS:
8218 case FFELEX_typeSEMICOLON:
8219 ffesta_confirmed ();
8220 break;
8221 }
8222 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlMODULE);
8223 if (!ffesrc_is_name_init (*p))
8224 goto bad_im; /* :::::::::::::::::::: */
8225 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
8226 if (!ffesta_is_inhibited ())
8227 ffestc_R1105 (nt);
8228 ffelex_token_kill (nt);
8229 return (ffelexHandler) ffesta_zero (t);
8230 }
8231
8232 /* Here we know that we're indeed looking at a MODULEPROCEDURE
8233 statement rather than MODULE and that the character following
8234 MODULEPROCEDURE in the NAMES token is a valid first character for a
8235 NAME. This means that unless the second token is COMMA, we have an
8236 ambiguous statement that can be read either as MODULE PROCEDURE name
8237 or MODULE PROCEDUREname, the former being an R1205, the latter an
8238 R1105. */
8239
8240 if (ffesta_first_kw != FFESTR_firstMODULEPROCEDURE)
8241 goto bad_0; /* :::::::::::::::::::: */
8242 switch (ffelex_token_type (t))
8243 {
8244 case FFELEX_typeCOLONCOLON:
8245 ffesta_confirmed (); /* Error, but clearly intended. */
8246 goto bad_1; /* :::::::::::::::::::: */
8247
8248 default:
8249 goto bad_1; /* :::::::::::::::::::: */
8250
8251 case FFELEX_typeCOMMA: /* Aha, clearly not MODULE PROCEDUREname. */
8252 ffesta_confirmed ();
8253 ffestb_local_.moduleprocedure.started = FALSE;
8254 ffesta_tokens[1]
8255 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
8256 return (ffelexHandler) ffestb_module2_ (t);
8257
8258 case FFELEX_typeEOS: /* MODULE PROCEDURE name or MODULE
8259 PROCEDUREname. */
8260 case FFELEX_typeSEMICOLON:
8261 ffesta_confirmed ();
8262 break;
8263 }
8264 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
8265 mt = ffelex_token_name_from_names (ffesta_tokens[0], FFESTR_firstlMODULE,
8266 0);
8267 if (!ffesta_is_inhibited ())
8268 ffestc_module (mt, nt); /* Implement ambiguous statement. */
8269 ffelex_token_kill (nt);
8270 ffelex_token_kill (mt);
8271 return (ffelexHandler) ffesta_zero (t);
8272
8273 default:
8274 goto bad_0; /* :::::::::::::::::::: */
8275 }
8276
8277 bad_0: /* :::::::::::::::::::: */
8278 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", ffesta_tokens[0]);
8279 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8280
8281 bad_1: /* :::::::::::::::::::: */
8282 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", t);
8283 return (ffelexHandler) ffelex_swallow_tokens (t,
8284 (ffelexHandler) ffesta_zero); /* Invalid second token. */
8285
8286 bad_1m: /* :::::::::::::::::::: */
8287 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE", t);
8288 return (ffelexHandler) ffelex_swallow_tokens (t,
8289 (ffelexHandler) ffesta_zero); /* Invalid second token. */
8290
8291 bad_im: /* :::::::::::::::::::: */
8292 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "MODULE", ffesta_tokens[0], i, t);
8293 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8294 }
8295
8296 /* ffestb_module1_ -- "MODULEPROCEDURE" or "MODULE" "PROCEDURE"
8297
8298 return ffestb_module1_; // to lexer
8299
8300 Make sure the statement has a valid form for the MODULEPROCEDURE statement. If it
8301 does, implement the statement. */
8302
8303 static ffelexHandler
8304 ffestb_module1_ (ffelexToken t)
8305 {
8306 switch (ffelex_token_type (t))
8307 {
8308 case FFELEX_typeNAME:
8309 if (!ffestb_local_.moduleprocedure.started
8310 && (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME))
8311 {
8312 ffesta_confirmed ();
8313 ffelex_token_kill (ffesta_tokens[1]);
8314 }
8315 ffesta_tokens[1] = ffelex_token_use (t);
8316 return (ffelexHandler) ffestb_module2_;
8317
8318 case FFELEX_typeEOS:
8319 case FFELEX_typeSEMICOLON:
8320 if (ffestb_local_.moduleprocedure.started)
8321 break; /* Error if we've already seen NAME COMMA. */
8322 ffesta_confirmed ();
8323 if (!ffesta_is_inhibited ())
8324 ffestc_R1105 (ffesta_tokens[1]);
8325 ffelex_token_kill (ffesta_tokens[1]);
8326 return (ffelexHandler) ffesta_zero (t);
8327
8328 case FFELEX_typeCOMMA:
8329 case FFELEX_typeCOLONCOLON:
8330 ffesta_confirmed (); /* Error, but clearly intended. */
8331 break;
8332
8333 default:
8334 break;
8335 }
8336
8337 if (ffestb_local_.moduleprocedure.started && !ffesta_is_inhibited ())
8338 ffestc_R1205_finish ();
8339 else if (!ffestb_local_.moduleprocedure.started)
8340 ffelex_token_kill (ffesta_tokens[1]);
8341 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", t);
8342 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8343 }
8344
8345 /* ffestb_module2_ -- "MODULE/PROCEDURE" NAME
8346
8347 return ffestb_module2_; // to lexer
8348
8349 Make sure the statement has a valid form for the MODULEPROCEDURE statement. If it
8350 does, implement the statement. */
8351
8352 static ffelexHandler
8353 ffestb_module2_ (ffelexToken t)
8354 {
8355 switch (ffelex_token_type (t))
8356 {
8357 case FFELEX_typeEOS:
8358 case FFELEX_typeSEMICOLON:
8359 if (!ffestb_local_.moduleprocedure.started)
8360 {
8361 ffesta_confirmed ();
8362 if (!ffesta_is_inhibited ())
8363 ffestc_R1205_start ();
8364 }
8365 if (!ffesta_is_inhibited ())
8366 {
8367 ffestc_R1205_item (ffesta_tokens[1]);
8368 ffestc_R1205_finish ();
8369 }
8370 ffelex_token_kill (ffesta_tokens[1]);
8371 return (ffelexHandler) ffesta_zero (t);
8372
8373 case FFELEX_typeCOMMA:
8374 if (!ffestb_local_.moduleprocedure.started)
8375 {
8376 ffestb_local_.moduleprocedure.started = TRUE;
8377 ffesta_confirmed ();
8378 if (!ffesta_is_inhibited ())
8379 ffestc_R1205_start ();
8380 }
8381 if (!ffesta_is_inhibited ())
8382 ffestc_R1205_item (ffesta_tokens[1]);
8383 ffelex_token_kill (ffesta_tokens[1]);
8384 return (ffelexHandler) ffestb_module1_;
8385
8386 default:
8387 break;
8388 }
8389
8390 if (ffestb_local_.moduleprocedure.started && !ffesta_is_inhibited ())
8391 ffestc_R1205_finish ();
8392 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", t);
8393 ffelex_token_kill (ffesta_tokens[1]);
8394 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8395 }
8396
8397 /* ffestb_module3_ -- "MODULE" NAME
8398
8399 return ffestb_module3_; // to lexer
8400
8401 Make sure the statement has a valid form for the MODULE statement. If it
8402 does, implement the statement. */
8403
8404 static ffelexHandler
8405 ffestb_module3_ (ffelexToken t)
8406 {
8407 switch (ffelex_token_type (t))
8408 {
8409 case FFELEX_typeEOS:
8410 case FFELEX_typeSEMICOLON:
8411 if (!ffesta_is_inhibited ())
8412 ffestc_R1105 (ffesta_tokens[1]);
8413 ffelex_token_kill (ffesta_tokens[1]);
8414 return (ffelexHandler) ffesta_zero (t);
8415
8416 default:
8417 break;
8418 }
8419
8420 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE", t);
8421 ffelex_token_kill (ffesta_tokens[1]);
8422 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8423 }
8424
8425 #endif
8426 /* ffestb_R809 -- Parse the SELECTCASE statement
8427
8428 return ffestb_R809; // to lexer
8429
8430 Make sure the statement has a valid form for the SELECTCASE statement.
8431 If it does, implement the statement. */
8432
8433 ffelexHandler
8434 ffestb_R809 (ffelexToken t)
8435 {
8436 ffeTokenLength i;
8437 const char *p;
8438
8439 switch (ffelex_token_type (ffesta_tokens[0]))
8440 {
8441 case FFELEX_typeNAME:
8442 switch (ffesta_first_kw)
8443 {
8444 case FFESTR_firstSELECT:
8445 if ((ffelex_token_type (t) != FFELEX_typeNAME)
8446 || (ffesta_second_kw != FFESTR_secondCASE))
8447 goto bad_1; /* :::::::::::::::::::: */
8448 ffesta_confirmed ();
8449 return (ffelexHandler) ffestb_R8091_;
8450
8451 case FFESTR_firstSELECTCASE:
8452 return (ffelexHandler) ffestb_R8091_ (t);
8453
8454 default:
8455 goto bad_0; /* :::::::::::::::::::: */
8456 }
8457
8458 case FFELEX_typeNAMES:
8459 if (ffesta_first_kw != FFESTR_firstSELECTCASE)
8460 goto bad_0; /* :::::::::::::::::::: */
8461 switch (ffelex_token_type (t))
8462 {
8463 case FFELEX_typeCOMMA:
8464 case FFELEX_typeEOS:
8465 case FFELEX_typeSEMICOLON:
8466 case FFELEX_typeCOLONCOLON:
8467 ffesta_confirmed (); /* Error, but clearly intended. */
8468 goto bad_1; /* :::::::::::::::::::: */
8469
8470 default:
8471 goto bad_1; /* :::::::::::::::::::: */
8472
8473 case FFELEX_typeOPEN_PAREN:
8474 break;
8475 }
8476 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSELECTCASE);
8477 if (*p != '\0')
8478 goto bad_i; /* :::::::::::::::::::: */
8479 return (ffelexHandler) ffestb_R8091_ (t);
8480
8481 default:
8482 goto bad_0; /* :::::::::::::::::::: */
8483 }
8484
8485 bad_0: /* :::::::::::::::::::: */
8486 if (ffesta_construct_name != NULL)
8487 {
8488 ffelex_token_kill (ffesta_construct_name);
8489 ffesta_construct_name = NULL;
8490 }
8491 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", ffesta_tokens[0]);
8492 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8493
8494 bad_1: /* :::::::::::::::::::: */
8495 if (ffesta_construct_name != NULL)
8496 {
8497 ffelex_token_kill (ffesta_construct_name);
8498 ffesta_construct_name = NULL;
8499 }
8500 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", t);
8501 return (ffelexHandler) ffelex_swallow_tokens (t,
8502 (ffelexHandler) ffesta_zero); /* Invalid second token. */
8503
8504 bad_i: /* :::::::::::::::::::: */
8505 if (ffesta_construct_name != NULL)
8506 {
8507 ffelex_token_kill (ffesta_construct_name);
8508 ffesta_construct_name = NULL;
8509 }
8510 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", ffesta_tokens[0], i, t);
8511 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8512 }
8513
8514 /* ffestb_R8091_ -- "SELECTCASE" or "SELECT" "CASE"
8515
8516 return ffestb_R8091_; // to lexer
8517
8518 Make sure the statement has a valid form for the SELECTCASE statement. If it
8519 does, implement the statement. */
8520
8521 static ffelexHandler
8522 ffestb_R8091_ (ffelexToken t)
8523 {
8524 switch (ffelex_token_type (t))
8525 {
8526 case FFELEX_typeOPEN_PAREN:
8527 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
8528 FFEEXPR_contextSELECTCASE, (ffeexprCallback) ffestb_R8092_);
8529
8530 case FFELEX_typeEOS:
8531 case FFELEX_typeSEMICOLON:
8532 case FFELEX_typeCOMMA:
8533 case FFELEX_typeCOLONCOLON:
8534 ffesta_confirmed (); /* Error, but clearly intended. */
8535 break;
8536
8537 default:
8538 break;
8539 }
8540
8541 if (ffesta_construct_name != NULL)
8542 {
8543 ffelex_token_kill (ffesta_construct_name);
8544 ffesta_construct_name = NULL;
8545 }
8546 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", t);
8547 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8548 }
8549
8550 /* ffestb_R8092_ -- "SELECT/CASE" OPEN_PAREN expr
8551
8552 (ffestb_R8092_) // to expression handler
8553
8554 Make sure the statement has a valid form for the SELECTCASE statement. If it
8555 does, implement the statement. */
8556
8557 static ffelexHandler
8558 ffestb_R8092_ (ffelexToken ft, ffebld expr, ffelexToken t)
8559 {
8560 switch (ffelex_token_type (t))
8561 {
8562 case FFELEX_typeCLOSE_PAREN:
8563 if (expr == NULL)
8564 break;
8565 ffesta_tokens[1] = ffelex_token_use (ft);
8566 ffestb_local_.selectcase.expr = expr;
8567 return (ffelexHandler) ffestb_R8093_;
8568
8569 default:
8570 break;
8571 }
8572
8573 if (ffesta_construct_name != NULL)
8574 {
8575 ffelex_token_kill (ffesta_construct_name);
8576 ffesta_construct_name = NULL;
8577 }
8578 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", t);
8579 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8580 }
8581
8582 /* ffestb_R8093_ -- "SELECT/CASE" OPEN_PAREN expr CLOSE_PAREN
8583
8584 return ffestb_R8093_; // to lexer
8585
8586 Make sure the statement has a valid form for the SELECTCASE statement. If it
8587 does, implement the statement. */
8588
8589 static ffelexHandler
8590 ffestb_R8093_ (ffelexToken t)
8591 {
8592 switch (ffelex_token_type (t))
8593 {
8594 case FFELEX_typeEOS:
8595 case FFELEX_typeSEMICOLON:
8596 ffesta_confirmed ();
8597 if (!ffesta_is_inhibited ())
8598 ffestc_R809 (ffesta_construct_name, ffestb_local_.selectcase.expr,
8599 ffesta_tokens[1]);
8600 ffelex_token_kill (ffesta_tokens[1]);
8601 if (ffesta_construct_name != NULL)
8602 {
8603 ffelex_token_kill (ffesta_construct_name);
8604 ffesta_construct_name = NULL;
8605 }
8606 return ffesta_zero (t);
8607
8608 case FFELEX_typeCOMMA:
8609 case FFELEX_typeCOLONCOLON:
8610 ffesta_confirmed (); /* Error, but clearly intended. */
8611 break;
8612
8613 default:
8614 break;
8615 }
8616
8617 ffelex_token_kill (ffesta_tokens[1]);
8618 if (ffesta_construct_name != NULL)
8619 {
8620 ffelex_token_kill (ffesta_construct_name);
8621 ffesta_construct_name = NULL;
8622 }
8623 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", t);
8624 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8625 }
8626
8627 /* ffestb_R810 -- Parse the CASE statement
8628
8629 return ffestb_R810; // to lexer
8630
8631 Make sure the statement has a valid form for the CASE statement.
8632 If it does, implement the statement. */
8633
8634 ffelexHandler
8635 ffestb_R810 (ffelexToken t)
8636 {
8637 ffeTokenLength i;
8638 unsigned const char *p;
8639
8640 switch (ffelex_token_type (ffesta_tokens[0]))
8641 {
8642 case FFELEX_typeNAME:
8643 if (ffesta_first_kw != FFESTR_firstCASE)
8644 goto bad_0; /* :::::::::::::::::::: */
8645 switch (ffelex_token_type (t))
8646 {
8647 case FFELEX_typeCOMMA:
8648 case FFELEX_typeEOS:
8649 case FFELEX_typeSEMICOLON:
8650 case FFELEX_typeCOLONCOLON:
8651 ffesta_confirmed (); /* Error, but clearly intended. */
8652 goto bad_1; /* :::::::::::::::::::: */
8653
8654 default:
8655 goto bad_1; /* :::::::::::::::::::: */
8656
8657 case FFELEX_typeNAME:
8658 ffesta_confirmed ();
8659 if (ffesta_second_kw != FFESTR_secondDEFAULT)
8660 goto bad_1; /* :::::::::::::::::::: */
8661 ffestb_local_.case_stmt.cases = NULL;
8662 return (ffelexHandler) ffestb_R8101_;
8663
8664 case FFELEX_typeOPEN_PAREN:
8665 ffestb_local_.case_stmt.cases = ffestt_caselist_create ();
8666 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
8667 FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8103_);
8668 }
8669
8670 case FFELEX_typeNAMES:
8671 switch (ffesta_first_kw)
8672 {
8673 case FFESTR_firstCASEDEFAULT:
8674 switch (ffelex_token_type (t))
8675 {
8676 case FFELEX_typeCOMMA:
8677 case FFELEX_typeCOLONCOLON:
8678 ffesta_confirmed (); /* Error, but clearly intended. */
8679 goto bad_1; /* :::::::::::::::::::: */
8680
8681 default:
8682 goto bad_1; /* :::::::::::::::::::: */
8683
8684 case FFELEX_typeEOS:
8685 case FFELEX_typeSEMICOLON:
8686 ffesta_confirmed ();
8687 break;
8688 }
8689 ffestb_local_.case_stmt.cases = NULL;
8690 p = ffelex_token_text (ffesta_tokens[0])
8691 + (i = FFESTR_firstlCASEDEFAULT);
8692 if (*p == '\0')
8693 return (ffelexHandler) ffestb_R8101_ (t);
8694 if (!ffesrc_is_name_init (*p))
8695 goto bad_i; /* :::::::::::::::::::: */
8696 ffesta_tokens[1] = ffelex_token_name_from_names (ffesta_tokens[0], i,
8697 0);
8698 return (ffelexHandler) ffestb_R8102_ (t);
8699
8700 case FFESTR_firstCASE:
8701 break;
8702
8703 default:
8704 goto bad_0; /* :::::::::::::::::::: */
8705 }
8706
8707 switch (ffelex_token_type (t))
8708 {
8709 case FFELEX_typeCOMMA:
8710 case FFELEX_typeEOS:
8711 case FFELEX_typeSEMICOLON:
8712 case FFELEX_typeCOLONCOLON:
8713 ffesta_confirmed (); /* Error, but clearly intended. */
8714 goto bad_1; /* :::::::::::::::::::: */
8715
8716 default:
8717 goto bad_1; /* :::::::::::::::::::: */
8718
8719 case FFELEX_typeOPEN_PAREN:
8720 break;
8721 }
8722 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCASE);
8723 if (*p != '\0')
8724 goto bad_i; /* :::::::::::::::::::: */
8725 ffestb_local_.case_stmt.cases = ffestt_caselist_create ();
8726 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
8727 FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8103_);
8728
8729 default:
8730 goto bad_0; /* :::::::::::::::::::: */
8731 }
8732
8733 bad_0: /* :::::::::::::::::::: */
8734 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", ffesta_tokens[0]);
8735 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8736
8737 bad_1: /* :::::::::::::::::::: */
8738 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
8739 return (ffelexHandler) ffelex_swallow_tokens (t,
8740 (ffelexHandler) ffesta_zero); /* Invalid second token. */
8741
8742 bad_i: /* :::::::::::::::::::: */
8743 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CASE", ffesta_tokens[0], i, t);
8744 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8745 }
8746
8747 /* ffestb_R8101_ -- "CASE" case-selector
8748
8749 return ffestb_R8101_; // to lexer
8750
8751 Make sure the statement has a valid form for the CASE statement. If it
8752 does, implement the statement. */
8753
8754 static ffelexHandler
8755 ffestb_R8101_ (ffelexToken t)
8756 {
8757 switch (ffelex_token_type (t))
8758 {
8759 case FFELEX_typeNAME:
8760 ffesta_tokens[1] = ffelex_token_use (t);
8761 return (ffelexHandler) ffestb_R8102_;
8762
8763 case FFELEX_typeEOS:
8764 case FFELEX_typeSEMICOLON:
8765 ffesta_tokens[1] = NULL;
8766 return (ffelexHandler) ffestb_R8102_ (t);
8767
8768 case FFELEX_typeCOMMA:
8769 case FFELEX_typeCOLONCOLON:
8770 ffesta_confirmed (); /* Error, but clearly intended. */
8771 break;
8772
8773 default:
8774 break;
8775 }
8776
8777 if (ffestb_local_.case_stmt.cases != NULL)
8778 ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
8779 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
8780 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8781 }
8782
8783 /* ffestb_R8102_ -- "CASE" case-selector [NAME]
8784
8785 return ffestb_R8102_; // to lexer
8786
8787 Make sure the statement has a valid form for the CASE statement. If it
8788 does, implement the statement. */
8789
8790 static ffelexHandler
8791 ffestb_R8102_ (ffelexToken t)
8792 {
8793 switch (ffelex_token_type (t))
8794 {
8795 case FFELEX_typeEOS:
8796 case FFELEX_typeSEMICOLON:
8797 ffesta_confirmed ();
8798 if (!ffesta_is_inhibited ())
8799 ffestc_R810 (ffestb_local_.case_stmt.cases, ffesta_tokens[1]);
8800 if (ffestb_local_.case_stmt.cases != NULL)
8801 ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
8802 if (ffesta_tokens[1] != NULL)
8803 ffelex_token_kill (ffesta_tokens[1]);
8804 return (ffelexHandler) ffesta_zero (t);
8805
8806 case FFELEX_typeCOMMA:
8807 case FFELEX_typeCOLONCOLON:
8808 ffesta_confirmed (); /* Error, but clearly intended. */
8809 break;
8810
8811 default:
8812 break;
8813 }
8814
8815 if (ffestb_local_.case_stmt.cases != NULL)
8816 ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
8817 if (ffesta_tokens[1] != NULL)
8818 ffelex_token_kill (ffesta_tokens[1]);
8819 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
8820 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8821 }
8822
8823 /* ffestb_R8103_ -- "CASE" OPEN_PAREN expr
8824
8825 (ffestb_R8103_) // to expression handler
8826
8827 Make sure the statement has a valid form for the CASE statement. If it
8828 does, implement the statement. */
8829
8830 static ffelexHandler
8831 ffestb_R8103_ (ffelexToken ft, ffebld expr, ffelexToken t)
8832 {
8833 switch (ffelex_token_type (t))
8834 {
8835 case FFELEX_typeCLOSE_PAREN:
8836 ffestt_caselist_append (ffestb_local_.case_stmt.cases, FALSE, expr, NULL,
8837 ffelex_token_use (ft));
8838 return (ffelexHandler) ffestb_R8101_;
8839
8840 case FFELEX_typeCOMMA:
8841 ffestt_caselist_append (ffestb_local_.case_stmt.cases, FALSE, expr, NULL,
8842 ffelex_token_use (ft));
8843 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
8844 FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8103_);
8845
8846 case FFELEX_typeCOLON:
8847 ffestt_caselist_append (ffestb_local_.case_stmt.cases, TRUE, expr, NULL,
8848 ffelex_token_use (ft)); /* NULL second expr for
8849 now, just plug in. */
8850 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
8851 FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8104_);
8852
8853 default:
8854 break;
8855 }
8856
8857 ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
8858 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
8859 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8860 }
8861
8862 /* ffestb_R8104_ -- "CASE" OPEN_PAREN expr COLON expr
8863
8864 (ffestb_R8104_) // to expression handler
8865
8866 Make sure the statement has a valid form for the CASE statement. If it
8867 does, implement the statement. */
8868
8869 static ffelexHandler
8870 ffestb_R8104_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
8871 {
8872 switch (ffelex_token_type (t))
8873 {
8874 case FFELEX_typeCLOSE_PAREN:
8875 ffestb_local_.case_stmt.cases->previous->expr2 = expr;
8876 return (ffelexHandler) ffestb_R8101_;
8877
8878 case FFELEX_typeCOMMA:
8879 ffestb_local_.case_stmt.cases->previous->expr2 = expr;
8880 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
8881 FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8103_);
8882
8883 default:
8884 break;
8885 }
8886
8887 ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
8888 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
8889 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8890 }
8891
8892 /* ffestb_R1001 -- Parse a FORMAT statement
8893
8894 return ffestb_R1001; // to lexer
8895
8896 Make sure the statement has a valid form for an FORMAT statement.
8897 If it does, implement the statement. */
8898
8899 ffelexHandler
8900 ffestb_R1001 (ffelexToken t)
8901 {
8902 ffesttFormatList f;
8903
8904 switch (ffelex_token_type (ffesta_tokens[0]))
8905 {
8906 case FFELEX_typeNAME:
8907 if (ffesta_first_kw != FFESTR_firstFORMAT)
8908 goto bad_0; /* :::::::::::::::::::: */
8909 break;
8910
8911 case FFELEX_typeNAMES:
8912 if (ffesta_first_kw != FFESTR_firstFORMAT)
8913 goto bad_0; /* :::::::::::::::::::: */
8914 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlFORMAT)
8915 goto bad_0; /* :::::::::::::::::::: */
8916 break;
8917
8918 default:
8919 goto bad_0; /* :::::::::::::::::::: */
8920 }
8921
8922 switch (ffelex_token_type (t))
8923 {
8924 case FFELEX_typeOPEN_PAREN:
8925 ffestb_local_.format.complained = FALSE;
8926 ffestb_local_.format.f = NULL; /* No parent yet. */
8927 ffestb_local_.format.f = ffestt_formatlist_create (NULL,
8928 ffelex_token_use (t));
8929 ffelex_set_names_pure (TRUE); /* Have even free-form lexer give us
8930 NAMES. */
8931 return (ffelexHandler) ffestb_R10011_;
8932
8933 case FFELEX_typeOPEN_ARRAY:/* "(/". */
8934 ffesta_confirmed ();
8935 ffestb_local_.format.complained = FALSE;
8936 ffestb_local_.format.f = ffestt_formatlist_create (NULL,
8937 ffelex_token_use (t));
8938 f = ffestt_formatlist_append (ffestb_local_.format.f);
8939 f->type = FFESTP_formattypeSLASH;
8940 f->t = ffelex_token_use (t);
8941 f->u.R1010.val.present = FALSE;
8942 f->u.R1010.val.rtexpr = FALSE;
8943 f->u.R1010.val.t = NULL;
8944 f->u.R1010.val.u.unsigned_val = 1;
8945 ffelex_set_names_pure (TRUE); /* Have even free-form lexer give us
8946 NAMES. */
8947 return (ffelexHandler) ffestb_R100112_;
8948
8949 case FFELEX_typeEOS:
8950 case FFELEX_typeSEMICOLON:
8951 case FFELEX_typeCOMMA:
8952 case FFELEX_typeCOLONCOLON:
8953 ffesta_confirmed (); /* Error, but clearly intended. */
8954 goto bad_1; /* :::::::::::::::::::: */
8955
8956 default:
8957 goto bad_1; /* :::::::::::::::::::: */
8958 }
8959
8960 bad_0: /* :::::::::::::::::::: */
8961 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", ffesta_tokens[0]);
8962 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
8963
8964 bad_1: /* :::::::::::::::::::: */
8965 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
8966 return (ffelexHandler) ffelex_swallow_tokens (t,
8967 (ffelexHandler) ffesta_zero); /* Invalid second token. */
8968 }
8969
8970 /* ffestb_R10011_ -- "FORMAT" OPEN_PAREN expr
8971
8972 return ffestb_R10011_; // to lexer
8973
8974 For CLOSE_PAREN, wrap up the format list and if it is the top-level one,
8975 exit. For anything else, pass it to _2_. */
8976
8977 static ffelexHandler
8978 ffestb_R10011_ (ffelexToken t)
8979 {
8980 ffesttFormatList f;
8981
8982 switch (ffelex_token_type (t))
8983 {
8984 case FFELEX_typeCLOSE_PAREN:
8985 break;
8986
8987 default:
8988 return (ffelexHandler) ffestb_R10012_ (t);
8989 }
8990
8991 /* If we have a format we're working on, continue working on it. */
8992
8993 f = ffestb_local_.format.f->u.root.parent;
8994
8995 if (f != NULL)
8996 {
8997 ffestb_local_.format.f = f->next;
8998 return (ffelexHandler) ffestb_R100111_;
8999 }
9000
9001 return (ffelexHandler) ffestb_R100114_;
9002 }
9003
9004 /* ffestb_R10012_ -- "FORMAT" OPEN_PAREN [format-item-list]
9005
9006 return ffestb_R10012_; // to lexer
9007
9008 The initial state for a format-item. Here, just handle the initial
9009 number, sign for number, or run-time expression. Also handle spurious
9010 comma, close-paren (indicating spurious comma), close-array (like
9011 close-paren but preceded by slash), and quoted strings. */
9012
9013 static ffelexHandler
9014 ffestb_R10012_ (ffelexToken t)
9015 {
9016 unsigned long unsigned_val;
9017 ffesttFormatList f;
9018
9019 switch (ffelex_token_type (t))
9020 {
9021 case FFELEX_typeOPEN_ANGLE:
9022 ffesta_confirmed ();
9023 ffestb_local_.format.pre.t = ffelex_token_use (t);
9024 ffelex_set_names_pure (FALSE);
9025 if (!ffesta_seen_first_exec && !ffestb_local_.format.complained)
9026 {
9027 ffestb_local_.format.complained = TRUE;
9028 ffebad_start (FFEBAD_FORMAT_EXPR_SPEC);
9029 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
9030 ffebad_finish ();
9031 }
9032 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
9033 FFEEXPR_contextFORMAT, (ffeexprCallback) ffestb_R100115_);
9034
9035 case FFELEX_typeNUMBER:
9036 ffestb_local_.format.sign = FALSE; /* No sign present. */
9037 ffestb_local_.format.pre.present = TRUE;
9038 ffestb_local_.format.pre.rtexpr = FALSE;
9039 ffestb_local_.format.pre.t = ffelex_token_use (t);
9040 ffestb_local_.format.pre.u.unsigned_val = unsigned_val
9041 = strtoul (ffelex_token_text (t), NULL, 10);
9042 ffelex_set_expecting_hollerith (unsigned_val, '\0',
9043 ffelex_token_where_line (t),
9044 ffelex_token_where_column (t));
9045 return (ffelexHandler) ffestb_R10014_;
9046
9047 case FFELEX_typePLUS:
9048 ffestb_local_.format.sign = TRUE; /* Positive. */
9049 ffestb_local_.format.pre.t = ffelex_token_use (t);
9050 return (ffelexHandler) ffestb_R10013_;
9051
9052 case FFELEX_typeMINUS:
9053 ffestb_local_.format.sign = FALSE; /* Negative. */
9054 ffestb_local_.format.pre.t = ffelex_token_use (t);
9055 return (ffelexHandler) ffestb_R10013_;
9056
9057 case FFELEX_typeCOLON:
9058 case FFELEX_typeCOLONCOLON:/* "::". */
9059 case FFELEX_typeSLASH:
9060 case FFELEX_typeCONCAT: /* "//". */
9061 case FFELEX_typeNAMES:
9062 case FFELEX_typeDOLLAR:
9063 case FFELEX_typeOPEN_PAREN:
9064 case FFELEX_typeOPEN_ARRAY:/* "(/". */
9065 ffestb_local_.format.sign = FALSE; /* No sign present. */
9066 ffestb_local_.format.pre.present = FALSE;
9067 ffestb_local_.format.pre.rtexpr = FALSE;
9068 ffestb_local_.format.pre.t = NULL;
9069 ffestb_local_.format.pre.u.unsigned_val = 1;
9070 return (ffelexHandler) ffestb_R10014_ (t);
9071
9072 case FFELEX_typeCOMMA:
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 return (ffelexHandler) ffestb_R10012_;
9077
9078 case FFELEX_typeCLOSE_PAREN:
9079 ffebad_start (FFEBAD_FORMAT_EXTRA_COMMA);
9080 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
9081 ffebad_finish ();
9082 f = ffestb_local_.format.f->u.root.parent;
9083 if (f == NULL)
9084 return (ffelexHandler) ffestb_R100114_;
9085 ffestb_local_.format.f = f->next;
9086 return (ffelexHandler) ffestb_R100111_;
9087
9088 case FFELEX_typeCLOSE_ARRAY: /* "/)". */
9089 f = ffestt_formatlist_append (ffestb_local_.format.f);
9090 f->type = FFESTP_formattypeSLASH;
9091 f->t = ffelex_token_use (t);
9092 f->u.R1010.val.present = FALSE;
9093 f->u.R1010.val.rtexpr = FALSE;
9094 f->u.R1010.val.t = NULL;
9095 f->u.R1010.val.u.unsigned_val = 1;
9096 f = ffestb_local_.format.f->u.root.parent;
9097 if (f == NULL)
9098 return (ffelexHandler) ffestb_R100114_;
9099 ffestb_local_.format.f = f->next;
9100 return (ffelexHandler) ffestb_R100111_;
9101
9102 case FFELEX_typeEOS:
9103 case FFELEX_typeSEMICOLON:
9104 ffesta_confirmed ();
9105 ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_PAREN, t);
9106 for (f = ffestb_local_.format.f;
9107 f->u.root.parent != NULL;
9108 f = f->u.root.parent->next)
9109 ;
9110 ffestb_local_.format.f = f;
9111 return (ffelexHandler) ffestb_R100114_ (t);
9112
9113 case FFELEX_typeQUOTE:
9114 if (ffe_is_vxt ())
9115 break; /* Error, probably something like FORMAT("17)
9116 = X. */
9117 ffelex_set_expecting_hollerith (-1, '\"',
9118 ffelex_token_where_line (t),
9119 ffelex_token_where_column (t)); /* Don't have to unset
9120 this one. */
9121 return (ffelexHandler) ffestb_R100113_;
9122
9123 case FFELEX_typeAPOSTROPHE:
9124 #if 0 /* No apparent need for this, and not killed
9125 anywhere. */
9126 ffesta_tokens[1] = ffelex_token_use (t);
9127 #endif
9128 ffelex_set_expecting_hollerith (-1, '\'',
9129 ffelex_token_where_line (t),
9130 ffelex_token_where_column (t)); /* Don't have to unset
9131 this one. */
9132 return (ffelexHandler) ffestb_R100113_;
9133
9134 default:
9135 break;
9136 }
9137
9138 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
9139 ffestt_formatlist_kill (ffestb_local_.format.f);
9140 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
9141 }
9142
9143 /* ffestb_R10013_ -- "FORMAT" OPEN_PAREN [format-item-list] PLUS/MINUS
9144
9145 return ffestb_R10013_; // to lexer
9146
9147 Expect a NUMBER or complain about and then ignore the PLUS/MINUS. */
9148
9149 static ffelexHandler
9150 ffestb_R10013_ (ffelexToken t)
9151 {
9152 unsigned long unsigned_val;
9153
9154 switch (ffelex_token_type (t))
9155 {
9156 case FFELEX_typeNUMBER:
9157 ffestb_local_.format.pre.present = TRUE;
9158 ffestb_local_.format.pre.rtexpr = FALSE;
9159 unsigned_val = strtoul (ffelex_token_text (t), NULL, 10);
9160 ffestb_local_.format.pre.u.signed_val = ffestb_local_.format.sign
9161 ? unsigned_val : -unsigned_val;
9162 ffestb_local_.format.sign = TRUE; /* Sign present. */
9163 return (ffelexHandler) ffestb_R10014_;
9164
9165 default:
9166 ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
9167 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
9168 ffelex_token_where_column (ffestb_local_.format.pre.t));
9169 ffebad_finish ();
9170 ffelex_token_kill (ffestb_local_.format.pre.t);
9171 return (ffelexHandler) ffestb_R10012_ (t);
9172 }
9173 }
9174
9175 /* ffestb_R10014_ -- "FORMAT" OPEN_PAREN [format-item-list] [[+/-] NUMBER]
9176
9177 return ffestb_R10014_; // to lexer
9178
9179 Here is where we expect to see the actual NAMES, COLON, SLASH, OPEN_PAREN,
9180 OPEN_ARRAY, COLONCOLON, CONCAT, DOLLAR, or HOLLERITH that identifies what
9181 kind of format-item we're dealing with. But if we see a NUMBER instead, it
9182 means free-form spaces number like "5 6 X", so scale the current number
9183 accordingly and reenter this state. (I really wouldn't be surprised if
9184 they change this spacing rule in the F90 spec so that you can't embed
9185 spaces within numbers or within keywords like BN in a free-source-form
9186 program.) */
9187
9188 static ffelexHandler
9189 ffestb_R10014_ (ffelexToken t)
9190 {
9191 ffesttFormatList f;
9192 ffeTokenLength i;
9193 const char *p;
9194 ffestrFormat kw;
9195
9196 ffelex_set_expecting_hollerith (0, '\0',
9197 ffewhere_line_unknown (),
9198 ffewhere_column_unknown ());
9199
9200 switch (ffelex_token_type (t))
9201 {
9202 case FFELEX_typeHOLLERITH:
9203 f = ffestt_formatlist_append (ffestb_local_.format.f);
9204 f->type = FFESTP_formattypeR1016;
9205 f->t = ffelex_token_use (t);
9206 ffelex_token_kill (ffestb_local_.format.pre.t); /* It WAS present! */
9207 return (ffelexHandler) ffestb_R100111_;
9208
9209 case FFELEX_typeNUMBER:
9210 assert (ffestb_local_.format.pre.present);
9211 ffesta_confirmed ();
9212 if (ffestb_local_.format.pre.rtexpr)
9213 {
9214 ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
9215 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
9216 ffebad_finish ();
9217 return (ffelexHandler) ffestb_R10014_;
9218 }
9219 if (ffestb_local_.format.sign)
9220 {
9221 for (i = ffelex_token_length (t) + 1; i > 0; --i)
9222 ffestb_local_.format.pre.u.signed_val *= 10;
9223 ffestb_local_.format.pre.u.signed_val += strtoul (ffelex_token_text (t),
9224 NULL, 10);
9225 }
9226 else
9227 {
9228 for (i = ffelex_token_length (t) + 1; i > 0; --i)
9229 ffestb_local_.format.pre.u.unsigned_val *= 10;
9230 ffestb_local_.format.pre.u.unsigned_val += strtoul (ffelex_token_text (t),
9231 NULL, 10);
9232 ffelex_set_expecting_hollerith (ffestb_local_.format.pre.u.unsigned_val,
9233 '\0',
9234 ffelex_token_where_line (t),
9235 ffelex_token_where_column (t));
9236 }
9237 return (ffelexHandler) ffestb_R10014_;
9238
9239 case FFELEX_typeCOLONCOLON: /* "::". */
9240 if (ffestb_local_.format.pre.present)
9241 {
9242 ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_COLON_SPEC,
9243 ffestb_local_.format.pre.t);
9244 ffelex_token_kill (ffestb_local_.format.pre.t);
9245 ffestb_local_.format.pre.present = FALSE;
9246 }
9247 else
9248 {
9249 f = ffestt_formatlist_append (ffestb_local_.format.f);
9250 f->type = FFESTP_formattypeCOLON;
9251 f->t = ffelex_token_use (t);
9252 f->u.R1010.val.present = FALSE;
9253 f->u.R1010.val.rtexpr = FALSE;
9254 f->u.R1010.val.t = NULL;
9255 f->u.R1010.val.u.unsigned_val = 1;
9256 }
9257 f = ffestt_formatlist_append (ffestb_local_.format.f);
9258 f->type = FFESTP_formattypeCOLON;
9259 f->t = ffelex_token_use (t);
9260 f->u.R1010.val.present = FALSE;
9261 f->u.R1010.val.rtexpr = FALSE;
9262 f->u.R1010.val.t = NULL;
9263 f->u.R1010.val.u.unsigned_val = 1;
9264 return (ffelexHandler) ffestb_R100112_;
9265
9266 case FFELEX_typeCOLON:
9267 if (ffestb_local_.format.pre.present)
9268 {
9269 ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_COLON_SPEC,
9270 ffestb_local_.format.pre.t);
9271 ffelex_token_kill (ffestb_local_.format.pre.t);
9272 return (ffelexHandler) ffestb_R100112_;
9273 }
9274 f = ffestt_formatlist_append (ffestb_local_.format.f);
9275 f->type = FFESTP_formattypeCOLON;
9276 f->t = ffelex_token_use (t);
9277 f->u.R1010.val.present = FALSE;
9278 f->u.R1010.val.rtexpr = FALSE;
9279 f->u.R1010.val.t = NULL;
9280 f->u.R1010.val.u.unsigned_val = 1;
9281 return (ffelexHandler) ffestb_R100112_;
9282
9283 case FFELEX_typeCONCAT: /* "//". */
9284 if (ffestb_local_.format.sign)
9285 {
9286 ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
9287 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
9288 ffelex_token_where_column (ffestb_local_.format.pre.t));
9289 ffebad_finish ();
9290 ffestb_local_.format.pre.u.unsigned_val
9291 = (ffestb_local_.format.pre.u.signed_val < 0)
9292 ? -ffestb_local_.format.pre.u.signed_val
9293 : ffestb_local_.format.pre.u.signed_val;
9294 }
9295 f = ffestt_formatlist_append (ffestb_local_.format.f);
9296 f->type = FFESTP_formattypeSLASH;
9297 f->t = ffelex_token_use (t);
9298 f->u.R1010.val = ffestb_local_.format.pre;
9299 ffestb_local_.format.pre.present = FALSE;
9300 ffestb_local_.format.pre.rtexpr = FALSE;
9301 ffestb_local_.format.pre.t = NULL;
9302 ffestb_local_.format.pre.u.unsigned_val = 1;
9303 f = ffestt_formatlist_append (ffestb_local_.format.f);
9304 f->type = FFESTP_formattypeSLASH;
9305 f->t = ffelex_token_use (t);
9306 f->u.R1010.val = ffestb_local_.format.pre;
9307 return (ffelexHandler) ffestb_R100112_;
9308
9309 case FFELEX_typeSLASH:
9310 if (ffestb_local_.format.sign)
9311 {
9312 ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
9313 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
9314 ffelex_token_where_column (ffestb_local_.format.pre.t));
9315 ffebad_finish ();
9316 ffestb_local_.format.pre.u.unsigned_val
9317 = (ffestb_local_.format.pre.u.signed_val < 0)
9318 ? -ffestb_local_.format.pre.u.signed_val
9319 : ffestb_local_.format.pre.u.signed_val;
9320 }
9321 f = ffestt_formatlist_append (ffestb_local_.format.f);
9322 f->type = FFESTP_formattypeSLASH;
9323 f->t = ffelex_token_use (t);
9324 f->u.R1010.val = ffestb_local_.format.pre;
9325 return (ffelexHandler) ffestb_R100112_;
9326
9327 case FFELEX_typeOPEN_PAREN:
9328 if (ffestb_local_.format.sign)
9329 {
9330 ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
9331 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
9332 ffelex_token_where_column (ffestb_local_.format.pre.t));
9333 ffebad_finish ();
9334 ffestb_local_.format.pre.u.unsigned_val
9335 = (ffestb_local_.format.pre.u.signed_val < 0)
9336 ? -ffestb_local_.format.pre.u.signed_val
9337 : ffestb_local_.format.pre.u.signed_val;
9338 }
9339 f = ffestt_formatlist_append (ffestb_local_.format.f);
9340 f->type = FFESTP_formattypeFORMAT;
9341 f->t = ffelex_token_use (t);
9342 f->u.R1003D.R1004 = ffestb_local_.format.pre;
9343 f->u.R1003D.format = ffestb_local_.format.f
9344 = ffestt_formatlist_create (f, ffelex_token_use (t));
9345 return (ffelexHandler) ffestb_R10011_;
9346
9347 case FFELEX_typeOPEN_ARRAY:/* "(/". */
9348 if (ffestb_local_.format.sign)
9349 {
9350 ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
9351 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
9352 ffelex_token_where_column (ffestb_local_.format.pre.t));
9353 ffebad_finish ();
9354 ffestb_local_.format.pre.u.unsigned_val
9355 = (ffestb_local_.format.pre.u.signed_val < 0)
9356 ? -ffestb_local_.format.pre.u.signed_val
9357 : ffestb_local_.format.pre.u.signed_val;
9358 }
9359 f = ffestt_formatlist_append (ffestb_local_.format.f);
9360 f->type = FFESTP_formattypeFORMAT;
9361 f->t = ffelex_token_use (t);
9362 f->u.R1003D.R1004 = ffestb_local_.format.pre;
9363 f->u.R1003D.format = ffestb_local_.format.f
9364 = ffestt_formatlist_create (f, ffelex_token_use (t));
9365 f = ffestt_formatlist_append (ffestb_local_.format.f);
9366 f->type = FFESTP_formattypeSLASH;
9367 f->t = ffelex_token_use (t);
9368 f->u.R1010.val.present = FALSE;
9369 f->u.R1010.val.rtexpr = FALSE;
9370 f->u.R1010.val.t = NULL;
9371 f->u.R1010.val.u.unsigned_val = 1;
9372 return (ffelexHandler) ffestb_R100112_;
9373
9374 case FFELEX_typeCLOSE_ARRAY: /* "/)". */
9375 f = ffestt_formatlist_append (ffestb_local_.format.f);
9376 f->type = FFESTP_formattypeSLASH;
9377 f->t = ffelex_token_use (t);
9378 f->u.R1010.val = ffestb_local_.format.pre;
9379 f = ffestb_local_.format.f->u.root.parent;
9380 if (f == NULL)
9381 return (ffelexHandler) ffestb_R100114_;
9382 ffestb_local_.format.f = f->next;
9383 return (ffelexHandler) ffestb_R100111_;
9384
9385 case FFELEX_typeQUOTE:
9386 if (ffe_is_vxt ())
9387 break; /* A totally bad character in a VXT FORMAT. */
9388 ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
9389 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
9390 ffelex_token_where_column (ffestb_local_.format.pre.t));
9391 ffebad_finish ();
9392 ffelex_token_kill (ffestb_local_.format.pre.t);
9393 ffesta_confirmed ();
9394 #if 0 /* No apparent need for this, and not killed
9395 anywhere. */
9396 ffesta_tokens[1] = ffelex_token_use (t);
9397 #endif
9398 ffelex_set_expecting_hollerith (-1, '\"',
9399 ffelex_token_where_line (t),
9400 ffelex_token_where_column (t)); /* Don't have to unset
9401 this one. */
9402 return (ffelexHandler) ffestb_R100113_;
9403
9404 case FFELEX_typeAPOSTROPHE:
9405 ffesta_confirmed ();
9406 ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
9407 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
9408 ffelex_token_where_column (ffestb_local_.format.pre.t));
9409 ffebad_finish ();
9410 ffelex_token_kill (ffestb_local_.format.pre.t);
9411 #if 0 /* No apparent need for this, and not killed
9412 anywhere. */
9413 ffesta_tokens[1] = ffelex_token_use (t);
9414 #endif
9415 ffelex_set_expecting_hollerith (-1, '\'', ffelex_token_where_line (t),
9416 ffelex_token_where_column (t)); /* Don't have to unset
9417 this one. */
9418 return (ffelexHandler) ffestb_R100113_;
9419
9420 case FFELEX_typeEOS:
9421 case FFELEX_typeSEMICOLON:
9422 ffesta_confirmed ();
9423 ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_PAREN, t);
9424 for (f = ffestb_local_.format.f;
9425 f->u.root.parent != NULL;
9426 f = f->u.root.parent->next)
9427 ;
9428 ffestb_local_.format.f = f;
9429 ffelex_token_kill (ffestb_local_.format.pre.t);
9430 return (ffelexHandler) ffestb_R100114_ (t);
9431
9432 case FFELEX_typeDOLLAR:
9433 ffestb_local_.format.t = ffelex_token_use (t);
9434 if (ffestb_local_.format.pre.present)
9435 ffesta_confirmed (); /* Number preceding this invalid elsewhere. */
9436 ffestb_local_.format.current = FFESTP_formattypeDOLLAR;
9437 return (ffelexHandler) ffestb_R10015_;
9438
9439 case FFELEX_typeNAMES:
9440 kw = ffestr_format (t);
9441 ffestb_local_.format.t = ffelex_token_use (t);
9442 switch (kw)
9443 {
9444 case FFESTR_formatI:
9445 if (ffestb_local_.format.pre.present)
9446 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9447 ffestb_local_.format.current = FFESTP_formattypeI;
9448 i = FFESTR_formatlI;
9449 break;
9450
9451 case FFESTR_formatB:
9452 if (ffestb_local_.format.pre.present)
9453 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9454 ffestb_local_.format.current = FFESTP_formattypeB;
9455 i = FFESTR_formatlB;
9456 break;
9457
9458 case FFESTR_formatO:
9459 if (ffestb_local_.format.pre.present)
9460 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9461 ffestb_local_.format.current = FFESTP_formattypeO;
9462 i = FFESTR_formatlO;
9463 break;
9464
9465 case FFESTR_formatZ:
9466 if (ffestb_local_.format.pre.present)
9467 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9468 ffestb_local_.format.current = FFESTP_formattypeZ;
9469 i = FFESTR_formatlZ;
9470 break;
9471
9472 case FFESTR_formatF:
9473 if (ffestb_local_.format.pre.present)
9474 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9475 ffestb_local_.format.current = FFESTP_formattypeF;
9476 i = FFESTR_formatlF;
9477 break;
9478
9479 case FFESTR_formatE:
9480 ffestb_local_.format.current = FFESTP_formattypeE;
9481 i = FFESTR_formatlE;
9482 break;
9483
9484 case FFESTR_formatEN:
9485 if (ffestb_local_.format.pre.present)
9486 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9487 ffestb_local_.format.current = FFESTP_formattypeEN;
9488 i = FFESTR_formatlEN;
9489 break;
9490
9491 case FFESTR_formatG:
9492 if (ffestb_local_.format.pre.present)
9493 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9494 ffestb_local_.format.current = FFESTP_formattypeG;
9495 i = FFESTR_formatlG;
9496 break;
9497
9498 case FFESTR_formatL:
9499 if (ffestb_local_.format.pre.present)
9500 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9501 ffestb_local_.format.current = FFESTP_formattypeL;
9502 i = FFESTR_formatlL;
9503 break;
9504
9505 case FFESTR_formatA:
9506 if (ffestb_local_.format.pre.present)
9507 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9508 ffestb_local_.format.current = FFESTP_formattypeA;
9509 i = FFESTR_formatlA;
9510 break;
9511
9512 case FFESTR_formatD:
9513 ffestb_local_.format.current = FFESTP_formattypeD;
9514 i = FFESTR_formatlD;
9515 break;
9516
9517 case FFESTR_formatQ:
9518 ffestb_local_.format.current = FFESTP_formattypeQ;
9519 i = FFESTR_formatlQ;
9520 break;
9521
9522 case FFESTR_formatDOLLAR:
9523 if (ffestb_local_.format.pre.present)
9524 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9525 ffestb_local_.format.current = FFESTP_formattypeDOLLAR;
9526 i = FFESTR_formatlDOLLAR;
9527 break;
9528
9529 case FFESTR_formatP:
9530 if (ffestb_local_.format.pre.present)
9531 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9532 ffestb_local_.format.current = FFESTP_formattypeP;
9533 i = FFESTR_formatlP;
9534 break;
9535
9536 case FFESTR_formatT:
9537 if (ffestb_local_.format.pre.present)
9538 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9539 ffestb_local_.format.current = FFESTP_formattypeT;
9540 i = FFESTR_formatlT;
9541 break;
9542
9543 case FFESTR_formatTL:
9544 if (ffestb_local_.format.pre.present)
9545 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9546 ffestb_local_.format.current = FFESTP_formattypeTL;
9547 i = FFESTR_formatlTL;
9548 break;
9549
9550 case FFESTR_formatTR:
9551 if (ffestb_local_.format.pre.present)
9552 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9553 ffestb_local_.format.current = FFESTP_formattypeTR;
9554 i = FFESTR_formatlTR;
9555 break;
9556
9557 case FFESTR_formatX:
9558 if (ffestb_local_.format.pre.present)
9559 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9560 ffestb_local_.format.current = FFESTP_formattypeX;
9561 i = FFESTR_formatlX;
9562 break;
9563
9564 case FFESTR_formatS:
9565 if (ffestb_local_.format.pre.present)
9566 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9567 ffestb_local_.format.current = FFESTP_formattypeS;
9568 i = FFESTR_formatlS;
9569 break;
9570
9571 case FFESTR_formatSP:
9572 if (ffestb_local_.format.pre.present)
9573 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9574 ffestb_local_.format.current = FFESTP_formattypeSP;
9575 i = FFESTR_formatlSP;
9576 break;
9577
9578 case FFESTR_formatSS:
9579 if (ffestb_local_.format.pre.present)
9580 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9581 ffestb_local_.format.current = FFESTP_formattypeSS;
9582 i = FFESTR_formatlSS;
9583 break;
9584
9585 case FFESTR_formatBN:
9586 if (ffestb_local_.format.pre.present)
9587 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9588 ffestb_local_.format.current = FFESTP_formattypeBN;
9589 i = FFESTR_formatlBN;
9590 break;
9591
9592 case FFESTR_formatBZ:
9593 if (ffestb_local_.format.pre.present)
9594 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9595 ffestb_local_.format.current = FFESTP_formattypeBZ;
9596 i = FFESTR_formatlBZ;
9597 break;
9598
9599 case FFESTR_formatH: /* Error, either "H" or "<expr>H". */
9600 if (ffestb_local_.format.pre.present)
9601 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9602 ffestb_local_.format.current = FFESTP_formattypeH;
9603 i = FFESTR_formatlH;
9604 break;
9605
9606 case FFESTR_formatPD:
9607 if (ffestb_local_.format.pre.present)
9608 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9609 ffestb_subr_R1001_append_p_ ();
9610 ffestb_local_.format.t = ffelex_token_name_from_names (t,
9611 FFESTR_formatlP, 1);
9612 ffestb_local_.format.sign = FALSE;
9613 ffestb_local_.format.pre.present = FALSE;
9614 ffestb_local_.format.pre.rtexpr = FALSE;
9615 ffestb_local_.format.pre.t = NULL;
9616 ffestb_local_.format.pre.u.unsigned_val = 1;
9617 ffestb_local_.format.current = FFESTP_formattypeD;
9618 i = FFESTR_formatlPD;
9619 break;
9620
9621 case FFESTR_formatPE:
9622 if (ffestb_local_.format.pre.present)
9623 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9624 ffestb_subr_R1001_append_p_ ();
9625 ffestb_local_.format.t = ffelex_token_name_from_names (t,
9626 FFESTR_formatlP, 1);
9627 ffestb_local_.format.sign = FALSE;
9628 ffestb_local_.format.pre.present = FALSE;
9629 ffestb_local_.format.pre.rtexpr = FALSE;
9630 ffestb_local_.format.pre.t = NULL;
9631 ffestb_local_.format.pre.u.unsigned_val = 1;
9632 ffestb_local_.format.current = FFESTP_formattypeE;
9633 i = FFESTR_formatlPE;
9634 break;
9635
9636 case FFESTR_formatPEN:
9637 if (ffestb_local_.format.pre.present)
9638 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9639 ffestb_subr_R1001_append_p_ ();
9640 ffestb_local_.format.t = ffelex_token_name_from_names (t,
9641 FFESTR_formatlP, 1);
9642 ffestb_local_.format.sign = FALSE;
9643 ffestb_local_.format.pre.present = FALSE;
9644 ffestb_local_.format.pre.rtexpr = FALSE;
9645 ffestb_local_.format.pre.t = NULL;
9646 ffestb_local_.format.pre.u.unsigned_val = 1;
9647 ffestb_local_.format.current = FFESTP_formattypeEN;
9648 i = FFESTR_formatlPEN;
9649 break;
9650
9651 case FFESTR_formatPF:
9652 if (ffestb_local_.format.pre.present)
9653 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9654 ffestb_subr_R1001_append_p_ ();
9655 ffestb_local_.format.t = ffelex_token_name_from_names (t,
9656 FFESTR_formatlP, 1);
9657 ffestb_local_.format.sign = FALSE;
9658 ffestb_local_.format.pre.present = FALSE;
9659 ffestb_local_.format.pre.rtexpr = FALSE;
9660 ffestb_local_.format.pre.t = NULL;
9661 ffestb_local_.format.pre.u.unsigned_val = 1;
9662 ffestb_local_.format.current = FFESTP_formattypeF;
9663 i = FFESTR_formatlPF;
9664 break;
9665
9666 case FFESTR_formatPG:
9667 if (ffestb_local_.format.pre.present)
9668 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9669 ffestb_subr_R1001_append_p_ ();
9670 ffestb_local_.format.t = ffelex_token_name_from_names (t,
9671 FFESTR_formatlP, 1);
9672 ffestb_local_.format.sign = FALSE;
9673 ffestb_local_.format.pre.present = FALSE;
9674 ffestb_local_.format.pre.rtexpr = FALSE;
9675 ffestb_local_.format.pre.t = NULL;
9676 ffestb_local_.format.pre.u.unsigned_val = 1;
9677 ffestb_local_.format.current = FFESTP_formattypeG;
9678 i = FFESTR_formatlPG;
9679 break;
9680
9681 default:
9682 if (ffestb_local_.format.pre.present)
9683 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
9684 ffestb_local_.format.current = FFESTP_formattypeNone;
9685 p = strpbrk (ffelex_token_text (t), "0123456789");
9686 if (p == NULL)
9687 i = ffelex_token_length (t);
9688 else
9689 i = p - ffelex_token_text (t);
9690 break;
9691 }
9692 p = ffelex_token_text (t) + i;
9693 if (*p == '\0')
9694 return (ffelexHandler) ffestb_R10015_;
9695 if (! ISDIGIT (*p))
9696 {
9697 if (ffestb_local_.format.current == FFESTP_formattypeH)
9698 p = strpbrk (p, "0123456789");
9699 else
9700 {
9701 p = NULL;
9702 ffestb_local_.format.current = FFESTP_formattypeNone;
9703 }
9704 if (p == NULL)
9705 return (ffelexHandler) ffestb_R10015_;
9706 i = p - ffelex_token_text (t); /* Collect digits. */
9707 }
9708 ffestb_local_.format.post.present = TRUE;
9709 ffestb_local_.format.post.rtexpr = FALSE;
9710 ffestb_local_.format.post.t = ffelex_token_number_from_names (t, i);
9711 ffestb_local_.format.post.u.unsigned_val
9712 = strtoul (ffelex_token_text (ffestb_local_.format.post.t), NULL, 10);
9713 p += ffelex_token_length (ffestb_local_.format.post.t);
9714 i += ffelex_token_length (ffestb_local_.format.post.t);
9715 if (*p == '\0')
9716 return (ffelexHandler) ffestb_R10016_;
9717 if ((kw != FFESTR_formatP) ||
9718 !ffelex_is_firstnamechar ((unsigned char)*p))
9719 {
9720 if (ffestb_local_.format.current != FFESTP_formattypeH)
9721 ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL);
9722 return (ffelexHandler) ffestb_R10016_;
9723 }
9724
9725 /* Here we have [number]P[number][text]. Treat as
9726 [number]P,[number][text]. */
9727
9728 ffestb_subr_R1001_append_p_ ();
9729 t = ffestb_local_.format.t = ffelex_token_names_from_names (t, i, 0);
9730 ffestb_local_.format.sign = FALSE;
9731 ffestb_local_.format.pre = ffestb_local_.format.post;
9732 kw = ffestr_format (t);
9733 switch (kw)
9734 { /* Only a few possibilities here. */
9735 case FFESTR_formatD:
9736 ffestb_local_.format.current = FFESTP_formattypeD;
9737 i = FFESTR_formatlD;
9738 break;
9739
9740 case FFESTR_formatE:
9741 ffestb_local_.format.current = FFESTP_formattypeE;
9742 i = FFESTR_formatlE;
9743 break;
9744
9745 case FFESTR_formatEN:
9746 ffestb_local_.format.current = FFESTP_formattypeEN;
9747 i = FFESTR_formatlEN;
9748 break;
9749
9750 case FFESTR_formatF:
9751 ffestb_local_.format.current = FFESTP_formattypeF;
9752 i = FFESTR_formatlF;
9753 break;
9754
9755 case FFESTR_formatG:
9756 ffestb_local_.format.current = FFESTP_formattypeG;
9757 i = FFESTR_formatlG;
9758 break;
9759
9760 default:
9761 ffebad_start (FFEBAD_FORMAT_P_NOCOMMA);
9762 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
9763 ffebad_finish ();
9764 ffestb_local_.format.current = FFESTP_formattypeNone;
9765 p = strpbrk (ffelex_token_text (t), "0123456789");
9766 if (p == NULL)
9767 i = ffelex_token_length (t);
9768 else
9769 i = p - ffelex_token_text (t);
9770 }
9771 p = ffelex_token_text (t) + i;
9772 if (*p == '\0')
9773 return (ffelexHandler) ffestb_R10015_;
9774 if (! ISDIGIT (*p))
9775 {
9776 ffestb_local_.format.current = FFESTP_formattypeNone;
9777 p = strpbrk (p, "0123456789");
9778 if (p == NULL)
9779 return (ffelexHandler) ffestb_R10015_;
9780 i = p - ffelex_token_text (t); /* Collect digits anyway. */
9781 }
9782 ffestb_local_.format.post.present = TRUE;
9783 ffestb_local_.format.post.rtexpr = FALSE;
9784 ffestb_local_.format.post.t = ffelex_token_number_from_names (t, i);
9785 ffestb_local_.format.post.u.unsigned_val
9786 = strtoul (ffelex_token_text (ffestb_local_.format.post.t), NULL, 10);
9787 p += ffelex_token_length (ffestb_local_.format.post.t);
9788 i += ffelex_token_length (ffestb_local_.format.post.t);
9789 if (*p == '\0')
9790 return (ffelexHandler) ffestb_R10016_;
9791 ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL);
9792 return (ffelexHandler) ffestb_R10016_;
9793
9794 default:
9795 break;
9796 }
9797
9798 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
9799 if (ffestb_local_.format.pre.present)
9800 ffelex_token_kill (ffestb_local_.format.pre.t);
9801 ffestt_formatlist_kill (ffestb_local_.format.f);
9802 return (ffelexHandler) ffelex_swallow_tokens (t,
9803 (ffelexHandler) ffesta_zero);
9804 }
9805
9806 /* ffestb_R10015_ -- [[+/-] NUMBER] NAMES
9807
9808 return ffestb_R10015_; // to lexer
9809
9810 Here we've gotten at least the initial mnemonic for the edit descriptor.
9811 We expect either a NUMBER, for the post-mnemonic value, a NAMES, for
9812 further clarification (in free-form only, sigh) of the mnemonic, or
9813 anything else. In all cases we go to _6_, with the difference that for
9814 NUMBER and NAMES we send the next token rather than the current token. */
9815
9816 static ffelexHandler
9817 ffestb_R10015_ (ffelexToken t)
9818 {
9819 bool split_pea; /* New NAMES requires splitting kP from new
9820 edit desc. */
9821 ffestrFormat kw;
9822 const char *p;
9823 ffeTokenLength i;
9824
9825 switch (ffelex_token_type (t))
9826 {
9827 case FFELEX_typeOPEN_ANGLE:
9828 ffesta_confirmed ();
9829 ffestb_local_.format.post.t = ffelex_token_use (t);
9830 ffelex_set_names_pure (FALSE);
9831 if (!ffesta_seen_first_exec && !ffestb_local_.format.complained)
9832 {
9833 ffestb_local_.format.complained = TRUE;
9834 ffebad_start (FFEBAD_FORMAT_EXPR_SPEC);
9835 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
9836 ffebad_finish ();
9837 }
9838 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
9839 FFEEXPR_contextFORMAT, (ffeexprCallback) ffestb_R100116_);
9840
9841 case FFELEX_typeNUMBER:
9842 ffestb_local_.format.post.present = TRUE;
9843 ffestb_local_.format.post.rtexpr = FALSE;
9844 ffestb_local_.format.post.t = ffelex_token_use (t);
9845 ffestb_local_.format.post.u.unsigned_val
9846 = strtoul (ffelex_token_text (t), NULL, 10);
9847 return (ffelexHandler) ffestb_R10016_;
9848
9849 case FFELEX_typeNAMES:
9850 ffesta_confirmed (); /* NAMES " " NAMES invalid elsewhere in
9851 free-form. */
9852 kw = ffestr_format (t);
9853 switch (ffestb_local_.format.current)
9854 {
9855 case FFESTP_formattypeP:
9856 split_pea = TRUE;
9857 break;
9858
9859 case FFESTP_formattypeH: /* An error, maintain this indicator. */
9860 kw = FFESTR_formatNone;
9861 split_pea = FALSE;
9862 break;
9863
9864 default:
9865 split_pea = FALSE;
9866 break;
9867 }
9868
9869 switch (kw)
9870 {
9871 case FFESTR_formatF:
9872 switch (ffestb_local_.format.current)
9873 {
9874 case FFESTP_formattypeP:
9875 ffestb_local_.format.current = FFESTP_formattypeF;
9876 break;
9877
9878 default:
9879 ffestb_local_.format.current = FFESTP_formattypeNone;
9880 break;
9881 }
9882 i = FFESTR_formatlF;
9883 break;
9884
9885 case FFESTR_formatE:
9886 switch (ffestb_local_.format.current)
9887 {
9888 case FFESTP_formattypeP:
9889 ffestb_local_.format.current = FFESTP_formattypeE;
9890 break;
9891
9892 default:
9893 ffestb_local_.format.current = FFESTP_formattypeNone;
9894 break;
9895 }
9896 i = FFESTR_formatlE;
9897 break;
9898
9899 case FFESTR_formatEN:
9900 switch (ffestb_local_.format.current)
9901 {
9902 case FFESTP_formattypeP:
9903 ffestb_local_.format.current = FFESTP_formattypeEN;
9904 break;
9905
9906 default:
9907 ffestb_local_.format.current = FFESTP_formattypeNone;
9908 break;
9909 }
9910 i = FFESTR_formatlEN;
9911 break;
9912
9913 case FFESTR_formatG:
9914 switch (ffestb_local_.format.current)
9915 {
9916 case FFESTP_formattypeP:
9917 ffestb_local_.format.current = FFESTP_formattypeG;
9918 break;
9919
9920 default:
9921 ffestb_local_.format.current = FFESTP_formattypeNone;
9922 break;
9923 }
9924 i = FFESTR_formatlG;
9925 break;
9926
9927 case FFESTR_formatL:
9928 switch (ffestb_local_.format.current)
9929 {
9930 case FFESTP_formattypeT:
9931 ffestb_local_.format.current = FFESTP_formattypeTL;
9932 break;
9933
9934 default:
9935 ffestb_local_.format.current = FFESTP_formattypeNone;
9936 break;
9937 }
9938 i = FFESTR_formatlL;
9939 break;
9940
9941 case FFESTR_formatD:
9942 switch (ffestb_local_.format.current)
9943 {
9944 case FFESTP_formattypeP:
9945 ffestb_local_.format.current = FFESTP_formattypeD;
9946 break;
9947
9948 default:
9949 ffestb_local_.format.current = FFESTP_formattypeNone;
9950 break;
9951 }
9952 i = FFESTR_formatlD;
9953 break;
9954
9955 case FFESTR_formatS:
9956 switch (ffestb_local_.format.current)
9957 {
9958 case FFESTP_formattypeS:
9959 ffestb_local_.format.current = FFESTP_formattypeSS;
9960 break;
9961
9962 default:
9963 ffestb_local_.format.current = FFESTP_formattypeNone;
9964 break;
9965 }
9966 i = FFESTR_formatlS;
9967 break;
9968
9969 case FFESTR_formatP:
9970 switch (ffestb_local_.format.current)
9971 {
9972 case FFESTP_formattypeS:
9973 ffestb_local_.format.current = FFESTP_formattypeSP;
9974 break;
9975
9976 default:
9977 ffestb_local_.format.current = FFESTP_formattypeNone;
9978 break;
9979 }
9980 i = FFESTR_formatlP;
9981 break;
9982
9983 case FFESTR_formatR:
9984 switch (ffestb_local_.format.current)
9985 {
9986 case FFESTP_formattypeT:
9987 ffestb_local_.format.current = FFESTP_formattypeTR;
9988 break;
9989
9990 default:
9991 ffestb_local_.format.current = FFESTP_formattypeNone;
9992 break;
9993 }
9994 i = FFESTR_formatlR;
9995 break;
9996
9997 case FFESTR_formatZ:
9998 switch (ffestb_local_.format.current)
9999 {
10000 case FFESTP_formattypeB:
10001 ffestb_local_.format.current = FFESTP_formattypeBZ;
10002 break;
10003
10004 default:
10005 ffestb_local_.format.current = FFESTP_formattypeNone;
10006 break;
10007 }
10008 i = FFESTR_formatlZ;
10009 break;
10010
10011 case FFESTR_formatN:
10012 switch (ffestb_local_.format.current)
10013 {
10014 case FFESTP_formattypeE:
10015 ffestb_local_.format.current = FFESTP_formattypeEN;
10016 break;
10017
10018 case FFESTP_formattypeB:
10019 ffestb_local_.format.current = FFESTP_formattypeBN;
10020 break;
10021
10022 default:
10023 ffestb_local_.format.current = FFESTP_formattypeNone;
10024 break;
10025 }
10026 i = FFESTR_formatlN;
10027 break;
10028
10029 default:
10030 if (ffestb_local_.format.current != FFESTP_formattypeH)
10031 ffestb_local_.format.current = FFESTP_formattypeNone;
10032 split_pea = FALSE; /* Go ahead and let the P be in the party. */
10033 p = strpbrk (ffelex_token_text (t), "0123456789");
10034 if (p == NULL)
10035 i = ffelex_token_length (t);
10036 else
10037 i = p - ffelex_token_text (t);
10038 }
10039
10040 if (split_pea)
10041 {
10042 ffestb_subr_R1001_append_p_ ();
10043 ffestb_local_.format.t = ffelex_token_use (t);
10044 ffestb_local_.format.sign = FALSE;
10045 ffestb_local_.format.pre.present = FALSE;
10046 ffestb_local_.format.pre.rtexpr = FALSE;
10047 ffestb_local_.format.pre.t = NULL;
10048 ffestb_local_.format.pre.u.unsigned_val = 1;
10049 }
10050
10051 p = ffelex_token_text (t) + i;
10052 if (*p == '\0')
10053 return (ffelexHandler) ffestb_R10015_;
10054 if (! ISDIGIT (*p))
10055 {
10056 ffestb_local_.format.current = FFESTP_formattypeNone;
10057 p = strpbrk (p, "0123456789");
10058 if (p == NULL)
10059 return (ffelexHandler) ffestb_R10015_;
10060 i = p - ffelex_token_text (t); /* Collect digits anyway. */
10061 }
10062 ffestb_local_.format.post.present = TRUE;
10063 ffestb_local_.format.post.rtexpr = FALSE;
10064 ffestb_local_.format.post.t = ffelex_token_number_from_names (t, i);
10065 ffestb_local_.format.post.u.unsigned_val
10066 = strtoul (ffelex_token_text (ffestb_local_.format.post.t), NULL, 10);
10067 p += ffelex_token_length (ffestb_local_.format.post.t);
10068 i += ffelex_token_length (ffestb_local_.format.post.t);
10069 if (*p == '\0')
10070 return (ffelexHandler) ffestb_R10016_;
10071 ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL);
10072 return (ffelexHandler) ffestb_R10016_;
10073
10074 default:
10075 ffestb_local_.format.post.present = FALSE;
10076 ffestb_local_.format.post.rtexpr = FALSE;
10077 ffestb_local_.format.post.t = NULL;
10078 ffestb_local_.format.post.u.unsigned_val = 1;
10079 return (ffelexHandler) ffestb_R10016_ (t);
10080 }
10081 }
10082
10083 /* ffestb_R10016_ -- [[+/-] NUMBER] NAMES NUMBER
10084
10085 return ffestb_R10016_; // to lexer
10086
10087 Expect a PERIOD here. Maybe find a NUMBER to append to the current
10088 number, in which case return to this state. Maybe find a NAMES to switch
10089 from a kP descriptor to a new descriptor (else the NAMES is spurious),
10090 in which case generator the P item and go to state _4_. Anything
10091 else, pass token on to state _8_. */
10092
10093 static ffelexHandler
10094 ffestb_R10016_ (ffelexToken t)
10095 {
10096 ffeTokenLength i;
10097
10098 switch (ffelex_token_type (t))
10099 {
10100 case FFELEX_typePERIOD:
10101 return (ffelexHandler) ffestb_R10017_;
10102
10103 case FFELEX_typeNUMBER:
10104 assert (ffestb_local_.format.post.present);
10105 ffesta_confirmed ();
10106 if (ffestb_local_.format.post.rtexpr)
10107 {
10108 ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
10109 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
10110 ffebad_finish ();
10111 return (ffelexHandler) ffestb_R10016_;
10112 }
10113 for (i = ffelex_token_length (t) + 1; i > 0; --i)
10114 ffestb_local_.format.post.u.unsigned_val *= 10;
10115 ffestb_local_.format.post.u.unsigned_val += strtoul (ffelex_token_text (t),
10116 NULL, 10);
10117 return (ffelexHandler) ffestb_R10016_;
10118
10119 case FFELEX_typeNAMES:
10120 ffesta_confirmed (); /* NUMBER " " NAMES invalid elsewhere. */
10121 if (ffestb_local_.format.current != FFESTP_formattypeP)
10122 {
10123 ffesta_ffebad_1t (FFEBAD_FORMAT_TEXT_IN_NUMBER, t);
10124 return (ffelexHandler) ffestb_R10016_;
10125 }
10126 ffestb_subr_R1001_append_p_ ();
10127 ffestb_local_.format.sign = FALSE;
10128 ffestb_local_.format.pre = ffestb_local_.format.post;
10129 return (ffelexHandler) ffestb_R10014_ (t);
10130
10131 default:
10132 ffestb_local_.format.dot.present = FALSE;
10133 ffestb_local_.format.dot.rtexpr = FALSE;
10134 ffestb_local_.format.dot.t = NULL;
10135 ffestb_local_.format.dot.u.unsigned_val = 1;
10136 return (ffelexHandler) ffestb_R10018_ (t);
10137 }
10138 }
10139
10140 /* ffestb_R10017_ -- [[+/-] NUMBER] NAMES NUMBER PERIOD
10141
10142 return ffestb_R10017_; // to lexer
10143
10144 Here we've gotten the period following the edit descriptor.
10145 We expect either a NUMBER, for the dot value, or something else, which
10146 probably means we're not even close to being in a real FORMAT statement. */
10147
10148 static ffelexHandler
10149 ffestb_R10017_ (ffelexToken t)
10150 {
10151 switch (ffelex_token_type (t))
10152 {
10153 case FFELEX_typeOPEN_ANGLE:
10154 ffestb_local_.format.dot.t = ffelex_token_use (t);
10155 ffelex_set_names_pure (FALSE);
10156 if (!ffesta_seen_first_exec && !ffestb_local_.format.complained)
10157 {
10158 ffestb_local_.format.complained = TRUE;
10159 ffebad_start (FFEBAD_FORMAT_EXPR_SPEC);
10160 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
10161 ffebad_finish ();
10162 }
10163 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
10164 FFEEXPR_contextFORMAT, (ffeexprCallback) ffestb_R100117_);
10165
10166 case FFELEX_typeNUMBER:
10167 ffestb_local_.format.dot.present = TRUE;
10168 ffestb_local_.format.dot.rtexpr = FALSE;
10169 ffestb_local_.format.dot.t = ffelex_token_use (t);
10170 ffestb_local_.format.dot.u.unsigned_val
10171 = strtoul (ffelex_token_text (t), NULL, 10);
10172 return (ffelexHandler) ffestb_R10018_;
10173
10174 default:
10175 ffelex_token_kill (ffestb_local_.format.t);
10176 if (ffestb_local_.format.pre.present)
10177 ffelex_token_kill (ffestb_local_.format.pre.t);
10178 if (ffestb_local_.format.post.present)
10179 ffelex_token_kill (ffestb_local_.format.post.t);
10180 ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_DOT, t);
10181 ffestt_formatlist_kill (ffestb_local_.format.f);
10182 return (ffelexHandler) ffelex_swallow_tokens (t,
10183 (ffelexHandler) ffesta_zero);
10184 }
10185 }
10186
10187 /* ffestb_R10018_ -- [[+/-] NUMBER] NAMES NUMBER PERIOD NUMBER
10188
10189 return ffestb_R10018_; // to lexer
10190
10191 Expect a NAMES here, which must begin with "E" to be valid. Maybe find a
10192 NUMBER to append to the current number, in which case return to this state.
10193 Anything else, pass token on to state _10_. */
10194
10195 static ffelexHandler
10196 ffestb_R10018_ (ffelexToken t)
10197 {
10198 ffeTokenLength i;
10199 const char *p;
10200
10201 switch (ffelex_token_type (t))
10202 {
10203 case FFELEX_typeNUMBER:
10204 assert (ffestb_local_.format.dot.present);
10205 ffesta_confirmed ();
10206 if (ffestb_local_.format.dot.rtexpr)
10207 {
10208 ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
10209 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
10210 ffebad_finish ();
10211 return (ffelexHandler) ffestb_R10018_;
10212 }
10213 for (i = ffelex_token_length (t) + 1; i > 0; --i)
10214 ffestb_local_.format.dot.u.unsigned_val *= 10;
10215 ffestb_local_.format.dot.u.unsigned_val += strtoul (ffelex_token_text (t),
10216 NULL, 10);
10217 return (ffelexHandler) ffestb_R10018_;
10218
10219 case FFELEX_typeNAMES:
10220 if (!ffesrc_char_match_init (*(p = ffelex_token_text (t)), 'E', 'e'))
10221 {
10222 ffesta_ffebad_1t (FFEBAD_FORMAT_TEXT_IN_NUMBER, t);
10223 return (ffelexHandler) ffestb_R10018_;
10224 }
10225 if (*++p == '\0')
10226 return (ffelexHandler) ffestb_R10019_; /* Go get NUMBER. */
10227 i = 1;
10228 if (! ISDIGIT (*p))
10229 {
10230 ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, 1, NULL);
10231 return (ffelexHandler) ffestb_R10018_;
10232 }
10233 ffestb_local_.format.exp.present = TRUE;
10234 ffestb_local_.format.exp.rtexpr = FALSE;
10235 ffestb_local_.format.exp.t = ffelex_token_number_from_names (t, i);
10236 ffestb_local_.format.exp.u.unsigned_val
10237 = strtoul (ffelex_token_text (ffestb_local_.format.exp.t), NULL, 10);
10238 p += ffelex_token_length (ffestb_local_.format.exp.t);
10239 i += ffelex_token_length (ffestb_local_.format.exp.t);
10240 if (*p == '\0')
10241 return (ffelexHandler) ffestb_R100110_;
10242 ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL);
10243 return (ffelexHandler) ffestb_R100110_;
10244
10245 default:
10246 ffestb_local_.format.exp.present = FALSE;
10247 ffestb_local_.format.exp.rtexpr = FALSE;
10248 ffestb_local_.format.exp.t = NULL;
10249 ffestb_local_.format.exp.u.unsigned_val = 1;
10250 return (ffelexHandler) ffestb_R100110_ (t);
10251 }
10252 }
10253
10254 /* ffestb_R10019_ -- [[+/-] NUMBER] NAMES NUMBER PERIOD NUMBER "E"
10255
10256 return ffestb_R10019_; // to lexer
10257
10258 Here we've gotten the "E" following the edit descriptor.
10259 We expect either a NUMBER, for the exponent value, or something else. */
10260
10261 static ffelexHandler
10262 ffestb_R10019_ (ffelexToken t)
10263 {
10264 switch (ffelex_token_type (t))
10265 {
10266 case FFELEX_typeOPEN_ANGLE:
10267 ffestb_local_.format.exp.t = ffelex_token_use (t);
10268 ffelex_set_names_pure (FALSE);
10269 if (!ffesta_seen_first_exec && !ffestb_local_.format.complained)
10270 {
10271 ffestb_local_.format.complained = TRUE;
10272 ffebad_start (FFEBAD_FORMAT_EXPR_SPEC);
10273 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
10274 ffebad_finish ();
10275 }
10276 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
10277 FFEEXPR_contextFORMAT, (ffeexprCallback) ffestb_R100118_);
10278
10279 case FFELEX_typeNUMBER:
10280 ffestb_local_.format.exp.present = TRUE;
10281 ffestb_local_.format.exp.rtexpr = FALSE;
10282 ffestb_local_.format.exp.t = ffelex_token_use (t);
10283 ffestb_local_.format.exp.u.unsigned_val
10284 = strtoul (ffelex_token_text (t), NULL, 10);
10285 return (ffelexHandler) ffestb_R100110_;
10286
10287 default:
10288 ffelex_token_kill (ffestb_local_.format.t);
10289 if (ffestb_local_.format.pre.present)
10290 ffelex_token_kill (ffestb_local_.format.pre.t);
10291 if (ffestb_local_.format.post.present)
10292 ffelex_token_kill (ffestb_local_.format.post.t);
10293 if (ffestb_local_.format.dot.present)
10294 ffelex_token_kill (ffestb_local_.format.dot.t);
10295 ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_EXP, t);
10296 ffestt_formatlist_kill (ffestb_local_.format.f);
10297 return (ffelexHandler) ffelex_swallow_tokens (t,
10298 (ffelexHandler) ffesta_zero);
10299 }
10300 }
10301
10302 /* ffestb_R100110_ -- [[+/-] NUMBER] NAMES NUMBER [PERIOD NUMBER ["E" NUMBER]]
10303
10304 return ffestb_R100110_; // to lexer
10305
10306 Maybe find a NUMBER to append to the current number, in which case return
10307 to this state. Anything else, handle current descriptor, then pass token
10308 on to state _10_. */
10309
10310 static ffelexHandler
10311 ffestb_R100110_ (ffelexToken t)
10312 {
10313 ffeTokenLength i;
10314 enum expect
10315 {
10316 required,
10317 optional,
10318 disallowed
10319 };
10320 ffebad err;
10321 enum expect pre;
10322 enum expect post;
10323 enum expect dot;
10324 enum expect exp;
10325 bool R1005;
10326 ffesttFormatList f;
10327
10328 switch (ffelex_token_type (t))
10329 {
10330 case FFELEX_typeNUMBER:
10331 assert (ffestb_local_.format.exp.present);
10332 ffesta_confirmed ();
10333 if (ffestb_local_.format.exp.rtexpr)
10334 {
10335 ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
10336 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
10337 ffebad_finish ();
10338 return (ffelexHandler) ffestb_R100110_;
10339 }
10340 for (i = ffelex_token_length (t) + 1; i > 0; --i)
10341 ffestb_local_.format.exp.u.unsigned_val *= 10;
10342 ffestb_local_.format.exp.u.unsigned_val += strtoul (ffelex_token_text (t),
10343 NULL, 10);
10344 return (ffelexHandler) ffestb_R100110_;
10345
10346 default:
10347 if (ffestb_local_.format.sign
10348 && (ffestb_local_.format.current != FFESTP_formattypeP)
10349 && (ffestb_local_.format.current != FFESTP_formattypeH))
10350 {
10351 ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
10352 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
10353 ffelex_token_where_column (ffestb_local_.format.pre.t));
10354 ffebad_finish ();
10355 ffestb_local_.format.pre.u.unsigned_val
10356 = (ffestb_local_.format.pre.u.signed_val < 0)
10357 ? -ffestb_local_.format.pre.u.signed_val
10358 : ffestb_local_.format.pre.u.signed_val;
10359 }
10360 switch (ffestb_local_.format.current)
10361 {
10362 case FFESTP_formattypeI:
10363 err = FFEBAD_FORMAT_BAD_I_SPEC;
10364 pre = optional;
10365 post = required;
10366 dot = optional;
10367 exp = disallowed;
10368 R1005 = TRUE;
10369 break;
10370
10371 case FFESTP_formattypeB:
10372 err = FFEBAD_FORMAT_BAD_B_SPEC;
10373 pre = optional;
10374 post = required;
10375 dot = optional;
10376 exp = disallowed;
10377 R1005 = TRUE;
10378 break;
10379
10380 case FFESTP_formattypeO:
10381 err = FFEBAD_FORMAT_BAD_O_SPEC;
10382 pre = optional;
10383 post = required;
10384 dot = optional;
10385 exp = disallowed;
10386 R1005 = TRUE;
10387 break;
10388
10389 case FFESTP_formattypeZ:
10390 err = FFEBAD_FORMAT_BAD_Z_SPEC;
10391 pre = optional;
10392 post = required;
10393 dot = optional;
10394 exp = disallowed;
10395 R1005 = TRUE;
10396 break;
10397
10398 case FFESTP_formattypeF:
10399 err = FFEBAD_FORMAT_BAD_F_SPEC;
10400 pre = optional;
10401 post = required;
10402 dot = required;
10403 exp = disallowed;
10404 R1005 = TRUE;
10405 break;
10406
10407 case FFESTP_formattypeE:
10408 err = FFEBAD_FORMAT_BAD_E_SPEC;
10409 pre = optional;
10410 post = required;
10411 dot = required;
10412 exp = optional;
10413 R1005 = TRUE;
10414 break;
10415
10416 case FFESTP_formattypeEN:
10417 err = FFEBAD_FORMAT_BAD_EN_SPEC;
10418 pre = optional;
10419 post = required;
10420 dot = required;
10421 exp = optional;
10422 R1005 = TRUE;
10423 break;
10424
10425 case FFESTP_formattypeG:
10426 err = FFEBAD_FORMAT_BAD_G_SPEC;
10427 pre = optional;
10428 post = required;
10429 dot = required;
10430 exp = optional;
10431 R1005 = TRUE;
10432 break;
10433
10434 case FFESTP_formattypeL:
10435 err = FFEBAD_FORMAT_BAD_L_SPEC;
10436 pre = optional;
10437 post = required;
10438 dot = disallowed;
10439 exp = disallowed;
10440 R1005 = TRUE;
10441 break;
10442
10443 case FFESTP_formattypeA:
10444 err = FFEBAD_FORMAT_BAD_A_SPEC;
10445 pre = optional;
10446 post = optional;
10447 dot = disallowed;
10448 exp = disallowed;
10449 R1005 = TRUE;
10450 break;
10451
10452 case FFESTP_formattypeD:
10453 err = FFEBAD_FORMAT_BAD_D_SPEC;
10454 pre = optional;
10455 post = required;
10456 dot = required;
10457 exp = disallowed;
10458 R1005 = TRUE;
10459 break;
10460
10461 case FFESTP_formattypeQ:
10462 err = FFEBAD_FORMAT_BAD_Q_SPEC;
10463 pre = disallowed;
10464 post = disallowed;
10465 dot = disallowed;
10466 exp = disallowed;
10467 R1005 = FALSE;
10468 break;
10469
10470 case FFESTP_formattypeDOLLAR:
10471 err = FFEBAD_FORMAT_BAD_DOLLAR_SPEC;
10472 pre = disallowed;
10473 post = disallowed;
10474 dot = disallowed;
10475 exp = disallowed;
10476 R1005 = FALSE;
10477 break;
10478
10479 case FFESTP_formattypeP:
10480 err = FFEBAD_FORMAT_BAD_P_SPEC;
10481 pre = required;
10482 post = disallowed;
10483 dot = disallowed;
10484 exp = disallowed;
10485 R1005 = FALSE;
10486 break;
10487
10488 case FFESTP_formattypeT:
10489 err = FFEBAD_FORMAT_BAD_T_SPEC;
10490 pre = disallowed;
10491 post = required;
10492 dot = disallowed;
10493 exp = disallowed;
10494 R1005 = FALSE;
10495 break;
10496
10497 case FFESTP_formattypeTL:
10498 err = FFEBAD_FORMAT_BAD_TL_SPEC;
10499 pre = disallowed;
10500 post = required;
10501 dot = disallowed;
10502 exp = disallowed;
10503 R1005 = FALSE;
10504 break;
10505
10506 case FFESTP_formattypeTR:
10507 err = FFEBAD_FORMAT_BAD_TR_SPEC;
10508 pre = disallowed;
10509 post = required;
10510 dot = disallowed;
10511 exp = disallowed;
10512 R1005 = FALSE;
10513 break;
10514
10515 case FFESTP_formattypeX:
10516 err = FFEBAD_FORMAT_BAD_X_SPEC;
10517 pre = required;
10518 post = disallowed;
10519 dot = disallowed;
10520 exp = disallowed;
10521 R1005 = FALSE;
10522 break;
10523
10524 case FFESTP_formattypeS:
10525 err = FFEBAD_FORMAT_BAD_S_SPEC;
10526 pre = disallowed;
10527 post = disallowed;
10528 dot = disallowed;
10529 exp = disallowed;
10530 R1005 = FALSE;
10531 break;
10532
10533 case FFESTP_formattypeSP:
10534 err = FFEBAD_FORMAT_BAD_SP_SPEC;
10535 pre = disallowed;
10536 post = disallowed;
10537 dot = disallowed;
10538 exp = disallowed;
10539 R1005 = FALSE;
10540 break;
10541
10542 case FFESTP_formattypeSS:
10543 err = FFEBAD_FORMAT_BAD_SS_SPEC;
10544 pre = disallowed;
10545 post = disallowed;
10546 dot = disallowed;
10547 exp = disallowed;
10548 R1005 = FALSE;
10549 break;
10550
10551 case FFESTP_formattypeBN:
10552 err = FFEBAD_FORMAT_BAD_BN_SPEC;
10553 pre = disallowed;
10554 post = disallowed;
10555 dot = disallowed;
10556 exp = disallowed;
10557 R1005 = FALSE;
10558 break;
10559
10560 case FFESTP_formattypeBZ:
10561 err = FFEBAD_FORMAT_BAD_BZ_SPEC;
10562 pre = disallowed;
10563 post = disallowed;
10564 dot = disallowed;
10565 exp = disallowed;
10566 R1005 = FALSE;
10567 break;
10568
10569 case FFESTP_formattypeH: /* Definitely an error, make sure of
10570 it. */
10571 err = FFEBAD_FORMAT_BAD_H_SPEC;
10572 pre = ffestb_local_.format.pre.present ? disallowed : required;
10573 post = disallowed;
10574 dot = disallowed;
10575 exp = disallowed;
10576 R1005 = FALSE;
10577 break;
10578
10579 case FFESTP_formattypeNone:
10580 ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_SPEC,
10581 ffestb_local_.format.t);
10582
10583 clean_up_to_11_: /* :::::::::::::::::::: */
10584
10585 ffelex_token_kill (ffestb_local_.format.t);
10586 if (ffestb_local_.format.pre.present)
10587 ffelex_token_kill (ffestb_local_.format.pre.t);
10588 if (ffestb_local_.format.post.present)
10589 ffelex_token_kill (ffestb_local_.format.post.t);
10590 if (ffestb_local_.format.dot.present)
10591 ffelex_token_kill (ffestb_local_.format.dot.t);
10592 if (ffestb_local_.format.exp.present)
10593 ffelex_token_kill (ffestb_local_.format.exp.t);
10594 return (ffelexHandler) ffestb_R100111_ (t);
10595
10596 default:
10597 assert ("bad format item" == NULL);
10598 err = FFEBAD_FORMAT_BAD_H_SPEC;
10599 pre = disallowed;
10600 post = disallowed;
10601 dot = disallowed;
10602 exp = disallowed;
10603 R1005 = FALSE;
10604 break;
10605 }
10606 if (((pre == disallowed) && ffestb_local_.format.pre.present)
10607 || ((pre == required) && !ffestb_local_.format.pre.present))
10608 {
10609 ffesta_ffebad_1t (err, (pre == required)
10610 ? ffestb_local_.format.t : ffestb_local_.format.pre.t);
10611 goto clean_up_to_11_; /* :::::::::::::::::::: */
10612 }
10613 if (((post == disallowed) && ffestb_local_.format.post.present)
10614 || ((post == required) && !ffestb_local_.format.post.present))
10615 {
10616 ffesta_ffebad_1t (err, (post == required)
10617 ? ffestb_local_.format.t : ffestb_local_.format.post.t);
10618 goto clean_up_to_11_; /* :::::::::::::::::::: */
10619 }
10620 if (((dot == disallowed) && ffestb_local_.format.dot.present)
10621 || ((dot == required) && !ffestb_local_.format.dot.present))
10622 {
10623 ffesta_ffebad_1t (err, (dot == required)
10624 ? ffestb_local_.format.t : ffestb_local_.format.dot.t);
10625 goto clean_up_to_11_; /* :::::::::::::::::::: */
10626 }
10627 if (((exp == disallowed) && ffestb_local_.format.exp.present)
10628 || ((exp == required) && !ffestb_local_.format.exp.present))
10629 {
10630 ffesta_ffebad_1t (err, (exp == required)
10631 ? ffestb_local_.format.t : ffestb_local_.format.exp.t);
10632 goto clean_up_to_11_; /* :::::::::::::::::::: */
10633 }
10634 f = ffestt_formatlist_append (ffestb_local_.format.f);
10635 f->type = ffestb_local_.format.current;
10636 f->t = ffestb_local_.format.t;
10637 if (R1005)
10638 {
10639 f->u.R1005.R1004 = ffestb_local_.format.pre;
10640 f->u.R1005.R1006 = ffestb_local_.format.post;
10641 f->u.R1005.R1007_or_R1008 = ffestb_local_.format.dot;
10642 f->u.R1005.R1009 = ffestb_local_.format.exp;
10643 }
10644 else
10645 /* Must be R1010. */
10646 {
10647 if (pre == disallowed)
10648 f->u.R1010.val = ffestb_local_.format.post;
10649 else
10650 f->u.R1010.val = ffestb_local_.format.pre;
10651 }
10652 return (ffelexHandler) ffestb_R100111_ (t);
10653 }
10654 }
10655
10656 /* ffestb_R100111_ -- edit-descriptor
10657
10658 return ffestb_R100111_; // to lexer
10659
10660 Expect a COMMA, CLOSE_PAREN, CLOSE_ARRAY, COLON, COLONCOLON, SLASH, or
10661 CONCAT, or complain about missing comma. */
10662
10663 static ffelexHandler
10664 ffestb_R100111_ (ffelexToken t)
10665 {
10666 ffesttFormatList f;
10667
10668 switch (ffelex_token_type (t))
10669 {
10670 case FFELEX_typeCOMMA:
10671 return (ffelexHandler) ffestb_R10012_;
10672
10673 case FFELEX_typeCOLON:
10674 case FFELEX_typeCOLONCOLON:
10675 case FFELEX_typeSLASH:
10676 case FFELEX_typeCONCAT:
10677 return (ffelexHandler) ffestb_R10012_ (t);
10678
10679 case FFELEX_typeCLOSE_PAREN:
10680 f = ffestb_local_.format.f->u.root.parent;
10681 if (f == NULL)
10682 return (ffelexHandler) ffestb_R100114_;
10683 ffestb_local_.format.f = f->next;
10684 return (ffelexHandler) ffestb_R100111_;
10685
10686 case FFELEX_typeCLOSE_ARRAY: /* "/)". */
10687 f = ffestt_formatlist_append (ffestb_local_.format.f);
10688 f->type = FFESTP_formattypeSLASH;
10689 f->t = ffelex_token_use (t);
10690 f->u.R1010.val.present = FALSE;
10691 f->u.R1010.val.rtexpr = FALSE;
10692 f->u.R1010.val.t = NULL;
10693 f->u.R1010.val.u.unsigned_val = 1;
10694 f = ffestb_local_.format.f->u.root.parent;
10695 if (f == NULL)
10696 return (ffelexHandler) ffestb_R100114_;
10697 ffestb_local_.format.f = f->next;
10698 return (ffelexHandler) ffestb_R100111_;
10699
10700 case FFELEX_typeOPEN_ANGLE:
10701 case FFELEX_typeDOLLAR:
10702 case FFELEX_typeNUMBER:
10703 case FFELEX_typeOPEN_PAREN:
10704 case FFELEX_typeOPEN_ARRAY:
10705 case FFELEX_typeQUOTE:
10706 case FFELEX_typeAPOSTROPHE:
10707 case FFELEX_typeNAMES:
10708 ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_COMMA, t);
10709 return (ffelexHandler) ffestb_R10012_ (t);
10710
10711 case FFELEX_typeEOS:
10712 case FFELEX_typeSEMICOLON:
10713 ffesta_confirmed ();
10714 ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_PAREN, t);
10715 for (f = ffestb_local_.format.f;
10716 f->u.root.parent != NULL;
10717 f = f->u.root.parent->next)
10718 ;
10719 ffestb_local_.format.f = f;
10720 return (ffelexHandler) ffestb_R100114_ (t);
10721
10722 default:
10723 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
10724 ffestt_formatlist_kill (ffestb_local_.format.f);
10725 return (ffelexHandler) ffelex_swallow_tokens (t,
10726 (ffelexHandler) ffesta_zero);
10727 }
10728 }
10729
10730 /* ffestb_R100112_ -- COLON, COLONCOLON, SLASH, OPEN_ARRAY, or CONCAT
10731
10732 return ffestb_R100112_; // to lexer
10733
10734 Like _11_ except the COMMA is optional. */
10735
10736 static ffelexHandler
10737 ffestb_R100112_ (ffelexToken t)
10738 {
10739 ffesttFormatList f;
10740
10741 switch (ffelex_token_type (t))
10742 {
10743 case FFELEX_typeCOMMA:
10744 return (ffelexHandler) ffestb_R10012_;
10745
10746 case FFELEX_typeCOLON:
10747 case FFELEX_typeCOLONCOLON:
10748 case FFELEX_typeSLASH:
10749 case FFELEX_typeCONCAT:
10750 case FFELEX_typeOPEN_ANGLE:
10751 case FFELEX_typeNAMES:
10752 case FFELEX_typeDOLLAR:
10753 case FFELEX_typeNUMBER:
10754 case FFELEX_typeOPEN_PAREN:
10755 case FFELEX_typeOPEN_ARRAY:
10756 case FFELEX_typeQUOTE:
10757 case FFELEX_typeAPOSTROPHE:
10758 case FFELEX_typePLUS:
10759 case FFELEX_typeMINUS:
10760 return (ffelexHandler) ffestb_R10012_ (t);
10761
10762 case FFELEX_typeCLOSE_PAREN:
10763 f = ffestb_local_.format.f->u.root.parent;
10764 if (f == NULL)
10765 return (ffelexHandler) ffestb_R100114_;
10766 ffestb_local_.format.f = f->next;
10767 return (ffelexHandler) ffestb_R100111_;
10768
10769 case FFELEX_typeCLOSE_ARRAY: /* "/)". */
10770 f = ffestt_formatlist_append (ffestb_local_.format.f);
10771 f->type = FFESTP_formattypeSLASH;
10772 f->t = ffelex_token_use (t);
10773 f->u.R1010.val.present = FALSE;
10774 f->u.R1010.val.rtexpr = FALSE;
10775 f->u.R1010.val.t = NULL;
10776 f->u.R1010.val.u.unsigned_val = 1;
10777 f = ffestb_local_.format.f->u.root.parent;
10778 if (f == NULL)
10779 return (ffelexHandler) ffestb_R100114_;
10780 ffestb_local_.format.f = f->next;
10781 return (ffelexHandler) ffestb_R100111_;
10782
10783 case FFELEX_typeEOS:
10784 case FFELEX_typeSEMICOLON:
10785 ffesta_confirmed ();
10786 ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_PAREN, t);
10787 for (f = ffestb_local_.format.f;
10788 f->u.root.parent != NULL;
10789 f = f->u.root.parent->next)
10790 ;
10791 ffestb_local_.format.f = f;
10792 return (ffelexHandler) ffestb_R100114_ (t);
10793
10794 default:
10795 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
10796 ffestt_formatlist_kill (ffestb_local_.format.f);
10797 return (ffelexHandler) ffelex_swallow_tokens (t,
10798 (ffelexHandler) ffesta_zero);
10799 }
10800 }
10801
10802 /* ffestb_R100113_ -- Handle CHARACTER token.
10803
10804 return ffestb_R100113_; // to lexer
10805
10806 Append the format item to the list, go to _11_. */
10807
10808 static ffelexHandler
10809 ffestb_R100113_ (ffelexToken t)
10810 {
10811 ffesttFormatList f;
10812
10813 assert (ffelex_token_type (t) == FFELEX_typeCHARACTER);
10814
10815 if (ffe_is_pedantic_not_90 () && (ffelex_token_length (t) == 0))
10816 {
10817 ffebad_start (FFEBAD_NULL_CHAR_CONST);
10818 ffebad_here (0, ffelex_token_where_line (t),
10819 ffelex_token_where_column (t));
10820 ffebad_finish ();
10821 }
10822
10823 f = ffestt_formatlist_append (ffestb_local_.format.f);
10824 f->type = FFESTP_formattypeR1016;
10825 f->t = ffelex_token_use (t);
10826 return (ffelexHandler) ffestb_R100111_;
10827 }
10828
10829 /* ffestb_R100114_ -- "FORMAT" OPEN_PAREN format-item-list CLOSE_PAREN
10830
10831 return ffestb_R100114_; // to lexer
10832
10833 Handle EOS/SEMICOLON or something else. */
10834
10835 static ffelexHandler
10836 ffestb_R100114_ (ffelexToken t)
10837 {
10838 ffelex_set_names_pure (FALSE);
10839
10840 switch (ffelex_token_type (t))
10841 {
10842 case FFELEX_typeEOS:
10843 case FFELEX_typeSEMICOLON:
10844 ffesta_confirmed ();
10845 if (!ffesta_is_inhibited () && !ffestb_local_.format.complained)
10846 ffestc_R1001 (ffestb_local_.format.f);
10847 ffestt_formatlist_kill (ffestb_local_.format.f);
10848 return (ffelexHandler) ffesta_zero (t);
10849
10850 default:
10851 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
10852 ffestt_formatlist_kill (ffestb_local_.format.f);
10853 return (ffelexHandler) ffelex_swallow_tokens (t,
10854 (ffelexHandler) ffesta_zero);
10855 }
10856 }
10857
10858 /* ffestb_R100115_ -- OPEN_ANGLE expr
10859
10860 (ffestb_R100115_) // to expression handler
10861
10862 Handle expression prior to the edit descriptor. */
10863
10864 static ffelexHandler
10865 ffestb_R100115_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
10866 {
10867 switch (ffelex_token_type (t))
10868 {
10869 case FFELEX_typeCLOSE_ANGLE:
10870 ffestb_local_.format.pre.present = TRUE;
10871 ffestb_local_.format.pre.rtexpr = TRUE;
10872 ffestb_local_.format.pre.u.expr = expr;
10873 ffelex_set_names_pure (TRUE);
10874 return (ffelexHandler) ffestb_R10014_;
10875
10876 default:
10877 ffelex_token_kill (ffestb_local_.format.pre.t);
10878 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
10879 ffestt_formatlist_kill (ffestb_local_.format.f);
10880 return (ffelexHandler) ffelex_swallow_tokens (t,
10881 (ffelexHandler) ffesta_zero);
10882 }
10883 }
10884
10885 /* ffestb_R100116_ -- "[n]X" OPEN_ANGLE expr
10886
10887 (ffestb_R100116_) // to expression handler
10888
10889 Handle expression after the edit descriptor. */
10890
10891 static ffelexHandler
10892 ffestb_R100116_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
10893 {
10894 switch (ffelex_token_type (t))
10895 {
10896 case FFELEX_typeCLOSE_ANGLE:
10897 ffestb_local_.format.post.present = TRUE;
10898 ffestb_local_.format.post.rtexpr = TRUE;
10899 ffestb_local_.format.post.u.expr = expr;
10900 ffelex_set_names_pure (TRUE);
10901 return (ffelexHandler) ffestb_R10016_;
10902
10903 default:
10904 ffelex_token_kill (ffestb_local_.format.t);
10905 ffelex_token_kill (ffestb_local_.format.post.t);
10906 if (ffestb_local_.format.pre.present)
10907 ffelex_token_kill (ffestb_local_.format.pre.t);
10908 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
10909 ffestt_formatlist_kill (ffestb_local_.format.f);
10910 return (ffelexHandler) ffelex_swallow_tokens (t,
10911 (ffelexHandler) ffesta_zero);
10912 }
10913 }
10914
10915 /* ffestb_R100117_ -- "[n]X[n]." OPEN_ANGLE expr
10916
10917 (ffestb_R100117_) // to expression handler
10918
10919 Handle expression after the PERIOD. */
10920
10921 static ffelexHandler
10922 ffestb_R100117_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
10923 {
10924 switch (ffelex_token_type (t))
10925 {
10926 case FFELEX_typeCLOSE_ANGLE:
10927 ffestb_local_.format.dot.present = TRUE;
10928 ffestb_local_.format.dot.rtexpr = TRUE;
10929 ffestb_local_.format.dot.u.expr = expr;
10930 ffelex_set_names_pure (TRUE);
10931 return (ffelexHandler) ffestb_R10018_;
10932
10933 default:
10934 ffelex_token_kill (ffestb_local_.format.t);
10935 ffelex_token_kill (ffestb_local_.format.dot.t);
10936 if (ffestb_local_.format.pre.present)
10937 ffelex_token_kill (ffestb_local_.format.pre.t);
10938 if (ffestb_local_.format.post.present)
10939 ffelex_token_kill (ffestb_local_.format.post.t);
10940 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
10941 ffestt_formatlist_kill (ffestb_local_.format.f);
10942 return (ffelexHandler) ffelex_swallow_tokens (t,
10943 (ffelexHandler) ffesta_zero);
10944 }
10945 }
10946
10947 /* ffestb_R100118_ -- "[n]X[n].[n]E" OPEN_ANGLE expr
10948
10949 (ffestb_R100118_) // to expression handler
10950
10951 Handle expression after the "E". */
10952
10953 static ffelexHandler
10954 ffestb_R100118_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
10955 {
10956 switch (ffelex_token_type (t))
10957 {
10958 case FFELEX_typeCLOSE_ANGLE:
10959 ffestb_local_.format.exp.present = TRUE;
10960 ffestb_local_.format.exp.rtexpr = TRUE;
10961 ffestb_local_.format.exp.u.expr = expr;
10962 ffelex_set_names_pure (TRUE);
10963 return (ffelexHandler) ffestb_R100110_;
10964
10965 default:
10966 ffelex_token_kill (ffestb_local_.format.t);
10967 ffelex_token_kill (ffestb_local_.format.exp.t);
10968 if (ffestb_local_.format.pre.present)
10969 ffelex_token_kill (ffestb_local_.format.pre.t);
10970 if (ffestb_local_.format.post.present)
10971 ffelex_token_kill (ffestb_local_.format.post.t);
10972 if (ffestb_local_.format.dot.present)
10973 ffelex_token_kill (ffestb_local_.format.dot.t);
10974 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
10975 ffestt_formatlist_kill (ffestb_local_.format.f);
10976 return (ffelexHandler) ffelex_swallow_tokens (t,
10977 (ffelexHandler) ffesta_zero);
10978 }
10979 }
10980
10981 /* ffestb_R1107 -- Parse the USE statement
10982
10983 return ffestb_R1107; // to lexer
10984
10985 Make sure the statement has a valid form for the USE statement.
10986 If it does, implement the statement. */
10987
10988 #if FFESTR_F90
10989 ffelexHandler
10990 ffestb_R1107 (ffelexToken t)
10991 {
10992 ffeTokenLength i;
10993 const char *p;
10994
10995 switch (ffelex_token_type (ffesta_tokens[0]))
10996 {
10997 case FFELEX_typeNAME:
10998 if (ffesta_first_kw != FFESTR_firstUSE)
10999 goto bad_0; /* :::::::::::::::::::: */
11000 switch (ffelex_token_type (t))
11001 {
11002 case FFELEX_typeNAME:
11003 break;
11004
11005 case FFELEX_typeEOS:
11006 case FFELEX_typeSEMICOLON:
11007 case FFELEX_typeCOMMA:
11008 case FFELEX_typeCOLONCOLON:
11009 ffesta_confirmed (); /* Error, but clearly intended. */
11010 goto bad_1; /* :::::::::::::::::::: */
11011
11012 default:
11013 goto bad_0; /* :::::::::::::::::::: */
11014 }
11015 ffesta_confirmed ();
11016 ffesta_tokens[1] = ffelex_token_use (t);
11017 return (ffelexHandler) ffestb_R11071_;
11018
11019 case FFELEX_typeNAMES:
11020 if (ffesta_first_kw != FFESTR_firstUSE)
11021 goto bad_0; /* :::::::::::::::::::: */
11022 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlUSE);
11023 if (!ffesrc_is_name_init (*p))
11024 goto bad_i; /* :::::::::::::::::::: */
11025 switch (ffelex_token_type (t))
11026 {
11027 case FFELEX_typeCOLONCOLON:
11028 ffesta_confirmed (); /* Error, but clearly intended. */
11029 goto bad_1; /* :::::::::::::::::::: */
11030
11031 default:
11032 goto bad_1; /* :::::::::::::::::::: */
11033
11034 case FFELEX_typeCOMMA:
11035 case FFELEX_typeEOS:
11036 case FFELEX_typeSEMICOLON:
11037 break;
11038 }
11039 ffesta_confirmed ();
11040 ffesta_tokens[1]
11041 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
11042 return (ffelexHandler) ffestb_R11071_ (t);
11043
11044 default:
11045 goto bad_0; /* :::::::::::::::::::: */
11046 }
11047
11048 bad_0: /* :::::::::::::::::::: */
11049 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", ffesta_tokens[0]);
11050 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11051
11052 bad_1: /* :::::::::::::::::::: */
11053 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
11054 return (ffelexHandler) ffelex_swallow_tokens (t,
11055 (ffelexHandler) ffesta_zero); /* Invalid second token. */
11056
11057 bad_i: /* :::::::::::::::::::: */
11058 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "USE", ffesta_tokens[0], i, t);
11059 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11060 }
11061
11062 /* ffestb_R11071_ -- "USE" NAME
11063
11064 return ffestb_R11071_; // to lexer
11065
11066 Make sure the statement has a valid form for the USE statement. If it
11067 does, implement the statement. */
11068
11069 static ffelexHandler
11070 ffestb_R11071_ (ffelexToken t)
11071 {
11072 switch (ffelex_token_type (t))
11073 {
11074 case FFELEX_typeEOS:
11075 case FFELEX_typeSEMICOLON:
11076 if (!ffesta_is_inhibited ())
11077 {
11078 ffestc_R1107_start (ffesta_tokens[1], FALSE);
11079 ffestc_R1107_finish ();
11080 }
11081 ffelex_token_kill (ffesta_tokens[1]);
11082 return (ffelexHandler) ffesta_zero (t);
11083
11084 case FFELEX_typeCOMMA:
11085 return (ffelexHandler) ffestb_R11072_;
11086
11087 default:
11088 break;
11089 }
11090
11091 ffelex_token_kill (ffesta_tokens[1]);
11092 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
11093 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11094 }
11095
11096 /* ffestb_R11072_ -- "USE" NAME COMMA
11097
11098 return ffestb_R11072_; // to lexer
11099
11100 Make sure the statement has a valid form for the USE statement. If it
11101 does, implement the statement. */
11102
11103 static ffelexHandler
11104 ffestb_R11072_ (ffelexToken t)
11105 {
11106 switch (ffelex_token_type (t))
11107 {
11108 case FFELEX_typeNAME:
11109 ffesta_tokens[2] = ffelex_token_use (t);
11110 return (ffelexHandler) ffestb_R11073_;
11111
11112 default:
11113 break;
11114 }
11115
11116 ffelex_token_kill (ffesta_tokens[1]);
11117 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
11118 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11119 }
11120
11121 /* ffestb_R11073_ -- "USE" NAME COMMA NAME
11122
11123 return ffestb_R11073_; // to lexer
11124
11125 Make sure the statement has a valid form for the USE statement. If it
11126 does, implement the statement. */
11127
11128 static ffelexHandler
11129 ffestb_R11073_ (ffelexToken t)
11130 {
11131 switch (ffelex_token_type (t))
11132 {
11133 case FFELEX_typeCOLON:
11134 if (ffestr_other (ffesta_tokens[2]) != FFESTR_otherONLY)
11135 break;
11136 if (!ffesta_is_inhibited ())
11137 ffestc_R1107_start (ffesta_tokens[1], TRUE);
11138 ffelex_token_kill (ffesta_tokens[1]);
11139 ffelex_token_kill (ffesta_tokens[2]);
11140 return (ffelexHandler) ffestb_R11074_;
11141
11142 case FFELEX_typePOINTS:
11143 if (!ffesta_is_inhibited ())
11144 ffestc_R1107_start (ffesta_tokens[1], FALSE);
11145 ffelex_token_kill (ffesta_tokens[1]);
11146 ffesta_tokens[1] = ffesta_tokens[2];
11147 return (ffelexHandler) ffestb_R110711_;
11148
11149 default:
11150 break;
11151 }
11152
11153 ffelex_token_kill (ffesta_tokens[1]);
11154 ffelex_token_kill (ffesta_tokens[2]);
11155 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
11156 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11157 }
11158
11159 /* ffestb_R11074_ -- "USE" NAME COMMA "ONLY" COLON
11160
11161 return ffestb_R11074_; // to lexer
11162
11163 Make sure the statement has a valid form for the USE statement. If it
11164 does, implement the statement. */
11165
11166 static ffelexHandler
11167 ffestb_R11074_ (ffelexToken t)
11168 {
11169 switch (ffelex_token_type (t))
11170 {
11171 case FFELEX_typeNAME:
11172 ffesta_tokens[1] = ffelex_token_use (t);
11173 return (ffelexHandler) ffestb_R11075_;
11174
11175 case FFELEX_typeEOS:
11176 case FFELEX_typeSEMICOLON:
11177 if (!ffesta_is_inhibited ())
11178 ffestc_R1107_finish ();
11179 return (ffelexHandler) ffesta_zero (t);
11180
11181 default:
11182 break;
11183 }
11184
11185 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
11186 ffestc_R1107_finish ();
11187 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11188 }
11189
11190 /* ffestb_R11075_ -- "USE" NAME COMMA "ONLY" COLON NAME
11191
11192 return ffestb_R11075_; // to lexer
11193
11194 Make sure the statement has a valid form for the USE statement. If it
11195 does, implement the statement. */
11196
11197 static ffelexHandler
11198 ffestb_R11075_ (ffelexToken t)
11199 {
11200 switch (ffelex_token_type (t))
11201 {
11202 case FFELEX_typeEOS:
11203 case FFELEX_typeSEMICOLON:
11204 if (!ffesta_is_inhibited ())
11205 {
11206 ffestc_R1107_item (NULL, ffesta_tokens[1]);
11207 ffestc_R1107_finish ();
11208 }
11209 ffelex_token_kill (ffesta_tokens[1]);
11210 return (ffelexHandler) ffesta_zero (t);
11211
11212 case FFELEX_typeCOMMA:
11213 if (!ffesta_is_inhibited ())
11214 ffestc_R1107_item (NULL, ffesta_tokens[1]);
11215 ffelex_token_kill (ffesta_tokens[1]);
11216 return (ffelexHandler) ffestb_R11078_;
11217
11218 case FFELEX_typePOINTS:
11219 return (ffelexHandler) ffestb_R11076_;
11220
11221 default:
11222 break;
11223 }
11224
11225 ffelex_token_kill (ffesta_tokens[1]);
11226 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
11227 ffestc_R1107_finish ();
11228 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11229 }
11230
11231 /* ffestb_R11076_ -- "USE" NAME COMMA "ONLY" COLON NAME POINTS
11232
11233 return ffestb_R11076_; // to lexer
11234
11235 Make sure the statement has a valid form for the USE statement. If it
11236 does, implement the statement. */
11237
11238 static ffelexHandler
11239 ffestb_R11076_ (ffelexToken t)
11240 {
11241 switch (ffelex_token_type (t))
11242 {
11243 case FFELEX_typeNAME:
11244 if (!ffesta_is_inhibited ())
11245 ffestc_R1107_item (ffesta_tokens[1], t);
11246 ffelex_token_kill (ffesta_tokens[1]);
11247 return (ffelexHandler) ffestb_R11077_;
11248
11249 default:
11250 break;
11251 }
11252
11253 ffelex_token_kill (ffesta_tokens[1]);
11254 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
11255 ffestc_R1107_finish ();
11256 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11257 }
11258
11259 /* ffestb_R11077_ -- "USE" NAME COMMA "ONLY" COLON NAME POINTS NAME
11260
11261 return ffestb_R11077_; // to lexer
11262
11263 Make sure the statement has a valid form for the USE statement. If it
11264 does, implement the statement. */
11265
11266 static ffelexHandler
11267 ffestb_R11077_ (ffelexToken t)
11268 {
11269 switch (ffelex_token_type (t))
11270 {
11271 case FFELEX_typeEOS:
11272 case FFELEX_typeSEMICOLON:
11273 if (!ffesta_is_inhibited ())
11274 ffestc_R1107_finish ();
11275 return (ffelexHandler) ffesta_zero (t);
11276
11277 case FFELEX_typeCOMMA:
11278 return (ffelexHandler) ffestb_R11078_;
11279
11280 default:
11281 break;
11282 }
11283
11284 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
11285 ffestc_R1107_finish ();
11286 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11287 }
11288
11289 /* ffestb_R11078_ -- "USE" NAME COMMA "ONLY" COLON NAME POINTS NAME COMMA
11290
11291 return ffestb_R11078_; // to lexer
11292
11293 Make sure the statement has a valid form for the USE statement. If it
11294 does, implement the statement. */
11295
11296 static ffelexHandler
11297 ffestb_R11078_ (ffelexToken t)
11298 {
11299 switch (ffelex_token_type (t))
11300 {
11301 case FFELEX_typeNAME:
11302 ffesta_tokens[1] = ffelex_token_use (t);
11303 return (ffelexHandler) ffestb_R11075_;
11304
11305 default:
11306 break;
11307 }
11308
11309 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
11310 ffestc_R1107_finish ();
11311 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11312 }
11313
11314 /* ffestb_R11079_ -- "USE" NAME COMMA
11315
11316 return ffestb_R11079_; // to lexer
11317
11318 Make sure the statement has a valid form for the USE statement. If it
11319 does, implement the statement. */
11320
11321 static ffelexHandler
11322 ffestb_R11079_ (ffelexToken t)
11323 {
11324 switch (ffelex_token_type (t))
11325 {
11326 case FFELEX_typeNAME:
11327 ffesta_tokens[1] = ffelex_token_use (t);
11328 return (ffelexHandler) ffestb_R110710_;
11329
11330 default:
11331 break;
11332 }
11333
11334 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
11335 ffestc_R1107_finish ();
11336 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11337 }
11338
11339 /* ffestb_R110710_ -- "USE" NAME COMMA NAME
11340
11341 return ffestb_R110710_; // to lexer
11342
11343 Make sure the statement has a valid form for the USE statement. If it
11344 does, implement the statement. */
11345
11346 static ffelexHandler
11347 ffestb_R110710_ (ffelexToken t)
11348 {
11349 switch (ffelex_token_type (t))
11350 {
11351 case FFELEX_typePOINTS:
11352 return (ffelexHandler) ffestb_R110711_;
11353
11354 default:
11355 break;
11356 }
11357
11358 ffelex_token_kill (ffesta_tokens[1]);
11359 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
11360 ffestc_R1107_finish ();
11361 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11362 }
11363
11364 /* ffestb_R110711_ -- "USE" NAME COMMA NAME POINTS
11365
11366 return ffestb_R110711_; // to lexer
11367
11368 Make sure the statement has a valid form for the USE statement. If it
11369 does, implement the statement. */
11370
11371 static ffelexHandler
11372 ffestb_R110711_ (ffelexToken t)
11373 {
11374 switch (ffelex_token_type (t))
11375 {
11376 case FFELEX_typeNAME:
11377 if (!ffesta_is_inhibited ())
11378 ffestc_R1107_item (ffesta_tokens[1], t);
11379 ffelex_token_kill (ffesta_tokens[1]);
11380 return (ffelexHandler) ffestb_R110712_;
11381
11382 default:
11383 break;
11384 }
11385
11386 ffelex_token_kill (ffesta_tokens[1]);
11387 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
11388 ffestc_R1107_finish ();
11389 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11390 }
11391
11392 /* ffestb_R110712_ -- "USE" NAME COMMA NAME POINTS NAME
11393
11394 return ffestb_R110712_; // to lexer
11395
11396 Make sure the statement has a valid form for the USE statement. If it
11397 does, implement the statement. */
11398
11399 static ffelexHandler
11400 ffestb_R110712_ (ffelexToken t)
11401 {
11402 switch (ffelex_token_type (t))
11403 {
11404 case FFELEX_typeEOS:
11405 case FFELEX_typeSEMICOLON:
11406 if (!ffesta_is_inhibited ())
11407 ffestc_R1107_finish ();
11408 return (ffelexHandler) ffesta_zero (t);
11409
11410 case FFELEX_typeCOMMA:
11411 return (ffelexHandler) ffestb_R11079_;
11412
11413 default:
11414 break;
11415 }
11416
11417 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
11418 ffestc_R1107_finish ();
11419 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11420 }
11421
11422 #endif
11423 /* ffestb_R1202 -- Parse the INTERFACE statement
11424
11425 return ffestb_R1202; // to lexer
11426
11427 Make sure the statement has a valid form for the INTERFACE statement.
11428 If it does, implement the statement.
11429
11430 15-May-90 JCB 1.1
11431 Allow INTERFACE by itself; missed this
11432 valid form when originally doing syntactic analysis code. */
11433
11434 #if FFESTR_F90
11435 ffelexHandler
11436 ffestb_R1202 (ffelexToken t)
11437 {
11438 ffeTokenLength i;
11439 const char *p;
11440
11441 switch (ffelex_token_type (ffesta_tokens[0]))
11442 {
11443 case FFELEX_typeNAME:
11444 if (ffesta_first_kw != FFESTR_firstINTERFACE)
11445 goto bad_0; /* :::::::::::::::::::: */
11446 switch (ffelex_token_type (t))
11447 {
11448 case FFELEX_typeNAME:
11449 break;
11450
11451 case FFELEX_typeEOS:
11452 case FFELEX_typeSEMICOLON:
11453 ffesta_confirmed ();
11454 if (!ffesta_is_inhibited ())
11455 ffestc_R1202 (FFESTP_definedoperatorNone, NULL);
11456 return (ffelexHandler) ffesta_zero (t);
11457
11458 case FFELEX_typeCOMMA:
11459 case FFELEX_typeCOLONCOLON:
11460 ffesta_confirmed (); /* Error, but clearly intended. */
11461 goto bad_1; /* :::::::::::::::::::: */
11462
11463 default:
11464 goto bad_1; /* :::::::::::::::::::: */
11465 }
11466
11467 ffesta_confirmed ();
11468 switch (ffesta_second_kw)
11469 {
11470 case FFESTR_secondOPERATOR:
11471 ffestb_local_.interface.operator = FFESTP_definedoperatorOPERATOR;
11472 break;
11473
11474 case FFESTR_secondASSIGNMENT:
11475 ffestb_local_.interface.operator = FFESTP_definedoperatorASSIGNMENT;
11476 break;
11477
11478 default:
11479 ffestb_local_.interface.operator = FFESTP_definedoperatorNone;
11480 break;
11481 }
11482 ffesta_tokens[1] = ffelex_token_use (t);
11483 return (ffelexHandler) ffestb_R12021_;
11484
11485 case FFELEX_typeNAMES:
11486 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlINTERFACE);
11487 switch (ffesta_first_kw)
11488 {
11489 case FFESTR_firstINTERFACEOPERATOR:
11490 if (*(ffelex_token_text (ffesta_tokens[0])
11491 + FFESTR_firstlINTERFACEOPERATOR) == '\0')
11492 ffestb_local_.interface.operator
11493 = FFESTP_definedoperatorOPERATOR;
11494 break;
11495
11496 case FFESTR_firstINTERFACEASSGNMNT:
11497 if (*(ffelex_token_text (ffesta_tokens[0])
11498 + FFESTR_firstlINTERFACEASSGNMNT) == '\0')
11499 ffestb_local_.interface.operator
11500 = FFESTP_definedoperatorASSIGNMENT;
11501 break;
11502
11503 case FFESTR_firstINTERFACE:
11504 ffestb_local_.interface.operator = FFESTP_definedoperatorNone;
11505 break;
11506
11507 default:
11508 goto bad_0; /* :::::::::::::::::::: */
11509 }
11510 switch (ffelex_token_type (t))
11511 {
11512 case FFELEX_typeCOMMA:
11513 case FFELEX_typeCOLONCOLON:
11514 ffesta_confirmed (); /* Error, but clearly intended. */
11515 goto bad_1; /* :::::::::::::::::::: */
11516
11517 default:
11518 goto bad_1; /* :::::::::::::::::::: */
11519
11520 case FFELEX_typeOPEN_PAREN:
11521 case FFELEX_typeOPEN_ARRAY: /* Sigh. */
11522 break;
11523
11524 case FFELEX_typeEOS:
11525 case FFELEX_typeSEMICOLON:
11526 ffesta_confirmed ();
11527 if (*p == '\0')
11528 {
11529 if (!ffesta_is_inhibited ())
11530 ffestc_R1202 (FFESTP_definedoperatorNone, NULL);
11531 return (ffelexHandler) ffesta_zero (t);
11532 }
11533 break;
11534 }
11535 if (!ffesrc_is_name_init (*p))
11536 goto bad_i; /* :::::::::::::::::::: */
11537 ffesta_tokens[1] = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
11538 return (ffelexHandler) ffestb_R12021_ (t);
11539
11540 default:
11541 goto bad_0; /* :::::::::::::::::::: */
11542 }
11543
11544 bad_0: /* :::::::::::::::::::: */
11545 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", ffesta_tokens[0]);
11546 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11547
11548 bad_1: /* :::::::::::::::::::: */
11549 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
11550 return (ffelexHandler) ffelex_swallow_tokens (t,
11551 (ffelexHandler) ffesta_zero); /* Invalid second token. */
11552
11553 bad_i: /* :::::::::::::::::::: */
11554 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "INTERFACE", ffesta_tokens[0], i, t);
11555 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11556 }
11557
11558 /* ffestb_R12021_ -- "INTERFACE" NAME
11559
11560 return ffestb_R12021_; // to lexer
11561
11562 Make sure the statement has a valid form for the INTERFACE statement. If
11563 it does, implement the statement. */
11564
11565 static ffelexHandler
11566 ffestb_R12021_ (ffelexToken t)
11567 {
11568 ffestb_local_.interface.slash = TRUE; /* Slash follows open paren. */
11569
11570 switch (ffelex_token_type (t))
11571 {
11572 case FFELEX_typeEOS:
11573 case FFELEX_typeSEMICOLON:
11574 if (!ffesta_is_inhibited ())
11575 ffestc_R1202 (FFESTP_definedoperatorNone, ffesta_tokens[1]);
11576 ffelex_token_kill (ffesta_tokens[1]);
11577 return (ffelexHandler) ffesta_zero (t);
11578
11579 case FFELEX_typeOPEN_PAREN:
11580 ffestb_local_.interface.slash = FALSE; /* Slash doesn't follow. */
11581 /* Fall through. */
11582 case FFELEX_typeOPEN_ARRAY:
11583 switch (ffestb_local_.interface.operator)
11584 {
11585 case FFESTP_definedoperatorNone:
11586 break;
11587
11588 case FFESTP_definedoperatorOPERATOR:
11589 ffestb_local_.interface.assignment = FALSE;
11590 return (ffelexHandler) ffestb_R12022_;
11591
11592 case FFESTP_definedoperatorASSIGNMENT:
11593 ffestb_local_.interface.assignment = TRUE;
11594 return (ffelexHandler) ffestb_R12022_;
11595
11596 default:
11597 assert (FALSE);
11598 }
11599 break;
11600
11601 case FFELEX_typeCOMMA:
11602 case FFELEX_typeCOLONCOLON:
11603 ffesta_confirmed (); /* Error, but clearly intended. */
11604 break;
11605
11606 default:
11607 break;
11608 }
11609
11610 ffelex_token_kill (ffesta_tokens[1]);
11611 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
11612 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11613 }
11614
11615 /* ffestb_R12022_ -- "INTERFACE" "OPERATOR/ASSIGNMENT" OPEN_PAREN
11616
11617 return ffestb_R12022_; // to lexer
11618
11619 Make sure the statement has a valid form for the INTERFACE statement. If
11620 it does, implement the statement. */
11621
11622 static ffelexHandler
11623 ffestb_R12022_ (ffelexToken t)
11624 {
11625 ffesta_tokens[2] = ffelex_token_use (t);
11626
11627 switch (ffelex_token_type (t))
11628 {
11629 case FFELEX_typePERIOD:
11630 if (ffestb_local_.interface.slash)
11631 break;
11632 return (ffelexHandler) ffestb_R12023_;
11633
11634 case FFELEX_typePOWER:
11635 if (ffestb_local_.interface.slash)
11636 break;
11637 ffestb_local_.interface.operator = FFESTP_definedoperatorPOWER;
11638 return (ffelexHandler) ffestb_R12025_;
11639
11640 case FFELEX_typeASTERISK:
11641 if (ffestb_local_.interface.slash)
11642 break;
11643 ffestb_local_.interface.operator = FFESTP_definedoperatorMULT;
11644 return (ffelexHandler) ffestb_R12025_;
11645
11646 case FFELEX_typePLUS:
11647 if (ffestb_local_.interface.slash)
11648 break;
11649 ffestb_local_.interface.operator = FFESTP_definedoperatorADD;
11650 return (ffelexHandler) ffestb_R12025_;
11651
11652 case FFELEX_typeCONCAT:
11653 if (ffestb_local_.interface.slash)
11654 break;
11655 ffestb_local_.interface.operator = FFESTP_definedoperatorCONCAT;
11656 return (ffelexHandler) ffestb_R12025_;
11657
11658 case FFELEX_typeSLASH:
11659 if (ffestb_local_.interface.slash)
11660 {
11661 ffestb_local_.interface.operator = FFESTP_definedoperatorCONCAT;
11662 return (ffelexHandler) ffestb_R12025_;
11663 }
11664 ffestb_local_.interface.operator = FFESTP_definedoperatorDIVIDE;
11665 return (ffelexHandler) ffestb_R12025_;
11666
11667 case FFELEX_typeMINUS:
11668 if (ffestb_local_.interface.slash)
11669 break;
11670 ffestb_local_.interface.operator = FFESTP_definedoperatorSUBTRACT;
11671 return (ffelexHandler) ffestb_R12025_;
11672
11673 case FFELEX_typeREL_EQ:
11674 if (ffestb_local_.interface.slash)
11675 break;
11676 ffestb_local_.interface.operator = FFESTP_definedoperatorEQ;
11677 return (ffelexHandler) ffestb_R12025_;
11678
11679 case FFELEX_typeREL_NE:
11680 if (ffestb_local_.interface.slash)
11681 break;
11682 ffestb_local_.interface.operator = FFESTP_definedoperatorNE;
11683 return (ffelexHandler) ffestb_R12025_;
11684
11685 case FFELEX_typeOPEN_ANGLE:
11686 if (ffestb_local_.interface.slash)
11687 break;
11688 ffestb_local_.interface.operator = FFESTP_definedoperatorLT;
11689 return (ffelexHandler) ffestb_R12025_;
11690
11691 case FFELEX_typeREL_LE:
11692 if (ffestb_local_.interface.slash)
11693 break;
11694 ffestb_local_.interface.operator = FFESTP_definedoperatorLE;
11695 return (ffelexHandler) ffestb_R12025_;
11696
11697 case FFELEX_typeCLOSE_ANGLE:
11698 if (ffestb_local_.interface.slash)
11699 break;
11700 ffestb_local_.interface.operator = FFESTP_definedoperatorGT;
11701 return (ffelexHandler) ffestb_R12025_;
11702
11703 case FFELEX_typeREL_GE:
11704 if (ffestb_local_.interface.slash)
11705 break;
11706 ffestb_local_.interface.operator = FFESTP_definedoperatorGE;
11707 return (ffelexHandler) ffestb_R12025_;
11708
11709 case FFELEX_typeEQUALS:
11710 if (ffestb_local_.interface.slash)
11711 {
11712 ffestb_local_.interface.operator = FFESTP_definedoperatorNE;
11713 return (ffelexHandler) ffestb_R12025_;
11714 }
11715 ffestb_local_.interface.operator = FFESTP_definedoperatorASSIGNMENT;
11716 return (ffelexHandler) ffestb_R12025_;
11717
11718 case FFELEX_typeCLOSE_ARRAY:
11719 if (!ffestb_local_.interface.slash)
11720 {
11721 ffestb_local_.interface.operator = FFESTP_definedoperatorDIVIDE;
11722 return (ffelexHandler) ffestb_R12026_;
11723 }
11724 ffestb_local_.interface.operator = FFESTP_definedoperatorCONCAT;
11725 return (ffelexHandler) ffestb_R12026_;
11726
11727 case FFELEX_typeCLOSE_PAREN:
11728 if (!ffestb_local_.interface.slash)
11729 break;
11730 ffestb_local_.interface.operator = FFESTP_definedoperatorDIVIDE;
11731 return (ffelexHandler) ffestb_R12026_;
11732
11733 default:
11734 break;
11735 }
11736
11737 ffelex_token_kill (ffesta_tokens[1]);
11738 ffelex_token_kill (ffesta_tokens[2]);
11739 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
11740 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11741 }
11742
11743 /* ffestb_R12023_ -- "INTERFACE" NAME OPEN_PAREN PERIOD
11744
11745 return ffestb_R12023_; // to lexer
11746
11747 Make sure the statement has a valid form for the INTERFACE statement. If
11748 it does, implement the statement. */
11749
11750 static ffelexHandler
11751 ffestb_R12023_ (ffelexToken t)
11752 {
11753 switch (ffelex_token_type (t))
11754 {
11755 case FFELEX_typeNAME:
11756 ffelex_token_kill (ffesta_tokens[2]);
11757 ffesta_tokens[2] = ffelex_token_use (t);
11758 return (ffelexHandler) ffestb_R12024_;
11759
11760 default:
11761 break;
11762 }
11763
11764 ffelex_token_kill (ffesta_tokens[1]);
11765 ffelex_token_kill (ffesta_tokens[2]);
11766 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
11767 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11768 }
11769
11770 /* ffestb_R12024_ -- "INTERFACE" NAME OPEN_PAREN PERIOD NAME
11771
11772 return ffestb_R12024_; // to lexer
11773
11774 Make sure the statement has a valid form for the INTERFACE statement. If
11775 it does, implement the statement. */
11776
11777 static ffelexHandler
11778 ffestb_R12024_ (ffelexToken t)
11779 {
11780 switch (ffelex_token_type (t))
11781 {
11782 case FFELEX_typePERIOD:
11783 return (ffelexHandler) ffestb_R12025_;
11784
11785 default:
11786 break;
11787 }
11788
11789 ffelex_token_kill (ffesta_tokens[1]);
11790 ffelex_token_kill (ffesta_tokens[2]);
11791 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
11792 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11793 }
11794
11795 /* ffestb_R12025_ -- "INTERFACE" NAME OPEN_PAREN operator
11796
11797 return ffestb_R12025_; // to lexer
11798
11799 Make sure the statement has a valid form for the INTERFACE statement. If
11800 it does, implement the statement. */
11801
11802 static ffelexHandler
11803 ffestb_R12025_ (ffelexToken t)
11804 {
11805 switch (ffelex_token_type (t))
11806 {
11807 case FFELEX_typeCLOSE_PAREN:
11808 return (ffelexHandler) ffestb_R12026_;
11809
11810 default:
11811 break;
11812 }
11813
11814 ffelex_token_kill (ffesta_tokens[1]);
11815 ffelex_token_kill (ffesta_tokens[2]);
11816 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
11817 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11818 }
11819
11820 /* ffestb_R12026_ -- "INTERFACE" NAME OPEN_PAREN operator CLOSE_PAREN
11821
11822 return ffestb_R12026_; // to lexer
11823
11824 Make sure the statement has a valid form for the INTERFACE statement. If
11825 it does, implement the statement. */
11826
11827 static ffelexHandler
11828 ffestb_R12026_ (ffelexToken t)
11829 {
11830 const char *p;
11831
11832 switch (ffelex_token_type (t))
11833 {
11834 case FFELEX_typeEOS:
11835 case FFELEX_typeSEMICOLON:
11836 ffesta_confirmed ();
11837 if (ffestb_local_.interface.assignment
11838 && (ffestb_local_.interface.operator
11839 != FFESTP_definedoperatorASSIGNMENT))
11840 {
11841 ffebad_start (FFEBAD_INTERFACE_ASSIGNMENT);
11842 ffebad_here (0, ffelex_token_where_line (ffesta_tokens[1]),
11843 ffelex_token_where_column (ffesta_tokens[1]));
11844 ffebad_here (1, ffelex_token_where_line (ffesta_tokens[2]),
11845 ffelex_token_where_column (ffesta_tokens[2]));
11846 ffebad_finish ();
11847 }
11848 switch (ffelex_token_type (ffesta_tokens[2]))
11849 {
11850 case FFELEX_typeNAME:
11851 switch (ffestr_other (ffesta_tokens[2]))
11852 {
11853 case FFESTR_otherNOT:
11854 if (!ffesta_is_inhibited ())
11855 ffestc_R1202 (FFESTP_definedoperatorNOT, NULL);
11856 break;
11857
11858 case FFESTR_otherAND:
11859 if (!ffesta_is_inhibited ())
11860 ffestc_R1202 (FFESTP_definedoperatorAND, NULL);
11861 break;
11862
11863 case FFESTR_otherOR:
11864 if (!ffesta_is_inhibited ())
11865 ffestc_R1202 (FFESTP_definedoperatorOR, NULL);
11866 break;
11867
11868 case FFESTR_otherEQV:
11869 if (!ffesta_is_inhibited ())
11870 ffestc_R1202 (FFESTP_definedoperatorEQV, NULL);
11871 break;
11872
11873 case FFESTR_otherNEQV:
11874 if (!ffesta_is_inhibited ())
11875 ffestc_R1202 (FFESTP_definedoperatorNEQV, NULL);
11876 break;
11877
11878 case FFESTR_otherEQ:
11879 if (!ffesta_is_inhibited ())
11880 ffestc_R1202 (FFESTP_definedoperatorEQ, NULL);
11881 break;
11882
11883 case FFESTR_otherNE:
11884 if (!ffesta_is_inhibited ())
11885 ffestc_R1202 (FFESTP_definedoperatorNE, NULL);
11886 break;
11887
11888 case FFESTR_otherLT:
11889 if (!ffesta_is_inhibited ())
11890 ffestc_R1202 (FFESTP_definedoperatorLT, NULL);
11891 break;
11892
11893 case FFESTR_otherLE:
11894 if (!ffesta_is_inhibited ())
11895 ffestc_R1202 (FFESTP_definedoperatorLE, NULL);
11896 break;
11897
11898 case FFESTR_otherGT:
11899 if (!ffesta_is_inhibited ())
11900 ffestc_R1202 (FFESTP_definedoperatorGT, NULL);
11901 break;
11902
11903 case FFESTR_otherGE:
11904 if (!ffesta_is_inhibited ())
11905 ffestc_R1202 (FFESTP_definedoperatorGE, NULL);
11906 break;
11907
11908 default:
11909 for (p = ffelex_token_text (ffesta_tokens[2]); *p != '\0'; ++p)
11910 {
11911 if (! ISALPHA (*p))
11912 {
11913 ffelex_token_kill (ffesta_tokens[1]);
11914 ffelex_token_kill (ffesta_tokens[2]);
11915 ffesta_ffebad_1t (FFEBAD_INTERFACE_NONLETTER,
11916 ffesta_tokens[2]);
11917 return (ffelexHandler) ffelex_swallow_tokens (t,
11918 (ffelexHandler) ffesta_zero);
11919 }
11920 }
11921 if (!ffesta_is_inhibited ())
11922 ffestc_R1202 (FFESTP_definedoperatorOPERATOR,
11923 ffesta_tokens[2]);
11924 }
11925 break;
11926
11927 case FFELEX_typeEQUALS:
11928 if (!ffestb_local_.interface.assignment
11929 && (ffestb_local_.interface.operator
11930 == FFESTP_definedoperatorASSIGNMENT))
11931 {
11932 ffebad_start (FFEBAD_INTERFACE_OPERATOR);
11933 ffebad_here (0, ffelex_token_where_line (ffesta_tokens[1]),
11934 ffelex_token_where_column (ffesta_tokens[1]));
11935 ffebad_here (1, ffelex_token_where_line (ffesta_tokens[2]),
11936 ffelex_token_where_column (ffesta_tokens[2]));
11937 ffebad_finish ();
11938 }
11939 if (!ffesta_is_inhibited ())
11940 ffestc_R1202 (ffestb_local_.interface.operator, NULL);
11941 break;
11942
11943 default:
11944 if (!ffesta_is_inhibited ())
11945 ffestc_R1202 (ffestb_local_.interface.operator, NULL);
11946 }
11947 ffelex_token_kill (ffesta_tokens[1]);
11948 ffelex_token_kill (ffesta_tokens[2]);
11949 return (ffelexHandler) ffesta_zero (t);
11950
11951 default:
11952 break;
11953 }
11954
11955 ffelex_token_kill (ffesta_tokens[1]);
11956 ffelex_token_kill (ffesta_tokens[2]);
11957 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
11958 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11959 }
11960
11961 #endif
11962 /* ffestb_S3P4 -- Parse the INCLUDE line
11963
11964 return ffestb_S3P4; // to lexer
11965
11966 Make sure the statement has a valid form for the INCLUDE line. If it
11967 does, implement the statement. */
11968
11969 ffelexHandler
11970 ffestb_S3P4 (ffelexToken t)
11971 {
11972 ffeTokenLength i;
11973 const char *p;
11974 ffelexHandler next;
11975 ffelexToken nt;
11976 ffelexToken ut;
11977
11978 switch (ffelex_token_type (ffesta_tokens[0]))
11979 {
11980 case FFELEX_typeNAME:
11981 if (ffesta_first_kw != FFESTR_firstINCLUDE)
11982 goto bad_0; /* :::::::::::::::::::: */
11983 switch (ffelex_token_type (t))
11984 {
11985 case FFELEX_typeNUMBER:
11986 case FFELEX_typeAPOSTROPHE:
11987 case FFELEX_typeQUOTE:
11988 break;
11989
11990 default:
11991 goto bad_1; /* :::::::::::::::::::: */
11992 }
11993 ffesta_confirmed ();
11994 return (ffelexHandler) (*((ffelexHandler)
11995 ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextINCLUDE,
11996 (ffeexprCallback) ffestb_S3P41_)))
11997 (t);
11998
11999 case FFELEX_typeNAMES:
12000 if (ffesta_first_kw != FFESTR_firstINCLUDE)
12001 goto bad_0; /* :::::::::::::::::::: */
12002 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlINCLUDE);
12003 switch (ffelex_token_type (t))
12004 {
12005 default:
12006 goto bad_1; /* :::::::::::::::::::: */
12007
12008 case FFELEX_typeAPOSTROPHE:
12009 case FFELEX_typeQUOTE:
12010 break;
12011 }
12012 ffesta_confirmed ();
12013 if (*p == '\0')
12014 return (ffelexHandler) (*((ffelexHandler)
12015 ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextINCLUDE,
12016 (ffeexprCallback) ffestb_S3P41_)))
12017 (t);
12018 if (! ISDIGIT (*p))
12019 goto bad_i; /* :::::::::::::::::::: */
12020 nt = ffelex_token_number_from_names (ffesta_tokens[0], i);
12021 p += ffelex_token_length (nt);
12022 i += ffelex_token_length (nt);
12023 if ((*p != '_') || (++i, *++p != '\0'))
12024 {
12025 ffelex_token_kill (nt);
12026 goto bad_i; /* :::::::::::::::::::: */
12027 }
12028 ut = ffelex_token_uscore_from_names (ffesta_tokens[0], i - 1);
12029 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs
12030 (ffesta_output_pool, FFEEXPR_contextINCLUDE,
12031 (ffeexprCallback) ffestb_S3P41_)))
12032 (nt);
12033 ffelex_token_kill (nt);
12034 next = (ffelexHandler) (*next) (ut);
12035 ffelex_token_kill (ut);
12036 return (ffelexHandler) (*next) (t);
12037
12038 default:
12039 goto bad_0; /* :::::::::::::::::::: */
12040 }
12041
12042 bad_0: /* :::::::::::::::::::: */
12043 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INCLUDE", ffesta_tokens[0]);
12044 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12045
12046 bad_1: /* :::::::::::::::::::: */
12047 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INCLUDE", t);
12048 return (ffelexHandler) ffelex_swallow_tokens (t,
12049 (ffelexHandler) ffesta_zero); /* Invalid second token. */
12050
12051 bad_i: /* :::::::::::::::::::: */
12052 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "INCLUDE", ffesta_tokens[0], i, t);
12053 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12054 }
12055
12056 /* ffestb_S3P41_ -- "INCLUDE" [NUMBER "_"] expr
12057
12058 (ffestb_S3P41_) // to expression handler
12059
12060 Make sure the next token is an EOS, but not a SEMICOLON. */
12061
12062 static ffelexHandler
12063 ffestb_S3P41_ (ffelexToken ft, ffebld expr, ffelexToken t)
12064 {
12065 switch (ffelex_token_type (t))
12066 {
12067 case FFELEX_typeEOS:
12068 case FFELEX_typeSEMICOLON:
12069 if (expr == NULL)
12070 break;
12071 if (!ffesta_is_inhibited ())
12072 {
12073 if (ffe_is_pedantic ()
12074 && ((ffelex_token_type (t) == FFELEX_typeSEMICOLON)
12075 || ffesta_line_has_semicolons))
12076 {
12077 ffebad_start_msg ("INCLUDE at %0 not the only statement on the source line", FFEBAD_severityWARNING);
12078 ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
12079 ffelex_token_where_column (ffesta_tokens[0]));
12080 ffebad_finish ();
12081 }
12082 ffestc_S3P4 (expr, ft);
12083 }
12084 return (ffelexHandler) ffesta_zero (t);
12085
12086 default:
12087 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INCLUDE", t);
12088 break;
12089 }
12090
12091 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12092 }
12093
12094 /* ffestb_V012 -- Parse the MAP statement
12095
12096 return ffestb_V012; // to lexer
12097
12098 Make sure the statement has a valid form for the MAP statement. If
12099 it does, implement the statement. */
12100
12101 #if FFESTR_VXT
12102 ffelexHandler
12103 ffestb_V012 (ffelexToken t)
12104 {
12105 const char *p;
12106 ffeTokenLength i;
12107
12108 switch (ffelex_token_type (ffesta_tokens[0]))
12109 {
12110 case FFELEX_typeNAME:
12111 if (ffesta_first_kw != FFESTR_firstMAP)
12112 goto bad_0; /* :::::::::::::::::::: */
12113 break;
12114
12115 case FFELEX_typeNAMES:
12116 if (ffesta_first_kw != FFESTR_firstMAP)
12117 goto bad_0; /* :::::::::::::::::::: */
12118 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlMAP)
12119 {
12120 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlMAP);
12121 goto bad_i; /* :::::::::::::::::::: */
12122 }
12123 break;
12124
12125 default:
12126 goto bad_0; /* :::::::::::::::::::: */
12127 }
12128
12129 switch (ffelex_token_type (t))
12130 {
12131 case FFELEX_typeEOS:
12132 case FFELEX_typeSEMICOLON:
12133 ffesta_confirmed ();
12134 if (!ffesta_is_inhibited ())
12135 ffestc_V012 ();
12136 return (ffelexHandler) ffesta_zero (t);
12137
12138 case FFELEX_typeCOMMA:
12139 case FFELEX_typeCOLONCOLON:
12140 ffesta_confirmed (); /* Error, but clearly intended. */
12141 goto bad_1; /* :::::::::::::::::::: */
12142
12143 default:
12144 goto bad_1; /* :::::::::::::::::::: */
12145 }
12146
12147 bad_0: /* :::::::::::::::::::: */
12148 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MAP", ffesta_tokens[0]);
12149 return (ffelexHandler) ffelex_swallow_tokens (t,
12150 (ffelexHandler) ffesta_zero); /* Invalid first token. */
12151
12152 bad_1: /* :::::::::::::::::::: */
12153 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MAP", t);
12154 return (ffelexHandler) ffelex_swallow_tokens (t,
12155 (ffelexHandler) ffesta_zero); /* Invalid second token. */
12156
12157 bad_i: /* :::::::::::::::::::: */
12158 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "MAP", ffesta_tokens[0], i, t);
12159 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12160 }
12161
12162 #endif
12163 /* ffestb_V014 -- Parse the VOLATILE statement
12164
12165 return ffestb_V014; // to lexer
12166
12167 Make sure the statement has a valid form for the VOLATILE statement. If it
12168 does, implement the statement. */
12169
12170 ffelexHandler
12171 ffestb_V014 (ffelexToken t)
12172 {
12173 ffeTokenLength i;
12174 unsigned const char *p;
12175 ffelexToken nt;
12176 ffelexHandler next;
12177
12178 switch (ffelex_token_type (ffesta_tokens[0]))
12179 {
12180 case FFELEX_typeNAME:
12181 if (ffesta_first_kw != FFESTR_firstVOLATILE)
12182 goto bad_0; /* :::::::::::::::::::: */
12183 switch (ffelex_token_type (t))
12184 {
12185 case FFELEX_typeEOS:
12186 case FFELEX_typeSEMICOLON:
12187 case FFELEX_typeCOMMA:
12188 ffesta_confirmed (); /* Error, but clearly intended. */
12189 goto bad_1; /* :::::::::::::::::::: */
12190
12191 default:
12192 goto bad_1; /* :::::::::::::::::::: */
12193
12194 case FFELEX_typeNAME:
12195 case FFELEX_typeSLASH:
12196 ffesta_confirmed ();
12197 if (!ffesta_is_inhibited ())
12198 ffestc_V014_start ();
12199 return (ffelexHandler) ffestb_V0141_ (t);
12200
12201 case FFELEX_typeCOLONCOLON:
12202 ffesta_confirmed ();
12203 if (!ffesta_is_inhibited ())
12204 ffestc_V014_start ();
12205 return (ffelexHandler) ffestb_V0141_;
12206 }
12207
12208 case FFELEX_typeNAMES:
12209 if (ffesta_first_kw != FFESTR_firstVOLATILE)
12210 goto bad_0; /* :::::::::::::::::::: */
12211 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlVOLATILE);
12212 switch (ffelex_token_type (t))
12213 {
12214 default:
12215 goto bad_1; /* :::::::::::::::::::: */
12216
12217 case FFELEX_typeCOMMA:
12218 case FFELEX_typeEOS:
12219 case FFELEX_typeSEMICOLON:
12220 ffesta_confirmed ();
12221 break;
12222
12223 case FFELEX_typeSLASH:
12224 ffesta_confirmed ();
12225 if (*p != '\0')
12226 goto bad_i; /* :::::::::::::::::::: */
12227 if (!ffesta_is_inhibited ())
12228 ffestc_V014_start ();
12229 return (ffelexHandler) ffestb_V0141_ (t);
12230
12231 case FFELEX_typeCOLONCOLON:
12232 ffesta_confirmed ();
12233 if (*p != '\0')
12234 goto bad_i; /* :::::::::::::::::::: */
12235 if (!ffesta_is_inhibited ())
12236 ffestc_V014_start ();
12237 return (ffelexHandler) ffestb_V0141_;
12238 }
12239
12240 /* Here, we have at least one char after "VOLATILE" and t is COMMA or
12241 EOS/SEMICOLON. */
12242
12243 if (!ffesrc_is_name_init (*p))
12244 goto bad_i; /* :::::::::::::::::::: */
12245 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
12246 if (!ffesta_is_inhibited ())
12247 ffestc_V014_start ();
12248 next = (ffelexHandler) ffestb_V0141_ (nt);
12249 ffelex_token_kill (nt);
12250 return (ffelexHandler) (*next) (t);
12251
12252 default:
12253 goto bad_0; /* :::::::::::::::::::: */
12254 }
12255
12256 bad_0: /* :::::::::::::::::::: */
12257 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", ffesta_tokens[0]);
12258 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12259
12260 bad_1: /* :::::::::::::::::::: */
12261 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
12262 return (ffelexHandler) ffelex_swallow_tokens (t,
12263 (ffelexHandler) ffesta_zero); /* Invalid second token. */
12264
12265 bad_i: /* :::::::::::::::::::: */
12266 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "VOLATILE", ffesta_tokens[0], i, t);
12267 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12268 }
12269
12270 /* ffestb_V0141_ -- "VOLATILE" [COLONCOLON]
12271
12272 return ffestb_V0141_; // to lexer
12273
12274 Handle NAME or SLASH. */
12275
12276 static ffelexHandler
12277 ffestb_V0141_ (ffelexToken t)
12278 {
12279 switch (ffelex_token_type (t))
12280 {
12281 case FFELEX_typeNAME:
12282 ffestb_local_.V014.is_cblock = FALSE;
12283 ffesta_tokens[1] = ffelex_token_use (t);
12284 return (ffelexHandler) ffestb_V0144_;
12285
12286 case FFELEX_typeSLASH:
12287 ffestb_local_.V014.is_cblock = TRUE;
12288 return (ffelexHandler) ffestb_V0142_;
12289
12290 default:
12291 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
12292 break;
12293 }
12294
12295 if (!ffesta_is_inhibited ())
12296 ffestc_V014_finish ();
12297 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12298 }
12299
12300 /* ffestb_V0142_ -- "VOLATILE" [COLONCOLON] SLASH
12301
12302 return ffestb_V0142_; // to lexer
12303
12304 Handle NAME. */
12305
12306 static ffelexHandler
12307 ffestb_V0142_ (ffelexToken t)
12308 {
12309 switch (ffelex_token_type (t))
12310 {
12311 case FFELEX_typeNAME:
12312 ffesta_tokens[1] = ffelex_token_use (t);
12313 return (ffelexHandler) ffestb_V0143_;
12314
12315 default:
12316 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
12317 break;
12318 }
12319
12320 if (!ffesta_is_inhibited ())
12321 ffestc_V014_finish ();
12322 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12323 }
12324
12325 /* ffestb_V0143_ -- "VOLATILE" [COLONCOLON] SLASH NAME
12326
12327 return ffestb_V0143_; // to lexer
12328
12329 Handle SLASH. */
12330
12331 static ffelexHandler
12332 ffestb_V0143_ (ffelexToken t)
12333 {
12334 switch (ffelex_token_type (t))
12335 {
12336 case FFELEX_typeSLASH:
12337 return (ffelexHandler) ffestb_V0144_;
12338
12339 default:
12340 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
12341 break;
12342 }
12343
12344 if (!ffesta_is_inhibited ())
12345 ffestc_V014_finish ();
12346 ffelex_token_kill (ffesta_tokens[1]);
12347 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12348 }
12349
12350 /* ffestb_V0144_ -- "VOLATILE" [COLONCOLON] R523
12351
12352 return ffestb_V0144_; // to lexer
12353
12354 Handle COMMA or EOS/SEMICOLON. */
12355
12356 static ffelexHandler
12357 ffestb_V0144_ (ffelexToken t)
12358 {
12359 switch (ffelex_token_type (t))
12360 {
12361 case FFELEX_typeCOMMA:
12362 if (!ffesta_is_inhibited ())
12363 {
12364 if (ffestb_local_.V014.is_cblock)
12365 ffestc_V014_item_cblock (ffesta_tokens[1]);
12366 else
12367 ffestc_V014_item_object (ffesta_tokens[1]);
12368 }
12369 ffelex_token_kill (ffesta_tokens[1]);
12370 return (ffelexHandler) ffestb_V0141_;
12371
12372 case FFELEX_typeEOS:
12373 case FFELEX_typeSEMICOLON:
12374 if (!ffesta_is_inhibited ())
12375 {
12376 if (ffestb_local_.V014.is_cblock)
12377 ffestc_V014_item_cblock (ffesta_tokens[1]);
12378 else
12379 ffestc_V014_item_object (ffesta_tokens[1]);
12380 ffestc_V014_finish ();
12381 }
12382 ffelex_token_kill (ffesta_tokens[1]);
12383 return (ffelexHandler) ffesta_zero (t);
12384
12385 default:
12386 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
12387 break;
12388 }
12389
12390 if (!ffesta_is_inhibited ())
12391 ffestc_V014_finish ();
12392 ffelex_token_kill (ffesta_tokens[1]);
12393 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12394 }
12395
12396 /* ffestb_V025 -- Parse the DEFINEFILE statement
12397
12398 return ffestb_V025; // to lexer
12399
12400 Make sure the statement has a valid form for the DEFINEFILE statement.
12401 If it does, implement the statement. */
12402
12403 #if FFESTR_VXT
12404 ffelexHandler
12405 ffestb_V025 (ffelexToken t)
12406 {
12407 ffeTokenLength i;
12408 const char *p;
12409 ffelexToken nt;
12410 ffelexHandler next;
12411
12412 ffestb_local_.V025.started = FALSE;
12413 switch (ffelex_token_type (ffesta_tokens[0]))
12414 {
12415 case FFELEX_typeNAME:
12416 switch (ffesta_first_kw)
12417 {
12418 case FFESTR_firstDEFINE:
12419 if ((ffelex_token_type (t) != FFELEX_typeNAME)
12420 || (ffesta_second_kw != FFESTR_secondFILE))
12421 goto bad_1; /* :::::::::::::::::::: */
12422 ffesta_confirmed ();
12423 return (ffelexHandler) ffestb_V0251_;
12424
12425 case FFESTR_firstDEFINEFILE:
12426 return (ffelexHandler) ffestb_V0251_ (t);
12427
12428 default:
12429 goto bad_0; /* :::::::::::::::::::: */
12430 }
12431
12432 case FFELEX_typeNAMES:
12433 if (ffesta_first_kw != FFESTR_firstDEFINEFILE)
12434 goto bad_0; /* :::::::::::::::::::: */
12435 switch (ffelex_token_type (t))
12436 {
12437 case FFELEX_typeCOMMA:
12438 case FFELEX_typeEOS:
12439 case FFELEX_typeSEMICOLON:
12440 case FFELEX_typeCOLONCOLON:
12441 ffesta_confirmed (); /* Error, but clearly intended. */
12442 goto bad_1; /* :::::::::::::::::::: */
12443
12444 default:
12445 goto bad_1; /* :::::::::::::::::::: */
12446
12447 case FFELEX_typeOPEN_PAREN:
12448 break;
12449 }
12450 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDEFINEFILE);
12451 if (ISDIGIT (*p))
12452 nt = ffelex_token_number_from_names (ffesta_tokens[0], i);
12453 else if (ffesrc_is_name_init (*p))
12454 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
12455 else
12456 goto bad_i; /* :::::::::::::::::::: */
12457 next = (ffelexHandler) ffestb_V0251_ (nt);
12458 ffelex_token_kill (nt);
12459 return (ffelexHandler) (*next) (t);
12460
12461 default:
12462 goto bad_0; /* :::::::::::::::::::: */
12463 }
12464
12465 bad_0: /* :::::::::::::::::::: */
12466 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", ffesta_tokens[0]);
12467 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12468
12469 bad_1: /* :::::::::::::::::::: */
12470 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
12471 return (ffelexHandler) ffelex_swallow_tokens (t,
12472 (ffelexHandler) ffesta_zero); /* Invalid second token. */
12473
12474 bad_i: /* :::::::::::::::::::: */
12475 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", ffesta_tokens[0], i, t);
12476 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12477 }
12478
12479 /* ffestb_V0251_ -- "DEFINEFILE" or "DEFINE" "FILE"
12480
12481 return ffestb_V0251_; // to lexer
12482
12483 Make sure the statement has a valid form for the DEFINEFILE statement. If it
12484 does, implement the statement. */
12485
12486 static ffelexHandler
12487 ffestb_V0251_ (ffelexToken t)
12488 {
12489 switch (ffelex_token_type (t))
12490 {
12491 case FFELEX_typeNAME:
12492 case FFELEX_typeNUMBER:
12493 if (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME)
12494 ffesta_confirmed ();
12495 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
12496 FFEEXPR_contextFILEUNIT_DF, (ffeexprCallback) ffestb_V0252_)))
12497 (t);
12498
12499 case FFELEX_typeEOS:
12500 case FFELEX_typeSEMICOLON:
12501 case FFELEX_typeCOMMA:
12502 case FFELEX_typeCOLONCOLON:
12503 ffesta_confirmed (); /* Error, but clearly intended. */
12504 break;
12505
12506 default:
12507 break;
12508 }
12509
12510 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
12511 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12512 }
12513
12514 /* ffestb_V0252_ -- "DEFINEFILE" expr
12515
12516 (ffestb_V0252_) // to expression handler
12517
12518 Make sure the statement has a valid form for the DEFINEFILE statement. If
12519 it does, implement the statement. */
12520
12521 static ffelexHandler
12522 ffestb_V0252_ (ffelexToken ft, ffebld expr, ffelexToken t)
12523 {
12524 switch (ffelex_token_type (t))
12525 {
12526 case FFELEX_typeOPEN_PAREN:
12527 ffestb_local_.V025.u = expr;
12528 ffesta_tokens[1] = ffelex_token_use (ft);
12529 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
12530 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0253_);
12531
12532 default:
12533 break;
12534 }
12535
12536 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
12537 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12538 }
12539
12540 /* ffestb_V0253_ -- "DEFINEFILE" expr OPEN_PAREN expr
12541
12542 (ffestb_V0253_) // to expression handler
12543
12544 Make sure the statement has a valid form for the DEFINEFILE statement. If
12545 it does, implement the statement. */
12546
12547 static ffelexHandler
12548 ffestb_V0253_ (ffelexToken ft, ffebld expr, ffelexToken t)
12549 {
12550 switch (ffelex_token_type (t))
12551 {
12552 case FFELEX_typeCOMMA:
12553 ffestb_local_.V025.m = expr;
12554 ffesta_tokens[2] = ffelex_token_use (ft);
12555 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
12556 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0254_);
12557
12558 default:
12559 break;
12560 }
12561
12562 ffelex_token_kill (ffesta_tokens[1]);
12563 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
12564 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12565 }
12566
12567 /* ffestb_V0254_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr
12568
12569 (ffestb_V0254_) // to expression handler
12570
12571 Make sure the statement has a valid form for the DEFINEFILE statement. If
12572 it does, implement the statement. */
12573
12574 static ffelexHandler
12575 ffestb_V0254_ (ffelexToken ft, ffebld expr, ffelexToken t)
12576 {
12577 switch (ffelex_token_type (t))
12578 {
12579 case FFELEX_typeCOMMA:
12580 ffestb_local_.V025.n = expr;
12581 ffesta_tokens[3] = ffelex_token_use (ft);
12582 return (ffelexHandler) ffestb_V0255_;
12583
12584 default:
12585 break;
12586 }
12587
12588 ffelex_token_kill (ffesta_tokens[1]);
12589 ffelex_token_kill (ffesta_tokens[2]);
12590 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
12591 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12592 }
12593
12594 /* ffestb_V0255_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA
12595
12596 return ffestb_V0255_; // to lexer
12597
12598 Make sure the statement has a valid form for the DEFINEFILE statement. If
12599 it does, implement the statement. */
12600
12601 static ffelexHandler
12602 ffestb_V0255_ (ffelexToken t)
12603 {
12604 const char *p;
12605
12606 switch (ffelex_token_type (t))
12607 {
12608 case FFELEX_typeNAME:
12609 p = ffelex_token_text (t);
12610 if (!ffesrc_char_match_init (*p, 'U', 'u') || (*++p != '\0'))
12611 break;
12612 return (ffelexHandler) ffestb_V0256_;
12613
12614 default:
12615 break;
12616 }
12617
12618 ffelex_token_kill (ffesta_tokens[1]);
12619 ffelex_token_kill (ffesta_tokens[2]);
12620 ffelex_token_kill (ffesta_tokens[3]);
12621 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
12622 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12623 }
12624
12625 /* ffestb_V0256_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA "U"
12626
12627 return ffestb_V0256_; // to lexer
12628
12629 Make sure the statement has a valid form for the DEFINEFILE statement. If
12630 it does, implement the statement. */
12631
12632 static ffelexHandler
12633 ffestb_V0256_ (ffelexToken t)
12634 {
12635 switch (ffelex_token_type (t))
12636 {
12637 case FFELEX_typeCOMMA:
12638 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
12639 FFEEXPR_contextFILEASSOC,
12640 (ffeexprCallback) ffestb_V0257_);
12641
12642 default:
12643 break;
12644 }
12645
12646 ffelex_token_kill (ffesta_tokens[1]);
12647 ffelex_token_kill (ffesta_tokens[2]);
12648 ffelex_token_kill (ffesta_tokens[3]);
12649 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
12650 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12651 }
12652
12653 /* ffestb_V0257_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA "U"
12654 COMMA expr
12655
12656 (ffestb_V0257_) // to expression handler
12657
12658 Make sure the statement has a valid form for the DEFINEFILE statement. If
12659 it does, implement the statement. */
12660
12661 static ffelexHandler
12662 ffestb_V0257_ (ffelexToken ft, ffebld expr, ffelexToken t)
12663 {
12664 switch (ffelex_token_type (t))
12665 {
12666 case FFELEX_typeCLOSE_PAREN:
12667 ffestb_local_.V025.asv = expr;
12668 ffesta_tokens[4] = ffelex_token_use (ft);
12669 return (ffelexHandler) ffestb_V0258_;
12670
12671 default:
12672 break;
12673 }
12674
12675 ffelex_token_kill (ffesta_tokens[1]);
12676 ffelex_token_kill (ffesta_tokens[2]);
12677 ffelex_token_kill (ffesta_tokens[3]);
12678 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
12679 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12680 }
12681
12682 /* ffestb_V0258_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA "U"
12683 COMMA expr CLOSE_PAREN
12684
12685 return ffestb_V0258_; // to lexer
12686
12687 Make sure the statement has a valid form for the DEFINEFILE statement. If
12688 it does, implement the statement. */
12689
12690 static ffelexHandler
12691 ffestb_V0258_ (ffelexToken t)
12692 {
12693 switch (ffelex_token_type (t))
12694 {
12695 case FFELEX_typeCOMMA:
12696 case FFELEX_typeEOS:
12697 case FFELEX_typeSEMICOLON:
12698 if (!ffestb_local_.V025.started)
12699 {
12700 ffesta_confirmed ();
12701 if (!ffesta_is_inhibited ())
12702 ffestc_V025_start ();
12703 ffestb_local_.V025.started = TRUE;
12704 }
12705 if (!ffesta_is_inhibited ())
12706 ffestc_V025_item (ffestb_local_.V025.u, ffesta_tokens[1],
12707 ffestb_local_.V025.m, ffesta_tokens[2],
12708 ffestb_local_.V025.n, ffesta_tokens[3],
12709 ffestb_local_.V025.asv, ffesta_tokens[4]);
12710 ffelex_token_kill (ffesta_tokens[1]);
12711 ffelex_token_kill (ffesta_tokens[2]);
12712 ffelex_token_kill (ffesta_tokens[3]);
12713 ffelex_token_kill (ffesta_tokens[4]);
12714 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
12715 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
12716 FFEEXPR_contextFILEUNIT_DF, (ffeexprCallback) ffestb_V0252_);
12717 if (!ffesta_is_inhibited ())
12718 ffestc_V025_finish ();
12719 return (ffelexHandler) ffesta_zero (t);
12720
12721 default:
12722 break;
12723 }
12724
12725 ffelex_token_kill (ffesta_tokens[1]);
12726 ffelex_token_kill (ffesta_tokens[2]);
12727 ffelex_token_kill (ffesta_tokens[3]);
12728 ffelex_token_kill (ffesta_tokens[4]);
12729 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
12730 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12731 }
12732
12733 #endif
12734 /* ffestb_subr_kill_easy_ -- Kill I/O statement data structure
12735
12736 ffestb_subr_kill_easy_();
12737
12738 Kills all tokens in the I/O data structure. Assumes that they are
12739 overlaid with each other (union) in ffest_private.h and the typing
12740 and structure references assume (though not necessarily dangerous if
12741 FALSE) that INQUIRE has the most file elements. */
12742
12743 #if FFESTB_KILL_EASY_
12744 static void
12745 ffestb_subr_kill_easy_ (ffestpInquireIx max)
12746 {
12747 ffestpInquireIx ix;
12748
12749 for (ix = 0; ix < max; ++ix)
12750 {
12751 if (ffestp_file.inquire.inquire_spec[ix].kw_or_val_present)
12752 {
12753 if (ffestp_file.inquire.inquire_spec[ix].kw_present)
12754 ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].kw);
12755 if (ffestp_file.inquire.inquire_spec[ix].value_present)
12756 ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].value);
12757 }
12758 }
12759 }
12760
12761 #endif
12762 /* ffestb_subr_kill_accept_ -- Kill ACCEPT statement data structure
12763
12764 ffestb_subr_kill_accept_();
12765
12766 Kills all tokens in the ACCEPT data structure. */
12767
12768 #if !FFESTB_KILL_EASY_
12769 static void
12770 ffestb_subr_kill_accept_ ()
12771 {
12772 ffestpAcceptIx ix;
12773
12774 for (ix = 0; ix < FFESTP_acceptix; ++ix)
12775 {
12776 if (ffestp_file.accept.accept_spec[ix].kw_or_val_present)
12777 {
12778 if (ffestp_file.accept.accept_spec[ix].kw_present)
12779 ffelex_token_kill (ffestp_file.accept.accept_spec[ix].kw);
12780 if (ffestp_file.accept.accept_spec[ix].value_present)
12781 ffelex_token_kill (ffestp_file.accept.accept_spec[ix].value);
12782 }
12783 }
12784 }
12785
12786 #endif
12787 /* ffestb_subr_kill_beru_ -- Kill BACKSPACE/ENDFILE/REWIND/UNLOCK statement
12788 data structure
12789
12790 ffestb_subr_kill_beru_();
12791
12792 Kills all tokens in the BACKSPACE/ENDFILE/REWIND/UNLOCK data structure. */
12793
12794 #if !FFESTB_KILL_EASY_
12795 static void
12796 ffestb_subr_kill_beru_ ()
12797 {
12798 ffestpBeruIx ix;
12799
12800 for (ix = 0; ix < FFESTP_beruix; ++ix)
12801 {
12802 if (ffestp_file.beru.beru_spec[ix].kw_or_val_present)
12803 {
12804 if (ffestp_file.beru.beru_spec[ix].kw_present)
12805 ffelex_token_kill (ffestp_file.beru.beru_spec[ix].kw);
12806 if (ffestp_file.beru.beru_spec[ix].value_present)
12807 ffelex_token_kill (ffestp_file.beru.beru_spec[ix].value);
12808 }
12809 }
12810 }
12811
12812 #endif
12813 /* ffestb_subr_kill_close_ -- Kill CLOSE statement data structure
12814
12815 ffestb_subr_kill_close_();
12816
12817 Kills all tokens in the CLOSE data structure. */
12818
12819 #if !FFESTB_KILL_EASY_
12820 static void
12821 ffestb_subr_kill_close_ ()
12822 {
12823 ffestpCloseIx ix;
12824
12825 for (ix = 0; ix < FFESTP_closeix; ++ix)
12826 {
12827 if (ffestp_file.close.close_spec[ix].kw_or_val_present)
12828 {
12829 if (ffestp_file.close.close_spec[ix].kw_present)
12830 ffelex_token_kill (ffestp_file.close.close_spec[ix].kw);
12831 if (ffestp_file.close.close_spec[ix].value_present)
12832 ffelex_token_kill (ffestp_file.close.close_spec[ix].value);
12833 }
12834 }
12835 }
12836
12837 #endif
12838 /* ffestb_subr_kill_delete_ -- Kill DELETE statement data structure
12839
12840 ffestb_subr_kill_delete_();
12841
12842 Kills all tokens in the DELETE data structure. */
12843
12844 #if !FFESTB_KILL_EASY_
12845 static void
12846 ffestb_subr_kill_delete_ ()
12847 {
12848 ffestpDeleteIx ix;
12849
12850 for (ix = 0; ix < FFESTP_deleteix; ++ix)
12851 {
12852 if (ffestp_file.delete.delete_spec[ix].kw_or_val_present)
12853 {
12854 if (ffestp_file.delete.delete_spec[ix].kw_present)
12855 ffelex_token_kill (ffestp_file.delete.delete_spec[ix].kw);
12856 if (ffestp_file.delete.delete_spec[ix].value_present)
12857 ffelex_token_kill (ffestp_file.delete.delete_spec[ix].value);
12858 }
12859 }
12860 }
12861
12862 #endif
12863 /* ffestb_subr_kill_inquire_ -- Kill INQUIRE statement data structure
12864
12865 ffestb_subr_kill_inquire_();
12866
12867 Kills all tokens in the INQUIRE data structure. */
12868
12869 #if !FFESTB_KILL_EASY_
12870 static void
12871 ffestb_subr_kill_inquire_ ()
12872 {
12873 ffestpInquireIx ix;
12874
12875 for (ix = 0; ix < FFESTP_inquireix; ++ix)
12876 {
12877 if (ffestp_file.inquire.inquire_spec[ix].kw_or_val_present)
12878 {
12879 if (ffestp_file.inquire.inquire_spec[ix].kw_present)
12880 ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].kw);
12881 if (ffestp_file.inquire.inquire_spec[ix].value_present)
12882 ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].value);
12883 }
12884 }
12885 }
12886
12887 #endif
12888 /* ffestb_subr_kill_open_ -- Kill OPEN statement data structure
12889
12890 ffestb_subr_kill_open_();
12891
12892 Kills all tokens in the OPEN data structure. */
12893
12894 #if !FFESTB_KILL_EASY_
12895 static void
12896 ffestb_subr_kill_open_ ()
12897 {
12898 ffestpOpenIx ix;
12899
12900 for (ix = 0; ix < FFESTP_openix; ++ix)
12901 {
12902 if (ffestp_file.open.open_spec[ix].kw_or_val_present)
12903 {
12904 if (ffestp_file.open.open_spec[ix].kw_present)
12905 ffelex_token_kill (ffestp_file.open.open_spec[ix].kw);
12906 if (ffestp_file.open.open_spec[ix].value_present)
12907 ffelex_token_kill (ffestp_file.open.open_spec[ix].value);
12908 }
12909 }
12910 }
12911
12912 #endif
12913 /* ffestb_subr_kill_print_ -- Kill PRINT statement data structure
12914
12915 ffestb_subr_kill_print_();
12916
12917 Kills all tokens in the PRINT data structure. */
12918
12919 #if !FFESTB_KILL_EASY_
12920 static void
12921 ffestb_subr_kill_print_ ()
12922 {
12923 ffestpPrintIx ix;
12924
12925 for (ix = 0; ix < FFESTP_printix; ++ix)
12926 {
12927 if (ffestp_file.print.print_spec[ix].kw_or_val_present)
12928 {
12929 if (ffestp_file.print.print_spec[ix].kw_present)
12930 ffelex_token_kill (ffestp_file.print.print_spec[ix].kw);
12931 if (ffestp_file.print.print_spec[ix].value_present)
12932 ffelex_token_kill (ffestp_file.print.print_spec[ix].value);
12933 }
12934 }
12935 }
12936
12937 #endif
12938 /* ffestb_subr_kill_read_ -- Kill READ statement data structure
12939
12940 ffestb_subr_kill_read_();
12941
12942 Kills all tokens in the READ data structure. */
12943
12944 #if !FFESTB_KILL_EASY_
12945 static void
12946 ffestb_subr_kill_read_ ()
12947 {
12948 ffestpReadIx ix;
12949
12950 for (ix = 0; ix < FFESTP_readix; ++ix)
12951 {
12952 if (ffestp_file.read.read_spec[ix].kw_or_val_present)
12953 {
12954 if (ffestp_file.read.read_spec[ix].kw_present)
12955 ffelex_token_kill (ffestp_file.read.read_spec[ix].kw);
12956 if (ffestp_file.read.read_spec[ix].value_present)
12957 ffelex_token_kill (ffestp_file.read.read_spec[ix].value);
12958 }
12959 }
12960 }
12961
12962 #endif
12963 /* ffestb_subr_kill_rewrite_ -- Kill REWRITE statement data structure
12964
12965 ffestb_subr_kill_rewrite_();
12966
12967 Kills all tokens in the REWRITE data structure. */
12968
12969 #if !FFESTB_KILL_EASY_
12970 static void
12971 ffestb_subr_kill_rewrite_ ()
12972 {
12973 ffestpRewriteIx ix;
12974
12975 for (ix = 0; ix < FFESTP_rewriteix; ++ix)
12976 {
12977 if (ffestp_file.rewrite.rewrite_spec[ix].kw_or_val_present)
12978 {
12979 if (ffestp_file.rewrite.rewrite_spec[ix].kw_present)
12980 ffelex_token_kill (ffestp_file.rewrite.rewrite_spec[ix].kw);
12981 if (ffestp_file.rewrite.rewrite_spec[ix].value_present)
12982 ffelex_token_kill (ffestp_file.rewrite.rewrite_spec[ix].value);
12983 }
12984 }
12985 }
12986
12987 #endif
12988 /* ffestb_subr_kill_type_ -- Kill TYPE statement data structure
12989
12990 ffestb_subr_kill_type_();
12991
12992 Kills all tokens in the TYPE data structure. */
12993
12994 #if !FFESTB_KILL_EASY_
12995 static void
12996 ffestb_subr_kill_type_ ()
12997 {
12998 ffestpTypeIx ix;
12999
13000 for (ix = 0; ix < FFESTP_typeix; ++ix)
13001 {
13002 if (ffestp_file.type.type_spec[ix].kw_or_val_present)
13003 {
13004 if (ffestp_file.type.type_spec[ix].kw_present)
13005 ffelex_token_kill (ffestp_file.type.type_spec[ix].kw);
13006 if (ffestp_file.type.type_spec[ix].value_present)
13007 ffelex_token_kill (ffestp_file.type.type_spec[ix].value);
13008 }
13009 }
13010 }
13011
13012 #endif
13013 /* ffestb_subr_kill_write_ -- Kill WRITE statement data structure
13014
13015 ffestb_subr_kill_write_();
13016
13017 Kills all tokens in the WRITE data structure. */
13018
13019 #if !FFESTB_KILL_EASY_
13020 static void
13021 ffestb_subr_kill_write_ ()
13022 {
13023 ffestpWriteIx ix;
13024
13025 for (ix = 0; ix < FFESTP_writeix; ++ix)
13026 {
13027 if (ffestp_file.write.write_spec[ix].kw_or_val_present)
13028 {
13029 if (ffestp_file.write.write_spec[ix].kw_present)
13030 ffelex_token_kill (ffestp_file.write.write_spec[ix].kw);
13031 if (ffestp_file.write.write_spec[ix].value_present)
13032 ffelex_token_kill (ffestp_file.write.write_spec[ix].value);
13033 }
13034 }
13035 }
13036
13037 #endif
13038 /* ffestb_beru -- Parse the BACKSPACE/ENDFILE/REWIND/UNLOCK statement
13039
13040 return ffestb_beru; // to lexer
13041
13042 Make sure the statement has a valid form for the BACKSPACE/ENDFILE/REWIND/
13043 UNLOCK statement. If it does, implement the statement. */
13044
13045 ffelexHandler
13046 ffestb_beru (ffelexToken t)
13047 {
13048 ffelexHandler next;
13049 ffestpBeruIx ix;
13050
13051 switch (ffelex_token_type (ffesta_tokens[0]))
13052 {
13053 case FFELEX_typeNAME:
13054 switch (ffelex_token_type (t))
13055 {
13056 case FFELEX_typeCOMMA:
13057 case FFELEX_typeCOLONCOLON:
13058 case FFELEX_typeEOS:
13059 case FFELEX_typeSEMICOLON:
13060 ffesta_confirmed (); /* Error, but clearly intended. */
13061 goto bad_1; /* :::::::::::::::::::: */
13062
13063 case FFELEX_typeEQUALS:
13064 case FFELEX_typePOINTS:
13065 case FFELEX_typeCOLON:
13066 goto bad_1; /* :::::::::::::::::::: */
13067
13068 case FFELEX_typeNAME:
13069 case FFELEX_typeNUMBER:
13070 ffesta_confirmed ();
13071 break;
13072
13073 case FFELEX_typeOPEN_PAREN:
13074 for (ix = 0; ix < FFESTP_beruix; ++ix)
13075 ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
13076 ffesta_tokens[1] = ffelex_token_use (t);
13077 return (ffelexHandler) ffestb_beru2_;
13078
13079 default:
13080 break;
13081 }
13082
13083 for (ix = 0; ix < FFESTP_beruix; ++ix)
13084 ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
13085 return (ffelexHandler) (*((ffelexHandler)
13086 ffeexpr_rhs (ffesta_output_pool,
13087 FFEEXPR_contextFILENUM,
13088 (ffeexprCallback) ffestb_beru1_)))
13089 (t);
13090
13091 case FFELEX_typeNAMES:
13092 switch (ffelex_token_type (t))
13093 {
13094 case FFELEX_typeCOMMA:
13095 case FFELEX_typeCOLONCOLON:
13096 ffesta_confirmed (); /* Error, but clearly intended. */
13097 goto bad_1; /* :::::::::::::::::::: */
13098
13099 case FFELEX_typeEQUALS:
13100 case FFELEX_typePOINTS:
13101 case FFELEX_typeCOLON:
13102 goto bad_1; /* :::::::::::::::::::: */
13103
13104 case FFELEX_typeEOS:
13105 case FFELEX_typeSEMICOLON:
13106 ffesta_confirmed ();
13107 break;
13108
13109 case FFELEX_typeOPEN_PAREN:
13110 if (ffelex_token_length (ffesta_tokens[0])
13111 != ffestb_args.beru.len)
13112 break;
13113
13114 for (ix = 0; ix < FFESTP_beruix; ++ix)
13115 ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
13116 ffesta_tokens[1] = ffelex_token_use (t);
13117 return (ffelexHandler) ffestb_beru2_;
13118
13119 default:
13120 break;
13121 }
13122 for (ix = 0; ix < FFESTP_beruix; ++ix)
13123 ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
13124 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13125 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_beru1_);
13126 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
13127 ffestb_args.beru.len);
13128 if (next == NULL)
13129 return (ffelexHandler) ffelex_swallow_tokens (t,
13130 (ffelexHandler) ffesta_zero);
13131 return (ffelexHandler) (*next) (t);
13132
13133 default:
13134 goto bad_0; /* :::::::::::::::::::: */
13135 }
13136
13137 bad_0: /* :::::::::::::::::::: */
13138 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, ffesta_tokens[0]);
13139 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13140
13141 bad_1: /* :::::::::::::::::::: */
13142 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
13143 return (ffelexHandler) ffelex_swallow_tokens (t,
13144 (ffelexHandler) ffesta_zero); /* Invalid second token. */
13145 }
13146
13147 /* ffestb_beru1_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" expr
13148
13149 (ffestb_beru1_) // to expression handler
13150
13151 Make sure the next token is an EOS or SEMICOLON. */
13152
13153 static ffelexHandler
13154 ffestb_beru1_ (ffelexToken ft, ffebld expr, ffelexToken t)
13155 {
13156 switch (ffelex_token_type (t))
13157 {
13158 case FFELEX_typeEOS:
13159 case FFELEX_typeSEMICOLON:
13160 if (expr == NULL)
13161 break;
13162 ffesta_confirmed ();
13163 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_or_val_present
13164 = TRUE;
13165 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_present = FALSE;
13166 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_present = TRUE;
13167 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_is_label
13168 = FALSE;
13169 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value
13170 = ffelex_token_use (ft);
13171 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].u.expr = expr;
13172 if (!ffesta_is_inhibited ())
13173 {
13174 switch (ffesta_first_kw)
13175 {
13176 case FFESTR_firstBACKSPACE:
13177 ffestc_R919 ();
13178 break;
13179
13180 case FFESTR_firstENDFILE:
13181 case FFESTR_firstEND:
13182 ffestc_R920 ();
13183 break;
13184
13185 case FFESTR_firstREWIND:
13186 ffestc_R921 ();
13187 break;
13188
13189 #if FFESTR_VXT
13190 case FFESTR_firstUNLOCK:
13191 ffestc_V022 ();
13192 break;
13193 #endif
13194
13195 default:
13196 assert (FALSE);
13197 }
13198 }
13199 ffestb_subr_kill_beru_ ();
13200 return (ffelexHandler) ffesta_zero (t);
13201
13202 default:
13203 break;
13204 }
13205
13206 ffestb_subr_kill_beru_ ();
13207 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
13208 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13209 }
13210
13211 /* ffestb_beru2_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN
13212
13213 return ffestb_beru2_; // to lexer
13214
13215 Handle expr construct (not NAME=expr construct) here. */
13216
13217 static ffelexHandler
13218 ffestb_beru2_ (ffelexToken t)
13219 {
13220 ffelexToken nt;
13221 ffelexHandler next;
13222
13223 switch (ffelex_token_type (t))
13224 {
13225 case FFELEX_typeNAME:
13226 ffesta_tokens[2] = ffelex_token_use (t);
13227 return (ffelexHandler) ffestb_beru3_;
13228
13229 default:
13230 nt = ffesta_tokens[1];
13231 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13232 FFEEXPR_contextFILENUMAMBIG, (ffeexprCallback) ffestb_beru4_)))
13233 (nt);
13234 ffelex_token_kill (nt);
13235 return (ffelexHandler) (*next) (t);
13236 }
13237 }
13238
13239 /* ffestb_beru3_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN NAME
13240
13241 return ffestb_beru3_; // to lexer
13242
13243 If EQUALS here, go to states that handle it. Else, send NAME and this
13244 token thru expression handler. */
13245
13246 static ffelexHandler
13247 ffestb_beru3_ (ffelexToken t)
13248 {
13249 ffelexHandler next;
13250 ffelexToken nt;
13251 ffelexToken ot;
13252
13253 switch (ffelex_token_type (t))
13254 {
13255 case FFELEX_typeEQUALS:
13256 ffelex_token_kill (ffesta_tokens[1]);
13257 nt = ffesta_tokens[2];
13258 next = (ffelexHandler) ffestb_beru5_ (nt);
13259 ffelex_token_kill (nt);
13260 return (ffelexHandler) (*next) (t);
13261
13262 default:
13263 nt = ffesta_tokens[1];
13264 ot = ffesta_tokens[2];
13265 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13266 FFEEXPR_contextFILENUMAMBIG, (ffeexprCallback) ffestb_beru4_)))
13267 (nt);
13268 ffelex_token_kill (nt);
13269 next = (ffelexHandler) (*next) (ot);
13270 ffelex_token_kill (ot);
13271 return (ffelexHandler) (*next) (t);
13272 }
13273 }
13274
13275 /* ffestb_beru4_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN expr [CLOSE_PAREN]
13276
13277 (ffestb_beru4_) // to expression handler
13278
13279 Handle COMMA or EOS/SEMICOLON here.
13280
13281 15-Feb-91 JCB 1.2
13282 Now using new mechanism whereby expr comes back as opITEM if the
13283 expr is considered part (or all) of an I/O control list (and should
13284 be stripped of its outer opITEM node) or not if it is considered
13285 a plain unit number that happens to have been enclosed in parens.
13286 26-Mar-90 JCB 1.1
13287 No longer expecting close-paren here because of constructs like
13288 BACKSPACE (5)+2, so now expecting either COMMA because it was a
13289 construct like BACKSPACE (5+2,... or EOS/SEMICOLON because it is like
13290 the former construct. Ah, the vagaries of Fortran. */
13291
13292 static ffelexHandler
13293 ffestb_beru4_ (ffelexToken ft, ffebld expr, ffelexToken t)
13294 {
13295 bool inlist;
13296
13297 switch (ffelex_token_type (t))
13298 {
13299 case FFELEX_typeCOMMA:
13300 case FFELEX_typeEOS:
13301 case FFELEX_typeSEMICOLON:
13302 case FFELEX_typeCLOSE_PAREN:
13303 if (expr == NULL)
13304 break;
13305 if (ffebld_op (expr) == FFEBLD_opITEM)
13306 {
13307 inlist = TRUE;
13308 expr = ffebld_head (expr);
13309 }
13310 else
13311 inlist = FALSE;
13312 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_or_val_present
13313 = TRUE;
13314 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_present = FALSE;
13315 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_present = TRUE;
13316 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_is_label
13317 = FALSE;
13318 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value
13319 = ffelex_token_use (ft);
13320 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].u.expr = expr;
13321 if (inlist)
13322 return (ffelexHandler) ffestb_beru9_ (t);
13323 return (ffelexHandler) ffestb_beru10_ (t);
13324
13325 default:
13326 break;
13327 }
13328
13329 ffestb_subr_kill_beru_ ();
13330 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
13331 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13332 }
13333
13334 /* ffestb_beru5_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN [external-file-unit
13335 COMMA]
13336
13337 return ffestb_beru5_; // to lexer
13338
13339 Handle expr construct (not NAME=expr construct) here. */
13340
13341 static ffelexHandler
13342 ffestb_beru5_ (ffelexToken t)
13343 {
13344 ffestrGenio kw;
13345
13346 ffestb_local_.beru.label = FALSE;
13347
13348 switch (ffelex_token_type (t))
13349 {
13350 case FFELEX_typeNAME:
13351 kw = ffestr_genio (t);
13352 switch (kw)
13353 {
13354 case FFESTR_genioERR:
13355 ffestb_local_.beru.ix = FFESTP_beruixERR;
13356 ffestb_local_.beru.label = TRUE;
13357 break;
13358
13359 case FFESTR_genioIOSTAT:
13360 ffestb_local_.beru.ix = FFESTP_beruixIOSTAT;
13361 ffestb_local_.beru.left = TRUE;
13362 ffestb_local_.beru.context = FFEEXPR_contextFILEINT;
13363 break;
13364
13365 case FFESTR_genioUNIT:
13366 ffestb_local_.beru.ix = FFESTP_beruixUNIT;
13367 ffestb_local_.beru.left = FALSE;
13368 ffestb_local_.beru.context = FFEEXPR_contextFILENUM;
13369 break;
13370
13371 default:
13372 goto bad; /* :::::::::::::::::::: */
13373 }
13374 if (ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
13375 .kw_or_val_present)
13376 break; /* Can't specify a keyword twice! */
13377 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
13378 .kw_or_val_present = TRUE;
13379 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
13380 .kw_present = TRUE;
13381 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
13382 .value_present = FALSE;
13383 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value_is_label
13384 = ffestb_local_.beru.label;
13385 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].kw
13386 = ffelex_token_use (t);
13387 return (ffelexHandler) ffestb_beru6_;
13388
13389 default:
13390 break;
13391 }
13392
13393 bad: /* :::::::::::::::::::: */
13394 ffestb_subr_kill_beru_ ();
13395 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
13396 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13397 }
13398
13399 /* ffestb_beru6_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN [external-file-unit
13400 COMMA] NAME
13401
13402 return ffestb_beru6_; // to lexer
13403
13404 Make sure EQUALS here, send next token to expression handler. */
13405
13406 static ffelexHandler
13407 ffestb_beru6_ (ffelexToken t)
13408 {
13409
13410 switch (ffelex_token_type (t))
13411 {
13412 case FFELEX_typeEQUALS:
13413 ffesta_confirmed ();
13414 if (ffestb_local_.beru.label)
13415 return (ffelexHandler) ffestb_beru8_;
13416 if (ffestb_local_.beru.left)
13417 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
13418 ffestb_local_.beru.context,
13419 (ffeexprCallback) ffestb_beru7_);
13420 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13421 ffestb_local_.beru.context,
13422 (ffeexprCallback) ffestb_beru7_);
13423
13424 default:
13425 break;
13426 }
13427
13428 ffestb_subr_kill_beru_ ();
13429 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
13430 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13431 }
13432
13433 /* ffestb_beru7_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... NAME EQUALS expr
13434
13435 (ffestb_beru7_) // to expression handler
13436
13437 Handle COMMA or CLOSE_PAREN here. */
13438
13439 static ffelexHandler
13440 ffestb_beru7_ (ffelexToken ft, ffebld expr, ffelexToken t)
13441 {
13442 switch (ffelex_token_type (t))
13443 {
13444 case FFELEX_typeCOMMA:
13445 case FFELEX_typeCLOSE_PAREN:
13446 if (expr == NULL)
13447 break;
13448 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value_present
13449 = TRUE;
13450 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value
13451 = ffelex_token_use (ft);
13452 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].u.expr = expr;
13453 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
13454 return (ffelexHandler) ffestb_beru5_;
13455 return (ffelexHandler) ffestb_beru10_;
13456
13457 default:
13458 break;
13459 }
13460
13461 ffestb_subr_kill_beru_ ();
13462 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
13463 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13464 }
13465
13466 /* ffestb_beru8_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... NAME EQUALS
13467
13468 return ffestb_beru8_; // to lexer
13469
13470 Handle NUMBER for label here. */
13471
13472 static ffelexHandler
13473 ffestb_beru8_ (ffelexToken t)
13474 {
13475 switch (ffelex_token_type (t))
13476 {
13477 case FFELEX_typeNUMBER:
13478 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value_present
13479 = TRUE;
13480 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value
13481 = ffelex_token_use (t);
13482 return (ffelexHandler) ffestb_beru9_;
13483
13484 default:
13485 break;
13486 }
13487
13488 ffestb_subr_kill_beru_ ();
13489 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
13490 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13491 }
13492
13493 /* ffestb_beru9_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... NAME EQUALS
13494 NUMBER
13495
13496 return ffestb_beru9_; // to lexer
13497
13498 Handle COMMA or CLOSE_PAREN here. */
13499
13500 static ffelexHandler
13501 ffestb_beru9_ (ffelexToken t)
13502 {
13503 switch (ffelex_token_type (t))
13504 {
13505 case FFELEX_typeCOMMA:
13506 return (ffelexHandler) ffestb_beru5_;
13507
13508 case FFELEX_typeCLOSE_PAREN:
13509 return (ffelexHandler) ffestb_beru10_;
13510
13511 default:
13512 break;
13513 }
13514
13515 ffestb_subr_kill_beru_ ();
13516 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
13517 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13518 }
13519
13520 /* ffestb_beru10_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... CLOSE_PAREN
13521
13522 return ffestb_beru10_; // to lexer
13523
13524 Handle EOS or SEMICOLON here. */
13525
13526 static ffelexHandler
13527 ffestb_beru10_ (ffelexToken t)
13528 {
13529 switch (ffelex_token_type (t))
13530 {
13531 case FFELEX_typeEOS:
13532 case FFELEX_typeSEMICOLON:
13533 ffesta_confirmed ();
13534 if (!ffesta_is_inhibited ())
13535 {
13536 switch (ffesta_first_kw)
13537 {
13538 case FFESTR_firstBACKSPACE:
13539 ffestc_R919 ();
13540 break;
13541
13542 case FFESTR_firstENDFILE:
13543 case FFESTR_firstEND:
13544 ffestc_R920 ();
13545 break;
13546
13547 case FFESTR_firstREWIND:
13548 ffestc_R921 ();
13549 break;
13550
13551 #if FFESTR_VXT
13552 case FFESTR_firstUNLOCK:
13553 ffestc_V022 ();
13554 break;
13555 #endif
13556
13557 default:
13558 assert (FALSE);
13559 }
13560 }
13561 ffestb_subr_kill_beru_ ();
13562 return (ffelexHandler) ffesta_zero (t);
13563
13564 default:
13565 break;
13566 }
13567
13568 ffestb_subr_kill_beru_ ();
13569 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
13570 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13571 }
13572
13573 /* ffestb_vxtcode -- Parse the VXT DECODE/ENCODE statement
13574
13575 return ffestb_vxtcode; // to lexer
13576
13577 Make sure the statement has a valid form for the VXT DECODE/ENCODE
13578 statement. If it does, implement the statement. */
13579
13580 #if FFESTR_VXT
13581 ffelexHandler
13582 ffestb_vxtcode (ffelexToken t)
13583 {
13584 ffestpVxtcodeIx ix;
13585
13586 switch (ffelex_token_type (ffesta_tokens[0]))
13587 {
13588 case FFELEX_typeNAME:
13589 switch (ffelex_token_type (t))
13590 {
13591 case FFELEX_typeCOMMA:
13592 case FFELEX_typeCOLONCOLON:
13593 case FFELEX_typeEOS:
13594 case FFELEX_typeSEMICOLON:
13595 case FFELEX_typeNAME:
13596 case FFELEX_typeNUMBER:
13597 ffesta_confirmed (); /* Error, but clearly intended. */
13598 goto bad_1; /* :::::::::::::::::::: */
13599
13600 default:
13601 goto bad_1; /* :::::::::::::::::::: */
13602
13603 case FFELEX_typeOPEN_PAREN:
13604 for (ix = 0; ix < FFESTP_vxtcodeix; ++ix)
13605 ffestp_file.vxtcode.vxtcode_spec[ix].kw_or_val_present = FALSE;
13606 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13607 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_vxtcode1_);
13608 }
13609
13610 case FFELEX_typeNAMES:
13611 switch (ffelex_token_type (t))
13612 {
13613 case FFELEX_typeEOS:
13614 case FFELEX_typeSEMICOLON:
13615 case FFELEX_typeCOMMA:
13616 case FFELEX_typeCOLONCOLON:
13617 ffesta_confirmed (); /* Error, but clearly intended. */
13618 goto bad_1; /* :::::::::::::::::::: */
13619
13620 default:
13621 goto bad_1; /* :::::::::::::::::::: */
13622
13623 case FFELEX_typeOPEN_PAREN:
13624 if (ffelex_token_length (ffesta_tokens[0])
13625 != ffestb_args.vxtcode.len)
13626 goto bad_0; /* :::::::::::::::::::: */
13627
13628 for (ix = 0; ix < FFESTP_vxtcodeix; ++ix)
13629 ffestp_file.vxtcode.vxtcode_spec[ix].kw_or_val_present = FALSE;
13630 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13631 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_vxtcode1_);
13632 }
13633
13634 default:
13635 goto bad_0; /* :::::::::::::::::::: */
13636 }
13637
13638 bad_0: /* :::::::::::::::::::: */
13639 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, ffesta_tokens[0]);
13640 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13641
13642 bad_1: /* :::::::::::::::::::: */
13643 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
13644 return (ffelexHandler) ffelex_swallow_tokens (t,
13645 (ffelexHandler) ffesta_zero); /* Invalid second token. */
13646 }
13647
13648 /* ffestb_vxtcode1_ -- "VXTCODE" OPEN_PAREN expr
13649
13650 (ffestb_vxtcode1_) // to expression handler
13651
13652 Handle COMMA here. */
13653
13654 static ffelexHandler
13655 ffestb_vxtcode1_ (ffelexToken ft, ffebld expr, ffelexToken t)
13656 {
13657 switch (ffelex_token_type (t))
13658 {
13659 case FFELEX_typeCOMMA:
13660 if (expr == NULL)
13661 break;
13662 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].kw_or_val_present
13663 = TRUE;
13664 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].kw_present = FALSE;
13665 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].value_present = TRUE;
13666 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].value_is_label
13667 = FALSE;
13668 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].value
13669 = ffelex_token_use (ft);
13670 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].u.expr = expr;
13671 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13672 FFEEXPR_contextFILEFORMAT, (ffeexprCallback) ffestb_vxtcode2_);
13673
13674 default:
13675 break;
13676 }
13677
13678 ffestb_subr_kill_vxtcode_ ();
13679 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
13680 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13681 }
13682
13683 /* ffestb_vxtcode2_ -- "VXTCODE" OPEN_PAREN expr COMMA expr
13684
13685 (ffestb_vxtcode2_) // to expression handler
13686
13687 Handle COMMA here. */
13688
13689 static ffelexHandler
13690 ffestb_vxtcode2_ (ffelexToken ft, ffebld expr, ffelexToken t)
13691 {
13692 switch (ffelex_token_type (t))
13693 {
13694 case FFELEX_typeCOMMA:
13695 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].kw_or_val_present
13696 = TRUE;
13697 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].kw_present = FALSE;
13698 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].value_present = TRUE;
13699 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].value_is_label
13700 = (expr == NULL);
13701 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].value
13702 = ffelex_token_use (ft);
13703 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].u.expr = expr;
13704 if (ffesta_first_kw == FFESTR_firstENCODE)
13705 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
13706 FFEEXPR_contextFILEVXTCODE,
13707 (ffeexprCallback) ffestb_vxtcode3_);
13708 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13709 FFEEXPR_contextFILEVXTCODE,
13710 (ffeexprCallback) ffestb_vxtcode3_);
13711
13712 default:
13713 break;
13714 }
13715
13716 ffestb_subr_kill_vxtcode_ ();
13717 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
13718 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13719 }
13720
13721 /* ffestb_vxtcode3_ -- "VXTCODE" OPEN_PAREN expr COMMA expr COMMA expr
13722
13723 (ffestb_vxtcode3_) // to expression handler
13724
13725 Handle COMMA or CLOSE_PAREN here. */
13726
13727 static ffelexHandler
13728 ffestb_vxtcode3_ (ffelexToken ft, ffebld expr, ffelexToken t)
13729 {
13730 switch (ffelex_token_type (t))
13731 {
13732 case FFELEX_typeCOMMA:
13733 case FFELEX_typeCLOSE_PAREN:
13734 if (expr == NULL)
13735 break;
13736 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].kw_or_val_present
13737 = TRUE;
13738 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].kw_present = FALSE;
13739 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].value_present = TRUE;
13740 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].value_is_label
13741 = FALSE;
13742 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].value
13743 = ffelex_token_use (ft);
13744 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].u.expr = expr;
13745 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
13746 return (ffelexHandler) ffestb_vxtcode4_;
13747 return (ffelexHandler) ffestb_vxtcode9_;
13748
13749 default:
13750 break;
13751 }
13752
13753 ffestb_subr_kill_vxtcode_ ();
13754 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
13755 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13756 }
13757
13758 /* ffestb_vxtcode4_ -- "VXTCODE" OPEN_PAREN ...
13759
13760 return ffestb_vxtcode4_; // to lexer
13761
13762 Handle NAME=expr construct here. */
13763
13764 static ffelexHandler
13765 ffestb_vxtcode4_ (ffelexToken t)
13766 {
13767 ffestrGenio kw;
13768
13769 ffestb_local_.vxtcode.label = FALSE;
13770
13771 switch (ffelex_token_type (t))
13772 {
13773 case FFELEX_typeNAME:
13774 kw = ffestr_genio (t);
13775 switch (kw)
13776 {
13777 case FFESTR_genioERR:
13778 ffestb_local_.vxtcode.ix = FFESTP_vxtcodeixERR;
13779 ffestb_local_.vxtcode.label = TRUE;
13780 break;
13781
13782 case FFESTR_genioIOSTAT:
13783 ffestb_local_.vxtcode.ix = FFESTP_vxtcodeixIOSTAT;
13784 ffestb_local_.vxtcode.left = TRUE;
13785 ffestb_local_.vxtcode.context = FFEEXPR_contextFILEINT;
13786 break;
13787
13788 default:
13789 goto bad; /* :::::::::::::::::::: */
13790 }
13791 if (ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix]
13792 .kw_or_val_present)
13793 break; /* Can't specify a keyword twice! */
13794 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix]
13795 .kw_or_val_present = TRUE;
13796 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix]
13797 .kw_present = TRUE;
13798 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix]
13799 .value_present = FALSE;
13800 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value_is_label
13801 = ffestb_local_.vxtcode.label;
13802 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].kw
13803 = ffelex_token_use (t);
13804 return (ffelexHandler) ffestb_vxtcode5_;
13805
13806 default:
13807 break;
13808 }
13809
13810 bad: /* :::::::::::::::::::: */
13811 ffestb_subr_kill_vxtcode_ ();
13812 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
13813 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13814 }
13815
13816 /* ffestb_vxtcode5_ -- "VXTCODE" OPEN_PAREN [external-file-unit COMMA [format
13817 COMMA]] NAME
13818
13819 return ffestb_vxtcode5_; // to lexer
13820
13821 Make sure EQUALS here, send next token to expression handler. */
13822
13823 static ffelexHandler
13824 ffestb_vxtcode5_ (ffelexToken t)
13825 {
13826 switch (ffelex_token_type (t))
13827 {
13828 case FFELEX_typeEQUALS:
13829 ffesta_confirmed ();
13830 if (ffestb_local_.vxtcode.label)
13831 return (ffelexHandler) ffestb_vxtcode7_;
13832 if (ffestb_local_.vxtcode.left)
13833 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
13834 ffestb_local_.vxtcode.context,
13835 (ffeexprCallback) ffestb_vxtcode6_);
13836 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13837 ffestb_local_.vxtcode.context,
13838 (ffeexprCallback) ffestb_vxtcode6_);
13839
13840 default:
13841 break;
13842 }
13843
13844 ffestb_subr_kill_vxtcode_ ();
13845 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
13846 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13847 }
13848
13849 /* ffestb_vxtcode6_ -- "VXTCODE" OPEN_PAREN ... NAME EQUALS expr
13850
13851 (ffestb_vxtcode6_) // to expression handler
13852
13853 Handle COMMA or CLOSE_PAREN here. */
13854
13855 static ffelexHandler
13856 ffestb_vxtcode6_ (ffelexToken ft, ffebld expr, ffelexToken t)
13857 {
13858 switch (ffelex_token_type (t))
13859 {
13860 case FFELEX_typeCOMMA:
13861 case FFELEX_typeCLOSE_PAREN:
13862 if (expr == NULL)
13863 break;
13864 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value_present
13865 = TRUE;
13866 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value
13867 = ffelex_token_use (ft);
13868 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].u.expr = expr;
13869 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
13870 return (ffelexHandler) ffestb_vxtcode4_;
13871 return (ffelexHandler) ffestb_vxtcode9_;
13872
13873 default:
13874 break;
13875 }
13876
13877 ffestb_subr_kill_vxtcode_ ();
13878 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
13879 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13880 }
13881
13882 /* ffestb_vxtcode7_ -- "VXTCODE" OPEN_PAREN ... NAME EQUALS
13883
13884 return ffestb_vxtcode7_; // to lexer
13885
13886 Handle NUMBER for label here. */
13887
13888 static ffelexHandler
13889 ffestb_vxtcode7_ (ffelexToken t)
13890 {
13891 switch (ffelex_token_type (t))
13892 {
13893 case FFELEX_typeNUMBER:
13894 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value_present
13895 = TRUE;
13896 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value
13897 = ffelex_token_use (t);
13898 return (ffelexHandler) ffestb_vxtcode8_;
13899
13900 default:
13901 break;
13902 }
13903
13904 ffestb_subr_kill_vxtcode_ ();
13905 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
13906 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13907 }
13908
13909 /* ffestb_vxtcode8_ -- "VXTCODE" OPEN_PAREN ... NAME EQUALS NUMBER
13910
13911 return ffestb_vxtcode8_; // to lexer
13912
13913 Handle COMMA or CLOSE_PAREN here. */
13914
13915 static ffelexHandler
13916 ffestb_vxtcode8_ (ffelexToken t)
13917 {
13918 switch (ffelex_token_type (t))
13919 {
13920 case FFELEX_typeCOMMA:
13921 return (ffelexHandler) ffestb_vxtcode4_;
13922
13923 case FFELEX_typeCLOSE_PAREN:
13924 return (ffelexHandler) ffestb_vxtcode9_;
13925
13926 default:
13927 break;
13928 }
13929
13930 ffestb_subr_kill_vxtcode_ ();
13931 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
13932 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13933 }
13934
13935 /* ffestb_vxtcode9_ -- "VXTCODE" OPEN_PAREN ... CLOSE_PAREN
13936
13937 return ffestb_vxtcode9_; // to lexer
13938
13939 Handle EOS or SEMICOLON here.
13940
13941 07-Jun-90 JCB 1.1
13942 Context for ENCODE/DECODE expressions is now IOLISTDF instead of IOLIST
13943 since they apply to internal files. */
13944
13945 static ffelexHandler
13946 ffestb_vxtcode9_ (ffelexToken t)
13947 {
13948 ffelexHandler next;
13949
13950 switch (ffelex_token_type (t))
13951 {
13952 case FFELEX_typeEOS:
13953 case FFELEX_typeSEMICOLON:
13954 ffesta_confirmed ();
13955 if (!ffesta_is_inhibited ())
13956 {
13957 if (ffesta_first_kw == FFESTR_firstENCODE)
13958 {
13959 ffestc_V023_start ();
13960 ffestc_V023_finish ();
13961 }
13962 else
13963 {
13964 ffestc_V024_start ();
13965 ffestc_V024_finish ();
13966 }
13967 }
13968 ffestb_subr_kill_vxtcode_ ();
13969 return (ffelexHandler) ffesta_zero (t);
13970
13971 case FFELEX_typeNAME:
13972 case FFELEX_typeOPEN_PAREN:
13973 case FFELEX_typeCOMMA:
13974 ffesta_confirmed ();
13975 if (!ffesta_is_inhibited ())
13976 if (ffesta_first_kw == FFESTR_firstENCODE)
13977 ffestc_V023_start ();
13978 else
13979 ffestc_V024_start ();
13980 ffestb_subr_kill_vxtcode_ ();
13981 if (ffesta_first_kw == FFESTR_firstDECODE)
13982 next = (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
13983 FFEEXPR_contextIOLISTDF,
13984 (ffeexprCallback) ffestb_vxtcode10_);
13985 else
13986 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13987 FFEEXPR_contextIOLISTDF,
13988 (ffeexprCallback) ffestb_vxtcode10_);
13989
13990 /* EXTENSION: Allow an optional preceding COMMA here if not pedantic.
13991 (f2c provides this extension, as do other compilers, supposedly.) */
13992
13993 if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA))
13994 return next;
13995
13996 return (ffelexHandler) (*next) (t);
13997
13998 default:
13999 break;
14000 }
14001
14002 ffestb_subr_kill_vxtcode_ ();
14003 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
14004 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14005 }
14006
14007 /* ffestb_vxtcode10_ -- "VXTCODE(...)" expr
14008
14009 (ffestb_vxtcode10_) // to expression handler
14010
14011 Handle COMMA or EOS/SEMICOLON here.
14012
14013 07-Jun-90 JCB 1.1
14014 Context for ENCODE/DECODE expressions is now IOLISTDF instead of IOLIST
14015 since they apply to internal files. */
14016
14017 static ffelexHandler
14018 ffestb_vxtcode10_ (ffelexToken ft, ffebld expr, ffelexToken t)
14019 {
14020 switch (ffelex_token_type (t))
14021 {
14022 case FFELEX_typeCOMMA:
14023 if (expr == NULL)
14024 break;
14025 if (!ffesta_is_inhibited ())
14026 if (ffesta_first_kw == FFESTR_firstENCODE)
14027 ffestc_V023_item (expr, ft);
14028 else
14029 ffestc_V024_item (expr, ft);
14030 if (ffesta_first_kw == FFESTR_firstDECODE)
14031 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
14032 FFEEXPR_contextIOLISTDF,
14033 (ffeexprCallback) ffestb_vxtcode10_);
14034 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
14035 FFEEXPR_contextIOLISTDF,
14036 (ffeexprCallback) ffestb_vxtcode10_);
14037
14038 case FFELEX_typeEOS:
14039 case FFELEX_typeSEMICOLON:
14040 if (expr == NULL)
14041 break;
14042 if (!ffesta_is_inhibited ())
14043 {
14044 if (ffesta_first_kw == FFESTR_firstENCODE)
14045 {
14046 ffestc_V023_item (expr, ft);
14047 ffestc_V023_finish ();
14048 }
14049 else
14050 {
14051 ffestc_V024_item (expr, ft);
14052 ffestc_V024_finish ();
14053 }
14054 }
14055 return (ffelexHandler) ffesta_zero (t);
14056
14057 default:
14058 break;
14059 }
14060
14061 if (!ffesta_is_inhibited ())
14062 if (ffesta_first_kw == FFESTR_firstENCODE)
14063 ffestc_V023_finish ();
14064 else
14065 ffestc_V024_finish ();
14066 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
14067 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14068 }
14069
14070 #endif
14071 /* ffestb_R904 -- Parse an OPEN statement
14072
14073 return ffestb_R904; // to lexer
14074
14075 Make sure the statement has a valid form for an OPEN statement.
14076 If it does, implement the statement. */
14077
14078 ffelexHandler
14079 ffestb_R904 (ffelexToken t)
14080 {
14081 ffestpOpenIx ix;
14082
14083 switch (ffelex_token_type (ffesta_tokens[0]))
14084 {
14085 case FFELEX_typeNAME:
14086 if (ffesta_first_kw != FFESTR_firstOPEN)
14087 goto bad_0; /* :::::::::::::::::::: */
14088 break;
14089
14090 case FFELEX_typeNAMES:
14091 if (ffesta_first_kw != FFESTR_firstOPEN)
14092 goto bad_0; /* :::::::::::::::::::: */
14093 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlOPEN)
14094 goto bad_0; /* :::::::::::::::::::: */
14095 break;
14096
14097 default:
14098 goto bad_0; /* :::::::::::::::::::: */
14099 }
14100
14101 switch (ffelex_token_type (t))
14102 {
14103 case FFELEX_typeOPEN_PAREN:
14104 break;
14105
14106 case FFELEX_typeEOS:
14107 case FFELEX_typeSEMICOLON:
14108 case FFELEX_typeCOMMA:
14109 case FFELEX_typeCOLONCOLON:
14110 ffesta_confirmed (); /* Error, but clearly intended. */
14111 goto bad_1; /* :::::::::::::::::::: */
14112
14113 default:
14114 goto bad_1; /* :::::::::::::::::::: */
14115 }
14116
14117 for (ix = 0; ix < FFESTP_openix; ++ix)
14118 ffestp_file.open.open_spec[ix].kw_or_val_present = FALSE;
14119
14120 return (ffelexHandler) ffestb_R9041_;
14121
14122 bad_0: /* :::::::::::::::::::: */
14123 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", ffesta_tokens[0]);
14124 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14125
14126 bad_1: /* :::::::::::::::::::: */
14127 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
14128 return (ffelexHandler) ffelex_swallow_tokens (t,
14129 (ffelexHandler) ffesta_zero); /* Invalid second token. */
14130 }
14131
14132 /* ffestb_R9041_ -- "OPEN" OPEN_PAREN
14133
14134 return ffestb_R9041_; // to lexer
14135
14136 Handle expr construct (not NAME=expr construct) here. */
14137
14138 static ffelexHandler
14139 ffestb_R9041_ (ffelexToken t)
14140 {
14141 switch (ffelex_token_type (t))
14142 {
14143 case FFELEX_typeNAME:
14144 ffesta_tokens[1] = ffelex_token_use (t);
14145 return (ffelexHandler) ffestb_R9042_;
14146
14147 default:
14148 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
14149 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9043_)))
14150 (t);
14151 }
14152 }
14153
14154 /* ffestb_R9042_ -- "OPEN" OPEN_PAREN NAME
14155
14156 return ffestb_R9042_; // to lexer
14157
14158 If EQUALS here, go to states that handle it. Else, send NAME and this
14159 token thru expression handler. */
14160
14161 static ffelexHandler
14162 ffestb_R9042_ (ffelexToken t)
14163 {
14164 ffelexHandler next;
14165 ffelexToken nt;
14166
14167 switch (ffelex_token_type (t))
14168 {
14169 case FFELEX_typeEQUALS:
14170 nt = ffesta_tokens[1];
14171 next = (ffelexHandler) ffestb_R9044_ (nt);
14172 ffelex_token_kill (nt);
14173 return (ffelexHandler) (*next) (t);
14174
14175 default:
14176 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
14177 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9043_)))
14178 (ffesta_tokens[1]);
14179 ffelex_token_kill (ffesta_tokens[1]);
14180 return (ffelexHandler) (*next) (t);
14181 }
14182 }
14183
14184 /* ffestb_R9043_ -- "OPEN" OPEN_PAREN expr
14185
14186 (ffestb_R9043_) // to expression handler
14187
14188 Handle COMMA or CLOSE_PAREN here. */
14189
14190 static ffelexHandler
14191 ffestb_R9043_ (ffelexToken ft, ffebld expr, ffelexToken t)
14192 {
14193 switch (ffelex_token_type (t))
14194 {
14195 case FFELEX_typeCOMMA:
14196 case FFELEX_typeCLOSE_PAREN:
14197 if (expr == NULL)
14198 break;
14199 ffestp_file.open.open_spec[FFESTP_openixUNIT].kw_or_val_present
14200 = TRUE;
14201 ffestp_file.open.open_spec[FFESTP_openixUNIT].kw_present = FALSE;
14202 ffestp_file.open.open_spec[FFESTP_openixUNIT].value_present = TRUE;
14203 ffestp_file.open.open_spec[FFESTP_openixUNIT].value_is_label
14204 = FALSE;
14205 ffestp_file.open.open_spec[FFESTP_openixUNIT].value
14206 = ffelex_token_use (ft);
14207 ffestp_file.open.open_spec[FFESTP_openixUNIT].u.expr = expr;
14208 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
14209 return (ffelexHandler) ffestb_R9044_;
14210 return (ffelexHandler) ffestb_R9049_;
14211
14212 default:
14213 break;
14214 }
14215
14216 ffestb_subr_kill_open_ ();
14217 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
14218 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14219 }
14220
14221 /* ffestb_R9044_ -- "OPEN" OPEN_PAREN [external-file-unit COMMA]
14222
14223 return ffestb_R9044_; // to lexer
14224
14225 Handle expr construct (not NAME=expr construct) here. */
14226
14227 static ffelexHandler
14228 ffestb_R9044_ (ffelexToken t)
14229 {
14230 ffestrOpen kw;
14231
14232 ffestb_local_.open.label = FALSE;
14233
14234 switch (ffelex_token_type (t))
14235 {
14236 case FFELEX_typeNAME:
14237 kw = ffestr_open (t);
14238 switch (kw)
14239 {
14240 case FFESTR_openACCESS:
14241 ffestb_local_.open.ix = FFESTP_openixACCESS;
14242 ffestb_local_.open.left = FALSE;
14243 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
14244 break;
14245
14246 case FFESTR_openACTION:
14247 ffestb_local_.open.ix = FFESTP_openixACTION;
14248 ffestb_local_.open.left = FALSE;
14249 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
14250 break;
14251
14252 case FFESTR_openASSOCIATEVARIABLE:
14253 ffestb_local_.open.ix = FFESTP_openixASSOCIATEVARIABLE;
14254 ffestb_local_.open.left = TRUE;
14255 ffestb_local_.open.context = FFEEXPR_contextFILEASSOC;
14256 break;
14257
14258 case FFESTR_openBLANK:
14259 ffestb_local_.open.ix = FFESTP_openixBLANK;
14260 ffestb_local_.open.left = FALSE;
14261 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
14262 break;
14263
14264 case FFESTR_openBLOCKSIZE:
14265 ffestb_local_.open.ix = FFESTP_openixBLOCKSIZE;
14266 ffestb_local_.open.left = FALSE;
14267 ffestb_local_.open.context = FFEEXPR_contextFILENUM;
14268 break;
14269
14270 case FFESTR_openBUFFERCOUNT:
14271 ffestb_local_.open.ix = FFESTP_openixBUFFERCOUNT;
14272 ffestb_local_.open.left = FALSE;
14273 ffestb_local_.open.context = FFEEXPR_contextFILENUM;
14274 break;
14275
14276 case FFESTR_openCARRIAGECONTROL:
14277 ffestb_local_.open.ix = FFESTP_openixCARRIAGECONTROL;
14278 ffestb_local_.open.left = FALSE;
14279 ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
14280 break;
14281
14282 case FFESTR_openDEFAULTFILE:
14283 ffestb_local_.open.ix = FFESTP_openixDEFAULTFILE;
14284 ffestb_local_.open.left = FALSE;
14285 ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
14286 break;
14287
14288 case FFESTR_openDELIM:
14289 ffestb_local_.open.ix = FFESTP_openixDELIM;
14290 ffestb_local_.open.left = FALSE;
14291 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
14292 break;
14293
14294 case FFESTR_openDISP:
14295 case FFESTR_openDISPOSE:
14296 ffestb_local_.open.ix = FFESTP_openixDISPOSE;
14297 ffestb_local_.open.left = FALSE;
14298 ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
14299 break;
14300
14301 case FFESTR_openERR:
14302 ffestb_local_.open.ix = FFESTP_openixERR;
14303 ffestb_local_.open.label = TRUE;
14304 break;
14305
14306 case FFESTR_openEXTENDSIZE:
14307 ffestb_local_.open.ix = FFESTP_openixEXTENDSIZE;
14308 ffestb_local_.open.left = FALSE;
14309 ffestb_local_.open.context = FFEEXPR_contextFILENUM;
14310 break;
14311
14312 case FFESTR_openFILE:
14313 case FFESTR_openNAME:
14314 ffestb_local_.open.ix = FFESTP_openixFILE;
14315 ffestb_local_.open.left = FALSE;
14316 ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
14317 break;
14318
14319 case FFESTR_openFORM:
14320 ffestb_local_.open.ix = FFESTP_openixFORM;
14321 ffestb_local_.open.left = FALSE;
14322 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
14323 break;
14324
14325 case FFESTR_openINITIALSIZE:
14326 ffestb_local_.open.ix = FFESTP_openixINITIALSIZE;
14327 ffestb_local_.open.left = FALSE;
14328 ffestb_local_.open.context = FFEEXPR_contextFILENUM;
14329 break;
14330
14331 case FFESTR_openIOSTAT:
14332 ffestb_local_.open.ix = FFESTP_openixIOSTAT;
14333 ffestb_local_.open.left = TRUE;
14334 ffestb_local_.open.context = FFEEXPR_contextFILEINT;
14335 break;
14336
14337 #if 0 /* Haven't added support for expression
14338 context yet (though easy). */
14339 case FFESTR_openKEY:
14340 ffestb_local_.open.ix = FFESTP_openixKEY;
14341 ffestb_local_.open.left = FALSE;
14342 ffestb_local_.open.context = FFEEXPR_contextFILEKEY;
14343 break;
14344 #endif
14345
14346 case FFESTR_openMAXREC:
14347 ffestb_local_.open.ix = FFESTP_openixMAXREC;
14348 ffestb_local_.open.left = FALSE;
14349 ffestb_local_.open.context = FFEEXPR_contextFILENUM;
14350 break;
14351
14352 case FFESTR_openNOSPANBLOCKS:
14353 if (ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
14354 .kw_or_val_present)
14355 goto bad; /* :::::::::::::::::::: */
14356 ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
14357 .kw_or_val_present = TRUE;
14358 ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
14359 .kw_present = TRUE;
14360 ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
14361 .value_present = FALSE;
14362 ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS].kw
14363 = ffelex_token_use (t);
14364 return (ffelexHandler) ffestb_R9048_;
14365
14366 case FFESTR_openORGANIZATION:
14367 ffestb_local_.open.ix = FFESTP_openixORGANIZATION;
14368 ffestb_local_.open.left = FALSE;
14369 ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
14370 break;
14371
14372 case FFESTR_openPAD:
14373 ffestb_local_.open.ix = FFESTP_openixPAD;
14374 ffestb_local_.open.left = FALSE;
14375 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
14376 break;
14377
14378 case FFESTR_openPOSITION:
14379 ffestb_local_.open.ix = FFESTP_openixPOSITION;
14380 ffestb_local_.open.left = FALSE;
14381 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
14382 break;
14383
14384 case FFESTR_openREADONLY:
14385 if (ffestp_file.open.open_spec[FFESTP_openixREADONLY]
14386 .kw_or_val_present)
14387 goto bad; /* :::::::::::::::::::: */
14388 ffestp_file.open.open_spec[FFESTP_openixREADONLY]
14389 .kw_or_val_present = TRUE;
14390 ffestp_file.open.open_spec[FFESTP_openixREADONLY]
14391 .kw_present = TRUE;
14392 ffestp_file.open.open_spec[FFESTP_openixREADONLY]
14393 .value_present = FALSE;
14394 ffestp_file.open.open_spec[FFESTP_openixREADONLY].kw
14395 = ffelex_token_use (t);
14396 return (ffelexHandler) ffestb_R9048_;
14397
14398 case FFESTR_openRECL:
14399 case FFESTR_openRECORDSIZE:
14400 ffestb_local_.open.ix = FFESTP_openixRECL;
14401 ffestb_local_.open.left = FALSE;
14402 ffestb_local_.open.context = FFEEXPR_contextFILENUM;
14403 break;
14404
14405 case FFESTR_openRECORDTYPE:
14406 ffestb_local_.open.ix = FFESTP_openixRECORDTYPE;
14407 ffestb_local_.open.left = FALSE;
14408 ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
14409 break;
14410
14411 case FFESTR_openSHARED:
14412 if (ffestp_file.open.open_spec[FFESTP_openixSHARED]
14413 .kw_or_val_present)
14414 goto bad; /* :::::::::::::::::::: */
14415 ffestp_file.open.open_spec[FFESTP_openixSHARED]
14416 .kw_or_val_present = TRUE;
14417 ffestp_file.open.open_spec[FFESTP_openixSHARED]
14418 .kw_present = TRUE;
14419 ffestp_file.open.open_spec[FFESTP_openixSHARED]
14420 .value_present = FALSE;
14421 ffestp_file.open.open_spec[FFESTP_openixSHARED].kw
14422 = ffelex_token_use (t);
14423 return (ffelexHandler) ffestb_R9048_;
14424
14425 case FFESTR_openSTATUS:
14426 case FFESTR_openTYPE:
14427 ffestb_local_.open.ix = FFESTP_openixSTATUS;
14428 ffestb_local_.open.left = FALSE;
14429 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
14430 break;
14431
14432 case FFESTR_openUNIT:
14433 ffestb_local_.open.ix = FFESTP_openixUNIT;
14434 ffestb_local_.open.left = FALSE;
14435 ffestb_local_.open.context = FFEEXPR_contextFILENUM;
14436 break;
14437
14438 case FFESTR_openUSEROPEN:
14439 ffestb_local_.open.ix = FFESTP_openixUSEROPEN;
14440 ffestb_local_.open.left = TRUE;
14441 ffestb_local_.open.context = FFEEXPR_contextFILEEXTFUNC;
14442 break;
14443
14444 default:
14445 goto bad; /* :::::::::::::::::::: */
14446 }
14447 if (ffestp_file.open.open_spec[ffestb_local_.open.ix]
14448 .kw_or_val_present)
14449 break; /* Can't specify a keyword twice! */
14450 ffestp_file.open.open_spec[ffestb_local_.open.ix]
14451 .kw_or_val_present = TRUE;
14452 ffestp_file.open.open_spec[ffestb_local_.open.ix]
14453 .kw_present = TRUE;
14454 ffestp_file.open.open_spec[ffestb_local_.open.ix]
14455 .value_present = FALSE;
14456 ffestp_file.open.open_spec[ffestb_local_.open.ix].value_is_label
14457 = ffestb_local_.open.label;
14458 ffestp_file.open.open_spec[ffestb_local_.open.ix].kw
14459 = ffelex_token_use (t);
14460 return (ffelexHandler) ffestb_R9045_;
14461
14462 default:
14463 break;
14464 }
14465
14466 bad: /* :::::::::::::::::::: */
14467 ffestb_subr_kill_open_ ();
14468 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
14469 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14470 }
14471
14472 /* ffestb_R9045_ -- "OPEN" OPEN_PAREN [external-file-unit COMMA] NAME
14473
14474 return ffestb_R9045_; // to lexer
14475
14476 Make sure EQUALS here, send next token to expression handler. */
14477
14478 static ffelexHandler
14479 ffestb_R9045_ (ffelexToken t)
14480 {
14481 switch (ffelex_token_type (t))
14482 {
14483 case FFELEX_typeEQUALS:
14484 ffesta_confirmed ();
14485 if (ffestb_local_.open.label)
14486 return (ffelexHandler) ffestb_R9047_;
14487 if (ffestb_local_.open.left)
14488 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
14489 ffestb_local_.open.context,
14490 (ffeexprCallback) ffestb_R9046_);
14491 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
14492 ffestb_local_.open.context,
14493 (ffeexprCallback) ffestb_R9046_);
14494
14495 default:
14496 break;
14497 }
14498
14499 ffestb_subr_kill_open_ ();
14500 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
14501 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14502 }
14503
14504 /* ffestb_R9046_ -- "OPEN" OPEN_PAREN ... NAME EQUALS expr
14505
14506 (ffestb_R9046_) // to expression handler
14507
14508 Handle COMMA or CLOSE_PAREN here. */
14509
14510 static ffelexHandler
14511 ffestb_R9046_ (ffelexToken ft, ffebld expr, ffelexToken t)
14512 {
14513 switch (ffelex_token_type (t))
14514 {
14515 case FFELEX_typeCOMMA:
14516 case FFELEX_typeCLOSE_PAREN:
14517 if (expr == NULL)
14518 break;
14519 ffestp_file.open.open_spec[ffestb_local_.open.ix].value_present
14520 = TRUE;
14521 ffestp_file.open.open_spec[ffestb_local_.open.ix].value
14522 = ffelex_token_use (ft);
14523 ffestp_file.open.open_spec[ffestb_local_.open.ix].u.expr = expr;
14524 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
14525 return (ffelexHandler) ffestb_R9044_;
14526 return (ffelexHandler) ffestb_R9049_;
14527
14528 default:
14529 break;
14530 }
14531
14532 ffestb_subr_kill_open_ ();
14533 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
14534 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14535 }
14536
14537 /* ffestb_R9047_ -- "OPEN" OPEN_PAREN ... NAME EQUALS
14538
14539 return ffestb_R9047_; // to lexer
14540
14541 Handle NUMBER for label here. */
14542
14543 static ffelexHandler
14544 ffestb_R9047_ (ffelexToken t)
14545 {
14546 switch (ffelex_token_type (t))
14547 {
14548 case FFELEX_typeNUMBER:
14549 ffestp_file.open.open_spec[ffestb_local_.open.ix].value_present
14550 = TRUE;
14551 ffestp_file.open.open_spec[ffestb_local_.open.ix].value
14552 = ffelex_token_use (t);
14553 return (ffelexHandler) ffestb_R9048_;
14554
14555 default:
14556 break;
14557 }
14558
14559 ffestb_subr_kill_open_ ();
14560 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
14561 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14562 }
14563
14564 /* ffestb_R9048_ -- "OPEN" OPEN_PAREN ... NAME EQUALS NUMBER
14565
14566 return ffestb_R9048_; // to lexer
14567
14568 Handle COMMA or CLOSE_PAREN here. */
14569
14570 static ffelexHandler
14571 ffestb_R9048_ (ffelexToken t)
14572 {
14573 switch (ffelex_token_type (t))
14574 {
14575 case FFELEX_typeCOMMA:
14576 return (ffelexHandler) ffestb_R9044_;
14577
14578 case FFELEX_typeCLOSE_PAREN:
14579 return (ffelexHandler) ffestb_R9049_;
14580
14581 default:
14582 break;
14583 }
14584
14585 ffestb_subr_kill_open_ ();
14586 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
14587 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14588 }
14589
14590 /* ffestb_R9049_ -- "OPEN" OPEN_PAREN ... CLOSE_PAREN
14591
14592 return ffestb_R9049_; // to lexer
14593
14594 Handle EOS or SEMICOLON here. */
14595
14596 static ffelexHandler
14597 ffestb_R9049_ (ffelexToken t)
14598 {
14599 switch (ffelex_token_type (t))
14600 {
14601 case FFELEX_typeEOS:
14602 case FFELEX_typeSEMICOLON:
14603 ffesta_confirmed ();
14604 if (!ffesta_is_inhibited ())
14605 ffestc_R904 ();
14606 ffestb_subr_kill_open_ ();
14607 return (ffelexHandler) ffesta_zero (t);
14608
14609 default:
14610 break;
14611 }
14612
14613 ffestb_subr_kill_open_ ();
14614 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
14615 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14616 }
14617
14618 /* ffestb_R907 -- Parse a CLOSE statement
14619
14620 return ffestb_R907; // to lexer
14621
14622 Make sure the statement has a valid form for a CLOSE statement.
14623 If it does, implement the statement. */
14624
14625 ffelexHandler
14626 ffestb_R907 (ffelexToken t)
14627 {
14628 ffestpCloseIx ix;
14629
14630 switch (ffelex_token_type (ffesta_tokens[0]))
14631 {
14632 case FFELEX_typeNAME:
14633 if (ffesta_first_kw != FFESTR_firstCLOSE)
14634 goto bad_0; /* :::::::::::::::::::: */
14635 break;
14636
14637 case FFELEX_typeNAMES:
14638 if (ffesta_first_kw != FFESTR_firstCLOSE)
14639 goto bad_0; /* :::::::::::::::::::: */
14640 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlCLOSE)
14641 goto bad_0; /* :::::::::::::::::::: */
14642 break;
14643
14644 default:
14645 goto bad_0; /* :::::::::::::::::::: */
14646 }
14647
14648 switch (ffelex_token_type (t))
14649 {
14650 case FFELEX_typeOPEN_PAREN:
14651 break;
14652
14653 case FFELEX_typeEOS:
14654 case FFELEX_typeSEMICOLON:
14655 case FFELEX_typeCOMMA:
14656 case FFELEX_typeCOLONCOLON:
14657 ffesta_confirmed (); /* Error, but clearly intended. */
14658 goto bad_1; /* :::::::::::::::::::: */
14659
14660 default:
14661 goto bad_1; /* :::::::::::::::::::: */
14662 }
14663
14664 for (ix = 0; ix < FFESTP_closeix; ++ix)
14665 ffestp_file.close.close_spec[ix].kw_or_val_present = FALSE;
14666
14667 return (ffelexHandler) ffestb_R9071_;
14668
14669 bad_0: /* :::::::::::::::::::: */
14670 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", ffesta_tokens[0]);
14671 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14672
14673 bad_1: /* :::::::::::::::::::: */
14674 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
14675 return (ffelexHandler) ffelex_swallow_tokens (t,
14676 (ffelexHandler) ffesta_zero); /* Invalid second token. */
14677 }
14678
14679 /* ffestb_R9071_ -- "CLOSE" OPEN_PAREN
14680
14681 return ffestb_R9071_; // to lexer
14682
14683 Handle expr construct (not NAME=expr construct) here. */
14684
14685 static ffelexHandler
14686 ffestb_R9071_ (ffelexToken t)
14687 {
14688 switch (ffelex_token_type (t))
14689 {
14690 case FFELEX_typeNAME:
14691 ffesta_tokens[1] = ffelex_token_use (t);
14692 return (ffelexHandler) ffestb_R9072_;
14693
14694 default:
14695 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
14696 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9073_)))
14697 (t);
14698 }
14699 }
14700
14701 /* ffestb_R9072_ -- "CLOSE" OPEN_PAREN NAME
14702
14703 return ffestb_R9072_; // to lexer
14704
14705 If EQUALS here, go to states that handle it. Else, send NAME and this
14706 token thru expression handler. */
14707
14708 static ffelexHandler
14709 ffestb_R9072_ (ffelexToken t)
14710 {
14711 ffelexHandler next;
14712 ffelexToken nt;
14713
14714 switch (ffelex_token_type (t))
14715 {
14716 case FFELEX_typeEQUALS:
14717 nt = ffesta_tokens[1];
14718 next = (ffelexHandler) ffestb_R9074_ (nt);
14719 ffelex_token_kill (nt);
14720 return (ffelexHandler) (*next) (t);
14721
14722 default:
14723 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
14724 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9073_)))
14725 (ffesta_tokens[1]);
14726 ffelex_token_kill (ffesta_tokens[1]);
14727 return (ffelexHandler) (*next) (t);
14728 }
14729 }
14730
14731 /* ffestb_R9073_ -- "CLOSE" OPEN_PAREN expr
14732
14733 (ffestb_R9073_) // to expression handler
14734
14735 Handle COMMA or CLOSE_PAREN here. */
14736
14737 static ffelexHandler
14738 ffestb_R9073_ (ffelexToken ft, ffebld expr, ffelexToken t)
14739 {
14740 switch (ffelex_token_type (t))
14741 {
14742 case FFELEX_typeCOMMA:
14743 case FFELEX_typeCLOSE_PAREN:
14744 if (expr == NULL)
14745 break;
14746 ffestp_file.close.close_spec[FFESTP_closeixUNIT].kw_or_val_present
14747 = TRUE;
14748 ffestp_file.close.close_spec[FFESTP_closeixUNIT].kw_present = FALSE;
14749 ffestp_file.close.close_spec[FFESTP_closeixUNIT].value_present = TRUE;
14750 ffestp_file.close.close_spec[FFESTP_closeixUNIT].value_is_label
14751 = FALSE;
14752 ffestp_file.close.close_spec[FFESTP_closeixUNIT].value
14753 = ffelex_token_use (ft);
14754 ffestp_file.close.close_spec[FFESTP_closeixUNIT].u.expr = expr;
14755 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
14756 return (ffelexHandler) ffestb_R9074_;
14757 return (ffelexHandler) ffestb_R9079_;
14758
14759 default:
14760 break;
14761 }
14762
14763 ffestb_subr_kill_close_ ();
14764 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
14765 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14766 }
14767
14768 /* ffestb_R9074_ -- "CLOSE" OPEN_PAREN [external-file-unit COMMA]
14769
14770 return ffestb_R9074_; // to lexer
14771
14772 Handle expr construct (not NAME=expr construct) here. */
14773
14774 static ffelexHandler
14775 ffestb_R9074_ (ffelexToken t)
14776 {
14777 ffestrGenio kw;
14778
14779 ffestb_local_.close.label = FALSE;
14780
14781 switch (ffelex_token_type (t))
14782 {
14783 case FFELEX_typeNAME:
14784 kw = ffestr_genio (t);
14785 switch (kw)
14786 {
14787 case FFESTR_genioERR:
14788 ffestb_local_.close.ix = FFESTP_closeixERR;
14789 ffestb_local_.close.label = TRUE;
14790 break;
14791
14792 case FFESTR_genioIOSTAT:
14793 ffestb_local_.close.ix = FFESTP_closeixIOSTAT;
14794 ffestb_local_.close.left = TRUE;
14795 ffestb_local_.close.context = FFEEXPR_contextFILEINT;
14796 break;
14797
14798 case FFESTR_genioSTATUS:
14799 case FFESTR_genioDISP:
14800 case FFESTR_genioDISPOSE:
14801 ffestb_local_.close.ix = FFESTP_closeixSTATUS;
14802 ffestb_local_.close.left = FALSE;
14803 ffestb_local_.close.context = FFEEXPR_contextFILEDFCHAR;
14804 break;
14805
14806 case FFESTR_genioUNIT:
14807 ffestb_local_.close.ix = FFESTP_closeixUNIT;
14808 ffestb_local_.close.left = FALSE;
14809 ffestb_local_.close.context = FFEEXPR_contextFILENUM;
14810 break;
14811
14812 default:
14813 goto bad; /* :::::::::::::::::::: */
14814 }
14815 if (ffestp_file.close.close_spec[ffestb_local_.close.ix]
14816 .kw_or_val_present)
14817 break; /* Can't specify a keyword twice! */
14818 ffestp_file.close.close_spec[ffestb_local_.close.ix]
14819 .kw_or_val_present = TRUE;
14820 ffestp_file.close.close_spec[ffestb_local_.close.ix]
14821 .kw_present = TRUE;
14822 ffestp_file.close.close_spec[ffestb_local_.close.ix]
14823 .value_present = FALSE;
14824 ffestp_file.close.close_spec[ffestb_local_.close.ix].value_is_label
14825 = ffestb_local_.close.label;
14826 ffestp_file.close.close_spec[ffestb_local_.close.ix].kw
14827 = ffelex_token_use (t);
14828 return (ffelexHandler) ffestb_R9075_;
14829
14830 default:
14831 break;
14832 }
14833
14834 bad: /* :::::::::::::::::::: */
14835 ffestb_subr_kill_close_ ();
14836 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
14837 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14838 }
14839
14840 /* ffestb_R9075_ -- "CLOSE" OPEN_PAREN [external-file-unit COMMA] NAME
14841
14842 return ffestb_R9075_; // to lexer
14843
14844 Make sure EQUALS here, send next token to expression handler. */
14845
14846 static ffelexHandler
14847 ffestb_R9075_ (ffelexToken t)
14848 {
14849 switch (ffelex_token_type (t))
14850 {
14851 case FFELEX_typeEQUALS:
14852 ffesta_confirmed ();
14853 if (ffestb_local_.close.label)
14854 return (ffelexHandler) ffestb_R9077_;
14855 if (ffestb_local_.close.left)
14856 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
14857 ffestb_local_.close.context,
14858 (ffeexprCallback) ffestb_R9076_);
14859 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
14860 ffestb_local_.close.context,
14861 (ffeexprCallback) ffestb_R9076_);
14862
14863 default:
14864 break;
14865 }
14866
14867 ffestb_subr_kill_close_ ();
14868 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
14869 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14870 }
14871
14872 /* ffestb_R9076_ -- "CLOSE" OPEN_PAREN ... NAME EQUALS expr
14873
14874 (ffestb_R9076_) // to expression handler
14875
14876 Handle COMMA or CLOSE_PAREN here. */
14877
14878 static ffelexHandler
14879 ffestb_R9076_ (ffelexToken ft, ffebld expr, ffelexToken t)
14880 {
14881 switch (ffelex_token_type (t))
14882 {
14883 case FFELEX_typeCOMMA:
14884 case FFELEX_typeCLOSE_PAREN:
14885 if (expr == NULL)
14886 break;
14887 ffestp_file.close.close_spec[ffestb_local_.close.ix].value_present
14888 = TRUE;
14889 ffestp_file.close.close_spec[ffestb_local_.close.ix].value
14890 = ffelex_token_use (ft);
14891 ffestp_file.close.close_spec[ffestb_local_.close.ix].u.expr = expr;
14892 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
14893 return (ffelexHandler) ffestb_R9074_;
14894 return (ffelexHandler) ffestb_R9079_;
14895
14896 default:
14897 break;
14898 }
14899
14900 ffestb_subr_kill_close_ ();
14901 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
14902 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14903 }
14904
14905 /* ffestb_R9077_ -- "CLOSE" OPEN_PAREN ... NAME EQUALS
14906
14907 return ffestb_R9077_; // to lexer
14908
14909 Handle NUMBER for label here. */
14910
14911 static ffelexHandler
14912 ffestb_R9077_ (ffelexToken t)
14913 {
14914 switch (ffelex_token_type (t))
14915 {
14916 case FFELEX_typeNUMBER:
14917 ffestp_file.close.close_spec[ffestb_local_.close.ix].value_present
14918 = TRUE;
14919 ffestp_file.close.close_spec[ffestb_local_.close.ix].value
14920 = ffelex_token_use (t);
14921 return (ffelexHandler) ffestb_R9078_;
14922
14923 default:
14924 break;
14925 }
14926
14927 ffestb_subr_kill_close_ ();
14928 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
14929 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14930 }
14931
14932 /* ffestb_R9078_ -- "CLOSE" OPEN_PAREN ... NAME EQUALS NUMBER
14933
14934 return ffestb_R9078_; // to lexer
14935
14936 Handle COMMA or CLOSE_PAREN here. */
14937
14938 static ffelexHandler
14939 ffestb_R9078_ (ffelexToken t)
14940 {
14941 switch (ffelex_token_type (t))
14942 {
14943 case FFELEX_typeCOMMA:
14944 return (ffelexHandler) ffestb_R9074_;
14945
14946 case FFELEX_typeCLOSE_PAREN:
14947 return (ffelexHandler) ffestb_R9079_;
14948
14949 default:
14950 break;
14951 }
14952
14953 ffestb_subr_kill_close_ ();
14954 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
14955 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14956 }
14957
14958 /* ffestb_R9079_ -- "CLOSE" OPEN_PAREN ... CLOSE_PAREN
14959
14960 return ffestb_R9079_; // to lexer
14961
14962 Handle EOS or SEMICOLON here. */
14963
14964 static ffelexHandler
14965 ffestb_R9079_ (ffelexToken t)
14966 {
14967 switch (ffelex_token_type (t))
14968 {
14969 case FFELEX_typeEOS:
14970 case FFELEX_typeSEMICOLON:
14971 ffesta_confirmed ();
14972 if (!ffesta_is_inhibited ())
14973 ffestc_R907 ();
14974 ffestb_subr_kill_close_ ();
14975 return (ffelexHandler) ffesta_zero (t);
14976
14977 default:
14978 break;
14979 }
14980
14981 ffestb_subr_kill_close_ ();
14982 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
14983 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14984 }
14985
14986 /* ffestb_R909 -- Parse the READ statement
14987
14988 return ffestb_R909; // to lexer
14989
14990 Make sure the statement has a valid form for the READ
14991 statement. If it does, implement the statement. */
14992
14993 ffelexHandler
14994 ffestb_R909 (ffelexToken t)
14995 {
14996 ffelexHandler next;
14997 ffestpReadIx ix;
14998
14999 switch (ffelex_token_type (ffesta_tokens[0]))
15000 {
15001 case FFELEX_typeNAME:
15002 if (ffesta_first_kw != FFESTR_firstREAD)
15003 goto bad_0; /* :::::::::::::::::::: */
15004 switch (ffelex_token_type (t))
15005 {
15006 case FFELEX_typeCOMMA:
15007 case FFELEX_typeCOLONCOLON:
15008 case FFELEX_typeEOS:
15009 case FFELEX_typeSEMICOLON:
15010 ffesta_confirmed (); /* Error, but clearly intended. */
15011 goto bad_1; /* :::::::::::::::::::: */
15012
15013 case FFELEX_typeEQUALS:
15014 case FFELEX_typePOINTS:
15015 case FFELEX_typeCOLON:
15016 goto bad_1; /* :::::::::::::::::::: */
15017
15018 case FFELEX_typeNAME:
15019 case FFELEX_typeNUMBER:
15020 ffesta_confirmed ();
15021 break;
15022
15023 case FFELEX_typeOPEN_PAREN:
15024 for (ix = 0; ix < FFESTP_readix; ++ix)
15025 ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
15026 ffesta_tokens[1] = ffelex_token_use (t);
15027 return (ffelexHandler) ffestb_R9092_;
15028
15029 default:
15030 break;
15031 }
15032
15033 for (ix = 0; ix < FFESTP_readix; ++ix)
15034 ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
15035 return (ffelexHandler) (*((ffelexHandler)
15036 ffeexpr_rhs (ffesta_output_pool,
15037 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9091_)))
15038 (t);
15039
15040 case FFELEX_typeNAMES:
15041 if (ffesta_first_kw != FFESTR_firstREAD)
15042 goto bad_0; /* :::::::::::::::::::: */
15043 switch (ffelex_token_type (t))
15044 {
15045 case FFELEX_typeEOS:
15046 case FFELEX_typeSEMICOLON:
15047 case FFELEX_typeCOMMA:
15048 ffesta_confirmed ();
15049 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlREAD)
15050 break;
15051 goto bad_1; /* :::::::::::::::::::: */
15052
15053 case FFELEX_typeCOLONCOLON:
15054 ffesta_confirmed (); /* Error, but clearly intended. */
15055 goto bad_1; /* :::::::::::::::::::: */
15056
15057 case FFELEX_typeEQUALS:
15058 case FFELEX_typePOINTS:
15059 case FFELEX_typeCOLON:
15060 goto bad_1; /* :::::::::::::::::::: */
15061
15062 case FFELEX_typeOPEN_PAREN:
15063 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlREAD)
15064 break;
15065
15066 for (ix = 0; ix < FFESTP_readix; ++ix)
15067 ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
15068 ffesta_tokens[1] = ffelex_token_use (t);
15069 return (ffelexHandler) ffestb_R9092_;
15070
15071 default:
15072 break;
15073 }
15074 for (ix = 0; ix < FFESTP_readix; ++ix)
15075 ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
15076 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15077 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9091_);
15078 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
15079 FFESTR_firstlREAD);
15080 if (next == NULL)
15081 return (ffelexHandler) ffelex_swallow_tokens (t,
15082 (ffelexHandler) ffesta_zero);
15083 return (ffelexHandler) (*next) (t);
15084
15085 default:
15086 goto bad_0; /* :::::::::::::::::::: */
15087 }
15088
15089 bad_0: /* :::::::::::::::::::: */
15090 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", ffesta_tokens[0]);
15091 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15092
15093 bad_1: /* :::::::::::::::::::: */
15094 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15095 return (ffelexHandler) ffelex_swallow_tokens (t,
15096 (ffelexHandler) ffesta_zero); /* Invalid second token. */
15097 }
15098
15099 /* ffestb_R9091_ -- "READ" expr
15100
15101 (ffestb_R9091_) // to expression handler
15102
15103 Make sure the next token is a COMMA or EOS/SEMICOLON. */
15104
15105 static ffelexHandler
15106 ffestb_R9091_ (ffelexToken ft, ffebld expr, ffelexToken t)
15107 {
15108 switch (ffelex_token_type (t))
15109 {
15110 case FFELEX_typeEOS:
15111 case FFELEX_typeSEMICOLON:
15112 case FFELEX_typeCOMMA:
15113 ffesta_confirmed ();
15114 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_or_val_present
15115 = TRUE;
15116 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_present = FALSE;
15117 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_present = TRUE;
15118 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_is_label
15119 = (expr == NULL);
15120 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value
15121 = ffelex_token_use (ft);
15122 ffestp_file.read.read_spec[FFESTP_readixFORMAT].u.expr = expr;
15123 if (!ffesta_is_inhibited ())
15124 ffestc_R909_start (TRUE);
15125 ffestb_subr_kill_read_ ();
15126 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
15127 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
15128 ffestc_context_iolist (),
15129 (ffeexprCallback) ffestb_R90915_);
15130 if (!ffesta_is_inhibited ())
15131 ffestc_R909_finish ();
15132 return (ffelexHandler) ffesta_zero (t);
15133
15134 default:
15135 break;
15136 }
15137
15138 ffestb_subr_kill_read_ ();
15139 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15140 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15141 }
15142
15143 /* ffestb_R9092_ -- "READ" OPEN_PAREN
15144
15145 return ffestb_R9092_; // to lexer
15146
15147 Handle expr construct (not NAME=expr construct) here. */
15148
15149 static ffelexHandler
15150 ffestb_R9092_ (ffelexToken t)
15151 {
15152 ffelexToken nt;
15153 ffelexHandler next;
15154
15155 switch (ffelex_token_type (t))
15156 {
15157 case FFELEX_typeNAME:
15158 ffesta_tokens[2] = ffelex_token_use (t);
15159 return (ffelexHandler) ffestb_R9093_;
15160
15161 default:
15162 nt = ffesta_tokens[1];
15163 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15164 FFEEXPR_contextFILEUNITAMBIG, (ffeexprCallback) ffestb_R9094_)))
15165 (nt);
15166 ffelex_token_kill (nt);
15167 return (ffelexHandler) (*next) (t);
15168 }
15169 }
15170
15171 /* ffestb_R9093_ -- "READ" OPEN_PAREN NAME
15172
15173 return ffestb_R9093_; // to lexer
15174
15175 If EQUALS here, go to states that handle it. Else, send NAME and this
15176 token thru expression handler. */
15177
15178 static ffelexHandler
15179 ffestb_R9093_ (ffelexToken t)
15180 {
15181 ffelexHandler next;
15182 ffelexToken nt;
15183 ffelexToken ot;
15184
15185 switch (ffelex_token_type (t))
15186 {
15187 case FFELEX_typeEQUALS:
15188 ffelex_token_kill (ffesta_tokens[1]);
15189 nt = ffesta_tokens[2];
15190 next = (ffelexHandler) ffestb_R9098_ (nt);
15191 ffelex_token_kill (nt);
15192 return (ffelexHandler) (*next) (t);
15193
15194 default:
15195 nt = ffesta_tokens[1];
15196 ot = ffesta_tokens[2];
15197 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15198 FFEEXPR_contextFILEUNITAMBIG, (ffeexprCallback) ffestb_R9094_)))
15199 (nt);
15200 ffelex_token_kill (nt);
15201 next = (ffelexHandler) (*next) (ot);
15202 ffelex_token_kill (ot);
15203 return (ffelexHandler) (*next) (t);
15204 }
15205 }
15206
15207 /* ffestb_R9094_ -- "READ" OPEN_PAREN expr [CLOSE_PAREN]
15208
15209 (ffestb_R9094_) // to expression handler
15210
15211 Handle COMMA or EOS/SEMICOLON here.
15212
15213 15-Feb-91 JCB 1.1
15214 Use new ffeexpr mechanism whereby the expr is encased in an opITEM if
15215 ffeexpr decided it was an item in a control list (hence a unit
15216 specifier), or a format specifier otherwise. */
15217
15218 static ffelexHandler
15219 ffestb_R9094_ (ffelexToken ft, ffebld expr, ffelexToken t)
15220 {
15221 if (expr == NULL)
15222 goto bad; /* :::::::::::::::::::: */
15223
15224 if (ffebld_op (expr) != FFEBLD_opITEM)
15225 {
15226 switch (ffelex_token_type (t))
15227 {
15228 case FFELEX_typeCOMMA:
15229 case FFELEX_typeEOS:
15230 case FFELEX_typeSEMICOLON:
15231 ffesta_confirmed ();
15232 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_or_val_present
15233 = TRUE;
15234 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_present = FALSE;
15235 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_present = TRUE;
15236 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_is_label
15237 = FALSE;
15238 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value
15239 = ffelex_token_use (ft);
15240 ffestp_file.read.read_spec[FFESTP_readixFORMAT].u.expr = expr;
15241 if (!ffesta_is_inhibited ())
15242 ffestc_R909_start (TRUE);
15243 ffestb_subr_kill_read_ ();
15244 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
15245 return (ffelexHandler)
15246 ffeexpr_lhs (ffesta_output_pool,
15247 ffestc_context_iolist (),
15248 (ffeexprCallback) ffestb_R90915_);
15249 if (!ffesta_is_inhibited ())
15250 ffestc_R909_finish ();
15251 return (ffelexHandler) ffesta_zero (t);
15252
15253 default:
15254 goto bad; /* :::::::::::::::::::: */
15255 }
15256 }
15257
15258 expr = ffebld_head (expr);
15259
15260 if (expr == NULL)
15261 goto bad; /* :::::::::::::::::::: */
15262
15263 switch (ffelex_token_type (t))
15264 {
15265 case FFELEX_typeCOMMA:
15266 case FFELEX_typeCLOSE_PAREN:
15267 ffestp_file.read.read_spec[FFESTP_readixUNIT].kw_or_val_present
15268 = TRUE;
15269 ffestp_file.read.read_spec[FFESTP_readixUNIT].kw_present = FALSE;
15270 ffestp_file.read.read_spec[FFESTP_readixUNIT].value_present = TRUE;
15271 ffestp_file.read.read_spec[FFESTP_readixUNIT].value_is_label
15272 = FALSE;
15273 ffestp_file.read.read_spec[FFESTP_readixUNIT].value
15274 = ffelex_token_use (ft);
15275 ffestp_file.read.read_spec[FFESTP_readixUNIT].u.expr = expr;
15276 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
15277 return (ffelexHandler) ffestb_R9095_;
15278 return (ffelexHandler) ffestb_R90913_;
15279
15280 default:
15281 break;
15282 }
15283
15284 bad: /* :::::::::::::::::::: */
15285 ffestb_subr_kill_read_ ();
15286 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15287 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15288 }
15289
15290 /* ffestb_R9095_ -- "READ" OPEN_PAREN expr COMMA
15291
15292 return ffestb_R9095_; // to lexer
15293
15294 Handle expr construct (not NAME=expr construct) here. */
15295
15296 static ffelexHandler
15297 ffestb_R9095_ (ffelexToken t)
15298 {
15299 switch (ffelex_token_type (t))
15300 {
15301 case FFELEX_typeNAME:
15302 ffesta_tokens[1] = ffelex_token_use (t);
15303 return (ffelexHandler) ffestb_R9096_;
15304
15305 default:
15306 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15307 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9097_)))
15308 (t);
15309 }
15310 }
15311
15312 /* ffestb_R9096_ -- "READ" OPEN_PAREN expr COMMA NAME
15313
15314 return ffestb_R9096_; // to lexer
15315
15316 If EQUALS here, go to states that handle it. Else, send NAME and this
15317 token thru expression handler. */
15318
15319 static ffelexHandler
15320 ffestb_R9096_ (ffelexToken t)
15321 {
15322 ffelexHandler next;
15323 ffelexToken nt;
15324
15325 switch (ffelex_token_type (t))
15326 {
15327 case FFELEX_typeEQUALS:
15328 nt = ffesta_tokens[1];
15329 next = (ffelexHandler) ffestb_R9098_ (nt);
15330 ffelex_token_kill (nt);
15331 return (ffelexHandler) (*next) (t);
15332
15333 default:
15334 nt = ffesta_tokens[1];
15335 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15336 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9097_)))
15337 (nt);
15338 ffelex_token_kill (nt);
15339 return (ffelexHandler) (*next) (t);
15340 }
15341 }
15342
15343 /* ffestb_R9097_ -- "READ" OPEN_PAREN expr COMMA expr
15344
15345 (ffestb_R9097_) // to expression handler
15346
15347 Handle COMMA or CLOSE_PAREN here. */
15348
15349 static ffelexHandler
15350 ffestb_R9097_ (ffelexToken ft, ffebld expr, ffelexToken t)
15351 {
15352 switch (ffelex_token_type (t))
15353 {
15354 case FFELEX_typeCOMMA:
15355 case FFELEX_typeCLOSE_PAREN:
15356 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_or_val_present
15357 = TRUE;
15358 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_present = FALSE;
15359 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_present = TRUE;
15360 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_is_label
15361 = (expr == NULL);
15362 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value
15363 = ffelex_token_use (ft);
15364 ffestp_file.read.read_spec[FFESTP_readixFORMAT].u.expr = expr;
15365 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
15366 return (ffelexHandler) ffestb_R9098_;
15367 return (ffelexHandler) ffestb_R90913_;
15368
15369 default:
15370 break;
15371 }
15372
15373 ffestb_subr_kill_read_ ();
15374 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15375 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15376 }
15377
15378 /* ffestb_R9098_ -- "READ" OPEN_PAREN [external-file-unit COMMA [format
15379 COMMA]]
15380
15381 return ffestb_R9098_; // to lexer
15382
15383 Handle expr construct (not NAME=expr construct) here. */
15384
15385 static ffelexHandler
15386 ffestb_R9098_ (ffelexToken t)
15387 {
15388 ffestrGenio kw;
15389
15390 ffestb_local_.read.label = FALSE;
15391
15392 switch (ffelex_token_type (t))
15393 {
15394 case FFELEX_typeNAME:
15395 kw = ffestr_genio (t);
15396 switch (kw)
15397 {
15398 case FFESTR_genioADVANCE:
15399 ffestb_local_.read.ix = FFESTP_readixADVANCE;
15400 ffestb_local_.read.left = FALSE;
15401 ffestb_local_.read.context = FFEEXPR_contextFILEDFCHAR;
15402 break;
15403
15404 case FFESTR_genioEOR:
15405 ffestb_local_.read.ix = FFESTP_readixEOR;
15406 ffestb_local_.read.label = TRUE;
15407 break;
15408
15409 case FFESTR_genioERR:
15410 ffestb_local_.read.ix = FFESTP_readixERR;
15411 ffestb_local_.read.label = TRUE;
15412 break;
15413
15414 case FFESTR_genioEND:
15415 ffestb_local_.read.ix = FFESTP_readixEND;
15416 ffestb_local_.read.label = TRUE;
15417 break;
15418
15419 case FFESTR_genioFMT:
15420 ffestb_local_.read.ix = FFESTP_readixFORMAT;
15421 ffestb_local_.read.left = FALSE;
15422 ffestb_local_.read.context = FFEEXPR_contextFILEFORMAT;
15423 break;
15424
15425 case FFESTR_genioIOSTAT:
15426 ffestb_local_.read.ix = FFESTP_readixIOSTAT;
15427 ffestb_local_.read.left = TRUE;
15428 ffestb_local_.read.context = FFEEXPR_contextFILEINT;
15429 break;
15430
15431 case FFESTR_genioKEY:
15432 case FFESTR_genioKEYEQ:
15433 ffestb_local_.read.ix = FFESTP_readixKEYEQ;
15434 ffestb_local_.read.left = FALSE;
15435 ffestb_local_.read.context = FFEEXPR_contextFILENUMCHAR;
15436 break;
15437
15438 case FFESTR_genioKEYGE:
15439 ffestb_local_.read.ix = FFESTP_readixKEYGE;
15440 ffestb_local_.read.left = FALSE;
15441 ffestb_local_.read.context = FFEEXPR_contextFILENUMCHAR;
15442 break;
15443
15444 case FFESTR_genioKEYGT:
15445 ffestb_local_.read.ix = FFESTP_readixKEYGT;
15446 ffestb_local_.read.left = FALSE;
15447 ffestb_local_.read.context = FFEEXPR_contextFILENUMCHAR;
15448 break;
15449
15450 case FFESTR_genioKEYID:
15451 ffestb_local_.read.ix = FFESTP_readixKEYID;
15452 ffestb_local_.read.left = FALSE;
15453 ffestb_local_.read.context = FFEEXPR_contextFILENUM;
15454 break;
15455
15456 case FFESTR_genioNML:
15457 ffestb_local_.read.ix = FFESTP_readixFORMAT;
15458 ffestb_local_.read.left = TRUE;
15459 ffestb_local_.read.context = FFEEXPR_contextFILENAMELIST;
15460 break;
15461
15462 case FFESTR_genioNULLS:
15463 ffestb_local_.read.ix = FFESTP_readixNULLS;
15464 ffestb_local_.read.left = TRUE;
15465 ffestb_local_.read.context = FFEEXPR_contextFILEINT;
15466 break;
15467
15468 case FFESTR_genioREC:
15469 ffestb_local_.read.ix = FFESTP_readixREC;
15470 ffestb_local_.read.left = FALSE;
15471 ffestb_local_.read.context = FFEEXPR_contextFILENUM;
15472 break;
15473
15474 case FFESTR_genioSIZE:
15475 ffestb_local_.read.ix = FFESTP_readixSIZE;
15476 ffestb_local_.read.left = TRUE;
15477 ffestb_local_.read.context = FFEEXPR_contextFILEINT;
15478 break;
15479
15480 case FFESTR_genioUNIT:
15481 ffestb_local_.read.ix = FFESTP_readixUNIT;
15482 ffestb_local_.read.left = FALSE;
15483 ffestb_local_.read.context = FFEEXPR_contextFILEUNIT;
15484 break;
15485
15486 default:
15487 goto bad; /* :::::::::::::::::::: */
15488 }
15489 if (ffestp_file.read.read_spec[ffestb_local_.read.ix]
15490 .kw_or_val_present)
15491 break; /* Can't specify a keyword twice! */
15492 ffestp_file.read.read_spec[ffestb_local_.read.ix]
15493 .kw_or_val_present = TRUE;
15494 ffestp_file.read.read_spec[ffestb_local_.read.ix]
15495 .kw_present = TRUE;
15496 ffestp_file.read.read_spec[ffestb_local_.read.ix]
15497 .value_present = FALSE;
15498 ffestp_file.read.read_spec[ffestb_local_.read.ix].value_is_label
15499 = ffestb_local_.read.label;
15500 ffestp_file.read.read_spec[ffestb_local_.read.ix].kw
15501 = ffelex_token_use (t);
15502 return (ffelexHandler) ffestb_R9099_;
15503
15504 default:
15505 break;
15506 }
15507
15508 bad: /* :::::::::::::::::::: */
15509 ffestb_subr_kill_read_ ();
15510 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15511 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15512 }
15513
15514 /* ffestb_R9099_ -- "READ" OPEN_PAREN [external-file-unit COMMA [format
15515 COMMA]] NAME
15516
15517 return ffestb_R9099_; // to lexer
15518
15519 Make sure EQUALS here, send next token to expression handler. */
15520
15521 static ffelexHandler
15522 ffestb_R9099_ (ffelexToken t)
15523 {
15524 switch (ffelex_token_type (t))
15525 {
15526 case FFELEX_typeEQUALS:
15527 ffesta_confirmed ();
15528 if (ffestb_local_.read.label)
15529 return (ffelexHandler) ffestb_R90911_;
15530 if (ffestb_local_.read.left)
15531 return (ffelexHandler)
15532 ffeexpr_lhs (ffesta_output_pool,
15533 ffestb_local_.read.context,
15534 (ffeexprCallback) ffestb_R90910_);
15535 return (ffelexHandler)
15536 ffeexpr_rhs (ffesta_output_pool,
15537 ffestb_local_.read.context,
15538 (ffeexprCallback) ffestb_R90910_);
15539
15540 default:
15541 break;
15542 }
15543
15544 ffestb_subr_kill_read_ ();
15545 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15546 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15547 }
15548
15549 /* ffestb_R90910_ -- "READ" OPEN_PAREN ... NAME EQUALS expr
15550
15551 (ffestb_R90910_) // to expression handler
15552
15553 Handle COMMA or CLOSE_PAREN here. */
15554
15555 static ffelexHandler
15556 ffestb_R90910_ (ffelexToken ft, ffebld expr, ffelexToken t)
15557 {
15558 switch (ffelex_token_type (t))
15559 {
15560 case FFELEX_typeCOMMA:
15561 case FFELEX_typeCLOSE_PAREN:
15562 if (expr == NULL)
15563 {
15564 if (ffestb_local_.read.context == FFEEXPR_contextFILEFORMAT)
15565 ffestp_file.read.read_spec[ffestb_local_.read.ix]
15566 .value_is_label = TRUE;
15567 else
15568 break;
15569 }
15570 ffestp_file.read.read_spec[ffestb_local_.read.ix].value_present
15571 = TRUE;
15572 ffestp_file.read.read_spec[ffestb_local_.read.ix].value
15573 = ffelex_token_use (ft);
15574 ffestp_file.read.read_spec[ffestb_local_.read.ix].u.expr = expr;
15575 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
15576 return (ffelexHandler) ffestb_R9098_;
15577 return (ffelexHandler) ffestb_R90913_;
15578
15579 default:
15580 break;
15581 }
15582
15583 ffestb_subr_kill_read_ ();
15584 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15585 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15586 }
15587
15588 /* ffestb_R90911_ -- "READ" OPEN_PAREN ... NAME EQUALS
15589
15590 return ffestb_R90911_; // to lexer
15591
15592 Handle NUMBER for label here. */
15593
15594 static ffelexHandler
15595 ffestb_R90911_ (ffelexToken t)
15596 {
15597 switch (ffelex_token_type (t))
15598 {
15599 case FFELEX_typeNUMBER:
15600 ffestp_file.read.read_spec[ffestb_local_.read.ix].value_present
15601 = TRUE;
15602 ffestp_file.read.read_spec[ffestb_local_.read.ix].value
15603 = ffelex_token_use (t);
15604 return (ffelexHandler) ffestb_R90912_;
15605
15606 default:
15607 break;
15608 }
15609
15610 ffestb_subr_kill_read_ ();
15611 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15612 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15613 }
15614
15615 /* ffestb_R90912_ -- "READ" OPEN_PAREN ... NAME EQUALS NUMBER
15616
15617 return ffestb_R90912_; // to lexer
15618
15619 Handle COMMA or CLOSE_PAREN here. */
15620
15621 static ffelexHandler
15622 ffestb_R90912_ (ffelexToken t)
15623 {
15624 switch (ffelex_token_type (t))
15625 {
15626 case FFELEX_typeCOMMA:
15627 return (ffelexHandler) ffestb_R9098_;
15628
15629 case FFELEX_typeCLOSE_PAREN:
15630 return (ffelexHandler) ffestb_R90913_;
15631
15632 default:
15633 break;
15634 }
15635
15636 ffestb_subr_kill_read_ ();
15637 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15638 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15639 }
15640
15641 /* ffestb_R90913_ -- "READ" OPEN_PAREN ... CLOSE_PAREN
15642
15643 return ffestb_R90913_; // to lexer
15644
15645 Handle EOS or SEMICOLON here.
15646
15647 15-Feb-91 JCB 1.1
15648 Fix to allow implied-DO construct here (OPEN_PAREN) -- actually,
15649 don't presume knowledge of what an initial token in an lhs context
15650 is going to be, let ffeexpr_lhs handle that as much as possible. */
15651
15652 static ffelexHandler
15653 ffestb_R90913_ (ffelexToken t)
15654 {
15655 switch (ffelex_token_type (t))
15656 {
15657 case FFELEX_typeEOS:
15658 case FFELEX_typeSEMICOLON:
15659 ffesta_confirmed ();
15660 if (!ffesta_is_inhibited ())
15661 {
15662 ffestc_R909_start (FALSE);
15663 ffestc_R909_finish ();
15664 }
15665 ffestb_subr_kill_read_ ();
15666 return (ffelexHandler) ffesta_zero (t);
15667
15668 default:
15669 ffesta_confirmed ();
15670 /* Fall through. */
15671 case FFELEX_typeOPEN_PAREN: /* Could still be assignment!! */
15672 break;
15673 }
15674
15675 /* If token isn't NAME or OPEN_PAREN, ffeexpr_lhs will ultimately whine
15676 about it, so leave it up to that code. */
15677
15678 /* EXTENSION: Allow an optional preceding COMMA here if not pedantic. (f2c
15679 provides this extension, as do other compilers, supposedly.) */
15680
15681 if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA))
15682 return (ffelexHandler)
15683 ffeexpr_lhs (ffesta_output_pool,
15684 ffestc_context_iolist (),
15685 (ffeexprCallback) ffestb_R90914_);
15686
15687 return (ffelexHandler) (*((ffelexHandler)
15688 ffeexpr_lhs (ffesta_output_pool,
15689 ffestc_context_iolist (),
15690 (ffeexprCallback) ffestb_R90914_)))
15691 (t);
15692 }
15693
15694 /* ffestb_R90914_ -- "READ(...)" expr
15695
15696 (ffestb_R90914_) // to expression handler
15697
15698 Handle COMMA or EOS/SEMICOLON here. */
15699
15700 static ffelexHandler
15701 ffestb_R90914_ (ffelexToken ft, ffebld expr, ffelexToken t)
15702 {
15703 switch (ffelex_token_type (t))
15704 {
15705 case FFELEX_typeCOMMA:
15706 if (expr == NULL)
15707 break;
15708
15709 ffesta_confirmed ();
15710 if (!ffesta_is_inhibited ())
15711 ffestc_R909_start (FALSE);
15712 ffestb_subr_kill_read_ ();
15713
15714 if (!ffesta_is_inhibited ())
15715 ffestc_R909_item (expr, ft);
15716 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
15717 ffestc_context_iolist (),
15718 (ffeexprCallback) ffestb_R90915_);
15719
15720 case FFELEX_typeEOS:
15721 case FFELEX_typeSEMICOLON:
15722 if (expr == NULL)
15723 break;
15724
15725 ffesta_confirmed ();
15726 if (!ffesta_is_inhibited ())
15727 ffestc_R909_start (FALSE);
15728 ffestb_subr_kill_read_ ();
15729
15730 if (!ffesta_is_inhibited ())
15731 {
15732 ffestc_R909_item (expr, ft);
15733 ffestc_R909_finish ();
15734 }
15735 return (ffelexHandler) ffesta_zero (t);
15736
15737 default:
15738 break;
15739 }
15740
15741 ffestb_subr_kill_read_ ();
15742 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15743 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15744 }
15745
15746 /* ffestb_R90915_ -- "READ(...)" expr COMMA expr
15747
15748 (ffestb_R90915_) // to expression handler
15749
15750 Handle COMMA or EOS/SEMICOLON here. */
15751
15752 static ffelexHandler
15753 ffestb_R90915_ (ffelexToken ft, ffebld expr, ffelexToken t)
15754 {
15755 switch (ffelex_token_type (t))
15756 {
15757 case FFELEX_typeCOMMA:
15758 if (expr == NULL)
15759 break;
15760 if (!ffesta_is_inhibited ())
15761 ffestc_R909_item (expr, ft);
15762 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
15763 ffestc_context_iolist (),
15764 (ffeexprCallback) ffestb_R90915_);
15765
15766 case FFELEX_typeEOS:
15767 case FFELEX_typeSEMICOLON:
15768 if (expr == NULL)
15769 break;
15770 if (!ffesta_is_inhibited ())
15771 {
15772 ffestc_R909_item (expr, ft);
15773 ffestc_R909_finish ();
15774 }
15775 return (ffelexHandler) ffesta_zero (t);
15776
15777 default:
15778 break;
15779 }
15780
15781 if (!ffesta_is_inhibited ())
15782 ffestc_R909_finish ();
15783 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15784 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15785 }
15786
15787 /* ffestb_R910 -- Parse the WRITE statement
15788
15789 return ffestb_R910; // to lexer
15790
15791 Make sure the statement has a valid form for the WRITE
15792 statement. If it does, implement the statement. */
15793
15794 ffelexHandler
15795 ffestb_R910 (ffelexToken t)
15796 {
15797 ffestpWriteIx ix;
15798
15799 switch (ffelex_token_type (ffesta_tokens[0]))
15800 {
15801 case FFELEX_typeNAME:
15802 if (ffesta_first_kw != FFESTR_firstWRITE)
15803 goto bad_0; /* :::::::::::::::::::: */
15804 switch (ffelex_token_type (t))
15805 {
15806 case FFELEX_typeCOMMA:
15807 case FFELEX_typeCOLONCOLON:
15808 case FFELEX_typeEOS:
15809 case FFELEX_typeSEMICOLON:
15810 case FFELEX_typeNAME:
15811 case FFELEX_typeNUMBER:
15812 ffesta_confirmed (); /* Error, but clearly intended. */
15813 goto bad_1; /* :::::::::::::::::::: */
15814
15815 default:
15816 goto bad_1; /* :::::::::::::::::::: */
15817
15818 case FFELEX_typeOPEN_PAREN:
15819 for (ix = 0; ix < FFESTP_writeix; ++ix)
15820 ffestp_file.write.write_spec[ix].kw_or_val_present = FALSE;
15821 return (ffelexHandler) ffestb_R9101_;
15822 }
15823
15824 case FFELEX_typeNAMES:
15825 if (ffesta_first_kw != FFESTR_firstWRITE)
15826 goto bad_0; /* :::::::::::::::::::: */
15827 switch (ffelex_token_type (t))
15828 {
15829 case FFELEX_typeEOS:
15830 case FFELEX_typeSEMICOLON:
15831 case FFELEX_typeCOMMA:
15832 case FFELEX_typeCOLONCOLON:
15833 ffesta_confirmed (); /* Error, but clearly intended. */
15834 goto bad_1; /* :::::::::::::::::::: */
15835
15836 default:
15837 goto bad_1; /* :::::::::::::::::::: */
15838
15839 case FFELEX_typeOPEN_PAREN:
15840 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlWRITE)
15841 goto bad_0; /* :::::::::::::::::::: */
15842
15843 for (ix = 0; ix < FFESTP_writeix; ++ix)
15844 ffestp_file.write.write_spec[ix].kw_or_val_present = FALSE;
15845 return (ffelexHandler) ffestb_R9101_;
15846 }
15847
15848 default:
15849 goto bad_0; /* :::::::::::::::::::: */
15850 }
15851
15852 bad_0: /* :::::::::::::::::::: */
15853 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", ffesta_tokens[0]);
15854 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15855
15856 bad_1: /* :::::::::::::::::::: */
15857 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
15858 return (ffelexHandler) ffelex_swallow_tokens (t,
15859 (ffelexHandler) ffesta_zero); /* Invalid second token. */
15860 }
15861
15862 /* ffestb_R9101_ -- "WRITE" OPEN_PAREN
15863
15864 return ffestb_R9101_; // to lexer
15865
15866 Handle expr construct (not NAME=expr construct) here. */
15867
15868 static ffelexHandler
15869 ffestb_R9101_ (ffelexToken t)
15870 {
15871 switch (ffelex_token_type (t))
15872 {
15873 case FFELEX_typeNAME:
15874 ffesta_tokens[1] = ffelex_token_use (t);
15875 return (ffelexHandler) ffestb_R9102_;
15876
15877 default:
15878 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15879 FFEEXPR_contextFILEUNIT, (ffeexprCallback) ffestb_R9103_)))
15880 (t);
15881 }
15882 }
15883
15884 /* ffestb_R9102_ -- "WRITE" OPEN_PAREN NAME
15885
15886 return ffestb_R9102_; // to lexer
15887
15888 If EQUALS here, go to states that handle it. Else, send NAME and this
15889 token thru expression handler. */
15890
15891 static ffelexHandler
15892 ffestb_R9102_ (ffelexToken t)
15893 {
15894 ffelexHandler next;
15895 ffelexToken nt;
15896
15897 switch (ffelex_token_type (t))
15898 {
15899 case FFELEX_typeEQUALS:
15900 nt = ffesta_tokens[1];
15901 next = (ffelexHandler) ffestb_R9107_ (nt);
15902 ffelex_token_kill (nt);
15903 return (ffelexHandler) (*next) (t);
15904
15905 default:
15906 nt = ffesta_tokens[1];
15907 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15908 FFEEXPR_contextFILEUNIT, (ffeexprCallback) ffestb_R9103_)))
15909 (nt);
15910 ffelex_token_kill (nt);
15911 return (ffelexHandler) (*next) (t);
15912 }
15913 }
15914
15915 /* ffestb_R9103_ -- "WRITE" OPEN_PAREN expr [CLOSE_PAREN]
15916
15917 (ffestb_R9103_) // to expression handler
15918
15919 Handle COMMA or EOS/SEMICOLON here. */
15920
15921 static ffelexHandler
15922 ffestb_R9103_ (ffelexToken ft, ffebld expr, ffelexToken t)
15923 {
15924 switch (ffelex_token_type (t))
15925 {
15926 case FFELEX_typeCOMMA:
15927 case FFELEX_typeCLOSE_PAREN:
15928 if (expr == NULL)
15929 break;
15930 ffestp_file.write.write_spec[FFESTP_writeixUNIT].kw_or_val_present
15931 = TRUE;
15932 ffestp_file.write.write_spec[FFESTP_writeixUNIT].kw_present = FALSE;
15933 ffestp_file.write.write_spec[FFESTP_writeixUNIT].value_present = TRUE;
15934 ffestp_file.write.write_spec[FFESTP_writeixUNIT].value_is_label
15935 = FALSE;
15936 ffestp_file.write.write_spec[FFESTP_writeixUNIT].value
15937 = ffelex_token_use (ft);
15938 ffestp_file.write.write_spec[FFESTP_writeixUNIT].u.expr = expr;
15939 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
15940 return (ffelexHandler) ffestb_R9104_;
15941 return (ffelexHandler) ffestb_R91012_;
15942
15943 default:
15944 break;
15945 }
15946
15947 ffestb_subr_kill_write_ ();
15948 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
15949 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15950 }
15951
15952 /* ffestb_R9104_ -- "WRITE" OPEN_PAREN expr COMMA
15953
15954 return ffestb_R9104_; // to lexer
15955
15956 Handle expr construct (not NAME=expr construct) here. */
15957
15958 static ffelexHandler
15959 ffestb_R9104_ (ffelexToken t)
15960 {
15961 switch (ffelex_token_type (t))
15962 {
15963 case FFELEX_typeNAME:
15964 ffesta_tokens[1] = ffelex_token_use (t);
15965 return (ffelexHandler) ffestb_R9105_;
15966
15967 default:
15968 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15969 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9106_)))
15970 (t);
15971 }
15972 }
15973
15974 /* ffestb_R9105_ -- "WRITE" OPEN_PAREN expr COMMA NAME
15975
15976 return ffestb_R9105_; // to lexer
15977
15978 If EQUALS here, go to states that handle it. Else, send NAME and this
15979 token thru expression handler. */
15980
15981 static ffelexHandler
15982 ffestb_R9105_ (ffelexToken t)
15983 {
15984 ffelexHandler next;
15985 ffelexToken nt;
15986
15987 switch (ffelex_token_type (t))
15988 {
15989 case FFELEX_typeEQUALS:
15990 nt = ffesta_tokens[1];
15991 next = (ffelexHandler) ffestb_R9107_ (nt);
15992 ffelex_token_kill (nt);
15993 return (ffelexHandler) (*next) (t);
15994
15995 default:
15996 nt = ffesta_tokens[1];
15997 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15998 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9106_)))
15999 (nt);
16000 ffelex_token_kill (nt);
16001 return (ffelexHandler) (*next) (t);
16002 }
16003 }
16004
16005 /* ffestb_R9106_ -- "WRITE" OPEN_PAREN expr COMMA expr
16006
16007 (ffestb_R9106_) // to expression handler
16008
16009 Handle COMMA or CLOSE_PAREN here. */
16010
16011 static ffelexHandler
16012 ffestb_R9106_ (ffelexToken ft, ffebld expr, ffelexToken t)
16013 {
16014 switch (ffelex_token_type (t))
16015 {
16016 case FFELEX_typeCOMMA:
16017 case FFELEX_typeCLOSE_PAREN:
16018 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].kw_or_val_present
16019 = TRUE;
16020 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].kw_present = FALSE;
16021 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].value_present = TRUE;
16022 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].value_is_label
16023 = (expr == NULL);
16024 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].value
16025 = ffelex_token_use (ft);
16026 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].u.expr = expr;
16027 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
16028 return (ffelexHandler) ffestb_R9107_;
16029 return (ffelexHandler) ffestb_R91012_;
16030
16031 default:
16032 break;
16033 }
16034
16035 ffestb_subr_kill_write_ ();
16036 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
16037 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16038 }
16039
16040 /* ffestb_R9107_ -- "WRITE" OPEN_PAREN [external-file-unit COMMA [format
16041 COMMA]]
16042
16043 return ffestb_R9107_; // to lexer
16044
16045 Handle expr construct (not NAME=expr construct) here. */
16046
16047 static ffelexHandler
16048 ffestb_R9107_ (ffelexToken t)
16049 {
16050 ffestrGenio kw;
16051
16052 ffestb_local_.write.label = FALSE;
16053
16054 switch (ffelex_token_type (t))
16055 {
16056 case FFELEX_typeNAME:
16057 kw = ffestr_genio (t);
16058 switch (kw)
16059 {
16060 case FFESTR_genioADVANCE:
16061 ffestb_local_.write.ix = FFESTP_writeixADVANCE;
16062 ffestb_local_.write.left = FALSE;
16063 ffestb_local_.write.context = FFEEXPR_contextFILEDFCHAR;
16064 break;
16065
16066 case FFESTR_genioEOR:
16067 ffestb_local_.write.ix = FFESTP_writeixEOR;
16068 ffestb_local_.write.label = TRUE;
16069 break;
16070
16071 case FFESTR_genioERR:
16072 ffestb_local_.write.ix = FFESTP_writeixERR;
16073 ffestb_local_.write.label = TRUE;
16074 break;
16075
16076 case FFESTR_genioFMT:
16077 ffestb_local_.write.ix = FFESTP_writeixFORMAT;
16078 ffestb_local_.write.left = FALSE;
16079 ffestb_local_.write.context = FFEEXPR_contextFILEFORMAT;
16080 break;
16081
16082 case FFESTR_genioIOSTAT:
16083 ffestb_local_.write.ix = FFESTP_writeixIOSTAT;
16084 ffestb_local_.write.left = TRUE;
16085 ffestb_local_.write.context = FFEEXPR_contextFILEINT;
16086 break;
16087
16088 case FFESTR_genioNML:
16089 ffestb_local_.write.ix = FFESTP_writeixFORMAT;
16090 ffestb_local_.write.left = TRUE;
16091 ffestb_local_.write.context = FFEEXPR_contextFILENAMELIST;
16092 break;
16093
16094 case FFESTR_genioREC:
16095 ffestb_local_.write.ix = FFESTP_writeixREC;
16096 ffestb_local_.write.left = FALSE;
16097 ffestb_local_.write.context = FFEEXPR_contextFILENUM;
16098 break;
16099
16100 case FFESTR_genioUNIT:
16101 ffestb_local_.write.ix = FFESTP_writeixUNIT;
16102 ffestb_local_.write.left = FALSE;
16103 ffestb_local_.write.context = FFEEXPR_contextFILEUNIT;
16104 break;
16105
16106 default:
16107 goto bad; /* :::::::::::::::::::: */
16108 }
16109 if (ffestp_file.write.write_spec[ffestb_local_.write.ix]
16110 .kw_or_val_present)
16111 break; /* Can't specify a keyword twice! */
16112 ffestp_file.write.write_spec[ffestb_local_.write.ix]
16113 .kw_or_val_present = TRUE;
16114 ffestp_file.write.write_spec[ffestb_local_.write.ix]
16115 .kw_present = TRUE;
16116 ffestp_file.write.write_spec[ffestb_local_.write.ix]
16117 .value_present = FALSE;
16118 ffestp_file.write.write_spec[ffestb_local_.write.ix].value_is_label
16119 = ffestb_local_.write.label;
16120 ffestp_file.write.write_spec[ffestb_local_.write.ix].kw
16121 = ffelex_token_use (t);
16122 return (ffelexHandler) ffestb_R9108_;
16123
16124 default:
16125 break;
16126 }
16127
16128 bad: /* :::::::::::::::::::: */
16129 ffestb_subr_kill_write_ ();
16130 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
16131 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16132 }
16133
16134 /* ffestb_R9108_ -- "WRITE" OPEN_PAREN [external-file-unit COMMA [format
16135 COMMA]] NAME
16136
16137 return ffestb_R9108_; // to lexer
16138
16139 Make sure EQUALS here, send next token to expression handler. */
16140
16141 static ffelexHandler
16142 ffestb_R9108_ (ffelexToken t)
16143 {
16144 switch (ffelex_token_type (t))
16145 {
16146 case FFELEX_typeEQUALS:
16147 ffesta_confirmed ();
16148 if (ffestb_local_.write.label)
16149 return (ffelexHandler) ffestb_R91010_;
16150 if (ffestb_local_.write.left)
16151 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
16152 ffestb_local_.write.context,
16153 (ffeexprCallback) ffestb_R9109_);
16154 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16155 ffestb_local_.write.context,
16156 (ffeexprCallback) ffestb_R9109_);
16157
16158 default:
16159 break;
16160 }
16161
16162 ffestb_subr_kill_write_ ();
16163 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
16164 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16165 }
16166
16167 /* ffestb_R9109_ -- "WRITE" OPEN_PAREN ... NAME EQUALS expr
16168
16169 (ffestb_R9109_) // to expression handler
16170
16171 Handle COMMA or CLOSE_PAREN here. */
16172
16173 static ffelexHandler
16174 ffestb_R9109_ (ffelexToken ft, ffebld expr, ffelexToken t)
16175 {
16176 switch (ffelex_token_type (t))
16177 {
16178 case FFELEX_typeCOMMA:
16179 case FFELEX_typeCLOSE_PAREN:
16180 if (expr == NULL)
16181 {
16182 if (ffestb_local_.write.context == FFEEXPR_contextFILEFORMAT)
16183 ffestp_file.write.write_spec[ffestb_local_.write.ix]
16184 .value_is_label = TRUE;
16185 else
16186 break;
16187 }
16188 ffestp_file.write.write_spec[ffestb_local_.write.ix].value_present
16189 = TRUE;
16190 ffestp_file.write.write_spec[ffestb_local_.write.ix].value
16191 = ffelex_token_use (ft);
16192 ffestp_file.write.write_spec[ffestb_local_.write.ix].u.expr = expr;
16193 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
16194 return (ffelexHandler) ffestb_R9107_;
16195 return (ffelexHandler) ffestb_R91012_;
16196
16197 default:
16198 break;
16199 }
16200
16201 ffestb_subr_kill_write_ ();
16202 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
16203 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16204 }
16205
16206 /* ffestb_R91010_ -- "WRITE" OPEN_PAREN ... NAME EQUALS
16207
16208 return ffestb_R91010_; // to lexer
16209
16210 Handle NUMBER for label here. */
16211
16212 static ffelexHandler
16213 ffestb_R91010_ (ffelexToken t)
16214 {
16215 switch (ffelex_token_type (t))
16216 {
16217 case FFELEX_typeNUMBER:
16218 ffestp_file.write.write_spec[ffestb_local_.write.ix].value_present
16219 = TRUE;
16220 ffestp_file.write.write_spec[ffestb_local_.write.ix].value
16221 = ffelex_token_use (t);
16222 return (ffelexHandler) ffestb_R91011_;
16223
16224 default:
16225 break;
16226 }
16227
16228 ffestb_subr_kill_write_ ();
16229 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
16230 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16231 }
16232
16233 /* ffestb_R91011_ -- "WRITE" OPEN_PAREN ... NAME EQUALS NUMBER
16234
16235 return ffestb_R91011_; // to lexer
16236
16237 Handle COMMA or CLOSE_PAREN here. */
16238
16239 static ffelexHandler
16240 ffestb_R91011_ (ffelexToken t)
16241 {
16242 switch (ffelex_token_type (t))
16243 {
16244 case FFELEX_typeCOMMA:
16245 return (ffelexHandler) ffestb_R9107_;
16246
16247 case FFELEX_typeCLOSE_PAREN:
16248 return (ffelexHandler) ffestb_R91012_;
16249
16250 default:
16251 break;
16252 }
16253
16254 ffestb_subr_kill_write_ ();
16255 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
16256 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16257 }
16258
16259 /* ffestb_R91012_ -- "WRITE" OPEN_PAREN ... CLOSE_PAREN
16260
16261 return ffestb_R91012_; // to lexer
16262
16263 Handle EOS or SEMICOLON here. */
16264
16265 static ffelexHandler
16266 ffestb_R91012_ (ffelexToken t)
16267 {
16268 switch (ffelex_token_type (t))
16269 {
16270 case FFELEX_typeEOS:
16271 case FFELEX_typeSEMICOLON:
16272 ffesta_confirmed ();
16273 if (!ffesta_is_inhibited ())
16274 {
16275 ffestc_R910_start ();
16276 ffestc_R910_finish ();
16277 }
16278 ffestb_subr_kill_write_ ();
16279 return (ffelexHandler) ffesta_zero (t);
16280
16281 default:
16282 ffesta_confirmed ();
16283 /* Fall through. */
16284 case FFELEX_typeOPEN_PAREN: /* Could still be assignment!! */
16285
16286 /* EXTENSION: Allow an optional preceding COMMA here if not pedantic.
16287 (f2c provides this extension, as do other compilers, supposedly.) */
16288
16289 if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA))
16290 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16291 ffestc_context_iolist (), (ffeexprCallback) ffestb_R91013_);
16292
16293 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16294 ffestc_context_iolist (), (ffeexprCallback) ffestb_R91013_)))
16295 (t);
16296
16297 case FFELEX_typeEQUALS:
16298 case FFELEX_typePOINTS:
16299 break;
16300 }
16301
16302 ffestb_subr_kill_write_ ();
16303 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
16304 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16305 }
16306
16307 /* ffestb_R91013_ -- "WRITE(...)" expr
16308
16309 (ffestb_R91013_) // to expression handler
16310
16311 Handle COMMA or EOS/SEMICOLON here. */
16312
16313 static ffelexHandler
16314 ffestb_R91013_ (ffelexToken ft, ffebld expr, ffelexToken t)
16315 {
16316 switch (ffelex_token_type (t))
16317 {
16318 case FFELEX_typeCOMMA:
16319 if (expr == NULL)
16320 break;
16321
16322 ffesta_confirmed ();
16323 if (!ffesta_is_inhibited ())
16324 ffestc_R910_start ();
16325 ffestb_subr_kill_write_ ();
16326
16327 if (!ffesta_is_inhibited ())
16328 ffestc_R910_item (expr, ft);
16329 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16330 ffestc_context_iolist (), (ffeexprCallback) ffestb_R91014_);
16331
16332 case FFELEX_typeEOS:
16333 case FFELEX_typeSEMICOLON:
16334 if (expr == NULL)
16335 break;
16336
16337 ffesta_confirmed ();
16338 if (!ffesta_is_inhibited ())
16339 ffestc_R910_start ();
16340 ffestb_subr_kill_write_ ();
16341
16342 if (!ffesta_is_inhibited ())
16343 {
16344 ffestc_R910_item (expr, ft);
16345 ffestc_R910_finish ();
16346 }
16347 return (ffelexHandler) ffesta_zero (t);
16348
16349 default:
16350 break;
16351 }
16352
16353 ffestb_subr_kill_write_ ();
16354 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
16355 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16356 }
16357
16358 /* ffestb_R91014_ -- "WRITE(...)" expr COMMA expr
16359
16360 (ffestb_R91014_) // to expression handler
16361
16362 Handle COMMA or EOS/SEMICOLON here. */
16363
16364 static ffelexHandler
16365 ffestb_R91014_ (ffelexToken ft, ffebld expr, ffelexToken t)
16366 {
16367 switch (ffelex_token_type (t))
16368 {
16369 case FFELEX_typeCOMMA:
16370 if (expr == NULL)
16371 break;
16372 if (!ffesta_is_inhibited ())
16373 ffestc_R910_item (expr, ft);
16374 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16375 ffestc_context_iolist (), (ffeexprCallback) ffestb_R91014_);
16376
16377 case FFELEX_typeEOS:
16378 case FFELEX_typeSEMICOLON:
16379 if (expr == NULL)
16380 break;
16381 if (!ffesta_is_inhibited ())
16382 {
16383 ffestc_R910_item (expr, ft);
16384 ffestc_R910_finish ();
16385 }
16386 return (ffelexHandler) ffesta_zero (t);
16387
16388 default:
16389 break;
16390 }
16391
16392 if (!ffesta_is_inhibited ())
16393 ffestc_R910_finish ();
16394 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
16395 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16396 }
16397
16398 /* ffestb_R911 -- Parse the PRINT statement
16399
16400 return ffestb_R911; // to lexer
16401
16402 Make sure the statement has a valid form for the PRINT
16403 statement. If it does, implement the statement. */
16404
16405 ffelexHandler
16406 ffestb_R911 (ffelexToken t)
16407 {
16408 ffelexHandler next;
16409 ffestpPrintIx ix;
16410
16411 switch (ffelex_token_type (ffesta_tokens[0]))
16412 {
16413 case FFELEX_typeNAME:
16414 if (ffesta_first_kw != FFESTR_firstPRINT)
16415 goto bad_0; /* :::::::::::::::::::: */
16416 switch (ffelex_token_type (t))
16417 {
16418 case FFELEX_typeCOMMA:
16419 case FFELEX_typeCOLONCOLON:
16420 case FFELEX_typeEOS:
16421 case FFELEX_typeSEMICOLON:
16422 ffesta_confirmed (); /* Error, but clearly intended. */
16423 goto bad_1; /* :::::::::::::::::::: */
16424
16425 case FFELEX_typeEQUALS:
16426 case FFELEX_typePOINTS:
16427 case FFELEX_typeCOLON:
16428 goto bad_1; /* :::::::::::::::::::: */
16429
16430 case FFELEX_typeNAME:
16431 case FFELEX_typeNUMBER:
16432 ffesta_confirmed ();
16433 break;
16434
16435 default:
16436 break;
16437 }
16438
16439 for (ix = 0; ix < FFESTP_printix; ++ix)
16440 ffestp_file.print.print_spec[ix].kw_or_val_present = FALSE;
16441 return (ffelexHandler) (*((ffelexHandler)
16442 ffeexpr_rhs (ffesta_output_pool,
16443 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9111_)))
16444 (t);
16445
16446 case FFELEX_typeNAMES:
16447 if (ffesta_first_kw != FFESTR_firstPRINT)
16448 goto bad_0; /* :::::::::::::::::::: */
16449 switch (ffelex_token_type (t))
16450 {
16451 case FFELEX_typeEOS:
16452 case FFELEX_typeSEMICOLON:
16453 case FFELEX_typeCOMMA:
16454 ffesta_confirmed ();
16455 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlPRINT)
16456 break;
16457 goto bad_1; /* :::::::::::::::::::: */
16458
16459 case FFELEX_typeCOLONCOLON:
16460 ffesta_confirmed (); /* Error, but clearly intended. */
16461 goto bad_1; /* :::::::::::::::::::: */
16462
16463 case FFELEX_typeEQUALS:
16464 case FFELEX_typePOINTS:
16465 case FFELEX_typeCOLON:
16466 goto bad_1; /* :::::::::::::::::::: */
16467
16468 default:
16469 break;
16470 }
16471 for (ix = 0; ix < FFESTP_printix; ++ix)
16472 ffestp_file.print.print_spec[ix].kw_or_val_present = FALSE;
16473 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16474 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9111_);
16475 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
16476 FFESTR_firstlPRINT);
16477 if (next == NULL)
16478 return (ffelexHandler) ffelex_swallow_tokens (t,
16479 (ffelexHandler) ffesta_zero);
16480 return (ffelexHandler) (*next) (t);
16481
16482 default:
16483 goto bad_0; /* :::::::::::::::::::: */
16484 }
16485
16486 bad_0: /* :::::::::::::::::::: */
16487 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", ffesta_tokens[0]);
16488 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16489
16490 bad_1: /* :::::::::::::::::::: */
16491 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", t);
16492 return (ffelexHandler) ffelex_swallow_tokens (t,
16493 (ffelexHandler) ffesta_zero); /* Invalid second token. */
16494 }
16495
16496 /* ffestb_R9111_ -- "PRINT" expr
16497
16498 (ffestb_R9111_) // to expression handler
16499
16500 Make sure the next token is a COMMA or EOS/SEMICOLON. */
16501
16502 static ffelexHandler
16503 ffestb_R9111_ (ffelexToken ft, ffebld expr, ffelexToken t)
16504 {
16505 switch (ffelex_token_type (t))
16506 {
16507 case FFELEX_typeEOS:
16508 case FFELEX_typeSEMICOLON:
16509 case FFELEX_typeCOMMA:
16510 ffesta_confirmed ();
16511 ffestp_file.print.print_spec[FFESTP_printixFORMAT].kw_or_val_present
16512 = TRUE;
16513 ffestp_file.print.print_spec[FFESTP_printixFORMAT].kw_present = FALSE;
16514 ffestp_file.print.print_spec[FFESTP_printixFORMAT].value_present = TRUE;
16515 ffestp_file.print.print_spec[FFESTP_printixFORMAT].value_is_label
16516 = (expr == NULL);
16517 ffestp_file.print.print_spec[FFESTP_printixFORMAT].value
16518 = ffelex_token_use (ft);
16519 ffestp_file.print.print_spec[FFESTP_printixFORMAT].u.expr = expr;
16520 if (!ffesta_is_inhibited ())
16521 ffestc_R911_start ();
16522 ffestb_subr_kill_print_ ();
16523 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
16524 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16525 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R9112_);
16526 if (!ffesta_is_inhibited ())
16527 ffestc_R911_finish ();
16528 return (ffelexHandler) ffesta_zero (t);
16529
16530 default:
16531 break;
16532 }
16533
16534 ffestb_subr_kill_print_ ();
16535 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", t);
16536 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16537 }
16538
16539 /* ffestb_R9112_ -- "PRINT" expr COMMA expr
16540
16541 (ffestb_R9112_) // to expression handler
16542
16543 Handle COMMA or EOS/SEMICOLON here. */
16544
16545 static ffelexHandler
16546 ffestb_R9112_ (ffelexToken ft, ffebld expr, ffelexToken t)
16547 {
16548 switch (ffelex_token_type (t))
16549 {
16550 case FFELEX_typeCOMMA:
16551 if (expr == NULL)
16552 break;
16553 if (!ffesta_is_inhibited ())
16554 ffestc_R911_item (expr, ft);
16555 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16556 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R9112_);
16557
16558 case FFELEX_typeEOS:
16559 case FFELEX_typeSEMICOLON:
16560 if (expr == NULL)
16561 break;
16562 if (!ffesta_is_inhibited ())
16563 {
16564 ffestc_R911_item (expr, ft);
16565 ffestc_R911_finish ();
16566 }
16567 return (ffelexHandler) ffesta_zero (t);
16568
16569 default:
16570 break;
16571 }
16572
16573 if (!ffesta_is_inhibited ())
16574 ffestc_R911_finish ();
16575 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", t);
16576 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16577 }
16578
16579 /* ffestb_R923 -- Parse an INQUIRE statement
16580
16581 return ffestb_R923; // to lexer
16582
16583 Make sure the statement has a valid form for an INQUIRE statement.
16584 If it does, implement the statement. */
16585
16586 ffelexHandler
16587 ffestb_R923 (ffelexToken t)
16588 {
16589 ffestpInquireIx ix;
16590
16591 switch (ffelex_token_type (ffesta_tokens[0]))
16592 {
16593 case FFELEX_typeNAME:
16594 if (ffesta_first_kw != FFESTR_firstINQUIRE)
16595 goto bad_0; /* :::::::::::::::::::: */
16596 break;
16597
16598 case FFELEX_typeNAMES:
16599 if (ffesta_first_kw != FFESTR_firstINQUIRE)
16600 goto bad_0; /* :::::::::::::::::::: */
16601 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlINQUIRE)
16602 goto bad_0; /* :::::::::::::::::::: */
16603 break;
16604
16605 default:
16606 goto bad_0; /* :::::::::::::::::::: */
16607 }
16608
16609 switch (ffelex_token_type (t))
16610 {
16611 case FFELEX_typeOPEN_PAREN:
16612 break;
16613
16614 case FFELEX_typeEOS:
16615 case FFELEX_typeSEMICOLON:
16616 case FFELEX_typeCOMMA:
16617 case FFELEX_typeCOLONCOLON:
16618 ffesta_confirmed (); /* Error, but clearly intended. */
16619 goto bad_1; /* :::::::::::::::::::: */
16620
16621 default:
16622 goto bad_1; /* :::::::::::::::::::: */
16623 }
16624
16625 for (ix = 0; ix < FFESTP_inquireix; ++ix)
16626 ffestp_file.inquire.inquire_spec[ix].kw_or_val_present = FALSE;
16627
16628 ffestb_local_.inquire.may_be_iolength = TRUE;
16629 return (ffelexHandler) ffestb_R9231_;
16630
16631 bad_0: /* :::::::::::::::::::: */
16632 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", ffesta_tokens[0]);
16633 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16634
16635 bad_1: /* :::::::::::::::::::: */
16636 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
16637 return (ffelexHandler) ffelex_swallow_tokens (t,
16638 (ffelexHandler) ffesta_zero); /* Invalid second token. */
16639 }
16640
16641 /* ffestb_R9231_ -- "INQUIRE" OPEN_PAREN
16642
16643 return ffestb_R9231_; // to lexer
16644
16645 Handle expr construct (not NAME=expr construct) here. */
16646
16647 static ffelexHandler
16648 ffestb_R9231_ (ffelexToken t)
16649 {
16650 switch (ffelex_token_type (t))
16651 {
16652 case FFELEX_typeNAME:
16653 ffesta_tokens[1] = ffelex_token_use (t);
16654 return (ffelexHandler) ffestb_R9232_;
16655
16656 default:
16657 ffestb_local_.inquire.may_be_iolength = FALSE;
16658 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16659 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9233_)))
16660 (t);
16661 }
16662 }
16663
16664 /* ffestb_R9232_ -- "INQUIRE" OPEN_PAREN NAME
16665
16666 return ffestb_R9232_; // to lexer
16667
16668 If EQUALS here, go to states that handle it. Else, send NAME and this
16669 token thru expression handler. */
16670
16671 static ffelexHandler
16672 ffestb_R9232_ (ffelexToken t)
16673 {
16674 ffelexHandler next;
16675 ffelexToken nt;
16676
16677 switch (ffelex_token_type (t))
16678 {
16679 case FFELEX_typeEQUALS:
16680 nt = ffesta_tokens[1];
16681 next = (ffelexHandler) ffestb_R9234_ (nt);
16682 ffelex_token_kill (nt);
16683 return (ffelexHandler) (*next) (t);
16684
16685 default:
16686 ffestb_local_.inquire.may_be_iolength = FALSE;
16687 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16688 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9233_)))
16689 (ffesta_tokens[1]);
16690 ffelex_token_kill (ffesta_tokens[1]);
16691 return (ffelexHandler) (*next) (t);
16692 }
16693 }
16694
16695 /* ffestb_R9233_ -- "INQUIRE" OPEN_PAREN expr
16696
16697 (ffestb_R9233_) // to expression handler
16698
16699 Handle COMMA or CLOSE_PAREN here. */
16700
16701 static ffelexHandler
16702 ffestb_R9233_ (ffelexToken ft, ffebld expr, ffelexToken t)
16703 {
16704 switch (ffelex_token_type (t))
16705 {
16706 case FFELEX_typeCOMMA:
16707 case FFELEX_typeCLOSE_PAREN:
16708 if (expr == NULL)
16709 break;
16710 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw_or_val_present
16711 = TRUE;
16712 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw_present = FALSE;
16713 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value_present = TRUE;
16714 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value_is_label
16715 = FALSE;
16716 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value
16717 = ffelex_token_use (ft);
16718 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].u.expr = expr;
16719 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
16720 return (ffelexHandler) ffestb_R9234_;
16721 return (ffelexHandler) ffestb_R9239_;
16722
16723 default:
16724 break;
16725 }
16726
16727 ffestb_subr_kill_inquire_ ();
16728 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
16729 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16730 }
16731
16732 /* ffestb_R9234_ -- "INQUIRE" OPEN_PAREN [external-file-unit COMMA]
16733
16734 return ffestb_R9234_; // to lexer
16735
16736 Handle expr construct (not NAME=expr construct) here. */
16737
16738 static ffelexHandler
16739 ffestb_R9234_ (ffelexToken t)
16740 {
16741 ffestrInquire kw;
16742
16743 ffestb_local_.inquire.label = FALSE;
16744
16745 switch (ffelex_token_type (t))
16746 {
16747 case FFELEX_typeNAME:
16748 kw = ffestr_inquire (t);
16749 if (kw != FFESTR_inquireIOLENGTH)
16750 ffestb_local_.inquire.may_be_iolength = FALSE;
16751 switch (kw)
16752 {
16753 case FFESTR_inquireACCESS:
16754 ffestb_local_.inquire.ix = FFESTP_inquireixACCESS;
16755 ffestb_local_.inquire.left = TRUE;
16756 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16757 break;
16758
16759 case FFESTR_inquireACTION:
16760 ffestb_local_.inquire.ix = FFESTP_inquireixACTION;
16761 ffestb_local_.inquire.left = TRUE;
16762 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16763 break;
16764
16765 case FFESTR_inquireBLANK:
16766 ffestb_local_.inquire.ix = FFESTP_inquireixBLANK;
16767 ffestb_local_.inquire.left = TRUE;
16768 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16769 break;
16770
16771 case FFESTR_inquireCARRIAGECONTROL:
16772 ffestb_local_.inquire.ix = FFESTP_inquireixCARRIAGECONTROL;
16773 ffestb_local_.inquire.left = TRUE;
16774 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
16775 break;
16776
16777 case FFESTR_inquireDEFAULTFILE:
16778 ffestb_local_.inquire.ix = FFESTP_inquireixDEFAULTFILE;
16779 ffestb_local_.inquire.left = FALSE;
16780 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
16781 break;
16782
16783 case FFESTR_inquireDELIM:
16784 ffestb_local_.inquire.ix = FFESTP_inquireixDELIM;
16785 ffestb_local_.inquire.left = TRUE;
16786 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16787 break;
16788
16789 case FFESTR_inquireDIRECT:
16790 ffestb_local_.inquire.ix = FFESTP_inquireixDIRECT;
16791 ffestb_local_.inquire.left = TRUE;
16792 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16793 break;
16794
16795 case FFESTR_inquireERR:
16796 ffestb_local_.inquire.ix = FFESTP_inquireixERR;
16797 ffestb_local_.inquire.label = TRUE;
16798 break;
16799
16800 case FFESTR_inquireEXIST:
16801 ffestb_local_.inquire.ix = FFESTP_inquireixEXIST;
16802 ffestb_local_.inquire.left = TRUE;
16803 ffestb_local_.inquire.context = FFEEXPR_contextFILELOG;
16804 break;
16805
16806 case FFESTR_inquireFILE:
16807 ffestb_local_.inquire.ix = FFESTP_inquireixFILE;
16808 ffestb_local_.inquire.left = FALSE;
16809 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
16810 break;
16811
16812 case FFESTR_inquireFORM:
16813 ffestb_local_.inquire.ix = FFESTP_inquireixFORM;
16814 ffestb_local_.inquire.left = TRUE;
16815 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16816 break;
16817
16818 case FFESTR_inquireFORMATTED:
16819 ffestb_local_.inquire.ix = FFESTP_inquireixFORMATTED;
16820 ffestb_local_.inquire.left = TRUE;
16821 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16822 break;
16823
16824 case FFESTR_inquireIOLENGTH:
16825 if (!ffestb_local_.inquire.may_be_iolength)
16826 goto bad; /* :::::::::::::::::::: */
16827 ffestb_local_.inquire.ix = FFESTP_inquireixIOLENGTH;
16828 ffestb_local_.inquire.left = TRUE;
16829 ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
16830 break;
16831
16832 case FFESTR_inquireIOSTAT:
16833 ffestb_local_.inquire.ix = FFESTP_inquireixIOSTAT;
16834 ffestb_local_.inquire.left = TRUE;
16835 ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
16836 break;
16837
16838 case FFESTR_inquireKEYED:
16839 ffestb_local_.inquire.ix = FFESTP_inquireixKEYED;
16840 ffestb_local_.inquire.left = TRUE;
16841 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
16842 break;
16843
16844 case FFESTR_inquireNAME:
16845 ffestb_local_.inquire.ix = FFESTP_inquireixNAME;
16846 ffestb_local_.inquire.left = TRUE;
16847 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
16848 break;
16849
16850 case FFESTR_inquireNAMED:
16851 ffestb_local_.inquire.ix = FFESTP_inquireixNAMED;
16852 ffestb_local_.inquire.left = TRUE;
16853 ffestb_local_.inquire.context = FFEEXPR_contextFILELOG;
16854 break;
16855
16856 case FFESTR_inquireNEXTREC:
16857 ffestb_local_.inquire.ix = FFESTP_inquireixNEXTREC;
16858 ffestb_local_.inquire.left = TRUE;
16859 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFINT;
16860 break;
16861
16862 case FFESTR_inquireNUMBER:
16863 ffestb_local_.inquire.ix = FFESTP_inquireixNUMBER;
16864 ffestb_local_.inquire.left = TRUE;
16865 ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
16866 break;
16867
16868 case FFESTR_inquireOPENED:
16869 ffestb_local_.inquire.ix = FFESTP_inquireixOPENED;
16870 ffestb_local_.inquire.left = TRUE;
16871 ffestb_local_.inquire.context = FFEEXPR_contextFILELOG;
16872 break;
16873
16874 case FFESTR_inquireORGANIZATION:
16875 ffestb_local_.inquire.ix = FFESTP_inquireixORGANIZATION;
16876 ffestb_local_.inquire.left = TRUE;
16877 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
16878 break;
16879
16880 case FFESTR_inquirePAD:
16881 ffestb_local_.inquire.ix = FFESTP_inquireixPAD;
16882 ffestb_local_.inquire.left = TRUE;
16883 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16884 break;
16885
16886 case FFESTR_inquirePOSITION:
16887 ffestb_local_.inquire.ix = FFESTP_inquireixPOSITION;
16888 ffestb_local_.inquire.left = TRUE;
16889 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16890 break;
16891
16892 case FFESTR_inquireREAD:
16893 ffestb_local_.inquire.ix = FFESTP_inquireixREAD;
16894 ffestb_local_.inquire.left = TRUE;
16895 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16896 break;
16897
16898 case FFESTR_inquireREADWRITE:
16899 ffestb_local_.inquire.ix = FFESTP_inquireixREADWRITE;
16900 ffestb_local_.inquire.left = TRUE;
16901 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16902 break;
16903
16904 case FFESTR_inquireRECL:
16905 ffestb_local_.inquire.ix = FFESTP_inquireixRECL;
16906 ffestb_local_.inquire.left = TRUE;
16907 ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
16908 break;
16909
16910 case FFESTR_inquireRECORDTYPE:
16911 ffestb_local_.inquire.ix = FFESTP_inquireixRECORDTYPE;
16912 ffestb_local_.inquire.left = TRUE;
16913 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
16914 break;
16915
16916 case FFESTR_inquireSEQUENTIAL:
16917 ffestb_local_.inquire.ix = FFESTP_inquireixSEQUENTIAL;
16918 ffestb_local_.inquire.left = TRUE;
16919 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16920 break;
16921
16922 case FFESTR_inquireUNFORMATTED:
16923 ffestb_local_.inquire.ix = FFESTP_inquireixUNFORMATTED;
16924 ffestb_local_.inquire.left = TRUE;
16925 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16926 break;
16927
16928 case FFESTR_inquireUNIT:
16929 ffestb_local_.inquire.ix = FFESTP_inquireixUNIT;
16930 ffestb_local_.inquire.left = FALSE;
16931 ffestb_local_.inquire.context = FFEEXPR_contextFILENUM;
16932 break;
16933
16934 default:
16935 goto bad; /* :::::::::::::::::::: */
16936 }
16937 if (ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
16938 .kw_or_val_present)
16939 break; /* Can't specify a keyword twice! */
16940 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
16941 .kw_or_val_present = TRUE;
16942 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
16943 .kw_present = TRUE;
16944 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
16945 .value_present = FALSE;
16946 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value_is_label
16947 = ffestb_local_.inquire.label;
16948 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].kw
16949 = ffelex_token_use (t);
16950 return (ffelexHandler) ffestb_R9235_;
16951
16952 default:
16953 break;
16954 }
16955
16956 bad: /* :::::::::::::::::::: */
16957 ffestb_subr_kill_inquire_ ();
16958 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
16959 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16960 }
16961
16962 /* ffestb_R9235_ -- "INQUIRE" OPEN_PAREN [external-file-unit COMMA] NAME
16963
16964 return ffestb_R9235_; // to lexer
16965
16966 Make sure EQUALS here, send next token to expression handler. */
16967
16968 static ffelexHandler
16969 ffestb_R9235_ (ffelexToken t)
16970 {
16971 switch (ffelex_token_type (t))
16972 {
16973 case FFELEX_typeEQUALS:
16974 ffesta_confirmed ();
16975 if (ffestb_local_.inquire.label)
16976 return (ffelexHandler) ffestb_R9237_;
16977 if (ffestb_local_.inquire.left)
16978 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
16979 ffestb_local_.inquire.context,
16980 (ffeexprCallback) ffestb_R9236_);
16981 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16982 ffestb_local_.inquire.context,
16983 (ffeexprCallback) ffestb_R9236_);
16984
16985 default:
16986 break;
16987 }
16988
16989 ffestb_subr_kill_inquire_ ();
16990 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
16991 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16992 }
16993
16994 /* ffestb_R9236_ -- "INQUIRE" OPEN_PAREN ... NAME EQUALS expr
16995
16996 (ffestb_R9236_) // to expression handler
16997
16998 Handle COMMA or CLOSE_PAREN here. */
16999
17000 static ffelexHandler
17001 ffestb_R9236_ (ffelexToken ft, ffebld expr, ffelexToken t)
17002 {
17003 switch (ffelex_token_type (t))
17004 {
17005 case FFELEX_typeCOMMA:
17006 if (ffestb_local_.inquire.ix == FFESTP_inquireixIOLENGTH)
17007 break; /* IOLENGTH=expr must be followed by
17008 CLOSE_PAREN. */
17009 /* Fall through. */
17010 case FFELEX_typeCLOSE_PAREN:
17011 if (expr == NULL)
17012 break;
17013 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value_present
17014 = TRUE;
17015 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value
17016 = ffelex_token_use (ft);
17017 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].u.expr = expr;
17018 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
17019 return (ffelexHandler) ffestb_R9234_;
17020 if (ffestb_local_.inquire.ix == FFESTP_inquireixIOLENGTH)
17021 return (ffelexHandler) ffestb_R92310_;
17022 return (ffelexHandler) ffestb_R9239_;
17023
17024 default:
17025 break;
17026 }
17027
17028 ffestb_subr_kill_inquire_ ();
17029 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
17030 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17031 }
17032
17033 /* ffestb_R9237_ -- "INQUIRE" OPEN_PAREN ... NAME EQUALS
17034
17035 return ffestb_R9237_; // to lexer
17036
17037 Handle NUMBER for label here. */
17038
17039 static ffelexHandler
17040 ffestb_R9237_ (ffelexToken t)
17041 {
17042 switch (ffelex_token_type (t))
17043 {
17044 case FFELEX_typeNUMBER:
17045 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value_present
17046 = TRUE;
17047 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value
17048 = ffelex_token_use (t);
17049 return (ffelexHandler) ffestb_R9238_;
17050
17051 default:
17052 break;
17053 }
17054
17055 ffestb_subr_kill_inquire_ ();
17056 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
17057 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17058 }
17059
17060 /* ffestb_R9238_ -- "INQUIRE" OPEN_PAREN ... NAME EQUALS NUMBER
17061
17062 return ffestb_R9238_; // to lexer
17063
17064 Handle COMMA or CLOSE_PAREN here. */
17065
17066 static ffelexHandler
17067 ffestb_R9238_ (ffelexToken t)
17068 {
17069 switch (ffelex_token_type (t))
17070 {
17071 case FFELEX_typeCOMMA:
17072 return (ffelexHandler) ffestb_R9234_;
17073
17074 case FFELEX_typeCLOSE_PAREN:
17075 return (ffelexHandler) ffestb_R9239_;
17076
17077 default:
17078 break;
17079 }
17080
17081 ffestb_subr_kill_inquire_ ();
17082 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
17083 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17084 }
17085
17086 /* ffestb_R9239_ -- "INQUIRE" OPEN_PAREN ... CLOSE_PAREN
17087
17088 return ffestb_R9239_; // to lexer
17089
17090 Handle EOS or SEMICOLON here. */
17091
17092 static ffelexHandler
17093 ffestb_R9239_ (ffelexToken t)
17094 {
17095 switch (ffelex_token_type (t))
17096 {
17097 case FFELEX_typeEOS:
17098 case FFELEX_typeSEMICOLON:
17099 ffesta_confirmed ();
17100 if (!ffesta_is_inhibited ())
17101 ffestc_R923A ();
17102 ffestb_subr_kill_inquire_ ();
17103 return (ffelexHandler) ffesta_zero (t);
17104
17105 default:
17106 break;
17107 }
17108
17109 ffestb_subr_kill_inquire_ ();
17110 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
17111 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17112 }
17113
17114 /* ffestb_R92310_ -- "INQUIRE(IOLENGTH=expr)"
17115
17116 return ffestb_R92310_; // to lexer
17117
17118 Make sure EOS or SEMICOLON not here; begin R923B processing and expect
17119 output IO list. */
17120
17121 static ffelexHandler
17122 ffestb_R92310_ (ffelexToken t)
17123 {
17124 switch (ffelex_token_type (t))
17125 {
17126 case FFELEX_typeEOS:
17127 case FFELEX_typeSEMICOLON:
17128 break;
17129
17130 default:
17131 ffesta_confirmed ();
17132 if (!ffesta_is_inhibited ())
17133 ffestc_R923B_start ();
17134 ffestb_subr_kill_inquire_ ();
17135 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17136 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R92311_)))
17137 (t);
17138 }
17139
17140 ffestb_subr_kill_inquire_ ();
17141 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
17142 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17143 }
17144
17145 /* ffestb_R92311_ -- "INQUIRE(IOLENGTH=expr)" expr
17146
17147 (ffestb_R92311_) // to expression handler
17148
17149 Handle COMMA or EOS/SEMICOLON here. */
17150
17151 static ffelexHandler
17152 ffestb_R92311_ (ffelexToken ft, ffebld expr, ffelexToken t)
17153 {
17154 switch (ffelex_token_type (t))
17155 {
17156 case FFELEX_typeCOMMA:
17157 if (expr == NULL)
17158 break;
17159 if (!ffesta_is_inhibited ())
17160 ffestc_R923B_item (expr, ft);
17161 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17162 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R92311_);
17163
17164 case FFELEX_typeEOS:
17165 case FFELEX_typeSEMICOLON:
17166 if (expr == NULL)
17167 break;
17168 if (!ffesta_is_inhibited ())
17169 {
17170 ffestc_R923B_item (expr, ft);
17171 ffestc_R923B_finish ();
17172 }
17173 return (ffelexHandler) ffesta_zero (t);
17174
17175 default:
17176 break;
17177 }
17178
17179 if (!ffesta_is_inhibited ())
17180 ffestc_R923B_finish ();
17181 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
17182 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17183 }
17184
17185 /* ffestb_V018 -- Parse the REWRITE statement
17186
17187 return ffestb_V018; // to lexer
17188
17189 Make sure the statement has a valid form for the REWRITE
17190 statement. If it does, implement the statement. */
17191
17192 #if FFESTR_VXT
17193 ffelexHandler
17194 ffestb_V018 (ffelexToken t)
17195 {
17196 ffestpRewriteIx ix;
17197
17198 switch (ffelex_token_type (ffesta_tokens[0]))
17199 {
17200 case FFELEX_typeNAME:
17201 if (ffesta_first_kw != FFESTR_firstREWRITE)
17202 goto bad_0; /* :::::::::::::::::::: */
17203 switch (ffelex_token_type (t))
17204 {
17205 case FFELEX_typeCOMMA:
17206 case FFELEX_typeCOLONCOLON:
17207 case FFELEX_typeEOS:
17208 case FFELEX_typeSEMICOLON:
17209 case FFELEX_typeNAME:
17210 case FFELEX_typeNUMBER:
17211 ffesta_confirmed (); /* Error, but clearly intended. */
17212 goto bad_1; /* :::::::::::::::::::: */
17213
17214 default:
17215 goto bad_1; /* :::::::::::::::::::: */
17216
17217 case FFELEX_typeOPEN_PAREN:
17218 for (ix = 0; ix < FFESTP_rewriteix; ++ix)
17219 ffestp_file.rewrite.rewrite_spec[ix].kw_or_val_present = FALSE;
17220 return (ffelexHandler) ffestb_V0181_;
17221 }
17222
17223 case FFELEX_typeNAMES:
17224 if (ffesta_first_kw != FFESTR_firstREWRITE)
17225 goto bad_0; /* :::::::::::::::::::: */
17226 switch (ffelex_token_type (t))
17227 {
17228 case FFELEX_typeEOS:
17229 case FFELEX_typeSEMICOLON:
17230 case FFELEX_typeCOMMA:
17231 case FFELEX_typeCOLONCOLON:
17232 ffesta_confirmed (); /* Error, but clearly intended. */
17233 goto bad_1; /* :::::::::::::::::::: */
17234
17235 default:
17236 goto bad_1; /* :::::::::::::::::::: */
17237
17238 case FFELEX_typeOPEN_PAREN:
17239 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlREWRITE)
17240 goto bad_0; /* :::::::::::::::::::: */
17241
17242 for (ix = 0; ix < FFESTP_rewriteix; ++ix)
17243 ffestp_file.rewrite.rewrite_spec[ix].kw_or_val_present = FALSE;
17244 return (ffelexHandler) ffestb_V0181_;
17245 }
17246
17247 default:
17248 goto bad_0; /* :::::::::::::::::::: */
17249 }
17250
17251 bad_0: /* :::::::::::::::::::: */
17252 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", ffesta_tokens[0]);
17253 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17254
17255 bad_1: /* :::::::::::::::::::: */
17256 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17257 return (ffelexHandler) ffelex_swallow_tokens (t,
17258 (ffelexHandler) ffesta_zero); /* Invalid second token. */
17259 }
17260
17261 /* ffestb_V0181_ -- "REWRITE" OPEN_PAREN
17262
17263 return ffestb_V0181_; // to lexer
17264
17265 Handle expr construct (not NAME=expr construct) here. */
17266
17267 static ffelexHandler
17268 ffestb_V0181_ (ffelexToken t)
17269 {
17270 switch (ffelex_token_type (t))
17271 {
17272 case FFELEX_typeNAME:
17273 ffesta_tokens[1] = ffelex_token_use (t);
17274 return (ffelexHandler) ffestb_V0182_;
17275
17276 default:
17277 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17278 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0183_)))
17279 (t);
17280 }
17281 }
17282
17283 /* ffestb_V0182_ -- "REWRITE" OPEN_PAREN NAME
17284
17285 return ffestb_V0182_; // to lexer
17286
17287 If EQUALS here, go to states that handle it. Else, send NAME and this
17288 token thru expression handler. */
17289
17290 static ffelexHandler
17291 ffestb_V0182_ (ffelexToken t)
17292 {
17293 ffelexHandler next;
17294 ffelexToken nt;
17295
17296 switch (ffelex_token_type (t))
17297 {
17298 case FFELEX_typeEQUALS:
17299 nt = ffesta_tokens[1];
17300 next = (ffelexHandler) ffestb_V0187_ (nt);
17301 ffelex_token_kill (nt);
17302 return (ffelexHandler) (*next) (t);
17303
17304 default:
17305 nt = ffesta_tokens[1];
17306 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17307 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0183_)))
17308 (nt);
17309 ffelex_token_kill (nt);
17310 return (ffelexHandler) (*next) (t);
17311 }
17312 }
17313
17314 /* ffestb_V0183_ -- "REWRITE" OPEN_PAREN expr [CLOSE_PAREN]
17315
17316 (ffestb_V0183_) // to expression handler
17317
17318 Handle COMMA or EOS/SEMICOLON here. */
17319
17320 static ffelexHandler
17321 ffestb_V0183_ (ffelexToken ft, ffebld expr, ffelexToken t)
17322 {
17323 switch (ffelex_token_type (t))
17324 {
17325 case FFELEX_typeCOMMA:
17326 case FFELEX_typeCLOSE_PAREN:
17327 if (expr == NULL)
17328 break;
17329 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].kw_or_val_present
17330 = TRUE;
17331 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].kw_present = FALSE;
17332 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].value_present = TRUE;
17333 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].value_is_label
17334 = FALSE;
17335 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].value
17336 = ffelex_token_use (ft);
17337 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].u.expr = expr;
17338 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
17339 return (ffelexHandler) ffestb_V0184_;
17340 return (ffelexHandler) ffestb_V01812_;
17341
17342 default:
17343 break;
17344 }
17345
17346 ffestb_subr_kill_rewrite_ ();
17347 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17348 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17349 }
17350
17351 /* ffestb_V0184_ -- "REWRITE" OPEN_PAREN expr COMMA
17352
17353 return ffestb_V0184_; // to lexer
17354
17355 Handle expr construct (not NAME=expr construct) here. */
17356
17357 static ffelexHandler
17358 ffestb_V0184_ (ffelexToken t)
17359 {
17360 switch (ffelex_token_type (t))
17361 {
17362 case FFELEX_typeNAME:
17363 ffesta_tokens[1] = ffelex_token_use (t);
17364 return (ffelexHandler) ffestb_V0185_;
17365
17366 default:
17367 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17368 FFEEXPR_contextFILEFORMAT, (ffeexprCallback) ffestb_V0186_)))
17369 (t);
17370 }
17371 }
17372
17373 /* ffestb_V0185_ -- "REWRITE" OPEN_PAREN expr COMMA NAME
17374
17375 return ffestb_V0185_; // to lexer
17376
17377 If EQUALS here, go to states that handle it. Else, send NAME and this
17378 token thru expression handler. */
17379
17380 static ffelexHandler
17381 ffestb_V0185_ (ffelexToken t)
17382 {
17383 ffelexHandler next;
17384 ffelexToken nt;
17385
17386 switch (ffelex_token_type (t))
17387 {
17388 case FFELEX_typeEQUALS:
17389 nt = ffesta_tokens[1];
17390 next = (ffelexHandler) ffestb_V0187_ (nt);
17391 ffelex_token_kill (nt);
17392 return (ffelexHandler) (*next) (t);
17393
17394 default:
17395 nt = ffesta_tokens[1];
17396 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17397 FFEEXPR_contextFILEFORMAT, (ffeexprCallback) ffestb_V0186_)))
17398 (nt);
17399 ffelex_token_kill (nt);
17400 return (ffelexHandler) (*next) (t);
17401 }
17402 }
17403
17404 /* ffestb_V0186_ -- "REWRITE" OPEN_PAREN expr COMMA expr
17405
17406 (ffestb_V0186_) // to expression handler
17407
17408 Handle COMMA or CLOSE_PAREN here. */
17409
17410 static ffelexHandler
17411 ffestb_V0186_ (ffelexToken ft, ffebld expr, ffelexToken t)
17412 {
17413 switch (ffelex_token_type (t))
17414 {
17415 case FFELEX_typeCOMMA:
17416 case FFELEX_typeCLOSE_PAREN:
17417 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw_or_val_present
17418 = TRUE;
17419 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw_present = FALSE;
17420 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value_present = TRUE;
17421 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value_is_label
17422 = (expr == NULL);
17423 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value
17424 = ffelex_token_use (ft);
17425 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].u.expr = expr;
17426 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
17427 return (ffelexHandler) ffestb_V0187_;
17428 return (ffelexHandler) ffestb_V01812_;
17429
17430 default:
17431 break;
17432 }
17433
17434 ffestb_subr_kill_rewrite_ ();
17435 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17436 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17437 }
17438
17439 /* ffestb_V0187_ -- "REWRITE" OPEN_PAREN [external-file-unit COMMA [format
17440 COMMA]]
17441
17442 return ffestb_V0187_; // to lexer
17443
17444 Handle expr construct (not NAME=expr construct) here. */
17445
17446 static ffelexHandler
17447 ffestb_V0187_ (ffelexToken t)
17448 {
17449 ffestrGenio kw;
17450
17451 ffestb_local_.rewrite.label = FALSE;
17452
17453 switch (ffelex_token_type (t))
17454 {
17455 case FFELEX_typeNAME:
17456 kw = ffestr_genio (t);
17457 switch (kw)
17458 {
17459 case FFESTR_genioERR:
17460 ffestb_local_.rewrite.ix = FFESTP_rewriteixERR;
17461 ffestb_local_.rewrite.label = TRUE;
17462 break;
17463
17464 case FFESTR_genioFMT:
17465 ffestb_local_.rewrite.ix = FFESTP_rewriteixFMT;
17466 ffestb_local_.rewrite.left = FALSE;
17467 ffestb_local_.rewrite.context = FFEEXPR_contextFILEFORMAT;
17468 break;
17469
17470 case FFESTR_genioIOSTAT:
17471 ffestb_local_.rewrite.ix = FFESTP_rewriteixIOSTAT;
17472 ffestb_local_.rewrite.left = TRUE;
17473 ffestb_local_.rewrite.context = FFEEXPR_contextFILEINT;
17474 break;
17475
17476 case FFESTR_genioUNIT:
17477 ffestb_local_.rewrite.ix = FFESTP_rewriteixUNIT;
17478 ffestb_local_.rewrite.left = FALSE;
17479 ffestb_local_.rewrite.context = FFEEXPR_contextFILENUM;
17480 break;
17481
17482 default:
17483 goto bad; /* :::::::::::::::::::: */
17484 }
17485 if (ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
17486 .kw_or_val_present)
17487 break; /* Can't specify a keyword twice! */
17488 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
17489 .kw_or_val_present = TRUE;
17490 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
17491 .kw_present = TRUE;
17492 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
17493 .value_present = FALSE;
17494 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value_is_label
17495 = ffestb_local_.rewrite.label;
17496 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].kw
17497 = ffelex_token_use (t);
17498 return (ffelexHandler) ffestb_V0188_;
17499
17500 default:
17501 break;
17502 }
17503
17504 bad: /* :::::::::::::::::::: */
17505 ffestb_subr_kill_rewrite_ ();
17506 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17507 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17508 }
17509
17510 /* ffestb_V0188_ -- "REWRITE" OPEN_PAREN [external-file-unit COMMA [format
17511 COMMA]] NAME
17512
17513 return ffestb_V0188_; // to lexer
17514
17515 Make sure EQUALS here, send next token to expression handler. */
17516
17517 static ffelexHandler
17518 ffestb_V0188_ (ffelexToken t)
17519 {
17520 switch (ffelex_token_type (t))
17521 {
17522 case FFELEX_typeEQUALS:
17523 ffesta_confirmed ();
17524 if (ffestb_local_.rewrite.label)
17525 return (ffelexHandler) ffestb_V01810_;
17526 if (ffestb_local_.rewrite.left)
17527 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
17528 ffestb_local_.rewrite.context,
17529 (ffeexprCallback) ffestb_V0189_);
17530 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17531 ffestb_local_.rewrite.context,
17532 (ffeexprCallback) ffestb_V0189_);
17533
17534 default:
17535 break;
17536 }
17537
17538 ffestb_subr_kill_rewrite_ ();
17539 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17540 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17541 }
17542
17543 /* ffestb_V0189_ -- "REWRITE" OPEN_PAREN ... NAME EQUALS expr
17544
17545 (ffestb_V0189_) // to expression handler
17546
17547 Handle COMMA or CLOSE_PAREN here. */
17548
17549 static ffelexHandler
17550 ffestb_V0189_ (ffelexToken ft, ffebld expr, ffelexToken t)
17551 {
17552 switch (ffelex_token_type (t))
17553 {
17554 case FFELEX_typeCOMMA:
17555 case FFELEX_typeCLOSE_PAREN:
17556 if (expr == NULL)
17557 if (ffestb_local_.rewrite.context == FFEEXPR_contextFILEFORMAT)
17558 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
17559 .value_is_label = TRUE;
17560 else
17561 break;
17562 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value_present
17563 = TRUE;
17564 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value
17565 = ffelex_token_use (ft);
17566 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].u.expr = expr;
17567 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
17568 return (ffelexHandler) ffestb_V0187_;
17569 return (ffelexHandler) ffestb_V01812_;
17570
17571 default:
17572 break;
17573 }
17574
17575 ffestb_subr_kill_rewrite_ ();
17576 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17577 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17578 }
17579
17580 /* ffestb_V01810_ -- "REWRITE" OPEN_PAREN ... NAME EQUALS
17581
17582 return ffestb_V01810_; // to lexer
17583
17584 Handle NUMBER for label here. */
17585
17586 static ffelexHandler
17587 ffestb_V01810_ (ffelexToken t)
17588 {
17589 switch (ffelex_token_type (t))
17590 {
17591 case FFELEX_typeNUMBER:
17592 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value_present
17593 = TRUE;
17594 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value
17595 = ffelex_token_use (t);
17596 return (ffelexHandler) ffestb_V01811_;
17597
17598 default:
17599 break;
17600 }
17601
17602 ffestb_subr_kill_rewrite_ ();
17603 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17604 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17605 }
17606
17607 /* ffestb_V01811_ -- "REWRITE" OPEN_PAREN ... NAME EQUALS NUMBER
17608
17609 return ffestb_V01811_; // to lexer
17610
17611 Handle COMMA or CLOSE_PAREN here. */
17612
17613 static ffelexHandler
17614 ffestb_V01811_ (ffelexToken t)
17615 {
17616 switch (ffelex_token_type (t))
17617 {
17618 case FFELEX_typeCOMMA:
17619 return (ffelexHandler) ffestb_V0187_;
17620
17621 case FFELEX_typeCLOSE_PAREN:
17622 return (ffelexHandler) ffestb_V01812_;
17623
17624 default:
17625 break;
17626 }
17627
17628 ffestb_subr_kill_rewrite_ ();
17629 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17630 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17631 }
17632
17633 /* ffestb_V01812_ -- "REWRITE" OPEN_PAREN ... CLOSE_PAREN
17634
17635 return ffestb_V01812_; // to lexer
17636
17637 Handle EOS or SEMICOLON here. */
17638
17639 static ffelexHandler
17640 ffestb_V01812_ (ffelexToken t)
17641 {
17642 switch (ffelex_token_type (t))
17643 {
17644 case FFELEX_typeEOS:
17645 case FFELEX_typeSEMICOLON:
17646 ffesta_confirmed ();
17647 if (!ffesta_is_inhibited ())
17648 {
17649 ffestc_V018_start ();
17650 ffestc_V018_finish ();
17651 }
17652 ffestb_subr_kill_rewrite_ ();
17653 return (ffelexHandler) ffesta_zero (t);
17654
17655 case FFELEX_typeNAME:
17656 case FFELEX_typeOPEN_PAREN:
17657 case FFELEX_typeCOMMA:
17658 ffesta_confirmed ();
17659 if (!ffesta_is_inhibited ())
17660 ffestc_V018_start ();
17661 ffestb_subr_kill_rewrite_ ();
17662
17663 /* EXTENSION: Allow an optional preceding COMMA here if not pedantic.
17664 (f2c provides this extension, as do other compilers, supposedly.) */
17665
17666 if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA))
17667 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17668 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V01813_);
17669
17670 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17671 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V01813_)))
17672 (t);
17673
17674 default:
17675 break;
17676 }
17677
17678 ffestb_subr_kill_rewrite_ ();
17679 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17680 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17681 }
17682
17683 /* ffestb_V01813_ -- "REWRITE(...)" expr
17684
17685 (ffestb_V01813_) // to expression handler
17686
17687 Handle COMMA or EOS/SEMICOLON here. */
17688
17689 static ffelexHandler
17690 ffestb_V01813_ (ffelexToken ft, ffebld expr, ffelexToken t)
17691 {
17692 switch (ffelex_token_type (t))
17693 {
17694 case FFELEX_typeCOMMA:
17695 if (expr == NULL)
17696 break;
17697 if (!ffesta_is_inhibited ())
17698 ffestc_V018_item (expr, ft);
17699 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17700 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V01813_);
17701
17702 case FFELEX_typeEOS:
17703 case FFELEX_typeSEMICOLON:
17704 if (expr == NULL)
17705 break;
17706 if (!ffesta_is_inhibited ())
17707 {
17708 ffestc_V018_item (expr, ft);
17709 ffestc_V018_finish ();
17710 }
17711 return (ffelexHandler) ffesta_zero (t);
17712
17713 default:
17714 break;
17715 }
17716
17717 if (!ffesta_is_inhibited ())
17718 ffestc_V018_finish ();
17719 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17720 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17721 }
17722
17723 /* ffestb_V019 -- Parse the ACCEPT statement
17724
17725 return ffestb_V019; // to lexer
17726
17727 Make sure the statement has a valid form for the ACCEPT
17728 statement. If it does, implement the statement. */
17729
17730 ffelexHandler
17731 ffestb_V019 (ffelexToken t)
17732 {
17733 ffelexHandler next;
17734 ffestpAcceptIx ix;
17735
17736 switch (ffelex_token_type (ffesta_tokens[0]))
17737 {
17738 case FFELEX_typeNAME:
17739 if (ffesta_first_kw != FFESTR_firstACCEPT)
17740 goto bad_0; /* :::::::::::::::::::: */
17741 switch (ffelex_token_type (t))
17742 {
17743 case FFELEX_typeCOMMA:
17744 case FFELEX_typeCOLONCOLON:
17745 case FFELEX_typeEOS:
17746 case FFELEX_typeSEMICOLON:
17747 ffesta_confirmed (); /* Error, but clearly intended. */
17748 goto bad_1; /* :::::::::::::::::::: */
17749
17750 case FFELEX_typeEQUALS:
17751 case FFELEX_typePOINTS:
17752 case FFELEX_typeCOLON:
17753 goto bad_1; /* :::::::::::::::::::: */
17754
17755 case FFELEX_typeNAME:
17756 case FFELEX_typeNUMBER:
17757 ffesta_confirmed ();
17758 break;
17759
17760 default:
17761 break;
17762 }
17763
17764 for (ix = 0; ix < FFESTP_acceptix; ++ix)
17765 ffestp_file.accept.accept_spec[ix].kw_or_val_present = FALSE;
17766 return (ffelexHandler) (*((ffelexHandler)
17767 ffeexpr_rhs (ffesta_output_pool,
17768 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0191_)))
17769 (t);
17770
17771 case FFELEX_typeNAMES:
17772 if (ffesta_first_kw != FFESTR_firstACCEPT)
17773 goto bad_0; /* :::::::::::::::::::: */
17774 switch (ffelex_token_type (t))
17775 {
17776 case FFELEX_typeEOS:
17777 case FFELEX_typeSEMICOLON:
17778 case FFELEX_typeCOMMA:
17779 ffesta_confirmed ();
17780 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlACCEPT)
17781 break;
17782 goto bad_1; /* :::::::::::::::::::: */
17783
17784 case FFELEX_typeCOLONCOLON:
17785 ffesta_confirmed (); /* Error, but clearly intended. */
17786 goto bad_1; /* :::::::::::::::::::: */
17787
17788 case FFELEX_typeEQUALS:
17789 case FFELEX_typePOINTS:
17790 case FFELEX_typeCOLON:
17791 goto bad_1; /* :::::::::::::::::::: */
17792
17793 default:
17794 break;
17795 }
17796 for (ix = 0; ix < FFESTP_acceptix; ++ix)
17797 ffestp_file.accept.accept_spec[ix].kw_or_val_present = FALSE;
17798 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17799 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0191_);
17800 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
17801 FFESTR_firstlACCEPT);
17802 if (next == NULL)
17803 return (ffelexHandler) ffelex_swallow_tokens (t,
17804 (ffelexHandler) ffesta_zero);
17805 return (ffelexHandler) (*next) (t);
17806
17807 default:
17808 goto bad_0; /* :::::::::::::::::::: */
17809 }
17810
17811 bad_0: /* :::::::::::::::::::: */
17812 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", ffesta_tokens[0]);
17813 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17814
17815 bad_1: /* :::::::::::::::::::: */
17816 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", t);
17817 return (ffelexHandler) ffelex_swallow_tokens (t,
17818 (ffelexHandler) ffesta_zero); /* Invalid second token. */
17819 }
17820
17821 /* ffestb_V0191_ -- "ACCEPT" expr
17822
17823 (ffestb_V0191_) // to expression handler
17824
17825 Make sure the next token is a COMMA or EOS/SEMICOLON. */
17826
17827 static ffelexHandler
17828 ffestb_V0191_ (ffelexToken ft, ffebld expr, ffelexToken t)
17829 {
17830 switch (ffelex_token_type (t))
17831 {
17832 case FFELEX_typeEOS:
17833 case FFELEX_typeSEMICOLON:
17834 case FFELEX_typeCOMMA:
17835 ffesta_confirmed ();
17836 ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].kw_or_val_present
17837 = TRUE;
17838 ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].kw_present = FALSE;
17839 ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].value_present = TRUE;
17840 ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].value_is_label
17841 = (expr == NULL);
17842 ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].value
17843 = ffelex_token_use (ft);
17844 ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].u.expr = expr;
17845 if (!ffesta_is_inhibited ())
17846 ffestc_V019_start ();
17847 ffestb_subr_kill_accept_ ();
17848 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
17849 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
17850 FFEEXPR_contextIOLIST,
17851 (ffeexprCallback) ffestb_V0192_);
17852 if (!ffesta_is_inhibited ())
17853 ffestc_V019_finish ();
17854 return (ffelexHandler) ffesta_zero (t);
17855
17856 default:
17857 break;
17858 }
17859
17860 ffestb_subr_kill_accept_ ();
17861 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", t);
17862 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17863 }
17864
17865 /* ffestb_V0192_ -- "ACCEPT" expr COMMA expr
17866
17867 (ffestb_V0192_) // to expression handler
17868
17869 Handle COMMA or EOS/SEMICOLON here. */
17870
17871 static ffelexHandler
17872 ffestb_V0192_ (ffelexToken ft, ffebld expr, ffelexToken t)
17873 {
17874 switch (ffelex_token_type (t))
17875 {
17876 case FFELEX_typeCOMMA:
17877 if (expr == NULL)
17878 break;
17879 if (!ffesta_is_inhibited ())
17880 ffestc_V019_item (expr, ft);
17881 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
17882 FFEEXPR_contextIOLIST,
17883 (ffeexprCallback) ffestb_V0192_);
17884
17885 case FFELEX_typeEOS:
17886 case FFELEX_typeSEMICOLON:
17887 if (expr == NULL)
17888 break;
17889 if (!ffesta_is_inhibited ())
17890 {
17891 ffestc_V019_item (expr, ft);
17892 ffestc_V019_finish ();
17893 }
17894 return (ffelexHandler) ffesta_zero (t);
17895
17896 default:
17897 break;
17898 }
17899
17900 if (!ffesta_is_inhibited ())
17901 ffestc_V019_finish ();
17902 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", t);
17903 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17904 }
17905
17906 #endif
17907 /* ffestb_V020 -- Parse the TYPE statement
17908
17909 return ffestb_V020; // to lexer
17910
17911 Make sure the statement has a valid form for the TYPE
17912 statement. If it does, implement the statement. */
17913
17914 ffelexHandler
17915 ffestb_V020 (ffelexToken t)
17916 {
17917 ffeTokenLength i;
17918 const char *p;
17919 ffelexHandler next;
17920 ffestpTypeIx ix;
17921
17922 switch (ffelex_token_type (ffesta_tokens[0]))
17923 {
17924 case FFELEX_typeNAME:
17925 if (ffesta_first_kw != FFESTR_firstTYPE)
17926 goto bad_0; /* :::::::::::::::::::: */
17927 switch (ffelex_token_type (t))
17928 {
17929 case FFELEX_typeCOLONCOLON:
17930 case FFELEX_typeEOS:
17931 case FFELEX_typeSEMICOLON:
17932 ffesta_confirmed (); /* Error, but clearly intended. */
17933 goto bad_1; /* :::::::::::::::::::: */
17934
17935 case FFELEX_typeEQUALS:
17936 case FFELEX_typePOINTS:
17937 case FFELEX_typeCOLON:
17938 case FFELEX_typeCOMMA: /* Because "TYPE,PUBLIC::A" is ambiguous with
17939 '90. */
17940 goto bad_1; /* :::::::::::::::::::: */
17941
17942 case FFELEX_typeNUMBER:
17943 ffesta_confirmed ();
17944 break;
17945
17946 case FFELEX_typeNAME: /* Because TYPE A is ambiguous with '90. */
17947 default:
17948 break;
17949 }
17950
17951 for (ix = 0; ix < FFESTP_typeix; ++ix)
17952 ffestp_file.type.type_spec[ix].kw_or_val_present = FALSE;
17953 return (ffelexHandler) (*((ffelexHandler)
17954 ffeexpr_rhs (ffesta_output_pool,
17955 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0201_)))
17956 (t);
17957
17958 case FFELEX_typeNAMES:
17959 if (ffesta_first_kw != FFESTR_firstTYPE)
17960 goto bad_0; /* :::::::::::::::::::: */
17961 switch (ffelex_token_type (t))
17962 {
17963 case FFELEX_typeEOS:
17964 case FFELEX_typeSEMICOLON:
17965 case FFELEX_typeCOMMA:
17966 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlTYPE)
17967 break;
17968 goto bad_1; /* :::::::::::::::::::: */
17969
17970 case FFELEX_typeCOLONCOLON:
17971 ffesta_confirmed (); /* Error, but clearly intended. */
17972 goto bad_1; /* :::::::::::::::::::: */
17973
17974 case FFELEX_typeOPEN_PAREN:
17975 if (ffelex_token_length (ffesta_tokens[0]) == FFESTR_firstlTYPE)
17976 break; /* Else might be assignment/stmtfuncdef. */
17977 goto bad_1; /* :::::::::::::::::::: */
17978
17979 case FFELEX_typeEQUALS:
17980 case FFELEX_typePOINTS:
17981 case FFELEX_typeCOLON:
17982 goto bad_1; /* :::::::::::::::::::: */
17983
17984 default:
17985 break;
17986 }
17987 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlTYPE);
17988 if (ISDIGIT (*p))
17989 ffesta_confirmed (); /* Else might be '90 TYPE statement. */
17990 for (ix = 0; ix < FFESTP_typeix; ++ix)
17991 ffestp_file.type.type_spec[ix].kw_or_val_present = FALSE;
17992 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17993 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0201_);
17994 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
17995 FFESTR_firstlTYPE);
17996 if (next == NULL)
17997 return (ffelexHandler) ffelex_swallow_tokens (t,
17998 (ffelexHandler) ffesta_zero);
17999 return (ffelexHandler) (*next) (t);
18000
18001 default:
18002 goto bad_0; /* :::::::::::::::::::: */
18003 }
18004
18005 bad_0: /* :::::::::::::::::::: */
18006 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", ffesta_tokens[0]);
18007 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18008
18009 bad_1: /* :::::::::::::::::::: */
18010 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", t);
18011 return (ffelexHandler) ffelex_swallow_tokens (t,
18012 (ffelexHandler) ffesta_zero); /* Invalid second token. */
18013 }
18014
18015 /* ffestb_V0201_ -- "TYPE" expr
18016
18017 (ffestb_V0201_) // to expression handler
18018
18019 Make sure the next token is a COMMA or EOS/SEMICOLON. */
18020
18021 static ffelexHandler
18022 ffestb_V0201_ (ffelexToken ft, ffebld expr, ffelexToken t)
18023 {
18024 bool comma = TRUE;
18025
18026 switch (ffelex_token_type (t))
18027 {
18028 case FFELEX_typeEOS:
18029 case FFELEX_typeSEMICOLON:
18030 if (!ffe_is_vxt () && (expr != NULL)
18031 && (ffebld_op (expr) == FFEBLD_opSYMTER))
18032 break;
18033 comma = FALSE;
18034 /* Fall through. */
18035 case FFELEX_typeCOMMA:
18036 if (!ffe_is_vxt () && comma && (expr != NULL)
18037 && (ffebld_op (expr) == FFEBLD_opPAREN)
18038 && (ffebld_op (ffebld_left (expr)) == FFEBLD_opSYMTER))
18039 break;
18040 ffesta_confirmed ();
18041 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].kw_or_val_present
18042 = TRUE;
18043 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].kw_present = FALSE;
18044 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].value_present = TRUE;
18045 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].value_is_label
18046 = (expr == NULL);
18047 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].value
18048 = ffelex_token_use (ft);
18049 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].u.expr = expr;
18050 if (!ffesta_is_inhibited ())
18051 ffestc_V020_start ();
18052 ffestb_subr_kill_type_ ();
18053 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
18054 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
18055 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V0202_);
18056 if (!ffesta_is_inhibited ())
18057 ffestc_V020_finish ();
18058 return (ffelexHandler) ffesta_zero (t);
18059
18060 default:
18061 break;
18062 }
18063
18064 ffestb_subr_kill_type_ ();
18065 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", t);
18066 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18067 }
18068
18069 /* ffestb_V0202_ -- "TYPE" expr COMMA expr
18070
18071 (ffestb_V0202_) // to expression handler
18072
18073 Handle COMMA or EOS/SEMICOLON here. */
18074
18075 static ffelexHandler
18076 ffestb_V0202_ (ffelexToken ft, ffebld expr, ffelexToken t)
18077 {
18078 switch (ffelex_token_type (t))
18079 {
18080 case FFELEX_typeCOMMA:
18081 if (expr == NULL)
18082 break;
18083 if (!ffesta_is_inhibited ())
18084 ffestc_V020_item (expr, ft);
18085 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
18086 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V0202_);
18087
18088 case FFELEX_typeEOS:
18089 case FFELEX_typeSEMICOLON:
18090 if (expr == NULL)
18091 break;
18092 if (!ffesta_is_inhibited ())
18093 {
18094 ffestc_V020_item (expr, ft);
18095 ffestc_V020_finish ();
18096 }
18097 return (ffelexHandler) ffesta_zero (t);
18098
18099 default:
18100 break;
18101 }
18102
18103 if (!ffesta_is_inhibited ())
18104 ffestc_V020_finish ();
18105 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", t);
18106 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18107 }
18108
18109 /* ffestb_V021 -- Parse a DELETE statement
18110
18111 return ffestb_V021; // to lexer
18112
18113 Make sure the statement has a valid form for a DELETE statement.
18114 If it does, implement the statement. */
18115
18116 #if FFESTR_VXT
18117 ffelexHandler
18118 ffestb_V021 (ffelexToken t)
18119 {
18120 ffestpDeleteIx ix;
18121
18122 switch (ffelex_token_type (ffesta_tokens[0]))
18123 {
18124 case FFELEX_typeNAME:
18125 if (ffesta_first_kw != FFESTR_firstDELETE)
18126 goto bad_0; /* :::::::::::::::::::: */
18127 break;
18128
18129 case FFELEX_typeNAMES:
18130 if (ffesta_first_kw != FFESTR_firstDELETE)
18131 goto bad_0; /* :::::::::::::::::::: */
18132 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlDELETE)
18133 goto bad_0; /* :::::::::::::::::::: */
18134 break;
18135
18136 default:
18137 goto bad_0; /* :::::::::::::::::::: */
18138 }
18139
18140 switch (ffelex_token_type (t))
18141 {
18142 case FFELEX_typeOPEN_PAREN:
18143 break;
18144
18145 case FFELEX_typeEOS:
18146 case FFELEX_typeSEMICOLON:
18147 case FFELEX_typeCOMMA:
18148 case FFELEX_typeCOLONCOLON:
18149 ffesta_confirmed (); /* Error, but clearly intended. */
18150 goto bad_1; /* :::::::::::::::::::: */
18151
18152 default:
18153 goto bad_1; /* :::::::::::::::::::: */
18154 }
18155
18156 for (ix = 0; ix < FFESTP_deleteix; ++ix)
18157 ffestp_file.delete.delete_spec[ix].kw_or_val_present = FALSE;
18158
18159 return (ffelexHandler) ffestb_V0211_;
18160
18161 bad_0: /* :::::::::::::::::::: */
18162 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", ffesta_tokens[0]);
18163 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18164
18165 bad_1: /* :::::::::::::::::::: */
18166 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
18167 return (ffelexHandler) ffelex_swallow_tokens (t,
18168 (ffelexHandler) ffesta_zero); /* Invalid second token. */
18169 }
18170
18171 /* ffestb_V0211_ -- "DELETE" OPEN_PAREN
18172
18173 return ffestb_V0211_; // to lexer
18174
18175 Handle expr construct (not NAME=expr construct) here. */
18176
18177 static ffelexHandler
18178 ffestb_V0211_ (ffelexToken t)
18179 {
18180 switch (ffelex_token_type (t))
18181 {
18182 case FFELEX_typeNAME:
18183 ffesta_tokens[1] = ffelex_token_use (t);
18184 return (ffelexHandler) ffestb_V0212_;
18185
18186 default:
18187 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
18188 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0213_)))
18189 (t);
18190 }
18191 }
18192
18193 /* ffestb_V0212_ -- "DELETE" OPEN_PAREN NAME
18194
18195 return ffestb_V0212_; // to lexer
18196
18197 If EQUALS here, go to states that handle it. Else, send NAME and this
18198 token thru expression handler. */
18199
18200 static ffelexHandler
18201 ffestb_V0212_ (ffelexToken t)
18202 {
18203 ffelexHandler next;
18204 ffelexToken nt;
18205
18206 switch (ffelex_token_type (t))
18207 {
18208 case FFELEX_typeEQUALS:
18209 nt = ffesta_tokens[1];
18210 next = (ffelexHandler) ffestb_V0214_ (nt);
18211 ffelex_token_kill (nt);
18212 return (ffelexHandler) (*next) (t);
18213
18214 default:
18215 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
18216 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0213_)))
18217 (ffesta_tokens[1]);
18218 ffelex_token_kill (ffesta_tokens[1]);
18219 return (ffelexHandler) (*next) (t);
18220 }
18221 }
18222
18223 /* ffestb_V0213_ -- "DELETE" OPEN_PAREN expr
18224
18225 (ffestb_V0213_) // to expression handler
18226
18227 Handle COMMA or DELETE_PAREN here. */
18228
18229 static ffelexHandler
18230 ffestb_V0213_ (ffelexToken ft, ffebld expr, ffelexToken t)
18231 {
18232 switch (ffelex_token_type (t))
18233 {
18234 case FFELEX_typeCOMMA:
18235 case FFELEX_typeCLOSE_PAREN:
18236 if (expr == NULL)
18237 break;
18238 ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].kw_or_val_present
18239 = TRUE;
18240 ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].kw_present = FALSE;
18241 ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].value_present = TRUE;
18242 ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].value_is_label
18243 = FALSE;
18244 ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].value
18245 = ffelex_token_use (ft);
18246 ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].u.expr = expr;
18247 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
18248 return (ffelexHandler) ffestb_V0214_;
18249 return (ffelexHandler) ffestb_V0219_;
18250
18251 default:
18252 break;
18253 }
18254
18255 ffestb_subr_kill_delete_ ();
18256 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
18257 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18258 }
18259
18260 /* ffestb_V0214_ -- "DELETE" OPEN_PAREN [external-file-unit COMMA]
18261
18262 return ffestb_V0214_; // to lexer
18263
18264 Handle expr construct (not NAME=expr construct) here. */
18265
18266 static ffelexHandler
18267 ffestb_V0214_ (ffelexToken t)
18268 {
18269 ffestrGenio kw;
18270
18271 ffestb_local_.delete.label = FALSE;
18272
18273 switch (ffelex_token_type (t))
18274 {
18275 case FFELEX_typeNAME:
18276 kw = ffestr_genio (t);
18277 switch (kw)
18278 {
18279 case FFESTR_genioERR:
18280 ffestb_local_.delete.ix = FFESTP_deleteixERR;
18281 ffestb_local_.delete.label = TRUE;
18282 break;
18283
18284 case FFESTR_genioIOSTAT:
18285 ffestb_local_.delete.ix = FFESTP_deleteixIOSTAT;
18286 ffestb_local_.delete.left = TRUE;
18287 ffestb_local_.delete.context = FFEEXPR_contextFILEINT;
18288 break;
18289
18290 case FFESTR_genioREC:
18291 ffestb_local_.delete.ix = FFESTP_deleteixREC;
18292 ffestb_local_.delete.left = FALSE;
18293 ffestb_local_.delete.context = FFEEXPR_contextFILENUM;
18294 break;
18295
18296 case FFESTR_genioUNIT:
18297 ffestb_local_.delete.ix = FFESTP_deleteixUNIT;
18298 ffestb_local_.delete.left = FALSE;
18299 ffestb_local_.delete.context = FFEEXPR_contextFILENUM;
18300 break;
18301
18302 default:
18303 goto bad; /* :::::::::::::::::::: */
18304 }
18305 if (ffestp_file.delete.delete_spec[ffestb_local_.delete.ix]
18306 .kw_or_val_present)
18307 break; /* Can't specify a keyword twice! */
18308 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix]
18309 .kw_or_val_present = TRUE;
18310 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix]
18311 .kw_present = TRUE;
18312 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix]
18313 .value_present = FALSE;
18314 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value_is_label
18315 = ffestb_local_.delete.label;
18316 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].kw
18317 = ffelex_token_use (t);
18318 return (ffelexHandler) ffestb_V0215_;
18319
18320 default:
18321 break;
18322 }
18323
18324 bad: /* :::::::::::::::::::: */
18325 ffestb_subr_kill_delete_ ();
18326 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
18327 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18328 }
18329
18330 /* ffestb_V0215_ -- "DELETE" OPEN_PAREN [external-file-unit COMMA] NAME
18331
18332 return ffestb_V0215_; // to lexer
18333
18334 Make sure EQUALS here, send next token to expression handler. */
18335
18336 static ffelexHandler
18337 ffestb_V0215_ (ffelexToken t)
18338 {
18339 switch (ffelex_token_type (t))
18340 {
18341 case FFELEX_typeEQUALS:
18342 ffesta_confirmed ();
18343 if (ffestb_local_.delete.label)
18344 return (ffelexHandler) ffestb_V0217_;
18345 if (ffestb_local_.delete.left)
18346 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
18347 ffestb_local_.delete.context,
18348 (ffeexprCallback) ffestb_V0216_);
18349 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
18350 ffestb_local_.delete.context, (ffeexprCallback) ffestb_V0216_);
18351
18352 default:
18353 break;
18354 }
18355
18356 ffestb_subr_kill_delete_ ();
18357 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
18358 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18359 }
18360
18361 /* ffestb_V0216_ -- "DELETE" OPEN_PAREN ... NAME EQUALS expr
18362
18363 (ffestb_V0216_) // to expression handler
18364
18365 Handle COMMA or CLOSE_PAREN here. */
18366
18367 static ffelexHandler
18368 ffestb_V0216_ (ffelexToken ft, ffebld expr, ffelexToken t)
18369 {
18370 switch (ffelex_token_type (t))
18371 {
18372 case FFELEX_typeCOMMA:
18373 case FFELEX_typeCLOSE_PAREN:
18374 if (expr == NULL)
18375 break;
18376 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value_present
18377 = TRUE;
18378 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value
18379 = ffelex_token_use (ft);
18380 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].u.expr = expr;
18381 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
18382 return (ffelexHandler) ffestb_V0214_;
18383 return (ffelexHandler) ffestb_V0219_;
18384
18385 default:
18386 break;
18387 }
18388
18389 ffestb_subr_kill_delete_ ();
18390 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
18391 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18392 }
18393
18394 /* ffestb_V0217_ -- "DELETE" OPEN_PAREN ... NAME EQUALS
18395
18396 return ffestb_V0217_; // to lexer
18397
18398 Handle NUMBER for label here. */
18399
18400 static ffelexHandler
18401 ffestb_V0217_ (ffelexToken t)
18402 {
18403 switch (ffelex_token_type (t))
18404 {
18405 case FFELEX_typeNUMBER:
18406 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value_present
18407 = TRUE;
18408 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value
18409 = ffelex_token_use (t);
18410 return (ffelexHandler) ffestb_V0218_;
18411
18412 default:
18413 break;
18414 }
18415
18416 ffestb_subr_kill_delete_ ();
18417 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
18418 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18419 }
18420
18421 /* ffestb_V0218_ -- "DELETE" OPEN_PAREN ... NAME EQUALS NUMBER
18422
18423 return ffestb_V0218_; // to lexer
18424
18425 Handle COMMA or CLOSE_PAREN here. */
18426
18427 static ffelexHandler
18428 ffestb_V0218_ (ffelexToken t)
18429 {
18430 switch (ffelex_token_type (t))
18431 {
18432 case FFELEX_typeCOMMA:
18433 return (ffelexHandler) ffestb_V0214_;
18434
18435 case FFELEX_typeCLOSE_PAREN:
18436 return (ffelexHandler) ffestb_V0219_;
18437
18438 default:
18439 break;
18440 }
18441
18442 ffestb_subr_kill_delete_ ();
18443 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
18444 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18445 }
18446
18447 /* ffestb_V0219_ -- "DELETE" OPEN_PAREN ... CLOSE_PAREN
18448
18449 return ffestb_V0219_; // to lexer
18450
18451 Handle EOS or SEMICOLON here. */
18452
18453 static ffelexHandler
18454 ffestb_V0219_ (ffelexToken t)
18455 {
18456 switch (ffelex_token_type (t))
18457 {
18458 case FFELEX_typeEOS:
18459 case FFELEX_typeSEMICOLON:
18460 ffesta_confirmed ();
18461 if (!ffesta_is_inhibited ())
18462 ffestc_V021 ();
18463 ffestb_subr_kill_delete_ ();
18464 return (ffelexHandler) ffesta_zero (t);
18465
18466 default:
18467 break;
18468 }
18469
18470 ffestb_subr_kill_delete_ ();
18471 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
18472 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18473 }
18474
18475 /* ffestb_V026 -- Parse a FIND statement
18476
18477 return ffestb_V026; // to lexer
18478
18479 Make sure the statement has a valid form for a FIND statement.
18480 If it does, implement the statement. */
18481
18482 ffelexHandler
18483 ffestb_V026 (ffelexToken t)
18484 {
18485 ffestpFindIx ix;
18486
18487 switch (ffelex_token_type (ffesta_tokens[0]))
18488 {
18489 case FFELEX_typeNAME:
18490 if (ffesta_first_kw != FFESTR_firstFIND)
18491 goto bad_0; /* :::::::::::::::::::: */
18492 break;
18493
18494 case FFELEX_typeNAMES:
18495 if (ffesta_first_kw != FFESTR_firstFIND)
18496 goto bad_0; /* :::::::::::::::::::: */
18497 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlFIND)
18498 goto bad_0; /* :::::::::::::::::::: */
18499 break;
18500
18501 default:
18502 goto bad_0; /* :::::::::::::::::::: */
18503 }
18504
18505 switch (ffelex_token_type (t))
18506 {
18507 case FFELEX_typeOPEN_PAREN:
18508 break;
18509
18510 case FFELEX_typeEOS:
18511 case FFELEX_typeSEMICOLON:
18512 case FFELEX_typeCOMMA:
18513 case FFELEX_typeCOLONCOLON:
18514 ffesta_confirmed (); /* Error, but clearly intended. */
18515 goto bad_1; /* :::::::::::::::::::: */
18516
18517 default:
18518 goto bad_1; /* :::::::::::::::::::: */
18519 }
18520
18521 for (ix = 0; ix < FFESTP_findix; ++ix)
18522 ffestp_file.find.find_spec[ix].kw_or_val_present = FALSE;
18523
18524 return (ffelexHandler) ffestb_V0261_;
18525
18526 bad_0: /* :::::::::::::::::::: */
18527 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", ffesta_tokens[0]);
18528 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18529
18530 bad_1: /* :::::::::::::::::::: */
18531 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
18532 return (ffelexHandler) ffelex_swallow_tokens (t,
18533 (ffelexHandler) ffesta_zero); /* Invalid second token. */
18534 }
18535
18536 /* ffestb_V0261_ -- "FIND" OPEN_PAREN
18537
18538 return ffestb_V0261_; // to lexer
18539
18540 Handle expr construct (not NAME=expr construct) here. */
18541
18542 static ffelexHandler
18543 ffestb_V0261_ (ffelexToken t)
18544 {
18545 switch (ffelex_token_type (t))
18546 {
18547 case FFELEX_typeNAME:
18548 ffesta_tokens[1] = ffelex_token_use (t);
18549 return (ffelexHandler) ffestb_V0262_;
18550
18551 default:
18552 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
18553 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0263_)))
18554 (t);
18555 }
18556 }
18557
18558 /* ffestb_V0262_ -- "FIND" OPEN_PAREN NAME
18559
18560 return ffestb_V0262_; // to lexer
18561
18562 If EQUALS here, go to states that handle it. Else, send NAME and this
18563 token thru expression handler. */
18564
18565 static ffelexHandler
18566 ffestb_V0262_ (ffelexToken t)
18567 {
18568 ffelexHandler next;
18569 ffelexToken nt;
18570
18571 switch (ffelex_token_type (t))
18572 {
18573 case FFELEX_typeEQUALS:
18574 nt = ffesta_tokens[1];
18575 next = (ffelexHandler) ffestb_V0264_ (nt);
18576 ffelex_token_kill (nt);
18577 return (ffelexHandler) (*next) (t);
18578
18579 default:
18580 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
18581 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0263_)))
18582 (ffesta_tokens[1]);
18583 ffelex_token_kill (ffesta_tokens[1]);
18584 return (ffelexHandler) (*next) (t);
18585 }
18586 }
18587
18588 /* ffestb_V0263_ -- "FIND" OPEN_PAREN expr
18589
18590 (ffestb_V0263_) // to expression handler
18591
18592 Handle COMMA or FIND_PAREN here. */
18593
18594 static ffelexHandler
18595 ffestb_V0263_ (ffelexToken ft, ffebld expr, ffelexToken t)
18596 {
18597 switch (ffelex_token_type (t))
18598 {
18599 case FFELEX_typeCOMMA:
18600 case FFELEX_typeCLOSE_PAREN:
18601 if (expr == NULL)
18602 break;
18603 ffestp_file.find.find_spec[FFESTP_findixUNIT].kw_or_val_present
18604 = TRUE;
18605 ffestp_file.find.find_spec[FFESTP_findixUNIT].kw_present = FALSE;
18606 ffestp_file.find.find_spec[FFESTP_findixUNIT].value_present = TRUE;
18607 ffestp_file.find.find_spec[FFESTP_findixUNIT].value_is_label
18608 = FALSE;
18609 ffestp_file.find.find_spec[FFESTP_findixUNIT].value
18610 = ffelex_token_use (ft);
18611 ffestp_file.find.find_spec[FFESTP_findixUNIT].u.expr = expr;
18612 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
18613 return (ffelexHandler) ffestb_V0264_;
18614 return (ffelexHandler) ffestb_V0269_;
18615
18616 default:
18617 break;
18618 }
18619
18620 ffestb_subr_kill_find_ ();
18621 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
18622 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18623 }
18624
18625 /* ffestb_V0264_ -- "FIND" OPEN_PAREN [external-file-unit COMMA]
18626
18627 return ffestb_V0264_; // to lexer
18628
18629 Handle expr construct (not NAME=expr construct) here. */
18630
18631 static ffelexHandler
18632 ffestb_V0264_ (ffelexToken t)
18633 {
18634 ffestrGenio kw;
18635
18636 ffestb_local_.find.label = FALSE;
18637
18638 switch (ffelex_token_type (t))
18639 {
18640 case FFELEX_typeNAME:
18641 kw = ffestr_genio (t);
18642 switch (kw)
18643 {
18644 case FFESTR_genioERR:
18645 ffestb_local_.find.ix = FFESTP_findixERR;
18646 ffestb_local_.find.label = TRUE;
18647 break;
18648
18649 case FFESTR_genioIOSTAT:
18650 ffestb_local_.find.ix = FFESTP_findixIOSTAT;
18651 ffestb_local_.find.left = TRUE;
18652 ffestb_local_.find.context = FFEEXPR_contextFILEINT;
18653 break;
18654
18655 case FFESTR_genioREC:
18656 ffestb_local_.find.ix = FFESTP_findixREC;
18657 ffestb_local_.find.left = FALSE;
18658 ffestb_local_.find.context = FFEEXPR_contextFILENUM;
18659 break;
18660
18661 case FFESTR_genioUNIT:
18662 ffestb_local_.find.ix = FFESTP_findixUNIT;
18663 ffestb_local_.find.left = FALSE;
18664 ffestb_local_.find.context = FFEEXPR_contextFILENUM;
18665 break;
18666
18667 default:
18668 goto bad; /* :::::::::::::::::::: */
18669 }
18670 if (ffestp_file.find.find_spec[ffestb_local_.find.ix]
18671 .kw_or_val_present)
18672 break; /* Can't specify a keyword twice! */
18673 ffestp_file.find.find_spec[ffestb_local_.find.ix]
18674 .kw_or_val_present = TRUE;
18675 ffestp_file.find.find_spec[ffestb_local_.find.ix]
18676 .kw_present = TRUE;
18677 ffestp_file.find.find_spec[ffestb_local_.find.ix]
18678 .value_present = FALSE;
18679 ffestp_file.find.find_spec[ffestb_local_.find.ix].value_is_label
18680 = ffestb_local_.find.label;
18681 ffestp_file.find.find_spec[ffestb_local_.find.ix].kw
18682 = ffelex_token_use (t);
18683 return (ffelexHandler) ffestb_V0265_;
18684
18685 default:
18686 break;
18687 }
18688
18689 bad: /* :::::::::::::::::::: */
18690 ffestb_subr_kill_find_ ();
18691 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
18692 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18693 }
18694
18695 /* ffestb_V0265_ -- "FIND" OPEN_PAREN [external-file-unit COMMA] NAME
18696
18697 return ffestb_V0265_; // to lexer
18698
18699 Make sure EQUALS here, send next token to expression handler. */
18700
18701 static ffelexHandler
18702 ffestb_V0265_ (ffelexToken t)
18703 {
18704 switch (ffelex_token_type (t))
18705 {
18706 case FFELEX_typeEQUALS:
18707 ffesta_confirmed ();
18708 if (ffestb_local_.find.label)
18709 return (ffelexHandler) ffestb_V0267_;
18710 if (ffestb_local_.find.left)
18711 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
18712 ffestb_local_.find.context,
18713 (ffeexprCallback) ffestb_V0266_);
18714 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
18715 ffestb_local_.find.context,
18716 (ffeexprCallback) ffestb_V0266_);
18717
18718 default:
18719 break;
18720 }
18721
18722 ffestb_subr_kill_find_ ();
18723 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
18724 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18725 }
18726
18727 /* ffestb_V0266_ -- "FIND" OPEN_PAREN ... NAME EQUALS expr
18728
18729 (ffestb_V0266_) // to expression handler
18730
18731 Handle COMMA or CLOSE_PAREN here. */
18732
18733 static ffelexHandler
18734 ffestb_V0266_ (ffelexToken ft, ffebld expr, ffelexToken t)
18735 {
18736 switch (ffelex_token_type (t))
18737 {
18738 case FFELEX_typeCOMMA:
18739 case FFELEX_typeCLOSE_PAREN:
18740 if (expr == NULL)
18741 break;
18742 ffestp_file.find.find_spec[ffestb_local_.find.ix].value_present
18743 = TRUE;
18744 ffestp_file.find.find_spec[ffestb_local_.find.ix].value
18745 = ffelex_token_use (ft);
18746 ffestp_file.find.find_spec[ffestb_local_.find.ix].u.expr = expr;
18747 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
18748 return (ffelexHandler) ffestb_V0264_;
18749 return (ffelexHandler) ffestb_V0269_;
18750
18751 default:
18752 break;
18753 }
18754
18755 ffestb_subr_kill_find_ ();
18756 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
18757 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18758 }
18759
18760 /* ffestb_V0267_ -- "FIND" OPEN_PAREN ... NAME EQUALS
18761
18762 return ffestb_V0267_; // to lexer
18763
18764 Handle NUMBER for label here. */
18765
18766 static ffelexHandler
18767 ffestb_V0267_ (ffelexToken t)
18768 {
18769 switch (ffelex_token_type (t))
18770 {
18771 case FFELEX_typeNUMBER:
18772 ffestp_file.find.find_spec[ffestb_local_.find.ix].value_present
18773 = TRUE;
18774 ffestp_file.find.find_spec[ffestb_local_.find.ix].value
18775 = ffelex_token_use (t);
18776 return (ffelexHandler) ffestb_V0268_;
18777
18778 default:
18779 break;
18780 }
18781
18782 ffestb_subr_kill_find_ ();
18783 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
18784 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18785 }
18786
18787 /* ffestb_V0268_ -- "FIND" OPEN_PAREN ... NAME EQUALS NUMBER
18788
18789 return ffestb_V0268_; // to lexer
18790
18791 Handle COMMA or CLOSE_PAREN here. */
18792
18793 static ffelexHandler
18794 ffestb_V0268_ (ffelexToken t)
18795 {
18796 switch (ffelex_token_type (t))
18797 {
18798 case FFELEX_typeCOMMA:
18799 return (ffelexHandler) ffestb_V0264_;
18800
18801 case FFELEX_typeCLOSE_PAREN:
18802 return (ffelexHandler) ffestb_V0269_;
18803
18804 default:
18805 break;
18806 }
18807
18808 ffestb_subr_kill_find_ ();
18809 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
18810 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18811 }
18812
18813 /* ffestb_V0269_ -- "FIND" OPEN_PAREN ... CLOSE_PAREN
18814
18815 return ffestb_V0269_; // to lexer
18816
18817 Handle EOS or SEMICOLON here. */
18818
18819 static ffelexHandler
18820 ffestb_V0269_ (ffelexToken t)
18821 {
18822 switch (ffelex_token_type (t))
18823 {
18824 case FFELEX_typeEOS:
18825 case FFELEX_typeSEMICOLON:
18826 ffesta_confirmed ();
18827 if (!ffesta_is_inhibited ())
18828 ffestc_V026 ();
18829 ffestb_subr_kill_find_ ();
18830 return (ffelexHandler) ffesta_zero (t);
18831
18832 default:
18833 break;
18834 }
18835
18836 ffestb_subr_kill_find_ ();
18837 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
18838 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18839 }
18840
18841 #endif
18842 /* ffestb_dimlist -- Parse the ALLOCATABLE/POINTER/TARGET statement
18843
18844 return ffestb_dimlist; // to lexer
18845
18846 Make sure the statement has a valid form for the ALLOCATABLE/POINTER/
18847 TARGET statement. If it does, implement the statement. */
18848
18849 #if FFESTR_F90
18850 ffelexHandler
18851 ffestb_dimlist (ffelexToken t)
18852 {
18853 ffeTokenLength i;
18854 const char *p;
18855 ffelexToken nt;
18856 ffelexHandler next;
18857
18858 switch (ffelex_token_type (ffesta_tokens[0]))
18859 {
18860 case FFELEX_typeNAME:
18861 switch (ffelex_token_type (t))
18862 {
18863 case FFELEX_typeCOMMA:
18864 case FFELEX_typeEOS:
18865 case FFELEX_typeSEMICOLON:
18866 ffesta_confirmed (); /* Error, but clearly intended. */
18867 goto bad_1; /* :::::::::::::::::::: */
18868
18869 default:
18870 goto bad_1; /* :::::::::::::::::::: */
18871
18872 case FFELEX_typeCOLONCOLON:
18873 ffesta_confirmed ();
18874 if (!ffesta_is_inhibited ())
18875 {
18876 switch (ffesta_first_kw)
18877 {
18878 case FFESTR_firstALLOCATABLE:
18879 ffestc_R525_start ();
18880 break;
18881
18882 case FFESTR_firstPOINTER:
18883 ffestc_R526_start ();
18884 break;
18885
18886 case FFESTR_firstTARGET:
18887 ffestc_R527_start ();
18888 break;
18889
18890 default:
18891 assert (FALSE);
18892 }
18893 }
18894 ffestb_local_.dimlist.started = TRUE;
18895 return (ffelexHandler) ffestb_dimlist1_;
18896
18897 case FFELEX_typeNAME:
18898 ffesta_confirmed ();
18899 if (!ffesta_is_inhibited ())
18900 {
18901 switch (ffesta_first_kw)
18902 {
18903 case FFESTR_firstALLOCATABLE:
18904 ffestc_R525_start ();
18905 break;
18906
18907 case FFESTR_firstPOINTER:
18908 ffestc_R526_start ();
18909 break;
18910
18911 case FFESTR_firstTARGET:
18912 ffestc_R527_start ();
18913 break;
18914
18915 default:
18916 assert (FALSE);
18917 }
18918 }
18919 ffestb_local_.dimlist.started = TRUE;
18920 return (ffelexHandler) ffestb_dimlist1_ (t);
18921 }
18922
18923 case FFELEX_typeNAMES:
18924 p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.dimlist.len);
18925 switch (ffelex_token_type (t))
18926 {
18927 default:
18928 goto bad_1; /* :::::::::::::::::::: */
18929
18930 case FFELEX_typeEOS:
18931 case FFELEX_typeSEMICOLON:
18932 case FFELEX_typeCOMMA:
18933 ffesta_confirmed ();
18934 if (!ffesrc_is_name_init (*p))
18935 goto bad_i; /* :::::::::::::::::::: */
18936 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
18937 if (!ffesta_is_inhibited ())
18938 {
18939 switch (ffesta_first_kw)
18940 {
18941 case FFESTR_firstALLOCATABLE:
18942 ffestc_R525_start ();
18943 break;
18944
18945 case FFESTR_firstPOINTER:
18946 ffestc_R526_start ();
18947 break;
18948
18949 case FFESTR_firstTARGET:
18950 ffestc_R527_start ();
18951 break;
18952
18953 default:
18954 assert (FALSE);
18955 }
18956 }
18957 ffestb_local_.dimlist.started = TRUE;
18958 next = (ffelexHandler) ffestb_dimlist1_ (nt);
18959 ffelex_token_kill (nt);
18960 return (ffelexHandler) (*next) (t);
18961
18962 case FFELEX_typeCOLONCOLON:
18963 ffesta_confirmed ();
18964 if (*p != '\0')
18965 goto bad_i; /* :::::::::::::::::::: */
18966 if (!ffesta_is_inhibited ())
18967 {
18968 switch (ffesta_first_kw)
18969 {
18970 case FFESTR_firstALLOCATABLE:
18971 ffestc_R525_start ();
18972 break;
18973
18974 case FFESTR_firstPOINTER:
18975 ffestc_R526_start ();
18976 break;
18977
18978 case FFESTR_firstTARGET:
18979 ffestc_R527_start ();
18980 break;
18981
18982 default:
18983 assert (FALSE);
18984 }
18985 }
18986 ffestb_local_.dimlist.started = TRUE;
18987 return (ffelexHandler) ffestb_dimlist1_;
18988
18989 case FFELEX_typeOPEN_PAREN:
18990 if (!ffesrc_is_name_init (*p))
18991 goto bad_i; /* :::::::::::::::::::: */
18992 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
18993 ffestb_local_.dimlist.started = FALSE;
18994 next = (ffelexHandler) ffestb_dimlist1_ (nt);
18995 ffelex_token_kill (nt);
18996 return (ffelexHandler) (*next) (t);
18997 }
18998
18999 default:
19000 goto bad_0; /* :::::::::::::::::::: */
19001 }
19002
19003 bad_0: /* :::::::::::::::::::: */
19004 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, ffesta_tokens[0]);
19005 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19006
19007 bad_1: /* :::::::::::::::::::: */
19008 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
19009 return (ffelexHandler) ffelex_swallow_tokens (t,
19010 (ffelexHandler) ffesta_zero); /* Invalid second token. */
19011
19012 bad_i: /* :::::::::::::::::::: */
19013 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, ffesta_tokens[0], i, t);
19014 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19015 }
19016
19017 /* ffestb_dimlist1_ -- "ALLOCATABLE/POINTER/TARGET" [COLONCOLON]
19018
19019 return ffestb_dimlist1_; // to lexer
19020
19021 Handle NAME. */
19022
19023 static ffelexHandler
19024 ffestb_dimlist1_ (ffelexToken t)
19025 {
19026 switch (ffelex_token_type (t))
19027 {
19028 case FFELEX_typeNAME:
19029 ffesta_tokens[1] = ffelex_token_use (t);
19030 return (ffelexHandler) ffestb_dimlist2_;
19031
19032 default:
19033 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
19034 break;
19035 }
19036
19037 if (!ffesta_is_inhibited ())
19038 {
19039 switch (ffesta_first_kw)
19040 {
19041 case FFESTR_firstALLOCATABLE:
19042 ffestc_R525_finish ();
19043 break;
19044
19045 case FFESTR_firstPOINTER:
19046 ffestc_R526_finish ();
19047 break;
19048
19049 case FFESTR_firstTARGET:
19050 ffestc_R527_finish ();
19051 break;
19052
19053 default:
19054 assert (FALSE);
19055 }
19056 }
19057 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19058 }
19059
19060 /* ffestb_dimlist2_ -- "ALLOCATABLE/POINTER/TARGET" ... NAME
19061
19062 return ffestb_dimlist2_; // to lexer
19063
19064 Handle OPEN_PAREN. */
19065
19066 static ffelexHandler
19067 ffestb_dimlist2_ (ffelexToken t)
19068 {
19069 switch (ffelex_token_type (t))
19070 {
19071 case FFELEX_typeOPEN_PAREN:
19072 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
19073 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_dimlist3_;
19074 ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
19075 ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLIST;
19076 #ifdef FFECOM_dimensionsMAX
19077 ffestb_subrargs_.dim_list.ndims = 0;
19078 #endif
19079 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
19080 FFEEXPR_contextDIMLIST, (ffeexprCallback) ffestb_subr_dimlist_);
19081
19082 case FFELEX_typeCOMMA:
19083 ffesta_confirmed ();
19084 if (!ffesta_is_inhibited ())
19085 {
19086 if (!ffestb_local_.dimlist.started)
19087 {
19088 switch (ffesta_first_kw)
19089 {
19090 case FFESTR_firstALLOCATABLE:
19091 ffestc_R525_start ();
19092 break;
19093
19094 case FFESTR_firstPOINTER:
19095 ffestc_R526_start ();
19096 break;
19097
19098 case FFESTR_firstTARGET:
19099 ffestc_R527_start ();
19100 break;
19101
19102 default:
19103 assert (FALSE);
19104 }
19105 ffestb_local_.dimlist.started = TRUE;
19106 }
19107 switch (ffesta_first_kw)
19108 {
19109 case FFESTR_firstALLOCATABLE:
19110 ffestc_R525_item (ffesta_tokens[1], NULL);
19111 break;
19112
19113 case FFESTR_firstPOINTER:
19114 ffestc_R526_item (ffesta_tokens[1], NULL);
19115 break;
19116
19117 case FFESTR_firstTARGET:
19118 ffestc_R527_item (ffesta_tokens[1], NULL);
19119 break;
19120
19121 default:
19122 assert (FALSE);
19123 }
19124 }
19125 ffelex_token_kill (ffesta_tokens[1]);
19126 return (ffelexHandler) ffestb_dimlist4_;
19127
19128 case FFELEX_typeEOS:
19129 case FFELEX_typeSEMICOLON:
19130 ffesta_confirmed ();
19131 if (!ffesta_is_inhibited ())
19132 {
19133 if (!ffestb_local_.dimlist.started)
19134 {
19135 switch (ffesta_first_kw)
19136 {
19137 case FFESTR_firstALLOCATABLE:
19138 ffestc_R525_start ();
19139 break;
19140
19141 case FFESTR_firstPOINTER:
19142 ffestc_R526_start ();
19143 break;
19144
19145 case FFESTR_firstTARGET:
19146 ffestc_R527_start ();
19147 break;
19148
19149 default:
19150 assert (FALSE);
19151 }
19152 }
19153 switch (ffesta_first_kw)
19154 {
19155 case FFESTR_firstALLOCATABLE:
19156 ffestc_R525_item (ffesta_tokens[1], NULL);
19157 ffestc_R525_finish ();
19158 break;
19159
19160 case FFESTR_firstPOINTER:
19161 ffestc_R526_item (ffesta_tokens[1], NULL);
19162 ffestc_R526_finish ();
19163 break;
19164
19165 case FFESTR_firstTARGET:
19166 ffestc_R527_item (ffesta_tokens[1], NULL);
19167 ffestc_R527_finish ();
19168 break;
19169
19170 default:
19171 assert (FALSE);
19172 }
19173 }
19174 ffelex_token_kill (ffesta_tokens[1]);
19175 return (ffelexHandler) ffesta_zero (t);
19176
19177 default:
19178 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
19179 break;
19180 }
19181
19182 if (!ffesta_is_inhibited ())
19183 {
19184 switch (ffesta_first_kw)
19185 {
19186 case FFESTR_firstALLOCATABLE:
19187 ffestc_R525_finish ();
19188 break;
19189
19190 case FFESTR_firstPOINTER:
19191 ffestc_R526_finish ();
19192 break;
19193
19194 case FFESTR_firstTARGET:
19195 ffestc_R527_finish ();
19196 break;
19197
19198 default:
19199 assert (FALSE);
19200 }
19201 }
19202 ffelex_token_kill (ffesta_tokens[1]);
19203 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19204 }
19205
19206 /* ffestb_dimlist3_ -- "ALLOCATABLE/POINTER/TARGET" ... NAME OPEN_PAREN
19207 dimlist CLOSE_PAREN
19208
19209 return ffestb_dimlist3_; // to lexer
19210
19211 Handle COMMA or EOS/SEMICOLON. */
19212
19213 static ffelexHandler
19214 ffestb_dimlist3_ (ffelexToken t)
19215 {
19216 if (!ffestb_subrargs_.dim_list.ok)
19217 goto bad; /* :::::::::::::::::::: */
19218
19219 switch (ffelex_token_type (t))
19220 {
19221 case FFELEX_typeCOMMA:
19222 ffesta_confirmed ();
19223 if (!ffesta_is_inhibited ())
19224 {
19225 if (!ffestb_local_.dimlist.started)
19226 {
19227 switch (ffesta_first_kw)
19228 {
19229 case FFESTR_firstALLOCATABLE:
19230 ffestc_R525_start ();
19231 break;
19232
19233 case FFESTR_firstPOINTER:
19234 ffestc_R526_start ();
19235 break;
19236
19237 case FFESTR_firstTARGET:
19238 ffestc_R527_start ();
19239 break;
19240
19241 default:
19242 assert (FALSE);
19243 }
19244 ffestb_local_.dimlist.started = TRUE;
19245 }
19246 switch (ffesta_first_kw)
19247 {
19248 case FFESTR_firstALLOCATABLE:
19249 ffestc_R525_item (ffesta_tokens[1],
19250 ffestb_subrargs_.dim_list.dims);
19251 break;
19252
19253 case FFESTR_firstPOINTER:
19254 ffestc_R526_item (ffesta_tokens[1],
19255 ffestb_subrargs_.dim_list.dims);
19256 break;
19257
19258 case FFESTR_firstTARGET:
19259 ffestc_R527_item (ffesta_tokens[1],
19260 ffestb_subrargs_.dim_list.dims);
19261 break;
19262
19263 default:
19264 assert (FALSE);
19265 }
19266 }
19267 ffelex_token_kill (ffesta_tokens[1]);
19268 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
19269 return (ffelexHandler) ffestb_dimlist4_;
19270
19271 case FFELEX_typeEOS:
19272 case FFELEX_typeSEMICOLON:
19273 ffesta_confirmed ();
19274 if (!ffesta_is_inhibited ())
19275 {
19276 if (!ffestb_local_.dimlist.started)
19277 {
19278 switch (ffesta_first_kw)
19279 {
19280 case FFESTR_firstALLOCATABLE:
19281 ffestc_R525_start ();
19282 break;
19283
19284 case FFESTR_firstPOINTER:
19285 ffestc_R526_start ();
19286 break;
19287
19288 case FFESTR_firstTARGET:
19289 ffestc_R527_start ();
19290 break;
19291
19292 default:
19293 assert (FALSE);
19294 }
19295 }
19296 switch (ffesta_first_kw)
19297 {
19298 case FFESTR_firstALLOCATABLE:
19299 ffestc_R525_item (ffesta_tokens[1],
19300 ffestb_subrargs_.dim_list.dims);
19301 ffestc_R525_finish ();
19302 break;
19303
19304 case FFESTR_firstPOINTER:
19305 ffestc_R526_item (ffesta_tokens[1],
19306 ffestb_subrargs_.dim_list.dims);
19307 ffestc_R526_finish ();
19308 break;
19309
19310 case FFESTR_firstTARGET:
19311 ffestc_R527_item (ffesta_tokens[1],
19312 ffestb_subrargs_.dim_list.dims);
19313 ffestc_R527_finish ();
19314 break;
19315
19316 default:
19317 assert (FALSE);
19318 }
19319 }
19320 ffelex_token_kill (ffesta_tokens[1]);
19321 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
19322 return (ffelexHandler) ffesta_zero (t);
19323
19324 default:
19325 break;
19326 }
19327
19328 bad: /* :::::::::::::::::::: */
19329 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
19330 if (ffestb_local_.dimlist.started && !ffesta_is_inhibited ())
19331 {
19332 switch (ffesta_first_kw)
19333 {
19334 case FFESTR_firstALLOCATABLE:
19335 ffestc_R525_finish ();
19336 break;
19337
19338 case FFESTR_firstPOINTER:
19339 ffestc_R526_finish ();
19340 break;
19341
19342 case FFESTR_firstTARGET:
19343 ffestc_R527_finish ();
19344 break;
19345
19346 default:
19347 assert (FALSE);
19348 }
19349 }
19350 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
19351 ffelex_token_kill (ffesta_tokens[1]);
19352 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19353 }
19354
19355 /* ffestb_dimlist4_ -- "ALLOCATABLE/POINTER/TARGET" ... COMMA
19356
19357 return ffestb_dimlist4_; // to lexer
19358
19359 Make sure we don't have EOS or SEMICOLON. */
19360
19361 static ffelexHandler
19362 ffestb_dimlist4_ (ffelexToken t)
19363 {
19364 switch (ffelex_token_type (t))
19365 {
19366 case FFELEX_typeEOS:
19367 case FFELEX_typeSEMICOLON:
19368 if (!ffesta_is_inhibited ())
19369 {
19370 switch (ffesta_first_kw)
19371 {
19372 case FFESTR_firstALLOCATABLE:
19373 ffestc_R525_finish ();
19374 break;
19375
19376 case FFESTR_firstPOINTER:
19377 ffestc_R526_finish ();
19378 break;
19379
19380 case FFESTR_firstTARGET:
19381 ffestc_R527_finish ();
19382 break;
19383
19384 default:
19385 assert (FALSE);
19386 }
19387 }
19388 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
19389 return (ffelexHandler) ffesta_zero (t);
19390
19391 default:
19392 return (ffelexHandler) ffestb_dimlist1_ (t);
19393 }
19394 }
19395
19396 #endif
19397 /* ffestb_dummy -- Parse an ENTRY/FUNCTION/SUBROUTINE statement
19398
19399 return ffestb_dummy; // to lexer
19400
19401 Make sure the statement has a valid form for an ENTRY/FUNCTION/SUBROUTINE
19402 statement. If it does, implement the statement. */
19403
19404 ffelexHandler
19405 ffestb_dummy (ffelexToken t)
19406 {
19407 ffeTokenLength i;
19408 unsigned const char *p;
19409
19410 switch (ffelex_token_type (ffesta_tokens[0]))
19411 {
19412 case FFELEX_typeNAME:
19413 switch (ffelex_token_type (t))
19414 {
19415 case FFELEX_typeEOS:
19416 case FFELEX_typeSEMICOLON:
19417 case FFELEX_typeCOMMA:
19418 case FFELEX_typeCOLONCOLON:
19419 ffesta_confirmed (); /* Error, but clearly intended. */
19420 goto bad_1; /* :::::::::::::::::::: */
19421
19422 default:
19423 goto bad_1; /* :::::::::::::::::::: */
19424
19425 case FFELEX_typeNAME:
19426 break;
19427 }
19428
19429 ffesta_confirmed ();
19430 ffesta_tokens[1] = ffelex_token_use (t);
19431 ffestb_local_.decl.recursive = NULL;
19432 ffestb_local_.dummy.badname = ffestb_args.dummy.badname;
19433 ffestb_local_.dummy.is_subr = ffestb_args.dummy.is_subr;
19434 ffestb_local_.dummy.first_kw = ffesta_first_kw;
19435 return (ffelexHandler) ffestb_dummy1_;
19436
19437 case FFELEX_typeNAMES:
19438 switch (ffelex_token_type (t))
19439 {
19440 case FFELEX_typeCOMMA:
19441 case FFELEX_typeCOLONCOLON:
19442 ffesta_confirmed (); /* Error, but clearly intended. */
19443 goto bad_1; /* :::::::::::::::::::: */
19444
19445 default:
19446 goto bad_1; /* :::::::::::::::::::: */
19447
19448 case FFELEX_typeEOS:
19449 case FFELEX_typeSEMICOLON:
19450 ffesta_confirmed ();
19451 break;
19452
19453 case FFELEX_typeOPEN_PAREN:
19454 break;
19455 }
19456 p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.dummy.len);
19457 if (!ffesrc_is_name_init (*p))
19458 goto bad_i; /* :::::::::::::::::::: */
19459 ffesta_tokens[1]
19460 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
19461 ffestb_local_.decl.recursive = NULL;
19462 ffestb_local_.dummy.badname = ffestb_args.dummy.badname;
19463 ffestb_local_.dummy.is_subr = ffestb_args.dummy.is_subr;
19464 ffestb_local_.dummy.first_kw = ffesta_first_kw;
19465 return (ffelexHandler) ffestb_dummy1_ (t);
19466
19467 default:
19468 goto bad_0; /* :::::::::::::::::::: */
19469 }
19470
19471 bad_0: /* :::::::::::::::::::: */
19472 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dummy.badname, ffesta_tokens[0]);
19473 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19474
19475 bad_1: /* :::::::::::::::::::: */
19476 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dummy.badname, t);
19477 return (ffelexHandler) ffelex_swallow_tokens (t,
19478 (ffelexHandler) ffesta_zero); /* Invalid second token. */
19479
19480 bad_i: /* :::::::::::::::::::: */
19481 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.dummy.badname, ffesta_tokens[0], i, t);
19482 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19483 }
19484
19485 /* ffestb_dummy1_ -- "ENTRY/FUNCTION/SUBROUTINE" NAME
19486
19487 return ffestb_dummy1_; // to lexer
19488
19489 Make sure the next token is an EOS, SEMICOLON, or OPEN_PAREN. In the
19490 former case, just implement a null arg list, else get the arg list and
19491 then implement. */
19492
19493 static ffelexHandler
19494 ffestb_dummy1_ (ffelexToken t)
19495 {
19496 switch (ffelex_token_type (t))
19497 {
19498 case FFELEX_typeEOS:
19499 case FFELEX_typeSEMICOLON:
19500 if (ffestb_local_.dummy.first_kw == FFESTR_firstFUNCTION)
19501 {
19502 ffesta_confirmed (); /* Later, not if typename w/o RECURSIVE. */
19503 break; /* Produce an error message, need that open
19504 paren. */
19505 }
19506 ffesta_confirmed ();
19507 if (!ffesta_is_inhibited ())
19508 { /* Pretend as though we got a truly NULL
19509 list. */
19510 ffestb_subrargs_.name_list.args = NULL;
19511 ffestb_subrargs_.name_list.ok = TRUE;
19512 ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
19513 return (ffelexHandler) ffestb_dummy2_ (t);
19514 }
19515 if (ffestb_local_.decl.recursive != NULL)
19516 ffelex_token_kill (ffestb_local_.decl.recursive);
19517 ffelex_token_kill (ffesta_tokens[1]);
19518 return (ffelexHandler) ffesta_zero (t);
19519
19520 case FFELEX_typeOPEN_PAREN:
19521 ffestb_subrargs_.name_list.args = ffestt_tokenlist_create ();
19522 ffestb_subrargs_.name_list.handler = (ffelexHandler) ffestb_dummy2_;
19523 ffestb_subrargs_.name_list.is_subr = ffestb_local_.dummy.is_subr;
19524 ffestb_subrargs_.name_list.names = FALSE;
19525 return (ffelexHandler) ffestb_subr_name_list_;
19526
19527 default:
19528 break;
19529 }
19530
19531 if (ffestb_local_.decl.recursive != NULL)
19532 ffelex_token_kill (ffestb_local_.decl.recursive);
19533 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_local_.dummy.badname, t);
19534 ffelex_token_kill (ffesta_tokens[1]);
19535 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19536 }
19537
19538 /* ffestb_dummy2_ -- <dummy-keyword> NAME OPEN_PAREN arg-list CLOSE_PAREN
19539
19540 return ffestb_dummy2_; // to lexer
19541
19542 Make sure the statement has a valid form for a dummy-def statement. If it
19543 does, implement the statement. */
19544
19545 static ffelexHandler
19546 ffestb_dummy2_ (ffelexToken t)
19547 {
19548 if (!ffestb_subrargs_.name_list.ok)
19549 goto bad; /* :::::::::::::::::::: */
19550
19551 switch (ffelex_token_type (t))
19552 {
19553 case FFELEX_typeEOS:
19554 case FFELEX_typeSEMICOLON:
19555 ffesta_confirmed ();
19556 if (!ffesta_is_inhibited ())
19557 {
19558 switch (ffestb_local_.dummy.first_kw)
19559 {
19560 case FFESTR_firstFUNCTION:
19561 ffestc_R1219 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
19562 ffestb_subrargs_.name_list.close_paren, FFESTP_typeNone,
19563 NULL, NULL, NULL, NULL, ffestb_local_.decl.recursive, NULL);
19564 break;
19565
19566 case FFESTR_firstSUBROUTINE:
19567 ffestc_R1223 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
19568 ffestb_subrargs_.name_list.close_paren,
19569 ffestb_local_.decl.recursive);
19570 break;
19571
19572 case FFESTR_firstENTRY:
19573 ffestc_R1226 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
19574 ffestb_subrargs_.name_list.close_paren);
19575 break;
19576
19577 default:
19578 assert (FALSE);
19579 }
19580 }
19581 ffelex_token_kill (ffesta_tokens[1]);
19582 if (ffestb_local_.decl.recursive != NULL)
19583 ffelex_token_kill (ffestb_local_.decl.recursive);
19584 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
19585 if (ffestb_subrargs_.name_list.args != NULL)
19586 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
19587 return (ffelexHandler) ffesta_zero (t);
19588
19589 case FFELEX_typeNAME:
19590 ffesta_confirmed ();
19591 if ((ffestb_local_.dummy.first_kw != FFESTR_firstFUNCTION)
19592 || (ffestr_other (t) != FFESTR_otherRESULT))
19593 break;
19594 ffestb_local_.decl.type = FFESTP_typeNone;
19595 ffestb_local_.decl.kind = NULL;
19596 ffestb_local_.decl.kindt = NULL;
19597 ffestb_local_.decl.len = NULL;
19598 ffestb_local_.decl.lent = NULL;
19599 return (ffelexHandler) ffestb_decl_funcname_6_;
19600
19601 default:
19602 break;
19603 }
19604
19605 bad: /* :::::::::::::::::::: */
19606 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_local_.dummy.badname, t);
19607 ffelex_token_kill (ffesta_tokens[1]);
19608 if (ffestb_local_.decl.recursive != NULL)
19609 ffelex_token_kill (ffestb_local_.decl.recursive);
19610 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
19611 if (ffestb_subrargs_.name_list.args != NULL)
19612 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
19613 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19614 }
19615
19616 /* ffestb_R524 -- Parse the DIMENSION statement
19617
19618 return ffestb_R524; // to lexer
19619
19620 Make sure the statement has a valid form for the DIMENSION statement. If
19621 it does, implement the statement. */
19622
19623 ffelexHandler
19624 ffestb_R524 (ffelexToken t)
19625 {
19626 ffeTokenLength i;
19627 unsigned const char *p;
19628 ffelexToken nt;
19629 ffelexHandler next;
19630
19631 switch (ffelex_token_type (ffesta_tokens[0]))
19632 {
19633 case FFELEX_typeNAME:
19634 switch (ffelex_token_type (t))
19635 {
19636 case FFELEX_typeCOMMA:
19637 case FFELEX_typeCOLONCOLON:
19638 case FFELEX_typeEOS:
19639 case FFELEX_typeSEMICOLON:
19640 ffesta_confirmed (); /* Error, but clearly intended. */
19641 goto bad_1; /* :::::::::::::::::::: */
19642
19643 default:
19644 goto bad_1; /* :::::::::::::::::::: */
19645
19646 case FFELEX_typeNAME:
19647 ffesta_confirmed ();
19648 if (!ffesta_is_inhibited ())
19649 ffestc_R524_start (ffesta_first_kw == FFESTR_firstVIRTUAL);
19650 ffestb_local_.dimension.started = TRUE;
19651 return (ffelexHandler) ffestb_R5241_ (t);
19652 }
19653
19654 case FFELEX_typeNAMES:
19655 p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.R524.len);
19656 switch (ffelex_token_type (t))
19657 {
19658 default:
19659 goto bad_1; /* :::::::::::::::::::: */
19660
19661 case FFELEX_typeEOS:
19662 case FFELEX_typeSEMICOLON:
19663 case FFELEX_typeCOMMA:
19664 case FFELEX_typeCOLONCOLON:
19665 ffesta_confirmed ();
19666 goto bad_1; /* :::::::::::::::::::: */
19667
19668 case FFELEX_typeOPEN_PAREN:
19669 break;
19670 }
19671
19672 /* Here, we have at least one char after "DIMENSION" and t is
19673 OPEN_PAREN. */
19674
19675 if (!ffesrc_is_name_init (*p))
19676 goto bad_i; /* :::::::::::::::::::: */
19677 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
19678 ffestb_local_.dimension.started = FALSE;
19679 next = (ffelexHandler) ffestb_R5241_ (nt);
19680 ffelex_token_kill (nt);
19681 return (ffelexHandler) (*next) (t);
19682
19683 default:
19684 goto bad_0; /* :::::::::::::::::::: */
19685 }
19686
19687 bad_0: /* :::::::::::::::::::: */
19688 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, ffesta_tokens[0]);
19689 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19690
19691 bad_1: /* :::::::::::::::::::: */
19692 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
19693 return (ffelexHandler) ffelex_swallow_tokens (t,
19694 (ffelexHandler) ffesta_zero); /* Invalid second token. */
19695
19696 bad_i: /* :::::::::::::::::::: */
19697 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, ffesta_tokens[0], i, t);
19698 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19699 }
19700
19701 /* ffestb_R5241_ -- "DIMENSION"
19702
19703 return ffestb_R5241_; // to lexer
19704
19705 Handle NAME. */
19706
19707 static ffelexHandler
19708 ffestb_R5241_ (ffelexToken t)
19709 {
19710 switch (ffelex_token_type (t))
19711 {
19712 case FFELEX_typeNAME:
19713 ffesta_tokens[1] = ffelex_token_use (t);
19714 return (ffelexHandler) ffestb_R5242_;
19715
19716 default:
19717 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
19718 break;
19719 }
19720
19721 if (!ffesta_is_inhibited ())
19722 ffestc_R524_finish ();
19723 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19724 }
19725
19726 /* ffestb_R5242_ -- "DIMENSION" ... NAME
19727
19728 return ffestb_R5242_; // to lexer
19729
19730 Handle OPEN_PAREN. */
19731
19732 static ffelexHandler
19733 ffestb_R5242_ (ffelexToken t)
19734 {
19735 switch (ffelex_token_type (t))
19736 {
19737 case FFELEX_typeOPEN_PAREN:
19738 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
19739 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_R5243_;
19740 ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
19741 ffestb_subrargs_.dim_list.ctx = ffesta_is_entry_valid
19742 ? FFEEXPR_contextDIMLIST : FFEEXPR_contextDIMLISTCOMMON;
19743 #ifdef FFECOM_dimensionsMAX
19744 ffestb_subrargs_.dim_list.ndims = 0;
19745 #endif
19746 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
19747 ffestb_subrargs_.dim_list.ctx,
19748 (ffeexprCallback) ffestb_subr_dimlist_);
19749
19750 default:
19751 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
19752 break;
19753 }
19754
19755 if (!ffesta_is_inhibited ())
19756 ffestc_R524_finish ();
19757 ffelex_token_kill (ffesta_tokens[1]);
19758 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19759 }
19760
19761 /* ffestb_R5243_ -- "DIMENSION" ... NAME OPEN_PAREN dimlist CLOSE_PAREN
19762
19763 return ffestb_R5243_; // to lexer
19764
19765 Handle COMMA or EOS/SEMICOLON. */
19766
19767 static ffelexHandler
19768 ffestb_R5243_ (ffelexToken t)
19769 {
19770 if (!ffestb_subrargs_.dim_list.ok)
19771 goto bad; /* :::::::::::::::::::: */
19772
19773 switch (ffelex_token_type (t))
19774 {
19775 case FFELEX_typeCOMMA:
19776 ffesta_confirmed ();
19777 if (!ffesta_is_inhibited ())
19778 {
19779 if (!ffestb_local_.dimension.started)
19780 {
19781 ffestc_R524_start (ffesta_first_kw == FFESTR_firstVIRTUAL);
19782 ffestb_local_.dimension.started = TRUE;
19783 }
19784 ffestc_R524_item (ffesta_tokens[1],
19785 ffestb_subrargs_.dim_list.dims);
19786 }
19787 ffelex_token_kill (ffesta_tokens[1]);
19788 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
19789 return (ffelexHandler) ffestb_R5244_;
19790
19791 case FFELEX_typeEOS:
19792 case FFELEX_typeSEMICOLON:
19793 ffesta_confirmed ();
19794 if (!ffesta_is_inhibited ())
19795 {
19796 if (!ffestb_local_.dimension.started)
19797 {
19798 ffestc_R524_start (ffesta_first_kw == FFESTR_firstVIRTUAL);
19799 ffestb_local_.dimension.started = TRUE;
19800 }
19801 ffestc_R524_item (ffesta_tokens[1],
19802 ffestb_subrargs_.dim_list.dims);
19803 ffestc_R524_finish ();
19804 }
19805 ffelex_token_kill (ffesta_tokens[1]);
19806 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
19807 return (ffelexHandler) ffesta_zero (t);
19808
19809 default:
19810 break;
19811 }
19812
19813 bad: /* :::::::::::::::::::: */
19814 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
19815 if (ffestb_local_.dimension.started && !ffesta_is_inhibited ())
19816 ffestc_R524_finish ();
19817 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
19818 ffelex_token_kill (ffesta_tokens[1]);
19819 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19820 }
19821
19822 /* ffestb_R5244_ -- "DIMENSION" ... COMMA
19823
19824 return ffestb_R5244_; // to lexer
19825
19826 Make sure we don't have EOS or SEMICOLON. */
19827
19828 static ffelexHandler
19829 ffestb_R5244_ (ffelexToken t)
19830 {
19831 switch (ffelex_token_type (t))
19832 {
19833 case FFELEX_typeEOS:
19834 case FFELEX_typeSEMICOLON:
19835 if (!ffesta_is_inhibited ())
19836 ffestc_R524_finish ();
19837 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
19838 return (ffelexHandler) ffesta_zero (t);
19839
19840 default:
19841 return (ffelexHandler) ffestb_R5241_ (t);
19842 }
19843 }
19844
19845 /* ffestb_R547 -- Parse the COMMON statement
19846
19847 return ffestb_R547; // to lexer
19848
19849 Make sure the statement has a valid form for the COMMON statement. If it
19850 does, implement the statement. */
19851
19852 ffelexHandler
19853 ffestb_R547 (ffelexToken t)
19854 {
19855 ffeTokenLength i;
19856 unsigned const char *p;
19857 ffelexToken nt;
19858 ffelexHandler next;
19859
19860 switch (ffelex_token_type (ffesta_tokens[0]))
19861 {
19862 case FFELEX_typeNAME:
19863 if (ffesta_first_kw != FFESTR_firstCOMMON)
19864 goto bad_0; /* :::::::::::::::::::: */
19865 switch (ffelex_token_type (t))
19866 {
19867 case FFELEX_typeCOMMA:
19868 case FFELEX_typeCOLONCOLON:
19869 case FFELEX_typeEOS:
19870 case FFELEX_typeSEMICOLON:
19871 ffesta_confirmed (); /* Error, but clearly intended. */
19872 goto bad_1; /* :::::::::::::::::::: */
19873
19874 default:
19875 goto bad_1; /* :::::::::::::::::::: */
19876
19877 case FFELEX_typeNAME:
19878 case FFELEX_typeSLASH:
19879 case FFELEX_typeCONCAT:
19880 ffesta_confirmed ();
19881 if (!ffesta_is_inhibited ())
19882 ffestc_R547_start ();
19883 ffestb_local_.common.started = TRUE;
19884 return (ffelexHandler) ffestb_R5471_ (t);
19885 }
19886
19887 case FFELEX_typeNAMES:
19888 if (ffesta_first_kw != FFESTR_firstCOMMON)
19889 goto bad_0; /* :::::::::::::::::::: */
19890 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCOMMON);
19891 switch (ffelex_token_type (t))
19892 {
19893 default:
19894 goto bad_1; /* :::::::::::::::::::: */
19895
19896 case FFELEX_typeEOS:
19897 case FFELEX_typeSEMICOLON:
19898 case FFELEX_typeCOMMA:
19899 case FFELEX_typeCOLONCOLON:
19900 ffesta_confirmed ();
19901 break;
19902
19903 case FFELEX_typeSLASH:
19904 case FFELEX_typeCONCAT:
19905 ffesta_confirmed ();
19906 if (*p != '\0')
19907 break;
19908 if (!ffesta_is_inhibited ())
19909 ffestc_R547_start ();
19910 ffestb_local_.common.started = TRUE;
19911 return (ffelexHandler) ffestb_R5471_ (t);
19912
19913 case FFELEX_typeOPEN_PAREN:
19914 break;
19915 }
19916
19917 /* Here, we have at least one char after "COMMON" and t is COMMA,
19918 EOS/SEMICOLON, OPEN_PAREN, SLASH, or CONCAT. */
19919
19920 if (!ffesrc_is_name_init (*p))
19921 goto bad_i; /* :::::::::::::::::::: */
19922 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
19923 if (ffelex_token_type (t) == FFELEX_typeOPEN_PAREN)
19924 ffestb_local_.common.started = FALSE;
19925 else
19926 {
19927 if (!ffesta_is_inhibited ())
19928 ffestc_R547_start ();
19929 ffestb_local_.common.started = TRUE;
19930 }
19931 next = (ffelexHandler) ffestb_R5471_ (nt);
19932 ffelex_token_kill (nt);
19933 return (ffelexHandler) (*next) (t);
19934
19935 default:
19936 goto bad_0; /* :::::::::::::::::::: */
19937 }
19938
19939 bad_0: /* :::::::::::::::::::: */
19940 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", ffesta_tokens[0]);
19941 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19942
19943 bad_1: /* :::::::::::::::::::: */
19944 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
19945 return (ffelexHandler) ffelex_swallow_tokens (t,
19946 (ffelexHandler) ffesta_zero); /* Invalid second token. */
19947
19948 bad_i: /* :::::::::::::::::::: */
19949 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "COMMON", ffesta_tokens[0], i, t);
19950 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19951 }
19952
19953 /* ffestb_R5471_ -- "COMMON"
19954
19955 return ffestb_R5471_; // to lexer
19956
19957 Handle NAME, SLASH, or CONCAT. */
19958
19959 static ffelexHandler
19960 ffestb_R5471_ (ffelexToken t)
19961 {
19962 switch (ffelex_token_type (t))
19963 {
19964 case FFELEX_typeNAME:
19965 return (ffelexHandler) ffestb_R5474_ (t);
19966
19967 case FFELEX_typeSLASH:
19968 return (ffelexHandler) ffestb_R5472_;
19969
19970 case FFELEX_typeCONCAT:
19971 if (!ffesta_is_inhibited ())
19972 ffestc_R547_item_cblock (NULL);
19973 return (ffelexHandler) ffestb_R5474_;
19974
19975 default:
19976 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
19977 break;
19978 }
19979
19980 if (!ffesta_is_inhibited ())
19981 ffestc_R547_finish ();
19982 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19983 }
19984
19985 /* ffestb_R5472_ -- "COMMON" SLASH
19986
19987 return ffestb_R5472_; // to lexer
19988
19989 Handle NAME. */
19990
19991 static ffelexHandler
19992 ffestb_R5472_ (ffelexToken t)
19993 {
19994 switch (ffelex_token_type (t))
19995 {
19996 case FFELEX_typeNAME:
19997 ffesta_tokens[1] = ffelex_token_use (t);
19998 return (ffelexHandler) ffestb_R5473_;
19999
20000 case FFELEX_typeSLASH:
20001 if (!ffesta_is_inhibited ())
20002 ffestc_R547_item_cblock (NULL);
20003 return (ffelexHandler) ffestb_R5474_;
20004
20005 default:
20006 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
20007 break;
20008 }
20009
20010 if (!ffesta_is_inhibited ())
20011 ffestc_R547_finish ();
20012 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20013 }
20014
20015 /* ffestb_R5473_ -- "COMMON" SLASH NAME
20016
20017 return ffestb_R5473_; // to lexer
20018
20019 Handle SLASH. */
20020
20021 static ffelexHandler
20022 ffestb_R5473_ (ffelexToken t)
20023 {
20024 switch (ffelex_token_type (t))
20025 {
20026 case FFELEX_typeSLASH:
20027 if (!ffesta_is_inhibited ())
20028 ffestc_R547_item_cblock (ffesta_tokens[1]);
20029 ffelex_token_kill (ffesta_tokens[1]);
20030 return (ffelexHandler) ffestb_R5474_;
20031
20032 default:
20033 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
20034 break;
20035 }
20036
20037 if (!ffesta_is_inhibited ())
20038 ffestc_R547_finish ();
20039 ffelex_token_kill (ffesta_tokens[1]);
20040 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20041 }
20042
20043 /* ffestb_R5474_ -- "COMMON" [SLASH NAME SLASH] or "COMMON" CONCAT
20044
20045 return ffestb_R5474_; // to lexer
20046
20047 Handle NAME. */
20048
20049 static ffelexHandler
20050 ffestb_R5474_ (ffelexToken t)
20051 {
20052 switch (ffelex_token_type (t))
20053 {
20054 case FFELEX_typeNAME:
20055 ffesta_tokens[1] = ffelex_token_use (t);
20056 return (ffelexHandler) ffestb_R5475_;
20057
20058 default:
20059 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
20060 break;
20061 }
20062
20063 if (!ffesta_is_inhibited ())
20064 ffestc_R547_finish ();
20065 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20066 }
20067
20068 /* ffestb_R5475_ -- "COMMON" ... NAME
20069
20070 return ffestb_R5475_; // to lexer
20071
20072 Handle OPEN_PAREN. */
20073
20074 static ffelexHandler
20075 ffestb_R5475_ (ffelexToken t)
20076 {
20077 switch (ffelex_token_type (t))
20078 {
20079 case FFELEX_typeOPEN_PAREN:
20080 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
20081 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_R5476_;
20082 ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
20083 ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLISTCOMMON;
20084 #ifdef FFECOM_dimensionsMAX
20085 ffestb_subrargs_.dim_list.ndims = 0;
20086 #endif
20087 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
20088 FFEEXPR_contextDIMLISTCOMMON, (ffeexprCallback) ffestb_subr_dimlist_);
20089
20090 case FFELEX_typeCOMMA:
20091 if (!ffesta_is_inhibited ())
20092 ffestc_R547_item_object (ffesta_tokens[1], NULL);
20093 ffelex_token_kill (ffesta_tokens[1]);
20094 return (ffelexHandler) ffestb_R5477_;
20095
20096 case FFELEX_typeSLASH:
20097 case FFELEX_typeCONCAT:
20098 if (!ffesta_is_inhibited ())
20099 ffestc_R547_item_object (ffesta_tokens[1], NULL);
20100 ffelex_token_kill (ffesta_tokens[1]);
20101 return (ffelexHandler) ffestb_R5471_ (t);
20102
20103 case FFELEX_typeEOS:
20104 case FFELEX_typeSEMICOLON:
20105 if (!ffesta_is_inhibited ())
20106 {
20107 ffestc_R547_item_object (ffesta_tokens[1], NULL);
20108 ffestc_R547_finish ();
20109 }
20110 ffelex_token_kill (ffesta_tokens[1]);
20111 return (ffelexHandler) ffesta_zero (t);
20112
20113 default:
20114 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
20115 break;
20116 }
20117
20118 if (!ffesta_is_inhibited ())
20119 ffestc_R547_finish ();
20120 ffelex_token_kill (ffesta_tokens[1]);
20121 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20122 }
20123
20124 /* ffestb_R5476_ -- "COMMON" ... NAME OPEN_PAREN dimlist CLOSE_PAREN
20125
20126 return ffestb_R5476_; // to lexer
20127
20128 Handle COMMA, SLASH, CONCAT, EOS/SEMICOLON. */
20129
20130 static ffelexHandler
20131 ffestb_R5476_ (ffelexToken t)
20132 {
20133 if (!ffestb_subrargs_.dim_list.ok)
20134 goto bad; /* :::::::::::::::::::: */
20135
20136 switch (ffelex_token_type (t))
20137 {
20138 case FFELEX_typeCOMMA:
20139 ffesta_confirmed ();
20140 if (!ffesta_is_inhibited ())
20141 {
20142 if (!ffestb_local_.common.started)
20143 {
20144 ffestc_R547_start ();
20145 ffestb_local_.common.started = TRUE;
20146 }
20147 ffestc_R547_item_object (ffesta_tokens[1],
20148 ffestb_subrargs_.dim_list.dims);
20149 }
20150 ffelex_token_kill (ffesta_tokens[1]);
20151 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
20152 return (ffelexHandler) ffestb_R5477_;
20153
20154 case FFELEX_typeSLASH:
20155 case FFELEX_typeCONCAT:
20156 ffesta_confirmed ();
20157 if (!ffesta_is_inhibited ())
20158 {
20159 if (!ffestb_local_.common.started)
20160 {
20161 ffestc_R547_start ();
20162 ffestb_local_.common.started = TRUE;
20163 }
20164 ffestc_R547_item_object (ffesta_tokens[1],
20165 ffestb_subrargs_.dim_list.dims);
20166 }
20167 ffelex_token_kill (ffesta_tokens[1]);
20168 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
20169 return (ffelexHandler) ffestb_R5471_ (t);
20170
20171 case FFELEX_typeEOS:
20172 case FFELEX_typeSEMICOLON:
20173 ffesta_confirmed ();
20174 if (!ffesta_is_inhibited ())
20175 {
20176 if (!ffestb_local_.common.started)
20177 ffestc_R547_start ();
20178 ffestc_R547_item_object (ffesta_tokens[1],
20179 ffestb_subrargs_.dim_list.dims);
20180 ffestc_R547_finish ();
20181 }
20182 ffelex_token_kill (ffesta_tokens[1]);
20183 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
20184 return (ffelexHandler) ffesta_zero (t);
20185
20186 default:
20187 break;
20188 }
20189
20190 bad: /* :::::::::::::::::::: */
20191 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
20192 if (ffestb_local_.common.started && !ffesta_is_inhibited ())
20193 ffestc_R547_finish ();
20194 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
20195 ffelex_token_kill (ffesta_tokens[1]);
20196 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20197 }
20198
20199 /* ffestb_R5477_ -- "COMMON" ... COMMA
20200
20201 return ffestb_R5477_; // to lexer
20202
20203 Make sure we don't have EOS or SEMICOLON. */
20204
20205 static ffelexHandler
20206 ffestb_R5477_ (ffelexToken t)
20207 {
20208 switch (ffelex_token_type (t))
20209 {
20210 case FFELEX_typeEOS:
20211 case FFELEX_typeSEMICOLON:
20212 if (!ffesta_is_inhibited ())
20213 ffestc_R547_finish ();
20214 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
20215 return (ffelexHandler) ffesta_zero (t);
20216
20217 default:
20218 return (ffelexHandler) ffestb_R5471_ (t);
20219 }
20220 }
20221
20222 /* ffestb_R624 -- Parse a NULLIFY statement
20223
20224 return ffestb_R624; // to lexer
20225
20226 Make sure the statement has a valid form for a NULLIFY
20227 statement. If it does, implement the statement.
20228
20229 31-May-90 JCB 2.0
20230 Rewrite to produce a list of expressions rather than just names; this
20231 eases semantic checking, putting it in expression handling where that
20232 kind of thing gets done anyway, and makes it easier to support more
20233 flexible extensions to Fortran 90 like NULLIFY(FOO%BAR). */
20234
20235 #if FFESTR_F90
20236 ffelexHandler
20237 ffestb_R624 (ffelexToken t)
20238 {
20239 switch (ffelex_token_type (ffesta_tokens[0]))
20240 {
20241 case FFELEX_typeNAME:
20242 if (ffesta_first_kw != FFESTR_firstNULLIFY)
20243 goto bad_0; /* :::::::::::::::::::: */
20244 break;
20245
20246 case FFELEX_typeNAMES:
20247 if (ffesta_first_kw != FFESTR_firstNULLIFY)
20248 goto bad_0; /* :::::::::::::::::::: */
20249 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlNULLIFY)
20250 goto bad_0; /* :::::::::::::::::::: */
20251 break;
20252
20253 default:
20254 goto bad_0; /* :::::::::::::::::::: */
20255 }
20256
20257 switch (ffelex_token_type (t))
20258 {
20259 case FFELEX_typeOPEN_PAREN:
20260 break;
20261
20262 case FFELEX_typeEOS:
20263 case FFELEX_typeSEMICOLON:
20264 case FFELEX_typeCOMMA:
20265 case FFELEX_typeCOLONCOLON:
20266 case FFELEX_typeNAME:
20267 ffesta_confirmed (); /* Error, but clearly intended. */
20268 goto bad_1; /* :::::::::::::::::::: */
20269
20270 default:
20271 goto bad_1; /* :::::::::::::::::::: */
20272 }
20273
20274 ffestb_local_.R624.exprs = ffestt_exprlist_create ();
20275 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
20276 FFEEXPR_contextNULLIFY,
20277 (ffeexprCallback) ffestb_R6241_);
20278
20279 bad_0: /* :::::::::::::::::::: */
20280 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", ffesta_tokens[0]);
20281 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20282
20283 bad_1: /* :::::::::::::::::::: */
20284 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", t);
20285 return (ffelexHandler) ffelex_swallow_tokens (t,
20286 (ffelexHandler) ffesta_zero); /* Invalid second token. */
20287 }
20288
20289 /* ffestb_R6241_ -- "NULLIFY" OPEN_PAREN expr
20290
20291 return ffestb_R6241_; // to lexer
20292
20293 Make sure the statement has a valid form for a NULLIFY statement. If it
20294 does, implement the statement.
20295
20296 31-May-90 JCB 2.0
20297 Rewrite to produce a list of expressions rather than just names; this
20298 eases semantic checking, putting it in expression handling where that
20299 kind of thing gets done anyway, and makes it easier to support more
20300 flexible extensions to Fortran 90 like NULLIFY(FOO%BAR). */
20301
20302 static ffelexHandler
20303 ffestb_R6241_ (ffelexToken ft, ffebld expr, ffelexToken t)
20304 {
20305 switch (ffelex_token_type (t))
20306 {
20307 case FFELEX_typeCLOSE_PAREN:
20308 if (expr == NULL)
20309 break;
20310 ffestt_exprlist_append (ffestb_local_.R624.exprs, expr,
20311 ffelex_token_use (t));
20312 return (ffelexHandler) ffestb_R6242_;
20313
20314 case FFELEX_typeCOMMA:
20315 if (expr == NULL)
20316 break;
20317 ffestt_exprlist_append (ffestb_local_.R624.exprs, expr,
20318 ffelex_token_use (t));
20319 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
20320 FFEEXPR_contextNULLIFY,
20321 (ffeexprCallback) ffestb_R6241_);
20322
20323 default:
20324 break;
20325 }
20326
20327 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", t);
20328 ffestt_exprlist_kill (ffestb_local_.R624.exprs);
20329 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20330 }
20331
20332 /* ffestb_R6242_ -- "NULLIFY" OPEN_PAREN expr-list CLOSE_PAREN
20333
20334 return ffestb_R6242_; // to lexer
20335
20336 Make sure the statement has a valid form for a NULLIFY statement. If it
20337 does, implement the statement. */
20338
20339 static ffelexHandler
20340 ffestb_R6242_ (ffelexToken t)
20341 {
20342 switch (ffelex_token_type (t))
20343 {
20344 case FFELEX_typeEOS:
20345 case FFELEX_typeSEMICOLON:
20346 ffesta_confirmed ();
20347 if (!ffesta_is_inhibited ())
20348 ffestc_R624 (ffestb_local_.R624.exprs);
20349 ffestt_exprlist_kill (ffestb_local_.R624.exprs);
20350 return (ffelexHandler) ffesta_zero (t);
20351
20352 default:
20353 break;
20354 }
20355
20356 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", t);
20357 ffestt_exprlist_kill (ffestb_local_.R624.exprs);
20358 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20359 }
20360
20361 #endif
20362 /* ffestb_R1229 -- Parse a STMTFUNCTION statement
20363
20364 return ffestb_R1229; // to lexer
20365
20366 Make sure the statement has a valid form for a STMTFUNCTION
20367 statement. If it does, implement the statement. */
20368
20369 ffelexHandler
20370 ffestb_R1229 (ffelexToken t)
20371 {
20372 switch (ffelex_token_type (ffesta_tokens[0]))
20373 {
20374 case FFELEX_typeNAME:
20375 case FFELEX_typeNAMES:
20376 break;
20377
20378 default:
20379 goto bad_0; /* :::::::::::::::::::: */
20380 }
20381
20382 switch (ffelex_token_type (t))
20383 {
20384 case FFELEX_typeOPEN_PAREN:
20385 break;
20386
20387 case FFELEX_typeEOS:
20388 case FFELEX_typeSEMICOLON:
20389 case FFELEX_typeCOMMA:
20390 case FFELEX_typeCOLONCOLON:
20391 case FFELEX_typeNAME:
20392 ffesta_confirmed (); /* Error, but clearly intended. */
20393 goto bad_1; /* :::::::::::::::::::: */
20394
20395 default:
20396 goto bad_1; /* :::::::::::::::::::: */
20397 }
20398
20399 ffestb_subrargs_.name_list.args = ffestt_tokenlist_create ();
20400 ffestb_subrargs_.name_list.handler = (ffelexHandler) ffestb_R12291_;
20401 ffestb_subrargs_.name_list.is_subr = FALSE; /* No "*" items in list! */
20402 ffestb_subrargs_.name_list.names = TRUE; /* In case "IF(FOO)CALL
20403 FOO...". */
20404 return (ffelexHandler) ffestb_subr_name_list_;
20405
20406 bad_0: /* :::::::::::::::::::: */
20407 bad_1: /* :::::::::::::::::::: */
20408 ffesta_ffebad_2t (FFEBAD_UNREC_STMT, ffesta_tokens[0], t);
20409 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20410 }
20411
20412 /* ffestb_R12291_ -- "STMTFUNCTION" OPEN_PAREN dummy-name-list CLOSE_PAREN
20413
20414 return ffestb_R12291_; // to lexer
20415
20416 Make sure the statement has a valid form for a STMTFUNCTION statement. If
20417 it does, implement the statement. */
20418
20419 static ffelexHandler
20420 ffestb_R12291_ (ffelexToken t)
20421 {
20422 ffelex_set_names (FALSE);
20423
20424 if (!ffestb_subrargs_.name_list.ok)
20425 goto bad; /* :::::::::::::::::::: */
20426
20427 switch (ffelex_token_type (t))
20428 {
20429 case FFELEX_typeEQUALS:
20430 ffesta_confirmed ();
20431 if (!ffesta_is_inhibited ())
20432 ffestc_R1229_start (ffesta_tokens[0],
20433 ffestb_subrargs_.name_list.args,
20434 ffestb_subrargs_.name_list.close_paren);
20435 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
20436 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
20437 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
20438 FFEEXPR_contextSFUNCDEF, (ffeexprCallback) ffestb_R12292_);
20439
20440 default:
20441 break;
20442 }
20443
20444 bad: /* :::::::::::::::::::: */
20445 ffesta_ffebad_2t (FFEBAD_UNREC_STMT, ffesta_tokens[0], t);
20446 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
20447 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
20448 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20449 }
20450
20451 /* ffestb_R12292_ -- "STMTFUNCTION" OPEN_PAREN dummy-name-list CLOSE_PAREN
20452 EQUALS expr
20453
20454 (ffestb_R12292_) // to expression handler
20455
20456 Make sure the statement has a valid form for a STMTFUNCTION statement. If
20457 it does, implement the statement. */
20458
20459 static ffelexHandler
20460 ffestb_R12292_ (ffelexToken ft, ffebld expr, ffelexToken t)
20461 {
20462 if (expr == NULL)
20463 goto bad; /* :::::::::::::::::::: */
20464
20465 switch (ffelex_token_type (t))
20466 {
20467 case FFELEX_typeEOS:
20468 case FFELEX_typeSEMICOLON:
20469 if (!ffesta_is_inhibited ())
20470 ffestc_R1229_finish (expr, ft);
20471 return (ffelexHandler) ffesta_zero (t);
20472
20473 default:
20474 break;
20475 }
20476
20477 bad: /* :::::::::::::::::::: */
20478 ffestc_R1229_finish (NULL, NULL);
20479 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "statement-function-definition", t);
20480 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20481 }
20482
20483 /* ffestb_decl_chartype -- Parse the CHARACTER statement
20484
20485 return ffestb_decl_chartype; // to lexer
20486
20487 Make sure the statement has a valid form for the CHARACTER statement. If
20488 it does, implement the statement. */
20489
20490 ffelexHandler
20491 ffestb_decl_chartype (ffelexToken t)
20492 {
20493 ffeTokenLength i;
20494 unsigned const char *p;
20495
20496 ffestb_local_.decl.type = FFESTP_typeCHARACTER;
20497 ffestb_local_.decl.recursive = NULL;
20498 ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
20499 ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
20500
20501 switch (ffelex_token_type (ffesta_tokens[0]))
20502 {
20503 case FFELEX_typeNAME:
20504 if (ffesta_first_kw != FFESTR_firstCHRCTR)
20505 goto bad_0; /* :::::::::::::::::::: */
20506 switch (ffelex_token_type (t))
20507 {
20508 case FFELEX_typeEOS:
20509 case FFELEX_typeSEMICOLON:
20510 ffesta_confirmed (); /* Error, but clearly intended. */
20511 goto bad_1; /* :::::::::::::::::::: */
20512
20513 default:
20514 goto bad_1; /* :::::::::::::::::::: */
20515
20516 case FFELEX_typeCOMMA:
20517 ffesta_confirmed ();
20518 if (!ffesta_is_inhibited ())
20519 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20520 NULL, NULL, NULL, NULL);
20521 return (ffelexHandler) ffestb_decl_attrs_;
20522
20523 case FFELEX_typeCOLONCOLON:
20524 ffestb_local_.decl.coloncolon = TRUE;
20525 ffesta_confirmed ();
20526 if (!ffesta_is_inhibited ())
20527 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20528 NULL, NULL, NULL, NULL);
20529 return (ffelexHandler) ffestb_decl_ents_;
20530
20531 case FFELEX_typeASTERISK:
20532 ffesta_confirmed ();
20533 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_chartype1_;
20534 ffestb_local_.decl.badname = "TYPEDECL";
20535 return (ffelexHandler) ffestb_decl_starlen_;
20536
20537 case FFELEX_typeOPEN_PAREN:
20538 ffestb_local_.decl.kind = NULL;
20539 ffestb_local_.decl.kindt = NULL;
20540 ffestb_local_.decl.len = NULL;
20541 ffestb_local_.decl.lent = NULL;
20542 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
20543 ffestb_local_.decl.badname = "_TYPEDECL";
20544 return (ffelexHandler) ffestb_decl_typeparams_;
20545
20546 case FFELEX_typeNAME:
20547 ffesta_confirmed ();
20548 ffestb_local_.decl.kind = NULL;
20549 ffestb_local_.decl.kindt = NULL;
20550 ffestb_local_.decl.len = NULL;
20551 ffestb_local_.decl.lent = NULL;
20552 return (ffelexHandler) ffestb_decl_entsp_ (t);
20553 }
20554
20555 case FFELEX_typeNAMES:
20556 if (ffesta_first_kw != FFESTR_firstCHRCTR)
20557 goto bad_0; /* :::::::::::::::::::: */
20558 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCHRCTR);
20559 switch (ffelex_token_type (t))
20560 {
20561 default:
20562 goto bad_1; /* :::::::::::::::::::: */
20563
20564 case FFELEX_typeEOS:
20565 case FFELEX_typeSEMICOLON:
20566 ffesta_confirmed ();
20567 break;
20568
20569 case FFELEX_typeCOMMA:
20570 ffesta_confirmed ();
20571 if (*p != '\0')
20572 break;
20573 if (!ffesta_is_inhibited ())
20574 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20575 NULL, NULL, NULL, NULL);
20576 return (ffelexHandler) ffestb_decl_attrs_;
20577
20578 case FFELEX_typeCOLONCOLON:
20579 ffestb_local_.decl.coloncolon = TRUE;
20580 ffesta_confirmed ();
20581 if (*p != '\0')
20582 goto bad_i; /* :::::::::::::::::::: */
20583 if (!ffesta_is_inhibited ())
20584 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20585 NULL, NULL, NULL, NULL);
20586 return (ffelexHandler) ffestb_decl_ents_;
20587
20588 case FFELEX_typeASTERISK:
20589 ffesta_confirmed ();
20590 if (*p != '\0')
20591 break;
20592 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_chartype1_;
20593 ffestb_local_.decl.badname = "TYPEDECL";
20594 return (ffelexHandler) ffestb_decl_starlen_;
20595
20596 case FFELEX_typeSLASH:
20597 ffesta_confirmed ();
20598 if (*p != '\0')
20599 break;
20600 goto bad_1; /* :::::::::::::::::::: */
20601
20602 case FFELEX_typeOPEN_PAREN:
20603 if (*p != '\0')
20604 break;
20605 ffestb_local_.decl.kind = NULL;
20606 ffestb_local_.decl.kindt = NULL;
20607 ffestb_local_.decl.len = NULL;
20608 ffestb_local_.decl.lent = NULL;
20609 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
20610 ffestb_local_.decl.badname = "TYPEDECL";
20611 return (ffelexHandler) ffestb_decl_typeparams_;
20612 }
20613 if (!ffesrc_is_name_init (*p))
20614 goto bad_i; /* :::::::::::::::::::: */
20615 ffestb_local_.decl.kind = NULL;
20616 ffestb_local_.decl.kindt = NULL;
20617 ffestb_local_.decl.len = NULL;
20618 ffestb_local_.decl.lent = NULL;
20619 ffesta_tokens[1] = ffelex_token_names_from_names (ffesta_tokens[0], i, 0);
20620 return (ffelexHandler) ffestb_decl_entsp_2_ (t);
20621
20622 default:
20623 goto bad_0; /* :::::::::::::::::::: */
20624 }
20625
20626 bad_0: /* :::::::::::::::::::: */
20627 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
20628 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20629
20630 bad_1: /* :::::::::::::::::::: */
20631 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
20632 return (ffelexHandler) ffelex_swallow_tokens (t,
20633 (ffelexHandler) ffesta_zero); /* Invalid second token. */
20634
20635 bad_i: /* :::::::::::::::::::: */
20636 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0], i, t);
20637 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20638 }
20639
20640 /* ffestb_decl_chartype1_ -- "CHARACTER" ASTERISK char-length
20641
20642 return ffestb_decl_chartype1_; // to lexer
20643
20644 Handle COMMA, COLONCOLON, or anything else. */
20645
20646 static ffelexHandler
20647 ffestb_decl_chartype1_ (ffelexToken t)
20648 {
20649 ffelex_set_names (FALSE);
20650
20651 switch (ffelex_token_type (t))
20652 {
20653 case FFELEX_typeCOLONCOLON:
20654 ffestb_local_.decl.coloncolon = TRUE;
20655 /* Fall through. */
20656 case FFELEX_typeCOMMA:
20657 ffesta_confirmed ();
20658 if (!ffesta_is_inhibited ())
20659 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20660 NULL, NULL, ffestb_local_.decl.len, ffestb_local_.decl.lent);
20661 if (ffestb_local_.decl.lent != NULL)
20662 ffelex_token_kill (ffestb_local_.decl.lent);
20663 return (ffelexHandler) ffestb_decl_ents_;
20664
20665 default:
20666 return (ffelexHandler) ffestb_decl_entsp_ (t);
20667 }
20668 }
20669
20670 /* ffestb_decl_dbltype -- Parse the DOUBLEPRECISION/DOUBLECOMPLEX statement
20671
20672 return ffestb_decl_dbltype; // to lexer
20673
20674 Make sure the statement has a valid form for the DOUBLEPRECISION/
20675 DOUBLECOMPLEX statement. If it does, implement the statement. */
20676
20677 ffelexHandler
20678 ffestb_decl_dbltype (ffelexToken t)
20679 {
20680 ffeTokenLength i;
20681 unsigned const char *p;
20682
20683 ffestb_local_.decl.type = ffestb_args.decl.type;
20684 ffestb_local_.decl.recursive = NULL;
20685 ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
20686 ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
20687
20688 switch (ffelex_token_type (ffesta_tokens[0]))
20689 {
20690 case FFELEX_typeNAME:
20691 switch (ffelex_token_type (t))
20692 {
20693 case FFELEX_typeEOS:
20694 case FFELEX_typeSEMICOLON:
20695 ffesta_confirmed (); /* Error, but clearly intended. */
20696 goto bad_1; /* :::::::::::::::::::: */
20697
20698 default:
20699 goto bad_1; /* :::::::::::::::::::: */
20700
20701 case FFELEX_typeCOMMA:
20702 ffesta_confirmed ();
20703 if (!ffesta_is_inhibited ())
20704 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20705 NULL, NULL, NULL, NULL);
20706 return (ffelexHandler) ffestb_decl_attrs_;
20707
20708 case FFELEX_typeCOLONCOLON:
20709 ffestb_local_.decl.coloncolon = TRUE;
20710 ffesta_confirmed ();
20711 if (!ffesta_is_inhibited ())
20712 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20713 NULL, NULL, NULL, NULL);
20714 return (ffelexHandler) ffestb_decl_ents_;
20715
20716 case FFELEX_typeNAME:
20717 ffesta_confirmed ();
20718 ffestb_local_.decl.kind = NULL;
20719 ffestb_local_.decl.kindt = NULL;
20720 ffestb_local_.decl.len = NULL;
20721 ffestb_local_.decl.lent = NULL;
20722 return (ffelexHandler) ffestb_decl_entsp_ (t);
20723 }
20724
20725 case FFELEX_typeNAMES:
20726 p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.decl.len);
20727 switch (ffelex_token_type (t))
20728 {
20729 default:
20730 goto bad_1; /* :::::::::::::::::::: */
20731
20732 case FFELEX_typeEOS:
20733 case FFELEX_typeSEMICOLON:
20734 ffesta_confirmed ();
20735 break;
20736
20737 case FFELEX_typeCOMMA:
20738 ffesta_confirmed ();
20739 if (*p != '\0')
20740 break;
20741 if (!ffesta_is_inhibited ())
20742 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20743 NULL, NULL, NULL, NULL);
20744 return (ffelexHandler) ffestb_decl_attrs_;
20745
20746 case FFELEX_typeCOLONCOLON:
20747 ffestb_local_.decl.coloncolon = TRUE;
20748 ffesta_confirmed ();
20749 if (*p != '\0')
20750 goto bad_i; /* :::::::::::::::::::: */
20751 if (!ffesta_is_inhibited ())
20752 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20753 NULL, NULL, NULL, NULL);
20754 return (ffelexHandler) ffestb_decl_ents_;
20755
20756 case FFELEX_typeSLASH:
20757 ffesta_confirmed ();
20758 if (*p != '\0')
20759 break;
20760 goto bad_1; /* :::::::::::::::::::: */
20761
20762 case FFELEX_typeOPEN_PAREN:
20763 if (*p != '\0')
20764 break;
20765 goto bad_1; /* :::::::::::::::::::: */
20766 }
20767 if (!ffesrc_is_name_init (*p))
20768 goto bad_i; /* :::::::::::::::::::: */
20769 ffestb_local_.decl.kind = NULL;
20770 ffestb_local_.decl.kindt = NULL;
20771 ffestb_local_.decl.len = NULL;
20772 ffestb_local_.decl.lent = NULL;
20773 ffesta_tokens[1] = ffelex_token_names_from_names (ffesta_tokens[0], i, 0);
20774 return (ffelexHandler) ffestb_decl_entsp_2_ (t);
20775
20776 default:
20777 goto bad_0; /* :::::::::::::::::::: */
20778 }
20779
20780 bad_0: /* :::::::::::::::::::: */
20781 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
20782 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20783
20784 bad_1: /* :::::::::::::::::::: */
20785 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
20786 return (ffelexHandler) ffelex_swallow_tokens (t,
20787 (ffelexHandler) ffesta_zero); /* Invalid second token. */
20788
20789 bad_i: /* :::::::::::::::::::: */
20790 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0], i, t);
20791 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20792 }
20793
20794 /* ffestb_decl_double -- Parse the DOUBLE PRECISION/DOUBLE COMPLEX statement
20795
20796 return ffestb_decl_double; // to lexer
20797
20798 Make sure the statement has a valid form for the DOUBLE PRECISION/
20799 DOUBLE COMPLEX statement. If it does, implement the statement. */
20800
20801 ffelexHandler
20802 ffestb_decl_double (ffelexToken t)
20803 {
20804 ffestb_local_.decl.recursive = NULL;
20805 ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
20806 ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
20807
20808 switch (ffelex_token_type (ffesta_tokens[0]))
20809 {
20810 case FFELEX_typeNAME:
20811 if (ffesta_first_kw != FFESTR_firstDBL)
20812 goto bad_0; /* :::::::::::::::::::: */
20813 switch (ffelex_token_type (t))
20814 {
20815 case FFELEX_typeEOS:
20816 case FFELEX_typeSEMICOLON:
20817 case FFELEX_typeCOMMA:
20818 case FFELEX_typeCOLONCOLON:
20819 ffesta_confirmed (); /* Error, but clearly intended. */
20820 goto bad_1; /* :::::::::::::::::::: */
20821
20822 default:
20823 goto bad_1; /* :::::::::::::::::::: */
20824
20825 case FFELEX_typeNAME:
20826 ffesta_confirmed ();
20827 switch (ffestr_second (t))
20828 {
20829 case FFESTR_secondCOMPLEX:
20830 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
20831 break;
20832
20833 case FFESTR_secondPRECISION:
20834 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
20835 break;
20836
20837 default:
20838 goto bad_1; /* :::::::::::::::::::: */
20839 }
20840 ffestb_local_.decl.kind = NULL;
20841 ffestb_local_.decl.kindt = NULL;
20842 ffestb_local_.decl.len = NULL;
20843 ffestb_local_.decl.lent = NULL;
20844 return (ffelexHandler) ffestb_decl_attrsp_;
20845 }
20846
20847 default:
20848 goto bad_0; /* :::::::::::::::::::: */
20849 }
20850
20851 bad_0: /* :::::::::::::::::::: */
20852 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
20853 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20854
20855 bad_1: /* :::::::::::::::::::: */
20856 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
20857 return (ffelexHandler) ffelex_swallow_tokens (t,
20858 (ffelexHandler) ffesta_zero); /* Invalid second token. */
20859 }
20860
20861 /* ffestb_decl_gentype -- Parse the INTEGER/REAL/COMPLEX/LOGICAL statement
20862
20863 return ffestb_decl_gentype; // to lexer
20864
20865 Make sure the statement has a valid form for the INTEGER/REAL/COMPLEX/
20866 LOGICAL statement. If it does, implement the statement. */
20867
20868 ffelexHandler
20869 ffestb_decl_gentype (ffelexToken t)
20870 {
20871 ffeTokenLength i;
20872 unsigned const char *p;
20873
20874 ffestb_local_.decl.type = ffestb_args.decl.type;
20875 ffestb_local_.decl.recursive = NULL;
20876 ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
20877 ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
20878
20879 switch (ffelex_token_type (ffesta_tokens[0]))
20880 {
20881 case FFELEX_typeNAME:
20882 switch (ffelex_token_type (t))
20883 {
20884 case FFELEX_typeEOS:
20885 case FFELEX_typeSEMICOLON:
20886 ffesta_confirmed (); /* Error, but clearly intended. */
20887 goto bad_1; /* :::::::::::::::::::: */
20888
20889 default:
20890 goto bad_1; /* :::::::::::::::::::: */
20891
20892 case FFELEX_typeCOMMA:
20893 ffesta_confirmed ();
20894 if (!ffesta_is_inhibited ())
20895 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20896 NULL, NULL, NULL, NULL);
20897 return (ffelexHandler) ffestb_decl_attrs_;
20898
20899 case FFELEX_typeCOLONCOLON:
20900 ffestb_local_.decl.coloncolon = TRUE;
20901 ffesta_confirmed ();
20902 if (!ffesta_is_inhibited ())
20903 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20904 NULL, NULL, NULL, NULL);
20905 return (ffelexHandler) ffestb_decl_ents_;
20906
20907 case FFELEX_typeASTERISK:
20908 ffesta_confirmed ();
20909 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
20910 ffestb_local_.decl.badname = "TYPEDECL";
20911 return (ffelexHandler) ffestb_decl_starkind_;
20912
20913 case FFELEX_typeOPEN_PAREN:
20914 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
20915 ffestb_local_.decl.badname = "TYPEDECL";
20916 return (ffelexHandler) ffestb_decl_kindparam_;
20917
20918 case FFELEX_typeNAME:
20919 ffesta_confirmed ();
20920 ffestb_local_.decl.kind = NULL;
20921 ffestb_local_.decl.kindt = NULL;
20922 ffestb_local_.decl.len = NULL;
20923 ffestb_local_.decl.lent = NULL;
20924 return (ffelexHandler) ffestb_decl_entsp_ (t);
20925 }
20926
20927 case FFELEX_typeNAMES:
20928 p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.decl.len);
20929 switch (ffelex_token_type (t))
20930 {
20931 default:
20932 goto bad_1; /* :::::::::::::::::::: */
20933
20934 case FFELEX_typeEOS:
20935 case FFELEX_typeSEMICOLON:
20936 ffesta_confirmed ();
20937 break;
20938
20939 case FFELEX_typeCOMMA:
20940 ffesta_confirmed ();
20941 if (*p != '\0')
20942 break;
20943 if (!ffesta_is_inhibited ())
20944 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20945 NULL, NULL, NULL, NULL);
20946 return (ffelexHandler) ffestb_decl_attrs_;
20947
20948 case FFELEX_typeCOLONCOLON:
20949 ffestb_local_.decl.coloncolon = TRUE;
20950 ffesta_confirmed ();
20951 if (*p != '\0')
20952 goto bad_i; /* :::::::::::::::::::: */
20953 if (!ffesta_is_inhibited ())
20954 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20955 NULL, NULL, NULL, NULL);
20956 return (ffelexHandler) ffestb_decl_ents_;
20957
20958 case FFELEX_typeSLASH:
20959 ffesta_confirmed ();
20960 if (*p != '\0')
20961 break;
20962 goto bad_1; /* :::::::::::::::::::: */
20963
20964 case FFELEX_typeASTERISK:
20965 ffesta_confirmed ();
20966 if (*p != '\0')
20967 break;
20968 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
20969 ffestb_local_.decl.badname = "TYPEDECL";
20970 return (ffelexHandler) ffestb_decl_starkind_;
20971
20972 case FFELEX_typeOPEN_PAREN:
20973 if (*p != '\0')
20974 break;
20975 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
20976 ffestb_local_.decl.badname = "TYPEDECL";
20977 return (ffelexHandler) ffestb_decl_kindparam_;
20978 }
20979 if (!ffesrc_is_name_init (*p))
20980 goto bad_i; /* :::::::::::::::::::: */
20981 ffestb_local_.decl.kind = NULL;
20982 ffestb_local_.decl.kindt = NULL;
20983 ffestb_local_.decl.len = NULL;
20984 ffestb_local_.decl.lent = NULL;
20985 ffesta_tokens[1] = ffelex_token_names_from_names (ffesta_tokens[0], i, 0);
20986 return (ffelexHandler) ffestb_decl_entsp_2_ (t);
20987
20988 default:
20989 goto bad_0; /* :::::::::::::::::::: */
20990 }
20991
20992 bad_0: /* :::::::::::::::::::: */
20993 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
20994 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20995
20996 bad_1: /* :::::::::::::::::::: */
20997 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
20998 return (ffelexHandler) ffelex_swallow_tokens (t,
20999 (ffelexHandler) ffesta_zero); /* Invalid second token. */
21000
21001 bad_i: /* :::::::::::::::::::: */
21002 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0], i, t);
21003 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21004 }
21005
21006 /* ffestb_decl_recursive -- Parse the RECURSIVE FUNCTION statement
21007
21008 return ffestb_decl_recursive; // to lexer
21009
21010 Make sure the statement has a valid form for the RECURSIVE FUNCTION
21011 statement. If it does, implement the statement. */
21012
21013 #if FFESTR_F90
21014 ffelexHandler
21015 ffestb_decl_recursive (ffelexToken t)
21016 {
21017 ffeTokenLength i;
21018 const char *p;
21019 ffelexToken nt;
21020 ffelexToken ot;
21021 ffelexHandler next;
21022 bool needfunc;
21023
21024 switch (ffelex_token_type (ffesta_tokens[0]))
21025 {
21026 case FFELEX_typeNAME:
21027 if (ffesta_first_kw != FFESTR_firstRECURSIVE)
21028 goto bad_0; /* :::::::::::::::::::: */
21029 switch (ffelex_token_type (t))
21030 {
21031 case FFELEX_typeEOS:
21032 case FFELEX_typeSEMICOLON:
21033 case FFELEX_typeCOMMA:
21034 case FFELEX_typeCOLONCOLON:
21035 ffesta_confirmed (); /* Error, but clearly intended. */
21036 goto bad_1; /* :::::::::::::::::::: */
21037
21038 default:
21039 goto bad_1; /* :::::::::::::::::::: */
21040
21041 case FFELEX_typeNAME:
21042 break;
21043 }
21044 ffesta_confirmed ();
21045 ffestb_local_.decl.recursive = ffelex_token_use (ffesta_tokens[0]);
21046 switch (ffesta_second_kw)
21047 {
21048 case FFESTR_secondINTEGER:
21049 ffestb_local_.decl.type = FFESTP_typeINTEGER;
21050 return (ffelexHandler) ffestb_decl_recursive1_;
21051
21052 case FFESTR_secondBYTE:
21053 ffestb_local_.decl.type = FFESTP_typeBYTE;
21054 return (ffelexHandler) ffestb_decl_recursive1_;
21055
21056 case FFESTR_secondWORD:
21057 ffestb_local_.decl.type = FFESTP_typeWORD;
21058 return (ffelexHandler) ffestb_decl_recursive1_;
21059
21060 case FFESTR_secondREAL:
21061 ffestb_local_.decl.type = FFESTP_typeREAL;
21062 return (ffelexHandler) ffestb_decl_recursive1_;
21063
21064 case FFESTR_secondCOMPLEX:
21065 ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
21066 return (ffelexHandler) ffestb_decl_recursive1_;
21067
21068 case FFESTR_secondLOGICAL:
21069 ffestb_local_.decl.type = FFESTP_typeLOGICAL;
21070 return (ffelexHandler) ffestb_decl_recursive1_;
21071
21072 case FFESTR_secondCHARACTER:
21073 ffestb_local_.decl.type = FFESTP_typeCHARACTER;
21074 return (ffelexHandler) ffestb_decl_recursive1_;
21075
21076 case FFESTR_secondDOUBLE:
21077 return (ffelexHandler) ffestb_decl_recursive2_;
21078
21079 case FFESTR_secondDOUBLEPRECISION:
21080 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
21081 ffestb_local_.decl.kind = NULL;
21082 ffestb_local_.decl.kindt = NULL;
21083 ffestb_local_.decl.len = NULL;
21084 ffestb_local_.decl.lent = NULL;
21085 return (ffelexHandler) ffestb_decl_func_;
21086
21087 case FFESTR_secondDOUBLECOMPLEX:
21088 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
21089 ffestb_local_.decl.kind = NULL;
21090 ffestb_local_.decl.kindt = NULL;
21091 ffestb_local_.decl.len = NULL;
21092 ffestb_local_.decl.lent = NULL;
21093 return (ffelexHandler) ffestb_decl_func_;
21094
21095 case FFESTR_secondTYPE:
21096 ffestb_local_.decl.type = FFESTP_typeTYPE;
21097 return (ffelexHandler) ffestb_decl_recursive3_;
21098
21099 case FFESTR_secondFUNCTION:
21100 ffestb_local_.dummy.first_kw = FFESTR_firstFUNCTION;
21101 ffestb_local_.dummy.badname = "FUNCTION";
21102 ffestb_local_.dummy.is_subr = FALSE;
21103 return (ffelexHandler) ffestb_decl_recursive4_;
21104
21105 case FFESTR_secondSUBROUTINE:
21106 ffestb_local_.dummy.first_kw = FFESTR_firstSUBROUTINE;
21107 ffestb_local_.dummy.badname = "SUBROUTINE";
21108 ffestb_local_.dummy.is_subr = TRUE;
21109 return (ffelexHandler) ffestb_decl_recursive4_;
21110
21111 default:
21112 ffelex_token_kill (ffestb_local_.decl.recursive);
21113 goto bad_1; /* :::::::::::::::::::: */
21114 }
21115
21116 case FFELEX_typeNAMES:
21117 if (ffesta_first_kw != FFESTR_firstRECURSIVE)
21118 goto bad_0; /* :::::::::::::::::::: */
21119 switch (ffelex_token_type (t))
21120 {
21121 case FFELEX_typeCOMMA:
21122 case FFELEX_typeCOLONCOLON:
21123 case FFELEX_typeASTERISK:
21124 case FFELEX_typeSEMICOLON:
21125 case FFELEX_typeEOS:
21126 ffesta_confirmed ();
21127 break;
21128
21129 default:
21130 break;
21131 }
21132 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlRECURSIVE);
21133 if (!ffesrc_is_name_init (*p))
21134 goto bad_0; /* :::::::::::::::::::: */
21135 ffestb_local_.decl.recursive
21136 = ffelex_token_name_from_names (ffesta_tokens[0], 0,
21137 FFESTR_firstlRECURSIVE);
21138 nt = ffelex_token_names_from_names (ffesta_tokens[0],
21139 FFESTR_firstlRECURSIVE, 0);
21140 switch (ffestr_first (nt))
21141 {
21142 case FFESTR_firstINTGR:
21143 p = ffelex_token_text (nt) + (i = FFESTR_firstlINTGR);
21144 ffestb_local_.decl.type = FFESTP_typeINTEGER;
21145 needfunc = FALSE;
21146 goto typefunc; /* :::::::::::::::::::: */
21147
21148 case FFESTR_firstBYTE:
21149 p = ffelex_token_text (nt) + (i = FFESTR_firstlBYTE);
21150 ffestb_local_.decl.type = FFESTP_typeBYTE;
21151 needfunc = FALSE;
21152 goto typefunc; /* :::::::::::::::::::: */
21153
21154 case FFESTR_firstWORD:
21155 p = ffelex_token_text (nt) + (i = FFESTR_firstlWORD);
21156 ffestb_local_.decl.type = FFESTP_typeWORD;
21157 needfunc = FALSE;
21158 goto typefunc; /* :::::::::::::::::::: */
21159
21160 case FFESTR_firstREAL:
21161 p = ffelex_token_text (nt) + (i = FFESTR_firstlREAL);
21162 ffestb_local_.decl.type = FFESTP_typeREAL;
21163 needfunc = FALSE;
21164 goto typefunc; /* :::::::::::::::::::: */
21165
21166 case FFESTR_firstCMPLX:
21167 p = ffelex_token_text (nt) + (i = FFESTR_firstlCMPLX);
21168 ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
21169 needfunc = FALSE;
21170 goto typefunc; /* :::::::::::::::::::: */
21171
21172 case FFESTR_firstLGCL:
21173 p = ffelex_token_text (nt) + (i = FFESTR_firstlLGCL);
21174 ffestb_local_.decl.type = FFESTP_typeLOGICAL;
21175 needfunc = FALSE;
21176 goto typefunc; /* :::::::::::::::::::: */
21177
21178 case FFESTR_firstCHRCTR:
21179 p = ffelex_token_text (nt) + (i = FFESTR_firstlCHRCTR);
21180 ffestb_local_.decl.type = FFESTP_typeCHARACTER;
21181 needfunc = FALSE;
21182 goto typefunc; /* :::::::::::::::::::: */
21183
21184 case FFESTR_firstDBLPRCSN:
21185 p = ffelex_token_text (nt) + (i = FFESTR_firstlDBLPRCSN);
21186 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
21187 needfunc = TRUE;
21188 goto typefunc; /* :::::::::::::::::::: */
21189
21190 case FFESTR_firstDBLCMPLX:
21191 p = ffelex_token_text (nt) + (i = FFESTR_firstlDBLCMPLX);
21192 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
21193 needfunc = TRUE;
21194 goto typefunc; /* :::::::::::::::::::: */
21195
21196 case FFESTR_firstTYPE:
21197 p = ffelex_token_text (nt) + (i = FFESTR_firstlTYPE);
21198 ffestb_local_.decl.type = FFESTP_typeTYPE;
21199 next = (ffelexHandler) ffestb_decl_recursive3_;
21200 break;
21201
21202 case FFESTR_firstFUNCTION:
21203 p = ffelex_token_text (nt) + (i = FFESTR_firstlFUNCTION);
21204 ffestb_local_.dummy.first_kw = FFESTR_firstFUNCTION;
21205 ffestb_local_.dummy.badname = "FUNCTION";
21206 ffestb_local_.dummy.is_subr = FALSE;
21207 next = (ffelexHandler) ffestb_decl_recursive4_;
21208 break;
21209
21210 case FFESTR_firstSUBROUTINE:
21211 p = ffelex_token_text (nt) + (i = FFESTR_firstlSUBROUTINE);
21212 ffestb_local_.dummy.first_kw = FFESTR_firstSUBROUTINE;
21213 ffestb_local_.dummy.badname = "SUBROUTINE";
21214 ffestb_local_.dummy.is_subr = TRUE;
21215 next = (ffelexHandler) ffestb_decl_recursive4_;
21216 break;
21217
21218 default:
21219 ffelex_token_kill (ffestb_local_.decl.recursive);
21220 ffelex_token_kill (nt);
21221 goto bad_1; /* :::::::::::::::::::: */
21222 }
21223 if (*p == '\0')
21224 {
21225 ffelex_token_kill (nt);
21226 return (ffelexHandler) (*next) (t);
21227 }
21228 if (!ffesrc_is_name_init (*p))
21229 goto bad_i; /* :::::::::::::::::::: */
21230 ot = ffelex_token_name_from_names (nt, i, 0);
21231 ffelex_token_kill (nt);
21232 next = (ffelexHandler) (*next) (ot);
21233 ffelex_token_kill (ot);
21234 return (ffelexHandler) (*next) (t);
21235
21236 default:
21237 goto bad_0; /* :::::::::::::::::::: */
21238 }
21239
21240 typefunc: /* :::::::::::::::::::: */
21241 if (*p == '\0')
21242 {
21243 ffelex_token_kill (nt);
21244 if (needfunc) /* DOUBLE PRECISION or DOUBLE COMPLEX? */
21245 {
21246 ffelex_token_kill (ffestb_local_.decl.recursive);
21247 goto bad_1; /* :::::::::::::::::::: */
21248 }
21249 return (ffelexHandler) ffestb_decl_recursive1_ (t);
21250 }
21251 if (!ffesrc_is_name_init (*p))
21252 goto bad_i; /* :::::::::::::::::::: */
21253 ot = ffelex_token_names_from_names (nt, i, 0);
21254 ffelex_token_kill (nt);
21255 if (ffestr_first (ot) != FFESTR_firstFUNCTION)
21256 goto bad_o; /* :::::::::::::::::::: */
21257 p = ffelex_token_text (ot) + (i = FFESTR_firstlFUNCTION);
21258 if (!ffesrc_is_name_init (*p))
21259 goto bad_i; /* :::::::::::::::::::: */
21260 ffesta_tokens[1] = ffelex_token_name_from_names (ot, i, 0);
21261 ffelex_token_kill (ot);
21262 ffestb_local_.decl.kind = NULL;
21263 ffestb_local_.decl.kindt = NULL;
21264 ffestb_local_.decl.len = NULL;
21265 ffestb_local_.decl.lent = NULL;
21266 return (ffelexHandler) ffestb_decl_funcname_1_ (t);
21267
21268 bad_0: /* :::::::::::::::::::: */
21269 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", ffesta_tokens[0]);
21270 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21271
21272 bad_1: /* :::::::::::::::::::: */
21273 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
21274 return (ffelexHandler) ffelex_swallow_tokens (t,
21275 (ffelexHandler) ffesta_zero); /* Invalid second token. */
21276
21277 bad_i: /* :::::::::::::::::::: */
21278 ffelex_token_kill (ffestb_local_.decl.recursive);
21279 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", nt, i, t);
21280 ffelex_token_kill (nt);
21281 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21282
21283 bad_o: /* :::::::::::::::::::: */
21284 ffelex_token_kill (ffestb_local_.decl.recursive);
21285 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", ot);
21286 ffelex_token_kill (ot);
21287 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21288 }
21289
21290 /* ffestb_decl_recursive1_ -- "RECURSIVE" generic-type
21291
21292 return ffestb_decl_recursive1_; // to lexer
21293
21294 Handle ASTERISK, OPEN_PAREN, or NAME. */
21295
21296 static ffelexHandler
21297 ffestb_decl_recursive1_ (ffelexToken t)
21298 {
21299 switch (ffelex_token_type (t))
21300 {
21301 case FFELEX_typeASTERISK:
21302 ffesta_confirmed ();
21303 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_func_;
21304 ffestb_local_.decl.badname = "TYPEFUNC";
21305 if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
21306 return (ffelexHandler) ffestb_decl_starlen_;
21307 return (ffelexHandler) ffestb_decl_starkind_;
21308
21309 case FFELEX_typeOPEN_PAREN:
21310 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_func_;
21311 ffestb_local_.decl.badname = "TYPEFUNC";
21312 if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
21313 {
21314 ffestb_local_.decl.kind = NULL;
21315 ffestb_local_.decl.kindt = NULL;
21316 ffestb_local_.decl.len = NULL;
21317 ffestb_local_.decl.lent = NULL;
21318 return (ffelexHandler) ffestb_decl_typeparams_;
21319 }
21320 return (ffelexHandler) ffestb_decl_kindparam_;
21321
21322 case FFELEX_typeNAME:
21323 ffestb_local_.decl.kind = NULL;
21324 ffestb_local_.decl.kindt = NULL;
21325 ffestb_local_.decl.len = NULL;
21326 ffestb_local_.decl.lent = NULL;
21327 return (ffelexHandler) ffestb_decl_func_ (t);
21328
21329 default:
21330 break;
21331 }
21332
21333 if (ffestb_local_.decl.recursive != NULL)
21334 ffelex_token_kill (ffestb_local_.decl.recursive);
21335 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
21336 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21337 }
21338
21339 /* ffestb_decl_recursive2_ -- "RECURSIVE" "DOUBLE"
21340
21341 return ffestb_decl_recursive2_; // to lexer
21342
21343 Handle NAME. */
21344
21345 static ffelexHandler
21346 ffestb_decl_recursive2_ (ffelexToken t)
21347 {
21348 switch (ffelex_token_type (t))
21349 {
21350 case FFELEX_typeNAME:
21351 switch (ffestr_second (t))
21352 {
21353 case FFESTR_secondPRECISION:
21354 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
21355 break;
21356
21357 case FFESTR_secondCOMPLEX:
21358 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
21359 break;
21360
21361 default:
21362 goto bad; /* :::::::::::::::::::: */
21363 }
21364 ffestb_local_.decl.kind = NULL;
21365 ffestb_local_.decl.kindt = NULL;
21366 ffestb_local_.decl.len = NULL;
21367 ffestb_local_.decl.lent = NULL;
21368 return (ffelexHandler) ffestb_decl_func_;
21369
21370 default:
21371 break;
21372 }
21373
21374 bad: /* :::::::::::::::::::: */
21375 if (ffestb_local_.decl.recursive != NULL)
21376 ffelex_token_kill (ffestb_local_.decl.recursive);
21377 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
21378 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21379 }
21380
21381 /* ffestb_decl_recursive3_ -- "RECURSIVE" "TYPE"
21382
21383 return ffestb_decl_recursive3_; // to lexer
21384
21385 Handle OPEN_PAREN. */
21386
21387 static ffelexHandler
21388 ffestb_decl_recursive3_ (ffelexToken t)
21389 {
21390 switch (ffelex_token_type (t))
21391 {
21392 case FFELEX_typeOPEN_PAREN:
21393 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_func_;
21394 ffestb_local_.decl.badname = "TYPEFUNC";
21395 return (ffelexHandler) ffestb_decl_typetype1_;
21396
21397 default:
21398 break;
21399 }
21400
21401 if (ffestb_local_.decl.recursive != NULL)
21402 ffelex_token_kill (ffestb_local_.decl.recursive);
21403 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
21404 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21405 }
21406
21407 /* ffestb_decl_recursive4_ -- "RECURSIVE" "FUNCTION/SUBROUTINE"
21408
21409 return ffestb_decl_recursive4_; // to lexer
21410
21411 Handle OPEN_PAREN. */
21412
21413 static ffelexHandler
21414 ffestb_decl_recursive4_ (ffelexToken t)
21415 {
21416 switch (ffelex_token_type (t))
21417 {
21418 case FFELEX_typeNAME:
21419 ffesta_tokens[1] = ffelex_token_use (t);
21420 return (ffelexHandler) ffestb_dummy1_;
21421
21422 default:
21423 break;
21424 }
21425
21426 if (ffestb_local_.decl.recursive != NULL)
21427 ffelex_token_kill (ffestb_local_.decl.recursive);
21428 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
21429 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21430 }
21431
21432 #endif
21433 /* ffestb_decl_typetype -- Parse the R426/R501/R1219 TYPE statement
21434
21435 return ffestb_decl_typetype; // to lexer
21436
21437 Make sure the statement has a valid form for the TYPE statement. If it
21438 does, implement the statement. */
21439
21440 #if FFESTR_F90
21441 ffelexHandler
21442 ffestb_decl_typetype (ffelexToken t)
21443 {
21444 switch (ffelex_token_type (ffesta_tokens[0]))
21445 {
21446 case FFELEX_typeNAME:
21447 if (ffesta_first_kw != FFESTR_firstTYPE)
21448 goto bad_0; /* :::::::::::::::::::: */
21449 break;
21450
21451 case FFELEX_typeNAMES:
21452 if (ffesta_first_kw != FFESTR_firstTYPE)
21453 goto bad_0; /* :::::::::::::::::::: */
21454 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlTYPE)
21455 goto bad_0; /* :::::::::::::::::::: */
21456 break;
21457
21458 default:
21459 goto bad_0; /* :::::::::::::::::::: */
21460 }
21461
21462 switch (ffelex_token_type (t))
21463 {
21464 case FFELEX_typeOPEN_PAREN:
21465 break;
21466
21467 case FFELEX_typeEOS:
21468 case FFELEX_typeSEMICOLON:
21469 case FFELEX_typeCOLONCOLON:/* Not COMMA: R424 "TYPE,PUBLIC::A". */
21470 ffesta_confirmed (); /* Error, but clearly intended. */
21471 goto bad_1; /* :::::::::::::::::::: */
21472
21473 default:
21474 goto bad_1; /* :::::::::::::::::::: */
21475 }
21476
21477 ffestb_local_.decl.recursive = NULL;
21478 ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
21479 ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
21480
21481 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
21482 ffestb_local_.decl.badname = "type-declaration";
21483 return (ffelexHandler) ffestb_decl_typetype1_;
21484
21485 bad_0: /* :::::::::::::::::::: */
21486 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
21487 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21488
21489 bad_1: /* :::::::::::::::::::: */
21490 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
21491 return (ffelexHandler) ffelex_swallow_tokens (t,
21492 (ffelexHandler) ffesta_zero); /* Invalid second token. */
21493 }
21494
21495 #endif
21496 /* ffestb_decl_attrs_ -- "type" [type parameters] COMMA
21497
21498 return ffestb_decl_attrs_; // to lexer
21499
21500 Handle NAME of an attribute. */
21501
21502 static ffelexHandler
21503 ffestb_decl_attrs_ (ffelexToken t)
21504 {
21505 switch (ffelex_token_type (t))
21506 {
21507 case FFELEX_typeNAME:
21508 switch (ffestr_first (t))
21509 {
21510 #if FFESTR_F90
21511 case FFESTR_firstALLOCATABLE:
21512 if (!ffesta_is_inhibited ())
21513 ffestc_decl_attrib (FFESTP_attribALLOCATABLE, t,
21514 FFESTR_otherNone, NULL);
21515 return (ffelexHandler) ffestb_decl_attrs_7_;
21516 #endif
21517
21518 case FFESTR_firstDIMENSION:
21519 ffesta_tokens[1] = ffelex_token_use (t);
21520 return (ffelexHandler) ffestb_decl_attrs_1_;
21521
21522 case FFESTR_firstEXTERNAL:
21523 if (!ffesta_is_inhibited ())
21524 ffestc_decl_attrib (FFESTP_attribEXTERNAL, t,
21525 FFESTR_otherNone, NULL);
21526 return (ffelexHandler) ffestb_decl_attrs_7_;
21527
21528 #if FFESTR_F90
21529 case FFESTR_firstINTENT:
21530 ffesta_tokens[1] = ffelex_token_use (t);
21531 return (ffelexHandler) ffestb_decl_attrs_3_;
21532 #endif
21533
21534 case FFESTR_firstINTRINSIC:
21535 if (!ffesta_is_inhibited ())
21536 ffestc_decl_attrib (FFESTP_attribINTRINSIC, t,
21537 FFESTR_otherNone, NULL);
21538 return (ffelexHandler) ffestb_decl_attrs_7_;
21539
21540 #if FFESTR_F90
21541 case FFESTR_firstOPTIONAL:
21542 if (!ffesta_is_inhibited ())
21543 ffestc_decl_attrib (FFESTP_attribOPTIONAL, t,
21544 FFESTR_otherNone, NULL);
21545 return (ffelexHandler) ffestb_decl_attrs_7_;
21546 #endif
21547
21548 case FFESTR_firstPARAMETER:
21549 ffestb_local_.decl.parameter = TRUE;
21550 if (!ffesta_is_inhibited ())
21551 ffestc_decl_attrib (FFESTP_attribPARAMETER, t,
21552 FFESTR_otherNone, NULL);
21553 return (ffelexHandler) ffestb_decl_attrs_7_;
21554
21555 #if FFESTR_F90
21556 case FFESTR_firstPOINTER:
21557 if (!ffesta_is_inhibited ())
21558 ffestc_decl_attrib (FFESTP_attribPOINTER, t,
21559 FFESTR_otherNone, NULL);
21560 return (ffelexHandler) ffestb_decl_attrs_7_;
21561 #endif
21562
21563 #if FFESTR_F90
21564 case FFESTR_firstPRIVATE:
21565 if (!ffesta_is_inhibited ())
21566 ffestc_decl_attrib (FFESTP_attribPRIVATE, t,
21567 FFESTR_otherNone, NULL);
21568 return (ffelexHandler) ffestb_decl_attrs_7_;
21569
21570 case FFESTR_firstPUBLIC:
21571 if (!ffesta_is_inhibited ())
21572 ffestc_decl_attrib (FFESTP_attribPUBLIC, t,
21573 FFESTR_otherNone, NULL);
21574 return (ffelexHandler) ffestb_decl_attrs_7_;
21575 #endif
21576
21577 case FFESTR_firstSAVE:
21578 if (!ffesta_is_inhibited ())
21579 ffestc_decl_attrib (FFESTP_attribSAVE, t,
21580 FFESTR_otherNone, NULL);
21581 return (ffelexHandler) ffestb_decl_attrs_7_;
21582
21583 #if FFESTR_F90
21584 case FFESTR_firstTARGET:
21585 if (!ffesta_is_inhibited ())
21586 ffestc_decl_attrib (FFESTP_attribTARGET, t,
21587 FFESTR_otherNone, NULL);
21588 return (ffelexHandler) ffestb_decl_attrs_7_;
21589 #endif
21590
21591 default:
21592 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
21593 return (ffelexHandler) ffestb_decl_attrs_7_;
21594 }
21595 break;
21596
21597 default:
21598 break;
21599 }
21600
21601 if (!ffesta_is_inhibited ())
21602 ffestc_decl_finish ();
21603 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
21604 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21605 }
21606
21607 /* ffestb_decl_attrs_1_ -- "type" [type parameters] ",DIMENSION"
21608
21609 return ffestb_decl_attrs_1_; // to lexer
21610
21611 Handle OPEN_PAREN. */
21612
21613 static ffelexHandler
21614 ffestb_decl_attrs_1_ (ffelexToken t)
21615 {
21616 switch (ffelex_token_type (t))
21617 {
21618 case FFELEX_typeOPEN_PAREN:
21619 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
21620 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_decl_attrs_2_;
21621 ffestb_subrargs_.dim_list.pool = ffesta_scratch_pool;
21622 ffestb_subrargs_.dim_list.ctx = ffesta_is_entry_valid
21623 ? FFEEXPR_contextDIMLIST : FFEEXPR_contextDIMLISTCOMMON;
21624 #ifdef FFECOM_dimensionsMAX
21625 ffestb_subrargs_.dim_list.ndims = 0;
21626 #endif
21627 return (ffelexHandler) ffeexpr_rhs (ffesta_scratch_pool,
21628 ffestb_subrargs_.dim_list.ctx,
21629 (ffeexprCallback) ffestb_subr_dimlist_);
21630
21631 case FFELEX_typeCOMMA:
21632 case FFELEX_typeCOLONCOLON:
21633 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, ffesta_tokens[1]);
21634 ffelex_token_kill (ffesta_tokens[1]);
21635 return (ffelexHandler) ffestb_decl_attrs_7_ (t);
21636
21637 default:
21638 break;
21639 }
21640
21641 if (!ffesta_is_inhibited ())
21642 ffestc_decl_finish ();
21643 ffelex_token_kill (ffesta_tokens[1]);
21644 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
21645 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21646 }
21647
21648 /* ffestb_decl_attrs_2_ -- "type" [type parameters] ",DIMENSION" OPEN_PAREN
21649 dimlist CLOSE_PAREN
21650
21651 return ffestb_decl_attrs_2_; // to lexer
21652
21653 Handle COMMA or COLONCOLON. */
21654
21655 static ffelexHandler
21656 ffestb_decl_attrs_2_ (ffelexToken t)
21657 {
21658 if (!ffestb_subrargs_.dim_list.ok)
21659 goto bad; /* :::::::::::::::::::: */
21660
21661 switch (ffelex_token_type (t))
21662 {
21663 case FFELEX_typeCOMMA:
21664 case FFELEX_typeCOLONCOLON:
21665 if (!ffesta_is_inhibited ())
21666 ffestc_decl_attrib (FFESTP_attribDIMENSION, ffesta_tokens[1],
21667 FFESTR_otherNone, ffestb_subrargs_.dim_list.dims);
21668 ffelex_token_kill (ffesta_tokens[1]);
21669 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
21670 return (ffelexHandler) ffestb_decl_attrs_7_ (t);
21671
21672 default:
21673 break;
21674 }
21675
21676 bad: /* :::::::::::::::::::: */
21677 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
21678 if (!ffesta_is_inhibited ())
21679 ffestc_decl_finish ();
21680 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
21681 ffelex_token_kill (ffesta_tokens[1]);
21682 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21683 }
21684
21685 /* ffestb_decl_attrs_3_ -- "type" [type parameters] ",INTENT"
21686
21687 return ffestb_decl_attrs_3_; // to lexer
21688
21689 Handle OPEN_PAREN. */
21690
21691 #if FFESTR_F90
21692 static ffelexHandler
21693 ffestb_decl_attrs_3_ (ffelexToken t)
21694 {
21695 switch (ffelex_token_type (t))
21696 {
21697 case FFELEX_typeOPEN_PAREN:
21698 return (ffelexHandler) ffestb_decl_attrs_4_;
21699
21700 case FFELEX_typeCOMMA:
21701 case FFELEX_typeCOLONCOLON:
21702 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, ffesta_tokens[1]);
21703 ffelex_token_kill (ffesta_tokens[1]);
21704 return (ffelexHandler) ffestb_decl_attrs_7_ (t);
21705
21706 default:
21707 break;
21708 }
21709
21710 if (!ffesta_is_inhibited ())
21711 ffestc_decl_finish ();
21712 ffelex_token_kill (ffesta_tokens[1]);
21713 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
21714 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21715 }
21716
21717 /* ffestb_decl_attrs_4_ -- "type" [type parameters] ",INTENT" OPEN_PAREN
21718
21719 return ffestb_decl_attrs_4_; // to lexer
21720
21721 Handle NAME. */
21722
21723 static ffelexHandler
21724 ffestb_decl_attrs_4_ (ffelexToken t)
21725 {
21726 switch (ffelex_token_type (t))
21727 {
21728 case FFELEX_typeNAME:
21729 ffestb_local_.decl.kw = ffestr_other (t);
21730 switch (ffestb_local_.decl.kw)
21731 {
21732 case FFESTR_otherIN:
21733 return (ffelexHandler) ffestb_decl_attrs_5_;
21734
21735 case FFESTR_otherINOUT:
21736 return (ffelexHandler) ffestb_decl_attrs_6_;
21737
21738 case FFESTR_otherOUT:
21739 return (ffelexHandler) ffestb_decl_attrs_6_;
21740
21741 default:
21742 ffestb_local_.decl.kw = FFESTR_otherNone;
21743 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
21744 return (ffelexHandler) ffestb_decl_attrs_5_;
21745 }
21746 break;
21747
21748 default:
21749 break;
21750 }
21751
21752 if (!ffesta_is_inhibited ())
21753 ffestc_decl_finish ();
21754 ffelex_token_kill (ffesta_tokens[1]);
21755 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
21756 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21757 }
21758
21759 /* ffestb_decl_attrs_5_ -- "type" [type parameters] ",INTENT" OPEN_PAREN "IN"
21760
21761 return ffestb_decl_attrs_5_; // to lexer
21762
21763 Handle NAME or CLOSE_PAREN. */
21764
21765 static ffelexHandler
21766 ffestb_decl_attrs_5_ (ffelexToken t)
21767 {
21768 switch (ffelex_token_type (t))
21769 {
21770 case FFELEX_typeNAME:
21771 switch (ffestr_other (t))
21772 {
21773 case FFESTR_otherOUT:
21774 if (ffestb_local_.decl.kw != FFESTR_otherNone)
21775 ffestb_local_.decl.kw = FFESTR_otherINOUT;
21776 return (ffelexHandler) ffestb_decl_attrs_6_;
21777
21778 default:
21779 if (ffestb_local_.decl.kw != FFESTR_otherNone)
21780 {
21781 ffestb_local_.decl.kw = FFESTR_otherNone;
21782 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
21783 }
21784 return (ffelexHandler) ffestb_decl_attrs_5_;
21785 }
21786 break;
21787
21788 case FFELEX_typeCLOSE_PAREN:
21789 return (ffelexHandler) ffestb_decl_attrs_6_ (t);
21790
21791 default:
21792 break;
21793 }
21794
21795 if (!ffesta_is_inhibited ())
21796 ffestc_decl_finish ();
21797 ffelex_token_kill (ffesta_tokens[1]);
21798 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
21799 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21800 }
21801
21802 /* ffestb_decl_attrs_6_ -- "type" [type parameters] ",INTENT" OPEN_PAREN "IN"
21803 ["OUT"]
21804
21805 return ffestb_decl_attrs_6_; // to lexer
21806
21807 Handle CLOSE_PAREN. */
21808
21809 static ffelexHandler
21810 ffestb_decl_attrs_6_ (ffelexToken t)
21811 {
21812 switch (ffelex_token_type (t))
21813 {
21814 case FFELEX_typeCLOSE_PAREN:
21815 if ((ffestb_local_.decl.kw != FFESTR_otherNone)
21816 && !ffesta_is_inhibited ())
21817 ffestc_decl_attrib (FFESTP_attribINTENT, ffesta_tokens[1],
21818 ffestb_local_.decl.kw, NULL);
21819 ffelex_token_kill (ffesta_tokens[1]);
21820 return (ffelexHandler) ffestb_decl_attrs_7_;
21821
21822 default:
21823 break;
21824 }
21825
21826 if (!ffesta_is_inhibited ())
21827 ffestc_decl_finish ();
21828 ffelex_token_kill (ffesta_tokens[1]);
21829 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
21830 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21831 }
21832
21833 #endif
21834 /* ffestb_decl_attrs_7_ -- "type" [type parameters] attribute
21835
21836 return ffestb_decl_attrs_7_; // to lexer
21837
21838 Handle COMMA (another attribute) or COLONCOLON (entities). */
21839
21840 static ffelexHandler
21841 ffestb_decl_attrs_7_ (ffelexToken t)
21842 {
21843 switch (ffelex_token_type (t))
21844 {
21845 case FFELEX_typeCOMMA:
21846 return (ffelexHandler) ffestb_decl_attrs_;
21847
21848 case FFELEX_typeCOLONCOLON:
21849 ffestb_local_.decl.coloncolon = TRUE;
21850 return (ffelexHandler) ffestb_decl_ents_;
21851
21852 default:
21853 break;
21854 }
21855
21856 if (!ffesta_is_inhibited ())
21857 ffestc_decl_finish ();
21858 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
21859 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21860 }
21861
21862 /* ffestb_decl_attrsp_ -- "type" [type parameters]
21863
21864 return ffestb_decl_attrsp_; // to lexer
21865
21866 Handle COMMA (meaning we have attributes), COLONCOLON (meaning we have
21867 no attributes but entities), or go to entsp to see about functions or
21868 entities. */
21869
21870 static ffelexHandler
21871 ffestb_decl_attrsp_ (ffelexToken t)
21872 {
21873 ffelex_set_names (FALSE);
21874
21875 switch (ffelex_token_type (t))
21876 {
21877 case FFELEX_typeCOMMA:
21878 ffesta_confirmed ();
21879 if (!ffesta_is_inhibited ())
21880 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
21881 ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
21882 ffestb_local_.decl.len, ffestb_local_.decl.lent);
21883 if (ffestb_local_.decl.kindt != NULL)
21884 ffelex_token_kill (ffestb_local_.decl.kindt);
21885 if (ffestb_local_.decl.lent != NULL)
21886 ffelex_token_kill (ffestb_local_.decl.lent);
21887 return (ffelexHandler) ffestb_decl_attrs_;
21888
21889 case FFELEX_typeCOLONCOLON:
21890 ffestb_local_.decl.coloncolon = TRUE;
21891 ffesta_confirmed ();
21892 if (!ffesta_is_inhibited ())
21893 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
21894 ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
21895 ffestb_local_.decl.len, ffestb_local_.decl.lent);
21896 if (ffestb_local_.decl.kindt != NULL)
21897 ffelex_token_kill (ffestb_local_.decl.kindt);
21898 if (ffestb_local_.decl.lent != NULL)
21899 ffelex_token_kill (ffestb_local_.decl.lent);
21900 return (ffelexHandler) ffestb_decl_ents_;
21901
21902 default:
21903 return (ffelexHandler) ffestb_decl_entsp_ (t);
21904 }
21905 }
21906
21907 /* ffestb_decl_ents_ -- "type" [type parameters] [attributes "::"]
21908
21909 return ffestb_decl_ents_; // to lexer
21910
21911 Handle NAME of an entity. */
21912
21913 static ffelexHandler
21914 ffestb_decl_ents_ (ffelexToken t)
21915 {
21916 switch (ffelex_token_type (t))
21917 {
21918 case FFELEX_typeNAME:
21919 ffesta_tokens[1] = ffelex_token_use (t);
21920 return (ffelexHandler) ffestb_decl_ents_1_;
21921
21922 default:
21923 break;
21924 }
21925
21926 if (!ffesta_is_inhibited ())
21927 ffestc_decl_finish ();
21928 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
21929 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21930 }
21931
21932 /* ffestb_decl_ents_1_ -- "type" [type parameters] [attributes "::"] NAME
21933
21934 return ffestb_decl_ents_1_; // to lexer
21935
21936 Handle ASTERISK, OPEN_PAREN, EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */
21937
21938 static ffelexHandler
21939 ffestb_decl_ents_1_ (ffelexToken t)
21940 {
21941 switch (ffelex_token_type (t))
21942 {
21943 case FFELEX_typeCOMMA:
21944 if (!ffesta_is_inhibited ())
21945 ffestc_decl_item (ffesta_tokens[1], NULL, NULL, NULL, NULL, NULL, NULL,
21946 NULL, FALSE);
21947 ffelex_token_kill (ffesta_tokens[1]);
21948 return (ffelexHandler) ffestb_decl_ents_;
21949
21950 case FFELEX_typeEOS:
21951 case FFELEX_typeSEMICOLON:
21952 if (!ffesta_is_inhibited ())
21953 {
21954 ffestc_decl_item (ffesta_tokens[1], NULL, NULL, NULL, NULL, NULL, NULL,
21955 NULL, FALSE);
21956 ffestc_decl_finish ();
21957 }
21958 ffelex_token_kill (ffesta_tokens[1]);
21959 return (ffelexHandler) ffesta_zero (t);
21960
21961 case FFELEX_typeASTERISK:
21962 ffestb_local_.decl.len = NULL;
21963 ffestb_local_.decl.lent = NULL;
21964 return (ffelexHandler) ffestb_decl_ents_2_;
21965
21966 case FFELEX_typeOPEN_PAREN:
21967 ffestb_local_.decl.kind = NULL;
21968 ffestb_local_.decl.kindt = NULL;
21969 ffestb_local_.decl.len = NULL;
21970 ffestb_local_.decl.lent = NULL;
21971 return (ffelexHandler) ffestb_decl_ents_3_ (t);
21972
21973 case FFELEX_typeEQUALS:
21974 case FFELEX_typeSLASH:
21975 ffestb_local_.decl.kind = NULL;
21976 ffestb_local_.decl.kindt = NULL;
21977 ffestb_subrargs_.dim_list.dims = NULL;
21978 ffestb_local_.decl.len = NULL;
21979 ffestb_local_.decl.lent = NULL;
21980 return (ffelexHandler) ffestb_decl_ents_7_ (t);
21981
21982 default:
21983 break;
21984 }
21985
21986 if (!ffesta_is_inhibited ())
21987 ffestc_decl_finish ();
21988 ffelex_token_kill (ffesta_tokens[1]);
21989 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
21990 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21991 }
21992
21993 /* ffestb_decl_ents_2_ -- "type" [type parameters] [attributes "::"] NAME
21994 ASTERISK
21995
21996 return ffestb_decl_ents_2_; // to lexer
21997
21998 Handle NUMBER or OPEN_PAREN. */
21999
22000 static ffelexHandler
22001 ffestb_decl_ents_2_ (ffelexToken t)
22002 {
22003 switch (ffelex_token_type (t))
22004 {
22005 case FFELEX_typeNUMBER:
22006 if (ffestb_local_.decl.type != FFESTP_typeCHARACTER)
22007 {
22008 ffestb_local_.decl.kind = NULL;
22009 ffestb_local_.decl.kindt = ffelex_token_use (t);
22010 return (ffelexHandler) ffestb_decl_ents_3_;
22011 }
22012 /* Fall through. *//* (CHARACTER's *n is always a len spec. */
22013 case FFELEX_typeOPEN_PAREN:/* "*(" is after the (omitted)
22014 "(array-spec)". */
22015 ffestb_local_.decl.kind = NULL;
22016 ffestb_local_.decl.kindt = NULL;
22017 ffestb_subrargs_.dim_list.dims = NULL;
22018 return (ffelexHandler) ffestb_decl_ents_5_ (t);
22019
22020 default:
22021 break;
22022 }
22023
22024 if (!ffesta_is_inhibited ())
22025 ffestc_decl_finish ();
22026 ffelex_token_kill (ffesta_tokens[1]);
22027 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22028 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22029 }
22030
22031 /* ffestb_decl_ents_3_ -- "type" [type parameters] [attributes "::"] NAME
22032 [ASTERISK NUMBER]
22033
22034 return ffestb_decl_ents_3_; // to lexer
22035
22036 Handle ASTERISK, OPEN_PAREN, EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */
22037
22038 static ffelexHandler
22039 ffestb_decl_ents_3_ (ffelexToken t)
22040 {
22041 switch (ffelex_token_type (t))
22042 {
22043 case FFELEX_typeCOMMA:
22044 if (!ffesta_is_inhibited ())
22045 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
22046 ffestb_local_.decl.kindt, NULL, NULL, NULL, NULL, NULL, FALSE);
22047 ffelex_token_kill (ffesta_tokens[1]);
22048 if (ffestb_local_.decl.kindt != NULL)
22049 ffelex_token_kill (ffestb_local_.decl.kindt);
22050 return (ffelexHandler) ffestb_decl_ents_;
22051
22052 case FFELEX_typeEOS:
22053 case FFELEX_typeSEMICOLON:
22054 if (!ffesta_is_inhibited ())
22055 {
22056 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
22057 ffestb_local_.decl.kindt, NULL, NULL, NULL, NULL, NULL, FALSE);
22058 ffestc_decl_finish ();
22059 }
22060 ffelex_token_kill (ffesta_tokens[1]);
22061 if (ffestb_local_.decl.kindt != NULL)
22062 ffelex_token_kill (ffestb_local_.decl.kindt);
22063 return (ffelexHandler) ffesta_zero (t);
22064
22065 case FFELEX_typeASTERISK:
22066 ffestb_subrargs_.dim_list.dims = NULL;
22067 return (ffelexHandler) ffestb_decl_ents_5_;
22068
22069 case FFELEX_typeOPEN_PAREN:
22070 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
22071 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_decl_ents_4_;
22072 ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
22073 ffestb_subrargs_.dim_list.ctx = ffesta_is_entry_valid
22074 ? FFEEXPR_contextDIMLIST : FFEEXPR_contextDIMLISTCOMMON;
22075 #ifdef FFECOM_dimensionsMAX
22076 ffestb_subrargs_.dim_list.ndims = 0;
22077 #endif
22078 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
22079 ffestb_subrargs_.dim_list.ctx,
22080 (ffeexprCallback) ffestb_subr_dimlist_);
22081
22082 case FFELEX_typeEQUALS:
22083 case FFELEX_typeSLASH:
22084 ffestb_local_.decl.kind = NULL;
22085 ffestb_local_.decl.kindt = NULL;
22086 ffestb_subrargs_.dim_list.dims = NULL;
22087 ffestb_local_.decl.len = NULL;
22088 ffestb_local_.decl.lent = NULL;
22089 return (ffelexHandler) ffestb_decl_ents_7_ (t);
22090
22091 default:
22092 break;
22093 }
22094
22095 if (!ffesta_is_inhibited ())
22096 ffestc_decl_finish ();
22097 ffelex_token_kill (ffesta_tokens[1]);
22098 if (ffestb_local_.decl.kindt != NULL)
22099 ffelex_token_kill (ffestb_local_.decl.kindt);
22100 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22101 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22102 }
22103
22104 /* ffestb_decl_ents_4_ -- "type" [type parameters] [attributes "::"] NAME
22105 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
22106
22107 return ffestb_decl_ents_4_; // to lexer
22108
22109 Handle ASTERISK, EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */
22110
22111 static ffelexHandler
22112 ffestb_decl_ents_4_ (ffelexToken t)
22113 {
22114 ffelexToken nt;
22115
22116 if (!ffestb_subrargs_.dim_list.ok)
22117 goto bad; /* :::::::::::::::::::: */
22118
22119 if (ffelex_token_type (ffesta_tokens[1]) == FFELEX_typeNAMES)
22120 {
22121 switch (ffelex_token_type (t))
22122 {
22123 case FFELEX_typeCOMMA:
22124 case FFELEX_typeEOS:
22125 case FFELEX_typeSEMICOLON:
22126 case FFELEX_typeASTERISK:
22127 case FFELEX_typeSLASH: /* But NOT FFELEX_typeEQUALS. */
22128 case FFELEX_typeCOLONCOLON: /* Actually an error. */
22129 break; /* Confirm and handle. */
22130
22131 default: /* Perhaps EQUALS, as in
22132 INTEGERFUNCTIONX(A)=B. */
22133 goto bad; /* :::::::::::::::::::: */
22134 }
22135 ffesta_confirmed ();
22136 if (!ffesta_is_inhibited ())
22137 {
22138 nt = ffelex_token_name_from_names (ffesta_tokens[1], 0, 0);
22139 ffelex_token_kill (ffesta_tokens[1]);
22140 ffesta_tokens[1] = nt;
22141 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
22142 NULL, NULL, NULL, NULL);
22143 }
22144 }
22145
22146 switch (ffelex_token_type (t))
22147 {
22148 case FFELEX_typeCOMMA:
22149 if (!ffesta_is_inhibited ())
22150 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
22151 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
22152 ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
22153 FALSE);
22154 ffelex_token_kill (ffesta_tokens[1]);
22155 if (ffestb_local_.decl.kindt != NULL)
22156 ffelex_token_kill (ffestb_local_.decl.kindt);
22157 if (ffestb_local_.decl.lent != NULL)
22158 ffelex_token_kill (ffestb_local_.decl.lent);
22159 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22160 return (ffelexHandler) ffestb_decl_ents_;
22161
22162 case FFELEX_typeEOS:
22163 case FFELEX_typeSEMICOLON:
22164 if (!ffesta_is_inhibited ())
22165 {
22166 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
22167 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
22168 ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
22169 FALSE);
22170 ffestc_decl_finish ();
22171 }
22172 ffelex_token_kill (ffesta_tokens[1]);
22173 if (ffestb_local_.decl.kindt != NULL)
22174 ffelex_token_kill (ffestb_local_.decl.kindt);
22175 if (ffestb_local_.decl.lent != NULL)
22176 ffelex_token_kill (ffestb_local_.decl.lent);
22177 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22178 return (ffelexHandler) ffesta_zero (t);
22179
22180 case FFELEX_typeASTERISK:
22181 if (ffestb_local_.decl.lent != NULL)
22182 break; /* Can't specify "*length" twice. */
22183 return (ffelexHandler) ffestb_decl_ents_5_;
22184
22185 case FFELEX_typeEQUALS:
22186 case FFELEX_typeSLASH:
22187 return (ffelexHandler) ffestb_decl_ents_7_ (t);
22188
22189 default:
22190 break;
22191 }
22192
22193 bad: /* :::::::::::::::::::: */
22194 if ((ffelex_token_type (ffesta_tokens[1]) != FFELEX_typeNAMES)
22195 && !ffesta_is_inhibited ())
22196 ffestc_decl_finish ();
22197 ffelex_token_kill (ffesta_tokens[1]);
22198 if (ffestb_local_.decl.kindt != NULL)
22199 ffelex_token_kill (ffestb_local_.decl.kindt);
22200 if (ffestb_local_.decl.lent != NULL)
22201 ffelex_token_kill (ffestb_local_.decl.lent);
22202 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22203 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22204 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22205 }
22206
22207 /* ffestb_decl_ents_5_ -- "type" [type parameters] [attributes "::"] NAME
22208 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
22209 ASTERISK
22210
22211 return ffestb_decl_ents_5_; // to lexer
22212
22213 Handle NUMBER or OPEN_PAREN. */
22214
22215 static ffelexHandler
22216 ffestb_decl_ents_5_ (ffelexToken t)
22217 {
22218 switch (ffelex_token_type (t))
22219 {
22220 case FFELEX_typeNUMBER:
22221 ffestb_local_.decl.len = NULL;
22222 ffestb_local_.decl.lent = ffelex_token_use (t);
22223 return (ffelexHandler) ffestb_decl_ents_7_;
22224
22225 case FFELEX_typeOPEN_PAREN:
22226 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
22227 FFEEXPR_contextCHARACTERSIZE, (ffeexprCallback) ffestb_decl_ents_6_);
22228
22229 default:
22230 break;
22231 }
22232
22233 if (!ffesta_is_inhibited ())
22234 ffestc_decl_finish ();
22235 ffelex_token_kill (ffesta_tokens[1]);
22236 if (ffestb_local_.decl.kindt != NULL)
22237 ffelex_token_kill (ffestb_local_.decl.kindt);
22238 if (ffestb_subrargs_.dim_list.dims != NULL)
22239 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22240 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22241 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22242 }
22243
22244 /* ffestb_decl_ents_6_ -- "type" [type parameters] [attributes "::"] NAME
22245 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
22246 ASTERISK OPEN_PAREN expr
22247
22248 (ffestb_decl_ents_6_) // to expression handler
22249
22250 Handle CLOSE_PAREN. */
22251
22252 static ffelexHandler
22253 ffestb_decl_ents_6_ (ffelexToken ft, ffebld expr, ffelexToken t)
22254 {
22255 switch (ffelex_token_type (t))
22256 {
22257 case FFELEX_typeCLOSE_PAREN:
22258 if (expr == NULL)
22259 break;
22260 ffestb_local_.decl.len = expr;
22261 ffestb_local_.decl.lent = ffelex_token_use (ft);
22262 return (ffelexHandler) ffestb_decl_ents_7_;
22263
22264 default:
22265 break;
22266 }
22267
22268 if (!ffesta_is_inhibited ())
22269 ffestc_decl_finish ();
22270 ffelex_token_kill (ffesta_tokens[1]);
22271 if (ffestb_local_.decl.kindt != NULL)
22272 ffelex_token_kill (ffestb_local_.decl.kindt);
22273 if (ffestb_subrargs_.dim_list.dims != NULL)
22274 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22275 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22276 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22277 }
22278
22279 /* ffestb_decl_ents_7_ -- "type" [type parameters] [attributes "::"] NAME
22280 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
22281 [ASTERISK charlength]
22282
22283 return ffestb_decl_ents_7_; // to lexer
22284
22285 Handle EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */
22286
22287 static ffelexHandler
22288 ffestb_decl_ents_7_ (ffelexToken t)
22289 {
22290 switch (ffelex_token_type (t))
22291 {
22292 case FFELEX_typeCOMMA:
22293 if (!ffesta_is_inhibited ())
22294 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
22295 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
22296 ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
22297 FALSE);
22298 ffelex_token_kill (ffesta_tokens[1]);
22299 if (ffestb_local_.decl.kindt != NULL)
22300 ffelex_token_kill (ffestb_local_.decl.kindt);
22301 if (ffestb_subrargs_.dim_list.dims != NULL)
22302 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22303 if (ffestb_local_.decl.lent != NULL)
22304 ffelex_token_kill (ffestb_local_.decl.lent);
22305 return (ffelexHandler) ffestb_decl_ents_;
22306
22307 case FFELEX_typeEOS:
22308 case FFELEX_typeSEMICOLON:
22309 if (!ffesta_is_inhibited ())
22310 {
22311 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
22312 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
22313 ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
22314 FALSE);
22315 ffestc_decl_finish ();
22316 }
22317 ffelex_token_kill (ffesta_tokens[1]);
22318 if (ffestb_local_.decl.kindt != NULL)
22319 ffelex_token_kill (ffestb_local_.decl.kindt);
22320 if (ffestb_subrargs_.dim_list.dims != NULL)
22321 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22322 if (ffestb_local_.decl.lent != NULL)
22323 ffelex_token_kill (ffestb_local_.decl.lent);
22324 return (ffelexHandler) ffesta_zero (t);
22325
22326 case FFELEX_typeEQUALS:
22327 if (!ffestb_local_.decl.coloncolon)
22328 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_INIT, t);
22329 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
22330 ffestb_local_.decl.parameter ? FFEEXPR_contextPARAMETER
22331 : FFEEXPR_contextINITVAL, (ffeexprCallback) ffestb_decl_ents_8_);
22332
22333 case FFELEX_typeSLASH:
22334 if (!ffesta_is_inhibited ())
22335 {
22336 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
22337 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
22338 ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
22339 TRUE);
22340 ffestc_decl_itemstartvals ();
22341 }
22342 ffelex_token_kill (ffesta_tokens[1]);
22343 if (ffestb_local_.decl.kindt != NULL)
22344 ffelex_token_kill (ffestb_local_.decl.kindt);
22345 if (ffestb_subrargs_.dim_list.dims != NULL)
22346 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22347 if (ffestb_local_.decl.lent != NULL)
22348 ffelex_token_kill (ffestb_local_.decl.lent);
22349 return (ffelexHandler) ffeexpr_rhs
22350 (ffesta_output_pool, FFEEXPR_contextDATA,
22351 (ffeexprCallback) ffestb_decl_ents_9_);
22352
22353 default:
22354 break;
22355 }
22356
22357 if (!ffesta_is_inhibited ())
22358 ffestc_decl_finish ();
22359 ffelex_token_kill (ffesta_tokens[1]);
22360 if (ffestb_local_.decl.kindt != NULL)
22361 ffelex_token_kill (ffestb_local_.decl.kindt);
22362 if (ffestb_subrargs_.dim_list.dims != NULL)
22363 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22364 if (ffestb_local_.decl.lent != NULL)
22365 ffelex_token_kill (ffestb_local_.decl.lent);
22366 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22367 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22368 }
22369
22370 /* ffestb_decl_ents_8_ -- "type" [type parameters] [attributes "::"] NAME
22371 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
22372 [ASTERISK charlength] EQUALS expr
22373
22374 (ffestb_decl_ents_8_) // to expression handler
22375
22376 Handle COMMA or EOS/SEMICOLON. */
22377
22378 static ffelexHandler
22379 ffestb_decl_ents_8_ (ffelexToken ft, ffebld expr, ffelexToken t)
22380 {
22381 switch (ffelex_token_type (t))
22382 {
22383 case FFELEX_typeCOMMA:
22384 if (expr == NULL)
22385 break;
22386 if (!ffesta_is_inhibited ())
22387 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
22388 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
22389 ffestb_local_.decl.len, ffestb_local_.decl.lent, expr, ft,
22390 FALSE);
22391 ffelex_token_kill (ffesta_tokens[1]);
22392 if (ffestb_local_.decl.kindt != NULL)
22393 ffelex_token_kill (ffestb_local_.decl.kindt);
22394 if (ffestb_subrargs_.dim_list.dims != NULL)
22395 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22396 if (ffestb_local_.decl.lent != NULL)
22397 ffelex_token_kill (ffestb_local_.decl.lent);
22398 return (ffelexHandler) ffestb_decl_ents_;
22399
22400 case FFELEX_typeEOS:
22401 case FFELEX_typeSEMICOLON:
22402 if (!ffesta_is_inhibited ())
22403 {
22404 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
22405 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
22406 ffestb_local_.decl.len, ffestb_local_.decl.lent, expr, ft,
22407 FALSE);
22408 ffestc_decl_finish ();
22409 }
22410 ffelex_token_kill (ffesta_tokens[1]);
22411 if (ffestb_local_.decl.kindt != NULL)
22412 ffelex_token_kill (ffestb_local_.decl.kindt);
22413 if (ffestb_subrargs_.dim_list.dims != NULL)
22414 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22415 if (ffestb_local_.decl.lent != NULL)
22416 ffelex_token_kill (ffestb_local_.decl.lent);
22417 return (ffelexHandler) ffesta_zero (t);
22418
22419 default:
22420 break;
22421 }
22422
22423 if (!ffesta_is_inhibited ())
22424 ffestc_decl_finish ();
22425 ffelex_token_kill (ffesta_tokens[1]);
22426 if (ffestb_local_.decl.kindt != NULL)
22427 ffelex_token_kill (ffestb_local_.decl.kindt);
22428 if (ffestb_subrargs_.dim_list.dims != NULL)
22429 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22430 if (ffestb_local_.decl.lent != NULL)
22431 ffelex_token_kill (ffestb_local_.decl.lent);
22432 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22433 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22434 }
22435
22436 /* ffestb_decl_ents_9_ -- "type" ... SLASH expr
22437
22438 (ffestb_decl_ents_9_) // to expression handler
22439
22440 Handle ASTERISK, COMMA, or SLASH. */
22441
22442 static ffelexHandler
22443 ffestb_decl_ents_9_ (ffelexToken ft, ffebld expr, ffelexToken t)
22444 {
22445 switch (ffelex_token_type (t))
22446 {
22447 case FFELEX_typeCOMMA:
22448 if (expr == NULL)
22449 break;
22450 if (!ffesta_is_inhibited ())
22451 ffestc_decl_itemvalue (NULL, NULL, expr, ft);
22452 return (ffelexHandler) ffeexpr_rhs
22453 (ffesta_output_pool, FFEEXPR_contextDATA,
22454 (ffeexprCallback) ffestb_decl_ents_9_);
22455
22456 case FFELEX_typeASTERISK:
22457 if (expr == NULL)
22458 break;
22459 ffestb_local_.decl.expr = expr;
22460 ffesta_tokens[1] = ffelex_token_use (ft);
22461 return (ffelexHandler) ffeexpr_rhs
22462 (ffesta_output_pool, FFEEXPR_contextDATA,
22463 (ffeexprCallback) ffestb_decl_ents_10_);
22464
22465 case FFELEX_typeSLASH:
22466 if (expr == NULL)
22467 break;
22468 if (!ffesta_is_inhibited ())
22469 {
22470 ffestc_decl_itemvalue (NULL, NULL, expr, ft);
22471 ffestc_decl_itemendvals (t);
22472 }
22473 return (ffelexHandler) ffestb_decl_ents_11_;
22474
22475 default:
22476 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22477 break;
22478 }
22479
22480 if (!ffesta_is_inhibited ())
22481 {
22482 ffestc_decl_itemendvals (t);
22483 ffestc_decl_finish ();
22484 }
22485 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22486 }
22487
22488 /* ffestb_decl_ents_10_ -- "type" ... SLASH expr ASTERISK expr
22489
22490 (ffestb_decl_ents_10_) // to expression handler
22491
22492 Handle COMMA or SLASH. */
22493
22494 static ffelexHandler
22495 ffestb_decl_ents_10_ (ffelexToken ft, ffebld expr, ffelexToken t)
22496 {
22497 switch (ffelex_token_type (t))
22498 {
22499 case FFELEX_typeCOMMA:
22500 if (expr == NULL)
22501 break;
22502 if (!ffesta_is_inhibited ())
22503 ffestc_decl_itemvalue (ffestb_local_.decl.expr, ffesta_tokens[1],
22504 expr, ft);
22505 ffelex_token_kill (ffesta_tokens[1]);
22506 return (ffelexHandler) ffeexpr_rhs
22507 (ffesta_output_pool, FFEEXPR_contextDATA,
22508 (ffeexprCallback) ffestb_decl_ents_9_);
22509
22510 case FFELEX_typeSLASH:
22511 if (expr == NULL)
22512 break;
22513 if (!ffesta_is_inhibited ())
22514 {
22515 ffestc_decl_itemvalue (ffestb_local_.decl.expr, ffesta_tokens[1],
22516 expr, ft);
22517 ffestc_decl_itemendvals (t);
22518 }
22519 ffelex_token_kill (ffesta_tokens[1]);
22520 return (ffelexHandler) ffestb_decl_ents_11_;
22521
22522 default:
22523 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22524 break;
22525 }
22526
22527 if (!ffesta_is_inhibited ())
22528 {
22529 ffestc_decl_itemendvals (t);
22530 ffestc_decl_finish ();
22531 }
22532 ffelex_token_kill (ffesta_tokens[1]);
22533 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22534 }
22535
22536 /* ffestb_decl_ents_11_ -- "type" [type parameters] [attributes "::"] NAME
22537 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
22538 [ASTERISK charlength] SLASH initvals SLASH
22539
22540 return ffestb_decl_ents_11_; // to lexer
22541
22542 Handle COMMA or EOS/SEMICOLON. */
22543
22544 static ffelexHandler
22545 ffestb_decl_ents_11_ (ffelexToken t)
22546 {
22547 switch (ffelex_token_type (t))
22548 {
22549 case FFELEX_typeCOMMA:
22550 return (ffelexHandler) ffestb_decl_ents_;
22551
22552 case FFELEX_typeEOS:
22553 case FFELEX_typeSEMICOLON:
22554 if (!ffesta_is_inhibited ())
22555 ffestc_decl_finish ();
22556 return (ffelexHandler) ffesta_zero (t);
22557
22558 default:
22559 break;
22560 }
22561
22562 if (!ffesta_is_inhibited ())
22563 ffestc_decl_finish ();
22564 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22565 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22566 }
22567
22568 /* ffestb_decl_entsp_ -- "type" [type parameters]
22569
22570 return ffestb_decl_entsp_; // to lexer
22571
22572 Handle NAME or NAMES beginning either an entity (object) declaration or
22573 a function definition.. */
22574
22575 static ffelexHandler
22576 ffestb_decl_entsp_ (ffelexToken t)
22577 {
22578 switch (ffelex_token_type (t))
22579 {
22580 case FFELEX_typeNAME:
22581 ffesta_confirmed ();
22582 ffesta_tokens[1] = ffelex_token_use (t);
22583 return (ffelexHandler) ffestb_decl_entsp_1_;
22584
22585 case FFELEX_typeNAMES:
22586 ffesta_confirmed ();
22587 ffesta_tokens[1] = ffelex_token_use (t);
22588 return (ffelexHandler) ffestb_decl_entsp_2_;
22589
22590 default:
22591 break;
22592 }
22593
22594 if (ffestb_local_.decl.kindt != NULL)
22595 ffelex_token_kill (ffestb_local_.decl.kindt);
22596 if (ffestb_local_.decl.lent != NULL)
22597 ffelex_token_kill (ffestb_local_.decl.lent);
22598 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22599 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22600 }
22601
22602 /* ffestb_decl_entsp_1_ -- "type" [type parameters] NAME
22603
22604 return ffestb_decl_entsp_1_; // to lexer
22605
22606 If we get another NAME token here, then the previous one must be
22607 "RECURSIVE" or "FUNCTION" and we handle it accordingly. Otherwise,
22608 we send the previous and current token through to _ents_. */
22609
22610 static ffelexHandler
22611 ffestb_decl_entsp_1_ (ffelexToken t)
22612 {
22613 switch (ffelex_token_type (t))
22614 {
22615 case FFELEX_typeNAME:
22616 switch (ffestr_first (ffesta_tokens[1]))
22617 {
22618 #if FFESTR_F90
22619 case FFESTR_firstRECURSIVE:
22620 if (ffestr_first (t) != FFESTR_firstFUNCTION)
22621 {
22622 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
22623 break;
22624 }
22625 ffestb_local_.decl.recursive = ffesta_tokens[1];
22626 return (ffelexHandler) ffestb_decl_funcname_;
22627 #endif
22628
22629 case FFESTR_firstFUNCTION:
22630 ffelex_token_kill (ffesta_tokens[1]);
22631 return (ffelexHandler) ffestb_decl_funcname_ (t);
22632
22633 default:
22634 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", ffesta_tokens[1]);
22635 break;
22636 }
22637 break;
22638
22639 default:
22640 if ((ffelex_token_type (ffesta_tokens[1]) != FFELEX_typeNAMES)
22641 && !ffesta_is_inhibited ())
22642 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
22643 ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
22644 ffestb_local_.decl.len, ffestb_local_.decl.lent);
22645 if (ffestb_local_.decl.kindt != NULL)
22646 ffelex_token_kill (ffestb_local_.decl.kindt);
22647 if (ffestb_local_.decl.lent != NULL)
22648 ffelex_token_kill (ffestb_local_.decl.lent);
22649 /* NAME/NAMES token already in ffesta_tokens[1]. */
22650 return (ffelexHandler) ffestb_decl_ents_1_ (t);
22651 }
22652
22653 if (ffestb_local_.decl.kindt != NULL)
22654 ffelex_token_kill (ffestb_local_.decl.kindt);
22655 if (ffestb_local_.decl.lent != NULL)
22656 ffelex_token_kill (ffestb_local_.decl.lent);
22657 ffelex_token_kill (ffesta_tokens[1]);
22658 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22659 }
22660
22661 /* ffestb_decl_entsp_2_ -- "type" [type parameters] NAMES
22662
22663 return ffestb_decl_entsp_2_; // to lexer
22664
22665 If we get an ASTERISK or OPEN_PAREN here, then if the previous NAMES
22666 begins with "FUNCTION" or "RECURSIVEFUNCTION" and is followed by a
22667 first-name-char, we have a possible syntactically ambiguous situation.
22668 Otherwise, we have a straightforward situation just as if we went
22669 through _entsp_1_ instead of here. */
22670
22671 static ffelexHandler
22672 ffestb_decl_entsp_2_ (ffelexToken t)
22673 {
22674 ffelexToken nt;
22675 bool asterisk_ok;
22676 unsigned const char *p;
22677 ffeTokenLength i;
22678
22679 switch (ffelex_token_type (t))
22680 {
22681 case FFELEX_typeASTERISK:
22682 ffesta_confirmed ();
22683 switch (ffestb_local_.decl.type)
22684 {
22685 case FFESTP_typeINTEGER:
22686 case FFESTP_typeREAL:
22687 case FFESTP_typeCOMPLEX:
22688 case FFESTP_typeLOGICAL:
22689 asterisk_ok = (ffestb_local_.decl.kindt == NULL);
22690 break;
22691
22692 case FFESTP_typeCHARACTER:
22693 asterisk_ok = (ffestb_local_.decl.lent == NULL);
22694 break;
22695
22696 case FFESTP_typeBYTE:
22697 case FFESTP_typeWORD:
22698 default:
22699 asterisk_ok = FALSE;
22700 break;
22701 }
22702 switch (ffestr_first (ffesta_tokens[1]))
22703 {
22704 #if FFESTR_F90
22705 case FFESTR_firstRECURSIVEFNCTN:
22706 if (!asterisk_ok)
22707 break; /* For our own convenience, treat as non-FN
22708 stmt. */
22709 p = ffelex_token_text (ffesta_tokens[1])
22710 + (i = FFESTR_firstlRECURSIVEFNCTN);
22711 if (!ffesrc_is_name_init (*p))
22712 break;
22713 ffestb_local_.decl.recursive
22714 = ffelex_token_name_from_names (ffesta_tokens[1], 0,
22715 FFESTR_firstlRECURSIVEFNCTN);
22716 ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
22717 FFESTR_firstlRECURSIVEFNCTN, 0);
22718 return (ffelexHandler) ffestb_decl_entsp_3_;
22719 #endif
22720
22721 case FFESTR_firstFUNCTION:
22722 if (!asterisk_ok)
22723 break; /* For our own convenience, treat as non-FN
22724 stmt. */
22725 p = ffelex_token_text (ffesta_tokens[1])
22726 + (i = FFESTR_firstlFUNCTION);
22727 if (!ffesrc_is_name_init (*p))
22728 break;
22729 ffestb_local_.decl.recursive = NULL;
22730 ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
22731 FFESTR_firstlFUNCTION, 0);
22732 return (ffelexHandler) ffestb_decl_entsp_3_;
22733
22734 default:
22735 break;
22736 }
22737 break;
22738
22739 case FFELEX_typeOPEN_PAREN:
22740 ffestb_local_.decl.aster_after = FALSE;
22741 switch (ffestr_first (ffesta_tokens[1]))
22742 {
22743 #if FFESTR_F90
22744 case FFESTR_firstRECURSIVEFNCTN:
22745 p = ffelex_token_text (ffesta_tokens[1])
22746 + (i = FFESTR_firstlRECURSIVEFNCTN);
22747 if (!ffesrc_is_name_init (*p))
22748 break;
22749 ffestb_local_.decl.recursive
22750 = ffelex_token_name_from_names (ffesta_tokens[1], 0,
22751 FFESTR_firstlRECURSIVEFNCTN);
22752 ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
22753 FFESTR_firstlRECURSIVEFNCTN, 0);
22754 return (ffelexHandler) ffestb_decl_entsp_5_ (t);
22755 #endif
22756
22757 case FFESTR_firstFUNCTION:
22758 p = ffelex_token_text (ffesta_tokens[1])
22759 + (i = FFESTR_firstlFUNCTION);
22760 if (!ffesrc_is_name_init (*p))
22761 break;
22762 ffestb_local_.decl.recursive = NULL;
22763 ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
22764 FFESTR_firstlFUNCTION, 0);
22765 return (ffelexHandler) ffestb_decl_entsp_5_ (t);
22766
22767 default:
22768 break;
22769 }
22770 if ((ffestb_local_.decl.kindt != NULL)
22771 || (ffestb_local_.decl.lent != NULL))
22772 break; /* Have kind/len type param, definitely not
22773 assignment stmt. */
22774 return (ffelexHandler) ffestb_decl_entsp_1_ (t);
22775
22776 default:
22777 break;
22778 }
22779
22780 nt = ffelex_token_name_from_names (ffesta_tokens[1], 0, 0);
22781 ffelex_token_kill (ffesta_tokens[1]);
22782 ffesta_tokens[1] = nt; /* Change NAMES to NAME. */
22783 return (ffelexHandler) ffestb_decl_entsp_1_ (t);
22784 }
22785
22786 /* ffestb_decl_entsp_3_ -- "type" [type parameters] [RECURSIVE] FUNCTION
22787 NAME ASTERISK
22788
22789 return ffestb_decl_entsp_3_; // to lexer
22790
22791 Handle NUMBER or OPEN_PAREN. */
22792
22793 static ffelexHandler
22794 ffestb_decl_entsp_3_ (ffelexToken t)
22795 {
22796 ffestb_local_.decl.aster_after = TRUE;
22797
22798 switch (ffelex_token_type (t))
22799 {
22800 case FFELEX_typeNUMBER:
22801 switch (ffestb_local_.decl.type)
22802 {
22803 case FFESTP_typeINTEGER:
22804 case FFESTP_typeREAL:
22805 case FFESTP_typeCOMPLEX:
22806 case FFESTP_typeLOGICAL:
22807 ffestb_local_.decl.kindt = ffelex_token_use (t);
22808 break;
22809
22810 case FFESTP_typeCHARACTER:
22811 ffestb_local_.decl.lent = ffelex_token_use (t);
22812 break;
22813
22814 case FFESTP_typeBYTE:
22815 case FFESTP_typeWORD:
22816 default:
22817 assert (FALSE);
22818 }
22819 return (ffelexHandler) ffestb_decl_entsp_5_;
22820
22821 case FFELEX_typeOPEN_PAREN:
22822 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
22823 FFEEXPR_contextCHARACTERSIZE,
22824 (ffeexprCallback) ffestb_decl_entsp_4_);
22825
22826 default:
22827 break;
22828 }
22829
22830 if (ffestb_local_.decl.recursive != NULL)
22831 ffelex_token_kill (ffestb_local_.decl.recursive);
22832 if (ffestb_local_.decl.kindt != NULL)
22833 ffelex_token_kill (ffestb_local_.decl.kindt);
22834 if (ffestb_local_.decl.lent != NULL)
22835 ffelex_token_kill (ffestb_local_.decl.lent);
22836 ffelex_token_kill (ffesta_tokens[1]);
22837 ffelex_token_kill (ffesta_tokens[2]);
22838 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
22839 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22840 }
22841
22842 /* ffestb_decl_entsp_4_ -- "type" [type parameters] [RECURSIVE] FUNCTION
22843 NAME ASTERISK OPEN_PAREN expr
22844
22845 (ffestb_decl_entsp_4_) // to expression handler
22846
22847 Allow only CLOSE_PAREN; and deal with character-length expression. */
22848
22849 static ffelexHandler
22850 ffestb_decl_entsp_4_ (ffelexToken ft, ffebld expr, ffelexToken t)
22851 {
22852 switch (ffelex_token_type (t))
22853 {
22854 case FFELEX_typeCLOSE_PAREN:
22855 if (expr == NULL)
22856 break;
22857 switch (ffestb_local_.decl.type)
22858 {
22859 case FFESTP_typeCHARACTER:
22860 ffestb_local_.decl.len = expr;
22861 ffestb_local_.decl.lent = ffelex_token_use (ft);
22862 break;
22863
22864 default:
22865 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
22866 break;
22867 }
22868 return (ffelexHandler) ffestb_decl_entsp_5_;
22869
22870 default:
22871 break;
22872 }
22873
22874 if (ffestb_local_.decl.recursive != NULL)
22875 ffelex_token_kill (ffestb_local_.decl.recursive);
22876 if (ffestb_local_.decl.kindt != NULL)
22877 ffelex_token_kill (ffestb_local_.decl.kindt);
22878 if (ffestb_local_.decl.lent != NULL)
22879 ffelex_token_kill (ffestb_local_.decl.lent);
22880 ffelex_token_kill (ffesta_tokens[1]);
22881 ffelex_token_kill (ffesta_tokens[2]);
22882 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
22883 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22884 }
22885
22886 /* ffestb_decl_entsp_5_ -- "type" [type parameters] [RECURSIVE] FUNCTION
22887 NAME [type parameter]
22888
22889 return ffestb_decl_entsp_5_; // to lexer
22890
22891 Make sure the next token is an OPEN_PAREN. Get the arg list or dimension
22892 list. If it can't be an arg list, or if the CLOSE_PAREN is followed by
22893 something other than EOS/SEMICOLON or NAME, then treat as dimension list
22894 and handle statement as an R426/R501. If it can't be a dimension list, or
22895 if the CLOSE_PAREN is followed by NAME, treat as an arg list and handle
22896 statement as an R1219. If it can be either an arg list or a dimension
22897 list and if the CLOSE_PAREN is followed by EOS/SEMICOLON, ask FFESTC
22898 whether to treat the statement as an R426/R501 or an R1219 and act
22899 accordingly. */
22900
22901 static ffelexHandler
22902 ffestb_decl_entsp_5_ (ffelexToken t)
22903 {
22904 switch (ffelex_token_type (t))
22905 {
22906 case FFELEX_typeOPEN_PAREN:
22907 if (ffestb_local_.decl.aster_after && (ffestb_local_.decl.len != NULL))
22908 { /* "CHARACTER[RECURSIVE]FUNCTIONxyz*(len-expr)
22909 (..." must be a function-stmt, since the
22910 (len-expr) cannot precede (array-spec) in
22911 an object declaration but can precede
22912 (name-list) in a function stmt. */
22913 ffelex_token_kill (ffesta_tokens[1]);
22914 ffesta_tokens[1] = ffesta_tokens[2];
22915 return (ffelexHandler) ffestb_decl_funcname_4_ (t);
22916 }
22917 ffestb_local_.decl.toklist = ffestt_tokenlist_create ();
22918 ffestb_local_.decl.empty = TRUE;
22919 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
22920 return (ffelexHandler) ffestb_decl_entsp_6_;
22921
22922 default:
22923 break;
22924 }
22925
22926 assert (ffestb_local_.decl.aster_after);
22927 ffesta_confirmed (); /* We've seen an ASTERISK, so even EQUALS
22928 confirmed. */
22929 ffestb_subr_ambig_to_ents_ ();
22930 ffestb_subrargs_.dim_list.dims = NULL;
22931 return (ffelexHandler) ffestb_decl_ents_7_ (t);
22932 }
22933
22934 /* ffestb_decl_entsp_6_ -- "type" [type parameters] [RECURSIVE] FUNCTION
22935 NAME [type parameter] OPEN_PAREN
22936
22937 return ffestb_decl_entsp_6_; // to lexer
22938
22939 If CLOSE_PAREN, we definitely have an R1219 function-stmt, since
22940 the notation "name()" is invalid for a declaration. */
22941
22942 static ffelexHandler
22943 ffestb_decl_entsp_6_ (ffelexToken t)
22944 {
22945 ffelexHandler next;
22946
22947 switch (ffelex_token_type (t))
22948 {
22949 case FFELEX_typeCLOSE_PAREN:
22950 if (!ffestb_local_.decl.empty)
22951 { /* Trailing comma, just a warning for
22952 stmt func def, so allow ambiguity. */
22953 ffestt_tokenlist_append (ffestb_local_.decl.toklist,
22954 ffelex_token_use (t));
22955 return (ffelexHandler) ffestb_decl_entsp_8_;
22956 }
22957 ffelex_token_kill (ffesta_tokens[1]);
22958 ffesta_tokens[1] = ffesta_tokens[2];
22959 next = (ffelexHandler) ffestt_tokenlist_handle
22960 (ffestb_local_.decl.toklist, (ffelexHandler) ffestb_decl_funcname_4_);
22961 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
22962 return (ffelexHandler) (*next) (t);
22963
22964 case FFELEX_typeNAME:
22965 ffestb_local_.decl.empty = FALSE;
22966 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
22967 return (ffelexHandler) ffestb_decl_entsp_7_;
22968
22969 case FFELEX_typeEQUALS:
22970 case FFELEX_typePOINTS:
22971 case FFELEX_typePERCENT:
22972 case FFELEX_typePERIOD:
22973 case FFELEX_typeOPEN_PAREN:
22974 if ((ffestb_local_.decl.kindt != NULL)
22975 || (ffestb_local_.decl.lent != NULL))
22976 break; /* type(params)name or type*val name, either
22977 way confirmed. */
22978 return (ffelexHandler) ffestb_subr_ambig_nope_ (t);
22979
22980 default:
22981 break;
22982 }
22983
22984 ffesta_confirmed ();
22985 ffestb_subr_ambig_to_ents_ ();
22986 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
22987 (ffelexHandler) ffestb_decl_ents_3_);
22988 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
22989 return (ffelexHandler) (*next) (t);
22990 }
22991
22992 /* ffestb_decl_entsp_7_ -- "type" [type parameters] [RECURSIVE] FUNCTION
22993 NAME [type parameter] OPEN_PAREN NAME
22994
22995 return ffestb_decl_entsp_7_; // to lexer
22996
22997 Expect COMMA or CLOSE_PAREN to remain ambiguous, else not an R1219
22998 function-stmt. */
22999
23000 static ffelexHandler
23001 ffestb_decl_entsp_7_ (ffelexToken t)
23002 {
23003 ffelexHandler next;
23004
23005 switch (ffelex_token_type (t))
23006 {
23007 case FFELEX_typeCLOSE_PAREN:
23008 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
23009 return (ffelexHandler) ffestb_decl_entsp_8_;
23010
23011 case FFELEX_typeCOMMA:
23012 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
23013 return (ffelexHandler) ffestb_decl_entsp_6_;
23014
23015 case FFELEX_typeEQUALS:
23016 case FFELEX_typePOINTS:
23017 case FFELEX_typePERCENT:
23018 case FFELEX_typePERIOD:
23019 case FFELEX_typeOPEN_PAREN:
23020 if ((ffestb_local_.decl.kindt != NULL)
23021 || (ffestb_local_.decl.lent != NULL))
23022 break; /* type(params)name or type*val name, either
23023 way confirmed. */
23024 return (ffelexHandler) ffestb_subr_ambig_nope_ (t);
23025
23026 default:
23027 break;
23028 }
23029
23030 ffesta_confirmed ();
23031 ffestb_subr_ambig_to_ents_ ();
23032 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
23033 (ffelexHandler) ffestb_decl_ents_3_);
23034 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
23035 return (ffelexHandler) (*next) (t);
23036 }
23037
23038 /* ffestb_decl_entsp_8_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23039 NAME [type parameter] OPEN_PAREN name-list
23040 CLOSE_PAREN
23041
23042 return ffestb_decl_entsp_8_; // to lexer
23043
23044 If EOS/SEMICOLON, situation remains ambiguous, ask FFESTC to resolve
23045 it. If NAME (must be "RESULT", but that is checked later on),
23046 definitely an R1219 function-stmt. Anything else, handle as entity decl. */
23047
23048 static ffelexHandler
23049 ffestb_decl_entsp_8_ (ffelexToken t)
23050 {
23051 ffelexHandler next;
23052
23053 switch (ffelex_token_type (t))
23054 {
23055 case FFELEX_typeEOS:
23056 case FFELEX_typeSEMICOLON:
23057 ffesta_confirmed ();
23058 if (ffestc_is_decl_not_R1219 ())
23059 break;
23060 /* Fall through. */
23061 case FFELEX_typeNAME:
23062 ffesta_confirmed ();
23063 ffelex_token_kill (ffesta_tokens[1]);
23064 ffesta_tokens[1] = ffesta_tokens[2];
23065 next = (ffelexHandler) ffestt_tokenlist_handle
23066 (ffestb_local_.decl.toklist, (ffelexHandler) ffestb_decl_funcname_4_);
23067 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
23068 return (ffelexHandler) (*next) (t);
23069
23070 case FFELEX_typeEQUALS:
23071 case FFELEX_typePOINTS:
23072 case FFELEX_typePERCENT:
23073 case FFELEX_typePERIOD:
23074 case FFELEX_typeOPEN_PAREN:
23075 if ((ffestb_local_.decl.kindt != NULL)
23076 || (ffestb_local_.decl.lent != NULL))
23077 break; /* type(params)name or type*val name, either
23078 way confirmed. */
23079 return (ffelexHandler) ffestb_subr_ambig_nope_ (t);
23080
23081 default:
23082 break;
23083 }
23084
23085 ffesta_confirmed ();
23086 ffestb_subr_ambig_to_ents_ ();
23087 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
23088 (ffelexHandler) ffestb_decl_ents_3_);
23089 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
23090 return (ffelexHandler) (*next) (t);
23091 }
23092
23093 /* ffestb_decl_func_ -- ["type" [type parameters]] RECURSIVE
23094
23095 return ffestb_decl_func_; // to lexer
23096
23097 Handle "FUNCTION". */
23098
23099 #if FFESTR_F90
23100 static ffelexHandler
23101 ffestb_decl_func_ (ffelexToken t)
23102 {
23103 const char *p;
23104 ffeTokenLength i;
23105
23106 ffelex_set_names (FALSE);
23107
23108 switch (ffelex_token_type (t))
23109 {
23110 case FFELEX_typeNAME:
23111 if (ffestr_first (t) != FFESTR_firstFUNCTION)
23112 break;
23113 return (ffelexHandler) ffestb_decl_funcname_;
23114
23115 case FFELEX_typeNAMES:
23116 ffesta_confirmed ();
23117 if (ffestr_first (t) != FFESTR_firstFUNCTION)
23118 break;
23119 p = ffelex_token_text (t) + (i = FFESTR_firstlFUNCTION);
23120 if (*p == '\0')
23121 break;
23122 if (!ffesrc_is_name_init (*p))
23123 goto bad_i; /* :::::::::::::::::::: */
23124 ffesta_tokens[1] = ffelex_token_name_from_names (t, i, 0);
23125 return (ffelexHandler) ffestb_decl_funcname_1_;
23126
23127 default:
23128 break;
23129 }
23130
23131 if (ffestb_local_.decl.recursive != NULL)
23132 ffelex_token_kill (ffestb_local_.decl.recursive);
23133 if (ffestb_local_.decl.kindt != NULL)
23134 ffelex_token_kill (ffestb_local_.decl.kindt);
23135 if (ffestb_local_.decl.lent != NULL)
23136 ffelex_token_kill (ffestb_local_.decl.lent);
23137 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23138 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23139
23140 bad_i: /* :::::::::::::::::::: */
23141 if (ffestb_local_.decl.recursive != NULL)
23142 ffelex_token_kill (ffestb_local_.decl.recursive);
23143 if (ffestb_local_.decl.kindt != NULL)
23144 ffelex_token_kill (ffestb_local_.decl.kindt);
23145 if (ffestb_local_.decl.lent != NULL)
23146 ffelex_token_kill (ffestb_local_.decl.lent);
23147 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t, i, NULL);
23148 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23149 }
23150
23151 #endif
23152 /* ffestb_decl_funcname_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23153
23154 return ffestb_decl_funcname_; // to lexer
23155
23156 Handle NAME of a function. */
23157
23158 static ffelexHandler
23159 ffestb_decl_funcname_ (ffelexToken t)
23160 {
23161 switch (ffelex_token_type (t))
23162 {
23163 case FFELEX_typeNAME:
23164 ffesta_tokens[1] = ffelex_token_use (t);
23165 return (ffelexHandler) ffestb_decl_funcname_1_;
23166
23167 default:
23168 break;
23169 }
23170
23171 if (ffestb_local_.decl.recursive != NULL)
23172 ffelex_token_kill (ffestb_local_.decl.recursive);
23173 if (ffestb_local_.decl.kindt != NULL)
23174 ffelex_token_kill (ffestb_local_.decl.kindt);
23175 if (ffestb_local_.decl.lent != NULL)
23176 ffelex_token_kill (ffestb_local_.decl.lent);
23177 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23178 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23179 }
23180
23181 /* ffestb_decl_funcname_1_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23182 NAME
23183
23184 return ffestb_decl_funcname_1_; // to lexer
23185
23186 Handle ASTERISK or OPEN_PAREN. */
23187
23188 static ffelexHandler
23189 ffestb_decl_funcname_1_ (ffelexToken t)
23190 {
23191 switch (ffelex_token_type (t))
23192 {
23193 case FFELEX_typeASTERISK:
23194 return (ffelexHandler) ffestb_decl_funcname_2_;
23195
23196 case FFELEX_typeOPEN_PAREN:
23197 return (ffelexHandler) ffestb_decl_funcname_4_ (t);
23198
23199 default:
23200 break;
23201 }
23202
23203 if (ffestb_local_.decl.recursive != NULL)
23204 ffelex_token_kill (ffestb_local_.decl.recursive);
23205 if (ffestb_local_.decl.kindt != NULL)
23206 ffelex_token_kill (ffestb_local_.decl.kindt);
23207 if (ffestb_local_.decl.lent != NULL)
23208 ffelex_token_kill (ffestb_local_.decl.lent);
23209 ffelex_token_kill (ffesta_tokens[1]);
23210 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23211 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23212 }
23213
23214 /* ffestb_decl_funcname_2_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23215 NAME ASTERISK
23216
23217 return ffestb_decl_funcname_2_; // to lexer
23218
23219 Handle NUMBER or OPEN_PAREN. */
23220
23221 static ffelexHandler
23222 ffestb_decl_funcname_2_ (ffelexToken t)
23223 {
23224 switch (ffelex_token_type (t))
23225 {
23226 case FFELEX_typeNUMBER:
23227 switch (ffestb_local_.decl.type)
23228 {
23229 case FFESTP_typeINTEGER:
23230 case FFESTP_typeREAL:
23231 case FFESTP_typeCOMPLEX:
23232 case FFESTP_typeLOGICAL:
23233 if (ffestb_local_.decl.kindt == NULL)
23234 ffestb_local_.decl.kindt = ffelex_token_use (t);
23235 else
23236 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23237 break;
23238
23239 case FFESTP_typeCHARACTER:
23240 if (ffestb_local_.decl.lent == NULL)
23241 ffestb_local_.decl.lent = ffelex_token_use (t);
23242 else
23243 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23244 break;
23245
23246 case FFESTP_typeBYTE:
23247 case FFESTP_typeWORD:
23248 default:
23249 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23250 break;
23251 }
23252 return (ffelexHandler) ffestb_decl_funcname_4_;
23253
23254 case FFELEX_typeOPEN_PAREN:
23255 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
23256 FFEEXPR_contextCHARACTERSIZE,
23257 (ffeexprCallback) ffestb_decl_funcname_3_);
23258
23259 default:
23260 break;
23261 }
23262
23263 if (ffestb_local_.decl.recursive != NULL)
23264 ffelex_token_kill (ffestb_local_.decl.recursive);
23265 if (ffestb_local_.decl.kindt != NULL)
23266 ffelex_token_kill (ffestb_local_.decl.kindt);
23267 if (ffestb_local_.decl.lent != NULL)
23268 ffelex_token_kill (ffestb_local_.decl.lent);
23269 ffelex_token_kill (ffesta_tokens[1]);
23270 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23271 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23272 }
23273
23274 /* ffestb_decl_funcname_3_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23275 NAME ASTERISK OPEN_PAREN expr
23276
23277 (ffestb_decl_funcname_3_) // to expression handler
23278
23279 Allow only CLOSE_PAREN; and deal with character-length expression. */
23280
23281 static ffelexHandler
23282 ffestb_decl_funcname_3_ (ffelexToken ft, ffebld expr, ffelexToken t)
23283 {
23284 switch (ffelex_token_type (t))
23285 {
23286 case FFELEX_typeCLOSE_PAREN:
23287 if (expr == NULL)
23288 break;
23289 switch (ffestb_local_.decl.type)
23290 {
23291 case FFESTP_typeCHARACTER:
23292 if (ffestb_local_.decl.lent == NULL)
23293 {
23294 ffestb_local_.decl.len = expr;
23295 ffestb_local_.decl.lent = ffelex_token_use (ft);
23296 }
23297 else
23298 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23299 break;
23300
23301 default:
23302 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23303 break;
23304 }
23305 return (ffelexHandler) ffestb_decl_funcname_4_;
23306
23307 default:
23308 break;
23309 }
23310
23311 if (ffestb_local_.decl.recursive != NULL)
23312 ffelex_token_kill (ffestb_local_.decl.recursive);
23313 if (ffestb_local_.decl.kindt != NULL)
23314 ffelex_token_kill (ffestb_local_.decl.kindt);
23315 if (ffestb_local_.decl.lent != NULL)
23316 ffelex_token_kill (ffestb_local_.decl.lent);
23317 ffelex_token_kill (ffesta_tokens[1]);
23318 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23319 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23320 }
23321
23322 /* ffestb_decl_funcname_4_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23323 NAME [type parameter]
23324
23325 return ffestb_decl_funcname_4_; // to lexer
23326
23327 Make sure the next token is an OPEN_PAREN. Get the arg list and
23328 then implement. */
23329
23330 static ffelexHandler
23331 ffestb_decl_funcname_4_ (ffelexToken t)
23332 {
23333 switch (ffelex_token_type (t))
23334 {
23335 case FFELEX_typeOPEN_PAREN:
23336 ffestb_subrargs_.name_list.args = ffestt_tokenlist_create ();
23337 ffestb_subrargs_.name_list.handler
23338 = (ffelexHandler) ffestb_decl_funcname_5_;
23339 ffestb_subrargs_.name_list.is_subr = FALSE;
23340 ffestb_subrargs_.name_list.names = FALSE;
23341 return (ffelexHandler) ffestb_subr_name_list_;
23342
23343 default:
23344 break;
23345 }
23346
23347 if (ffestb_local_.decl.recursive != NULL)
23348 ffelex_token_kill (ffestb_local_.decl.recursive);
23349 if (ffestb_local_.decl.kindt != NULL)
23350 ffelex_token_kill (ffestb_local_.decl.kindt);
23351 if (ffestb_local_.decl.lent != NULL)
23352 ffelex_token_kill (ffestb_local_.decl.lent);
23353 ffelex_token_kill (ffesta_tokens[1]);
23354 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23355 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23356 }
23357
23358 /* ffestb_decl_funcname_5_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23359 NAME [type parameter] OPEN_PAREN arg-list
23360 CLOSE_PAREN
23361
23362 return ffestb_decl_funcname_5_; // to lexer
23363
23364 Must have EOS/SEMICOLON or "RESULT" here. */
23365
23366 static ffelexHandler
23367 ffestb_decl_funcname_5_ (ffelexToken t)
23368 {
23369 if (!ffestb_subrargs_.name_list.ok)
23370 goto bad; /* :::::::::::::::::::: */
23371
23372 switch (ffelex_token_type (t))
23373 {
23374 case FFELEX_typeEOS:
23375 case FFELEX_typeSEMICOLON:
23376 ffesta_confirmed ();
23377 if (!ffesta_is_inhibited ())
23378 ffestc_R1219 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
23379 ffestb_subrargs_.name_list.close_paren, ffestb_local_.decl.type,
23380 ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
23381 ffestb_local_.decl.len, ffestb_local_.decl.lent,
23382 ffestb_local_.decl.recursive, NULL);
23383 if (ffestb_local_.decl.recursive != NULL)
23384 ffelex_token_kill (ffestb_local_.decl.recursive);
23385 if (ffestb_local_.decl.kindt != NULL)
23386 ffelex_token_kill (ffestb_local_.decl.kindt);
23387 if (ffestb_local_.decl.lent != NULL)
23388 ffelex_token_kill (ffestb_local_.decl.lent);
23389 ffelex_token_kill (ffesta_tokens[1]);
23390 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
23391 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
23392 return (ffelexHandler) ffesta_zero (t);
23393
23394 case FFELEX_typeNAME:
23395 if (ffestr_other (t) != FFESTR_otherRESULT)
23396 break;
23397 return (ffelexHandler) ffestb_decl_funcname_6_;
23398
23399 default:
23400 break;
23401 }
23402
23403 bad: /* :::::::::::::::::::: */
23404 if (ffestb_local_.decl.recursive != NULL)
23405 ffelex_token_kill (ffestb_local_.decl.recursive);
23406 if (ffestb_local_.decl.kindt != NULL)
23407 ffelex_token_kill (ffestb_local_.decl.kindt);
23408 if (ffestb_local_.decl.lent != NULL)
23409 ffelex_token_kill (ffestb_local_.decl.lent);
23410 ffelex_token_kill (ffesta_tokens[1]);
23411 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
23412 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
23413 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23414 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23415 }
23416
23417 /* ffestb_decl_funcname_6_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23418 NAME [type parameter] OPEN_PAREN arglist
23419 CLOSE_PAREN "RESULT"
23420
23421 return ffestb_decl_funcname_6_; // to lexer
23422
23423 Make sure the next token is an OPEN_PAREN. */
23424
23425 static ffelexHandler
23426 ffestb_decl_funcname_6_ (ffelexToken t)
23427 {
23428 switch (ffelex_token_type (t))
23429 {
23430 case FFELEX_typeOPEN_PAREN:
23431 return (ffelexHandler) ffestb_decl_funcname_7_;
23432
23433 default:
23434 break;
23435 }
23436
23437 if (ffestb_local_.decl.recursive != NULL)
23438 ffelex_token_kill (ffestb_local_.decl.recursive);
23439 if (ffestb_local_.decl.kindt != NULL)
23440 ffelex_token_kill (ffestb_local_.decl.kindt);
23441 if (ffestb_local_.decl.lent != NULL)
23442 ffelex_token_kill (ffestb_local_.decl.lent);
23443 ffelex_token_kill (ffesta_tokens[1]);
23444 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
23445 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
23446 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23447 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23448 }
23449
23450 /* ffestb_decl_funcname_7_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23451 NAME [type parameter] OPEN_PAREN arglist
23452 CLOSE_PAREN "RESULT" OPEN_PAREN
23453
23454 return ffestb_decl_funcname_7_; // to lexer
23455
23456 Make sure the next token is a NAME. */
23457
23458 static ffelexHandler
23459 ffestb_decl_funcname_7_ (ffelexToken t)
23460 {
23461 switch (ffelex_token_type (t))
23462 {
23463 case FFELEX_typeNAME:
23464 ffesta_tokens[2] = ffelex_token_use (t);
23465 return (ffelexHandler) ffestb_decl_funcname_8_;
23466
23467 default:
23468 break;
23469 }
23470
23471 if (ffestb_local_.decl.recursive != NULL)
23472 ffelex_token_kill (ffestb_local_.decl.recursive);
23473 if (ffestb_local_.decl.kindt != NULL)
23474 ffelex_token_kill (ffestb_local_.decl.kindt);
23475 if (ffestb_local_.decl.lent != NULL)
23476 ffelex_token_kill (ffestb_local_.decl.lent);
23477 ffelex_token_kill (ffesta_tokens[1]);
23478 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
23479 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
23480 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23481 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23482 }
23483
23484 /* ffestb_decl_funcname_8_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23485 NAME [type parameter] OPEN_PAREN arglist
23486 CLOSE_PAREN "RESULT" OPEN_PAREN NAME
23487
23488 return ffestb_decl_funcname_8_; // to lexer
23489
23490 Make sure the next token is a CLOSE_PAREN. */
23491
23492 static ffelexHandler
23493 ffestb_decl_funcname_8_ (ffelexToken t)
23494 {
23495 switch (ffelex_token_type (t))
23496 {
23497 case FFELEX_typeCLOSE_PAREN:
23498 return (ffelexHandler) ffestb_decl_funcname_9_;
23499
23500 default:
23501 break;
23502 }
23503
23504 if (ffestb_local_.decl.recursive != NULL)
23505 ffelex_token_kill (ffestb_local_.decl.recursive);
23506 if (ffestb_local_.decl.kindt != NULL)
23507 ffelex_token_kill (ffestb_local_.decl.kindt);
23508 if (ffestb_local_.decl.lent != NULL)
23509 ffelex_token_kill (ffestb_local_.decl.lent);
23510 ffelex_token_kill (ffesta_tokens[1]);
23511 ffelex_token_kill (ffesta_tokens[2]);
23512 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
23513 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
23514 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23515 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23516 }
23517
23518 /* ffestb_decl_funcname_9_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23519 NAME [type parameter] OPEN_PAREN arg-list
23520 CLOSE_PAREN "RESULT" OPEN_PAREN NAME CLOSE_PAREN
23521
23522 return ffestb_decl_funcname_9_; // to lexer
23523
23524 Must have EOS/SEMICOLON here. */
23525
23526 static ffelexHandler
23527 ffestb_decl_funcname_9_ (ffelexToken t)
23528 {
23529 switch (ffelex_token_type (t))
23530 {
23531 case FFELEX_typeEOS:
23532 case FFELEX_typeSEMICOLON:
23533 if (!ffesta_is_inhibited ())
23534 ffestc_R1219 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
23535 ffestb_subrargs_.name_list.close_paren, ffestb_local_.decl.type,
23536 ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
23537 ffestb_local_.decl.len, ffestb_local_.decl.lent,
23538 ffestb_local_.decl.recursive, ffesta_tokens[2]);
23539 if (ffestb_local_.decl.recursive != NULL)
23540 ffelex_token_kill (ffestb_local_.decl.recursive);
23541 if (ffestb_local_.decl.kindt != NULL)
23542 ffelex_token_kill (ffestb_local_.decl.kindt);
23543 if (ffestb_local_.decl.lent != NULL)
23544 ffelex_token_kill (ffestb_local_.decl.lent);
23545 ffelex_token_kill (ffesta_tokens[1]);
23546 ffelex_token_kill (ffesta_tokens[2]);
23547 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
23548 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
23549 return (ffelexHandler) ffesta_zero (t);
23550
23551 default:
23552 break;
23553 }
23554
23555 if (ffestb_local_.decl.recursive != NULL)
23556 ffelex_token_kill (ffestb_local_.decl.recursive);
23557 if (ffestb_local_.decl.kindt != NULL)
23558 ffelex_token_kill (ffestb_local_.decl.kindt);
23559 if (ffestb_local_.decl.lent != NULL)
23560 ffelex_token_kill (ffestb_local_.decl.lent);
23561 ffelex_token_kill (ffesta_tokens[1]);
23562 ffelex_token_kill (ffesta_tokens[2]);
23563 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
23564 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
23565 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23566 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23567 }
23568
23569 /* ffestb_V003 -- Parse the STRUCTURE statement
23570
23571 return ffestb_V003; // to lexer
23572
23573 Make sure the statement has a valid form for the STRUCTURE statement.
23574 If it does, implement the statement. */
23575
23576 #if FFESTR_VXT
23577 ffelexHandler
23578 ffestb_V003 (ffelexToken t)
23579 {
23580 ffeTokenLength i;
23581 const char *p;
23582 ffelexToken nt;
23583 ffelexHandler next;
23584
23585 switch (ffelex_token_type (ffesta_tokens[0]))
23586 {
23587 case FFELEX_typeNAME:
23588 if (ffesta_first_kw != FFESTR_firstSTRUCTURE)
23589 goto bad_0; /* :::::::::::::::::::: */
23590 switch (ffelex_token_type (t))
23591 {
23592 case FFELEX_typeCOMMA:
23593 case FFELEX_typeCOLONCOLON:
23594 case FFELEX_typeEOS:
23595 case FFELEX_typeSEMICOLON:
23596 ffesta_confirmed (); /* Error, but clearly intended. */
23597 goto bad_1; /* :::::::::::::::::::: */
23598
23599 default:
23600 goto bad_1; /* :::::::::::::::::::: */
23601
23602 case FFELEX_typeNAME:
23603 ffesta_confirmed ();
23604 if (!ffesta_is_inhibited ())
23605 ffestc_V003_start (NULL);
23606 ffestb_local_.structure.started = TRUE;
23607 return (ffelexHandler) ffestb_V0034_ (t);
23608
23609 case FFELEX_typeSLASH:
23610 ffesta_confirmed ();
23611 return (ffelexHandler) ffestb_V0031_;
23612 }
23613
23614 case FFELEX_typeNAMES:
23615 if (ffesta_first_kw != FFESTR_firstSTRUCTURE)
23616 goto bad_0; /* :::::::::::::::::::: */
23617 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSTRUCTURE);
23618 switch (ffelex_token_type (t))
23619 {
23620 default:
23621 goto bad_1; /* :::::::::::::::::::: */
23622
23623 case FFELEX_typeEOS:
23624 case FFELEX_typeSEMICOLON:
23625 case FFELEX_typeCOMMA:
23626 case FFELEX_typeCOLONCOLON:
23627 ffesta_confirmed ();
23628 break;
23629
23630 case FFELEX_typeSLASH:
23631 ffesta_confirmed ();
23632 if (*p != '\0')
23633 goto bad_1; /* :::::::::::::::::::: */
23634 return (ffelexHandler) ffestb_V0031_;
23635
23636 case FFELEX_typeOPEN_PAREN:
23637 break;
23638 }
23639
23640 /* Here, we have at least one char after "STRUCTURE" and t is COMMA,
23641 EOS/SEMICOLON, or OPEN_PAREN. */
23642
23643 if (!ffesrc_is_name_init (*p))
23644 goto bad_i; /* :::::::::::::::::::: */
23645 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
23646 if (ffelex_token_type (t) == FFELEX_typeOPEN_PAREN)
23647 ffestb_local_.structure.started = FALSE;
23648 else
23649 {
23650 if (!ffesta_is_inhibited ())
23651 ffestc_V003_start (NULL);
23652 ffestb_local_.structure.started = TRUE;
23653 }
23654 next = (ffelexHandler) ffestb_V0034_ (nt);
23655 ffelex_token_kill (nt);
23656 return (ffelexHandler) (*next) (t);
23657
23658 default:
23659 goto bad_0; /* :::::::::::::::::::: */
23660 }
23661
23662 bad_0: /* :::::::::::::::::::: */
23663 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", ffesta_tokens[0]);
23664 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23665
23666 bad_1: /* :::::::::::::::::::: */
23667 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
23668 return (ffelexHandler) ffelex_swallow_tokens (t,
23669 (ffelexHandler) ffesta_zero); /* Invalid second token. */
23670
23671 bad_i: /* :::::::::::::::::::: */
23672 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", ffesta_tokens[0], i, t);
23673 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23674 }
23675
23676 /* ffestb_V0031_ -- "STRUCTURE" SLASH
23677
23678 return ffestb_V0031_; // to lexer
23679
23680 Handle NAME. */
23681
23682 static ffelexHandler
23683 ffestb_V0031_ (ffelexToken t)
23684 {
23685 switch (ffelex_token_type (t))
23686 {
23687 case FFELEX_typeNAME:
23688 ffesta_tokens[1] = ffelex_token_use (t);
23689 return (ffelexHandler) ffestb_V0032_;
23690
23691 default:
23692 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
23693 break;
23694 }
23695
23696 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23697 }
23698
23699 /* ffestb_V0032_ -- "STRUCTURE" SLASH NAME
23700
23701 return ffestb_V0032_; // to lexer
23702
23703 Handle SLASH. */
23704
23705 static ffelexHandler
23706 ffestb_V0032_ (ffelexToken t)
23707 {
23708 switch (ffelex_token_type (t))
23709 {
23710 case FFELEX_typeSLASH:
23711 if (!ffesta_is_inhibited ())
23712 ffestc_V003_start (ffesta_tokens[1]);
23713 ffestb_local_.structure.started = TRUE;
23714 ffelex_token_kill (ffesta_tokens[1]);
23715 return (ffelexHandler) ffestb_V0033_;
23716
23717 default:
23718 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
23719 break;
23720 }
23721
23722 ffelex_token_kill (ffesta_tokens[1]);
23723 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23724 }
23725
23726 /* ffestb_V0033_ -- "STRUCTURE" SLASH NAME SLASH
23727
23728 return ffestb_V0033_; // to lexer
23729
23730 Handle NAME or EOS/SEMICOLON. */
23731
23732 static ffelexHandler
23733 ffestb_V0033_ (ffelexToken t)
23734 {
23735 switch (ffelex_token_type (t))
23736 {
23737 case FFELEX_typeNAME:
23738 return (ffelexHandler) ffestb_V0034_ (t);
23739
23740 case FFELEX_typeEOS:
23741 case FFELEX_typeSEMICOLON:
23742 if (!ffesta_is_inhibited ())
23743 ffestc_V003_finish ();
23744 return (ffelexHandler) ffesta_zero (t);
23745
23746 default:
23747 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
23748 break;
23749 }
23750
23751 ffelex_token_kill (ffesta_tokens[1]);
23752 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23753 }
23754
23755 /* ffestb_V0034_ -- "STRUCTURE" [SLASH NAME SLASH]
23756
23757 return ffestb_V0034_; // to lexer
23758
23759 Handle NAME. */
23760
23761 static ffelexHandler
23762 ffestb_V0034_ (ffelexToken t)
23763 {
23764 switch (ffelex_token_type (t))
23765 {
23766 case FFELEX_typeNAME:
23767 ffesta_tokens[1] = ffelex_token_use (t);
23768 return (ffelexHandler) ffestb_V0035_;
23769
23770 default:
23771 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
23772 break;
23773 }
23774
23775 if (!ffesta_is_inhibited ())
23776 ffestc_V003_finish ();
23777 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23778 }
23779
23780 /* ffestb_V0035_ -- "STRUCTURE" ... NAME
23781
23782 return ffestb_V0035_; // to lexer
23783
23784 Handle OPEN_PAREN. */
23785
23786 static ffelexHandler
23787 ffestb_V0035_ (ffelexToken t)
23788 {
23789 switch (ffelex_token_type (t))
23790 {
23791 case FFELEX_typeOPEN_PAREN:
23792 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
23793 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_V0036_;
23794 ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
23795 ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLISTCOMMON;
23796 #ifdef FFECOM_dimensionsMAX
23797 ffestb_subrargs_.dim_list.ndims = 0;
23798 #endif
23799 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
23800 FFEEXPR_contextDIMLISTCOMMON, (ffeexprCallback) ffestb_subr_dimlist_);
23801
23802 case FFELEX_typeCOMMA:
23803 if (!ffesta_is_inhibited ())
23804 ffestc_V003_item (ffesta_tokens[1], NULL);
23805 ffelex_token_kill (ffesta_tokens[1]);
23806 return (ffelexHandler) ffestb_V0034_;
23807
23808 case FFELEX_typeEOS:
23809 case FFELEX_typeSEMICOLON:
23810 if (!ffesta_is_inhibited ())
23811 {
23812 ffestc_V003_item (ffesta_tokens[1], NULL);
23813 ffestc_V003_finish ();
23814 }
23815 ffelex_token_kill (ffesta_tokens[1]);
23816 return (ffelexHandler) ffesta_zero (t);
23817
23818 default:
23819 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
23820 break;
23821 }
23822
23823 if (!ffesta_is_inhibited ())
23824 ffestc_V003_finish ();
23825 ffelex_token_kill (ffesta_tokens[1]);
23826 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23827 }
23828
23829 /* ffestb_V0036_ -- "STRUCTURE" ... NAME OPEN_PAREN dimlist CLOSE_PAREN
23830
23831 return ffestb_V0036_; // to lexer
23832
23833 Handle COMMA or EOS/SEMICOLON. */
23834
23835 static ffelexHandler
23836 ffestb_V0036_ (ffelexToken t)
23837 {
23838 if (!ffestb_subrargs_.dim_list.ok)
23839 goto bad; /* :::::::::::::::::::: */
23840
23841 switch (ffelex_token_type (t))
23842 {
23843 case FFELEX_typeCOMMA:
23844 ffesta_confirmed ();
23845 if (!ffesta_is_inhibited ())
23846 {
23847 if (!ffestb_local_.structure.started)
23848 {
23849 ffestc_V003_start (NULL);
23850 ffestb_local_.structure.started = TRUE;
23851 }
23852 ffestc_V003_item (ffesta_tokens[1],
23853 ffestb_subrargs_.dim_list.dims);
23854 }
23855 ffelex_token_kill (ffesta_tokens[1]);
23856 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
23857 return (ffelexHandler) ffestb_V0034_;
23858
23859 case FFELEX_typeEOS:
23860 case FFELEX_typeSEMICOLON:
23861 ffesta_confirmed ();
23862 if (!ffesta_is_inhibited ())
23863 {
23864 if (!ffestb_local_.structure.started)
23865 ffestc_V003_start (NULL);
23866 ffestc_V003_item (ffesta_tokens[1],
23867 ffestb_subrargs_.dim_list.dims);
23868 ffestc_V003_finish ();
23869 }
23870 ffelex_token_kill (ffesta_tokens[1]);
23871 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
23872 return (ffelexHandler) ffesta_zero (t);
23873
23874 default:
23875 break;
23876 }
23877
23878 bad: /* :::::::::::::::::::: */
23879 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
23880 if (ffestb_local_.structure.started && !ffesta_is_inhibited ())
23881 ffestc_V003_finish ();
23882 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
23883 ffelex_token_kill (ffesta_tokens[1]);
23884 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23885 }
23886
23887 /* ffestb_V016 -- Parse the RECORD statement
23888
23889 return ffestb_V016; // to lexer
23890
23891 Make sure the statement has a valid form for the RECORD statement. If it
23892 does, implement the statement. */
23893
23894 ffelexHandler
23895 ffestb_V016 (ffelexToken t)
23896 {
23897 const char *p;
23898 ffeTokenLength i;
23899
23900 switch (ffelex_token_type (ffesta_tokens[0]))
23901 {
23902 case FFELEX_typeNAME:
23903 if (ffesta_first_kw != FFESTR_firstRECORD)
23904 goto bad_0; /* :::::::::::::::::::: */
23905 break;
23906
23907 case FFELEX_typeNAMES:
23908 if (ffesta_first_kw != FFESTR_firstRECORD)
23909 goto bad_0; /* :::::::::::::::::::: */
23910 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlRECORD);
23911 if (*p != '\0')
23912 goto bad_i; /* :::::::::::::::::::: */
23913 break;
23914
23915 default:
23916 goto bad_0; /* :::::::::::::::::::: */
23917 }
23918
23919 switch (ffelex_token_type (t))
23920 {
23921 case FFELEX_typeCOMMA:
23922 case FFELEX_typeEOS:
23923 case FFELEX_typeSEMICOLON:
23924 case FFELEX_typeCOLONCOLON:
23925 ffesta_confirmed (); /* Error, but clearly intended. */
23926 goto bad_1; /* :::::::::::::::::::: */
23927
23928 default:
23929 goto bad_1; /* :::::::::::::::::::: */
23930
23931 case FFELEX_typeSLASH:
23932 break;
23933 }
23934
23935 ffesta_confirmed ();
23936 if (!ffesta_is_inhibited ())
23937 ffestc_V016_start ();
23938 return (ffelexHandler) ffestb_V0161_;
23939
23940 bad_0: /* :::::::::::::::::::: */
23941 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", ffesta_tokens[0]);
23942 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23943
23944 bad_1: /* :::::::::::::::::::: */
23945 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
23946 return (ffelexHandler) ffelex_swallow_tokens (t,
23947 (ffelexHandler) ffesta_zero); /* Invalid second token. */
23948
23949 bad_i: /* :::::::::::::::::::: */
23950 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "RECORD", ffesta_tokens[0], i, t);
23951 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23952 }
23953
23954 /* ffestb_V0161_ -- "RECORD" SLASH
23955
23956 return ffestb_V0161_; // to lexer
23957
23958 Handle NAME. */
23959
23960 static ffelexHandler
23961 ffestb_V0161_ (ffelexToken t)
23962 {
23963 switch (ffelex_token_type (t))
23964 {
23965 case FFELEX_typeNAME:
23966 if (!ffesta_is_inhibited ())
23967 ffestc_V016_item_structure (t);
23968 return (ffelexHandler) ffestb_V0162_;
23969
23970 default:
23971 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
23972 break;
23973 }
23974
23975 if (!ffesta_is_inhibited ())
23976 ffestc_V016_finish ();
23977 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23978 }
23979
23980 /* ffestb_V0162_ -- "RECORD" SLASH NAME
23981
23982 return ffestb_V0162_; // to lexer
23983
23984 Handle SLASH. */
23985
23986 static ffelexHandler
23987 ffestb_V0162_ (ffelexToken t)
23988 {
23989 switch (ffelex_token_type (t))
23990 {
23991 case FFELEX_typeSLASH:
23992 return (ffelexHandler) ffestb_V0163_;
23993
23994 default:
23995 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
23996 break;
23997 }
23998
23999 if (!ffesta_is_inhibited ())
24000 ffestc_V016_finish ();
24001 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24002 }
24003
24004 /* ffestb_V0163_ -- "RECORD" SLASH NAME SLASH
24005
24006 return ffestb_V0163_; // to lexer
24007
24008 Handle NAME. */
24009
24010 static ffelexHandler
24011 ffestb_V0163_ (ffelexToken t)
24012 {
24013 switch (ffelex_token_type (t))
24014 {
24015 case FFELEX_typeNAME:
24016 ffesta_tokens[1] = ffelex_token_use (t);
24017 return (ffelexHandler) ffestb_V0164_;
24018
24019 default:
24020 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
24021 break;
24022 }
24023
24024 if (!ffesta_is_inhibited ())
24025 ffestc_V016_finish ();
24026 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24027 }
24028
24029 /* ffestb_V0164_ -- "RECORD" ... NAME
24030
24031 return ffestb_V0164_; // to lexer
24032
24033 Handle OPEN_PAREN. */
24034
24035 static ffelexHandler
24036 ffestb_V0164_ (ffelexToken t)
24037 {
24038 switch (ffelex_token_type (t))
24039 {
24040 case FFELEX_typeOPEN_PAREN:
24041 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
24042 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_V0165_;
24043 ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
24044 ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLISTCOMMON;
24045 #ifdef FFECOM_dimensionsMAX
24046 ffestb_subrargs_.dim_list.ndims = 0;
24047 #endif
24048 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
24049 FFEEXPR_contextDIMLISTCOMMON, (ffeexprCallback) ffestb_subr_dimlist_);
24050
24051 case FFELEX_typeCOMMA:
24052 if (!ffesta_is_inhibited ())
24053 ffestc_V016_item_object (ffesta_tokens[1], NULL);
24054 ffelex_token_kill (ffesta_tokens[1]);
24055 return (ffelexHandler) ffestb_V0166_;
24056
24057 case FFELEX_typeEOS:
24058 case FFELEX_typeSEMICOLON:
24059 if (!ffesta_is_inhibited ())
24060 {
24061 ffestc_V016_item_object (ffesta_tokens[1], NULL);
24062 ffestc_V016_finish ();
24063 }
24064 ffelex_token_kill (ffesta_tokens[1]);
24065 return (ffelexHandler) ffesta_zero (t);
24066
24067 default:
24068 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
24069 break;
24070 }
24071
24072 if (!ffesta_is_inhibited ())
24073 ffestc_V016_finish ();
24074 ffelex_token_kill (ffesta_tokens[1]);
24075 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24076 }
24077
24078 /* ffestb_V0165_ -- "RECORD" ... NAME OPEN_PAREN dimlist CLOSE_PAREN
24079
24080 return ffestb_V0165_; // to lexer
24081
24082 Handle COMMA or EOS/SEMICOLON. */
24083
24084 static ffelexHandler
24085 ffestb_V0165_ (ffelexToken t)
24086 {
24087 if (!ffestb_subrargs_.dim_list.ok)
24088 goto bad; /* :::::::::::::::::::: */
24089
24090 switch (ffelex_token_type (t))
24091 {
24092 case FFELEX_typeCOMMA:
24093 if (!ffesta_is_inhibited ())
24094 ffestc_V016_item_object (ffesta_tokens[1],
24095 ffestb_subrargs_.dim_list.dims);
24096 ffelex_token_kill (ffesta_tokens[1]);
24097 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
24098 return (ffelexHandler) ffestb_V0166_;
24099
24100 case FFELEX_typeEOS:
24101 case FFELEX_typeSEMICOLON:
24102 if (!ffesta_is_inhibited ())
24103 {
24104 ffestc_V016_item_object (ffesta_tokens[1],
24105 ffestb_subrargs_.dim_list.dims);
24106 ffestc_V016_finish ();
24107 }
24108 ffelex_token_kill (ffesta_tokens[1]);
24109 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
24110 return (ffelexHandler) ffesta_zero (t);
24111
24112 default:
24113 break;
24114 }
24115
24116 bad: /* :::::::::::::::::::: */
24117 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
24118 if (ffestb_local_.structure.started && !ffesta_is_inhibited ())
24119 ffestc_V016_finish ();
24120 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
24121 ffelex_token_kill (ffesta_tokens[1]);
24122 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24123 }
24124
24125 /* ffestb_V0166_ -- "RECORD" SLASH NAME SLASH NAME [OPEN_PAREN dimlist
24126 CLOSE_PAREN] COMMA
24127
24128 return ffestb_V0166_; // to lexer
24129
24130 Handle NAME or SLASH. */
24131
24132 static ffelexHandler
24133 ffestb_V0166_ (ffelexToken t)
24134 {
24135 switch (ffelex_token_type (t))
24136 {
24137 case FFELEX_typeNAME:
24138 ffesta_tokens[1] = ffelex_token_use (t);
24139 return (ffelexHandler) ffestb_V0164_;
24140
24141 case FFELEX_typeSLASH:
24142 return (ffelexHandler) ffestb_V0161_;
24143
24144 default:
24145 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
24146 break;
24147 }
24148
24149 if (!ffesta_is_inhibited ())
24150 ffestc_V016_finish ();
24151 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24152 }
24153
24154 #endif
24155 /* ffestb_V027 -- Parse the VXT PARAMETER statement
24156
24157 return ffestb_V027; // to lexer
24158
24159 Make sure the statement has a valid form for the VXT PARAMETER statement.
24160 If it does, implement the statement. */
24161
24162 ffelexHandler
24163 ffestb_V027 (ffelexToken t)
24164 {
24165 unsigned const char *p;
24166 ffeTokenLength i;
24167
24168 switch (ffelex_token_type (ffesta_tokens[0]))
24169 {
24170 case FFELEX_typeNAME:
24171 if (ffesta_first_kw != FFESTR_firstPARAMETER)
24172 goto bad_0; /* :::::::::::::::::::: */
24173 switch (ffelex_token_type (t))
24174 {
24175 case FFELEX_typeNAME:
24176 break;
24177
24178 default:
24179 goto bad_1; /* :::::::::::::::::::: */
24180 }
24181 ffesta_confirmed ();
24182 ffestb_local_.vxtparam.started = TRUE;
24183 if (!ffesta_is_inhibited ())
24184 ffestc_V027_start ();
24185 ffesta_tokens[1] = ffelex_token_use (t);
24186 return (ffelexHandler) ffestb_V0271_;
24187
24188 case FFELEX_typeNAMES:
24189 if (ffesta_first_kw != FFESTR_firstPARAMETER)
24190 goto bad_0; /* :::::::::::::::::::: */
24191 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlPARAMETER);
24192 switch (ffelex_token_type (t))
24193 {
24194 case FFELEX_typeEQUALS:
24195 break;
24196
24197 default:
24198 goto bad_1; /* :::::::::::::::::::: */
24199 }
24200 if (!ffesrc_is_name_init (*p))
24201 goto bad_i; /* :::::::::::::::::::: */
24202 ffestb_local_.vxtparam.started = FALSE;
24203 ffesta_tokens[1] = ffelex_token_name_from_names (ffesta_tokens[0], i,
24204 0);
24205 return (ffelexHandler) ffestb_V0271_ (t);
24206
24207 default:
24208 goto bad_0; /* :::::::::::::::::::: */
24209 }
24210
24211 bad_0: /* :::::::::::::::::::: */
24212 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", ffesta_tokens[0]);
24213 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24214
24215 bad_1: /* :::::::::::::::::::: */
24216 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
24217 return (ffelexHandler) ffelex_swallow_tokens (t,
24218 (ffelexHandler) ffesta_zero); /* Invalid second token. */
24219
24220 bad_i: /* :::::::::::::::::::: */
24221 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "PARAMETER", ffesta_tokens[0], i, t);
24222 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24223 }
24224
24225 /* ffestb_V0271_ -- "PARAMETER" NAME
24226
24227 return ffestb_V0271_; // to lexer
24228
24229 Handle EQUALS. */
24230
24231 static ffelexHandler
24232 ffestb_V0271_ (ffelexToken t)
24233 {
24234 switch (ffelex_token_type (t))
24235 {
24236 case FFELEX_typeEQUALS:
24237 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
24238 FFEEXPR_contextPARAMETER, (ffeexprCallback) ffestb_V0272_);
24239
24240 default:
24241 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
24242 break;
24243 }
24244
24245 ffelex_token_kill (ffesta_tokens[1]);
24246 if (ffestb_local_.vxtparam.started && !ffesta_is_inhibited ())
24247 ffestc_V027_finish ();
24248 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24249 }
24250
24251 /* ffestb_V0272_ -- "PARAMETER" NAME EQUALS expr
24252
24253 (ffestb_V0272_) // to expression handler
24254
24255 Handle COMMA or EOS/SEMICOLON. */
24256
24257 static ffelexHandler
24258 ffestb_V0272_ (ffelexToken ft, ffebld expr, ffelexToken t)
24259 {
24260 switch (ffelex_token_type (t))
24261 {
24262 case FFELEX_typeEOS:
24263 case FFELEX_typeSEMICOLON:
24264 if (!ffestb_local_.vxtparam.started)
24265 {
24266 if (ffestc_is_let_not_V027 ())
24267 break; /* Not a valid VXTPARAMETER stmt. */
24268 ffesta_confirmed ();
24269 if (!ffesta_is_inhibited ())
24270 ffestc_V027_start ();
24271 ffestb_local_.vxtparam.started = TRUE;
24272 }
24273 if (expr == NULL)
24274 break;
24275 if (!ffesta_is_inhibited ())
24276 {
24277 ffestc_V027_item (ffesta_tokens[1], expr, ft);
24278 ffestc_V027_finish ();
24279 }
24280 ffelex_token_kill (ffesta_tokens[1]);
24281 return (ffelexHandler) ffesta_zero (t);
24282
24283 case FFELEX_typeCOMMA:
24284 ffesta_confirmed ();
24285 if (!ffestb_local_.vxtparam.started)
24286 {
24287 if (!ffesta_is_inhibited ())
24288 ffestc_V027_start ();
24289 ffestb_local_.vxtparam.started = TRUE;
24290 }
24291 if (expr == NULL)
24292 break;
24293 if (!ffesta_is_inhibited ())
24294 ffestc_V027_item (ffesta_tokens[1], expr, ft);
24295 ffelex_token_kill (ffesta_tokens[1]);
24296 return (ffelexHandler) ffestb_V0273_;
24297
24298 default:
24299 break;
24300 }
24301
24302 ffelex_token_kill (ffesta_tokens[1]);
24303 if (ffestb_local_.vxtparam.started && !ffesta_is_inhibited ())
24304 ffestc_V027_finish ();
24305 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
24306 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24307 }
24308
24309 /* ffestb_V0273_ -- "PARAMETER" NAME EQUALS expr COMMA
24310
24311 return ffestb_V0273_; // to lexer
24312
24313 Handle NAME. */
24314
24315 static ffelexHandler
24316 ffestb_V0273_ (ffelexToken t)
24317 {
24318 switch (ffelex_token_type (t))
24319 {
24320 case FFELEX_typeNAME:
24321 ffesta_tokens[1] = ffelex_token_use (t);
24322 return (ffelexHandler) ffestb_V0271_;
24323
24324 default:
24325 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
24326 break;
24327 }
24328
24329 if (ffestb_local_.vxtparam.started && !ffesta_is_inhibited ())
24330 ffestc_V027_finish ();
24331 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24332 }
24333
24334 /* ffestb_decl_R539 -- Parse the IMPLICIT FUNCTION statement
24335
24336 return ffestb_decl_R539; // to lexer
24337
24338 Make sure the statement has a valid form for the IMPLICIT
24339 statement. If it does, implement the statement. */
24340
24341 ffelexHandler
24342 ffestb_decl_R539 (ffelexToken t)
24343 {
24344 ffeTokenLength i;
24345 unsigned const char *p;
24346 ffelexToken nt;
24347 ffestrSecond kw;
24348
24349 ffestb_local_.decl.recursive = NULL;
24350
24351 switch (ffelex_token_type (ffesta_tokens[0]))
24352 {
24353 case FFELEX_typeNAME:
24354 if (ffesta_first_kw != FFESTR_firstIMPLICIT)
24355 goto bad_0; /* :::::::::::::::::::: */
24356 switch (ffelex_token_type (t))
24357 {
24358 case FFELEX_typeEOS:
24359 case FFELEX_typeSEMICOLON:
24360 case FFELEX_typeCOMMA:
24361 case FFELEX_typeCOLONCOLON:
24362 ffesta_confirmed (); /* Error, but clearly intended. */
24363 goto bad_1; /* :::::::::::::::::::: */
24364
24365 default:
24366 goto bad_1; /* :::::::::::::::::::: */
24367
24368 case FFELEX_typeNAME:
24369 break;
24370 }
24371 ffesta_confirmed ();
24372 ffestb_local_.decl.imp_started = FALSE;
24373 switch (ffesta_second_kw)
24374 {
24375 case FFESTR_secondINTEGER:
24376 ffestb_local_.decl.type = FFESTP_typeINTEGER;
24377 return (ffelexHandler) ffestb_decl_R5391_;
24378
24379 case FFESTR_secondBYTE:
24380 ffestb_local_.decl.type = FFESTP_typeBYTE;
24381 return (ffelexHandler) ffestb_decl_R5391_;
24382
24383 case FFESTR_secondWORD:
24384 ffestb_local_.decl.type = FFESTP_typeWORD;
24385 return (ffelexHandler) ffestb_decl_R5391_;
24386
24387 case FFESTR_secondREAL:
24388 ffestb_local_.decl.type = FFESTP_typeREAL;
24389 return (ffelexHandler) ffestb_decl_R5391_;
24390
24391 case FFESTR_secondCOMPLEX:
24392 ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
24393 return (ffelexHandler) ffestb_decl_R5391_;
24394
24395 case FFESTR_secondLOGICAL:
24396 ffestb_local_.decl.type = FFESTP_typeLOGICAL;
24397 return (ffelexHandler) ffestb_decl_R5391_;
24398
24399 case FFESTR_secondCHARACTER:
24400 ffestb_local_.decl.type = FFESTP_typeCHARACTER;
24401 return (ffelexHandler) ffestb_decl_R5391_;
24402
24403 case FFESTR_secondDOUBLE:
24404 return (ffelexHandler) ffestb_decl_R5392_;
24405
24406 case FFESTR_secondDOUBLEPRECISION:
24407 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
24408 ffestb_local_.decl.kind = NULL;
24409 ffestb_local_.decl.kindt = NULL;
24410 ffestb_local_.decl.len = NULL;
24411 ffestb_local_.decl.lent = NULL;
24412 return (ffelexHandler) ffestb_decl_R539letters_;
24413
24414 case FFESTR_secondDOUBLECOMPLEX:
24415 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
24416 ffestb_local_.decl.kind = NULL;
24417 ffestb_local_.decl.kindt = NULL;
24418 ffestb_local_.decl.len = NULL;
24419 ffestb_local_.decl.lent = NULL;
24420 return (ffelexHandler) ffestb_decl_R539letters_;
24421
24422 case FFESTR_secondNONE:
24423 return (ffelexHandler) ffestb_decl_R5394_;
24424
24425 #if FFESTR_F90
24426 case FFESTR_secondTYPE:
24427 ffestb_local_.decl.type = FFESTP_typeTYPE;
24428 return (ffelexHandler) ffestb_decl_R5393_;
24429 #endif
24430
24431 default:
24432 goto bad_1; /* :::::::::::::::::::: */
24433 }
24434
24435 case FFELEX_typeNAMES:
24436 if (ffesta_first_kw != FFESTR_firstIMPLICIT)
24437 goto bad_0; /* :::::::::::::::::::: */
24438 switch (ffelex_token_type (t))
24439 {
24440 case FFELEX_typeCOMMA:
24441 case FFELEX_typeCOLONCOLON:
24442 case FFELEX_typeASTERISK:
24443 case FFELEX_typeSEMICOLON:
24444 case FFELEX_typeEOS:
24445 ffesta_confirmed ();
24446 break;
24447
24448 case FFELEX_typeOPEN_PAREN:
24449 break;
24450
24451 default:
24452 goto bad_1; /* :::::::::::::::::::: */
24453 }
24454 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlIMPLICIT);
24455 if (!ffesrc_is_name_init (*p))
24456 goto bad_0; /* :::::::::::::::::::: */
24457 ffestb_local_.decl.imp_started = FALSE;
24458 nt = ffelex_token_name_from_names (ffesta_tokens[0],
24459 FFESTR_firstlIMPLICIT, 0);
24460 kw = ffestr_second (nt);
24461 ffelex_token_kill (nt);
24462 switch (kw)
24463 {
24464 case FFESTR_secondINTEGER:
24465 ffestb_local_.decl.type = FFESTP_typeINTEGER;
24466 return (ffelexHandler) ffestb_decl_R5391_ (t);
24467
24468 case FFESTR_secondBYTE:
24469 ffestb_local_.decl.type = FFESTP_typeBYTE;
24470 return (ffelexHandler) ffestb_decl_R5391_ (t);
24471
24472 case FFESTR_secondWORD:
24473 ffestb_local_.decl.type = FFESTP_typeWORD;
24474 return (ffelexHandler) ffestb_decl_R5391_ (t);
24475
24476 case FFESTR_secondREAL:
24477 ffestb_local_.decl.type = FFESTP_typeREAL;
24478 return (ffelexHandler) ffestb_decl_R5391_ (t);
24479
24480 case FFESTR_secondCOMPLEX:
24481 ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
24482 return (ffelexHandler) ffestb_decl_R5391_ (t);
24483
24484 case FFESTR_secondLOGICAL:
24485 ffestb_local_.decl.type = FFESTP_typeLOGICAL;
24486 return (ffelexHandler) ffestb_decl_R5391_ (t);
24487
24488 case FFESTR_secondCHARACTER:
24489 ffestb_local_.decl.type = FFESTP_typeCHARACTER;
24490 return (ffelexHandler) ffestb_decl_R5391_ (t);
24491
24492 case FFESTR_secondDOUBLEPRECISION:
24493 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
24494 ffestb_local_.decl.kind = NULL;
24495 ffestb_local_.decl.kindt = NULL;
24496 ffestb_local_.decl.len = NULL;
24497 ffestb_local_.decl.lent = NULL;
24498 return (ffelexHandler) ffestb_decl_R539letters_ (t);
24499
24500 case FFESTR_secondDOUBLECOMPLEX:
24501 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
24502 ffestb_local_.decl.kind = NULL;
24503 ffestb_local_.decl.kindt = NULL;
24504 ffestb_local_.decl.len = NULL;
24505 ffestb_local_.decl.lent = NULL;
24506 return (ffelexHandler) ffestb_decl_R539letters_ (t);
24507
24508 case FFESTR_secondNONE:
24509 return (ffelexHandler) ffestb_decl_R5394_ (t);
24510
24511 #if FFESTR_F90
24512 case FFESTR_secondTYPE:
24513 ffestb_local_.decl.type = FFESTP_typeTYPE;
24514 return (ffelexHandler) ffestb_decl_R5393_ (t);
24515 #endif
24516
24517 default:
24518 goto bad_1; /* :::::::::::::::::::: */
24519 }
24520
24521 default:
24522 goto bad_0; /* :::::::::::::::::::: */
24523 }
24524
24525 bad_0: /* :::::::::::::::::::: */
24526 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", ffesta_tokens[0]);
24527 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24528
24529 bad_1: /* :::::::::::::::::::: */
24530 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24531 return (ffelexHandler) ffelex_swallow_tokens (t,
24532 (ffelexHandler) ffesta_zero); /* Invalid second token. */
24533 }
24534
24535 /* ffestb_decl_R5391_ -- "IMPLICIT" generic-type
24536
24537 return ffestb_decl_R5391_; // to lexer
24538
24539 Handle ASTERISK or OPEN_PAREN. */
24540
24541 static ffelexHandler
24542 ffestb_decl_R5391_ (ffelexToken t)
24543 {
24544 switch (ffelex_token_type (t))
24545 {
24546 case FFELEX_typeASTERISK:
24547 ffesta_confirmed ();
24548 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_R539letters_;
24549 ffestb_local_.decl.badname = "IMPLICIT";
24550 if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
24551 return (ffelexHandler) ffestb_decl_starlen_;
24552 return (ffelexHandler) ffestb_decl_starkind_;
24553
24554 case FFELEX_typeOPEN_PAREN:
24555 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_R539letters_;
24556 ffestb_local_.decl.badname = "IMPLICIT";
24557 ffestb_local_.decl.kind = NULL;
24558 ffestb_local_.decl.kindt = NULL;
24559 ffestb_local_.decl.len = NULL;
24560 ffestb_local_.decl.lent = NULL;
24561 if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
24562 ffestb_local_.decl.imp_handler
24563 = (ffelexHandler) ffestb_decl_typeparams_;
24564 else
24565 ffestb_local_.decl.imp_handler
24566 = (ffelexHandler) ffestb_decl_kindparam_;
24567 return (ffelexHandler) ffestb_decl_R539maybe_ (t);
24568
24569 default:
24570 break;
24571 }
24572
24573 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24574 ffestc_R539finish ();
24575 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24576 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24577 }
24578
24579 /* ffestb_decl_R5392_ -- "IMPLICIT" "DOUBLE"
24580
24581 return ffestb_decl_R5392_; // to lexer
24582
24583 Handle NAME. */
24584
24585 static ffelexHandler
24586 ffestb_decl_R5392_ (ffelexToken t)
24587 {
24588 switch (ffelex_token_type (t))
24589 {
24590 case FFELEX_typeNAME:
24591 switch (ffestr_second (t))
24592 {
24593 case FFESTR_secondPRECISION:
24594 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
24595 break;
24596
24597 case FFESTR_secondCOMPLEX:
24598 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
24599 break;
24600
24601 default:
24602 goto bad; /* :::::::::::::::::::: */
24603 }
24604 ffestb_local_.decl.kind = NULL;
24605 ffestb_local_.decl.kindt = NULL;
24606 ffestb_local_.decl.len = NULL;
24607 ffestb_local_.decl.lent = NULL;
24608 return (ffelexHandler) ffestb_decl_R539letters_;
24609
24610 default:
24611 break;
24612 }
24613
24614 bad: /* :::::::::::::::::::: */
24615 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24616 ffestc_R539finish ();
24617 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24618 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24619 }
24620
24621 /* ffestb_decl_R5393_ -- "IMPLICIT" "TYPE"
24622
24623 return ffestb_decl_R5393_; // to lexer
24624
24625 Handle OPEN_PAREN. */
24626
24627 #if FFESTR_F90
24628 static ffelexHandler
24629 ffestb_decl_R5393_ (ffelexToken t)
24630 {
24631 switch (ffelex_token_type (t))
24632 {
24633 case FFELEX_typeOPEN_PAREN:
24634 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_R539letters_;
24635 ffestb_local_.decl.badname = "IMPLICIT";
24636 return (ffelexHandler) ffestb_decl_typetype1_;
24637
24638 default:
24639 break;
24640 }
24641
24642 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24643 ffestc_R539finish ();
24644 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24645 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24646 }
24647
24648 #endif
24649 /* ffestb_decl_R5394_ -- "IMPLICIT" "NONE"
24650
24651 return ffestb_decl_R5394_; // to lexer
24652
24653 Handle EOS/SEMICOLON. */
24654
24655 static ffelexHandler
24656 ffestb_decl_R5394_ (ffelexToken t)
24657 {
24658 switch (ffelex_token_type (t))
24659 {
24660 case FFELEX_typeEOS:
24661 case FFELEX_typeSEMICOLON:
24662 ffesta_confirmed ();
24663 if (!ffesta_is_inhibited ())
24664 ffestc_R539 (); /* IMPLICIT NONE. */
24665 return (ffelexHandler) ffesta_zero (t);
24666
24667 default:
24668 break;
24669 }
24670
24671 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24672 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24673 }
24674
24675 /* ffestb_decl_R5395_ -- "IMPLICIT" implicit-spec-list COMMA
24676
24677 return ffestb_decl_R5395_; // to lexer
24678
24679 Handle NAME for next type-spec. */
24680
24681 static ffelexHandler
24682 ffestb_decl_R5395_ (ffelexToken t)
24683 {
24684 switch (ffelex_token_type (t))
24685 {
24686 case FFELEX_typeNAME:
24687 switch (ffestr_second (t))
24688 {
24689 case FFESTR_secondINTEGER:
24690 ffestb_local_.decl.type = FFESTP_typeINTEGER;
24691 return (ffelexHandler) ffestb_decl_R5391_;
24692
24693 case FFESTR_secondBYTE:
24694 ffestb_local_.decl.type = FFESTP_typeBYTE;
24695 return (ffelexHandler) ffestb_decl_R5391_;
24696
24697 case FFESTR_secondWORD:
24698 ffestb_local_.decl.type = FFESTP_typeWORD;
24699 return (ffelexHandler) ffestb_decl_R5391_;
24700
24701 case FFESTR_secondREAL:
24702 ffestb_local_.decl.type = FFESTP_typeREAL;
24703 return (ffelexHandler) ffestb_decl_R5391_;
24704
24705 case FFESTR_secondCOMPLEX:
24706 ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
24707 return (ffelexHandler) ffestb_decl_R5391_;
24708
24709 case FFESTR_secondLOGICAL:
24710 ffestb_local_.decl.type = FFESTP_typeLOGICAL;
24711 return (ffelexHandler) ffestb_decl_R5391_;
24712
24713 case FFESTR_secondCHARACTER:
24714 ffestb_local_.decl.type = FFESTP_typeCHARACTER;
24715 return (ffelexHandler) ffestb_decl_R5391_;
24716
24717 case FFESTR_secondDOUBLE:
24718 return (ffelexHandler) ffestb_decl_R5392_;
24719
24720 case FFESTR_secondDOUBLEPRECISION:
24721 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
24722 ffestb_local_.decl.kind = NULL;
24723 ffestb_local_.decl.kindt = NULL;
24724 ffestb_local_.decl.len = NULL;
24725 ffestb_local_.decl.lent = NULL;
24726 return (ffelexHandler) ffestb_decl_R539letters_;
24727
24728 case FFESTR_secondDOUBLECOMPLEX:
24729 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
24730 ffestb_local_.decl.kind = NULL;
24731 ffestb_local_.decl.kindt = NULL;
24732 ffestb_local_.decl.len = NULL;
24733 ffestb_local_.decl.lent = NULL;
24734 return (ffelexHandler) ffestb_decl_R539letters_;
24735
24736 #if FFESTR_F90
24737 case FFESTR_secondTYPE:
24738 ffestb_local_.decl.type = FFESTP_typeTYPE;
24739 return (ffelexHandler) ffestb_decl_R5393_;
24740 #endif
24741
24742 default:
24743 break;
24744 }
24745 break;
24746
24747 default:
24748 break;
24749 }
24750
24751 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24752 ffestc_R539finish ();
24753 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24754 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24755 }
24756
24757 /* ffestb_decl_R539letters_ -- "IMPLICIT" type-spec
24758
24759 return ffestb_decl_R539letters_; // to lexer
24760
24761 Handle OPEN_PAREN. */
24762
24763 static ffelexHandler
24764 ffestb_decl_R539letters_ (ffelexToken t)
24765 {
24766 ffelex_set_names (FALSE);
24767
24768 switch (ffelex_token_type (t))
24769 {
24770 case FFELEX_typeOPEN_PAREN:
24771 ffestb_local_.decl.imps = ffestt_implist_create ();
24772 return (ffelexHandler) ffestb_decl_R539letters_1_;
24773
24774 default:
24775 break;
24776 }
24777
24778 if (ffestb_local_.decl.kindt != NULL)
24779 ffelex_token_kill (ffestb_local_.decl.kindt);
24780 if (ffestb_local_.decl.lent != NULL)
24781 ffelex_token_kill (ffestb_local_.decl.lent);
24782 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24783 ffestc_R539finish ();
24784 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24785 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24786 }
24787
24788 /* ffestb_decl_R539letters_1_ -- "IMPLICIT" type-spec OPEN_PAREN
24789
24790 return ffestb_decl_R539letters_1_; // to lexer
24791
24792 Handle NAME. */
24793
24794 static ffelexHandler
24795 ffestb_decl_R539letters_1_ (ffelexToken t)
24796 {
24797 switch (ffelex_token_type (t))
24798 {
24799 case FFELEX_typeNAME:
24800 if (ffelex_token_length (t) != 1)
24801 break;
24802 ffesta_tokens[1] = ffelex_token_use (t);
24803 return (ffelexHandler) ffestb_decl_R539letters_2_;
24804
24805 default:
24806 break;
24807 }
24808
24809 ffestt_implist_kill (ffestb_local_.decl.imps);
24810 if (ffestb_local_.decl.kindt != NULL)
24811 ffelex_token_kill (ffestb_local_.decl.kindt);
24812 if (ffestb_local_.decl.lent != NULL)
24813 ffelex_token_kill (ffestb_local_.decl.lent);
24814 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24815 ffestc_R539finish ();
24816 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24817 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24818 }
24819
24820 /* ffestb_decl_R539letters_2_ -- "IMPLICIT" type-spec OPEN_PAREN NAME
24821
24822 return ffestb_decl_R539letters_2_; // to lexer
24823
24824 Handle COMMA or MINUS. */
24825
24826 static ffelexHandler
24827 ffestb_decl_R539letters_2_ (ffelexToken t)
24828 {
24829 switch (ffelex_token_type (t))
24830 {
24831 case FFELEX_typeCOMMA:
24832 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
24833 return (ffelexHandler) ffestb_decl_R539letters_1_;
24834
24835 case FFELEX_typeCLOSE_PAREN:
24836 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
24837 return (ffelexHandler) ffestb_decl_R539letters_5_;
24838
24839 case FFELEX_typeMINUS:
24840 return (ffelexHandler) ffestb_decl_R539letters_3_;
24841
24842 default:
24843 break;
24844 }
24845
24846 ffelex_token_kill (ffesta_tokens[1]);
24847 ffestt_implist_kill (ffestb_local_.decl.imps);
24848 if (ffestb_local_.decl.kindt != NULL)
24849 ffelex_token_kill (ffestb_local_.decl.kindt);
24850 if (ffestb_local_.decl.lent != NULL)
24851 ffelex_token_kill (ffestb_local_.decl.lent);
24852 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24853 ffestc_R539finish ();
24854 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24855 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24856 }
24857
24858 /* ffestb_decl_R539letters_3_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
24859
24860 return ffestb_decl_R539letters_3_; // to lexer
24861
24862 Handle NAME. */
24863
24864 static ffelexHandler
24865 ffestb_decl_R539letters_3_ (ffelexToken t)
24866 {
24867 switch (ffelex_token_type (t))
24868 {
24869 case FFELEX_typeNAME:
24870 if (ffelex_token_length (t) != 1)
24871 break;
24872 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1],
24873 ffelex_token_use (t));
24874 return (ffelexHandler) ffestb_decl_R539letters_4_;
24875
24876 default:
24877 break;
24878 }
24879
24880 ffelex_token_kill (ffesta_tokens[1]);
24881 ffestt_implist_kill (ffestb_local_.decl.imps);
24882 if (ffestb_local_.decl.kindt != NULL)
24883 ffelex_token_kill (ffestb_local_.decl.kindt);
24884 if (ffestb_local_.decl.lent != NULL)
24885 ffelex_token_kill (ffestb_local_.decl.lent);
24886 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24887 ffestc_R539finish ();
24888 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24889 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24890 }
24891
24892 /* ffestb_decl_R539letters_4_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
24893 NAME
24894
24895 return ffestb_decl_R539letters_4_; // to lexer
24896
24897 Handle COMMA or CLOSE_PAREN. */
24898
24899 static ffelexHandler
24900 ffestb_decl_R539letters_4_ (ffelexToken t)
24901 {
24902 switch (ffelex_token_type (t))
24903 {
24904 case FFELEX_typeCOMMA:
24905 return (ffelexHandler) ffestb_decl_R539letters_1_;
24906
24907 case FFELEX_typeCLOSE_PAREN:
24908 return (ffelexHandler) ffestb_decl_R539letters_5_;
24909
24910 default:
24911 break;
24912 }
24913
24914 ffestt_implist_kill (ffestb_local_.decl.imps);
24915 if (ffestb_local_.decl.kindt != NULL)
24916 ffelex_token_kill (ffestb_local_.decl.kindt);
24917 if (ffestb_local_.decl.lent != NULL)
24918 ffelex_token_kill (ffestb_local_.decl.lent);
24919 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24920 ffestc_R539finish ();
24921 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24922 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24923 }
24924
24925 /* ffestb_decl_R539letters_5_ -- "IMPLICIT" type-spec OPEN_PAREN
24926 letter-spec-list CLOSE_PAREN
24927
24928 return ffestb_decl_R539letters_5_; // to lexer
24929
24930 Handle COMMA or EOS/SEMICOLON. */
24931
24932 static ffelexHandler
24933 ffestb_decl_R539letters_5_ (ffelexToken t)
24934 {
24935 switch (ffelex_token_type (t))
24936 {
24937 case FFELEX_typeCOMMA:
24938 case FFELEX_typeEOS:
24939 case FFELEX_typeSEMICOLON:
24940 if (!ffestb_local_.decl.imp_started)
24941 {
24942 ffestb_local_.decl.imp_started = TRUE;
24943 ffesta_confirmed ();
24944 if (!ffesta_is_inhibited ())
24945 ffestc_R539start ();
24946 }
24947 if (!ffesta_is_inhibited ())
24948 ffestc_R539item (ffestb_local_.decl.type, ffestb_local_.decl.kind,
24949 ffestb_local_.decl.kindt, ffestb_local_.decl.len,
24950 ffestb_local_.decl.lent, ffestb_local_.decl.imps);
24951 if (ffestb_local_.decl.kindt != NULL)
24952 ffelex_token_kill (ffestb_local_.decl.kindt);
24953 if (ffestb_local_.decl.lent != NULL)
24954 ffelex_token_kill (ffestb_local_.decl.lent);
24955 ffestt_implist_kill (ffestb_local_.decl.imps);
24956 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
24957 return (ffelexHandler) ffestb_decl_R5395_;
24958 if (!ffesta_is_inhibited ())
24959 ffestc_R539finish ();
24960 return (ffelexHandler) ffesta_zero (t);
24961
24962 default:
24963 break;
24964 }
24965
24966 ffestt_implist_kill (ffestb_local_.decl.imps);
24967 if (ffestb_local_.decl.kindt != NULL)
24968 ffelex_token_kill (ffestb_local_.decl.kindt);
24969 if (ffestb_local_.decl.lent != NULL)
24970 ffelex_token_kill (ffestb_local_.decl.lent);
24971 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24972 ffestc_R539finish ();
24973 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24974 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24975 }
24976
24977 /* ffestb_decl_R539maybe_ -- "IMPLICIT" generic-type-spec
24978
24979 return ffestb_decl_R539maybe_; // to lexer
24980
24981 Handle OPEN_PAREN. */
24982
24983 static ffelexHandler
24984 ffestb_decl_R539maybe_ (ffelexToken t)
24985 {
24986 assert (ffelex_token_type (t) == FFELEX_typeOPEN_PAREN);
24987 ffestb_local_.decl.imps = ffestt_implist_create ();
24988 ffestb_local_.decl.toklist = ffestt_tokenlist_create ();
24989 ffestb_local_.decl.imp_seen_comma
24990 = (ffestb_local_.decl.type != FFESTP_typeCHARACTER);
24991 return (ffelexHandler) ffestb_decl_R539maybe_1_;
24992 }
24993
24994 /* ffestb_decl_R539maybe_1_ -- "IMPLICIT" generic-type-spec OPEN_PAREN
24995
24996 return ffestb_decl_R539maybe_1_; // to lexer
24997
24998 Handle NAME. */
24999
25000 static ffelexHandler
25001 ffestb_decl_R539maybe_1_ (ffelexToken t)
25002 {
25003 ffelexHandler next;
25004
25005 switch (ffelex_token_type (t))
25006 {
25007 case FFELEX_typeNAME:
25008 if (ffelex_token_length (t) != 1)
25009 break;
25010 ffesta_tokens[1] = ffelex_token_use (t);
25011 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
25012 return (ffelexHandler) ffestb_decl_R539maybe_2_;
25013
25014 default:
25015 break;
25016 }
25017
25018 ffestt_implist_kill (ffestb_local_.decl.imps);
25019 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
25020 (ffelexHandler) ffestb_local_.decl.imp_handler);
25021 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
25022 return (ffelexHandler) (*next) (t);
25023 }
25024
25025 /* ffestb_decl_R539maybe_2_ -- "IMPLICIT" generic-type-spec OPEN_PAREN NAME
25026
25027 return ffestb_decl_R539maybe_2_; // to lexer
25028
25029 Handle COMMA or MINUS. */
25030
25031 static ffelexHandler
25032 ffestb_decl_R539maybe_2_ (ffelexToken t)
25033 {
25034 ffelexHandler next;
25035
25036 switch (ffelex_token_type (t))
25037 {
25038 case FFELEX_typeCOMMA:
25039 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
25040 if (ffestb_local_.decl.imp_seen_comma)
25041 {
25042 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
25043 return (ffelexHandler) ffestb_decl_R539letters_1_;
25044 }
25045 ffestb_local_.decl.imp_seen_comma = TRUE;
25046 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
25047 return (ffelexHandler) ffestb_decl_R539maybe_1_;
25048
25049 case FFELEX_typeCLOSE_PAREN:
25050 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
25051 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
25052 return (ffelexHandler) ffestb_decl_R539maybe_5_;
25053
25054 case FFELEX_typeMINUS:
25055 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
25056 return (ffelexHandler) ffestb_decl_R539maybe_3_;
25057
25058 default:
25059 break;
25060 }
25061
25062 ffelex_token_kill (ffesta_tokens[1]);
25063 ffestt_implist_kill (ffestb_local_.decl.imps);
25064 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
25065 (ffelexHandler) ffestb_local_.decl.imp_handler);
25066 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
25067 return (ffelexHandler) (*next) (t);
25068 }
25069
25070 /* ffestb_decl_R539maybe_3_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
25071
25072 return ffestb_decl_R539maybe_3_; // to lexer
25073
25074 Handle NAME. */
25075
25076 static ffelexHandler
25077 ffestb_decl_R539maybe_3_ (ffelexToken t)
25078 {
25079 ffelexHandler next;
25080
25081 switch (ffelex_token_type (t))
25082 {
25083 case FFELEX_typeNAME:
25084 if (ffelex_token_length (t) != 1)
25085 break;
25086 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1],
25087 ffelex_token_use (t));
25088 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
25089 return (ffelexHandler) ffestb_decl_R539maybe_4_;
25090
25091 default:
25092 break;
25093 }
25094
25095 ffelex_token_kill (ffesta_tokens[1]);
25096 ffestt_implist_kill (ffestb_local_.decl.imps);
25097 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
25098 (ffelexHandler) ffestb_local_.decl.imp_handler);
25099 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
25100 return (ffelexHandler) (*next) (t);
25101 }
25102
25103 /* ffestb_decl_R539maybe_4_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
25104 NAME
25105
25106 return ffestb_decl_R539maybe_4_; // to lexer
25107
25108 Handle COMMA or CLOSE_PAREN. */
25109
25110 static ffelexHandler
25111 ffestb_decl_R539maybe_4_ (ffelexToken t)
25112 {
25113 ffelexHandler next;
25114
25115 switch (ffelex_token_type (t))
25116 {
25117 case FFELEX_typeCOMMA:
25118 if (ffestb_local_.decl.imp_seen_comma)
25119 {
25120 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
25121 return (ffelexHandler) ffestb_decl_R539letters_1_;
25122 }
25123 ffestb_local_.decl.imp_seen_comma = TRUE;
25124 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
25125 return (ffelexHandler) ffestb_decl_R539maybe_1_;
25126
25127 case FFELEX_typeCLOSE_PAREN:
25128 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
25129 return (ffelexHandler) ffestb_decl_R539maybe_5_;
25130
25131 default:
25132 break;
25133 }
25134
25135 ffestt_implist_kill (ffestb_local_.decl.imps);
25136 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
25137 (ffelexHandler) ffestb_local_.decl.imp_handler);
25138 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
25139 return (ffelexHandler) (*next) (t);
25140 }
25141
25142 /* ffestb_decl_R539maybe_5_ -- "IMPLICIT" type-spec OPEN_PAREN
25143 letter-spec-list CLOSE_PAREN
25144
25145 return ffestb_decl_R539maybe_5_; // to lexer
25146
25147 Handle COMMA or EOS/SEMICOLON. */
25148
25149 static ffelexHandler
25150 ffestb_decl_R539maybe_5_ (ffelexToken t)
25151 {
25152 ffelexHandler next;
25153
25154 switch (ffelex_token_type (t))
25155 {
25156 case FFELEX_typeCOMMA:
25157 case FFELEX_typeEOS:
25158 case FFELEX_typeSEMICOLON:
25159 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
25160 if (!ffestb_local_.decl.imp_started)
25161 {
25162 ffestb_local_.decl.imp_started = TRUE;
25163 ffesta_confirmed ();
25164 if (!ffesta_is_inhibited ())
25165 ffestc_R539start ();
25166 }
25167 if (!ffesta_is_inhibited ())
25168 ffestc_R539item (ffestb_local_.decl.type, ffestb_local_.decl.kind,
25169 ffestb_local_.decl.kindt, ffestb_local_.decl.len,
25170 ffestb_local_.decl.lent, ffestb_local_.decl.imps);
25171 if (ffestb_local_.decl.kindt != NULL)
25172 ffelex_token_kill (ffestb_local_.decl.kindt);
25173 if (ffestb_local_.decl.lent != NULL)
25174 ffelex_token_kill (ffestb_local_.decl.lent);
25175 ffestt_implist_kill (ffestb_local_.decl.imps);
25176 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
25177 return (ffelexHandler) ffestb_decl_R5395_;
25178 if (!ffesta_is_inhibited ())
25179 ffestc_R539finish ();
25180 return (ffelexHandler) ffesta_zero (t);
25181
25182 case FFELEX_typeOPEN_PAREN:
25183 ffesta_confirmed ();
25184 ffestt_implist_kill (ffestb_local_.decl.imps);
25185 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
25186 (ffelexHandler) ffestb_local_.decl.imp_handler);
25187 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
25188 return (ffelexHandler) (*next) (t);
25189
25190 default:
25191 break;
25192 }
25193
25194 ffestt_implist_kill (ffestb_local_.decl.imps);
25195 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
25196 if (ffestb_local_.decl.kindt != NULL)
25197 ffelex_token_kill (ffestb_local_.decl.kindt);
25198 if (ffestb_local_.decl.lent != NULL)
25199 ffelex_token_kill (ffestb_local_.decl.lent);
25200 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
25201 ffestc_R539finish ();
25202 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
25203 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
25204 }
Mirror of the offical gcc git repository hosted at gcc.gnu.org