?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
2003-11-27 Dalibor Topic <robilad@kaffe.org>
[official-gcc.git] / gcc / f / stb.c
blob673f96c23c543a72438d11d9b0382a81f1a58ce2
1 /* stb.c -- Implementation File (module.c template V1.0)
2 Copyright (C) 1995, 1996, 2002, 2003
3 Free Software Foundation, Inc.
4 Contributed by James Craig Burley.
5
6 This file is part of GNU Fortran.
7
8 GNU Fortran is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2, or (at your option)
11 any later version.
12
13 GNU Fortran is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with GNU Fortran; see the file COPYING. If not, write to
20 the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
21 02111-1307, USA.
22
23 Related Modules:
24 st.c
25
26 Description:
27 Parses the proper form for statements, builds up expression trees for
28 them, but does not actually implement them. Uses ffebad (primarily via
29 ffesta_ffebad_start) to indicate errors in form. In many cases, an invalid
30 statement form indicates another possible statement needs to be looked at
31 by ffest. In a few cases, a valid statement form might not completely
32 determine the nature of the statement, as in REALFUNCTIONA(B), which is
33 a valid form for either the first statement of a function named A taking
34 an argument named B or for the declaration of a real array named FUNCTIONA
35 with an adjustable size of B. A similar (though somewhat easier) choice
36 must be made for the statement-function-def vs. assignment forms, as in
37 the case of FOO(A) = A+2.0.
38
39 A given parser consists of one or more state handlers, the first of which
40 is the initial state, and the last of which (for any given input) returns
41 control to a final state handler (ffesta_zero or ffesta_two, explained
42 below). The functions handling the states for a given parser usually have
43 the same names, differing only in the final number, as in ffestb_foo_
44 (handles the initial state), ffestb_foo_1_, ffestb_foo_2_ (handle
45 subsequent states), although liberties sometimes are taken with the "foo"
46 part either when keywords are clarified into given statements or are
47 transferred into other possible areas. (For example, the type-name
48 states can hop over to _dummy_ functions when the FUNCTION or RECURSIVE
49 keywords are seen, though this kind of thing is kept to a minimum.) Only
50 the names without numbers are exported to the rest of ffest; the others
51 are local (static).
52
53 Each initial state is provided with the first token in ffesta_tokens[0],
54 which will be killed upon return to the final state (ffesta_zero or
55 ffelex_swallow_tokens passed through to ffesta_zero), so while it may
56 be changed to another token, a valid token must be left there to be
57 killed. Also, a "convenient" array of tokens are left in
58 ffesta_tokens[1..FFESTA_tokensMAX]. The initial state of this set of
59 elements is undefined, thus, if tokens are stored here, they must be
60 killed before returning to the final state. Any parser may also use
61 cross-state local variables by sticking a structure containing storage
62 for those variables in the local union ffestb_local_ (unless the union
63 goes on strike). Furthermore, parsers that handle more than one first or
64 second tokens (like _varlist_, which handles EXTERNAL, INTENT, INTRINSIC,
65 OPTIONAL,
66 PUBLIC, or PRIVATE, and _endxyz_, which handles ENDBLOCK, ENDBLOCKDATA,
67 ENDDO, ENDIF, and so on) may expect arguments from ffest in the
68 ffest-wide union ffest_args_, the substructure specific to the parser.
69
70 A parser's responsibility is: to call either ffesta_confirmed or
71 ffest_ffebad_start before returning to the final state; to be the only
72 parser that can possibly call ffesta_confirmed for a given statement;
73 to call ffest_ffebad_start immediately upon recognizing a bad token
74 (specifically one that another statement parser might confirm upon);
75 to call ffestc functions only after calling ffesta_confirmed and only
76 when ffesta_is_inhibited returns FALSE; and to call ffesta_is_inhibited
77 only after calling ffesta_confirmed. Confirm as early as reasonably
78 possible, even when only one ffestc function is called for the statement
79 later on, because early confirmation can enhance the error-reporting
80 capabilities if a subsequent error is detected and this parser isn't
81 the first possibility for the statement.
82
83 To assist the parser, functions like ffesta_ffebad_1t and _1p_ have
84 been provided to make use of ffest_ffebad_start fairly easy.
85
86 Modifications:
87 */
88
89 /* Include files. */
90
91 #include "proj.h"
92 #include "stb.h"
93 #include "bad.h"
94 #include "expr.h"
95 #include "lex.h"
96 #include "malloc.h"
97 #include "src.h"
98 #include "sta.h"
99 #include "stc.h"
100 #include "stp.h"
101 #include "str.h"
102
103 /* Externals defined here. */
104
105 struct _ffestb_args_ ffestb_args;
106
107 /* Simple definitions and enumerations. */
108
109 #define FFESTB_KILL_EASY_ 1 /* 1 for only one _subr_kill_xyz_ fn. */
110
111 /* Internal typedefs. */
112
113 union ffestb_subrargs_u_
114 {
115 struct
116 {
117 ffesttTokenList labels; /* Input arg, must not be NULL. */
118 ffelexHandler handler; /* Input arg, call me when done. */
119 bool ok; /* Output arg, TRUE if list ended in
120 CLOSE_PAREN. */
121 }
122 label_list;
123 struct
124 {
125 ffesttDimList dims; /* Input arg, must not be NULL. */
126 ffelexHandler handler; /* Input arg, call me when done. */
127 mallocPool pool; /* Pool to allocate into. */
128 bool ok; /* Output arg, TRUE if list ended in
129 CLOSE_PAREN. */
130 ffeexprContext ctx; /* DIMLIST or DIMLISTCOMMON. */
131 #ifdef FFECOM_dimensionsMAX
132 int ndims; /* For backends that really can't have
133 infinite dims. */
134 #endif
135 }
136 dim_list;
137 struct
138 {
139 ffesttTokenList args; /* Input arg, must not be NULL. */
140 ffelexHandler handler; /* Input arg, call me when done. */
141 ffelexToken close_paren;/* Output arg if ok, CLOSE_PAREN token. */
142 bool is_subr; /* Input arg, TRUE if list in subr-def
143 context. */
144 bool ok; /* Output arg, TRUE if list ended in
145 CLOSE_PAREN. */
146 bool names; /* Do ffelex_set_names(TRUE) before return. */
147 }
148 name_list;
149 };
150
151 union ffestb_local_u_
152 {
153 struct
154 {
155 ffebld expr;
156 }
157 call_stmt;
158 struct
159 {
160 ffebld expr;
161 }
162 go_to;
163 struct
164 {
165 ffebld dest;
166 bool vxtparam; /* If assignment might really be VXT
167 PARAMETER stmt. */
168 }
169 let;
170 struct
171 {
172 ffebld expr;
173 }
174 if_stmt;
175 struct
176 {
177 ffebld expr;
178 }
179 else_stmt;
180 struct
181 {
182 ffebld expr;
183 }
184 dowhile;
185 struct
186 {
187 ffebld var;
188 ffebld start;
189 ffebld end;
190 }
191 do_stmt;
192 struct
193 {
194 bool is_cblock;
195 }
196 R522;
197 struct
198 {
199 ffebld expr;
200 bool started;
201 }
202 parameter;
203 struct
204 {
205 ffesttExprList exprs;
206 bool started;
207 }
208 equivalence;
209 struct
210 {
211 ffebld expr;
212 bool started;
213 }
214 data;
215 struct
216 {
217 ffestrOther kw;
218 }
219 varlist;
220 struct
221 {
222 ffelexHandler next;
223 }
224 construct;
225 struct
226 {
227 ffesttFormatList f;
228 ffestpFormatType current; /* What we're currently working on. */
229 ffelexToken t; /* Token of what we're currently working on. */
230 ffesttFormatValue pre;
231 ffesttFormatValue post;
232 ffesttFormatValue dot;
233 ffesttFormatValue exp;
234 bool sign; /* _3_, pos/neg; elsewhere, signed/unsigned. */
235 bool complained; /* If run-time expr seen in nonexec context. */
236 }
237 format;
238 struct
239 {
240 ffebld expr;
241 }
242 selectcase;
243 struct
244 {
245 ffesttCaseList cases;
246 }
247 case_stmt;
248 struct
249 {
250 bool is_cblock;
251 }
252 V014;
253 struct
254 {
255 ffestpBeruIx ix;
256 bool label;
257 bool left;
258 ffeexprContext context;
259 }
260 beru;
261 struct
262 {
263 ffestpCloseIx ix;
264 bool label;
265 bool left;
266 ffeexprContext context;
267 }
268 close;
269 struct
270 {
271 ffestpDeleteIx ix;
272 bool label;
273 bool left;
274 ffeexprContext context;
275 }
276 delete;
277 struct
278 {
279 ffestpDeleteIx ix;
280 bool label;
281 bool left;
282 ffeexprContext context;
283 }
284 find;
285 struct
286 {
287 ffestpInquireIx ix;
288 bool label;
289 bool left;
290 ffeexprContext context;
291 bool may_be_iolength;
292 }
293 inquire;
294 struct
295 {
296 ffestpOpenIx ix;
297 bool label;
298 bool left;
299 ffeexprContext context;
300 }
301 open;
302 struct
303 {
304 ffestpReadIx ix;
305 bool label;
306 bool left;
307 ffeexprContext context;
308 }
309 read;
310 struct
311 {
312 ffestpRewriteIx ix;
313 bool label;
314 bool left;
315 ffeexprContext context;
316 }
317 rewrite;
318 struct
319 {
320 ffestpWriteIx ix;
321 bool label;
322 bool left;
323 ffeexprContext context;
324 }
325 vxtcode;
326 struct
327 {
328 ffestpWriteIx ix;
329 bool label;
330 bool left;
331 ffeexprContext context;
332 }
333 write;
334 struct
335 {
336 bool started;
337 }
338 common;
339 struct
340 {
341 bool started;
342 }
343 dimension;
344 struct
345 {
346 bool started;
347 }
348 dimlist;
349 struct
350 {
351 const char *badname;
352 ffestrFirst first_kw;
353 bool is_subr;
354 }
355 dummy;
356 struct
357 {
358 ffebld kind; /* Kind type parameter, if any. */
359 ffelexToken kindt; /* Kind type first token, if any. */
360 ffebld len; /* Length type parameter, if any. */
361 ffelexToken lent; /* Length type parameter, if any. */
362 ffelexHandler handler;
363 ffelexToken recursive;
364 ffebld expr;
365 ffesttTokenList toklist;/* For ambiguity resolution. */
366 ffesttImpList imps; /* List of IMPLICIT letters. */
367 ffelexHandler imp_handler; /* Call if paren list wasn't letters. */
368 const char *badname;
369 ffestrOther kw; /* INTENT(IN/OUT/INOUT). */
370 ffestpType type;
371 bool parameter; /* If PARAMETER attribute seen (governs =expr
372 context). */
373 bool coloncolon; /* If COLONCOLON seen (allows =expr). */
374 bool aster_after; /* "*" seen after, not before,
375 [RECURSIVE]FUNCTIONxyz. */
376 bool empty; /* Ambig function dummy arg list empty so
377 far? */
378 bool imp_started; /* Started IMPLICIT statement already. */
379 bool imp_seen_comma; /* TRUE if next COMMA within parens means not
380 R541. */
381 }
382 decl;
383 struct
384 {
385 bool started;
386 }
387 vxtparam;
388 }; /* Merge with the one in ffestb later. */
389
390 /* Private include files. */
391
392
393 /* Internal structure definitions. */
394
395
396 /* Static objects accessed by functions in this module. */
397
398 static union ffestb_subrargs_u_ ffestb_subrargs_;
399 static union ffestb_local_u_ ffestb_local_;
400
401 /* Static functions (internal). */
402
403 static void ffestb_subr_ambig_to_ents_ (void);
404 static ffelexHandler ffestb_subr_ambig_nope_ (ffelexToken t);
405 static ffelexHandler ffestb_subr_dimlist_ (ffelexToken ft, ffebld expr,
406 ffelexToken t);
407 static ffelexHandler ffestb_subr_dimlist_1_ (ffelexToken ft, ffebld expr,
408 ffelexToken t);
409 static ffelexHandler ffestb_subr_dimlist_2_ (ffelexToken ft, ffebld expr,
410 ffelexToken t);
411 static ffelexHandler ffestb_subr_name_list_ (ffelexToken t);
412 static ffelexHandler ffestb_subr_name_list_1_ (ffelexToken t);
413 static void ffestb_subr_R1001_append_p_ (void);
414 static ffelexHandler ffestb_decl_kindparam_ (ffelexToken t);
415 static ffelexHandler ffestb_decl_kindparam_1_ (ffelexToken t);
416 static ffelexHandler ffestb_decl_kindparam_2_ (ffelexToken ft, ffebld expr,
417 ffelexToken t);
418 static ffelexHandler ffestb_decl_starkind_ (ffelexToken t);
419 static ffelexHandler ffestb_decl_starlen_ (ffelexToken t);
420 static ffelexHandler ffestb_decl_starlen_1_ (ffelexToken ft, ffebld expr,
421 ffelexToken t);
422 static ffelexHandler ffestb_decl_typeparams_ (ffelexToken t);
423 static ffelexHandler ffestb_decl_typeparams_1_ (ffelexToken t);
424 static ffelexHandler ffestb_decl_typeparams_2_ (ffelexToken ft, ffebld expr,
425 ffelexToken t);
426 static ffelexHandler ffestb_decl_typeparams_3_ (ffelexToken ft, ffebld expr,
427 ffelexToken t);
428 static ffelexHandler ffestb_subr_label_list_ (ffelexToken t);
429 static ffelexHandler ffestb_subr_label_list_1_ (ffelexToken t);
430 static ffelexHandler ffestb_do1_ (ffelexToken t);
431 static ffelexHandler ffestb_do2_ (ffelexToken t);
432 static ffelexHandler ffestb_do3_ (ffelexToken t);
433 static ffelexHandler ffestb_do4_ (ffelexToken ft, ffebld expr,
434 ffelexToken t);
435 static ffelexHandler ffestb_do5_ (ffelexToken t);
436 static ffelexHandler ffestb_do6_ (ffelexToken ft, ffebld expr,
437 ffelexToken t);
438 static ffelexHandler ffestb_do7_ (ffelexToken ft, ffebld expr,
439 ffelexToken t);
440 static ffelexHandler ffestb_do8_ (ffelexToken ft, ffebld expr,
441 ffelexToken t);
442 static ffelexHandler ffestb_do9_ (ffelexToken ft, ffebld expr,
443 ffelexToken t);
444 static ffelexHandler ffestb_else1_ (ffelexToken t);
445 static ffelexHandler ffestb_else2_ (ffelexToken ft, ffebld expr,
446 ffelexToken t);
447 static ffelexHandler ffestb_else3_ (ffelexToken t);
448 static ffelexHandler ffestb_else4_ (ffelexToken t);
449 static ffelexHandler ffestb_else5_ (ffelexToken t);
450 static ffelexHandler ffestb_end1_ (ffelexToken t);
451 static ffelexHandler ffestb_end2_ (ffelexToken t);
452 static ffelexHandler ffestb_end3_ (ffelexToken t);
453 static ffelexHandler ffestb_goto1_ (ffelexToken t);
454 static ffelexHandler ffestb_goto2_ (ffelexToken t);
455 static ffelexHandler ffestb_goto3_ (ffelexToken t);
456 static ffelexHandler ffestb_goto4_ (ffelexToken ft, ffebld expr,
457 ffelexToken t);
458 static ffelexHandler ffestb_goto5_ (ffelexToken ft, ffebld expr,
459 ffelexToken t);
460 static ffelexHandler ffestb_goto6_ (ffelexToken t);
461 static ffelexHandler ffestb_goto7_ (ffelexToken t);
462 static ffelexHandler ffestb_halt1_ (ffelexToken ft, ffebld expr,
463 ffelexToken t);
464 static ffelexHandler ffestb_if1_ (ffelexToken ft, ffebld expr,
465 ffelexToken t);
466 static ffelexHandler ffestb_if2_ (ffelexToken t);
467 static ffelexHandler ffestb_if3_ (ffelexToken t);
468 static ffelexHandler ffestb_let1_ (ffelexToken ft, ffebld expr,
469 ffelexToken t);
470 static ffelexHandler ffestb_let2_ (ffelexToken ft, ffebld expr,
471 ffelexToken t);
472 static ffelexHandler ffestb_varlist5_ (ffelexToken t);
473 static ffelexHandler ffestb_varlist6_ (ffelexToken t);
474 static ffelexHandler ffestb_R5221_ (ffelexToken t);
475 static ffelexHandler ffestb_R5222_ (ffelexToken t);
476 static ffelexHandler ffestb_R5223_ (ffelexToken t);
477 static ffelexHandler ffestb_R5224_ (ffelexToken t);
478 static ffelexHandler ffestb_R5281_ (ffelexToken ft, ffebld expr,
479 ffelexToken t);
480 static ffelexHandler ffestb_R5282_ (ffelexToken ft, ffebld expr,
481 ffelexToken t);
482 static ffelexHandler ffestb_R5283_ (ffelexToken ft, ffebld expr,
483 ffelexToken t);
484 static ffelexHandler ffestb_R5284_ (ffelexToken t);
485 static ffelexHandler ffestb_R5371_ (ffelexToken ft, ffebld expr,
486 ffelexToken t);
487 static ffelexHandler ffestb_R5372_ (ffelexToken ft, ffebld expr,
488 ffelexToken t);
489 static ffelexHandler ffestb_R5373_ (ffelexToken t);
490 static ffelexHandler ffestb_R5421_ (ffelexToken t);
491 static ffelexHandler ffestb_R5422_ (ffelexToken t);
492 static ffelexHandler ffestb_R5423_ (ffelexToken t);
493 static ffelexHandler ffestb_R5424_ (ffelexToken t);
494 static ffelexHandler ffestb_R5425_ (ffelexToken t);
495 static ffelexHandler ffestb_R5441_ (ffelexToken ft, ffebld expr,
496 ffelexToken t);
497 static ffelexHandler ffestb_R5442_ (ffelexToken ft, ffebld expr,
498 ffelexToken t);
499 static ffelexHandler ffestb_R5443_ (ffelexToken t);
500 static ffelexHandler ffestb_R5444_ (ffelexToken t);
501 static ffelexHandler ffestb_R8341_ (ffelexToken t);
502 static ffelexHandler ffestb_R8351_ (ffelexToken t);
503 static ffelexHandler ffestb_R8381_ (ffelexToken t);
504 static ffelexHandler ffestb_R8382_ (ffelexToken t);
505 static ffelexHandler ffestb_R8383_ (ffelexToken ft, ffebld expr,
506 ffelexToken t);
507 static ffelexHandler ffestb_R8401_ (ffelexToken ft, ffebld expr,
508 ffelexToken t);
509 static ffelexHandler ffestb_R8402_ (ffelexToken t);
510 static ffelexHandler ffestb_R8403_ (ffelexToken t);
511 static ffelexHandler ffestb_R8404_ (ffelexToken t);
512 static ffelexHandler ffestb_R8405_ (ffelexToken t);
513 static ffelexHandler ffestb_R8406_ (ffelexToken t);
514 static ffelexHandler ffestb_R8407_ (ffelexToken t);
515 static ffelexHandler ffestb_R11021_ (ffelexToken t);
516 static ffelexHandler ffestb_R1111_1_ (ffelexToken t);
517 static ffelexHandler ffestb_R1111_2_ (ffelexToken t);
518 static ffelexHandler ffestb_R12121_ (ffelexToken ft, ffebld expr,
519 ffelexToken t);
520 static ffelexHandler ffestb_R12271_ (ffelexToken ft, ffebld expr,
521 ffelexToken t);
522 static ffelexHandler ffestb_construct1_ (ffelexToken t);
523 static ffelexHandler ffestb_construct2_ (ffelexToken t);
524 static ffelexHandler ffestb_R8091_ (ffelexToken t);
525 static ffelexHandler ffestb_R8092_ (ffelexToken ft, ffebld expr,
526 ffelexToken t);
527 static ffelexHandler ffestb_R8093_ (ffelexToken t);
528 static ffelexHandler ffestb_R8101_ (ffelexToken t);
529 static ffelexHandler ffestb_R8102_ (ffelexToken t);
530 static ffelexHandler ffestb_R8103_ (ffelexToken ft, ffebld expr,
531 ffelexToken t);
532 static ffelexHandler ffestb_R8104_ (ffelexToken ft, ffebld expr,
533 ffelexToken t);
534 static ffelexHandler ffestb_R10011_ (ffelexToken t);
535 static ffelexHandler ffestb_R10012_ (ffelexToken t);
536 static ffelexHandler ffestb_R10013_ (ffelexToken t);
537 static ffelexHandler ffestb_R10014_ (ffelexToken t);
538 static ffelexHandler ffestb_R10015_ (ffelexToken t);
539 static ffelexHandler ffestb_R10016_ (ffelexToken t);
540 static ffelexHandler ffestb_R10017_ (ffelexToken t);
541 static ffelexHandler ffestb_R10018_ (ffelexToken t);
542 static ffelexHandler ffestb_R10019_ (ffelexToken t);
543 static ffelexHandler ffestb_R100110_ (ffelexToken t);
544 static ffelexHandler ffestb_R100111_ (ffelexToken t);
545 static ffelexHandler ffestb_R100112_ (ffelexToken t);
546 static ffelexHandler ffestb_R100113_ (ffelexToken t);
547 static ffelexHandler ffestb_R100114_ (ffelexToken t);
548 static ffelexHandler ffestb_R100115_ (ffelexToken ft, ffebld expr,
549 ffelexToken t);
550 static ffelexHandler ffestb_R100116_ (ffelexToken ft, ffebld expr,
551 ffelexToken t);
552 static ffelexHandler ffestb_R100117_ (ffelexToken ft, ffebld expr,
553 ffelexToken t);
554 static ffelexHandler ffestb_R100118_ (ffelexToken ft, ffebld expr,
555 ffelexToken t);
556 static ffelexHandler ffestb_S3P41_ (ffelexToken ft, ffebld expr,
557 ffelexToken t);
558 static ffelexHandler ffestb_V0141_ (ffelexToken t);
559 static ffelexHandler ffestb_V0142_ (ffelexToken t);
560 static ffelexHandler ffestb_V0143_ (ffelexToken t);
561 static ffelexHandler ffestb_V0144_ (ffelexToken t);
562 #if FFESTB_KILL_EASY_
563 static void ffestb_subr_kill_easy_ (ffestpInquireIx max);
564 #else
565 static void ffestb_subr_kill_accept_ (void);
566 static void ffestb_subr_kill_beru_ (void);
567 static void ffestb_subr_kill_close_ (void);
568 static void ffestb_subr_kill_delete_ (void);
569 static void ffestb_subr_kill_find_ (void); /* Not written yet. */
570 static void ffestb_subr_kill_inquire_ (void);
571 static void ffestb_subr_kill_open_ (void);
572 static void ffestb_subr_kill_print_ (void);
573 static void ffestb_subr_kill_read_ (void);
574 static void ffestb_subr_kill_rewrite_ (void);
575 static void ffestb_subr_kill_type_ (void);
576 static void ffestb_subr_kill_vxtcode_ (void); /* Not written yet. */
577 static void ffestb_subr_kill_write_ (void);
578 #endif
579 static ffelexHandler ffestb_beru1_ (ffelexToken ft, ffebld expr,
580 ffelexToken t);
581 static ffelexHandler ffestb_beru2_ (ffelexToken t);
582 static ffelexHandler ffestb_beru3_ (ffelexToken t);
583 static ffelexHandler ffestb_beru4_ (ffelexToken ft, ffebld expr,
584 ffelexToken t);
585 static ffelexHandler ffestb_beru5_ (ffelexToken t);
586 static ffelexHandler ffestb_beru6_ (ffelexToken t);
587 static ffelexHandler ffestb_beru7_ (ffelexToken ft, ffebld expr,
588 ffelexToken t);
589 static ffelexHandler ffestb_beru8_ (ffelexToken t);
590 static ffelexHandler ffestb_beru9_ (ffelexToken t);
591 static ffelexHandler ffestb_beru10_ (ffelexToken t);
592 static ffelexHandler ffestb_R9041_ (ffelexToken t);
593 static ffelexHandler ffestb_R9042_ (ffelexToken t);
594 static ffelexHandler ffestb_R9043_ (ffelexToken ft, ffebld expr,
595 ffelexToken t);
596 static ffelexHandler ffestb_R9044_ (ffelexToken t);
597 static ffelexHandler ffestb_R9045_ (ffelexToken t);
598 static ffelexHandler ffestb_R9046_ (ffelexToken ft, ffebld expr,
599 ffelexToken t);
600 static ffelexHandler ffestb_R9047_ (ffelexToken t);
601 static ffelexHandler ffestb_R9048_ (ffelexToken t);
602 static ffelexHandler ffestb_R9049_ (ffelexToken t);
603 static ffelexHandler ffestb_R9071_ (ffelexToken t);
604 static ffelexHandler ffestb_R9072_ (ffelexToken t);
605 static ffelexHandler ffestb_R9073_ (ffelexToken ft, ffebld expr,
606 ffelexToken t);
607 static ffelexHandler ffestb_R9074_ (ffelexToken t);
608 static ffelexHandler ffestb_R9075_ (ffelexToken t);
609 static ffelexHandler ffestb_R9076_ (ffelexToken ft, ffebld expr,
610 ffelexToken t);
611 static ffelexHandler ffestb_R9077_ (ffelexToken t);
612 static ffelexHandler ffestb_R9078_ (ffelexToken t);
613 static ffelexHandler ffestb_R9079_ (ffelexToken t);
614 static ffelexHandler ffestb_R9091_ (ffelexToken ft, ffebld expr,
615 ffelexToken t);
616 static ffelexHandler ffestb_R9092_ (ffelexToken t);
617 static ffelexHandler ffestb_R9093_ (ffelexToken t);
618 static ffelexHandler ffestb_R9094_ (ffelexToken ft, ffebld expr,
619 ffelexToken t);
620 static ffelexHandler ffestb_R9095_ (ffelexToken t);
621 static ffelexHandler ffestb_R9096_ (ffelexToken t);
622 static ffelexHandler ffestb_R9097_ (ffelexToken ft, ffebld expr,
623 ffelexToken t);
624 static ffelexHandler ffestb_R9098_ (ffelexToken t);
625 static ffelexHandler ffestb_R9099_ (ffelexToken t);
626 static ffelexHandler ffestb_R90910_ (ffelexToken ft, ffebld expr,
627 ffelexToken t);
628 static ffelexHandler ffestb_R90911_ (ffelexToken t);
629 static ffelexHandler ffestb_R90912_ (ffelexToken t);
630 static ffelexHandler ffestb_R90913_ (ffelexToken t);
631 static ffelexHandler ffestb_R90914_ (ffelexToken ft, ffebld expr,
632 ffelexToken t);
633 static ffelexHandler ffestb_R90915_ (ffelexToken ft, ffebld expr,
634 ffelexToken t);
635 static ffelexHandler ffestb_R9101_ (ffelexToken t);
636 static ffelexHandler ffestb_R9102_ (ffelexToken t);
637 static ffelexHandler ffestb_R9103_ (ffelexToken ft, ffebld expr,
638 ffelexToken t);
639 static ffelexHandler ffestb_R9104_ (ffelexToken t);
640 static ffelexHandler ffestb_R9105_ (ffelexToken t);
641 static ffelexHandler ffestb_R9106_ (ffelexToken ft, ffebld expr,
642 ffelexToken t);
643 static ffelexHandler ffestb_R9107_ (ffelexToken t);
644 static ffelexHandler ffestb_R9108_ (ffelexToken t);
645 static ffelexHandler ffestb_R9109_ (ffelexToken ft, ffebld expr,
646 ffelexToken t);
647 static ffelexHandler ffestb_R91010_ (ffelexToken t);
648 static ffelexHandler ffestb_R91011_ (ffelexToken t);
649 static ffelexHandler ffestb_R91012_ (ffelexToken t);
650 static ffelexHandler ffestb_R91013_ (ffelexToken ft, ffebld expr,
651 ffelexToken t);
652 static ffelexHandler ffestb_R91014_ (ffelexToken ft, ffebld expr,
653 ffelexToken t);
654 static ffelexHandler ffestb_R9111_ (ffelexToken ft, ffebld expr,
655 ffelexToken t);
656 static ffelexHandler ffestb_R9112_ (ffelexToken ft, ffebld expr,
657 ffelexToken t);
658 static ffelexHandler ffestb_R9231_ (ffelexToken t);
659 static ffelexHandler ffestb_R9232_ (ffelexToken t);
660 static ffelexHandler ffestb_R9233_ (ffelexToken ft, ffebld expr,
661 ffelexToken t);
662 static ffelexHandler ffestb_R9234_ (ffelexToken t);
663 static ffelexHandler ffestb_R9235_ (ffelexToken t);
664 static ffelexHandler ffestb_R9236_ (ffelexToken ft, ffebld expr,
665 ffelexToken t);
666 static ffelexHandler ffestb_R9237_ (ffelexToken t);
667 static ffelexHandler ffestb_R9238_ (ffelexToken t);
668 static ffelexHandler ffestb_R9239_ (ffelexToken t);
669 static ffelexHandler ffestb_R92310_ (ffelexToken t);
670 static ffelexHandler ffestb_R92311_ (ffelexToken ft, ffebld expr,
671 ffelexToken t);
672 static ffelexHandler ffestb_V0201_ (ffelexToken ft, ffebld expr,
673 ffelexToken t);
674 static ffelexHandler ffestb_V0202_ (ffelexToken ft, ffebld expr,
675 ffelexToken t);
676 static ffelexHandler ffestb_dummy1_ (ffelexToken t);
677 static ffelexHandler ffestb_dummy2_ (ffelexToken t);
678 static ffelexHandler ffestb_R5241_ (ffelexToken t);
679 static ffelexHandler ffestb_R5242_ (ffelexToken t);
680 static ffelexHandler ffestb_R5243_ (ffelexToken t);
681 static ffelexHandler ffestb_R5244_ (ffelexToken t);
682 static ffelexHandler ffestb_R5471_ (ffelexToken t);
683 static ffelexHandler ffestb_R5472_ (ffelexToken t);
684 static ffelexHandler ffestb_R5473_ (ffelexToken t);
685 static ffelexHandler ffestb_R5474_ (ffelexToken t);
686 static ffelexHandler ffestb_R5475_ (ffelexToken t);
687 static ffelexHandler ffestb_R5476_ (ffelexToken t);
688 static ffelexHandler ffestb_R5477_ (ffelexToken t);
689 static ffelexHandler ffestb_R12291_ (ffelexToken t);
690 static ffelexHandler ffestb_R12292_ (ffelexToken ft, ffebld expr,
691 ffelexToken t);
692 static ffelexHandler ffestb_decl_chartype1_ (ffelexToken t);
693 static ffelexHandler ffestb_decl_attrs_ (ffelexToken t);
694 static ffelexHandler ffestb_decl_attrs_1_ (ffelexToken t);
695 static ffelexHandler ffestb_decl_attrs_2_ (ffelexToken t);
696 static ffelexHandler ffestb_decl_attrs_7_ (ffelexToken t);
697 static ffelexHandler ffestb_decl_attrsp_ (ffelexToken t);
698 static ffelexHandler ffestb_decl_ents_ (ffelexToken t);
699 static ffelexHandler ffestb_decl_ents_1_ (ffelexToken t);
700 static ffelexHandler ffestb_decl_ents_2_ (ffelexToken t);
701 static ffelexHandler ffestb_decl_ents_3_ (ffelexToken t);
702 static ffelexHandler ffestb_decl_ents_4_ (ffelexToken t);
703 static ffelexHandler ffestb_decl_ents_5_ (ffelexToken t);
704 static ffelexHandler ffestb_decl_ents_6_ (ffelexToken ft, ffebld expr,
705 ffelexToken t);
706 static ffelexHandler ffestb_decl_ents_7_ (ffelexToken t);
707 static ffelexHandler ffestb_decl_ents_8_ (ffelexToken ft, ffebld expr,
708 ffelexToken t);
709 static ffelexHandler ffestb_decl_ents_9_ (ffelexToken ft, ffebld expr,
710 ffelexToken t);
711 static ffelexHandler ffestb_decl_ents_10_ (ffelexToken ft, ffebld expr,
712 ffelexToken t);
713 static ffelexHandler ffestb_decl_ents_11_ (ffelexToken t);
714 static ffelexHandler ffestb_decl_entsp_ (ffelexToken t);
715 static ffelexHandler ffestb_decl_entsp_1_ (ffelexToken t);
716 static ffelexHandler ffestb_decl_entsp_2_ (ffelexToken t);
717 static ffelexHandler ffestb_decl_entsp_3_ (ffelexToken t);
718 static ffelexHandler ffestb_decl_entsp_4_ (ffelexToken ft, ffebld expr,
719 ffelexToken t);
720 static ffelexHandler ffestb_decl_entsp_5_ (ffelexToken t);
721 static ffelexHandler ffestb_decl_entsp_6_ (ffelexToken t);
722 static ffelexHandler ffestb_decl_entsp_7_ (ffelexToken t);
723 static ffelexHandler ffestb_decl_entsp_8_ (ffelexToken t);
724 static ffelexHandler ffestb_decl_funcname_ (ffelexToken t);
725 static ffelexHandler ffestb_decl_funcname_1_ (ffelexToken t);
726 static ffelexHandler ffestb_decl_funcname_2_ (ffelexToken t);
727 static ffelexHandler ffestb_decl_funcname_3_ (ffelexToken ft, ffebld expr,
728 ffelexToken t);
729 static ffelexHandler ffestb_decl_funcname_4_ (ffelexToken t);
730 static ffelexHandler ffestb_decl_funcname_5_ (ffelexToken t);
731 static ffelexHandler ffestb_decl_funcname_6_ (ffelexToken t);
732 static ffelexHandler ffestb_decl_funcname_7_ (ffelexToken t);
733 static ffelexHandler ffestb_decl_funcname_8_ (ffelexToken t);
734 static ffelexHandler ffestb_decl_funcname_9_ (ffelexToken t);
735 static ffelexHandler ffestb_V0271_ (ffelexToken t);
736 static ffelexHandler ffestb_V0272_ (ffelexToken ft, ffebld expr,
737 ffelexToken t);
738 static ffelexHandler ffestb_V0273_ (ffelexToken t);
739 static ffelexHandler ffestb_decl_R5391_ (ffelexToken t);
740 static ffelexHandler ffestb_decl_R5392_ (ffelexToken t);
741 static ffelexHandler ffestb_decl_R5394_ (ffelexToken t);
742 static ffelexHandler ffestb_decl_R5395_ (ffelexToken t);
743 static ffelexHandler ffestb_decl_R539letters_ (ffelexToken t);
744 static ffelexHandler ffestb_decl_R539letters_1_ (ffelexToken t);
745 static ffelexHandler ffestb_decl_R539letters_2_ (ffelexToken t);
746 static ffelexHandler ffestb_decl_R539letters_3_ (ffelexToken t);
747 static ffelexHandler ffestb_decl_R539letters_4_ (ffelexToken t);
748 static ffelexHandler ffestb_decl_R539letters_5_ (ffelexToken t);
749 static ffelexHandler ffestb_decl_R539maybe_ (ffelexToken t);
750 static ffelexHandler ffestb_decl_R539maybe_1_ (ffelexToken t);
751 static ffelexHandler ffestb_decl_R539maybe_2_ (ffelexToken t);
752 static ffelexHandler ffestb_decl_R539maybe_3_ (ffelexToken t);
753 static ffelexHandler ffestb_decl_R539maybe_4_ (ffelexToken t);
754 static ffelexHandler ffestb_decl_R539maybe_5_ (ffelexToken t);
755
756 /* Internal macros. */
757
758 #if FFESTB_KILL_EASY_
759 #define ffestb_subr_kill_accept_() \
760 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_acceptix)
761 #define ffestb_subr_kill_beru_() \
762 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_beruix)
763 #define ffestb_subr_kill_close_() \
764 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_closeix)
765 #define ffestb_subr_kill_delete_() \
766 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_deleteix)
767 #define ffestb_subr_kill_find_() \
768 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_findix)
769 #define ffestb_subr_kill_inquire_() \
770 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_inquireix)
771 #define ffestb_subr_kill_open_() \
772 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_openix)
773 #define ffestb_subr_kill_print_() \
774 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_printix)
775 #define ffestb_subr_kill_read_() \
776 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_readix)
777 #define ffestb_subr_kill_rewrite_() \
778 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_rewriteix)
779 #define ffestb_subr_kill_type_() \
780 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_typeix)
781 #define ffestb_subr_kill_vxtcode_() \
782 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_vxtcodeix)
783 #define ffestb_subr_kill_write_() \
784 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_writeix)
785 #endif
786 \f
787 /* ffestb_subr_ambig_nope_ -- Cleans up and aborts ambig w/o confirming
788
789 ffestb_subr_ambig_nope_();
790
791 Switch from ambiguity handling in _entsp_ functions to handling entities
792 in _ents_ (perform housekeeping tasks). */
793
794 static ffelexHandler
795 ffestb_subr_ambig_nope_ (ffelexToken t)
796 {
797 if (ffestb_local_.decl.recursive != NULL)
798 ffelex_token_kill (ffestb_local_.decl.recursive);
799 if (ffestb_local_.decl.kindt != NULL)
800 ffelex_token_kill (ffestb_local_.decl.kindt);
801 if (ffestb_local_.decl.lent != NULL)
802 ffelex_token_kill (ffestb_local_.decl.lent);
803 ffelex_token_kill (ffesta_tokens[1]);
804 ffelex_token_kill (ffesta_tokens[2]);
805 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
806 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
807 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
808 }
809
810 /* ffestb_subr_ambig_to_ents_ -- Switches from ambiguity to entity decl
811
812 ffestb_subr_ambig_to_ents_();
813
814 Switch from ambiguity handling in _entsp_ functions to handling entities
815 in _ents_ (perform housekeeping tasks). */
816
817 static void
818 ffestb_subr_ambig_to_ents_ (void)
819 {
820 ffelexToken nt;
821
822 nt = ffelex_token_name_from_names (ffesta_tokens[1], 0, 0);
823 ffelex_token_kill (ffesta_tokens[1]);
824 ffelex_token_kill (ffesta_tokens[2]);
825 ffesta_tokens[1] = nt;
826 if (ffestb_local_.decl.recursive != NULL)
827 ffelex_token_kill (ffestb_local_.decl.recursive);
828 if (!ffestb_local_.decl.aster_after)
829 {
830 if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
831 {
832 if (!ffesta_is_inhibited ())
833 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
834 ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
835 ffestb_local_.decl.len, ffestb_local_.decl.lent);
836 if (ffestb_local_.decl.kindt != NULL)
837 {
838 ffelex_token_kill (ffestb_local_.decl.kindt);
839 ffestb_local_.decl.kind = NULL;
840 ffestb_local_.decl.kindt = NULL;
841 }
842 if (ffestb_local_.decl.lent != NULL)
843 {
844 ffelex_token_kill (ffestb_local_.decl.lent);
845 ffestb_local_.decl.len = NULL;
846 ffestb_local_.decl.lent = NULL;
847 }
848 }
849 else
850 {
851 if (!ffesta_is_inhibited ())
852 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
853 ffestb_local_.decl.kind, ffestb_local_.decl.kindt, NULL,
854 NULL);
855 if (ffestb_local_.decl.kindt != NULL)
856 {
857 ffelex_token_kill (ffestb_local_.decl.kindt);
858 ffestb_local_.decl.kind = NULL;
859 ffestb_local_.decl.kindt = NULL;
860 }
861 }
862 return;
863 }
864 if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
865 {
866 if (!ffesta_is_inhibited ())
867 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
868 ffestb_local_.decl.kind, ffestb_local_.decl.kindt, NULL, NULL);
869 if (ffestb_local_.decl.kindt != NULL)
870 {
871 ffelex_token_kill (ffestb_local_.decl.kindt);
872 ffestb_local_.decl.kind = NULL;
873 ffestb_local_.decl.kindt = NULL;
874 }
875 }
876 else if (!ffesta_is_inhibited ())
877 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
878 NULL, NULL, NULL, NULL);
879 /* NAME/NAMES token already in ffesta_tokens[1]. */
880 }
881
882 /* ffestb_subr_dimlist_ -- OPEN_PAREN expr
883
884 (ffestb_subr_dimlist_) // to expression handler
885
886 Deal with a dimension list.
887
888 19-Dec-90 JCB 1.1
889 Detect too many dimensions if backend wants it. */
890
891 static ffelexHandler
892 ffestb_subr_dimlist_ (ffelexToken ft, ffebld expr, ffelexToken t)
893 {
894 switch (ffelex_token_type (t))
895 {
896 case FFELEX_typeCLOSE_PAREN:
897 if (expr == NULL)
898 break;
899 #ifdef FFECOM_dimensionsMAX
900 if (ffestb_subrargs_.dim_list.ndims++ == FFECOM_dimensionsMAX)
901 {
902 ffesta_ffebad_1t (FFEBAD_TOO_MANY_DIMS, ft);
903 ffestb_subrargs_.dim_list.ok = TRUE; /* Not a parse error, really. */
904 return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
905 }
906 #endif
907 ffestt_dimlist_append (ffestb_subrargs_.dim_list.dims, NULL, expr,
908 ffelex_token_use (t));
909 ffestb_subrargs_.dim_list.ok = TRUE;
910 return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
911
912 case FFELEX_typeCOMMA:
913 if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
914 break;
915 #ifdef FFECOM_dimensionsMAX
916 if (ffestb_subrargs_.dim_list.ndims++ == FFECOM_dimensionsMAX)
917 {
918 ffesta_ffebad_1t (FFEBAD_TOO_MANY_DIMS, ft);
919 return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
920 ffestb_subrargs_.dim_list.ctx,
921 (ffeexprCallback) ffestb_subr_dimlist_2_);
922 }
923 #endif
924 ffestt_dimlist_append (ffestb_subrargs_.dim_list.dims, NULL, expr,
925 ffelex_token_use (t));
926 return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
927 ffestb_subrargs_.dim_list.ctx,
928 (ffeexprCallback) ffestb_subr_dimlist_);
929
930 case FFELEX_typeCOLON:
931 if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
932 break;
933 #ifdef FFECOM_dimensionsMAX
934 if (ffestb_subrargs_.dim_list.ndims++ == FFECOM_dimensionsMAX)
935 {
936 ffesta_ffebad_1t (FFEBAD_TOO_MANY_DIMS, ft);
937 return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
938 ffestb_subrargs_.dim_list.ctx,
939 (ffeexprCallback) ffestb_subr_dimlist_2_);
940 }
941 #endif
942 ffestt_dimlist_append (ffestb_subrargs_.dim_list.dims, expr, NULL,
943 ffelex_token_use (t)); /* NULL second expr for
944 now, just plug in. */
945 return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
946 ffestb_subrargs_.dim_list.ctx,
947 (ffeexprCallback) ffestb_subr_dimlist_1_);
948
949 default:
950 break;
951 }
952
953 ffestb_subrargs_.dim_list.ok = FALSE;
954 return (ffelexHandler) ffestb_subrargs_.dim_list.handler (t);
955 }
956
957 /* ffestb_subr_dimlist_1_ -- OPEN_PAREN expr COLON expr
958
959 (ffestb_subr_dimlist_1_) // to expression handler
960
961 Get the upper bound. */
962
963 static ffelexHandler
964 ffestb_subr_dimlist_1_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
965 {
966 switch (ffelex_token_type (t))
967 {
968 case FFELEX_typeCLOSE_PAREN:
969 ffestb_subrargs_.dim_list.dims->previous->upper = expr;
970 ffestb_subrargs_.dim_list.ok = TRUE;
971 return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
972
973 case FFELEX_typeCOMMA:
974 if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
975 break;
976 ffestb_subrargs_.dim_list.dims->previous->upper = expr;
977 return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
978 ffestb_subrargs_.dim_list.ctx, (ffeexprCallback) ffestb_subr_dimlist_);
979
980 default:
981 break;
982 }
983
984 ffestb_subrargs_.dim_list.ok = FALSE;
985 return (ffelexHandler) ffestb_subrargs_.dim_list.handler (t);
986 }
987
988 /* ffestb_subr_dimlist_2_ -- OPEN_PAREN too-many-dim-exprs
989
990 (ffestb_subr_dimlist_2_) // to expression handler
991
992 Get the upper bound. */
993
994 static ffelexHandler
995 ffestb_subr_dimlist_2_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
996 {
997 switch (ffelex_token_type (t))
998 {
999 case FFELEX_typeCLOSE_PAREN:
1000 ffestb_subrargs_.dim_list.ok = TRUE; /* Not a parse error, really. */
1001 return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
1002
1003 case FFELEX_typeCOMMA:
1004 case FFELEX_typeCOLON:
1005 if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
1006 break;
1007 return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
1008 ffestb_subrargs_.dim_list.ctx,
1009 (ffeexprCallback) ffestb_subr_dimlist_2_);
1010
1011 default:
1012 break;
1013 }
1014
1015 ffestb_subrargs_.dim_list.ok = FALSE;
1016 return (ffelexHandler) ffestb_subrargs_.dim_list.handler (t);
1017 }
1018
1019 /* ffestb_subr_name_list_ -- Collect a list of name args and close-paren
1020
1021 return ffestb_subr_name_list_; // to lexer after seeing OPEN_PAREN
1022
1023 This implements R1224 in the Fortran 90 spec. The arg list may be
1024 empty, or be a comma-separated list (an optional trailing comma currently
1025 results in a warning but no other effect) of arguments. For functions,
1026 however, "*" is invalid (we implement dummy-arg-name, rather than R1224
1027 dummy-arg, which itself is either dummy-arg-name or "*"). */
1028
1029 static ffelexHandler
1030 ffestb_subr_name_list_ (ffelexToken t)
1031 {
1032 switch (ffelex_token_type (t))
1033 {
1034 case FFELEX_typeCLOSE_PAREN:
1035 if (ffestt_tokenlist_count (ffestb_subrargs_.name_list.args) != 0)
1036 { /* Trailing comma, warn. */
1037 ffebad_start (FFEBAD_TRAILING_COMMA);
1038 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
1039 ffebad_finish ();
1040 }
1041 ffestb_subrargs_.name_list.ok = TRUE;
1042 ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
1043 if (ffestb_subrargs_.name_list.names)
1044 ffelex_set_names (TRUE);
1045 return (ffelexHandler) ffestb_subrargs_.name_list.handler;
1046
1047 case FFELEX_typeASTERISK:
1048 if (!ffestb_subrargs_.name_list.is_subr)
1049 break;
1050
1051 case FFELEX_typeNAME:
1052 ffestt_tokenlist_append (ffestb_subrargs_.name_list.args,
1053 ffelex_token_use (t));
1054 return (ffelexHandler) ffestb_subr_name_list_1_;
1055
1056 default:
1057 break;
1058 }
1059
1060 ffestb_subrargs_.name_list.ok = FALSE;
1061 ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
1062 if (ffestb_subrargs_.name_list.names)
1063 ffelex_set_names (TRUE);
1064 return (ffelexHandler) (*ffestb_subrargs_.name_list.handler) (t);
1065 }
1066
1067 /* ffestb_subr_name_list_1_ -- NAME or ASTERISK
1068
1069 return ffestb_subr_name_list_1_; // to lexer
1070
1071 The next token must be COMMA or CLOSE_PAREN, either way go to original
1072 state, but only after adding the appropriate name list item. */
1073
1074 static ffelexHandler
1075 ffestb_subr_name_list_1_ (ffelexToken t)
1076 {
1077 switch (ffelex_token_type (t))
1078 {
1079 case FFELEX_typeCOMMA:
1080 return (ffelexHandler) ffestb_subr_name_list_;
1081
1082 case FFELEX_typeCLOSE_PAREN:
1083 ffestb_subrargs_.name_list.ok = TRUE;
1084 ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
1085 if (ffestb_subrargs_.name_list.names)
1086 ffelex_set_names (TRUE);
1087 return (ffelexHandler) ffestb_subrargs_.name_list.handler;
1088
1089 default:
1090 ffestb_subrargs_.name_list.ok = FALSE;
1091 ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
1092 if (ffestb_subrargs_.name_list.names)
1093 ffelex_set_names (TRUE);
1094 return (ffelexHandler) (*ffestb_subrargs_.name_list.handler) (t);
1095 }
1096 }
1097
1098 static void
1099 ffestb_subr_R1001_append_p_ (void)
1100 {
1101 ffesttFormatList f;
1102
1103 if (!ffestb_local_.format.pre.present)
1104 {
1105 ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_P_SPEC, ffestb_local_.format.t);
1106 ffelex_token_kill (ffestb_local_.format.t);
1107 return;
1108 }
1109
1110 f = ffestt_formatlist_append (ffestb_local_.format.f);
1111 f->type = FFESTP_formattypeP;
1112 f->t = ffestb_local_.format.t;
1113 f->u.R1010.val = ffestb_local_.format.pre;
1114 }
1115
1116 /* ffestb_decl_kindparam_ -- "type" OPEN_PAREN
1117
1118 return ffestb_decl_kindparam_; // to lexer
1119
1120 Handle "[KIND=]expr)". */
1121
1122 static ffelexHandler
1123 ffestb_decl_kindparam_ (ffelexToken t)
1124 {
1125 switch (ffelex_token_type (t))
1126 {
1127 case FFELEX_typeNAME:
1128 ffesta_tokens[1] = ffelex_token_use (t);
1129 return (ffelexHandler) ffestb_decl_kindparam_1_;
1130
1131 default:
1132 return (ffelexHandler) (*((ffelexHandler)
1133 ffeexpr_rhs (ffesta_output_pool,
1134 FFEEXPR_contextKINDTYPE,
1135 (ffeexprCallback) ffestb_decl_kindparam_2_)))
1136 (t);
1137 }
1138 }
1139
1140 /* ffestb_decl_kindparam_1_ -- "type" OPEN_PAREN NAME
1141
1142 return ffestb_decl_kindparam_1_; // to lexer
1143
1144 Handle "[KIND=]expr)". */
1145
1146 static ffelexHandler
1147 ffestb_decl_kindparam_1_ (ffelexToken t)
1148 {
1149 ffelexHandler next;
1150 ffelexToken nt;
1151
1152 switch (ffelex_token_type (t))
1153 {
1154 case FFELEX_typeEQUALS:
1155 ffesta_confirmed ();
1156 if (ffestr_other (ffesta_tokens[1]) != FFESTR_otherKIND)
1157 break;
1158 ffelex_token_kill (ffesta_tokens[1]);
1159 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
1160 FFEEXPR_contextKINDTYPE, (ffeexprCallback) ffestb_decl_kindparam_2_);
1161
1162 default:
1163 nt = ffesta_tokens[1];
1164 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
1165 FFEEXPR_contextKINDTYPE, (ffeexprCallback) ffestb_decl_kindparam_2_)))
1166 (nt);
1167 ffelex_token_kill (nt);
1168 return (ffelexHandler) (*next) (t);
1169 }
1170
1171 if (ffestb_local_.decl.recursive != NULL)
1172 ffelex_token_kill (ffestb_local_.decl.recursive);
1173 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1174 ffestb_local_.decl.badname,
1175 ffesta_tokens[1]);
1176 ffelex_token_kill (ffesta_tokens[1]);
1177 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1178 }
1179
1180 /* ffestb_decl_kindparam_2_ -- "type" OPEN_PAREN ["KIND="] expr
1181
1182 (ffestb_decl_kindparam_2_) // to expression handler
1183
1184 Handle "[KIND=]expr)". */
1185
1186 static ffelexHandler
1187 ffestb_decl_kindparam_2_ (ffelexToken ft, ffebld expr, ffelexToken t)
1188 {
1189 switch (ffelex_token_type (t))
1190 {
1191 case FFELEX_typeCLOSE_PAREN:
1192 ffestb_local_.decl.kind = expr;
1193 ffestb_local_.decl.kindt = ffelex_token_use (ft);
1194 ffestb_local_.decl.len = NULL;
1195 ffestb_local_.decl.lent = NULL;
1196 ffelex_set_names (TRUE);
1197 return (ffelexHandler) ffestb_local_.decl.handler;
1198
1199 default:
1200 break;
1201 }
1202
1203 if (ffestb_local_.decl.recursive != NULL)
1204 ffelex_token_kill (ffestb_local_.decl.recursive);
1205 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1206 ffestb_local_.decl.badname,
1207 t);
1208 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1209 }
1210
1211 /* ffestb_decl_starkind_ -- "type" ASTERISK
1212
1213 return ffestb_decl_starkind_; // to lexer
1214
1215 Handle NUMBER. */
1216
1217 static ffelexHandler
1218 ffestb_decl_starkind_ (ffelexToken t)
1219 {
1220 switch (ffelex_token_type (t))
1221 {
1222 case FFELEX_typeNUMBER:
1223 ffestb_local_.decl.kindt = ffelex_token_use (t);
1224 ffestb_local_.decl.kind = NULL;
1225 ffestb_local_.decl.len = NULL;
1226 ffestb_local_.decl.lent = NULL;
1227 ffelex_set_names (TRUE);
1228 return (ffelexHandler) ffestb_local_.decl.handler;
1229
1230 default:
1231 break;
1232 }
1233
1234 if (ffestb_local_.decl.recursive != NULL)
1235 ffelex_token_kill (ffestb_local_.decl.recursive);
1236 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1237 ffestb_local_.decl.badname,
1238 t);
1239 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1240 }
1241
1242 /* ffestb_decl_starlen_ -- "CHARACTER" ASTERISK
1243
1244 return ffestb_decl_starlen_; // to lexer
1245
1246 Handle NUMBER. */
1247
1248 static ffelexHandler
1249 ffestb_decl_starlen_ (ffelexToken t)
1250 {
1251 switch (ffelex_token_type (t))
1252 {
1253 case FFELEX_typeNUMBER:
1254 ffestb_local_.decl.kind = NULL;
1255 ffestb_local_.decl.kindt = NULL;
1256 ffestb_local_.decl.len = NULL;
1257 ffestb_local_.decl.lent = ffelex_token_use (t);
1258 ffelex_set_names (TRUE);
1259 return (ffelexHandler) ffestb_local_.decl.handler;
1260
1261 case FFELEX_typeOPEN_PAREN:
1262 ffestb_local_.decl.kind = NULL;
1263 ffestb_local_.decl.kindt = NULL;
1264 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
1265 FFEEXPR_contextCHARACTERSIZE,
1266 (ffeexprCallback) ffestb_decl_starlen_1_);
1267
1268 default:
1269 break;
1270 }
1271
1272 if (ffestb_local_.decl.recursive != NULL)
1273 ffelex_token_kill (ffestb_local_.decl.recursive);
1274 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1275 ffestb_local_.decl.badname,
1276 t);
1277 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1278 }
1279
1280 /* ffestb_decl_starlen_1_ -- "CHARACTER" ASTERISK OPEN_PAREN expr
1281
1282 (ffestb_decl_starlen_1_) // to expression handler
1283
1284 Handle CLOSE_PAREN. */
1285
1286 static ffelexHandler
1287 ffestb_decl_starlen_1_ (ffelexToken ft, ffebld expr, ffelexToken t)
1288 {
1289 switch (ffelex_token_type (t))
1290 {
1291 case FFELEX_typeCLOSE_PAREN:
1292 if (expr == NULL)
1293 break;
1294 ffestb_local_.decl.len = expr;
1295 ffestb_local_.decl.lent = ffelex_token_use (ft);
1296 ffelex_set_names (TRUE);
1297 return (ffelexHandler) ffestb_local_.decl.handler;
1298
1299 default:
1300 break;
1301 }
1302
1303 if (ffestb_local_.decl.recursive != NULL)
1304 ffelex_token_kill (ffestb_local_.decl.recursive);
1305 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1306 ffestb_local_.decl.badname,
1307 t);
1308 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1309 }
1310
1311 /* ffestb_decl_typeparams_ -- "CHARACTER" OPEN_PAREN
1312
1313 return ffestb_decl_typeparams_; // to lexer
1314
1315 Handle "[KIND=]expr)". */
1316
1317 static ffelexHandler
1318 ffestb_decl_typeparams_ (ffelexToken t)
1319 {
1320 switch (ffelex_token_type (t))
1321 {
1322 case FFELEX_typeNAME:
1323 ffesta_tokens[1] = ffelex_token_use (t);
1324 return (ffelexHandler) ffestb_decl_typeparams_1_;
1325
1326 default:
1327 if (ffestb_local_.decl.lent == NULL)
1328 return (ffelexHandler) (*((ffelexHandler)
1329 ffeexpr_rhs (ffesta_output_pool,
1330 FFEEXPR_contextCHARACTERSIZE,
1331 (ffeexprCallback) ffestb_decl_typeparams_2_)))
1332 (t);
1333 if (ffestb_local_.decl.kindt != NULL)
1334 break;
1335 return (ffelexHandler) (*((ffelexHandler)
1336 ffeexpr_rhs (ffesta_output_pool,
1337 FFEEXPR_contextKINDTYPE,
1338 (ffeexprCallback) ffestb_decl_typeparams_3_)))
1339 (t);
1340 }
1341
1342 if (ffestb_local_.decl.recursive != NULL)
1343 ffelex_token_kill (ffestb_local_.decl.recursive);
1344 if (ffestb_local_.decl.kindt != NULL)
1345 ffelex_token_kill (ffestb_local_.decl.kindt);
1346 if (ffestb_local_.decl.lent != NULL)
1347 ffelex_token_kill (ffestb_local_.decl.lent);
1348 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1349 ffestb_local_.decl.badname,
1350 t);
1351 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1352 }
1353
1354 /* ffestb_decl_typeparams_1_ -- "CHARACTER" OPEN_PAREN NAME
1355
1356 return ffestb_decl_typeparams_1_; // to lexer
1357
1358 Handle "[KIND=]expr)". */
1359
1360 static ffelexHandler
1361 ffestb_decl_typeparams_1_ (ffelexToken t)
1362 {
1363 ffelexHandler next;
1364 ffelexToken nt;
1365
1366 switch (ffelex_token_type (t))
1367 {
1368 case FFELEX_typeEQUALS:
1369 ffesta_confirmed ();
1370 switch (ffestr_other (ffesta_tokens[1]))
1371 {
1372 case FFESTR_otherLEN:
1373 if (ffestb_local_.decl.lent != NULL)
1374 break;
1375 ffelex_token_kill (ffesta_tokens[1]);
1376 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
1377 FFEEXPR_contextCHARACTERSIZE,
1378 (ffeexprCallback) ffestb_decl_typeparams_2_);
1379
1380 case FFESTR_otherKIND:
1381 if (ffestb_local_.decl.kindt != NULL)
1382 break;
1383 ffelex_token_kill (ffesta_tokens[1]);
1384 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
1385 FFEEXPR_contextKINDTYPE,
1386 (ffeexprCallback) ffestb_decl_typeparams_3_);
1387
1388 default:
1389 break;
1390 }
1391 break;
1392
1393 default:
1394 nt = ffesta_tokens[1];
1395 if (ffestb_local_.decl.lent == NULL)
1396 next = (ffelexHandler) (*((ffelexHandler)
1397 ffeexpr_rhs (ffesta_output_pool,
1398 FFEEXPR_contextCHARACTERSIZE,
1399 (ffeexprCallback) ffestb_decl_typeparams_2_)))
1400 (nt);
1401 else if (ffestb_local_.decl.kindt == NULL)
1402 next = (ffelexHandler) (*((ffelexHandler)
1403 ffeexpr_rhs (ffesta_output_pool,
1404 FFEEXPR_contextKINDTYPE,
1405 (ffeexprCallback) ffestb_decl_typeparams_3_)))
1406 (nt);
1407 else
1408 {
1409 ffesta_tokens[1] = nt;
1410 break;
1411 }
1412 ffelex_token_kill (nt);
1413 return (ffelexHandler) (*next) (t);
1414 }
1415
1416 if (ffestb_local_.decl.recursive != NULL)
1417 ffelex_token_kill (ffestb_local_.decl.recursive);
1418 if (ffestb_local_.decl.kindt != NULL)
1419 ffelex_token_kill (ffestb_local_.decl.kindt);
1420 if (ffestb_local_.decl.lent != NULL)
1421 ffelex_token_kill (ffestb_local_.decl.lent);
1422 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1423 ffestb_local_.decl.badname,
1424 ffesta_tokens[1]);
1425 ffelex_token_kill (ffesta_tokens[1]);
1426 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1427 }
1428
1429 /* ffestb_decl_typeparams_2_ -- "CHARACTER" OPEN_PAREN ["LEN="] expr
1430
1431 (ffestb_decl_typeparams_2_) // to expression handler
1432
1433 Handle "[LEN=]expr)". */
1434
1435 static ffelexHandler
1436 ffestb_decl_typeparams_2_ (ffelexToken ft, ffebld expr, ffelexToken t)
1437 {
1438 switch (ffelex_token_type (t))
1439 {
1440 case FFELEX_typeCLOSE_PAREN:
1441 ffestb_local_.decl.len = expr;
1442 ffestb_local_.decl.lent = ffelex_token_use (ft);
1443 ffelex_set_names (TRUE);
1444 return (ffelexHandler) ffestb_local_.decl.handler;
1445
1446 case FFELEX_typeCOMMA:
1447 ffestb_local_.decl.len = expr;
1448 ffestb_local_.decl.lent = ffelex_token_use (ft);
1449 return (ffelexHandler) ffestb_decl_typeparams_;
1450
1451 default:
1452 break;
1453 }
1454
1455 if (ffestb_local_.decl.recursive != NULL)
1456 ffelex_token_kill (ffestb_local_.decl.recursive);
1457 if (ffestb_local_.decl.kindt != NULL)
1458 ffelex_token_kill (ffestb_local_.decl.kindt);
1459 if (ffestb_local_.decl.lent != NULL)
1460 ffelex_token_kill (ffestb_local_.decl.lent);
1461 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1462 ffestb_local_.decl.badname,
1463 t);
1464 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1465 }
1466
1467 /* ffestb_decl_typeparams_3_ -- "CHARACTER" OPEN_PAREN ["KIND="] expr
1468
1469 (ffestb_decl_typeparams_3_) // to expression handler
1470
1471 Handle "[KIND=]expr)". */
1472
1473 static ffelexHandler
1474 ffestb_decl_typeparams_3_ (ffelexToken ft, ffebld expr, ffelexToken t)
1475 {
1476 switch (ffelex_token_type (t))
1477 {
1478 case FFELEX_typeCLOSE_PAREN:
1479 ffestb_local_.decl.kind = expr;
1480 ffestb_local_.decl.kindt = ffelex_token_use (ft);
1481 ffelex_set_names (TRUE);
1482 return (ffelexHandler) ffestb_local_.decl.handler;
1483
1484 case FFELEX_typeCOMMA:
1485 ffestb_local_.decl.kind = expr;
1486 ffestb_local_.decl.kindt = ffelex_token_use (ft);
1487 return (ffelexHandler) ffestb_decl_typeparams_;
1488
1489 default:
1490 break;
1491 }
1492
1493 if (ffestb_local_.decl.recursive != NULL)
1494 ffelex_token_kill (ffestb_local_.decl.recursive);
1495 if (ffestb_local_.decl.kindt != NULL)
1496 ffelex_token_kill (ffestb_local_.decl.kindt);
1497 if (ffestb_local_.decl.lent != NULL)
1498 ffelex_token_kill (ffestb_local_.decl.lent);
1499 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
1500 ffestb_local_.decl.badname,
1501 t);
1502 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1503 }
1504
1505 /* ffestb_subr_label_list_ -- Collect a tokenlist of labels and close-paren
1506
1507 return ffestb_subr_label_list_; // to lexer after seeing OPEN_PAREN
1508
1509 First token must be a NUMBER. Must be followed by zero or more COMMA
1510 NUMBER pairs. Must then be followed by a CLOSE_PAREN. If all ok, put
1511 the NUMBER tokens in a token list and return via the handler for the
1512 token after CLOSE_PAREN. Else return via
1513 same handler, but with the ok return value set FALSE. */
1514
1515 static ffelexHandler
1516 ffestb_subr_label_list_ (ffelexToken t)
1517 {
1518 if (ffelex_token_type (t) == FFELEX_typeNUMBER)
1519 {
1520 ffestt_tokenlist_append (ffestb_subrargs_.label_list.labels,
1521 ffelex_token_use (t));
1522 return (ffelexHandler) ffestb_subr_label_list_1_;
1523 }
1524
1525 ffestb_subrargs_.label_list.ok = FALSE;
1526 return (ffelexHandler) (*ffestb_subrargs_.label_list.handler) (t);
1527 }
1528
1529 /* ffestb_subr_label_list_1_ -- NUMBER
1530
1531 return ffestb_subr_label_list_1_; // to lexer after seeing NUMBER
1532
1533 The next token must be COMMA, in which case go back to
1534 ffestb_subr_label_list_, or CLOSE_PAREN, in which case set ok to TRUE
1535 and go to the handler. */
1536
1537 static ffelexHandler
1538 ffestb_subr_label_list_1_ (ffelexToken t)
1539 {
1540 switch (ffelex_token_type (t))
1541 {
1542 case FFELEX_typeCOMMA:
1543 return (ffelexHandler) ffestb_subr_label_list_;
1544
1545 case FFELEX_typeCLOSE_PAREN:
1546 ffestb_subrargs_.label_list.ok = TRUE;
1547 return (ffelexHandler) ffestb_subrargs_.label_list.handler;
1548
1549 default:
1550 ffestb_subrargs_.label_list.ok = FALSE;
1551 return (ffelexHandler) (*ffestb_subrargs_.label_list.handler) (t);
1552 }
1553 }
1554
1555 /* ffestb_do -- Parse the DO statement
1556
1557 return ffestb_do; // to lexer
1558
1559 Make sure the statement has a valid form for the DO statement. If it
1560 does, implement the statement. */
1561
1562 ffelexHandler
1563 ffestb_do (ffelexToken t)
1564 {
1565 ffeTokenLength i;
1566 unsigned const char *p;
1567 ffelexHandler next;
1568 ffelexToken nt;
1569 ffestrSecond kw;
1570
1571 switch (ffelex_token_type (ffesta_tokens[0]))
1572 {
1573 case FFELEX_typeNAME:
1574 if (ffesta_first_kw != FFESTR_firstDO)
1575 goto bad_0; /* :::::::::::::::::::: */
1576 switch (ffelex_token_type (t))
1577 {
1578 case FFELEX_typeNUMBER:
1579 ffesta_confirmed ();
1580 ffesta_tokens[1] = ffelex_token_use (t);
1581 return (ffelexHandler) ffestb_do1_;
1582
1583 case FFELEX_typeCOMMA:
1584 ffesta_confirmed ();
1585 ffesta_tokens[1] = NULL;
1586 return (ffelexHandler) ffestb_do2_;
1587
1588 case FFELEX_typeNAME:
1589 ffesta_confirmed ();
1590 ffesta_tokens[1] = NULL;
1591 ffesta_tokens[2] = ffelex_token_use (t);
1592 return (ffelexHandler) ffestb_do3_;
1593
1594 case FFELEX_typeEOS:
1595 case FFELEX_typeSEMICOLON:
1596 ffesta_confirmed ();
1597 ffesta_tokens[1] = NULL;
1598 return (ffelexHandler) ffestb_do1_ (t);
1599
1600 case FFELEX_typeCOLONCOLON:
1601 ffesta_confirmed (); /* Error, but clearly intended. */
1602 goto bad_1; /* :::::::::::::::::::: */
1603
1604 default:
1605 goto bad_1; /* :::::::::::::::::::: */
1606 }
1607
1608 case FFELEX_typeNAMES:
1609 if (ffesta_first_kw != FFESTR_firstDO)
1610 goto bad_0; /* :::::::::::::::::::: */
1611 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDO);
1612 switch (ffelex_token_type (t))
1613 {
1614 case FFELEX_typeCOLONCOLON:
1615 ffesta_confirmed (); /* Error, but clearly intended. */
1616 goto bad_1; /* :::::::::::::::::::: */
1617
1618 default:
1619 goto bad_1; /* :::::::::::::::::::: */
1620
1621 case FFELEX_typeOPEN_PAREN: /* Must be "DO" label "WHILE". */
1622 if (! ISDIGIT (*p))
1623 goto bad_i; /* :::::::::::::::::::: */
1624 ffesta_tokens[1] = ffelex_token_number_from_names (ffesta_tokens[0],
1625 i);
1626 p += ffelex_token_length (ffesta_tokens[1]);
1627 i += ffelex_token_length (ffesta_tokens[1]);
1628 if (((*p) != 'W') && ((*p) != 'w'))
1629 goto bad_i1; /* :::::::::::::::::::: */
1630 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
1631 kw = ffestr_second (nt);
1632 ffelex_token_kill (nt);
1633 if (kw != FFESTR_secondWHILE)
1634 goto bad_i1; /* :::::::::::::::::::: */
1635 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
1636 FFEEXPR_contextDOWHILE, (ffeexprCallback) ffestb_do4_);
1637
1638 case FFELEX_typeCOMMA:
1639 ffesta_confirmed ();
1640 if (*p == '\0')
1641 {
1642 ffesta_tokens[1] = NULL;
1643 return (ffelexHandler) ffestb_do2_;
1644 }
1645 if (! ISDIGIT (*p))
1646 goto bad_i; /* :::::::::::::::::::: */
1647 ffesta_tokens[1] = ffelex_token_number_from_names (ffesta_tokens[0],
1648 i);
1649 p += ffelex_token_length (ffesta_tokens[1]);
1650 i += ffelex_token_length (ffesta_tokens[1]);
1651 if (*p != '\0')
1652 goto bad_i1; /* :::::::::::::::::::: */
1653 return (ffelexHandler) ffestb_do2_;
1654
1655 case FFELEX_typeEQUALS:
1656 if (ISDIGIT (*p))
1657 {
1658 ffesta_tokens[1]
1659 = ffelex_token_number_from_names (ffesta_tokens[0], i);
1660 p += ffelex_token_length (ffesta_tokens[1]);
1661 i += ffelex_token_length (ffesta_tokens[1]);
1662 }
1663 else
1664 ffesta_tokens[1] = NULL;
1665 if (!ffesrc_is_name_init (*p))
1666 goto bad_i1; /* :::::::::::::::::::: */
1667 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
1668 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_lhs
1669 (ffesta_output_pool, FFEEXPR_contextDO,
1670 (ffeexprCallback) ffestb_do6_)))
1671 (nt);
1672 ffelex_token_kill (nt); /* Will get it back in _6_... */
1673 return (ffelexHandler) (*next) (t);
1674
1675 case FFELEX_typeEOS:
1676 case FFELEX_typeSEMICOLON:
1677 ffesta_confirmed ();
1678 if (ISDIGIT (*p))
1679 {
1680 ffesta_tokens[1]
1681 = ffelex_token_number_from_names (ffesta_tokens[0], i);
1682 p += ffelex_token_length (ffesta_tokens[1]);
1683 i += ffelex_token_length (ffesta_tokens[1]);
1684 }
1685 else
1686 ffesta_tokens[1] = NULL;
1687 if (*p != '\0')
1688 goto bad_i1; /* :::::::::::::::::::: */
1689 return (ffelexHandler) ffestb_do1_ (t);
1690 }
1691
1692 default:
1693 goto bad_0; /* :::::::::::::::::::: */
1694 }
1695
1696 bad_0: /* :::::::::::::::::::: */
1697 if (ffesta_construct_name != NULL)
1698 {
1699 ffelex_token_kill (ffesta_construct_name);
1700 ffesta_construct_name = NULL;
1701 }
1702 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[0]);
1703 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1704
1705 bad_1: /* :::::::::::::::::::: */
1706 if (ffesta_construct_name != NULL)
1707 {
1708 ffelex_token_kill (ffesta_construct_name);
1709 ffesta_construct_name = NULL;
1710 }
1711 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
1712 return (ffelexHandler) ffelex_swallow_tokens (t,
1713 (ffelexHandler) ffesta_zero); /* Invalid second token. */
1714
1715 bad_i1: /* :::::::::::::::::::: */
1716 if (ffesta_tokens[1])
1717 ffelex_token_kill (ffesta_tokens[1]);
1718
1719 bad_i: /* :::::::::::::::::::: */
1720 if (ffesta_construct_name != NULL)
1721 {
1722 ffelex_token_kill (ffesta_construct_name);
1723 ffesta_construct_name = NULL;
1724 }
1725 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[0], i, t);
1726 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1727 }
1728
1729 /* ffestb_dowhile -- Parse the DOWHILE statement
1730
1731 return ffestb_dowhile; // to lexer
1732
1733 Make sure the statement has a valid form for the DOWHILE statement. If it
1734 does, implement the statement. */
1735
1736 ffelexHandler
1737 ffestb_dowhile (ffelexToken t)
1738 {
1739 ffeTokenLength i;
1740 const char *p;
1741 ffelexHandler next;
1742 ffelexToken nt;
1743
1744 switch (ffelex_token_type (ffesta_tokens[0]))
1745 {
1746 case FFELEX_typeNAMES:
1747 if (ffesta_first_kw != FFESTR_firstDOWHILE)
1748 goto bad_0; /* :::::::::::::::::::: */
1749 switch (ffelex_token_type (t))
1750 {
1751 case FFELEX_typeEOS:
1752 case FFELEX_typeSEMICOLON:
1753 case FFELEX_typeCOMMA:
1754 case FFELEX_typeCOLONCOLON:
1755 ffesta_confirmed (); /* Error, but clearly intended. */
1756 goto bad_1; /* :::::::::::::::::::: */
1757
1758 default:
1759 goto bad_1; /* :::::::::::::::::::: */
1760
1761 case FFELEX_typeOPEN_PAREN:
1762 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDOWHILE);
1763 if (*p != '\0')
1764 goto bad_i; /* :::::::::::::::::::: */
1765 ffesta_tokens[1] = NULL;
1766 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
1767 FFEEXPR_contextDOWHILE, (ffeexprCallback) ffestb_do4_);
1768
1769 case FFELEX_typeEQUALS:/* Not really DOWHILE, but DOWHILExyz=.... */
1770 ffesta_tokens[1] = NULL;
1771 nt = ffelex_token_name_from_names (ffesta_tokens[0], FFESTR_firstlDO,
1772 0);
1773 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_lhs
1774 (ffesta_output_pool, FFEEXPR_contextDO,
1775 (ffeexprCallback) ffestb_do6_)))
1776 (nt);
1777 ffelex_token_kill (nt); /* Will get it back in _6_... */
1778 return (ffelexHandler) (*next) (t);
1779 }
1780
1781 default:
1782 goto bad_0; /* :::::::::::::::::::: */
1783 }
1784
1785 bad_0: /* :::::::::::::::::::: */
1786 if (ffesta_construct_name != NULL)
1787 {
1788 ffelex_token_kill (ffesta_construct_name);
1789 ffesta_construct_name = NULL;
1790 }
1791 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[0]);
1792 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1793
1794 bad_1: /* :::::::::::::::::::: */
1795 if (ffesta_construct_name != NULL)
1796 {
1797 ffelex_token_kill (ffesta_construct_name);
1798 ffesta_construct_name = NULL;
1799 }
1800 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
1801 return (ffelexHandler) ffelex_swallow_tokens (t,
1802 (ffelexHandler) ffesta_zero); /* Invalid second token. */
1803
1804 bad_i: /* :::::::::::::::::::: */
1805 if (ffesta_construct_name != NULL)
1806 {
1807 ffelex_token_kill (ffesta_construct_name);
1808 ffesta_construct_name = NULL;
1809 }
1810 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[0], i, t);
1811 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1812 }
1813
1814 /* ffestb_do1_ -- "DO" [label]
1815
1816 return ffestb_do1_; // to lexer
1817
1818 Make sure the statement has a valid form for the DO statement. If it
1819 does, implement the statement. */
1820
1821 static ffelexHandler
1822 ffestb_do1_ (ffelexToken t)
1823 {
1824 switch (ffelex_token_type (t))
1825 {
1826 case FFELEX_typeCOMMA:
1827 ffesta_confirmed ();
1828 return (ffelexHandler) ffestb_do2_;
1829
1830 case FFELEX_typeEOS:
1831 case FFELEX_typeSEMICOLON:
1832 ffesta_confirmed ();
1833 if (!ffesta_is_inhibited ())
1834 {
1835 if (ffesta_tokens[1] != NULL)
1836 ffestc_R819B (ffesta_construct_name, ffesta_tokens[1], NULL,
1837 NULL);
1838 else
1839 ffestc_R820B (ffesta_construct_name, NULL, NULL);
1840 }
1841 if (ffesta_tokens[1] != NULL)
1842 ffelex_token_kill (ffesta_tokens[1]);
1843 if (ffesta_construct_name != NULL)
1844 {
1845 ffelex_token_kill (ffesta_construct_name);
1846 ffesta_construct_name = NULL;
1847 }
1848 return (ffelexHandler) ffesta_zero (t);
1849
1850 case FFELEX_typeNAME:
1851 return (ffelexHandler) ffestb_do2_ (t);
1852
1853 default:
1854 break;
1855 }
1856
1857 if (ffesta_tokens[1] != NULL)
1858 ffelex_token_kill (ffesta_tokens[1]);
1859 if (ffesta_construct_name != NULL)
1860 {
1861 ffelex_token_kill (ffesta_construct_name);
1862 ffesta_construct_name = NULL;
1863 }
1864 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
1865 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1866 }
1867
1868 /* ffestb_do2_ -- "DO" [label] [,]
1869
1870 return ffestb_do2_; // to lexer
1871
1872 Make sure the statement has a valid form for the DO statement. If it
1873 does, implement the statement. */
1874
1875 static ffelexHandler
1876 ffestb_do2_ (ffelexToken t)
1877 {
1878 switch (ffelex_token_type (t))
1879 {
1880 case FFELEX_typeNAME:
1881 ffesta_tokens[2] = ffelex_token_use (t);
1882 return (ffelexHandler) ffestb_do3_;
1883
1884 default:
1885 break;
1886 }
1887
1888 if (ffesta_tokens[1] != NULL)
1889 ffelex_token_kill (ffesta_tokens[1]);
1890 if (ffesta_construct_name != NULL)
1891 {
1892 ffelex_token_kill (ffesta_construct_name);
1893 ffesta_construct_name = NULL;
1894 }
1895 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
1896 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1897 }
1898
1899 /* ffestb_do3_ -- "DO" [label] [,] NAME
1900
1901 return ffestb_do3_; // to lexer
1902
1903 Make sure the statement has a valid form for the DO statement. If it
1904 does, implement the statement. */
1905
1906 static ffelexHandler
1907 ffestb_do3_ (ffelexToken t)
1908 {
1909 ffelexHandler next;
1910
1911 switch (ffelex_token_type (t))
1912 {
1913 case FFELEX_typeEQUALS:
1914 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
1915 FFEEXPR_contextDO, (ffeexprCallback) ffestb_do6_)))
1916 (ffesta_tokens[2]);
1917 ffelex_token_kill (ffesta_tokens[2]); /* Will get it back in _6_... */
1918 return (ffelexHandler) (*next) (t);
1919
1920 case FFELEX_typeOPEN_PAREN:
1921 if (ffestr_second (ffesta_tokens[2]) != FFESTR_secondWHILE)
1922 {
1923 if (ffesta_tokens[1] != NULL)
1924 ffelex_token_kill (ffesta_tokens[1]);
1925 if (ffesta_construct_name != NULL)
1926 {
1927 ffelex_token_kill (ffesta_construct_name);
1928 ffesta_construct_name = NULL;
1929 }
1930 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[2]);
1931 ffelex_token_kill (ffesta_tokens[2]);
1932 return (ffelexHandler) ffelex_swallow_tokens (t,
1933 (ffelexHandler) ffesta_zero); /* Invalid token. */
1934 }
1935 ffelex_token_kill (ffesta_tokens[2]);
1936 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
1937 FFEEXPR_contextDOWHILE, (ffeexprCallback) ffestb_do4_);
1938
1939 default:
1940 break;
1941 }
1942
1943 ffelex_token_kill (ffesta_tokens[2]);
1944 if (ffesta_tokens[1] != NULL)
1945 ffelex_token_kill (ffesta_tokens[1]);
1946 if (ffesta_construct_name != NULL)
1947 {
1948 ffelex_token_kill (ffesta_construct_name);
1949 ffesta_construct_name = NULL;
1950 }
1951 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
1952 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1953 }
1954
1955 /* ffestb_do4_ -- "DO" [label] [,] "WHILE" OPEN_PAREN expr
1956
1957 (ffestb_do4_) // to expression handler
1958
1959 Make sure the statement has a valid form for the DO statement. If it
1960 does, implement the statement. */
1961
1962 static ffelexHandler
1963 ffestb_do4_ (ffelexToken ft, ffebld expr, ffelexToken t)
1964 {
1965 switch (ffelex_token_type (t))
1966 {
1967 case FFELEX_typeCLOSE_PAREN:
1968 if (expr == NULL)
1969 break;
1970 ffesta_tokens[2] = ffelex_token_use (ft);
1971 ffestb_local_.dowhile.expr = expr;
1972 return (ffelexHandler) ffestb_do5_;
1973
1974 default:
1975 break;
1976 }
1977
1978 if (ffesta_tokens[1] != NULL)
1979 ffelex_token_kill (ffesta_tokens[1]);
1980 if (ffesta_construct_name != NULL)
1981 {
1982 ffelex_token_kill (ffesta_construct_name);
1983 ffesta_construct_name = NULL;
1984 }
1985 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
1986 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
1987 }
1988
1989 /* ffestb_do5_ -- "DO" [label] [,] "WHILE" OPEN_PAREN expr CLOSE_PAREN
1990
1991 return ffestb_do5_; // to lexer
1992
1993 Make sure the statement has a valid form for the DO statement. If it
1994 does, implement the statement. */
1995
1996 static ffelexHandler
1997 ffestb_do5_ (ffelexToken t)
1998 {
1999 switch (ffelex_token_type (t))
2000 {
2001 case FFELEX_typeEOS:
2002 case FFELEX_typeSEMICOLON:
2003 ffesta_confirmed ();
2004 if (!ffesta_is_inhibited ())
2005 {
2006 if (ffesta_tokens[1] != NULL)
2007 ffestc_R819B (ffesta_construct_name, ffesta_tokens[1],
2008 ffestb_local_.dowhile.expr, ffesta_tokens[2]);
2009 else
2010 ffestc_R820B (ffesta_construct_name, ffestb_local_.dowhile.expr,
2011 ffesta_tokens[2]);
2012 }
2013 ffelex_token_kill (ffesta_tokens[2]);
2014 if (ffesta_tokens[1] != NULL)
2015 ffelex_token_kill (ffesta_tokens[1]);
2016 if (ffesta_construct_name != NULL)
2017 {
2018 ffelex_token_kill (ffesta_construct_name);
2019 ffesta_construct_name = NULL;
2020 }
2021 return (ffelexHandler) ffesta_zero (t);
2022
2023 default:
2024 break;
2025 }
2026
2027 ffelex_token_kill (ffesta_tokens[2]);
2028 if (ffesta_tokens[1] != NULL)
2029 ffelex_token_kill (ffesta_tokens[1]);
2030 if (ffesta_construct_name != NULL)
2031 {
2032 ffelex_token_kill (ffesta_construct_name);
2033 ffesta_construct_name = NULL;
2034 }
2035 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
2036 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2037 }
2038
2039 /* ffestb_do6_ -- "DO" [label] [,] var-expr
2040
2041 (ffestb_do6_) // to expression handler
2042
2043 Make sure the statement has a valid form for the DO statement. If it
2044 does, implement the statement. */
2045
2046 static ffelexHandler
2047 ffestb_do6_ (ffelexToken ft, ffebld expr, ffelexToken t)
2048 {
2049 /* _3_ already ensured that this would be an EQUALS token. If not, it is a
2050 bug in the FFE. */
2051
2052 assert (ffelex_token_type (t) == FFELEX_typeEQUALS);
2053
2054 ffesta_tokens[2] = ffelex_token_use (ft);
2055 ffestb_local_.do_stmt.var = expr;
2056 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
2057 FFEEXPR_contextDO, (ffeexprCallback) ffestb_do7_);
2058 }
2059
2060 /* ffestb_do7_ -- "DO" [label] [,] var-expr EQUALS expr
2061
2062 (ffestb_do7_) // to expression handler
2063
2064 Make sure the statement has a valid form for the DO statement. If it
2065 does, implement the statement. */
2066
2067 static ffelexHandler
2068 ffestb_do7_ (ffelexToken ft, ffebld expr, ffelexToken t)
2069 {
2070 switch (ffelex_token_type (t))
2071 {
2072 case FFELEX_typeCOMMA:
2073 ffesta_confirmed ();
2074 if (expr == NULL)
2075 break;
2076 ffesta_tokens[3] = ffelex_token_use (ft);
2077 ffestb_local_.do_stmt.start = expr;
2078 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
2079 FFEEXPR_contextDO, (ffeexprCallback) ffestb_do8_);
2080
2081 default:
2082 break;
2083 }
2084
2085 ffelex_token_kill (ffesta_tokens[2]);
2086 if (ffesta_tokens[1] != NULL)
2087 ffelex_token_kill (ffesta_tokens[1]);
2088 if (ffesta_construct_name != NULL)
2089 {
2090 ffelex_token_kill (ffesta_construct_name);
2091 ffesta_construct_name = NULL;
2092 }
2093 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
2094 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2095 }
2096
2097 /* ffestb_do8_ -- "DO" [label] [,] var-expr EQUALS expr COMMA expr
2098
2099 (ffestb_do8_) // to expression handler
2100
2101 Make sure the statement has a valid form for the DO statement. If it
2102 does, implement the statement. */
2103
2104 static ffelexHandler
2105 ffestb_do8_ (ffelexToken ft, ffebld expr, ffelexToken t)
2106 {
2107 switch (ffelex_token_type (t))
2108 {
2109 case FFELEX_typeCOMMA:
2110 if (expr == NULL)
2111 break;
2112 ffesta_tokens[4] = ffelex_token_use (ft);
2113 ffestb_local_.do_stmt.end = expr;
2114 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
2115 FFEEXPR_contextDO, (ffeexprCallback) ffestb_do9_);
2116
2117 case FFELEX_typeEOS:
2118 case FFELEX_typeSEMICOLON:
2119 if (expr == NULL)
2120 break;
2121 ffesta_tokens[4] = ffelex_token_use (ft);
2122 ffestb_local_.do_stmt.end = expr;
2123 return (ffelexHandler) ffestb_do9_ (NULL, NULL, t);
2124
2125 default:
2126 break;
2127 }
2128
2129 ffelex_token_kill (ffesta_tokens[3]);
2130 ffelex_token_kill (ffesta_tokens[2]);
2131 if (ffesta_tokens[1] != NULL)
2132 ffelex_token_kill (ffesta_tokens[1]);
2133 if (ffesta_construct_name != NULL)
2134 {
2135 ffelex_token_kill (ffesta_construct_name);
2136 ffesta_construct_name = NULL;
2137 }
2138 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
2139 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2140 }
2141
2142 /* ffestb_do9_ -- "DO" [label] [,] var-expr EQUALS expr COMMA expr
2143 [COMMA expr]
2144
2145 (ffestb_do9_) // to expression handler
2146
2147 Make sure the statement has a valid form for the DO statement. If it
2148 does, implement the statement. */
2149
2150 static ffelexHandler
2151 ffestb_do9_ (ffelexToken ft, ffebld expr, ffelexToken t)
2152 {
2153 switch (ffelex_token_type (t))
2154 {
2155 case FFELEX_typeEOS:
2156 case FFELEX_typeSEMICOLON:
2157 if ((expr == NULL) && (ft != NULL))
2158 break;
2159 if (!ffesta_is_inhibited ())
2160 {
2161 if (ffesta_tokens[1] != NULL)
2162 ffestc_R819A (ffesta_construct_name, ffesta_tokens[1],
2163 ffestb_local_.do_stmt.var, ffesta_tokens[2],
2164 ffestb_local_.do_stmt.start, ffesta_tokens[3],
2165 ffestb_local_.do_stmt.end, ffesta_tokens[4], expr, ft);
2166 else
2167 ffestc_R820A (ffesta_construct_name, ffestb_local_.do_stmt.var,
2168 ffesta_tokens[2], ffestb_local_.do_stmt.start,
2169 ffesta_tokens[3], ffestb_local_.do_stmt.end,
2170 ffesta_tokens[4], expr, ft);
2171 }
2172 ffelex_token_kill (ffesta_tokens[4]);
2173 ffelex_token_kill (ffesta_tokens[3]);
2174 ffelex_token_kill (ffesta_tokens[2]);
2175 if (ffesta_tokens[1] != NULL)
2176 ffelex_token_kill (ffesta_tokens[1]);
2177 if (ffesta_construct_name != NULL)
2178 {
2179 ffelex_token_kill (ffesta_construct_name);
2180 ffesta_construct_name = NULL;
2181 }
2182
2183 return (ffelexHandler) ffesta_zero (t);
2184
2185 default:
2186 break;
2187 }
2188
2189 ffelex_token_kill (ffesta_tokens[4]);
2190 ffelex_token_kill (ffesta_tokens[3]);
2191 ffelex_token_kill (ffesta_tokens[2]);
2192 if (ffesta_tokens[1] != NULL)
2193 ffelex_token_kill (ffesta_tokens[1]);
2194 if (ffesta_construct_name != NULL)
2195 {
2196 ffelex_token_kill (ffesta_construct_name);
2197 ffesta_construct_name = NULL;
2198 }
2199 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
2200 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2201 }
2202
2203 /* ffestb_else -- Parse the ELSE statement
2204
2205 return ffestb_else; // to lexer
2206
2207 Make sure the statement has a valid form for the ELSE statement. If it
2208 does, implement the statement. */
2209
2210 ffelexHandler
2211 ffestb_else (ffelexToken t)
2212 {
2213 ffeTokenLength i;
2214 unsigned const char *p;
2215
2216 switch (ffelex_token_type (ffesta_tokens[0]))
2217 {
2218 case FFELEX_typeNAME:
2219 if (ffesta_first_kw != FFESTR_firstELSE)
2220 goto bad_0; /* :::::::::::::::::::: */
2221 switch (ffelex_token_type (t))
2222 {
2223 case FFELEX_typeEOS:
2224 case FFELEX_typeSEMICOLON:
2225 ffesta_confirmed ();
2226 ffesta_tokens[1] = NULL;
2227 ffestb_args.elsexyz.second = FFESTR_secondNone;
2228 return (ffelexHandler) ffestb_else1_ (t);
2229
2230 case FFELEX_typeCOMMA:
2231 case FFELEX_typeCOLONCOLON:
2232 ffesta_confirmed (); /* Error, but clearly intended. */
2233 goto bad_1; /* :::::::::::::::::::: */
2234
2235 default:
2236 goto bad_1; /* :::::::::::::::::::: */
2237
2238 case FFELEX_typeNAME:
2239 break;
2240 }
2241
2242 ffesta_confirmed ();
2243 ffestb_args.elsexyz.second = ffesta_second_kw;
2244 ffesta_tokens[1] = ffelex_token_use (t);
2245 return (ffelexHandler) ffestb_else1_;
2246
2247 case FFELEX_typeNAMES:
2248 if (ffesta_first_kw != FFESTR_firstELSE)
2249 goto bad_0; /* :::::::::::::::::::: */
2250 switch (ffelex_token_type (t))
2251 {
2252 case FFELEX_typeCOMMA:
2253 case FFELEX_typeCOLONCOLON:
2254 ffesta_confirmed (); /* Error, but clearly intended. */
2255 goto bad_1; /* :::::::::::::::::::: */
2256
2257 default:
2258 goto bad_1; /* :::::::::::::::::::: */
2259
2260 case FFELEX_typeEOS:
2261 case FFELEX_typeSEMICOLON:
2262 break;
2263 }
2264 ffesta_confirmed ();
2265 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlELSE)
2266 {
2267 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlELSE);
2268 if (!ffesrc_is_name_init (*p))
2269 goto bad_i; /* :::::::::::::::::::: */
2270 ffesta_tokens[1]
2271 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
2272 }
2273 else
2274 ffesta_tokens[1] = NULL;
2275 ffestb_args.elsexyz.second = FFESTR_secondNone;
2276 return (ffelexHandler) ffestb_else1_ (t);
2277
2278 default:
2279 goto bad_0; /* :::::::::::::::::::: */
2280 }
2281
2282 bad_0: /* :::::::::::::::::::: */
2283 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", ffesta_tokens[0]);
2284 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2285
2286 bad_1: /* :::::::::::::::::::: */
2287 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", t);
2288 return (ffelexHandler) ffelex_swallow_tokens (t,
2289 (ffelexHandler) ffesta_zero); /* Invalid second token. */
2290
2291 bad_i: /* :::::::::::::::::::: */
2292 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "ELSE", ffesta_tokens[0], i, t);
2293 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2294 }
2295
2296 /* ffestb_elsexyz -- Parse an ELSEIF/ELSEWHERE statement
2297
2298 return ffestb_elsexyz; // to lexer
2299
2300 Expects len and second to be set in ffestb_args.elsexyz to the length
2301 of the ELSExyz keyword involved and the corresponding ffestrSecond value. */
2302
2303 ffelexHandler
2304 ffestb_elsexyz (ffelexToken t)
2305 {
2306 ffeTokenLength i;
2307 const char *p;
2308
2309 switch (ffelex_token_type (ffesta_tokens[0]))
2310 {
2311 case FFELEX_typeNAME:
2312 switch (ffelex_token_type (t))
2313 {
2314 case FFELEX_typeEOS:
2315 case FFELEX_typeSEMICOLON:
2316 if (ffesta_first_kw == FFESTR_firstELSEIF)
2317 goto bad_0; /* :::::::::::::::::::: */
2318 ffesta_confirmed ();
2319 ffesta_tokens[1] = NULL;
2320 return (ffelexHandler) ffestb_else1_ (t);
2321
2322 case FFELEX_typeNAME:
2323 ffesta_confirmed ();
2324 goto bad_1; /* :::::::::::::::::::: */
2325
2326 case FFELEX_typeOPEN_PAREN:
2327 if (ffesta_first_kw != FFESTR_firstELSEIF)
2328 goto bad_0; /* :::::::::::::::::::: */
2329 ffesta_tokens[1] = NULL;
2330 return (ffelexHandler) ffestb_else1_ (t);
2331
2332 case FFELEX_typeCOMMA:
2333 case FFELEX_typeCOLONCOLON:
2334 ffesta_confirmed (); /* Error, but clearly intended. */
2335 goto bad_1; /* :::::::::::::::::::: */
2336
2337 default:
2338 goto bad_1; /* :::::::::::::::::::: */
2339 }
2340
2341 case FFELEX_typeNAMES:
2342 switch (ffelex_token_type (t))
2343 {
2344 case FFELEX_typeCOMMA:
2345 case FFELEX_typeCOLONCOLON:
2346 ffesta_confirmed (); /* Error, but clearly intended. */
2347 goto bad_1; /* :::::::::::::::::::: */
2348
2349 default:
2350 goto bad_1; /* :::::::::::::::::::: */
2351
2352 case FFELEX_typeOPEN_PAREN:
2353 if (ffesta_first_kw != FFESTR_firstELSEIF)
2354 goto bad_1; /* :::::::::::::::::::: */
2355 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlELSEIF)
2356 {
2357 i = FFESTR_firstlELSEIF;
2358 goto bad_i; /* :::::::::::::::::::: */
2359 }
2360 ffesta_tokens[1] = NULL;
2361 return (ffelexHandler) ffestb_else1_ (t);
2362
2363 case FFELEX_typeEOS:
2364 case FFELEX_typeSEMICOLON:
2365 break;
2366 }
2367 ffesta_confirmed ();
2368 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlELSE);
2369 ffesta_tokens[1]
2370 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
2371 return (ffelexHandler) ffestb_else1_ (t);
2372
2373 default:
2374 goto bad_0; /* :::::::::::::::::::: */
2375 }
2376
2377 bad_0: /* :::::::::::::::::::: */
2378 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", ffesta_tokens[0]);
2379 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2380
2381 bad_1: /* :::::::::::::::::::: */
2382 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", t);
2383 return (ffelexHandler) ffelex_swallow_tokens (t,
2384 (ffelexHandler) ffesta_zero); /* Invalid second token. */
2385
2386 bad_i: /* :::::::::::::::::::: */
2387 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "ELSE IF", ffesta_tokens[0], i, t);
2388 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2389 }
2390
2391 /* ffestb_else1_ -- "ELSE" (NAME)
2392
2393 return ffestb_else1_; // to lexer
2394
2395 If EOS/SEMICOLON, implement the appropriate statement (keep in mind that
2396 "ELSE WHERE" is ambiguous at the syntactic level). If OPEN_PAREN, start
2397 expression analysis with callback at _2_. */
2398
2399 static ffelexHandler
2400 ffestb_else1_ (ffelexToken t)
2401 {
2402 switch (ffelex_token_type (t))
2403 {
2404 case FFELEX_typeOPEN_PAREN:
2405 if (ffestb_args.elsexyz.second == FFESTR_secondIF)
2406 {
2407 if (ffesta_tokens[1] != NULL)
2408 ffelex_token_kill (ffesta_tokens[1]);
2409 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
2410 FFEEXPR_contextIF, (ffeexprCallback) ffestb_else2_);
2411 }
2412 /* Fall through. */
2413 default:
2414 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", t);
2415 if (ffesta_tokens[1] != NULL)
2416 ffelex_token_kill (ffesta_tokens[1]);
2417 return (ffelexHandler) ffelex_swallow_tokens (t,
2418 (ffelexHandler) ffesta_zero);
2419
2420 case FFELEX_typeEOS:
2421 case FFELEX_typeSEMICOLON:
2422 ffesta_confirmed ();
2423 break;
2424
2425 }
2426
2427 switch (ffestb_args.elsexyz.second)
2428 {
2429
2430 default:
2431 if (!ffesta_is_inhibited ())
2432 ffestc_R805 (ffesta_tokens[1]);
2433 break;
2434 }
2435
2436 if (ffesta_tokens[1] != NULL)
2437 ffelex_token_kill (ffesta_tokens[1]);
2438 return (ffelexHandler) ffesta_zero (t);
2439 }
2440
2441 /* ffestb_else2_ -- "ELSE" "IF" OPEN_PAREN expr
2442
2443 (ffestb_else2_) // to expression handler
2444
2445 Make sure the next token is CLOSE_PAREN. */
2446
2447 static ffelexHandler
2448 ffestb_else2_ (ffelexToken ft, ffebld expr, ffelexToken t)
2449 {
2450 ffestb_local_.else_stmt.expr = expr;
2451
2452 switch (ffelex_token_type (t))
2453 {
2454 case FFELEX_typeCLOSE_PAREN:
2455 if (expr == NULL)
2456 break;
2457 ffesta_tokens[1] = ffelex_token_use (ft);
2458 ffelex_set_names (TRUE);
2459 return (ffelexHandler) ffestb_else3_;
2460
2461 default:
2462 break;
2463 }
2464
2465 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t);
2466 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2467 }
2468
2469 /* ffestb_else3_ -- "ELSE" "IF" OPEN_PAREN expr CLOSE_PAREN
2470
2471 return ffestb_else3_; // to lexer
2472
2473 Make sure the next token is "THEN". */
2474
2475 static ffelexHandler
2476 ffestb_else3_ (ffelexToken t)
2477 {
2478 ffeTokenLength i;
2479 unsigned const char *p;
2480
2481 ffelex_set_names (FALSE);
2482
2483 switch (ffelex_token_type (t))
2484 {
2485 case FFELEX_typeNAME:
2486 ffesta_confirmed ();
2487 if (ffestr_first (t) == FFESTR_firstTHEN)
2488 return (ffelexHandler) ffestb_else4_;
2489 break;
2490
2491 case FFELEX_typeNAMES:
2492 ffesta_confirmed ();
2493 if (ffestr_first (t) != FFESTR_firstTHEN)
2494 break;
2495 if (ffelex_token_length (t) == FFESTR_firstlTHEN)
2496 return (ffelexHandler) ffestb_else4_;
2497 p = ffelex_token_text (t) + (i = FFESTR_firstlTHEN);
2498 if (!ffesrc_is_name_init (*p))
2499 goto bad_i; /* :::::::::::::::::::: */
2500 ffesta_tokens[2] = ffelex_token_name_from_names (t, i, 0);
2501 return (ffelexHandler) ffestb_else5_;
2502
2503 default:
2504 break;
2505 }
2506
2507 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t);
2508 ffelex_token_kill (ffesta_tokens[1]);
2509 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2510
2511 bad_i: /* :::::::::::::::::::: */
2512 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t, i, NULL);
2513 ffelex_token_kill (ffesta_tokens[1]);
2514 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2515 }
2516
2517 /* ffestb_else4_ -- "ELSE" "IF" OPEN_PAREN expr CLOSE_PAREN "THEN"
2518
2519 return ffestb_else4_; // to lexer
2520
2521 Handle a NAME or EOS/SEMICOLON, then go to state _5_. */
2522
2523 static ffelexHandler
2524 ffestb_else4_ (ffelexToken t)
2525 {
2526 ffelex_set_names (FALSE);
2527
2528 switch (ffelex_token_type (t))
2529 {
2530 case FFELEX_typeEOS:
2531 case FFELEX_typeSEMICOLON:
2532 ffesta_tokens[2] = NULL;
2533 return (ffelexHandler) ffestb_else5_ (t);
2534
2535 case FFELEX_typeNAME:
2536 ffesta_tokens[2] = ffelex_token_use (t);
2537 return (ffelexHandler) ffestb_else5_;
2538
2539 default:
2540 break;
2541 }
2542
2543 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t);
2544 ffelex_token_kill (ffesta_tokens[1]);
2545 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2546 }
2547
2548 /* ffestb_else5_ -- "ELSE" "IF" OPEN_PAREN expr CLOSE_PAREN "THEN"
2549
2550 return ffestb_else5_; // to lexer
2551
2552 Make sure the next token is EOS or SEMICOLON; implement R804. */
2553
2554 static ffelexHandler
2555 ffestb_else5_ (ffelexToken t)
2556 {
2557 switch (ffelex_token_type (t))
2558 {
2559 case FFELEX_typeEOS:
2560 case FFELEX_typeSEMICOLON:
2561 if (!ffesta_is_inhibited ())
2562 ffestc_R804 (ffestb_local_.else_stmt.expr, ffesta_tokens[1],
2563 ffesta_tokens[2]);
2564 ffelex_token_kill (ffesta_tokens[1]);
2565 if (ffesta_tokens[2] != NULL)
2566 ffelex_token_kill (ffesta_tokens[2]);
2567 return (ffelexHandler) ffesta_zero (t);
2568
2569 default:
2570 break;
2571 }
2572
2573 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t);
2574 ffelex_token_kill (ffesta_tokens[1]);
2575 if (ffesta_tokens[2] != NULL)
2576 ffelex_token_kill (ffesta_tokens[2]);
2577 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2578 }
2579
2580 /* ffestb_end -- Parse the END statement
2581
2582 return ffestb_end; // to lexer
2583
2584 Make sure the statement has a valid form for the END statement. If it
2585 does, implement the statement. */
2586
2587 ffelexHandler
2588 ffestb_end (ffelexToken t)
2589 {
2590 ffeTokenLength i;
2591
2592 switch (ffelex_token_type (ffesta_tokens[0]))
2593 {
2594 case FFELEX_typeNAME:
2595 if (ffesta_first_kw != FFESTR_firstEND)
2596 goto bad_0; /* :::::::::::::::::::: */
2597 switch (ffelex_token_type (t))
2598 {
2599 case FFELEX_typeEOS:
2600 case FFELEX_typeSEMICOLON:
2601 ffesta_tokens[1] = NULL;
2602 ffestb_args.endxyz.second = FFESTR_secondNone;
2603 return (ffelexHandler) ffestb_end3_ (t);
2604
2605 case FFELEX_typeCOMMA:
2606 case FFELEX_typeCOLONCOLON:
2607 ffesta_confirmed (); /* Error, but clearly intended. */
2608 goto bad_1; /* :::::::::::::::::::: */
2609
2610 default:
2611 goto bad_1; /* :::::::::::::::::::: */
2612
2613 case FFELEX_typeNAME:
2614 break;
2615 }
2616
2617 ffesta_confirmed ();
2618 ffestb_args.endxyz.second = ffesta_second_kw;
2619 switch (ffesta_second_kw)
2620 {
2621 case FFESTR_secondFILE:
2622 ffestb_args.beru.badname = "ENDFILE";
2623 return (ffelexHandler) ffestb_beru;
2624
2625 case FFESTR_secondBLOCK:
2626 return (ffelexHandler) ffestb_end1_;
2627
2628 case FFESTR_secondNone:
2629 goto bad_1; /* :::::::::::::::::::: */
2630
2631 default:
2632 return (ffelexHandler) ffestb_end2_;
2633 }
2634
2635 case FFELEX_typeNAMES:
2636 if (ffesta_first_kw != FFESTR_firstEND)
2637 goto bad_0; /* :::::::::::::::::::: */
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_typeEOS:
2649 case FFELEX_typeSEMICOLON:
2650 break;
2651 }
2652 ffesta_confirmed ();
2653 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlEND)
2654 {
2655 i = FFESTR_firstlEND;
2656 goto bad_i; /* :::::::::::::::::::: */
2657 }
2658 ffesta_tokens[1] = NULL;
2659 ffestb_args.endxyz.second = FFESTR_secondNone;
2660 return (ffelexHandler) ffestb_end3_ (t);
2661
2662 default:
2663 goto bad_0; /* :::::::::::::::::::: */
2664 }
2665
2666 bad_0: /* :::::::::::::::::::: */
2667 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0]);
2668 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2669
2670 bad_1: /* :::::::::::::::::::: */
2671 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
2672 return (ffelexHandler) ffelex_swallow_tokens (t,
2673 (ffelexHandler) ffesta_zero); /* Invalid second token. */
2674
2675 bad_i: /* :::::::::::::::::::: */
2676 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0], i, t);
2677 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2678 }
2679
2680 /* ffestb_endxyz -- Parse an ENDxyz statement
2681
2682 return ffestb_endxyz; // to lexer
2683
2684 Expects len and second to be set in ffestb_args.endxyz to the length
2685 of the ENDxyz keyword involved and the corresponding ffestrSecond value. */
2686
2687 ffelexHandler
2688 ffestb_endxyz (ffelexToken t)
2689 {
2690 ffeTokenLength i;
2691 unsigned const char *p;
2692
2693 switch (ffelex_token_type (ffesta_tokens[0]))
2694 {
2695 case FFELEX_typeNAME:
2696 switch (ffelex_token_type (t))
2697 {
2698 case FFELEX_typeEOS:
2699 case FFELEX_typeSEMICOLON:
2700 ffesta_confirmed ();
2701 ffesta_tokens[1] = NULL;
2702 return (ffelexHandler) ffestb_end3_ (t);
2703
2704 case FFELEX_typeNAME:
2705 ffesta_confirmed ();
2706 switch (ffestb_args.endxyz.second)
2707 {
2708 case FFESTR_secondBLOCK:
2709 if (ffesta_second_kw != FFESTR_secondDATA)
2710 goto bad_1; /* :::::::::::::::::::: */
2711 return (ffelexHandler) ffestb_end2_;
2712
2713 default:
2714 return (ffelexHandler) ffestb_end2_ (t);
2715 }
2716
2717 case FFELEX_typeCOMMA:
2718 case FFELEX_typeCOLONCOLON:
2719 ffesta_confirmed (); /* Error, but clearly intended. */
2720 goto bad_1; /* :::::::::::::::::::: */
2721
2722 default:
2723 goto bad_1; /* :::::::::::::::::::: */
2724 }
2725
2726 case FFELEX_typeNAMES:
2727 switch (ffelex_token_type (t))
2728 {
2729 case FFELEX_typeCOMMA:
2730 case FFELEX_typeCOLONCOLON:
2731 ffesta_confirmed (); /* Error, but clearly intended. */
2732 goto bad_1; /* :::::::::::::::::::: */
2733
2734 default:
2735 goto bad_1; /* :::::::::::::::::::: */
2736
2737 case FFELEX_typeEOS:
2738 case FFELEX_typeSEMICOLON:
2739 break;
2740 }
2741 ffesta_confirmed ();
2742 if (ffestb_args.endxyz.second == FFESTR_secondBLOCK)
2743 {
2744 i = FFESTR_firstlEND;
2745 goto bad_i; /* :::::::::::::::::::: */
2746 }
2747 if (ffelex_token_length (ffesta_tokens[0]) != ffestb_args.endxyz.len)
2748 {
2749 p = ffelex_token_text (ffesta_tokens[0])
2750 + (i = ffestb_args.endxyz.len);
2751 if (!ffesrc_is_name_init (*p))
2752 goto bad_i; /* :::::::::::::::::::: */
2753 ffesta_tokens[1]
2754 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
2755 return (ffelexHandler) ffestb_end3_ (t);
2756 }
2757 ffesta_tokens[1] = NULL;
2758 return (ffelexHandler) ffestb_end3_ (t);
2759
2760 default:
2761 goto bad_0; /* :::::::::::::::::::: */
2762 }
2763
2764 bad_0: /* :::::::::::::::::::: */
2765 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0]);
2766 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2767
2768 bad_1: /* :::::::::::::::::::: */
2769 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
2770 return (ffelexHandler) ffelex_swallow_tokens (t,
2771 (ffelexHandler) ffesta_zero); /* Invalid second token. */
2772
2773 bad_i: /* :::::::::::::::::::: */
2774 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0], i, t);
2775 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2776 }
2777
2778 /* ffestb_end1_ -- "END" "BLOCK"
2779
2780 return ffestb_end1_; // to lexer
2781
2782 Make sure the next token is "DATA". */
2783
2784 static ffelexHandler
2785 ffestb_end1_ (ffelexToken t)
2786 {
2787 if ((ffelex_token_type (t) == FFELEX_typeNAME)
2788 && (ffesrc_strcmp_2c (ffe_case_match (), ffelex_token_text (t), "DATA",
2789 "data", "Data")
2790 == 0))
2791 {
2792 return (ffelexHandler) ffestb_end2_;
2793 }
2794
2795 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
2796 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2797 }
2798
2799 /* ffestb_end2_ -- "END" <unit-kind>
2800
2801 return ffestb_end2_; // to lexer
2802
2803 Make sure the next token is a NAME or EOS. */
2804
2805 static ffelexHandler
2806 ffestb_end2_ (ffelexToken t)
2807 {
2808 switch (ffelex_token_type (t))
2809 {
2810 case FFELEX_typeNAME:
2811 ffesta_tokens[1] = ffelex_token_use (t);
2812 return (ffelexHandler) ffestb_end3_;
2813
2814 case FFELEX_typeEOS:
2815 case FFELEX_typeSEMICOLON:
2816 ffesta_tokens[1] = NULL;
2817 return (ffelexHandler) ffestb_end3_ (t);
2818
2819 default:
2820 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
2821 return (ffelexHandler) ffelex_swallow_tokens (t,
2822 (ffelexHandler) ffesta_zero);
2823 }
2824 }
2825
2826 /* ffestb_end3_ -- "END" <unit-kind> (NAME)
2827
2828 return ffestb_end3_; // to lexer
2829
2830 Make sure the next token is an EOS, then implement the statement. */
2831
2832 static ffelexHandler
2833 ffestb_end3_ (ffelexToken t)
2834 {
2835 switch (ffelex_token_type (t))
2836 {
2837 default:
2838 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
2839 if (ffesta_tokens[1] != NULL)
2840 ffelex_token_kill (ffesta_tokens[1]);
2841 return (ffelexHandler) ffelex_swallow_tokens (t,
2842 (ffelexHandler) ffesta_zero);
2843
2844 case FFELEX_typeEOS:
2845 case FFELEX_typeSEMICOLON:
2846 ffesta_confirmed ();
2847 if (ffestb_args.endxyz.second == FFESTR_secondNone)
2848 {
2849 if (!ffesta_is_inhibited ())
2850 ffestc_end ();
2851 return (ffelexHandler) ffesta_zero (t);
2852 }
2853 break;
2854 }
2855
2856 switch (ffestb_args.endxyz.second)
2857 {
2858 case FFESTR_secondIF:
2859 if (!ffesta_is_inhibited ())
2860 ffestc_R806 (ffesta_tokens[1]);
2861 break;
2862
2863 case FFESTR_secondSELECT:
2864 if (!ffesta_is_inhibited ())
2865 ffestc_R811 (ffesta_tokens[1]);
2866 break;
2867
2868 case FFESTR_secondDO:
2869 if (!ffesta_is_inhibited ())
2870 ffestc_R825 (ffesta_tokens[1]);
2871 break;
2872
2873 case FFESTR_secondPROGRAM:
2874 if (!ffesta_is_inhibited ())
2875 ffestc_R1103 (ffesta_tokens[1]);
2876 break;
2877
2878 case FFESTR_secondBLOCK:
2879 case FFESTR_secondBLOCKDATA:
2880 if (!ffesta_is_inhibited ())
2881 ffestc_R1112 (ffesta_tokens[1]);
2882 break;
2883
2884 case FFESTR_secondFUNCTION:
2885 if (!ffesta_is_inhibited ())
2886 ffestc_R1221 (ffesta_tokens[1]);
2887 break;
2888
2889 case FFESTR_secondSUBROUTINE:
2890 if (!ffesta_is_inhibited ())
2891 ffestc_R1225 (ffesta_tokens[1]);
2892 break;
2893
2894 default:
2895 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0]);
2896 if (ffesta_tokens[1] != NULL)
2897 ffelex_token_kill (ffesta_tokens[1]);
2898 return (ffelexHandler) ffelex_swallow_tokens (t,
2899 (ffelexHandler) ffesta_zero);
2900 }
2901
2902 if (ffesta_tokens[1] != NULL)
2903 ffelex_token_kill (ffesta_tokens[1]);
2904 return (ffelexHandler) ffesta_zero (t);
2905 }
2906
2907 /* ffestb_goto -- Parse the GOTO statement
2908
2909 return ffestb_goto; // to lexer
2910
2911 Make sure the statement has a valid form for the GOTO statement. If it
2912 does, implement the statement. */
2913
2914 ffelexHandler
2915 ffestb_goto (ffelexToken t)
2916 {
2917 ffeTokenLength i;
2918 unsigned const char *p;
2919 ffelexHandler next;
2920 ffelexToken nt;
2921
2922 switch (ffelex_token_type (ffesta_tokens[0]))
2923 {
2924 case FFELEX_typeNAME:
2925 switch (ffesta_first_kw)
2926 {
2927 case FFESTR_firstGO:
2928 if ((ffelex_token_type (t) != FFELEX_typeNAME)
2929 || (ffesta_second_kw != FFESTR_secondTO))
2930 goto bad_1; /* :::::::::::::::::::: */
2931 ffesta_confirmed ();
2932 return (ffelexHandler) ffestb_goto1_;
2933
2934 case FFESTR_firstGOTO:
2935 return (ffelexHandler) ffestb_goto1_ (t);
2936
2937 default:
2938 goto bad_0; /* :::::::::::::::::::: */
2939 }
2940
2941 case FFELEX_typeNAMES:
2942 if (ffesta_first_kw != FFESTR_firstGOTO)
2943 goto bad_0; /* :::::::::::::::::::: */
2944 switch (ffelex_token_type (t))
2945 {
2946 case FFELEX_typeCOLONCOLON:
2947 ffesta_confirmed (); /* Error, but clearly intended. */
2948 goto bad_1; /* :::::::::::::::::::: */
2949
2950 default:
2951 goto bad_1; /* :::::::::::::::::::: */
2952
2953 case FFELEX_typeOPEN_PAREN:
2954 case FFELEX_typePERCENT: /* Since GOTO I%J is apparently valid
2955 in '90. */
2956 case FFELEX_typeCOMMA:
2957 break;
2958
2959 case FFELEX_typeEOS:
2960 case FFELEX_typeSEMICOLON:
2961 ffesta_confirmed ();
2962 break;
2963 }
2964 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlGOTO)
2965 {
2966 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlGOTO);
2967 if (ISDIGIT (*p))
2968 {
2969 nt = ffelex_token_number_from_names (ffesta_tokens[0], i);
2970 p += ffelex_token_length (nt);
2971 i += ffelex_token_length (nt);
2972 if (*p != '\0')
2973 {
2974 ffelex_token_kill (nt);
2975 goto bad_i; /* :::::::::::::::::::: */
2976 }
2977 }
2978 else if (ffesrc_is_name_init (*p))
2979 {
2980 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
2981 }
2982 else
2983 goto bad_i; /* :::::::::::::::::::: */
2984 next = (ffelexHandler) ffestb_goto1_ (nt);
2985 ffelex_token_kill (nt);
2986 return (ffelexHandler) (*next) (t);
2987 }
2988 return (ffelexHandler) ffestb_goto1_ (t);
2989
2990 default:
2991 goto bad_0; /* :::::::::::::::::::: */
2992 }
2993
2994 bad_0: /* :::::::::::::::::::: */
2995 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "GO TO", ffesta_tokens[0]);
2996 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
2997
2998 bad_1: /* :::::::::::::::::::: */
2999 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "GO TO", t);
3000 return (ffelexHandler) ffelex_swallow_tokens (t,
3001 (ffelexHandler) ffesta_zero); /* Invalid second token. */
3002
3003 bad_i: /* :::::::::::::::::::: */
3004 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "GO TO", ffesta_tokens[0], i, t);
3005 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3006 }
3007
3008 /* ffestb_goto1_ -- "GOTO" or "GO" "TO"
3009
3010 return ffestb_goto1_; // to lexer
3011
3012 Make sure the statement has a valid form for the GOTO statement. If it
3013 does, implement the statement. */
3014
3015 static ffelexHandler
3016 ffestb_goto1_ (ffelexToken t)
3017 {
3018 switch (ffelex_token_type (t))
3019 {
3020 case FFELEX_typeNUMBER:
3021 if (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME)
3022 ffesta_confirmed ();
3023 ffesta_tokens[1] = ffelex_token_use (t);
3024 return (ffelexHandler) ffestb_goto2_;
3025
3026 case FFELEX_typeOPEN_PAREN:
3027 ffesta_tokens[1] = ffelex_token_use (t);
3028 ffestb_subrargs_.label_list.labels = ffestt_tokenlist_create ();
3029 ffestb_subrargs_.label_list.handler = (ffelexHandler) ffestb_goto3_;
3030 return (ffelexHandler) ffestb_subr_label_list_;
3031
3032 case FFELEX_typeNAME:
3033 if (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME)
3034 ffesta_confirmed ();
3035 return (ffelexHandler) (*((ffelexHandler)
3036 ffeexpr_lhs (ffesta_output_pool,
3037 FFEEXPR_contextAGOTO,
3038 (ffeexprCallback) ffestb_goto4_)))
3039 (t);
3040
3041 case FFELEX_typeEOS:
3042 case FFELEX_typeSEMICOLON:
3043 case FFELEX_typeCOMMA:
3044 case FFELEX_typeCOLONCOLON:
3045 ffesta_confirmed (); /* Error, but clearly intended. */
3046 break;
3047
3048 default:
3049 break;
3050 }
3051
3052 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "GO TO", t);
3053 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3054 }
3055
3056 /* ffestb_goto2_ -- "GO/TO" NUMBER
3057
3058 return ffestb_goto2_; // to lexer
3059
3060 Make sure the statement has a valid form for the GOTO statement. If it
3061 does, implement the statement. */
3062
3063 static ffelexHandler
3064 ffestb_goto2_ (ffelexToken t)
3065 {
3066 switch (ffelex_token_type (t))
3067 {
3068 case FFELEX_typeEOS:
3069 case FFELEX_typeSEMICOLON:
3070 ffesta_confirmed ();
3071 if (!ffesta_is_inhibited ())
3072 ffestc_R836 (ffesta_tokens[1]);
3073 ffelex_token_kill (ffesta_tokens[1]);
3074 return (ffelexHandler) ffesta_zero (t);
3075
3076 default:
3077 break;
3078 }
3079
3080 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "GO TO", t);
3081 ffelex_token_kill (ffesta_tokens[1]);
3082 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3083 }
3084
3085 /* ffestb_goto3_ -- "GO/TO" OPEN_PAREN label-list CLOSE_PAREN
3086
3087 return ffestb_goto3_; // to lexer
3088
3089 Make sure the statement has a valid form for the GOTO statement. If it
3090 does, implement the statement. */
3091
3092 static ffelexHandler
3093 ffestb_goto3_ (ffelexToken t)
3094 {
3095 if (!ffestb_subrargs_.label_list.ok)
3096 goto bad; /* :::::::::::::::::::: */
3097
3098 switch (ffelex_token_type (t))
3099 {
3100 case FFELEX_typeCOMMA:
3101 ffesta_confirmed ();
3102 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextCGOTO,
3103 (ffeexprCallback) ffestb_goto5_);
3104
3105 case FFELEX_typeEQUALS:
3106 case FFELEX_typePOINTS:
3107 case FFELEX_typeEOS:
3108 case FFELEX_typeSEMICOLON:
3109 break;
3110
3111 default:
3112 ffesta_confirmed ();
3113 /* Fall through. */
3114 case FFELEX_typeOPEN_PAREN: /* Could still be assignment!! */
3115 return (ffelexHandler) (*((ffelexHandler)
3116 ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextCGOTO,
3117 (ffeexprCallback) ffestb_goto5_)))
3118 (t);
3119 }
3120
3121 bad: /* :::::::::::::::::::: */
3122 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "computed-GOTO", t);
3123 ffelex_token_kill (ffesta_tokens[1]);
3124 ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
3125 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3126 }
3127
3128 /* ffestb_goto4_ -- "GO/TO" expr
3129
3130 (ffestb_goto4_) // to expression handler
3131
3132 Make sure the statement has a valid form for the GOTO statement. If it
3133 does, implement the statement. */
3134
3135 static ffelexHandler
3136 ffestb_goto4_ (ffelexToken ft, ffebld expr, ffelexToken t)
3137 {
3138 switch (ffelex_token_type (t))
3139 {
3140 case FFELEX_typeCOMMA:
3141 ffesta_confirmed ();
3142 if (expr == NULL)
3143 break;
3144 ffesta_tokens[1] = ffelex_token_use (ft);
3145 ffestb_local_.go_to.expr = expr;
3146 return (ffelexHandler) ffestb_goto6_;
3147
3148 case FFELEX_typeOPEN_PAREN:
3149 if (expr == NULL)
3150 break;
3151 ffesta_tokens[1] = ffelex_token_use (ft);
3152 ffestb_local_.go_to.expr = expr;
3153 return (ffelexHandler) ffestb_goto6_ (t);
3154
3155 case FFELEX_typeEOS:
3156 case FFELEX_typeSEMICOLON:
3157 ffesta_confirmed ();
3158 if (expr == NULL)
3159 break;
3160 if (!ffesta_is_inhibited ())
3161 ffestc_R839 (expr, ft, NULL);
3162 return (ffelexHandler) ffesta_zero (t);
3163
3164 default:
3165 break;
3166 }
3167
3168 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assigned-GOTO", t);
3169 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3170 }
3171
3172 /* ffestb_goto5_ -- "GO/TO" OPEN_PAREN label-list CLOSE_PAREN (COMMA) expr
3173
3174 (ffestb_goto5_) // to expression handler
3175
3176 Make sure the statement has a valid form for the GOTO statement. If it
3177 does, implement the statement. */
3178
3179 static ffelexHandler
3180 ffestb_goto5_ (ffelexToken ft, ffebld expr, ffelexToken t)
3181 {
3182 switch (ffelex_token_type (t))
3183 {
3184 case FFELEX_typeEOS:
3185 case FFELEX_typeSEMICOLON:
3186 if (expr == NULL)
3187 break;
3188 ffesta_confirmed ();
3189 if (!ffesta_is_inhibited ())
3190 ffestc_R837 (ffestb_subrargs_.label_list.labels, expr, ft);
3191 ffelex_token_kill (ffesta_tokens[1]);
3192 ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
3193 return (ffelexHandler) ffesta_zero (t);
3194
3195 default:
3196 break;
3197 }
3198
3199 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "computed-GOTO", t);
3200 ffelex_token_kill (ffesta_tokens[1]);
3201 ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
3202 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3203 }
3204
3205 /* ffestb_goto6_ -- "GO/TO" expr (COMMA)
3206
3207 return ffestb_goto6_; // to lexer
3208
3209 Make sure the statement has a valid form for the GOTO statement. If it
3210 does, implement the statement. */
3211
3212 static ffelexHandler
3213 ffestb_goto6_ (ffelexToken t)
3214 {
3215 switch (ffelex_token_type (t))
3216 {
3217 case FFELEX_typeOPEN_PAREN:
3218 ffesta_tokens[2] = ffelex_token_use (t);
3219 ffestb_subrargs_.label_list.labels = ffestt_tokenlist_create ();
3220 ffestb_subrargs_.label_list.handler = (ffelexHandler) ffestb_goto7_;
3221 return (ffelexHandler) ffestb_subr_label_list_;
3222
3223 default:
3224 break;
3225 }
3226
3227 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assigned-GOTO", t);
3228 ffelex_token_kill (ffesta_tokens[1]);
3229 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3230 }
3231
3232 /* ffestb_goto7_ -- "GO/TO" expr (COMMA) OPEN_PAREN label-list CLOSE_PAREN
3233
3234 return ffestb_goto7_; // to lexer
3235
3236 Make sure the statement has a valid form for the GOTO statement. If it
3237 does, implement the statement. */
3238
3239 static ffelexHandler
3240 ffestb_goto7_ (ffelexToken t)
3241 {
3242 if (!ffestb_subrargs_.label_list.ok)
3243 goto bad; /* :::::::::::::::::::: */
3244
3245 switch (ffelex_token_type (t))
3246 {
3247 case FFELEX_typeEOS:
3248 case FFELEX_typeSEMICOLON:
3249 ffesta_confirmed ();
3250 if (!ffesta_is_inhibited ())
3251 ffestc_R839 (ffestb_local_.go_to.expr, ffesta_tokens[1],
3252 ffestb_subrargs_.label_list.labels);
3253 ffelex_token_kill (ffesta_tokens[1]);
3254 ffelex_token_kill (ffesta_tokens[2]);
3255 ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
3256 return (ffelexHandler) ffesta_zero (t);
3257
3258 default:
3259 break;
3260 }
3261
3262 bad: /* :::::::::::::::::::: */
3263 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assigned-GOTO", t);
3264 ffelex_token_kill (ffesta_tokens[1]);
3265 ffelex_token_kill (ffesta_tokens[2]);
3266 ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
3267 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3268 }
3269
3270 /* ffestb_halt -- Parse the STOP/PAUSE statement
3271
3272 return ffestb_halt; // to lexer
3273
3274 Make sure the statement has a valid form for the STOP/PAUSE statement. If
3275 it does, implement the statement. */
3276
3277 ffelexHandler
3278 ffestb_halt (ffelexToken t)
3279 {
3280 ffelexHandler next;
3281
3282 switch (ffelex_token_type (ffesta_tokens[0]))
3283 {
3284 case FFELEX_typeNAME:
3285 switch (ffelex_token_type (t))
3286 {
3287 case FFELEX_typeCOMMA:
3288 case FFELEX_typeCOLONCOLON:
3289 ffesta_confirmed (); /* Error, but clearly intended. */
3290 goto bad_1; /* :::::::::::::::::::: */
3291
3292 default:
3293 goto bad_1; /* :::::::::::::::::::: */
3294
3295 case FFELEX_typeEOS:
3296 case FFELEX_typeSEMICOLON:
3297 case FFELEX_typeNAME:
3298 case FFELEX_typeNUMBER:
3299 case FFELEX_typeAPOSTROPHE:
3300 case FFELEX_typeQUOTE:
3301 ffesta_confirmed ();
3302 break;
3303 }
3304
3305 return (ffelexHandler) (*((ffelexHandler)
3306 ffeexpr_rhs (ffesta_output_pool,
3307 FFEEXPR_contextSTOP,
3308 (ffeexprCallback) ffestb_halt1_)))
3309 (t);
3310
3311 case FFELEX_typeNAMES:
3312 switch (ffelex_token_type (t))
3313 {
3314 default:
3315 goto bad_1; /* :::::::::::::::::::: */
3316
3317 case FFELEX_typeEOS:
3318 case FFELEX_typeSEMICOLON:
3319 case FFELEX_typeNAME:
3320 case FFELEX_typeNUMBER:
3321 case FFELEX_typeAPOSTROPHE:
3322 case FFELEX_typeQUOTE:
3323 ffesta_confirmed ();
3324 break;
3325 }
3326 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
3327 FFEEXPR_contextSTOP,
3328 (ffeexprCallback) ffestb_halt1_);
3329 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
3330 ffestb_args.halt.len);
3331 if (next == NULL)
3332 return (ffelexHandler) ffelex_swallow_tokens (t,
3333 (ffelexHandler) ffesta_zero);
3334 return (ffelexHandler) (*next) (t);
3335
3336 default:
3337 goto bad_0; /* :::::::::::::::::::: */
3338 }
3339
3340 bad_0: /* :::::::::::::::::::: */
3341 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
3342 (ffesta_first_kw == FFESTR_firstSTOP)
3343 ? "STOP" : "PAUSE",
3344 ffesta_tokens[0]);
3345 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3346
3347 bad_1: /* :::::::::::::::::::: */
3348 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
3349 (ffesta_first_kw == FFESTR_firstSTOP)
3350 ? "STOP" : "PAUSE",
3351 t);
3352 return (ffelexHandler) ffelex_swallow_tokens (t,
3353 (ffelexHandler) ffesta_zero); /* Invalid second token. */
3354 }
3355
3356 /* ffestb_halt1_ -- "STOP/PAUSE" expr
3357
3358 (ffestb_halt1_) // to expression handler
3359
3360 Make sure the next token is an EOS or SEMICOLON. */
3361
3362 static ffelexHandler
3363 ffestb_halt1_ (ffelexToken ft, ffebld expr, ffelexToken t)
3364 {
3365 switch (ffelex_token_type (t))
3366 {
3367 case FFELEX_typeEOS:
3368 case FFELEX_typeSEMICOLON:
3369 ffesta_confirmed ();
3370 if (!ffesta_is_inhibited ())
3371 {
3372 if (ffesta_first_kw == FFESTR_firstSTOP)
3373 ffestc_R842 (expr, ft);
3374 else
3375 ffestc_R843 (expr, ft);
3376 }
3377 return (ffelexHandler) ffesta_zero (t);
3378
3379 default:
3380 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
3381 (ffesta_first_kw == FFESTR_firstSTOP)
3382 ? "STOP" : "PAUSE",
3383 t);
3384 break;
3385 }
3386
3387 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3388 }
3389
3390 /* ffestb_if -- Parse an IF statement
3391
3392 return ffestb_if; // to lexer
3393
3394 Make sure the statement has a valid form for an IF statement.
3395 If it does, implement the statement. */
3396
3397 ffelexHandler
3398 ffestb_if (ffelexToken t)
3399 {
3400 switch (ffelex_token_type (ffesta_tokens[0]))
3401 {
3402 case FFELEX_typeNAME:
3403 if (ffesta_first_kw != FFESTR_firstIF)
3404 goto bad_0; /* :::::::::::::::::::: */
3405 break;
3406
3407 case FFELEX_typeNAMES:
3408 if (ffesta_first_kw != FFESTR_firstIF)
3409 goto bad_0; /* :::::::::::::::::::: */
3410 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlIF)
3411 goto bad_0; /* :::::::::::::::::::: */
3412 break;
3413
3414 default:
3415 goto bad_0; /* :::::::::::::::::::: */
3416 }
3417
3418 switch (ffelex_token_type (t))
3419 {
3420 case FFELEX_typeOPEN_PAREN:
3421 break;
3422
3423 case FFELEX_typeEOS:
3424 case FFELEX_typeSEMICOLON:
3425 case FFELEX_typeCOMMA:
3426 case FFELEX_typeCOLONCOLON:
3427 ffesta_confirmed (); /* Error, but clearly intended. */
3428 goto bad_1; /* :::::::::::::::::::: */
3429
3430 default:
3431 goto bad_1; /* :::::::::::::::::::: */
3432 }
3433
3434 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextIF,
3435 (ffeexprCallback) ffestb_if1_);
3436
3437 bad_0: /* :::::::::::::::::::: */
3438 if (ffesta_construct_name != NULL)
3439 {
3440 ffelex_token_kill (ffesta_construct_name);
3441 ffesta_construct_name = NULL;
3442 }
3443 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IF", ffesta_tokens[0]);
3444 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3445
3446 bad_1: /* :::::::::::::::::::: */
3447 if (ffesta_construct_name != NULL)
3448 {
3449 ffelex_token_kill (ffesta_construct_name);
3450 ffesta_construct_name = NULL;
3451 }
3452 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IF", t);
3453 return (ffelexHandler) ffelex_swallow_tokens (t,
3454 (ffelexHandler) ffesta_zero); /* Invalid second token. */
3455 }
3456
3457 /* ffestb_if1_ -- "IF" OPEN_PAREN expr
3458
3459 (ffestb_if1_) // to expression handler
3460
3461 Make sure the next token is CLOSE_PAREN. */
3462
3463 static ffelexHandler
3464 ffestb_if1_ (ffelexToken ft, ffebld expr, ffelexToken t)
3465 {
3466 ffestb_local_.if_stmt.expr = expr;
3467
3468 switch (ffelex_token_type (t))
3469 {
3470 case FFELEX_typeCLOSE_PAREN:
3471 if (expr == NULL)
3472 break;
3473 ffesta_tokens[1] = ffelex_token_use (ft);
3474 ffelex_set_names (TRUE);
3475 return (ffelexHandler) ffestb_if2_;
3476
3477 default:
3478 break;
3479 }
3480
3481 if (ffesta_construct_name != NULL)
3482 {
3483 ffelex_token_kill (ffesta_construct_name);
3484 ffesta_construct_name = NULL;
3485 }
3486 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IF", t);
3487 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3488 }
3489
3490 /* ffestb_if2_ -- "IF" OPEN_PAREN expr CLOSE_PAREN
3491
3492 return ffestb_if2_; // to lexer
3493
3494 Make sure the next token is NAME. */
3495
3496 static ffelexHandler
3497 ffestb_if2_ (ffelexToken t)
3498 {
3499 ffelex_set_names (FALSE);
3500
3501 switch (ffelex_token_type (t))
3502 {
3503 case FFELEX_typeNAME:
3504 case FFELEX_typeNAMES:
3505 ffesta_confirmed ();
3506 ffesta_tokens[2] = ffelex_token_use (t);
3507 return (ffelexHandler) ffestb_if3_;
3508
3509 default:
3510 break;
3511 }
3512
3513 ffelex_token_kill (ffesta_tokens[1]);
3514 if ((ffesta_construct_name == NULL)
3515 || (ffelex_token_type (t) != FFELEX_typeNUMBER))
3516 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IF", t);
3517 else
3518 ffesta_ffebad_2st (FFEBAD_INVALID_STMT_FORM, "CONSTRUCT",
3519 ffesta_construct_name, t);
3520 if (ffesta_construct_name != NULL)
3521 {
3522 ffelex_token_kill (ffesta_construct_name);
3523 ffesta_construct_name = NULL;
3524 }
3525 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3526 }
3527
3528 /* ffestb_if3_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NAME
3529
3530 return ffestb_if3_; // to lexer
3531
3532 If the next token is EOS or SEMICOLON and the preceding NAME was "THEN",
3533 implement R803. Else, implement R807 and send the preceding NAME followed
3534 by the current token. */
3535
3536 static ffelexHandler
3537 ffestb_if3_ (ffelexToken t)
3538 {
3539 ffelexHandler next;
3540
3541 switch (ffelex_token_type (t))
3542 {
3543 case FFELEX_typeEOS:
3544 case FFELEX_typeSEMICOLON:
3545 if (ffestr_first (ffesta_tokens[2]) == FFESTR_firstTHEN)
3546 {
3547 if (!ffesta_is_inhibited ())
3548 ffestc_R803 (ffesta_construct_name, ffestb_local_.if_stmt.expr,
3549 ffesta_tokens[1]);
3550 ffelex_token_kill (ffesta_tokens[1]);
3551 ffelex_token_kill (ffesta_tokens[2]);
3552 if (ffesta_construct_name != NULL)
3553 {
3554 ffelex_token_kill (ffesta_construct_name);
3555 ffesta_construct_name = NULL;
3556 }
3557 return (ffelexHandler) ffesta_zero (t);
3558 }
3559 break;
3560
3561 default:
3562 break;
3563 }
3564
3565 if (ffesta_construct_name != NULL)
3566 {
3567 if (!ffesta_is_inhibited ())
3568 ffesta_ffebad_2st (FFEBAD_INVALID_STMT_FORM, "CONSTRUCT",
3569 ffesta_construct_name, ffesta_tokens[2]);
3570 ffelex_token_kill (ffesta_construct_name);
3571 ffesta_construct_name = NULL;
3572 ffelex_token_kill (ffesta_tokens[1]);
3573 ffelex_token_kill (ffesta_tokens[2]);
3574 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3575 }
3576
3577 if (!ffesta_is_inhibited ())
3578 ffestc_R807 (ffestb_local_.if_stmt.expr, ffesta_tokens[1]);
3579 ffelex_token_kill (ffesta_tokens[1]);
3580 {
3581 ffelexToken my_2 = ffesta_tokens[2];
3582
3583 next = (ffelexHandler) ffesta_two (my_2, t);
3584 ffelex_token_kill (my_2);
3585 }
3586 return (ffelexHandler) next;
3587 }
3588
3589 /* ffestb_let -- Parse an assignment statement
3590
3591 return ffestb_let; // to lexer
3592
3593 Make sure the statement has a valid form for an assignment statement. If
3594 it does, implement the statement. */
3595
3596 ffelexHandler
3597 ffestb_let (ffelexToken t)
3598 {
3599 ffelexHandler next;
3600 bool vxtparam; /* TRUE if it might really be a VXT PARAMETER
3601 stmt. */
3602 unsigned const char *p;
3603
3604 switch (ffelex_token_type (ffesta_tokens[0]))
3605 {
3606 case FFELEX_typeNAME:
3607 vxtparam = FALSE;
3608 break;
3609
3610 case FFELEX_typeNAMES:
3611 vxtparam = TRUE;
3612 break;
3613
3614 default:
3615 goto bad_0; /* :::::::::::::::::::: */
3616 }
3617
3618 switch (ffelex_token_type (t))
3619 {
3620 case FFELEX_typeOPEN_PAREN:
3621 case FFELEX_typePERCENT:
3622 case FFELEX_typePOINTS:
3623 ffestb_local_.let.vxtparam = FALSE;
3624 break;
3625
3626 case FFELEX_typeEQUALS:
3627 if (!vxtparam || (ffesta_first_kw != FFESTR_firstPARAMETER))
3628 {
3629 ffestb_local_.let.vxtparam = FALSE;
3630 break;
3631 }
3632 p = ffelex_token_text (ffesta_tokens[0]) + FFESTR_firstlPARAMETER;
3633 ffestb_local_.let.vxtparam = ffesrc_is_name_init (*p);
3634 break;
3635
3636 default:
3637 goto bad_1; /* :::::::::::::::::::: */
3638 }
3639
3640 next = (ffelexHandler) (*((ffelexHandler)
3641 ffeexpr_lhs (ffesta_output_pool,
3642 FFEEXPR_contextLET,
3643 (ffeexprCallback) ffestb_let1_)))
3644 (ffesta_tokens[0]);
3645 return (ffelexHandler) (*next) (t);
3646
3647 bad_0: /* :::::::::::::::::::: */
3648 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assignment", ffesta_tokens[0]);
3649 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3650
3651 bad_1: /* :::::::::::::::::::: */
3652 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assignment", t);
3653 return (ffelexHandler) ffelex_swallow_tokens (t,
3654 (ffelexHandler) ffesta_zero); /* Invalid second token. */
3655 }
3656
3657 /* ffestb_let1_ -- expr
3658
3659 (ffestb_let1_) // to expression handler
3660
3661 Make sure the next token is EQUALS or POINTS. */
3662
3663 static ffelexHandler
3664 ffestb_let1_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
3665 {
3666 ffestb_local_.let.dest = expr;
3667
3668 switch (ffelex_token_type (t))
3669 {
3670 case FFELEX_typeEQUALS:
3671 if (expr == NULL)
3672 break;
3673 ffesta_tokens[1] = ffelex_token_use (t);
3674 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
3675 FFEEXPR_contextLET, (ffeexprCallback) ffestb_let2_);
3676
3677 default:
3678 break;
3679 }
3680
3681 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assignment", t);
3682 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3683 }
3684
3685 /* ffestb_let2_ -- expr EQUALS/POINTS expr
3686
3687 (ffestb_end2_) // to expression handler
3688
3689 Make sure the next token is EOS or SEMICOLON; implement the statement. */
3690
3691 static ffelexHandler
3692 ffestb_let2_ (ffelexToken ft, ffebld expr, ffelexToken t)
3693 {
3694 switch (ffelex_token_type (t))
3695 {
3696 case FFELEX_typeEOS:
3697 case FFELEX_typeSEMICOLON:
3698 if (expr == NULL)
3699 break;
3700 if (ffestb_local_.let.vxtparam && !ffestc_is_let_not_V027 ())
3701 break;
3702 ffesta_confirmed ();
3703 if (!ffesta_is_inhibited ())
3704 ffestc_let (ffestb_local_.let.dest, expr, ft);
3705 ffelex_token_kill (ffesta_tokens[1]);
3706 return (ffelexHandler) ffesta_zero (t);
3707
3708 default:
3709 break;
3710 }
3711
3712 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
3713 (ffelex_token_type (ffesta_tokens[1]) == FFELEX_typeEQUALS)
3714 ? "assignment" : "pointer-assignment",
3715 t);
3716 ffelex_token_kill (ffesta_tokens[1]);
3717 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3718 }
3719
3720 /* ffestb_varlist -- Parse EXTERNAL/INTENT/INTRINSIC/OPTIONAL/PUBLIC/PRIVATE
3721 statement
3722
3723 return ffestb_varlist; // to lexer
3724
3725 Make sure the statement has a valid form. If it
3726 does, implement the statement. */
3727
3728 ffelexHandler
3729 ffestb_varlist (ffelexToken t)
3730 {
3731 ffeTokenLength i;
3732 unsigned const char *p;
3733 ffelexToken nt;
3734 ffelexHandler next;
3735
3736 switch (ffelex_token_type (ffesta_tokens[0]))
3737 {
3738 case FFELEX_typeNAME:
3739 switch (ffelex_token_type (t))
3740 {
3741 case FFELEX_typeEOS:
3742 case FFELEX_typeSEMICOLON:
3743 ffesta_confirmed ();
3744 goto bad_1; /* :::::::::::::::::::: */
3745
3746 case FFELEX_typeCOMMA:
3747 ffesta_confirmed (); /* Error, but clearly intended. */
3748 goto bad_1; /* :::::::::::::::::::: */
3749
3750 case FFELEX_typeCOLONCOLON:
3751 ffesta_confirmed ();
3752 ffesta_confirmed (); /* Error, but clearly intended. */
3753 goto bad_1; /* :::::::::::::::::::: */
3754
3755 default:
3756 goto bad_1; /* :::::::::::::::::::: */
3757
3758 case FFELEX_typeOPEN_PAREN:
3759 goto bad_1; /* :::::::::::::::::::: */
3760
3761 case FFELEX_typeNAME:
3762 ffesta_confirmed ();
3763 switch (ffesta_first_kw)
3764 {
3765 case FFESTR_firstEXTERNAL:
3766 if (!ffesta_is_inhibited ())
3767 ffestc_R1207_start ();
3768 break;
3769
3770 case FFESTR_firstINTRINSIC:
3771 if (!ffesta_is_inhibited ())
3772 ffestc_R1208_start ();
3773 break;
3774
3775 default:
3776 break;
3777 }
3778 return (ffelexHandler) ffestb_varlist5_ (t);
3779 }
3780
3781 case FFELEX_typeNAMES:
3782 p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.varlist.len);
3783 switch (ffelex_token_type (t))
3784 {
3785 case FFELEX_typeEOS:
3786 case FFELEX_typeSEMICOLON:
3787 ffesta_confirmed ();
3788 if (*p != '\0')
3789 break;
3790 goto bad_1; /* :::::::::::::::::::: */
3791
3792 case FFELEX_typeCOMMA:
3793 ffesta_confirmed (); /* Error, but clearly intended. */
3794
3795 if (*p != '\0')
3796 break;
3797 goto bad_1; /* :::::::::::::::::::: */
3798
3799 case FFELEX_typeCOLONCOLON:
3800 ffesta_confirmed ();
3801 goto bad_1; /* :::::::::::::::::::: */
3802
3803 case FFELEX_typeOPEN_PAREN:
3804 goto bad_1; /* :::::::::::::::::::: */
3805
3806 case FFELEX_typeNAME:
3807 ffesta_confirmed ();
3808 switch (ffesta_first_kw)
3809 {
3810 case FFESTR_firstEXTERNAL:
3811 if (!ffesta_is_inhibited ())
3812 ffestc_R1207_start ();
3813 break;
3814
3815 case FFESTR_firstINTRINSIC:
3816 if (!ffesta_is_inhibited ())
3817 ffestc_R1208_start ();
3818 break;
3819
3820 default:
3821 break;
3822 }
3823 return (ffelexHandler) ffestb_varlist5_ (t);
3824
3825 default:
3826 goto bad_1; /* :::::::::::::::::::: */
3827 }
3828
3829 /* Here, we have at least one char after the first keyword and t is
3830 COMMA or EOS/SEMICOLON. Also we know that this form is valid for
3831 only the statements reaching here (specifically, INTENT won't reach
3832 here). */
3833
3834 if (!ffesrc_is_name_init (*p))
3835 goto bad_i; /* :::::::::::::::::::: */
3836 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
3837 if (!ffesta_is_inhibited ())
3838 {
3839 switch (ffesta_first_kw)
3840 {
3841 case FFESTR_firstEXTERNAL:
3842 ffestc_R1207_start ();
3843 break;
3844
3845 case FFESTR_firstINTRINSIC:
3846 ffestc_R1208_start ();
3847 break;
3848
3849 default:
3850 assert (FALSE);
3851 }
3852 }
3853 next = (ffelexHandler) ffestb_varlist5_ (nt);
3854 ffelex_token_kill (nt);
3855 return (ffelexHandler) (*next) (t);
3856
3857 default:
3858 goto bad_0; /* :::::::::::::::::::: */
3859 }
3860
3861 bad_0: /* :::::::::::::::::::: */
3862 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, ffesta_tokens[0]);
3863 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3864
3865 bad_1: /* :::::::::::::::::::: */
3866 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
3867 return (ffelexHandler) ffelex_swallow_tokens (t,
3868 (ffelexHandler) ffesta_zero); /* Invalid second token. */
3869
3870 bad_i: /* :::::::::::::::::::: */
3871 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, ffesta_tokens[0], i, t);
3872 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3873 }
3874
3875 /* ffestb_varlist5_ -- Handles the list of variable names
3876
3877 return ffestb_varlist5_; // to lexer
3878
3879 Handle NAME. */
3880
3881 static ffelexHandler
3882 ffestb_varlist5_ (ffelexToken t)
3883 {
3884 switch (ffelex_token_type (t))
3885 {
3886 case FFELEX_typeNAME:
3887 ffesta_tokens[1] = ffelex_token_use (t);
3888 return (ffelexHandler) ffestb_varlist6_;
3889
3890 default:
3891 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
3892 break;
3893 }
3894
3895 if (!ffesta_is_inhibited ())
3896 {
3897 switch (ffesta_first_kw)
3898 {
3899 case FFESTR_firstEXTERNAL:
3900 ffestc_R1207_finish ();
3901 break;
3902
3903 case FFESTR_firstINTRINSIC:
3904 ffestc_R1208_finish ();
3905 break;
3906
3907 default:
3908 assert (FALSE);
3909 }
3910 }
3911 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3912 }
3913
3914 /* ffestb_varlist6_ -- (whatever) NAME
3915
3916 return ffestb_varlist6_; // to lexer
3917
3918 Handle COMMA or EOS/SEMICOLON. */
3919
3920 static ffelexHandler
3921 ffestb_varlist6_ (ffelexToken t)
3922 {
3923 switch (ffelex_token_type (t))
3924 {
3925 case FFELEX_typeCOMMA:
3926 if (!ffesta_is_inhibited ())
3927 {
3928 switch (ffesta_first_kw)
3929 {
3930 case FFESTR_firstEXTERNAL:
3931 ffestc_R1207_item (ffesta_tokens[1]);
3932 break;
3933
3934 case FFESTR_firstINTRINSIC:
3935 ffestc_R1208_item (ffesta_tokens[1]);
3936 break;
3937
3938 default:
3939 assert (FALSE);
3940 }
3941 }
3942 ffelex_token_kill (ffesta_tokens[1]);
3943 return (ffelexHandler) ffestb_varlist5_;
3944
3945 case FFELEX_typeEOS:
3946 case FFELEX_typeSEMICOLON:
3947 if (!ffesta_is_inhibited ())
3948 {
3949 switch (ffesta_first_kw)
3950 {
3951 case FFESTR_firstEXTERNAL:
3952 ffestc_R1207_item (ffesta_tokens[1]);
3953 ffestc_R1207_finish ();
3954 break;
3955
3956 case FFESTR_firstINTRINSIC:
3957 ffestc_R1208_item (ffesta_tokens[1]);
3958 ffestc_R1208_finish ();
3959 break;
3960
3961 default:
3962 assert (FALSE);
3963 }
3964 }
3965 ffelex_token_kill (ffesta_tokens[1]);
3966 return (ffelexHandler) ffesta_zero (t);
3967
3968 default:
3969 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
3970 break;
3971 }
3972
3973 if (!ffesta_is_inhibited ())
3974 {
3975 switch (ffesta_first_kw)
3976 {
3977 case FFESTR_firstEXTERNAL:
3978 ffestc_R1207_finish ();
3979 break;
3980
3981 case FFESTR_firstINTRINSIC:
3982 ffestc_R1208_finish ();
3983 break;
3984
3985 default:
3986 assert (FALSE);
3987 }
3988 }
3989 ffelex_token_kill (ffesta_tokens[1]);
3990 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
3991 }
3992
3993 /* ffestb_R522 -- Parse the SAVE statement
3994
3995 return ffestb_R522; // to lexer
3996
3997 Make sure the statement has a valid form for the SAVE statement. If it
3998 does, implement the statement. */
3999
4000 ffelexHandler
4001 ffestb_R522 (ffelexToken t)
4002 {
4003 ffeTokenLength i;
4004 unsigned const char *p;
4005 ffelexToken nt;
4006 ffelexHandler next;
4007
4008 switch (ffelex_token_type (ffesta_tokens[0]))
4009 {
4010 case FFELEX_typeNAME:
4011 if (ffesta_first_kw != FFESTR_firstSAVE)
4012 goto bad_0; /* :::::::::::::::::::: */
4013 switch (ffelex_token_type (t))
4014 {
4015 case FFELEX_typeCOMMA:
4016 ffesta_confirmed (); /* Error, but clearly intended. */
4017 goto bad_1; /* :::::::::::::::::::: */
4018
4019 default:
4020 goto bad_1; /* :::::::::::::::::::: */
4021
4022 case FFELEX_typeEOS:
4023 case FFELEX_typeSEMICOLON:
4024 ffesta_confirmed ();
4025 if (!ffesta_is_inhibited ())
4026 ffestc_R522 ();
4027 return (ffelexHandler) ffesta_zero (t);
4028
4029 case FFELEX_typeNAME:
4030 case FFELEX_typeSLASH:
4031 ffesta_confirmed ();
4032 if (!ffesta_is_inhibited ())
4033 ffestc_R522start ();
4034 return (ffelexHandler) ffestb_R5221_ (t);
4035
4036 case FFELEX_typeCOLONCOLON:
4037 ffesta_confirmed ();
4038 if (!ffesta_is_inhibited ())
4039 ffestc_R522start ();
4040 return (ffelexHandler) ffestb_R5221_;
4041 }
4042
4043 case FFELEX_typeNAMES:
4044 if (ffesta_first_kw != FFESTR_firstSAVE)
4045 goto bad_0; /* :::::::::::::::::::: */
4046 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSAVE);
4047 switch (ffelex_token_type (t))
4048 {
4049 default:
4050 goto bad_1; /* :::::::::::::::::::: */
4051
4052 case FFELEX_typeCOMMA:
4053 ffesta_confirmed ();
4054 break;
4055
4056 case FFELEX_typeEOS:
4057 case FFELEX_typeSEMICOLON:
4058 ffesta_confirmed ();
4059 if (*p != '\0')
4060 break;
4061 if (!ffesta_is_inhibited ())
4062 ffestc_R522 ();
4063 return (ffelexHandler) ffesta_zero (t);
4064
4065 case FFELEX_typeSLASH:
4066 ffesta_confirmed ();
4067 if (*p != '\0')
4068 goto bad_i; /* :::::::::::::::::::: */
4069 if (!ffesta_is_inhibited ())
4070 ffestc_R522start ();
4071 return (ffelexHandler) ffestb_R5221_ (t);
4072
4073 case FFELEX_typeCOLONCOLON:
4074 ffesta_confirmed ();
4075 if (*p != '\0')
4076 goto bad_i; /* :::::::::::::::::::: */
4077 if (!ffesta_is_inhibited ())
4078 ffestc_R522start ();
4079 return (ffelexHandler) ffestb_R5221_;
4080 }
4081
4082 /* Here, we have at least one char after "SAVE" and t is COMMA or
4083 EOS/SEMICOLON. */
4084
4085 if (!ffesrc_is_name_init (*p))
4086 goto bad_i; /* :::::::::::::::::::: */
4087 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
4088 if (!ffesta_is_inhibited ())
4089 ffestc_R522start ();
4090 next = (ffelexHandler) ffestb_R5221_ (nt);
4091 ffelex_token_kill (nt);
4092 return (ffelexHandler) (*next) (t);
4093
4094 default:
4095 goto bad_0; /* :::::::::::::::::::: */
4096 }
4097
4098 bad_0: /* :::::::::::::::::::: */
4099 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", ffesta_tokens[0]);
4100 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4101
4102 bad_1: /* :::::::::::::::::::: */
4103 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
4104 return (ffelexHandler) ffelex_swallow_tokens (t,
4105 (ffelexHandler) ffesta_zero); /* Invalid second token. */
4106
4107 bad_i: /* :::::::::::::::::::: */
4108 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "SAVE", ffesta_tokens[0], i, t);
4109 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4110 }
4111
4112 /* ffestb_R5221_ -- "SAVE" [COLONCOLON]
4113
4114 return ffestb_R5221_; // to lexer
4115
4116 Handle NAME or SLASH. */
4117
4118 static ffelexHandler
4119 ffestb_R5221_ (ffelexToken t)
4120 {
4121 switch (ffelex_token_type (t))
4122 {
4123 case FFELEX_typeNAME:
4124 ffestb_local_.R522.is_cblock = FALSE;
4125 ffesta_tokens[1] = ffelex_token_use (t);
4126 return (ffelexHandler) ffestb_R5224_;
4127
4128 case FFELEX_typeSLASH:
4129 ffestb_local_.R522.is_cblock = TRUE;
4130 return (ffelexHandler) ffestb_R5222_;
4131
4132 default:
4133 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
4134 break;
4135 }
4136
4137 if (!ffesta_is_inhibited ())
4138 ffestc_R522finish ();
4139 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4140 }
4141
4142 /* ffestb_R5222_ -- "SAVE" [COLONCOLON] SLASH
4143
4144 return ffestb_R5222_; // to lexer
4145
4146 Handle NAME. */
4147
4148 static ffelexHandler
4149 ffestb_R5222_ (ffelexToken t)
4150 {
4151 switch (ffelex_token_type (t))
4152 {
4153 case FFELEX_typeNAME:
4154 ffesta_tokens[1] = ffelex_token_use (t);
4155 return (ffelexHandler) ffestb_R5223_;
4156
4157 default:
4158 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
4159 break;
4160 }
4161
4162 if (!ffesta_is_inhibited ())
4163 ffestc_R522finish ();
4164 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4165 }
4166
4167 /* ffestb_R5223_ -- "SAVE" [COLONCOLON] SLASH NAME
4168
4169 return ffestb_R5223_; // to lexer
4170
4171 Handle SLASH. */
4172
4173 static ffelexHandler
4174 ffestb_R5223_ (ffelexToken t)
4175 {
4176 switch (ffelex_token_type (t))
4177 {
4178 case FFELEX_typeSLASH:
4179 return (ffelexHandler) ffestb_R5224_;
4180
4181 default:
4182 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
4183 break;
4184 }
4185
4186 if (!ffesta_is_inhibited ())
4187 ffestc_R522finish ();
4188 ffelex_token_kill (ffesta_tokens[1]);
4189 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4190 }
4191
4192 /* ffestb_R5224_ -- "SAVE" [COLONCOLON] R523
4193
4194 return ffestb_R5224_; // to lexer
4195
4196 Handle COMMA or EOS/SEMICOLON. */
4197
4198 static ffelexHandler
4199 ffestb_R5224_ (ffelexToken t)
4200 {
4201 switch (ffelex_token_type (t))
4202 {
4203 case FFELEX_typeCOMMA:
4204 if (!ffesta_is_inhibited ())
4205 {
4206 if (ffestb_local_.R522.is_cblock)
4207 ffestc_R522item_cblock (ffesta_tokens[1]);
4208 else
4209 ffestc_R522item_object (ffesta_tokens[1]);
4210 }
4211 ffelex_token_kill (ffesta_tokens[1]);
4212 return (ffelexHandler) ffestb_R5221_;
4213
4214 case FFELEX_typeEOS:
4215 case FFELEX_typeSEMICOLON:
4216 if (!ffesta_is_inhibited ())
4217 {
4218 if (ffestb_local_.R522.is_cblock)
4219 ffestc_R522item_cblock (ffesta_tokens[1]);
4220 else
4221 ffestc_R522item_object (ffesta_tokens[1]);
4222 ffestc_R522finish ();
4223 }
4224 ffelex_token_kill (ffesta_tokens[1]);
4225 return (ffelexHandler) ffesta_zero (t);
4226
4227 default:
4228 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
4229 break;
4230 }
4231
4232 if (!ffesta_is_inhibited ())
4233 ffestc_R522finish ();
4234 ffelex_token_kill (ffesta_tokens[1]);
4235 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4236 }
4237
4238 /* ffestb_R528 -- Parse the DATA statement
4239
4240 return ffestb_R528; // to lexer
4241
4242 Make sure the statement has a valid form for the DATA statement. If it
4243 does, implement the statement. */
4244
4245 ffelexHandler
4246 ffestb_R528 (ffelexToken t)
4247 {
4248 unsigned const char *p;
4249 ffeTokenLength i;
4250 ffelexToken nt;
4251 ffelexHandler next;
4252
4253 switch (ffelex_token_type (ffesta_tokens[0]))
4254 {
4255 case FFELEX_typeNAME:
4256 if (ffesta_first_kw != FFESTR_firstDATA)
4257 goto bad_0; /* :::::::::::::::::::: */
4258 switch (ffelex_token_type (t))
4259 {
4260 case FFELEX_typeCOMMA:
4261 case FFELEX_typeEOS:
4262 case FFELEX_typeSEMICOLON:
4263 case FFELEX_typeSLASH:
4264 case FFELEX_typeCOLONCOLON:
4265 ffesta_confirmed (); /* Error, but clearly intended. */
4266 goto bad_1; /* :::::::::::::::::::: */
4267
4268 default:
4269 goto bad_1; /* :::::::::::::::::::: */
4270
4271 case FFELEX_typeNAME:
4272 ffesta_confirmed ();
4273 break;
4274
4275 case FFELEX_typeOPEN_PAREN:
4276 break;
4277 }
4278 ffestb_local_.data.started = FALSE;
4279 return (ffelexHandler) (*((ffelexHandler)
4280 ffeexpr_lhs (ffesta_output_pool,
4281 FFEEXPR_contextDATA,
4282 (ffeexprCallback) ffestb_R5281_)))
4283 (t);
4284
4285 case FFELEX_typeNAMES:
4286 if (ffesta_first_kw != FFESTR_firstDATA)
4287 goto bad_0; /* :::::::::::::::::::: */
4288 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDATA);
4289 switch (ffelex_token_type (t))
4290 {
4291 case FFELEX_typeEOS:
4292 case FFELEX_typeSEMICOLON:
4293 case FFELEX_typeCOLONCOLON:
4294 ffesta_confirmed (); /* Error, but clearly intended. */
4295 goto bad_1; /* :::::::::::::::::::: */
4296
4297 default:
4298 goto bad_1; /* :::::::::::::::::::: */
4299
4300 case FFELEX_typeOPEN_PAREN:
4301 if (*p == '\0')
4302 {
4303 ffestb_local_.data.started = FALSE;
4304 return (ffelexHandler) (*((ffelexHandler)
4305 ffeexpr_lhs (ffesta_output_pool,
4306 FFEEXPR_contextDATA,
4307 (ffeexprCallback)
4308 ffestb_R5281_)))
4309 (t);
4310 }
4311 break;
4312
4313 case FFELEX_typeCOMMA:
4314 case FFELEX_typeSLASH:
4315 ffesta_confirmed ();
4316 break;
4317 }
4318 if (!ffesrc_is_name_init (*p))
4319 goto bad_i; /* :::::::::::::::::::: */
4320 ffestb_local_.data.started = FALSE;
4321 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
4322 next = (ffelexHandler) (*((ffelexHandler)
4323 ffeexpr_lhs (ffesta_output_pool,
4324 FFEEXPR_contextDATA,
4325 (ffeexprCallback) ffestb_R5281_)))
4326 (nt);
4327 ffelex_token_kill (nt);
4328 return (ffelexHandler) (*next) (t);
4329
4330 default:
4331 goto bad_0; /* :::::::::::::::::::: */
4332 }
4333
4334 bad_0: /* :::::::::::::::::::: */
4335 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", ffesta_tokens[0]);
4336 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4337
4338 bad_1: /* :::::::::::::::::::: */
4339 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
4340 return (ffelexHandler) ffelex_swallow_tokens (t,
4341 (ffelexHandler) ffesta_zero); /* Invalid second token. */
4342
4343 bad_i: /* :::::::::::::::::::: */
4344 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DATA", ffesta_tokens[0], i, t);
4345 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4346 }
4347
4348 /* ffestb_R5281_ -- "DATA" expr-list
4349
4350 (ffestb_R5281_) // to expression handler
4351
4352 Handle COMMA or SLASH. */
4353
4354 static ffelexHandler
4355 ffestb_R5281_ (ffelexToken ft, ffebld expr, ffelexToken t)
4356 {
4357 switch (ffelex_token_type (t))
4358 {
4359 case FFELEX_typeCOMMA:
4360 ffesta_confirmed ();
4361 if (expr == NULL)
4362 break;
4363 if (!ffesta_is_inhibited ())
4364 {
4365 if (!ffestb_local_.data.started)
4366 {
4367 ffestc_R528_start ();
4368 ffestb_local_.data.started = TRUE;
4369 }
4370 ffestc_R528_item_object (expr, ft);
4371 }
4372 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
4373 FFEEXPR_contextDATA,
4374 (ffeexprCallback) ffestb_R5281_);
4375
4376 case FFELEX_typeSLASH:
4377 ffesta_confirmed ();
4378 if (expr == NULL)
4379 break;
4380 if (!ffesta_is_inhibited ())
4381 {
4382 if (!ffestb_local_.data.started)
4383 {
4384 ffestc_R528_start ();
4385 ffestb_local_.data.started = TRUE;
4386 }
4387 ffestc_R528_item_object (expr, ft);
4388 ffestc_R528_item_startvals ();
4389 }
4390 return (ffelexHandler) ffeexpr_rhs
4391 (ffesta_output_pool, FFEEXPR_contextDATA,
4392 (ffeexprCallback) ffestb_R5282_);
4393
4394 default:
4395 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
4396 break;
4397 }
4398
4399 if (ffestb_local_.data.started && !ffesta_is_inhibited ())
4400 ffestc_R528_finish ();
4401 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4402 }
4403
4404 /* ffestb_R5282_ -- "DATA" expr-list SLASH expr-list
4405
4406 (ffestb_R5282_) // to expression handler
4407
4408 Handle ASTERISK, COMMA, or SLASH. */
4409
4410 static ffelexHandler
4411 ffestb_R5282_ (ffelexToken ft, ffebld expr, ffelexToken t)
4412 {
4413 switch (ffelex_token_type (t))
4414 {
4415 case FFELEX_typeCOMMA:
4416 if (expr == NULL)
4417 break;
4418 if (!ffesta_is_inhibited ())
4419 ffestc_R528_item_value (NULL, NULL, expr, ft);
4420 return (ffelexHandler) ffeexpr_rhs
4421 (ffesta_output_pool, FFEEXPR_contextDATA,
4422 (ffeexprCallback) ffestb_R5282_);
4423
4424 case FFELEX_typeASTERISK:
4425 if (expr == NULL)
4426 break;
4427 ffestb_local_.data.expr = ffeexpr_convert (expr, ft, t,
4428 FFEINFO_basictypeINTEGER,
4429 FFEINFO_kindtypeINTEGER1,
4430 0,
4431 FFETARGET_charactersizeNONE,
4432 FFEEXPR_contextLET);
4433 ffesta_tokens[1] = ffelex_token_use (ft);
4434 return (ffelexHandler) ffeexpr_rhs
4435 (ffesta_output_pool, FFEEXPR_contextDATA,
4436 (ffeexprCallback) ffestb_R5283_);
4437
4438 case FFELEX_typeSLASH:
4439 if (expr == NULL)
4440 break;
4441 if (!ffesta_is_inhibited ())
4442 {
4443 ffestc_R528_item_value (NULL, NULL, expr, ft);
4444 ffestc_R528_item_endvals (t);
4445 }
4446 return (ffelexHandler) ffestb_R5284_;
4447
4448 default:
4449 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
4450 break;
4451 }
4452
4453 if (!ffesta_is_inhibited ())
4454 {
4455 ffestc_R528_item_endvals (t);
4456 ffestc_R528_finish ();
4457 }
4458 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4459 }
4460
4461 /* ffestb_R5283_ -- "DATA" expr-list SLASH expr ASTERISK expr
4462
4463 (ffestb_R5283_) // to expression handler
4464
4465 Handle COMMA or SLASH. */
4466
4467 static ffelexHandler
4468 ffestb_R5283_ (ffelexToken ft, ffebld expr, ffelexToken t)
4469 {
4470 switch (ffelex_token_type (t))
4471 {
4472 case FFELEX_typeCOMMA:
4473 if (expr == NULL)
4474 break;
4475 if (!ffesta_is_inhibited ())
4476 ffestc_R528_item_value (ffestb_local_.data.expr, ffesta_tokens[1],
4477 expr, ft);
4478 ffelex_token_kill (ffesta_tokens[1]);
4479 return (ffelexHandler) ffeexpr_rhs
4480 (ffesta_output_pool, FFEEXPR_contextDATA,
4481 (ffeexprCallback) ffestb_R5282_);
4482
4483 case FFELEX_typeSLASH:
4484 if (expr == NULL)
4485 break;
4486 if (!ffesta_is_inhibited ())
4487 {
4488 ffestc_R528_item_value (ffestb_local_.data.expr, ffesta_tokens[1],
4489 expr, ft);
4490 ffestc_R528_item_endvals (t);
4491 }
4492 ffelex_token_kill (ffesta_tokens[1]);
4493 return (ffelexHandler) ffestb_R5284_;
4494
4495 default:
4496 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
4497 break;
4498 }
4499
4500 if (!ffesta_is_inhibited ())
4501 {
4502 ffestc_R528_item_endvals (t);
4503 ffestc_R528_finish ();
4504 }
4505 ffelex_token_kill (ffesta_tokens[1]);
4506 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4507 }
4508
4509 /* ffestb_R5284_ -- "DATA" expr-list SLASH expr-list SLASH
4510
4511 return ffestb_R5284_; // to lexer
4512
4513 Handle [COMMA] NAME or EOS/SEMICOLON. */
4514
4515 static ffelexHandler
4516 ffestb_R5284_ (ffelexToken t)
4517 {
4518 switch (ffelex_token_type (t))
4519 {
4520 case FFELEX_typeCOMMA:
4521 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
4522 FFEEXPR_contextDATA,
4523 (ffeexprCallback) ffestb_R5281_);
4524
4525 case FFELEX_typeNAME:
4526 case FFELEX_typeOPEN_PAREN:
4527 return (ffelexHandler) (*((ffelexHandler)
4528 ffeexpr_lhs (ffesta_output_pool,
4529 FFEEXPR_contextDATA,
4530 (ffeexprCallback) ffestb_R5281_)))
4531 (t);
4532
4533 case FFELEX_typeEOS:
4534 case FFELEX_typeSEMICOLON:
4535 if (!ffesta_is_inhibited ())
4536 ffestc_R528_finish ();
4537 return (ffelexHandler) ffesta_zero (t);
4538
4539 default:
4540 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
4541 break;
4542 }
4543
4544 if (!ffesta_is_inhibited ())
4545 ffestc_R528_finish ();
4546 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4547 }
4548
4549 /* ffestb_R537 -- Parse a PARAMETER statement
4550
4551 return ffestb_R537; // to lexer
4552
4553 Make sure the statement has a valid form for an PARAMETER statement.
4554 If it does, implement the statement. */
4555
4556 ffelexHandler
4557 ffestb_R537 (ffelexToken t)
4558 {
4559 switch (ffelex_token_type (ffesta_tokens[0]))
4560 {
4561 case FFELEX_typeNAME:
4562 if (ffesta_first_kw != FFESTR_firstPARAMETER)
4563 goto bad_0; /* :::::::::::::::::::: */
4564 break;
4565
4566 case FFELEX_typeNAMES:
4567 if (ffesta_first_kw != FFESTR_firstPARAMETER)
4568 goto bad_0; /* :::::::::::::::::::: */
4569 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlPARAMETER)
4570 goto bad_0; /* :::::::::::::::::::: */
4571 break;
4572
4573 default:
4574 goto bad_0; /* :::::::::::::::::::: */
4575 }
4576
4577 switch (ffelex_token_type (t))
4578 {
4579 case FFELEX_typeOPEN_PAREN:
4580 break;
4581
4582 case FFELEX_typeEOS:
4583 case FFELEX_typeSEMICOLON:
4584 case FFELEX_typeCOMMA:
4585 case FFELEX_typeCOLONCOLON:
4586 ffesta_confirmed (); /* Error, but clearly intended. */
4587 goto bad_1; /* :::::::::::::::::::: */
4588
4589 default:
4590 goto bad_1; /* :::::::::::::::::::: */
4591 }
4592
4593 ffestb_local_.parameter.started = FALSE;
4594 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
4595 FFEEXPR_contextPARAMETER,
4596 (ffeexprCallback) ffestb_R5371_);
4597
4598 bad_0: /* :::::::::::::::::::: */
4599 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", ffesta_tokens[0]);
4600 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4601
4602 bad_1: /* :::::::::::::::::::: */
4603 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
4604 return (ffelexHandler) ffelex_swallow_tokens (t,
4605 (ffelexHandler) ffesta_zero); /* Invalid second token. */
4606 }
4607
4608 /* ffestb_R5371_ -- "PARAMETER" OPEN_PAREN expr
4609
4610 (ffestb_R5371_) // to expression handler
4611
4612 Make sure the next token is EQUALS. */
4613
4614 static ffelexHandler
4615 ffestb_R5371_ (ffelexToken ft, ffebld expr, ffelexToken t)
4616 {
4617 ffestb_local_.parameter.expr = expr;
4618
4619 switch (ffelex_token_type (t))
4620 {
4621 case FFELEX_typeEQUALS:
4622 ffesta_confirmed ();
4623 if (expr == NULL)
4624 break;
4625 ffesta_tokens[1] = ffelex_token_use (ft);
4626 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
4627 FFEEXPR_contextPARAMETER, (ffeexprCallback) ffestb_R5372_);
4628
4629 default:
4630 break;
4631 }
4632
4633 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
4634 if (ffestb_local_.parameter.started)
4635 ffestc_R537_finish ();
4636 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4637 }
4638
4639 /* ffestb_R5372_ -- "PARAMETER" OPEN_PAREN expr EQUALS expr
4640
4641 (ffestb_R5372_) // to expression handler
4642
4643 Make sure the next token is COMMA or CLOSE_PAREN. */
4644
4645 static ffelexHandler
4646 ffestb_R5372_ (ffelexToken ft, ffebld expr, ffelexToken t)
4647 {
4648 switch (ffelex_token_type (t))
4649 {
4650 case FFELEX_typeCOMMA:
4651 if (expr == NULL)
4652 break;
4653 if (!ffesta_is_inhibited ())
4654 {
4655 if (!ffestb_local_.parameter.started)
4656 {
4657 ffestc_R537_start ();
4658 ffestb_local_.parameter.started = TRUE;
4659 }
4660 ffestc_R537_item (ffestb_local_.parameter.expr, ffesta_tokens[1],
4661 expr, ft);
4662 }
4663 ffelex_token_kill (ffesta_tokens[1]);
4664 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
4665 FFEEXPR_contextPARAMETER,
4666 (ffeexprCallback) ffestb_R5371_);
4667
4668 case FFELEX_typeCLOSE_PAREN:
4669 if (expr == NULL)
4670 break;
4671 if (!ffesta_is_inhibited ())
4672 {
4673 if (!ffestb_local_.parameter.started)
4674 {
4675 ffestc_R537_start ();
4676 ffestb_local_.parameter.started = TRUE;
4677 }
4678 ffestc_R537_item (ffestb_local_.parameter.expr, ffesta_tokens[1],
4679 expr, ft);
4680 ffestc_R537_finish ();
4681 }
4682 ffelex_token_kill (ffesta_tokens[1]);
4683 return (ffelexHandler) ffestb_R5373_;
4684
4685 default:
4686 break;
4687 }
4688
4689 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
4690 if (ffestb_local_.parameter.started)
4691 ffestc_R537_finish ();
4692 ffelex_token_kill (ffesta_tokens[1]);
4693 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4694 }
4695
4696 /* ffestb_R5373_ -- "PARAMETER" OPEN_PAREN expr EQUALS expr CLOSE_PAREN
4697
4698 return ffestb_R5373_; // to lexer
4699
4700 Make sure the next token is EOS or SEMICOLON, or generate an error. All
4701 cleanup has already been done, by the way. */
4702
4703 static ffelexHandler
4704 ffestb_R5373_ (ffelexToken t)
4705 {
4706 switch (ffelex_token_type (t))
4707 {
4708 case FFELEX_typeEOS:
4709 case FFELEX_typeSEMICOLON:
4710 return (ffelexHandler) ffesta_zero (t);
4711
4712 default:
4713 break;
4714 }
4715
4716 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
4717 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4718 }
4719
4720 /* ffestb_R542 -- Parse the NAMELIST statement
4721
4722 return ffestb_R542; // to lexer
4723
4724 Make sure the statement has a valid form for the NAMELIST statement. If it
4725 does, implement the statement. */
4726
4727 ffelexHandler
4728 ffestb_R542 (ffelexToken t)
4729 {
4730 const char *p;
4731 ffeTokenLength i;
4732
4733 switch (ffelex_token_type (ffesta_tokens[0]))
4734 {
4735 case FFELEX_typeNAME:
4736 if (ffesta_first_kw != FFESTR_firstNAMELIST)
4737 goto bad_0; /* :::::::::::::::::::: */
4738 break;
4739
4740 case FFELEX_typeNAMES:
4741 if (ffesta_first_kw != FFESTR_firstNAMELIST)
4742 goto bad_0; /* :::::::::::::::::::: */
4743 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlNAMELIST);
4744 if (*p != '\0')
4745 goto bad_i; /* :::::::::::::::::::: */
4746 break;
4747
4748 default:
4749 goto bad_0; /* :::::::::::::::::::: */
4750 }
4751
4752 switch (ffelex_token_type (t))
4753 {
4754 case FFELEX_typeCOMMA:
4755 case FFELEX_typeEOS:
4756 case FFELEX_typeSEMICOLON:
4757 case FFELEX_typeCOLONCOLON:
4758 ffesta_confirmed (); /* Error, but clearly intended. */
4759 goto bad_1; /* :::::::::::::::::::: */
4760
4761 default:
4762 goto bad_1; /* :::::::::::::::::::: */
4763
4764 case FFELEX_typeSLASH:
4765 break;
4766 }
4767
4768 ffesta_confirmed ();
4769 if (!ffesta_is_inhibited ())
4770 ffestc_R542_start ();
4771 return (ffelexHandler) ffestb_R5421_;
4772
4773 bad_0: /* :::::::::::::::::::: */
4774 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", ffesta_tokens[0]);
4775 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4776
4777 bad_1: /* :::::::::::::::::::: */
4778 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
4779 return (ffelexHandler) ffelex_swallow_tokens (t,
4780 (ffelexHandler) ffesta_zero); /* Invalid second token. */
4781
4782 bad_i: /* :::::::::::::::::::: */
4783 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "NAMELIST", ffesta_tokens[0], i, t);
4784 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4785 }
4786
4787 /* ffestb_R5421_ -- "NAMELIST" SLASH
4788
4789 return ffestb_R5421_; // to lexer
4790
4791 Handle NAME. */
4792
4793 static ffelexHandler
4794 ffestb_R5421_ (ffelexToken t)
4795 {
4796 switch (ffelex_token_type (t))
4797 {
4798 case FFELEX_typeNAME:
4799 if (!ffesta_is_inhibited ())
4800 ffestc_R542_item_nlist (t);
4801 return (ffelexHandler) ffestb_R5422_;
4802
4803 default:
4804 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
4805 break;
4806 }
4807
4808 if (!ffesta_is_inhibited ())
4809 ffestc_R542_finish ();
4810 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4811 }
4812
4813 /* ffestb_R5422_ -- "NAMELIST" SLASH NAME
4814
4815 return ffestb_R5422_; // to lexer
4816
4817 Handle SLASH. */
4818
4819 static ffelexHandler
4820 ffestb_R5422_ (ffelexToken t)
4821 {
4822 switch (ffelex_token_type (t))
4823 {
4824 case FFELEX_typeSLASH:
4825 return (ffelexHandler) ffestb_R5423_;
4826
4827 default:
4828 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
4829 break;
4830 }
4831
4832 if (!ffesta_is_inhibited ())
4833 ffestc_R542_finish ();
4834 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4835 }
4836
4837 /* ffestb_R5423_ -- "NAMELIST" SLASH NAME SLASH
4838
4839 return ffestb_R5423_; // to lexer
4840
4841 Handle NAME. */
4842
4843 static ffelexHandler
4844 ffestb_R5423_ (ffelexToken t)
4845 {
4846 switch (ffelex_token_type (t))
4847 {
4848 case FFELEX_typeNAME:
4849 if (!ffesta_is_inhibited ())
4850 ffestc_R542_item_nitem (t);
4851 return (ffelexHandler) ffestb_R5424_;
4852
4853 default:
4854 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
4855 break;
4856 }
4857
4858 if (!ffesta_is_inhibited ())
4859 ffestc_R542_finish ();
4860 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4861 }
4862
4863 /* ffestb_R5424_ -- "NAMELIST" SLASH NAME SLASH NAME
4864
4865 return ffestb_R5424_; // to lexer
4866
4867 Handle COMMA, EOS/SEMICOLON, or SLASH. */
4868
4869 static ffelexHandler
4870 ffestb_R5424_ (ffelexToken t)
4871 {
4872 switch (ffelex_token_type (t))
4873 {
4874 case FFELEX_typeCOMMA:
4875 return (ffelexHandler) ffestb_R5425_;
4876
4877 case FFELEX_typeEOS:
4878 case FFELEX_typeSEMICOLON:
4879 if (!ffesta_is_inhibited ())
4880 ffestc_R542_finish ();
4881 return (ffelexHandler) ffesta_zero (t);
4882
4883 case FFELEX_typeSLASH:
4884 return (ffelexHandler) ffestb_R5421_;
4885
4886 default:
4887 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
4888 break;
4889 }
4890
4891 if (!ffesta_is_inhibited ())
4892 ffestc_R542_finish ();
4893 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4894 }
4895
4896 /* ffestb_R5425_ -- "NAMELIST" SLASH NAME SLASH NAME COMMA
4897
4898 return ffestb_R5425_; // to lexer
4899
4900 Handle NAME or SLASH. */
4901
4902 static ffelexHandler
4903 ffestb_R5425_ (ffelexToken t)
4904 {
4905 switch (ffelex_token_type (t))
4906 {
4907 case FFELEX_typeNAME:
4908 if (!ffesta_is_inhibited ())
4909 ffestc_R542_item_nitem (t);
4910 return (ffelexHandler) ffestb_R5424_;
4911
4912 case FFELEX_typeSLASH:
4913 return (ffelexHandler) ffestb_R5421_;
4914
4915 default:
4916 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
4917 break;
4918 }
4919
4920 if (!ffesta_is_inhibited ())
4921 ffestc_R542_finish ();
4922 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4923 }
4924
4925 /* ffestb_R544 -- Parse an EQUIVALENCE statement
4926
4927 return ffestb_R544; // to lexer
4928
4929 Make sure the statement has a valid form for an EQUIVALENCE statement.
4930 If it does, implement the statement. */
4931
4932 ffelexHandler
4933 ffestb_R544 (ffelexToken t)
4934 {
4935 switch (ffelex_token_type (ffesta_tokens[0]))
4936 {
4937 case FFELEX_typeNAME:
4938 if (ffesta_first_kw != FFESTR_firstEQUIVALENCE)
4939 goto bad_0; /* :::::::::::::::::::: */
4940 break;
4941
4942 case FFELEX_typeNAMES:
4943 if (ffesta_first_kw != FFESTR_firstEQUIVALENCE)
4944 goto bad_0; /* :::::::::::::::::::: */
4945 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlEQUIVALENCE)
4946 goto bad_0; /* :::::::::::::::::::: */
4947 break;
4948
4949 default:
4950 goto bad_0; /* :::::::::::::::::::: */
4951 }
4952
4953 switch (ffelex_token_type (t))
4954 {
4955 case FFELEX_typeOPEN_PAREN:
4956 break;
4957
4958 case FFELEX_typeEOS:
4959 case FFELEX_typeSEMICOLON:
4960 case FFELEX_typeCOMMA:
4961 case FFELEX_typeCOLONCOLON:
4962 ffesta_confirmed (); /* Error, but clearly intended. */
4963 goto bad_1; /* :::::::::::::::::::: */
4964
4965 default:
4966 goto bad_1; /* :::::::::::::::::::: */
4967 }
4968
4969 ffestb_local_.equivalence.started = FALSE;
4970 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
4971 FFEEXPR_contextEQUIVALENCE,
4972 (ffeexprCallback) ffestb_R5441_);
4973
4974 bad_0: /* :::::::::::::::::::: */
4975 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", ffesta_tokens[0]);
4976 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
4977
4978 bad_1: /* :::::::::::::::::::: */
4979 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
4980 return (ffelexHandler) ffelex_swallow_tokens (t,
4981 (ffelexHandler) ffesta_zero); /* Invalid second token. */
4982 }
4983
4984 /* ffestb_R5441_ -- "EQUIVALENCE" OPEN_PAREN expr
4985
4986 (ffestb_R5441_) // to expression handler
4987
4988 Make sure the next token is COMMA. */
4989
4990 static ffelexHandler
4991 ffestb_R5441_ (ffelexToken ft, ffebld expr, ffelexToken t)
4992 {
4993 switch (ffelex_token_type (t))
4994 {
4995 case FFELEX_typeCOMMA:
4996 if (expr == NULL)
4997 break;
4998 ffestb_local_.equivalence.exprs = ffestt_exprlist_create ();
4999 ffestt_exprlist_append (ffestb_local_.equivalence.exprs, expr,
5000 ffelex_token_use (ft));
5001 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
5002 FFEEXPR_contextEQUIVALENCE,
5003 (ffeexprCallback) ffestb_R5442_);
5004
5005 default:
5006 break;
5007 }
5008
5009 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
5010 if (ffestb_local_.equivalence.started)
5011 ffestc_R544_finish ();
5012 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5013 }
5014
5015 /* ffestb_R5442_ -- "EQUIVALENCE" OPEN_PAREN expr COMMA expr
5016
5017 (ffestb_R5442_) // to expression handler
5018
5019 Make sure the next token is COMMA or CLOSE_PAREN. For COMMA, we just
5020 append the expression to our list and continue; for CLOSE_PAREN, we
5021 append the expression and move to _3_. */
5022
5023 static ffelexHandler
5024 ffestb_R5442_ (ffelexToken ft, ffebld expr, ffelexToken t)
5025 {
5026 switch (ffelex_token_type (t))
5027 {
5028 case FFELEX_typeCOMMA:
5029 if (expr == NULL)
5030 break;
5031 ffestt_exprlist_append (ffestb_local_.equivalence.exprs, expr,
5032 ffelex_token_use (ft));
5033 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
5034 FFEEXPR_contextEQUIVALENCE,
5035 (ffeexprCallback) ffestb_R5442_);
5036
5037 case FFELEX_typeCLOSE_PAREN:
5038 if (expr == NULL)
5039 break;
5040 ffestt_exprlist_append (ffestb_local_.equivalence.exprs, expr,
5041 ffelex_token_use (ft));
5042 return (ffelexHandler) ffestb_R5443_;
5043
5044 default:
5045 break;
5046 }
5047
5048 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
5049 if (ffestb_local_.equivalence.started)
5050 ffestc_R544_finish ();
5051 ffestt_exprlist_kill (ffestb_local_.equivalence.exprs);
5052 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5053 }
5054
5055 /* ffestb_R5443_ -- "EQUIVALENCE" OPEN_PAREN expr COMMA expr CLOSE_PAREN
5056
5057 return ffestb_R5443_; // to lexer
5058
5059 Make sure the next token is COMMA or EOS/SEMICOLON. */
5060
5061 static ffelexHandler
5062 ffestb_R5443_ (ffelexToken t)
5063 {
5064 switch (ffelex_token_type (t))
5065 {
5066 case FFELEX_typeCOMMA:
5067 ffesta_confirmed ();
5068 if (!ffesta_is_inhibited ())
5069 {
5070 if (!ffestb_local_.equivalence.started)
5071 {
5072 ffestc_R544_start ();
5073 ffestb_local_.equivalence.started = TRUE;
5074 }
5075 ffestc_R544_item (ffestb_local_.equivalence.exprs);
5076 }
5077 ffestt_exprlist_kill (ffestb_local_.equivalence.exprs);
5078 return (ffelexHandler) ffestb_R5444_;
5079
5080 case FFELEX_typeEOS:
5081 case FFELEX_typeSEMICOLON:
5082 ffesta_confirmed ();
5083 if (!ffesta_is_inhibited ())
5084 {
5085 if (!ffestb_local_.equivalence.started)
5086 {
5087 ffestc_R544_start ();
5088 ffestb_local_.equivalence.started = TRUE;
5089 }
5090 ffestc_R544_item (ffestb_local_.equivalence.exprs);
5091 ffestc_R544_finish ();
5092 }
5093 ffestt_exprlist_kill (ffestb_local_.equivalence.exprs);
5094 return (ffelexHandler) ffesta_zero (t);
5095
5096 default:
5097 break;
5098 }
5099
5100 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
5101 if (ffestb_local_.equivalence.started)
5102 ffestc_R544_finish ();
5103 ffestt_exprlist_kill (ffestb_local_.equivalence.exprs);
5104 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5105 }
5106
5107 /* ffestb_R5444_ -- "EQUIVALENCE" OPEN_PAREN expr COMMA expr CLOSE_PAREN COMMA
5108
5109 return ffestb_R5444_; // to lexer
5110
5111 Make sure the next token is OPEN_PAREN, or generate an error. */
5112
5113 static ffelexHandler
5114 ffestb_R5444_ (ffelexToken t)
5115 {
5116 switch (ffelex_token_type (t))
5117 {
5118 case FFELEX_typeOPEN_PAREN:
5119 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
5120 FFEEXPR_contextEQUIVALENCE,
5121 (ffeexprCallback) ffestb_R5441_);
5122
5123 default:
5124 break;
5125 }
5126
5127 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
5128 if (ffestb_local_.equivalence.started)
5129 ffestc_R544_finish ();
5130 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5131 }
5132
5133 /* ffestb_R834 -- Parse the CYCLE statement
5134
5135 return ffestb_R834; // to lexer
5136
5137 Make sure the statement has a valid form for the CYCLE statement. If
5138 it does, implement the statement. */
5139
5140 ffelexHandler
5141 ffestb_R834 (ffelexToken t)
5142 {
5143 ffeTokenLength i;
5144 unsigned const char *p;
5145
5146 switch (ffelex_token_type (ffesta_tokens[0]))
5147 {
5148 case FFELEX_typeNAME:
5149 if (ffesta_first_kw != FFESTR_firstCYCLE)
5150 goto bad_0; /* :::::::::::::::::::: */
5151 switch (ffelex_token_type (t))
5152 {
5153 case FFELEX_typeCOMMA:
5154 case FFELEX_typeCOLONCOLON:
5155 ffesta_confirmed (); /* Error, but clearly intended. */
5156 goto bad_1; /* :::::::::::::::::::: */
5157
5158 default:
5159 goto bad_1; /* :::::::::::::::::::: */
5160
5161 case FFELEX_typeNAME:
5162 ffesta_confirmed ();
5163 ffesta_tokens[1] = ffelex_token_use (t);
5164 return (ffelexHandler) ffestb_R8341_;
5165
5166 case FFELEX_typeEOS:
5167 case FFELEX_typeSEMICOLON:
5168 ffesta_confirmed ();
5169 ffesta_tokens[1] = NULL;
5170 return (ffelexHandler) ffestb_R8341_ (t);
5171 }
5172
5173 case FFELEX_typeNAMES:
5174 if (ffesta_first_kw != FFESTR_firstCYCLE)
5175 goto bad_0; /* :::::::::::::::::::: */
5176 switch (ffelex_token_type (t))
5177 {
5178 default:
5179 goto bad_1; /* :::::::::::::::::::: */
5180
5181 case FFELEX_typeEOS:
5182 case FFELEX_typeSEMICOLON:
5183 break;
5184 }
5185 ffesta_confirmed ();
5186 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCYCLE);
5187 if (*p == '\0')
5188 {
5189 ffesta_tokens[1] = NULL;
5190 }
5191 else
5192 {
5193 if (!ffesrc_is_name_init (*p))
5194 goto bad_i; /* :::::::::::::::::::: */
5195 ffesta_tokens[1]
5196 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
5197 }
5198 return (ffelexHandler) ffestb_R8341_ (t);
5199
5200 default:
5201 goto bad_0; /* :::::::::::::::::::: */
5202 }
5203
5204 bad_0: /* :::::::::::::::::::: */
5205 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CYCLE", ffesta_tokens[0]);
5206 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5207
5208 bad_1: /* :::::::::::::::::::: */
5209 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CYCLE", t);
5210 return (ffelexHandler) ffelex_swallow_tokens (t,
5211 (ffelexHandler) ffesta_zero); /* Invalid second token. */
5212
5213 bad_i: /* :::::::::::::::::::: */
5214 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CYCLE", ffesta_tokens[0], i, t);
5215 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5216 }
5217
5218 /* ffestb_R8341_ -- "CYCLE" [NAME]
5219
5220 return ffestb_R8341_; // to lexer
5221
5222 Make sure the next token is an EOS or SEMICOLON. */
5223
5224 static ffelexHandler
5225 ffestb_R8341_ (ffelexToken t)
5226 {
5227 switch (ffelex_token_type (t))
5228 {
5229 case FFELEX_typeEOS:
5230 case FFELEX_typeSEMICOLON:
5231 ffesta_confirmed ();
5232 if (!ffesta_is_inhibited ())
5233 ffestc_R834 (ffesta_tokens[1]);
5234 if (ffesta_tokens[1] != NULL)
5235 ffelex_token_kill (ffesta_tokens[1]);
5236 return (ffelexHandler) ffesta_zero (t);
5237
5238 default:
5239 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CYCLE", t);
5240 break;
5241 }
5242
5243 if (ffesta_tokens[1] != NULL)
5244 ffelex_token_kill (ffesta_tokens[1]);
5245 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5246 }
5247
5248 /* ffestb_R835 -- Parse the EXIT statement
5249
5250 return ffestb_R835; // to lexer
5251
5252 Make sure the statement has a valid form for the EXIT statement. If
5253 it does, implement the statement. */
5254
5255 ffelexHandler
5256 ffestb_R835 (ffelexToken t)
5257 {
5258 ffeTokenLength i;
5259 unsigned const char *p;
5260
5261 switch (ffelex_token_type (ffesta_tokens[0]))
5262 {
5263 case FFELEX_typeNAME:
5264 if (ffesta_first_kw != FFESTR_firstEXIT)
5265 goto bad_0; /* :::::::::::::::::::: */
5266 switch (ffelex_token_type (t))
5267 {
5268 case FFELEX_typeCOMMA:
5269 case FFELEX_typeCOLONCOLON:
5270 ffesta_confirmed (); /* Error, but clearly intended. */
5271 goto bad_1; /* :::::::::::::::::::: */
5272
5273 default:
5274 goto bad_1; /* :::::::::::::::::::: */
5275
5276 case FFELEX_typeNAME:
5277 ffesta_confirmed ();
5278 ffesta_tokens[1] = ffelex_token_use (t);
5279 return (ffelexHandler) ffestb_R8351_;
5280
5281 case FFELEX_typeEOS:
5282 case FFELEX_typeSEMICOLON:
5283 ffesta_confirmed ();
5284 ffesta_tokens[1] = NULL;
5285 return (ffelexHandler) ffestb_R8351_ (t);
5286 }
5287
5288 case FFELEX_typeNAMES:
5289 if (ffesta_first_kw != FFESTR_firstEXIT)
5290 goto bad_0; /* :::::::::::::::::::: */
5291 switch (ffelex_token_type (t))
5292 {
5293 default:
5294 goto bad_1; /* :::::::::::::::::::: */
5295
5296 case FFELEX_typeEOS:
5297 case FFELEX_typeSEMICOLON:
5298 break;
5299 }
5300 ffesta_confirmed ();
5301 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlEXIT);
5302 if (*p == '\0')
5303 {
5304 ffesta_tokens[1] = NULL;
5305 }
5306 else
5307 {
5308 if (!ffesrc_is_name_init (*p))
5309 goto bad_i; /* :::::::::::::::::::: */
5310 ffesta_tokens[1]
5311 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
5312 }
5313 return (ffelexHandler) ffestb_R8351_ (t);
5314
5315 default:
5316 goto bad_0; /* :::::::::::::::::::: */
5317 }
5318
5319 bad_0: /* :::::::::::::::::::: */
5320 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EXIT", ffesta_tokens[0]);
5321 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5322
5323 bad_1: /* :::::::::::::::::::: */
5324 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EXIT", t);
5325 return (ffelexHandler) ffelex_swallow_tokens (t,
5326 (ffelexHandler) ffesta_zero); /* Invalid second token. */
5327
5328 bad_i: /* :::::::::::::::::::: */
5329 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "EXIT", ffesta_tokens[0], i, t);
5330 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5331 }
5332
5333 /* ffestb_R8351_ -- "EXIT" [NAME]
5334
5335 return ffestb_R8351_; // to lexer
5336
5337 Make sure the next token is an EOS or SEMICOLON. */
5338
5339 static ffelexHandler
5340 ffestb_R8351_ (ffelexToken t)
5341 {
5342 switch (ffelex_token_type (t))
5343 {
5344 case FFELEX_typeEOS:
5345 case FFELEX_typeSEMICOLON:
5346 ffesta_confirmed ();
5347 if (!ffesta_is_inhibited ())
5348 ffestc_R835 (ffesta_tokens[1]);
5349 if (ffesta_tokens[1] != NULL)
5350 ffelex_token_kill (ffesta_tokens[1]);
5351 return (ffelexHandler) ffesta_zero (t);
5352
5353 default:
5354 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EXIT", t);
5355 break;
5356 }
5357
5358 if (ffesta_tokens[1] != NULL)
5359 ffelex_token_kill (ffesta_tokens[1]);
5360 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5361 }
5362
5363 /* ffestb_R838 -- Parse the ASSIGN statement
5364
5365 return ffestb_R838; // to lexer
5366
5367 Make sure the statement has a valid form for the ASSIGN statement. If it
5368 does, implement the statement. */
5369
5370 ffelexHandler
5371 ffestb_R838 (ffelexToken t)
5372 {
5373 unsigned const char *p;
5374 ffeTokenLength i;
5375 ffelexHandler next;
5376 ffelexToken et; /* First token in target. */
5377
5378 switch (ffelex_token_type (ffesta_tokens[0]))
5379 {
5380 case FFELEX_typeNAME:
5381 if (ffesta_first_kw != FFESTR_firstASSIGN)
5382 goto bad_0; /* :::::::::::::::::::: */
5383 switch (ffelex_token_type (t))
5384 {
5385 case FFELEX_typeEOS:
5386 case FFELEX_typeSEMICOLON:
5387 case FFELEX_typeCOMMA:
5388 case FFELEX_typeCOLONCOLON:
5389 ffesta_confirmed (); /* Error, but clearly intended. */
5390 goto bad_1; /* :::::::::::::::::::: */
5391
5392 default:
5393 goto bad_1; /* :::::::::::::::::::: */
5394
5395 case FFELEX_typeNUMBER:
5396 break;
5397 }
5398 ffesta_tokens[1] = ffelex_token_use (t);
5399 ffesta_confirmed ();
5400 return (ffelexHandler) ffestb_R8381_;
5401
5402 case FFELEX_typeNAMES:
5403 if (ffesta_first_kw != FFESTR_firstASSIGN)
5404 goto bad_0; /* :::::::::::::::::::: */
5405
5406 switch (ffelex_token_type (t))
5407 {
5408 case FFELEX_typeEOS:
5409 case FFELEX_typeSEMICOLON:
5410 ffesta_confirmed ();
5411 /* Fall through. */
5412 case FFELEX_typePERCENT:
5413 case FFELEX_typeOPEN_PAREN:
5414 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlASSIGN);
5415 if (! ISDIGIT (*p))
5416 goto bad_i; /* :::::::::::::::::::: */
5417 ffesta_tokens[1]
5418 = ffelex_token_number_from_names (ffesta_tokens[0], i);
5419 p += ffelex_token_length (ffesta_tokens[1]); /* Skip to "TO". */
5420 i += ffelex_token_length (ffesta_tokens[1]);
5421 if (!ffesrc_char_match_init (*p, 'T', 't') /* "TO". */
5422 || (++i, !ffesrc_char_match_noninit (*++p, 'O', 'o')))
5423 {
5424 bad_i_1: /* :::::::::::::::::::: */
5425 ffelex_token_kill (ffesta_tokens[1]);
5426 goto bad_i; /* :::::::::::::::::::: */
5427 }
5428 ++p, ++i;
5429 if (!ffesrc_is_name_init (*p))
5430 goto bad_i_1; /* :::::::::::::::::::: */
5431 et = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
5432 next = (ffelexHandler)
5433 (*((ffelexHandler)
5434 ffeexpr_lhs (ffesta_output_pool,
5435 FFEEXPR_contextASSIGN,
5436 (ffeexprCallback)
5437 ffestb_R8383_)))
5438 (et);
5439 ffelex_token_kill (et);
5440 return (ffelexHandler) (*next) (t);
5441
5442 case FFELEX_typeCOMMA:
5443 case FFELEX_typeCOLONCOLON:
5444 ffesta_confirmed (); /* Error, but clearly intended. */
5445 goto bad_1; /* :::::::::::::::::::: */
5446
5447 default:
5448 goto bad_1; /* :::::::::::::::::::: */
5449 }
5450
5451 default:
5452 goto bad_0; /* :::::::::::::::::::: */
5453 }
5454
5455 bad_0: /* :::::::::::::::::::: */
5456 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", ffesta_tokens[0]);
5457 return (ffelexHandler) ffelex_swallow_tokens (t,
5458 (ffelexHandler) ffesta_zero); /* Invalid first token. */
5459
5460 bad_1: /* :::::::::::::::::::: */
5461 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", t);
5462 return (ffelexHandler) ffelex_swallow_tokens (t,
5463 (ffelexHandler) ffesta_zero); /* Invalid second token. */
5464
5465 bad_i: /* :::::::::::::::::::: */
5466 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "ASSIGN", ffesta_tokens[0], i, t);
5467 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5468 }
5469
5470 /* ffestb_R8381_ -- "ASSIGN" NUMBER
5471
5472 return ffestb_R8381_; // to lexer
5473
5474 Make sure the next token is "TO". */
5475
5476 static ffelexHandler
5477 ffestb_R8381_ (ffelexToken t)
5478 {
5479 if ((ffelex_token_type (t) == FFELEX_typeNAME)
5480 && (ffesrc_strcmp_2c (ffe_case_match (), ffelex_token_text (t), "TO", "to",
5481 "To") == 0))
5482 {
5483 return (ffelexHandler) ffestb_R8382_;
5484 }
5485
5486 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", t);
5487 if (ffelex_token_type (t) == FFELEX_typeNAME)
5488 return (ffelexHandler) ffestb_R8382_ (t); /* Maybe user forgot "TO". */
5489
5490 ffelex_token_kill (ffesta_tokens[1]);
5491 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5492 }
5493
5494 /* ffestb_R8382_ -- "ASSIGN" NUMBER ("TO")
5495
5496 return ffestb_R8382_; // to lexer
5497
5498 Make sure the next token is a name, then pass it along to the expression
5499 evaluator as an LHS expression. The callback function is _3_. */
5500
5501 static ffelexHandler
5502 ffestb_R8382_ (ffelexToken t)
5503 {
5504 if (ffelex_token_type (t) == FFELEX_typeNAME)
5505 {
5506 return (ffelexHandler)
5507 (*((ffelexHandler)
5508 ffeexpr_lhs (ffesta_output_pool, FFEEXPR_contextASSIGN,
5509 (ffeexprCallback) ffestb_R8383_)))
5510 (t);
5511 }
5512
5513 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", t);
5514 ffelex_token_kill (ffesta_tokens[1]);
5515 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5516 }
5517
5518 /* ffestb_R8383_ -- "ASSIGN" NUMBER ("TO") expression
5519
5520 (ffestb_R8383_) // to expression handler
5521
5522 Make sure the next token is an EOS or SEMICOLON. */
5523
5524 static ffelexHandler
5525 ffestb_R8383_ (ffelexToken ft, ffebld expr, ffelexToken t)
5526 {
5527 switch (ffelex_token_type (t))
5528 {
5529 case FFELEX_typeEOS:
5530 case FFELEX_typeSEMICOLON:
5531 ffesta_confirmed ();
5532 if (expr == NULL)
5533 break;
5534 if (!ffesta_is_inhibited ())
5535 ffestc_R838 (ffesta_tokens[1], expr, ft);
5536 ffelex_token_kill (ffesta_tokens[1]);
5537 return (ffelexHandler) ffesta_zero (t);
5538
5539 default:
5540 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", t);
5541 break;
5542 }
5543
5544 ffelex_token_kill (ffesta_tokens[1]);
5545 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5546 }
5547
5548 /* ffestb_R840 -- Parse an arithmetic-IF statement
5549
5550 return ffestb_R840; // to lexer
5551
5552 Make sure the statement has a valid form for an arithmetic-IF statement.
5553 If it does, implement the statement. */
5554
5555 ffelexHandler
5556 ffestb_R840 (ffelexToken t)
5557 {
5558 switch (ffelex_token_type (ffesta_tokens[0]))
5559 {
5560 case FFELEX_typeNAME:
5561 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlIF)
5562 goto bad_0; /* :::::::::::::::::::: */
5563 if (ffesta_first_kw != FFESTR_firstIF)
5564 goto bad_0; /* :::::::::::::::::::: */
5565 break;
5566
5567 case FFELEX_typeNAMES:
5568 if (ffesta_first_kw != FFESTR_firstIF)
5569 goto bad_0; /* :::::::::::::::::::: */
5570 break;
5571
5572 default:
5573 goto bad_0; /* :::::::::::::::::::: */
5574 }
5575
5576 switch (ffelex_token_type (t))
5577 {
5578 case FFELEX_typeOPEN_PAREN:
5579 break;
5580
5581 default:
5582 goto bad_1; /* :::::::::::::::::::: */
5583 }
5584
5585 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextARITHIF,
5586 (ffeexprCallback) ffestb_R8401_);
5587
5588 bad_0: /* :::::::::::::::::::: */
5589 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", ffesta_tokens[0]);
5590 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5591
5592 bad_1: /* :::::::::::::::::::: */
5593 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
5594 return (ffelexHandler) ffelex_swallow_tokens (t,
5595 (ffelexHandler) ffesta_zero); /* Invalid second token. */
5596 }
5597
5598 /* ffestb_R8401_ -- "IF" OPEN_PAREN expr
5599
5600 (ffestb_R8401_) // to expression handler
5601
5602 Make sure the next token is CLOSE_PAREN. */
5603
5604 static ffelexHandler
5605 ffestb_R8401_ (ffelexToken ft, ffebld expr, ffelexToken t)
5606 {
5607 ffestb_local_.if_stmt.expr = expr;
5608
5609 switch (ffelex_token_type (t))
5610 {
5611 case FFELEX_typeCLOSE_PAREN:
5612 if (expr == NULL)
5613 break;
5614 ffesta_tokens[1] = ffelex_token_use (ft);
5615 ffelex_set_names (TRUE); /* In case it's a logical IF instead. */
5616 return (ffelexHandler) ffestb_R8402_;
5617
5618 default:
5619 break;
5620 }
5621
5622 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
5623 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5624 }
5625
5626 /* ffestb_R8402_ -- "IF" OPEN_PAREN expr CLOSE_PAREN
5627
5628 return ffestb_R8402_; // to lexer
5629
5630 Make sure the next token is NUMBER. */
5631
5632 static ffelexHandler
5633 ffestb_R8402_ (ffelexToken t)
5634 {
5635 ffelex_set_names (FALSE);
5636
5637 switch (ffelex_token_type (t))
5638 {
5639 case FFELEX_typeNUMBER:
5640 ffesta_confirmed ();
5641 ffesta_tokens[2] = ffelex_token_use (t);
5642 return (ffelexHandler) ffestb_R8403_;
5643
5644 default:
5645 break;
5646 }
5647
5648 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
5649 ffelex_token_kill (ffesta_tokens[1]);
5650 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5651 }
5652
5653 /* ffestb_R8403_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER
5654
5655 return ffestb_R8403_; // to lexer
5656
5657 Make sure the next token is COMMA. */
5658
5659 static ffelexHandler
5660 ffestb_R8403_ (ffelexToken t)
5661 {
5662 switch (ffelex_token_type (t))
5663 {
5664 case FFELEX_typeCOMMA:
5665 return (ffelexHandler) ffestb_R8404_;
5666
5667 default:
5668 break;
5669 }
5670
5671 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
5672 ffelex_token_kill (ffesta_tokens[1]);
5673 ffelex_token_kill (ffesta_tokens[2]);
5674 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5675 }
5676
5677 /* ffestb_R8404_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER COMMA
5678
5679 return ffestb_R8404_; // to lexer
5680
5681 Make sure the next token is NUMBER. */
5682
5683 static ffelexHandler
5684 ffestb_R8404_ (ffelexToken t)
5685 {
5686 switch (ffelex_token_type (t))
5687 {
5688 case FFELEX_typeNUMBER:
5689 ffesta_tokens[3] = ffelex_token_use (t);
5690 return (ffelexHandler) ffestb_R8405_;
5691
5692 default:
5693 break;
5694 }
5695
5696 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
5697 ffelex_token_kill (ffesta_tokens[1]);
5698 ffelex_token_kill (ffesta_tokens[2]);
5699 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5700 }
5701
5702 /* ffestb_R8405_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER COMMA NUMBER
5703
5704 return ffestb_R8405_; // to lexer
5705
5706 Make sure the next token is COMMA. */
5707
5708 static ffelexHandler
5709 ffestb_R8405_ (ffelexToken t)
5710 {
5711 switch (ffelex_token_type (t))
5712 {
5713 case FFELEX_typeCOMMA:
5714 return (ffelexHandler) ffestb_R8406_;
5715
5716 default:
5717 break;
5718 }
5719
5720 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
5721 ffelex_token_kill (ffesta_tokens[1]);
5722 ffelex_token_kill (ffesta_tokens[2]);
5723 ffelex_token_kill (ffesta_tokens[3]);
5724 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5725 }
5726
5727 /* ffestb_R8406_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER COMMA NUMBER COMMA
5728
5729 return ffestb_R8406_; // to lexer
5730
5731 Make sure the next token is NUMBER. */
5732
5733 static ffelexHandler
5734 ffestb_R8406_ (ffelexToken t)
5735 {
5736 switch (ffelex_token_type (t))
5737 {
5738 case FFELEX_typeNUMBER:
5739 ffesta_tokens[4] = ffelex_token_use (t);
5740 return (ffelexHandler) ffestb_R8407_;
5741
5742 default:
5743 break;
5744 }
5745
5746 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
5747 ffelex_token_kill (ffesta_tokens[1]);
5748 ffelex_token_kill (ffesta_tokens[2]);
5749 ffelex_token_kill (ffesta_tokens[3]);
5750 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5751 }
5752
5753 /* ffestb_R8407_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER COMMA NUMBER COMMA
5754 NUMBER
5755
5756 return ffestb_R8407_; // to lexer
5757
5758 Make sure the next token is EOS or SEMICOLON. */
5759
5760 static ffelexHandler
5761 ffestb_R8407_ (ffelexToken t)
5762 {
5763 switch (ffelex_token_type (t))
5764 {
5765 case FFELEX_typeEOS:
5766 case FFELEX_typeSEMICOLON:
5767 if (!ffesta_is_inhibited ())
5768 ffestc_R840 (ffestb_local_.if_stmt.expr, ffesta_tokens[1],
5769 ffesta_tokens[2], ffesta_tokens[3], ffesta_tokens[4]);
5770 ffelex_token_kill (ffesta_tokens[1]);
5771 ffelex_token_kill (ffesta_tokens[2]);
5772 ffelex_token_kill (ffesta_tokens[3]);
5773 ffelex_token_kill (ffesta_tokens[4]);
5774 return (ffelexHandler) ffesta_zero (t);
5775
5776 default:
5777 break;
5778 }
5779
5780 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
5781 ffelex_token_kill (ffesta_tokens[1]);
5782 ffelex_token_kill (ffesta_tokens[2]);
5783 ffelex_token_kill (ffesta_tokens[3]);
5784 ffelex_token_kill (ffesta_tokens[4]);
5785 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5786 }
5787
5788 /* ffestb_R841 -- Parse the CONTINUE statement
5789
5790 return ffestb_R841; // to lexer
5791
5792 Make sure the statement has a valid form for the CONTINUE statement. If
5793 it does, implement the statement. */
5794
5795 ffelexHandler
5796 ffestb_R841 (ffelexToken t)
5797 {
5798 const char *p;
5799 ffeTokenLength i;
5800
5801 switch (ffelex_token_type (ffesta_tokens[0]))
5802 {
5803 case FFELEX_typeNAME:
5804 if (ffesta_first_kw != FFESTR_firstCONTINUE)
5805 goto bad_0; /* :::::::::::::::::::: */
5806 break;
5807
5808 case FFELEX_typeNAMES:
5809 if (ffesta_first_kw != FFESTR_firstCONTINUE)
5810 goto bad_0; /* :::::::::::::::::::: */
5811 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlCONTINUE)
5812 {
5813 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCONTINUE);
5814 goto bad_i; /* :::::::::::::::::::: */
5815 }
5816 break;
5817
5818 default:
5819 goto bad_0; /* :::::::::::::::::::: */
5820 }
5821
5822 switch (ffelex_token_type (t))
5823 {
5824 case FFELEX_typeEOS:
5825 case FFELEX_typeSEMICOLON:
5826 ffesta_confirmed ();
5827 if (!ffesta_is_inhibited ())
5828 ffestc_R841 ();
5829 return (ffelexHandler) ffesta_zero (t);
5830
5831 case FFELEX_typeCOMMA:
5832 case FFELEX_typeCOLONCOLON:
5833 ffesta_confirmed (); /* Error, but clearly intended. */
5834 goto bad_1; /* :::::::::::::::::::: */
5835
5836 default:
5837 goto bad_1; /* :::::::::::::::::::: */
5838 }
5839
5840 bad_0: /* :::::::::::::::::::: */
5841 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CONTINUE", ffesta_tokens[0]);
5842 return (ffelexHandler) ffelex_swallow_tokens (t,
5843 (ffelexHandler) ffesta_zero); /* Invalid first token. */
5844
5845 bad_1: /* :::::::::::::::::::: */
5846 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CONTINUE", t);
5847 return (ffelexHandler) ffelex_swallow_tokens (t,
5848 (ffelexHandler) ffesta_zero); /* Invalid second token. */
5849
5850 bad_i: /* :::::::::::::::::::: */
5851 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CONTINUE", ffesta_tokens[0], i, t);
5852 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5853 }
5854
5855 /* ffestb_R1102 -- Parse the PROGRAM statement
5856
5857 return ffestb_R1102; // to lexer
5858
5859 Make sure the statement has a valid form for the PROGRAM statement. If it
5860 does, implement the statement. */
5861
5862 ffelexHandler
5863 ffestb_R1102 (ffelexToken t)
5864 {
5865 ffeTokenLength i;
5866 unsigned const char *p;
5867
5868 switch (ffelex_token_type (ffesta_tokens[0]))
5869 {
5870 case FFELEX_typeNAME:
5871 if (ffesta_first_kw != FFESTR_firstPROGRAM)
5872 goto bad_0; /* :::::::::::::::::::: */
5873 switch (ffelex_token_type (t))
5874 {
5875 case FFELEX_typeEOS:
5876 case FFELEX_typeSEMICOLON:
5877 case FFELEX_typeCOMMA:
5878 case FFELEX_typeCOLONCOLON:
5879 ffesta_confirmed (); /* Error, but clearly intended. */
5880 goto bad_1; /* :::::::::::::::::::: */
5881
5882 default:
5883 goto bad_1; /* :::::::::::::::::::: */
5884
5885 case FFELEX_typeNAME:
5886 break;
5887 }
5888
5889 ffesta_confirmed ();
5890 ffesta_tokens[1] = ffelex_token_use (t);
5891 return (ffelexHandler) ffestb_R11021_;
5892
5893 case FFELEX_typeNAMES:
5894 if (ffesta_first_kw != FFESTR_firstPROGRAM)
5895 goto bad_0; /* :::::::::::::::::::: */
5896 switch (ffelex_token_type (t))
5897 {
5898 case FFELEX_typeCOMMA:
5899 case FFELEX_typeCOLONCOLON:
5900 ffesta_confirmed (); /* Error, but clearly intended. */
5901 goto bad_1; /* :::::::::::::::::::: */
5902
5903 default:
5904 goto bad_1; /* :::::::::::::::::::: */
5905
5906 case FFELEX_typeEOS:
5907 case FFELEX_typeSEMICOLON:
5908 break;
5909 }
5910 ffesta_confirmed ();
5911 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlPROGRAM);
5912 if (!ffesrc_is_name_init (*p))
5913 goto bad_i; /* :::::::::::::::::::: */
5914 ffesta_tokens[1]
5915 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
5916 return (ffelexHandler) ffestb_R11021_ (t);
5917
5918 default:
5919 goto bad_0; /* :::::::::::::::::::: */
5920 }
5921
5922 bad_0: /* :::::::::::::::::::: */
5923 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PROGRAM", ffesta_tokens[0]);
5924 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5925
5926 bad_1: /* :::::::::::::::::::: */
5927 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PROGRAM", t);
5928 return (ffelexHandler) ffelex_swallow_tokens (t,
5929 (ffelexHandler) ffesta_zero); /* Invalid second token. */
5930
5931 bad_i: /* :::::::::::::::::::: */
5932 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "PROGRAM", ffesta_tokens[0], i, t);
5933 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5934 }
5935
5936 /* ffestb_R11021_ -- "PROGRAM" NAME
5937
5938 return ffestb_R11021_; // to lexer
5939
5940 Make sure the next token is an EOS or SEMICOLON. */
5941
5942 static ffelexHandler
5943 ffestb_R11021_ (ffelexToken t)
5944 {
5945 switch (ffelex_token_type (t))
5946 {
5947 case FFELEX_typeEOS:
5948 case FFELEX_typeSEMICOLON:
5949 ffesta_confirmed ();
5950 if (!ffesta_is_inhibited ())
5951 ffestc_R1102 (ffesta_tokens[1]);
5952 ffelex_token_kill (ffesta_tokens[1]);
5953 return (ffelexHandler) ffesta_zero (t);
5954
5955 default:
5956 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PROGRAM", t);
5957 break;
5958 }
5959
5960 ffelex_token_kill (ffesta_tokens[1]);
5961 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
5962 }
5963
5964 /* ffestb_block -- Parse the BLOCK DATA statement
5965
5966 return ffestb_block; // to lexer
5967
5968 Make sure the statement has a valid form for the BLOCK DATA statement. If
5969 it does, implement the statement. */
5970
5971 ffelexHandler
5972 ffestb_block (ffelexToken t)
5973 {
5974 switch (ffelex_token_type (ffesta_tokens[0]))
5975 {
5976 case FFELEX_typeNAME:
5977 if (ffesta_first_kw != FFESTR_firstBLOCK)
5978 goto bad_0; /* :::::::::::::::::::: */
5979 switch (ffelex_token_type (t))
5980 {
5981 default:
5982 goto bad_1; /* :::::::::::::::::::: */
5983
5984 case FFELEX_typeNAME:
5985 if (ffesta_second_kw != FFESTR_secondDATA)
5986 goto bad_1; /* :::::::::::::::::::: */
5987 break;
5988 }
5989
5990 ffesta_confirmed ();
5991 return (ffelexHandler) ffestb_R1111_1_;
5992
5993 default:
5994 goto bad_0; /* :::::::::::::::::::: */
5995 }
5996
5997 bad_0: /* :::::::::::::::::::: */
5998 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", ffesta_tokens[0]);
5999 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6000
6001 bad_1: /* :::::::::::::::::::: */
6002 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", t);
6003 return (ffelexHandler) ffelex_swallow_tokens (t,
6004 (ffelexHandler) ffesta_zero); /* Invalid second token. */
6005 }
6006
6007 /* ffestb_blockdata -- Parse the BLOCKDATA statement
6008
6009 return ffestb_blockdata; // to lexer
6010
6011 Make sure the statement has a valid form for the BLOCKDATA statement. If
6012 it does, implement the statement. */
6013
6014 ffelexHandler
6015 ffestb_blockdata (ffelexToken t)
6016 {
6017 ffeTokenLength i;
6018 unsigned const char *p;
6019
6020 switch (ffelex_token_type (ffesta_tokens[0]))
6021 {
6022 case FFELEX_typeNAME:
6023 if (ffesta_first_kw != FFESTR_firstBLOCKDATA)
6024 goto bad_0; /* :::::::::::::::::::: */
6025 switch (ffelex_token_type (t))
6026 {
6027 case FFELEX_typeCOMMA:
6028 case FFELEX_typeCOLONCOLON:
6029 ffesta_confirmed (); /* Error, but clearly intended. */
6030 goto bad_1; /* :::::::::::::::::::: */
6031
6032 default:
6033 goto bad_1; /* :::::::::::::::::::: */
6034
6035 case FFELEX_typeNAME:
6036 ffesta_confirmed ();
6037 ffesta_tokens[1] = ffelex_token_use (t);
6038 return (ffelexHandler) ffestb_R1111_2_;
6039
6040 case FFELEX_typeEOS:
6041 case FFELEX_typeSEMICOLON:
6042 ffesta_confirmed ();
6043 ffesta_tokens[1] = NULL;
6044 return (ffelexHandler) ffestb_R1111_2_ (t);
6045 }
6046
6047 case FFELEX_typeNAMES:
6048 if (ffesta_first_kw != FFESTR_firstBLOCKDATA)
6049 goto bad_0; /* :::::::::::::::::::: */
6050 switch (ffelex_token_type (t))
6051 {
6052 default:
6053 goto bad_1; /* :::::::::::::::::::: */
6054
6055 case FFELEX_typeEOS:
6056 case FFELEX_typeSEMICOLON:
6057 break;
6058 }
6059 ffesta_confirmed ();
6060 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlBLOCKDATA);
6061 if (*p == '\0')
6062 {
6063 ffesta_tokens[1] = NULL;
6064 }
6065 else
6066 {
6067 if (!ffesrc_is_name_init (*p))
6068 goto bad_i; /* :::::::::::::::::::: */
6069 ffesta_tokens[1]
6070 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
6071 }
6072 return (ffelexHandler) ffestb_R1111_2_ (t);
6073
6074 default:
6075 goto bad_0; /* :::::::::::::::::::: */
6076 }
6077
6078 bad_0: /* :::::::::::::::::::: */
6079 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", ffesta_tokens[0]);
6080 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6081
6082 bad_1: /* :::::::::::::::::::: */
6083 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", t);
6084 return (ffelexHandler) ffelex_swallow_tokens (t,
6085 (ffelexHandler) ffesta_zero); /* Invalid second token. */
6086
6087 bad_i: /* :::::::::::::::::::: */
6088 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", ffesta_tokens[0], i, t);
6089 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6090 }
6091
6092 /* ffestb_R1111_1_ -- "BLOCK" "DATA"
6093
6094 return ffestb_R1111_1_; // to lexer
6095
6096 Make sure the next token is a NAME, EOS, or SEMICOLON token. */
6097
6098 static ffelexHandler
6099 ffestb_R1111_1_ (ffelexToken t)
6100 {
6101 switch (ffelex_token_type (t))
6102 {
6103 case FFELEX_typeNAME:
6104 ffesta_tokens[1] = ffelex_token_use (t);
6105 return (ffelexHandler) ffestb_R1111_2_;
6106
6107 case FFELEX_typeEOS:
6108 case FFELEX_typeSEMICOLON:
6109 ffesta_tokens[1] = NULL;
6110 return (ffelexHandler) ffestb_R1111_2_ (t);
6111
6112 default:
6113 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", t);
6114 break;
6115 }
6116
6117 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6118 }
6119
6120 /* ffestb_R1111_2_ -- "BLOCK/DATA" NAME
6121
6122 return ffestb_R1111_2_; // to lexer
6123
6124 Make sure the next token is an EOS or SEMICOLON. */
6125
6126 static ffelexHandler
6127 ffestb_R1111_2_ (ffelexToken t)
6128 {
6129 switch (ffelex_token_type (t))
6130 {
6131 case FFELEX_typeEOS:
6132 case FFELEX_typeSEMICOLON:
6133 ffesta_confirmed ();
6134 if (!ffesta_is_inhibited ())
6135 ffestc_R1111 (ffesta_tokens[1]);
6136 if (ffesta_tokens[1] != NULL)
6137 ffelex_token_kill (ffesta_tokens[1]);
6138 return (ffelexHandler) ffesta_zero (t);
6139
6140 default:
6141 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", t);
6142 break;
6143 }
6144
6145 if (ffesta_tokens[1] != NULL)
6146 ffelex_token_kill (ffesta_tokens[1]);
6147 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6148 }
6149
6150 /* ffestb_R1212 -- Parse the CALL statement
6151
6152 return ffestb_R1212; // to lexer
6153
6154 Make sure the statement has a valid form for the CALL statement. If it
6155 does, implement the statement. */
6156
6157 ffelexHandler
6158 ffestb_R1212 (ffelexToken t)
6159 {
6160 ffeTokenLength i;
6161 unsigned const char *p;
6162 ffelexHandler next;
6163 ffelexToken nt;
6164
6165 switch (ffelex_token_type (ffesta_tokens[0]))
6166 {
6167 case FFELEX_typeNAME:
6168 if (ffesta_first_kw != FFESTR_firstCALL)
6169 goto bad_0; /* :::::::::::::::::::: */
6170 switch (ffelex_token_type (t))
6171 {
6172 case FFELEX_typeEOS:
6173 case FFELEX_typeSEMICOLON:
6174 case FFELEX_typeCOMMA:
6175 case FFELEX_typeCOLONCOLON:
6176 ffesta_confirmed (); /* Error, but clearly intended. */
6177 goto bad_1; /* :::::::::::::::::::: */
6178
6179 default:
6180 goto bad_1; /* :::::::::::::::::::: */
6181
6182 case FFELEX_typeNAME:
6183 break;
6184 }
6185 ffesta_confirmed ();
6186 return (ffelexHandler)
6187 (*((ffelexHandler)
6188 ffeexpr_lhs (ffesta_output_pool, FFEEXPR_contextSUBROUTINEREF,
6189 (ffeexprCallback) ffestb_R12121_)))
6190 (t);
6191
6192 case FFELEX_typeNAMES:
6193 if (ffesta_first_kw != FFESTR_firstCALL)
6194 goto bad_0; /* :::::::::::::::::::: */
6195 switch (ffelex_token_type (t))
6196 {
6197 case FFELEX_typeCOLONCOLON:
6198 case FFELEX_typeCOMMA:
6199 ffesta_confirmed (); /* Error, but clearly intended. */
6200 goto bad_1; /* :::::::::::::::::::: */
6201
6202 default:
6203 goto bad_1; /* :::::::::::::::::::: */
6204
6205 case FFELEX_typeOPEN_PAREN:
6206 break;
6207
6208 case FFELEX_typeEOS:
6209 case FFELEX_typeSEMICOLON:
6210 ffesta_confirmed ();
6211 break;
6212 }
6213 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCALL);
6214 if (!ffesrc_is_name_init (*p))
6215 goto bad_i; /* :::::::::::::::::::: */
6216 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
6217 next = (ffelexHandler)
6218 (*((ffelexHandler)
6219 ffeexpr_lhs (ffesta_output_pool, FFEEXPR_contextSUBROUTINEREF,
6220 (ffeexprCallback) ffestb_R12121_)))
6221 (nt);
6222 ffelex_token_kill (nt);
6223 return (ffelexHandler) (*next) (t);
6224
6225 default:
6226 goto bad_0; /* :::::::::::::::::::: */
6227 }
6228
6229 bad_0: /* :::::::::::::::::::: */
6230 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CALL", ffesta_tokens[0]);
6231 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6232
6233 bad_1: /* :::::::::::::::::::: */
6234 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CALL", t);
6235 return (ffelexHandler) ffelex_swallow_tokens (t,
6236 (ffelexHandler) ffesta_zero); /* Invalid second token. */
6237
6238 bad_i: /* :::::::::::::::::::: */
6239 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CALL", ffesta_tokens[0], i, t);
6240 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6241 }
6242
6243 /* ffestb_R12121_ -- "CALL" expr
6244
6245 (ffestb_R12121_) // to expression handler
6246
6247 Make sure the statement has a valid form for the CALL statement. If it
6248 does, implement the statement. */
6249
6250 static ffelexHandler
6251 ffestb_R12121_ (ffelexToken ft, ffebld expr, ffelexToken t)
6252 {
6253 switch (ffelex_token_type (t))
6254 {
6255 case FFELEX_typeEOS:
6256 case FFELEX_typeSEMICOLON:
6257 ffesta_confirmed ();
6258 if (expr == NULL)
6259 break;
6260 if (!ffesta_is_inhibited ())
6261 ffestc_R1212 (expr, ft);
6262 return (ffelexHandler) ffesta_zero (t);
6263
6264 default:
6265 break;
6266 }
6267
6268 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CALL", t);
6269 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6270 }
6271
6272 /* ffestb_R1227 -- Parse the RETURN statement
6273
6274 return ffestb_R1227; // to lexer
6275
6276 Make sure the statement has a valid form for the RETURN statement. If it
6277 does, implement the statement. */
6278
6279 ffelexHandler
6280 ffestb_R1227 (ffelexToken t)
6281 {
6282 ffelexHandler next;
6283
6284 switch (ffelex_token_type (ffesta_tokens[0]))
6285 {
6286 case FFELEX_typeNAME:
6287 if (ffesta_first_kw != FFESTR_firstRETURN)
6288 goto bad_0; /* :::::::::::::::::::: */
6289 switch (ffelex_token_type (t))
6290 {
6291 case FFELEX_typeCOMMA:
6292 case FFELEX_typeCOLONCOLON:
6293 ffesta_confirmed (); /* Error, but clearly intended. */
6294 goto bad_1; /* :::::::::::::::::::: */
6295
6296 case FFELEX_typeEQUALS:
6297 case FFELEX_typePOINTS:
6298 case FFELEX_typeCOLON:
6299 goto bad_1; /* :::::::::::::::::::: */
6300
6301 case FFELEX_typeEOS:
6302 case FFELEX_typeSEMICOLON:
6303 case FFELEX_typeNAME:
6304 case FFELEX_typeNUMBER:
6305 ffesta_confirmed ();
6306 break;
6307
6308 default:
6309 break;
6310 }
6311
6312 return (ffelexHandler) (*((ffelexHandler)
6313 ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextRETURN,
6314 (ffeexprCallback) ffestb_R12271_)))
6315 (t);
6316
6317 case FFELEX_typeNAMES:
6318 if (ffesta_first_kw != FFESTR_firstRETURN)
6319 goto bad_0; /* :::::::::::::::::::: */
6320 switch (ffelex_token_type (t))
6321 {
6322 case FFELEX_typeCOMMA:
6323 case FFELEX_typeCOLONCOLON:
6324 ffesta_confirmed (); /* Error, but clearly intended. */
6325 goto bad_1; /* :::::::::::::::::::: */
6326
6327 case FFELEX_typeEQUALS:
6328 case FFELEX_typePOINTS:
6329 case FFELEX_typeCOLON:
6330 goto bad_1; /* :::::::::::::::::::: */
6331
6332 case FFELEX_typeEOS:
6333 case FFELEX_typeSEMICOLON:
6334 ffesta_confirmed ();
6335 break;
6336
6337 default:
6338 break;
6339 }
6340 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
6341 FFEEXPR_contextRETURN, (ffeexprCallback) ffestb_R12271_);
6342 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
6343 FFESTR_firstlRETURN);
6344 if (next == NULL)
6345 return (ffelexHandler) ffelex_swallow_tokens (t,
6346 (ffelexHandler) ffesta_zero);
6347 return (ffelexHandler) (*next) (t);
6348
6349 default:
6350 goto bad_0; /* :::::::::::::::::::: */
6351 }
6352
6353 bad_0: /* :::::::::::::::::::: */
6354 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RETURN", ffesta_tokens[0]);
6355 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6356
6357 bad_1: /* :::::::::::::::::::: */
6358 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RETURN", t);
6359 return (ffelexHandler) ffelex_swallow_tokens (t,
6360 (ffelexHandler) ffesta_zero); /* Invalid second token. */
6361 }
6362
6363 /* ffestb_R12271_ -- "RETURN" expr
6364
6365 (ffestb_R12271_) // to expression handler
6366
6367 Make sure the next token is an EOS or SEMICOLON. */
6368
6369 static ffelexHandler
6370 ffestb_R12271_ (ffelexToken ft, ffebld expr, ffelexToken t)
6371 {
6372 switch (ffelex_token_type (t))
6373 {
6374 case FFELEX_typeEOS:
6375 case FFELEX_typeSEMICOLON:
6376 ffesta_confirmed ();
6377 if (!ffesta_is_inhibited ())
6378 ffestc_R1227 (expr, ft);
6379 return (ffelexHandler) ffesta_zero (t);
6380
6381 default:
6382 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RETURN", t);
6383 break;
6384 }
6385
6386 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6387 }
6388
6389 /* ffestb_construct -- Parse a construct name
6390
6391 return ffestb_construct; // to lexer
6392
6393 Make sure the statement can have a construct name (if-then-stmt, do-stmt,
6394 select-case-stmt). */
6395
6396 ffelexHandler
6397 ffestb_construct (ffelexToken t UNUSED)
6398 {
6399 /* This handler gets invoked only when token 0 is NAME/NAMES and token 1 is
6400 COLON. */
6401
6402 ffesta_confirmed ();
6403 ffelex_set_names (TRUE);
6404 return (ffelexHandler) ffestb_construct1_;
6405 }
6406
6407 /* ffestb_construct1_ -- NAME COLON
6408
6409 return ffestb_construct1_; // to lexer
6410
6411 Make sure we've got a NAME that is DO, DOWHILE, IF, SELECT, or SELECTCASE. */
6412
6413 static ffelexHandler
6414 ffestb_construct1_ (ffelexToken t)
6415 {
6416 ffelex_set_names (FALSE);
6417
6418 switch (ffelex_token_type (t))
6419 {
6420 case FFELEX_typeNAME:
6421 ffesta_first_kw = ffestr_first (t);
6422 switch (ffesta_first_kw)
6423 {
6424 case FFESTR_firstIF:
6425 ffestb_local_.construct.next = (ffelexHandler) ffestb_if;
6426 break;
6427
6428 case FFESTR_firstDO:
6429 ffestb_local_.construct.next = (ffelexHandler) ffestb_do;
6430 break;
6431
6432 case FFESTR_firstDOWHILE:
6433 ffestb_local_.construct.next = (ffelexHandler) ffestb_dowhile;
6434 break;
6435
6436 case FFESTR_firstSELECT:
6437 case FFESTR_firstSELECTCASE:
6438 ffestb_local_.construct.next = (ffelexHandler) ffestb_R809;
6439 break;
6440
6441 default:
6442 goto bad; /* :::::::::::::::::::: */
6443 }
6444 ffesta_construct_name = ffesta_tokens[0];
6445 ffesta_tokens[0] = ffelex_token_use (t);
6446 return (ffelexHandler) ffestb_construct2_;
6447
6448 case FFELEX_typeNAMES:
6449 ffesta_first_kw = ffestr_first (t);
6450 switch (ffesta_first_kw)
6451 {
6452 case FFESTR_firstIF:
6453 if (ffelex_token_length (t) != FFESTR_firstlIF)
6454 goto bad; /* :::::::::::::::::::: */
6455 ffestb_local_.construct.next = (ffelexHandler) ffestb_if;
6456 break;
6457
6458 case FFESTR_firstDO:
6459 ffestb_local_.construct.next = (ffelexHandler) ffestb_do;
6460 break;
6461
6462 case FFESTR_firstDOWHILE:
6463 if (ffelex_token_length (t) != FFESTR_firstlDOWHILE)
6464 goto bad; /* :::::::::::::::::::: */
6465 ffestb_local_.construct.next = (ffelexHandler) ffestb_dowhile;
6466 break;
6467
6468 case FFESTR_firstSELECTCASE:
6469 if (ffelex_token_length (t) != FFESTR_firstlSELECTCASE)
6470 goto bad; /* :::::::::::::::::::: */
6471 ffestb_local_.construct.next = (ffelexHandler) ffestb_R809;
6472 break;
6473
6474 default:
6475 goto bad; /* :::::::::::::::::::: */
6476 }
6477 ffesta_construct_name = ffesta_tokens[0];
6478 ffesta_tokens[0] = ffelex_token_use (t);
6479 return (ffelexHandler) ffestb_construct2_;
6480
6481 default:
6482 break;
6483 }
6484
6485 bad: /* :::::::::::::::::::: */
6486 ffesta_ffebad_2st (FFEBAD_INVALID_STMT_FORM, "CONSTRUCT",
6487 ffesta_tokens[0], t);
6488 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6489 }
6490
6491 /* ffestb_construct2_ -- NAME COLON "DO/DOWHILE/IF/SELECT/SELECTCASE"
6492
6493 return ffestb_construct2_; // to lexer
6494
6495 This extra step is needed to set ffesta_second_kw if the second token
6496 (here) is a NAME, so DO and SELECT can continue to expect it. */
6497
6498 static ffelexHandler
6499 ffestb_construct2_ (ffelexToken t)
6500 {
6501 if (ffelex_token_type (t) == FFELEX_typeNAME)
6502 ffesta_second_kw = ffestr_second (t);
6503 return (ffelexHandler) (*ffestb_local_.construct.next) (t);
6504 }
6505
6506 /* ffestb_R809 -- Parse the SELECTCASE statement
6507
6508 return ffestb_R809; // to lexer
6509
6510 Make sure the statement has a valid form for the SELECTCASE statement.
6511 If it does, implement the statement. */
6512
6513 ffelexHandler
6514 ffestb_R809 (ffelexToken t)
6515 {
6516 ffeTokenLength i;
6517 const char *p;
6518
6519 switch (ffelex_token_type (ffesta_tokens[0]))
6520 {
6521 case FFELEX_typeNAME:
6522 switch (ffesta_first_kw)
6523 {
6524 case FFESTR_firstSELECT:
6525 if ((ffelex_token_type (t) != FFELEX_typeNAME)
6526 || (ffesta_second_kw != FFESTR_secondCASE))
6527 goto bad_1; /* :::::::::::::::::::: */
6528 ffesta_confirmed ();
6529 return (ffelexHandler) ffestb_R8091_;
6530
6531 case FFESTR_firstSELECTCASE:
6532 return (ffelexHandler) ffestb_R8091_ (t);
6533
6534 default:
6535 goto bad_0; /* :::::::::::::::::::: */
6536 }
6537
6538 case FFELEX_typeNAMES:
6539 if (ffesta_first_kw != FFESTR_firstSELECTCASE)
6540 goto bad_0; /* :::::::::::::::::::: */
6541 switch (ffelex_token_type (t))
6542 {
6543 case FFELEX_typeCOMMA:
6544 case FFELEX_typeEOS:
6545 case FFELEX_typeSEMICOLON:
6546 case FFELEX_typeCOLONCOLON:
6547 ffesta_confirmed (); /* Error, but clearly intended. */
6548 goto bad_1; /* :::::::::::::::::::: */
6549
6550 default:
6551 goto bad_1; /* :::::::::::::::::::: */
6552
6553 case FFELEX_typeOPEN_PAREN:
6554 break;
6555 }
6556 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSELECTCASE);
6557 if (*p != '\0')
6558 goto bad_i; /* :::::::::::::::::::: */
6559 return (ffelexHandler) ffestb_R8091_ (t);
6560
6561 default:
6562 goto bad_0; /* :::::::::::::::::::: */
6563 }
6564
6565 bad_0: /* :::::::::::::::::::: */
6566 if (ffesta_construct_name != NULL)
6567 {
6568 ffelex_token_kill (ffesta_construct_name);
6569 ffesta_construct_name = NULL;
6570 }
6571 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", ffesta_tokens[0]);
6572 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6573
6574 bad_1: /* :::::::::::::::::::: */
6575 if (ffesta_construct_name != NULL)
6576 {
6577 ffelex_token_kill (ffesta_construct_name);
6578 ffesta_construct_name = NULL;
6579 }
6580 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", t);
6581 return (ffelexHandler) ffelex_swallow_tokens (t,
6582 (ffelexHandler) ffesta_zero); /* Invalid second token. */
6583
6584 bad_i: /* :::::::::::::::::::: */
6585 if (ffesta_construct_name != NULL)
6586 {
6587 ffelex_token_kill (ffesta_construct_name);
6588 ffesta_construct_name = NULL;
6589 }
6590 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", ffesta_tokens[0], i, t);
6591 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6592 }
6593
6594 /* ffestb_R8091_ -- "SELECTCASE" or "SELECT" "CASE"
6595
6596 return ffestb_R8091_; // to lexer
6597
6598 Make sure the statement has a valid form for the SELECTCASE statement. If it
6599 does, implement the statement. */
6600
6601 static ffelexHandler
6602 ffestb_R8091_ (ffelexToken t)
6603 {
6604 switch (ffelex_token_type (t))
6605 {
6606 case FFELEX_typeOPEN_PAREN:
6607 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
6608 FFEEXPR_contextSELECTCASE, (ffeexprCallback) ffestb_R8092_);
6609
6610 case FFELEX_typeEOS:
6611 case FFELEX_typeSEMICOLON:
6612 case FFELEX_typeCOMMA:
6613 case FFELEX_typeCOLONCOLON:
6614 ffesta_confirmed (); /* Error, but clearly intended. */
6615 break;
6616
6617 default:
6618 break;
6619 }
6620
6621 if (ffesta_construct_name != NULL)
6622 {
6623 ffelex_token_kill (ffesta_construct_name);
6624 ffesta_construct_name = NULL;
6625 }
6626 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", t);
6627 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6628 }
6629
6630 /* ffestb_R8092_ -- "SELECT/CASE" OPEN_PAREN expr
6631
6632 (ffestb_R8092_) // to expression handler
6633
6634 Make sure the statement has a valid form for the SELECTCASE statement. If it
6635 does, implement the statement. */
6636
6637 static ffelexHandler
6638 ffestb_R8092_ (ffelexToken ft, ffebld expr, ffelexToken t)
6639 {
6640 switch (ffelex_token_type (t))
6641 {
6642 case FFELEX_typeCLOSE_PAREN:
6643 if (expr == NULL)
6644 break;
6645 ffesta_tokens[1] = ffelex_token_use (ft);
6646 ffestb_local_.selectcase.expr = expr;
6647 return (ffelexHandler) ffestb_R8093_;
6648
6649 default:
6650 break;
6651 }
6652
6653 if (ffesta_construct_name != NULL)
6654 {
6655 ffelex_token_kill (ffesta_construct_name);
6656 ffesta_construct_name = NULL;
6657 }
6658 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", t);
6659 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6660 }
6661
6662 /* ffestb_R8093_ -- "SELECT/CASE" OPEN_PAREN expr CLOSE_PAREN
6663
6664 return ffestb_R8093_; // to lexer
6665
6666 Make sure the statement has a valid form for the SELECTCASE statement. If it
6667 does, implement the statement. */
6668
6669 static ffelexHandler
6670 ffestb_R8093_ (ffelexToken t)
6671 {
6672 switch (ffelex_token_type (t))
6673 {
6674 case FFELEX_typeEOS:
6675 case FFELEX_typeSEMICOLON:
6676 ffesta_confirmed ();
6677 if (!ffesta_is_inhibited ())
6678 ffestc_R809 (ffesta_construct_name, ffestb_local_.selectcase.expr,
6679 ffesta_tokens[1]);
6680 ffelex_token_kill (ffesta_tokens[1]);
6681 if (ffesta_construct_name != NULL)
6682 {
6683 ffelex_token_kill (ffesta_construct_name);
6684 ffesta_construct_name = NULL;
6685 }
6686 return ffesta_zero (t);
6687
6688 case FFELEX_typeCOMMA:
6689 case FFELEX_typeCOLONCOLON:
6690 ffesta_confirmed (); /* Error, but clearly intended. */
6691 break;
6692
6693 default:
6694 break;
6695 }
6696
6697 ffelex_token_kill (ffesta_tokens[1]);
6698 if (ffesta_construct_name != NULL)
6699 {
6700 ffelex_token_kill (ffesta_construct_name);
6701 ffesta_construct_name = NULL;
6702 }
6703 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", t);
6704 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6705 }
6706
6707 /* ffestb_R810 -- Parse the CASE statement
6708
6709 return ffestb_R810; // to lexer
6710
6711 Make sure the statement has a valid form for the CASE statement.
6712 If it does, implement the statement. */
6713
6714 ffelexHandler
6715 ffestb_R810 (ffelexToken t)
6716 {
6717 ffeTokenLength i;
6718 unsigned const char *p;
6719
6720 switch (ffelex_token_type (ffesta_tokens[0]))
6721 {
6722 case FFELEX_typeNAME:
6723 if (ffesta_first_kw != FFESTR_firstCASE)
6724 goto bad_0; /* :::::::::::::::::::: */
6725 switch (ffelex_token_type (t))
6726 {
6727 case FFELEX_typeCOMMA:
6728 case FFELEX_typeEOS:
6729 case FFELEX_typeSEMICOLON:
6730 case FFELEX_typeCOLONCOLON:
6731 ffesta_confirmed (); /* Error, but clearly intended. */
6732 goto bad_1; /* :::::::::::::::::::: */
6733
6734 default:
6735 goto bad_1; /* :::::::::::::::::::: */
6736
6737 case FFELEX_typeNAME:
6738 ffesta_confirmed ();
6739 if (ffesta_second_kw != FFESTR_secondDEFAULT)
6740 goto bad_1; /* :::::::::::::::::::: */
6741 ffestb_local_.case_stmt.cases = NULL;
6742 return (ffelexHandler) ffestb_R8101_;
6743
6744 case FFELEX_typeOPEN_PAREN:
6745 ffestb_local_.case_stmt.cases = ffestt_caselist_create ();
6746 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
6747 FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8103_);
6748 }
6749
6750 case FFELEX_typeNAMES:
6751 switch (ffesta_first_kw)
6752 {
6753 case FFESTR_firstCASEDEFAULT:
6754 switch (ffelex_token_type (t))
6755 {
6756 case FFELEX_typeCOMMA:
6757 case FFELEX_typeCOLONCOLON:
6758 ffesta_confirmed (); /* Error, but clearly intended. */
6759 goto bad_1; /* :::::::::::::::::::: */
6760
6761 default:
6762 goto bad_1; /* :::::::::::::::::::: */
6763
6764 case FFELEX_typeEOS:
6765 case FFELEX_typeSEMICOLON:
6766 ffesta_confirmed ();
6767 break;
6768 }
6769 ffestb_local_.case_stmt.cases = NULL;
6770 p = ffelex_token_text (ffesta_tokens[0])
6771 + (i = FFESTR_firstlCASEDEFAULT);
6772 if (*p == '\0')
6773 return (ffelexHandler) ffestb_R8101_ (t);
6774 if (!ffesrc_is_name_init (*p))
6775 goto bad_i; /* :::::::::::::::::::: */
6776 ffesta_tokens[1] = ffelex_token_name_from_names (ffesta_tokens[0], i,
6777 0);
6778 return (ffelexHandler) ffestb_R8102_ (t);
6779
6780 case FFESTR_firstCASE:
6781 break;
6782
6783 default:
6784 goto bad_0; /* :::::::::::::::::::: */
6785 }
6786
6787 switch (ffelex_token_type (t))
6788 {
6789 case FFELEX_typeCOMMA:
6790 case FFELEX_typeEOS:
6791 case FFELEX_typeSEMICOLON:
6792 case FFELEX_typeCOLONCOLON:
6793 ffesta_confirmed (); /* Error, but clearly intended. */
6794 goto bad_1; /* :::::::::::::::::::: */
6795
6796 default:
6797 goto bad_1; /* :::::::::::::::::::: */
6798
6799 case FFELEX_typeOPEN_PAREN:
6800 break;
6801 }
6802 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCASE);
6803 if (*p != '\0')
6804 goto bad_i; /* :::::::::::::::::::: */
6805 ffestb_local_.case_stmt.cases = ffestt_caselist_create ();
6806 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
6807 FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8103_);
6808
6809 default:
6810 goto bad_0; /* :::::::::::::::::::: */
6811 }
6812
6813 bad_0: /* :::::::::::::::::::: */
6814 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", ffesta_tokens[0]);
6815 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6816
6817 bad_1: /* :::::::::::::::::::: */
6818 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
6819 return (ffelexHandler) ffelex_swallow_tokens (t,
6820 (ffelexHandler) ffesta_zero); /* Invalid second token. */
6821
6822 bad_i: /* :::::::::::::::::::: */
6823 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CASE", ffesta_tokens[0], i, t);
6824 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6825 }
6826
6827 /* ffestb_R8101_ -- "CASE" case-selector
6828
6829 return ffestb_R8101_; // to lexer
6830
6831 Make sure the statement has a valid form for the CASE statement. If it
6832 does, implement the statement. */
6833
6834 static ffelexHandler
6835 ffestb_R8101_ (ffelexToken t)
6836 {
6837 switch (ffelex_token_type (t))
6838 {
6839 case FFELEX_typeNAME:
6840 ffesta_tokens[1] = ffelex_token_use (t);
6841 return (ffelexHandler) ffestb_R8102_;
6842
6843 case FFELEX_typeEOS:
6844 case FFELEX_typeSEMICOLON:
6845 ffesta_tokens[1] = NULL;
6846 return (ffelexHandler) ffestb_R8102_ (t);
6847
6848 case FFELEX_typeCOMMA:
6849 case FFELEX_typeCOLONCOLON:
6850 ffesta_confirmed (); /* Error, but clearly intended. */
6851 break;
6852
6853 default:
6854 break;
6855 }
6856
6857 if (ffestb_local_.case_stmt.cases != NULL)
6858 ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
6859 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
6860 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6861 }
6862
6863 /* ffestb_R8102_ -- "CASE" case-selector [NAME]
6864
6865 return ffestb_R8102_; // to lexer
6866
6867 Make sure the statement has a valid form for the CASE statement. If it
6868 does, implement the statement. */
6869
6870 static ffelexHandler
6871 ffestb_R8102_ (ffelexToken t)
6872 {
6873 switch (ffelex_token_type (t))
6874 {
6875 case FFELEX_typeEOS:
6876 case FFELEX_typeSEMICOLON:
6877 ffesta_confirmed ();
6878 if (!ffesta_is_inhibited ())
6879 ffestc_R810 (ffestb_local_.case_stmt.cases, ffesta_tokens[1]);
6880 if (ffestb_local_.case_stmt.cases != NULL)
6881 ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
6882 if (ffesta_tokens[1] != NULL)
6883 ffelex_token_kill (ffesta_tokens[1]);
6884 return (ffelexHandler) ffesta_zero (t);
6885
6886 case FFELEX_typeCOMMA:
6887 case FFELEX_typeCOLONCOLON:
6888 ffesta_confirmed (); /* Error, but clearly intended. */
6889 break;
6890
6891 default:
6892 break;
6893 }
6894
6895 if (ffestb_local_.case_stmt.cases != NULL)
6896 ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
6897 if (ffesta_tokens[1] != NULL)
6898 ffelex_token_kill (ffesta_tokens[1]);
6899 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
6900 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6901 }
6902
6903 /* ffestb_R8103_ -- "CASE" OPEN_PAREN expr
6904
6905 (ffestb_R8103_) // to expression handler
6906
6907 Make sure the statement has a valid form for the CASE statement. If it
6908 does, implement the statement. */
6909
6910 static ffelexHandler
6911 ffestb_R8103_ (ffelexToken ft, ffebld expr, ffelexToken t)
6912 {
6913 switch (ffelex_token_type (t))
6914 {
6915 case FFELEX_typeCLOSE_PAREN:
6916 ffestt_caselist_append (ffestb_local_.case_stmt.cases, FALSE, expr, NULL,
6917 ffelex_token_use (ft));
6918 return (ffelexHandler) ffestb_R8101_;
6919
6920 case FFELEX_typeCOMMA:
6921 ffestt_caselist_append (ffestb_local_.case_stmt.cases, FALSE, expr, NULL,
6922 ffelex_token_use (ft));
6923 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
6924 FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8103_);
6925
6926 case FFELEX_typeCOLON:
6927 ffestt_caselist_append (ffestb_local_.case_stmt.cases, TRUE, expr, NULL,
6928 ffelex_token_use (ft)); /* NULL second expr for
6929 now, just plug in. */
6930 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
6931 FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8104_);
6932
6933 default:
6934 break;
6935 }
6936
6937 ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
6938 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
6939 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6940 }
6941
6942 /* ffestb_R8104_ -- "CASE" OPEN_PAREN expr COLON expr
6943
6944 (ffestb_R8104_) // to expression handler
6945
6946 Make sure the statement has a valid form for the CASE statement. If it
6947 does, implement the statement. */
6948
6949 static ffelexHandler
6950 ffestb_R8104_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
6951 {
6952 switch (ffelex_token_type (t))
6953 {
6954 case FFELEX_typeCLOSE_PAREN:
6955 ffestb_local_.case_stmt.cases->previous->expr2 = expr;
6956 return (ffelexHandler) ffestb_R8101_;
6957
6958 case FFELEX_typeCOMMA:
6959 ffestb_local_.case_stmt.cases->previous->expr2 = expr;
6960 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
6961 FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8103_);
6962
6963 default:
6964 break;
6965 }
6966
6967 ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
6968 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
6969 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
6970 }
6971
6972 /* ffestb_R1001 -- Parse a FORMAT statement
6973
6974 return ffestb_R1001; // to lexer
6975
6976 Make sure the statement has a valid form for an FORMAT statement.
6977 If it does, implement the statement. */
6978
6979 ffelexHandler
6980 ffestb_R1001 (ffelexToken t)
6981 {
6982 ffesttFormatList f;
6983
6984 switch (ffelex_token_type (ffesta_tokens[0]))
6985 {
6986 case FFELEX_typeNAME:
6987 if (ffesta_first_kw != FFESTR_firstFORMAT)
6988 goto bad_0; /* :::::::::::::::::::: */
6989 break;
6990
6991 case FFELEX_typeNAMES:
6992 if (ffesta_first_kw != FFESTR_firstFORMAT)
6993 goto bad_0; /* :::::::::::::::::::: */
6994 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlFORMAT)
6995 goto bad_0; /* :::::::::::::::::::: */
6996 break;
6997
6998 default:
6999 goto bad_0; /* :::::::::::::::::::: */
7000 }
7001
7002 switch (ffelex_token_type (t))
7003 {
7004 case FFELEX_typeOPEN_PAREN:
7005 ffestb_local_.format.complained = FALSE;
7006 ffestb_local_.format.f = NULL; /* No parent yet. */
7007 ffestb_local_.format.f = ffestt_formatlist_create (NULL,
7008 ffelex_token_use (t));
7009 ffelex_set_names_pure (TRUE); /* Have even free-form lexer give us
7010 NAMES. */
7011 return (ffelexHandler) ffestb_R10011_;
7012
7013 case FFELEX_typeOPEN_ARRAY:/* "(/". */
7014 ffesta_confirmed ();
7015 ffestb_local_.format.complained = FALSE;
7016 ffestb_local_.format.f = ffestt_formatlist_create (NULL,
7017 ffelex_token_use (t));
7018 f = ffestt_formatlist_append (ffestb_local_.format.f);
7019 f->type = FFESTP_formattypeSLASH;
7020 f->t = ffelex_token_use (t);
7021 f->u.R1010.val.present = FALSE;
7022 f->u.R1010.val.rtexpr = FALSE;
7023 f->u.R1010.val.t = NULL;
7024 f->u.R1010.val.u.unsigned_val = 1;
7025 ffelex_set_names_pure (TRUE); /* Have even free-form lexer give us
7026 NAMES. */
7027 return (ffelexHandler) ffestb_R100112_;
7028
7029 case FFELEX_typeEOS:
7030 case FFELEX_typeSEMICOLON:
7031 case FFELEX_typeCOMMA:
7032 case FFELEX_typeCOLONCOLON:
7033 ffesta_confirmed (); /* Error, but clearly intended. */
7034 goto bad_1; /* :::::::::::::::::::: */
7035
7036 default:
7037 goto bad_1; /* :::::::::::::::::::: */
7038 }
7039
7040 bad_0: /* :::::::::::::::::::: */
7041 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", ffesta_tokens[0]);
7042 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7043
7044 bad_1: /* :::::::::::::::::::: */
7045 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
7046 return (ffelexHandler) ffelex_swallow_tokens (t,
7047 (ffelexHandler) ffesta_zero); /* Invalid second token. */
7048 }
7049
7050 /* ffestb_R10011_ -- "FORMAT" OPEN_PAREN expr
7051
7052 return ffestb_R10011_; // to lexer
7053
7054 For CLOSE_PAREN, wrap up the format list and if it is the top-level one,
7055 exit. For anything else, pass it to _2_. */
7056
7057 static ffelexHandler
7058 ffestb_R10011_ (ffelexToken t)
7059 {
7060 ffesttFormatList f;
7061
7062 switch (ffelex_token_type (t))
7063 {
7064 case FFELEX_typeCLOSE_PAREN:
7065 break;
7066
7067 default:
7068 return (ffelexHandler) ffestb_R10012_ (t);
7069 }
7070
7071 /* If we have a format we're working on, continue working on it. */
7072
7073 f = ffestb_local_.format.f->u.root.parent;
7074
7075 if (f != NULL)
7076 {
7077 ffestb_local_.format.f = f->next;
7078 return (ffelexHandler) ffestb_R100111_;
7079 }
7080
7081 return (ffelexHandler) ffestb_R100114_;
7082 }
7083
7084 /* ffestb_R10012_ -- "FORMAT" OPEN_PAREN [format-item-list]
7085
7086 return ffestb_R10012_; // to lexer
7087
7088 The initial state for a format-item. Here, just handle the initial
7089 number, sign for number, or run-time expression. Also handle spurious
7090 comma, close-paren (indicating spurious comma), close-array (like
7091 close-paren but preceded by slash), and quoted strings. */
7092
7093 static ffelexHandler
7094 ffestb_R10012_ (ffelexToken t)
7095 {
7096 unsigned long unsigned_val;
7097 ffesttFormatList f;
7098
7099 switch (ffelex_token_type (t))
7100 {
7101 case FFELEX_typeOPEN_ANGLE:
7102 ffesta_confirmed ();
7103 ffestb_local_.format.pre.t = ffelex_token_use (t);
7104 ffelex_set_names_pure (FALSE);
7105 if (!ffesta_seen_first_exec && !ffestb_local_.format.complained)
7106 {
7107 ffestb_local_.format.complained = TRUE;
7108 ffebad_start (FFEBAD_FORMAT_EXPR_SPEC);
7109 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
7110 ffebad_finish ();
7111 }
7112 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
7113 FFEEXPR_contextFORMAT, (ffeexprCallback) ffestb_R100115_);
7114
7115 case FFELEX_typeNUMBER:
7116 ffestb_local_.format.sign = FALSE; /* No sign present. */
7117 ffestb_local_.format.pre.present = TRUE;
7118 ffestb_local_.format.pre.rtexpr = FALSE;
7119 ffestb_local_.format.pre.t = ffelex_token_use (t);
7120 ffestb_local_.format.pre.u.unsigned_val = unsigned_val
7121 = strtoul (ffelex_token_text (t), NULL, 10);
7122 ffelex_set_expecting_hollerith (unsigned_val, '\0',
7123 ffelex_token_where_line (t),
7124 ffelex_token_where_column (t));
7125 return (ffelexHandler) ffestb_R10014_;
7126
7127 case FFELEX_typePLUS:
7128 ffestb_local_.format.sign = TRUE; /* Positive. */
7129 ffestb_local_.format.pre.t = ffelex_token_use (t);
7130 return (ffelexHandler) ffestb_R10013_;
7131
7132 case FFELEX_typeMINUS:
7133 ffestb_local_.format.sign = FALSE; /* Negative. */
7134 ffestb_local_.format.pre.t = ffelex_token_use (t);
7135 return (ffelexHandler) ffestb_R10013_;
7136
7137 case FFELEX_typeCOLON:
7138 case FFELEX_typeCOLONCOLON:/* "::". */
7139 case FFELEX_typeSLASH:
7140 case FFELEX_typeCONCAT: /* "//". */
7141 case FFELEX_typeNAMES:
7142 case FFELEX_typeDOLLAR:
7143 case FFELEX_typeOPEN_PAREN:
7144 case FFELEX_typeOPEN_ARRAY:/* "(/". */
7145 ffestb_local_.format.sign = FALSE; /* No sign present. */
7146 ffestb_local_.format.pre.present = FALSE;
7147 ffestb_local_.format.pre.rtexpr = FALSE;
7148 ffestb_local_.format.pre.t = NULL;
7149 ffestb_local_.format.pre.u.unsigned_val = 1;
7150 return (ffelexHandler) ffestb_R10014_ (t);
7151
7152 case FFELEX_typeCOMMA:
7153 ffebad_start (FFEBAD_FORMAT_EXTRA_COMMA);
7154 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
7155 ffebad_finish ();
7156 return (ffelexHandler) ffestb_R10012_;
7157
7158 case FFELEX_typeCLOSE_PAREN:
7159 ffebad_start (FFEBAD_FORMAT_EXTRA_COMMA);
7160 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
7161 ffebad_finish ();
7162 f = ffestb_local_.format.f->u.root.parent;
7163 if (f == NULL)
7164 return (ffelexHandler) ffestb_R100114_;
7165 ffestb_local_.format.f = f->next;
7166 return (ffelexHandler) ffestb_R100111_;
7167
7168 case FFELEX_typeCLOSE_ARRAY: /* "/)". */
7169 f = ffestt_formatlist_append (ffestb_local_.format.f);
7170 f->type = FFESTP_formattypeSLASH;
7171 f->t = ffelex_token_use (t);
7172 f->u.R1010.val.present = FALSE;
7173 f->u.R1010.val.rtexpr = FALSE;
7174 f->u.R1010.val.t = NULL;
7175 f->u.R1010.val.u.unsigned_val = 1;
7176 f = ffestb_local_.format.f->u.root.parent;
7177 if (f == NULL)
7178 return (ffelexHandler) ffestb_R100114_;
7179 ffestb_local_.format.f = f->next;
7180 return (ffelexHandler) ffestb_R100111_;
7181
7182 case FFELEX_typeEOS:
7183 case FFELEX_typeSEMICOLON:
7184 ffesta_confirmed ();
7185 ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_PAREN, t);
7186 for (f = ffestb_local_.format.f;
7187 f->u.root.parent != NULL;
7188 f = f->u.root.parent->next)
7189 ;
7190 ffestb_local_.format.f = f;
7191 return (ffelexHandler) ffestb_R100114_ (t);
7192
7193 case FFELEX_typeQUOTE:
7194 if (ffe_is_vxt ())
7195 break; /* Error, probably something like FORMAT("17)
7196 = X. */
7197 ffelex_set_expecting_hollerith (-1, '\"',
7198 ffelex_token_where_line (t),
7199 ffelex_token_where_column (t)); /* Don't have to unset
7200 this one. */
7201 return (ffelexHandler) ffestb_R100113_;
7202
7203 case FFELEX_typeAPOSTROPHE:
7204 #if 0 /* No apparent need for this, and not killed
7205 anywhere. */
7206 ffesta_tokens[1] = ffelex_token_use (t);
7207 #endif
7208 ffelex_set_expecting_hollerith (-1, '\'',
7209 ffelex_token_where_line (t),
7210 ffelex_token_where_column (t)); /* Don't have to unset
7211 this one. */
7212 return (ffelexHandler) ffestb_R100113_;
7213
7214 default:
7215 break;
7216 }
7217
7218 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
7219 ffestt_formatlist_kill (ffestb_local_.format.f);
7220 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
7221 }
7222
7223 /* ffestb_R10013_ -- "FORMAT" OPEN_PAREN [format-item-list] PLUS/MINUS
7224
7225 return ffestb_R10013_; // to lexer
7226
7227 Expect a NUMBER or complain about and then ignore the PLUS/MINUS. */
7228
7229 static ffelexHandler
7230 ffestb_R10013_ (ffelexToken t)
7231 {
7232 unsigned long unsigned_val;
7233
7234 switch (ffelex_token_type (t))
7235 {
7236 case FFELEX_typeNUMBER:
7237 ffestb_local_.format.pre.present = TRUE;
7238 ffestb_local_.format.pre.rtexpr = FALSE;
7239 unsigned_val = strtoul (ffelex_token_text (t), NULL, 10);
7240 ffestb_local_.format.pre.u.signed_val = ffestb_local_.format.sign
7241 ? unsigned_val : -unsigned_val;
7242 ffestb_local_.format.sign = TRUE; /* Sign present. */
7243 return (ffelexHandler) ffestb_R10014_;
7244
7245 default:
7246 ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
7247 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
7248 ffelex_token_where_column (ffestb_local_.format.pre.t));
7249 ffebad_finish ();
7250 ffelex_token_kill (ffestb_local_.format.pre.t);
7251 return (ffelexHandler) ffestb_R10012_ (t);
7252 }
7253 }
7254
7255 /* ffestb_R10014_ -- "FORMAT" OPEN_PAREN [format-item-list] [[+/-] NUMBER]
7256
7257 return ffestb_R10014_; // to lexer
7258
7259 Here is where we expect to see the actual NAMES, COLON, SLASH, OPEN_PAREN,
7260 OPEN_ARRAY, COLONCOLON, CONCAT, DOLLAR, or HOLLERITH that identifies what
7261 kind of format-item we're dealing with. But if we see a NUMBER instead, it
7262 means free-form spaces number like "5 6 X", so scale the current number
7263 accordingly and reenter this state. (I really wouldn't be surprised if
7264 they change this spacing rule in the F90 spec so that you can't embed
7265 spaces within numbers or within keywords like BN in a free-source-form
7266 program.) */
7267
7268 static ffelexHandler
7269 ffestb_R10014_ (ffelexToken t)
7270 {
7271 ffesttFormatList f;
7272 ffeTokenLength i;
7273 const char *p;
7274 ffestrFormat kw;
7275
7276 ffelex_set_expecting_hollerith (0, '\0',
7277 ffewhere_line_unknown (),
7278 ffewhere_column_unknown ());
7279
7280 switch (ffelex_token_type (t))
7281 {
7282 case FFELEX_typeHOLLERITH:
7283 f = ffestt_formatlist_append (ffestb_local_.format.f);
7284 f->type = FFESTP_formattypeR1016;
7285 f->t = ffelex_token_use (t);
7286 ffelex_token_kill (ffestb_local_.format.pre.t); /* It WAS present! */
7287 return (ffelexHandler) ffestb_R100111_;
7288
7289 case FFELEX_typeNUMBER:
7290 assert (ffestb_local_.format.pre.present);
7291 ffesta_confirmed ();
7292 if (ffestb_local_.format.pre.rtexpr)
7293 {
7294 ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
7295 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
7296 ffebad_finish ();
7297 return (ffelexHandler) ffestb_R10014_;
7298 }
7299 if (ffestb_local_.format.sign)
7300 {
7301 for (i = ffelex_token_length (t) + 1; i > 0; --i)
7302 ffestb_local_.format.pre.u.signed_val *= 10;
7303 ffestb_local_.format.pre.u.signed_val += strtoul (ffelex_token_text (t),
7304 NULL, 10);
7305 }
7306 else
7307 {
7308 for (i = ffelex_token_length (t) + 1; i > 0; --i)
7309 ffestb_local_.format.pre.u.unsigned_val *= 10;
7310 ffestb_local_.format.pre.u.unsigned_val += strtoul (ffelex_token_text (t),
7311 NULL, 10);
7312 ffelex_set_expecting_hollerith (ffestb_local_.format.pre.u.unsigned_val,
7313 '\0',
7314 ffelex_token_where_line (t),
7315 ffelex_token_where_column (t));
7316 }
7317 return (ffelexHandler) ffestb_R10014_;
7318
7319 case FFELEX_typeCOLONCOLON: /* "::". */
7320 if (ffestb_local_.format.pre.present)
7321 {
7322 ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_COLON_SPEC,
7323 ffestb_local_.format.pre.t);
7324 ffelex_token_kill (ffestb_local_.format.pre.t);
7325 ffestb_local_.format.pre.present = FALSE;
7326 }
7327 else
7328 {
7329 f = ffestt_formatlist_append (ffestb_local_.format.f);
7330 f->type = FFESTP_formattypeCOLON;
7331 f->t = ffelex_token_use (t);
7332 f->u.R1010.val.present = FALSE;
7333 f->u.R1010.val.rtexpr = FALSE;
7334 f->u.R1010.val.t = NULL;
7335 f->u.R1010.val.u.unsigned_val = 1;
7336 }
7337 f = ffestt_formatlist_append (ffestb_local_.format.f);
7338 f->type = FFESTP_formattypeCOLON;
7339 f->t = ffelex_token_use (t);
7340 f->u.R1010.val.present = FALSE;
7341 f->u.R1010.val.rtexpr = FALSE;
7342 f->u.R1010.val.t = NULL;
7343 f->u.R1010.val.u.unsigned_val = 1;
7344 return (ffelexHandler) ffestb_R100112_;
7345
7346 case FFELEX_typeCOLON:
7347 if (ffestb_local_.format.pre.present)
7348 {
7349 ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_COLON_SPEC,
7350 ffestb_local_.format.pre.t);
7351 ffelex_token_kill (ffestb_local_.format.pre.t);
7352 return (ffelexHandler) ffestb_R100112_;
7353 }
7354 f = ffestt_formatlist_append (ffestb_local_.format.f);
7355 f->type = FFESTP_formattypeCOLON;
7356 f->t = ffelex_token_use (t);
7357 f->u.R1010.val.present = FALSE;
7358 f->u.R1010.val.rtexpr = FALSE;
7359 f->u.R1010.val.t = NULL;
7360 f->u.R1010.val.u.unsigned_val = 1;
7361 return (ffelexHandler) ffestb_R100112_;
7362
7363 case FFELEX_typeCONCAT: /* "//". */
7364 if (ffestb_local_.format.sign)
7365 {
7366 ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
7367 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
7368 ffelex_token_where_column (ffestb_local_.format.pre.t));
7369 ffebad_finish ();
7370 ffestb_local_.format.pre.u.unsigned_val
7371 = (ffestb_local_.format.pre.u.signed_val < 0)
7372 ? -ffestb_local_.format.pre.u.signed_val
7373 : ffestb_local_.format.pre.u.signed_val;
7374 }
7375 f = ffestt_formatlist_append (ffestb_local_.format.f);
7376 f->type = FFESTP_formattypeSLASH;
7377 f->t = ffelex_token_use (t);
7378 f->u.R1010.val = ffestb_local_.format.pre;
7379 ffestb_local_.format.pre.present = FALSE;
7380 ffestb_local_.format.pre.rtexpr = FALSE;
7381 ffestb_local_.format.pre.t = NULL;
7382 ffestb_local_.format.pre.u.unsigned_val = 1;
7383 f = ffestt_formatlist_append (ffestb_local_.format.f);
7384 f->type = FFESTP_formattypeSLASH;
7385 f->t = ffelex_token_use (t);
7386 f->u.R1010.val = ffestb_local_.format.pre;
7387 return (ffelexHandler) ffestb_R100112_;
7388
7389 case FFELEX_typeSLASH:
7390 if (ffestb_local_.format.sign)
7391 {
7392 ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
7393 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
7394 ffelex_token_where_column (ffestb_local_.format.pre.t));
7395 ffebad_finish ();
7396 ffestb_local_.format.pre.u.unsigned_val
7397 = (ffestb_local_.format.pre.u.signed_val < 0)
7398 ? -ffestb_local_.format.pre.u.signed_val
7399 : ffestb_local_.format.pre.u.signed_val;
7400 }
7401 f = ffestt_formatlist_append (ffestb_local_.format.f);
7402 f->type = FFESTP_formattypeSLASH;
7403 f->t = ffelex_token_use (t);
7404 f->u.R1010.val = ffestb_local_.format.pre;
7405 return (ffelexHandler) ffestb_R100112_;
7406
7407 case FFELEX_typeOPEN_PAREN:
7408 if (ffestb_local_.format.sign)
7409 {
7410 ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
7411 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
7412 ffelex_token_where_column (ffestb_local_.format.pre.t));
7413 ffebad_finish ();
7414 ffestb_local_.format.pre.u.unsigned_val
7415 = (ffestb_local_.format.pre.u.signed_val < 0)
7416 ? -ffestb_local_.format.pre.u.signed_val
7417 : ffestb_local_.format.pre.u.signed_val;
7418 }
7419 f = ffestt_formatlist_append (ffestb_local_.format.f);
7420 f->type = FFESTP_formattypeFORMAT;
7421 f->t = ffelex_token_use (t);
7422 f->u.R1003D.R1004 = ffestb_local_.format.pre;
7423 f->u.R1003D.format = ffestb_local_.format.f
7424 = ffestt_formatlist_create (f, ffelex_token_use (t));
7425 return (ffelexHandler) ffestb_R10011_;
7426
7427 case FFELEX_typeOPEN_ARRAY:/* "(/". */
7428 if (ffestb_local_.format.sign)
7429 {
7430 ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
7431 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
7432 ffelex_token_where_column (ffestb_local_.format.pre.t));
7433 ffebad_finish ();
7434 ffestb_local_.format.pre.u.unsigned_val
7435 = (ffestb_local_.format.pre.u.signed_val < 0)
7436 ? -ffestb_local_.format.pre.u.signed_val
7437 : ffestb_local_.format.pre.u.signed_val;
7438 }
7439 f = ffestt_formatlist_append (ffestb_local_.format.f);
7440 f->type = FFESTP_formattypeFORMAT;
7441 f->t = ffelex_token_use (t);
7442 f->u.R1003D.R1004 = ffestb_local_.format.pre;
7443 f->u.R1003D.format = ffestb_local_.format.f
7444 = ffestt_formatlist_create (f, ffelex_token_use (t));
7445 f = ffestt_formatlist_append (ffestb_local_.format.f);
7446 f->type = FFESTP_formattypeSLASH;
7447 f->t = ffelex_token_use (t);
7448 f->u.R1010.val.present = FALSE;
7449 f->u.R1010.val.rtexpr = FALSE;
7450 f->u.R1010.val.t = NULL;
7451 f->u.R1010.val.u.unsigned_val = 1;
7452 return (ffelexHandler) ffestb_R100112_;
7453
7454 case FFELEX_typeCLOSE_ARRAY: /* "/)". */
7455 f = ffestt_formatlist_append (ffestb_local_.format.f);
7456 f->type = FFESTP_formattypeSLASH;
7457 f->t = ffelex_token_use (t);
7458 f->u.R1010.val = ffestb_local_.format.pre;
7459 f = ffestb_local_.format.f->u.root.parent;
7460 if (f == NULL)
7461 return (ffelexHandler) ffestb_R100114_;
7462 ffestb_local_.format.f = f->next;
7463 return (ffelexHandler) ffestb_R100111_;
7464
7465 case FFELEX_typeQUOTE:
7466 if (ffe_is_vxt ())
7467 break; /* A totally bad character in a VXT FORMAT. */
7468 ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
7469 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
7470 ffelex_token_where_column (ffestb_local_.format.pre.t));
7471 ffebad_finish ();
7472 ffelex_token_kill (ffestb_local_.format.pre.t);
7473 ffesta_confirmed ();
7474 #if 0 /* No apparent need for this, and not killed
7475 anywhere. */
7476 ffesta_tokens[1] = ffelex_token_use (t);
7477 #endif
7478 ffelex_set_expecting_hollerith (-1, '\"',
7479 ffelex_token_where_line (t),
7480 ffelex_token_where_column (t)); /* Don't have to unset
7481 this one. */
7482 return (ffelexHandler) ffestb_R100113_;
7483
7484 case FFELEX_typeAPOSTROPHE:
7485 ffesta_confirmed ();
7486 ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
7487 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
7488 ffelex_token_where_column (ffestb_local_.format.pre.t));
7489 ffebad_finish ();
7490 ffelex_token_kill (ffestb_local_.format.pre.t);
7491 #if 0 /* No apparent need for this, and not killed
7492 anywhere. */
7493 ffesta_tokens[1] = ffelex_token_use (t);
7494 #endif
7495 ffelex_set_expecting_hollerith (-1, '\'', ffelex_token_where_line (t),
7496 ffelex_token_where_column (t)); /* Don't have to unset
7497 this one. */
7498 return (ffelexHandler) ffestb_R100113_;
7499
7500 case FFELEX_typeEOS:
7501 case FFELEX_typeSEMICOLON:
7502 ffesta_confirmed ();
7503 ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_PAREN, t);
7504 for (f = ffestb_local_.format.f;
7505 f->u.root.parent != NULL;
7506 f = f->u.root.parent->next)
7507 ;
7508 ffestb_local_.format.f = f;
7509 ffelex_token_kill (ffestb_local_.format.pre.t);
7510 return (ffelexHandler) ffestb_R100114_ (t);
7511
7512 case FFELEX_typeDOLLAR:
7513 ffestb_local_.format.t = ffelex_token_use (t);
7514 if (ffestb_local_.format.pre.present)
7515 ffesta_confirmed (); /* Number preceding this invalid elsewhere. */
7516 ffestb_local_.format.current = FFESTP_formattypeDOLLAR;
7517 return (ffelexHandler) ffestb_R10015_;
7518
7519 case FFELEX_typeNAMES:
7520 kw = ffestr_format (t);
7521 ffestb_local_.format.t = ffelex_token_use (t);
7522 switch (kw)
7523 {
7524 case FFESTR_formatI:
7525 if (ffestb_local_.format.pre.present)
7526 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
7527 ffestb_local_.format.current = FFESTP_formattypeI;
7528 i = FFESTR_formatlI;
7529 break;
7530
7531 case FFESTR_formatB:
7532 if (ffestb_local_.format.pre.present)
7533 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
7534 ffestb_local_.format.current = FFESTP_formattypeB;
7535 i = FFESTR_formatlB;
7536 break;
7537
7538 case FFESTR_formatO:
7539 if (ffestb_local_.format.pre.present)
7540 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
7541 ffestb_local_.format.current = FFESTP_formattypeO;
7542 i = FFESTR_formatlO;
7543 break;
7544
7545 case FFESTR_formatZ:
7546 if (ffestb_local_.format.pre.present)
7547 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
7548 ffestb_local_.format.current = FFESTP_formattypeZ;
7549 i = FFESTR_formatlZ;
7550 break;
7551
7552 case FFESTR_formatF:
7553 if (ffestb_local_.format.pre.present)
7554 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
7555 ffestb_local_.format.current = FFESTP_formattypeF;
7556 i = FFESTR_formatlF;
7557 break;
7558
7559 case FFESTR_formatE:
7560 ffestb_local_.format.current = FFESTP_formattypeE;
7561 i = FFESTR_formatlE;
7562 break;
7563
7564 case FFESTR_formatEN:
7565 if (ffestb_local_.format.pre.present)
7566 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
7567 ffestb_local_.format.current = FFESTP_formattypeEN;
7568 i = FFESTR_formatlEN;
7569 break;
7570
7571 case FFESTR_formatG:
7572 if (ffestb_local_.format.pre.present)
7573 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
7574 ffestb_local_.format.current = FFESTP_formattypeG;
7575 i = FFESTR_formatlG;
7576 break;
7577
7578 case FFESTR_formatL:
7579 if (ffestb_local_.format.pre.present)
7580 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
7581 ffestb_local_.format.current = FFESTP_formattypeL;
7582 i = FFESTR_formatlL;
7583 break;
7584
7585 case FFESTR_formatA:
7586 if (ffestb_local_.format.pre.present)
7587 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
7588 ffestb_local_.format.current = FFESTP_formattypeA;
7589 i = FFESTR_formatlA;
7590 break;
7591
7592 case FFESTR_formatD:
7593 ffestb_local_.format.current = FFESTP_formattypeD;
7594 i = FFESTR_formatlD;
7595 break;
7596
7597 case FFESTR_formatQ:
7598 ffestb_local_.format.current = FFESTP_formattypeQ;
7599 i = FFESTR_formatlQ;
7600 break;
7601
7602 case FFESTR_formatDOLLAR:
7603 if (ffestb_local_.format.pre.present)
7604 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
7605 ffestb_local_.format.current = FFESTP_formattypeDOLLAR;
7606 i = FFESTR_formatlDOLLAR;
7607 break;
7608
7609 case FFESTR_formatP:
7610 if (ffestb_local_.format.pre.present)
7611 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
7612 ffestb_local_.format.current = FFESTP_formattypeP;
7613 i = FFESTR_formatlP;
7614 break;
7615
7616 case FFESTR_formatT:
7617 if (ffestb_local_.format.pre.present)
7618 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
7619 ffestb_local_.format.current = FFESTP_formattypeT;
7620 i = FFESTR_formatlT;
7621 break;
7622
7623 case FFESTR_formatTL:
7624 if (ffestb_local_.format.pre.present)
7625 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
7626 ffestb_local_.format.current = FFESTP_formattypeTL;
7627 i = FFESTR_formatlTL;
7628 break;
7629
7630 case FFESTR_formatTR:
7631 if (ffestb_local_.format.pre.present)
7632 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
7633 ffestb_local_.format.current = FFESTP_formattypeTR;
7634 i = FFESTR_formatlTR;
7635 break;
7636
7637 case FFESTR_formatX:
7638 if (ffestb_local_.format.pre.present)
7639 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
7640 ffestb_local_.format.current = FFESTP_formattypeX;
7641 i = FFESTR_formatlX;
7642 break;
7643
7644 case FFESTR_formatS:
7645 if (ffestb_local_.format.pre.present)
7646 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
7647 ffestb_local_.format.current = FFESTP_formattypeS;
7648 i = FFESTR_formatlS;
7649 break;
7650
7651 case FFESTR_formatSP:
7652 if (ffestb_local_.format.pre.present)
7653 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
7654 ffestb_local_.format.current = FFESTP_formattypeSP;
7655 i = FFESTR_formatlSP;
7656 break;
7657
7658 case FFESTR_formatSS:
7659 if (ffestb_local_.format.pre.present)
7660 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
7661 ffestb_local_.format.current = FFESTP_formattypeSS;
7662 i = FFESTR_formatlSS;
7663 break;
7664
7665 case FFESTR_formatBN:
7666 if (ffestb_local_.format.pre.present)
7667 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
7668 ffestb_local_.format.current = FFESTP_formattypeBN;
7669 i = FFESTR_formatlBN;
7670 break;
7671
7672 case FFESTR_formatBZ:
7673 if (ffestb_local_.format.pre.present)
7674 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
7675 ffestb_local_.format.current = FFESTP_formattypeBZ;
7676 i = FFESTR_formatlBZ;
7677 break;
7678
7679 case FFESTR_formatH: /* Error, either "H" or "<expr>H". */
7680 if (ffestb_local_.format.pre.present)
7681 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
7682 ffestb_local_.format.current = FFESTP_formattypeH;
7683 i = FFESTR_formatlH;
7684 break;
7685
7686 case FFESTR_formatPD:
7687 if (ffestb_local_.format.pre.present)
7688 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
7689 ffestb_subr_R1001_append_p_ ();
7690 ffestb_local_.format.t = ffelex_token_name_from_names (t,
7691 FFESTR_formatlP, 1);
7692 ffestb_local_.format.sign = FALSE;
7693 ffestb_local_.format.pre.present = FALSE;
7694 ffestb_local_.format.pre.rtexpr = FALSE;
7695 ffestb_local_.format.pre.t = NULL;
7696 ffestb_local_.format.pre.u.unsigned_val = 1;
7697 ffestb_local_.format.current = FFESTP_formattypeD;
7698 i = FFESTR_formatlPD;
7699 break;
7700
7701 case FFESTR_formatPE:
7702 if (ffestb_local_.format.pre.present)
7703 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
7704 ffestb_subr_R1001_append_p_ ();
7705 ffestb_local_.format.t = ffelex_token_name_from_names (t,
7706 FFESTR_formatlP, 1);
7707 ffestb_local_.format.sign = FALSE;
7708 ffestb_local_.format.pre.present = FALSE;
7709 ffestb_local_.format.pre.rtexpr = FALSE;
7710 ffestb_local_.format.pre.t = NULL;
7711 ffestb_local_.format.pre.u.unsigned_val = 1;
7712 ffestb_local_.format.current = FFESTP_formattypeE;
7713 i = FFESTR_formatlPE;
7714 break;
7715
7716 case FFESTR_formatPEN:
7717 if (ffestb_local_.format.pre.present)
7718 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
7719 ffestb_subr_R1001_append_p_ ();
7720 ffestb_local_.format.t = ffelex_token_name_from_names (t,
7721 FFESTR_formatlP, 1);
7722 ffestb_local_.format.sign = FALSE;
7723 ffestb_local_.format.pre.present = FALSE;
7724 ffestb_local_.format.pre.rtexpr = FALSE;
7725 ffestb_local_.format.pre.t = NULL;
7726 ffestb_local_.format.pre.u.unsigned_val = 1;
7727 ffestb_local_.format.current = FFESTP_formattypeEN;
7728 i = FFESTR_formatlPEN;
7729 break;
7730
7731 case FFESTR_formatPF:
7732 if (ffestb_local_.format.pre.present)
7733 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
7734 ffestb_subr_R1001_append_p_ ();
7735 ffestb_local_.format.t = ffelex_token_name_from_names (t,
7736 FFESTR_formatlP, 1);
7737 ffestb_local_.format.sign = FALSE;
7738 ffestb_local_.format.pre.present = FALSE;
7739 ffestb_local_.format.pre.rtexpr = FALSE;
7740 ffestb_local_.format.pre.t = NULL;
7741 ffestb_local_.format.pre.u.unsigned_val = 1;
7742 ffestb_local_.format.current = FFESTP_formattypeF;
7743 i = FFESTR_formatlPF;
7744 break;
7745
7746 case FFESTR_formatPG:
7747 if (ffestb_local_.format.pre.present)
7748 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
7749 ffestb_subr_R1001_append_p_ ();
7750 ffestb_local_.format.t = ffelex_token_name_from_names (t,
7751 FFESTR_formatlP, 1);
7752 ffestb_local_.format.sign = FALSE;
7753 ffestb_local_.format.pre.present = FALSE;
7754 ffestb_local_.format.pre.rtexpr = FALSE;
7755 ffestb_local_.format.pre.t = NULL;
7756 ffestb_local_.format.pre.u.unsigned_val = 1;
7757 ffestb_local_.format.current = FFESTP_formattypeG;
7758 i = FFESTR_formatlPG;
7759 break;
7760
7761 default:
7762 if (ffestb_local_.format.pre.present)
7763 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
7764 ffestb_local_.format.current = FFESTP_formattypeNone;
7765 p = strpbrk (ffelex_token_text (t), "0123456789");
7766 if (p == NULL)
7767 i = ffelex_token_length (t);
7768 else
7769 i = p - ffelex_token_text (t);
7770 break;
7771 }
7772 p = ffelex_token_text (t) + i;
7773 if (*p == '\0')
7774 return (ffelexHandler) ffestb_R10015_;
7775 if (! ISDIGIT (*p))
7776 {
7777 if (ffestb_local_.format.current == FFESTP_formattypeH)
7778 p = strpbrk (p, "0123456789");
7779 else
7780 {
7781 p = NULL;
7782 ffestb_local_.format.current = FFESTP_formattypeNone;
7783 }
7784 if (p == NULL)
7785 return (ffelexHandler) ffestb_R10015_;
7786 i = p - ffelex_token_text (t); /* Collect digits. */
7787 }
7788 ffestb_local_.format.post.present = TRUE;
7789 ffestb_local_.format.post.rtexpr = FALSE;
7790 ffestb_local_.format.post.t = ffelex_token_number_from_names (t, i);
7791 ffestb_local_.format.post.u.unsigned_val
7792 = strtoul (ffelex_token_text (ffestb_local_.format.post.t), NULL, 10);
7793 p += ffelex_token_length (ffestb_local_.format.post.t);
7794 i += ffelex_token_length (ffestb_local_.format.post.t);
7795 if (*p == '\0')
7796 return (ffelexHandler) ffestb_R10016_;
7797 if ((kw != FFESTR_formatP) ||
7798 !ffelex_is_firstnamechar ((unsigned char)*p))
7799 {
7800 if (ffestb_local_.format.current != FFESTP_formattypeH)
7801 ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL);
7802 return (ffelexHandler) ffestb_R10016_;
7803 }
7804
7805 /* Here we have [number]P[number][text]. Treat as
7806 [number]P,[number][text]. */
7807
7808 ffestb_subr_R1001_append_p_ ();
7809 t = ffestb_local_.format.t = ffelex_token_names_from_names (t, i, 0);
7810 ffestb_local_.format.sign = FALSE;
7811 ffestb_local_.format.pre = ffestb_local_.format.post;
7812 kw = ffestr_format (t);
7813 switch (kw)
7814 { /* Only a few possibilities here. */
7815 case FFESTR_formatD:
7816 ffestb_local_.format.current = FFESTP_formattypeD;
7817 i = FFESTR_formatlD;
7818 break;
7819
7820 case FFESTR_formatE:
7821 ffestb_local_.format.current = FFESTP_formattypeE;
7822 i = FFESTR_formatlE;
7823 break;
7824
7825 case FFESTR_formatEN:
7826 ffestb_local_.format.current = FFESTP_formattypeEN;
7827 i = FFESTR_formatlEN;
7828 break;
7829
7830 case FFESTR_formatF:
7831 ffestb_local_.format.current = FFESTP_formattypeF;
7832 i = FFESTR_formatlF;
7833 break;
7834
7835 case FFESTR_formatG:
7836 ffestb_local_.format.current = FFESTP_formattypeG;
7837 i = FFESTR_formatlG;
7838 break;
7839
7840 default:
7841 ffebad_start (FFEBAD_FORMAT_P_NOCOMMA);
7842 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
7843 ffebad_finish ();
7844 ffestb_local_.format.current = FFESTP_formattypeNone;
7845 p = strpbrk (ffelex_token_text (t), "0123456789");
7846 if (p == NULL)
7847 i = ffelex_token_length (t);
7848 else
7849 i = p - ffelex_token_text (t);
7850 }
7851 p = ffelex_token_text (t) + i;
7852 if (*p == '\0')
7853 return (ffelexHandler) ffestb_R10015_;
7854 if (! ISDIGIT (*p))
7855 {
7856 ffestb_local_.format.current = FFESTP_formattypeNone;
7857 p = strpbrk (p, "0123456789");
7858 if (p == NULL)
7859 return (ffelexHandler) ffestb_R10015_;
7860 i = p - ffelex_token_text (t); /* Collect digits anyway. */
7861 }
7862 ffestb_local_.format.post.present = TRUE;
7863 ffestb_local_.format.post.rtexpr = FALSE;
7864 ffestb_local_.format.post.t = ffelex_token_number_from_names (t, i);
7865 ffestb_local_.format.post.u.unsigned_val
7866 = strtoul (ffelex_token_text (ffestb_local_.format.post.t), NULL, 10);
7867 p += ffelex_token_length (ffestb_local_.format.post.t);
7868 i += ffelex_token_length (ffestb_local_.format.post.t);
7869 if (*p == '\0')
7870 return (ffelexHandler) ffestb_R10016_;
7871 ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL);
7872 return (ffelexHandler) ffestb_R10016_;
7873
7874 default:
7875 break;
7876 }
7877
7878 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
7879 if (ffestb_local_.format.pre.present)
7880 ffelex_token_kill (ffestb_local_.format.pre.t);
7881 ffestt_formatlist_kill (ffestb_local_.format.f);
7882 return (ffelexHandler) ffelex_swallow_tokens (t,
7883 (ffelexHandler) ffesta_zero);
7884 }
7885
7886 /* ffestb_R10015_ -- [[+/-] NUMBER] NAMES
7887
7888 return ffestb_R10015_; // to lexer
7889
7890 Here we've gotten at least the initial mnemonic for the edit descriptor.
7891 We expect either a NUMBER, for the post-mnemonic value, a NAMES, for
7892 further clarification (in free-form only, sigh) of the mnemonic, or
7893 anything else. In all cases we go to _6_, with the difference that for
7894 NUMBER and NAMES we send the next token rather than the current token. */
7895
7896 static ffelexHandler
7897 ffestb_R10015_ (ffelexToken t)
7898 {
7899 bool split_pea; /* New NAMES requires splitting kP from new
7900 edit desc. */
7901 ffestrFormat kw;
7902 const char *p;
7903 ffeTokenLength i;
7904
7905 switch (ffelex_token_type (t))
7906 {
7907 case FFELEX_typeOPEN_ANGLE:
7908 ffesta_confirmed ();
7909 ffestb_local_.format.post.t = ffelex_token_use (t);
7910 ffelex_set_names_pure (FALSE);
7911 if (!ffesta_seen_first_exec && !ffestb_local_.format.complained)
7912 {
7913 ffestb_local_.format.complained = TRUE;
7914 ffebad_start (FFEBAD_FORMAT_EXPR_SPEC);
7915 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
7916 ffebad_finish ();
7917 }
7918 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
7919 FFEEXPR_contextFORMAT, (ffeexprCallback) ffestb_R100116_);
7920
7921 case FFELEX_typeNUMBER:
7922 ffestb_local_.format.post.present = TRUE;
7923 ffestb_local_.format.post.rtexpr = FALSE;
7924 ffestb_local_.format.post.t = ffelex_token_use (t);
7925 ffestb_local_.format.post.u.unsigned_val
7926 = strtoul (ffelex_token_text (t), NULL, 10);
7927 return (ffelexHandler) ffestb_R10016_;
7928
7929 case FFELEX_typeNAMES:
7930 ffesta_confirmed (); /* NAMES " " NAMES invalid elsewhere in
7931 free-form. */
7932 kw = ffestr_format (t);
7933 switch (ffestb_local_.format.current)
7934 {
7935 case FFESTP_formattypeP:
7936 split_pea = TRUE;
7937 break;
7938
7939 case FFESTP_formattypeH: /* An error, maintain this indicator. */
7940 kw = FFESTR_formatNone;
7941 split_pea = FALSE;
7942 break;
7943
7944 default:
7945 split_pea = FALSE;
7946 break;
7947 }
7948
7949 switch (kw)
7950 {
7951 case FFESTR_formatF:
7952 switch (ffestb_local_.format.current)
7953 {
7954 case FFESTP_formattypeP:
7955 ffestb_local_.format.current = FFESTP_formattypeF;
7956 break;
7957
7958 default:
7959 ffestb_local_.format.current = FFESTP_formattypeNone;
7960 break;
7961 }
7962 i = FFESTR_formatlF;
7963 break;
7964
7965 case FFESTR_formatE:
7966 switch (ffestb_local_.format.current)
7967 {
7968 case FFESTP_formattypeP:
7969 ffestb_local_.format.current = FFESTP_formattypeE;
7970 break;
7971
7972 default:
7973 ffestb_local_.format.current = FFESTP_formattypeNone;
7974 break;
7975 }
7976 i = FFESTR_formatlE;
7977 break;
7978
7979 case FFESTR_formatEN:
7980 switch (ffestb_local_.format.current)
7981 {
7982 case FFESTP_formattypeP:
7983 ffestb_local_.format.current = FFESTP_formattypeEN;
7984 break;
7985
7986 default:
7987 ffestb_local_.format.current = FFESTP_formattypeNone;
7988 break;
7989 }
7990 i = FFESTR_formatlEN;
7991 break;
7992
7993 case FFESTR_formatG:
7994 switch (ffestb_local_.format.current)
7995 {
7996 case FFESTP_formattypeP:
7997 ffestb_local_.format.current = FFESTP_formattypeG;
7998 break;
7999
8000 default:
8001 ffestb_local_.format.current = FFESTP_formattypeNone;
8002 break;
8003 }
8004 i = FFESTR_formatlG;
8005 break;
8006
8007 case FFESTR_formatL:
8008 switch (ffestb_local_.format.current)
8009 {
8010 case FFESTP_formattypeT:
8011 ffestb_local_.format.current = FFESTP_formattypeTL;
8012 break;
8013
8014 default:
8015 ffestb_local_.format.current = FFESTP_formattypeNone;
8016 break;
8017 }
8018 i = FFESTR_formatlL;
8019 break;
8020
8021 case FFESTR_formatD:
8022 switch (ffestb_local_.format.current)
8023 {
8024 case FFESTP_formattypeP:
8025 ffestb_local_.format.current = FFESTP_formattypeD;
8026 break;
8027
8028 default:
8029 ffestb_local_.format.current = FFESTP_formattypeNone;
8030 break;
8031 }
8032 i = FFESTR_formatlD;
8033 break;
8034
8035 case FFESTR_formatS:
8036 switch (ffestb_local_.format.current)
8037 {
8038 case FFESTP_formattypeS:
8039 ffestb_local_.format.current = FFESTP_formattypeSS;
8040 break;
8041
8042 default:
8043 ffestb_local_.format.current = FFESTP_formattypeNone;
8044 break;
8045 }
8046 i = FFESTR_formatlS;
8047 break;
8048
8049 case FFESTR_formatP:
8050 switch (ffestb_local_.format.current)
8051 {
8052 case FFESTP_formattypeS:
8053 ffestb_local_.format.current = FFESTP_formattypeSP;
8054 break;
8055
8056 default:
8057 ffestb_local_.format.current = FFESTP_formattypeNone;
8058 break;
8059 }
8060 i = FFESTR_formatlP;
8061 break;
8062
8063 case FFESTR_formatR:
8064 switch (ffestb_local_.format.current)
8065 {
8066 case FFESTP_formattypeT:
8067 ffestb_local_.format.current = FFESTP_formattypeTR;
8068 break;
8069
8070 default:
8071 ffestb_local_.format.current = FFESTP_formattypeNone;
8072 break;
8073 }
8074 i = FFESTR_formatlR;
8075 break;
8076
8077 case FFESTR_formatZ:
8078 switch (ffestb_local_.format.current)
8079 {
8080 case FFESTP_formattypeB:
8081 ffestb_local_.format.current = FFESTP_formattypeBZ;
8082 break;
8083
8084 default:
8085 ffestb_local_.format.current = FFESTP_formattypeNone;
8086 break;
8087 }
8088 i = FFESTR_formatlZ;
8089 break;
8090
8091 case FFESTR_formatN:
8092 switch (ffestb_local_.format.current)
8093 {
8094 case FFESTP_formattypeE:
8095 ffestb_local_.format.current = FFESTP_formattypeEN;
8096 break;
8097
8098 case FFESTP_formattypeB:
8099 ffestb_local_.format.current = FFESTP_formattypeBN;
8100 break;
8101
8102 default:
8103 ffestb_local_.format.current = FFESTP_formattypeNone;
8104 break;
8105 }
8106 i = FFESTR_formatlN;
8107 break;
8108
8109 default:
8110 if (ffestb_local_.format.current != FFESTP_formattypeH)
8111 ffestb_local_.format.current = FFESTP_formattypeNone;
8112 split_pea = FALSE; /* Go ahead and let the P be in the party. */
8113 p = strpbrk (ffelex_token_text (t), "0123456789");
8114 if (p == NULL)
8115 i = ffelex_token_length (t);
8116 else
8117 i = p - ffelex_token_text (t);
8118 }
8119
8120 if (split_pea)
8121 {
8122 ffestb_subr_R1001_append_p_ ();
8123 ffestb_local_.format.t = ffelex_token_use (t);
8124 ffestb_local_.format.sign = FALSE;
8125 ffestb_local_.format.pre.present = FALSE;
8126 ffestb_local_.format.pre.rtexpr = FALSE;
8127 ffestb_local_.format.pre.t = NULL;
8128 ffestb_local_.format.pre.u.unsigned_val = 1;
8129 }
8130
8131 p = ffelex_token_text (t) + i;
8132 if (*p == '\0')
8133 return (ffelexHandler) ffestb_R10015_;
8134 if (! ISDIGIT (*p))
8135 {
8136 ffestb_local_.format.current = FFESTP_formattypeNone;
8137 p = strpbrk (p, "0123456789");
8138 if (p == NULL)
8139 return (ffelexHandler) ffestb_R10015_;
8140 i = p - ffelex_token_text (t); /* Collect digits anyway. */
8141 }
8142 ffestb_local_.format.post.present = TRUE;
8143 ffestb_local_.format.post.rtexpr = FALSE;
8144 ffestb_local_.format.post.t = ffelex_token_number_from_names (t, i);
8145 ffestb_local_.format.post.u.unsigned_val
8146 = strtoul (ffelex_token_text (ffestb_local_.format.post.t), NULL, 10);
8147 p += ffelex_token_length (ffestb_local_.format.post.t);
8148 i += ffelex_token_length (ffestb_local_.format.post.t);
8149 if (*p == '\0')
8150 return (ffelexHandler) ffestb_R10016_;
8151 ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL);
8152 return (ffelexHandler) ffestb_R10016_;
8153
8154 default:
8155 ffestb_local_.format.post.present = FALSE;
8156 ffestb_local_.format.post.rtexpr = FALSE;
8157 ffestb_local_.format.post.t = NULL;
8158 ffestb_local_.format.post.u.unsigned_val = 1;
8159 return (ffelexHandler) ffestb_R10016_ (t);
8160 }
8161 }
8162
8163 /* ffestb_R10016_ -- [[+/-] NUMBER] NAMES NUMBER
8164
8165 return ffestb_R10016_; // to lexer
8166
8167 Expect a PERIOD here. Maybe find a NUMBER to append to the current
8168 number, in which case return to this state. Maybe find a NAMES to switch
8169 from a kP descriptor to a new descriptor (else the NAMES is spurious),
8170 in which case generator the P item and go to state _4_. Anything
8171 else, pass token on to state _8_. */
8172
8173 static ffelexHandler
8174 ffestb_R10016_ (ffelexToken t)
8175 {
8176 ffeTokenLength i;
8177
8178 switch (ffelex_token_type (t))
8179 {
8180 case FFELEX_typePERIOD:
8181 return (ffelexHandler) ffestb_R10017_;
8182
8183 case FFELEX_typeNUMBER:
8184 assert (ffestb_local_.format.post.present);
8185 ffesta_confirmed ();
8186 if (ffestb_local_.format.post.rtexpr)
8187 {
8188 ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
8189 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
8190 ffebad_finish ();
8191 return (ffelexHandler) ffestb_R10016_;
8192 }
8193 for (i = ffelex_token_length (t) + 1; i > 0; --i)
8194 ffestb_local_.format.post.u.unsigned_val *= 10;
8195 ffestb_local_.format.post.u.unsigned_val += strtoul (ffelex_token_text (t),
8196 NULL, 10);
8197 return (ffelexHandler) ffestb_R10016_;
8198
8199 case FFELEX_typeNAMES:
8200 ffesta_confirmed (); /* NUMBER " " NAMES invalid elsewhere. */
8201 if (ffestb_local_.format.current != FFESTP_formattypeP)
8202 {
8203 ffesta_ffebad_1t (FFEBAD_FORMAT_TEXT_IN_NUMBER, t);
8204 return (ffelexHandler) ffestb_R10016_;
8205 }
8206 ffestb_subr_R1001_append_p_ ();
8207 ffestb_local_.format.sign = FALSE;
8208 ffestb_local_.format.pre = ffestb_local_.format.post;
8209 return (ffelexHandler) ffestb_R10014_ (t);
8210
8211 default:
8212 ffestb_local_.format.dot.present = FALSE;
8213 ffestb_local_.format.dot.rtexpr = FALSE;
8214 ffestb_local_.format.dot.t = NULL;
8215 ffestb_local_.format.dot.u.unsigned_val = 1;
8216 return (ffelexHandler) ffestb_R10018_ (t);
8217 }
8218 }
8219
8220 /* ffestb_R10017_ -- [[+/-] NUMBER] NAMES NUMBER PERIOD
8221
8222 return ffestb_R10017_; // to lexer
8223
8224 Here we've gotten the period following the edit descriptor.
8225 We expect either a NUMBER, for the dot value, or something else, which
8226 probably means we're not even close to being in a real FORMAT statement. */
8227
8228 static ffelexHandler
8229 ffestb_R10017_ (ffelexToken t)
8230 {
8231 switch (ffelex_token_type (t))
8232 {
8233 case FFELEX_typeOPEN_ANGLE:
8234 ffestb_local_.format.dot.t = ffelex_token_use (t);
8235 ffelex_set_names_pure (FALSE);
8236 if (!ffesta_seen_first_exec && !ffestb_local_.format.complained)
8237 {
8238 ffestb_local_.format.complained = TRUE;
8239 ffebad_start (FFEBAD_FORMAT_EXPR_SPEC);
8240 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
8241 ffebad_finish ();
8242 }
8243 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
8244 FFEEXPR_contextFORMAT, (ffeexprCallback) ffestb_R100117_);
8245
8246 case FFELEX_typeNUMBER:
8247 ffestb_local_.format.dot.present = TRUE;
8248 ffestb_local_.format.dot.rtexpr = FALSE;
8249 ffestb_local_.format.dot.t = ffelex_token_use (t);
8250 ffestb_local_.format.dot.u.unsigned_val
8251 = strtoul (ffelex_token_text (t), NULL, 10);
8252 return (ffelexHandler) ffestb_R10018_;
8253
8254 default:
8255 ffelex_token_kill (ffestb_local_.format.t);
8256 if (ffestb_local_.format.pre.present)
8257 ffelex_token_kill (ffestb_local_.format.pre.t);
8258 if (ffestb_local_.format.post.present)
8259 ffelex_token_kill (ffestb_local_.format.post.t);
8260 ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_DOT, t);
8261 ffestt_formatlist_kill (ffestb_local_.format.f);
8262 return (ffelexHandler) ffelex_swallow_tokens (t,
8263 (ffelexHandler) ffesta_zero);
8264 }
8265 }
8266
8267 /* ffestb_R10018_ -- [[+/-] NUMBER] NAMES NUMBER PERIOD NUMBER
8268
8269 return ffestb_R10018_; // to lexer
8270
8271 Expect a NAMES here, which must begin with "E" to be valid. Maybe find a
8272 NUMBER to append to the current number, in which case return to this state.
8273 Anything else, pass token on to state _10_. */
8274
8275 static ffelexHandler
8276 ffestb_R10018_ (ffelexToken t)
8277 {
8278 ffeTokenLength i;
8279 const char *p;
8280
8281 switch (ffelex_token_type (t))
8282 {
8283 case FFELEX_typeNUMBER:
8284 assert (ffestb_local_.format.dot.present);
8285 ffesta_confirmed ();
8286 if (ffestb_local_.format.dot.rtexpr)
8287 {
8288 ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
8289 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
8290 ffebad_finish ();
8291 return (ffelexHandler) ffestb_R10018_;
8292 }
8293 for (i = ffelex_token_length (t) + 1; i > 0; --i)
8294 ffestb_local_.format.dot.u.unsigned_val *= 10;
8295 ffestb_local_.format.dot.u.unsigned_val += strtoul (ffelex_token_text (t),
8296 NULL, 10);
8297 return (ffelexHandler) ffestb_R10018_;
8298
8299 case FFELEX_typeNAMES:
8300 if (!ffesrc_char_match_init (*(p = ffelex_token_text (t)), 'E', 'e'))
8301 {
8302 ffesta_ffebad_1t (FFEBAD_FORMAT_TEXT_IN_NUMBER, t);
8303 return (ffelexHandler) ffestb_R10018_;
8304 }
8305 if (*++p == '\0')
8306 return (ffelexHandler) ffestb_R10019_; /* Go get NUMBER. */
8307 i = 1;
8308 if (! ISDIGIT (*p))
8309 {
8310 ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, 1, NULL);
8311 return (ffelexHandler) ffestb_R10018_;
8312 }
8313 ffestb_local_.format.exp.present = TRUE;
8314 ffestb_local_.format.exp.rtexpr = FALSE;
8315 ffestb_local_.format.exp.t = ffelex_token_number_from_names (t, i);
8316 ffestb_local_.format.exp.u.unsigned_val
8317 = strtoul (ffelex_token_text (ffestb_local_.format.exp.t), NULL, 10);
8318 p += ffelex_token_length (ffestb_local_.format.exp.t);
8319 i += ffelex_token_length (ffestb_local_.format.exp.t);
8320 if (*p == '\0')
8321 return (ffelexHandler) ffestb_R100110_;
8322 ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL);
8323 return (ffelexHandler) ffestb_R100110_;
8324
8325 default:
8326 ffestb_local_.format.exp.present = FALSE;
8327 ffestb_local_.format.exp.rtexpr = FALSE;
8328 ffestb_local_.format.exp.t = NULL;
8329 ffestb_local_.format.exp.u.unsigned_val = 1;
8330 return (ffelexHandler) ffestb_R100110_ (t);
8331 }
8332 }
8333
8334 /* ffestb_R10019_ -- [[+/-] NUMBER] NAMES NUMBER PERIOD NUMBER "E"
8335
8336 return ffestb_R10019_; // to lexer
8337
8338 Here we've gotten the "E" following the edit descriptor.
8339 We expect either a NUMBER, for the exponent value, or something else. */
8340
8341 static ffelexHandler
8342 ffestb_R10019_ (ffelexToken t)
8343 {
8344 switch (ffelex_token_type (t))
8345 {
8346 case FFELEX_typeOPEN_ANGLE:
8347 ffestb_local_.format.exp.t = ffelex_token_use (t);
8348 ffelex_set_names_pure (FALSE);
8349 if (!ffesta_seen_first_exec && !ffestb_local_.format.complained)
8350 {
8351 ffestb_local_.format.complained = TRUE;
8352 ffebad_start (FFEBAD_FORMAT_EXPR_SPEC);
8353 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
8354 ffebad_finish ();
8355 }
8356 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
8357 FFEEXPR_contextFORMAT, (ffeexprCallback) ffestb_R100118_);
8358
8359 case FFELEX_typeNUMBER:
8360 ffestb_local_.format.exp.present = TRUE;
8361 ffestb_local_.format.exp.rtexpr = FALSE;
8362 ffestb_local_.format.exp.t = ffelex_token_use (t);
8363 ffestb_local_.format.exp.u.unsigned_val
8364 = strtoul (ffelex_token_text (t), NULL, 10);
8365 return (ffelexHandler) ffestb_R100110_;
8366
8367 default:
8368 ffelex_token_kill (ffestb_local_.format.t);
8369 if (ffestb_local_.format.pre.present)
8370 ffelex_token_kill (ffestb_local_.format.pre.t);
8371 if (ffestb_local_.format.post.present)
8372 ffelex_token_kill (ffestb_local_.format.post.t);
8373 if (ffestb_local_.format.dot.present)
8374 ffelex_token_kill (ffestb_local_.format.dot.t);
8375 ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_EXP, t);
8376 ffestt_formatlist_kill (ffestb_local_.format.f);
8377 return (ffelexHandler) ffelex_swallow_tokens (t,
8378 (ffelexHandler) ffesta_zero);
8379 }
8380 }
8381
8382 /* ffestb_R100110_ -- [[+/-] NUMBER] NAMES NUMBER [PERIOD NUMBER ["E" NUMBER]]
8383
8384 return ffestb_R100110_; // to lexer
8385
8386 Maybe find a NUMBER to append to the current number, in which case return
8387 to this state. Anything else, handle current descriptor, then pass token
8388 on to state _10_. */
8389
8390 static ffelexHandler
8391 ffestb_R100110_ (ffelexToken t)
8392 {
8393 ffeTokenLength i;
8394 enum expect
8395 {
8396 required,
8397 optional,
8398 disallowed
8399 };
8400 ffebad err;
8401 enum expect pre;
8402 enum expect post;
8403 enum expect dot;
8404 enum expect exp;
8405 bool R1005;
8406 ffesttFormatList f;
8407
8408 switch (ffelex_token_type (t))
8409 {
8410 case FFELEX_typeNUMBER:
8411 assert (ffestb_local_.format.exp.present);
8412 ffesta_confirmed ();
8413 if (ffestb_local_.format.exp.rtexpr)
8414 {
8415 ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
8416 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
8417 ffebad_finish ();
8418 return (ffelexHandler) ffestb_R100110_;
8419 }
8420 for (i = ffelex_token_length (t) + 1; i > 0; --i)
8421 ffestb_local_.format.exp.u.unsigned_val *= 10;
8422 ffestb_local_.format.exp.u.unsigned_val += strtoul (ffelex_token_text (t),
8423 NULL, 10);
8424 return (ffelexHandler) ffestb_R100110_;
8425
8426 default:
8427 if (ffestb_local_.format.sign
8428 && (ffestb_local_.format.current != FFESTP_formattypeP)
8429 && (ffestb_local_.format.current != FFESTP_formattypeH))
8430 {
8431 ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
8432 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
8433 ffelex_token_where_column (ffestb_local_.format.pre.t));
8434 ffebad_finish ();
8435 ffestb_local_.format.pre.u.unsigned_val
8436 = (ffestb_local_.format.pre.u.signed_val < 0)
8437 ? -ffestb_local_.format.pre.u.signed_val
8438 : ffestb_local_.format.pre.u.signed_val;
8439 }
8440 switch (ffestb_local_.format.current)
8441 {
8442 case FFESTP_formattypeI:
8443 err = FFEBAD_FORMAT_BAD_I_SPEC;
8444 pre = optional;
8445 post = required;
8446 dot = optional;
8447 exp = disallowed;
8448 R1005 = TRUE;
8449 break;
8450
8451 case FFESTP_formattypeB:
8452 err = FFEBAD_FORMAT_BAD_B_SPEC;
8453 pre = optional;
8454 post = required;
8455 dot = optional;
8456 exp = disallowed;
8457 R1005 = TRUE;
8458 break;
8459
8460 case FFESTP_formattypeO:
8461 err = FFEBAD_FORMAT_BAD_O_SPEC;
8462 pre = optional;
8463 post = required;
8464 dot = optional;
8465 exp = disallowed;
8466 R1005 = TRUE;
8467 break;
8468
8469 case FFESTP_formattypeZ:
8470 err = FFEBAD_FORMAT_BAD_Z_SPEC;
8471 pre = optional;
8472 post = required;
8473 dot = optional;
8474 exp = disallowed;
8475 R1005 = TRUE;
8476 break;
8477
8478 case FFESTP_formattypeF:
8479 err = FFEBAD_FORMAT_BAD_F_SPEC;
8480 pre = optional;
8481 post = required;
8482 dot = required;
8483 exp = disallowed;
8484 R1005 = TRUE;
8485 break;
8486
8487 case FFESTP_formattypeE:
8488 err = FFEBAD_FORMAT_BAD_E_SPEC;
8489 pre = optional;
8490 post = required;
8491 dot = required;
8492 exp = optional;
8493 R1005 = TRUE;
8494 break;
8495
8496 case FFESTP_formattypeEN:
8497 err = FFEBAD_FORMAT_BAD_EN_SPEC;
8498 pre = optional;
8499 post = required;
8500 dot = required;
8501 exp = optional;
8502 R1005 = TRUE;
8503 break;
8504
8505 case FFESTP_formattypeG:
8506 err = FFEBAD_FORMAT_BAD_G_SPEC;
8507 pre = optional;
8508 post = required;
8509 dot = required;
8510 exp = optional;
8511 R1005 = TRUE;
8512 break;
8513
8514 case FFESTP_formattypeL:
8515 err = FFEBAD_FORMAT_BAD_L_SPEC;
8516 pre = optional;
8517 post = required;
8518 dot = disallowed;
8519 exp = disallowed;
8520 R1005 = TRUE;
8521 break;
8522
8523 case FFESTP_formattypeA:
8524 err = FFEBAD_FORMAT_BAD_A_SPEC;
8525 pre = optional;
8526 post = optional;
8527 dot = disallowed;
8528 exp = disallowed;
8529 R1005 = TRUE;
8530 break;
8531
8532 case FFESTP_formattypeD:
8533 err = FFEBAD_FORMAT_BAD_D_SPEC;
8534 pre = optional;
8535 post = required;
8536 dot = required;
8537 exp = disallowed;
8538 R1005 = TRUE;
8539 break;
8540
8541 case FFESTP_formattypeQ:
8542 err = FFEBAD_FORMAT_BAD_Q_SPEC;
8543 pre = disallowed;
8544 post = disallowed;
8545 dot = disallowed;
8546 exp = disallowed;
8547 R1005 = FALSE;
8548 break;
8549
8550 case FFESTP_formattypeDOLLAR:
8551 err = FFEBAD_FORMAT_BAD_DOLLAR_SPEC;
8552 pre = disallowed;
8553 post = disallowed;
8554 dot = disallowed;
8555 exp = disallowed;
8556 R1005 = FALSE;
8557 break;
8558
8559 case FFESTP_formattypeP:
8560 err = FFEBAD_FORMAT_BAD_P_SPEC;
8561 pre = required;
8562 post = disallowed;
8563 dot = disallowed;
8564 exp = disallowed;
8565 R1005 = FALSE;
8566 break;
8567
8568 case FFESTP_formattypeT:
8569 err = FFEBAD_FORMAT_BAD_T_SPEC;
8570 pre = disallowed;
8571 post = required;
8572 dot = disallowed;
8573 exp = disallowed;
8574 R1005 = FALSE;
8575 break;
8576
8577 case FFESTP_formattypeTL:
8578 err = FFEBAD_FORMAT_BAD_TL_SPEC;
8579 pre = disallowed;
8580 post = required;
8581 dot = disallowed;
8582 exp = disallowed;
8583 R1005 = FALSE;
8584 break;
8585
8586 case FFESTP_formattypeTR:
8587 err = FFEBAD_FORMAT_BAD_TR_SPEC;
8588 pre = disallowed;
8589 post = required;
8590 dot = disallowed;
8591 exp = disallowed;
8592 R1005 = FALSE;
8593 break;
8594
8595 case FFESTP_formattypeX:
8596 err = FFEBAD_FORMAT_BAD_X_SPEC;
8597 pre = ffe_is_pedantic() ? required : optional;
8598 post = disallowed;
8599 dot = disallowed;
8600 exp = disallowed;
8601 R1005 = FALSE;
8602 break;
8603
8604 case FFESTP_formattypeS:
8605 err = FFEBAD_FORMAT_BAD_S_SPEC;
8606 pre = disallowed;
8607 post = disallowed;
8608 dot = disallowed;
8609 exp = disallowed;
8610 R1005 = FALSE;
8611 break;
8612
8613 case FFESTP_formattypeSP:
8614 err = FFEBAD_FORMAT_BAD_SP_SPEC;
8615 pre = disallowed;
8616 post = disallowed;
8617 dot = disallowed;
8618 exp = disallowed;
8619 R1005 = FALSE;
8620 break;
8621
8622 case FFESTP_formattypeSS:
8623 err = FFEBAD_FORMAT_BAD_SS_SPEC;
8624 pre = disallowed;
8625 post = disallowed;
8626 dot = disallowed;
8627 exp = disallowed;
8628 R1005 = FALSE;
8629 break;
8630
8631 case FFESTP_formattypeBN:
8632 err = FFEBAD_FORMAT_BAD_BN_SPEC;
8633 pre = disallowed;
8634 post = disallowed;
8635 dot = disallowed;
8636 exp = disallowed;
8637 R1005 = FALSE;
8638 break;
8639
8640 case FFESTP_formattypeBZ:
8641 err = FFEBAD_FORMAT_BAD_BZ_SPEC;
8642 pre = disallowed;
8643 post = disallowed;
8644 dot = disallowed;
8645 exp = disallowed;
8646 R1005 = FALSE;
8647 break;
8648
8649 case FFESTP_formattypeH: /* Definitely an error, make sure of
8650 it. */
8651 err = FFEBAD_FORMAT_BAD_H_SPEC;
8652 pre = ffestb_local_.format.pre.present ? disallowed : required;
8653 post = disallowed;
8654 dot = disallowed;
8655 exp = disallowed;
8656 R1005 = FALSE;
8657 break;
8658
8659 case FFESTP_formattypeNone:
8660 ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_SPEC,
8661 ffestb_local_.format.t);
8662
8663 clean_up_to_11_: /* :::::::::::::::::::: */
8664
8665 ffelex_token_kill (ffestb_local_.format.t);
8666 if (ffestb_local_.format.pre.present)
8667 ffelex_token_kill (ffestb_local_.format.pre.t);
8668 if (ffestb_local_.format.post.present)
8669 ffelex_token_kill (ffestb_local_.format.post.t);
8670 if (ffestb_local_.format.dot.present)
8671 ffelex_token_kill (ffestb_local_.format.dot.t);
8672 if (ffestb_local_.format.exp.present)
8673 ffelex_token_kill (ffestb_local_.format.exp.t);
8674 return (ffelexHandler) ffestb_R100111_ (t);
8675
8676 default:
8677 assert ("bad format item" == NULL);
8678 err = FFEBAD_FORMAT_BAD_H_SPEC;
8679 pre = disallowed;
8680 post = disallowed;
8681 dot = disallowed;
8682 exp = disallowed;
8683 R1005 = FALSE;
8684 break;
8685 }
8686 if (((pre == disallowed) && ffestb_local_.format.pre.present)
8687 || ((pre == required) && !ffestb_local_.format.pre.present))
8688 {
8689 ffesta_ffebad_1t (err, (pre == required)
8690 ? ffestb_local_.format.t : ffestb_local_.format.pre.t);
8691 goto clean_up_to_11_; /* :::::::::::::::::::: */
8692 }
8693 if (((post == disallowed) && ffestb_local_.format.post.present)
8694 || ((post == required) && !ffestb_local_.format.post.present))
8695 {
8696 ffesta_ffebad_1t (err, (post == required)
8697 ? ffestb_local_.format.t : ffestb_local_.format.post.t);
8698 goto clean_up_to_11_; /* :::::::::::::::::::: */
8699 }
8700 if (((dot == disallowed) && ffestb_local_.format.dot.present)
8701 || ((dot == required) && !ffestb_local_.format.dot.present))
8702 {
8703 ffesta_ffebad_1t (err, (dot == required)
8704 ? ffestb_local_.format.t : ffestb_local_.format.dot.t);
8705 goto clean_up_to_11_; /* :::::::::::::::::::: */
8706 }
8707 if (((exp == disallowed) && ffestb_local_.format.exp.present)
8708 || ((exp == required) && !ffestb_local_.format.exp.present))
8709 {
8710 ffesta_ffebad_1t (err, (exp == required)
8711 ? ffestb_local_.format.t : ffestb_local_.format.exp.t);
8712 goto clean_up_to_11_; /* :::::::::::::::::::: */
8713 }
8714 f = ffestt_formatlist_append (ffestb_local_.format.f);
8715 f->type = ffestb_local_.format.current;
8716 f->t = ffestb_local_.format.t;
8717 if (R1005)
8718 {
8719 f->u.R1005.R1004 = ffestb_local_.format.pre;
8720 f->u.R1005.R1006 = ffestb_local_.format.post;
8721 f->u.R1005.R1007_or_R1008 = ffestb_local_.format.dot;
8722 f->u.R1005.R1009 = ffestb_local_.format.exp;
8723 }
8724 else
8725 /* Must be R1010. */
8726 {
8727 if (pre == disallowed)
8728 f->u.R1010.val = ffestb_local_.format.post;
8729 else
8730 f->u.R1010.val = ffestb_local_.format.pre;
8731 }
8732 return (ffelexHandler) ffestb_R100111_ (t);
8733 }
8734 }
8735
8736 /* ffestb_R100111_ -- edit-descriptor
8737
8738 return ffestb_R100111_; // to lexer
8739
8740 Expect a COMMA, CLOSE_PAREN, CLOSE_ARRAY, COLON, COLONCOLON, SLASH, or
8741 CONCAT, or complain about missing comma. */
8742
8743 static ffelexHandler
8744 ffestb_R100111_ (ffelexToken t)
8745 {
8746 ffesttFormatList f;
8747
8748 switch (ffelex_token_type (t))
8749 {
8750 case FFELEX_typeCOMMA:
8751 return (ffelexHandler) ffestb_R10012_;
8752
8753 case FFELEX_typeCOLON:
8754 case FFELEX_typeCOLONCOLON:
8755 case FFELEX_typeSLASH:
8756 case FFELEX_typeCONCAT:
8757 return (ffelexHandler) ffestb_R10012_ (t);
8758
8759 case FFELEX_typeCLOSE_PAREN:
8760 f = ffestb_local_.format.f->u.root.parent;
8761 if (f == NULL)
8762 return (ffelexHandler) ffestb_R100114_;
8763 ffestb_local_.format.f = f->next;
8764 return (ffelexHandler) ffestb_R100111_;
8765
8766 case FFELEX_typeCLOSE_ARRAY: /* "/)". */
8767 f = ffestt_formatlist_append (ffestb_local_.format.f);
8768 f->type = FFESTP_formattypeSLASH;
8769 f->t = ffelex_token_use (t);
8770 f->u.R1010.val.present = FALSE;
8771 f->u.R1010.val.rtexpr = FALSE;
8772 f->u.R1010.val.t = NULL;
8773 f->u.R1010.val.u.unsigned_val = 1;
8774 f = ffestb_local_.format.f->u.root.parent;
8775 if (f == NULL)
8776 return (ffelexHandler) ffestb_R100114_;
8777 ffestb_local_.format.f = f->next;
8778 return (ffelexHandler) ffestb_R100111_;
8779
8780 case FFELEX_typeOPEN_ANGLE:
8781 case FFELEX_typeDOLLAR:
8782 case FFELEX_typeNUMBER:
8783 case FFELEX_typeOPEN_PAREN:
8784 case FFELEX_typeOPEN_ARRAY:
8785 case FFELEX_typeQUOTE:
8786 case FFELEX_typeAPOSTROPHE:
8787 case FFELEX_typeNAMES:
8788 ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_COMMA, t);
8789 return (ffelexHandler) ffestb_R10012_ (t);
8790
8791 case FFELEX_typeEOS:
8792 case FFELEX_typeSEMICOLON:
8793 ffesta_confirmed ();
8794 ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_PAREN, t);
8795 for (f = ffestb_local_.format.f;
8796 f->u.root.parent != NULL;
8797 f = f->u.root.parent->next)
8798 ;
8799 ffestb_local_.format.f = f;
8800 return (ffelexHandler) ffestb_R100114_ (t);
8801
8802 default:
8803 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
8804 ffestt_formatlist_kill (ffestb_local_.format.f);
8805 return (ffelexHandler) ffelex_swallow_tokens (t,
8806 (ffelexHandler) ffesta_zero);
8807 }
8808 }
8809
8810 /* ffestb_R100112_ -- COLON, COLONCOLON, SLASH, OPEN_ARRAY, or CONCAT
8811
8812 return ffestb_R100112_; // to lexer
8813
8814 Like _11_ except the COMMA is optional. */
8815
8816 static ffelexHandler
8817 ffestb_R100112_ (ffelexToken t)
8818 {
8819 ffesttFormatList f;
8820
8821 switch (ffelex_token_type (t))
8822 {
8823 case FFELEX_typeCOMMA:
8824 return (ffelexHandler) ffestb_R10012_;
8825
8826 case FFELEX_typeCOLON:
8827 case FFELEX_typeCOLONCOLON:
8828 case FFELEX_typeSLASH:
8829 case FFELEX_typeCONCAT:
8830 case FFELEX_typeOPEN_ANGLE:
8831 case FFELEX_typeNAMES:
8832 case FFELEX_typeDOLLAR:
8833 case FFELEX_typeNUMBER:
8834 case FFELEX_typeOPEN_PAREN:
8835 case FFELEX_typeOPEN_ARRAY:
8836 case FFELEX_typeQUOTE:
8837 case FFELEX_typeAPOSTROPHE:
8838 case FFELEX_typePLUS:
8839 case FFELEX_typeMINUS:
8840 return (ffelexHandler) ffestb_R10012_ (t);
8841
8842 case FFELEX_typeCLOSE_PAREN:
8843 f = ffestb_local_.format.f->u.root.parent;
8844 if (f == NULL)
8845 return (ffelexHandler) ffestb_R100114_;
8846 ffestb_local_.format.f = f->next;
8847 return (ffelexHandler) ffestb_R100111_;
8848
8849 case FFELEX_typeCLOSE_ARRAY: /* "/)". */
8850 f = ffestt_formatlist_append (ffestb_local_.format.f);
8851 f->type = FFESTP_formattypeSLASH;
8852 f->t = ffelex_token_use (t);
8853 f->u.R1010.val.present = FALSE;
8854 f->u.R1010.val.rtexpr = FALSE;
8855 f->u.R1010.val.t = NULL;
8856 f->u.R1010.val.u.unsigned_val = 1;
8857 f = ffestb_local_.format.f->u.root.parent;
8858 if (f == NULL)
8859 return (ffelexHandler) ffestb_R100114_;
8860 ffestb_local_.format.f = f->next;
8861 return (ffelexHandler) ffestb_R100111_;
8862
8863 case FFELEX_typeEOS:
8864 case FFELEX_typeSEMICOLON:
8865 ffesta_confirmed ();
8866 ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_PAREN, t);
8867 for (f = ffestb_local_.format.f;
8868 f->u.root.parent != NULL;
8869 f = f->u.root.parent->next)
8870 ;
8871 ffestb_local_.format.f = f;
8872 return (ffelexHandler) ffestb_R100114_ (t);
8873
8874 default:
8875 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
8876 ffestt_formatlist_kill (ffestb_local_.format.f);
8877 return (ffelexHandler) ffelex_swallow_tokens (t,
8878 (ffelexHandler) ffesta_zero);
8879 }
8880 }
8881
8882 /* ffestb_R100113_ -- Handle CHARACTER token.
8883
8884 return ffestb_R100113_; // to lexer
8885
8886 Append the format item to the list, go to _11_. */
8887
8888 static ffelexHandler
8889 ffestb_R100113_ (ffelexToken t)
8890 {
8891 ffesttFormatList f;
8892
8893 assert (ffelex_token_type (t) == FFELEX_typeCHARACTER);
8894
8895 if (ffe_is_pedantic_not_90 () && (ffelex_token_length (t) == 0))
8896 {
8897 ffebad_start (FFEBAD_NULL_CHAR_CONST);
8898 ffebad_here (0, ffelex_token_where_line (t),
8899 ffelex_token_where_column (t));
8900 ffebad_finish ();
8901 }
8902
8903 f = ffestt_formatlist_append (ffestb_local_.format.f);
8904 f->type = FFESTP_formattypeR1016;
8905 f->t = ffelex_token_use (t);
8906 return (ffelexHandler) ffestb_R100111_;
8907 }
8908
8909 /* ffestb_R100114_ -- "FORMAT" OPEN_PAREN format-item-list CLOSE_PAREN
8910
8911 return ffestb_R100114_; // to lexer
8912
8913 Handle EOS/SEMICOLON or something else. */
8914
8915 static ffelexHandler
8916 ffestb_R100114_ (ffelexToken t)
8917 {
8918 ffelex_set_names_pure (FALSE);
8919
8920 switch (ffelex_token_type (t))
8921 {
8922 case FFELEX_typeEOS:
8923 case FFELEX_typeSEMICOLON:
8924 ffesta_confirmed ();
8925 if (!ffesta_is_inhibited () && !ffestb_local_.format.complained)
8926 ffestc_R1001 (ffestb_local_.format.f);
8927 ffestt_formatlist_kill (ffestb_local_.format.f);
8928 return (ffelexHandler) ffesta_zero (t);
8929
8930 default:
8931 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
8932 ffestt_formatlist_kill (ffestb_local_.format.f);
8933 return (ffelexHandler) ffelex_swallow_tokens (t,
8934 (ffelexHandler) ffesta_zero);
8935 }
8936 }
8937
8938 /* ffestb_R100115_ -- OPEN_ANGLE expr
8939
8940 (ffestb_R100115_) // to expression handler
8941
8942 Handle expression prior to the edit descriptor. */
8943
8944 static ffelexHandler
8945 ffestb_R100115_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
8946 {
8947 switch (ffelex_token_type (t))
8948 {
8949 case FFELEX_typeCLOSE_ANGLE:
8950 ffestb_local_.format.pre.present = TRUE;
8951 ffestb_local_.format.pre.rtexpr = TRUE;
8952 ffestb_local_.format.pre.u.expr = expr;
8953 ffelex_set_names_pure (TRUE);
8954 return (ffelexHandler) ffestb_R10014_;
8955
8956 default:
8957 ffelex_token_kill (ffestb_local_.format.pre.t);
8958 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
8959 ffestt_formatlist_kill (ffestb_local_.format.f);
8960 return (ffelexHandler) ffelex_swallow_tokens (t,
8961 (ffelexHandler) ffesta_zero);
8962 }
8963 }
8964
8965 /* ffestb_R100116_ -- "[n]X" OPEN_ANGLE expr
8966
8967 (ffestb_R100116_) // to expression handler
8968
8969 Handle expression after the edit descriptor. */
8970
8971 static ffelexHandler
8972 ffestb_R100116_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
8973 {
8974 switch (ffelex_token_type (t))
8975 {
8976 case FFELEX_typeCLOSE_ANGLE:
8977 ffestb_local_.format.post.present = TRUE;
8978 ffestb_local_.format.post.rtexpr = TRUE;
8979 ffestb_local_.format.post.u.expr = expr;
8980 ffelex_set_names_pure (TRUE);
8981 return (ffelexHandler) ffestb_R10016_;
8982
8983 default:
8984 ffelex_token_kill (ffestb_local_.format.t);
8985 ffelex_token_kill (ffestb_local_.format.post.t);
8986 if (ffestb_local_.format.pre.present)
8987 ffelex_token_kill (ffestb_local_.format.pre.t);
8988 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
8989 ffestt_formatlist_kill (ffestb_local_.format.f);
8990 return (ffelexHandler) ffelex_swallow_tokens (t,
8991 (ffelexHandler) ffesta_zero);
8992 }
8993 }
8994
8995 /* ffestb_R100117_ -- "[n]X[n]." OPEN_ANGLE expr
8996
8997 (ffestb_R100117_) // to expression handler
8998
8999 Handle expression after the PERIOD. */
9000
9001 static ffelexHandler
9002 ffestb_R100117_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
9003 {
9004 switch (ffelex_token_type (t))
9005 {
9006 case FFELEX_typeCLOSE_ANGLE:
9007 ffestb_local_.format.dot.present = TRUE;
9008 ffestb_local_.format.dot.rtexpr = TRUE;
9009 ffestb_local_.format.dot.u.expr = expr;
9010 ffelex_set_names_pure (TRUE);
9011 return (ffelexHandler) ffestb_R10018_;
9012
9013 default:
9014 ffelex_token_kill (ffestb_local_.format.t);
9015 ffelex_token_kill (ffestb_local_.format.dot.t);
9016 if (ffestb_local_.format.pre.present)
9017 ffelex_token_kill (ffestb_local_.format.pre.t);
9018 if (ffestb_local_.format.post.present)
9019 ffelex_token_kill (ffestb_local_.format.post.t);
9020 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
9021 ffestt_formatlist_kill (ffestb_local_.format.f);
9022 return (ffelexHandler) ffelex_swallow_tokens (t,
9023 (ffelexHandler) ffesta_zero);
9024 }
9025 }
9026
9027 /* ffestb_R100118_ -- "[n]X[n].[n]E" OPEN_ANGLE expr
9028
9029 (ffestb_R100118_) // to expression handler
9030
9031 Handle expression after the "E". */
9032
9033 static ffelexHandler
9034 ffestb_R100118_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
9035 {
9036 switch (ffelex_token_type (t))
9037 {
9038 case FFELEX_typeCLOSE_ANGLE:
9039 ffestb_local_.format.exp.present = TRUE;
9040 ffestb_local_.format.exp.rtexpr = TRUE;
9041 ffestb_local_.format.exp.u.expr = expr;
9042 ffelex_set_names_pure (TRUE);
9043 return (ffelexHandler) ffestb_R100110_;
9044
9045 default:
9046 ffelex_token_kill (ffestb_local_.format.t);
9047 ffelex_token_kill (ffestb_local_.format.exp.t);
9048 if (ffestb_local_.format.pre.present)
9049 ffelex_token_kill (ffestb_local_.format.pre.t);
9050 if (ffestb_local_.format.post.present)
9051 ffelex_token_kill (ffestb_local_.format.post.t);
9052 if (ffestb_local_.format.dot.present)
9053 ffelex_token_kill (ffestb_local_.format.dot.t);
9054 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
9055 ffestt_formatlist_kill (ffestb_local_.format.f);
9056 return (ffelexHandler) ffelex_swallow_tokens (t,
9057 (ffelexHandler) ffesta_zero);
9058 }
9059 }
9060
9061 /* ffestb_S3P4 -- Parse the INCLUDE line
9062
9063 return ffestb_S3P4; // to lexer
9064
9065 Make sure the statement has a valid form for the INCLUDE line. If it
9066 does, implement the statement. */
9067
9068 ffelexHandler
9069 ffestb_S3P4 (ffelexToken t)
9070 {
9071 ffeTokenLength i;
9072 const char *p;
9073 ffelexHandler next;
9074 ffelexToken nt;
9075 ffelexToken ut;
9076
9077 switch (ffelex_token_type (ffesta_tokens[0]))
9078 {
9079 case FFELEX_typeNAME:
9080 if (ffesta_first_kw != FFESTR_firstINCLUDE)
9081 goto bad_0; /* :::::::::::::::::::: */
9082 switch (ffelex_token_type (t))
9083 {
9084 case FFELEX_typeNUMBER:
9085 case FFELEX_typeAPOSTROPHE:
9086 case FFELEX_typeQUOTE:
9087 break;
9088
9089 default:
9090 goto bad_1; /* :::::::::::::::::::: */
9091 }
9092 ffesta_confirmed ();
9093 return (ffelexHandler) (*((ffelexHandler)
9094 ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextINCLUDE,
9095 (ffeexprCallback) ffestb_S3P41_)))
9096 (t);
9097
9098 case FFELEX_typeNAMES:
9099 if (ffesta_first_kw != FFESTR_firstINCLUDE)
9100 goto bad_0; /* :::::::::::::::::::: */
9101 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlINCLUDE);
9102 switch (ffelex_token_type (t))
9103 {
9104 default:
9105 goto bad_1; /* :::::::::::::::::::: */
9106
9107 case FFELEX_typeAPOSTROPHE:
9108 case FFELEX_typeQUOTE:
9109 break;
9110 }
9111 ffesta_confirmed ();
9112 if (*p == '\0')
9113 return (ffelexHandler) (*((ffelexHandler)
9114 ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextINCLUDE,
9115 (ffeexprCallback) ffestb_S3P41_)))
9116 (t);
9117 if (! ISDIGIT (*p))
9118 goto bad_i; /* :::::::::::::::::::: */
9119 nt = ffelex_token_number_from_names (ffesta_tokens[0], i);
9120 p += ffelex_token_length (nt);
9121 i += ffelex_token_length (nt);
9122 if ((*p != '_') || (++i, *++p != '\0'))
9123 {
9124 ffelex_token_kill (nt);
9125 goto bad_i; /* :::::::::::::::::::: */
9126 }
9127 ut = ffelex_token_uscore_from_names (ffesta_tokens[0], i - 1);
9128 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs
9129 (ffesta_output_pool, FFEEXPR_contextINCLUDE,
9130 (ffeexprCallback) ffestb_S3P41_)))
9131 (nt);
9132 ffelex_token_kill (nt);
9133 next = (ffelexHandler) (*next) (ut);
9134 ffelex_token_kill (ut);
9135 return (ffelexHandler) (*next) (t);
9136
9137 default:
9138 goto bad_0; /* :::::::::::::::::::: */
9139 }
9140
9141 bad_0: /* :::::::::::::::::::: */
9142 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INCLUDE", ffesta_tokens[0]);
9143 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
9144
9145 bad_1: /* :::::::::::::::::::: */
9146 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INCLUDE", t);
9147 return (ffelexHandler) ffelex_swallow_tokens (t,
9148 (ffelexHandler) ffesta_zero); /* Invalid second token. */
9149
9150 bad_i: /* :::::::::::::::::::: */
9151 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "INCLUDE", ffesta_tokens[0], i, t);
9152 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
9153 }
9154
9155 /* ffestb_S3P41_ -- "INCLUDE" [NUMBER "_"] expr
9156
9157 (ffestb_S3P41_) // to expression handler
9158
9159 Make sure the next token is an EOS, but not a SEMICOLON. */
9160
9161 static ffelexHandler
9162 ffestb_S3P41_ (ffelexToken ft, ffebld expr, ffelexToken t)
9163 {
9164 switch (ffelex_token_type (t))
9165 {
9166 case FFELEX_typeEOS:
9167 case FFELEX_typeSEMICOLON:
9168 if (expr == NULL)
9169 break;
9170 if (!ffesta_is_inhibited ())
9171 {
9172 if (ffe_is_pedantic ()
9173 && ((ffelex_token_type (t) == FFELEX_typeSEMICOLON)
9174 || ffesta_line_has_semicolons))
9175 {
9176 /* xgettext:no-c-format */
9177 ffebad_start_msg ("INCLUDE at %0 not the only statement on the source line", FFEBAD_severityWARNING);
9178 ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
9179 ffelex_token_where_column (ffesta_tokens[0]));
9180 ffebad_finish ();
9181 }
9182 ffestc_S3P4 (expr, ft);
9183 }
9184 return (ffelexHandler) ffesta_zero (t);
9185
9186 default:
9187 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INCLUDE", t);
9188 break;
9189 }
9190
9191 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
9192 }
9193
9194 /* ffestb_V014 -- Parse the VOLATILE statement
9195
9196 return ffestb_V014; // to lexer
9197
9198 Make sure the statement has a valid form for the VOLATILE statement. If it
9199 does, implement the statement. */
9200
9201 ffelexHandler
9202 ffestb_V014 (ffelexToken t)
9203 {
9204 ffeTokenLength i;
9205 unsigned const char *p;
9206 ffelexToken nt;
9207 ffelexHandler next;
9208
9209 switch (ffelex_token_type (ffesta_tokens[0]))
9210 {
9211 case FFELEX_typeNAME:
9212 if (ffesta_first_kw != FFESTR_firstVOLATILE)
9213 goto bad_0; /* :::::::::::::::::::: */
9214 switch (ffelex_token_type (t))
9215 {
9216 case FFELEX_typeEOS:
9217 case FFELEX_typeSEMICOLON:
9218 case FFELEX_typeCOMMA:
9219 ffesta_confirmed (); /* Error, but clearly intended. */
9220 goto bad_1; /* :::::::::::::::::::: */
9221
9222 default:
9223 goto bad_1; /* :::::::::::::::::::: */
9224
9225 case FFELEX_typeNAME:
9226 case FFELEX_typeSLASH:
9227 ffesta_confirmed ();
9228 if (!ffesta_is_inhibited ())
9229 ffestc_V014_start ();
9230 return (ffelexHandler) ffestb_V0141_ (t);
9231
9232 case FFELEX_typeCOLONCOLON:
9233 ffesta_confirmed ();
9234 if (!ffesta_is_inhibited ())
9235 ffestc_V014_start ();
9236 return (ffelexHandler) ffestb_V0141_;
9237 }
9238
9239 case FFELEX_typeNAMES:
9240 if (ffesta_first_kw != FFESTR_firstVOLATILE)
9241 goto bad_0; /* :::::::::::::::::::: */
9242 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlVOLATILE);
9243 switch (ffelex_token_type (t))
9244 {
9245 default:
9246 goto bad_1; /* :::::::::::::::::::: */
9247
9248 case FFELEX_typeCOMMA:
9249 case FFELEX_typeEOS:
9250 case FFELEX_typeSEMICOLON:
9251 ffesta_confirmed ();
9252 break;
9253
9254 case FFELEX_typeSLASH:
9255 ffesta_confirmed ();
9256 if (*p != '\0')
9257 goto bad_i; /* :::::::::::::::::::: */
9258 if (!ffesta_is_inhibited ())
9259 ffestc_V014_start ();
9260 return (ffelexHandler) ffestb_V0141_ (t);
9261
9262 case FFELEX_typeCOLONCOLON:
9263 ffesta_confirmed ();
9264 if (*p != '\0')
9265 goto bad_i; /* :::::::::::::::::::: */
9266 if (!ffesta_is_inhibited ())
9267 ffestc_V014_start ();
9268 return (ffelexHandler) ffestb_V0141_;
9269 }
9270
9271 /* Here, we have at least one char after "VOLATILE" and t is COMMA or
9272 EOS/SEMICOLON. */
9273
9274 if (!ffesrc_is_name_init (*p))
9275 goto bad_i; /* :::::::::::::::::::: */
9276 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
9277 if (!ffesta_is_inhibited ())
9278 ffestc_V014_start ();
9279 next = (ffelexHandler) ffestb_V0141_ (nt);
9280 ffelex_token_kill (nt);
9281 return (ffelexHandler) (*next) (t);
9282
9283 default:
9284 goto bad_0; /* :::::::::::::::::::: */
9285 }
9286
9287 bad_0: /* :::::::::::::::::::: */
9288 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", ffesta_tokens[0]);
9289 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
9290
9291 bad_1: /* :::::::::::::::::::: */
9292 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
9293 return (ffelexHandler) ffelex_swallow_tokens (t,
9294 (ffelexHandler) ffesta_zero); /* Invalid second token. */
9295
9296 bad_i: /* :::::::::::::::::::: */
9297 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "VOLATILE", ffesta_tokens[0], i, t);
9298 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
9299 }
9300
9301 /* ffestb_V0141_ -- "VOLATILE" [COLONCOLON]
9302
9303 return ffestb_V0141_; // to lexer
9304
9305 Handle NAME or SLASH. */
9306
9307 static ffelexHandler
9308 ffestb_V0141_ (ffelexToken t)
9309 {
9310 switch (ffelex_token_type (t))
9311 {
9312 case FFELEX_typeNAME:
9313 ffestb_local_.V014.is_cblock = FALSE;
9314 ffesta_tokens[1] = ffelex_token_use (t);
9315 return (ffelexHandler) ffestb_V0144_;
9316
9317 case FFELEX_typeSLASH:
9318 ffestb_local_.V014.is_cblock = TRUE;
9319 return (ffelexHandler) ffestb_V0142_;
9320
9321 default:
9322 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
9323 break;
9324 }
9325
9326 if (!ffesta_is_inhibited ())
9327 ffestc_V014_finish ();
9328 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
9329 }
9330
9331 /* ffestb_V0142_ -- "VOLATILE" [COLONCOLON] SLASH
9332
9333 return ffestb_V0142_; // to lexer
9334
9335 Handle NAME. */
9336
9337 static ffelexHandler
9338 ffestb_V0142_ (ffelexToken t)
9339 {
9340 switch (ffelex_token_type (t))
9341 {
9342 case FFELEX_typeNAME:
9343 ffesta_tokens[1] = ffelex_token_use (t);
9344 return (ffelexHandler) ffestb_V0143_;
9345
9346 default:
9347 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
9348 break;
9349 }
9350
9351 if (!ffesta_is_inhibited ())
9352 ffestc_V014_finish ();
9353 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
9354 }
9355
9356 /* ffestb_V0143_ -- "VOLATILE" [COLONCOLON] SLASH NAME
9357
9358 return ffestb_V0143_; // to lexer
9359
9360 Handle SLASH. */
9361
9362 static ffelexHandler
9363 ffestb_V0143_ (ffelexToken t)
9364 {
9365 switch (ffelex_token_type (t))
9366 {
9367 case FFELEX_typeSLASH:
9368 return (ffelexHandler) ffestb_V0144_;
9369
9370 default:
9371 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
9372 break;
9373 }
9374
9375 if (!ffesta_is_inhibited ())
9376 ffestc_V014_finish ();
9377 ffelex_token_kill (ffesta_tokens[1]);
9378 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
9379 }
9380
9381 /* ffestb_V0144_ -- "VOLATILE" [COLONCOLON] R523
9382
9383 return ffestb_V0144_; // to lexer
9384
9385 Handle COMMA or EOS/SEMICOLON. */
9386
9387 static ffelexHandler
9388 ffestb_V0144_ (ffelexToken t)
9389 {
9390 switch (ffelex_token_type (t))
9391 {
9392 case FFELEX_typeCOMMA:
9393 if (!ffesta_is_inhibited ())
9394 {
9395 if (ffestb_local_.V014.is_cblock)
9396 ffestc_V014_item_cblock (ffesta_tokens[1]);
9397 else
9398 ffestc_V014_item_object (ffesta_tokens[1]);
9399 }
9400 ffelex_token_kill (ffesta_tokens[1]);
9401 return (ffelexHandler) ffestb_V0141_;
9402
9403 case FFELEX_typeEOS:
9404 case FFELEX_typeSEMICOLON:
9405 if (!ffesta_is_inhibited ())
9406 {
9407 if (ffestb_local_.V014.is_cblock)
9408 ffestc_V014_item_cblock (ffesta_tokens[1]);
9409 else
9410 ffestc_V014_item_object (ffesta_tokens[1]);
9411 ffestc_V014_finish ();
9412 }
9413 ffelex_token_kill (ffesta_tokens[1]);
9414 return (ffelexHandler) ffesta_zero (t);
9415
9416 default:
9417 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
9418 break;
9419 }
9420
9421 if (!ffesta_is_inhibited ())
9422 ffestc_V014_finish ();
9423 ffelex_token_kill (ffesta_tokens[1]);
9424 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
9425 }
9426
9427 /* ffestb_subr_kill_easy_ -- Kill I/O statement data structure
9428
9429 ffestb_subr_kill_easy_();
9430
9431 Kills all tokens in the I/O data structure. Assumes that they are
9432 overlaid with each other (union) in ffest_private.h and the typing
9433 and structure references assume (though not necessarily dangerous if
9434 FALSE) that INQUIRE has the most file elements. */
9435
9436 #if FFESTB_KILL_EASY_
9437 static void
9438 ffestb_subr_kill_easy_ (ffestpInquireIx max)
9439 {
9440 ffestpInquireIx ix;
9441
9442 for (ix = 0; ix < max; ++ix)
9443 {
9444 if (ffestp_file.inquire.inquire_spec[ix].kw_or_val_present)
9445 {
9446 if (ffestp_file.inquire.inquire_spec[ix].kw_present)
9447 ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].kw);
9448 if (ffestp_file.inquire.inquire_spec[ix].value_present)
9449 ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].value);
9450 }
9451 }
9452 }
9453
9454 #endif
9455 /* ffestb_subr_kill_accept_ -- Kill ACCEPT statement data structure
9456
9457 ffestb_subr_kill_accept_();
9458
9459 Kills all tokens in the ACCEPT data structure. */
9460
9461 #if !FFESTB_KILL_EASY_
9462 static void
9463 ffestb_subr_kill_accept_ (void)
9464 {
9465 ffestpAcceptIx ix;
9466
9467 for (ix = 0; ix < FFESTP_acceptix; ++ix)
9468 {
9469 if (ffestp_file.accept.accept_spec[ix].kw_or_val_present)
9470 {
9471 if (ffestp_file.accept.accept_spec[ix].kw_present)
9472 ffelex_token_kill (ffestp_file.accept.accept_spec[ix].kw);
9473 if (ffestp_file.accept.accept_spec[ix].value_present)
9474 ffelex_token_kill (ffestp_file.accept.accept_spec[ix].value);
9475 }
9476 }
9477 }
9478
9479 #endif
9480 /* ffestb_subr_kill_beru_ -- Kill BACKSPACE/ENDFILE/REWIND/UNLOCK statement
9481 data structure
9482
9483 ffestb_subr_kill_beru_();
9484
9485 Kills all tokens in the BACKSPACE/ENDFILE/REWIND/UNLOCK data structure. */
9486
9487 #if !FFESTB_KILL_EASY_
9488 static void
9489 ffestb_subr_kill_beru_ (void)
9490 {
9491 ffestpBeruIx ix;
9492
9493 for (ix = 0; ix < FFESTP_beruix; ++ix)
9494 {
9495 if (ffestp_file.beru.beru_spec[ix].kw_or_val_present)
9496 {
9497 if (ffestp_file.beru.beru_spec[ix].kw_present)
9498 ffelex_token_kill (ffestp_file.beru.beru_spec[ix].kw);
9499 if (ffestp_file.beru.beru_spec[ix].value_present)
9500 ffelex_token_kill (ffestp_file.beru.beru_spec[ix].value);
9501 }
9502 }
9503 }
9504
9505 #endif
9506 /* ffestb_subr_kill_close_ -- Kill CLOSE statement data structure
9507
9508 ffestb_subr_kill_close_();
9509
9510 Kills all tokens in the CLOSE data structure. */
9511
9512 #if !FFESTB_KILL_EASY_
9513 static void
9514 ffestb_subr_kill_close_ (void)
9515 {
9516 ffestpCloseIx ix;
9517
9518 for (ix = 0; ix < FFESTP_closeix; ++ix)
9519 {
9520 if (ffestp_file.close.close_spec[ix].kw_or_val_present)
9521 {
9522 if (ffestp_file.close.close_spec[ix].kw_present)
9523 ffelex_token_kill (ffestp_file.close.close_spec[ix].kw);
9524 if (ffestp_file.close.close_spec[ix].value_present)
9525 ffelex_token_kill (ffestp_file.close.close_spec[ix].value);
9526 }
9527 }
9528 }
9529
9530 #endif
9531 /* ffestb_subr_kill_delete_ -- Kill DELETE statement data structure
9532
9533 ffestb_subr_kill_delete_();
9534
9535 Kills all tokens in the DELETE data structure. */
9536
9537 #if !FFESTB_KILL_EASY_
9538 static void
9539 ffestb_subr_kill_delete_ (void)
9540 {
9541 ffestpDeleteIx ix;
9542
9543 for (ix = 0; ix < FFESTP_deleteix; ++ix)
9544 {
9545 if (ffestp_file.delete.delete_spec[ix].kw_or_val_present)
9546 {
9547 if (ffestp_file.delete.delete_spec[ix].kw_present)
9548 ffelex_token_kill (ffestp_file.delete.delete_spec[ix].kw);
9549 if (ffestp_file.delete.delete_spec[ix].value_present)
9550 ffelex_token_kill (ffestp_file.delete.delete_spec[ix].value);
9551 }
9552 }
9553 }
9554
9555 #endif
9556 /* ffestb_subr_kill_inquire_ -- Kill INQUIRE statement data structure
9557
9558 ffestb_subr_kill_inquire_();
9559
9560 Kills all tokens in the INQUIRE data structure. */
9561
9562 #if !FFESTB_KILL_EASY_
9563 static void
9564 ffestb_subr_kill_inquire_ (void)
9565 {
9566 ffestpInquireIx ix;
9567
9568 for (ix = 0; ix < FFESTP_inquireix; ++ix)
9569 {
9570 if (ffestp_file.inquire.inquire_spec[ix].kw_or_val_present)
9571 {
9572 if (ffestp_file.inquire.inquire_spec[ix].kw_present)
9573 ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].kw);
9574 if (ffestp_file.inquire.inquire_spec[ix].value_present)
9575 ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].value);
9576 }
9577 }
9578 }
9579
9580 #endif
9581 /* ffestb_subr_kill_open_ -- Kill OPEN statement data structure
9582
9583 ffestb_subr_kill_open_();
9584
9585 Kills all tokens in the OPEN data structure. */
9586
9587 #if !FFESTB_KILL_EASY_
9588 static void
9589 ffestb_subr_kill_open_ (void)
9590 {
9591 ffestpOpenIx ix;
9592
9593 for (ix = 0; ix < FFESTP_openix; ++ix)
9594 {
9595 if (ffestp_file.open.open_spec[ix].kw_or_val_present)
9596 {
9597 if (ffestp_file.open.open_spec[ix].kw_present)
9598 ffelex_token_kill (ffestp_file.open.open_spec[ix].kw);
9599 if (ffestp_file.open.open_spec[ix].value_present)
9600 ffelex_token_kill (ffestp_file.open.open_spec[ix].value);
9601 }
9602 }
9603 }
9604
9605 #endif
9606 /* ffestb_subr_kill_print_ -- Kill PRINT statement data structure
9607
9608 ffestb_subr_kill_print_();
9609
9610 Kills all tokens in the PRINT data structure. */
9611
9612 #if !FFESTB_KILL_EASY_
9613 static void
9614 ffestb_subr_kill_print_ (void)
9615 {
9616 ffestpPrintIx ix;
9617
9618 for (ix = 0; ix < FFESTP_printix; ++ix)
9619 {
9620 if (ffestp_file.print.print_spec[ix].kw_or_val_present)
9621 {
9622 if (ffestp_file.print.print_spec[ix].kw_present)
9623 ffelex_token_kill (ffestp_file.print.print_spec[ix].kw);
9624 if (ffestp_file.print.print_spec[ix].value_present)
9625 ffelex_token_kill (ffestp_file.print.print_spec[ix].value);
9626 }
9627 }
9628 }
9629
9630 #endif
9631 /* ffestb_subr_kill_read_ -- Kill READ statement data structure
9632
9633 ffestb_subr_kill_read_();
9634
9635 Kills all tokens in the READ data structure. */
9636
9637 #if !FFESTB_KILL_EASY_
9638 static void
9639 ffestb_subr_kill_read_ (void)
9640 {
9641 ffestpReadIx ix;
9642
9643 for (ix = 0; ix < FFESTP_readix; ++ix)
9644 {
9645 if (ffestp_file.read.read_spec[ix].kw_or_val_present)
9646 {
9647 if (ffestp_file.read.read_spec[ix].kw_present)
9648 ffelex_token_kill (ffestp_file.read.read_spec[ix].kw);
9649 if (ffestp_file.read.read_spec[ix].value_present)
9650 ffelex_token_kill (ffestp_file.read.read_spec[ix].value);
9651 }
9652 }
9653 }
9654
9655 #endif
9656 /* ffestb_subr_kill_rewrite_ -- Kill REWRITE statement data structure
9657
9658 ffestb_subr_kill_rewrite_();
9659
9660 Kills all tokens in the REWRITE data structure. */
9661
9662 #if !FFESTB_KILL_EASY_
9663 static void
9664 ffestb_subr_kill_rewrite_ (void)
9665 {
9666 ffestpRewriteIx ix;
9667
9668 for (ix = 0; ix < FFESTP_rewriteix; ++ix)
9669 {
9670 if (ffestp_file.rewrite.rewrite_spec[ix].kw_or_val_present)
9671 {
9672 if (ffestp_file.rewrite.rewrite_spec[ix].kw_present)
9673 ffelex_token_kill (ffestp_file.rewrite.rewrite_spec[ix].kw);
9674 if (ffestp_file.rewrite.rewrite_spec[ix].value_present)
9675 ffelex_token_kill (ffestp_file.rewrite.rewrite_spec[ix].value);
9676 }
9677 }
9678 }
9679
9680 #endif
9681 /* ffestb_subr_kill_type_ -- Kill TYPE statement data structure
9682
9683 ffestb_subr_kill_type_();
9684
9685 Kills all tokens in the TYPE data structure. */
9686
9687 #if !FFESTB_KILL_EASY_
9688 static void
9689 ffestb_subr_kill_type_ (void)
9690 {
9691 ffestpTypeIx ix;
9692
9693 for (ix = 0; ix < FFESTP_typeix; ++ix)
9694 {
9695 if (ffestp_file.type.type_spec[ix].kw_or_val_present)
9696 {
9697 if (ffestp_file.type.type_spec[ix].kw_present)
9698 ffelex_token_kill (ffestp_file.type.type_spec[ix].kw);
9699 if (ffestp_file.type.type_spec[ix].value_present)
9700 ffelex_token_kill (ffestp_file.type.type_spec[ix].value);
9701 }
9702 }
9703 }
9704
9705 #endif
9706 /* ffestb_subr_kill_write_ -- Kill WRITE statement data structure
9707
9708 ffestb_subr_kill_write_();
9709
9710 Kills all tokens in the WRITE data structure. */
9711
9712 #if !FFESTB_KILL_EASY_
9713 static void
9714 ffestb_subr_kill_write_ (void)
9715 {
9716 ffestpWriteIx ix;
9717
9718 for (ix = 0; ix < FFESTP_writeix; ++ix)
9719 {
9720 if (ffestp_file.write.write_spec[ix].kw_or_val_present)
9721 {
9722 if (ffestp_file.write.write_spec[ix].kw_present)
9723 ffelex_token_kill (ffestp_file.write.write_spec[ix].kw);
9724 if (ffestp_file.write.write_spec[ix].value_present)
9725 ffelex_token_kill (ffestp_file.write.write_spec[ix].value);
9726 }
9727 }
9728 }
9729
9730 #endif
9731 /* ffestb_beru -- Parse the BACKSPACE/ENDFILE/REWIND/UNLOCK statement
9732
9733 return ffestb_beru; // to lexer
9734
9735 Make sure the statement has a valid form for the BACKSPACE/ENDFILE/REWIND/
9736 UNLOCK statement. If it does, implement the statement. */
9737
9738 ffelexHandler
9739 ffestb_beru (ffelexToken t)
9740 {
9741 ffelexHandler next;
9742 ffestpBeruIx ix;
9743
9744 switch (ffelex_token_type (ffesta_tokens[0]))
9745 {
9746 case FFELEX_typeNAME:
9747 switch (ffelex_token_type (t))
9748 {
9749 case FFELEX_typeCOMMA:
9750 case FFELEX_typeCOLONCOLON:
9751 case FFELEX_typeEOS:
9752 case FFELEX_typeSEMICOLON:
9753 ffesta_confirmed (); /* Error, but clearly intended. */
9754 goto bad_1; /* :::::::::::::::::::: */
9755
9756 case FFELEX_typeEQUALS:
9757 case FFELEX_typePOINTS:
9758 case FFELEX_typeCOLON:
9759 goto bad_1; /* :::::::::::::::::::: */
9760
9761 case FFELEX_typeNAME:
9762 case FFELEX_typeNUMBER:
9763 ffesta_confirmed ();
9764 break;
9765
9766 case FFELEX_typeOPEN_PAREN:
9767 for (ix = 0; ix < FFESTP_beruix; ++ix)
9768 ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
9769 ffesta_tokens[1] = ffelex_token_use (t);
9770 return (ffelexHandler) ffestb_beru2_;
9771
9772 default:
9773 break;
9774 }
9775
9776 for (ix = 0; ix < FFESTP_beruix; ++ix)
9777 ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
9778 return (ffelexHandler) (*((ffelexHandler)
9779 ffeexpr_rhs (ffesta_output_pool,
9780 FFEEXPR_contextFILENUM,
9781 (ffeexprCallback) ffestb_beru1_)))
9782 (t);
9783
9784 case FFELEX_typeNAMES:
9785 switch (ffelex_token_type (t))
9786 {
9787 case FFELEX_typeCOMMA:
9788 case FFELEX_typeCOLONCOLON:
9789 ffesta_confirmed (); /* Error, but clearly intended. */
9790 goto bad_1; /* :::::::::::::::::::: */
9791
9792 case FFELEX_typeEQUALS:
9793 case FFELEX_typePOINTS:
9794 case FFELEX_typeCOLON:
9795 goto bad_1; /* :::::::::::::::::::: */
9796
9797 case FFELEX_typeEOS:
9798 case FFELEX_typeSEMICOLON:
9799 ffesta_confirmed ();
9800 break;
9801
9802 case FFELEX_typeOPEN_PAREN:
9803 if (ffelex_token_length (ffesta_tokens[0])
9804 != ffestb_args.beru.len)
9805 break;
9806
9807 for (ix = 0; ix < FFESTP_beruix; ++ix)
9808 ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
9809 ffesta_tokens[1] = ffelex_token_use (t);
9810 return (ffelexHandler) ffestb_beru2_;
9811
9812 default:
9813 break;
9814 }
9815 for (ix = 0; ix < FFESTP_beruix; ++ix)
9816 ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
9817 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
9818 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_beru1_);
9819 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
9820 ffestb_args.beru.len);
9821 if (next == NULL)
9822 return (ffelexHandler) ffelex_swallow_tokens (t,
9823 (ffelexHandler) ffesta_zero);
9824 return (ffelexHandler) (*next) (t);
9825
9826 default:
9827 goto bad_0; /* :::::::::::::::::::: */
9828 }
9829
9830 bad_0: /* :::::::::::::::::::: */
9831 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, ffesta_tokens[0]);
9832 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
9833
9834 bad_1: /* :::::::::::::::::::: */
9835 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
9836 return (ffelexHandler) ffelex_swallow_tokens (t,
9837 (ffelexHandler) ffesta_zero); /* Invalid second token. */
9838 }
9839
9840 /* ffestb_beru1_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" expr
9841
9842 (ffestb_beru1_) // to expression handler
9843
9844 Make sure the next token is an EOS or SEMICOLON. */
9845
9846 static ffelexHandler
9847 ffestb_beru1_ (ffelexToken ft, ffebld expr, ffelexToken t)
9848 {
9849 switch (ffelex_token_type (t))
9850 {
9851 case FFELEX_typeEOS:
9852 case FFELEX_typeSEMICOLON:
9853 if (expr == NULL)
9854 break;
9855 ffesta_confirmed ();
9856 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_or_val_present
9857 = TRUE;
9858 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_present = FALSE;
9859 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_present = TRUE;
9860 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_is_label
9861 = FALSE;
9862 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value
9863 = ffelex_token_use (ft);
9864 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].u.expr = expr;
9865 if (!ffesta_is_inhibited ())
9866 {
9867 switch (ffesta_first_kw)
9868 {
9869 case FFESTR_firstBACKSPACE:
9870 ffestc_R919 ();
9871 break;
9872
9873 case FFESTR_firstENDFILE:
9874 case FFESTR_firstEND:
9875 ffestc_R920 ();
9876 break;
9877
9878 case FFESTR_firstREWIND:
9879 ffestc_R921 ();
9880 break;
9881
9882 default:
9883 assert (FALSE);
9884 }
9885 }
9886 ffestb_subr_kill_beru_ ();
9887 return (ffelexHandler) ffesta_zero (t);
9888
9889 default:
9890 break;
9891 }
9892
9893 ffestb_subr_kill_beru_ ();
9894 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
9895 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
9896 }
9897
9898 /* ffestb_beru2_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN
9899
9900 return ffestb_beru2_; // to lexer
9901
9902 Handle expr construct (not NAME=expr construct) here. */
9903
9904 static ffelexHandler
9905 ffestb_beru2_ (ffelexToken t)
9906 {
9907 ffelexToken nt;
9908 ffelexHandler next;
9909
9910 switch (ffelex_token_type (t))
9911 {
9912 case FFELEX_typeNAME:
9913 ffesta_tokens[2] = ffelex_token_use (t);
9914 return (ffelexHandler) ffestb_beru3_;
9915
9916 default:
9917 nt = ffesta_tokens[1];
9918 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
9919 FFEEXPR_contextFILENUMAMBIG, (ffeexprCallback) ffestb_beru4_)))
9920 (nt);
9921 ffelex_token_kill (nt);
9922 return (ffelexHandler) (*next) (t);
9923 }
9924 }
9925
9926 /* ffestb_beru3_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN NAME
9927
9928 return ffestb_beru3_; // to lexer
9929
9930 If EQUALS here, go to states that handle it. Else, send NAME and this
9931 token thru expression handler. */
9932
9933 static ffelexHandler
9934 ffestb_beru3_ (ffelexToken t)
9935 {
9936 ffelexHandler next;
9937 ffelexToken nt;
9938 ffelexToken ot;
9939
9940 switch (ffelex_token_type (t))
9941 {
9942 case FFELEX_typeEQUALS:
9943 ffelex_token_kill (ffesta_tokens[1]);
9944 nt = ffesta_tokens[2];
9945 next = (ffelexHandler) ffestb_beru5_ (nt);
9946 ffelex_token_kill (nt);
9947 return (ffelexHandler) (*next) (t);
9948
9949 default:
9950 nt = ffesta_tokens[1];
9951 ot = ffesta_tokens[2];
9952 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
9953 FFEEXPR_contextFILENUMAMBIG, (ffeexprCallback) ffestb_beru4_)))
9954 (nt);
9955 ffelex_token_kill (nt);
9956 next = (ffelexHandler) (*next) (ot);
9957 ffelex_token_kill (ot);
9958 return (ffelexHandler) (*next) (t);
9959 }
9960 }
9961
9962 /* ffestb_beru4_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN expr [CLOSE_PAREN]
9963
9964 (ffestb_beru4_) // to expression handler
9965
9966 Handle COMMA or EOS/SEMICOLON here.
9967
9968 15-Feb-91 JCB 1.2
9969 Now using new mechanism whereby expr comes back as opITEM if the
9970 expr is considered part (or all) of an I/O control list (and should
9971 be stripped of its outer opITEM node) or not if it is considered
9972 a plain unit number that happens to have been enclosed in parens.
9973 26-Mar-90 JCB 1.1
9974 No longer expecting close-paren here because of constructs like
9975 BACKSPACE (5)+2, so now expecting either COMMA because it was a
9976 construct like BACKSPACE (5+2,... or EOS/SEMICOLON because it is like
9977 the former construct. Ah, the vagaries of Fortran. */
9978
9979 static ffelexHandler
9980 ffestb_beru4_ (ffelexToken ft, ffebld expr, ffelexToken t)
9981 {
9982 bool inlist;
9983
9984 switch (ffelex_token_type (t))
9985 {
9986 case FFELEX_typeCOMMA:
9987 case FFELEX_typeEOS:
9988 case FFELEX_typeSEMICOLON:
9989 case FFELEX_typeCLOSE_PAREN:
9990 if (expr == NULL)
9991 break;
9992 if (ffebld_op (expr) == FFEBLD_opITEM)
9993 {
9994 inlist = TRUE;
9995 expr = ffebld_head (expr);
9996 }
9997 else
9998 inlist = FALSE;
9999 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_or_val_present
10000 = TRUE;
10001 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_present = FALSE;
10002 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_present = TRUE;
10003 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_is_label
10004 = FALSE;
10005 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value
10006 = ffelex_token_use (ft);
10007 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].u.expr = expr;
10008 if (inlist)
10009 return (ffelexHandler) ffestb_beru9_ (t);
10010 return (ffelexHandler) ffestb_beru10_ (t);
10011
10012 default:
10013 break;
10014 }
10015
10016 ffestb_subr_kill_beru_ ();
10017 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
10018 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
10019 }
10020
10021 /* ffestb_beru5_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN [external-file-unit
10022 COMMA]
10023
10024 return ffestb_beru5_; // to lexer
10025
10026 Handle expr construct (not NAME=expr construct) here. */
10027
10028 static ffelexHandler
10029 ffestb_beru5_ (ffelexToken t)
10030 {
10031 ffestrGenio kw;
10032
10033 ffestb_local_.beru.label = FALSE;
10034
10035 switch (ffelex_token_type (t))
10036 {
10037 case FFELEX_typeNAME:
10038 kw = ffestr_genio (t);
10039 switch (kw)
10040 {
10041 case FFESTR_genioERR:
10042 ffestb_local_.beru.ix = FFESTP_beruixERR;
10043 ffestb_local_.beru.label = TRUE;
10044 break;
10045
10046 case FFESTR_genioIOSTAT:
10047 ffestb_local_.beru.ix = FFESTP_beruixIOSTAT;
10048 ffestb_local_.beru.left = TRUE;
10049 ffestb_local_.beru.context = FFEEXPR_contextFILEINT;
10050 break;
10051
10052 case FFESTR_genioUNIT:
10053 ffestb_local_.beru.ix = FFESTP_beruixUNIT;
10054 ffestb_local_.beru.left = FALSE;
10055 ffestb_local_.beru.context = FFEEXPR_contextFILENUM;
10056 break;
10057
10058 default:
10059 goto bad; /* :::::::::::::::::::: */
10060 }
10061 if (ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
10062 .kw_or_val_present)
10063 break; /* Can't specify a keyword twice! */
10064 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
10065 .kw_or_val_present = TRUE;
10066 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
10067 .kw_present = TRUE;
10068 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
10069 .value_present = FALSE;
10070 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value_is_label
10071 = ffestb_local_.beru.label;
10072 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].kw
10073 = ffelex_token_use (t);
10074 return (ffelexHandler) ffestb_beru6_;
10075
10076 default:
10077 break;
10078 }
10079
10080 bad: /* :::::::::::::::::::: */
10081 ffestb_subr_kill_beru_ ();
10082 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
10083 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
10084 }
10085
10086 /* ffestb_beru6_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN [external-file-unit
10087 COMMA] NAME
10088
10089 return ffestb_beru6_; // to lexer
10090
10091 Make sure EQUALS here, send next token to expression handler. */
10092
10093 static ffelexHandler
10094 ffestb_beru6_ (ffelexToken t)
10095 {
10096
10097 switch (ffelex_token_type (t))
10098 {
10099 case FFELEX_typeEQUALS:
10100 ffesta_confirmed ();
10101 if (ffestb_local_.beru.label)
10102 return (ffelexHandler) ffestb_beru8_;
10103 if (ffestb_local_.beru.left)
10104 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
10105 ffestb_local_.beru.context,
10106 (ffeexprCallback) ffestb_beru7_);
10107 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
10108 ffestb_local_.beru.context,
10109 (ffeexprCallback) ffestb_beru7_);
10110
10111 default:
10112 break;
10113 }
10114
10115 ffestb_subr_kill_beru_ ();
10116 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
10117 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
10118 }
10119
10120 /* ffestb_beru7_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... NAME EQUALS expr
10121
10122 (ffestb_beru7_) // to expression handler
10123
10124 Handle COMMA or CLOSE_PAREN here. */
10125
10126 static ffelexHandler
10127 ffestb_beru7_ (ffelexToken ft, ffebld expr, ffelexToken t)
10128 {
10129 switch (ffelex_token_type (t))
10130 {
10131 case FFELEX_typeCOMMA:
10132 case FFELEX_typeCLOSE_PAREN:
10133 if (expr == NULL)
10134 break;
10135 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value_present
10136 = TRUE;
10137 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value
10138 = ffelex_token_use (ft);
10139 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].u.expr = expr;
10140 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
10141 return (ffelexHandler) ffestb_beru5_;
10142 return (ffelexHandler) ffestb_beru10_;
10143
10144 default:
10145 break;
10146 }
10147
10148 ffestb_subr_kill_beru_ ();
10149 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
10150 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
10151 }
10152
10153 /* ffestb_beru8_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... NAME EQUALS
10154
10155 return ffestb_beru8_; // to lexer
10156
10157 Handle NUMBER for label here. */
10158
10159 static ffelexHandler
10160 ffestb_beru8_ (ffelexToken t)
10161 {
10162 switch (ffelex_token_type (t))
10163 {
10164 case FFELEX_typeNUMBER:
10165 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value_present
10166 = TRUE;
10167 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value
10168 = ffelex_token_use (t);
10169 return (ffelexHandler) ffestb_beru9_;
10170
10171 default:
10172 break;
10173 }
10174
10175 ffestb_subr_kill_beru_ ();
10176 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
10177 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
10178 }
10179
10180 /* ffestb_beru9_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... NAME EQUALS
10181 NUMBER
10182
10183 return ffestb_beru9_; // to lexer
10184
10185 Handle COMMA or CLOSE_PAREN here. */
10186
10187 static ffelexHandler
10188 ffestb_beru9_ (ffelexToken t)
10189 {
10190 switch (ffelex_token_type (t))
10191 {
10192 case FFELEX_typeCOMMA:
10193 return (ffelexHandler) ffestb_beru5_;
10194
10195 case FFELEX_typeCLOSE_PAREN:
10196 return (ffelexHandler) ffestb_beru10_;
10197
10198 default:
10199 break;
10200 }
10201
10202 ffestb_subr_kill_beru_ ();
10203 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
10204 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
10205 }
10206
10207 /* ffestb_beru10_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... CLOSE_PAREN
10208
10209 return ffestb_beru10_; // to lexer
10210
10211 Handle EOS or SEMICOLON here. */
10212
10213 static ffelexHandler
10214 ffestb_beru10_ (ffelexToken t)
10215 {
10216 switch (ffelex_token_type (t))
10217 {
10218 case FFELEX_typeEOS:
10219 case FFELEX_typeSEMICOLON:
10220 ffesta_confirmed ();
10221 if (!ffesta_is_inhibited ())
10222 {
10223 switch (ffesta_first_kw)
10224 {
10225 case FFESTR_firstBACKSPACE:
10226 ffestc_R919 ();
10227 break;
10228
10229 case FFESTR_firstENDFILE:
10230 case FFESTR_firstEND:
10231 ffestc_R920 ();
10232 break;
10233
10234 case FFESTR_firstREWIND:
10235 ffestc_R921 ();
10236 break;
10237
10238 default:
10239 assert (FALSE);
10240 }
10241 }
10242 ffestb_subr_kill_beru_ ();
10243 return (ffelexHandler) ffesta_zero (t);
10244
10245 default:
10246 break;
10247 }
10248
10249 ffestb_subr_kill_beru_ ();
10250 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
10251 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
10252 }
10253
10254 /* ffestb_R904 -- Parse an OPEN statement
10255
10256 return ffestb_R904; // to lexer
10257
10258 Make sure the statement has a valid form for an OPEN statement.
10259 If it does, implement the statement. */
10260
10261 ffelexHandler
10262 ffestb_R904 (ffelexToken t)
10263 {
10264 ffestpOpenIx ix;
10265
10266 switch (ffelex_token_type (ffesta_tokens[0]))
10267 {
10268 case FFELEX_typeNAME:
10269 if (ffesta_first_kw != FFESTR_firstOPEN)
10270 goto bad_0; /* :::::::::::::::::::: */
10271 break;
10272
10273 case FFELEX_typeNAMES:
10274 if (ffesta_first_kw != FFESTR_firstOPEN)
10275 goto bad_0; /* :::::::::::::::::::: */
10276 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlOPEN)
10277 goto bad_0; /* :::::::::::::::::::: */
10278 break;
10279
10280 default:
10281 goto bad_0; /* :::::::::::::::::::: */
10282 }
10283
10284 switch (ffelex_token_type (t))
10285 {
10286 case FFELEX_typeOPEN_PAREN:
10287 break;
10288
10289 case FFELEX_typeEOS:
10290 case FFELEX_typeSEMICOLON:
10291 case FFELEX_typeCOMMA:
10292 case FFELEX_typeCOLONCOLON:
10293 ffesta_confirmed (); /* Error, but clearly intended. */
10294 goto bad_1; /* :::::::::::::::::::: */
10295
10296 default:
10297 goto bad_1; /* :::::::::::::::::::: */
10298 }
10299
10300 for (ix = 0; ix < FFESTP_openix; ++ix)
10301 ffestp_file.open.open_spec[ix].kw_or_val_present = FALSE;
10302
10303 return (ffelexHandler) ffestb_R9041_;
10304
10305 bad_0: /* :::::::::::::::::::: */
10306 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", ffesta_tokens[0]);
10307 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
10308
10309 bad_1: /* :::::::::::::::::::: */
10310 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
10311 return (ffelexHandler) ffelex_swallow_tokens (t,
10312 (ffelexHandler) ffesta_zero); /* Invalid second token. */
10313 }
10314
10315 /* ffestb_R9041_ -- "OPEN" OPEN_PAREN
10316
10317 return ffestb_R9041_; // to lexer
10318
10319 Handle expr construct (not NAME=expr construct) here. */
10320
10321 static ffelexHandler
10322 ffestb_R9041_ (ffelexToken t)
10323 {
10324 switch (ffelex_token_type (t))
10325 {
10326 case FFELEX_typeNAME:
10327 ffesta_tokens[1] = ffelex_token_use (t);
10328 return (ffelexHandler) ffestb_R9042_;
10329
10330 default:
10331 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
10332 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9043_)))
10333 (t);
10334 }
10335 }
10336
10337 /* ffestb_R9042_ -- "OPEN" OPEN_PAREN NAME
10338
10339 return ffestb_R9042_; // to lexer
10340
10341 If EQUALS here, go to states that handle it. Else, send NAME and this
10342 token thru expression handler. */
10343
10344 static ffelexHandler
10345 ffestb_R9042_ (ffelexToken t)
10346 {
10347 ffelexHandler next;
10348 ffelexToken nt;
10349
10350 switch (ffelex_token_type (t))
10351 {
10352 case FFELEX_typeEQUALS:
10353 nt = ffesta_tokens[1];
10354 next = (ffelexHandler) ffestb_R9044_ (nt);
10355 ffelex_token_kill (nt);
10356 return (ffelexHandler) (*next) (t);
10357
10358 default:
10359 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
10360 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9043_)))
10361 (ffesta_tokens[1]);
10362 ffelex_token_kill (ffesta_tokens[1]);
10363 return (ffelexHandler) (*next) (t);
10364 }
10365 }
10366
10367 /* ffestb_R9043_ -- "OPEN" OPEN_PAREN expr
10368
10369 (ffestb_R9043_) // to expression handler
10370
10371 Handle COMMA or CLOSE_PAREN here. */
10372
10373 static ffelexHandler
10374 ffestb_R9043_ (ffelexToken ft, ffebld expr, ffelexToken t)
10375 {
10376 switch (ffelex_token_type (t))
10377 {
10378 case FFELEX_typeCOMMA:
10379 case FFELEX_typeCLOSE_PAREN:
10380 if (expr == NULL)
10381 break;
10382 ffestp_file.open.open_spec[FFESTP_openixUNIT].kw_or_val_present
10383 = TRUE;
10384 ffestp_file.open.open_spec[FFESTP_openixUNIT].kw_present = FALSE;
10385 ffestp_file.open.open_spec[FFESTP_openixUNIT].value_present = TRUE;
10386 ffestp_file.open.open_spec[FFESTP_openixUNIT].value_is_label
10387 = FALSE;
10388 ffestp_file.open.open_spec[FFESTP_openixUNIT].value
10389 = ffelex_token_use (ft);
10390 ffestp_file.open.open_spec[FFESTP_openixUNIT].u.expr = expr;
10391 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
10392 return (ffelexHandler) ffestb_R9044_;
10393 return (ffelexHandler) ffestb_R9049_;
10394
10395 default:
10396 break;
10397 }
10398
10399 ffestb_subr_kill_open_ ();
10400 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
10401 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
10402 }
10403
10404 /* ffestb_R9044_ -- "OPEN" OPEN_PAREN [external-file-unit COMMA]
10405
10406 return ffestb_R9044_; // to lexer
10407
10408 Handle expr construct (not NAME=expr construct) here. */
10409
10410 static ffelexHandler
10411 ffestb_R9044_ (ffelexToken t)
10412 {
10413 ffestrOpen kw;
10414
10415 ffestb_local_.open.label = FALSE;
10416
10417 switch (ffelex_token_type (t))
10418 {
10419 case FFELEX_typeNAME:
10420 kw = ffestr_open (t);
10421 switch (kw)
10422 {
10423 case FFESTR_openACCESS:
10424 ffestb_local_.open.ix = FFESTP_openixACCESS;
10425 ffestb_local_.open.left = FALSE;
10426 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
10427 break;
10428
10429 case FFESTR_openACTION:
10430 ffestb_local_.open.ix = FFESTP_openixACTION;
10431 ffestb_local_.open.left = FALSE;
10432 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
10433 break;
10434
10435 case FFESTR_openASSOCIATEVARIABLE:
10436 ffestb_local_.open.ix = FFESTP_openixASSOCIATEVARIABLE;
10437 ffestb_local_.open.left = TRUE;
10438 ffestb_local_.open.context = FFEEXPR_contextFILEASSOC;
10439 break;
10440
10441 case FFESTR_openBLANK:
10442 ffestb_local_.open.ix = FFESTP_openixBLANK;
10443 ffestb_local_.open.left = FALSE;
10444 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
10445 break;
10446
10447 case FFESTR_openBLOCKSIZE:
10448 ffestb_local_.open.ix = FFESTP_openixBLOCKSIZE;
10449 ffestb_local_.open.left = FALSE;
10450 ffestb_local_.open.context = FFEEXPR_contextFILENUM;
10451 break;
10452
10453 case FFESTR_openBUFFERCOUNT:
10454 ffestb_local_.open.ix = FFESTP_openixBUFFERCOUNT;
10455 ffestb_local_.open.left = FALSE;
10456 ffestb_local_.open.context = FFEEXPR_contextFILENUM;
10457 break;
10458
10459 case FFESTR_openCARRIAGECONTROL:
10460 ffestb_local_.open.ix = FFESTP_openixCARRIAGECONTROL;
10461 ffestb_local_.open.left = FALSE;
10462 ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
10463 break;
10464
10465 case FFESTR_openDEFAULTFILE:
10466 ffestb_local_.open.ix = FFESTP_openixDEFAULTFILE;
10467 ffestb_local_.open.left = FALSE;
10468 ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
10469 break;
10470
10471 case FFESTR_openDELIM:
10472 ffestb_local_.open.ix = FFESTP_openixDELIM;
10473 ffestb_local_.open.left = FALSE;
10474 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
10475 break;
10476
10477 case FFESTR_openDISP:
10478 case FFESTR_openDISPOSE:
10479 ffestb_local_.open.ix = FFESTP_openixDISPOSE;
10480 ffestb_local_.open.left = FALSE;
10481 ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
10482 break;
10483
10484 case FFESTR_openERR:
10485 ffestb_local_.open.ix = FFESTP_openixERR;
10486 ffestb_local_.open.label = TRUE;
10487 break;
10488
10489 case FFESTR_openEXTENDSIZE:
10490 ffestb_local_.open.ix = FFESTP_openixEXTENDSIZE;
10491 ffestb_local_.open.left = FALSE;
10492 ffestb_local_.open.context = FFEEXPR_contextFILENUM;
10493 break;
10494
10495 case FFESTR_openFILE:
10496 case FFESTR_openNAME:
10497 ffestb_local_.open.ix = FFESTP_openixFILE;
10498 ffestb_local_.open.left = FALSE;
10499 ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
10500 break;
10501
10502 case FFESTR_openFORM:
10503 ffestb_local_.open.ix = FFESTP_openixFORM;
10504 ffestb_local_.open.left = FALSE;
10505 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
10506 break;
10507
10508 case FFESTR_openINITIALSIZE:
10509 ffestb_local_.open.ix = FFESTP_openixINITIALSIZE;
10510 ffestb_local_.open.left = FALSE;
10511 ffestb_local_.open.context = FFEEXPR_contextFILENUM;
10512 break;
10513
10514 case FFESTR_openIOSTAT:
10515 ffestb_local_.open.ix = FFESTP_openixIOSTAT;
10516 ffestb_local_.open.left = TRUE;
10517 ffestb_local_.open.context = FFEEXPR_contextFILEINT;
10518 break;
10519
10520 #if 0 /* Haven't added support for expression
10521 context yet (though easy). */
10522 case FFESTR_openKEY:
10523 ffestb_local_.open.ix = FFESTP_openixKEY;
10524 ffestb_local_.open.left = FALSE;
10525 ffestb_local_.open.context = FFEEXPR_contextFILEKEY;
10526 break;
10527 #endif
10528
10529 case FFESTR_openMAXREC:
10530 ffestb_local_.open.ix = FFESTP_openixMAXREC;
10531 ffestb_local_.open.left = FALSE;
10532 ffestb_local_.open.context = FFEEXPR_contextFILENUM;
10533 break;
10534
10535 case FFESTR_openNOSPANBLOCKS:
10536 if (ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
10537 .kw_or_val_present)
10538 goto bad; /* :::::::::::::::::::: */
10539 ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
10540 .kw_or_val_present = TRUE;
10541 ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
10542 .kw_present = TRUE;
10543 ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
10544 .value_present = FALSE;
10545 ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS].kw
10546 = ffelex_token_use (t);
10547 return (ffelexHandler) ffestb_R9048_;
10548
10549 case FFESTR_openORGANIZATION:
10550 ffestb_local_.open.ix = FFESTP_openixORGANIZATION;
10551 ffestb_local_.open.left = FALSE;
10552 ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
10553 break;
10554
10555 case FFESTR_openPAD:
10556 ffestb_local_.open.ix = FFESTP_openixPAD;
10557 ffestb_local_.open.left = FALSE;
10558 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
10559 break;
10560
10561 case FFESTR_openPOSITION:
10562 ffestb_local_.open.ix = FFESTP_openixPOSITION;
10563 ffestb_local_.open.left = FALSE;
10564 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
10565 break;
10566
10567 case FFESTR_openREADONLY:
10568 if (ffestp_file.open.open_spec[FFESTP_openixREADONLY]
10569 .kw_or_val_present)
10570 goto bad; /* :::::::::::::::::::: */
10571 ffestp_file.open.open_spec[FFESTP_openixREADONLY]
10572 .kw_or_val_present = TRUE;
10573 ffestp_file.open.open_spec[FFESTP_openixREADONLY]
10574 .kw_present = TRUE;
10575 ffestp_file.open.open_spec[FFESTP_openixREADONLY]
10576 .value_present = FALSE;
10577 ffestp_file.open.open_spec[FFESTP_openixREADONLY].kw
10578 = ffelex_token_use (t);
10579 return (ffelexHandler) ffestb_R9048_;
10580
10581 case FFESTR_openRECL:
10582 case FFESTR_openRECORDSIZE:
10583 ffestb_local_.open.ix = FFESTP_openixRECL;
10584 ffestb_local_.open.left = FALSE;
10585 ffestb_local_.open.context = FFEEXPR_contextFILENUM;
10586 break;
10587
10588 case FFESTR_openRECORDTYPE:
10589 ffestb_local_.open.ix = FFESTP_openixRECORDTYPE;
10590 ffestb_local_.open.left = FALSE;
10591 ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
10592 break;
10593
10594 case FFESTR_openSHARED:
10595 if (ffestp_file.open.open_spec[FFESTP_openixSHARED]
10596 .kw_or_val_present)
10597 goto bad; /* :::::::::::::::::::: */
10598 ffestp_file.open.open_spec[FFESTP_openixSHARED]
10599 .kw_or_val_present = TRUE;
10600 ffestp_file.open.open_spec[FFESTP_openixSHARED]
10601 .kw_present = TRUE;
10602 ffestp_file.open.open_spec[FFESTP_openixSHARED]
10603 .value_present = FALSE;
10604 ffestp_file.open.open_spec[FFESTP_openixSHARED].kw
10605 = ffelex_token_use (t);
10606 return (ffelexHandler) ffestb_R9048_;
10607
10608 case FFESTR_openSTATUS:
10609 case FFESTR_openTYPE:
10610 ffestb_local_.open.ix = FFESTP_openixSTATUS;
10611 ffestb_local_.open.left = FALSE;
10612 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
10613 break;
10614
10615 case FFESTR_openUNIT:
10616 ffestb_local_.open.ix = FFESTP_openixUNIT;
10617 ffestb_local_.open.left = FALSE;
10618 ffestb_local_.open.context = FFEEXPR_contextFILENUM;
10619 break;
10620
10621 case FFESTR_openUSEROPEN:
10622 ffestb_local_.open.ix = FFESTP_openixUSEROPEN;
10623 ffestb_local_.open.left = TRUE;
10624 ffestb_local_.open.context = FFEEXPR_contextFILEEXTFUNC;
10625 break;
10626
10627 default:
10628 goto bad; /* :::::::::::::::::::: */
10629 }
10630 if (ffestp_file.open.open_spec[ffestb_local_.open.ix]
10631 .kw_or_val_present)
10632 break; /* Can't specify a keyword twice! */
10633 ffestp_file.open.open_spec[ffestb_local_.open.ix]
10634 .kw_or_val_present = TRUE;
10635 ffestp_file.open.open_spec[ffestb_local_.open.ix]
10636 .kw_present = TRUE;
10637 ffestp_file.open.open_spec[ffestb_local_.open.ix]
10638 .value_present = FALSE;
10639 ffestp_file.open.open_spec[ffestb_local_.open.ix].value_is_label
10640 = ffestb_local_.open.label;
10641 ffestp_file.open.open_spec[ffestb_local_.open.ix].kw
10642 = ffelex_token_use (t);
10643 return (ffelexHandler) ffestb_R9045_;
10644
10645 default:
10646 break;
10647 }
10648
10649 bad: /* :::::::::::::::::::: */
10650 ffestb_subr_kill_open_ ();
10651 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
10652 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
10653 }
10654
10655 /* ffestb_R9045_ -- "OPEN" OPEN_PAREN [external-file-unit COMMA] NAME
10656
10657 return ffestb_R9045_; // to lexer
10658
10659 Make sure EQUALS here, send next token to expression handler. */
10660
10661 static ffelexHandler
10662 ffestb_R9045_ (ffelexToken t)
10663 {
10664 switch (ffelex_token_type (t))
10665 {
10666 case FFELEX_typeEQUALS:
10667 ffesta_confirmed ();
10668 if (ffestb_local_.open.label)
10669 return (ffelexHandler) ffestb_R9047_;
10670 if (ffestb_local_.open.left)
10671 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
10672 ffestb_local_.open.context,
10673 (ffeexprCallback) ffestb_R9046_);
10674 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
10675 ffestb_local_.open.context,
10676 (ffeexprCallback) ffestb_R9046_);
10677
10678 default:
10679 break;
10680 }
10681
10682 ffestb_subr_kill_open_ ();
10683 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
10684 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
10685 }
10686
10687 /* ffestb_R9046_ -- "OPEN" OPEN_PAREN ... NAME EQUALS expr
10688
10689 (ffestb_R9046_) // to expression handler
10690
10691 Handle COMMA or CLOSE_PAREN here. */
10692
10693 static ffelexHandler
10694 ffestb_R9046_ (ffelexToken ft, ffebld expr, ffelexToken t)
10695 {
10696 switch (ffelex_token_type (t))
10697 {
10698 case FFELEX_typeCOMMA:
10699 case FFELEX_typeCLOSE_PAREN:
10700 if (expr == NULL)
10701 break;
10702 ffestp_file.open.open_spec[ffestb_local_.open.ix].value_present
10703 = TRUE;
10704 ffestp_file.open.open_spec[ffestb_local_.open.ix].value
10705 = ffelex_token_use (ft);
10706 ffestp_file.open.open_spec[ffestb_local_.open.ix].u.expr = expr;
10707 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
10708 return (ffelexHandler) ffestb_R9044_;
10709 return (ffelexHandler) ffestb_R9049_;
10710
10711 default:
10712 break;
10713 }
10714
10715 ffestb_subr_kill_open_ ();
10716 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
10717 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
10718 }
10719
10720 /* ffestb_R9047_ -- "OPEN" OPEN_PAREN ... NAME EQUALS
10721
10722 return ffestb_R9047_; // to lexer
10723
10724 Handle NUMBER for label here. */
10725
10726 static ffelexHandler
10727 ffestb_R9047_ (ffelexToken t)
10728 {
10729 switch (ffelex_token_type (t))
10730 {
10731 case FFELEX_typeNUMBER:
10732 ffestp_file.open.open_spec[ffestb_local_.open.ix].value_present
10733 = TRUE;
10734 ffestp_file.open.open_spec[ffestb_local_.open.ix].value
10735 = ffelex_token_use (t);
10736 return (ffelexHandler) ffestb_R9048_;
10737
10738 default:
10739 break;
10740 }
10741
10742 ffestb_subr_kill_open_ ();
10743 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
10744 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
10745 }
10746
10747 /* ffestb_R9048_ -- "OPEN" OPEN_PAREN ... NAME EQUALS NUMBER
10748
10749 return ffestb_R9048_; // to lexer
10750
10751 Handle COMMA or CLOSE_PAREN here. */
10752
10753 static ffelexHandler
10754 ffestb_R9048_ (ffelexToken t)
10755 {
10756 switch (ffelex_token_type (t))
10757 {
10758 case FFELEX_typeCOMMA:
10759 return (ffelexHandler) ffestb_R9044_;
10760
10761 case FFELEX_typeCLOSE_PAREN:
10762 return (ffelexHandler) ffestb_R9049_;
10763
10764 default:
10765 break;
10766 }
10767
10768 ffestb_subr_kill_open_ ();
10769 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
10770 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
10771 }
10772
10773 /* ffestb_R9049_ -- "OPEN" OPEN_PAREN ... CLOSE_PAREN
10774
10775 return ffestb_R9049_; // to lexer
10776
10777 Handle EOS or SEMICOLON here. */
10778
10779 static ffelexHandler
10780 ffestb_R9049_ (ffelexToken t)
10781 {
10782 switch (ffelex_token_type (t))
10783 {
10784 case FFELEX_typeEOS:
10785 case FFELEX_typeSEMICOLON:
10786 ffesta_confirmed ();
10787 if (!ffesta_is_inhibited ())
10788 ffestc_R904 ();
10789 ffestb_subr_kill_open_ ();
10790 return (ffelexHandler) ffesta_zero (t);
10791
10792 default:
10793 break;
10794 }
10795
10796 ffestb_subr_kill_open_ ();
10797 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
10798 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
10799 }
10800
10801 /* ffestb_R907 -- Parse a CLOSE statement
10802
10803 return ffestb_R907; // to lexer
10804
10805 Make sure the statement has a valid form for a CLOSE statement.
10806 If it does, implement the statement. */
10807
10808 ffelexHandler
10809 ffestb_R907 (ffelexToken t)
10810 {
10811 ffestpCloseIx ix;
10812
10813 switch (ffelex_token_type (ffesta_tokens[0]))
10814 {
10815 case FFELEX_typeNAME:
10816 if (ffesta_first_kw != FFESTR_firstCLOSE)
10817 goto bad_0; /* :::::::::::::::::::: */
10818 break;
10819
10820 case FFELEX_typeNAMES:
10821 if (ffesta_first_kw != FFESTR_firstCLOSE)
10822 goto bad_0; /* :::::::::::::::::::: */
10823 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlCLOSE)
10824 goto bad_0; /* :::::::::::::::::::: */
10825 break;
10826
10827 default:
10828 goto bad_0; /* :::::::::::::::::::: */
10829 }
10830
10831 switch (ffelex_token_type (t))
10832 {
10833 case FFELEX_typeOPEN_PAREN:
10834 break;
10835
10836 case FFELEX_typeEOS:
10837 case FFELEX_typeSEMICOLON:
10838 case FFELEX_typeCOMMA:
10839 case FFELEX_typeCOLONCOLON:
10840 ffesta_confirmed (); /* Error, but clearly intended. */
10841 goto bad_1; /* :::::::::::::::::::: */
10842
10843 default:
10844 goto bad_1; /* :::::::::::::::::::: */
10845 }
10846
10847 for (ix = 0; ix < FFESTP_closeix; ++ix)
10848 ffestp_file.close.close_spec[ix].kw_or_val_present = FALSE;
10849
10850 return (ffelexHandler) ffestb_R9071_;
10851
10852 bad_0: /* :::::::::::::::::::: */
10853 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", ffesta_tokens[0]);
10854 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
10855
10856 bad_1: /* :::::::::::::::::::: */
10857 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
10858 return (ffelexHandler) ffelex_swallow_tokens (t,
10859 (ffelexHandler) ffesta_zero); /* Invalid second token. */
10860 }
10861
10862 /* ffestb_R9071_ -- "CLOSE" OPEN_PAREN
10863
10864 return ffestb_R9071_; // to lexer
10865
10866 Handle expr construct (not NAME=expr construct) here. */
10867
10868 static ffelexHandler
10869 ffestb_R9071_ (ffelexToken t)
10870 {
10871 switch (ffelex_token_type (t))
10872 {
10873 case FFELEX_typeNAME:
10874 ffesta_tokens[1] = ffelex_token_use (t);
10875 return (ffelexHandler) ffestb_R9072_;
10876
10877 default:
10878 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
10879 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9073_)))
10880 (t);
10881 }
10882 }
10883
10884 /* ffestb_R9072_ -- "CLOSE" OPEN_PAREN NAME
10885
10886 return ffestb_R9072_; // to lexer
10887
10888 If EQUALS here, go to states that handle it. Else, send NAME and this
10889 token thru expression handler. */
10890
10891 static ffelexHandler
10892 ffestb_R9072_ (ffelexToken t)
10893 {
10894 ffelexHandler next;
10895 ffelexToken nt;
10896
10897 switch (ffelex_token_type (t))
10898 {
10899 case FFELEX_typeEQUALS:
10900 nt = ffesta_tokens[1];
10901 next = (ffelexHandler) ffestb_R9074_ (nt);
10902 ffelex_token_kill (nt);
10903 return (ffelexHandler) (*next) (t);
10904
10905 default:
10906 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
10907 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9073_)))
10908 (ffesta_tokens[1]);
10909 ffelex_token_kill (ffesta_tokens[1]);
10910 return (ffelexHandler) (*next) (t);
10911 }
10912 }
10913
10914 /* ffestb_R9073_ -- "CLOSE" OPEN_PAREN expr
10915
10916 (ffestb_R9073_) // to expression handler
10917
10918 Handle COMMA or CLOSE_PAREN here. */
10919
10920 static ffelexHandler
10921 ffestb_R9073_ (ffelexToken ft, ffebld expr, ffelexToken t)
10922 {
10923 switch (ffelex_token_type (t))
10924 {
10925 case FFELEX_typeCOMMA:
10926 case FFELEX_typeCLOSE_PAREN:
10927 if (expr == NULL)
10928 break;
10929 ffestp_file.close.close_spec[FFESTP_closeixUNIT].kw_or_val_present
10930 = TRUE;
10931 ffestp_file.close.close_spec[FFESTP_closeixUNIT].kw_present = FALSE;
10932 ffestp_file.close.close_spec[FFESTP_closeixUNIT].value_present = TRUE;
10933 ffestp_file.close.close_spec[FFESTP_closeixUNIT].value_is_label
10934 = FALSE;
10935 ffestp_file.close.close_spec[FFESTP_closeixUNIT].value
10936 = ffelex_token_use (ft);
10937 ffestp_file.close.close_spec[FFESTP_closeixUNIT].u.expr = expr;
10938 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
10939 return (ffelexHandler) ffestb_R9074_;
10940 return (ffelexHandler) ffestb_R9079_;
10941
10942 default:
10943 break;
10944 }
10945
10946 ffestb_subr_kill_close_ ();
10947 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
10948 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
10949 }
10950
10951 /* ffestb_R9074_ -- "CLOSE" OPEN_PAREN [external-file-unit COMMA]
10952
10953 return ffestb_R9074_; // to lexer
10954
10955 Handle expr construct (not NAME=expr construct) here. */
10956
10957 static ffelexHandler
10958 ffestb_R9074_ (ffelexToken t)
10959 {
10960 ffestrGenio kw;
10961
10962 ffestb_local_.close.label = FALSE;
10963
10964 switch (ffelex_token_type (t))
10965 {
10966 case FFELEX_typeNAME:
10967 kw = ffestr_genio (t);
10968 switch (kw)
10969 {
10970 case FFESTR_genioERR:
10971 ffestb_local_.close.ix = FFESTP_closeixERR;
10972 ffestb_local_.close.label = TRUE;
10973 break;
10974
10975 case FFESTR_genioIOSTAT:
10976 ffestb_local_.close.ix = FFESTP_closeixIOSTAT;
10977 ffestb_local_.close.left = TRUE;
10978 ffestb_local_.close.context = FFEEXPR_contextFILEINT;
10979 break;
10980
10981 case FFESTR_genioSTATUS:
10982 case FFESTR_genioDISP:
10983 case FFESTR_genioDISPOSE:
10984 ffestb_local_.close.ix = FFESTP_closeixSTATUS;
10985 ffestb_local_.close.left = FALSE;
10986 ffestb_local_.close.context = FFEEXPR_contextFILEDFCHAR;
10987 break;
10988
10989 case FFESTR_genioUNIT:
10990 ffestb_local_.close.ix = FFESTP_closeixUNIT;
10991 ffestb_local_.close.left = FALSE;
10992 ffestb_local_.close.context = FFEEXPR_contextFILENUM;
10993 break;
10994
10995 default:
10996 goto bad; /* :::::::::::::::::::: */
10997 }
10998 if (ffestp_file.close.close_spec[ffestb_local_.close.ix]
10999 .kw_or_val_present)
11000 break; /* Can't specify a keyword twice! */
11001 ffestp_file.close.close_spec[ffestb_local_.close.ix]
11002 .kw_or_val_present = TRUE;
11003 ffestp_file.close.close_spec[ffestb_local_.close.ix]
11004 .kw_present = TRUE;
11005 ffestp_file.close.close_spec[ffestb_local_.close.ix]
11006 .value_present = FALSE;
11007 ffestp_file.close.close_spec[ffestb_local_.close.ix].value_is_label
11008 = ffestb_local_.close.label;
11009 ffestp_file.close.close_spec[ffestb_local_.close.ix].kw
11010 = ffelex_token_use (t);
11011 return (ffelexHandler) ffestb_R9075_;
11012
11013 default:
11014 break;
11015 }
11016
11017 bad: /* :::::::::::::::::::: */
11018 ffestb_subr_kill_close_ ();
11019 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
11020 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11021 }
11022
11023 /* ffestb_R9075_ -- "CLOSE" OPEN_PAREN [external-file-unit COMMA] NAME
11024
11025 return ffestb_R9075_; // to lexer
11026
11027 Make sure EQUALS here, send next token to expression handler. */
11028
11029 static ffelexHandler
11030 ffestb_R9075_ (ffelexToken t)
11031 {
11032 switch (ffelex_token_type (t))
11033 {
11034 case FFELEX_typeEQUALS:
11035 ffesta_confirmed ();
11036 if (ffestb_local_.close.label)
11037 return (ffelexHandler) ffestb_R9077_;
11038 if (ffestb_local_.close.left)
11039 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
11040 ffestb_local_.close.context,
11041 (ffeexprCallback) ffestb_R9076_);
11042 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
11043 ffestb_local_.close.context,
11044 (ffeexprCallback) ffestb_R9076_);
11045
11046 default:
11047 break;
11048 }
11049
11050 ffestb_subr_kill_close_ ();
11051 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
11052 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11053 }
11054
11055 /* ffestb_R9076_ -- "CLOSE" OPEN_PAREN ... NAME EQUALS expr
11056
11057 (ffestb_R9076_) // to expression handler
11058
11059 Handle COMMA or CLOSE_PAREN here. */
11060
11061 static ffelexHandler
11062 ffestb_R9076_ (ffelexToken ft, ffebld expr, ffelexToken t)
11063 {
11064 switch (ffelex_token_type (t))
11065 {
11066 case FFELEX_typeCOMMA:
11067 case FFELEX_typeCLOSE_PAREN:
11068 if (expr == NULL)
11069 break;
11070 ffestp_file.close.close_spec[ffestb_local_.close.ix].value_present
11071 = TRUE;
11072 ffestp_file.close.close_spec[ffestb_local_.close.ix].value
11073 = ffelex_token_use (ft);
11074 ffestp_file.close.close_spec[ffestb_local_.close.ix].u.expr = expr;
11075 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
11076 return (ffelexHandler) ffestb_R9074_;
11077 return (ffelexHandler) ffestb_R9079_;
11078
11079 default:
11080 break;
11081 }
11082
11083 ffestb_subr_kill_close_ ();
11084 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
11085 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11086 }
11087
11088 /* ffestb_R9077_ -- "CLOSE" OPEN_PAREN ... NAME EQUALS
11089
11090 return ffestb_R9077_; // to lexer
11091
11092 Handle NUMBER for label here. */
11093
11094 static ffelexHandler
11095 ffestb_R9077_ (ffelexToken t)
11096 {
11097 switch (ffelex_token_type (t))
11098 {
11099 case FFELEX_typeNUMBER:
11100 ffestp_file.close.close_spec[ffestb_local_.close.ix].value_present
11101 = TRUE;
11102 ffestp_file.close.close_spec[ffestb_local_.close.ix].value
11103 = ffelex_token_use (t);
11104 return (ffelexHandler) ffestb_R9078_;
11105
11106 default:
11107 break;
11108 }
11109
11110 ffestb_subr_kill_close_ ();
11111 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
11112 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11113 }
11114
11115 /* ffestb_R9078_ -- "CLOSE" OPEN_PAREN ... NAME EQUALS NUMBER
11116
11117 return ffestb_R9078_; // to lexer
11118
11119 Handle COMMA or CLOSE_PAREN here. */
11120
11121 static ffelexHandler
11122 ffestb_R9078_ (ffelexToken t)
11123 {
11124 switch (ffelex_token_type (t))
11125 {
11126 case FFELEX_typeCOMMA:
11127 return (ffelexHandler) ffestb_R9074_;
11128
11129 case FFELEX_typeCLOSE_PAREN:
11130 return (ffelexHandler) ffestb_R9079_;
11131
11132 default:
11133 break;
11134 }
11135
11136 ffestb_subr_kill_close_ ();
11137 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
11138 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11139 }
11140
11141 /* ffestb_R9079_ -- "CLOSE" OPEN_PAREN ... CLOSE_PAREN
11142
11143 return ffestb_R9079_; // to lexer
11144
11145 Handle EOS or SEMICOLON here. */
11146
11147 static ffelexHandler
11148 ffestb_R9079_ (ffelexToken t)
11149 {
11150 switch (ffelex_token_type (t))
11151 {
11152 case FFELEX_typeEOS:
11153 case FFELEX_typeSEMICOLON:
11154 ffesta_confirmed ();
11155 if (!ffesta_is_inhibited ())
11156 ffestc_R907 ();
11157 ffestb_subr_kill_close_ ();
11158 return (ffelexHandler) ffesta_zero (t);
11159
11160 default:
11161 break;
11162 }
11163
11164 ffestb_subr_kill_close_ ();
11165 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
11166 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11167 }
11168
11169 /* ffestb_R909 -- Parse the READ statement
11170
11171 return ffestb_R909; // to lexer
11172
11173 Make sure the statement has a valid form for the READ
11174 statement. If it does, implement the statement. */
11175
11176 ffelexHandler
11177 ffestb_R909 (ffelexToken t)
11178 {
11179 ffelexHandler next;
11180 ffestpReadIx ix;
11181
11182 switch (ffelex_token_type (ffesta_tokens[0]))
11183 {
11184 case FFELEX_typeNAME:
11185 if (ffesta_first_kw != FFESTR_firstREAD)
11186 goto bad_0; /* :::::::::::::::::::: */
11187 switch (ffelex_token_type (t))
11188 {
11189 case FFELEX_typeCOMMA:
11190 case FFELEX_typeCOLONCOLON:
11191 case FFELEX_typeEOS:
11192 case FFELEX_typeSEMICOLON:
11193 ffesta_confirmed (); /* Error, but clearly intended. */
11194 goto bad_1; /* :::::::::::::::::::: */
11195
11196 case FFELEX_typeEQUALS:
11197 case FFELEX_typePOINTS:
11198 case FFELEX_typeCOLON:
11199 goto bad_1; /* :::::::::::::::::::: */
11200
11201 case FFELEX_typeNAME:
11202 case FFELEX_typeNUMBER:
11203 ffesta_confirmed ();
11204 break;
11205
11206 case FFELEX_typeOPEN_PAREN:
11207 for (ix = 0; ix < FFESTP_readix; ++ix)
11208 ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
11209 ffesta_tokens[1] = ffelex_token_use (t);
11210 return (ffelexHandler) ffestb_R9092_;
11211
11212 default:
11213 break;
11214 }
11215
11216 for (ix = 0; ix < FFESTP_readix; ++ix)
11217 ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
11218 return (ffelexHandler) (*((ffelexHandler)
11219 ffeexpr_rhs (ffesta_output_pool,
11220 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9091_)))
11221 (t);
11222
11223 case FFELEX_typeNAMES:
11224 if (ffesta_first_kw != FFESTR_firstREAD)
11225 goto bad_0; /* :::::::::::::::::::: */
11226 switch (ffelex_token_type (t))
11227 {
11228 case FFELEX_typeEOS:
11229 case FFELEX_typeSEMICOLON:
11230 case FFELEX_typeCOMMA:
11231 ffesta_confirmed ();
11232 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlREAD)
11233 break;
11234 goto bad_1; /* :::::::::::::::::::: */
11235
11236 case FFELEX_typeCOLONCOLON:
11237 ffesta_confirmed (); /* Error, but clearly intended. */
11238 goto bad_1; /* :::::::::::::::::::: */
11239
11240 case FFELEX_typeEQUALS:
11241 case FFELEX_typePOINTS:
11242 case FFELEX_typeCOLON:
11243 goto bad_1; /* :::::::::::::::::::: */
11244
11245 case FFELEX_typeOPEN_PAREN:
11246 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlREAD)
11247 break;
11248
11249 for (ix = 0; ix < FFESTP_readix; ++ix)
11250 ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
11251 ffesta_tokens[1] = ffelex_token_use (t);
11252 return (ffelexHandler) ffestb_R9092_;
11253
11254 default:
11255 break;
11256 }
11257 for (ix = 0; ix < FFESTP_readix; ++ix)
11258 ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
11259 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
11260 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9091_);
11261 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
11262 FFESTR_firstlREAD);
11263 if (next == NULL)
11264 return (ffelexHandler) ffelex_swallow_tokens (t,
11265 (ffelexHandler) ffesta_zero);
11266 return (ffelexHandler) (*next) (t);
11267
11268 default:
11269 goto bad_0; /* :::::::::::::::::::: */
11270 }
11271
11272 bad_0: /* :::::::::::::::::::: */
11273 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", ffesta_tokens[0]);
11274 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11275
11276 bad_1: /* :::::::::::::::::::: */
11277 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
11278 return (ffelexHandler) ffelex_swallow_tokens (t,
11279 (ffelexHandler) ffesta_zero); /* Invalid second token. */
11280 }
11281
11282 /* ffestb_R9091_ -- "READ" expr
11283
11284 (ffestb_R9091_) // to expression handler
11285
11286 Make sure the next token is a COMMA or EOS/SEMICOLON. */
11287
11288 static ffelexHandler
11289 ffestb_R9091_ (ffelexToken ft, ffebld expr, ffelexToken t)
11290 {
11291 switch (ffelex_token_type (t))
11292 {
11293 case FFELEX_typeEOS:
11294 case FFELEX_typeSEMICOLON:
11295 case FFELEX_typeCOMMA:
11296 ffesta_confirmed ();
11297 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_or_val_present
11298 = TRUE;
11299 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_present = FALSE;
11300 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_present = TRUE;
11301 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_is_label
11302 = (expr == NULL);
11303 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value
11304 = ffelex_token_use (ft);
11305 ffestp_file.read.read_spec[FFESTP_readixFORMAT].u.expr = expr;
11306 if (!ffesta_is_inhibited ())
11307 ffestc_R909_start (TRUE);
11308 ffestb_subr_kill_read_ ();
11309 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
11310 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
11311 ffestc_context_iolist (),
11312 (ffeexprCallback) ffestb_R90915_);
11313 if (!ffesta_is_inhibited ())
11314 ffestc_R909_finish ();
11315 return (ffelexHandler) ffesta_zero (t);
11316
11317 default:
11318 break;
11319 }
11320
11321 ffestb_subr_kill_read_ ();
11322 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
11323 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11324 }
11325
11326 /* ffestb_R9092_ -- "READ" OPEN_PAREN
11327
11328 return ffestb_R9092_; // to lexer
11329
11330 Handle expr construct (not NAME=expr construct) here. */
11331
11332 static ffelexHandler
11333 ffestb_R9092_ (ffelexToken t)
11334 {
11335 ffelexToken nt;
11336 ffelexHandler next;
11337
11338 switch (ffelex_token_type (t))
11339 {
11340 case FFELEX_typeNAME:
11341 ffesta_tokens[2] = ffelex_token_use (t);
11342 return (ffelexHandler) ffestb_R9093_;
11343
11344 default:
11345 nt = ffesta_tokens[1];
11346 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
11347 FFEEXPR_contextFILEUNITAMBIG, (ffeexprCallback) ffestb_R9094_)))
11348 (nt);
11349 ffelex_token_kill (nt);
11350 return (ffelexHandler) (*next) (t);
11351 }
11352 }
11353
11354 /* ffestb_R9093_ -- "READ" OPEN_PAREN NAME
11355
11356 return ffestb_R9093_; // to lexer
11357
11358 If EQUALS here, go to states that handle it. Else, send NAME and this
11359 token thru expression handler. */
11360
11361 static ffelexHandler
11362 ffestb_R9093_ (ffelexToken t)
11363 {
11364 ffelexHandler next;
11365 ffelexToken nt;
11366 ffelexToken ot;
11367
11368 switch (ffelex_token_type (t))
11369 {
11370 case FFELEX_typeEQUALS:
11371 ffelex_token_kill (ffesta_tokens[1]);
11372 nt = ffesta_tokens[2];
11373 next = (ffelexHandler) ffestb_R9098_ (nt);
11374 ffelex_token_kill (nt);
11375 return (ffelexHandler) (*next) (t);
11376
11377 default:
11378 nt = ffesta_tokens[1];
11379 ot = ffesta_tokens[2];
11380 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
11381 FFEEXPR_contextFILEUNITAMBIG, (ffeexprCallback) ffestb_R9094_)))
11382 (nt);
11383 ffelex_token_kill (nt);
11384 next = (ffelexHandler) (*next) (ot);
11385 ffelex_token_kill (ot);
11386 return (ffelexHandler) (*next) (t);
11387 }
11388 }
11389
11390 /* ffestb_R9094_ -- "READ" OPEN_PAREN expr [CLOSE_PAREN]
11391
11392 (ffestb_R9094_) // to expression handler
11393
11394 Handle COMMA or EOS/SEMICOLON here.
11395
11396 15-Feb-91 JCB 1.1
11397 Use new ffeexpr mechanism whereby the expr is encased in an opITEM if
11398 ffeexpr decided it was an item in a control list (hence a unit
11399 specifier), or a format specifier otherwise. */
11400
11401 static ffelexHandler
11402 ffestb_R9094_ (ffelexToken ft, ffebld expr, ffelexToken t)
11403 {
11404 if (expr == NULL)
11405 goto bad; /* :::::::::::::::::::: */
11406
11407 if (ffebld_op (expr) != FFEBLD_opITEM)
11408 {
11409 switch (ffelex_token_type (t))
11410 {
11411 case FFELEX_typeCOMMA:
11412 case FFELEX_typeEOS:
11413 case FFELEX_typeSEMICOLON:
11414 ffesta_confirmed ();
11415 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_or_val_present
11416 = TRUE;
11417 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_present = FALSE;
11418 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_present = TRUE;
11419 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_is_label
11420 = FALSE;
11421 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value
11422 = ffelex_token_use (ft);
11423 ffestp_file.read.read_spec[FFESTP_readixFORMAT].u.expr = expr;
11424 if (!ffesta_is_inhibited ())
11425 ffestc_R909_start (TRUE);
11426 ffestb_subr_kill_read_ ();
11427 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
11428 return (ffelexHandler)
11429 ffeexpr_lhs (ffesta_output_pool,
11430 ffestc_context_iolist (),
11431 (ffeexprCallback) ffestb_R90915_);
11432 if (!ffesta_is_inhibited ())
11433 ffestc_R909_finish ();
11434 return (ffelexHandler) ffesta_zero (t);
11435
11436 default:
11437 goto bad; /* :::::::::::::::::::: */
11438 }
11439 }
11440
11441 expr = ffebld_head (expr);
11442
11443 if (expr == NULL)
11444 goto bad; /* :::::::::::::::::::: */
11445
11446 switch (ffelex_token_type (t))
11447 {
11448 case FFELEX_typeCOMMA:
11449 case FFELEX_typeCLOSE_PAREN:
11450 ffestp_file.read.read_spec[FFESTP_readixUNIT].kw_or_val_present
11451 = TRUE;
11452 ffestp_file.read.read_spec[FFESTP_readixUNIT].kw_present = FALSE;
11453 ffestp_file.read.read_spec[FFESTP_readixUNIT].value_present = TRUE;
11454 ffestp_file.read.read_spec[FFESTP_readixUNIT].value_is_label
11455 = FALSE;
11456 ffestp_file.read.read_spec[FFESTP_readixUNIT].value
11457 = ffelex_token_use (ft);
11458 ffestp_file.read.read_spec[FFESTP_readixUNIT].u.expr = expr;
11459 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
11460 return (ffelexHandler) ffestb_R9095_;
11461 return (ffelexHandler) ffestb_R90913_;
11462
11463 default:
11464 break;
11465 }
11466
11467 bad: /* :::::::::::::::::::: */
11468 ffestb_subr_kill_read_ ();
11469 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
11470 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11471 }
11472
11473 /* ffestb_R9095_ -- "READ" OPEN_PAREN expr COMMA
11474
11475 return ffestb_R9095_; // to lexer
11476
11477 Handle expr construct (not NAME=expr construct) here. */
11478
11479 static ffelexHandler
11480 ffestb_R9095_ (ffelexToken t)
11481 {
11482 switch (ffelex_token_type (t))
11483 {
11484 case FFELEX_typeNAME:
11485 ffesta_tokens[1] = ffelex_token_use (t);
11486 return (ffelexHandler) ffestb_R9096_;
11487
11488 default:
11489 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
11490 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9097_)))
11491 (t);
11492 }
11493 }
11494
11495 /* ffestb_R9096_ -- "READ" OPEN_PAREN expr COMMA NAME
11496
11497 return ffestb_R9096_; // to lexer
11498
11499 If EQUALS here, go to states that handle it. Else, send NAME and this
11500 token thru expression handler. */
11501
11502 static ffelexHandler
11503 ffestb_R9096_ (ffelexToken t)
11504 {
11505 ffelexHandler next;
11506 ffelexToken nt;
11507
11508 switch (ffelex_token_type (t))
11509 {
11510 case FFELEX_typeEQUALS:
11511 nt = ffesta_tokens[1];
11512 next = (ffelexHandler) ffestb_R9098_ (nt);
11513 ffelex_token_kill (nt);
11514 return (ffelexHandler) (*next) (t);
11515
11516 default:
11517 nt = ffesta_tokens[1];
11518 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
11519 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9097_)))
11520 (nt);
11521 ffelex_token_kill (nt);
11522 return (ffelexHandler) (*next) (t);
11523 }
11524 }
11525
11526 /* ffestb_R9097_ -- "READ" OPEN_PAREN expr COMMA expr
11527
11528 (ffestb_R9097_) // to expression handler
11529
11530 Handle COMMA or CLOSE_PAREN here. */
11531
11532 static ffelexHandler
11533 ffestb_R9097_ (ffelexToken ft, ffebld expr, ffelexToken t)
11534 {
11535 switch (ffelex_token_type (t))
11536 {
11537 case FFELEX_typeCOMMA:
11538 case FFELEX_typeCLOSE_PAREN:
11539 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_or_val_present
11540 = TRUE;
11541 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_present = FALSE;
11542 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_present = TRUE;
11543 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_is_label
11544 = (expr == NULL);
11545 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value
11546 = ffelex_token_use (ft);
11547 ffestp_file.read.read_spec[FFESTP_readixFORMAT].u.expr = expr;
11548 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
11549 return (ffelexHandler) ffestb_R9098_;
11550 return (ffelexHandler) ffestb_R90913_;
11551
11552 default:
11553 break;
11554 }
11555
11556 ffestb_subr_kill_read_ ();
11557 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
11558 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11559 }
11560
11561 /* ffestb_R9098_ -- "READ" OPEN_PAREN [external-file-unit COMMA [format
11562 COMMA]]
11563
11564 return ffestb_R9098_; // to lexer
11565
11566 Handle expr construct (not NAME=expr construct) here. */
11567
11568 static ffelexHandler
11569 ffestb_R9098_ (ffelexToken t)
11570 {
11571 ffestrGenio kw;
11572
11573 ffestb_local_.read.label = FALSE;
11574
11575 switch (ffelex_token_type (t))
11576 {
11577 case FFELEX_typeNAME:
11578 kw = ffestr_genio (t);
11579 switch (kw)
11580 {
11581 case FFESTR_genioADVANCE:
11582 ffestb_local_.read.ix = FFESTP_readixADVANCE;
11583 ffestb_local_.read.left = FALSE;
11584 ffestb_local_.read.context = FFEEXPR_contextFILEDFCHAR;
11585 break;
11586
11587 case FFESTR_genioEOR:
11588 ffestb_local_.read.ix = FFESTP_readixEOR;
11589 ffestb_local_.read.label = TRUE;
11590 break;
11591
11592 case FFESTR_genioERR:
11593 ffestb_local_.read.ix = FFESTP_readixERR;
11594 ffestb_local_.read.label = TRUE;
11595 break;
11596
11597 case FFESTR_genioEND:
11598 ffestb_local_.read.ix = FFESTP_readixEND;
11599 ffestb_local_.read.label = TRUE;
11600 break;
11601
11602 case FFESTR_genioFMT:
11603 ffestb_local_.read.ix = FFESTP_readixFORMAT;
11604 ffestb_local_.read.left = FALSE;
11605 ffestb_local_.read.context = FFEEXPR_contextFILEFORMAT;
11606 break;
11607
11608 case FFESTR_genioIOSTAT:
11609 ffestb_local_.read.ix = FFESTP_readixIOSTAT;
11610 ffestb_local_.read.left = TRUE;
11611 ffestb_local_.read.context = FFEEXPR_contextFILEINT;
11612 break;
11613
11614 case FFESTR_genioKEY:
11615 case FFESTR_genioKEYEQ:
11616 ffestb_local_.read.ix = FFESTP_readixKEYEQ;
11617 ffestb_local_.read.left = FALSE;
11618 ffestb_local_.read.context = FFEEXPR_contextFILENUMCHAR;
11619 break;
11620
11621 case FFESTR_genioKEYGE:
11622 ffestb_local_.read.ix = FFESTP_readixKEYGE;
11623 ffestb_local_.read.left = FALSE;
11624 ffestb_local_.read.context = FFEEXPR_contextFILENUMCHAR;
11625 break;
11626
11627 case FFESTR_genioKEYGT:
11628 ffestb_local_.read.ix = FFESTP_readixKEYGT;
11629 ffestb_local_.read.left = FALSE;
11630 ffestb_local_.read.context = FFEEXPR_contextFILENUMCHAR;
11631 break;
11632
11633 case FFESTR_genioKEYID:
11634 ffestb_local_.read.ix = FFESTP_readixKEYID;
11635 ffestb_local_.read.left = FALSE;
11636 ffestb_local_.read.context = FFEEXPR_contextFILENUM;
11637 break;
11638
11639 case FFESTR_genioNML:
11640 ffestb_local_.read.ix = FFESTP_readixFORMAT;
11641 ffestb_local_.read.left = TRUE;
11642 ffestb_local_.read.context = FFEEXPR_contextFILENAMELIST;
11643 break;
11644
11645 case FFESTR_genioNULLS:
11646 ffestb_local_.read.ix = FFESTP_readixNULLS;
11647 ffestb_local_.read.left = TRUE;
11648 ffestb_local_.read.context = FFEEXPR_contextFILEINT;
11649 break;
11650
11651 case FFESTR_genioREC:
11652 ffestb_local_.read.ix = FFESTP_readixREC;
11653 ffestb_local_.read.left = FALSE;
11654 ffestb_local_.read.context = FFEEXPR_contextFILENUM;
11655 break;
11656
11657 case FFESTR_genioSIZE:
11658 ffestb_local_.read.ix = FFESTP_readixSIZE;
11659 ffestb_local_.read.left = TRUE;
11660 ffestb_local_.read.context = FFEEXPR_contextFILEINT;
11661 break;
11662
11663 case FFESTR_genioUNIT:
11664 ffestb_local_.read.ix = FFESTP_readixUNIT;
11665 ffestb_local_.read.left = FALSE;
11666 ffestb_local_.read.context = FFEEXPR_contextFILEUNIT;
11667 break;
11668
11669 default:
11670 goto bad; /* :::::::::::::::::::: */
11671 }
11672 if (ffestp_file.read.read_spec[ffestb_local_.read.ix]
11673 .kw_or_val_present)
11674 break; /* Can't specify a keyword twice! */
11675 ffestp_file.read.read_spec[ffestb_local_.read.ix]
11676 .kw_or_val_present = TRUE;
11677 ffestp_file.read.read_spec[ffestb_local_.read.ix]
11678 .kw_present = TRUE;
11679 ffestp_file.read.read_spec[ffestb_local_.read.ix]
11680 .value_present = FALSE;
11681 ffestp_file.read.read_spec[ffestb_local_.read.ix].value_is_label
11682 = ffestb_local_.read.label;
11683 ffestp_file.read.read_spec[ffestb_local_.read.ix].kw
11684 = ffelex_token_use (t);
11685 return (ffelexHandler) ffestb_R9099_;
11686
11687 default:
11688 break;
11689 }
11690
11691 bad: /* :::::::::::::::::::: */
11692 ffestb_subr_kill_read_ ();
11693 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
11694 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11695 }
11696
11697 /* ffestb_R9099_ -- "READ" OPEN_PAREN [external-file-unit COMMA [format
11698 COMMA]] NAME
11699
11700 return ffestb_R9099_; // to lexer
11701
11702 Make sure EQUALS here, send next token to expression handler. */
11703
11704 static ffelexHandler
11705 ffestb_R9099_ (ffelexToken t)
11706 {
11707 switch (ffelex_token_type (t))
11708 {
11709 case FFELEX_typeEQUALS:
11710 ffesta_confirmed ();
11711 if (ffestb_local_.read.label)
11712 return (ffelexHandler) ffestb_R90911_;
11713 if (ffestb_local_.read.left)
11714 return (ffelexHandler)
11715 ffeexpr_lhs (ffesta_output_pool,
11716 ffestb_local_.read.context,
11717 (ffeexprCallback) ffestb_R90910_);
11718 return (ffelexHandler)
11719 ffeexpr_rhs (ffesta_output_pool,
11720 ffestb_local_.read.context,
11721 (ffeexprCallback) ffestb_R90910_);
11722
11723 default:
11724 break;
11725 }
11726
11727 ffestb_subr_kill_read_ ();
11728 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
11729 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11730 }
11731
11732 /* ffestb_R90910_ -- "READ" OPEN_PAREN ... NAME EQUALS expr
11733
11734 (ffestb_R90910_) // to expression handler
11735
11736 Handle COMMA or CLOSE_PAREN here. */
11737
11738 static ffelexHandler
11739 ffestb_R90910_ (ffelexToken ft, ffebld expr, ffelexToken t)
11740 {
11741 switch (ffelex_token_type (t))
11742 {
11743 case FFELEX_typeCOMMA:
11744 case FFELEX_typeCLOSE_PAREN:
11745 if (expr == NULL)
11746 {
11747 if (ffestb_local_.read.context == FFEEXPR_contextFILEFORMAT)
11748 ffestp_file.read.read_spec[ffestb_local_.read.ix]
11749 .value_is_label = TRUE;
11750 else
11751 break;
11752 }
11753 ffestp_file.read.read_spec[ffestb_local_.read.ix].value_present
11754 = TRUE;
11755 ffestp_file.read.read_spec[ffestb_local_.read.ix].value
11756 = ffelex_token_use (ft);
11757 ffestp_file.read.read_spec[ffestb_local_.read.ix].u.expr = expr;
11758 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
11759 return (ffelexHandler) ffestb_R9098_;
11760 return (ffelexHandler) ffestb_R90913_;
11761
11762 default:
11763 break;
11764 }
11765
11766 ffestb_subr_kill_read_ ();
11767 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
11768 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11769 }
11770
11771 /* ffestb_R90911_ -- "READ" OPEN_PAREN ... NAME EQUALS
11772
11773 return ffestb_R90911_; // to lexer
11774
11775 Handle NUMBER for label here. */
11776
11777 static ffelexHandler
11778 ffestb_R90911_ (ffelexToken t)
11779 {
11780 switch (ffelex_token_type (t))
11781 {
11782 case FFELEX_typeNUMBER:
11783 ffestp_file.read.read_spec[ffestb_local_.read.ix].value_present
11784 = TRUE;
11785 ffestp_file.read.read_spec[ffestb_local_.read.ix].value
11786 = ffelex_token_use (t);
11787 return (ffelexHandler) ffestb_R90912_;
11788
11789 default:
11790 break;
11791 }
11792
11793 ffestb_subr_kill_read_ ();
11794 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
11795 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11796 }
11797
11798 /* ffestb_R90912_ -- "READ" OPEN_PAREN ... NAME EQUALS NUMBER
11799
11800 return ffestb_R90912_; // to lexer
11801
11802 Handle COMMA or CLOSE_PAREN here. */
11803
11804 static ffelexHandler
11805 ffestb_R90912_ (ffelexToken t)
11806 {
11807 switch (ffelex_token_type (t))
11808 {
11809 case FFELEX_typeCOMMA:
11810 return (ffelexHandler) ffestb_R9098_;
11811
11812 case FFELEX_typeCLOSE_PAREN:
11813 return (ffelexHandler) ffestb_R90913_;
11814
11815 default:
11816 break;
11817 }
11818
11819 ffestb_subr_kill_read_ ();
11820 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
11821 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11822 }
11823
11824 /* ffestb_R90913_ -- "READ" OPEN_PAREN ... CLOSE_PAREN
11825
11826 return ffestb_R90913_; // to lexer
11827
11828 Handle EOS or SEMICOLON here.
11829
11830 15-Feb-91 JCB 1.1
11831 Fix to allow implied-DO construct here (OPEN_PAREN) -- actually,
11832 don't presume knowledge of what an initial token in an lhs context
11833 is going to be, let ffeexpr_lhs handle that as much as possible. */
11834
11835 static ffelexHandler
11836 ffestb_R90913_ (ffelexToken t)
11837 {
11838 switch (ffelex_token_type (t))
11839 {
11840 case FFELEX_typeEOS:
11841 case FFELEX_typeSEMICOLON:
11842 ffesta_confirmed ();
11843 if (!ffesta_is_inhibited ())
11844 {
11845 ffestc_R909_start (FALSE);
11846 ffestc_R909_finish ();
11847 }
11848 ffestb_subr_kill_read_ ();
11849 return (ffelexHandler) ffesta_zero (t);
11850
11851 default:
11852 ffesta_confirmed ();
11853 /* Fall through. */
11854 case FFELEX_typeOPEN_PAREN: /* Could still be assignment!! */
11855 break;
11856 }
11857
11858 /* If token isn't NAME or OPEN_PAREN, ffeexpr_lhs will ultimately whine
11859 about it, so leave it up to that code. */
11860
11861 /* EXTENSION: Allow an optional preceding COMMA here if not pedantic. (f2c
11862 provides this extension, as do other compilers, supposedly.) */
11863
11864 if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA))
11865 return (ffelexHandler)
11866 ffeexpr_lhs (ffesta_output_pool,
11867 ffestc_context_iolist (),
11868 (ffeexprCallback) ffestb_R90914_);
11869
11870 return (ffelexHandler) (*((ffelexHandler)
11871 ffeexpr_lhs (ffesta_output_pool,
11872 ffestc_context_iolist (),
11873 (ffeexprCallback) ffestb_R90914_)))
11874 (t);
11875 }
11876
11877 /* ffestb_R90914_ -- "READ(...)" expr
11878
11879 (ffestb_R90914_) // to expression handler
11880
11881 Handle COMMA or EOS/SEMICOLON here. */
11882
11883 static ffelexHandler
11884 ffestb_R90914_ (ffelexToken ft, ffebld expr, ffelexToken t)
11885 {
11886 switch (ffelex_token_type (t))
11887 {
11888 case FFELEX_typeCOMMA:
11889 if (expr == NULL)
11890 break;
11891
11892 ffesta_confirmed ();
11893 if (!ffesta_is_inhibited ())
11894 ffestc_R909_start (FALSE);
11895 ffestb_subr_kill_read_ ();
11896
11897 if (!ffesta_is_inhibited ())
11898 ffestc_R909_item (expr, ft);
11899 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
11900 ffestc_context_iolist (),
11901 (ffeexprCallback) ffestb_R90915_);
11902
11903 case FFELEX_typeEOS:
11904 case FFELEX_typeSEMICOLON:
11905 if (expr == NULL)
11906 break;
11907
11908 ffesta_confirmed ();
11909 if (!ffesta_is_inhibited ())
11910 ffestc_R909_start (FALSE);
11911 ffestb_subr_kill_read_ ();
11912
11913 if (!ffesta_is_inhibited ())
11914 {
11915 ffestc_R909_item (expr, ft);
11916 ffestc_R909_finish ();
11917 }
11918 return (ffelexHandler) ffesta_zero (t);
11919
11920 default:
11921 break;
11922 }
11923
11924 ffestb_subr_kill_read_ ();
11925 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
11926 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11927 }
11928
11929 /* ffestb_R90915_ -- "READ(...)" expr COMMA expr
11930
11931 (ffestb_R90915_) // to expression handler
11932
11933 Handle COMMA or EOS/SEMICOLON here. */
11934
11935 static ffelexHandler
11936 ffestb_R90915_ (ffelexToken ft, ffebld expr, ffelexToken t)
11937 {
11938 switch (ffelex_token_type (t))
11939 {
11940 case FFELEX_typeCOMMA:
11941 if (expr == NULL)
11942 break;
11943 if (!ffesta_is_inhibited ())
11944 ffestc_R909_item (expr, ft);
11945 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
11946 ffestc_context_iolist (),
11947 (ffeexprCallback) ffestb_R90915_);
11948
11949 case FFELEX_typeEOS:
11950 case FFELEX_typeSEMICOLON:
11951 if (expr == NULL)
11952 break;
11953 if (!ffesta_is_inhibited ())
11954 {
11955 ffestc_R909_item (expr, ft);
11956 ffestc_R909_finish ();
11957 }
11958 return (ffelexHandler) ffesta_zero (t);
11959
11960 default:
11961 break;
11962 }
11963
11964 if (!ffesta_is_inhibited ())
11965 ffestc_R909_finish ();
11966 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
11967 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
11968 }
11969
11970 /* ffestb_R910 -- Parse the WRITE statement
11971
11972 return ffestb_R910; // to lexer
11973
11974 Make sure the statement has a valid form for the WRITE
11975 statement. If it does, implement the statement. */
11976
11977 ffelexHandler
11978 ffestb_R910 (ffelexToken t)
11979 {
11980 ffestpWriteIx ix;
11981
11982 switch (ffelex_token_type (ffesta_tokens[0]))
11983 {
11984 case FFELEX_typeNAME:
11985 if (ffesta_first_kw != FFESTR_firstWRITE)
11986 goto bad_0; /* :::::::::::::::::::: */
11987 switch (ffelex_token_type (t))
11988 {
11989 case FFELEX_typeCOMMA:
11990 case FFELEX_typeCOLONCOLON:
11991 case FFELEX_typeEOS:
11992 case FFELEX_typeSEMICOLON:
11993 case FFELEX_typeNAME:
11994 case FFELEX_typeNUMBER:
11995 ffesta_confirmed (); /* Error, but clearly intended. */
11996 goto bad_1; /* :::::::::::::::::::: */
11997
11998 default:
11999 goto bad_1; /* :::::::::::::::::::: */
12000
12001 case FFELEX_typeOPEN_PAREN:
12002 for (ix = 0; ix < FFESTP_writeix; ++ix)
12003 ffestp_file.write.write_spec[ix].kw_or_val_present = FALSE;
12004 return (ffelexHandler) ffestb_R9101_;
12005 }
12006
12007 case FFELEX_typeNAMES:
12008 if (ffesta_first_kw != FFESTR_firstWRITE)
12009 goto bad_0; /* :::::::::::::::::::: */
12010 switch (ffelex_token_type (t))
12011 {
12012 case FFELEX_typeEOS:
12013 case FFELEX_typeSEMICOLON:
12014 case FFELEX_typeCOMMA:
12015 case FFELEX_typeCOLONCOLON:
12016 ffesta_confirmed (); /* Error, but clearly intended. */
12017 goto bad_1; /* :::::::::::::::::::: */
12018
12019 default:
12020 goto bad_1; /* :::::::::::::::::::: */
12021
12022 case FFELEX_typeOPEN_PAREN:
12023 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlWRITE)
12024 goto bad_0; /* :::::::::::::::::::: */
12025
12026 for (ix = 0; ix < FFESTP_writeix; ++ix)
12027 ffestp_file.write.write_spec[ix].kw_or_val_present = FALSE;
12028 return (ffelexHandler) ffestb_R9101_;
12029 }
12030
12031 default:
12032 goto bad_0; /* :::::::::::::::::::: */
12033 }
12034
12035 bad_0: /* :::::::::::::::::::: */
12036 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", ffesta_tokens[0]);
12037 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12038
12039 bad_1: /* :::::::::::::::::::: */
12040 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
12041 return (ffelexHandler) ffelex_swallow_tokens (t,
12042 (ffelexHandler) ffesta_zero); /* Invalid second token. */
12043 }
12044
12045 /* ffestb_R9101_ -- "WRITE" OPEN_PAREN
12046
12047 return ffestb_R9101_; // to lexer
12048
12049 Handle expr construct (not NAME=expr construct) here. */
12050
12051 static ffelexHandler
12052 ffestb_R9101_ (ffelexToken t)
12053 {
12054 switch (ffelex_token_type (t))
12055 {
12056 case FFELEX_typeNAME:
12057 ffesta_tokens[1] = ffelex_token_use (t);
12058 return (ffelexHandler) ffestb_R9102_;
12059
12060 default:
12061 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
12062 FFEEXPR_contextFILEUNIT, (ffeexprCallback) ffestb_R9103_)))
12063 (t);
12064 }
12065 }
12066
12067 /* ffestb_R9102_ -- "WRITE" OPEN_PAREN NAME
12068
12069 return ffestb_R9102_; // to lexer
12070
12071 If EQUALS here, go to states that handle it. Else, send NAME and this
12072 token thru expression handler. */
12073
12074 static ffelexHandler
12075 ffestb_R9102_ (ffelexToken t)
12076 {
12077 ffelexHandler next;
12078 ffelexToken nt;
12079
12080 switch (ffelex_token_type (t))
12081 {
12082 case FFELEX_typeEQUALS:
12083 nt = ffesta_tokens[1];
12084 next = (ffelexHandler) ffestb_R9107_ (nt);
12085 ffelex_token_kill (nt);
12086 return (ffelexHandler) (*next) (t);
12087
12088 default:
12089 nt = ffesta_tokens[1];
12090 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
12091 FFEEXPR_contextFILEUNIT, (ffeexprCallback) ffestb_R9103_)))
12092 (nt);
12093 ffelex_token_kill (nt);
12094 return (ffelexHandler) (*next) (t);
12095 }
12096 }
12097
12098 /* ffestb_R9103_ -- "WRITE" OPEN_PAREN expr [CLOSE_PAREN]
12099
12100 (ffestb_R9103_) // to expression handler
12101
12102 Handle COMMA or EOS/SEMICOLON here. */
12103
12104 static ffelexHandler
12105 ffestb_R9103_ (ffelexToken ft, ffebld expr, ffelexToken t)
12106 {
12107 switch (ffelex_token_type (t))
12108 {
12109 case FFELEX_typeCOMMA:
12110 case FFELEX_typeCLOSE_PAREN:
12111 if (expr == NULL)
12112 break;
12113 ffestp_file.write.write_spec[FFESTP_writeixUNIT].kw_or_val_present
12114 = TRUE;
12115 ffestp_file.write.write_spec[FFESTP_writeixUNIT].kw_present = FALSE;
12116 ffestp_file.write.write_spec[FFESTP_writeixUNIT].value_present = TRUE;
12117 ffestp_file.write.write_spec[FFESTP_writeixUNIT].value_is_label
12118 = FALSE;
12119 ffestp_file.write.write_spec[FFESTP_writeixUNIT].value
12120 = ffelex_token_use (ft);
12121 ffestp_file.write.write_spec[FFESTP_writeixUNIT].u.expr = expr;
12122 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
12123 return (ffelexHandler) ffestb_R9104_;
12124 return (ffelexHandler) ffestb_R91012_;
12125
12126 default:
12127 break;
12128 }
12129
12130 ffestb_subr_kill_write_ ();
12131 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
12132 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12133 }
12134
12135 /* ffestb_R9104_ -- "WRITE" OPEN_PAREN expr COMMA
12136
12137 return ffestb_R9104_; // to lexer
12138
12139 Handle expr construct (not NAME=expr construct) here. */
12140
12141 static ffelexHandler
12142 ffestb_R9104_ (ffelexToken t)
12143 {
12144 switch (ffelex_token_type (t))
12145 {
12146 case FFELEX_typeNAME:
12147 ffesta_tokens[1] = ffelex_token_use (t);
12148 return (ffelexHandler) ffestb_R9105_;
12149
12150 default:
12151 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
12152 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9106_)))
12153 (t);
12154 }
12155 }
12156
12157 /* ffestb_R9105_ -- "WRITE" OPEN_PAREN expr COMMA NAME
12158
12159 return ffestb_R9105_; // to lexer
12160
12161 If EQUALS here, go to states that handle it. Else, send NAME and this
12162 token thru expression handler. */
12163
12164 static ffelexHandler
12165 ffestb_R9105_ (ffelexToken t)
12166 {
12167 ffelexHandler next;
12168 ffelexToken nt;
12169
12170 switch (ffelex_token_type (t))
12171 {
12172 case FFELEX_typeEQUALS:
12173 nt = ffesta_tokens[1];
12174 next = (ffelexHandler) ffestb_R9107_ (nt);
12175 ffelex_token_kill (nt);
12176 return (ffelexHandler) (*next) (t);
12177
12178 default:
12179 nt = ffesta_tokens[1];
12180 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
12181 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9106_)))
12182 (nt);
12183 ffelex_token_kill (nt);
12184 return (ffelexHandler) (*next) (t);
12185 }
12186 }
12187
12188 /* ffestb_R9106_ -- "WRITE" OPEN_PAREN expr COMMA expr
12189
12190 (ffestb_R9106_) // to expression handler
12191
12192 Handle COMMA or CLOSE_PAREN here. */
12193
12194 static ffelexHandler
12195 ffestb_R9106_ (ffelexToken ft, ffebld expr, ffelexToken t)
12196 {
12197 switch (ffelex_token_type (t))
12198 {
12199 case FFELEX_typeCOMMA:
12200 case FFELEX_typeCLOSE_PAREN:
12201 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].kw_or_val_present
12202 = TRUE;
12203 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].kw_present = FALSE;
12204 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].value_present = TRUE;
12205 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].value_is_label
12206 = (expr == NULL);
12207 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].value
12208 = ffelex_token_use (ft);
12209 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].u.expr = expr;
12210 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
12211 return (ffelexHandler) ffestb_R9107_;
12212 return (ffelexHandler) ffestb_R91012_;
12213
12214 default:
12215 break;
12216 }
12217
12218 ffestb_subr_kill_write_ ();
12219 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
12220 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12221 }
12222
12223 /* ffestb_R9107_ -- "WRITE" OPEN_PAREN [external-file-unit COMMA [format
12224 COMMA]]
12225
12226 return ffestb_R9107_; // to lexer
12227
12228 Handle expr construct (not NAME=expr construct) here. */
12229
12230 static ffelexHandler
12231 ffestb_R9107_ (ffelexToken t)
12232 {
12233 ffestrGenio kw;
12234
12235 ffestb_local_.write.label = FALSE;
12236
12237 switch (ffelex_token_type (t))
12238 {
12239 case FFELEX_typeNAME:
12240 kw = ffestr_genio (t);
12241 switch (kw)
12242 {
12243 case FFESTR_genioADVANCE:
12244 ffestb_local_.write.ix = FFESTP_writeixADVANCE;
12245 ffestb_local_.write.left = FALSE;
12246 ffestb_local_.write.context = FFEEXPR_contextFILEDFCHAR;
12247 break;
12248
12249 case FFESTR_genioEOR:
12250 ffestb_local_.write.ix = FFESTP_writeixEOR;
12251 ffestb_local_.write.label = TRUE;
12252 break;
12253
12254 case FFESTR_genioERR:
12255 ffestb_local_.write.ix = FFESTP_writeixERR;
12256 ffestb_local_.write.label = TRUE;
12257 break;
12258
12259 case FFESTR_genioFMT:
12260 ffestb_local_.write.ix = FFESTP_writeixFORMAT;
12261 ffestb_local_.write.left = FALSE;
12262 ffestb_local_.write.context = FFEEXPR_contextFILEFORMAT;
12263 break;
12264
12265 case FFESTR_genioIOSTAT:
12266 ffestb_local_.write.ix = FFESTP_writeixIOSTAT;
12267 ffestb_local_.write.left = TRUE;
12268 ffestb_local_.write.context = FFEEXPR_contextFILEINT;
12269 break;
12270
12271 case FFESTR_genioNML:
12272 ffestb_local_.write.ix = FFESTP_writeixFORMAT;
12273 ffestb_local_.write.left = TRUE;
12274 ffestb_local_.write.context = FFEEXPR_contextFILENAMELIST;
12275 break;
12276
12277 case FFESTR_genioREC:
12278 ffestb_local_.write.ix = FFESTP_writeixREC;
12279 ffestb_local_.write.left = FALSE;
12280 ffestb_local_.write.context = FFEEXPR_contextFILENUM;
12281 break;
12282
12283 case FFESTR_genioUNIT:
12284 ffestb_local_.write.ix = FFESTP_writeixUNIT;
12285 ffestb_local_.write.left = FALSE;
12286 ffestb_local_.write.context = FFEEXPR_contextFILEUNIT;
12287 break;
12288
12289 default:
12290 goto bad; /* :::::::::::::::::::: */
12291 }
12292 if (ffestp_file.write.write_spec[ffestb_local_.write.ix]
12293 .kw_or_val_present)
12294 break; /* Can't specify a keyword twice! */
12295 ffestp_file.write.write_spec[ffestb_local_.write.ix]
12296 .kw_or_val_present = TRUE;
12297 ffestp_file.write.write_spec[ffestb_local_.write.ix]
12298 .kw_present = TRUE;
12299 ffestp_file.write.write_spec[ffestb_local_.write.ix]
12300 .value_present = FALSE;
12301 ffestp_file.write.write_spec[ffestb_local_.write.ix].value_is_label
12302 = ffestb_local_.write.label;
12303 ffestp_file.write.write_spec[ffestb_local_.write.ix].kw
12304 = ffelex_token_use (t);
12305 return (ffelexHandler) ffestb_R9108_;
12306
12307 default:
12308 break;
12309 }
12310
12311 bad: /* :::::::::::::::::::: */
12312 ffestb_subr_kill_write_ ();
12313 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
12314 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12315 }
12316
12317 /* ffestb_R9108_ -- "WRITE" OPEN_PAREN [external-file-unit COMMA [format
12318 COMMA]] NAME
12319
12320 return ffestb_R9108_; // to lexer
12321
12322 Make sure EQUALS here, send next token to expression handler. */
12323
12324 static ffelexHandler
12325 ffestb_R9108_ (ffelexToken t)
12326 {
12327 switch (ffelex_token_type (t))
12328 {
12329 case FFELEX_typeEQUALS:
12330 ffesta_confirmed ();
12331 if (ffestb_local_.write.label)
12332 return (ffelexHandler) ffestb_R91010_;
12333 if (ffestb_local_.write.left)
12334 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
12335 ffestb_local_.write.context,
12336 (ffeexprCallback) ffestb_R9109_);
12337 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
12338 ffestb_local_.write.context,
12339 (ffeexprCallback) ffestb_R9109_);
12340
12341 default:
12342 break;
12343 }
12344
12345 ffestb_subr_kill_write_ ();
12346 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
12347 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12348 }
12349
12350 /* ffestb_R9109_ -- "WRITE" OPEN_PAREN ... NAME EQUALS expr
12351
12352 (ffestb_R9109_) // to expression handler
12353
12354 Handle COMMA or CLOSE_PAREN here. */
12355
12356 static ffelexHandler
12357 ffestb_R9109_ (ffelexToken ft, ffebld expr, ffelexToken t)
12358 {
12359 switch (ffelex_token_type (t))
12360 {
12361 case FFELEX_typeCOMMA:
12362 case FFELEX_typeCLOSE_PAREN:
12363 if (expr == NULL)
12364 {
12365 if (ffestb_local_.write.context == FFEEXPR_contextFILEFORMAT)
12366 ffestp_file.write.write_spec[ffestb_local_.write.ix]
12367 .value_is_label = TRUE;
12368 else
12369 break;
12370 }
12371 ffestp_file.write.write_spec[ffestb_local_.write.ix].value_present
12372 = TRUE;
12373 ffestp_file.write.write_spec[ffestb_local_.write.ix].value
12374 = ffelex_token_use (ft);
12375 ffestp_file.write.write_spec[ffestb_local_.write.ix].u.expr = expr;
12376 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
12377 return (ffelexHandler) ffestb_R9107_;
12378 return (ffelexHandler) ffestb_R91012_;
12379
12380 default:
12381 break;
12382 }
12383
12384 ffestb_subr_kill_write_ ();
12385 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
12386 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12387 }
12388
12389 /* ffestb_R91010_ -- "WRITE" OPEN_PAREN ... NAME EQUALS
12390
12391 return ffestb_R91010_; // to lexer
12392
12393 Handle NUMBER for label here. */
12394
12395 static ffelexHandler
12396 ffestb_R91010_ (ffelexToken t)
12397 {
12398 switch (ffelex_token_type (t))
12399 {
12400 case FFELEX_typeNUMBER:
12401 ffestp_file.write.write_spec[ffestb_local_.write.ix].value_present
12402 = TRUE;
12403 ffestp_file.write.write_spec[ffestb_local_.write.ix].value
12404 = ffelex_token_use (t);
12405 return (ffelexHandler) ffestb_R91011_;
12406
12407 default:
12408 break;
12409 }
12410
12411 ffestb_subr_kill_write_ ();
12412 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
12413 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12414 }
12415
12416 /* ffestb_R91011_ -- "WRITE" OPEN_PAREN ... NAME EQUALS NUMBER
12417
12418 return ffestb_R91011_; // to lexer
12419
12420 Handle COMMA or CLOSE_PAREN here. */
12421
12422 static ffelexHandler
12423 ffestb_R91011_ (ffelexToken t)
12424 {
12425 switch (ffelex_token_type (t))
12426 {
12427 case FFELEX_typeCOMMA:
12428 return (ffelexHandler) ffestb_R9107_;
12429
12430 case FFELEX_typeCLOSE_PAREN:
12431 return (ffelexHandler) ffestb_R91012_;
12432
12433 default:
12434 break;
12435 }
12436
12437 ffestb_subr_kill_write_ ();
12438 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
12439 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12440 }
12441
12442 /* ffestb_R91012_ -- "WRITE" OPEN_PAREN ... CLOSE_PAREN
12443
12444 return ffestb_R91012_; // to lexer
12445
12446 Handle EOS or SEMICOLON here. */
12447
12448 static ffelexHandler
12449 ffestb_R91012_ (ffelexToken t)
12450 {
12451 switch (ffelex_token_type (t))
12452 {
12453 case FFELEX_typeEOS:
12454 case FFELEX_typeSEMICOLON:
12455 ffesta_confirmed ();
12456 if (!ffesta_is_inhibited ())
12457 {
12458 ffestc_R910_start ();
12459 ffestc_R910_finish ();
12460 }
12461 ffestb_subr_kill_write_ ();
12462 return (ffelexHandler) ffesta_zero (t);
12463
12464 default:
12465 ffesta_confirmed ();
12466 /* Fall through. */
12467 case FFELEX_typeOPEN_PAREN: /* Could still be assignment!! */
12468
12469 /* EXTENSION: Allow an optional preceding COMMA here if not pedantic.
12470 (f2c provides this extension, as do other compilers, supposedly.) */
12471
12472 if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA))
12473 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
12474 ffestc_context_iolist (), (ffeexprCallback) ffestb_R91013_);
12475
12476 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
12477 ffestc_context_iolist (), (ffeexprCallback) ffestb_R91013_)))
12478 (t);
12479
12480 case FFELEX_typeEQUALS:
12481 case FFELEX_typePOINTS:
12482 break;
12483 }
12484
12485 ffestb_subr_kill_write_ ();
12486 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
12487 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12488 }
12489
12490 /* ffestb_R91013_ -- "WRITE(...)" expr
12491
12492 (ffestb_R91013_) // to expression handler
12493
12494 Handle COMMA or EOS/SEMICOLON here. */
12495
12496 static ffelexHandler
12497 ffestb_R91013_ (ffelexToken ft, ffebld expr, ffelexToken t)
12498 {
12499 switch (ffelex_token_type (t))
12500 {
12501 case FFELEX_typeCOMMA:
12502 if (expr == NULL)
12503 break;
12504
12505 ffesta_confirmed ();
12506 if (!ffesta_is_inhibited ())
12507 ffestc_R910_start ();
12508 ffestb_subr_kill_write_ ();
12509
12510 if (!ffesta_is_inhibited ())
12511 ffestc_R910_item (expr, ft);
12512 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
12513 ffestc_context_iolist (), (ffeexprCallback) ffestb_R91014_);
12514
12515 case FFELEX_typeEOS:
12516 case FFELEX_typeSEMICOLON:
12517 if (expr == NULL)
12518 break;
12519
12520 ffesta_confirmed ();
12521 if (!ffesta_is_inhibited ())
12522 ffestc_R910_start ();
12523 ffestb_subr_kill_write_ ();
12524
12525 if (!ffesta_is_inhibited ())
12526 {
12527 ffestc_R910_item (expr, ft);
12528 ffestc_R910_finish ();
12529 }
12530 return (ffelexHandler) ffesta_zero (t);
12531
12532 default:
12533 break;
12534 }
12535
12536 ffestb_subr_kill_write_ ();
12537 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
12538 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12539 }
12540
12541 /* ffestb_R91014_ -- "WRITE(...)" expr COMMA expr
12542
12543 (ffestb_R91014_) // to expression handler
12544
12545 Handle COMMA or EOS/SEMICOLON here. */
12546
12547 static ffelexHandler
12548 ffestb_R91014_ (ffelexToken ft, ffebld expr, ffelexToken t)
12549 {
12550 switch (ffelex_token_type (t))
12551 {
12552 case FFELEX_typeCOMMA:
12553 if (expr == NULL)
12554 break;
12555 if (!ffesta_is_inhibited ())
12556 ffestc_R910_item (expr, ft);
12557 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
12558 ffestc_context_iolist (), (ffeexprCallback) ffestb_R91014_);
12559
12560 case FFELEX_typeEOS:
12561 case FFELEX_typeSEMICOLON:
12562 if (expr == NULL)
12563 break;
12564 if (!ffesta_is_inhibited ())
12565 {
12566 ffestc_R910_item (expr, ft);
12567 ffestc_R910_finish ();
12568 }
12569 return (ffelexHandler) ffesta_zero (t);
12570
12571 default:
12572 break;
12573 }
12574
12575 if (!ffesta_is_inhibited ())
12576 ffestc_R910_finish ();
12577 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
12578 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12579 }
12580
12581 /* ffestb_R911 -- Parse the PRINT statement
12582
12583 return ffestb_R911; // to lexer
12584
12585 Make sure the statement has a valid form for the PRINT
12586 statement. If it does, implement the statement. */
12587
12588 ffelexHandler
12589 ffestb_R911 (ffelexToken t)
12590 {
12591 ffelexHandler next;
12592 ffestpPrintIx ix;
12593
12594 switch (ffelex_token_type (ffesta_tokens[0]))
12595 {
12596 case FFELEX_typeNAME:
12597 if (ffesta_first_kw != FFESTR_firstPRINT)
12598 goto bad_0; /* :::::::::::::::::::: */
12599 switch (ffelex_token_type (t))
12600 {
12601 case FFELEX_typeCOMMA:
12602 case FFELEX_typeCOLONCOLON:
12603 case FFELEX_typeEOS:
12604 case FFELEX_typeSEMICOLON:
12605 ffesta_confirmed (); /* Error, but clearly intended. */
12606 goto bad_1; /* :::::::::::::::::::: */
12607
12608 case FFELEX_typeEQUALS:
12609 case FFELEX_typePOINTS:
12610 case FFELEX_typeCOLON:
12611 goto bad_1; /* :::::::::::::::::::: */
12612
12613 case FFELEX_typeNAME:
12614 case FFELEX_typeNUMBER:
12615 ffesta_confirmed ();
12616 break;
12617
12618 default:
12619 break;
12620 }
12621
12622 for (ix = 0; ix < FFESTP_printix; ++ix)
12623 ffestp_file.print.print_spec[ix].kw_or_val_present = FALSE;
12624 return (ffelexHandler) (*((ffelexHandler)
12625 ffeexpr_rhs (ffesta_output_pool,
12626 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9111_)))
12627 (t);
12628
12629 case FFELEX_typeNAMES:
12630 if (ffesta_first_kw != FFESTR_firstPRINT)
12631 goto bad_0; /* :::::::::::::::::::: */
12632 switch (ffelex_token_type (t))
12633 {
12634 case FFELEX_typeEOS:
12635 case FFELEX_typeSEMICOLON:
12636 case FFELEX_typeCOMMA:
12637 ffesta_confirmed ();
12638 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlPRINT)
12639 break;
12640 goto bad_1; /* :::::::::::::::::::: */
12641
12642 case FFELEX_typeCOLONCOLON:
12643 ffesta_confirmed (); /* Error, but clearly intended. */
12644 goto bad_1; /* :::::::::::::::::::: */
12645
12646 case FFELEX_typeEQUALS:
12647 case FFELEX_typePOINTS:
12648 case FFELEX_typeCOLON:
12649 goto bad_1; /* :::::::::::::::::::: */
12650
12651 default:
12652 break;
12653 }
12654 for (ix = 0; ix < FFESTP_printix; ++ix)
12655 ffestp_file.print.print_spec[ix].kw_or_val_present = FALSE;
12656 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
12657 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9111_);
12658 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
12659 FFESTR_firstlPRINT);
12660 if (next == NULL)
12661 return (ffelexHandler) ffelex_swallow_tokens (t,
12662 (ffelexHandler) ffesta_zero);
12663 return (ffelexHandler) (*next) (t);
12664
12665 default:
12666 goto bad_0; /* :::::::::::::::::::: */
12667 }
12668
12669 bad_0: /* :::::::::::::::::::: */
12670 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", ffesta_tokens[0]);
12671 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12672
12673 bad_1: /* :::::::::::::::::::: */
12674 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", t);
12675 return (ffelexHandler) ffelex_swallow_tokens (t,
12676 (ffelexHandler) ffesta_zero); /* Invalid second token. */
12677 }
12678
12679 /* ffestb_R9111_ -- "PRINT" expr
12680
12681 (ffestb_R9111_) // to expression handler
12682
12683 Make sure the next token is a COMMA or EOS/SEMICOLON. */
12684
12685 static ffelexHandler
12686 ffestb_R9111_ (ffelexToken ft, ffebld expr, ffelexToken t)
12687 {
12688 switch (ffelex_token_type (t))
12689 {
12690 case FFELEX_typeEOS:
12691 case FFELEX_typeSEMICOLON:
12692 case FFELEX_typeCOMMA:
12693 ffesta_confirmed ();
12694 ffestp_file.print.print_spec[FFESTP_printixFORMAT].kw_or_val_present
12695 = TRUE;
12696 ffestp_file.print.print_spec[FFESTP_printixFORMAT].kw_present = FALSE;
12697 ffestp_file.print.print_spec[FFESTP_printixFORMAT].value_present = TRUE;
12698 ffestp_file.print.print_spec[FFESTP_printixFORMAT].value_is_label
12699 = (expr == NULL);
12700 ffestp_file.print.print_spec[FFESTP_printixFORMAT].value
12701 = ffelex_token_use (ft);
12702 ffestp_file.print.print_spec[FFESTP_printixFORMAT].u.expr = expr;
12703 if (!ffesta_is_inhibited ())
12704 ffestc_R911_start ();
12705 ffestb_subr_kill_print_ ();
12706 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
12707 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
12708 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R9112_);
12709 if (!ffesta_is_inhibited ())
12710 ffestc_R911_finish ();
12711 return (ffelexHandler) ffesta_zero (t);
12712
12713 default:
12714 break;
12715 }
12716
12717 ffestb_subr_kill_print_ ();
12718 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", t);
12719 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12720 }
12721
12722 /* ffestb_R9112_ -- "PRINT" expr COMMA expr
12723
12724 (ffestb_R9112_) // to expression handler
12725
12726 Handle COMMA or EOS/SEMICOLON here. */
12727
12728 static ffelexHandler
12729 ffestb_R9112_ (ffelexToken ft, ffebld expr, ffelexToken t)
12730 {
12731 switch (ffelex_token_type (t))
12732 {
12733 case FFELEX_typeCOMMA:
12734 if (expr == NULL)
12735 break;
12736 if (!ffesta_is_inhibited ())
12737 ffestc_R911_item (expr, ft);
12738 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
12739 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R9112_);
12740
12741 case FFELEX_typeEOS:
12742 case FFELEX_typeSEMICOLON:
12743 if (expr == NULL)
12744 break;
12745 if (!ffesta_is_inhibited ())
12746 {
12747 ffestc_R911_item (expr, ft);
12748 ffestc_R911_finish ();
12749 }
12750 return (ffelexHandler) ffesta_zero (t);
12751
12752 default:
12753 break;
12754 }
12755
12756 if (!ffesta_is_inhibited ())
12757 ffestc_R911_finish ();
12758 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", t);
12759 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12760 }
12761
12762 /* ffestb_R923 -- Parse an INQUIRE statement
12763
12764 return ffestb_R923; // to lexer
12765
12766 Make sure the statement has a valid form for an INQUIRE statement.
12767 If it does, implement the statement. */
12768
12769 ffelexHandler
12770 ffestb_R923 (ffelexToken t)
12771 {
12772 ffestpInquireIx ix;
12773
12774 switch (ffelex_token_type (ffesta_tokens[0]))
12775 {
12776 case FFELEX_typeNAME:
12777 if (ffesta_first_kw != FFESTR_firstINQUIRE)
12778 goto bad_0; /* :::::::::::::::::::: */
12779 break;
12780
12781 case FFELEX_typeNAMES:
12782 if (ffesta_first_kw != FFESTR_firstINQUIRE)
12783 goto bad_0; /* :::::::::::::::::::: */
12784 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlINQUIRE)
12785 goto bad_0; /* :::::::::::::::::::: */
12786 break;
12787
12788 default:
12789 goto bad_0; /* :::::::::::::::::::: */
12790 }
12791
12792 switch (ffelex_token_type (t))
12793 {
12794 case FFELEX_typeOPEN_PAREN:
12795 break;
12796
12797 case FFELEX_typeEOS:
12798 case FFELEX_typeSEMICOLON:
12799 case FFELEX_typeCOMMA:
12800 case FFELEX_typeCOLONCOLON:
12801 ffesta_confirmed (); /* Error, but clearly intended. */
12802 goto bad_1; /* :::::::::::::::::::: */
12803
12804 default:
12805 goto bad_1; /* :::::::::::::::::::: */
12806 }
12807
12808 for (ix = 0; ix < FFESTP_inquireix; ++ix)
12809 ffestp_file.inquire.inquire_spec[ix].kw_or_val_present = FALSE;
12810
12811 ffestb_local_.inquire.may_be_iolength = TRUE;
12812 return (ffelexHandler) ffestb_R9231_;
12813
12814 bad_0: /* :::::::::::::::::::: */
12815 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", ffesta_tokens[0]);
12816 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12817
12818 bad_1: /* :::::::::::::::::::: */
12819 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
12820 return (ffelexHandler) ffelex_swallow_tokens (t,
12821 (ffelexHandler) ffesta_zero); /* Invalid second token. */
12822 }
12823
12824 /* ffestb_R9231_ -- "INQUIRE" OPEN_PAREN
12825
12826 return ffestb_R9231_; // to lexer
12827
12828 Handle expr construct (not NAME=expr construct) here. */
12829
12830 static ffelexHandler
12831 ffestb_R9231_ (ffelexToken t)
12832 {
12833 switch (ffelex_token_type (t))
12834 {
12835 case FFELEX_typeNAME:
12836 ffesta_tokens[1] = ffelex_token_use (t);
12837 return (ffelexHandler) ffestb_R9232_;
12838
12839 default:
12840 ffestb_local_.inquire.may_be_iolength = FALSE;
12841 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
12842 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9233_)))
12843 (t);
12844 }
12845 }
12846
12847 /* ffestb_R9232_ -- "INQUIRE" OPEN_PAREN NAME
12848
12849 return ffestb_R9232_; // to lexer
12850
12851 If EQUALS here, go to states that handle it. Else, send NAME and this
12852 token thru expression handler. */
12853
12854 static ffelexHandler
12855 ffestb_R9232_ (ffelexToken t)
12856 {
12857 ffelexHandler next;
12858 ffelexToken nt;
12859
12860 switch (ffelex_token_type (t))
12861 {
12862 case FFELEX_typeEQUALS:
12863 nt = ffesta_tokens[1];
12864 next = (ffelexHandler) ffestb_R9234_ (nt);
12865 ffelex_token_kill (nt);
12866 return (ffelexHandler) (*next) (t);
12867
12868 default:
12869 ffestb_local_.inquire.may_be_iolength = FALSE;
12870 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
12871 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9233_)))
12872 (ffesta_tokens[1]);
12873 ffelex_token_kill (ffesta_tokens[1]);
12874 return (ffelexHandler) (*next) (t);
12875 }
12876 }
12877
12878 /* ffestb_R9233_ -- "INQUIRE" OPEN_PAREN expr
12879
12880 (ffestb_R9233_) // to expression handler
12881
12882 Handle COMMA or CLOSE_PAREN here. */
12883
12884 static ffelexHandler
12885 ffestb_R9233_ (ffelexToken ft, ffebld expr, ffelexToken t)
12886 {
12887 switch (ffelex_token_type (t))
12888 {
12889 case FFELEX_typeCOMMA:
12890 case FFELEX_typeCLOSE_PAREN:
12891 if (expr == NULL)
12892 break;
12893 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw_or_val_present
12894 = TRUE;
12895 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw_present = FALSE;
12896 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value_present = TRUE;
12897 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value_is_label
12898 = FALSE;
12899 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value
12900 = ffelex_token_use (ft);
12901 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].u.expr = expr;
12902 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
12903 return (ffelexHandler) ffestb_R9234_;
12904 return (ffelexHandler) ffestb_R9239_;
12905
12906 default:
12907 break;
12908 }
12909
12910 ffestb_subr_kill_inquire_ ();
12911 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
12912 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
12913 }
12914
12915 /* ffestb_R9234_ -- "INQUIRE" OPEN_PAREN [external-file-unit COMMA]
12916
12917 return ffestb_R9234_; // to lexer
12918
12919 Handle expr construct (not NAME=expr construct) here. */
12920
12921 static ffelexHandler
12922 ffestb_R9234_ (ffelexToken t)
12923 {
12924 ffestrInquire kw;
12925
12926 ffestb_local_.inquire.label = FALSE;
12927
12928 switch (ffelex_token_type (t))
12929 {
12930 case FFELEX_typeNAME:
12931 kw = ffestr_inquire (t);
12932 if (kw != FFESTR_inquireIOLENGTH)
12933 ffestb_local_.inquire.may_be_iolength = FALSE;
12934 switch (kw)
12935 {
12936 case FFESTR_inquireACCESS:
12937 ffestb_local_.inquire.ix = FFESTP_inquireixACCESS;
12938 ffestb_local_.inquire.left = TRUE;
12939 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
12940 break;
12941
12942 case FFESTR_inquireACTION:
12943 ffestb_local_.inquire.ix = FFESTP_inquireixACTION;
12944 ffestb_local_.inquire.left = TRUE;
12945 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
12946 break;
12947
12948 case FFESTR_inquireBLANK:
12949 ffestb_local_.inquire.ix = FFESTP_inquireixBLANK;
12950 ffestb_local_.inquire.left = TRUE;
12951 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
12952 break;
12953
12954 case FFESTR_inquireCARRIAGECONTROL:
12955 ffestb_local_.inquire.ix = FFESTP_inquireixCARRIAGECONTROL;
12956 ffestb_local_.inquire.left = TRUE;
12957 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
12958 break;
12959
12960 case FFESTR_inquireDEFAULTFILE:
12961 ffestb_local_.inquire.ix = FFESTP_inquireixDEFAULTFILE;
12962 ffestb_local_.inquire.left = FALSE;
12963 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
12964 break;
12965
12966 case FFESTR_inquireDELIM:
12967 ffestb_local_.inquire.ix = FFESTP_inquireixDELIM;
12968 ffestb_local_.inquire.left = TRUE;
12969 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
12970 break;
12971
12972 case FFESTR_inquireDIRECT:
12973 ffestb_local_.inquire.ix = FFESTP_inquireixDIRECT;
12974 ffestb_local_.inquire.left = TRUE;
12975 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
12976 break;
12977
12978 case FFESTR_inquireERR:
12979 ffestb_local_.inquire.ix = FFESTP_inquireixERR;
12980 ffestb_local_.inquire.label = TRUE;
12981 break;
12982
12983 case FFESTR_inquireEXIST:
12984 ffestb_local_.inquire.ix = FFESTP_inquireixEXIST;
12985 ffestb_local_.inquire.left = TRUE;
12986 ffestb_local_.inquire.context = FFEEXPR_contextFILELOG;
12987 break;
12988
12989 case FFESTR_inquireFILE:
12990 ffestb_local_.inquire.ix = FFESTP_inquireixFILE;
12991 ffestb_local_.inquire.left = FALSE;
12992 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
12993 break;
12994
12995 case FFESTR_inquireFORM:
12996 ffestb_local_.inquire.ix = FFESTP_inquireixFORM;
12997 ffestb_local_.inquire.left = TRUE;
12998 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
12999 break;
13000
13001 case FFESTR_inquireFORMATTED:
13002 ffestb_local_.inquire.ix = FFESTP_inquireixFORMATTED;
13003 ffestb_local_.inquire.left = TRUE;
13004 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
13005 break;
13006
13007 case FFESTR_inquireIOLENGTH:
13008 if (!ffestb_local_.inquire.may_be_iolength)
13009 goto bad; /* :::::::::::::::::::: */
13010 ffestb_local_.inquire.ix = FFESTP_inquireixIOLENGTH;
13011 ffestb_local_.inquire.left = TRUE;
13012 ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
13013 break;
13014
13015 case FFESTR_inquireIOSTAT:
13016 ffestb_local_.inquire.ix = FFESTP_inquireixIOSTAT;
13017 ffestb_local_.inquire.left = TRUE;
13018 ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
13019 break;
13020
13021 case FFESTR_inquireKEYED:
13022 ffestb_local_.inquire.ix = FFESTP_inquireixKEYED;
13023 ffestb_local_.inquire.left = TRUE;
13024 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
13025 break;
13026
13027 case FFESTR_inquireNAME:
13028 ffestb_local_.inquire.ix = FFESTP_inquireixNAME;
13029 ffestb_local_.inquire.left = TRUE;
13030 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
13031 break;
13032
13033 case FFESTR_inquireNAMED:
13034 ffestb_local_.inquire.ix = FFESTP_inquireixNAMED;
13035 ffestb_local_.inquire.left = TRUE;
13036 ffestb_local_.inquire.context = FFEEXPR_contextFILELOG;
13037 break;
13038
13039 case FFESTR_inquireNEXTREC:
13040 ffestb_local_.inquire.ix = FFESTP_inquireixNEXTREC;
13041 ffestb_local_.inquire.left = TRUE;
13042 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFINT;
13043 break;
13044
13045 case FFESTR_inquireNUMBER:
13046 ffestb_local_.inquire.ix = FFESTP_inquireixNUMBER;
13047 ffestb_local_.inquire.left = TRUE;
13048 ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
13049 break;
13050
13051 case FFESTR_inquireOPENED:
13052 ffestb_local_.inquire.ix = FFESTP_inquireixOPENED;
13053 ffestb_local_.inquire.left = TRUE;
13054 ffestb_local_.inquire.context = FFEEXPR_contextFILELOG;
13055 break;
13056
13057 case FFESTR_inquireORGANIZATION:
13058 ffestb_local_.inquire.ix = FFESTP_inquireixORGANIZATION;
13059 ffestb_local_.inquire.left = TRUE;
13060 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
13061 break;
13062
13063 case FFESTR_inquirePAD:
13064 ffestb_local_.inquire.ix = FFESTP_inquireixPAD;
13065 ffestb_local_.inquire.left = TRUE;
13066 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
13067 break;
13068
13069 case FFESTR_inquirePOSITION:
13070 ffestb_local_.inquire.ix = FFESTP_inquireixPOSITION;
13071 ffestb_local_.inquire.left = TRUE;
13072 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
13073 break;
13074
13075 case FFESTR_inquireREAD:
13076 ffestb_local_.inquire.ix = FFESTP_inquireixREAD;
13077 ffestb_local_.inquire.left = TRUE;
13078 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
13079 break;
13080
13081 case FFESTR_inquireREADWRITE:
13082 ffestb_local_.inquire.ix = FFESTP_inquireixREADWRITE;
13083 ffestb_local_.inquire.left = TRUE;
13084 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
13085 break;
13086
13087 case FFESTR_inquireRECL:
13088 ffestb_local_.inquire.ix = FFESTP_inquireixRECL;
13089 ffestb_local_.inquire.left = TRUE;
13090 ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
13091 break;
13092
13093 case FFESTR_inquireRECORDTYPE:
13094 ffestb_local_.inquire.ix = FFESTP_inquireixRECORDTYPE;
13095 ffestb_local_.inquire.left = TRUE;
13096 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
13097 break;
13098
13099 case FFESTR_inquireSEQUENTIAL:
13100 ffestb_local_.inquire.ix = FFESTP_inquireixSEQUENTIAL;
13101 ffestb_local_.inquire.left = TRUE;
13102 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
13103 break;
13104
13105 case FFESTR_inquireUNFORMATTED:
13106 ffestb_local_.inquire.ix = FFESTP_inquireixUNFORMATTED;
13107 ffestb_local_.inquire.left = TRUE;
13108 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
13109 break;
13110
13111 case FFESTR_inquireUNIT:
13112 ffestb_local_.inquire.ix = FFESTP_inquireixUNIT;
13113 ffestb_local_.inquire.left = FALSE;
13114 ffestb_local_.inquire.context = FFEEXPR_contextFILENUM;
13115 break;
13116
13117 default:
13118 goto bad; /* :::::::::::::::::::: */
13119 }
13120 if (ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
13121 .kw_or_val_present)
13122 break; /* Can't specify a keyword twice! */
13123 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
13124 .kw_or_val_present = TRUE;
13125 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
13126 .kw_present = TRUE;
13127 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
13128 .value_present = FALSE;
13129 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value_is_label
13130 = ffestb_local_.inquire.label;
13131 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].kw
13132 = ffelex_token_use (t);
13133 return (ffelexHandler) ffestb_R9235_;
13134
13135 default:
13136 break;
13137 }
13138
13139 bad: /* :::::::::::::::::::: */
13140 ffestb_subr_kill_inquire_ ();
13141 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
13142 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13143 }
13144
13145 /* ffestb_R9235_ -- "INQUIRE" OPEN_PAREN [external-file-unit COMMA] NAME
13146
13147 return ffestb_R9235_; // to lexer
13148
13149 Make sure EQUALS here, send next token to expression handler. */
13150
13151 static ffelexHandler
13152 ffestb_R9235_ (ffelexToken t)
13153 {
13154 switch (ffelex_token_type (t))
13155 {
13156 case FFELEX_typeEQUALS:
13157 ffesta_confirmed ();
13158 if (ffestb_local_.inquire.label)
13159 return (ffelexHandler) ffestb_R9237_;
13160 if (ffestb_local_.inquire.left)
13161 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
13162 ffestb_local_.inquire.context,
13163 (ffeexprCallback) ffestb_R9236_);
13164 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13165 ffestb_local_.inquire.context,
13166 (ffeexprCallback) ffestb_R9236_);
13167
13168 default:
13169 break;
13170 }
13171
13172 ffestb_subr_kill_inquire_ ();
13173 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
13174 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13175 }
13176
13177 /* ffestb_R9236_ -- "INQUIRE" OPEN_PAREN ... NAME EQUALS expr
13178
13179 (ffestb_R9236_) // to expression handler
13180
13181 Handle COMMA or CLOSE_PAREN here. */
13182
13183 static ffelexHandler
13184 ffestb_R9236_ (ffelexToken ft, ffebld expr, ffelexToken t)
13185 {
13186 switch (ffelex_token_type (t))
13187 {
13188 case FFELEX_typeCOMMA:
13189 if (ffestb_local_.inquire.ix == FFESTP_inquireixIOLENGTH)
13190 break; /* IOLENGTH=expr must be followed by
13191 CLOSE_PAREN. */
13192 /* Fall through. */
13193 case FFELEX_typeCLOSE_PAREN:
13194 if (expr == NULL)
13195 break;
13196 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value_present
13197 = TRUE;
13198 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value
13199 = ffelex_token_use (ft);
13200 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].u.expr = expr;
13201 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
13202 return (ffelexHandler) ffestb_R9234_;
13203 if (ffestb_local_.inquire.ix == FFESTP_inquireixIOLENGTH)
13204 return (ffelexHandler) ffestb_R92310_;
13205 return (ffelexHandler) ffestb_R9239_;
13206
13207 default:
13208 break;
13209 }
13210
13211 ffestb_subr_kill_inquire_ ();
13212 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
13213 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13214 }
13215
13216 /* ffestb_R9237_ -- "INQUIRE" OPEN_PAREN ... NAME EQUALS
13217
13218 return ffestb_R9237_; // to lexer
13219
13220 Handle NUMBER for label here. */
13221
13222 static ffelexHandler
13223 ffestb_R9237_ (ffelexToken t)
13224 {
13225 switch (ffelex_token_type (t))
13226 {
13227 case FFELEX_typeNUMBER:
13228 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value_present
13229 = TRUE;
13230 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value
13231 = ffelex_token_use (t);
13232 return (ffelexHandler) ffestb_R9238_;
13233
13234 default:
13235 break;
13236 }
13237
13238 ffestb_subr_kill_inquire_ ();
13239 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
13240 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13241 }
13242
13243 /* ffestb_R9238_ -- "INQUIRE" OPEN_PAREN ... NAME EQUALS NUMBER
13244
13245 return ffestb_R9238_; // to lexer
13246
13247 Handle COMMA or CLOSE_PAREN here. */
13248
13249 static ffelexHandler
13250 ffestb_R9238_ (ffelexToken t)
13251 {
13252 switch (ffelex_token_type (t))
13253 {
13254 case FFELEX_typeCOMMA:
13255 return (ffelexHandler) ffestb_R9234_;
13256
13257 case FFELEX_typeCLOSE_PAREN:
13258 return (ffelexHandler) ffestb_R9239_;
13259
13260 default:
13261 break;
13262 }
13263
13264 ffestb_subr_kill_inquire_ ();
13265 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
13266 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13267 }
13268
13269 /* ffestb_R9239_ -- "INQUIRE" OPEN_PAREN ... CLOSE_PAREN
13270
13271 return ffestb_R9239_; // to lexer
13272
13273 Handle EOS or SEMICOLON here. */
13274
13275 static ffelexHandler
13276 ffestb_R9239_ (ffelexToken t)
13277 {
13278 switch (ffelex_token_type (t))
13279 {
13280 case FFELEX_typeEOS:
13281 case FFELEX_typeSEMICOLON:
13282 ffesta_confirmed ();
13283 if (!ffesta_is_inhibited ())
13284 ffestc_R923A ();
13285 ffestb_subr_kill_inquire_ ();
13286 return (ffelexHandler) ffesta_zero (t);
13287
13288 default:
13289 break;
13290 }
13291
13292 ffestb_subr_kill_inquire_ ();
13293 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
13294 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13295 }
13296
13297 /* ffestb_R92310_ -- "INQUIRE(IOLENGTH=expr)"
13298
13299 return ffestb_R92310_; // to lexer
13300
13301 Make sure EOS or SEMICOLON not here; begin R923B processing and expect
13302 output IO list. */
13303
13304 static ffelexHandler
13305 ffestb_R92310_ (ffelexToken t)
13306 {
13307 switch (ffelex_token_type (t))
13308 {
13309 case FFELEX_typeEOS:
13310 case FFELEX_typeSEMICOLON:
13311 break;
13312
13313 default:
13314 ffesta_confirmed ();
13315 if (!ffesta_is_inhibited ())
13316 ffestc_R923B_start ();
13317 ffestb_subr_kill_inquire_ ();
13318 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13319 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R92311_)))
13320 (t);
13321 }
13322
13323 ffestb_subr_kill_inquire_ ();
13324 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
13325 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13326 }
13327
13328 /* ffestb_R92311_ -- "INQUIRE(IOLENGTH=expr)" expr
13329
13330 (ffestb_R92311_) // to expression handler
13331
13332 Handle COMMA or EOS/SEMICOLON here. */
13333
13334 static ffelexHandler
13335 ffestb_R92311_ (ffelexToken ft, ffebld expr, ffelexToken t)
13336 {
13337 switch (ffelex_token_type (t))
13338 {
13339 case FFELEX_typeCOMMA:
13340 if (expr == NULL)
13341 break;
13342 if (!ffesta_is_inhibited ())
13343 ffestc_R923B_item (expr, ft);
13344 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13345 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R92311_);
13346
13347 case FFELEX_typeEOS:
13348 case FFELEX_typeSEMICOLON:
13349 if (expr == NULL)
13350 break;
13351 if (!ffesta_is_inhibited ())
13352 {
13353 ffestc_R923B_item (expr, ft);
13354 ffestc_R923B_finish ();
13355 }
13356 return (ffelexHandler) ffesta_zero (t);
13357
13358 default:
13359 break;
13360 }
13361
13362 if (!ffesta_is_inhibited ())
13363 ffestc_R923B_finish ();
13364 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
13365 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13366 }
13367
13368 /* ffestb_V020 -- Parse the TYPE statement
13369
13370 return ffestb_V020; // to lexer
13371
13372 Make sure the statement has a valid form for the TYPE
13373 statement. If it does, implement the statement. */
13374
13375 ffelexHandler
13376 ffestb_V020 (ffelexToken t)
13377 {
13378 ffeTokenLength i;
13379 const char *p;
13380 ffelexHandler next;
13381 ffestpTypeIx ix;
13382
13383 switch (ffelex_token_type (ffesta_tokens[0]))
13384 {
13385 case FFELEX_typeNAME:
13386 if (ffesta_first_kw != FFESTR_firstTYPE)
13387 goto bad_0; /* :::::::::::::::::::: */
13388 switch (ffelex_token_type (t))
13389 {
13390 case FFELEX_typeCOLONCOLON:
13391 case FFELEX_typeEOS:
13392 case FFELEX_typeSEMICOLON:
13393 ffesta_confirmed (); /* Error, but clearly intended. */
13394 goto bad_1; /* :::::::::::::::::::: */
13395
13396 case FFELEX_typeEQUALS:
13397 case FFELEX_typePOINTS:
13398 case FFELEX_typeCOLON:
13399 case FFELEX_typeCOMMA: /* Because "TYPE,PUBLIC::A" is ambiguous with
13400 '90. */
13401 goto bad_1; /* :::::::::::::::::::: */
13402
13403 case FFELEX_typeNUMBER:
13404 ffesta_confirmed ();
13405 break;
13406
13407 case FFELEX_typeNAME: /* Because TYPE A is ambiguous with '90. */
13408 default:
13409 break;
13410 }
13411
13412 for (ix = 0; ix < FFESTP_typeix; ++ix)
13413 ffestp_file.type.type_spec[ix].kw_or_val_present = FALSE;
13414 return (ffelexHandler) (*((ffelexHandler)
13415 ffeexpr_rhs (ffesta_output_pool,
13416 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0201_)))
13417 (t);
13418
13419 case FFELEX_typeNAMES:
13420 if (ffesta_first_kw != FFESTR_firstTYPE)
13421 goto bad_0; /* :::::::::::::::::::: */
13422 switch (ffelex_token_type (t))
13423 {
13424 case FFELEX_typeEOS:
13425 case FFELEX_typeSEMICOLON:
13426 case FFELEX_typeCOMMA:
13427 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlTYPE)
13428 break;
13429 goto bad_1; /* :::::::::::::::::::: */
13430
13431 case FFELEX_typeCOLONCOLON:
13432 ffesta_confirmed (); /* Error, but clearly intended. */
13433 goto bad_1; /* :::::::::::::::::::: */
13434
13435 case FFELEX_typeOPEN_PAREN:
13436 if (ffelex_token_length (ffesta_tokens[0]) == FFESTR_firstlTYPE)
13437 break; /* Else might be assignment/stmtfuncdef. */
13438 goto bad_1; /* :::::::::::::::::::: */
13439
13440 case FFELEX_typeEQUALS:
13441 case FFELEX_typePOINTS:
13442 case FFELEX_typeCOLON:
13443 goto bad_1; /* :::::::::::::::::::: */
13444
13445 default:
13446 break;
13447 }
13448 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlTYPE);
13449 if (ISDIGIT (*p))
13450 ffesta_confirmed (); /* Else might be '90 TYPE statement. */
13451 for (ix = 0; ix < FFESTP_typeix; ++ix)
13452 ffestp_file.type.type_spec[ix].kw_or_val_present = FALSE;
13453 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13454 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0201_);
13455 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
13456 FFESTR_firstlTYPE);
13457 if (next == NULL)
13458 return (ffelexHandler) ffelex_swallow_tokens (t,
13459 (ffelexHandler) ffesta_zero);
13460 return (ffelexHandler) (*next) (t);
13461
13462 default:
13463 goto bad_0; /* :::::::::::::::::::: */
13464 }
13465
13466 bad_0: /* :::::::::::::::::::: */
13467 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", ffesta_tokens[0]);
13468 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13469
13470 bad_1: /* :::::::::::::::::::: */
13471 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", t);
13472 return (ffelexHandler) ffelex_swallow_tokens (t,
13473 (ffelexHandler) ffesta_zero); /* Invalid second token. */
13474 }
13475
13476 /* ffestb_V0201_ -- "TYPE" expr
13477
13478 (ffestb_V0201_) // to expression handler
13479
13480 Make sure the next token is a COMMA or EOS/SEMICOLON. */
13481
13482 static ffelexHandler
13483 ffestb_V0201_ (ffelexToken ft, ffebld expr, ffelexToken t)
13484 {
13485 bool comma = TRUE;
13486
13487 switch (ffelex_token_type (t))
13488 {
13489 case FFELEX_typeEOS:
13490 case FFELEX_typeSEMICOLON:
13491 if (!ffe_is_vxt () && (expr != NULL)
13492 && (ffebld_op (expr) == FFEBLD_opSYMTER))
13493 break;
13494 comma = FALSE;
13495 /* Fall through. */
13496 case FFELEX_typeCOMMA:
13497 if (!ffe_is_vxt () && comma && (expr != NULL)
13498 && (ffebld_op (expr) == FFEBLD_opPAREN)
13499 && (ffebld_op (ffebld_left (expr)) == FFEBLD_opSYMTER))
13500 break;
13501 ffesta_confirmed ();
13502 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].kw_or_val_present
13503 = TRUE;
13504 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].kw_present = FALSE;
13505 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].value_present = TRUE;
13506 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].value_is_label
13507 = (expr == NULL);
13508 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].value
13509 = ffelex_token_use (ft);
13510 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].u.expr = expr;
13511 if (!ffesta_is_inhibited ())
13512 ffestc_V020_start ();
13513 ffestb_subr_kill_type_ ();
13514 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
13515 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13516 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V0202_);
13517 if (!ffesta_is_inhibited ())
13518 ffestc_V020_finish ();
13519 return (ffelexHandler) ffesta_zero (t);
13520
13521 default:
13522 break;
13523 }
13524
13525 ffestb_subr_kill_type_ ();
13526 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", t);
13527 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13528 }
13529
13530 /* ffestb_V0202_ -- "TYPE" expr COMMA expr
13531
13532 (ffestb_V0202_) // to expression handler
13533
13534 Handle COMMA or EOS/SEMICOLON here. */
13535
13536 static ffelexHandler
13537 ffestb_V0202_ (ffelexToken ft, ffebld expr, ffelexToken t)
13538 {
13539 switch (ffelex_token_type (t))
13540 {
13541 case FFELEX_typeCOMMA:
13542 if (expr == NULL)
13543 break;
13544 if (!ffesta_is_inhibited ())
13545 ffestc_V020_item (expr, ft);
13546 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13547 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V0202_);
13548
13549 case FFELEX_typeEOS:
13550 case FFELEX_typeSEMICOLON:
13551 if (expr == NULL)
13552 break;
13553 if (!ffesta_is_inhibited ())
13554 {
13555 ffestc_V020_item (expr, ft);
13556 ffestc_V020_finish ();
13557 }
13558 return (ffelexHandler) ffesta_zero (t);
13559
13560 default:
13561 break;
13562 }
13563
13564 if (!ffesta_is_inhibited ())
13565 ffestc_V020_finish ();
13566 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", t);
13567 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13568 }
13569
13570 /* ffestb_dummy -- Parse an ENTRY/FUNCTION/SUBROUTINE statement
13571
13572 return ffestb_dummy; // to lexer
13573
13574 Make sure the statement has a valid form for an ENTRY/FUNCTION/SUBROUTINE
13575 statement. If it does, implement the statement. */
13576
13577 ffelexHandler
13578 ffestb_dummy (ffelexToken t)
13579 {
13580 ffeTokenLength i;
13581 unsigned const char *p;
13582
13583 switch (ffelex_token_type (ffesta_tokens[0]))
13584 {
13585 case FFELEX_typeNAME:
13586 switch (ffelex_token_type (t))
13587 {
13588 case FFELEX_typeEOS:
13589 case FFELEX_typeSEMICOLON:
13590 case FFELEX_typeCOMMA:
13591 case FFELEX_typeCOLONCOLON:
13592 ffesta_confirmed (); /* Error, but clearly intended. */
13593 goto bad_1; /* :::::::::::::::::::: */
13594
13595 default:
13596 goto bad_1; /* :::::::::::::::::::: */
13597
13598 case FFELEX_typeNAME:
13599 break;
13600 }
13601
13602 ffesta_confirmed ();
13603 ffesta_tokens[1] = ffelex_token_use (t);
13604 ffestb_local_.decl.recursive = NULL;
13605 ffestb_local_.dummy.badname = ffestb_args.dummy.badname;
13606 ffestb_local_.dummy.is_subr = ffestb_args.dummy.is_subr;
13607 ffestb_local_.dummy.first_kw = ffesta_first_kw;
13608 return (ffelexHandler) ffestb_dummy1_;
13609
13610 case FFELEX_typeNAMES:
13611 switch (ffelex_token_type (t))
13612 {
13613 case FFELEX_typeCOMMA:
13614 case FFELEX_typeCOLONCOLON:
13615 ffesta_confirmed (); /* Error, but clearly intended. */
13616 goto bad_1; /* :::::::::::::::::::: */
13617
13618 default:
13619 goto bad_1; /* :::::::::::::::::::: */
13620
13621 case FFELEX_typeEOS:
13622 case FFELEX_typeSEMICOLON:
13623 ffesta_confirmed ();
13624 break;
13625
13626 case FFELEX_typeOPEN_PAREN:
13627 break;
13628 }
13629 p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.dummy.len);
13630 if (!ffesrc_is_name_init (*p))
13631 goto bad_i; /* :::::::::::::::::::: */
13632 ffesta_tokens[1]
13633 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
13634 ffestb_local_.decl.recursive = NULL;
13635 ffestb_local_.dummy.badname = ffestb_args.dummy.badname;
13636 ffestb_local_.dummy.is_subr = ffestb_args.dummy.is_subr;
13637 ffestb_local_.dummy.first_kw = ffesta_first_kw;
13638 return (ffelexHandler) ffestb_dummy1_ (t);
13639
13640 default:
13641 goto bad_0; /* :::::::::::::::::::: */
13642 }
13643
13644 bad_0: /* :::::::::::::::::::: */
13645 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dummy.badname, ffesta_tokens[0]);
13646 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13647
13648 bad_1: /* :::::::::::::::::::: */
13649 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dummy.badname, t);
13650 return (ffelexHandler) ffelex_swallow_tokens (t,
13651 (ffelexHandler) ffesta_zero); /* Invalid second token. */
13652
13653 bad_i: /* :::::::::::::::::::: */
13654 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.dummy.badname, ffesta_tokens[0], i, t);
13655 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13656 }
13657
13658 /* ffestb_dummy1_ -- "ENTRY/FUNCTION/SUBROUTINE" NAME
13659
13660 return ffestb_dummy1_; // to lexer
13661
13662 Make sure the next token is an EOS, SEMICOLON, or OPEN_PAREN. In the
13663 former case, just implement a null arg list, else get the arg list and
13664 then implement. */
13665
13666 static ffelexHandler
13667 ffestb_dummy1_ (ffelexToken t)
13668 {
13669 switch (ffelex_token_type (t))
13670 {
13671 case FFELEX_typeEOS:
13672 case FFELEX_typeSEMICOLON:
13673 if (ffestb_local_.dummy.first_kw == FFESTR_firstFUNCTION)
13674 {
13675 ffesta_confirmed (); /* Later, not if typename w/o RECURSIVE. */
13676 break; /* Produce an error message, need that open
13677 paren. */
13678 }
13679 ffesta_confirmed ();
13680 if (!ffesta_is_inhibited ())
13681 { /* Pretend as though we got a truly NULL
13682 list. */
13683 ffestb_subrargs_.name_list.args = NULL;
13684 ffestb_subrargs_.name_list.ok = TRUE;
13685 ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
13686 return (ffelexHandler) ffestb_dummy2_ (t);
13687 }
13688 if (ffestb_local_.decl.recursive != NULL)
13689 ffelex_token_kill (ffestb_local_.decl.recursive);
13690 ffelex_token_kill (ffesta_tokens[1]);
13691 return (ffelexHandler) ffesta_zero (t);
13692
13693 case FFELEX_typeOPEN_PAREN:
13694 ffestb_subrargs_.name_list.args = ffestt_tokenlist_create ();
13695 ffestb_subrargs_.name_list.handler = (ffelexHandler) ffestb_dummy2_;
13696 ffestb_subrargs_.name_list.is_subr = ffestb_local_.dummy.is_subr;
13697 ffestb_subrargs_.name_list.names = FALSE;
13698 return (ffelexHandler) ffestb_subr_name_list_;
13699
13700 default:
13701 break;
13702 }
13703
13704 if (ffestb_local_.decl.recursive != NULL)
13705 ffelex_token_kill (ffestb_local_.decl.recursive);
13706 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_local_.dummy.badname, t);
13707 ffelex_token_kill (ffesta_tokens[1]);
13708 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13709 }
13710
13711 /* ffestb_dummy2_ -- <dummy-keyword> NAME OPEN_PAREN arg-list CLOSE_PAREN
13712
13713 return ffestb_dummy2_; // to lexer
13714
13715 Make sure the statement has a valid form for a dummy-def statement. If it
13716 does, implement the statement. */
13717
13718 static ffelexHandler
13719 ffestb_dummy2_ (ffelexToken t)
13720 {
13721 if (!ffestb_subrargs_.name_list.ok)
13722 goto bad; /* :::::::::::::::::::: */
13723
13724 switch (ffelex_token_type (t))
13725 {
13726 case FFELEX_typeEOS:
13727 case FFELEX_typeSEMICOLON:
13728 ffesta_confirmed ();
13729 if (!ffesta_is_inhibited ())
13730 {
13731 switch (ffestb_local_.dummy.first_kw)
13732 {
13733 case FFESTR_firstFUNCTION:
13734 ffestc_R1219 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
13735 ffestb_subrargs_.name_list.close_paren, FFESTP_typeNone,
13736 NULL, NULL, NULL, NULL, ffestb_local_.decl.recursive, NULL);
13737 break;
13738
13739 case FFESTR_firstSUBROUTINE:
13740 ffestc_R1223 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
13741 ffestb_subrargs_.name_list.close_paren,
13742 ffestb_local_.decl.recursive);
13743 break;
13744
13745 case FFESTR_firstENTRY:
13746 ffestc_R1226 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
13747 ffestb_subrargs_.name_list.close_paren);
13748 break;
13749
13750 default:
13751 assert (FALSE);
13752 }
13753 }
13754 ffelex_token_kill (ffesta_tokens[1]);
13755 if (ffestb_local_.decl.recursive != NULL)
13756 ffelex_token_kill (ffestb_local_.decl.recursive);
13757 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
13758 if (ffestb_subrargs_.name_list.args != NULL)
13759 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
13760 return (ffelexHandler) ffesta_zero (t);
13761
13762 case FFELEX_typeNAME:
13763 ffesta_confirmed ();
13764 if ((ffestb_local_.dummy.first_kw != FFESTR_firstFUNCTION)
13765 || (ffestr_other (t) != FFESTR_otherRESULT))
13766 break;
13767 ffestb_local_.decl.type = FFESTP_typeNone;
13768 ffestb_local_.decl.kind = NULL;
13769 ffestb_local_.decl.kindt = NULL;
13770 ffestb_local_.decl.len = NULL;
13771 ffestb_local_.decl.lent = NULL;
13772 return (ffelexHandler) ffestb_decl_funcname_6_;
13773
13774 default:
13775 break;
13776 }
13777
13778 bad: /* :::::::::::::::::::: */
13779 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_local_.dummy.badname, t);
13780 ffelex_token_kill (ffesta_tokens[1]);
13781 if (ffestb_local_.decl.recursive != NULL)
13782 ffelex_token_kill (ffestb_local_.decl.recursive);
13783 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
13784 if (ffestb_subrargs_.name_list.args != NULL)
13785 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
13786 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13787 }
13788
13789 /* ffestb_R524 -- Parse the DIMENSION statement
13790
13791 return ffestb_R524; // to lexer
13792
13793 Make sure the statement has a valid form for the DIMENSION statement. If
13794 it does, implement the statement. */
13795
13796 ffelexHandler
13797 ffestb_R524 (ffelexToken t)
13798 {
13799 ffeTokenLength i;
13800 unsigned const char *p;
13801 ffelexToken nt;
13802 ffelexHandler next;
13803
13804 switch (ffelex_token_type (ffesta_tokens[0]))
13805 {
13806 case FFELEX_typeNAME:
13807 switch (ffelex_token_type (t))
13808 {
13809 case FFELEX_typeCOMMA:
13810 case FFELEX_typeCOLONCOLON:
13811 case FFELEX_typeEOS:
13812 case FFELEX_typeSEMICOLON:
13813 ffesta_confirmed (); /* Error, but clearly intended. */
13814 goto bad_1; /* :::::::::::::::::::: */
13815
13816 default:
13817 goto bad_1; /* :::::::::::::::::::: */
13818
13819 case FFELEX_typeNAME:
13820 ffesta_confirmed ();
13821 if (!ffesta_is_inhibited ())
13822 ffestc_R524_start (ffesta_first_kw == FFESTR_firstVIRTUAL);
13823 ffestb_local_.dimension.started = TRUE;
13824 return (ffelexHandler) ffestb_R5241_ (t);
13825 }
13826
13827 case FFELEX_typeNAMES:
13828 p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.R524.len);
13829 switch (ffelex_token_type (t))
13830 {
13831 default:
13832 goto bad_1; /* :::::::::::::::::::: */
13833
13834 case FFELEX_typeEOS:
13835 case FFELEX_typeSEMICOLON:
13836 case FFELEX_typeCOMMA:
13837 case FFELEX_typeCOLONCOLON:
13838 ffesta_confirmed ();
13839 goto bad_1; /* :::::::::::::::::::: */
13840
13841 case FFELEX_typeOPEN_PAREN:
13842 break;
13843 }
13844
13845 /* Here, we have at least one char after "DIMENSION" and t is
13846 OPEN_PAREN. */
13847
13848 if (!ffesrc_is_name_init (*p))
13849 goto bad_i; /* :::::::::::::::::::: */
13850 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
13851 ffestb_local_.dimension.started = FALSE;
13852 next = (ffelexHandler) ffestb_R5241_ (nt);
13853 ffelex_token_kill (nt);
13854 return (ffelexHandler) (*next) (t);
13855
13856 default:
13857 goto bad_0; /* :::::::::::::::::::: */
13858 }
13859
13860 bad_0: /* :::::::::::::::::::: */
13861 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, ffesta_tokens[0]);
13862 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13863
13864 bad_1: /* :::::::::::::::::::: */
13865 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
13866 return (ffelexHandler) ffelex_swallow_tokens (t,
13867 (ffelexHandler) ffesta_zero); /* Invalid second token. */
13868
13869 bad_i: /* :::::::::::::::::::: */
13870 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, ffesta_tokens[0], i, t);
13871 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13872 }
13873
13874 /* ffestb_R5241_ -- "DIMENSION"
13875
13876 return ffestb_R5241_; // to lexer
13877
13878 Handle NAME. */
13879
13880 static ffelexHandler
13881 ffestb_R5241_ (ffelexToken t)
13882 {
13883 switch (ffelex_token_type (t))
13884 {
13885 case FFELEX_typeNAME:
13886 ffesta_tokens[1] = ffelex_token_use (t);
13887 return (ffelexHandler) ffestb_R5242_;
13888
13889 default:
13890 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
13891 break;
13892 }
13893
13894 if (!ffesta_is_inhibited ())
13895 ffestc_R524_finish ();
13896 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13897 }
13898
13899 /* ffestb_R5242_ -- "DIMENSION" ... NAME
13900
13901 return ffestb_R5242_; // to lexer
13902
13903 Handle OPEN_PAREN. */
13904
13905 static ffelexHandler
13906 ffestb_R5242_ (ffelexToken t)
13907 {
13908 switch (ffelex_token_type (t))
13909 {
13910 case FFELEX_typeOPEN_PAREN:
13911 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
13912 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_R5243_;
13913 ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
13914 ffestb_subrargs_.dim_list.ctx = ffesta_is_entry_valid
13915 ? FFEEXPR_contextDIMLIST : FFEEXPR_contextDIMLISTCOMMON;
13916 #ifdef FFECOM_dimensionsMAX
13917 ffestb_subrargs_.dim_list.ndims = 0;
13918 #endif
13919 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
13920 ffestb_subrargs_.dim_list.ctx,
13921 (ffeexprCallback) ffestb_subr_dimlist_);
13922
13923 default:
13924 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
13925 break;
13926 }
13927
13928 if (!ffesta_is_inhibited ())
13929 ffestc_R524_finish ();
13930 ffelex_token_kill (ffesta_tokens[1]);
13931 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13932 }
13933
13934 /* ffestb_R5243_ -- "DIMENSION" ... NAME OPEN_PAREN dimlist CLOSE_PAREN
13935
13936 return ffestb_R5243_; // to lexer
13937
13938 Handle COMMA or EOS/SEMICOLON. */
13939
13940 static ffelexHandler
13941 ffestb_R5243_ (ffelexToken t)
13942 {
13943 if (!ffestb_subrargs_.dim_list.ok)
13944 goto bad; /* :::::::::::::::::::: */
13945
13946 switch (ffelex_token_type (t))
13947 {
13948 case FFELEX_typeCOMMA:
13949 ffesta_confirmed ();
13950 if (!ffesta_is_inhibited ())
13951 {
13952 if (!ffestb_local_.dimension.started)
13953 {
13954 ffestc_R524_start (ffesta_first_kw == FFESTR_firstVIRTUAL);
13955 ffestb_local_.dimension.started = TRUE;
13956 }
13957 ffestc_R524_item (ffesta_tokens[1],
13958 ffestb_subrargs_.dim_list.dims);
13959 }
13960 ffelex_token_kill (ffesta_tokens[1]);
13961 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
13962 return (ffelexHandler) ffestb_R5244_;
13963
13964 case FFELEX_typeEOS:
13965 case FFELEX_typeSEMICOLON:
13966 ffesta_confirmed ();
13967 if (!ffesta_is_inhibited ())
13968 {
13969 if (!ffestb_local_.dimension.started)
13970 {
13971 ffestc_R524_start (ffesta_first_kw == FFESTR_firstVIRTUAL);
13972 ffestb_local_.dimension.started = TRUE;
13973 }
13974 ffestc_R524_item (ffesta_tokens[1],
13975 ffestb_subrargs_.dim_list.dims);
13976 ffestc_R524_finish ();
13977 }
13978 ffelex_token_kill (ffesta_tokens[1]);
13979 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
13980 return (ffelexHandler) ffesta_zero (t);
13981
13982 default:
13983 break;
13984 }
13985
13986 bad: /* :::::::::::::::::::: */
13987 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
13988 if (ffestb_local_.dimension.started && !ffesta_is_inhibited ())
13989 ffestc_R524_finish ();
13990 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
13991 ffelex_token_kill (ffesta_tokens[1]);
13992 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
13993 }
13994
13995 /* ffestb_R5244_ -- "DIMENSION" ... COMMA
13996
13997 return ffestb_R5244_; // to lexer
13998
13999 Make sure we don't have EOS or SEMICOLON. */
14000
14001 static ffelexHandler
14002 ffestb_R5244_ (ffelexToken t)
14003 {
14004 switch (ffelex_token_type (t))
14005 {
14006 case FFELEX_typeEOS:
14007 case FFELEX_typeSEMICOLON:
14008 if (!ffesta_is_inhibited ())
14009 ffestc_R524_finish ();
14010 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
14011 return (ffelexHandler) ffesta_zero (t);
14012
14013 default:
14014 return (ffelexHandler) ffestb_R5241_ (t);
14015 }
14016 }
14017
14018 /* ffestb_R547 -- Parse the COMMON statement
14019
14020 return ffestb_R547; // to lexer
14021
14022 Make sure the statement has a valid form for the COMMON statement. If it
14023 does, implement the statement. */
14024
14025 ffelexHandler
14026 ffestb_R547 (ffelexToken t)
14027 {
14028 ffeTokenLength i;
14029 unsigned const char *p;
14030 ffelexToken nt;
14031 ffelexHandler next;
14032
14033 switch (ffelex_token_type (ffesta_tokens[0]))
14034 {
14035 case FFELEX_typeNAME:
14036 if (ffesta_first_kw != FFESTR_firstCOMMON)
14037 goto bad_0; /* :::::::::::::::::::: */
14038 switch (ffelex_token_type (t))
14039 {
14040 case FFELEX_typeCOMMA:
14041 case FFELEX_typeCOLONCOLON:
14042 case FFELEX_typeEOS:
14043 case FFELEX_typeSEMICOLON:
14044 ffesta_confirmed (); /* Error, but clearly intended. */
14045 goto bad_1; /* :::::::::::::::::::: */
14046
14047 default:
14048 goto bad_1; /* :::::::::::::::::::: */
14049
14050 case FFELEX_typeNAME:
14051 case FFELEX_typeSLASH:
14052 case FFELEX_typeCONCAT:
14053 ffesta_confirmed ();
14054 if (!ffesta_is_inhibited ())
14055 ffestc_R547_start ();
14056 ffestb_local_.common.started = TRUE;
14057 return (ffelexHandler) ffestb_R5471_ (t);
14058 }
14059
14060 case FFELEX_typeNAMES:
14061 if (ffesta_first_kw != FFESTR_firstCOMMON)
14062 goto bad_0; /* :::::::::::::::::::: */
14063 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCOMMON);
14064 switch (ffelex_token_type (t))
14065 {
14066 default:
14067 goto bad_1; /* :::::::::::::::::::: */
14068
14069 case FFELEX_typeEOS:
14070 case FFELEX_typeSEMICOLON:
14071 case FFELEX_typeCOMMA:
14072 case FFELEX_typeCOLONCOLON:
14073 ffesta_confirmed ();
14074 break;
14075
14076 case FFELEX_typeSLASH:
14077 case FFELEX_typeCONCAT:
14078 ffesta_confirmed ();
14079 if (*p != '\0')
14080 break;
14081 if (!ffesta_is_inhibited ())
14082 ffestc_R547_start ();
14083 ffestb_local_.common.started = TRUE;
14084 return (ffelexHandler) ffestb_R5471_ (t);
14085
14086 case FFELEX_typeOPEN_PAREN:
14087 break;
14088 }
14089
14090 /* Here, we have at least one char after "COMMON" and t is COMMA,
14091 EOS/SEMICOLON, OPEN_PAREN, SLASH, or CONCAT. */
14092
14093 if (!ffesrc_is_name_init (*p))
14094 goto bad_i; /* :::::::::::::::::::: */
14095 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
14096 if (ffelex_token_type (t) == FFELEX_typeOPEN_PAREN)
14097 ffestb_local_.common.started = FALSE;
14098 else
14099 {
14100 if (!ffesta_is_inhibited ())
14101 ffestc_R547_start ();
14102 ffestb_local_.common.started = TRUE;
14103 }
14104 next = (ffelexHandler) ffestb_R5471_ (nt);
14105 ffelex_token_kill (nt);
14106 return (ffelexHandler) (*next) (t);
14107
14108 default:
14109 goto bad_0; /* :::::::::::::::::::: */
14110 }
14111
14112 bad_0: /* :::::::::::::::::::: */
14113 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", ffesta_tokens[0]);
14114 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14115
14116 bad_1: /* :::::::::::::::::::: */
14117 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
14118 return (ffelexHandler) ffelex_swallow_tokens (t,
14119 (ffelexHandler) ffesta_zero); /* Invalid second token. */
14120
14121 bad_i: /* :::::::::::::::::::: */
14122 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "COMMON", ffesta_tokens[0], i, t);
14123 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14124 }
14125
14126 /* ffestb_R5471_ -- "COMMON"
14127
14128 return ffestb_R5471_; // to lexer
14129
14130 Handle NAME, SLASH, or CONCAT. */
14131
14132 static ffelexHandler
14133 ffestb_R5471_ (ffelexToken t)
14134 {
14135 switch (ffelex_token_type (t))
14136 {
14137 case FFELEX_typeNAME:
14138 return (ffelexHandler) ffestb_R5474_ (t);
14139
14140 case FFELEX_typeSLASH:
14141 return (ffelexHandler) ffestb_R5472_;
14142
14143 case FFELEX_typeCONCAT:
14144 if (!ffesta_is_inhibited ())
14145 ffestc_R547_item_cblock (NULL);
14146 return (ffelexHandler) ffestb_R5474_;
14147
14148 default:
14149 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
14150 break;
14151 }
14152
14153 if (!ffesta_is_inhibited ())
14154 ffestc_R547_finish ();
14155 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14156 }
14157
14158 /* ffestb_R5472_ -- "COMMON" SLASH
14159
14160 return ffestb_R5472_; // to lexer
14161
14162 Handle NAME. */
14163
14164 static ffelexHandler
14165 ffestb_R5472_ (ffelexToken t)
14166 {
14167 switch (ffelex_token_type (t))
14168 {
14169 case FFELEX_typeNAME:
14170 ffesta_tokens[1] = ffelex_token_use (t);
14171 return (ffelexHandler) ffestb_R5473_;
14172
14173 case FFELEX_typeSLASH:
14174 if (!ffesta_is_inhibited ())
14175 ffestc_R547_item_cblock (NULL);
14176 return (ffelexHandler) ffestb_R5474_;
14177
14178 default:
14179 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
14180 break;
14181 }
14182
14183 if (!ffesta_is_inhibited ())
14184 ffestc_R547_finish ();
14185 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14186 }
14187
14188 /* ffestb_R5473_ -- "COMMON" SLASH NAME
14189
14190 return ffestb_R5473_; // to lexer
14191
14192 Handle SLASH. */
14193
14194 static ffelexHandler
14195 ffestb_R5473_ (ffelexToken t)
14196 {
14197 switch (ffelex_token_type (t))
14198 {
14199 case FFELEX_typeSLASH:
14200 if (!ffesta_is_inhibited ())
14201 ffestc_R547_item_cblock (ffesta_tokens[1]);
14202 ffelex_token_kill (ffesta_tokens[1]);
14203 return (ffelexHandler) ffestb_R5474_;
14204
14205 default:
14206 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
14207 break;
14208 }
14209
14210 if (!ffesta_is_inhibited ())
14211 ffestc_R547_finish ();
14212 ffelex_token_kill (ffesta_tokens[1]);
14213 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14214 }
14215
14216 /* ffestb_R5474_ -- "COMMON" [SLASH NAME SLASH] or "COMMON" CONCAT
14217
14218 return ffestb_R5474_; // to lexer
14219
14220 Handle NAME. */
14221
14222 static ffelexHandler
14223 ffestb_R5474_ (ffelexToken t)
14224 {
14225 switch (ffelex_token_type (t))
14226 {
14227 case FFELEX_typeNAME:
14228 ffesta_tokens[1] = ffelex_token_use (t);
14229 return (ffelexHandler) ffestb_R5475_;
14230
14231 default:
14232 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
14233 break;
14234 }
14235
14236 if (!ffesta_is_inhibited ())
14237 ffestc_R547_finish ();
14238 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14239 }
14240
14241 /* ffestb_R5475_ -- "COMMON" ... NAME
14242
14243 return ffestb_R5475_; // to lexer
14244
14245 Handle OPEN_PAREN. */
14246
14247 static ffelexHandler
14248 ffestb_R5475_ (ffelexToken t)
14249 {
14250 switch (ffelex_token_type (t))
14251 {
14252 case FFELEX_typeOPEN_PAREN:
14253 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
14254 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_R5476_;
14255 ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
14256 ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLISTCOMMON;
14257 #ifdef FFECOM_dimensionsMAX
14258 ffestb_subrargs_.dim_list.ndims = 0;
14259 #endif
14260 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
14261 FFEEXPR_contextDIMLISTCOMMON, (ffeexprCallback) ffestb_subr_dimlist_);
14262
14263 case FFELEX_typeCOMMA:
14264 if (!ffesta_is_inhibited ())
14265 ffestc_R547_item_object (ffesta_tokens[1], NULL);
14266 ffelex_token_kill (ffesta_tokens[1]);
14267 return (ffelexHandler) ffestb_R5477_;
14268
14269 case FFELEX_typeSLASH:
14270 case FFELEX_typeCONCAT:
14271 if (!ffesta_is_inhibited ())
14272 ffestc_R547_item_object (ffesta_tokens[1], NULL);
14273 ffelex_token_kill (ffesta_tokens[1]);
14274 return (ffelexHandler) ffestb_R5471_ (t);
14275
14276 case FFELEX_typeEOS:
14277 case FFELEX_typeSEMICOLON:
14278 if (!ffesta_is_inhibited ())
14279 {
14280 ffestc_R547_item_object (ffesta_tokens[1], NULL);
14281 ffestc_R547_finish ();
14282 }
14283 ffelex_token_kill (ffesta_tokens[1]);
14284 return (ffelexHandler) ffesta_zero (t);
14285
14286 default:
14287 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
14288 break;
14289 }
14290
14291 if (!ffesta_is_inhibited ())
14292 ffestc_R547_finish ();
14293 ffelex_token_kill (ffesta_tokens[1]);
14294 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14295 }
14296
14297 /* ffestb_R5476_ -- "COMMON" ... NAME OPEN_PAREN dimlist CLOSE_PAREN
14298
14299 return ffestb_R5476_; // to lexer
14300
14301 Handle COMMA, SLASH, CONCAT, EOS/SEMICOLON. */
14302
14303 static ffelexHandler
14304 ffestb_R5476_ (ffelexToken t)
14305 {
14306 if (!ffestb_subrargs_.dim_list.ok)
14307 goto bad; /* :::::::::::::::::::: */
14308
14309 switch (ffelex_token_type (t))
14310 {
14311 case FFELEX_typeCOMMA:
14312 ffesta_confirmed ();
14313 if (!ffesta_is_inhibited ())
14314 {
14315 if (!ffestb_local_.common.started)
14316 {
14317 ffestc_R547_start ();
14318 ffestb_local_.common.started = TRUE;
14319 }
14320 ffestc_R547_item_object (ffesta_tokens[1],
14321 ffestb_subrargs_.dim_list.dims);
14322 }
14323 ffelex_token_kill (ffesta_tokens[1]);
14324 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
14325 return (ffelexHandler) ffestb_R5477_;
14326
14327 case FFELEX_typeSLASH:
14328 case FFELEX_typeCONCAT:
14329 ffesta_confirmed ();
14330 if (!ffesta_is_inhibited ())
14331 {
14332 if (!ffestb_local_.common.started)
14333 {
14334 ffestc_R547_start ();
14335 ffestb_local_.common.started = TRUE;
14336 }
14337 ffestc_R547_item_object (ffesta_tokens[1],
14338 ffestb_subrargs_.dim_list.dims);
14339 }
14340 ffelex_token_kill (ffesta_tokens[1]);
14341 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
14342 return (ffelexHandler) ffestb_R5471_ (t);
14343
14344 case FFELEX_typeEOS:
14345 case FFELEX_typeSEMICOLON:
14346 ffesta_confirmed ();
14347 if (!ffesta_is_inhibited ())
14348 {
14349 if (!ffestb_local_.common.started)
14350 ffestc_R547_start ();
14351 ffestc_R547_item_object (ffesta_tokens[1],
14352 ffestb_subrargs_.dim_list.dims);
14353 ffestc_R547_finish ();
14354 }
14355 ffelex_token_kill (ffesta_tokens[1]);
14356 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
14357 return (ffelexHandler) ffesta_zero (t);
14358
14359 default:
14360 break;
14361 }
14362
14363 bad: /* :::::::::::::::::::: */
14364 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
14365 if (ffestb_local_.common.started && !ffesta_is_inhibited ())
14366 ffestc_R547_finish ();
14367 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
14368 ffelex_token_kill (ffesta_tokens[1]);
14369 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14370 }
14371
14372 /* ffestb_R5477_ -- "COMMON" ... COMMA
14373
14374 return ffestb_R5477_; // to lexer
14375
14376 Make sure we don't have EOS or SEMICOLON. */
14377
14378 static ffelexHandler
14379 ffestb_R5477_ (ffelexToken t)
14380 {
14381 switch (ffelex_token_type (t))
14382 {
14383 case FFELEX_typeEOS:
14384 case FFELEX_typeSEMICOLON:
14385 if (!ffesta_is_inhibited ())
14386 ffestc_R547_finish ();
14387 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
14388 return (ffelexHandler) ffesta_zero (t);
14389
14390 default:
14391 return (ffelexHandler) ffestb_R5471_ (t);
14392 }
14393 }
14394
14395 /* ffestb_R1229 -- Parse a STMTFUNCTION statement
14396
14397 return ffestb_R1229; // to lexer
14398
14399 Make sure the statement has a valid form for a STMTFUNCTION
14400 statement. If it does, implement the statement. */
14401
14402 ffelexHandler
14403 ffestb_R1229 (ffelexToken t)
14404 {
14405 switch (ffelex_token_type (ffesta_tokens[0]))
14406 {
14407 case FFELEX_typeNAME:
14408 case FFELEX_typeNAMES:
14409 break;
14410
14411 default:
14412 goto bad_0; /* :::::::::::::::::::: */
14413 }
14414
14415 switch (ffelex_token_type (t))
14416 {
14417 case FFELEX_typeOPEN_PAREN:
14418 break;
14419
14420 case FFELEX_typeEOS:
14421 case FFELEX_typeSEMICOLON:
14422 case FFELEX_typeCOMMA:
14423 case FFELEX_typeCOLONCOLON:
14424 case FFELEX_typeNAME:
14425 ffesta_confirmed (); /* Error, but clearly intended. */
14426 goto bad_1; /* :::::::::::::::::::: */
14427
14428 default:
14429 goto bad_1; /* :::::::::::::::::::: */
14430 }
14431
14432 ffestb_subrargs_.name_list.args = ffestt_tokenlist_create ();
14433 ffestb_subrargs_.name_list.handler = (ffelexHandler) ffestb_R12291_;
14434 ffestb_subrargs_.name_list.is_subr = FALSE; /* No "*" items in list! */
14435 ffestb_subrargs_.name_list.names = TRUE; /* In case "IF(FOO)CALL
14436 FOO...". */
14437 return (ffelexHandler) ffestb_subr_name_list_;
14438
14439 bad_0: /* :::::::::::::::::::: */
14440 bad_1: /* :::::::::::::::::::: */
14441 ffesta_ffebad_2t (FFEBAD_UNREC_STMT, ffesta_tokens[0], t);
14442 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14443 }
14444
14445 /* ffestb_R12291_ -- "STMTFUNCTION" OPEN_PAREN dummy-name-list CLOSE_PAREN
14446
14447 return ffestb_R12291_; // to lexer
14448
14449 Make sure the statement has a valid form for a STMTFUNCTION statement. If
14450 it does, implement the statement. */
14451
14452 static ffelexHandler
14453 ffestb_R12291_ (ffelexToken t)
14454 {
14455 ffelex_set_names (FALSE);
14456
14457 if (!ffestb_subrargs_.name_list.ok)
14458 goto bad; /* :::::::::::::::::::: */
14459
14460 switch (ffelex_token_type (t))
14461 {
14462 case FFELEX_typeEQUALS:
14463 ffesta_confirmed ();
14464 if (!ffesta_is_inhibited ())
14465 ffestc_R1229_start (ffesta_tokens[0],
14466 ffestb_subrargs_.name_list.args,
14467 ffestb_subrargs_.name_list.close_paren);
14468 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
14469 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
14470 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
14471 FFEEXPR_contextSFUNCDEF, (ffeexprCallback) ffestb_R12292_);
14472
14473 default:
14474 break;
14475 }
14476
14477 bad: /* :::::::::::::::::::: */
14478 ffesta_ffebad_2t (FFEBAD_UNREC_STMT, ffesta_tokens[0], t);
14479 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
14480 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
14481 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14482 }
14483
14484 /* ffestb_R12292_ -- "STMTFUNCTION" OPEN_PAREN dummy-name-list CLOSE_PAREN
14485 EQUALS expr
14486
14487 (ffestb_R12292_) // to expression handler
14488
14489 Make sure the statement has a valid form for a STMTFUNCTION statement. If
14490 it does, implement the statement. */
14491
14492 static ffelexHandler
14493 ffestb_R12292_ (ffelexToken ft, ffebld expr, ffelexToken t)
14494 {
14495 if (expr == NULL)
14496 goto bad; /* :::::::::::::::::::: */
14497
14498 switch (ffelex_token_type (t))
14499 {
14500 case FFELEX_typeEOS:
14501 case FFELEX_typeSEMICOLON:
14502 if (!ffesta_is_inhibited ())
14503 ffestc_R1229_finish (expr, ft);
14504 return (ffelexHandler) ffesta_zero (t);
14505
14506 default:
14507 break;
14508 }
14509
14510 bad: /* :::::::::::::::::::: */
14511 ffestc_R1229_finish (NULL, NULL);
14512 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "statement-function-definition", t);
14513 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14514 }
14515
14516 /* ffestb_decl_chartype -- Parse the CHARACTER statement
14517
14518 return ffestb_decl_chartype; // to lexer
14519
14520 Make sure the statement has a valid form for the CHARACTER statement. If
14521 it does, implement the statement. */
14522
14523 ffelexHandler
14524 ffestb_decl_chartype (ffelexToken t)
14525 {
14526 ffeTokenLength i;
14527 unsigned const char *p;
14528
14529 ffestb_local_.decl.type = FFESTP_typeCHARACTER;
14530 ffestb_local_.decl.recursive = NULL;
14531 ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
14532 ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
14533
14534 switch (ffelex_token_type (ffesta_tokens[0]))
14535 {
14536 case FFELEX_typeNAME:
14537 if (ffesta_first_kw != FFESTR_firstCHRCTR)
14538 goto bad_0; /* :::::::::::::::::::: */
14539 switch (ffelex_token_type (t))
14540 {
14541 case FFELEX_typeEOS:
14542 case FFELEX_typeSEMICOLON:
14543 ffesta_confirmed (); /* Error, but clearly intended. */
14544 goto bad_1; /* :::::::::::::::::::: */
14545
14546 default:
14547 goto bad_1; /* :::::::::::::::::::: */
14548
14549 case FFELEX_typeCOMMA:
14550 ffesta_confirmed ();
14551 if (!ffesta_is_inhibited ())
14552 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
14553 NULL, NULL, NULL, NULL);
14554 return (ffelexHandler) ffestb_decl_attrs_;
14555
14556 case FFELEX_typeCOLONCOLON:
14557 ffestb_local_.decl.coloncolon = TRUE;
14558 ffesta_confirmed ();
14559 if (!ffesta_is_inhibited ())
14560 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
14561 NULL, NULL, NULL, NULL);
14562 return (ffelexHandler) ffestb_decl_ents_;
14563
14564 case FFELEX_typeASTERISK:
14565 ffesta_confirmed ();
14566 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_chartype1_;
14567 ffestb_local_.decl.badname = "TYPEDECL";
14568 return (ffelexHandler) ffestb_decl_starlen_;
14569
14570 case FFELEX_typeOPEN_PAREN:
14571 ffestb_local_.decl.kind = NULL;
14572 ffestb_local_.decl.kindt = NULL;
14573 ffestb_local_.decl.len = NULL;
14574 ffestb_local_.decl.lent = NULL;
14575 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
14576 ffestb_local_.decl.badname = "_TYPEDECL";
14577 return (ffelexHandler) ffestb_decl_typeparams_;
14578
14579 case FFELEX_typeNAME:
14580 ffesta_confirmed ();
14581 ffestb_local_.decl.kind = NULL;
14582 ffestb_local_.decl.kindt = NULL;
14583 ffestb_local_.decl.len = NULL;
14584 ffestb_local_.decl.lent = NULL;
14585 return (ffelexHandler) ffestb_decl_entsp_ (t);
14586 }
14587
14588 case FFELEX_typeNAMES:
14589 if (ffesta_first_kw != FFESTR_firstCHRCTR)
14590 goto bad_0; /* :::::::::::::::::::: */
14591 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCHRCTR);
14592 switch (ffelex_token_type (t))
14593 {
14594 default:
14595 goto bad_1; /* :::::::::::::::::::: */
14596
14597 case FFELEX_typeEOS:
14598 case FFELEX_typeSEMICOLON:
14599 ffesta_confirmed ();
14600 break;
14601
14602 case FFELEX_typeCOMMA:
14603 ffesta_confirmed ();
14604 if (*p != '\0')
14605 break;
14606 if (!ffesta_is_inhibited ())
14607 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
14608 NULL, NULL, NULL, NULL);
14609 return (ffelexHandler) ffestb_decl_attrs_;
14610
14611 case FFELEX_typeCOLONCOLON:
14612 ffestb_local_.decl.coloncolon = TRUE;
14613 ffesta_confirmed ();
14614 if (*p != '\0')
14615 goto bad_i; /* :::::::::::::::::::: */
14616 if (!ffesta_is_inhibited ())
14617 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
14618 NULL, NULL, NULL, NULL);
14619 return (ffelexHandler) ffestb_decl_ents_;
14620
14621 case FFELEX_typeASTERISK:
14622 ffesta_confirmed ();
14623 if (*p != '\0')
14624 break;
14625 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_chartype1_;
14626 ffestb_local_.decl.badname = "TYPEDECL";
14627 return (ffelexHandler) ffestb_decl_starlen_;
14628
14629 case FFELEX_typeSLASH:
14630 ffesta_confirmed ();
14631 if (*p != '\0')
14632 break;
14633 goto bad_1; /* :::::::::::::::::::: */
14634
14635 case FFELEX_typeOPEN_PAREN:
14636 if (*p != '\0')
14637 break;
14638 ffestb_local_.decl.kind = NULL;
14639 ffestb_local_.decl.kindt = NULL;
14640 ffestb_local_.decl.len = NULL;
14641 ffestb_local_.decl.lent = NULL;
14642 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
14643 ffestb_local_.decl.badname = "TYPEDECL";
14644 return (ffelexHandler) ffestb_decl_typeparams_;
14645 }
14646 if (!ffesrc_is_name_init (*p))
14647 goto bad_i; /* :::::::::::::::::::: */
14648 ffestb_local_.decl.kind = NULL;
14649 ffestb_local_.decl.kindt = NULL;
14650 ffestb_local_.decl.len = NULL;
14651 ffestb_local_.decl.lent = NULL;
14652 ffesta_tokens[1] = ffelex_token_names_from_names (ffesta_tokens[0], i, 0);
14653 return (ffelexHandler) ffestb_decl_entsp_2_ (t);
14654
14655 default:
14656 goto bad_0; /* :::::::::::::::::::: */
14657 }
14658
14659 bad_0: /* :::::::::::::::::::: */
14660 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
14661 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14662
14663 bad_1: /* :::::::::::::::::::: */
14664 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
14665 return (ffelexHandler) ffelex_swallow_tokens (t,
14666 (ffelexHandler) ffesta_zero); /* Invalid second token. */
14667
14668 bad_i: /* :::::::::::::::::::: */
14669 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0], i, t);
14670 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14671 }
14672
14673 /* ffestb_decl_chartype1_ -- "CHARACTER" ASTERISK char-length
14674
14675 return ffestb_decl_chartype1_; // to lexer
14676
14677 Handle COMMA, COLONCOLON, or anything else. */
14678
14679 static ffelexHandler
14680 ffestb_decl_chartype1_ (ffelexToken t)
14681 {
14682 ffelex_set_names (FALSE);
14683
14684 switch (ffelex_token_type (t))
14685 {
14686 case FFELEX_typeCOLONCOLON:
14687 ffestb_local_.decl.coloncolon = TRUE;
14688 /* Fall through. */
14689 case FFELEX_typeCOMMA:
14690 ffesta_confirmed ();
14691 if (!ffesta_is_inhibited ())
14692 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
14693 NULL, NULL, ffestb_local_.decl.len, ffestb_local_.decl.lent);
14694 if (ffestb_local_.decl.lent != NULL)
14695 ffelex_token_kill (ffestb_local_.decl.lent);
14696 return (ffelexHandler) ffestb_decl_ents_;
14697
14698 default:
14699 return (ffelexHandler) ffestb_decl_entsp_ (t);
14700 }
14701 }
14702
14703 /* ffestb_decl_dbltype -- Parse the DOUBLEPRECISION/DOUBLECOMPLEX statement
14704
14705 return ffestb_decl_dbltype; // to lexer
14706
14707 Make sure the statement has a valid form for the DOUBLEPRECISION/
14708 DOUBLECOMPLEX statement. If it does, implement the statement. */
14709
14710 ffelexHandler
14711 ffestb_decl_dbltype (ffelexToken t)
14712 {
14713 ffeTokenLength i;
14714 unsigned const char *p;
14715
14716 ffestb_local_.decl.type = ffestb_args.decl.type;
14717 ffestb_local_.decl.recursive = NULL;
14718 ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
14719 ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
14720
14721 switch (ffelex_token_type (ffesta_tokens[0]))
14722 {
14723 case FFELEX_typeNAME:
14724 switch (ffelex_token_type (t))
14725 {
14726 case FFELEX_typeEOS:
14727 case FFELEX_typeSEMICOLON:
14728 ffesta_confirmed (); /* Error, but clearly intended. */
14729 goto bad_1; /* :::::::::::::::::::: */
14730
14731 default:
14732 goto bad_1; /* :::::::::::::::::::: */
14733
14734 case FFELEX_typeCOMMA:
14735 ffesta_confirmed ();
14736 if (!ffesta_is_inhibited ())
14737 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
14738 NULL, NULL, NULL, NULL);
14739 return (ffelexHandler) ffestb_decl_attrs_;
14740
14741 case FFELEX_typeCOLONCOLON:
14742 ffestb_local_.decl.coloncolon = TRUE;
14743 ffesta_confirmed ();
14744 if (!ffesta_is_inhibited ())
14745 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
14746 NULL, NULL, NULL, NULL);
14747 return (ffelexHandler) ffestb_decl_ents_;
14748
14749 case FFELEX_typeNAME:
14750 ffesta_confirmed ();
14751 ffestb_local_.decl.kind = NULL;
14752 ffestb_local_.decl.kindt = NULL;
14753 ffestb_local_.decl.len = NULL;
14754 ffestb_local_.decl.lent = NULL;
14755 return (ffelexHandler) ffestb_decl_entsp_ (t);
14756 }
14757
14758 case FFELEX_typeNAMES:
14759 p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.decl.len);
14760 switch (ffelex_token_type (t))
14761 {
14762 default:
14763 goto bad_1; /* :::::::::::::::::::: */
14764
14765 case FFELEX_typeEOS:
14766 case FFELEX_typeSEMICOLON:
14767 ffesta_confirmed ();
14768 break;
14769
14770 case FFELEX_typeCOMMA:
14771 ffesta_confirmed ();
14772 if (*p != '\0')
14773 break;
14774 if (!ffesta_is_inhibited ())
14775 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
14776 NULL, NULL, NULL, NULL);
14777 return (ffelexHandler) ffestb_decl_attrs_;
14778
14779 case FFELEX_typeCOLONCOLON:
14780 ffestb_local_.decl.coloncolon = TRUE;
14781 ffesta_confirmed ();
14782 if (*p != '\0')
14783 goto bad_i; /* :::::::::::::::::::: */
14784 if (!ffesta_is_inhibited ())
14785 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
14786 NULL, NULL, NULL, NULL);
14787 return (ffelexHandler) ffestb_decl_ents_;
14788
14789 case FFELEX_typeSLASH:
14790 ffesta_confirmed ();
14791 if (*p != '\0')
14792 break;
14793 goto bad_1; /* :::::::::::::::::::: */
14794
14795 case FFELEX_typeOPEN_PAREN:
14796 if (*p != '\0')
14797 break;
14798 goto bad_1; /* :::::::::::::::::::: */
14799 }
14800 if (!ffesrc_is_name_init (*p))
14801 goto bad_i; /* :::::::::::::::::::: */
14802 ffestb_local_.decl.kind = NULL;
14803 ffestb_local_.decl.kindt = NULL;
14804 ffestb_local_.decl.len = NULL;
14805 ffestb_local_.decl.lent = NULL;
14806 ffesta_tokens[1] = ffelex_token_names_from_names (ffesta_tokens[0], i, 0);
14807 return (ffelexHandler) ffestb_decl_entsp_2_ (t);
14808
14809 default:
14810 goto bad_0; /* :::::::::::::::::::: */
14811 }
14812
14813 bad_0: /* :::::::::::::::::::: */
14814 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
14815 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14816
14817 bad_1: /* :::::::::::::::::::: */
14818 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
14819 return (ffelexHandler) ffelex_swallow_tokens (t,
14820 (ffelexHandler) ffesta_zero); /* Invalid second token. */
14821
14822 bad_i: /* :::::::::::::::::::: */
14823 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0], i, t);
14824 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14825 }
14826
14827 /* ffestb_decl_double -- Parse the DOUBLE PRECISION/DOUBLE COMPLEX statement
14828
14829 return ffestb_decl_double; // to lexer
14830
14831 Make sure the statement has a valid form for the DOUBLE PRECISION/
14832 DOUBLE COMPLEX statement. If it does, implement the statement. */
14833
14834 ffelexHandler
14835 ffestb_decl_double (ffelexToken t)
14836 {
14837 ffestb_local_.decl.recursive = NULL;
14838 ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
14839 ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
14840
14841 switch (ffelex_token_type (ffesta_tokens[0]))
14842 {
14843 case FFELEX_typeNAME:
14844 if (ffesta_first_kw != FFESTR_firstDBL)
14845 goto bad_0; /* :::::::::::::::::::: */
14846 switch (ffelex_token_type (t))
14847 {
14848 case FFELEX_typeEOS:
14849 case FFELEX_typeSEMICOLON:
14850 case FFELEX_typeCOMMA:
14851 case FFELEX_typeCOLONCOLON:
14852 ffesta_confirmed (); /* Error, but clearly intended. */
14853 goto bad_1; /* :::::::::::::::::::: */
14854
14855 default:
14856 goto bad_1; /* :::::::::::::::::::: */
14857
14858 case FFELEX_typeNAME:
14859 ffesta_confirmed ();
14860 switch (ffestr_second (t))
14861 {
14862 case FFESTR_secondCOMPLEX:
14863 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
14864 break;
14865
14866 case FFESTR_secondPRECISION:
14867 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
14868 break;
14869
14870 default:
14871 goto bad_1; /* :::::::::::::::::::: */
14872 }
14873 ffestb_local_.decl.kind = NULL;
14874 ffestb_local_.decl.kindt = NULL;
14875 ffestb_local_.decl.len = NULL;
14876 ffestb_local_.decl.lent = NULL;
14877 return (ffelexHandler) ffestb_decl_attrsp_;
14878 }
14879
14880 default:
14881 goto bad_0; /* :::::::::::::::::::: */
14882 }
14883
14884 bad_0: /* :::::::::::::::::::: */
14885 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
14886 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
14887
14888 bad_1: /* :::::::::::::::::::: */
14889 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
14890 return (ffelexHandler) ffelex_swallow_tokens (t,
14891 (ffelexHandler) ffesta_zero); /* Invalid second token. */
14892 }
14893
14894 /* ffestb_decl_gentype -- Parse the INTEGER/REAL/COMPLEX/LOGICAL statement
14895
14896 return ffestb_decl_gentype; // to lexer
14897
14898 Make sure the statement has a valid form for the INTEGER/REAL/COMPLEX/
14899 LOGICAL statement. If it does, implement the statement. */
14900
14901 ffelexHandler
14902 ffestb_decl_gentype (ffelexToken t)
14903 {
14904 ffeTokenLength i;
14905 unsigned const char *p;
14906
14907 ffestb_local_.decl.type = ffestb_args.decl.type;
14908 ffestb_local_.decl.recursive = NULL;
14909 ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
14910 ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
14911
14912 switch (ffelex_token_type (ffesta_tokens[0]))
14913 {
14914 case FFELEX_typeNAME:
14915 switch (ffelex_token_type (t))
14916 {
14917 case FFELEX_typeEOS:
14918 case FFELEX_typeSEMICOLON:
14919 ffesta_confirmed (); /* Error, but clearly intended. */
14920 goto bad_1; /* :::::::::::::::::::: */
14921
14922 default:
14923 goto bad_1; /* :::::::::::::::::::: */
14924
14925 case FFELEX_typeCOMMA:
14926 ffesta_confirmed ();
14927 if (!ffesta_is_inhibited ())
14928 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
14929 NULL, NULL, NULL, NULL);
14930 return (ffelexHandler) ffestb_decl_attrs_;
14931
14932 case FFELEX_typeCOLONCOLON:
14933 ffestb_local_.decl.coloncolon = TRUE;
14934 ffesta_confirmed ();
14935 if (!ffesta_is_inhibited ())
14936 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
14937 NULL, NULL, NULL, NULL);
14938 return (ffelexHandler) ffestb_decl_ents_;
14939
14940 case FFELEX_typeASTERISK:
14941 ffesta_confirmed ();
14942 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
14943 ffestb_local_.decl.badname = "TYPEDECL";
14944 return (ffelexHandler) ffestb_decl_starkind_;
14945
14946 case FFELEX_typeOPEN_PAREN:
14947 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
14948 ffestb_local_.decl.badname = "TYPEDECL";
14949 return (ffelexHandler) ffestb_decl_kindparam_;
14950
14951 case FFELEX_typeNAME:
14952 ffesta_confirmed ();
14953 ffestb_local_.decl.kind = NULL;
14954 ffestb_local_.decl.kindt = NULL;
14955 ffestb_local_.decl.len = NULL;
14956 ffestb_local_.decl.lent = NULL;
14957 return (ffelexHandler) ffestb_decl_entsp_ (t);
14958 }
14959
14960 case FFELEX_typeNAMES:
14961 p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.decl.len);
14962 switch (ffelex_token_type (t))
14963 {
14964 default:
14965 goto bad_1; /* :::::::::::::::::::: */
14966
14967 case FFELEX_typeEOS:
14968 case FFELEX_typeSEMICOLON:
14969 ffesta_confirmed ();
14970 break;
14971
14972 case FFELEX_typeCOMMA:
14973 ffesta_confirmed ();
14974 if (*p != '\0')
14975 break;
14976 if (!ffesta_is_inhibited ())
14977 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
14978 NULL, NULL, NULL, NULL);
14979 return (ffelexHandler) ffestb_decl_attrs_;
14980
14981 case FFELEX_typeCOLONCOLON:
14982 ffestb_local_.decl.coloncolon = TRUE;
14983 ffesta_confirmed ();
14984 if (*p != '\0')
14985 goto bad_i; /* :::::::::::::::::::: */
14986 if (!ffesta_is_inhibited ())
14987 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
14988 NULL, NULL, NULL, NULL);
14989 return (ffelexHandler) ffestb_decl_ents_;
14990
14991 case FFELEX_typeSLASH:
14992 ffesta_confirmed ();
14993 if (*p != '\0')
14994 break;
14995 goto bad_1; /* :::::::::::::::::::: */
14996
14997 case FFELEX_typeASTERISK:
14998 ffesta_confirmed ();
14999 if (*p != '\0')
15000 break;
15001 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
15002 ffestb_local_.decl.badname = "TYPEDECL";
15003 return (ffelexHandler) ffestb_decl_starkind_;
15004
15005 case FFELEX_typeOPEN_PAREN:
15006 if (*p != '\0')
15007 break;
15008 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
15009 ffestb_local_.decl.badname = "TYPEDECL";
15010 return (ffelexHandler) ffestb_decl_kindparam_;
15011 }
15012 if (!ffesrc_is_name_init (*p))
15013 goto bad_i; /* :::::::::::::::::::: */
15014 ffestb_local_.decl.kind = NULL;
15015 ffestb_local_.decl.kindt = NULL;
15016 ffestb_local_.decl.len = NULL;
15017 ffestb_local_.decl.lent = NULL;
15018 ffesta_tokens[1] = ffelex_token_names_from_names (ffesta_tokens[0], i, 0);
15019 return (ffelexHandler) ffestb_decl_entsp_2_ (t);
15020
15021 default:
15022 goto bad_0; /* :::::::::::::::::::: */
15023 }
15024
15025 bad_0: /* :::::::::::::::::::: */
15026 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
15027 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15028
15029 bad_1: /* :::::::::::::::::::: */
15030 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
15031 return (ffelexHandler) ffelex_swallow_tokens (t,
15032 (ffelexHandler) ffesta_zero); /* Invalid second token. */
15033
15034 bad_i: /* :::::::::::::::::::: */
15035 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0], i, t);
15036 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15037 }
15038
15039 /* ffestb_decl_attrs_ -- "type" [type parameters] COMMA
15040
15041 return ffestb_decl_attrs_; // to lexer
15042
15043 Handle NAME of an attribute. */
15044
15045 static ffelexHandler
15046 ffestb_decl_attrs_ (ffelexToken t)
15047 {
15048 switch (ffelex_token_type (t))
15049 {
15050 case FFELEX_typeNAME:
15051 switch (ffestr_first (t))
15052 {
15053 case FFESTR_firstDIMENSION:
15054 ffesta_tokens[1] = ffelex_token_use (t);
15055 return (ffelexHandler) ffestb_decl_attrs_1_;
15056
15057 case FFESTR_firstEXTERNAL:
15058 if (!ffesta_is_inhibited ())
15059 ffestc_decl_attrib (FFESTP_attribEXTERNAL, t,
15060 FFESTR_otherNone, NULL);
15061 return (ffelexHandler) ffestb_decl_attrs_7_;
15062
15063 case FFESTR_firstINTRINSIC:
15064 if (!ffesta_is_inhibited ())
15065 ffestc_decl_attrib (FFESTP_attribINTRINSIC, t,
15066 FFESTR_otherNone, NULL);
15067 return (ffelexHandler) ffestb_decl_attrs_7_;
15068
15069 case FFESTR_firstPARAMETER:
15070 ffestb_local_.decl.parameter = TRUE;
15071 if (!ffesta_is_inhibited ())
15072 ffestc_decl_attrib (FFESTP_attribPARAMETER, t,
15073 FFESTR_otherNone, NULL);
15074 return (ffelexHandler) ffestb_decl_attrs_7_;
15075
15076 case FFESTR_firstSAVE:
15077 if (!ffesta_is_inhibited ())
15078 ffestc_decl_attrib (FFESTP_attribSAVE, t,
15079 FFESTR_otherNone, NULL);
15080 return (ffelexHandler) ffestb_decl_attrs_7_;
15081
15082 default:
15083 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
15084 return (ffelexHandler) ffestb_decl_attrs_7_;
15085 }
15086 break;
15087
15088 default:
15089 break;
15090 }
15091
15092 if (!ffesta_is_inhibited ())
15093 ffestc_decl_finish ();
15094 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
15095 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15096 }
15097
15098 /* ffestb_decl_attrs_1_ -- "type" [type parameters] ",DIMENSION"
15099
15100 return ffestb_decl_attrs_1_; // to lexer
15101
15102 Handle OPEN_PAREN. */
15103
15104 static ffelexHandler
15105 ffestb_decl_attrs_1_ (ffelexToken t)
15106 {
15107 switch (ffelex_token_type (t))
15108 {
15109 case FFELEX_typeOPEN_PAREN:
15110 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
15111 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_decl_attrs_2_;
15112 ffestb_subrargs_.dim_list.pool = ffesta_scratch_pool;
15113 ffestb_subrargs_.dim_list.ctx = ffesta_is_entry_valid
15114 ? FFEEXPR_contextDIMLIST : FFEEXPR_contextDIMLISTCOMMON;
15115 #ifdef FFECOM_dimensionsMAX
15116 ffestb_subrargs_.dim_list.ndims = 0;
15117 #endif
15118 return (ffelexHandler) ffeexpr_rhs (ffesta_scratch_pool,
15119 ffestb_subrargs_.dim_list.ctx,
15120 (ffeexprCallback) ffestb_subr_dimlist_);
15121
15122 case FFELEX_typeCOMMA:
15123 case FFELEX_typeCOLONCOLON:
15124 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, ffesta_tokens[1]);
15125 ffelex_token_kill (ffesta_tokens[1]);
15126 return (ffelexHandler) ffestb_decl_attrs_7_ (t);
15127
15128 default:
15129 break;
15130 }
15131
15132 if (!ffesta_is_inhibited ())
15133 ffestc_decl_finish ();
15134 ffelex_token_kill (ffesta_tokens[1]);
15135 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
15136 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15137 }
15138
15139 /* ffestb_decl_attrs_2_ -- "type" [type parameters] ",DIMENSION" OPEN_PAREN
15140 dimlist CLOSE_PAREN
15141
15142 return ffestb_decl_attrs_2_; // to lexer
15143
15144 Handle COMMA or COLONCOLON. */
15145
15146 static ffelexHandler
15147 ffestb_decl_attrs_2_ (ffelexToken t)
15148 {
15149 if (!ffestb_subrargs_.dim_list.ok)
15150 goto bad; /* :::::::::::::::::::: */
15151
15152 switch (ffelex_token_type (t))
15153 {
15154 case FFELEX_typeCOMMA:
15155 case FFELEX_typeCOLONCOLON:
15156 if (!ffesta_is_inhibited ())
15157 ffestc_decl_attrib (FFESTP_attribDIMENSION, ffesta_tokens[1],
15158 FFESTR_otherNone, ffestb_subrargs_.dim_list.dims);
15159 ffelex_token_kill (ffesta_tokens[1]);
15160 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
15161 return (ffelexHandler) ffestb_decl_attrs_7_ (t);
15162
15163 default:
15164 break;
15165 }
15166
15167 bad: /* :::::::::::::::::::: */
15168 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
15169 if (!ffesta_is_inhibited ())
15170 ffestc_decl_finish ();
15171 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
15172 ffelex_token_kill (ffesta_tokens[1]);
15173 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15174 }
15175
15176 /* ffestb_decl_attrs_7_ -- "type" [type parameters] attribute
15177
15178 return ffestb_decl_attrs_7_; // to lexer
15179
15180 Handle COMMA (another attribute) or COLONCOLON (entities). */
15181
15182 static ffelexHandler
15183 ffestb_decl_attrs_7_ (ffelexToken t)
15184 {
15185 switch (ffelex_token_type (t))
15186 {
15187 case FFELEX_typeCOMMA:
15188 return (ffelexHandler) ffestb_decl_attrs_;
15189
15190 case FFELEX_typeCOLONCOLON:
15191 ffestb_local_.decl.coloncolon = TRUE;
15192 return (ffelexHandler) ffestb_decl_ents_;
15193
15194 default:
15195 break;
15196 }
15197
15198 if (!ffesta_is_inhibited ())
15199 ffestc_decl_finish ();
15200 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
15201 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15202 }
15203
15204 /* ffestb_decl_attrsp_ -- "type" [type parameters]
15205
15206 return ffestb_decl_attrsp_; // to lexer
15207
15208 Handle COMMA (meaning we have attributes), COLONCOLON (meaning we have
15209 no attributes but entities), or go to entsp to see about functions or
15210 entities. */
15211
15212 static ffelexHandler
15213 ffestb_decl_attrsp_ (ffelexToken t)
15214 {
15215 ffelex_set_names (FALSE);
15216
15217 switch (ffelex_token_type (t))
15218 {
15219 case FFELEX_typeCOMMA:
15220 ffesta_confirmed ();
15221 if (!ffesta_is_inhibited ())
15222 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
15223 ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
15224 ffestb_local_.decl.len, ffestb_local_.decl.lent);
15225 if (ffestb_local_.decl.kindt != NULL)
15226 ffelex_token_kill (ffestb_local_.decl.kindt);
15227 if (ffestb_local_.decl.lent != NULL)
15228 ffelex_token_kill (ffestb_local_.decl.lent);
15229 return (ffelexHandler) ffestb_decl_attrs_;
15230
15231 case FFELEX_typeCOLONCOLON:
15232 ffestb_local_.decl.coloncolon = TRUE;
15233 ffesta_confirmed ();
15234 if (!ffesta_is_inhibited ())
15235 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
15236 ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
15237 ffestb_local_.decl.len, ffestb_local_.decl.lent);
15238 if (ffestb_local_.decl.kindt != NULL)
15239 ffelex_token_kill (ffestb_local_.decl.kindt);
15240 if (ffestb_local_.decl.lent != NULL)
15241 ffelex_token_kill (ffestb_local_.decl.lent);
15242 return (ffelexHandler) ffestb_decl_ents_;
15243
15244 default:
15245 return (ffelexHandler) ffestb_decl_entsp_ (t);
15246 }
15247 }
15248
15249 /* ffestb_decl_ents_ -- "type" [type parameters] [attributes "::"]
15250
15251 return ffestb_decl_ents_; // to lexer
15252
15253 Handle NAME of an entity. */
15254
15255 static ffelexHandler
15256 ffestb_decl_ents_ (ffelexToken t)
15257 {
15258 switch (ffelex_token_type (t))
15259 {
15260 case FFELEX_typeNAME:
15261 ffesta_tokens[1] = ffelex_token_use (t);
15262 return (ffelexHandler) ffestb_decl_ents_1_;
15263
15264 default:
15265 break;
15266 }
15267
15268 if (!ffesta_is_inhibited ())
15269 ffestc_decl_finish ();
15270 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
15271 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15272 }
15273
15274 /* ffestb_decl_ents_1_ -- "type" [type parameters] [attributes "::"] NAME
15275
15276 return ffestb_decl_ents_1_; // to lexer
15277
15278 Handle ASTERISK, OPEN_PAREN, EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */
15279
15280 static ffelexHandler
15281 ffestb_decl_ents_1_ (ffelexToken t)
15282 {
15283 switch (ffelex_token_type (t))
15284 {
15285 case FFELEX_typeCOMMA:
15286 if (!ffesta_is_inhibited ())
15287 ffestc_decl_item (ffesta_tokens[1], NULL, NULL, NULL, NULL, NULL, NULL,
15288 NULL, FALSE);
15289 ffelex_token_kill (ffesta_tokens[1]);
15290 return (ffelexHandler) ffestb_decl_ents_;
15291
15292 case FFELEX_typeEOS:
15293 case FFELEX_typeSEMICOLON:
15294 if (!ffesta_is_inhibited ())
15295 {
15296 ffestc_decl_item (ffesta_tokens[1], NULL, NULL, NULL, NULL, NULL, NULL,
15297 NULL, FALSE);
15298 ffestc_decl_finish ();
15299 }
15300 ffelex_token_kill (ffesta_tokens[1]);
15301 return (ffelexHandler) ffesta_zero (t);
15302
15303 case FFELEX_typeASTERISK:
15304 ffestb_local_.decl.len = NULL;
15305 ffestb_local_.decl.lent = NULL;
15306 return (ffelexHandler) ffestb_decl_ents_2_;
15307
15308 case FFELEX_typeOPEN_PAREN:
15309 ffestb_local_.decl.kind = NULL;
15310 ffestb_local_.decl.kindt = NULL;
15311 ffestb_local_.decl.len = NULL;
15312 ffestb_local_.decl.lent = NULL;
15313 return (ffelexHandler) ffestb_decl_ents_3_ (t);
15314
15315 case FFELEX_typeEQUALS:
15316 case FFELEX_typeSLASH:
15317 ffestb_local_.decl.kind = NULL;
15318 ffestb_local_.decl.kindt = NULL;
15319 ffestb_subrargs_.dim_list.dims = NULL;
15320 ffestb_local_.decl.len = NULL;
15321 ffestb_local_.decl.lent = NULL;
15322 return (ffelexHandler) ffestb_decl_ents_7_ (t);
15323
15324 default:
15325 break;
15326 }
15327
15328 if (!ffesta_is_inhibited ())
15329 ffestc_decl_finish ();
15330 ffelex_token_kill (ffesta_tokens[1]);
15331 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
15332 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15333 }
15334
15335 /* ffestb_decl_ents_2_ -- "type" [type parameters] [attributes "::"] NAME
15336 ASTERISK
15337
15338 return ffestb_decl_ents_2_; // to lexer
15339
15340 Handle NUMBER or OPEN_PAREN. */
15341
15342 static ffelexHandler
15343 ffestb_decl_ents_2_ (ffelexToken t)
15344 {
15345 switch (ffelex_token_type (t))
15346 {
15347 case FFELEX_typeNUMBER:
15348 if (ffestb_local_.decl.type != FFESTP_typeCHARACTER)
15349 {
15350 ffestb_local_.decl.kind = NULL;
15351 ffestb_local_.decl.kindt = ffelex_token_use (t);
15352 return (ffelexHandler) ffestb_decl_ents_3_;
15353 }
15354 /* Fall through. *//* (CHARACTER's *n is always a len spec. */
15355 case FFELEX_typeOPEN_PAREN:/* "*(" is after the (omitted)
15356 "(array-spec)". */
15357 ffestb_local_.decl.kind = NULL;
15358 ffestb_local_.decl.kindt = NULL;
15359 ffestb_subrargs_.dim_list.dims = NULL;
15360 return (ffelexHandler) ffestb_decl_ents_5_ (t);
15361
15362 default:
15363 break;
15364 }
15365
15366 if (!ffesta_is_inhibited ())
15367 ffestc_decl_finish ();
15368 ffelex_token_kill (ffesta_tokens[1]);
15369 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
15370 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15371 }
15372
15373 /* ffestb_decl_ents_3_ -- "type" [type parameters] [attributes "::"] NAME
15374 [ASTERISK NUMBER]
15375
15376 return ffestb_decl_ents_3_; // to lexer
15377
15378 Handle ASTERISK, OPEN_PAREN, EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */
15379
15380 static ffelexHandler
15381 ffestb_decl_ents_3_ (ffelexToken t)
15382 {
15383 switch (ffelex_token_type (t))
15384 {
15385 case FFELEX_typeCOMMA:
15386 if (!ffesta_is_inhibited ())
15387 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
15388 ffestb_local_.decl.kindt, NULL, NULL, NULL, NULL, NULL, FALSE);
15389 ffelex_token_kill (ffesta_tokens[1]);
15390 if (ffestb_local_.decl.kindt != NULL)
15391 ffelex_token_kill (ffestb_local_.decl.kindt);
15392 return (ffelexHandler) ffestb_decl_ents_;
15393
15394 case FFELEX_typeEOS:
15395 case FFELEX_typeSEMICOLON:
15396 if (!ffesta_is_inhibited ())
15397 {
15398 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
15399 ffestb_local_.decl.kindt, NULL, NULL, NULL, NULL, NULL, FALSE);
15400 ffestc_decl_finish ();
15401 }
15402 ffelex_token_kill (ffesta_tokens[1]);
15403 if (ffestb_local_.decl.kindt != NULL)
15404 ffelex_token_kill (ffestb_local_.decl.kindt);
15405 return (ffelexHandler) ffesta_zero (t);
15406
15407 case FFELEX_typeASTERISK:
15408 ffestb_subrargs_.dim_list.dims = NULL;
15409 return (ffelexHandler) ffestb_decl_ents_5_;
15410
15411 case FFELEX_typeOPEN_PAREN:
15412 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
15413 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_decl_ents_4_;
15414 ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
15415 ffestb_subrargs_.dim_list.ctx = ffesta_is_entry_valid
15416 ? FFEEXPR_contextDIMLIST : FFEEXPR_contextDIMLISTCOMMON;
15417 #ifdef FFECOM_dimensionsMAX
15418 ffestb_subrargs_.dim_list.ndims = 0;
15419 #endif
15420 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15421 ffestb_subrargs_.dim_list.ctx,
15422 (ffeexprCallback) ffestb_subr_dimlist_);
15423
15424 case FFELEX_typeEQUALS:
15425 case FFELEX_typeSLASH:
15426 ffestb_local_.decl.kind = NULL;
15427 ffestb_local_.decl.kindt = NULL;
15428 ffestb_subrargs_.dim_list.dims = NULL;
15429 ffestb_local_.decl.len = NULL;
15430 ffestb_local_.decl.lent = NULL;
15431 return (ffelexHandler) ffestb_decl_ents_7_ (t);
15432
15433 default:
15434 break;
15435 }
15436
15437 if (!ffesta_is_inhibited ())
15438 ffestc_decl_finish ();
15439 ffelex_token_kill (ffesta_tokens[1]);
15440 if (ffestb_local_.decl.kindt != NULL)
15441 ffelex_token_kill (ffestb_local_.decl.kindt);
15442 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
15443 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15444 }
15445
15446 /* ffestb_decl_ents_4_ -- "type" [type parameters] [attributes "::"] NAME
15447 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
15448
15449 return ffestb_decl_ents_4_; // to lexer
15450
15451 Handle ASTERISK, EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */
15452
15453 static ffelexHandler
15454 ffestb_decl_ents_4_ (ffelexToken t)
15455 {
15456 ffelexToken nt;
15457
15458 if (!ffestb_subrargs_.dim_list.ok)
15459 goto bad; /* :::::::::::::::::::: */
15460
15461 if (ffelex_token_type (ffesta_tokens[1]) == FFELEX_typeNAMES)
15462 {
15463 switch (ffelex_token_type (t))
15464 {
15465 case FFELEX_typeCOMMA:
15466 case FFELEX_typeEOS:
15467 case FFELEX_typeSEMICOLON:
15468 case FFELEX_typeASTERISK:
15469 case FFELEX_typeSLASH: /* But NOT FFELEX_typeEQUALS. */
15470 case FFELEX_typeCOLONCOLON: /* Actually an error. */
15471 break; /* Confirm and handle. */
15472
15473 default: /* Perhaps EQUALS, as in
15474 INTEGERFUNCTIONX(A)=B. */
15475 goto bad; /* :::::::::::::::::::: */
15476 }
15477 ffesta_confirmed ();
15478 if (!ffesta_is_inhibited ())
15479 {
15480 nt = ffelex_token_name_from_names (ffesta_tokens[1], 0, 0);
15481 ffelex_token_kill (ffesta_tokens[1]);
15482 ffesta_tokens[1] = nt;
15483 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
15484 NULL, NULL, NULL, NULL);
15485 }
15486 }
15487
15488 switch (ffelex_token_type (t))
15489 {
15490 case FFELEX_typeCOMMA:
15491 if (!ffesta_is_inhibited ())
15492 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
15493 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
15494 ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
15495 FALSE);
15496 ffelex_token_kill (ffesta_tokens[1]);
15497 if (ffestb_local_.decl.kindt != NULL)
15498 ffelex_token_kill (ffestb_local_.decl.kindt);
15499 if (ffestb_local_.decl.lent != NULL)
15500 ffelex_token_kill (ffestb_local_.decl.lent);
15501 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
15502 return (ffelexHandler) ffestb_decl_ents_;
15503
15504 case FFELEX_typeEOS:
15505 case FFELEX_typeSEMICOLON:
15506 if (!ffesta_is_inhibited ())
15507 {
15508 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
15509 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
15510 ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
15511 FALSE);
15512 ffestc_decl_finish ();
15513 }
15514 ffelex_token_kill (ffesta_tokens[1]);
15515 if (ffestb_local_.decl.kindt != NULL)
15516 ffelex_token_kill (ffestb_local_.decl.kindt);
15517 if (ffestb_local_.decl.lent != NULL)
15518 ffelex_token_kill (ffestb_local_.decl.lent);
15519 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
15520 return (ffelexHandler) ffesta_zero (t);
15521
15522 case FFELEX_typeASTERISK:
15523 if (ffestb_local_.decl.lent != NULL)
15524 break; /* Can't specify "*length" twice. */
15525 return (ffelexHandler) ffestb_decl_ents_5_;
15526
15527 case FFELEX_typeEQUALS:
15528 case FFELEX_typeSLASH:
15529 return (ffelexHandler) ffestb_decl_ents_7_ (t);
15530
15531 default:
15532 break;
15533 }
15534
15535 bad: /* :::::::::::::::::::: */
15536 if ((ffelex_token_type (ffesta_tokens[1]) != FFELEX_typeNAMES)
15537 && !ffesta_is_inhibited ())
15538 ffestc_decl_finish ();
15539 ffelex_token_kill (ffesta_tokens[1]);
15540 if (ffestb_local_.decl.kindt != NULL)
15541 ffelex_token_kill (ffestb_local_.decl.kindt);
15542 if (ffestb_local_.decl.lent != NULL)
15543 ffelex_token_kill (ffestb_local_.decl.lent);
15544 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
15545 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
15546 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15547 }
15548
15549 /* ffestb_decl_ents_5_ -- "type" [type parameters] [attributes "::"] NAME
15550 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
15551 ASTERISK
15552
15553 return ffestb_decl_ents_5_; // to lexer
15554
15555 Handle NUMBER or OPEN_PAREN. */
15556
15557 static ffelexHandler
15558 ffestb_decl_ents_5_ (ffelexToken t)
15559 {
15560 switch (ffelex_token_type (t))
15561 {
15562 case FFELEX_typeNUMBER:
15563 ffestb_local_.decl.len = NULL;
15564 ffestb_local_.decl.lent = ffelex_token_use (t);
15565 return (ffelexHandler) ffestb_decl_ents_7_;
15566
15567 case FFELEX_typeOPEN_PAREN:
15568 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15569 FFEEXPR_contextCHARACTERSIZE, (ffeexprCallback) ffestb_decl_ents_6_);
15570
15571 default:
15572 break;
15573 }
15574
15575 if (!ffesta_is_inhibited ())
15576 ffestc_decl_finish ();
15577 ffelex_token_kill (ffesta_tokens[1]);
15578 if (ffestb_local_.decl.kindt != NULL)
15579 ffelex_token_kill (ffestb_local_.decl.kindt);
15580 if (ffestb_subrargs_.dim_list.dims != NULL)
15581 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
15582 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
15583 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15584 }
15585
15586 /* ffestb_decl_ents_6_ -- "type" [type parameters] [attributes "::"] NAME
15587 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
15588 ASTERISK OPEN_PAREN expr
15589
15590 (ffestb_decl_ents_6_) // to expression handler
15591
15592 Handle CLOSE_PAREN. */
15593
15594 static ffelexHandler
15595 ffestb_decl_ents_6_ (ffelexToken ft, ffebld expr, ffelexToken t)
15596 {
15597 switch (ffelex_token_type (t))
15598 {
15599 case FFELEX_typeCLOSE_PAREN:
15600 if (expr == NULL)
15601 break;
15602 ffestb_local_.decl.len = expr;
15603 ffestb_local_.decl.lent = ffelex_token_use (ft);
15604 return (ffelexHandler) ffestb_decl_ents_7_;
15605
15606 default:
15607 break;
15608 }
15609
15610 if (!ffesta_is_inhibited ())
15611 ffestc_decl_finish ();
15612 ffelex_token_kill (ffesta_tokens[1]);
15613 if (ffestb_local_.decl.kindt != NULL)
15614 ffelex_token_kill (ffestb_local_.decl.kindt);
15615 if (ffestb_subrargs_.dim_list.dims != NULL)
15616 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
15617 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
15618 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15619 }
15620
15621 /* ffestb_decl_ents_7_ -- "type" [type parameters] [attributes "::"] NAME
15622 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
15623 [ASTERISK charlength]
15624
15625 return ffestb_decl_ents_7_; // to lexer
15626
15627 Handle EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */
15628
15629 static ffelexHandler
15630 ffestb_decl_ents_7_ (ffelexToken t)
15631 {
15632 switch (ffelex_token_type (t))
15633 {
15634 case FFELEX_typeCOMMA:
15635 if (!ffesta_is_inhibited ())
15636 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
15637 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
15638 ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
15639 FALSE);
15640 ffelex_token_kill (ffesta_tokens[1]);
15641 if (ffestb_local_.decl.kindt != NULL)
15642 ffelex_token_kill (ffestb_local_.decl.kindt);
15643 if (ffestb_subrargs_.dim_list.dims != NULL)
15644 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
15645 if (ffestb_local_.decl.lent != NULL)
15646 ffelex_token_kill (ffestb_local_.decl.lent);
15647 return (ffelexHandler) ffestb_decl_ents_;
15648
15649 case FFELEX_typeEOS:
15650 case FFELEX_typeSEMICOLON:
15651 if (!ffesta_is_inhibited ())
15652 {
15653 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
15654 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
15655 ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
15656 FALSE);
15657 ffestc_decl_finish ();
15658 }
15659 ffelex_token_kill (ffesta_tokens[1]);
15660 if (ffestb_local_.decl.kindt != NULL)
15661 ffelex_token_kill (ffestb_local_.decl.kindt);
15662 if (ffestb_subrargs_.dim_list.dims != NULL)
15663 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
15664 if (ffestb_local_.decl.lent != NULL)
15665 ffelex_token_kill (ffestb_local_.decl.lent);
15666 return (ffelexHandler) ffesta_zero (t);
15667
15668 case FFELEX_typeEQUALS:
15669 if (!ffestb_local_.decl.coloncolon)
15670 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_INIT, t);
15671 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
15672 ffestb_local_.decl.parameter ? FFEEXPR_contextPARAMETER
15673 : FFEEXPR_contextINITVAL, (ffeexprCallback) ffestb_decl_ents_8_);
15674
15675 case FFELEX_typeSLASH:
15676 if (!ffesta_is_inhibited ())
15677 {
15678 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
15679 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
15680 ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
15681 TRUE);
15682 ffestc_decl_itemstartvals ();
15683 }
15684 ffelex_token_kill (ffesta_tokens[1]);
15685 if (ffestb_local_.decl.kindt != NULL)
15686 ffelex_token_kill (ffestb_local_.decl.kindt);
15687 if (ffestb_subrargs_.dim_list.dims != NULL)
15688 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
15689 if (ffestb_local_.decl.lent != NULL)
15690 ffelex_token_kill (ffestb_local_.decl.lent);
15691 return (ffelexHandler) ffeexpr_rhs
15692 (ffesta_output_pool, FFEEXPR_contextDATA,
15693 (ffeexprCallback) ffestb_decl_ents_9_);
15694
15695 default:
15696 break;
15697 }
15698
15699 if (!ffesta_is_inhibited ())
15700 ffestc_decl_finish ();
15701 ffelex_token_kill (ffesta_tokens[1]);
15702 if (ffestb_local_.decl.kindt != NULL)
15703 ffelex_token_kill (ffestb_local_.decl.kindt);
15704 if (ffestb_subrargs_.dim_list.dims != NULL)
15705 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
15706 if (ffestb_local_.decl.lent != NULL)
15707 ffelex_token_kill (ffestb_local_.decl.lent);
15708 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
15709 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15710 }
15711
15712 /* ffestb_decl_ents_8_ -- "type" [type parameters] [attributes "::"] NAME
15713 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
15714 [ASTERISK charlength] EQUALS expr
15715
15716 (ffestb_decl_ents_8_) // to expression handler
15717
15718 Handle COMMA or EOS/SEMICOLON. */
15719
15720 static ffelexHandler
15721 ffestb_decl_ents_8_ (ffelexToken ft, ffebld expr, ffelexToken t)
15722 {
15723 switch (ffelex_token_type (t))
15724 {
15725 case FFELEX_typeCOMMA:
15726 if (expr == NULL)
15727 break;
15728 if (!ffesta_is_inhibited ())
15729 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
15730 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
15731 ffestb_local_.decl.len, ffestb_local_.decl.lent, expr, ft,
15732 FALSE);
15733 ffelex_token_kill (ffesta_tokens[1]);
15734 if (ffestb_local_.decl.kindt != NULL)
15735 ffelex_token_kill (ffestb_local_.decl.kindt);
15736 if (ffestb_subrargs_.dim_list.dims != NULL)
15737 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
15738 if (ffestb_local_.decl.lent != NULL)
15739 ffelex_token_kill (ffestb_local_.decl.lent);
15740 return (ffelexHandler) ffestb_decl_ents_;
15741
15742 case FFELEX_typeEOS:
15743 case FFELEX_typeSEMICOLON:
15744 if (!ffesta_is_inhibited ())
15745 {
15746 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
15747 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
15748 ffestb_local_.decl.len, ffestb_local_.decl.lent, expr, ft,
15749 FALSE);
15750 ffestc_decl_finish ();
15751 }
15752 ffelex_token_kill (ffesta_tokens[1]);
15753 if (ffestb_local_.decl.kindt != NULL)
15754 ffelex_token_kill (ffestb_local_.decl.kindt);
15755 if (ffestb_subrargs_.dim_list.dims != NULL)
15756 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
15757 if (ffestb_local_.decl.lent != NULL)
15758 ffelex_token_kill (ffestb_local_.decl.lent);
15759 return (ffelexHandler) ffesta_zero (t);
15760
15761 default:
15762 break;
15763 }
15764
15765 if (!ffesta_is_inhibited ())
15766 ffestc_decl_finish ();
15767 ffelex_token_kill (ffesta_tokens[1]);
15768 if (ffestb_local_.decl.kindt != NULL)
15769 ffelex_token_kill (ffestb_local_.decl.kindt);
15770 if (ffestb_subrargs_.dim_list.dims != NULL)
15771 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
15772 if (ffestb_local_.decl.lent != NULL)
15773 ffelex_token_kill (ffestb_local_.decl.lent);
15774 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
15775 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15776 }
15777
15778 /* ffestb_decl_ents_9_ -- "type" ... SLASH expr
15779
15780 (ffestb_decl_ents_9_) // to expression handler
15781
15782 Handle ASTERISK, COMMA, or SLASH. */
15783
15784 static ffelexHandler
15785 ffestb_decl_ents_9_ (ffelexToken ft, ffebld expr, ffelexToken t)
15786 {
15787 switch (ffelex_token_type (t))
15788 {
15789 case FFELEX_typeCOMMA:
15790 if (expr == NULL)
15791 break;
15792 if (!ffesta_is_inhibited ())
15793 ffestc_decl_itemvalue (NULL, NULL, expr, ft);
15794 return (ffelexHandler) ffeexpr_rhs
15795 (ffesta_output_pool, FFEEXPR_contextDATA,
15796 (ffeexprCallback) ffestb_decl_ents_9_);
15797
15798 case FFELEX_typeASTERISK:
15799 if (expr == NULL)
15800 break;
15801 ffestb_local_.decl.expr = expr;
15802 ffesta_tokens[1] = ffelex_token_use (ft);
15803 return (ffelexHandler) ffeexpr_rhs
15804 (ffesta_output_pool, FFEEXPR_contextDATA,
15805 (ffeexprCallback) ffestb_decl_ents_10_);
15806
15807 case FFELEX_typeSLASH:
15808 if (expr == NULL)
15809 break;
15810 if (!ffesta_is_inhibited ())
15811 {
15812 ffestc_decl_itemvalue (NULL, NULL, expr, ft);
15813 ffestc_decl_itemendvals (t);
15814 }
15815 return (ffelexHandler) ffestb_decl_ents_11_;
15816
15817 default:
15818 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
15819 break;
15820 }
15821
15822 if (!ffesta_is_inhibited ())
15823 {
15824 ffestc_decl_itemendvals (t);
15825 ffestc_decl_finish ();
15826 }
15827 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15828 }
15829
15830 /* ffestb_decl_ents_10_ -- "type" ... SLASH expr ASTERISK expr
15831
15832 (ffestb_decl_ents_10_) // to expression handler
15833
15834 Handle COMMA or SLASH. */
15835
15836 static ffelexHandler
15837 ffestb_decl_ents_10_ (ffelexToken ft, ffebld expr, ffelexToken t)
15838 {
15839 switch (ffelex_token_type (t))
15840 {
15841 case FFELEX_typeCOMMA:
15842 if (expr == NULL)
15843 break;
15844 if (!ffesta_is_inhibited ())
15845 ffestc_decl_itemvalue (ffestb_local_.decl.expr, ffesta_tokens[1],
15846 expr, ft);
15847 ffelex_token_kill (ffesta_tokens[1]);
15848 return (ffelexHandler) ffeexpr_rhs
15849 (ffesta_output_pool, FFEEXPR_contextDATA,
15850 (ffeexprCallback) ffestb_decl_ents_9_);
15851
15852 case FFELEX_typeSLASH:
15853 if (expr == NULL)
15854 break;
15855 if (!ffesta_is_inhibited ())
15856 {
15857 ffestc_decl_itemvalue (ffestb_local_.decl.expr, ffesta_tokens[1],
15858 expr, ft);
15859 ffestc_decl_itemendvals (t);
15860 }
15861 ffelex_token_kill (ffesta_tokens[1]);
15862 return (ffelexHandler) ffestb_decl_ents_11_;
15863
15864 default:
15865 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
15866 break;
15867 }
15868
15869 if (!ffesta_is_inhibited ())
15870 {
15871 ffestc_decl_itemendvals (t);
15872 ffestc_decl_finish ();
15873 }
15874 ffelex_token_kill (ffesta_tokens[1]);
15875 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15876 }
15877
15878 /* ffestb_decl_ents_11_ -- "type" [type parameters] [attributes "::"] NAME
15879 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
15880 [ASTERISK charlength] SLASH initvals SLASH
15881
15882 return ffestb_decl_ents_11_; // to lexer
15883
15884 Handle COMMA or EOS/SEMICOLON. */
15885
15886 static ffelexHandler
15887 ffestb_decl_ents_11_ (ffelexToken t)
15888 {
15889 switch (ffelex_token_type (t))
15890 {
15891 case FFELEX_typeCOMMA:
15892 return (ffelexHandler) ffestb_decl_ents_;
15893
15894 case FFELEX_typeEOS:
15895 case FFELEX_typeSEMICOLON:
15896 if (!ffesta_is_inhibited ())
15897 ffestc_decl_finish ();
15898 return (ffelexHandler) ffesta_zero (t);
15899
15900 default:
15901 break;
15902 }
15903
15904 if (!ffesta_is_inhibited ())
15905 ffestc_decl_finish ();
15906 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
15907 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15908 }
15909
15910 /* ffestb_decl_entsp_ -- "type" [type parameters]
15911
15912 return ffestb_decl_entsp_; // to lexer
15913
15914 Handle NAME or NAMES beginning either an entity (object) declaration or
15915 a function definition.. */
15916
15917 static ffelexHandler
15918 ffestb_decl_entsp_ (ffelexToken t)
15919 {
15920 switch (ffelex_token_type (t))
15921 {
15922 case FFELEX_typeNAME:
15923 ffesta_confirmed ();
15924 ffesta_tokens[1] = ffelex_token_use (t);
15925 return (ffelexHandler) ffestb_decl_entsp_1_;
15926
15927 case FFELEX_typeNAMES:
15928 ffesta_confirmed ();
15929 ffesta_tokens[1] = ffelex_token_use (t);
15930 return (ffelexHandler) ffestb_decl_entsp_2_;
15931
15932 default:
15933 break;
15934 }
15935
15936 if (ffestb_local_.decl.kindt != NULL)
15937 ffelex_token_kill (ffestb_local_.decl.kindt);
15938 if (ffestb_local_.decl.lent != NULL)
15939 ffelex_token_kill (ffestb_local_.decl.lent);
15940 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
15941 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15942 }
15943
15944 /* ffestb_decl_entsp_1_ -- "type" [type parameters] NAME
15945
15946 return ffestb_decl_entsp_1_; // to lexer
15947
15948 If we get another NAME token here, then the previous one must be
15949 "RECURSIVE" or "FUNCTION" and we handle it accordingly. Otherwise,
15950 we send the previous and current token through to _ents_. */
15951
15952 static ffelexHandler
15953 ffestb_decl_entsp_1_ (ffelexToken t)
15954 {
15955 switch (ffelex_token_type (t))
15956 {
15957 case FFELEX_typeNAME:
15958 switch (ffestr_first (ffesta_tokens[1]))
15959 {
15960 case FFESTR_firstFUNCTION:
15961 ffelex_token_kill (ffesta_tokens[1]);
15962 return (ffelexHandler) ffestb_decl_funcname_ (t);
15963
15964 default:
15965 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", ffesta_tokens[1]);
15966 break;
15967 }
15968 break;
15969
15970 default:
15971 if ((ffelex_token_type (ffesta_tokens[1]) != FFELEX_typeNAMES)
15972 && !ffesta_is_inhibited ())
15973 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
15974 ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
15975 ffestb_local_.decl.len, ffestb_local_.decl.lent);
15976 if (ffestb_local_.decl.kindt != NULL)
15977 ffelex_token_kill (ffestb_local_.decl.kindt);
15978 if (ffestb_local_.decl.lent != NULL)
15979 ffelex_token_kill (ffestb_local_.decl.lent);
15980 /* NAME/NAMES token already in ffesta_tokens[1]. */
15981 return (ffelexHandler) ffestb_decl_ents_1_ (t);
15982 }
15983
15984 if (ffestb_local_.decl.kindt != NULL)
15985 ffelex_token_kill (ffestb_local_.decl.kindt);
15986 if (ffestb_local_.decl.lent != NULL)
15987 ffelex_token_kill (ffestb_local_.decl.lent);
15988 ffelex_token_kill (ffesta_tokens[1]);
15989 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
15990 }
15991
15992 /* ffestb_decl_entsp_2_ -- "type" [type parameters] NAMES
15993
15994 return ffestb_decl_entsp_2_; // to lexer
15995
15996 If we get an ASTERISK or OPEN_PAREN here, then if the previous NAMES
15997 begins with "FUNCTION" or "RECURSIVEFUNCTION" and is followed by a
15998 first-name-char, we have a possible syntactically ambiguous situation.
15999 Otherwise, we have a straightforward situation just as if we went
16000 through _entsp_1_ instead of here. */
16001
16002 static ffelexHandler
16003 ffestb_decl_entsp_2_ (ffelexToken t)
16004 {
16005 ffelexToken nt;
16006 bool asterisk_ok;
16007 unsigned const char *p;
16008 ffeTokenLength i;
16009
16010 switch (ffelex_token_type (t))
16011 {
16012 case FFELEX_typeASTERISK:
16013 ffesta_confirmed ();
16014 switch (ffestb_local_.decl.type)
16015 {
16016 case FFESTP_typeINTEGER:
16017 case FFESTP_typeREAL:
16018 case FFESTP_typeCOMPLEX:
16019 case FFESTP_typeLOGICAL:
16020 asterisk_ok = (ffestb_local_.decl.kindt == NULL);
16021 break;
16022
16023 case FFESTP_typeCHARACTER:
16024 asterisk_ok = (ffestb_local_.decl.lent == NULL);
16025 break;
16026
16027 case FFESTP_typeBYTE:
16028 case FFESTP_typeWORD:
16029 default:
16030 asterisk_ok = FALSE;
16031 break;
16032 }
16033 switch (ffestr_first (ffesta_tokens[1]))
16034 {
16035 case FFESTR_firstFUNCTION:
16036 if (!asterisk_ok)
16037 break; /* For our own convenience, treat as non-FN
16038 stmt. */
16039 p = ffelex_token_text (ffesta_tokens[1])
16040 + (i = FFESTR_firstlFUNCTION);
16041 if (!ffesrc_is_name_init (*p))
16042 break;
16043 ffestb_local_.decl.recursive = NULL;
16044 ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
16045 FFESTR_firstlFUNCTION, 0);
16046 return (ffelexHandler) ffestb_decl_entsp_3_;
16047
16048 default:
16049 break;
16050 }
16051 break;
16052
16053 case FFELEX_typeOPEN_PAREN:
16054 ffestb_local_.decl.aster_after = FALSE;
16055 switch (ffestr_first (ffesta_tokens[1]))
16056 {
16057 case FFESTR_firstFUNCTION:
16058 p = ffelex_token_text (ffesta_tokens[1])
16059 + (i = FFESTR_firstlFUNCTION);
16060 if (!ffesrc_is_name_init (*p))
16061 break;
16062 ffestb_local_.decl.recursive = NULL;
16063 ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
16064 FFESTR_firstlFUNCTION, 0);
16065 return (ffelexHandler) ffestb_decl_entsp_5_ (t);
16066
16067 default:
16068 break;
16069 }
16070 if ((ffestb_local_.decl.kindt != NULL)
16071 || (ffestb_local_.decl.lent != NULL))
16072 break; /* Have kind/len type param, definitely not
16073 assignment stmt. */
16074 return (ffelexHandler) ffestb_decl_entsp_1_ (t);
16075
16076 default:
16077 break;
16078 }
16079
16080 nt = ffelex_token_name_from_names (ffesta_tokens[1], 0, 0);
16081 ffelex_token_kill (ffesta_tokens[1]);
16082 ffesta_tokens[1] = nt; /* Change NAMES to NAME. */
16083 return (ffelexHandler) ffestb_decl_entsp_1_ (t);
16084 }
16085
16086 /* ffestb_decl_entsp_3_ -- "type" [type parameters] [RECURSIVE] FUNCTION
16087 NAME ASTERISK
16088
16089 return ffestb_decl_entsp_3_; // to lexer
16090
16091 Handle NUMBER or OPEN_PAREN. */
16092
16093 static ffelexHandler
16094 ffestb_decl_entsp_3_ (ffelexToken t)
16095 {
16096 ffestb_local_.decl.aster_after = TRUE;
16097
16098 switch (ffelex_token_type (t))
16099 {
16100 case FFELEX_typeNUMBER:
16101 switch (ffestb_local_.decl.type)
16102 {
16103 case FFESTP_typeINTEGER:
16104 case FFESTP_typeREAL:
16105 case FFESTP_typeCOMPLEX:
16106 case FFESTP_typeLOGICAL:
16107 ffestb_local_.decl.kindt = ffelex_token_use (t);
16108 break;
16109
16110 case FFESTP_typeCHARACTER:
16111 ffestb_local_.decl.lent = ffelex_token_use (t);
16112 break;
16113
16114 case FFESTP_typeBYTE:
16115 case FFESTP_typeWORD:
16116 default:
16117 assert (FALSE);
16118 }
16119 return (ffelexHandler) ffestb_decl_entsp_5_;
16120
16121 case FFELEX_typeOPEN_PAREN:
16122 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16123 FFEEXPR_contextCHARACTERSIZE,
16124 (ffeexprCallback) ffestb_decl_entsp_4_);
16125
16126 default:
16127 break;
16128 }
16129
16130 if (ffestb_local_.decl.recursive != NULL)
16131 ffelex_token_kill (ffestb_local_.decl.recursive);
16132 if (ffestb_local_.decl.kindt != NULL)
16133 ffelex_token_kill (ffestb_local_.decl.kindt);
16134 if (ffestb_local_.decl.lent != NULL)
16135 ffelex_token_kill (ffestb_local_.decl.lent);
16136 ffelex_token_kill (ffesta_tokens[1]);
16137 ffelex_token_kill (ffesta_tokens[2]);
16138 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
16139 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16140 }
16141
16142 /* ffestb_decl_entsp_4_ -- "type" [type parameters] [RECURSIVE] FUNCTION
16143 NAME ASTERISK OPEN_PAREN expr
16144
16145 (ffestb_decl_entsp_4_) // to expression handler
16146
16147 Allow only CLOSE_PAREN; and deal with character-length expression. */
16148
16149 static ffelexHandler
16150 ffestb_decl_entsp_4_ (ffelexToken ft, ffebld expr, ffelexToken t)
16151 {
16152 switch (ffelex_token_type (t))
16153 {
16154 case FFELEX_typeCLOSE_PAREN:
16155 if (expr == NULL)
16156 break;
16157 switch (ffestb_local_.decl.type)
16158 {
16159 case FFESTP_typeCHARACTER:
16160 ffestb_local_.decl.len = expr;
16161 ffestb_local_.decl.lent = ffelex_token_use (ft);
16162 break;
16163
16164 default:
16165 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
16166 break;
16167 }
16168 return (ffelexHandler) ffestb_decl_entsp_5_;
16169
16170 default:
16171 break;
16172 }
16173
16174 if (ffestb_local_.decl.recursive != NULL)
16175 ffelex_token_kill (ffestb_local_.decl.recursive);
16176 if (ffestb_local_.decl.kindt != NULL)
16177 ffelex_token_kill (ffestb_local_.decl.kindt);
16178 if (ffestb_local_.decl.lent != NULL)
16179 ffelex_token_kill (ffestb_local_.decl.lent);
16180 ffelex_token_kill (ffesta_tokens[1]);
16181 ffelex_token_kill (ffesta_tokens[2]);
16182 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
16183 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16184 }
16185
16186 /* ffestb_decl_entsp_5_ -- "type" [type parameters] [RECURSIVE] FUNCTION
16187 NAME [type parameter]
16188
16189 return ffestb_decl_entsp_5_; // to lexer
16190
16191 Make sure the next token is an OPEN_PAREN. Get the arg list or dimension
16192 list. If it can't be an arg list, or if the CLOSE_PAREN is followed by
16193 something other than EOS/SEMICOLON or NAME, then treat as dimension list
16194 and handle statement as an R426/R501. If it can't be a dimension list, or
16195 if the CLOSE_PAREN is followed by NAME, treat as an arg list and handle
16196 statement as an R1219. If it can be either an arg list or a dimension
16197 list and if the CLOSE_PAREN is followed by EOS/SEMICOLON, ask FFESTC
16198 whether to treat the statement as an R426/R501 or an R1219 and act
16199 accordingly. */
16200
16201 static ffelexHandler
16202 ffestb_decl_entsp_5_ (ffelexToken t)
16203 {
16204 switch (ffelex_token_type (t))
16205 {
16206 case FFELEX_typeOPEN_PAREN:
16207 if (ffestb_local_.decl.aster_after && (ffestb_local_.decl.len != NULL))
16208 { /* "CHARACTER[RECURSIVE]FUNCTIONxyz*(len-expr)
16209 (..." must be a function-stmt, since the
16210 (len-expr) cannot precede (array-spec) in
16211 an object declaration but can precede
16212 (name-list) in a function stmt. */
16213 ffelex_token_kill (ffesta_tokens[1]);
16214 ffesta_tokens[1] = ffesta_tokens[2];
16215 return (ffelexHandler) ffestb_decl_funcname_4_ (t);
16216 }
16217 ffestb_local_.decl.toklist = ffestt_tokenlist_create ();
16218 ffestb_local_.decl.empty = TRUE;
16219 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
16220 return (ffelexHandler) ffestb_decl_entsp_6_;
16221
16222 default:
16223 break;
16224 }
16225
16226 assert (ffestb_local_.decl.aster_after);
16227 ffesta_confirmed (); /* We've seen an ASTERISK, so even EQUALS
16228 confirmed. */
16229 ffestb_subr_ambig_to_ents_ ();
16230 ffestb_subrargs_.dim_list.dims = NULL;
16231 return (ffelexHandler) ffestb_decl_ents_7_ (t);
16232 }
16233
16234 /* ffestb_decl_entsp_6_ -- "type" [type parameters] [RECURSIVE] FUNCTION
16235 NAME [type parameter] OPEN_PAREN
16236
16237 return ffestb_decl_entsp_6_; // to lexer
16238
16239 If CLOSE_PAREN, we definitely have an R1219 function-stmt, since
16240 the notation "name()" is invalid for a declaration. */
16241
16242 static ffelexHandler
16243 ffestb_decl_entsp_6_ (ffelexToken t)
16244 {
16245 ffelexHandler next;
16246
16247 switch (ffelex_token_type (t))
16248 {
16249 case FFELEX_typeCLOSE_PAREN:
16250 if (!ffestb_local_.decl.empty)
16251 { /* Trailing comma, just a warning for
16252 stmt func def, so allow ambiguity. */
16253 ffestt_tokenlist_append (ffestb_local_.decl.toklist,
16254 ffelex_token_use (t));
16255 return (ffelexHandler) ffestb_decl_entsp_8_;
16256 }
16257 ffelex_token_kill (ffesta_tokens[1]);
16258 ffesta_tokens[1] = ffesta_tokens[2];
16259 next = (ffelexHandler) ffestt_tokenlist_handle
16260 (ffestb_local_.decl.toklist, (ffelexHandler) ffestb_decl_funcname_4_);
16261 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
16262 return (ffelexHandler) (*next) (t);
16263
16264 case FFELEX_typeNAME:
16265 ffestb_local_.decl.empty = FALSE;
16266 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
16267 return (ffelexHandler) ffestb_decl_entsp_7_;
16268
16269 case FFELEX_typeEQUALS:
16270 case FFELEX_typePOINTS:
16271 case FFELEX_typePERCENT:
16272 case FFELEX_typePERIOD:
16273 case FFELEX_typeOPEN_PAREN:
16274 if ((ffestb_local_.decl.kindt != NULL)
16275 || (ffestb_local_.decl.lent != NULL))
16276 break; /* type(params)name or type*val name, either
16277 way confirmed. */
16278 return (ffelexHandler) ffestb_subr_ambig_nope_ (t);
16279
16280 default:
16281 break;
16282 }
16283
16284 ffesta_confirmed ();
16285 ffestb_subr_ambig_to_ents_ ();
16286 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
16287 (ffelexHandler) ffestb_decl_ents_3_);
16288 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
16289 return (ffelexHandler) (*next) (t);
16290 }
16291
16292 /* ffestb_decl_entsp_7_ -- "type" [type parameters] [RECURSIVE] FUNCTION
16293 NAME [type parameter] OPEN_PAREN NAME
16294
16295 return ffestb_decl_entsp_7_; // to lexer
16296
16297 Expect COMMA or CLOSE_PAREN to remain ambiguous, else not an R1219
16298 function-stmt. */
16299
16300 static ffelexHandler
16301 ffestb_decl_entsp_7_ (ffelexToken t)
16302 {
16303 ffelexHandler next;
16304
16305 switch (ffelex_token_type (t))
16306 {
16307 case FFELEX_typeCLOSE_PAREN:
16308 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
16309 return (ffelexHandler) ffestb_decl_entsp_8_;
16310
16311 case FFELEX_typeCOMMA:
16312 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
16313 return (ffelexHandler) ffestb_decl_entsp_6_;
16314
16315 case FFELEX_typeEQUALS:
16316 case FFELEX_typePOINTS:
16317 case FFELEX_typePERCENT:
16318 case FFELEX_typePERIOD:
16319 case FFELEX_typeOPEN_PAREN:
16320 if ((ffestb_local_.decl.kindt != NULL)
16321 || (ffestb_local_.decl.lent != NULL))
16322 break; /* type(params)name or type*val name, either
16323 way confirmed. */
16324 return (ffelexHandler) ffestb_subr_ambig_nope_ (t);
16325
16326 default:
16327 break;
16328 }
16329
16330 ffesta_confirmed ();
16331 ffestb_subr_ambig_to_ents_ ();
16332 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
16333 (ffelexHandler) ffestb_decl_ents_3_);
16334 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
16335 return (ffelexHandler) (*next) (t);
16336 }
16337
16338 /* ffestb_decl_entsp_8_ -- "type" [type parameters] [RECURSIVE] FUNCTION
16339 NAME [type parameter] OPEN_PAREN name-list
16340 CLOSE_PAREN
16341
16342 return ffestb_decl_entsp_8_; // to lexer
16343
16344 If EOS/SEMICOLON, situation remains ambiguous, ask FFESTC to resolve
16345 it. If NAME (must be "RESULT", but that is checked later on),
16346 definitely an R1219 function-stmt. Anything else, handle as entity decl. */
16347
16348 static ffelexHandler
16349 ffestb_decl_entsp_8_ (ffelexToken t)
16350 {
16351 ffelexHandler next;
16352
16353 switch (ffelex_token_type (t))
16354 {
16355 case FFELEX_typeEOS:
16356 case FFELEX_typeSEMICOLON:
16357 ffesta_confirmed ();
16358 if (ffestc_is_decl_not_R1219 ())
16359 break;
16360 /* Fall through. */
16361 case FFELEX_typeNAME:
16362 ffesta_confirmed ();
16363 ffelex_token_kill (ffesta_tokens[1]);
16364 ffesta_tokens[1] = ffesta_tokens[2];
16365 next = (ffelexHandler) ffestt_tokenlist_handle
16366 (ffestb_local_.decl.toklist, (ffelexHandler) ffestb_decl_funcname_4_);
16367 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
16368 return (ffelexHandler) (*next) (t);
16369
16370 case FFELEX_typeEQUALS:
16371 case FFELEX_typePOINTS:
16372 case FFELEX_typePERCENT:
16373 case FFELEX_typePERIOD:
16374 case FFELEX_typeOPEN_PAREN:
16375 if ((ffestb_local_.decl.kindt != NULL)
16376 || (ffestb_local_.decl.lent != NULL))
16377 break; /* type(params)name or type*val name, either
16378 way confirmed. */
16379 return (ffelexHandler) ffestb_subr_ambig_nope_ (t);
16380
16381 default:
16382 break;
16383 }
16384
16385 ffesta_confirmed ();
16386 ffestb_subr_ambig_to_ents_ ();
16387 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
16388 (ffelexHandler) ffestb_decl_ents_3_);
16389 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
16390 return (ffelexHandler) (*next) (t);
16391 }
16392
16393 /* ffestb_decl_funcname_ -- "type" [type parameters] [RECURSIVE] FUNCTION
16394
16395 return ffestb_decl_funcname_; // to lexer
16396
16397 Handle NAME of a function. */
16398
16399 static ffelexHandler
16400 ffestb_decl_funcname_ (ffelexToken t)
16401 {
16402 switch (ffelex_token_type (t))
16403 {
16404 case FFELEX_typeNAME:
16405 ffesta_tokens[1] = ffelex_token_use (t);
16406 return (ffelexHandler) ffestb_decl_funcname_1_;
16407
16408 default:
16409 break;
16410 }
16411
16412 if (ffestb_local_.decl.recursive != NULL)
16413 ffelex_token_kill (ffestb_local_.decl.recursive);
16414 if (ffestb_local_.decl.kindt != NULL)
16415 ffelex_token_kill (ffestb_local_.decl.kindt);
16416 if (ffestb_local_.decl.lent != NULL)
16417 ffelex_token_kill (ffestb_local_.decl.lent);
16418 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
16419 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16420 }
16421
16422 /* ffestb_decl_funcname_1_ -- "type" [type parameters] [RECURSIVE] FUNCTION
16423 NAME
16424
16425 return ffestb_decl_funcname_1_; // to lexer
16426
16427 Handle ASTERISK or OPEN_PAREN. */
16428
16429 static ffelexHandler
16430 ffestb_decl_funcname_1_ (ffelexToken t)
16431 {
16432 switch (ffelex_token_type (t))
16433 {
16434 case FFELEX_typeASTERISK:
16435 return (ffelexHandler) ffestb_decl_funcname_2_;
16436
16437 case FFELEX_typeOPEN_PAREN:
16438 return (ffelexHandler) ffestb_decl_funcname_4_ (t);
16439
16440 default:
16441 break;
16442 }
16443
16444 if (ffestb_local_.decl.recursive != NULL)
16445 ffelex_token_kill (ffestb_local_.decl.recursive);
16446 if (ffestb_local_.decl.kindt != NULL)
16447 ffelex_token_kill (ffestb_local_.decl.kindt);
16448 if (ffestb_local_.decl.lent != NULL)
16449 ffelex_token_kill (ffestb_local_.decl.lent);
16450 ffelex_token_kill (ffesta_tokens[1]);
16451 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
16452 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16453 }
16454
16455 /* ffestb_decl_funcname_2_ -- "type" [type parameters] [RECURSIVE] FUNCTION
16456 NAME ASTERISK
16457
16458 return ffestb_decl_funcname_2_; // to lexer
16459
16460 Handle NUMBER or OPEN_PAREN. */
16461
16462 static ffelexHandler
16463 ffestb_decl_funcname_2_ (ffelexToken t)
16464 {
16465 switch (ffelex_token_type (t))
16466 {
16467 case FFELEX_typeNUMBER:
16468 switch (ffestb_local_.decl.type)
16469 {
16470 case FFESTP_typeINTEGER:
16471 case FFESTP_typeREAL:
16472 case FFESTP_typeCOMPLEX:
16473 case FFESTP_typeLOGICAL:
16474 if (ffestb_local_.decl.kindt == NULL)
16475 ffestb_local_.decl.kindt = ffelex_token_use (t);
16476 else
16477 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
16478 break;
16479
16480 case FFESTP_typeCHARACTER:
16481 if (ffestb_local_.decl.lent == NULL)
16482 ffestb_local_.decl.lent = ffelex_token_use (t);
16483 else
16484 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
16485 break;
16486
16487 case FFESTP_typeBYTE:
16488 case FFESTP_typeWORD:
16489 default:
16490 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
16491 break;
16492 }
16493 return (ffelexHandler) ffestb_decl_funcname_4_;
16494
16495 case FFELEX_typeOPEN_PAREN:
16496 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16497 FFEEXPR_contextCHARACTERSIZE,
16498 (ffeexprCallback) ffestb_decl_funcname_3_);
16499
16500 default:
16501 break;
16502 }
16503
16504 if (ffestb_local_.decl.recursive != NULL)
16505 ffelex_token_kill (ffestb_local_.decl.recursive);
16506 if (ffestb_local_.decl.kindt != NULL)
16507 ffelex_token_kill (ffestb_local_.decl.kindt);
16508 if (ffestb_local_.decl.lent != NULL)
16509 ffelex_token_kill (ffestb_local_.decl.lent);
16510 ffelex_token_kill (ffesta_tokens[1]);
16511 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
16512 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16513 }
16514
16515 /* ffestb_decl_funcname_3_ -- "type" [type parameters] [RECURSIVE] FUNCTION
16516 NAME ASTERISK OPEN_PAREN expr
16517
16518 (ffestb_decl_funcname_3_) // to expression handler
16519
16520 Allow only CLOSE_PAREN; and deal with character-length expression. */
16521
16522 static ffelexHandler
16523 ffestb_decl_funcname_3_ (ffelexToken ft, ffebld expr, ffelexToken t)
16524 {
16525 switch (ffelex_token_type (t))
16526 {
16527 case FFELEX_typeCLOSE_PAREN:
16528 if (expr == NULL)
16529 break;
16530 switch (ffestb_local_.decl.type)
16531 {
16532 case FFESTP_typeCHARACTER:
16533 if (ffestb_local_.decl.lent == NULL)
16534 {
16535 ffestb_local_.decl.len = expr;
16536 ffestb_local_.decl.lent = ffelex_token_use (ft);
16537 }
16538 else
16539 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
16540 break;
16541
16542 default:
16543 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
16544 break;
16545 }
16546 return (ffelexHandler) ffestb_decl_funcname_4_;
16547
16548 default:
16549 break;
16550 }
16551
16552 if (ffestb_local_.decl.recursive != NULL)
16553 ffelex_token_kill (ffestb_local_.decl.recursive);
16554 if (ffestb_local_.decl.kindt != NULL)
16555 ffelex_token_kill (ffestb_local_.decl.kindt);
16556 if (ffestb_local_.decl.lent != NULL)
16557 ffelex_token_kill (ffestb_local_.decl.lent);
16558 ffelex_token_kill (ffesta_tokens[1]);
16559 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
16560 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16561 }
16562
16563 /* ffestb_decl_funcname_4_ -- "type" [type parameters] [RECURSIVE] FUNCTION
16564 NAME [type parameter]
16565
16566 return ffestb_decl_funcname_4_; // to lexer
16567
16568 Make sure the next token is an OPEN_PAREN. Get the arg list and
16569 then implement. */
16570
16571 static ffelexHandler
16572 ffestb_decl_funcname_4_ (ffelexToken t)
16573 {
16574 switch (ffelex_token_type (t))
16575 {
16576 case FFELEX_typeOPEN_PAREN:
16577 ffestb_subrargs_.name_list.args = ffestt_tokenlist_create ();
16578 ffestb_subrargs_.name_list.handler
16579 = (ffelexHandler) ffestb_decl_funcname_5_;
16580 ffestb_subrargs_.name_list.is_subr = FALSE;
16581 ffestb_subrargs_.name_list.names = FALSE;
16582 return (ffelexHandler) ffestb_subr_name_list_;
16583
16584 default:
16585 break;
16586 }
16587
16588 if (ffestb_local_.decl.recursive != NULL)
16589 ffelex_token_kill (ffestb_local_.decl.recursive);
16590 if (ffestb_local_.decl.kindt != NULL)
16591 ffelex_token_kill (ffestb_local_.decl.kindt);
16592 if (ffestb_local_.decl.lent != NULL)
16593 ffelex_token_kill (ffestb_local_.decl.lent);
16594 ffelex_token_kill (ffesta_tokens[1]);
16595 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
16596 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16597 }
16598
16599 /* ffestb_decl_funcname_5_ -- "type" [type parameters] [RECURSIVE] FUNCTION
16600 NAME [type parameter] OPEN_PAREN arg-list
16601 CLOSE_PAREN
16602
16603 return ffestb_decl_funcname_5_; // to lexer
16604
16605 Must have EOS/SEMICOLON or "RESULT" here. */
16606
16607 static ffelexHandler
16608 ffestb_decl_funcname_5_ (ffelexToken t)
16609 {
16610 if (!ffestb_subrargs_.name_list.ok)
16611 goto bad; /* :::::::::::::::::::: */
16612
16613 switch (ffelex_token_type (t))
16614 {
16615 case FFELEX_typeEOS:
16616 case FFELEX_typeSEMICOLON:
16617 ffesta_confirmed ();
16618 if (!ffesta_is_inhibited ())
16619 ffestc_R1219 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
16620 ffestb_subrargs_.name_list.close_paren, ffestb_local_.decl.type,
16621 ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
16622 ffestb_local_.decl.len, ffestb_local_.decl.lent,
16623 ffestb_local_.decl.recursive, NULL);
16624 if (ffestb_local_.decl.recursive != NULL)
16625 ffelex_token_kill (ffestb_local_.decl.recursive);
16626 if (ffestb_local_.decl.kindt != NULL)
16627 ffelex_token_kill (ffestb_local_.decl.kindt);
16628 if (ffestb_local_.decl.lent != NULL)
16629 ffelex_token_kill (ffestb_local_.decl.lent);
16630 ffelex_token_kill (ffesta_tokens[1]);
16631 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
16632 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
16633 return (ffelexHandler) ffesta_zero (t);
16634
16635 case FFELEX_typeNAME:
16636 if (ffestr_other (t) != FFESTR_otherRESULT)
16637 break;
16638 return (ffelexHandler) ffestb_decl_funcname_6_;
16639
16640 default:
16641 break;
16642 }
16643
16644 bad: /* :::::::::::::::::::: */
16645 if (ffestb_local_.decl.recursive != NULL)
16646 ffelex_token_kill (ffestb_local_.decl.recursive);
16647 if (ffestb_local_.decl.kindt != NULL)
16648 ffelex_token_kill (ffestb_local_.decl.kindt);
16649 if (ffestb_local_.decl.lent != NULL)
16650 ffelex_token_kill (ffestb_local_.decl.lent);
16651 ffelex_token_kill (ffesta_tokens[1]);
16652 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
16653 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
16654 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
16655 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16656 }
16657
16658 /* ffestb_decl_funcname_6_ -- "type" [type parameters] [RECURSIVE] FUNCTION
16659 NAME [type parameter] OPEN_PAREN arglist
16660 CLOSE_PAREN "RESULT"
16661
16662 return ffestb_decl_funcname_6_; // to lexer
16663
16664 Make sure the next token is an OPEN_PAREN. */
16665
16666 static ffelexHandler
16667 ffestb_decl_funcname_6_ (ffelexToken t)
16668 {
16669 switch (ffelex_token_type (t))
16670 {
16671 case FFELEX_typeOPEN_PAREN:
16672 return (ffelexHandler) ffestb_decl_funcname_7_;
16673
16674 default:
16675 break;
16676 }
16677
16678 if (ffestb_local_.decl.recursive != NULL)
16679 ffelex_token_kill (ffestb_local_.decl.recursive);
16680 if (ffestb_local_.decl.kindt != NULL)
16681 ffelex_token_kill (ffestb_local_.decl.kindt);
16682 if (ffestb_local_.decl.lent != NULL)
16683 ffelex_token_kill (ffestb_local_.decl.lent);
16684 ffelex_token_kill (ffesta_tokens[1]);
16685 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
16686 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
16687 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
16688 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16689 }
16690
16691 /* ffestb_decl_funcname_7_ -- "type" [type parameters] [RECURSIVE] FUNCTION
16692 NAME [type parameter] OPEN_PAREN arglist
16693 CLOSE_PAREN "RESULT" OPEN_PAREN
16694
16695 return ffestb_decl_funcname_7_; // to lexer
16696
16697 Make sure the next token is a NAME. */
16698
16699 static ffelexHandler
16700 ffestb_decl_funcname_7_ (ffelexToken t)
16701 {
16702 switch (ffelex_token_type (t))
16703 {
16704 case FFELEX_typeNAME:
16705 ffesta_tokens[2] = ffelex_token_use (t);
16706 return (ffelexHandler) ffestb_decl_funcname_8_;
16707
16708 default:
16709 break;
16710 }
16711
16712 if (ffestb_local_.decl.recursive != NULL)
16713 ffelex_token_kill (ffestb_local_.decl.recursive);
16714 if (ffestb_local_.decl.kindt != NULL)
16715 ffelex_token_kill (ffestb_local_.decl.kindt);
16716 if (ffestb_local_.decl.lent != NULL)
16717 ffelex_token_kill (ffestb_local_.decl.lent);
16718 ffelex_token_kill (ffesta_tokens[1]);
16719 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
16720 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
16721 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
16722 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16723 }
16724
16725 /* ffestb_decl_funcname_8_ -- "type" [type parameters] [RECURSIVE] FUNCTION
16726 NAME [type parameter] OPEN_PAREN arglist
16727 CLOSE_PAREN "RESULT" OPEN_PAREN NAME
16728
16729 return ffestb_decl_funcname_8_; // to lexer
16730
16731 Make sure the next token is a CLOSE_PAREN. */
16732
16733 static ffelexHandler
16734 ffestb_decl_funcname_8_ (ffelexToken t)
16735 {
16736 switch (ffelex_token_type (t))
16737 {
16738 case FFELEX_typeCLOSE_PAREN:
16739 return (ffelexHandler) ffestb_decl_funcname_9_;
16740
16741 default:
16742 break;
16743 }
16744
16745 if (ffestb_local_.decl.recursive != NULL)
16746 ffelex_token_kill (ffestb_local_.decl.recursive);
16747 if (ffestb_local_.decl.kindt != NULL)
16748 ffelex_token_kill (ffestb_local_.decl.kindt);
16749 if (ffestb_local_.decl.lent != NULL)
16750 ffelex_token_kill (ffestb_local_.decl.lent);
16751 ffelex_token_kill (ffesta_tokens[1]);
16752 ffelex_token_kill (ffesta_tokens[2]);
16753 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
16754 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
16755 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
16756 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16757 }
16758
16759 /* ffestb_decl_funcname_9_ -- "type" [type parameters] [RECURSIVE] FUNCTION
16760 NAME [type parameter] OPEN_PAREN arg-list
16761 CLOSE_PAREN "RESULT" OPEN_PAREN NAME CLOSE_PAREN
16762
16763 return ffestb_decl_funcname_9_; // to lexer
16764
16765 Must have EOS/SEMICOLON here. */
16766
16767 static ffelexHandler
16768 ffestb_decl_funcname_9_ (ffelexToken t)
16769 {
16770 switch (ffelex_token_type (t))
16771 {
16772 case FFELEX_typeEOS:
16773 case FFELEX_typeSEMICOLON:
16774 if (!ffesta_is_inhibited ())
16775 ffestc_R1219 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
16776 ffestb_subrargs_.name_list.close_paren, ffestb_local_.decl.type,
16777 ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
16778 ffestb_local_.decl.len, ffestb_local_.decl.lent,
16779 ffestb_local_.decl.recursive, ffesta_tokens[2]);
16780 if (ffestb_local_.decl.recursive != NULL)
16781 ffelex_token_kill (ffestb_local_.decl.recursive);
16782 if (ffestb_local_.decl.kindt != NULL)
16783 ffelex_token_kill (ffestb_local_.decl.kindt);
16784 if (ffestb_local_.decl.lent != NULL)
16785 ffelex_token_kill (ffestb_local_.decl.lent);
16786 ffelex_token_kill (ffesta_tokens[1]);
16787 ffelex_token_kill (ffesta_tokens[2]);
16788 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
16789 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
16790 return (ffelexHandler) ffesta_zero (t);
16791
16792 default:
16793 break;
16794 }
16795
16796 if (ffestb_local_.decl.recursive != NULL)
16797 ffelex_token_kill (ffestb_local_.decl.recursive);
16798 if (ffestb_local_.decl.kindt != NULL)
16799 ffelex_token_kill (ffestb_local_.decl.kindt);
16800 if (ffestb_local_.decl.lent != NULL)
16801 ffelex_token_kill (ffestb_local_.decl.lent);
16802 ffelex_token_kill (ffesta_tokens[1]);
16803 ffelex_token_kill (ffesta_tokens[2]);
16804 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
16805 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
16806 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
16807 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16808 }
16809 /* ffestb_V027 -- Parse the VXT PARAMETER statement
16810
16811 return ffestb_V027; // to lexer
16812
16813 Make sure the statement has a valid form for the VXT PARAMETER statement.
16814 If it does, implement the statement. */
16815
16816 ffelexHandler
16817 ffestb_V027 (ffelexToken t)
16818 {
16819 unsigned const char *p;
16820 ffeTokenLength i;
16821
16822 switch (ffelex_token_type (ffesta_tokens[0]))
16823 {
16824 case FFELEX_typeNAME:
16825 if (ffesta_first_kw != FFESTR_firstPARAMETER)
16826 goto bad_0; /* :::::::::::::::::::: */
16827 switch (ffelex_token_type (t))
16828 {
16829 case FFELEX_typeNAME:
16830 break;
16831
16832 default:
16833 goto bad_1; /* :::::::::::::::::::: */
16834 }
16835 ffesta_confirmed ();
16836 ffestb_local_.vxtparam.started = TRUE;
16837 if (!ffesta_is_inhibited ())
16838 ffestc_V027_start ();
16839 ffesta_tokens[1] = ffelex_token_use (t);
16840 return (ffelexHandler) ffestb_V0271_;
16841
16842 case FFELEX_typeNAMES:
16843 if (ffesta_first_kw != FFESTR_firstPARAMETER)
16844 goto bad_0; /* :::::::::::::::::::: */
16845 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlPARAMETER);
16846 switch (ffelex_token_type (t))
16847 {
16848 case FFELEX_typeEQUALS:
16849 break;
16850
16851 default:
16852 goto bad_1; /* :::::::::::::::::::: */
16853 }
16854 if (!ffesrc_is_name_init (*p))
16855 goto bad_i; /* :::::::::::::::::::: */
16856 ffestb_local_.vxtparam.started = FALSE;
16857 ffesta_tokens[1] = ffelex_token_name_from_names (ffesta_tokens[0], i,
16858 0);
16859 return (ffelexHandler) ffestb_V0271_ (t);
16860
16861 default:
16862 goto bad_0; /* :::::::::::::::::::: */
16863 }
16864
16865 bad_0: /* :::::::::::::::::::: */
16866 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", ffesta_tokens[0]);
16867 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16868
16869 bad_1: /* :::::::::::::::::::: */
16870 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
16871 return (ffelexHandler) ffelex_swallow_tokens (t,
16872 (ffelexHandler) ffesta_zero); /* Invalid second token. */
16873
16874 bad_i: /* :::::::::::::::::::: */
16875 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "PARAMETER", ffesta_tokens[0], i, t);
16876 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16877 }
16878
16879 /* ffestb_V0271_ -- "PARAMETER" NAME
16880
16881 return ffestb_V0271_; // to lexer
16882
16883 Handle EQUALS. */
16884
16885 static ffelexHandler
16886 ffestb_V0271_ (ffelexToken t)
16887 {
16888 switch (ffelex_token_type (t))
16889 {
16890 case FFELEX_typeEQUALS:
16891 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
16892 FFEEXPR_contextPARAMETER, (ffeexprCallback) ffestb_V0272_);
16893
16894 default:
16895 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
16896 break;
16897 }
16898
16899 ffelex_token_kill (ffesta_tokens[1]);
16900 if (ffestb_local_.vxtparam.started && !ffesta_is_inhibited ())
16901 ffestc_V027_finish ();
16902 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16903 }
16904
16905 /* ffestb_V0272_ -- "PARAMETER" NAME EQUALS expr
16906
16907 (ffestb_V0272_) // to expression handler
16908
16909 Handle COMMA or EOS/SEMICOLON. */
16910
16911 static ffelexHandler
16912 ffestb_V0272_ (ffelexToken ft, ffebld expr, ffelexToken t)
16913 {
16914 switch (ffelex_token_type (t))
16915 {
16916 case FFELEX_typeEOS:
16917 case FFELEX_typeSEMICOLON:
16918 if (!ffestb_local_.vxtparam.started)
16919 {
16920 if (ffestc_is_let_not_V027 ())
16921 break; /* Not a valid VXTPARAMETER stmt. */
16922 ffesta_confirmed ();
16923 if (!ffesta_is_inhibited ())
16924 ffestc_V027_start ();
16925 ffestb_local_.vxtparam.started = TRUE;
16926 }
16927 if (expr == NULL)
16928 break;
16929 if (!ffesta_is_inhibited ())
16930 {
16931 ffestc_V027_item (ffesta_tokens[1], expr, ft);
16932 ffestc_V027_finish ();
16933 }
16934 ffelex_token_kill (ffesta_tokens[1]);
16935 return (ffelexHandler) ffesta_zero (t);
16936
16937 case FFELEX_typeCOMMA:
16938 ffesta_confirmed ();
16939 if (!ffestb_local_.vxtparam.started)
16940 {
16941 if (!ffesta_is_inhibited ())
16942 ffestc_V027_start ();
16943 ffestb_local_.vxtparam.started = TRUE;
16944 }
16945 if (expr == NULL)
16946 break;
16947 if (!ffesta_is_inhibited ())
16948 ffestc_V027_item (ffesta_tokens[1], expr, ft);
16949 ffelex_token_kill (ffesta_tokens[1]);
16950 return (ffelexHandler) ffestb_V0273_;
16951
16952 default:
16953 break;
16954 }
16955
16956 ffelex_token_kill (ffesta_tokens[1]);
16957 if (ffestb_local_.vxtparam.started && !ffesta_is_inhibited ())
16958 ffestc_V027_finish ();
16959 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
16960 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16961 }
16962
16963 /* ffestb_V0273_ -- "PARAMETER" NAME EQUALS expr COMMA
16964
16965 return ffestb_V0273_; // to lexer
16966
16967 Handle NAME. */
16968
16969 static ffelexHandler
16970 ffestb_V0273_ (ffelexToken t)
16971 {
16972 switch (ffelex_token_type (t))
16973 {
16974 case FFELEX_typeNAME:
16975 ffesta_tokens[1] = ffelex_token_use (t);
16976 return (ffelexHandler) ffestb_V0271_;
16977
16978 default:
16979 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
16980 break;
16981 }
16982
16983 if (ffestb_local_.vxtparam.started && !ffesta_is_inhibited ())
16984 ffestc_V027_finish ();
16985 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
16986 }
16987
16988 /* ffestb_decl_R539 -- Parse the IMPLICIT FUNCTION statement
16989
16990 return ffestb_decl_R539; // to lexer
16991
16992 Make sure the statement has a valid form for the IMPLICIT
16993 statement. If it does, implement the statement. */
16994
16995 ffelexHandler
16996 ffestb_decl_R539 (ffelexToken t)
16997 {
16998 ffeTokenLength i;
16999 unsigned const char *p;
17000 ffelexToken nt;
17001 ffestrSecond kw;
17002
17003 ffestb_local_.decl.recursive = NULL;
17004
17005 switch (ffelex_token_type (ffesta_tokens[0]))
17006 {
17007 case FFELEX_typeNAME:
17008 if (ffesta_first_kw != FFESTR_firstIMPLICIT)
17009 goto bad_0; /* :::::::::::::::::::: */
17010 switch (ffelex_token_type (t))
17011 {
17012 case FFELEX_typeEOS:
17013 case FFELEX_typeSEMICOLON:
17014 case FFELEX_typeCOMMA:
17015 case FFELEX_typeCOLONCOLON:
17016 ffesta_confirmed (); /* Error, but clearly intended. */
17017 goto bad_1; /* :::::::::::::::::::: */
17018
17019 default:
17020 goto bad_1; /* :::::::::::::::::::: */
17021
17022 case FFELEX_typeNAME:
17023 break;
17024 }
17025 ffesta_confirmed ();
17026 ffestb_local_.decl.imp_started = FALSE;
17027 switch (ffesta_second_kw)
17028 {
17029 case FFESTR_secondINTEGER:
17030 ffestb_local_.decl.type = FFESTP_typeINTEGER;
17031 return (ffelexHandler) ffestb_decl_R5391_;
17032
17033 case FFESTR_secondBYTE:
17034 ffestb_local_.decl.type = FFESTP_typeBYTE;
17035 return (ffelexHandler) ffestb_decl_R5391_;
17036
17037 case FFESTR_secondWORD:
17038 ffestb_local_.decl.type = FFESTP_typeWORD;
17039 return (ffelexHandler) ffestb_decl_R5391_;
17040
17041 case FFESTR_secondREAL:
17042 ffestb_local_.decl.type = FFESTP_typeREAL;
17043 return (ffelexHandler) ffestb_decl_R5391_;
17044
17045 case FFESTR_secondCOMPLEX:
17046 ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
17047 return (ffelexHandler) ffestb_decl_R5391_;
17048
17049 case FFESTR_secondLOGICAL:
17050 ffestb_local_.decl.type = FFESTP_typeLOGICAL;
17051 return (ffelexHandler) ffestb_decl_R5391_;
17052
17053 case FFESTR_secondCHARACTER:
17054 ffestb_local_.decl.type = FFESTP_typeCHARACTER;
17055 return (ffelexHandler) ffestb_decl_R5391_;
17056
17057 case FFESTR_secondDOUBLE:
17058 return (ffelexHandler) ffestb_decl_R5392_;
17059
17060 case FFESTR_secondDOUBLEPRECISION:
17061 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
17062 ffestb_local_.decl.kind = NULL;
17063 ffestb_local_.decl.kindt = NULL;
17064 ffestb_local_.decl.len = NULL;
17065 ffestb_local_.decl.lent = NULL;
17066 return (ffelexHandler) ffestb_decl_R539letters_;
17067
17068 case FFESTR_secondDOUBLECOMPLEX:
17069 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
17070 ffestb_local_.decl.kind = NULL;
17071 ffestb_local_.decl.kindt = NULL;
17072 ffestb_local_.decl.len = NULL;
17073 ffestb_local_.decl.lent = NULL;
17074 return (ffelexHandler) ffestb_decl_R539letters_;
17075
17076 case FFESTR_secondNONE:
17077 return (ffelexHandler) ffestb_decl_R5394_;
17078
17079 default:
17080 goto bad_1; /* :::::::::::::::::::: */
17081 }
17082
17083 case FFELEX_typeNAMES:
17084 if (ffesta_first_kw != FFESTR_firstIMPLICIT)
17085 goto bad_0; /* :::::::::::::::::::: */
17086 switch (ffelex_token_type (t))
17087 {
17088 case FFELEX_typeCOMMA:
17089 case FFELEX_typeCOLONCOLON:
17090 case FFELEX_typeASTERISK:
17091 case FFELEX_typeSEMICOLON:
17092 case FFELEX_typeEOS:
17093 ffesta_confirmed ();
17094 break;
17095
17096 case FFELEX_typeOPEN_PAREN:
17097 break;
17098
17099 default:
17100 goto bad_1; /* :::::::::::::::::::: */
17101 }
17102 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlIMPLICIT);
17103 if (!ffesrc_is_name_init (*p))
17104 goto bad_0; /* :::::::::::::::::::: */
17105 ffestb_local_.decl.imp_started = FALSE;
17106 nt = ffelex_token_name_from_names (ffesta_tokens[0],
17107 FFESTR_firstlIMPLICIT, 0);
17108 kw = ffestr_second (nt);
17109 ffelex_token_kill (nt);
17110 switch (kw)
17111 {
17112 case FFESTR_secondINTEGER:
17113 ffestb_local_.decl.type = FFESTP_typeINTEGER;
17114 return (ffelexHandler) ffestb_decl_R5391_ (t);
17115
17116 case FFESTR_secondBYTE:
17117 ffestb_local_.decl.type = FFESTP_typeBYTE;
17118 return (ffelexHandler) ffestb_decl_R5391_ (t);
17119
17120 case FFESTR_secondWORD:
17121 ffestb_local_.decl.type = FFESTP_typeWORD;
17122 return (ffelexHandler) ffestb_decl_R5391_ (t);
17123
17124 case FFESTR_secondREAL:
17125 ffestb_local_.decl.type = FFESTP_typeREAL;
17126 return (ffelexHandler) ffestb_decl_R5391_ (t);
17127
17128 case FFESTR_secondCOMPLEX:
17129 ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
17130 return (ffelexHandler) ffestb_decl_R5391_ (t);
17131
17132 case FFESTR_secondLOGICAL:
17133 ffestb_local_.decl.type = FFESTP_typeLOGICAL;
17134 return (ffelexHandler) ffestb_decl_R5391_ (t);
17135
17136 case FFESTR_secondCHARACTER:
17137 ffestb_local_.decl.type = FFESTP_typeCHARACTER;
17138 return (ffelexHandler) ffestb_decl_R5391_ (t);
17139
17140 case FFESTR_secondDOUBLEPRECISION:
17141 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
17142 ffestb_local_.decl.kind = NULL;
17143 ffestb_local_.decl.kindt = NULL;
17144 ffestb_local_.decl.len = NULL;
17145 ffestb_local_.decl.lent = NULL;
17146 return (ffelexHandler) ffestb_decl_R539letters_ (t);
17147
17148 case FFESTR_secondDOUBLECOMPLEX:
17149 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
17150 ffestb_local_.decl.kind = NULL;
17151 ffestb_local_.decl.kindt = NULL;
17152 ffestb_local_.decl.len = NULL;
17153 ffestb_local_.decl.lent = NULL;
17154 return (ffelexHandler) ffestb_decl_R539letters_ (t);
17155
17156 case FFESTR_secondNONE:
17157 return (ffelexHandler) ffestb_decl_R5394_ (t);
17158
17159 default:
17160 goto bad_1; /* :::::::::::::::::::: */
17161 }
17162
17163 default:
17164 goto bad_0; /* :::::::::::::::::::: */
17165 }
17166
17167 bad_0: /* :::::::::::::::::::: */
17168 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", ffesta_tokens[0]);
17169 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17170
17171 bad_1: /* :::::::::::::::::::: */
17172 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
17173 return (ffelexHandler) ffelex_swallow_tokens (t,
17174 (ffelexHandler) ffesta_zero); /* Invalid second token. */
17175 }
17176
17177 /* ffestb_decl_R5391_ -- "IMPLICIT" generic-type
17178
17179 return ffestb_decl_R5391_; // to lexer
17180
17181 Handle ASTERISK or OPEN_PAREN. */
17182
17183 static ffelexHandler
17184 ffestb_decl_R5391_ (ffelexToken t)
17185 {
17186 switch (ffelex_token_type (t))
17187 {
17188 case FFELEX_typeASTERISK:
17189 ffesta_confirmed ();
17190 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_R539letters_;
17191 ffestb_local_.decl.badname = "IMPLICIT";
17192 if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
17193 return (ffelexHandler) ffestb_decl_starlen_;
17194 return (ffelexHandler) ffestb_decl_starkind_;
17195
17196 case FFELEX_typeOPEN_PAREN:
17197 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_R539letters_;
17198 ffestb_local_.decl.badname = "IMPLICIT";
17199 ffestb_local_.decl.kind = NULL;
17200 ffestb_local_.decl.kindt = NULL;
17201 ffestb_local_.decl.len = NULL;
17202 ffestb_local_.decl.lent = NULL;
17203 if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
17204 ffestb_local_.decl.imp_handler
17205 = (ffelexHandler) ffestb_decl_typeparams_;
17206 else
17207 ffestb_local_.decl.imp_handler
17208 = (ffelexHandler) ffestb_decl_kindparam_;
17209 return (ffelexHandler) ffestb_decl_R539maybe_ (t);
17210
17211 default:
17212 break;
17213 }
17214
17215 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
17216 ffestc_R539finish ();
17217 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
17218 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17219 }
17220
17221 /* ffestb_decl_R5392_ -- "IMPLICIT" "DOUBLE"
17222
17223 return ffestb_decl_R5392_; // to lexer
17224
17225 Handle NAME. */
17226
17227 static ffelexHandler
17228 ffestb_decl_R5392_ (ffelexToken t)
17229 {
17230 switch (ffelex_token_type (t))
17231 {
17232 case FFELEX_typeNAME:
17233 switch (ffestr_second (t))
17234 {
17235 case FFESTR_secondPRECISION:
17236 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
17237 break;
17238
17239 case FFESTR_secondCOMPLEX:
17240 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
17241 break;
17242
17243 default:
17244 goto bad; /* :::::::::::::::::::: */
17245 }
17246 ffestb_local_.decl.kind = NULL;
17247 ffestb_local_.decl.kindt = NULL;
17248 ffestb_local_.decl.len = NULL;
17249 ffestb_local_.decl.lent = NULL;
17250 return (ffelexHandler) ffestb_decl_R539letters_;
17251
17252 default:
17253 break;
17254 }
17255
17256 bad: /* :::::::::::::::::::: */
17257 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
17258 ffestc_R539finish ();
17259 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
17260 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17261 }
17262
17263 /* ffestb_decl_R5394_ -- "IMPLICIT" "NONE"
17264
17265 return ffestb_decl_R5394_; // to lexer
17266
17267 Handle EOS/SEMICOLON. */
17268
17269 static ffelexHandler
17270 ffestb_decl_R5394_ (ffelexToken t)
17271 {
17272 switch (ffelex_token_type (t))
17273 {
17274 case FFELEX_typeEOS:
17275 case FFELEX_typeSEMICOLON:
17276 ffesta_confirmed ();
17277 if (!ffesta_is_inhibited ())
17278 ffestc_R539 (); /* IMPLICIT NONE. */
17279 return (ffelexHandler) ffesta_zero (t);
17280
17281 default:
17282 break;
17283 }
17284
17285 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
17286 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17287 }
17288
17289 /* ffestb_decl_R5395_ -- "IMPLICIT" implicit-spec-list COMMA
17290
17291 return ffestb_decl_R5395_; // to lexer
17292
17293 Handle NAME for next type-spec. */
17294
17295 static ffelexHandler
17296 ffestb_decl_R5395_ (ffelexToken t)
17297 {
17298 switch (ffelex_token_type (t))
17299 {
17300 case FFELEX_typeNAME:
17301 switch (ffestr_second (t))
17302 {
17303 case FFESTR_secondINTEGER:
17304 ffestb_local_.decl.type = FFESTP_typeINTEGER;
17305 return (ffelexHandler) ffestb_decl_R5391_;
17306
17307 case FFESTR_secondBYTE:
17308 ffestb_local_.decl.type = FFESTP_typeBYTE;
17309 return (ffelexHandler) ffestb_decl_R5391_;
17310
17311 case FFESTR_secondWORD:
17312 ffestb_local_.decl.type = FFESTP_typeWORD;
17313 return (ffelexHandler) ffestb_decl_R5391_;
17314
17315 case FFESTR_secondREAL:
17316 ffestb_local_.decl.type = FFESTP_typeREAL;
17317 return (ffelexHandler) ffestb_decl_R5391_;
17318
17319 case FFESTR_secondCOMPLEX:
17320 ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
17321 return (ffelexHandler) ffestb_decl_R5391_;
17322
17323 case FFESTR_secondLOGICAL:
17324 ffestb_local_.decl.type = FFESTP_typeLOGICAL;
17325 return (ffelexHandler) ffestb_decl_R5391_;
17326
17327 case FFESTR_secondCHARACTER:
17328 ffestb_local_.decl.type = FFESTP_typeCHARACTER;
17329 return (ffelexHandler) ffestb_decl_R5391_;
17330
17331 case FFESTR_secondDOUBLE:
17332 return (ffelexHandler) ffestb_decl_R5392_;
17333
17334 case FFESTR_secondDOUBLEPRECISION:
17335 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
17336 ffestb_local_.decl.kind = NULL;
17337 ffestb_local_.decl.kindt = NULL;
17338 ffestb_local_.decl.len = NULL;
17339 ffestb_local_.decl.lent = NULL;
17340 return (ffelexHandler) ffestb_decl_R539letters_;
17341
17342 case FFESTR_secondDOUBLECOMPLEX:
17343 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
17344 ffestb_local_.decl.kind = NULL;
17345 ffestb_local_.decl.kindt = NULL;
17346 ffestb_local_.decl.len = NULL;
17347 ffestb_local_.decl.lent = NULL;
17348 return (ffelexHandler) ffestb_decl_R539letters_;
17349
17350 default:
17351 break;
17352 }
17353 break;
17354
17355 default:
17356 break;
17357 }
17358
17359 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
17360 ffestc_R539finish ();
17361 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
17362 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17363 }
17364
17365 /* ffestb_decl_R539letters_ -- "IMPLICIT" type-spec
17366
17367 return ffestb_decl_R539letters_; // to lexer
17368
17369 Handle OPEN_PAREN. */
17370
17371 static ffelexHandler
17372 ffestb_decl_R539letters_ (ffelexToken t)
17373 {
17374 ffelex_set_names (FALSE);
17375
17376 switch (ffelex_token_type (t))
17377 {
17378 case FFELEX_typeOPEN_PAREN:
17379 ffestb_local_.decl.imps = ffestt_implist_create ();
17380 return (ffelexHandler) ffestb_decl_R539letters_1_;
17381
17382 default:
17383 break;
17384 }
17385
17386 if (ffestb_local_.decl.kindt != NULL)
17387 ffelex_token_kill (ffestb_local_.decl.kindt);
17388 if (ffestb_local_.decl.lent != NULL)
17389 ffelex_token_kill (ffestb_local_.decl.lent);
17390 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
17391 ffestc_R539finish ();
17392 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
17393 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17394 }
17395
17396 /* ffestb_decl_R539letters_1_ -- "IMPLICIT" type-spec OPEN_PAREN
17397
17398 return ffestb_decl_R539letters_1_; // to lexer
17399
17400 Handle NAME. */
17401
17402 static ffelexHandler
17403 ffestb_decl_R539letters_1_ (ffelexToken t)
17404 {
17405 switch (ffelex_token_type (t))
17406 {
17407 case FFELEX_typeNAME:
17408 if (ffelex_token_length (t) != 1)
17409 break;
17410 ffesta_tokens[1] = ffelex_token_use (t);
17411 return (ffelexHandler) ffestb_decl_R539letters_2_;
17412
17413 default:
17414 break;
17415 }
17416
17417 ffestt_implist_kill (ffestb_local_.decl.imps);
17418 if (ffestb_local_.decl.kindt != NULL)
17419 ffelex_token_kill (ffestb_local_.decl.kindt);
17420 if (ffestb_local_.decl.lent != NULL)
17421 ffelex_token_kill (ffestb_local_.decl.lent);
17422 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
17423 ffestc_R539finish ();
17424 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
17425 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17426 }
17427
17428 /* ffestb_decl_R539letters_2_ -- "IMPLICIT" type-spec OPEN_PAREN NAME
17429
17430 return ffestb_decl_R539letters_2_; // to lexer
17431
17432 Handle COMMA or MINUS. */
17433
17434 static ffelexHandler
17435 ffestb_decl_R539letters_2_ (ffelexToken t)
17436 {
17437 switch (ffelex_token_type (t))
17438 {
17439 case FFELEX_typeCOMMA:
17440 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
17441 return (ffelexHandler) ffestb_decl_R539letters_1_;
17442
17443 case FFELEX_typeCLOSE_PAREN:
17444 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
17445 return (ffelexHandler) ffestb_decl_R539letters_5_;
17446
17447 case FFELEX_typeMINUS:
17448 return (ffelexHandler) ffestb_decl_R539letters_3_;
17449
17450 default:
17451 break;
17452 }
17453
17454 ffelex_token_kill (ffesta_tokens[1]);
17455 ffestt_implist_kill (ffestb_local_.decl.imps);
17456 if (ffestb_local_.decl.kindt != NULL)
17457 ffelex_token_kill (ffestb_local_.decl.kindt);
17458 if (ffestb_local_.decl.lent != NULL)
17459 ffelex_token_kill (ffestb_local_.decl.lent);
17460 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
17461 ffestc_R539finish ();
17462 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
17463 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17464 }
17465
17466 /* ffestb_decl_R539letters_3_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
17467
17468 return ffestb_decl_R539letters_3_; // to lexer
17469
17470 Handle NAME. */
17471
17472 static ffelexHandler
17473 ffestb_decl_R539letters_3_ (ffelexToken t)
17474 {
17475 switch (ffelex_token_type (t))
17476 {
17477 case FFELEX_typeNAME:
17478 if (ffelex_token_length (t) != 1)
17479 break;
17480 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1],
17481 ffelex_token_use (t));
17482 return (ffelexHandler) ffestb_decl_R539letters_4_;
17483
17484 default:
17485 break;
17486 }
17487
17488 ffelex_token_kill (ffesta_tokens[1]);
17489 ffestt_implist_kill (ffestb_local_.decl.imps);
17490 if (ffestb_local_.decl.kindt != NULL)
17491 ffelex_token_kill (ffestb_local_.decl.kindt);
17492 if (ffestb_local_.decl.lent != NULL)
17493 ffelex_token_kill (ffestb_local_.decl.lent);
17494 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
17495 ffestc_R539finish ();
17496 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
17497 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17498 }
17499
17500 /* ffestb_decl_R539letters_4_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
17501 NAME
17502
17503 return ffestb_decl_R539letters_4_; // to lexer
17504
17505 Handle COMMA or CLOSE_PAREN. */
17506
17507 static ffelexHandler
17508 ffestb_decl_R539letters_4_ (ffelexToken t)
17509 {
17510 switch (ffelex_token_type (t))
17511 {
17512 case FFELEX_typeCOMMA:
17513 return (ffelexHandler) ffestb_decl_R539letters_1_;
17514
17515 case FFELEX_typeCLOSE_PAREN:
17516 return (ffelexHandler) ffestb_decl_R539letters_5_;
17517
17518 default:
17519 break;
17520 }
17521
17522 ffestt_implist_kill (ffestb_local_.decl.imps);
17523 if (ffestb_local_.decl.kindt != NULL)
17524 ffelex_token_kill (ffestb_local_.decl.kindt);
17525 if (ffestb_local_.decl.lent != NULL)
17526 ffelex_token_kill (ffestb_local_.decl.lent);
17527 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
17528 ffestc_R539finish ();
17529 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
17530 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17531 }
17532
17533 /* ffestb_decl_R539letters_5_ -- "IMPLICIT" type-spec OPEN_PAREN
17534 letter-spec-list CLOSE_PAREN
17535
17536 return ffestb_decl_R539letters_5_; // to lexer
17537
17538 Handle COMMA or EOS/SEMICOLON. */
17539
17540 static ffelexHandler
17541 ffestb_decl_R539letters_5_ (ffelexToken t)
17542 {
17543 switch (ffelex_token_type (t))
17544 {
17545 case FFELEX_typeCOMMA:
17546 case FFELEX_typeEOS:
17547 case FFELEX_typeSEMICOLON:
17548 if (!ffestb_local_.decl.imp_started)
17549 {
17550 ffestb_local_.decl.imp_started = TRUE;
17551 ffesta_confirmed ();
17552 if (!ffesta_is_inhibited ())
17553 ffestc_R539start ();
17554 }
17555 if (!ffesta_is_inhibited ())
17556 ffestc_R539item (ffestb_local_.decl.type, ffestb_local_.decl.kind,
17557 ffestb_local_.decl.kindt, ffestb_local_.decl.len,
17558 ffestb_local_.decl.lent, ffestb_local_.decl.imps);
17559 if (ffestb_local_.decl.kindt != NULL)
17560 ffelex_token_kill (ffestb_local_.decl.kindt);
17561 if (ffestb_local_.decl.lent != NULL)
17562 ffelex_token_kill (ffestb_local_.decl.lent);
17563 ffestt_implist_kill (ffestb_local_.decl.imps);
17564 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
17565 return (ffelexHandler) ffestb_decl_R5395_;
17566 if (!ffesta_is_inhibited ())
17567 ffestc_R539finish ();
17568 return (ffelexHandler) ffesta_zero (t);
17569
17570 default:
17571 break;
17572 }
17573
17574 ffestt_implist_kill (ffestb_local_.decl.imps);
17575 if (ffestb_local_.decl.kindt != NULL)
17576 ffelex_token_kill (ffestb_local_.decl.kindt);
17577 if (ffestb_local_.decl.lent != NULL)
17578 ffelex_token_kill (ffestb_local_.decl.lent);
17579 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
17580 ffestc_R539finish ();
17581 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
17582 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17583 }
17584
17585 /* ffestb_decl_R539maybe_ -- "IMPLICIT" generic-type-spec
17586
17587 return ffestb_decl_R539maybe_; // to lexer
17588
17589 Handle OPEN_PAREN. */
17590
17591 static ffelexHandler
17592 ffestb_decl_R539maybe_ (ffelexToken t)
17593 {
17594 assert (ffelex_token_type (t) == FFELEX_typeOPEN_PAREN);
17595 ffestb_local_.decl.imps = ffestt_implist_create ();
17596 ffestb_local_.decl.toklist = ffestt_tokenlist_create ();
17597 ffestb_local_.decl.imp_seen_comma
17598 = (ffestb_local_.decl.type != FFESTP_typeCHARACTER);
17599 return (ffelexHandler) ffestb_decl_R539maybe_1_;
17600 }
17601
17602 /* ffestb_decl_R539maybe_1_ -- "IMPLICIT" generic-type-spec OPEN_PAREN
17603
17604 return ffestb_decl_R539maybe_1_; // to lexer
17605
17606 Handle NAME. */
17607
17608 static ffelexHandler
17609 ffestb_decl_R539maybe_1_ (ffelexToken t)
17610 {
17611 ffelexHandler next;
17612
17613 switch (ffelex_token_type (t))
17614 {
17615 case FFELEX_typeNAME:
17616 if (ffelex_token_length (t) != 1)
17617 break;
17618 ffesta_tokens[1] = ffelex_token_use (t);
17619 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
17620 return (ffelexHandler) ffestb_decl_R539maybe_2_;
17621
17622 default:
17623 break;
17624 }
17625
17626 ffestt_implist_kill (ffestb_local_.decl.imps);
17627 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
17628 (ffelexHandler) ffestb_local_.decl.imp_handler);
17629 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
17630 return (ffelexHandler) (*next) (t);
17631 }
17632
17633 /* ffestb_decl_R539maybe_2_ -- "IMPLICIT" generic-type-spec OPEN_PAREN NAME
17634
17635 return ffestb_decl_R539maybe_2_; // to lexer
17636
17637 Handle COMMA or MINUS. */
17638
17639 static ffelexHandler
17640 ffestb_decl_R539maybe_2_ (ffelexToken t)
17641 {
17642 ffelexHandler next;
17643
17644 switch (ffelex_token_type (t))
17645 {
17646 case FFELEX_typeCOMMA:
17647 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
17648 if (ffestb_local_.decl.imp_seen_comma)
17649 {
17650 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
17651 return (ffelexHandler) ffestb_decl_R539letters_1_;
17652 }
17653 ffestb_local_.decl.imp_seen_comma = TRUE;
17654 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
17655 return (ffelexHandler) ffestb_decl_R539maybe_1_;
17656
17657 case FFELEX_typeCLOSE_PAREN:
17658 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
17659 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
17660 return (ffelexHandler) ffestb_decl_R539maybe_5_;
17661
17662 case FFELEX_typeMINUS:
17663 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
17664 return (ffelexHandler) ffestb_decl_R539maybe_3_;
17665
17666 default:
17667 break;
17668 }
17669
17670 ffelex_token_kill (ffesta_tokens[1]);
17671 ffestt_implist_kill (ffestb_local_.decl.imps);
17672 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
17673 (ffelexHandler) ffestb_local_.decl.imp_handler);
17674 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
17675 return (ffelexHandler) (*next) (t);
17676 }
17677
17678 /* ffestb_decl_R539maybe_3_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
17679
17680 return ffestb_decl_R539maybe_3_; // to lexer
17681
17682 Handle NAME. */
17683
17684 static ffelexHandler
17685 ffestb_decl_R539maybe_3_ (ffelexToken t)
17686 {
17687 ffelexHandler next;
17688
17689 switch (ffelex_token_type (t))
17690 {
17691 case FFELEX_typeNAME:
17692 if (ffelex_token_length (t) != 1)
17693 break;
17694 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1],
17695 ffelex_token_use (t));
17696 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
17697 return (ffelexHandler) ffestb_decl_R539maybe_4_;
17698
17699 default:
17700 break;
17701 }
17702
17703 ffelex_token_kill (ffesta_tokens[1]);
17704 ffestt_implist_kill (ffestb_local_.decl.imps);
17705 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
17706 (ffelexHandler) ffestb_local_.decl.imp_handler);
17707 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
17708 return (ffelexHandler) (*next) (t);
17709 }
17710
17711 /* ffestb_decl_R539maybe_4_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
17712 NAME
17713
17714 return ffestb_decl_R539maybe_4_; // to lexer
17715
17716 Handle COMMA or CLOSE_PAREN. */
17717
17718 static ffelexHandler
17719 ffestb_decl_R539maybe_4_ (ffelexToken t)
17720 {
17721 ffelexHandler next;
17722
17723 switch (ffelex_token_type (t))
17724 {
17725 case FFELEX_typeCOMMA:
17726 if (ffestb_local_.decl.imp_seen_comma)
17727 {
17728 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
17729 return (ffelexHandler) ffestb_decl_R539letters_1_;
17730 }
17731 ffestb_local_.decl.imp_seen_comma = TRUE;
17732 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
17733 return (ffelexHandler) ffestb_decl_R539maybe_1_;
17734
17735 case FFELEX_typeCLOSE_PAREN:
17736 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
17737 return (ffelexHandler) ffestb_decl_R539maybe_5_;
17738
17739 default:
17740 break;
17741 }
17742
17743 ffestt_implist_kill (ffestb_local_.decl.imps);
17744 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
17745 (ffelexHandler) ffestb_local_.decl.imp_handler);
17746 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
17747 return (ffelexHandler) (*next) (t);
17748 }
17749
17750 /* ffestb_decl_R539maybe_5_ -- "IMPLICIT" type-spec OPEN_PAREN
17751 letter-spec-list CLOSE_PAREN
17752
17753 return ffestb_decl_R539maybe_5_; // to lexer
17754
17755 Handle COMMA or EOS/SEMICOLON. */
17756
17757 static ffelexHandler
17758 ffestb_decl_R539maybe_5_ (ffelexToken t)
17759 {
17760 ffelexHandler next;
17761
17762 switch (ffelex_token_type (t))
17763 {
17764 case FFELEX_typeCOMMA:
17765 case FFELEX_typeEOS:
17766 case FFELEX_typeSEMICOLON:
17767 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
17768 if (!ffestb_local_.decl.imp_started)
17769 {
17770 ffestb_local_.decl.imp_started = TRUE;
17771 ffesta_confirmed ();
17772 if (!ffesta_is_inhibited ())
17773 ffestc_R539start ();
17774 }
17775 if (!ffesta_is_inhibited ())
17776 ffestc_R539item (ffestb_local_.decl.type, ffestb_local_.decl.kind,
17777 ffestb_local_.decl.kindt, ffestb_local_.decl.len,
17778 ffestb_local_.decl.lent, ffestb_local_.decl.imps);
17779 if (ffestb_local_.decl.kindt != NULL)
17780 ffelex_token_kill (ffestb_local_.decl.kindt);
17781 if (ffestb_local_.decl.lent != NULL)
17782 ffelex_token_kill (ffestb_local_.decl.lent);
17783 ffestt_implist_kill (ffestb_local_.decl.imps);
17784 if (ffelex_token_type (t) == FFELEX_typeCOMMA)
17785 return (ffelexHandler) ffestb_decl_R5395_;
17786 if (!ffesta_is_inhibited ())
17787 ffestc_R539finish ();
17788 return (ffelexHandler) ffesta_zero (t);
17789
17790 case FFELEX_typeOPEN_PAREN:
17791 ffesta_confirmed ();
17792 ffestt_implist_kill (ffestb_local_.decl.imps);
17793 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
17794 (ffelexHandler) ffestb_local_.decl.imp_handler);
17795 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
17796 return (ffelexHandler) (*next) (t);
17797
17798 default:
17799 break;
17800 }
17801
17802 ffestt_implist_kill (ffestb_local_.decl.imps);
17803 ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
17804 if (ffestb_local_.decl.kindt != NULL)
17805 ffelex_token_kill (ffestb_local_.decl.kindt);
17806 if (ffestb_local_.decl.lent != NULL)
17807 ffelex_token_kill (ffestb_local_.decl.lent);
17808 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
17809 ffestc_R539finish ();
17810 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
17811 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
17812 }
Mirror of the offical gcc git repository hosted at gcc.gnu.org