1 /* stb.c -- Implementation File (module.c template V1.0)
2 Copyright (C) 1995, 1996, 2002 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
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
ffestb_subr_ambig_nope_(ffelexToken t)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
ffestb_subr_ambig_to_ents_()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
ffestb_subr_dimlist_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_subr_dimlist_1_(ffelexToken ft UNUSED,ffebld expr,ffelexToken t)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
ffestb_subr_dimlist_2_(ffelexToken ft UNUSED,ffebld expr,ffelexToken t)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
ffestb_subr_name_list_(ffelexToken t)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
ffestb_subr_name_list_1_(ffelexToken t)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
ffestb_subr_R1001_append_p_(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
ffestb_decl_kindparam_(ffelexToken t)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
ffestb_decl_kindparam_1_(ffelexToken t)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
ffestb_decl_kindparam_2_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_decl_starkind_(ffelexToken t)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
ffestb_decl_starlen_(ffelexToken t)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
ffestb_decl_starlen_1_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_decl_typeparams_(ffelexToken t)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
ffestb_decl_typeparams_1_(ffelexToken t)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
ffestb_decl_typeparams_2_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_decl_typeparams_3_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_decl_typetype1_(ffelexToken t)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
ffestb_decl_typetype2_(ffelexToken t)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
ffestb_subr_label_list_(ffelexToken t)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
ffestb_subr_label_list_1_(ffelexToken t)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
ffestb_do(ffelexToken t)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
ffestb_dowhile(ffelexToken t)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
ffestb_do1_(ffelexToken t)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
ffestb_do2_(ffelexToken t)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
ffestb_do3_(ffelexToken t)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
ffestb_do4_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_do5_(ffelexToken t)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
ffestb_do6_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_do7_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_do8_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_do9_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_else(ffelexToken t)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
ffestb_elsexyz(ffelexToken t)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
ffestb_else1_(ffelexToken t)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
ffestb_else2_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_else3_(ffelexToken t)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
ffestb_else4_(ffelexToken t)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
ffestb_else5_(ffelexToken t)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
ffestb_end(ffelexToken t)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
ffestb_endxyz(ffelexToken t)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
ffestb_end1_(ffelexToken t)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
ffestb_end2_(ffelexToken t)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
ffestb_end3_(ffelexToken t)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
ffestb_goto(ffelexToken t)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
ffestb_goto1_(ffelexToken t)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
ffestb_goto2_(ffelexToken t)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
ffestb_goto3_(ffelexToken t)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
ffestb_goto4_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_goto5_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_goto6_(ffelexToken t)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
ffestb_goto7_(ffelexToken t)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
ffestb_halt(ffelexToken t)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
ffestb_halt1_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_if(ffelexToken t)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
ffestb_if1_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_if2_(ffelexToken t)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
ffestb_if3_(ffelexToken t)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
ffestb_where(ffelexToken t)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
ffestb_where1_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_where2_(ffelexToken t)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
ffestb_where3_(ffelexToken t)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
ffestb_let(ffelexToken t)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
ffestb_let1_(ffelexToken ft UNUSED,ffebld expr,ffelexToken t)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
ffestb_let2_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_type(ffelexToken t)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
ffestb_type1_(ffelexToken t)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
ffestb_type2_(ffelexToken t)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
ffestb_type3_(ffelexToken t)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
ffestb_type4_(ffelexToken t)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
ffestb_varlist(ffelexToken t)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
ffestb_varlist1_(ffelexToken t)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
ffestb_varlist2_(ffelexToken t)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
ffestb_varlist3_(ffelexToken t)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
ffestb_varlist4_(ffelexToken t)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
ffestb_varlist5_(ffelexToken t)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
ffestb_varlist6_(ffelexToken t)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
ffestb_R423B(ffelexToken t)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
ffestb_R522(ffelexToken t)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
ffestb_R5221_(ffelexToken t)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
ffestb_R5222_(ffelexToken t)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
ffestb_R5223_(ffelexToken t)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
ffestb_R5224_(ffelexToken t)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
ffestb_R528(ffelexToken t)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
ffestb_R5281_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_R5282_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_R5283_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_R5284_(ffelexToken t)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
ffestb_R537(ffelexToken t)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
ffestb_R5371_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_R5372_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_R5373_(ffelexToken t)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
ffestb_R542(ffelexToken t)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
ffestb_R5421_(ffelexToken t)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
ffestb_R5422_(ffelexToken t)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
ffestb_R5423_(ffelexToken t)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
ffestb_R5424_(ffelexToken t)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
ffestb_R5425_(ffelexToken t)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
ffestb_R544(ffelexToken t)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
ffestb_R5441_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_R5442_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_R5443_(ffelexToken t)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
ffestb_R5444_(ffelexToken t)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
ffestb_R834(ffelexToken t)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
ffestb_R8341_(ffelexToken t)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
ffestb_R835(ffelexToken t)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
ffestb_R8351_(ffelexToken t)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
ffestb_R838(ffelexToken t)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
ffestb_R8381_(ffelexToken t)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
ffestb_R8382_(ffelexToken t)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
ffestb_R8383_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_R840(ffelexToken t)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
ffestb_R8401_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_R8402_(ffelexToken t)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
ffestb_R8403_(ffelexToken t)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
ffestb_R8404_(ffelexToken t)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
ffestb_R8405_(ffelexToken t)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
ffestb_R8406_(ffelexToken t)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
ffestb_R8407_(ffelexToken t)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
ffestb_R841(ffelexToken t)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
ffestb_R1102(ffelexToken t)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
ffestb_R11021_(ffelexToken t)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
ffestb_block(ffelexToken t)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
ffestb_blockdata(ffelexToken t)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
ffestb_R1111_1_(ffelexToken t)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
ffestb_R1111_2_(ffelexToken t)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
ffestb_R1212(ffelexToken t)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
ffestb_R12121_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_R1227(ffelexToken t)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
ffestb_R12271_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_R1228(ffelexToken t)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
ffestb_V009(ffelexToken t)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
ffestb_construct(ffelexToken t UNUSED)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
ffestb_construct1_(ffelexToken t)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
ffestb_construct2_(ffelexToken t)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
ffestb_heap(ffelexToken t)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
ffestb_heap1_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_heap2_(ffelexToken t)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
ffestb_heap3_(ffelexToken t)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
ffestb_heap4_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_heap5_(ffelexToken t)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
ffestb_module(ffelexToken t)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
ffestb_module1_(ffelexToken t)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
ffestb_module2_(ffelexToken t)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
ffestb_module3_(ffelexToken t)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
ffestb_R809(ffelexToken t)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
ffestb_R8091_(ffelexToken t)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
ffestb_R8092_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_R8093_(ffelexToken t)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
ffestb_R810(ffelexToken t)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
ffestb_R8101_(ffelexToken t)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
ffestb_R8102_(ffelexToken t)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
ffestb_R8103_(ffelexToken ft,ffebld expr,ffelexToken t)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
ffestb_R8104_(ffelexToken ft UNUSED,ffebld expr,ffelexToken t)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
ffestb_R1001(ffelexToken t)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
ffestb_R10011_(ffelexToken t)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
ffestb_R10012_(ffelexToken t)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
ffestb_R10013_(ffelexToken t)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
ffestb_R10014_(ffelexToken t)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
ffestb_R10015_(ffelexToken t)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
ffestb_R10016_(ffelexToken t)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
ffestb_R10017_(ffelexToken t)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
ffestb_R10018_(ffelexToken t)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
ffestb_R10019_(ffelexToken t)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
ffestb_R100110_(ffelexToken t)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
ffestb_R100111_(ffelexToken t)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
ffestb_R100112_(ffelexToken t)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
ffestb_R100113_(ffelexToken t)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
ffestb_R100114_(ffelexToken t)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
ffestb_R100115_(ffelexToken ft UNUSED,ffebld expr,ffelexToken t)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
ffestb_R100116_(ffelexToken ft UNUSED,ffebld expr,ffelexToken t)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
ffestb_R100117_(ffelexToken ft UNUSED,ffebld expr,ffelexToken t)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
ffestb_R100118_(ffelexToken ft UNUSED,ffebld expr,ffelexToken t)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
ffestb_R1107(ffelexToken t)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
ffestb_R11071_(ffelexToken t)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
ffestb_R11072_(ffelexToken t)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
ffestb_R11073_(ffelexToken t)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
ffestb_R11074_(ffelexToken t)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
ffestb_R11075_(ffelexToken t)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
ffestb_R11076_(ffelexToken t)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
ffestb_R11077_(ffelexToken t)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
ffestb_R11078_(ffelexToken t)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
ffestb_R11079_(ffelexToken t)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
ffestb_R110710_(ffelexToken t)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
ffestb_R110711_(ffelexToken t)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
ffestb_R110712_(ffelexToken t)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
ffestb_R1202(ffelexToken t)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
ffestb_R12021_(ffelexToken t)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
ffestb_R12022_(ffelexToken t)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
ffestb_R12023_(ffelexToken t)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
ffestb_R12024_(ffelexToken t)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
ffestb_R12025_(ffelexToken t)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
ffestb_R12026_(ffelexToken t)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
ffestb_S3P4(ffelexToken t)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
ffestb_S3P41_(ffelexToken ft,ffebld expr,ffelexToken t)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 /* xgettext:no-c-format */
12078 ffebad_start_msg ("INCLUDE at %0 not the only statement on the source line", FFEBAD_severityWARNING);
12079 ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
12080 ffelex_token_where_column (ffesta_tokens[0]));
12081 ffebad_finish ();
12082 }
12083 ffestc_S3P4 (expr, ft);
12084 }
12085 return (ffelexHandler) ffesta_zero (t);
12086
12087 default:
12088 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INCLUDE", t);
12089 break;
12090 }
12091
12092 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12093 }
12094
12095 /* ffestb_V012 -- Parse the MAP statement
12096
12097 return ffestb_V012; // to lexer
12098
12099 Make sure the statement has a valid form for the MAP statement. If
12100 it does, implement the statement. */
12101
12102 #if FFESTR_VXT
12103 ffelexHandler
ffestb_V012(ffelexToken t)12104 ffestb_V012 (ffelexToken t)
12105 {
12106 const char *p;
12107 ffeTokenLength i;
12108
12109 switch (ffelex_token_type (ffesta_tokens[0]))
12110 {
12111 case FFELEX_typeNAME:
12112 if (ffesta_first_kw != FFESTR_firstMAP)
12113 goto bad_0; /* :::::::::::::::::::: */
12114 break;
12115
12116 case FFELEX_typeNAMES:
12117 if (ffesta_first_kw != FFESTR_firstMAP)
12118 goto bad_0; /* :::::::::::::::::::: */
12119 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlMAP)
12120 {
12121 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlMAP);
12122 goto bad_i; /* :::::::::::::::::::: */
12123 }
12124 break;
12125
12126 default:
12127 goto bad_0; /* :::::::::::::::::::: */
12128 }
12129
12130 switch (ffelex_token_type (t))
12131 {
12132 case FFELEX_typeEOS:
12133 case FFELEX_typeSEMICOLON:
12134 ffesta_confirmed ();
12135 if (!ffesta_is_inhibited ())
12136 ffestc_V012 ();
12137 return (ffelexHandler) ffesta_zero (t);
12138
12139 case FFELEX_typeCOMMA:
12140 case FFELEX_typeCOLONCOLON:
12141 ffesta_confirmed (); /* Error, but clearly intended. */
12142 goto bad_1; /* :::::::::::::::::::: */
12143
12144 default:
12145 goto bad_1; /* :::::::::::::::::::: */
12146 }
12147
12148 bad_0: /* :::::::::::::::::::: */
12149 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MAP", ffesta_tokens[0]);
12150 return (ffelexHandler) ffelex_swallow_tokens (t,
12151 (ffelexHandler) ffesta_zero); /* Invalid first token. */
12152
12153 bad_1: /* :::::::::::::::::::: */
12154 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MAP", t);
12155 return (ffelexHandler) ffelex_swallow_tokens (t,
12156 (ffelexHandler) ffesta_zero); /* Invalid second token. */
12157
12158 bad_i: /* :::::::::::::::::::: */
12159 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "MAP", ffesta_tokens[0], i, t);
12160 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12161 }
12162
12163 #endif
12164 /* ffestb_V014 -- Parse the VOLATILE statement
12165
12166 return ffestb_V014; // to lexer
12167
12168 Make sure the statement has a valid form for the VOLATILE statement. If it
12169 does, implement the statement. */
12170
12171 ffelexHandler
ffestb_V014(ffelexToken t)12172 ffestb_V014 (ffelexToken t)
12173 {
12174 ffeTokenLength i;
12175 unsigned const char *p;
12176 ffelexToken nt;
12177 ffelexHandler next;
12178
12179 switch (ffelex_token_type (ffesta_tokens[0]))
12180 {
12181 case FFELEX_typeNAME:
12182 if (ffesta_first_kw != FFESTR_firstVOLATILE)
12183 goto bad_0; /* :::::::::::::::::::: */
12184 switch (ffelex_token_type (t))
12185 {
12186 case FFELEX_typeEOS:
12187 case FFELEX_typeSEMICOLON:
12188 case FFELEX_typeCOMMA:
12189 ffesta_confirmed (); /* Error, but clearly intended. */
12190 goto bad_1; /* :::::::::::::::::::: */
12191
12192 default:
12193 goto bad_1; /* :::::::::::::::::::: */
12194
12195 case FFELEX_typeNAME:
12196 case FFELEX_typeSLASH:
12197 ffesta_confirmed ();
12198 if (!ffesta_is_inhibited ())
12199 ffestc_V014_start ();
12200 return (ffelexHandler) ffestb_V0141_ (t);
12201
12202 case FFELEX_typeCOLONCOLON:
12203 ffesta_confirmed ();
12204 if (!ffesta_is_inhibited ())
12205 ffestc_V014_start ();
12206 return (ffelexHandler) ffestb_V0141_;
12207 }
12208
12209 case FFELEX_typeNAMES:
12210 if (ffesta_first_kw != FFESTR_firstVOLATILE)
12211 goto bad_0; /* :::::::::::::::::::: */
12212 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlVOLATILE);
12213 switch (ffelex_token_type (t))
12214 {
12215 default:
12216 goto bad_1; /* :::::::::::::::::::: */
12217
12218 case FFELEX_typeCOMMA:
12219 case FFELEX_typeEOS:
12220 case FFELEX_typeSEMICOLON:
12221 ffesta_confirmed ();
12222 break;
12223
12224 case FFELEX_typeSLASH:
12225 ffesta_confirmed ();
12226 if (*p != '\0')
12227 goto bad_i; /* :::::::::::::::::::: */
12228 if (!ffesta_is_inhibited ())
12229 ffestc_V014_start ();
12230 return (ffelexHandler) ffestb_V0141_ (t);
12231
12232 case FFELEX_typeCOLONCOLON:
12233 ffesta_confirmed ();
12234 if (*p != '\0')
12235 goto bad_i; /* :::::::::::::::::::: */
12236 if (!ffesta_is_inhibited ())
12237 ffestc_V014_start ();
12238 return (ffelexHandler) ffestb_V0141_;
12239 }
12240
12241 /* Here, we have at least one char after "VOLATILE" and t is COMMA or
12242 EOS/SEMICOLON. */
12243
12244 if (!ffesrc_is_name_init (*p))
12245 goto bad_i; /* :::::::::::::::::::: */
12246 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
12247 if (!ffesta_is_inhibited ())
12248 ffestc_V014_start ();
12249 next = (ffelexHandler) ffestb_V0141_ (nt);
12250 ffelex_token_kill (nt);
12251 return (ffelexHandler) (*next) (t);
12252
12253 default:
12254 goto bad_0; /* :::::::::::::::::::: */
12255 }
12256
12257 bad_0: /* :::::::::::::::::::: */
12258 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", ffesta_tokens[0]);
12259 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12260
12261 bad_1: /* :::::::::::::::::::: */
12262 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
12263 return (ffelexHandler) ffelex_swallow_tokens (t,
12264 (ffelexHandler) ffesta_zero); /* Invalid second token. */
12265
12266 bad_i: /* :::::::::::::::::::: */
12267 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "VOLATILE", ffesta_tokens[0], i, t);
12268 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12269 }
12270
12271 /* ffestb_V0141_ -- "VOLATILE" [COLONCOLON]
12272
12273 return ffestb_V0141_; // to lexer
12274
12275 Handle NAME or SLASH. */
12276
12277 static ffelexHandler
ffestb_V0141_(ffelexToken t)12278 ffestb_V0141_ (ffelexToken t)
12279 {
12280 switch (ffelex_token_type (t))
12281 {
12282 case FFELEX_typeNAME:
12283 ffestb_local_.V014.is_cblock = FALSE;
12284 ffesta_tokens[1] = ffelex_token_use (t);
12285 return (ffelexHandler) ffestb_V0144_;
12286
12287 case FFELEX_typeSLASH:
12288 ffestb_local_.V014.is_cblock = TRUE;
12289 return (ffelexHandler) ffestb_V0142_;
12290
12291 default:
12292 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
12293 break;
12294 }
12295
12296 if (!ffesta_is_inhibited ())
12297 ffestc_V014_finish ();
12298 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12299 }
12300
12301 /* ffestb_V0142_ -- "VOLATILE" [COLONCOLON] SLASH
12302
12303 return ffestb_V0142_; // to lexer
12304
12305 Handle NAME. */
12306
12307 static ffelexHandler
ffestb_V0142_(ffelexToken t)12308 ffestb_V0142_ (ffelexToken t)
12309 {
12310 switch (ffelex_token_type (t))
12311 {
12312 case FFELEX_typeNAME:
12313 ffesta_tokens[1] = ffelex_token_use (t);
12314 return (ffelexHandler) ffestb_V0143_;
12315
12316 default:
12317 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
12318 break;
12319 }
12320
12321 if (!ffesta_is_inhibited ())
12322 ffestc_V014_finish ();
12323 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12324 }
12325
12326 /* ffestb_V0143_ -- "VOLATILE" [COLONCOLON] SLASH NAME
12327
12328 return ffestb_V0143_; // to lexer
12329
12330 Handle SLASH. */
12331
12332 static ffelexHandler
ffestb_V0143_(ffelexToken t)12333 ffestb_V0143_ (ffelexToken t)
12334 {
12335 switch (ffelex_token_type (t))
12336 {
12337 case FFELEX_typeSLASH:
12338 return (ffelexHandler) ffestb_V0144_;
12339
12340 default:
12341 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
12342 break;
12343 }
12344
12345 if (!ffesta_is_inhibited ())
12346 ffestc_V014_finish ();
12347 ffelex_token_kill (ffesta_tokens[1]);
12348 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12349 }
12350
12351 /* ffestb_V0144_ -- "VOLATILE" [COLONCOLON] R523
12352
12353 return ffestb_V0144_; // to lexer
12354
12355 Handle COMMA or EOS/SEMICOLON. */
12356
12357 static ffelexHandler
ffestb_V0144_(ffelexToken t)12358 ffestb_V0144_ (ffelexToken t)
12359 {
12360 switch (ffelex_token_type (t))
12361 {
12362 case FFELEX_typeCOMMA:
12363 if (!ffesta_is_inhibited ())
12364 {
12365 if (ffestb_local_.V014.is_cblock)
12366 ffestc_V014_item_cblock (ffesta_tokens[1]);
12367 else
12368 ffestc_V014_item_object (ffesta_tokens[1]);
12369 }
12370 ffelex_token_kill (ffesta_tokens[1]);
12371 return (ffelexHandler) ffestb_V0141_;
12372
12373 case FFELEX_typeEOS:
12374 case FFELEX_typeSEMICOLON:
12375 if (!ffesta_is_inhibited ())
12376 {
12377 if (ffestb_local_.V014.is_cblock)
12378 ffestc_V014_item_cblock (ffesta_tokens[1]);
12379 else
12380 ffestc_V014_item_object (ffesta_tokens[1]);
12381 ffestc_V014_finish ();
12382 }
12383 ffelex_token_kill (ffesta_tokens[1]);
12384 return (ffelexHandler) ffesta_zero (t);
12385
12386 default:
12387 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
12388 break;
12389 }
12390
12391 if (!ffesta_is_inhibited ())
12392 ffestc_V014_finish ();
12393 ffelex_token_kill (ffesta_tokens[1]);
12394 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12395 }
12396
12397 /* ffestb_V025 -- Parse the DEFINEFILE statement
12398
12399 return ffestb_V025; // to lexer
12400
12401 Make sure the statement has a valid form for the DEFINEFILE statement.
12402 If it does, implement the statement. */
12403
12404 #if FFESTR_VXT
12405 ffelexHandler
ffestb_V025(ffelexToken t)12406 ffestb_V025 (ffelexToken t)
12407 {
12408 ffeTokenLength i;
12409 const char *p;
12410 ffelexToken nt;
12411 ffelexHandler next;
12412
12413 ffestb_local_.V025.started = FALSE;
12414 switch (ffelex_token_type (ffesta_tokens[0]))
12415 {
12416 case FFELEX_typeNAME:
12417 switch (ffesta_first_kw)
12418 {
12419 case FFESTR_firstDEFINE:
12420 if ((ffelex_token_type (t) != FFELEX_typeNAME)
12421 || (ffesta_second_kw != FFESTR_secondFILE))
12422 goto bad_1; /* :::::::::::::::::::: */
12423 ffesta_confirmed ();
12424 return (ffelexHandler) ffestb_V0251_;
12425
12426 case FFESTR_firstDEFINEFILE:
12427 return (ffelexHandler) ffestb_V0251_ (t);
12428
12429 default:
12430 goto bad_0; /* :::::::::::::::::::: */
12431 }
12432
12433 case FFELEX_typeNAMES:
12434 if (ffesta_first_kw != FFESTR_firstDEFINEFILE)
12435 goto bad_0; /* :::::::::::::::::::: */
12436 switch (ffelex_token_type (t))
12437 {
12438 case FFELEX_typeCOMMA:
12439 case FFELEX_typeEOS:
12440 case FFELEX_typeSEMICOLON:
12441 case FFELEX_typeCOLONCOLON:
12442 ffesta_confirmed (); /* Error, but clearly intended. */
12443 goto bad_1; /* :::::::::::::::::::: */
12444
12445 default:
12446 goto bad_1; /* :::::::::::::::::::: */
12447
12448 case FFELEX_typeOPEN_PAREN:
12449 break;
12450 }
12451 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDEFINEFILE);
12452 if (ISDIGIT (*p))
12453 nt = ffelex_token_number_from_names (ffesta_tokens[0], i);
12454 else if (ffesrc_is_name_init (*p))
12455 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
12456 else
12457 goto bad_i; /* :::::::::::::::::::: */
12458 next = (ffelexHandler) ffestb_V0251_ (nt);
12459 ffelex_token_kill (nt);
12460 return (ffelexHandler) (*next) (t);
12461
12462 default:
12463 goto bad_0; /* :::::::::::::::::::: */
12464 }
12465
12466 bad_0: /* :::::::::::::::::::: */
12467 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", ffesta_tokens[0]);
12468 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12469
12470 bad_1: /* :::::::::::::::::::: */
12471 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
12472 return (ffelexHandler) ffelex_swallow_tokens (t,
12473 (ffelexHandler) ffesta_zero); /* Invalid second token. */
12474
12475 bad_i: /* :::::::::::::::::::: */
12476 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", ffesta_tokens[0], i, t);
12477 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12478 }
12479
12480 /* ffestb_V0251_ -- "DEFINEFILE" or "DEFINE" "FILE"
12481
12482 return ffestb_V0251_; // to lexer
12483
12484 Make sure the statement has a valid form for the DEFINEFILE statement. If it
12485 does, implement the statement. */
12486
12487 static ffelexHandler
ffestb_V0251_(ffelexToken t)12488 ffestb_V0251_ (ffelexToken t)
12489 {
12490 switch (ffelex_token_type (t))
12491 {
12492 case FFELEX_typeNAME:
12493 case FFELEX_typeNUMBER:
12494 if (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME)
12495 ffesta_confirmed ();
12496 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
12497 FFEEXPR_contextFILEUNIT_DF, (ffeexprCallback) ffestb_V0252_)))
12498 (t);
12499
12500 case FFELEX_typeEOS:
12501 case FFELEX_typeSEMICOLON:
12502 case FFELEX_typeCOMMA:
12503 case FFELEX_typeCOLONCOLON:
12504 ffesta_confirmed (); /* Error, but clearly intended. */
12505 break;
12506
12507 default:
12508 break;
12509 }
12510
12511 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
12512 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12513 }
12514
12515 /* ffestb_V0252_ -- "DEFINEFILE" expr
12516
12517 (ffestb_V0252_) // to expression handler
12518
12519 Make sure the statement has a valid form for the DEFINEFILE statement. If
12520 it does, implement the statement. */
12521
12522 static ffelexHandler
ffestb_V0252_(ffelexToken ft,ffebld expr,ffelexToken t)12523 ffestb_V0252_ (ffelexToken ft, ffebld expr, ffelexToken t)
12524 {
12525 switch (ffelex_token_type (t))
12526 {
12527 case FFELEX_typeOPEN_PAREN:
12528 ffestb_local_.V025.u = expr;
12529 ffesta_tokens[1] = ffelex_token_use (ft);
12530 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
12531 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0253_);
12532
12533 default:
12534 break;
12535 }
12536
12537 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
12538 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12539 }
12540
12541 /* ffestb_V0253_ -- "DEFINEFILE" expr OPEN_PAREN expr
12542
12543 (ffestb_V0253_) // to expression handler
12544
12545 Make sure the statement has a valid form for the DEFINEFILE statement. If
12546 it does, implement the statement. */
12547
12548 static ffelexHandler
ffestb_V0253_(ffelexToken ft,ffebld expr,ffelexToken t)12549 ffestb_V0253_ (ffelexToken ft, ffebld expr, ffelexToken t)
12550 {
12551 switch (ffelex_token_type (t))
12552 {
12553 case FFELEX_typeCOMMA:
12554 ffestb_local_.V025.m = expr;
12555 ffesta_tokens[2] = ffelex_token_use (ft);
12556 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
12557 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0254_);
12558
12559 default:
12560 break;
12561 }
12562
12563 ffelex_token_kill (ffesta_tokens[1]);
12564 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
12565 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12566 }
12567
12568 /* ffestb_V0254_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr
12569
12570 (ffestb_V0254_) // to expression handler
12571
12572 Make sure the statement has a valid form for the DEFINEFILE statement. If
12573 it does, implement the statement. */
12574
12575 static ffelexHandler
ffestb_V0254_(ffelexToken ft,ffebld expr,ffelexToken t)12576 ffestb_V0254_ (ffelexToken ft, ffebld expr, ffelexToken t)
12577 {
12578 switch (ffelex_token_type (t))
12579 {
12580 case FFELEX_typeCOMMA:
12581 ffestb_local_.V025.n = expr;
12582 ffesta_tokens[3] = ffelex_token_use (ft);
12583 return (ffelexHandler) ffestb_V0255_;
12584
12585 default:
12586 break;
12587 }
12588
12589 ffelex_token_kill (ffesta_tokens[1]);
12590 ffelex_token_kill (ffesta_tokens[2]);
12591 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
12592 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12593 }
12594
12595 /* ffestb_V0255_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA
12596
12597 return ffestb_V0255_; // to lexer
12598
12599 Make sure the statement has a valid form for the DEFINEFILE statement. If
12600 it does, implement the statement. */
12601
12602 static ffelexHandler
ffestb_V0255_(ffelexToken t)12603 ffestb_V0255_ (ffelexToken t)
12604 {
12605 const char *p;
12606
12607 switch (ffelex_token_type (t))
12608 {
12609 case FFELEX_typeNAME:
12610 p = ffelex_token_text (t);
12611 if (!ffesrc_char_match_init (*p, 'U', 'u') || (*++p != '\0'))
12612 break;
12613 return (ffelexHandler) ffestb_V0256_;
12614
12615 default:
12616 break;
12617 }
12618
12619 ffelex_token_kill (ffesta_tokens[1]);
12620 ffelex_token_kill (ffesta_tokens[2]);
12621 ffelex_token_kill (ffesta_tokens[3]);
12622 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
12623 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12624 }
12625
12626 /* ffestb_V0256_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA "U"
12627
12628 return ffestb_V0256_; // to lexer
12629
12630 Make sure the statement has a valid form for the DEFINEFILE statement. If
12631 it does, implement the statement. */
12632
12633 static ffelexHandler
ffestb_V0256_(ffelexToken t)12634 ffestb_V0256_ (ffelexToken t)
12635 {
12636 switch (ffelex_token_type (t))
12637 {
12638 case FFELEX_typeCOMMA:
12639 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
12640 FFEEXPR_contextFILEASSOC,
12641 (ffeexprCallback) ffestb_V0257_);
12642
12643 default:
12644 break;
12645 }
12646
12647 ffelex_token_kill (ffesta_tokens[1]);
12648 ffelex_token_kill (ffesta_tokens[2]);
12649 ffelex_token_kill (ffesta_tokens[3]);
12650 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
12651 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12652 }
12653
12654 /* ffestb_V0257_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA "U"
12655 COMMA expr
12656
12657 (ffestb_V0257_) // to expression handler
12658
12659 Make sure the statement has a valid form for the DEFINEFILE statement. If
12660 it does, implement the statement. */
12661
12662 static ffelexHandler
ffestb_V0257_(ffelexToken ft,ffebld expr,ffelexToken t)12663 ffestb_V0257_ (ffelexToken ft, ffebld expr, ffelexToken t)
12664 {
12665 switch (ffelex_token_type (t))
12666 {
12667 case FFELEX_typeCLOSE_PAREN:
12668 ffestb_local_.V025.asv = expr;
12669 ffesta_tokens[4] = ffelex_token_use (ft);
12670 return (ffelexHandler) ffestb_V0258_;
12671
12672 default:
12673 break;
12674 }
12675
12676 ffelex_token_kill (ffesta_tokens[1]);
12677 ffelex_token_kill (ffesta_tokens[2]);
12678 ffelex_token_kill (ffesta_tokens[3]);
12679 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
12680 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12681 }
12682
12683 /* ffestb_V0258_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA "U"
12684 COMMA expr CLOSE_PAREN
12685
12686 return ffestb_V0258_; // to lexer
12687
12688 Make sure the statement has a valid form for the DEFINEFILE statement. If
12689 it does, implement the statement. */
12690
12691 static ffelexHandler
ffestb_V0258_(ffelexToken t)12692 ffestb_V0258_ (ffelexToken t)
12693 {
12694 switch (ffelex_token_type (t))
12695 {
12696 case FFELEX_typeCOMMA:
12697 case FFELEX_typeEOS:
12698 case FFELEX_typeSEMICOLON:
12699 if (!ffestb_local_.V025.started)
12700 {
12701 ffesta_confirmed ();
12702 if (!ffesta_is_inhibited ())
12703 ffestc_V025_start ();
12704 ffestb_local_.V025.started = TRUE;
12705 }
12706 if (!ffesta_is_inhibited ())
12707 ffestc_V025_item (ffestb_local_.V025.u, ffesta_tokens[1],
12708 ffestb_local_.V025.m, ffesta_tokens[2],
12709 ffestb_local_.V025.n, ffesta_tokens[3],
12710 ffestb_local_.V025.asv, ffesta_tokens[4]);
12711 ffelex_token_kill (ffesta_tokens[1]);
12712 ffelex_token_kill (ffesta_tokens[2]);
12713 ffelex_token_kill (ffesta_tokens[3]);
12714 ffelex_token_kill (ffesta_tokens[4]);
12715 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
12716 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
12717 FFEEXPR_contextFILEUNIT_DF, (ffeexprCallback) ffestb_V0252_);
12718 if (!ffesta_is_inhibited ())
12719 ffestc_V025_finish ();
12720 return (ffelexHandler) ffesta_zero (t);
12721
12722 default:
12723 break;
12724 }
12725
12726 ffelex_token_kill (ffesta_tokens[1]);
12727 ffelex_token_kill (ffesta_tokens[2]);
12728 ffelex_token_kill (ffesta_tokens[3]);
12729 ffelex_token_kill (ffesta_tokens[4]);
12730 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
12731 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12732 }
12733
12734 #endif
12735 /* ffestb_subr_kill_easy_ -- Kill I/O statement data structure
12736
12737 ffestb_subr_kill_easy_();
12738
12739 Kills all tokens in the I/O data structure. Assumes that they are
12740 overlaid with each other (union) in ffest_private.h and the typing
12741 and structure references assume (though not necessarily dangerous if
12742 FALSE) that INQUIRE has the most file elements. */
12743
12744 #if FFESTB_KILL_EASY_
12745 static void
ffestb_subr_kill_easy_(ffestpInquireIx max)12746 ffestb_subr_kill_easy_ (ffestpInquireIx max)
12747 {
12748 ffestpInquireIx ix;
12749
12750 for (ix = 0; ix < max; ++ix)
12751 {
12752 if (ffestp_file.inquire.inquire_spec[ix].kw_or_val_present)
12753 {
12754 if (ffestp_file.inquire.inquire_spec[ix].kw_present)
12755 ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].kw);
12756 if (ffestp_file.inquire.inquire_spec[ix].value_present)
12757 ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].value);
12758 }
12759 }
12760 }
12761
12762 #endif
12763 /* ffestb_subr_kill_accept_ -- Kill ACCEPT statement data structure
12764
12765 ffestb_subr_kill_accept_();
12766
12767 Kills all tokens in the ACCEPT data structure. */
12768
12769 #if !FFESTB_KILL_EASY_
12770 static void
ffestb_subr_kill_accept_()12771 ffestb_subr_kill_accept_ ()
12772 {
12773 ffestpAcceptIx ix;
12774
12775 for (ix = 0; ix < FFESTP_acceptix; ++ix)
12776 {
12777 if (ffestp_file.accept.accept_spec[ix].kw_or_val_present)
12778 {
12779 if (ffestp_file.accept.accept_spec[ix].kw_present)
12780 ffelex_token_kill (ffestp_file.accept.accept_spec[ix].kw);
12781 if (ffestp_file.accept.accept_spec[ix].value_present)
12782 ffelex_token_kill (ffestp_file.accept.accept_spec[ix].value);
12783 }
12784 }
12785 }
12786
12787 #endif
12788 /* ffestb_subr_kill_beru_ -- Kill BACKSPACE/ENDFILE/REWIND/UNLOCK statement
12789 data structure
12790
12791 ffestb_subr_kill_beru_();
12792
12793 Kills all tokens in the BACKSPACE/ENDFILE/REWIND/UNLOCK data structure. */
12794
12795 #if !FFESTB_KILL_EASY_
12796 static void
ffestb_subr_kill_beru_()12797 ffestb_subr_kill_beru_ ()
12798 {
12799 ffestpBeruIx ix;
12800
12801 for (ix = 0; ix < FFESTP_beruix; ++ix)
12802 {
12803 if (ffestp_file.beru.beru_spec[ix].kw_or_val_present)
12804 {
12805 if (ffestp_file.beru.beru_spec[ix].kw_present)
12806 ffelex_token_kill (ffestp_file.beru.beru_spec[ix].kw);
12807 if (ffestp_file.beru.beru_spec[ix].value_present)
12808 ffelex_token_kill (ffestp_file.beru.beru_spec[ix].value);
12809 }
12810 }
12811 }
12812
12813 #endif
12814 /* ffestb_subr_kill_close_ -- Kill CLOSE statement data structure
12815
12816 ffestb_subr_kill_close_();
12817
12818 Kills all tokens in the CLOSE data structure. */
12819
12820 #if !FFESTB_KILL_EASY_
12821 static void
ffestb_subr_kill_close_()12822 ffestb_subr_kill_close_ ()
12823 {
12824 ffestpCloseIx ix;
12825
12826 for (ix = 0; ix < FFESTP_closeix; ++ix)
12827 {
12828 if (ffestp_file.close.close_spec[ix].kw_or_val_present)
12829 {
12830 if (ffestp_file.close.close_spec[ix].kw_present)
12831 ffelex_token_kill (ffestp_file.close.close_spec[ix].kw);
12832 if (ffestp_file.close.close_spec[ix].value_present)
12833 ffelex_token_kill (ffestp_file.close.close_spec[ix].value);
12834 }
12835 }
12836 }
12837
12838 #endif
12839 /* ffestb_subr_kill_delete_ -- Kill DELETE statement data structure
12840
12841 ffestb_subr_kill_delete_();
12842
12843 Kills all tokens in the DELETE data structure. */
12844
12845 #if !FFESTB_KILL_EASY_
12846 static void
ffestb_subr_kill_delete_()12847 ffestb_subr_kill_delete_ ()
12848 {
12849 ffestpDeleteIx ix;
12850
12851 for (ix = 0; ix < FFESTP_deleteix; ++ix)
12852 {
12853 if (ffestp_file.delete.delete_spec[ix].kw_or_val_present)
12854 {
12855 if (ffestp_file.delete.delete_spec[ix].kw_present)
12856 ffelex_token_kill (ffestp_file.delete.delete_spec[ix].kw);
12857 if (ffestp_file.delete.delete_spec[ix].value_present)
12858 ffelex_token_kill (ffestp_file.delete.delete_spec[ix].value);
12859 }
12860 }
12861 }
12862
12863 #endif
12864 /* ffestb_subr_kill_inquire_ -- Kill INQUIRE statement data structure
12865
12866 ffestb_subr_kill_inquire_();
12867
12868 Kills all tokens in the INQUIRE data structure. */
12869
12870 #if !FFESTB_KILL_EASY_
12871 static void
ffestb_subr_kill_inquire_()12872 ffestb_subr_kill_inquire_ ()
12873 {
12874 ffestpInquireIx ix;
12875
12876 for (ix = 0; ix < FFESTP_inquireix; ++ix)
12877 {
12878 if (ffestp_file.inquire.inquire_spec[ix].kw_or_val_present)
12879 {
12880 if (ffestp_file.inquire.inquire_spec[ix].kw_present)
12881 ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].kw);
12882 if (ffestp_file.inquire.inquire_spec[ix].value_present)
12883 ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].value);
12884 }
12885 }
12886 }
12887
12888 #endif
12889 /* ffestb_subr_kill_open_ -- Kill OPEN statement data structure
12890
12891 ffestb_subr_kill_open_();
12892
12893 Kills all tokens in the OPEN data structure. */
12894
12895 #if !FFESTB_KILL_EASY_
12896 static void
ffestb_subr_kill_open_()12897 ffestb_subr_kill_open_ ()
12898 {
12899 ffestpOpenIx ix;
12900
12901 for (ix = 0; ix < FFESTP_openix; ++ix)
12902 {
12903 if (ffestp_file.open.open_spec[ix].kw_or_val_present)
12904 {
12905 if (ffestp_file.open.open_spec[ix].kw_present)
12906 ffelex_token_kill (ffestp_file.open.open_spec[ix].kw);
12907 if (ffestp_file.open.open_spec[ix].value_present)
12908 ffelex_token_kill (ffestp_file.open.open_spec[ix].value);
12909 }
12910 }
12911 }
12912
12913 #endif
12914 /* ffestb_subr_kill_print_ -- Kill PRINT statement data structure
12915
12916 ffestb_subr_kill_print_();
12917
12918 Kills all tokens in the PRINT data structure. */
12919
12920 #if !FFESTB_KILL_EASY_
12921 static void
ffestb_subr_kill_print_()12922 ffestb_subr_kill_print_ ()
12923 {
12924 ffestpPrintIx ix;
12925
12926 for (ix = 0; ix < FFESTP_printix; ++ix)
12927 {
12928 if (ffestp_file.print.print_spec[ix].kw_or_val_present)
12929 {
12930 if (ffestp_file.print.print_spec[ix].kw_present)
12931 ffelex_token_kill (ffestp_file.print.print_spec[ix].kw);
12932 if (ffestp_file.print.print_spec[ix].value_present)
12933 ffelex_token_kill (ffestp_file.print.print_spec[ix].value);
12934 }
12935 }
12936 }
12937
12938 #endif
12939 /* ffestb_subr_kill_read_ -- Kill READ statement data structure
12940
12941 ffestb_subr_kill_read_();
12942
12943 Kills all tokens in the READ data structure. */
12944
12945 #if !FFESTB_KILL_EASY_
12946 static void
ffestb_subr_kill_read_()12947 ffestb_subr_kill_read_ ()
12948 {
12949 ffestpReadIx ix;
12950
12951 for (ix = 0; ix < FFESTP_readix; ++ix)
12952 {
12953 if (ffestp_file.read.read_spec[ix].kw_or_val_present)
12954 {
12955 if (ffestp_file.read.read_spec[ix].kw_present)
12956 ffelex_token_kill (ffestp_file.read.read_spec[ix].kw);
12957 if (ffestp_file.read.read_spec[ix].value_present)
12958 ffelex_token_kill (ffestp_file.read.read_spec[ix].value);
12959 }
12960 }
12961 }
12962
12963 #endif
12964 /* ffestb_subr_kill_rewrite_ -- Kill REWRITE statement data structure
12965
12966 ffestb_subr_kill_rewrite_();
12967
12968 Kills all tokens in the REWRITE data structure. */
12969
12970 #if !FFESTB_KILL_EASY_
12971 static void
ffestb_subr_kill_rewrite_()12972 ffestb_subr_kill_rewrite_ ()
12973 {
12974 ffestpRewriteIx ix;
12975
12976 for (ix = 0; ix < FFESTP_rewriteix; ++ix)
12977 {
12978 if (ffestp_file.rewrite.rewrite_spec[ix].kw_or_val_present)
12979 {
12980 if (ffestp_file.rewrite.rewrite_spec[ix].kw_present)
12981 ffelex_token_kill (ffestp_file.rewrite.rewrite_spec[ix].kw);
12982 if (ffestp_file.rewrite.rewrite_spec[ix].value_present)
12983 ffelex_token_kill (ffestp_file.rewrite.rewrite_spec[ix].value);
12984 }
12985 }
12986 }
12987
12988 #endif
12989 /* ffestb_subr_kill_type_ -- Kill TYPE statement data structure
12990
12991 ffestb_subr_kill_type_();
12992
12993 Kills all tokens in the TYPE data structure. */
12994
12995 #if !FFESTB_KILL_EASY_
12996 static void
ffestb_subr_kill_type_()12997 ffestb_subr_kill_type_ ()
12998 {
12999 ffestpTypeIx ix;
13000
13001 for (ix = 0; ix < FFESTP_typeix; ++ix)
13002 {
13003 if (ffestp_file.type.type_spec[ix].kw_or_val_present)
13004 {
13005 if (ffestp_file.type.type_spec[ix].kw_present)
13006 ffelex_token_kill (ffestp_file.type.type_spec[ix].kw);
13007 if (ffestp_file.type.type_spec[ix].value_present)
13008 ffelex_token_kill (ffestp_file.type.type_spec[ix].value);
13009 }
13010 }
13011 }
13012
13013 #endif
13014 /* ffestb_subr_kill_write_ -- Kill WRITE statement data structure
13015
13016 ffestb_subr_kill_write_();
13017
13018 Kills all tokens in the WRITE data structure. */
13019
13020 #if !FFESTB_KILL_EASY_
13021 static void
ffestb_subr_kill_write_()13022 ffestb_subr_kill_write_ ()
13023 {
13024 ffestpWriteIx ix;
13025
13026 for (ix = 0; ix < FFESTP_writeix; ++ix)
13027 {
13028 if (ffestp_file.write.write_spec[ix].kw_or_val_present)
13029 {
13030 if (ffestp_file.write.write_spec[ix].kw_present)
13031 ffelex_token_kill (ffestp_file.write.write_spec[ix].kw);
13032 if (ffestp_file.write.write_spec[ix].value_present)
13033 ffelex_token_kill (ffestp_file.write.write_spec[ix].value);
13034 }
13035 }
13036 }
13037
13038 #endif
13039 /* ffestb_beru -- Parse the BACKSPACE/ENDFILE/REWIND/UNLOCK statement
13040
13041 return ffestb_beru; // to lexer
13042
13043 Make sure the statement has a valid form for the BACKSPACE/ENDFILE/REWIND/
13044 UNLOCK statement. If it does, implement the statement. */
13045
13046 ffelexHandler
ffestb_beru(ffelexToken t)13047 ffestb_beru (ffelexToken t)
13048 {
13049 ffelexHandler next;
13050 ffestpBeruIx ix;
13051
13052 switch (ffelex_token_type (ffesta_tokens[0]))
13053 {
13054 case FFELEX_typeNAME:
13055 switch (ffelex_token_type (t))
13056 {
13057 case FFELEX_typeCOMMA:
13058 case FFELEX_typeCOLONCOLON:
13059 case FFELEX_typeEOS:
13060 case FFELEX_typeSEMICOLON:
13061 ffesta_confirmed (); /* Error, but clearly intended. */
13062 goto bad_1; /* :::::::::::::::::::: */
13063
13064 case FFELEX_typeEQUALS:
13065 case FFELEX_typePOINTS:
13066 case FFELEX_typeCOLON:
13067 goto bad_1; /* :::::::::::::::::::: */
13068
13069 case FFELEX_typeNAME:
13070 case FFELEX_typeNUMBER:
13071 ffesta_confirmed ();
13072 break;
13073
13074 case FFELEX_typeOPEN_PAREN:
13075 for (ix = 0; ix < FFESTP_beruix; ++ix)
13076 ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
13077 ffesta_tokens[1] = ffelex_token_use (t);
13078 return (ffelexHandler) ffestb_beru2_;
13079
13080 default:
13081 break;
13082 }
13083
13084 for (ix = 0; ix < FFESTP_beruix; ++ix)
13085 ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
13086 return (ffelexHandler) (*((ffelexHandler)
13087 ffeexpr_rhs (ffesta_output_pool,
13088 FFEEXPR_contextFILENUM,
13089 (ffeexprCallback) ffestb_beru1_)))
13090 (t);
13091
13092 case FFELEX_typeNAMES:
13093 switch (ffelex_token_type (t))
13094 {
13095 case FFELEX_typeCOMMA:
13096 case FFELEX_typeCOLONCOLON:
13097 ffesta_confirmed (); /* Error, but clearly intended. */
13098 goto bad_1; /* :::::::::::::::::::: */
13099
13100 case FFELEX_typeEQUALS:
13101 case FFELEX_typePOINTS:
13102 case FFELEX_typeCOLON:
13103 goto bad_1; /* :::::::::::::::::::: */
13104
13105 case FFELEX_typeEOS:
13106 case FFELEX_typeSEMICOLON:
13107 ffesta_confirmed ();
13108 break;
13109
13110 case FFELEX_typeOPEN_PAREN:
13111 if (ffelex_token_length (ffesta_tokens[0])
13112 != ffestb_args.beru.len)
13113 break;
13114
13115 for (ix = 0; ix < FFESTP_beruix; ++ix)
13116 ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
13117 ffesta_tokens[1] = ffelex_token_use (t);
13118 return (ffelexHandler) ffestb_beru2_;
13119
13120 default:
13121 break;
13122 }
13123 for (ix = 0; ix < FFESTP_beruix; ++ix)
13124 ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
13125 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13126 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_beru1_);
13127 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
13128 ffestb_args.beru.len);
13129 if (next == NULL)
13130 return (ffelexHandler) ffelex_swallow_tokens (t,
13131 (ffelexHandler) ffesta_zero);
13132 return (ffelexHandler) (*next) (t);
13133
13134 default:
13135 goto bad_0; /* :::::::::::::::::::: */
13136 }
13137
13138 bad_0: /* :::::::::::::::::::: */
13139 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, ffesta_tokens[0]);
13140 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13141
13142 bad_1: /* :::::::::::::::::::: */
13143 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
13144 return (ffelexHandler) ffelex_swallow_tokens (t,
13145 (ffelexHandler) ffesta_zero); /* Invalid second token. */
13146 }
13147
13148 /* ffestb_beru1_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" expr
13149
13150 (ffestb_beru1_) // to expression handler
13151
13152 Make sure the next token is an EOS or SEMICOLON. */
13153
13154 static ffelexHandler
ffestb_beru1_(ffelexToken ft,ffebld expr,ffelexToken t)13155 ffestb_beru1_ (ffelexToken ft, ffebld expr, ffelexToken t)
13156 {
13157 switch (ffelex_token_type (t))
13158 {
13159 case FFELEX_typeEOS:
13160 case FFELEX_typeSEMICOLON:
13161 if (expr == NULL)
13162 break;
13163 ffesta_confirmed ();
13164 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_or_val_present
13165 = TRUE;
13166 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_present = FALSE;
13167 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_present = TRUE;
13168 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_is_label
13169 = FALSE;
13170 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value
13171 = ffelex_token_use (ft);
13172 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].u.expr = expr;
13173 if (!ffesta_is_inhibited ())
13174 {
13175 switch (ffesta_first_kw)
13176 {
13177 case FFESTR_firstBACKSPACE:
13178 ffestc_R919 ();
13179 break;
13180
13181 case FFESTR_firstENDFILE:
13182 case FFESTR_firstEND:
13183 ffestc_R920 ();
13184 break;
13185
13186 case FFESTR_firstREWIND:
13187 ffestc_R921 ();
13188 break;
13189
13190 #if FFESTR_VXT
13191 case FFESTR_firstUNLOCK:
13192 ffestc_V022 ();
13193 break;
13194 #endif
13195
13196 default:
13197 assert (FALSE);
13198 }
13199 }
13200 ffestb_subr_kill_beru_ ();
13201 return (ffelexHandler) ffesta_zero (t);
13202
13203 default:
13204 break;
13205 }
13206
13207 ffestb_subr_kill_beru_ ();
13208 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
13209 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13210 }
13211
13212 /* ffestb_beru2_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN
13213
13214 return ffestb_beru2_; // to lexer
13215
13216 Handle expr construct (not NAME=expr construct) here. */
13217
13218 static ffelexHandler
ffestb_beru2_(ffelexToken t)13219 ffestb_beru2_ (ffelexToken t)
13220 {
13221 ffelexToken nt;
13222 ffelexHandler next;
13223
13224 switch (ffelex_token_type (t))
13225 {
13226 case FFELEX_typeNAME:
13227 ffesta_tokens[2] = ffelex_token_use (t);
13228 return (ffelexHandler) ffestb_beru3_;
13229
13230 default:
13231 nt = ffesta_tokens[1];
13232 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13233 FFEEXPR_contextFILENUMAMBIG, (ffeexprCallback) ffestb_beru4_)))
13234 (nt);
13235 ffelex_token_kill (nt);
13236 return (ffelexHandler) (*next) (t);
13237 }
13238 }
13239
13240 /* ffestb_beru3_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN NAME
13241
13242 return ffestb_beru3_; // to lexer
13243
13244 If EQUALS here, go to states that handle it. Else, send NAME and this
13245 token thru expression handler. */
13246
13247 static ffelexHandler
ffestb_beru3_(ffelexToken t)13248 ffestb_beru3_ (ffelexToken t)
13249 {
13250 ffelexHandler next;
13251 ffelexToken nt;
13252 ffelexToken ot;
13253
13254 switch (ffelex_token_type (t))
13255 {
13256 case FFELEX_typeEQUALS:
13257 ffelex_token_kill (ffesta_tokens[1]);
13258 nt = ffesta_tokens[2];
13259 next = (ffelexHandler) ffestb_beru5_ (nt);
13260 ffelex_token_kill (nt);
13261 return (ffelexHandler) (*next) (t);
13262
13263 default:
13264 nt = ffesta_tokens[1];
13265 ot = ffesta_tokens[2];
13266 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13267 FFEEXPR_contextFILENUMAMBIG, (ffeexprCallback) ffestb_beru4_)))
13268 (nt);
13269 ffelex_token_kill (nt);
13270 next = (ffelexHandler) (*next) (ot);
13271 ffelex_token_kill (ot);
13272 return (ffelexHandler) (*next) (t);
13273 }
13274 }
13275
13276 /* ffestb_beru4_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN expr [CLOSE_PAREN]
13277
13278 (ffestb_beru4_) // to expression handler
13279
13280 Handle COMMA or EOS/SEMICOLON here.
13281
13282 15-Feb-91 JCB 1.2
13283 Now using new mechanism whereby expr comes back as opITEM if the
13284 expr is considered part (or all) of an I/O control list (and should
13285 be stripped of its outer opITEM node) or not if it is considered
13286 a plain unit number that happens to have been enclosed in parens.
13287 26-Mar-90 JCB 1.1
13288 No longer expecting close-paren here because of constructs like
13289 BACKSPACE (5)+2, so now expecting either COMMA because it was a
13290 construct like BACKSPACE (5+2,... or EOS/SEMICOLON because it is like
13291 the former construct. Ah, the vagaries of Fortran. */
13292
13293 static ffelexHandler
ffestb_beru4_(ffelexToken ft,ffebld expr,ffelexToken t)13294 ffestb_beru4_ (ffelexToken ft, ffebld expr, ffelexToken t)
13295 {
13296 bool inlist;
13297
13298 switch (ffelex_token_type (t))
13299 {
13300 case FFELEX_typeCOMMA:
13301 case FFELEX_typeEOS:
13302 case FFELEX_typeSEMICOLON:
13303 case FFELEX_typeCLOSE_PAREN:
13304 if (expr == NULL)
13305 break;
13306 if (ffebld_op (expr) == FFEBLD_opITEM)
13307 {
13308 inlist = TRUE;
13309 expr = ffebld_head (expr);
13310 }
13311 else
13312 inlist = FALSE;
13313 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_or_val_present
13314 = TRUE;
13315 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_present = FALSE;
13316 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_present = TRUE;
13317 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_is_label
13318 = FALSE;
13319 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value
13320 = ffelex_token_use (ft);
13321 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].u.expr = expr;
13322 if (inlist)
13323 return (ffelexHandler) ffestb_beru9_ (t);
13324 return (ffelexHandler) ffestb_beru10_ (t);
13325
13326 default:
13327 break;
13328 }
13329
13330 ffestb_subr_kill_beru_ ();
13331 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
13332 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13333 }
13334
13335 /* ffestb_beru5_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN [external-file-unit
13336 COMMA]
13337
13338 return ffestb_beru5_; // to lexer
13339
13340 Handle expr construct (not NAME=expr construct) here. */
13341
13342 static ffelexHandler
ffestb_beru5_(ffelexToken t)13343 ffestb_beru5_ (ffelexToken t)
13344 {
13345 ffestrGenio kw;
13346
13347 ffestb_local_.beru.label = FALSE;
13348
13349 switch (ffelex_token_type (t))
13350 {
13351 case FFELEX_typeNAME:
13352 kw = ffestr_genio (t);
13353 switch (kw)
13354 {
13355 case FFESTR_genioERR:
13356 ffestb_local_.beru.ix = FFESTP_beruixERR;
13357 ffestb_local_.beru.label = TRUE;
13358 break;
13359
13360 case FFESTR_genioIOSTAT:
13361 ffestb_local_.beru.ix = FFESTP_beruixIOSTAT;
13362 ffestb_local_.beru.left = TRUE;
13363 ffestb_local_.beru.context = FFEEXPR_contextFILEINT;
13364 break;
13365
13366 case FFESTR_genioUNIT:
13367 ffestb_local_.beru.ix = FFESTP_beruixUNIT;
13368 ffestb_local_.beru.left = FALSE;
13369 ffestb_local_.beru.context = FFEEXPR_contextFILENUM;
13370 break;
13371
13372 default:
13373 goto bad; /* :::::::::::::::::::: */
13374 }
13375 if (ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
13376 .kw_or_val_present)
13377 break; /* Can't specify a keyword twice! */
13378 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
13379 .kw_or_val_present = TRUE;
13380 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
13381 .kw_present = TRUE;
13382 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
13383 .value_present = FALSE;
13384 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value_is_label
13385 = ffestb_local_.beru.label;
13386 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].kw
13387 = ffelex_token_use (t);
13388 return (ffelexHandler) ffestb_beru6_;
13389
13390 default:
13391 break;
13392 }
13393
13394 bad: /* :::::::::::::::::::: */
13395 ffestb_subr_kill_beru_ ();
13396 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
13397 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13398 }
13399
13400 /* ffestb_beru6_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN [external-file-unit
13401 COMMA] NAME
13402
13403 return ffestb_beru6_; // to lexer
13404
13405 Make sure EQUALS here, send next token to expression handler. */
13406
13407 static ffelexHandler
ffestb_beru6_(ffelexToken t)13408 ffestb_beru6_ (ffelexToken t)
13409 {
13410
13411 switch (ffelex_token_type (t))
13412 {
13413 case FFELEX_typeEQUALS:
13414 ffesta_confirmed ();
13415 if (ffestb_local_.beru.label)
13416 return (ffelexHandler) ffestb_beru8_;
13417 if (ffestb_local_.beru.left)
13418 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
13419 ffestb_local_.beru.context,
13420 (ffeexprCallback) ffestb_beru7_);
13421 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13422 ffestb_local_.beru.context,
13423 (ffeexprCallback) ffestb_beru7_);
13424
13425 default:
13426 break;
13427 }
13428
13429 ffestb_subr_kill_beru_ ();
13430 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
13431 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13432 }
13433
13434 /* ffestb_beru7_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... NAME EQUALS expr
13435
13436 (ffestb_beru7_) // to expression handler
13437
13438 Handle COMMA or CLOSE_PAREN here. */
13439
13440 static ffelexHandler
ffestb_beru7_(ffelexToken ft,ffebld expr,ffelexToken t)13441 ffestb_beru7_ (ffelexToken ft, ffebld expr, ffelexToken t)
13442 {
13443 switch (ffelex_token_type (t))
13444 {
13445 case FFELEX_typeCOMMA:
13446 case FFELEX_typeCLOSE_PAREN:
13447 if (expr == NULL)
13448 break;
13449 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value_present
13450 = TRUE;
13451 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value
13452 = ffelex_token_use (ft);
13453 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].u.expr = expr;
13454 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
13455 return (ffelexHandler) ffestb_beru5_;
13456 return (ffelexHandler) ffestb_beru10_;
13457
13458 default:
13459 break;
13460 }
13461
13462 ffestb_subr_kill_beru_ ();
13463 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
13464 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13465 }
13466
13467 /* ffestb_beru8_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... NAME EQUALS
13468
13469 return ffestb_beru8_; // to lexer
13470
13471 Handle NUMBER for label here. */
13472
13473 static ffelexHandler
ffestb_beru8_(ffelexToken t)13474 ffestb_beru8_ (ffelexToken t)
13475 {
13476 switch (ffelex_token_type (t))
13477 {
13478 case FFELEX_typeNUMBER:
13479 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value_present
13480 = TRUE;
13481 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value
13482 = ffelex_token_use (t);
13483 return (ffelexHandler) ffestb_beru9_;
13484
13485 default:
13486 break;
13487 }
13488
13489 ffestb_subr_kill_beru_ ();
13490 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
13491 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13492 }
13493
13494 /* ffestb_beru9_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... NAME EQUALS
13495 NUMBER
13496
13497 return ffestb_beru9_; // to lexer
13498
13499 Handle COMMA or CLOSE_PAREN here. */
13500
13501 static ffelexHandler
ffestb_beru9_(ffelexToken t)13502 ffestb_beru9_ (ffelexToken t)
13503 {
13504 switch (ffelex_token_type (t))
13505 {
13506 case FFELEX_typeCOMMA:
13507 return (ffelexHandler) ffestb_beru5_;
13508
13509 case FFELEX_typeCLOSE_PAREN:
13510 return (ffelexHandler) ffestb_beru10_;
13511
13512 default:
13513 break;
13514 }
13515
13516 ffestb_subr_kill_beru_ ();
13517 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
13518 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13519 }
13520
13521 /* ffestb_beru10_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... CLOSE_PAREN
13522
13523 return ffestb_beru10_; // to lexer
13524
13525 Handle EOS or SEMICOLON here. */
13526
13527 static ffelexHandler
ffestb_beru10_(ffelexToken t)13528 ffestb_beru10_ (ffelexToken t)
13529 {
13530 switch (ffelex_token_type (t))
13531 {
13532 case FFELEX_typeEOS:
13533 case FFELEX_typeSEMICOLON:
13534 ffesta_confirmed ();
13535 if (!ffesta_is_inhibited ())
13536 {
13537 switch (ffesta_first_kw)
13538 {
13539 case FFESTR_firstBACKSPACE:
13540 ffestc_R919 ();
13541 break;
13542
13543 case FFESTR_firstENDFILE:
13544 case FFESTR_firstEND:
13545 ffestc_R920 ();
13546 break;
13547
13548 case FFESTR_firstREWIND:
13549 ffestc_R921 ();
13550 break;
13551
13552 #if FFESTR_VXT
13553 case FFESTR_firstUNLOCK:
13554 ffestc_V022 ();
13555 break;
13556 #endif
13557
13558 default:
13559 assert (FALSE);
13560 }
13561 }
13562 ffestb_subr_kill_beru_ ();
13563 return (ffelexHandler) ffesta_zero (t);
13564
13565 default:
13566 break;
13567 }
13568
13569 ffestb_subr_kill_beru_ ();
13570 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
13571 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13572 }
13573
13574 /* ffestb_vxtcode -- Parse the VXT DECODE/ENCODE statement
13575
13576 return ffestb_vxtcode; // to lexer
13577
13578 Make sure the statement has a valid form for the VXT DECODE/ENCODE
13579 statement. If it does, implement the statement. */
13580
13581 #if FFESTR_VXT
13582 ffelexHandler
ffestb_vxtcode(ffelexToken t)13583 ffestb_vxtcode (ffelexToken t)
13584 {
13585 ffestpVxtcodeIx ix;
13586
13587 switch (ffelex_token_type (ffesta_tokens[0]))
13588 {
13589 case FFELEX_typeNAME:
13590 switch (ffelex_token_type (t))
13591 {
13592 case FFELEX_typeCOMMA:
13593 case FFELEX_typeCOLONCOLON:
13594 case FFELEX_typeEOS:
13595 case FFELEX_typeSEMICOLON:
13596 case FFELEX_typeNAME:
13597 case FFELEX_typeNUMBER:
13598 ffesta_confirmed (); /* Error, but clearly intended. */
13599 goto bad_1; /* :::::::::::::::::::: */
13600
13601 default:
13602 goto bad_1; /* :::::::::::::::::::: */
13603
13604 case FFELEX_typeOPEN_PAREN:
13605 for (ix = 0; ix < FFESTP_vxtcodeix; ++ix)
13606 ffestp_file.vxtcode.vxtcode_spec[ix].kw_or_val_present = FALSE;
13607 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13608 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_vxtcode1_);
13609 }
13610
13611 case FFELEX_typeNAMES:
13612 switch (ffelex_token_type (t))
13613 {
13614 case FFELEX_typeEOS:
13615 case FFELEX_typeSEMICOLON:
13616 case FFELEX_typeCOMMA:
13617 case FFELEX_typeCOLONCOLON:
13618 ffesta_confirmed (); /* Error, but clearly intended. */
13619 goto bad_1; /* :::::::::::::::::::: */
13620
13621 default:
13622 goto bad_1; /* :::::::::::::::::::: */
13623
13624 case FFELEX_typeOPEN_PAREN:
13625 if (ffelex_token_length (ffesta_tokens[0])
13626 != ffestb_args.vxtcode.len)
13627 goto bad_0; /* :::::::::::::::::::: */
13628
13629 for (ix = 0; ix < FFESTP_vxtcodeix; ++ix)
13630 ffestp_file.vxtcode.vxtcode_spec[ix].kw_or_val_present = FALSE;
13631 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13632 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_vxtcode1_);
13633 }
13634
13635 default:
13636 goto bad_0; /* :::::::::::::::::::: */
13637 }
13638
13639 bad_0: /* :::::::::::::::::::: */
13640 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, ffesta_tokens[0]);
13641 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13642
13643 bad_1: /* :::::::::::::::::::: */
13644 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
13645 return (ffelexHandler) ffelex_swallow_tokens (t,
13646 (ffelexHandler) ffesta_zero); /* Invalid second token. */
13647 }
13648
13649 /* ffestb_vxtcode1_ -- "VXTCODE" OPEN_PAREN expr
13650
13651 (ffestb_vxtcode1_) // to expression handler
13652
13653 Handle COMMA here. */
13654
13655 static ffelexHandler
ffestb_vxtcode1_(ffelexToken ft,ffebld expr,ffelexToken t)13656 ffestb_vxtcode1_ (ffelexToken ft, ffebld expr, ffelexToken t)
13657 {
13658 switch (ffelex_token_type (t))
13659 {
13660 case FFELEX_typeCOMMA:
13661 if (expr == NULL)
13662 break;
13663 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].kw_or_val_present
13664 = TRUE;
13665 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].kw_present = FALSE;
13666 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].value_present = TRUE;
13667 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].value_is_label
13668 = FALSE;
13669 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].value
13670 = ffelex_token_use (ft);
13671 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].u.expr = expr;
13672 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13673 FFEEXPR_contextFILEFORMAT, (ffeexprCallback) ffestb_vxtcode2_);
13674
13675 default:
13676 break;
13677 }
13678
13679 ffestb_subr_kill_vxtcode_ ();
13680 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
13681 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13682 }
13683
13684 /* ffestb_vxtcode2_ -- "VXTCODE" OPEN_PAREN expr COMMA expr
13685
13686 (ffestb_vxtcode2_) // to expression handler
13687
13688 Handle COMMA here. */
13689
13690 static ffelexHandler
ffestb_vxtcode2_(ffelexToken ft,ffebld expr,ffelexToken t)13691 ffestb_vxtcode2_ (ffelexToken ft, ffebld expr, ffelexToken t)
13692 {
13693 switch (ffelex_token_type (t))
13694 {
13695 case FFELEX_typeCOMMA:
13696 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].kw_or_val_present
13697 = TRUE;
13698 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].kw_present = FALSE;
13699 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].value_present = TRUE;
13700 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].value_is_label
13701 = (expr == NULL);
13702 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].value
13703 = ffelex_token_use (ft);
13704 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].u.expr = expr;
13705 if (ffesta_first_kw == FFESTR_firstENCODE)
13706 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
13707 FFEEXPR_contextFILEVXTCODE,
13708 (ffeexprCallback) ffestb_vxtcode3_);
13709 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13710 FFEEXPR_contextFILEVXTCODE,
13711 (ffeexprCallback) ffestb_vxtcode3_);
13712
13713 default:
13714 break;
13715 }
13716
13717 ffestb_subr_kill_vxtcode_ ();
13718 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
13719 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13720 }
13721
13722 /* ffestb_vxtcode3_ -- "VXTCODE" OPEN_PAREN expr COMMA expr COMMA expr
13723
13724 (ffestb_vxtcode3_) // to expression handler
13725
13726 Handle COMMA or CLOSE_PAREN here. */
13727
13728 static ffelexHandler
ffestb_vxtcode3_(ffelexToken ft,ffebld expr,ffelexToken t)13729 ffestb_vxtcode3_ (ffelexToken ft, ffebld expr, ffelexToken t)
13730 {
13731 switch (ffelex_token_type (t))
13732 {
13733 case FFELEX_typeCOMMA:
13734 case FFELEX_typeCLOSE_PAREN:
13735 if (expr == NULL)
13736 break;
13737 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].kw_or_val_present
13738 = TRUE;
13739 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].kw_present = FALSE;
13740 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].value_present = TRUE;
13741 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].value_is_label
13742 = FALSE;
13743 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].value
13744 = ffelex_token_use (ft);
13745 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].u.expr = expr;
13746 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
13747 return (ffelexHandler) ffestb_vxtcode4_;
13748 return (ffelexHandler) ffestb_vxtcode9_;
13749
13750 default:
13751 break;
13752 }
13753
13754 ffestb_subr_kill_vxtcode_ ();
13755 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
13756 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13757 }
13758
13759 /* ffestb_vxtcode4_ -- "VXTCODE" OPEN_PAREN ...
13760
13761 return ffestb_vxtcode4_; // to lexer
13762
13763 Handle NAME=expr construct here. */
13764
13765 static ffelexHandler
ffestb_vxtcode4_(ffelexToken t)13766 ffestb_vxtcode4_ (ffelexToken t)
13767 {
13768 ffestrGenio kw;
13769
13770 ffestb_local_.vxtcode.label = FALSE;
13771
13772 switch (ffelex_token_type (t))
13773 {
13774 case FFELEX_typeNAME:
13775 kw = ffestr_genio (t);
13776 switch (kw)
13777 {
13778 case FFESTR_genioERR:
13779 ffestb_local_.vxtcode.ix = FFESTP_vxtcodeixERR;
13780 ffestb_local_.vxtcode.label = TRUE;
13781 break;
13782
13783 case FFESTR_genioIOSTAT:
13784 ffestb_local_.vxtcode.ix = FFESTP_vxtcodeixIOSTAT;
13785 ffestb_local_.vxtcode.left = TRUE;
13786 ffestb_local_.vxtcode.context = FFEEXPR_contextFILEINT;
13787 break;
13788
13789 default:
13790 goto bad; /* :::::::::::::::::::: */
13791 }
13792 if (ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix]
13793 .kw_or_val_present)
13794 break; /* Can't specify a keyword twice! */
13795 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix]
13796 .kw_or_val_present = TRUE;
13797 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix]
13798 .kw_present = TRUE;
13799 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix]
13800 .value_present = FALSE;
13801 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value_is_label
13802 = ffestb_local_.vxtcode.label;
13803 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].kw
13804 = ffelex_token_use (t);
13805 return (ffelexHandler) ffestb_vxtcode5_;
13806
13807 default:
13808 break;
13809 }
13810
13811 bad: /* :::::::::::::::::::: */
13812 ffestb_subr_kill_vxtcode_ ();
13813 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
13814 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13815 }
13816
13817 /* ffestb_vxtcode5_ -- "VXTCODE" OPEN_PAREN [external-file-unit COMMA [format
13818 COMMA]] NAME
13819
13820 return ffestb_vxtcode5_; // to lexer
13821
13822 Make sure EQUALS here, send next token to expression handler. */
13823
13824 static ffelexHandler
ffestb_vxtcode5_(ffelexToken t)13825 ffestb_vxtcode5_ (ffelexToken t)
13826 {
13827 switch (ffelex_token_type (t))
13828 {
13829 case FFELEX_typeEQUALS:
13830 ffesta_confirmed ();
13831 if (ffestb_local_.vxtcode.label)
13832 return (ffelexHandler) ffestb_vxtcode7_;
13833 if (ffestb_local_.vxtcode.left)
13834 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
13835 ffestb_local_.vxtcode.context,
13836 (ffeexprCallback) ffestb_vxtcode6_);
13837 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13838 ffestb_local_.vxtcode.context,
13839 (ffeexprCallback) ffestb_vxtcode6_);
13840
13841 default:
13842 break;
13843 }
13844
13845 ffestb_subr_kill_vxtcode_ ();
13846 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
13847 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13848 }
13849
13850 /* ffestb_vxtcode6_ -- "VXTCODE" OPEN_PAREN ... NAME EQUALS expr
13851
13852 (ffestb_vxtcode6_) // to expression handler
13853
13854 Handle COMMA or CLOSE_PAREN here. */
13855
13856 static ffelexHandler
ffestb_vxtcode6_(ffelexToken ft,ffebld expr,ffelexToken t)13857 ffestb_vxtcode6_ (ffelexToken ft, ffebld expr, ffelexToken t)
13858 {
13859 switch (ffelex_token_type (t))
13860 {
13861 case FFELEX_typeCOMMA:
13862 case FFELEX_typeCLOSE_PAREN:
13863 if (expr == NULL)
13864 break;
13865 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value_present
13866 = TRUE;
13867 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value
13868 = ffelex_token_use (ft);
13869 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].u.expr = expr;
13870 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
13871 return (ffelexHandler) ffestb_vxtcode4_;
13872 return (ffelexHandler) ffestb_vxtcode9_;
13873
13874 default:
13875 break;
13876 }
13877
13878 ffestb_subr_kill_vxtcode_ ();
13879 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
13880 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13881 }
13882
13883 /* ffestb_vxtcode7_ -- "VXTCODE" OPEN_PAREN ... NAME EQUALS
13884
13885 return ffestb_vxtcode7_; // to lexer
13886
13887 Handle NUMBER for label here. */
13888
13889 static ffelexHandler
ffestb_vxtcode7_(ffelexToken t)13890 ffestb_vxtcode7_ (ffelexToken t)
13891 {
13892 switch (ffelex_token_type (t))
13893 {
13894 case FFELEX_typeNUMBER:
13895 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value_present
13896 = TRUE;
13897 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value
13898 = ffelex_token_use (t);
13899 return (ffelexHandler) ffestb_vxtcode8_;
13900
13901 default:
13902 break;
13903 }
13904
13905 ffestb_subr_kill_vxtcode_ ();
13906 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
13907 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13908 }
13909
13910 /* ffestb_vxtcode8_ -- "VXTCODE" OPEN_PAREN ... NAME EQUALS NUMBER
13911
13912 return ffestb_vxtcode8_; // to lexer
13913
13914 Handle COMMA or CLOSE_PAREN here. */
13915
13916 static ffelexHandler
ffestb_vxtcode8_(ffelexToken t)13917 ffestb_vxtcode8_ (ffelexToken t)
13918 {
13919 switch (ffelex_token_type (t))
13920 {
13921 case FFELEX_typeCOMMA:
13922 return (ffelexHandler) ffestb_vxtcode4_;
13923
13924 case FFELEX_typeCLOSE_PAREN:
13925 return (ffelexHandler) ffestb_vxtcode9_;
13926
13927 default:
13928 break;
13929 }
13930
13931 ffestb_subr_kill_vxtcode_ ();
13932 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
13933 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13934 }
13935
13936 /* ffestb_vxtcode9_ -- "VXTCODE" OPEN_PAREN ... CLOSE_PAREN
13937
13938 return ffestb_vxtcode9_; // to lexer
13939
13940 Handle EOS or SEMICOLON here.
13941
13942 07-Jun-90 JCB 1.1
13943 Context for ENCODE/DECODE expressions is now IOLISTDF instead of IOLIST
13944 since they apply to internal files. */
13945
13946 static ffelexHandler
ffestb_vxtcode9_(ffelexToken t)13947 ffestb_vxtcode9_ (ffelexToken t)
13948 {
13949 ffelexHandler next;
13950
13951 switch (ffelex_token_type (t))
13952 {
13953 case FFELEX_typeEOS:
13954 case FFELEX_typeSEMICOLON:
13955 ffesta_confirmed ();
13956 if (!ffesta_is_inhibited ())
13957 {
13958 if (ffesta_first_kw == FFESTR_firstENCODE)
13959 {
13960 ffestc_V023_start ();
13961 ffestc_V023_finish ();
13962 }
13963 else
13964 {
13965 ffestc_V024_start ();
13966 ffestc_V024_finish ();
13967 }
13968 }
13969 ffestb_subr_kill_vxtcode_ ();
13970 return (ffelexHandler) ffesta_zero (t);
13971
13972 case FFELEX_typeNAME:
13973 case FFELEX_typeOPEN_PAREN:
13974 case FFELEX_typeCOMMA:
13975 ffesta_confirmed ();
13976 if (!ffesta_is_inhibited ())
13977 if (ffesta_first_kw == FFESTR_firstENCODE)
13978 ffestc_V023_start ();
13979 else
13980 ffestc_V024_start ();
13981 ffestb_subr_kill_vxtcode_ ();
13982 if (ffesta_first_kw == FFESTR_firstDECODE)
13983 next = (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
13984 FFEEXPR_contextIOLISTDF,
13985 (ffeexprCallback) ffestb_vxtcode10_);
13986 else
13987 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13988 FFEEXPR_contextIOLISTDF,
13989 (ffeexprCallback) ffestb_vxtcode10_);
13990
13991 /* EXTENSION: Allow an optional preceding COMMA here if not pedantic.
13992 (f2c provides this extension, as do other compilers, supposedly.) */
13993
13994 if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA))
13995 return next;
13996
13997 return (ffelexHandler) (*next) (t);
13998
13999 default:
14000 break;
14001 }
14002
14003 ffestb_subr_kill_vxtcode_ ();
14004 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
14005 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14006 }
14007
14008 /* ffestb_vxtcode10_ -- "VXTCODE(...)" expr
14009
14010 (ffestb_vxtcode10_) // to expression handler
14011
14012 Handle COMMA or EOS/SEMICOLON here.
14013
14014 07-Jun-90 JCB 1.1
14015 Context for ENCODE/DECODE expressions is now IOLISTDF instead of IOLIST
14016 since they apply to internal files. */
14017
14018 static ffelexHandler
ffestb_vxtcode10_(ffelexToken ft,ffebld expr,ffelexToken t)14019 ffestb_vxtcode10_ (ffelexToken ft, ffebld expr, ffelexToken t)
14020 {
14021 switch (ffelex_token_type (t))
14022 {
14023 case FFELEX_typeCOMMA:
14024 if (expr == NULL)
14025 break;
14026 if (!ffesta_is_inhibited ())
14027 if (ffesta_first_kw == FFESTR_firstENCODE)
14028 ffestc_V023_item (expr, ft);
14029 else
14030 ffestc_V024_item (expr, ft);
14031 if (ffesta_first_kw == FFESTR_firstDECODE)
14032 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
14033 FFEEXPR_contextIOLISTDF,
14034 (ffeexprCallback) ffestb_vxtcode10_);
14035 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
14036 FFEEXPR_contextIOLISTDF,
14037 (ffeexprCallback) ffestb_vxtcode10_);
14038
14039 case FFELEX_typeEOS:
14040 case FFELEX_typeSEMICOLON:
14041 if (expr == NULL)
14042 break;
14043 if (!ffesta_is_inhibited ())
14044 {
14045 if (ffesta_first_kw == FFESTR_firstENCODE)
14046 {
14047 ffestc_V023_item (expr, ft);
14048 ffestc_V023_finish ();
14049 }
14050 else
14051 {
14052 ffestc_V024_item (expr, ft);
14053 ffestc_V024_finish ();
14054 }
14055 }
14056 return (ffelexHandler) ffesta_zero (t);
14057
14058 default:
14059 break;
14060 }
14061
14062 if (!ffesta_is_inhibited ())
14063 if (ffesta_first_kw == FFESTR_firstENCODE)
14064 ffestc_V023_finish ();
14065 else
14066 ffestc_V024_finish ();
14067 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
14068 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14069 }
14070
14071 #endif
14072 /* ffestb_R904 -- Parse an OPEN statement
14073
14074 return ffestb_R904; // to lexer
14075
14076 Make sure the statement has a valid form for an OPEN statement.
14077 If it does, implement the statement. */
14078
14079 ffelexHandler
ffestb_R904(ffelexToken t)14080 ffestb_R904 (ffelexToken t)
14081 {
14082 ffestpOpenIx ix;
14083
14084 switch (ffelex_token_type (ffesta_tokens[0]))
14085 {
14086 case FFELEX_typeNAME:
14087 if (ffesta_first_kw != FFESTR_firstOPEN)
14088 goto bad_0; /* :::::::::::::::::::: */
14089 break;
14090
14091 case FFELEX_typeNAMES:
14092 if (ffesta_first_kw != FFESTR_firstOPEN)
14093 goto bad_0; /* :::::::::::::::::::: */
14094 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlOPEN)
14095 goto bad_0; /* :::::::::::::::::::: */
14096 break;
14097
14098 default:
14099 goto bad_0; /* :::::::::::::::::::: */
14100 }
14101
14102 switch (ffelex_token_type (t))
14103 {
14104 case FFELEX_typeOPEN_PAREN:
14105 break;
14106
14107 case FFELEX_typeEOS:
14108 case FFELEX_typeSEMICOLON:
14109 case FFELEX_typeCOMMA:
14110 case FFELEX_typeCOLONCOLON:
14111 ffesta_confirmed (); /* Error, but clearly intended. */
14112 goto bad_1; /* :::::::::::::::::::: */
14113
14114 default:
14115 goto bad_1; /* :::::::::::::::::::: */
14116 }
14117
14118 for (ix = 0; ix < FFESTP_openix; ++ix)
14119 ffestp_file.open.open_spec[ix].kw_or_val_present = FALSE;
14120
14121 return (ffelexHandler) ffestb_R9041_;
14122
14123 bad_0: /* :::::::::::::::::::: */
14124 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", ffesta_tokens[0]);
14125 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14126
14127 bad_1: /* :::::::::::::::::::: */
14128 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
14129 return (ffelexHandler) ffelex_swallow_tokens (t,
14130 (ffelexHandler) ffesta_zero); /* Invalid second token. */
14131 }
14132
14133 /* ffestb_R9041_ -- "OPEN" OPEN_PAREN
14134
14135 return ffestb_R9041_; // to lexer
14136
14137 Handle expr construct (not NAME=expr construct) here. */
14138
14139 static ffelexHandler
ffestb_R9041_(ffelexToken t)14140 ffestb_R9041_ (ffelexToken t)
14141 {
14142 switch (ffelex_token_type (t))
14143 {
14144 case FFELEX_typeNAME:
14145 ffesta_tokens[1] = ffelex_token_use (t);
14146 return (ffelexHandler) ffestb_R9042_;
14147
14148 default:
14149 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
14150 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9043_)))
14151 (t);
14152 }
14153 }
14154
14155 /* ffestb_R9042_ -- "OPEN" OPEN_PAREN NAME
14156
14157 return ffestb_R9042_; // to lexer
14158
14159 If EQUALS here, go to states that handle it. Else, send NAME and this
14160 token thru expression handler. */
14161
14162 static ffelexHandler
ffestb_R9042_(ffelexToken t)14163 ffestb_R9042_ (ffelexToken t)
14164 {
14165 ffelexHandler next;
14166 ffelexToken nt;
14167
14168 switch (ffelex_token_type (t))
14169 {
14170 case FFELEX_typeEQUALS:
14171 nt = ffesta_tokens[1];
14172 next = (ffelexHandler) ffestb_R9044_ (nt);
14173 ffelex_token_kill (nt);
14174 return (ffelexHandler) (*next) (t);
14175
14176 default:
14177 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
14178 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9043_)))
14179 (ffesta_tokens[1]);
14180 ffelex_token_kill (ffesta_tokens[1]);
14181 return (ffelexHandler) (*next) (t);
14182 }
14183 }
14184
14185 /* ffestb_R9043_ -- "OPEN" OPEN_PAREN expr
14186
14187 (ffestb_R9043_) // to expression handler
14188
14189 Handle COMMA or CLOSE_PAREN here. */
14190
14191 static ffelexHandler
ffestb_R9043_(ffelexToken ft,ffebld expr,ffelexToken t)14192 ffestb_R9043_ (ffelexToken ft, ffebld expr, ffelexToken t)
14193 {
14194 switch (ffelex_token_type (t))
14195 {
14196 case FFELEX_typeCOMMA:
14197 case FFELEX_typeCLOSE_PAREN:
14198 if (expr == NULL)
14199 break;
14200 ffestp_file.open.open_spec[FFESTP_openixUNIT].kw_or_val_present
14201 = TRUE;
14202 ffestp_file.open.open_spec[FFESTP_openixUNIT].kw_present = FALSE;
14203 ffestp_file.open.open_spec[FFESTP_openixUNIT].value_present = TRUE;
14204 ffestp_file.open.open_spec[FFESTP_openixUNIT].value_is_label
14205 = FALSE;
14206 ffestp_file.open.open_spec[FFESTP_openixUNIT].value
14207 = ffelex_token_use (ft);
14208 ffestp_file.open.open_spec[FFESTP_openixUNIT].u.expr = expr;
14209 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
14210 return (ffelexHandler) ffestb_R9044_;
14211 return (ffelexHandler) ffestb_R9049_;
14212
14213 default:
14214 break;
14215 }
14216
14217 ffestb_subr_kill_open_ ();
14218 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
14219 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14220 }
14221
14222 /* ffestb_R9044_ -- "OPEN" OPEN_PAREN [external-file-unit COMMA]
14223
14224 return ffestb_R9044_; // to lexer
14225
14226 Handle expr construct (not NAME=expr construct) here. */
14227
14228 static ffelexHandler
ffestb_R9044_(ffelexToken t)14229 ffestb_R9044_ (ffelexToken t)
14230 {
14231 ffestrOpen kw;
14232
14233 ffestb_local_.open.label = FALSE;
14234
14235 switch (ffelex_token_type (t))
14236 {
14237 case FFELEX_typeNAME:
14238 kw = ffestr_open (t);
14239 switch (kw)
14240 {
14241 case FFESTR_openACCESS:
14242 ffestb_local_.open.ix = FFESTP_openixACCESS;
14243 ffestb_local_.open.left = FALSE;
14244 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
14245 break;
14246
14247 case FFESTR_openACTION:
14248 ffestb_local_.open.ix = FFESTP_openixACTION;
14249 ffestb_local_.open.left = FALSE;
14250 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
14251 break;
14252
14253 case FFESTR_openASSOCIATEVARIABLE:
14254 ffestb_local_.open.ix = FFESTP_openixASSOCIATEVARIABLE;
14255 ffestb_local_.open.left = TRUE;
14256 ffestb_local_.open.context = FFEEXPR_contextFILEASSOC;
14257 break;
14258
14259 case FFESTR_openBLANK:
14260 ffestb_local_.open.ix = FFESTP_openixBLANK;
14261 ffestb_local_.open.left = FALSE;
14262 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
14263 break;
14264
14265 case FFESTR_openBLOCKSIZE:
14266 ffestb_local_.open.ix = FFESTP_openixBLOCKSIZE;
14267 ffestb_local_.open.left = FALSE;
14268 ffestb_local_.open.context = FFEEXPR_contextFILENUM;
14269 break;
14270
14271 case FFESTR_openBUFFERCOUNT:
14272 ffestb_local_.open.ix = FFESTP_openixBUFFERCOUNT;
14273 ffestb_local_.open.left = FALSE;
14274 ffestb_local_.open.context = FFEEXPR_contextFILENUM;
14275 break;
14276
14277 case FFESTR_openCARRIAGECONTROL:
14278 ffestb_local_.open.ix = FFESTP_openixCARRIAGECONTROL;
14279 ffestb_local_.open.left = FALSE;
14280 ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
14281 break;
14282
14283 case FFESTR_openDEFAULTFILE:
14284 ffestb_local_.open.ix = FFESTP_openixDEFAULTFILE;
14285 ffestb_local_.open.left = FALSE;
14286 ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
14287 break;
14288
14289 case FFESTR_openDELIM:
14290 ffestb_local_.open.ix = FFESTP_openixDELIM;
14291 ffestb_local_.open.left = FALSE;
14292 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
14293 break;
14294
14295 case FFESTR_openDISP:
14296 case FFESTR_openDISPOSE:
14297 ffestb_local_.open.ix = FFESTP_openixDISPOSE;
14298 ffestb_local_.open.left = FALSE;
14299 ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
14300 break;
14301
14302 case FFESTR_openERR:
14303 ffestb_local_.open.ix = FFESTP_openixERR;
14304 ffestb_local_.open.label = TRUE;
14305 break;
14306
14307 case FFESTR_openEXTENDSIZE:
14308 ffestb_local_.open.ix = FFESTP_openixEXTENDSIZE;
14309 ffestb_local_.open.left = FALSE;
14310 ffestb_local_.open.context = FFEEXPR_contextFILENUM;
14311 break;
14312
14313 case FFESTR_openFILE:
14314 case FFESTR_openNAME:
14315 ffestb_local_.open.ix = FFESTP_openixFILE;
14316 ffestb_local_.open.left = FALSE;
14317 ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
14318 break;
14319
14320 case FFESTR_openFORM:
14321 ffestb_local_.open.ix = FFESTP_openixFORM;
14322 ffestb_local_.open.left = FALSE;
14323 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
14324 break;
14325
14326 case FFESTR_openINITIALSIZE:
14327 ffestb_local_.open.ix = FFESTP_openixINITIALSIZE;
14328 ffestb_local_.open.left = FALSE;
14329 ffestb_local_.open.context = FFEEXPR_contextFILENUM;
14330 break;
14331
14332 case FFESTR_openIOSTAT:
14333 ffestb_local_.open.ix = FFESTP_openixIOSTAT;
14334 ffestb_local_.open.left = TRUE;
14335 ffestb_local_.open.context = FFEEXPR_contextFILEINT;
14336 break;
14337
14338 #if 0 /* Haven't added support for expression
14339 context yet (though easy). */
14340 case FFESTR_openKEY:
14341 ffestb_local_.open.ix = FFESTP_openixKEY;
14342 ffestb_local_.open.left = FALSE;
14343 ffestb_local_.open.context = FFEEXPR_contextFILEKEY;
14344 break;
14345 #endif
14346
14347 case FFESTR_openMAXREC:
14348 ffestb_local_.open.ix = FFESTP_openixMAXREC;
14349 ffestb_local_.open.left = FALSE;
14350 ffestb_local_.open.context = FFEEXPR_contextFILENUM;
14351 break;
14352
14353 case FFESTR_openNOSPANBLOCKS:
14354 if (ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
14355 .kw_or_val_present)
14356 goto bad; /* :::::::::::::::::::: */
14357 ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
14358 .kw_or_val_present = TRUE;
14359 ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
14360 .kw_present = TRUE;
14361 ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
14362 .value_present = FALSE;
14363 ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS].kw
14364 = ffelex_token_use (t);
14365 return (ffelexHandler) ffestb_R9048_;
14366
14367 case FFESTR_openORGANIZATION:
14368 ffestb_local_.open.ix = FFESTP_openixORGANIZATION;
14369 ffestb_local_.open.left = FALSE;
14370 ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
14371 break;
14372
14373 case FFESTR_openPAD:
14374 ffestb_local_.open.ix = FFESTP_openixPAD;
14375 ffestb_local_.open.left = FALSE;
14376 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
14377 break;
14378
14379 case FFESTR_openPOSITION:
14380 ffestb_local_.open.ix = FFESTP_openixPOSITION;
14381 ffestb_local_.open.left = FALSE;
14382 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
14383 break;
14384
14385 case FFESTR_openREADONLY:
14386 if (ffestp_file.open.open_spec[FFESTP_openixREADONLY]
14387 .kw_or_val_present)
14388 goto bad; /* :::::::::::::::::::: */
14389 ffestp_file.open.open_spec[FFESTP_openixREADONLY]
14390 .kw_or_val_present = TRUE;
14391 ffestp_file.open.open_spec[FFESTP_openixREADONLY]
14392 .kw_present = TRUE;
14393 ffestp_file.open.open_spec[FFESTP_openixREADONLY]
14394 .value_present = FALSE;
14395 ffestp_file.open.open_spec[FFESTP_openixREADONLY].kw
14396 = ffelex_token_use (t);
14397 return (ffelexHandler) ffestb_R9048_;
14398
14399 case FFESTR_openRECL:
14400 case FFESTR_openRECORDSIZE:
14401 ffestb_local_.open.ix = FFESTP_openixRECL;
14402 ffestb_local_.open.left = FALSE;
14403 ffestb_local_.open.context = FFEEXPR_contextFILENUM;
14404 break;
14405
14406 case FFESTR_openRECORDTYPE:
14407 ffestb_local_.open.ix = FFESTP_openixRECORDTYPE;
14408 ffestb_local_.open.left = FALSE;
14409 ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
14410 break;
14411
14412 case FFESTR_openSHARED:
14413 if (ffestp_file.open.open_spec[FFESTP_openixSHARED]
14414 .kw_or_val_present)
14415 goto bad; /* :::::::::::::::::::: */
14416 ffestp_file.open.open_spec[FFESTP_openixSHARED]
14417 .kw_or_val_present = TRUE;
14418 ffestp_file.open.open_spec[FFESTP_openixSHARED]
14419 .kw_present = TRUE;
14420 ffestp_file.open.open_spec[FFESTP_openixSHARED]
14421 .value_present = FALSE;
14422 ffestp_file.open.open_spec[FFESTP_openixSHARED].kw
14423 = ffelex_token_use (t);
14424 return (ffelexHandler) ffestb_R9048_;
14425
14426 case FFESTR_openSTATUS:
14427 case FFESTR_openTYPE:
14428 ffestb_local_.open.ix = FFESTP_openixSTATUS;
14429 ffestb_local_.open.left = FALSE;
14430 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
14431 break;
14432
14433 case FFESTR_openUNIT:
14434 ffestb_local_.open.ix = FFESTP_openixUNIT;
14435 ffestb_local_.open.left = FALSE;
14436 ffestb_local_.open.context = FFEEXPR_contextFILENUM;
14437 break;
14438
14439 case FFESTR_openUSEROPEN:
14440 ffestb_local_.open.ix = FFESTP_openixUSEROPEN;
14441 ffestb_local_.open.left = TRUE;
14442 ffestb_local_.open.context = FFEEXPR_contextFILEEXTFUNC;
14443 break;
14444
14445 default:
14446 goto bad; /* :::::::::::::::::::: */
14447 }
14448 if (ffestp_file.open.open_spec[ffestb_local_.open.ix]
14449 .kw_or_val_present)
14450 break; /* Can't specify a keyword twice! */
14451 ffestp_file.open.open_spec[ffestb_local_.open.ix]
14452 .kw_or_val_present = TRUE;
14453 ffestp_file.open.open_spec[ffestb_local_.open.ix]
14454 .kw_present = TRUE;
14455 ffestp_file.open.open_spec[ffestb_local_.open.ix]
14456 .value_present = FALSE;
14457 ffestp_file.open.open_spec[ffestb_local_.open.ix].value_is_label
14458 = ffestb_local_.open.label;
14459 ffestp_file.open.open_spec[ffestb_local_.open.ix].kw
14460 = ffelex_token_use (t);
14461 return (ffelexHandler) ffestb_R9045_;
14462
14463 default:
14464 break;
14465 }
14466
14467 bad: /* :::::::::::::::::::: */
14468 ffestb_subr_kill_open_ ();
14469 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
14470 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14471 }
14472
14473 /* ffestb_R9045_ -- "OPEN" OPEN_PAREN [external-file-unit COMMA] NAME
14474
14475 return ffestb_R9045_; // to lexer
14476
14477 Make sure EQUALS here, send next token to expression handler. */
14478
14479 static ffelexHandler
ffestb_R9045_(ffelexToken t)14480 ffestb_R9045_ (ffelexToken t)
14481 {
14482 switch (ffelex_token_type (t))
14483 {
14484 case FFELEX_typeEQUALS:
14485 ffesta_confirmed ();
14486 if (ffestb_local_.open.label)
14487 return (ffelexHandler) ffestb_R9047_;
14488 if (ffestb_local_.open.left)
14489 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
14490 ffestb_local_.open.context,
14491 (ffeexprCallback) ffestb_R9046_);
14492 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
14493 ffestb_local_.open.context,
14494 (ffeexprCallback) ffestb_R9046_);
14495
14496 default:
14497 break;
14498 }
14499
14500 ffestb_subr_kill_open_ ();
14501 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
14502 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14503 }
14504
14505 /* ffestb_R9046_ -- "OPEN" OPEN_PAREN ... NAME EQUALS expr
14506
14507 (ffestb_R9046_) // to expression handler
14508
14509 Handle COMMA or CLOSE_PAREN here. */
14510
14511 static ffelexHandler
ffestb_R9046_(ffelexToken ft,ffebld expr,ffelexToken t)14512 ffestb_R9046_ (ffelexToken ft, ffebld expr, ffelexToken t)
14513 {
14514 switch (ffelex_token_type (t))
14515 {
14516 case FFELEX_typeCOMMA:
14517 case FFELEX_typeCLOSE_PAREN:
14518 if (expr == NULL)
14519 break;
14520 ffestp_file.open.open_spec[ffestb_local_.open.ix].value_present
14521 = TRUE;
14522 ffestp_file.open.open_spec[ffestb_local_.open.ix].value
14523 = ffelex_token_use (ft);
14524 ffestp_file.open.open_spec[ffestb_local_.open.ix].u.expr = expr;
14525 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
14526 return (ffelexHandler) ffestb_R9044_;
14527 return (ffelexHandler) ffestb_R9049_;
14528
14529 default:
14530 break;
14531 }
14532
14533 ffestb_subr_kill_open_ ();
14534 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
14535 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14536 }
14537
14538 /* ffestb_R9047_ -- "OPEN" OPEN_PAREN ... NAME EQUALS
14539
14540 return ffestb_R9047_; // to lexer
14541
14542 Handle NUMBER for label here. */
14543
14544 static ffelexHandler
ffestb_R9047_(ffelexToken t)14545 ffestb_R9047_ (ffelexToken t)
14546 {
14547 switch (ffelex_token_type (t))
14548 {
14549 case FFELEX_typeNUMBER:
14550 ffestp_file.open.open_spec[ffestb_local_.open.ix].value_present
14551 = TRUE;
14552 ffestp_file.open.open_spec[ffestb_local_.open.ix].value
14553 = ffelex_token_use (t);
14554 return (ffelexHandler) ffestb_R9048_;
14555
14556 default:
14557 break;
14558 }
14559
14560 ffestb_subr_kill_open_ ();
14561 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
14562 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14563 }
14564
14565 /* ffestb_R9048_ -- "OPEN" OPEN_PAREN ... NAME EQUALS NUMBER
14566
14567 return ffestb_R9048_; // to lexer
14568
14569 Handle COMMA or CLOSE_PAREN here. */
14570
14571 static ffelexHandler
ffestb_R9048_(ffelexToken t)14572 ffestb_R9048_ (ffelexToken t)
14573 {
14574 switch (ffelex_token_type (t))
14575 {
14576 case FFELEX_typeCOMMA:
14577 return (ffelexHandler) ffestb_R9044_;
14578
14579 case FFELEX_typeCLOSE_PAREN:
14580 return (ffelexHandler) ffestb_R9049_;
14581
14582 default:
14583 break;
14584 }
14585
14586 ffestb_subr_kill_open_ ();
14587 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
14588 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14589 }
14590
14591 /* ffestb_R9049_ -- "OPEN" OPEN_PAREN ... CLOSE_PAREN
14592
14593 return ffestb_R9049_; // to lexer
14594
14595 Handle EOS or SEMICOLON here. */
14596
14597 static ffelexHandler
ffestb_R9049_(ffelexToken t)14598 ffestb_R9049_ (ffelexToken t)
14599 {
14600 switch (ffelex_token_type (t))
14601 {
14602 case FFELEX_typeEOS:
14603 case FFELEX_typeSEMICOLON:
14604 ffesta_confirmed ();
14605 if (!ffesta_is_inhibited ())
14606 ffestc_R904 ();
14607 ffestb_subr_kill_open_ ();
14608 return (ffelexHandler) ffesta_zero (t);
14609
14610 default:
14611 break;
14612 }
14613
14614 ffestb_subr_kill_open_ ();
14615 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
14616 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14617 }
14618
14619 /* ffestb_R907 -- Parse a CLOSE statement
14620
14621 return ffestb_R907; // to lexer
14622
14623 Make sure the statement has a valid form for a CLOSE statement.
14624 If it does, implement the statement. */
14625
14626 ffelexHandler
ffestb_R907(ffelexToken t)14627 ffestb_R907 (ffelexToken t)
14628 {
14629 ffestpCloseIx ix;
14630
14631 switch (ffelex_token_type (ffesta_tokens[0]))
14632 {
14633 case FFELEX_typeNAME:
14634 if (ffesta_first_kw != FFESTR_firstCLOSE)
14635 goto bad_0; /* :::::::::::::::::::: */
14636 break;
14637
14638 case FFELEX_typeNAMES:
14639 if (ffesta_first_kw != FFESTR_firstCLOSE)
14640 goto bad_0; /* :::::::::::::::::::: */
14641 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlCLOSE)
14642 goto bad_0; /* :::::::::::::::::::: */
14643 break;
14644
14645 default:
14646 goto bad_0; /* :::::::::::::::::::: */
14647 }
14648
14649 switch (ffelex_token_type (t))
14650 {
14651 case FFELEX_typeOPEN_PAREN:
14652 break;
14653
14654 case FFELEX_typeEOS:
14655 case FFELEX_typeSEMICOLON:
14656 case FFELEX_typeCOMMA:
14657 case FFELEX_typeCOLONCOLON:
14658 ffesta_confirmed (); /* Error, but clearly intended. */
14659 goto bad_1; /* :::::::::::::::::::: */
14660
14661 default:
14662 goto bad_1; /* :::::::::::::::::::: */
14663 }
14664
14665 for (ix = 0; ix < FFESTP_closeix; ++ix)
14666 ffestp_file.close.close_spec[ix].kw_or_val_present = FALSE;
14667
14668 return (ffelexHandler) ffestb_R9071_;
14669
14670 bad_0: /* :::::::::::::::::::: */
14671 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", ffesta_tokens[0]);
14672 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14673
14674 bad_1: /* :::::::::::::::::::: */
14675 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
14676 return (ffelexHandler) ffelex_swallow_tokens (t,
14677 (ffelexHandler) ffesta_zero); /* Invalid second token. */
14678 }
14679
14680 /* ffestb_R9071_ -- "CLOSE" OPEN_PAREN
14681
14682 return ffestb_R9071_; // to lexer
14683
14684 Handle expr construct (not NAME=expr construct) here. */
14685
14686 static ffelexHandler
ffestb_R9071_(ffelexToken t)14687 ffestb_R9071_ (ffelexToken t)
14688 {
14689 switch (ffelex_token_type (t))
14690 {
14691 case FFELEX_typeNAME:
14692 ffesta_tokens[1] = ffelex_token_use (t);
14693 return (ffelexHandler) ffestb_R9072_;
14694
14695 default:
14696 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
14697 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9073_)))
14698 (t);
14699 }
14700 }
14701
14702 /* ffestb_R9072_ -- "CLOSE" OPEN_PAREN NAME
14703
14704 return ffestb_R9072_; // to lexer
14705
14706 If EQUALS here, go to states that handle it. Else, send NAME and this
14707 token thru expression handler. */
14708
14709 static ffelexHandler
ffestb_R9072_(ffelexToken t)14710 ffestb_R9072_ (ffelexToken t)
14711 {
14712 ffelexHandler next;
14713 ffelexToken nt;
14714
14715 switch (ffelex_token_type (t))
14716 {
14717 case FFELEX_typeEQUALS:
14718 nt = ffesta_tokens[1];
14719 next = (ffelexHandler) ffestb_R9074_ (nt);
14720 ffelex_token_kill (nt);
14721 return (ffelexHandler) (*next) (t);
14722
14723 default:
14724 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
14725 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9073_)))
14726 (ffesta_tokens[1]);
14727 ffelex_token_kill (ffesta_tokens[1]);
14728 return (ffelexHandler) (*next) (t);
14729 }
14730 }
14731
14732 /* ffestb_R9073_ -- "CLOSE" OPEN_PAREN expr
14733
14734 (ffestb_R9073_) // to expression handler
14735
14736 Handle COMMA or CLOSE_PAREN here. */
14737
14738 static ffelexHandler
ffestb_R9073_(ffelexToken ft,ffebld expr,ffelexToken t)14739 ffestb_R9073_ (ffelexToken ft, ffebld expr, ffelexToken t)
14740 {
14741 switch (ffelex_token_type (t))
14742 {
14743 case FFELEX_typeCOMMA:
14744 case FFELEX_typeCLOSE_PAREN:
14745 if (expr == NULL)
14746 break;
14747 ffestp_file.close.close_spec[FFESTP_closeixUNIT].kw_or_val_present
14748 = TRUE;
14749 ffestp_file.close.close_spec[FFESTP_closeixUNIT].kw_present = FALSE;
14750 ffestp_file.close.close_spec[FFESTP_closeixUNIT].value_present = TRUE;
14751 ffestp_file.close.close_spec[FFESTP_closeixUNIT].value_is_label
14752 = FALSE;
14753 ffestp_file.close.close_spec[FFESTP_closeixUNIT].value
14754 = ffelex_token_use (ft);
14755 ffestp_file.close.close_spec[FFESTP_closeixUNIT].u.expr = expr;
14756 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
14757 return (ffelexHandler) ffestb_R9074_;
14758 return (ffelexHandler) ffestb_R9079_;
14759
14760 default:
14761 break;
14762 }
14763
14764 ffestb_subr_kill_close_ ();
14765 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
14766 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14767 }
14768
14769 /* ffestb_R9074_ -- "CLOSE" OPEN_PAREN [external-file-unit COMMA]
14770
14771 return ffestb_R9074_; // to lexer
14772
14773 Handle expr construct (not NAME=expr construct) here. */
14774
14775 static ffelexHandler
ffestb_R9074_(ffelexToken t)14776 ffestb_R9074_ (ffelexToken t)
14777 {
14778 ffestrGenio kw;
14779
14780 ffestb_local_.close.label = FALSE;
14781
14782 switch (ffelex_token_type (t))
14783 {
14784 case FFELEX_typeNAME:
14785 kw = ffestr_genio (t);
14786 switch (kw)
14787 {
14788 case FFESTR_genioERR:
14789 ffestb_local_.close.ix = FFESTP_closeixERR;
14790 ffestb_local_.close.label = TRUE;
14791 break;
14792
14793 case FFESTR_genioIOSTAT:
14794 ffestb_local_.close.ix = FFESTP_closeixIOSTAT;
14795 ffestb_local_.close.left = TRUE;
14796 ffestb_local_.close.context = FFEEXPR_contextFILEINT;
14797 break;
14798
14799 case FFESTR_genioSTATUS:
14800 case FFESTR_genioDISP:
14801 case FFESTR_genioDISPOSE:
14802 ffestb_local_.close.ix = FFESTP_closeixSTATUS;
14803 ffestb_local_.close.left = FALSE;
14804 ffestb_local_.close.context = FFEEXPR_contextFILEDFCHAR;
14805 break;
14806
14807 case FFESTR_genioUNIT:
14808 ffestb_local_.close.ix = FFESTP_closeixUNIT;
14809 ffestb_local_.close.left = FALSE;
14810 ffestb_local_.close.context = FFEEXPR_contextFILENUM;
14811 break;
14812
14813 default:
14814 goto bad; /* :::::::::::::::::::: */
14815 }
14816 if (ffestp_file.close.close_spec[ffestb_local_.close.ix]
14817 .kw_or_val_present)
14818 break; /* Can't specify a keyword twice! */
14819 ffestp_file.close.close_spec[ffestb_local_.close.ix]
14820 .kw_or_val_present = TRUE;
14821 ffestp_file.close.close_spec[ffestb_local_.close.ix]
14822 .kw_present = TRUE;
14823 ffestp_file.close.close_spec[ffestb_local_.close.ix]
14824 .value_present = FALSE;
14825 ffestp_file.close.close_spec[ffestb_local_.close.ix].value_is_label
14826 = ffestb_local_.close.label;
14827 ffestp_file.close.close_spec[ffestb_local_.close.ix].kw
14828 = ffelex_token_use (t);
14829 return (ffelexHandler) ffestb_R9075_;
14830
14831 default:
14832 break;
14833 }
14834
14835 bad: /* :::::::::::::::::::: */
14836 ffestb_subr_kill_close_ ();
14837 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
14838 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14839 }
14840
14841 /* ffestb_R9075_ -- "CLOSE" OPEN_PAREN [external-file-unit COMMA] NAME
14842
14843 return ffestb_R9075_; // to lexer
14844
14845 Make sure EQUALS here, send next token to expression handler. */
14846
14847 static ffelexHandler
ffestb_R9075_(ffelexToken t)14848 ffestb_R9075_ (ffelexToken t)
14849 {
14850 switch (ffelex_token_type (t))
14851 {
14852 case FFELEX_typeEQUALS:
14853 ffesta_confirmed ();
14854 if (ffestb_local_.close.label)
14855 return (ffelexHandler) ffestb_R9077_;
14856 if (ffestb_local_.close.left)
14857 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
14858 ffestb_local_.close.context,
14859 (ffeexprCallback) ffestb_R9076_);
14860 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
14861 ffestb_local_.close.context,
14862 (ffeexprCallback) ffestb_R9076_);
14863
14864 default:
14865 break;
14866 }
14867
14868 ffestb_subr_kill_close_ ();
14869 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
14870 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14871 }
14872
14873 /* ffestb_R9076_ -- "CLOSE" OPEN_PAREN ... NAME EQUALS expr
14874
14875 (ffestb_R9076_) // to expression handler
14876
14877 Handle COMMA or CLOSE_PAREN here. */
14878
14879 static ffelexHandler
ffestb_R9076_(ffelexToken ft,ffebld expr,ffelexToken t)14880 ffestb_R9076_ (ffelexToken ft, ffebld expr, ffelexToken t)
14881 {
14882 switch (ffelex_token_type (t))
14883 {
14884 case FFELEX_typeCOMMA:
14885 case FFELEX_typeCLOSE_PAREN:
14886 if (expr == NULL)
14887 break;
14888 ffestp_file.close.close_spec[ffestb_local_.close.ix].value_present
14889 = TRUE;
14890 ffestp_file.close.close_spec[ffestb_local_.close.ix].value
14891 = ffelex_token_use (ft);
14892 ffestp_file.close.close_spec[ffestb_local_.close.ix].u.expr = expr;
14893 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
14894 return (ffelexHandler) ffestb_R9074_;
14895 return (ffelexHandler) ffestb_R9079_;
14896
14897 default:
14898 break;
14899 }
14900
14901 ffestb_subr_kill_close_ ();
14902 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
14903 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14904 }
14905
14906 /* ffestb_R9077_ -- "CLOSE" OPEN_PAREN ... NAME EQUALS
14907
14908 return ffestb_R9077_; // to lexer
14909
14910 Handle NUMBER for label here. */
14911
14912 static ffelexHandler
ffestb_R9077_(ffelexToken t)14913 ffestb_R9077_ (ffelexToken t)
14914 {
14915 switch (ffelex_token_type (t))
14916 {
14917 case FFELEX_typeNUMBER:
14918 ffestp_file.close.close_spec[ffestb_local_.close.ix].value_present
14919 = TRUE;
14920 ffestp_file.close.close_spec[ffestb_local_.close.ix].value
14921 = ffelex_token_use (t);
14922 return (ffelexHandler) ffestb_R9078_;
14923
14924 default:
14925 break;
14926 }
14927
14928 ffestb_subr_kill_close_ ();
14929 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
14930 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14931 }
14932
14933 /* ffestb_R9078_ -- "CLOSE" OPEN_PAREN ... NAME EQUALS NUMBER
14934
14935 return ffestb_R9078_; // to lexer
14936
14937 Handle COMMA or CLOSE_PAREN here. */
14938
14939 static ffelexHandler
ffestb_R9078_(ffelexToken t)14940 ffestb_R9078_ (ffelexToken t)
14941 {
14942 switch (ffelex_token_type (t))
14943 {
14944 case FFELEX_typeCOMMA:
14945 return (ffelexHandler) ffestb_R9074_;
14946
14947 case FFELEX_typeCLOSE_PAREN:
14948 return (ffelexHandler) ffestb_R9079_;
14949
14950 default:
14951 break;
14952 }
14953
14954 ffestb_subr_kill_close_ ();
14955 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
14956 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14957 }
14958
14959 /* ffestb_R9079_ -- "CLOSE" OPEN_PAREN ... CLOSE_PAREN
14960
14961 return ffestb_R9079_; // to lexer
14962
14963 Handle EOS or SEMICOLON here. */
14964
14965 static ffelexHandler
ffestb_R9079_(ffelexToken t)14966 ffestb_R9079_ (ffelexToken t)
14967 {
14968 switch (ffelex_token_type (t))
14969 {
14970 case FFELEX_typeEOS:
14971 case FFELEX_typeSEMICOLON:
14972 ffesta_confirmed ();
14973 if (!ffesta_is_inhibited ())
14974 ffestc_R907 ();
14975 ffestb_subr_kill_close_ ();
14976 return (ffelexHandler) ffesta_zero (t);
14977
14978 default:
14979 break;
14980 }
14981
14982 ffestb_subr_kill_close_ ();
14983 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
14984 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14985 }
14986
14987 /* ffestb_R909 -- Parse the READ statement
14988
14989 return ffestb_R909; // to lexer
14990
14991 Make sure the statement has a valid form for the READ
14992 statement. If it does, implement the statement. */
14993
14994 ffelexHandler
ffestb_R909(ffelexToken t)14995 ffestb_R909 (ffelexToken t)
14996 {
14997 ffelexHandler next;
14998 ffestpReadIx ix;
14999
15000 switch (ffelex_token_type (ffesta_tokens[0]))
15001 {
15002 case FFELEX_typeNAME:
15003 if (ffesta_first_kw != FFESTR_firstREAD)
15004 goto bad_0; /* :::::::::::::::::::: */
15005 switch (ffelex_token_type (t))
15006 {
15007 case FFELEX_typeCOMMA:
15008 case FFELEX_typeCOLONCOLON:
15009 case FFELEX_typeEOS:
15010 case FFELEX_typeSEMICOLON:
15011 ffesta_confirmed (); /* Error, but clearly intended. */
15012 goto bad_1; /* :::::::::::::::::::: */
15013
15014 case FFELEX_typeEQUALS:
15015 case FFELEX_typePOINTS:
15016 case FFELEX_typeCOLON:
15017 goto bad_1; /* :::::::::::::::::::: */
15018
15019 case FFELEX_typeNAME:
15020 case FFELEX_typeNUMBER:
15021 ffesta_confirmed ();
15022 break;
15023
15024 case FFELEX_typeOPEN_PAREN:
15025 for (ix = 0; ix < FFESTP_readix; ++ix)
15026 ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
15027 ffesta_tokens[1] = ffelex_token_use (t);
15028 return (ffelexHandler) ffestb_R9092_;
15029
15030 default:
15031 break;
15032 }
15033
15034 for (ix = 0; ix < FFESTP_readix; ++ix)
15035 ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
15036 return (ffelexHandler) (*((ffelexHandler)
15037 ffeexpr_rhs (ffesta_output_pool,
15038 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9091_)))
15039 (t);
15040
15041 case FFELEX_typeNAMES:
15042 if (ffesta_first_kw != FFESTR_firstREAD)
15043 goto bad_0; /* :::::::::::::::::::: */
15044 switch (ffelex_token_type (t))
15045 {
15046 case FFELEX_typeEOS:
15047 case FFELEX_typeSEMICOLON:
15048 case FFELEX_typeCOMMA:
15049 ffesta_confirmed ();
15050 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlREAD)
15051 break;
15052 goto bad_1; /* :::::::::::::::::::: */
15053
15054 case FFELEX_typeCOLONCOLON:
15055 ffesta_confirmed (); /* Error, but clearly intended. */
15056 goto bad_1; /* :::::::::::::::::::: */
15057
15058 case FFELEX_typeEQUALS:
15059 case FFELEX_typePOINTS:
15060 case FFELEX_typeCOLON:
15061 goto bad_1; /* :::::::::::::::::::: */
15062
15063 case FFELEX_typeOPEN_PAREN:
15064 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlREAD)
15065 break;
15066
15067 for (ix = 0; ix < FFESTP_readix; ++ix)
15068 ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
15069 ffesta_tokens[1] = ffelex_token_use (t);
15070 return (ffelexHandler) ffestb_R9092_;
15071
15072 default:
15073 break;
15074 }
15075 for (ix = 0; ix < FFESTP_readix; ++ix)
15076 ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
15077 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15078 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9091_);
15079 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
15080 FFESTR_firstlREAD);
15081 if (next == NULL)
15082 return (ffelexHandler) ffelex_swallow_tokens (t,
15083 (ffelexHandler) ffesta_zero);
15084 return (ffelexHandler) (*next) (t);
15085
15086 default:
15087 goto bad_0; /* :::::::::::::::::::: */
15088 }
15089
15090 bad_0: /* :::::::::::::::::::: */
15091 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", ffesta_tokens[0]);
15092 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15093
15094 bad_1: /* :::::::::::::::::::: */
15095 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15096 return (ffelexHandler) ffelex_swallow_tokens (t,
15097 (ffelexHandler) ffesta_zero); /* Invalid second token. */
15098 }
15099
15100 /* ffestb_R9091_ -- "READ" expr
15101
15102 (ffestb_R9091_) // to expression handler
15103
15104 Make sure the next token is a COMMA or EOS/SEMICOLON. */
15105
15106 static ffelexHandler
ffestb_R9091_(ffelexToken ft,ffebld expr,ffelexToken t)15107 ffestb_R9091_ (ffelexToken ft, ffebld expr, ffelexToken t)
15108 {
15109 switch (ffelex_token_type (t))
15110 {
15111 case FFELEX_typeEOS:
15112 case FFELEX_typeSEMICOLON:
15113 case FFELEX_typeCOMMA:
15114 ffesta_confirmed ();
15115 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_or_val_present
15116 = TRUE;
15117 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_present = FALSE;
15118 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_present = TRUE;
15119 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_is_label
15120 = (expr == NULL);
15121 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value
15122 = ffelex_token_use (ft);
15123 ffestp_file.read.read_spec[FFESTP_readixFORMAT].u.expr = expr;
15124 if (!ffesta_is_inhibited ())
15125 ffestc_R909_start (TRUE);
15126 ffestb_subr_kill_read_ ();
15127 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
15128 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
15129 ffestc_context_iolist (),
15130 (ffeexprCallback) ffestb_R90915_);
15131 if (!ffesta_is_inhibited ())
15132 ffestc_R909_finish ();
15133 return (ffelexHandler) ffesta_zero (t);
15134
15135 default:
15136 break;
15137 }
15138
15139 ffestb_subr_kill_read_ ();
15140 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15141 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15142 }
15143
15144 /* ffestb_R9092_ -- "READ" OPEN_PAREN
15145
15146 return ffestb_R9092_; // to lexer
15147
15148 Handle expr construct (not NAME=expr construct) here. */
15149
15150 static ffelexHandler
ffestb_R9092_(ffelexToken t)15151 ffestb_R9092_ (ffelexToken t)
15152 {
15153 ffelexToken nt;
15154 ffelexHandler next;
15155
15156 switch (ffelex_token_type (t))
15157 {
15158 case FFELEX_typeNAME:
15159 ffesta_tokens[2] = ffelex_token_use (t);
15160 return (ffelexHandler) ffestb_R9093_;
15161
15162 default:
15163 nt = ffesta_tokens[1];
15164 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15165 FFEEXPR_contextFILEUNITAMBIG, (ffeexprCallback) ffestb_R9094_)))
15166 (nt);
15167 ffelex_token_kill (nt);
15168 return (ffelexHandler) (*next) (t);
15169 }
15170 }
15171
15172 /* ffestb_R9093_ -- "READ" OPEN_PAREN NAME
15173
15174 return ffestb_R9093_; // to lexer
15175
15176 If EQUALS here, go to states that handle it. Else, send NAME and this
15177 token thru expression handler. */
15178
15179 static ffelexHandler
ffestb_R9093_(ffelexToken t)15180 ffestb_R9093_ (ffelexToken t)
15181 {
15182 ffelexHandler next;
15183 ffelexToken nt;
15184 ffelexToken ot;
15185
15186 switch (ffelex_token_type (t))
15187 {
15188 case FFELEX_typeEQUALS:
15189 ffelex_token_kill (ffesta_tokens[1]);
15190 nt = ffesta_tokens[2];
15191 next = (ffelexHandler) ffestb_R9098_ (nt);
15192 ffelex_token_kill (nt);
15193 return (ffelexHandler) (*next) (t);
15194
15195 default:
15196 nt = ffesta_tokens[1];
15197 ot = ffesta_tokens[2];
15198 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15199 FFEEXPR_contextFILEUNITAMBIG, (ffeexprCallback) ffestb_R9094_)))
15200 (nt);
15201 ffelex_token_kill (nt);
15202 next = (ffelexHandler) (*next) (ot);
15203 ffelex_token_kill (ot);
15204 return (ffelexHandler) (*next) (t);
15205 }
15206 }
15207
15208 /* ffestb_R9094_ -- "READ" OPEN_PAREN expr [CLOSE_PAREN]
15209
15210 (ffestb_R9094_) // to expression handler
15211
15212 Handle COMMA or EOS/SEMICOLON here.
15213
15214 15-Feb-91 JCB 1.1
15215 Use new ffeexpr mechanism whereby the expr is encased in an opITEM if
15216 ffeexpr decided it was an item in a control list (hence a unit
15217 specifier), or a format specifier otherwise. */
15218
15219 static ffelexHandler
ffestb_R9094_(ffelexToken ft,ffebld expr,ffelexToken t)15220 ffestb_R9094_ (ffelexToken ft, ffebld expr, ffelexToken t)
15221 {
15222 if (expr == NULL)
15223 goto bad; /* :::::::::::::::::::: */
15224
15225 if (ffebld_op (expr) != FFEBLD_opITEM)
15226 {
15227 switch (ffelex_token_type (t))
15228 {
15229 case FFELEX_typeCOMMA:
15230 case FFELEX_typeEOS:
15231 case FFELEX_typeSEMICOLON:
15232 ffesta_confirmed ();
15233 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_or_val_present
15234 = TRUE;
15235 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_present = FALSE;
15236 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_present = TRUE;
15237 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_is_label
15238 = FALSE;
15239 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value
15240 = ffelex_token_use (ft);
15241 ffestp_file.read.read_spec[FFESTP_readixFORMAT].u.expr = expr;
15242 if (!ffesta_is_inhibited ())
15243 ffestc_R909_start (TRUE);
15244 ffestb_subr_kill_read_ ();
15245 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
15246 return (ffelexHandler)
15247 ffeexpr_lhs (ffesta_output_pool,
15248 ffestc_context_iolist (),
15249 (ffeexprCallback) ffestb_R90915_);
15250 if (!ffesta_is_inhibited ())
15251 ffestc_R909_finish ();
15252 return (ffelexHandler) ffesta_zero (t);
15253
15254 default:
15255 goto bad; /* :::::::::::::::::::: */
15256 }
15257 }
15258
15259 expr = ffebld_head (expr);
15260
15261 if (expr == NULL)
15262 goto bad; /* :::::::::::::::::::: */
15263
15264 switch (ffelex_token_type (t))
15265 {
15266 case FFELEX_typeCOMMA:
15267 case FFELEX_typeCLOSE_PAREN:
15268 ffestp_file.read.read_spec[FFESTP_readixUNIT].kw_or_val_present
15269 = TRUE;
15270 ffestp_file.read.read_spec[FFESTP_readixUNIT].kw_present = FALSE;
15271 ffestp_file.read.read_spec[FFESTP_readixUNIT].value_present = TRUE;
15272 ffestp_file.read.read_spec[FFESTP_readixUNIT].value_is_label
15273 = FALSE;
15274 ffestp_file.read.read_spec[FFESTP_readixUNIT].value
15275 = ffelex_token_use (ft);
15276 ffestp_file.read.read_spec[FFESTP_readixUNIT].u.expr = expr;
15277 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
15278 return (ffelexHandler) ffestb_R9095_;
15279 return (ffelexHandler) ffestb_R90913_;
15280
15281 default:
15282 break;
15283 }
15284
15285 bad: /* :::::::::::::::::::: */
15286 ffestb_subr_kill_read_ ();
15287 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15288 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15289 }
15290
15291 /* ffestb_R9095_ -- "READ" OPEN_PAREN expr COMMA
15292
15293 return ffestb_R9095_; // to lexer
15294
15295 Handle expr construct (not NAME=expr construct) here. */
15296
15297 static ffelexHandler
ffestb_R9095_(ffelexToken t)15298 ffestb_R9095_ (ffelexToken t)
15299 {
15300 switch (ffelex_token_type (t))
15301 {
15302 case FFELEX_typeNAME:
15303 ffesta_tokens[1] = ffelex_token_use (t);
15304 return (ffelexHandler) ffestb_R9096_;
15305
15306 default:
15307 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15308 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9097_)))
15309 (t);
15310 }
15311 }
15312
15313 /* ffestb_R9096_ -- "READ" OPEN_PAREN expr COMMA NAME
15314
15315 return ffestb_R9096_; // to lexer
15316
15317 If EQUALS here, go to states that handle it. Else, send NAME and this
15318 token thru expression handler. */
15319
15320 static ffelexHandler
ffestb_R9096_(ffelexToken t)15321 ffestb_R9096_ (ffelexToken t)
15322 {
15323 ffelexHandler next;
15324 ffelexToken nt;
15325
15326 switch (ffelex_token_type (t))
15327 {
15328 case FFELEX_typeEQUALS:
15329 nt = ffesta_tokens[1];
15330 next = (ffelexHandler) ffestb_R9098_ (nt);
15331 ffelex_token_kill (nt);
15332 return (ffelexHandler) (*next) (t);
15333
15334 default:
15335 nt = ffesta_tokens[1];
15336 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15337 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9097_)))
15338 (nt);
15339 ffelex_token_kill (nt);
15340 return (ffelexHandler) (*next) (t);
15341 }
15342 }
15343
15344 /* ffestb_R9097_ -- "READ" OPEN_PAREN expr COMMA expr
15345
15346 (ffestb_R9097_) // to expression handler
15347
15348 Handle COMMA or CLOSE_PAREN here. */
15349
15350 static ffelexHandler
ffestb_R9097_(ffelexToken ft,ffebld expr,ffelexToken t)15351 ffestb_R9097_ (ffelexToken ft, ffebld expr, ffelexToken t)
15352 {
15353 switch (ffelex_token_type (t))
15354 {
15355 case FFELEX_typeCOMMA:
15356 case FFELEX_typeCLOSE_PAREN:
15357 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_or_val_present
15358 = TRUE;
15359 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_present = FALSE;
15360 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_present = TRUE;
15361 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_is_label
15362 = (expr == NULL);
15363 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value
15364 = ffelex_token_use (ft);
15365 ffestp_file.read.read_spec[FFESTP_readixFORMAT].u.expr = expr;
15366 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
15367 return (ffelexHandler) ffestb_R9098_;
15368 return (ffelexHandler) ffestb_R90913_;
15369
15370 default:
15371 break;
15372 }
15373
15374 ffestb_subr_kill_read_ ();
15375 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15376 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15377 }
15378
15379 /* ffestb_R9098_ -- "READ" OPEN_PAREN [external-file-unit COMMA [format
15380 COMMA]]
15381
15382 return ffestb_R9098_; // to lexer
15383
15384 Handle expr construct (not NAME=expr construct) here. */
15385
15386 static ffelexHandler
ffestb_R9098_(ffelexToken t)15387 ffestb_R9098_ (ffelexToken t)
15388 {
15389 ffestrGenio kw;
15390
15391 ffestb_local_.read.label = FALSE;
15392
15393 switch (ffelex_token_type (t))
15394 {
15395 case FFELEX_typeNAME:
15396 kw = ffestr_genio (t);
15397 switch (kw)
15398 {
15399 case FFESTR_genioADVANCE:
15400 ffestb_local_.read.ix = FFESTP_readixADVANCE;
15401 ffestb_local_.read.left = FALSE;
15402 ffestb_local_.read.context = FFEEXPR_contextFILEDFCHAR;
15403 break;
15404
15405 case FFESTR_genioEOR:
15406 ffestb_local_.read.ix = FFESTP_readixEOR;
15407 ffestb_local_.read.label = TRUE;
15408 break;
15409
15410 case FFESTR_genioERR:
15411 ffestb_local_.read.ix = FFESTP_readixERR;
15412 ffestb_local_.read.label = TRUE;
15413 break;
15414
15415 case FFESTR_genioEND:
15416 ffestb_local_.read.ix = FFESTP_readixEND;
15417 ffestb_local_.read.label = TRUE;
15418 break;
15419
15420 case FFESTR_genioFMT:
15421 ffestb_local_.read.ix = FFESTP_readixFORMAT;
15422 ffestb_local_.read.left = FALSE;
15423 ffestb_local_.read.context = FFEEXPR_contextFILEFORMAT;
15424 break;
15425
15426 case FFESTR_genioIOSTAT:
15427 ffestb_local_.read.ix = FFESTP_readixIOSTAT;
15428 ffestb_local_.read.left = TRUE;
15429 ffestb_local_.read.context = FFEEXPR_contextFILEINT;
15430 break;
15431
15432 case FFESTR_genioKEY:
15433 case FFESTR_genioKEYEQ:
15434 ffestb_local_.read.ix = FFESTP_readixKEYEQ;
15435 ffestb_local_.read.left = FALSE;
15436 ffestb_local_.read.context = FFEEXPR_contextFILENUMCHAR;
15437 break;
15438
15439 case FFESTR_genioKEYGE:
15440 ffestb_local_.read.ix = FFESTP_readixKEYGE;
15441 ffestb_local_.read.left = FALSE;
15442 ffestb_local_.read.context = FFEEXPR_contextFILENUMCHAR;
15443 break;
15444
15445 case FFESTR_genioKEYGT:
15446 ffestb_local_.read.ix = FFESTP_readixKEYGT;
15447 ffestb_local_.read.left = FALSE;
15448 ffestb_local_.read.context = FFEEXPR_contextFILENUMCHAR;
15449 break;
15450
15451 case FFESTR_genioKEYID:
15452 ffestb_local_.read.ix = FFESTP_readixKEYID;
15453 ffestb_local_.read.left = FALSE;
15454 ffestb_local_.read.context = FFEEXPR_contextFILENUM;
15455 break;
15456
15457 case FFESTR_genioNML:
15458 ffestb_local_.read.ix = FFESTP_readixFORMAT;
15459 ffestb_local_.read.left = TRUE;
15460 ffestb_local_.read.context = FFEEXPR_contextFILENAMELIST;
15461 break;
15462
15463 case FFESTR_genioNULLS:
15464 ffestb_local_.read.ix = FFESTP_readixNULLS;
15465 ffestb_local_.read.left = TRUE;
15466 ffestb_local_.read.context = FFEEXPR_contextFILEINT;
15467 break;
15468
15469 case FFESTR_genioREC:
15470 ffestb_local_.read.ix = FFESTP_readixREC;
15471 ffestb_local_.read.left = FALSE;
15472 ffestb_local_.read.context = FFEEXPR_contextFILENUM;
15473 break;
15474
15475 case FFESTR_genioSIZE:
15476 ffestb_local_.read.ix = FFESTP_readixSIZE;
15477 ffestb_local_.read.left = TRUE;
15478 ffestb_local_.read.context = FFEEXPR_contextFILEINT;
15479 break;
15480
15481 case FFESTR_genioUNIT:
15482 ffestb_local_.read.ix = FFESTP_readixUNIT;
15483 ffestb_local_.read.left = FALSE;
15484 ffestb_local_.read.context = FFEEXPR_contextFILEUNIT;
15485 break;
15486
15487 default:
15488 goto bad; /* :::::::::::::::::::: */
15489 }
15490 if (ffestp_file.read.read_spec[ffestb_local_.read.ix]
15491 .kw_or_val_present)
15492 break; /* Can't specify a keyword twice! */
15493 ffestp_file.read.read_spec[ffestb_local_.read.ix]
15494 .kw_or_val_present = TRUE;
15495 ffestp_file.read.read_spec[ffestb_local_.read.ix]
15496 .kw_present = TRUE;
15497 ffestp_file.read.read_spec[ffestb_local_.read.ix]
15498 .value_present = FALSE;
15499 ffestp_file.read.read_spec[ffestb_local_.read.ix].value_is_label
15500 = ffestb_local_.read.label;
15501 ffestp_file.read.read_spec[ffestb_local_.read.ix].kw
15502 = ffelex_token_use (t);
15503 return (ffelexHandler) ffestb_R9099_;
15504
15505 default:
15506 break;
15507 }
15508
15509 bad: /* :::::::::::::::::::: */
15510 ffestb_subr_kill_read_ ();
15511 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15512 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15513 }
15514
15515 /* ffestb_R9099_ -- "READ" OPEN_PAREN [external-file-unit COMMA [format
15516 COMMA]] NAME
15517
15518 return ffestb_R9099_; // to lexer
15519
15520 Make sure EQUALS here, send next token to expression handler. */
15521
15522 static ffelexHandler
ffestb_R9099_(ffelexToken t)15523 ffestb_R9099_ (ffelexToken t)
15524 {
15525 switch (ffelex_token_type (t))
15526 {
15527 case FFELEX_typeEQUALS:
15528 ffesta_confirmed ();
15529 if (ffestb_local_.read.label)
15530 return (ffelexHandler) ffestb_R90911_;
15531 if (ffestb_local_.read.left)
15532 return (ffelexHandler)
15533 ffeexpr_lhs (ffesta_output_pool,
15534 ffestb_local_.read.context,
15535 (ffeexprCallback) ffestb_R90910_);
15536 return (ffelexHandler)
15537 ffeexpr_rhs (ffesta_output_pool,
15538 ffestb_local_.read.context,
15539 (ffeexprCallback) ffestb_R90910_);
15540
15541 default:
15542 break;
15543 }
15544
15545 ffestb_subr_kill_read_ ();
15546 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15547 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15548 }
15549
15550 /* ffestb_R90910_ -- "READ" OPEN_PAREN ... NAME EQUALS expr
15551
15552 (ffestb_R90910_) // to expression handler
15553
15554 Handle COMMA or CLOSE_PAREN here. */
15555
15556 static ffelexHandler
ffestb_R90910_(ffelexToken ft,ffebld expr,ffelexToken t)15557 ffestb_R90910_ (ffelexToken ft, ffebld expr, ffelexToken t)
15558 {
15559 switch (ffelex_token_type (t))
15560 {
15561 case FFELEX_typeCOMMA:
15562 case FFELEX_typeCLOSE_PAREN:
15563 if (expr == NULL)
15564 {
15565 if (ffestb_local_.read.context == FFEEXPR_contextFILEFORMAT)
15566 ffestp_file.read.read_spec[ffestb_local_.read.ix]
15567 .value_is_label = TRUE;
15568 else
15569 break;
15570 }
15571 ffestp_file.read.read_spec[ffestb_local_.read.ix].value_present
15572 = TRUE;
15573 ffestp_file.read.read_spec[ffestb_local_.read.ix].value
15574 = ffelex_token_use (ft);
15575 ffestp_file.read.read_spec[ffestb_local_.read.ix].u.expr = expr;
15576 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
15577 return (ffelexHandler) ffestb_R9098_;
15578 return (ffelexHandler) ffestb_R90913_;
15579
15580 default:
15581 break;
15582 }
15583
15584 ffestb_subr_kill_read_ ();
15585 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15586 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15587 }
15588
15589 /* ffestb_R90911_ -- "READ" OPEN_PAREN ... NAME EQUALS
15590
15591 return ffestb_R90911_; // to lexer
15592
15593 Handle NUMBER for label here. */
15594
15595 static ffelexHandler
ffestb_R90911_(ffelexToken t)15596 ffestb_R90911_ (ffelexToken t)
15597 {
15598 switch (ffelex_token_type (t))
15599 {
15600 case FFELEX_typeNUMBER:
15601 ffestp_file.read.read_spec[ffestb_local_.read.ix].value_present
15602 = TRUE;
15603 ffestp_file.read.read_spec[ffestb_local_.read.ix].value
15604 = ffelex_token_use (t);
15605 return (ffelexHandler) ffestb_R90912_;
15606
15607 default:
15608 break;
15609 }
15610
15611 ffestb_subr_kill_read_ ();
15612 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15613 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15614 }
15615
15616 /* ffestb_R90912_ -- "READ" OPEN_PAREN ... NAME EQUALS NUMBER
15617
15618 return ffestb_R90912_; // to lexer
15619
15620 Handle COMMA or CLOSE_PAREN here. */
15621
15622 static ffelexHandler
ffestb_R90912_(ffelexToken t)15623 ffestb_R90912_ (ffelexToken t)
15624 {
15625 switch (ffelex_token_type (t))
15626 {
15627 case FFELEX_typeCOMMA:
15628 return (ffelexHandler) ffestb_R9098_;
15629
15630 case FFELEX_typeCLOSE_PAREN:
15631 return (ffelexHandler) ffestb_R90913_;
15632
15633 default:
15634 break;
15635 }
15636
15637 ffestb_subr_kill_read_ ();
15638 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15639 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15640 }
15641
15642 /* ffestb_R90913_ -- "READ" OPEN_PAREN ... CLOSE_PAREN
15643
15644 return ffestb_R90913_; // to lexer
15645
15646 Handle EOS or SEMICOLON here.
15647
15648 15-Feb-91 JCB 1.1
15649 Fix to allow implied-DO construct here (OPEN_PAREN) -- actually,
15650 don't presume knowledge of what an initial token in an lhs context
15651 is going to be, let ffeexpr_lhs handle that as much as possible. */
15652
15653 static ffelexHandler
ffestb_R90913_(ffelexToken t)15654 ffestb_R90913_ (ffelexToken t)
15655 {
15656 switch (ffelex_token_type (t))
15657 {
15658 case FFELEX_typeEOS:
15659 case FFELEX_typeSEMICOLON:
15660 ffesta_confirmed ();
15661 if (!ffesta_is_inhibited ())
15662 {
15663 ffestc_R909_start (FALSE);
15664 ffestc_R909_finish ();
15665 }
15666 ffestb_subr_kill_read_ ();
15667 return (ffelexHandler) ffesta_zero (t);
15668
15669 default:
15670 ffesta_confirmed ();
15671 /* Fall through. */
15672 case FFELEX_typeOPEN_PAREN: /* Could still be assignment!! */
15673 break;
15674 }
15675
15676 /* If token isn't NAME or OPEN_PAREN, ffeexpr_lhs will ultimately whine
15677 about it, so leave it up to that code. */
15678
15679 /* EXTENSION: Allow an optional preceding COMMA here if not pedantic. (f2c
15680 provides this extension, as do other compilers, supposedly.) */
15681
15682 if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA))
15683 return (ffelexHandler)
15684 ffeexpr_lhs (ffesta_output_pool,
15685 ffestc_context_iolist (),
15686 (ffeexprCallback) ffestb_R90914_);
15687
15688 return (ffelexHandler) (*((ffelexHandler)
15689 ffeexpr_lhs (ffesta_output_pool,
15690 ffestc_context_iolist (),
15691 (ffeexprCallback) ffestb_R90914_)))
15692 (t);
15693 }
15694
15695 /* ffestb_R90914_ -- "READ(...)" expr
15696
15697 (ffestb_R90914_) // to expression handler
15698
15699 Handle COMMA or EOS/SEMICOLON here. */
15700
15701 static ffelexHandler
ffestb_R90914_(ffelexToken ft,ffebld expr,ffelexToken t)15702 ffestb_R90914_ (ffelexToken ft, ffebld expr, ffelexToken t)
15703 {
15704 switch (ffelex_token_type (t))
15705 {
15706 case FFELEX_typeCOMMA:
15707 if (expr == NULL)
15708 break;
15709
15710 ffesta_confirmed ();
15711 if (!ffesta_is_inhibited ())
15712 ffestc_R909_start (FALSE);
15713 ffestb_subr_kill_read_ ();
15714
15715 if (!ffesta_is_inhibited ())
15716 ffestc_R909_item (expr, ft);
15717 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
15718 ffestc_context_iolist (),
15719 (ffeexprCallback) ffestb_R90915_);
15720
15721 case FFELEX_typeEOS:
15722 case FFELEX_typeSEMICOLON:
15723 if (expr == NULL)
15724 break;
15725
15726 ffesta_confirmed ();
15727 if (!ffesta_is_inhibited ())
15728 ffestc_R909_start (FALSE);
15729 ffestb_subr_kill_read_ ();
15730
15731 if (!ffesta_is_inhibited ())
15732 {
15733 ffestc_R909_item (expr, ft);
15734 ffestc_R909_finish ();
15735 }
15736 return (ffelexHandler) ffesta_zero (t);
15737
15738 default:
15739 break;
15740 }
15741
15742 ffestb_subr_kill_read_ ();
15743 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15744 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15745 }
15746
15747 /* ffestb_R90915_ -- "READ(...)" expr COMMA expr
15748
15749 (ffestb_R90915_) // to expression handler
15750
15751 Handle COMMA or EOS/SEMICOLON here. */
15752
15753 static ffelexHandler
ffestb_R90915_(ffelexToken ft,ffebld expr,ffelexToken t)15754 ffestb_R90915_ (ffelexToken ft, ffebld expr, ffelexToken t)
15755 {
15756 switch (ffelex_token_type (t))
15757 {
15758 case FFELEX_typeCOMMA:
15759 if (expr == NULL)
15760 break;
15761 if (!ffesta_is_inhibited ())
15762 ffestc_R909_item (expr, ft);
15763 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
15764 ffestc_context_iolist (),
15765 (ffeexprCallback) ffestb_R90915_);
15766
15767 case FFELEX_typeEOS:
15768 case FFELEX_typeSEMICOLON:
15769 if (expr == NULL)
15770 break;
15771 if (!ffesta_is_inhibited ())
15772 {
15773 ffestc_R909_item (expr, ft);
15774 ffestc_R909_finish ();
15775 }
15776 return (ffelexHandler) ffesta_zero (t);
15777
15778 default:
15779 break;
15780 }
15781
15782 if (!ffesta_is_inhibited ())
15783 ffestc_R909_finish ();
15784 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
15785 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15786 }
15787
15788 /* ffestb_R910 -- Parse the WRITE statement
15789
15790 return ffestb_R910; // to lexer
15791
15792 Make sure the statement has a valid form for the WRITE
15793 statement. If it does, implement the statement. */
15794
15795 ffelexHandler
ffestb_R910(ffelexToken t)15796 ffestb_R910 (ffelexToken t)
15797 {
15798 ffestpWriteIx ix;
15799
15800 switch (ffelex_token_type (ffesta_tokens[0]))
15801 {
15802 case FFELEX_typeNAME:
15803 if (ffesta_first_kw != FFESTR_firstWRITE)
15804 goto bad_0; /* :::::::::::::::::::: */
15805 switch (ffelex_token_type (t))
15806 {
15807 case FFELEX_typeCOMMA:
15808 case FFELEX_typeCOLONCOLON:
15809 case FFELEX_typeEOS:
15810 case FFELEX_typeSEMICOLON:
15811 case FFELEX_typeNAME:
15812 case FFELEX_typeNUMBER:
15813 ffesta_confirmed (); /* Error, but clearly intended. */
15814 goto bad_1; /* :::::::::::::::::::: */
15815
15816 default:
15817 goto bad_1; /* :::::::::::::::::::: */
15818
15819 case FFELEX_typeOPEN_PAREN:
15820 for (ix = 0; ix < FFESTP_writeix; ++ix)
15821 ffestp_file.write.write_spec[ix].kw_or_val_present = FALSE;
15822 return (ffelexHandler) ffestb_R9101_;
15823 }
15824
15825 case FFELEX_typeNAMES:
15826 if (ffesta_first_kw != FFESTR_firstWRITE)
15827 goto bad_0; /* :::::::::::::::::::: */
15828 switch (ffelex_token_type (t))
15829 {
15830 case FFELEX_typeEOS:
15831 case FFELEX_typeSEMICOLON:
15832 case FFELEX_typeCOMMA:
15833 case FFELEX_typeCOLONCOLON:
15834 ffesta_confirmed (); /* Error, but clearly intended. */
15835 goto bad_1; /* :::::::::::::::::::: */
15836
15837 default:
15838 goto bad_1; /* :::::::::::::::::::: */
15839
15840 case FFELEX_typeOPEN_PAREN:
15841 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlWRITE)
15842 goto bad_0; /* :::::::::::::::::::: */
15843
15844 for (ix = 0; ix < FFESTP_writeix; ++ix)
15845 ffestp_file.write.write_spec[ix].kw_or_val_present = FALSE;
15846 return (ffelexHandler) ffestb_R9101_;
15847 }
15848
15849 default:
15850 goto bad_0; /* :::::::::::::::::::: */
15851 }
15852
15853 bad_0: /* :::::::::::::::::::: */
15854 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", ffesta_tokens[0]);
15855 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15856
15857 bad_1: /* :::::::::::::::::::: */
15858 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
15859 return (ffelexHandler) ffelex_swallow_tokens (t,
15860 (ffelexHandler) ffesta_zero); /* Invalid second token. */
15861 }
15862
15863 /* ffestb_R9101_ -- "WRITE" OPEN_PAREN
15864
15865 return ffestb_R9101_; // to lexer
15866
15867 Handle expr construct (not NAME=expr construct) here. */
15868
15869 static ffelexHandler
ffestb_R9101_(ffelexToken t)15870 ffestb_R9101_ (ffelexToken t)
15871 {
15872 switch (ffelex_token_type (t))
15873 {
15874 case FFELEX_typeNAME:
15875 ffesta_tokens[1] = ffelex_token_use (t);
15876 return (ffelexHandler) ffestb_R9102_;
15877
15878 default:
15879 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15880 FFEEXPR_contextFILEUNIT, (ffeexprCallback) ffestb_R9103_)))
15881 (t);
15882 }
15883 }
15884
15885 /* ffestb_R9102_ -- "WRITE" OPEN_PAREN NAME
15886
15887 return ffestb_R9102_; // to lexer
15888
15889 If EQUALS here, go to states that handle it. Else, send NAME and this
15890 token thru expression handler. */
15891
15892 static ffelexHandler
ffestb_R9102_(ffelexToken t)15893 ffestb_R9102_ (ffelexToken t)
15894 {
15895 ffelexHandler next;
15896 ffelexToken nt;
15897
15898 switch (ffelex_token_type (t))
15899 {
15900 case FFELEX_typeEQUALS:
15901 nt = ffesta_tokens[1];
15902 next = (ffelexHandler) ffestb_R9107_ (nt);
15903 ffelex_token_kill (nt);
15904 return (ffelexHandler) (*next) (t);
15905
15906 default:
15907 nt = ffesta_tokens[1];
15908 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15909 FFEEXPR_contextFILEUNIT, (ffeexprCallback) ffestb_R9103_)))
15910 (nt);
15911 ffelex_token_kill (nt);
15912 return (ffelexHandler) (*next) (t);
15913 }
15914 }
15915
15916 /* ffestb_R9103_ -- "WRITE" OPEN_PAREN expr [CLOSE_PAREN]
15917
15918 (ffestb_R9103_) // to expression handler
15919
15920 Handle COMMA or EOS/SEMICOLON here. */
15921
15922 static ffelexHandler
ffestb_R9103_(ffelexToken ft,ffebld expr,ffelexToken t)15923 ffestb_R9103_ (ffelexToken ft, ffebld expr, ffelexToken t)
15924 {
15925 switch (ffelex_token_type (t))
15926 {
15927 case FFELEX_typeCOMMA:
15928 case FFELEX_typeCLOSE_PAREN:
15929 if (expr == NULL)
15930 break;
15931 ffestp_file.write.write_spec[FFESTP_writeixUNIT].kw_or_val_present
15932 = TRUE;
15933 ffestp_file.write.write_spec[FFESTP_writeixUNIT].kw_present = FALSE;
15934 ffestp_file.write.write_spec[FFESTP_writeixUNIT].value_present = TRUE;
15935 ffestp_file.write.write_spec[FFESTP_writeixUNIT].value_is_label
15936 = FALSE;
15937 ffestp_file.write.write_spec[FFESTP_writeixUNIT].value
15938 = ffelex_token_use (ft);
15939 ffestp_file.write.write_spec[FFESTP_writeixUNIT].u.expr = expr;
15940 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
15941 return (ffelexHandler) ffestb_R9104_;
15942 return (ffelexHandler) ffestb_R91012_;
15943
15944 default:
15945 break;
15946 }
15947
15948 ffestb_subr_kill_write_ ();
15949 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
15950 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15951 }
15952
15953 /* ffestb_R9104_ -- "WRITE" OPEN_PAREN expr COMMA
15954
15955 return ffestb_R9104_; // to lexer
15956
15957 Handle expr construct (not NAME=expr construct) here. */
15958
15959 static ffelexHandler
ffestb_R9104_(ffelexToken t)15960 ffestb_R9104_ (ffelexToken t)
15961 {
15962 switch (ffelex_token_type (t))
15963 {
15964 case FFELEX_typeNAME:
15965 ffesta_tokens[1] = ffelex_token_use (t);
15966 return (ffelexHandler) ffestb_R9105_;
15967
15968 default:
15969 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15970 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9106_)))
15971 (t);
15972 }
15973 }
15974
15975 /* ffestb_R9105_ -- "WRITE" OPEN_PAREN expr COMMA NAME
15976
15977 return ffestb_R9105_; // to lexer
15978
15979 If EQUALS here, go to states that handle it. Else, send NAME and this
15980 token thru expression handler. */
15981
15982 static ffelexHandler
ffestb_R9105_(ffelexToken t)15983 ffestb_R9105_ (ffelexToken t)
15984 {
15985 ffelexHandler next;
15986 ffelexToken nt;
15987
15988 switch (ffelex_token_type (t))
15989 {
15990 case FFELEX_typeEQUALS:
15991 nt = ffesta_tokens[1];
15992 next = (ffelexHandler) ffestb_R9107_ (nt);
15993 ffelex_token_kill (nt);
15994 return (ffelexHandler) (*next) (t);
15995
15996 default:
15997 nt = ffesta_tokens[1];
15998 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15999 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9106_)))
16000 (nt);
16001 ffelex_token_kill (nt);
16002 return (ffelexHandler) (*next) (t);
16003 }
16004 }
16005
16006 /* ffestb_R9106_ -- "WRITE" OPEN_PAREN expr COMMA expr
16007
16008 (ffestb_R9106_) // to expression handler
16009
16010 Handle COMMA or CLOSE_PAREN here. */
16011
16012 static ffelexHandler
ffestb_R9106_(ffelexToken ft,ffebld expr,ffelexToken t)16013 ffestb_R9106_ (ffelexToken ft, ffebld expr, ffelexToken t)
16014 {
16015 switch (ffelex_token_type (t))
16016 {
16017 case FFELEX_typeCOMMA:
16018 case FFELEX_typeCLOSE_PAREN:
16019 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].kw_or_val_present
16020 = TRUE;
16021 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].kw_present = FALSE;
16022 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].value_present = TRUE;
16023 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].value_is_label
16024 = (expr == NULL);
16025 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].value
16026 = ffelex_token_use (ft);
16027 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].u.expr = expr;
16028 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
16029 return (ffelexHandler) ffestb_R9107_;
16030 return (ffelexHandler) ffestb_R91012_;
16031
16032 default:
16033 break;
16034 }
16035
16036 ffestb_subr_kill_write_ ();
16037 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
16038 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16039 }
16040
16041 /* ffestb_R9107_ -- "WRITE" OPEN_PAREN [external-file-unit COMMA [format
16042 COMMA]]
16043
16044 return ffestb_R9107_; // to lexer
16045
16046 Handle expr construct (not NAME=expr construct) here. */
16047
16048 static ffelexHandler
ffestb_R9107_(ffelexToken t)16049 ffestb_R9107_ (ffelexToken t)
16050 {
16051 ffestrGenio kw;
16052
16053 ffestb_local_.write.label = FALSE;
16054
16055 switch (ffelex_token_type (t))
16056 {
16057 case FFELEX_typeNAME:
16058 kw = ffestr_genio (t);
16059 switch (kw)
16060 {
16061 case FFESTR_genioADVANCE:
16062 ffestb_local_.write.ix = FFESTP_writeixADVANCE;
16063 ffestb_local_.write.left = FALSE;
16064 ffestb_local_.write.context = FFEEXPR_contextFILEDFCHAR;
16065 break;
16066
16067 case FFESTR_genioEOR:
16068 ffestb_local_.write.ix = FFESTP_writeixEOR;
16069 ffestb_local_.write.label = TRUE;
16070 break;
16071
16072 case FFESTR_genioERR:
16073 ffestb_local_.write.ix = FFESTP_writeixERR;
16074 ffestb_local_.write.label = TRUE;
16075 break;
16076
16077 case FFESTR_genioFMT:
16078 ffestb_local_.write.ix = FFESTP_writeixFORMAT;
16079 ffestb_local_.write.left = FALSE;
16080 ffestb_local_.write.context = FFEEXPR_contextFILEFORMAT;
16081 break;
16082
16083 case FFESTR_genioIOSTAT:
16084 ffestb_local_.write.ix = FFESTP_writeixIOSTAT;
16085 ffestb_local_.write.left = TRUE;
16086 ffestb_local_.write.context = FFEEXPR_contextFILEINT;
16087 break;
16088
16089 case FFESTR_genioNML:
16090 ffestb_local_.write.ix = FFESTP_writeixFORMAT;
16091 ffestb_local_.write.left = TRUE;
16092 ffestb_local_.write.context = FFEEXPR_contextFILENAMELIST;
16093 break;
16094
16095 case FFESTR_genioREC:
16096 ffestb_local_.write.ix = FFESTP_writeixREC;
16097 ffestb_local_.write.left = FALSE;
16098 ffestb_local_.write.context = FFEEXPR_contextFILENUM;
16099 break;
16100
16101 case FFESTR_genioUNIT:
16102 ffestb_local_.write.ix = FFESTP_writeixUNIT;
16103 ffestb_local_.write.left = FALSE;
16104 ffestb_local_.write.context = FFEEXPR_contextFILEUNIT;
16105 break;
16106
16107 default:
16108 goto bad; /* :::::::::::::::::::: */
16109 }
16110 if (ffestp_file.write.write_spec[ffestb_local_.write.ix]
16111 .kw_or_val_present)
16112 break; /* Can't specify a keyword twice! */
16113 ffestp_file.write.write_spec[ffestb_local_.write.ix]
16114 .kw_or_val_present = TRUE;
16115 ffestp_file.write.write_spec[ffestb_local_.write.ix]
16116 .kw_present = TRUE;
16117 ffestp_file.write.write_spec[ffestb_local_.write.ix]
16118 .value_present = FALSE;
16119 ffestp_file.write.write_spec[ffestb_local_.write.ix].value_is_label
16120 = ffestb_local_.write.label;
16121 ffestp_file.write.write_spec[ffestb_local_.write.ix].kw
16122 = ffelex_token_use (t);
16123 return (ffelexHandler) ffestb_R9108_;
16124
16125 default:
16126 break;
16127 }
16128
16129 bad: /* :::::::::::::::::::: */
16130 ffestb_subr_kill_write_ ();
16131 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
16132 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16133 }
16134
16135 /* ffestb_R9108_ -- "WRITE" OPEN_PAREN [external-file-unit COMMA [format
16136 COMMA]] NAME
16137
16138 return ffestb_R9108_; // to lexer
16139
16140 Make sure EQUALS here, send next token to expression handler. */
16141
16142 static ffelexHandler
ffestb_R9108_(ffelexToken t)16143 ffestb_R9108_ (ffelexToken t)
16144 {
16145 switch (ffelex_token_type (t))
16146 {
16147 case FFELEX_typeEQUALS:
16148 ffesta_confirmed ();
16149 if (ffestb_local_.write.label)
16150 return (ffelexHandler) ffestb_R91010_;
16151 if (ffestb_local_.write.left)
16152 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
16153 ffestb_local_.write.context,
16154 (ffeexprCallback) ffestb_R9109_);
16155 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16156 ffestb_local_.write.context,
16157 (ffeexprCallback) ffestb_R9109_);
16158
16159 default:
16160 break;
16161 }
16162
16163 ffestb_subr_kill_write_ ();
16164 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
16165 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16166 }
16167
16168 /* ffestb_R9109_ -- "WRITE" OPEN_PAREN ... NAME EQUALS expr
16169
16170 (ffestb_R9109_) // to expression handler
16171
16172 Handle COMMA or CLOSE_PAREN here. */
16173
16174 static ffelexHandler
ffestb_R9109_(ffelexToken ft,ffebld expr,ffelexToken t)16175 ffestb_R9109_ (ffelexToken ft, ffebld expr, ffelexToken t)
16176 {
16177 switch (ffelex_token_type (t))
16178 {
16179 case FFELEX_typeCOMMA:
16180 case FFELEX_typeCLOSE_PAREN:
16181 if (expr == NULL)
16182 {
16183 if (ffestb_local_.write.context == FFEEXPR_contextFILEFORMAT)
16184 ffestp_file.write.write_spec[ffestb_local_.write.ix]
16185 .value_is_label = TRUE;
16186 else
16187 break;
16188 }
16189 ffestp_file.write.write_spec[ffestb_local_.write.ix].value_present
16190 = TRUE;
16191 ffestp_file.write.write_spec[ffestb_local_.write.ix].value
16192 = ffelex_token_use (ft);
16193 ffestp_file.write.write_spec[ffestb_local_.write.ix].u.expr = expr;
16194 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
16195 return (ffelexHandler) ffestb_R9107_;
16196 return (ffelexHandler) ffestb_R91012_;
16197
16198 default:
16199 break;
16200 }
16201
16202 ffestb_subr_kill_write_ ();
16203 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
16204 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16205 }
16206
16207 /* ffestb_R91010_ -- "WRITE" OPEN_PAREN ... NAME EQUALS
16208
16209 return ffestb_R91010_; // to lexer
16210
16211 Handle NUMBER for label here. */
16212
16213 static ffelexHandler
ffestb_R91010_(ffelexToken t)16214 ffestb_R91010_ (ffelexToken t)
16215 {
16216 switch (ffelex_token_type (t))
16217 {
16218 case FFELEX_typeNUMBER:
16219 ffestp_file.write.write_spec[ffestb_local_.write.ix].value_present
16220 = TRUE;
16221 ffestp_file.write.write_spec[ffestb_local_.write.ix].value
16222 = ffelex_token_use (t);
16223 return (ffelexHandler) ffestb_R91011_;
16224
16225 default:
16226 break;
16227 }
16228
16229 ffestb_subr_kill_write_ ();
16230 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
16231 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16232 }
16233
16234 /* ffestb_R91011_ -- "WRITE" OPEN_PAREN ... NAME EQUALS NUMBER
16235
16236 return ffestb_R91011_; // to lexer
16237
16238 Handle COMMA or CLOSE_PAREN here. */
16239
16240 static ffelexHandler
ffestb_R91011_(ffelexToken t)16241 ffestb_R91011_ (ffelexToken t)
16242 {
16243 switch (ffelex_token_type (t))
16244 {
16245 case FFELEX_typeCOMMA:
16246 return (ffelexHandler) ffestb_R9107_;
16247
16248 case FFELEX_typeCLOSE_PAREN:
16249 return (ffelexHandler) ffestb_R91012_;
16250
16251 default:
16252 break;
16253 }
16254
16255 ffestb_subr_kill_write_ ();
16256 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
16257 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16258 }
16259
16260 /* ffestb_R91012_ -- "WRITE" OPEN_PAREN ... CLOSE_PAREN
16261
16262 return ffestb_R91012_; // to lexer
16263
16264 Handle EOS or SEMICOLON here. */
16265
16266 static ffelexHandler
ffestb_R91012_(ffelexToken t)16267 ffestb_R91012_ (ffelexToken t)
16268 {
16269 switch (ffelex_token_type (t))
16270 {
16271 case FFELEX_typeEOS:
16272 case FFELEX_typeSEMICOLON:
16273 ffesta_confirmed ();
16274 if (!ffesta_is_inhibited ())
16275 {
16276 ffestc_R910_start ();
16277 ffestc_R910_finish ();
16278 }
16279 ffestb_subr_kill_write_ ();
16280 return (ffelexHandler) ffesta_zero (t);
16281
16282 default:
16283 ffesta_confirmed ();
16284 /* Fall through. */
16285 case FFELEX_typeOPEN_PAREN: /* Could still be assignment!! */
16286
16287 /* EXTENSION: Allow an optional preceding COMMA here if not pedantic.
16288 (f2c provides this extension, as do other compilers, supposedly.) */
16289
16290 if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA))
16291 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16292 ffestc_context_iolist (), (ffeexprCallback) ffestb_R91013_);
16293
16294 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16295 ffestc_context_iolist (), (ffeexprCallback) ffestb_R91013_)))
16296 (t);
16297
16298 case FFELEX_typeEQUALS:
16299 case FFELEX_typePOINTS:
16300 break;
16301 }
16302
16303 ffestb_subr_kill_write_ ();
16304 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
16305 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16306 }
16307
16308 /* ffestb_R91013_ -- "WRITE(...)" expr
16309
16310 (ffestb_R91013_) // to expression handler
16311
16312 Handle COMMA or EOS/SEMICOLON here. */
16313
16314 static ffelexHandler
ffestb_R91013_(ffelexToken ft,ffebld expr,ffelexToken t)16315 ffestb_R91013_ (ffelexToken ft, ffebld expr, ffelexToken t)
16316 {
16317 switch (ffelex_token_type (t))
16318 {
16319 case FFELEX_typeCOMMA:
16320 if (expr == NULL)
16321 break;
16322
16323 ffesta_confirmed ();
16324 if (!ffesta_is_inhibited ())
16325 ffestc_R910_start ();
16326 ffestb_subr_kill_write_ ();
16327
16328 if (!ffesta_is_inhibited ())
16329 ffestc_R910_item (expr, ft);
16330 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16331 ffestc_context_iolist (), (ffeexprCallback) ffestb_R91014_);
16332
16333 case FFELEX_typeEOS:
16334 case FFELEX_typeSEMICOLON:
16335 if (expr == NULL)
16336 break;
16337
16338 ffesta_confirmed ();
16339 if (!ffesta_is_inhibited ())
16340 ffestc_R910_start ();
16341 ffestb_subr_kill_write_ ();
16342
16343 if (!ffesta_is_inhibited ())
16344 {
16345 ffestc_R910_item (expr, ft);
16346 ffestc_R910_finish ();
16347 }
16348 return (ffelexHandler) ffesta_zero (t);
16349
16350 default:
16351 break;
16352 }
16353
16354 ffestb_subr_kill_write_ ();
16355 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
16356 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16357 }
16358
16359 /* ffestb_R91014_ -- "WRITE(...)" expr COMMA expr
16360
16361 (ffestb_R91014_) // to expression handler
16362
16363 Handle COMMA or EOS/SEMICOLON here. */
16364
16365 static ffelexHandler
ffestb_R91014_(ffelexToken ft,ffebld expr,ffelexToken t)16366 ffestb_R91014_ (ffelexToken ft, ffebld expr, ffelexToken t)
16367 {
16368 switch (ffelex_token_type (t))
16369 {
16370 case FFELEX_typeCOMMA:
16371 if (expr == NULL)
16372 break;
16373 if (!ffesta_is_inhibited ())
16374 ffestc_R910_item (expr, ft);
16375 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16376 ffestc_context_iolist (), (ffeexprCallback) ffestb_R91014_);
16377
16378 case FFELEX_typeEOS:
16379 case FFELEX_typeSEMICOLON:
16380 if (expr == NULL)
16381 break;
16382 if (!ffesta_is_inhibited ())
16383 {
16384 ffestc_R910_item (expr, ft);
16385 ffestc_R910_finish ();
16386 }
16387 return (ffelexHandler) ffesta_zero (t);
16388
16389 default:
16390 break;
16391 }
16392
16393 if (!ffesta_is_inhibited ())
16394 ffestc_R910_finish ();
16395 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
16396 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16397 }
16398
16399 /* ffestb_R911 -- Parse the PRINT statement
16400
16401 return ffestb_R911; // to lexer
16402
16403 Make sure the statement has a valid form for the PRINT
16404 statement. If it does, implement the statement. */
16405
16406 ffelexHandler
ffestb_R911(ffelexToken t)16407 ffestb_R911 (ffelexToken t)
16408 {
16409 ffelexHandler next;
16410 ffestpPrintIx ix;
16411
16412 switch (ffelex_token_type (ffesta_tokens[0]))
16413 {
16414 case FFELEX_typeNAME:
16415 if (ffesta_first_kw != FFESTR_firstPRINT)
16416 goto bad_0; /* :::::::::::::::::::: */
16417 switch (ffelex_token_type (t))
16418 {
16419 case FFELEX_typeCOMMA:
16420 case FFELEX_typeCOLONCOLON:
16421 case FFELEX_typeEOS:
16422 case FFELEX_typeSEMICOLON:
16423 ffesta_confirmed (); /* Error, but clearly intended. */
16424 goto bad_1; /* :::::::::::::::::::: */
16425
16426 case FFELEX_typeEQUALS:
16427 case FFELEX_typePOINTS:
16428 case FFELEX_typeCOLON:
16429 goto bad_1; /* :::::::::::::::::::: */
16430
16431 case FFELEX_typeNAME:
16432 case FFELEX_typeNUMBER:
16433 ffesta_confirmed ();
16434 break;
16435
16436 default:
16437 break;
16438 }
16439
16440 for (ix = 0; ix < FFESTP_printix; ++ix)
16441 ffestp_file.print.print_spec[ix].kw_or_val_present = FALSE;
16442 return (ffelexHandler) (*((ffelexHandler)
16443 ffeexpr_rhs (ffesta_output_pool,
16444 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9111_)))
16445 (t);
16446
16447 case FFELEX_typeNAMES:
16448 if (ffesta_first_kw != FFESTR_firstPRINT)
16449 goto bad_0; /* :::::::::::::::::::: */
16450 switch (ffelex_token_type (t))
16451 {
16452 case FFELEX_typeEOS:
16453 case FFELEX_typeSEMICOLON:
16454 case FFELEX_typeCOMMA:
16455 ffesta_confirmed ();
16456 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlPRINT)
16457 break;
16458 goto bad_1; /* :::::::::::::::::::: */
16459
16460 case FFELEX_typeCOLONCOLON:
16461 ffesta_confirmed (); /* Error, but clearly intended. */
16462 goto bad_1; /* :::::::::::::::::::: */
16463
16464 case FFELEX_typeEQUALS:
16465 case FFELEX_typePOINTS:
16466 case FFELEX_typeCOLON:
16467 goto bad_1; /* :::::::::::::::::::: */
16468
16469 default:
16470 break;
16471 }
16472 for (ix = 0; ix < FFESTP_printix; ++ix)
16473 ffestp_file.print.print_spec[ix].kw_or_val_present = FALSE;
16474 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16475 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9111_);
16476 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
16477 FFESTR_firstlPRINT);
16478 if (next == NULL)
16479 return (ffelexHandler) ffelex_swallow_tokens (t,
16480 (ffelexHandler) ffesta_zero);
16481 return (ffelexHandler) (*next) (t);
16482
16483 default:
16484 goto bad_0; /* :::::::::::::::::::: */
16485 }
16486
16487 bad_0: /* :::::::::::::::::::: */
16488 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", ffesta_tokens[0]);
16489 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16490
16491 bad_1: /* :::::::::::::::::::: */
16492 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", t);
16493 return (ffelexHandler) ffelex_swallow_tokens (t,
16494 (ffelexHandler) ffesta_zero); /* Invalid second token. */
16495 }
16496
16497 /* ffestb_R9111_ -- "PRINT" expr
16498
16499 (ffestb_R9111_) // to expression handler
16500
16501 Make sure the next token is a COMMA or EOS/SEMICOLON. */
16502
16503 static ffelexHandler
ffestb_R9111_(ffelexToken ft,ffebld expr,ffelexToken t)16504 ffestb_R9111_ (ffelexToken ft, ffebld expr, ffelexToken t)
16505 {
16506 switch (ffelex_token_type (t))
16507 {
16508 case FFELEX_typeEOS:
16509 case FFELEX_typeSEMICOLON:
16510 case FFELEX_typeCOMMA:
16511 ffesta_confirmed ();
16512 ffestp_file.print.print_spec[FFESTP_printixFORMAT].kw_or_val_present
16513 = TRUE;
16514 ffestp_file.print.print_spec[FFESTP_printixFORMAT].kw_present = FALSE;
16515 ffestp_file.print.print_spec[FFESTP_printixFORMAT].value_present = TRUE;
16516 ffestp_file.print.print_spec[FFESTP_printixFORMAT].value_is_label
16517 = (expr == NULL);
16518 ffestp_file.print.print_spec[FFESTP_printixFORMAT].value
16519 = ffelex_token_use (ft);
16520 ffestp_file.print.print_spec[FFESTP_printixFORMAT].u.expr = expr;
16521 if (!ffesta_is_inhibited ())
16522 ffestc_R911_start ();
16523 ffestb_subr_kill_print_ ();
16524 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
16525 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16526 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R9112_);
16527 if (!ffesta_is_inhibited ())
16528 ffestc_R911_finish ();
16529 return (ffelexHandler) ffesta_zero (t);
16530
16531 default:
16532 break;
16533 }
16534
16535 ffestb_subr_kill_print_ ();
16536 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", t);
16537 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16538 }
16539
16540 /* ffestb_R9112_ -- "PRINT" expr COMMA expr
16541
16542 (ffestb_R9112_) // to expression handler
16543
16544 Handle COMMA or EOS/SEMICOLON here. */
16545
16546 static ffelexHandler
ffestb_R9112_(ffelexToken ft,ffebld expr,ffelexToken t)16547 ffestb_R9112_ (ffelexToken ft, ffebld expr, ffelexToken t)
16548 {
16549 switch (ffelex_token_type (t))
16550 {
16551 case FFELEX_typeCOMMA:
16552 if (expr == NULL)
16553 break;
16554 if (!ffesta_is_inhibited ())
16555 ffestc_R911_item (expr, ft);
16556 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16557 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R9112_);
16558
16559 case FFELEX_typeEOS:
16560 case FFELEX_typeSEMICOLON:
16561 if (expr == NULL)
16562 break;
16563 if (!ffesta_is_inhibited ())
16564 {
16565 ffestc_R911_item (expr, ft);
16566 ffestc_R911_finish ();
16567 }
16568 return (ffelexHandler) ffesta_zero (t);
16569
16570 default:
16571 break;
16572 }
16573
16574 if (!ffesta_is_inhibited ())
16575 ffestc_R911_finish ();
16576 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", t);
16577 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16578 }
16579
16580 /* ffestb_R923 -- Parse an INQUIRE statement
16581
16582 return ffestb_R923; // to lexer
16583
16584 Make sure the statement has a valid form for an INQUIRE statement.
16585 If it does, implement the statement. */
16586
16587 ffelexHandler
ffestb_R923(ffelexToken t)16588 ffestb_R923 (ffelexToken t)
16589 {
16590 ffestpInquireIx ix;
16591
16592 switch (ffelex_token_type (ffesta_tokens[0]))
16593 {
16594 case FFELEX_typeNAME:
16595 if (ffesta_first_kw != FFESTR_firstINQUIRE)
16596 goto bad_0; /* :::::::::::::::::::: */
16597 break;
16598
16599 case FFELEX_typeNAMES:
16600 if (ffesta_first_kw != FFESTR_firstINQUIRE)
16601 goto bad_0; /* :::::::::::::::::::: */
16602 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlINQUIRE)
16603 goto bad_0; /* :::::::::::::::::::: */
16604 break;
16605
16606 default:
16607 goto bad_0; /* :::::::::::::::::::: */
16608 }
16609
16610 switch (ffelex_token_type (t))
16611 {
16612 case FFELEX_typeOPEN_PAREN:
16613 break;
16614
16615 case FFELEX_typeEOS:
16616 case FFELEX_typeSEMICOLON:
16617 case FFELEX_typeCOMMA:
16618 case FFELEX_typeCOLONCOLON:
16619 ffesta_confirmed (); /* Error, but clearly intended. */
16620 goto bad_1; /* :::::::::::::::::::: */
16621
16622 default:
16623 goto bad_1; /* :::::::::::::::::::: */
16624 }
16625
16626 for (ix = 0; ix < FFESTP_inquireix; ++ix)
16627 ffestp_file.inquire.inquire_spec[ix].kw_or_val_present = FALSE;
16628
16629 ffestb_local_.inquire.may_be_iolength = TRUE;
16630 return (ffelexHandler) ffestb_R9231_;
16631
16632 bad_0: /* :::::::::::::::::::: */
16633 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", ffesta_tokens[0]);
16634 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16635
16636 bad_1: /* :::::::::::::::::::: */
16637 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
16638 return (ffelexHandler) ffelex_swallow_tokens (t,
16639 (ffelexHandler) ffesta_zero); /* Invalid second token. */
16640 }
16641
16642 /* ffestb_R9231_ -- "INQUIRE" OPEN_PAREN
16643
16644 return ffestb_R9231_; // to lexer
16645
16646 Handle expr construct (not NAME=expr construct) here. */
16647
16648 static ffelexHandler
ffestb_R9231_(ffelexToken t)16649 ffestb_R9231_ (ffelexToken t)
16650 {
16651 switch (ffelex_token_type (t))
16652 {
16653 case FFELEX_typeNAME:
16654 ffesta_tokens[1] = ffelex_token_use (t);
16655 return (ffelexHandler) ffestb_R9232_;
16656
16657 default:
16658 ffestb_local_.inquire.may_be_iolength = FALSE;
16659 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16660 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9233_)))
16661 (t);
16662 }
16663 }
16664
16665 /* ffestb_R9232_ -- "INQUIRE" OPEN_PAREN NAME
16666
16667 return ffestb_R9232_; // to lexer
16668
16669 If EQUALS here, go to states that handle it. Else, send NAME and this
16670 token thru expression handler. */
16671
16672 static ffelexHandler
ffestb_R9232_(ffelexToken t)16673 ffestb_R9232_ (ffelexToken t)
16674 {
16675 ffelexHandler next;
16676 ffelexToken nt;
16677
16678 switch (ffelex_token_type (t))
16679 {
16680 case FFELEX_typeEQUALS:
16681 nt = ffesta_tokens[1];
16682 next = (ffelexHandler) ffestb_R9234_ (nt);
16683 ffelex_token_kill (nt);
16684 return (ffelexHandler) (*next) (t);
16685
16686 default:
16687 ffestb_local_.inquire.may_be_iolength = FALSE;
16688 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16689 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9233_)))
16690 (ffesta_tokens[1]);
16691 ffelex_token_kill (ffesta_tokens[1]);
16692 return (ffelexHandler) (*next) (t);
16693 }
16694 }
16695
16696 /* ffestb_R9233_ -- "INQUIRE" OPEN_PAREN expr
16697
16698 (ffestb_R9233_) // to expression handler
16699
16700 Handle COMMA or CLOSE_PAREN here. */
16701
16702 static ffelexHandler
ffestb_R9233_(ffelexToken ft,ffebld expr,ffelexToken t)16703 ffestb_R9233_ (ffelexToken ft, ffebld expr, ffelexToken t)
16704 {
16705 switch (ffelex_token_type (t))
16706 {
16707 case FFELEX_typeCOMMA:
16708 case FFELEX_typeCLOSE_PAREN:
16709 if (expr == NULL)
16710 break;
16711 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw_or_val_present
16712 = TRUE;
16713 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw_present = FALSE;
16714 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value_present = TRUE;
16715 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value_is_label
16716 = FALSE;
16717 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value
16718 = ffelex_token_use (ft);
16719 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].u.expr = expr;
16720 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
16721 return (ffelexHandler) ffestb_R9234_;
16722 return (ffelexHandler) ffestb_R9239_;
16723
16724 default:
16725 break;
16726 }
16727
16728 ffestb_subr_kill_inquire_ ();
16729 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
16730 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16731 }
16732
16733 /* ffestb_R9234_ -- "INQUIRE" OPEN_PAREN [external-file-unit COMMA]
16734
16735 return ffestb_R9234_; // to lexer
16736
16737 Handle expr construct (not NAME=expr construct) here. */
16738
16739 static ffelexHandler
ffestb_R9234_(ffelexToken t)16740 ffestb_R9234_ (ffelexToken t)
16741 {
16742 ffestrInquire kw;
16743
16744 ffestb_local_.inquire.label = FALSE;
16745
16746 switch (ffelex_token_type (t))
16747 {
16748 case FFELEX_typeNAME:
16749 kw = ffestr_inquire (t);
16750 if (kw != FFESTR_inquireIOLENGTH)
16751 ffestb_local_.inquire.may_be_iolength = FALSE;
16752 switch (kw)
16753 {
16754 case FFESTR_inquireACCESS:
16755 ffestb_local_.inquire.ix = FFESTP_inquireixACCESS;
16756 ffestb_local_.inquire.left = TRUE;
16757 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16758 break;
16759
16760 case FFESTR_inquireACTION:
16761 ffestb_local_.inquire.ix = FFESTP_inquireixACTION;
16762 ffestb_local_.inquire.left = TRUE;
16763 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16764 break;
16765
16766 case FFESTR_inquireBLANK:
16767 ffestb_local_.inquire.ix = FFESTP_inquireixBLANK;
16768 ffestb_local_.inquire.left = TRUE;
16769 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16770 break;
16771
16772 case FFESTR_inquireCARRIAGECONTROL:
16773 ffestb_local_.inquire.ix = FFESTP_inquireixCARRIAGECONTROL;
16774 ffestb_local_.inquire.left = TRUE;
16775 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
16776 break;
16777
16778 case FFESTR_inquireDEFAULTFILE:
16779 ffestb_local_.inquire.ix = FFESTP_inquireixDEFAULTFILE;
16780 ffestb_local_.inquire.left = FALSE;
16781 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
16782 break;
16783
16784 case FFESTR_inquireDELIM:
16785 ffestb_local_.inquire.ix = FFESTP_inquireixDELIM;
16786 ffestb_local_.inquire.left = TRUE;
16787 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16788 break;
16789
16790 case FFESTR_inquireDIRECT:
16791 ffestb_local_.inquire.ix = FFESTP_inquireixDIRECT;
16792 ffestb_local_.inquire.left = TRUE;
16793 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16794 break;
16795
16796 case FFESTR_inquireERR:
16797 ffestb_local_.inquire.ix = FFESTP_inquireixERR;
16798 ffestb_local_.inquire.label = TRUE;
16799 break;
16800
16801 case FFESTR_inquireEXIST:
16802 ffestb_local_.inquire.ix = FFESTP_inquireixEXIST;
16803 ffestb_local_.inquire.left = TRUE;
16804 ffestb_local_.inquire.context = FFEEXPR_contextFILELOG;
16805 break;
16806
16807 case FFESTR_inquireFILE:
16808 ffestb_local_.inquire.ix = FFESTP_inquireixFILE;
16809 ffestb_local_.inquire.left = FALSE;
16810 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
16811 break;
16812
16813 case FFESTR_inquireFORM:
16814 ffestb_local_.inquire.ix = FFESTP_inquireixFORM;
16815 ffestb_local_.inquire.left = TRUE;
16816 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16817 break;
16818
16819 case FFESTR_inquireFORMATTED:
16820 ffestb_local_.inquire.ix = FFESTP_inquireixFORMATTED;
16821 ffestb_local_.inquire.left = TRUE;
16822 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16823 break;
16824
16825 case FFESTR_inquireIOLENGTH:
16826 if (!ffestb_local_.inquire.may_be_iolength)
16827 goto bad; /* :::::::::::::::::::: */
16828 ffestb_local_.inquire.ix = FFESTP_inquireixIOLENGTH;
16829 ffestb_local_.inquire.left = TRUE;
16830 ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
16831 break;
16832
16833 case FFESTR_inquireIOSTAT:
16834 ffestb_local_.inquire.ix = FFESTP_inquireixIOSTAT;
16835 ffestb_local_.inquire.left = TRUE;
16836 ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
16837 break;
16838
16839 case FFESTR_inquireKEYED:
16840 ffestb_local_.inquire.ix = FFESTP_inquireixKEYED;
16841 ffestb_local_.inquire.left = TRUE;
16842 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
16843 break;
16844
16845 case FFESTR_inquireNAME:
16846 ffestb_local_.inquire.ix = FFESTP_inquireixNAME;
16847 ffestb_local_.inquire.left = TRUE;
16848 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
16849 break;
16850
16851 case FFESTR_inquireNAMED:
16852 ffestb_local_.inquire.ix = FFESTP_inquireixNAMED;
16853 ffestb_local_.inquire.left = TRUE;
16854 ffestb_local_.inquire.context = FFEEXPR_contextFILELOG;
16855 break;
16856
16857 case FFESTR_inquireNEXTREC:
16858 ffestb_local_.inquire.ix = FFESTP_inquireixNEXTREC;
16859 ffestb_local_.inquire.left = TRUE;
16860 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFINT;
16861 break;
16862
16863 case FFESTR_inquireNUMBER:
16864 ffestb_local_.inquire.ix = FFESTP_inquireixNUMBER;
16865 ffestb_local_.inquire.left = TRUE;
16866 ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
16867 break;
16868
16869 case FFESTR_inquireOPENED:
16870 ffestb_local_.inquire.ix = FFESTP_inquireixOPENED;
16871 ffestb_local_.inquire.left = TRUE;
16872 ffestb_local_.inquire.context = FFEEXPR_contextFILELOG;
16873 break;
16874
16875 case FFESTR_inquireORGANIZATION:
16876 ffestb_local_.inquire.ix = FFESTP_inquireixORGANIZATION;
16877 ffestb_local_.inquire.left = TRUE;
16878 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
16879 break;
16880
16881 case FFESTR_inquirePAD:
16882 ffestb_local_.inquire.ix = FFESTP_inquireixPAD;
16883 ffestb_local_.inquire.left = TRUE;
16884 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16885 break;
16886
16887 case FFESTR_inquirePOSITION:
16888 ffestb_local_.inquire.ix = FFESTP_inquireixPOSITION;
16889 ffestb_local_.inquire.left = TRUE;
16890 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16891 break;
16892
16893 case FFESTR_inquireREAD:
16894 ffestb_local_.inquire.ix = FFESTP_inquireixREAD;
16895 ffestb_local_.inquire.left = TRUE;
16896 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16897 break;
16898
16899 case FFESTR_inquireREADWRITE:
16900 ffestb_local_.inquire.ix = FFESTP_inquireixREADWRITE;
16901 ffestb_local_.inquire.left = TRUE;
16902 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16903 break;
16904
16905 case FFESTR_inquireRECL:
16906 ffestb_local_.inquire.ix = FFESTP_inquireixRECL;
16907 ffestb_local_.inquire.left = TRUE;
16908 ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
16909 break;
16910
16911 case FFESTR_inquireRECORDTYPE:
16912 ffestb_local_.inquire.ix = FFESTP_inquireixRECORDTYPE;
16913 ffestb_local_.inquire.left = TRUE;
16914 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
16915 break;
16916
16917 case FFESTR_inquireSEQUENTIAL:
16918 ffestb_local_.inquire.ix = FFESTP_inquireixSEQUENTIAL;
16919 ffestb_local_.inquire.left = TRUE;
16920 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16921 break;
16922
16923 case FFESTR_inquireUNFORMATTED:
16924 ffestb_local_.inquire.ix = FFESTP_inquireixUNFORMATTED;
16925 ffestb_local_.inquire.left = TRUE;
16926 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
16927 break;
16928
16929 case FFESTR_inquireUNIT:
16930 ffestb_local_.inquire.ix = FFESTP_inquireixUNIT;
16931 ffestb_local_.inquire.left = FALSE;
16932 ffestb_local_.inquire.context = FFEEXPR_contextFILENUM;
16933 break;
16934
16935 default:
16936 goto bad; /* :::::::::::::::::::: */
16937 }
16938 if (ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
16939 .kw_or_val_present)
16940 break; /* Can't specify a keyword twice! */
16941 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
16942 .kw_or_val_present = TRUE;
16943 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
16944 .kw_present = TRUE;
16945 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
16946 .value_present = FALSE;
16947 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value_is_label
16948 = ffestb_local_.inquire.label;
16949 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].kw
16950 = ffelex_token_use (t);
16951 return (ffelexHandler) ffestb_R9235_;
16952
16953 default:
16954 break;
16955 }
16956
16957 bad: /* :::::::::::::::::::: */
16958 ffestb_subr_kill_inquire_ ();
16959 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
16960 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16961 }
16962
16963 /* ffestb_R9235_ -- "INQUIRE" OPEN_PAREN [external-file-unit COMMA] NAME
16964
16965 return ffestb_R9235_; // to lexer
16966
16967 Make sure EQUALS here, send next token to expression handler. */
16968
16969 static ffelexHandler
ffestb_R9235_(ffelexToken t)16970 ffestb_R9235_ (ffelexToken t)
16971 {
16972 switch (ffelex_token_type (t))
16973 {
16974 case FFELEX_typeEQUALS:
16975 ffesta_confirmed ();
16976 if (ffestb_local_.inquire.label)
16977 return (ffelexHandler) ffestb_R9237_;
16978 if (ffestb_local_.inquire.left)
16979 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
16980 ffestb_local_.inquire.context,
16981 (ffeexprCallback) ffestb_R9236_);
16982 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16983 ffestb_local_.inquire.context,
16984 (ffeexprCallback) ffestb_R9236_);
16985
16986 default:
16987 break;
16988 }
16989
16990 ffestb_subr_kill_inquire_ ();
16991 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
16992 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16993 }
16994
16995 /* ffestb_R9236_ -- "INQUIRE" OPEN_PAREN ... NAME EQUALS expr
16996
16997 (ffestb_R9236_) // to expression handler
16998
16999 Handle COMMA or CLOSE_PAREN here. */
17000
17001 static ffelexHandler
ffestb_R9236_(ffelexToken ft,ffebld expr,ffelexToken t)17002 ffestb_R9236_ (ffelexToken ft, ffebld expr, ffelexToken t)
17003 {
17004 switch (ffelex_token_type (t))
17005 {
17006 case FFELEX_typeCOMMA:
17007 if (ffestb_local_.inquire.ix == FFESTP_inquireixIOLENGTH)
17008 break; /* IOLENGTH=expr must be followed by
17009 CLOSE_PAREN. */
17010 /* Fall through. */
17011 case FFELEX_typeCLOSE_PAREN:
17012 if (expr == NULL)
17013 break;
17014 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value_present
17015 = TRUE;
17016 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value
17017 = ffelex_token_use (ft);
17018 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].u.expr = expr;
17019 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
17020 return (ffelexHandler) ffestb_R9234_;
17021 if (ffestb_local_.inquire.ix == FFESTP_inquireixIOLENGTH)
17022 return (ffelexHandler) ffestb_R92310_;
17023 return (ffelexHandler) ffestb_R9239_;
17024
17025 default:
17026 break;
17027 }
17028
17029 ffestb_subr_kill_inquire_ ();
17030 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
17031 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17032 }
17033
17034 /* ffestb_R9237_ -- "INQUIRE" OPEN_PAREN ... NAME EQUALS
17035
17036 return ffestb_R9237_; // to lexer
17037
17038 Handle NUMBER for label here. */
17039
17040 static ffelexHandler
ffestb_R9237_(ffelexToken t)17041 ffestb_R9237_ (ffelexToken t)
17042 {
17043 switch (ffelex_token_type (t))
17044 {
17045 case FFELEX_typeNUMBER:
17046 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value_present
17047 = TRUE;
17048 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value
17049 = ffelex_token_use (t);
17050 return (ffelexHandler) ffestb_R9238_;
17051
17052 default:
17053 break;
17054 }
17055
17056 ffestb_subr_kill_inquire_ ();
17057 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
17058 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17059 }
17060
17061 /* ffestb_R9238_ -- "INQUIRE" OPEN_PAREN ... NAME EQUALS NUMBER
17062
17063 return ffestb_R9238_; // to lexer
17064
17065 Handle COMMA or CLOSE_PAREN here. */
17066
17067 static ffelexHandler
ffestb_R9238_(ffelexToken t)17068 ffestb_R9238_ (ffelexToken t)
17069 {
17070 switch (ffelex_token_type (t))
17071 {
17072 case FFELEX_typeCOMMA:
17073 return (ffelexHandler) ffestb_R9234_;
17074
17075 case FFELEX_typeCLOSE_PAREN:
17076 return (ffelexHandler) ffestb_R9239_;
17077
17078 default:
17079 break;
17080 }
17081
17082 ffestb_subr_kill_inquire_ ();
17083 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
17084 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17085 }
17086
17087 /* ffestb_R9239_ -- "INQUIRE" OPEN_PAREN ... CLOSE_PAREN
17088
17089 return ffestb_R9239_; // to lexer
17090
17091 Handle EOS or SEMICOLON here. */
17092
17093 static ffelexHandler
ffestb_R9239_(ffelexToken t)17094 ffestb_R9239_ (ffelexToken t)
17095 {
17096 switch (ffelex_token_type (t))
17097 {
17098 case FFELEX_typeEOS:
17099 case FFELEX_typeSEMICOLON:
17100 ffesta_confirmed ();
17101 if (!ffesta_is_inhibited ())
17102 ffestc_R923A ();
17103 ffestb_subr_kill_inquire_ ();
17104 return (ffelexHandler) ffesta_zero (t);
17105
17106 default:
17107 break;
17108 }
17109
17110 ffestb_subr_kill_inquire_ ();
17111 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
17112 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17113 }
17114
17115 /* ffestb_R92310_ -- "INQUIRE(IOLENGTH=expr)"
17116
17117 return ffestb_R92310_; // to lexer
17118
17119 Make sure EOS or SEMICOLON not here; begin R923B processing and expect
17120 output IO list. */
17121
17122 static ffelexHandler
ffestb_R92310_(ffelexToken t)17123 ffestb_R92310_ (ffelexToken t)
17124 {
17125 switch (ffelex_token_type (t))
17126 {
17127 case FFELEX_typeEOS:
17128 case FFELEX_typeSEMICOLON:
17129 break;
17130
17131 default:
17132 ffesta_confirmed ();
17133 if (!ffesta_is_inhibited ())
17134 ffestc_R923B_start ();
17135 ffestb_subr_kill_inquire_ ();
17136 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17137 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R92311_)))
17138 (t);
17139 }
17140
17141 ffestb_subr_kill_inquire_ ();
17142 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
17143 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17144 }
17145
17146 /* ffestb_R92311_ -- "INQUIRE(IOLENGTH=expr)" expr
17147
17148 (ffestb_R92311_) // to expression handler
17149
17150 Handle COMMA or EOS/SEMICOLON here. */
17151
17152 static ffelexHandler
ffestb_R92311_(ffelexToken ft,ffebld expr,ffelexToken t)17153 ffestb_R92311_ (ffelexToken ft, ffebld expr, ffelexToken t)
17154 {
17155 switch (ffelex_token_type (t))
17156 {
17157 case FFELEX_typeCOMMA:
17158 if (expr == NULL)
17159 break;
17160 if (!ffesta_is_inhibited ())
17161 ffestc_R923B_item (expr, ft);
17162 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17163 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R92311_);
17164
17165 case FFELEX_typeEOS:
17166 case FFELEX_typeSEMICOLON:
17167 if (expr == NULL)
17168 break;
17169 if (!ffesta_is_inhibited ())
17170 {
17171 ffestc_R923B_item (expr, ft);
17172 ffestc_R923B_finish ();
17173 }
17174 return (ffelexHandler) ffesta_zero (t);
17175
17176 default:
17177 break;
17178 }
17179
17180 if (!ffesta_is_inhibited ())
17181 ffestc_R923B_finish ();
17182 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
17183 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17184 }
17185
17186 /* ffestb_V018 -- Parse the REWRITE statement
17187
17188 return ffestb_V018; // to lexer
17189
17190 Make sure the statement has a valid form for the REWRITE
17191 statement. If it does, implement the statement. */
17192
17193 #if FFESTR_VXT
17194 ffelexHandler
ffestb_V018(ffelexToken t)17195 ffestb_V018 (ffelexToken t)
17196 {
17197 ffestpRewriteIx ix;
17198
17199 switch (ffelex_token_type (ffesta_tokens[0]))
17200 {
17201 case FFELEX_typeNAME:
17202 if (ffesta_first_kw != FFESTR_firstREWRITE)
17203 goto bad_0; /* :::::::::::::::::::: */
17204 switch (ffelex_token_type (t))
17205 {
17206 case FFELEX_typeCOMMA:
17207 case FFELEX_typeCOLONCOLON:
17208 case FFELEX_typeEOS:
17209 case FFELEX_typeSEMICOLON:
17210 case FFELEX_typeNAME:
17211 case FFELEX_typeNUMBER:
17212 ffesta_confirmed (); /* Error, but clearly intended. */
17213 goto bad_1; /* :::::::::::::::::::: */
17214
17215 default:
17216 goto bad_1; /* :::::::::::::::::::: */
17217
17218 case FFELEX_typeOPEN_PAREN:
17219 for (ix = 0; ix < FFESTP_rewriteix; ++ix)
17220 ffestp_file.rewrite.rewrite_spec[ix].kw_or_val_present = FALSE;
17221 return (ffelexHandler) ffestb_V0181_;
17222 }
17223
17224 case FFELEX_typeNAMES:
17225 if (ffesta_first_kw != FFESTR_firstREWRITE)
17226 goto bad_0; /* :::::::::::::::::::: */
17227 switch (ffelex_token_type (t))
17228 {
17229 case FFELEX_typeEOS:
17230 case FFELEX_typeSEMICOLON:
17231 case FFELEX_typeCOMMA:
17232 case FFELEX_typeCOLONCOLON:
17233 ffesta_confirmed (); /* Error, but clearly intended. */
17234 goto bad_1; /* :::::::::::::::::::: */
17235
17236 default:
17237 goto bad_1; /* :::::::::::::::::::: */
17238
17239 case FFELEX_typeOPEN_PAREN:
17240 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlREWRITE)
17241 goto bad_0; /* :::::::::::::::::::: */
17242
17243 for (ix = 0; ix < FFESTP_rewriteix; ++ix)
17244 ffestp_file.rewrite.rewrite_spec[ix].kw_or_val_present = FALSE;
17245 return (ffelexHandler) ffestb_V0181_;
17246 }
17247
17248 default:
17249 goto bad_0; /* :::::::::::::::::::: */
17250 }
17251
17252 bad_0: /* :::::::::::::::::::: */
17253 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", ffesta_tokens[0]);
17254 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17255
17256 bad_1: /* :::::::::::::::::::: */
17257 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17258 return (ffelexHandler) ffelex_swallow_tokens (t,
17259 (ffelexHandler) ffesta_zero); /* Invalid second token. */
17260 }
17261
17262 /* ffestb_V0181_ -- "REWRITE" OPEN_PAREN
17263
17264 return ffestb_V0181_; // to lexer
17265
17266 Handle expr construct (not NAME=expr construct) here. */
17267
17268 static ffelexHandler
ffestb_V0181_(ffelexToken t)17269 ffestb_V0181_ (ffelexToken t)
17270 {
17271 switch (ffelex_token_type (t))
17272 {
17273 case FFELEX_typeNAME:
17274 ffesta_tokens[1] = ffelex_token_use (t);
17275 return (ffelexHandler) ffestb_V0182_;
17276
17277 default:
17278 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17279 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0183_)))
17280 (t);
17281 }
17282 }
17283
17284 /* ffestb_V0182_ -- "REWRITE" OPEN_PAREN NAME
17285
17286 return ffestb_V0182_; // to lexer
17287
17288 If EQUALS here, go to states that handle it. Else, send NAME and this
17289 token thru expression handler. */
17290
17291 static ffelexHandler
ffestb_V0182_(ffelexToken t)17292 ffestb_V0182_ (ffelexToken t)
17293 {
17294 ffelexHandler next;
17295 ffelexToken nt;
17296
17297 switch (ffelex_token_type (t))
17298 {
17299 case FFELEX_typeEQUALS:
17300 nt = ffesta_tokens[1];
17301 next = (ffelexHandler) ffestb_V0187_ (nt);
17302 ffelex_token_kill (nt);
17303 return (ffelexHandler) (*next) (t);
17304
17305 default:
17306 nt = ffesta_tokens[1];
17307 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17308 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0183_)))
17309 (nt);
17310 ffelex_token_kill (nt);
17311 return (ffelexHandler) (*next) (t);
17312 }
17313 }
17314
17315 /* ffestb_V0183_ -- "REWRITE" OPEN_PAREN expr [CLOSE_PAREN]
17316
17317 (ffestb_V0183_) // to expression handler
17318
17319 Handle COMMA or EOS/SEMICOLON here. */
17320
17321 static ffelexHandler
ffestb_V0183_(ffelexToken ft,ffebld expr,ffelexToken t)17322 ffestb_V0183_ (ffelexToken ft, ffebld expr, ffelexToken t)
17323 {
17324 switch (ffelex_token_type (t))
17325 {
17326 case FFELEX_typeCOMMA:
17327 case FFELEX_typeCLOSE_PAREN:
17328 if (expr == NULL)
17329 break;
17330 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].kw_or_val_present
17331 = TRUE;
17332 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].kw_present = FALSE;
17333 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].value_present = TRUE;
17334 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].value_is_label
17335 = FALSE;
17336 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].value
17337 = ffelex_token_use (ft);
17338 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].u.expr = expr;
17339 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
17340 return (ffelexHandler) ffestb_V0184_;
17341 return (ffelexHandler) ffestb_V01812_;
17342
17343 default:
17344 break;
17345 }
17346
17347 ffestb_subr_kill_rewrite_ ();
17348 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17349 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17350 }
17351
17352 /* ffestb_V0184_ -- "REWRITE" OPEN_PAREN expr COMMA
17353
17354 return ffestb_V0184_; // to lexer
17355
17356 Handle expr construct (not NAME=expr construct) here. */
17357
17358 static ffelexHandler
ffestb_V0184_(ffelexToken t)17359 ffestb_V0184_ (ffelexToken t)
17360 {
17361 switch (ffelex_token_type (t))
17362 {
17363 case FFELEX_typeNAME:
17364 ffesta_tokens[1] = ffelex_token_use (t);
17365 return (ffelexHandler) ffestb_V0185_;
17366
17367 default:
17368 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17369 FFEEXPR_contextFILEFORMAT, (ffeexprCallback) ffestb_V0186_)))
17370 (t);
17371 }
17372 }
17373
17374 /* ffestb_V0185_ -- "REWRITE" OPEN_PAREN expr COMMA NAME
17375
17376 return ffestb_V0185_; // to lexer
17377
17378 If EQUALS here, go to states that handle it. Else, send NAME and this
17379 token thru expression handler. */
17380
17381 static ffelexHandler
ffestb_V0185_(ffelexToken t)17382 ffestb_V0185_ (ffelexToken t)
17383 {
17384 ffelexHandler next;
17385 ffelexToken nt;
17386
17387 switch (ffelex_token_type (t))
17388 {
17389 case FFELEX_typeEQUALS:
17390 nt = ffesta_tokens[1];
17391 next = (ffelexHandler) ffestb_V0187_ (nt);
17392 ffelex_token_kill (nt);
17393 return (ffelexHandler) (*next) (t);
17394
17395 default:
17396 nt = ffesta_tokens[1];
17397 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17398 FFEEXPR_contextFILEFORMAT, (ffeexprCallback) ffestb_V0186_)))
17399 (nt);
17400 ffelex_token_kill (nt);
17401 return (ffelexHandler) (*next) (t);
17402 }
17403 }
17404
17405 /* ffestb_V0186_ -- "REWRITE" OPEN_PAREN expr COMMA expr
17406
17407 (ffestb_V0186_) // to expression handler
17408
17409 Handle COMMA or CLOSE_PAREN here. */
17410
17411 static ffelexHandler
ffestb_V0186_(ffelexToken ft,ffebld expr,ffelexToken t)17412 ffestb_V0186_ (ffelexToken ft, ffebld expr, ffelexToken t)
17413 {
17414 switch (ffelex_token_type (t))
17415 {
17416 case FFELEX_typeCOMMA:
17417 case FFELEX_typeCLOSE_PAREN:
17418 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw_or_val_present
17419 = TRUE;
17420 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw_present = FALSE;
17421 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value_present = TRUE;
17422 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value_is_label
17423 = (expr == NULL);
17424 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value
17425 = ffelex_token_use (ft);
17426 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].u.expr = expr;
17427 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
17428 return (ffelexHandler) ffestb_V0187_;
17429 return (ffelexHandler) ffestb_V01812_;
17430
17431 default:
17432 break;
17433 }
17434
17435 ffestb_subr_kill_rewrite_ ();
17436 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17437 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17438 }
17439
17440 /* ffestb_V0187_ -- "REWRITE" OPEN_PAREN [external-file-unit COMMA [format
17441 COMMA]]
17442
17443 return ffestb_V0187_; // to lexer
17444
17445 Handle expr construct (not NAME=expr construct) here. */
17446
17447 static ffelexHandler
ffestb_V0187_(ffelexToken t)17448 ffestb_V0187_ (ffelexToken t)
17449 {
17450 ffestrGenio kw;
17451
17452 ffestb_local_.rewrite.label = FALSE;
17453
17454 switch (ffelex_token_type (t))
17455 {
17456 case FFELEX_typeNAME:
17457 kw = ffestr_genio (t);
17458 switch (kw)
17459 {
17460 case FFESTR_genioERR:
17461 ffestb_local_.rewrite.ix = FFESTP_rewriteixERR;
17462 ffestb_local_.rewrite.label = TRUE;
17463 break;
17464
17465 case FFESTR_genioFMT:
17466 ffestb_local_.rewrite.ix = FFESTP_rewriteixFMT;
17467 ffestb_local_.rewrite.left = FALSE;
17468 ffestb_local_.rewrite.context = FFEEXPR_contextFILEFORMAT;
17469 break;
17470
17471 case FFESTR_genioIOSTAT:
17472 ffestb_local_.rewrite.ix = FFESTP_rewriteixIOSTAT;
17473 ffestb_local_.rewrite.left = TRUE;
17474 ffestb_local_.rewrite.context = FFEEXPR_contextFILEINT;
17475 break;
17476
17477 case FFESTR_genioUNIT:
17478 ffestb_local_.rewrite.ix = FFESTP_rewriteixUNIT;
17479 ffestb_local_.rewrite.left = FALSE;
17480 ffestb_local_.rewrite.context = FFEEXPR_contextFILENUM;
17481 break;
17482
17483 default:
17484 goto bad; /* :::::::::::::::::::: */
17485 }
17486 if (ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
17487 .kw_or_val_present)
17488 break; /* Can't specify a keyword twice! */
17489 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
17490 .kw_or_val_present = TRUE;
17491 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
17492 .kw_present = TRUE;
17493 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
17494 .value_present = FALSE;
17495 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value_is_label
17496 = ffestb_local_.rewrite.label;
17497 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].kw
17498 = ffelex_token_use (t);
17499 return (ffelexHandler) ffestb_V0188_;
17500
17501 default:
17502 break;
17503 }
17504
17505 bad: /* :::::::::::::::::::: */
17506 ffestb_subr_kill_rewrite_ ();
17507 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17508 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17509 }
17510
17511 /* ffestb_V0188_ -- "REWRITE" OPEN_PAREN [external-file-unit COMMA [format
17512 COMMA]] NAME
17513
17514 return ffestb_V0188_; // to lexer
17515
17516 Make sure EQUALS here, send next token to expression handler. */
17517
17518 static ffelexHandler
ffestb_V0188_(ffelexToken t)17519 ffestb_V0188_ (ffelexToken t)
17520 {
17521 switch (ffelex_token_type (t))
17522 {
17523 case FFELEX_typeEQUALS:
17524 ffesta_confirmed ();
17525 if (ffestb_local_.rewrite.label)
17526 return (ffelexHandler) ffestb_V01810_;
17527 if (ffestb_local_.rewrite.left)
17528 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
17529 ffestb_local_.rewrite.context,
17530 (ffeexprCallback) ffestb_V0189_);
17531 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17532 ffestb_local_.rewrite.context,
17533 (ffeexprCallback) ffestb_V0189_);
17534
17535 default:
17536 break;
17537 }
17538
17539 ffestb_subr_kill_rewrite_ ();
17540 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17541 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17542 }
17543
17544 /* ffestb_V0189_ -- "REWRITE" OPEN_PAREN ... NAME EQUALS expr
17545
17546 (ffestb_V0189_) // to expression handler
17547
17548 Handle COMMA or CLOSE_PAREN here. */
17549
17550 static ffelexHandler
ffestb_V0189_(ffelexToken ft,ffebld expr,ffelexToken t)17551 ffestb_V0189_ (ffelexToken ft, ffebld expr, ffelexToken t)
17552 {
17553 switch (ffelex_token_type (t))
17554 {
17555 case FFELEX_typeCOMMA:
17556 case FFELEX_typeCLOSE_PAREN:
17557 if (expr == NULL)
17558 if (ffestb_local_.rewrite.context == FFEEXPR_contextFILEFORMAT)
17559 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
17560 .value_is_label = TRUE;
17561 else
17562 break;
17563 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value_present
17564 = TRUE;
17565 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value
17566 = ffelex_token_use (ft);
17567 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].u.expr = expr;
17568 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
17569 return (ffelexHandler) ffestb_V0187_;
17570 return (ffelexHandler) ffestb_V01812_;
17571
17572 default:
17573 break;
17574 }
17575
17576 ffestb_subr_kill_rewrite_ ();
17577 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17578 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17579 }
17580
17581 /* ffestb_V01810_ -- "REWRITE" OPEN_PAREN ... NAME EQUALS
17582
17583 return ffestb_V01810_; // to lexer
17584
17585 Handle NUMBER for label here. */
17586
17587 static ffelexHandler
ffestb_V01810_(ffelexToken t)17588 ffestb_V01810_ (ffelexToken t)
17589 {
17590 switch (ffelex_token_type (t))
17591 {
17592 case FFELEX_typeNUMBER:
17593 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value_present
17594 = TRUE;
17595 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value
17596 = ffelex_token_use (t);
17597 return (ffelexHandler) ffestb_V01811_;
17598
17599 default:
17600 break;
17601 }
17602
17603 ffestb_subr_kill_rewrite_ ();
17604 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17605 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17606 }
17607
17608 /* ffestb_V01811_ -- "REWRITE" OPEN_PAREN ... NAME EQUALS NUMBER
17609
17610 return ffestb_V01811_; // to lexer
17611
17612 Handle COMMA or CLOSE_PAREN here. */
17613
17614 static ffelexHandler
ffestb_V01811_(ffelexToken t)17615 ffestb_V01811_ (ffelexToken t)
17616 {
17617 switch (ffelex_token_type (t))
17618 {
17619 case FFELEX_typeCOMMA:
17620 return (ffelexHandler) ffestb_V0187_;
17621
17622 case FFELEX_typeCLOSE_PAREN:
17623 return (ffelexHandler) ffestb_V01812_;
17624
17625 default:
17626 break;
17627 }
17628
17629 ffestb_subr_kill_rewrite_ ();
17630 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17631 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17632 }
17633
17634 /* ffestb_V01812_ -- "REWRITE" OPEN_PAREN ... CLOSE_PAREN
17635
17636 return ffestb_V01812_; // to lexer
17637
17638 Handle EOS or SEMICOLON here. */
17639
17640 static ffelexHandler
ffestb_V01812_(ffelexToken t)17641 ffestb_V01812_ (ffelexToken t)
17642 {
17643 switch (ffelex_token_type (t))
17644 {
17645 case FFELEX_typeEOS:
17646 case FFELEX_typeSEMICOLON:
17647 ffesta_confirmed ();
17648 if (!ffesta_is_inhibited ())
17649 {
17650 ffestc_V018_start ();
17651 ffestc_V018_finish ();
17652 }
17653 ffestb_subr_kill_rewrite_ ();
17654 return (ffelexHandler) ffesta_zero (t);
17655
17656 case FFELEX_typeNAME:
17657 case FFELEX_typeOPEN_PAREN:
17658 case FFELEX_typeCOMMA:
17659 ffesta_confirmed ();
17660 if (!ffesta_is_inhibited ())
17661 ffestc_V018_start ();
17662 ffestb_subr_kill_rewrite_ ();
17663
17664 /* EXTENSION: Allow an optional preceding COMMA here if not pedantic.
17665 (f2c provides this extension, as do other compilers, supposedly.) */
17666
17667 if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA))
17668 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17669 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V01813_);
17670
17671 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17672 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V01813_)))
17673 (t);
17674
17675 default:
17676 break;
17677 }
17678
17679 ffestb_subr_kill_rewrite_ ();
17680 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17681 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17682 }
17683
17684 /* ffestb_V01813_ -- "REWRITE(...)" expr
17685
17686 (ffestb_V01813_) // to expression handler
17687
17688 Handle COMMA or EOS/SEMICOLON here. */
17689
17690 static ffelexHandler
ffestb_V01813_(ffelexToken ft,ffebld expr,ffelexToken t)17691 ffestb_V01813_ (ffelexToken ft, ffebld expr, ffelexToken t)
17692 {
17693 switch (ffelex_token_type (t))
17694 {
17695 case FFELEX_typeCOMMA:
17696 if (expr == NULL)
17697 break;
17698 if (!ffesta_is_inhibited ())
17699 ffestc_V018_item (expr, ft);
17700 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17701 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V01813_);
17702
17703 case FFELEX_typeEOS:
17704 case FFELEX_typeSEMICOLON:
17705 if (expr == NULL)
17706 break;
17707 if (!ffesta_is_inhibited ())
17708 {
17709 ffestc_V018_item (expr, ft);
17710 ffestc_V018_finish ();
17711 }
17712 return (ffelexHandler) ffesta_zero (t);
17713
17714 default:
17715 break;
17716 }
17717
17718 if (!ffesta_is_inhibited ())
17719 ffestc_V018_finish ();
17720 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
17721 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17722 }
17723
17724 /* ffestb_V019 -- Parse the ACCEPT statement
17725
17726 return ffestb_V019; // to lexer
17727
17728 Make sure the statement has a valid form for the ACCEPT
17729 statement. If it does, implement the statement. */
17730
17731 ffelexHandler
ffestb_V019(ffelexToken t)17732 ffestb_V019 (ffelexToken t)
17733 {
17734 ffelexHandler next;
17735 ffestpAcceptIx ix;
17736
17737 switch (ffelex_token_type (ffesta_tokens[0]))
17738 {
17739 case FFELEX_typeNAME:
17740 if (ffesta_first_kw != FFESTR_firstACCEPT)
17741 goto bad_0; /* :::::::::::::::::::: */
17742 switch (ffelex_token_type (t))
17743 {
17744 case FFELEX_typeCOMMA:
17745 case FFELEX_typeCOLONCOLON:
17746 case FFELEX_typeEOS:
17747 case FFELEX_typeSEMICOLON:
17748 ffesta_confirmed (); /* Error, but clearly intended. */
17749 goto bad_1; /* :::::::::::::::::::: */
17750
17751 case FFELEX_typeEQUALS:
17752 case FFELEX_typePOINTS:
17753 case FFELEX_typeCOLON:
17754 goto bad_1; /* :::::::::::::::::::: */
17755
17756 case FFELEX_typeNAME:
17757 case FFELEX_typeNUMBER:
17758 ffesta_confirmed ();
17759 break;
17760
17761 default:
17762 break;
17763 }
17764
17765 for (ix = 0; ix < FFESTP_acceptix; ++ix)
17766 ffestp_file.accept.accept_spec[ix].kw_or_val_present = FALSE;
17767 return (ffelexHandler) (*((ffelexHandler)
17768 ffeexpr_rhs (ffesta_output_pool,
17769 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0191_)))
17770 (t);
17771
17772 case FFELEX_typeNAMES:
17773 if (ffesta_first_kw != FFESTR_firstACCEPT)
17774 goto bad_0; /* :::::::::::::::::::: */
17775 switch (ffelex_token_type (t))
17776 {
17777 case FFELEX_typeEOS:
17778 case FFELEX_typeSEMICOLON:
17779 case FFELEX_typeCOMMA:
17780 ffesta_confirmed ();
17781 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlACCEPT)
17782 break;
17783 goto bad_1; /* :::::::::::::::::::: */
17784
17785 case FFELEX_typeCOLONCOLON:
17786 ffesta_confirmed (); /* Error, but clearly intended. */
17787 goto bad_1; /* :::::::::::::::::::: */
17788
17789 case FFELEX_typeEQUALS:
17790 case FFELEX_typePOINTS:
17791 case FFELEX_typeCOLON:
17792 goto bad_1; /* :::::::::::::::::::: */
17793
17794 default:
17795 break;
17796 }
17797 for (ix = 0; ix < FFESTP_acceptix; ++ix)
17798 ffestp_file.accept.accept_spec[ix].kw_or_val_present = FALSE;
17799 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17800 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0191_);
17801 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
17802 FFESTR_firstlACCEPT);
17803 if (next == NULL)
17804 return (ffelexHandler) ffelex_swallow_tokens (t,
17805 (ffelexHandler) ffesta_zero);
17806 return (ffelexHandler) (*next) (t);
17807
17808 default:
17809 goto bad_0; /* :::::::::::::::::::: */
17810 }
17811
17812 bad_0: /* :::::::::::::::::::: */
17813 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", ffesta_tokens[0]);
17814 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17815
17816 bad_1: /* :::::::::::::::::::: */
17817 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", t);
17818 return (ffelexHandler) ffelex_swallow_tokens (t,
17819 (ffelexHandler) ffesta_zero); /* Invalid second token. */
17820 }
17821
17822 /* ffestb_V0191_ -- "ACCEPT" expr
17823
17824 (ffestb_V0191_) // to expression handler
17825
17826 Make sure the next token is a COMMA or EOS/SEMICOLON. */
17827
17828 static ffelexHandler
ffestb_V0191_(ffelexToken ft,ffebld expr,ffelexToken t)17829 ffestb_V0191_ (ffelexToken ft, ffebld expr, ffelexToken t)
17830 {
17831 switch (ffelex_token_type (t))
17832 {
17833 case FFELEX_typeEOS:
17834 case FFELEX_typeSEMICOLON:
17835 case FFELEX_typeCOMMA:
17836 ffesta_confirmed ();
17837 ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].kw_or_val_present
17838 = TRUE;
17839 ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].kw_present = FALSE;
17840 ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].value_present = TRUE;
17841 ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].value_is_label
17842 = (expr == NULL);
17843 ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].value
17844 = ffelex_token_use (ft);
17845 ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].u.expr = expr;
17846 if (!ffesta_is_inhibited ())
17847 ffestc_V019_start ();
17848 ffestb_subr_kill_accept_ ();
17849 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
17850 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
17851 FFEEXPR_contextIOLIST,
17852 (ffeexprCallback) ffestb_V0192_);
17853 if (!ffesta_is_inhibited ())
17854 ffestc_V019_finish ();
17855 return (ffelexHandler) ffesta_zero (t);
17856
17857 default:
17858 break;
17859 }
17860
17861 ffestb_subr_kill_accept_ ();
17862 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", t);
17863 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17864 }
17865
17866 /* ffestb_V0192_ -- "ACCEPT" expr COMMA expr
17867
17868 (ffestb_V0192_) // to expression handler
17869
17870 Handle COMMA or EOS/SEMICOLON here. */
17871
17872 static ffelexHandler
ffestb_V0192_(ffelexToken ft,ffebld expr,ffelexToken t)17873 ffestb_V0192_ (ffelexToken ft, ffebld expr, ffelexToken t)
17874 {
17875 switch (ffelex_token_type (t))
17876 {
17877 case FFELEX_typeCOMMA:
17878 if (expr == NULL)
17879 break;
17880 if (!ffesta_is_inhibited ())
17881 ffestc_V019_item (expr, ft);
17882 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
17883 FFEEXPR_contextIOLIST,
17884 (ffeexprCallback) ffestb_V0192_);
17885
17886 case FFELEX_typeEOS:
17887 case FFELEX_typeSEMICOLON:
17888 if (expr == NULL)
17889 break;
17890 if (!ffesta_is_inhibited ())
17891 {
17892 ffestc_V019_item (expr, ft);
17893 ffestc_V019_finish ();
17894 }
17895 return (ffelexHandler) ffesta_zero (t);
17896
17897 default:
17898 break;
17899 }
17900
17901 if (!ffesta_is_inhibited ())
17902 ffestc_V019_finish ();
17903 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", t);
17904 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17905 }
17906
17907 #endif
17908 /* ffestb_V020 -- Parse the TYPE statement
17909
17910 return ffestb_V020; // to lexer
17911
17912 Make sure the statement has a valid form for the TYPE
17913 statement. If it does, implement the statement. */
17914
17915 ffelexHandler
ffestb_V020(ffelexToken t)17916 ffestb_V020 (ffelexToken t)
17917 {
17918 ffeTokenLength i;
17919 const char *p;
17920 ffelexHandler next;
17921 ffestpTypeIx ix;
17922
17923 switch (ffelex_token_type (ffesta_tokens[0]))
17924 {
17925 case FFELEX_typeNAME:
17926 if (ffesta_first_kw != FFESTR_firstTYPE)
17927 goto bad_0; /* :::::::::::::::::::: */
17928 switch (ffelex_token_type (t))
17929 {
17930 case FFELEX_typeCOLONCOLON:
17931 case FFELEX_typeEOS:
17932 case FFELEX_typeSEMICOLON:
17933 ffesta_confirmed (); /* Error, but clearly intended. */
17934 goto bad_1; /* :::::::::::::::::::: */
17935
17936 case FFELEX_typeEQUALS:
17937 case FFELEX_typePOINTS:
17938 case FFELEX_typeCOLON:
17939 case FFELEX_typeCOMMA: /* Because "TYPE,PUBLIC::A" is ambiguous with
17940 '90. */
17941 goto bad_1; /* :::::::::::::::::::: */
17942
17943 case FFELEX_typeNUMBER:
17944 ffesta_confirmed ();
17945 break;
17946
17947 case FFELEX_typeNAME: /* Because TYPE A is ambiguous with '90. */
17948 default:
17949 break;
17950 }
17951
17952 for (ix = 0; ix < FFESTP_typeix; ++ix)
17953 ffestp_file.type.type_spec[ix].kw_or_val_present = FALSE;
17954 return (ffelexHandler) (*((ffelexHandler)
17955 ffeexpr_rhs (ffesta_output_pool,
17956 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0201_)))
17957 (t);
17958
17959 case FFELEX_typeNAMES:
17960 if (ffesta_first_kw != FFESTR_firstTYPE)
17961 goto bad_0; /* :::::::::::::::::::: */
17962 switch (ffelex_token_type (t))
17963 {
17964 case FFELEX_typeEOS:
17965 case FFELEX_typeSEMICOLON:
17966 case FFELEX_typeCOMMA:
17967 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlTYPE)
17968 break;
17969 goto bad_1; /* :::::::::::::::::::: */
17970
17971 case FFELEX_typeCOLONCOLON:
17972 ffesta_confirmed (); /* Error, but clearly intended. */
17973 goto bad_1; /* :::::::::::::::::::: */
17974
17975 case FFELEX_typeOPEN_PAREN:
17976 if (ffelex_token_length (ffesta_tokens[0]) == FFESTR_firstlTYPE)
17977 break; /* Else might be assignment/stmtfuncdef. */
17978 goto bad_1; /* :::::::::::::::::::: */
17979
17980 case FFELEX_typeEQUALS:
17981 case FFELEX_typePOINTS:
17982 case FFELEX_typeCOLON:
17983 goto bad_1; /* :::::::::::::::::::: */
17984
17985 default:
17986 break;
17987 }
17988 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlTYPE);
17989 if (ISDIGIT (*p))
17990 ffesta_confirmed (); /* Else might be '90 TYPE statement. */
17991 for (ix = 0; ix < FFESTP_typeix; ++ix)
17992 ffestp_file.type.type_spec[ix].kw_or_val_present = FALSE;
17993 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
17994 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0201_);
17995 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
17996 FFESTR_firstlTYPE);
17997 if (next == NULL)
17998 return (ffelexHandler) ffelex_swallow_tokens (t,
17999 (ffelexHandler) ffesta_zero);
18000 return (ffelexHandler) (*next) (t);
18001
18002 default:
18003 goto bad_0; /* :::::::::::::::::::: */
18004 }
18005
18006 bad_0: /* :::::::::::::::::::: */
18007 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", ffesta_tokens[0]);
18008 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18009
18010 bad_1: /* :::::::::::::::::::: */
18011 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", t);
18012 return (ffelexHandler) ffelex_swallow_tokens (t,
18013 (ffelexHandler) ffesta_zero); /* Invalid second token. */
18014 }
18015
18016 /* ffestb_V0201_ -- "TYPE" expr
18017
18018 (ffestb_V0201_) // to expression handler
18019
18020 Make sure the next token is a COMMA or EOS/SEMICOLON. */
18021
18022 static ffelexHandler
ffestb_V0201_(ffelexToken ft,ffebld expr,ffelexToken t)18023 ffestb_V0201_ (ffelexToken ft, ffebld expr, ffelexToken t)
18024 {
18025 bool comma = TRUE;
18026
18027 switch (ffelex_token_type (t))
18028 {
18029 case FFELEX_typeEOS:
18030 case FFELEX_typeSEMICOLON:
18031 if (!ffe_is_vxt () && (expr != NULL)
18032 && (ffebld_op (expr) == FFEBLD_opSYMTER))
18033 break;
18034 comma = FALSE;
18035 /* Fall through. */
18036 case FFELEX_typeCOMMA:
18037 if (!ffe_is_vxt () && comma && (expr != NULL)
18038 && (ffebld_op (expr) == FFEBLD_opPAREN)
18039 && (ffebld_op (ffebld_left (expr)) == FFEBLD_opSYMTER))
18040 break;
18041 ffesta_confirmed ();
18042 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].kw_or_val_present
18043 = TRUE;
18044 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].kw_present = FALSE;
18045 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].value_present = TRUE;
18046 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].value_is_label
18047 = (expr == NULL);
18048 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].value
18049 = ffelex_token_use (ft);
18050 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].u.expr = expr;
18051 if (!ffesta_is_inhibited ())
18052 ffestc_V020_start ();
18053 ffestb_subr_kill_type_ ();
18054 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
18055 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
18056 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V0202_);
18057 if (!ffesta_is_inhibited ())
18058 ffestc_V020_finish ();
18059 return (ffelexHandler) ffesta_zero (t);
18060
18061 default:
18062 break;
18063 }
18064
18065 ffestb_subr_kill_type_ ();
18066 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", t);
18067 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18068 }
18069
18070 /* ffestb_V0202_ -- "TYPE" expr COMMA expr
18071
18072 (ffestb_V0202_) // to expression handler
18073
18074 Handle COMMA or EOS/SEMICOLON here. */
18075
18076 static ffelexHandler
ffestb_V0202_(ffelexToken ft,ffebld expr,ffelexToken t)18077 ffestb_V0202_ (ffelexToken ft, ffebld expr, ffelexToken t)
18078 {
18079 switch (ffelex_token_type (t))
18080 {
18081 case FFELEX_typeCOMMA:
18082 if (expr == NULL)
18083 break;
18084 if (!ffesta_is_inhibited ())
18085 ffestc_V020_item (expr, ft);
18086 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
18087 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V0202_);
18088
18089 case FFELEX_typeEOS:
18090 case FFELEX_typeSEMICOLON:
18091 if (expr == NULL)
18092 break;
18093 if (!ffesta_is_inhibited ())
18094 {
18095 ffestc_V020_item (expr, ft);
18096 ffestc_V020_finish ();
18097 }
18098 return (ffelexHandler) ffesta_zero (t);
18099
18100 default:
18101 break;
18102 }
18103
18104 if (!ffesta_is_inhibited ())
18105 ffestc_V020_finish ();
18106 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", t);
18107 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18108 }
18109
18110 /* ffestb_V021 -- Parse a DELETE statement
18111
18112 return ffestb_V021; // to lexer
18113
18114 Make sure the statement has a valid form for a DELETE statement.
18115 If it does, implement the statement. */
18116
18117 #if FFESTR_VXT
18118 ffelexHandler
ffestb_V021(ffelexToken t)18119 ffestb_V021 (ffelexToken t)
18120 {
18121 ffestpDeleteIx ix;
18122
18123 switch (ffelex_token_type (ffesta_tokens[0]))
18124 {
18125 case FFELEX_typeNAME:
18126 if (ffesta_first_kw != FFESTR_firstDELETE)
18127 goto bad_0; /* :::::::::::::::::::: */
18128 break;
18129
18130 case FFELEX_typeNAMES:
18131 if (ffesta_first_kw != FFESTR_firstDELETE)
18132 goto bad_0; /* :::::::::::::::::::: */
18133 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlDELETE)
18134 goto bad_0; /* :::::::::::::::::::: */
18135 break;
18136
18137 default:
18138 goto bad_0; /* :::::::::::::::::::: */
18139 }
18140
18141 switch (ffelex_token_type (t))
18142 {
18143 case FFELEX_typeOPEN_PAREN:
18144 break;
18145
18146 case FFELEX_typeEOS:
18147 case FFELEX_typeSEMICOLON:
18148 case FFELEX_typeCOMMA:
18149 case FFELEX_typeCOLONCOLON:
18150 ffesta_confirmed (); /* Error, but clearly intended. */
18151 goto bad_1; /* :::::::::::::::::::: */
18152
18153 default:
18154 goto bad_1; /* :::::::::::::::::::: */
18155 }
18156
18157 for (ix = 0; ix < FFESTP_deleteix; ++ix)
18158 ffestp_file.delete.delete_spec[ix].kw_or_val_present = FALSE;
18159
18160 return (ffelexHandler) ffestb_V0211_;
18161
18162 bad_0: /* :::::::::::::::::::: */
18163 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", ffesta_tokens[0]);
18164 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18165
18166 bad_1: /* :::::::::::::::::::: */
18167 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
18168 return (ffelexHandler) ffelex_swallow_tokens (t,
18169 (ffelexHandler) ffesta_zero); /* Invalid second token. */
18170 }
18171
18172 /* ffestb_V0211_ -- "DELETE" OPEN_PAREN
18173
18174 return ffestb_V0211_; // to lexer
18175
18176 Handle expr construct (not NAME=expr construct) here. */
18177
18178 static ffelexHandler
ffestb_V0211_(ffelexToken t)18179 ffestb_V0211_ (ffelexToken t)
18180 {
18181 switch (ffelex_token_type (t))
18182 {
18183 case FFELEX_typeNAME:
18184 ffesta_tokens[1] = ffelex_token_use (t);
18185 return (ffelexHandler) ffestb_V0212_;
18186
18187 default:
18188 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
18189 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0213_)))
18190 (t);
18191 }
18192 }
18193
18194 /* ffestb_V0212_ -- "DELETE" OPEN_PAREN NAME
18195
18196 return ffestb_V0212_; // to lexer
18197
18198 If EQUALS here, go to states that handle it. Else, send NAME and this
18199 token thru expression handler. */
18200
18201 static ffelexHandler
ffestb_V0212_(ffelexToken t)18202 ffestb_V0212_ (ffelexToken t)
18203 {
18204 ffelexHandler next;
18205 ffelexToken nt;
18206
18207 switch (ffelex_token_type (t))
18208 {
18209 case FFELEX_typeEQUALS:
18210 nt = ffesta_tokens[1];
18211 next = (ffelexHandler) ffestb_V0214_ (nt);
18212 ffelex_token_kill (nt);
18213 return (ffelexHandler) (*next) (t);
18214
18215 default:
18216 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
18217 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0213_)))
18218 (ffesta_tokens[1]);
18219 ffelex_token_kill (ffesta_tokens[1]);
18220 return (ffelexHandler) (*next) (t);
18221 }
18222 }
18223
18224 /* ffestb_V0213_ -- "DELETE" OPEN_PAREN expr
18225
18226 (ffestb_V0213_) // to expression handler
18227
18228 Handle COMMA or DELETE_PAREN here. */
18229
18230 static ffelexHandler
ffestb_V0213_(ffelexToken ft,ffebld expr,ffelexToken t)18231 ffestb_V0213_ (ffelexToken ft, ffebld expr, ffelexToken t)
18232 {
18233 switch (ffelex_token_type (t))
18234 {
18235 case FFELEX_typeCOMMA:
18236 case FFELEX_typeCLOSE_PAREN:
18237 if (expr == NULL)
18238 break;
18239 ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].kw_or_val_present
18240 = TRUE;
18241 ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].kw_present = FALSE;
18242 ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].value_present = TRUE;
18243 ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].value_is_label
18244 = FALSE;
18245 ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].value
18246 = ffelex_token_use (ft);
18247 ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].u.expr = expr;
18248 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
18249 return (ffelexHandler) ffestb_V0214_;
18250 return (ffelexHandler) ffestb_V0219_;
18251
18252 default:
18253 break;
18254 }
18255
18256 ffestb_subr_kill_delete_ ();
18257 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
18258 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18259 }
18260
18261 /* ffestb_V0214_ -- "DELETE" OPEN_PAREN [external-file-unit COMMA]
18262
18263 return ffestb_V0214_; // to lexer
18264
18265 Handle expr construct (not NAME=expr construct) here. */
18266
18267 static ffelexHandler
ffestb_V0214_(ffelexToken t)18268 ffestb_V0214_ (ffelexToken t)
18269 {
18270 ffestrGenio kw;
18271
18272 ffestb_local_.delete.label = FALSE;
18273
18274 switch (ffelex_token_type (t))
18275 {
18276 case FFELEX_typeNAME:
18277 kw = ffestr_genio (t);
18278 switch (kw)
18279 {
18280 case FFESTR_genioERR:
18281 ffestb_local_.delete.ix = FFESTP_deleteixERR;
18282 ffestb_local_.delete.label = TRUE;
18283 break;
18284
18285 case FFESTR_genioIOSTAT:
18286 ffestb_local_.delete.ix = FFESTP_deleteixIOSTAT;
18287 ffestb_local_.delete.left = TRUE;
18288 ffestb_local_.delete.context = FFEEXPR_contextFILEINT;
18289 break;
18290
18291 case FFESTR_genioREC:
18292 ffestb_local_.delete.ix = FFESTP_deleteixREC;
18293 ffestb_local_.delete.left = FALSE;
18294 ffestb_local_.delete.context = FFEEXPR_contextFILENUM;
18295 break;
18296
18297 case FFESTR_genioUNIT:
18298 ffestb_local_.delete.ix = FFESTP_deleteixUNIT;
18299 ffestb_local_.delete.left = FALSE;
18300 ffestb_local_.delete.context = FFEEXPR_contextFILENUM;
18301 break;
18302
18303 default:
18304 goto bad; /* :::::::::::::::::::: */
18305 }
18306 if (ffestp_file.delete.delete_spec[ffestb_local_.delete.ix]
18307 .kw_or_val_present)
18308 break; /* Can't specify a keyword twice! */
18309 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix]
18310 .kw_or_val_present = TRUE;
18311 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix]
18312 .kw_present = TRUE;
18313 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix]
18314 .value_present = FALSE;
18315 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value_is_label
18316 = ffestb_local_.delete.label;
18317 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].kw
18318 = ffelex_token_use (t);
18319 return (ffelexHandler) ffestb_V0215_;
18320
18321 default:
18322 break;
18323 }
18324
18325 bad: /* :::::::::::::::::::: */
18326 ffestb_subr_kill_delete_ ();
18327 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
18328 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18329 }
18330
18331 /* ffestb_V0215_ -- "DELETE" OPEN_PAREN [external-file-unit COMMA] NAME
18332
18333 return ffestb_V0215_; // to lexer
18334
18335 Make sure EQUALS here, send next token to expression handler. */
18336
18337 static ffelexHandler
ffestb_V0215_(ffelexToken t)18338 ffestb_V0215_ (ffelexToken t)
18339 {
18340 switch (ffelex_token_type (t))
18341 {
18342 case FFELEX_typeEQUALS:
18343 ffesta_confirmed ();
18344 if (ffestb_local_.delete.label)
18345 return (ffelexHandler) ffestb_V0217_;
18346 if (ffestb_local_.delete.left)
18347 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
18348 ffestb_local_.delete.context,
18349 (ffeexprCallback) ffestb_V0216_);
18350 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
18351 ffestb_local_.delete.context, (ffeexprCallback) ffestb_V0216_);
18352
18353 default:
18354 break;
18355 }
18356
18357 ffestb_subr_kill_delete_ ();
18358 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
18359 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18360 }
18361
18362 /* ffestb_V0216_ -- "DELETE" OPEN_PAREN ... NAME EQUALS expr
18363
18364 (ffestb_V0216_) // to expression handler
18365
18366 Handle COMMA or CLOSE_PAREN here. */
18367
18368 static ffelexHandler
ffestb_V0216_(ffelexToken ft,ffebld expr,ffelexToken t)18369 ffestb_V0216_ (ffelexToken ft, ffebld expr, ffelexToken t)
18370 {
18371 switch (ffelex_token_type (t))
18372 {
18373 case FFELEX_typeCOMMA:
18374 case FFELEX_typeCLOSE_PAREN:
18375 if (expr == NULL)
18376 break;
18377 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value_present
18378 = TRUE;
18379 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value
18380 = ffelex_token_use (ft);
18381 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].u.expr = expr;
18382 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
18383 return (ffelexHandler) ffestb_V0214_;
18384 return (ffelexHandler) ffestb_V0219_;
18385
18386 default:
18387 break;
18388 }
18389
18390 ffestb_subr_kill_delete_ ();
18391 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
18392 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18393 }
18394
18395 /* ffestb_V0217_ -- "DELETE" OPEN_PAREN ... NAME EQUALS
18396
18397 return ffestb_V0217_; // to lexer
18398
18399 Handle NUMBER for label here. */
18400
18401 static ffelexHandler
ffestb_V0217_(ffelexToken t)18402 ffestb_V0217_ (ffelexToken t)
18403 {
18404 switch (ffelex_token_type (t))
18405 {
18406 case FFELEX_typeNUMBER:
18407 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value_present
18408 = TRUE;
18409 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value
18410 = ffelex_token_use (t);
18411 return (ffelexHandler) ffestb_V0218_;
18412
18413 default:
18414 break;
18415 }
18416
18417 ffestb_subr_kill_delete_ ();
18418 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
18419 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18420 }
18421
18422 /* ffestb_V0218_ -- "DELETE" OPEN_PAREN ... NAME EQUALS NUMBER
18423
18424 return ffestb_V0218_; // to lexer
18425
18426 Handle COMMA or CLOSE_PAREN here. */
18427
18428 static ffelexHandler
ffestb_V0218_(ffelexToken t)18429 ffestb_V0218_ (ffelexToken t)
18430 {
18431 switch (ffelex_token_type (t))
18432 {
18433 case FFELEX_typeCOMMA:
18434 return (ffelexHandler) ffestb_V0214_;
18435
18436 case FFELEX_typeCLOSE_PAREN:
18437 return (ffelexHandler) ffestb_V0219_;
18438
18439 default:
18440 break;
18441 }
18442
18443 ffestb_subr_kill_delete_ ();
18444 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
18445 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18446 }
18447
18448 /* ffestb_V0219_ -- "DELETE" OPEN_PAREN ... CLOSE_PAREN
18449
18450 return ffestb_V0219_; // to lexer
18451
18452 Handle EOS or SEMICOLON here. */
18453
18454 static ffelexHandler
ffestb_V0219_(ffelexToken t)18455 ffestb_V0219_ (ffelexToken t)
18456 {
18457 switch (ffelex_token_type (t))
18458 {
18459 case FFELEX_typeEOS:
18460 case FFELEX_typeSEMICOLON:
18461 ffesta_confirmed ();
18462 if (!ffesta_is_inhibited ())
18463 ffestc_V021 ();
18464 ffestb_subr_kill_delete_ ();
18465 return (ffelexHandler) ffesta_zero (t);
18466
18467 default:
18468 break;
18469 }
18470
18471 ffestb_subr_kill_delete_ ();
18472 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
18473 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18474 }
18475
18476 /* ffestb_V026 -- Parse a FIND statement
18477
18478 return ffestb_V026; // to lexer
18479
18480 Make sure the statement has a valid form for a FIND statement.
18481 If it does, implement the statement. */
18482
18483 ffelexHandler
ffestb_V026(ffelexToken t)18484 ffestb_V026 (ffelexToken t)
18485 {
18486 ffestpFindIx ix;
18487
18488 switch (ffelex_token_type (ffesta_tokens[0]))
18489 {
18490 case FFELEX_typeNAME:
18491 if (ffesta_first_kw != FFESTR_firstFIND)
18492 goto bad_0; /* :::::::::::::::::::: */
18493 break;
18494
18495 case FFELEX_typeNAMES:
18496 if (ffesta_first_kw != FFESTR_firstFIND)
18497 goto bad_0; /* :::::::::::::::::::: */
18498 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlFIND)
18499 goto bad_0; /* :::::::::::::::::::: */
18500 break;
18501
18502 default:
18503 goto bad_0; /* :::::::::::::::::::: */
18504 }
18505
18506 switch (ffelex_token_type (t))
18507 {
18508 case FFELEX_typeOPEN_PAREN:
18509 break;
18510
18511 case FFELEX_typeEOS:
18512 case FFELEX_typeSEMICOLON:
18513 case FFELEX_typeCOMMA:
18514 case FFELEX_typeCOLONCOLON:
18515 ffesta_confirmed (); /* Error, but clearly intended. */
18516 goto bad_1; /* :::::::::::::::::::: */
18517
18518 default:
18519 goto bad_1; /* :::::::::::::::::::: */
18520 }
18521
18522 for (ix = 0; ix < FFESTP_findix; ++ix)
18523 ffestp_file.find.find_spec[ix].kw_or_val_present = FALSE;
18524
18525 return (ffelexHandler) ffestb_V0261_;
18526
18527 bad_0: /* :::::::::::::::::::: */
18528 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", ffesta_tokens[0]);
18529 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18530
18531 bad_1: /* :::::::::::::::::::: */
18532 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
18533 return (ffelexHandler) ffelex_swallow_tokens (t,
18534 (ffelexHandler) ffesta_zero); /* Invalid second token. */
18535 }
18536
18537 /* ffestb_V0261_ -- "FIND" OPEN_PAREN
18538
18539 return ffestb_V0261_; // to lexer
18540
18541 Handle expr construct (not NAME=expr construct) here. */
18542
18543 static ffelexHandler
ffestb_V0261_(ffelexToken t)18544 ffestb_V0261_ (ffelexToken t)
18545 {
18546 switch (ffelex_token_type (t))
18547 {
18548 case FFELEX_typeNAME:
18549 ffesta_tokens[1] = ffelex_token_use (t);
18550 return (ffelexHandler) ffestb_V0262_;
18551
18552 default:
18553 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
18554 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0263_)))
18555 (t);
18556 }
18557 }
18558
18559 /* ffestb_V0262_ -- "FIND" OPEN_PAREN NAME
18560
18561 return ffestb_V0262_; // to lexer
18562
18563 If EQUALS here, go to states that handle it. Else, send NAME and this
18564 token thru expression handler. */
18565
18566 static ffelexHandler
ffestb_V0262_(ffelexToken t)18567 ffestb_V0262_ (ffelexToken t)
18568 {
18569 ffelexHandler next;
18570 ffelexToken nt;
18571
18572 switch (ffelex_token_type (t))
18573 {
18574 case FFELEX_typeEQUALS:
18575 nt = ffesta_tokens[1];
18576 next = (ffelexHandler) ffestb_V0264_ (nt);
18577 ffelex_token_kill (nt);
18578 return (ffelexHandler) (*next) (t);
18579
18580 default:
18581 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
18582 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0263_)))
18583 (ffesta_tokens[1]);
18584 ffelex_token_kill (ffesta_tokens[1]);
18585 return (ffelexHandler) (*next) (t);
18586 }
18587 }
18588
18589 /* ffestb_V0263_ -- "FIND" OPEN_PAREN expr
18590
18591 (ffestb_V0263_) // to expression handler
18592
18593 Handle COMMA or FIND_PAREN here. */
18594
18595 static ffelexHandler
ffestb_V0263_(ffelexToken ft,ffebld expr,ffelexToken t)18596 ffestb_V0263_ (ffelexToken ft, ffebld expr, ffelexToken t)
18597 {
18598 switch (ffelex_token_type (t))
18599 {
18600 case FFELEX_typeCOMMA:
18601 case FFELEX_typeCLOSE_PAREN:
18602 if (expr == NULL)
18603 break;
18604 ffestp_file.find.find_spec[FFESTP_findixUNIT].kw_or_val_present
18605 = TRUE;
18606 ffestp_file.find.find_spec[FFESTP_findixUNIT].kw_present = FALSE;
18607 ffestp_file.find.find_spec[FFESTP_findixUNIT].value_present = TRUE;
18608 ffestp_file.find.find_spec[FFESTP_findixUNIT].value_is_label
18609 = FALSE;
18610 ffestp_file.find.find_spec[FFESTP_findixUNIT].value
18611 = ffelex_token_use (ft);
18612 ffestp_file.find.find_spec[FFESTP_findixUNIT].u.expr = expr;
18613 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
18614 return (ffelexHandler) ffestb_V0264_;
18615 return (ffelexHandler) ffestb_V0269_;
18616
18617 default:
18618 break;
18619 }
18620
18621 ffestb_subr_kill_find_ ();
18622 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
18623 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18624 }
18625
18626 /* ffestb_V0264_ -- "FIND" OPEN_PAREN [external-file-unit COMMA]
18627
18628 return ffestb_V0264_; // to lexer
18629
18630 Handle expr construct (not NAME=expr construct) here. */
18631
18632 static ffelexHandler
ffestb_V0264_(ffelexToken t)18633 ffestb_V0264_ (ffelexToken t)
18634 {
18635 ffestrGenio kw;
18636
18637 ffestb_local_.find.label = FALSE;
18638
18639 switch (ffelex_token_type (t))
18640 {
18641 case FFELEX_typeNAME:
18642 kw = ffestr_genio (t);
18643 switch (kw)
18644 {
18645 case FFESTR_genioERR:
18646 ffestb_local_.find.ix = FFESTP_findixERR;
18647 ffestb_local_.find.label = TRUE;
18648 break;
18649
18650 case FFESTR_genioIOSTAT:
18651 ffestb_local_.find.ix = FFESTP_findixIOSTAT;
18652 ffestb_local_.find.left = TRUE;
18653 ffestb_local_.find.context = FFEEXPR_contextFILEINT;
18654 break;
18655
18656 case FFESTR_genioREC:
18657 ffestb_local_.find.ix = FFESTP_findixREC;
18658 ffestb_local_.find.left = FALSE;
18659 ffestb_local_.find.context = FFEEXPR_contextFILENUM;
18660 break;
18661
18662 case FFESTR_genioUNIT:
18663 ffestb_local_.find.ix = FFESTP_findixUNIT;
18664 ffestb_local_.find.left = FALSE;
18665 ffestb_local_.find.context = FFEEXPR_contextFILENUM;
18666 break;
18667
18668 default:
18669 goto bad; /* :::::::::::::::::::: */
18670 }
18671 if (ffestp_file.find.find_spec[ffestb_local_.find.ix]
18672 .kw_or_val_present)
18673 break; /* Can't specify a keyword twice! */
18674 ffestp_file.find.find_spec[ffestb_local_.find.ix]
18675 .kw_or_val_present = TRUE;
18676 ffestp_file.find.find_spec[ffestb_local_.find.ix]
18677 .kw_present = TRUE;
18678 ffestp_file.find.find_spec[ffestb_local_.find.ix]
18679 .value_present = FALSE;
18680 ffestp_file.find.find_spec[ffestb_local_.find.ix].value_is_label
18681 = ffestb_local_.find.label;
18682 ffestp_file.find.find_spec[ffestb_local_.find.ix].kw
18683 = ffelex_token_use (t);
18684 return (ffelexHandler) ffestb_V0265_;
18685
18686 default:
18687 break;
18688 }
18689
18690 bad: /* :::::::::::::::::::: */
18691 ffestb_subr_kill_find_ ();
18692 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
18693 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18694 }
18695
18696 /* ffestb_V0265_ -- "FIND" OPEN_PAREN [external-file-unit COMMA] NAME
18697
18698 return ffestb_V0265_; // to lexer
18699
18700 Make sure EQUALS here, send next token to expression handler. */
18701
18702 static ffelexHandler
ffestb_V0265_(ffelexToken t)18703 ffestb_V0265_ (ffelexToken t)
18704 {
18705 switch (ffelex_token_type (t))
18706 {
18707 case FFELEX_typeEQUALS:
18708 ffesta_confirmed ();
18709 if (ffestb_local_.find.label)
18710 return (ffelexHandler) ffestb_V0267_;
18711 if (ffestb_local_.find.left)
18712 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
18713 ffestb_local_.find.context,
18714 (ffeexprCallback) ffestb_V0266_);
18715 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
18716 ffestb_local_.find.context,
18717 (ffeexprCallback) ffestb_V0266_);
18718
18719 default:
18720 break;
18721 }
18722
18723 ffestb_subr_kill_find_ ();
18724 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
18725 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18726 }
18727
18728 /* ffestb_V0266_ -- "FIND" OPEN_PAREN ... NAME EQUALS expr
18729
18730 (ffestb_V0266_) // to expression handler
18731
18732 Handle COMMA or CLOSE_PAREN here. */
18733
18734 static ffelexHandler
ffestb_V0266_(ffelexToken ft,ffebld expr,ffelexToken t)18735 ffestb_V0266_ (ffelexToken ft, ffebld expr, ffelexToken t)
18736 {
18737 switch (ffelex_token_type (t))
18738 {
18739 case FFELEX_typeCOMMA:
18740 case FFELEX_typeCLOSE_PAREN:
18741 if (expr == NULL)
18742 break;
18743 ffestp_file.find.find_spec[ffestb_local_.find.ix].value_present
18744 = TRUE;
18745 ffestp_file.find.find_spec[ffestb_local_.find.ix].value
18746 = ffelex_token_use (ft);
18747 ffestp_file.find.find_spec[ffestb_local_.find.ix].u.expr = expr;
18748 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
18749 return (ffelexHandler) ffestb_V0264_;
18750 return (ffelexHandler) ffestb_V0269_;
18751
18752 default:
18753 break;
18754 }
18755
18756 ffestb_subr_kill_find_ ();
18757 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
18758 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18759 }
18760
18761 /* ffestb_V0267_ -- "FIND" OPEN_PAREN ... NAME EQUALS
18762
18763 return ffestb_V0267_; // to lexer
18764
18765 Handle NUMBER for label here. */
18766
18767 static ffelexHandler
ffestb_V0267_(ffelexToken t)18768 ffestb_V0267_ (ffelexToken t)
18769 {
18770 switch (ffelex_token_type (t))
18771 {
18772 case FFELEX_typeNUMBER:
18773 ffestp_file.find.find_spec[ffestb_local_.find.ix].value_present
18774 = TRUE;
18775 ffestp_file.find.find_spec[ffestb_local_.find.ix].value
18776 = ffelex_token_use (t);
18777 return (ffelexHandler) ffestb_V0268_;
18778
18779 default:
18780 break;
18781 }
18782
18783 ffestb_subr_kill_find_ ();
18784 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
18785 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18786 }
18787
18788 /* ffestb_V0268_ -- "FIND" OPEN_PAREN ... NAME EQUALS NUMBER
18789
18790 return ffestb_V0268_; // to lexer
18791
18792 Handle COMMA or CLOSE_PAREN here. */
18793
18794 static ffelexHandler
ffestb_V0268_(ffelexToken t)18795 ffestb_V0268_ (ffelexToken t)
18796 {
18797 switch (ffelex_token_type (t))
18798 {
18799 case FFELEX_typeCOMMA:
18800 return (ffelexHandler) ffestb_V0264_;
18801
18802 case FFELEX_typeCLOSE_PAREN:
18803 return (ffelexHandler) ffestb_V0269_;
18804
18805 default:
18806 break;
18807 }
18808
18809 ffestb_subr_kill_find_ ();
18810 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
18811 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18812 }
18813
18814 /* ffestb_V0269_ -- "FIND" OPEN_PAREN ... CLOSE_PAREN
18815
18816 return ffestb_V0269_; // to lexer
18817
18818 Handle EOS or SEMICOLON here. */
18819
18820 static ffelexHandler
ffestb_V0269_(ffelexToken t)18821 ffestb_V0269_ (ffelexToken t)
18822 {
18823 switch (ffelex_token_type (t))
18824 {
18825 case FFELEX_typeEOS:
18826 case FFELEX_typeSEMICOLON:
18827 ffesta_confirmed ();
18828 if (!ffesta_is_inhibited ())
18829 ffestc_V026 ();
18830 ffestb_subr_kill_find_ ();
18831 return (ffelexHandler) ffesta_zero (t);
18832
18833 default:
18834 break;
18835 }
18836
18837 ffestb_subr_kill_find_ ();
18838 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
18839 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
18840 }
18841
18842 #endif
18843 /* ffestb_dimlist -- Parse the ALLOCATABLE/POINTER/TARGET statement
18844
18845 return ffestb_dimlist; // to lexer
18846
18847 Make sure the statement has a valid form for the ALLOCATABLE/POINTER/
18848 TARGET statement. If it does, implement the statement. */
18849
18850 #if FFESTR_F90
18851 ffelexHandler
ffestb_dimlist(ffelexToken t)18852 ffestb_dimlist (ffelexToken t)
18853 {
18854 ffeTokenLength i;
18855 const char *p;
18856 ffelexToken nt;
18857 ffelexHandler next;
18858
18859 switch (ffelex_token_type (ffesta_tokens[0]))
18860 {
18861 case FFELEX_typeNAME:
18862 switch (ffelex_token_type (t))
18863 {
18864 case FFELEX_typeCOMMA:
18865 case FFELEX_typeEOS:
18866 case FFELEX_typeSEMICOLON:
18867 ffesta_confirmed (); /* Error, but clearly intended. */
18868 goto bad_1; /* :::::::::::::::::::: */
18869
18870 default:
18871 goto bad_1; /* :::::::::::::::::::: */
18872
18873 case FFELEX_typeCOLONCOLON:
18874 ffesta_confirmed ();
18875 if (!ffesta_is_inhibited ())
18876 {
18877 switch (ffesta_first_kw)
18878 {
18879 case FFESTR_firstALLOCATABLE:
18880 ffestc_R525_start ();
18881 break;
18882
18883 case FFESTR_firstPOINTER:
18884 ffestc_R526_start ();
18885 break;
18886
18887 case FFESTR_firstTARGET:
18888 ffestc_R527_start ();
18889 break;
18890
18891 default:
18892 assert (FALSE);
18893 }
18894 }
18895 ffestb_local_.dimlist.started = TRUE;
18896 return (ffelexHandler) ffestb_dimlist1_;
18897
18898 case FFELEX_typeNAME:
18899 ffesta_confirmed ();
18900 if (!ffesta_is_inhibited ())
18901 {
18902 switch (ffesta_first_kw)
18903 {
18904 case FFESTR_firstALLOCATABLE:
18905 ffestc_R525_start ();
18906 break;
18907
18908 case FFESTR_firstPOINTER:
18909 ffestc_R526_start ();
18910 break;
18911
18912 case FFESTR_firstTARGET:
18913 ffestc_R527_start ();
18914 break;
18915
18916 default:
18917 assert (FALSE);
18918 }
18919 }
18920 ffestb_local_.dimlist.started = TRUE;
18921 return (ffelexHandler) ffestb_dimlist1_ (t);
18922 }
18923
18924 case FFELEX_typeNAMES:
18925 p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.dimlist.len);
18926 switch (ffelex_token_type (t))
18927 {
18928 default:
18929 goto bad_1; /* :::::::::::::::::::: */
18930
18931 case FFELEX_typeEOS:
18932 case FFELEX_typeSEMICOLON:
18933 case FFELEX_typeCOMMA:
18934 ffesta_confirmed ();
18935 if (!ffesrc_is_name_init (*p))
18936 goto bad_i; /* :::::::::::::::::::: */
18937 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
18938 if (!ffesta_is_inhibited ())
18939 {
18940 switch (ffesta_first_kw)
18941 {
18942 case FFESTR_firstALLOCATABLE:
18943 ffestc_R525_start ();
18944 break;
18945
18946 case FFESTR_firstPOINTER:
18947 ffestc_R526_start ();
18948 break;
18949
18950 case FFESTR_firstTARGET:
18951 ffestc_R527_start ();
18952 break;
18953
18954 default:
18955 assert (FALSE);
18956 }
18957 }
18958 ffestb_local_.dimlist.started = TRUE;
18959 next = (ffelexHandler) ffestb_dimlist1_ (nt);
18960 ffelex_token_kill (nt);
18961 return (ffelexHandler) (*next) (t);
18962
18963 case FFELEX_typeCOLONCOLON:
18964 ffesta_confirmed ();
18965 if (*p != '\0')
18966 goto bad_i; /* :::::::::::::::::::: */
18967 if (!ffesta_is_inhibited ())
18968 {
18969 switch (ffesta_first_kw)
18970 {
18971 case FFESTR_firstALLOCATABLE:
18972 ffestc_R525_start ();
18973 break;
18974
18975 case FFESTR_firstPOINTER:
18976 ffestc_R526_start ();
18977 break;
18978
18979 case FFESTR_firstTARGET:
18980 ffestc_R527_start ();
18981 break;
18982
18983 default:
18984 assert (FALSE);
18985 }
18986 }
18987 ffestb_local_.dimlist.started = TRUE;
18988 return (ffelexHandler) ffestb_dimlist1_;
18989
18990 case FFELEX_typeOPEN_PAREN:
18991 if (!ffesrc_is_name_init (*p))
18992 goto bad_i; /* :::::::::::::::::::: */
18993 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
18994 ffestb_local_.dimlist.started = FALSE;
18995 next = (ffelexHandler) ffestb_dimlist1_ (nt);
18996 ffelex_token_kill (nt);
18997 return (ffelexHandler) (*next) (t);
18998 }
18999
19000 default:
19001 goto bad_0; /* :::::::::::::::::::: */
19002 }
19003
19004 bad_0: /* :::::::::::::::::::: */
19005 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, ffesta_tokens[0]);
19006 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19007
19008 bad_1: /* :::::::::::::::::::: */
19009 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
19010 return (ffelexHandler) ffelex_swallow_tokens (t,
19011 (ffelexHandler) ffesta_zero); /* Invalid second token. */
19012
19013 bad_i: /* :::::::::::::::::::: */
19014 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, ffesta_tokens[0], i, t);
19015 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19016 }
19017
19018 /* ffestb_dimlist1_ -- "ALLOCATABLE/POINTER/TARGET" [COLONCOLON]
19019
19020 return ffestb_dimlist1_; // to lexer
19021
19022 Handle NAME. */
19023
19024 static ffelexHandler
ffestb_dimlist1_(ffelexToken t)19025 ffestb_dimlist1_ (ffelexToken t)
19026 {
19027 switch (ffelex_token_type (t))
19028 {
19029 case FFELEX_typeNAME:
19030 ffesta_tokens[1] = ffelex_token_use (t);
19031 return (ffelexHandler) ffestb_dimlist2_;
19032
19033 default:
19034 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
19035 break;
19036 }
19037
19038 if (!ffesta_is_inhibited ())
19039 {
19040 switch (ffesta_first_kw)
19041 {
19042 case FFESTR_firstALLOCATABLE:
19043 ffestc_R525_finish ();
19044 break;
19045
19046 case FFESTR_firstPOINTER:
19047 ffestc_R526_finish ();
19048 break;
19049
19050 case FFESTR_firstTARGET:
19051 ffestc_R527_finish ();
19052 break;
19053
19054 default:
19055 assert (FALSE);
19056 }
19057 }
19058 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19059 }
19060
19061 /* ffestb_dimlist2_ -- "ALLOCATABLE/POINTER/TARGET" ... NAME
19062
19063 return ffestb_dimlist2_; // to lexer
19064
19065 Handle OPEN_PAREN. */
19066
19067 static ffelexHandler
ffestb_dimlist2_(ffelexToken t)19068 ffestb_dimlist2_ (ffelexToken t)
19069 {
19070 switch (ffelex_token_type (t))
19071 {
19072 case FFELEX_typeOPEN_PAREN:
19073 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
19074 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_dimlist3_;
19075 ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
19076 ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLIST;
19077 #ifdef FFECOM_dimensionsMAX
19078 ffestb_subrargs_.dim_list.ndims = 0;
19079 #endif
19080 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
19081 FFEEXPR_contextDIMLIST, (ffeexprCallback) ffestb_subr_dimlist_);
19082
19083 case FFELEX_typeCOMMA:
19084 ffesta_confirmed ();
19085 if (!ffesta_is_inhibited ())
19086 {
19087 if (!ffestb_local_.dimlist.started)
19088 {
19089 switch (ffesta_first_kw)
19090 {
19091 case FFESTR_firstALLOCATABLE:
19092 ffestc_R525_start ();
19093 break;
19094
19095 case FFESTR_firstPOINTER:
19096 ffestc_R526_start ();
19097 break;
19098
19099 case FFESTR_firstTARGET:
19100 ffestc_R527_start ();
19101 break;
19102
19103 default:
19104 assert (FALSE);
19105 }
19106 ffestb_local_.dimlist.started = TRUE;
19107 }
19108 switch (ffesta_first_kw)
19109 {
19110 case FFESTR_firstALLOCATABLE:
19111 ffestc_R525_item (ffesta_tokens[1], NULL);
19112 break;
19113
19114 case FFESTR_firstPOINTER:
19115 ffestc_R526_item (ffesta_tokens[1], NULL);
19116 break;
19117
19118 case FFESTR_firstTARGET:
19119 ffestc_R527_item (ffesta_tokens[1], NULL);
19120 break;
19121
19122 default:
19123 assert (FALSE);
19124 }
19125 }
19126 ffelex_token_kill (ffesta_tokens[1]);
19127 return (ffelexHandler) ffestb_dimlist4_;
19128
19129 case FFELEX_typeEOS:
19130 case FFELEX_typeSEMICOLON:
19131 ffesta_confirmed ();
19132 if (!ffesta_is_inhibited ())
19133 {
19134 if (!ffestb_local_.dimlist.started)
19135 {
19136 switch (ffesta_first_kw)
19137 {
19138 case FFESTR_firstALLOCATABLE:
19139 ffestc_R525_start ();
19140 break;
19141
19142 case FFESTR_firstPOINTER:
19143 ffestc_R526_start ();
19144 break;
19145
19146 case FFESTR_firstTARGET:
19147 ffestc_R527_start ();
19148 break;
19149
19150 default:
19151 assert (FALSE);
19152 }
19153 }
19154 switch (ffesta_first_kw)
19155 {
19156 case FFESTR_firstALLOCATABLE:
19157 ffestc_R525_item (ffesta_tokens[1], NULL);
19158 ffestc_R525_finish ();
19159 break;
19160
19161 case FFESTR_firstPOINTER:
19162 ffestc_R526_item (ffesta_tokens[1], NULL);
19163 ffestc_R526_finish ();
19164 break;
19165
19166 case FFESTR_firstTARGET:
19167 ffestc_R527_item (ffesta_tokens[1], NULL);
19168 ffestc_R527_finish ();
19169 break;
19170
19171 default:
19172 assert (FALSE);
19173 }
19174 }
19175 ffelex_token_kill (ffesta_tokens[1]);
19176 return (ffelexHandler) ffesta_zero (t);
19177
19178 default:
19179 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
19180 break;
19181 }
19182
19183 if (!ffesta_is_inhibited ())
19184 {
19185 switch (ffesta_first_kw)
19186 {
19187 case FFESTR_firstALLOCATABLE:
19188 ffestc_R525_finish ();
19189 break;
19190
19191 case FFESTR_firstPOINTER:
19192 ffestc_R526_finish ();
19193 break;
19194
19195 case FFESTR_firstTARGET:
19196 ffestc_R527_finish ();
19197 break;
19198
19199 default:
19200 assert (FALSE);
19201 }
19202 }
19203 ffelex_token_kill (ffesta_tokens[1]);
19204 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19205 }
19206
19207 /* ffestb_dimlist3_ -- "ALLOCATABLE/POINTER/TARGET" ... NAME OPEN_PAREN
19208 dimlist CLOSE_PAREN
19209
19210 return ffestb_dimlist3_; // to lexer
19211
19212 Handle COMMA or EOS/SEMICOLON. */
19213
19214 static ffelexHandler
ffestb_dimlist3_(ffelexToken t)19215 ffestb_dimlist3_ (ffelexToken t)
19216 {
19217 if (!ffestb_subrargs_.dim_list.ok)
19218 goto bad; /* :::::::::::::::::::: */
19219
19220 switch (ffelex_token_type (t))
19221 {
19222 case FFELEX_typeCOMMA:
19223 ffesta_confirmed ();
19224 if (!ffesta_is_inhibited ())
19225 {
19226 if (!ffestb_local_.dimlist.started)
19227 {
19228 switch (ffesta_first_kw)
19229 {
19230 case FFESTR_firstALLOCATABLE:
19231 ffestc_R525_start ();
19232 break;
19233
19234 case FFESTR_firstPOINTER:
19235 ffestc_R526_start ();
19236 break;
19237
19238 case FFESTR_firstTARGET:
19239 ffestc_R527_start ();
19240 break;
19241
19242 default:
19243 assert (FALSE);
19244 }
19245 ffestb_local_.dimlist.started = TRUE;
19246 }
19247 switch (ffesta_first_kw)
19248 {
19249 case FFESTR_firstALLOCATABLE:
19250 ffestc_R525_item (ffesta_tokens[1],
19251 ffestb_subrargs_.dim_list.dims);
19252 break;
19253
19254 case FFESTR_firstPOINTER:
19255 ffestc_R526_item (ffesta_tokens[1],
19256 ffestb_subrargs_.dim_list.dims);
19257 break;
19258
19259 case FFESTR_firstTARGET:
19260 ffestc_R527_item (ffesta_tokens[1],
19261 ffestb_subrargs_.dim_list.dims);
19262 break;
19263
19264 default:
19265 assert (FALSE);
19266 }
19267 }
19268 ffelex_token_kill (ffesta_tokens[1]);
19269 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
19270 return (ffelexHandler) ffestb_dimlist4_;
19271
19272 case FFELEX_typeEOS:
19273 case FFELEX_typeSEMICOLON:
19274 ffesta_confirmed ();
19275 if (!ffesta_is_inhibited ())
19276 {
19277 if (!ffestb_local_.dimlist.started)
19278 {
19279 switch (ffesta_first_kw)
19280 {
19281 case FFESTR_firstALLOCATABLE:
19282 ffestc_R525_start ();
19283 break;
19284
19285 case FFESTR_firstPOINTER:
19286 ffestc_R526_start ();
19287 break;
19288
19289 case FFESTR_firstTARGET:
19290 ffestc_R527_start ();
19291 break;
19292
19293 default:
19294 assert (FALSE);
19295 }
19296 }
19297 switch (ffesta_first_kw)
19298 {
19299 case FFESTR_firstALLOCATABLE:
19300 ffestc_R525_item (ffesta_tokens[1],
19301 ffestb_subrargs_.dim_list.dims);
19302 ffestc_R525_finish ();
19303 break;
19304
19305 case FFESTR_firstPOINTER:
19306 ffestc_R526_item (ffesta_tokens[1],
19307 ffestb_subrargs_.dim_list.dims);
19308 ffestc_R526_finish ();
19309 break;
19310
19311 case FFESTR_firstTARGET:
19312 ffestc_R527_item (ffesta_tokens[1],
19313 ffestb_subrargs_.dim_list.dims);
19314 ffestc_R527_finish ();
19315 break;
19316
19317 default:
19318 assert (FALSE);
19319 }
19320 }
19321 ffelex_token_kill (ffesta_tokens[1]);
19322 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
19323 return (ffelexHandler) ffesta_zero (t);
19324
19325 default:
19326 break;
19327 }
19328
19329 bad: /* :::::::::::::::::::: */
19330 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
19331 if (ffestb_local_.dimlist.started && !ffesta_is_inhibited ())
19332 {
19333 switch (ffesta_first_kw)
19334 {
19335 case FFESTR_firstALLOCATABLE:
19336 ffestc_R525_finish ();
19337 break;
19338
19339 case FFESTR_firstPOINTER:
19340 ffestc_R526_finish ();
19341 break;
19342
19343 case FFESTR_firstTARGET:
19344 ffestc_R527_finish ();
19345 break;
19346
19347 default:
19348 assert (FALSE);
19349 }
19350 }
19351 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
19352 ffelex_token_kill (ffesta_tokens[1]);
19353 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19354 }
19355
19356 /* ffestb_dimlist4_ -- "ALLOCATABLE/POINTER/TARGET" ... COMMA
19357
19358 return ffestb_dimlist4_; // to lexer
19359
19360 Make sure we don't have EOS or SEMICOLON. */
19361
19362 static ffelexHandler
ffestb_dimlist4_(ffelexToken t)19363 ffestb_dimlist4_ (ffelexToken t)
19364 {
19365 switch (ffelex_token_type (t))
19366 {
19367 case FFELEX_typeEOS:
19368 case FFELEX_typeSEMICOLON:
19369 if (!ffesta_is_inhibited ())
19370 {
19371 switch (ffesta_first_kw)
19372 {
19373 case FFESTR_firstALLOCATABLE:
19374 ffestc_R525_finish ();
19375 break;
19376
19377 case FFESTR_firstPOINTER:
19378 ffestc_R526_finish ();
19379 break;
19380
19381 case FFESTR_firstTARGET:
19382 ffestc_R527_finish ();
19383 break;
19384
19385 default:
19386 assert (FALSE);
19387 }
19388 }
19389 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
19390 return (ffelexHandler) ffesta_zero (t);
19391
19392 default:
19393 return (ffelexHandler) ffestb_dimlist1_ (t);
19394 }
19395 }
19396
19397 #endif
19398 /* ffestb_dummy -- Parse an ENTRY/FUNCTION/SUBROUTINE statement
19399
19400 return ffestb_dummy; // to lexer
19401
19402 Make sure the statement has a valid form for an ENTRY/FUNCTION/SUBROUTINE
19403 statement. If it does, implement the statement. */
19404
19405 ffelexHandler
ffestb_dummy(ffelexToken t)19406 ffestb_dummy (ffelexToken t)
19407 {
19408 ffeTokenLength i;
19409 unsigned const char *p;
19410
19411 switch (ffelex_token_type (ffesta_tokens[0]))
19412 {
19413 case FFELEX_typeNAME:
19414 switch (ffelex_token_type (t))
19415 {
19416 case FFELEX_typeEOS:
19417 case FFELEX_typeSEMICOLON:
19418 case FFELEX_typeCOMMA:
19419 case FFELEX_typeCOLONCOLON:
19420 ffesta_confirmed (); /* Error, but clearly intended. */
19421 goto bad_1; /* :::::::::::::::::::: */
19422
19423 default:
19424 goto bad_1; /* :::::::::::::::::::: */
19425
19426 case FFELEX_typeNAME:
19427 break;
19428 }
19429
19430 ffesta_confirmed ();
19431 ffesta_tokens[1] = ffelex_token_use (t);
19432 ffestb_local_.decl.recursive = NULL;
19433 ffestb_local_.dummy.badname = ffestb_args.dummy.badname;
19434 ffestb_local_.dummy.is_subr = ffestb_args.dummy.is_subr;
19435 ffestb_local_.dummy.first_kw = ffesta_first_kw;
19436 return (ffelexHandler) ffestb_dummy1_;
19437
19438 case FFELEX_typeNAMES:
19439 switch (ffelex_token_type (t))
19440 {
19441 case FFELEX_typeCOMMA:
19442 case FFELEX_typeCOLONCOLON:
19443 ffesta_confirmed (); /* Error, but clearly intended. */
19444 goto bad_1; /* :::::::::::::::::::: */
19445
19446 default:
19447 goto bad_1; /* :::::::::::::::::::: */
19448
19449 case FFELEX_typeEOS:
19450 case FFELEX_typeSEMICOLON:
19451 ffesta_confirmed ();
19452 break;
19453
19454 case FFELEX_typeOPEN_PAREN:
19455 break;
19456 }
19457 p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.dummy.len);
19458 if (!ffesrc_is_name_init (*p))
19459 goto bad_i; /* :::::::::::::::::::: */
19460 ffesta_tokens[1]
19461 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
19462 ffestb_local_.decl.recursive = NULL;
19463 ffestb_local_.dummy.badname = ffestb_args.dummy.badname;
19464 ffestb_local_.dummy.is_subr = ffestb_args.dummy.is_subr;
19465 ffestb_local_.dummy.first_kw = ffesta_first_kw;
19466 return (ffelexHandler) ffestb_dummy1_ (t);
19467
19468 default:
19469 goto bad_0; /* :::::::::::::::::::: */
19470 }
19471
19472 bad_0: /* :::::::::::::::::::: */
19473 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dummy.badname, ffesta_tokens[0]);
19474 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19475
19476 bad_1: /* :::::::::::::::::::: */
19477 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dummy.badname, t);
19478 return (ffelexHandler) ffelex_swallow_tokens (t,
19479 (ffelexHandler) ffesta_zero); /* Invalid second token. */
19480
19481 bad_i: /* :::::::::::::::::::: */
19482 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.dummy.badname, ffesta_tokens[0], i, t);
19483 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19484 }
19485
19486 /* ffestb_dummy1_ -- "ENTRY/FUNCTION/SUBROUTINE" NAME
19487
19488 return ffestb_dummy1_; // to lexer
19489
19490 Make sure the next token is an EOS, SEMICOLON, or OPEN_PAREN. In the
19491 former case, just implement a null arg list, else get the arg list and
19492 then implement. */
19493
19494 static ffelexHandler
ffestb_dummy1_(ffelexToken t)19495 ffestb_dummy1_ (ffelexToken t)
19496 {
19497 switch (ffelex_token_type (t))
19498 {
19499 case FFELEX_typeEOS:
19500 case FFELEX_typeSEMICOLON:
19501 if (ffestb_local_.dummy.first_kw == FFESTR_firstFUNCTION)
19502 {
19503 ffesta_confirmed (); /* Later, not if typename w/o RECURSIVE. */
19504 break; /* Produce an error message, need that open
19505 paren. */
19506 }
19507 ffesta_confirmed ();
19508 if (!ffesta_is_inhibited ())
19509 { /* Pretend as though we got a truly NULL
19510 list. */
19511 ffestb_subrargs_.name_list.args = NULL;
19512 ffestb_subrargs_.name_list.ok = TRUE;
19513 ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
19514 return (ffelexHandler) ffestb_dummy2_ (t);
19515 }
19516 if (ffestb_local_.decl.recursive != NULL)
19517 ffelex_token_kill (ffestb_local_.decl.recursive);
19518 ffelex_token_kill (ffesta_tokens[1]);
19519 return (ffelexHandler) ffesta_zero (t);
19520
19521 case FFELEX_typeOPEN_PAREN:
19522 ffestb_subrargs_.name_list.args = ffestt_tokenlist_create ();
19523 ffestb_subrargs_.name_list.handler = (ffelexHandler) ffestb_dummy2_;
19524 ffestb_subrargs_.name_list.is_subr = ffestb_local_.dummy.is_subr;
19525 ffestb_subrargs_.name_list.names = FALSE;
19526 return (ffelexHandler) ffestb_subr_name_list_;
19527
19528 default:
19529 break;
19530 }
19531
19532 if (ffestb_local_.decl.recursive != NULL)
19533 ffelex_token_kill (ffestb_local_.decl.recursive);
19534 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_local_.dummy.badname, t);
19535 ffelex_token_kill (ffesta_tokens[1]);
19536 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19537 }
19538
19539 /* ffestb_dummy2_ -- <dummy-keyword> NAME OPEN_PAREN arg-list CLOSE_PAREN
19540
19541 return ffestb_dummy2_; // to lexer
19542
19543 Make sure the statement has a valid form for a dummy-def statement. If it
19544 does, implement the statement. */
19545
19546 static ffelexHandler
ffestb_dummy2_(ffelexToken t)19547 ffestb_dummy2_ (ffelexToken t)
19548 {
19549 if (!ffestb_subrargs_.name_list.ok)
19550 goto bad; /* :::::::::::::::::::: */
19551
19552 switch (ffelex_token_type (t))
19553 {
19554 case FFELEX_typeEOS:
19555 case FFELEX_typeSEMICOLON:
19556 ffesta_confirmed ();
19557 if (!ffesta_is_inhibited ())
19558 {
19559 switch (ffestb_local_.dummy.first_kw)
19560 {
19561 case FFESTR_firstFUNCTION:
19562 ffestc_R1219 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
19563 ffestb_subrargs_.name_list.close_paren, FFESTP_typeNone,
19564 NULL, NULL, NULL, NULL, ffestb_local_.decl.recursive, NULL);
19565 break;
19566
19567 case FFESTR_firstSUBROUTINE:
19568 ffestc_R1223 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
19569 ffestb_subrargs_.name_list.close_paren,
19570 ffestb_local_.decl.recursive);
19571 break;
19572
19573 case FFESTR_firstENTRY:
19574 ffestc_R1226 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
19575 ffestb_subrargs_.name_list.close_paren);
19576 break;
19577
19578 default:
19579 assert (FALSE);
19580 }
19581 }
19582 ffelex_token_kill (ffesta_tokens[1]);
19583 if (ffestb_local_.decl.recursive != NULL)
19584 ffelex_token_kill (ffestb_local_.decl.recursive);
19585 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
19586 if (ffestb_subrargs_.name_list.args != NULL)
19587 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
19588 return (ffelexHandler) ffesta_zero (t);
19589
19590 case FFELEX_typeNAME:
19591 ffesta_confirmed ();
19592 if ((ffestb_local_.dummy.first_kw != FFESTR_firstFUNCTION)
19593 || (ffestr_other (t) != FFESTR_otherRESULT))
19594 break;
19595 ffestb_local_.decl.type = FFESTP_typeNone;
19596 ffestb_local_.decl.kind = NULL;
19597 ffestb_local_.decl.kindt = NULL;
19598 ffestb_local_.decl.len = NULL;
19599 ffestb_local_.decl.lent = NULL;
19600 return (ffelexHandler) ffestb_decl_funcname_6_;
19601
19602 default:
19603 break;
19604 }
19605
19606 bad: /* :::::::::::::::::::: */
19607 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_local_.dummy.badname, t);
19608 ffelex_token_kill (ffesta_tokens[1]);
19609 if (ffestb_local_.decl.recursive != NULL)
19610 ffelex_token_kill (ffestb_local_.decl.recursive);
19611 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
19612 if (ffestb_subrargs_.name_list.args != NULL)
19613 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
19614 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19615 }
19616
19617 /* ffestb_R524 -- Parse the DIMENSION statement
19618
19619 return ffestb_R524; // to lexer
19620
19621 Make sure the statement has a valid form for the DIMENSION statement. If
19622 it does, implement the statement. */
19623
19624 ffelexHandler
ffestb_R524(ffelexToken t)19625 ffestb_R524 (ffelexToken t)
19626 {
19627 ffeTokenLength i;
19628 unsigned const char *p;
19629 ffelexToken nt;
19630 ffelexHandler next;
19631
19632 switch (ffelex_token_type (ffesta_tokens[0]))
19633 {
19634 case FFELEX_typeNAME:
19635 switch (ffelex_token_type (t))
19636 {
19637 case FFELEX_typeCOMMA:
19638 case FFELEX_typeCOLONCOLON:
19639 case FFELEX_typeEOS:
19640 case FFELEX_typeSEMICOLON:
19641 ffesta_confirmed (); /* Error, but clearly intended. */
19642 goto bad_1; /* :::::::::::::::::::: */
19643
19644 default:
19645 goto bad_1; /* :::::::::::::::::::: */
19646
19647 case FFELEX_typeNAME:
19648 ffesta_confirmed ();
19649 if (!ffesta_is_inhibited ())
19650 ffestc_R524_start (ffesta_first_kw == FFESTR_firstVIRTUAL);
19651 ffestb_local_.dimension.started = TRUE;
19652 return (ffelexHandler) ffestb_R5241_ (t);
19653 }
19654
19655 case FFELEX_typeNAMES:
19656 p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.R524.len);
19657 switch (ffelex_token_type (t))
19658 {
19659 default:
19660 goto bad_1; /* :::::::::::::::::::: */
19661
19662 case FFELEX_typeEOS:
19663 case FFELEX_typeSEMICOLON:
19664 case FFELEX_typeCOMMA:
19665 case FFELEX_typeCOLONCOLON:
19666 ffesta_confirmed ();
19667 goto bad_1; /* :::::::::::::::::::: */
19668
19669 case FFELEX_typeOPEN_PAREN:
19670 break;
19671 }
19672
19673 /* Here, we have at least one char after "DIMENSION" and t is
19674 OPEN_PAREN. */
19675
19676 if (!ffesrc_is_name_init (*p))
19677 goto bad_i; /* :::::::::::::::::::: */
19678 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
19679 ffestb_local_.dimension.started = FALSE;
19680 next = (ffelexHandler) ffestb_R5241_ (nt);
19681 ffelex_token_kill (nt);
19682 return (ffelexHandler) (*next) (t);
19683
19684 default:
19685 goto bad_0; /* :::::::::::::::::::: */
19686 }
19687
19688 bad_0: /* :::::::::::::::::::: */
19689 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, ffesta_tokens[0]);
19690 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19691
19692 bad_1: /* :::::::::::::::::::: */
19693 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
19694 return (ffelexHandler) ffelex_swallow_tokens (t,
19695 (ffelexHandler) ffesta_zero); /* Invalid second token. */
19696
19697 bad_i: /* :::::::::::::::::::: */
19698 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, ffesta_tokens[0], i, t);
19699 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19700 }
19701
19702 /* ffestb_R5241_ -- "DIMENSION"
19703
19704 return ffestb_R5241_; // to lexer
19705
19706 Handle NAME. */
19707
19708 static ffelexHandler
ffestb_R5241_(ffelexToken t)19709 ffestb_R5241_ (ffelexToken t)
19710 {
19711 switch (ffelex_token_type (t))
19712 {
19713 case FFELEX_typeNAME:
19714 ffesta_tokens[1] = ffelex_token_use (t);
19715 return (ffelexHandler) ffestb_R5242_;
19716
19717 default:
19718 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
19719 break;
19720 }
19721
19722 if (!ffesta_is_inhibited ())
19723 ffestc_R524_finish ();
19724 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19725 }
19726
19727 /* ffestb_R5242_ -- "DIMENSION" ... NAME
19728
19729 return ffestb_R5242_; // to lexer
19730
19731 Handle OPEN_PAREN. */
19732
19733 static ffelexHandler
ffestb_R5242_(ffelexToken t)19734 ffestb_R5242_ (ffelexToken t)
19735 {
19736 switch (ffelex_token_type (t))
19737 {
19738 case FFELEX_typeOPEN_PAREN:
19739 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
19740 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_R5243_;
19741 ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
19742 ffestb_subrargs_.dim_list.ctx = ffesta_is_entry_valid
19743 ? FFEEXPR_contextDIMLIST : FFEEXPR_contextDIMLISTCOMMON;
19744 #ifdef FFECOM_dimensionsMAX
19745 ffestb_subrargs_.dim_list.ndims = 0;
19746 #endif
19747 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
19748 ffestb_subrargs_.dim_list.ctx,
19749 (ffeexprCallback) ffestb_subr_dimlist_);
19750
19751 default:
19752 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
19753 break;
19754 }
19755
19756 if (!ffesta_is_inhibited ())
19757 ffestc_R524_finish ();
19758 ffelex_token_kill (ffesta_tokens[1]);
19759 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19760 }
19761
19762 /* ffestb_R5243_ -- "DIMENSION" ... NAME OPEN_PAREN dimlist CLOSE_PAREN
19763
19764 return ffestb_R5243_; // to lexer
19765
19766 Handle COMMA or EOS/SEMICOLON. */
19767
19768 static ffelexHandler
ffestb_R5243_(ffelexToken t)19769 ffestb_R5243_ (ffelexToken t)
19770 {
19771 if (!ffestb_subrargs_.dim_list.ok)
19772 goto bad; /* :::::::::::::::::::: */
19773
19774 switch (ffelex_token_type (t))
19775 {
19776 case FFELEX_typeCOMMA:
19777 ffesta_confirmed ();
19778 if (!ffesta_is_inhibited ())
19779 {
19780 if (!ffestb_local_.dimension.started)
19781 {
19782 ffestc_R524_start (ffesta_first_kw == FFESTR_firstVIRTUAL);
19783 ffestb_local_.dimension.started = TRUE;
19784 }
19785 ffestc_R524_item (ffesta_tokens[1],
19786 ffestb_subrargs_.dim_list.dims);
19787 }
19788 ffelex_token_kill (ffesta_tokens[1]);
19789 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
19790 return (ffelexHandler) ffestb_R5244_;
19791
19792 case FFELEX_typeEOS:
19793 case FFELEX_typeSEMICOLON:
19794 ffesta_confirmed ();
19795 if (!ffesta_is_inhibited ())
19796 {
19797 if (!ffestb_local_.dimension.started)
19798 {
19799 ffestc_R524_start (ffesta_first_kw == FFESTR_firstVIRTUAL);
19800 ffestb_local_.dimension.started = TRUE;
19801 }
19802 ffestc_R524_item (ffesta_tokens[1],
19803 ffestb_subrargs_.dim_list.dims);
19804 ffestc_R524_finish ();
19805 }
19806 ffelex_token_kill (ffesta_tokens[1]);
19807 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
19808 return (ffelexHandler) ffesta_zero (t);
19809
19810 default:
19811 break;
19812 }
19813
19814 bad: /* :::::::::::::::::::: */
19815 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
19816 if (ffestb_local_.dimension.started && !ffesta_is_inhibited ())
19817 ffestc_R524_finish ();
19818 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
19819 ffelex_token_kill (ffesta_tokens[1]);
19820 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19821 }
19822
19823 /* ffestb_R5244_ -- "DIMENSION" ... COMMA
19824
19825 return ffestb_R5244_; // to lexer
19826
19827 Make sure we don't have EOS or SEMICOLON. */
19828
19829 static ffelexHandler
ffestb_R5244_(ffelexToken t)19830 ffestb_R5244_ (ffelexToken t)
19831 {
19832 switch (ffelex_token_type (t))
19833 {
19834 case FFELEX_typeEOS:
19835 case FFELEX_typeSEMICOLON:
19836 if (!ffesta_is_inhibited ())
19837 ffestc_R524_finish ();
19838 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
19839 return (ffelexHandler) ffesta_zero (t);
19840
19841 default:
19842 return (ffelexHandler) ffestb_R5241_ (t);
19843 }
19844 }
19845
19846 /* ffestb_R547 -- Parse the COMMON statement
19847
19848 return ffestb_R547; // to lexer
19849
19850 Make sure the statement has a valid form for the COMMON statement. If it
19851 does, implement the statement. */
19852
19853 ffelexHandler
ffestb_R547(ffelexToken t)19854 ffestb_R547 (ffelexToken t)
19855 {
19856 ffeTokenLength i;
19857 unsigned const char *p;
19858 ffelexToken nt;
19859 ffelexHandler next;
19860
19861 switch (ffelex_token_type (ffesta_tokens[0]))
19862 {
19863 case FFELEX_typeNAME:
19864 if (ffesta_first_kw != FFESTR_firstCOMMON)
19865 goto bad_0; /* :::::::::::::::::::: */
19866 switch (ffelex_token_type (t))
19867 {
19868 case FFELEX_typeCOMMA:
19869 case FFELEX_typeCOLONCOLON:
19870 case FFELEX_typeEOS:
19871 case FFELEX_typeSEMICOLON:
19872 ffesta_confirmed (); /* Error, but clearly intended. */
19873 goto bad_1; /* :::::::::::::::::::: */
19874
19875 default:
19876 goto bad_1; /* :::::::::::::::::::: */
19877
19878 case FFELEX_typeNAME:
19879 case FFELEX_typeSLASH:
19880 case FFELEX_typeCONCAT:
19881 ffesta_confirmed ();
19882 if (!ffesta_is_inhibited ())
19883 ffestc_R547_start ();
19884 ffestb_local_.common.started = TRUE;
19885 return (ffelexHandler) ffestb_R5471_ (t);
19886 }
19887
19888 case FFELEX_typeNAMES:
19889 if (ffesta_first_kw != FFESTR_firstCOMMON)
19890 goto bad_0; /* :::::::::::::::::::: */
19891 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCOMMON);
19892 switch (ffelex_token_type (t))
19893 {
19894 default:
19895 goto bad_1; /* :::::::::::::::::::: */
19896
19897 case FFELEX_typeEOS:
19898 case FFELEX_typeSEMICOLON:
19899 case FFELEX_typeCOMMA:
19900 case FFELEX_typeCOLONCOLON:
19901 ffesta_confirmed ();
19902 break;
19903
19904 case FFELEX_typeSLASH:
19905 case FFELEX_typeCONCAT:
19906 ffesta_confirmed ();
19907 if (*p != '\0')
19908 break;
19909 if (!ffesta_is_inhibited ())
19910 ffestc_R547_start ();
19911 ffestb_local_.common.started = TRUE;
19912 return (ffelexHandler) ffestb_R5471_ (t);
19913
19914 case FFELEX_typeOPEN_PAREN:
19915 break;
19916 }
19917
19918 /* Here, we have at least one char after "COMMON" and t is COMMA,
19919 EOS/SEMICOLON, OPEN_PAREN, SLASH, or CONCAT. */
19920
19921 if (!ffesrc_is_name_init (*p))
19922 goto bad_i; /* :::::::::::::::::::: */
19923 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
19924 if (ffelex_token_type (t) == FFELEX_typeOPEN_PAREN)
19925 ffestb_local_.common.started = FALSE;
19926 else
19927 {
19928 if (!ffesta_is_inhibited ())
19929 ffestc_R547_start ();
19930 ffestb_local_.common.started = TRUE;
19931 }
19932 next = (ffelexHandler) ffestb_R5471_ (nt);
19933 ffelex_token_kill (nt);
19934 return (ffelexHandler) (*next) (t);
19935
19936 default:
19937 goto bad_0; /* :::::::::::::::::::: */
19938 }
19939
19940 bad_0: /* :::::::::::::::::::: */
19941 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", ffesta_tokens[0]);
19942 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19943
19944 bad_1: /* :::::::::::::::::::: */
19945 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
19946 return (ffelexHandler) ffelex_swallow_tokens (t,
19947 (ffelexHandler) ffesta_zero); /* Invalid second token. */
19948
19949 bad_i: /* :::::::::::::::::::: */
19950 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "COMMON", ffesta_tokens[0], i, t);
19951 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19952 }
19953
19954 /* ffestb_R5471_ -- "COMMON"
19955
19956 return ffestb_R5471_; // to lexer
19957
19958 Handle NAME, SLASH, or CONCAT. */
19959
19960 static ffelexHandler
ffestb_R5471_(ffelexToken t)19961 ffestb_R5471_ (ffelexToken t)
19962 {
19963 switch (ffelex_token_type (t))
19964 {
19965 case FFELEX_typeNAME:
19966 return (ffelexHandler) ffestb_R5474_ (t);
19967
19968 case FFELEX_typeSLASH:
19969 return (ffelexHandler) ffestb_R5472_;
19970
19971 case FFELEX_typeCONCAT:
19972 if (!ffesta_is_inhibited ())
19973 ffestc_R547_item_cblock (NULL);
19974 return (ffelexHandler) ffestb_R5474_;
19975
19976 default:
19977 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
19978 break;
19979 }
19980
19981 if (!ffesta_is_inhibited ())
19982 ffestc_R547_finish ();
19983 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
19984 }
19985
19986 /* ffestb_R5472_ -- "COMMON" SLASH
19987
19988 return ffestb_R5472_; // to lexer
19989
19990 Handle NAME. */
19991
19992 static ffelexHandler
ffestb_R5472_(ffelexToken t)19993 ffestb_R5472_ (ffelexToken t)
19994 {
19995 switch (ffelex_token_type (t))
19996 {
19997 case FFELEX_typeNAME:
19998 ffesta_tokens[1] = ffelex_token_use (t);
19999 return (ffelexHandler) ffestb_R5473_;
20000
20001 case FFELEX_typeSLASH:
20002 if (!ffesta_is_inhibited ())
20003 ffestc_R547_item_cblock (NULL);
20004 return (ffelexHandler) ffestb_R5474_;
20005
20006 default:
20007 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
20008 break;
20009 }
20010
20011 if (!ffesta_is_inhibited ())
20012 ffestc_R547_finish ();
20013 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20014 }
20015
20016 /* ffestb_R5473_ -- "COMMON" SLASH NAME
20017
20018 return ffestb_R5473_; // to lexer
20019
20020 Handle SLASH. */
20021
20022 static ffelexHandler
ffestb_R5473_(ffelexToken t)20023 ffestb_R5473_ (ffelexToken t)
20024 {
20025 switch (ffelex_token_type (t))
20026 {
20027 case FFELEX_typeSLASH:
20028 if (!ffesta_is_inhibited ())
20029 ffestc_R547_item_cblock (ffesta_tokens[1]);
20030 ffelex_token_kill (ffesta_tokens[1]);
20031 return (ffelexHandler) ffestb_R5474_;
20032
20033 default:
20034 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
20035 break;
20036 }
20037
20038 if (!ffesta_is_inhibited ())
20039 ffestc_R547_finish ();
20040 ffelex_token_kill (ffesta_tokens[1]);
20041 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20042 }
20043
20044 /* ffestb_R5474_ -- "COMMON" [SLASH NAME SLASH] or "COMMON" CONCAT
20045
20046 return ffestb_R5474_; // to lexer
20047
20048 Handle NAME. */
20049
20050 static ffelexHandler
ffestb_R5474_(ffelexToken t)20051 ffestb_R5474_ (ffelexToken t)
20052 {
20053 switch (ffelex_token_type (t))
20054 {
20055 case FFELEX_typeNAME:
20056 ffesta_tokens[1] = ffelex_token_use (t);
20057 return (ffelexHandler) ffestb_R5475_;
20058
20059 default:
20060 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
20061 break;
20062 }
20063
20064 if (!ffesta_is_inhibited ())
20065 ffestc_R547_finish ();
20066 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20067 }
20068
20069 /* ffestb_R5475_ -- "COMMON" ... NAME
20070
20071 return ffestb_R5475_; // to lexer
20072
20073 Handle OPEN_PAREN. */
20074
20075 static ffelexHandler
ffestb_R5475_(ffelexToken t)20076 ffestb_R5475_ (ffelexToken t)
20077 {
20078 switch (ffelex_token_type (t))
20079 {
20080 case FFELEX_typeOPEN_PAREN:
20081 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
20082 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_R5476_;
20083 ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
20084 ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLISTCOMMON;
20085 #ifdef FFECOM_dimensionsMAX
20086 ffestb_subrargs_.dim_list.ndims = 0;
20087 #endif
20088 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
20089 FFEEXPR_contextDIMLISTCOMMON, (ffeexprCallback) ffestb_subr_dimlist_);
20090
20091 case FFELEX_typeCOMMA:
20092 if (!ffesta_is_inhibited ())
20093 ffestc_R547_item_object (ffesta_tokens[1], NULL);
20094 ffelex_token_kill (ffesta_tokens[1]);
20095 return (ffelexHandler) ffestb_R5477_;
20096
20097 case FFELEX_typeSLASH:
20098 case FFELEX_typeCONCAT:
20099 if (!ffesta_is_inhibited ())
20100 ffestc_R547_item_object (ffesta_tokens[1], NULL);
20101 ffelex_token_kill (ffesta_tokens[1]);
20102 return (ffelexHandler) ffestb_R5471_ (t);
20103
20104 case FFELEX_typeEOS:
20105 case FFELEX_typeSEMICOLON:
20106 if (!ffesta_is_inhibited ())
20107 {
20108 ffestc_R547_item_object (ffesta_tokens[1], NULL);
20109 ffestc_R547_finish ();
20110 }
20111 ffelex_token_kill (ffesta_tokens[1]);
20112 return (ffelexHandler) ffesta_zero (t);
20113
20114 default:
20115 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
20116 break;
20117 }
20118
20119 if (!ffesta_is_inhibited ())
20120 ffestc_R547_finish ();
20121 ffelex_token_kill (ffesta_tokens[1]);
20122 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20123 }
20124
20125 /* ffestb_R5476_ -- "COMMON" ... NAME OPEN_PAREN dimlist CLOSE_PAREN
20126
20127 return ffestb_R5476_; // to lexer
20128
20129 Handle COMMA, SLASH, CONCAT, EOS/SEMICOLON. */
20130
20131 static ffelexHandler
ffestb_R5476_(ffelexToken t)20132 ffestb_R5476_ (ffelexToken t)
20133 {
20134 if (!ffestb_subrargs_.dim_list.ok)
20135 goto bad; /* :::::::::::::::::::: */
20136
20137 switch (ffelex_token_type (t))
20138 {
20139 case FFELEX_typeCOMMA:
20140 ffesta_confirmed ();
20141 if (!ffesta_is_inhibited ())
20142 {
20143 if (!ffestb_local_.common.started)
20144 {
20145 ffestc_R547_start ();
20146 ffestb_local_.common.started = TRUE;
20147 }
20148 ffestc_R547_item_object (ffesta_tokens[1],
20149 ffestb_subrargs_.dim_list.dims);
20150 }
20151 ffelex_token_kill (ffesta_tokens[1]);
20152 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
20153 return (ffelexHandler) ffestb_R5477_;
20154
20155 case FFELEX_typeSLASH:
20156 case FFELEX_typeCONCAT:
20157 ffesta_confirmed ();
20158 if (!ffesta_is_inhibited ())
20159 {
20160 if (!ffestb_local_.common.started)
20161 {
20162 ffestc_R547_start ();
20163 ffestb_local_.common.started = TRUE;
20164 }
20165 ffestc_R547_item_object (ffesta_tokens[1],
20166 ffestb_subrargs_.dim_list.dims);
20167 }
20168 ffelex_token_kill (ffesta_tokens[1]);
20169 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
20170 return (ffelexHandler) ffestb_R5471_ (t);
20171
20172 case FFELEX_typeEOS:
20173 case FFELEX_typeSEMICOLON:
20174 ffesta_confirmed ();
20175 if (!ffesta_is_inhibited ())
20176 {
20177 if (!ffestb_local_.common.started)
20178 ffestc_R547_start ();
20179 ffestc_R547_item_object (ffesta_tokens[1],
20180 ffestb_subrargs_.dim_list.dims);
20181 ffestc_R547_finish ();
20182 }
20183 ffelex_token_kill (ffesta_tokens[1]);
20184 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
20185 return (ffelexHandler) ffesta_zero (t);
20186
20187 default:
20188 break;
20189 }
20190
20191 bad: /* :::::::::::::::::::: */
20192 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
20193 if (ffestb_local_.common.started && !ffesta_is_inhibited ())
20194 ffestc_R547_finish ();
20195 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
20196 ffelex_token_kill (ffesta_tokens[1]);
20197 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20198 }
20199
20200 /* ffestb_R5477_ -- "COMMON" ... COMMA
20201
20202 return ffestb_R5477_; // to lexer
20203
20204 Make sure we don't have EOS or SEMICOLON. */
20205
20206 static ffelexHandler
ffestb_R5477_(ffelexToken t)20207 ffestb_R5477_ (ffelexToken t)
20208 {
20209 switch (ffelex_token_type (t))
20210 {
20211 case FFELEX_typeEOS:
20212 case FFELEX_typeSEMICOLON:
20213 if (!ffesta_is_inhibited ())
20214 ffestc_R547_finish ();
20215 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
20216 return (ffelexHandler) ffesta_zero (t);
20217
20218 default:
20219 return (ffelexHandler) ffestb_R5471_ (t);
20220 }
20221 }
20222
20223 /* ffestb_R624 -- Parse a NULLIFY statement
20224
20225 return ffestb_R624; // to lexer
20226
20227 Make sure the statement has a valid form for a NULLIFY
20228 statement. If it does, implement the statement.
20229
20230 31-May-90 JCB 2.0
20231 Rewrite to produce a list of expressions rather than just names; this
20232 eases semantic checking, putting it in expression handling where that
20233 kind of thing gets done anyway, and makes it easier to support more
20234 flexible extensions to Fortran 90 like NULLIFY(FOO%BAR). */
20235
20236 #if FFESTR_F90
20237 ffelexHandler
ffestb_R624(ffelexToken t)20238 ffestb_R624 (ffelexToken t)
20239 {
20240 switch (ffelex_token_type (ffesta_tokens[0]))
20241 {
20242 case FFELEX_typeNAME:
20243 if (ffesta_first_kw != FFESTR_firstNULLIFY)
20244 goto bad_0; /* :::::::::::::::::::: */
20245 break;
20246
20247 case FFELEX_typeNAMES:
20248 if (ffesta_first_kw != FFESTR_firstNULLIFY)
20249 goto bad_0; /* :::::::::::::::::::: */
20250 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlNULLIFY)
20251 goto bad_0; /* :::::::::::::::::::: */
20252 break;
20253
20254 default:
20255 goto bad_0; /* :::::::::::::::::::: */
20256 }
20257
20258 switch (ffelex_token_type (t))
20259 {
20260 case FFELEX_typeOPEN_PAREN:
20261 break;
20262
20263 case FFELEX_typeEOS:
20264 case FFELEX_typeSEMICOLON:
20265 case FFELEX_typeCOMMA:
20266 case FFELEX_typeCOLONCOLON:
20267 case FFELEX_typeNAME:
20268 ffesta_confirmed (); /* Error, but clearly intended. */
20269 goto bad_1; /* :::::::::::::::::::: */
20270
20271 default:
20272 goto bad_1; /* :::::::::::::::::::: */
20273 }
20274
20275 ffestb_local_.R624.exprs = ffestt_exprlist_create ();
20276 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
20277 FFEEXPR_contextNULLIFY,
20278 (ffeexprCallback) ffestb_R6241_);
20279
20280 bad_0: /* :::::::::::::::::::: */
20281 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", ffesta_tokens[0]);
20282 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20283
20284 bad_1: /* :::::::::::::::::::: */
20285 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", t);
20286 return (ffelexHandler) ffelex_swallow_tokens (t,
20287 (ffelexHandler) ffesta_zero); /* Invalid second token. */
20288 }
20289
20290 /* ffestb_R6241_ -- "NULLIFY" OPEN_PAREN expr
20291
20292 return ffestb_R6241_; // to lexer
20293
20294 Make sure the statement has a valid form for a NULLIFY statement. If it
20295 does, implement the statement.
20296
20297 31-May-90 JCB 2.0
20298 Rewrite to produce a list of expressions rather than just names; this
20299 eases semantic checking, putting it in expression handling where that
20300 kind of thing gets done anyway, and makes it easier to support more
20301 flexible extensions to Fortran 90 like NULLIFY(FOO%BAR). */
20302
20303 static ffelexHandler
ffestb_R6241_(ffelexToken ft,ffebld expr,ffelexToken t)20304 ffestb_R6241_ (ffelexToken ft, ffebld expr, ffelexToken t)
20305 {
20306 switch (ffelex_token_type (t))
20307 {
20308 case FFELEX_typeCLOSE_PAREN:
20309 if (expr == NULL)
20310 break;
20311 ffestt_exprlist_append (ffestb_local_.R624.exprs, expr,
20312 ffelex_token_use (t));
20313 return (ffelexHandler) ffestb_R6242_;
20314
20315 case FFELEX_typeCOMMA:
20316 if (expr == NULL)
20317 break;
20318 ffestt_exprlist_append (ffestb_local_.R624.exprs, expr,
20319 ffelex_token_use (t));
20320 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
20321 FFEEXPR_contextNULLIFY,
20322 (ffeexprCallback) ffestb_R6241_);
20323
20324 default:
20325 break;
20326 }
20327
20328 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", t);
20329 ffestt_exprlist_kill (ffestb_local_.R624.exprs);
20330 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20331 }
20332
20333 /* ffestb_R6242_ -- "NULLIFY" OPEN_PAREN expr-list CLOSE_PAREN
20334
20335 return ffestb_R6242_; // to lexer
20336
20337 Make sure the statement has a valid form for a NULLIFY statement. If it
20338 does, implement the statement. */
20339
20340 static ffelexHandler
ffestb_R6242_(ffelexToken t)20341 ffestb_R6242_ (ffelexToken t)
20342 {
20343 switch (ffelex_token_type (t))
20344 {
20345 case FFELEX_typeEOS:
20346 case FFELEX_typeSEMICOLON:
20347 ffesta_confirmed ();
20348 if (!ffesta_is_inhibited ())
20349 ffestc_R624 (ffestb_local_.R624.exprs);
20350 ffestt_exprlist_kill (ffestb_local_.R624.exprs);
20351 return (ffelexHandler) ffesta_zero (t);
20352
20353 default:
20354 break;
20355 }
20356
20357 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", t);
20358 ffestt_exprlist_kill (ffestb_local_.R624.exprs);
20359 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20360 }
20361
20362 #endif
20363 /* ffestb_R1229 -- Parse a STMTFUNCTION statement
20364
20365 return ffestb_R1229; // to lexer
20366
20367 Make sure the statement has a valid form for a STMTFUNCTION
20368 statement. If it does, implement the statement. */
20369
20370 ffelexHandler
ffestb_R1229(ffelexToken t)20371 ffestb_R1229 (ffelexToken t)
20372 {
20373 switch (ffelex_token_type (ffesta_tokens[0]))
20374 {
20375 case FFELEX_typeNAME:
20376 case FFELEX_typeNAMES:
20377 break;
20378
20379 default:
20380 goto bad_0; /* :::::::::::::::::::: */
20381 }
20382
20383 switch (ffelex_token_type (t))
20384 {
20385 case FFELEX_typeOPEN_PAREN:
20386 break;
20387
20388 case FFELEX_typeEOS:
20389 case FFELEX_typeSEMICOLON:
20390 case FFELEX_typeCOMMA:
20391 case FFELEX_typeCOLONCOLON:
20392 case FFELEX_typeNAME:
20393 ffesta_confirmed (); /* Error, but clearly intended. */
20394 goto bad_1; /* :::::::::::::::::::: */
20395
20396 default:
20397 goto bad_1; /* :::::::::::::::::::: */
20398 }
20399
20400 ffestb_subrargs_.name_list.args = ffestt_tokenlist_create ();
20401 ffestb_subrargs_.name_list.handler = (ffelexHandler) ffestb_R12291_;
20402 ffestb_subrargs_.name_list.is_subr = FALSE; /* No "*" items in list! */
20403 ffestb_subrargs_.name_list.names = TRUE; /* In case "IF(FOO)CALL
20404 FOO...". */
20405 return (ffelexHandler) ffestb_subr_name_list_;
20406
20407 bad_0: /* :::::::::::::::::::: */
20408 bad_1: /* :::::::::::::::::::: */
20409 ffesta_ffebad_2t (FFEBAD_UNREC_STMT, ffesta_tokens[0], t);
20410 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20411 }
20412
20413 /* ffestb_R12291_ -- "STMTFUNCTION" OPEN_PAREN dummy-name-list CLOSE_PAREN
20414
20415 return ffestb_R12291_; // to lexer
20416
20417 Make sure the statement has a valid form for a STMTFUNCTION statement. If
20418 it does, implement the statement. */
20419
20420 static ffelexHandler
ffestb_R12291_(ffelexToken t)20421 ffestb_R12291_ (ffelexToken t)
20422 {
20423 ffelex_set_names (FALSE);
20424
20425 if (!ffestb_subrargs_.name_list.ok)
20426 goto bad; /* :::::::::::::::::::: */
20427
20428 switch (ffelex_token_type (t))
20429 {
20430 case FFELEX_typeEQUALS:
20431 ffesta_confirmed ();
20432 if (!ffesta_is_inhibited ())
20433 ffestc_R1229_start (ffesta_tokens[0],
20434 ffestb_subrargs_.name_list.args,
20435 ffestb_subrargs_.name_list.close_paren);
20436 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
20437 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
20438 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
20439 FFEEXPR_contextSFUNCDEF, (ffeexprCallback) ffestb_R12292_);
20440
20441 default:
20442 break;
20443 }
20444
20445 bad: /* :::::::::::::::::::: */
20446 ffesta_ffebad_2t (FFEBAD_UNREC_STMT, ffesta_tokens[0], t);
20447 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
20448 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
20449 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20450 }
20451
20452 /* ffestb_R12292_ -- "STMTFUNCTION" OPEN_PAREN dummy-name-list CLOSE_PAREN
20453 EQUALS expr
20454
20455 (ffestb_R12292_) // to expression handler
20456
20457 Make sure the statement has a valid form for a STMTFUNCTION statement. If
20458 it does, implement the statement. */
20459
20460 static ffelexHandler
ffestb_R12292_(ffelexToken ft,ffebld expr,ffelexToken t)20461 ffestb_R12292_ (ffelexToken ft, ffebld expr, ffelexToken t)
20462 {
20463 if (expr == NULL)
20464 goto bad; /* :::::::::::::::::::: */
20465
20466 switch (ffelex_token_type (t))
20467 {
20468 case FFELEX_typeEOS:
20469 case FFELEX_typeSEMICOLON:
20470 if (!ffesta_is_inhibited ())
20471 ffestc_R1229_finish (expr, ft);
20472 return (ffelexHandler) ffesta_zero (t);
20473
20474 default:
20475 break;
20476 }
20477
20478 bad: /* :::::::::::::::::::: */
20479 ffestc_R1229_finish (NULL, NULL);
20480 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "statement-function-definition", t);
20481 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20482 }
20483
20484 /* ffestb_decl_chartype -- Parse the CHARACTER statement
20485
20486 return ffestb_decl_chartype; // to lexer
20487
20488 Make sure the statement has a valid form for the CHARACTER statement. If
20489 it does, implement the statement. */
20490
20491 ffelexHandler
ffestb_decl_chartype(ffelexToken t)20492 ffestb_decl_chartype (ffelexToken t)
20493 {
20494 ffeTokenLength i;
20495 unsigned const char *p;
20496
20497 ffestb_local_.decl.type = FFESTP_typeCHARACTER;
20498 ffestb_local_.decl.recursive = NULL;
20499 ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
20500 ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
20501
20502 switch (ffelex_token_type (ffesta_tokens[0]))
20503 {
20504 case FFELEX_typeNAME:
20505 if (ffesta_first_kw != FFESTR_firstCHRCTR)
20506 goto bad_0; /* :::::::::::::::::::: */
20507 switch (ffelex_token_type (t))
20508 {
20509 case FFELEX_typeEOS:
20510 case FFELEX_typeSEMICOLON:
20511 ffesta_confirmed (); /* Error, but clearly intended. */
20512 goto bad_1; /* :::::::::::::::::::: */
20513
20514 default:
20515 goto bad_1; /* :::::::::::::::::::: */
20516
20517 case FFELEX_typeCOMMA:
20518 ffesta_confirmed ();
20519 if (!ffesta_is_inhibited ())
20520 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20521 NULL, NULL, NULL, NULL);
20522 return (ffelexHandler) ffestb_decl_attrs_;
20523
20524 case FFELEX_typeCOLONCOLON:
20525 ffestb_local_.decl.coloncolon = TRUE;
20526 ffesta_confirmed ();
20527 if (!ffesta_is_inhibited ())
20528 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20529 NULL, NULL, NULL, NULL);
20530 return (ffelexHandler) ffestb_decl_ents_;
20531
20532 case FFELEX_typeASTERISK:
20533 ffesta_confirmed ();
20534 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_chartype1_;
20535 ffestb_local_.decl.badname = "TYPEDECL";
20536 return (ffelexHandler) ffestb_decl_starlen_;
20537
20538 case FFELEX_typeOPEN_PAREN:
20539 ffestb_local_.decl.kind = NULL;
20540 ffestb_local_.decl.kindt = NULL;
20541 ffestb_local_.decl.len = NULL;
20542 ffestb_local_.decl.lent = NULL;
20543 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
20544 ffestb_local_.decl.badname = "_TYPEDECL";
20545 return (ffelexHandler) ffestb_decl_typeparams_;
20546
20547 case FFELEX_typeNAME:
20548 ffesta_confirmed ();
20549 ffestb_local_.decl.kind = NULL;
20550 ffestb_local_.decl.kindt = NULL;
20551 ffestb_local_.decl.len = NULL;
20552 ffestb_local_.decl.lent = NULL;
20553 return (ffelexHandler) ffestb_decl_entsp_ (t);
20554 }
20555
20556 case FFELEX_typeNAMES:
20557 if (ffesta_first_kw != FFESTR_firstCHRCTR)
20558 goto bad_0; /* :::::::::::::::::::: */
20559 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCHRCTR);
20560 switch (ffelex_token_type (t))
20561 {
20562 default:
20563 goto bad_1; /* :::::::::::::::::::: */
20564
20565 case FFELEX_typeEOS:
20566 case FFELEX_typeSEMICOLON:
20567 ffesta_confirmed ();
20568 break;
20569
20570 case FFELEX_typeCOMMA:
20571 ffesta_confirmed ();
20572 if (*p != '\0')
20573 break;
20574 if (!ffesta_is_inhibited ())
20575 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20576 NULL, NULL, NULL, NULL);
20577 return (ffelexHandler) ffestb_decl_attrs_;
20578
20579 case FFELEX_typeCOLONCOLON:
20580 ffestb_local_.decl.coloncolon = TRUE;
20581 ffesta_confirmed ();
20582 if (*p != '\0')
20583 goto bad_i; /* :::::::::::::::::::: */
20584 if (!ffesta_is_inhibited ())
20585 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20586 NULL, NULL, NULL, NULL);
20587 return (ffelexHandler) ffestb_decl_ents_;
20588
20589 case FFELEX_typeASTERISK:
20590 ffesta_confirmed ();
20591 if (*p != '\0')
20592 break;
20593 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_chartype1_;
20594 ffestb_local_.decl.badname = "TYPEDECL";
20595 return (ffelexHandler) ffestb_decl_starlen_;
20596
20597 case FFELEX_typeSLASH:
20598 ffesta_confirmed ();
20599 if (*p != '\0')
20600 break;
20601 goto bad_1; /* :::::::::::::::::::: */
20602
20603 case FFELEX_typeOPEN_PAREN:
20604 if (*p != '\0')
20605 break;
20606 ffestb_local_.decl.kind = NULL;
20607 ffestb_local_.decl.kindt = NULL;
20608 ffestb_local_.decl.len = NULL;
20609 ffestb_local_.decl.lent = NULL;
20610 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
20611 ffestb_local_.decl.badname = "TYPEDECL";
20612 return (ffelexHandler) ffestb_decl_typeparams_;
20613 }
20614 if (!ffesrc_is_name_init (*p))
20615 goto bad_i; /* :::::::::::::::::::: */
20616 ffestb_local_.decl.kind = NULL;
20617 ffestb_local_.decl.kindt = NULL;
20618 ffestb_local_.decl.len = NULL;
20619 ffestb_local_.decl.lent = NULL;
20620 ffesta_tokens[1] = ffelex_token_names_from_names (ffesta_tokens[0], i, 0);
20621 return (ffelexHandler) ffestb_decl_entsp_2_ (t);
20622
20623 default:
20624 goto bad_0; /* :::::::::::::::::::: */
20625 }
20626
20627 bad_0: /* :::::::::::::::::::: */
20628 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
20629 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20630
20631 bad_1: /* :::::::::::::::::::: */
20632 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
20633 return (ffelexHandler) ffelex_swallow_tokens (t,
20634 (ffelexHandler) ffesta_zero); /* Invalid second token. */
20635
20636 bad_i: /* :::::::::::::::::::: */
20637 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0], i, t);
20638 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20639 }
20640
20641 /* ffestb_decl_chartype1_ -- "CHARACTER" ASTERISK char-length
20642
20643 return ffestb_decl_chartype1_; // to lexer
20644
20645 Handle COMMA, COLONCOLON, or anything else. */
20646
20647 static ffelexHandler
ffestb_decl_chartype1_(ffelexToken t)20648 ffestb_decl_chartype1_ (ffelexToken t)
20649 {
20650 ffelex_set_names (FALSE);
20651
20652 switch (ffelex_token_type (t))
20653 {
20654 case FFELEX_typeCOLONCOLON:
20655 ffestb_local_.decl.coloncolon = TRUE;
20656 /* Fall through. */
20657 case FFELEX_typeCOMMA:
20658 ffesta_confirmed ();
20659 if (!ffesta_is_inhibited ())
20660 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20661 NULL, NULL, ffestb_local_.decl.len, ffestb_local_.decl.lent);
20662 if (ffestb_local_.decl.lent != NULL)
20663 ffelex_token_kill (ffestb_local_.decl.lent);
20664 return (ffelexHandler) ffestb_decl_ents_;
20665
20666 default:
20667 return (ffelexHandler) ffestb_decl_entsp_ (t);
20668 }
20669 }
20670
20671 /* ffestb_decl_dbltype -- Parse the DOUBLEPRECISION/DOUBLECOMPLEX statement
20672
20673 return ffestb_decl_dbltype; // to lexer
20674
20675 Make sure the statement has a valid form for the DOUBLEPRECISION/
20676 DOUBLECOMPLEX statement. If it does, implement the statement. */
20677
20678 ffelexHandler
ffestb_decl_dbltype(ffelexToken t)20679 ffestb_decl_dbltype (ffelexToken t)
20680 {
20681 ffeTokenLength i;
20682 unsigned const char *p;
20683
20684 ffestb_local_.decl.type = ffestb_args.decl.type;
20685 ffestb_local_.decl.recursive = NULL;
20686 ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
20687 ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
20688
20689 switch (ffelex_token_type (ffesta_tokens[0]))
20690 {
20691 case FFELEX_typeNAME:
20692 switch (ffelex_token_type (t))
20693 {
20694 case FFELEX_typeEOS:
20695 case FFELEX_typeSEMICOLON:
20696 ffesta_confirmed (); /* Error, but clearly intended. */
20697 goto bad_1; /* :::::::::::::::::::: */
20698
20699 default:
20700 goto bad_1; /* :::::::::::::::::::: */
20701
20702 case FFELEX_typeCOMMA:
20703 ffesta_confirmed ();
20704 if (!ffesta_is_inhibited ())
20705 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20706 NULL, NULL, NULL, NULL);
20707 return (ffelexHandler) ffestb_decl_attrs_;
20708
20709 case FFELEX_typeCOLONCOLON:
20710 ffestb_local_.decl.coloncolon = TRUE;
20711 ffesta_confirmed ();
20712 if (!ffesta_is_inhibited ())
20713 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20714 NULL, NULL, NULL, NULL);
20715 return (ffelexHandler) ffestb_decl_ents_;
20716
20717 case FFELEX_typeNAME:
20718 ffesta_confirmed ();
20719 ffestb_local_.decl.kind = NULL;
20720 ffestb_local_.decl.kindt = NULL;
20721 ffestb_local_.decl.len = NULL;
20722 ffestb_local_.decl.lent = NULL;
20723 return (ffelexHandler) ffestb_decl_entsp_ (t);
20724 }
20725
20726 case FFELEX_typeNAMES:
20727 p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.decl.len);
20728 switch (ffelex_token_type (t))
20729 {
20730 default:
20731 goto bad_1; /* :::::::::::::::::::: */
20732
20733 case FFELEX_typeEOS:
20734 case FFELEX_typeSEMICOLON:
20735 ffesta_confirmed ();
20736 break;
20737
20738 case FFELEX_typeCOMMA:
20739 ffesta_confirmed ();
20740 if (*p != '\0')
20741 break;
20742 if (!ffesta_is_inhibited ())
20743 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20744 NULL, NULL, NULL, NULL);
20745 return (ffelexHandler) ffestb_decl_attrs_;
20746
20747 case FFELEX_typeCOLONCOLON:
20748 ffestb_local_.decl.coloncolon = TRUE;
20749 ffesta_confirmed ();
20750 if (*p != '\0')
20751 goto bad_i; /* :::::::::::::::::::: */
20752 if (!ffesta_is_inhibited ())
20753 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20754 NULL, NULL, NULL, NULL);
20755 return (ffelexHandler) ffestb_decl_ents_;
20756
20757 case FFELEX_typeSLASH:
20758 ffesta_confirmed ();
20759 if (*p != '\0')
20760 break;
20761 goto bad_1; /* :::::::::::::::::::: */
20762
20763 case FFELEX_typeOPEN_PAREN:
20764 if (*p != '\0')
20765 break;
20766 goto bad_1; /* :::::::::::::::::::: */
20767 }
20768 if (!ffesrc_is_name_init (*p))
20769 goto bad_i; /* :::::::::::::::::::: */
20770 ffestb_local_.decl.kind = NULL;
20771 ffestb_local_.decl.kindt = NULL;
20772 ffestb_local_.decl.len = NULL;
20773 ffestb_local_.decl.lent = NULL;
20774 ffesta_tokens[1] = ffelex_token_names_from_names (ffesta_tokens[0], i, 0);
20775 return (ffelexHandler) ffestb_decl_entsp_2_ (t);
20776
20777 default:
20778 goto bad_0; /* :::::::::::::::::::: */
20779 }
20780
20781 bad_0: /* :::::::::::::::::::: */
20782 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
20783 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20784
20785 bad_1: /* :::::::::::::::::::: */
20786 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
20787 return (ffelexHandler) ffelex_swallow_tokens (t,
20788 (ffelexHandler) ffesta_zero); /* Invalid second token. */
20789
20790 bad_i: /* :::::::::::::::::::: */
20791 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0], i, t);
20792 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20793 }
20794
20795 /* ffestb_decl_double -- Parse the DOUBLE PRECISION/DOUBLE COMPLEX statement
20796
20797 return ffestb_decl_double; // to lexer
20798
20799 Make sure the statement has a valid form for the DOUBLE PRECISION/
20800 DOUBLE COMPLEX statement. If it does, implement the statement. */
20801
20802 ffelexHandler
ffestb_decl_double(ffelexToken t)20803 ffestb_decl_double (ffelexToken t)
20804 {
20805 ffestb_local_.decl.recursive = NULL;
20806 ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
20807 ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
20808
20809 switch (ffelex_token_type (ffesta_tokens[0]))
20810 {
20811 case FFELEX_typeNAME:
20812 if (ffesta_first_kw != FFESTR_firstDBL)
20813 goto bad_0; /* :::::::::::::::::::: */
20814 switch (ffelex_token_type (t))
20815 {
20816 case FFELEX_typeEOS:
20817 case FFELEX_typeSEMICOLON:
20818 case FFELEX_typeCOMMA:
20819 case FFELEX_typeCOLONCOLON:
20820 ffesta_confirmed (); /* Error, but clearly intended. */
20821 goto bad_1; /* :::::::::::::::::::: */
20822
20823 default:
20824 goto bad_1; /* :::::::::::::::::::: */
20825
20826 case FFELEX_typeNAME:
20827 ffesta_confirmed ();
20828 switch (ffestr_second (t))
20829 {
20830 case FFESTR_secondCOMPLEX:
20831 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
20832 break;
20833
20834 case FFESTR_secondPRECISION:
20835 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
20836 break;
20837
20838 default:
20839 goto bad_1; /* :::::::::::::::::::: */
20840 }
20841 ffestb_local_.decl.kind = NULL;
20842 ffestb_local_.decl.kindt = NULL;
20843 ffestb_local_.decl.len = NULL;
20844 ffestb_local_.decl.lent = NULL;
20845 return (ffelexHandler) ffestb_decl_attrsp_;
20846 }
20847
20848 default:
20849 goto bad_0; /* :::::::::::::::::::: */
20850 }
20851
20852 bad_0: /* :::::::::::::::::::: */
20853 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
20854 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20855
20856 bad_1: /* :::::::::::::::::::: */
20857 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
20858 return (ffelexHandler) ffelex_swallow_tokens (t,
20859 (ffelexHandler) ffesta_zero); /* Invalid second token. */
20860 }
20861
20862 /* ffestb_decl_gentype -- Parse the INTEGER/REAL/COMPLEX/LOGICAL statement
20863
20864 return ffestb_decl_gentype; // to lexer
20865
20866 Make sure the statement has a valid form for the INTEGER/REAL/COMPLEX/
20867 LOGICAL statement. If it does, implement the statement. */
20868
20869 ffelexHandler
ffestb_decl_gentype(ffelexToken t)20870 ffestb_decl_gentype (ffelexToken t)
20871 {
20872 ffeTokenLength i;
20873 unsigned const char *p;
20874
20875 ffestb_local_.decl.type = ffestb_args.decl.type;
20876 ffestb_local_.decl.recursive = NULL;
20877 ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
20878 ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
20879
20880 switch (ffelex_token_type (ffesta_tokens[0]))
20881 {
20882 case FFELEX_typeNAME:
20883 switch (ffelex_token_type (t))
20884 {
20885 case FFELEX_typeEOS:
20886 case FFELEX_typeSEMICOLON:
20887 ffesta_confirmed (); /* Error, but clearly intended. */
20888 goto bad_1; /* :::::::::::::::::::: */
20889
20890 default:
20891 goto bad_1; /* :::::::::::::::::::: */
20892
20893 case FFELEX_typeCOMMA:
20894 ffesta_confirmed ();
20895 if (!ffesta_is_inhibited ())
20896 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20897 NULL, NULL, NULL, NULL);
20898 return (ffelexHandler) ffestb_decl_attrs_;
20899
20900 case FFELEX_typeCOLONCOLON:
20901 ffestb_local_.decl.coloncolon = TRUE;
20902 ffesta_confirmed ();
20903 if (!ffesta_is_inhibited ())
20904 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20905 NULL, NULL, NULL, NULL);
20906 return (ffelexHandler) ffestb_decl_ents_;
20907
20908 case FFELEX_typeASTERISK:
20909 ffesta_confirmed ();
20910 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
20911 ffestb_local_.decl.badname = "TYPEDECL";
20912 return (ffelexHandler) ffestb_decl_starkind_;
20913
20914 case FFELEX_typeOPEN_PAREN:
20915 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
20916 ffestb_local_.decl.badname = "TYPEDECL";
20917 return (ffelexHandler) ffestb_decl_kindparam_;
20918
20919 case FFELEX_typeNAME:
20920 ffesta_confirmed ();
20921 ffestb_local_.decl.kind = NULL;
20922 ffestb_local_.decl.kindt = NULL;
20923 ffestb_local_.decl.len = NULL;
20924 ffestb_local_.decl.lent = NULL;
20925 return (ffelexHandler) ffestb_decl_entsp_ (t);
20926 }
20927
20928 case FFELEX_typeNAMES:
20929 p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.decl.len);
20930 switch (ffelex_token_type (t))
20931 {
20932 default:
20933 goto bad_1; /* :::::::::::::::::::: */
20934
20935 case FFELEX_typeEOS:
20936 case FFELEX_typeSEMICOLON:
20937 ffesta_confirmed ();
20938 break;
20939
20940 case FFELEX_typeCOMMA:
20941 ffesta_confirmed ();
20942 if (*p != '\0')
20943 break;
20944 if (!ffesta_is_inhibited ())
20945 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20946 NULL, NULL, NULL, NULL);
20947 return (ffelexHandler) ffestb_decl_attrs_;
20948
20949 case FFELEX_typeCOLONCOLON:
20950 ffestb_local_.decl.coloncolon = TRUE;
20951 ffesta_confirmed ();
20952 if (*p != '\0')
20953 goto bad_i; /* :::::::::::::::::::: */
20954 if (!ffesta_is_inhibited ())
20955 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
20956 NULL, NULL, NULL, NULL);
20957 return (ffelexHandler) ffestb_decl_ents_;
20958
20959 case FFELEX_typeSLASH:
20960 ffesta_confirmed ();
20961 if (*p != '\0')
20962 break;
20963 goto bad_1; /* :::::::::::::::::::: */
20964
20965 case FFELEX_typeASTERISK:
20966 ffesta_confirmed ();
20967 if (*p != '\0')
20968 break;
20969 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
20970 ffestb_local_.decl.badname = "TYPEDECL";
20971 return (ffelexHandler) ffestb_decl_starkind_;
20972
20973 case FFELEX_typeOPEN_PAREN:
20974 if (*p != '\0')
20975 break;
20976 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
20977 ffestb_local_.decl.badname = "TYPEDECL";
20978 return (ffelexHandler) ffestb_decl_kindparam_;
20979 }
20980 if (!ffesrc_is_name_init (*p))
20981 goto bad_i; /* :::::::::::::::::::: */
20982 ffestb_local_.decl.kind = NULL;
20983 ffestb_local_.decl.kindt = NULL;
20984 ffestb_local_.decl.len = NULL;
20985 ffestb_local_.decl.lent = NULL;
20986 ffesta_tokens[1] = ffelex_token_names_from_names (ffesta_tokens[0], i, 0);
20987 return (ffelexHandler) ffestb_decl_entsp_2_ (t);
20988
20989 default:
20990 goto bad_0; /* :::::::::::::::::::: */
20991 }
20992
20993 bad_0: /* :::::::::::::::::::: */
20994 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
20995 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
20996
20997 bad_1: /* :::::::::::::::::::: */
20998 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
20999 return (ffelexHandler) ffelex_swallow_tokens (t,
21000 (ffelexHandler) ffesta_zero); /* Invalid second token. */
21001
21002 bad_i: /* :::::::::::::::::::: */
21003 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0], i, t);
21004 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21005 }
21006
21007 /* ffestb_decl_recursive -- Parse the RECURSIVE FUNCTION statement
21008
21009 return ffestb_decl_recursive; // to lexer
21010
21011 Make sure the statement has a valid form for the RECURSIVE FUNCTION
21012 statement. If it does, implement the statement. */
21013
21014 #if FFESTR_F90
21015 ffelexHandler
ffestb_decl_recursive(ffelexToken t)21016 ffestb_decl_recursive (ffelexToken t)
21017 {
21018 ffeTokenLength i;
21019 const char *p;
21020 ffelexToken nt;
21021 ffelexToken ot;
21022 ffelexHandler next;
21023 bool needfunc;
21024
21025 switch (ffelex_token_type (ffesta_tokens[0]))
21026 {
21027 case FFELEX_typeNAME:
21028 if (ffesta_first_kw != FFESTR_firstRECURSIVE)
21029 goto bad_0; /* :::::::::::::::::::: */
21030 switch (ffelex_token_type (t))
21031 {
21032 case FFELEX_typeEOS:
21033 case FFELEX_typeSEMICOLON:
21034 case FFELEX_typeCOMMA:
21035 case FFELEX_typeCOLONCOLON:
21036 ffesta_confirmed (); /* Error, but clearly intended. */
21037 goto bad_1; /* :::::::::::::::::::: */
21038
21039 default:
21040 goto bad_1; /* :::::::::::::::::::: */
21041
21042 case FFELEX_typeNAME:
21043 break;
21044 }
21045 ffesta_confirmed ();
21046 ffestb_local_.decl.recursive = ffelex_token_use (ffesta_tokens[0]);
21047 switch (ffesta_second_kw)
21048 {
21049 case FFESTR_secondINTEGER:
21050 ffestb_local_.decl.type = FFESTP_typeINTEGER;
21051 return (ffelexHandler) ffestb_decl_recursive1_;
21052
21053 case FFESTR_secondBYTE:
21054 ffestb_local_.decl.type = FFESTP_typeBYTE;
21055 return (ffelexHandler) ffestb_decl_recursive1_;
21056
21057 case FFESTR_secondWORD:
21058 ffestb_local_.decl.type = FFESTP_typeWORD;
21059 return (ffelexHandler) ffestb_decl_recursive1_;
21060
21061 case FFESTR_secondREAL:
21062 ffestb_local_.decl.type = FFESTP_typeREAL;
21063 return (ffelexHandler) ffestb_decl_recursive1_;
21064
21065 case FFESTR_secondCOMPLEX:
21066 ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
21067 return (ffelexHandler) ffestb_decl_recursive1_;
21068
21069 case FFESTR_secondLOGICAL:
21070 ffestb_local_.decl.type = FFESTP_typeLOGICAL;
21071 return (ffelexHandler) ffestb_decl_recursive1_;
21072
21073 case FFESTR_secondCHARACTER:
21074 ffestb_local_.decl.type = FFESTP_typeCHARACTER;
21075 return (ffelexHandler) ffestb_decl_recursive1_;
21076
21077 case FFESTR_secondDOUBLE:
21078 return (ffelexHandler) ffestb_decl_recursive2_;
21079
21080 case FFESTR_secondDOUBLEPRECISION:
21081 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
21082 ffestb_local_.decl.kind = NULL;
21083 ffestb_local_.decl.kindt = NULL;
21084 ffestb_local_.decl.len = NULL;
21085 ffestb_local_.decl.lent = NULL;
21086 return (ffelexHandler) ffestb_decl_func_;
21087
21088 case FFESTR_secondDOUBLECOMPLEX:
21089 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
21090 ffestb_local_.decl.kind = NULL;
21091 ffestb_local_.decl.kindt = NULL;
21092 ffestb_local_.decl.len = NULL;
21093 ffestb_local_.decl.lent = NULL;
21094 return (ffelexHandler) ffestb_decl_func_;
21095
21096 case FFESTR_secondTYPE:
21097 ffestb_local_.decl.type = FFESTP_typeTYPE;
21098 return (ffelexHandler) ffestb_decl_recursive3_;
21099
21100 case FFESTR_secondFUNCTION:
21101 ffestb_local_.dummy.first_kw = FFESTR_firstFUNCTION;
21102 ffestb_local_.dummy.badname = "FUNCTION";
21103 ffestb_local_.dummy.is_subr = FALSE;
21104 return (ffelexHandler) ffestb_decl_recursive4_;
21105
21106 case FFESTR_secondSUBROUTINE:
21107 ffestb_local_.dummy.first_kw = FFESTR_firstSUBROUTINE;
21108 ffestb_local_.dummy.badname = "SUBROUTINE";
21109 ffestb_local_.dummy.is_subr = TRUE;
21110 return (ffelexHandler) ffestb_decl_recursive4_;
21111
21112 default:
21113 ffelex_token_kill (ffestb_local_.decl.recursive);
21114 goto bad_1; /* :::::::::::::::::::: */
21115 }
21116
21117 case FFELEX_typeNAMES:
21118 if (ffesta_first_kw != FFESTR_firstRECURSIVE)
21119 goto bad_0; /* :::::::::::::::::::: */
21120 switch (ffelex_token_type (t))
21121 {
21122 case FFELEX_typeCOMMA:
21123 case FFELEX_typeCOLONCOLON:
21124 case FFELEX_typeASTERISK:
21125 case FFELEX_typeSEMICOLON:
21126 case FFELEX_typeEOS:
21127 ffesta_confirmed ();
21128 break;
21129
21130 default:
21131 break;
21132 }
21133 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlRECURSIVE);
21134 if (!ffesrc_is_name_init (*p))
21135 goto bad_0; /* :::::::::::::::::::: */
21136 ffestb_local_.decl.recursive
21137 = ffelex_token_name_from_names (ffesta_tokens[0], 0,
21138 FFESTR_firstlRECURSIVE);
21139 nt = ffelex_token_names_from_names (ffesta_tokens[0],
21140 FFESTR_firstlRECURSIVE, 0);
21141 switch (ffestr_first (nt))
21142 {
21143 case FFESTR_firstINTGR:
21144 p = ffelex_token_text (nt) + (i = FFESTR_firstlINTGR);
21145 ffestb_local_.decl.type = FFESTP_typeINTEGER;
21146 needfunc = FALSE;
21147 goto typefunc; /* :::::::::::::::::::: */
21148
21149 case FFESTR_firstBYTE:
21150 p = ffelex_token_text (nt) + (i = FFESTR_firstlBYTE);
21151 ffestb_local_.decl.type = FFESTP_typeBYTE;
21152 needfunc = FALSE;
21153 goto typefunc; /* :::::::::::::::::::: */
21154
21155 case FFESTR_firstWORD:
21156 p = ffelex_token_text (nt) + (i = FFESTR_firstlWORD);
21157 ffestb_local_.decl.type = FFESTP_typeWORD;
21158 needfunc = FALSE;
21159 goto typefunc; /* :::::::::::::::::::: */
21160
21161 case FFESTR_firstREAL:
21162 p = ffelex_token_text (nt) + (i = FFESTR_firstlREAL);
21163 ffestb_local_.decl.type = FFESTP_typeREAL;
21164 needfunc = FALSE;
21165 goto typefunc; /* :::::::::::::::::::: */
21166
21167 case FFESTR_firstCMPLX:
21168 p = ffelex_token_text (nt) + (i = FFESTR_firstlCMPLX);
21169 ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
21170 needfunc = FALSE;
21171 goto typefunc; /* :::::::::::::::::::: */
21172
21173 case FFESTR_firstLGCL:
21174 p = ffelex_token_text (nt) + (i = FFESTR_firstlLGCL);
21175 ffestb_local_.decl.type = FFESTP_typeLOGICAL;
21176 needfunc = FALSE;
21177 goto typefunc; /* :::::::::::::::::::: */
21178
21179 case FFESTR_firstCHRCTR:
21180 p = ffelex_token_text (nt) + (i = FFESTR_firstlCHRCTR);
21181 ffestb_local_.decl.type = FFESTP_typeCHARACTER;
21182 needfunc = FALSE;
21183 goto typefunc; /* :::::::::::::::::::: */
21184
21185 case FFESTR_firstDBLPRCSN:
21186 p = ffelex_token_text (nt) + (i = FFESTR_firstlDBLPRCSN);
21187 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
21188 needfunc = TRUE;
21189 goto typefunc; /* :::::::::::::::::::: */
21190
21191 case FFESTR_firstDBLCMPLX:
21192 p = ffelex_token_text (nt) + (i = FFESTR_firstlDBLCMPLX);
21193 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
21194 needfunc = TRUE;
21195 goto typefunc; /* :::::::::::::::::::: */
21196
21197 case FFESTR_firstTYPE:
21198 p = ffelex_token_text (nt) + (i = FFESTR_firstlTYPE);
21199 ffestb_local_.decl.type = FFESTP_typeTYPE;
21200 next = (ffelexHandler) ffestb_decl_recursive3_;
21201 break;
21202
21203 case FFESTR_firstFUNCTION:
21204 p = ffelex_token_text (nt) + (i = FFESTR_firstlFUNCTION);
21205 ffestb_local_.dummy.first_kw = FFESTR_firstFUNCTION;
21206 ffestb_local_.dummy.badname = "FUNCTION";
21207 ffestb_local_.dummy.is_subr = FALSE;
21208 next = (ffelexHandler) ffestb_decl_recursive4_;
21209 break;
21210
21211 case FFESTR_firstSUBROUTINE:
21212 p = ffelex_token_text (nt) + (i = FFESTR_firstlSUBROUTINE);
21213 ffestb_local_.dummy.first_kw = FFESTR_firstSUBROUTINE;
21214 ffestb_local_.dummy.badname = "SUBROUTINE";
21215 ffestb_local_.dummy.is_subr = TRUE;
21216 next = (ffelexHandler) ffestb_decl_recursive4_;
21217 break;
21218
21219 default:
21220 ffelex_token_kill (ffestb_local_.decl.recursive);
21221 ffelex_token_kill (nt);
21222 goto bad_1; /* :::::::::::::::::::: */
21223 }
21224 if (*p == '\0')
21225 {
21226 ffelex_token_kill (nt);
21227 return (ffelexHandler) (*next) (t);
21228 }
21229 if (!ffesrc_is_name_init (*p))
21230 goto bad_i; /* :::::::::::::::::::: */
21231 ot = ffelex_token_name_from_names (nt, i, 0);
21232 ffelex_token_kill (nt);
21233 next = (ffelexHandler) (*next) (ot);
21234 ffelex_token_kill (ot);
21235 return (ffelexHandler) (*next) (t);
21236
21237 default:
21238 goto bad_0; /* :::::::::::::::::::: */
21239 }
21240
21241 typefunc: /* :::::::::::::::::::: */
21242 if (*p == '\0')
21243 {
21244 ffelex_token_kill (nt);
21245 if (needfunc) /* DOUBLE PRECISION or DOUBLE COMPLEX? */
21246 {
21247 ffelex_token_kill (ffestb_local_.decl.recursive);
21248 goto bad_1; /* :::::::::::::::::::: */
21249 }
21250 return (ffelexHandler) ffestb_decl_recursive1_ (t);
21251 }
21252 if (!ffesrc_is_name_init (*p))
21253 goto bad_i; /* :::::::::::::::::::: */
21254 ot = ffelex_token_names_from_names (nt, i, 0);
21255 ffelex_token_kill (nt);
21256 if (ffestr_first (ot) != FFESTR_firstFUNCTION)
21257 goto bad_o; /* :::::::::::::::::::: */
21258 p = ffelex_token_text (ot) + (i = FFESTR_firstlFUNCTION);
21259 if (!ffesrc_is_name_init (*p))
21260 goto bad_i; /* :::::::::::::::::::: */
21261 ffesta_tokens[1] = ffelex_token_name_from_names (ot, i, 0);
21262 ffelex_token_kill (ot);
21263 ffestb_local_.decl.kind = NULL;
21264 ffestb_local_.decl.kindt = NULL;
21265 ffestb_local_.decl.len = NULL;
21266 ffestb_local_.decl.lent = NULL;
21267 return (ffelexHandler) ffestb_decl_funcname_1_ (t);
21268
21269 bad_0: /* :::::::::::::::::::: */
21270 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", ffesta_tokens[0]);
21271 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21272
21273 bad_1: /* :::::::::::::::::::: */
21274 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
21275 return (ffelexHandler) ffelex_swallow_tokens (t,
21276 (ffelexHandler) ffesta_zero); /* Invalid second token. */
21277
21278 bad_i: /* :::::::::::::::::::: */
21279 ffelex_token_kill (ffestb_local_.decl.recursive);
21280 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", nt, i, t);
21281 ffelex_token_kill (nt);
21282 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21283
21284 bad_o: /* :::::::::::::::::::: */
21285 ffelex_token_kill (ffestb_local_.decl.recursive);
21286 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", ot);
21287 ffelex_token_kill (ot);
21288 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21289 }
21290
21291 /* ffestb_decl_recursive1_ -- "RECURSIVE" generic-type
21292
21293 return ffestb_decl_recursive1_; // to lexer
21294
21295 Handle ASTERISK, OPEN_PAREN, or NAME. */
21296
21297 static ffelexHandler
ffestb_decl_recursive1_(ffelexToken t)21298 ffestb_decl_recursive1_ (ffelexToken t)
21299 {
21300 switch (ffelex_token_type (t))
21301 {
21302 case FFELEX_typeASTERISK:
21303 ffesta_confirmed ();
21304 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_func_;
21305 ffestb_local_.decl.badname = "TYPEFUNC";
21306 if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
21307 return (ffelexHandler) ffestb_decl_starlen_;
21308 return (ffelexHandler) ffestb_decl_starkind_;
21309
21310 case FFELEX_typeOPEN_PAREN:
21311 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_func_;
21312 ffestb_local_.decl.badname = "TYPEFUNC";
21313 if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
21314 {
21315 ffestb_local_.decl.kind = NULL;
21316 ffestb_local_.decl.kindt = NULL;
21317 ffestb_local_.decl.len = NULL;
21318 ffestb_local_.decl.lent = NULL;
21319 return (ffelexHandler) ffestb_decl_typeparams_;
21320 }
21321 return (ffelexHandler) ffestb_decl_kindparam_;
21322
21323 case FFELEX_typeNAME:
21324 ffestb_local_.decl.kind = NULL;
21325 ffestb_local_.decl.kindt = NULL;
21326 ffestb_local_.decl.len = NULL;
21327 ffestb_local_.decl.lent = NULL;
21328 return (ffelexHandler) ffestb_decl_func_ (t);
21329
21330 default:
21331 break;
21332 }
21333
21334 if (ffestb_local_.decl.recursive != NULL)
21335 ffelex_token_kill (ffestb_local_.decl.recursive);
21336 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
21337 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21338 }
21339
21340 /* ffestb_decl_recursive2_ -- "RECURSIVE" "DOUBLE"
21341
21342 return ffestb_decl_recursive2_; // to lexer
21343
21344 Handle NAME. */
21345
21346 static ffelexHandler
ffestb_decl_recursive2_(ffelexToken t)21347 ffestb_decl_recursive2_ (ffelexToken t)
21348 {
21349 switch (ffelex_token_type (t))
21350 {
21351 case FFELEX_typeNAME:
21352 switch (ffestr_second (t))
21353 {
21354 case FFESTR_secondPRECISION:
21355 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
21356 break;
21357
21358 case FFESTR_secondCOMPLEX:
21359 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
21360 break;
21361
21362 default:
21363 goto bad; /* :::::::::::::::::::: */
21364 }
21365 ffestb_local_.decl.kind = NULL;
21366 ffestb_local_.decl.kindt = NULL;
21367 ffestb_local_.decl.len = NULL;
21368 ffestb_local_.decl.lent = NULL;
21369 return (ffelexHandler) ffestb_decl_func_;
21370
21371 default:
21372 break;
21373 }
21374
21375 bad: /* :::::::::::::::::::: */
21376 if (ffestb_local_.decl.recursive != NULL)
21377 ffelex_token_kill (ffestb_local_.decl.recursive);
21378 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
21379 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21380 }
21381
21382 /* ffestb_decl_recursive3_ -- "RECURSIVE" "TYPE"
21383
21384 return ffestb_decl_recursive3_; // to lexer
21385
21386 Handle OPEN_PAREN. */
21387
21388 static ffelexHandler
ffestb_decl_recursive3_(ffelexToken t)21389 ffestb_decl_recursive3_ (ffelexToken t)
21390 {
21391 switch (ffelex_token_type (t))
21392 {
21393 case FFELEX_typeOPEN_PAREN:
21394 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_func_;
21395 ffestb_local_.decl.badname = "TYPEFUNC";
21396 return (ffelexHandler) ffestb_decl_typetype1_;
21397
21398 default:
21399 break;
21400 }
21401
21402 if (ffestb_local_.decl.recursive != NULL)
21403 ffelex_token_kill (ffestb_local_.decl.recursive);
21404 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
21405 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21406 }
21407
21408 /* ffestb_decl_recursive4_ -- "RECURSIVE" "FUNCTION/SUBROUTINE"
21409
21410 return ffestb_decl_recursive4_; // to lexer
21411
21412 Handle OPEN_PAREN. */
21413
21414 static ffelexHandler
ffestb_decl_recursive4_(ffelexToken t)21415 ffestb_decl_recursive4_ (ffelexToken t)
21416 {
21417 switch (ffelex_token_type (t))
21418 {
21419 case FFELEX_typeNAME:
21420 ffesta_tokens[1] = ffelex_token_use (t);
21421 return (ffelexHandler) ffestb_dummy1_;
21422
21423 default:
21424 break;
21425 }
21426
21427 if (ffestb_local_.decl.recursive != NULL)
21428 ffelex_token_kill (ffestb_local_.decl.recursive);
21429 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
21430 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21431 }
21432
21433 #endif
21434 /* ffestb_decl_typetype -- Parse the R426/R501/R1219 TYPE statement
21435
21436 return ffestb_decl_typetype; // to lexer
21437
21438 Make sure the statement has a valid form for the TYPE statement. If it
21439 does, implement the statement. */
21440
21441 #if FFESTR_F90
21442 ffelexHandler
ffestb_decl_typetype(ffelexToken t)21443 ffestb_decl_typetype (ffelexToken t)
21444 {
21445 switch (ffelex_token_type (ffesta_tokens[0]))
21446 {
21447 case FFELEX_typeNAME:
21448 if (ffesta_first_kw != FFESTR_firstTYPE)
21449 goto bad_0; /* :::::::::::::::::::: */
21450 break;
21451
21452 case FFELEX_typeNAMES:
21453 if (ffesta_first_kw != FFESTR_firstTYPE)
21454 goto bad_0; /* :::::::::::::::::::: */
21455 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlTYPE)
21456 goto bad_0; /* :::::::::::::::::::: */
21457 break;
21458
21459 default:
21460 goto bad_0; /* :::::::::::::::::::: */
21461 }
21462
21463 switch (ffelex_token_type (t))
21464 {
21465 case FFELEX_typeOPEN_PAREN:
21466 break;
21467
21468 case FFELEX_typeEOS:
21469 case FFELEX_typeSEMICOLON:
21470 case FFELEX_typeCOLONCOLON:/* Not COMMA: R424 "TYPE,PUBLIC::A". */
21471 ffesta_confirmed (); /* Error, but clearly intended. */
21472 goto bad_1; /* :::::::::::::::::::: */
21473
21474 default:
21475 goto bad_1; /* :::::::::::::::::::: */
21476 }
21477
21478 ffestb_local_.decl.recursive = NULL;
21479 ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
21480 ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
21481
21482 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
21483 ffestb_local_.decl.badname = "type-declaration";
21484 return (ffelexHandler) ffestb_decl_typetype1_;
21485
21486 bad_0: /* :::::::::::::::::::: */
21487 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
21488 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21489
21490 bad_1: /* :::::::::::::::::::: */
21491 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
21492 return (ffelexHandler) ffelex_swallow_tokens (t,
21493 (ffelexHandler) ffesta_zero); /* Invalid second token. */
21494 }
21495
21496 #endif
21497 /* ffestb_decl_attrs_ -- "type" [type parameters] COMMA
21498
21499 return ffestb_decl_attrs_; // to lexer
21500
21501 Handle NAME of an attribute. */
21502
21503 static ffelexHandler
ffestb_decl_attrs_(ffelexToken t)21504 ffestb_decl_attrs_ (ffelexToken t)
21505 {
21506 switch (ffelex_token_type (t))
21507 {
21508 case FFELEX_typeNAME:
21509 switch (ffestr_first (t))
21510 {
21511 #if FFESTR_F90
21512 case FFESTR_firstALLOCATABLE:
21513 if (!ffesta_is_inhibited ())
21514 ffestc_decl_attrib (FFESTP_attribALLOCATABLE, t,
21515 FFESTR_otherNone, NULL);
21516 return (ffelexHandler) ffestb_decl_attrs_7_;
21517 #endif
21518
21519 case FFESTR_firstDIMENSION:
21520 ffesta_tokens[1] = ffelex_token_use (t);
21521 return (ffelexHandler) ffestb_decl_attrs_1_;
21522
21523 case FFESTR_firstEXTERNAL:
21524 if (!ffesta_is_inhibited ())
21525 ffestc_decl_attrib (FFESTP_attribEXTERNAL, t,
21526 FFESTR_otherNone, NULL);
21527 return (ffelexHandler) ffestb_decl_attrs_7_;
21528
21529 #if FFESTR_F90
21530 case FFESTR_firstINTENT:
21531 ffesta_tokens[1] = ffelex_token_use (t);
21532 return (ffelexHandler) ffestb_decl_attrs_3_;
21533 #endif
21534
21535 case FFESTR_firstINTRINSIC:
21536 if (!ffesta_is_inhibited ())
21537 ffestc_decl_attrib (FFESTP_attribINTRINSIC, t,
21538 FFESTR_otherNone, NULL);
21539 return (ffelexHandler) ffestb_decl_attrs_7_;
21540
21541 #if FFESTR_F90
21542 case FFESTR_firstOPTIONAL:
21543 if (!ffesta_is_inhibited ())
21544 ffestc_decl_attrib (FFESTP_attribOPTIONAL, t,
21545 FFESTR_otherNone, NULL);
21546 return (ffelexHandler) ffestb_decl_attrs_7_;
21547 #endif
21548
21549 case FFESTR_firstPARAMETER:
21550 ffestb_local_.decl.parameter = TRUE;
21551 if (!ffesta_is_inhibited ())
21552 ffestc_decl_attrib (FFESTP_attribPARAMETER, t,
21553 FFESTR_otherNone, NULL);
21554 return (ffelexHandler) ffestb_decl_attrs_7_;
21555
21556 #if FFESTR_F90
21557 case FFESTR_firstPOINTER:
21558 if (!ffesta_is_inhibited ())
21559 ffestc_decl_attrib (FFESTP_attribPOINTER, t,
21560 FFESTR_otherNone, NULL);
21561 return (ffelexHandler) ffestb_decl_attrs_7_;
21562 #endif
21563
21564 #if FFESTR_F90
21565 case FFESTR_firstPRIVATE:
21566 if (!ffesta_is_inhibited ())
21567 ffestc_decl_attrib (FFESTP_attribPRIVATE, t,
21568 FFESTR_otherNone, NULL);
21569 return (ffelexHandler) ffestb_decl_attrs_7_;
21570
21571 case FFESTR_firstPUBLIC:
21572 if (!ffesta_is_inhibited ())
21573 ffestc_decl_attrib (FFESTP_attribPUBLIC, t,
21574 FFESTR_otherNone, NULL);
21575 return (ffelexHandler) ffestb_decl_attrs_7_;
21576 #endif
21577
21578 case FFESTR_firstSAVE:
21579 if (!ffesta_is_inhibited ())
21580 ffestc_decl_attrib (FFESTP_attribSAVE, t,
21581 FFESTR_otherNone, NULL);
21582 return (ffelexHandler) ffestb_decl_attrs_7_;
21583
21584 #if FFESTR_F90
21585 case FFESTR_firstTARGET:
21586 if (!ffesta_is_inhibited ())
21587 ffestc_decl_attrib (FFESTP_attribTARGET, t,
21588 FFESTR_otherNone, NULL);
21589 return (ffelexHandler) ffestb_decl_attrs_7_;
21590 #endif
21591
21592 default:
21593 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
21594 return (ffelexHandler) ffestb_decl_attrs_7_;
21595 }
21596 break;
21597
21598 default:
21599 break;
21600 }
21601
21602 if (!ffesta_is_inhibited ())
21603 ffestc_decl_finish ();
21604 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
21605 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21606 }
21607
21608 /* ffestb_decl_attrs_1_ -- "type" [type parameters] ",DIMENSION"
21609
21610 return ffestb_decl_attrs_1_; // to lexer
21611
21612 Handle OPEN_PAREN. */
21613
21614 static ffelexHandler
ffestb_decl_attrs_1_(ffelexToken t)21615 ffestb_decl_attrs_1_ (ffelexToken t)
21616 {
21617 switch (ffelex_token_type (t))
21618 {
21619 case FFELEX_typeOPEN_PAREN:
21620 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
21621 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_decl_attrs_2_;
21622 ffestb_subrargs_.dim_list.pool = ffesta_scratch_pool;
21623 ffestb_subrargs_.dim_list.ctx = ffesta_is_entry_valid
21624 ? FFEEXPR_contextDIMLIST : FFEEXPR_contextDIMLISTCOMMON;
21625 #ifdef FFECOM_dimensionsMAX
21626 ffestb_subrargs_.dim_list.ndims = 0;
21627 #endif
21628 return (ffelexHandler) ffeexpr_rhs (ffesta_scratch_pool,
21629 ffestb_subrargs_.dim_list.ctx,
21630 (ffeexprCallback) ffestb_subr_dimlist_);
21631
21632 case FFELEX_typeCOMMA:
21633 case FFELEX_typeCOLONCOLON:
21634 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, ffesta_tokens[1]);
21635 ffelex_token_kill (ffesta_tokens[1]);
21636 return (ffelexHandler) ffestb_decl_attrs_7_ (t);
21637
21638 default:
21639 break;
21640 }
21641
21642 if (!ffesta_is_inhibited ())
21643 ffestc_decl_finish ();
21644 ffelex_token_kill (ffesta_tokens[1]);
21645 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
21646 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21647 }
21648
21649 /* ffestb_decl_attrs_2_ -- "type" [type parameters] ",DIMENSION" OPEN_PAREN
21650 dimlist CLOSE_PAREN
21651
21652 return ffestb_decl_attrs_2_; // to lexer
21653
21654 Handle COMMA or COLONCOLON. */
21655
21656 static ffelexHandler
ffestb_decl_attrs_2_(ffelexToken t)21657 ffestb_decl_attrs_2_ (ffelexToken t)
21658 {
21659 if (!ffestb_subrargs_.dim_list.ok)
21660 goto bad; /* :::::::::::::::::::: */
21661
21662 switch (ffelex_token_type (t))
21663 {
21664 case FFELEX_typeCOMMA:
21665 case FFELEX_typeCOLONCOLON:
21666 if (!ffesta_is_inhibited ())
21667 ffestc_decl_attrib (FFESTP_attribDIMENSION, ffesta_tokens[1],
21668 FFESTR_otherNone, ffestb_subrargs_.dim_list.dims);
21669 ffelex_token_kill (ffesta_tokens[1]);
21670 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
21671 return (ffelexHandler) ffestb_decl_attrs_7_ (t);
21672
21673 default:
21674 break;
21675 }
21676
21677 bad: /* :::::::::::::::::::: */
21678 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
21679 if (!ffesta_is_inhibited ())
21680 ffestc_decl_finish ();
21681 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
21682 ffelex_token_kill (ffesta_tokens[1]);
21683 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21684 }
21685
21686 /* ffestb_decl_attrs_3_ -- "type" [type parameters] ",INTENT"
21687
21688 return ffestb_decl_attrs_3_; // to lexer
21689
21690 Handle OPEN_PAREN. */
21691
21692 #if FFESTR_F90
21693 static ffelexHandler
ffestb_decl_attrs_3_(ffelexToken t)21694 ffestb_decl_attrs_3_ (ffelexToken t)
21695 {
21696 switch (ffelex_token_type (t))
21697 {
21698 case FFELEX_typeOPEN_PAREN:
21699 return (ffelexHandler) ffestb_decl_attrs_4_;
21700
21701 case FFELEX_typeCOMMA:
21702 case FFELEX_typeCOLONCOLON:
21703 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, ffesta_tokens[1]);
21704 ffelex_token_kill (ffesta_tokens[1]);
21705 return (ffelexHandler) ffestb_decl_attrs_7_ (t);
21706
21707 default:
21708 break;
21709 }
21710
21711 if (!ffesta_is_inhibited ())
21712 ffestc_decl_finish ();
21713 ffelex_token_kill (ffesta_tokens[1]);
21714 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
21715 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21716 }
21717
21718 /* ffestb_decl_attrs_4_ -- "type" [type parameters] ",INTENT" OPEN_PAREN
21719
21720 return ffestb_decl_attrs_4_; // to lexer
21721
21722 Handle NAME. */
21723
21724 static ffelexHandler
ffestb_decl_attrs_4_(ffelexToken t)21725 ffestb_decl_attrs_4_ (ffelexToken t)
21726 {
21727 switch (ffelex_token_type (t))
21728 {
21729 case FFELEX_typeNAME:
21730 ffestb_local_.decl.kw = ffestr_other (t);
21731 switch (ffestb_local_.decl.kw)
21732 {
21733 case FFESTR_otherIN:
21734 return (ffelexHandler) ffestb_decl_attrs_5_;
21735
21736 case FFESTR_otherINOUT:
21737 return (ffelexHandler) ffestb_decl_attrs_6_;
21738
21739 case FFESTR_otherOUT:
21740 return (ffelexHandler) ffestb_decl_attrs_6_;
21741
21742 default:
21743 ffestb_local_.decl.kw = FFESTR_otherNone;
21744 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
21745 return (ffelexHandler) ffestb_decl_attrs_5_;
21746 }
21747 break;
21748
21749 default:
21750 break;
21751 }
21752
21753 if (!ffesta_is_inhibited ())
21754 ffestc_decl_finish ();
21755 ffelex_token_kill (ffesta_tokens[1]);
21756 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
21757 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21758 }
21759
21760 /* ffestb_decl_attrs_5_ -- "type" [type parameters] ",INTENT" OPEN_PAREN "IN"
21761
21762 return ffestb_decl_attrs_5_; // to lexer
21763
21764 Handle NAME or CLOSE_PAREN. */
21765
21766 static ffelexHandler
ffestb_decl_attrs_5_(ffelexToken t)21767 ffestb_decl_attrs_5_ (ffelexToken t)
21768 {
21769 switch (ffelex_token_type (t))
21770 {
21771 case FFELEX_typeNAME:
21772 switch (ffestr_other (t))
21773 {
21774 case FFESTR_otherOUT:
21775 if (ffestb_local_.decl.kw != FFESTR_otherNone)
21776 ffestb_local_.decl.kw = FFESTR_otherINOUT;
21777 return (ffelexHandler) ffestb_decl_attrs_6_;
21778
21779 default:
21780 if (ffestb_local_.decl.kw != FFESTR_otherNone)
21781 {
21782 ffestb_local_.decl.kw = FFESTR_otherNone;
21783 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
21784 }
21785 return (ffelexHandler) ffestb_decl_attrs_5_;
21786 }
21787 break;
21788
21789 case FFELEX_typeCLOSE_PAREN:
21790 return (ffelexHandler) ffestb_decl_attrs_6_ (t);
21791
21792 default:
21793 break;
21794 }
21795
21796 if (!ffesta_is_inhibited ())
21797 ffestc_decl_finish ();
21798 ffelex_token_kill (ffesta_tokens[1]);
21799 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
21800 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21801 }
21802
21803 /* ffestb_decl_attrs_6_ -- "type" [type parameters] ",INTENT" OPEN_PAREN "IN"
21804 ["OUT"]
21805
21806 return ffestb_decl_attrs_6_; // to lexer
21807
21808 Handle CLOSE_PAREN. */
21809
21810 static ffelexHandler
ffestb_decl_attrs_6_(ffelexToken t)21811 ffestb_decl_attrs_6_ (ffelexToken t)
21812 {
21813 switch (ffelex_token_type (t))
21814 {
21815 case FFELEX_typeCLOSE_PAREN:
21816 if ((ffestb_local_.decl.kw != FFESTR_otherNone)
21817 && !ffesta_is_inhibited ())
21818 ffestc_decl_attrib (FFESTP_attribINTENT, ffesta_tokens[1],
21819 ffestb_local_.decl.kw, NULL);
21820 ffelex_token_kill (ffesta_tokens[1]);
21821 return (ffelexHandler) ffestb_decl_attrs_7_;
21822
21823 default:
21824 break;
21825 }
21826
21827 if (!ffesta_is_inhibited ())
21828 ffestc_decl_finish ();
21829 ffelex_token_kill (ffesta_tokens[1]);
21830 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
21831 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21832 }
21833
21834 #endif
21835 /* ffestb_decl_attrs_7_ -- "type" [type parameters] attribute
21836
21837 return ffestb_decl_attrs_7_; // to lexer
21838
21839 Handle COMMA (another attribute) or COLONCOLON (entities). */
21840
21841 static ffelexHandler
ffestb_decl_attrs_7_(ffelexToken t)21842 ffestb_decl_attrs_7_ (ffelexToken t)
21843 {
21844 switch (ffelex_token_type (t))
21845 {
21846 case FFELEX_typeCOMMA:
21847 return (ffelexHandler) ffestb_decl_attrs_;
21848
21849 case FFELEX_typeCOLONCOLON:
21850 ffestb_local_.decl.coloncolon = TRUE;
21851 return (ffelexHandler) ffestb_decl_ents_;
21852
21853 default:
21854 break;
21855 }
21856
21857 if (!ffesta_is_inhibited ())
21858 ffestc_decl_finish ();
21859 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
21860 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21861 }
21862
21863 /* ffestb_decl_attrsp_ -- "type" [type parameters]
21864
21865 return ffestb_decl_attrsp_; // to lexer
21866
21867 Handle COMMA (meaning we have attributes), COLONCOLON (meaning we have
21868 no attributes but entities), or go to entsp to see about functions or
21869 entities. */
21870
21871 static ffelexHandler
ffestb_decl_attrsp_(ffelexToken t)21872 ffestb_decl_attrsp_ (ffelexToken t)
21873 {
21874 ffelex_set_names (FALSE);
21875
21876 switch (ffelex_token_type (t))
21877 {
21878 case FFELEX_typeCOMMA:
21879 ffesta_confirmed ();
21880 if (!ffesta_is_inhibited ())
21881 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
21882 ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
21883 ffestb_local_.decl.len, ffestb_local_.decl.lent);
21884 if (ffestb_local_.decl.kindt != NULL)
21885 ffelex_token_kill (ffestb_local_.decl.kindt);
21886 if (ffestb_local_.decl.lent != NULL)
21887 ffelex_token_kill (ffestb_local_.decl.lent);
21888 return (ffelexHandler) ffestb_decl_attrs_;
21889
21890 case FFELEX_typeCOLONCOLON:
21891 ffestb_local_.decl.coloncolon = TRUE;
21892 ffesta_confirmed ();
21893 if (!ffesta_is_inhibited ())
21894 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
21895 ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
21896 ffestb_local_.decl.len, ffestb_local_.decl.lent);
21897 if (ffestb_local_.decl.kindt != NULL)
21898 ffelex_token_kill (ffestb_local_.decl.kindt);
21899 if (ffestb_local_.decl.lent != NULL)
21900 ffelex_token_kill (ffestb_local_.decl.lent);
21901 return (ffelexHandler) ffestb_decl_ents_;
21902
21903 default:
21904 return (ffelexHandler) ffestb_decl_entsp_ (t);
21905 }
21906 }
21907
21908 /* ffestb_decl_ents_ -- "type" [type parameters] [attributes "::"]
21909
21910 return ffestb_decl_ents_; // to lexer
21911
21912 Handle NAME of an entity. */
21913
21914 static ffelexHandler
ffestb_decl_ents_(ffelexToken t)21915 ffestb_decl_ents_ (ffelexToken t)
21916 {
21917 switch (ffelex_token_type (t))
21918 {
21919 case FFELEX_typeNAME:
21920 ffesta_tokens[1] = ffelex_token_use (t);
21921 return (ffelexHandler) ffestb_decl_ents_1_;
21922
21923 default:
21924 break;
21925 }
21926
21927 if (!ffesta_is_inhibited ())
21928 ffestc_decl_finish ();
21929 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
21930 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21931 }
21932
21933 /* ffestb_decl_ents_1_ -- "type" [type parameters] [attributes "::"] NAME
21934
21935 return ffestb_decl_ents_1_; // to lexer
21936
21937 Handle ASTERISK, OPEN_PAREN, EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */
21938
21939 static ffelexHandler
ffestb_decl_ents_1_(ffelexToken t)21940 ffestb_decl_ents_1_ (ffelexToken t)
21941 {
21942 switch (ffelex_token_type (t))
21943 {
21944 case FFELEX_typeCOMMA:
21945 if (!ffesta_is_inhibited ())
21946 ffestc_decl_item (ffesta_tokens[1], NULL, NULL, NULL, NULL, NULL, NULL,
21947 NULL, FALSE);
21948 ffelex_token_kill (ffesta_tokens[1]);
21949 return (ffelexHandler) ffestb_decl_ents_;
21950
21951 case FFELEX_typeEOS:
21952 case FFELEX_typeSEMICOLON:
21953 if (!ffesta_is_inhibited ())
21954 {
21955 ffestc_decl_item (ffesta_tokens[1], NULL, NULL, NULL, NULL, NULL, NULL,
21956 NULL, FALSE);
21957 ffestc_decl_finish ();
21958 }
21959 ffelex_token_kill (ffesta_tokens[1]);
21960 return (ffelexHandler) ffesta_zero (t);
21961
21962 case FFELEX_typeASTERISK:
21963 ffestb_local_.decl.len = NULL;
21964 ffestb_local_.decl.lent = NULL;
21965 return (ffelexHandler) ffestb_decl_ents_2_;
21966
21967 case FFELEX_typeOPEN_PAREN:
21968 ffestb_local_.decl.kind = NULL;
21969 ffestb_local_.decl.kindt = NULL;
21970 ffestb_local_.decl.len = NULL;
21971 ffestb_local_.decl.lent = NULL;
21972 return (ffelexHandler) ffestb_decl_ents_3_ (t);
21973
21974 case FFELEX_typeEQUALS:
21975 case FFELEX_typeSLASH:
21976 ffestb_local_.decl.kind = NULL;
21977 ffestb_local_.decl.kindt = NULL;
21978 ffestb_subrargs_.dim_list.dims = NULL;
21979 ffestb_local_.decl.len = NULL;
21980 ffestb_local_.decl.lent = NULL;
21981 return (ffelexHandler) ffestb_decl_ents_7_ (t);
21982
21983 default:
21984 break;
21985 }
21986
21987 if (!ffesta_is_inhibited ())
21988 ffestc_decl_finish ();
21989 ffelex_token_kill (ffesta_tokens[1]);
21990 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
21991 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
21992 }
21993
21994 /* ffestb_decl_ents_2_ -- "type" [type parameters] [attributes "::"] NAME
21995 ASTERISK
21996
21997 return ffestb_decl_ents_2_; // to lexer
21998
21999 Handle NUMBER or OPEN_PAREN. */
22000
22001 static ffelexHandler
ffestb_decl_ents_2_(ffelexToken t)22002 ffestb_decl_ents_2_ (ffelexToken t)
22003 {
22004 switch (ffelex_token_type (t))
22005 {
22006 case FFELEX_typeNUMBER:
22007 if (ffestb_local_.decl.type != FFESTP_typeCHARACTER)
22008 {
22009 ffestb_local_.decl.kind = NULL;
22010 ffestb_local_.decl.kindt = ffelex_token_use (t);
22011 return (ffelexHandler) ffestb_decl_ents_3_;
22012 }
22013 /* Fall through. *//* (CHARACTER's *n is always a len spec. */
22014 case FFELEX_typeOPEN_PAREN:/* "*(" is after the (omitted)
22015 "(array-spec)". */
22016 ffestb_local_.decl.kind = NULL;
22017 ffestb_local_.decl.kindt = NULL;
22018 ffestb_subrargs_.dim_list.dims = NULL;
22019 return (ffelexHandler) ffestb_decl_ents_5_ (t);
22020
22021 default:
22022 break;
22023 }
22024
22025 if (!ffesta_is_inhibited ())
22026 ffestc_decl_finish ();
22027 ffelex_token_kill (ffesta_tokens[1]);
22028 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22029 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22030 }
22031
22032 /* ffestb_decl_ents_3_ -- "type" [type parameters] [attributes "::"] NAME
22033 [ASTERISK NUMBER]
22034
22035 return ffestb_decl_ents_3_; // to lexer
22036
22037 Handle ASTERISK, OPEN_PAREN, EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */
22038
22039 static ffelexHandler
ffestb_decl_ents_3_(ffelexToken t)22040 ffestb_decl_ents_3_ (ffelexToken t)
22041 {
22042 switch (ffelex_token_type (t))
22043 {
22044 case FFELEX_typeCOMMA:
22045 if (!ffesta_is_inhibited ())
22046 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
22047 ffestb_local_.decl.kindt, NULL, NULL, NULL, NULL, NULL, FALSE);
22048 ffelex_token_kill (ffesta_tokens[1]);
22049 if (ffestb_local_.decl.kindt != NULL)
22050 ffelex_token_kill (ffestb_local_.decl.kindt);
22051 return (ffelexHandler) ffestb_decl_ents_;
22052
22053 case FFELEX_typeEOS:
22054 case FFELEX_typeSEMICOLON:
22055 if (!ffesta_is_inhibited ())
22056 {
22057 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
22058 ffestb_local_.decl.kindt, NULL, NULL, NULL, NULL, NULL, FALSE);
22059 ffestc_decl_finish ();
22060 }
22061 ffelex_token_kill (ffesta_tokens[1]);
22062 if (ffestb_local_.decl.kindt != NULL)
22063 ffelex_token_kill (ffestb_local_.decl.kindt);
22064 return (ffelexHandler) ffesta_zero (t);
22065
22066 case FFELEX_typeASTERISK:
22067 ffestb_subrargs_.dim_list.dims = NULL;
22068 return (ffelexHandler) ffestb_decl_ents_5_;
22069
22070 case FFELEX_typeOPEN_PAREN:
22071 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
22072 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_decl_ents_4_;
22073 ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
22074 ffestb_subrargs_.dim_list.ctx = ffesta_is_entry_valid
22075 ? FFEEXPR_contextDIMLIST : FFEEXPR_contextDIMLISTCOMMON;
22076 #ifdef FFECOM_dimensionsMAX
22077 ffestb_subrargs_.dim_list.ndims = 0;
22078 #endif
22079 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
22080 ffestb_subrargs_.dim_list.ctx,
22081 (ffeexprCallback) ffestb_subr_dimlist_);
22082
22083 case FFELEX_typeEQUALS:
22084 case FFELEX_typeSLASH:
22085 ffestb_local_.decl.kind = NULL;
22086 ffestb_local_.decl.kindt = NULL;
22087 ffestb_subrargs_.dim_list.dims = NULL;
22088 ffestb_local_.decl.len = NULL;
22089 ffestb_local_.decl.lent = NULL;
22090 return (ffelexHandler) ffestb_decl_ents_7_ (t);
22091
22092 default:
22093 break;
22094 }
22095
22096 if (!ffesta_is_inhibited ())
22097 ffestc_decl_finish ();
22098 ffelex_token_kill (ffesta_tokens[1]);
22099 if (ffestb_local_.decl.kindt != NULL)
22100 ffelex_token_kill (ffestb_local_.decl.kindt);
22101 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22102 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22103 }
22104
22105 /* ffestb_decl_ents_4_ -- "type" [type parameters] [attributes "::"] NAME
22106 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
22107
22108 return ffestb_decl_ents_4_; // to lexer
22109
22110 Handle ASTERISK, EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */
22111
22112 static ffelexHandler
ffestb_decl_ents_4_(ffelexToken t)22113 ffestb_decl_ents_4_ (ffelexToken t)
22114 {
22115 ffelexToken nt;
22116
22117 if (!ffestb_subrargs_.dim_list.ok)
22118 goto bad; /* :::::::::::::::::::: */
22119
22120 if (ffelex_token_type (ffesta_tokens[1]) == FFELEX_typeNAMES)
22121 {
22122 switch (ffelex_token_type (t))
22123 {
22124 case FFELEX_typeCOMMA:
22125 case FFELEX_typeEOS:
22126 case FFELEX_typeSEMICOLON:
22127 case FFELEX_typeASTERISK:
22128 case FFELEX_typeSLASH: /* But NOT FFELEX_typeEQUALS. */
22129 case FFELEX_typeCOLONCOLON: /* Actually an error. */
22130 break; /* Confirm and handle. */
22131
22132 default: /* Perhaps EQUALS, as in
22133 INTEGERFUNCTIONX(A)=B. */
22134 goto bad; /* :::::::::::::::::::: */
22135 }
22136 ffesta_confirmed ();
22137 if (!ffesta_is_inhibited ())
22138 {
22139 nt = ffelex_token_name_from_names (ffesta_tokens[1], 0, 0);
22140 ffelex_token_kill (ffesta_tokens[1]);
22141 ffesta_tokens[1] = nt;
22142 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
22143 NULL, NULL, NULL, NULL);
22144 }
22145 }
22146
22147 switch (ffelex_token_type (t))
22148 {
22149 case FFELEX_typeCOMMA:
22150 if (!ffesta_is_inhibited ())
22151 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
22152 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
22153 ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
22154 FALSE);
22155 ffelex_token_kill (ffesta_tokens[1]);
22156 if (ffestb_local_.decl.kindt != NULL)
22157 ffelex_token_kill (ffestb_local_.decl.kindt);
22158 if (ffestb_local_.decl.lent != NULL)
22159 ffelex_token_kill (ffestb_local_.decl.lent);
22160 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22161 return (ffelexHandler) ffestb_decl_ents_;
22162
22163 case FFELEX_typeEOS:
22164 case FFELEX_typeSEMICOLON:
22165 if (!ffesta_is_inhibited ())
22166 {
22167 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
22168 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
22169 ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
22170 FALSE);
22171 ffestc_decl_finish ();
22172 }
22173 ffelex_token_kill (ffesta_tokens[1]);
22174 if (ffestb_local_.decl.kindt != NULL)
22175 ffelex_token_kill (ffestb_local_.decl.kindt);
22176 if (ffestb_local_.decl.lent != NULL)
22177 ffelex_token_kill (ffestb_local_.decl.lent);
22178 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22179 return (ffelexHandler) ffesta_zero (t);
22180
22181 case FFELEX_typeASTERISK:
22182 if (ffestb_local_.decl.lent != NULL)
22183 break; /* Can't specify "*length" twice. */
22184 return (ffelexHandler) ffestb_decl_ents_5_;
22185
22186 case FFELEX_typeEQUALS:
22187 case FFELEX_typeSLASH:
22188 return (ffelexHandler) ffestb_decl_ents_7_ (t);
22189
22190 default:
22191 break;
22192 }
22193
22194 bad: /* :::::::::::::::::::: */
22195 if ((ffelex_token_type (ffesta_tokens[1]) != FFELEX_typeNAMES)
22196 && !ffesta_is_inhibited ())
22197 ffestc_decl_finish ();
22198 ffelex_token_kill (ffesta_tokens[1]);
22199 if (ffestb_local_.decl.kindt != NULL)
22200 ffelex_token_kill (ffestb_local_.decl.kindt);
22201 if (ffestb_local_.decl.lent != NULL)
22202 ffelex_token_kill (ffestb_local_.decl.lent);
22203 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22204 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22205 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22206 }
22207
22208 /* ffestb_decl_ents_5_ -- "type" [type parameters] [attributes "::"] NAME
22209 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
22210 ASTERISK
22211
22212 return ffestb_decl_ents_5_; // to lexer
22213
22214 Handle NUMBER or OPEN_PAREN. */
22215
22216 static ffelexHandler
ffestb_decl_ents_5_(ffelexToken t)22217 ffestb_decl_ents_5_ (ffelexToken t)
22218 {
22219 switch (ffelex_token_type (t))
22220 {
22221 case FFELEX_typeNUMBER:
22222 ffestb_local_.decl.len = NULL;
22223 ffestb_local_.decl.lent = ffelex_token_use (t);
22224 return (ffelexHandler) ffestb_decl_ents_7_;
22225
22226 case FFELEX_typeOPEN_PAREN:
22227 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
22228 FFEEXPR_contextCHARACTERSIZE, (ffeexprCallback) ffestb_decl_ents_6_);
22229
22230 default:
22231 break;
22232 }
22233
22234 if (!ffesta_is_inhibited ())
22235 ffestc_decl_finish ();
22236 ffelex_token_kill (ffesta_tokens[1]);
22237 if (ffestb_local_.decl.kindt != NULL)
22238 ffelex_token_kill (ffestb_local_.decl.kindt);
22239 if (ffestb_subrargs_.dim_list.dims != NULL)
22240 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22241 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22242 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22243 }
22244
22245 /* ffestb_decl_ents_6_ -- "type" [type parameters] [attributes "::"] NAME
22246 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
22247 ASTERISK OPEN_PAREN expr
22248
22249 (ffestb_decl_ents_6_) // to expression handler
22250
22251 Handle CLOSE_PAREN. */
22252
22253 static ffelexHandler
ffestb_decl_ents_6_(ffelexToken ft,ffebld expr,ffelexToken t)22254 ffestb_decl_ents_6_ (ffelexToken ft, ffebld expr, ffelexToken t)
22255 {
22256 switch (ffelex_token_type (t))
22257 {
22258 case FFELEX_typeCLOSE_PAREN:
22259 if (expr == NULL)
22260 break;
22261 ffestb_local_.decl.len = expr;
22262 ffestb_local_.decl.lent = ffelex_token_use (ft);
22263 return (ffelexHandler) ffestb_decl_ents_7_;
22264
22265 default:
22266 break;
22267 }
22268
22269 if (!ffesta_is_inhibited ())
22270 ffestc_decl_finish ();
22271 ffelex_token_kill (ffesta_tokens[1]);
22272 if (ffestb_local_.decl.kindt != NULL)
22273 ffelex_token_kill (ffestb_local_.decl.kindt);
22274 if (ffestb_subrargs_.dim_list.dims != NULL)
22275 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22276 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22277 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22278 }
22279
22280 /* ffestb_decl_ents_7_ -- "type" [type parameters] [attributes "::"] NAME
22281 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
22282 [ASTERISK charlength]
22283
22284 return ffestb_decl_ents_7_; // to lexer
22285
22286 Handle EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */
22287
22288 static ffelexHandler
ffestb_decl_ents_7_(ffelexToken t)22289 ffestb_decl_ents_7_ (ffelexToken t)
22290 {
22291 switch (ffelex_token_type (t))
22292 {
22293 case FFELEX_typeCOMMA:
22294 if (!ffesta_is_inhibited ())
22295 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
22296 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
22297 ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
22298 FALSE);
22299 ffelex_token_kill (ffesta_tokens[1]);
22300 if (ffestb_local_.decl.kindt != NULL)
22301 ffelex_token_kill (ffestb_local_.decl.kindt);
22302 if (ffestb_subrargs_.dim_list.dims != NULL)
22303 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22304 if (ffestb_local_.decl.lent != NULL)
22305 ffelex_token_kill (ffestb_local_.decl.lent);
22306 return (ffelexHandler) ffestb_decl_ents_;
22307
22308 case FFELEX_typeEOS:
22309 case FFELEX_typeSEMICOLON:
22310 if (!ffesta_is_inhibited ())
22311 {
22312 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
22313 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
22314 ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
22315 FALSE);
22316 ffestc_decl_finish ();
22317 }
22318 ffelex_token_kill (ffesta_tokens[1]);
22319 if (ffestb_local_.decl.kindt != NULL)
22320 ffelex_token_kill (ffestb_local_.decl.kindt);
22321 if (ffestb_subrargs_.dim_list.dims != NULL)
22322 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22323 if (ffestb_local_.decl.lent != NULL)
22324 ffelex_token_kill (ffestb_local_.decl.lent);
22325 return (ffelexHandler) ffesta_zero (t);
22326
22327 case FFELEX_typeEQUALS:
22328 if (!ffestb_local_.decl.coloncolon)
22329 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_INIT, t);
22330 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
22331 ffestb_local_.decl.parameter ? FFEEXPR_contextPARAMETER
22332 : FFEEXPR_contextINITVAL, (ffeexprCallback) ffestb_decl_ents_8_);
22333
22334 case FFELEX_typeSLASH:
22335 if (!ffesta_is_inhibited ())
22336 {
22337 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
22338 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
22339 ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
22340 TRUE);
22341 ffestc_decl_itemstartvals ();
22342 }
22343 ffelex_token_kill (ffesta_tokens[1]);
22344 if (ffestb_local_.decl.kindt != NULL)
22345 ffelex_token_kill (ffestb_local_.decl.kindt);
22346 if (ffestb_subrargs_.dim_list.dims != NULL)
22347 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22348 if (ffestb_local_.decl.lent != NULL)
22349 ffelex_token_kill (ffestb_local_.decl.lent);
22350 return (ffelexHandler) ffeexpr_rhs
22351 (ffesta_output_pool, FFEEXPR_contextDATA,
22352 (ffeexprCallback) ffestb_decl_ents_9_);
22353
22354 default:
22355 break;
22356 }
22357
22358 if (!ffesta_is_inhibited ())
22359 ffestc_decl_finish ();
22360 ffelex_token_kill (ffesta_tokens[1]);
22361 if (ffestb_local_.decl.kindt != NULL)
22362 ffelex_token_kill (ffestb_local_.decl.kindt);
22363 if (ffestb_subrargs_.dim_list.dims != NULL)
22364 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22365 if (ffestb_local_.decl.lent != NULL)
22366 ffelex_token_kill (ffestb_local_.decl.lent);
22367 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22368 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22369 }
22370
22371 /* ffestb_decl_ents_8_ -- "type" [type parameters] [attributes "::"] NAME
22372 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
22373 [ASTERISK charlength] EQUALS expr
22374
22375 (ffestb_decl_ents_8_) // to expression handler
22376
22377 Handle COMMA or EOS/SEMICOLON. */
22378
22379 static ffelexHandler
ffestb_decl_ents_8_(ffelexToken ft,ffebld expr,ffelexToken t)22380 ffestb_decl_ents_8_ (ffelexToken ft, ffebld expr, ffelexToken t)
22381 {
22382 switch (ffelex_token_type (t))
22383 {
22384 case FFELEX_typeCOMMA:
22385 if (expr == NULL)
22386 break;
22387 if (!ffesta_is_inhibited ())
22388 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
22389 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
22390 ffestb_local_.decl.len, ffestb_local_.decl.lent, expr, ft,
22391 FALSE);
22392 ffelex_token_kill (ffesta_tokens[1]);
22393 if (ffestb_local_.decl.kindt != NULL)
22394 ffelex_token_kill (ffestb_local_.decl.kindt);
22395 if (ffestb_subrargs_.dim_list.dims != NULL)
22396 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22397 if (ffestb_local_.decl.lent != NULL)
22398 ffelex_token_kill (ffestb_local_.decl.lent);
22399 return (ffelexHandler) ffestb_decl_ents_;
22400
22401 case FFELEX_typeEOS:
22402 case FFELEX_typeSEMICOLON:
22403 if (!ffesta_is_inhibited ())
22404 {
22405 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
22406 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
22407 ffestb_local_.decl.len, ffestb_local_.decl.lent, expr, ft,
22408 FALSE);
22409 ffestc_decl_finish ();
22410 }
22411 ffelex_token_kill (ffesta_tokens[1]);
22412 if (ffestb_local_.decl.kindt != NULL)
22413 ffelex_token_kill (ffestb_local_.decl.kindt);
22414 if (ffestb_subrargs_.dim_list.dims != NULL)
22415 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22416 if (ffestb_local_.decl.lent != NULL)
22417 ffelex_token_kill (ffestb_local_.decl.lent);
22418 return (ffelexHandler) ffesta_zero (t);
22419
22420 default:
22421 break;
22422 }
22423
22424 if (!ffesta_is_inhibited ())
22425 ffestc_decl_finish ();
22426 ffelex_token_kill (ffesta_tokens[1]);
22427 if (ffestb_local_.decl.kindt != NULL)
22428 ffelex_token_kill (ffestb_local_.decl.kindt);
22429 if (ffestb_subrargs_.dim_list.dims != NULL)
22430 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
22431 if (ffestb_local_.decl.lent != NULL)
22432 ffelex_token_kill (ffestb_local_.decl.lent);
22433 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22434 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22435 }
22436
22437 /* ffestb_decl_ents_9_ -- "type" ... SLASH expr
22438
22439 (ffestb_decl_ents_9_) // to expression handler
22440
22441 Handle ASTERISK, COMMA, or SLASH. */
22442
22443 static ffelexHandler
ffestb_decl_ents_9_(ffelexToken ft,ffebld expr,ffelexToken t)22444 ffestb_decl_ents_9_ (ffelexToken ft, ffebld expr, ffelexToken t)
22445 {
22446 switch (ffelex_token_type (t))
22447 {
22448 case FFELEX_typeCOMMA:
22449 if (expr == NULL)
22450 break;
22451 if (!ffesta_is_inhibited ())
22452 ffestc_decl_itemvalue (NULL, NULL, expr, ft);
22453 return (ffelexHandler) ffeexpr_rhs
22454 (ffesta_output_pool, FFEEXPR_contextDATA,
22455 (ffeexprCallback) ffestb_decl_ents_9_);
22456
22457 case FFELEX_typeASTERISK:
22458 if (expr == NULL)
22459 break;
22460 ffestb_local_.decl.expr = expr;
22461 ffesta_tokens[1] = ffelex_token_use (ft);
22462 return (ffelexHandler) ffeexpr_rhs
22463 (ffesta_output_pool, FFEEXPR_contextDATA,
22464 (ffeexprCallback) ffestb_decl_ents_10_);
22465
22466 case FFELEX_typeSLASH:
22467 if (expr == NULL)
22468 break;
22469 if (!ffesta_is_inhibited ())
22470 {
22471 ffestc_decl_itemvalue (NULL, NULL, expr, ft);
22472 ffestc_decl_itemendvals (t);
22473 }
22474 return (ffelexHandler) ffestb_decl_ents_11_;
22475
22476 default:
22477 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22478 break;
22479 }
22480
22481 if (!ffesta_is_inhibited ())
22482 {
22483 ffestc_decl_itemendvals (t);
22484 ffestc_decl_finish ();
22485 }
22486 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22487 }
22488
22489 /* ffestb_decl_ents_10_ -- "type" ... SLASH expr ASTERISK expr
22490
22491 (ffestb_decl_ents_10_) // to expression handler
22492
22493 Handle COMMA or SLASH. */
22494
22495 static ffelexHandler
ffestb_decl_ents_10_(ffelexToken ft,ffebld expr,ffelexToken t)22496 ffestb_decl_ents_10_ (ffelexToken ft, ffebld expr, ffelexToken t)
22497 {
22498 switch (ffelex_token_type (t))
22499 {
22500 case FFELEX_typeCOMMA:
22501 if (expr == NULL)
22502 break;
22503 if (!ffesta_is_inhibited ())
22504 ffestc_decl_itemvalue (ffestb_local_.decl.expr, ffesta_tokens[1],
22505 expr, ft);
22506 ffelex_token_kill (ffesta_tokens[1]);
22507 return (ffelexHandler) ffeexpr_rhs
22508 (ffesta_output_pool, FFEEXPR_contextDATA,
22509 (ffeexprCallback) ffestb_decl_ents_9_);
22510
22511 case FFELEX_typeSLASH:
22512 if (expr == NULL)
22513 break;
22514 if (!ffesta_is_inhibited ())
22515 {
22516 ffestc_decl_itemvalue (ffestb_local_.decl.expr, ffesta_tokens[1],
22517 expr, ft);
22518 ffestc_decl_itemendvals (t);
22519 }
22520 ffelex_token_kill (ffesta_tokens[1]);
22521 return (ffelexHandler) ffestb_decl_ents_11_;
22522
22523 default:
22524 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22525 break;
22526 }
22527
22528 if (!ffesta_is_inhibited ())
22529 {
22530 ffestc_decl_itemendvals (t);
22531 ffestc_decl_finish ();
22532 }
22533 ffelex_token_kill (ffesta_tokens[1]);
22534 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22535 }
22536
22537 /* ffestb_decl_ents_11_ -- "type" [type parameters] [attributes "::"] NAME
22538 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
22539 [ASTERISK charlength] SLASH initvals SLASH
22540
22541 return ffestb_decl_ents_11_; // to lexer
22542
22543 Handle COMMA or EOS/SEMICOLON. */
22544
22545 static ffelexHandler
ffestb_decl_ents_11_(ffelexToken t)22546 ffestb_decl_ents_11_ (ffelexToken t)
22547 {
22548 switch (ffelex_token_type (t))
22549 {
22550 case FFELEX_typeCOMMA:
22551 return (ffelexHandler) ffestb_decl_ents_;
22552
22553 case FFELEX_typeEOS:
22554 case FFELEX_typeSEMICOLON:
22555 if (!ffesta_is_inhibited ())
22556 ffestc_decl_finish ();
22557 return (ffelexHandler) ffesta_zero (t);
22558
22559 default:
22560 break;
22561 }
22562
22563 if (!ffesta_is_inhibited ())
22564 ffestc_decl_finish ();
22565 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22566 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22567 }
22568
22569 /* ffestb_decl_entsp_ -- "type" [type parameters]
22570
22571 return ffestb_decl_entsp_; // to lexer
22572
22573 Handle NAME or NAMES beginning either an entity (object) declaration or
22574 a function definition.. */
22575
22576 static ffelexHandler
ffestb_decl_entsp_(ffelexToken t)22577 ffestb_decl_entsp_ (ffelexToken t)
22578 {
22579 switch (ffelex_token_type (t))
22580 {
22581 case FFELEX_typeNAME:
22582 ffesta_confirmed ();
22583 ffesta_tokens[1] = ffelex_token_use (t);
22584 return (ffelexHandler) ffestb_decl_entsp_1_;
22585
22586 case FFELEX_typeNAMES:
22587 ffesta_confirmed ();
22588 ffesta_tokens[1] = ffelex_token_use (t);
22589 return (ffelexHandler) ffestb_decl_entsp_2_;
22590
22591 default:
22592 break;
22593 }
22594
22595 if (ffestb_local_.decl.kindt != NULL)
22596 ffelex_token_kill (ffestb_local_.decl.kindt);
22597 if (ffestb_local_.decl.lent != NULL)
22598 ffelex_token_kill (ffestb_local_.decl.lent);
22599 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
22600 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22601 }
22602
22603 /* ffestb_decl_entsp_1_ -- "type" [type parameters] NAME
22604
22605 return ffestb_decl_entsp_1_; // to lexer
22606
22607 If we get another NAME token here, then the previous one must be
22608 "RECURSIVE" or "FUNCTION" and we handle it accordingly. Otherwise,
22609 we send the previous and current token through to _ents_. */
22610
22611 static ffelexHandler
ffestb_decl_entsp_1_(ffelexToken t)22612 ffestb_decl_entsp_1_ (ffelexToken t)
22613 {
22614 switch (ffelex_token_type (t))
22615 {
22616 case FFELEX_typeNAME:
22617 switch (ffestr_first (ffesta_tokens[1]))
22618 {
22619 #if FFESTR_F90
22620 case FFESTR_firstRECURSIVE:
22621 if (ffestr_first (t) != FFESTR_firstFUNCTION)
22622 {
22623 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
22624 break;
22625 }
22626 ffestb_local_.decl.recursive = ffesta_tokens[1];
22627 return (ffelexHandler) ffestb_decl_funcname_;
22628 #endif
22629
22630 case FFESTR_firstFUNCTION:
22631 ffelex_token_kill (ffesta_tokens[1]);
22632 return (ffelexHandler) ffestb_decl_funcname_ (t);
22633
22634 default:
22635 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", ffesta_tokens[1]);
22636 break;
22637 }
22638 break;
22639
22640 default:
22641 if ((ffelex_token_type (ffesta_tokens[1]) != FFELEX_typeNAMES)
22642 && !ffesta_is_inhibited ())
22643 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
22644 ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
22645 ffestb_local_.decl.len, ffestb_local_.decl.lent);
22646 if (ffestb_local_.decl.kindt != NULL)
22647 ffelex_token_kill (ffestb_local_.decl.kindt);
22648 if (ffestb_local_.decl.lent != NULL)
22649 ffelex_token_kill (ffestb_local_.decl.lent);
22650 /* NAME/NAMES token already in ffesta_tokens[1]. */
22651 return (ffelexHandler) ffestb_decl_ents_1_ (t);
22652 }
22653
22654 if (ffestb_local_.decl.kindt != NULL)
22655 ffelex_token_kill (ffestb_local_.decl.kindt);
22656 if (ffestb_local_.decl.lent != NULL)
22657 ffelex_token_kill (ffestb_local_.decl.lent);
22658 ffelex_token_kill (ffesta_tokens[1]);
22659 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22660 }
22661
22662 /* ffestb_decl_entsp_2_ -- "type" [type parameters] NAMES
22663
22664 return ffestb_decl_entsp_2_; // to lexer
22665
22666 If we get an ASTERISK or OPEN_PAREN here, then if the previous NAMES
22667 begins with "FUNCTION" or "RECURSIVEFUNCTION" and is followed by a
22668 first-name-char, we have a possible syntactically ambiguous situation.
22669 Otherwise, we have a straightforward situation just as if we went
22670 through _entsp_1_ instead of here. */
22671
22672 static ffelexHandler
ffestb_decl_entsp_2_(ffelexToken t)22673 ffestb_decl_entsp_2_ (ffelexToken t)
22674 {
22675 ffelexToken nt;
22676 bool asterisk_ok;
22677 unsigned const char *p;
22678 ffeTokenLength i;
22679
22680 switch (ffelex_token_type (t))
22681 {
22682 case FFELEX_typeASTERISK:
22683 ffesta_confirmed ();
22684 switch (ffestb_local_.decl.type)
22685 {
22686 case FFESTP_typeINTEGER:
22687 case FFESTP_typeREAL:
22688 case FFESTP_typeCOMPLEX:
22689 case FFESTP_typeLOGICAL:
22690 asterisk_ok = (ffestb_local_.decl.kindt == NULL);
22691 break;
22692
22693 case FFESTP_typeCHARACTER:
22694 asterisk_ok = (ffestb_local_.decl.lent == NULL);
22695 break;
22696
22697 case FFESTP_typeBYTE:
22698 case FFESTP_typeWORD:
22699 default:
22700 asterisk_ok = FALSE;
22701 break;
22702 }
22703 switch (ffestr_first (ffesta_tokens[1]))
22704 {
22705 #if FFESTR_F90
22706 case FFESTR_firstRECURSIVEFNCTN:
22707 if (!asterisk_ok)
22708 break; /* For our own convenience, treat as non-FN
22709 stmt. */
22710 p = ffelex_token_text (ffesta_tokens[1])
22711 + (i = FFESTR_firstlRECURSIVEFNCTN);
22712 if (!ffesrc_is_name_init (*p))
22713 break;
22714 ffestb_local_.decl.recursive
22715 = ffelex_token_name_from_names (ffesta_tokens[1], 0,
22716 FFESTR_firstlRECURSIVEFNCTN);
22717 ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
22718 FFESTR_firstlRECURSIVEFNCTN, 0);
22719 return (ffelexHandler) ffestb_decl_entsp_3_;
22720 #endif
22721
22722 case FFESTR_firstFUNCTION:
22723 if (!asterisk_ok)
22724 break; /* For our own convenience, treat as non-FN
22725 stmt. */
22726 p = ffelex_token_text (ffesta_tokens[1])
22727 + (i = FFESTR_firstlFUNCTION);
22728 if (!ffesrc_is_name_init (*p))
22729 break;
22730 ffestb_local_.decl.recursive = NULL;
22731 ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
22732 FFESTR_firstlFUNCTION, 0);
22733 return (ffelexHandler) ffestb_decl_entsp_3_;
22734
22735 default:
22736 break;
22737 }
22738 break;
22739
22740 case FFELEX_typeOPEN_PAREN:
22741 ffestb_local_.decl.aster_after = FALSE;
22742 switch (ffestr_first (ffesta_tokens[1]))
22743 {
22744 #if FFESTR_F90
22745 case FFESTR_firstRECURSIVEFNCTN:
22746 p = ffelex_token_text (ffesta_tokens[1])
22747 + (i = FFESTR_firstlRECURSIVEFNCTN);
22748 if (!ffesrc_is_name_init (*p))
22749 break;
22750 ffestb_local_.decl.recursive
22751 = ffelex_token_name_from_names (ffesta_tokens[1], 0,
22752 FFESTR_firstlRECURSIVEFNCTN);
22753 ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
22754 FFESTR_firstlRECURSIVEFNCTN, 0);
22755 return (ffelexHandler) ffestb_decl_entsp_5_ (t);
22756 #endif
22757
22758 case FFESTR_firstFUNCTION:
22759 p = ffelex_token_text (ffesta_tokens[1])
22760 + (i = FFESTR_firstlFUNCTION);
22761 if (!ffesrc_is_name_init (*p))
22762 break;
22763 ffestb_local_.decl.recursive = NULL;
22764 ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
22765 FFESTR_firstlFUNCTION, 0);
22766 return (ffelexHandler) ffestb_decl_entsp_5_ (t);
22767
22768 default:
22769 break;
22770 }
22771 if ((ffestb_local_.decl.kindt != NULL)
22772 || (ffestb_local_.decl.lent != NULL))
22773 break; /* Have kind/len type param, definitely not
22774 assignment stmt. */
22775 return (ffelexHandler) ffestb_decl_entsp_1_ (t);
22776
22777 default:
22778 break;
22779 }
22780
22781 nt = ffelex_token_name_from_names (ffesta_tokens[1], 0, 0);
22782 ffelex_token_kill (ffesta_tokens[1]);
22783 ffesta_tokens[1] = nt; /* Change NAMES to NAME. */
22784 return (ffelexHandler) ffestb_decl_entsp_1_ (t);
22785 }
22786
22787 /* ffestb_decl_entsp_3_ -- "type" [type parameters] [RECURSIVE] FUNCTION
22788 NAME ASTERISK
22789
22790 return ffestb_decl_entsp_3_; // to lexer
22791
22792 Handle NUMBER or OPEN_PAREN. */
22793
22794 static ffelexHandler
ffestb_decl_entsp_3_(ffelexToken t)22795 ffestb_decl_entsp_3_ (ffelexToken t)
22796 {
22797 ffestb_local_.decl.aster_after = TRUE;
22798
22799 switch (ffelex_token_type (t))
22800 {
22801 case FFELEX_typeNUMBER:
22802 switch (ffestb_local_.decl.type)
22803 {
22804 case FFESTP_typeINTEGER:
22805 case FFESTP_typeREAL:
22806 case FFESTP_typeCOMPLEX:
22807 case FFESTP_typeLOGICAL:
22808 ffestb_local_.decl.kindt = ffelex_token_use (t);
22809 break;
22810
22811 case FFESTP_typeCHARACTER:
22812 ffestb_local_.decl.lent = ffelex_token_use (t);
22813 break;
22814
22815 case FFESTP_typeBYTE:
22816 case FFESTP_typeWORD:
22817 default:
22818 assert (FALSE);
22819 }
22820 return (ffelexHandler) ffestb_decl_entsp_5_;
22821
22822 case FFELEX_typeOPEN_PAREN:
22823 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
22824 FFEEXPR_contextCHARACTERSIZE,
22825 (ffeexprCallback) ffestb_decl_entsp_4_);
22826
22827 default:
22828 break;
22829 }
22830
22831 if (ffestb_local_.decl.recursive != NULL)
22832 ffelex_token_kill (ffestb_local_.decl.recursive);
22833 if (ffestb_local_.decl.kindt != NULL)
22834 ffelex_token_kill (ffestb_local_.decl.kindt);
22835 if (ffestb_local_.decl.lent != NULL)
22836 ffelex_token_kill (ffestb_local_.decl.lent);
22837 ffelex_token_kill (ffesta_tokens[1]);
22838 ffelex_token_kill (ffesta_tokens[2]);
22839 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
22840 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22841 }
22842
22843 /* ffestb_decl_entsp_4_ -- "type" [type parameters] [RECURSIVE] FUNCTION
22844 NAME ASTERISK OPEN_PAREN expr
22845
22846 (ffestb_decl_entsp_4_) // to expression handler
22847
22848 Allow only CLOSE_PAREN; and deal with character-length expression. */
22849
22850 static ffelexHandler
ffestb_decl_entsp_4_(ffelexToken ft,ffebld expr,ffelexToken t)22851 ffestb_decl_entsp_4_ (ffelexToken ft, ffebld expr, ffelexToken t)
22852 {
22853 switch (ffelex_token_type (t))
22854 {
22855 case FFELEX_typeCLOSE_PAREN:
22856 if (expr == NULL)
22857 break;
22858 switch (ffestb_local_.decl.type)
22859 {
22860 case FFESTP_typeCHARACTER:
22861 ffestb_local_.decl.len = expr;
22862 ffestb_local_.decl.lent = ffelex_token_use (ft);
22863 break;
22864
22865 default:
22866 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
22867 break;
22868 }
22869 return (ffelexHandler) ffestb_decl_entsp_5_;
22870
22871 default:
22872 break;
22873 }
22874
22875 if (ffestb_local_.decl.recursive != NULL)
22876 ffelex_token_kill (ffestb_local_.decl.recursive);
22877 if (ffestb_local_.decl.kindt != NULL)
22878 ffelex_token_kill (ffestb_local_.decl.kindt);
22879 if (ffestb_local_.decl.lent != NULL)
22880 ffelex_token_kill (ffestb_local_.decl.lent);
22881 ffelex_token_kill (ffesta_tokens[1]);
22882 ffelex_token_kill (ffesta_tokens[2]);
22883 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
22884 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
22885 }
22886
22887 /* ffestb_decl_entsp_5_ -- "type" [type parameters] [RECURSIVE] FUNCTION
22888 NAME [type parameter]
22889
22890 return ffestb_decl_entsp_5_; // to lexer
22891
22892 Make sure the next token is an OPEN_PAREN. Get the arg list or dimension
22893 list. If it can't be an arg list, or if the CLOSE_PAREN is followed by
22894 something other than EOS/SEMICOLON or NAME, then treat as dimension list
22895 and handle statement as an R426/R501. If it can't be a dimension list, or
22896 if the CLOSE_PAREN is followed by NAME, treat as an arg list and handle
22897 statement as an R1219. If it can be either an arg list or a dimension
22898 list and if the CLOSE_PAREN is followed by EOS/SEMICOLON, ask FFESTC
22899 whether to treat the statement as an R426/R501 or an R1219 and act
22900 accordingly. */
22901
22902 static ffelexHandler
ffestb_decl_entsp_5_(ffelexToken t)22903 ffestb_decl_entsp_5_ (ffelexToken t)
22904 {
22905 switch (ffelex_token_type (t))
22906 {
22907 case FFELEX_typeOPEN_PAREN:
22908 if (ffestb_local_.decl.aster_after && (ffestb_local_.decl.len != NULL))
22909 { /* "CHARACTER[RECURSIVE]FUNCTIONxyz*(len-expr)
22910 (..." must be a function-stmt, since the
22911 (len-expr) cannot precede (array-spec) in
22912 an object declaration but can precede
22913 (name-list) in a function stmt. */
22914 ffelex_token_kill (ffesta_tokens[1]);
22915 ffesta_tokens[1] = ffesta_tokens[2];
22916 return (ffelexHandler) ffestb_decl_funcname_4_ (t);
22917 }
22918 ffestb_local_.decl.toklist = ffestt_tokenlist_create ();
22919 ffestb_local_.decl.empty = TRUE;
22920 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
22921 return (ffelexHandler) ffestb_decl_entsp_6_;
22922
22923 default:
22924 break;
22925 }
22926
22927 assert (ffestb_local_.decl.aster_after);
22928 ffesta_confirmed (); /* We've seen an ASTERISK, so even EQUALS
22929 confirmed. */
22930 ffestb_subr_ambig_to_ents_ ();
22931 ffestb_subrargs_.dim_list.dims = NULL;
22932 return (ffelexHandler) ffestb_decl_ents_7_ (t);
22933 }
22934
22935 /* ffestb_decl_entsp_6_ -- "type" [type parameters] [RECURSIVE] FUNCTION
22936 NAME [type parameter] OPEN_PAREN
22937
22938 return ffestb_decl_entsp_6_; // to lexer
22939
22940 If CLOSE_PAREN, we definitely have an R1219 function-stmt, since
22941 the notation "name()" is invalid for a declaration. */
22942
22943 static ffelexHandler
ffestb_decl_entsp_6_(ffelexToken t)22944 ffestb_decl_entsp_6_ (ffelexToken t)
22945 {
22946 ffelexHandler next;
22947
22948 switch (ffelex_token_type (t))
22949 {
22950 case FFELEX_typeCLOSE_PAREN:
22951 if (!ffestb_local_.decl.empty)
22952 { /* Trailing comma, just a warning for
22953 stmt func def, so allow ambiguity. */
22954 ffestt_tokenlist_append (ffestb_local_.decl.toklist,
22955 ffelex_token_use (t));
22956 return (ffelexHandler) ffestb_decl_entsp_8_;
22957 }
22958 ffelex_token_kill (ffesta_tokens[1]);
22959 ffesta_tokens[1] = ffesta_tokens[2];
22960 next = (ffelexHandler) ffestt_tokenlist_handle
22961 (ffestb_local_.decl.toklist, (ffelexHandler) ffestb_decl_funcname_4_);
22962 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
22963 return (ffelexHandler) (*next) (t);
22964
22965 case FFELEX_typeNAME:
22966 ffestb_local_.decl.empty = FALSE;
22967 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
22968 return (ffelexHandler) ffestb_decl_entsp_7_;
22969
22970 case FFELEX_typeEQUALS:
22971 case FFELEX_typePOINTS:
22972 case FFELEX_typePERCENT:
22973 case FFELEX_typePERIOD:
22974 case FFELEX_typeOPEN_PAREN:
22975 if ((ffestb_local_.decl.kindt != NULL)
22976 || (ffestb_local_.decl.lent != NULL))
22977 break; /* type(params)name or type*val name, either
22978 way confirmed. */
22979 return (ffelexHandler) ffestb_subr_ambig_nope_ (t);
22980
22981 default:
22982 break;
22983 }
22984
22985 ffesta_confirmed ();
22986 ffestb_subr_ambig_to_ents_ ();
22987 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
22988 (ffelexHandler) ffestb_decl_ents_3_);
22989 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
22990 return (ffelexHandler) (*next) (t);
22991 }
22992
22993 /* ffestb_decl_entsp_7_ -- "type" [type parameters] [RECURSIVE] FUNCTION
22994 NAME [type parameter] OPEN_PAREN NAME
22995
22996 return ffestb_decl_entsp_7_; // to lexer
22997
22998 Expect COMMA or CLOSE_PAREN to remain ambiguous, else not an R1219
22999 function-stmt. */
23000
23001 static ffelexHandler
ffestb_decl_entsp_7_(ffelexToken t)23002 ffestb_decl_entsp_7_ (ffelexToken t)
23003 {
23004 ffelexHandler next;
23005
23006 switch (ffelex_token_type (t))
23007 {
23008 case FFELEX_typeCLOSE_PAREN:
23009 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
23010 return (ffelexHandler) ffestb_decl_entsp_8_;
23011
23012 case FFELEX_typeCOMMA:
23013 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
23014 return (ffelexHandler) ffestb_decl_entsp_6_;
23015
23016 case FFELEX_typeEQUALS:
23017 case FFELEX_typePOINTS:
23018 case FFELEX_typePERCENT:
23019 case FFELEX_typePERIOD:
23020 case FFELEX_typeOPEN_PAREN:
23021 if ((ffestb_local_.decl.kindt != NULL)
23022 || (ffestb_local_.decl.lent != NULL))
23023 break; /* type(params)name or type*val name, either
23024 way confirmed. */
23025 return (ffelexHandler) ffestb_subr_ambig_nope_ (t);
23026
23027 default:
23028 break;
23029 }
23030
23031 ffesta_confirmed ();
23032 ffestb_subr_ambig_to_ents_ ();
23033 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
23034 (ffelexHandler) ffestb_decl_ents_3_);
23035 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
23036 return (ffelexHandler) (*next) (t);
23037 }
23038
23039 /* ffestb_decl_entsp_8_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23040 NAME [type parameter] OPEN_PAREN name-list
23041 CLOSE_PAREN
23042
23043 return ffestb_decl_entsp_8_; // to lexer
23044
23045 If EOS/SEMICOLON, situation remains ambiguous, ask FFESTC to resolve
23046 it. If NAME (must be "RESULT", but that is checked later on),
23047 definitely an R1219 function-stmt. Anything else, handle as entity decl. */
23048
23049 static ffelexHandler
ffestb_decl_entsp_8_(ffelexToken t)23050 ffestb_decl_entsp_8_ (ffelexToken t)
23051 {
23052 ffelexHandler next;
23053
23054 switch (ffelex_token_type (t))
23055 {
23056 case FFELEX_typeEOS:
23057 case FFELEX_typeSEMICOLON:
23058 ffesta_confirmed ();
23059 if (ffestc_is_decl_not_R1219 ())
23060 break;
23061 /* Fall through. */
23062 case FFELEX_typeNAME:
23063 ffesta_confirmed ();
23064 ffelex_token_kill (ffesta_tokens[1]);
23065 ffesta_tokens[1] = ffesta_tokens[2];
23066 next = (ffelexHandler) ffestt_tokenlist_handle
23067 (ffestb_local_.decl.toklist, (ffelexHandler) ffestb_decl_funcname_4_);
23068 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
23069 return (ffelexHandler) (*next) (t);
23070
23071 case FFELEX_typeEQUALS:
23072 case FFELEX_typePOINTS:
23073 case FFELEX_typePERCENT:
23074 case FFELEX_typePERIOD:
23075 case FFELEX_typeOPEN_PAREN:
23076 if ((ffestb_local_.decl.kindt != NULL)
23077 || (ffestb_local_.decl.lent != NULL))
23078 break; /* type(params)name or type*val name, either
23079 way confirmed. */
23080 return (ffelexHandler) ffestb_subr_ambig_nope_ (t);
23081
23082 default:
23083 break;
23084 }
23085
23086 ffesta_confirmed ();
23087 ffestb_subr_ambig_to_ents_ ();
23088 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
23089 (ffelexHandler) ffestb_decl_ents_3_);
23090 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
23091 return (ffelexHandler) (*next) (t);
23092 }
23093
23094 /* ffestb_decl_func_ -- ["type" [type parameters]] RECURSIVE
23095
23096 return ffestb_decl_func_; // to lexer
23097
23098 Handle "FUNCTION". */
23099
23100 #if FFESTR_F90
23101 static ffelexHandler
ffestb_decl_func_(ffelexToken t)23102 ffestb_decl_func_ (ffelexToken t)
23103 {
23104 const char *p;
23105 ffeTokenLength i;
23106
23107 ffelex_set_names (FALSE);
23108
23109 switch (ffelex_token_type (t))
23110 {
23111 case FFELEX_typeNAME:
23112 if (ffestr_first (t) != FFESTR_firstFUNCTION)
23113 break;
23114 return (ffelexHandler) ffestb_decl_funcname_;
23115
23116 case FFELEX_typeNAMES:
23117 ffesta_confirmed ();
23118 if (ffestr_first (t) != FFESTR_firstFUNCTION)
23119 break;
23120 p = ffelex_token_text (t) + (i = FFESTR_firstlFUNCTION);
23121 if (*p == '\0')
23122 break;
23123 if (!ffesrc_is_name_init (*p))
23124 goto bad_i; /* :::::::::::::::::::: */
23125 ffesta_tokens[1] = ffelex_token_name_from_names (t, i, 0);
23126 return (ffelexHandler) ffestb_decl_funcname_1_;
23127
23128 default:
23129 break;
23130 }
23131
23132 if (ffestb_local_.decl.recursive != NULL)
23133 ffelex_token_kill (ffestb_local_.decl.recursive);
23134 if (ffestb_local_.decl.kindt != NULL)
23135 ffelex_token_kill (ffestb_local_.decl.kindt);
23136 if (ffestb_local_.decl.lent != NULL)
23137 ffelex_token_kill (ffestb_local_.decl.lent);
23138 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23139 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23140
23141 bad_i: /* :::::::::::::::::::: */
23142 if (ffestb_local_.decl.recursive != NULL)
23143 ffelex_token_kill (ffestb_local_.decl.recursive);
23144 if (ffestb_local_.decl.kindt != NULL)
23145 ffelex_token_kill (ffestb_local_.decl.kindt);
23146 if (ffestb_local_.decl.lent != NULL)
23147 ffelex_token_kill (ffestb_local_.decl.lent);
23148 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t, i, NULL);
23149 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23150 }
23151
23152 #endif
23153 /* ffestb_decl_funcname_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23154
23155 return ffestb_decl_funcname_; // to lexer
23156
23157 Handle NAME of a function. */
23158
23159 static ffelexHandler
ffestb_decl_funcname_(ffelexToken t)23160 ffestb_decl_funcname_ (ffelexToken t)
23161 {
23162 switch (ffelex_token_type (t))
23163 {
23164 case FFELEX_typeNAME:
23165 ffesta_tokens[1] = ffelex_token_use (t);
23166 return (ffelexHandler) ffestb_decl_funcname_1_;
23167
23168 default:
23169 break;
23170 }
23171
23172 if (ffestb_local_.decl.recursive != NULL)
23173 ffelex_token_kill (ffestb_local_.decl.recursive);
23174 if (ffestb_local_.decl.kindt != NULL)
23175 ffelex_token_kill (ffestb_local_.decl.kindt);
23176 if (ffestb_local_.decl.lent != NULL)
23177 ffelex_token_kill (ffestb_local_.decl.lent);
23178 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23179 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23180 }
23181
23182 /* ffestb_decl_funcname_1_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23183 NAME
23184
23185 return ffestb_decl_funcname_1_; // to lexer
23186
23187 Handle ASTERISK or OPEN_PAREN. */
23188
23189 static ffelexHandler
ffestb_decl_funcname_1_(ffelexToken t)23190 ffestb_decl_funcname_1_ (ffelexToken t)
23191 {
23192 switch (ffelex_token_type (t))
23193 {
23194 case FFELEX_typeASTERISK:
23195 return (ffelexHandler) ffestb_decl_funcname_2_;
23196
23197 case FFELEX_typeOPEN_PAREN:
23198 return (ffelexHandler) ffestb_decl_funcname_4_ (t);
23199
23200 default:
23201 break;
23202 }
23203
23204 if (ffestb_local_.decl.recursive != NULL)
23205 ffelex_token_kill (ffestb_local_.decl.recursive);
23206 if (ffestb_local_.decl.kindt != NULL)
23207 ffelex_token_kill (ffestb_local_.decl.kindt);
23208 if (ffestb_local_.decl.lent != NULL)
23209 ffelex_token_kill (ffestb_local_.decl.lent);
23210 ffelex_token_kill (ffesta_tokens[1]);
23211 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23212 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23213 }
23214
23215 /* ffestb_decl_funcname_2_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23216 NAME ASTERISK
23217
23218 return ffestb_decl_funcname_2_; // to lexer
23219
23220 Handle NUMBER or OPEN_PAREN. */
23221
23222 static ffelexHandler
ffestb_decl_funcname_2_(ffelexToken t)23223 ffestb_decl_funcname_2_ (ffelexToken t)
23224 {
23225 switch (ffelex_token_type (t))
23226 {
23227 case FFELEX_typeNUMBER:
23228 switch (ffestb_local_.decl.type)
23229 {
23230 case FFESTP_typeINTEGER:
23231 case FFESTP_typeREAL:
23232 case FFESTP_typeCOMPLEX:
23233 case FFESTP_typeLOGICAL:
23234 if (ffestb_local_.decl.kindt == NULL)
23235 ffestb_local_.decl.kindt = ffelex_token_use (t);
23236 else
23237 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23238 break;
23239
23240 case FFESTP_typeCHARACTER:
23241 if (ffestb_local_.decl.lent == NULL)
23242 ffestb_local_.decl.lent = ffelex_token_use (t);
23243 else
23244 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23245 break;
23246
23247 case FFESTP_typeBYTE:
23248 case FFESTP_typeWORD:
23249 default:
23250 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23251 break;
23252 }
23253 return (ffelexHandler) ffestb_decl_funcname_4_;
23254
23255 case FFELEX_typeOPEN_PAREN:
23256 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
23257 FFEEXPR_contextCHARACTERSIZE,
23258 (ffeexprCallback) ffestb_decl_funcname_3_);
23259
23260 default:
23261 break;
23262 }
23263
23264 if (ffestb_local_.decl.recursive != NULL)
23265 ffelex_token_kill (ffestb_local_.decl.recursive);
23266 if (ffestb_local_.decl.kindt != NULL)
23267 ffelex_token_kill (ffestb_local_.decl.kindt);
23268 if (ffestb_local_.decl.lent != NULL)
23269 ffelex_token_kill (ffestb_local_.decl.lent);
23270 ffelex_token_kill (ffesta_tokens[1]);
23271 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23272 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23273 }
23274
23275 /* ffestb_decl_funcname_3_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23276 NAME ASTERISK OPEN_PAREN expr
23277
23278 (ffestb_decl_funcname_3_) // to expression handler
23279
23280 Allow only CLOSE_PAREN; and deal with character-length expression. */
23281
23282 static ffelexHandler
ffestb_decl_funcname_3_(ffelexToken ft,ffebld expr,ffelexToken t)23283 ffestb_decl_funcname_3_ (ffelexToken ft, ffebld expr, ffelexToken t)
23284 {
23285 switch (ffelex_token_type (t))
23286 {
23287 case FFELEX_typeCLOSE_PAREN:
23288 if (expr == NULL)
23289 break;
23290 switch (ffestb_local_.decl.type)
23291 {
23292 case FFESTP_typeCHARACTER:
23293 if (ffestb_local_.decl.lent == NULL)
23294 {
23295 ffestb_local_.decl.len = expr;
23296 ffestb_local_.decl.lent = ffelex_token_use (ft);
23297 }
23298 else
23299 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23300 break;
23301
23302 default:
23303 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23304 break;
23305 }
23306 return (ffelexHandler) ffestb_decl_funcname_4_;
23307
23308 default:
23309 break;
23310 }
23311
23312 if (ffestb_local_.decl.recursive != NULL)
23313 ffelex_token_kill (ffestb_local_.decl.recursive);
23314 if (ffestb_local_.decl.kindt != NULL)
23315 ffelex_token_kill (ffestb_local_.decl.kindt);
23316 if (ffestb_local_.decl.lent != NULL)
23317 ffelex_token_kill (ffestb_local_.decl.lent);
23318 ffelex_token_kill (ffesta_tokens[1]);
23319 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23320 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23321 }
23322
23323 /* ffestb_decl_funcname_4_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23324 NAME [type parameter]
23325
23326 return ffestb_decl_funcname_4_; // to lexer
23327
23328 Make sure the next token is an OPEN_PAREN. Get the arg list and
23329 then implement. */
23330
23331 static ffelexHandler
ffestb_decl_funcname_4_(ffelexToken t)23332 ffestb_decl_funcname_4_ (ffelexToken t)
23333 {
23334 switch (ffelex_token_type (t))
23335 {
23336 case FFELEX_typeOPEN_PAREN:
23337 ffestb_subrargs_.name_list.args = ffestt_tokenlist_create ();
23338 ffestb_subrargs_.name_list.handler
23339 = (ffelexHandler) ffestb_decl_funcname_5_;
23340 ffestb_subrargs_.name_list.is_subr = FALSE;
23341 ffestb_subrargs_.name_list.names = FALSE;
23342 return (ffelexHandler) ffestb_subr_name_list_;
23343
23344 default:
23345 break;
23346 }
23347
23348 if (ffestb_local_.decl.recursive != NULL)
23349 ffelex_token_kill (ffestb_local_.decl.recursive);
23350 if (ffestb_local_.decl.kindt != NULL)
23351 ffelex_token_kill (ffestb_local_.decl.kindt);
23352 if (ffestb_local_.decl.lent != NULL)
23353 ffelex_token_kill (ffestb_local_.decl.lent);
23354 ffelex_token_kill (ffesta_tokens[1]);
23355 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23356 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23357 }
23358
23359 /* ffestb_decl_funcname_5_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23360 NAME [type parameter] OPEN_PAREN arg-list
23361 CLOSE_PAREN
23362
23363 return ffestb_decl_funcname_5_; // to lexer
23364
23365 Must have EOS/SEMICOLON or "RESULT" here. */
23366
23367 static ffelexHandler
ffestb_decl_funcname_5_(ffelexToken t)23368 ffestb_decl_funcname_5_ (ffelexToken t)
23369 {
23370 if (!ffestb_subrargs_.name_list.ok)
23371 goto bad; /* :::::::::::::::::::: */
23372
23373 switch (ffelex_token_type (t))
23374 {
23375 case FFELEX_typeEOS:
23376 case FFELEX_typeSEMICOLON:
23377 ffesta_confirmed ();
23378 if (!ffesta_is_inhibited ())
23379 ffestc_R1219 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
23380 ffestb_subrargs_.name_list.close_paren, ffestb_local_.decl.type,
23381 ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
23382 ffestb_local_.decl.len, ffestb_local_.decl.lent,
23383 ffestb_local_.decl.recursive, NULL);
23384 if (ffestb_local_.decl.recursive != NULL)
23385 ffelex_token_kill (ffestb_local_.decl.recursive);
23386 if (ffestb_local_.decl.kindt != NULL)
23387 ffelex_token_kill (ffestb_local_.decl.kindt);
23388 if (ffestb_local_.decl.lent != NULL)
23389 ffelex_token_kill (ffestb_local_.decl.lent);
23390 ffelex_token_kill (ffesta_tokens[1]);
23391 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
23392 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
23393 return (ffelexHandler) ffesta_zero (t);
23394
23395 case FFELEX_typeNAME:
23396 if (ffestr_other (t) != FFESTR_otherRESULT)
23397 break;
23398 return (ffelexHandler) ffestb_decl_funcname_6_;
23399
23400 default:
23401 break;
23402 }
23403
23404 bad: /* :::::::::::::::::::: */
23405 if (ffestb_local_.decl.recursive != NULL)
23406 ffelex_token_kill (ffestb_local_.decl.recursive);
23407 if (ffestb_local_.decl.kindt != NULL)
23408 ffelex_token_kill (ffestb_local_.decl.kindt);
23409 if (ffestb_local_.decl.lent != NULL)
23410 ffelex_token_kill (ffestb_local_.decl.lent);
23411 ffelex_token_kill (ffesta_tokens[1]);
23412 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
23413 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
23414 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23415 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23416 }
23417
23418 /* ffestb_decl_funcname_6_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23419 NAME [type parameter] OPEN_PAREN arglist
23420 CLOSE_PAREN "RESULT"
23421
23422 return ffestb_decl_funcname_6_; // to lexer
23423
23424 Make sure the next token is an OPEN_PAREN. */
23425
23426 static ffelexHandler
ffestb_decl_funcname_6_(ffelexToken t)23427 ffestb_decl_funcname_6_ (ffelexToken t)
23428 {
23429 switch (ffelex_token_type (t))
23430 {
23431 case FFELEX_typeOPEN_PAREN:
23432 return (ffelexHandler) ffestb_decl_funcname_7_;
23433
23434 default:
23435 break;
23436 }
23437
23438 if (ffestb_local_.decl.recursive != NULL)
23439 ffelex_token_kill (ffestb_local_.decl.recursive);
23440 if (ffestb_local_.decl.kindt != NULL)
23441 ffelex_token_kill (ffestb_local_.decl.kindt);
23442 if (ffestb_local_.decl.lent != NULL)
23443 ffelex_token_kill (ffestb_local_.decl.lent);
23444 ffelex_token_kill (ffesta_tokens[1]);
23445 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
23446 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
23447 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23448 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23449 }
23450
23451 /* ffestb_decl_funcname_7_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23452 NAME [type parameter] OPEN_PAREN arglist
23453 CLOSE_PAREN "RESULT" OPEN_PAREN
23454
23455 return ffestb_decl_funcname_7_; // to lexer
23456
23457 Make sure the next token is a NAME. */
23458
23459 static ffelexHandler
ffestb_decl_funcname_7_(ffelexToken t)23460 ffestb_decl_funcname_7_ (ffelexToken t)
23461 {
23462 switch (ffelex_token_type (t))
23463 {
23464 case FFELEX_typeNAME:
23465 ffesta_tokens[2] = ffelex_token_use (t);
23466 return (ffelexHandler) ffestb_decl_funcname_8_;
23467
23468 default:
23469 break;
23470 }
23471
23472 if (ffestb_local_.decl.recursive != NULL)
23473 ffelex_token_kill (ffestb_local_.decl.recursive);
23474 if (ffestb_local_.decl.kindt != NULL)
23475 ffelex_token_kill (ffestb_local_.decl.kindt);
23476 if (ffestb_local_.decl.lent != NULL)
23477 ffelex_token_kill (ffestb_local_.decl.lent);
23478 ffelex_token_kill (ffesta_tokens[1]);
23479 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
23480 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
23481 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23482 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23483 }
23484
23485 /* ffestb_decl_funcname_8_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23486 NAME [type parameter] OPEN_PAREN arglist
23487 CLOSE_PAREN "RESULT" OPEN_PAREN NAME
23488
23489 return ffestb_decl_funcname_8_; // to lexer
23490
23491 Make sure the next token is a CLOSE_PAREN. */
23492
23493 static ffelexHandler
ffestb_decl_funcname_8_(ffelexToken t)23494 ffestb_decl_funcname_8_ (ffelexToken t)
23495 {
23496 switch (ffelex_token_type (t))
23497 {
23498 case FFELEX_typeCLOSE_PAREN:
23499 return (ffelexHandler) ffestb_decl_funcname_9_;
23500
23501 default:
23502 break;
23503 }
23504
23505 if (ffestb_local_.decl.recursive != NULL)
23506 ffelex_token_kill (ffestb_local_.decl.recursive);
23507 if (ffestb_local_.decl.kindt != NULL)
23508 ffelex_token_kill (ffestb_local_.decl.kindt);
23509 if (ffestb_local_.decl.lent != NULL)
23510 ffelex_token_kill (ffestb_local_.decl.lent);
23511 ffelex_token_kill (ffesta_tokens[1]);
23512 ffelex_token_kill (ffesta_tokens[2]);
23513 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
23514 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
23515 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23516 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23517 }
23518
23519 /* ffestb_decl_funcname_9_ -- "type" [type parameters] [RECURSIVE] FUNCTION
23520 NAME [type parameter] OPEN_PAREN arg-list
23521 CLOSE_PAREN "RESULT" OPEN_PAREN NAME CLOSE_PAREN
23522
23523 return ffestb_decl_funcname_9_; // to lexer
23524
23525 Must have EOS/SEMICOLON here. */
23526
23527 static ffelexHandler
ffestb_decl_funcname_9_(ffelexToken t)23528 ffestb_decl_funcname_9_ (ffelexToken t)
23529 {
23530 switch (ffelex_token_type (t))
23531 {
23532 case FFELEX_typeEOS:
23533 case FFELEX_typeSEMICOLON:
23534 if (!ffesta_is_inhibited ())
23535 ffestc_R1219 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
23536 ffestb_subrargs_.name_list.close_paren, ffestb_local_.decl.type,
23537 ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
23538 ffestb_local_.decl.len, ffestb_local_.decl.lent,
23539 ffestb_local_.decl.recursive, ffesta_tokens[2]);
23540 if (ffestb_local_.decl.recursive != NULL)
23541 ffelex_token_kill (ffestb_local_.decl.recursive);
23542 if (ffestb_local_.decl.kindt != NULL)
23543 ffelex_token_kill (ffestb_local_.decl.kindt);
23544 if (ffestb_local_.decl.lent != NULL)
23545 ffelex_token_kill (ffestb_local_.decl.lent);
23546 ffelex_token_kill (ffesta_tokens[1]);
23547 ffelex_token_kill (ffesta_tokens[2]);
23548 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
23549 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
23550 return (ffelexHandler) ffesta_zero (t);
23551
23552 default:
23553 break;
23554 }
23555
23556 if (ffestb_local_.decl.recursive != NULL)
23557 ffelex_token_kill (ffestb_local_.decl.recursive);
23558 if (ffestb_local_.decl.kindt != NULL)
23559 ffelex_token_kill (ffestb_local_.decl.kindt);
23560 if (ffestb_local_.decl.lent != NULL)
23561 ffelex_token_kill (ffestb_local_.decl.lent);
23562 ffelex_token_kill (ffesta_tokens[1]);
23563 ffelex_token_kill (ffesta_tokens[2]);
23564 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
23565 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
23566 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
23567 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23568 }
23569
23570 /* ffestb_V003 -- Parse the STRUCTURE statement
23571
23572 return ffestb_V003; // to lexer
23573
23574 Make sure the statement has a valid form for the STRUCTURE statement.
23575 If it does, implement the statement. */
23576
23577 #if FFESTR_VXT
23578 ffelexHandler
ffestb_V003(ffelexToken t)23579 ffestb_V003 (ffelexToken t)
23580 {
23581 ffeTokenLength i;
23582 const char *p;
23583 ffelexToken nt;
23584 ffelexHandler next;
23585
23586 switch (ffelex_token_type (ffesta_tokens[0]))
23587 {
23588 case FFELEX_typeNAME:
23589 if (ffesta_first_kw != FFESTR_firstSTRUCTURE)
23590 goto bad_0; /* :::::::::::::::::::: */
23591 switch (ffelex_token_type (t))
23592 {
23593 case FFELEX_typeCOMMA:
23594 case FFELEX_typeCOLONCOLON:
23595 case FFELEX_typeEOS:
23596 case FFELEX_typeSEMICOLON:
23597 ffesta_confirmed (); /* Error, but clearly intended. */
23598 goto bad_1; /* :::::::::::::::::::: */
23599
23600 default:
23601 goto bad_1; /* :::::::::::::::::::: */
23602
23603 case FFELEX_typeNAME:
23604 ffesta_confirmed ();
23605 if (!ffesta_is_inhibited ())
23606 ffestc_V003_start (NULL);
23607 ffestb_local_.structure.started = TRUE;
23608 return (ffelexHandler) ffestb_V0034_ (t);
23609
23610 case FFELEX_typeSLASH:
23611 ffesta_confirmed ();
23612 return (ffelexHandler) ffestb_V0031_;
23613 }
23614
23615 case FFELEX_typeNAMES:
23616 if (ffesta_first_kw != FFESTR_firstSTRUCTURE)
23617 goto bad_0; /* :::::::::::::::::::: */
23618 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSTRUCTURE);
23619 switch (ffelex_token_type (t))
23620 {
23621 default:
23622 goto bad_1; /* :::::::::::::::::::: */
23623
23624 case FFELEX_typeEOS:
23625 case FFELEX_typeSEMICOLON:
23626 case FFELEX_typeCOMMA:
23627 case FFELEX_typeCOLONCOLON:
23628 ffesta_confirmed ();
23629 break;
23630
23631 case FFELEX_typeSLASH:
23632 ffesta_confirmed ();
23633 if (*p != '\0')
23634 goto bad_1; /* :::::::::::::::::::: */
23635 return (ffelexHandler) ffestb_V0031_;
23636
23637 case FFELEX_typeOPEN_PAREN:
23638 break;
23639 }
23640
23641 /* Here, we have at least one char after "STRUCTURE" and t is COMMA,
23642 EOS/SEMICOLON, or OPEN_PAREN. */
23643
23644 if (!ffesrc_is_name_init (*p))
23645 goto bad_i; /* :::::::::::::::::::: */
23646 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
23647 if (ffelex_token_type (t) == FFELEX_typeOPEN_PAREN)
23648 ffestb_local_.structure.started = FALSE;
23649 else
23650 {
23651 if (!ffesta_is_inhibited ())
23652 ffestc_V003_start (NULL);
23653 ffestb_local_.structure.started = TRUE;
23654 }
23655 next = (ffelexHandler) ffestb_V0034_ (nt);
23656 ffelex_token_kill (nt);
23657 return (ffelexHandler) (*next) (t);
23658
23659 default:
23660 goto bad_0; /* :::::::::::::::::::: */
23661 }
23662
23663 bad_0: /* :::::::::::::::::::: */
23664 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", ffesta_tokens[0]);
23665 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23666
23667 bad_1: /* :::::::::::::::::::: */
23668 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
23669 return (ffelexHandler) ffelex_swallow_tokens (t,
23670 (ffelexHandler) ffesta_zero); /* Invalid second token. */
23671
23672 bad_i: /* :::::::::::::::::::: */
23673 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", ffesta_tokens[0], i, t);
23674 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23675 }
23676
23677 /* ffestb_V0031_ -- "STRUCTURE" SLASH
23678
23679 return ffestb_V0031_; // to lexer
23680
23681 Handle NAME. */
23682
23683 static ffelexHandler
ffestb_V0031_(ffelexToken t)23684 ffestb_V0031_ (ffelexToken t)
23685 {
23686 switch (ffelex_token_type (t))
23687 {
23688 case FFELEX_typeNAME:
23689 ffesta_tokens[1] = ffelex_token_use (t);
23690 return (ffelexHandler) ffestb_V0032_;
23691
23692 default:
23693 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
23694 break;
23695 }
23696
23697 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23698 }
23699
23700 /* ffestb_V0032_ -- "STRUCTURE" SLASH NAME
23701
23702 return ffestb_V0032_; // to lexer
23703
23704 Handle SLASH. */
23705
23706 static ffelexHandler
ffestb_V0032_(ffelexToken t)23707 ffestb_V0032_ (ffelexToken t)
23708 {
23709 switch (ffelex_token_type (t))
23710 {
23711 case FFELEX_typeSLASH:
23712 if (!ffesta_is_inhibited ())
23713 ffestc_V003_start (ffesta_tokens[1]);
23714 ffestb_local_.structure.started = TRUE;
23715 ffelex_token_kill (ffesta_tokens[1]);
23716 return (ffelexHandler) ffestb_V0033_;
23717
23718 default:
23719 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
23720 break;
23721 }
23722
23723 ffelex_token_kill (ffesta_tokens[1]);
23724 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23725 }
23726
23727 /* ffestb_V0033_ -- "STRUCTURE" SLASH NAME SLASH
23728
23729 return ffestb_V0033_; // to lexer
23730
23731 Handle NAME or EOS/SEMICOLON. */
23732
23733 static ffelexHandler
ffestb_V0033_(ffelexToken t)23734 ffestb_V0033_ (ffelexToken t)
23735 {
23736 switch (ffelex_token_type (t))
23737 {
23738 case FFELEX_typeNAME:
23739 return (ffelexHandler) ffestb_V0034_ (t);
23740
23741 case FFELEX_typeEOS:
23742 case FFELEX_typeSEMICOLON:
23743 if (!ffesta_is_inhibited ())
23744 ffestc_V003_finish ();
23745 return (ffelexHandler) ffesta_zero (t);
23746
23747 default:
23748 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
23749 break;
23750 }
23751
23752 ffelex_token_kill (ffesta_tokens[1]);
23753 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23754 }
23755
23756 /* ffestb_V0034_ -- "STRUCTURE" [SLASH NAME SLASH]
23757
23758 return ffestb_V0034_; // to lexer
23759
23760 Handle NAME. */
23761
23762 static ffelexHandler
ffestb_V0034_(ffelexToken t)23763 ffestb_V0034_ (ffelexToken t)
23764 {
23765 switch (ffelex_token_type (t))
23766 {
23767 case FFELEX_typeNAME:
23768 ffesta_tokens[1] = ffelex_token_use (t);
23769 return (ffelexHandler) ffestb_V0035_;
23770
23771 default:
23772 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
23773 break;
23774 }
23775
23776 if (!ffesta_is_inhibited ())
23777 ffestc_V003_finish ();
23778 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23779 }
23780
23781 /* ffestb_V0035_ -- "STRUCTURE" ... NAME
23782
23783 return ffestb_V0035_; // to lexer
23784
23785 Handle OPEN_PAREN. */
23786
23787 static ffelexHandler
ffestb_V0035_(ffelexToken t)23788 ffestb_V0035_ (ffelexToken t)
23789 {
23790 switch (ffelex_token_type (t))
23791 {
23792 case FFELEX_typeOPEN_PAREN:
23793 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
23794 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_V0036_;
23795 ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
23796 ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLISTCOMMON;
23797 #ifdef FFECOM_dimensionsMAX
23798 ffestb_subrargs_.dim_list.ndims = 0;
23799 #endif
23800 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
23801 FFEEXPR_contextDIMLISTCOMMON, (ffeexprCallback) ffestb_subr_dimlist_);
23802
23803 case FFELEX_typeCOMMA:
23804 if (!ffesta_is_inhibited ())
23805 ffestc_V003_item (ffesta_tokens[1], NULL);
23806 ffelex_token_kill (ffesta_tokens[1]);
23807 return (ffelexHandler) ffestb_V0034_;
23808
23809 case FFELEX_typeEOS:
23810 case FFELEX_typeSEMICOLON:
23811 if (!ffesta_is_inhibited ())
23812 {
23813 ffestc_V003_item (ffesta_tokens[1], NULL);
23814 ffestc_V003_finish ();
23815 }
23816 ffelex_token_kill (ffesta_tokens[1]);
23817 return (ffelexHandler) ffesta_zero (t);
23818
23819 default:
23820 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
23821 break;
23822 }
23823
23824 if (!ffesta_is_inhibited ())
23825 ffestc_V003_finish ();
23826 ffelex_token_kill (ffesta_tokens[1]);
23827 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23828 }
23829
23830 /* ffestb_V0036_ -- "STRUCTURE" ... NAME OPEN_PAREN dimlist CLOSE_PAREN
23831
23832 return ffestb_V0036_; // to lexer
23833
23834 Handle COMMA or EOS/SEMICOLON. */
23835
23836 static ffelexHandler
ffestb_V0036_(ffelexToken t)23837 ffestb_V0036_ (ffelexToken t)
23838 {
23839 if (!ffestb_subrargs_.dim_list.ok)
23840 goto bad; /* :::::::::::::::::::: */
23841
23842 switch (ffelex_token_type (t))
23843 {
23844 case FFELEX_typeCOMMA:
23845 ffesta_confirmed ();
23846 if (!ffesta_is_inhibited ())
23847 {
23848 if (!ffestb_local_.structure.started)
23849 {
23850 ffestc_V003_start (NULL);
23851 ffestb_local_.structure.started = TRUE;
23852 }
23853 ffestc_V003_item (ffesta_tokens[1],
23854 ffestb_subrargs_.dim_list.dims);
23855 }
23856 ffelex_token_kill (ffesta_tokens[1]);
23857 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
23858 return (ffelexHandler) ffestb_V0034_;
23859
23860 case FFELEX_typeEOS:
23861 case FFELEX_typeSEMICOLON:
23862 ffesta_confirmed ();
23863 if (!ffesta_is_inhibited ())
23864 {
23865 if (!ffestb_local_.structure.started)
23866 ffestc_V003_start (NULL);
23867 ffestc_V003_item (ffesta_tokens[1],
23868 ffestb_subrargs_.dim_list.dims);
23869 ffestc_V003_finish ();
23870 }
23871 ffelex_token_kill (ffesta_tokens[1]);
23872 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
23873 return (ffelexHandler) ffesta_zero (t);
23874
23875 default:
23876 break;
23877 }
23878
23879 bad: /* :::::::::::::::::::: */
23880 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
23881 if (ffestb_local_.structure.started && !ffesta_is_inhibited ())
23882 ffestc_V003_finish ();
23883 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
23884 ffelex_token_kill (ffesta_tokens[1]);
23885 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23886 }
23887
23888 /* ffestb_V016 -- Parse the RECORD statement
23889
23890 return ffestb_V016; // to lexer
23891
23892 Make sure the statement has a valid form for the RECORD statement. If it
23893 does, implement the statement. */
23894
23895 ffelexHandler
ffestb_V016(ffelexToken t)23896 ffestb_V016 (ffelexToken t)
23897 {
23898 const char *p;
23899 ffeTokenLength i;
23900
23901 switch (ffelex_token_type (ffesta_tokens[0]))
23902 {
23903 case FFELEX_typeNAME:
23904 if (ffesta_first_kw != FFESTR_firstRECORD)
23905 goto bad_0; /* :::::::::::::::::::: */
23906 break;
23907
23908 case FFELEX_typeNAMES:
23909 if (ffesta_first_kw != FFESTR_firstRECORD)
23910 goto bad_0; /* :::::::::::::::::::: */
23911 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlRECORD);
23912 if (*p != '\0')
23913 goto bad_i; /* :::::::::::::::::::: */
23914 break;
23915
23916 default:
23917 goto bad_0; /* :::::::::::::::::::: */
23918 }
23919
23920 switch (ffelex_token_type (t))
23921 {
23922 case FFELEX_typeCOMMA:
23923 case FFELEX_typeEOS:
23924 case FFELEX_typeSEMICOLON:
23925 case FFELEX_typeCOLONCOLON:
23926 ffesta_confirmed (); /* Error, but clearly intended. */
23927 goto bad_1; /* :::::::::::::::::::: */
23928
23929 default:
23930 goto bad_1; /* :::::::::::::::::::: */
23931
23932 case FFELEX_typeSLASH:
23933 break;
23934 }
23935
23936 ffesta_confirmed ();
23937 if (!ffesta_is_inhibited ())
23938 ffestc_V016_start ();
23939 return (ffelexHandler) ffestb_V0161_;
23940
23941 bad_0: /* :::::::::::::::::::: */
23942 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", ffesta_tokens[0]);
23943 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23944
23945 bad_1: /* :::::::::::::::::::: */
23946 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
23947 return (ffelexHandler) ffelex_swallow_tokens (t,
23948 (ffelexHandler) ffesta_zero); /* Invalid second token. */
23949
23950 bad_i: /* :::::::::::::::::::: */
23951 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "RECORD", ffesta_tokens[0], i, t);
23952 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23953 }
23954
23955 /* ffestb_V0161_ -- "RECORD" SLASH
23956
23957 return ffestb_V0161_; // to lexer
23958
23959 Handle NAME. */
23960
23961 static ffelexHandler
ffestb_V0161_(ffelexToken t)23962 ffestb_V0161_ (ffelexToken t)
23963 {
23964 switch (ffelex_token_type (t))
23965 {
23966 case FFELEX_typeNAME:
23967 if (!ffesta_is_inhibited ())
23968 ffestc_V016_item_structure (t);
23969 return (ffelexHandler) ffestb_V0162_;
23970
23971 default:
23972 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
23973 break;
23974 }
23975
23976 if (!ffesta_is_inhibited ())
23977 ffestc_V016_finish ();
23978 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
23979 }
23980
23981 /* ffestb_V0162_ -- "RECORD" SLASH NAME
23982
23983 return ffestb_V0162_; // to lexer
23984
23985 Handle SLASH. */
23986
23987 static ffelexHandler
ffestb_V0162_(ffelexToken t)23988 ffestb_V0162_ (ffelexToken t)
23989 {
23990 switch (ffelex_token_type (t))
23991 {
23992 case FFELEX_typeSLASH:
23993 return (ffelexHandler) ffestb_V0163_;
23994
23995 default:
23996 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
23997 break;
23998 }
23999
24000 if (!ffesta_is_inhibited ())
24001 ffestc_V016_finish ();
24002 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24003 }
24004
24005 /* ffestb_V0163_ -- "RECORD" SLASH NAME SLASH
24006
24007 return ffestb_V0163_; // to lexer
24008
24009 Handle NAME. */
24010
24011 static ffelexHandler
ffestb_V0163_(ffelexToken t)24012 ffestb_V0163_ (ffelexToken t)
24013 {
24014 switch (ffelex_token_type (t))
24015 {
24016 case FFELEX_typeNAME:
24017 ffesta_tokens[1] = ffelex_token_use (t);
24018 return (ffelexHandler) ffestb_V0164_;
24019
24020 default:
24021 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
24022 break;
24023 }
24024
24025 if (!ffesta_is_inhibited ())
24026 ffestc_V016_finish ();
24027 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24028 }
24029
24030 /* ffestb_V0164_ -- "RECORD" ... NAME
24031
24032 return ffestb_V0164_; // to lexer
24033
24034 Handle OPEN_PAREN. */
24035
24036 static ffelexHandler
ffestb_V0164_(ffelexToken t)24037 ffestb_V0164_ (ffelexToken t)
24038 {
24039 switch (ffelex_token_type (t))
24040 {
24041 case FFELEX_typeOPEN_PAREN:
24042 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
24043 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_V0165_;
24044 ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
24045 ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLISTCOMMON;
24046 #ifdef FFECOM_dimensionsMAX
24047 ffestb_subrargs_.dim_list.ndims = 0;
24048 #endif
24049 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
24050 FFEEXPR_contextDIMLISTCOMMON, (ffeexprCallback) ffestb_subr_dimlist_);
24051
24052 case FFELEX_typeCOMMA:
24053 if (!ffesta_is_inhibited ())
24054 ffestc_V016_item_object (ffesta_tokens[1], NULL);
24055 ffelex_token_kill (ffesta_tokens[1]);
24056 return (ffelexHandler) ffestb_V0166_;
24057
24058 case FFELEX_typeEOS:
24059 case FFELEX_typeSEMICOLON:
24060 if (!ffesta_is_inhibited ())
24061 {
24062 ffestc_V016_item_object (ffesta_tokens[1], NULL);
24063 ffestc_V016_finish ();
24064 }
24065 ffelex_token_kill (ffesta_tokens[1]);
24066 return (ffelexHandler) ffesta_zero (t);
24067
24068 default:
24069 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
24070 break;
24071 }
24072
24073 if (!ffesta_is_inhibited ())
24074 ffestc_V016_finish ();
24075 ffelex_token_kill (ffesta_tokens[1]);
24076 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24077 }
24078
24079 /* ffestb_V0165_ -- "RECORD" ... NAME OPEN_PAREN dimlist CLOSE_PAREN
24080
24081 return ffestb_V0165_; // to lexer
24082
24083 Handle COMMA or EOS/SEMICOLON. */
24084
24085 static ffelexHandler
ffestb_V0165_(ffelexToken t)24086 ffestb_V0165_ (ffelexToken t)
24087 {
24088 if (!ffestb_subrargs_.dim_list.ok)
24089 goto bad; /* :::::::::::::::::::: */
24090
24091 switch (ffelex_token_type (t))
24092 {
24093 case FFELEX_typeCOMMA:
24094 if (!ffesta_is_inhibited ())
24095 ffestc_V016_item_object (ffesta_tokens[1],
24096 ffestb_subrargs_.dim_list.dims);
24097 ffelex_token_kill (ffesta_tokens[1]);
24098 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
24099 return (ffelexHandler) ffestb_V0166_;
24100
24101 case FFELEX_typeEOS:
24102 case FFELEX_typeSEMICOLON:
24103 if (!ffesta_is_inhibited ())
24104 {
24105 ffestc_V016_item_object (ffesta_tokens[1],
24106 ffestb_subrargs_.dim_list.dims);
24107 ffestc_V016_finish ();
24108 }
24109 ffelex_token_kill (ffesta_tokens[1]);
24110 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
24111 return (ffelexHandler) ffesta_zero (t);
24112
24113 default:
24114 break;
24115 }
24116
24117 bad: /* :::::::::::::::::::: */
24118 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
24119 if (ffestb_local_.structure.started && !ffesta_is_inhibited ())
24120 ffestc_V016_finish ();
24121 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
24122 ffelex_token_kill (ffesta_tokens[1]);
24123 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24124 }
24125
24126 /* ffestb_V0166_ -- "RECORD" SLASH NAME SLASH NAME [OPEN_PAREN dimlist
24127 CLOSE_PAREN] COMMA
24128
24129 return ffestb_V0166_; // to lexer
24130
24131 Handle NAME or SLASH. */
24132
24133 static ffelexHandler
ffestb_V0166_(ffelexToken t)24134 ffestb_V0166_ (ffelexToken t)
24135 {
24136 switch (ffelex_token_type (t))
24137 {
24138 case FFELEX_typeNAME:
24139 ffesta_tokens[1] = ffelex_token_use (t);
24140 return (ffelexHandler) ffestb_V0164_;
24141
24142 case FFELEX_typeSLASH:
24143 return (ffelexHandler) ffestb_V0161_;
24144
24145 default:
24146 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
24147 break;
24148 }
24149
24150 if (!ffesta_is_inhibited ())
24151 ffestc_V016_finish ();
24152 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24153 }
24154
24155 #endif
24156 /* ffestb_V027 -- Parse the VXT PARAMETER statement
24157
24158 return ffestb_V027; // to lexer
24159
24160 Make sure the statement has a valid form for the VXT PARAMETER statement.
24161 If it does, implement the statement. */
24162
24163 ffelexHandler
ffestb_V027(ffelexToken t)24164 ffestb_V027 (ffelexToken t)
24165 {
24166 unsigned const char *p;
24167 ffeTokenLength i;
24168
24169 switch (ffelex_token_type (ffesta_tokens[0]))
24170 {
24171 case FFELEX_typeNAME:
24172 if (ffesta_first_kw != FFESTR_firstPARAMETER)
24173 goto bad_0; /* :::::::::::::::::::: */
24174 switch (ffelex_token_type (t))
24175 {
24176 case FFELEX_typeNAME:
24177 break;
24178
24179 default:
24180 goto bad_1; /* :::::::::::::::::::: */
24181 }
24182 ffesta_confirmed ();
24183 ffestb_local_.vxtparam.started = TRUE;
24184 if (!ffesta_is_inhibited ())
24185 ffestc_V027_start ();
24186 ffesta_tokens[1] = ffelex_token_use (t);
24187 return (ffelexHandler) ffestb_V0271_;
24188
24189 case FFELEX_typeNAMES:
24190 if (ffesta_first_kw != FFESTR_firstPARAMETER)
24191 goto bad_0; /* :::::::::::::::::::: */
24192 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlPARAMETER);
24193 switch (ffelex_token_type (t))
24194 {
24195 case FFELEX_typeEQUALS:
24196 break;
24197
24198 default:
24199 goto bad_1; /* :::::::::::::::::::: */
24200 }
24201 if (!ffesrc_is_name_init (*p))
24202 goto bad_i; /* :::::::::::::::::::: */
24203 ffestb_local_.vxtparam.started = FALSE;
24204 ffesta_tokens[1] = ffelex_token_name_from_names (ffesta_tokens[0], i,
24205 0);
24206 return (ffelexHandler) ffestb_V0271_ (t);
24207
24208 default:
24209 goto bad_0; /* :::::::::::::::::::: */
24210 }
24211
24212 bad_0: /* :::::::::::::::::::: */
24213 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", ffesta_tokens[0]);
24214 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24215
24216 bad_1: /* :::::::::::::::::::: */
24217 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
24218 return (ffelexHandler) ffelex_swallow_tokens (t,
24219 (ffelexHandler) ffesta_zero); /* Invalid second token. */
24220
24221 bad_i: /* :::::::::::::::::::: */
24222 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "PARAMETER", ffesta_tokens[0], i, t);
24223 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24224 }
24225
24226 /* ffestb_V0271_ -- "PARAMETER" NAME
24227
24228 return ffestb_V0271_; // to lexer
24229
24230 Handle EQUALS. */
24231
24232 static ffelexHandler
ffestb_V0271_(ffelexToken t)24233 ffestb_V0271_ (ffelexToken t)
24234 {
24235 switch (ffelex_token_type (t))
24236 {
24237 case FFELEX_typeEQUALS:
24238 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
24239 FFEEXPR_contextPARAMETER, (ffeexprCallback) ffestb_V0272_);
24240
24241 default:
24242 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
24243 break;
24244 }
24245
24246 ffelex_token_kill (ffesta_tokens[1]);
24247 if (ffestb_local_.vxtparam.started && !ffesta_is_inhibited ())
24248 ffestc_V027_finish ();
24249 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24250 }
24251
24252 /* ffestb_V0272_ -- "PARAMETER" NAME EQUALS expr
24253
24254 (ffestb_V0272_) // to expression handler
24255
24256 Handle COMMA or EOS/SEMICOLON. */
24257
24258 static ffelexHandler
ffestb_V0272_(ffelexToken ft,ffebld expr,ffelexToken t)24259 ffestb_V0272_ (ffelexToken ft, ffebld expr, ffelexToken t)
24260 {
24261 switch (ffelex_token_type (t))
24262 {
24263 case FFELEX_typeEOS:
24264 case FFELEX_typeSEMICOLON:
24265 if (!ffestb_local_.vxtparam.started)
24266 {
24267 if (ffestc_is_let_not_V027 ())
24268 break; /* Not a valid VXTPARAMETER stmt. */
24269 ffesta_confirmed ();
24270 if (!ffesta_is_inhibited ())
24271 ffestc_V027_start ();
24272 ffestb_local_.vxtparam.started = TRUE;
24273 }
24274 if (expr == NULL)
24275 break;
24276 if (!ffesta_is_inhibited ())
24277 {
24278 ffestc_V027_item (ffesta_tokens[1], expr, ft);
24279 ffestc_V027_finish ();
24280 }
24281 ffelex_token_kill (ffesta_tokens[1]);
24282 return (ffelexHandler) ffesta_zero (t);
24283
24284 case FFELEX_typeCOMMA:
24285 ffesta_confirmed ();
24286 if (!ffestb_local_.vxtparam.started)
24287 {
24288 if (!ffesta_is_inhibited ())
24289 ffestc_V027_start ();
24290 ffestb_local_.vxtparam.started = TRUE;
24291 }
24292 if (expr == NULL)
24293 break;
24294 if (!ffesta_is_inhibited ())
24295 ffestc_V027_item (ffesta_tokens[1], expr, ft);
24296 ffelex_token_kill (ffesta_tokens[1]);
24297 return (ffelexHandler) ffestb_V0273_;
24298
24299 default:
24300 break;
24301 }
24302
24303 ffelex_token_kill (ffesta_tokens[1]);
24304 if (ffestb_local_.vxtparam.started && !ffesta_is_inhibited ())
24305 ffestc_V027_finish ();
24306 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
24307 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24308 }
24309
24310 /* ffestb_V0273_ -- "PARAMETER" NAME EQUALS expr COMMA
24311
24312 return ffestb_V0273_; // to lexer
24313
24314 Handle NAME. */
24315
24316 static ffelexHandler
ffestb_V0273_(ffelexToken t)24317 ffestb_V0273_ (ffelexToken t)
24318 {
24319 switch (ffelex_token_type (t))
24320 {
24321 case FFELEX_typeNAME:
24322 ffesta_tokens[1] = ffelex_token_use (t);
24323 return (ffelexHandler) ffestb_V0271_;
24324
24325 default:
24326 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
24327 break;
24328 }
24329
24330 if (ffestb_local_.vxtparam.started && !ffesta_is_inhibited ())
24331 ffestc_V027_finish ();
24332 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24333 }
24334
24335 /* ffestb_decl_R539 -- Parse the IMPLICIT FUNCTION statement
24336
24337 return ffestb_decl_R539; // to lexer
24338
24339 Make sure the statement has a valid form for the IMPLICIT
24340 statement. If it does, implement the statement. */
24341
24342 ffelexHandler
ffestb_decl_R539(ffelexToken t)24343 ffestb_decl_R539 (ffelexToken t)
24344 {
24345 ffeTokenLength i;
24346 unsigned const char *p;
24347 ffelexToken nt;
24348 ffestrSecond kw;
24349
24350 ffestb_local_.decl.recursive = NULL;
24351
24352 switch (ffelex_token_type (ffesta_tokens[0]))
24353 {
24354 case FFELEX_typeNAME:
24355 if (ffesta_first_kw != FFESTR_firstIMPLICIT)
24356 goto bad_0; /* :::::::::::::::::::: */
24357 switch (ffelex_token_type (t))
24358 {
24359 case FFELEX_typeEOS:
24360 case FFELEX_typeSEMICOLON:
24361 case FFELEX_typeCOMMA:
24362 case FFELEX_typeCOLONCOLON:
24363 ffesta_confirmed (); /* Error, but clearly intended. */
24364 goto bad_1; /* :::::::::::::::::::: */
24365
24366 default:
24367 goto bad_1; /* :::::::::::::::::::: */
24368
24369 case FFELEX_typeNAME:
24370 break;
24371 }
24372 ffesta_confirmed ();
24373 ffestb_local_.decl.imp_started = FALSE;
24374 switch (ffesta_second_kw)
24375 {
24376 case FFESTR_secondINTEGER:
24377 ffestb_local_.decl.type = FFESTP_typeINTEGER;
24378 return (ffelexHandler) ffestb_decl_R5391_;
24379
24380 case FFESTR_secondBYTE:
24381 ffestb_local_.decl.type = FFESTP_typeBYTE;
24382 return (ffelexHandler) ffestb_decl_R5391_;
24383
24384 case FFESTR_secondWORD:
24385 ffestb_local_.decl.type = FFESTP_typeWORD;
24386 return (ffelexHandler) ffestb_decl_R5391_;
24387
24388 case FFESTR_secondREAL:
24389 ffestb_local_.decl.type = FFESTP_typeREAL;
24390 return (ffelexHandler) ffestb_decl_R5391_;
24391
24392 case FFESTR_secondCOMPLEX:
24393 ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
24394 return (ffelexHandler) ffestb_decl_R5391_;
24395
24396 case FFESTR_secondLOGICAL:
24397 ffestb_local_.decl.type = FFESTP_typeLOGICAL;
24398 return (ffelexHandler) ffestb_decl_R5391_;
24399
24400 case FFESTR_secondCHARACTER:
24401 ffestb_local_.decl.type = FFESTP_typeCHARACTER;
24402 return (ffelexHandler) ffestb_decl_R5391_;
24403
24404 case FFESTR_secondDOUBLE:
24405 return (ffelexHandler) ffestb_decl_R5392_;
24406
24407 case FFESTR_secondDOUBLEPRECISION:
24408 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
24409 ffestb_local_.decl.kind = NULL;
24410 ffestb_local_.decl.kindt = NULL;
24411 ffestb_local_.decl.len = NULL;
24412 ffestb_local_.decl.lent = NULL;
24413 return (ffelexHandler) ffestb_decl_R539letters_;
24414
24415 case FFESTR_secondDOUBLECOMPLEX:
24416 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
24417 ffestb_local_.decl.kind = NULL;
24418 ffestb_local_.decl.kindt = NULL;
24419 ffestb_local_.decl.len = NULL;
24420 ffestb_local_.decl.lent = NULL;
24421 return (ffelexHandler) ffestb_decl_R539letters_;
24422
24423 case FFESTR_secondNONE:
24424 return (ffelexHandler) ffestb_decl_R5394_;
24425
24426 #if FFESTR_F90
24427 case FFESTR_secondTYPE:
24428 ffestb_local_.decl.type = FFESTP_typeTYPE;
24429 return (ffelexHandler) ffestb_decl_R5393_;
24430 #endif
24431
24432 default:
24433 goto bad_1; /* :::::::::::::::::::: */
24434 }
24435
24436 case FFELEX_typeNAMES:
24437 if (ffesta_first_kw != FFESTR_firstIMPLICIT)
24438 goto bad_0; /* :::::::::::::::::::: */
24439 switch (ffelex_token_type (t))
24440 {
24441 case FFELEX_typeCOMMA:
24442 case FFELEX_typeCOLONCOLON:
24443 case FFELEX_typeASTERISK:
24444 case FFELEX_typeSEMICOLON:
24445 case FFELEX_typeEOS:
24446 ffesta_confirmed ();
24447 break;
24448
24449 case FFELEX_typeOPEN_PAREN:
24450 break;
24451
24452 default:
24453 goto bad_1; /* :::::::::::::::::::: */
24454 }
24455 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlIMPLICIT);
24456 if (!ffesrc_is_name_init (*p))
24457 goto bad_0; /* :::::::::::::::::::: */
24458 ffestb_local_.decl.imp_started = FALSE;
24459 nt = ffelex_token_name_from_names (ffesta_tokens[0],
24460 FFESTR_firstlIMPLICIT, 0);
24461 kw = ffestr_second (nt);
24462 ffelex_token_kill (nt);
24463 switch (kw)
24464 {
24465 case FFESTR_secondINTEGER:
24466 ffestb_local_.decl.type = FFESTP_typeINTEGER;
24467 return (ffelexHandler) ffestb_decl_R5391_ (t);
24468
24469 case FFESTR_secondBYTE:
24470 ffestb_local_.decl.type = FFESTP_typeBYTE;
24471 return (ffelexHandler) ffestb_decl_R5391_ (t);
24472
24473 case FFESTR_secondWORD:
24474 ffestb_local_.decl.type = FFESTP_typeWORD;
24475 return (ffelexHandler) ffestb_decl_R5391_ (t);
24476
24477 case FFESTR_secondREAL:
24478 ffestb_local_.decl.type = FFESTP_typeREAL;
24479 return (ffelexHandler) ffestb_decl_R5391_ (t);
24480
24481 case FFESTR_secondCOMPLEX:
24482 ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
24483 return (ffelexHandler) ffestb_decl_R5391_ (t);
24484
24485 case FFESTR_secondLOGICAL:
24486 ffestb_local_.decl.type = FFESTP_typeLOGICAL;
24487 return (ffelexHandler) ffestb_decl_R5391_ (t);
24488
24489 case FFESTR_secondCHARACTER:
24490 ffestb_local_.decl.type = FFESTP_typeCHARACTER;
24491 return (ffelexHandler) ffestb_decl_R5391_ (t);
24492
24493 case FFESTR_secondDOUBLEPRECISION:
24494 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
24495 ffestb_local_.decl.kind = NULL;
24496 ffestb_local_.decl.kindt = NULL;
24497 ffestb_local_.decl.len = NULL;
24498 ffestb_local_.decl.lent = NULL;
24499 return (ffelexHandler) ffestb_decl_R539letters_ (t);
24500
24501 case FFESTR_secondDOUBLECOMPLEX:
24502 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
24503 ffestb_local_.decl.kind = NULL;
24504 ffestb_local_.decl.kindt = NULL;
24505 ffestb_local_.decl.len = NULL;
24506 ffestb_local_.decl.lent = NULL;
24507 return (ffelexHandler) ffestb_decl_R539letters_ (t);
24508
24509 case FFESTR_secondNONE:
24510 return (ffelexHandler) ffestb_decl_R5394_ (t);
24511
24512 #if FFESTR_F90
24513 case FFESTR_secondTYPE:
24514 ffestb_local_.decl.type = FFESTP_typeTYPE;
24515 return (ffelexHandler) ffestb_decl_R5393_ (t);
24516 #endif
24517
24518 default:
24519 goto bad_1; /* :::::::::::::::::::: */
24520 }
24521
24522 default:
24523 goto bad_0; /* :::::::::::::::::::: */
24524 }
24525
24526 bad_0: /* :::::::::::::::::::: */
24527 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", ffesta_tokens[0]);
24528 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24529
24530 bad_1: /* :::::::::::::::::::: */
24531 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24532 return (ffelexHandler) ffelex_swallow_tokens (t,
24533 (ffelexHandler) ffesta_zero); /* Invalid second token. */
24534 }
24535
24536 /* ffestb_decl_R5391_ -- "IMPLICIT" generic-type
24537
24538 return ffestb_decl_R5391_; // to lexer
24539
24540 Handle ASTERISK or OPEN_PAREN. */
24541
24542 static ffelexHandler
ffestb_decl_R5391_(ffelexToken t)24543 ffestb_decl_R5391_ (ffelexToken t)
24544 {
24545 switch (ffelex_token_type (t))
24546 {
24547 case FFELEX_typeASTERISK:
24548 ffesta_confirmed ();
24549 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_R539letters_;
24550 ffestb_local_.decl.badname = "IMPLICIT";
24551 if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
24552 return (ffelexHandler) ffestb_decl_starlen_;
24553 return (ffelexHandler) ffestb_decl_starkind_;
24554
24555 case FFELEX_typeOPEN_PAREN:
24556 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_R539letters_;
24557 ffestb_local_.decl.badname = "IMPLICIT";
24558 ffestb_local_.decl.kind = NULL;
24559 ffestb_local_.decl.kindt = NULL;
24560 ffestb_local_.decl.len = NULL;
24561 ffestb_local_.decl.lent = NULL;
24562 if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
24563 ffestb_local_.decl.imp_handler
24564 = (ffelexHandler) ffestb_decl_typeparams_;
24565 else
24566 ffestb_local_.decl.imp_handler
24567 = (ffelexHandler) ffestb_decl_kindparam_;
24568 return (ffelexHandler) ffestb_decl_R539maybe_ (t);
24569
24570 default:
24571 break;
24572 }
24573
24574 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24575 ffestc_R539finish ();
24576 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24577 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24578 }
24579
24580 /* ffestb_decl_R5392_ -- "IMPLICIT" "DOUBLE"
24581
24582 return ffestb_decl_R5392_; // to lexer
24583
24584 Handle NAME. */
24585
24586 static ffelexHandler
ffestb_decl_R5392_(ffelexToken t)24587 ffestb_decl_R5392_ (ffelexToken t)
24588 {
24589 switch (ffelex_token_type (t))
24590 {
24591 case FFELEX_typeNAME:
24592 switch (ffestr_second (t))
24593 {
24594 case FFESTR_secondPRECISION:
24595 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
24596 break;
24597
24598 case FFESTR_secondCOMPLEX:
24599 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
24600 break;
24601
24602 default:
24603 goto bad; /* :::::::::::::::::::: */
24604 }
24605 ffestb_local_.decl.kind = NULL;
24606 ffestb_local_.decl.kindt = NULL;
24607 ffestb_local_.decl.len = NULL;
24608 ffestb_local_.decl.lent = NULL;
24609 return (ffelexHandler) ffestb_decl_R539letters_;
24610
24611 default:
24612 break;
24613 }
24614
24615 bad: /* :::::::::::::::::::: */
24616 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24617 ffestc_R539finish ();
24618 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24619 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24620 }
24621
24622 /* ffestb_decl_R5393_ -- "IMPLICIT" "TYPE"
24623
24624 return ffestb_decl_R5393_; // to lexer
24625
24626 Handle OPEN_PAREN. */
24627
24628 #if FFESTR_F90
24629 static ffelexHandler
ffestb_decl_R5393_(ffelexToken t)24630 ffestb_decl_R5393_ (ffelexToken t)
24631 {
24632 switch (ffelex_token_type (t))
24633 {
24634 case FFELEX_typeOPEN_PAREN:
24635 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_R539letters_;
24636 ffestb_local_.decl.badname = "IMPLICIT";
24637 return (ffelexHandler) ffestb_decl_typetype1_;
24638
24639 default:
24640 break;
24641 }
24642
24643 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24644 ffestc_R539finish ();
24645 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24646 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24647 }
24648
24649 #endif
24650 /* ffestb_decl_R5394_ -- "IMPLICIT" "NONE"
24651
24652 return ffestb_decl_R5394_; // to lexer
24653
24654 Handle EOS/SEMICOLON. */
24655
24656 static ffelexHandler
ffestb_decl_R5394_(ffelexToken t)24657 ffestb_decl_R5394_ (ffelexToken t)
24658 {
24659 switch (ffelex_token_type (t))
24660 {
24661 case FFELEX_typeEOS:
24662 case FFELEX_typeSEMICOLON:
24663 ffesta_confirmed ();
24664 if (!ffesta_is_inhibited ())
24665 ffestc_R539 (); /* IMPLICIT NONE. */
24666 return (ffelexHandler) ffesta_zero (t);
24667
24668 default:
24669 break;
24670 }
24671
24672 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24673 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24674 }
24675
24676 /* ffestb_decl_R5395_ -- "IMPLICIT" implicit-spec-list COMMA
24677
24678 return ffestb_decl_R5395_; // to lexer
24679
24680 Handle NAME for next type-spec. */
24681
24682 static ffelexHandler
ffestb_decl_R5395_(ffelexToken t)24683 ffestb_decl_R5395_ (ffelexToken t)
24684 {
24685 switch (ffelex_token_type (t))
24686 {
24687 case FFELEX_typeNAME:
24688 switch (ffestr_second (t))
24689 {
24690 case FFESTR_secondINTEGER:
24691 ffestb_local_.decl.type = FFESTP_typeINTEGER;
24692 return (ffelexHandler) ffestb_decl_R5391_;
24693
24694 case FFESTR_secondBYTE:
24695 ffestb_local_.decl.type = FFESTP_typeBYTE;
24696 return (ffelexHandler) ffestb_decl_R5391_;
24697
24698 case FFESTR_secondWORD:
24699 ffestb_local_.decl.type = FFESTP_typeWORD;
24700 return (ffelexHandler) ffestb_decl_R5391_;
24701
24702 case FFESTR_secondREAL:
24703 ffestb_local_.decl.type = FFESTP_typeREAL;
24704 return (ffelexHandler) ffestb_decl_R5391_;
24705
24706 case FFESTR_secondCOMPLEX:
24707 ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
24708 return (ffelexHandler) ffestb_decl_R5391_;
24709
24710 case FFESTR_secondLOGICAL:
24711 ffestb_local_.decl.type = FFESTP_typeLOGICAL;
24712 return (ffelexHandler) ffestb_decl_R5391_;
24713
24714 case FFESTR_secondCHARACTER:
24715 ffestb_local_.decl.type = FFESTP_typeCHARACTER;
24716 return (ffelexHandler) ffestb_decl_R5391_;
24717
24718 case FFESTR_secondDOUBLE:
24719 return (ffelexHandler) ffestb_decl_R5392_;
24720
24721 case FFESTR_secondDOUBLEPRECISION:
24722 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
24723 ffestb_local_.decl.kind = NULL;
24724 ffestb_local_.decl.kindt = NULL;
24725 ffestb_local_.decl.len = NULL;
24726 ffestb_local_.decl.lent = NULL;
24727 return (ffelexHandler) ffestb_decl_R539letters_;
24728
24729 case FFESTR_secondDOUBLECOMPLEX:
24730 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
24731 ffestb_local_.decl.kind = NULL;
24732 ffestb_local_.decl.kindt = NULL;
24733 ffestb_local_.decl.len = NULL;
24734 ffestb_local_.decl.lent = NULL;
24735 return (ffelexHandler) ffestb_decl_R539letters_;
24736
24737 #if FFESTR_F90
24738 case FFESTR_secondTYPE:
24739 ffestb_local_.decl.type = FFESTP_typeTYPE;
24740 return (ffelexHandler) ffestb_decl_R5393_;
24741 #endif
24742
24743 default:
24744 break;
24745 }
24746 break;
24747
24748 default:
24749 break;
24750 }
24751
24752 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24753 ffestc_R539finish ();
24754 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24755 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24756 }
24757
24758 /* ffestb_decl_R539letters_ -- "IMPLICIT" type-spec
24759
24760 return ffestb_decl_R539letters_; // to lexer
24761
24762 Handle OPEN_PAREN. */
24763
24764 static ffelexHandler
ffestb_decl_R539letters_(ffelexToken t)24765 ffestb_decl_R539letters_ (ffelexToken t)
24766 {
24767 ffelex_set_names (FALSE);
24768
24769 switch (ffelex_token_type (t))
24770 {
24771 case FFELEX_typeOPEN_PAREN:
24772 ffestb_local_.decl.imps = ffestt_implist_create ();
24773 return (ffelexHandler) ffestb_decl_R539letters_1_;
24774
24775 default:
24776 break;
24777 }
24778
24779 if (ffestb_local_.decl.kindt != NULL)
24780 ffelex_token_kill (ffestb_local_.decl.kindt);
24781 if (ffestb_local_.decl.lent != NULL)
24782 ffelex_token_kill (ffestb_local_.decl.lent);
24783 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24784 ffestc_R539finish ();
24785 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24786 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24787 }
24788
24789 /* ffestb_decl_R539letters_1_ -- "IMPLICIT" type-spec OPEN_PAREN
24790
24791 return ffestb_decl_R539letters_1_; // to lexer
24792
24793 Handle NAME. */
24794
24795 static ffelexHandler
ffestb_decl_R539letters_1_(ffelexToken t)24796 ffestb_decl_R539letters_1_ (ffelexToken t)
24797 {
24798 switch (ffelex_token_type (t))
24799 {
24800 case FFELEX_typeNAME:
24801 if (ffelex_token_length (t) != 1)
24802 break;
24803 ffesta_tokens[1] = ffelex_token_use (t);
24804 return (ffelexHandler) ffestb_decl_R539letters_2_;
24805
24806 default:
24807 break;
24808 }
24809
24810 ffestt_implist_kill (ffestb_local_.decl.imps);
24811 if (ffestb_local_.decl.kindt != NULL)
24812 ffelex_token_kill (ffestb_local_.decl.kindt);
24813 if (ffestb_local_.decl.lent != NULL)
24814 ffelex_token_kill (ffestb_local_.decl.lent);
24815 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24816 ffestc_R539finish ();
24817 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24818 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24819 }
24820
24821 /* ffestb_decl_R539letters_2_ -- "IMPLICIT" type-spec OPEN_PAREN NAME
24822
24823 return ffestb_decl_R539letters_2_; // to lexer
24824
24825 Handle COMMA or MINUS. */
24826
24827 static ffelexHandler
ffestb_decl_R539letters_2_(ffelexToken t)24828 ffestb_decl_R539letters_2_ (ffelexToken t)
24829 {
24830 switch (ffelex_token_type (t))
24831 {
24832 case FFELEX_typeCOMMA:
24833 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
24834 return (ffelexHandler) ffestb_decl_R539letters_1_;
24835
24836 case FFELEX_typeCLOSE_PAREN:
24837 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
24838 return (ffelexHandler) ffestb_decl_R539letters_5_;
24839
24840 case FFELEX_typeMINUS:
24841 return (ffelexHandler) ffestb_decl_R539letters_3_;
24842
24843 default:
24844 break;
24845 }
24846
24847 ffelex_token_kill (ffesta_tokens[1]);
24848 ffestt_implist_kill (ffestb_local_.decl.imps);
24849 if (ffestb_local_.decl.kindt != NULL)
24850 ffelex_token_kill (ffestb_local_.decl.kindt);
24851 if (ffestb_local_.decl.lent != NULL)
24852 ffelex_token_kill (ffestb_local_.decl.lent);
24853 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24854 ffestc_R539finish ();
24855 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24856 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24857 }
24858
24859 /* ffestb_decl_R539letters_3_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
24860
24861 return ffestb_decl_R539letters_3_; // to lexer
24862
24863 Handle NAME. */
24864
24865 static ffelexHandler
ffestb_decl_R539letters_3_(ffelexToken t)24866 ffestb_decl_R539letters_3_ (ffelexToken t)
24867 {
24868 switch (ffelex_token_type (t))
24869 {
24870 case FFELEX_typeNAME:
24871 if (ffelex_token_length (t) != 1)
24872 break;
24873 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1],
24874 ffelex_token_use (t));
24875 return (ffelexHandler) ffestb_decl_R539letters_4_;
24876
24877 default:
24878 break;
24879 }
24880
24881 ffelex_token_kill (ffesta_tokens[1]);
24882 ffestt_implist_kill (ffestb_local_.decl.imps);
24883 if (ffestb_local_.decl.kindt != NULL)
24884 ffelex_token_kill (ffestb_local_.decl.kindt);
24885 if (ffestb_local_.decl.lent != NULL)
24886 ffelex_token_kill (ffestb_local_.decl.lent);
24887 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24888 ffestc_R539finish ();
24889 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24890 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24891 }
24892
24893 /* ffestb_decl_R539letters_4_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
24894 NAME
24895
24896 return ffestb_decl_R539letters_4_; // to lexer
24897
24898 Handle COMMA or CLOSE_PAREN. */
24899
24900 static ffelexHandler
ffestb_decl_R539letters_4_(ffelexToken t)24901 ffestb_decl_R539letters_4_ (ffelexToken t)
24902 {
24903 switch (ffelex_token_type (t))
24904 {
24905 case FFELEX_typeCOMMA:
24906 return (ffelexHandler) ffestb_decl_R539letters_1_;
24907
24908 case FFELEX_typeCLOSE_PAREN:
24909 return (ffelexHandler) ffestb_decl_R539letters_5_;
24910
24911 default:
24912 break;
24913 }
24914
24915 ffestt_implist_kill (ffestb_local_.decl.imps);
24916 if (ffestb_local_.decl.kindt != NULL)
24917 ffelex_token_kill (ffestb_local_.decl.kindt);
24918 if (ffestb_local_.decl.lent != NULL)
24919 ffelex_token_kill (ffestb_local_.decl.lent);
24920 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24921 ffestc_R539finish ();
24922 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24923 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24924 }
24925
24926 /* ffestb_decl_R539letters_5_ -- "IMPLICIT" type-spec OPEN_PAREN
24927 letter-spec-list CLOSE_PAREN
24928
24929 return ffestb_decl_R539letters_5_; // to lexer
24930
24931 Handle COMMA or EOS/SEMICOLON. */
24932
24933 static ffelexHandler
ffestb_decl_R539letters_5_(ffelexToken t)24934 ffestb_decl_R539letters_5_ (ffelexToken t)
24935 {
24936 switch (ffelex_token_type (t))
24937 {
24938 case FFELEX_typeCOMMA:
24939 case FFELEX_typeEOS:
24940 case FFELEX_typeSEMICOLON:
24941 if (!ffestb_local_.decl.imp_started)
24942 {
24943 ffestb_local_.decl.imp_started = TRUE;
24944 ffesta_confirmed ();
24945 if (!ffesta_is_inhibited ())
24946 ffestc_R539start ();
24947 }
24948 if (!ffesta_is_inhibited ())
24949 ffestc_R539item (ffestb_local_.decl.type, ffestb_local_.decl.kind,
24950 ffestb_local_.decl.kindt, ffestb_local_.decl.len,
24951 ffestb_local_.decl.lent, ffestb_local_.decl.imps);
24952 if (ffestb_local_.decl.kindt != NULL)
24953 ffelex_token_kill (ffestb_local_.decl.kindt);
24954 if (ffestb_local_.decl.lent != NULL)
24955 ffelex_token_kill (ffestb_local_.decl.lent);
24956 ffestt_implist_kill (ffestb_local_.decl.imps);
24957 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
24958 return (ffelexHandler) ffestb_decl_R5395_;
24959 if (!ffesta_is_inhibited ())
24960 ffestc_R539finish ();
24961 return (ffelexHandler) ffesta_zero (t);
24962
24963 default:
24964 break;
24965 }
24966
24967 ffestt_implist_kill (ffestb_local_.decl.imps);
24968 if (ffestb_local_.decl.kindt != NULL)
24969 ffelex_token_kill (ffestb_local_.decl.kindt);
24970 if (ffestb_local_.decl.lent != NULL)
24971 ffelex_token_kill (ffestb_local_.decl.lent);
24972 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
24973 ffestc_R539finish ();
24974 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
24975 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
24976 }
24977
24978 /* ffestb_decl_R539maybe_ -- "IMPLICIT" generic-type-spec
24979
24980 return ffestb_decl_R539maybe_; // to lexer
24981
24982 Handle OPEN_PAREN. */
24983
24984 static ffelexHandler
ffestb_decl_R539maybe_(ffelexToken t)24985 ffestb_decl_R539maybe_ (ffelexToken t)
24986 {
24987 assert (ffelex_token_type (t) == FFELEX_typeOPEN_PAREN);
24988 ffestb_local_.decl.imps = ffestt_implist_create ();
24989 ffestb_local_.decl.toklist = ffestt_tokenlist_create ();
24990 ffestb_local_.decl.imp_seen_comma
24991 = (ffestb_local_.decl.type != FFESTP_typeCHARACTER);
24992 return (ffelexHandler) ffestb_decl_R539maybe_1_;
24993 }
24994
24995 /* ffestb_decl_R539maybe_1_ -- "IMPLICIT" generic-type-spec OPEN_PAREN
24996
24997 return ffestb_decl_R539maybe_1_; // to lexer
24998
24999 Handle NAME. */
25000
25001 static ffelexHandler
ffestb_decl_R539maybe_1_(ffelexToken t)25002 ffestb_decl_R539maybe_1_ (ffelexToken t)
25003 {
25004 ffelexHandler next;
25005
25006 switch (ffelex_token_type (t))
25007 {
25008 case FFELEX_typeNAME:
25009 if (ffelex_token_length (t) != 1)
25010 break;
25011 ffesta_tokens[1] = ffelex_token_use (t);
25012 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
25013 return (ffelexHandler) ffestb_decl_R539maybe_2_;
25014
25015 default:
25016 break;
25017 }
25018
25019 ffestt_implist_kill (ffestb_local_.decl.imps);
25020 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
25021 (ffelexHandler) ffestb_local_.decl.imp_handler);
25022 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
25023 return (ffelexHandler) (*next) (t);
25024 }
25025
25026 /* ffestb_decl_R539maybe_2_ -- "IMPLICIT" generic-type-spec OPEN_PAREN NAME
25027
25028 return ffestb_decl_R539maybe_2_; // to lexer
25029
25030 Handle COMMA or MINUS. */
25031
25032 static ffelexHandler
ffestb_decl_R539maybe_2_(ffelexToken t)25033 ffestb_decl_R539maybe_2_ (ffelexToken t)
25034 {
25035 ffelexHandler next;
25036
25037 switch (ffelex_token_type (t))
25038 {
25039 case FFELEX_typeCOMMA:
25040 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
25041 if (ffestb_local_.decl.imp_seen_comma)
25042 {
25043 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
25044 return (ffelexHandler) ffestb_decl_R539letters_1_;
25045 }
25046 ffestb_local_.decl.imp_seen_comma = TRUE;
25047 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
25048 return (ffelexHandler) ffestb_decl_R539maybe_1_;
25049
25050 case FFELEX_typeCLOSE_PAREN:
25051 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
25052 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
25053 return (ffelexHandler) ffestb_decl_R539maybe_5_;
25054
25055 case FFELEX_typeMINUS:
25056 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
25057 return (ffelexHandler) ffestb_decl_R539maybe_3_;
25058
25059 default:
25060 break;
25061 }
25062
25063 ffelex_token_kill (ffesta_tokens[1]);
25064 ffestt_implist_kill (ffestb_local_.decl.imps);
25065 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
25066 (ffelexHandler) ffestb_local_.decl.imp_handler);
25067 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
25068 return (ffelexHandler) (*next) (t);
25069 }
25070
25071 /* ffestb_decl_R539maybe_3_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
25072
25073 return ffestb_decl_R539maybe_3_; // to lexer
25074
25075 Handle NAME. */
25076
25077 static ffelexHandler
ffestb_decl_R539maybe_3_(ffelexToken t)25078 ffestb_decl_R539maybe_3_ (ffelexToken t)
25079 {
25080 ffelexHandler next;
25081
25082 switch (ffelex_token_type (t))
25083 {
25084 case FFELEX_typeNAME:
25085 if (ffelex_token_length (t) != 1)
25086 break;
25087 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1],
25088 ffelex_token_use (t));
25089 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
25090 return (ffelexHandler) ffestb_decl_R539maybe_4_;
25091
25092 default:
25093 break;
25094 }
25095
25096 ffelex_token_kill (ffesta_tokens[1]);
25097 ffestt_implist_kill (ffestb_local_.decl.imps);
25098 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
25099 (ffelexHandler) ffestb_local_.decl.imp_handler);
25100 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
25101 return (ffelexHandler) (*next) (t);
25102 }
25103
25104 /* ffestb_decl_R539maybe_4_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
25105 NAME
25106
25107 return ffestb_decl_R539maybe_4_; // to lexer
25108
25109 Handle COMMA or CLOSE_PAREN. */
25110
25111 static ffelexHandler
ffestb_decl_R539maybe_4_(ffelexToken t)25112 ffestb_decl_R539maybe_4_ (ffelexToken t)
25113 {
25114 ffelexHandler next;
25115
25116 switch (ffelex_token_type (t))
25117 {
25118 case FFELEX_typeCOMMA:
25119 if (ffestb_local_.decl.imp_seen_comma)
25120 {
25121 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
25122 return (ffelexHandler) ffestb_decl_R539letters_1_;
25123 }
25124 ffestb_local_.decl.imp_seen_comma = TRUE;
25125 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
25126 return (ffelexHandler) ffestb_decl_R539maybe_1_;
25127
25128 case FFELEX_typeCLOSE_PAREN:
25129 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
25130 return (ffelexHandler) ffestb_decl_R539maybe_5_;
25131
25132 default:
25133 break;
25134 }
25135
25136 ffestt_implist_kill (ffestb_local_.decl.imps);
25137 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
25138 (ffelexHandler) ffestb_local_.decl.imp_handler);
25139 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
25140 return (ffelexHandler) (*next) (t);
25141 }
25142
25143 /* ffestb_decl_R539maybe_5_ -- "IMPLICIT" type-spec OPEN_PAREN
25144 letter-spec-list CLOSE_PAREN
25145
25146 return ffestb_decl_R539maybe_5_; // to lexer
25147
25148 Handle COMMA or EOS/SEMICOLON. */
25149
25150 static ffelexHandler
ffestb_decl_R539maybe_5_(ffelexToken t)25151 ffestb_decl_R539maybe_5_ (ffelexToken t)
25152 {
25153 ffelexHandler next;
25154
25155 switch (ffelex_token_type (t))
25156 {
25157 case FFELEX_typeCOMMA:
25158 case FFELEX_typeEOS:
25159 case FFELEX_typeSEMICOLON:
25160 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
25161 if (!ffestb_local_.decl.imp_started)
25162 {
25163 ffestb_local_.decl.imp_started = TRUE;
25164 ffesta_confirmed ();
25165 if (!ffesta_is_inhibited ())
25166 ffestc_R539start ();
25167 }
25168 if (!ffesta_is_inhibited ())
25169 ffestc_R539item (ffestb_local_.decl.type, ffestb_local_.decl.kind,
25170 ffestb_local_.decl.kindt, ffestb_local_.decl.len,
25171 ffestb_local_.decl.lent, ffestb_local_.decl.imps);
25172 if (ffestb_local_.decl.kindt != NULL)
25173 ffelex_token_kill (ffestb_local_.decl.kindt);
25174 if (ffestb_local_.decl.lent != NULL)
25175 ffelex_token_kill (ffestb_local_.decl.lent);
25176 ffestt_implist_kill (ffestb_local_.decl.imps);
25177 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
25178 return (ffelexHandler) ffestb_decl_R5395_;
25179 if (!ffesta_is_inhibited ())
25180 ffestc_R539finish ();
25181 return (ffelexHandler) ffesta_zero (t);
25182
25183 case FFELEX_typeOPEN_PAREN:
25184 ffesta_confirmed ();
25185 ffestt_implist_kill (ffestb_local_.decl.imps);
25186 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
25187 (ffelexHandler) ffestb_local_.decl.imp_handler);
25188 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
25189 return (ffelexHandler) (*next) (t);
25190
25191 default:
25192 break;
25193 }
25194
25195 ffestt_implist_kill (ffestb_local_.decl.imps);
25196 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
25197 if (ffestb_local_.decl.kindt != NULL)
25198 ffelex_token_kill (ffestb_local_.decl.kindt);
25199 if (ffestb_local_.decl.lent != NULL)
25200 ffelex_token_kill (ffestb_local_.decl.lent);
25201 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
25202 ffestc_R539finish ();
25203 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
25204 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
25205 }
25206