1/* stb.c -- Implementation File (module.c template V1.0) 2 Copyright (C) 1995, 1996 Free Software Foundation, Inc. 3 Contributed by James Craig Burley. 4 5This file is part of GNU Fortran. 6 7GNU Fortran is free software; you can redistribute it and/or modify 8it under the terms of the GNU General Public License as published by 9the Free Software Foundation; either version 2, or (at your option) 10any later version. 11 12GNU Fortran is distributed in the hope that it will be useful, 13but WITHOUT ANY WARRANTY; without even the implied warranty of 14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15GNU General Public License for more details. 16 17You should have received a copy of the GNU General Public License 18along with GNU Fortran; see the file COPYING. If not, write to 19the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA 2002111-1307, USA. 21 22 Related Modules: 23 st.c 24 25 Description: 26 Parses the proper form for statements, builds up expression trees for 27 them, but does not actually implement them. Uses ffebad (primarily via 28 ffesta_ffebad_start) to indicate errors in form. In many cases, an invalid 29 statement form indicates another possible statement needs to be looked at 30 by ffest. In a few cases, a valid statement form might not completely 31 determine the nature of the statement, as in REALFUNCTIONA(B), which is 32 a valid form for either the first statement of a function named A taking 33 an argument named B or for the declaration of a real array named FUNCTIONA 34 with an adjustable size of B. A similar (though somewhat easier) choice 35 must be made for the statement-function-def vs. assignment forms, as in 36 the case of FOO(A) = A+2.0. 37 38 A given parser consists of one or more state handlers, the first of which 39 is the initial state, and the last of which (for any given input) returns 40 control to a final state handler (ffesta_zero or ffesta_two, explained 41 below). The functions handling the states for a given parser usually have 42 the same names, differing only in the final number, as in ffestb_foo_ 43 (handles the initial state), ffestb_foo_1_, ffestb_foo_2_ (handle 44 subsequent states), although liberties sometimes are taken with the "foo" 45 part either when keywords are clarified into given statements or are 46 transferred into other possible areas. (For example, the type-name 47 states can hop over to _dummy_ functions when the FUNCTION or RECURSIVE 48 keywords are seen, though this kind of thing is kept to a minimum.) Only 49 the names without numbers are exported to the rest of ffest; the others 50 are local (static). 51 52 Each initial state is provided with the first token in ffesta_tokens[0], 53 which will be killed upon return to the final state (ffesta_zero or 54 ffelex_swallow_tokens passed through to ffesta_zero), so while it may 55 be changed to another token, a valid token must be left there to be 56 killed. Also, a "convenient" array of tokens are left in 57 ffesta_tokens[1..FFESTA_tokensMAX]. The initial state of this set of 58 elements is undefined, thus, if tokens are stored here, they must be 59 killed before returning to the final state. Any parser may also use 60 cross-state local variables by sticking a structure containing storage 61 for those variables in the local union ffestb_local_ (unless the union 62 goes on strike). Furthermore, parsers that handle more than one first or 63 second tokens (like _varlist_, which handles EXTERNAL, INTENT, INTRINSIC, 64 OPTIONAL, 65 PUBLIC, or PRIVATE, and _endxyz_, which handles ENDBLOCK, ENDBLOCKDATA, 66 ENDDO, ENDIF, and so on) may expect arguments from ffest in the 67 ffest-wide union ffest_args_, the substructure specific to the parser. 68 69 A parser's responsibility is: to call either ffesta_confirmed or 70 ffest_ffebad_start before returning to the final state; to be the only 71 parser that can possibly call ffesta_confirmed for a given statement; 72 to call ffest_ffebad_start immediately upon recognizing a bad token 73 (specifically one that another statement parser might confirm upon); 74 to call ffestc functions only after calling ffesta_confirmed and only 75 when ffesta_is_inhibited returns FALSE; and to call ffesta_is_inhibited 76 only after calling ffesta_confirmed. Confirm as early as reasonably 77 possible, even when only one ffestc function is called for the statement 78 later on, because early confirmation can enhance the error-reporting 79 capabilities if a subsequent error is detected and this parser isn't 80 the first possibility for the statement. 81 82 To assist the parser, functions like ffesta_ffebad_1t and _1p_ have 83 been provided to make use of ffest_ffebad_start fairly easy. 84 85 Modifications: 86*/ 87 88/* Include files. */ 89 90#include "proj.h" 91#include "stb.h" 92#include "bad.h" 93#include "expr.h" 94#include "lex.h" 95#include "malloc.h" 96#include "src.h" 97#include "sta.h" 98#include "stc.h" 99#include "stp.h" 100#include "str.h" 101 102/* Externals defined here. */ 103 104struct _ffestb_args_ ffestb_args; 105 106/* Simple definitions and enumerations. */ 107 108#define FFESTB_KILL_EASY_ 1 /* 1 for only one _subr_kill_xyz_ fn. */ 109 110/* Internal typedefs. */ 111 112union ffestb_subrargs_u_ 113 { 114 struct 115 { 116 ffesttTokenList labels; /* Input arg, must not be NULL. */ 117 ffelexHandler handler; /* Input arg, call me when done. */ 118 bool ok; /* Output arg, TRUE if list ended in 119 CLOSE_PAREN. */ 120 } 121 label_list; 122 struct 123 { 124 ffesttDimList dims; /* Input arg, must not be NULL. */ 125 ffelexHandler handler; /* Input arg, call me when done. */ 126 mallocPool pool; /* Pool to allocate into. */ 127 bool ok; /* Output arg, TRUE if list ended in 128 CLOSE_PAREN. */ 129 ffeexprContext ctx; /* DIMLIST or DIMLISTCOMMON. */ 130#ifdef FFECOM_dimensionsMAX 131 int ndims; /* For backends that really can't have 132 infinite dims. */ 133#endif 134 } 135 dim_list; 136 struct 137 { 138 ffesttTokenList args; /* Input arg, must not be NULL. */ 139 ffelexHandler handler; /* Input arg, call me when done. */ 140 ffelexToken close_paren;/* Output arg if ok, CLOSE_PAREN token. */ 141 bool is_subr; /* Input arg, TRUE if list in subr-def 142 context. */ 143 bool ok; /* Output arg, TRUE if list ended in 144 CLOSE_PAREN. */ 145 bool names; /* Do ffelex_set_names(TRUE) before return. */ 146 } 147 name_list; 148 }; 149 150union ffestb_local_u_ 151 { 152 struct 153 { 154 ffebld expr; 155 } 156 call_stmt; 157 struct 158 { 159 ffebld expr; 160 } 161 go_to; 162 struct 163 { 164 ffebld dest; 165 bool vxtparam; /* If assignment might really be VXT 166 PARAMETER stmt. */ 167 } 168 let; 169 struct 170 { 171 ffebld expr; 172 } 173 if_stmt; 174 struct 175 { 176 ffebld expr; 177 } 178 else_stmt; 179 struct 180 { 181 ffebld expr; 182 } 183 dowhile; 184 struct 185 { 186 ffebld var; 187 ffebld start; 188 ffebld end; 189 } 190 do_stmt; 191 struct 192 { 193 bool is_cblock; 194 } 195 R522; 196 struct 197 { 198 ffebld expr; 199 bool started; 200 } 201 parameter; 202 struct 203 { 204 ffesttExprList exprs; 205 bool started; 206 } 207 equivalence; 208 struct 209 { 210 ffebld expr; 211 bool started; 212 } 213 data; 214 struct 215 { 216 ffestrOther kw; 217 } 218 varlist; 219#if FFESTR_F90 220 struct 221 { 222 ffestrOther kw; 223 } 224 type; 225#endif 226 struct 227 { 228 ffelexHandler next; 229 } 230 construct; 231 struct 232 { 233 ffesttFormatList f; 234 ffestpFormatType current; /* What we're currently working on. */ 235 ffelexToken t; /* Token of what we're currently working on. */ 236 ffesttFormatValue pre; 237 ffesttFormatValue post; 238 ffesttFormatValue dot; 239 ffesttFormatValue exp; 240 bool sign; /* _3_, pos/neg; elsewhere, signed/unsigned. */ 241 bool complained; /* If run-time expr seen in nonexec context. */ 242 } 243 format; 244#if FFESTR_F90 245 struct 246 { 247 bool started; 248 } 249 moduleprocedure; 250#endif 251 struct 252 { 253 ffebld expr; 254 } 255 selectcase; 256 struct 257 { 258 ffesttCaseList cases; 259 } 260 case_stmt; 261#if FFESTR_F90 262 struct 263 { 264 ffesttExprList exprs; 265 ffebld expr; 266 } 267 heap; 268#endif 269#if FFESTR_F90 270 struct 271 { 272 ffesttExprList exprs; 273 } 274 R624; 275#endif 276#if FFESTR_F90 277 struct 278 { 279 ffestpDefinedOperator operator; 280 bool assignment; /* TRUE for INTERFACE ASSIGNMENT, FALSE for 281 ...OPERATOR. */ 282 bool slash; /* TRUE if OPEN_ARRAY, FALSE if OPEN_PAREN. */ 283 } 284 interface; 285#endif 286 struct 287 { 288 bool is_cblock; 289 } 290 V014; 291#if FFESTR_VXT 292 struct 293 { 294 bool started; 295 ffebld u; 296 ffebld m; 297 ffebld n; 298 ffebld asv; 299 } 300 V025; 301#endif 302 struct 303 { 304 ffestpBeruIx ix; 305 bool label; 306 bool left; 307 ffeexprContext context; 308 } 309 beru; 310 struct 311 { 312 ffestpCloseIx ix; 313 bool label; 314 bool left; 315 ffeexprContext context; 316 } 317 close; 318 struct 319 { 320 ffestpDeleteIx ix; 321 bool label; 322 bool left; 323 ffeexprContext context; 324 } 325 delete; 326 struct 327 { 328 ffestpDeleteIx ix; 329 bool label; 330 bool left; 331 ffeexprContext context; 332 } 333 find; 334 struct 335 { 336 ffestpInquireIx ix; 337 bool label; 338 bool left; 339 ffeexprContext context; 340 bool may_be_iolength; 341 } 342 inquire; 343 struct 344 { 345 ffestpOpenIx ix; 346 bool label; 347 bool left; 348 ffeexprContext context; 349 } 350 open; 351 struct 352 { 353 ffestpReadIx ix; 354 bool label; 355 bool left; 356 ffeexprContext context; 357 } 358 read; 359 struct 360 { 361 ffestpRewriteIx ix; 362 bool label; 363 bool left; 364 ffeexprContext context; 365 } 366 rewrite; 367 struct 368 { 369 ffestpWriteIx ix; 370 bool label; 371 bool left; 372 ffeexprContext context; 373 } 374 vxtcode; 375 struct 376 { 377 ffestpWriteIx ix; 378 bool label; 379 bool left; 380 ffeexprContext context; 381 } 382 write; 383#if FFESTR_F90 384 struct 385 { 386 bool started; 387 } 388 structure; 389#endif 390 struct 391 { 392 bool started; 393 } 394 common; 395 struct 396 { 397 bool started; 398 } 399 dimension; 400 struct 401 { 402 bool started; 403 } 404 dimlist; 405 struct 406 { 407 const char *badname; 408 ffestrFirst first_kw; 409 bool is_subr; 410 } 411 dummy; 412 struct 413 { 414 ffebld kind; /* Kind type parameter, if any. */ 415 ffelexToken kindt; /* Kind type first token, if any. */ 416 ffebld len; /* Length type parameter, if any. */ 417 ffelexToken lent; /* Length type parameter, if any. */ 418 ffelexHandler handler; 419 ffelexToken recursive; 420 ffebld expr; 421 ffesttTokenList toklist;/* For ambiguity resolution. */ 422 ffesttImpList imps; /* List of IMPLICIT letters. */ 423 ffelexHandler imp_handler; /* Call if paren list wasn't letters. */ 424 const char *badname; 425 ffestrOther kw; /* INTENT(IN/OUT/INOUT). */ 426 ffestpType type; 427 bool parameter; /* If PARAMETER attribute seen (governs =expr 428 context). */ 429 bool coloncolon; /* If COLONCOLON seen (allows =expr). */ 430 bool aster_after; /* "*" seen after, not before, 431 [RECURSIVE]FUNCTIONxyz. */ 432 bool empty; /* Ambig function dummy arg list empty so 433 far? */ 434 bool imp_started; /* Started IMPLICIT statement already. */ 435 bool imp_seen_comma; /* TRUE if next COMMA within parens means not 436 R541. */ 437 } 438 decl; 439 struct 440 { 441 bool started; 442 } 443 vxtparam; 444 }; /* Merge with the one in ffestb later. */ 445 446/* Private include files. */ 447 448 449/* Internal structure definitions. */ 450 451 452/* Static objects accessed by functions in this module. */ 453 454static union ffestb_subrargs_u_ ffestb_subrargs_; 455static union ffestb_local_u_ ffestb_local_; 456 457/* Static functions (internal). */ 458 459static void ffestb_subr_ambig_to_ents_ (void); 460static ffelexHandler ffestb_subr_ambig_nope_ (ffelexToken t); 461static ffelexHandler ffestb_subr_dimlist_ (ffelexToken ft, ffebld expr, 462 ffelexToken t); 463static ffelexHandler ffestb_subr_dimlist_1_ (ffelexToken ft, ffebld expr, 464 ffelexToken t); 465static ffelexHandler ffestb_subr_dimlist_2_ (ffelexToken ft, ffebld expr, 466 ffelexToken t); 467static ffelexHandler ffestb_subr_name_list_ (ffelexToken t); 468static ffelexHandler ffestb_subr_name_list_1_ (ffelexToken t); 469static void ffestb_subr_R1001_append_p_ (void); 470static ffelexHandler ffestb_decl_kindparam_ (ffelexToken t); 471static ffelexHandler ffestb_decl_kindparam_1_ (ffelexToken t); 472static ffelexHandler ffestb_decl_kindparam_2_ (ffelexToken ft, ffebld expr, 473 ffelexToken t); 474static ffelexHandler ffestb_decl_starkind_ (ffelexToken t); 475static ffelexHandler ffestb_decl_starlen_ (ffelexToken t); 476static ffelexHandler ffestb_decl_starlen_1_ (ffelexToken ft, ffebld expr, 477 ffelexToken t); 478static ffelexHandler ffestb_decl_typeparams_ (ffelexToken t); 479static ffelexHandler ffestb_decl_typeparams_1_ (ffelexToken t); 480static ffelexHandler ffestb_decl_typeparams_2_ (ffelexToken ft, ffebld expr, 481 ffelexToken t); 482static ffelexHandler ffestb_decl_typeparams_3_ (ffelexToken ft, ffebld expr, 483 ffelexToken t); 484#if FFESTR_F90 485static ffelexHandler ffestb_decl_typetype1_ (ffelexToken t); 486static ffelexHandler ffestb_decl_typetype2_ (ffelexToken t); 487#endif 488static ffelexHandler ffestb_subr_label_list_ (ffelexToken t); 489static ffelexHandler ffestb_subr_label_list_1_ (ffelexToken t); 490static ffelexHandler ffestb_do1_ (ffelexToken t); 491static ffelexHandler ffestb_do2_ (ffelexToken t); 492static ffelexHandler ffestb_do3_ (ffelexToken t); 493static ffelexHandler ffestb_do4_ (ffelexToken ft, ffebld expr, 494 ffelexToken t); 495static ffelexHandler ffestb_do5_ (ffelexToken t); 496static ffelexHandler ffestb_do6_ (ffelexToken ft, ffebld expr, 497 ffelexToken t); 498static ffelexHandler ffestb_do7_ (ffelexToken ft, ffebld expr, 499 ffelexToken t); 500static ffelexHandler ffestb_do8_ (ffelexToken ft, ffebld expr, 501 ffelexToken t); 502static ffelexHandler ffestb_do9_ (ffelexToken ft, ffebld expr, 503 ffelexToken t); 504static ffelexHandler ffestb_else1_ (ffelexToken t); 505static ffelexHandler ffestb_else2_ (ffelexToken ft, ffebld expr, 506 ffelexToken t); 507static ffelexHandler ffestb_else3_ (ffelexToken t); 508static ffelexHandler ffestb_else4_ (ffelexToken t); 509static ffelexHandler ffestb_else5_ (ffelexToken t); 510static ffelexHandler ffestb_end1_ (ffelexToken t); 511static ffelexHandler ffestb_end2_ (ffelexToken t); 512static ffelexHandler ffestb_end3_ (ffelexToken t); 513static ffelexHandler ffestb_goto1_ (ffelexToken t); 514static ffelexHandler ffestb_goto2_ (ffelexToken t); 515static ffelexHandler ffestb_goto3_ (ffelexToken t); 516static ffelexHandler ffestb_goto4_ (ffelexToken ft, ffebld expr, 517 ffelexToken t); 518static ffelexHandler ffestb_goto5_ (ffelexToken ft, ffebld expr, 519 ffelexToken t); 520static ffelexHandler ffestb_goto6_ (ffelexToken t); 521static ffelexHandler ffestb_goto7_ (ffelexToken t); 522static ffelexHandler ffestb_halt1_ (ffelexToken ft, ffebld expr, 523 ffelexToken t); 524static ffelexHandler ffestb_if1_ (ffelexToken ft, ffebld expr, 525 ffelexToken t); 526static ffelexHandler ffestb_if2_ (ffelexToken t); 527static ffelexHandler ffestb_if3_ (ffelexToken t); 528static ffelexHandler ffestb_let1_ (ffelexToken ft, ffebld expr, 529 ffelexToken t); 530static ffelexHandler ffestb_let2_ (ffelexToken ft, ffebld expr, 531 ffelexToken t); 532#if FFESTR_F90 533static ffelexHandler ffestb_type1_ (ffelexToken t); 534static ffelexHandler ffestb_type2_ (ffelexToken t); 535static ffelexHandler ffestb_type3_ (ffelexToken t); 536static ffelexHandler ffestb_type4_ (ffelexToken t); 537#endif 538#if FFESTR_F90 539static ffelexHandler ffestb_varlist1_ (ffelexToken t); 540static ffelexHandler ffestb_varlist2_ (ffelexToken t); 541static ffelexHandler ffestb_varlist3_ (ffelexToken t); 542static ffelexHandler ffestb_varlist4_ (ffelexToken t); 543#endif 544static ffelexHandler ffestb_varlist5_ (ffelexToken t); 545static ffelexHandler ffestb_varlist6_ (ffelexToken t); 546#if FFESTR_F90 547static ffelexHandler ffestb_where1_ (ffelexToken ft, ffebld expr, 548 ffelexToken t); 549static ffelexHandler ffestb_where2_ (ffelexToken t); 550static ffelexHandler ffestb_where3_ (ffelexToken t); 551#endif 552static ffelexHandler ffestb_R5221_ (ffelexToken t); 553static ffelexHandler ffestb_R5222_ (ffelexToken t); 554static ffelexHandler ffestb_R5223_ (ffelexToken t); 555static ffelexHandler ffestb_R5224_ (ffelexToken t); 556static ffelexHandler ffestb_R5281_ (ffelexToken ft, ffebld expr, 557 ffelexToken t); 558static ffelexHandler ffestb_R5282_ (ffelexToken ft, ffebld expr, 559 ffelexToken t); 560static ffelexHandler ffestb_R5283_ (ffelexToken ft, ffebld expr, 561 ffelexToken t); 562static ffelexHandler ffestb_R5284_ (ffelexToken t); 563static ffelexHandler ffestb_R5371_ (ffelexToken ft, ffebld expr, 564 ffelexToken t); 565static ffelexHandler ffestb_R5372_ (ffelexToken ft, ffebld expr, 566 ffelexToken t); 567static ffelexHandler ffestb_R5373_ (ffelexToken t); 568static ffelexHandler ffestb_R5421_ (ffelexToken t); 569static ffelexHandler ffestb_R5422_ (ffelexToken t); 570static ffelexHandler ffestb_R5423_ (ffelexToken t); 571static ffelexHandler ffestb_R5424_ (ffelexToken t); 572static ffelexHandler ffestb_R5425_ (ffelexToken t); 573static ffelexHandler ffestb_R5441_ (ffelexToken ft, ffebld expr, 574 ffelexToken t); 575static ffelexHandler ffestb_R5442_ (ffelexToken ft, ffebld expr, 576 ffelexToken t); 577static ffelexHandler ffestb_R5443_ (ffelexToken t); 578static ffelexHandler ffestb_R5444_ (ffelexToken t); 579static ffelexHandler ffestb_R8341_ (ffelexToken t); 580static ffelexHandler ffestb_R8351_ (ffelexToken t); 581static ffelexHandler ffestb_R8381_ (ffelexToken t); 582static ffelexHandler ffestb_R8382_ (ffelexToken t); 583static ffelexHandler ffestb_R8383_ (ffelexToken ft, ffebld expr, 584 ffelexToken t); 585static ffelexHandler ffestb_R8401_ (ffelexToken ft, ffebld expr, 586 ffelexToken t); 587static ffelexHandler ffestb_R8402_ (ffelexToken t); 588static ffelexHandler ffestb_R8403_ (ffelexToken t); 589static ffelexHandler ffestb_R8404_ (ffelexToken t); 590static ffelexHandler ffestb_R8405_ (ffelexToken t); 591static ffelexHandler ffestb_R8406_ (ffelexToken t); 592static ffelexHandler ffestb_R8407_ (ffelexToken t); 593static ffelexHandler ffestb_R11021_ (ffelexToken t); 594static ffelexHandler ffestb_R1111_1_ (ffelexToken t); 595static ffelexHandler ffestb_R1111_2_ (ffelexToken t); 596static ffelexHandler ffestb_R12121_ (ffelexToken ft, ffebld expr, 597 ffelexToken t); 598static ffelexHandler ffestb_R12271_ (ffelexToken ft, ffebld expr, 599 ffelexToken t); 600static ffelexHandler ffestb_construct1_ (ffelexToken t); 601static ffelexHandler ffestb_construct2_ (ffelexToken t); 602#if FFESTR_F90 603static ffelexHandler ffestb_heap1_ (ffelexToken ft, ffebld expr, 604 ffelexToken t); 605static ffelexHandler ffestb_heap2_ (ffelexToken t); 606static ffelexHandler ffestb_heap3_ (ffelexToken t); 607static ffelexHandler ffestb_heap4_ (ffelexToken ft, ffebld expr, 608 ffelexToken t); 609static ffelexHandler ffestb_heap5_ (ffelexToken t); 610#endif 611#if FFESTR_F90 612static ffelexHandler ffestb_module1_ (ffelexToken t); 613static ffelexHandler ffestb_module2_ (ffelexToken t); 614static ffelexHandler ffestb_module3_ (ffelexToken t); 615#endif 616static ffelexHandler ffestb_R8091_ (ffelexToken t); 617static ffelexHandler ffestb_R8092_ (ffelexToken ft, ffebld expr, 618 ffelexToken t); 619static ffelexHandler ffestb_R8093_ (ffelexToken t); 620static ffelexHandler ffestb_R8101_ (ffelexToken t); 621static ffelexHandler ffestb_R8102_ (ffelexToken t); 622static ffelexHandler ffestb_R8103_ (ffelexToken ft, ffebld expr, 623 ffelexToken t); 624static ffelexHandler ffestb_R8104_ (ffelexToken ft, ffebld expr, 625 ffelexToken t); 626static ffelexHandler ffestb_R10011_ (ffelexToken t); 627static ffelexHandler ffestb_R10012_ (ffelexToken t); 628static ffelexHandler ffestb_R10013_ (ffelexToken t); 629static ffelexHandler ffestb_R10014_ (ffelexToken t); 630static ffelexHandler ffestb_R10015_ (ffelexToken t); 631static ffelexHandler ffestb_R10016_ (ffelexToken t); 632static ffelexHandler ffestb_R10017_ (ffelexToken t); 633static ffelexHandler ffestb_R10018_ (ffelexToken t); 634static ffelexHandler ffestb_R10019_ (ffelexToken t); 635static ffelexHandler ffestb_R100110_ (ffelexToken t); 636static ffelexHandler ffestb_R100111_ (ffelexToken t); 637static ffelexHandler ffestb_R100112_ (ffelexToken t); 638static ffelexHandler ffestb_R100113_ (ffelexToken t); 639static ffelexHandler ffestb_R100114_ (ffelexToken t); 640static ffelexHandler ffestb_R100115_ (ffelexToken ft, ffebld expr, 641 ffelexToken t); 642static ffelexHandler ffestb_R100116_ (ffelexToken ft, ffebld expr, 643 ffelexToken t); 644static ffelexHandler ffestb_R100117_ (ffelexToken ft, ffebld expr, 645 ffelexToken t); 646static ffelexHandler ffestb_R100118_ (ffelexToken ft, ffebld expr, 647 ffelexToken t); 648#if FFESTR_F90 649static ffelexHandler ffestb_R11071_ (ffelexToken t); 650static ffelexHandler ffestb_R11072_ (ffelexToken t); 651static ffelexHandler ffestb_R11073_ (ffelexToken t); 652static ffelexHandler ffestb_R11074_ (ffelexToken t); 653static ffelexHandler ffestb_R11075_ (ffelexToken t); 654static ffelexHandler ffestb_R11076_ (ffelexToken t); 655static ffelexHandler ffestb_R11077_ (ffelexToken t); 656static ffelexHandler ffestb_R11078_ (ffelexToken t); 657static ffelexHandler ffestb_R11079_ (ffelexToken t); 658static ffelexHandler ffestb_R110710_ (ffelexToken t); 659static ffelexHandler ffestb_R110711_ (ffelexToken t); 660static ffelexHandler ffestb_R110712_ (ffelexToken t); 661#endif 662#if FFESTR_F90 663static ffelexHandler ffestb_R12021_ (ffelexToken t); 664static ffelexHandler ffestb_R12022_ (ffelexToken t); 665static ffelexHandler ffestb_R12023_ (ffelexToken t); 666static ffelexHandler ffestb_R12024_ (ffelexToken t); 667static ffelexHandler ffestb_R12025_ (ffelexToken t); 668static ffelexHandler ffestb_R12026_ (ffelexToken t); 669#endif 670static ffelexHandler ffestb_S3P41_ (ffelexToken ft, ffebld expr, 671 ffelexToken t); 672static ffelexHandler ffestb_V0141_ (ffelexToken t); 673static ffelexHandler ffestb_V0142_ (ffelexToken t); 674static ffelexHandler ffestb_V0143_ (ffelexToken t); 675static ffelexHandler ffestb_V0144_ (ffelexToken t); 676#if FFESTR_VXT 677static ffelexHandler ffestb_V0251_ (ffelexToken t); 678static ffelexHandler ffestb_V0252_ (ffelexToken ft, ffebld expr, 679 ffelexToken t); 680static ffelexHandler ffestb_V0253_ (ffelexToken ft, ffebld expr, 681 ffelexToken t); 682static ffelexHandler ffestb_V0254_ (ffelexToken ft, ffebld expr, 683 ffelexToken t); 684static ffelexHandler ffestb_V0255_ (ffelexToken t); 685static ffelexHandler ffestb_V0256_ (ffelexToken t); 686static ffelexHandler ffestb_V0257_ (ffelexToken ft, ffebld expr, 687 ffelexToken t); 688static ffelexHandler ffestb_V0258_ (ffelexToken t); 689#endif 690#if FFESTB_KILL_EASY_ 691static void ffestb_subr_kill_easy_ (ffestpInquireIx max); 692#else 693static void ffestb_subr_kill_accept_ (void); 694static void ffestb_subr_kill_beru_ (void); 695static void ffestb_subr_kill_close_ (void); 696static void ffestb_subr_kill_delete_ (void); 697static void ffestb_subr_kill_find_ (void); /* Not written yet. */ 698static void ffestb_subr_kill_inquire_ (void); 699static void ffestb_subr_kill_open_ (void); 700static void ffestb_subr_kill_print_ (void); 701static void ffestb_subr_kill_read_ (void); 702static void ffestb_subr_kill_rewrite_ (void); 703static void ffestb_subr_kill_type_ (void); 704static void ffestb_subr_kill_vxtcode_ (void); /* Not written yet. */ 705static void ffestb_subr_kill_write_ (void); 706#endif 707static ffelexHandler ffestb_beru1_ (ffelexToken ft, ffebld expr, 708 ffelexToken t); 709static ffelexHandler ffestb_beru2_ (ffelexToken t); 710static ffelexHandler ffestb_beru3_ (ffelexToken t); 711static ffelexHandler ffestb_beru4_ (ffelexToken ft, ffebld expr, 712 ffelexToken t); 713static ffelexHandler ffestb_beru5_ (ffelexToken t); 714static ffelexHandler ffestb_beru6_ (ffelexToken t); 715static ffelexHandler ffestb_beru7_ (ffelexToken ft, ffebld expr, 716 ffelexToken t); 717static ffelexHandler ffestb_beru8_ (ffelexToken t); 718static ffelexHandler ffestb_beru9_ (ffelexToken t); 719static ffelexHandler ffestb_beru10_ (ffelexToken t); 720#if FFESTR_VXT 721static ffelexHandler ffestb_vxtcode1_ (ffelexToken ft, ffebld expr, 722 ffelexToken t); 723static ffelexHandler ffestb_vxtcode2_ (ffelexToken ft, ffebld expr, 724 ffelexToken t); 725static ffelexHandler ffestb_vxtcode3_ (ffelexToken ft, ffebld expr, 726 ffelexToken t); 727static ffelexHandler ffestb_vxtcode4_ (ffelexToken t); 728static ffelexHandler ffestb_vxtcode5_ (ffelexToken t); 729static ffelexHandler ffestb_vxtcode6_ (ffelexToken ft, ffebld expr, 730 ffelexToken t); 731static ffelexHandler ffestb_vxtcode7_ (ffelexToken t); 732static ffelexHandler ffestb_vxtcode8_ (ffelexToken t); 733static ffelexHandler ffestb_vxtcode9_ (ffelexToken t); 734static ffelexHandler ffestb_vxtcode10_ (ffelexToken ft, ffebld expr, 735 ffelexToken t); 736#endif 737static ffelexHandler ffestb_R9041_ (ffelexToken t); 738static ffelexHandler ffestb_R9042_ (ffelexToken t); 739static ffelexHandler ffestb_R9043_ (ffelexToken ft, ffebld expr, 740 ffelexToken t); 741static ffelexHandler ffestb_R9044_ (ffelexToken t); 742static ffelexHandler ffestb_R9045_ (ffelexToken t); 743static ffelexHandler ffestb_R9046_ (ffelexToken ft, ffebld expr, 744 ffelexToken t); 745static ffelexHandler ffestb_R9047_ (ffelexToken t); 746static ffelexHandler ffestb_R9048_ (ffelexToken t); 747static ffelexHandler ffestb_R9049_ (ffelexToken t); 748static ffelexHandler ffestb_R9071_ (ffelexToken t); 749static ffelexHandler ffestb_R9072_ (ffelexToken t); 750static ffelexHandler ffestb_R9073_ (ffelexToken ft, ffebld expr, 751 ffelexToken t); 752static ffelexHandler ffestb_R9074_ (ffelexToken t); 753static ffelexHandler ffestb_R9075_ (ffelexToken t); 754static ffelexHandler ffestb_R9076_ (ffelexToken ft, ffebld expr, 755 ffelexToken t); 756static ffelexHandler ffestb_R9077_ (ffelexToken t); 757static ffelexHandler ffestb_R9078_ (ffelexToken t); 758static ffelexHandler ffestb_R9079_ (ffelexToken t); 759static ffelexHandler ffestb_R9091_ (ffelexToken ft, ffebld expr, 760 ffelexToken t); 761static ffelexHandler ffestb_R9092_ (ffelexToken t); 762static ffelexHandler ffestb_R9093_ (ffelexToken t); 763static ffelexHandler ffestb_R9094_ (ffelexToken ft, ffebld expr, 764 ffelexToken t); 765static ffelexHandler ffestb_R9095_ (ffelexToken t); 766static ffelexHandler ffestb_R9096_ (ffelexToken t); 767static ffelexHandler ffestb_R9097_ (ffelexToken ft, ffebld expr, 768 ffelexToken t); 769static ffelexHandler ffestb_R9098_ (ffelexToken t); 770static ffelexHandler ffestb_R9099_ (ffelexToken t); 771static ffelexHandler ffestb_R90910_ (ffelexToken ft, ffebld expr, 772 ffelexToken t); 773static ffelexHandler ffestb_R90911_ (ffelexToken t); 774static ffelexHandler ffestb_R90912_ (ffelexToken t); 775static ffelexHandler ffestb_R90913_ (ffelexToken t); 776static ffelexHandler ffestb_R90914_ (ffelexToken ft, ffebld expr, 777 ffelexToken t); 778static ffelexHandler ffestb_R90915_ (ffelexToken ft, ffebld expr, 779 ffelexToken t); 780static ffelexHandler ffestb_R9101_ (ffelexToken t); 781static ffelexHandler ffestb_R9102_ (ffelexToken t); 782static ffelexHandler ffestb_R9103_ (ffelexToken ft, ffebld expr, 783 ffelexToken t); 784static ffelexHandler ffestb_R9104_ (ffelexToken t); 785static ffelexHandler ffestb_R9105_ (ffelexToken t); 786static ffelexHandler ffestb_R9106_ (ffelexToken ft, ffebld expr, 787 ffelexToken t); 788static ffelexHandler ffestb_R9107_ (ffelexToken t); 789static ffelexHandler ffestb_R9108_ (ffelexToken t); 790static ffelexHandler ffestb_R9109_ (ffelexToken ft, ffebld expr, 791 ffelexToken t); 792static ffelexHandler ffestb_R91010_ (ffelexToken t); 793static ffelexHandler ffestb_R91011_ (ffelexToken t); 794static ffelexHandler ffestb_R91012_ (ffelexToken t); 795static ffelexHandler ffestb_R91013_ (ffelexToken ft, ffebld expr, 796 ffelexToken t); 797static ffelexHandler ffestb_R91014_ (ffelexToken ft, ffebld expr, 798 ffelexToken t); 799static ffelexHandler ffestb_R9111_ (ffelexToken ft, ffebld expr, 800 ffelexToken t); 801static ffelexHandler ffestb_R9112_ (ffelexToken ft, ffebld expr, 802 ffelexToken t); 803static ffelexHandler ffestb_R9231_ (ffelexToken t); 804static ffelexHandler ffestb_R9232_ (ffelexToken t); 805static ffelexHandler ffestb_R9233_ (ffelexToken ft, ffebld expr, 806 ffelexToken t); 807static ffelexHandler ffestb_R9234_ (ffelexToken t); 808static ffelexHandler ffestb_R9235_ (ffelexToken t); 809static ffelexHandler ffestb_R9236_ (ffelexToken ft, ffebld expr, 810 ffelexToken t); 811static ffelexHandler ffestb_R9237_ (ffelexToken t); 812static ffelexHandler ffestb_R9238_ (ffelexToken t); 813static ffelexHandler ffestb_R9239_ (ffelexToken t); 814static ffelexHandler ffestb_R92310_ (ffelexToken t); 815static ffelexHandler ffestb_R92311_ (ffelexToken ft, ffebld expr, 816 ffelexToken t); 817#if FFESTR_VXT 818static ffelexHandler ffestb_V0181_ (ffelexToken t); 819static ffelexHandler ffestb_V0182_ (ffelexToken t); 820static ffelexHandler ffestb_V0183_ (ffelexToken ft, ffebld expr, 821 ffelexToken t); 822static ffelexHandler ffestb_V0184_ (ffelexToken t); 823static ffelexHandler ffestb_V0185_ (ffelexToken t); 824static ffelexHandler ffestb_V0186_ (ffelexToken ft, ffebld expr, 825 ffelexToken t); 826static ffelexHandler ffestb_V0187_ (ffelexToken t); 827static ffelexHandler ffestb_V0188_ (ffelexToken t); 828static ffelexHandler ffestb_V0189_ (ffelexToken ft, ffebld expr, 829 ffelexToken t); 830static ffelexHandler ffestb_V01810_ (ffelexToken t); 831static ffelexHandler ffestb_V01811_ (ffelexToken t); 832static ffelexHandler ffestb_V01812_ (ffelexToken t); 833static ffelexHandler ffestb_V01813_ (ffelexToken ft, ffebld expr, 834 ffelexToken t); 835static ffelexHandler ffestb_V0191_ (ffelexToken ft, ffebld expr, 836 ffelexToken t); 837static ffelexHandler ffestb_V0192_ (ffelexToken ft, ffebld expr, 838 ffelexToken t); 839#endif 840static ffelexHandler ffestb_V0201_ (ffelexToken ft, ffebld expr, 841 ffelexToken t); 842static ffelexHandler ffestb_V0202_ (ffelexToken ft, ffebld expr, 843 ffelexToken t); 844#if FFESTR_VXT 845static ffelexHandler ffestb_V0211_ (ffelexToken t); 846static ffelexHandler ffestb_V0212_ (ffelexToken t); 847static ffelexHandler ffestb_V0213_ (ffelexToken ft, ffebld expr, 848 ffelexToken t); 849static ffelexHandler ffestb_V0214_ (ffelexToken t); 850static ffelexHandler ffestb_V0215_ (ffelexToken t); 851static ffelexHandler ffestb_V0216_ (ffelexToken ft, ffebld expr, 852 ffelexToken t); 853static ffelexHandler ffestb_V0217_ (ffelexToken t); 854static ffelexHandler ffestb_V0218_ (ffelexToken t); 855static ffelexHandler ffestb_V0219_ (ffelexToken t); 856static ffelexHandler ffestb_V0261_ (ffelexToken t); 857static ffelexHandler ffestb_V0262_ (ffelexToken t); 858static ffelexHandler ffestb_V0263_ (ffelexToken ft, ffebld expr, 859 ffelexToken t); 860static ffelexHandler ffestb_V0264_ (ffelexToken t); 861static ffelexHandler ffestb_V0265_ (ffelexToken t); 862static ffelexHandler ffestb_V0266_ (ffelexToken ft, ffebld expr, 863 ffelexToken t); 864static ffelexHandler ffestb_V0267_ (ffelexToken t); 865static ffelexHandler ffestb_V0268_ (ffelexToken t); 866static ffelexHandler ffestb_V0269_ (ffelexToken t); 867#endif 868#if FFESTR_F90 869static ffelexHandler ffestb_dimlist1_ (ffelexToken t); 870static ffelexHandler ffestb_dimlist2_ (ffelexToken t); 871static ffelexHandler ffestb_dimlist3_ (ffelexToken t); 872static ffelexHandler ffestb_dimlist4_ (ffelexToken t); 873#endif 874static ffelexHandler ffestb_dummy1_ (ffelexToken t); 875static ffelexHandler ffestb_dummy2_ (ffelexToken t); 876static ffelexHandler ffestb_R5241_ (ffelexToken t); 877static ffelexHandler ffestb_R5242_ (ffelexToken t); 878static ffelexHandler ffestb_R5243_ (ffelexToken t); 879static ffelexHandler ffestb_R5244_ (ffelexToken t); 880static ffelexHandler ffestb_R5471_ (ffelexToken t); 881static ffelexHandler ffestb_R5472_ (ffelexToken t); 882static ffelexHandler ffestb_R5473_ (ffelexToken t); 883static ffelexHandler ffestb_R5474_ (ffelexToken t); 884static ffelexHandler ffestb_R5475_ (ffelexToken t); 885static ffelexHandler ffestb_R5476_ (ffelexToken t); 886static ffelexHandler ffestb_R5477_ (ffelexToken t); 887#if FFESTR_F90 888static ffelexHandler ffestb_R6241_ (ffelexToken ft, ffebld expr, 889 ffelexToken t); 890static ffelexHandler ffestb_R6242_ (ffelexToken t); 891#endif 892static ffelexHandler ffestb_R12291_ (ffelexToken t); 893static ffelexHandler ffestb_R12292_ (ffelexToken ft, ffebld expr, 894 ffelexToken t); 895static ffelexHandler ffestb_decl_chartype1_ (ffelexToken t); 896#if FFESTR_F90 897static ffelexHandler ffestb_decl_recursive1_ (ffelexToken t); 898static ffelexHandler ffestb_decl_recursive2_ (ffelexToken t); 899static ffelexHandler ffestb_decl_recursive3_ (ffelexToken t); 900static ffelexHandler ffestb_decl_recursive4_ (ffelexToken t); 901#endif 902static ffelexHandler ffestb_decl_attrs_ (ffelexToken t); 903static ffelexHandler ffestb_decl_attrs_1_ (ffelexToken t); 904static ffelexHandler ffestb_decl_attrs_2_ (ffelexToken t); 905#if FFESTR_F90 906static ffelexHandler ffestb_decl_attrs_3_ (ffelexToken t); 907static ffelexHandler ffestb_decl_attrs_4_ (ffelexToken t); 908static ffelexHandler ffestb_decl_attrs_5_ (ffelexToken t); 909static ffelexHandler ffestb_decl_attrs_6_ (ffelexToken t); 910#endif 911static ffelexHandler ffestb_decl_attrs_7_ (ffelexToken t); 912static ffelexHandler ffestb_decl_attrsp_ (ffelexToken t); 913static ffelexHandler ffestb_decl_ents_ (ffelexToken t); 914static ffelexHandler ffestb_decl_ents_1_ (ffelexToken t); 915static ffelexHandler ffestb_decl_ents_2_ (ffelexToken t); 916static ffelexHandler ffestb_decl_ents_3_ (ffelexToken t); 917static ffelexHandler ffestb_decl_ents_4_ (ffelexToken t); 918static ffelexHandler ffestb_decl_ents_5_ (ffelexToken t); 919static ffelexHandler ffestb_decl_ents_6_ (ffelexToken ft, ffebld expr, 920 ffelexToken t); 921static ffelexHandler ffestb_decl_ents_7_ (ffelexToken t); 922static ffelexHandler ffestb_decl_ents_8_ (ffelexToken ft, ffebld expr, 923 ffelexToken t); 924static ffelexHandler ffestb_decl_ents_9_ (ffelexToken ft, ffebld expr, 925 ffelexToken t); 926static ffelexHandler ffestb_decl_ents_10_ (ffelexToken ft, ffebld expr, 927 ffelexToken t); 928static ffelexHandler ffestb_decl_ents_11_ (ffelexToken t); 929static ffelexHandler ffestb_decl_entsp_ (ffelexToken t); 930static ffelexHandler ffestb_decl_entsp_1_ (ffelexToken t); 931static ffelexHandler ffestb_decl_entsp_2_ (ffelexToken t); 932static ffelexHandler ffestb_decl_entsp_3_ (ffelexToken t); 933static ffelexHandler ffestb_decl_entsp_4_ (ffelexToken ft, ffebld expr, 934 ffelexToken t); 935static ffelexHandler ffestb_decl_entsp_5_ (ffelexToken t); 936static ffelexHandler ffestb_decl_entsp_6_ (ffelexToken t); 937static ffelexHandler ffestb_decl_entsp_7_ (ffelexToken t); 938static ffelexHandler ffestb_decl_entsp_8_ (ffelexToken t); 939#if FFESTR_F90 940static ffelexHandler ffestb_decl_func_ (ffelexToken t); 941#endif 942static ffelexHandler ffestb_decl_funcname_ (ffelexToken t); 943static ffelexHandler ffestb_decl_funcname_1_ (ffelexToken t); 944static ffelexHandler ffestb_decl_funcname_2_ (ffelexToken t); 945static ffelexHandler ffestb_decl_funcname_3_ (ffelexToken ft, ffebld expr, 946 ffelexToken t); 947static ffelexHandler ffestb_decl_funcname_4_ (ffelexToken t); 948static ffelexHandler ffestb_decl_funcname_5_ (ffelexToken t); 949static ffelexHandler ffestb_decl_funcname_6_ (ffelexToken t); 950static ffelexHandler ffestb_decl_funcname_7_ (ffelexToken t); 951static ffelexHandler ffestb_decl_funcname_8_ (ffelexToken t); 952static ffelexHandler ffestb_decl_funcname_9_ (ffelexToken t); 953#if FFESTR_VXT 954static ffelexHandler ffestb_V0031_ (ffelexToken t); 955static ffelexHandler ffestb_V0032_ (ffelexToken t); 956static ffelexHandler ffestb_V0033_ (ffelexToken t); 957static ffelexHandler ffestb_V0034_ (ffelexToken t); 958static ffelexHandler ffestb_V0035_ (ffelexToken t); 959static ffelexHandler ffestb_V0036_ (ffelexToken t); 960static ffelexHandler ffestb_V0161_ (ffelexToken t); 961static ffelexHandler ffestb_V0162_ (ffelexToken t); 962static ffelexHandler ffestb_V0163_ (ffelexToken t); 963static ffelexHandler ffestb_V0164_ (ffelexToken t); 964static ffelexHandler ffestb_V0165_ (ffelexToken t); 965static ffelexHandler ffestb_V0166_ (ffelexToken t); 966#endif 967static ffelexHandler ffestb_V0271_ (ffelexToken t); 968static ffelexHandler ffestb_V0272_ (ffelexToken ft, ffebld expr, 969 ffelexToken t); 970static ffelexHandler ffestb_V0273_ (ffelexToken t); 971static ffelexHandler ffestb_decl_R5391_ (ffelexToken t); 972static ffelexHandler ffestb_decl_R5392_ (ffelexToken t); 973#if FFESTR_F90 974static ffelexHandler ffestb_decl_R5393_ (ffelexToken t); 975#endif 976static ffelexHandler ffestb_decl_R5394_ (ffelexToken t); 977static ffelexHandler ffestb_decl_R5395_ (ffelexToken t); 978static ffelexHandler ffestb_decl_R539letters_ (ffelexToken t); 979static ffelexHandler ffestb_decl_R539letters_1_ (ffelexToken t); 980static ffelexHandler ffestb_decl_R539letters_2_ (ffelexToken t); 981static ffelexHandler ffestb_decl_R539letters_3_ (ffelexToken t); 982static ffelexHandler ffestb_decl_R539letters_4_ (ffelexToken t); 983static ffelexHandler ffestb_decl_R539letters_5_ (ffelexToken t); 984static ffelexHandler ffestb_decl_R539maybe_ (ffelexToken t); 985static ffelexHandler ffestb_decl_R539maybe_1_ (ffelexToken t); 986static ffelexHandler ffestb_decl_R539maybe_2_ (ffelexToken t); 987static ffelexHandler ffestb_decl_R539maybe_3_ (ffelexToken t); 988static ffelexHandler ffestb_decl_R539maybe_4_ (ffelexToken t); 989static ffelexHandler ffestb_decl_R539maybe_5_ (ffelexToken t); 990 991/* Internal macros. */ 992 993#if FFESTB_KILL_EASY_ 994#define ffestb_subr_kill_accept_() \ 995 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_acceptix) 996#define ffestb_subr_kill_beru_() \ 997 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_beruix) 998#define ffestb_subr_kill_close_() \ 999 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_closeix) 1000#define ffestb_subr_kill_delete_() \ 1001 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_deleteix) 1002#define ffestb_subr_kill_find_() \ 1003 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_findix) 1004#define ffestb_subr_kill_inquire_() \ 1005 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_inquireix) 1006#define ffestb_subr_kill_open_() \ 1007 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_openix) 1008#define ffestb_subr_kill_print_() \ 1009 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_printix) 1010#define ffestb_subr_kill_read_() \ 1011 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_readix) 1012#define ffestb_subr_kill_rewrite_() \ 1013 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_rewriteix) 1014#define ffestb_subr_kill_type_() \ 1015 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_typeix) 1016#define ffestb_subr_kill_vxtcode_() \ 1017 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_vxtcodeix) 1018#define ffestb_subr_kill_write_() \ 1019 ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_writeix) 1020#endif 1021 1022/* ffestb_subr_ambig_nope_ -- Cleans up and aborts ambig w/o confirming 1023 1024 ffestb_subr_ambig_nope_(); 1025 1026 Switch from ambiguity handling in _entsp_ functions to handling entities 1027 in _ents_ (perform housekeeping tasks). */ 1028 1029static ffelexHandler 1030ffestb_subr_ambig_nope_ (ffelexToken t) 1031{ 1032 if (ffestb_local_.decl.recursive != NULL) 1033 ffelex_token_kill (ffestb_local_.decl.recursive); 1034 if (ffestb_local_.decl.kindt != NULL) 1035 ffelex_token_kill (ffestb_local_.decl.kindt); 1036 if (ffestb_local_.decl.lent != NULL) 1037 ffelex_token_kill (ffestb_local_.decl.lent); 1038 ffelex_token_kill (ffesta_tokens[1]); 1039 ffelex_token_kill (ffesta_tokens[2]); 1040 ffestt_tokenlist_kill (ffestb_local_.decl.toklist); 1041 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); 1042 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 1043} 1044 1045/* ffestb_subr_ambig_to_ents_ -- Switches from ambiguity to entity decl 1046 1047 ffestb_subr_ambig_to_ents_(); 1048 1049 Switch from ambiguity handling in _entsp_ functions to handling entities 1050 in _ents_ (perform housekeeping tasks). */ 1051 1052static void 1053ffestb_subr_ambig_to_ents_ () 1054{ 1055 ffelexToken nt; 1056 1057 nt = ffelex_token_name_from_names (ffesta_tokens[1], 0, 0); 1058 ffelex_token_kill (ffesta_tokens[1]); 1059 ffelex_token_kill (ffesta_tokens[2]); 1060 ffesta_tokens[1] = nt; 1061 if (ffestb_local_.decl.recursive != NULL) 1062 ffelex_token_kill (ffestb_local_.decl.recursive); 1063 if (!ffestb_local_.decl.aster_after) 1064 { 1065 if (ffestb_local_.decl.type == FFESTP_typeCHARACTER) 1066 { 1067 if (!ffesta_is_inhibited ()) 1068 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0], 1069 ffestb_local_.decl.kind, ffestb_local_.decl.kindt, 1070 ffestb_local_.decl.len, ffestb_local_.decl.lent); 1071 if (ffestb_local_.decl.kindt != NULL) 1072 { 1073 ffelex_token_kill (ffestb_local_.decl.kindt); 1074 ffestb_local_.decl.kind = NULL; 1075 ffestb_local_.decl.kindt = NULL; 1076 } 1077 if (ffestb_local_.decl.lent != NULL) 1078 { 1079 ffelex_token_kill (ffestb_local_.decl.lent); 1080 ffestb_local_.decl.len = NULL; 1081 ffestb_local_.decl.lent = NULL; 1082 } 1083 } 1084 else 1085 { 1086 if (!ffesta_is_inhibited ()) 1087 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0], 1088 ffestb_local_.decl.kind, ffestb_local_.decl.kindt, NULL, 1089 NULL); 1090 if (ffestb_local_.decl.kindt != NULL) 1091 { 1092 ffelex_token_kill (ffestb_local_.decl.kindt); 1093 ffestb_local_.decl.kind = NULL; 1094 ffestb_local_.decl.kindt = NULL; 1095 } 1096 } 1097 return; 1098 } 1099 if (ffestb_local_.decl.type == FFESTP_typeCHARACTER) 1100 { 1101 if (!ffesta_is_inhibited ()) 1102 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0], 1103 ffestb_local_.decl.kind, ffestb_local_.decl.kindt, NULL, NULL); 1104 if (ffestb_local_.decl.kindt != NULL) 1105 { 1106 ffelex_token_kill (ffestb_local_.decl.kindt); 1107 ffestb_local_.decl.kind = NULL; 1108 ffestb_local_.decl.kindt = NULL; 1109 } 1110 } 1111 else if (!ffesta_is_inhibited ()) 1112 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0], 1113 NULL, NULL, NULL, NULL); 1114 /* NAME/NAMES token already in ffesta_tokens[1]. */ 1115} 1116 1117/* ffestb_subr_dimlist_ -- OPEN_PAREN expr 1118 1119 (ffestb_subr_dimlist_) // to expression handler 1120 1121 Deal with a dimension list. 1122 1123 19-Dec-90 JCB 1.1 1124 Detect too many dimensions if backend wants it. */ 1125 1126static ffelexHandler 1127ffestb_subr_dimlist_ (ffelexToken ft, ffebld expr, ffelexToken t) 1128{ 1129 switch (ffelex_token_type (t)) 1130 { 1131 case FFELEX_typeCLOSE_PAREN: 1132 if (expr == NULL) 1133 break; 1134#ifdef FFECOM_dimensionsMAX 1135 if (ffestb_subrargs_.dim_list.ndims++ == FFECOM_dimensionsMAX) 1136 { 1137 ffesta_ffebad_1t (FFEBAD_TOO_MANY_DIMS, ft); 1138 ffestb_subrargs_.dim_list.ok = TRUE; /* Not a parse error, really. */ 1139 return (ffelexHandler) ffestb_subrargs_.dim_list.handler; 1140 } 1141#endif 1142 ffestt_dimlist_append (ffestb_subrargs_.dim_list.dims, NULL, expr, 1143 ffelex_token_use (t)); 1144 ffestb_subrargs_.dim_list.ok = TRUE; 1145 return (ffelexHandler) ffestb_subrargs_.dim_list.handler; 1146 1147 case FFELEX_typeCOMMA: 1148 if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR)) 1149 break; 1150#ifdef FFECOM_dimensionsMAX 1151 if (ffestb_subrargs_.dim_list.ndims++ == FFECOM_dimensionsMAX) 1152 { 1153 ffesta_ffebad_1t (FFEBAD_TOO_MANY_DIMS, ft); 1154 return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool, 1155 ffestb_subrargs_.dim_list.ctx, 1156 (ffeexprCallback) ffestb_subr_dimlist_2_); 1157 } 1158#endif 1159 ffestt_dimlist_append (ffestb_subrargs_.dim_list.dims, NULL, expr, 1160 ffelex_token_use (t)); 1161 return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool, 1162 ffestb_subrargs_.dim_list.ctx, 1163 (ffeexprCallback) ffestb_subr_dimlist_); 1164 1165 case FFELEX_typeCOLON: 1166 if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR)) 1167 break; 1168#ifdef FFECOM_dimensionsMAX 1169 if (ffestb_subrargs_.dim_list.ndims++ == FFECOM_dimensionsMAX) 1170 { 1171 ffesta_ffebad_1t (FFEBAD_TOO_MANY_DIMS, ft); 1172 return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool, 1173 ffestb_subrargs_.dim_list.ctx, 1174 (ffeexprCallback) ffestb_subr_dimlist_2_); 1175 } 1176#endif 1177 ffestt_dimlist_append (ffestb_subrargs_.dim_list.dims, expr, NULL, 1178 ffelex_token_use (t)); /* NULL second expr for 1179 now, just plug in. */ 1180 return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool, 1181 ffestb_subrargs_.dim_list.ctx, 1182 (ffeexprCallback) ffestb_subr_dimlist_1_); 1183 1184 default: 1185 break; 1186 } 1187 1188 ffestb_subrargs_.dim_list.ok = FALSE; 1189 return (ffelexHandler) ffestb_subrargs_.dim_list.handler (t); 1190} 1191 1192/* ffestb_subr_dimlist_1_ -- OPEN_PAREN expr COLON expr 1193 1194 (ffestb_subr_dimlist_1_) // to expression handler 1195 1196 Get the upper bound. */ 1197 1198static ffelexHandler 1199ffestb_subr_dimlist_1_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t) 1200{ 1201 switch (ffelex_token_type (t)) 1202 { 1203 case FFELEX_typeCLOSE_PAREN: 1204 ffestb_subrargs_.dim_list.dims->previous->upper = expr; 1205 ffestb_subrargs_.dim_list.ok = TRUE; 1206 return (ffelexHandler) ffestb_subrargs_.dim_list.handler; 1207 1208 case FFELEX_typeCOMMA: 1209 if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR)) 1210 break; 1211 ffestb_subrargs_.dim_list.dims->previous->upper = expr; 1212 return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool, 1213 ffestb_subrargs_.dim_list.ctx, (ffeexprCallback) ffestb_subr_dimlist_); 1214 1215 default: 1216 break; 1217 } 1218 1219 ffestb_subrargs_.dim_list.ok = FALSE; 1220 return (ffelexHandler) ffestb_subrargs_.dim_list.handler (t); 1221} 1222 1223/* ffestb_subr_dimlist_2_ -- OPEN_PAREN too-many-dim-exprs 1224 1225 (ffestb_subr_dimlist_2_) // to expression handler 1226 1227 Get the upper bound. */ 1228 1229static ffelexHandler 1230ffestb_subr_dimlist_2_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t) 1231{ 1232 switch (ffelex_token_type (t)) 1233 { 1234 case FFELEX_typeCLOSE_PAREN: 1235 ffestb_subrargs_.dim_list.ok = TRUE; /* Not a parse error, really. */ 1236 return (ffelexHandler) ffestb_subrargs_.dim_list.handler; 1237 1238 case FFELEX_typeCOMMA: 1239 case FFELEX_typeCOLON: 1240 if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR)) 1241 break; 1242 return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool, 1243 ffestb_subrargs_.dim_list.ctx, 1244 (ffeexprCallback) ffestb_subr_dimlist_2_); 1245 1246 default: 1247 break; 1248 } 1249 1250 ffestb_subrargs_.dim_list.ok = FALSE; 1251 return (ffelexHandler) ffestb_subrargs_.dim_list.handler (t); 1252} 1253 1254/* ffestb_subr_name_list_ -- Collect a list of name args and close-paren 1255 1256 return ffestb_subr_name_list_; // to lexer after seeing OPEN_PAREN 1257 1258 This implements R1224 in the Fortran 90 spec. The arg list may be 1259 empty, or be a comma-separated list (an optional trailing comma currently 1260 results in a warning but no other effect) of arguments. For functions, 1261 however, "*" is invalid (we implement dummy-arg-name, rather than R1224 1262 dummy-arg, which itself is either dummy-arg-name or "*"). */ 1263 1264static ffelexHandler 1265ffestb_subr_name_list_ (ffelexToken t) 1266{ 1267 switch (ffelex_token_type (t)) 1268 { 1269 case FFELEX_typeCLOSE_PAREN: 1270 if (ffestt_tokenlist_count (ffestb_subrargs_.name_list.args) != 0) 1271 { /* Trailing comma, warn. */ 1272 ffebad_start (FFEBAD_TRAILING_COMMA); 1273 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); 1274 ffebad_finish (); 1275 } 1276 ffestb_subrargs_.name_list.ok = TRUE; 1277 ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t); 1278 if (ffestb_subrargs_.name_list.names) 1279 ffelex_set_names (TRUE); 1280 return (ffelexHandler) ffestb_subrargs_.name_list.handler; 1281 1282 case FFELEX_typeASTERISK: 1283 if (!ffestb_subrargs_.name_list.is_subr) 1284 break; 1285 1286 case FFELEX_typeNAME: 1287 ffestt_tokenlist_append (ffestb_subrargs_.name_list.args, 1288 ffelex_token_use (t)); 1289 return (ffelexHandler) ffestb_subr_name_list_1_; 1290 1291 default: 1292 break; 1293 } 1294 1295 ffestb_subrargs_.name_list.ok = FALSE; 1296 ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t); 1297 if (ffestb_subrargs_.name_list.names) 1298 ffelex_set_names (TRUE); 1299 return (ffelexHandler) (*ffestb_subrargs_.name_list.handler) (t); 1300} 1301 1302/* ffestb_subr_name_list_1_ -- NAME or ASTERISK 1303 1304 return ffestb_subr_name_list_1_; // to lexer 1305 1306 The next token must be COMMA or CLOSE_PAREN, either way go to original 1307 state, but only after adding the appropriate name list item. */ 1308 1309static ffelexHandler 1310ffestb_subr_name_list_1_ (ffelexToken t) 1311{ 1312 switch (ffelex_token_type (t)) 1313 { 1314 case FFELEX_typeCOMMA: 1315 return (ffelexHandler) ffestb_subr_name_list_; 1316 1317 case FFELEX_typeCLOSE_PAREN: 1318 ffestb_subrargs_.name_list.ok = TRUE; 1319 ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t); 1320 if (ffestb_subrargs_.name_list.names) 1321 ffelex_set_names (TRUE); 1322 return (ffelexHandler) ffestb_subrargs_.name_list.handler; 1323 1324 default: 1325 ffestb_subrargs_.name_list.ok = FALSE; 1326 ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t); 1327 if (ffestb_subrargs_.name_list.names) 1328 ffelex_set_names (TRUE); 1329 return (ffelexHandler) (*ffestb_subrargs_.name_list.handler) (t); 1330 } 1331} 1332 1333static void 1334ffestb_subr_R1001_append_p_ (void) 1335{ 1336 ffesttFormatList f; 1337 1338 if (!ffestb_local_.format.pre.present) 1339 { 1340 ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_P_SPEC, ffestb_local_.format.t); 1341 ffelex_token_kill (ffestb_local_.format.t); 1342 return; 1343 } 1344 1345 f = ffestt_formatlist_append (ffestb_local_.format.f); 1346 f->type = FFESTP_formattypeP; 1347 f->t = ffestb_local_.format.t; 1348 f->u.R1010.val = ffestb_local_.format.pre; 1349} 1350 1351/* ffestb_decl_kindparam_ -- "type" OPEN_PAREN 1352 1353 return ffestb_decl_kindparam_; // to lexer 1354 1355 Handle "[KIND=]expr)". */ 1356 1357static ffelexHandler 1358ffestb_decl_kindparam_ (ffelexToken t) 1359{ 1360 switch (ffelex_token_type (t)) 1361 { 1362 case FFELEX_typeNAME: 1363 ffesta_tokens[1] = ffelex_token_use (t); 1364 return (ffelexHandler) ffestb_decl_kindparam_1_; 1365 1366 default: 1367 return (ffelexHandler) (*((ffelexHandler) 1368 ffeexpr_rhs (ffesta_output_pool, 1369 FFEEXPR_contextKINDTYPE, 1370 (ffeexprCallback) ffestb_decl_kindparam_2_))) 1371 (t); 1372 } 1373} 1374 1375/* ffestb_decl_kindparam_1_ -- "type" OPEN_PAREN NAME 1376 1377 return ffestb_decl_kindparam_1_; // to lexer 1378 1379 Handle "[KIND=]expr)". */ 1380 1381static ffelexHandler 1382ffestb_decl_kindparam_1_ (ffelexToken t) 1383{ 1384 ffelexHandler next; 1385 ffelexToken nt; 1386 1387 switch (ffelex_token_type (t)) 1388 { 1389 case FFELEX_typeEQUALS: 1390 ffesta_confirmed (); 1391 if (ffestr_other (ffesta_tokens[1]) != FFESTR_otherKIND) 1392 break; 1393 ffelex_token_kill (ffesta_tokens[1]); 1394 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 1395 FFEEXPR_contextKINDTYPE, (ffeexprCallback) ffestb_decl_kindparam_2_); 1396 1397 default: 1398 nt = ffesta_tokens[1]; 1399 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 1400 FFEEXPR_contextKINDTYPE, (ffeexprCallback) ffestb_decl_kindparam_2_))) 1401 (nt); 1402 ffelex_token_kill (nt); 1403 return (ffelexHandler) (*next) (t); 1404 } 1405 1406 if (ffestb_local_.decl.recursive != NULL) 1407 ffelex_token_kill (ffestb_local_.decl.recursive); 1408 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, 1409 ffestb_local_.decl.badname, 1410 ffesta_tokens[1]); 1411 ffelex_token_kill (ffesta_tokens[1]); 1412 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 1413} 1414 1415/* ffestb_decl_kindparam_2_ -- "type" OPEN_PAREN ["KIND="] expr 1416 1417 (ffestb_decl_kindparam_2_) // to expression handler 1418 1419 Handle "[KIND=]expr)". */ 1420 1421static ffelexHandler 1422ffestb_decl_kindparam_2_ (ffelexToken ft, ffebld expr, ffelexToken t) 1423{ 1424 switch (ffelex_token_type (t)) 1425 { 1426 case FFELEX_typeCLOSE_PAREN: 1427 ffestb_local_.decl.kind = expr; 1428 ffestb_local_.decl.kindt = ffelex_token_use (ft); 1429 ffestb_local_.decl.len = NULL; 1430 ffestb_local_.decl.lent = NULL; 1431 ffelex_set_names (TRUE); 1432 return (ffelexHandler) ffestb_local_.decl.handler; 1433 1434 default: 1435 break; 1436 } 1437 1438 if (ffestb_local_.decl.recursive != NULL) 1439 ffelex_token_kill (ffestb_local_.decl.recursive); 1440 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, 1441 ffestb_local_.decl.badname, 1442 t); 1443 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 1444} 1445 1446/* ffestb_decl_starkind_ -- "type" ASTERISK 1447 1448 return ffestb_decl_starkind_; // to lexer 1449 1450 Handle NUMBER. */ 1451 1452static ffelexHandler 1453ffestb_decl_starkind_ (ffelexToken t) 1454{ 1455 switch (ffelex_token_type (t)) 1456 { 1457 case FFELEX_typeNUMBER: 1458 ffestb_local_.decl.kindt = ffelex_token_use (t); 1459 ffestb_local_.decl.kind = NULL; 1460 ffestb_local_.decl.len = NULL; 1461 ffestb_local_.decl.lent = NULL; 1462 ffelex_set_names (TRUE); 1463 return (ffelexHandler) ffestb_local_.decl.handler; 1464 1465 default: 1466 break; 1467 } 1468 1469 if (ffestb_local_.decl.recursive != NULL) 1470 ffelex_token_kill (ffestb_local_.decl.recursive); 1471 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, 1472 ffestb_local_.decl.badname, 1473 t); 1474 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 1475} 1476 1477/* ffestb_decl_starlen_ -- "CHARACTER" ASTERISK 1478 1479 return ffestb_decl_starlen_; // to lexer 1480 1481 Handle NUMBER. */ 1482 1483static ffelexHandler 1484ffestb_decl_starlen_ (ffelexToken t) 1485{ 1486 switch (ffelex_token_type (t)) 1487 { 1488 case FFELEX_typeNUMBER: 1489 ffestb_local_.decl.kind = NULL; 1490 ffestb_local_.decl.kindt = NULL; 1491 ffestb_local_.decl.len = NULL; 1492 ffestb_local_.decl.lent = ffelex_token_use (t); 1493 ffelex_set_names (TRUE); 1494 return (ffelexHandler) ffestb_local_.decl.handler; 1495 1496 case FFELEX_typeOPEN_PAREN: 1497 ffestb_local_.decl.kind = NULL; 1498 ffestb_local_.decl.kindt = NULL; 1499 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 1500 FFEEXPR_contextCHARACTERSIZE, 1501 (ffeexprCallback) ffestb_decl_starlen_1_); 1502 1503 default: 1504 break; 1505 } 1506 1507 if (ffestb_local_.decl.recursive != NULL) 1508 ffelex_token_kill (ffestb_local_.decl.recursive); 1509 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, 1510 ffestb_local_.decl.badname, 1511 t); 1512 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 1513} 1514 1515/* ffestb_decl_starlen_1_ -- "CHARACTER" ASTERISK OPEN_PAREN expr 1516 1517 (ffestb_decl_starlen_1_) // to expression handler 1518 1519 Handle CLOSE_PAREN. */ 1520 1521static ffelexHandler 1522ffestb_decl_starlen_1_ (ffelexToken ft, ffebld expr, ffelexToken t) 1523{ 1524 switch (ffelex_token_type (t)) 1525 { 1526 case FFELEX_typeCLOSE_PAREN: 1527 if (expr == NULL) 1528 break; 1529 ffestb_local_.decl.len = expr; 1530 ffestb_local_.decl.lent = ffelex_token_use (ft); 1531 ffelex_set_names (TRUE); 1532 return (ffelexHandler) ffestb_local_.decl.handler; 1533 1534 default: 1535 break; 1536 } 1537 1538 if (ffestb_local_.decl.recursive != NULL) 1539 ffelex_token_kill (ffestb_local_.decl.recursive); 1540 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, 1541 ffestb_local_.decl.badname, 1542 t); 1543 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 1544} 1545 1546/* ffestb_decl_typeparams_ -- "CHARACTER" OPEN_PAREN 1547 1548 return ffestb_decl_typeparams_; // to lexer 1549 1550 Handle "[KIND=]expr)". */ 1551 1552static ffelexHandler 1553ffestb_decl_typeparams_ (ffelexToken t) 1554{ 1555 switch (ffelex_token_type (t)) 1556 { 1557 case FFELEX_typeNAME: 1558 ffesta_tokens[1] = ffelex_token_use (t); 1559 return (ffelexHandler) ffestb_decl_typeparams_1_; 1560 1561 default: 1562 if (ffestb_local_.decl.lent == NULL) 1563 return (ffelexHandler) (*((ffelexHandler) 1564 ffeexpr_rhs (ffesta_output_pool, 1565 FFEEXPR_contextCHARACTERSIZE, 1566 (ffeexprCallback) ffestb_decl_typeparams_2_))) 1567 (t); 1568 if (ffestb_local_.decl.kindt != NULL) 1569 break; 1570 return (ffelexHandler) (*((ffelexHandler) 1571 ffeexpr_rhs (ffesta_output_pool, 1572 FFEEXPR_contextKINDTYPE, 1573 (ffeexprCallback) ffestb_decl_typeparams_3_))) 1574 (t); 1575 } 1576 1577 if (ffestb_local_.decl.recursive != NULL) 1578 ffelex_token_kill (ffestb_local_.decl.recursive); 1579 if (ffestb_local_.decl.kindt != NULL) 1580 ffelex_token_kill (ffestb_local_.decl.kindt); 1581 if (ffestb_local_.decl.lent != NULL) 1582 ffelex_token_kill (ffestb_local_.decl.lent); 1583 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, 1584 ffestb_local_.decl.badname, 1585 t); 1586 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 1587} 1588 1589/* ffestb_decl_typeparams_1_ -- "CHARACTER" OPEN_PAREN NAME 1590 1591 return ffestb_decl_typeparams_1_; // to lexer 1592 1593 Handle "[KIND=]expr)". */ 1594 1595static ffelexHandler 1596ffestb_decl_typeparams_1_ (ffelexToken t) 1597{ 1598 ffelexHandler next; 1599 ffelexToken nt; 1600 1601 switch (ffelex_token_type (t)) 1602 { 1603 case FFELEX_typeEQUALS: 1604 ffesta_confirmed (); 1605 switch (ffestr_other (ffesta_tokens[1])) 1606 { 1607 case FFESTR_otherLEN: 1608 if (ffestb_local_.decl.lent != NULL) 1609 break; 1610 ffelex_token_kill (ffesta_tokens[1]); 1611 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 1612 FFEEXPR_contextCHARACTERSIZE, 1613 (ffeexprCallback) ffestb_decl_typeparams_2_); 1614 1615 case FFESTR_otherKIND: 1616 if (ffestb_local_.decl.kindt != NULL) 1617 break; 1618 ffelex_token_kill (ffesta_tokens[1]); 1619 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 1620 FFEEXPR_contextKINDTYPE, 1621 (ffeexprCallback) ffestb_decl_typeparams_3_); 1622 1623 default: 1624 break; 1625 } 1626 break; 1627 1628 default: 1629 nt = ffesta_tokens[1]; 1630 if (ffestb_local_.decl.lent == NULL) 1631 next = (ffelexHandler) (*((ffelexHandler) 1632 ffeexpr_rhs (ffesta_output_pool, 1633 FFEEXPR_contextCHARACTERSIZE, 1634 (ffeexprCallback) ffestb_decl_typeparams_2_))) 1635 (nt); 1636 else if (ffestb_local_.decl.kindt == NULL) 1637 next = (ffelexHandler) (*((ffelexHandler) 1638 ffeexpr_rhs (ffesta_output_pool, 1639 FFEEXPR_contextKINDTYPE, 1640 (ffeexprCallback) ffestb_decl_typeparams_3_))) 1641 (nt); 1642 else 1643 { 1644 ffesta_tokens[1] = nt; 1645 break; 1646 } 1647 ffelex_token_kill (nt); 1648 return (ffelexHandler) (*next) (t); 1649 } 1650 1651 if (ffestb_local_.decl.recursive != NULL) 1652 ffelex_token_kill (ffestb_local_.decl.recursive); 1653 if (ffestb_local_.decl.kindt != NULL) 1654 ffelex_token_kill (ffestb_local_.decl.kindt); 1655 if (ffestb_local_.decl.lent != NULL) 1656 ffelex_token_kill (ffestb_local_.decl.lent); 1657 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, 1658 ffestb_local_.decl.badname, 1659 ffesta_tokens[1]); 1660 ffelex_token_kill (ffesta_tokens[1]); 1661 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 1662} 1663 1664/* ffestb_decl_typeparams_2_ -- "CHARACTER" OPEN_PAREN ["LEN="] expr 1665 1666 (ffestb_decl_typeparams_2_) // to expression handler 1667 1668 Handle "[LEN=]expr)". */ 1669 1670static ffelexHandler 1671ffestb_decl_typeparams_2_ (ffelexToken ft, ffebld expr, ffelexToken t) 1672{ 1673 switch (ffelex_token_type (t)) 1674 { 1675 case FFELEX_typeCLOSE_PAREN: 1676 ffestb_local_.decl.len = expr; 1677 ffestb_local_.decl.lent = ffelex_token_use (ft); 1678 ffelex_set_names (TRUE); 1679 return (ffelexHandler) ffestb_local_.decl.handler; 1680 1681 case FFELEX_typeCOMMA: 1682 ffestb_local_.decl.len = expr; 1683 ffestb_local_.decl.lent = ffelex_token_use (ft); 1684 return (ffelexHandler) ffestb_decl_typeparams_; 1685 1686 default: 1687 break; 1688 } 1689 1690 if (ffestb_local_.decl.recursive != NULL) 1691 ffelex_token_kill (ffestb_local_.decl.recursive); 1692 if (ffestb_local_.decl.kindt != NULL) 1693 ffelex_token_kill (ffestb_local_.decl.kindt); 1694 if (ffestb_local_.decl.lent != NULL) 1695 ffelex_token_kill (ffestb_local_.decl.lent); 1696 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, 1697 ffestb_local_.decl.badname, 1698 t); 1699 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 1700} 1701 1702/* ffestb_decl_typeparams_3_ -- "CHARACTER" OPEN_PAREN ["KIND="] expr 1703 1704 (ffestb_decl_typeparams_3_) // to expression handler 1705 1706 Handle "[KIND=]expr)". */ 1707 1708static ffelexHandler 1709ffestb_decl_typeparams_3_ (ffelexToken ft, ffebld expr, ffelexToken t) 1710{ 1711 switch (ffelex_token_type (t)) 1712 { 1713 case FFELEX_typeCLOSE_PAREN: 1714 ffestb_local_.decl.kind = expr; 1715 ffestb_local_.decl.kindt = ffelex_token_use (ft); 1716 ffelex_set_names (TRUE); 1717 return (ffelexHandler) ffestb_local_.decl.handler; 1718 1719 case FFELEX_typeCOMMA: 1720 ffestb_local_.decl.kind = expr; 1721 ffestb_local_.decl.kindt = ffelex_token_use (ft); 1722 return (ffelexHandler) ffestb_decl_typeparams_; 1723 1724 default: 1725 break; 1726 } 1727 1728 if (ffestb_local_.decl.recursive != NULL) 1729 ffelex_token_kill (ffestb_local_.decl.recursive); 1730 if (ffestb_local_.decl.kindt != NULL) 1731 ffelex_token_kill (ffestb_local_.decl.kindt); 1732 if (ffestb_local_.decl.lent != NULL) 1733 ffelex_token_kill (ffestb_local_.decl.lent); 1734 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, 1735 ffestb_local_.decl.badname, 1736 t); 1737 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 1738} 1739 1740/* ffestb_decl_typetype1_ -- "TYPE" OPEN_PAREN 1741 1742 return ffestb_decl_typetype1_; // to lexer 1743 1744 Handle NAME. */ 1745 1746#if FFESTR_F90 1747static ffelexHandler 1748ffestb_decl_typetype1_ (ffelexToken t) 1749{ 1750 switch (ffelex_token_type (t)) 1751 { 1752 case FFELEX_typeNAME: 1753 ffestb_local_.decl.kindt = ffelex_token_use (t); 1754 return (ffelexHandler) ffestb_decl_typetype2_; 1755 1756 default: 1757 break; 1758 } 1759 1760 if (ffestb_local_.decl.recursive != NULL) 1761 ffelex_token_kill (ffestb_local_.decl.recursive); 1762 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, 1763 ffestb_local_.decl.badname, 1764 t); 1765 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 1766} 1767 1768/* ffestb_decl_typetype2_ -- "TYPE" OPEN_PAREN NAME 1769 1770 return ffestb_decl_typetype2_; // to lexer 1771 1772 Handle CLOSE_PAREN. */ 1773 1774static ffelexHandler 1775ffestb_decl_typetype2_ (ffelexToken t) 1776{ 1777 switch (ffelex_token_type (t)) 1778 { 1779 case FFELEX_typeCLOSE_PAREN: 1780 ffestb_local_.decl.type = FFESTP_typeTYPE; 1781 ffestb_local_.decl.kind = NULL; 1782 ffestb_local_.decl.len = NULL; 1783 ffestb_local_.decl.lent = NULL; 1784 ffelex_set_names (TRUE); 1785 return (ffelexHandler) ffestb_local_.decl.handler; 1786 1787 default: 1788 break; 1789 } 1790 1791 if (ffestb_local_.decl.recursive != NULL) 1792 ffelex_token_kill (ffestb_local_.decl.recursive); 1793 ffelex_token_kill (ffestb_local_.decl.kindt); 1794 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, 1795 ffestb_local_.decl.badname, 1796 t); 1797 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 1798} 1799 1800#endif 1801/* ffestb_subr_label_list_ -- Collect a tokenlist of labels and close-paren 1802 1803 return ffestb_subr_label_list_; // to lexer after seeing OPEN_PAREN 1804 1805 First token must be a NUMBER. Must be followed by zero or more COMMA 1806 NUMBER pairs. Must then be followed by a CLOSE_PAREN. If all ok, put 1807 the NUMBER tokens in a token list and return via the handler for the 1808 token after CLOSE_PAREN. Else return via 1809 same handler, but with the ok return value set FALSE. */ 1810 1811static ffelexHandler 1812ffestb_subr_label_list_ (ffelexToken t) 1813{ 1814 if (ffelex_token_type (t) == FFELEX_typeNUMBER) 1815 { 1816 ffestt_tokenlist_append (ffestb_subrargs_.label_list.labels, 1817 ffelex_token_use (t)); 1818 return (ffelexHandler) ffestb_subr_label_list_1_; 1819 } 1820 1821 ffestb_subrargs_.label_list.ok = FALSE; 1822 return (ffelexHandler) (*ffestb_subrargs_.label_list.handler) (t); 1823} 1824 1825/* ffestb_subr_label_list_1_ -- NUMBER 1826 1827 return ffestb_subr_label_list_1_; // to lexer after seeing NUMBER 1828 1829 The next token must be COMMA, in which case go back to 1830 ffestb_subr_label_list_, or CLOSE_PAREN, in which case set ok to TRUE 1831 and go to the handler. */ 1832 1833static ffelexHandler 1834ffestb_subr_label_list_1_ (ffelexToken t) 1835{ 1836 switch (ffelex_token_type (t)) 1837 { 1838 case FFELEX_typeCOMMA: 1839 return (ffelexHandler) ffestb_subr_label_list_; 1840 1841 case FFELEX_typeCLOSE_PAREN: 1842 ffestb_subrargs_.label_list.ok = TRUE; 1843 return (ffelexHandler) ffestb_subrargs_.label_list.handler; 1844 1845 default: 1846 ffestb_subrargs_.label_list.ok = FALSE; 1847 return (ffelexHandler) (*ffestb_subrargs_.label_list.handler) (t); 1848 } 1849} 1850 1851/* ffestb_do -- Parse the DO statement 1852 1853 return ffestb_do; // to lexer 1854 1855 Make sure the statement has a valid form for the DO statement. If it 1856 does, implement the statement. */ 1857 1858ffelexHandler 1859ffestb_do (ffelexToken t) 1860{ 1861 ffeTokenLength i; 1862 unsigned const char *p; 1863 ffelexHandler next; 1864 ffelexToken nt; 1865 ffestrSecond kw; 1866 1867 switch (ffelex_token_type (ffesta_tokens[0])) 1868 { 1869 case FFELEX_typeNAME: 1870 if (ffesta_first_kw != FFESTR_firstDO) 1871 goto bad_0; /* :::::::::::::::::::: */ 1872 switch (ffelex_token_type (t)) 1873 { 1874 case FFELEX_typeNUMBER: 1875 ffesta_confirmed (); 1876 ffesta_tokens[1] = ffelex_token_use (t); 1877 return (ffelexHandler) ffestb_do1_; 1878 1879 case FFELEX_typeCOMMA: 1880 ffesta_confirmed (); 1881 ffesta_tokens[1] = NULL; 1882 return (ffelexHandler) ffestb_do2_; 1883 1884 case FFELEX_typeNAME: 1885 ffesta_confirmed (); 1886 ffesta_tokens[1] = NULL; 1887 ffesta_tokens[2] = ffelex_token_use (t); 1888 return (ffelexHandler) ffestb_do3_; 1889 1890 case FFELEX_typeEOS: 1891 case FFELEX_typeSEMICOLON: 1892 ffesta_confirmed (); 1893 ffesta_tokens[1] = NULL; 1894 return (ffelexHandler) ffestb_do1_ (t); 1895 1896 case FFELEX_typeCOLONCOLON: 1897 ffesta_confirmed (); /* Error, but clearly intended. */ 1898 goto bad_1; /* :::::::::::::::::::: */ 1899 1900 default: 1901 goto bad_1; /* :::::::::::::::::::: */ 1902 } 1903 1904 case FFELEX_typeNAMES: 1905 if (ffesta_first_kw != FFESTR_firstDO) 1906 goto bad_0; /* :::::::::::::::::::: */ 1907 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDO); 1908 switch (ffelex_token_type (t)) 1909 { 1910 case FFELEX_typeCOLONCOLON: 1911 ffesta_confirmed (); /* Error, but clearly intended. */ 1912 goto bad_1; /* :::::::::::::::::::: */ 1913 1914 default: 1915 goto bad_1; /* :::::::::::::::::::: */ 1916 1917 case FFELEX_typeOPEN_PAREN: /* Must be "DO" label "WHILE". */ 1918 if (! ISDIGIT (*p)) 1919 goto bad_i; /* :::::::::::::::::::: */ 1920 ffesta_tokens[1] = ffelex_token_number_from_names (ffesta_tokens[0], 1921 i); 1922 p += ffelex_token_length (ffesta_tokens[1]); 1923 i += ffelex_token_length (ffesta_tokens[1]); 1924 if (((*p) != 'W') && ((*p) != 'w')) 1925 goto bad_i1; /* :::::::::::::::::::: */ 1926 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); 1927 kw = ffestr_second (nt); 1928 ffelex_token_kill (nt); 1929 if (kw != FFESTR_secondWHILE) 1930 goto bad_i1; /* :::::::::::::::::::: */ 1931 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 1932 FFEEXPR_contextDOWHILE, (ffeexprCallback) ffestb_do4_); 1933 1934 case FFELEX_typeCOMMA: 1935 ffesta_confirmed (); 1936 if (*p == '\0') 1937 { 1938 ffesta_tokens[1] = NULL; 1939 return (ffelexHandler) ffestb_do2_; 1940 } 1941 if (! ISDIGIT (*p)) 1942 goto bad_i; /* :::::::::::::::::::: */ 1943 ffesta_tokens[1] = ffelex_token_number_from_names (ffesta_tokens[0], 1944 i); 1945 p += ffelex_token_length (ffesta_tokens[1]); 1946 i += ffelex_token_length (ffesta_tokens[1]); 1947 if (*p != '\0') 1948 goto bad_i1; /* :::::::::::::::::::: */ 1949 return (ffelexHandler) ffestb_do2_; 1950 1951 case FFELEX_typeEQUALS: 1952 if (ISDIGIT (*p)) 1953 { 1954 ffesta_tokens[1] 1955 = ffelex_token_number_from_names (ffesta_tokens[0], i); 1956 p += ffelex_token_length (ffesta_tokens[1]); 1957 i += ffelex_token_length (ffesta_tokens[1]); 1958 } 1959 else 1960 ffesta_tokens[1] = NULL; 1961 if (!ffesrc_is_name_init (*p)) 1962 goto bad_i1; /* :::::::::::::::::::: */ 1963 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); 1964 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_lhs 1965 (ffesta_output_pool, FFEEXPR_contextDO, 1966 (ffeexprCallback) ffestb_do6_))) 1967 (nt); 1968 ffelex_token_kill (nt); /* Will get it back in _6_... */ 1969 return (ffelexHandler) (*next) (t); 1970 1971 case FFELEX_typeEOS: 1972 case FFELEX_typeSEMICOLON: 1973 ffesta_confirmed (); 1974 if (ISDIGIT (*p)) 1975 { 1976 ffesta_tokens[1] 1977 = ffelex_token_number_from_names (ffesta_tokens[0], i); 1978 p += ffelex_token_length (ffesta_tokens[1]); 1979 i += ffelex_token_length (ffesta_tokens[1]); 1980 } 1981 else 1982 ffesta_tokens[1] = NULL; 1983 if (*p != '\0') 1984 goto bad_i1; /* :::::::::::::::::::: */ 1985 return (ffelexHandler) ffestb_do1_ (t); 1986 } 1987 1988 default: 1989 goto bad_0; /* :::::::::::::::::::: */ 1990 } 1991 1992bad_0: /* :::::::::::::::::::: */ 1993 if (ffesta_construct_name != NULL) 1994 { 1995 ffelex_token_kill (ffesta_construct_name); 1996 ffesta_construct_name = NULL; 1997 } 1998 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[0]); 1999 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 2000 2001bad_1: /* :::::::::::::::::::: */ 2002 if (ffesta_construct_name != NULL) 2003 { 2004 ffelex_token_kill (ffesta_construct_name); 2005 ffesta_construct_name = NULL; 2006 } 2007 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t); 2008 return (ffelexHandler) ffelex_swallow_tokens (t, 2009 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 2010 2011bad_i1: /* :::::::::::::::::::: */ 2012 if (ffesta_tokens[1]) 2013 ffelex_token_kill (ffesta_tokens[1]); 2014 2015bad_i: /* :::::::::::::::::::: */ 2016 if (ffesta_construct_name != NULL) 2017 { 2018 ffelex_token_kill (ffesta_construct_name); 2019 ffesta_construct_name = NULL; 2020 } 2021 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[0], i, t); 2022 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 2023} 2024 2025/* ffestb_dowhile -- Parse the DOWHILE statement 2026 2027 return ffestb_dowhile; // to lexer 2028 2029 Make sure the statement has a valid form for the DOWHILE statement. If it 2030 does, implement the statement. */ 2031 2032ffelexHandler 2033ffestb_dowhile (ffelexToken t) 2034{ 2035 ffeTokenLength i; 2036 const char *p; 2037 ffelexHandler next; 2038 ffelexToken nt; 2039 2040 switch (ffelex_token_type (ffesta_tokens[0])) 2041 { 2042 case FFELEX_typeNAMES: 2043 if (ffesta_first_kw != FFESTR_firstDOWHILE) 2044 goto bad_0; /* :::::::::::::::::::: */ 2045 switch (ffelex_token_type (t)) 2046 { 2047 case FFELEX_typeEOS: 2048 case FFELEX_typeSEMICOLON: 2049 case FFELEX_typeCOMMA: 2050 case FFELEX_typeCOLONCOLON: 2051 ffesta_confirmed (); /* Error, but clearly intended. */ 2052 goto bad_1; /* :::::::::::::::::::: */ 2053 2054 default: 2055 goto bad_1; /* :::::::::::::::::::: */ 2056 2057 case FFELEX_typeOPEN_PAREN: 2058 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDOWHILE); 2059 if (*p != '\0') 2060 goto bad_i; /* :::::::::::::::::::: */ 2061 ffesta_tokens[1] = NULL; 2062 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 2063 FFEEXPR_contextDOWHILE, (ffeexprCallback) ffestb_do4_); 2064 2065 case FFELEX_typeEQUALS:/* Not really DOWHILE, but DOWHILExyz=.... */ 2066 ffesta_tokens[1] = NULL; 2067 nt = ffelex_token_name_from_names (ffesta_tokens[0], FFESTR_firstlDO, 2068 0); 2069 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_lhs 2070 (ffesta_output_pool, FFEEXPR_contextDO, 2071 (ffeexprCallback) ffestb_do6_))) 2072 (nt); 2073 ffelex_token_kill (nt); /* Will get it back in _6_... */ 2074 return (ffelexHandler) (*next) (t); 2075 } 2076 2077 default: 2078 goto bad_0; /* :::::::::::::::::::: */ 2079 } 2080 2081bad_0: /* :::::::::::::::::::: */ 2082 if (ffesta_construct_name != NULL) 2083 { 2084 ffelex_token_kill (ffesta_construct_name); 2085 ffesta_construct_name = NULL; 2086 } 2087 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[0]); 2088 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 2089 2090bad_1: /* :::::::::::::::::::: */ 2091 if (ffesta_construct_name != NULL) 2092 { 2093 ffelex_token_kill (ffesta_construct_name); 2094 ffesta_construct_name = NULL; 2095 } 2096 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t); 2097 return (ffelexHandler) ffelex_swallow_tokens (t, 2098 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 2099 2100bad_i: /* :::::::::::::::::::: */ 2101 if (ffesta_construct_name != NULL) 2102 { 2103 ffelex_token_kill (ffesta_construct_name); 2104 ffesta_construct_name = NULL; 2105 } 2106 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[0], i, t); 2107 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 2108} 2109 2110/* ffestb_do1_ -- "DO" [label] 2111 2112 return ffestb_do1_; // to lexer 2113 2114 Make sure the statement has a valid form for the DO statement. If it 2115 does, implement the statement. */ 2116 2117static ffelexHandler 2118ffestb_do1_ (ffelexToken t) 2119{ 2120 switch (ffelex_token_type (t)) 2121 { 2122 case FFELEX_typeCOMMA: 2123 ffesta_confirmed (); 2124 return (ffelexHandler) ffestb_do2_; 2125 2126 case FFELEX_typeEOS: 2127 case FFELEX_typeSEMICOLON: 2128 ffesta_confirmed (); 2129 if (!ffesta_is_inhibited ()) 2130 { 2131 if (ffesta_tokens[1] != NULL) 2132 ffestc_R819B (ffesta_construct_name, ffesta_tokens[1], NULL, 2133 NULL); 2134 else 2135 ffestc_R820B (ffesta_construct_name, NULL, NULL); 2136 } 2137 if (ffesta_tokens[1] != NULL) 2138 ffelex_token_kill (ffesta_tokens[1]); 2139 if (ffesta_construct_name != NULL) 2140 { 2141 ffelex_token_kill (ffesta_construct_name); 2142 ffesta_construct_name = NULL; 2143 } 2144 return (ffelexHandler) ffesta_zero (t); 2145 2146 case FFELEX_typeNAME: 2147 return (ffelexHandler) ffestb_do2_ (t); 2148 2149 default: 2150 break; 2151 } 2152 2153 if (ffesta_tokens[1] != NULL) 2154 ffelex_token_kill (ffesta_tokens[1]); 2155 if (ffesta_construct_name != NULL) 2156 { 2157 ffelex_token_kill (ffesta_construct_name); 2158 ffesta_construct_name = NULL; 2159 } 2160 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t); 2161 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 2162} 2163 2164/* ffestb_do2_ -- "DO" [label] [,] 2165 2166 return ffestb_do2_; // to lexer 2167 2168 Make sure the statement has a valid form for the DO statement. If it 2169 does, implement the statement. */ 2170 2171static ffelexHandler 2172ffestb_do2_ (ffelexToken t) 2173{ 2174 switch (ffelex_token_type (t)) 2175 { 2176 case FFELEX_typeNAME: 2177 ffesta_tokens[2] = ffelex_token_use (t); 2178 return (ffelexHandler) ffestb_do3_; 2179 2180 default: 2181 break; 2182 } 2183 2184 if (ffesta_tokens[1] != NULL) 2185 ffelex_token_kill (ffesta_tokens[1]); 2186 if (ffesta_construct_name != NULL) 2187 { 2188 ffelex_token_kill (ffesta_construct_name); 2189 ffesta_construct_name = NULL; 2190 } 2191 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t); 2192 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 2193} 2194 2195/* ffestb_do3_ -- "DO" [label] [,] NAME 2196 2197 return ffestb_do3_; // to lexer 2198 2199 Make sure the statement has a valid form for the DO statement. If it 2200 does, implement the statement. */ 2201 2202static ffelexHandler 2203ffestb_do3_ (ffelexToken t) 2204{ 2205 ffelexHandler next; 2206 2207 switch (ffelex_token_type (t)) 2208 { 2209 case FFELEX_typeEQUALS: 2210 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 2211 FFEEXPR_contextDO, (ffeexprCallback) ffestb_do6_))) 2212 (ffesta_tokens[2]); 2213 ffelex_token_kill (ffesta_tokens[2]); /* Will get it back in _6_... */ 2214 return (ffelexHandler) (*next) (t); 2215 2216 case FFELEX_typeOPEN_PAREN: 2217 if (ffestr_second (ffesta_tokens[2]) != FFESTR_secondWHILE) 2218 { 2219 if (ffesta_tokens[1] != NULL) 2220 ffelex_token_kill (ffesta_tokens[1]); 2221 if (ffesta_construct_name != NULL) 2222 { 2223 ffelex_token_kill (ffesta_construct_name); 2224 ffesta_construct_name = NULL; 2225 } 2226 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[2]); 2227 ffelex_token_kill (ffesta_tokens[2]); 2228 return (ffelexHandler) ffelex_swallow_tokens (t, 2229 (ffelexHandler) ffesta_zero); /* Invalid token. */ 2230 } 2231 ffelex_token_kill (ffesta_tokens[2]); 2232 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 2233 FFEEXPR_contextDOWHILE, (ffeexprCallback) ffestb_do4_); 2234 2235 default: 2236 break; 2237 } 2238 2239 ffelex_token_kill (ffesta_tokens[2]); 2240 if (ffesta_tokens[1] != NULL) 2241 ffelex_token_kill (ffesta_tokens[1]); 2242 if (ffesta_construct_name != NULL) 2243 { 2244 ffelex_token_kill (ffesta_construct_name); 2245 ffesta_construct_name = NULL; 2246 } 2247 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t); 2248 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 2249} 2250 2251/* ffestb_do4_ -- "DO" [label] [,] "WHILE" OPEN_PAREN expr 2252 2253 (ffestb_do4_) // to expression handler 2254 2255 Make sure the statement has a valid form for the DO statement. If it 2256 does, implement the statement. */ 2257 2258static ffelexHandler 2259ffestb_do4_ (ffelexToken ft, ffebld expr, ffelexToken t) 2260{ 2261 switch (ffelex_token_type (t)) 2262 { 2263 case FFELEX_typeCLOSE_PAREN: 2264 if (expr == NULL) 2265 break; 2266 ffesta_tokens[2] = ffelex_token_use (ft); 2267 ffestb_local_.dowhile.expr = expr; 2268 return (ffelexHandler) ffestb_do5_; 2269 2270 default: 2271 break; 2272 } 2273 2274 if (ffesta_tokens[1] != NULL) 2275 ffelex_token_kill (ffesta_tokens[1]); 2276 if (ffesta_construct_name != NULL) 2277 { 2278 ffelex_token_kill (ffesta_construct_name); 2279 ffesta_construct_name = NULL; 2280 } 2281 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t); 2282 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 2283} 2284 2285/* ffestb_do5_ -- "DO" [label] [,] "WHILE" OPEN_PAREN expr CLOSE_PAREN 2286 2287 return ffestb_do5_; // to lexer 2288 2289 Make sure the statement has a valid form for the DO statement. If it 2290 does, implement the statement. */ 2291 2292static ffelexHandler 2293ffestb_do5_ (ffelexToken t) 2294{ 2295 switch (ffelex_token_type (t)) 2296 { 2297 case FFELEX_typeEOS: 2298 case FFELEX_typeSEMICOLON: 2299 ffesta_confirmed (); 2300 if (!ffesta_is_inhibited ()) 2301 { 2302 if (ffesta_tokens[1] != NULL) 2303 ffestc_R819B (ffesta_construct_name, ffesta_tokens[1], 2304 ffestb_local_.dowhile.expr, ffesta_tokens[2]); 2305 else 2306 ffestc_R820B (ffesta_construct_name, ffestb_local_.dowhile.expr, 2307 ffesta_tokens[2]); 2308 } 2309 ffelex_token_kill (ffesta_tokens[2]); 2310 if (ffesta_tokens[1] != NULL) 2311 ffelex_token_kill (ffesta_tokens[1]); 2312 if (ffesta_construct_name != NULL) 2313 { 2314 ffelex_token_kill (ffesta_construct_name); 2315 ffesta_construct_name = NULL; 2316 } 2317 return (ffelexHandler) ffesta_zero (t); 2318 2319 default: 2320 break; 2321 } 2322 2323 ffelex_token_kill (ffesta_tokens[2]); 2324 if (ffesta_tokens[1] != NULL) 2325 ffelex_token_kill (ffesta_tokens[1]); 2326 if (ffesta_construct_name != NULL) 2327 { 2328 ffelex_token_kill (ffesta_construct_name); 2329 ffesta_construct_name = NULL; 2330 } 2331 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t); 2332 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 2333} 2334 2335/* ffestb_do6_ -- "DO" [label] [,] var-expr 2336 2337 (ffestb_do6_) // to expression handler 2338 2339 Make sure the statement has a valid form for the DO statement. If it 2340 does, implement the statement. */ 2341 2342static ffelexHandler 2343ffestb_do6_ (ffelexToken ft, ffebld expr, ffelexToken t) 2344{ 2345 /* _3_ already ensured that this would be an EQUALS token. If not, it is a 2346 bug in the FFE. */ 2347 2348 assert (ffelex_token_type (t) == FFELEX_typeEQUALS); 2349 2350 ffesta_tokens[2] = ffelex_token_use (ft); 2351 ffestb_local_.do_stmt.var = expr; 2352 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 2353 FFEEXPR_contextDO, (ffeexprCallback) ffestb_do7_); 2354} 2355 2356/* ffestb_do7_ -- "DO" [label] [,] var-expr EQUALS expr 2357 2358 (ffestb_do7_) // to expression handler 2359 2360 Make sure the statement has a valid form for the DO statement. If it 2361 does, implement the statement. */ 2362 2363static ffelexHandler 2364ffestb_do7_ (ffelexToken ft, ffebld expr, ffelexToken t) 2365{ 2366 switch (ffelex_token_type (t)) 2367 { 2368 case FFELEX_typeCOMMA: 2369 ffesta_confirmed (); 2370 if (expr == NULL) 2371 break; 2372 ffesta_tokens[3] = ffelex_token_use (ft); 2373 ffestb_local_.do_stmt.start = expr; 2374 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 2375 FFEEXPR_contextDO, (ffeexprCallback) ffestb_do8_); 2376 2377 default: 2378 break; 2379 } 2380 2381 ffelex_token_kill (ffesta_tokens[2]); 2382 if (ffesta_tokens[1] != NULL) 2383 ffelex_token_kill (ffesta_tokens[1]); 2384 if (ffesta_construct_name != NULL) 2385 { 2386 ffelex_token_kill (ffesta_construct_name); 2387 ffesta_construct_name = NULL; 2388 } 2389 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t); 2390 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 2391} 2392 2393/* ffestb_do8_ -- "DO" [label] [,] var-expr EQUALS expr COMMA expr 2394 2395 (ffestb_do8_) // to expression handler 2396 2397 Make sure the statement has a valid form for the DO statement. If it 2398 does, implement the statement. */ 2399 2400static ffelexHandler 2401ffestb_do8_ (ffelexToken ft, ffebld expr, ffelexToken t) 2402{ 2403 switch (ffelex_token_type (t)) 2404 { 2405 case FFELEX_typeCOMMA: 2406 if (expr == NULL) 2407 break; 2408 ffesta_tokens[4] = ffelex_token_use (ft); 2409 ffestb_local_.do_stmt.end = expr; 2410 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 2411 FFEEXPR_contextDO, (ffeexprCallback) ffestb_do9_); 2412 2413 case FFELEX_typeEOS: 2414 case FFELEX_typeSEMICOLON: 2415 if (expr == NULL) 2416 break; 2417 ffesta_tokens[4] = ffelex_token_use (ft); 2418 ffestb_local_.do_stmt.end = expr; 2419 return (ffelexHandler) ffestb_do9_ (NULL, NULL, t); 2420 2421 default: 2422 break; 2423 } 2424 2425 ffelex_token_kill (ffesta_tokens[3]); 2426 ffelex_token_kill (ffesta_tokens[2]); 2427 if (ffesta_tokens[1] != NULL) 2428 ffelex_token_kill (ffesta_tokens[1]); 2429 if (ffesta_construct_name != NULL) 2430 { 2431 ffelex_token_kill (ffesta_construct_name); 2432 ffesta_construct_name = NULL; 2433 } 2434 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t); 2435 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 2436} 2437 2438/* ffestb_do9_ -- "DO" [label] [,] var-expr EQUALS expr COMMA expr 2439 [COMMA expr] 2440 2441 (ffestb_do9_) // to expression handler 2442 2443 Make sure the statement has a valid form for the DO statement. If it 2444 does, implement the statement. */ 2445 2446static ffelexHandler 2447ffestb_do9_ (ffelexToken ft, ffebld expr, ffelexToken t) 2448{ 2449 switch (ffelex_token_type (t)) 2450 { 2451 case FFELEX_typeEOS: 2452 case FFELEX_typeSEMICOLON: 2453 if ((expr == NULL) && (ft != NULL)) 2454 break; 2455 if (!ffesta_is_inhibited ()) 2456 { 2457 if (ffesta_tokens[1] != NULL) 2458 ffestc_R819A (ffesta_construct_name, ffesta_tokens[1], 2459 ffestb_local_.do_stmt.var, ffesta_tokens[2], 2460 ffestb_local_.do_stmt.start, ffesta_tokens[3], 2461 ffestb_local_.do_stmt.end, ffesta_tokens[4], expr, ft); 2462 else 2463 ffestc_R820A (ffesta_construct_name, ffestb_local_.do_stmt.var, 2464 ffesta_tokens[2], ffestb_local_.do_stmt.start, 2465 ffesta_tokens[3], ffestb_local_.do_stmt.end, 2466 ffesta_tokens[4], expr, ft); 2467 } 2468 ffelex_token_kill (ffesta_tokens[4]); 2469 ffelex_token_kill (ffesta_tokens[3]); 2470 ffelex_token_kill (ffesta_tokens[2]); 2471 if (ffesta_tokens[1] != NULL) 2472 ffelex_token_kill (ffesta_tokens[1]); 2473 if (ffesta_construct_name != NULL) 2474 { 2475 ffelex_token_kill (ffesta_construct_name); 2476 ffesta_construct_name = NULL; 2477 } 2478 2479 return (ffelexHandler) ffesta_zero (t); 2480 2481 default: 2482 break; 2483 } 2484 2485 ffelex_token_kill (ffesta_tokens[4]); 2486 ffelex_token_kill (ffesta_tokens[3]); 2487 ffelex_token_kill (ffesta_tokens[2]); 2488 if (ffesta_tokens[1] != NULL) 2489 ffelex_token_kill (ffesta_tokens[1]); 2490 if (ffesta_construct_name != NULL) 2491 { 2492 ffelex_token_kill (ffesta_construct_name); 2493 ffesta_construct_name = NULL; 2494 } 2495 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t); 2496 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 2497} 2498 2499/* ffestb_else -- Parse the ELSE statement 2500 2501 return ffestb_else; // to lexer 2502 2503 Make sure the statement has a valid form for the ELSE statement. If it 2504 does, implement the statement. */ 2505 2506ffelexHandler 2507ffestb_else (ffelexToken t) 2508{ 2509 ffeTokenLength i; 2510 unsigned const char *p; 2511 2512 switch (ffelex_token_type (ffesta_tokens[0])) 2513 { 2514 case FFELEX_typeNAME: 2515 if (ffesta_first_kw != FFESTR_firstELSE) 2516 goto bad_0; /* :::::::::::::::::::: */ 2517 switch (ffelex_token_type (t)) 2518 { 2519 case FFELEX_typeEOS: 2520 case FFELEX_typeSEMICOLON: 2521 ffesta_confirmed (); 2522 ffesta_tokens[1] = NULL; 2523 ffestb_args.elsexyz.second = FFESTR_secondNone; 2524 return (ffelexHandler) ffestb_else1_ (t); 2525 2526 case FFELEX_typeCOMMA: 2527 case FFELEX_typeCOLONCOLON: 2528 ffesta_confirmed (); /* Error, but clearly intended. */ 2529 goto bad_1; /* :::::::::::::::::::: */ 2530 2531 default: 2532 goto bad_1; /* :::::::::::::::::::: */ 2533 2534 case FFELEX_typeNAME: 2535 break; 2536 } 2537 2538 ffesta_confirmed (); 2539 ffestb_args.elsexyz.second = ffesta_second_kw; 2540 ffesta_tokens[1] = ffelex_token_use (t); 2541 return (ffelexHandler) ffestb_else1_; 2542 2543 case FFELEX_typeNAMES: 2544 if (ffesta_first_kw != FFESTR_firstELSE) 2545 goto bad_0; /* :::::::::::::::::::: */ 2546 switch (ffelex_token_type (t)) 2547 { 2548 case FFELEX_typeCOMMA: 2549 case FFELEX_typeCOLONCOLON: 2550 ffesta_confirmed (); /* Error, but clearly intended. */ 2551 goto bad_1; /* :::::::::::::::::::: */ 2552 2553 default: 2554 goto bad_1; /* :::::::::::::::::::: */ 2555 2556 case FFELEX_typeEOS: 2557 case FFELEX_typeSEMICOLON: 2558 break; 2559 } 2560 ffesta_confirmed (); 2561 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlELSE) 2562 { 2563 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlELSE); 2564 if (!ffesrc_is_name_init (*p)) 2565 goto bad_i; /* :::::::::::::::::::: */ 2566 ffesta_tokens[1] 2567 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); 2568 } 2569 else 2570 ffesta_tokens[1] = NULL; 2571 ffestb_args.elsexyz.second = FFESTR_secondNone; 2572 return (ffelexHandler) ffestb_else1_ (t); 2573 2574 default: 2575 goto bad_0; /* :::::::::::::::::::: */ 2576 } 2577 2578bad_0: /* :::::::::::::::::::: */ 2579 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", ffesta_tokens[0]); 2580 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 2581 2582bad_1: /* :::::::::::::::::::: */ 2583 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", t); 2584 return (ffelexHandler) ffelex_swallow_tokens (t, 2585 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 2586 2587bad_i: /* :::::::::::::::::::: */ 2588 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "ELSE", ffesta_tokens[0], i, t); 2589 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 2590} 2591 2592/* ffestb_elsexyz -- Parse an ELSEIF/ELSEWHERE statement 2593 2594 return ffestb_elsexyz; // to lexer 2595 2596 Expects len and second to be set in ffestb_args.elsexyz to the length 2597 of the ELSExyz keyword involved and the corresponding ffestrSecond value. */ 2598 2599ffelexHandler 2600ffestb_elsexyz (ffelexToken t) 2601{ 2602 ffeTokenLength i; 2603 const char *p; 2604 2605 switch (ffelex_token_type (ffesta_tokens[0])) 2606 { 2607 case FFELEX_typeNAME: 2608 switch (ffelex_token_type (t)) 2609 { 2610 case FFELEX_typeEOS: 2611 case FFELEX_typeSEMICOLON: 2612 if (ffesta_first_kw == FFESTR_firstELSEIF) 2613 goto bad_0; /* :::::::::::::::::::: */ 2614 ffesta_confirmed (); 2615 ffesta_tokens[1] = NULL; 2616 return (ffelexHandler) ffestb_else1_ (t); 2617 2618 case FFELEX_typeNAME: 2619 ffesta_confirmed (); 2620 goto bad_1; /* :::::::::::::::::::: */ 2621 2622 case FFELEX_typeOPEN_PAREN: 2623 if (ffesta_first_kw != FFESTR_firstELSEIF) 2624 goto bad_0; /* :::::::::::::::::::: */ 2625 ffesta_tokens[1] = NULL; 2626 return (ffelexHandler) ffestb_else1_ (t); 2627 2628 case FFELEX_typeCOMMA: 2629 case FFELEX_typeCOLONCOLON: 2630 ffesta_confirmed (); /* Error, but clearly intended. */ 2631 goto bad_1; /* :::::::::::::::::::: */ 2632 2633 default: 2634 goto bad_1; /* :::::::::::::::::::: */ 2635 } 2636 2637 case FFELEX_typeNAMES: 2638 switch (ffelex_token_type (t)) 2639 { 2640 case FFELEX_typeCOMMA: 2641 case FFELEX_typeCOLONCOLON: 2642 ffesta_confirmed (); /* Error, but clearly intended. */ 2643 goto bad_1; /* :::::::::::::::::::: */ 2644 2645 default: 2646 goto bad_1; /* :::::::::::::::::::: */ 2647 2648 case FFELEX_typeOPEN_PAREN: 2649 if (ffesta_first_kw != FFESTR_firstELSEIF) 2650 goto bad_1; /* :::::::::::::::::::: */ 2651 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlELSEIF) 2652 { 2653 i = FFESTR_firstlELSEIF; 2654 goto bad_i; /* :::::::::::::::::::: */ 2655 } 2656 ffesta_tokens[1] = NULL; 2657 return (ffelexHandler) ffestb_else1_ (t); 2658 2659 case FFELEX_typeEOS: 2660 case FFELEX_typeSEMICOLON: 2661 break; 2662 } 2663 ffesta_confirmed (); 2664 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlELSE); 2665 ffesta_tokens[1] 2666 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); 2667#if FFESTR_F90 2668 if ((ffestb_args.elsexyz.second == FFESTR_secondWHERE) 2669 && (ffelex_token_length (ffesta_tokens[1]) != FFESTR_secondlWHERE)) 2670 ffestb_args.elsexyz.second = FFESTR_secondNone; 2671#endif 2672 return (ffelexHandler) ffestb_else1_ (t); 2673 2674 default: 2675 goto bad_0; /* :::::::::::::::::::: */ 2676 } 2677 2678bad_0: /* :::::::::::::::::::: */ 2679 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", ffesta_tokens[0]); 2680 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 2681 2682bad_1: /* :::::::::::::::::::: */ 2683 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", t); 2684 return (ffelexHandler) ffelex_swallow_tokens (t, 2685 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 2686 2687bad_i: /* :::::::::::::::::::: */ 2688 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "ELSE IF", ffesta_tokens[0], i, t); 2689 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 2690} 2691 2692/* ffestb_else1_ -- "ELSE" (NAME) 2693 2694 return ffestb_else1_; // to lexer 2695 2696 If EOS/SEMICOLON, implement the appropriate statement (keep in mind that 2697 "ELSE WHERE" is ambiguous at the syntactic level). If OPEN_PAREN, start 2698 expression analysis with callback at _2_. */ 2699 2700static ffelexHandler 2701ffestb_else1_ (ffelexToken t) 2702{ 2703 switch (ffelex_token_type (t)) 2704 { 2705 case FFELEX_typeOPEN_PAREN: 2706 if (ffestb_args.elsexyz.second == FFESTR_secondIF) 2707 { 2708 if (ffesta_tokens[1] != NULL) 2709 ffelex_token_kill (ffesta_tokens[1]); 2710 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 2711 FFEEXPR_contextIF, (ffeexprCallback) ffestb_else2_); 2712 } 2713 /* Fall through. */ 2714 default: 2715 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", t); 2716 if (ffesta_tokens[1] != NULL) 2717 ffelex_token_kill (ffesta_tokens[1]); 2718 return (ffelexHandler) ffelex_swallow_tokens (t, 2719 (ffelexHandler) ffesta_zero); 2720 2721 case FFELEX_typeEOS: 2722 case FFELEX_typeSEMICOLON: 2723 ffesta_confirmed (); 2724 break; 2725 2726 } 2727 2728 switch (ffestb_args.elsexyz.second) 2729 { 2730#if FFESTR_F90 2731 case FFESTR_secondWHERE: 2732 if (!ffesta_is_inhibited ()) 2733 if ((ffesta_first_kw == FFESTR_firstELSEWHERE) 2734 && (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME)) 2735 ffestc_R744 (); 2736 else 2737 ffestc_elsewhere (ffesta_tokens[1]); /* R744 or R805. */ 2738 break; 2739#endif 2740 2741 default: 2742 if (!ffesta_is_inhibited ()) 2743 ffestc_R805 (ffesta_tokens[1]); 2744 break; 2745 } 2746 2747 if (ffesta_tokens[1] != NULL) 2748 ffelex_token_kill (ffesta_tokens[1]); 2749 return (ffelexHandler) ffesta_zero (t); 2750} 2751 2752/* ffestb_else2_ -- "ELSE" "IF" OPEN_PAREN expr 2753 2754 (ffestb_else2_) // to expression handler 2755 2756 Make sure the next token is CLOSE_PAREN. */ 2757 2758static ffelexHandler 2759ffestb_else2_ (ffelexToken ft, ffebld expr, ffelexToken t) 2760{ 2761 ffestb_local_.else_stmt.expr = expr; 2762 2763 switch (ffelex_token_type (t)) 2764 { 2765 case FFELEX_typeCLOSE_PAREN: 2766 if (expr == NULL) 2767 break; 2768 ffesta_tokens[1] = ffelex_token_use (ft); 2769 ffelex_set_names (TRUE); 2770 return (ffelexHandler) ffestb_else3_; 2771 2772 default: 2773 break; 2774 } 2775 2776 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t); 2777 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 2778} 2779 2780/* ffestb_else3_ -- "ELSE" "IF" OPEN_PAREN expr CLOSE_PAREN 2781 2782 return ffestb_else3_; // to lexer 2783 2784 Make sure the next token is "THEN". */ 2785 2786static ffelexHandler 2787ffestb_else3_ (ffelexToken t) 2788{ 2789 ffeTokenLength i; 2790 unsigned const char *p; 2791 2792 ffelex_set_names (FALSE); 2793 2794 switch (ffelex_token_type (t)) 2795 { 2796 case FFELEX_typeNAME: 2797 ffesta_confirmed (); 2798 if (ffestr_first (t) == FFESTR_firstTHEN) 2799 return (ffelexHandler) ffestb_else4_; 2800 break; 2801 2802 case FFELEX_typeNAMES: 2803 ffesta_confirmed (); 2804 if (ffestr_first (t) != FFESTR_firstTHEN) 2805 break; 2806 if (ffelex_token_length (t) == FFESTR_firstlTHEN) 2807 return (ffelexHandler) ffestb_else4_; 2808 p = ffelex_token_text (t) + (i = FFESTR_firstlTHEN); 2809 if (!ffesrc_is_name_init (*p)) 2810 goto bad_i; /* :::::::::::::::::::: */ 2811 ffesta_tokens[2] = ffelex_token_name_from_names (t, i, 0); 2812 return (ffelexHandler) ffestb_else5_; 2813 2814 default: 2815 break; 2816 } 2817 2818 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t); 2819 ffelex_token_kill (ffesta_tokens[1]); 2820 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 2821 2822bad_i: /* :::::::::::::::::::: */ 2823 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t, i, NULL); 2824 ffelex_token_kill (ffesta_tokens[1]); 2825 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 2826} 2827 2828/* ffestb_else4_ -- "ELSE" "IF" OPEN_PAREN expr CLOSE_PAREN "THEN" 2829 2830 return ffestb_else4_; // to lexer 2831 2832 Handle a NAME or EOS/SEMICOLON, then go to state _5_. */ 2833 2834static ffelexHandler 2835ffestb_else4_ (ffelexToken t) 2836{ 2837 ffelex_set_names (FALSE); 2838 2839 switch (ffelex_token_type (t)) 2840 { 2841 case FFELEX_typeEOS: 2842 case FFELEX_typeSEMICOLON: 2843 ffesta_tokens[2] = NULL; 2844 return (ffelexHandler) ffestb_else5_ (t); 2845 2846 case FFELEX_typeNAME: 2847 ffesta_tokens[2] = ffelex_token_use (t); 2848 return (ffelexHandler) ffestb_else5_; 2849 2850 default: 2851 break; 2852 } 2853 2854 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t); 2855 ffelex_token_kill (ffesta_tokens[1]); 2856 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 2857} 2858 2859/* ffestb_else5_ -- "ELSE" "IF" OPEN_PAREN expr CLOSE_PAREN "THEN" 2860 2861 return ffestb_else5_; // to lexer 2862 2863 Make sure the next token is EOS or SEMICOLON; implement R804. */ 2864 2865static ffelexHandler 2866ffestb_else5_ (ffelexToken t) 2867{ 2868 switch (ffelex_token_type (t)) 2869 { 2870 case FFELEX_typeEOS: 2871 case FFELEX_typeSEMICOLON: 2872 if (!ffesta_is_inhibited ()) 2873 ffestc_R804 (ffestb_local_.else_stmt.expr, ffesta_tokens[1], 2874 ffesta_tokens[2]); 2875 ffelex_token_kill (ffesta_tokens[1]); 2876 if (ffesta_tokens[2] != NULL) 2877 ffelex_token_kill (ffesta_tokens[2]); 2878 return (ffelexHandler) ffesta_zero (t); 2879 2880 default: 2881 break; 2882 } 2883 2884 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t); 2885 ffelex_token_kill (ffesta_tokens[1]); 2886 if (ffesta_tokens[2] != NULL) 2887 ffelex_token_kill (ffesta_tokens[2]); 2888 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 2889} 2890 2891/* ffestb_end -- Parse the END statement 2892 2893 return ffestb_end; // to lexer 2894 2895 Make sure the statement has a valid form for the END statement. If it 2896 does, implement the statement. */ 2897 2898ffelexHandler 2899ffestb_end (ffelexToken t) 2900{ 2901 ffeTokenLength i; 2902 2903 switch (ffelex_token_type (ffesta_tokens[0])) 2904 { 2905 case FFELEX_typeNAME: 2906 if (ffesta_first_kw != FFESTR_firstEND) 2907 goto bad_0; /* :::::::::::::::::::: */ 2908 switch (ffelex_token_type (t)) 2909 { 2910 case FFELEX_typeEOS: 2911 case FFELEX_typeSEMICOLON: 2912 ffesta_tokens[1] = NULL; 2913 ffestb_args.endxyz.second = FFESTR_secondNone; 2914 return (ffelexHandler) ffestb_end3_ (t); 2915 2916 case FFELEX_typeCOMMA: 2917 case FFELEX_typeCOLONCOLON: 2918 ffesta_confirmed (); /* Error, but clearly intended. */ 2919 goto bad_1; /* :::::::::::::::::::: */ 2920 2921 default: 2922 goto bad_1; /* :::::::::::::::::::: */ 2923 2924 case FFELEX_typeNAME: 2925 break; 2926 } 2927 2928 ffesta_confirmed (); 2929 ffestb_args.endxyz.second = ffesta_second_kw; 2930 switch (ffesta_second_kw) 2931 { 2932 case FFESTR_secondFILE: 2933 ffestb_args.beru.badname = "ENDFILE"; 2934 return (ffelexHandler) ffestb_beru; 2935 2936 case FFESTR_secondBLOCK: 2937 return (ffelexHandler) ffestb_end1_; 2938 2939#if FFESTR_F90 2940 case FFESTR_secondINTERFACE: 2941#endif 2942#if FFESTR_VXT 2943 case FFESTR_secondMAP: 2944 case FFESTR_secondSTRUCTURE: 2945 case FFESTR_secondUNION: 2946#endif 2947#if FFESTR_F90 2948 case FFESTR_secondWHERE: 2949 ffesta_tokens[1] = NULL; 2950 return (ffelexHandler) ffestb_end3_; 2951#endif 2952 2953 case FFESTR_secondNone: 2954 goto bad_1; /* :::::::::::::::::::: */ 2955 2956 default: 2957 return (ffelexHandler) ffestb_end2_; 2958 } 2959 2960 case FFELEX_typeNAMES: 2961 if (ffesta_first_kw != FFESTR_firstEND) 2962 goto bad_0; /* :::::::::::::::::::: */ 2963 switch (ffelex_token_type (t)) 2964 { 2965 case FFELEX_typeCOMMA: 2966 case FFELEX_typeCOLONCOLON: 2967 ffesta_confirmed (); /* Error, but clearly intended. */ 2968 goto bad_1; /* :::::::::::::::::::: */ 2969 2970 default: 2971 goto bad_1; /* :::::::::::::::::::: */ 2972 2973 case FFELEX_typeEOS: 2974 case FFELEX_typeSEMICOLON: 2975 break; 2976 } 2977 ffesta_confirmed (); 2978 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlEND) 2979 { 2980 i = FFESTR_firstlEND; 2981 goto bad_i; /* :::::::::::::::::::: */ 2982 } 2983 ffesta_tokens[1] = NULL; 2984 ffestb_args.endxyz.second = FFESTR_secondNone; 2985 return (ffelexHandler) ffestb_end3_ (t); 2986 2987 default: 2988 goto bad_0; /* :::::::::::::::::::: */ 2989 } 2990 2991bad_0: /* :::::::::::::::::::: */ 2992 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0]); 2993 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 2994 2995bad_1: /* :::::::::::::::::::: */ 2996 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t); 2997 return (ffelexHandler) ffelex_swallow_tokens (t, 2998 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 2999 3000bad_i: /* :::::::::::::::::::: */ 3001 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0], i, t); 3002 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 3003} 3004 3005/* ffestb_endxyz -- Parse an ENDxyz statement 3006 3007 return ffestb_endxyz; // to lexer 3008 3009 Expects len and second to be set in ffestb_args.endxyz to the length 3010 of the ENDxyz keyword involved and the corresponding ffestrSecond value. */ 3011 3012ffelexHandler 3013ffestb_endxyz (ffelexToken t) 3014{ 3015 ffeTokenLength i; 3016 unsigned const char *p; 3017 3018 switch (ffelex_token_type (ffesta_tokens[0])) 3019 { 3020 case FFELEX_typeNAME: 3021 switch (ffelex_token_type (t)) 3022 { 3023 case FFELEX_typeEOS: 3024 case FFELEX_typeSEMICOLON: 3025 ffesta_confirmed (); 3026 ffesta_tokens[1] = NULL; 3027 return (ffelexHandler) ffestb_end3_ (t); 3028 3029 case FFELEX_typeNAME: 3030 ffesta_confirmed (); 3031 switch (ffestb_args.endxyz.second) 3032 { 3033#if FFESTR_F90 3034 case FFESTR_secondINTERFACE: 3035#endif 3036#if FFESTR_VXT 3037 case FFESTR_secondMAP: 3038 case FFESTR_secondSTRUCTURE: 3039 case FFESTR_secondUNION: 3040#endif 3041#if FFESTR_F90 3042 case FFESTR_secondWHERE: 3043 goto bad_1; /* :::::::::::::::::::: */ 3044#endif 3045 3046 case FFESTR_secondBLOCK: 3047 if (ffesta_second_kw != FFESTR_secondDATA) 3048 goto bad_1; /* :::::::::::::::::::: */ 3049 return (ffelexHandler) ffestb_end2_; 3050 3051 default: 3052 return (ffelexHandler) ffestb_end2_ (t); 3053 } 3054 3055 case FFELEX_typeCOMMA: 3056 case FFELEX_typeCOLONCOLON: 3057 ffesta_confirmed (); /* Error, but clearly intended. */ 3058 goto bad_1; /* :::::::::::::::::::: */ 3059 3060 default: 3061 goto bad_1; /* :::::::::::::::::::: */ 3062 } 3063 3064 case FFELEX_typeNAMES: 3065 switch (ffelex_token_type (t)) 3066 { 3067 case FFELEX_typeCOMMA: 3068 case FFELEX_typeCOLONCOLON: 3069 ffesta_confirmed (); /* Error, but clearly intended. */ 3070 goto bad_1; /* :::::::::::::::::::: */ 3071 3072 default: 3073 goto bad_1; /* :::::::::::::::::::: */ 3074 3075 case FFELEX_typeEOS: 3076 case FFELEX_typeSEMICOLON: 3077 break; 3078 } 3079 ffesta_confirmed (); 3080 if (ffestb_args.endxyz.second == FFESTR_secondBLOCK) 3081 { 3082 i = FFESTR_firstlEND; 3083 goto bad_i; /* :::::::::::::::::::: */ 3084 } 3085 if (ffelex_token_length (ffesta_tokens[0]) != ffestb_args.endxyz.len) 3086 { 3087 p = ffelex_token_text (ffesta_tokens[0]) 3088 + (i = ffestb_args.endxyz.len); 3089 switch (ffestb_args.endxyz.second) 3090 { 3091#if FFESTR_F90 3092 case FFESTR_secondINTERFACE: 3093#endif 3094#if FFESTR_VXT 3095 case FFESTR_secondMAP: 3096 case FFESTR_secondSTRUCTURE: 3097 case FFESTR_secondUNION: 3098#endif 3099#if FFESTR_F90 3100 case FFESTR_secondWHERE: 3101 goto bad_i; /* :::::::::::::::::::: */ 3102#endif 3103 3104 default: 3105 break; 3106 } 3107 if (!ffesrc_is_name_init (*p)) 3108 goto bad_i; /* :::::::::::::::::::: */ 3109 ffesta_tokens[1] 3110 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); 3111 return (ffelexHandler) ffestb_end3_ (t); 3112 } 3113 ffesta_tokens[1] = NULL; 3114 return (ffelexHandler) ffestb_end3_ (t); 3115 3116 default: 3117 goto bad_0; /* :::::::::::::::::::: */ 3118 } 3119 3120bad_0: /* :::::::::::::::::::: */ 3121 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0]); 3122 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 3123 3124bad_1: /* :::::::::::::::::::: */ 3125 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t); 3126 return (ffelexHandler) ffelex_swallow_tokens (t, 3127 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 3128 3129bad_i: /* :::::::::::::::::::: */ 3130 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0], i, t); 3131 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 3132} 3133 3134/* ffestb_end1_ -- "END" "BLOCK" 3135 3136 return ffestb_end1_; // to lexer 3137 3138 Make sure the next token is "DATA". */ 3139 3140static ffelexHandler 3141ffestb_end1_ (ffelexToken t) 3142{ 3143 if ((ffelex_token_type (t) == FFELEX_typeNAME) 3144 && (ffesrc_strcmp_2c (ffe_case_match (), ffelex_token_text (t), "DATA", 3145 "data", "Data") 3146 == 0)) 3147 { 3148 return (ffelexHandler) ffestb_end2_; 3149 } 3150 3151 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t); 3152 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 3153} 3154 3155/* ffestb_end2_ -- "END" <unit-kind> 3156 3157 return ffestb_end2_; // to lexer 3158 3159 Make sure the next token is a NAME or EOS. */ 3160 3161static ffelexHandler 3162ffestb_end2_ (ffelexToken t) 3163{ 3164 switch (ffelex_token_type (t)) 3165 { 3166 case FFELEX_typeNAME: 3167 ffesta_tokens[1] = ffelex_token_use (t); 3168 return (ffelexHandler) ffestb_end3_; 3169 3170 case FFELEX_typeEOS: 3171 case FFELEX_typeSEMICOLON: 3172 ffesta_tokens[1] = NULL; 3173 return (ffelexHandler) ffestb_end3_ (t); 3174 3175 default: 3176 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t); 3177 return (ffelexHandler) ffelex_swallow_tokens (t, 3178 (ffelexHandler) ffesta_zero); 3179 } 3180} 3181 3182/* ffestb_end3_ -- "END" <unit-kind> (NAME) 3183 3184 return ffestb_end3_; // to lexer 3185 3186 Make sure the next token is an EOS, then implement the statement. */ 3187 3188static ffelexHandler 3189ffestb_end3_ (ffelexToken t) 3190{ 3191 switch (ffelex_token_type (t)) 3192 { 3193 default: 3194 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t); 3195 if (ffesta_tokens[1] != NULL) 3196 ffelex_token_kill (ffesta_tokens[1]); 3197 return (ffelexHandler) ffelex_swallow_tokens (t, 3198 (ffelexHandler) ffesta_zero); 3199 3200 case FFELEX_typeEOS: 3201 case FFELEX_typeSEMICOLON: 3202 ffesta_confirmed (); 3203 if (ffestb_args.endxyz.second == FFESTR_secondNone) 3204 { 3205 if (!ffesta_is_inhibited ()) 3206 ffestc_end (); 3207 return (ffelexHandler) ffesta_zero (t); 3208 } 3209 break; 3210 } 3211 3212 switch (ffestb_args.endxyz.second) 3213 { 3214#if FFESTR_F90 3215 case FFESTR_secondTYPE: 3216 if (!ffesta_is_inhibited ()) 3217 ffestc_R425 (ffesta_tokens[1]); 3218 break; 3219#endif 3220 3221#if FFESTR_F90 3222 case FFESTR_secondWHERE: 3223 if (!ffesta_is_inhibited ()) 3224 ffestc_R745 (); 3225 break; 3226#endif 3227 3228 case FFESTR_secondIF: 3229 if (!ffesta_is_inhibited ()) 3230 ffestc_R806 (ffesta_tokens[1]); 3231 break; 3232 3233 case FFESTR_secondSELECT: 3234 if (!ffesta_is_inhibited ()) 3235 ffestc_R811 (ffesta_tokens[1]); 3236 break; 3237 3238 case FFESTR_secondDO: 3239 if (!ffesta_is_inhibited ()) 3240 ffestc_R825 (ffesta_tokens[1]); 3241 break; 3242 3243 case FFESTR_secondPROGRAM: 3244 if (!ffesta_is_inhibited ()) 3245 ffestc_R1103 (ffesta_tokens[1]); 3246 break; 3247 3248#if FFESTR_F90 3249 case FFESTR_secondMODULE: 3250 if (!ffesta_is_inhibited ()) 3251 ffestc_R1106 (ffesta_tokens[1]); 3252 break; 3253#endif 3254 case FFESTR_secondBLOCK: 3255 case FFESTR_secondBLOCKDATA: 3256 if (!ffesta_is_inhibited ()) 3257 ffestc_R1112 (ffesta_tokens[1]); 3258 break; 3259 3260#if FFESTR_F90 3261 case FFESTR_secondINTERFACE: 3262 if (!ffesta_is_inhibited ()) 3263 ffestc_R1203 (); 3264 break; 3265#endif 3266 3267 case FFESTR_secondFUNCTION: 3268 if (!ffesta_is_inhibited ()) 3269 ffestc_R1221 (ffesta_tokens[1]); 3270 break; 3271 3272 case FFESTR_secondSUBROUTINE: 3273 if (!ffesta_is_inhibited ()) 3274 ffestc_R1225 (ffesta_tokens[1]); 3275 break; 3276 3277#if FFESTR_VXT 3278 case FFESTR_secondSTRUCTURE: 3279 if (!ffesta_is_inhibited ()) 3280 ffestc_V004 (); 3281 break; 3282#endif 3283 3284#if FFESTR_VXT 3285 case FFESTR_secondUNION: 3286 if (!ffesta_is_inhibited ()) 3287 ffestc_V010 (); 3288 break; 3289#endif 3290 3291#if FFESTR_VXT 3292 case FFESTR_secondMAP: 3293 if (!ffesta_is_inhibited ()) 3294 ffestc_V013 (); 3295 break; 3296#endif 3297 3298 default: 3299 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0]); 3300 if (ffesta_tokens[1] != NULL) 3301 ffelex_token_kill (ffesta_tokens[1]); 3302 return (ffelexHandler) ffelex_swallow_tokens (t, 3303 (ffelexHandler) ffesta_zero); 3304 } 3305 3306 if (ffesta_tokens[1] != NULL) 3307 ffelex_token_kill (ffesta_tokens[1]); 3308 return (ffelexHandler) ffesta_zero (t); 3309} 3310 3311/* ffestb_goto -- Parse the GOTO statement 3312 3313 return ffestb_goto; // to lexer 3314 3315 Make sure the statement has a valid form for the GOTO statement. If it 3316 does, implement the statement. */ 3317 3318ffelexHandler 3319ffestb_goto (ffelexToken t) 3320{ 3321 ffeTokenLength i; 3322 unsigned const char *p; 3323 ffelexHandler next; 3324 ffelexToken nt; 3325 3326 switch (ffelex_token_type (ffesta_tokens[0])) 3327 { 3328 case FFELEX_typeNAME: 3329 switch (ffesta_first_kw) 3330 { 3331 case FFESTR_firstGO: 3332 if ((ffelex_token_type (t) != FFELEX_typeNAME) 3333 || (ffesta_second_kw != FFESTR_secondTO)) 3334 goto bad_1; /* :::::::::::::::::::: */ 3335 ffesta_confirmed (); 3336 return (ffelexHandler) ffestb_goto1_; 3337 3338 case FFESTR_firstGOTO: 3339 return (ffelexHandler) ffestb_goto1_ (t); 3340 3341 default: 3342 goto bad_0; /* :::::::::::::::::::: */ 3343 } 3344 3345 case FFELEX_typeNAMES: 3346 if (ffesta_first_kw != FFESTR_firstGOTO) 3347 goto bad_0; /* :::::::::::::::::::: */ 3348 switch (ffelex_token_type (t)) 3349 { 3350 case FFELEX_typeCOLONCOLON: 3351 ffesta_confirmed (); /* Error, but clearly intended. */ 3352 goto bad_1; /* :::::::::::::::::::: */ 3353 3354 default: 3355 goto bad_1; /* :::::::::::::::::::: */ 3356 3357 case FFELEX_typeOPEN_PAREN: 3358 case FFELEX_typePERCENT: /* Since GOTO I%J is apparently valid 3359 in '90. */ 3360 case FFELEX_typeCOMMA: 3361 break; 3362 3363 case FFELEX_typeEOS: 3364 case FFELEX_typeSEMICOLON: 3365 ffesta_confirmed (); 3366 break; 3367 } 3368 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlGOTO) 3369 { 3370 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlGOTO); 3371 if (ISDIGIT (*p)) 3372 { 3373 nt = ffelex_token_number_from_names (ffesta_tokens[0], i); 3374 p += ffelex_token_length (nt); 3375 i += ffelex_token_length (nt); 3376 if (*p != '\0') 3377 { 3378 ffelex_token_kill (nt); 3379 goto bad_i; /* :::::::::::::::::::: */ 3380 } 3381 } 3382 else if (ffesrc_is_name_init (*p)) 3383 { 3384 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); 3385 } 3386 else 3387 goto bad_i; /* :::::::::::::::::::: */ 3388 next = (ffelexHandler) ffestb_goto1_ (nt); 3389 ffelex_token_kill (nt); 3390 return (ffelexHandler) (*next) (t); 3391 } 3392 return (ffelexHandler) ffestb_goto1_ (t); 3393 3394 default: 3395 goto bad_0; /* :::::::::::::::::::: */ 3396 } 3397 3398bad_0: /* :::::::::::::::::::: */ 3399 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "GO TO", ffesta_tokens[0]); 3400 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 3401 3402bad_1: /* :::::::::::::::::::: */ 3403 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "GO TO", t); 3404 return (ffelexHandler) ffelex_swallow_tokens (t, 3405 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 3406 3407bad_i: /* :::::::::::::::::::: */ 3408 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "GO TO", ffesta_tokens[0], i, t); 3409 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 3410} 3411 3412/* ffestb_goto1_ -- "GOTO" or "GO" "TO" 3413 3414 return ffestb_goto1_; // to lexer 3415 3416 Make sure the statement has a valid form for the GOTO statement. If it 3417 does, implement the statement. */ 3418 3419static ffelexHandler 3420ffestb_goto1_ (ffelexToken t) 3421{ 3422 switch (ffelex_token_type (t)) 3423 { 3424 case FFELEX_typeNUMBER: 3425 if (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME) 3426 ffesta_confirmed (); 3427 ffesta_tokens[1] = ffelex_token_use (t); 3428 return (ffelexHandler) ffestb_goto2_; 3429 3430 case FFELEX_typeOPEN_PAREN: 3431 ffesta_tokens[1] = ffelex_token_use (t); 3432 ffestb_subrargs_.label_list.labels = ffestt_tokenlist_create (); 3433 ffestb_subrargs_.label_list.handler = (ffelexHandler) ffestb_goto3_; 3434 return (ffelexHandler) ffestb_subr_label_list_; 3435 3436 case FFELEX_typeNAME: 3437 if (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME) 3438 ffesta_confirmed (); 3439 return (ffelexHandler) (*((ffelexHandler) 3440 ffeexpr_lhs (ffesta_output_pool, 3441 FFEEXPR_contextAGOTO, 3442 (ffeexprCallback) ffestb_goto4_))) 3443 (t); 3444 3445 case FFELEX_typeEOS: 3446 case FFELEX_typeSEMICOLON: 3447 case FFELEX_typeCOMMA: 3448 case FFELEX_typeCOLONCOLON: 3449 ffesta_confirmed (); /* Error, but clearly intended. */ 3450 break; 3451 3452 default: 3453 break; 3454 } 3455 3456 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "GO TO", t); 3457 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 3458} 3459 3460/* ffestb_goto2_ -- "GO/TO" NUMBER 3461 3462 return ffestb_goto2_; // to lexer 3463 3464 Make sure the statement has a valid form for the GOTO statement. If it 3465 does, implement the statement. */ 3466 3467static ffelexHandler 3468ffestb_goto2_ (ffelexToken t) 3469{ 3470 switch (ffelex_token_type (t)) 3471 { 3472 case FFELEX_typeEOS: 3473 case FFELEX_typeSEMICOLON: 3474 ffesta_confirmed (); 3475 if (!ffesta_is_inhibited ()) 3476 ffestc_R836 (ffesta_tokens[1]); 3477 ffelex_token_kill (ffesta_tokens[1]); 3478 return (ffelexHandler) ffesta_zero (t); 3479 3480 default: 3481 break; 3482 } 3483 3484 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "GO TO", t); 3485 ffelex_token_kill (ffesta_tokens[1]); 3486 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 3487} 3488 3489/* ffestb_goto3_ -- "GO/TO" OPEN_PAREN label-list CLOSE_PAREN 3490 3491 return ffestb_goto3_; // to lexer 3492 3493 Make sure the statement has a valid form for the GOTO statement. If it 3494 does, implement the statement. */ 3495 3496static ffelexHandler 3497ffestb_goto3_ (ffelexToken t) 3498{ 3499 if (!ffestb_subrargs_.label_list.ok) 3500 goto bad; /* :::::::::::::::::::: */ 3501 3502 switch (ffelex_token_type (t)) 3503 { 3504 case FFELEX_typeCOMMA: 3505 ffesta_confirmed (); 3506 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextCGOTO, 3507 (ffeexprCallback) ffestb_goto5_); 3508 3509 case FFELEX_typeEQUALS: 3510 case FFELEX_typePOINTS: 3511 case FFELEX_typeEOS: 3512 case FFELEX_typeSEMICOLON: 3513 break; 3514 3515 default: 3516 ffesta_confirmed (); 3517 /* Fall through. */ 3518 case FFELEX_typeOPEN_PAREN: /* Could still be assignment!! */ 3519 return (ffelexHandler) (*((ffelexHandler) 3520 ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextCGOTO, 3521 (ffeexprCallback) ffestb_goto5_))) 3522 (t); 3523 } 3524 3525bad: /* :::::::::::::::::::: */ 3526 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "computed-GOTO", t); 3527 ffelex_token_kill (ffesta_tokens[1]); 3528 ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels); 3529 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 3530} 3531 3532/* ffestb_goto4_ -- "GO/TO" expr 3533 3534 (ffestb_goto4_) // to expression handler 3535 3536 Make sure the statement has a valid form for the GOTO statement. If it 3537 does, implement the statement. */ 3538 3539static ffelexHandler 3540ffestb_goto4_ (ffelexToken ft, ffebld expr, ffelexToken t) 3541{ 3542 switch (ffelex_token_type (t)) 3543 { 3544 case FFELEX_typeCOMMA: 3545 ffesta_confirmed (); 3546 if (expr == NULL) 3547 break; 3548 ffesta_tokens[1] = ffelex_token_use (ft); 3549 ffestb_local_.go_to.expr = expr; 3550 return (ffelexHandler) ffestb_goto6_; 3551 3552 case FFELEX_typeOPEN_PAREN: 3553 if (expr == NULL) 3554 break; 3555 ffesta_tokens[1] = ffelex_token_use (ft); 3556 ffestb_local_.go_to.expr = expr; 3557 return (ffelexHandler) ffestb_goto6_ (t); 3558 3559 case FFELEX_typeEOS: 3560 case FFELEX_typeSEMICOLON: 3561 ffesta_confirmed (); 3562 if (expr == NULL) 3563 break; 3564 if (!ffesta_is_inhibited ()) 3565 ffestc_R839 (expr, ft, NULL); 3566 return (ffelexHandler) ffesta_zero (t); 3567 3568 default: 3569 break; 3570 } 3571 3572 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assigned-GOTO", t); 3573 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 3574} 3575 3576/* ffestb_goto5_ -- "GO/TO" OPEN_PAREN label-list CLOSE_PAREN (COMMA) expr 3577 3578 (ffestb_goto5_) // to expression handler 3579 3580 Make sure the statement has a valid form for the GOTO statement. If it 3581 does, implement the statement. */ 3582 3583static ffelexHandler 3584ffestb_goto5_ (ffelexToken ft, ffebld expr, ffelexToken t) 3585{ 3586 switch (ffelex_token_type (t)) 3587 { 3588 case FFELEX_typeEOS: 3589 case FFELEX_typeSEMICOLON: 3590 if (expr == NULL) 3591 break; 3592 ffesta_confirmed (); 3593 if (!ffesta_is_inhibited ()) 3594 ffestc_R837 (ffestb_subrargs_.label_list.labels, expr, ft); 3595 ffelex_token_kill (ffesta_tokens[1]); 3596 ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels); 3597 return (ffelexHandler) ffesta_zero (t); 3598 3599 default: 3600 break; 3601 } 3602 3603 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "computed-GOTO", t); 3604 ffelex_token_kill (ffesta_tokens[1]); 3605 ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels); 3606 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 3607} 3608 3609/* ffestb_goto6_ -- "GO/TO" expr (COMMA) 3610 3611 return ffestb_goto6_; // to lexer 3612 3613 Make sure the statement has a valid form for the GOTO statement. If it 3614 does, implement the statement. */ 3615 3616static ffelexHandler 3617ffestb_goto6_ (ffelexToken t) 3618{ 3619 switch (ffelex_token_type (t)) 3620 { 3621 case FFELEX_typeOPEN_PAREN: 3622 ffesta_tokens[2] = ffelex_token_use (t); 3623 ffestb_subrargs_.label_list.labels = ffestt_tokenlist_create (); 3624 ffestb_subrargs_.label_list.handler = (ffelexHandler) ffestb_goto7_; 3625 return (ffelexHandler) ffestb_subr_label_list_; 3626 3627 default: 3628 break; 3629 } 3630 3631 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assigned-GOTO", t); 3632 ffelex_token_kill (ffesta_tokens[1]); 3633 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 3634} 3635 3636/* ffestb_goto7_ -- "GO/TO" expr (COMMA) OPEN_PAREN label-list CLOSE_PAREN 3637 3638 return ffestb_goto7_; // to lexer 3639 3640 Make sure the statement has a valid form for the GOTO statement. If it 3641 does, implement the statement. */ 3642 3643static ffelexHandler 3644ffestb_goto7_ (ffelexToken t) 3645{ 3646 if (!ffestb_subrargs_.label_list.ok) 3647 goto bad; /* :::::::::::::::::::: */ 3648 3649 switch (ffelex_token_type (t)) 3650 { 3651 case FFELEX_typeEOS: 3652 case FFELEX_typeSEMICOLON: 3653 ffesta_confirmed (); 3654 if (!ffesta_is_inhibited ()) 3655 ffestc_R839 (ffestb_local_.go_to.expr, ffesta_tokens[1], 3656 ffestb_subrargs_.label_list.labels); 3657 ffelex_token_kill (ffesta_tokens[1]); 3658 ffelex_token_kill (ffesta_tokens[2]); 3659 ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels); 3660 return (ffelexHandler) ffesta_zero (t); 3661 3662 default: 3663 break; 3664 } 3665 3666bad: /* :::::::::::::::::::: */ 3667 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assigned-GOTO", t); 3668 ffelex_token_kill (ffesta_tokens[1]); 3669 ffelex_token_kill (ffesta_tokens[2]); 3670 ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels); 3671 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 3672} 3673 3674/* ffestb_halt -- Parse the STOP/PAUSE statement 3675 3676 return ffestb_halt; // to lexer 3677 3678 Make sure the statement has a valid form for the STOP/PAUSE statement. If 3679 it does, implement the statement. */ 3680 3681ffelexHandler 3682ffestb_halt (ffelexToken t) 3683{ 3684 ffelexHandler next; 3685 3686 switch (ffelex_token_type (ffesta_tokens[0])) 3687 { 3688 case FFELEX_typeNAME: 3689 switch (ffelex_token_type (t)) 3690 { 3691 case FFELEX_typeCOMMA: 3692 case FFELEX_typeCOLONCOLON: 3693 ffesta_confirmed (); /* Error, but clearly intended. */ 3694 goto bad_1; /* :::::::::::::::::::: */ 3695 3696 default: 3697 goto bad_1; /* :::::::::::::::::::: */ 3698 3699 case FFELEX_typeEOS: 3700 case FFELEX_typeSEMICOLON: 3701 case FFELEX_typeNAME: 3702 case FFELEX_typeNUMBER: 3703 case FFELEX_typeAPOSTROPHE: 3704 case FFELEX_typeQUOTE: 3705 ffesta_confirmed (); 3706 break; 3707 } 3708 3709 return (ffelexHandler) (*((ffelexHandler) 3710 ffeexpr_rhs (ffesta_output_pool, 3711 FFEEXPR_contextSTOP, 3712 (ffeexprCallback) ffestb_halt1_))) 3713 (t); 3714 3715 case FFELEX_typeNAMES: 3716 switch (ffelex_token_type (t)) 3717 { 3718 default: 3719 goto bad_1; /* :::::::::::::::::::: */ 3720 3721 case FFELEX_typeEOS: 3722 case FFELEX_typeSEMICOLON: 3723 case FFELEX_typeNAME: 3724 case FFELEX_typeNUMBER: 3725 case FFELEX_typeAPOSTROPHE: 3726 case FFELEX_typeQUOTE: 3727 ffesta_confirmed (); 3728 break; 3729 } 3730 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 3731 FFEEXPR_contextSTOP, 3732 (ffeexprCallback) ffestb_halt1_); 3733 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0], 3734 ffestb_args.halt.len); 3735 if (next == NULL) 3736 return (ffelexHandler) ffelex_swallow_tokens (t, 3737 (ffelexHandler) ffesta_zero); 3738 return (ffelexHandler) (*next) (t); 3739 3740 default: 3741 goto bad_0; /* :::::::::::::::::::: */ 3742 } 3743 3744bad_0: /* :::::::::::::::::::: */ 3745 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, 3746 (ffesta_first_kw == FFESTR_firstSTOP) 3747 ? "STOP" : "PAUSE", 3748 ffesta_tokens[0]); 3749 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 3750 3751bad_1: /* :::::::::::::::::::: */ 3752 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, 3753 (ffesta_first_kw == FFESTR_firstSTOP) 3754 ? "STOP" : "PAUSE", 3755 t); 3756 return (ffelexHandler) ffelex_swallow_tokens (t, 3757 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 3758} 3759 3760/* ffestb_halt1_ -- "STOP/PAUSE" expr 3761 3762 (ffestb_halt1_) // to expression handler 3763 3764 Make sure the next token is an EOS or SEMICOLON. */ 3765 3766static ffelexHandler 3767ffestb_halt1_ (ffelexToken ft, ffebld expr, ffelexToken t) 3768{ 3769 switch (ffelex_token_type (t)) 3770 { 3771 case FFELEX_typeEOS: 3772 case FFELEX_typeSEMICOLON: 3773 ffesta_confirmed (); 3774 if (!ffesta_is_inhibited ()) 3775 { 3776 if (ffesta_first_kw == FFESTR_firstSTOP) 3777 ffestc_R842 (expr, ft); 3778 else 3779 ffestc_R843 (expr, ft); 3780 } 3781 return (ffelexHandler) ffesta_zero (t); 3782 3783 default: 3784 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, 3785 (ffesta_first_kw == FFESTR_firstSTOP) 3786 ? "STOP" : "PAUSE", 3787 t); 3788 break; 3789 } 3790 3791 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 3792} 3793 3794/* ffestb_if -- Parse an IF statement 3795 3796 return ffestb_if; // to lexer 3797 3798 Make sure the statement has a valid form for an IF statement. 3799 If it does, implement the statement. */ 3800 3801ffelexHandler 3802ffestb_if (ffelexToken t) 3803{ 3804 switch (ffelex_token_type (ffesta_tokens[0])) 3805 { 3806 case FFELEX_typeNAME: 3807 if (ffesta_first_kw != FFESTR_firstIF) 3808 goto bad_0; /* :::::::::::::::::::: */ 3809 break; 3810 3811 case FFELEX_typeNAMES: 3812 if (ffesta_first_kw != FFESTR_firstIF) 3813 goto bad_0; /* :::::::::::::::::::: */ 3814 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlIF) 3815 goto bad_0; /* :::::::::::::::::::: */ 3816 break; 3817 3818 default: 3819 goto bad_0; /* :::::::::::::::::::: */ 3820 } 3821 3822 switch (ffelex_token_type (t)) 3823 { 3824 case FFELEX_typeOPEN_PAREN: 3825 break; 3826 3827 case FFELEX_typeEOS: 3828 case FFELEX_typeSEMICOLON: 3829 case FFELEX_typeCOMMA: 3830 case FFELEX_typeCOLONCOLON: 3831 ffesta_confirmed (); /* Error, but clearly intended. */ 3832 goto bad_1; /* :::::::::::::::::::: */ 3833 3834 default: 3835 goto bad_1; /* :::::::::::::::::::: */ 3836 } 3837 3838 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextIF, 3839 (ffeexprCallback) ffestb_if1_); 3840 3841bad_0: /* :::::::::::::::::::: */ 3842 if (ffesta_construct_name != NULL) 3843 { 3844 ffelex_token_kill (ffesta_construct_name); 3845 ffesta_construct_name = NULL; 3846 } 3847 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IF", ffesta_tokens[0]); 3848 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 3849 3850bad_1: /* :::::::::::::::::::: */ 3851 if (ffesta_construct_name != NULL) 3852 { 3853 ffelex_token_kill (ffesta_construct_name); 3854 ffesta_construct_name = NULL; 3855 } 3856 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IF", t); 3857 return (ffelexHandler) ffelex_swallow_tokens (t, 3858 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 3859} 3860 3861/* ffestb_if1_ -- "IF" OPEN_PAREN expr 3862 3863 (ffestb_if1_) // to expression handler 3864 3865 Make sure the next token is CLOSE_PAREN. */ 3866 3867static ffelexHandler 3868ffestb_if1_ (ffelexToken ft, ffebld expr, ffelexToken t) 3869{ 3870 ffestb_local_.if_stmt.expr = expr; 3871 3872 switch (ffelex_token_type (t)) 3873 { 3874 case FFELEX_typeCLOSE_PAREN: 3875 if (expr == NULL) 3876 break; 3877 ffesta_tokens[1] = ffelex_token_use (ft); 3878 ffelex_set_names (TRUE); 3879 return (ffelexHandler) ffestb_if2_; 3880 3881 default: 3882 break; 3883 } 3884 3885 if (ffesta_construct_name != NULL) 3886 { 3887 ffelex_token_kill (ffesta_construct_name); 3888 ffesta_construct_name = NULL; 3889 } 3890 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IF", t); 3891 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 3892} 3893 3894/* ffestb_if2_ -- "IF" OPEN_PAREN expr CLOSE_PAREN 3895 3896 return ffestb_if2_; // to lexer 3897 3898 Make sure the next token is NAME. */ 3899 3900static ffelexHandler 3901ffestb_if2_ (ffelexToken t) 3902{ 3903 ffelex_set_names (FALSE); 3904 3905 switch (ffelex_token_type (t)) 3906 { 3907 case FFELEX_typeNAME: 3908 case FFELEX_typeNAMES: 3909 ffesta_confirmed (); 3910 ffesta_tokens[2] = ffelex_token_use (t); 3911 return (ffelexHandler) ffestb_if3_; 3912 3913 default: 3914 break; 3915 } 3916 3917 ffelex_token_kill (ffesta_tokens[1]); 3918 if ((ffesta_construct_name == NULL) 3919 || (ffelex_token_type (t) != FFELEX_typeNUMBER)) 3920 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IF", t); 3921 else 3922 ffesta_ffebad_2st (FFEBAD_INVALID_STMT_FORM, "CONSTRUCT", 3923 ffesta_construct_name, t); 3924 if (ffesta_construct_name != NULL) 3925 { 3926 ffelex_token_kill (ffesta_construct_name); 3927 ffesta_construct_name = NULL; 3928 } 3929 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 3930} 3931 3932/* ffestb_if3_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NAME 3933 3934 return ffestb_if3_; // to lexer 3935 3936 If the next token is EOS or SEMICOLON and the preceding NAME was "THEN", 3937 implement R803. Else, implement R807 and send the preceding NAME followed 3938 by the current token. */ 3939 3940static ffelexHandler 3941ffestb_if3_ (ffelexToken t) 3942{ 3943 ffelexHandler next; 3944 3945 switch (ffelex_token_type (t)) 3946 { 3947 case FFELEX_typeEOS: 3948 case FFELEX_typeSEMICOLON: 3949 if (ffestr_first (ffesta_tokens[2]) == FFESTR_firstTHEN) 3950 { 3951 if (!ffesta_is_inhibited ()) 3952 ffestc_R803 (ffesta_construct_name, ffestb_local_.if_stmt.expr, 3953 ffesta_tokens[1]); 3954 ffelex_token_kill (ffesta_tokens[1]); 3955 ffelex_token_kill (ffesta_tokens[2]); 3956 if (ffesta_construct_name != NULL) 3957 { 3958 ffelex_token_kill (ffesta_construct_name); 3959 ffesta_construct_name = NULL; 3960 } 3961 return (ffelexHandler) ffesta_zero (t); 3962 } 3963 break; 3964 3965 default: 3966 break; 3967 } 3968 3969 if (ffesta_construct_name != NULL) 3970 { 3971 if (!ffesta_is_inhibited ()) 3972 ffesta_ffebad_2st (FFEBAD_INVALID_STMT_FORM, "CONSTRUCT", 3973 ffesta_construct_name, ffesta_tokens[2]); 3974 ffelex_token_kill (ffesta_construct_name); 3975 ffesta_construct_name = NULL; 3976 ffelex_token_kill (ffesta_tokens[1]); 3977 ffelex_token_kill (ffesta_tokens[2]); 3978 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 3979 } 3980 3981 if (!ffesta_is_inhibited ()) 3982 ffestc_R807 (ffestb_local_.if_stmt.expr, ffesta_tokens[1]); 3983 ffelex_token_kill (ffesta_tokens[1]); 3984 { 3985 ffelexToken my_2 = ffesta_tokens[2]; 3986 3987 next = (ffelexHandler) ffesta_two (my_2, t); 3988 ffelex_token_kill (my_2); 3989 } 3990 return (ffelexHandler) next; 3991} 3992 3993/* ffestb_where -- Parse a WHERE statement 3994 3995 return ffestb_where; // to lexer 3996 3997 Make sure the statement has a valid form for a WHERE statement. 3998 If it does, implement the statement. */ 3999 4000#if FFESTR_F90 4001ffelexHandler 4002ffestb_where (ffelexToken t) 4003{ 4004 switch (ffelex_token_type (ffesta_tokens[0])) 4005 { 4006 case FFELEX_typeNAME: 4007 if (ffesta_first_kw != FFESTR_firstWHERE) 4008 goto bad_0; /* :::::::::::::::::::: */ 4009 break; 4010 4011 case FFELEX_typeNAMES: 4012 if (ffesta_first_kw != FFESTR_firstWHERE) 4013 goto bad_0; /* :::::::::::::::::::: */ 4014 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlWHERE) 4015 goto bad_0; /* :::::::::::::::::::: */ 4016 break; 4017 4018 default: 4019 goto bad_0; /* :::::::::::::::::::: */ 4020 } 4021 4022 switch (ffelex_token_type (t)) 4023 { 4024 case FFELEX_typeOPEN_PAREN: 4025 break; 4026 4027 case FFELEX_typeEOS: 4028 case FFELEX_typeSEMICOLON: 4029 case FFELEX_typeCOMMA: 4030 case FFELEX_typeCOLONCOLON: 4031 ffesta_confirmed (); /* Error, but clearly intended. */ 4032 goto bad_1; /* :::::::::::::::::::: */ 4033 4034 default: 4035 goto bad_1; /* :::::::::::::::::::: */ 4036 } 4037 4038 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextWHERE, 4039 (ffeexprCallback) ffestb_where1_); 4040 4041bad_0: /* :::::::::::::::::::: */ 4042 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", ffesta_tokens[0]); 4043 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 4044 4045bad_1: /* :::::::::::::::::::: */ 4046 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", t); 4047 return (ffelexHandler) ffelex_swallow_tokens (t, 4048 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 4049} 4050 4051#endif 4052/* ffestb_where1_ -- "WHERE" OPEN_PAREN expr 4053 4054 (ffestb_where1_) // to expression handler 4055 4056 Make sure the next token is CLOSE_PAREN. */ 4057 4058#if FFESTR_F90 4059static ffelexHandler 4060ffestb_where1_ (ffelexToken ft, ffebld expr, ffelexToken t) 4061{ 4062 ffestb_local_.if_stmt.expr = expr; 4063 4064 switch (ffelex_token_type (t)) 4065 { 4066 case FFELEX_typeCLOSE_PAREN: 4067 if (expr == NULL) 4068 break; 4069 ffesta_tokens[1] = ffelex_token_use (ft); 4070 ffelex_set_names (TRUE); 4071 return (ffelexHandler) ffestb_where2_; 4072 4073 default: 4074 break; 4075 } 4076 4077 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", t); 4078 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 4079} 4080 4081#endif 4082/* ffestb_where2_ -- "WHERE" OPEN_PAREN expr CLOSE_PAREN 4083 4084 return ffestb_where2_; // to lexer 4085 4086 Make sure the next token is NAME. */ 4087 4088#if FFESTR_F90 4089static ffelexHandler 4090ffestb_where2_ (ffelexToken t) 4091{ 4092 ffelex_set_names (FALSE); 4093 4094 switch (ffelex_token_type (t)) 4095 { 4096 case FFELEX_typeNAME: 4097 case FFELEX_typeNAMES: 4098 ffesta_confirmed (); 4099 ffesta_tokens[2] = ffelex_token_use (t); 4100 return (ffelexHandler) ffestb_where3_; 4101 4102 case FFELEX_typeEOS: 4103 case FFELEX_typeSEMICOLON: 4104 ffesta_confirmed (); 4105 if (!ffesta_is_inhibited ()) 4106 ffestc_R742 (ffestb_local_.if_stmt.expr, ffesta_tokens[1]); 4107 ffelex_token_kill (ffesta_tokens[1]); 4108 return (ffelexHandler) ffesta_zero (t); 4109 4110 default: 4111 break; 4112 } 4113 4114 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", t); 4115 ffelex_token_kill (ffesta_tokens[1]); 4116 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 4117} 4118 4119#endif 4120/* ffestb_where3_ -- "WHERE" OPEN_PAREN expr CLOSE_PAREN NAME 4121 4122 return ffestb_where3_; // to lexer 4123 4124 Implement R742. */ 4125 4126#if FFESTR_F90 4127static ffelexHandler 4128ffestb_where3_ (ffelexToken t) 4129{ 4130 ffelexHandler next; 4131 ffelexToken my_2 = ffesta_tokens[2]; 4132 4133 if (!ffesta_is_inhibited ()) 4134 ffestc_R740 (ffestb_local_.if_stmt.expr, ffesta_tokens[1]); 4135 ffelex_token_kill (ffesta_tokens[1]); 4136 next = (ffelexHandler) ffesta_two (my_2, t); 4137 ffelex_token_kill (my_2); 4138 return (ffelexHandler) next; 4139} 4140 4141#endif 4142/* ffestb_let -- Parse an assignment statement 4143 4144 return ffestb_let; // to lexer 4145 4146 Make sure the statement has a valid form for an assignment statement. If 4147 it does, implement the statement. */ 4148 4149ffelexHandler 4150ffestb_let (ffelexToken t) 4151{ 4152 ffelexHandler next; 4153 bool vxtparam; /* TRUE if it might really be a VXT PARAMETER 4154 stmt. */ 4155 unsigned const char *p; 4156 4157 switch (ffelex_token_type (ffesta_tokens[0])) 4158 { 4159 case FFELEX_typeNAME: 4160 vxtparam = FALSE; 4161 break; 4162 4163 case FFELEX_typeNAMES: 4164 vxtparam = TRUE; 4165 break; 4166 4167 default: 4168 goto bad_0; /* :::::::::::::::::::: */ 4169 } 4170 4171 switch (ffelex_token_type (t)) 4172 { 4173 case FFELEX_typeOPEN_PAREN: 4174 case FFELEX_typePERCENT: 4175 case FFELEX_typePOINTS: 4176 ffestb_local_.let.vxtparam = FALSE; 4177 break; 4178 4179 case FFELEX_typeEQUALS: 4180 if (!vxtparam || (ffesta_first_kw != FFESTR_firstPARAMETER)) 4181 { 4182 ffestb_local_.let.vxtparam = FALSE; 4183 break; 4184 } 4185 p = ffelex_token_text (ffesta_tokens[0]) + FFESTR_firstlPARAMETER; 4186 ffestb_local_.let.vxtparam = ffesrc_is_name_init (*p); 4187 break; 4188 4189 default: 4190 goto bad_1; /* :::::::::::::::::::: */ 4191 } 4192 4193 next = (ffelexHandler) (*((ffelexHandler) 4194 ffeexpr_lhs (ffesta_output_pool, 4195 FFEEXPR_contextLET, 4196 (ffeexprCallback) ffestb_let1_))) 4197 (ffesta_tokens[0]); 4198 return (ffelexHandler) (*next) (t); 4199 4200bad_0: /* :::::::::::::::::::: */ 4201 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assignment", ffesta_tokens[0]); 4202 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 4203 4204bad_1: /* :::::::::::::::::::: */ 4205 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assignment", t); 4206 return (ffelexHandler) ffelex_swallow_tokens (t, 4207 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 4208} 4209 4210/* ffestb_let1_ -- expr 4211 4212 (ffestb_let1_) // to expression handler 4213 4214 Make sure the next token is EQUALS or POINTS. */ 4215 4216static ffelexHandler 4217ffestb_let1_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t) 4218{ 4219 ffestb_local_.let.dest = expr; 4220 4221 switch (ffelex_token_type (t)) 4222 { 4223#if FFESTR_F90 4224 case FFELEX_typePOINTS: 4225#endif 4226 case FFELEX_typeEQUALS: 4227 if (expr == NULL) 4228 break; 4229 ffesta_tokens[1] = ffelex_token_use (t); 4230 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 4231 FFEEXPR_contextLET, (ffeexprCallback) ffestb_let2_); 4232 4233 default: 4234 break; 4235 } 4236 4237 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assignment", t); 4238 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 4239} 4240 4241/* ffestb_let2_ -- expr EQUALS/POINTS expr 4242 4243 (ffestb_end2_) // to expression handler 4244 4245 Make sure the next token is EOS or SEMICOLON; implement the statement. */ 4246 4247static ffelexHandler 4248ffestb_let2_ (ffelexToken ft, ffebld expr, ffelexToken t) 4249{ 4250 switch (ffelex_token_type (t)) 4251 { 4252 case FFELEX_typeEOS: 4253 case FFELEX_typeSEMICOLON: 4254 if (expr == NULL) 4255 break; 4256 if (ffestb_local_.let.vxtparam && !ffestc_is_let_not_V027 ()) 4257 break; 4258 ffesta_confirmed (); 4259 if (!ffesta_is_inhibited ()) 4260#if FFESTR_F90 4261 if (ffelex_token_type (ffesta_tokens[1]) == FFELEX_typeEQUALS) 4262#endif 4263 ffestc_let (ffestb_local_.let.dest, expr, ft); 4264#if FFESTR_F90 4265 else 4266 ffestc_R738 (ffestb_local_.let.dest, expr, ft); 4267#endif 4268 ffelex_token_kill (ffesta_tokens[1]); 4269 return (ffelexHandler) ffesta_zero (t); 4270 4271 default: 4272 break; 4273 } 4274 4275 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, 4276 (ffelex_token_type (ffesta_tokens[1]) == FFELEX_typeEQUALS) 4277 ? "assignment" : "pointer-assignment", 4278 t); 4279 ffelex_token_kill (ffesta_tokens[1]); 4280 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 4281} 4282 4283/* ffestb_type -- Parse the TYPE statement 4284 4285 return ffestb_type; // to lexer 4286 4287 Make sure the statement has a valid form for the TYPE statement. If 4288 it does, implement the statement. */ 4289 4290#if FFESTR_F90 4291ffelexHandler 4292ffestb_type (ffelexToken t) 4293{ 4294 ffeTokenLength i; 4295 const char *p; 4296 4297 switch (ffelex_token_type (ffesta_tokens[0])) 4298 { 4299 case FFELEX_typeNAME: 4300 if (ffesta_first_kw != FFESTR_firstTYPE) 4301 goto bad_0; /* :::::::::::::::::::: */ 4302 switch (ffelex_token_type (t)) 4303 { 4304 case FFELEX_typeEOS: 4305 case FFELEX_typeSEMICOLON: 4306 case FFELEX_typeCOLONCOLON: 4307 ffesta_confirmed (); /* Error, but clearly intended. */ 4308 goto bad_1; /* :::::::::::::::::::: */ 4309 4310 default: 4311 goto bad_1; /* :::::::::::::::::::: */ 4312 4313 case FFELEX_typeCOMMA: 4314 ffesta_confirmed (); 4315 return (ffelexHandler) ffestb_type1_; 4316 4317 case FFELEX_typeNAME: /* No confirm here, because ambig w/V020 VXT 4318 TYPE. */ 4319 ffesta_tokens[1] = NULL; 4320 ffesta_tokens[2] = ffelex_token_use (t); 4321 return (ffelexHandler) ffestb_type4_; 4322 } 4323 4324 case FFELEX_typeNAMES: 4325 if (ffesta_first_kw != FFESTR_firstTYPE) 4326 goto bad_0; /* :::::::::::::::::::: */ 4327 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlTYPE); 4328 switch (ffelex_token_type (t)) 4329 { 4330 default: 4331 goto bad_1; /* :::::::::::::::::::: */ 4332 4333 case FFELEX_typeCOMMA: 4334 if (*p != '\0') 4335 goto bad_i; /* :::::::::::::::::::: */ 4336 ffesta_confirmed (); 4337 ffelex_set_names (TRUE); 4338 return (ffelexHandler) ffestb_type1_; 4339 4340 case FFELEX_typeEOS: 4341 case FFELEX_typeSEMICOLON: 4342 break; 4343 } 4344 if (!ffesrc_is_name_init (*p)) 4345 goto bad_i; /* :::::::::::::::::::: */ 4346 ffesta_tokens[1] = NULL; 4347 ffesta_tokens[2] 4348 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); 4349 return (ffelexHandler) ffestb_type4_ (t); 4350 4351 default: 4352 goto bad_0; /* :::::::::::::::::::: */ 4353 } 4354 4355bad_0: /* :::::::::::::::::::: */ 4356 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", ffesta_tokens[0]); 4357 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 4358 4359bad_1: /* :::::::::::::::::::: */ 4360 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t); 4361 return (ffelexHandler) ffelex_swallow_tokens (t, 4362 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 4363 4364bad_i: /* :::::::::::::::::::: */ 4365 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "TYPE", ffesta_tokens[0], i, t); 4366 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 4367} 4368 4369/* ffestb_type1_ -- "TYPE" COMMA 4370 4371 return ffestb_type1_; // to lexer 4372 4373 Make sure the next token is a NAME. */ 4374 4375static ffelexHandler 4376ffestb_type1_ (ffelexToken t) 4377{ 4378 ffeTokenLength i; 4379 const char *p; 4380 4381 ffelex_set_names (FALSE); 4382 4383 switch (ffelex_token_type (t)) 4384 { 4385 case FFELEX_typeNAME: 4386 ffesta_tokens[1] = ffelex_token_use (t); 4387 ffestb_local_.type.kw = ffestr_other (t); 4388 switch (ffestb_local_.varlist.kw) 4389 { 4390 case FFESTR_otherPUBLIC: 4391 case FFESTR_otherPRIVATE: 4392 return (ffelexHandler) ffestb_type2_; 4393 4394 default: 4395 ffelex_token_kill (ffesta_tokens[1]); 4396 break; 4397 } 4398 break; 4399 4400 case FFELEX_typeNAMES: 4401 ffesta_tokens[1] = ffelex_token_use (t); 4402 ffestb_local_.type.kw = ffestr_other (t); 4403 switch (ffestb_local_.varlist.kw) 4404 { 4405 case FFESTR_otherPUBLIC: 4406 p = ffelex_token_text (t) + (i = FFESTR_otherlPUBLIC); 4407 if (*p == '\0') 4408 return (ffelexHandler) ffestb_type2_; 4409 if (!ffesrc_is_name_init (*p)) 4410 goto bad_i1; /* :::::::::::::::::::: */ 4411 ffesta_tokens[2] = ffelex_token_name_from_names (t, i, 0); 4412 return (ffelexHandler) ffestb_type4_; 4413 4414 case FFESTR_otherPRIVATE: 4415 p = ffelex_token_text (t) + (i = FFESTR_otherlPRIVATE); 4416 if (*p == '\0') 4417 return (ffelexHandler) ffestb_type2_; 4418 if (!ffesrc_is_name_init (*p)) 4419 goto bad_i1; /* :::::::::::::::::::: */ 4420 ffesta_tokens[2] = ffelex_token_name_from_names (t, i, 0); 4421 return (ffelexHandler) ffestb_type4_; 4422 4423 default: 4424 ffelex_token_kill (ffesta_tokens[1]); 4425 break; 4426 } 4427 break; 4428 4429 default: 4430 break; 4431 } 4432 4433 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t); 4434 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 4435 4436bad_i1: /* :::::::::::::::::::: */ 4437 ffelex_token_kill (ffesta_tokens[1]); 4438 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "TYPE", t, i, NULL); 4439 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 4440} 4441 4442/* ffestb_type2_ -- "TYPE" COMMA NAME 4443 4444 return ffestb_type2_; // to lexer 4445 4446 Handle COLONCOLON or NAME. */ 4447 4448static ffelexHandler 4449ffestb_type2_ (ffelexToken t) 4450{ 4451 switch (ffelex_token_type (t)) 4452 { 4453 case FFELEX_typeCOLONCOLON: 4454 return (ffelexHandler) ffestb_type3_; 4455 4456 case FFELEX_typeNAME: 4457 return (ffelexHandler) ffestb_type3_ (t); 4458 4459 default: 4460 break; 4461 } 4462 4463 if (ffesta_tokens[1] != NULL) 4464 ffelex_token_kill (ffesta_tokens[1]); 4465 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t); 4466 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 4467} 4468 4469/* ffestb_type3_ -- "TYPE" [COMMA NAME [COLONCOLON]] 4470 4471 return ffestb_type3_; // to lexer 4472 4473 Make sure the next token is a NAME. */ 4474 4475static ffelexHandler 4476ffestb_type3_ (ffelexToken t) 4477{ 4478 switch (ffelex_token_type (t)) 4479 { 4480 case FFELEX_typeNAME: 4481 ffesta_tokens[2] = ffelex_token_use (t); 4482 return (ffelexHandler) ffestb_type4_; 4483 4484 default: 4485 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t); 4486 break; 4487 } 4488 4489 if (ffesta_tokens[1] != NULL) 4490 ffelex_token_kill (ffesta_tokens[1]); 4491 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 4492} 4493 4494/* ffestb_type4_ -- "TYPE" [COMMA NAME [COLONCOLON]] NAME 4495 4496 return ffestb_type4_; // to lexer 4497 4498 Make sure the next token is an EOS or SEMICOLON. */ 4499 4500static ffelexHandler 4501ffestb_type4_ (ffelexToken t) 4502{ 4503 switch (ffelex_token_type (t)) 4504 { 4505 case FFELEX_typeEOS: 4506 case FFELEX_typeSEMICOLON: 4507 ffesta_confirmed (); 4508 if (!ffesta_is_inhibited ()) 4509 ffestc_R424 (ffesta_tokens[1], ffestb_local_.type.kw, 4510 ffesta_tokens[2]); 4511 if (ffesta_tokens[1] != NULL) 4512 ffelex_token_kill (ffesta_tokens[1]); 4513 ffelex_token_kill (ffesta_tokens[2]); 4514 return (ffelexHandler) ffesta_zero (t); 4515 4516 default: 4517 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t); 4518 break; 4519 } 4520 4521 if (ffesta_tokens[1] != NULL) 4522 ffelex_token_kill (ffesta_tokens[1]); 4523 ffelex_token_kill (ffesta_tokens[2]); 4524 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 4525} 4526 4527#endif 4528/* ffestb_varlist -- Parse EXTERNAL/INTENT/INTRINSIC/OPTIONAL/PUBLIC/PRIVATE 4529 statement 4530 4531 return ffestb_varlist; // to lexer 4532 4533 Make sure the statement has a valid form. If it 4534 does, implement the statement. */ 4535 4536ffelexHandler 4537ffestb_varlist (ffelexToken t) 4538{ 4539 ffeTokenLength i; 4540 unsigned const char *p; 4541 ffelexToken nt; 4542 ffelexHandler next; 4543 4544 switch (ffelex_token_type (ffesta_tokens[0])) 4545 { 4546 case FFELEX_typeNAME: 4547 switch (ffelex_token_type (t)) 4548 { 4549 case FFELEX_typeEOS: 4550 case FFELEX_typeSEMICOLON: 4551 ffesta_confirmed (); 4552 switch (ffesta_first_kw) 4553 { 4554#if FFESTR_F90 4555 case FFESTR_firstPUBLIC: 4556 if (!ffesta_is_inhibited ()) 4557 ffestc_R521A (); 4558 return (ffelexHandler) ffesta_zero (t); 4559 4560 case FFESTR_firstPRIVATE: 4561 if (!ffesta_is_inhibited ()) 4562 ffestc_private (); /* Either R523A or R521B. */ 4563 return (ffelexHandler) ffesta_zero (t); 4564#endif 4565 4566 default: 4567 goto bad_1; /* :::::::::::::::::::: */ 4568 } 4569 4570 case FFELEX_typeCOMMA: 4571 ffesta_confirmed (); /* Error, but clearly intended. */ 4572 goto bad_1; /* :::::::::::::::::::: */ 4573 4574 case FFELEX_typeCOLONCOLON: 4575 ffesta_confirmed (); 4576 switch (ffesta_first_kw) 4577 { 4578#if FFESTR_F90 4579 case FFESTR_firstOPTIONAL: 4580 if (!ffesta_is_inhibited ()) 4581 ffestc_R520_start (); 4582 break; 4583 4584 case FFESTR_firstPUBLIC: 4585 if (!ffesta_is_inhibited ()) 4586 ffestc_R521Astart (); 4587 break; 4588 4589 case FFESTR_firstPRIVATE: 4590 if (!ffesta_is_inhibited ()) 4591 ffestc_R521Bstart (); 4592 break; 4593#endif 4594 4595 default: 4596 ffesta_confirmed (); /* Error, but clearly intended. */ 4597 goto bad_1; /* :::::::::::::::::::: */ 4598 } 4599 return (ffelexHandler) ffestb_varlist5_; 4600 4601 default: 4602 goto bad_1; /* :::::::::::::::::::: */ 4603 4604 case FFELEX_typeOPEN_PAREN: 4605 switch (ffesta_first_kw) 4606 { 4607#if FFESTR_F90 4608 case FFESTR_firstINTENT: 4609 return (ffelexHandler) ffestb_varlist1_; 4610#endif 4611 4612 default: 4613 goto bad_1; /* :::::::::::::::::::: */ 4614 } 4615 4616 case FFELEX_typeNAME: 4617 ffesta_confirmed (); 4618 switch (ffesta_first_kw) 4619 { 4620 case FFESTR_firstEXTERNAL: 4621 if (!ffesta_is_inhibited ()) 4622 ffestc_R1207_start (); 4623 break; 4624 4625#if FFESTR_F90 4626 case FFESTR_firstINTENT: 4627 goto bad_1; /* :::::::::::::::::::: */ 4628#endif 4629 4630 case FFESTR_firstINTRINSIC: 4631 if (!ffesta_is_inhibited ()) 4632 ffestc_R1208_start (); 4633 break; 4634 4635#if FFESTR_F90 4636 case FFESTR_firstOPTIONAL: 4637 if (!ffesta_is_inhibited ()) 4638 ffestc_R520_start (); 4639 break; 4640#endif 4641 4642#if FFESTR_F90 4643 case FFESTR_firstPUBLIC: 4644 if (!ffesta_is_inhibited ()) 4645 ffestc_R521Astart (); 4646 break; 4647 4648 case FFESTR_firstPRIVATE: 4649 if (!ffesta_is_inhibited ()) 4650 ffestc_R521Bstart (); 4651 break; 4652#endif 4653 4654 default: 4655 break; 4656 } 4657 return (ffelexHandler) ffestb_varlist5_ (t); 4658 } 4659 4660 case FFELEX_typeNAMES: 4661 p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.varlist.len); 4662 switch (ffelex_token_type (t)) 4663 { 4664 case FFELEX_typeEOS: 4665 case FFELEX_typeSEMICOLON: 4666 ffesta_confirmed (); 4667 switch (ffesta_first_kw) 4668 { 4669#if FFESTR_F90 4670 case FFESTR_firstINTENT: 4671 goto bad_1; /* :::::::::::::::::::: */ 4672#endif 4673 4674 default: 4675 break; 4676 } 4677 if (*p != '\0') 4678 break; 4679 switch (ffesta_first_kw) 4680 { 4681#if FFESTR_F90 4682 case FFESTR_firstPUBLIC: 4683 if (!ffesta_is_inhibited ()) 4684 ffestc_R521A (); 4685 return (ffelexHandler) ffesta_zero (t); 4686 4687 case FFESTR_firstPRIVATE: 4688 if (!ffesta_is_inhibited ()) 4689 ffestc_private (); /* Either R423A or R521B. */ 4690 return (ffelexHandler) ffesta_zero (t); 4691#endif 4692 4693 default: 4694 goto bad_1; /* :::::::::::::::::::: */ 4695 } 4696 4697 case FFELEX_typeCOMMA: 4698 ffesta_confirmed (); /* Error, but clearly intended. */ 4699 switch (ffesta_first_kw) 4700 { 4701#if FFESTR_F90 4702 case FFESTR_firstINTENT: 4703 goto bad_1; /* :::::::::::::::::::: */ 4704#endif 4705 4706 default: 4707 break; 4708 } 4709 if (*p != '\0') 4710 break; 4711 goto bad_1; /* :::::::::::::::::::: */ 4712 4713 case FFELEX_typeCOLONCOLON: 4714 ffesta_confirmed (); 4715 switch (ffesta_first_kw) 4716 { 4717#if FFESTR_F90 4718 case FFESTR_firstOPTIONAL: 4719 if (!ffesta_is_inhibited ()) 4720 ffestc_R520_start (); 4721 break; 4722#endif 4723 4724#if FFESTR_F90 4725 case FFESTR_firstPUBLIC: 4726 if (!ffesta_is_inhibited ()) 4727 ffestc_R521Astart (); 4728 break; 4729 4730 case FFESTR_firstPRIVATE: 4731 if (!ffesta_is_inhibited ()) 4732 ffestc_R521Bstart (); 4733 break; 4734#endif 4735 4736 default: 4737 goto bad_1; /* :::::::::::::::::::: */ 4738 } 4739 return (ffelexHandler) ffestb_varlist5_; 4740 4741 case FFELEX_typeOPEN_PAREN: 4742 switch (ffesta_first_kw) 4743 { 4744#if FFESTR_F90 4745 case FFESTR_firstINTENT: 4746 if (*p != '\0') 4747 goto bad_1; /* :::::::::::::::::::: */ 4748 return (ffelexHandler) ffestb_varlist1_; 4749#endif 4750 4751 default: 4752 goto bad_1; /* :::::::::::::::::::: */ 4753 } 4754 4755 case FFELEX_typeNAME: 4756 ffesta_confirmed (); 4757 switch (ffesta_first_kw) 4758 { 4759 case FFESTR_firstEXTERNAL: 4760 if (!ffesta_is_inhibited ()) 4761 ffestc_R1207_start (); 4762 break; 4763 4764#if FFESTR_F90 4765 case FFESTR_firstINTENT: 4766 goto bad_1; /* :::::::::::::::::::: */ 4767#endif 4768 4769 case FFESTR_firstINTRINSIC: 4770 if (!ffesta_is_inhibited ()) 4771 ffestc_R1208_start (); 4772 break; 4773 4774#if FFESTR_F90 4775 case FFESTR_firstOPTIONAL: 4776 if (!ffesta_is_inhibited ()) 4777 ffestc_R520_start (); 4778 break; 4779#endif 4780 4781#if FFESTR_F90 4782 case FFESTR_firstPUBLIC: 4783 if (!ffesta_is_inhibited ()) 4784 ffestc_R521Astart (); 4785 break; 4786 4787 case FFESTR_firstPRIVATE: 4788 if (!ffesta_is_inhibited ()) 4789 ffestc_R521Bstart (); 4790 break; 4791#endif 4792 4793 default: 4794 break; 4795 } 4796 return (ffelexHandler) ffestb_varlist5_ (t); 4797 4798 default: 4799 goto bad_1; /* :::::::::::::::::::: */ 4800 } 4801 4802 /* Here, we have at least one char after the first keyword and t is 4803 COMMA or EOS/SEMICOLON. Also we know that this form is valid for 4804 only the statements reaching here (specifically, INTENT won't reach 4805 here). */ 4806 4807 if (!ffesrc_is_name_init (*p)) 4808 goto bad_i; /* :::::::::::::::::::: */ 4809 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); 4810 if (!ffesta_is_inhibited ()) 4811 { 4812 switch (ffesta_first_kw) 4813 { 4814 case FFESTR_firstEXTERNAL: 4815 ffestc_R1207_start (); 4816 break; 4817 4818 case FFESTR_firstINTRINSIC: 4819 ffestc_R1208_start (); 4820 break; 4821 4822#if FFESTR_F90 4823 case FFESTR_firstOPTIONAL: 4824 ffestc_R520_start (); 4825 break; 4826#endif 4827 4828#if FFESTR_F90 4829 case FFESTR_firstPUBLIC: 4830 ffestc_R521Astart (); 4831 break; 4832 4833 case FFESTR_firstPRIVATE: 4834 ffestc_R521Bstart (); 4835 break; 4836#endif 4837 4838 default: 4839 assert (FALSE); 4840 } 4841 } 4842 next = (ffelexHandler) ffestb_varlist5_ (nt); 4843 ffelex_token_kill (nt); 4844 return (ffelexHandler) (*next) (t); 4845 4846 default: 4847 goto bad_0; /* :::::::::::::::::::: */ 4848 } 4849 4850bad_0: /* :::::::::::::::::::: */ 4851 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, ffesta_tokens[0]); 4852 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 4853 4854bad_1: /* :::::::::::::::::::: */ 4855 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t); 4856 return (ffelexHandler) ffelex_swallow_tokens (t, 4857 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 4858 4859bad_i: /* :::::::::::::::::::: */ 4860 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, ffesta_tokens[0], i, t); 4861 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 4862} 4863 4864/* ffestb_varlist1_ -- "INTENT" OPEN_PAREN 4865 4866 return ffestb_varlist1_; // to lexer 4867 4868 Handle NAME. */ 4869 4870#if FFESTR_F90 4871static ffelexHandler 4872ffestb_varlist1_ (ffelexToken t) 4873{ 4874 switch (ffelex_token_type (t)) 4875 { 4876 case FFELEX_typeNAME: 4877 ffesta_tokens[1] = ffelex_token_use (t); 4878 ffestb_local_.varlist.kw = ffestr_other (t); 4879 switch (ffestb_local_.varlist.kw) 4880 { 4881 case FFESTR_otherIN: 4882 return (ffelexHandler) ffestb_varlist2_; 4883 4884 case FFESTR_otherINOUT: 4885 return (ffelexHandler) ffestb_varlist3_; 4886 4887 case FFESTR_otherOUT: 4888 return (ffelexHandler) ffestb_varlist3_; 4889 4890 default: 4891 ffelex_token_kill (ffesta_tokens[1]); 4892 break; 4893 } 4894 break; 4895 4896 default: 4897 break; 4898 } 4899 4900 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t); 4901 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 4902} 4903 4904/* ffestb_varlist2_ -- "INTENT" OPEN_PAREN "IN" 4905 4906 return ffestb_varlist2_; // to lexer 4907 4908 Handle NAME. */ 4909 4910static ffelexHandler 4911ffestb_varlist2_ (ffelexToken t) 4912{ 4913 switch (ffelex_token_type (t)) 4914 { 4915 case FFELEX_typeNAME: 4916 switch (ffestr_other (t)) 4917 { 4918 case FFESTR_otherOUT: 4919 ffestb_local_.varlist.kw = FFESTR_otherINOUT; 4920 return (ffelexHandler) ffestb_varlist3_; 4921 4922 default: 4923 break; 4924 } 4925 break; 4926 4927 case FFELEX_typeCLOSE_PAREN: 4928 return (ffelexHandler) ffestb_varlist4_; 4929 4930 default: 4931 break; 4932 } 4933 4934 ffelex_token_kill (ffesta_tokens[1]); 4935 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t); 4936 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 4937} 4938 4939/* ffestb_varlist3_ -- "INTENT" OPEN_PAREN NAME ["OUT"] 4940 4941 return ffestb_varlist3_; // to lexer 4942 4943 Handle CLOSE_PAREN. */ 4944 4945static ffelexHandler 4946ffestb_varlist3_ (ffelexToken t) 4947{ 4948 switch (ffelex_token_type (t)) 4949 { 4950 case FFELEX_typeCLOSE_PAREN: 4951 return (ffelexHandler) ffestb_varlist4_; 4952 4953 default: 4954 break; 4955 } 4956 4957 ffelex_token_kill (ffesta_tokens[1]); 4958 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t); 4959 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 4960} 4961 4962/* ffestb_varlist4_ -- "INTENT" OPEN_PAREN NAME ["OUT"] CLOSE_PAREN 4963 4964 return ffestb_varlist4_; // to lexer 4965 4966 Handle COLONCOLON or NAME. */ 4967 4968static ffelexHandler 4969ffestb_varlist4_ (ffelexToken t) 4970{ 4971 switch (ffelex_token_type (t)) 4972 { 4973 case FFELEX_typeCOLONCOLON: 4974 ffesta_confirmed (); 4975 if (!ffesta_is_inhibited ()) 4976 ffestc_R519_start (ffesta_tokens[1], ffestb_local_.varlist.kw); 4977 ffelex_token_kill (ffesta_tokens[1]); 4978 return (ffelexHandler) ffestb_varlist5_; 4979 4980 case FFELEX_typeNAME: 4981 ffesta_confirmed (); 4982 if (!ffesta_is_inhibited ()) 4983 ffestc_R519_start (ffesta_tokens[1], ffestb_local_.varlist.kw); 4984 ffelex_token_kill (ffesta_tokens[1]); 4985 return (ffelexHandler) ffestb_varlist5_ (t); 4986 4987 default: 4988 break; 4989 } 4990 4991 ffelex_token_kill (ffesta_tokens[1]); 4992 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t); 4993 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 4994} 4995 4996#endif 4997/* ffestb_varlist5_ -- Handles the list of variable names 4998 4999 return ffestb_varlist5_; // to lexer 5000 5001 Handle NAME. */ 5002 5003static ffelexHandler 5004ffestb_varlist5_ (ffelexToken t) 5005{ 5006 switch (ffelex_token_type (t)) 5007 { 5008 case FFELEX_typeNAME: 5009 ffesta_tokens[1] = ffelex_token_use (t); 5010 return (ffelexHandler) ffestb_varlist6_; 5011 5012 default: 5013 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t); 5014 break; 5015 } 5016 5017 if (!ffesta_is_inhibited ()) 5018 { 5019 switch (ffesta_first_kw) 5020 { 5021 case FFESTR_firstEXTERNAL: 5022 ffestc_R1207_finish (); 5023 break; 5024 5025#if FFESTR_F90 5026 case FFESTR_firstINTENT: 5027 ffestc_R519_finish (); 5028 break; 5029#endif 5030 5031 case FFESTR_firstINTRINSIC: 5032 ffestc_R1208_finish (); 5033 break; 5034 5035#if FFESTR_F90 5036 case FFESTR_firstOPTIONAL: 5037 ffestc_R520_finish (); 5038 break; 5039#endif 5040 5041#if FFESTR_F90 5042 case FFESTR_firstPUBLIC: 5043 ffestc_R521Afinish (); 5044 break; 5045 5046 case FFESTR_firstPRIVATE: 5047 ffestc_R521Bfinish (); 5048 break; 5049#endif 5050 5051 default: 5052 assert (FALSE); 5053 } 5054 } 5055 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 5056} 5057 5058/* ffestb_varlist6_ -- (whatever) NAME 5059 5060 return ffestb_varlist6_; // to lexer 5061 5062 Handle COMMA or EOS/SEMICOLON. */ 5063 5064static ffelexHandler 5065ffestb_varlist6_ (ffelexToken t) 5066{ 5067 switch (ffelex_token_type (t)) 5068 { 5069 case FFELEX_typeCOMMA: 5070 if (!ffesta_is_inhibited ()) 5071 { 5072 switch (ffesta_first_kw) 5073 { 5074 case FFESTR_firstEXTERNAL: 5075 ffestc_R1207_item (ffesta_tokens[1]); 5076 break; 5077 5078#if FFESTR_F90 5079 case FFESTR_firstINTENT: 5080 ffestc_R519_item (ffesta_tokens[1]); 5081 break; 5082#endif 5083 5084 case FFESTR_firstINTRINSIC: 5085 ffestc_R1208_item (ffesta_tokens[1]); 5086 break; 5087 5088#if FFESTR_F90 5089 case FFESTR_firstOPTIONAL: 5090 ffestc_R520_item (ffesta_tokens[1]); 5091 break; 5092#endif 5093 5094#if FFESTR_F90 5095 case FFESTR_firstPUBLIC: 5096 ffestc_R521Aitem (ffesta_tokens[1]); 5097 break; 5098 5099 case FFESTR_firstPRIVATE: 5100 ffestc_R521Bitem (ffesta_tokens[1]); 5101 break; 5102#endif 5103 5104 default: 5105 assert (FALSE); 5106 } 5107 } 5108 ffelex_token_kill (ffesta_tokens[1]); 5109 return (ffelexHandler) ffestb_varlist5_; 5110 5111 case FFELEX_typeEOS: 5112 case FFELEX_typeSEMICOLON: 5113 if (!ffesta_is_inhibited ()) 5114 { 5115 switch (ffesta_first_kw) 5116 { 5117 case FFESTR_firstEXTERNAL: 5118 ffestc_R1207_item (ffesta_tokens[1]); 5119 ffestc_R1207_finish (); 5120 break; 5121 5122#if FFESTR_F90 5123 case FFESTR_firstINTENT: 5124 ffestc_R519_item (ffesta_tokens[1]); 5125 ffestc_R519_finish (); 5126 break; 5127#endif 5128 5129 case FFESTR_firstINTRINSIC: 5130 ffestc_R1208_item (ffesta_tokens[1]); 5131 ffestc_R1208_finish (); 5132 break; 5133 5134#if FFESTR_F90 5135 case FFESTR_firstOPTIONAL: 5136 ffestc_R520_item (ffesta_tokens[1]); 5137 ffestc_R520_finish (); 5138 break; 5139#endif 5140 5141#if FFESTR_F90 5142 case FFESTR_firstPUBLIC: 5143 ffestc_R521Aitem (ffesta_tokens[1]); 5144 ffestc_R521Afinish (); 5145 break; 5146 5147 case FFESTR_firstPRIVATE: 5148 ffestc_R521Bitem (ffesta_tokens[1]); 5149 ffestc_R521Bfinish (); 5150 break; 5151#endif 5152 5153 default: 5154 assert (FALSE); 5155 } 5156 } 5157 ffelex_token_kill (ffesta_tokens[1]); 5158 return (ffelexHandler) ffesta_zero (t); 5159 5160 default: 5161 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t); 5162 break; 5163 } 5164 5165 if (!ffesta_is_inhibited ()) 5166 { 5167 switch (ffesta_first_kw) 5168 { 5169 case FFESTR_firstEXTERNAL: 5170 ffestc_R1207_finish (); 5171 break; 5172 5173#if FFESTR_F90 5174 case FFESTR_firstINTENT: 5175 ffestc_R519_finish (); 5176 break; 5177#endif 5178 5179 case FFESTR_firstINTRINSIC: 5180 ffestc_R1208_finish (); 5181 break; 5182 5183#if FFESTR_F90 5184 case FFESTR_firstOPTIONAL: 5185 ffestc_R520_finish (); 5186 break; 5187#endif 5188 5189#if FFESTR_F90 5190 case FFESTR_firstPUBLIC: 5191 ffestc_R521Afinish (); 5192 break; 5193 5194 case FFESTR_firstPRIVATE: 5195 ffestc_R521Bfinish (); 5196 break; 5197#endif 5198 5199 default: 5200 assert (FALSE); 5201 } 5202 } 5203 ffelex_token_kill (ffesta_tokens[1]); 5204 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 5205} 5206 5207/* ffestb_R423B -- Parse the SEQUENCE statement 5208 5209 return ffestb_R423B; // to lexer 5210 5211 Make sure the statement has a valid form for the SEQUENCE statement. If 5212 it does, implement the statement. */ 5213 5214#if FFESTR_F90 5215ffelexHandler 5216ffestb_R423B (ffelexToken t) 5217{ 5218 const char *p; 5219 ffeTokenLength i; 5220 5221 switch (ffelex_token_type (ffesta_tokens[0])) 5222 { 5223 case FFELEX_typeNAME: 5224 if (ffesta_first_kw != FFESTR_firstSEQUENCE) 5225 goto bad_0; /* :::::::::::::::::::: */ 5226 break; 5227 5228 case FFELEX_typeNAMES: 5229 if (ffesta_first_kw != FFESTR_firstSEQUENCE) 5230 goto bad_0; /* :::::::::::::::::::: */ 5231 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlSEQUENCE) 5232 { 5233 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSEQUENCE); 5234 goto bad_i; /* :::::::::::::::::::: */ 5235 } 5236 break; 5237 5238 default: 5239 goto bad_0; /* :::::::::::::::::::: */ 5240 } 5241 5242 switch (ffelex_token_type (t)) 5243 { 5244 case FFELEX_typeEOS: 5245 case FFELEX_typeSEMICOLON: 5246 ffesta_confirmed (); 5247 if (!ffesta_is_inhibited ()) 5248 ffestc_R423B (); 5249 return (ffelexHandler) ffesta_zero (t); 5250 5251 case FFELEX_typeCOMMA: 5252 case FFELEX_typeCOLONCOLON: 5253 ffesta_confirmed (); /* Error, but clearly intended. */ 5254 goto bad_1; /* :::::::::::::::::::: */ 5255 5256 default: 5257 goto bad_1; /* :::::::::::::::::::: */ 5258 } 5259 5260bad_0: /* :::::::::::::::::::: */ 5261 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SEQUENCE", ffesta_tokens[0]); 5262 return (ffelexHandler) ffelex_swallow_tokens (t, 5263 (ffelexHandler) ffesta_zero); /* Invalid first token. */ 5264 5265bad_1: /* :::::::::::::::::::: */ 5266 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SEQUENCE", t); 5267 return (ffelexHandler) ffelex_swallow_tokens (t, 5268 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 5269 5270bad_i: /* :::::::::::::::::::: */ 5271 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "SEQUENCE", ffesta_tokens[0], i, t); 5272 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 5273} 5274 5275#endif 5276/* ffestb_R522 -- Parse the SAVE statement 5277 5278 return ffestb_R522; // to lexer 5279 5280 Make sure the statement has a valid form for the SAVE statement. If it 5281 does, implement the statement. */ 5282 5283ffelexHandler 5284ffestb_R522 (ffelexToken t) 5285{ 5286 ffeTokenLength i; 5287 unsigned const char *p; 5288 ffelexToken nt; 5289 ffelexHandler next; 5290 5291 switch (ffelex_token_type (ffesta_tokens[0])) 5292 { 5293 case FFELEX_typeNAME: 5294 if (ffesta_first_kw != FFESTR_firstSAVE) 5295 goto bad_0; /* :::::::::::::::::::: */ 5296 switch (ffelex_token_type (t)) 5297 { 5298 case FFELEX_typeCOMMA: 5299 ffesta_confirmed (); /* Error, but clearly intended. */ 5300 goto bad_1; /* :::::::::::::::::::: */ 5301 5302 default: 5303 goto bad_1; /* :::::::::::::::::::: */ 5304 5305 case FFELEX_typeEOS: 5306 case FFELEX_typeSEMICOLON: 5307 ffesta_confirmed (); 5308 if (!ffesta_is_inhibited ()) 5309 ffestc_R522 (); 5310 return (ffelexHandler) ffesta_zero (t); 5311 5312 case FFELEX_typeNAME: 5313 case FFELEX_typeSLASH: 5314 ffesta_confirmed (); 5315 if (!ffesta_is_inhibited ()) 5316 ffestc_R522start (); 5317 return (ffelexHandler) ffestb_R5221_ (t); 5318 5319 case FFELEX_typeCOLONCOLON: 5320 ffesta_confirmed (); 5321 if (!ffesta_is_inhibited ()) 5322 ffestc_R522start (); 5323 return (ffelexHandler) ffestb_R5221_; 5324 } 5325 5326 case FFELEX_typeNAMES: 5327 if (ffesta_first_kw != FFESTR_firstSAVE) 5328 goto bad_0; /* :::::::::::::::::::: */ 5329 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSAVE); 5330 switch (ffelex_token_type (t)) 5331 { 5332 default: 5333 goto bad_1; /* :::::::::::::::::::: */ 5334 5335 case FFELEX_typeCOMMA: 5336 ffesta_confirmed (); 5337 break; 5338 5339 case FFELEX_typeEOS: 5340 case FFELEX_typeSEMICOLON: 5341 ffesta_confirmed (); 5342 if (*p != '\0') 5343 break; 5344 if (!ffesta_is_inhibited ()) 5345 ffestc_R522 (); 5346 return (ffelexHandler) ffesta_zero (t); 5347 5348 case FFELEX_typeSLASH: 5349 ffesta_confirmed (); 5350 if (*p != '\0') 5351 goto bad_i; /* :::::::::::::::::::: */ 5352 if (!ffesta_is_inhibited ()) 5353 ffestc_R522start (); 5354 return (ffelexHandler) ffestb_R5221_ (t); 5355 5356 case FFELEX_typeCOLONCOLON: 5357 ffesta_confirmed (); 5358 if (*p != '\0') 5359 goto bad_i; /* :::::::::::::::::::: */ 5360 if (!ffesta_is_inhibited ()) 5361 ffestc_R522start (); 5362 return (ffelexHandler) ffestb_R5221_; 5363 } 5364 5365 /* Here, we have at least one char after "SAVE" and t is COMMA or 5366 EOS/SEMICOLON. */ 5367 5368 if (!ffesrc_is_name_init (*p)) 5369 goto bad_i; /* :::::::::::::::::::: */ 5370 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); 5371 if (!ffesta_is_inhibited ()) 5372 ffestc_R522start (); 5373 next = (ffelexHandler) ffestb_R5221_ (nt); 5374 ffelex_token_kill (nt); 5375 return (ffelexHandler) (*next) (t); 5376 5377 default: 5378 goto bad_0; /* :::::::::::::::::::: */ 5379 } 5380 5381bad_0: /* :::::::::::::::::::: */ 5382 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", ffesta_tokens[0]); 5383 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 5384 5385bad_1: /* :::::::::::::::::::: */ 5386 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t); 5387 return (ffelexHandler) ffelex_swallow_tokens (t, 5388 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 5389 5390bad_i: /* :::::::::::::::::::: */ 5391 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "SAVE", ffesta_tokens[0], i, t); 5392 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 5393} 5394 5395/* ffestb_R5221_ -- "SAVE" [COLONCOLON] 5396 5397 return ffestb_R5221_; // to lexer 5398 5399 Handle NAME or SLASH. */ 5400 5401static ffelexHandler 5402ffestb_R5221_ (ffelexToken t) 5403{ 5404 switch (ffelex_token_type (t)) 5405 { 5406 case FFELEX_typeNAME: 5407 ffestb_local_.R522.is_cblock = FALSE; 5408 ffesta_tokens[1] = ffelex_token_use (t); 5409 return (ffelexHandler) ffestb_R5224_; 5410 5411 case FFELEX_typeSLASH: 5412 ffestb_local_.R522.is_cblock = TRUE; 5413 return (ffelexHandler) ffestb_R5222_; 5414 5415 default: 5416 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t); 5417 break; 5418 } 5419 5420 if (!ffesta_is_inhibited ()) 5421 ffestc_R522finish (); 5422 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 5423} 5424 5425/* ffestb_R5222_ -- "SAVE" [COLONCOLON] SLASH 5426 5427 return ffestb_R5222_; // to lexer 5428 5429 Handle NAME. */ 5430 5431static ffelexHandler 5432ffestb_R5222_ (ffelexToken t) 5433{ 5434 switch (ffelex_token_type (t)) 5435 { 5436 case FFELEX_typeNAME: 5437 ffesta_tokens[1] = ffelex_token_use (t); 5438 return (ffelexHandler) ffestb_R5223_; 5439 5440 default: 5441 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t); 5442 break; 5443 } 5444 5445 if (!ffesta_is_inhibited ()) 5446 ffestc_R522finish (); 5447 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 5448} 5449 5450/* ffestb_R5223_ -- "SAVE" [COLONCOLON] SLASH NAME 5451 5452 return ffestb_R5223_; // to lexer 5453 5454 Handle SLASH. */ 5455 5456static ffelexHandler 5457ffestb_R5223_ (ffelexToken t) 5458{ 5459 switch (ffelex_token_type (t)) 5460 { 5461 case FFELEX_typeSLASH: 5462 return (ffelexHandler) ffestb_R5224_; 5463 5464 default: 5465 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t); 5466 break; 5467 } 5468 5469 if (!ffesta_is_inhibited ()) 5470 ffestc_R522finish (); 5471 ffelex_token_kill (ffesta_tokens[1]); 5472 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 5473} 5474 5475/* ffestb_R5224_ -- "SAVE" [COLONCOLON] R523 5476 5477 return ffestb_R5224_; // to lexer 5478 5479 Handle COMMA or EOS/SEMICOLON. */ 5480 5481static ffelexHandler 5482ffestb_R5224_ (ffelexToken t) 5483{ 5484 switch (ffelex_token_type (t)) 5485 { 5486 case FFELEX_typeCOMMA: 5487 if (!ffesta_is_inhibited ()) 5488 { 5489 if (ffestb_local_.R522.is_cblock) 5490 ffestc_R522item_cblock (ffesta_tokens[1]); 5491 else 5492 ffestc_R522item_object (ffesta_tokens[1]); 5493 } 5494 ffelex_token_kill (ffesta_tokens[1]); 5495 return (ffelexHandler) ffestb_R5221_; 5496 5497 case FFELEX_typeEOS: 5498 case FFELEX_typeSEMICOLON: 5499 if (!ffesta_is_inhibited ()) 5500 { 5501 if (ffestb_local_.R522.is_cblock) 5502 ffestc_R522item_cblock (ffesta_tokens[1]); 5503 else 5504 ffestc_R522item_object (ffesta_tokens[1]); 5505 ffestc_R522finish (); 5506 } 5507 ffelex_token_kill (ffesta_tokens[1]); 5508 return (ffelexHandler) ffesta_zero (t); 5509 5510 default: 5511 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t); 5512 break; 5513 } 5514 5515 if (!ffesta_is_inhibited ()) 5516 ffestc_R522finish (); 5517 ffelex_token_kill (ffesta_tokens[1]); 5518 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 5519} 5520 5521/* ffestb_R528 -- Parse the DATA statement 5522 5523 return ffestb_R528; // to lexer 5524 5525 Make sure the statement has a valid form for the DATA statement. If it 5526 does, implement the statement. */ 5527 5528ffelexHandler 5529ffestb_R528 (ffelexToken t) 5530{ 5531 unsigned const char *p; 5532 ffeTokenLength i; 5533 ffelexToken nt; 5534 ffelexHandler next; 5535 5536 switch (ffelex_token_type (ffesta_tokens[0])) 5537 { 5538 case FFELEX_typeNAME: 5539 if (ffesta_first_kw != FFESTR_firstDATA) 5540 goto bad_0; /* :::::::::::::::::::: */ 5541 switch (ffelex_token_type (t)) 5542 { 5543 case FFELEX_typeCOMMA: 5544 case FFELEX_typeEOS: 5545 case FFELEX_typeSEMICOLON: 5546 case FFELEX_typeSLASH: 5547 case FFELEX_typeCOLONCOLON: 5548 ffesta_confirmed (); /* Error, but clearly intended. */ 5549 goto bad_1; /* :::::::::::::::::::: */ 5550 5551 default: 5552 goto bad_1; /* :::::::::::::::::::: */ 5553 5554 case FFELEX_typeNAME: 5555 ffesta_confirmed (); 5556 break; 5557 5558 case FFELEX_typeOPEN_PAREN: 5559 break; 5560 } 5561 ffestb_local_.data.started = FALSE; 5562 return (ffelexHandler) (*((ffelexHandler) 5563 ffeexpr_lhs (ffesta_output_pool, 5564 FFEEXPR_contextDATA, 5565 (ffeexprCallback) ffestb_R5281_))) 5566 (t); 5567 5568 case FFELEX_typeNAMES: 5569 if (ffesta_first_kw != FFESTR_firstDATA) 5570 goto bad_0; /* :::::::::::::::::::: */ 5571 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDATA); 5572 switch (ffelex_token_type (t)) 5573 { 5574 case FFELEX_typeEOS: 5575 case FFELEX_typeSEMICOLON: 5576 case FFELEX_typeCOLONCOLON: 5577 ffesta_confirmed (); /* Error, but clearly intended. */ 5578 goto bad_1; /* :::::::::::::::::::: */ 5579 5580 default: 5581 goto bad_1; /* :::::::::::::::::::: */ 5582 5583 case FFELEX_typeOPEN_PAREN: 5584 if (*p == '\0') 5585 { 5586 ffestb_local_.data.started = FALSE; 5587 return (ffelexHandler) (*((ffelexHandler) 5588 ffeexpr_lhs (ffesta_output_pool, 5589 FFEEXPR_contextDATA, 5590 (ffeexprCallback) 5591 ffestb_R5281_))) 5592 (t); 5593 } 5594 break; 5595 5596 case FFELEX_typeCOMMA: 5597 case FFELEX_typeSLASH: 5598 ffesta_confirmed (); 5599 break; 5600 } 5601 if (!ffesrc_is_name_init (*p)) 5602 goto bad_i; /* :::::::::::::::::::: */ 5603 ffestb_local_.data.started = FALSE; 5604 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); 5605 next = (ffelexHandler) (*((ffelexHandler) 5606 ffeexpr_lhs (ffesta_output_pool, 5607 FFEEXPR_contextDATA, 5608 (ffeexprCallback) ffestb_R5281_))) 5609 (nt); 5610 ffelex_token_kill (nt); 5611 return (ffelexHandler) (*next) (t); 5612 5613 default: 5614 goto bad_0; /* :::::::::::::::::::: */ 5615 } 5616 5617bad_0: /* :::::::::::::::::::: */ 5618 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", ffesta_tokens[0]); 5619 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 5620 5621bad_1: /* :::::::::::::::::::: */ 5622 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t); 5623 return (ffelexHandler) ffelex_swallow_tokens (t, 5624 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 5625 5626bad_i: /* :::::::::::::::::::: */ 5627 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DATA", ffesta_tokens[0], i, t); 5628 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 5629} 5630 5631/* ffestb_R5281_ -- "DATA" expr-list 5632 5633 (ffestb_R5281_) // to expression handler 5634 5635 Handle COMMA or SLASH. */ 5636 5637static ffelexHandler 5638ffestb_R5281_ (ffelexToken ft, ffebld expr, ffelexToken t) 5639{ 5640 switch (ffelex_token_type (t)) 5641 { 5642 case FFELEX_typeCOMMA: 5643 ffesta_confirmed (); 5644 if (expr == NULL) 5645 break; 5646 if (!ffesta_is_inhibited ()) 5647 { 5648 if (!ffestb_local_.data.started) 5649 { 5650 ffestc_R528_start (); 5651 ffestb_local_.data.started = TRUE; 5652 } 5653 ffestc_R528_item_object (expr, ft); 5654 } 5655 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 5656 FFEEXPR_contextDATA, 5657 (ffeexprCallback) ffestb_R5281_); 5658 5659 case FFELEX_typeSLASH: 5660 ffesta_confirmed (); 5661 if (expr == NULL) 5662 break; 5663 if (!ffesta_is_inhibited ()) 5664 { 5665 if (!ffestb_local_.data.started) 5666 { 5667 ffestc_R528_start (); 5668 ffestb_local_.data.started = TRUE; 5669 } 5670 ffestc_R528_item_object (expr, ft); 5671 ffestc_R528_item_startvals (); 5672 } 5673 return (ffelexHandler) ffeexpr_rhs 5674 (ffesta_output_pool, FFEEXPR_contextDATA, 5675 (ffeexprCallback) ffestb_R5282_); 5676 5677 default: 5678 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t); 5679 break; 5680 } 5681 5682 if (ffestb_local_.data.started && !ffesta_is_inhibited ()) 5683 ffestc_R528_finish (); 5684 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 5685} 5686 5687/* ffestb_R5282_ -- "DATA" expr-list SLASH expr-list 5688 5689 (ffestb_R5282_) // to expression handler 5690 5691 Handle ASTERISK, COMMA, or SLASH. */ 5692 5693static ffelexHandler 5694ffestb_R5282_ (ffelexToken ft, ffebld expr, ffelexToken t) 5695{ 5696 switch (ffelex_token_type (t)) 5697 { 5698 case FFELEX_typeCOMMA: 5699 if (expr == NULL) 5700 break; 5701 if (!ffesta_is_inhibited ()) 5702 ffestc_R528_item_value (NULL, NULL, expr, ft); 5703 return (ffelexHandler) ffeexpr_rhs 5704 (ffesta_output_pool, FFEEXPR_contextDATA, 5705 (ffeexprCallback) ffestb_R5282_); 5706 5707 case FFELEX_typeASTERISK: 5708 if (expr == NULL) 5709 break; 5710 ffestb_local_.data.expr = ffeexpr_convert (expr, ft, t, 5711 FFEINFO_basictypeINTEGER, 5712 FFEINFO_kindtypeINTEGER1, 5713 0, 5714 FFETARGET_charactersizeNONE, 5715 FFEEXPR_contextLET); 5716 ffesta_tokens[1] = ffelex_token_use (ft); 5717 return (ffelexHandler) ffeexpr_rhs 5718 (ffesta_output_pool, FFEEXPR_contextDATA, 5719 (ffeexprCallback) ffestb_R5283_); 5720 5721 case FFELEX_typeSLASH: 5722 if (expr == NULL) 5723 break; 5724 if (!ffesta_is_inhibited ()) 5725 { 5726 ffestc_R528_item_value (NULL, NULL, expr, ft); 5727 ffestc_R528_item_endvals (t); 5728 } 5729 return (ffelexHandler) ffestb_R5284_; 5730 5731 default: 5732 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t); 5733 break; 5734 } 5735 5736 if (!ffesta_is_inhibited ()) 5737 { 5738 ffestc_R528_item_endvals (t); 5739 ffestc_R528_finish (); 5740 } 5741 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 5742} 5743 5744/* ffestb_R5283_ -- "DATA" expr-list SLASH expr ASTERISK expr 5745 5746 (ffestb_R5283_) // to expression handler 5747 5748 Handle COMMA or SLASH. */ 5749 5750static ffelexHandler 5751ffestb_R5283_ (ffelexToken ft, ffebld expr, ffelexToken t) 5752{ 5753 switch (ffelex_token_type (t)) 5754 { 5755 case FFELEX_typeCOMMA: 5756 if (expr == NULL) 5757 break; 5758 if (!ffesta_is_inhibited ()) 5759 ffestc_R528_item_value (ffestb_local_.data.expr, ffesta_tokens[1], 5760 expr, ft); 5761 ffelex_token_kill (ffesta_tokens[1]); 5762 return (ffelexHandler) ffeexpr_rhs 5763 (ffesta_output_pool, FFEEXPR_contextDATA, 5764 (ffeexprCallback) ffestb_R5282_); 5765 5766 case FFELEX_typeSLASH: 5767 if (expr == NULL) 5768 break; 5769 if (!ffesta_is_inhibited ()) 5770 { 5771 ffestc_R528_item_value (ffestb_local_.data.expr, ffesta_tokens[1], 5772 expr, ft); 5773 ffestc_R528_item_endvals (t); 5774 } 5775 ffelex_token_kill (ffesta_tokens[1]); 5776 return (ffelexHandler) ffestb_R5284_; 5777 5778 default: 5779 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t); 5780 break; 5781 } 5782 5783 if (!ffesta_is_inhibited ()) 5784 { 5785 ffestc_R528_item_endvals (t); 5786 ffestc_R528_finish (); 5787 } 5788 ffelex_token_kill (ffesta_tokens[1]); 5789 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 5790} 5791 5792/* ffestb_R5284_ -- "DATA" expr-list SLASH expr-list SLASH 5793 5794 return ffestb_R5284_; // to lexer 5795 5796 Handle [COMMA] NAME or EOS/SEMICOLON. */ 5797 5798static ffelexHandler 5799ffestb_R5284_ (ffelexToken t) 5800{ 5801 switch (ffelex_token_type (t)) 5802 { 5803 case FFELEX_typeCOMMA: 5804 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 5805 FFEEXPR_contextDATA, 5806 (ffeexprCallback) ffestb_R5281_); 5807 5808 case FFELEX_typeNAME: 5809 case FFELEX_typeOPEN_PAREN: 5810 return (ffelexHandler) (*((ffelexHandler) 5811 ffeexpr_lhs (ffesta_output_pool, 5812 FFEEXPR_contextDATA, 5813 (ffeexprCallback) ffestb_R5281_))) 5814 (t); 5815 5816 case FFELEX_typeEOS: 5817 case FFELEX_typeSEMICOLON: 5818 if (!ffesta_is_inhibited ()) 5819 ffestc_R528_finish (); 5820 return (ffelexHandler) ffesta_zero (t); 5821 5822 default: 5823 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t); 5824 break; 5825 } 5826 5827 if (!ffesta_is_inhibited ()) 5828 ffestc_R528_finish (); 5829 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 5830} 5831 5832/* ffestb_R537 -- Parse a PARAMETER statement 5833 5834 return ffestb_R537; // to lexer 5835 5836 Make sure the statement has a valid form for an PARAMETER statement. 5837 If it does, implement the statement. */ 5838 5839ffelexHandler 5840ffestb_R537 (ffelexToken t) 5841{ 5842 switch (ffelex_token_type (ffesta_tokens[0])) 5843 { 5844 case FFELEX_typeNAME: 5845 if (ffesta_first_kw != FFESTR_firstPARAMETER) 5846 goto bad_0; /* :::::::::::::::::::: */ 5847 break; 5848 5849 case FFELEX_typeNAMES: 5850 if (ffesta_first_kw != FFESTR_firstPARAMETER) 5851 goto bad_0; /* :::::::::::::::::::: */ 5852 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlPARAMETER) 5853 goto bad_0; /* :::::::::::::::::::: */ 5854 break; 5855 5856 default: 5857 goto bad_0; /* :::::::::::::::::::: */ 5858 } 5859 5860 switch (ffelex_token_type (t)) 5861 { 5862 case FFELEX_typeOPEN_PAREN: 5863 break; 5864 5865 case FFELEX_typeEOS: 5866 case FFELEX_typeSEMICOLON: 5867 case FFELEX_typeCOMMA: 5868 case FFELEX_typeCOLONCOLON: 5869 ffesta_confirmed (); /* Error, but clearly intended. */ 5870 goto bad_1; /* :::::::::::::::::::: */ 5871 5872 default: 5873 goto bad_1; /* :::::::::::::::::::: */ 5874 } 5875 5876 ffestb_local_.parameter.started = FALSE; 5877 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 5878 FFEEXPR_contextPARAMETER, 5879 (ffeexprCallback) ffestb_R5371_); 5880 5881bad_0: /* :::::::::::::::::::: */ 5882 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", ffesta_tokens[0]); 5883 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 5884 5885bad_1: /* :::::::::::::::::::: */ 5886 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t); 5887 return (ffelexHandler) ffelex_swallow_tokens (t, 5888 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 5889} 5890 5891/* ffestb_R5371_ -- "PARAMETER" OPEN_PAREN expr 5892 5893 (ffestb_R5371_) // to expression handler 5894 5895 Make sure the next token is EQUALS. */ 5896 5897static ffelexHandler 5898ffestb_R5371_ (ffelexToken ft, ffebld expr, ffelexToken t) 5899{ 5900 ffestb_local_.parameter.expr = expr; 5901 5902 switch (ffelex_token_type (t)) 5903 { 5904 case FFELEX_typeEQUALS: 5905 ffesta_confirmed (); 5906 if (expr == NULL) 5907 break; 5908 ffesta_tokens[1] = ffelex_token_use (ft); 5909 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 5910 FFEEXPR_contextPARAMETER, (ffeexprCallback) ffestb_R5372_); 5911 5912 default: 5913 break; 5914 } 5915 5916 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t); 5917 if (ffestb_local_.parameter.started) 5918 ffestc_R537_finish (); 5919 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 5920} 5921 5922/* ffestb_R5372_ -- "PARAMETER" OPEN_PAREN expr EQUALS expr 5923 5924 (ffestb_R5372_) // to expression handler 5925 5926 Make sure the next token is COMMA or CLOSE_PAREN. */ 5927 5928static ffelexHandler 5929ffestb_R5372_ (ffelexToken ft, ffebld expr, ffelexToken t) 5930{ 5931 switch (ffelex_token_type (t)) 5932 { 5933 case FFELEX_typeCOMMA: 5934 if (expr == NULL) 5935 break; 5936 if (!ffesta_is_inhibited ()) 5937 { 5938 if (!ffestb_local_.parameter.started) 5939 { 5940 ffestc_R537_start (); 5941 ffestb_local_.parameter.started = TRUE; 5942 } 5943 ffestc_R537_item (ffestb_local_.parameter.expr, ffesta_tokens[1], 5944 expr, ft); 5945 } 5946 ffelex_token_kill (ffesta_tokens[1]); 5947 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 5948 FFEEXPR_contextPARAMETER, 5949 (ffeexprCallback) ffestb_R5371_); 5950 5951 case FFELEX_typeCLOSE_PAREN: 5952 if (expr == NULL) 5953 break; 5954 if (!ffesta_is_inhibited ()) 5955 { 5956 if (!ffestb_local_.parameter.started) 5957 { 5958 ffestc_R537_start (); 5959 ffestb_local_.parameter.started = TRUE; 5960 } 5961 ffestc_R537_item (ffestb_local_.parameter.expr, ffesta_tokens[1], 5962 expr, ft); 5963 ffestc_R537_finish (); 5964 } 5965 ffelex_token_kill (ffesta_tokens[1]); 5966 return (ffelexHandler) ffestb_R5373_; 5967 5968 default: 5969 break; 5970 } 5971 5972 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t); 5973 if (ffestb_local_.parameter.started) 5974 ffestc_R537_finish (); 5975 ffelex_token_kill (ffesta_tokens[1]); 5976 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 5977} 5978 5979/* ffestb_R5373_ -- "PARAMETER" OPEN_PAREN expr EQUALS expr CLOSE_PAREN 5980 5981 return ffestb_R5373_; // to lexer 5982 5983 Make sure the next token is EOS or SEMICOLON, or generate an error. All 5984 cleanup has already been done, by the way. */ 5985 5986static ffelexHandler 5987ffestb_R5373_ (ffelexToken t) 5988{ 5989 switch (ffelex_token_type (t)) 5990 { 5991 case FFELEX_typeEOS: 5992 case FFELEX_typeSEMICOLON: 5993 return (ffelexHandler) ffesta_zero (t); 5994 5995 default: 5996 break; 5997 } 5998 5999 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t); 6000 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 6001} 6002 6003/* ffestb_R542 -- Parse the NAMELIST statement 6004 6005 return ffestb_R542; // to lexer 6006 6007 Make sure the statement has a valid form for the NAMELIST statement. If it 6008 does, implement the statement. */ 6009 6010ffelexHandler 6011ffestb_R542 (ffelexToken t) 6012{ 6013 const char *p; 6014 ffeTokenLength i; 6015 6016 switch (ffelex_token_type (ffesta_tokens[0])) 6017 { 6018 case FFELEX_typeNAME: 6019 if (ffesta_first_kw != FFESTR_firstNAMELIST) 6020 goto bad_0; /* :::::::::::::::::::: */ 6021 break; 6022 6023 case FFELEX_typeNAMES: 6024 if (ffesta_first_kw != FFESTR_firstNAMELIST) 6025 goto bad_0; /* :::::::::::::::::::: */ 6026 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlNAMELIST); 6027 if (*p != '\0') 6028 goto bad_i; /* :::::::::::::::::::: */ 6029 break; 6030 6031 default: 6032 goto bad_0; /* :::::::::::::::::::: */ 6033 } 6034 6035 switch (ffelex_token_type (t)) 6036 { 6037 case FFELEX_typeCOMMA: 6038 case FFELEX_typeEOS: 6039 case FFELEX_typeSEMICOLON: 6040 case FFELEX_typeCOLONCOLON: 6041 ffesta_confirmed (); /* Error, but clearly intended. */ 6042 goto bad_1; /* :::::::::::::::::::: */ 6043 6044 default: 6045 goto bad_1; /* :::::::::::::::::::: */ 6046 6047 case FFELEX_typeSLASH: 6048 break; 6049 } 6050 6051 ffesta_confirmed (); 6052 if (!ffesta_is_inhibited ()) 6053 ffestc_R542_start (); 6054 return (ffelexHandler) ffestb_R5421_; 6055 6056bad_0: /* :::::::::::::::::::: */ 6057 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", ffesta_tokens[0]); 6058 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 6059 6060bad_1: /* :::::::::::::::::::: */ 6061 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t); 6062 return (ffelexHandler) ffelex_swallow_tokens (t, 6063 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 6064 6065bad_i: /* :::::::::::::::::::: */ 6066 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "NAMELIST", ffesta_tokens[0], i, t); 6067 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 6068} 6069 6070/* ffestb_R5421_ -- "NAMELIST" SLASH 6071 6072 return ffestb_R5421_; // to lexer 6073 6074 Handle NAME. */ 6075 6076static ffelexHandler 6077ffestb_R5421_ (ffelexToken t) 6078{ 6079 switch (ffelex_token_type (t)) 6080 { 6081 case FFELEX_typeNAME: 6082 if (!ffesta_is_inhibited ()) 6083 ffestc_R542_item_nlist (t); 6084 return (ffelexHandler) ffestb_R5422_; 6085 6086 default: 6087 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t); 6088 break; 6089 } 6090 6091 if (!ffesta_is_inhibited ()) 6092 ffestc_R542_finish (); 6093 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 6094} 6095 6096/* ffestb_R5422_ -- "NAMELIST" SLASH NAME 6097 6098 return ffestb_R5422_; // to lexer 6099 6100 Handle SLASH. */ 6101 6102static ffelexHandler 6103ffestb_R5422_ (ffelexToken t) 6104{ 6105 switch (ffelex_token_type (t)) 6106 { 6107 case FFELEX_typeSLASH: 6108 return (ffelexHandler) ffestb_R5423_; 6109 6110 default: 6111 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t); 6112 break; 6113 } 6114 6115 if (!ffesta_is_inhibited ()) 6116 ffestc_R542_finish (); 6117 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 6118} 6119 6120/* ffestb_R5423_ -- "NAMELIST" SLASH NAME SLASH 6121 6122 return ffestb_R5423_; // to lexer 6123 6124 Handle NAME. */ 6125 6126static ffelexHandler 6127ffestb_R5423_ (ffelexToken t) 6128{ 6129 switch (ffelex_token_type (t)) 6130 { 6131 case FFELEX_typeNAME: 6132 if (!ffesta_is_inhibited ()) 6133 ffestc_R542_item_nitem (t); 6134 return (ffelexHandler) ffestb_R5424_; 6135 6136 default: 6137 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t); 6138 break; 6139 } 6140 6141 if (!ffesta_is_inhibited ()) 6142 ffestc_R542_finish (); 6143 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 6144} 6145 6146/* ffestb_R5424_ -- "NAMELIST" SLASH NAME SLASH NAME 6147 6148 return ffestb_R5424_; // to lexer 6149 6150 Handle COMMA, EOS/SEMICOLON, or SLASH. */ 6151 6152static ffelexHandler 6153ffestb_R5424_ (ffelexToken t) 6154{ 6155 switch (ffelex_token_type (t)) 6156 { 6157 case FFELEX_typeCOMMA: 6158 return (ffelexHandler) ffestb_R5425_; 6159 6160 case FFELEX_typeEOS: 6161 case FFELEX_typeSEMICOLON: 6162 if (!ffesta_is_inhibited ()) 6163 ffestc_R542_finish (); 6164 return (ffelexHandler) ffesta_zero (t); 6165 6166 case FFELEX_typeSLASH: 6167 return (ffelexHandler) ffestb_R5421_; 6168 6169 default: 6170 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t); 6171 break; 6172 } 6173 6174 if (!ffesta_is_inhibited ()) 6175 ffestc_R542_finish (); 6176 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 6177} 6178 6179/* ffestb_R5425_ -- "NAMELIST" SLASH NAME SLASH NAME COMMA 6180 6181 return ffestb_R5425_; // to lexer 6182 6183 Handle NAME or SLASH. */ 6184 6185static ffelexHandler 6186ffestb_R5425_ (ffelexToken t) 6187{ 6188 switch (ffelex_token_type (t)) 6189 { 6190 case FFELEX_typeNAME: 6191 if (!ffesta_is_inhibited ()) 6192 ffestc_R542_item_nitem (t); 6193 return (ffelexHandler) ffestb_R5424_; 6194 6195 case FFELEX_typeSLASH: 6196 return (ffelexHandler) ffestb_R5421_; 6197 6198 default: 6199 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t); 6200 break; 6201 } 6202 6203 if (!ffesta_is_inhibited ()) 6204 ffestc_R542_finish (); 6205 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 6206} 6207 6208/* ffestb_R544 -- Parse an EQUIVALENCE statement 6209 6210 return ffestb_R544; // to lexer 6211 6212 Make sure the statement has a valid form for an EQUIVALENCE statement. 6213 If it does, implement the statement. */ 6214 6215ffelexHandler 6216ffestb_R544 (ffelexToken t) 6217{ 6218 switch (ffelex_token_type (ffesta_tokens[0])) 6219 { 6220 case FFELEX_typeNAME: 6221 if (ffesta_first_kw != FFESTR_firstEQUIVALENCE) 6222 goto bad_0; /* :::::::::::::::::::: */ 6223 break; 6224 6225 case FFELEX_typeNAMES: 6226 if (ffesta_first_kw != FFESTR_firstEQUIVALENCE) 6227 goto bad_0; /* :::::::::::::::::::: */ 6228 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlEQUIVALENCE) 6229 goto bad_0; /* :::::::::::::::::::: */ 6230 break; 6231 6232 default: 6233 goto bad_0; /* :::::::::::::::::::: */ 6234 } 6235 6236 switch (ffelex_token_type (t)) 6237 { 6238 case FFELEX_typeOPEN_PAREN: 6239 break; 6240 6241 case FFELEX_typeEOS: 6242 case FFELEX_typeSEMICOLON: 6243 case FFELEX_typeCOMMA: 6244 case FFELEX_typeCOLONCOLON: 6245 ffesta_confirmed (); /* Error, but clearly intended. */ 6246 goto bad_1; /* :::::::::::::::::::: */ 6247 6248 default: 6249 goto bad_1; /* :::::::::::::::::::: */ 6250 } 6251 6252 ffestb_local_.equivalence.started = FALSE; 6253 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 6254 FFEEXPR_contextEQUIVALENCE, 6255 (ffeexprCallback) ffestb_R5441_); 6256 6257bad_0: /* :::::::::::::::::::: */ 6258 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", ffesta_tokens[0]); 6259 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 6260 6261bad_1: /* :::::::::::::::::::: */ 6262 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t); 6263 return (ffelexHandler) ffelex_swallow_tokens (t, 6264 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 6265} 6266 6267/* ffestb_R5441_ -- "EQUIVALENCE" OPEN_PAREN expr 6268 6269 (ffestb_R5441_) // to expression handler 6270 6271 Make sure the next token is COMMA. */ 6272 6273static ffelexHandler 6274ffestb_R5441_ (ffelexToken ft, ffebld expr, ffelexToken t) 6275{ 6276 switch (ffelex_token_type (t)) 6277 { 6278 case FFELEX_typeCOMMA: 6279 if (expr == NULL) 6280 break; 6281 ffestb_local_.equivalence.exprs = ffestt_exprlist_create (); 6282 ffestt_exprlist_append (ffestb_local_.equivalence.exprs, expr, 6283 ffelex_token_use (ft)); 6284 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 6285 FFEEXPR_contextEQUIVALENCE, 6286 (ffeexprCallback) ffestb_R5442_); 6287 6288 default: 6289 break; 6290 } 6291 6292 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t); 6293 if (ffestb_local_.equivalence.started) 6294 ffestc_R544_finish (); 6295 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 6296} 6297 6298/* ffestb_R5442_ -- "EQUIVALENCE" OPEN_PAREN expr COMMA expr 6299 6300 (ffestb_R5442_) // to expression handler 6301 6302 Make sure the next token is COMMA or CLOSE_PAREN. For COMMA, we just 6303 append the expression to our list and continue; for CLOSE_PAREN, we 6304 append the expression and move to _3_. */ 6305 6306static ffelexHandler 6307ffestb_R5442_ (ffelexToken ft, ffebld expr, ffelexToken t) 6308{ 6309 switch (ffelex_token_type (t)) 6310 { 6311 case FFELEX_typeCOMMA: 6312 if (expr == NULL) 6313 break; 6314 ffestt_exprlist_append (ffestb_local_.equivalence.exprs, expr, 6315 ffelex_token_use (ft)); 6316 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 6317 FFEEXPR_contextEQUIVALENCE, 6318 (ffeexprCallback) ffestb_R5442_); 6319 6320 case FFELEX_typeCLOSE_PAREN: 6321 if (expr == NULL) 6322 break; 6323 ffestt_exprlist_append (ffestb_local_.equivalence.exprs, expr, 6324 ffelex_token_use (ft)); 6325 return (ffelexHandler) ffestb_R5443_; 6326 6327 default: 6328 break; 6329 } 6330 6331 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t); 6332 if (ffestb_local_.equivalence.started) 6333 ffestc_R544_finish (); 6334 ffestt_exprlist_kill (ffestb_local_.equivalence.exprs); 6335 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 6336} 6337 6338/* ffestb_R5443_ -- "EQUIVALENCE" OPEN_PAREN expr COMMA expr CLOSE_PAREN 6339 6340 return ffestb_R5443_; // to lexer 6341 6342 Make sure the next token is COMMA or EOS/SEMICOLON. */ 6343 6344static ffelexHandler 6345ffestb_R5443_ (ffelexToken t) 6346{ 6347 switch (ffelex_token_type (t)) 6348 { 6349 case FFELEX_typeCOMMA: 6350 ffesta_confirmed (); 6351 if (!ffesta_is_inhibited ()) 6352 { 6353 if (!ffestb_local_.equivalence.started) 6354 { 6355 ffestc_R544_start (); 6356 ffestb_local_.equivalence.started = TRUE; 6357 } 6358 ffestc_R544_item (ffestb_local_.equivalence.exprs); 6359 } 6360 ffestt_exprlist_kill (ffestb_local_.equivalence.exprs); 6361 return (ffelexHandler) ffestb_R5444_; 6362 6363 case FFELEX_typeEOS: 6364 case FFELEX_typeSEMICOLON: 6365 ffesta_confirmed (); 6366 if (!ffesta_is_inhibited ()) 6367 { 6368 if (!ffestb_local_.equivalence.started) 6369 { 6370 ffestc_R544_start (); 6371 ffestb_local_.equivalence.started = TRUE; 6372 } 6373 ffestc_R544_item (ffestb_local_.equivalence.exprs); 6374 ffestc_R544_finish (); 6375 } 6376 ffestt_exprlist_kill (ffestb_local_.equivalence.exprs); 6377 return (ffelexHandler) ffesta_zero (t); 6378 6379 default: 6380 break; 6381 } 6382 6383 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t); 6384 if (ffestb_local_.equivalence.started) 6385 ffestc_R544_finish (); 6386 ffestt_exprlist_kill (ffestb_local_.equivalence.exprs); 6387 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 6388} 6389 6390/* ffestb_R5444_ -- "EQUIVALENCE" OPEN_PAREN expr COMMA expr CLOSE_PAREN COMMA 6391 6392 return ffestb_R5444_; // to lexer 6393 6394 Make sure the next token is OPEN_PAREN, or generate an error. */ 6395 6396static ffelexHandler 6397ffestb_R5444_ (ffelexToken t) 6398{ 6399 switch (ffelex_token_type (t)) 6400 { 6401 case FFELEX_typeOPEN_PAREN: 6402 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 6403 FFEEXPR_contextEQUIVALENCE, 6404 (ffeexprCallback) ffestb_R5441_); 6405 6406 default: 6407 break; 6408 } 6409 6410 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t); 6411 if (ffestb_local_.equivalence.started) 6412 ffestc_R544_finish (); 6413 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 6414} 6415 6416/* ffestb_R834 -- Parse the CYCLE statement 6417 6418 return ffestb_R834; // to lexer 6419 6420 Make sure the statement has a valid form for the CYCLE statement. If 6421 it does, implement the statement. */ 6422 6423ffelexHandler 6424ffestb_R834 (ffelexToken t) 6425{ 6426 ffeTokenLength i; 6427 unsigned const char *p; 6428 6429 switch (ffelex_token_type (ffesta_tokens[0])) 6430 { 6431 case FFELEX_typeNAME: 6432 if (ffesta_first_kw != FFESTR_firstCYCLE) 6433 goto bad_0; /* :::::::::::::::::::: */ 6434 switch (ffelex_token_type (t)) 6435 { 6436 case FFELEX_typeCOMMA: 6437 case FFELEX_typeCOLONCOLON: 6438 ffesta_confirmed (); /* Error, but clearly intended. */ 6439 goto bad_1; /* :::::::::::::::::::: */ 6440 6441 default: 6442 goto bad_1; /* :::::::::::::::::::: */ 6443 6444 case FFELEX_typeNAME: 6445 ffesta_confirmed (); 6446 ffesta_tokens[1] = ffelex_token_use (t); 6447 return (ffelexHandler) ffestb_R8341_; 6448 6449 case FFELEX_typeEOS: 6450 case FFELEX_typeSEMICOLON: 6451 ffesta_confirmed (); 6452 ffesta_tokens[1] = NULL; 6453 return (ffelexHandler) ffestb_R8341_ (t); 6454 } 6455 6456 case FFELEX_typeNAMES: 6457 if (ffesta_first_kw != FFESTR_firstCYCLE) 6458 goto bad_0; /* :::::::::::::::::::: */ 6459 switch (ffelex_token_type (t)) 6460 { 6461 default: 6462 goto bad_1; /* :::::::::::::::::::: */ 6463 6464 case FFELEX_typeEOS: 6465 case FFELEX_typeSEMICOLON: 6466 break; 6467 } 6468 ffesta_confirmed (); 6469 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCYCLE); 6470 if (*p == '\0') 6471 { 6472 ffesta_tokens[1] = NULL; 6473 } 6474 else 6475 { 6476 if (!ffesrc_is_name_init (*p)) 6477 goto bad_i; /* :::::::::::::::::::: */ 6478 ffesta_tokens[1] 6479 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); 6480 } 6481 return (ffelexHandler) ffestb_R8341_ (t); 6482 6483 default: 6484 goto bad_0; /* :::::::::::::::::::: */ 6485 } 6486 6487bad_0: /* :::::::::::::::::::: */ 6488 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CYCLE", ffesta_tokens[0]); 6489 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 6490 6491bad_1: /* :::::::::::::::::::: */ 6492 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CYCLE", t); 6493 return (ffelexHandler) ffelex_swallow_tokens (t, 6494 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 6495 6496bad_i: /* :::::::::::::::::::: */ 6497 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CYCLE", ffesta_tokens[0], i, t); 6498 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 6499} 6500 6501/* ffestb_R8341_ -- "CYCLE" [NAME] 6502 6503 return ffestb_R8341_; // to lexer 6504 6505 Make sure the next token is an EOS or SEMICOLON. */ 6506 6507static ffelexHandler 6508ffestb_R8341_ (ffelexToken t) 6509{ 6510 switch (ffelex_token_type (t)) 6511 { 6512 case FFELEX_typeEOS: 6513 case FFELEX_typeSEMICOLON: 6514 ffesta_confirmed (); 6515 if (!ffesta_is_inhibited ()) 6516 ffestc_R834 (ffesta_tokens[1]); 6517 if (ffesta_tokens[1] != NULL) 6518 ffelex_token_kill (ffesta_tokens[1]); 6519 return (ffelexHandler) ffesta_zero (t); 6520 6521 default: 6522 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CYCLE", t); 6523 break; 6524 } 6525 6526 if (ffesta_tokens[1] != NULL) 6527 ffelex_token_kill (ffesta_tokens[1]); 6528 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 6529} 6530 6531/* ffestb_R835 -- Parse the EXIT statement 6532 6533 return ffestb_R835; // to lexer 6534 6535 Make sure the statement has a valid form for the EXIT statement. If 6536 it does, implement the statement. */ 6537 6538ffelexHandler 6539ffestb_R835 (ffelexToken t) 6540{ 6541 ffeTokenLength i; 6542 unsigned const char *p; 6543 6544 switch (ffelex_token_type (ffesta_tokens[0])) 6545 { 6546 case FFELEX_typeNAME: 6547 if (ffesta_first_kw != FFESTR_firstEXIT) 6548 goto bad_0; /* :::::::::::::::::::: */ 6549 switch (ffelex_token_type (t)) 6550 { 6551 case FFELEX_typeCOMMA: 6552 case FFELEX_typeCOLONCOLON: 6553 ffesta_confirmed (); /* Error, but clearly intended. */ 6554 goto bad_1; /* :::::::::::::::::::: */ 6555 6556 default: 6557 goto bad_1; /* :::::::::::::::::::: */ 6558 6559 case FFELEX_typeNAME: 6560 ffesta_confirmed (); 6561 ffesta_tokens[1] = ffelex_token_use (t); 6562 return (ffelexHandler) ffestb_R8351_; 6563 6564 case FFELEX_typeEOS: 6565 case FFELEX_typeSEMICOLON: 6566 ffesta_confirmed (); 6567 ffesta_tokens[1] = NULL; 6568 return (ffelexHandler) ffestb_R8351_ (t); 6569 } 6570 6571 case FFELEX_typeNAMES: 6572 if (ffesta_first_kw != FFESTR_firstEXIT) 6573 goto bad_0; /* :::::::::::::::::::: */ 6574 switch (ffelex_token_type (t)) 6575 { 6576 default: 6577 goto bad_1; /* :::::::::::::::::::: */ 6578 6579 case FFELEX_typeEOS: 6580 case FFELEX_typeSEMICOLON: 6581 break; 6582 } 6583 ffesta_confirmed (); 6584 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlEXIT); 6585 if (*p == '\0') 6586 { 6587 ffesta_tokens[1] = NULL; 6588 } 6589 else 6590 { 6591 if (!ffesrc_is_name_init (*p)) 6592 goto bad_i; /* :::::::::::::::::::: */ 6593 ffesta_tokens[1] 6594 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); 6595 } 6596 return (ffelexHandler) ffestb_R8351_ (t); 6597 6598 default: 6599 goto bad_0; /* :::::::::::::::::::: */ 6600 } 6601 6602bad_0: /* :::::::::::::::::::: */ 6603 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EXIT", ffesta_tokens[0]); 6604 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 6605 6606bad_1: /* :::::::::::::::::::: */ 6607 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EXIT", t); 6608 return (ffelexHandler) ffelex_swallow_tokens (t, 6609 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 6610 6611bad_i: /* :::::::::::::::::::: */ 6612 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "EXIT", ffesta_tokens[0], i, t); 6613 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 6614} 6615 6616/* ffestb_R8351_ -- "EXIT" [NAME] 6617 6618 return ffestb_R8351_; // to lexer 6619 6620 Make sure the next token is an EOS or SEMICOLON. */ 6621 6622static ffelexHandler 6623ffestb_R8351_ (ffelexToken t) 6624{ 6625 switch (ffelex_token_type (t)) 6626 { 6627 case FFELEX_typeEOS: 6628 case FFELEX_typeSEMICOLON: 6629 ffesta_confirmed (); 6630 if (!ffesta_is_inhibited ()) 6631 ffestc_R835 (ffesta_tokens[1]); 6632 if (ffesta_tokens[1] != NULL) 6633 ffelex_token_kill (ffesta_tokens[1]); 6634 return (ffelexHandler) ffesta_zero (t); 6635 6636 default: 6637 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EXIT", t); 6638 break; 6639 } 6640 6641 if (ffesta_tokens[1] != NULL) 6642 ffelex_token_kill (ffesta_tokens[1]); 6643 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 6644} 6645 6646/* ffestb_R838 -- Parse the ASSIGN statement 6647 6648 return ffestb_R838; // to lexer 6649 6650 Make sure the statement has a valid form for the ASSIGN statement. If it 6651 does, implement the statement. */ 6652 6653ffelexHandler 6654ffestb_R838 (ffelexToken t) 6655{ 6656 unsigned const char *p; 6657 ffeTokenLength i; 6658 ffelexHandler next; 6659 ffelexToken et; /* First token in target. */ 6660 6661 switch (ffelex_token_type (ffesta_tokens[0])) 6662 { 6663 case FFELEX_typeNAME: 6664 if (ffesta_first_kw != FFESTR_firstASSIGN) 6665 goto bad_0; /* :::::::::::::::::::: */ 6666 switch (ffelex_token_type (t)) 6667 { 6668 case FFELEX_typeEOS: 6669 case FFELEX_typeSEMICOLON: 6670 case FFELEX_typeCOMMA: 6671 case FFELEX_typeCOLONCOLON: 6672 ffesta_confirmed (); /* Error, but clearly intended. */ 6673 goto bad_1; /* :::::::::::::::::::: */ 6674 6675 default: 6676 goto bad_1; /* :::::::::::::::::::: */ 6677 6678 case FFELEX_typeNUMBER: 6679 break; 6680 } 6681 ffesta_tokens[1] = ffelex_token_use (t); 6682 ffesta_confirmed (); 6683 return (ffelexHandler) ffestb_R8381_; 6684 6685 case FFELEX_typeNAMES: 6686 if (ffesta_first_kw != FFESTR_firstASSIGN) 6687 goto bad_0; /* :::::::::::::::::::: */ 6688 6689 switch (ffelex_token_type (t)) 6690 { 6691 case FFELEX_typeEOS: 6692 case FFELEX_typeSEMICOLON: 6693 ffesta_confirmed (); 6694 /* Fall through. */ 6695 case FFELEX_typePERCENT: 6696 case FFELEX_typeOPEN_PAREN: 6697 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlASSIGN); 6698 if (! ISDIGIT (*p)) 6699 goto bad_i; /* :::::::::::::::::::: */ 6700 ffesta_tokens[1] 6701 = ffelex_token_number_from_names (ffesta_tokens[0], i); 6702 p += ffelex_token_length (ffesta_tokens[1]); /* Skip to "TO". */ 6703 i += ffelex_token_length (ffesta_tokens[1]); 6704 if (!ffesrc_char_match_init (*p, 'T', 't') /* "TO". */ 6705 || (++i, !ffesrc_char_match_noninit (*++p, 'O', 'o'))) 6706 { 6707 bad_i_1: /* :::::::::::::::::::: */ 6708 ffelex_token_kill (ffesta_tokens[1]); 6709 goto bad_i; /* :::::::::::::::::::: */ 6710 } 6711 ++p, ++i; 6712 if (!ffesrc_is_name_init (*p)) 6713 goto bad_i_1; /* :::::::::::::::::::: */ 6714 et = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); 6715 next = (ffelexHandler) 6716 (*((ffelexHandler) 6717 ffeexpr_lhs (ffesta_output_pool, 6718 FFEEXPR_contextASSIGN, 6719 (ffeexprCallback) 6720 ffestb_R8383_))) 6721 (et); 6722 ffelex_token_kill (et); 6723 return (ffelexHandler) (*next) (t); 6724 6725 case FFELEX_typeCOMMA: 6726 case FFELEX_typeCOLONCOLON: 6727 ffesta_confirmed (); /* Error, but clearly intended. */ 6728 goto bad_1; /* :::::::::::::::::::: */ 6729 6730 default: 6731 goto bad_1; /* :::::::::::::::::::: */ 6732 } 6733 6734 default: 6735 goto bad_0; /* :::::::::::::::::::: */ 6736 } 6737 6738bad_0: /* :::::::::::::::::::: */ 6739 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", ffesta_tokens[0]); 6740 return (ffelexHandler) ffelex_swallow_tokens (t, 6741 (ffelexHandler) ffesta_zero); /* Invalid first token. */ 6742 6743bad_1: /* :::::::::::::::::::: */ 6744 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", t); 6745 return (ffelexHandler) ffelex_swallow_tokens (t, 6746 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 6747 6748bad_i: /* :::::::::::::::::::: */ 6749 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "ASSIGN", ffesta_tokens[0], i, t); 6750 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 6751} 6752 6753/* ffestb_R8381_ -- "ASSIGN" NUMBER 6754 6755 return ffestb_R8381_; // to lexer 6756 6757 Make sure the next token is "TO". */ 6758 6759static ffelexHandler 6760ffestb_R8381_ (ffelexToken t) 6761{ 6762 if ((ffelex_token_type (t) == FFELEX_typeNAME) 6763 && (ffesrc_strcmp_2c (ffe_case_match (), ffelex_token_text (t), "TO", "to", 6764 "To") == 0)) 6765 { 6766 return (ffelexHandler) ffestb_R8382_; 6767 } 6768 6769 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", t); 6770 if (ffelex_token_type (t) == FFELEX_typeNAME) 6771 return (ffelexHandler) ffestb_R8382_ (t); /* Maybe user forgot "TO". */ 6772 6773 ffelex_token_kill (ffesta_tokens[1]); 6774 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 6775} 6776 6777/* ffestb_R8382_ -- "ASSIGN" NUMBER ("TO") 6778 6779 return ffestb_R8382_; // to lexer 6780 6781 Make sure the next token is a name, then pass it along to the expression 6782 evaluator as an LHS expression. The callback function is _3_. */ 6783 6784static ffelexHandler 6785ffestb_R8382_ (ffelexToken t) 6786{ 6787 if (ffelex_token_type (t) == FFELEX_typeNAME) 6788 { 6789 return (ffelexHandler) 6790 (*((ffelexHandler) 6791 ffeexpr_lhs (ffesta_output_pool, FFEEXPR_contextASSIGN, 6792 (ffeexprCallback) ffestb_R8383_))) 6793 (t); 6794 } 6795 6796 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", t); 6797 ffelex_token_kill (ffesta_tokens[1]); 6798 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 6799} 6800 6801/* ffestb_R8383_ -- "ASSIGN" NUMBER ("TO") expression 6802 6803 (ffestb_R8383_) // to expression handler 6804 6805 Make sure the next token is an EOS or SEMICOLON. */ 6806 6807static ffelexHandler 6808ffestb_R8383_ (ffelexToken ft, ffebld expr, ffelexToken t) 6809{ 6810 switch (ffelex_token_type (t)) 6811 { 6812 case FFELEX_typeEOS: 6813 case FFELEX_typeSEMICOLON: 6814 ffesta_confirmed (); 6815 if (expr == NULL) 6816 break; 6817 if (!ffesta_is_inhibited ()) 6818 ffestc_R838 (ffesta_tokens[1], expr, ft); 6819 ffelex_token_kill (ffesta_tokens[1]); 6820 return (ffelexHandler) ffesta_zero (t); 6821 6822 default: 6823 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", t); 6824 break; 6825 } 6826 6827 ffelex_token_kill (ffesta_tokens[1]); 6828 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 6829} 6830 6831/* ffestb_R840 -- Parse an arithmetic-IF statement 6832 6833 return ffestb_R840; // to lexer 6834 6835 Make sure the statement has a valid form for an arithmetic-IF statement. 6836 If it does, implement the statement. */ 6837 6838ffelexHandler 6839ffestb_R840 (ffelexToken t) 6840{ 6841 switch (ffelex_token_type (ffesta_tokens[0])) 6842 { 6843 case FFELEX_typeNAME: 6844 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlIF) 6845 goto bad_0; /* :::::::::::::::::::: */ 6846 if (ffesta_first_kw != FFESTR_firstIF) 6847 goto bad_0; /* :::::::::::::::::::: */ 6848 break; 6849 6850 case FFELEX_typeNAMES: 6851 if (ffesta_first_kw != FFESTR_firstIF) 6852 goto bad_0; /* :::::::::::::::::::: */ 6853 break; 6854 6855 default: 6856 goto bad_0; /* :::::::::::::::::::: */ 6857 } 6858 6859 switch (ffelex_token_type (t)) 6860 { 6861 case FFELEX_typeOPEN_PAREN: 6862 break; 6863 6864 default: 6865 goto bad_1; /* :::::::::::::::::::: */ 6866 } 6867 6868 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextARITHIF, 6869 (ffeexprCallback) ffestb_R8401_); 6870 6871bad_0: /* :::::::::::::::::::: */ 6872 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", ffesta_tokens[0]); 6873 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 6874 6875bad_1: /* :::::::::::::::::::: */ 6876 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t); 6877 return (ffelexHandler) ffelex_swallow_tokens (t, 6878 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 6879} 6880 6881/* ffestb_R8401_ -- "IF" OPEN_PAREN expr 6882 6883 (ffestb_R8401_) // to expression handler 6884 6885 Make sure the next token is CLOSE_PAREN. */ 6886 6887static ffelexHandler 6888ffestb_R8401_ (ffelexToken ft, ffebld expr, ffelexToken t) 6889{ 6890 ffestb_local_.if_stmt.expr = expr; 6891 6892 switch (ffelex_token_type (t)) 6893 { 6894 case FFELEX_typeCLOSE_PAREN: 6895 if (expr == NULL) 6896 break; 6897 ffesta_tokens[1] = ffelex_token_use (ft); 6898 ffelex_set_names (TRUE); /* In case it's a logical IF instead. */ 6899 return (ffelexHandler) ffestb_R8402_; 6900 6901 default: 6902 break; 6903 } 6904 6905 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t); 6906 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 6907} 6908 6909/* ffestb_R8402_ -- "IF" OPEN_PAREN expr CLOSE_PAREN 6910 6911 return ffestb_R8402_; // to lexer 6912 6913 Make sure the next token is NUMBER. */ 6914 6915static ffelexHandler 6916ffestb_R8402_ (ffelexToken t) 6917{ 6918 ffelex_set_names (FALSE); 6919 6920 switch (ffelex_token_type (t)) 6921 { 6922 case FFELEX_typeNUMBER: 6923 ffesta_confirmed (); 6924 ffesta_tokens[2] = ffelex_token_use (t); 6925 return (ffelexHandler) ffestb_R8403_; 6926 6927 default: 6928 break; 6929 } 6930 6931 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t); 6932 ffelex_token_kill (ffesta_tokens[1]); 6933 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 6934} 6935 6936/* ffestb_R8403_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER 6937 6938 return ffestb_R8403_; // to lexer 6939 6940 Make sure the next token is COMMA. */ 6941 6942static ffelexHandler 6943ffestb_R8403_ (ffelexToken t) 6944{ 6945 switch (ffelex_token_type (t)) 6946 { 6947 case FFELEX_typeCOMMA: 6948 return (ffelexHandler) ffestb_R8404_; 6949 6950 default: 6951 break; 6952 } 6953 6954 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t); 6955 ffelex_token_kill (ffesta_tokens[1]); 6956 ffelex_token_kill (ffesta_tokens[2]); 6957 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 6958} 6959 6960/* ffestb_R8404_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER COMMA 6961 6962 return ffestb_R8404_; // to lexer 6963 6964 Make sure the next token is NUMBER. */ 6965 6966static ffelexHandler 6967ffestb_R8404_ (ffelexToken t) 6968{ 6969 switch (ffelex_token_type (t)) 6970 { 6971 case FFELEX_typeNUMBER: 6972 ffesta_tokens[3] = ffelex_token_use (t); 6973 return (ffelexHandler) ffestb_R8405_; 6974 6975 default: 6976 break; 6977 } 6978 6979 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t); 6980 ffelex_token_kill (ffesta_tokens[1]); 6981 ffelex_token_kill (ffesta_tokens[2]); 6982 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 6983} 6984 6985/* ffestb_R8405_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER COMMA NUMBER 6986 6987 return ffestb_R8405_; // to lexer 6988 6989 Make sure the next token is COMMA. */ 6990 6991static ffelexHandler 6992ffestb_R8405_ (ffelexToken t) 6993{ 6994 switch (ffelex_token_type (t)) 6995 { 6996 case FFELEX_typeCOMMA: 6997 return (ffelexHandler) ffestb_R8406_; 6998 6999 default: 7000 break; 7001 } 7002 7003 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t); 7004 ffelex_token_kill (ffesta_tokens[1]); 7005 ffelex_token_kill (ffesta_tokens[2]); 7006 ffelex_token_kill (ffesta_tokens[3]); 7007 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 7008} 7009 7010/* ffestb_R8406_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER COMMA NUMBER COMMA 7011 7012 return ffestb_R8406_; // to lexer 7013 7014 Make sure the next token is NUMBER. */ 7015 7016static ffelexHandler 7017ffestb_R8406_ (ffelexToken t) 7018{ 7019 switch (ffelex_token_type (t)) 7020 { 7021 case FFELEX_typeNUMBER: 7022 ffesta_tokens[4] = ffelex_token_use (t); 7023 return (ffelexHandler) ffestb_R8407_; 7024 7025 default: 7026 break; 7027 } 7028 7029 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t); 7030 ffelex_token_kill (ffesta_tokens[1]); 7031 ffelex_token_kill (ffesta_tokens[2]); 7032 ffelex_token_kill (ffesta_tokens[3]); 7033 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 7034} 7035 7036/* ffestb_R8407_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER COMMA NUMBER COMMA 7037 NUMBER 7038 7039 return ffestb_R8407_; // to lexer 7040 7041 Make sure the next token is EOS or SEMICOLON. */ 7042 7043static ffelexHandler 7044ffestb_R8407_ (ffelexToken t) 7045{ 7046 switch (ffelex_token_type (t)) 7047 { 7048 case FFELEX_typeEOS: 7049 case FFELEX_typeSEMICOLON: 7050 if (!ffesta_is_inhibited ()) 7051 ffestc_R840 (ffestb_local_.if_stmt.expr, ffesta_tokens[1], 7052 ffesta_tokens[2], ffesta_tokens[3], ffesta_tokens[4]); 7053 ffelex_token_kill (ffesta_tokens[1]); 7054 ffelex_token_kill (ffesta_tokens[2]); 7055 ffelex_token_kill (ffesta_tokens[3]); 7056 ffelex_token_kill (ffesta_tokens[4]); 7057 return (ffelexHandler) ffesta_zero (t); 7058 7059 default: 7060 break; 7061 } 7062 7063 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t); 7064 ffelex_token_kill (ffesta_tokens[1]); 7065 ffelex_token_kill (ffesta_tokens[2]); 7066 ffelex_token_kill (ffesta_tokens[3]); 7067 ffelex_token_kill (ffesta_tokens[4]); 7068 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 7069} 7070 7071/* ffestb_R841 -- Parse the CONTINUE statement 7072 7073 return ffestb_R841; // to lexer 7074 7075 Make sure the statement has a valid form for the CONTINUE statement. If 7076 it does, implement the statement. */ 7077 7078ffelexHandler 7079ffestb_R841 (ffelexToken t) 7080{ 7081 const char *p; 7082 ffeTokenLength i; 7083 7084 switch (ffelex_token_type (ffesta_tokens[0])) 7085 { 7086 case FFELEX_typeNAME: 7087 if (ffesta_first_kw != FFESTR_firstCONTINUE) 7088 goto bad_0; /* :::::::::::::::::::: */ 7089 break; 7090 7091 case FFELEX_typeNAMES: 7092 if (ffesta_first_kw != FFESTR_firstCONTINUE) 7093 goto bad_0; /* :::::::::::::::::::: */ 7094 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlCONTINUE) 7095 { 7096 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCONTINUE); 7097 goto bad_i; /* :::::::::::::::::::: */ 7098 } 7099 break; 7100 7101 default: 7102 goto bad_0; /* :::::::::::::::::::: */ 7103 } 7104 7105 switch (ffelex_token_type (t)) 7106 { 7107 case FFELEX_typeEOS: 7108 case FFELEX_typeSEMICOLON: 7109 ffesta_confirmed (); 7110 if (!ffesta_is_inhibited ()) 7111 ffestc_R841 (); 7112 return (ffelexHandler) ffesta_zero (t); 7113 7114 case FFELEX_typeCOMMA: 7115 case FFELEX_typeCOLONCOLON: 7116 ffesta_confirmed (); /* Error, but clearly intended. */ 7117 goto bad_1; /* :::::::::::::::::::: */ 7118 7119 default: 7120 goto bad_1; /* :::::::::::::::::::: */ 7121 } 7122 7123bad_0: /* :::::::::::::::::::: */ 7124 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CONTINUE", ffesta_tokens[0]); 7125 return (ffelexHandler) ffelex_swallow_tokens (t, 7126 (ffelexHandler) ffesta_zero); /* Invalid first token. */ 7127 7128bad_1: /* :::::::::::::::::::: */ 7129 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CONTINUE", t); 7130 return (ffelexHandler) ffelex_swallow_tokens (t, 7131 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 7132 7133bad_i: /* :::::::::::::::::::: */ 7134 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CONTINUE", ffesta_tokens[0], i, t); 7135 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 7136} 7137 7138/* ffestb_R1102 -- Parse the PROGRAM statement 7139 7140 return ffestb_R1102; // to lexer 7141 7142 Make sure the statement has a valid form for the PROGRAM statement. If it 7143 does, implement the statement. */ 7144 7145ffelexHandler 7146ffestb_R1102 (ffelexToken t) 7147{ 7148 ffeTokenLength i; 7149 unsigned const char *p; 7150 7151 switch (ffelex_token_type (ffesta_tokens[0])) 7152 { 7153 case FFELEX_typeNAME: 7154 if (ffesta_first_kw != FFESTR_firstPROGRAM) 7155 goto bad_0; /* :::::::::::::::::::: */ 7156 switch (ffelex_token_type (t)) 7157 { 7158 case FFELEX_typeEOS: 7159 case FFELEX_typeSEMICOLON: 7160 case FFELEX_typeCOMMA: 7161 case FFELEX_typeCOLONCOLON: 7162 ffesta_confirmed (); /* Error, but clearly intended. */ 7163 goto bad_1; /* :::::::::::::::::::: */ 7164 7165 default: 7166 goto bad_1; /* :::::::::::::::::::: */ 7167 7168 case FFELEX_typeNAME: 7169 break; 7170 } 7171 7172 ffesta_confirmed (); 7173 ffesta_tokens[1] = ffelex_token_use (t); 7174 return (ffelexHandler) ffestb_R11021_; 7175 7176 case FFELEX_typeNAMES: 7177 if (ffesta_first_kw != FFESTR_firstPROGRAM) 7178 goto bad_0; /* :::::::::::::::::::: */ 7179 switch (ffelex_token_type (t)) 7180 { 7181 case FFELEX_typeCOMMA: 7182 case FFELEX_typeCOLONCOLON: 7183 ffesta_confirmed (); /* Error, but clearly intended. */ 7184 goto bad_1; /* :::::::::::::::::::: */ 7185 7186 default: 7187 goto bad_1; /* :::::::::::::::::::: */ 7188 7189 case FFELEX_typeEOS: 7190 case FFELEX_typeSEMICOLON: 7191 break; 7192 } 7193 ffesta_confirmed (); 7194 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlPROGRAM); 7195 if (!ffesrc_is_name_init (*p)) 7196 goto bad_i; /* :::::::::::::::::::: */ 7197 ffesta_tokens[1] 7198 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); 7199 return (ffelexHandler) ffestb_R11021_ (t); 7200 7201 default: 7202 goto bad_0; /* :::::::::::::::::::: */ 7203 } 7204 7205bad_0: /* :::::::::::::::::::: */ 7206 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PROGRAM", ffesta_tokens[0]); 7207 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 7208 7209bad_1: /* :::::::::::::::::::: */ 7210 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PROGRAM", t); 7211 return (ffelexHandler) ffelex_swallow_tokens (t, 7212 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 7213 7214bad_i: /* :::::::::::::::::::: */ 7215 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "PROGRAM", ffesta_tokens[0], i, t); 7216 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 7217} 7218 7219/* ffestb_R11021_ -- "PROGRAM" NAME 7220 7221 return ffestb_R11021_; // to lexer 7222 7223 Make sure the next token is an EOS or SEMICOLON. */ 7224 7225static ffelexHandler 7226ffestb_R11021_ (ffelexToken t) 7227{ 7228 switch (ffelex_token_type (t)) 7229 { 7230 case FFELEX_typeEOS: 7231 case FFELEX_typeSEMICOLON: 7232 ffesta_confirmed (); 7233 if (!ffesta_is_inhibited ()) 7234 ffestc_R1102 (ffesta_tokens[1]); 7235 ffelex_token_kill (ffesta_tokens[1]); 7236 return (ffelexHandler) ffesta_zero (t); 7237 7238 default: 7239 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PROGRAM", t); 7240 break; 7241 } 7242 7243 ffelex_token_kill (ffesta_tokens[1]); 7244 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 7245} 7246 7247/* ffestb_block -- Parse the BLOCK DATA statement 7248 7249 return ffestb_block; // to lexer 7250 7251 Make sure the statement has a valid form for the BLOCK DATA statement. If 7252 it does, implement the statement. */ 7253 7254ffelexHandler 7255ffestb_block (ffelexToken t) 7256{ 7257 switch (ffelex_token_type (ffesta_tokens[0])) 7258 { 7259 case FFELEX_typeNAME: 7260 if (ffesta_first_kw != FFESTR_firstBLOCK) 7261 goto bad_0; /* :::::::::::::::::::: */ 7262 switch (ffelex_token_type (t)) 7263 { 7264 default: 7265 goto bad_1; /* :::::::::::::::::::: */ 7266 7267 case FFELEX_typeNAME: 7268 if (ffesta_second_kw != FFESTR_secondDATA) 7269 goto bad_1; /* :::::::::::::::::::: */ 7270 break; 7271 } 7272 7273 ffesta_confirmed (); 7274 return (ffelexHandler) ffestb_R1111_1_; 7275 7276 default: 7277 goto bad_0; /* :::::::::::::::::::: */ 7278 } 7279 7280bad_0: /* :::::::::::::::::::: */ 7281 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", ffesta_tokens[0]); 7282 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 7283 7284bad_1: /* :::::::::::::::::::: */ 7285 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", t); 7286 return (ffelexHandler) ffelex_swallow_tokens (t, 7287 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 7288} 7289 7290/* ffestb_blockdata -- Parse the BLOCKDATA statement 7291 7292 return ffestb_blockdata; // to lexer 7293 7294 Make sure the statement has a valid form for the BLOCKDATA statement. If 7295 it does, implement the statement. */ 7296 7297ffelexHandler 7298ffestb_blockdata (ffelexToken t) 7299{ 7300 ffeTokenLength i; 7301 unsigned const char *p; 7302 7303 switch (ffelex_token_type (ffesta_tokens[0])) 7304 { 7305 case FFELEX_typeNAME: 7306 if (ffesta_first_kw != FFESTR_firstBLOCKDATA) 7307 goto bad_0; /* :::::::::::::::::::: */ 7308 switch (ffelex_token_type (t)) 7309 { 7310 case FFELEX_typeCOMMA: 7311 case FFELEX_typeCOLONCOLON: 7312 ffesta_confirmed (); /* Error, but clearly intended. */ 7313 goto bad_1; /* :::::::::::::::::::: */ 7314 7315 default: 7316 goto bad_1; /* :::::::::::::::::::: */ 7317 7318 case FFELEX_typeNAME: 7319 ffesta_confirmed (); 7320 ffesta_tokens[1] = ffelex_token_use (t); 7321 return (ffelexHandler) ffestb_R1111_2_; 7322 7323 case FFELEX_typeEOS: 7324 case FFELEX_typeSEMICOLON: 7325 ffesta_confirmed (); 7326 ffesta_tokens[1] = NULL; 7327 return (ffelexHandler) ffestb_R1111_2_ (t); 7328 } 7329 7330 case FFELEX_typeNAMES: 7331 if (ffesta_first_kw != FFESTR_firstBLOCKDATA) 7332 goto bad_0; /* :::::::::::::::::::: */ 7333 switch (ffelex_token_type (t)) 7334 { 7335 default: 7336 goto bad_1; /* :::::::::::::::::::: */ 7337 7338 case FFELEX_typeEOS: 7339 case FFELEX_typeSEMICOLON: 7340 break; 7341 } 7342 ffesta_confirmed (); 7343 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlBLOCKDATA); 7344 if (*p == '\0') 7345 { 7346 ffesta_tokens[1] = NULL; 7347 } 7348 else 7349 { 7350 if (!ffesrc_is_name_init (*p)) 7351 goto bad_i; /* :::::::::::::::::::: */ 7352 ffesta_tokens[1] 7353 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); 7354 } 7355 return (ffelexHandler) ffestb_R1111_2_ (t); 7356 7357 default: 7358 goto bad_0; /* :::::::::::::::::::: */ 7359 } 7360 7361bad_0: /* :::::::::::::::::::: */ 7362 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", ffesta_tokens[0]); 7363 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 7364 7365bad_1: /* :::::::::::::::::::: */ 7366 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", t); 7367 return (ffelexHandler) ffelex_swallow_tokens (t, 7368 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 7369 7370bad_i: /* :::::::::::::::::::: */ 7371 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", ffesta_tokens[0], i, t); 7372 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 7373} 7374 7375/* ffestb_R1111_1_ -- "BLOCK" "DATA" 7376 7377 return ffestb_R1111_1_; // to lexer 7378 7379 Make sure the next token is a NAME, EOS, or SEMICOLON token. */ 7380 7381static ffelexHandler 7382ffestb_R1111_1_ (ffelexToken t) 7383{ 7384 switch (ffelex_token_type (t)) 7385 { 7386 case FFELEX_typeNAME: 7387 ffesta_tokens[1] = ffelex_token_use (t); 7388 return (ffelexHandler) ffestb_R1111_2_; 7389 7390 case FFELEX_typeEOS: 7391 case FFELEX_typeSEMICOLON: 7392 ffesta_tokens[1] = NULL; 7393 return (ffelexHandler) ffestb_R1111_2_ (t); 7394 7395 default: 7396 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", t); 7397 break; 7398 } 7399 7400 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 7401} 7402 7403/* ffestb_R1111_2_ -- "BLOCK/DATA" NAME 7404 7405 return ffestb_R1111_2_; // to lexer 7406 7407 Make sure the next token is an EOS or SEMICOLON. */ 7408 7409static ffelexHandler 7410ffestb_R1111_2_ (ffelexToken t) 7411{ 7412 switch (ffelex_token_type (t)) 7413 { 7414 case FFELEX_typeEOS: 7415 case FFELEX_typeSEMICOLON: 7416 ffesta_confirmed (); 7417 if (!ffesta_is_inhibited ()) 7418 ffestc_R1111 (ffesta_tokens[1]); 7419 if (ffesta_tokens[1] != NULL) 7420 ffelex_token_kill (ffesta_tokens[1]); 7421 return (ffelexHandler) ffesta_zero (t); 7422 7423 default: 7424 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", t); 7425 break; 7426 } 7427 7428 if (ffesta_tokens[1] != NULL) 7429 ffelex_token_kill (ffesta_tokens[1]); 7430 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 7431} 7432 7433/* ffestb_R1212 -- Parse the CALL statement 7434 7435 return ffestb_R1212; // to lexer 7436 7437 Make sure the statement has a valid form for the CALL statement. If it 7438 does, implement the statement. */ 7439 7440ffelexHandler 7441ffestb_R1212 (ffelexToken t) 7442{ 7443 ffeTokenLength i; 7444 unsigned const char *p; 7445 ffelexHandler next; 7446 ffelexToken nt; 7447 7448 switch (ffelex_token_type (ffesta_tokens[0])) 7449 { 7450 case FFELEX_typeNAME: 7451 if (ffesta_first_kw != FFESTR_firstCALL) 7452 goto bad_0; /* :::::::::::::::::::: */ 7453 switch (ffelex_token_type (t)) 7454 { 7455 case FFELEX_typeEOS: 7456 case FFELEX_typeSEMICOLON: 7457 case FFELEX_typeCOMMA: 7458 case FFELEX_typeCOLONCOLON: 7459 ffesta_confirmed (); /* Error, but clearly intended. */ 7460 goto bad_1; /* :::::::::::::::::::: */ 7461 7462 default: 7463 goto bad_1; /* :::::::::::::::::::: */ 7464 7465 case FFELEX_typeNAME: 7466 break; 7467 } 7468 ffesta_confirmed (); 7469 return (ffelexHandler) 7470 (*((ffelexHandler) 7471 ffeexpr_lhs (ffesta_output_pool, FFEEXPR_contextSUBROUTINEREF, 7472 (ffeexprCallback) ffestb_R12121_))) 7473 (t); 7474 7475 case FFELEX_typeNAMES: 7476 if (ffesta_first_kw != FFESTR_firstCALL) 7477 goto bad_0; /* :::::::::::::::::::: */ 7478 switch (ffelex_token_type (t)) 7479 { 7480 case FFELEX_typeCOLONCOLON: 7481 case FFELEX_typeCOMMA: 7482 ffesta_confirmed (); /* Error, but clearly intended. */ 7483 goto bad_1; /* :::::::::::::::::::: */ 7484 7485 default: 7486 goto bad_1; /* :::::::::::::::::::: */ 7487 7488 case FFELEX_typeOPEN_PAREN: 7489 break; 7490 7491 case FFELEX_typeEOS: 7492 case FFELEX_typeSEMICOLON: 7493 ffesta_confirmed (); 7494 break; 7495 } 7496 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCALL); 7497 if (!ffesrc_is_name_init (*p)) 7498 goto bad_i; /* :::::::::::::::::::: */ 7499 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); 7500 next = (ffelexHandler) 7501 (*((ffelexHandler) 7502 ffeexpr_lhs (ffesta_output_pool, FFEEXPR_contextSUBROUTINEREF, 7503 (ffeexprCallback) ffestb_R12121_))) 7504 (nt); 7505 ffelex_token_kill (nt); 7506 return (ffelexHandler) (*next) (t); 7507 7508 default: 7509 goto bad_0; /* :::::::::::::::::::: */ 7510 } 7511 7512bad_0: /* :::::::::::::::::::: */ 7513 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CALL", ffesta_tokens[0]); 7514 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 7515 7516bad_1: /* :::::::::::::::::::: */ 7517 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CALL", t); 7518 return (ffelexHandler) ffelex_swallow_tokens (t, 7519 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 7520 7521bad_i: /* :::::::::::::::::::: */ 7522 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CALL", ffesta_tokens[0], i, t); 7523 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 7524} 7525 7526/* ffestb_R12121_ -- "CALL" expr 7527 7528 (ffestb_R12121_) // to expression handler 7529 7530 Make sure the statement has a valid form for the CALL statement. If it 7531 does, implement the statement. */ 7532 7533static ffelexHandler 7534ffestb_R12121_ (ffelexToken ft, ffebld expr, ffelexToken t) 7535{ 7536 switch (ffelex_token_type (t)) 7537 { 7538 case FFELEX_typeEOS: 7539 case FFELEX_typeSEMICOLON: 7540 ffesta_confirmed (); 7541 if (expr == NULL) 7542 break; 7543 if (!ffesta_is_inhibited ()) 7544 ffestc_R1212 (expr, ft); 7545 return (ffelexHandler) ffesta_zero (t); 7546 7547 default: 7548 break; 7549 } 7550 7551 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CALL", t); 7552 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 7553} 7554 7555/* ffestb_R1227 -- Parse the RETURN statement 7556 7557 return ffestb_R1227; // to lexer 7558 7559 Make sure the statement has a valid form for the RETURN statement. If it 7560 does, implement the statement. */ 7561 7562ffelexHandler 7563ffestb_R1227 (ffelexToken t) 7564{ 7565 ffelexHandler next; 7566 7567 switch (ffelex_token_type (ffesta_tokens[0])) 7568 { 7569 case FFELEX_typeNAME: 7570 if (ffesta_first_kw != FFESTR_firstRETURN) 7571 goto bad_0; /* :::::::::::::::::::: */ 7572 switch (ffelex_token_type (t)) 7573 { 7574 case FFELEX_typeCOMMA: 7575 case FFELEX_typeCOLONCOLON: 7576 ffesta_confirmed (); /* Error, but clearly intended. */ 7577 goto bad_1; /* :::::::::::::::::::: */ 7578 7579 case FFELEX_typeEQUALS: 7580 case FFELEX_typePOINTS: 7581 case FFELEX_typeCOLON: 7582 goto bad_1; /* :::::::::::::::::::: */ 7583 7584 case FFELEX_typeEOS: 7585 case FFELEX_typeSEMICOLON: 7586 case FFELEX_typeNAME: 7587 case FFELEX_typeNUMBER: 7588 ffesta_confirmed (); 7589 break; 7590 7591 default: 7592 break; 7593 } 7594 7595 return (ffelexHandler) (*((ffelexHandler) 7596 ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextRETURN, 7597 (ffeexprCallback) ffestb_R12271_))) 7598 (t); 7599 7600 case FFELEX_typeNAMES: 7601 if (ffesta_first_kw != FFESTR_firstRETURN) 7602 goto bad_0; /* :::::::::::::::::::: */ 7603 switch (ffelex_token_type (t)) 7604 { 7605 case FFELEX_typeCOMMA: 7606 case FFELEX_typeCOLONCOLON: 7607 ffesta_confirmed (); /* Error, but clearly intended. */ 7608 goto bad_1; /* :::::::::::::::::::: */ 7609 7610 case FFELEX_typeEQUALS: 7611 case FFELEX_typePOINTS: 7612 case FFELEX_typeCOLON: 7613 goto bad_1; /* :::::::::::::::::::: */ 7614 7615 case FFELEX_typeEOS: 7616 case FFELEX_typeSEMICOLON: 7617 ffesta_confirmed (); 7618 break; 7619 7620 default: 7621 break; 7622 } 7623 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 7624 FFEEXPR_contextRETURN, (ffeexprCallback) ffestb_R12271_); 7625 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0], 7626 FFESTR_firstlRETURN); 7627 if (next == NULL) 7628 return (ffelexHandler) ffelex_swallow_tokens (t, 7629 (ffelexHandler) ffesta_zero); 7630 return (ffelexHandler) (*next) (t); 7631 7632 default: 7633 goto bad_0; /* :::::::::::::::::::: */ 7634 } 7635 7636bad_0: /* :::::::::::::::::::: */ 7637 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RETURN", ffesta_tokens[0]); 7638 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 7639 7640bad_1: /* :::::::::::::::::::: */ 7641 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RETURN", t); 7642 return (ffelexHandler) ffelex_swallow_tokens (t, 7643 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 7644} 7645 7646/* ffestb_R12271_ -- "RETURN" expr 7647 7648 (ffestb_R12271_) // to expression handler 7649 7650 Make sure the next token is an EOS or SEMICOLON. */ 7651 7652static ffelexHandler 7653ffestb_R12271_ (ffelexToken ft, ffebld expr, ffelexToken t) 7654{ 7655 switch (ffelex_token_type (t)) 7656 { 7657 case FFELEX_typeEOS: 7658 case FFELEX_typeSEMICOLON: 7659 ffesta_confirmed (); 7660 if (!ffesta_is_inhibited ()) 7661 ffestc_R1227 (expr, ft); 7662 return (ffelexHandler) ffesta_zero (t); 7663 7664 default: 7665 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RETURN", t); 7666 break; 7667 } 7668 7669 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 7670} 7671 7672/* ffestb_R1228 -- Parse the CONTAINS statement 7673 7674 return ffestb_R1228; // to lexer 7675 7676 Make sure the statement has a valid form for the CONTAINS statement. If 7677 it does, implement the statement. */ 7678 7679#if FFESTR_F90 7680ffelexHandler 7681ffestb_R1228 (ffelexToken t) 7682{ 7683 const char *p; 7684 ffeTokenLength i; 7685 7686 switch (ffelex_token_type (ffesta_tokens[0])) 7687 { 7688 case FFELEX_typeNAME: 7689 if (ffesta_first_kw != FFESTR_firstCONTAINS) 7690 goto bad_0; /* :::::::::::::::::::: */ 7691 break; 7692 7693 case FFELEX_typeNAMES: 7694 if (ffesta_first_kw != FFESTR_firstCONTAINS) 7695 goto bad_0; /* :::::::::::::::::::: */ 7696 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlCONTAINS) 7697 { 7698 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCONTAINS); 7699 goto bad_i; /* :::::::::::::::::::: */ 7700 } 7701 break; 7702 7703 default: 7704 goto bad_0; /* :::::::::::::::::::: */ 7705 } 7706 7707 switch (ffelex_token_type (t)) 7708 { 7709 case FFELEX_typeEOS: 7710 case FFELEX_typeSEMICOLON: 7711 ffesta_confirmed (); 7712 if (!ffesta_is_inhibited ()) 7713 ffestc_R1228 (); 7714 return (ffelexHandler) ffesta_zero (t); 7715 7716 case FFELEX_typeCOMMA: 7717 case FFELEX_typeCOLONCOLON: 7718 ffesta_confirmed (); /* Error, but clearly intended. */ 7719 goto bad_1; /* :::::::::::::::::::: */ 7720 7721 default: 7722 goto bad_1; /* :::::::::::::::::::: */ 7723 } 7724 7725bad_0: /* :::::::::::::::::::: */ 7726 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CONTAINS", ffesta_tokens[0]); 7727 return (ffelexHandler) ffelex_swallow_tokens (t, 7728 (ffelexHandler) ffesta_zero); /* Invalid first token. */ 7729 7730bad_1: /* :::::::::::::::::::: */ 7731 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CONTAINS", t); 7732 return (ffelexHandler) ffelex_swallow_tokens (t, 7733 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 7734 7735bad_i: /* :::::::::::::::::::: */ 7736 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CONTAINS", ffesta_tokens[0], i, t); 7737 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 7738} 7739 7740#endif 7741/* ffestb_V009 -- Parse the UNION statement 7742 7743 return ffestb_V009; // to lexer 7744 7745 Make sure the statement has a valid form for the UNION statement. If 7746 it does, implement the statement. */ 7747 7748#if FFESTR_VXT 7749ffelexHandler 7750ffestb_V009 (ffelexToken t) 7751{ 7752 const char *p; 7753 ffeTokenLength i; 7754 7755 switch (ffelex_token_type (ffesta_tokens[0])) 7756 { 7757 case FFELEX_typeNAME: 7758 if (ffesta_first_kw != FFESTR_firstUNION) 7759 goto bad_0; /* :::::::::::::::::::: */ 7760 break; 7761 7762 case FFELEX_typeNAMES: 7763 if (ffesta_first_kw != FFESTR_firstUNION) 7764 goto bad_0; /* :::::::::::::::::::: */ 7765 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlUNION) 7766 { 7767 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlUNION); 7768 goto bad_i; /* :::::::::::::::::::: */ 7769 } 7770 break; 7771 7772 default: 7773 goto bad_0; /* :::::::::::::::::::: */ 7774 } 7775 7776 switch (ffelex_token_type (t)) 7777 { 7778 case FFELEX_typeEOS: 7779 case FFELEX_typeSEMICOLON: 7780 ffesta_confirmed (); 7781 if (!ffesta_is_inhibited ()) 7782 ffestc_V009 (); 7783 return (ffelexHandler) ffesta_zero (t); 7784 7785 case FFELEX_typeCOMMA: 7786 case FFELEX_typeCOLONCOLON: 7787 ffesta_confirmed (); /* Error, but clearly intended. */ 7788 goto bad_1; /* :::::::::::::::::::: */ 7789 7790 default: 7791 goto bad_1; /* :::::::::::::::::::: */ 7792 } 7793 7794bad_0: /* :::::::::::::::::::: */ 7795 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "UNION", ffesta_tokens[0]); 7796 return (ffelexHandler) ffelex_swallow_tokens (t, 7797 (ffelexHandler) ffesta_zero); /* Invalid first token. */ 7798 7799bad_1: /* :::::::::::::::::::: */ 7800 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "UNION", t); 7801 return (ffelexHandler) ffelex_swallow_tokens (t, 7802 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 7803 7804bad_i: /* :::::::::::::::::::: */ 7805 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "UNION", ffesta_tokens[0], i, t); 7806 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 7807} 7808 7809#endif 7810/* ffestb_construct -- Parse a construct name 7811 7812 return ffestb_construct; // to lexer 7813 7814 Make sure the statement can have a construct name (if-then-stmt, do-stmt, 7815 select-case-stmt). */ 7816 7817ffelexHandler 7818ffestb_construct (ffelexToken t UNUSED) 7819{ 7820 /* This handler gets invoked only when token 0 is NAME/NAMES and token 1 is 7821 COLON. */ 7822 7823 ffesta_confirmed (); 7824 ffelex_set_names (TRUE); 7825 return (ffelexHandler) ffestb_construct1_; 7826} 7827 7828/* ffestb_construct1_ -- NAME COLON 7829 7830 return ffestb_construct1_; // to lexer 7831 7832 Make sure we've got a NAME that is DO, DOWHILE, IF, SELECT, or SELECTCASE. */ 7833 7834static ffelexHandler 7835ffestb_construct1_ (ffelexToken t) 7836{ 7837 ffelex_set_names (FALSE); 7838 7839 switch (ffelex_token_type (t)) 7840 { 7841 case FFELEX_typeNAME: 7842 ffesta_first_kw = ffestr_first (t); 7843 switch (ffesta_first_kw) 7844 { 7845 case FFESTR_firstIF: 7846 ffestb_local_.construct.next = (ffelexHandler) ffestb_if; 7847 break; 7848 7849 case FFESTR_firstDO: 7850 ffestb_local_.construct.next = (ffelexHandler) ffestb_do; 7851 break; 7852 7853 case FFESTR_firstDOWHILE: 7854 ffestb_local_.construct.next = (ffelexHandler) ffestb_dowhile; 7855 break; 7856 7857 case FFESTR_firstSELECT: 7858 case FFESTR_firstSELECTCASE: 7859 ffestb_local_.construct.next = (ffelexHandler) ffestb_R809; 7860 break; 7861 7862 default: 7863 goto bad; /* :::::::::::::::::::: */ 7864 } 7865 ffesta_construct_name = ffesta_tokens[0]; 7866 ffesta_tokens[0] = ffelex_token_use (t); 7867 return (ffelexHandler) ffestb_construct2_; 7868 7869 case FFELEX_typeNAMES: 7870 ffesta_first_kw = ffestr_first (t); 7871 switch (ffesta_first_kw) 7872 { 7873 case FFESTR_firstIF: 7874 if (ffelex_token_length (t) != FFESTR_firstlIF) 7875 goto bad; /* :::::::::::::::::::: */ 7876 ffestb_local_.construct.next = (ffelexHandler) ffestb_if; 7877 break; 7878 7879 case FFESTR_firstDO: 7880 ffestb_local_.construct.next = (ffelexHandler) ffestb_do; 7881 break; 7882 7883 case FFESTR_firstDOWHILE: 7884 if (ffelex_token_length (t) != FFESTR_firstlDOWHILE) 7885 goto bad; /* :::::::::::::::::::: */ 7886 ffestb_local_.construct.next = (ffelexHandler) ffestb_dowhile; 7887 break; 7888 7889 case FFESTR_firstSELECTCASE: 7890 if (ffelex_token_length (t) != FFESTR_firstlSELECTCASE) 7891 goto bad; /* :::::::::::::::::::: */ 7892 ffestb_local_.construct.next = (ffelexHandler) ffestb_R809; 7893 break; 7894 7895 default: 7896 goto bad; /* :::::::::::::::::::: */ 7897 } 7898 ffesta_construct_name = ffesta_tokens[0]; 7899 ffesta_tokens[0] = ffelex_token_use (t); 7900 return (ffelexHandler) ffestb_construct2_; 7901 7902 default: 7903 break; 7904 } 7905 7906bad: /* :::::::::::::::::::: */ 7907 ffesta_ffebad_2st (FFEBAD_INVALID_STMT_FORM, "CONSTRUCT", 7908 ffesta_tokens[0], t); 7909 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 7910} 7911 7912/* ffestb_construct2_ -- NAME COLON "DO/DOWHILE/IF/SELECT/SELECTCASE" 7913 7914 return ffestb_construct2_; // to lexer 7915 7916 This extra step is needed to set ffesta_second_kw if the second token 7917 (here) is a NAME, so DO and SELECT can continue to expect it. */ 7918 7919static ffelexHandler 7920ffestb_construct2_ (ffelexToken t) 7921{ 7922 if (ffelex_token_type (t) == FFELEX_typeNAME) 7923 ffesta_second_kw = ffestr_second (t); 7924 return (ffelexHandler) (*ffestb_local_.construct.next) (t); 7925} 7926 7927/* ffestb_heap -- Parse an ALLOCATE/DEALLOCATE statement 7928 7929 return ffestb_heap; // to lexer 7930 7931 Make sure the statement has a valid form for an ALLOCATE/DEALLOCATE 7932 statement. If it does, implement the statement. */ 7933 7934#if FFESTR_F90 7935ffelexHandler 7936ffestb_heap (ffelexToken t) 7937{ 7938 switch (ffelex_token_type (ffesta_tokens[0])) 7939 { 7940 case FFELEX_typeNAME: 7941 break; 7942 7943 case FFELEX_typeNAMES: 7944 if (ffelex_token_length (ffesta_tokens[0]) != ffestb_args.heap.len) 7945 goto bad_0; /* :::::::::::::::::::: */ 7946 break; 7947 7948 default: 7949 goto bad_0; /* :::::::::::::::::::: */ 7950 } 7951 7952 switch (ffelex_token_type (t)) 7953 { 7954 case FFELEX_typeOPEN_PAREN: 7955 break; 7956 7957 case FFELEX_typeEOS: 7958 case FFELEX_typeSEMICOLON: 7959 case FFELEX_typeCOMMA: 7960 case FFELEX_typeCOLONCOLON: 7961 ffesta_confirmed (); /* Error, but clearly intended. */ 7962 goto bad_1; /* :::::::::::::::::::: */ 7963 7964 default: 7965 goto bad_1; /* :::::::::::::::::::: */ 7966 } 7967 7968 ffestb_local_.heap.exprs = ffestt_exprlist_create (); 7969 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 7970 ffestb_args.heap.ctx, 7971 (ffeexprCallback) ffestb_heap1_); 7972 7973bad_0: /* :::::::::::::::::::: */ 7974 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, ffesta_tokens[0]); 7975 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 7976 7977bad_1: /* :::::::::::::::::::: */ 7978 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t); 7979 return (ffelexHandler) ffelex_swallow_tokens (t, 7980 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 7981} 7982 7983/* ffestb_heap1_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN expr 7984 7985 (ffestb_heap1_) // to expression handler 7986 7987 Make sure the next token is COMMA. */ 7988 7989static ffelexHandler 7990ffestb_heap1_ (ffelexToken ft, ffebld expr, ffelexToken t) 7991{ 7992 switch (ffelex_token_type (t)) 7993 { 7994 case FFELEX_typeCOMMA: 7995 if (expr == NULL) 7996 break; 7997 ffestt_exprlist_append (ffestb_local_.heap.exprs, expr, 7998 ffelex_token_use (t)); 7999 return (ffelexHandler) ffestb_heap2_; 8000 8001 case FFELEX_typeCLOSE_PAREN: 8002 if (expr == NULL) 8003 break; 8004 ffestt_exprlist_append (ffestb_local_.heap.exprs, expr, 8005 ffelex_token_use (t)); 8006 ffesta_tokens[1] = NULL; 8007 ffestb_local_.heap.expr = NULL; 8008 return (ffelexHandler) ffestb_heap5_; 8009 8010 default: 8011 break; 8012 } 8013 8014 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t); 8015 ffestt_exprlist_kill (ffestb_local_.heap.exprs); 8016 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 8017} 8018 8019/* ffestb_heap2_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN expr COMMA 8020 8021 return ffestb_heap2_; // to lexer 8022 8023 Make sure the next token is NAME. */ 8024 8025static ffelexHandler 8026ffestb_heap2_ (ffelexToken t) 8027{ 8028 switch (ffelex_token_type (t)) 8029 { 8030 case FFELEX_typeNAME: 8031 ffesta_tokens[1] = ffelex_token_use (t); 8032 return (ffelexHandler) ffestb_heap3_; 8033 8034 default: 8035 break; 8036 } 8037 8038 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t); 8039 ffestt_exprlist_kill (ffestb_local_.heap.exprs); 8040 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 8041} 8042 8043/* ffestb_heap3_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN expr COMMA NAME 8044 8045 return ffestb_heap3_; // to lexer 8046 8047 If token is EQUALS, make sure NAME was "STAT" and handle STAT variable; 8048 else pass NAME and token to expression handler. */ 8049 8050static ffelexHandler 8051ffestb_heap3_ (ffelexToken t) 8052{ 8053 ffelexHandler next; 8054 8055 switch (ffelex_token_type (t)) 8056 { 8057 case FFELEX_typeEQUALS: 8058 ffesta_confirmed (); 8059 if (ffestr_other (ffesta_tokens[1]) != FFESTR_otherSTAT) 8060 break; 8061 ffelex_token_kill (ffesta_tokens[1]); 8062 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 8063 FFEEXPR_contextHEAPSTAT, 8064 (ffeexprCallback) ffestb_heap4_); 8065 8066 default: 8067 next = (ffelexHandler) 8068 (*((ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 8069 ffestb_args.heap.ctx, 8070 (ffeexprCallback) ffestb_heap1_))) 8071 (ffesta_tokens[1]); 8072 ffelex_token_kill (ffesta_tokens[1]); 8073 return (ffelexHandler) (*next) (t); 8074 } 8075 8076 ffelex_token_kill (ffesta_tokens[1]); 8077 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t); 8078 ffestt_exprlist_kill (ffestb_local_.heap.exprs); 8079 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 8080} 8081 8082/* ffestb_heap4_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN ... COMMA "STAT" EQUALS 8083 expr 8084 8085 (ffestb_heap4_) // to expression handler 8086 8087 Make sure the next token is CLOSE_PAREN. */ 8088 8089static ffelexHandler 8090ffestb_heap4_ (ffelexToken ft, ffebld expr, ffelexToken t) 8091{ 8092 switch (ffelex_token_type (t)) 8093 { 8094 case FFELEX_typeCLOSE_PAREN: 8095 if (expr == NULL) 8096 break; 8097 ffesta_tokens[1] = ffelex_token_use (ft); 8098 ffestb_local_.heap.expr = expr; 8099 return (ffelexHandler) ffestb_heap5_; 8100 8101 default: 8102 break; 8103 } 8104 8105 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t); 8106 ffestt_exprlist_kill (ffestb_local_.heap.exprs); 8107 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 8108} 8109 8110/* ffestb_heap5_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN ... CLOSE_PAREN 8111 8112 return ffestb_heap5_; // to lexer 8113 8114 Make sure the next token is EOS/SEMICOLON. */ 8115 8116static ffelexHandler 8117ffestb_heap5_ (ffelexToken t) 8118{ 8119 switch (ffelex_token_type (t)) 8120 { 8121 case FFELEX_typeEOS: 8122 case FFELEX_typeSEMICOLON: 8123 ffesta_confirmed (); 8124 if (!ffesta_is_inhibited ()) 8125 if (ffesta_first_kw == FFESTR_firstALLOCATE) 8126 ffestc_R620 (ffestb_local_.heap.exprs, ffestb_local_.heap.expr, 8127 ffesta_tokens[1]); 8128 else 8129 ffestc_R625 (ffestb_local_.heap.exprs, ffestb_local_.heap.expr, 8130 ffesta_tokens[1]); 8131 ffestt_exprlist_kill (ffestb_local_.heap.exprs); 8132 if (ffesta_tokens[1] != NULL) 8133 ffelex_token_kill (ffesta_tokens[1]); 8134 return (ffelexHandler) ffesta_zero (t); 8135 8136 default: 8137 break; 8138 } 8139 8140 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t); 8141 ffestt_exprlist_kill (ffestb_local_.heap.exprs); 8142 if (ffesta_tokens[1] != NULL) 8143 ffelex_token_kill (ffesta_tokens[1]); 8144 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 8145} 8146 8147#endif 8148/* ffestb_module -- Parse the MODULEPROCEDURE statement 8149 8150 return ffestb_module; // to lexer 8151 8152 Make sure the statement has a valid form for the MODULEPROCEDURE statement. 8153 If it does, implement the statement. 8154 8155 31-May-90 JCB 1.1 8156 Confirm NAME==MODULE followed by standard four invalid tokens, so we 8157 get decent message if somebody forgets that MODULE requires a name. */ 8158 8159#if FFESTR_F90 8160ffelexHandler 8161ffestb_module (ffelexToken t) 8162{ 8163 ffeTokenLength i; 8164 const char *p; 8165 ffelexToken nt; 8166 ffelexToken mt; /* Name in MODULE PROCEDUREname, i.e. 8167 includes "PROCEDURE". */ 8168 8169 switch (ffelex_token_type (ffesta_tokens[0])) 8170 { 8171 case FFELEX_typeNAME: 8172 if (ffesta_first_kw != FFESTR_firstMODULE) 8173 goto bad_0; /* :::::::::::::::::::: */ 8174 switch (ffelex_token_type (t)) 8175 { 8176 case FFELEX_typeNAME: 8177 break; 8178 8179 case FFELEX_typeCOLONCOLON: 8180 case FFELEX_typeCOMMA: 8181 case FFELEX_typeEOS: 8182 case FFELEX_typeSEMICOLON: 8183 ffesta_confirmed (); 8184 goto bad_1m; /* :::::::::::::::::::: */ 8185 8186 default: 8187 goto bad_1m; /* :::::::::::::::::::: */ 8188 } 8189 8190 ffesta_confirmed (); 8191 if (ffesta_second_kw != FFESTR_secondPROCEDURE) 8192 { 8193 ffesta_tokens[1] = ffelex_token_use (t); 8194 return (ffelexHandler) ffestb_module3_; 8195 } 8196 ffestb_local_.moduleprocedure.started = FALSE; 8197 ffesta_tokens[1] = ffelex_token_use (t); 8198 return (ffelexHandler) ffestb_module1_; 8199 8200 case FFELEX_typeNAMES: 8201 p = ffelex_token_text (ffesta_tokens[0]) 8202 + (i = FFESTR_firstlMODULEPROCEDURE); 8203 if ((ffesta_first_kw == FFESTR_firstMODULE) 8204 || ((ffesta_first_kw == FFESTR_firstMODULEPROCEDURE) 8205 && !ffesrc_is_name_init (*p))) 8206 { /* Definitely not "MODULE PROCEDURE name". */ 8207 switch (ffelex_token_type (t)) 8208 { 8209 case FFELEX_typeCOMMA: 8210 case FFELEX_typeCOLONCOLON: 8211 ffesta_confirmed (); /* Error, but clearly intended. */ 8212 goto bad_1m; /* :::::::::::::::::::: */ 8213 8214 default: 8215 goto bad_1m; /* :::::::::::::::::::: */ 8216 8217 case FFELEX_typeEOS: 8218 case FFELEX_typeSEMICOLON: 8219 ffesta_confirmed (); 8220 break; 8221 } 8222 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlMODULE); 8223 if (!ffesrc_is_name_init (*p)) 8224 goto bad_im; /* :::::::::::::::::::: */ 8225 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); 8226 if (!ffesta_is_inhibited ()) 8227 ffestc_R1105 (nt); 8228 ffelex_token_kill (nt); 8229 return (ffelexHandler) ffesta_zero (t); 8230 } 8231 8232 /* Here we know that we're indeed looking at a MODULEPROCEDURE 8233 statement rather than MODULE and that the character following 8234 MODULEPROCEDURE in the NAMES token is a valid first character for a 8235 NAME. This means that unless the second token is COMMA, we have an 8236 ambiguous statement that can be read either as MODULE PROCEDURE name 8237 or MODULE PROCEDUREname, the former being an R1205, the latter an 8238 R1105. */ 8239 8240 if (ffesta_first_kw != FFESTR_firstMODULEPROCEDURE) 8241 goto bad_0; /* :::::::::::::::::::: */ 8242 switch (ffelex_token_type (t)) 8243 { 8244 case FFELEX_typeCOLONCOLON: 8245 ffesta_confirmed (); /* Error, but clearly intended. */ 8246 goto bad_1; /* :::::::::::::::::::: */ 8247 8248 default: 8249 goto bad_1; /* :::::::::::::::::::: */ 8250 8251 case FFELEX_typeCOMMA: /* Aha, clearly not MODULE PROCEDUREname. */ 8252 ffesta_confirmed (); 8253 ffestb_local_.moduleprocedure.started = FALSE; 8254 ffesta_tokens[1] 8255 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); 8256 return (ffelexHandler) ffestb_module2_ (t); 8257 8258 case FFELEX_typeEOS: /* MODULE PROCEDURE name or MODULE 8259 PROCEDUREname. */ 8260 case FFELEX_typeSEMICOLON: 8261 ffesta_confirmed (); 8262 break; 8263 } 8264 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); 8265 mt = ffelex_token_name_from_names (ffesta_tokens[0], FFESTR_firstlMODULE, 8266 0); 8267 if (!ffesta_is_inhibited ()) 8268 ffestc_module (mt, nt); /* Implement ambiguous statement. */ 8269 ffelex_token_kill (nt); 8270 ffelex_token_kill (mt); 8271 return (ffelexHandler) ffesta_zero (t); 8272 8273 default: 8274 goto bad_0; /* :::::::::::::::::::: */ 8275 } 8276 8277bad_0: /* :::::::::::::::::::: */ 8278 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", ffesta_tokens[0]); 8279 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 8280 8281bad_1: /* :::::::::::::::::::: */ 8282 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", t); 8283 return (ffelexHandler) ffelex_swallow_tokens (t, 8284 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 8285 8286bad_1m: /* :::::::::::::::::::: */ 8287 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE", t); 8288 return (ffelexHandler) ffelex_swallow_tokens (t, 8289 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 8290 8291bad_im: /* :::::::::::::::::::: */ 8292 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "MODULE", ffesta_tokens[0], i, t); 8293 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 8294} 8295 8296/* ffestb_module1_ -- "MODULEPROCEDURE" or "MODULE" "PROCEDURE" 8297 8298 return ffestb_module1_; // to lexer 8299 8300 Make sure the statement has a valid form for the MODULEPROCEDURE statement. If it 8301 does, implement the statement. */ 8302 8303static ffelexHandler 8304ffestb_module1_ (ffelexToken t) 8305{ 8306 switch (ffelex_token_type (t)) 8307 { 8308 case FFELEX_typeNAME: 8309 if (!ffestb_local_.moduleprocedure.started 8310 && (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME)) 8311 { 8312 ffesta_confirmed (); 8313 ffelex_token_kill (ffesta_tokens[1]); 8314 } 8315 ffesta_tokens[1] = ffelex_token_use (t); 8316 return (ffelexHandler) ffestb_module2_; 8317 8318 case FFELEX_typeEOS: 8319 case FFELEX_typeSEMICOLON: 8320 if (ffestb_local_.moduleprocedure.started) 8321 break; /* Error if we've already seen NAME COMMA. */ 8322 ffesta_confirmed (); 8323 if (!ffesta_is_inhibited ()) 8324 ffestc_R1105 (ffesta_tokens[1]); 8325 ffelex_token_kill (ffesta_tokens[1]); 8326 return (ffelexHandler) ffesta_zero (t); 8327 8328 case FFELEX_typeCOMMA: 8329 case FFELEX_typeCOLONCOLON: 8330 ffesta_confirmed (); /* Error, but clearly intended. */ 8331 break; 8332 8333 default: 8334 break; 8335 } 8336 8337 if (ffestb_local_.moduleprocedure.started && !ffesta_is_inhibited ()) 8338 ffestc_R1205_finish (); 8339 else if (!ffestb_local_.moduleprocedure.started) 8340 ffelex_token_kill (ffesta_tokens[1]); 8341 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", t); 8342 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 8343} 8344 8345/* ffestb_module2_ -- "MODULE/PROCEDURE" NAME 8346 8347 return ffestb_module2_; // to lexer 8348 8349 Make sure the statement has a valid form for the MODULEPROCEDURE statement. If it 8350 does, implement the statement. */ 8351 8352static ffelexHandler 8353ffestb_module2_ (ffelexToken t) 8354{ 8355 switch (ffelex_token_type (t)) 8356 { 8357 case FFELEX_typeEOS: 8358 case FFELEX_typeSEMICOLON: 8359 if (!ffestb_local_.moduleprocedure.started) 8360 { 8361 ffesta_confirmed (); 8362 if (!ffesta_is_inhibited ()) 8363 ffestc_R1205_start (); 8364 } 8365 if (!ffesta_is_inhibited ()) 8366 { 8367 ffestc_R1205_item (ffesta_tokens[1]); 8368 ffestc_R1205_finish (); 8369 } 8370 ffelex_token_kill (ffesta_tokens[1]); 8371 return (ffelexHandler) ffesta_zero (t); 8372 8373 case FFELEX_typeCOMMA: 8374 if (!ffestb_local_.moduleprocedure.started) 8375 { 8376 ffestb_local_.moduleprocedure.started = TRUE; 8377 ffesta_confirmed (); 8378 if (!ffesta_is_inhibited ()) 8379 ffestc_R1205_start (); 8380 } 8381 if (!ffesta_is_inhibited ()) 8382 ffestc_R1205_item (ffesta_tokens[1]); 8383 ffelex_token_kill (ffesta_tokens[1]); 8384 return (ffelexHandler) ffestb_module1_; 8385 8386 default: 8387 break; 8388 } 8389 8390 if (ffestb_local_.moduleprocedure.started && !ffesta_is_inhibited ()) 8391 ffestc_R1205_finish (); 8392 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", t); 8393 ffelex_token_kill (ffesta_tokens[1]); 8394 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 8395} 8396 8397/* ffestb_module3_ -- "MODULE" NAME 8398 8399 return ffestb_module3_; // to lexer 8400 8401 Make sure the statement has a valid form for the MODULE statement. If it 8402 does, implement the statement. */ 8403 8404static ffelexHandler 8405ffestb_module3_ (ffelexToken t) 8406{ 8407 switch (ffelex_token_type (t)) 8408 { 8409 case FFELEX_typeEOS: 8410 case FFELEX_typeSEMICOLON: 8411 if (!ffesta_is_inhibited ()) 8412 ffestc_R1105 (ffesta_tokens[1]); 8413 ffelex_token_kill (ffesta_tokens[1]); 8414 return (ffelexHandler) ffesta_zero (t); 8415 8416 default: 8417 break; 8418 } 8419 8420 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE", t); 8421 ffelex_token_kill (ffesta_tokens[1]); 8422 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 8423} 8424 8425#endif 8426/* ffestb_R809 -- Parse the SELECTCASE statement 8427 8428 return ffestb_R809; // to lexer 8429 8430 Make sure the statement has a valid form for the SELECTCASE statement. 8431 If it does, implement the statement. */ 8432 8433ffelexHandler 8434ffestb_R809 (ffelexToken t) 8435{ 8436 ffeTokenLength i; 8437 const char *p; 8438 8439 switch (ffelex_token_type (ffesta_tokens[0])) 8440 { 8441 case FFELEX_typeNAME: 8442 switch (ffesta_first_kw) 8443 { 8444 case FFESTR_firstSELECT: 8445 if ((ffelex_token_type (t) != FFELEX_typeNAME) 8446 || (ffesta_second_kw != FFESTR_secondCASE)) 8447 goto bad_1; /* :::::::::::::::::::: */ 8448 ffesta_confirmed (); 8449 return (ffelexHandler) ffestb_R8091_; 8450 8451 case FFESTR_firstSELECTCASE: 8452 return (ffelexHandler) ffestb_R8091_ (t); 8453 8454 default: 8455 goto bad_0; /* :::::::::::::::::::: */ 8456 } 8457 8458 case FFELEX_typeNAMES: 8459 if (ffesta_first_kw != FFESTR_firstSELECTCASE) 8460 goto bad_0; /* :::::::::::::::::::: */ 8461 switch (ffelex_token_type (t)) 8462 { 8463 case FFELEX_typeCOMMA: 8464 case FFELEX_typeEOS: 8465 case FFELEX_typeSEMICOLON: 8466 case FFELEX_typeCOLONCOLON: 8467 ffesta_confirmed (); /* Error, but clearly intended. */ 8468 goto bad_1; /* :::::::::::::::::::: */ 8469 8470 default: 8471 goto bad_1; /* :::::::::::::::::::: */ 8472 8473 case FFELEX_typeOPEN_PAREN: 8474 break; 8475 } 8476 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSELECTCASE); 8477 if (*p != '\0') 8478 goto bad_i; /* :::::::::::::::::::: */ 8479 return (ffelexHandler) ffestb_R8091_ (t); 8480 8481 default: 8482 goto bad_0; /* :::::::::::::::::::: */ 8483 } 8484 8485bad_0: /* :::::::::::::::::::: */ 8486 if (ffesta_construct_name != NULL) 8487 { 8488 ffelex_token_kill (ffesta_construct_name); 8489 ffesta_construct_name = NULL; 8490 } 8491 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", ffesta_tokens[0]); 8492 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 8493 8494bad_1: /* :::::::::::::::::::: */ 8495 if (ffesta_construct_name != NULL) 8496 { 8497 ffelex_token_kill (ffesta_construct_name); 8498 ffesta_construct_name = NULL; 8499 } 8500 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", t); 8501 return (ffelexHandler) ffelex_swallow_tokens (t, 8502 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 8503 8504bad_i: /* :::::::::::::::::::: */ 8505 if (ffesta_construct_name != NULL) 8506 { 8507 ffelex_token_kill (ffesta_construct_name); 8508 ffesta_construct_name = NULL; 8509 } 8510 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", ffesta_tokens[0], i, t); 8511 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 8512} 8513 8514/* ffestb_R8091_ -- "SELECTCASE" or "SELECT" "CASE" 8515 8516 return ffestb_R8091_; // to lexer 8517 8518 Make sure the statement has a valid form for the SELECTCASE statement. If it 8519 does, implement the statement. */ 8520 8521static ffelexHandler 8522ffestb_R8091_ (ffelexToken t) 8523{ 8524 switch (ffelex_token_type (t)) 8525 { 8526 case FFELEX_typeOPEN_PAREN: 8527 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 8528 FFEEXPR_contextSELECTCASE, (ffeexprCallback) ffestb_R8092_); 8529 8530 case FFELEX_typeEOS: 8531 case FFELEX_typeSEMICOLON: 8532 case FFELEX_typeCOMMA: 8533 case FFELEX_typeCOLONCOLON: 8534 ffesta_confirmed (); /* Error, but clearly intended. */ 8535 break; 8536 8537 default: 8538 break; 8539 } 8540 8541 if (ffesta_construct_name != NULL) 8542 { 8543 ffelex_token_kill (ffesta_construct_name); 8544 ffesta_construct_name = NULL; 8545 } 8546 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", t); 8547 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 8548} 8549 8550/* ffestb_R8092_ -- "SELECT/CASE" OPEN_PAREN expr 8551 8552 (ffestb_R8092_) // to expression handler 8553 8554 Make sure the statement has a valid form for the SELECTCASE statement. If it 8555 does, implement the statement. */ 8556 8557static ffelexHandler 8558ffestb_R8092_ (ffelexToken ft, ffebld expr, ffelexToken t) 8559{ 8560 switch (ffelex_token_type (t)) 8561 { 8562 case FFELEX_typeCLOSE_PAREN: 8563 if (expr == NULL) 8564 break; 8565 ffesta_tokens[1] = ffelex_token_use (ft); 8566 ffestb_local_.selectcase.expr = expr; 8567 return (ffelexHandler) ffestb_R8093_; 8568 8569 default: 8570 break; 8571 } 8572 8573 if (ffesta_construct_name != NULL) 8574 { 8575 ffelex_token_kill (ffesta_construct_name); 8576 ffesta_construct_name = NULL; 8577 } 8578 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", t); 8579 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 8580} 8581 8582/* ffestb_R8093_ -- "SELECT/CASE" OPEN_PAREN expr CLOSE_PAREN 8583 8584 return ffestb_R8093_; // to lexer 8585 8586 Make sure the statement has a valid form for the SELECTCASE statement. If it 8587 does, implement the statement. */ 8588 8589static ffelexHandler 8590ffestb_R8093_ (ffelexToken t) 8591{ 8592 switch (ffelex_token_type (t)) 8593 { 8594 case FFELEX_typeEOS: 8595 case FFELEX_typeSEMICOLON: 8596 ffesta_confirmed (); 8597 if (!ffesta_is_inhibited ()) 8598 ffestc_R809 (ffesta_construct_name, ffestb_local_.selectcase.expr, 8599 ffesta_tokens[1]); 8600 ffelex_token_kill (ffesta_tokens[1]); 8601 if (ffesta_construct_name != NULL) 8602 { 8603 ffelex_token_kill (ffesta_construct_name); 8604 ffesta_construct_name = NULL; 8605 } 8606 return ffesta_zero (t); 8607 8608 case FFELEX_typeCOMMA: 8609 case FFELEX_typeCOLONCOLON: 8610 ffesta_confirmed (); /* Error, but clearly intended. */ 8611 break; 8612 8613 default: 8614 break; 8615 } 8616 8617 ffelex_token_kill (ffesta_tokens[1]); 8618 if (ffesta_construct_name != NULL) 8619 { 8620 ffelex_token_kill (ffesta_construct_name); 8621 ffesta_construct_name = NULL; 8622 } 8623 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", t); 8624 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 8625} 8626 8627/* ffestb_R810 -- Parse the CASE statement 8628 8629 return ffestb_R810; // to lexer 8630 8631 Make sure the statement has a valid form for the CASE statement. 8632 If it does, implement the statement. */ 8633 8634ffelexHandler 8635ffestb_R810 (ffelexToken t) 8636{ 8637 ffeTokenLength i; 8638 unsigned const char *p; 8639 8640 switch (ffelex_token_type (ffesta_tokens[0])) 8641 { 8642 case FFELEX_typeNAME: 8643 if (ffesta_first_kw != FFESTR_firstCASE) 8644 goto bad_0; /* :::::::::::::::::::: */ 8645 switch (ffelex_token_type (t)) 8646 { 8647 case FFELEX_typeCOMMA: 8648 case FFELEX_typeEOS: 8649 case FFELEX_typeSEMICOLON: 8650 case FFELEX_typeCOLONCOLON: 8651 ffesta_confirmed (); /* Error, but clearly intended. */ 8652 goto bad_1; /* :::::::::::::::::::: */ 8653 8654 default: 8655 goto bad_1; /* :::::::::::::::::::: */ 8656 8657 case FFELEX_typeNAME: 8658 ffesta_confirmed (); 8659 if (ffesta_second_kw != FFESTR_secondDEFAULT) 8660 goto bad_1; /* :::::::::::::::::::: */ 8661 ffestb_local_.case_stmt.cases = NULL; 8662 return (ffelexHandler) ffestb_R8101_; 8663 8664 case FFELEX_typeOPEN_PAREN: 8665 ffestb_local_.case_stmt.cases = ffestt_caselist_create (); 8666 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 8667 FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8103_); 8668 } 8669 8670 case FFELEX_typeNAMES: 8671 switch (ffesta_first_kw) 8672 { 8673 case FFESTR_firstCASEDEFAULT: 8674 switch (ffelex_token_type (t)) 8675 { 8676 case FFELEX_typeCOMMA: 8677 case FFELEX_typeCOLONCOLON: 8678 ffesta_confirmed (); /* Error, but clearly intended. */ 8679 goto bad_1; /* :::::::::::::::::::: */ 8680 8681 default: 8682 goto bad_1; /* :::::::::::::::::::: */ 8683 8684 case FFELEX_typeEOS: 8685 case FFELEX_typeSEMICOLON: 8686 ffesta_confirmed (); 8687 break; 8688 } 8689 ffestb_local_.case_stmt.cases = NULL; 8690 p = ffelex_token_text (ffesta_tokens[0]) 8691 + (i = FFESTR_firstlCASEDEFAULT); 8692 if (*p == '\0') 8693 return (ffelexHandler) ffestb_R8101_ (t); 8694 if (!ffesrc_is_name_init (*p)) 8695 goto bad_i; /* :::::::::::::::::::: */ 8696 ffesta_tokens[1] = ffelex_token_name_from_names (ffesta_tokens[0], i, 8697 0); 8698 return (ffelexHandler) ffestb_R8102_ (t); 8699 8700 case FFESTR_firstCASE: 8701 break; 8702 8703 default: 8704 goto bad_0; /* :::::::::::::::::::: */ 8705 } 8706 8707 switch (ffelex_token_type (t)) 8708 { 8709 case FFELEX_typeCOMMA: 8710 case FFELEX_typeEOS: 8711 case FFELEX_typeSEMICOLON: 8712 case FFELEX_typeCOLONCOLON: 8713 ffesta_confirmed (); /* Error, but clearly intended. */ 8714 goto bad_1; /* :::::::::::::::::::: */ 8715 8716 default: 8717 goto bad_1; /* :::::::::::::::::::: */ 8718 8719 case FFELEX_typeOPEN_PAREN: 8720 break; 8721 } 8722 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCASE); 8723 if (*p != '\0') 8724 goto bad_i; /* :::::::::::::::::::: */ 8725 ffestb_local_.case_stmt.cases = ffestt_caselist_create (); 8726 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 8727 FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8103_); 8728 8729 default: 8730 goto bad_0; /* :::::::::::::::::::: */ 8731 } 8732 8733bad_0: /* :::::::::::::::::::: */ 8734 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", ffesta_tokens[0]); 8735 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 8736 8737bad_1: /* :::::::::::::::::::: */ 8738 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t); 8739 return (ffelexHandler) ffelex_swallow_tokens (t, 8740 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 8741 8742bad_i: /* :::::::::::::::::::: */ 8743 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CASE", ffesta_tokens[0], i, t); 8744 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 8745} 8746 8747/* ffestb_R8101_ -- "CASE" case-selector 8748 8749 return ffestb_R8101_; // to lexer 8750 8751 Make sure the statement has a valid form for the CASE statement. If it 8752 does, implement the statement. */ 8753 8754static ffelexHandler 8755ffestb_R8101_ (ffelexToken t) 8756{ 8757 switch (ffelex_token_type (t)) 8758 { 8759 case FFELEX_typeNAME: 8760 ffesta_tokens[1] = ffelex_token_use (t); 8761 return (ffelexHandler) ffestb_R8102_; 8762 8763 case FFELEX_typeEOS: 8764 case FFELEX_typeSEMICOLON: 8765 ffesta_tokens[1] = NULL; 8766 return (ffelexHandler) ffestb_R8102_ (t); 8767 8768 case FFELEX_typeCOMMA: 8769 case FFELEX_typeCOLONCOLON: 8770 ffesta_confirmed (); /* Error, but clearly intended. */ 8771 break; 8772 8773 default: 8774 break; 8775 } 8776 8777 if (ffestb_local_.case_stmt.cases != NULL) 8778 ffestt_caselist_kill (ffestb_local_.case_stmt.cases); 8779 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t); 8780 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 8781} 8782 8783/* ffestb_R8102_ -- "CASE" case-selector [NAME] 8784 8785 return ffestb_R8102_; // to lexer 8786 8787 Make sure the statement has a valid form for the CASE statement. If it 8788 does, implement the statement. */ 8789 8790static ffelexHandler 8791ffestb_R8102_ (ffelexToken t) 8792{ 8793 switch (ffelex_token_type (t)) 8794 { 8795 case FFELEX_typeEOS: 8796 case FFELEX_typeSEMICOLON: 8797 ffesta_confirmed (); 8798 if (!ffesta_is_inhibited ()) 8799 ffestc_R810 (ffestb_local_.case_stmt.cases, ffesta_tokens[1]); 8800 if (ffestb_local_.case_stmt.cases != NULL) 8801 ffestt_caselist_kill (ffestb_local_.case_stmt.cases); 8802 if (ffesta_tokens[1] != NULL) 8803 ffelex_token_kill (ffesta_tokens[1]); 8804 return (ffelexHandler) ffesta_zero (t); 8805 8806 case FFELEX_typeCOMMA: 8807 case FFELEX_typeCOLONCOLON: 8808 ffesta_confirmed (); /* Error, but clearly intended. */ 8809 break; 8810 8811 default: 8812 break; 8813 } 8814 8815 if (ffestb_local_.case_stmt.cases != NULL) 8816 ffestt_caselist_kill (ffestb_local_.case_stmt.cases); 8817 if (ffesta_tokens[1] != NULL) 8818 ffelex_token_kill (ffesta_tokens[1]); 8819 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t); 8820 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 8821} 8822 8823/* ffestb_R8103_ -- "CASE" OPEN_PAREN expr 8824 8825 (ffestb_R8103_) // to expression handler 8826 8827 Make sure the statement has a valid form for the CASE statement. If it 8828 does, implement the statement. */ 8829 8830static ffelexHandler 8831ffestb_R8103_ (ffelexToken ft, ffebld expr, ffelexToken t) 8832{ 8833 switch (ffelex_token_type (t)) 8834 { 8835 case FFELEX_typeCLOSE_PAREN: 8836 ffestt_caselist_append (ffestb_local_.case_stmt.cases, FALSE, expr, NULL, 8837 ffelex_token_use (ft)); 8838 return (ffelexHandler) ffestb_R8101_; 8839 8840 case FFELEX_typeCOMMA: 8841 ffestt_caselist_append (ffestb_local_.case_stmt.cases, FALSE, expr, NULL, 8842 ffelex_token_use (ft)); 8843 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 8844 FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8103_); 8845 8846 case FFELEX_typeCOLON: 8847 ffestt_caselist_append (ffestb_local_.case_stmt.cases, TRUE, expr, NULL, 8848 ffelex_token_use (ft)); /* NULL second expr for 8849 now, just plug in. */ 8850 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 8851 FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8104_); 8852 8853 default: 8854 break; 8855 } 8856 8857 ffestt_caselist_kill (ffestb_local_.case_stmt.cases); 8858 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t); 8859 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 8860} 8861 8862/* ffestb_R8104_ -- "CASE" OPEN_PAREN expr COLON expr 8863 8864 (ffestb_R8104_) // to expression handler 8865 8866 Make sure the statement has a valid form for the CASE statement. If it 8867 does, implement the statement. */ 8868 8869static ffelexHandler 8870ffestb_R8104_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t) 8871{ 8872 switch (ffelex_token_type (t)) 8873 { 8874 case FFELEX_typeCLOSE_PAREN: 8875 ffestb_local_.case_stmt.cases->previous->expr2 = expr; 8876 return (ffelexHandler) ffestb_R8101_; 8877 8878 case FFELEX_typeCOMMA: 8879 ffestb_local_.case_stmt.cases->previous->expr2 = expr; 8880 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 8881 FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8103_); 8882 8883 default: 8884 break; 8885 } 8886 8887 ffestt_caselist_kill (ffestb_local_.case_stmt.cases); 8888 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t); 8889 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 8890} 8891 8892/* ffestb_R1001 -- Parse a FORMAT statement 8893 8894 return ffestb_R1001; // to lexer 8895 8896 Make sure the statement has a valid form for an FORMAT statement. 8897 If it does, implement the statement. */ 8898 8899ffelexHandler 8900ffestb_R1001 (ffelexToken t) 8901{ 8902 ffesttFormatList f; 8903 8904 switch (ffelex_token_type (ffesta_tokens[0])) 8905 { 8906 case FFELEX_typeNAME: 8907 if (ffesta_first_kw != FFESTR_firstFORMAT) 8908 goto bad_0; /* :::::::::::::::::::: */ 8909 break; 8910 8911 case FFELEX_typeNAMES: 8912 if (ffesta_first_kw != FFESTR_firstFORMAT) 8913 goto bad_0; /* :::::::::::::::::::: */ 8914 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlFORMAT) 8915 goto bad_0; /* :::::::::::::::::::: */ 8916 break; 8917 8918 default: 8919 goto bad_0; /* :::::::::::::::::::: */ 8920 } 8921 8922 switch (ffelex_token_type (t)) 8923 { 8924 case FFELEX_typeOPEN_PAREN: 8925 ffestb_local_.format.complained = FALSE; 8926 ffestb_local_.format.f = NULL; /* No parent yet. */ 8927 ffestb_local_.format.f = ffestt_formatlist_create (NULL, 8928 ffelex_token_use (t)); 8929 ffelex_set_names_pure (TRUE); /* Have even free-form lexer give us 8930 NAMES. */ 8931 return (ffelexHandler) ffestb_R10011_; 8932 8933 case FFELEX_typeOPEN_ARRAY:/* "(/". */ 8934 ffesta_confirmed (); 8935 ffestb_local_.format.complained = FALSE; 8936 ffestb_local_.format.f = ffestt_formatlist_create (NULL, 8937 ffelex_token_use (t)); 8938 f = ffestt_formatlist_append (ffestb_local_.format.f); 8939 f->type = FFESTP_formattypeSLASH; 8940 f->t = ffelex_token_use (t); 8941 f->u.R1010.val.present = FALSE; 8942 f->u.R1010.val.rtexpr = FALSE; 8943 f->u.R1010.val.t = NULL; 8944 f->u.R1010.val.u.unsigned_val = 1; 8945 ffelex_set_names_pure (TRUE); /* Have even free-form lexer give us 8946 NAMES. */ 8947 return (ffelexHandler) ffestb_R100112_; 8948 8949 case FFELEX_typeEOS: 8950 case FFELEX_typeSEMICOLON: 8951 case FFELEX_typeCOMMA: 8952 case FFELEX_typeCOLONCOLON: 8953 ffesta_confirmed (); /* Error, but clearly intended. */ 8954 goto bad_1; /* :::::::::::::::::::: */ 8955 8956 default: 8957 goto bad_1; /* :::::::::::::::::::: */ 8958 } 8959 8960bad_0: /* :::::::::::::::::::: */ 8961 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", ffesta_tokens[0]); 8962 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 8963 8964bad_1: /* :::::::::::::::::::: */ 8965 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t); 8966 return (ffelexHandler) ffelex_swallow_tokens (t, 8967 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 8968} 8969 8970/* ffestb_R10011_ -- "FORMAT" OPEN_PAREN expr 8971 8972 return ffestb_R10011_; // to lexer 8973 8974 For CLOSE_PAREN, wrap up the format list and if it is the top-level one, 8975 exit. For anything else, pass it to _2_. */ 8976 8977static ffelexHandler 8978ffestb_R10011_ (ffelexToken t) 8979{ 8980 ffesttFormatList f; 8981 8982 switch (ffelex_token_type (t)) 8983 { 8984 case FFELEX_typeCLOSE_PAREN: 8985 break; 8986 8987 default: 8988 return (ffelexHandler) ffestb_R10012_ (t); 8989 } 8990 8991 /* If we have a format we're working on, continue working on it. */ 8992 8993 f = ffestb_local_.format.f->u.root.parent; 8994 8995 if (f != NULL) 8996 { 8997 ffestb_local_.format.f = f->next; 8998 return (ffelexHandler) ffestb_R100111_; 8999 } 9000 9001 return (ffelexHandler) ffestb_R100114_; 9002} 9003 9004/* ffestb_R10012_ -- "FORMAT" OPEN_PAREN [format-item-list] 9005 9006 return ffestb_R10012_; // to lexer 9007 9008 The initial state for a format-item. Here, just handle the initial 9009 number, sign for number, or run-time expression. Also handle spurious 9010 comma, close-paren (indicating spurious comma), close-array (like 9011 close-paren but preceded by slash), and quoted strings. */ 9012 9013static ffelexHandler 9014ffestb_R10012_ (ffelexToken t) 9015{ 9016 unsigned long unsigned_val; 9017 ffesttFormatList f; 9018 9019 switch (ffelex_token_type (t)) 9020 { 9021 case FFELEX_typeOPEN_ANGLE: 9022 ffesta_confirmed (); 9023 ffestb_local_.format.pre.t = ffelex_token_use (t); 9024 ffelex_set_names_pure (FALSE); 9025 if (!ffesta_seen_first_exec && !ffestb_local_.format.complained) 9026 { 9027 ffestb_local_.format.complained = TRUE; 9028 ffebad_start (FFEBAD_FORMAT_EXPR_SPEC); 9029 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); 9030 ffebad_finish (); 9031 } 9032 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 9033 FFEEXPR_contextFORMAT, (ffeexprCallback) ffestb_R100115_); 9034 9035 case FFELEX_typeNUMBER: 9036 ffestb_local_.format.sign = FALSE; /* No sign present. */ 9037 ffestb_local_.format.pre.present = TRUE; 9038 ffestb_local_.format.pre.rtexpr = FALSE; 9039 ffestb_local_.format.pre.t = ffelex_token_use (t); 9040 ffestb_local_.format.pre.u.unsigned_val = unsigned_val 9041 = strtoul (ffelex_token_text (t), NULL, 10); 9042 ffelex_set_expecting_hollerith (unsigned_val, '\0', 9043 ffelex_token_where_line (t), 9044 ffelex_token_where_column (t)); 9045 return (ffelexHandler) ffestb_R10014_; 9046 9047 case FFELEX_typePLUS: 9048 ffestb_local_.format.sign = TRUE; /* Positive. */ 9049 ffestb_local_.format.pre.t = ffelex_token_use (t); 9050 return (ffelexHandler) ffestb_R10013_; 9051 9052 case FFELEX_typeMINUS: 9053 ffestb_local_.format.sign = FALSE; /* Negative. */ 9054 ffestb_local_.format.pre.t = ffelex_token_use (t); 9055 return (ffelexHandler) ffestb_R10013_; 9056 9057 case FFELEX_typeCOLON: 9058 case FFELEX_typeCOLONCOLON:/* "::". */ 9059 case FFELEX_typeSLASH: 9060 case FFELEX_typeCONCAT: /* "//". */ 9061 case FFELEX_typeNAMES: 9062 case FFELEX_typeDOLLAR: 9063 case FFELEX_typeOPEN_PAREN: 9064 case FFELEX_typeOPEN_ARRAY:/* "(/". */ 9065 ffestb_local_.format.sign = FALSE; /* No sign present. */ 9066 ffestb_local_.format.pre.present = FALSE; 9067 ffestb_local_.format.pre.rtexpr = FALSE; 9068 ffestb_local_.format.pre.t = NULL; 9069 ffestb_local_.format.pre.u.unsigned_val = 1; 9070 return (ffelexHandler) ffestb_R10014_ (t); 9071 9072 case FFELEX_typeCOMMA: 9073 ffebad_start (FFEBAD_FORMAT_EXTRA_COMMA); 9074 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); 9075 ffebad_finish (); 9076 return (ffelexHandler) ffestb_R10012_; 9077 9078 case FFELEX_typeCLOSE_PAREN: 9079 ffebad_start (FFEBAD_FORMAT_EXTRA_COMMA); 9080 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); 9081 ffebad_finish (); 9082 f = ffestb_local_.format.f->u.root.parent; 9083 if (f == NULL) 9084 return (ffelexHandler) ffestb_R100114_; 9085 ffestb_local_.format.f = f->next; 9086 return (ffelexHandler) ffestb_R100111_; 9087 9088 case FFELEX_typeCLOSE_ARRAY: /* "/)". */ 9089 f = ffestt_formatlist_append (ffestb_local_.format.f); 9090 f->type = FFESTP_formattypeSLASH; 9091 f->t = ffelex_token_use (t); 9092 f->u.R1010.val.present = FALSE; 9093 f->u.R1010.val.rtexpr = FALSE; 9094 f->u.R1010.val.t = NULL; 9095 f->u.R1010.val.u.unsigned_val = 1; 9096 f = ffestb_local_.format.f->u.root.parent; 9097 if (f == NULL) 9098 return (ffelexHandler) ffestb_R100114_; 9099 ffestb_local_.format.f = f->next; 9100 return (ffelexHandler) ffestb_R100111_; 9101 9102 case FFELEX_typeEOS: 9103 case FFELEX_typeSEMICOLON: 9104 ffesta_confirmed (); 9105 ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_PAREN, t); 9106 for (f = ffestb_local_.format.f; 9107 f->u.root.parent != NULL; 9108 f = f->u.root.parent->next) 9109 ; 9110 ffestb_local_.format.f = f; 9111 return (ffelexHandler) ffestb_R100114_ (t); 9112 9113 case FFELEX_typeQUOTE: 9114 if (ffe_is_vxt ()) 9115 break; /* Error, probably something like FORMAT("17) 9116 = X. */ 9117 ffelex_set_expecting_hollerith (-1, '\"', 9118 ffelex_token_where_line (t), 9119 ffelex_token_where_column (t)); /* Don't have to unset 9120 this one. */ 9121 return (ffelexHandler) ffestb_R100113_; 9122 9123 case FFELEX_typeAPOSTROPHE: 9124#if 0 /* No apparent need for this, and not killed 9125 anywhere. */ 9126 ffesta_tokens[1] = ffelex_token_use (t); 9127#endif 9128 ffelex_set_expecting_hollerith (-1, '\'', 9129 ffelex_token_where_line (t), 9130 ffelex_token_where_column (t)); /* Don't have to unset 9131 this one. */ 9132 return (ffelexHandler) ffestb_R100113_; 9133 9134 default: 9135 break; 9136 } 9137 9138 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t); 9139 ffestt_formatlist_kill (ffestb_local_.format.f); 9140 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 9141} 9142 9143/* ffestb_R10013_ -- "FORMAT" OPEN_PAREN [format-item-list] PLUS/MINUS 9144 9145 return ffestb_R10013_; // to lexer 9146 9147 Expect a NUMBER or complain about and then ignore the PLUS/MINUS. */ 9148 9149static ffelexHandler 9150ffestb_R10013_ (ffelexToken t) 9151{ 9152 unsigned long unsigned_val; 9153 9154 switch (ffelex_token_type (t)) 9155 { 9156 case FFELEX_typeNUMBER: 9157 ffestb_local_.format.pre.present = TRUE; 9158 ffestb_local_.format.pre.rtexpr = FALSE; 9159 unsigned_val = strtoul (ffelex_token_text (t), NULL, 10); 9160 ffestb_local_.format.pre.u.signed_val = ffestb_local_.format.sign 9161 ? unsigned_val : -unsigned_val; 9162 ffestb_local_.format.sign = TRUE; /* Sign present. */ 9163 return (ffelexHandler) ffestb_R10014_; 9164 9165 default: 9166 ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN); 9167 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t), 9168 ffelex_token_where_column (ffestb_local_.format.pre.t)); 9169 ffebad_finish (); 9170 ffelex_token_kill (ffestb_local_.format.pre.t); 9171 return (ffelexHandler) ffestb_R10012_ (t); 9172 } 9173} 9174 9175/* ffestb_R10014_ -- "FORMAT" OPEN_PAREN [format-item-list] [[+/-] NUMBER] 9176 9177 return ffestb_R10014_; // to lexer 9178 9179 Here is where we expect to see the actual NAMES, COLON, SLASH, OPEN_PAREN, 9180 OPEN_ARRAY, COLONCOLON, CONCAT, DOLLAR, or HOLLERITH that identifies what 9181 kind of format-item we're dealing with. But if we see a NUMBER instead, it 9182 means free-form spaces number like "5 6 X", so scale the current number 9183 accordingly and reenter this state. (I really wouldn't be surprised if 9184 they change this spacing rule in the F90 spec so that you can't embed 9185 spaces within numbers or within keywords like BN in a free-source-form 9186 program.) */ 9187 9188static ffelexHandler 9189ffestb_R10014_ (ffelexToken t) 9190{ 9191 ffesttFormatList f; 9192 ffeTokenLength i; 9193 const char *p; 9194 ffestrFormat kw; 9195 9196 ffelex_set_expecting_hollerith (0, '\0', 9197 ffewhere_line_unknown (), 9198 ffewhere_column_unknown ()); 9199 9200 switch (ffelex_token_type (t)) 9201 { 9202 case FFELEX_typeHOLLERITH: 9203 f = ffestt_formatlist_append (ffestb_local_.format.f); 9204 f->type = FFESTP_formattypeR1016; 9205 f->t = ffelex_token_use (t); 9206 ffelex_token_kill (ffestb_local_.format.pre.t); /* It WAS present! */ 9207 return (ffelexHandler) ffestb_R100111_; 9208 9209 case FFELEX_typeNUMBER: 9210 assert (ffestb_local_.format.pre.present); 9211 ffesta_confirmed (); 9212 if (ffestb_local_.format.pre.rtexpr) 9213 { 9214 ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER); 9215 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); 9216 ffebad_finish (); 9217 return (ffelexHandler) ffestb_R10014_; 9218 } 9219 if (ffestb_local_.format.sign) 9220 { 9221 for (i = ffelex_token_length (t) + 1; i > 0; --i) 9222 ffestb_local_.format.pre.u.signed_val *= 10; 9223 ffestb_local_.format.pre.u.signed_val += strtoul (ffelex_token_text (t), 9224 NULL, 10); 9225 } 9226 else 9227 { 9228 for (i = ffelex_token_length (t) + 1; i > 0; --i) 9229 ffestb_local_.format.pre.u.unsigned_val *= 10; 9230 ffestb_local_.format.pre.u.unsigned_val += strtoul (ffelex_token_text (t), 9231 NULL, 10); 9232 ffelex_set_expecting_hollerith (ffestb_local_.format.pre.u.unsigned_val, 9233 '\0', 9234 ffelex_token_where_line (t), 9235 ffelex_token_where_column (t)); 9236 } 9237 return (ffelexHandler) ffestb_R10014_; 9238 9239 case FFELEX_typeCOLONCOLON: /* "::". */ 9240 if (ffestb_local_.format.pre.present) 9241 { 9242 ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_COLON_SPEC, 9243 ffestb_local_.format.pre.t); 9244 ffelex_token_kill (ffestb_local_.format.pre.t); 9245 ffestb_local_.format.pre.present = FALSE; 9246 } 9247 else 9248 { 9249 f = ffestt_formatlist_append (ffestb_local_.format.f); 9250 f->type = FFESTP_formattypeCOLON; 9251 f->t = ffelex_token_use (t); 9252 f->u.R1010.val.present = FALSE; 9253 f->u.R1010.val.rtexpr = FALSE; 9254 f->u.R1010.val.t = NULL; 9255 f->u.R1010.val.u.unsigned_val = 1; 9256 } 9257 f = ffestt_formatlist_append (ffestb_local_.format.f); 9258 f->type = FFESTP_formattypeCOLON; 9259 f->t = ffelex_token_use (t); 9260 f->u.R1010.val.present = FALSE; 9261 f->u.R1010.val.rtexpr = FALSE; 9262 f->u.R1010.val.t = NULL; 9263 f->u.R1010.val.u.unsigned_val = 1; 9264 return (ffelexHandler) ffestb_R100112_; 9265 9266 case FFELEX_typeCOLON: 9267 if (ffestb_local_.format.pre.present) 9268 { 9269 ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_COLON_SPEC, 9270 ffestb_local_.format.pre.t); 9271 ffelex_token_kill (ffestb_local_.format.pre.t); 9272 return (ffelexHandler) ffestb_R100112_; 9273 } 9274 f = ffestt_formatlist_append (ffestb_local_.format.f); 9275 f->type = FFESTP_formattypeCOLON; 9276 f->t = ffelex_token_use (t); 9277 f->u.R1010.val.present = FALSE; 9278 f->u.R1010.val.rtexpr = FALSE; 9279 f->u.R1010.val.t = NULL; 9280 f->u.R1010.val.u.unsigned_val = 1; 9281 return (ffelexHandler) ffestb_R100112_; 9282 9283 case FFELEX_typeCONCAT: /* "//". */ 9284 if (ffestb_local_.format.sign) 9285 { 9286 ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN); 9287 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t), 9288 ffelex_token_where_column (ffestb_local_.format.pre.t)); 9289 ffebad_finish (); 9290 ffestb_local_.format.pre.u.unsigned_val 9291 = (ffestb_local_.format.pre.u.signed_val < 0) 9292 ? -ffestb_local_.format.pre.u.signed_val 9293 : ffestb_local_.format.pre.u.signed_val; 9294 } 9295 f = ffestt_formatlist_append (ffestb_local_.format.f); 9296 f->type = FFESTP_formattypeSLASH; 9297 f->t = ffelex_token_use (t); 9298 f->u.R1010.val = ffestb_local_.format.pre; 9299 ffestb_local_.format.pre.present = FALSE; 9300 ffestb_local_.format.pre.rtexpr = FALSE; 9301 ffestb_local_.format.pre.t = NULL; 9302 ffestb_local_.format.pre.u.unsigned_val = 1; 9303 f = ffestt_formatlist_append (ffestb_local_.format.f); 9304 f->type = FFESTP_formattypeSLASH; 9305 f->t = ffelex_token_use (t); 9306 f->u.R1010.val = ffestb_local_.format.pre; 9307 return (ffelexHandler) ffestb_R100112_; 9308 9309 case FFELEX_typeSLASH: 9310 if (ffestb_local_.format.sign) 9311 { 9312 ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN); 9313 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t), 9314 ffelex_token_where_column (ffestb_local_.format.pre.t)); 9315 ffebad_finish (); 9316 ffestb_local_.format.pre.u.unsigned_val 9317 = (ffestb_local_.format.pre.u.signed_val < 0) 9318 ? -ffestb_local_.format.pre.u.signed_val 9319 : ffestb_local_.format.pre.u.signed_val; 9320 } 9321 f = ffestt_formatlist_append (ffestb_local_.format.f); 9322 f->type = FFESTP_formattypeSLASH; 9323 f->t = ffelex_token_use (t); 9324 f->u.R1010.val = ffestb_local_.format.pre; 9325 return (ffelexHandler) ffestb_R100112_; 9326 9327 case FFELEX_typeOPEN_PAREN: 9328 if (ffestb_local_.format.sign) 9329 { 9330 ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN); 9331 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t), 9332 ffelex_token_where_column (ffestb_local_.format.pre.t)); 9333 ffebad_finish (); 9334 ffestb_local_.format.pre.u.unsigned_val 9335 = (ffestb_local_.format.pre.u.signed_val < 0) 9336 ? -ffestb_local_.format.pre.u.signed_val 9337 : ffestb_local_.format.pre.u.signed_val; 9338 } 9339 f = ffestt_formatlist_append (ffestb_local_.format.f); 9340 f->type = FFESTP_formattypeFORMAT; 9341 f->t = ffelex_token_use (t); 9342 f->u.R1003D.R1004 = ffestb_local_.format.pre; 9343 f->u.R1003D.format = ffestb_local_.format.f 9344 = ffestt_formatlist_create (f, ffelex_token_use (t)); 9345 return (ffelexHandler) ffestb_R10011_; 9346 9347 case FFELEX_typeOPEN_ARRAY:/* "(/". */ 9348 if (ffestb_local_.format.sign) 9349 { 9350 ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN); 9351 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t), 9352 ffelex_token_where_column (ffestb_local_.format.pre.t)); 9353 ffebad_finish (); 9354 ffestb_local_.format.pre.u.unsigned_val 9355 = (ffestb_local_.format.pre.u.signed_val < 0) 9356 ? -ffestb_local_.format.pre.u.signed_val 9357 : ffestb_local_.format.pre.u.signed_val; 9358 } 9359 f = ffestt_formatlist_append (ffestb_local_.format.f); 9360 f->type = FFESTP_formattypeFORMAT; 9361 f->t = ffelex_token_use (t); 9362 f->u.R1003D.R1004 = ffestb_local_.format.pre; 9363 f->u.R1003D.format = ffestb_local_.format.f 9364 = ffestt_formatlist_create (f, ffelex_token_use (t)); 9365 f = ffestt_formatlist_append (ffestb_local_.format.f); 9366 f->type = FFESTP_formattypeSLASH; 9367 f->t = ffelex_token_use (t); 9368 f->u.R1010.val.present = FALSE; 9369 f->u.R1010.val.rtexpr = FALSE; 9370 f->u.R1010.val.t = NULL; 9371 f->u.R1010.val.u.unsigned_val = 1; 9372 return (ffelexHandler) ffestb_R100112_; 9373 9374 case FFELEX_typeCLOSE_ARRAY: /* "/)". */ 9375 f = ffestt_formatlist_append (ffestb_local_.format.f); 9376 f->type = FFESTP_formattypeSLASH; 9377 f->t = ffelex_token_use (t); 9378 f->u.R1010.val = ffestb_local_.format.pre; 9379 f = ffestb_local_.format.f->u.root.parent; 9380 if (f == NULL) 9381 return (ffelexHandler) ffestb_R100114_; 9382 ffestb_local_.format.f = f->next; 9383 return (ffelexHandler) ffestb_R100111_; 9384 9385 case FFELEX_typeQUOTE: 9386 if (ffe_is_vxt ()) 9387 break; /* A totally bad character in a VXT FORMAT. */ 9388 ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER); 9389 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t), 9390 ffelex_token_where_column (ffestb_local_.format.pre.t)); 9391 ffebad_finish (); 9392 ffelex_token_kill (ffestb_local_.format.pre.t); 9393 ffesta_confirmed (); 9394#if 0 /* No apparent need for this, and not killed 9395 anywhere. */ 9396 ffesta_tokens[1] = ffelex_token_use (t); 9397#endif 9398 ffelex_set_expecting_hollerith (-1, '\"', 9399 ffelex_token_where_line (t), 9400 ffelex_token_where_column (t)); /* Don't have to unset 9401 this one. */ 9402 return (ffelexHandler) ffestb_R100113_; 9403 9404 case FFELEX_typeAPOSTROPHE: 9405 ffesta_confirmed (); 9406 ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER); 9407 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t), 9408 ffelex_token_where_column (ffestb_local_.format.pre.t)); 9409 ffebad_finish (); 9410 ffelex_token_kill (ffestb_local_.format.pre.t); 9411#if 0 /* No apparent need for this, and not killed 9412 anywhere. */ 9413 ffesta_tokens[1] = ffelex_token_use (t); 9414#endif 9415 ffelex_set_expecting_hollerith (-1, '\'', ffelex_token_where_line (t), 9416 ffelex_token_where_column (t)); /* Don't have to unset 9417 this one. */ 9418 return (ffelexHandler) ffestb_R100113_; 9419 9420 case FFELEX_typeEOS: 9421 case FFELEX_typeSEMICOLON: 9422 ffesta_confirmed (); 9423 ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_PAREN, t); 9424 for (f = ffestb_local_.format.f; 9425 f->u.root.parent != NULL; 9426 f = f->u.root.parent->next) 9427 ; 9428 ffestb_local_.format.f = f; 9429 ffelex_token_kill (ffestb_local_.format.pre.t); 9430 return (ffelexHandler) ffestb_R100114_ (t); 9431 9432 case FFELEX_typeDOLLAR: 9433 ffestb_local_.format.t = ffelex_token_use (t); 9434 if (ffestb_local_.format.pre.present) 9435 ffesta_confirmed (); /* Number preceding this invalid elsewhere. */ 9436 ffestb_local_.format.current = FFESTP_formattypeDOLLAR; 9437 return (ffelexHandler) ffestb_R10015_; 9438 9439 case FFELEX_typeNAMES: 9440 kw = ffestr_format (t); 9441 ffestb_local_.format.t = ffelex_token_use (t); 9442 switch (kw) 9443 { 9444 case FFESTR_formatI: 9445 if (ffestb_local_.format.pre.present) 9446 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */ 9447 ffestb_local_.format.current = FFESTP_formattypeI; 9448 i = FFESTR_formatlI; 9449 break; 9450 9451 case FFESTR_formatB: 9452 if (ffestb_local_.format.pre.present) 9453 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */ 9454 ffestb_local_.format.current = FFESTP_formattypeB; 9455 i = FFESTR_formatlB; 9456 break; 9457 9458 case FFESTR_formatO: 9459 if (ffestb_local_.format.pre.present) 9460 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */ 9461 ffestb_local_.format.current = FFESTP_formattypeO; 9462 i = FFESTR_formatlO; 9463 break; 9464 9465 case FFESTR_formatZ: 9466 if (ffestb_local_.format.pre.present) 9467 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */ 9468 ffestb_local_.format.current = FFESTP_formattypeZ; 9469 i = FFESTR_formatlZ; 9470 break; 9471 9472 case FFESTR_formatF: 9473 if (ffestb_local_.format.pre.present) 9474 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */ 9475 ffestb_local_.format.current = FFESTP_formattypeF; 9476 i = FFESTR_formatlF; 9477 break; 9478 9479 case FFESTR_formatE: 9480 ffestb_local_.format.current = FFESTP_formattypeE; 9481 i = FFESTR_formatlE; 9482 break; 9483 9484 case FFESTR_formatEN: 9485 if (ffestb_local_.format.pre.present) 9486 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */ 9487 ffestb_local_.format.current = FFESTP_formattypeEN; 9488 i = FFESTR_formatlEN; 9489 break; 9490 9491 case FFESTR_formatG: 9492 if (ffestb_local_.format.pre.present) 9493 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */ 9494 ffestb_local_.format.current = FFESTP_formattypeG; 9495 i = FFESTR_formatlG; 9496 break; 9497 9498 case FFESTR_formatL: 9499 if (ffestb_local_.format.pre.present) 9500 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */ 9501 ffestb_local_.format.current = FFESTP_formattypeL; 9502 i = FFESTR_formatlL; 9503 break; 9504 9505 case FFESTR_formatA: 9506 if (ffestb_local_.format.pre.present) 9507 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */ 9508 ffestb_local_.format.current = FFESTP_formattypeA; 9509 i = FFESTR_formatlA; 9510 break; 9511 9512 case FFESTR_formatD: 9513 ffestb_local_.format.current = FFESTP_formattypeD; 9514 i = FFESTR_formatlD; 9515 break; 9516 9517 case FFESTR_formatQ: 9518 ffestb_local_.format.current = FFESTP_formattypeQ; 9519 i = FFESTR_formatlQ; 9520 break; 9521 9522 case FFESTR_formatDOLLAR: 9523 if (ffestb_local_.format.pre.present) 9524 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */ 9525 ffestb_local_.format.current = FFESTP_formattypeDOLLAR; 9526 i = FFESTR_formatlDOLLAR; 9527 break; 9528 9529 case FFESTR_formatP: 9530 if (ffestb_local_.format.pre.present) 9531 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */ 9532 ffestb_local_.format.current = FFESTP_formattypeP; 9533 i = FFESTR_formatlP; 9534 break; 9535 9536 case FFESTR_formatT: 9537 if (ffestb_local_.format.pre.present) 9538 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */ 9539 ffestb_local_.format.current = FFESTP_formattypeT; 9540 i = FFESTR_formatlT; 9541 break; 9542 9543 case FFESTR_formatTL: 9544 if (ffestb_local_.format.pre.present) 9545 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */ 9546 ffestb_local_.format.current = FFESTP_formattypeTL; 9547 i = FFESTR_formatlTL; 9548 break; 9549 9550 case FFESTR_formatTR: 9551 if (ffestb_local_.format.pre.present) 9552 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */ 9553 ffestb_local_.format.current = FFESTP_formattypeTR; 9554 i = FFESTR_formatlTR; 9555 break; 9556 9557 case FFESTR_formatX: 9558 if (ffestb_local_.format.pre.present) 9559 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */ 9560 ffestb_local_.format.current = FFESTP_formattypeX; 9561 i = FFESTR_formatlX; 9562 break; 9563 9564 case FFESTR_formatS: 9565 if (ffestb_local_.format.pre.present) 9566 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */ 9567 ffestb_local_.format.current = FFESTP_formattypeS; 9568 i = FFESTR_formatlS; 9569 break; 9570 9571 case FFESTR_formatSP: 9572 if (ffestb_local_.format.pre.present) 9573 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */ 9574 ffestb_local_.format.current = FFESTP_formattypeSP; 9575 i = FFESTR_formatlSP; 9576 break; 9577 9578 case FFESTR_formatSS: 9579 if (ffestb_local_.format.pre.present) 9580 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */ 9581 ffestb_local_.format.current = FFESTP_formattypeSS; 9582 i = FFESTR_formatlSS; 9583 break; 9584 9585 case FFESTR_formatBN: 9586 if (ffestb_local_.format.pre.present) 9587 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */ 9588 ffestb_local_.format.current = FFESTP_formattypeBN; 9589 i = FFESTR_formatlBN; 9590 break; 9591 9592 case FFESTR_formatBZ: 9593 if (ffestb_local_.format.pre.present) 9594 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */ 9595 ffestb_local_.format.current = FFESTP_formattypeBZ; 9596 i = FFESTR_formatlBZ; 9597 break; 9598 9599 case FFESTR_formatH: /* Error, either "H" or "<expr>H". */ 9600 if (ffestb_local_.format.pre.present) 9601 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */ 9602 ffestb_local_.format.current = FFESTP_formattypeH; 9603 i = FFESTR_formatlH; 9604 break; 9605 9606 case FFESTR_formatPD: 9607 if (ffestb_local_.format.pre.present) 9608 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */ 9609 ffestb_subr_R1001_append_p_ (); 9610 ffestb_local_.format.t = ffelex_token_name_from_names (t, 9611 FFESTR_formatlP, 1); 9612 ffestb_local_.format.sign = FALSE; 9613 ffestb_local_.format.pre.present = FALSE; 9614 ffestb_local_.format.pre.rtexpr = FALSE; 9615 ffestb_local_.format.pre.t = NULL; 9616 ffestb_local_.format.pre.u.unsigned_val = 1; 9617 ffestb_local_.format.current = FFESTP_formattypeD; 9618 i = FFESTR_formatlPD; 9619 break; 9620 9621 case FFESTR_formatPE: 9622 if (ffestb_local_.format.pre.present) 9623 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */ 9624 ffestb_subr_R1001_append_p_ (); 9625 ffestb_local_.format.t = ffelex_token_name_from_names (t, 9626 FFESTR_formatlP, 1); 9627 ffestb_local_.format.sign = FALSE; 9628 ffestb_local_.format.pre.present = FALSE; 9629 ffestb_local_.format.pre.rtexpr = FALSE; 9630 ffestb_local_.format.pre.t = NULL; 9631 ffestb_local_.format.pre.u.unsigned_val = 1; 9632 ffestb_local_.format.current = FFESTP_formattypeE; 9633 i = FFESTR_formatlPE; 9634 break; 9635 9636 case FFESTR_formatPEN: 9637 if (ffestb_local_.format.pre.present) 9638 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */ 9639 ffestb_subr_R1001_append_p_ (); 9640 ffestb_local_.format.t = ffelex_token_name_from_names (t, 9641 FFESTR_formatlP, 1); 9642 ffestb_local_.format.sign = FALSE; 9643 ffestb_local_.format.pre.present = FALSE; 9644 ffestb_local_.format.pre.rtexpr = FALSE; 9645 ffestb_local_.format.pre.t = NULL; 9646 ffestb_local_.format.pre.u.unsigned_val = 1; 9647 ffestb_local_.format.current = FFESTP_formattypeEN; 9648 i = FFESTR_formatlPEN; 9649 break; 9650 9651 case FFESTR_formatPF: 9652 if (ffestb_local_.format.pre.present) 9653 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */ 9654 ffestb_subr_R1001_append_p_ (); 9655 ffestb_local_.format.t = ffelex_token_name_from_names (t, 9656 FFESTR_formatlP, 1); 9657 ffestb_local_.format.sign = FALSE; 9658 ffestb_local_.format.pre.present = FALSE; 9659 ffestb_local_.format.pre.rtexpr = FALSE; 9660 ffestb_local_.format.pre.t = NULL; 9661 ffestb_local_.format.pre.u.unsigned_val = 1; 9662 ffestb_local_.format.current = FFESTP_formattypeF; 9663 i = FFESTR_formatlPF; 9664 break; 9665 9666 case FFESTR_formatPG: 9667 if (ffestb_local_.format.pre.present) 9668 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */ 9669 ffestb_subr_R1001_append_p_ (); 9670 ffestb_local_.format.t = ffelex_token_name_from_names (t, 9671 FFESTR_formatlP, 1); 9672 ffestb_local_.format.sign = FALSE; 9673 ffestb_local_.format.pre.present = FALSE; 9674 ffestb_local_.format.pre.rtexpr = FALSE; 9675 ffestb_local_.format.pre.t = NULL; 9676 ffestb_local_.format.pre.u.unsigned_val = 1; 9677 ffestb_local_.format.current = FFESTP_formattypeG; 9678 i = FFESTR_formatlPG; 9679 break; 9680 9681 default: 9682 if (ffestb_local_.format.pre.present) 9683 ffesta_confirmed ();/* Number preceding this invalid elsewhere. */ 9684 ffestb_local_.format.current = FFESTP_formattypeNone; 9685 p = strpbrk (ffelex_token_text (t), "0123456789"); 9686 if (p == NULL) 9687 i = ffelex_token_length (t); 9688 else 9689 i = p - ffelex_token_text (t); 9690 break; 9691 } 9692 p = ffelex_token_text (t) + i; 9693 if (*p == '\0') 9694 return (ffelexHandler) ffestb_R10015_; 9695 if (! ISDIGIT (*p)) 9696 { 9697 if (ffestb_local_.format.current == FFESTP_formattypeH) 9698 p = strpbrk (p, "0123456789"); 9699 else 9700 { 9701 p = NULL; 9702 ffestb_local_.format.current = FFESTP_formattypeNone; 9703 } 9704 if (p == NULL) 9705 return (ffelexHandler) ffestb_R10015_; 9706 i = p - ffelex_token_text (t); /* Collect digits. */ 9707 } 9708 ffestb_local_.format.post.present = TRUE; 9709 ffestb_local_.format.post.rtexpr = FALSE; 9710 ffestb_local_.format.post.t = ffelex_token_number_from_names (t, i); 9711 ffestb_local_.format.post.u.unsigned_val 9712 = strtoul (ffelex_token_text (ffestb_local_.format.post.t), NULL, 10); 9713 p += ffelex_token_length (ffestb_local_.format.post.t); 9714 i += ffelex_token_length (ffestb_local_.format.post.t); 9715 if (*p == '\0') 9716 return (ffelexHandler) ffestb_R10016_; 9717 if ((kw != FFESTR_formatP) || 9718 !ffelex_is_firstnamechar ((unsigned char)*p)) 9719 { 9720 if (ffestb_local_.format.current != FFESTP_formattypeH) 9721 ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL); 9722 return (ffelexHandler) ffestb_R10016_; 9723 } 9724 9725 /* Here we have [number]P[number][text]. Treat as 9726 [number]P,[number][text]. */ 9727 9728 ffestb_subr_R1001_append_p_ (); 9729 t = ffestb_local_.format.t = ffelex_token_names_from_names (t, i, 0); 9730 ffestb_local_.format.sign = FALSE; 9731 ffestb_local_.format.pre = ffestb_local_.format.post; 9732 kw = ffestr_format (t); 9733 switch (kw) 9734 { /* Only a few possibilities here. */ 9735 case FFESTR_formatD: 9736 ffestb_local_.format.current = FFESTP_formattypeD; 9737 i = FFESTR_formatlD; 9738 break; 9739 9740 case FFESTR_formatE: 9741 ffestb_local_.format.current = FFESTP_formattypeE; 9742 i = FFESTR_formatlE; 9743 break; 9744 9745 case FFESTR_formatEN: 9746 ffestb_local_.format.current = FFESTP_formattypeEN; 9747 i = FFESTR_formatlEN; 9748 break; 9749 9750 case FFESTR_formatF: 9751 ffestb_local_.format.current = FFESTP_formattypeF; 9752 i = FFESTR_formatlF; 9753 break; 9754 9755 case FFESTR_formatG: 9756 ffestb_local_.format.current = FFESTP_formattypeG; 9757 i = FFESTR_formatlG; 9758 break; 9759 9760 default: 9761 ffebad_start (FFEBAD_FORMAT_P_NOCOMMA); 9762 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); 9763 ffebad_finish (); 9764 ffestb_local_.format.current = FFESTP_formattypeNone; 9765 p = strpbrk (ffelex_token_text (t), "0123456789"); 9766 if (p == NULL) 9767 i = ffelex_token_length (t); 9768 else 9769 i = p - ffelex_token_text (t); 9770 } 9771 p = ffelex_token_text (t) + i; 9772 if (*p == '\0') 9773 return (ffelexHandler) ffestb_R10015_; 9774 if (! ISDIGIT (*p)) 9775 { 9776 ffestb_local_.format.current = FFESTP_formattypeNone; 9777 p = strpbrk (p, "0123456789"); 9778 if (p == NULL) 9779 return (ffelexHandler) ffestb_R10015_; 9780 i = p - ffelex_token_text (t); /* Collect digits anyway. */ 9781 } 9782 ffestb_local_.format.post.present = TRUE; 9783 ffestb_local_.format.post.rtexpr = FALSE; 9784 ffestb_local_.format.post.t = ffelex_token_number_from_names (t, i); 9785 ffestb_local_.format.post.u.unsigned_val 9786 = strtoul (ffelex_token_text (ffestb_local_.format.post.t), NULL, 10); 9787 p += ffelex_token_length (ffestb_local_.format.post.t); 9788 i += ffelex_token_length (ffestb_local_.format.post.t); 9789 if (*p == '\0') 9790 return (ffelexHandler) ffestb_R10016_; 9791 ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL); 9792 return (ffelexHandler) ffestb_R10016_; 9793 9794 default: 9795 break; 9796 } 9797 9798 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t); 9799 if (ffestb_local_.format.pre.present) 9800 ffelex_token_kill (ffestb_local_.format.pre.t); 9801 ffestt_formatlist_kill (ffestb_local_.format.f); 9802 return (ffelexHandler) ffelex_swallow_tokens (t, 9803 (ffelexHandler) ffesta_zero); 9804} 9805 9806/* ffestb_R10015_ -- [[+/-] NUMBER] NAMES 9807 9808 return ffestb_R10015_; // to lexer 9809 9810 Here we've gotten at least the initial mnemonic for the edit descriptor. 9811 We expect either a NUMBER, for the post-mnemonic value, a NAMES, for 9812 further clarification (in free-form only, sigh) of the mnemonic, or 9813 anything else. In all cases we go to _6_, with the difference that for 9814 NUMBER and NAMES we send the next token rather than the current token. */ 9815 9816static ffelexHandler 9817ffestb_R10015_ (ffelexToken t) 9818{ 9819 bool split_pea; /* New NAMES requires splitting kP from new 9820 edit desc. */ 9821 ffestrFormat kw; 9822 const char *p; 9823 ffeTokenLength i; 9824 9825 switch (ffelex_token_type (t)) 9826 { 9827 case FFELEX_typeOPEN_ANGLE: 9828 ffesta_confirmed (); 9829 ffestb_local_.format.post.t = ffelex_token_use (t); 9830 ffelex_set_names_pure (FALSE); 9831 if (!ffesta_seen_first_exec && !ffestb_local_.format.complained) 9832 { 9833 ffestb_local_.format.complained = TRUE; 9834 ffebad_start (FFEBAD_FORMAT_EXPR_SPEC); 9835 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); 9836 ffebad_finish (); 9837 } 9838 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 9839 FFEEXPR_contextFORMAT, (ffeexprCallback) ffestb_R100116_); 9840 9841 case FFELEX_typeNUMBER: 9842 ffestb_local_.format.post.present = TRUE; 9843 ffestb_local_.format.post.rtexpr = FALSE; 9844 ffestb_local_.format.post.t = ffelex_token_use (t); 9845 ffestb_local_.format.post.u.unsigned_val 9846 = strtoul (ffelex_token_text (t), NULL, 10); 9847 return (ffelexHandler) ffestb_R10016_; 9848 9849 case FFELEX_typeNAMES: 9850 ffesta_confirmed (); /* NAMES " " NAMES invalid elsewhere in 9851 free-form. */ 9852 kw = ffestr_format (t); 9853 switch (ffestb_local_.format.current) 9854 { 9855 case FFESTP_formattypeP: 9856 split_pea = TRUE; 9857 break; 9858 9859 case FFESTP_formattypeH: /* An error, maintain this indicator. */ 9860 kw = FFESTR_formatNone; 9861 split_pea = FALSE; 9862 break; 9863 9864 default: 9865 split_pea = FALSE; 9866 break; 9867 } 9868 9869 switch (kw) 9870 { 9871 case FFESTR_formatF: 9872 switch (ffestb_local_.format.current) 9873 { 9874 case FFESTP_formattypeP: 9875 ffestb_local_.format.current = FFESTP_formattypeF; 9876 break; 9877 9878 default: 9879 ffestb_local_.format.current = FFESTP_formattypeNone; 9880 break; 9881 } 9882 i = FFESTR_formatlF; 9883 break; 9884 9885 case FFESTR_formatE: 9886 switch (ffestb_local_.format.current) 9887 { 9888 case FFESTP_formattypeP: 9889 ffestb_local_.format.current = FFESTP_formattypeE; 9890 break; 9891 9892 default: 9893 ffestb_local_.format.current = FFESTP_formattypeNone; 9894 break; 9895 } 9896 i = FFESTR_formatlE; 9897 break; 9898 9899 case FFESTR_formatEN: 9900 switch (ffestb_local_.format.current) 9901 { 9902 case FFESTP_formattypeP: 9903 ffestb_local_.format.current = FFESTP_formattypeEN; 9904 break; 9905 9906 default: 9907 ffestb_local_.format.current = FFESTP_formattypeNone; 9908 break; 9909 } 9910 i = FFESTR_formatlEN; 9911 break; 9912 9913 case FFESTR_formatG: 9914 switch (ffestb_local_.format.current) 9915 { 9916 case FFESTP_formattypeP: 9917 ffestb_local_.format.current = FFESTP_formattypeG; 9918 break; 9919 9920 default: 9921 ffestb_local_.format.current = FFESTP_formattypeNone; 9922 break; 9923 } 9924 i = FFESTR_formatlG; 9925 break; 9926 9927 case FFESTR_formatL: 9928 switch (ffestb_local_.format.current) 9929 { 9930 case FFESTP_formattypeT: 9931 ffestb_local_.format.current = FFESTP_formattypeTL; 9932 break; 9933 9934 default: 9935 ffestb_local_.format.current = FFESTP_formattypeNone; 9936 break; 9937 } 9938 i = FFESTR_formatlL; 9939 break; 9940 9941 case FFESTR_formatD: 9942 switch (ffestb_local_.format.current) 9943 { 9944 case FFESTP_formattypeP: 9945 ffestb_local_.format.current = FFESTP_formattypeD; 9946 break; 9947 9948 default: 9949 ffestb_local_.format.current = FFESTP_formattypeNone; 9950 break; 9951 } 9952 i = FFESTR_formatlD; 9953 break; 9954 9955 case FFESTR_formatS: 9956 switch (ffestb_local_.format.current) 9957 { 9958 case FFESTP_formattypeS: 9959 ffestb_local_.format.current = FFESTP_formattypeSS; 9960 break; 9961 9962 default: 9963 ffestb_local_.format.current = FFESTP_formattypeNone; 9964 break; 9965 } 9966 i = FFESTR_formatlS; 9967 break; 9968 9969 case FFESTR_formatP: 9970 switch (ffestb_local_.format.current) 9971 { 9972 case FFESTP_formattypeS: 9973 ffestb_local_.format.current = FFESTP_formattypeSP; 9974 break; 9975 9976 default: 9977 ffestb_local_.format.current = FFESTP_formattypeNone; 9978 break; 9979 } 9980 i = FFESTR_formatlP; 9981 break; 9982 9983 case FFESTR_formatR: 9984 switch (ffestb_local_.format.current) 9985 { 9986 case FFESTP_formattypeT: 9987 ffestb_local_.format.current = FFESTP_formattypeTR; 9988 break; 9989 9990 default: 9991 ffestb_local_.format.current = FFESTP_formattypeNone; 9992 break; 9993 } 9994 i = FFESTR_formatlR; 9995 break; 9996 9997 case FFESTR_formatZ: 9998 switch (ffestb_local_.format.current) 9999 { 10000 case FFESTP_formattypeB: 10001 ffestb_local_.format.current = FFESTP_formattypeBZ; 10002 break; 10003 10004 default: 10005 ffestb_local_.format.current = FFESTP_formattypeNone; 10006 break; 10007 } 10008 i = FFESTR_formatlZ; 10009 break; 10010 10011 case FFESTR_formatN: 10012 switch (ffestb_local_.format.current) 10013 { 10014 case FFESTP_formattypeE: 10015 ffestb_local_.format.current = FFESTP_formattypeEN; 10016 break; 10017 10018 case FFESTP_formattypeB: 10019 ffestb_local_.format.current = FFESTP_formattypeBN; 10020 break; 10021 10022 default: 10023 ffestb_local_.format.current = FFESTP_formattypeNone; 10024 break; 10025 } 10026 i = FFESTR_formatlN; 10027 break; 10028 10029 default: 10030 if (ffestb_local_.format.current != FFESTP_formattypeH) 10031 ffestb_local_.format.current = FFESTP_formattypeNone; 10032 split_pea = FALSE; /* Go ahead and let the P be in the party. */ 10033 p = strpbrk (ffelex_token_text (t), "0123456789"); 10034 if (p == NULL) 10035 i = ffelex_token_length (t); 10036 else 10037 i = p - ffelex_token_text (t); 10038 } 10039 10040 if (split_pea) 10041 { 10042 ffestb_subr_R1001_append_p_ (); 10043 ffestb_local_.format.t = ffelex_token_use (t); 10044 ffestb_local_.format.sign = FALSE; 10045 ffestb_local_.format.pre.present = FALSE; 10046 ffestb_local_.format.pre.rtexpr = FALSE; 10047 ffestb_local_.format.pre.t = NULL; 10048 ffestb_local_.format.pre.u.unsigned_val = 1; 10049 } 10050 10051 p = ffelex_token_text (t) + i; 10052 if (*p == '\0') 10053 return (ffelexHandler) ffestb_R10015_; 10054 if (! ISDIGIT (*p)) 10055 { 10056 ffestb_local_.format.current = FFESTP_formattypeNone; 10057 p = strpbrk (p, "0123456789"); 10058 if (p == NULL) 10059 return (ffelexHandler) ffestb_R10015_; 10060 i = p - ffelex_token_text (t); /* Collect digits anyway. */ 10061 } 10062 ffestb_local_.format.post.present = TRUE; 10063 ffestb_local_.format.post.rtexpr = FALSE; 10064 ffestb_local_.format.post.t = ffelex_token_number_from_names (t, i); 10065 ffestb_local_.format.post.u.unsigned_val 10066 = strtoul (ffelex_token_text (ffestb_local_.format.post.t), NULL, 10); 10067 p += ffelex_token_length (ffestb_local_.format.post.t); 10068 i += ffelex_token_length (ffestb_local_.format.post.t); 10069 if (*p == '\0') 10070 return (ffelexHandler) ffestb_R10016_; 10071 ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL); 10072 return (ffelexHandler) ffestb_R10016_; 10073 10074 default: 10075 ffestb_local_.format.post.present = FALSE; 10076 ffestb_local_.format.post.rtexpr = FALSE; 10077 ffestb_local_.format.post.t = NULL; 10078 ffestb_local_.format.post.u.unsigned_val = 1; 10079 return (ffelexHandler) ffestb_R10016_ (t); 10080 } 10081} 10082 10083/* ffestb_R10016_ -- [[+/-] NUMBER] NAMES NUMBER 10084 10085 return ffestb_R10016_; // to lexer 10086 10087 Expect a PERIOD here. Maybe find a NUMBER to append to the current 10088 number, in which case return to this state. Maybe find a NAMES to switch 10089 from a kP descriptor to a new descriptor (else the NAMES is spurious), 10090 in which case generator the P item and go to state _4_. Anything 10091 else, pass token on to state _8_. */ 10092 10093static ffelexHandler 10094ffestb_R10016_ (ffelexToken t) 10095{ 10096 ffeTokenLength i; 10097 10098 switch (ffelex_token_type (t)) 10099 { 10100 case FFELEX_typePERIOD: 10101 return (ffelexHandler) ffestb_R10017_; 10102 10103 case FFELEX_typeNUMBER: 10104 assert (ffestb_local_.format.post.present); 10105 ffesta_confirmed (); 10106 if (ffestb_local_.format.post.rtexpr) 10107 { 10108 ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER); 10109 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); 10110 ffebad_finish (); 10111 return (ffelexHandler) ffestb_R10016_; 10112 } 10113 for (i = ffelex_token_length (t) + 1; i > 0; --i) 10114 ffestb_local_.format.post.u.unsigned_val *= 10; 10115 ffestb_local_.format.post.u.unsigned_val += strtoul (ffelex_token_text (t), 10116 NULL, 10); 10117 return (ffelexHandler) ffestb_R10016_; 10118 10119 case FFELEX_typeNAMES: 10120 ffesta_confirmed (); /* NUMBER " " NAMES invalid elsewhere. */ 10121 if (ffestb_local_.format.current != FFESTP_formattypeP) 10122 { 10123 ffesta_ffebad_1t (FFEBAD_FORMAT_TEXT_IN_NUMBER, t); 10124 return (ffelexHandler) ffestb_R10016_; 10125 } 10126 ffestb_subr_R1001_append_p_ (); 10127 ffestb_local_.format.sign = FALSE; 10128 ffestb_local_.format.pre = ffestb_local_.format.post; 10129 return (ffelexHandler) ffestb_R10014_ (t); 10130 10131 default: 10132 ffestb_local_.format.dot.present = FALSE; 10133 ffestb_local_.format.dot.rtexpr = FALSE; 10134 ffestb_local_.format.dot.t = NULL; 10135 ffestb_local_.format.dot.u.unsigned_val = 1; 10136 return (ffelexHandler) ffestb_R10018_ (t); 10137 } 10138} 10139 10140/* ffestb_R10017_ -- [[+/-] NUMBER] NAMES NUMBER PERIOD 10141 10142 return ffestb_R10017_; // to lexer 10143 10144 Here we've gotten the period following the edit descriptor. 10145 We expect either a NUMBER, for the dot value, or something else, which 10146 probably means we're not even close to being in a real FORMAT statement. */ 10147 10148static ffelexHandler 10149ffestb_R10017_ (ffelexToken t) 10150{ 10151 switch (ffelex_token_type (t)) 10152 { 10153 case FFELEX_typeOPEN_ANGLE: 10154 ffestb_local_.format.dot.t = ffelex_token_use (t); 10155 ffelex_set_names_pure (FALSE); 10156 if (!ffesta_seen_first_exec && !ffestb_local_.format.complained) 10157 { 10158 ffestb_local_.format.complained = TRUE; 10159 ffebad_start (FFEBAD_FORMAT_EXPR_SPEC); 10160 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); 10161 ffebad_finish (); 10162 } 10163 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 10164 FFEEXPR_contextFORMAT, (ffeexprCallback) ffestb_R100117_); 10165 10166 case FFELEX_typeNUMBER: 10167 ffestb_local_.format.dot.present = TRUE; 10168 ffestb_local_.format.dot.rtexpr = FALSE; 10169 ffestb_local_.format.dot.t = ffelex_token_use (t); 10170 ffestb_local_.format.dot.u.unsigned_val 10171 = strtoul (ffelex_token_text (t), NULL, 10); 10172 return (ffelexHandler) ffestb_R10018_; 10173 10174 default: 10175 ffelex_token_kill (ffestb_local_.format.t); 10176 if (ffestb_local_.format.pre.present) 10177 ffelex_token_kill (ffestb_local_.format.pre.t); 10178 if (ffestb_local_.format.post.present) 10179 ffelex_token_kill (ffestb_local_.format.post.t); 10180 ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_DOT, t); 10181 ffestt_formatlist_kill (ffestb_local_.format.f); 10182 return (ffelexHandler) ffelex_swallow_tokens (t, 10183 (ffelexHandler) ffesta_zero); 10184 } 10185} 10186 10187/* ffestb_R10018_ -- [[+/-] NUMBER] NAMES NUMBER PERIOD NUMBER 10188 10189 return ffestb_R10018_; // to lexer 10190 10191 Expect a NAMES here, which must begin with "E" to be valid. Maybe find a 10192 NUMBER to append to the current number, in which case return to this state. 10193 Anything else, pass token on to state _10_. */ 10194 10195static ffelexHandler 10196ffestb_R10018_ (ffelexToken t) 10197{ 10198 ffeTokenLength i; 10199 const char *p; 10200 10201 switch (ffelex_token_type (t)) 10202 { 10203 case FFELEX_typeNUMBER: 10204 assert (ffestb_local_.format.dot.present); 10205 ffesta_confirmed (); 10206 if (ffestb_local_.format.dot.rtexpr) 10207 { 10208 ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER); 10209 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); 10210 ffebad_finish (); 10211 return (ffelexHandler) ffestb_R10018_; 10212 } 10213 for (i = ffelex_token_length (t) + 1; i > 0; --i) 10214 ffestb_local_.format.dot.u.unsigned_val *= 10; 10215 ffestb_local_.format.dot.u.unsigned_val += strtoul (ffelex_token_text (t), 10216 NULL, 10); 10217 return (ffelexHandler) ffestb_R10018_; 10218 10219 case FFELEX_typeNAMES: 10220 if (!ffesrc_char_match_init (*(p = ffelex_token_text (t)), 'E', 'e')) 10221 { 10222 ffesta_ffebad_1t (FFEBAD_FORMAT_TEXT_IN_NUMBER, t); 10223 return (ffelexHandler) ffestb_R10018_; 10224 } 10225 if (*++p == '\0') 10226 return (ffelexHandler) ffestb_R10019_; /* Go get NUMBER. */ 10227 i = 1; 10228 if (! ISDIGIT (*p)) 10229 { 10230 ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, 1, NULL); 10231 return (ffelexHandler) ffestb_R10018_; 10232 } 10233 ffestb_local_.format.exp.present = TRUE; 10234 ffestb_local_.format.exp.rtexpr = FALSE; 10235 ffestb_local_.format.exp.t = ffelex_token_number_from_names (t, i); 10236 ffestb_local_.format.exp.u.unsigned_val 10237 = strtoul (ffelex_token_text (ffestb_local_.format.exp.t), NULL, 10); 10238 p += ffelex_token_length (ffestb_local_.format.exp.t); 10239 i += ffelex_token_length (ffestb_local_.format.exp.t); 10240 if (*p == '\0') 10241 return (ffelexHandler) ffestb_R100110_; 10242 ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL); 10243 return (ffelexHandler) ffestb_R100110_; 10244 10245 default: 10246 ffestb_local_.format.exp.present = FALSE; 10247 ffestb_local_.format.exp.rtexpr = FALSE; 10248 ffestb_local_.format.exp.t = NULL; 10249 ffestb_local_.format.exp.u.unsigned_val = 1; 10250 return (ffelexHandler) ffestb_R100110_ (t); 10251 } 10252} 10253 10254/* ffestb_R10019_ -- [[+/-] NUMBER] NAMES NUMBER PERIOD NUMBER "E" 10255 10256 return ffestb_R10019_; // to lexer 10257 10258 Here we've gotten the "E" following the edit descriptor. 10259 We expect either a NUMBER, for the exponent value, or something else. */ 10260 10261static ffelexHandler 10262ffestb_R10019_ (ffelexToken t) 10263{ 10264 switch (ffelex_token_type (t)) 10265 { 10266 case FFELEX_typeOPEN_ANGLE: 10267 ffestb_local_.format.exp.t = ffelex_token_use (t); 10268 ffelex_set_names_pure (FALSE); 10269 if (!ffesta_seen_first_exec && !ffestb_local_.format.complained) 10270 { 10271 ffestb_local_.format.complained = TRUE; 10272 ffebad_start (FFEBAD_FORMAT_EXPR_SPEC); 10273 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); 10274 ffebad_finish (); 10275 } 10276 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 10277 FFEEXPR_contextFORMAT, (ffeexprCallback) ffestb_R100118_); 10278 10279 case FFELEX_typeNUMBER: 10280 ffestb_local_.format.exp.present = TRUE; 10281 ffestb_local_.format.exp.rtexpr = FALSE; 10282 ffestb_local_.format.exp.t = ffelex_token_use (t); 10283 ffestb_local_.format.exp.u.unsigned_val 10284 = strtoul (ffelex_token_text (t), NULL, 10); 10285 return (ffelexHandler) ffestb_R100110_; 10286 10287 default: 10288 ffelex_token_kill (ffestb_local_.format.t); 10289 if (ffestb_local_.format.pre.present) 10290 ffelex_token_kill (ffestb_local_.format.pre.t); 10291 if (ffestb_local_.format.post.present) 10292 ffelex_token_kill (ffestb_local_.format.post.t); 10293 if (ffestb_local_.format.dot.present) 10294 ffelex_token_kill (ffestb_local_.format.dot.t); 10295 ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_EXP, t); 10296 ffestt_formatlist_kill (ffestb_local_.format.f); 10297 return (ffelexHandler) ffelex_swallow_tokens (t, 10298 (ffelexHandler) ffesta_zero); 10299 } 10300} 10301 10302/* ffestb_R100110_ -- [[+/-] NUMBER] NAMES NUMBER [PERIOD NUMBER ["E" NUMBER]] 10303 10304 return ffestb_R100110_; // to lexer 10305 10306 Maybe find a NUMBER to append to the current number, in which case return 10307 to this state. Anything else, handle current descriptor, then pass token 10308 on to state _10_. */ 10309 10310static ffelexHandler 10311ffestb_R100110_ (ffelexToken t) 10312{ 10313 ffeTokenLength i; 10314 enum expect 10315 { 10316 required, 10317 optional, 10318 disallowed 10319 }; 10320 ffebad err; 10321 enum expect pre; 10322 enum expect post; 10323 enum expect dot; 10324 enum expect exp; 10325 bool R1005; 10326 ffesttFormatList f; 10327 10328 switch (ffelex_token_type (t)) 10329 { 10330 case FFELEX_typeNUMBER: 10331 assert (ffestb_local_.format.exp.present); 10332 ffesta_confirmed (); 10333 if (ffestb_local_.format.exp.rtexpr) 10334 { 10335 ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER); 10336 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); 10337 ffebad_finish (); 10338 return (ffelexHandler) ffestb_R100110_; 10339 } 10340 for (i = ffelex_token_length (t) + 1; i > 0; --i) 10341 ffestb_local_.format.exp.u.unsigned_val *= 10; 10342 ffestb_local_.format.exp.u.unsigned_val += strtoul (ffelex_token_text (t), 10343 NULL, 10); 10344 return (ffelexHandler) ffestb_R100110_; 10345 10346 default: 10347 if (ffestb_local_.format.sign 10348 && (ffestb_local_.format.current != FFESTP_formattypeP) 10349 && (ffestb_local_.format.current != FFESTP_formattypeH)) 10350 { 10351 ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN); 10352 ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t), 10353 ffelex_token_where_column (ffestb_local_.format.pre.t)); 10354 ffebad_finish (); 10355 ffestb_local_.format.pre.u.unsigned_val 10356 = (ffestb_local_.format.pre.u.signed_val < 0) 10357 ? -ffestb_local_.format.pre.u.signed_val 10358 : ffestb_local_.format.pre.u.signed_val; 10359 } 10360 switch (ffestb_local_.format.current) 10361 { 10362 case FFESTP_formattypeI: 10363 err = FFEBAD_FORMAT_BAD_I_SPEC; 10364 pre = optional; 10365 post = required; 10366 dot = optional; 10367 exp = disallowed; 10368 R1005 = TRUE; 10369 break; 10370 10371 case FFESTP_formattypeB: 10372 err = FFEBAD_FORMAT_BAD_B_SPEC; 10373 pre = optional; 10374 post = required; 10375 dot = optional; 10376 exp = disallowed; 10377 R1005 = TRUE; 10378 break; 10379 10380 case FFESTP_formattypeO: 10381 err = FFEBAD_FORMAT_BAD_O_SPEC; 10382 pre = optional; 10383 post = required; 10384 dot = optional; 10385 exp = disallowed; 10386 R1005 = TRUE; 10387 break; 10388 10389 case FFESTP_formattypeZ: 10390 err = FFEBAD_FORMAT_BAD_Z_SPEC; 10391 pre = optional; 10392 post = required; 10393 dot = optional; 10394 exp = disallowed; 10395 R1005 = TRUE; 10396 break; 10397 10398 case FFESTP_formattypeF: 10399 err = FFEBAD_FORMAT_BAD_F_SPEC; 10400 pre = optional; 10401 post = required; 10402 dot = required; 10403 exp = disallowed; 10404 R1005 = TRUE; 10405 break; 10406 10407 case FFESTP_formattypeE: 10408 err = FFEBAD_FORMAT_BAD_E_SPEC; 10409 pre = optional; 10410 post = required; 10411 dot = required; 10412 exp = optional; 10413 R1005 = TRUE; 10414 break; 10415 10416 case FFESTP_formattypeEN: 10417 err = FFEBAD_FORMAT_BAD_EN_SPEC; 10418 pre = optional; 10419 post = required; 10420 dot = required; 10421 exp = optional; 10422 R1005 = TRUE; 10423 break; 10424 10425 case FFESTP_formattypeG: 10426 err = FFEBAD_FORMAT_BAD_G_SPEC; 10427 pre = optional; 10428 post = required; 10429 dot = required; 10430 exp = optional; 10431 R1005 = TRUE; 10432 break; 10433 10434 case FFESTP_formattypeL: 10435 err = FFEBAD_FORMAT_BAD_L_SPEC; 10436 pre = optional; 10437 post = required; 10438 dot = disallowed; 10439 exp = disallowed; 10440 R1005 = TRUE; 10441 break; 10442 10443 case FFESTP_formattypeA: 10444 err = FFEBAD_FORMAT_BAD_A_SPEC; 10445 pre = optional; 10446 post = optional; 10447 dot = disallowed; 10448 exp = disallowed; 10449 R1005 = TRUE; 10450 break; 10451 10452 case FFESTP_formattypeD: 10453 err = FFEBAD_FORMAT_BAD_D_SPEC; 10454 pre = optional; 10455 post = required; 10456 dot = required; 10457 exp = disallowed; 10458 R1005 = TRUE; 10459 break; 10460 10461 case FFESTP_formattypeQ: 10462 err = FFEBAD_FORMAT_BAD_Q_SPEC; 10463 pre = disallowed; 10464 post = disallowed; 10465 dot = disallowed; 10466 exp = disallowed; 10467 R1005 = FALSE; 10468 break; 10469 10470 case FFESTP_formattypeDOLLAR: 10471 err = FFEBAD_FORMAT_BAD_DOLLAR_SPEC; 10472 pre = disallowed; 10473 post = disallowed; 10474 dot = disallowed; 10475 exp = disallowed; 10476 R1005 = FALSE; 10477 break; 10478 10479 case FFESTP_formattypeP: 10480 err = FFEBAD_FORMAT_BAD_P_SPEC; 10481 pre = required; 10482 post = disallowed; 10483 dot = disallowed; 10484 exp = disallowed; 10485 R1005 = FALSE; 10486 break; 10487 10488 case FFESTP_formattypeT: 10489 err = FFEBAD_FORMAT_BAD_T_SPEC; 10490 pre = disallowed; 10491 post = required; 10492 dot = disallowed; 10493 exp = disallowed; 10494 R1005 = FALSE; 10495 break; 10496 10497 case FFESTP_formattypeTL: 10498 err = FFEBAD_FORMAT_BAD_TL_SPEC; 10499 pre = disallowed; 10500 post = required; 10501 dot = disallowed; 10502 exp = disallowed; 10503 R1005 = FALSE; 10504 break; 10505 10506 case FFESTP_formattypeTR: 10507 err = FFEBAD_FORMAT_BAD_TR_SPEC; 10508 pre = disallowed; 10509 post = required; 10510 dot = disallowed; 10511 exp = disallowed; 10512 R1005 = FALSE; 10513 break; 10514 10515 case FFESTP_formattypeX: 10516 err = FFEBAD_FORMAT_BAD_X_SPEC; 10517 pre = required; 10518 post = disallowed; 10519 dot = disallowed; 10520 exp = disallowed; 10521 R1005 = FALSE; 10522 break; 10523 10524 case FFESTP_formattypeS: 10525 err = FFEBAD_FORMAT_BAD_S_SPEC; 10526 pre = disallowed; 10527 post = disallowed; 10528 dot = disallowed; 10529 exp = disallowed; 10530 R1005 = FALSE; 10531 break; 10532 10533 case FFESTP_formattypeSP: 10534 err = FFEBAD_FORMAT_BAD_SP_SPEC; 10535 pre = disallowed; 10536 post = disallowed; 10537 dot = disallowed; 10538 exp = disallowed; 10539 R1005 = FALSE; 10540 break; 10541 10542 case FFESTP_formattypeSS: 10543 err = FFEBAD_FORMAT_BAD_SS_SPEC; 10544 pre = disallowed; 10545 post = disallowed; 10546 dot = disallowed; 10547 exp = disallowed; 10548 R1005 = FALSE; 10549 break; 10550 10551 case FFESTP_formattypeBN: 10552 err = FFEBAD_FORMAT_BAD_BN_SPEC; 10553 pre = disallowed; 10554 post = disallowed; 10555 dot = disallowed; 10556 exp = disallowed; 10557 R1005 = FALSE; 10558 break; 10559 10560 case FFESTP_formattypeBZ: 10561 err = FFEBAD_FORMAT_BAD_BZ_SPEC; 10562 pre = disallowed; 10563 post = disallowed; 10564 dot = disallowed; 10565 exp = disallowed; 10566 R1005 = FALSE; 10567 break; 10568 10569 case FFESTP_formattypeH: /* Definitely an error, make sure of 10570 it. */ 10571 err = FFEBAD_FORMAT_BAD_H_SPEC; 10572 pre = ffestb_local_.format.pre.present ? disallowed : required; 10573 post = disallowed; 10574 dot = disallowed; 10575 exp = disallowed; 10576 R1005 = FALSE; 10577 break; 10578 10579 case FFESTP_formattypeNone: 10580 ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_SPEC, 10581 ffestb_local_.format.t); 10582 10583 clean_up_to_11_: /* :::::::::::::::::::: */ 10584 10585 ffelex_token_kill (ffestb_local_.format.t); 10586 if (ffestb_local_.format.pre.present) 10587 ffelex_token_kill (ffestb_local_.format.pre.t); 10588 if (ffestb_local_.format.post.present) 10589 ffelex_token_kill (ffestb_local_.format.post.t); 10590 if (ffestb_local_.format.dot.present) 10591 ffelex_token_kill (ffestb_local_.format.dot.t); 10592 if (ffestb_local_.format.exp.present) 10593 ffelex_token_kill (ffestb_local_.format.exp.t); 10594 return (ffelexHandler) ffestb_R100111_ (t); 10595 10596 default: 10597 assert ("bad format item" == NULL); 10598 err = FFEBAD_FORMAT_BAD_H_SPEC; 10599 pre = disallowed; 10600 post = disallowed; 10601 dot = disallowed; 10602 exp = disallowed; 10603 R1005 = FALSE; 10604 break; 10605 } 10606 if (((pre == disallowed) && ffestb_local_.format.pre.present) 10607 || ((pre == required) && !ffestb_local_.format.pre.present)) 10608 { 10609 ffesta_ffebad_1t (err, (pre == required) 10610 ? ffestb_local_.format.t : ffestb_local_.format.pre.t); 10611 goto clean_up_to_11_; /* :::::::::::::::::::: */ 10612 } 10613 if (((post == disallowed) && ffestb_local_.format.post.present) 10614 || ((post == required) && !ffestb_local_.format.post.present)) 10615 { 10616 ffesta_ffebad_1t (err, (post == required) 10617 ? ffestb_local_.format.t : ffestb_local_.format.post.t); 10618 goto clean_up_to_11_; /* :::::::::::::::::::: */ 10619 } 10620 if (((dot == disallowed) && ffestb_local_.format.dot.present) 10621 || ((dot == required) && !ffestb_local_.format.dot.present)) 10622 { 10623 ffesta_ffebad_1t (err, (dot == required) 10624 ? ffestb_local_.format.t : ffestb_local_.format.dot.t); 10625 goto clean_up_to_11_; /* :::::::::::::::::::: */ 10626 } 10627 if (((exp == disallowed) && ffestb_local_.format.exp.present) 10628 || ((exp == required) && !ffestb_local_.format.exp.present)) 10629 { 10630 ffesta_ffebad_1t (err, (exp == required) 10631 ? ffestb_local_.format.t : ffestb_local_.format.exp.t); 10632 goto clean_up_to_11_; /* :::::::::::::::::::: */ 10633 } 10634 f = ffestt_formatlist_append (ffestb_local_.format.f); 10635 f->type = ffestb_local_.format.current; 10636 f->t = ffestb_local_.format.t; 10637 if (R1005) 10638 { 10639 f->u.R1005.R1004 = ffestb_local_.format.pre; 10640 f->u.R1005.R1006 = ffestb_local_.format.post; 10641 f->u.R1005.R1007_or_R1008 = ffestb_local_.format.dot; 10642 f->u.R1005.R1009 = ffestb_local_.format.exp; 10643 } 10644 else 10645 /* Must be R1010. */ 10646 { 10647 if (pre == disallowed) 10648 f->u.R1010.val = ffestb_local_.format.post; 10649 else 10650 f->u.R1010.val = ffestb_local_.format.pre; 10651 } 10652 return (ffelexHandler) ffestb_R100111_ (t); 10653 } 10654} 10655 10656/* ffestb_R100111_ -- edit-descriptor 10657 10658 return ffestb_R100111_; // to lexer 10659 10660 Expect a COMMA, CLOSE_PAREN, CLOSE_ARRAY, COLON, COLONCOLON, SLASH, or 10661 CONCAT, or complain about missing comma. */ 10662 10663static ffelexHandler 10664ffestb_R100111_ (ffelexToken t) 10665{ 10666 ffesttFormatList f; 10667 10668 switch (ffelex_token_type (t)) 10669 { 10670 case FFELEX_typeCOMMA: 10671 return (ffelexHandler) ffestb_R10012_; 10672 10673 case FFELEX_typeCOLON: 10674 case FFELEX_typeCOLONCOLON: 10675 case FFELEX_typeSLASH: 10676 case FFELEX_typeCONCAT: 10677 return (ffelexHandler) ffestb_R10012_ (t); 10678 10679 case FFELEX_typeCLOSE_PAREN: 10680 f = ffestb_local_.format.f->u.root.parent; 10681 if (f == NULL) 10682 return (ffelexHandler) ffestb_R100114_; 10683 ffestb_local_.format.f = f->next; 10684 return (ffelexHandler) ffestb_R100111_; 10685 10686 case FFELEX_typeCLOSE_ARRAY: /* "/)". */ 10687 f = ffestt_formatlist_append (ffestb_local_.format.f); 10688 f->type = FFESTP_formattypeSLASH; 10689 f->t = ffelex_token_use (t); 10690 f->u.R1010.val.present = FALSE; 10691 f->u.R1010.val.rtexpr = FALSE; 10692 f->u.R1010.val.t = NULL; 10693 f->u.R1010.val.u.unsigned_val = 1; 10694 f = ffestb_local_.format.f->u.root.parent; 10695 if (f == NULL) 10696 return (ffelexHandler) ffestb_R100114_; 10697 ffestb_local_.format.f = f->next; 10698 return (ffelexHandler) ffestb_R100111_; 10699 10700 case FFELEX_typeOPEN_ANGLE: 10701 case FFELEX_typeDOLLAR: 10702 case FFELEX_typeNUMBER: 10703 case FFELEX_typeOPEN_PAREN: 10704 case FFELEX_typeOPEN_ARRAY: 10705 case FFELEX_typeQUOTE: 10706 case FFELEX_typeAPOSTROPHE: 10707 case FFELEX_typeNAMES: 10708 ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_COMMA, t); 10709 return (ffelexHandler) ffestb_R10012_ (t); 10710 10711 case FFELEX_typeEOS: 10712 case FFELEX_typeSEMICOLON: 10713 ffesta_confirmed (); 10714 ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_PAREN, t); 10715 for (f = ffestb_local_.format.f; 10716 f->u.root.parent != NULL; 10717 f = f->u.root.parent->next) 10718 ; 10719 ffestb_local_.format.f = f; 10720 return (ffelexHandler) ffestb_R100114_ (t); 10721 10722 default: 10723 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t); 10724 ffestt_formatlist_kill (ffestb_local_.format.f); 10725 return (ffelexHandler) ffelex_swallow_tokens (t, 10726 (ffelexHandler) ffesta_zero); 10727 } 10728} 10729 10730/* ffestb_R100112_ -- COLON, COLONCOLON, SLASH, OPEN_ARRAY, or CONCAT 10731 10732 return ffestb_R100112_; // to lexer 10733 10734 Like _11_ except the COMMA is optional. */ 10735 10736static ffelexHandler 10737ffestb_R100112_ (ffelexToken t) 10738{ 10739 ffesttFormatList f; 10740 10741 switch (ffelex_token_type (t)) 10742 { 10743 case FFELEX_typeCOMMA: 10744 return (ffelexHandler) ffestb_R10012_; 10745 10746 case FFELEX_typeCOLON: 10747 case FFELEX_typeCOLONCOLON: 10748 case FFELEX_typeSLASH: 10749 case FFELEX_typeCONCAT: 10750 case FFELEX_typeOPEN_ANGLE: 10751 case FFELEX_typeNAMES: 10752 case FFELEX_typeDOLLAR: 10753 case FFELEX_typeNUMBER: 10754 case FFELEX_typeOPEN_PAREN: 10755 case FFELEX_typeOPEN_ARRAY: 10756 case FFELEX_typeQUOTE: 10757 case FFELEX_typeAPOSTROPHE: 10758 case FFELEX_typePLUS: 10759 case FFELEX_typeMINUS: 10760 return (ffelexHandler) ffestb_R10012_ (t); 10761 10762 case FFELEX_typeCLOSE_PAREN: 10763 f = ffestb_local_.format.f->u.root.parent; 10764 if (f == NULL) 10765 return (ffelexHandler) ffestb_R100114_; 10766 ffestb_local_.format.f = f->next; 10767 return (ffelexHandler) ffestb_R100111_; 10768 10769 case FFELEX_typeCLOSE_ARRAY: /* "/)". */ 10770 f = ffestt_formatlist_append (ffestb_local_.format.f); 10771 f->type = FFESTP_formattypeSLASH; 10772 f->t = ffelex_token_use (t); 10773 f->u.R1010.val.present = FALSE; 10774 f->u.R1010.val.rtexpr = FALSE; 10775 f->u.R1010.val.t = NULL; 10776 f->u.R1010.val.u.unsigned_val = 1; 10777 f = ffestb_local_.format.f->u.root.parent; 10778 if (f == NULL) 10779 return (ffelexHandler) ffestb_R100114_; 10780 ffestb_local_.format.f = f->next; 10781 return (ffelexHandler) ffestb_R100111_; 10782 10783 case FFELEX_typeEOS: 10784 case FFELEX_typeSEMICOLON: 10785 ffesta_confirmed (); 10786 ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_PAREN, t); 10787 for (f = ffestb_local_.format.f; 10788 f->u.root.parent != NULL; 10789 f = f->u.root.parent->next) 10790 ; 10791 ffestb_local_.format.f = f; 10792 return (ffelexHandler) ffestb_R100114_ (t); 10793 10794 default: 10795 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t); 10796 ffestt_formatlist_kill (ffestb_local_.format.f); 10797 return (ffelexHandler) ffelex_swallow_tokens (t, 10798 (ffelexHandler) ffesta_zero); 10799 } 10800} 10801 10802/* ffestb_R100113_ -- Handle CHARACTER token. 10803 10804 return ffestb_R100113_; // to lexer 10805 10806 Append the format item to the list, go to _11_. */ 10807 10808static ffelexHandler 10809ffestb_R100113_ (ffelexToken t) 10810{ 10811 ffesttFormatList f; 10812 10813 assert (ffelex_token_type (t) == FFELEX_typeCHARACTER); 10814 10815 if (ffe_is_pedantic_not_90 () && (ffelex_token_length (t) == 0)) 10816 { 10817 ffebad_start (FFEBAD_NULL_CHAR_CONST); 10818 ffebad_here (0, ffelex_token_where_line (t), 10819 ffelex_token_where_column (t)); 10820 ffebad_finish (); 10821 } 10822 10823 f = ffestt_formatlist_append (ffestb_local_.format.f); 10824 f->type = FFESTP_formattypeR1016; 10825 f->t = ffelex_token_use (t); 10826 return (ffelexHandler) ffestb_R100111_; 10827} 10828 10829/* ffestb_R100114_ -- "FORMAT" OPEN_PAREN format-item-list CLOSE_PAREN 10830 10831 return ffestb_R100114_; // to lexer 10832 10833 Handle EOS/SEMICOLON or something else. */ 10834 10835static ffelexHandler 10836ffestb_R100114_ (ffelexToken t) 10837{ 10838 ffelex_set_names_pure (FALSE); 10839 10840 switch (ffelex_token_type (t)) 10841 { 10842 case FFELEX_typeEOS: 10843 case FFELEX_typeSEMICOLON: 10844 ffesta_confirmed (); 10845 if (!ffesta_is_inhibited () && !ffestb_local_.format.complained) 10846 ffestc_R1001 (ffestb_local_.format.f); 10847 ffestt_formatlist_kill (ffestb_local_.format.f); 10848 return (ffelexHandler) ffesta_zero (t); 10849 10850 default: 10851 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t); 10852 ffestt_formatlist_kill (ffestb_local_.format.f); 10853 return (ffelexHandler) ffelex_swallow_tokens (t, 10854 (ffelexHandler) ffesta_zero); 10855 } 10856} 10857 10858/* ffestb_R100115_ -- OPEN_ANGLE expr 10859 10860 (ffestb_R100115_) // to expression handler 10861 10862 Handle expression prior to the edit descriptor. */ 10863 10864static ffelexHandler 10865ffestb_R100115_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t) 10866{ 10867 switch (ffelex_token_type (t)) 10868 { 10869 case FFELEX_typeCLOSE_ANGLE: 10870 ffestb_local_.format.pre.present = TRUE; 10871 ffestb_local_.format.pre.rtexpr = TRUE; 10872 ffestb_local_.format.pre.u.expr = expr; 10873 ffelex_set_names_pure (TRUE); 10874 return (ffelexHandler) ffestb_R10014_; 10875 10876 default: 10877 ffelex_token_kill (ffestb_local_.format.pre.t); 10878 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t); 10879 ffestt_formatlist_kill (ffestb_local_.format.f); 10880 return (ffelexHandler) ffelex_swallow_tokens (t, 10881 (ffelexHandler) ffesta_zero); 10882 } 10883} 10884 10885/* ffestb_R100116_ -- "[n]X" OPEN_ANGLE expr 10886 10887 (ffestb_R100116_) // to expression handler 10888 10889 Handle expression after the edit descriptor. */ 10890 10891static ffelexHandler 10892ffestb_R100116_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t) 10893{ 10894 switch (ffelex_token_type (t)) 10895 { 10896 case FFELEX_typeCLOSE_ANGLE: 10897 ffestb_local_.format.post.present = TRUE; 10898 ffestb_local_.format.post.rtexpr = TRUE; 10899 ffestb_local_.format.post.u.expr = expr; 10900 ffelex_set_names_pure (TRUE); 10901 return (ffelexHandler) ffestb_R10016_; 10902 10903 default: 10904 ffelex_token_kill (ffestb_local_.format.t); 10905 ffelex_token_kill (ffestb_local_.format.post.t); 10906 if (ffestb_local_.format.pre.present) 10907 ffelex_token_kill (ffestb_local_.format.pre.t); 10908 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t); 10909 ffestt_formatlist_kill (ffestb_local_.format.f); 10910 return (ffelexHandler) ffelex_swallow_tokens (t, 10911 (ffelexHandler) ffesta_zero); 10912 } 10913} 10914 10915/* ffestb_R100117_ -- "[n]X[n]." OPEN_ANGLE expr 10916 10917 (ffestb_R100117_) // to expression handler 10918 10919 Handle expression after the PERIOD. */ 10920 10921static ffelexHandler 10922ffestb_R100117_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t) 10923{ 10924 switch (ffelex_token_type (t)) 10925 { 10926 case FFELEX_typeCLOSE_ANGLE: 10927 ffestb_local_.format.dot.present = TRUE; 10928 ffestb_local_.format.dot.rtexpr = TRUE; 10929 ffestb_local_.format.dot.u.expr = expr; 10930 ffelex_set_names_pure (TRUE); 10931 return (ffelexHandler) ffestb_R10018_; 10932 10933 default: 10934 ffelex_token_kill (ffestb_local_.format.t); 10935 ffelex_token_kill (ffestb_local_.format.dot.t); 10936 if (ffestb_local_.format.pre.present) 10937 ffelex_token_kill (ffestb_local_.format.pre.t); 10938 if (ffestb_local_.format.post.present) 10939 ffelex_token_kill (ffestb_local_.format.post.t); 10940 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t); 10941 ffestt_formatlist_kill (ffestb_local_.format.f); 10942 return (ffelexHandler) ffelex_swallow_tokens (t, 10943 (ffelexHandler) ffesta_zero); 10944 } 10945} 10946 10947/* ffestb_R100118_ -- "[n]X[n].[n]E" OPEN_ANGLE expr 10948 10949 (ffestb_R100118_) // to expression handler 10950 10951 Handle expression after the "E". */ 10952 10953static ffelexHandler 10954ffestb_R100118_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t) 10955{ 10956 switch (ffelex_token_type (t)) 10957 { 10958 case FFELEX_typeCLOSE_ANGLE: 10959 ffestb_local_.format.exp.present = TRUE; 10960 ffestb_local_.format.exp.rtexpr = TRUE; 10961 ffestb_local_.format.exp.u.expr = expr; 10962 ffelex_set_names_pure (TRUE); 10963 return (ffelexHandler) ffestb_R100110_; 10964 10965 default: 10966 ffelex_token_kill (ffestb_local_.format.t); 10967 ffelex_token_kill (ffestb_local_.format.exp.t); 10968 if (ffestb_local_.format.pre.present) 10969 ffelex_token_kill (ffestb_local_.format.pre.t); 10970 if (ffestb_local_.format.post.present) 10971 ffelex_token_kill (ffestb_local_.format.post.t); 10972 if (ffestb_local_.format.dot.present) 10973 ffelex_token_kill (ffestb_local_.format.dot.t); 10974 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t); 10975 ffestt_formatlist_kill (ffestb_local_.format.f); 10976 return (ffelexHandler) ffelex_swallow_tokens (t, 10977 (ffelexHandler) ffesta_zero); 10978 } 10979} 10980 10981/* ffestb_R1107 -- Parse the USE statement 10982 10983 return ffestb_R1107; // to lexer 10984 10985 Make sure the statement has a valid form for the USE statement. 10986 If it does, implement the statement. */ 10987 10988#if FFESTR_F90 10989ffelexHandler 10990ffestb_R1107 (ffelexToken t) 10991{ 10992 ffeTokenLength i; 10993 const char *p; 10994 10995 switch (ffelex_token_type (ffesta_tokens[0])) 10996 { 10997 case FFELEX_typeNAME: 10998 if (ffesta_first_kw != FFESTR_firstUSE) 10999 goto bad_0; /* :::::::::::::::::::: */ 11000 switch (ffelex_token_type (t)) 11001 { 11002 case FFELEX_typeNAME: 11003 break; 11004 11005 case FFELEX_typeEOS: 11006 case FFELEX_typeSEMICOLON: 11007 case FFELEX_typeCOMMA: 11008 case FFELEX_typeCOLONCOLON: 11009 ffesta_confirmed (); /* Error, but clearly intended. */ 11010 goto bad_1; /* :::::::::::::::::::: */ 11011 11012 default: 11013 goto bad_0; /* :::::::::::::::::::: */ 11014 } 11015 ffesta_confirmed (); 11016 ffesta_tokens[1] = ffelex_token_use (t); 11017 return (ffelexHandler) ffestb_R11071_; 11018 11019 case FFELEX_typeNAMES: 11020 if (ffesta_first_kw != FFESTR_firstUSE) 11021 goto bad_0; /* :::::::::::::::::::: */ 11022 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlUSE); 11023 if (!ffesrc_is_name_init (*p)) 11024 goto bad_i; /* :::::::::::::::::::: */ 11025 switch (ffelex_token_type (t)) 11026 { 11027 case FFELEX_typeCOLONCOLON: 11028 ffesta_confirmed (); /* Error, but clearly intended. */ 11029 goto bad_1; /* :::::::::::::::::::: */ 11030 11031 default: 11032 goto bad_1; /* :::::::::::::::::::: */ 11033 11034 case FFELEX_typeCOMMA: 11035 case FFELEX_typeEOS: 11036 case FFELEX_typeSEMICOLON: 11037 break; 11038 } 11039 ffesta_confirmed (); 11040 ffesta_tokens[1] 11041 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); 11042 return (ffelexHandler) ffestb_R11071_ (t); 11043 11044 default: 11045 goto bad_0; /* :::::::::::::::::::: */ 11046 } 11047 11048bad_0: /* :::::::::::::::::::: */ 11049 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", ffesta_tokens[0]); 11050 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 11051 11052bad_1: /* :::::::::::::::::::: */ 11053 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t); 11054 return (ffelexHandler) ffelex_swallow_tokens (t, 11055 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 11056 11057bad_i: /* :::::::::::::::::::: */ 11058 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "USE", ffesta_tokens[0], i, t); 11059 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 11060} 11061 11062/* ffestb_R11071_ -- "USE" NAME 11063 11064 return ffestb_R11071_; // to lexer 11065 11066 Make sure the statement has a valid form for the USE statement. If it 11067 does, implement the statement. */ 11068 11069static ffelexHandler 11070ffestb_R11071_ (ffelexToken t) 11071{ 11072 switch (ffelex_token_type (t)) 11073 { 11074 case FFELEX_typeEOS: 11075 case FFELEX_typeSEMICOLON: 11076 if (!ffesta_is_inhibited ()) 11077 { 11078 ffestc_R1107_start (ffesta_tokens[1], FALSE); 11079 ffestc_R1107_finish (); 11080 } 11081 ffelex_token_kill (ffesta_tokens[1]); 11082 return (ffelexHandler) ffesta_zero (t); 11083 11084 case FFELEX_typeCOMMA: 11085 return (ffelexHandler) ffestb_R11072_; 11086 11087 default: 11088 break; 11089 } 11090 11091 ffelex_token_kill (ffesta_tokens[1]); 11092 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t); 11093 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 11094} 11095 11096/* ffestb_R11072_ -- "USE" NAME COMMA 11097 11098 return ffestb_R11072_; // to lexer 11099 11100 Make sure the statement has a valid form for the USE statement. If it 11101 does, implement the statement. */ 11102 11103static ffelexHandler 11104ffestb_R11072_ (ffelexToken t) 11105{ 11106 switch (ffelex_token_type (t)) 11107 { 11108 case FFELEX_typeNAME: 11109 ffesta_tokens[2] = ffelex_token_use (t); 11110 return (ffelexHandler) ffestb_R11073_; 11111 11112 default: 11113 break; 11114 } 11115 11116 ffelex_token_kill (ffesta_tokens[1]); 11117 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t); 11118 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 11119} 11120 11121/* ffestb_R11073_ -- "USE" NAME COMMA NAME 11122 11123 return ffestb_R11073_; // to lexer 11124 11125 Make sure the statement has a valid form for the USE statement. If it 11126 does, implement the statement. */ 11127 11128static ffelexHandler 11129ffestb_R11073_ (ffelexToken t) 11130{ 11131 switch (ffelex_token_type (t)) 11132 { 11133 case FFELEX_typeCOLON: 11134 if (ffestr_other (ffesta_tokens[2]) != FFESTR_otherONLY) 11135 break; 11136 if (!ffesta_is_inhibited ()) 11137 ffestc_R1107_start (ffesta_tokens[1], TRUE); 11138 ffelex_token_kill (ffesta_tokens[1]); 11139 ffelex_token_kill (ffesta_tokens[2]); 11140 return (ffelexHandler) ffestb_R11074_; 11141 11142 case FFELEX_typePOINTS: 11143 if (!ffesta_is_inhibited ()) 11144 ffestc_R1107_start (ffesta_tokens[1], FALSE); 11145 ffelex_token_kill (ffesta_tokens[1]); 11146 ffesta_tokens[1] = ffesta_tokens[2]; 11147 return (ffelexHandler) ffestb_R110711_; 11148 11149 default: 11150 break; 11151 } 11152 11153 ffelex_token_kill (ffesta_tokens[1]); 11154 ffelex_token_kill (ffesta_tokens[2]); 11155 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t); 11156 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 11157} 11158 11159/* ffestb_R11074_ -- "USE" NAME COMMA "ONLY" COLON 11160 11161 return ffestb_R11074_; // to lexer 11162 11163 Make sure the statement has a valid form for the USE statement. If it 11164 does, implement the statement. */ 11165 11166static ffelexHandler 11167ffestb_R11074_ (ffelexToken t) 11168{ 11169 switch (ffelex_token_type (t)) 11170 { 11171 case FFELEX_typeNAME: 11172 ffesta_tokens[1] = ffelex_token_use (t); 11173 return (ffelexHandler) ffestb_R11075_; 11174 11175 case FFELEX_typeEOS: 11176 case FFELEX_typeSEMICOLON: 11177 if (!ffesta_is_inhibited ()) 11178 ffestc_R1107_finish (); 11179 return (ffelexHandler) ffesta_zero (t); 11180 11181 default: 11182 break; 11183 } 11184 11185 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t); 11186 ffestc_R1107_finish (); 11187 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 11188} 11189 11190/* ffestb_R11075_ -- "USE" NAME COMMA "ONLY" COLON NAME 11191 11192 return ffestb_R11075_; // to lexer 11193 11194 Make sure the statement has a valid form for the USE statement. If it 11195 does, implement the statement. */ 11196 11197static ffelexHandler 11198ffestb_R11075_ (ffelexToken t) 11199{ 11200 switch (ffelex_token_type (t)) 11201 { 11202 case FFELEX_typeEOS: 11203 case FFELEX_typeSEMICOLON: 11204 if (!ffesta_is_inhibited ()) 11205 { 11206 ffestc_R1107_item (NULL, ffesta_tokens[1]); 11207 ffestc_R1107_finish (); 11208 } 11209 ffelex_token_kill (ffesta_tokens[1]); 11210 return (ffelexHandler) ffesta_zero (t); 11211 11212 case FFELEX_typeCOMMA: 11213 if (!ffesta_is_inhibited ()) 11214 ffestc_R1107_item (NULL, ffesta_tokens[1]); 11215 ffelex_token_kill (ffesta_tokens[1]); 11216 return (ffelexHandler) ffestb_R11078_; 11217 11218 case FFELEX_typePOINTS: 11219 return (ffelexHandler) ffestb_R11076_; 11220 11221 default: 11222 break; 11223 } 11224 11225 ffelex_token_kill (ffesta_tokens[1]); 11226 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t); 11227 ffestc_R1107_finish (); 11228 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 11229} 11230 11231/* ffestb_R11076_ -- "USE" NAME COMMA "ONLY" COLON NAME POINTS 11232 11233 return ffestb_R11076_; // to lexer 11234 11235 Make sure the statement has a valid form for the USE statement. If it 11236 does, implement the statement. */ 11237 11238static ffelexHandler 11239ffestb_R11076_ (ffelexToken t) 11240{ 11241 switch (ffelex_token_type (t)) 11242 { 11243 case FFELEX_typeNAME: 11244 if (!ffesta_is_inhibited ()) 11245 ffestc_R1107_item (ffesta_tokens[1], t); 11246 ffelex_token_kill (ffesta_tokens[1]); 11247 return (ffelexHandler) ffestb_R11077_; 11248 11249 default: 11250 break; 11251 } 11252 11253 ffelex_token_kill (ffesta_tokens[1]); 11254 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t); 11255 ffestc_R1107_finish (); 11256 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 11257} 11258 11259/* ffestb_R11077_ -- "USE" NAME COMMA "ONLY" COLON NAME POINTS NAME 11260 11261 return ffestb_R11077_; // to lexer 11262 11263 Make sure the statement has a valid form for the USE statement. If it 11264 does, implement the statement. */ 11265 11266static ffelexHandler 11267ffestb_R11077_ (ffelexToken t) 11268{ 11269 switch (ffelex_token_type (t)) 11270 { 11271 case FFELEX_typeEOS: 11272 case FFELEX_typeSEMICOLON: 11273 if (!ffesta_is_inhibited ()) 11274 ffestc_R1107_finish (); 11275 return (ffelexHandler) ffesta_zero (t); 11276 11277 case FFELEX_typeCOMMA: 11278 return (ffelexHandler) ffestb_R11078_; 11279 11280 default: 11281 break; 11282 } 11283 11284 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t); 11285 ffestc_R1107_finish (); 11286 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 11287} 11288 11289/* ffestb_R11078_ -- "USE" NAME COMMA "ONLY" COLON NAME POINTS NAME COMMA 11290 11291 return ffestb_R11078_; // to lexer 11292 11293 Make sure the statement has a valid form for the USE statement. If it 11294 does, implement the statement. */ 11295 11296static ffelexHandler 11297ffestb_R11078_ (ffelexToken t) 11298{ 11299 switch (ffelex_token_type (t)) 11300 { 11301 case FFELEX_typeNAME: 11302 ffesta_tokens[1] = ffelex_token_use (t); 11303 return (ffelexHandler) ffestb_R11075_; 11304 11305 default: 11306 break; 11307 } 11308 11309 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t); 11310 ffestc_R1107_finish (); 11311 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 11312} 11313 11314/* ffestb_R11079_ -- "USE" NAME COMMA 11315 11316 return ffestb_R11079_; // to lexer 11317 11318 Make sure the statement has a valid form for the USE statement. If it 11319 does, implement the statement. */ 11320 11321static ffelexHandler 11322ffestb_R11079_ (ffelexToken t) 11323{ 11324 switch (ffelex_token_type (t)) 11325 { 11326 case FFELEX_typeNAME: 11327 ffesta_tokens[1] = ffelex_token_use (t); 11328 return (ffelexHandler) ffestb_R110710_; 11329 11330 default: 11331 break; 11332 } 11333 11334 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t); 11335 ffestc_R1107_finish (); 11336 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 11337} 11338 11339/* ffestb_R110710_ -- "USE" NAME COMMA NAME 11340 11341 return ffestb_R110710_; // to lexer 11342 11343 Make sure the statement has a valid form for the USE statement. If it 11344 does, implement the statement. */ 11345 11346static ffelexHandler 11347ffestb_R110710_ (ffelexToken t) 11348{ 11349 switch (ffelex_token_type (t)) 11350 { 11351 case FFELEX_typePOINTS: 11352 return (ffelexHandler) ffestb_R110711_; 11353 11354 default: 11355 break; 11356 } 11357 11358 ffelex_token_kill (ffesta_tokens[1]); 11359 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t); 11360 ffestc_R1107_finish (); 11361 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 11362} 11363 11364/* ffestb_R110711_ -- "USE" NAME COMMA NAME POINTS 11365 11366 return ffestb_R110711_; // to lexer 11367 11368 Make sure the statement has a valid form for the USE statement. If it 11369 does, implement the statement. */ 11370 11371static ffelexHandler 11372ffestb_R110711_ (ffelexToken t) 11373{ 11374 switch (ffelex_token_type (t)) 11375 { 11376 case FFELEX_typeNAME: 11377 if (!ffesta_is_inhibited ()) 11378 ffestc_R1107_item (ffesta_tokens[1], t); 11379 ffelex_token_kill (ffesta_tokens[1]); 11380 return (ffelexHandler) ffestb_R110712_; 11381 11382 default: 11383 break; 11384 } 11385 11386 ffelex_token_kill (ffesta_tokens[1]); 11387 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t); 11388 ffestc_R1107_finish (); 11389 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 11390} 11391 11392/* ffestb_R110712_ -- "USE" NAME COMMA NAME POINTS NAME 11393 11394 return ffestb_R110712_; // to lexer 11395 11396 Make sure the statement has a valid form for the USE statement. If it 11397 does, implement the statement. */ 11398 11399static ffelexHandler 11400ffestb_R110712_ (ffelexToken t) 11401{ 11402 switch (ffelex_token_type (t)) 11403 { 11404 case FFELEX_typeEOS: 11405 case FFELEX_typeSEMICOLON: 11406 if (!ffesta_is_inhibited ()) 11407 ffestc_R1107_finish (); 11408 return (ffelexHandler) ffesta_zero (t); 11409 11410 case FFELEX_typeCOMMA: 11411 return (ffelexHandler) ffestb_R11079_; 11412 11413 default: 11414 break; 11415 } 11416 11417 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t); 11418 ffestc_R1107_finish (); 11419 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 11420} 11421 11422#endif 11423/* ffestb_R1202 -- Parse the INTERFACE statement 11424 11425 return ffestb_R1202; // to lexer 11426 11427 Make sure the statement has a valid form for the INTERFACE statement. 11428 If it does, implement the statement. 11429 11430 15-May-90 JCB 1.1 11431 Allow INTERFACE by itself; missed this 11432 valid form when originally doing syntactic analysis code. */ 11433 11434#if FFESTR_F90 11435ffelexHandler 11436ffestb_R1202 (ffelexToken t) 11437{ 11438 ffeTokenLength i; 11439 const char *p; 11440 11441 switch (ffelex_token_type (ffesta_tokens[0])) 11442 { 11443 case FFELEX_typeNAME: 11444 if (ffesta_first_kw != FFESTR_firstINTERFACE) 11445 goto bad_0; /* :::::::::::::::::::: */ 11446 switch (ffelex_token_type (t)) 11447 { 11448 case FFELEX_typeNAME: 11449 break; 11450 11451 case FFELEX_typeEOS: 11452 case FFELEX_typeSEMICOLON: 11453 ffesta_confirmed (); 11454 if (!ffesta_is_inhibited ()) 11455 ffestc_R1202 (FFESTP_definedoperatorNone, NULL); 11456 return (ffelexHandler) ffesta_zero (t); 11457 11458 case FFELEX_typeCOMMA: 11459 case FFELEX_typeCOLONCOLON: 11460 ffesta_confirmed (); /* Error, but clearly intended. */ 11461 goto bad_1; /* :::::::::::::::::::: */ 11462 11463 default: 11464 goto bad_1; /* :::::::::::::::::::: */ 11465 } 11466 11467 ffesta_confirmed (); 11468 switch (ffesta_second_kw) 11469 { 11470 case FFESTR_secondOPERATOR: 11471 ffestb_local_.interface.operator = FFESTP_definedoperatorOPERATOR; 11472 break; 11473 11474 case FFESTR_secondASSIGNMENT: 11475 ffestb_local_.interface.operator = FFESTP_definedoperatorASSIGNMENT; 11476 break; 11477 11478 default: 11479 ffestb_local_.interface.operator = FFESTP_definedoperatorNone; 11480 break; 11481 } 11482 ffesta_tokens[1] = ffelex_token_use (t); 11483 return (ffelexHandler) ffestb_R12021_; 11484 11485 case FFELEX_typeNAMES: 11486 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlINTERFACE); 11487 switch (ffesta_first_kw) 11488 { 11489 case FFESTR_firstINTERFACEOPERATOR: 11490 if (*(ffelex_token_text (ffesta_tokens[0]) 11491 + FFESTR_firstlINTERFACEOPERATOR) == '\0') 11492 ffestb_local_.interface.operator 11493 = FFESTP_definedoperatorOPERATOR; 11494 break; 11495 11496 case FFESTR_firstINTERFACEASSGNMNT: 11497 if (*(ffelex_token_text (ffesta_tokens[0]) 11498 + FFESTR_firstlINTERFACEASSGNMNT) == '\0') 11499 ffestb_local_.interface.operator 11500 = FFESTP_definedoperatorASSIGNMENT; 11501 break; 11502 11503 case FFESTR_firstINTERFACE: 11504 ffestb_local_.interface.operator = FFESTP_definedoperatorNone; 11505 break; 11506 11507 default: 11508 goto bad_0; /* :::::::::::::::::::: */ 11509 } 11510 switch (ffelex_token_type (t)) 11511 { 11512 case FFELEX_typeCOMMA: 11513 case FFELEX_typeCOLONCOLON: 11514 ffesta_confirmed (); /* Error, but clearly intended. */ 11515 goto bad_1; /* :::::::::::::::::::: */ 11516 11517 default: 11518 goto bad_1; /* :::::::::::::::::::: */ 11519 11520 case FFELEX_typeOPEN_PAREN: 11521 case FFELEX_typeOPEN_ARRAY: /* Sigh. */ 11522 break; 11523 11524 case FFELEX_typeEOS: 11525 case FFELEX_typeSEMICOLON: 11526 ffesta_confirmed (); 11527 if (*p == '\0') 11528 { 11529 if (!ffesta_is_inhibited ()) 11530 ffestc_R1202 (FFESTP_definedoperatorNone, NULL); 11531 return (ffelexHandler) ffesta_zero (t); 11532 } 11533 break; 11534 } 11535 if (!ffesrc_is_name_init (*p)) 11536 goto bad_i; /* :::::::::::::::::::: */ 11537 ffesta_tokens[1] = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); 11538 return (ffelexHandler) ffestb_R12021_ (t); 11539 11540 default: 11541 goto bad_0; /* :::::::::::::::::::: */ 11542 } 11543 11544bad_0: /* :::::::::::::::::::: */ 11545 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", ffesta_tokens[0]); 11546 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 11547 11548bad_1: /* :::::::::::::::::::: */ 11549 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t); 11550 return (ffelexHandler) ffelex_swallow_tokens (t, 11551 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 11552 11553bad_i: /* :::::::::::::::::::: */ 11554 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "INTERFACE", ffesta_tokens[0], i, t); 11555 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 11556} 11557 11558/* ffestb_R12021_ -- "INTERFACE" NAME 11559 11560 return ffestb_R12021_; // to lexer 11561 11562 Make sure the statement has a valid form for the INTERFACE statement. If 11563 it does, implement the statement. */ 11564 11565static ffelexHandler 11566ffestb_R12021_ (ffelexToken t) 11567{ 11568 ffestb_local_.interface.slash = TRUE; /* Slash follows open paren. */ 11569 11570 switch (ffelex_token_type (t)) 11571 { 11572 case FFELEX_typeEOS: 11573 case FFELEX_typeSEMICOLON: 11574 if (!ffesta_is_inhibited ()) 11575 ffestc_R1202 (FFESTP_definedoperatorNone, ffesta_tokens[1]); 11576 ffelex_token_kill (ffesta_tokens[1]); 11577 return (ffelexHandler) ffesta_zero (t); 11578 11579 case FFELEX_typeOPEN_PAREN: 11580 ffestb_local_.interface.slash = FALSE; /* Slash doesn't follow. */ 11581 /* Fall through. */ 11582 case FFELEX_typeOPEN_ARRAY: 11583 switch (ffestb_local_.interface.operator) 11584 { 11585 case FFESTP_definedoperatorNone: 11586 break; 11587 11588 case FFESTP_definedoperatorOPERATOR: 11589 ffestb_local_.interface.assignment = FALSE; 11590 return (ffelexHandler) ffestb_R12022_; 11591 11592 case FFESTP_definedoperatorASSIGNMENT: 11593 ffestb_local_.interface.assignment = TRUE; 11594 return (ffelexHandler) ffestb_R12022_; 11595 11596 default: 11597 assert (FALSE); 11598 } 11599 break; 11600 11601 case FFELEX_typeCOMMA: 11602 case FFELEX_typeCOLONCOLON: 11603 ffesta_confirmed (); /* Error, but clearly intended. */ 11604 break; 11605 11606 default: 11607 break; 11608 } 11609 11610 ffelex_token_kill (ffesta_tokens[1]); 11611 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t); 11612 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 11613} 11614 11615/* ffestb_R12022_ -- "INTERFACE" "OPERATOR/ASSIGNMENT" OPEN_PAREN 11616 11617 return ffestb_R12022_; // to lexer 11618 11619 Make sure the statement has a valid form for the INTERFACE statement. If 11620 it does, implement the statement. */ 11621 11622static ffelexHandler 11623ffestb_R12022_ (ffelexToken t) 11624{ 11625 ffesta_tokens[2] = ffelex_token_use (t); 11626 11627 switch (ffelex_token_type (t)) 11628 { 11629 case FFELEX_typePERIOD: 11630 if (ffestb_local_.interface.slash) 11631 break; 11632 return (ffelexHandler) ffestb_R12023_; 11633 11634 case FFELEX_typePOWER: 11635 if (ffestb_local_.interface.slash) 11636 break; 11637 ffestb_local_.interface.operator = FFESTP_definedoperatorPOWER; 11638 return (ffelexHandler) ffestb_R12025_; 11639 11640 case FFELEX_typeASTERISK: 11641 if (ffestb_local_.interface.slash) 11642 break; 11643 ffestb_local_.interface.operator = FFESTP_definedoperatorMULT; 11644 return (ffelexHandler) ffestb_R12025_; 11645 11646 case FFELEX_typePLUS: 11647 if (ffestb_local_.interface.slash) 11648 break; 11649 ffestb_local_.interface.operator = FFESTP_definedoperatorADD; 11650 return (ffelexHandler) ffestb_R12025_; 11651 11652 case FFELEX_typeCONCAT: 11653 if (ffestb_local_.interface.slash) 11654 break; 11655 ffestb_local_.interface.operator = FFESTP_definedoperatorCONCAT; 11656 return (ffelexHandler) ffestb_R12025_; 11657 11658 case FFELEX_typeSLASH: 11659 if (ffestb_local_.interface.slash) 11660 { 11661 ffestb_local_.interface.operator = FFESTP_definedoperatorCONCAT; 11662 return (ffelexHandler) ffestb_R12025_; 11663 } 11664 ffestb_local_.interface.operator = FFESTP_definedoperatorDIVIDE; 11665 return (ffelexHandler) ffestb_R12025_; 11666 11667 case FFELEX_typeMINUS: 11668 if (ffestb_local_.interface.slash) 11669 break; 11670 ffestb_local_.interface.operator = FFESTP_definedoperatorSUBTRACT; 11671 return (ffelexHandler) ffestb_R12025_; 11672 11673 case FFELEX_typeREL_EQ: 11674 if (ffestb_local_.interface.slash) 11675 break; 11676 ffestb_local_.interface.operator = FFESTP_definedoperatorEQ; 11677 return (ffelexHandler) ffestb_R12025_; 11678 11679 case FFELEX_typeREL_NE: 11680 if (ffestb_local_.interface.slash) 11681 break; 11682 ffestb_local_.interface.operator = FFESTP_definedoperatorNE; 11683 return (ffelexHandler) ffestb_R12025_; 11684 11685 case FFELEX_typeOPEN_ANGLE: 11686 if (ffestb_local_.interface.slash) 11687 break; 11688 ffestb_local_.interface.operator = FFESTP_definedoperatorLT; 11689 return (ffelexHandler) ffestb_R12025_; 11690 11691 case FFELEX_typeREL_LE: 11692 if (ffestb_local_.interface.slash) 11693 break; 11694 ffestb_local_.interface.operator = FFESTP_definedoperatorLE; 11695 return (ffelexHandler) ffestb_R12025_; 11696 11697 case FFELEX_typeCLOSE_ANGLE: 11698 if (ffestb_local_.interface.slash) 11699 break; 11700 ffestb_local_.interface.operator = FFESTP_definedoperatorGT; 11701 return (ffelexHandler) ffestb_R12025_; 11702 11703 case FFELEX_typeREL_GE: 11704 if (ffestb_local_.interface.slash) 11705 break; 11706 ffestb_local_.interface.operator = FFESTP_definedoperatorGE; 11707 return (ffelexHandler) ffestb_R12025_; 11708 11709 case FFELEX_typeEQUALS: 11710 if (ffestb_local_.interface.slash) 11711 { 11712 ffestb_local_.interface.operator = FFESTP_definedoperatorNE; 11713 return (ffelexHandler) ffestb_R12025_; 11714 } 11715 ffestb_local_.interface.operator = FFESTP_definedoperatorASSIGNMENT; 11716 return (ffelexHandler) ffestb_R12025_; 11717 11718 case FFELEX_typeCLOSE_ARRAY: 11719 if (!ffestb_local_.interface.slash) 11720 { 11721 ffestb_local_.interface.operator = FFESTP_definedoperatorDIVIDE; 11722 return (ffelexHandler) ffestb_R12026_; 11723 } 11724 ffestb_local_.interface.operator = FFESTP_definedoperatorCONCAT; 11725 return (ffelexHandler) ffestb_R12026_; 11726 11727 case FFELEX_typeCLOSE_PAREN: 11728 if (!ffestb_local_.interface.slash) 11729 break; 11730 ffestb_local_.interface.operator = FFESTP_definedoperatorDIVIDE; 11731 return (ffelexHandler) ffestb_R12026_; 11732 11733 default: 11734 break; 11735 } 11736 11737 ffelex_token_kill (ffesta_tokens[1]); 11738 ffelex_token_kill (ffesta_tokens[2]); 11739 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t); 11740 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 11741} 11742 11743/* ffestb_R12023_ -- "INTERFACE" NAME OPEN_PAREN PERIOD 11744 11745 return ffestb_R12023_; // to lexer 11746 11747 Make sure the statement has a valid form for the INTERFACE statement. If 11748 it does, implement the statement. */ 11749 11750static ffelexHandler 11751ffestb_R12023_ (ffelexToken t) 11752{ 11753 switch (ffelex_token_type (t)) 11754 { 11755 case FFELEX_typeNAME: 11756 ffelex_token_kill (ffesta_tokens[2]); 11757 ffesta_tokens[2] = ffelex_token_use (t); 11758 return (ffelexHandler) ffestb_R12024_; 11759 11760 default: 11761 break; 11762 } 11763 11764 ffelex_token_kill (ffesta_tokens[1]); 11765 ffelex_token_kill (ffesta_tokens[2]); 11766 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t); 11767 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 11768} 11769 11770/* ffestb_R12024_ -- "INTERFACE" NAME OPEN_PAREN PERIOD NAME 11771 11772 return ffestb_R12024_; // to lexer 11773 11774 Make sure the statement has a valid form for the INTERFACE statement. If 11775 it does, implement the statement. */ 11776 11777static ffelexHandler 11778ffestb_R12024_ (ffelexToken t) 11779{ 11780 switch (ffelex_token_type (t)) 11781 { 11782 case FFELEX_typePERIOD: 11783 return (ffelexHandler) ffestb_R12025_; 11784 11785 default: 11786 break; 11787 } 11788 11789 ffelex_token_kill (ffesta_tokens[1]); 11790 ffelex_token_kill (ffesta_tokens[2]); 11791 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t); 11792 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 11793} 11794 11795/* ffestb_R12025_ -- "INTERFACE" NAME OPEN_PAREN operator 11796 11797 return ffestb_R12025_; // to lexer 11798 11799 Make sure the statement has a valid form for the INTERFACE statement. If 11800 it does, implement the statement. */ 11801 11802static ffelexHandler 11803ffestb_R12025_ (ffelexToken t) 11804{ 11805 switch (ffelex_token_type (t)) 11806 { 11807 case FFELEX_typeCLOSE_PAREN: 11808 return (ffelexHandler) ffestb_R12026_; 11809 11810 default: 11811 break; 11812 } 11813 11814 ffelex_token_kill (ffesta_tokens[1]); 11815 ffelex_token_kill (ffesta_tokens[2]); 11816 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t); 11817 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 11818} 11819 11820/* ffestb_R12026_ -- "INTERFACE" NAME OPEN_PAREN operator CLOSE_PAREN 11821 11822 return ffestb_R12026_; // to lexer 11823 11824 Make sure the statement has a valid form for the INTERFACE statement. If 11825 it does, implement the statement. */ 11826 11827static ffelexHandler 11828ffestb_R12026_ (ffelexToken t) 11829{ 11830 const char *p; 11831 11832 switch (ffelex_token_type (t)) 11833 { 11834 case FFELEX_typeEOS: 11835 case FFELEX_typeSEMICOLON: 11836 ffesta_confirmed (); 11837 if (ffestb_local_.interface.assignment 11838 && (ffestb_local_.interface.operator 11839 != FFESTP_definedoperatorASSIGNMENT)) 11840 { 11841 ffebad_start (FFEBAD_INTERFACE_ASSIGNMENT); 11842 ffebad_here (0, ffelex_token_where_line (ffesta_tokens[1]), 11843 ffelex_token_where_column (ffesta_tokens[1])); 11844 ffebad_here (1, ffelex_token_where_line (ffesta_tokens[2]), 11845 ffelex_token_where_column (ffesta_tokens[2])); 11846 ffebad_finish (); 11847 } 11848 switch (ffelex_token_type (ffesta_tokens[2])) 11849 { 11850 case FFELEX_typeNAME: 11851 switch (ffestr_other (ffesta_tokens[2])) 11852 { 11853 case FFESTR_otherNOT: 11854 if (!ffesta_is_inhibited ()) 11855 ffestc_R1202 (FFESTP_definedoperatorNOT, NULL); 11856 break; 11857 11858 case FFESTR_otherAND: 11859 if (!ffesta_is_inhibited ()) 11860 ffestc_R1202 (FFESTP_definedoperatorAND, NULL); 11861 break; 11862 11863 case FFESTR_otherOR: 11864 if (!ffesta_is_inhibited ()) 11865 ffestc_R1202 (FFESTP_definedoperatorOR, NULL); 11866 break; 11867 11868 case FFESTR_otherEQV: 11869 if (!ffesta_is_inhibited ()) 11870 ffestc_R1202 (FFESTP_definedoperatorEQV, NULL); 11871 break; 11872 11873 case FFESTR_otherNEQV: 11874 if (!ffesta_is_inhibited ()) 11875 ffestc_R1202 (FFESTP_definedoperatorNEQV, NULL); 11876 break; 11877 11878 case FFESTR_otherEQ: 11879 if (!ffesta_is_inhibited ()) 11880 ffestc_R1202 (FFESTP_definedoperatorEQ, NULL); 11881 break; 11882 11883 case FFESTR_otherNE: 11884 if (!ffesta_is_inhibited ()) 11885 ffestc_R1202 (FFESTP_definedoperatorNE, NULL); 11886 break; 11887 11888 case FFESTR_otherLT: 11889 if (!ffesta_is_inhibited ()) 11890 ffestc_R1202 (FFESTP_definedoperatorLT, NULL); 11891 break; 11892 11893 case FFESTR_otherLE: 11894 if (!ffesta_is_inhibited ()) 11895 ffestc_R1202 (FFESTP_definedoperatorLE, NULL); 11896 break; 11897 11898 case FFESTR_otherGT: 11899 if (!ffesta_is_inhibited ()) 11900 ffestc_R1202 (FFESTP_definedoperatorGT, NULL); 11901 break; 11902 11903 case FFESTR_otherGE: 11904 if (!ffesta_is_inhibited ()) 11905 ffestc_R1202 (FFESTP_definedoperatorGE, NULL); 11906 break; 11907 11908 default: 11909 for (p = ffelex_token_text (ffesta_tokens[2]); *p != '\0'; ++p) 11910 { 11911 if (! ISALPHA (*p)) 11912 { 11913 ffelex_token_kill (ffesta_tokens[1]); 11914 ffelex_token_kill (ffesta_tokens[2]); 11915 ffesta_ffebad_1t (FFEBAD_INTERFACE_NONLETTER, 11916 ffesta_tokens[2]); 11917 return (ffelexHandler) ffelex_swallow_tokens (t, 11918 (ffelexHandler) ffesta_zero); 11919 } 11920 } 11921 if (!ffesta_is_inhibited ()) 11922 ffestc_R1202 (FFESTP_definedoperatorOPERATOR, 11923 ffesta_tokens[2]); 11924 } 11925 break; 11926 11927 case FFELEX_typeEQUALS: 11928 if (!ffestb_local_.interface.assignment 11929 && (ffestb_local_.interface.operator 11930 == FFESTP_definedoperatorASSIGNMENT)) 11931 { 11932 ffebad_start (FFEBAD_INTERFACE_OPERATOR); 11933 ffebad_here (0, ffelex_token_where_line (ffesta_tokens[1]), 11934 ffelex_token_where_column (ffesta_tokens[1])); 11935 ffebad_here (1, ffelex_token_where_line (ffesta_tokens[2]), 11936 ffelex_token_where_column (ffesta_tokens[2])); 11937 ffebad_finish (); 11938 } 11939 if (!ffesta_is_inhibited ()) 11940 ffestc_R1202 (ffestb_local_.interface.operator, NULL); 11941 break; 11942 11943 default: 11944 if (!ffesta_is_inhibited ()) 11945 ffestc_R1202 (ffestb_local_.interface.operator, NULL); 11946 } 11947 ffelex_token_kill (ffesta_tokens[1]); 11948 ffelex_token_kill (ffesta_tokens[2]); 11949 return (ffelexHandler) ffesta_zero (t); 11950 11951 default: 11952 break; 11953 } 11954 11955 ffelex_token_kill (ffesta_tokens[1]); 11956 ffelex_token_kill (ffesta_tokens[2]); 11957 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t); 11958 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 11959} 11960 11961#endif 11962/* ffestb_S3P4 -- Parse the INCLUDE line 11963 11964 return ffestb_S3P4; // to lexer 11965 11966 Make sure the statement has a valid form for the INCLUDE line. If it 11967 does, implement the statement. */ 11968 11969ffelexHandler 11970ffestb_S3P4 (ffelexToken t) 11971{ 11972 ffeTokenLength i; 11973 const char *p; 11974 ffelexHandler next; 11975 ffelexToken nt; 11976 ffelexToken ut; 11977 11978 switch (ffelex_token_type (ffesta_tokens[0])) 11979 { 11980 case FFELEX_typeNAME: 11981 if (ffesta_first_kw != FFESTR_firstINCLUDE) 11982 goto bad_0; /* :::::::::::::::::::: */ 11983 switch (ffelex_token_type (t)) 11984 { 11985 case FFELEX_typeNUMBER: 11986 case FFELEX_typeAPOSTROPHE: 11987 case FFELEX_typeQUOTE: 11988 break; 11989 11990 default: 11991 goto bad_1; /* :::::::::::::::::::: */ 11992 } 11993 ffesta_confirmed (); 11994 return (ffelexHandler) (*((ffelexHandler) 11995 ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextINCLUDE, 11996 (ffeexprCallback) ffestb_S3P41_))) 11997 (t); 11998 11999 case FFELEX_typeNAMES: 12000 if (ffesta_first_kw != FFESTR_firstINCLUDE) 12001 goto bad_0; /* :::::::::::::::::::: */ 12002 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlINCLUDE); 12003 switch (ffelex_token_type (t)) 12004 { 12005 default: 12006 goto bad_1; /* :::::::::::::::::::: */ 12007 12008 case FFELEX_typeAPOSTROPHE: 12009 case FFELEX_typeQUOTE: 12010 break; 12011 } 12012 ffesta_confirmed (); 12013 if (*p == '\0') 12014 return (ffelexHandler) (*((ffelexHandler) 12015 ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextINCLUDE, 12016 (ffeexprCallback) ffestb_S3P41_))) 12017 (t); 12018 if (! ISDIGIT (*p)) 12019 goto bad_i; /* :::::::::::::::::::: */ 12020 nt = ffelex_token_number_from_names (ffesta_tokens[0], i); 12021 p += ffelex_token_length (nt); 12022 i += ffelex_token_length (nt); 12023 if ((*p != '_') || (++i, *++p != '\0')) 12024 { 12025 ffelex_token_kill (nt); 12026 goto bad_i; /* :::::::::::::::::::: */ 12027 } 12028 ut = ffelex_token_uscore_from_names (ffesta_tokens[0], i - 1); 12029 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs 12030 (ffesta_output_pool, FFEEXPR_contextINCLUDE, 12031 (ffeexprCallback) ffestb_S3P41_))) 12032 (nt); 12033 ffelex_token_kill (nt); 12034 next = (ffelexHandler) (*next) (ut); 12035 ffelex_token_kill (ut); 12036 return (ffelexHandler) (*next) (t); 12037 12038 default: 12039 goto bad_0; /* :::::::::::::::::::: */ 12040 } 12041 12042bad_0: /* :::::::::::::::::::: */ 12043 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INCLUDE", ffesta_tokens[0]); 12044 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 12045 12046bad_1: /* :::::::::::::::::::: */ 12047 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INCLUDE", t); 12048 return (ffelexHandler) ffelex_swallow_tokens (t, 12049 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 12050 12051bad_i: /* :::::::::::::::::::: */ 12052 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "INCLUDE", ffesta_tokens[0], i, t); 12053 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 12054} 12055 12056/* ffestb_S3P41_ -- "INCLUDE" [NUMBER "_"] expr 12057 12058 (ffestb_S3P41_) // to expression handler 12059 12060 Make sure the next token is an EOS, but not a SEMICOLON. */ 12061 12062static ffelexHandler 12063ffestb_S3P41_ (ffelexToken ft, ffebld expr, ffelexToken t) 12064{ 12065 switch (ffelex_token_type (t)) 12066 { 12067 case FFELEX_typeEOS: 12068 case FFELEX_typeSEMICOLON: 12069 if (expr == NULL) 12070 break; 12071 if (!ffesta_is_inhibited ()) 12072 { 12073 if (ffe_is_pedantic () 12074 && ((ffelex_token_type (t) == FFELEX_typeSEMICOLON) 12075 || ffesta_line_has_semicolons)) 12076 { 12077 ffebad_start_msg ("INCLUDE at %0 not the only statement on the source line", FFEBAD_severityWARNING); 12078 ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]), 12079 ffelex_token_where_column (ffesta_tokens[0])); 12080 ffebad_finish (); 12081 } 12082 ffestc_S3P4 (expr, ft); 12083 } 12084 return (ffelexHandler) ffesta_zero (t); 12085 12086 default: 12087 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INCLUDE", t); 12088 break; 12089 } 12090 12091 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 12092} 12093 12094/* ffestb_V012 -- Parse the MAP statement 12095 12096 return ffestb_V012; // to lexer 12097 12098 Make sure the statement has a valid form for the MAP statement. If 12099 it does, implement the statement. */ 12100 12101#if FFESTR_VXT 12102ffelexHandler 12103ffestb_V012 (ffelexToken t) 12104{ 12105 const char *p; 12106 ffeTokenLength i; 12107 12108 switch (ffelex_token_type (ffesta_tokens[0])) 12109 { 12110 case FFELEX_typeNAME: 12111 if (ffesta_first_kw != FFESTR_firstMAP) 12112 goto bad_0; /* :::::::::::::::::::: */ 12113 break; 12114 12115 case FFELEX_typeNAMES: 12116 if (ffesta_first_kw != FFESTR_firstMAP) 12117 goto bad_0; /* :::::::::::::::::::: */ 12118 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlMAP) 12119 { 12120 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlMAP); 12121 goto bad_i; /* :::::::::::::::::::: */ 12122 } 12123 break; 12124 12125 default: 12126 goto bad_0; /* :::::::::::::::::::: */ 12127 } 12128 12129 switch (ffelex_token_type (t)) 12130 { 12131 case FFELEX_typeEOS: 12132 case FFELEX_typeSEMICOLON: 12133 ffesta_confirmed (); 12134 if (!ffesta_is_inhibited ()) 12135 ffestc_V012 (); 12136 return (ffelexHandler) ffesta_zero (t); 12137 12138 case FFELEX_typeCOMMA: 12139 case FFELEX_typeCOLONCOLON: 12140 ffesta_confirmed (); /* Error, but clearly intended. */ 12141 goto bad_1; /* :::::::::::::::::::: */ 12142 12143 default: 12144 goto bad_1; /* :::::::::::::::::::: */ 12145 } 12146 12147bad_0: /* :::::::::::::::::::: */ 12148 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MAP", ffesta_tokens[0]); 12149 return (ffelexHandler) ffelex_swallow_tokens (t, 12150 (ffelexHandler) ffesta_zero); /* Invalid first token. */ 12151 12152bad_1: /* :::::::::::::::::::: */ 12153 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MAP", t); 12154 return (ffelexHandler) ffelex_swallow_tokens (t, 12155 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 12156 12157bad_i: /* :::::::::::::::::::: */ 12158 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "MAP", ffesta_tokens[0], i, t); 12159 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 12160} 12161 12162#endif 12163/* ffestb_V014 -- Parse the VOLATILE statement 12164 12165 return ffestb_V014; // to lexer 12166 12167 Make sure the statement has a valid form for the VOLATILE statement. If it 12168 does, implement the statement. */ 12169 12170ffelexHandler 12171ffestb_V014 (ffelexToken t) 12172{ 12173 ffeTokenLength i; 12174 unsigned const char *p; 12175 ffelexToken nt; 12176 ffelexHandler next; 12177 12178 switch (ffelex_token_type (ffesta_tokens[0])) 12179 { 12180 case FFELEX_typeNAME: 12181 if (ffesta_first_kw != FFESTR_firstVOLATILE) 12182 goto bad_0; /* :::::::::::::::::::: */ 12183 switch (ffelex_token_type (t)) 12184 { 12185 case FFELEX_typeEOS: 12186 case FFELEX_typeSEMICOLON: 12187 case FFELEX_typeCOMMA: 12188 ffesta_confirmed (); /* Error, but clearly intended. */ 12189 goto bad_1; /* :::::::::::::::::::: */ 12190 12191 default: 12192 goto bad_1; /* :::::::::::::::::::: */ 12193 12194 case FFELEX_typeNAME: 12195 case FFELEX_typeSLASH: 12196 ffesta_confirmed (); 12197 if (!ffesta_is_inhibited ()) 12198 ffestc_V014_start (); 12199 return (ffelexHandler) ffestb_V0141_ (t); 12200 12201 case FFELEX_typeCOLONCOLON: 12202 ffesta_confirmed (); 12203 if (!ffesta_is_inhibited ()) 12204 ffestc_V014_start (); 12205 return (ffelexHandler) ffestb_V0141_; 12206 } 12207 12208 case FFELEX_typeNAMES: 12209 if (ffesta_first_kw != FFESTR_firstVOLATILE) 12210 goto bad_0; /* :::::::::::::::::::: */ 12211 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlVOLATILE); 12212 switch (ffelex_token_type (t)) 12213 { 12214 default: 12215 goto bad_1; /* :::::::::::::::::::: */ 12216 12217 case FFELEX_typeCOMMA: 12218 case FFELEX_typeEOS: 12219 case FFELEX_typeSEMICOLON: 12220 ffesta_confirmed (); 12221 break; 12222 12223 case FFELEX_typeSLASH: 12224 ffesta_confirmed (); 12225 if (*p != '\0') 12226 goto bad_i; /* :::::::::::::::::::: */ 12227 if (!ffesta_is_inhibited ()) 12228 ffestc_V014_start (); 12229 return (ffelexHandler) ffestb_V0141_ (t); 12230 12231 case FFELEX_typeCOLONCOLON: 12232 ffesta_confirmed (); 12233 if (*p != '\0') 12234 goto bad_i; /* :::::::::::::::::::: */ 12235 if (!ffesta_is_inhibited ()) 12236 ffestc_V014_start (); 12237 return (ffelexHandler) ffestb_V0141_; 12238 } 12239 12240 /* Here, we have at least one char after "VOLATILE" and t is COMMA or 12241 EOS/SEMICOLON. */ 12242 12243 if (!ffesrc_is_name_init (*p)) 12244 goto bad_i; /* :::::::::::::::::::: */ 12245 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); 12246 if (!ffesta_is_inhibited ()) 12247 ffestc_V014_start (); 12248 next = (ffelexHandler) ffestb_V0141_ (nt); 12249 ffelex_token_kill (nt); 12250 return (ffelexHandler) (*next) (t); 12251 12252 default: 12253 goto bad_0; /* :::::::::::::::::::: */ 12254 } 12255 12256bad_0: /* :::::::::::::::::::: */ 12257 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", ffesta_tokens[0]); 12258 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 12259 12260bad_1: /* :::::::::::::::::::: */ 12261 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t); 12262 return (ffelexHandler) ffelex_swallow_tokens (t, 12263 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 12264 12265bad_i: /* :::::::::::::::::::: */ 12266 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "VOLATILE", ffesta_tokens[0], i, t); 12267 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 12268} 12269 12270/* ffestb_V0141_ -- "VOLATILE" [COLONCOLON] 12271 12272 return ffestb_V0141_; // to lexer 12273 12274 Handle NAME or SLASH. */ 12275 12276static ffelexHandler 12277ffestb_V0141_ (ffelexToken t) 12278{ 12279 switch (ffelex_token_type (t)) 12280 { 12281 case FFELEX_typeNAME: 12282 ffestb_local_.V014.is_cblock = FALSE; 12283 ffesta_tokens[1] = ffelex_token_use (t); 12284 return (ffelexHandler) ffestb_V0144_; 12285 12286 case FFELEX_typeSLASH: 12287 ffestb_local_.V014.is_cblock = TRUE; 12288 return (ffelexHandler) ffestb_V0142_; 12289 12290 default: 12291 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t); 12292 break; 12293 } 12294 12295 if (!ffesta_is_inhibited ()) 12296 ffestc_V014_finish (); 12297 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 12298} 12299 12300/* ffestb_V0142_ -- "VOLATILE" [COLONCOLON] SLASH 12301 12302 return ffestb_V0142_; // to lexer 12303 12304 Handle NAME. */ 12305 12306static ffelexHandler 12307ffestb_V0142_ (ffelexToken t) 12308{ 12309 switch (ffelex_token_type (t)) 12310 { 12311 case FFELEX_typeNAME: 12312 ffesta_tokens[1] = ffelex_token_use (t); 12313 return (ffelexHandler) ffestb_V0143_; 12314 12315 default: 12316 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t); 12317 break; 12318 } 12319 12320 if (!ffesta_is_inhibited ()) 12321 ffestc_V014_finish (); 12322 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 12323} 12324 12325/* ffestb_V0143_ -- "VOLATILE" [COLONCOLON] SLASH NAME 12326 12327 return ffestb_V0143_; // to lexer 12328 12329 Handle SLASH. */ 12330 12331static ffelexHandler 12332ffestb_V0143_ (ffelexToken t) 12333{ 12334 switch (ffelex_token_type (t)) 12335 { 12336 case FFELEX_typeSLASH: 12337 return (ffelexHandler) ffestb_V0144_; 12338 12339 default: 12340 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t); 12341 break; 12342 } 12343 12344 if (!ffesta_is_inhibited ()) 12345 ffestc_V014_finish (); 12346 ffelex_token_kill (ffesta_tokens[1]); 12347 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 12348} 12349 12350/* ffestb_V0144_ -- "VOLATILE" [COLONCOLON] R523 12351 12352 return ffestb_V0144_; // to lexer 12353 12354 Handle COMMA or EOS/SEMICOLON. */ 12355 12356static ffelexHandler 12357ffestb_V0144_ (ffelexToken t) 12358{ 12359 switch (ffelex_token_type (t)) 12360 { 12361 case FFELEX_typeCOMMA: 12362 if (!ffesta_is_inhibited ()) 12363 { 12364 if (ffestb_local_.V014.is_cblock) 12365 ffestc_V014_item_cblock (ffesta_tokens[1]); 12366 else 12367 ffestc_V014_item_object (ffesta_tokens[1]); 12368 } 12369 ffelex_token_kill (ffesta_tokens[1]); 12370 return (ffelexHandler) ffestb_V0141_; 12371 12372 case FFELEX_typeEOS: 12373 case FFELEX_typeSEMICOLON: 12374 if (!ffesta_is_inhibited ()) 12375 { 12376 if (ffestb_local_.V014.is_cblock) 12377 ffestc_V014_item_cblock (ffesta_tokens[1]); 12378 else 12379 ffestc_V014_item_object (ffesta_tokens[1]); 12380 ffestc_V014_finish (); 12381 } 12382 ffelex_token_kill (ffesta_tokens[1]); 12383 return (ffelexHandler) ffesta_zero (t); 12384 12385 default: 12386 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t); 12387 break; 12388 } 12389 12390 if (!ffesta_is_inhibited ()) 12391 ffestc_V014_finish (); 12392 ffelex_token_kill (ffesta_tokens[1]); 12393 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 12394} 12395 12396/* ffestb_V025 -- Parse the DEFINEFILE statement 12397 12398 return ffestb_V025; // to lexer 12399 12400 Make sure the statement has a valid form for the DEFINEFILE statement. 12401 If it does, implement the statement. */ 12402 12403#if FFESTR_VXT 12404ffelexHandler 12405ffestb_V025 (ffelexToken t) 12406{ 12407 ffeTokenLength i; 12408 const char *p; 12409 ffelexToken nt; 12410 ffelexHandler next; 12411 12412 ffestb_local_.V025.started = FALSE; 12413 switch (ffelex_token_type (ffesta_tokens[0])) 12414 { 12415 case FFELEX_typeNAME: 12416 switch (ffesta_first_kw) 12417 { 12418 case FFESTR_firstDEFINE: 12419 if ((ffelex_token_type (t) != FFELEX_typeNAME) 12420 || (ffesta_second_kw != FFESTR_secondFILE)) 12421 goto bad_1; /* :::::::::::::::::::: */ 12422 ffesta_confirmed (); 12423 return (ffelexHandler) ffestb_V0251_; 12424 12425 case FFESTR_firstDEFINEFILE: 12426 return (ffelexHandler) ffestb_V0251_ (t); 12427 12428 default: 12429 goto bad_0; /* :::::::::::::::::::: */ 12430 } 12431 12432 case FFELEX_typeNAMES: 12433 if (ffesta_first_kw != FFESTR_firstDEFINEFILE) 12434 goto bad_0; /* :::::::::::::::::::: */ 12435 switch (ffelex_token_type (t)) 12436 { 12437 case FFELEX_typeCOMMA: 12438 case FFELEX_typeEOS: 12439 case FFELEX_typeSEMICOLON: 12440 case FFELEX_typeCOLONCOLON: 12441 ffesta_confirmed (); /* Error, but clearly intended. */ 12442 goto bad_1; /* :::::::::::::::::::: */ 12443 12444 default: 12445 goto bad_1; /* :::::::::::::::::::: */ 12446 12447 case FFELEX_typeOPEN_PAREN: 12448 break; 12449 } 12450 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDEFINEFILE); 12451 if (ISDIGIT (*p)) 12452 nt = ffelex_token_number_from_names (ffesta_tokens[0], i); 12453 else if (ffesrc_is_name_init (*p)) 12454 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); 12455 else 12456 goto bad_i; /* :::::::::::::::::::: */ 12457 next = (ffelexHandler) ffestb_V0251_ (nt); 12458 ffelex_token_kill (nt); 12459 return (ffelexHandler) (*next) (t); 12460 12461 default: 12462 goto bad_0; /* :::::::::::::::::::: */ 12463 } 12464 12465bad_0: /* :::::::::::::::::::: */ 12466 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", ffesta_tokens[0]); 12467 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 12468 12469bad_1: /* :::::::::::::::::::: */ 12470 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t); 12471 return (ffelexHandler) ffelex_swallow_tokens (t, 12472 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 12473 12474bad_i: /* :::::::::::::::::::: */ 12475 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", ffesta_tokens[0], i, t); 12476 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 12477} 12478 12479/* ffestb_V0251_ -- "DEFINEFILE" or "DEFINE" "FILE" 12480 12481 return ffestb_V0251_; // to lexer 12482 12483 Make sure the statement has a valid form for the DEFINEFILE statement. If it 12484 does, implement the statement. */ 12485 12486static ffelexHandler 12487ffestb_V0251_ (ffelexToken t) 12488{ 12489 switch (ffelex_token_type (t)) 12490 { 12491 case FFELEX_typeNAME: 12492 case FFELEX_typeNUMBER: 12493 if (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME) 12494 ffesta_confirmed (); 12495 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 12496 FFEEXPR_contextFILEUNIT_DF, (ffeexprCallback) ffestb_V0252_))) 12497 (t); 12498 12499 case FFELEX_typeEOS: 12500 case FFELEX_typeSEMICOLON: 12501 case FFELEX_typeCOMMA: 12502 case FFELEX_typeCOLONCOLON: 12503 ffesta_confirmed (); /* Error, but clearly intended. */ 12504 break; 12505 12506 default: 12507 break; 12508 } 12509 12510 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t); 12511 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 12512} 12513 12514/* ffestb_V0252_ -- "DEFINEFILE" expr 12515 12516 (ffestb_V0252_) // to expression handler 12517 12518 Make sure the statement has a valid form for the DEFINEFILE statement. If 12519 it does, implement the statement. */ 12520 12521static ffelexHandler 12522ffestb_V0252_ (ffelexToken ft, ffebld expr, ffelexToken t) 12523{ 12524 switch (ffelex_token_type (t)) 12525 { 12526 case FFELEX_typeOPEN_PAREN: 12527 ffestb_local_.V025.u = expr; 12528 ffesta_tokens[1] = ffelex_token_use (ft); 12529 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 12530 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0253_); 12531 12532 default: 12533 break; 12534 } 12535 12536 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t); 12537 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 12538} 12539 12540/* ffestb_V0253_ -- "DEFINEFILE" expr OPEN_PAREN expr 12541 12542 (ffestb_V0253_) // to expression handler 12543 12544 Make sure the statement has a valid form for the DEFINEFILE statement. If 12545 it does, implement the statement. */ 12546 12547static ffelexHandler 12548ffestb_V0253_ (ffelexToken ft, ffebld expr, ffelexToken t) 12549{ 12550 switch (ffelex_token_type (t)) 12551 { 12552 case FFELEX_typeCOMMA: 12553 ffestb_local_.V025.m = expr; 12554 ffesta_tokens[2] = ffelex_token_use (ft); 12555 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 12556 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0254_); 12557 12558 default: 12559 break; 12560 } 12561 12562 ffelex_token_kill (ffesta_tokens[1]); 12563 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t); 12564 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 12565} 12566 12567/* ffestb_V0254_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr 12568 12569 (ffestb_V0254_) // to expression handler 12570 12571 Make sure the statement has a valid form for the DEFINEFILE statement. If 12572 it does, implement the statement. */ 12573 12574static ffelexHandler 12575ffestb_V0254_ (ffelexToken ft, ffebld expr, ffelexToken t) 12576{ 12577 switch (ffelex_token_type (t)) 12578 { 12579 case FFELEX_typeCOMMA: 12580 ffestb_local_.V025.n = expr; 12581 ffesta_tokens[3] = ffelex_token_use (ft); 12582 return (ffelexHandler) ffestb_V0255_; 12583 12584 default: 12585 break; 12586 } 12587 12588 ffelex_token_kill (ffesta_tokens[1]); 12589 ffelex_token_kill (ffesta_tokens[2]); 12590 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t); 12591 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 12592} 12593 12594/* ffestb_V0255_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA 12595 12596 return ffestb_V0255_; // to lexer 12597 12598 Make sure the statement has a valid form for the DEFINEFILE statement. If 12599 it does, implement the statement. */ 12600 12601static ffelexHandler 12602ffestb_V0255_ (ffelexToken t) 12603{ 12604 const char *p; 12605 12606 switch (ffelex_token_type (t)) 12607 { 12608 case FFELEX_typeNAME: 12609 p = ffelex_token_text (t); 12610 if (!ffesrc_char_match_init (*p, 'U', 'u') || (*++p != '\0')) 12611 break; 12612 return (ffelexHandler) ffestb_V0256_; 12613 12614 default: 12615 break; 12616 } 12617 12618 ffelex_token_kill (ffesta_tokens[1]); 12619 ffelex_token_kill (ffesta_tokens[2]); 12620 ffelex_token_kill (ffesta_tokens[3]); 12621 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t); 12622 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 12623} 12624 12625/* ffestb_V0256_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA "U" 12626 12627 return ffestb_V0256_; // to lexer 12628 12629 Make sure the statement has a valid form for the DEFINEFILE statement. If 12630 it does, implement the statement. */ 12631 12632static ffelexHandler 12633ffestb_V0256_ (ffelexToken t) 12634{ 12635 switch (ffelex_token_type (t)) 12636 { 12637 case FFELEX_typeCOMMA: 12638 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 12639 FFEEXPR_contextFILEASSOC, 12640 (ffeexprCallback) ffestb_V0257_); 12641 12642 default: 12643 break; 12644 } 12645 12646 ffelex_token_kill (ffesta_tokens[1]); 12647 ffelex_token_kill (ffesta_tokens[2]); 12648 ffelex_token_kill (ffesta_tokens[3]); 12649 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t); 12650 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 12651} 12652 12653/* ffestb_V0257_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA "U" 12654 COMMA expr 12655 12656 (ffestb_V0257_) // to expression handler 12657 12658 Make sure the statement has a valid form for the DEFINEFILE statement. If 12659 it does, implement the statement. */ 12660 12661static ffelexHandler 12662ffestb_V0257_ (ffelexToken ft, ffebld expr, ffelexToken t) 12663{ 12664 switch (ffelex_token_type (t)) 12665 { 12666 case FFELEX_typeCLOSE_PAREN: 12667 ffestb_local_.V025.asv = expr; 12668 ffesta_tokens[4] = ffelex_token_use (ft); 12669 return (ffelexHandler) ffestb_V0258_; 12670 12671 default: 12672 break; 12673 } 12674 12675 ffelex_token_kill (ffesta_tokens[1]); 12676 ffelex_token_kill (ffesta_tokens[2]); 12677 ffelex_token_kill (ffesta_tokens[3]); 12678 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t); 12679 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 12680} 12681 12682/* ffestb_V0258_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA "U" 12683 COMMA expr CLOSE_PAREN 12684 12685 return ffestb_V0258_; // to lexer 12686 12687 Make sure the statement has a valid form for the DEFINEFILE statement. If 12688 it does, implement the statement. */ 12689 12690static ffelexHandler 12691ffestb_V0258_ (ffelexToken t) 12692{ 12693 switch (ffelex_token_type (t)) 12694 { 12695 case FFELEX_typeCOMMA: 12696 case FFELEX_typeEOS: 12697 case FFELEX_typeSEMICOLON: 12698 if (!ffestb_local_.V025.started) 12699 { 12700 ffesta_confirmed (); 12701 if (!ffesta_is_inhibited ()) 12702 ffestc_V025_start (); 12703 ffestb_local_.V025.started = TRUE; 12704 } 12705 if (!ffesta_is_inhibited ()) 12706 ffestc_V025_item (ffestb_local_.V025.u, ffesta_tokens[1], 12707 ffestb_local_.V025.m, ffesta_tokens[2], 12708 ffestb_local_.V025.n, ffesta_tokens[3], 12709 ffestb_local_.V025.asv, ffesta_tokens[4]); 12710 ffelex_token_kill (ffesta_tokens[1]); 12711 ffelex_token_kill (ffesta_tokens[2]); 12712 ffelex_token_kill (ffesta_tokens[3]); 12713 ffelex_token_kill (ffesta_tokens[4]); 12714 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 12715 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 12716 FFEEXPR_contextFILEUNIT_DF, (ffeexprCallback) ffestb_V0252_); 12717 if (!ffesta_is_inhibited ()) 12718 ffestc_V025_finish (); 12719 return (ffelexHandler) ffesta_zero (t); 12720 12721 default: 12722 break; 12723 } 12724 12725 ffelex_token_kill (ffesta_tokens[1]); 12726 ffelex_token_kill (ffesta_tokens[2]); 12727 ffelex_token_kill (ffesta_tokens[3]); 12728 ffelex_token_kill (ffesta_tokens[4]); 12729 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t); 12730 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 12731} 12732 12733#endif 12734/* ffestb_subr_kill_easy_ -- Kill I/O statement data structure 12735 12736 ffestb_subr_kill_easy_(); 12737 12738 Kills all tokens in the I/O data structure. Assumes that they are 12739 overlaid with each other (union) in ffest_private.h and the typing 12740 and structure references assume (though not necessarily dangerous if 12741 FALSE) that INQUIRE has the most file elements. */ 12742 12743#if FFESTB_KILL_EASY_ 12744static void 12745ffestb_subr_kill_easy_ (ffestpInquireIx max) 12746{ 12747 ffestpInquireIx ix; 12748 12749 for (ix = 0; ix < max; ++ix) 12750 { 12751 if (ffestp_file.inquire.inquire_spec[ix].kw_or_val_present) 12752 { 12753 if (ffestp_file.inquire.inquire_spec[ix].kw_present) 12754 ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].kw); 12755 if (ffestp_file.inquire.inquire_spec[ix].value_present) 12756 ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].value); 12757 } 12758 } 12759} 12760 12761#endif 12762/* ffestb_subr_kill_accept_ -- Kill ACCEPT statement data structure 12763 12764 ffestb_subr_kill_accept_(); 12765 12766 Kills all tokens in the ACCEPT data structure. */ 12767 12768#if !FFESTB_KILL_EASY_ 12769static void 12770ffestb_subr_kill_accept_ () 12771{ 12772 ffestpAcceptIx ix; 12773 12774 for (ix = 0; ix < FFESTP_acceptix; ++ix) 12775 { 12776 if (ffestp_file.accept.accept_spec[ix].kw_or_val_present) 12777 { 12778 if (ffestp_file.accept.accept_spec[ix].kw_present) 12779 ffelex_token_kill (ffestp_file.accept.accept_spec[ix].kw); 12780 if (ffestp_file.accept.accept_spec[ix].value_present) 12781 ffelex_token_kill (ffestp_file.accept.accept_spec[ix].value); 12782 } 12783 } 12784} 12785 12786#endif 12787/* ffestb_subr_kill_beru_ -- Kill BACKSPACE/ENDFILE/REWIND/UNLOCK statement 12788 data structure 12789 12790 ffestb_subr_kill_beru_(); 12791 12792 Kills all tokens in the BACKSPACE/ENDFILE/REWIND/UNLOCK data structure. */ 12793 12794#if !FFESTB_KILL_EASY_ 12795static void 12796ffestb_subr_kill_beru_ () 12797{ 12798 ffestpBeruIx ix; 12799 12800 for (ix = 0; ix < FFESTP_beruix; ++ix) 12801 { 12802 if (ffestp_file.beru.beru_spec[ix].kw_or_val_present) 12803 { 12804 if (ffestp_file.beru.beru_spec[ix].kw_present) 12805 ffelex_token_kill (ffestp_file.beru.beru_spec[ix].kw); 12806 if (ffestp_file.beru.beru_spec[ix].value_present) 12807 ffelex_token_kill (ffestp_file.beru.beru_spec[ix].value); 12808 } 12809 } 12810} 12811 12812#endif 12813/* ffestb_subr_kill_close_ -- Kill CLOSE statement data structure 12814 12815 ffestb_subr_kill_close_(); 12816 12817 Kills all tokens in the CLOSE data structure. */ 12818 12819#if !FFESTB_KILL_EASY_ 12820static void 12821ffestb_subr_kill_close_ () 12822{ 12823 ffestpCloseIx ix; 12824 12825 for (ix = 0; ix < FFESTP_closeix; ++ix) 12826 { 12827 if (ffestp_file.close.close_spec[ix].kw_or_val_present) 12828 { 12829 if (ffestp_file.close.close_spec[ix].kw_present) 12830 ffelex_token_kill (ffestp_file.close.close_spec[ix].kw); 12831 if (ffestp_file.close.close_spec[ix].value_present) 12832 ffelex_token_kill (ffestp_file.close.close_spec[ix].value); 12833 } 12834 } 12835} 12836 12837#endif 12838/* ffestb_subr_kill_delete_ -- Kill DELETE statement data structure 12839 12840 ffestb_subr_kill_delete_(); 12841 12842 Kills all tokens in the DELETE data structure. */ 12843 12844#if !FFESTB_KILL_EASY_ 12845static void 12846ffestb_subr_kill_delete_ () 12847{ 12848 ffestpDeleteIx ix; 12849 12850 for (ix = 0; ix < FFESTP_deleteix; ++ix) 12851 { 12852 if (ffestp_file.delete.delete_spec[ix].kw_or_val_present) 12853 { 12854 if (ffestp_file.delete.delete_spec[ix].kw_present) 12855 ffelex_token_kill (ffestp_file.delete.delete_spec[ix].kw); 12856 if (ffestp_file.delete.delete_spec[ix].value_present) 12857 ffelex_token_kill (ffestp_file.delete.delete_spec[ix].value); 12858 } 12859 } 12860} 12861 12862#endif 12863/* ffestb_subr_kill_inquire_ -- Kill INQUIRE statement data structure 12864 12865 ffestb_subr_kill_inquire_(); 12866 12867 Kills all tokens in the INQUIRE data structure. */ 12868 12869#if !FFESTB_KILL_EASY_ 12870static void 12871ffestb_subr_kill_inquire_ () 12872{ 12873 ffestpInquireIx ix; 12874 12875 for (ix = 0; ix < FFESTP_inquireix; ++ix) 12876 { 12877 if (ffestp_file.inquire.inquire_spec[ix].kw_or_val_present) 12878 { 12879 if (ffestp_file.inquire.inquire_spec[ix].kw_present) 12880 ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].kw); 12881 if (ffestp_file.inquire.inquire_spec[ix].value_present) 12882 ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].value); 12883 } 12884 } 12885} 12886 12887#endif 12888/* ffestb_subr_kill_open_ -- Kill OPEN statement data structure 12889 12890 ffestb_subr_kill_open_(); 12891 12892 Kills all tokens in the OPEN data structure. */ 12893 12894#if !FFESTB_KILL_EASY_ 12895static void 12896ffestb_subr_kill_open_ () 12897{ 12898 ffestpOpenIx ix; 12899 12900 for (ix = 0; ix < FFESTP_openix; ++ix) 12901 { 12902 if (ffestp_file.open.open_spec[ix].kw_or_val_present) 12903 { 12904 if (ffestp_file.open.open_spec[ix].kw_present) 12905 ffelex_token_kill (ffestp_file.open.open_spec[ix].kw); 12906 if (ffestp_file.open.open_spec[ix].value_present) 12907 ffelex_token_kill (ffestp_file.open.open_spec[ix].value); 12908 } 12909 } 12910} 12911 12912#endif 12913/* ffestb_subr_kill_print_ -- Kill PRINT statement data structure 12914 12915 ffestb_subr_kill_print_(); 12916 12917 Kills all tokens in the PRINT data structure. */ 12918 12919#if !FFESTB_KILL_EASY_ 12920static void 12921ffestb_subr_kill_print_ () 12922{ 12923 ffestpPrintIx ix; 12924 12925 for (ix = 0; ix < FFESTP_printix; ++ix) 12926 { 12927 if (ffestp_file.print.print_spec[ix].kw_or_val_present) 12928 { 12929 if (ffestp_file.print.print_spec[ix].kw_present) 12930 ffelex_token_kill (ffestp_file.print.print_spec[ix].kw); 12931 if (ffestp_file.print.print_spec[ix].value_present) 12932 ffelex_token_kill (ffestp_file.print.print_spec[ix].value); 12933 } 12934 } 12935} 12936 12937#endif 12938/* ffestb_subr_kill_read_ -- Kill READ statement data structure 12939 12940 ffestb_subr_kill_read_(); 12941 12942 Kills all tokens in the READ data structure. */ 12943 12944#if !FFESTB_KILL_EASY_ 12945static void 12946ffestb_subr_kill_read_ () 12947{ 12948 ffestpReadIx ix; 12949 12950 for (ix = 0; ix < FFESTP_readix; ++ix) 12951 { 12952 if (ffestp_file.read.read_spec[ix].kw_or_val_present) 12953 { 12954 if (ffestp_file.read.read_spec[ix].kw_present) 12955 ffelex_token_kill (ffestp_file.read.read_spec[ix].kw); 12956 if (ffestp_file.read.read_spec[ix].value_present) 12957 ffelex_token_kill (ffestp_file.read.read_spec[ix].value); 12958 } 12959 } 12960} 12961 12962#endif 12963/* ffestb_subr_kill_rewrite_ -- Kill REWRITE statement data structure 12964 12965 ffestb_subr_kill_rewrite_(); 12966 12967 Kills all tokens in the REWRITE data structure. */ 12968 12969#if !FFESTB_KILL_EASY_ 12970static void 12971ffestb_subr_kill_rewrite_ () 12972{ 12973 ffestpRewriteIx ix; 12974 12975 for (ix = 0; ix < FFESTP_rewriteix; ++ix) 12976 { 12977 if (ffestp_file.rewrite.rewrite_spec[ix].kw_or_val_present) 12978 { 12979 if (ffestp_file.rewrite.rewrite_spec[ix].kw_present) 12980 ffelex_token_kill (ffestp_file.rewrite.rewrite_spec[ix].kw); 12981 if (ffestp_file.rewrite.rewrite_spec[ix].value_present) 12982 ffelex_token_kill (ffestp_file.rewrite.rewrite_spec[ix].value); 12983 } 12984 } 12985} 12986 12987#endif 12988/* ffestb_subr_kill_type_ -- Kill TYPE statement data structure 12989 12990 ffestb_subr_kill_type_(); 12991 12992 Kills all tokens in the TYPE data structure. */ 12993 12994#if !FFESTB_KILL_EASY_ 12995static void 12996ffestb_subr_kill_type_ () 12997{ 12998 ffestpTypeIx ix; 12999 13000 for (ix = 0; ix < FFESTP_typeix; ++ix) 13001 { 13002 if (ffestp_file.type.type_spec[ix].kw_or_val_present) 13003 { 13004 if (ffestp_file.type.type_spec[ix].kw_present) 13005 ffelex_token_kill (ffestp_file.type.type_spec[ix].kw); 13006 if (ffestp_file.type.type_spec[ix].value_present) 13007 ffelex_token_kill (ffestp_file.type.type_spec[ix].value); 13008 } 13009 } 13010} 13011 13012#endif 13013/* ffestb_subr_kill_write_ -- Kill WRITE statement data structure 13014 13015 ffestb_subr_kill_write_(); 13016 13017 Kills all tokens in the WRITE data structure. */ 13018 13019#if !FFESTB_KILL_EASY_ 13020static void 13021ffestb_subr_kill_write_ () 13022{ 13023 ffestpWriteIx ix; 13024 13025 for (ix = 0; ix < FFESTP_writeix; ++ix) 13026 { 13027 if (ffestp_file.write.write_spec[ix].kw_or_val_present) 13028 { 13029 if (ffestp_file.write.write_spec[ix].kw_present) 13030 ffelex_token_kill (ffestp_file.write.write_spec[ix].kw); 13031 if (ffestp_file.write.write_spec[ix].value_present) 13032 ffelex_token_kill (ffestp_file.write.write_spec[ix].value); 13033 } 13034 } 13035} 13036 13037#endif 13038/* ffestb_beru -- Parse the BACKSPACE/ENDFILE/REWIND/UNLOCK statement 13039 13040 return ffestb_beru; // to lexer 13041 13042 Make sure the statement has a valid form for the BACKSPACE/ENDFILE/REWIND/ 13043 UNLOCK statement. If it does, implement the statement. */ 13044 13045ffelexHandler 13046ffestb_beru (ffelexToken t) 13047{ 13048 ffelexHandler next; 13049 ffestpBeruIx ix; 13050 13051 switch (ffelex_token_type (ffesta_tokens[0])) 13052 { 13053 case FFELEX_typeNAME: 13054 switch (ffelex_token_type (t)) 13055 { 13056 case FFELEX_typeCOMMA: 13057 case FFELEX_typeCOLONCOLON: 13058 case FFELEX_typeEOS: 13059 case FFELEX_typeSEMICOLON: 13060 ffesta_confirmed (); /* Error, but clearly intended. */ 13061 goto bad_1; /* :::::::::::::::::::: */ 13062 13063 case FFELEX_typeEQUALS: 13064 case FFELEX_typePOINTS: 13065 case FFELEX_typeCOLON: 13066 goto bad_1; /* :::::::::::::::::::: */ 13067 13068 case FFELEX_typeNAME: 13069 case FFELEX_typeNUMBER: 13070 ffesta_confirmed (); 13071 break; 13072 13073 case FFELEX_typeOPEN_PAREN: 13074 for (ix = 0; ix < FFESTP_beruix; ++ix) 13075 ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE; 13076 ffesta_tokens[1] = ffelex_token_use (t); 13077 return (ffelexHandler) ffestb_beru2_; 13078 13079 default: 13080 break; 13081 } 13082 13083 for (ix = 0; ix < FFESTP_beruix; ++ix) 13084 ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE; 13085 return (ffelexHandler) (*((ffelexHandler) 13086 ffeexpr_rhs (ffesta_output_pool, 13087 FFEEXPR_contextFILENUM, 13088 (ffeexprCallback) ffestb_beru1_))) 13089 (t); 13090 13091 case FFELEX_typeNAMES: 13092 switch (ffelex_token_type (t)) 13093 { 13094 case FFELEX_typeCOMMA: 13095 case FFELEX_typeCOLONCOLON: 13096 ffesta_confirmed (); /* Error, but clearly intended. */ 13097 goto bad_1; /* :::::::::::::::::::: */ 13098 13099 case FFELEX_typeEQUALS: 13100 case FFELEX_typePOINTS: 13101 case FFELEX_typeCOLON: 13102 goto bad_1; /* :::::::::::::::::::: */ 13103 13104 case FFELEX_typeEOS: 13105 case FFELEX_typeSEMICOLON: 13106 ffesta_confirmed (); 13107 break; 13108 13109 case FFELEX_typeOPEN_PAREN: 13110 if (ffelex_token_length (ffesta_tokens[0]) 13111 != ffestb_args.beru.len) 13112 break; 13113 13114 for (ix = 0; ix < FFESTP_beruix; ++ix) 13115 ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE; 13116 ffesta_tokens[1] = ffelex_token_use (t); 13117 return (ffelexHandler) ffestb_beru2_; 13118 13119 default: 13120 break; 13121 } 13122 for (ix = 0; ix < FFESTP_beruix; ++ix) 13123 ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE; 13124 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 13125 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_beru1_); 13126 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0], 13127 ffestb_args.beru.len); 13128 if (next == NULL) 13129 return (ffelexHandler) ffelex_swallow_tokens (t, 13130 (ffelexHandler) ffesta_zero); 13131 return (ffelexHandler) (*next) (t); 13132 13133 default: 13134 goto bad_0; /* :::::::::::::::::::: */ 13135 } 13136 13137bad_0: /* :::::::::::::::::::: */ 13138 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, ffesta_tokens[0]); 13139 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 13140 13141bad_1: /* :::::::::::::::::::: */ 13142 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t); 13143 return (ffelexHandler) ffelex_swallow_tokens (t, 13144 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 13145} 13146 13147/* ffestb_beru1_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" expr 13148 13149 (ffestb_beru1_) // to expression handler 13150 13151 Make sure the next token is an EOS or SEMICOLON. */ 13152 13153static ffelexHandler 13154ffestb_beru1_ (ffelexToken ft, ffebld expr, ffelexToken t) 13155{ 13156 switch (ffelex_token_type (t)) 13157 { 13158 case FFELEX_typeEOS: 13159 case FFELEX_typeSEMICOLON: 13160 if (expr == NULL) 13161 break; 13162 ffesta_confirmed (); 13163 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_or_val_present 13164 = TRUE; 13165 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_present = FALSE; 13166 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_present = TRUE; 13167 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_is_label 13168 = FALSE; 13169 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value 13170 = ffelex_token_use (ft); 13171 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].u.expr = expr; 13172 if (!ffesta_is_inhibited ()) 13173 { 13174 switch (ffesta_first_kw) 13175 { 13176 case FFESTR_firstBACKSPACE: 13177 ffestc_R919 (); 13178 break; 13179 13180 case FFESTR_firstENDFILE: 13181 case FFESTR_firstEND: 13182 ffestc_R920 (); 13183 break; 13184 13185 case FFESTR_firstREWIND: 13186 ffestc_R921 (); 13187 break; 13188 13189#if FFESTR_VXT 13190 case FFESTR_firstUNLOCK: 13191 ffestc_V022 (); 13192 break; 13193#endif 13194 13195 default: 13196 assert (FALSE); 13197 } 13198 } 13199 ffestb_subr_kill_beru_ (); 13200 return (ffelexHandler) ffesta_zero (t); 13201 13202 default: 13203 break; 13204 } 13205 13206 ffestb_subr_kill_beru_ (); 13207 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t); 13208 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 13209} 13210 13211/* ffestb_beru2_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN 13212 13213 return ffestb_beru2_; // to lexer 13214 13215 Handle expr construct (not NAME=expr construct) here. */ 13216 13217static ffelexHandler 13218ffestb_beru2_ (ffelexToken t) 13219{ 13220 ffelexToken nt; 13221 ffelexHandler next; 13222 13223 switch (ffelex_token_type (t)) 13224 { 13225 case FFELEX_typeNAME: 13226 ffesta_tokens[2] = ffelex_token_use (t); 13227 return (ffelexHandler) ffestb_beru3_; 13228 13229 default: 13230 nt = ffesta_tokens[1]; 13231 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 13232 FFEEXPR_contextFILENUMAMBIG, (ffeexprCallback) ffestb_beru4_))) 13233 (nt); 13234 ffelex_token_kill (nt); 13235 return (ffelexHandler) (*next) (t); 13236 } 13237} 13238 13239/* ffestb_beru3_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN NAME 13240 13241 return ffestb_beru3_; // to lexer 13242 13243 If EQUALS here, go to states that handle it. Else, send NAME and this 13244 token thru expression handler. */ 13245 13246static ffelexHandler 13247ffestb_beru3_ (ffelexToken t) 13248{ 13249 ffelexHandler next; 13250 ffelexToken nt; 13251 ffelexToken ot; 13252 13253 switch (ffelex_token_type (t)) 13254 { 13255 case FFELEX_typeEQUALS: 13256 ffelex_token_kill (ffesta_tokens[1]); 13257 nt = ffesta_tokens[2]; 13258 next = (ffelexHandler) ffestb_beru5_ (nt); 13259 ffelex_token_kill (nt); 13260 return (ffelexHandler) (*next) (t); 13261 13262 default: 13263 nt = ffesta_tokens[1]; 13264 ot = ffesta_tokens[2]; 13265 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 13266 FFEEXPR_contextFILENUMAMBIG, (ffeexprCallback) ffestb_beru4_))) 13267 (nt); 13268 ffelex_token_kill (nt); 13269 next = (ffelexHandler) (*next) (ot); 13270 ffelex_token_kill (ot); 13271 return (ffelexHandler) (*next) (t); 13272 } 13273} 13274 13275/* ffestb_beru4_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN expr [CLOSE_PAREN] 13276 13277 (ffestb_beru4_) // to expression handler 13278 13279 Handle COMMA or EOS/SEMICOLON here. 13280 13281 15-Feb-91 JCB 1.2 13282 Now using new mechanism whereby expr comes back as opITEM if the 13283 expr is considered part (or all) of an I/O control list (and should 13284 be stripped of its outer opITEM node) or not if it is considered 13285 a plain unit number that happens to have been enclosed in parens. 13286 26-Mar-90 JCB 1.1 13287 No longer expecting close-paren here because of constructs like 13288 BACKSPACE (5)+2, so now expecting either COMMA because it was a 13289 construct like BACKSPACE (5+2,... or EOS/SEMICOLON because it is like 13290 the former construct. Ah, the vagaries of Fortran. */ 13291 13292static ffelexHandler 13293ffestb_beru4_ (ffelexToken ft, ffebld expr, ffelexToken t) 13294{ 13295 bool inlist; 13296 13297 switch (ffelex_token_type (t)) 13298 { 13299 case FFELEX_typeCOMMA: 13300 case FFELEX_typeEOS: 13301 case FFELEX_typeSEMICOLON: 13302 case FFELEX_typeCLOSE_PAREN: 13303 if (expr == NULL) 13304 break; 13305 if (ffebld_op (expr) == FFEBLD_opITEM) 13306 { 13307 inlist = TRUE; 13308 expr = ffebld_head (expr); 13309 } 13310 else 13311 inlist = FALSE; 13312 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_or_val_present 13313 = TRUE; 13314 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_present = FALSE; 13315 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_present = TRUE; 13316 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_is_label 13317 = FALSE; 13318 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value 13319 = ffelex_token_use (ft); 13320 ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].u.expr = expr; 13321 if (inlist) 13322 return (ffelexHandler) ffestb_beru9_ (t); 13323 return (ffelexHandler) ffestb_beru10_ (t); 13324 13325 default: 13326 break; 13327 } 13328 13329 ffestb_subr_kill_beru_ (); 13330 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t); 13331 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 13332} 13333 13334/* ffestb_beru5_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN [external-file-unit 13335 COMMA] 13336 13337 return ffestb_beru5_; // to lexer 13338 13339 Handle expr construct (not NAME=expr construct) here. */ 13340 13341static ffelexHandler 13342ffestb_beru5_ (ffelexToken t) 13343{ 13344 ffestrGenio kw; 13345 13346 ffestb_local_.beru.label = FALSE; 13347 13348 switch (ffelex_token_type (t)) 13349 { 13350 case FFELEX_typeNAME: 13351 kw = ffestr_genio (t); 13352 switch (kw) 13353 { 13354 case FFESTR_genioERR: 13355 ffestb_local_.beru.ix = FFESTP_beruixERR; 13356 ffestb_local_.beru.label = TRUE; 13357 break; 13358 13359 case FFESTR_genioIOSTAT: 13360 ffestb_local_.beru.ix = FFESTP_beruixIOSTAT; 13361 ffestb_local_.beru.left = TRUE; 13362 ffestb_local_.beru.context = FFEEXPR_contextFILEINT; 13363 break; 13364 13365 case FFESTR_genioUNIT: 13366 ffestb_local_.beru.ix = FFESTP_beruixUNIT; 13367 ffestb_local_.beru.left = FALSE; 13368 ffestb_local_.beru.context = FFEEXPR_contextFILENUM; 13369 break; 13370 13371 default: 13372 goto bad; /* :::::::::::::::::::: */ 13373 } 13374 if (ffestp_file.beru.beru_spec[ffestb_local_.beru.ix] 13375 .kw_or_val_present) 13376 break; /* Can't specify a keyword twice! */ 13377 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix] 13378 .kw_or_val_present = TRUE; 13379 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix] 13380 .kw_present = TRUE; 13381 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix] 13382 .value_present = FALSE; 13383 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value_is_label 13384 = ffestb_local_.beru.label; 13385 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].kw 13386 = ffelex_token_use (t); 13387 return (ffelexHandler) ffestb_beru6_; 13388 13389 default: 13390 break; 13391 } 13392 13393bad: /* :::::::::::::::::::: */ 13394 ffestb_subr_kill_beru_ (); 13395 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t); 13396 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 13397} 13398 13399/* ffestb_beru6_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN [external-file-unit 13400 COMMA] NAME 13401 13402 return ffestb_beru6_; // to lexer 13403 13404 Make sure EQUALS here, send next token to expression handler. */ 13405 13406static ffelexHandler 13407ffestb_beru6_ (ffelexToken t) 13408{ 13409 13410 switch (ffelex_token_type (t)) 13411 { 13412 case FFELEX_typeEQUALS: 13413 ffesta_confirmed (); 13414 if (ffestb_local_.beru.label) 13415 return (ffelexHandler) ffestb_beru8_; 13416 if (ffestb_local_.beru.left) 13417 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 13418 ffestb_local_.beru.context, 13419 (ffeexprCallback) ffestb_beru7_); 13420 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 13421 ffestb_local_.beru.context, 13422 (ffeexprCallback) ffestb_beru7_); 13423 13424 default: 13425 break; 13426 } 13427 13428 ffestb_subr_kill_beru_ (); 13429 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t); 13430 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 13431} 13432 13433/* ffestb_beru7_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... NAME EQUALS expr 13434 13435 (ffestb_beru7_) // to expression handler 13436 13437 Handle COMMA or CLOSE_PAREN here. */ 13438 13439static ffelexHandler 13440ffestb_beru7_ (ffelexToken ft, ffebld expr, ffelexToken t) 13441{ 13442 switch (ffelex_token_type (t)) 13443 { 13444 case FFELEX_typeCOMMA: 13445 case FFELEX_typeCLOSE_PAREN: 13446 if (expr == NULL) 13447 break; 13448 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value_present 13449 = TRUE; 13450 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value 13451 = ffelex_token_use (ft); 13452 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].u.expr = expr; 13453 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 13454 return (ffelexHandler) ffestb_beru5_; 13455 return (ffelexHandler) ffestb_beru10_; 13456 13457 default: 13458 break; 13459 } 13460 13461 ffestb_subr_kill_beru_ (); 13462 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t); 13463 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 13464} 13465 13466/* ffestb_beru8_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... NAME EQUALS 13467 13468 return ffestb_beru8_; // to lexer 13469 13470 Handle NUMBER for label here. */ 13471 13472static ffelexHandler 13473ffestb_beru8_ (ffelexToken t) 13474{ 13475 switch (ffelex_token_type (t)) 13476 { 13477 case FFELEX_typeNUMBER: 13478 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value_present 13479 = TRUE; 13480 ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value 13481 = ffelex_token_use (t); 13482 return (ffelexHandler) ffestb_beru9_; 13483 13484 default: 13485 break; 13486 } 13487 13488 ffestb_subr_kill_beru_ (); 13489 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t); 13490 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 13491} 13492 13493/* ffestb_beru9_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... NAME EQUALS 13494 NUMBER 13495 13496 return ffestb_beru9_; // to lexer 13497 13498 Handle COMMA or CLOSE_PAREN here. */ 13499 13500static ffelexHandler 13501ffestb_beru9_ (ffelexToken t) 13502{ 13503 switch (ffelex_token_type (t)) 13504 { 13505 case FFELEX_typeCOMMA: 13506 return (ffelexHandler) ffestb_beru5_; 13507 13508 case FFELEX_typeCLOSE_PAREN: 13509 return (ffelexHandler) ffestb_beru10_; 13510 13511 default: 13512 break; 13513 } 13514 13515 ffestb_subr_kill_beru_ (); 13516 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t); 13517 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 13518} 13519 13520/* ffestb_beru10_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... CLOSE_PAREN 13521 13522 return ffestb_beru10_; // to lexer 13523 13524 Handle EOS or SEMICOLON here. */ 13525 13526static ffelexHandler 13527ffestb_beru10_ (ffelexToken t) 13528{ 13529 switch (ffelex_token_type (t)) 13530 { 13531 case FFELEX_typeEOS: 13532 case FFELEX_typeSEMICOLON: 13533 ffesta_confirmed (); 13534 if (!ffesta_is_inhibited ()) 13535 { 13536 switch (ffesta_first_kw) 13537 { 13538 case FFESTR_firstBACKSPACE: 13539 ffestc_R919 (); 13540 break; 13541 13542 case FFESTR_firstENDFILE: 13543 case FFESTR_firstEND: 13544 ffestc_R920 (); 13545 break; 13546 13547 case FFESTR_firstREWIND: 13548 ffestc_R921 (); 13549 break; 13550 13551#if FFESTR_VXT 13552 case FFESTR_firstUNLOCK: 13553 ffestc_V022 (); 13554 break; 13555#endif 13556 13557 default: 13558 assert (FALSE); 13559 } 13560 } 13561 ffestb_subr_kill_beru_ (); 13562 return (ffelexHandler) ffesta_zero (t); 13563 13564 default: 13565 break; 13566 } 13567 13568 ffestb_subr_kill_beru_ (); 13569 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t); 13570 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 13571} 13572 13573/* ffestb_vxtcode -- Parse the VXT DECODE/ENCODE statement 13574 13575 return ffestb_vxtcode; // to lexer 13576 13577 Make sure the statement has a valid form for the VXT DECODE/ENCODE 13578 statement. If it does, implement the statement. */ 13579 13580#if FFESTR_VXT 13581ffelexHandler 13582ffestb_vxtcode (ffelexToken t) 13583{ 13584 ffestpVxtcodeIx ix; 13585 13586 switch (ffelex_token_type (ffesta_tokens[0])) 13587 { 13588 case FFELEX_typeNAME: 13589 switch (ffelex_token_type (t)) 13590 { 13591 case FFELEX_typeCOMMA: 13592 case FFELEX_typeCOLONCOLON: 13593 case FFELEX_typeEOS: 13594 case FFELEX_typeSEMICOLON: 13595 case FFELEX_typeNAME: 13596 case FFELEX_typeNUMBER: 13597 ffesta_confirmed (); /* Error, but clearly intended. */ 13598 goto bad_1; /* :::::::::::::::::::: */ 13599 13600 default: 13601 goto bad_1; /* :::::::::::::::::::: */ 13602 13603 case FFELEX_typeOPEN_PAREN: 13604 for (ix = 0; ix < FFESTP_vxtcodeix; ++ix) 13605 ffestp_file.vxtcode.vxtcode_spec[ix].kw_or_val_present = FALSE; 13606 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 13607 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_vxtcode1_); 13608 } 13609 13610 case FFELEX_typeNAMES: 13611 switch (ffelex_token_type (t)) 13612 { 13613 case FFELEX_typeEOS: 13614 case FFELEX_typeSEMICOLON: 13615 case FFELEX_typeCOMMA: 13616 case FFELEX_typeCOLONCOLON: 13617 ffesta_confirmed (); /* Error, but clearly intended. */ 13618 goto bad_1; /* :::::::::::::::::::: */ 13619 13620 default: 13621 goto bad_1; /* :::::::::::::::::::: */ 13622 13623 case FFELEX_typeOPEN_PAREN: 13624 if (ffelex_token_length (ffesta_tokens[0]) 13625 != ffestb_args.vxtcode.len) 13626 goto bad_0; /* :::::::::::::::::::: */ 13627 13628 for (ix = 0; ix < FFESTP_vxtcodeix; ++ix) 13629 ffestp_file.vxtcode.vxtcode_spec[ix].kw_or_val_present = FALSE; 13630 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 13631 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_vxtcode1_); 13632 } 13633 13634 default: 13635 goto bad_0; /* :::::::::::::::::::: */ 13636 } 13637 13638bad_0: /* :::::::::::::::::::: */ 13639 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, ffesta_tokens[0]); 13640 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 13641 13642bad_1: /* :::::::::::::::::::: */ 13643 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t); 13644 return (ffelexHandler) ffelex_swallow_tokens (t, 13645 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 13646} 13647 13648/* ffestb_vxtcode1_ -- "VXTCODE" OPEN_PAREN expr 13649 13650 (ffestb_vxtcode1_) // to expression handler 13651 13652 Handle COMMA here. */ 13653 13654static ffelexHandler 13655ffestb_vxtcode1_ (ffelexToken ft, ffebld expr, ffelexToken t) 13656{ 13657 switch (ffelex_token_type (t)) 13658 { 13659 case FFELEX_typeCOMMA: 13660 if (expr == NULL) 13661 break; 13662 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].kw_or_val_present 13663 = TRUE; 13664 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].kw_present = FALSE; 13665 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].value_present = TRUE; 13666 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].value_is_label 13667 = FALSE; 13668 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].value 13669 = ffelex_token_use (ft); 13670 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].u.expr = expr; 13671 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 13672 FFEEXPR_contextFILEFORMAT, (ffeexprCallback) ffestb_vxtcode2_); 13673 13674 default: 13675 break; 13676 } 13677 13678 ffestb_subr_kill_vxtcode_ (); 13679 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t); 13680 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 13681} 13682 13683/* ffestb_vxtcode2_ -- "VXTCODE" OPEN_PAREN expr COMMA expr 13684 13685 (ffestb_vxtcode2_) // to expression handler 13686 13687 Handle COMMA here. */ 13688 13689static ffelexHandler 13690ffestb_vxtcode2_ (ffelexToken ft, ffebld expr, ffelexToken t) 13691{ 13692 switch (ffelex_token_type (t)) 13693 { 13694 case FFELEX_typeCOMMA: 13695 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].kw_or_val_present 13696 = TRUE; 13697 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].kw_present = FALSE; 13698 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].value_present = TRUE; 13699 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].value_is_label 13700 = (expr == NULL); 13701 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].value 13702 = ffelex_token_use (ft); 13703 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].u.expr = expr; 13704 if (ffesta_first_kw == FFESTR_firstENCODE) 13705 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 13706 FFEEXPR_contextFILEVXTCODE, 13707 (ffeexprCallback) ffestb_vxtcode3_); 13708 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 13709 FFEEXPR_contextFILEVXTCODE, 13710 (ffeexprCallback) ffestb_vxtcode3_); 13711 13712 default: 13713 break; 13714 } 13715 13716 ffestb_subr_kill_vxtcode_ (); 13717 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t); 13718 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 13719} 13720 13721/* ffestb_vxtcode3_ -- "VXTCODE" OPEN_PAREN expr COMMA expr COMMA expr 13722 13723 (ffestb_vxtcode3_) // to expression handler 13724 13725 Handle COMMA or CLOSE_PAREN here. */ 13726 13727static ffelexHandler 13728ffestb_vxtcode3_ (ffelexToken ft, ffebld expr, ffelexToken t) 13729{ 13730 switch (ffelex_token_type (t)) 13731 { 13732 case FFELEX_typeCOMMA: 13733 case FFELEX_typeCLOSE_PAREN: 13734 if (expr == NULL) 13735 break; 13736 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].kw_or_val_present 13737 = TRUE; 13738 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].kw_present = FALSE; 13739 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].value_present = TRUE; 13740 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].value_is_label 13741 = FALSE; 13742 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].value 13743 = ffelex_token_use (ft); 13744 ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].u.expr = expr; 13745 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 13746 return (ffelexHandler) ffestb_vxtcode4_; 13747 return (ffelexHandler) ffestb_vxtcode9_; 13748 13749 default: 13750 break; 13751 } 13752 13753 ffestb_subr_kill_vxtcode_ (); 13754 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t); 13755 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 13756} 13757 13758/* ffestb_vxtcode4_ -- "VXTCODE" OPEN_PAREN ... 13759 13760 return ffestb_vxtcode4_; // to lexer 13761 13762 Handle NAME=expr construct here. */ 13763 13764static ffelexHandler 13765ffestb_vxtcode4_ (ffelexToken t) 13766{ 13767 ffestrGenio kw; 13768 13769 ffestb_local_.vxtcode.label = FALSE; 13770 13771 switch (ffelex_token_type (t)) 13772 { 13773 case FFELEX_typeNAME: 13774 kw = ffestr_genio (t); 13775 switch (kw) 13776 { 13777 case FFESTR_genioERR: 13778 ffestb_local_.vxtcode.ix = FFESTP_vxtcodeixERR; 13779 ffestb_local_.vxtcode.label = TRUE; 13780 break; 13781 13782 case FFESTR_genioIOSTAT: 13783 ffestb_local_.vxtcode.ix = FFESTP_vxtcodeixIOSTAT; 13784 ffestb_local_.vxtcode.left = TRUE; 13785 ffestb_local_.vxtcode.context = FFEEXPR_contextFILEINT; 13786 break; 13787 13788 default: 13789 goto bad; /* :::::::::::::::::::: */ 13790 } 13791 if (ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix] 13792 .kw_or_val_present) 13793 break; /* Can't specify a keyword twice! */ 13794 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix] 13795 .kw_or_val_present = TRUE; 13796 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix] 13797 .kw_present = TRUE; 13798 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix] 13799 .value_present = FALSE; 13800 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value_is_label 13801 = ffestb_local_.vxtcode.label; 13802 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].kw 13803 = ffelex_token_use (t); 13804 return (ffelexHandler) ffestb_vxtcode5_; 13805 13806 default: 13807 break; 13808 } 13809 13810bad: /* :::::::::::::::::::: */ 13811 ffestb_subr_kill_vxtcode_ (); 13812 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t); 13813 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 13814} 13815 13816/* ffestb_vxtcode5_ -- "VXTCODE" OPEN_PAREN [external-file-unit COMMA [format 13817 COMMA]] NAME 13818 13819 return ffestb_vxtcode5_; // to lexer 13820 13821 Make sure EQUALS here, send next token to expression handler. */ 13822 13823static ffelexHandler 13824ffestb_vxtcode5_ (ffelexToken t) 13825{ 13826 switch (ffelex_token_type (t)) 13827 { 13828 case FFELEX_typeEQUALS: 13829 ffesta_confirmed (); 13830 if (ffestb_local_.vxtcode.label) 13831 return (ffelexHandler) ffestb_vxtcode7_; 13832 if (ffestb_local_.vxtcode.left) 13833 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 13834 ffestb_local_.vxtcode.context, 13835 (ffeexprCallback) ffestb_vxtcode6_); 13836 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 13837 ffestb_local_.vxtcode.context, 13838 (ffeexprCallback) ffestb_vxtcode6_); 13839 13840 default: 13841 break; 13842 } 13843 13844 ffestb_subr_kill_vxtcode_ (); 13845 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t); 13846 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 13847} 13848 13849/* ffestb_vxtcode6_ -- "VXTCODE" OPEN_PAREN ... NAME EQUALS expr 13850 13851 (ffestb_vxtcode6_) // to expression handler 13852 13853 Handle COMMA or CLOSE_PAREN here. */ 13854 13855static ffelexHandler 13856ffestb_vxtcode6_ (ffelexToken ft, ffebld expr, ffelexToken t) 13857{ 13858 switch (ffelex_token_type (t)) 13859 { 13860 case FFELEX_typeCOMMA: 13861 case FFELEX_typeCLOSE_PAREN: 13862 if (expr == NULL) 13863 break; 13864 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value_present 13865 = TRUE; 13866 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value 13867 = ffelex_token_use (ft); 13868 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].u.expr = expr; 13869 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 13870 return (ffelexHandler) ffestb_vxtcode4_; 13871 return (ffelexHandler) ffestb_vxtcode9_; 13872 13873 default: 13874 break; 13875 } 13876 13877 ffestb_subr_kill_vxtcode_ (); 13878 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t); 13879 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 13880} 13881 13882/* ffestb_vxtcode7_ -- "VXTCODE" OPEN_PAREN ... NAME EQUALS 13883 13884 return ffestb_vxtcode7_; // to lexer 13885 13886 Handle NUMBER for label here. */ 13887 13888static ffelexHandler 13889ffestb_vxtcode7_ (ffelexToken t) 13890{ 13891 switch (ffelex_token_type (t)) 13892 { 13893 case FFELEX_typeNUMBER: 13894 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value_present 13895 = TRUE; 13896 ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value 13897 = ffelex_token_use (t); 13898 return (ffelexHandler) ffestb_vxtcode8_; 13899 13900 default: 13901 break; 13902 } 13903 13904 ffestb_subr_kill_vxtcode_ (); 13905 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t); 13906 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 13907} 13908 13909/* ffestb_vxtcode8_ -- "VXTCODE" OPEN_PAREN ... NAME EQUALS NUMBER 13910 13911 return ffestb_vxtcode8_; // to lexer 13912 13913 Handle COMMA or CLOSE_PAREN here. */ 13914 13915static ffelexHandler 13916ffestb_vxtcode8_ (ffelexToken t) 13917{ 13918 switch (ffelex_token_type (t)) 13919 { 13920 case FFELEX_typeCOMMA: 13921 return (ffelexHandler) ffestb_vxtcode4_; 13922 13923 case FFELEX_typeCLOSE_PAREN: 13924 return (ffelexHandler) ffestb_vxtcode9_; 13925 13926 default: 13927 break; 13928 } 13929 13930 ffestb_subr_kill_vxtcode_ (); 13931 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t); 13932 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 13933} 13934 13935/* ffestb_vxtcode9_ -- "VXTCODE" OPEN_PAREN ... CLOSE_PAREN 13936 13937 return ffestb_vxtcode9_; // to lexer 13938 13939 Handle EOS or SEMICOLON here. 13940 13941 07-Jun-90 JCB 1.1 13942 Context for ENCODE/DECODE expressions is now IOLISTDF instead of IOLIST 13943 since they apply to internal files. */ 13944 13945static ffelexHandler 13946ffestb_vxtcode9_ (ffelexToken t) 13947{ 13948 ffelexHandler next; 13949 13950 switch (ffelex_token_type (t)) 13951 { 13952 case FFELEX_typeEOS: 13953 case FFELEX_typeSEMICOLON: 13954 ffesta_confirmed (); 13955 if (!ffesta_is_inhibited ()) 13956 { 13957 if (ffesta_first_kw == FFESTR_firstENCODE) 13958 { 13959 ffestc_V023_start (); 13960 ffestc_V023_finish (); 13961 } 13962 else 13963 { 13964 ffestc_V024_start (); 13965 ffestc_V024_finish (); 13966 } 13967 } 13968 ffestb_subr_kill_vxtcode_ (); 13969 return (ffelexHandler) ffesta_zero (t); 13970 13971 case FFELEX_typeNAME: 13972 case FFELEX_typeOPEN_PAREN: 13973 case FFELEX_typeCOMMA: 13974 ffesta_confirmed (); 13975 if (!ffesta_is_inhibited ()) 13976 if (ffesta_first_kw == FFESTR_firstENCODE) 13977 ffestc_V023_start (); 13978 else 13979 ffestc_V024_start (); 13980 ffestb_subr_kill_vxtcode_ (); 13981 if (ffesta_first_kw == FFESTR_firstDECODE) 13982 next = (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 13983 FFEEXPR_contextIOLISTDF, 13984 (ffeexprCallback) ffestb_vxtcode10_); 13985 else 13986 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 13987 FFEEXPR_contextIOLISTDF, 13988 (ffeexprCallback) ffestb_vxtcode10_); 13989 13990 /* EXTENSION: Allow an optional preceding COMMA here if not pedantic. 13991 (f2c provides this extension, as do other compilers, supposedly.) */ 13992 13993 if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA)) 13994 return next; 13995 13996 return (ffelexHandler) (*next) (t); 13997 13998 default: 13999 break; 14000 } 14001 14002 ffestb_subr_kill_vxtcode_ (); 14003 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t); 14004 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 14005} 14006 14007/* ffestb_vxtcode10_ -- "VXTCODE(...)" expr 14008 14009 (ffestb_vxtcode10_) // to expression handler 14010 14011 Handle COMMA or EOS/SEMICOLON here. 14012 14013 07-Jun-90 JCB 1.1 14014 Context for ENCODE/DECODE expressions is now IOLISTDF instead of IOLIST 14015 since they apply to internal files. */ 14016 14017static ffelexHandler 14018ffestb_vxtcode10_ (ffelexToken ft, ffebld expr, ffelexToken t) 14019{ 14020 switch (ffelex_token_type (t)) 14021 { 14022 case FFELEX_typeCOMMA: 14023 if (expr == NULL) 14024 break; 14025 if (!ffesta_is_inhibited ()) 14026 if (ffesta_first_kw == FFESTR_firstENCODE) 14027 ffestc_V023_item (expr, ft); 14028 else 14029 ffestc_V024_item (expr, ft); 14030 if (ffesta_first_kw == FFESTR_firstDECODE) 14031 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 14032 FFEEXPR_contextIOLISTDF, 14033 (ffeexprCallback) ffestb_vxtcode10_); 14034 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 14035 FFEEXPR_contextIOLISTDF, 14036 (ffeexprCallback) ffestb_vxtcode10_); 14037 14038 case FFELEX_typeEOS: 14039 case FFELEX_typeSEMICOLON: 14040 if (expr == NULL) 14041 break; 14042 if (!ffesta_is_inhibited ()) 14043 { 14044 if (ffesta_first_kw == FFESTR_firstENCODE) 14045 { 14046 ffestc_V023_item (expr, ft); 14047 ffestc_V023_finish (); 14048 } 14049 else 14050 { 14051 ffestc_V024_item (expr, ft); 14052 ffestc_V024_finish (); 14053 } 14054 } 14055 return (ffelexHandler) ffesta_zero (t); 14056 14057 default: 14058 break; 14059 } 14060 14061 if (!ffesta_is_inhibited ()) 14062 if (ffesta_first_kw == FFESTR_firstENCODE) 14063 ffestc_V023_finish (); 14064 else 14065 ffestc_V024_finish (); 14066 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t); 14067 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 14068} 14069 14070#endif 14071/* ffestb_R904 -- Parse an OPEN statement 14072 14073 return ffestb_R904; // to lexer 14074 14075 Make sure the statement has a valid form for an OPEN statement. 14076 If it does, implement the statement. */ 14077 14078ffelexHandler 14079ffestb_R904 (ffelexToken t) 14080{ 14081 ffestpOpenIx ix; 14082 14083 switch (ffelex_token_type (ffesta_tokens[0])) 14084 { 14085 case FFELEX_typeNAME: 14086 if (ffesta_first_kw != FFESTR_firstOPEN) 14087 goto bad_0; /* :::::::::::::::::::: */ 14088 break; 14089 14090 case FFELEX_typeNAMES: 14091 if (ffesta_first_kw != FFESTR_firstOPEN) 14092 goto bad_0; /* :::::::::::::::::::: */ 14093 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlOPEN) 14094 goto bad_0; /* :::::::::::::::::::: */ 14095 break; 14096 14097 default: 14098 goto bad_0; /* :::::::::::::::::::: */ 14099 } 14100 14101 switch (ffelex_token_type (t)) 14102 { 14103 case FFELEX_typeOPEN_PAREN: 14104 break; 14105 14106 case FFELEX_typeEOS: 14107 case FFELEX_typeSEMICOLON: 14108 case FFELEX_typeCOMMA: 14109 case FFELEX_typeCOLONCOLON: 14110 ffesta_confirmed (); /* Error, but clearly intended. */ 14111 goto bad_1; /* :::::::::::::::::::: */ 14112 14113 default: 14114 goto bad_1; /* :::::::::::::::::::: */ 14115 } 14116 14117 for (ix = 0; ix < FFESTP_openix; ++ix) 14118 ffestp_file.open.open_spec[ix].kw_or_val_present = FALSE; 14119 14120 return (ffelexHandler) ffestb_R9041_; 14121 14122bad_0: /* :::::::::::::::::::: */ 14123 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", ffesta_tokens[0]); 14124 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 14125 14126bad_1: /* :::::::::::::::::::: */ 14127 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t); 14128 return (ffelexHandler) ffelex_swallow_tokens (t, 14129 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 14130} 14131 14132/* ffestb_R9041_ -- "OPEN" OPEN_PAREN 14133 14134 return ffestb_R9041_; // to lexer 14135 14136 Handle expr construct (not NAME=expr construct) here. */ 14137 14138static ffelexHandler 14139ffestb_R9041_ (ffelexToken t) 14140{ 14141 switch (ffelex_token_type (t)) 14142 { 14143 case FFELEX_typeNAME: 14144 ffesta_tokens[1] = ffelex_token_use (t); 14145 return (ffelexHandler) ffestb_R9042_; 14146 14147 default: 14148 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 14149 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9043_))) 14150 (t); 14151 } 14152} 14153 14154/* ffestb_R9042_ -- "OPEN" OPEN_PAREN NAME 14155 14156 return ffestb_R9042_; // to lexer 14157 14158 If EQUALS here, go to states that handle it. Else, send NAME and this 14159 token thru expression handler. */ 14160 14161static ffelexHandler 14162ffestb_R9042_ (ffelexToken t) 14163{ 14164 ffelexHandler next; 14165 ffelexToken nt; 14166 14167 switch (ffelex_token_type (t)) 14168 { 14169 case FFELEX_typeEQUALS: 14170 nt = ffesta_tokens[1]; 14171 next = (ffelexHandler) ffestb_R9044_ (nt); 14172 ffelex_token_kill (nt); 14173 return (ffelexHandler) (*next) (t); 14174 14175 default: 14176 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 14177 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9043_))) 14178 (ffesta_tokens[1]); 14179 ffelex_token_kill (ffesta_tokens[1]); 14180 return (ffelexHandler) (*next) (t); 14181 } 14182} 14183 14184/* ffestb_R9043_ -- "OPEN" OPEN_PAREN expr 14185 14186 (ffestb_R9043_) // to expression handler 14187 14188 Handle COMMA or CLOSE_PAREN here. */ 14189 14190static ffelexHandler 14191ffestb_R9043_ (ffelexToken ft, ffebld expr, ffelexToken t) 14192{ 14193 switch (ffelex_token_type (t)) 14194 { 14195 case FFELEX_typeCOMMA: 14196 case FFELEX_typeCLOSE_PAREN: 14197 if (expr == NULL) 14198 break; 14199 ffestp_file.open.open_spec[FFESTP_openixUNIT].kw_or_val_present 14200 = TRUE; 14201 ffestp_file.open.open_spec[FFESTP_openixUNIT].kw_present = FALSE; 14202 ffestp_file.open.open_spec[FFESTP_openixUNIT].value_present = TRUE; 14203 ffestp_file.open.open_spec[FFESTP_openixUNIT].value_is_label 14204 = FALSE; 14205 ffestp_file.open.open_spec[FFESTP_openixUNIT].value 14206 = ffelex_token_use (ft); 14207 ffestp_file.open.open_spec[FFESTP_openixUNIT].u.expr = expr; 14208 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 14209 return (ffelexHandler) ffestb_R9044_; 14210 return (ffelexHandler) ffestb_R9049_; 14211 14212 default: 14213 break; 14214 } 14215 14216 ffestb_subr_kill_open_ (); 14217 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t); 14218 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 14219} 14220 14221/* ffestb_R9044_ -- "OPEN" OPEN_PAREN [external-file-unit COMMA] 14222 14223 return ffestb_R9044_; // to lexer 14224 14225 Handle expr construct (not NAME=expr construct) here. */ 14226 14227static ffelexHandler 14228ffestb_R9044_ (ffelexToken t) 14229{ 14230 ffestrOpen kw; 14231 14232 ffestb_local_.open.label = FALSE; 14233 14234 switch (ffelex_token_type (t)) 14235 { 14236 case FFELEX_typeNAME: 14237 kw = ffestr_open (t); 14238 switch (kw) 14239 { 14240 case FFESTR_openACCESS: 14241 ffestb_local_.open.ix = FFESTP_openixACCESS; 14242 ffestb_local_.open.left = FALSE; 14243 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR; 14244 break; 14245 14246 case FFESTR_openACTION: 14247 ffestb_local_.open.ix = FFESTP_openixACTION; 14248 ffestb_local_.open.left = FALSE; 14249 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR; 14250 break; 14251 14252 case FFESTR_openASSOCIATEVARIABLE: 14253 ffestb_local_.open.ix = FFESTP_openixASSOCIATEVARIABLE; 14254 ffestb_local_.open.left = TRUE; 14255 ffestb_local_.open.context = FFEEXPR_contextFILEASSOC; 14256 break; 14257 14258 case FFESTR_openBLANK: 14259 ffestb_local_.open.ix = FFESTP_openixBLANK; 14260 ffestb_local_.open.left = FALSE; 14261 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR; 14262 break; 14263 14264 case FFESTR_openBLOCKSIZE: 14265 ffestb_local_.open.ix = FFESTP_openixBLOCKSIZE; 14266 ffestb_local_.open.left = FALSE; 14267 ffestb_local_.open.context = FFEEXPR_contextFILENUM; 14268 break; 14269 14270 case FFESTR_openBUFFERCOUNT: 14271 ffestb_local_.open.ix = FFESTP_openixBUFFERCOUNT; 14272 ffestb_local_.open.left = FALSE; 14273 ffestb_local_.open.context = FFEEXPR_contextFILENUM; 14274 break; 14275 14276 case FFESTR_openCARRIAGECONTROL: 14277 ffestb_local_.open.ix = FFESTP_openixCARRIAGECONTROL; 14278 ffestb_local_.open.left = FALSE; 14279 ffestb_local_.open.context = FFEEXPR_contextFILECHAR; 14280 break; 14281 14282 case FFESTR_openDEFAULTFILE: 14283 ffestb_local_.open.ix = FFESTP_openixDEFAULTFILE; 14284 ffestb_local_.open.left = FALSE; 14285 ffestb_local_.open.context = FFEEXPR_contextFILECHAR; 14286 break; 14287 14288 case FFESTR_openDELIM: 14289 ffestb_local_.open.ix = FFESTP_openixDELIM; 14290 ffestb_local_.open.left = FALSE; 14291 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR; 14292 break; 14293 14294 case FFESTR_openDISP: 14295 case FFESTR_openDISPOSE: 14296 ffestb_local_.open.ix = FFESTP_openixDISPOSE; 14297 ffestb_local_.open.left = FALSE; 14298 ffestb_local_.open.context = FFEEXPR_contextFILECHAR; 14299 break; 14300 14301 case FFESTR_openERR: 14302 ffestb_local_.open.ix = FFESTP_openixERR; 14303 ffestb_local_.open.label = TRUE; 14304 break; 14305 14306 case FFESTR_openEXTENDSIZE: 14307 ffestb_local_.open.ix = FFESTP_openixEXTENDSIZE; 14308 ffestb_local_.open.left = FALSE; 14309 ffestb_local_.open.context = FFEEXPR_contextFILENUM; 14310 break; 14311 14312 case FFESTR_openFILE: 14313 case FFESTR_openNAME: 14314 ffestb_local_.open.ix = FFESTP_openixFILE; 14315 ffestb_local_.open.left = FALSE; 14316 ffestb_local_.open.context = FFEEXPR_contextFILECHAR; 14317 break; 14318 14319 case FFESTR_openFORM: 14320 ffestb_local_.open.ix = FFESTP_openixFORM; 14321 ffestb_local_.open.left = FALSE; 14322 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR; 14323 break; 14324 14325 case FFESTR_openINITIALSIZE: 14326 ffestb_local_.open.ix = FFESTP_openixINITIALSIZE; 14327 ffestb_local_.open.left = FALSE; 14328 ffestb_local_.open.context = FFEEXPR_contextFILENUM; 14329 break; 14330 14331 case FFESTR_openIOSTAT: 14332 ffestb_local_.open.ix = FFESTP_openixIOSTAT; 14333 ffestb_local_.open.left = TRUE; 14334 ffestb_local_.open.context = FFEEXPR_contextFILEINT; 14335 break; 14336 14337#if 0 /* Haven't added support for expression 14338 context yet (though easy). */ 14339 case FFESTR_openKEY: 14340 ffestb_local_.open.ix = FFESTP_openixKEY; 14341 ffestb_local_.open.left = FALSE; 14342 ffestb_local_.open.context = FFEEXPR_contextFILEKEY; 14343 break; 14344#endif 14345 14346 case FFESTR_openMAXREC: 14347 ffestb_local_.open.ix = FFESTP_openixMAXREC; 14348 ffestb_local_.open.left = FALSE; 14349 ffestb_local_.open.context = FFEEXPR_contextFILENUM; 14350 break; 14351 14352 case FFESTR_openNOSPANBLOCKS: 14353 if (ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS] 14354 .kw_or_val_present) 14355 goto bad; /* :::::::::::::::::::: */ 14356 ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS] 14357 .kw_or_val_present = TRUE; 14358 ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS] 14359 .kw_present = TRUE; 14360 ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS] 14361 .value_present = FALSE; 14362 ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS].kw 14363 = ffelex_token_use (t); 14364 return (ffelexHandler) ffestb_R9048_; 14365 14366 case FFESTR_openORGANIZATION: 14367 ffestb_local_.open.ix = FFESTP_openixORGANIZATION; 14368 ffestb_local_.open.left = FALSE; 14369 ffestb_local_.open.context = FFEEXPR_contextFILECHAR; 14370 break; 14371 14372 case FFESTR_openPAD: 14373 ffestb_local_.open.ix = FFESTP_openixPAD; 14374 ffestb_local_.open.left = FALSE; 14375 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR; 14376 break; 14377 14378 case FFESTR_openPOSITION: 14379 ffestb_local_.open.ix = FFESTP_openixPOSITION; 14380 ffestb_local_.open.left = FALSE; 14381 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR; 14382 break; 14383 14384 case FFESTR_openREADONLY: 14385 if (ffestp_file.open.open_spec[FFESTP_openixREADONLY] 14386 .kw_or_val_present) 14387 goto bad; /* :::::::::::::::::::: */ 14388 ffestp_file.open.open_spec[FFESTP_openixREADONLY] 14389 .kw_or_val_present = TRUE; 14390 ffestp_file.open.open_spec[FFESTP_openixREADONLY] 14391 .kw_present = TRUE; 14392 ffestp_file.open.open_spec[FFESTP_openixREADONLY] 14393 .value_present = FALSE; 14394 ffestp_file.open.open_spec[FFESTP_openixREADONLY].kw 14395 = ffelex_token_use (t); 14396 return (ffelexHandler) ffestb_R9048_; 14397 14398 case FFESTR_openRECL: 14399 case FFESTR_openRECORDSIZE: 14400 ffestb_local_.open.ix = FFESTP_openixRECL; 14401 ffestb_local_.open.left = FALSE; 14402 ffestb_local_.open.context = FFEEXPR_contextFILENUM; 14403 break; 14404 14405 case FFESTR_openRECORDTYPE: 14406 ffestb_local_.open.ix = FFESTP_openixRECORDTYPE; 14407 ffestb_local_.open.left = FALSE; 14408 ffestb_local_.open.context = FFEEXPR_contextFILECHAR; 14409 break; 14410 14411 case FFESTR_openSHARED: 14412 if (ffestp_file.open.open_spec[FFESTP_openixSHARED] 14413 .kw_or_val_present) 14414 goto bad; /* :::::::::::::::::::: */ 14415 ffestp_file.open.open_spec[FFESTP_openixSHARED] 14416 .kw_or_val_present = TRUE; 14417 ffestp_file.open.open_spec[FFESTP_openixSHARED] 14418 .kw_present = TRUE; 14419 ffestp_file.open.open_spec[FFESTP_openixSHARED] 14420 .value_present = FALSE; 14421 ffestp_file.open.open_spec[FFESTP_openixSHARED].kw 14422 = ffelex_token_use (t); 14423 return (ffelexHandler) ffestb_R9048_; 14424 14425 case FFESTR_openSTATUS: 14426 case FFESTR_openTYPE: 14427 ffestb_local_.open.ix = FFESTP_openixSTATUS; 14428 ffestb_local_.open.left = FALSE; 14429 ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR; 14430 break; 14431 14432 case FFESTR_openUNIT: 14433 ffestb_local_.open.ix = FFESTP_openixUNIT; 14434 ffestb_local_.open.left = FALSE; 14435 ffestb_local_.open.context = FFEEXPR_contextFILENUM; 14436 break; 14437 14438 case FFESTR_openUSEROPEN: 14439 ffestb_local_.open.ix = FFESTP_openixUSEROPEN; 14440 ffestb_local_.open.left = TRUE; 14441 ffestb_local_.open.context = FFEEXPR_contextFILEEXTFUNC; 14442 break; 14443 14444 default: 14445 goto bad; /* :::::::::::::::::::: */ 14446 } 14447 if (ffestp_file.open.open_spec[ffestb_local_.open.ix] 14448 .kw_or_val_present) 14449 break; /* Can't specify a keyword twice! */ 14450 ffestp_file.open.open_spec[ffestb_local_.open.ix] 14451 .kw_or_val_present = TRUE; 14452 ffestp_file.open.open_spec[ffestb_local_.open.ix] 14453 .kw_present = TRUE; 14454 ffestp_file.open.open_spec[ffestb_local_.open.ix] 14455 .value_present = FALSE; 14456 ffestp_file.open.open_spec[ffestb_local_.open.ix].value_is_label 14457 = ffestb_local_.open.label; 14458 ffestp_file.open.open_spec[ffestb_local_.open.ix].kw 14459 = ffelex_token_use (t); 14460 return (ffelexHandler) ffestb_R9045_; 14461 14462 default: 14463 break; 14464 } 14465 14466bad: /* :::::::::::::::::::: */ 14467 ffestb_subr_kill_open_ (); 14468 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t); 14469 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 14470} 14471 14472/* ffestb_R9045_ -- "OPEN" OPEN_PAREN [external-file-unit COMMA] NAME 14473 14474 return ffestb_R9045_; // to lexer 14475 14476 Make sure EQUALS here, send next token to expression handler. */ 14477 14478static ffelexHandler 14479ffestb_R9045_ (ffelexToken t) 14480{ 14481 switch (ffelex_token_type (t)) 14482 { 14483 case FFELEX_typeEQUALS: 14484 ffesta_confirmed (); 14485 if (ffestb_local_.open.label) 14486 return (ffelexHandler) ffestb_R9047_; 14487 if (ffestb_local_.open.left) 14488 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 14489 ffestb_local_.open.context, 14490 (ffeexprCallback) ffestb_R9046_); 14491 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 14492 ffestb_local_.open.context, 14493 (ffeexprCallback) ffestb_R9046_); 14494 14495 default: 14496 break; 14497 } 14498 14499 ffestb_subr_kill_open_ (); 14500 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t); 14501 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 14502} 14503 14504/* ffestb_R9046_ -- "OPEN" OPEN_PAREN ... NAME EQUALS expr 14505 14506 (ffestb_R9046_) // to expression handler 14507 14508 Handle COMMA or CLOSE_PAREN here. */ 14509 14510static ffelexHandler 14511ffestb_R9046_ (ffelexToken ft, ffebld expr, ffelexToken t) 14512{ 14513 switch (ffelex_token_type (t)) 14514 { 14515 case FFELEX_typeCOMMA: 14516 case FFELEX_typeCLOSE_PAREN: 14517 if (expr == NULL) 14518 break; 14519 ffestp_file.open.open_spec[ffestb_local_.open.ix].value_present 14520 = TRUE; 14521 ffestp_file.open.open_spec[ffestb_local_.open.ix].value 14522 = ffelex_token_use (ft); 14523 ffestp_file.open.open_spec[ffestb_local_.open.ix].u.expr = expr; 14524 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 14525 return (ffelexHandler) ffestb_R9044_; 14526 return (ffelexHandler) ffestb_R9049_; 14527 14528 default: 14529 break; 14530 } 14531 14532 ffestb_subr_kill_open_ (); 14533 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t); 14534 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 14535} 14536 14537/* ffestb_R9047_ -- "OPEN" OPEN_PAREN ... NAME EQUALS 14538 14539 return ffestb_R9047_; // to lexer 14540 14541 Handle NUMBER for label here. */ 14542 14543static ffelexHandler 14544ffestb_R9047_ (ffelexToken t) 14545{ 14546 switch (ffelex_token_type (t)) 14547 { 14548 case FFELEX_typeNUMBER: 14549 ffestp_file.open.open_spec[ffestb_local_.open.ix].value_present 14550 = TRUE; 14551 ffestp_file.open.open_spec[ffestb_local_.open.ix].value 14552 = ffelex_token_use (t); 14553 return (ffelexHandler) ffestb_R9048_; 14554 14555 default: 14556 break; 14557 } 14558 14559 ffestb_subr_kill_open_ (); 14560 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t); 14561 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 14562} 14563 14564/* ffestb_R9048_ -- "OPEN" OPEN_PAREN ... NAME EQUALS NUMBER 14565 14566 return ffestb_R9048_; // to lexer 14567 14568 Handle COMMA or CLOSE_PAREN here. */ 14569 14570static ffelexHandler 14571ffestb_R9048_ (ffelexToken t) 14572{ 14573 switch (ffelex_token_type (t)) 14574 { 14575 case FFELEX_typeCOMMA: 14576 return (ffelexHandler) ffestb_R9044_; 14577 14578 case FFELEX_typeCLOSE_PAREN: 14579 return (ffelexHandler) ffestb_R9049_; 14580 14581 default: 14582 break; 14583 } 14584 14585 ffestb_subr_kill_open_ (); 14586 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t); 14587 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 14588} 14589 14590/* ffestb_R9049_ -- "OPEN" OPEN_PAREN ... CLOSE_PAREN 14591 14592 return ffestb_R9049_; // to lexer 14593 14594 Handle EOS or SEMICOLON here. */ 14595 14596static ffelexHandler 14597ffestb_R9049_ (ffelexToken t) 14598{ 14599 switch (ffelex_token_type (t)) 14600 { 14601 case FFELEX_typeEOS: 14602 case FFELEX_typeSEMICOLON: 14603 ffesta_confirmed (); 14604 if (!ffesta_is_inhibited ()) 14605 ffestc_R904 (); 14606 ffestb_subr_kill_open_ (); 14607 return (ffelexHandler) ffesta_zero (t); 14608 14609 default: 14610 break; 14611 } 14612 14613 ffestb_subr_kill_open_ (); 14614 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t); 14615 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 14616} 14617 14618/* ffestb_R907 -- Parse a CLOSE statement 14619 14620 return ffestb_R907; // to lexer 14621 14622 Make sure the statement has a valid form for a CLOSE statement. 14623 If it does, implement the statement. */ 14624 14625ffelexHandler 14626ffestb_R907 (ffelexToken t) 14627{ 14628 ffestpCloseIx ix; 14629 14630 switch (ffelex_token_type (ffesta_tokens[0])) 14631 { 14632 case FFELEX_typeNAME: 14633 if (ffesta_first_kw != FFESTR_firstCLOSE) 14634 goto bad_0; /* :::::::::::::::::::: */ 14635 break; 14636 14637 case FFELEX_typeNAMES: 14638 if (ffesta_first_kw != FFESTR_firstCLOSE) 14639 goto bad_0; /* :::::::::::::::::::: */ 14640 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlCLOSE) 14641 goto bad_0; /* :::::::::::::::::::: */ 14642 break; 14643 14644 default: 14645 goto bad_0; /* :::::::::::::::::::: */ 14646 } 14647 14648 switch (ffelex_token_type (t)) 14649 { 14650 case FFELEX_typeOPEN_PAREN: 14651 break; 14652 14653 case FFELEX_typeEOS: 14654 case FFELEX_typeSEMICOLON: 14655 case FFELEX_typeCOMMA: 14656 case FFELEX_typeCOLONCOLON: 14657 ffesta_confirmed (); /* Error, but clearly intended. */ 14658 goto bad_1; /* :::::::::::::::::::: */ 14659 14660 default: 14661 goto bad_1; /* :::::::::::::::::::: */ 14662 } 14663 14664 for (ix = 0; ix < FFESTP_closeix; ++ix) 14665 ffestp_file.close.close_spec[ix].kw_or_val_present = FALSE; 14666 14667 return (ffelexHandler) ffestb_R9071_; 14668 14669bad_0: /* :::::::::::::::::::: */ 14670 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", ffesta_tokens[0]); 14671 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 14672 14673bad_1: /* :::::::::::::::::::: */ 14674 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t); 14675 return (ffelexHandler) ffelex_swallow_tokens (t, 14676 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 14677} 14678 14679/* ffestb_R9071_ -- "CLOSE" OPEN_PAREN 14680 14681 return ffestb_R9071_; // to lexer 14682 14683 Handle expr construct (not NAME=expr construct) here. */ 14684 14685static ffelexHandler 14686ffestb_R9071_ (ffelexToken t) 14687{ 14688 switch (ffelex_token_type (t)) 14689 { 14690 case FFELEX_typeNAME: 14691 ffesta_tokens[1] = ffelex_token_use (t); 14692 return (ffelexHandler) ffestb_R9072_; 14693 14694 default: 14695 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 14696 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9073_))) 14697 (t); 14698 } 14699} 14700 14701/* ffestb_R9072_ -- "CLOSE" OPEN_PAREN NAME 14702 14703 return ffestb_R9072_; // to lexer 14704 14705 If EQUALS here, go to states that handle it. Else, send NAME and this 14706 token thru expression handler. */ 14707 14708static ffelexHandler 14709ffestb_R9072_ (ffelexToken t) 14710{ 14711 ffelexHandler next; 14712 ffelexToken nt; 14713 14714 switch (ffelex_token_type (t)) 14715 { 14716 case FFELEX_typeEQUALS: 14717 nt = ffesta_tokens[1]; 14718 next = (ffelexHandler) ffestb_R9074_ (nt); 14719 ffelex_token_kill (nt); 14720 return (ffelexHandler) (*next) (t); 14721 14722 default: 14723 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 14724 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9073_))) 14725 (ffesta_tokens[1]); 14726 ffelex_token_kill (ffesta_tokens[1]); 14727 return (ffelexHandler) (*next) (t); 14728 } 14729} 14730 14731/* ffestb_R9073_ -- "CLOSE" OPEN_PAREN expr 14732 14733 (ffestb_R9073_) // to expression handler 14734 14735 Handle COMMA or CLOSE_PAREN here. */ 14736 14737static ffelexHandler 14738ffestb_R9073_ (ffelexToken ft, ffebld expr, ffelexToken t) 14739{ 14740 switch (ffelex_token_type (t)) 14741 { 14742 case FFELEX_typeCOMMA: 14743 case FFELEX_typeCLOSE_PAREN: 14744 if (expr == NULL) 14745 break; 14746 ffestp_file.close.close_spec[FFESTP_closeixUNIT].kw_or_val_present 14747 = TRUE; 14748 ffestp_file.close.close_spec[FFESTP_closeixUNIT].kw_present = FALSE; 14749 ffestp_file.close.close_spec[FFESTP_closeixUNIT].value_present = TRUE; 14750 ffestp_file.close.close_spec[FFESTP_closeixUNIT].value_is_label 14751 = FALSE; 14752 ffestp_file.close.close_spec[FFESTP_closeixUNIT].value 14753 = ffelex_token_use (ft); 14754 ffestp_file.close.close_spec[FFESTP_closeixUNIT].u.expr = expr; 14755 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 14756 return (ffelexHandler) ffestb_R9074_; 14757 return (ffelexHandler) ffestb_R9079_; 14758 14759 default: 14760 break; 14761 } 14762 14763 ffestb_subr_kill_close_ (); 14764 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t); 14765 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 14766} 14767 14768/* ffestb_R9074_ -- "CLOSE" OPEN_PAREN [external-file-unit COMMA] 14769 14770 return ffestb_R9074_; // to lexer 14771 14772 Handle expr construct (not NAME=expr construct) here. */ 14773 14774static ffelexHandler 14775ffestb_R9074_ (ffelexToken t) 14776{ 14777 ffestrGenio kw; 14778 14779 ffestb_local_.close.label = FALSE; 14780 14781 switch (ffelex_token_type (t)) 14782 { 14783 case FFELEX_typeNAME: 14784 kw = ffestr_genio (t); 14785 switch (kw) 14786 { 14787 case FFESTR_genioERR: 14788 ffestb_local_.close.ix = FFESTP_closeixERR; 14789 ffestb_local_.close.label = TRUE; 14790 break; 14791 14792 case FFESTR_genioIOSTAT: 14793 ffestb_local_.close.ix = FFESTP_closeixIOSTAT; 14794 ffestb_local_.close.left = TRUE; 14795 ffestb_local_.close.context = FFEEXPR_contextFILEINT; 14796 break; 14797 14798 case FFESTR_genioSTATUS: 14799 case FFESTR_genioDISP: 14800 case FFESTR_genioDISPOSE: 14801 ffestb_local_.close.ix = FFESTP_closeixSTATUS; 14802 ffestb_local_.close.left = FALSE; 14803 ffestb_local_.close.context = FFEEXPR_contextFILEDFCHAR; 14804 break; 14805 14806 case FFESTR_genioUNIT: 14807 ffestb_local_.close.ix = FFESTP_closeixUNIT; 14808 ffestb_local_.close.left = FALSE; 14809 ffestb_local_.close.context = FFEEXPR_contextFILENUM; 14810 break; 14811 14812 default: 14813 goto bad; /* :::::::::::::::::::: */ 14814 } 14815 if (ffestp_file.close.close_spec[ffestb_local_.close.ix] 14816 .kw_or_val_present) 14817 break; /* Can't specify a keyword twice! */ 14818 ffestp_file.close.close_spec[ffestb_local_.close.ix] 14819 .kw_or_val_present = TRUE; 14820 ffestp_file.close.close_spec[ffestb_local_.close.ix] 14821 .kw_present = TRUE; 14822 ffestp_file.close.close_spec[ffestb_local_.close.ix] 14823 .value_present = FALSE; 14824 ffestp_file.close.close_spec[ffestb_local_.close.ix].value_is_label 14825 = ffestb_local_.close.label; 14826 ffestp_file.close.close_spec[ffestb_local_.close.ix].kw 14827 = ffelex_token_use (t); 14828 return (ffelexHandler) ffestb_R9075_; 14829 14830 default: 14831 break; 14832 } 14833 14834bad: /* :::::::::::::::::::: */ 14835 ffestb_subr_kill_close_ (); 14836 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t); 14837 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 14838} 14839 14840/* ffestb_R9075_ -- "CLOSE" OPEN_PAREN [external-file-unit COMMA] NAME 14841 14842 return ffestb_R9075_; // to lexer 14843 14844 Make sure EQUALS here, send next token to expression handler. */ 14845 14846static ffelexHandler 14847ffestb_R9075_ (ffelexToken t) 14848{ 14849 switch (ffelex_token_type (t)) 14850 { 14851 case FFELEX_typeEQUALS: 14852 ffesta_confirmed (); 14853 if (ffestb_local_.close.label) 14854 return (ffelexHandler) ffestb_R9077_; 14855 if (ffestb_local_.close.left) 14856 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 14857 ffestb_local_.close.context, 14858 (ffeexprCallback) ffestb_R9076_); 14859 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 14860 ffestb_local_.close.context, 14861 (ffeexprCallback) ffestb_R9076_); 14862 14863 default: 14864 break; 14865 } 14866 14867 ffestb_subr_kill_close_ (); 14868 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t); 14869 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 14870} 14871 14872/* ffestb_R9076_ -- "CLOSE" OPEN_PAREN ... NAME EQUALS expr 14873 14874 (ffestb_R9076_) // to expression handler 14875 14876 Handle COMMA or CLOSE_PAREN here. */ 14877 14878static ffelexHandler 14879ffestb_R9076_ (ffelexToken ft, ffebld expr, ffelexToken t) 14880{ 14881 switch (ffelex_token_type (t)) 14882 { 14883 case FFELEX_typeCOMMA: 14884 case FFELEX_typeCLOSE_PAREN: 14885 if (expr == NULL) 14886 break; 14887 ffestp_file.close.close_spec[ffestb_local_.close.ix].value_present 14888 = TRUE; 14889 ffestp_file.close.close_spec[ffestb_local_.close.ix].value 14890 = ffelex_token_use (ft); 14891 ffestp_file.close.close_spec[ffestb_local_.close.ix].u.expr = expr; 14892 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 14893 return (ffelexHandler) ffestb_R9074_; 14894 return (ffelexHandler) ffestb_R9079_; 14895 14896 default: 14897 break; 14898 } 14899 14900 ffestb_subr_kill_close_ (); 14901 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t); 14902 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 14903} 14904 14905/* ffestb_R9077_ -- "CLOSE" OPEN_PAREN ... NAME EQUALS 14906 14907 return ffestb_R9077_; // to lexer 14908 14909 Handle NUMBER for label here. */ 14910 14911static ffelexHandler 14912ffestb_R9077_ (ffelexToken t) 14913{ 14914 switch (ffelex_token_type (t)) 14915 { 14916 case FFELEX_typeNUMBER: 14917 ffestp_file.close.close_spec[ffestb_local_.close.ix].value_present 14918 = TRUE; 14919 ffestp_file.close.close_spec[ffestb_local_.close.ix].value 14920 = ffelex_token_use (t); 14921 return (ffelexHandler) ffestb_R9078_; 14922 14923 default: 14924 break; 14925 } 14926 14927 ffestb_subr_kill_close_ (); 14928 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t); 14929 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 14930} 14931 14932/* ffestb_R9078_ -- "CLOSE" OPEN_PAREN ... NAME EQUALS NUMBER 14933 14934 return ffestb_R9078_; // to lexer 14935 14936 Handle COMMA or CLOSE_PAREN here. */ 14937 14938static ffelexHandler 14939ffestb_R9078_ (ffelexToken t) 14940{ 14941 switch (ffelex_token_type (t)) 14942 { 14943 case FFELEX_typeCOMMA: 14944 return (ffelexHandler) ffestb_R9074_; 14945 14946 case FFELEX_typeCLOSE_PAREN: 14947 return (ffelexHandler) ffestb_R9079_; 14948 14949 default: 14950 break; 14951 } 14952 14953 ffestb_subr_kill_close_ (); 14954 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t); 14955 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 14956} 14957 14958/* ffestb_R9079_ -- "CLOSE" OPEN_PAREN ... CLOSE_PAREN 14959 14960 return ffestb_R9079_; // to lexer 14961 14962 Handle EOS or SEMICOLON here. */ 14963 14964static ffelexHandler 14965ffestb_R9079_ (ffelexToken t) 14966{ 14967 switch (ffelex_token_type (t)) 14968 { 14969 case FFELEX_typeEOS: 14970 case FFELEX_typeSEMICOLON: 14971 ffesta_confirmed (); 14972 if (!ffesta_is_inhibited ()) 14973 ffestc_R907 (); 14974 ffestb_subr_kill_close_ (); 14975 return (ffelexHandler) ffesta_zero (t); 14976 14977 default: 14978 break; 14979 } 14980 14981 ffestb_subr_kill_close_ (); 14982 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t); 14983 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 14984} 14985 14986/* ffestb_R909 -- Parse the READ statement 14987 14988 return ffestb_R909; // to lexer 14989 14990 Make sure the statement has a valid form for the READ 14991 statement. If it does, implement the statement. */ 14992 14993ffelexHandler 14994ffestb_R909 (ffelexToken t) 14995{ 14996 ffelexHandler next; 14997 ffestpReadIx ix; 14998 14999 switch (ffelex_token_type (ffesta_tokens[0])) 15000 { 15001 case FFELEX_typeNAME: 15002 if (ffesta_first_kw != FFESTR_firstREAD) 15003 goto bad_0; /* :::::::::::::::::::: */ 15004 switch (ffelex_token_type (t)) 15005 { 15006 case FFELEX_typeCOMMA: 15007 case FFELEX_typeCOLONCOLON: 15008 case FFELEX_typeEOS: 15009 case FFELEX_typeSEMICOLON: 15010 ffesta_confirmed (); /* Error, but clearly intended. */ 15011 goto bad_1; /* :::::::::::::::::::: */ 15012 15013 case FFELEX_typeEQUALS: 15014 case FFELEX_typePOINTS: 15015 case FFELEX_typeCOLON: 15016 goto bad_1; /* :::::::::::::::::::: */ 15017 15018 case FFELEX_typeNAME: 15019 case FFELEX_typeNUMBER: 15020 ffesta_confirmed (); 15021 break; 15022 15023 case FFELEX_typeOPEN_PAREN: 15024 for (ix = 0; ix < FFESTP_readix; ++ix) 15025 ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE; 15026 ffesta_tokens[1] = ffelex_token_use (t); 15027 return (ffelexHandler) ffestb_R9092_; 15028 15029 default: 15030 break; 15031 } 15032 15033 for (ix = 0; ix < FFESTP_readix; ++ix) 15034 ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE; 15035 return (ffelexHandler) (*((ffelexHandler) 15036 ffeexpr_rhs (ffesta_output_pool, 15037 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9091_))) 15038 (t); 15039 15040 case FFELEX_typeNAMES: 15041 if (ffesta_first_kw != FFESTR_firstREAD) 15042 goto bad_0; /* :::::::::::::::::::: */ 15043 switch (ffelex_token_type (t)) 15044 { 15045 case FFELEX_typeEOS: 15046 case FFELEX_typeSEMICOLON: 15047 case FFELEX_typeCOMMA: 15048 ffesta_confirmed (); 15049 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlREAD) 15050 break; 15051 goto bad_1; /* :::::::::::::::::::: */ 15052 15053 case FFELEX_typeCOLONCOLON: 15054 ffesta_confirmed (); /* Error, but clearly intended. */ 15055 goto bad_1; /* :::::::::::::::::::: */ 15056 15057 case FFELEX_typeEQUALS: 15058 case FFELEX_typePOINTS: 15059 case FFELEX_typeCOLON: 15060 goto bad_1; /* :::::::::::::::::::: */ 15061 15062 case FFELEX_typeOPEN_PAREN: 15063 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlREAD) 15064 break; 15065 15066 for (ix = 0; ix < FFESTP_readix; ++ix) 15067 ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE; 15068 ffesta_tokens[1] = ffelex_token_use (t); 15069 return (ffelexHandler) ffestb_R9092_; 15070 15071 default: 15072 break; 15073 } 15074 for (ix = 0; ix < FFESTP_readix; ++ix) 15075 ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE; 15076 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 15077 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9091_); 15078 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0], 15079 FFESTR_firstlREAD); 15080 if (next == NULL) 15081 return (ffelexHandler) ffelex_swallow_tokens (t, 15082 (ffelexHandler) ffesta_zero); 15083 return (ffelexHandler) (*next) (t); 15084 15085 default: 15086 goto bad_0; /* :::::::::::::::::::: */ 15087 } 15088 15089bad_0: /* :::::::::::::::::::: */ 15090 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", ffesta_tokens[0]); 15091 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 15092 15093bad_1: /* :::::::::::::::::::: */ 15094 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t); 15095 return (ffelexHandler) ffelex_swallow_tokens (t, 15096 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 15097} 15098 15099/* ffestb_R9091_ -- "READ" expr 15100 15101 (ffestb_R9091_) // to expression handler 15102 15103 Make sure the next token is a COMMA or EOS/SEMICOLON. */ 15104 15105static ffelexHandler 15106ffestb_R9091_ (ffelexToken ft, ffebld expr, ffelexToken t) 15107{ 15108 switch (ffelex_token_type (t)) 15109 { 15110 case FFELEX_typeEOS: 15111 case FFELEX_typeSEMICOLON: 15112 case FFELEX_typeCOMMA: 15113 ffesta_confirmed (); 15114 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_or_val_present 15115 = TRUE; 15116 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_present = FALSE; 15117 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_present = TRUE; 15118 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_is_label 15119 = (expr == NULL); 15120 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value 15121 = ffelex_token_use (ft); 15122 ffestp_file.read.read_spec[FFESTP_readixFORMAT].u.expr = expr; 15123 if (!ffesta_is_inhibited ()) 15124 ffestc_R909_start (TRUE); 15125 ffestb_subr_kill_read_ (); 15126 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 15127 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 15128 ffestc_context_iolist (), 15129 (ffeexprCallback) ffestb_R90915_); 15130 if (!ffesta_is_inhibited ()) 15131 ffestc_R909_finish (); 15132 return (ffelexHandler) ffesta_zero (t); 15133 15134 default: 15135 break; 15136 } 15137 15138 ffestb_subr_kill_read_ (); 15139 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t); 15140 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 15141} 15142 15143/* ffestb_R9092_ -- "READ" OPEN_PAREN 15144 15145 return ffestb_R9092_; // to lexer 15146 15147 Handle expr construct (not NAME=expr construct) here. */ 15148 15149static ffelexHandler 15150ffestb_R9092_ (ffelexToken t) 15151{ 15152 ffelexToken nt; 15153 ffelexHandler next; 15154 15155 switch (ffelex_token_type (t)) 15156 { 15157 case FFELEX_typeNAME: 15158 ffesta_tokens[2] = ffelex_token_use (t); 15159 return (ffelexHandler) ffestb_R9093_; 15160 15161 default: 15162 nt = ffesta_tokens[1]; 15163 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 15164 FFEEXPR_contextFILEUNITAMBIG, (ffeexprCallback) ffestb_R9094_))) 15165 (nt); 15166 ffelex_token_kill (nt); 15167 return (ffelexHandler) (*next) (t); 15168 } 15169} 15170 15171/* ffestb_R9093_ -- "READ" OPEN_PAREN NAME 15172 15173 return ffestb_R9093_; // to lexer 15174 15175 If EQUALS here, go to states that handle it. Else, send NAME and this 15176 token thru expression handler. */ 15177 15178static ffelexHandler 15179ffestb_R9093_ (ffelexToken t) 15180{ 15181 ffelexHandler next; 15182 ffelexToken nt; 15183 ffelexToken ot; 15184 15185 switch (ffelex_token_type (t)) 15186 { 15187 case FFELEX_typeEQUALS: 15188 ffelex_token_kill (ffesta_tokens[1]); 15189 nt = ffesta_tokens[2]; 15190 next = (ffelexHandler) ffestb_R9098_ (nt); 15191 ffelex_token_kill (nt); 15192 return (ffelexHandler) (*next) (t); 15193 15194 default: 15195 nt = ffesta_tokens[1]; 15196 ot = ffesta_tokens[2]; 15197 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 15198 FFEEXPR_contextFILEUNITAMBIG, (ffeexprCallback) ffestb_R9094_))) 15199 (nt); 15200 ffelex_token_kill (nt); 15201 next = (ffelexHandler) (*next) (ot); 15202 ffelex_token_kill (ot); 15203 return (ffelexHandler) (*next) (t); 15204 } 15205} 15206 15207/* ffestb_R9094_ -- "READ" OPEN_PAREN expr [CLOSE_PAREN] 15208 15209 (ffestb_R9094_) // to expression handler 15210 15211 Handle COMMA or EOS/SEMICOLON here. 15212 15213 15-Feb-91 JCB 1.1 15214 Use new ffeexpr mechanism whereby the expr is encased in an opITEM if 15215 ffeexpr decided it was an item in a control list (hence a unit 15216 specifier), or a format specifier otherwise. */ 15217 15218static ffelexHandler 15219ffestb_R9094_ (ffelexToken ft, ffebld expr, ffelexToken t) 15220{ 15221 if (expr == NULL) 15222 goto bad; /* :::::::::::::::::::: */ 15223 15224 if (ffebld_op (expr) != FFEBLD_opITEM) 15225 { 15226 switch (ffelex_token_type (t)) 15227 { 15228 case FFELEX_typeCOMMA: 15229 case FFELEX_typeEOS: 15230 case FFELEX_typeSEMICOLON: 15231 ffesta_confirmed (); 15232 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_or_val_present 15233 = TRUE; 15234 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_present = FALSE; 15235 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_present = TRUE; 15236 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_is_label 15237 = FALSE; 15238 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value 15239 = ffelex_token_use (ft); 15240 ffestp_file.read.read_spec[FFESTP_readixFORMAT].u.expr = expr; 15241 if (!ffesta_is_inhibited ()) 15242 ffestc_R909_start (TRUE); 15243 ffestb_subr_kill_read_ (); 15244 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 15245 return (ffelexHandler) 15246 ffeexpr_lhs (ffesta_output_pool, 15247 ffestc_context_iolist (), 15248 (ffeexprCallback) ffestb_R90915_); 15249 if (!ffesta_is_inhibited ()) 15250 ffestc_R909_finish (); 15251 return (ffelexHandler) ffesta_zero (t); 15252 15253 default: 15254 goto bad; /* :::::::::::::::::::: */ 15255 } 15256 } 15257 15258 expr = ffebld_head (expr); 15259 15260 if (expr == NULL) 15261 goto bad; /* :::::::::::::::::::: */ 15262 15263 switch (ffelex_token_type (t)) 15264 { 15265 case FFELEX_typeCOMMA: 15266 case FFELEX_typeCLOSE_PAREN: 15267 ffestp_file.read.read_spec[FFESTP_readixUNIT].kw_or_val_present 15268 = TRUE; 15269 ffestp_file.read.read_spec[FFESTP_readixUNIT].kw_present = FALSE; 15270 ffestp_file.read.read_spec[FFESTP_readixUNIT].value_present = TRUE; 15271 ffestp_file.read.read_spec[FFESTP_readixUNIT].value_is_label 15272 = FALSE; 15273 ffestp_file.read.read_spec[FFESTP_readixUNIT].value 15274 = ffelex_token_use (ft); 15275 ffestp_file.read.read_spec[FFESTP_readixUNIT].u.expr = expr; 15276 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 15277 return (ffelexHandler) ffestb_R9095_; 15278 return (ffelexHandler) ffestb_R90913_; 15279 15280 default: 15281 break; 15282 } 15283 15284bad: /* :::::::::::::::::::: */ 15285 ffestb_subr_kill_read_ (); 15286 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t); 15287 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 15288} 15289 15290/* ffestb_R9095_ -- "READ" OPEN_PAREN expr COMMA 15291 15292 return ffestb_R9095_; // to lexer 15293 15294 Handle expr construct (not NAME=expr construct) here. */ 15295 15296static ffelexHandler 15297ffestb_R9095_ (ffelexToken t) 15298{ 15299 switch (ffelex_token_type (t)) 15300 { 15301 case FFELEX_typeNAME: 15302 ffesta_tokens[1] = ffelex_token_use (t); 15303 return (ffelexHandler) ffestb_R9096_; 15304 15305 default: 15306 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 15307 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9097_))) 15308 (t); 15309 } 15310} 15311 15312/* ffestb_R9096_ -- "READ" OPEN_PAREN expr COMMA NAME 15313 15314 return ffestb_R9096_; // to lexer 15315 15316 If EQUALS here, go to states that handle it. Else, send NAME and this 15317 token thru expression handler. */ 15318 15319static ffelexHandler 15320ffestb_R9096_ (ffelexToken t) 15321{ 15322 ffelexHandler next; 15323 ffelexToken nt; 15324 15325 switch (ffelex_token_type (t)) 15326 { 15327 case FFELEX_typeEQUALS: 15328 nt = ffesta_tokens[1]; 15329 next = (ffelexHandler) ffestb_R9098_ (nt); 15330 ffelex_token_kill (nt); 15331 return (ffelexHandler) (*next) (t); 15332 15333 default: 15334 nt = ffesta_tokens[1]; 15335 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 15336 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9097_))) 15337 (nt); 15338 ffelex_token_kill (nt); 15339 return (ffelexHandler) (*next) (t); 15340 } 15341} 15342 15343/* ffestb_R9097_ -- "READ" OPEN_PAREN expr COMMA expr 15344 15345 (ffestb_R9097_) // to expression handler 15346 15347 Handle COMMA or CLOSE_PAREN here. */ 15348 15349static ffelexHandler 15350ffestb_R9097_ (ffelexToken ft, ffebld expr, ffelexToken t) 15351{ 15352 switch (ffelex_token_type (t)) 15353 { 15354 case FFELEX_typeCOMMA: 15355 case FFELEX_typeCLOSE_PAREN: 15356 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_or_val_present 15357 = TRUE; 15358 ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_present = FALSE; 15359 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_present = TRUE; 15360 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_is_label 15361 = (expr == NULL); 15362 ffestp_file.read.read_spec[FFESTP_readixFORMAT].value 15363 = ffelex_token_use (ft); 15364 ffestp_file.read.read_spec[FFESTP_readixFORMAT].u.expr = expr; 15365 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 15366 return (ffelexHandler) ffestb_R9098_; 15367 return (ffelexHandler) ffestb_R90913_; 15368 15369 default: 15370 break; 15371 } 15372 15373 ffestb_subr_kill_read_ (); 15374 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t); 15375 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 15376} 15377 15378/* ffestb_R9098_ -- "READ" OPEN_PAREN [external-file-unit COMMA [format 15379 COMMA]] 15380 15381 return ffestb_R9098_; // to lexer 15382 15383 Handle expr construct (not NAME=expr construct) here. */ 15384 15385static ffelexHandler 15386ffestb_R9098_ (ffelexToken t) 15387{ 15388 ffestrGenio kw; 15389 15390 ffestb_local_.read.label = FALSE; 15391 15392 switch (ffelex_token_type (t)) 15393 { 15394 case FFELEX_typeNAME: 15395 kw = ffestr_genio (t); 15396 switch (kw) 15397 { 15398 case FFESTR_genioADVANCE: 15399 ffestb_local_.read.ix = FFESTP_readixADVANCE; 15400 ffestb_local_.read.left = FALSE; 15401 ffestb_local_.read.context = FFEEXPR_contextFILEDFCHAR; 15402 break; 15403 15404 case FFESTR_genioEOR: 15405 ffestb_local_.read.ix = FFESTP_readixEOR; 15406 ffestb_local_.read.label = TRUE; 15407 break; 15408 15409 case FFESTR_genioERR: 15410 ffestb_local_.read.ix = FFESTP_readixERR; 15411 ffestb_local_.read.label = TRUE; 15412 break; 15413 15414 case FFESTR_genioEND: 15415 ffestb_local_.read.ix = FFESTP_readixEND; 15416 ffestb_local_.read.label = TRUE; 15417 break; 15418 15419 case FFESTR_genioFMT: 15420 ffestb_local_.read.ix = FFESTP_readixFORMAT; 15421 ffestb_local_.read.left = FALSE; 15422 ffestb_local_.read.context = FFEEXPR_contextFILEFORMAT; 15423 break; 15424 15425 case FFESTR_genioIOSTAT: 15426 ffestb_local_.read.ix = FFESTP_readixIOSTAT; 15427 ffestb_local_.read.left = TRUE; 15428 ffestb_local_.read.context = FFEEXPR_contextFILEINT; 15429 break; 15430 15431 case FFESTR_genioKEY: 15432 case FFESTR_genioKEYEQ: 15433 ffestb_local_.read.ix = FFESTP_readixKEYEQ; 15434 ffestb_local_.read.left = FALSE; 15435 ffestb_local_.read.context = FFEEXPR_contextFILENUMCHAR; 15436 break; 15437 15438 case FFESTR_genioKEYGE: 15439 ffestb_local_.read.ix = FFESTP_readixKEYGE; 15440 ffestb_local_.read.left = FALSE; 15441 ffestb_local_.read.context = FFEEXPR_contextFILENUMCHAR; 15442 break; 15443 15444 case FFESTR_genioKEYGT: 15445 ffestb_local_.read.ix = FFESTP_readixKEYGT; 15446 ffestb_local_.read.left = FALSE; 15447 ffestb_local_.read.context = FFEEXPR_contextFILENUMCHAR; 15448 break; 15449 15450 case FFESTR_genioKEYID: 15451 ffestb_local_.read.ix = FFESTP_readixKEYID; 15452 ffestb_local_.read.left = FALSE; 15453 ffestb_local_.read.context = FFEEXPR_contextFILENUM; 15454 break; 15455 15456 case FFESTR_genioNML: 15457 ffestb_local_.read.ix = FFESTP_readixFORMAT; 15458 ffestb_local_.read.left = TRUE; 15459 ffestb_local_.read.context = FFEEXPR_contextFILENAMELIST; 15460 break; 15461 15462 case FFESTR_genioNULLS: 15463 ffestb_local_.read.ix = FFESTP_readixNULLS; 15464 ffestb_local_.read.left = TRUE; 15465 ffestb_local_.read.context = FFEEXPR_contextFILEINT; 15466 break; 15467 15468 case FFESTR_genioREC: 15469 ffestb_local_.read.ix = FFESTP_readixREC; 15470 ffestb_local_.read.left = FALSE; 15471 ffestb_local_.read.context = FFEEXPR_contextFILENUM; 15472 break; 15473 15474 case FFESTR_genioSIZE: 15475 ffestb_local_.read.ix = FFESTP_readixSIZE; 15476 ffestb_local_.read.left = TRUE; 15477 ffestb_local_.read.context = FFEEXPR_contextFILEINT; 15478 break; 15479 15480 case FFESTR_genioUNIT: 15481 ffestb_local_.read.ix = FFESTP_readixUNIT; 15482 ffestb_local_.read.left = FALSE; 15483 ffestb_local_.read.context = FFEEXPR_contextFILEUNIT; 15484 break; 15485 15486 default: 15487 goto bad; /* :::::::::::::::::::: */ 15488 } 15489 if (ffestp_file.read.read_spec[ffestb_local_.read.ix] 15490 .kw_or_val_present) 15491 break; /* Can't specify a keyword twice! */ 15492 ffestp_file.read.read_spec[ffestb_local_.read.ix] 15493 .kw_or_val_present = TRUE; 15494 ffestp_file.read.read_spec[ffestb_local_.read.ix] 15495 .kw_present = TRUE; 15496 ffestp_file.read.read_spec[ffestb_local_.read.ix] 15497 .value_present = FALSE; 15498 ffestp_file.read.read_spec[ffestb_local_.read.ix].value_is_label 15499 = ffestb_local_.read.label; 15500 ffestp_file.read.read_spec[ffestb_local_.read.ix].kw 15501 = ffelex_token_use (t); 15502 return (ffelexHandler) ffestb_R9099_; 15503 15504 default: 15505 break; 15506 } 15507 15508bad: /* :::::::::::::::::::: */ 15509 ffestb_subr_kill_read_ (); 15510 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t); 15511 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 15512} 15513 15514/* ffestb_R9099_ -- "READ" OPEN_PAREN [external-file-unit COMMA [format 15515 COMMA]] NAME 15516 15517 return ffestb_R9099_; // to lexer 15518 15519 Make sure EQUALS here, send next token to expression handler. */ 15520 15521static ffelexHandler 15522ffestb_R9099_ (ffelexToken t) 15523{ 15524 switch (ffelex_token_type (t)) 15525 { 15526 case FFELEX_typeEQUALS: 15527 ffesta_confirmed (); 15528 if (ffestb_local_.read.label) 15529 return (ffelexHandler) ffestb_R90911_; 15530 if (ffestb_local_.read.left) 15531 return (ffelexHandler) 15532 ffeexpr_lhs (ffesta_output_pool, 15533 ffestb_local_.read.context, 15534 (ffeexprCallback) ffestb_R90910_); 15535 return (ffelexHandler) 15536 ffeexpr_rhs (ffesta_output_pool, 15537 ffestb_local_.read.context, 15538 (ffeexprCallback) ffestb_R90910_); 15539 15540 default: 15541 break; 15542 } 15543 15544 ffestb_subr_kill_read_ (); 15545 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t); 15546 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 15547} 15548 15549/* ffestb_R90910_ -- "READ" OPEN_PAREN ... NAME EQUALS expr 15550 15551 (ffestb_R90910_) // to expression handler 15552 15553 Handle COMMA or CLOSE_PAREN here. */ 15554 15555static ffelexHandler 15556ffestb_R90910_ (ffelexToken ft, ffebld expr, ffelexToken t) 15557{ 15558 switch (ffelex_token_type (t)) 15559 { 15560 case FFELEX_typeCOMMA: 15561 case FFELEX_typeCLOSE_PAREN: 15562 if (expr == NULL) 15563 { 15564 if (ffestb_local_.read.context == FFEEXPR_contextFILEFORMAT) 15565 ffestp_file.read.read_spec[ffestb_local_.read.ix] 15566 .value_is_label = TRUE; 15567 else 15568 break; 15569 } 15570 ffestp_file.read.read_spec[ffestb_local_.read.ix].value_present 15571 = TRUE; 15572 ffestp_file.read.read_spec[ffestb_local_.read.ix].value 15573 = ffelex_token_use (ft); 15574 ffestp_file.read.read_spec[ffestb_local_.read.ix].u.expr = expr; 15575 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 15576 return (ffelexHandler) ffestb_R9098_; 15577 return (ffelexHandler) ffestb_R90913_; 15578 15579 default: 15580 break; 15581 } 15582 15583 ffestb_subr_kill_read_ (); 15584 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t); 15585 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 15586} 15587 15588/* ffestb_R90911_ -- "READ" OPEN_PAREN ... NAME EQUALS 15589 15590 return ffestb_R90911_; // to lexer 15591 15592 Handle NUMBER for label here. */ 15593 15594static ffelexHandler 15595ffestb_R90911_ (ffelexToken t) 15596{ 15597 switch (ffelex_token_type (t)) 15598 { 15599 case FFELEX_typeNUMBER: 15600 ffestp_file.read.read_spec[ffestb_local_.read.ix].value_present 15601 = TRUE; 15602 ffestp_file.read.read_spec[ffestb_local_.read.ix].value 15603 = ffelex_token_use (t); 15604 return (ffelexHandler) ffestb_R90912_; 15605 15606 default: 15607 break; 15608 } 15609 15610 ffestb_subr_kill_read_ (); 15611 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t); 15612 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 15613} 15614 15615/* ffestb_R90912_ -- "READ" OPEN_PAREN ... NAME EQUALS NUMBER 15616 15617 return ffestb_R90912_; // to lexer 15618 15619 Handle COMMA or CLOSE_PAREN here. */ 15620 15621static ffelexHandler 15622ffestb_R90912_ (ffelexToken t) 15623{ 15624 switch (ffelex_token_type (t)) 15625 { 15626 case FFELEX_typeCOMMA: 15627 return (ffelexHandler) ffestb_R9098_; 15628 15629 case FFELEX_typeCLOSE_PAREN: 15630 return (ffelexHandler) ffestb_R90913_; 15631 15632 default: 15633 break; 15634 } 15635 15636 ffestb_subr_kill_read_ (); 15637 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t); 15638 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 15639} 15640 15641/* ffestb_R90913_ -- "READ" OPEN_PAREN ... CLOSE_PAREN 15642 15643 return ffestb_R90913_; // to lexer 15644 15645 Handle EOS or SEMICOLON here. 15646 15647 15-Feb-91 JCB 1.1 15648 Fix to allow implied-DO construct here (OPEN_PAREN) -- actually, 15649 don't presume knowledge of what an initial token in an lhs context 15650 is going to be, let ffeexpr_lhs handle that as much as possible. */ 15651 15652static ffelexHandler 15653ffestb_R90913_ (ffelexToken t) 15654{ 15655 switch (ffelex_token_type (t)) 15656 { 15657 case FFELEX_typeEOS: 15658 case FFELEX_typeSEMICOLON: 15659 ffesta_confirmed (); 15660 if (!ffesta_is_inhibited ()) 15661 { 15662 ffestc_R909_start (FALSE); 15663 ffestc_R909_finish (); 15664 } 15665 ffestb_subr_kill_read_ (); 15666 return (ffelexHandler) ffesta_zero (t); 15667 15668 default: 15669 ffesta_confirmed (); 15670 /* Fall through. */ 15671 case FFELEX_typeOPEN_PAREN: /* Could still be assignment!! */ 15672 break; 15673 } 15674 15675 /* If token isn't NAME or OPEN_PAREN, ffeexpr_lhs will ultimately whine 15676 about it, so leave it up to that code. */ 15677 15678 /* EXTENSION: Allow an optional preceding COMMA here if not pedantic. (f2c 15679 provides this extension, as do other compilers, supposedly.) */ 15680 15681 if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA)) 15682 return (ffelexHandler) 15683 ffeexpr_lhs (ffesta_output_pool, 15684 ffestc_context_iolist (), 15685 (ffeexprCallback) ffestb_R90914_); 15686 15687 return (ffelexHandler) (*((ffelexHandler) 15688 ffeexpr_lhs (ffesta_output_pool, 15689 ffestc_context_iolist (), 15690 (ffeexprCallback) ffestb_R90914_))) 15691 (t); 15692} 15693 15694/* ffestb_R90914_ -- "READ(...)" expr 15695 15696 (ffestb_R90914_) // to expression handler 15697 15698 Handle COMMA or EOS/SEMICOLON here. */ 15699 15700static ffelexHandler 15701ffestb_R90914_ (ffelexToken ft, ffebld expr, ffelexToken t) 15702{ 15703 switch (ffelex_token_type (t)) 15704 { 15705 case FFELEX_typeCOMMA: 15706 if (expr == NULL) 15707 break; 15708 15709 ffesta_confirmed (); 15710 if (!ffesta_is_inhibited ()) 15711 ffestc_R909_start (FALSE); 15712 ffestb_subr_kill_read_ (); 15713 15714 if (!ffesta_is_inhibited ()) 15715 ffestc_R909_item (expr, ft); 15716 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 15717 ffestc_context_iolist (), 15718 (ffeexprCallback) ffestb_R90915_); 15719 15720 case FFELEX_typeEOS: 15721 case FFELEX_typeSEMICOLON: 15722 if (expr == NULL) 15723 break; 15724 15725 ffesta_confirmed (); 15726 if (!ffesta_is_inhibited ()) 15727 ffestc_R909_start (FALSE); 15728 ffestb_subr_kill_read_ (); 15729 15730 if (!ffesta_is_inhibited ()) 15731 { 15732 ffestc_R909_item (expr, ft); 15733 ffestc_R909_finish (); 15734 } 15735 return (ffelexHandler) ffesta_zero (t); 15736 15737 default: 15738 break; 15739 } 15740 15741 ffestb_subr_kill_read_ (); 15742 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t); 15743 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 15744} 15745 15746/* ffestb_R90915_ -- "READ(...)" expr COMMA expr 15747 15748 (ffestb_R90915_) // to expression handler 15749 15750 Handle COMMA or EOS/SEMICOLON here. */ 15751 15752static ffelexHandler 15753ffestb_R90915_ (ffelexToken ft, ffebld expr, ffelexToken t) 15754{ 15755 switch (ffelex_token_type (t)) 15756 { 15757 case FFELEX_typeCOMMA: 15758 if (expr == NULL) 15759 break; 15760 if (!ffesta_is_inhibited ()) 15761 ffestc_R909_item (expr, ft); 15762 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 15763 ffestc_context_iolist (), 15764 (ffeexprCallback) ffestb_R90915_); 15765 15766 case FFELEX_typeEOS: 15767 case FFELEX_typeSEMICOLON: 15768 if (expr == NULL) 15769 break; 15770 if (!ffesta_is_inhibited ()) 15771 { 15772 ffestc_R909_item (expr, ft); 15773 ffestc_R909_finish (); 15774 } 15775 return (ffelexHandler) ffesta_zero (t); 15776 15777 default: 15778 break; 15779 } 15780 15781 if (!ffesta_is_inhibited ()) 15782 ffestc_R909_finish (); 15783 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t); 15784 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 15785} 15786 15787/* ffestb_R910 -- Parse the WRITE statement 15788 15789 return ffestb_R910; // to lexer 15790 15791 Make sure the statement has a valid form for the WRITE 15792 statement. If it does, implement the statement. */ 15793 15794ffelexHandler 15795ffestb_R910 (ffelexToken t) 15796{ 15797 ffestpWriteIx ix; 15798 15799 switch (ffelex_token_type (ffesta_tokens[0])) 15800 { 15801 case FFELEX_typeNAME: 15802 if (ffesta_first_kw != FFESTR_firstWRITE) 15803 goto bad_0; /* :::::::::::::::::::: */ 15804 switch (ffelex_token_type (t)) 15805 { 15806 case FFELEX_typeCOMMA: 15807 case FFELEX_typeCOLONCOLON: 15808 case FFELEX_typeEOS: 15809 case FFELEX_typeSEMICOLON: 15810 case FFELEX_typeNAME: 15811 case FFELEX_typeNUMBER: 15812 ffesta_confirmed (); /* Error, but clearly intended. */ 15813 goto bad_1; /* :::::::::::::::::::: */ 15814 15815 default: 15816 goto bad_1; /* :::::::::::::::::::: */ 15817 15818 case FFELEX_typeOPEN_PAREN: 15819 for (ix = 0; ix < FFESTP_writeix; ++ix) 15820 ffestp_file.write.write_spec[ix].kw_or_val_present = FALSE; 15821 return (ffelexHandler) ffestb_R9101_; 15822 } 15823 15824 case FFELEX_typeNAMES: 15825 if (ffesta_first_kw != FFESTR_firstWRITE) 15826 goto bad_0; /* :::::::::::::::::::: */ 15827 switch (ffelex_token_type (t)) 15828 { 15829 case FFELEX_typeEOS: 15830 case FFELEX_typeSEMICOLON: 15831 case FFELEX_typeCOMMA: 15832 case FFELEX_typeCOLONCOLON: 15833 ffesta_confirmed (); /* Error, but clearly intended. */ 15834 goto bad_1; /* :::::::::::::::::::: */ 15835 15836 default: 15837 goto bad_1; /* :::::::::::::::::::: */ 15838 15839 case FFELEX_typeOPEN_PAREN: 15840 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlWRITE) 15841 goto bad_0; /* :::::::::::::::::::: */ 15842 15843 for (ix = 0; ix < FFESTP_writeix; ++ix) 15844 ffestp_file.write.write_spec[ix].kw_or_val_present = FALSE; 15845 return (ffelexHandler) ffestb_R9101_; 15846 } 15847 15848 default: 15849 goto bad_0; /* :::::::::::::::::::: */ 15850 } 15851 15852bad_0: /* :::::::::::::::::::: */ 15853 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", ffesta_tokens[0]); 15854 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 15855 15856bad_1: /* :::::::::::::::::::: */ 15857 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t); 15858 return (ffelexHandler) ffelex_swallow_tokens (t, 15859 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 15860} 15861 15862/* ffestb_R9101_ -- "WRITE" OPEN_PAREN 15863 15864 return ffestb_R9101_; // to lexer 15865 15866 Handle expr construct (not NAME=expr construct) here. */ 15867 15868static ffelexHandler 15869ffestb_R9101_ (ffelexToken t) 15870{ 15871 switch (ffelex_token_type (t)) 15872 { 15873 case FFELEX_typeNAME: 15874 ffesta_tokens[1] = ffelex_token_use (t); 15875 return (ffelexHandler) ffestb_R9102_; 15876 15877 default: 15878 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 15879 FFEEXPR_contextFILEUNIT, (ffeexprCallback) ffestb_R9103_))) 15880 (t); 15881 } 15882} 15883 15884/* ffestb_R9102_ -- "WRITE" OPEN_PAREN NAME 15885 15886 return ffestb_R9102_; // to lexer 15887 15888 If EQUALS here, go to states that handle it. Else, send NAME and this 15889 token thru expression handler. */ 15890 15891static ffelexHandler 15892ffestb_R9102_ (ffelexToken t) 15893{ 15894 ffelexHandler next; 15895 ffelexToken nt; 15896 15897 switch (ffelex_token_type (t)) 15898 { 15899 case FFELEX_typeEQUALS: 15900 nt = ffesta_tokens[1]; 15901 next = (ffelexHandler) ffestb_R9107_ (nt); 15902 ffelex_token_kill (nt); 15903 return (ffelexHandler) (*next) (t); 15904 15905 default: 15906 nt = ffesta_tokens[1]; 15907 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 15908 FFEEXPR_contextFILEUNIT, (ffeexprCallback) ffestb_R9103_))) 15909 (nt); 15910 ffelex_token_kill (nt); 15911 return (ffelexHandler) (*next) (t); 15912 } 15913} 15914 15915/* ffestb_R9103_ -- "WRITE" OPEN_PAREN expr [CLOSE_PAREN] 15916 15917 (ffestb_R9103_) // to expression handler 15918 15919 Handle COMMA or EOS/SEMICOLON here. */ 15920 15921static ffelexHandler 15922ffestb_R9103_ (ffelexToken ft, ffebld expr, ffelexToken t) 15923{ 15924 switch (ffelex_token_type (t)) 15925 { 15926 case FFELEX_typeCOMMA: 15927 case FFELEX_typeCLOSE_PAREN: 15928 if (expr == NULL) 15929 break; 15930 ffestp_file.write.write_spec[FFESTP_writeixUNIT].kw_or_val_present 15931 = TRUE; 15932 ffestp_file.write.write_spec[FFESTP_writeixUNIT].kw_present = FALSE; 15933 ffestp_file.write.write_spec[FFESTP_writeixUNIT].value_present = TRUE; 15934 ffestp_file.write.write_spec[FFESTP_writeixUNIT].value_is_label 15935 = FALSE; 15936 ffestp_file.write.write_spec[FFESTP_writeixUNIT].value 15937 = ffelex_token_use (ft); 15938 ffestp_file.write.write_spec[FFESTP_writeixUNIT].u.expr = expr; 15939 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 15940 return (ffelexHandler) ffestb_R9104_; 15941 return (ffelexHandler) ffestb_R91012_; 15942 15943 default: 15944 break; 15945 } 15946 15947 ffestb_subr_kill_write_ (); 15948 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t); 15949 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 15950} 15951 15952/* ffestb_R9104_ -- "WRITE" OPEN_PAREN expr COMMA 15953 15954 return ffestb_R9104_; // to lexer 15955 15956 Handle expr construct (not NAME=expr construct) here. */ 15957 15958static ffelexHandler 15959ffestb_R9104_ (ffelexToken t) 15960{ 15961 switch (ffelex_token_type (t)) 15962 { 15963 case FFELEX_typeNAME: 15964 ffesta_tokens[1] = ffelex_token_use (t); 15965 return (ffelexHandler) ffestb_R9105_; 15966 15967 default: 15968 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 15969 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9106_))) 15970 (t); 15971 } 15972} 15973 15974/* ffestb_R9105_ -- "WRITE" OPEN_PAREN expr COMMA NAME 15975 15976 return ffestb_R9105_; // to lexer 15977 15978 If EQUALS here, go to states that handle it. Else, send NAME and this 15979 token thru expression handler. */ 15980 15981static ffelexHandler 15982ffestb_R9105_ (ffelexToken t) 15983{ 15984 ffelexHandler next; 15985 ffelexToken nt; 15986 15987 switch (ffelex_token_type (t)) 15988 { 15989 case FFELEX_typeEQUALS: 15990 nt = ffesta_tokens[1]; 15991 next = (ffelexHandler) ffestb_R9107_ (nt); 15992 ffelex_token_kill (nt); 15993 return (ffelexHandler) (*next) (t); 15994 15995 default: 15996 nt = ffesta_tokens[1]; 15997 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 15998 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9106_))) 15999 (nt); 16000 ffelex_token_kill (nt); 16001 return (ffelexHandler) (*next) (t); 16002 } 16003} 16004 16005/* ffestb_R9106_ -- "WRITE" OPEN_PAREN expr COMMA expr 16006 16007 (ffestb_R9106_) // to expression handler 16008 16009 Handle COMMA or CLOSE_PAREN here. */ 16010 16011static ffelexHandler 16012ffestb_R9106_ (ffelexToken ft, ffebld expr, ffelexToken t) 16013{ 16014 switch (ffelex_token_type (t)) 16015 { 16016 case FFELEX_typeCOMMA: 16017 case FFELEX_typeCLOSE_PAREN: 16018 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].kw_or_val_present 16019 = TRUE; 16020 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].kw_present = FALSE; 16021 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].value_present = TRUE; 16022 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].value_is_label 16023 = (expr == NULL); 16024 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].value 16025 = ffelex_token_use (ft); 16026 ffestp_file.write.write_spec[FFESTP_writeixFORMAT].u.expr = expr; 16027 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 16028 return (ffelexHandler) ffestb_R9107_; 16029 return (ffelexHandler) ffestb_R91012_; 16030 16031 default: 16032 break; 16033 } 16034 16035 ffestb_subr_kill_write_ (); 16036 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t); 16037 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 16038} 16039 16040/* ffestb_R9107_ -- "WRITE" OPEN_PAREN [external-file-unit COMMA [format 16041 COMMA]] 16042 16043 return ffestb_R9107_; // to lexer 16044 16045 Handle expr construct (not NAME=expr construct) here. */ 16046 16047static ffelexHandler 16048ffestb_R9107_ (ffelexToken t) 16049{ 16050 ffestrGenio kw; 16051 16052 ffestb_local_.write.label = FALSE; 16053 16054 switch (ffelex_token_type (t)) 16055 { 16056 case FFELEX_typeNAME: 16057 kw = ffestr_genio (t); 16058 switch (kw) 16059 { 16060 case FFESTR_genioADVANCE: 16061 ffestb_local_.write.ix = FFESTP_writeixADVANCE; 16062 ffestb_local_.write.left = FALSE; 16063 ffestb_local_.write.context = FFEEXPR_contextFILEDFCHAR; 16064 break; 16065 16066 case FFESTR_genioEOR: 16067 ffestb_local_.write.ix = FFESTP_writeixEOR; 16068 ffestb_local_.write.label = TRUE; 16069 break; 16070 16071 case FFESTR_genioERR: 16072 ffestb_local_.write.ix = FFESTP_writeixERR; 16073 ffestb_local_.write.label = TRUE; 16074 break; 16075 16076 case FFESTR_genioFMT: 16077 ffestb_local_.write.ix = FFESTP_writeixFORMAT; 16078 ffestb_local_.write.left = FALSE; 16079 ffestb_local_.write.context = FFEEXPR_contextFILEFORMAT; 16080 break; 16081 16082 case FFESTR_genioIOSTAT: 16083 ffestb_local_.write.ix = FFESTP_writeixIOSTAT; 16084 ffestb_local_.write.left = TRUE; 16085 ffestb_local_.write.context = FFEEXPR_contextFILEINT; 16086 break; 16087 16088 case FFESTR_genioNML: 16089 ffestb_local_.write.ix = FFESTP_writeixFORMAT; 16090 ffestb_local_.write.left = TRUE; 16091 ffestb_local_.write.context = FFEEXPR_contextFILENAMELIST; 16092 break; 16093 16094 case FFESTR_genioREC: 16095 ffestb_local_.write.ix = FFESTP_writeixREC; 16096 ffestb_local_.write.left = FALSE; 16097 ffestb_local_.write.context = FFEEXPR_contextFILENUM; 16098 break; 16099 16100 case FFESTR_genioUNIT: 16101 ffestb_local_.write.ix = FFESTP_writeixUNIT; 16102 ffestb_local_.write.left = FALSE; 16103 ffestb_local_.write.context = FFEEXPR_contextFILEUNIT; 16104 break; 16105 16106 default: 16107 goto bad; /* :::::::::::::::::::: */ 16108 } 16109 if (ffestp_file.write.write_spec[ffestb_local_.write.ix] 16110 .kw_or_val_present) 16111 break; /* Can't specify a keyword twice! */ 16112 ffestp_file.write.write_spec[ffestb_local_.write.ix] 16113 .kw_or_val_present = TRUE; 16114 ffestp_file.write.write_spec[ffestb_local_.write.ix] 16115 .kw_present = TRUE; 16116 ffestp_file.write.write_spec[ffestb_local_.write.ix] 16117 .value_present = FALSE; 16118 ffestp_file.write.write_spec[ffestb_local_.write.ix].value_is_label 16119 = ffestb_local_.write.label; 16120 ffestp_file.write.write_spec[ffestb_local_.write.ix].kw 16121 = ffelex_token_use (t); 16122 return (ffelexHandler) ffestb_R9108_; 16123 16124 default: 16125 break; 16126 } 16127 16128bad: /* :::::::::::::::::::: */ 16129 ffestb_subr_kill_write_ (); 16130 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t); 16131 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 16132} 16133 16134/* ffestb_R9108_ -- "WRITE" OPEN_PAREN [external-file-unit COMMA [format 16135 COMMA]] NAME 16136 16137 return ffestb_R9108_; // to lexer 16138 16139 Make sure EQUALS here, send next token to expression handler. */ 16140 16141static ffelexHandler 16142ffestb_R9108_ (ffelexToken t) 16143{ 16144 switch (ffelex_token_type (t)) 16145 { 16146 case FFELEX_typeEQUALS: 16147 ffesta_confirmed (); 16148 if (ffestb_local_.write.label) 16149 return (ffelexHandler) ffestb_R91010_; 16150 if (ffestb_local_.write.left) 16151 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 16152 ffestb_local_.write.context, 16153 (ffeexprCallback) ffestb_R9109_); 16154 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 16155 ffestb_local_.write.context, 16156 (ffeexprCallback) ffestb_R9109_); 16157 16158 default: 16159 break; 16160 } 16161 16162 ffestb_subr_kill_write_ (); 16163 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t); 16164 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 16165} 16166 16167/* ffestb_R9109_ -- "WRITE" OPEN_PAREN ... NAME EQUALS expr 16168 16169 (ffestb_R9109_) // to expression handler 16170 16171 Handle COMMA or CLOSE_PAREN here. */ 16172 16173static ffelexHandler 16174ffestb_R9109_ (ffelexToken ft, ffebld expr, ffelexToken t) 16175{ 16176 switch (ffelex_token_type (t)) 16177 { 16178 case FFELEX_typeCOMMA: 16179 case FFELEX_typeCLOSE_PAREN: 16180 if (expr == NULL) 16181 { 16182 if (ffestb_local_.write.context == FFEEXPR_contextFILEFORMAT) 16183 ffestp_file.write.write_spec[ffestb_local_.write.ix] 16184 .value_is_label = TRUE; 16185 else 16186 break; 16187 } 16188 ffestp_file.write.write_spec[ffestb_local_.write.ix].value_present 16189 = TRUE; 16190 ffestp_file.write.write_spec[ffestb_local_.write.ix].value 16191 = ffelex_token_use (ft); 16192 ffestp_file.write.write_spec[ffestb_local_.write.ix].u.expr = expr; 16193 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 16194 return (ffelexHandler) ffestb_R9107_; 16195 return (ffelexHandler) ffestb_R91012_; 16196 16197 default: 16198 break; 16199 } 16200 16201 ffestb_subr_kill_write_ (); 16202 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t); 16203 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 16204} 16205 16206/* ffestb_R91010_ -- "WRITE" OPEN_PAREN ... NAME EQUALS 16207 16208 return ffestb_R91010_; // to lexer 16209 16210 Handle NUMBER for label here. */ 16211 16212static ffelexHandler 16213ffestb_R91010_ (ffelexToken t) 16214{ 16215 switch (ffelex_token_type (t)) 16216 { 16217 case FFELEX_typeNUMBER: 16218 ffestp_file.write.write_spec[ffestb_local_.write.ix].value_present 16219 = TRUE; 16220 ffestp_file.write.write_spec[ffestb_local_.write.ix].value 16221 = ffelex_token_use (t); 16222 return (ffelexHandler) ffestb_R91011_; 16223 16224 default: 16225 break; 16226 } 16227 16228 ffestb_subr_kill_write_ (); 16229 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t); 16230 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 16231} 16232 16233/* ffestb_R91011_ -- "WRITE" OPEN_PAREN ... NAME EQUALS NUMBER 16234 16235 return ffestb_R91011_; // to lexer 16236 16237 Handle COMMA or CLOSE_PAREN here. */ 16238 16239static ffelexHandler 16240ffestb_R91011_ (ffelexToken t) 16241{ 16242 switch (ffelex_token_type (t)) 16243 { 16244 case FFELEX_typeCOMMA: 16245 return (ffelexHandler) ffestb_R9107_; 16246 16247 case FFELEX_typeCLOSE_PAREN: 16248 return (ffelexHandler) ffestb_R91012_; 16249 16250 default: 16251 break; 16252 } 16253 16254 ffestb_subr_kill_write_ (); 16255 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t); 16256 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 16257} 16258 16259/* ffestb_R91012_ -- "WRITE" OPEN_PAREN ... CLOSE_PAREN 16260 16261 return ffestb_R91012_; // to lexer 16262 16263 Handle EOS or SEMICOLON here. */ 16264 16265static ffelexHandler 16266ffestb_R91012_ (ffelexToken t) 16267{ 16268 switch (ffelex_token_type (t)) 16269 { 16270 case FFELEX_typeEOS: 16271 case FFELEX_typeSEMICOLON: 16272 ffesta_confirmed (); 16273 if (!ffesta_is_inhibited ()) 16274 { 16275 ffestc_R910_start (); 16276 ffestc_R910_finish (); 16277 } 16278 ffestb_subr_kill_write_ (); 16279 return (ffelexHandler) ffesta_zero (t); 16280 16281 default: 16282 ffesta_confirmed (); 16283 /* Fall through. */ 16284 case FFELEX_typeOPEN_PAREN: /* Could still be assignment!! */ 16285 16286 /* EXTENSION: Allow an optional preceding COMMA here if not pedantic. 16287 (f2c provides this extension, as do other compilers, supposedly.) */ 16288 16289 if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA)) 16290 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 16291 ffestc_context_iolist (), (ffeexprCallback) ffestb_R91013_); 16292 16293 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 16294 ffestc_context_iolist (), (ffeexprCallback) ffestb_R91013_))) 16295 (t); 16296 16297 case FFELEX_typeEQUALS: 16298 case FFELEX_typePOINTS: 16299 break; 16300 } 16301 16302 ffestb_subr_kill_write_ (); 16303 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t); 16304 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 16305} 16306 16307/* ffestb_R91013_ -- "WRITE(...)" expr 16308 16309 (ffestb_R91013_) // to expression handler 16310 16311 Handle COMMA or EOS/SEMICOLON here. */ 16312 16313static ffelexHandler 16314ffestb_R91013_ (ffelexToken ft, ffebld expr, ffelexToken t) 16315{ 16316 switch (ffelex_token_type (t)) 16317 { 16318 case FFELEX_typeCOMMA: 16319 if (expr == NULL) 16320 break; 16321 16322 ffesta_confirmed (); 16323 if (!ffesta_is_inhibited ()) 16324 ffestc_R910_start (); 16325 ffestb_subr_kill_write_ (); 16326 16327 if (!ffesta_is_inhibited ()) 16328 ffestc_R910_item (expr, ft); 16329 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 16330 ffestc_context_iolist (), (ffeexprCallback) ffestb_R91014_); 16331 16332 case FFELEX_typeEOS: 16333 case FFELEX_typeSEMICOLON: 16334 if (expr == NULL) 16335 break; 16336 16337 ffesta_confirmed (); 16338 if (!ffesta_is_inhibited ()) 16339 ffestc_R910_start (); 16340 ffestb_subr_kill_write_ (); 16341 16342 if (!ffesta_is_inhibited ()) 16343 { 16344 ffestc_R910_item (expr, ft); 16345 ffestc_R910_finish (); 16346 } 16347 return (ffelexHandler) ffesta_zero (t); 16348 16349 default: 16350 break; 16351 } 16352 16353 ffestb_subr_kill_write_ (); 16354 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t); 16355 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 16356} 16357 16358/* ffestb_R91014_ -- "WRITE(...)" expr COMMA expr 16359 16360 (ffestb_R91014_) // to expression handler 16361 16362 Handle COMMA or EOS/SEMICOLON here. */ 16363 16364static ffelexHandler 16365ffestb_R91014_ (ffelexToken ft, ffebld expr, ffelexToken t) 16366{ 16367 switch (ffelex_token_type (t)) 16368 { 16369 case FFELEX_typeCOMMA: 16370 if (expr == NULL) 16371 break; 16372 if (!ffesta_is_inhibited ()) 16373 ffestc_R910_item (expr, ft); 16374 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 16375 ffestc_context_iolist (), (ffeexprCallback) ffestb_R91014_); 16376 16377 case FFELEX_typeEOS: 16378 case FFELEX_typeSEMICOLON: 16379 if (expr == NULL) 16380 break; 16381 if (!ffesta_is_inhibited ()) 16382 { 16383 ffestc_R910_item (expr, ft); 16384 ffestc_R910_finish (); 16385 } 16386 return (ffelexHandler) ffesta_zero (t); 16387 16388 default: 16389 break; 16390 } 16391 16392 if (!ffesta_is_inhibited ()) 16393 ffestc_R910_finish (); 16394 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t); 16395 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 16396} 16397 16398/* ffestb_R911 -- Parse the PRINT statement 16399 16400 return ffestb_R911; // to lexer 16401 16402 Make sure the statement has a valid form for the PRINT 16403 statement. If it does, implement the statement. */ 16404 16405ffelexHandler 16406ffestb_R911 (ffelexToken t) 16407{ 16408 ffelexHandler next; 16409 ffestpPrintIx ix; 16410 16411 switch (ffelex_token_type (ffesta_tokens[0])) 16412 { 16413 case FFELEX_typeNAME: 16414 if (ffesta_first_kw != FFESTR_firstPRINT) 16415 goto bad_0; /* :::::::::::::::::::: */ 16416 switch (ffelex_token_type (t)) 16417 { 16418 case FFELEX_typeCOMMA: 16419 case FFELEX_typeCOLONCOLON: 16420 case FFELEX_typeEOS: 16421 case FFELEX_typeSEMICOLON: 16422 ffesta_confirmed (); /* Error, but clearly intended. */ 16423 goto bad_1; /* :::::::::::::::::::: */ 16424 16425 case FFELEX_typeEQUALS: 16426 case FFELEX_typePOINTS: 16427 case FFELEX_typeCOLON: 16428 goto bad_1; /* :::::::::::::::::::: */ 16429 16430 case FFELEX_typeNAME: 16431 case FFELEX_typeNUMBER: 16432 ffesta_confirmed (); 16433 break; 16434 16435 default: 16436 break; 16437 } 16438 16439 for (ix = 0; ix < FFESTP_printix; ++ix) 16440 ffestp_file.print.print_spec[ix].kw_or_val_present = FALSE; 16441 return (ffelexHandler) (*((ffelexHandler) 16442 ffeexpr_rhs (ffesta_output_pool, 16443 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9111_))) 16444 (t); 16445 16446 case FFELEX_typeNAMES: 16447 if (ffesta_first_kw != FFESTR_firstPRINT) 16448 goto bad_0; /* :::::::::::::::::::: */ 16449 switch (ffelex_token_type (t)) 16450 { 16451 case FFELEX_typeEOS: 16452 case FFELEX_typeSEMICOLON: 16453 case FFELEX_typeCOMMA: 16454 ffesta_confirmed (); 16455 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlPRINT) 16456 break; 16457 goto bad_1; /* :::::::::::::::::::: */ 16458 16459 case FFELEX_typeCOLONCOLON: 16460 ffesta_confirmed (); /* Error, but clearly intended. */ 16461 goto bad_1; /* :::::::::::::::::::: */ 16462 16463 case FFELEX_typeEQUALS: 16464 case FFELEX_typePOINTS: 16465 case FFELEX_typeCOLON: 16466 goto bad_1; /* :::::::::::::::::::: */ 16467 16468 default: 16469 break; 16470 } 16471 for (ix = 0; ix < FFESTP_printix; ++ix) 16472 ffestp_file.print.print_spec[ix].kw_or_val_present = FALSE; 16473 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 16474 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9111_); 16475 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0], 16476 FFESTR_firstlPRINT); 16477 if (next == NULL) 16478 return (ffelexHandler) ffelex_swallow_tokens (t, 16479 (ffelexHandler) ffesta_zero); 16480 return (ffelexHandler) (*next) (t); 16481 16482 default: 16483 goto bad_0; /* :::::::::::::::::::: */ 16484 } 16485 16486bad_0: /* :::::::::::::::::::: */ 16487 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", ffesta_tokens[0]); 16488 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 16489 16490bad_1: /* :::::::::::::::::::: */ 16491 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", t); 16492 return (ffelexHandler) ffelex_swallow_tokens (t, 16493 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 16494} 16495 16496/* ffestb_R9111_ -- "PRINT" expr 16497 16498 (ffestb_R9111_) // to expression handler 16499 16500 Make sure the next token is a COMMA or EOS/SEMICOLON. */ 16501 16502static ffelexHandler 16503ffestb_R9111_ (ffelexToken ft, ffebld expr, ffelexToken t) 16504{ 16505 switch (ffelex_token_type (t)) 16506 { 16507 case FFELEX_typeEOS: 16508 case FFELEX_typeSEMICOLON: 16509 case FFELEX_typeCOMMA: 16510 ffesta_confirmed (); 16511 ffestp_file.print.print_spec[FFESTP_printixFORMAT].kw_or_val_present 16512 = TRUE; 16513 ffestp_file.print.print_spec[FFESTP_printixFORMAT].kw_present = FALSE; 16514 ffestp_file.print.print_spec[FFESTP_printixFORMAT].value_present = TRUE; 16515 ffestp_file.print.print_spec[FFESTP_printixFORMAT].value_is_label 16516 = (expr == NULL); 16517 ffestp_file.print.print_spec[FFESTP_printixFORMAT].value 16518 = ffelex_token_use (ft); 16519 ffestp_file.print.print_spec[FFESTP_printixFORMAT].u.expr = expr; 16520 if (!ffesta_is_inhibited ()) 16521 ffestc_R911_start (); 16522 ffestb_subr_kill_print_ (); 16523 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 16524 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 16525 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R9112_); 16526 if (!ffesta_is_inhibited ()) 16527 ffestc_R911_finish (); 16528 return (ffelexHandler) ffesta_zero (t); 16529 16530 default: 16531 break; 16532 } 16533 16534 ffestb_subr_kill_print_ (); 16535 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", t); 16536 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 16537} 16538 16539/* ffestb_R9112_ -- "PRINT" expr COMMA expr 16540 16541 (ffestb_R9112_) // to expression handler 16542 16543 Handle COMMA or EOS/SEMICOLON here. */ 16544 16545static ffelexHandler 16546ffestb_R9112_ (ffelexToken ft, ffebld expr, ffelexToken t) 16547{ 16548 switch (ffelex_token_type (t)) 16549 { 16550 case FFELEX_typeCOMMA: 16551 if (expr == NULL) 16552 break; 16553 if (!ffesta_is_inhibited ()) 16554 ffestc_R911_item (expr, ft); 16555 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 16556 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R9112_); 16557 16558 case FFELEX_typeEOS: 16559 case FFELEX_typeSEMICOLON: 16560 if (expr == NULL) 16561 break; 16562 if (!ffesta_is_inhibited ()) 16563 { 16564 ffestc_R911_item (expr, ft); 16565 ffestc_R911_finish (); 16566 } 16567 return (ffelexHandler) ffesta_zero (t); 16568 16569 default: 16570 break; 16571 } 16572 16573 if (!ffesta_is_inhibited ()) 16574 ffestc_R911_finish (); 16575 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", t); 16576 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 16577} 16578 16579/* ffestb_R923 -- Parse an INQUIRE statement 16580 16581 return ffestb_R923; // to lexer 16582 16583 Make sure the statement has a valid form for an INQUIRE statement. 16584 If it does, implement the statement. */ 16585 16586ffelexHandler 16587ffestb_R923 (ffelexToken t) 16588{ 16589 ffestpInquireIx ix; 16590 16591 switch (ffelex_token_type (ffesta_tokens[0])) 16592 { 16593 case FFELEX_typeNAME: 16594 if (ffesta_first_kw != FFESTR_firstINQUIRE) 16595 goto bad_0; /* :::::::::::::::::::: */ 16596 break; 16597 16598 case FFELEX_typeNAMES: 16599 if (ffesta_first_kw != FFESTR_firstINQUIRE) 16600 goto bad_0; /* :::::::::::::::::::: */ 16601 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlINQUIRE) 16602 goto bad_0; /* :::::::::::::::::::: */ 16603 break; 16604 16605 default: 16606 goto bad_0; /* :::::::::::::::::::: */ 16607 } 16608 16609 switch (ffelex_token_type (t)) 16610 { 16611 case FFELEX_typeOPEN_PAREN: 16612 break; 16613 16614 case FFELEX_typeEOS: 16615 case FFELEX_typeSEMICOLON: 16616 case FFELEX_typeCOMMA: 16617 case FFELEX_typeCOLONCOLON: 16618 ffesta_confirmed (); /* Error, but clearly intended. */ 16619 goto bad_1; /* :::::::::::::::::::: */ 16620 16621 default: 16622 goto bad_1; /* :::::::::::::::::::: */ 16623 } 16624 16625 for (ix = 0; ix < FFESTP_inquireix; ++ix) 16626 ffestp_file.inquire.inquire_spec[ix].kw_or_val_present = FALSE; 16627 16628 ffestb_local_.inquire.may_be_iolength = TRUE; 16629 return (ffelexHandler) ffestb_R9231_; 16630 16631bad_0: /* :::::::::::::::::::: */ 16632 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", ffesta_tokens[0]); 16633 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 16634 16635bad_1: /* :::::::::::::::::::: */ 16636 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t); 16637 return (ffelexHandler) ffelex_swallow_tokens (t, 16638 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 16639} 16640 16641/* ffestb_R9231_ -- "INQUIRE" OPEN_PAREN 16642 16643 return ffestb_R9231_; // to lexer 16644 16645 Handle expr construct (not NAME=expr construct) here. */ 16646 16647static ffelexHandler 16648ffestb_R9231_ (ffelexToken t) 16649{ 16650 switch (ffelex_token_type (t)) 16651 { 16652 case FFELEX_typeNAME: 16653 ffesta_tokens[1] = ffelex_token_use (t); 16654 return (ffelexHandler) ffestb_R9232_; 16655 16656 default: 16657 ffestb_local_.inquire.may_be_iolength = FALSE; 16658 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 16659 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9233_))) 16660 (t); 16661 } 16662} 16663 16664/* ffestb_R9232_ -- "INQUIRE" OPEN_PAREN NAME 16665 16666 return ffestb_R9232_; // to lexer 16667 16668 If EQUALS here, go to states that handle it. Else, send NAME and this 16669 token thru expression handler. */ 16670 16671static ffelexHandler 16672ffestb_R9232_ (ffelexToken t) 16673{ 16674 ffelexHandler next; 16675 ffelexToken nt; 16676 16677 switch (ffelex_token_type (t)) 16678 { 16679 case FFELEX_typeEQUALS: 16680 nt = ffesta_tokens[1]; 16681 next = (ffelexHandler) ffestb_R9234_ (nt); 16682 ffelex_token_kill (nt); 16683 return (ffelexHandler) (*next) (t); 16684 16685 default: 16686 ffestb_local_.inquire.may_be_iolength = FALSE; 16687 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 16688 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9233_))) 16689 (ffesta_tokens[1]); 16690 ffelex_token_kill (ffesta_tokens[1]); 16691 return (ffelexHandler) (*next) (t); 16692 } 16693} 16694 16695/* ffestb_R9233_ -- "INQUIRE" OPEN_PAREN expr 16696 16697 (ffestb_R9233_) // to expression handler 16698 16699 Handle COMMA or CLOSE_PAREN here. */ 16700 16701static ffelexHandler 16702ffestb_R9233_ (ffelexToken ft, ffebld expr, ffelexToken t) 16703{ 16704 switch (ffelex_token_type (t)) 16705 { 16706 case FFELEX_typeCOMMA: 16707 case FFELEX_typeCLOSE_PAREN: 16708 if (expr == NULL) 16709 break; 16710 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw_or_val_present 16711 = TRUE; 16712 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw_present = FALSE; 16713 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value_present = TRUE; 16714 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value_is_label 16715 = FALSE; 16716 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value 16717 = ffelex_token_use (ft); 16718 ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].u.expr = expr; 16719 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 16720 return (ffelexHandler) ffestb_R9234_; 16721 return (ffelexHandler) ffestb_R9239_; 16722 16723 default: 16724 break; 16725 } 16726 16727 ffestb_subr_kill_inquire_ (); 16728 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t); 16729 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 16730} 16731 16732/* ffestb_R9234_ -- "INQUIRE" OPEN_PAREN [external-file-unit COMMA] 16733 16734 return ffestb_R9234_; // to lexer 16735 16736 Handle expr construct (not NAME=expr construct) here. */ 16737 16738static ffelexHandler 16739ffestb_R9234_ (ffelexToken t) 16740{ 16741 ffestrInquire kw; 16742 16743 ffestb_local_.inquire.label = FALSE; 16744 16745 switch (ffelex_token_type (t)) 16746 { 16747 case FFELEX_typeNAME: 16748 kw = ffestr_inquire (t); 16749 if (kw != FFESTR_inquireIOLENGTH) 16750 ffestb_local_.inquire.may_be_iolength = FALSE; 16751 switch (kw) 16752 { 16753 case FFESTR_inquireACCESS: 16754 ffestb_local_.inquire.ix = FFESTP_inquireixACCESS; 16755 ffestb_local_.inquire.left = TRUE; 16756 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR; 16757 break; 16758 16759 case FFESTR_inquireACTION: 16760 ffestb_local_.inquire.ix = FFESTP_inquireixACTION; 16761 ffestb_local_.inquire.left = TRUE; 16762 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR; 16763 break; 16764 16765 case FFESTR_inquireBLANK: 16766 ffestb_local_.inquire.ix = FFESTP_inquireixBLANK; 16767 ffestb_local_.inquire.left = TRUE; 16768 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR; 16769 break; 16770 16771 case FFESTR_inquireCARRIAGECONTROL: 16772 ffestb_local_.inquire.ix = FFESTP_inquireixCARRIAGECONTROL; 16773 ffestb_local_.inquire.left = TRUE; 16774 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR; 16775 break; 16776 16777 case FFESTR_inquireDEFAULTFILE: 16778 ffestb_local_.inquire.ix = FFESTP_inquireixDEFAULTFILE; 16779 ffestb_local_.inquire.left = FALSE; 16780 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR; 16781 break; 16782 16783 case FFESTR_inquireDELIM: 16784 ffestb_local_.inquire.ix = FFESTP_inquireixDELIM; 16785 ffestb_local_.inquire.left = TRUE; 16786 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR; 16787 break; 16788 16789 case FFESTR_inquireDIRECT: 16790 ffestb_local_.inquire.ix = FFESTP_inquireixDIRECT; 16791 ffestb_local_.inquire.left = TRUE; 16792 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR; 16793 break; 16794 16795 case FFESTR_inquireERR: 16796 ffestb_local_.inquire.ix = FFESTP_inquireixERR; 16797 ffestb_local_.inquire.label = TRUE; 16798 break; 16799 16800 case FFESTR_inquireEXIST: 16801 ffestb_local_.inquire.ix = FFESTP_inquireixEXIST; 16802 ffestb_local_.inquire.left = TRUE; 16803 ffestb_local_.inquire.context = FFEEXPR_contextFILELOG; 16804 break; 16805 16806 case FFESTR_inquireFILE: 16807 ffestb_local_.inquire.ix = FFESTP_inquireixFILE; 16808 ffestb_local_.inquire.left = FALSE; 16809 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR; 16810 break; 16811 16812 case FFESTR_inquireFORM: 16813 ffestb_local_.inquire.ix = FFESTP_inquireixFORM; 16814 ffestb_local_.inquire.left = TRUE; 16815 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR; 16816 break; 16817 16818 case FFESTR_inquireFORMATTED: 16819 ffestb_local_.inquire.ix = FFESTP_inquireixFORMATTED; 16820 ffestb_local_.inquire.left = TRUE; 16821 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR; 16822 break; 16823 16824 case FFESTR_inquireIOLENGTH: 16825 if (!ffestb_local_.inquire.may_be_iolength) 16826 goto bad; /* :::::::::::::::::::: */ 16827 ffestb_local_.inquire.ix = FFESTP_inquireixIOLENGTH; 16828 ffestb_local_.inquire.left = TRUE; 16829 ffestb_local_.inquire.context = FFEEXPR_contextFILEINT; 16830 break; 16831 16832 case FFESTR_inquireIOSTAT: 16833 ffestb_local_.inquire.ix = FFESTP_inquireixIOSTAT; 16834 ffestb_local_.inquire.left = TRUE; 16835 ffestb_local_.inquire.context = FFEEXPR_contextFILEINT; 16836 break; 16837 16838 case FFESTR_inquireKEYED: 16839 ffestb_local_.inquire.ix = FFESTP_inquireixKEYED; 16840 ffestb_local_.inquire.left = TRUE; 16841 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR; 16842 break; 16843 16844 case FFESTR_inquireNAME: 16845 ffestb_local_.inquire.ix = FFESTP_inquireixNAME; 16846 ffestb_local_.inquire.left = TRUE; 16847 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR; 16848 break; 16849 16850 case FFESTR_inquireNAMED: 16851 ffestb_local_.inquire.ix = FFESTP_inquireixNAMED; 16852 ffestb_local_.inquire.left = TRUE; 16853 ffestb_local_.inquire.context = FFEEXPR_contextFILELOG; 16854 break; 16855 16856 case FFESTR_inquireNEXTREC: 16857 ffestb_local_.inquire.ix = FFESTP_inquireixNEXTREC; 16858 ffestb_local_.inquire.left = TRUE; 16859 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFINT; 16860 break; 16861 16862 case FFESTR_inquireNUMBER: 16863 ffestb_local_.inquire.ix = FFESTP_inquireixNUMBER; 16864 ffestb_local_.inquire.left = TRUE; 16865 ffestb_local_.inquire.context = FFEEXPR_contextFILEINT; 16866 break; 16867 16868 case FFESTR_inquireOPENED: 16869 ffestb_local_.inquire.ix = FFESTP_inquireixOPENED; 16870 ffestb_local_.inquire.left = TRUE; 16871 ffestb_local_.inquire.context = FFEEXPR_contextFILELOG; 16872 break; 16873 16874 case FFESTR_inquireORGANIZATION: 16875 ffestb_local_.inquire.ix = FFESTP_inquireixORGANIZATION; 16876 ffestb_local_.inquire.left = TRUE; 16877 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR; 16878 break; 16879 16880 case FFESTR_inquirePAD: 16881 ffestb_local_.inquire.ix = FFESTP_inquireixPAD; 16882 ffestb_local_.inquire.left = TRUE; 16883 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR; 16884 break; 16885 16886 case FFESTR_inquirePOSITION: 16887 ffestb_local_.inquire.ix = FFESTP_inquireixPOSITION; 16888 ffestb_local_.inquire.left = TRUE; 16889 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR; 16890 break; 16891 16892 case FFESTR_inquireREAD: 16893 ffestb_local_.inquire.ix = FFESTP_inquireixREAD; 16894 ffestb_local_.inquire.left = TRUE; 16895 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR; 16896 break; 16897 16898 case FFESTR_inquireREADWRITE: 16899 ffestb_local_.inquire.ix = FFESTP_inquireixREADWRITE; 16900 ffestb_local_.inquire.left = TRUE; 16901 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR; 16902 break; 16903 16904 case FFESTR_inquireRECL: 16905 ffestb_local_.inquire.ix = FFESTP_inquireixRECL; 16906 ffestb_local_.inquire.left = TRUE; 16907 ffestb_local_.inquire.context = FFEEXPR_contextFILEINT; 16908 break; 16909 16910 case FFESTR_inquireRECORDTYPE: 16911 ffestb_local_.inquire.ix = FFESTP_inquireixRECORDTYPE; 16912 ffestb_local_.inquire.left = TRUE; 16913 ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR; 16914 break; 16915 16916 case FFESTR_inquireSEQUENTIAL: 16917 ffestb_local_.inquire.ix = FFESTP_inquireixSEQUENTIAL; 16918 ffestb_local_.inquire.left = TRUE; 16919 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR; 16920 break; 16921 16922 case FFESTR_inquireUNFORMATTED: 16923 ffestb_local_.inquire.ix = FFESTP_inquireixUNFORMATTED; 16924 ffestb_local_.inquire.left = TRUE; 16925 ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR; 16926 break; 16927 16928 case FFESTR_inquireUNIT: 16929 ffestb_local_.inquire.ix = FFESTP_inquireixUNIT; 16930 ffestb_local_.inquire.left = FALSE; 16931 ffestb_local_.inquire.context = FFEEXPR_contextFILENUM; 16932 break; 16933 16934 default: 16935 goto bad; /* :::::::::::::::::::: */ 16936 } 16937 if (ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix] 16938 .kw_or_val_present) 16939 break; /* Can't specify a keyword twice! */ 16940 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix] 16941 .kw_or_val_present = TRUE; 16942 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix] 16943 .kw_present = TRUE; 16944 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix] 16945 .value_present = FALSE; 16946 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value_is_label 16947 = ffestb_local_.inquire.label; 16948 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].kw 16949 = ffelex_token_use (t); 16950 return (ffelexHandler) ffestb_R9235_; 16951 16952 default: 16953 break; 16954 } 16955 16956bad: /* :::::::::::::::::::: */ 16957 ffestb_subr_kill_inquire_ (); 16958 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t); 16959 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 16960} 16961 16962/* ffestb_R9235_ -- "INQUIRE" OPEN_PAREN [external-file-unit COMMA] NAME 16963 16964 return ffestb_R9235_; // to lexer 16965 16966 Make sure EQUALS here, send next token to expression handler. */ 16967 16968static ffelexHandler 16969ffestb_R9235_ (ffelexToken t) 16970{ 16971 switch (ffelex_token_type (t)) 16972 { 16973 case FFELEX_typeEQUALS: 16974 ffesta_confirmed (); 16975 if (ffestb_local_.inquire.label) 16976 return (ffelexHandler) ffestb_R9237_; 16977 if (ffestb_local_.inquire.left) 16978 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 16979 ffestb_local_.inquire.context, 16980 (ffeexprCallback) ffestb_R9236_); 16981 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 16982 ffestb_local_.inquire.context, 16983 (ffeexprCallback) ffestb_R9236_); 16984 16985 default: 16986 break; 16987 } 16988 16989 ffestb_subr_kill_inquire_ (); 16990 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t); 16991 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 16992} 16993 16994/* ffestb_R9236_ -- "INQUIRE" OPEN_PAREN ... NAME EQUALS expr 16995 16996 (ffestb_R9236_) // to expression handler 16997 16998 Handle COMMA or CLOSE_PAREN here. */ 16999 17000static ffelexHandler 17001ffestb_R9236_ (ffelexToken ft, ffebld expr, ffelexToken t) 17002{ 17003 switch (ffelex_token_type (t)) 17004 { 17005 case FFELEX_typeCOMMA: 17006 if (ffestb_local_.inquire.ix == FFESTP_inquireixIOLENGTH) 17007 break; /* IOLENGTH=expr must be followed by 17008 CLOSE_PAREN. */ 17009 /* Fall through. */ 17010 case FFELEX_typeCLOSE_PAREN: 17011 if (expr == NULL) 17012 break; 17013 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value_present 17014 = TRUE; 17015 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value 17016 = ffelex_token_use (ft); 17017 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].u.expr = expr; 17018 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 17019 return (ffelexHandler) ffestb_R9234_; 17020 if (ffestb_local_.inquire.ix == FFESTP_inquireixIOLENGTH) 17021 return (ffelexHandler) ffestb_R92310_; 17022 return (ffelexHandler) ffestb_R9239_; 17023 17024 default: 17025 break; 17026 } 17027 17028 ffestb_subr_kill_inquire_ (); 17029 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t); 17030 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 17031} 17032 17033/* ffestb_R9237_ -- "INQUIRE" OPEN_PAREN ... NAME EQUALS 17034 17035 return ffestb_R9237_; // to lexer 17036 17037 Handle NUMBER for label here. */ 17038 17039static ffelexHandler 17040ffestb_R9237_ (ffelexToken t) 17041{ 17042 switch (ffelex_token_type (t)) 17043 { 17044 case FFELEX_typeNUMBER: 17045 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value_present 17046 = TRUE; 17047 ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value 17048 = ffelex_token_use (t); 17049 return (ffelexHandler) ffestb_R9238_; 17050 17051 default: 17052 break; 17053 } 17054 17055 ffestb_subr_kill_inquire_ (); 17056 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t); 17057 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 17058} 17059 17060/* ffestb_R9238_ -- "INQUIRE" OPEN_PAREN ... NAME EQUALS NUMBER 17061 17062 return ffestb_R9238_; // to lexer 17063 17064 Handle COMMA or CLOSE_PAREN here. */ 17065 17066static ffelexHandler 17067ffestb_R9238_ (ffelexToken t) 17068{ 17069 switch (ffelex_token_type (t)) 17070 { 17071 case FFELEX_typeCOMMA: 17072 return (ffelexHandler) ffestb_R9234_; 17073 17074 case FFELEX_typeCLOSE_PAREN: 17075 return (ffelexHandler) ffestb_R9239_; 17076 17077 default: 17078 break; 17079 } 17080 17081 ffestb_subr_kill_inquire_ (); 17082 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t); 17083 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 17084} 17085 17086/* ffestb_R9239_ -- "INQUIRE" OPEN_PAREN ... CLOSE_PAREN 17087 17088 return ffestb_R9239_; // to lexer 17089 17090 Handle EOS or SEMICOLON here. */ 17091 17092static ffelexHandler 17093ffestb_R9239_ (ffelexToken t) 17094{ 17095 switch (ffelex_token_type (t)) 17096 { 17097 case FFELEX_typeEOS: 17098 case FFELEX_typeSEMICOLON: 17099 ffesta_confirmed (); 17100 if (!ffesta_is_inhibited ()) 17101 ffestc_R923A (); 17102 ffestb_subr_kill_inquire_ (); 17103 return (ffelexHandler) ffesta_zero (t); 17104 17105 default: 17106 break; 17107 } 17108 17109 ffestb_subr_kill_inquire_ (); 17110 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t); 17111 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 17112} 17113 17114/* ffestb_R92310_ -- "INQUIRE(IOLENGTH=expr)" 17115 17116 return ffestb_R92310_; // to lexer 17117 17118 Make sure EOS or SEMICOLON not here; begin R923B processing and expect 17119 output IO list. */ 17120 17121static ffelexHandler 17122ffestb_R92310_ (ffelexToken t) 17123{ 17124 switch (ffelex_token_type (t)) 17125 { 17126 case FFELEX_typeEOS: 17127 case FFELEX_typeSEMICOLON: 17128 break; 17129 17130 default: 17131 ffesta_confirmed (); 17132 if (!ffesta_is_inhibited ()) 17133 ffestc_R923B_start (); 17134 ffestb_subr_kill_inquire_ (); 17135 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 17136 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R92311_))) 17137 (t); 17138 } 17139 17140 ffestb_subr_kill_inquire_ (); 17141 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t); 17142 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 17143} 17144 17145/* ffestb_R92311_ -- "INQUIRE(IOLENGTH=expr)" expr 17146 17147 (ffestb_R92311_) // to expression handler 17148 17149 Handle COMMA or EOS/SEMICOLON here. */ 17150 17151static ffelexHandler 17152ffestb_R92311_ (ffelexToken ft, ffebld expr, ffelexToken t) 17153{ 17154 switch (ffelex_token_type (t)) 17155 { 17156 case FFELEX_typeCOMMA: 17157 if (expr == NULL) 17158 break; 17159 if (!ffesta_is_inhibited ()) 17160 ffestc_R923B_item (expr, ft); 17161 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 17162 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R92311_); 17163 17164 case FFELEX_typeEOS: 17165 case FFELEX_typeSEMICOLON: 17166 if (expr == NULL) 17167 break; 17168 if (!ffesta_is_inhibited ()) 17169 { 17170 ffestc_R923B_item (expr, ft); 17171 ffestc_R923B_finish (); 17172 } 17173 return (ffelexHandler) ffesta_zero (t); 17174 17175 default: 17176 break; 17177 } 17178 17179 if (!ffesta_is_inhibited ()) 17180 ffestc_R923B_finish (); 17181 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t); 17182 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 17183} 17184 17185/* ffestb_V018 -- Parse the REWRITE statement 17186 17187 return ffestb_V018; // to lexer 17188 17189 Make sure the statement has a valid form for the REWRITE 17190 statement. If it does, implement the statement. */ 17191 17192#if FFESTR_VXT 17193ffelexHandler 17194ffestb_V018 (ffelexToken t) 17195{ 17196 ffestpRewriteIx ix; 17197 17198 switch (ffelex_token_type (ffesta_tokens[0])) 17199 { 17200 case FFELEX_typeNAME: 17201 if (ffesta_first_kw != FFESTR_firstREWRITE) 17202 goto bad_0; /* :::::::::::::::::::: */ 17203 switch (ffelex_token_type (t)) 17204 { 17205 case FFELEX_typeCOMMA: 17206 case FFELEX_typeCOLONCOLON: 17207 case FFELEX_typeEOS: 17208 case FFELEX_typeSEMICOLON: 17209 case FFELEX_typeNAME: 17210 case FFELEX_typeNUMBER: 17211 ffesta_confirmed (); /* Error, but clearly intended. */ 17212 goto bad_1; /* :::::::::::::::::::: */ 17213 17214 default: 17215 goto bad_1; /* :::::::::::::::::::: */ 17216 17217 case FFELEX_typeOPEN_PAREN: 17218 for (ix = 0; ix < FFESTP_rewriteix; ++ix) 17219 ffestp_file.rewrite.rewrite_spec[ix].kw_or_val_present = FALSE; 17220 return (ffelexHandler) ffestb_V0181_; 17221 } 17222 17223 case FFELEX_typeNAMES: 17224 if (ffesta_first_kw != FFESTR_firstREWRITE) 17225 goto bad_0; /* :::::::::::::::::::: */ 17226 switch (ffelex_token_type (t)) 17227 { 17228 case FFELEX_typeEOS: 17229 case FFELEX_typeSEMICOLON: 17230 case FFELEX_typeCOMMA: 17231 case FFELEX_typeCOLONCOLON: 17232 ffesta_confirmed (); /* Error, but clearly intended. */ 17233 goto bad_1; /* :::::::::::::::::::: */ 17234 17235 default: 17236 goto bad_1; /* :::::::::::::::::::: */ 17237 17238 case FFELEX_typeOPEN_PAREN: 17239 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlREWRITE) 17240 goto bad_0; /* :::::::::::::::::::: */ 17241 17242 for (ix = 0; ix < FFESTP_rewriteix; ++ix) 17243 ffestp_file.rewrite.rewrite_spec[ix].kw_or_val_present = FALSE; 17244 return (ffelexHandler) ffestb_V0181_; 17245 } 17246 17247 default: 17248 goto bad_0; /* :::::::::::::::::::: */ 17249 } 17250 17251bad_0: /* :::::::::::::::::::: */ 17252 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", ffesta_tokens[0]); 17253 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 17254 17255bad_1: /* :::::::::::::::::::: */ 17256 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t); 17257 return (ffelexHandler) ffelex_swallow_tokens (t, 17258 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 17259} 17260 17261/* ffestb_V0181_ -- "REWRITE" OPEN_PAREN 17262 17263 return ffestb_V0181_; // to lexer 17264 17265 Handle expr construct (not NAME=expr construct) here. */ 17266 17267static ffelexHandler 17268ffestb_V0181_ (ffelexToken t) 17269{ 17270 switch (ffelex_token_type (t)) 17271 { 17272 case FFELEX_typeNAME: 17273 ffesta_tokens[1] = ffelex_token_use (t); 17274 return (ffelexHandler) ffestb_V0182_; 17275 17276 default: 17277 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 17278 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0183_))) 17279 (t); 17280 } 17281} 17282 17283/* ffestb_V0182_ -- "REWRITE" OPEN_PAREN NAME 17284 17285 return ffestb_V0182_; // to lexer 17286 17287 If EQUALS here, go to states that handle it. Else, send NAME and this 17288 token thru expression handler. */ 17289 17290static ffelexHandler 17291ffestb_V0182_ (ffelexToken t) 17292{ 17293 ffelexHandler next; 17294 ffelexToken nt; 17295 17296 switch (ffelex_token_type (t)) 17297 { 17298 case FFELEX_typeEQUALS: 17299 nt = ffesta_tokens[1]; 17300 next = (ffelexHandler) ffestb_V0187_ (nt); 17301 ffelex_token_kill (nt); 17302 return (ffelexHandler) (*next) (t); 17303 17304 default: 17305 nt = ffesta_tokens[1]; 17306 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 17307 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0183_))) 17308 (nt); 17309 ffelex_token_kill (nt); 17310 return (ffelexHandler) (*next) (t); 17311 } 17312} 17313 17314/* ffestb_V0183_ -- "REWRITE" OPEN_PAREN expr [CLOSE_PAREN] 17315 17316 (ffestb_V0183_) // to expression handler 17317 17318 Handle COMMA or EOS/SEMICOLON here. */ 17319 17320static ffelexHandler 17321ffestb_V0183_ (ffelexToken ft, ffebld expr, ffelexToken t) 17322{ 17323 switch (ffelex_token_type (t)) 17324 { 17325 case FFELEX_typeCOMMA: 17326 case FFELEX_typeCLOSE_PAREN: 17327 if (expr == NULL) 17328 break; 17329 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].kw_or_val_present 17330 = TRUE; 17331 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].kw_present = FALSE; 17332 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].value_present = TRUE; 17333 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].value_is_label 17334 = FALSE; 17335 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].value 17336 = ffelex_token_use (ft); 17337 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].u.expr = expr; 17338 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 17339 return (ffelexHandler) ffestb_V0184_; 17340 return (ffelexHandler) ffestb_V01812_; 17341 17342 default: 17343 break; 17344 } 17345 17346 ffestb_subr_kill_rewrite_ (); 17347 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t); 17348 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 17349} 17350 17351/* ffestb_V0184_ -- "REWRITE" OPEN_PAREN expr COMMA 17352 17353 return ffestb_V0184_; // to lexer 17354 17355 Handle expr construct (not NAME=expr construct) here. */ 17356 17357static ffelexHandler 17358ffestb_V0184_ (ffelexToken t) 17359{ 17360 switch (ffelex_token_type (t)) 17361 { 17362 case FFELEX_typeNAME: 17363 ffesta_tokens[1] = ffelex_token_use (t); 17364 return (ffelexHandler) ffestb_V0185_; 17365 17366 default: 17367 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 17368 FFEEXPR_contextFILEFORMAT, (ffeexprCallback) ffestb_V0186_))) 17369 (t); 17370 } 17371} 17372 17373/* ffestb_V0185_ -- "REWRITE" OPEN_PAREN expr COMMA NAME 17374 17375 return ffestb_V0185_; // to lexer 17376 17377 If EQUALS here, go to states that handle it. Else, send NAME and this 17378 token thru expression handler. */ 17379 17380static ffelexHandler 17381ffestb_V0185_ (ffelexToken t) 17382{ 17383 ffelexHandler next; 17384 ffelexToken nt; 17385 17386 switch (ffelex_token_type (t)) 17387 { 17388 case FFELEX_typeEQUALS: 17389 nt = ffesta_tokens[1]; 17390 next = (ffelexHandler) ffestb_V0187_ (nt); 17391 ffelex_token_kill (nt); 17392 return (ffelexHandler) (*next) (t); 17393 17394 default: 17395 nt = ffesta_tokens[1]; 17396 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 17397 FFEEXPR_contextFILEFORMAT, (ffeexprCallback) ffestb_V0186_))) 17398 (nt); 17399 ffelex_token_kill (nt); 17400 return (ffelexHandler) (*next) (t); 17401 } 17402} 17403 17404/* ffestb_V0186_ -- "REWRITE" OPEN_PAREN expr COMMA expr 17405 17406 (ffestb_V0186_) // to expression handler 17407 17408 Handle COMMA or CLOSE_PAREN here. */ 17409 17410static ffelexHandler 17411ffestb_V0186_ (ffelexToken ft, ffebld expr, ffelexToken t) 17412{ 17413 switch (ffelex_token_type (t)) 17414 { 17415 case FFELEX_typeCOMMA: 17416 case FFELEX_typeCLOSE_PAREN: 17417 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw_or_val_present 17418 = TRUE; 17419 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw_present = FALSE; 17420 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value_present = TRUE; 17421 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value_is_label 17422 = (expr == NULL); 17423 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value 17424 = ffelex_token_use (ft); 17425 ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].u.expr = expr; 17426 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 17427 return (ffelexHandler) ffestb_V0187_; 17428 return (ffelexHandler) ffestb_V01812_; 17429 17430 default: 17431 break; 17432 } 17433 17434 ffestb_subr_kill_rewrite_ (); 17435 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t); 17436 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 17437} 17438 17439/* ffestb_V0187_ -- "REWRITE" OPEN_PAREN [external-file-unit COMMA [format 17440 COMMA]] 17441 17442 return ffestb_V0187_; // to lexer 17443 17444 Handle expr construct (not NAME=expr construct) here. */ 17445 17446static ffelexHandler 17447ffestb_V0187_ (ffelexToken t) 17448{ 17449 ffestrGenio kw; 17450 17451 ffestb_local_.rewrite.label = FALSE; 17452 17453 switch (ffelex_token_type (t)) 17454 { 17455 case FFELEX_typeNAME: 17456 kw = ffestr_genio (t); 17457 switch (kw) 17458 { 17459 case FFESTR_genioERR: 17460 ffestb_local_.rewrite.ix = FFESTP_rewriteixERR; 17461 ffestb_local_.rewrite.label = TRUE; 17462 break; 17463 17464 case FFESTR_genioFMT: 17465 ffestb_local_.rewrite.ix = FFESTP_rewriteixFMT; 17466 ffestb_local_.rewrite.left = FALSE; 17467 ffestb_local_.rewrite.context = FFEEXPR_contextFILEFORMAT; 17468 break; 17469 17470 case FFESTR_genioIOSTAT: 17471 ffestb_local_.rewrite.ix = FFESTP_rewriteixIOSTAT; 17472 ffestb_local_.rewrite.left = TRUE; 17473 ffestb_local_.rewrite.context = FFEEXPR_contextFILEINT; 17474 break; 17475 17476 case FFESTR_genioUNIT: 17477 ffestb_local_.rewrite.ix = FFESTP_rewriteixUNIT; 17478 ffestb_local_.rewrite.left = FALSE; 17479 ffestb_local_.rewrite.context = FFEEXPR_contextFILENUM; 17480 break; 17481 17482 default: 17483 goto bad; /* :::::::::::::::::::: */ 17484 } 17485 if (ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix] 17486 .kw_or_val_present) 17487 break; /* Can't specify a keyword twice! */ 17488 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix] 17489 .kw_or_val_present = TRUE; 17490 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix] 17491 .kw_present = TRUE; 17492 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix] 17493 .value_present = FALSE; 17494 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value_is_label 17495 = ffestb_local_.rewrite.label; 17496 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].kw 17497 = ffelex_token_use (t); 17498 return (ffelexHandler) ffestb_V0188_; 17499 17500 default: 17501 break; 17502 } 17503 17504bad: /* :::::::::::::::::::: */ 17505 ffestb_subr_kill_rewrite_ (); 17506 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t); 17507 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 17508} 17509 17510/* ffestb_V0188_ -- "REWRITE" OPEN_PAREN [external-file-unit COMMA [format 17511 COMMA]] NAME 17512 17513 return ffestb_V0188_; // to lexer 17514 17515 Make sure EQUALS here, send next token to expression handler. */ 17516 17517static ffelexHandler 17518ffestb_V0188_ (ffelexToken t) 17519{ 17520 switch (ffelex_token_type (t)) 17521 { 17522 case FFELEX_typeEQUALS: 17523 ffesta_confirmed (); 17524 if (ffestb_local_.rewrite.label) 17525 return (ffelexHandler) ffestb_V01810_; 17526 if (ffestb_local_.rewrite.left) 17527 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 17528 ffestb_local_.rewrite.context, 17529 (ffeexprCallback) ffestb_V0189_); 17530 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 17531 ffestb_local_.rewrite.context, 17532 (ffeexprCallback) ffestb_V0189_); 17533 17534 default: 17535 break; 17536 } 17537 17538 ffestb_subr_kill_rewrite_ (); 17539 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t); 17540 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 17541} 17542 17543/* ffestb_V0189_ -- "REWRITE" OPEN_PAREN ... NAME EQUALS expr 17544 17545 (ffestb_V0189_) // to expression handler 17546 17547 Handle COMMA or CLOSE_PAREN here. */ 17548 17549static ffelexHandler 17550ffestb_V0189_ (ffelexToken ft, ffebld expr, ffelexToken t) 17551{ 17552 switch (ffelex_token_type (t)) 17553 { 17554 case FFELEX_typeCOMMA: 17555 case FFELEX_typeCLOSE_PAREN: 17556 if (expr == NULL) 17557 if (ffestb_local_.rewrite.context == FFEEXPR_contextFILEFORMAT) 17558 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix] 17559 .value_is_label = TRUE; 17560 else 17561 break; 17562 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value_present 17563 = TRUE; 17564 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value 17565 = ffelex_token_use (ft); 17566 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].u.expr = expr; 17567 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 17568 return (ffelexHandler) ffestb_V0187_; 17569 return (ffelexHandler) ffestb_V01812_; 17570 17571 default: 17572 break; 17573 } 17574 17575 ffestb_subr_kill_rewrite_ (); 17576 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t); 17577 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 17578} 17579 17580/* ffestb_V01810_ -- "REWRITE" OPEN_PAREN ... NAME EQUALS 17581 17582 return ffestb_V01810_; // to lexer 17583 17584 Handle NUMBER for label here. */ 17585 17586static ffelexHandler 17587ffestb_V01810_ (ffelexToken t) 17588{ 17589 switch (ffelex_token_type (t)) 17590 { 17591 case FFELEX_typeNUMBER: 17592 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value_present 17593 = TRUE; 17594 ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value 17595 = ffelex_token_use (t); 17596 return (ffelexHandler) ffestb_V01811_; 17597 17598 default: 17599 break; 17600 } 17601 17602 ffestb_subr_kill_rewrite_ (); 17603 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t); 17604 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 17605} 17606 17607/* ffestb_V01811_ -- "REWRITE" OPEN_PAREN ... NAME EQUALS NUMBER 17608 17609 return ffestb_V01811_; // to lexer 17610 17611 Handle COMMA or CLOSE_PAREN here. */ 17612 17613static ffelexHandler 17614ffestb_V01811_ (ffelexToken t) 17615{ 17616 switch (ffelex_token_type (t)) 17617 { 17618 case FFELEX_typeCOMMA: 17619 return (ffelexHandler) ffestb_V0187_; 17620 17621 case FFELEX_typeCLOSE_PAREN: 17622 return (ffelexHandler) ffestb_V01812_; 17623 17624 default: 17625 break; 17626 } 17627 17628 ffestb_subr_kill_rewrite_ (); 17629 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t); 17630 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 17631} 17632 17633/* ffestb_V01812_ -- "REWRITE" OPEN_PAREN ... CLOSE_PAREN 17634 17635 return ffestb_V01812_; // to lexer 17636 17637 Handle EOS or SEMICOLON here. */ 17638 17639static ffelexHandler 17640ffestb_V01812_ (ffelexToken t) 17641{ 17642 switch (ffelex_token_type (t)) 17643 { 17644 case FFELEX_typeEOS: 17645 case FFELEX_typeSEMICOLON: 17646 ffesta_confirmed (); 17647 if (!ffesta_is_inhibited ()) 17648 { 17649 ffestc_V018_start (); 17650 ffestc_V018_finish (); 17651 } 17652 ffestb_subr_kill_rewrite_ (); 17653 return (ffelexHandler) ffesta_zero (t); 17654 17655 case FFELEX_typeNAME: 17656 case FFELEX_typeOPEN_PAREN: 17657 case FFELEX_typeCOMMA: 17658 ffesta_confirmed (); 17659 if (!ffesta_is_inhibited ()) 17660 ffestc_V018_start (); 17661 ffestb_subr_kill_rewrite_ (); 17662 17663 /* EXTENSION: Allow an optional preceding COMMA here if not pedantic. 17664 (f2c provides this extension, as do other compilers, supposedly.) */ 17665 17666 if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA)) 17667 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 17668 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V01813_); 17669 17670 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 17671 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V01813_))) 17672 (t); 17673 17674 default: 17675 break; 17676 } 17677 17678 ffestb_subr_kill_rewrite_ (); 17679 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t); 17680 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 17681} 17682 17683/* ffestb_V01813_ -- "REWRITE(...)" expr 17684 17685 (ffestb_V01813_) // to expression handler 17686 17687 Handle COMMA or EOS/SEMICOLON here. */ 17688 17689static ffelexHandler 17690ffestb_V01813_ (ffelexToken ft, ffebld expr, ffelexToken t) 17691{ 17692 switch (ffelex_token_type (t)) 17693 { 17694 case FFELEX_typeCOMMA: 17695 if (expr == NULL) 17696 break; 17697 if (!ffesta_is_inhibited ()) 17698 ffestc_V018_item (expr, ft); 17699 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 17700 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V01813_); 17701 17702 case FFELEX_typeEOS: 17703 case FFELEX_typeSEMICOLON: 17704 if (expr == NULL) 17705 break; 17706 if (!ffesta_is_inhibited ()) 17707 { 17708 ffestc_V018_item (expr, ft); 17709 ffestc_V018_finish (); 17710 } 17711 return (ffelexHandler) ffesta_zero (t); 17712 17713 default: 17714 break; 17715 } 17716 17717 if (!ffesta_is_inhibited ()) 17718 ffestc_V018_finish (); 17719 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t); 17720 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 17721} 17722 17723/* ffestb_V019 -- Parse the ACCEPT statement 17724 17725 return ffestb_V019; // to lexer 17726 17727 Make sure the statement has a valid form for the ACCEPT 17728 statement. If it does, implement the statement. */ 17729 17730ffelexHandler 17731ffestb_V019 (ffelexToken t) 17732{ 17733 ffelexHandler next; 17734 ffestpAcceptIx ix; 17735 17736 switch (ffelex_token_type (ffesta_tokens[0])) 17737 { 17738 case FFELEX_typeNAME: 17739 if (ffesta_first_kw != FFESTR_firstACCEPT) 17740 goto bad_0; /* :::::::::::::::::::: */ 17741 switch (ffelex_token_type (t)) 17742 { 17743 case FFELEX_typeCOMMA: 17744 case FFELEX_typeCOLONCOLON: 17745 case FFELEX_typeEOS: 17746 case FFELEX_typeSEMICOLON: 17747 ffesta_confirmed (); /* Error, but clearly intended. */ 17748 goto bad_1; /* :::::::::::::::::::: */ 17749 17750 case FFELEX_typeEQUALS: 17751 case FFELEX_typePOINTS: 17752 case FFELEX_typeCOLON: 17753 goto bad_1; /* :::::::::::::::::::: */ 17754 17755 case FFELEX_typeNAME: 17756 case FFELEX_typeNUMBER: 17757 ffesta_confirmed (); 17758 break; 17759 17760 default: 17761 break; 17762 } 17763 17764 for (ix = 0; ix < FFESTP_acceptix; ++ix) 17765 ffestp_file.accept.accept_spec[ix].kw_or_val_present = FALSE; 17766 return (ffelexHandler) (*((ffelexHandler) 17767 ffeexpr_rhs (ffesta_output_pool, 17768 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0191_))) 17769 (t); 17770 17771 case FFELEX_typeNAMES: 17772 if (ffesta_first_kw != FFESTR_firstACCEPT) 17773 goto bad_0; /* :::::::::::::::::::: */ 17774 switch (ffelex_token_type (t)) 17775 { 17776 case FFELEX_typeEOS: 17777 case FFELEX_typeSEMICOLON: 17778 case FFELEX_typeCOMMA: 17779 ffesta_confirmed (); 17780 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlACCEPT) 17781 break; 17782 goto bad_1; /* :::::::::::::::::::: */ 17783 17784 case FFELEX_typeCOLONCOLON: 17785 ffesta_confirmed (); /* Error, but clearly intended. */ 17786 goto bad_1; /* :::::::::::::::::::: */ 17787 17788 case FFELEX_typeEQUALS: 17789 case FFELEX_typePOINTS: 17790 case FFELEX_typeCOLON: 17791 goto bad_1; /* :::::::::::::::::::: */ 17792 17793 default: 17794 break; 17795 } 17796 for (ix = 0; ix < FFESTP_acceptix; ++ix) 17797 ffestp_file.accept.accept_spec[ix].kw_or_val_present = FALSE; 17798 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 17799 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0191_); 17800 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0], 17801 FFESTR_firstlACCEPT); 17802 if (next == NULL) 17803 return (ffelexHandler) ffelex_swallow_tokens (t, 17804 (ffelexHandler) ffesta_zero); 17805 return (ffelexHandler) (*next) (t); 17806 17807 default: 17808 goto bad_0; /* :::::::::::::::::::: */ 17809 } 17810 17811bad_0: /* :::::::::::::::::::: */ 17812 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", ffesta_tokens[0]); 17813 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 17814 17815bad_1: /* :::::::::::::::::::: */ 17816 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", t); 17817 return (ffelexHandler) ffelex_swallow_tokens (t, 17818 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 17819} 17820 17821/* ffestb_V0191_ -- "ACCEPT" expr 17822 17823 (ffestb_V0191_) // to expression handler 17824 17825 Make sure the next token is a COMMA or EOS/SEMICOLON. */ 17826 17827static ffelexHandler 17828ffestb_V0191_ (ffelexToken ft, ffebld expr, ffelexToken t) 17829{ 17830 switch (ffelex_token_type (t)) 17831 { 17832 case FFELEX_typeEOS: 17833 case FFELEX_typeSEMICOLON: 17834 case FFELEX_typeCOMMA: 17835 ffesta_confirmed (); 17836 ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].kw_or_val_present 17837 = TRUE; 17838 ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].kw_present = FALSE; 17839 ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].value_present = TRUE; 17840 ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].value_is_label 17841 = (expr == NULL); 17842 ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].value 17843 = ffelex_token_use (ft); 17844 ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].u.expr = expr; 17845 if (!ffesta_is_inhibited ()) 17846 ffestc_V019_start (); 17847 ffestb_subr_kill_accept_ (); 17848 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 17849 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 17850 FFEEXPR_contextIOLIST, 17851 (ffeexprCallback) ffestb_V0192_); 17852 if (!ffesta_is_inhibited ()) 17853 ffestc_V019_finish (); 17854 return (ffelexHandler) ffesta_zero (t); 17855 17856 default: 17857 break; 17858 } 17859 17860 ffestb_subr_kill_accept_ (); 17861 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", t); 17862 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 17863} 17864 17865/* ffestb_V0192_ -- "ACCEPT" expr COMMA expr 17866 17867 (ffestb_V0192_) // to expression handler 17868 17869 Handle COMMA or EOS/SEMICOLON here. */ 17870 17871static ffelexHandler 17872ffestb_V0192_ (ffelexToken ft, ffebld expr, ffelexToken t) 17873{ 17874 switch (ffelex_token_type (t)) 17875 { 17876 case FFELEX_typeCOMMA: 17877 if (expr == NULL) 17878 break; 17879 if (!ffesta_is_inhibited ()) 17880 ffestc_V019_item (expr, ft); 17881 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 17882 FFEEXPR_contextIOLIST, 17883 (ffeexprCallback) ffestb_V0192_); 17884 17885 case FFELEX_typeEOS: 17886 case FFELEX_typeSEMICOLON: 17887 if (expr == NULL) 17888 break; 17889 if (!ffesta_is_inhibited ()) 17890 { 17891 ffestc_V019_item (expr, ft); 17892 ffestc_V019_finish (); 17893 } 17894 return (ffelexHandler) ffesta_zero (t); 17895 17896 default: 17897 break; 17898 } 17899 17900 if (!ffesta_is_inhibited ()) 17901 ffestc_V019_finish (); 17902 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", t); 17903 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 17904} 17905 17906#endif 17907/* ffestb_V020 -- Parse the TYPE statement 17908 17909 return ffestb_V020; // to lexer 17910 17911 Make sure the statement has a valid form for the TYPE 17912 statement. If it does, implement the statement. */ 17913 17914ffelexHandler 17915ffestb_V020 (ffelexToken t) 17916{ 17917 ffeTokenLength i; 17918 const char *p; 17919 ffelexHandler next; 17920 ffestpTypeIx ix; 17921 17922 switch (ffelex_token_type (ffesta_tokens[0])) 17923 { 17924 case FFELEX_typeNAME: 17925 if (ffesta_first_kw != FFESTR_firstTYPE) 17926 goto bad_0; /* :::::::::::::::::::: */ 17927 switch (ffelex_token_type (t)) 17928 { 17929 case FFELEX_typeCOLONCOLON: 17930 case FFELEX_typeEOS: 17931 case FFELEX_typeSEMICOLON: 17932 ffesta_confirmed (); /* Error, but clearly intended. */ 17933 goto bad_1; /* :::::::::::::::::::: */ 17934 17935 case FFELEX_typeEQUALS: 17936 case FFELEX_typePOINTS: 17937 case FFELEX_typeCOLON: 17938 case FFELEX_typeCOMMA: /* Because "TYPE,PUBLIC::A" is ambiguous with 17939 '90. */ 17940 goto bad_1; /* :::::::::::::::::::: */ 17941 17942 case FFELEX_typeNUMBER: 17943 ffesta_confirmed (); 17944 break; 17945 17946 case FFELEX_typeNAME: /* Because TYPE A is ambiguous with '90. */ 17947 default: 17948 break; 17949 } 17950 17951 for (ix = 0; ix < FFESTP_typeix; ++ix) 17952 ffestp_file.type.type_spec[ix].kw_or_val_present = FALSE; 17953 return (ffelexHandler) (*((ffelexHandler) 17954 ffeexpr_rhs (ffesta_output_pool, 17955 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0201_))) 17956 (t); 17957 17958 case FFELEX_typeNAMES: 17959 if (ffesta_first_kw != FFESTR_firstTYPE) 17960 goto bad_0; /* :::::::::::::::::::: */ 17961 switch (ffelex_token_type (t)) 17962 { 17963 case FFELEX_typeEOS: 17964 case FFELEX_typeSEMICOLON: 17965 case FFELEX_typeCOMMA: 17966 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlTYPE) 17967 break; 17968 goto bad_1; /* :::::::::::::::::::: */ 17969 17970 case FFELEX_typeCOLONCOLON: 17971 ffesta_confirmed (); /* Error, but clearly intended. */ 17972 goto bad_1; /* :::::::::::::::::::: */ 17973 17974 case FFELEX_typeOPEN_PAREN: 17975 if (ffelex_token_length (ffesta_tokens[0]) == FFESTR_firstlTYPE) 17976 break; /* Else might be assignment/stmtfuncdef. */ 17977 goto bad_1; /* :::::::::::::::::::: */ 17978 17979 case FFELEX_typeEQUALS: 17980 case FFELEX_typePOINTS: 17981 case FFELEX_typeCOLON: 17982 goto bad_1; /* :::::::::::::::::::: */ 17983 17984 default: 17985 break; 17986 } 17987 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlTYPE); 17988 if (ISDIGIT (*p)) 17989 ffesta_confirmed (); /* Else might be '90 TYPE statement. */ 17990 for (ix = 0; ix < FFESTP_typeix; ++ix) 17991 ffestp_file.type.type_spec[ix].kw_or_val_present = FALSE; 17992 next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 17993 FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0201_); 17994 next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0], 17995 FFESTR_firstlTYPE); 17996 if (next == NULL) 17997 return (ffelexHandler) ffelex_swallow_tokens (t, 17998 (ffelexHandler) ffesta_zero); 17999 return (ffelexHandler) (*next) (t); 18000 18001 default: 18002 goto bad_0; /* :::::::::::::::::::: */ 18003 } 18004 18005bad_0: /* :::::::::::::::::::: */ 18006 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", ffesta_tokens[0]); 18007 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 18008 18009bad_1: /* :::::::::::::::::::: */ 18010 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", t); 18011 return (ffelexHandler) ffelex_swallow_tokens (t, 18012 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 18013} 18014 18015/* ffestb_V0201_ -- "TYPE" expr 18016 18017 (ffestb_V0201_) // to expression handler 18018 18019 Make sure the next token is a COMMA or EOS/SEMICOLON. */ 18020 18021static ffelexHandler 18022ffestb_V0201_ (ffelexToken ft, ffebld expr, ffelexToken t) 18023{ 18024 bool comma = TRUE; 18025 18026 switch (ffelex_token_type (t)) 18027 { 18028 case FFELEX_typeEOS: 18029 case FFELEX_typeSEMICOLON: 18030 if (!ffe_is_vxt () && (expr != NULL) 18031 && (ffebld_op (expr) == FFEBLD_opSYMTER)) 18032 break; 18033 comma = FALSE; 18034 /* Fall through. */ 18035 case FFELEX_typeCOMMA: 18036 if (!ffe_is_vxt () && comma && (expr != NULL) 18037 && (ffebld_op (expr) == FFEBLD_opPAREN) 18038 && (ffebld_op (ffebld_left (expr)) == FFEBLD_opSYMTER)) 18039 break; 18040 ffesta_confirmed (); 18041 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].kw_or_val_present 18042 = TRUE; 18043 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].kw_present = FALSE; 18044 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].value_present = TRUE; 18045 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].value_is_label 18046 = (expr == NULL); 18047 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].value 18048 = ffelex_token_use (ft); 18049 ffestp_file.type.type_spec[FFESTP_typeixFORMAT].u.expr = expr; 18050 if (!ffesta_is_inhibited ()) 18051 ffestc_V020_start (); 18052 ffestb_subr_kill_type_ (); 18053 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 18054 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 18055 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V0202_); 18056 if (!ffesta_is_inhibited ()) 18057 ffestc_V020_finish (); 18058 return (ffelexHandler) ffesta_zero (t); 18059 18060 default: 18061 break; 18062 } 18063 18064 ffestb_subr_kill_type_ (); 18065 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", t); 18066 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 18067} 18068 18069/* ffestb_V0202_ -- "TYPE" expr COMMA expr 18070 18071 (ffestb_V0202_) // to expression handler 18072 18073 Handle COMMA or EOS/SEMICOLON here. */ 18074 18075static ffelexHandler 18076ffestb_V0202_ (ffelexToken ft, ffebld expr, ffelexToken t) 18077{ 18078 switch (ffelex_token_type (t)) 18079 { 18080 case FFELEX_typeCOMMA: 18081 if (expr == NULL) 18082 break; 18083 if (!ffesta_is_inhibited ()) 18084 ffestc_V020_item (expr, ft); 18085 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 18086 FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V0202_); 18087 18088 case FFELEX_typeEOS: 18089 case FFELEX_typeSEMICOLON: 18090 if (expr == NULL) 18091 break; 18092 if (!ffesta_is_inhibited ()) 18093 { 18094 ffestc_V020_item (expr, ft); 18095 ffestc_V020_finish (); 18096 } 18097 return (ffelexHandler) ffesta_zero (t); 18098 18099 default: 18100 break; 18101 } 18102 18103 if (!ffesta_is_inhibited ()) 18104 ffestc_V020_finish (); 18105 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", t); 18106 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 18107} 18108 18109/* ffestb_V021 -- Parse a DELETE statement 18110 18111 return ffestb_V021; // to lexer 18112 18113 Make sure the statement has a valid form for a DELETE statement. 18114 If it does, implement the statement. */ 18115 18116#if FFESTR_VXT 18117ffelexHandler 18118ffestb_V021 (ffelexToken t) 18119{ 18120 ffestpDeleteIx ix; 18121 18122 switch (ffelex_token_type (ffesta_tokens[0])) 18123 { 18124 case FFELEX_typeNAME: 18125 if (ffesta_first_kw != FFESTR_firstDELETE) 18126 goto bad_0; /* :::::::::::::::::::: */ 18127 break; 18128 18129 case FFELEX_typeNAMES: 18130 if (ffesta_first_kw != FFESTR_firstDELETE) 18131 goto bad_0; /* :::::::::::::::::::: */ 18132 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlDELETE) 18133 goto bad_0; /* :::::::::::::::::::: */ 18134 break; 18135 18136 default: 18137 goto bad_0; /* :::::::::::::::::::: */ 18138 } 18139 18140 switch (ffelex_token_type (t)) 18141 { 18142 case FFELEX_typeOPEN_PAREN: 18143 break; 18144 18145 case FFELEX_typeEOS: 18146 case FFELEX_typeSEMICOLON: 18147 case FFELEX_typeCOMMA: 18148 case FFELEX_typeCOLONCOLON: 18149 ffesta_confirmed (); /* Error, but clearly intended. */ 18150 goto bad_1; /* :::::::::::::::::::: */ 18151 18152 default: 18153 goto bad_1; /* :::::::::::::::::::: */ 18154 } 18155 18156 for (ix = 0; ix < FFESTP_deleteix; ++ix) 18157 ffestp_file.delete.delete_spec[ix].kw_or_val_present = FALSE; 18158 18159 return (ffelexHandler) ffestb_V0211_; 18160 18161bad_0: /* :::::::::::::::::::: */ 18162 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", ffesta_tokens[0]); 18163 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 18164 18165bad_1: /* :::::::::::::::::::: */ 18166 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t); 18167 return (ffelexHandler) ffelex_swallow_tokens (t, 18168 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 18169} 18170 18171/* ffestb_V0211_ -- "DELETE" OPEN_PAREN 18172 18173 return ffestb_V0211_; // to lexer 18174 18175 Handle expr construct (not NAME=expr construct) here. */ 18176 18177static ffelexHandler 18178ffestb_V0211_ (ffelexToken t) 18179{ 18180 switch (ffelex_token_type (t)) 18181 { 18182 case FFELEX_typeNAME: 18183 ffesta_tokens[1] = ffelex_token_use (t); 18184 return (ffelexHandler) ffestb_V0212_; 18185 18186 default: 18187 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 18188 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0213_))) 18189 (t); 18190 } 18191} 18192 18193/* ffestb_V0212_ -- "DELETE" OPEN_PAREN NAME 18194 18195 return ffestb_V0212_; // to lexer 18196 18197 If EQUALS here, go to states that handle it. Else, send NAME and this 18198 token thru expression handler. */ 18199 18200static ffelexHandler 18201ffestb_V0212_ (ffelexToken t) 18202{ 18203 ffelexHandler next; 18204 ffelexToken nt; 18205 18206 switch (ffelex_token_type (t)) 18207 { 18208 case FFELEX_typeEQUALS: 18209 nt = ffesta_tokens[1]; 18210 next = (ffelexHandler) ffestb_V0214_ (nt); 18211 ffelex_token_kill (nt); 18212 return (ffelexHandler) (*next) (t); 18213 18214 default: 18215 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 18216 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0213_))) 18217 (ffesta_tokens[1]); 18218 ffelex_token_kill (ffesta_tokens[1]); 18219 return (ffelexHandler) (*next) (t); 18220 } 18221} 18222 18223/* ffestb_V0213_ -- "DELETE" OPEN_PAREN expr 18224 18225 (ffestb_V0213_) // to expression handler 18226 18227 Handle COMMA or DELETE_PAREN here. */ 18228 18229static ffelexHandler 18230ffestb_V0213_ (ffelexToken ft, ffebld expr, ffelexToken t) 18231{ 18232 switch (ffelex_token_type (t)) 18233 { 18234 case FFELEX_typeCOMMA: 18235 case FFELEX_typeCLOSE_PAREN: 18236 if (expr == NULL) 18237 break; 18238 ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].kw_or_val_present 18239 = TRUE; 18240 ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].kw_present = FALSE; 18241 ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].value_present = TRUE; 18242 ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].value_is_label 18243 = FALSE; 18244 ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].value 18245 = ffelex_token_use (ft); 18246 ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].u.expr = expr; 18247 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 18248 return (ffelexHandler) ffestb_V0214_; 18249 return (ffelexHandler) ffestb_V0219_; 18250 18251 default: 18252 break; 18253 } 18254 18255 ffestb_subr_kill_delete_ (); 18256 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t); 18257 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 18258} 18259 18260/* ffestb_V0214_ -- "DELETE" OPEN_PAREN [external-file-unit COMMA] 18261 18262 return ffestb_V0214_; // to lexer 18263 18264 Handle expr construct (not NAME=expr construct) here. */ 18265 18266static ffelexHandler 18267ffestb_V0214_ (ffelexToken t) 18268{ 18269 ffestrGenio kw; 18270 18271 ffestb_local_.delete.label = FALSE; 18272 18273 switch (ffelex_token_type (t)) 18274 { 18275 case FFELEX_typeNAME: 18276 kw = ffestr_genio (t); 18277 switch (kw) 18278 { 18279 case FFESTR_genioERR: 18280 ffestb_local_.delete.ix = FFESTP_deleteixERR; 18281 ffestb_local_.delete.label = TRUE; 18282 break; 18283 18284 case FFESTR_genioIOSTAT: 18285 ffestb_local_.delete.ix = FFESTP_deleteixIOSTAT; 18286 ffestb_local_.delete.left = TRUE; 18287 ffestb_local_.delete.context = FFEEXPR_contextFILEINT; 18288 break; 18289 18290 case FFESTR_genioREC: 18291 ffestb_local_.delete.ix = FFESTP_deleteixREC; 18292 ffestb_local_.delete.left = FALSE; 18293 ffestb_local_.delete.context = FFEEXPR_contextFILENUM; 18294 break; 18295 18296 case FFESTR_genioUNIT: 18297 ffestb_local_.delete.ix = FFESTP_deleteixUNIT; 18298 ffestb_local_.delete.left = FALSE; 18299 ffestb_local_.delete.context = FFEEXPR_contextFILENUM; 18300 break; 18301 18302 default: 18303 goto bad; /* :::::::::::::::::::: */ 18304 } 18305 if (ffestp_file.delete.delete_spec[ffestb_local_.delete.ix] 18306 .kw_or_val_present) 18307 break; /* Can't specify a keyword twice! */ 18308 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix] 18309 .kw_or_val_present = TRUE; 18310 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix] 18311 .kw_present = TRUE; 18312 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix] 18313 .value_present = FALSE; 18314 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value_is_label 18315 = ffestb_local_.delete.label; 18316 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].kw 18317 = ffelex_token_use (t); 18318 return (ffelexHandler) ffestb_V0215_; 18319 18320 default: 18321 break; 18322 } 18323 18324bad: /* :::::::::::::::::::: */ 18325 ffestb_subr_kill_delete_ (); 18326 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t); 18327 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 18328} 18329 18330/* ffestb_V0215_ -- "DELETE" OPEN_PAREN [external-file-unit COMMA] NAME 18331 18332 return ffestb_V0215_; // to lexer 18333 18334 Make sure EQUALS here, send next token to expression handler. */ 18335 18336static ffelexHandler 18337ffestb_V0215_ (ffelexToken t) 18338{ 18339 switch (ffelex_token_type (t)) 18340 { 18341 case FFELEX_typeEQUALS: 18342 ffesta_confirmed (); 18343 if (ffestb_local_.delete.label) 18344 return (ffelexHandler) ffestb_V0217_; 18345 if (ffestb_local_.delete.left) 18346 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 18347 ffestb_local_.delete.context, 18348 (ffeexprCallback) ffestb_V0216_); 18349 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 18350 ffestb_local_.delete.context, (ffeexprCallback) ffestb_V0216_); 18351 18352 default: 18353 break; 18354 } 18355 18356 ffestb_subr_kill_delete_ (); 18357 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t); 18358 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 18359} 18360 18361/* ffestb_V0216_ -- "DELETE" OPEN_PAREN ... NAME EQUALS expr 18362 18363 (ffestb_V0216_) // to expression handler 18364 18365 Handle COMMA or CLOSE_PAREN here. */ 18366 18367static ffelexHandler 18368ffestb_V0216_ (ffelexToken ft, ffebld expr, ffelexToken t) 18369{ 18370 switch (ffelex_token_type (t)) 18371 { 18372 case FFELEX_typeCOMMA: 18373 case FFELEX_typeCLOSE_PAREN: 18374 if (expr == NULL) 18375 break; 18376 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value_present 18377 = TRUE; 18378 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value 18379 = ffelex_token_use (ft); 18380 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].u.expr = expr; 18381 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 18382 return (ffelexHandler) ffestb_V0214_; 18383 return (ffelexHandler) ffestb_V0219_; 18384 18385 default: 18386 break; 18387 } 18388 18389 ffestb_subr_kill_delete_ (); 18390 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t); 18391 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 18392} 18393 18394/* ffestb_V0217_ -- "DELETE" OPEN_PAREN ... NAME EQUALS 18395 18396 return ffestb_V0217_; // to lexer 18397 18398 Handle NUMBER for label here. */ 18399 18400static ffelexHandler 18401ffestb_V0217_ (ffelexToken t) 18402{ 18403 switch (ffelex_token_type (t)) 18404 { 18405 case FFELEX_typeNUMBER: 18406 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value_present 18407 = TRUE; 18408 ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value 18409 = ffelex_token_use (t); 18410 return (ffelexHandler) ffestb_V0218_; 18411 18412 default: 18413 break; 18414 } 18415 18416 ffestb_subr_kill_delete_ (); 18417 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t); 18418 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 18419} 18420 18421/* ffestb_V0218_ -- "DELETE" OPEN_PAREN ... NAME EQUALS NUMBER 18422 18423 return ffestb_V0218_; // to lexer 18424 18425 Handle COMMA or CLOSE_PAREN here. */ 18426 18427static ffelexHandler 18428ffestb_V0218_ (ffelexToken t) 18429{ 18430 switch (ffelex_token_type (t)) 18431 { 18432 case FFELEX_typeCOMMA: 18433 return (ffelexHandler) ffestb_V0214_; 18434 18435 case FFELEX_typeCLOSE_PAREN: 18436 return (ffelexHandler) ffestb_V0219_; 18437 18438 default: 18439 break; 18440 } 18441 18442 ffestb_subr_kill_delete_ (); 18443 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t); 18444 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 18445} 18446 18447/* ffestb_V0219_ -- "DELETE" OPEN_PAREN ... CLOSE_PAREN 18448 18449 return ffestb_V0219_; // to lexer 18450 18451 Handle EOS or SEMICOLON here. */ 18452 18453static ffelexHandler 18454ffestb_V0219_ (ffelexToken t) 18455{ 18456 switch (ffelex_token_type (t)) 18457 { 18458 case FFELEX_typeEOS: 18459 case FFELEX_typeSEMICOLON: 18460 ffesta_confirmed (); 18461 if (!ffesta_is_inhibited ()) 18462 ffestc_V021 (); 18463 ffestb_subr_kill_delete_ (); 18464 return (ffelexHandler) ffesta_zero (t); 18465 18466 default: 18467 break; 18468 } 18469 18470 ffestb_subr_kill_delete_ (); 18471 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t); 18472 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 18473} 18474 18475/* ffestb_V026 -- Parse a FIND statement 18476 18477 return ffestb_V026; // to lexer 18478 18479 Make sure the statement has a valid form for a FIND statement. 18480 If it does, implement the statement. */ 18481 18482ffelexHandler 18483ffestb_V026 (ffelexToken t) 18484{ 18485 ffestpFindIx ix; 18486 18487 switch (ffelex_token_type (ffesta_tokens[0])) 18488 { 18489 case FFELEX_typeNAME: 18490 if (ffesta_first_kw != FFESTR_firstFIND) 18491 goto bad_0; /* :::::::::::::::::::: */ 18492 break; 18493 18494 case FFELEX_typeNAMES: 18495 if (ffesta_first_kw != FFESTR_firstFIND) 18496 goto bad_0; /* :::::::::::::::::::: */ 18497 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlFIND) 18498 goto bad_0; /* :::::::::::::::::::: */ 18499 break; 18500 18501 default: 18502 goto bad_0; /* :::::::::::::::::::: */ 18503 } 18504 18505 switch (ffelex_token_type (t)) 18506 { 18507 case FFELEX_typeOPEN_PAREN: 18508 break; 18509 18510 case FFELEX_typeEOS: 18511 case FFELEX_typeSEMICOLON: 18512 case FFELEX_typeCOMMA: 18513 case FFELEX_typeCOLONCOLON: 18514 ffesta_confirmed (); /* Error, but clearly intended. */ 18515 goto bad_1; /* :::::::::::::::::::: */ 18516 18517 default: 18518 goto bad_1; /* :::::::::::::::::::: */ 18519 } 18520 18521 for (ix = 0; ix < FFESTP_findix; ++ix) 18522 ffestp_file.find.find_spec[ix].kw_or_val_present = FALSE; 18523 18524 return (ffelexHandler) ffestb_V0261_; 18525 18526bad_0: /* :::::::::::::::::::: */ 18527 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", ffesta_tokens[0]); 18528 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 18529 18530bad_1: /* :::::::::::::::::::: */ 18531 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t); 18532 return (ffelexHandler) ffelex_swallow_tokens (t, 18533 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 18534} 18535 18536/* ffestb_V0261_ -- "FIND" OPEN_PAREN 18537 18538 return ffestb_V0261_; // to lexer 18539 18540 Handle expr construct (not NAME=expr construct) here. */ 18541 18542static ffelexHandler 18543ffestb_V0261_ (ffelexToken t) 18544{ 18545 switch (ffelex_token_type (t)) 18546 { 18547 case FFELEX_typeNAME: 18548 ffesta_tokens[1] = ffelex_token_use (t); 18549 return (ffelexHandler) ffestb_V0262_; 18550 18551 default: 18552 return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 18553 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0263_))) 18554 (t); 18555 } 18556} 18557 18558/* ffestb_V0262_ -- "FIND" OPEN_PAREN NAME 18559 18560 return ffestb_V0262_; // to lexer 18561 18562 If EQUALS here, go to states that handle it. Else, send NAME and this 18563 token thru expression handler. */ 18564 18565static ffelexHandler 18566ffestb_V0262_ (ffelexToken t) 18567{ 18568 ffelexHandler next; 18569 ffelexToken nt; 18570 18571 switch (ffelex_token_type (t)) 18572 { 18573 case FFELEX_typeEQUALS: 18574 nt = ffesta_tokens[1]; 18575 next = (ffelexHandler) ffestb_V0264_ (nt); 18576 ffelex_token_kill (nt); 18577 return (ffelexHandler) (*next) (t); 18578 18579 default: 18580 next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 18581 FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0263_))) 18582 (ffesta_tokens[1]); 18583 ffelex_token_kill (ffesta_tokens[1]); 18584 return (ffelexHandler) (*next) (t); 18585 } 18586} 18587 18588/* ffestb_V0263_ -- "FIND" OPEN_PAREN expr 18589 18590 (ffestb_V0263_) // to expression handler 18591 18592 Handle COMMA or FIND_PAREN here. */ 18593 18594static ffelexHandler 18595ffestb_V0263_ (ffelexToken ft, ffebld expr, ffelexToken t) 18596{ 18597 switch (ffelex_token_type (t)) 18598 { 18599 case FFELEX_typeCOMMA: 18600 case FFELEX_typeCLOSE_PAREN: 18601 if (expr == NULL) 18602 break; 18603 ffestp_file.find.find_spec[FFESTP_findixUNIT].kw_or_val_present 18604 = TRUE; 18605 ffestp_file.find.find_spec[FFESTP_findixUNIT].kw_present = FALSE; 18606 ffestp_file.find.find_spec[FFESTP_findixUNIT].value_present = TRUE; 18607 ffestp_file.find.find_spec[FFESTP_findixUNIT].value_is_label 18608 = FALSE; 18609 ffestp_file.find.find_spec[FFESTP_findixUNIT].value 18610 = ffelex_token_use (ft); 18611 ffestp_file.find.find_spec[FFESTP_findixUNIT].u.expr = expr; 18612 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 18613 return (ffelexHandler) ffestb_V0264_; 18614 return (ffelexHandler) ffestb_V0269_; 18615 18616 default: 18617 break; 18618 } 18619 18620 ffestb_subr_kill_find_ (); 18621 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t); 18622 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 18623} 18624 18625/* ffestb_V0264_ -- "FIND" OPEN_PAREN [external-file-unit COMMA] 18626 18627 return ffestb_V0264_; // to lexer 18628 18629 Handle expr construct (not NAME=expr construct) here. */ 18630 18631static ffelexHandler 18632ffestb_V0264_ (ffelexToken t) 18633{ 18634 ffestrGenio kw; 18635 18636 ffestb_local_.find.label = FALSE; 18637 18638 switch (ffelex_token_type (t)) 18639 { 18640 case FFELEX_typeNAME: 18641 kw = ffestr_genio (t); 18642 switch (kw) 18643 { 18644 case FFESTR_genioERR: 18645 ffestb_local_.find.ix = FFESTP_findixERR; 18646 ffestb_local_.find.label = TRUE; 18647 break; 18648 18649 case FFESTR_genioIOSTAT: 18650 ffestb_local_.find.ix = FFESTP_findixIOSTAT; 18651 ffestb_local_.find.left = TRUE; 18652 ffestb_local_.find.context = FFEEXPR_contextFILEINT; 18653 break; 18654 18655 case FFESTR_genioREC: 18656 ffestb_local_.find.ix = FFESTP_findixREC; 18657 ffestb_local_.find.left = FALSE; 18658 ffestb_local_.find.context = FFEEXPR_contextFILENUM; 18659 break; 18660 18661 case FFESTR_genioUNIT: 18662 ffestb_local_.find.ix = FFESTP_findixUNIT; 18663 ffestb_local_.find.left = FALSE; 18664 ffestb_local_.find.context = FFEEXPR_contextFILENUM; 18665 break; 18666 18667 default: 18668 goto bad; /* :::::::::::::::::::: */ 18669 } 18670 if (ffestp_file.find.find_spec[ffestb_local_.find.ix] 18671 .kw_or_val_present) 18672 break; /* Can't specify a keyword twice! */ 18673 ffestp_file.find.find_spec[ffestb_local_.find.ix] 18674 .kw_or_val_present = TRUE; 18675 ffestp_file.find.find_spec[ffestb_local_.find.ix] 18676 .kw_present = TRUE; 18677 ffestp_file.find.find_spec[ffestb_local_.find.ix] 18678 .value_present = FALSE; 18679 ffestp_file.find.find_spec[ffestb_local_.find.ix].value_is_label 18680 = ffestb_local_.find.label; 18681 ffestp_file.find.find_spec[ffestb_local_.find.ix].kw 18682 = ffelex_token_use (t); 18683 return (ffelexHandler) ffestb_V0265_; 18684 18685 default: 18686 break; 18687 } 18688 18689bad: /* :::::::::::::::::::: */ 18690 ffestb_subr_kill_find_ (); 18691 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t); 18692 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 18693} 18694 18695/* ffestb_V0265_ -- "FIND" OPEN_PAREN [external-file-unit COMMA] NAME 18696 18697 return ffestb_V0265_; // to lexer 18698 18699 Make sure EQUALS here, send next token to expression handler. */ 18700 18701static ffelexHandler 18702ffestb_V0265_ (ffelexToken t) 18703{ 18704 switch (ffelex_token_type (t)) 18705 { 18706 case FFELEX_typeEQUALS: 18707 ffesta_confirmed (); 18708 if (ffestb_local_.find.label) 18709 return (ffelexHandler) ffestb_V0267_; 18710 if (ffestb_local_.find.left) 18711 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 18712 ffestb_local_.find.context, 18713 (ffeexprCallback) ffestb_V0266_); 18714 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 18715 ffestb_local_.find.context, 18716 (ffeexprCallback) ffestb_V0266_); 18717 18718 default: 18719 break; 18720 } 18721 18722 ffestb_subr_kill_find_ (); 18723 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t); 18724 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 18725} 18726 18727/* ffestb_V0266_ -- "FIND" OPEN_PAREN ... NAME EQUALS expr 18728 18729 (ffestb_V0266_) // to expression handler 18730 18731 Handle COMMA or CLOSE_PAREN here. */ 18732 18733static ffelexHandler 18734ffestb_V0266_ (ffelexToken ft, ffebld expr, ffelexToken t) 18735{ 18736 switch (ffelex_token_type (t)) 18737 { 18738 case FFELEX_typeCOMMA: 18739 case FFELEX_typeCLOSE_PAREN: 18740 if (expr == NULL) 18741 break; 18742 ffestp_file.find.find_spec[ffestb_local_.find.ix].value_present 18743 = TRUE; 18744 ffestp_file.find.find_spec[ffestb_local_.find.ix].value 18745 = ffelex_token_use (ft); 18746 ffestp_file.find.find_spec[ffestb_local_.find.ix].u.expr = expr; 18747 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 18748 return (ffelexHandler) ffestb_V0264_; 18749 return (ffelexHandler) ffestb_V0269_; 18750 18751 default: 18752 break; 18753 } 18754 18755 ffestb_subr_kill_find_ (); 18756 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t); 18757 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 18758} 18759 18760/* ffestb_V0267_ -- "FIND" OPEN_PAREN ... NAME EQUALS 18761 18762 return ffestb_V0267_; // to lexer 18763 18764 Handle NUMBER for label here. */ 18765 18766static ffelexHandler 18767ffestb_V0267_ (ffelexToken t) 18768{ 18769 switch (ffelex_token_type (t)) 18770 { 18771 case FFELEX_typeNUMBER: 18772 ffestp_file.find.find_spec[ffestb_local_.find.ix].value_present 18773 = TRUE; 18774 ffestp_file.find.find_spec[ffestb_local_.find.ix].value 18775 = ffelex_token_use (t); 18776 return (ffelexHandler) ffestb_V0268_; 18777 18778 default: 18779 break; 18780 } 18781 18782 ffestb_subr_kill_find_ (); 18783 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t); 18784 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 18785} 18786 18787/* ffestb_V0268_ -- "FIND" OPEN_PAREN ... NAME EQUALS NUMBER 18788 18789 return ffestb_V0268_; // to lexer 18790 18791 Handle COMMA or CLOSE_PAREN here. */ 18792 18793static ffelexHandler 18794ffestb_V0268_ (ffelexToken t) 18795{ 18796 switch (ffelex_token_type (t)) 18797 { 18798 case FFELEX_typeCOMMA: 18799 return (ffelexHandler) ffestb_V0264_; 18800 18801 case FFELEX_typeCLOSE_PAREN: 18802 return (ffelexHandler) ffestb_V0269_; 18803 18804 default: 18805 break; 18806 } 18807 18808 ffestb_subr_kill_find_ (); 18809 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t); 18810 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 18811} 18812 18813/* ffestb_V0269_ -- "FIND" OPEN_PAREN ... CLOSE_PAREN 18814 18815 return ffestb_V0269_; // to lexer 18816 18817 Handle EOS or SEMICOLON here. */ 18818 18819static ffelexHandler 18820ffestb_V0269_ (ffelexToken t) 18821{ 18822 switch (ffelex_token_type (t)) 18823 { 18824 case FFELEX_typeEOS: 18825 case FFELEX_typeSEMICOLON: 18826 ffesta_confirmed (); 18827 if (!ffesta_is_inhibited ()) 18828 ffestc_V026 (); 18829 ffestb_subr_kill_find_ (); 18830 return (ffelexHandler) ffesta_zero (t); 18831 18832 default: 18833 break; 18834 } 18835 18836 ffestb_subr_kill_find_ (); 18837 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t); 18838 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 18839} 18840 18841#endif 18842/* ffestb_dimlist -- Parse the ALLOCATABLE/POINTER/TARGET statement 18843 18844 return ffestb_dimlist; // to lexer 18845 18846 Make sure the statement has a valid form for the ALLOCATABLE/POINTER/ 18847 TARGET statement. If it does, implement the statement. */ 18848 18849#if FFESTR_F90 18850ffelexHandler 18851ffestb_dimlist (ffelexToken t) 18852{ 18853 ffeTokenLength i; 18854 const char *p; 18855 ffelexToken nt; 18856 ffelexHandler next; 18857 18858 switch (ffelex_token_type (ffesta_tokens[0])) 18859 { 18860 case FFELEX_typeNAME: 18861 switch (ffelex_token_type (t)) 18862 { 18863 case FFELEX_typeCOMMA: 18864 case FFELEX_typeEOS: 18865 case FFELEX_typeSEMICOLON: 18866 ffesta_confirmed (); /* Error, but clearly intended. */ 18867 goto bad_1; /* :::::::::::::::::::: */ 18868 18869 default: 18870 goto bad_1; /* :::::::::::::::::::: */ 18871 18872 case FFELEX_typeCOLONCOLON: 18873 ffesta_confirmed (); 18874 if (!ffesta_is_inhibited ()) 18875 { 18876 switch (ffesta_first_kw) 18877 { 18878 case FFESTR_firstALLOCATABLE: 18879 ffestc_R525_start (); 18880 break; 18881 18882 case FFESTR_firstPOINTER: 18883 ffestc_R526_start (); 18884 break; 18885 18886 case FFESTR_firstTARGET: 18887 ffestc_R527_start (); 18888 break; 18889 18890 default: 18891 assert (FALSE); 18892 } 18893 } 18894 ffestb_local_.dimlist.started = TRUE; 18895 return (ffelexHandler) ffestb_dimlist1_; 18896 18897 case FFELEX_typeNAME: 18898 ffesta_confirmed (); 18899 if (!ffesta_is_inhibited ()) 18900 { 18901 switch (ffesta_first_kw) 18902 { 18903 case FFESTR_firstALLOCATABLE: 18904 ffestc_R525_start (); 18905 break; 18906 18907 case FFESTR_firstPOINTER: 18908 ffestc_R526_start (); 18909 break; 18910 18911 case FFESTR_firstTARGET: 18912 ffestc_R527_start (); 18913 break; 18914 18915 default: 18916 assert (FALSE); 18917 } 18918 } 18919 ffestb_local_.dimlist.started = TRUE; 18920 return (ffelexHandler) ffestb_dimlist1_ (t); 18921 } 18922 18923 case FFELEX_typeNAMES: 18924 p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.dimlist.len); 18925 switch (ffelex_token_type (t)) 18926 { 18927 default: 18928 goto bad_1; /* :::::::::::::::::::: */ 18929 18930 case FFELEX_typeEOS: 18931 case FFELEX_typeSEMICOLON: 18932 case FFELEX_typeCOMMA: 18933 ffesta_confirmed (); 18934 if (!ffesrc_is_name_init (*p)) 18935 goto bad_i; /* :::::::::::::::::::: */ 18936 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); 18937 if (!ffesta_is_inhibited ()) 18938 { 18939 switch (ffesta_first_kw) 18940 { 18941 case FFESTR_firstALLOCATABLE: 18942 ffestc_R525_start (); 18943 break; 18944 18945 case FFESTR_firstPOINTER: 18946 ffestc_R526_start (); 18947 break; 18948 18949 case FFESTR_firstTARGET: 18950 ffestc_R527_start (); 18951 break; 18952 18953 default: 18954 assert (FALSE); 18955 } 18956 } 18957 ffestb_local_.dimlist.started = TRUE; 18958 next = (ffelexHandler) ffestb_dimlist1_ (nt); 18959 ffelex_token_kill (nt); 18960 return (ffelexHandler) (*next) (t); 18961 18962 case FFELEX_typeCOLONCOLON: 18963 ffesta_confirmed (); 18964 if (*p != '\0') 18965 goto bad_i; /* :::::::::::::::::::: */ 18966 if (!ffesta_is_inhibited ()) 18967 { 18968 switch (ffesta_first_kw) 18969 { 18970 case FFESTR_firstALLOCATABLE: 18971 ffestc_R525_start (); 18972 break; 18973 18974 case FFESTR_firstPOINTER: 18975 ffestc_R526_start (); 18976 break; 18977 18978 case FFESTR_firstTARGET: 18979 ffestc_R527_start (); 18980 break; 18981 18982 default: 18983 assert (FALSE); 18984 } 18985 } 18986 ffestb_local_.dimlist.started = TRUE; 18987 return (ffelexHandler) ffestb_dimlist1_; 18988 18989 case FFELEX_typeOPEN_PAREN: 18990 if (!ffesrc_is_name_init (*p)) 18991 goto bad_i; /* :::::::::::::::::::: */ 18992 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); 18993 ffestb_local_.dimlist.started = FALSE; 18994 next = (ffelexHandler) ffestb_dimlist1_ (nt); 18995 ffelex_token_kill (nt); 18996 return (ffelexHandler) (*next) (t); 18997 } 18998 18999 default: 19000 goto bad_0; /* :::::::::::::::::::: */ 19001 } 19002 19003bad_0: /* :::::::::::::::::::: */ 19004 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, ffesta_tokens[0]); 19005 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 19006 19007bad_1: /* :::::::::::::::::::: */ 19008 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t); 19009 return (ffelexHandler) ffelex_swallow_tokens (t, 19010 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 19011 19012bad_i: /* :::::::::::::::::::: */ 19013 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, ffesta_tokens[0], i, t); 19014 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 19015} 19016 19017/* ffestb_dimlist1_ -- "ALLOCATABLE/POINTER/TARGET" [COLONCOLON] 19018 19019 return ffestb_dimlist1_; // to lexer 19020 19021 Handle NAME. */ 19022 19023static ffelexHandler 19024ffestb_dimlist1_ (ffelexToken t) 19025{ 19026 switch (ffelex_token_type (t)) 19027 { 19028 case FFELEX_typeNAME: 19029 ffesta_tokens[1] = ffelex_token_use (t); 19030 return (ffelexHandler) ffestb_dimlist2_; 19031 19032 default: 19033 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t); 19034 break; 19035 } 19036 19037 if (!ffesta_is_inhibited ()) 19038 { 19039 switch (ffesta_first_kw) 19040 { 19041 case FFESTR_firstALLOCATABLE: 19042 ffestc_R525_finish (); 19043 break; 19044 19045 case FFESTR_firstPOINTER: 19046 ffestc_R526_finish (); 19047 break; 19048 19049 case FFESTR_firstTARGET: 19050 ffestc_R527_finish (); 19051 break; 19052 19053 default: 19054 assert (FALSE); 19055 } 19056 } 19057 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 19058} 19059 19060/* ffestb_dimlist2_ -- "ALLOCATABLE/POINTER/TARGET" ... NAME 19061 19062 return ffestb_dimlist2_; // to lexer 19063 19064 Handle OPEN_PAREN. */ 19065 19066static ffelexHandler 19067ffestb_dimlist2_ (ffelexToken t) 19068{ 19069 switch (ffelex_token_type (t)) 19070 { 19071 case FFELEX_typeOPEN_PAREN: 19072 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create (); 19073 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_dimlist3_; 19074 ffestb_subrargs_.dim_list.pool = ffesta_output_pool; 19075 ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLIST; 19076#ifdef FFECOM_dimensionsMAX 19077 ffestb_subrargs_.dim_list.ndims = 0; 19078#endif 19079 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 19080 FFEEXPR_contextDIMLIST, (ffeexprCallback) ffestb_subr_dimlist_); 19081 19082 case FFELEX_typeCOMMA: 19083 ffesta_confirmed (); 19084 if (!ffesta_is_inhibited ()) 19085 { 19086 if (!ffestb_local_.dimlist.started) 19087 { 19088 switch (ffesta_first_kw) 19089 { 19090 case FFESTR_firstALLOCATABLE: 19091 ffestc_R525_start (); 19092 break; 19093 19094 case FFESTR_firstPOINTER: 19095 ffestc_R526_start (); 19096 break; 19097 19098 case FFESTR_firstTARGET: 19099 ffestc_R527_start (); 19100 break; 19101 19102 default: 19103 assert (FALSE); 19104 } 19105 ffestb_local_.dimlist.started = TRUE; 19106 } 19107 switch (ffesta_first_kw) 19108 { 19109 case FFESTR_firstALLOCATABLE: 19110 ffestc_R525_item (ffesta_tokens[1], NULL); 19111 break; 19112 19113 case FFESTR_firstPOINTER: 19114 ffestc_R526_item (ffesta_tokens[1], NULL); 19115 break; 19116 19117 case FFESTR_firstTARGET: 19118 ffestc_R527_item (ffesta_tokens[1], NULL); 19119 break; 19120 19121 default: 19122 assert (FALSE); 19123 } 19124 } 19125 ffelex_token_kill (ffesta_tokens[1]); 19126 return (ffelexHandler) ffestb_dimlist4_; 19127 19128 case FFELEX_typeEOS: 19129 case FFELEX_typeSEMICOLON: 19130 ffesta_confirmed (); 19131 if (!ffesta_is_inhibited ()) 19132 { 19133 if (!ffestb_local_.dimlist.started) 19134 { 19135 switch (ffesta_first_kw) 19136 { 19137 case FFESTR_firstALLOCATABLE: 19138 ffestc_R525_start (); 19139 break; 19140 19141 case FFESTR_firstPOINTER: 19142 ffestc_R526_start (); 19143 break; 19144 19145 case FFESTR_firstTARGET: 19146 ffestc_R527_start (); 19147 break; 19148 19149 default: 19150 assert (FALSE); 19151 } 19152 } 19153 switch (ffesta_first_kw) 19154 { 19155 case FFESTR_firstALLOCATABLE: 19156 ffestc_R525_item (ffesta_tokens[1], NULL); 19157 ffestc_R525_finish (); 19158 break; 19159 19160 case FFESTR_firstPOINTER: 19161 ffestc_R526_item (ffesta_tokens[1], NULL); 19162 ffestc_R526_finish (); 19163 break; 19164 19165 case FFESTR_firstTARGET: 19166 ffestc_R527_item (ffesta_tokens[1], NULL); 19167 ffestc_R527_finish (); 19168 break; 19169 19170 default: 19171 assert (FALSE); 19172 } 19173 } 19174 ffelex_token_kill (ffesta_tokens[1]); 19175 return (ffelexHandler) ffesta_zero (t); 19176 19177 default: 19178 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t); 19179 break; 19180 } 19181 19182 if (!ffesta_is_inhibited ()) 19183 { 19184 switch (ffesta_first_kw) 19185 { 19186 case FFESTR_firstALLOCATABLE: 19187 ffestc_R525_finish (); 19188 break; 19189 19190 case FFESTR_firstPOINTER: 19191 ffestc_R526_finish (); 19192 break; 19193 19194 case FFESTR_firstTARGET: 19195 ffestc_R527_finish (); 19196 break; 19197 19198 default: 19199 assert (FALSE); 19200 } 19201 } 19202 ffelex_token_kill (ffesta_tokens[1]); 19203 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 19204} 19205 19206/* ffestb_dimlist3_ -- "ALLOCATABLE/POINTER/TARGET" ... NAME OPEN_PAREN 19207 dimlist CLOSE_PAREN 19208 19209 return ffestb_dimlist3_; // to lexer 19210 19211 Handle COMMA or EOS/SEMICOLON. */ 19212 19213static ffelexHandler 19214ffestb_dimlist3_ (ffelexToken t) 19215{ 19216 if (!ffestb_subrargs_.dim_list.ok) 19217 goto bad; /* :::::::::::::::::::: */ 19218 19219 switch (ffelex_token_type (t)) 19220 { 19221 case FFELEX_typeCOMMA: 19222 ffesta_confirmed (); 19223 if (!ffesta_is_inhibited ()) 19224 { 19225 if (!ffestb_local_.dimlist.started) 19226 { 19227 switch (ffesta_first_kw) 19228 { 19229 case FFESTR_firstALLOCATABLE: 19230 ffestc_R525_start (); 19231 break; 19232 19233 case FFESTR_firstPOINTER: 19234 ffestc_R526_start (); 19235 break; 19236 19237 case FFESTR_firstTARGET: 19238 ffestc_R527_start (); 19239 break; 19240 19241 default: 19242 assert (FALSE); 19243 } 19244 ffestb_local_.dimlist.started = TRUE; 19245 } 19246 switch (ffesta_first_kw) 19247 { 19248 case FFESTR_firstALLOCATABLE: 19249 ffestc_R525_item (ffesta_tokens[1], 19250 ffestb_subrargs_.dim_list.dims); 19251 break; 19252 19253 case FFESTR_firstPOINTER: 19254 ffestc_R526_item (ffesta_tokens[1], 19255 ffestb_subrargs_.dim_list.dims); 19256 break; 19257 19258 case FFESTR_firstTARGET: 19259 ffestc_R527_item (ffesta_tokens[1], 19260 ffestb_subrargs_.dim_list.dims); 19261 break; 19262 19263 default: 19264 assert (FALSE); 19265 } 19266 } 19267 ffelex_token_kill (ffesta_tokens[1]); 19268 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 19269 return (ffelexHandler) ffestb_dimlist4_; 19270 19271 case FFELEX_typeEOS: 19272 case FFELEX_typeSEMICOLON: 19273 ffesta_confirmed (); 19274 if (!ffesta_is_inhibited ()) 19275 { 19276 if (!ffestb_local_.dimlist.started) 19277 { 19278 switch (ffesta_first_kw) 19279 { 19280 case FFESTR_firstALLOCATABLE: 19281 ffestc_R525_start (); 19282 break; 19283 19284 case FFESTR_firstPOINTER: 19285 ffestc_R526_start (); 19286 break; 19287 19288 case FFESTR_firstTARGET: 19289 ffestc_R527_start (); 19290 break; 19291 19292 default: 19293 assert (FALSE); 19294 } 19295 } 19296 switch (ffesta_first_kw) 19297 { 19298 case FFESTR_firstALLOCATABLE: 19299 ffestc_R525_item (ffesta_tokens[1], 19300 ffestb_subrargs_.dim_list.dims); 19301 ffestc_R525_finish (); 19302 break; 19303 19304 case FFESTR_firstPOINTER: 19305 ffestc_R526_item (ffesta_tokens[1], 19306 ffestb_subrargs_.dim_list.dims); 19307 ffestc_R526_finish (); 19308 break; 19309 19310 case FFESTR_firstTARGET: 19311 ffestc_R527_item (ffesta_tokens[1], 19312 ffestb_subrargs_.dim_list.dims); 19313 ffestc_R527_finish (); 19314 break; 19315 19316 default: 19317 assert (FALSE); 19318 } 19319 } 19320 ffelex_token_kill (ffesta_tokens[1]); 19321 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 19322 return (ffelexHandler) ffesta_zero (t); 19323 19324 default: 19325 break; 19326 } 19327 19328bad: /* :::::::::::::::::::: */ 19329 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t); 19330 if (ffestb_local_.dimlist.started && !ffesta_is_inhibited ()) 19331 { 19332 switch (ffesta_first_kw) 19333 { 19334 case FFESTR_firstALLOCATABLE: 19335 ffestc_R525_finish (); 19336 break; 19337 19338 case FFESTR_firstPOINTER: 19339 ffestc_R526_finish (); 19340 break; 19341 19342 case FFESTR_firstTARGET: 19343 ffestc_R527_finish (); 19344 break; 19345 19346 default: 19347 assert (FALSE); 19348 } 19349 } 19350 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 19351 ffelex_token_kill (ffesta_tokens[1]); 19352 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 19353} 19354 19355/* ffestb_dimlist4_ -- "ALLOCATABLE/POINTER/TARGET" ... COMMA 19356 19357 return ffestb_dimlist4_; // to lexer 19358 19359 Make sure we don't have EOS or SEMICOLON. */ 19360 19361static ffelexHandler 19362ffestb_dimlist4_ (ffelexToken t) 19363{ 19364 switch (ffelex_token_type (t)) 19365 { 19366 case FFELEX_typeEOS: 19367 case FFELEX_typeSEMICOLON: 19368 if (!ffesta_is_inhibited ()) 19369 { 19370 switch (ffesta_first_kw) 19371 { 19372 case FFESTR_firstALLOCATABLE: 19373 ffestc_R525_finish (); 19374 break; 19375 19376 case FFESTR_firstPOINTER: 19377 ffestc_R526_finish (); 19378 break; 19379 19380 case FFESTR_firstTARGET: 19381 ffestc_R527_finish (); 19382 break; 19383 19384 default: 19385 assert (FALSE); 19386 } 19387 } 19388 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t); 19389 return (ffelexHandler) ffesta_zero (t); 19390 19391 default: 19392 return (ffelexHandler) ffestb_dimlist1_ (t); 19393 } 19394} 19395 19396#endif 19397/* ffestb_dummy -- Parse an ENTRY/FUNCTION/SUBROUTINE statement 19398 19399 return ffestb_dummy; // to lexer 19400 19401 Make sure the statement has a valid form for an ENTRY/FUNCTION/SUBROUTINE 19402 statement. If it does, implement the statement. */ 19403 19404ffelexHandler 19405ffestb_dummy (ffelexToken t) 19406{ 19407 ffeTokenLength i; 19408 unsigned const char *p; 19409 19410 switch (ffelex_token_type (ffesta_tokens[0])) 19411 { 19412 case FFELEX_typeNAME: 19413 switch (ffelex_token_type (t)) 19414 { 19415 case FFELEX_typeEOS: 19416 case FFELEX_typeSEMICOLON: 19417 case FFELEX_typeCOMMA: 19418 case FFELEX_typeCOLONCOLON: 19419 ffesta_confirmed (); /* Error, but clearly intended. */ 19420 goto bad_1; /* :::::::::::::::::::: */ 19421 19422 default: 19423 goto bad_1; /* :::::::::::::::::::: */ 19424 19425 case FFELEX_typeNAME: 19426 break; 19427 } 19428 19429 ffesta_confirmed (); 19430 ffesta_tokens[1] = ffelex_token_use (t); 19431 ffestb_local_.decl.recursive = NULL; 19432 ffestb_local_.dummy.badname = ffestb_args.dummy.badname; 19433 ffestb_local_.dummy.is_subr = ffestb_args.dummy.is_subr; 19434 ffestb_local_.dummy.first_kw = ffesta_first_kw; 19435 return (ffelexHandler) ffestb_dummy1_; 19436 19437 case FFELEX_typeNAMES: 19438 switch (ffelex_token_type (t)) 19439 { 19440 case FFELEX_typeCOMMA: 19441 case FFELEX_typeCOLONCOLON: 19442 ffesta_confirmed (); /* Error, but clearly intended. */ 19443 goto bad_1; /* :::::::::::::::::::: */ 19444 19445 default: 19446 goto bad_1; /* :::::::::::::::::::: */ 19447 19448 case FFELEX_typeEOS: 19449 case FFELEX_typeSEMICOLON: 19450 ffesta_confirmed (); 19451 break; 19452 19453 case FFELEX_typeOPEN_PAREN: 19454 break; 19455 } 19456 p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.dummy.len); 19457 if (!ffesrc_is_name_init (*p)) 19458 goto bad_i; /* :::::::::::::::::::: */ 19459 ffesta_tokens[1] 19460 = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); 19461 ffestb_local_.decl.recursive = NULL; 19462 ffestb_local_.dummy.badname = ffestb_args.dummy.badname; 19463 ffestb_local_.dummy.is_subr = ffestb_args.dummy.is_subr; 19464 ffestb_local_.dummy.first_kw = ffesta_first_kw; 19465 return (ffelexHandler) ffestb_dummy1_ (t); 19466 19467 default: 19468 goto bad_0; /* :::::::::::::::::::: */ 19469 } 19470 19471bad_0: /* :::::::::::::::::::: */ 19472 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dummy.badname, ffesta_tokens[0]); 19473 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 19474 19475bad_1: /* :::::::::::::::::::: */ 19476 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dummy.badname, t); 19477 return (ffelexHandler) ffelex_swallow_tokens (t, 19478 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 19479 19480bad_i: /* :::::::::::::::::::: */ 19481 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.dummy.badname, ffesta_tokens[0], i, t); 19482 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 19483} 19484 19485/* ffestb_dummy1_ -- "ENTRY/FUNCTION/SUBROUTINE" NAME 19486 19487 return ffestb_dummy1_; // to lexer 19488 19489 Make sure the next token is an EOS, SEMICOLON, or OPEN_PAREN. In the 19490 former case, just implement a null arg list, else get the arg list and 19491 then implement. */ 19492 19493static ffelexHandler 19494ffestb_dummy1_ (ffelexToken t) 19495{ 19496 switch (ffelex_token_type (t)) 19497 { 19498 case FFELEX_typeEOS: 19499 case FFELEX_typeSEMICOLON: 19500 if (ffestb_local_.dummy.first_kw == FFESTR_firstFUNCTION) 19501 { 19502 ffesta_confirmed (); /* Later, not if typename w/o RECURSIVE. */ 19503 break; /* Produce an error message, need that open 19504 paren. */ 19505 } 19506 ffesta_confirmed (); 19507 if (!ffesta_is_inhibited ()) 19508 { /* Pretend as though we got a truly NULL 19509 list. */ 19510 ffestb_subrargs_.name_list.args = NULL; 19511 ffestb_subrargs_.name_list.ok = TRUE; 19512 ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t); 19513 return (ffelexHandler) ffestb_dummy2_ (t); 19514 } 19515 if (ffestb_local_.decl.recursive != NULL) 19516 ffelex_token_kill (ffestb_local_.decl.recursive); 19517 ffelex_token_kill (ffesta_tokens[1]); 19518 return (ffelexHandler) ffesta_zero (t); 19519 19520 case FFELEX_typeOPEN_PAREN: 19521 ffestb_subrargs_.name_list.args = ffestt_tokenlist_create (); 19522 ffestb_subrargs_.name_list.handler = (ffelexHandler) ffestb_dummy2_; 19523 ffestb_subrargs_.name_list.is_subr = ffestb_local_.dummy.is_subr; 19524 ffestb_subrargs_.name_list.names = FALSE; 19525 return (ffelexHandler) ffestb_subr_name_list_; 19526 19527 default: 19528 break; 19529 } 19530 19531 if (ffestb_local_.decl.recursive != NULL) 19532 ffelex_token_kill (ffestb_local_.decl.recursive); 19533 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_local_.dummy.badname, t); 19534 ffelex_token_kill (ffesta_tokens[1]); 19535 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 19536} 19537 19538/* ffestb_dummy2_ -- <dummy-keyword> NAME OPEN_PAREN arg-list CLOSE_PAREN 19539 19540 return ffestb_dummy2_; // to lexer 19541 19542 Make sure the statement has a valid form for a dummy-def statement. If it 19543 does, implement the statement. */ 19544 19545static ffelexHandler 19546ffestb_dummy2_ (ffelexToken t) 19547{ 19548 if (!ffestb_subrargs_.name_list.ok) 19549 goto bad; /* :::::::::::::::::::: */ 19550 19551 switch (ffelex_token_type (t)) 19552 { 19553 case FFELEX_typeEOS: 19554 case FFELEX_typeSEMICOLON: 19555 ffesta_confirmed (); 19556 if (!ffesta_is_inhibited ()) 19557 { 19558 switch (ffestb_local_.dummy.first_kw) 19559 { 19560 case FFESTR_firstFUNCTION: 19561 ffestc_R1219 (ffesta_tokens[1], ffestb_subrargs_.name_list.args, 19562 ffestb_subrargs_.name_list.close_paren, FFESTP_typeNone, 19563 NULL, NULL, NULL, NULL, ffestb_local_.decl.recursive, NULL); 19564 break; 19565 19566 case FFESTR_firstSUBROUTINE: 19567 ffestc_R1223 (ffesta_tokens[1], ffestb_subrargs_.name_list.args, 19568 ffestb_subrargs_.name_list.close_paren, 19569 ffestb_local_.decl.recursive); 19570 break; 19571 19572 case FFESTR_firstENTRY: 19573 ffestc_R1226 (ffesta_tokens[1], ffestb_subrargs_.name_list.args, 19574 ffestb_subrargs_.name_list.close_paren); 19575 break; 19576 19577 default: 19578 assert (FALSE); 19579 } 19580 } 19581 ffelex_token_kill (ffesta_tokens[1]); 19582 if (ffestb_local_.decl.recursive != NULL) 19583 ffelex_token_kill (ffestb_local_.decl.recursive); 19584 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren); 19585 if (ffestb_subrargs_.name_list.args != NULL) 19586 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args); 19587 return (ffelexHandler) ffesta_zero (t); 19588 19589 case FFELEX_typeNAME: 19590 ffesta_confirmed (); 19591 if ((ffestb_local_.dummy.first_kw != FFESTR_firstFUNCTION) 19592 || (ffestr_other (t) != FFESTR_otherRESULT)) 19593 break; 19594 ffestb_local_.decl.type = FFESTP_typeNone; 19595 ffestb_local_.decl.kind = NULL; 19596 ffestb_local_.decl.kindt = NULL; 19597 ffestb_local_.decl.len = NULL; 19598 ffestb_local_.decl.lent = NULL; 19599 return (ffelexHandler) ffestb_decl_funcname_6_; 19600 19601 default: 19602 break; 19603 } 19604 19605bad: /* :::::::::::::::::::: */ 19606 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_local_.dummy.badname, t); 19607 ffelex_token_kill (ffesta_tokens[1]); 19608 if (ffestb_local_.decl.recursive != NULL) 19609 ffelex_token_kill (ffestb_local_.decl.recursive); 19610 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren); 19611 if (ffestb_subrargs_.name_list.args != NULL) 19612 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args); 19613 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 19614} 19615 19616/* ffestb_R524 -- Parse the DIMENSION statement 19617 19618 return ffestb_R524; // to lexer 19619 19620 Make sure the statement has a valid form for the DIMENSION statement. If 19621 it does, implement the statement. */ 19622 19623ffelexHandler 19624ffestb_R524 (ffelexToken t) 19625{ 19626 ffeTokenLength i; 19627 unsigned const char *p; 19628 ffelexToken nt; 19629 ffelexHandler next; 19630 19631 switch (ffelex_token_type (ffesta_tokens[0])) 19632 { 19633 case FFELEX_typeNAME: 19634 switch (ffelex_token_type (t)) 19635 { 19636 case FFELEX_typeCOMMA: 19637 case FFELEX_typeCOLONCOLON: 19638 case FFELEX_typeEOS: 19639 case FFELEX_typeSEMICOLON: 19640 ffesta_confirmed (); /* Error, but clearly intended. */ 19641 goto bad_1; /* :::::::::::::::::::: */ 19642 19643 default: 19644 goto bad_1; /* :::::::::::::::::::: */ 19645 19646 case FFELEX_typeNAME: 19647 ffesta_confirmed (); 19648 if (!ffesta_is_inhibited ()) 19649 ffestc_R524_start (ffesta_first_kw == FFESTR_firstVIRTUAL); 19650 ffestb_local_.dimension.started = TRUE; 19651 return (ffelexHandler) ffestb_R5241_ (t); 19652 } 19653 19654 case FFELEX_typeNAMES: 19655 p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.R524.len); 19656 switch (ffelex_token_type (t)) 19657 { 19658 default: 19659 goto bad_1; /* :::::::::::::::::::: */ 19660 19661 case FFELEX_typeEOS: 19662 case FFELEX_typeSEMICOLON: 19663 case FFELEX_typeCOMMA: 19664 case FFELEX_typeCOLONCOLON: 19665 ffesta_confirmed (); 19666 goto bad_1; /* :::::::::::::::::::: */ 19667 19668 case FFELEX_typeOPEN_PAREN: 19669 break; 19670 } 19671 19672 /* Here, we have at least one char after "DIMENSION" and t is 19673 OPEN_PAREN. */ 19674 19675 if (!ffesrc_is_name_init (*p)) 19676 goto bad_i; /* :::::::::::::::::::: */ 19677 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); 19678 ffestb_local_.dimension.started = FALSE; 19679 next = (ffelexHandler) ffestb_R5241_ (nt); 19680 ffelex_token_kill (nt); 19681 return (ffelexHandler) (*next) (t); 19682 19683 default: 19684 goto bad_0; /* :::::::::::::::::::: */ 19685 } 19686 19687bad_0: /* :::::::::::::::::::: */ 19688 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, ffesta_tokens[0]); 19689 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 19690 19691bad_1: /* :::::::::::::::::::: */ 19692 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t); 19693 return (ffelexHandler) ffelex_swallow_tokens (t, 19694 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 19695 19696bad_i: /* :::::::::::::::::::: */ 19697 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, ffesta_tokens[0], i, t); 19698 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 19699} 19700 19701/* ffestb_R5241_ -- "DIMENSION" 19702 19703 return ffestb_R5241_; // to lexer 19704 19705 Handle NAME. */ 19706 19707static ffelexHandler 19708ffestb_R5241_ (ffelexToken t) 19709{ 19710 switch (ffelex_token_type (t)) 19711 { 19712 case FFELEX_typeNAME: 19713 ffesta_tokens[1] = ffelex_token_use (t); 19714 return (ffelexHandler) ffestb_R5242_; 19715 19716 default: 19717 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t); 19718 break; 19719 } 19720 19721 if (!ffesta_is_inhibited ()) 19722 ffestc_R524_finish (); 19723 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 19724} 19725 19726/* ffestb_R5242_ -- "DIMENSION" ... NAME 19727 19728 return ffestb_R5242_; // to lexer 19729 19730 Handle OPEN_PAREN. */ 19731 19732static ffelexHandler 19733ffestb_R5242_ (ffelexToken t) 19734{ 19735 switch (ffelex_token_type (t)) 19736 { 19737 case FFELEX_typeOPEN_PAREN: 19738 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create (); 19739 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_R5243_; 19740 ffestb_subrargs_.dim_list.pool = ffesta_output_pool; 19741 ffestb_subrargs_.dim_list.ctx = ffesta_is_entry_valid 19742 ? FFEEXPR_contextDIMLIST : FFEEXPR_contextDIMLISTCOMMON; 19743#ifdef FFECOM_dimensionsMAX 19744 ffestb_subrargs_.dim_list.ndims = 0; 19745#endif 19746 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 19747 ffestb_subrargs_.dim_list.ctx, 19748 (ffeexprCallback) ffestb_subr_dimlist_); 19749 19750 default: 19751 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t); 19752 break; 19753 } 19754 19755 if (!ffesta_is_inhibited ()) 19756 ffestc_R524_finish (); 19757 ffelex_token_kill (ffesta_tokens[1]); 19758 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 19759} 19760 19761/* ffestb_R5243_ -- "DIMENSION" ... NAME OPEN_PAREN dimlist CLOSE_PAREN 19762 19763 return ffestb_R5243_; // to lexer 19764 19765 Handle COMMA or EOS/SEMICOLON. */ 19766 19767static ffelexHandler 19768ffestb_R5243_ (ffelexToken t) 19769{ 19770 if (!ffestb_subrargs_.dim_list.ok) 19771 goto bad; /* :::::::::::::::::::: */ 19772 19773 switch (ffelex_token_type (t)) 19774 { 19775 case FFELEX_typeCOMMA: 19776 ffesta_confirmed (); 19777 if (!ffesta_is_inhibited ()) 19778 { 19779 if (!ffestb_local_.dimension.started) 19780 { 19781 ffestc_R524_start (ffesta_first_kw == FFESTR_firstVIRTUAL); 19782 ffestb_local_.dimension.started = TRUE; 19783 } 19784 ffestc_R524_item (ffesta_tokens[1], 19785 ffestb_subrargs_.dim_list.dims); 19786 } 19787 ffelex_token_kill (ffesta_tokens[1]); 19788 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 19789 return (ffelexHandler) ffestb_R5244_; 19790 19791 case FFELEX_typeEOS: 19792 case FFELEX_typeSEMICOLON: 19793 ffesta_confirmed (); 19794 if (!ffesta_is_inhibited ()) 19795 { 19796 if (!ffestb_local_.dimension.started) 19797 { 19798 ffestc_R524_start (ffesta_first_kw == FFESTR_firstVIRTUAL); 19799 ffestb_local_.dimension.started = TRUE; 19800 } 19801 ffestc_R524_item (ffesta_tokens[1], 19802 ffestb_subrargs_.dim_list.dims); 19803 ffestc_R524_finish (); 19804 } 19805 ffelex_token_kill (ffesta_tokens[1]); 19806 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 19807 return (ffelexHandler) ffesta_zero (t); 19808 19809 default: 19810 break; 19811 } 19812 19813bad: /* :::::::::::::::::::: */ 19814 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t); 19815 if (ffestb_local_.dimension.started && !ffesta_is_inhibited ()) 19816 ffestc_R524_finish (); 19817 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 19818 ffelex_token_kill (ffesta_tokens[1]); 19819 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 19820} 19821 19822/* ffestb_R5244_ -- "DIMENSION" ... COMMA 19823 19824 return ffestb_R5244_; // to lexer 19825 19826 Make sure we don't have EOS or SEMICOLON. */ 19827 19828static ffelexHandler 19829ffestb_R5244_ (ffelexToken t) 19830{ 19831 switch (ffelex_token_type (t)) 19832 { 19833 case FFELEX_typeEOS: 19834 case FFELEX_typeSEMICOLON: 19835 if (!ffesta_is_inhibited ()) 19836 ffestc_R524_finish (); 19837 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t); 19838 return (ffelexHandler) ffesta_zero (t); 19839 19840 default: 19841 return (ffelexHandler) ffestb_R5241_ (t); 19842 } 19843} 19844 19845/* ffestb_R547 -- Parse the COMMON statement 19846 19847 return ffestb_R547; // to lexer 19848 19849 Make sure the statement has a valid form for the COMMON statement. If it 19850 does, implement the statement. */ 19851 19852ffelexHandler 19853ffestb_R547 (ffelexToken t) 19854{ 19855 ffeTokenLength i; 19856 unsigned const char *p; 19857 ffelexToken nt; 19858 ffelexHandler next; 19859 19860 switch (ffelex_token_type (ffesta_tokens[0])) 19861 { 19862 case FFELEX_typeNAME: 19863 if (ffesta_first_kw != FFESTR_firstCOMMON) 19864 goto bad_0; /* :::::::::::::::::::: */ 19865 switch (ffelex_token_type (t)) 19866 { 19867 case FFELEX_typeCOMMA: 19868 case FFELEX_typeCOLONCOLON: 19869 case FFELEX_typeEOS: 19870 case FFELEX_typeSEMICOLON: 19871 ffesta_confirmed (); /* Error, but clearly intended. */ 19872 goto bad_1; /* :::::::::::::::::::: */ 19873 19874 default: 19875 goto bad_1; /* :::::::::::::::::::: */ 19876 19877 case FFELEX_typeNAME: 19878 case FFELEX_typeSLASH: 19879 case FFELEX_typeCONCAT: 19880 ffesta_confirmed (); 19881 if (!ffesta_is_inhibited ()) 19882 ffestc_R547_start (); 19883 ffestb_local_.common.started = TRUE; 19884 return (ffelexHandler) ffestb_R5471_ (t); 19885 } 19886 19887 case FFELEX_typeNAMES: 19888 if (ffesta_first_kw != FFESTR_firstCOMMON) 19889 goto bad_0; /* :::::::::::::::::::: */ 19890 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCOMMON); 19891 switch (ffelex_token_type (t)) 19892 { 19893 default: 19894 goto bad_1; /* :::::::::::::::::::: */ 19895 19896 case FFELEX_typeEOS: 19897 case FFELEX_typeSEMICOLON: 19898 case FFELEX_typeCOMMA: 19899 case FFELEX_typeCOLONCOLON: 19900 ffesta_confirmed (); 19901 break; 19902 19903 case FFELEX_typeSLASH: 19904 case FFELEX_typeCONCAT: 19905 ffesta_confirmed (); 19906 if (*p != '\0') 19907 break; 19908 if (!ffesta_is_inhibited ()) 19909 ffestc_R547_start (); 19910 ffestb_local_.common.started = TRUE; 19911 return (ffelexHandler) ffestb_R5471_ (t); 19912 19913 case FFELEX_typeOPEN_PAREN: 19914 break; 19915 } 19916 19917 /* Here, we have at least one char after "COMMON" and t is COMMA, 19918 EOS/SEMICOLON, OPEN_PAREN, SLASH, or CONCAT. */ 19919 19920 if (!ffesrc_is_name_init (*p)) 19921 goto bad_i; /* :::::::::::::::::::: */ 19922 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); 19923 if (ffelex_token_type (t) == FFELEX_typeOPEN_PAREN) 19924 ffestb_local_.common.started = FALSE; 19925 else 19926 { 19927 if (!ffesta_is_inhibited ()) 19928 ffestc_R547_start (); 19929 ffestb_local_.common.started = TRUE; 19930 } 19931 next = (ffelexHandler) ffestb_R5471_ (nt); 19932 ffelex_token_kill (nt); 19933 return (ffelexHandler) (*next) (t); 19934 19935 default: 19936 goto bad_0; /* :::::::::::::::::::: */ 19937 } 19938 19939bad_0: /* :::::::::::::::::::: */ 19940 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", ffesta_tokens[0]); 19941 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 19942 19943bad_1: /* :::::::::::::::::::: */ 19944 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t); 19945 return (ffelexHandler) ffelex_swallow_tokens (t, 19946 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 19947 19948bad_i: /* :::::::::::::::::::: */ 19949 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "COMMON", ffesta_tokens[0], i, t); 19950 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 19951} 19952 19953/* ffestb_R5471_ -- "COMMON" 19954 19955 return ffestb_R5471_; // to lexer 19956 19957 Handle NAME, SLASH, or CONCAT. */ 19958 19959static ffelexHandler 19960ffestb_R5471_ (ffelexToken t) 19961{ 19962 switch (ffelex_token_type (t)) 19963 { 19964 case FFELEX_typeNAME: 19965 return (ffelexHandler) ffestb_R5474_ (t); 19966 19967 case FFELEX_typeSLASH: 19968 return (ffelexHandler) ffestb_R5472_; 19969 19970 case FFELEX_typeCONCAT: 19971 if (!ffesta_is_inhibited ()) 19972 ffestc_R547_item_cblock (NULL); 19973 return (ffelexHandler) ffestb_R5474_; 19974 19975 default: 19976 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t); 19977 break; 19978 } 19979 19980 if (!ffesta_is_inhibited ()) 19981 ffestc_R547_finish (); 19982 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 19983} 19984 19985/* ffestb_R5472_ -- "COMMON" SLASH 19986 19987 return ffestb_R5472_; // to lexer 19988 19989 Handle NAME. */ 19990 19991static ffelexHandler 19992ffestb_R5472_ (ffelexToken t) 19993{ 19994 switch (ffelex_token_type (t)) 19995 { 19996 case FFELEX_typeNAME: 19997 ffesta_tokens[1] = ffelex_token_use (t); 19998 return (ffelexHandler) ffestb_R5473_; 19999 20000 case FFELEX_typeSLASH: 20001 if (!ffesta_is_inhibited ()) 20002 ffestc_R547_item_cblock (NULL); 20003 return (ffelexHandler) ffestb_R5474_; 20004 20005 default: 20006 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t); 20007 break; 20008 } 20009 20010 if (!ffesta_is_inhibited ()) 20011 ffestc_R547_finish (); 20012 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 20013} 20014 20015/* ffestb_R5473_ -- "COMMON" SLASH NAME 20016 20017 return ffestb_R5473_; // to lexer 20018 20019 Handle SLASH. */ 20020 20021static ffelexHandler 20022ffestb_R5473_ (ffelexToken t) 20023{ 20024 switch (ffelex_token_type (t)) 20025 { 20026 case FFELEX_typeSLASH: 20027 if (!ffesta_is_inhibited ()) 20028 ffestc_R547_item_cblock (ffesta_tokens[1]); 20029 ffelex_token_kill (ffesta_tokens[1]); 20030 return (ffelexHandler) ffestb_R5474_; 20031 20032 default: 20033 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t); 20034 break; 20035 } 20036 20037 if (!ffesta_is_inhibited ()) 20038 ffestc_R547_finish (); 20039 ffelex_token_kill (ffesta_tokens[1]); 20040 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 20041} 20042 20043/* ffestb_R5474_ -- "COMMON" [SLASH NAME SLASH] or "COMMON" CONCAT 20044 20045 return ffestb_R5474_; // to lexer 20046 20047 Handle NAME. */ 20048 20049static ffelexHandler 20050ffestb_R5474_ (ffelexToken t) 20051{ 20052 switch (ffelex_token_type (t)) 20053 { 20054 case FFELEX_typeNAME: 20055 ffesta_tokens[1] = ffelex_token_use (t); 20056 return (ffelexHandler) ffestb_R5475_; 20057 20058 default: 20059 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t); 20060 break; 20061 } 20062 20063 if (!ffesta_is_inhibited ()) 20064 ffestc_R547_finish (); 20065 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 20066} 20067 20068/* ffestb_R5475_ -- "COMMON" ... NAME 20069 20070 return ffestb_R5475_; // to lexer 20071 20072 Handle OPEN_PAREN. */ 20073 20074static ffelexHandler 20075ffestb_R5475_ (ffelexToken t) 20076{ 20077 switch (ffelex_token_type (t)) 20078 { 20079 case FFELEX_typeOPEN_PAREN: 20080 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create (); 20081 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_R5476_; 20082 ffestb_subrargs_.dim_list.pool = ffesta_output_pool; 20083 ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLISTCOMMON; 20084#ifdef FFECOM_dimensionsMAX 20085 ffestb_subrargs_.dim_list.ndims = 0; 20086#endif 20087 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 20088 FFEEXPR_contextDIMLISTCOMMON, (ffeexprCallback) ffestb_subr_dimlist_); 20089 20090 case FFELEX_typeCOMMA: 20091 if (!ffesta_is_inhibited ()) 20092 ffestc_R547_item_object (ffesta_tokens[1], NULL); 20093 ffelex_token_kill (ffesta_tokens[1]); 20094 return (ffelexHandler) ffestb_R5477_; 20095 20096 case FFELEX_typeSLASH: 20097 case FFELEX_typeCONCAT: 20098 if (!ffesta_is_inhibited ()) 20099 ffestc_R547_item_object (ffesta_tokens[1], NULL); 20100 ffelex_token_kill (ffesta_tokens[1]); 20101 return (ffelexHandler) ffestb_R5471_ (t); 20102 20103 case FFELEX_typeEOS: 20104 case FFELEX_typeSEMICOLON: 20105 if (!ffesta_is_inhibited ()) 20106 { 20107 ffestc_R547_item_object (ffesta_tokens[1], NULL); 20108 ffestc_R547_finish (); 20109 } 20110 ffelex_token_kill (ffesta_tokens[1]); 20111 return (ffelexHandler) ffesta_zero (t); 20112 20113 default: 20114 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t); 20115 break; 20116 } 20117 20118 if (!ffesta_is_inhibited ()) 20119 ffestc_R547_finish (); 20120 ffelex_token_kill (ffesta_tokens[1]); 20121 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 20122} 20123 20124/* ffestb_R5476_ -- "COMMON" ... NAME OPEN_PAREN dimlist CLOSE_PAREN 20125 20126 return ffestb_R5476_; // to lexer 20127 20128 Handle COMMA, SLASH, CONCAT, EOS/SEMICOLON. */ 20129 20130static ffelexHandler 20131ffestb_R5476_ (ffelexToken t) 20132{ 20133 if (!ffestb_subrargs_.dim_list.ok) 20134 goto bad; /* :::::::::::::::::::: */ 20135 20136 switch (ffelex_token_type (t)) 20137 { 20138 case FFELEX_typeCOMMA: 20139 ffesta_confirmed (); 20140 if (!ffesta_is_inhibited ()) 20141 { 20142 if (!ffestb_local_.common.started) 20143 { 20144 ffestc_R547_start (); 20145 ffestb_local_.common.started = TRUE; 20146 } 20147 ffestc_R547_item_object (ffesta_tokens[1], 20148 ffestb_subrargs_.dim_list.dims); 20149 } 20150 ffelex_token_kill (ffesta_tokens[1]); 20151 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 20152 return (ffelexHandler) ffestb_R5477_; 20153 20154 case FFELEX_typeSLASH: 20155 case FFELEX_typeCONCAT: 20156 ffesta_confirmed (); 20157 if (!ffesta_is_inhibited ()) 20158 { 20159 if (!ffestb_local_.common.started) 20160 { 20161 ffestc_R547_start (); 20162 ffestb_local_.common.started = TRUE; 20163 } 20164 ffestc_R547_item_object (ffesta_tokens[1], 20165 ffestb_subrargs_.dim_list.dims); 20166 } 20167 ffelex_token_kill (ffesta_tokens[1]); 20168 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 20169 return (ffelexHandler) ffestb_R5471_ (t); 20170 20171 case FFELEX_typeEOS: 20172 case FFELEX_typeSEMICOLON: 20173 ffesta_confirmed (); 20174 if (!ffesta_is_inhibited ()) 20175 { 20176 if (!ffestb_local_.common.started) 20177 ffestc_R547_start (); 20178 ffestc_R547_item_object (ffesta_tokens[1], 20179 ffestb_subrargs_.dim_list.dims); 20180 ffestc_R547_finish (); 20181 } 20182 ffelex_token_kill (ffesta_tokens[1]); 20183 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 20184 return (ffelexHandler) ffesta_zero (t); 20185 20186 default: 20187 break; 20188 } 20189 20190bad: /* :::::::::::::::::::: */ 20191 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t); 20192 if (ffestb_local_.common.started && !ffesta_is_inhibited ()) 20193 ffestc_R547_finish (); 20194 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 20195 ffelex_token_kill (ffesta_tokens[1]); 20196 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 20197} 20198 20199/* ffestb_R5477_ -- "COMMON" ... COMMA 20200 20201 return ffestb_R5477_; // to lexer 20202 20203 Make sure we don't have EOS or SEMICOLON. */ 20204 20205static ffelexHandler 20206ffestb_R5477_ (ffelexToken t) 20207{ 20208 switch (ffelex_token_type (t)) 20209 { 20210 case FFELEX_typeEOS: 20211 case FFELEX_typeSEMICOLON: 20212 if (!ffesta_is_inhibited ()) 20213 ffestc_R547_finish (); 20214 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t); 20215 return (ffelexHandler) ffesta_zero (t); 20216 20217 default: 20218 return (ffelexHandler) ffestb_R5471_ (t); 20219 } 20220} 20221 20222/* ffestb_R624 -- Parse a NULLIFY statement 20223 20224 return ffestb_R624; // to lexer 20225 20226 Make sure the statement has a valid form for a NULLIFY 20227 statement. If it does, implement the statement. 20228 20229 31-May-90 JCB 2.0 20230 Rewrite to produce a list of expressions rather than just names; this 20231 eases semantic checking, putting it in expression handling where that 20232 kind of thing gets done anyway, and makes it easier to support more 20233 flexible extensions to Fortran 90 like NULLIFY(FOO%BAR). */ 20234 20235#if FFESTR_F90 20236ffelexHandler 20237ffestb_R624 (ffelexToken t) 20238{ 20239 switch (ffelex_token_type (ffesta_tokens[0])) 20240 { 20241 case FFELEX_typeNAME: 20242 if (ffesta_first_kw != FFESTR_firstNULLIFY) 20243 goto bad_0; /* :::::::::::::::::::: */ 20244 break; 20245 20246 case FFELEX_typeNAMES: 20247 if (ffesta_first_kw != FFESTR_firstNULLIFY) 20248 goto bad_0; /* :::::::::::::::::::: */ 20249 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlNULLIFY) 20250 goto bad_0; /* :::::::::::::::::::: */ 20251 break; 20252 20253 default: 20254 goto bad_0; /* :::::::::::::::::::: */ 20255 } 20256 20257 switch (ffelex_token_type (t)) 20258 { 20259 case FFELEX_typeOPEN_PAREN: 20260 break; 20261 20262 case FFELEX_typeEOS: 20263 case FFELEX_typeSEMICOLON: 20264 case FFELEX_typeCOMMA: 20265 case FFELEX_typeCOLONCOLON: 20266 case FFELEX_typeNAME: 20267 ffesta_confirmed (); /* Error, but clearly intended. */ 20268 goto bad_1; /* :::::::::::::::::::: */ 20269 20270 default: 20271 goto bad_1; /* :::::::::::::::::::: */ 20272 } 20273 20274 ffestb_local_.R624.exprs = ffestt_exprlist_create (); 20275 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 20276 FFEEXPR_contextNULLIFY, 20277 (ffeexprCallback) ffestb_R6241_); 20278 20279bad_0: /* :::::::::::::::::::: */ 20280 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", ffesta_tokens[0]); 20281 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 20282 20283bad_1: /* :::::::::::::::::::: */ 20284 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", t); 20285 return (ffelexHandler) ffelex_swallow_tokens (t, 20286 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 20287} 20288 20289/* ffestb_R6241_ -- "NULLIFY" OPEN_PAREN expr 20290 20291 return ffestb_R6241_; // to lexer 20292 20293 Make sure the statement has a valid form for a NULLIFY statement. If it 20294 does, implement the statement. 20295 20296 31-May-90 JCB 2.0 20297 Rewrite to produce a list of expressions rather than just names; this 20298 eases semantic checking, putting it in expression handling where that 20299 kind of thing gets done anyway, and makes it easier to support more 20300 flexible extensions to Fortran 90 like NULLIFY(FOO%BAR). */ 20301 20302static ffelexHandler 20303ffestb_R6241_ (ffelexToken ft, ffebld expr, ffelexToken t) 20304{ 20305 switch (ffelex_token_type (t)) 20306 { 20307 case FFELEX_typeCLOSE_PAREN: 20308 if (expr == NULL) 20309 break; 20310 ffestt_exprlist_append (ffestb_local_.R624.exprs, expr, 20311 ffelex_token_use (t)); 20312 return (ffelexHandler) ffestb_R6242_; 20313 20314 case FFELEX_typeCOMMA: 20315 if (expr == NULL) 20316 break; 20317 ffestt_exprlist_append (ffestb_local_.R624.exprs, expr, 20318 ffelex_token_use (t)); 20319 return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool, 20320 FFEEXPR_contextNULLIFY, 20321 (ffeexprCallback) ffestb_R6241_); 20322 20323 default: 20324 break; 20325 } 20326 20327 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", t); 20328 ffestt_exprlist_kill (ffestb_local_.R624.exprs); 20329 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 20330} 20331 20332/* ffestb_R6242_ -- "NULLIFY" OPEN_PAREN expr-list CLOSE_PAREN 20333 20334 return ffestb_R6242_; // to lexer 20335 20336 Make sure the statement has a valid form for a NULLIFY statement. If it 20337 does, implement the statement. */ 20338 20339static ffelexHandler 20340ffestb_R6242_ (ffelexToken t) 20341{ 20342 switch (ffelex_token_type (t)) 20343 { 20344 case FFELEX_typeEOS: 20345 case FFELEX_typeSEMICOLON: 20346 ffesta_confirmed (); 20347 if (!ffesta_is_inhibited ()) 20348 ffestc_R624 (ffestb_local_.R624.exprs); 20349 ffestt_exprlist_kill (ffestb_local_.R624.exprs); 20350 return (ffelexHandler) ffesta_zero (t); 20351 20352 default: 20353 break; 20354 } 20355 20356 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", t); 20357 ffestt_exprlist_kill (ffestb_local_.R624.exprs); 20358 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 20359} 20360 20361#endif 20362/* ffestb_R1229 -- Parse a STMTFUNCTION statement 20363 20364 return ffestb_R1229; // to lexer 20365 20366 Make sure the statement has a valid form for a STMTFUNCTION 20367 statement. If it does, implement the statement. */ 20368 20369ffelexHandler 20370ffestb_R1229 (ffelexToken t) 20371{ 20372 switch (ffelex_token_type (ffesta_tokens[0])) 20373 { 20374 case FFELEX_typeNAME: 20375 case FFELEX_typeNAMES: 20376 break; 20377 20378 default: 20379 goto bad_0; /* :::::::::::::::::::: */ 20380 } 20381 20382 switch (ffelex_token_type (t)) 20383 { 20384 case FFELEX_typeOPEN_PAREN: 20385 break; 20386 20387 case FFELEX_typeEOS: 20388 case FFELEX_typeSEMICOLON: 20389 case FFELEX_typeCOMMA: 20390 case FFELEX_typeCOLONCOLON: 20391 case FFELEX_typeNAME: 20392 ffesta_confirmed (); /* Error, but clearly intended. */ 20393 goto bad_1; /* :::::::::::::::::::: */ 20394 20395 default: 20396 goto bad_1; /* :::::::::::::::::::: */ 20397 } 20398 20399 ffestb_subrargs_.name_list.args = ffestt_tokenlist_create (); 20400 ffestb_subrargs_.name_list.handler = (ffelexHandler) ffestb_R12291_; 20401 ffestb_subrargs_.name_list.is_subr = FALSE; /* No "*" items in list! */ 20402 ffestb_subrargs_.name_list.names = TRUE; /* In case "IF(FOO)CALL 20403 FOO...". */ 20404 return (ffelexHandler) ffestb_subr_name_list_; 20405 20406bad_0: /* :::::::::::::::::::: */ 20407bad_1: /* :::::::::::::::::::: */ 20408 ffesta_ffebad_2t (FFEBAD_UNREC_STMT, ffesta_tokens[0], t); 20409 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 20410} 20411 20412/* ffestb_R12291_ -- "STMTFUNCTION" OPEN_PAREN dummy-name-list CLOSE_PAREN 20413 20414 return ffestb_R12291_; // to lexer 20415 20416 Make sure the statement has a valid form for a STMTFUNCTION statement. If 20417 it does, implement the statement. */ 20418 20419static ffelexHandler 20420ffestb_R12291_ (ffelexToken t) 20421{ 20422 ffelex_set_names (FALSE); 20423 20424 if (!ffestb_subrargs_.name_list.ok) 20425 goto bad; /* :::::::::::::::::::: */ 20426 20427 switch (ffelex_token_type (t)) 20428 { 20429 case FFELEX_typeEQUALS: 20430 ffesta_confirmed (); 20431 if (!ffesta_is_inhibited ()) 20432 ffestc_R1229_start (ffesta_tokens[0], 20433 ffestb_subrargs_.name_list.args, 20434 ffestb_subrargs_.name_list.close_paren); 20435 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren); 20436 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args); 20437 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 20438 FFEEXPR_contextSFUNCDEF, (ffeexprCallback) ffestb_R12292_); 20439 20440 default: 20441 break; 20442 } 20443 20444bad: /* :::::::::::::::::::: */ 20445 ffesta_ffebad_2t (FFEBAD_UNREC_STMT, ffesta_tokens[0], t); 20446 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren); 20447 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args); 20448 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 20449} 20450 20451/* ffestb_R12292_ -- "STMTFUNCTION" OPEN_PAREN dummy-name-list CLOSE_PAREN 20452 EQUALS expr 20453 20454 (ffestb_R12292_) // to expression handler 20455 20456 Make sure the statement has a valid form for a STMTFUNCTION statement. If 20457 it does, implement the statement. */ 20458 20459static ffelexHandler 20460ffestb_R12292_ (ffelexToken ft, ffebld expr, ffelexToken t) 20461{ 20462 if (expr == NULL) 20463 goto bad; /* :::::::::::::::::::: */ 20464 20465 switch (ffelex_token_type (t)) 20466 { 20467 case FFELEX_typeEOS: 20468 case FFELEX_typeSEMICOLON: 20469 if (!ffesta_is_inhibited ()) 20470 ffestc_R1229_finish (expr, ft); 20471 return (ffelexHandler) ffesta_zero (t); 20472 20473 default: 20474 break; 20475 } 20476 20477bad: /* :::::::::::::::::::: */ 20478 ffestc_R1229_finish (NULL, NULL); 20479 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "statement-function-definition", t); 20480 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 20481} 20482 20483/* ffestb_decl_chartype -- Parse the CHARACTER statement 20484 20485 return ffestb_decl_chartype; // to lexer 20486 20487 Make sure the statement has a valid form for the CHARACTER statement. If 20488 it does, implement the statement. */ 20489 20490ffelexHandler 20491ffestb_decl_chartype (ffelexToken t) 20492{ 20493 ffeTokenLength i; 20494 unsigned const char *p; 20495 20496 ffestb_local_.decl.type = FFESTP_typeCHARACTER; 20497 ffestb_local_.decl.recursive = NULL; 20498 ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */ 20499 ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */ 20500 20501 switch (ffelex_token_type (ffesta_tokens[0])) 20502 { 20503 case FFELEX_typeNAME: 20504 if (ffesta_first_kw != FFESTR_firstCHRCTR) 20505 goto bad_0; /* :::::::::::::::::::: */ 20506 switch (ffelex_token_type (t)) 20507 { 20508 case FFELEX_typeEOS: 20509 case FFELEX_typeSEMICOLON: 20510 ffesta_confirmed (); /* Error, but clearly intended. */ 20511 goto bad_1; /* :::::::::::::::::::: */ 20512 20513 default: 20514 goto bad_1; /* :::::::::::::::::::: */ 20515 20516 case FFELEX_typeCOMMA: 20517 ffesta_confirmed (); 20518 if (!ffesta_is_inhibited ()) 20519 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0], 20520 NULL, NULL, NULL, NULL); 20521 return (ffelexHandler) ffestb_decl_attrs_; 20522 20523 case FFELEX_typeCOLONCOLON: 20524 ffestb_local_.decl.coloncolon = TRUE; 20525 ffesta_confirmed (); 20526 if (!ffesta_is_inhibited ()) 20527 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0], 20528 NULL, NULL, NULL, NULL); 20529 return (ffelexHandler) ffestb_decl_ents_; 20530 20531 case FFELEX_typeASTERISK: 20532 ffesta_confirmed (); 20533 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_chartype1_; 20534 ffestb_local_.decl.badname = "TYPEDECL"; 20535 return (ffelexHandler) ffestb_decl_starlen_; 20536 20537 case FFELEX_typeOPEN_PAREN: 20538 ffestb_local_.decl.kind = NULL; 20539 ffestb_local_.decl.kindt = NULL; 20540 ffestb_local_.decl.len = NULL; 20541 ffestb_local_.decl.lent = NULL; 20542 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_; 20543 ffestb_local_.decl.badname = "_TYPEDECL"; 20544 return (ffelexHandler) ffestb_decl_typeparams_; 20545 20546 case FFELEX_typeNAME: 20547 ffesta_confirmed (); 20548 ffestb_local_.decl.kind = NULL; 20549 ffestb_local_.decl.kindt = NULL; 20550 ffestb_local_.decl.len = NULL; 20551 ffestb_local_.decl.lent = NULL; 20552 return (ffelexHandler) ffestb_decl_entsp_ (t); 20553 } 20554 20555 case FFELEX_typeNAMES: 20556 if (ffesta_first_kw != FFESTR_firstCHRCTR) 20557 goto bad_0; /* :::::::::::::::::::: */ 20558 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCHRCTR); 20559 switch (ffelex_token_type (t)) 20560 { 20561 default: 20562 goto bad_1; /* :::::::::::::::::::: */ 20563 20564 case FFELEX_typeEOS: 20565 case FFELEX_typeSEMICOLON: 20566 ffesta_confirmed (); 20567 break; 20568 20569 case FFELEX_typeCOMMA: 20570 ffesta_confirmed (); 20571 if (*p != '\0') 20572 break; 20573 if (!ffesta_is_inhibited ()) 20574 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0], 20575 NULL, NULL, NULL, NULL); 20576 return (ffelexHandler) ffestb_decl_attrs_; 20577 20578 case FFELEX_typeCOLONCOLON: 20579 ffestb_local_.decl.coloncolon = TRUE; 20580 ffesta_confirmed (); 20581 if (*p != '\0') 20582 goto bad_i; /* :::::::::::::::::::: */ 20583 if (!ffesta_is_inhibited ()) 20584 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0], 20585 NULL, NULL, NULL, NULL); 20586 return (ffelexHandler) ffestb_decl_ents_; 20587 20588 case FFELEX_typeASTERISK: 20589 ffesta_confirmed (); 20590 if (*p != '\0') 20591 break; 20592 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_chartype1_; 20593 ffestb_local_.decl.badname = "TYPEDECL"; 20594 return (ffelexHandler) ffestb_decl_starlen_; 20595 20596 case FFELEX_typeSLASH: 20597 ffesta_confirmed (); 20598 if (*p != '\0') 20599 break; 20600 goto bad_1; /* :::::::::::::::::::: */ 20601 20602 case FFELEX_typeOPEN_PAREN: 20603 if (*p != '\0') 20604 break; 20605 ffestb_local_.decl.kind = NULL; 20606 ffestb_local_.decl.kindt = NULL; 20607 ffestb_local_.decl.len = NULL; 20608 ffestb_local_.decl.lent = NULL; 20609 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_; 20610 ffestb_local_.decl.badname = "TYPEDECL"; 20611 return (ffelexHandler) ffestb_decl_typeparams_; 20612 } 20613 if (!ffesrc_is_name_init (*p)) 20614 goto bad_i; /* :::::::::::::::::::: */ 20615 ffestb_local_.decl.kind = NULL; 20616 ffestb_local_.decl.kindt = NULL; 20617 ffestb_local_.decl.len = NULL; 20618 ffestb_local_.decl.lent = NULL; 20619 ffesta_tokens[1] = ffelex_token_names_from_names (ffesta_tokens[0], i, 0); 20620 return (ffelexHandler) ffestb_decl_entsp_2_ (t); 20621 20622 default: 20623 goto bad_0; /* :::::::::::::::::::: */ 20624 } 20625 20626bad_0: /* :::::::::::::::::::: */ 20627 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]); 20628 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 20629 20630bad_1: /* :::::::::::::::::::: */ 20631 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t); 20632 return (ffelexHandler) ffelex_swallow_tokens (t, 20633 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 20634 20635bad_i: /* :::::::::::::::::::: */ 20636 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0], i, t); 20637 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 20638} 20639 20640/* ffestb_decl_chartype1_ -- "CHARACTER" ASTERISK char-length 20641 20642 return ffestb_decl_chartype1_; // to lexer 20643 20644 Handle COMMA, COLONCOLON, or anything else. */ 20645 20646static ffelexHandler 20647ffestb_decl_chartype1_ (ffelexToken t) 20648{ 20649 ffelex_set_names (FALSE); 20650 20651 switch (ffelex_token_type (t)) 20652 { 20653 case FFELEX_typeCOLONCOLON: 20654 ffestb_local_.decl.coloncolon = TRUE; 20655 /* Fall through. */ 20656 case FFELEX_typeCOMMA: 20657 ffesta_confirmed (); 20658 if (!ffesta_is_inhibited ()) 20659 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0], 20660 NULL, NULL, ffestb_local_.decl.len, ffestb_local_.decl.lent); 20661 if (ffestb_local_.decl.lent != NULL) 20662 ffelex_token_kill (ffestb_local_.decl.lent); 20663 return (ffelexHandler) ffestb_decl_ents_; 20664 20665 default: 20666 return (ffelexHandler) ffestb_decl_entsp_ (t); 20667 } 20668} 20669 20670/* ffestb_decl_dbltype -- Parse the DOUBLEPRECISION/DOUBLECOMPLEX statement 20671 20672 return ffestb_decl_dbltype; // to lexer 20673 20674 Make sure the statement has a valid form for the DOUBLEPRECISION/ 20675 DOUBLECOMPLEX statement. If it does, implement the statement. */ 20676 20677ffelexHandler 20678ffestb_decl_dbltype (ffelexToken t) 20679{ 20680 ffeTokenLength i; 20681 unsigned const char *p; 20682 20683 ffestb_local_.decl.type = ffestb_args.decl.type; 20684 ffestb_local_.decl.recursive = NULL; 20685 ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */ 20686 ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */ 20687 20688 switch (ffelex_token_type (ffesta_tokens[0])) 20689 { 20690 case FFELEX_typeNAME: 20691 switch (ffelex_token_type (t)) 20692 { 20693 case FFELEX_typeEOS: 20694 case FFELEX_typeSEMICOLON: 20695 ffesta_confirmed (); /* Error, but clearly intended. */ 20696 goto bad_1; /* :::::::::::::::::::: */ 20697 20698 default: 20699 goto bad_1; /* :::::::::::::::::::: */ 20700 20701 case FFELEX_typeCOMMA: 20702 ffesta_confirmed (); 20703 if (!ffesta_is_inhibited ()) 20704 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0], 20705 NULL, NULL, NULL, NULL); 20706 return (ffelexHandler) ffestb_decl_attrs_; 20707 20708 case FFELEX_typeCOLONCOLON: 20709 ffestb_local_.decl.coloncolon = TRUE; 20710 ffesta_confirmed (); 20711 if (!ffesta_is_inhibited ()) 20712 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0], 20713 NULL, NULL, NULL, NULL); 20714 return (ffelexHandler) ffestb_decl_ents_; 20715 20716 case FFELEX_typeNAME: 20717 ffesta_confirmed (); 20718 ffestb_local_.decl.kind = NULL; 20719 ffestb_local_.decl.kindt = NULL; 20720 ffestb_local_.decl.len = NULL; 20721 ffestb_local_.decl.lent = NULL; 20722 return (ffelexHandler) ffestb_decl_entsp_ (t); 20723 } 20724 20725 case FFELEX_typeNAMES: 20726 p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.decl.len); 20727 switch (ffelex_token_type (t)) 20728 { 20729 default: 20730 goto bad_1; /* :::::::::::::::::::: */ 20731 20732 case FFELEX_typeEOS: 20733 case FFELEX_typeSEMICOLON: 20734 ffesta_confirmed (); 20735 break; 20736 20737 case FFELEX_typeCOMMA: 20738 ffesta_confirmed (); 20739 if (*p != '\0') 20740 break; 20741 if (!ffesta_is_inhibited ()) 20742 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0], 20743 NULL, NULL, NULL, NULL); 20744 return (ffelexHandler) ffestb_decl_attrs_; 20745 20746 case FFELEX_typeCOLONCOLON: 20747 ffestb_local_.decl.coloncolon = TRUE; 20748 ffesta_confirmed (); 20749 if (*p != '\0') 20750 goto bad_i; /* :::::::::::::::::::: */ 20751 if (!ffesta_is_inhibited ()) 20752 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0], 20753 NULL, NULL, NULL, NULL); 20754 return (ffelexHandler) ffestb_decl_ents_; 20755 20756 case FFELEX_typeSLASH: 20757 ffesta_confirmed (); 20758 if (*p != '\0') 20759 break; 20760 goto bad_1; /* :::::::::::::::::::: */ 20761 20762 case FFELEX_typeOPEN_PAREN: 20763 if (*p != '\0') 20764 break; 20765 goto bad_1; /* :::::::::::::::::::: */ 20766 } 20767 if (!ffesrc_is_name_init (*p)) 20768 goto bad_i; /* :::::::::::::::::::: */ 20769 ffestb_local_.decl.kind = NULL; 20770 ffestb_local_.decl.kindt = NULL; 20771 ffestb_local_.decl.len = NULL; 20772 ffestb_local_.decl.lent = NULL; 20773 ffesta_tokens[1] = ffelex_token_names_from_names (ffesta_tokens[0], i, 0); 20774 return (ffelexHandler) ffestb_decl_entsp_2_ (t); 20775 20776 default: 20777 goto bad_0; /* :::::::::::::::::::: */ 20778 } 20779 20780bad_0: /* :::::::::::::::::::: */ 20781 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]); 20782 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 20783 20784bad_1: /* :::::::::::::::::::: */ 20785 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t); 20786 return (ffelexHandler) ffelex_swallow_tokens (t, 20787 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 20788 20789bad_i: /* :::::::::::::::::::: */ 20790 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0], i, t); 20791 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 20792} 20793 20794/* ffestb_decl_double -- Parse the DOUBLE PRECISION/DOUBLE COMPLEX statement 20795 20796 return ffestb_decl_double; // to lexer 20797 20798 Make sure the statement has a valid form for the DOUBLE PRECISION/ 20799 DOUBLE COMPLEX statement. If it does, implement the statement. */ 20800 20801ffelexHandler 20802ffestb_decl_double (ffelexToken t) 20803{ 20804 ffestb_local_.decl.recursive = NULL; 20805 ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */ 20806 ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */ 20807 20808 switch (ffelex_token_type (ffesta_tokens[0])) 20809 { 20810 case FFELEX_typeNAME: 20811 if (ffesta_first_kw != FFESTR_firstDBL) 20812 goto bad_0; /* :::::::::::::::::::: */ 20813 switch (ffelex_token_type (t)) 20814 { 20815 case FFELEX_typeEOS: 20816 case FFELEX_typeSEMICOLON: 20817 case FFELEX_typeCOMMA: 20818 case FFELEX_typeCOLONCOLON: 20819 ffesta_confirmed (); /* Error, but clearly intended. */ 20820 goto bad_1; /* :::::::::::::::::::: */ 20821 20822 default: 20823 goto bad_1; /* :::::::::::::::::::: */ 20824 20825 case FFELEX_typeNAME: 20826 ffesta_confirmed (); 20827 switch (ffestr_second (t)) 20828 { 20829 case FFESTR_secondCOMPLEX: 20830 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX; 20831 break; 20832 20833 case FFESTR_secondPRECISION: 20834 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN; 20835 break; 20836 20837 default: 20838 goto bad_1; /* :::::::::::::::::::: */ 20839 } 20840 ffestb_local_.decl.kind = NULL; 20841 ffestb_local_.decl.kindt = NULL; 20842 ffestb_local_.decl.len = NULL; 20843 ffestb_local_.decl.lent = NULL; 20844 return (ffelexHandler) ffestb_decl_attrsp_; 20845 } 20846 20847 default: 20848 goto bad_0; /* :::::::::::::::::::: */ 20849 } 20850 20851bad_0: /* :::::::::::::::::::: */ 20852 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]); 20853 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 20854 20855bad_1: /* :::::::::::::::::::: */ 20856 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t); 20857 return (ffelexHandler) ffelex_swallow_tokens (t, 20858 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 20859} 20860 20861/* ffestb_decl_gentype -- Parse the INTEGER/REAL/COMPLEX/LOGICAL statement 20862 20863 return ffestb_decl_gentype; // to lexer 20864 20865 Make sure the statement has a valid form for the INTEGER/REAL/COMPLEX/ 20866 LOGICAL statement. If it does, implement the statement. */ 20867 20868ffelexHandler 20869ffestb_decl_gentype (ffelexToken t) 20870{ 20871 ffeTokenLength i; 20872 unsigned const char *p; 20873 20874 ffestb_local_.decl.type = ffestb_args.decl.type; 20875 ffestb_local_.decl.recursive = NULL; 20876 ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */ 20877 ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */ 20878 20879 switch (ffelex_token_type (ffesta_tokens[0])) 20880 { 20881 case FFELEX_typeNAME: 20882 switch (ffelex_token_type (t)) 20883 { 20884 case FFELEX_typeEOS: 20885 case FFELEX_typeSEMICOLON: 20886 ffesta_confirmed (); /* Error, but clearly intended. */ 20887 goto bad_1; /* :::::::::::::::::::: */ 20888 20889 default: 20890 goto bad_1; /* :::::::::::::::::::: */ 20891 20892 case FFELEX_typeCOMMA: 20893 ffesta_confirmed (); 20894 if (!ffesta_is_inhibited ()) 20895 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0], 20896 NULL, NULL, NULL, NULL); 20897 return (ffelexHandler) ffestb_decl_attrs_; 20898 20899 case FFELEX_typeCOLONCOLON: 20900 ffestb_local_.decl.coloncolon = TRUE; 20901 ffesta_confirmed (); 20902 if (!ffesta_is_inhibited ()) 20903 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0], 20904 NULL, NULL, NULL, NULL); 20905 return (ffelexHandler) ffestb_decl_ents_; 20906 20907 case FFELEX_typeASTERISK: 20908 ffesta_confirmed (); 20909 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_; 20910 ffestb_local_.decl.badname = "TYPEDECL"; 20911 return (ffelexHandler) ffestb_decl_starkind_; 20912 20913 case FFELEX_typeOPEN_PAREN: 20914 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_; 20915 ffestb_local_.decl.badname = "TYPEDECL"; 20916 return (ffelexHandler) ffestb_decl_kindparam_; 20917 20918 case FFELEX_typeNAME: 20919 ffesta_confirmed (); 20920 ffestb_local_.decl.kind = NULL; 20921 ffestb_local_.decl.kindt = NULL; 20922 ffestb_local_.decl.len = NULL; 20923 ffestb_local_.decl.lent = NULL; 20924 return (ffelexHandler) ffestb_decl_entsp_ (t); 20925 } 20926 20927 case FFELEX_typeNAMES: 20928 p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.decl.len); 20929 switch (ffelex_token_type (t)) 20930 { 20931 default: 20932 goto bad_1; /* :::::::::::::::::::: */ 20933 20934 case FFELEX_typeEOS: 20935 case FFELEX_typeSEMICOLON: 20936 ffesta_confirmed (); 20937 break; 20938 20939 case FFELEX_typeCOMMA: 20940 ffesta_confirmed (); 20941 if (*p != '\0') 20942 break; 20943 if (!ffesta_is_inhibited ()) 20944 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0], 20945 NULL, NULL, NULL, NULL); 20946 return (ffelexHandler) ffestb_decl_attrs_; 20947 20948 case FFELEX_typeCOLONCOLON: 20949 ffestb_local_.decl.coloncolon = TRUE; 20950 ffesta_confirmed (); 20951 if (*p != '\0') 20952 goto bad_i; /* :::::::::::::::::::: */ 20953 if (!ffesta_is_inhibited ()) 20954 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0], 20955 NULL, NULL, NULL, NULL); 20956 return (ffelexHandler) ffestb_decl_ents_; 20957 20958 case FFELEX_typeSLASH: 20959 ffesta_confirmed (); 20960 if (*p != '\0') 20961 break; 20962 goto bad_1; /* :::::::::::::::::::: */ 20963 20964 case FFELEX_typeASTERISK: 20965 ffesta_confirmed (); 20966 if (*p != '\0') 20967 break; 20968 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_; 20969 ffestb_local_.decl.badname = "TYPEDECL"; 20970 return (ffelexHandler) ffestb_decl_starkind_; 20971 20972 case FFELEX_typeOPEN_PAREN: 20973 if (*p != '\0') 20974 break; 20975 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_; 20976 ffestb_local_.decl.badname = "TYPEDECL"; 20977 return (ffelexHandler) ffestb_decl_kindparam_; 20978 } 20979 if (!ffesrc_is_name_init (*p)) 20980 goto bad_i; /* :::::::::::::::::::: */ 20981 ffestb_local_.decl.kind = NULL; 20982 ffestb_local_.decl.kindt = NULL; 20983 ffestb_local_.decl.len = NULL; 20984 ffestb_local_.decl.lent = NULL; 20985 ffesta_tokens[1] = ffelex_token_names_from_names (ffesta_tokens[0], i, 0); 20986 return (ffelexHandler) ffestb_decl_entsp_2_ (t); 20987 20988 default: 20989 goto bad_0; /* :::::::::::::::::::: */ 20990 } 20991 20992bad_0: /* :::::::::::::::::::: */ 20993 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]); 20994 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 20995 20996bad_1: /* :::::::::::::::::::: */ 20997 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t); 20998 return (ffelexHandler) ffelex_swallow_tokens (t, 20999 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 21000 21001bad_i: /* :::::::::::::::::::: */ 21002 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0], i, t); 21003 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 21004} 21005 21006/* ffestb_decl_recursive -- Parse the RECURSIVE FUNCTION statement 21007 21008 return ffestb_decl_recursive; // to lexer 21009 21010 Make sure the statement has a valid form for the RECURSIVE FUNCTION 21011 statement. If it does, implement the statement. */ 21012 21013#if FFESTR_F90 21014ffelexHandler 21015ffestb_decl_recursive (ffelexToken t) 21016{ 21017 ffeTokenLength i; 21018 const char *p; 21019 ffelexToken nt; 21020 ffelexToken ot; 21021 ffelexHandler next; 21022 bool needfunc; 21023 21024 switch (ffelex_token_type (ffesta_tokens[0])) 21025 { 21026 case FFELEX_typeNAME: 21027 if (ffesta_first_kw != FFESTR_firstRECURSIVE) 21028 goto bad_0; /* :::::::::::::::::::: */ 21029 switch (ffelex_token_type (t)) 21030 { 21031 case FFELEX_typeEOS: 21032 case FFELEX_typeSEMICOLON: 21033 case FFELEX_typeCOMMA: 21034 case FFELEX_typeCOLONCOLON: 21035 ffesta_confirmed (); /* Error, but clearly intended. */ 21036 goto bad_1; /* :::::::::::::::::::: */ 21037 21038 default: 21039 goto bad_1; /* :::::::::::::::::::: */ 21040 21041 case FFELEX_typeNAME: 21042 break; 21043 } 21044 ffesta_confirmed (); 21045 ffestb_local_.decl.recursive = ffelex_token_use (ffesta_tokens[0]); 21046 switch (ffesta_second_kw) 21047 { 21048 case FFESTR_secondINTEGER: 21049 ffestb_local_.decl.type = FFESTP_typeINTEGER; 21050 return (ffelexHandler) ffestb_decl_recursive1_; 21051 21052 case FFESTR_secondBYTE: 21053 ffestb_local_.decl.type = FFESTP_typeBYTE; 21054 return (ffelexHandler) ffestb_decl_recursive1_; 21055 21056 case FFESTR_secondWORD: 21057 ffestb_local_.decl.type = FFESTP_typeWORD; 21058 return (ffelexHandler) ffestb_decl_recursive1_; 21059 21060 case FFESTR_secondREAL: 21061 ffestb_local_.decl.type = FFESTP_typeREAL; 21062 return (ffelexHandler) ffestb_decl_recursive1_; 21063 21064 case FFESTR_secondCOMPLEX: 21065 ffestb_local_.decl.type = FFESTP_typeCOMPLEX; 21066 return (ffelexHandler) ffestb_decl_recursive1_; 21067 21068 case FFESTR_secondLOGICAL: 21069 ffestb_local_.decl.type = FFESTP_typeLOGICAL; 21070 return (ffelexHandler) ffestb_decl_recursive1_; 21071 21072 case FFESTR_secondCHARACTER: 21073 ffestb_local_.decl.type = FFESTP_typeCHARACTER; 21074 return (ffelexHandler) ffestb_decl_recursive1_; 21075 21076 case FFESTR_secondDOUBLE: 21077 return (ffelexHandler) ffestb_decl_recursive2_; 21078 21079 case FFESTR_secondDOUBLEPRECISION: 21080 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN; 21081 ffestb_local_.decl.kind = NULL; 21082 ffestb_local_.decl.kindt = NULL; 21083 ffestb_local_.decl.len = NULL; 21084 ffestb_local_.decl.lent = NULL; 21085 return (ffelexHandler) ffestb_decl_func_; 21086 21087 case FFESTR_secondDOUBLECOMPLEX: 21088 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX; 21089 ffestb_local_.decl.kind = NULL; 21090 ffestb_local_.decl.kindt = NULL; 21091 ffestb_local_.decl.len = NULL; 21092 ffestb_local_.decl.lent = NULL; 21093 return (ffelexHandler) ffestb_decl_func_; 21094 21095 case FFESTR_secondTYPE: 21096 ffestb_local_.decl.type = FFESTP_typeTYPE; 21097 return (ffelexHandler) ffestb_decl_recursive3_; 21098 21099 case FFESTR_secondFUNCTION: 21100 ffestb_local_.dummy.first_kw = FFESTR_firstFUNCTION; 21101 ffestb_local_.dummy.badname = "FUNCTION"; 21102 ffestb_local_.dummy.is_subr = FALSE; 21103 return (ffelexHandler) ffestb_decl_recursive4_; 21104 21105 case FFESTR_secondSUBROUTINE: 21106 ffestb_local_.dummy.first_kw = FFESTR_firstSUBROUTINE; 21107 ffestb_local_.dummy.badname = "SUBROUTINE"; 21108 ffestb_local_.dummy.is_subr = TRUE; 21109 return (ffelexHandler) ffestb_decl_recursive4_; 21110 21111 default: 21112 ffelex_token_kill (ffestb_local_.decl.recursive); 21113 goto bad_1; /* :::::::::::::::::::: */ 21114 } 21115 21116 case FFELEX_typeNAMES: 21117 if (ffesta_first_kw != FFESTR_firstRECURSIVE) 21118 goto bad_0; /* :::::::::::::::::::: */ 21119 switch (ffelex_token_type (t)) 21120 { 21121 case FFELEX_typeCOMMA: 21122 case FFELEX_typeCOLONCOLON: 21123 case FFELEX_typeASTERISK: 21124 case FFELEX_typeSEMICOLON: 21125 case FFELEX_typeEOS: 21126 ffesta_confirmed (); 21127 break; 21128 21129 default: 21130 break; 21131 } 21132 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlRECURSIVE); 21133 if (!ffesrc_is_name_init (*p)) 21134 goto bad_0; /* :::::::::::::::::::: */ 21135 ffestb_local_.decl.recursive 21136 = ffelex_token_name_from_names (ffesta_tokens[0], 0, 21137 FFESTR_firstlRECURSIVE); 21138 nt = ffelex_token_names_from_names (ffesta_tokens[0], 21139 FFESTR_firstlRECURSIVE, 0); 21140 switch (ffestr_first (nt)) 21141 { 21142 case FFESTR_firstINTGR: 21143 p = ffelex_token_text (nt) + (i = FFESTR_firstlINTGR); 21144 ffestb_local_.decl.type = FFESTP_typeINTEGER; 21145 needfunc = FALSE; 21146 goto typefunc; /* :::::::::::::::::::: */ 21147 21148 case FFESTR_firstBYTE: 21149 p = ffelex_token_text (nt) + (i = FFESTR_firstlBYTE); 21150 ffestb_local_.decl.type = FFESTP_typeBYTE; 21151 needfunc = FALSE; 21152 goto typefunc; /* :::::::::::::::::::: */ 21153 21154 case FFESTR_firstWORD: 21155 p = ffelex_token_text (nt) + (i = FFESTR_firstlWORD); 21156 ffestb_local_.decl.type = FFESTP_typeWORD; 21157 needfunc = FALSE; 21158 goto typefunc; /* :::::::::::::::::::: */ 21159 21160 case FFESTR_firstREAL: 21161 p = ffelex_token_text (nt) + (i = FFESTR_firstlREAL); 21162 ffestb_local_.decl.type = FFESTP_typeREAL; 21163 needfunc = FALSE; 21164 goto typefunc; /* :::::::::::::::::::: */ 21165 21166 case FFESTR_firstCMPLX: 21167 p = ffelex_token_text (nt) + (i = FFESTR_firstlCMPLX); 21168 ffestb_local_.decl.type = FFESTP_typeCOMPLEX; 21169 needfunc = FALSE; 21170 goto typefunc; /* :::::::::::::::::::: */ 21171 21172 case FFESTR_firstLGCL: 21173 p = ffelex_token_text (nt) + (i = FFESTR_firstlLGCL); 21174 ffestb_local_.decl.type = FFESTP_typeLOGICAL; 21175 needfunc = FALSE; 21176 goto typefunc; /* :::::::::::::::::::: */ 21177 21178 case FFESTR_firstCHRCTR: 21179 p = ffelex_token_text (nt) + (i = FFESTR_firstlCHRCTR); 21180 ffestb_local_.decl.type = FFESTP_typeCHARACTER; 21181 needfunc = FALSE; 21182 goto typefunc; /* :::::::::::::::::::: */ 21183 21184 case FFESTR_firstDBLPRCSN: 21185 p = ffelex_token_text (nt) + (i = FFESTR_firstlDBLPRCSN); 21186 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN; 21187 needfunc = TRUE; 21188 goto typefunc; /* :::::::::::::::::::: */ 21189 21190 case FFESTR_firstDBLCMPLX: 21191 p = ffelex_token_text (nt) + (i = FFESTR_firstlDBLCMPLX); 21192 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX; 21193 needfunc = TRUE; 21194 goto typefunc; /* :::::::::::::::::::: */ 21195 21196 case FFESTR_firstTYPE: 21197 p = ffelex_token_text (nt) + (i = FFESTR_firstlTYPE); 21198 ffestb_local_.decl.type = FFESTP_typeTYPE; 21199 next = (ffelexHandler) ffestb_decl_recursive3_; 21200 break; 21201 21202 case FFESTR_firstFUNCTION: 21203 p = ffelex_token_text (nt) + (i = FFESTR_firstlFUNCTION); 21204 ffestb_local_.dummy.first_kw = FFESTR_firstFUNCTION; 21205 ffestb_local_.dummy.badname = "FUNCTION"; 21206 ffestb_local_.dummy.is_subr = FALSE; 21207 next = (ffelexHandler) ffestb_decl_recursive4_; 21208 break; 21209 21210 case FFESTR_firstSUBROUTINE: 21211 p = ffelex_token_text (nt) + (i = FFESTR_firstlSUBROUTINE); 21212 ffestb_local_.dummy.first_kw = FFESTR_firstSUBROUTINE; 21213 ffestb_local_.dummy.badname = "SUBROUTINE"; 21214 ffestb_local_.dummy.is_subr = TRUE; 21215 next = (ffelexHandler) ffestb_decl_recursive4_; 21216 break; 21217 21218 default: 21219 ffelex_token_kill (ffestb_local_.decl.recursive); 21220 ffelex_token_kill (nt); 21221 goto bad_1; /* :::::::::::::::::::: */ 21222 } 21223 if (*p == '\0') 21224 { 21225 ffelex_token_kill (nt); 21226 return (ffelexHandler) (*next) (t); 21227 } 21228 if (!ffesrc_is_name_init (*p)) 21229 goto bad_i; /* :::::::::::::::::::: */ 21230 ot = ffelex_token_name_from_names (nt, i, 0); 21231 ffelex_token_kill (nt); 21232 next = (ffelexHandler) (*next) (ot); 21233 ffelex_token_kill (ot); 21234 return (ffelexHandler) (*next) (t); 21235 21236 default: 21237 goto bad_0; /* :::::::::::::::::::: */ 21238 } 21239 21240typefunc: /* :::::::::::::::::::: */ 21241 if (*p == '\0') 21242 { 21243 ffelex_token_kill (nt); 21244 if (needfunc) /* DOUBLE PRECISION or DOUBLE COMPLEX? */ 21245 { 21246 ffelex_token_kill (ffestb_local_.decl.recursive); 21247 goto bad_1; /* :::::::::::::::::::: */ 21248 } 21249 return (ffelexHandler) ffestb_decl_recursive1_ (t); 21250 } 21251 if (!ffesrc_is_name_init (*p)) 21252 goto bad_i; /* :::::::::::::::::::: */ 21253 ot = ffelex_token_names_from_names (nt, i, 0); 21254 ffelex_token_kill (nt); 21255 if (ffestr_first (ot) != FFESTR_firstFUNCTION) 21256 goto bad_o; /* :::::::::::::::::::: */ 21257 p = ffelex_token_text (ot) + (i = FFESTR_firstlFUNCTION); 21258 if (!ffesrc_is_name_init (*p)) 21259 goto bad_i; /* :::::::::::::::::::: */ 21260 ffesta_tokens[1] = ffelex_token_name_from_names (ot, i, 0); 21261 ffelex_token_kill (ot); 21262 ffestb_local_.decl.kind = NULL; 21263 ffestb_local_.decl.kindt = NULL; 21264 ffestb_local_.decl.len = NULL; 21265 ffestb_local_.decl.lent = NULL; 21266 return (ffelexHandler) ffestb_decl_funcname_1_ (t); 21267 21268bad_0: /* :::::::::::::::::::: */ 21269 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", ffesta_tokens[0]); 21270 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 21271 21272bad_1: /* :::::::::::::::::::: */ 21273 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); 21274 return (ffelexHandler) ffelex_swallow_tokens (t, 21275 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 21276 21277bad_i: /* :::::::::::::::::::: */ 21278 ffelex_token_kill (ffestb_local_.decl.recursive); 21279 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", nt, i, t); 21280 ffelex_token_kill (nt); 21281 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 21282 21283bad_o: /* :::::::::::::::::::: */ 21284 ffelex_token_kill (ffestb_local_.decl.recursive); 21285 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", ot); 21286 ffelex_token_kill (ot); 21287 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 21288} 21289 21290/* ffestb_decl_recursive1_ -- "RECURSIVE" generic-type 21291 21292 return ffestb_decl_recursive1_; // to lexer 21293 21294 Handle ASTERISK, OPEN_PAREN, or NAME. */ 21295 21296static ffelexHandler 21297ffestb_decl_recursive1_ (ffelexToken t) 21298{ 21299 switch (ffelex_token_type (t)) 21300 { 21301 case FFELEX_typeASTERISK: 21302 ffesta_confirmed (); 21303 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_func_; 21304 ffestb_local_.decl.badname = "TYPEFUNC"; 21305 if (ffestb_local_.decl.type == FFESTP_typeCHARACTER) 21306 return (ffelexHandler) ffestb_decl_starlen_; 21307 return (ffelexHandler) ffestb_decl_starkind_; 21308 21309 case FFELEX_typeOPEN_PAREN: 21310 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_func_; 21311 ffestb_local_.decl.badname = "TYPEFUNC"; 21312 if (ffestb_local_.decl.type == FFESTP_typeCHARACTER) 21313 { 21314 ffestb_local_.decl.kind = NULL; 21315 ffestb_local_.decl.kindt = NULL; 21316 ffestb_local_.decl.len = NULL; 21317 ffestb_local_.decl.lent = NULL; 21318 return (ffelexHandler) ffestb_decl_typeparams_; 21319 } 21320 return (ffelexHandler) ffestb_decl_kindparam_; 21321 21322 case FFELEX_typeNAME: 21323 ffestb_local_.decl.kind = NULL; 21324 ffestb_local_.decl.kindt = NULL; 21325 ffestb_local_.decl.len = NULL; 21326 ffestb_local_.decl.lent = NULL; 21327 return (ffelexHandler) ffestb_decl_func_ (t); 21328 21329 default: 21330 break; 21331 } 21332 21333 if (ffestb_local_.decl.recursive != NULL) 21334 ffelex_token_kill (ffestb_local_.decl.recursive); 21335 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); 21336 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 21337} 21338 21339/* ffestb_decl_recursive2_ -- "RECURSIVE" "DOUBLE" 21340 21341 return ffestb_decl_recursive2_; // to lexer 21342 21343 Handle NAME. */ 21344 21345static ffelexHandler 21346ffestb_decl_recursive2_ (ffelexToken t) 21347{ 21348 switch (ffelex_token_type (t)) 21349 { 21350 case FFELEX_typeNAME: 21351 switch (ffestr_second (t)) 21352 { 21353 case FFESTR_secondPRECISION: 21354 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN; 21355 break; 21356 21357 case FFESTR_secondCOMPLEX: 21358 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX; 21359 break; 21360 21361 default: 21362 goto bad; /* :::::::::::::::::::: */ 21363 } 21364 ffestb_local_.decl.kind = NULL; 21365 ffestb_local_.decl.kindt = NULL; 21366 ffestb_local_.decl.len = NULL; 21367 ffestb_local_.decl.lent = NULL; 21368 return (ffelexHandler) ffestb_decl_func_; 21369 21370 default: 21371 break; 21372 } 21373 21374bad: /* :::::::::::::::::::: */ 21375 if (ffestb_local_.decl.recursive != NULL) 21376 ffelex_token_kill (ffestb_local_.decl.recursive); 21377 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); 21378 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 21379} 21380 21381/* ffestb_decl_recursive3_ -- "RECURSIVE" "TYPE" 21382 21383 return ffestb_decl_recursive3_; // to lexer 21384 21385 Handle OPEN_PAREN. */ 21386 21387static ffelexHandler 21388ffestb_decl_recursive3_ (ffelexToken t) 21389{ 21390 switch (ffelex_token_type (t)) 21391 { 21392 case FFELEX_typeOPEN_PAREN: 21393 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_func_; 21394 ffestb_local_.decl.badname = "TYPEFUNC"; 21395 return (ffelexHandler) ffestb_decl_typetype1_; 21396 21397 default: 21398 break; 21399 } 21400 21401 if (ffestb_local_.decl.recursive != NULL) 21402 ffelex_token_kill (ffestb_local_.decl.recursive); 21403 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); 21404 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 21405} 21406 21407/* ffestb_decl_recursive4_ -- "RECURSIVE" "FUNCTION/SUBROUTINE" 21408 21409 return ffestb_decl_recursive4_; // to lexer 21410 21411 Handle OPEN_PAREN. */ 21412 21413static ffelexHandler 21414ffestb_decl_recursive4_ (ffelexToken t) 21415{ 21416 switch (ffelex_token_type (t)) 21417 { 21418 case FFELEX_typeNAME: 21419 ffesta_tokens[1] = ffelex_token_use (t); 21420 return (ffelexHandler) ffestb_dummy1_; 21421 21422 default: 21423 break; 21424 } 21425 21426 if (ffestb_local_.decl.recursive != NULL) 21427 ffelex_token_kill (ffestb_local_.decl.recursive); 21428 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); 21429 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 21430} 21431 21432#endif 21433/* ffestb_decl_typetype -- Parse the R426/R501/R1219 TYPE statement 21434 21435 return ffestb_decl_typetype; // to lexer 21436 21437 Make sure the statement has a valid form for the TYPE statement. If it 21438 does, implement the statement. */ 21439 21440#if FFESTR_F90 21441ffelexHandler 21442ffestb_decl_typetype (ffelexToken t) 21443{ 21444 switch (ffelex_token_type (ffesta_tokens[0])) 21445 { 21446 case FFELEX_typeNAME: 21447 if (ffesta_first_kw != FFESTR_firstTYPE) 21448 goto bad_0; /* :::::::::::::::::::: */ 21449 break; 21450 21451 case FFELEX_typeNAMES: 21452 if (ffesta_first_kw != FFESTR_firstTYPE) 21453 goto bad_0; /* :::::::::::::::::::: */ 21454 if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlTYPE) 21455 goto bad_0; /* :::::::::::::::::::: */ 21456 break; 21457 21458 default: 21459 goto bad_0; /* :::::::::::::::::::: */ 21460 } 21461 21462 switch (ffelex_token_type (t)) 21463 { 21464 case FFELEX_typeOPEN_PAREN: 21465 break; 21466 21467 case FFELEX_typeEOS: 21468 case FFELEX_typeSEMICOLON: 21469 case FFELEX_typeCOLONCOLON:/* Not COMMA: R424 "TYPE,PUBLIC::A". */ 21470 ffesta_confirmed (); /* Error, but clearly intended. */ 21471 goto bad_1; /* :::::::::::::::::::: */ 21472 21473 default: 21474 goto bad_1; /* :::::::::::::::::::: */ 21475 } 21476 21477 ffestb_local_.decl.recursive = NULL; 21478 ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */ 21479 ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */ 21480 21481 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_; 21482 ffestb_local_.decl.badname = "type-declaration"; 21483 return (ffelexHandler) ffestb_decl_typetype1_; 21484 21485bad_0: /* :::::::::::::::::::: */ 21486 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]); 21487 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 21488 21489bad_1: /* :::::::::::::::::::: */ 21490 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t); 21491 return (ffelexHandler) ffelex_swallow_tokens (t, 21492 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 21493} 21494 21495#endif 21496/* ffestb_decl_attrs_ -- "type" [type parameters] COMMA 21497 21498 return ffestb_decl_attrs_; // to lexer 21499 21500 Handle NAME of an attribute. */ 21501 21502static ffelexHandler 21503ffestb_decl_attrs_ (ffelexToken t) 21504{ 21505 switch (ffelex_token_type (t)) 21506 { 21507 case FFELEX_typeNAME: 21508 switch (ffestr_first (t)) 21509 { 21510#if FFESTR_F90 21511 case FFESTR_firstALLOCATABLE: 21512 if (!ffesta_is_inhibited ()) 21513 ffestc_decl_attrib (FFESTP_attribALLOCATABLE, t, 21514 FFESTR_otherNone, NULL); 21515 return (ffelexHandler) ffestb_decl_attrs_7_; 21516#endif 21517 21518 case FFESTR_firstDIMENSION: 21519 ffesta_tokens[1] = ffelex_token_use (t); 21520 return (ffelexHandler) ffestb_decl_attrs_1_; 21521 21522 case FFESTR_firstEXTERNAL: 21523 if (!ffesta_is_inhibited ()) 21524 ffestc_decl_attrib (FFESTP_attribEXTERNAL, t, 21525 FFESTR_otherNone, NULL); 21526 return (ffelexHandler) ffestb_decl_attrs_7_; 21527 21528#if FFESTR_F90 21529 case FFESTR_firstINTENT: 21530 ffesta_tokens[1] = ffelex_token_use (t); 21531 return (ffelexHandler) ffestb_decl_attrs_3_; 21532#endif 21533 21534 case FFESTR_firstINTRINSIC: 21535 if (!ffesta_is_inhibited ()) 21536 ffestc_decl_attrib (FFESTP_attribINTRINSIC, t, 21537 FFESTR_otherNone, NULL); 21538 return (ffelexHandler) ffestb_decl_attrs_7_; 21539 21540#if FFESTR_F90 21541 case FFESTR_firstOPTIONAL: 21542 if (!ffesta_is_inhibited ()) 21543 ffestc_decl_attrib (FFESTP_attribOPTIONAL, t, 21544 FFESTR_otherNone, NULL); 21545 return (ffelexHandler) ffestb_decl_attrs_7_; 21546#endif 21547 21548 case FFESTR_firstPARAMETER: 21549 ffestb_local_.decl.parameter = TRUE; 21550 if (!ffesta_is_inhibited ()) 21551 ffestc_decl_attrib (FFESTP_attribPARAMETER, t, 21552 FFESTR_otherNone, NULL); 21553 return (ffelexHandler) ffestb_decl_attrs_7_; 21554 21555#if FFESTR_F90 21556 case FFESTR_firstPOINTER: 21557 if (!ffesta_is_inhibited ()) 21558 ffestc_decl_attrib (FFESTP_attribPOINTER, t, 21559 FFESTR_otherNone, NULL); 21560 return (ffelexHandler) ffestb_decl_attrs_7_; 21561#endif 21562 21563#if FFESTR_F90 21564 case FFESTR_firstPRIVATE: 21565 if (!ffesta_is_inhibited ()) 21566 ffestc_decl_attrib (FFESTP_attribPRIVATE, t, 21567 FFESTR_otherNone, NULL); 21568 return (ffelexHandler) ffestb_decl_attrs_7_; 21569 21570 case FFESTR_firstPUBLIC: 21571 if (!ffesta_is_inhibited ()) 21572 ffestc_decl_attrib (FFESTP_attribPUBLIC, t, 21573 FFESTR_otherNone, NULL); 21574 return (ffelexHandler) ffestb_decl_attrs_7_; 21575#endif 21576 21577 case FFESTR_firstSAVE: 21578 if (!ffesta_is_inhibited ()) 21579 ffestc_decl_attrib (FFESTP_attribSAVE, t, 21580 FFESTR_otherNone, NULL); 21581 return (ffelexHandler) ffestb_decl_attrs_7_; 21582 21583#if FFESTR_F90 21584 case FFESTR_firstTARGET: 21585 if (!ffesta_is_inhibited ()) 21586 ffestc_decl_attrib (FFESTP_attribTARGET, t, 21587 FFESTR_otherNone, NULL); 21588 return (ffelexHandler) ffestb_decl_attrs_7_; 21589#endif 21590 21591 default: 21592 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t); 21593 return (ffelexHandler) ffestb_decl_attrs_7_; 21594 } 21595 break; 21596 21597 default: 21598 break; 21599 } 21600 21601 if (!ffesta_is_inhibited ()) 21602 ffestc_decl_finish (); 21603 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t); 21604 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 21605} 21606 21607/* ffestb_decl_attrs_1_ -- "type" [type parameters] ",DIMENSION" 21608 21609 return ffestb_decl_attrs_1_; // to lexer 21610 21611 Handle OPEN_PAREN. */ 21612 21613static ffelexHandler 21614ffestb_decl_attrs_1_ (ffelexToken t) 21615{ 21616 switch (ffelex_token_type (t)) 21617 { 21618 case FFELEX_typeOPEN_PAREN: 21619 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create (); 21620 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_decl_attrs_2_; 21621 ffestb_subrargs_.dim_list.pool = ffesta_scratch_pool; 21622 ffestb_subrargs_.dim_list.ctx = ffesta_is_entry_valid 21623 ? FFEEXPR_contextDIMLIST : FFEEXPR_contextDIMLISTCOMMON; 21624#ifdef FFECOM_dimensionsMAX 21625 ffestb_subrargs_.dim_list.ndims = 0; 21626#endif 21627 return (ffelexHandler) ffeexpr_rhs (ffesta_scratch_pool, 21628 ffestb_subrargs_.dim_list.ctx, 21629 (ffeexprCallback) ffestb_subr_dimlist_); 21630 21631 case FFELEX_typeCOMMA: 21632 case FFELEX_typeCOLONCOLON: 21633 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, ffesta_tokens[1]); 21634 ffelex_token_kill (ffesta_tokens[1]); 21635 return (ffelexHandler) ffestb_decl_attrs_7_ (t); 21636 21637 default: 21638 break; 21639 } 21640 21641 if (!ffesta_is_inhibited ()) 21642 ffestc_decl_finish (); 21643 ffelex_token_kill (ffesta_tokens[1]); 21644 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t); 21645 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 21646} 21647 21648/* ffestb_decl_attrs_2_ -- "type" [type parameters] ",DIMENSION" OPEN_PAREN 21649 dimlist CLOSE_PAREN 21650 21651 return ffestb_decl_attrs_2_; // to lexer 21652 21653 Handle COMMA or COLONCOLON. */ 21654 21655static ffelexHandler 21656ffestb_decl_attrs_2_ (ffelexToken t) 21657{ 21658 if (!ffestb_subrargs_.dim_list.ok) 21659 goto bad; /* :::::::::::::::::::: */ 21660 21661 switch (ffelex_token_type (t)) 21662 { 21663 case FFELEX_typeCOMMA: 21664 case FFELEX_typeCOLONCOLON: 21665 if (!ffesta_is_inhibited ()) 21666 ffestc_decl_attrib (FFESTP_attribDIMENSION, ffesta_tokens[1], 21667 FFESTR_otherNone, ffestb_subrargs_.dim_list.dims); 21668 ffelex_token_kill (ffesta_tokens[1]); 21669 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 21670 return (ffelexHandler) ffestb_decl_attrs_7_ (t); 21671 21672 default: 21673 break; 21674 } 21675 21676bad: /* :::::::::::::::::::: */ 21677 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t); 21678 if (!ffesta_is_inhibited ()) 21679 ffestc_decl_finish (); 21680 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 21681 ffelex_token_kill (ffesta_tokens[1]); 21682 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 21683} 21684 21685/* ffestb_decl_attrs_3_ -- "type" [type parameters] ",INTENT" 21686 21687 return ffestb_decl_attrs_3_; // to lexer 21688 21689 Handle OPEN_PAREN. */ 21690 21691#if FFESTR_F90 21692static ffelexHandler 21693ffestb_decl_attrs_3_ (ffelexToken t) 21694{ 21695 switch (ffelex_token_type (t)) 21696 { 21697 case FFELEX_typeOPEN_PAREN: 21698 return (ffelexHandler) ffestb_decl_attrs_4_; 21699 21700 case FFELEX_typeCOMMA: 21701 case FFELEX_typeCOLONCOLON: 21702 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, ffesta_tokens[1]); 21703 ffelex_token_kill (ffesta_tokens[1]); 21704 return (ffelexHandler) ffestb_decl_attrs_7_ (t); 21705 21706 default: 21707 break; 21708 } 21709 21710 if (!ffesta_is_inhibited ()) 21711 ffestc_decl_finish (); 21712 ffelex_token_kill (ffesta_tokens[1]); 21713 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t); 21714 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 21715} 21716 21717/* ffestb_decl_attrs_4_ -- "type" [type parameters] ",INTENT" OPEN_PAREN 21718 21719 return ffestb_decl_attrs_4_; // to lexer 21720 21721 Handle NAME. */ 21722 21723static ffelexHandler 21724ffestb_decl_attrs_4_ (ffelexToken t) 21725{ 21726 switch (ffelex_token_type (t)) 21727 { 21728 case FFELEX_typeNAME: 21729 ffestb_local_.decl.kw = ffestr_other (t); 21730 switch (ffestb_local_.decl.kw) 21731 { 21732 case FFESTR_otherIN: 21733 return (ffelexHandler) ffestb_decl_attrs_5_; 21734 21735 case FFESTR_otherINOUT: 21736 return (ffelexHandler) ffestb_decl_attrs_6_; 21737 21738 case FFESTR_otherOUT: 21739 return (ffelexHandler) ffestb_decl_attrs_6_; 21740 21741 default: 21742 ffestb_local_.decl.kw = FFESTR_otherNone; 21743 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t); 21744 return (ffelexHandler) ffestb_decl_attrs_5_; 21745 } 21746 break; 21747 21748 default: 21749 break; 21750 } 21751 21752 if (!ffesta_is_inhibited ()) 21753 ffestc_decl_finish (); 21754 ffelex_token_kill (ffesta_tokens[1]); 21755 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t); 21756 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 21757} 21758 21759/* ffestb_decl_attrs_5_ -- "type" [type parameters] ",INTENT" OPEN_PAREN "IN" 21760 21761 return ffestb_decl_attrs_5_; // to lexer 21762 21763 Handle NAME or CLOSE_PAREN. */ 21764 21765static ffelexHandler 21766ffestb_decl_attrs_5_ (ffelexToken t) 21767{ 21768 switch (ffelex_token_type (t)) 21769 { 21770 case FFELEX_typeNAME: 21771 switch (ffestr_other (t)) 21772 { 21773 case FFESTR_otherOUT: 21774 if (ffestb_local_.decl.kw != FFESTR_otherNone) 21775 ffestb_local_.decl.kw = FFESTR_otherINOUT; 21776 return (ffelexHandler) ffestb_decl_attrs_6_; 21777 21778 default: 21779 if (ffestb_local_.decl.kw != FFESTR_otherNone) 21780 { 21781 ffestb_local_.decl.kw = FFESTR_otherNone; 21782 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t); 21783 } 21784 return (ffelexHandler) ffestb_decl_attrs_5_; 21785 } 21786 break; 21787 21788 case FFELEX_typeCLOSE_PAREN: 21789 return (ffelexHandler) ffestb_decl_attrs_6_ (t); 21790 21791 default: 21792 break; 21793 } 21794 21795 if (!ffesta_is_inhibited ()) 21796 ffestc_decl_finish (); 21797 ffelex_token_kill (ffesta_tokens[1]); 21798 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t); 21799 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 21800} 21801 21802/* ffestb_decl_attrs_6_ -- "type" [type parameters] ",INTENT" OPEN_PAREN "IN" 21803 ["OUT"] 21804 21805 return ffestb_decl_attrs_6_; // to lexer 21806 21807 Handle CLOSE_PAREN. */ 21808 21809static ffelexHandler 21810ffestb_decl_attrs_6_ (ffelexToken t) 21811{ 21812 switch (ffelex_token_type (t)) 21813 { 21814 case FFELEX_typeCLOSE_PAREN: 21815 if ((ffestb_local_.decl.kw != FFESTR_otherNone) 21816 && !ffesta_is_inhibited ()) 21817 ffestc_decl_attrib (FFESTP_attribINTENT, ffesta_tokens[1], 21818 ffestb_local_.decl.kw, NULL); 21819 ffelex_token_kill (ffesta_tokens[1]); 21820 return (ffelexHandler) ffestb_decl_attrs_7_; 21821 21822 default: 21823 break; 21824 } 21825 21826 if (!ffesta_is_inhibited ()) 21827 ffestc_decl_finish (); 21828 ffelex_token_kill (ffesta_tokens[1]); 21829 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t); 21830 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 21831} 21832 21833#endif 21834/* ffestb_decl_attrs_7_ -- "type" [type parameters] attribute 21835 21836 return ffestb_decl_attrs_7_; // to lexer 21837 21838 Handle COMMA (another attribute) or COLONCOLON (entities). */ 21839 21840static ffelexHandler 21841ffestb_decl_attrs_7_ (ffelexToken t) 21842{ 21843 switch (ffelex_token_type (t)) 21844 { 21845 case FFELEX_typeCOMMA: 21846 return (ffelexHandler) ffestb_decl_attrs_; 21847 21848 case FFELEX_typeCOLONCOLON: 21849 ffestb_local_.decl.coloncolon = TRUE; 21850 return (ffelexHandler) ffestb_decl_ents_; 21851 21852 default: 21853 break; 21854 } 21855 21856 if (!ffesta_is_inhibited ()) 21857 ffestc_decl_finish (); 21858 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t); 21859 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 21860} 21861 21862/* ffestb_decl_attrsp_ -- "type" [type parameters] 21863 21864 return ffestb_decl_attrsp_; // to lexer 21865 21866 Handle COMMA (meaning we have attributes), COLONCOLON (meaning we have 21867 no attributes but entities), or go to entsp to see about functions or 21868 entities. */ 21869 21870static ffelexHandler 21871ffestb_decl_attrsp_ (ffelexToken t) 21872{ 21873 ffelex_set_names (FALSE); 21874 21875 switch (ffelex_token_type (t)) 21876 { 21877 case FFELEX_typeCOMMA: 21878 ffesta_confirmed (); 21879 if (!ffesta_is_inhibited ()) 21880 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0], 21881 ffestb_local_.decl.kind, ffestb_local_.decl.kindt, 21882 ffestb_local_.decl.len, ffestb_local_.decl.lent); 21883 if (ffestb_local_.decl.kindt != NULL) 21884 ffelex_token_kill (ffestb_local_.decl.kindt); 21885 if (ffestb_local_.decl.lent != NULL) 21886 ffelex_token_kill (ffestb_local_.decl.lent); 21887 return (ffelexHandler) ffestb_decl_attrs_; 21888 21889 case FFELEX_typeCOLONCOLON: 21890 ffestb_local_.decl.coloncolon = TRUE; 21891 ffesta_confirmed (); 21892 if (!ffesta_is_inhibited ()) 21893 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0], 21894 ffestb_local_.decl.kind, ffestb_local_.decl.kindt, 21895 ffestb_local_.decl.len, ffestb_local_.decl.lent); 21896 if (ffestb_local_.decl.kindt != NULL) 21897 ffelex_token_kill (ffestb_local_.decl.kindt); 21898 if (ffestb_local_.decl.lent != NULL) 21899 ffelex_token_kill (ffestb_local_.decl.lent); 21900 return (ffelexHandler) ffestb_decl_ents_; 21901 21902 default: 21903 return (ffelexHandler) ffestb_decl_entsp_ (t); 21904 } 21905} 21906 21907/* ffestb_decl_ents_ -- "type" [type parameters] [attributes "::"] 21908 21909 return ffestb_decl_ents_; // to lexer 21910 21911 Handle NAME of an entity. */ 21912 21913static ffelexHandler 21914ffestb_decl_ents_ (ffelexToken t) 21915{ 21916 switch (ffelex_token_type (t)) 21917 { 21918 case FFELEX_typeNAME: 21919 ffesta_tokens[1] = ffelex_token_use (t); 21920 return (ffelexHandler) ffestb_decl_ents_1_; 21921 21922 default: 21923 break; 21924 } 21925 21926 if (!ffesta_is_inhibited ()) 21927 ffestc_decl_finish (); 21928 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t); 21929 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 21930} 21931 21932/* ffestb_decl_ents_1_ -- "type" [type parameters] [attributes "::"] NAME 21933 21934 return ffestb_decl_ents_1_; // to lexer 21935 21936 Handle ASTERISK, OPEN_PAREN, EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */ 21937 21938static ffelexHandler 21939ffestb_decl_ents_1_ (ffelexToken t) 21940{ 21941 switch (ffelex_token_type (t)) 21942 { 21943 case FFELEX_typeCOMMA: 21944 if (!ffesta_is_inhibited ()) 21945 ffestc_decl_item (ffesta_tokens[1], NULL, NULL, NULL, NULL, NULL, NULL, 21946 NULL, FALSE); 21947 ffelex_token_kill (ffesta_tokens[1]); 21948 return (ffelexHandler) ffestb_decl_ents_; 21949 21950 case FFELEX_typeEOS: 21951 case FFELEX_typeSEMICOLON: 21952 if (!ffesta_is_inhibited ()) 21953 { 21954 ffestc_decl_item (ffesta_tokens[1], NULL, NULL, NULL, NULL, NULL, NULL, 21955 NULL, FALSE); 21956 ffestc_decl_finish (); 21957 } 21958 ffelex_token_kill (ffesta_tokens[1]); 21959 return (ffelexHandler) ffesta_zero (t); 21960 21961 case FFELEX_typeASTERISK: 21962 ffestb_local_.decl.len = NULL; 21963 ffestb_local_.decl.lent = NULL; 21964 return (ffelexHandler) ffestb_decl_ents_2_; 21965 21966 case FFELEX_typeOPEN_PAREN: 21967 ffestb_local_.decl.kind = NULL; 21968 ffestb_local_.decl.kindt = NULL; 21969 ffestb_local_.decl.len = NULL; 21970 ffestb_local_.decl.lent = NULL; 21971 return (ffelexHandler) ffestb_decl_ents_3_ (t); 21972 21973 case FFELEX_typeEQUALS: 21974 case FFELEX_typeSLASH: 21975 ffestb_local_.decl.kind = NULL; 21976 ffestb_local_.decl.kindt = NULL; 21977 ffestb_subrargs_.dim_list.dims = NULL; 21978 ffestb_local_.decl.len = NULL; 21979 ffestb_local_.decl.lent = NULL; 21980 return (ffelexHandler) ffestb_decl_ents_7_ (t); 21981 21982 default: 21983 break; 21984 } 21985 21986 if (!ffesta_is_inhibited ()) 21987 ffestc_decl_finish (); 21988 ffelex_token_kill (ffesta_tokens[1]); 21989 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t); 21990 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 21991} 21992 21993/* ffestb_decl_ents_2_ -- "type" [type parameters] [attributes "::"] NAME 21994 ASTERISK 21995 21996 return ffestb_decl_ents_2_; // to lexer 21997 21998 Handle NUMBER or OPEN_PAREN. */ 21999 22000static ffelexHandler 22001ffestb_decl_ents_2_ (ffelexToken t) 22002{ 22003 switch (ffelex_token_type (t)) 22004 { 22005 case FFELEX_typeNUMBER: 22006 if (ffestb_local_.decl.type != FFESTP_typeCHARACTER) 22007 { 22008 ffestb_local_.decl.kind = NULL; 22009 ffestb_local_.decl.kindt = ffelex_token_use (t); 22010 return (ffelexHandler) ffestb_decl_ents_3_; 22011 } 22012 /* Fall through. *//* (CHARACTER's *n is always a len spec. */ 22013 case FFELEX_typeOPEN_PAREN:/* "*(" is after the (omitted) 22014 "(array-spec)". */ 22015 ffestb_local_.decl.kind = NULL; 22016 ffestb_local_.decl.kindt = NULL; 22017 ffestb_subrargs_.dim_list.dims = NULL; 22018 return (ffelexHandler) ffestb_decl_ents_5_ (t); 22019 22020 default: 22021 break; 22022 } 22023 22024 if (!ffesta_is_inhibited ()) 22025 ffestc_decl_finish (); 22026 ffelex_token_kill (ffesta_tokens[1]); 22027 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t); 22028 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 22029} 22030 22031/* ffestb_decl_ents_3_ -- "type" [type parameters] [attributes "::"] NAME 22032 [ASTERISK NUMBER] 22033 22034 return ffestb_decl_ents_3_; // to lexer 22035 22036 Handle ASTERISK, OPEN_PAREN, EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */ 22037 22038static ffelexHandler 22039ffestb_decl_ents_3_ (ffelexToken t) 22040{ 22041 switch (ffelex_token_type (t)) 22042 { 22043 case FFELEX_typeCOMMA: 22044 if (!ffesta_is_inhibited ()) 22045 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind, 22046 ffestb_local_.decl.kindt, NULL, NULL, NULL, NULL, NULL, FALSE); 22047 ffelex_token_kill (ffesta_tokens[1]); 22048 if (ffestb_local_.decl.kindt != NULL) 22049 ffelex_token_kill (ffestb_local_.decl.kindt); 22050 return (ffelexHandler) ffestb_decl_ents_; 22051 22052 case FFELEX_typeEOS: 22053 case FFELEX_typeSEMICOLON: 22054 if (!ffesta_is_inhibited ()) 22055 { 22056 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind, 22057 ffestb_local_.decl.kindt, NULL, NULL, NULL, NULL, NULL, FALSE); 22058 ffestc_decl_finish (); 22059 } 22060 ffelex_token_kill (ffesta_tokens[1]); 22061 if (ffestb_local_.decl.kindt != NULL) 22062 ffelex_token_kill (ffestb_local_.decl.kindt); 22063 return (ffelexHandler) ffesta_zero (t); 22064 22065 case FFELEX_typeASTERISK: 22066 ffestb_subrargs_.dim_list.dims = NULL; 22067 return (ffelexHandler) ffestb_decl_ents_5_; 22068 22069 case FFELEX_typeOPEN_PAREN: 22070 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create (); 22071 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_decl_ents_4_; 22072 ffestb_subrargs_.dim_list.pool = ffesta_output_pool; 22073 ffestb_subrargs_.dim_list.ctx = ffesta_is_entry_valid 22074 ? FFEEXPR_contextDIMLIST : FFEEXPR_contextDIMLISTCOMMON; 22075#ifdef FFECOM_dimensionsMAX 22076 ffestb_subrargs_.dim_list.ndims = 0; 22077#endif 22078 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 22079 ffestb_subrargs_.dim_list.ctx, 22080 (ffeexprCallback) ffestb_subr_dimlist_); 22081 22082 case FFELEX_typeEQUALS: 22083 case FFELEX_typeSLASH: 22084 ffestb_local_.decl.kind = NULL; 22085 ffestb_local_.decl.kindt = NULL; 22086 ffestb_subrargs_.dim_list.dims = NULL; 22087 ffestb_local_.decl.len = NULL; 22088 ffestb_local_.decl.lent = NULL; 22089 return (ffelexHandler) ffestb_decl_ents_7_ (t); 22090 22091 default: 22092 break; 22093 } 22094 22095 if (!ffesta_is_inhibited ()) 22096 ffestc_decl_finish (); 22097 ffelex_token_kill (ffesta_tokens[1]); 22098 if (ffestb_local_.decl.kindt != NULL) 22099 ffelex_token_kill (ffestb_local_.decl.kindt); 22100 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t); 22101 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 22102} 22103 22104/* ffestb_decl_ents_4_ -- "type" [type parameters] [attributes "::"] NAME 22105 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN] 22106 22107 return ffestb_decl_ents_4_; // to lexer 22108 22109 Handle ASTERISK, EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */ 22110 22111static ffelexHandler 22112ffestb_decl_ents_4_ (ffelexToken t) 22113{ 22114 ffelexToken nt; 22115 22116 if (!ffestb_subrargs_.dim_list.ok) 22117 goto bad; /* :::::::::::::::::::: */ 22118 22119 if (ffelex_token_type (ffesta_tokens[1]) == FFELEX_typeNAMES) 22120 { 22121 switch (ffelex_token_type (t)) 22122 { 22123 case FFELEX_typeCOMMA: 22124 case FFELEX_typeEOS: 22125 case FFELEX_typeSEMICOLON: 22126 case FFELEX_typeASTERISK: 22127 case FFELEX_typeSLASH: /* But NOT FFELEX_typeEQUALS. */ 22128 case FFELEX_typeCOLONCOLON: /* Actually an error. */ 22129 break; /* Confirm and handle. */ 22130 22131 default: /* Perhaps EQUALS, as in 22132 INTEGERFUNCTIONX(A)=B. */ 22133 goto bad; /* :::::::::::::::::::: */ 22134 } 22135 ffesta_confirmed (); 22136 if (!ffesta_is_inhibited ()) 22137 { 22138 nt = ffelex_token_name_from_names (ffesta_tokens[1], 0, 0); 22139 ffelex_token_kill (ffesta_tokens[1]); 22140 ffesta_tokens[1] = nt; 22141 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0], 22142 NULL, NULL, NULL, NULL); 22143 } 22144 } 22145 22146 switch (ffelex_token_type (t)) 22147 { 22148 case FFELEX_typeCOMMA: 22149 if (!ffesta_is_inhibited ()) 22150 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind, 22151 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims, 22152 ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL, 22153 FALSE); 22154 ffelex_token_kill (ffesta_tokens[1]); 22155 if (ffestb_local_.decl.kindt != NULL) 22156 ffelex_token_kill (ffestb_local_.decl.kindt); 22157 if (ffestb_local_.decl.lent != NULL) 22158 ffelex_token_kill (ffestb_local_.decl.lent); 22159 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 22160 return (ffelexHandler) ffestb_decl_ents_; 22161 22162 case FFELEX_typeEOS: 22163 case FFELEX_typeSEMICOLON: 22164 if (!ffesta_is_inhibited ()) 22165 { 22166 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind, 22167 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims, 22168 ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL, 22169 FALSE); 22170 ffestc_decl_finish (); 22171 } 22172 ffelex_token_kill (ffesta_tokens[1]); 22173 if (ffestb_local_.decl.kindt != NULL) 22174 ffelex_token_kill (ffestb_local_.decl.kindt); 22175 if (ffestb_local_.decl.lent != NULL) 22176 ffelex_token_kill (ffestb_local_.decl.lent); 22177 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 22178 return (ffelexHandler) ffesta_zero (t); 22179 22180 case FFELEX_typeASTERISK: 22181 if (ffestb_local_.decl.lent != NULL) 22182 break; /* Can't specify "*length" twice. */ 22183 return (ffelexHandler) ffestb_decl_ents_5_; 22184 22185 case FFELEX_typeEQUALS: 22186 case FFELEX_typeSLASH: 22187 return (ffelexHandler) ffestb_decl_ents_7_ (t); 22188 22189 default: 22190 break; 22191 } 22192 22193bad: /* :::::::::::::::::::: */ 22194 if ((ffelex_token_type (ffesta_tokens[1]) != FFELEX_typeNAMES) 22195 && !ffesta_is_inhibited ()) 22196 ffestc_decl_finish (); 22197 ffelex_token_kill (ffesta_tokens[1]); 22198 if (ffestb_local_.decl.kindt != NULL) 22199 ffelex_token_kill (ffestb_local_.decl.kindt); 22200 if (ffestb_local_.decl.lent != NULL) 22201 ffelex_token_kill (ffestb_local_.decl.lent); 22202 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 22203 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t); 22204 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 22205} 22206 22207/* ffestb_decl_ents_5_ -- "type" [type parameters] [attributes "::"] NAME 22208 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN] 22209 ASTERISK 22210 22211 return ffestb_decl_ents_5_; // to lexer 22212 22213 Handle NUMBER or OPEN_PAREN. */ 22214 22215static ffelexHandler 22216ffestb_decl_ents_5_ (ffelexToken t) 22217{ 22218 switch (ffelex_token_type (t)) 22219 { 22220 case FFELEX_typeNUMBER: 22221 ffestb_local_.decl.len = NULL; 22222 ffestb_local_.decl.lent = ffelex_token_use (t); 22223 return (ffelexHandler) ffestb_decl_ents_7_; 22224 22225 case FFELEX_typeOPEN_PAREN: 22226 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 22227 FFEEXPR_contextCHARACTERSIZE, (ffeexprCallback) ffestb_decl_ents_6_); 22228 22229 default: 22230 break; 22231 } 22232 22233 if (!ffesta_is_inhibited ()) 22234 ffestc_decl_finish (); 22235 ffelex_token_kill (ffesta_tokens[1]); 22236 if (ffestb_local_.decl.kindt != NULL) 22237 ffelex_token_kill (ffestb_local_.decl.kindt); 22238 if (ffestb_subrargs_.dim_list.dims != NULL) 22239 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 22240 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t); 22241 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 22242} 22243 22244/* ffestb_decl_ents_6_ -- "type" [type parameters] [attributes "::"] NAME 22245 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN] 22246 ASTERISK OPEN_PAREN expr 22247 22248 (ffestb_decl_ents_6_) // to expression handler 22249 22250 Handle CLOSE_PAREN. */ 22251 22252static ffelexHandler 22253ffestb_decl_ents_6_ (ffelexToken ft, ffebld expr, ffelexToken t) 22254{ 22255 switch (ffelex_token_type (t)) 22256 { 22257 case FFELEX_typeCLOSE_PAREN: 22258 if (expr == NULL) 22259 break; 22260 ffestb_local_.decl.len = expr; 22261 ffestb_local_.decl.lent = ffelex_token_use (ft); 22262 return (ffelexHandler) ffestb_decl_ents_7_; 22263 22264 default: 22265 break; 22266 } 22267 22268 if (!ffesta_is_inhibited ()) 22269 ffestc_decl_finish (); 22270 ffelex_token_kill (ffesta_tokens[1]); 22271 if (ffestb_local_.decl.kindt != NULL) 22272 ffelex_token_kill (ffestb_local_.decl.kindt); 22273 if (ffestb_subrargs_.dim_list.dims != NULL) 22274 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 22275 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t); 22276 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 22277} 22278 22279/* ffestb_decl_ents_7_ -- "type" [type parameters] [attributes "::"] NAME 22280 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN] 22281 [ASTERISK charlength] 22282 22283 return ffestb_decl_ents_7_; // to lexer 22284 22285 Handle EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */ 22286 22287static ffelexHandler 22288ffestb_decl_ents_7_ (ffelexToken t) 22289{ 22290 switch (ffelex_token_type (t)) 22291 { 22292 case FFELEX_typeCOMMA: 22293 if (!ffesta_is_inhibited ()) 22294 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind, 22295 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims, 22296 ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL, 22297 FALSE); 22298 ffelex_token_kill (ffesta_tokens[1]); 22299 if (ffestb_local_.decl.kindt != NULL) 22300 ffelex_token_kill (ffestb_local_.decl.kindt); 22301 if (ffestb_subrargs_.dim_list.dims != NULL) 22302 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 22303 if (ffestb_local_.decl.lent != NULL) 22304 ffelex_token_kill (ffestb_local_.decl.lent); 22305 return (ffelexHandler) ffestb_decl_ents_; 22306 22307 case FFELEX_typeEOS: 22308 case FFELEX_typeSEMICOLON: 22309 if (!ffesta_is_inhibited ()) 22310 { 22311 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind, 22312 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims, 22313 ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL, 22314 FALSE); 22315 ffestc_decl_finish (); 22316 } 22317 ffelex_token_kill (ffesta_tokens[1]); 22318 if (ffestb_local_.decl.kindt != NULL) 22319 ffelex_token_kill (ffestb_local_.decl.kindt); 22320 if (ffestb_subrargs_.dim_list.dims != NULL) 22321 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 22322 if (ffestb_local_.decl.lent != NULL) 22323 ffelex_token_kill (ffestb_local_.decl.lent); 22324 return (ffelexHandler) ffesta_zero (t); 22325 22326 case FFELEX_typeEQUALS: 22327 if (!ffestb_local_.decl.coloncolon) 22328 ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_INIT, t); 22329 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 22330 ffestb_local_.decl.parameter ? FFEEXPR_contextPARAMETER 22331 : FFEEXPR_contextINITVAL, (ffeexprCallback) ffestb_decl_ents_8_); 22332 22333 case FFELEX_typeSLASH: 22334 if (!ffesta_is_inhibited ()) 22335 { 22336 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind, 22337 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims, 22338 ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL, 22339 TRUE); 22340 ffestc_decl_itemstartvals (); 22341 } 22342 ffelex_token_kill (ffesta_tokens[1]); 22343 if (ffestb_local_.decl.kindt != NULL) 22344 ffelex_token_kill (ffestb_local_.decl.kindt); 22345 if (ffestb_subrargs_.dim_list.dims != NULL) 22346 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 22347 if (ffestb_local_.decl.lent != NULL) 22348 ffelex_token_kill (ffestb_local_.decl.lent); 22349 return (ffelexHandler) ffeexpr_rhs 22350 (ffesta_output_pool, FFEEXPR_contextDATA, 22351 (ffeexprCallback) ffestb_decl_ents_9_); 22352 22353 default: 22354 break; 22355 } 22356 22357 if (!ffesta_is_inhibited ()) 22358 ffestc_decl_finish (); 22359 ffelex_token_kill (ffesta_tokens[1]); 22360 if (ffestb_local_.decl.kindt != NULL) 22361 ffelex_token_kill (ffestb_local_.decl.kindt); 22362 if (ffestb_subrargs_.dim_list.dims != NULL) 22363 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 22364 if (ffestb_local_.decl.lent != NULL) 22365 ffelex_token_kill (ffestb_local_.decl.lent); 22366 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t); 22367 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 22368} 22369 22370/* ffestb_decl_ents_8_ -- "type" [type parameters] [attributes "::"] NAME 22371 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN] 22372 [ASTERISK charlength] EQUALS expr 22373 22374 (ffestb_decl_ents_8_) // to expression handler 22375 22376 Handle COMMA or EOS/SEMICOLON. */ 22377 22378static ffelexHandler 22379ffestb_decl_ents_8_ (ffelexToken ft, ffebld expr, ffelexToken t) 22380{ 22381 switch (ffelex_token_type (t)) 22382 { 22383 case FFELEX_typeCOMMA: 22384 if (expr == NULL) 22385 break; 22386 if (!ffesta_is_inhibited ()) 22387 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind, 22388 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims, 22389 ffestb_local_.decl.len, ffestb_local_.decl.lent, expr, ft, 22390 FALSE); 22391 ffelex_token_kill (ffesta_tokens[1]); 22392 if (ffestb_local_.decl.kindt != NULL) 22393 ffelex_token_kill (ffestb_local_.decl.kindt); 22394 if (ffestb_subrargs_.dim_list.dims != NULL) 22395 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 22396 if (ffestb_local_.decl.lent != NULL) 22397 ffelex_token_kill (ffestb_local_.decl.lent); 22398 return (ffelexHandler) ffestb_decl_ents_; 22399 22400 case FFELEX_typeEOS: 22401 case FFELEX_typeSEMICOLON: 22402 if (!ffesta_is_inhibited ()) 22403 { 22404 ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind, 22405 ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims, 22406 ffestb_local_.decl.len, ffestb_local_.decl.lent, expr, ft, 22407 FALSE); 22408 ffestc_decl_finish (); 22409 } 22410 ffelex_token_kill (ffesta_tokens[1]); 22411 if (ffestb_local_.decl.kindt != NULL) 22412 ffelex_token_kill (ffestb_local_.decl.kindt); 22413 if (ffestb_subrargs_.dim_list.dims != NULL) 22414 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 22415 if (ffestb_local_.decl.lent != NULL) 22416 ffelex_token_kill (ffestb_local_.decl.lent); 22417 return (ffelexHandler) ffesta_zero (t); 22418 22419 default: 22420 break; 22421 } 22422 22423 if (!ffesta_is_inhibited ()) 22424 ffestc_decl_finish (); 22425 ffelex_token_kill (ffesta_tokens[1]); 22426 if (ffestb_local_.decl.kindt != NULL) 22427 ffelex_token_kill (ffestb_local_.decl.kindt); 22428 if (ffestb_subrargs_.dim_list.dims != NULL) 22429 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 22430 if (ffestb_local_.decl.lent != NULL) 22431 ffelex_token_kill (ffestb_local_.decl.lent); 22432 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t); 22433 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 22434} 22435 22436/* ffestb_decl_ents_9_ -- "type" ... SLASH expr 22437 22438 (ffestb_decl_ents_9_) // to expression handler 22439 22440 Handle ASTERISK, COMMA, or SLASH. */ 22441 22442static ffelexHandler 22443ffestb_decl_ents_9_ (ffelexToken ft, ffebld expr, ffelexToken t) 22444{ 22445 switch (ffelex_token_type (t)) 22446 { 22447 case FFELEX_typeCOMMA: 22448 if (expr == NULL) 22449 break; 22450 if (!ffesta_is_inhibited ()) 22451 ffestc_decl_itemvalue (NULL, NULL, expr, ft); 22452 return (ffelexHandler) ffeexpr_rhs 22453 (ffesta_output_pool, FFEEXPR_contextDATA, 22454 (ffeexprCallback) ffestb_decl_ents_9_); 22455 22456 case FFELEX_typeASTERISK: 22457 if (expr == NULL) 22458 break; 22459 ffestb_local_.decl.expr = expr; 22460 ffesta_tokens[1] = ffelex_token_use (ft); 22461 return (ffelexHandler) ffeexpr_rhs 22462 (ffesta_output_pool, FFEEXPR_contextDATA, 22463 (ffeexprCallback) ffestb_decl_ents_10_); 22464 22465 case FFELEX_typeSLASH: 22466 if (expr == NULL) 22467 break; 22468 if (!ffesta_is_inhibited ()) 22469 { 22470 ffestc_decl_itemvalue (NULL, NULL, expr, ft); 22471 ffestc_decl_itemendvals (t); 22472 } 22473 return (ffelexHandler) ffestb_decl_ents_11_; 22474 22475 default: 22476 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t); 22477 break; 22478 } 22479 22480 if (!ffesta_is_inhibited ()) 22481 { 22482 ffestc_decl_itemendvals (t); 22483 ffestc_decl_finish (); 22484 } 22485 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 22486} 22487 22488/* ffestb_decl_ents_10_ -- "type" ... SLASH expr ASTERISK expr 22489 22490 (ffestb_decl_ents_10_) // to expression handler 22491 22492 Handle COMMA or SLASH. */ 22493 22494static ffelexHandler 22495ffestb_decl_ents_10_ (ffelexToken ft, ffebld expr, ffelexToken t) 22496{ 22497 switch (ffelex_token_type (t)) 22498 { 22499 case FFELEX_typeCOMMA: 22500 if (expr == NULL) 22501 break; 22502 if (!ffesta_is_inhibited ()) 22503 ffestc_decl_itemvalue (ffestb_local_.decl.expr, ffesta_tokens[1], 22504 expr, ft); 22505 ffelex_token_kill (ffesta_tokens[1]); 22506 return (ffelexHandler) ffeexpr_rhs 22507 (ffesta_output_pool, FFEEXPR_contextDATA, 22508 (ffeexprCallback) ffestb_decl_ents_9_); 22509 22510 case FFELEX_typeSLASH: 22511 if (expr == NULL) 22512 break; 22513 if (!ffesta_is_inhibited ()) 22514 { 22515 ffestc_decl_itemvalue (ffestb_local_.decl.expr, ffesta_tokens[1], 22516 expr, ft); 22517 ffestc_decl_itemendvals (t); 22518 } 22519 ffelex_token_kill (ffesta_tokens[1]); 22520 return (ffelexHandler) ffestb_decl_ents_11_; 22521 22522 default: 22523 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t); 22524 break; 22525 } 22526 22527 if (!ffesta_is_inhibited ()) 22528 { 22529 ffestc_decl_itemendvals (t); 22530 ffestc_decl_finish (); 22531 } 22532 ffelex_token_kill (ffesta_tokens[1]); 22533 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 22534} 22535 22536/* ffestb_decl_ents_11_ -- "type" [type parameters] [attributes "::"] NAME 22537 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN] 22538 [ASTERISK charlength] SLASH initvals SLASH 22539 22540 return ffestb_decl_ents_11_; // to lexer 22541 22542 Handle COMMA or EOS/SEMICOLON. */ 22543 22544static ffelexHandler 22545ffestb_decl_ents_11_ (ffelexToken t) 22546{ 22547 switch (ffelex_token_type (t)) 22548 { 22549 case FFELEX_typeCOMMA: 22550 return (ffelexHandler) ffestb_decl_ents_; 22551 22552 case FFELEX_typeEOS: 22553 case FFELEX_typeSEMICOLON: 22554 if (!ffesta_is_inhibited ()) 22555 ffestc_decl_finish (); 22556 return (ffelexHandler) ffesta_zero (t); 22557 22558 default: 22559 break; 22560 } 22561 22562 if (!ffesta_is_inhibited ()) 22563 ffestc_decl_finish (); 22564 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t); 22565 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 22566} 22567 22568/* ffestb_decl_entsp_ -- "type" [type parameters] 22569 22570 return ffestb_decl_entsp_; // to lexer 22571 22572 Handle NAME or NAMES beginning either an entity (object) declaration or 22573 a function definition.. */ 22574 22575static ffelexHandler 22576ffestb_decl_entsp_ (ffelexToken t) 22577{ 22578 switch (ffelex_token_type (t)) 22579 { 22580 case FFELEX_typeNAME: 22581 ffesta_confirmed (); 22582 ffesta_tokens[1] = ffelex_token_use (t); 22583 return (ffelexHandler) ffestb_decl_entsp_1_; 22584 22585 case FFELEX_typeNAMES: 22586 ffesta_confirmed (); 22587 ffesta_tokens[1] = ffelex_token_use (t); 22588 return (ffelexHandler) ffestb_decl_entsp_2_; 22589 22590 default: 22591 break; 22592 } 22593 22594 if (ffestb_local_.decl.kindt != NULL) 22595 ffelex_token_kill (ffestb_local_.decl.kindt); 22596 if (ffestb_local_.decl.lent != NULL) 22597 ffelex_token_kill (ffestb_local_.decl.lent); 22598 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t); 22599 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 22600} 22601 22602/* ffestb_decl_entsp_1_ -- "type" [type parameters] NAME 22603 22604 return ffestb_decl_entsp_1_; // to lexer 22605 22606 If we get another NAME token here, then the previous one must be 22607 "RECURSIVE" or "FUNCTION" and we handle it accordingly. Otherwise, 22608 we send the previous and current token through to _ents_. */ 22609 22610static ffelexHandler 22611ffestb_decl_entsp_1_ (ffelexToken t) 22612{ 22613 switch (ffelex_token_type (t)) 22614 { 22615 case FFELEX_typeNAME: 22616 switch (ffestr_first (ffesta_tokens[1])) 22617 { 22618#if FFESTR_F90 22619 case FFESTR_firstRECURSIVE: 22620 if (ffestr_first (t) != FFESTR_firstFUNCTION) 22621 { 22622 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); 22623 break; 22624 } 22625 ffestb_local_.decl.recursive = ffesta_tokens[1]; 22626 return (ffelexHandler) ffestb_decl_funcname_; 22627#endif 22628 22629 case FFESTR_firstFUNCTION: 22630 ffelex_token_kill (ffesta_tokens[1]); 22631 return (ffelexHandler) ffestb_decl_funcname_ (t); 22632 22633 default: 22634 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", ffesta_tokens[1]); 22635 break; 22636 } 22637 break; 22638 22639 default: 22640 if ((ffelex_token_type (ffesta_tokens[1]) != FFELEX_typeNAMES) 22641 && !ffesta_is_inhibited ()) 22642 ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0], 22643 ffestb_local_.decl.kind, ffestb_local_.decl.kindt, 22644 ffestb_local_.decl.len, ffestb_local_.decl.lent); 22645 if (ffestb_local_.decl.kindt != NULL) 22646 ffelex_token_kill (ffestb_local_.decl.kindt); 22647 if (ffestb_local_.decl.lent != NULL) 22648 ffelex_token_kill (ffestb_local_.decl.lent); 22649 /* NAME/NAMES token already in ffesta_tokens[1]. */ 22650 return (ffelexHandler) ffestb_decl_ents_1_ (t); 22651 } 22652 22653 if (ffestb_local_.decl.kindt != NULL) 22654 ffelex_token_kill (ffestb_local_.decl.kindt); 22655 if (ffestb_local_.decl.lent != NULL) 22656 ffelex_token_kill (ffestb_local_.decl.lent); 22657 ffelex_token_kill (ffesta_tokens[1]); 22658 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 22659} 22660 22661/* ffestb_decl_entsp_2_ -- "type" [type parameters] NAMES 22662 22663 return ffestb_decl_entsp_2_; // to lexer 22664 22665 If we get an ASTERISK or OPEN_PAREN here, then if the previous NAMES 22666 begins with "FUNCTION" or "RECURSIVEFUNCTION" and is followed by a 22667 first-name-char, we have a possible syntactically ambiguous situation. 22668 Otherwise, we have a straightforward situation just as if we went 22669 through _entsp_1_ instead of here. */ 22670 22671static ffelexHandler 22672ffestb_decl_entsp_2_ (ffelexToken t) 22673{ 22674 ffelexToken nt; 22675 bool asterisk_ok; 22676 unsigned const char *p; 22677 ffeTokenLength i; 22678 22679 switch (ffelex_token_type (t)) 22680 { 22681 case FFELEX_typeASTERISK: 22682 ffesta_confirmed (); 22683 switch (ffestb_local_.decl.type) 22684 { 22685 case FFESTP_typeINTEGER: 22686 case FFESTP_typeREAL: 22687 case FFESTP_typeCOMPLEX: 22688 case FFESTP_typeLOGICAL: 22689 asterisk_ok = (ffestb_local_.decl.kindt == NULL); 22690 break; 22691 22692 case FFESTP_typeCHARACTER: 22693 asterisk_ok = (ffestb_local_.decl.lent == NULL); 22694 break; 22695 22696 case FFESTP_typeBYTE: 22697 case FFESTP_typeWORD: 22698 default: 22699 asterisk_ok = FALSE; 22700 break; 22701 } 22702 switch (ffestr_first (ffesta_tokens[1])) 22703 { 22704#if FFESTR_F90 22705 case FFESTR_firstRECURSIVEFNCTN: 22706 if (!asterisk_ok) 22707 break; /* For our own convenience, treat as non-FN 22708 stmt. */ 22709 p = ffelex_token_text (ffesta_tokens[1]) 22710 + (i = FFESTR_firstlRECURSIVEFNCTN); 22711 if (!ffesrc_is_name_init (*p)) 22712 break; 22713 ffestb_local_.decl.recursive 22714 = ffelex_token_name_from_names (ffesta_tokens[1], 0, 22715 FFESTR_firstlRECURSIVEFNCTN); 22716 ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1], 22717 FFESTR_firstlRECURSIVEFNCTN, 0); 22718 return (ffelexHandler) ffestb_decl_entsp_3_; 22719#endif 22720 22721 case FFESTR_firstFUNCTION: 22722 if (!asterisk_ok) 22723 break; /* For our own convenience, treat as non-FN 22724 stmt. */ 22725 p = ffelex_token_text (ffesta_tokens[1]) 22726 + (i = FFESTR_firstlFUNCTION); 22727 if (!ffesrc_is_name_init (*p)) 22728 break; 22729 ffestb_local_.decl.recursive = NULL; 22730 ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1], 22731 FFESTR_firstlFUNCTION, 0); 22732 return (ffelexHandler) ffestb_decl_entsp_3_; 22733 22734 default: 22735 break; 22736 } 22737 break; 22738 22739 case FFELEX_typeOPEN_PAREN: 22740 ffestb_local_.decl.aster_after = FALSE; 22741 switch (ffestr_first (ffesta_tokens[1])) 22742 { 22743#if FFESTR_F90 22744 case FFESTR_firstRECURSIVEFNCTN: 22745 p = ffelex_token_text (ffesta_tokens[1]) 22746 + (i = FFESTR_firstlRECURSIVEFNCTN); 22747 if (!ffesrc_is_name_init (*p)) 22748 break; 22749 ffestb_local_.decl.recursive 22750 = ffelex_token_name_from_names (ffesta_tokens[1], 0, 22751 FFESTR_firstlRECURSIVEFNCTN); 22752 ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1], 22753 FFESTR_firstlRECURSIVEFNCTN, 0); 22754 return (ffelexHandler) ffestb_decl_entsp_5_ (t); 22755#endif 22756 22757 case FFESTR_firstFUNCTION: 22758 p = ffelex_token_text (ffesta_tokens[1]) 22759 + (i = FFESTR_firstlFUNCTION); 22760 if (!ffesrc_is_name_init (*p)) 22761 break; 22762 ffestb_local_.decl.recursive = NULL; 22763 ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1], 22764 FFESTR_firstlFUNCTION, 0); 22765 return (ffelexHandler) ffestb_decl_entsp_5_ (t); 22766 22767 default: 22768 break; 22769 } 22770 if ((ffestb_local_.decl.kindt != NULL) 22771 || (ffestb_local_.decl.lent != NULL)) 22772 break; /* Have kind/len type param, definitely not 22773 assignment stmt. */ 22774 return (ffelexHandler) ffestb_decl_entsp_1_ (t); 22775 22776 default: 22777 break; 22778 } 22779 22780 nt = ffelex_token_name_from_names (ffesta_tokens[1], 0, 0); 22781 ffelex_token_kill (ffesta_tokens[1]); 22782 ffesta_tokens[1] = nt; /* Change NAMES to NAME. */ 22783 return (ffelexHandler) ffestb_decl_entsp_1_ (t); 22784} 22785 22786/* ffestb_decl_entsp_3_ -- "type" [type parameters] [RECURSIVE] FUNCTION 22787 NAME ASTERISK 22788 22789 return ffestb_decl_entsp_3_; // to lexer 22790 22791 Handle NUMBER or OPEN_PAREN. */ 22792 22793static ffelexHandler 22794ffestb_decl_entsp_3_ (ffelexToken t) 22795{ 22796 ffestb_local_.decl.aster_after = TRUE; 22797 22798 switch (ffelex_token_type (t)) 22799 { 22800 case FFELEX_typeNUMBER: 22801 switch (ffestb_local_.decl.type) 22802 { 22803 case FFESTP_typeINTEGER: 22804 case FFESTP_typeREAL: 22805 case FFESTP_typeCOMPLEX: 22806 case FFESTP_typeLOGICAL: 22807 ffestb_local_.decl.kindt = ffelex_token_use (t); 22808 break; 22809 22810 case FFESTP_typeCHARACTER: 22811 ffestb_local_.decl.lent = ffelex_token_use (t); 22812 break; 22813 22814 case FFESTP_typeBYTE: 22815 case FFESTP_typeWORD: 22816 default: 22817 assert (FALSE); 22818 } 22819 return (ffelexHandler) ffestb_decl_entsp_5_; 22820 22821 case FFELEX_typeOPEN_PAREN: 22822 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 22823 FFEEXPR_contextCHARACTERSIZE, 22824 (ffeexprCallback) ffestb_decl_entsp_4_); 22825 22826 default: 22827 break; 22828 } 22829 22830 if (ffestb_local_.decl.recursive != NULL) 22831 ffelex_token_kill (ffestb_local_.decl.recursive); 22832 if (ffestb_local_.decl.kindt != NULL) 22833 ffelex_token_kill (ffestb_local_.decl.kindt); 22834 if (ffestb_local_.decl.lent != NULL) 22835 ffelex_token_kill (ffestb_local_.decl.lent); 22836 ffelex_token_kill (ffesta_tokens[1]); 22837 ffelex_token_kill (ffesta_tokens[2]); 22838 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); 22839 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 22840} 22841 22842/* ffestb_decl_entsp_4_ -- "type" [type parameters] [RECURSIVE] FUNCTION 22843 NAME ASTERISK OPEN_PAREN expr 22844 22845 (ffestb_decl_entsp_4_) // to expression handler 22846 22847 Allow only CLOSE_PAREN; and deal with character-length expression. */ 22848 22849static ffelexHandler 22850ffestb_decl_entsp_4_ (ffelexToken ft, ffebld expr, ffelexToken t) 22851{ 22852 switch (ffelex_token_type (t)) 22853 { 22854 case FFELEX_typeCLOSE_PAREN: 22855 if (expr == NULL) 22856 break; 22857 switch (ffestb_local_.decl.type) 22858 { 22859 case FFESTP_typeCHARACTER: 22860 ffestb_local_.decl.len = expr; 22861 ffestb_local_.decl.lent = ffelex_token_use (ft); 22862 break; 22863 22864 default: 22865 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); 22866 break; 22867 } 22868 return (ffelexHandler) ffestb_decl_entsp_5_; 22869 22870 default: 22871 break; 22872 } 22873 22874 if (ffestb_local_.decl.recursive != NULL) 22875 ffelex_token_kill (ffestb_local_.decl.recursive); 22876 if (ffestb_local_.decl.kindt != NULL) 22877 ffelex_token_kill (ffestb_local_.decl.kindt); 22878 if (ffestb_local_.decl.lent != NULL) 22879 ffelex_token_kill (ffestb_local_.decl.lent); 22880 ffelex_token_kill (ffesta_tokens[1]); 22881 ffelex_token_kill (ffesta_tokens[2]); 22882 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); 22883 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 22884} 22885 22886/* ffestb_decl_entsp_5_ -- "type" [type parameters] [RECURSIVE] FUNCTION 22887 NAME [type parameter] 22888 22889 return ffestb_decl_entsp_5_; // to lexer 22890 22891 Make sure the next token is an OPEN_PAREN. Get the arg list or dimension 22892 list. If it can't be an arg list, or if the CLOSE_PAREN is followed by 22893 something other than EOS/SEMICOLON or NAME, then treat as dimension list 22894 and handle statement as an R426/R501. If it can't be a dimension list, or 22895 if the CLOSE_PAREN is followed by NAME, treat as an arg list and handle 22896 statement as an R1219. If it can be either an arg list or a dimension 22897 list and if the CLOSE_PAREN is followed by EOS/SEMICOLON, ask FFESTC 22898 whether to treat the statement as an R426/R501 or an R1219 and act 22899 accordingly. */ 22900 22901static ffelexHandler 22902ffestb_decl_entsp_5_ (ffelexToken t) 22903{ 22904 switch (ffelex_token_type (t)) 22905 { 22906 case FFELEX_typeOPEN_PAREN: 22907 if (ffestb_local_.decl.aster_after && (ffestb_local_.decl.len != NULL)) 22908 { /* "CHARACTER[RECURSIVE]FUNCTIONxyz*(len-expr) 22909 (..." must be a function-stmt, since the 22910 (len-expr) cannot precede (array-spec) in 22911 an object declaration but can precede 22912 (name-list) in a function stmt. */ 22913 ffelex_token_kill (ffesta_tokens[1]); 22914 ffesta_tokens[1] = ffesta_tokens[2]; 22915 return (ffelexHandler) ffestb_decl_funcname_4_ (t); 22916 } 22917 ffestb_local_.decl.toklist = ffestt_tokenlist_create (); 22918 ffestb_local_.decl.empty = TRUE; 22919 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t)); 22920 return (ffelexHandler) ffestb_decl_entsp_6_; 22921 22922 default: 22923 break; 22924 } 22925 22926 assert (ffestb_local_.decl.aster_after); 22927 ffesta_confirmed (); /* We've seen an ASTERISK, so even EQUALS 22928 confirmed. */ 22929 ffestb_subr_ambig_to_ents_ (); 22930 ffestb_subrargs_.dim_list.dims = NULL; 22931 return (ffelexHandler) ffestb_decl_ents_7_ (t); 22932} 22933 22934/* ffestb_decl_entsp_6_ -- "type" [type parameters] [RECURSIVE] FUNCTION 22935 NAME [type parameter] OPEN_PAREN 22936 22937 return ffestb_decl_entsp_6_; // to lexer 22938 22939 If CLOSE_PAREN, we definitely have an R1219 function-stmt, since 22940 the notation "name()" is invalid for a declaration. */ 22941 22942static ffelexHandler 22943ffestb_decl_entsp_6_ (ffelexToken t) 22944{ 22945 ffelexHandler next; 22946 22947 switch (ffelex_token_type (t)) 22948 { 22949 case FFELEX_typeCLOSE_PAREN: 22950 if (!ffestb_local_.decl.empty) 22951 { /* Trailing comma, just a warning for 22952 stmt func def, so allow ambiguity. */ 22953 ffestt_tokenlist_append (ffestb_local_.decl.toklist, 22954 ffelex_token_use (t)); 22955 return (ffelexHandler) ffestb_decl_entsp_8_; 22956 } 22957 ffelex_token_kill (ffesta_tokens[1]); 22958 ffesta_tokens[1] = ffesta_tokens[2]; 22959 next = (ffelexHandler) ffestt_tokenlist_handle 22960 (ffestb_local_.decl.toklist, (ffelexHandler) ffestb_decl_funcname_4_); 22961 ffestt_tokenlist_kill (ffestb_local_.decl.toklist); 22962 return (ffelexHandler) (*next) (t); 22963 22964 case FFELEX_typeNAME: 22965 ffestb_local_.decl.empty = FALSE; 22966 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t)); 22967 return (ffelexHandler) ffestb_decl_entsp_7_; 22968 22969 case FFELEX_typeEQUALS: 22970 case FFELEX_typePOINTS: 22971 case FFELEX_typePERCENT: 22972 case FFELEX_typePERIOD: 22973 case FFELEX_typeOPEN_PAREN: 22974 if ((ffestb_local_.decl.kindt != NULL) 22975 || (ffestb_local_.decl.lent != NULL)) 22976 break; /* type(params)name or type*val name, either 22977 way confirmed. */ 22978 return (ffelexHandler) ffestb_subr_ambig_nope_ (t); 22979 22980 default: 22981 break; 22982 } 22983 22984 ffesta_confirmed (); 22985 ffestb_subr_ambig_to_ents_ (); 22986 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist, 22987 (ffelexHandler) ffestb_decl_ents_3_); 22988 ffestt_tokenlist_kill (ffestb_local_.decl.toklist); 22989 return (ffelexHandler) (*next) (t); 22990} 22991 22992/* ffestb_decl_entsp_7_ -- "type" [type parameters] [RECURSIVE] FUNCTION 22993 NAME [type parameter] OPEN_PAREN NAME 22994 22995 return ffestb_decl_entsp_7_; // to lexer 22996 22997 Expect COMMA or CLOSE_PAREN to remain ambiguous, else not an R1219 22998 function-stmt. */ 22999 23000static ffelexHandler 23001ffestb_decl_entsp_7_ (ffelexToken t) 23002{ 23003 ffelexHandler next; 23004 23005 switch (ffelex_token_type (t)) 23006 { 23007 case FFELEX_typeCLOSE_PAREN: 23008 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t)); 23009 return (ffelexHandler) ffestb_decl_entsp_8_; 23010 23011 case FFELEX_typeCOMMA: 23012 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t)); 23013 return (ffelexHandler) ffestb_decl_entsp_6_; 23014 23015 case FFELEX_typeEQUALS: 23016 case FFELEX_typePOINTS: 23017 case FFELEX_typePERCENT: 23018 case FFELEX_typePERIOD: 23019 case FFELEX_typeOPEN_PAREN: 23020 if ((ffestb_local_.decl.kindt != NULL) 23021 || (ffestb_local_.decl.lent != NULL)) 23022 break; /* type(params)name or type*val name, either 23023 way confirmed. */ 23024 return (ffelexHandler) ffestb_subr_ambig_nope_ (t); 23025 23026 default: 23027 break; 23028 } 23029 23030 ffesta_confirmed (); 23031 ffestb_subr_ambig_to_ents_ (); 23032 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist, 23033 (ffelexHandler) ffestb_decl_ents_3_); 23034 ffestt_tokenlist_kill (ffestb_local_.decl.toklist); 23035 return (ffelexHandler) (*next) (t); 23036} 23037 23038/* ffestb_decl_entsp_8_ -- "type" [type parameters] [RECURSIVE] FUNCTION 23039 NAME [type parameter] OPEN_PAREN name-list 23040 CLOSE_PAREN 23041 23042 return ffestb_decl_entsp_8_; // to lexer 23043 23044 If EOS/SEMICOLON, situation remains ambiguous, ask FFESTC to resolve 23045 it. If NAME (must be "RESULT", but that is checked later on), 23046 definitely an R1219 function-stmt. Anything else, handle as entity decl. */ 23047 23048static ffelexHandler 23049ffestb_decl_entsp_8_ (ffelexToken t) 23050{ 23051 ffelexHandler next; 23052 23053 switch (ffelex_token_type (t)) 23054 { 23055 case FFELEX_typeEOS: 23056 case FFELEX_typeSEMICOLON: 23057 ffesta_confirmed (); 23058 if (ffestc_is_decl_not_R1219 ()) 23059 break; 23060 /* Fall through. */ 23061 case FFELEX_typeNAME: 23062 ffesta_confirmed (); 23063 ffelex_token_kill (ffesta_tokens[1]); 23064 ffesta_tokens[1] = ffesta_tokens[2]; 23065 next = (ffelexHandler) ffestt_tokenlist_handle 23066 (ffestb_local_.decl.toklist, (ffelexHandler) ffestb_decl_funcname_4_); 23067 ffestt_tokenlist_kill (ffestb_local_.decl.toklist); 23068 return (ffelexHandler) (*next) (t); 23069 23070 case FFELEX_typeEQUALS: 23071 case FFELEX_typePOINTS: 23072 case FFELEX_typePERCENT: 23073 case FFELEX_typePERIOD: 23074 case FFELEX_typeOPEN_PAREN: 23075 if ((ffestb_local_.decl.kindt != NULL) 23076 || (ffestb_local_.decl.lent != NULL)) 23077 break; /* type(params)name or type*val name, either 23078 way confirmed. */ 23079 return (ffelexHandler) ffestb_subr_ambig_nope_ (t); 23080 23081 default: 23082 break; 23083 } 23084 23085 ffesta_confirmed (); 23086 ffestb_subr_ambig_to_ents_ (); 23087 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist, 23088 (ffelexHandler) ffestb_decl_ents_3_); 23089 ffestt_tokenlist_kill (ffestb_local_.decl.toklist); 23090 return (ffelexHandler) (*next) (t); 23091} 23092 23093/* ffestb_decl_func_ -- ["type" [type parameters]] RECURSIVE 23094 23095 return ffestb_decl_func_; // to lexer 23096 23097 Handle "FUNCTION". */ 23098 23099#if FFESTR_F90 23100static ffelexHandler 23101ffestb_decl_func_ (ffelexToken t) 23102{ 23103 const char *p; 23104 ffeTokenLength i; 23105 23106 ffelex_set_names (FALSE); 23107 23108 switch (ffelex_token_type (t)) 23109 { 23110 case FFELEX_typeNAME: 23111 if (ffestr_first (t) != FFESTR_firstFUNCTION) 23112 break; 23113 return (ffelexHandler) ffestb_decl_funcname_; 23114 23115 case FFELEX_typeNAMES: 23116 ffesta_confirmed (); 23117 if (ffestr_first (t) != FFESTR_firstFUNCTION) 23118 break; 23119 p = ffelex_token_text (t) + (i = FFESTR_firstlFUNCTION); 23120 if (*p == '\0') 23121 break; 23122 if (!ffesrc_is_name_init (*p)) 23123 goto bad_i; /* :::::::::::::::::::: */ 23124 ffesta_tokens[1] = ffelex_token_name_from_names (t, i, 0); 23125 return (ffelexHandler) ffestb_decl_funcname_1_; 23126 23127 default: 23128 break; 23129 } 23130 23131 if (ffestb_local_.decl.recursive != NULL) 23132 ffelex_token_kill (ffestb_local_.decl.recursive); 23133 if (ffestb_local_.decl.kindt != NULL) 23134 ffelex_token_kill (ffestb_local_.decl.kindt); 23135 if (ffestb_local_.decl.lent != NULL) 23136 ffelex_token_kill (ffestb_local_.decl.lent); 23137 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); 23138 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 23139 23140bad_i: /* :::::::::::::::::::: */ 23141 if (ffestb_local_.decl.recursive != NULL) 23142 ffelex_token_kill (ffestb_local_.decl.recursive); 23143 if (ffestb_local_.decl.kindt != NULL) 23144 ffelex_token_kill (ffestb_local_.decl.kindt); 23145 if (ffestb_local_.decl.lent != NULL) 23146 ffelex_token_kill (ffestb_local_.decl.lent); 23147 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t, i, NULL); 23148 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 23149} 23150 23151#endif 23152/* ffestb_decl_funcname_ -- "type" [type parameters] [RECURSIVE] FUNCTION 23153 23154 return ffestb_decl_funcname_; // to lexer 23155 23156 Handle NAME of a function. */ 23157 23158static ffelexHandler 23159ffestb_decl_funcname_ (ffelexToken t) 23160{ 23161 switch (ffelex_token_type (t)) 23162 { 23163 case FFELEX_typeNAME: 23164 ffesta_tokens[1] = ffelex_token_use (t); 23165 return (ffelexHandler) ffestb_decl_funcname_1_; 23166 23167 default: 23168 break; 23169 } 23170 23171 if (ffestb_local_.decl.recursive != NULL) 23172 ffelex_token_kill (ffestb_local_.decl.recursive); 23173 if (ffestb_local_.decl.kindt != NULL) 23174 ffelex_token_kill (ffestb_local_.decl.kindt); 23175 if (ffestb_local_.decl.lent != NULL) 23176 ffelex_token_kill (ffestb_local_.decl.lent); 23177 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); 23178 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 23179} 23180 23181/* ffestb_decl_funcname_1_ -- "type" [type parameters] [RECURSIVE] FUNCTION 23182 NAME 23183 23184 return ffestb_decl_funcname_1_; // to lexer 23185 23186 Handle ASTERISK or OPEN_PAREN. */ 23187 23188static ffelexHandler 23189ffestb_decl_funcname_1_ (ffelexToken t) 23190{ 23191 switch (ffelex_token_type (t)) 23192 { 23193 case FFELEX_typeASTERISK: 23194 return (ffelexHandler) ffestb_decl_funcname_2_; 23195 23196 case FFELEX_typeOPEN_PAREN: 23197 return (ffelexHandler) ffestb_decl_funcname_4_ (t); 23198 23199 default: 23200 break; 23201 } 23202 23203 if (ffestb_local_.decl.recursive != NULL) 23204 ffelex_token_kill (ffestb_local_.decl.recursive); 23205 if (ffestb_local_.decl.kindt != NULL) 23206 ffelex_token_kill (ffestb_local_.decl.kindt); 23207 if (ffestb_local_.decl.lent != NULL) 23208 ffelex_token_kill (ffestb_local_.decl.lent); 23209 ffelex_token_kill (ffesta_tokens[1]); 23210 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); 23211 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 23212} 23213 23214/* ffestb_decl_funcname_2_ -- "type" [type parameters] [RECURSIVE] FUNCTION 23215 NAME ASTERISK 23216 23217 return ffestb_decl_funcname_2_; // to lexer 23218 23219 Handle NUMBER or OPEN_PAREN. */ 23220 23221static ffelexHandler 23222ffestb_decl_funcname_2_ (ffelexToken t) 23223{ 23224 switch (ffelex_token_type (t)) 23225 { 23226 case FFELEX_typeNUMBER: 23227 switch (ffestb_local_.decl.type) 23228 { 23229 case FFESTP_typeINTEGER: 23230 case FFESTP_typeREAL: 23231 case FFESTP_typeCOMPLEX: 23232 case FFESTP_typeLOGICAL: 23233 if (ffestb_local_.decl.kindt == NULL) 23234 ffestb_local_.decl.kindt = ffelex_token_use (t); 23235 else 23236 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); 23237 break; 23238 23239 case FFESTP_typeCHARACTER: 23240 if (ffestb_local_.decl.lent == NULL) 23241 ffestb_local_.decl.lent = ffelex_token_use (t); 23242 else 23243 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); 23244 break; 23245 23246 case FFESTP_typeBYTE: 23247 case FFESTP_typeWORD: 23248 default: 23249 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); 23250 break; 23251 } 23252 return (ffelexHandler) ffestb_decl_funcname_4_; 23253 23254 case FFELEX_typeOPEN_PAREN: 23255 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 23256 FFEEXPR_contextCHARACTERSIZE, 23257 (ffeexprCallback) ffestb_decl_funcname_3_); 23258 23259 default: 23260 break; 23261 } 23262 23263 if (ffestb_local_.decl.recursive != NULL) 23264 ffelex_token_kill (ffestb_local_.decl.recursive); 23265 if (ffestb_local_.decl.kindt != NULL) 23266 ffelex_token_kill (ffestb_local_.decl.kindt); 23267 if (ffestb_local_.decl.lent != NULL) 23268 ffelex_token_kill (ffestb_local_.decl.lent); 23269 ffelex_token_kill (ffesta_tokens[1]); 23270 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); 23271 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 23272} 23273 23274/* ffestb_decl_funcname_3_ -- "type" [type parameters] [RECURSIVE] FUNCTION 23275 NAME ASTERISK OPEN_PAREN expr 23276 23277 (ffestb_decl_funcname_3_) // to expression handler 23278 23279 Allow only CLOSE_PAREN; and deal with character-length expression. */ 23280 23281static ffelexHandler 23282ffestb_decl_funcname_3_ (ffelexToken ft, ffebld expr, ffelexToken t) 23283{ 23284 switch (ffelex_token_type (t)) 23285 { 23286 case FFELEX_typeCLOSE_PAREN: 23287 if (expr == NULL) 23288 break; 23289 switch (ffestb_local_.decl.type) 23290 { 23291 case FFESTP_typeCHARACTER: 23292 if (ffestb_local_.decl.lent == NULL) 23293 { 23294 ffestb_local_.decl.len = expr; 23295 ffestb_local_.decl.lent = ffelex_token_use (ft); 23296 } 23297 else 23298 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); 23299 break; 23300 23301 default: 23302 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); 23303 break; 23304 } 23305 return (ffelexHandler) ffestb_decl_funcname_4_; 23306 23307 default: 23308 break; 23309 } 23310 23311 if (ffestb_local_.decl.recursive != NULL) 23312 ffelex_token_kill (ffestb_local_.decl.recursive); 23313 if (ffestb_local_.decl.kindt != NULL) 23314 ffelex_token_kill (ffestb_local_.decl.kindt); 23315 if (ffestb_local_.decl.lent != NULL) 23316 ffelex_token_kill (ffestb_local_.decl.lent); 23317 ffelex_token_kill (ffesta_tokens[1]); 23318 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); 23319 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 23320} 23321 23322/* ffestb_decl_funcname_4_ -- "type" [type parameters] [RECURSIVE] FUNCTION 23323 NAME [type parameter] 23324 23325 return ffestb_decl_funcname_4_; // to lexer 23326 23327 Make sure the next token is an OPEN_PAREN. Get the arg list and 23328 then implement. */ 23329 23330static ffelexHandler 23331ffestb_decl_funcname_4_ (ffelexToken t) 23332{ 23333 switch (ffelex_token_type (t)) 23334 { 23335 case FFELEX_typeOPEN_PAREN: 23336 ffestb_subrargs_.name_list.args = ffestt_tokenlist_create (); 23337 ffestb_subrargs_.name_list.handler 23338 = (ffelexHandler) ffestb_decl_funcname_5_; 23339 ffestb_subrargs_.name_list.is_subr = FALSE; 23340 ffestb_subrargs_.name_list.names = FALSE; 23341 return (ffelexHandler) ffestb_subr_name_list_; 23342 23343 default: 23344 break; 23345 } 23346 23347 if (ffestb_local_.decl.recursive != NULL) 23348 ffelex_token_kill (ffestb_local_.decl.recursive); 23349 if (ffestb_local_.decl.kindt != NULL) 23350 ffelex_token_kill (ffestb_local_.decl.kindt); 23351 if (ffestb_local_.decl.lent != NULL) 23352 ffelex_token_kill (ffestb_local_.decl.lent); 23353 ffelex_token_kill (ffesta_tokens[1]); 23354 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); 23355 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 23356} 23357 23358/* ffestb_decl_funcname_5_ -- "type" [type parameters] [RECURSIVE] FUNCTION 23359 NAME [type parameter] OPEN_PAREN arg-list 23360 CLOSE_PAREN 23361 23362 return ffestb_decl_funcname_5_; // to lexer 23363 23364 Must have EOS/SEMICOLON or "RESULT" here. */ 23365 23366static ffelexHandler 23367ffestb_decl_funcname_5_ (ffelexToken t) 23368{ 23369 if (!ffestb_subrargs_.name_list.ok) 23370 goto bad; /* :::::::::::::::::::: */ 23371 23372 switch (ffelex_token_type (t)) 23373 { 23374 case FFELEX_typeEOS: 23375 case FFELEX_typeSEMICOLON: 23376 ffesta_confirmed (); 23377 if (!ffesta_is_inhibited ()) 23378 ffestc_R1219 (ffesta_tokens[1], ffestb_subrargs_.name_list.args, 23379 ffestb_subrargs_.name_list.close_paren, ffestb_local_.decl.type, 23380 ffestb_local_.decl.kind, ffestb_local_.decl.kindt, 23381 ffestb_local_.decl.len, ffestb_local_.decl.lent, 23382 ffestb_local_.decl.recursive, NULL); 23383 if (ffestb_local_.decl.recursive != NULL) 23384 ffelex_token_kill (ffestb_local_.decl.recursive); 23385 if (ffestb_local_.decl.kindt != NULL) 23386 ffelex_token_kill (ffestb_local_.decl.kindt); 23387 if (ffestb_local_.decl.lent != NULL) 23388 ffelex_token_kill (ffestb_local_.decl.lent); 23389 ffelex_token_kill (ffesta_tokens[1]); 23390 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren); 23391 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args); 23392 return (ffelexHandler) ffesta_zero (t); 23393 23394 case FFELEX_typeNAME: 23395 if (ffestr_other (t) != FFESTR_otherRESULT) 23396 break; 23397 return (ffelexHandler) ffestb_decl_funcname_6_; 23398 23399 default: 23400 break; 23401 } 23402 23403bad: /* :::::::::::::::::::: */ 23404 if (ffestb_local_.decl.recursive != NULL) 23405 ffelex_token_kill (ffestb_local_.decl.recursive); 23406 if (ffestb_local_.decl.kindt != NULL) 23407 ffelex_token_kill (ffestb_local_.decl.kindt); 23408 if (ffestb_local_.decl.lent != NULL) 23409 ffelex_token_kill (ffestb_local_.decl.lent); 23410 ffelex_token_kill (ffesta_tokens[1]); 23411 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren); 23412 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args); 23413 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); 23414 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 23415} 23416 23417/* ffestb_decl_funcname_6_ -- "type" [type parameters] [RECURSIVE] FUNCTION 23418 NAME [type parameter] OPEN_PAREN arglist 23419 CLOSE_PAREN "RESULT" 23420 23421 return ffestb_decl_funcname_6_; // to lexer 23422 23423 Make sure the next token is an OPEN_PAREN. */ 23424 23425static ffelexHandler 23426ffestb_decl_funcname_6_ (ffelexToken t) 23427{ 23428 switch (ffelex_token_type (t)) 23429 { 23430 case FFELEX_typeOPEN_PAREN: 23431 return (ffelexHandler) ffestb_decl_funcname_7_; 23432 23433 default: 23434 break; 23435 } 23436 23437 if (ffestb_local_.decl.recursive != NULL) 23438 ffelex_token_kill (ffestb_local_.decl.recursive); 23439 if (ffestb_local_.decl.kindt != NULL) 23440 ffelex_token_kill (ffestb_local_.decl.kindt); 23441 if (ffestb_local_.decl.lent != NULL) 23442 ffelex_token_kill (ffestb_local_.decl.lent); 23443 ffelex_token_kill (ffesta_tokens[1]); 23444 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren); 23445 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args); 23446 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); 23447 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 23448} 23449 23450/* ffestb_decl_funcname_7_ -- "type" [type parameters] [RECURSIVE] FUNCTION 23451 NAME [type parameter] OPEN_PAREN arglist 23452 CLOSE_PAREN "RESULT" OPEN_PAREN 23453 23454 return ffestb_decl_funcname_7_; // to lexer 23455 23456 Make sure the next token is a NAME. */ 23457 23458static ffelexHandler 23459ffestb_decl_funcname_7_ (ffelexToken t) 23460{ 23461 switch (ffelex_token_type (t)) 23462 { 23463 case FFELEX_typeNAME: 23464 ffesta_tokens[2] = ffelex_token_use (t); 23465 return (ffelexHandler) ffestb_decl_funcname_8_; 23466 23467 default: 23468 break; 23469 } 23470 23471 if (ffestb_local_.decl.recursive != NULL) 23472 ffelex_token_kill (ffestb_local_.decl.recursive); 23473 if (ffestb_local_.decl.kindt != NULL) 23474 ffelex_token_kill (ffestb_local_.decl.kindt); 23475 if (ffestb_local_.decl.lent != NULL) 23476 ffelex_token_kill (ffestb_local_.decl.lent); 23477 ffelex_token_kill (ffesta_tokens[1]); 23478 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren); 23479 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args); 23480 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); 23481 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 23482} 23483 23484/* ffestb_decl_funcname_8_ -- "type" [type parameters] [RECURSIVE] FUNCTION 23485 NAME [type parameter] OPEN_PAREN arglist 23486 CLOSE_PAREN "RESULT" OPEN_PAREN NAME 23487 23488 return ffestb_decl_funcname_8_; // to lexer 23489 23490 Make sure the next token is a CLOSE_PAREN. */ 23491 23492static ffelexHandler 23493ffestb_decl_funcname_8_ (ffelexToken t) 23494{ 23495 switch (ffelex_token_type (t)) 23496 { 23497 case FFELEX_typeCLOSE_PAREN: 23498 return (ffelexHandler) ffestb_decl_funcname_9_; 23499 23500 default: 23501 break; 23502 } 23503 23504 if (ffestb_local_.decl.recursive != NULL) 23505 ffelex_token_kill (ffestb_local_.decl.recursive); 23506 if (ffestb_local_.decl.kindt != NULL) 23507 ffelex_token_kill (ffestb_local_.decl.kindt); 23508 if (ffestb_local_.decl.lent != NULL) 23509 ffelex_token_kill (ffestb_local_.decl.lent); 23510 ffelex_token_kill (ffesta_tokens[1]); 23511 ffelex_token_kill (ffesta_tokens[2]); 23512 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren); 23513 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args); 23514 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); 23515 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 23516} 23517 23518/* ffestb_decl_funcname_9_ -- "type" [type parameters] [RECURSIVE] FUNCTION 23519 NAME [type parameter] OPEN_PAREN arg-list 23520 CLOSE_PAREN "RESULT" OPEN_PAREN NAME CLOSE_PAREN 23521 23522 return ffestb_decl_funcname_9_; // to lexer 23523 23524 Must have EOS/SEMICOLON here. */ 23525 23526static ffelexHandler 23527ffestb_decl_funcname_9_ (ffelexToken t) 23528{ 23529 switch (ffelex_token_type (t)) 23530 { 23531 case FFELEX_typeEOS: 23532 case FFELEX_typeSEMICOLON: 23533 if (!ffesta_is_inhibited ()) 23534 ffestc_R1219 (ffesta_tokens[1], ffestb_subrargs_.name_list.args, 23535 ffestb_subrargs_.name_list.close_paren, ffestb_local_.decl.type, 23536 ffestb_local_.decl.kind, ffestb_local_.decl.kindt, 23537 ffestb_local_.decl.len, ffestb_local_.decl.lent, 23538 ffestb_local_.decl.recursive, ffesta_tokens[2]); 23539 if (ffestb_local_.decl.recursive != NULL) 23540 ffelex_token_kill (ffestb_local_.decl.recursive); 23541 if (ffestb_local_.decl.kindt != NULL) 23542 ffelex_token_kill (ffestb_local_.decl.kindt); 23543 if (ffestb_local_.decl.lent != NULL) 23544 ffelex_token_kill (ffestb_local_.decl.lent); 23545 ffelex_token_kill (ffesta_tokens[1]); 23546 ffelex_token_kill (ffesta_tokens[2]); 23547 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren); 23548 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args); 23549 return (ffelexHandler) ffesta_zero (t); 23550 23551 default: 23552 break; 23553 } 23554 23555 if (ffestb_local_.decl.recursive != NULL) 23556 ffelex_token_kill (ffestb_local_.decl.recursive); 23557 if (ffestb_local_.decl.kindt != NULL) 23558 ffelex_token_kill (ffestb_local_.decl.kindt); 23559 if (ffestb_local_.decl.lent != NULL) 23560 ffelex_token_kill (ffestb_local_.decl.lent); 23561 ffelex_token_kill (ffesta_tokens[1]); 23562 ffelex_token_kill (ffesta_tokens[2]); 23563 ffelex_token_kill (ffestb_subrargs_.name_list.close_paren); 23564 ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args); 23565 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t); 23566 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 23567} 23568 23569/* ffestb_V003 -- Parse the STRUCTURE statement 23570 23571 return ffestb_V003; // to lexer 23572 23573 Make sure the statement has a valid form for the STRUCTURE statement. 23574 If it does, implement the statement. */ 23575 23576#if FFESTR_VXT 23577ffelexHandler 23578ffestb_V003 (ffelexToken t) 23579{ 23580 ffeTokenLength i; 23581 const char *p; 23582 ffelexToken nt; 23583 ffelexHandler next; 23584 23585 switch (ffelex_token_type (ffesta_tokens[0])) 23586 { 23587 case FFELEX_typeNAME: 23588 if (ffesta_first_kw != FFESTR_firstSTRUCTURE) 23589 goto bad_0; /* :::::::::::::::::::: */ 23590 switch (ffelex_token_type (t)) 23591 { 23592 case FFELEX_typeCOMMA: 23593 case FFELEX_typeCOLONCOLON: 23594 case FFELEX_typeEOS: 23595 case FFELEX_typeSEMICOLON: 23596 ffesta_confirmed (); /* Error, but clearly intended. */ 23597 goto bad_1; /* :::::::::::::::::::: */ 23598 23599 default: 23600 goto bad_1; /* :::::::::::::::::::: */ 23601 23602 case FFELEX_typeNAME: 23603 ffesta_confirmed (); 23604 if (!ffesta_is_inhibited ()) 23605 ffestc_V003_start (NULL); 23606 ffestb_local_.structure.started = TRUE; 23607 return (ffelexHandler) ffestb_V0034_ (t); 23608 23609 case FFELEX_typeSLASH: 23610 ffesta_confirmed (); 23611 return (ffelexHandler) ffestb_V0031_; 23612 } 23613 23614 case FFELEX_typeNAMES: 23615 if (ffesta_first_kw != FFESTR_firstSTRUCTURE) 23616 goto bad_0; /* :::::::::::::::::::: */ 23617 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSTRUCTURE); 23618 switch (ffelex_token_type (t)) 23619 { 23620 default: 23621 goto bad_1; /* :::::::::::::::::::: */ 23622 23623 case FFELEX_typeEOS: 23624 case FFELEX_typeSEMICOLON: 23625 case FFELEX_typeCOMMA: 23626 case FFELEX_typeCOLONCOLON: 23627 ffesta_confirmed (); 23628 break; 23629 23630 case FFELEX_typeSLASH: 23631 ffesta_confirmed (); 23632 if (*p != '\0') 23633 goto bad_1; /* :::::::::::::::::::: */ 23634 return (ffelexHandler) ffestb_V0031_; 23635 23636 case FFELEX_typeOPEN_PAREN: 23637 break; 23638 } 23639 23640 /* Here, we have at least one char after "STRUCTURE" and t is COMMA, 23641 EOS/SEMICOLON, or OPEN_PAREN. */ 23642 23643 if (!ffesrc_is_name_init (*p)) 23644 goto bad_i; /* :::::::::::::::::::: */ 23645 nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0); 23646 if (ffelex_token_type (t) == FFELEX_typeOPEN_PAREN) 23647 ffestb_local_.structure.started = FALSE; 23648 else 23649 { 23650 if (!ffesta_is_inhibited ()) 23651 ffestc_V003_start (NULL); 23652 ffestb_local_.structure.started = TRUE; 23653 } 23654 next = (ffelexHandler) ffestb_V0034_ (nt); 23655 ffelex_token_kill (nt); 23656 return (ffelexHandler) (*next) (t); 23657 23658 default: 23659 goto bad_0; /* :::::::::::::::::::: */ 23660 } 23661 23662bad_0: /* :::::::::::::::::::: */ 23663 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", ffesta_tokens[0]); 23664 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 23665 23666bad_1: /* :::::::::::::::::::: */ 23667 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t); 23668 return (ffelexHandler) ffelex_swallow_tokens (t, 23669 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 23670 23671bad_i: /* :::::::::::::::::::: */ 23672 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", ffesta_tokens[0], i, t); 23673 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 23674} 23675 23676/* ffestb_V0031_ -- "STRUCTURE" SLASH 23677 23678 return ffestb_V0031_; // to lexer 23679 23680 Handle NAME. */ 23681 23682static ffelexHandler 23683ffestb_V0031_ (ffelexToken t) 23684{ 23685 switch (ffelex_token_type (t)) 23686 { 23687 case FFELEX_typeNAME: 23688 ffesta_tokens[1] = ffelex_token_use (t); 23689 return (ffelexHandler) ffestb_V0032_; 23690 23691 default: 23692 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t); 23693 break; 23694 } 23695 23696 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 23697} 23698 23699/* ffestb_V0032_ -- "STRUCTURE" SLASH NAME 23700 23701 return ffestb_V0032_; // to lexer 23702 23703 Handle SLASH. */ 23704 23705static ffelexHandler 23706ffestb_V0032_ (ffelexToken t) 23707{ 23708 switch (ffelex_token_type (t)) 23709 { 23710 case FFELEX_typeSLASH: 23711 if (!ffesta_is_inhibited ()) 23712 ffestc_V003_start (ffesta_tokens[1]); 23713 ffestb_local_.structure.started = TRUE; 23714 ffelex_token_kill (ffesta_tokens[1]); 23715 return (ffelexHandler) ffestb_V0033_; 23716 23717 default: 23718 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t); 23719 break; 23720 } 23721 23722 ffelex_token_kill (ffesta_tokens[1]); 23723 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 23724} 23725 23726/* ffestb_V0033_ -- "STRUCTURE" SLASH NAME SLASH 23727 23728 return ffestb_V0033_; // to lexer 23729 23730 Handle NAME or EOS/SEMICOLON. */ 23731 23732static ffelexHandler 23733ffestb_V0033_ (ffelexToken t) 23734{ 23735 switch (ffelex_token_type (t)) 23736 { 23737 case FFELEX_typeNAME: 23738 return (ffelexHandler) ffestb_V0034_ (t); 23739 23740 case FFELEX_typeEOS: 23741 case FFELEX_typeSEMICOLON: 23742 if (!ffesta_is_inhibited ()) 23743 ffestc_V003_finish (); 23744 return (ffelexHandler) ffesta_zero (t); 23745 23746 default: 23747 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t); 23748 break; 23749 } 23750 23751 ffelex_token_kill (ffesta_tokens[1]); 23752 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 23753} 23754 23755/* ffestb_V0034_ -- "STRUCTURE" [SLASH NAME SLASH] 23756 23757 return ffestb_V0034_; // to lexer 23758 23759 Handle NAME. */ 23760 23761static ffelexHandler 23762ffestb_V0034_ (ffelexToken t) 23763{ 23764 switch (ffelex_token_type (t)) 23765 { 23766 case FFELEX_typeNAME: 23767 ffesta_tokens[1] = ffelex_token_use (t); 23768 return (ffelexHandler) ffestb_V0035_; 23769 23770 default: 23771 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t); 23772 break; 23773 } 23774 23775 if (!ffesta_is_inhibited ()) 23776 ffestc_V003_finish (); 23777 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 23778} 23779 23780/* ffestb_V0035_ -- "STRUCTURE" ... NAME 23781 23782 return ffestb_V0035_; // to lexer 23783 23784 Handle OPEN_PAREN. */ 23785 23786static ffelexHandler 23787ffestb_V0035_ (ffelexToken t) 23788{ 23789 switch (ffelex_token_type (t)) 23790 { 23791 case FFELEX_typeOPEN_PAREN: 23792 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create (); 23793 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_V0036_; 23794 ffestb_subrargs_.dim_list.pool = ffesta_output_pool; 23795 ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLISTCOMMON; 23796#ifdef FFECOM_dimensionsMAX 23797 ffestb_subrargs_.dim_list.ndims = 0; 23798#endif 23799 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 23800 FFEEXPR_contextDIMLISTCOMMON, (ffeexprCallback) ffestb_subr_dimlist_); 23801 23802 case FFELEX_typeCOMMA: 23803 if (!ffesta_is_inhibited ()) 23804 ffestc_V003_item (ffesta_tokens[1], NULL); 23805 ffelex_token_kill (ffesta_tokens[1]); 23806 return (ffelexHandler) ffestb_V0034_; 23807 23808 case FFELEX_typeEOS: 23809 case FFELEX_typeSEMICOLON: 23810 if (!ffesta_is_inhibited ()) 23811 { 23812 ffestc_V003_item (ffesta_tokens[1], NULL); 23813 ffestc_V003_finish (); 23814 } 23815 ffelex_token_kill (ffesta_tokens[1]); 23816 return (ffelexHandler) ffesta_zero (t); 23817 23818 default: 23819 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t); 23820 break; 23821 } 23822 23823 if (!ffesta_is_inhibited ()) 23824 ffestc_V003_finish (); 23825 ffelex_token_kill (ffesta_tokens[1]); 23826 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 23827} 23828 23829/* ffestb_V0036_ -- "STRUCTURE" ... NAME OPEN_PAREN dimlist CLOSE_PAREN 23830 23831 return ffestb_V0036_; // to lexer 23832 23833 Handle COMMA or EOS/SEMICOLON. */ 23834 23835static ffelexHandler 23836ffestb_V0036_ (ffelexToken t) 23837{ 23838 if (!ffestb_subrargs_.dim_list.ok) 23839 goto bad; /* :::::::::::::::::::: */ 23840 23841 switch (ffelex_token_type (t)) 23842 { 23843 case FFELEX_typeCOMMA: 23844 ffesta_confirmed (); 23845 if (!ffesta_is_inhibited ()) 23846 { 23847 if (!ffestb_local_.structure.started) 23848 { 23849 ffestc_V003_start (NULL); 23850 ffestb_local_.structure.started = TRUE; 23851 } 23852 ffestc_V003_item (ffesta_tokens[1], 23853 ffestb_subrargs_.dim_list.dims); 23854 } 23855 ffelex_token_kill (ffesta_tokens[1]); 23856 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 23857 return (ffelexHandler) ffestb_V0034_; 23858 23859 case FFELEX_typeEOS: 23860 case FFELEX_typeSEMICOLON: 23861 ffesta_confirmed (); 23862 if (!ffesta_is_inhibited ()) 23863 { 23864 if (!ffestb_local_.structure.started) 23865 ffestc_V003_start (NULL); 23866 ffestc_V003_item (ffesta_tokens[1], 23867 ffestb_subrargs_.dim_list.dims); 23868 ffestc_V003_finish (); 23869 } 23870 ffelex_token_kill (ffesta_tokens[1]); 23871 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 23872 return (ffelexHandler) ffesta_zero (t); 23873 23874 default: 23875 break; 23876 } 23877 23878bad: /* :::::::::::::::::::: */ 23879 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t); 23880 if (ffestb_local_.structure.started && !ffesta_is_inhibited ()) 23881 ffestc_V003_finish (); 23882 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 23883 ffelex_token_kill (ffesta_tokens[1]); 23884 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 23885} 23886 23887/* ffestb_V016 -- Parse the RECORD statement 23888 23889 return ffestb_V016; // to lexer 23890 23891 Make sure the statement has a valid form for the RECORD statement. If it 23892 does, implement the statement. */ 23893 23894ffelexHandler 23895ffestb_V016 (ffelexToken t) 23896{ 23897 const char *p; 23898 ffeTokenLength i; 23899 23900 switch (ffelex_token_type (ffesta_tokens[0])) 23901 { 23902 case FFELEX_typeNAME: 23903 if (ffesta_first_kw != FFESTR_firstRECORD) 23904 goto bad_0; /* :::::::::::::::::::: */ 23905 break; 23906 23907 case FFELEX_typeNAMES: 23908 if (ffesta_first_kw != FFESTR_firstRECORD) 23909 goto bad_0; /* :::::::::::::::::::: */ 23910 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlRECORD); 23911 if (*p != '\0') 23912 goto bad_i; /* :::::::::::::::::::: */ 23913 break; 23914 23915 default: 23916 goto bad_0; /* :::::::::::::::::::: */ 23917 } 23918 23919 switch (ffelex_token_type (t)) 23920 { 23921 case FFELEX_typeCOMMA: 23922 case FFELEX_typeEOS: 23923 case FFELEX_typeSEMICOLON: 23924 case FFELEX_typeCOLONCOLON: 23925 ffesta_confirmed (); /* Error, but clearly intended. */ 23926 goto bad_1; /* :::::::::::::::::::: */ 23927 23928 default: 23929 goto bad_1; /* :::::::::::::::::::: */ 23930 23931 case FFELEX_typeSLASH: 23932 break; 23933 } 23934 23935 ffesta_confirmed (); 23936 if (!ffesta_is_inhibited ()) 23937 ffestc_V016_start (); 23938 return (ffelexHandler) ffestb_V0161_; 23939 23940bad_0: /* :::::::::::::::::::: */ 23941 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", ffesta_tokens[0]); 23942 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 23943 23944bad_1: /* :::::::::::::::::::: */ 23945 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t); 23946 return (ffelexHandler) ffelex_swallow_tokens (t, 23947 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 23948 23949bad_i: /* :::::::::::::::::::: */ 23950 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "RECORD", ffesta_tokens[0], i, t); 23951 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 23952} 23953 23954/* ffestb_V0161_ -- "RECORD" SLASH 23955 23956 return ffestb_V0161_; // to lexer 23957 23958 Handle NAME. */ 23959 23960static ffelexHandler 23961ffestb_V0161_ (ffelexToken t) 23962{ 23963 switch (ffelex_token_type (t)) 23964 { 23965 case FFELEX_typeNAME: 23966 if (!ffesta_is_inhibited ()) 23967 ffestc_V016_item_structure (t); 23968 return (ffelexHandler) ffestb_V0162_; 23969 23970 default: 23971 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t); 23972 break; 23973 } 23974 23975 if (!ffesta_is_inhibited ()) 23976 ffestc_V016_finish (); 23977 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 23978} 23979 23980/* ffestb_V0162_ -- "RECORD" SLASH NAME 23981 23982 return ffestb_V0162_; // to lexer 23983 23984 Handle SLASH. */ 23985 23986static ffelexHandler 23987ffestb_V0162_ (ffelexToken t) 23988{ 23989 switch (ffelex_token_type (t)) 23990 { 23991 case FFELEX_typeSLASH: 23992 return (ffelexHandler) ffestb_V0163_; 23993 23994 default: 23995 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t); 23996 break; 23997 } 23998 23999 if (!ffesta_is_inhibited ()) 24000 ffestc_V016_finish (); 24001 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 24002} 24003 24004/* ffestb_V0163_ -- "RECORD" SLASH NAME SLASH 24005 24006 return ffestb_V0163_; // to lexer 24007 24008 Handle NAME. */ 24009 24010static ffelexHandler 24011ffestb_V0163_ (ffelexToken t) 24012{ 24013 switch (ffelex_token_type (t)) 24014 { 24015 case FFELEX_typeNAME: 24016 ffesta_tokens[1] = ffelex_token_use (t); 24017 return (ffelexHandler) ffestb_V0164_; 24018 24019 default: 24020 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t); 24021 break; 24022 } 24023 24024 if (!ffesta_is_inhibited ()) 24025 ffestc_V016_finish (); 24026 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 24027} 24028 24029/* ffestb_V0164_ -- "RECORD" ... NAME 24030 24031 return ffestb_V0164_; // to lexer 24032 24033 Handle OPEN_PAREN. */ 24034 24035static ffelexHandler 24036ffestb_V0164_ (ffelexToken t) 24037{ 24038 switch (ffelex_token_type (t)) 24039 { 24040 case FFELEX_typeOPEN_PAREN: 24041 ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create (); 24042 ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_V0165_; 24043 ffestb_subrargs_.dim_list.pool = ffesta_output_pool; 24044 ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLISTCOMMON; 24045#ifdef FFECOM_dimensionsMAX 24046 ffestb_subrargs_.dim_list.ndims = 0; 24047#endif 24048 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 24049 FFEEXPR_contextDIMLISTCOMMON, (ffeexprCallback) ffestb_subr_dimlist_); 24050 24051 case FFELEX_typeCOMMA: 24052 if (!ffesta_is_inhibited ()) 24053 ffestc_V016_item_object (ffesta_tokens[1], NULL); 24054 ffelex_token_kill (ffesta_tokens[1]); 24055 return (ffelexHandler) ffestb_V0166_; 24056 24057 case FFELEX_typeEOS: 24058 case FFELEX_typeSEMICOLON: 24059 if (!ffesta_is_inhibited ()) 24060 { 24061 ffestc_V016_item_object (ffesta_tokens[1], NULL); 24062 ffestc_V016_finish (); 24063 } 24064 ffelex_token_kill (ffesta_tokens[1]); 24065 return (ffelexHandler) ffesta_zero (t); 24066 24067 default: 24068 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t); 24069 break; 24070 } 24071 24072 if (!ffesta_is_inhibited ()) 24073 ffestc_V016_finish (); 24074 ffelex_token_kill (ffesta_tokens[1]); 24075 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 24076} 24077 24078/* ffestb_V0165_ -- "RECORD" ... NAME OPEN_PAREN dimlist CLOSE_PAREN 24079 24080 return ffestb_V0165_; // to lexer 24081 24082 Handle COMMA or EOS/SEMICOLON. */ 24083 24084static ffelexHandler 24085ffestb_V0165_ (ffelexToken t) 24086{ 24087 if (!ffestb_subrargs_.dim_list.ok) 24088 goto bad; /* :::::::::::::::::::: */ 24089 24090 switch (ffelex_token_type (t)) 24091 { 24092 case FFELEX_typeCOMMA: 24093 if (!ffesta_is_inhibited ()) 24094 ffestc_V016_item_object (ffesta_tokens[1], 24095 ffestb_subrargs_.dim_list.dims); 24096 ffelex_token_kill (ffesta_tokens[1]); 24097 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 24098 return (ffelexHandler) ffestb_V0166_; 24099 24100 case FFELEX_typeEOS: 24101 case FFELEX_typeSEMICOLON: 24102 if (!ffesta_is_inhibited ()) 24103 { 24104 ffestc_V016_item_object (ffesta_tokens[1], 24105 ffestb_subrargs_.dim_list.dims); 24106 ffestc_V016_finish (); 24107 } 24108 ffelex_token_kill (ffesta_tokens[1]); 24109 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 24110 return (ffelexHandler) ffesta_zero (t); 24111 24112 default: 24113 break; 24114 } 24115 24116bad: /* :::::::::::::::::::: */ 24117 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t); 24118 if (ffestb_local_.structure.started && !ffesta_is_inhibited ()) 24119 ffestc_V016_finish (); 24120 ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims); 24121 ffelex_token_kill (ffesta_tokens[1]); 24122 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 24123} 24124 24125/* ffestb_V0166_ -- "RECORD" SLASH NAME SLASH NAME [OPEN_PAREN dimlist 24126 CLOSE_PAREN] COMMA 24127 24128 return ffestb_V0166_; // to lexer 24129 24130 Handle NAME or SLASH. */ 24131 24132static ffelexHandler 24133ffestb_V0166_ (ffelexToken t) 24134{ 24135 switch (ffelex_token_type (t)) 24136 { 24137 case FFELEX_typeNAME: 24138 ffesta_tokens[1] = ffelex_token_use (t); 24139 return (ffelexHandler) ffestb_V0164_; 24140 24141 case FFELEX_typeSLASH: 24142 return (ffelexHandler) ffestb_V0161_; 24143 24144 default: 24145 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t); 24146 break; 24147 } 24148 24149 if (!ffesta_is_inhibited ()) 24150 ffestc_V016_finish (); 24151 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 24152} 24153 24154#endif 24155/* ffestb_V027 -- Parse the VXT PARAMETER statement 24156 24157 return ffestb_V027; // to lexer 24158 24159 Make sure the statement has a valid form for the VXT PARAMETER statement. 24160 If it does, implement the statement. */ 24161 24162ffelexHandler 24163ffestb_V027 (ffelexToken t) 24164{ 24165 unsigned const char *p; 24166 ffeTokenLength i; 24167 24168 switch (ffelex_token_type (ffesta_tokens[0])) 24169 { 24170 case FFELEX_typeNAME: 24171 if (ffesta_first_kw != FFESTR_firstPARAMETER) 24172 goto bad_0; /* :::::::::::::::::::: */ 24173 switch (ffelex_token_type (t)) 24174 { 24175 case FFELEX_typeNAME: 24176 break; 24177 24178 default: 24179 goto bad_1; /* :::::::::::::::::::: */ 24180 } 24181 ffesta_confirmed (); 24182 ffestb_local_.vxtparam.started = TRUE; 24183 if (!ffesta_is_inhibited ()) 24184 ffestc_V027_start (); 24185 ffesta_tokens[1] = ffelex_token_use (t); 24186 return (ffelexHandler) ffestb_V0271_; 24187 24188 case FFELEX_typeNAMES: 24189 if (ffesta_first_kw != FFESTR_firstPARAMETER) 24190 goto bad_0; /* :::::::::::::::::::: */ 24191 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlPARAMETER); 24192 switch (ffelex_token_type (t)) 24193 { 24194 case FFELEX_typeEQUALS: 24195 break; 24196 24197 default: 24198 goto bad_1; /* :::::::::::::::::::: */ 24199 } 24200 if (!ffesrc_is_name_init (*p)) 24201 goto bad_i; /* :::::::::::::::::::: */ 24202 ffestb_local_.vxtparam.started = FALSE; 24203 ffesta_tokens[1] = ffelex_token_name_from_names (ffesta_tokens[0], i, 24204 0); 24205 return (ffelexHandler) ffestb_V0271_ (t); 24206 24207 default: 24208 goto bad_0; /* :::::::::::::::::::: */ 24209 } 24210 24211bad_0: /* :::::::::::::::::::: */ 24212 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", ffesta_tokens[0]); 24213 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 24214 24215bad_1: /* :::::::::::::::::::: */ 24216 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t); 24217 return (ffelexHandler) ffelex_swallow_tokens (t, 24218 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 24219 24220bad_i: /* :::::::::::::::::::: */ 24221 ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "PARAMETER", ffesta_tokens[0], i, t); 24222 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 24223} 24224 24225/* ffestb_V0271_ -- "PARAMETER" NAME 24226 24227 return ffestb_V0271_; // to lexer 24228 24229 Handle EQUALS. */ 24230 24231static ffelexHandler 24232ffestb_V0271_ (ffelexToken t) 24233{ 24234 switch (ffelex_token_type (t)) 24235 { 24236 case FFELEX_typeEQUALS: 24237 return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, 24238 FFEEXPR_contextPARAMETER, (ffeexprCallback) ffestb_V0272_); 24239 24240 default: 24241 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t); 24242 break; 24243 } 24244 24245 ffelex_token_kill (ffesta_tokens[1]); 24246 if (ffestb_local_.vxtparam.started && !ffesta_is_inhibited ()) 24247 ffestc_V027_finish (); 24248 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 24249} 24250 24251/* ffestb_V0272_ -- "PARAMETER" NAME EQUALS expr 24252 24253 (ffestb_V0272_) // to expression handler 24254 24255 Handle COMMA or EOS/SEMICOLON. */ 24256 24257static ffelexHandler 24258ffestb_V0272_ (ffelexToken ft, ffebld expr, ffelexToken t) 24259{ 24260 switch (ffelex_token_type (t)) 24261 { 24262 case FFELEX_typeEOS: 24263 case FFELEX_typeSEMICOLON: 24264 if (!ffestb_local_.vxtparam.started) 24265 { 24266 if (ffestc_is_let_not_V027 ()) 24267 break; /* Not a valid VXTPARAMETER stmt. */ 24268 ffesta_confirmed (); 24269 if (!ffesta_is_inhibited ()) 24270 ffestc_V027_start (); 24271 ffestb_local_.vxtparam.started = TRUE; 24272 } 24273 if (expr == NULL) 24274 break; 24275 if (!ffesta_is_inhibited ()) 24276 { 24277 ffestc_V027_item (ffesta_tokens[1], expr, ft); 24278 ffestc_V027_finish (); 24279 } 24280 ffelex_token_kill (ffesta_tokens[1]); 24281 return (ffelexHandler) ffesta_zero (t); 24282 24283 case FFELEX_typeCOMMA: 24284 ffesta_confirmed (); 24285 if (!ffestb_local_.vxtparam.started) 24286 { 24287 if (!ffesta_is_inhibited ()) 24288 ffestc_V027_start (); 24289 ffestb_local_.vxtparam.started = TRUE; 24290 } 24291 if (expr == NULL) 24292 break; 24293 if (!ffesta_is_inhibited ()) 24294 ffestc_V027_item (ffesta_tokens[1], expr, ft); 24295 ffelex_token_kill (ffesta_tokens[1]); 24296 return (ffelexHandler) ffestb_V0273_; 24297 24298 default: 24299 break; 24300 } 24301 24302 ffelex_token_kill (ffesta_tokens[1]); 24303 if (ffestb_local_.vxtparam.started && !ffesta_is_inhibited ()) 24304 ffestc_V027_finish (); 24305 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t); 24306 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 24307} 24308 24309/* ffestb_V0273_ -- "PARAMETER" NAME EQUALS expr COMMA 24310 24311 return ffestb_V0273_; // to lexer 24312 24313 Handle NAME. */ 24314 24315static ffelexHandler 24316ffestb_V0273_ (ffelexToken t) 24317{ 24318 switch (ffelex_token_type (t)) 24319 { 24320 case FFELEX_typeNAME: 24321 ffesta_tokens[1] = ffelex_token_use (t); 24322 return (ffelexHandler) ffestb_V0271_; 24323 24324 default: 24325 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t); 24326 break; 24327 } 24328 24329 if (ffestb_local_.vxtparam.started && !ffesta_is_inhibited ()) 24330 ffestc_V027_finish (); 24331 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 24332} 24333 24334/* ffestb_decl_R539 -- Parse the IMPLICIT FUNCTION statement 24335 24336 return ffestb_decl_R539; // to lexer 24337 24338 Make sure the statement has a valid form for the IMPLICIT 24339 statement. If it does, implement the statement. */ 24340 24341ffelexHandler 24342ffestb_decl_R539 (ffelexToken t) 24343{ 24344 ffeTokenLength i; 24345 unsigned const char *p; 24346 ffelexToken nt; 24347 ffestrSecond kw; 24348 24349 ffestb_local_.decl.recursive = NULL; 24350 24351 switch (ffelex_token_type (ffesta_tokens[0])) 24352 { 24353 case FFELEX_typeNAME: 24354 if (ffesta_first_kw != FFESTR_firstIMPLICIT) 24355 goto bad_0; /* :::::::::::::::::::: */ 24356 switch (ffelex_token_type (t)) 24357 { 24358 case FFELEX_typeEOS: 24359 case FFELEX_typeSEMICOLON: 24360 case FFELEX_typeCOMMA: 24361 case FFELEX_typeCOLONCOLON: 24362 ffesta_confirmed (); /* Error, but clearly intended. */ 24363 goto bad_1; /* :::::::::::::::::::: */ 24364 24365 default: 24366 goto bad_1; /* :::::::::::::::::::: */ 24367 24368 case FFELEX_typeNAME: 24369 break; 24370 } 24371 ffesta_confirmed (); 24372 ffestb_local_.decl.imp_started = FALSE; 24373 switch (ffesta_second_kw) 24374 { 24375 case FFESTR_secondINTEGER: 24376 ffestb_local_.decl.type = FFESTP_typeINTEGER; 24377 return (ffelexHandler) ffestb_decl_R5391_; 24378 24379 case FFESTR_secondBYTE: 24380 ffestb_local_.decl.type = FFESTP_typeBYTE; 24381 return (ffelexHandler) ffestb_decl_R5391_; 24382 24383 case FFESTR_secondWORD: 24384 ffestb_local_.decl.type = FFESTP_typeWORD; 24385 return (ffelexHandler) ffestb_decl_R5391_; 24386 24387 case FFESTR_secondREAL: 24388 ffestb_local_.decl.type = FFESTP_typeREAL; 24389 return (ffelexHandler) ffestb_decl_R5391_; 24390 24391 case FFESTR_secondCOMPLEX: 24392 ffestb_local_.decl.type = FFESTP_typeCOMPLEX; 24393 return (ffelexHandler) ffestb_decl_R5391_; 24394 24395 case FFESTR_secondLOGICAL: 24396 ffestb_local_.decl.type = FFESTP_typeLOGICAL; 24397 return (ffelexHandler) ffestb_decl_R5391_; 24398 24399 case FFESTR_secondCHARACTER: 24400 ffestb_local_.decl.type = FFESTP_typeCHARACTER; 24401 return (ffelexHandler) ffestb_decl_R5391_; 24402 24403 case FFESTR_secondDOUBLE: 24404 return (ffelexHandler) ffestb_decl_R5392_; 24405 24406 case FFESTR_secondDOUBLEPRECISION: 24407 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN; 24408 ffestb_local_.decl.kind = NULL; 24409 ffestb_local_.decl.kindt = NULL; 24410 ffestb_local_.decl.len = NULL; 24411 ffestb_local_.decl.lent = NULL; 24412 return (ffelexHandler) ffestb_decl_R539letters_; 24413 24414 case FFESTR_secondDOUBLECOMPLEX: 24415 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX; 24416 ffestb_local_.decl.kind = NULL; 24417 ffestb_local_.decl.kindt = NULL; 24418 ffestb_local_.decl.len = NULL; 24419 ffestb_local_.decl.lent = NULL; 24420 return (ffelexHandler) ffestb_decl_R539letters_; 24421 24422 case FFESTR_secondNONE: 24423 return (ffelexHandler) ffestb_decl_R5394_; 24424 24425#if FFESTR_F90 24426 case FFESTR_secondTYPE: 24427 ffestb_local_.decl.type = FFESTP_typeTYPE; 24428 return (ffelexHandler) ffestb_decl_R5393_; 24429#endif 24430 24431 default: 24432 goto bad_1; /* :::::::::::::::::::: */ 24433 } 24434 24435 case FFELEX_typeNAMES: 24436 if (ffesta_first_kw != FFESTR_firstIMPLICIT) 24437 goto bad_0; /* :::::::::::::::::::: */ 24438 switch (ffelex_token_type (t)) 24439 { 24440 case FFELEX_typeCOMMA: 24441 case FFELEX_typeCOLONCOLON: 24442 case FFELEX_typeASTERISK: 24443 case FFELEX_typeSEMICOLON: 24444 case FFELEX_typeEOS: 24445 ffesta_confirmed (); 24446 break; 24447 24448 case FFELEX_typeOPEN_PAREN: 24449 break; 24450 24451 default: 24452 goto bad_1; /* :::::::::::::::::::: */ 24453 } 24454 p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlIMPLICIT); 24455 if (!ffesrc_is_name_init (*p)) 24456 goto bad_0; /* :::::::::::::::::::: */ 24457 ffestb_local_.decl.imp_started = FALSE; 24458 nt = ffelex_token_name_from_names (ffesta_tokens[0], 24459 FFESTR_firstlIMPLICIT, 0); 24460 kw = ffestr_second (nt); 24461 ffelex_token_kill (nt); 24462 switch (kw) 24463 { 24464 case FFESTR_secondINTEGER: 24465 ffestb_local_.decl.type = FFESTP_typeINTEGER; 24466 return (ffelexHandler) ffestb_decl_R5391_ (t); 24467 24468 case FFESTR_secondBYTE: 24469 ffestb_local_.decl.type = FFESTP_typeBYTE; 24470 return (ffelexHandler) ffestb_decl_R5391_ (t); 24471 24472 case FFESTR_secondWORD: 24473 ffestb_local_.decl.type = FFESTP_typeWORD; 24474 return (ffelexHandler) ffestb_decl_R5391_ (t); 24475 24476 case FFESTR_secondREAL: 24477 ffestb_local_.decl.type = FFESTP_typeREAL; 24478 return (ffelexHandler) ffestb_decl_R5391_ (t); 24479 24480 case FFESTR_secondCOMPLEX: 24481 ffestb_local_.decl.type = FFESTP_typeCOMPLEX; 24482 return (ffelexHandler) ffestb_decl_R5391_ (t); 24483 24484 case FFESTR_secondLOGICAL: 24485 ffestb_local_.decl.type = FFESTP_typeLOGICAL; 24486 return (ffelexHandler) ffestb_decl_R5391_ (t); 24487 24488 case FFESTR_secondCHARACTER: 24489 ffestb_local_.decl.type = FFESTP_typeCHARACTER; 24490 return (ffelexHandler) ffestb_decl_R5391_ (t); 24491 24492 case FFESTR_secondDOUBLEPRECISION: 24493 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN; 24494 ffestb_local_.decl.kind = NULL; 24495 ffestb_local_.decl.kindt = NULL; 24496 ffestb_local_.decl.len = NULL; 24497 ffestb_local_.decl.lent = NULL; 24498 return (ffelexHandler) ffestb_decl_R539letters_ (t); 24499 24500 case FFESTR_secondDOUBLECOMPLEX: 24501 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX; 24502 ffestb_local_.decl.kind = NULL; 24503 ffestb_local_.decl.kindt = NULL; 24504 ffestb_local_.decl.len = NULL; 24505 ffestb_local_.decl.lent = NULL; 24506 return (ffelexHandler) ffestb_decl_R539letters_ (t); 24507 24508 case FFESTR_secondNONE: 24509 return (ffelexHandler) ffestb_decl_R5394_ (t); 24510 24511#if FFESTR_F90 24512 case FFESTR_secondTYPE: 24513 ffestb_local_.decl.type = FFESTP_typeTYPE; 24514 return (ffelexHandler) ffestb_decl_R5393_ (t); 24515#endif 24516 24517 default: 24518 goto bad_1; /* :::::::::::::::::::: */ 24519 } 24520 24521 default: 24522 goto bad_0; /* :::::::::::::::::::: */ 24523 } 24524 24525bad_0: /* :::::::::::::::::::: */ 24526 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", ffesta_tokens[0]); 24527 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 24528 24529bad_1: /* :::::::::::::::::::: */ 24530 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t); 24531 return (ffelexHandler) ffelex_swallow_tokens (t, 24532 (ffelexHandler) ffesta_zero); /* Invalid second token. */ 24533} 24534 24535/* ffestb_decl_R5391_ -- "IMPLICIT" generic-type 24536 24537 return ffestb_decl_R5391_; // to lexer 24538 24539 Handle ASTERISK or OPEN_PAREN. */ 24540 24541static ffelexHandler 24542ffestb_decl_R5391_ (ffelexToken t) 24543{ 24544 switch (ffelex_token_type (t)) 24545 { 24546 case FFELEX_typeASTERISK: 24547 ffesta_confirmed (); 24548 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_R539letters_; 24549 ffestb_local_.decl.badname = "IMPLICIT"; 24550 if (ffestb_local_.decl.type == FFESTP_typeCHARACTER) 24551 return (ffelexHandler) ffestb_decl_starlen_; 24552 return (ffelexHandler) ffestb_decl_starkind_; 24553 24554 case FFELEX_typeOPEN_PAREN: 24555 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_R539letters_; 24556 ffestb_local_.decl.badname = "IMPLICIT"; 24557 ffestb_local_.decl.kind = NULL; 24558 ffestb_local_.decl.kindt = NULL; 24559 ffestb_local_.decl.len = NULL; 24560 ffestb_local_.decl.lent = NULL; 24561 if (ffestb_local_.decl.type == FFESTP_typeCHARACTER) 24562 ffestb_local_.decl.imp_handler 24563 = (ffelexHandler) ffestb_decl_typeparams_; 24564 else 24565 ffestb_local_.decl.imp_handler 24566 = (ffelexHandler) ffestb_decl_kindparam_; 24567 return (ffelexHandler) ffestb_decl_R539maybe_ (t); 24568 24569 default: 24570 break; 24571 } 24572 24573 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ()) 24574 ffestc_R539finish (); 24575 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t); 24576 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 24577} 24578 24579/* ffestb_decl_R5392_ -- "IMPLICIT" "DOUBLE" 24580 24581 return ffestb_decl_R5392_; // to lexer 24582 24583 Handle NAME. */ 24584 24585static ffelexHandler 24586ffestb_decl_R5392_ (ffelexToken t) 24587{ 24588 switch (ffelex_token_type (t)) 24589 { 24590 case FFELEX_typeNAME: 24591 switch (ffestr_second (t)) 24592 { 24593 case FFESTR_secondPRECISION: 24594 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN; 24595 break; 24596 24597 case FFESTR_secondCOMPLEX: 24598 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX; 24599 break; 24600 24601 default: 24602 goto bad; /* :::::::::::::::::::: */ 24603 } 24604 ffestb_local_.decl.kind = NULL; 24605 ffestb_local_.decl.kindt = NULL; 24606 ffestb_local_.decl.len = NULL; 24607 ffestb_local_.decl.lent = NULL; 24608 return (ffelexHandler) ffestb_decl_R539letters_; 24609 24610 default: 24611 break; 24612 } 24613 24614bad: /* :::::::::::::::::::: */ 24615 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ()) 24616 ffestc_R539finish (); 24617 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t); 24618 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 24619} 24620 24621/* ffestb_decl_R5393_ -- "IMPLICIT" "TYPE" 24622 24623 return ffestb_decl_R5393_; // to lexer 24624 24625 Handle OPEN_PAREN. */ 24626 24627#if FFESTR_F90 24628static ffelexHandler 24629ffestb_decl_R5393_ (ffelexToken t) 24630{ 24631 switch (ffelex_token_type (t)) 24632 { 24633 case FFELEX_typeOPEN_PAREN: 24634 ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_R539letters_; 24635 ffestb_local_.decl.badname = "IMPLICIT"; 24636 return (ffelexHandler) ffestb_decl_typetype1_; 24637 24638 default: 24639 break; 24640 } 24641 24642 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ()) 24643 ffestc_R539finish (); 24644 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t); 24645 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 24646} 24647 24648#endif 24649/* ffestb_decl_R5394_ -- "IMPLICIT" "NONE" 24650 24651 return ffestb_decl_R5394_; // to lexer 24652 24653 Handle EOS/SEMICOLON. */ 24654 24655static ffelexHandler 24656ffestb_decl_R5394_ (ffelexToken t) 24657{ 24658 switch (ffelex_token_type (t)) 24659 { 24660 case FFELEX_typeEOS: 24661 case FFELEX_typeSEMICOLON: 24662 ffesta_confirmed (); 24663 if (!ffesta_is_inhibited ()) 24664 ffestc_R539 (); /* IMPLICIT NONE. */ 24665 return (ffelexHandler) ffesta_zero (t); 24666 24667 default: 24668 break; 24669 } 24670 24671 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t); 24672 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 24673} 24674 24675/* ffestb_decl_R5395_ -- "IMPLICIT" implicit-spec-list COMMA 24676 24677 return ffestb_decl_R5395_; // to lexer 24678 24679 Handle NAME for next type-spec. */ 24680 24681static ffelexHandler 24682ffestb_decl_R5395_ (ffelexToken t) 24683{ 24684 switch (ffelex_token_type (t)) 24685 { 24686 case FFELEX_typeNAME: 24687 switch (ffestr_second (t)) 24688 { 24689 case FFESTR_secondINTEGER: 24690 ffestb_local_.decl.type = FFESTP_typeINTEGER; 24691 return (ffelexHandler) ffestb_decl_R5391_; 24692 24693 case FFESTR_secondBYTE: 24694 ffestb_local_.decl.type = FFESTP_typeBYTE; 24695 return (ffelexHandler) ffestb_decl_R5391_; 24696 24697 case FFESTR_secondWORD: 24698 ffestb_local_.decl.type = FFESTP_typeWORD; 24699 return (ffelexHandler) ffestb_decl_R5391_; 24700 24701 case FFESTR_secondREAL: 24702 ffestb_local_.decl.type = FFESTP_typeREAL; 24703 return (ffelexHandler) ffestb_decl_R5391_; 24704 24705 case FFESTR_secondCOMPLEX: 24706 ffestb_local_.decl.type = FFESTP_typeCOMPLEX; 24707 return (ffelexHandler) ffestb_decl_R5391_; 24708 24709 case FFESTR_secondLOGICAL: 24710 ffestb_local_.decl.type = FFESTP_typeLOGICAL; 24711 return (ffelexHandler) ffestb_decl_R5391_; 24712 24713 case FFESTR_secondCHARACTER: 24714 ffestb_local_.decl.type = FFESTP_typeCHARACTER; 24715 return (ffelexHandler) ffestb_decl_R5391_; 24716 24717 case FFESTR_secondDOUBLE: 24718 return (ffelexHandler) ffestb_decl_R5392_; 24719 24720 case FFESTR_secondDOUBLEPRECISION: 24721 ffestb_local_.decl.type = FFESTP_typeDBLPRCSN; 24722 ffestb_local_.decl.kind = NULL; 24723 ffestb_local_.decl.kindt = NULL; 24724 ffestb_local_.decl.len = NULL; 24725 ffestb_local_.decl.lent = NULL; 24726 return (ffelexHandler) ffestb_decl_R539letters_; 24727 24728 case FFESTR_secondDOUBLECOMPLEX: 24729 ffestb_local_.decl.type = FFESTP_typeDBLCMPLX; 24730 ffestb_local_.decl.kind = NULL; 24731 ffestb_local_.decl.kindt = NULL; 24732 ffestb_local_.decl.len = NULL; 24733 ffestb_local_.decl.lent = NULL; 24734 return (ffelexHandler) ffestb_decl_R539letters_; 24735 24736#if FFESTR_F90 24737 case FFESTR_secondTYPE: 24738 ffestb_local_.decl.type = FFESTP_typeTYPE; 24739 return (ffelexHandler) ffestb_decl_R5393_; 24740#endif 24741 24742 default: 24743 break; 24744 } 24745 break; 24746 24747 default: 24748 break; 24749 } 24750 24751 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ()) 24752 ffestc_R539finish (); 24753 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t); 24754 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 24755} 24756 24757/* ffestb_decl_R539letters_ -- "IMPLICIT" type-spec 24758 24759 return ffestb_decl_R539letters_; // to lexer 24760 24761 Handle OPEN_PAREN. */ 24762 24763static ffelexHandler 24764ffestb_decl_R539letters_ (ffelexToken t) 24765{ 24766 ffelex_set_names (FALSE); 24767 24768 switch (ffelex_token_type (t)) 24769 { 24770 case FFELEX_typeOPEN_PAREN: 24771 ffestb_local_.decl.imps = ffestt_implist_create (); 24772 return (ffelexHandler) ffestb_decl_R539letters_1_; 24773 24774 default: 24775 break; 24776 } 24777 24778 if (ffestb_local_.decl.kindt != NULL) 24779 ffelex_token_kill (ffestb_local_.decl.kindt); 24780 if (ffestb_local_.decl.lent != NULL) 24781 ffelex_token_kill (ffestb_local_.decl.lent); 24782 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ()) 24783 ffestc_R539finish (); 24784 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t); 24785 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 24786} 24787 24788/* ffestb_decl_R539letters_1_ -- "IMPLICIT" type-spec OPEN_PAREN 24789 24790 return ffestb_decl_R539letters_1_; // to lexer 24791 24792 Handle NAME. */ 24793 24794static ffelexHandler 24795ffestb_decl_R539letters_1_ (ffelexToken t) 24796{ 24797 switch (ffelex_token_type (t)) 24798 { 24799 case FFELEX_typeNAME: 24800 if (ffelex_token_length (t) != 1) 24801 break; 24802 ffesta_tokens[1] = ffelex_token_use (t); 24803 return (ffelexHandler) ffestb_decl_R539letters_2_; 24804 24805 default: 24806 break; 24807 } 24808 24809 ffestt_implist_kill (ffestb_local_.decl.imps); 24810 if (ffestb_local_.decl.kindt != NULL) 24811 ffelex_token_kill (ffestb_local_.decl.kindt); 24812 if (ffestb_local_.decl.lent != NULL) 24813 ffelex_token_kill (ffestb_local_.decl.lent); 24814 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ()) 24815 ffestc_R539finish (); 24816 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t); 24817 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 24818} 24819 24820/* ffestb_decl_R539letters_2_ -- "IMPLICIT" type-spec OPEN_PAREN NAME 24821 24822 return ffestb_decl_R539letters_2_; // to lexer 24823 24824 Handle COMMA or MINUS. */ 24825 24826static ffelexHandler 24827ffestb_decl_R539letters_2_ (ffelexToken t) 24828{ 24829 switch (ffelex_token_type (t)) 24830 { 24831 case FFELEX_typeCOMMA: 24832 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL); 24833 return (ffelexHandler) ffestb_decl_R539letters_1_; 24834 24835 case FFELEX_typeCLOSE_PAREN: 24836 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL); 24837 return (ffelexHandler) ffestb_decl_R539letters_5_; 24838 24839 case FFELEX_typeMINUS: 24840 return (ffelexHandler) ffestb_decl_R539letters_3_; 24841 24842 default: 24843 break; 24844 } 24845 24846 ffelex_token_kill (ffesta_tokens[1]); 24847 ffestt_implist_kill (ffestb_local_.decl.imps); 24848 if (ffestb_local_.decl.kindt != NULL) 24849 ffelex_token_kill (ffestb_local_.decl.kindt); 24850 if (ffestb_local_.decl.lent != NULL) 24851 ffelex_token_kill (ffestb_local_.decl.lent); 24852 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ()) 24853 ffestc_R539finish (); 24854 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t); 24855 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 24856} 24857 24858/* ffestb_decl_R539letters_3_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS 24859 24860 return ffestb_decl_R539letters_3_; // to lexer 24861 24862 Handle NAME. */ 24863 24864static ffelexHandler 24865ffestb_decl_R539letters_3_ (ffelexToken t) 24866{ 24867 switch (ffelex_token_type (t)) 24868 { 24869 case FFELEX_typeNAME: 24870 if (ffelex_token_length (t) != 1) 24871 break; 24872 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], 24873 ffelex_token_use (t)); 24874 return (ffelexHandler) ffestb_decl_R539letters_4_; 24875 24876 default: 24877 break; 24878 } 24879 24880 ffelex_token_kill (ffesta_tokens[1]); 24881 ffestt_implist_kill (ffestb_local_.decl.imps); 24882 if (ffestb_local_.decl.kindt != NULL) 24883 ffelex_token_kill (ffestb_local_.decl.kindt); 24884 if (ffestb_local_.decl.lent != NULL) 24885 ffelex_token_kill (ffestb_local_.decl.lent); 24886 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ()) 24887 ffestc_R539finish (); 24888 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t); 24889 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 24890} 24891 24892/* ffestb_decl_R539letters_4_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS 24893 NAME 24894 24895 return ffestb_decl_R539letters_4_; // to lexer 24896 24897 Handle COMMA or CLOSE_PAREN. */ 24898 24899static ffelexHandler 24900ffestb_decl_R539letters_4_ (ffelexToken t) 24901{ 24902 switch (ffelex_token_type (t)) 24903 { 24904 case FFELEX_typeCOMMA: 24905 return (ffelexHandler) ffestb_decl_R539letters_1_; 24906 24907 case FFELEX_typeCLOSE_PAREN: 24908 return (ffelexHandler) ffestb_decl_R539letters_5_; 24909 24910 default: 24911 break; 24912 } 24913 24914 ffestt_implist_kill (ffestb_local_.decl.imps); 24915 if (ffestb_local_.decl.kindt != NULL) 24916 ffelex_token_kill (ffestb_local_.decl.kindt); 24917 if (ffestb_local_.decl.lent != NULL) 24918 ffelex_token_kill (ffestb_local_.decl.lent); 24919 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ()) 24920 ffestc_R539finish (); 24921 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t); 24922 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 24923} 24924 24925/* ffestb_decl_R539letters_5_ -- "IMPLICIT" type-spec OPEN_PAREN 24926 letter-spec-list CLOSE_PAREN 24927 24928 return ffestb_decl_R539letters_5_; // to lexer 24929 24930 Handle COMMA or EOS/SEMICOLON. */ 24931 24932static ffelexHandler 24933ffestb_decl_R539letters_5_ (ffelexToken t) 24934{ 24935 switch (ffelex_token_type (t)) 24936 { 24937 case FFELEX_typeCOMMA: 24938 case FFELEX_typeEOS: 24939 case FFELEX_typeSEMICOLON: 24940 if (!ffestb_local_.decl.imp_started) 24941 { 24942 ffestb_local_.decl.imp_started = TRUE; 24943 ffesta_confirmed (); 24944 if (!ffesta_is_inhibited ()) 24945 ffestc_R539start (); 24946 } 24947 if (!ffesta_is_inhibited ()) 24948 ffestc_R539item (ffestb_local_.decl.type, ffestb_local_.decl.kind, 24949 ffestb_local_.decl.kindt, ffestb_local_.decl.len, 24950 ffestb_local_.decl.lent, ffestb_local_.decl.imps); 24951 if (ffestb_local_.decl.kindt != NULL) 24952 ffelex_token_kill (ffestb_local_.decl.kindt); 24953 if (ffestb_local_.decl.lent != NULL) 24954 ffelex_token_kill (ffestb_local_.decl.lent); 24955 ffestt_implist_kill (ffestb_local_.decl.imps); 24956 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 24957 return (ffelexHandler) ffestb_decl_R5395_; 24958 if (!ffesta_is_inhibited ()) 24959 ffestc_R539finish (); 24960 return (ffelexHandler) ffesta_zero (t); 24961 24962 default: 24963 break; 24964 } 24965 24966 ffestt_implist_kill (ffestb_local_.decl.imps); 24967 if (ffestb_local_.decl.kindt != NULL) 24968 ffelex_token_kill (ffestb_local_.decl.kindt); 24969 if (ffestb_local_.decl.lent != NULL) 24970 ffelex_token_kill (ffestb_local_.decl.lent); 24971 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ()) 24972 ffestc_R539finish (); 24973 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t); 24974 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 24975} 24976 24977/* ffestb_decl_R539maybe_ -- "IMPLICIT" generic-type-spec 24978 24979 return ffestb_decl_R539maybe_; // to lexer 24980 24981 Handle OPEN_PAREN. */ 24982 24983static ffelexHandler 24984ffestb_decl_R539maybe_ (ffelexToken t) 24985{ 24986 assert (ffelex_token_type (t) == FFELEX_typeOPEN_PAREN); 24987 ffestb_local_.decl.imps = ffestt_implist_create (); 24988 ffestb_local_.decl.toklist = ffestt_tokenlist_create (); 24989 ffestb_local_.decl.imp_seen_comma 24990 = (ffestb_local_.decl.type != FFESTP_typeCHARACTER); 24991 return (ffelexHandler) ffestb_decl_R539maybe_1_; 24992} 24993 24994/* ffestb_decl_R539maybe_1_ -- "IMPLICIT" generic-type-spec OPEN_PAREN 24995 24996 return ffestb_decl_R539maybe_1_; // to lexer 24997 24998 Handle NAME. */ 24999 25000static ffelexHandler 25001ffestb_decl_R539maybe_1_ (ffelexToken t) 25002{ 25003 ffelexHandler next; 25004 25005 switch (ffelex_token_type (t)) 25006 { 25007 case FFELEX_typeNAME: 25008 if (ffelex_token_length (t) != 1) 25009 break; 25010 ffesta_tokens[1] = ffelex_token_use (t); 25011 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t)); 25012 return (ffelexHandler) ffestb_decl_R539maybe_2_; 25013 25014 default: 25015 break; 25016 } 25017 25018 ffestt_implist_kill (ffestb_local_.decl.imps); 25019 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist, 25020 (ffelexHandler) ffestb_local_.decl.imp_handler); 25021 ffestt_tokenlist_kill (ffestb_local_.decl.toklist); 25022 return (ffelexHandler) (*next) (t); 25023} 25024 25025/* ffestb_decl_R539maybe_2_ -- "IMPLICIT" generic-type-spec OPEN_PAREN NAME 25026 25027 return ffestb_decl_R539maybe_2_; // to lexer 25028 25029 Handle COMMA or MINUS. */ 25030 25031static ffelexHandler 25032ffestb_decl_R539maybe_2_ (ffelexToken t) 25033{ 25034 ffelexHandler next; 25035 25036 switch (ffelex_token_type (t)) 25037 { 25038 case FFELEX_typeCOMMA: 25039 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL); 25040 if (ffestb_local_.decl.imp_seen_comma) 25041 { 25042 ffestt_tokenlist_kill (ffestb_local_.decl.toklist); 25043 return (ffelexHandler) ffestb_decl_R539letters_1_; 25044 } 25045 ffestb_local_.decl.imp_seen_comma = TRUE; 25046 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t)); 25047 return (ffelexHandler) ffestb_decl_R539maybe_1_; 25048 25049 case FFELEX_typeCLOSE_PAREN: 25050 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL); 25051 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t)); 25052 return (ffelexHandler) ffestb_decl_R539maybe_5_; 25053 25054 case FFELEX_typeMINUS: 25055 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t)); 25056 return (ffelexHandler) ffestb_decl_R539maybe_3_; 25057 25058 default: 25059 break; 25060 } 25061 25062 ffelex_token_kill (ffesta_tokens[1]); 25063 ffestt_implist_kill (ffestb_local_.decl.imps); 25064 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist, 25065 (ffelexHandler) ffestb_local_.decl.imp_handler); 25066 ffestt_tokenlist_kill (ffestb_local_.decl.toklist); 25067 return (ffelexHandler) (*next) (t); 25068} 25069 25070/* ffestb_decl_R539maybe_3_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS 25071 25072 return ffestb_decl_R539maybe_3_; // to lexer 25073 25074 Handle NAME. */ 25075 25076static ffelexHandler 25077ffestb_decl_R539maybe_3_ (ffelexToken t) 25078{ 25079 ffelexHandler next; 25080 25081 switch (ffelex_token_type (t)) 25082 { 25083 case FFELEX_typeNAME: 25084 if (ffelex_token_length (t) != 1) 25085 break; 25086 ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], 25087 ffelex_token_use (t)); 25088 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t)); 25089 return (ffelexHandler) ffestb_decl_R539maybe_4_; 25090 25091 default: 25092 break; 25093 } 25094 25095 ffelex_token_kill (ffesta_tokens[1]); 25096 ffestt_implist_kill (ffestb_local_.decl.imps); 25097 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist, 25098 (ffelexHandler) ffestb_local_.decl.imp_handler); 25099 ffestt_tokenlist_kill (ffestb_local_.decl.toklist); 25100 return (ffelexHandler) (*next) (t); 25101} 25102 25103/* ffestb_decl_R539maybe_4_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS 25104 NAME 25105 25106 return ffestb_decl_R539maybe_4_; // to lexer 25107 25108 Handle COMMA or CLOSE_PAREN. */ 25109 25110static ffelexHandler 25111ffestb_decl_R539maybe_4_ (ffelexToken t) 25112{ 25113 ffelexHandler next; 25114 25115 switch (ffelex_token_type (t)) 25116 { 25117 case FFELEX_typeCOMMA: 25118 if (ffestb_local_.decl.imp_seen_comma) 25119 { 25120 ffestt_tokenlist_kill (ffestb_local_.decl.toklist); 25121 return (ffelexHandler) ffestb_decl_R539letters_1_; 25122 } 25123 ffestb_local_.decl.imp_seen_comma = TRUE; 25124 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t)); 25125 return (ffelexHandler) ffestb_decl_R539maybe_1_; 25126 25127 case FFELEX_typeCLOSE_PAREN: 25128 ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t)); 25129 return (ffelexHandler) ffestb_decl_R539maybe_5_; 25130 25131 default: 25132 break; 25133 } 25134 25135 ffestt_implist_kill (ffestb_local_.decl.imps); 25136 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist, 25137 (ffelexHandler) ffestb_local_.decl.imp_handler); 25138 ffestt_tokenlist_kill (ffestb_local_.decl.toklist); 25139 return (ffelexHandler) (*next) (t); 25140} 25141 25142/* ffestb_decl_R539maybe_5_ -- "IMPLICIT" type-spec OPEN_PAREN 25143 letter-spec-list CLOSE_PAREN 25144 25145 return ffestb_decl_R539maybe_5_; // to lexer 25146 25147 Handle COMMA or EOS/SEMICOLON. */ 25148 25149static ffelexHandler 25150ffestb_decl_R539maybe_5_ (ffelexToken t) 25151{ 25152 ffelexHandler next; 25153 25154 switch (ffelex_token_type (t)) 25155 { 25156 case FFELEX_typeCOMMA: 25157 case FFELEX_typeEOS: 25158 case FFELEX_typeSEMICOLON: 25159 ffestt_tokenlist_kill (ffestb_local_.decl.toklist); 25160 if (!ffestb_local_.decl.imp_started) 25161 { 25162 ffestb_local_.decl.imp_started = TRUE; 25163 ffesta_confirmed (); 25164 if (!ffesta_is_inhibited ()) 25165 ffestc_R539start (); 25166 } 25167 if (!ffesta_is_inhibited ()) 25168 ffestc_R539item (ffestb_local_.decl.type, ffestb_local_.decl.kind, 25169 ffestb_local_.decl.kindt, ffestb_local_.decl.len, 25170 ffestb_local_.decl.lent, ffestb_local_.decl.imps); 25171 if (ffestb_local_.decl.kindt != NULL) 25172 ffelex_token_kill (ffestb_local_.decl.kindt); 25173 if (ffestb_local_.decl.lent != NULL) 25174 ffelex_token_kill (ffestb_local_.decl.lent); 25175 ffestt_implist_kill (ffestb_local_.decl.imps); 25176 if (ffelex_token_type (t) == FFELEX_typeCOMMA) 25177 return (ffelexHandler) ffestb_decl_R5395_; 25178 if (!ffesta_is_inhibited ()) 25179 ffestc_R539finish (); 25180 return (ffelexHandler) ffesta_zero (t); 25181 25182 case FFELEX_typeOPEN_PAREN: 25183 ffesta_confirmed (); 25184 ffestt_implist_kill (ffestb_local_.decl.imps); 25185 next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist, 25186 (ffelexHandler) ffestb_local_.decl.imp_handler); 25187 ffestt_tokenlist_kill (ffestb_local_.decl.toklist); 25188 return (ffelexHandler) (*next) (t); 25189 25190 default: 25191 break; 25192 } 25193 25194 ffestt_implist_kill (ffestb_local_.decl.imps); 25195 ffestt_tokenlist_kill (ffestb_local_.decl.toklist); 25196 if (ffestb_local_.decl.kindt != NULL) 25197 ffelex_token_kill (ffestb_local_.decl.kindt); 25198 if (ffestb_local_.decl.lent != NULL) 25199 ffelex_token_kill (ffestb_local_.decl.lent); 25200 if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ()) 25201 ffestc_R539finish (); 25202 ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t); 25203 return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero); 25204} 25205