gcc/f/std.c

   1 /* std.c -- Implementation File (module.c template V1.0)
   2    Copyright (C) 1995, 1996, 2000, 2002 Free Software Foundation, Inc.
   3    Contributed by James Craig Burley.
   4
   5 This file is part of GNU Fortran.
   6
   7 GNU Fortran is free software; you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation; either version 2, or (at your option)
  10 any later version.
  11
  12 GNU Fortran is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with GNU Fortran; see the file COPYING.  If not, write to
  19 the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
  20 02111-1307, USA.
  21
  22    Related Modules:
  23       st.c
  24
  25    Description:
  26       Implements the various statements and such like.
  27
  28    Modifications:
  29       21-Nov-91  JCB  2.0
  30          Split out actual code generation to ffeste.
  31 */
  32
  33 /* Include files. */
  34
  35 #include "proj.h"
  36 #include "std.h"
  37 #include "bld.h"
  38 #include "com.h"
  39 #include "lab.h"
  40 #include "lex.h"
  41 #include "malloc.h"
  42 #include "sta.h"
  43 #include "ste.h"
  44 #include "stp.h"
  45 #include "str.h"
  46 #include "sts.h"
  47 #include "stt.h"
  48 #include "stv.h"
  49 #include "stw.h"
  50 #include "symbol.h"
  51 #include "target.h"
  52
  53 /* Externals defined here. */
  54
  55
  56 /* Simple definitions and enumerations. */
  57
  58 #define FFESTD_COPY_EASY_ 1     /* 1 for only one _subr_copy_xyz_ fn. */
  59
  60 #define FFESTD_IS_END_OPTIMIZED_ 1      /* 0=always gen STOP/RETURN before
  61                                            END. */
  62
  63 typedef enum
  64   {
  65     FFESTD_stateletSIMPLE_,     /* Expecting simple/start. */
  66     FFESTD_stateletATTRIB_,     /* Expecting attrib/item/itemstart. */
  67     FFESTD_stateletITEM_,       /* Expecting item/itemstart/finish. */
  68     FFESTD_stateletITEMVALS_,   /* Expecting itemvalue/itemendvals. */
  69     FFESTD_
  70   } ffestdStatelet_;
  71
  72 typedef enum
  73   {
  74     FFESTD_stmtidENDDOLOOP_,
  75     FFESTD_stmtidENDLOGIF_,
  76     FFESTD_stmtidEXECLABEL_,
  77     FFESTD_stmtidFORMATLABEL_,
  78     FFESTD_stmtidR737A_,        /* let */
  79     FFESTD_stmtidR803_,         /* IF-block */
  80     FFESTD_stmtidR804_,         /* ELSE IF */
  81     FFESTD_stmtidR805_,         /* ELSE */
  82     FFESTD_stmtidR806_,         /* END IF */
  83     FFESTD_stmtidR807_,         /* IF-logical */
  84     FFESTD_stmtidR809_,         /* SELECT CASE */
  85     FFESTD_stmtidR810_,         /* CASE */
  86     FFESTD_stmtidR811_,         /* END SELECT */
  87     FFESTD_stmtidR819A_,        /* DO-iterative */
  88     FFESTD_stmtidR819B_,        /* DO WHILE */
  89     FFESTD_stmtidR825_,         /* END DO */
  90     FFESTD_stmtidR834_,         /* CYCLE */
  91     FFESTD_stmtidR835_,         /* EXIT */
  92     FFESTD_stmtidR836_,         /* GOTO */
  93     FFESTD_stmtidR837_,         /* GOTO-computed */
  94     FFESTD_stmtidR838_,         /* ASSIGN */
  95     FFESTD_stmtidR839_,         /* GOTO-assigned */
  96     FFESTD_stmtidR840_,         /* IF-arithmetic */
  97     FFESTD_stmtidR841_,         /* CONTINUE */
  98     FFESTD_stmtidR842_,         /* STOP */
  99     FFESTD_stmtidR843_,         /* PAUSE */
 100     FFESTD_stmtidR904_,         /* OPEN */
 101     FFESTD_stmtidR907_,         /* CLOSE */
 102     FFESTD_stmtidR909_,         /* READ */
 103     FFESTD_stmtidR910_,         /* WRITE */
 104     FFESTD_stmtidR911_,         /* PRINT */
 105     FFESTD_stmtidR919_,         /* BACKSPACE */
 106     FFESTD_stmtidR920_,         /* ENDFILE */
 107     FFESTD_stmtidR921_,         /* REWIND */
 108     FFESTD_stmtidR923A_,        /* INQUIRE */
 109     FFESTD_stmtidR923B_,        /* INQUIRE-iolength */
 110     FFESTD_stmtidR1001_,        /* FORMAT */
 111     FFESTD_stmtidR1103_,        /* END_PROGRAM */
 112     FFESTD_stmtidR1112_,        /* END_BLOCK_DATA */
 113     FFESTD_stmtidR1212_,        /* CALL */
 114     FFESTD_stmtidR1221_,        /* END_FUNCTION */
 115     FFESTD_stmtidR1225_,        /* END_SUBROUTINE */
 116     FFESTD_stmtidR1226_,        /* ENTRY */
 117     FFESTD_stmtidR1227_,        /* RETURN */
 118 #if FFESTR_VXT
 119     FFESTD_stmtidV018_,         /* REWRITE */
 120     FFESTD_stmtidV019_,         /* ACCEPT */
 121 #endif
 122     FFESTD_stmtidV020_,         /* TYPE */
 123 #if FFESTR_VXT
 124     FFESTD_stmtidV021_,         /* DELETE */
 125     FFESTD_stmtidV022_,         /* UNLOCK */
 126     FFESTD_stmtidV023_,         /* ENCODE */
 127     FFESTD_stmtidV024_,         /* DECODE */
 128     FFESTD_stmtidV025start_,    /* DEFINEFILE (start) */
 129     FFESTD_stmtidV025item_,     /* (DEFINEFILE item) */
 130     FFESTD_stmtidV025finish_,   /* (DEFINEFILE finish) */
 131     FFESTD_stmtidV026_,         /* FIND */
 132 #endif
 133     FFESTD_stmtid_,
 134   } ffestdStmtId_;
 135
 136 /* Internal typedefs. */
 137
 138 typedef struct _ffestd_expr_item_ *ffestdExprItem_;
 139 typedef struct _ffestd_stmt_ *ffestdStmt_;
 140
 141 /* Private include files. */
 142
 143
 144 /* Internal structure definitions. */
 145
 146 struct _ffestd_expr_item_
 147   {
 148     ffestdExprItem_ next;
 149     ffebld expr;
 150     ffelexToken token;
 151   };
 152
 153 struct _ffestd_stmt_
 154   {
 155     ffestdStmt_ next;
 156     ffestdStmt_ previous;
 157     ffestdStmtId_ id;
 158     char *filename;
 159     int filelinenum;
 160     union
 161       {
 162         struct
 163           {
 164             ffestw block;
 165           }
 166         enddoloop;
 167         struct
 168           {
 169             ffelab label;
 170           }
 171         execlabel;
 172         struct
 173           {
 174             ffelab label;
 175           }
 176         formatlabel;
 177         struct
 178           {
 179             mallocPool pool;
 180             ffebld dest;
 181             ffebld source;
 182           }
 183         R737A;
 184         struct
 185           {
 186             mallocPool pool;
 187             ffestw block;
 188             ffebld expr;
 189           }
 190         R803;
 191         struct
 192           {
 193             mallocPool pool;
 194             ffestw block;
 195             ffebld expr;
 196           }
 197         R804;
 198         struct
 199           {
 200             ffestw block;
 201           }
 202         R805;
 203         struct
 204           {
 205             ffestw block;
 206           }
 207         R806;
 208         struct
 209           {
 210             mallocPool pool;
 211             ffebld expr;
 212           }
 213         R807;
 214         struct
 215           {
 216             mallocPool pool;
 217             ffestw block;
 218             ffebld expr;
 219           }
 220         R809;
 221         struct
 222           {
 223             mallocPool pool;
 224             ffestw block;
 225             unsigned long casenum;
 226           }
 227         R810;
 228         struct
 229           {
 230             ffestw block;
 231           }
 232         R811;
 233         struct
 234           {
 235             mallocPool pool;
 236             ffestw block;
 237             ffelab label;
 238             ffebld var;
 239             ffebld start;
 240             ffelexToken start_token;
 241             ffebld end;
 242             ffelexToken end_token;
 243             ffebld incr;
 244             ffelexToken incr_token;
 245           }
 246         R819A;
 247         struct
 248           {
 249             mallocPool pool;
 250             ffestw block;
 251             ffelab label;
 252             ffebld expr;
 253           }
 254         R819B;
 255         struct
 256           {
 257             ffestw block;
 258           }
 259         R834;
 260         struct
 261           {
 262             ffestw block;
 263           }
 264         R835;
 265         struct
 266           {
 267             ffelab label;
 268           }
 269         R836;
 270         struct
 271           {
 272             mallocPool pool;
 273             ffelab *labels;
 274             int count;
 275             ffebld expr;
 276           }
 277         R837;
 278         struct
 279           {
 280             mallocPool pool;
 281             ffelab label;
 282             ffebld target;
 283           }
 284         R838;
 285         struct
 286           {
 287             mallocPool pool;
 288             ffebld target;
 289           }
 290         R839;
 291         struct
 292           {
 293             mallocPool pool;
 294             ffebld expr;
 295             ffelab neg;
 296             ffelab zero;
 297             ffelab pos;
 298           }
 299         R840;
 300         struct
 301           {
 302             mallocPool pool;
 303             ffebld expr;
 304           }
 305         R842;
 306         struct
 307           {
 308             mallocPool pool;
 309             ffebld expr;
 310           }
 311         R843;
 312         struct
 313           {
 314             mallocPool pool;
 315             ffestpOpenStmt *params;
 316           }
 317         R904;
 318         struct
 319           {
 320             mallocPool pool;
 321             ffestpCloseStmt *params;
 322           }
 323         R907;
 324         struct
 325           {
 326             mallocPool pool;
 327             ffestpReadStmt *params;
 328             bool only_format;
 329             ffestvUnit unit;
 330             ffestvFormat format;
 331             bool rec;
 332             bool key;
 333             ffestdExprItem_ list;
 334           }
 335         R909;
 336         struct
 337           {
 338             mallocPool pool;
 339             ffestpWriteStmt *params;
 340             ffestvUnit unit;
 341             ffestvFormat format;
 342             bool rec;
 343             ffestdExprItem_ list;
 344           }
 345         R910;
 346         struct
 347           {
 348             mallocPool pool;
 349             ffestpPrintStmt *params;
 350             ffestvFormat format;
 351             ffestdExprItem_ list;
 352           }
 353         R911;
 354         struct
 355           {
 356             mallocPool pool;
 357             ffestpBeruStmt *params;
 358           }
 359         R919;
 360         struct
 361           {
 362             mallocPool pool;
 363             ffestpBeruStmt *params;
 364           }
 365         R920;
 366         struct
 367           {
 368             mallocPool pool;
 369             ffestpBeruStmt *params;
 370           }
 371         R921;
 372         struct
 373           {
 374             mallocPool pool;
 375             ffestpInquireStmt *params;
 376             bool by_file;
 377           }
 378         R923A;
 379         struct
 380           {
 381             mallocPool pool;
 382             ffestpInquireStmt *params;
 383             ffestdExprItem_ list;
 384           }
 385         R923B;
 386         struct
 387           {
 388             ffestsHolder str;
 389           }
 390         R1001;
 391         struct
 392           {
 393             mallocPool pool;
 394             ffebld expr;
 395           }
 396         R1212;
 397         struct
 398           {
 399             ffesymbol entry;
 400             int entrynum;
 401           }
 402         R1226;
 403         struct
 404           {
 405             mallocPool pool;
 406             ffestw block;
 407             ffebld expr;
 408           }
 409         R1227;
 410 #if FFESTR_VXT
 411         struct
 412           {
 413             mallocPool pool;
 414             ffestpRewriteStmt *params;
 415             ffestvFormat format;
 416             ffestdExprItem_ list;
 417           }
 418         V018;
 419         struct
 420           {
 421             mallocPool pool;
 422             ffestpAcceptStmt *params;
 423             ffestvFormat format;
 424             ffestdExprItem_ list;
 425           }
 426         V019;
 427 #endif
 428         struct
 429           {
 430             mallocPool pool;
 431             ffestpTypeStmt *params;
 432             ffestvFormat format;
 433             ffestdExprItem_ list;
 434           }
 435         V020;
 436 #if FFESTR_VXT
 437         struct
 438           {
 439             mallocPool pool;
 440             ffestpDeleteStmt *params;
 441           }
 442         V021;
 443         struct
 444           {
 445             mallocPool pool;
 446             ffestpBeruStmt *params;
 447           }
 448         V022;
 449         struct
 450           {
 451             mallocPool pool;
 452             ffestpVxtcodeStmt *params;
 453             ffestdExprItem_ list;
 454           }
 455         V023;
 456         struct
 457           {
 458             mallocPool pool;
 459             ffestpVxtcodeStmt *params;
 460             ffestdExprItem_ list;
 461           }
 462         V024;
 463         struct
 464           {
 465             ffebld u;
 466             ffebld m;
 467             ffebld n;
 468             ffebld asv;
 469           }
 470         V025item;
 471         struct
 472           {
 473             mallocPool pool;
 474           } V025finish;
 475         struct
 476           {
 477             mallocPool pool;
 478             ffestpFindStmt *params;
 479           }
 480         V026;
 481 #endif
 482       }
 483     u;
 484   };
 485
 486 /* Static objects accessed by functions in this module. */
 487
 488 static ffestdStatelet_ ffestd_statelet_ = FFESTD_stateletSIMPLE_;
 489 static int ffestd_block_level_ = 0;     /* Block level for reachableness. */
 490 static bool ffestd_is_reachable_;       /* Is the current stmt reachable?  */
 491 static ffelab ffestd_label_formatdef_ = NULL;
 492 static ffestdExprItem_ *ffestd_expr_list_;
 493 static struct
 494   {
 495     ffestdStmt_ first;
 496     ffestdStmt_ last;
 497   }
 498 ffestd_stmt_list_ =
 499 {
 500   NULL, NULL
 501 };
 502
 503
 504 /* # ENTRY statements pending. */
 505 static int ffestd_2pass_entrypoints_ = 0;
 506
 507 /* Static functions (internal). */
 508
 509 static void ffestd_stmt_append_ (ffestdStmt_ stmt);
 510 static ffestdStmt_ ffestd_stmt_new_ (ffestdStmtId_ id);
 511 static void ffestd_stmt_pass_ (void);
 512 #if FFESTD_COPY_EASY_
 513 static ffestpInquireStmt *ffestd_subr_copy_easy_ (ffestpInquireIx max);
 514 #endif
 515 static void ffestd_subr_vxt_ (void);
 516 #if FFESTR_F90
 517 static void ffestd_subr_f90_ (void);
 518 #endif
 519 static void ffestd_subr_labels_ (bool unexpected);
 520 static void ffestd_R1001dump_ (ffests s, ffesttFormatList list);
 521 static void ffestd_R1001dump_1005_1_ (ffests s, ffesttFormatList f,
 522                                       const char *string);
 523 static void ffestd_R1001dump_1005_2_ (ffests s, ffesttFormatList f,
 524                                       const char *string);
 525 static void ffestd_R1001dump_1005_3_ (ffests s, ffesttFormatList f,
 526                                       const char *string);
 527 static void ffestd_R1001dump_1005_4_ (ffests s, ffesttFormatList f,
 528                                       const char *string);
 529 static void ffestd_R1001dump_1005_5_ (ffests s, ffesttFormatList f,
 530                                       const char *string);
 531 static void ffestd_R1001dump_1010_1_ (ffests s, ffesttFormatList f,
 532                                       const char *string);
 533 static void ffestd_R1001dump_1010_2_ (ffests s, ffesttFormatList f,
 534                                       const char *string);
 535 static void ffestd_R1001dump_1010_3_ (ffests s, ffesttFormatList f,
 536                                       const char *string);
 537 static void ffestd_R1001dump_1010_4_ (ffests s, ffesttFormatList f,
 538                                       const char *string);
 539 static void ffestd_R1001dump_1010_5_ (ffests s, ffesttFormatList f,
 540                                       const char *string);
 541 static void ffestd_R1001error_ (ffesttFormatList f);
 542 static void ffestd_R1001rtexpr_ (ffests s, ffesttFormatList f, ffebld expr);
 543
 544 /* Internal macros. */
 545
 546 #define ffestd_subr_line_now_()                                        \
 547   ffeste_set_line (ffelex_token_where_filename (ffesta_tokens[0]), \
 548                    ffelex_token_where_filelinenum (ffesta_tokens[0]))
 549 #define ffestd_subr_line_restore_(s) \
 550   ffeste_set_line ((s)->filename, (s)->filelinenum)
 551 #define ffestd_subr_line_save_(s)                                          \
 552   ((s)->filename = ffelex_token_where_filename (ffesta_tokens[0]),         \
 553    (s)->filelinenum = ffelex_token_where_filelinenum (ffesta_tokens[0]))
 554 #define ffestd_check_simple_() \
 555       assert(ffestd_statelet_ == FFESTD_stateletSIMPLE_)
 556 #define ffestd_check_start_() \
 557       assert(ffestd_statelet_ == FFESTD_stateletSIMPLE_); \
 558       ffestd_statelet_ = FFESTD_stateletATTRIB_
 559 #define ffestd_check_attrib_() \
 560       assert(ffestd_statelet_ == FFESTD_stateletATTRIB_)
 561 #define ffestd_check_item_() \
 562       assert(ffestd_statelet_ == FFESTD_stateletATTRIB_  \
 563             || ffestd_statelet_ == FFESTD_stateletITEM_); \
 564       ffestd_statelet_ = FFESTD_stateletITEM_
 565 #define ffestd_check_item_startvals_() \
 566       assert(ffestd_statelet_ == FFESTD_stateletATTRIB_  \
 567             || ffestd_statelet_ == FFESTD_stateletITEM_); \
 568       ffestd_statelet_ = FFESTD_stateletITEMVALS_
 569 #define ffestd_check_item_value_() \
 570       assert(ffestd_statelet_ == FFESTD_stateletITEMVALS_)
 571 #define ffestd_check_item_endvals_() \
 572       assert(ffestd_statelet_ == FFESTD_stateletITEMVALS_); \
 573       ffestd_statelet_ = FFESTD_stateletITEM_
 574 #define ffestd_check_finish_() \
 575       assert(ffestd_statelet_ == FFESTD_stateletATTRIB_  \
 576             || ffestd_statelet_ == FFESTD_stateletITEM_); \
 577       ffestd_statelet_ = FFESTD_stateletSIMPLE_
 578
 579 #if FFESTD_COPY_EASY_
 580 #define ffestd_subr_copy_accept_() (ffestpAcceptStmt *) \
 581       ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_acceptix)
 582 #define ffestd_subr_copy_beru_() (ffestpBeruStmt *) \
 583       ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_beruix)
 584 #define ffestd_subr_copy_close_() (ffestpCloseStmt *) \
 585       ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_closeix)
 586 #define ffestd_subr_copy_delete_() (ffestpDeleteStmt *) \
 587       ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_deleteix)
 588 #define ffestd_subr_copy_find_() (ffestpFindStmt *) \
 589       ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_findix)
 590 #define ffestd_subr_copy_inquire_() (ffestpInquireStmt *) \
 591       ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_inquireix)
 592 #define ffestd_subr_copy_open_() (ffestpOpenStmt *) \
 593       ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_openix)
 594 #define ffestd_subr_copy_print_() (ffestpPrintStmt *) \
 595       ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_printix)
 596 #define ffestd_subr_copy_read_() (ffestpReadStmt *) \
 597       ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_readix)
 598 #define ffestd_subr_copy_rewrite_() (ffestpRewriteStmt *) \
 599       ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_rewriteix)
 600 #define ffestd_subr_copy_type_() (ffestpTypeStmt *) \
 601       ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_typeix)
 602 #define ffestd_subr_copy_vxtcode_() (ffestpVxtcodeStmt *) \
 603       ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_vxtcodeix)
 604 #define ffestd_subr_copy_write_() (ffestpWriteStmt *) \
 605       ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_writeix)
 606 #endif
 607 \f
 608 /* ffestd_stmt_append_ -- Append statement to end of stmt list
 609
 610    ffestd_stmt_append_(ffestd_stmt_new_(FFESTD_stmtidR737A_));  */
 611
 612 static void
 613 ffestd_stmt_append_ (ffestdStmt_ stmt)
 614 {
 615   stmt->next = (ffestdStmt_) &ffestd_stmt_list_.first;
 616   stmt->previous = ffestd_stmt_list_.last;
 617   stmt->next->previous = stmt;
 618   stmt->previous->next = stmt;
 619 }
 620
 621 /* ffestd_stmt_new_ -- Make new statement with given id
 622
 623    ffestdStmt_ stmt;
 624    stmt = ffestd_stmt_new_(FFESTD_stmtidR737A_);  */
 625
 626 static ffestdStmt_
 627 ffestd_stmt_new_ (ffestdStmtId_ id)
 628 {
 629   ffestdStmt_ stmt;
 630
 631   stmt = malloc_new_kp (ffe_pool_any_unit (), "ffestdStmt_", sizeof (*stmt));
 632   stmt->id = id;
 633   return stmt;
 634 }
 635
 636 /* ffestd_stmt_pass_ -- Pass all statements on list to ffeste
 637
 638    ffestd_stmt_pass_();  */
 639
 640 static void
 641 ffestd_stmt_pass_ ()
 642 {
 643   ffestdStmt_ stmt;
 644   ffestdExprItem_ expr;         /* For traversing lists. */
 645   bool okay = (TREE_CODE (current_function_decl) != ERROR_MARK);
 646
 647   if ((ffestd_2pass_entrypoints_ != 0) && okay)
 648     {
 649       tree which = ffecom_which_entrypoint_decl ();
 650       tree value;
 651       tree label;
 652       int pushok;
 653       int ents = ffestd_2pass_entrypoints_;
 654       tree duplicate;
 655
 656       expand_start_case (0, which, TREE_TYPE (which), "entrypoint dispatch");
 657
 658       stmt = ffestd_stmt_list_.first;
 659       do
 660         {
 661           while (stmt->id != FFESTD_stmtidR1226_)
 662             stmt = stmt->next;
 663
 664           if (stmt->u.R1226.entry != NULL)
 665             {
 666               value = build_int_2 (stmt->u.R1226.entrynum, 0);
 667               /* Yes, we really want to build a null LABEL_DECL here and not
 668                  put it on any list.  That's what pushcase wants, so that's
 669                  what it gets!  */
 670               label = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE);
 671
 672               pushok = pushcase (value, convert, label, &duplicate);
 673               assert (pushok == 0);
 674
 675               label = ffecom_temp_label ();
 676               TREE_USED (label) = 1;
 677               expand_goto (label);
 678
 679               ffesymbol_hook (stmt->u.R1226.entry).length_tree = label;
 680             }
 681           stmt = stmt->next;
 682         }
 683       while (--ents != 0);
 684
 685       expand_end_case (which);
 686     }
 687
 688   for (stmt = ffestd_stmt_list_.first;
 689        stmt != (ffestdStmt_) &ffestd_stmt_list_.first;
 690        stmt = stmt->next)
 691     {
 692       switch (stmt->id)
 693         {
 694         case FFESTD_stmtidENDDOLOOP_:
 695           ffestd_subr_line_restore_ (stmt);
 696           if (okay)
 697             ffeste_do (stmt->u.enddoloop.block);
 698           ffestw_kill (stmt->u.enddoloop.block);
 699           break;
 700
 701         case FFESTD_stmtidENDLOGIF_:
 702           ffestd_subr_line_restore_ (stmt);
 703           if (okay)
 704             ffeste_end_R807 ();
 705           break;
 706
 707         case FFESTD_stmtidEXECLABEL_:
 708           if (okay)
 709             ffeste_labeldef_branch (stmt->u.execlabel.label);
 710           break;
 711
 712         case FFESTD_stmtidFORMATLABEL_:
 713           if (okay)
 714             ffeste_labeldef_format (stmt->u.formatlabel.label);
 715           break;
 716
 717         case FFESTD_stmtidR737A_:
 718           ffestd_subr_line_restore_ (stmt);
 719           if (okay)
 720             ffeste_R737A (stmt->u.R737A.dest, stmt->u.R737A.source);
 721           malloc_pool_kill (stmt->u.R737A.pool);
 722           break;
 723
 724         case FFESTD_stmtidR803_:
 725           ffestd_subr_line_restore_ (stmt);
 726           if (okay)
 727             ffeste_R803 (stmt->u.R803.block, stmt->u.R803.expr);
 728           malloc_pool_kill (stmt->u.R803.pool);
 729           break;
 730
 731         case FFESTD_stmtidR804_:
 732           ffestd_subr_line_restore_ (stmt);
 733           if (okay)
 734             ffeste_R804 (stmt->u.R803.block, stmt->u.R804.expr);
 735           malloc_pool_kill (stmt->u.R804.pool);
 736           break;
 737
 738         case FFESTD_stmtidR805_:
 739           ffestd_subr_line_restore_ (stmt);
 740           if (okay)
 741             ffeste_R805 (stmt->u.R803.block);
 742           break;
 743
 744         case FFESTD_stmtidR806_:
 745           ffestd_subr_line_restore_ (stmt);
 746           if (okay)
 747             ffeste_R806 (stmt->u.R806.block);
 748           ffestw_kill (stmt->u.R806.block);
 749           break;
 750
 751         case FFESTD_stmtidR807_:
 752           ffestd_subr_line_restore_ (stmt);
 753           if (okay)
 754             ffeste_R807 (stmt->u.R807.expr);
 755           malloc_pool_kill (stmt->u.R807.pool);
 756           break;
 757
 758         case FFESTD_stmtidR809_:
 759           ffestd_subr_line_restore_ (stmt);
 760           if (okay)
 761             ffeste_R809 (stmt->u.R809.block, stmt->u.R809.expr);
 762           malloc_pool_kill (stmt->u.R809.pool);
 763           break;
 764
 765         case FFESTD_stmtidR810_:
 766           ffestd_subr_line_restore_ (stmt);
 767           if (okay)
 768             ffeste_R810 (stmt->u.R810.block, stmt->u.R810.casenum);
 769           malloc_pool_kill (stmt->u.R810.pool);
 770           break;
 771
 772         case FFESTD_stmtidR811_:
 773           ffestd_subr_line_restore_ (stmt);
 774           if (okay)
 775             ffeste_R811 (stmt->u.R811.block);
 776           malloc_pool_kill (ffestw_select (stmt->u.R811.block)->pool);
 777           ffestw_kill (stmt->u.R811.block);
 778           break;
 779
 780         case FFESTD_stmtidR819A_:
 781           ffestd_subr_line_restore_ (stmt);
 782           if (okay)
 783             ffeste_R819A (stmt->u.R819A.block, stmt->u.R819A.label,
 784                           stmt->u.R819A.var,
 785                           stmt->u.R819A.start, stmt->u.R819A.start_token,
 786                           stmt->u.R819A.end, stmt->u.R819A.end_token,
 787                           stmt->u.R819A.incr, stmt->u.R819A.incr_token);
 788           ffelex_token_kill (stmt->u.R819A.start_token);
 789           ffelex_token_kill (stmt->u.R819A.end_token);
 790           if (stmt->u.R819A.incr_token != NULL)
 791             ffelex_token_kill (stmt->u.R819A.incr_token);
 792           malloc_pool_kill (stmt->u.R819A.pool);
 793           break;
 794
 795         case FFESTD_stmtidR819B_:
 796           ffestd_subr_line_restore_ (stmt);
 797           if (okay)
 798             ffeste_R819B (stmt->u.R819B.block, stmt->u.R819B.label,
 799                           stmt->u.R819B.expr);
 800           malloc_pool_kill (stmt->u.R819B.pool);
 801           break;
 802
 803         case FFESTD_stmtidR825_:
 804           ffestd_subr_line_restore_ (stmt);
 805           if (okay)
 806             ffeste_R825 ();
 807           break;
 808
 809         case FFESTD_stmtidR834_:
 810           ffestd_subr_line_restore_ (stmt);
 811           if (okay)
 812             ffeste_R834 (stmt->u.R834.block);
 813           break;
 814
 815         case FFESTD_stmtidR835_:
 816           ffestd_subr_line_restore_ (stmt);
 817           if (okay)
 818             ffeste_R835 (stmt->u.R835.block);
 819           break;
 820
 821         case FFESTD_stmtidR836_:
 822           ffestd_subr_line_restore_ (stmt);
 823           if (okay)
 824             ffeste_R836 (stmt->u.R836.label);
 825           break;
 826
 827         case FFESTD_stmtidR837_:
 828           ffestd_subr_line_restore_ (stmt);
 829           if (okay)
 830             ffeste_R837 (stmt->u.R837.labels, stmt->u.R837.count,
 831                          stmt->u.R837.expr);
 832           malloc_pool_kill (stmt->u.R837.pool);
 833           break;
 834
 835         case FFESTD_stmtidR838_:
 836           ffestd_subr_line_restore_ (stmt);
 837           if (okay)
 838             ffeste_R838 (stmt->u.R838.label, stmt->u.R838.target);
 839           malloc_pool_kill (stmt->u.R838.pool);
 840           break;
 841
 842         case FFESTD_stmtidR839_:
 843           ffestd_subr_line_restore_ (stmt);
 844           if (okay)
 845             ffeste_R839 (stmt->u.R839.target);
 846           malloc_pool_kill (stmt->u.R839.pool);
 847           break;
 848
 849         case FFESTD_stmtidR840_:
 850           ffestd_subr_line_restore_ (stmt);
 851           if (okay)
 852             ffeste_R840 (stmt->u.R840.expr, stmt->u.R840.neg, stmt->u.R840.zero,
 853                          stmt->u.R840.pos);
 854           malloc_pool_kill (stmt->u.R840.pool);
 855           break;
 856
 857         case FFESTD_stmtidR841_:
 858           ffestd_subr_line_restore_ (stmt);
 859           if (okay)
 860             ffeste_R841 ();
 861           break;
 862
 863         case FFESTD_stmtidR842_:
 864           ffestd_subr_line_restore_ (stmt);
 865           if (okay)
 866             ffeste_R842 (stmt->u.R842.expr);
 867           if (stmt->u.R842.pool != NULL)
 868             malloc_pool_kill (stmt->u.R842.pool);
 869           break;
 870
 871         case FFESTD_stmtidR843_:
 872           ffestd_subr_line_restore_ (stmt);
 873           if (okay)
 874             ffeste_R843 (stmt->u.R843.expr);
 875           malloc_pool_kill (stmt->u.R843.pool);
 876           break;
 877
 878         case FFESTD_stmtidR904_:
 879           ffestd_subr_line_restore_ (stmt);
 880           if (okay)
 881             ffeste_R904 (stmt->u.R904.params);
 882           malloc_pool_kill (stmt->u.R904.pool);
 883           break;
 884
 885         case FFESTD_stmtidR907_:
 886           ffestd_subr_line_restore_ (stmt);
 887           if (okay)
 888             ffeste_R907 (stmt->u.R907.params);
 889           malloc_pool_kill (stmt->u.R907.pool);
 890           break;
 891
 892         case FFESTD_stmtidR909_:
 893           ffestd_subr_line_restore_ (stmt);
 894           if (okay)
 895             ffeste_R909_start (stmt->u.R909.params, stmt->u.R909.only_format,
 896                                stmt->u.R909.unit, stmt->u.R909.format,
 897                                stmt->u.R909.rec, stmt->u.R909.key);
 898           for (expr = stmt->u.R909.list; expr != NULL; expr = expr->next)
 899             {
 900               if (okay)
 901                 ffeste_R909_item (expr->expr, expr->token);
 902               ffelex_token_kill (expr->token);
 903             }
 904           if (okay)
 905             ffeste_R909_finish ();
 906           malloc_pool_kill (stmt->u.R909.pool);
 907           break;
 908
 909         case FFESTD_stmtidR910_:
 910           ffestd_subr_line_restore_ (stmt);
 911           if (okay)
 912             ffeste_R910_start (stmt->u.R910.params, stmt->u.R910.unit,
 913                                stmt->u.R910.format, stmt->u.R910.rec);
 914           for (expr = stmt->u.R910.list; expr != NULL; expr = expr->next)
 915             {
 916               if (okay)
 917                 ffeste_R910_item (expr->expr, expr->token);
 918               ffelex_token_kill (expr->token);
 919             }
 920           if (okay)
 921             ffeste_R910_finish ();
 922           malloc_pool_kill (stmt->u.R910.pool);
 923           break;
 924
 925         case FFESTD_stmtidR911_:
 926           ffestd_subr_line_restore_ (stmt);
 927           if (okay)
 928             ffeste_R911_start (stmt->u.R911.params, stmt->u.R911.format);
 929           for (expr = stmt->u.R911.list; expr != NULL; expr = expr->next)
 930             {
 931               if (okay)
 932                 ffeste_R911_item (expr->expr, expr->token);
 933               ffelex_token_kill (expr->token);
 934             }
 935           if (okay)
 936             ffeste_R911_finish ();
 937           malloc_pool_kill (stmt->u.R911.pool);
 938           break;
 939
 940         case FFESTD_stmtidR919_:
 941           ffestd_subr_line_restore_ (stmt);
 942           if (okay)
 943             ffeste_R919 (stmt->u.R919.params);
 944           malloc_pool_kill (stmt->u.R919.pool);
 945           break;
 946
 947         case FFESTD_stmtidR920_:
 948           ffestd_subr_line_restore_ (stmt);
 949           if (okay)
 950             ffeste_R920 (stmt->u.R920.params);
 951           malloc_pool_kill (stmt->u.R920.pool);
 952           break;
 953
 954         case FFESTD_stmtidR921_:
 955           ffestd_subr_line_restore_ (stmt);
 956           if (okay)
 957             ffeste_R921 (stmt->u.R921.params);
 958           malloc_pool_kill (stmt->u.R921.pool);
 959           break;
 960
 961         case FFESTD_stmtidR923A_:
 962           ffestd_subr_line_restore_ (stmt);
 963           if (okay)
 964             ffeste_R923A (stmt->u.R923A.params, stmt->u.R923A.by_file);
 965           malloc_pool_kill (stmt->u.R923A.pool);
 966           break;
 967
 968         case FFESTD_stmtidR923B_:
 969           ffestd_subr_line_restore_ (stmt);
 970           if (okay)
 971             ffeste_R923B_start (stmt->u.R923B.params);
 972           for (expr = stmt->u.R923B.list; expr != NULL; expr = expr->next)
 973             {
 974               if (okay)
 975                 ffeste_R923B_item (expr->expr);
 976             }
 977           if (okay)
 978             ffeste_R923B_finish ();
 979           malloc_pool_kill (stmt->u.R923B.pool);
 980           break;
 981
 982         case FFESTD_stmtidR1001_:
 983           if (okay)
 984             ffeste_R1001 (&stmt->u.R1001.str);
 985           ffests_kill (&stmt->u.R1001.str);
 986           break;
 987
 988         case FFESTD_stmtidR1103_:
 989           if (okay)
 990             ffeste_R1103 ();
 991           break;
 992
 993         case FFESTD_stmtidR1112_:
 994           if (okay)
 995             ffeste_R1112 ();
 996           break;
 997
 998         case FFESTD_stmtidR1212_:
 999           ffestd_subr_line_restore_ (stmt);
1000           if (okay)
1001             ffeste_R1212 (stmt->u.R1212.expr);
1002           malloc_pool_kill (stmt->u.R1212.pool);
1003           break;
1004
1005         case FFESTD_stmtidR1221_:
1006           if (okay)
1007             ffeste_R1221 ();
1008           break;
1009
1010         case FFESTD_stmtidR1225_:
1011           if (okay)
1012             ffeste_R1225 ();
1013           break;
1014
1015         case FFESTD_stmtidR1226_:
1016           ffestd_subr_line_restore_ (stmt);
1017           if (stmt->u.R1226.entry != NULL)
1018             {
1019               if (okay)
1020                 ffeste_R1226 (stmt->u.R1226.entry);
1021             }
1022           break;
1023
1024         case FFESTD_stmtidR1227_:
1025           ffestd_subr_line_restore_ (stmt);
1026           if (okay)
1027             ffeste_R1227 (stmt->u.R1227.block, stmt->u.R1227.expr);
1028           malloc_pool_kill (stmt->u.R1227.pool);
1029           break;
1030
1031 #if FFESTR_VXT
1032         case FFESTD_stmtidV018_:
1033           ffestd_subr_line_restore_ (stmt);
1034           if (okay)
1035             ffeste_V018_start (stmt->u.V018.params, stmt->u.V018.format);
1036           for (expr = stmt->u.V018.list; expr != NULL; expr = expr->next)
1037             {
1038               if (okay)
1039                 ffeste_V018_item (expr->expr);
1040             }
1041           if (okay)
1042             ffeste_V018_finish ();
1043           malloc_pool_kill (stmt->u.V018.pool);
1044           break;
1045
1046         case FFESTD_stmtidV019_:
1047           ffestd_subr_line_restore_ (stmt);
1048           if (okay)
1049             ffeste_V019_start (stmt->u.V019.params, stmt->u.V019.format);
1050           for (expr = stmt->u.V019.list; expr != NULL; expr = expr->next)
1051             {
1052               if (okay)
1053                 ffeste_V019_item (expr->expr);
1054             }
1055           if (okay)
1056             ffeste_V019_finish ();
1057           malloc_pool_kill (stmt->u.V019.pool);
1058           break;
1059 #endif
1060
1061         case FFESTD_stmtidV020_:
1062           ffestd_subr_line_restore_ (stmt);
1063           if (okay)
1064             ffeste_V020_start (stmt->u.V020.params, stmt->u.V020.format);
1065           for (expr = stmt->u.V020.list; expr != NULL; expr = expr->next)
1066             {
1067               if (okay)
1068                 ffeste_V020_item (expr->expr);
1069             }
1070           if (okay)
1071             ffeste_V020_finish ();
1072           malloc_pool_kill (stmt->u.V020.pool);
1073           break;
1074
1075 #if FFESTR_VXT
1076         case FFESTD_stmtidV021_:
1077           ffestd_subr_line_restore_ (stmt);
1078           if (okay)
1079             ffeste_V021 (stmt->u.V021.params);
1080           malloc_pool_kill (stmt->u.V021.pool);
1081           break;
1082
1083         case FFESTD_stmtidV023_:
1084           ffestd_subr_line_restore_ (stmt);
1085           if (okay)
1086             ffeste_V023_start (stmt->u.V023.params);
1087           for (expr = stmt->u.V023.list; expr != NULL; expr = expr->next)
1088             {
1089               if (okay)
1090                 ffeste_V023_item (expr->expr);
1091             }
1092           if (okay)
1093             ffeste_V023_finish ();
1094           malloc_pool_kill (stmt->u.V023.pool);
1095           break;
1096
1097         case FFESTD_stmtidV024_:
1098           ffestd_subr_line_restore_ (stmt);
1099           if (okay)
1100             ffeste_V024_start (stmt->u.V024.params);
1101           for (expr = stmt->u.V024.list; expr != NULL; expr = expr->next)
1102             {
1103               if (okay)
1104                 ffeste_V024_item (expr->expr);
1105             }
1106           if (okay)
1107             ffeste_V024_finish ();
1108           malloc_pool_kill (stmt->u.V024.pool);
1109           break;
1110
1111         case FFESTD_stmtidV025start_:
1112           ffestd_subr_line_restore_ (stmt);
1113           if (okay)
1114             ffeste_V025_start ();
1115           break;
1116
1117         case FFESTD_stmtidV025item_:
1118           if (okay)
1119             ffeste_V025_item (stmt->u.V025item.u, stmt->u.V025item.m,
1120                               stmt->u.V025item.n, stmt->u.V025item.asv);
1121           break;
1122
1123         case FFESTD_stmtidV025finish_:
1124           if (okay)
1125             ffeste_V025_finish ();
1126           malloc_pool_kill (stmt->u.V025finish.pool);
1127           break;
1128
1129         case FFESTD_stmtidV026_:
1130           ffestd_subr_line_restore_ (stmt);
1131           if (okay)
1132             ffeste_V026 (stmt->u.V026.params);
1133           malloc_pool_kill (stmt->u.V026.pool);
1134           break;
1135 #endif
1136
1137         default:
1138           assert ("bad stmt->id" == NULL);
1139           break;
1140         }
1141     }
1142 }
1143
1144 /* ffestd_subr_copy_easy_ -- Copy I/O statement data structure
1145
1146    ffestd_subr_copy_easy_();
1147
1148    Copies all data except tokens in the I/O data structure into a new
1149    structure that lasts as long as the output pool for the current
1150    statement.  Assumes that they are
1151    overlaid with each other (union) in stp.h and the typing
1152    and structure references assume (though not necessarily dangerous if
1153    FALSE) that INQUIRE has the most file elements.  */
1154
1155 #if FFESTD_COPY_EASY_
1156 static ffestpInquireStmt *
1157 ffestd_subr_copy_easy_ (ffestpInquireIx max)
1158 {
1159   ffestpInquireStmt *stmt;
1160   ffestpInquireIx ix;
1161
1162   stmt = (ffestpInquireStmt *) malloc_new_kp (ffesta_output_pool,
1163                                   "FFESTD easy", sizeof (ffestpFile) * max);
1164
1165   for (ix = 0; ix < max; ++ix)
1166     {
1167       if ((stmt->inquire_spec[ix].kw_or_val_present
1168            = ffestp_file.inquire.inquire_spec[ix].kw_or_val_present)
1169           && (stmt->inquire_spec[ix].value_present
1170               = ffestp_file.inquire.inquire_spec[ix].value_present))
1171         {
1172           if ((stmt->inquire_spec[ix].value_is_label
1173                = ffestp_file.inquire.inquire_spec[ix].value_is_label))
1174             stmt->inquire_spec[ix].u.label
1175               = ffestp_file.inquire.inquire_spec[ix].u.label;
1176           else
1177             stmt->inquire_spec[ix].u.expr
1178               = ffestp_file.inquire.inquire_spec[ix].u.expr;
1179         }
1180     }
1181
1182   return stmt;
1183 }
1184
1185 #endif
1186 /* ffestd_subr_labels_ -- Handle any undefined labels
1187
1188    ffestd_subr_labels_(FALSE);
1189
1190    For every undefined label, generate an error message and either define
1191    label as a FORMAT() statement (for FORMAT labels) or as a STOP statement
1192    (for all other labels).  */
1193
1194 static void
1195 ffestd_subr_labels_ (bool unexpected)
1196 {
1197   ffelab l;
1198   ffelabHandle h;
1199   ffelabNumber undef;
1200   ffesttFormatList f;
1201
1202   undef = ffelab_number () - ffestv_num_label_defines_;
1203
1204   for (h = ffelab_handle_first (); h != NULL; h = ffelab_handle_next (h))
1205     {
1206       l = ffelab_handle_target (h);
1207       if (ffewhere_line_is_unknown (ffelab_definition_line (l)))
1208         {                       /* Undefined label. */
1209           assert (!unexpected);
1210           assert (undef > 0);
1211           undef--;
1212           ffebad_start (FFEBAD_UNDEF_LABEL);
1213           if (ffelab_type (l) == FFELAB_typeLOOPEND)
1214             ffebad_here (0, ffelab_doref_line (l), ffelab_doref_column (l));
1215           else if (ffelab_type (l) != FFELAB_typeANY)
1216             ffebad_here (0, ffelab_firstref_line (l), ffelab_firstref_column (l));
1217           else if (!ffewhere_line_is_unknown (ffelab_firstref_line (l)))
1218             ffebad_here (0, ffelab_firstref_line (l), ffelab_firstref_column (l));
1219           else if (!ffewhere_line_is_unknown (ffelab_doref_line (l)))
1220             ffebad_here (0, ffelab_doref_line (l), ffelab_doref_column (l));
1221           else
1222             ffebad_here (0, ffelab_definition_line (l), ffelab_definition_column (l));
1223           ffebad_finish ();
1224
1225           switch (ffelab_type (l))
1226             {
1227             case FFELAB_typeFORMAT:
1228               ffelab_set_definition_line (l,
1229                               ffewhere_line_use (ffelab_firstref_line (l)));
1230               ffelab_set_definition_column (l,
1231                           ffewhere_column_use (ffelab_firstref_column (l)));
1232               ffestv_num_label_defines_++;
1233               f = ffestt_formatlist_create (NULL, NULL);
1234               ffestd_labeldef_format (l);
1235               ffestd_R1001 (f);
1236               ffestt_formatlist_kill (f);
1237               break;
1238
1239             case FFELAB_typeASSIGNABLE:
1240               ffelab_set_definition_line (l,
1241                               ffewhere_line_use (ffelab_firstref_line (l)));
1242               ffelab_set_definition_column (l,
1243                           ffewhere_column_use (ffelab_firstref_column (l)));
1244               ffestv_num_label_defines_++;
1245               ffelab_set_type (l, FFELAB_typeNOTLOOP);
1246               ffelab_set_blocknum (l, ffestw_blocknum (ffestw_stack_top ()));
1247               ffestd_labeldef_notloop (l);
1248               ffestd_R842 (NULL);
1249               break;
1250
1251             case FFELAB_typeNOTLOOP:
1252               ffelab_set_definition_line (l,
1253                               ffewhere_line_use (ffelab_firstref_line (l)));
1254               ffelab_set_definition_column (l,
1255                           ffewhere_column_use (ffelab_firstref_column (l)));
1256               ffestv_num_label_defines_++;
1257               ffelab_set_blocknum (l, ffestw_blocknum (ffestw_stack_top ()));
1258               ffestd_labeldef_notloop (l);
1259               ffestd_R842 (NULL);
1260               break;
1261
1262             default:
1263               assert ("bad label type" == NULL);
1264               /* Fall through. */
1265             case FFELAB_typeUNKNOWN:
1266             case FFELAB_typeANY:
1267               break;
1268             }
1269         }
1270     }
1271   ffelab_handle_done (h);
1272   assert (undef == 0);
1273 }
1274
1275 /* ffestd_subr_f90_ -- Report error about lack of full F90 support
1276
1277    ffestd_subr_f90_();  */
1278
1279 #if FFESTR_F90
1280 static void
1281 ffestd_subr_f90_ ()
1282 {
1283   ffebad_start (FFEBAD_F90);
1284   ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
1285                ffelex_token_where_column (ffesta_tokens[0]));
1286   ffebad_finish ();
1287 }
1288
1289 #endif
1290 /* ffestd_subr_vxt_ -- Report error about lack of full VXT support
1291
1292    ffestd_subr_vxt_();  */
1293
1294 static void
1295 ffestd_subr_vxt_ ()
1296 {
1297   ffebad_start (FFEBAD_VXT_UNSUPPORTED);
1298   ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
1299                ffelex_token_where_column (ffesta_tokens[0]));
1300   ffebad_finish ();
1301 }
1302
1303 /* ffestd_begin_uses -- Start a bunch of USE statements
1304
1305    ffestd_begin_uses();
1306
1307    Invoked before handling the first USE statement in a block of one or
1308    more USE statements.  _end_uses_(bool ok) is invoked before handling
1309    the first statement after the block (there are no BEGIN USE and END USE
1310    statements, but the semantics of USE statements effectively requires
1311    handling them as a single block rather than one statement at a time).  */
1312
1313 void
1314 ffestd_begin_uses ()
1315 {
1316 }
1317
1318 /* ffestd_do -- End of statement following DO-term-stmt etc
1319
1320    ffestd_do(TRUE);
1321
1322    Also invoked by _labeldef_branch_finish_ (or, in cases
1323    of errors, other _labeldef_ functions) when the label definition is
1324    for a DO-target (LOOPEND) label, once per matching/outstanding DO
1325    block on the stack.  These cases invoke this function with ok==TRUE, so
1326    only forced stack popping (via ffestd_eof_()) invokes it with ok==FALSE.  */
1327
1328 void
1329 ffestd_do (bool ok UNUSED)
1330 {
1331   ffestdStmt_ stmt;
1332
1333   stmt = ffestd_stmt_new_ (FFESTD_stmtidENDDOLOOP_);
1334   ffestd_stmt_append_ (stmt);
1335   ffestd_subr_line_save_ (stmt);
1336   stmt->u.enddoloop.block = ffestw_stack_top ();
1337
1338   --ffestd_block_level_;
1339   assert (ffestd_block_level_ >= 0);
1340 }
1341
1342 /* ffestd_end_uses -- End a bunch of USE statements
1343
1344    ffestd_end_uses(TRUE);
1345
1346    ok==TRUE means simply not popping due to ffestd_eof_()
1347    being called, because there is no formal END USES statement in Fortran.  */
1348
1349 #if FFESTR_F90
1350 void
1351 ffestd_end_uses (bool ok)
1352 {
1353 }
1354
1355 /* ffestd_end_R740 -- End a WHERE(-THEN)
1356
1357    ffestd_end_R740(TRUE);  */
1358
1359 void
1360 ffestd_end_R740 (bool ok)
1361 {
1362   return;                       /* F90. */
1363 }
1364
1365 #endif
1366 /* ffestd_end_R807 -- End of statement following logical IF
1367
1368    ffestd_end_R807(TRUE);
1369
1370    Applies ONLY to logical IF, not to IF-THEN.  For example, does not
1371    ffelex_token_kill the construct name for an IF-THEN block (the name
1372    field is invalid for logical IF).  ok==TRUE iff statement following
1373    logical IF (substatement) is valid; else, statement is invalid or
1374    stack forcibly popped due to ffestd_eof_().  */
1375
1376 void
1377 ffestd_end_R807 (bool ok UNUSED)
1378 {
1379   ffestdStmt_ stmt;
1380
1381   stmt = ffestd_stmt_new_ (FFESTD_stmtidENDLOGIF_);
1382   ffestd_stmt_append_ (stmt);
1383   ffestd_subr_line_save_ (stmt);
1384
1385   --ffestd_block_level_;
1386   assert (ffestd_block_level_ >= 0);
1387 }
1388
1389 /* ffestd_exec_begin -- Executable statements can start coming in now
1390
1391    ffestd_exec_begin();  */
1392
1393 void
1394 ffestd_exec_begin ()
1395 {
1396   ffecom_exec_transition ();
1397
1398   if (ffestd_2pass_entrypoints_ != 0)
1399     {                           /* Process pending ENTRY statements now that
1400                                    info filled in. */
1401       ffestdStmt_ stmt;
1402       int ents = ffestd_2pass_entrypoints_;
1403
1404       stmt = ffestd_stmt_list_.first;
1405       do
1406         {
1407           while (stmt->id != FFESTD_stmtidR1226_)
1408             stmt = stmt->next;
1409
1410           if (!ffecom_2pass_advise_entrypoint (stmt->u.R1226.entry))
1411             {
1412               stmt->u.R1226.entry = NULL;
1413               --ffestd_2pass_entrypoints_;
1414             }
1415           stmt = stmt->next;
1416         }
1417       while (--ents != 0);
1418     }
1419 }
1420
1421 /* ffestd_exec_end -- Executable statements can no longer come in now
1422
1423    ffestd_exec_end();  */
1424
1425 void
1426 ffestd_exec_end ()
1427 {
1428   int old_lineno = lineno;
1429   const char *old_input_filename = input_filename;
1430
1431   ffecom_end_transition ();
1432
1433   ffestd_stmt_pass_ ();
1434
1435   ffecom_finish_progunit ();
1436
1437   if (ffestd_2pass_entrypoints_ != 0)
1438     {
1439       int ents = ffestd_2pass_entrypoints_;
1440       ffestdStmt_ stmt = ffestd_stmt_list_.first;
1441
1442       do
1443         {
1444           while (stmt->id != FFESTD_stmtidR1226_)
1445             stmt = stmt->next;
1446
1447           if (stmt->u.R1226.entry != NULL)
1448             {
1449               ffestd_subr_line_restore_ (stmt);
1450               ffecom_2pass_do_entrypoint (stmt->u.R1226.entry);
1451             }
1452           stmt = stmt->next;
1453         }
1454       while (--ents != 0);
1455     }
1456
1457   ffestd_stmt_list_.first = NULL;
1458   ffestd_stmt_list_.last = NULL;
1459   ffestd_2pass_entrypoints_ = 0;
1460
1461   lineno = old_lineno;
1462   input_filename = old_input_filename;
1463 }
1464
1465 /* ffestd_init_3 -- Initialize for any program unit
1466
1467    ffestd_init_3();  */
1468
1469 void
1470 ffestd_init_3 ()
1471 {
1472   ffestd_stmt_list_.first = (ffestdStmt_) &ffestd_stmt_list_.first;
1473   ffestd_stmt_list_.last = (ffestdStmt_) &ffestd_stmt_list_.first;
1474 }
1475
1476 /* Generate "code" for "any" label def.  */
1477
1478 void
1479 ffestd_labeldef_any (ffelab label UNUSED)
1480 {
1481 }
1482
1483 /* ffestd_labeldef_branch -- Generate "code" for branch label def
1484
1485    ffestd_labeldef_branch(label);  */
1486
1487 void
1488 ffestd_labeldef_branch (ffelab label)
1489 {
1490   ffestdStmt_ stmt;
1491
1492   stmt = ffestd_stmt_new_ (FFESTD_stmtidEXECLABEL_);
1493   ffestd_stmt_append_ (stmt);
1494   stmt->u.execlabel.label = label;
1495
1496   ffestd_is_reachable_ = TRUE;
1497 }
1498
1499 /* ffestd_labeldef_format -- Generate "code" for FORMAT label def
1500
1501    ffestd_labeldef_format(label);  */
1502
1503 void
1504 ffestd_labeldef_format (ffelab label)
1505 {
1506   ffestdStmt_ stmt;
1507
1508   ffestd_label_formatdef_ = label;
1509
1510   stmt = ffestd_stmt_new_ (FFESTD_stmtidFORMATLABEL_);
1511   ffestd_stmt_append_ (stmt);
1512   stmt->u.formatlabel.label = label;
1513 }
1514
1515 /* ffestd_labeldef_useless -- Generate "code" for useless label def
1516
1517    ffestd_labeldef_useless(label);  */
1518
1519 void
1520 ffestd_labeldef_useless (ffelab label UNUSED)
1521 {
1522 }
1523
1524 /* ffestd_R423A -- PRIVATE statement (in R422 derived-type statement)
1525
1526    ffestd_R423A();  */
1527
1528 #if FFESTR_F90
1529 void
1530 ffestd_R423A ()
1531 {
1532   ffestd_check_simple_ ();
1533 }
1534
1535 /* ffestd_R423B -- SEQUENCE statement (in R422 derived-type-stmt)
1536
1537    ffestd_R423B();  */
1538
1539 void
1540 ffestd_R423B ()
1541 {
1542   ffestd_check_simple_ ();
1543 }
1544
1545 /* ffestd_R424 -- derived-TYPE-def statement
1546
1547    ffestd_R424(access_token,access_kw,name_token);
1548
1549    Handle a derived-type definition.  */
1550
1551 void
1552 ffestd_R424 (ffelexToken access, ffestrOther access_kw, ffelexToken name)
1553 {
1554   ffestd_check_simple_ ();
1555
1556   ffestd_subr_f90_ ();
1557   return;
1558
1559 #ifdef FFESTD_F90
1560   char *a;
1561
1562   if (access == NULL)
1563     fprintf (dmpout, "* TYPE %s\n", ffelex_token_text (name));
1564   else
1565     {
1566       switch (access_kw)
1567         {
1568         case FFESTR_otherPUBLIC:
1569           a = "PUBLIC";
1570           break;
1571
1572         case FFESTR_otherPRIVATE:
1573           a = "PRIVATE";
1574           break;
1575
1576         default:
1577           assert (FALSE);
1578         }
1579       fprintf (dmpout, "* TYPE,%s: %s\n", a, ffelex_token_text (name));
1580     }
1581 #endif
1582 }
1583
1584 /* ffestd_R425 -- End a TYPE
1585
1586    ffestd_R425(TRUE);  */
1587
1588 void
1589 ffestd_R425 (bool ok)
1590 {
1591 }
1592
1593 /* ffestd_R519_start -- INTENT statement list begin
1594
1595    ffestd_R519_start();
1596
1597    Verify that INTENT is valid here, and begin accepting items in the list.  */
1598
1599 void
1600 ffestd_R519_start (ffestrOther intent_kw)
1601 {
1602   ffestd_check_start_ ();
1603
1604   ffestd_subr_f90_ ();
1605   return;
1606
1607 #ifdef FFESTD_F90
1608   char *a;
1609
1610   switch (intent_kw)
1611     {
1612     case FFESTR_otherIN:
1613       a = "IN";
1614       break;
1615
1616     case FFESTR_otherOUT:
1617       a = "OUT";
1618       break;
1619
1620     case FFESTR_otherINOUT:
1621       a = "INOUT";
1622       break;
1623
1624     default:
1625       assert (FALSE);
1626     }
1627   fprintf (dmpout, "* INTENT (%s) ", a);
1628 #endif
1629 }
1630
1631 /* ffestd_R519_item -- INTENT statement for name
1632
1633    ffestd_R519_item(name_token);
1634
1635    Make sure name_token identifies a valid object to be INTENTed.  */
1636
1637 void
1638 ffestd_R519_item (ffelexToken name)
1639 {
1640   ffestd_check_item_ ();
1641
1642   return;                       /* F90. */
1643
1644 #ifdef FFESTD_F90
1645   fprintf (dmpout, "%s,", ffelex_token_text (name));
1646 #endif
1647 }
1648
1649 /* ffestd_R519_finish -- INTENT statement list complete
1650
1651    ffestd_R519_finish();
1652
1653    Just wrap up any local activities.  */
1654
1655 void
1656 ffestd_R519_finish ()
1657 {
1658   ffestd_check_finish_ ();
1659
1660   return;                       /* F90. */
1661
1662 #ifdef FFESTD_F90
1663   fputc ('\n', dmpout);
1664 #endif
1665 }
1666
1667 /* ffestd_R520_start -- OPTIONAL statement list begin
1668
1669    ffestd_R520_start();
1670
1671    Verify that OPTIONAL is valid here, and begin accepting items in the list.  */
1672
1673 void
1674 ffestd_R520_start ()
1675 {
1676   ffestd_check_start_ ();
1677
1678   ffestd_subr_f90_ ();
1679   return;
1680
1681 #ifdef FFESTD_F90
1682   fputs ("* OPTIONAL ", dmpout);
1683 #endif
1684 }
1685
1686 /* ffestd_R520_item -- OPTIONAL statement for name
1687
1688    ffestd_R520_item(name_token);
1689
1690    Make sure name_token identifies a valid object to be OPTIONALed.  */
1691
1692 void
1693 ffestd_R520_item (ffelexToken name)
1694 {
1695   ffestd_check_item_ ();
1696
1697   return;                       /* F90. */
1698
1699 #ifdef FFESTD_F90
1700   fprintf (dmpout, "%s,", ffelex_token_text (name));
1701 #endif
1702 }
1703
1704 /* ffestd_R520_finish -- OPTIONAL statement list complete
1705
1706    ffestd_R520_finish();
1707
1708    Just wrap up any local activities.  */
1709
1710 void
1711 ffestd_R520_finish ()
1712 {
1713   ffestd_check_finish_ ();
1714
1715   return;                       /* F90. */
1716
1717 #ifdef FFESTD_F90
1718   fputc ('\n', dmpout);
1719 #endif
1720 }
1721
1722 /* ffestd_R521A -- PUBLIC statement
1723
1724    ffestd_R521A();
1725
1726    Verify that PUBLIC is valid here.  */
1727
1728 void
1729 ffestd_R521A ()
1730 {
1731   ffestd_check_simple_ ();
1732
1733   ffestd_subr_f90_ ();
1734   return;
1735
1736 #ifdef FFESTD_F90
1737   fputs ("* PUBLIC\n", dmpout);
1738 #endif
1739 }
1740
1741 /* ffestd_R521Astart -- PUBLIC statement list begin
1742
1743    ffestd_R521Astart();
1744
1745    Verify that PUBLIC is valid here, and begin accepting items in the list.  */
1746
1747 void
1748 ffestd_R521Astart ()
1749 {
1750   ffestd_check_start_ ();
1751
1752   ffestd_subr_f90_ ();
1753   return;
1754
1755 #ifdef FFESTD_F90
1756   fputs ("* PUBLIC ", dmpout);
1757 #endif
1758 }
1759
1760 /* ffestd_R521Aitem -- PUBLIC statement for name
1761
1762    ffestd_R521Aitem(name_token);
1763
1764    Make sure name_token identifies a valid object to be PUBLICed.  */
1765
1766 void
1767 ffestd_R521Aitem (ffelexToken name)
1768 {
1769   ffestd_check_item_ ();
1770
1771   return;                       /* F90. */
1772
1773 #ifdef FFESTD_F90
1774   fprintf (dmpout, "%s,", ffelex_token_text (name));
1775 #endif
1776 }
1777
1778 /* ffestd_R521Afinish -- PUBLIC statement list complete
1779
1780    ffestd_R521Afinish();
1781
1782    Just wrap up any local activities.  */
1783
1784 void
1785 ffestd_R521Afinish ()
1786 {
1787   ffestd_check_finish_ ();
1788
1789   return;                       /* F90. */
1790
1791 #ifdef FFESTD_F90
1792   fputc ('\n', dmpout);
1793 #endif
1794 }
1795
1796 /* ffestd_R521B -- PRIVATE statement
1797
1798    ffestd_R521B();
1799
1800    Verify that PRIVATE is valid here (outside a derived-type statement).  */
1801
1802 void
1803 ffestd_R521B ()
1804 {
1805   ffestd_check_simple_ ();
1806
1807   ffestd_subr_f90_ ();
1808   return;
1809
1810 #ifdef FFESTD_F90
1811   fputs ("* PRIVATE_outside_of_R422_derived_type_def\n", dmpout);
1812 #endif
1813 }
1814
1815 /* ffestd_R521Bstart -- PRIVATE statement list begin
1816
1817    ffestd_R521Bstart();
1818
1819    Verify that PRIVATE is valid here, and begin accepting items in the list.  */
1820
1821 void
1822 ffestd_R521Bstart ()
1823 {
1824   ffestd_check_start_ ();
1825
1826   ffestd_subr_f90_ ();
1827   return;
1828
1829 #ifdef FFESTD_F90
1830   fputs ("* PRIVATE ", dmpout);
1831 #endif
1832 }
1833
1834 /* ffestd_R521Bitem -- PRIVATE statement for name
1835
1836    ffestd_R521Bitem(name_token);
1837
1838    Make sure name_token identifies a valid object to be PRIVATEed.  */
1839
1840 void
1841 ffestd_R521Bitem (ffelexToken name)
1842 {
1843   ffestd_check_item_ ();
1844
1845   return;                       /* F90. */
1846
1847 #ifdef FFESTD_F90
1848   fprintf (dmpout, "%s,", ffelex_token_text (name));
1849 #endif
1850 }
1851
1852 /* ffestd_R521Bfinish -- PRIVATE statement list complete
1853
1854    ffestd_R521Bfinish();
1855
1856    Just wrap up any local activities.  */
1857
1858 void
1859 ffestd_R521Bfinish ()
1860 {
1861   ffestd_check_finish_ ();
1862
1863   return;                       /* F90. */
1864
1865 #ifdef FFESTD_F90
1866   fputc ('\n', dmpout);
1867 #endif
1868 }
1869
1870 #endif
1871 /* ffestd_R522 -- SAVE statement with no list
1872
1873    ffestd_R522();
1874
1875    Verify that SAVE is valid here, and flag everything as SAVEd.  */
1876
1877 void
1878 ffestd_R522 ()
1879 {
1880   ffestd_check_simple_ ();
1881 }
1882
1883 /* ffestd_R522start -- SAVE statement list begin
1884
1885    ffestd_R522start();
1886
1887    Verify that SAVE is valid here, and begin accepting items in the list.  */
1888
1889 void
1890 ffestd_R522start ()
1891 {
1892   ffestd_check_start_ ();
1893 }
1894
1895 /* ffestd_R522item_object -- SAVE statement for object-name
1896
1897    ffestd_R522item_object(name_token);
1898
1899    Make sure name_token identifies a valid object to be SAVEd.  */
1900
1901 void
1902 ffestd_R522item_object (ffelexToken name UNUSED)
1903 {
1904   ffestd_check_item_ ();
1905 }
1906
1907 /* ffestd_R522item_cblock -- SAVE statement for common-block-name
1908
1909    ffestd_R522item_cblock(name_token);
1910
1911    Make sure name_token identifies a valid common block to be SAVEd.  */
1912
1913 void
1914 ffestd_R522item_cblock (ffelexToken name UNUSED)
1915 {
1916   ffestd_check_item_ ();
1917 }
1918
1919 /* ffestd_R522finish -- SAVE statement list complete
1920
1921    ffestd_R522finish();
1922
1923    Just wrap up any local activities.  */
1924
1925 void
1926 ffestd_R522finish ()
1927 {
1928   ffestd_check_finish_ ();
1929 }
1930
1931 /* ffestd_R524_start -- DIMENSION statement list begin
1932
1933    ffestd_R524_start(bool virtual);
1934
1935    Verify that DIMENSION is valid here, and begin accepting items in the list.  */
1936
1937 void
1938 ffestd_R524_start (bool virtual UNUSED)
1939 {
1940   ffestd_check_start_ ();
1941 }
1942
1943 /* ffestd_R524_item -- DIMENSION statement for object-name
1944
1945    ffestd_R524_item(name_token,dim_list);
1946
1947    Make sure name_token identifies a valid object to be DIMENSIONd.  */
1948
1949 void
1950 ffestd_R524_item (ffelexToken name UNUSED, ffesttDimList dims UNUSED)
1951 {
1952   ffestd_check_item_ ();
1953 }
1954
1955 /* ffestd_R524_finish -- DIMENSION statement list complete
1956
1957    ffestd_R524_finish();
1958
1959    Just wrap up any local activities.  */
1960
1961 void
1962 ffestd_R524_finish ()
1963 {
1964   ffestd_check_finish_ ();
1965 }
1966
1967 /* ffestd_R525_start -- ALLOCATABLE statement list begin
1968
1969    ffestd_R525_start();
1970
1971    Verify that ALLOCATABLE is valid here, and begin accepting items in the
1972    list.  */
1973
1974 #if FFESTR_F90
1975 void
1976 ffestd_R525_start ()
1977 {
1978   ffestd_check_start_ ();
1979
1980   ffestd_subr_f90_ ();
1981   return;
1982
1983 #ifdef FFESTD_F90
1984   fputs ("* ALLOCATABLE ", dmpout);
1985 #endif
1986 }
1987
1988 /* ffestd_R525_item -- ALLOCATABLE statement for object-name
1989
1990    ffestd_R525_item(name_token,dim_list);
1991
1992    Make sure name_token identifies a valid object to be ALLOCATABLEd.  */
1993
1994 void
1995 ffestd_R525_item (ffelexToken name, ffesttDimList dims)
1996 {
1997   ffestd_check_item_ ();
1998
1999   return;                       /* F90. */
2000
2001 #ifdef FFESTD_F90
2002   fputs (ffelex_token_text (name), dmpout);
2003   if (dims != NULL)
2004     {
2005       fputc ('(', dmpout);
2006       ffestt_dimlist_dump (dims);
2007       fputc (')', dmpout);
2008     }
2009   fputc (',', dmpout);
2010 #endif
2011 }
2012
2013 /* ffestd_R525_finish -- ALLOCATABLE statement list complete
2014
2015    ffestd_R525_finish();
2016
2017    Just wrap up any local activities.  */
2018
2019 void
2020 ffestd_R525_finish ()
2021 {
2022   ffestd_check_finish_ ();
2023
2024   return;                       /* F90. */
2025
2026 #ifdef FFESTD_F90
2027   fputc ('\n', dmpout);
2028 #endif
2029 }
2030
2031 /* ffestd_R526_start -- POINTER statement list begin
2032
2033    ffestd_R526_start();
2034
2035    Verify that POINTER is valid here, and begin accepting items in the
2036    list.  */
2037
2038 void
2039 ffestd_R526_start ()
2040 {
2041   ffestd_check_start_ ();
2042
2043   ffestd_subr_f90_ ();
2044   return;
2045
2046 #ifdef FFESTD_F90
2047   fputs ("* POINTER ", dmpout);
2048 #endif
2049 }
2050
2051 /* ffestd_R526_item -- POINTER statement for object-name
2052
2053    ffestd_R526_item(name_token,dim_list);
2054
2055    Make sure name_token identifies a valid object to be POINTERd.  */
2056
2057 void
2058 ffestd_R526_item (ffelexToken name, ffesttDimList dims)
2059 {
2060   ffestd_check_item_ ();
2061
2062   return;                       /* F90. */
2063
2064 #ifdef FFESTD_F90
2065   fputs (ffelex_token_text (name), dmpout);
2066   if (dims != NULL)
2067     {
2068       fputc ('(', dmpout);
2069       ffestt_dimlist_dump (dims);
2070       fputc (')', dmpout);
2071     }
2072   fputc (',', dmpout);
2073 #endif
2074 }
2075
2076 /* ffestd_R526_finish -- POINTER statement list complete
2077
2078    ffestd_R526_finish();
2079
2080    Just wrap up any local activities.  */
2081
2082 void
2083 ffestd_R526_finish ()
2084 {
2085   ffestd_check_finish_ ();
2086
2087   return;                       /* F90. */
2088
2089 #ifdef FFESTD_F90
2090   fputc ('\n', dmpout);
2091 #endif
2092 }
2093
2094 /* ffestd_R527_start -- TARGET statement list begin
2095
2096    ffestd_R527_start();
2097
2098    Verify that TARGET is valid here, and begin accepting items in the
2099    list.  */
2100
2101 void
2102 ffestd_R527_start ()
2103 {
2104   ffestd_check_start_ ();
2105
2106   ffestd_subr_f90_ ();
2107   return;
2108
2109 #ifdef FFESTD_F90
2110   fputs ("* TARGET ", dmpout);
2111 #endif
2112 }
2113
2114 /* ffestd_R527_item -- TARGET statement for object-name
2115
2116    ffestd_R527_item(name_token,dim_list);
2117
2118    Make sure name_token identifies a valid object to be TARGETd.  */
2119
2120 void
2121 ffestd_R527_item (ffelexToken name, ffesttDimList dims)
2122 {
2123   ffestd_check_item_ ();
2124
2125   return;                       /* F90. */
2126
2127 #ifdef FFESTD_F90
2128   fputs (ffelex_token_text (name), dmpout);
2129   if (dims != NULL)
2130     {
2131       fputc ('(', dmpout);
2132       ffestt_dimlist_dump (dims);
2133       fputc (')', dmpout);
2134     }
2135   fputc (',', dmpout);
2136 #endif
2137 }
2138
2139 /* ffestd_R527_finish -- TARGET statement list complete
2140
2141    ffestd_R527_finish();
2142
2143    Just wrap up any local activities.  */
2144
2145 void
2146 ffestd_R527_finish ()
2147 {
2148   ffestd_check_finish_ ();
2149
2150   return;                       /* F90. */
2151
2152 #ifdef FFESTD_F90
2153   fputc ('\n', dmpout);
2154 #endif
2155 }
2156
2157 #endif
2158 /* ffestd_R537_start -- PARAMETER statement list begin
2159
2160    ffestd_R537_start();
2161
2162    Verify that PARAMETER is valid here, and begin accepting items in the list.  */
2163
2164 void
2165 ffestd_R537_start ()
2166 {
2167   ffestd_check_start_ ();
2168 }
2169
2170 /* ffestd_R537_item -- PARAMETER statement assignment
2171
2172    ffestd_R537_item(dest,dest_token,source,source_token);
2173
2174    Make sure the source is a valid source for the destination; make the
2175    assignment.  */
2176
2177 void
2178 ffestd_R537_item (ffebld dest UNUSED, ffebld source UNUSED)
2179 {
2180   ffestd_check_item_ ();
2181 }
2182
2183 /* ffestd_R537_finish -- PARAMETER statement list complete
2184
2185    ffestd_R537_finish();
2186
2187    Just wrap up any local activities.  */
2188
2189 void
2190 ffestd_R537_finish ()
2191 {
2192   ffestd_check_finish_ ();
2193 }
2194
2195 /* ffestd_R539 -- IMPLICIT NONE statement
2196
2197    ffestd_R539();
2198
2199    Verify that the IMPLICIT NONE statement is ok here and implement.  */
2200
2201 void
2202 ffestd_R539 ()
2203 {
2204   ffestd_check_simple_ ();
2205 }
2206
2207 /* ffestd_R539start -- IMPLICIT statement
2208
2209    ffestd_R539start();
2210
2211    Verify that the IMPLICIT statement is ok here and implement.  */
2212
2213 void
2214 ffestd_R539start ()
2215 {
2216   ffestd_check_start_ ();
2217 }
2218
2219 /* ffestd_R539item -- IMPLICIT statement specification (R540)
2220
2221    ffestd_R539item(...);
2222
2223    Verify that the type and letter list are all ok and implement.  */
2224
2225 void
2226 ffestd_R539item (ffestpType type UNUSED, ffebld kind UNUSED,
2227                  ffelexToken kindt UNUSED, ffebld len UNUSED,
2228                  ffelexToken lent UNUSED, ffesttImpList letters UNUSED)
2229 {
2230   ffestd_check_item_ ();
2231 }
2232
2233 /* ffestd_R539finish -- IMPLICIT statement
2234
2235    ffestd_R539finish();
2236
2237    Finish up any local activities.  */
2238
2239 void
2240 ffestd_R539finish ()
2241 {
2242   ffestd_check_finish_ ();
2243 }
2244
2245 /* ffestd_R542_start -- NAMELIST statement list begin
2246
2247    ffestd_R542_start();
2248
2249    Verify that NAMELIST is valid here, and begin accepting items in the list.  */
2250
2251 void
2252 ffestd_R542_start ()
2253 {
2254   ffestd_check_start_ ();
2255 }
2256
2257 /* ffestd_R542_item_nlist -- NAMELIST statement for group-name
2258
2259    ffestd_R542_item_nlist(groupname_token);
2260
2261    Make sure name_token identifies a valid object to be NAMELISTd.  */
2262
2263 void
2264 ffestd_R542_item_nlist (ffelexToken name UNUSED)
2265 {
2266   ffestd_check_item_ ();
2267 }
2268
2269 /* ffestd_R542_item_nitem -- NAMELIST statement for variable-name
2270
2271    ffestd_R542_item_nitem(name_token);
2272
2273    Make sure name_token identifies a valid object to be NAMELISTd.  */
2274
2275 void
2276 ffestd_R542_item_nitem (ffelexToken name UNUSED)
2277 {
2278   ffestd_check_item_ ();
2279 }
2280
2281 /* ffestd_R542_finish -- NAMELIST statement list complete
2282
2283    ffestd_R542_finish();
2284
2285    Just wrap up any local activities.  */
2286
2287 void
2288 ffestd_R542_finish ()
2289 {
2290   ffestd_check_finish_ ();
2291 }
2292
2293 /* ffestd_R544_start -- EQUIVALENCE statement list begin
2294
2295    ffestd_R544_start();
2296
2297    Verify that EQUIVALENCE is valid here, and begin accepting items in the
2298    list.  */
2299
2300 #if 0
2301 void
2302 ffestd_R544_start ()
2303 {
2304   ffestd_check_start_ ();
2305 }
2306
2307 #endif
2308 /* ffestd_R544_item -- EQUIVALENCE statement assignment
2309
2310    ffestd_R544_item(exprlist);
2311
2312    Make sure the equivalence is valid, then implement it.  */
2313
2314 #if 0
2315 void
2316 ffestd_R544_item (ffesttExprList exprlist)
2317 {
2318   ffestd_check_item_ ();
2319 }
2320
2321 #endif
2322 /* ffestd_R544_finish -- EQUIVALENCE statement list complete
2323
2324    ffestd_R544_finish();
2325
2326    Just wrap up any local activities.  */
2327
2328 #if 0
2329 void
2330 ffestd_R544_finish ()
2331 {
2332   ffestd_check_finish_ ();
2333 }
2334
2335 #endif
2336 /* ffestd_R547_start -- COMMON statement list begin
2337
2338    ffestd_R547_start();
2339
2340    Verify that COMMON is valid here, and begin accepting items in the list.  */
2341
2342 void
2343 ffestd_R547_start ()
2344 {
2345   ffestd_check_start_ ();
2346 }
2347
2348 /* ffestd_R547_item_object -- COMMON statement for object-name
2349
2350    ffestd_R547_item_object(name_token,dim_list);
2351
2352    Make sure name_token identifies a valid object to be COMMONd.  */
2353
2354 void
2355 ffestd_R547_item_object (ffelexToken name UNUSED,
2356                          ffesttDimList dims UNUSED)
2357 {
2358   ffestd_check_item_ ();
2359 }
2360
2361 /* ffestd_R547_item_cblock -- COMMON statement for common-block-name
2362
2363    ffestd_R547_item_cblock(name_token);
2364
2365    Make sure name_token identifies a valid common block to be COMMONd.  */
2366
2367 void
2368 ffestd_R547_item_cblock (ffelexToken name UNUSED)
2369 {
2370   ffestd_check_item_ ();
2371 }
2372
2373 /* ffestd_R547_finish -- COMMON statement list complete
2374
2375    ffestd_R547_finish();
2376
2377    Just wrap up any local activities.  */
2378
2379 void
2380 ffestd_R547_finish ()
2381 {
2382   ffestd_check_finish_ ();
2383 }
2384
2385 /* ffestd_R620 -- ALLOCATE statement
2386
2387    ffestd_R620(exprlist,stat,stat_token);
2388
2389    Make sure the expression list is valid, then implement it.  */
2390
2391 #if FFESTR_F90
2392 void
2393 ffestd_R620 (ffesttExprList exprlist, ffebld stat)
2394 {
2395   ffestd_check_simple_ ();
2396
2397   ffestd_subr_f90_ ();
2398 }
2399
2400 /* ffestd_R624 -- NULLIFY statement
2401
2402    ffestd_R624(pointer_name_list);
2403
2404    Make sure pointer_name_list identifies valid pointers for a NULLIFY.  */
2405
2406 void
2407 ffestd_R624 (ffesttExprList pointers)
2408 {
2409   ffestd_check_simple_ ();
2410
2411   ffestd_subr_f90_ ();
2412   return;
2413
2414 #ifdef FFESTD_F90
2415   fputs ("+ NULLIFY (", dmpout);
2416   assert (pointers != NULL);
2417   ffestt_exprlist_dump (pointers);
2418   fputs (")\n", dmpout);
2419 #endif
2420 }
2421
2422 /* ffestd_R625 -- DEALLOCATE statement
2423
2424    ffestd_R625(exprlist,stat,stat_token);
2425
2426    Make sure the equivalence is valid, then implement it.  */
2427
2428 void
2429 ffestd_R625 (ffesttExprList exprlist, ffebld stat)
2430 {
2431   ffestd_check_simple_ ();
2432
2433   ffestd_subr_f90_ ();
2434 }
2435
2436 #endif
2437 /* ffestd_R737A -- Assignment statement outside of WHERE
2438
2439    ffestd_R737A(dest_expr,source_expr);  */
2440
2441 void
2442 ffestd_R737A (ffebld dest, ffebld source)
2443 {
2444   ffestdStmt_ stmt;
2445
2446   ffestd_check_simple_ ();
2447
2448   stmt = ffestd_stmt_new_ (FFESTD_stmtidR737A_);
2449   ffestd_stmt_append_ (stmt);
2450   ffestd_subr_line_save_ (stmt);
2451   stmt->u.R737A.pool = ffesta_output_pool;
2452   stmt->u.R737A.dest = dest;
2453   stmt->u.R737A.source = source;
2454   ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
2455 }
2456
2457 /* ffestd_R737B -- Assignment statement inside of WHERE
2458
2459    ffestd_R737B(dest_expr,source_expr);  */
2460
2461 #if FFESTR_F90
2462 void
2463 ffestd_R737B (ffebld dest, ffebld source)
2464 {
2465   ffestd_check_simple_ ();
2466 }
2467
2468 /* ffestd_R738 -- Pointer assignment statement
2469
2470    ffestd_R738(dest_expr,source_expr,source_token);
2471
2472    Make sure the assignment is valid.  */
2473
2474 void
2475 ffestd_R738 (ffebld dest, ffebld source)
2476 {
2477   ffestd_check_simple_ ();
2478
2479   ffestd_subr_f90_ ();
2480 }
2481
2482 /* ffestd_R740 -- WHERE statement
2483
2484    ffestd_R740(expr,expr_token);
2485
2486    Make sure statement is valid here; implement.  */
2487
2488 void
2489 ffestd_R740 (ffebld expr)
2490 {
2491   ffestd_check_simple_ ();
2492
2493   ffestd_subr_f90_ ();
2494 }
2495
2496 /* ffestd_R742 -- WHERE-construct statement
2497
2498    ffestd_R742(expr,expr_token);
2499
2500    Make sure statement is valid here; implement.  */
2501
2502 void
2503 ffestd_R742 (ffebld expr)
2504 {
2505   ffestd_check_simple_ ();
2506
2507   ffestd_subr_f90_ ();
2508 }
2509
2510 /* ffestd_R744 -- ELSE WHERE statement
2511
2512    ffestd_R744();
2513
2514    Make sure ffestd_kind_ identifies a WHERE block.
2515    Implement the ELSE of the current WHERE block.  */
2516
2517 void
2518 ffestd_R744 ()
2519 {
2520   ffestd_check_simple_ ();
2521
2522   return;                       /* F90. */
2523
2524 #ifdef FFESTD_F90
2525   fputs ("+ ELSE_WHERE\n", dmpout);
2526 #endif
2527 }
2528
2529 /* ffestd_R745 -- Implicit END WHERE statement.  */
2530
2531 void
2532 ffestd_R745 (bool ok)
2533 {
2534   return;                       /* F90. */
2535
2536 #ifdef FFESTD_F90
2537   fputs ("+ END_WHERE\n", dmpout);      /* Also see ffestd_R745. */
2538
2539   --ffestd_block_level_;
2540   assert (ffestd_block_level_ >= 0);
2541 #endif
2542 }
2543
2544 #endif
2545
2546 /* Block IF (IF-THEN) statement.  */
2547
2548 void
2549 ffestd_R803 (ffelexToken construct_name UNUSED, ffebld expr)
2550 {
2551   ffestdStmt_ stmt;
2552
2553   ffestd_check_simple_ ();
2554
2555   stmt = ffestd_stmt_new_ (FFESTD_stmtidR803_);
2556   ffestd_stmt_append_ (stmt);
2557   ffestd_subr_line_save_ (stmt);
2558   stmt->u.R803.pool = ffesta_output_pool;
2559   stmt->u.R803.block = ffestw_use (ffestw_stack_top ());
2560   stmt->u.R803.expr = expr;
2561   ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
2562
2563   ++ffestd_block_level_;
2564   assert (ffestd_block_level_ > 0);
2565 }
2566
2567 /* ELSE IF statement.  */
2568
2569 void
2570 ffestd_R804 (ffebld expr, ffelexToken name UNUSED)
2571 {
2572   ffestdStmt_ stmt;
2573
2574   ffestd_check_simple_ ();
2575
2576   stmt = ffestd_stmt_new_ (FFESTD_stmtidR804_);
2577   ffestd_stmt_append_ (stmt);
2578   ffestd_subr_line_save_ (stmt);
2579   stmt->u.R804.pool = ffesta_output_pool;
2580   stmt->u.R804.block = ffestw_use (ffestw_stack_top ());
2581   stmt->u.R804.expr = expr;
2582   ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
2583 }
2584
2585 /* ELSE statement.  */
2586
2587 void
2588 ffestd_R805 (ffelexToken name UNUSED)
2589 {
2590   ffestdStmt_ stmt;
2591
2592   ffestd_check_simple_ ();
2593
2594   stmt = ffestd_stmt_new_ (FFESTD_stmtidR805_);
2595   ffestd_stmt_append_ (stmt);
2596   ffestd_subr_line_save_ (stmt);
2597   stmt->u.R805.block = ffestw_use (ffestw_stack_top ());
2598 }
2599
2600 /* END IF statement.  */
2601
2602 void
2603 ffestd_R806 (bool ok UNUSED)
2604 {
2605   ffestdStmt_ stmt;
2606
2607   stmt = ffestd_stmt_new_ (FFESTD_stmtidR806_);
2608   ffestd_stmt_append_ (stmt);
2609   ffestd_subr_line_save_ (stmt);
2610   stmt->u.R806.block = ffestw_use (ffestw_stack_top ());
2611
2612   --ffestd_block_level_;
2613   assert (ffestd_block_level_ >= 0);
2614 }
2615
2616 /* ffestd_R807 -- Logical IF statement
2617
2618    ffestd_R807(expr,expr_token);
2619
2620    Make sure statement is valid here; implement.  */
2621
2622 void
2623 ffestd_R807 (ffebld expr)
2624 {
2625   ffestdStmt_ stmt;
2626
2627   ffestd_check_simple_ ();
2628
2629   stmt = ffestd_stmt_new_ (FFESTD_stmtidR807_);
2630   ffestd_stmt_append_ (stmt);
2631   ffestd_subr_line_save_ (stmt);
2632   stmt->u.R807.pool = ffesta_output_pool;
2633   stmt->u.R807.expr = expr;
2634   ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
2635
2636   ++ffestd_block_level_;
2637   assert (ffestd_block_level_ > 0);
2638 }
2639
2640 /* ffestd_R809 -- SELECT CASE statement
2641
2642    ffestd_R809(construct_name,expr,expr_token);
2643
2644    Make sure statement is valid here; implement.  */
2645
2646 void
2647 ffestd_R809 (ffelexToken construct_name UNUSED, ffebld expr)
2648 {
2649   ffestdStmt_ stmt;
2650
2651   ffestd_check_simple_ ();
2652
2653   stmt = ffestd_stmt_new_ (FFESTD_stmtidR809_);
2654   ffestd_stmt_append_ (stmt);
2655   ffestd_subr_line_save_ (stmt);
2656   stmt->u.R809.pool = ffesta_output_pool;
2657   stmt->u.R809.block = ffestw_use (ffestw_stack_top ());
2658   stmt->u.R809.expr = expr;
2659   ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
2660   malloc_pool_use (ffestw_select (ffestw_stack_top ())->pool);
2661
2662   ++ffestd_block_level_;
2663   assert (ffestd_block_level_ > 0);
2664 }
2665
2666 /* ffestd_R810 -- CASE statement
2667
2668    ffestd_R810(case_value_range_list,name);
2669
2670    If casenum is 0, it's CASE DEFAULT.  Else it's the case ranges at
2671    the start of the first_stmt list in the select object at the top of
2672    the stack that match casenum.  */
2673
2674 void
2675 ffestd_R810 (unsigned long casenum)
2676 {
2677   ffestdStmt_ stmt;
2678
2679   ffestd_check_simple_ ();
2680
2681   stmt = ffestd_stmt_new_ (FFESTD_stmtidR810_);
2682   ffestd_stmt_append_ (stmt);
2683   ffestd_subr_line_save_ (stmt);
2684   stmt->u.R810.pool = ffesta_output_pool;
2685   stmt->u.R810.block = ffestw_stack_top ();
2686   stmt->u.R810.casenum = casenum;
2687   ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
2688 }
2689
2690 /* ffestd_R811 -- End a SELECT
2691
2692    ffestd_R811(TRUE);  */
2693
2694 void
2695 ffestd_R811 (bool ok UNUSED)
2696 {
2697   ffestdStmt_ stmt;
2698
2699   stmt = ffestd_stmt_new_ (FFESTD_stmtidR811_);
2700   ffestd_stmt_append_ (stmt);
2701   ffestd_subr_line_save_ (stmt);
2702   stmt->u.R811.block = ffestw_stack_top ();
2703
2704   --ffestd_block_level_;
2705   assert (ffestd_block_level_ >= 0);
2706 }
2707
2708 /* ffestd_R819A -- Iterative DO statement
2709
2710    ffestd_R819A(construct_name,label_token,expr,expr_token);
2711
2712    Make sure statement is valid here; implement.  */
2713
2714 void
2715 ffestd_R819A (ffelexToken construct_name UNUSED, ffelab label,
2716               ffebld var, ffebld start, ffelexToken start_token,
2717               ffebld end, ffelexToken end_token,
2718               ffebld incr, ffelexToken incr_token)
2719 {
2720   ffestdStmt_ stmt;
2721
2722   ffestd_check_simple_ ();
2723
2724   stmt = ffestd_stmt_new_ (FFESTD_stmtidR819A_);
2725   ffestd_stmt_append_ (stmt);
2726   ffestd_subr_line_save_ (stmt);
2727   stmt->u.R819A.pool = ffesta_output_pool;
2728   stmt->u.R819A.block = ffestw_use (ffestw_stack_top ());
2729   stmt->u.R819A.label = label;
2730   stmt->u.R819A.var = var;
2731   stmt->u.R819A.start = start;
2732   stmt->u.R819A.start_token = ffelex_token_use (start_token);
2733   stmt->u.R819A.end = end;
2734   stmt->u.R819A.end_token = ffelex_token_use (end_token);
2735   stmt->u.R819A.incr = incr;
2736   stmt->u.R819A.incr_token = (incr_token == NULL) ? NULL
2737     : ffelex_token_use (incr_token);
2738   ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
2739
2740   ++ffestd_block_level_;
2741   assert (ffestd_block_level_ > 0);
2742 }
2743
2744 /* ffestd_R819B -- DO WHILE statement
2745
2746    ffestd_R819B(construct_name,label_token,expr,expr_token);
2747
2748    Make sure statement is valid here; implement.  */
2749
2750 void
2751 ffestd_R819B (ffelexToken construct_name UNUSED, ffelab label,
2752               ffebld expr)
2753 {
2754   ffestdStmt_ stmt;
2755
2756   ffestd_check_simple_ ();
2757
2758   stmt = ffestd_stmt_new_ (FFESTD_stmtidR819B_);
2759   ffestd_stmt_append_ (stmt);
2760   ffestd_subr_line_save_ (stmt);
2761   stmt->u.R819B.pool = ffesta_output_pool;
2762   stmt->u.R819B.block = ffestw_use (ffestw_stack_top ());
2763   stmt->u.R819B.label = label;
2764   stmt->u.R819B.expr = expr;
2765   ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
2766
2767   ++ffestd_block_level_;
2768   assert (ffestd_block_level_ > 0);
2769 }
2770
2771 /* ffestd_R825 -- END DO statement
2772
2773    ffestd_R825(name_token);
2774
2775    Make sure ffestd_kind_ identifies a DO block.  If not
2776    NULL, make sure name_token gives the correct name.  Do whatever
2777    is specific to seeing END DO with a DO-target label definition on it,
2778    where the END DO is really treated as a CONTINUE (i.e. generate th
2779    same code you would for CONTINUE).  ffestd_do handles the actual
2780    generation of end-loop code.  */
2781
2782 void
2783 ffestd_R825 (ffelexToken name UNUSED)
2784 {
2785   ffestdStmt_ stmt;
2786
2787   ffestd_check_simple_ ();
2788
2789   stmt = ffestd_stmt_new_ (FFESTD_stmtidR825_);
2790   ffestd_stmt_append_ (stmt);
2791   ffestd_subr_line_save_ (stmt);
2792 }
2793
2794 /* ffestd_R834 -- CYCLE statement
2795
2796    ffestd_R834(name_token);
2797
2798    Handle a CYCLE within a loop.  */
2799
2800 void
2801 ffestd_R834 (ffestw block)
2802 {
2803   ffestdStmt_ stmt;
2804
2805   ffestd_check_simple_ ();
2806
2807   stmt = ffestd_stmt_new_ (FFESTD_stmtidR834_);
2808   ffestd_stmt_append_ (stmt);
2809   ffestd_subr_line_save_ (stmt);
2810   stmt->u.R834.block = block;
2811 }
2812
2813 /* ffestd_R835 -- EXIT statement
2814
2815    ffestd_R835(name_token);
2816
2817    Handle a EXIT within a loop.  */
2818
2819 void
2820 ffestd_R835 (ffestw block)
2821 {
2822   ffestdStmt_ stmt;
2823
2824   ffestd_check_simple_ ();
2825
2826   stmt = ffestd_stmt_new_ (FFESTD_stmtidR835_);
2827   ffestd_stmt_append_ (stmt);
2828   ffestd_subr_line_save_ (stmt);
2829   stmt->u.R835.block = block;
2830 }
2831
2832 /* ffestd_R836 -- GOTO statement
2833
2834    ffestd_R836(label);
2835
2836    Make sure label_token identifies a valid label for a GOTO.  Update
2837    that label's info to indicate it is the target of a GOTO.  */
2838
2839 void
2840 ffestd_R836 (ffelab label)
2841 {
2842   ffestdStmt_ stmt;
2843
2844   ffestd_check_simple_ ();
2845
2846   stmt = ffestd_stmt_new_ (FFESTD_stmtidR836_);
2847   ffestd_stmt_append_ (stmt);
2848   ffestd_subr_line_save_ (stmt);
2849   stmt->u.R836.label = label;
2850
2851   if (ffestd_block_level_ == 0)
2852     ffestd_is_reachable_ = FALSE;
2853 }
2854
2855 /* ffestd_R837 -- Computed GOTO statement
2856
2857    ffestd_R837(labels,expr);
2858
2859    Make sure label_list identifies valid labels for a GOTO.  Update
2860    each label's info to indicate it is the target of a GOTO.  */
2861
2862 void
2863 ffestd_R837 (ffelab *labels, int count, ffebld expr)
2864 {
2865   ffestdStmt_ stmt;
2866
2867   ffestd_check_simple_ ();
2868
2869   stmt = ffestd_stmt_new_ (FFESTD_stmtidR837_);
2870   ffestd_stmt_append_ (stmt);
2871   ffestd_subr_line_save_ (stmt);
2872   stmt->u.R837.pool = ffesta_output_pool;
2873   stmt->u.R837.labels = labels;
2874   stmt->u.R837.count = count;
2875   stmt->u.R837.expr = expr;
2876   ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
2877 }
2878
2879 /* ffestd_R838 -- ASSIGN statement
2880
2881    ffestd_R838(label_token,target_variable,target_token);
2882
2883    Make sure label_token identifies a valid label for an assignment.  Update
2884    that label's info to indicate it is the source of an assignment.  Update
2885    target_variable's info to indicate it is the target the assignment of that
2886    label.  */
2887
2888 void
2889 ffestd_R838 (ffelab label, ffebld target)
2890 {
2891   ffestdStmt_ stmt;
2892
2893   ffestd_check_simple_ ();
2894
2895   stmt = ffestd_stmt_new_ (FFESTD_stmtidR838_);
2896   ffestd_stmt_append_ (stmt);
2897   ffestd_subr_line_save_ (stmt);
2898   stmt->u.R838.pool = ffesta_output_pool;
2899   stmt->u.R838.label = label;
2900   stmt->u.R838.target = target;
2901   ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
2902 }
2903
2904 /* ffestd_R839 -- Assigned GOTO statement
2905
2906    ffestd_R839(target,labels);
2907
2908    Make sure label_list identifies valid labels for a GOTO.  Update
2909    each label's info to indicate it is the target of a GOTO.  */
2910
2911 void
2912 ffestd_R839 (ffebld target, ffelab *labels UNUSED, int count UNUSED)
2913 {
2914   ffestdStmt_ stmt;
2915
2916   ffestd_check_simple_ ();
2917
2918   stmt = ffestd_stmt_new_ (FFESTD_stmtidR839_);
2919   ffestd_stmt_append_ (stmt);
2920   ffestd_subr_line_save_ (stmt);
2921   stmt->u.R839.pool = ffesta_output_pool;
2922   stmt->u.R839.target = target;
2923   ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
2924
2925   if (ffestd_block_level_ == 0)
2926     ffestd_is_reachable_ = FALSE;
2927 }
2928
2929 /* ffestd_R840 -- Arithmetic IF statement
2930
2931    ffestd_R840(expr,expr_token,neg,zero,pos);
2932
2933    Make sure the labels are valid; implement.  */
2934
2935 void
2936 ffestd_R840 (ffebld expr, ffelab neg, ffelab zero, ffelab pos)
2937 {
2938   ffestdStmt_ stmt;
2939
2940   ffestd_check_simple_ ();
2941
2942   stmt = ffestd_stmt_new_ (FFESTD_stmtidR840_);
2943   ffestd_stmt_append_ (stmt);
2944   ffestd_subr_line_save_ (stmt);
2945   stmt->u.R840.pool = ffesta_output_pool;
2946   stmt->u.R840.expr = expr;
2947   stmt->u.R840.neg = neg;
2948   stmt->u.R840.zero = zero;
2949   stmt->u.R840.pos = pos;
2950   ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
2951
2952   if (ffestd_block_level_ == 0)
2953     ffestd_is_reachable_ = FALSE;
2954 }
2955
2956 /* ffestd_R841 -- CONTINUE statement
2957
2958    ffestd_R841();  */
2959
2960 void
2961 ffestd_R841 (bool in_where UNUSED)
2962 {
2963   ffestdStmt_ stmt;
2964
2965   ffestd_check_simple_ ();
2966
2967   stmt = ffestd_stmt_new_ (FFESTD_stmtidR841_);
2968   ffestd_stmt_append_ (stmt);
2969   ffestd_subr_line_save_ (stmt);
2970 }
2971
2972 /* ffestd_R842 -- STOP statement
2973
2974    ffestd_R842(expr);  */
2975
2976 void
2977 ffestd_R842 (ffebld expr)
2978 {
2979   ffestdStmt_ stmt;
2980
2981   ffestd_check_simple_ ();
2982
2983   stmt = ffestd_stmt_new_ (FFESTD_stmtidR842_);
2984   ffestd_stmt_append_ (stmt);
2985   ffestd_subr_line_save_ (stmt);
2986   if (ffesta_outpooldisp () == FFESTA_pooldispPRESERVE)
2987     {
2988       /* This is a "spurious" (automatically-generated) STOP
2989          that follows a previous STOP or other statement.
2990          Make sure we don't have an expression in the pool,
2991          and then mark that the pool has already been killed.  */
2992       assert (expr == NULL);
2993       stmt->u.R842.pool = NULL;
2994       stmt->u.R842.expr = NULL;
2995     }
2996   else
2997     {
2998       stmt->u.R842.pool = ffesta_output_pool;
2999       stmt->u.R842.expr = expr;
3000       ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3001     }
3002
3003   if (ffestd_block_level_ == 0)
3004     ffestd_is_reachable_ = FALSE;
3005 }
3006
3007 /* ffestd_R843 -- PAUSE statement
3008
3009    ffestd_R843(expr,expr_token);
3010
3011    Make sure statement is valid here; implement.  expr and expr_token are
3012    both NULL if there was no expression.  */
3013
3014 void
3015 ffestd_R843 (ffebld expr)
3016 {
3017   ffestdStmt_ stmt;
3018
3019   ffestd_check_simple_ ();
3020
3021   stmt = ffestd_stmt_new_ (FFESTD_stmtidR843_);
3022   ffestd_stmt_append_ (stmt);
3023   ffestd_subr_line_save_ (stmt);
3024   stmt->u.R843.pool = ffesta_output_pool;
3025   stmt->u.R843.expr = expr;
3026   ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3027 }
3028
3029 /* ffestd_R904 -- OPEN statement
3030
3031    ffestd_R904();
3032
3033    Make sure an OPEN is valid in the current context, and implement it.  */
3034
3035 void
3036 ffestd_R904 ()
3037 {
3038   ffestdStmt_ stmt;
3039
3040   ffestd_check_simple_ ();
3041
3042 #define specified(something) \
3043       (ffestp_file.open.open_spec[something].kw_or_val_present)
3044
3045   /* Warn if there are any thing we don't handle via f2c libraries. */
3046
3047   if (specified (FFESTP_openixACTION)
3048       || specified (FFESTP_openixASSOCIATEVARIABLE)
3049       || specified (FFESTP_openixBLOCKSIZE)
3050       || specified (FFESTP_openixBUFFERCOUNT)
3051       || specified (FFESTP_openixCARRIAGECONTROL)
3052       || specified (FFESTP_openixDEFAULTFILE)
3053       || specified (FFESTP_openixDELIM)
3054       || specified (FFESTP_openixDISPOSE)
3055       || specified (FFESTP_openixEXTENDSIZE)
3056       || specified (FFESTP_openixINITIALSIZE)
3057       || specified (FFESTP_openixKEY)
3058       || specified (FFESTP_openixMAXREC)
3059       || specified (FFESTP_openixNOSPANBLOCKS)
3060       || specified (FFESTP_openixORGANIZATION)
3061       || specified (FFESTP_openixPAD)
3062       || specified (FFESTP_openixPOSITION)
3063       || specified (FFESTP_openixREADONLY)
3064       || specified (FFESTP_openixRECORDTYPE)
3065       || specified (FFESTP_openixSHARED)
3066       || specified (FFESTP_openixUSEROPEN))
3067     {
3068       ffebad_start (FFEBAD_OPEN_UNSUPPORTED);
3069       ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
3070                    ffelex_token_where_column (ffesta_tokens[0]));
3071       ffebad_finish ();
3072     }
3073
3074 #undef specified
3075
3076   stmt = ffestd_stmt_new_ (FFESTD_stmtidR904_);
3077   ffestd_stmt_append_ (stmt);
3078   ffestd_subr_line_save_ (stmt);
3079   stmt->u.R904.pool = ffesta_output_pool;
3080   stmt->u.R904.params = ffestd_subr_copy_open_ ();
3081   ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3082 }
3083
3084 /* ffestd_R907 -- CLOSE statement
3085
3086    ffestd_R907();
3087
3088    Make sure a CLOSE is valid in the current context, and implement it.  */
3089
3090 void
3091 ffestd_R907 ()
3092 {
3093   ffestdStmt_ stmt;
3094
3095   ffestd_check_simple_ ();
3096
3097   stmt = ffestd_stmt_new_ (FFESTD_stmtidR907_);
3098   ffestd_stmt_append_ (stmt);
3099   ffestd_subr_line_save_ (stmt);
3100   stmt->u.R907.pool = ffesta_output_pool;
3101   stmt->u.R907.params = ffestd_subr_copy_close_ ();
3102   ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3103 }
3104
3105 /* ffestd_R909_start -- READ(...) statement list begin
3106
3107    ffestd_R909_start(FALSE);
3108
3109    Verify that READ is valid here, and begin accepting items in the
3110    list.  */
3111
3112 void
3113 ffestd_R909_start (bool only_format, ffestvUnit unit,
3114                    ffestvFormat format, bool rec, bool key)
3115 {
3116   ffestdStmt_ stmt;
3117
3118   ffestd_check_start_ ();
3119
3120 #define specified(something) \
3121       (ffestp_file.read.read_spec[something].kw_or_val_present)
3122
3123   /* Warn if there are any thing we don't handle via f2c libraries. */
3124   if (specified (FFESTP_readixADVANCE)
3125       || specified (FFESTP_readixEOR)
3126       || specified (FFESTP_readixKEYEQ)
3127       || specified (FFESTP_readixKEYGE)
3128       || specified (FFESTP_readixKEYGT)
3129       || specified (FFESTP_readixKEYID)
3130       || specified (FFESTP_readixNULLS)
3131       || specified (FFESTP_readixSIZE))
3132     {
3133       ffebad_start (FFEBAD_READ_UNSUPPORTED);
3134       ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
3135                    ffelex_token_where_column (ffesta_tokens[0]));
3136       ffebad_finish ();
3137     }
3138
3139 #undef specified
3140
3141   stmt = ffestd_stmt_new_ (FFESTD_stmtidR909_);
3142   ffestd_stmt_append_ (stmt);
3143   ffestd_subr_line_save_ (stmt);
3144   stmt->u.R909.pool = ffesta_output_pool;
3145   stmt->u.R909.params = ffestd_subr_copy_read_ ();
3146   stmt->u.R909.only_format = only_format;
3147   stmt->u.R909.unit = unit;
3148   stmt->u.R909.format = format;
3149   stmt->u.R909.rec = rec;
3150   stmt->u.R909.key = key;
3151   stmt->u.R909.list = NULL;
3152   ffestd_expr_list_ = &stmt->u.R909.list;
3153   ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3154 }
3155
3156 /* ffestd_R909_item -- READ statement i/o item
3157
3158    ffestd_R909_item(expr,expr_token);
3159
3160    Implement output-list expression.  */
3161
3162 void
3163 ffestd_R909_item (ffebld expr, ffelexToken expr_token)
3164 {
3165   ffestdExprItem_ item;
3166
3167   ffestd_check_item_ ();
3168
3169   item = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool,
3170                                           "ffestdExprItem_", sizeof (*item));
3171
3172   item->next = NULL;
3173   item->expr = expr;
3174   item->token = ffelex_token_use (expr_token);
3175   *ffestd_expr_list_ = item;
3176   ffestd_expr_list_ = &item->next;
3177 }
3178
3179 /* ffestd_R909_finish -- READ statement list complete
3180
3181    ffestd_R909_finish();
3182
3183    Just wrap up any local activities.  */
3184
3185 void
3186 ffestd_R909_finish ()
3187 {
3188   ffestd_check_finish_ ();
3189 }
3190
3191 /* ffestd_R910_start -- WRITE(...) statement list begin
3192
3193    ffestd_R910_start();
3194
3195    Verify that WRITE is valid here, and begin accepting items in the
3196    list.  */
3197
3198 void
3199 ffestd_R910_start (ffestvUnit unit, ffestvFormat format, bool rec)
3200 {
3201   ffestdStmt_ stmt;
3202
3203   ffestd_check_start_ ();
3204
3205 #define specified(something) \
3206       (ffestp_file.write.write_spec[something].kw_or_val_present)
3207
3208   /* Warn if there are any thing we don't handle via f2c libraries. */
3209   if (specified (FFESTP_writeixADVANCE)
3210       || specified (FFESTP_writeixEOR))
3211     {
3212       ffebad_start (FFEBAD_WRITE_UNSUPPORTED);
3213       ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
3214                    ffelex_token_where_column (ffesta_tokens[0]));
3215       ffebad_finish ();
3216     }
3217
3218 #undef specified
3219
3220   stmt = ffestd_stmt_new_ (FFESTD_stmtidR910_);
3221   ffestd_stmt_append_ (stmt);
3222   ffestd_subr_line_save_ (stmt);
3223   stmt->u.R910.pool = ffesta_output_pool;
3224   stmt->u.R910.params = ffestd_subr_copy_write_ ();
3225   stmt->u.R910.unit = unit;
3226   stmt->u.R910.format = format;
3227   stmt->u.R910.rec = rec;
3228   stmt->u.R910.list = NULL;
3229   ffestd_expr_list_ = &stmt->u.R910.list;
3230   ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3231 }
3232
3233 /* ffestd_R910_item -- WRITE statement i/o item
3234
3235    ffestd_R910_item(expr,expr_token);
3236
3237    Implement output-list expression.  */
3238
3239 void
3240 ffestd_R910_item (ffebld expr, ffelexToken expr_token)
3241 {
3242   ffestdExprItem_ item;
3243
3244   ffestd_check_item_ ();
3245
3246   item = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool,
3247                                           "ffestdExprItem_", sizeof (*item));
3248
3249   item->next = NULL;
3250   item->expr = expr;
3251   item->token = ffelex_token_use (expr_token);
3252   *ffestd_expr_list_ = item;
3253   ffestd_expr_list_ = &item->next;
3254 }
3255
3256 /* ffestd_R910_finish -- WRITE statement list complete
3257
3258    ffestd_R910_finish();
3259
3260    Just wrap up any local activities.  */
3261
3262 void
3263 ffestd_R910_finish ()
3264 {
3265   ffestd_check_finish_ ();
3266 }
3267
3268 /* ffestd_R911_start -- PRINT statement list begin
3269
3270    ffestd_R911_start();
3271
3272    Verify that PRINT is valid here, and begin accepting items in the
3273    list.  */
3274
3275 void
3276 ffestd_R911_start (ffestvFormat format)
3277 {
3278   ffestdStmt_ stmt;
3279
3280   ffestd_check_start_ ();
3281
3282   stmt = ffestd_stmt_new_ (FFESTD_stmtidR911_);
3283   ffestd_stmt_append_ (stmt);
3284   ffestd_subr_line_save_ (stmt);
3285   stmt->u.R911.pool = ffesta_output_pool;
3286   stmt->u.R911.params = ffestd_subr_copy_print_ ();
3287   stmt->u.R911.format = format;
3288   stmt->u.R911.list = NULL;
3289   ffestd_expr_list_ = &stmt->u.R911.list;
3290   ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3291 }
3292
3293 /* ffestd_R911_item -- PRINT statement i/o item
3294
3295    ffestd_R911_item(expr,expr_token);
3296
3297    Implement output-list expression.  */
3298
3299 void
3300 ffestd_R911_item (ffebld expr, ffelexToken expr_token)
3301 {
3302   ffestdExprItem_ item;
3303
3304   ffestd_check_item_ ();
3305
3306   item = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool,
3307                                           "ffestdExprItem_", sizeof (*item));
3308
3309   item->next = NULL;
3310   item->expr = expr;
3311   item->token = ffelex_token_use (expr_token);
3312   *ffestd_expr_list_ = item;
3313   ffestd_expr_list_ = &item->next;
3314 }
3315
3316 /* ffestd_R911_finish -- PRINT statement list complete
3317
3318    ffestd_R911_finish();
3319
3320    Just wrap up any local activities.  */
3321
3322 void
3323 ffestd_R911_finish ()
3324 {
3325   ffestd_check_finish_ ();
3326 }
3327
3328 /* ffestd_R919 -- BACKSPACE statement
3329
3330    ffestd_R919();
3331
3332    Make sure a BACKSPACE is valid in the current context, and implement it.  */
3333
3334 void
3335 ffestd_R919 ()
3336 {
3337   ffestdStmt_ stmt;
3338
3339   ffestd_check_simple_ ();
3340
3341   stmt = ffestd_stmt_new_ (FFESTD_stmtidR919_);
3342   ffestd_stmt_append_ (stmt);
3343   ffestd_subr_line_save_ (stmt);
3344   stmt->u.R919.pool = ffesta_output_pool;
3345   stmt->u.R919.params = ffestd_subr_copy_beru_ ();
3346   ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3347 }
3348
3349 /* ffestd_R920 -- ENDFILE statement
3350
3351    ffestd_R920();
3352
3353    Make sure a ENDFILE is valid in the current context, and implement it.  */
3354
3355 void
3356 ffestd_R920 ()
3357 {
3358   ffestdStmt_ stmt;
3359
3360   ffestd_check_simple_ ();
3361
3362   stmt = ffestd_stmt_new_ (FFESTD_stmtidR920_);
3363   ffestd_stmt_append_ (stmt);
3364   ffestd_subr_line_save_ (stmt);
3365   stmt->u.R920.pool = ffesta_output_pool;
3366   stmt->u.R920.params = ffestd_subr_copy_beru_ ();
3367   ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3368 }
3369
3370 /* ffestd_R921 -- REWIND statement
3371
3372    ffestd_R921();
3373
3374    Make sure a REWIND is valid in the current context, and implement it.  */
3375
3376 void
3377 ffestd_R921 ()
3378 {
3379   ffestdStmt_ stmt;
3380
3381   ffestd_check_simple_ ();
3382
3383   stmt = ffestd_stmt_new_ (FFESTD_stmtidR921_);
3384   ffestd_stmt_append_ (stmt);
3385   ffestd_subr_line_save_ (stmt);
3386   stmt->u.R921.pool = ffesta_output_pool;
3387   stmt->u.R921.params = ffestd_subr_copy_beru_ ();
3388   ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3389 }
3390
3391 /* ffestd_R923A -- INQUIRE statement (non-IOLENGTH version)
3392
3393    ffestd_R923A(bool by_file);
3394
3395    Make sure an INQUIRE is valid in the current context, and implement it.  */
3396
3397 void
3398 ffestd_R923A (bool by_file)
3399 {
3400   ffestdStmt_ stmt;
3401
3402   ffestd_check_simple_ ();
3403
3404 #define specified(something) \
3405       (ffestp_file.inquire.inquire_spec[something].kw_or_val_present)
3406
3407   /* Warn if there are any thing we don't handle via f2c libraries. */
3408   if (specified (FFESTP_inquireixACTION)
3409       || specified (FFESTP_inquireixCARRIAGECONTROL)
3410       || specified (FFESTP_inquireixDEFAULTFILE)
3411       || specified (FFESTP_inquireixDELIM)
3412       || specified (FFESTP_inquireixKEYED)
3413       || specified (FFESTP_inquireixORGANIZATION)
3414       || specified (FFESTP_inquireixPAD)
3415       || specified (FFESTP_inquireixPOSITION)
3416       || specified (FFESTP_inquireixREAD)
3417       || specified (FFESTP_inquireixREADWRITE)
3418       || specified (FFESTP_inquireixRECORDTYPE)
3419       || specified (FFESTP_inquireixWRITE))
3420     {
3421       ffebad_start (FFEBAD_INQUIRE_UNSUPPORTED);
3422       ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
3423                    ffelex_token_where_column (ffesta_tokens[0]));
3424       ffebad_finish ();
3425     }
3426
3427 #undef specified
3428
3429   stmt = ffestd_stmt_new_ (FFESTD_stmtidR923A_);
3430   ffestd_stmt_append_ (stmt);
3431   ffestd_subr_line_save_ (stmt);
3432   stmt->u.R923A.pool = ffesta_output_pool;
3433   stmt->u.R923A.params = ffestd_subr_copy_inquire_ ();
3434   stmt->u.R923A.by_file = by_file;
3435   ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3436 }
3437
3438 /* ffestd_R923B_start -- INQUIRE(IOLENGTH=expr) statement list begin
3439
3440    ffestd_R923B_start();
3441
3442    Verify that INQUIRE is valid here, and begin accepting items in the
3443    list.  */
3444
3445 void
3446 ffestd_R923B_start ()
3447 {
3448   ffestdStmt_ stmt;
3449
3450   ffestd_check_start_ ();
3451
3452   stmt = ffestd_stmt_new_ (FFESTD_stmtidR923B_);
3453   ffestd_stmt_append_ (stmt);
3454   ffestd_subr_line_save_ (stmt);
3455   stmt->u.R923B.pool = ffesta_output_pool;
3456   stmt->u.R923B.params = ffestd_subr_copy_inquire_ ();
3457   stmt->u.R923B.list = NULL;
3458   ffestd_expr_list_ = &stmt->u.R923B.list;
3459   ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3460 }
3461
3462 /* ffestd_R923B_item -- INQUIRE statement i/o item
3463
3464    ffestd_R923B_item(expr,expr_token);
3465
3466    Implement output-list expression.  */
3467
3468 void
3469 ffestd_R923B_item (ffebld expr)
3470 {
3471   ffestdExprItem_ item;
3472
3473   ffestd_check_item_ ();
3474
3475   item = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool,
3476                                           "ffestdExprItem_", sizeof (*item));
3477
3478   item->next = NULL;
3479   item->expr = expr;
3480   *ffestd_expr_list_ = item;
3481   ffestd_expr_list_ = &item->next;
3482 }
3483
3484 /* ffestd_R923B_finish -- INQUIRE statement list complete
3485
3486    ffestd_R923B_finish();
3487
3488    Just wrap up any local activities.  */
3489
3490 void
3491 ffestd_R923B_finish ()
3492 {
3493   ffestd_check_finish_ ();
3494 }
3495
3496 /* ffestd_R1001 -- FORMAT statement
3497
3498    ffestd_R1001(format_list);  */
3499
3500 void
3501 ffestd_R1001 (ffesttFormatList f)
3502 {
3503   ffestsHolder str;
3504   ffests s = &str;
3505   ffestdStmt_ stmt;
3506
3507   ffestd_check_simple_ ();
3508
3509   if (ffestd_label_formatdef_ == NULL)
3510     return;                     /* Nothing to hook it up to (no label def). */
3511
3512   ffests_new (s, malloc_pool_image (), 80);
3513   ffests_putc (s, '(');
3514   ffestd_R1001dump_ (s, f);     /* Build the string in s. */
3515   ffests_putc (s, ')');
3516
3517   stmt = ffestd_stmt_new_ (FFESTD_stmtidR1001_);
3518   ffestd_stmt_append_ (stmt);
3519   stmt->u.R1001.str = str;
3520
3521   ffestd_label_formatdef_ = NULL;
3522 }
3523
3524 /* ffestd_R1001dump_ -- Dump list of formats
3525
3526    ffesttFormatList list;
3527    ffestd_R1001dump_(list,0);
3528
3529    The formats in the list are dumped.  */
3530
3531 static void
3532 ffestd_R1001dump_ (ffests s, ffesttFormatList list)
3533 {
3534   ffesttFormatList next;
3535
3536   for (next = list->next; next != list; next = next->next)
3537     {
3538       if (next != list->next)
3539         ffests_putc (s, ',');
3540       switch (next->type)
3541         {
3542         case FFESTP_formattypeI:
3543           ffestd_R1001dump_1005_3_ (s, next, "I");
3544           break;
3545
3546         case FFESTP_formattypeB:
3547           ffestd_R1001error_ (next);
3548           break;
3549
3550         case FFESTP_formattypeO:
3551           ffestd_R1001dump_1005_3_ (s, next, "O");
3552           break;
3553
3554         case FFESTP_formattypeZ:
3555           ffestd_R1001dump_1005_3_ (s, next, "Z");
3556           break;
3557
3558         case FFESTP_formattypeF:
3559           ffestd_R1001dump_1005_4_ (s, next, "F");
3560           break;
3561
3562         case FFESTP_formattypeE:
3563           ffestd_R1001dump_1005_5_ (s, next, "E");
3564           break;
3565
3566         case FFESTP_formattypeEN:
3567           ffestd_R1001error_ (next);
3568           break;
3569
3570         case FFESTP_formattypeG:
3571           ffestd_R1001dump_1005_5_ (s, next, "G");
3572           break;
3573
3574         case FFESTP_formattypeL:
3575           ffestd_R1001dump_1005_2_ (s, next, "L");
3576           break;
3577
3578         case FFESTP_formattypeA:
3579           ffestd_R1001dump_1005_1_ (s, next, "A");
3580           break;
3581
3582         case FFESTP_formattypeD:
3583           ffestd_R1001dump_1005_4_ (s, next, "D");
3584           break;
3585
3586         case FFESTP_formattypeQ:
3587           ffestd_R1001error_ (next);
3588           break;
3589
3590         case FFESTP_formattypeDOLLAR:
3591           ffestd_R1001dump_1010_1_ (s, next, "$");
3592           break;
3593
3594         case FFESTP_formattypeP:
3595           ffestd_R1001dump_1010_4_ (s, next, "P");
3596           break;
3597
3598         case FFESTP_formattypeT:
3599           ffestd_R1001dump_1010_5_ (s, next, "T");
3600           break;
3601
3602         case FFESTP_formattypeTL:
3603           ffestd_R1001dump_1010_5_ (s, next, "TL");
3604           break;
3605
3606         case FFESTP_formattypeTR:
3607           ffestd_R1001dump_1010_5_ (s, next, "TR");
3608           break;
3609
3610         case FFESTP_formattypeX:
3611           ffestd_R1001dump_1010_3_ (s, next, "X");
3612           break;
3613
3614         case FFESTP_formattypeS:
3615           ffestd_R1001dump_1010_1_ (s, next, "S");
3616           break;
3617
3618         case FFESTP_formattypeSP:
3619           ffestd_R1001dump_1010_1_ (s, next, "SP");
3620           break;
3621
3622         case FFESTP_formattypeSS:
3623           ffestd_R1001dump_1010_1_ (s, next, "SS");
3624           break;
3625
3626         case FFESTP_formattypeBN:
3627           ffestd_R1001dump_1010_1_ (s, next, "BN");
3628           break;
3629
3630         case FFESTP_formattypeBZ:
3631           ffestd_R1001dump_1010_1_ (s, next, "BZ");
3632           break;
3633
3634         case FFESTP_formattypeSLASH:
3635           ffestd_R1001dump_1010_2_ (s, next, "/");
3636           break;
3637
3638         case FFESTP_formattypeCOLON:
3639           ffestd_R1001dump_1010_1_ (s, next, ":");
3640           break;
3641
3642         case FFESTP_formattypeR1016:
3643           switch (ffelex_token_type (next->t))
3644             {
3645             case FFELEX_typeCHARACTER:
3646               {
3647                 char *p = ffelex_token_text (next->t);
3648                 ffeTokenLength i = ffelex_token_length (next->t);
3649
3650                 ffests_putc (s, '\002');
3651                 while (i-- != 0)
3652                   {
3653                     if (*p == '\002')
3654                       ffests_putc (s, '\002');
3655                     ffests_putc (s, *p);
3656                     ++p;
3657                   }
3658                 ffests_putc (s, '\002');
3659               }
3660               break;
3661
3662             case FFELEX_typeHOLLERITH:
3663               {
3664                 char *p = ffelex_token_text (next->t);
3665                 ffeTokenLength i = ffelex_token_length (next->t);
3666
3667                 ffests_printf (s, "%" ffeTokenLength_f "uH", i);
3668                 while (i-- != 0)
3669                   {
3670                     ffests_putc (s, *p);
3671                     ++p;
3672                   }
3673               }
3674               break;
3675
3676             default:
3677               assert (FALSE);
3678             }
3679           break;
3680
3681         case FFESTP_formattypeFORMAT:
3682           if (next->u.R1003D.R1004.present)
3683             {
3684               if (next->u.R1003D.R1004.rtexpr)
3685                 ffestd_R1001rtexpr_ (s, next, next->u.R1003D.R1004.u.expr);
3686               else
3687                 ffests_printf (s, "%lu", next->u.R1003D.R1004.u.unsigned_val);
3688             }
3689
3690           ffests_putc (s, '(');
3691           ffestd_R1001dump_ (s, next->u.R1003D.format);
3692           ffests_putc (s, ')');
3693           break;
3694
3695         default:
3696           assert (FALSE);
3697         }
3698     }
3699 }
3700
3701 /* ffestd_R1001dump_1005_1_ -- Dump a particular format
3702
3703    ffesttFormatList f;
3704    ffestd_R1001dump_1005_1_(f,"I");
3705
3706    The format is dumped with form [r]X[w].  */
3707
3708 static void
3709 ffestd_R1001dump_1005_1_ (ffests s, ffesttFormatList f, const char *string)
3710 {
3711   assert (!f->u.R1005.R1007_or_R1008.present);
3712   assert (!f->u.R1005.R1009.present);
3713
3714   if (f->u.R1005.R1004.present)
3715     {
3716       if (f->u.R1005.R1004.rtexpr)
3717         ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
3718       else
3719         ffests_printf (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
3720     }
3721
3722   ffests_puts (s, string);
3723
3724   if (f->u.R1005.R1006.present)
3725     {
3726       if (f->u.R1005.R1006.rtexpr)
3727         ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
3728       else
3729         ffests_printf (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
3730     }
3731 }
3732
3733 /* ffestd_R1001dump_1005_2_ -- Dump a particular format
3734
3735    ffesttFormatList f;
3736    ffestd_R1001dump_1005_2_(f,"I");
3737
3738    The format is dumped with form [r]Xw.  */
3739
3740 static void
3741 ffestd_R1001dump_1005_2_ (ffests s, ffesttFormatList f, const char *string)
3742 {
3743   assert (!f->u.R1005.R1007_or_R1008.present);
3744   assert (!f->u.R1005.R1009.present);
3745   assert (f->u.R1005.R1006.present);
3746
3747   if (f->u.R1005.R1004.present)
3748     {
3749       if (f->u.R1005.R1004.rtexpr)
3750         ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
3751       else
3752         ffests_printf (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
3753     }
3754
3755   ffests_puts (s, string);
3756
3757   if (f->u.R1005.R1006.rtexpr)
3758     ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
3759   else
3760     ffests_printf (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
3761 }
3762
3763 /* ffestd_R1001dump_1005_3_ -- Dump a particular format
3764
3765    ffesttFormatList f;
3766    ffestd_R1001dump_1005_3_(f,"I");
3767
3768    The format is dumped with form [r]Xw[.m].  */
3769
3770 static void
3771 ffestd_R1001dump_1005_3_ (ffests s, ffesttFormatList f, const char *string)
3772 {
3773   assert (!f->u.R1005.R1009.present);
3774   assert (f->u.R1005.R1006.present);
3775
3776   if (f->u.R1005.R1004.present)
3777     {
3778       if (f->u.R1005.R1004.rtexpr)
3779         ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
3780       else
3781         ffests_printf (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
3782     }
3783
3784   ffests_puts (s, string);
3785
3786   if (f->u.R1005.R1006.rtexpr)
3787     ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
3788   else
3789     ffests_printf (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
3790
3791   if (f->u.R1005.R1007_or_R1008.present)
3792     {
3793       ffests_putc (s, '.');
3794       if (f->u.R1005.R1007_or_R1008.rtexpr)
3795         ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1007_or_R1008.u.expr);
3796       else
3797         ffests_printf (s, "%lu", f->u.R1005.R1007_or_R1008.u.unsigned_val);
3798     }
3799 }
3800
3801 /* ffestd_R1001dump_1005_4_ -- Dump a particular format
3802
3803    ffesttFormatList f;
3804    ffestd_R1001dump_1005_4_(f,"I");
3805
3806    The format is dumped with form [r]Xw.d.  */
3807
3808 static void
3809 ffestd_R1001dump_1005_4_ (ffests s, ffesttFormatList f, const char *string)
3810 {
3811   assert (!f->u.R1005.R1009.present);
3812   assert (f->u.R1005.R1007_or_R1008.present);
3813   assert (f->u.R1005.R1006.present);
3814
3815   if (f->u.R1005.R1004.present)
3816     {
3817       if (f->u.R1005.R1004.rtexpr)
3818         ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
3819       else
3820         ffests_printf (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
3821     }
3822
3823   ffests_puts (s, string);
3824
3825   if (f->u.R1005.R1006.rtexpr)
3826     ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
3827   else
3828     ffests_printf (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
3829
3830   ffests_putc (s, '.');
3831   if (f->u.R1005.R1007_or_R1008.rtexpr)
3832     ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1007_or_R1008.u.expr);
3833   else
3834     ffests_printf (s, "%lu", f->u.R1005.R1007_or_R1008.u.unsigned_val);
3835 }
3836
3837 /* ffestd_R1001dump_1005_5_ -- Dump a particular format
3838
3839    ffesttFormatList f;
3840    ffestd_R1001dump_1005_5_(f,"I");
3841
3842    The format is dumped with form [r]Xw.d[Ee].  */
3843
3844 static void
3845 ffestd_R1001dump_1005_5_ (ffests s, ffesttFormatList f, const char *string)
3846 {
3847   assert (f->u.R1005.R1007_or_R1008.present);
3848   assert (f->u.R1005.R1006.present);
3849
3850   if (f->u.R1005.R1004.present)
3851     {
3852       if (f->u.R1005.R1004.rtexpr)
3853         ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
3854       else
3855         ffests_printf (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
3856     }
3857
3858   ffests_puts (s, string);
3859
3860   if (f->u.R1005.R1006.rtexpr)
3861     ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
3862   else
3863     ffests_printf (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
3864
3865   ffests_putc (s, '.');
3866   if (f->u.R1005.R1007_or_R1008.rtexpr)
3867     ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1007_or_R1008.u.expr);
3868   else
3869     ffests_printf (s, "%lu", f->u.R1005.R1007_or_R1008.u.unsigned_val);
3870
3871   if (f->u.R1005.R1009.present)
3872     {
3873       ffests_putc (s, 'E');
3874       if (f->u.R1005.R1009.rtexpr)
3875         ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1009.u.expr);
3876       else
3877         ffests_printf (s, "%lu", f->u.R1005.R1009.u.unsigned_val);
3878     }
3879 }
3880
3881 /* ffestd_R1001dump_1010_1_ -- Dump a particular format
3882
3883    ffesttFormatList f;
3884    ffestd_R1001dump_1010_1_(f,"I");
3885
3886    The format is dumped with form X.  */
3887
3888 static void
3889 ffestd_R1001dump_1010_1_ (ffests s, ffesttFormatList f, const char *string)
3890 {
3891   assert (!f->u.R1010.val.present);
3892
3893   ffests_puts (s, string);
3894 }
3895
3896 /* ffestd_R1001dump_1010_2_ -- Dump a particular format
3897
3898    ffesttFormatList f;
3899    ffestd_R1001dump_1010_2_(f,"I");
3900
3901    The format is dumped with form [r]X.  */
3902
3903 static void
3904 ffestd_R1001dump_1010_2_ (ffests s, ffesttFormatList f, const char *string)
3905 {
3906   if (f->u.R1010.val.present)
3907     {
3908       if (f->u.R1010.val.rtexpr)
3909         ffestd_R1001rtexpr_ (s, f, f->u.R1010.val.u.expr);
3910       else
3911         ffests_printf (s, "%lu", f->u.R1010.val.u.unsigned_val);
3912     }
3913
3914   ffests_puts (s, string);
3915 }
3916
3917 /* ffestd_R1001dump_1010_3_ -- Dump a particular format
3918
3919    ffesttFormatList f;
3920    ffestd_R1001dump_1010_3_(f,"I");
3921
3922    The format is dumped with form nX.  */
3923
3924 static void
3925 ffestd_R1001dump_1010_3_ (ffests s, ffesttFormatList f, const char *string)
3926 {
3927   assert (f->u.R1010.val.present);
3928
3929   if (f->u.R1010.val.rtexpr)
3930     ffestd_R1001rtexpr_ (s, f, f->u.R1010.val.u.expr);
3931   else
3932     ffests_printf (s, "%lu", f->u.R1010.val.u.unsigned_val);
3933
3934   ffests_puts (s, string);
3935 }
3936
3937 /* ffestd_R1001dump_1010_4_ -- Dump a particular format
3938
3939    ffesttFormatList f;
3940    ffestd_R1001dump_1010_4_(f,"I");
3941
3942    The format is dumped with form kX.  Note that k is signed.  */
3943
3944 static void
3945 ffestd_R1001dump_1010_4_ (ffests s, ffesttFormatList f, const char *string)
3946 {
3947   assert (f->u.R1010.val.present);
3948
3949   if (f->u.R1010.val.rtexpr)
3950     ffestd_R1001rtexpr_ (s, f, f->u.R1010.val.u.expr);
3951   else
3952     ffests_printf (s, "%ld", f->u.R1010.val.u.signed_val);
3953
3954   ffests_puts (s, string);
3955 }
3956
3957 /* ffestd_R1001dump_1010_5_ -- Dump a particular format
3958
3959    ffesttFormatList f;
3960    ffestd_R1001dump_1010_5_(f,"I");
3961
3962    The format is dumped with form Xn.  */
3963
3964 static void
3965 ffestd_R1001dump_1010_5_ (ffests s, ffesttFormatList f, const char *string)
3966 {
3967   assert (f->u.R1010.val.present);
3968
3969   ffests_puts (s, string);
3970
3971   if (f->u.R1010.val.rtexpr)
3972     ffestd_R1001rtexpr_ (s, f, f->u.R1010.val.u.expr);
3973   else
3974     ffests_printf (s, "%lu", f->u.R1010.val.u.unsigned_val);
3975 }
3976
3977 /* ffestd_R1001error_ -- Complain about FORMAT specification not supported
3978
3979    ffesttFormatList f;
3980    ffestd_R1001error_(f);
3981
3982    An error message is produced.  */
3983
3984 static void
3985 ffestd_R1001error_ (ffesttFormatList f)
3986 {
3987   ffebad_start (FFEBAD_FORMAT_UNSUPPORTED);
3988   ffebad_here (0, ffelex_token_where_line (f->t), ffelex_token_where_column (f->t));
3989   ffebad_finish ();
3990 }
3991
3992 static void
3993 ffestd_R1001rtexpr_ (ffests s, ffesttFormatList f, ffebld expr)
3994 {
3995   if ((expr == NULL)
3996       || (ffebld_op (expr) != FFEBLD_opCONTER)
3997       || (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeINTEGER)
3998       || (ffeinfo_kindtype (ffebld_info (expr)) == FFEINFO_kindtypeINTEGER4))
3999     {
4000       ffebad_start (FFEBAD_FORMAT_VARIABLE);
4001       ffebad_here (0, ffelex_token_where_line (f->t), ffelex_token_where_column (f->t));
4002       ffebad_finish ();
4003     }
4004   else
4005     {
4006       int val;
4007
4008       switch (ffeinfo_kindtype (ffebld_info (expr)))
4009         {
4010 #if FFETARGET_okINTEGER1
4011         case FFEINFO_kindtypeINTEGER1:
4012           val = ffebld_constant_integer1 (ffebld_conter (expr));
4013           break;
4014 #endif
4015
4016 #if FFETARGET_okINTEGER2
4017         case FFEINFO_kindtypeINTEGER2:
4018           val = ffebld_constant_integer2 (ffebld_conter (expr));
4019           break;
4020 #endif
4021
4022 #if FFETARGET_okINTEGER3
4023         case FFEINFO_kindtypeINTEGER3:
4024           val = ffebld_constant_integer3 (ffebld_conter (expr));
4025           break;
4026 #endif
4027
4028         default:
4029           assert ("bad INTEGER constant kind type" == NULL);
4030           /* Fall through. */
4031         case FFEINFO_kindtypeANY:
4032           return;
4033         }
4034       ffests_printf (s, "%ld", (long) val);
4035     }
4036 }
4037
4038 /* ffestd_R1102 -- PROGRAM statement
4039
4040    ffestd_R1102(name_token);
4041
4042    Make sure ffestd_kind_ identifies an empty block.  Make sure name_token
4043    gives a valid name.  Implement the beginning of a main program.  */
4044
4045 void
4046 ffestd_R1102 (ffesymbol s, ffelexToken name UNUSED)
4047 {
4048   ffestd_check_simple_ ();
4049
4050   assert (ffestd_block_level_ == 0);
4051   ffestd_is_reachable_ = TRUE;
4052
4053   ffecom_notify_primary_entry (s);
4054   ffe_set_is_mainprog (TRUE);   /* Is a main program. */
4055   ffe_set_is_saveall (TRUE);    /* Main program always has implicit SAVE. */
4056
4057   ffestw_set_sym (ffestw_stack_top (), s);
4058 }
4059
4060 /* ffestd_R1103 -- End a PROGRAM
4061
4062    ffestd_R1103();  */
4063
4064 void
4065 ffestd_R1103 (bool ok UNUSED)
4066 {
4067   ffestdStmt_ stmt;
4068
4069   assert (ffestd_block_level_ == 0);
4070
4071   if (FFESTD_IS_END_OPTIMIZED_ && ffestd_is_reachable_)
4072     ffestd_R842 (NULL);         /* Generate STOP. */
4073
4074   if (ffestw_state (ffestw_stack_top ()) != FFESTV_statePROGRAM5)
4075     ffestd_subr_labels_ (FALSE);/* Handle any undefined labels. */
4076
4077   stmt = ffestd_stmt_new_ (FFESTD_stmtidR1103_);
4078   ffestd_stmt_append_ (stmt);
4079 }
4080
4081 /* ffestd_R1105 -- MODULE statement
4082
4083    ffestd_R1105(name_token);
4084
4085    Make sure ffestd_kind_ identifies an empty block.  Make sure name_token
4086    gives a valid name.  Implement the beginning of a module.  */
4087
4088 #if FFESTR_F90
4089 void
4090 ffestd_R1105 (ffelexToken name)
4091 {
4092   assert (ffestd_block_level_ == 0);
4093
4094   ffestd_check_simple_ ();
4095
4096   ffestd_subr_f90_ ();
4097   return;
4098
4099 #ifdef FFESTD_F90
4100   fprintf (dmpout, "* MODULE %s\n", ffelex_token_text (name));
4101 #endif
4102 }
4103
4104 /* ffestd_R1106 -- End a MODULE
4105
4106    ffestd_R1106(TRUE);  */
4107
4108 void
4109 ffestd_R1106 (bool ok)
4110 {
4111   assert (ffestd_block_level_ == 0);
4112
4113   /* Generate any wrap-up code here (unlikely in MODULE!). */
4114
4115   if (ffestw_state (ffestw_stack_top ()) != FFESTV_stateMODULE5)
4116     ffestd_subr_labels_ (TRUE); /* Handle any undefined labels (unlikely). */
4117
4118   return;                       /* F90. */
4119
4120 #ifdef FFESTD_F90
4121   fprintf (dmpout, "< END_MODULE %s\n",
4122            ffelex_token_text (ffestw_name (ffestw_stack_top ())));
4123 #endif
4124 }
4125
4126 /* ffestd_R1107_start -- USE statement list begin
4127
4128    ffestd_R1107_start();
4129
4130    Verify that USE is valid here, and begin accepting items in the list.  */
4131
4132 void
4133 ffestd_R1107_start (ffelexToken name, bool only)
4134 {
4135   ffestd_check_start_ ();
4136
4137   ffestd_subr_f90_ ();
4138   return;
4139
4140 #ifdef FFESTD_F90
4141   fprintf (dmpout, "* USE %s,", ffelex_token_text (name));      /* NB
4142                                                                    _shriek_begin_uses_. */
4143   if (only)
4144     fputs ("only: ", dmpout);
4145 #endif
4146 }
4147
4148 /* ffestd_R1107_item -- USE statement for name
4149
4150    ffestd_R1107_item(local_token,use_token);
4151
4152    Make sure name_token identifies a valid object to be USEed.  local_token
4153    may be NULL if _start_ was called with only==TRUE.  */
4154
4155 void
4156 ffestd_R1107_item (ffelexToken local, ffelexToken use)
4157 {
4158   ffestd_check_item_ ();
4159   assert (use != NULL);
4160
4161   return;                       /* F90. */
4162
4163 #ifdef FFESTD_F90
4164   if (local != NULL)
4165     fprintf (dmpout, "%s=>", ffelex_token_text (local));
4166   fprintf (dmpout, "%s,", ffelex_token_text (use));
4167 #endif
4168 }
4169
4170 /* ffestd_R1107_finish -- USE statement list complete
4171
4172    ffestd_R1107_finish();
4173
4174    Just wrap up any local activities.  */
4175
4176 void
4177 ffestd_R1107_finish ()
4178 {
4179   ffestd_check_finish_ ();
4180
4181   return;                       /* F90. */
4182
4183 #ifdef FFESTD_F90
4184   fputc ('\n', dmpout);
4185 #endif
4186 }
4187
4188 #endif
4189 /* ffestd_R1111 -- BLOCK DATA statement
4190
4191    ffestd_R1111(name_token);
4192
4193    Make sure ffestd_kind_ identifies no current program unit.  If not
4194    NULL, make sure name_token gives a valid name.  Implement the beginning
4195    of a block data program unit.  */
4196
4197 void
4198 ffestd_R1111 (ffesymbol s, ffelexToken name UNUSED)
4199 {
4200   assert (ffestd_block_level_ == 0);
4201   ffestd_is_reachable_ = TRUE;
4202
4203   ffestd_check_simple_ ();
4204
4205   ffecom_notify_primary_entry (s);
4206   ffestw_set_sym (ffestw_stack_top (), s);
4207 }
4208
4209 /* ffestd_R1112 -- End a BLOCK DATA
4210
4211    ffestd_R1112(TRUE);  */
4212
4213 void
4214 ffestd_R1112 (bool ok UNUSED)
4215 {
4216   ffestdStmt_ stmt;
4217
4218   assert (ffestd_block_level_ == 0);
4219
4220   /* Generate any return-like code here (not likely for BLOCK DATA!). */
4221
4222   if (ffestw_state (ffestw_stack_top ()) != FFESTV_stateBLOCKDATA5)
4223     ffestd_subr_labels_ (TRUE); /* Handle any undefined labels. */
4224
4225   stmt = ffestd_stmt_new_ (FFESTD_stmtidR1112_);
4226   ffestd_stmt_append_ (stmt);
4227 }
4228
4229 /* ffestd_R1202 -- INTERFACE statement
4230
4231    ffestd_R1202(operator,defined_name);
4232
4233    Make sure ffestd_kind_ identifies an INTERFACE block.
4234    Implement the end of the current interface.
4235
4236    06-Jun-90  JCB  1.1
4237       Allow no operator or name to mean INTERFACE by itself; missed this
4238       valid form when originally doing syntactic analysis code.  */
4239
4240 #if FFESTR_F90
4241 void
4242 ffestd_R1202 (ffestpDefinedOperator operator, ffelexToken name)
4243 {
4244   ffestd_check_simple_ ();
4245
4246   ffestd_subr_f90_ ();
4247   return;
4248
4249 #ifdef FFESTD_F90
4250   switch (operator)
4251     {
4252     case FFESTP_definedoperatorNone:
4253       if (name == NULL)
4254         fputs ("* INTERFACE_unnamed\n", dmpout);
4255       else
4256         fprintf (dmpout, "* INTERFACE %s\n", ffelex_token_text (name));
4257       break;
4258
4259     case FFESTP_definedoperatorOPERATOR:
4260       fprintf (dmpout, "* INTERFACE_OPERATOR (.%s.)\n", ffelex_token_text (name));
4261       break;
4262
4263     case FFESTP_definedoperatorASSIGNMENT:
4264       fputs ("* INTERFACE_ASSIGNMENT (=)\n", dmpout);
4265       break;
4266
4267     case FFESTP_definedoperatorPOWER:
4268       fputs ("* INTERFACE_OPERATOR (**)\n", dmpout);
4269       break;
4270
4271     case FFESTP_definedoperatorMULT:
4272       fputs ("* INTERFACE_OPERATOR (*)\n", dmpout);
4273       break;
4274
4275     case FFESTP_definedoperatorADD:
4276       fputs ("* INTERFACE_OPERATOR (+)\n", dmpout);
4277       break;
4278
4279     case FFESTP_definedoperatorCONCAT:
4280       fputs ("* INTERFACE_OPERATOR (//)\n", dmpout);
4281       break;
4282
4283     case FFESTP_definedoperatorDIVIDE:
4284       fputs ("* INTERFACE_OPERATOR (/)\n", dmpout);
4285       break;
4286
4287     case FFESTP_definedoperatorSUBTRACT:
4288       fputs ("* INTERFACE_OPERATOR (-)\n", dmpout);
4289       break;
4290
4291     case FFESTP_definedoperatorNOT:
4292       fputs ("* INTERFACE_OPERATOR (.not.)\n", dmpout);
4293       break;
4294
4295     case FFESTP_definedoperatorAND:
4296       fputs ("* INTERFACE_OPERATOR (.and.)\n", dmpout);
4297       break;
4298
4299     case FFESTP_definedoperatorOR:
4300       fputs ("* INTERFACE_OPERATOR (.or.)\n", dmpout);
4301       break;
4302
4303     case FFESTP_definedoperatorEQV:
4304       fputs ("* INTERFACE_OPERATOR (.eqv.)\n", dmpout);
4305       break;
4306
4307     case FFESTP_definedoperatorNEQV:
4308       fputs ("* INTERFACE_OPERATOR (.neqv.)\n", dmpout);
4309       break;
4310
4311     case FFESTP_definedoperatorEQ:
4312       fputs ("* INTERFACE_OPERATOR (==)\n", dmpout);
4313       break;
4314
4315     case FFESTP_definedoperatorNE:
4316       fputs ("* INTERFACE_OPERATOR (/=)\n", dmpout);
4317       break;
4318
4319     case FFESTP_definedoperatorLT:
4320       fputs ("* INTERFACE_OPERATOR (<)\n", dmpout);
4321       break;
4322
4323     case FFESTP_definedoperatorLE:
4324       fputs ("* INTERFACE_OPERATOR (<=)\n", dmpout);
4325       break;
4326
4327     case FFESTP_definedoperatorGT:
4328       fputs ("* INTERFACE_OPERATOR (>)\n", dmpout);
4329       break;
4330
4331     case FFESTP_definedoperatorGE:
4332       fputs ("* INTERFACE_OPERATOR (>=)\n", dmpout);
4333       break;
4334
4335     default:
4336       assert (FALSE);
4337       break;
4338     }
4339 #endif
4340 }
4341
4342 /* ffestd_R1203 -- End an INTERFACE
4343
4344    ffestd_R1203(TRUE);  */
4345
4346 void
4347 ffestd_R1203 (bool ok)
4348 {
4349   return;                       /* F90. */
4350
4351 #ifdef FFESTD_F90
4352   fputs ("* END_INTERFACE\n", dmpout);
4353 #endif
4354 }
4355
4356 /* ffestd_R1205_start -- MODULE PROCEDURE statement list begin
4357
4358    ffestd_R1205_start();
4359
4360    Verify that MODULE PROCEDURE is valid here, and begin accepting items in
4361    the list.  */
4362
4363 void
4364 ffestd_R1205_start ()
4365 {
4366   ffestd_check_start_ ();
4367
4368   return;                       /* F90. */
4369
4370 #ifdef FFESTD_F90
4371   fputs ("* MODULE_PROCEDURE ", dmpout);
4372 #endif
4373 }
4374
4375 /* ffestd_R1205_item -- MODULE PROCEDURE statement for name
4376
4377    ffestd_R1205_item(name_token);
4378
4379    Make sure name_token identifies a valid object to be MODULE PROCEDUREed.  */
4380
4381 void
4382 ffestd_R1205_item (ffelexToken name)
4383 {
4384   ffestd_check_item_ ();
4385   assert (name != NULL);
4386
4387   return;                       /* F90. */
4388
4389 #ifdef FFESTD_F90
4390   fprintf (dmpout, "%s,", ffelex_token_text (name));
4391 #endif
4392 }
4393
4394 /* ffestd_R1205_finish -- MODULE PROCEDURE statement list complete
4395
4396    ffestd_R1205_finish();
4397
4398    Just wrap up any local activities.  */
4399
4400 void
4401 ffestd_R1205_finish ()
4402 {
4403   ffestd_check_finish_ ();
4404
4405   return;                       /* F90. */
4406
4407 #ifdef FFESTD_F90
4408   fputc ('\n', dmpout);
4409 #endif
4410 }
4411
4412 #endif
4413 /* ffestd_R1207_start -- EXTERNAL statement list begin
4414
4415    ffestd_R1207_start();
4416
4417    Verify that EXTERNAL is valid here, and begin accepting items in the list.  */
4418
4419 void
4420 ffestd_R1207_start ()
4421 {
4422   ffestd_check_start_ ();
4423 }
4424
4425 /* ffestd_R1207_item -- EXTERNAL statement for name
4426
4427    ffestd_R1207_item(name_token);
4428
4429    Make sure name_token identifies a valid object to be EXTERNALd.  */
4430
4431 void
4432 ffestd_R1207_item (ffelexToken name)
4433 {
4434   ffestd_check_item_ ();
4435   assert (name != NULL);
4436 }
4437
4438 /* ffestd_R1207_finish -- EXTERNAL statement list complete
4439
4440    ffestd_R1207_finish();
4441
4442    Just wrap up any local activities.  */
4443
4444 void
4445 ffestd_R1207_finish ()
4446 {
4447   ffestd_check_finish_ ();
4448 }
4449
4450 /* ffestd_R1208_start -- INTRINSIC statement list begin
4451
4452    ffestd_R1208_start();
4453
4454    Verify that INTRINSIC is valid here, and begin accepting items in the list.  */
4455
4456 void
4457 ffestd_R1208_start ()
4458 {
4459   ffestd_check_start_ ();
4460 }
4461
4462 /* ffestd_R1208_item -- INTRINSIC statement for name
4463
4464    ffestd_R1208_item(name_token);
4465
4466    Make sure name_token identifies a valid object to be INTRINSICd.  */
4467
4468 void
4469 ffestd_R1208_item (ffelexToken name)
4470 {
4471   ffestd_check_item_ ();
4472   assert (name != NULL);
4473 }
4474
4475 /* ffestd_R1208_finish -- INTRINSIC statement list complete
4476
4477    ffestd_R1208_finish();
4478
4479    Just wrap up any local activities.  */
4480
4481 void
4482 ffestd_R1208_finish ()
4483 {
4484   ffestd_check_finish_ ();
4485 }
4486
4487 /* ffestd_R1212 -- CALL statement
4488
4489    ffestd_R1212(expr,expr_token);
4490
4491    Make sure statement is valid here; implement.  */
4492
4493 void
4494 ffestd_R1212 (ffebld expr)
4495 {
4496   ffestdStmt_ stmt;
4497
4498   ffestd_check_simple_ ();
4499
4500   stmt = ffestd_stmt_new_ (FFESTD_stmtidR1212_);
4501   ffestd_stmt_append_ (stmt);
4502   ffestd_subr_line_save_ (stmt);
4503   stmt->u.R1212.pool = ffesta_output_pool;
4504   stmt->u.R1212.expr = expr;
4505   ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
4506 }
4507
4508 /* ffestd_R1213 -- Defined assignment statement
4509
4510    ffestd_R1213(dest_expr,source_expr,source_token);
4511
4512    Make sure the assignment is valid.  */
4513
4514 #if FFESTR_F90
4515 void
4516 ffestd_R1213 (ffebld dest, ffebld source)
4517 {
4518   ffestd_check_simple_ ();
4519
4520   ffestd_subr_f90_ ();
4521 }
4522
4523 #endif
4524 /* ffestd_R1219 -- FUNCTION statement
4525
4526    ffestd_R1219(funcname,arglist,ending_token,kind,kindt,len,lent,
4527          recursive);
4528
4529    Make sure statement is valid here, register arguments for the
4530    function name, and so on.
4531
4532    06-Jun-90  JCB  2.0
4533       Added the kind, len, and recursive arguments.  */
4534
4535 void
4536 ffestd_R1219 (ffesymbol s, ffelexToken funcname UNUSED,
4537               ffesttTokenList args UNUSED, ffestpType type UNUSED,
4538               ffebld kind UNUSED, ffelexToken kindt UNUSED,
4539               ffebld len UNUSED, ffelexToken lent UNUSED,
4540               bool recursive UNUSED, ffelexToken result UNUSED,
4541               bool separate_result UNUSED)
4542 {
4543   assert (ffestd_block_level_ == 0);
4544   ffestd_is_reachable_ = TRUE;
4545
4546   ffestd_check_simple_ ();
4547
4548   ffecom_notify_primary_entry (s);
4549   ffestw_set_sym (ffestw_stack_top (), s);
4550 }
4551
4552 /* ffestd_R1221 -- End a FUNCTION
4553
4554    ffestd_R1221(TRUE);  */
4555
4556 void
4557 ffestd_R1221 (bool ok UNUSED)
4558 {
4559   ffestdStmt_ stmt;
4560
4561   assert (ffestd_block_level_ == 0);
4562
4563   if (FFESTD_IS_END_OPTIMIZED_ && ffestd_is_reachable_)
4564     ffestd_R1227 (NULL);        /* Generate RETURN. */
4565
4566   if (ffestw_state (ffestw_stack_top ()) != FFESTV_stateFUNCTION5)
4567     ffestd_subr_labels_ (FALSE);/* Handle any undefined labels. */
4568
4569   stmt = ffestd_stmt_new_ (FFESTD_stmtidR1221_);
4570   ffestd_stmt_append_ (stmt);
4571 }
4572
4573 /* ffestd_R1223 -- SUBROUTINE statement
4574
4575    ffestd_R1223(subrname,arglist,ending_token,recursive_token);
4576
4577    Make sure statement is valid here, register arguments for the
4578    subroutine name, and so on.
4579
4580    06-Jun-90  JCB  2.0
4581       Added the recursive argument.  */
4582
4583 void
4584 ffestd_R1223 (ffesymbol s, ffelexToken subrname UNUSED,
4585               ffesttTokenList args UNUSED, ffelexToken final UNUSED,
4586               bool recursive UNUSED)
4587 {
4588   assert (ffestd_block_level_ == 0);
4589   ffestd_is_reachable_ = TRUE;
4590
4591   ffestd_check_simple_ ();
4592
4593   ffecom_notify_primary_entry (s);
4594   ffestw_set_sym (ffestw_stack_top (), s);
4595 }
4596
4597 /* ffestd_R1225 -- End a SUBROUTINE
4598
4599    ffestd_R1225(TRUE);  */
4600
4601 void
4602 ffestd_R1225 (bool ok UNUSED)
4603 {
4604   ffestdStmt_ stmt;
4605
4606   assert (ffestd_block_level_ == 0);
4607
4608   if (FFESTD_IS_END_OPTIMIZED_ && ffestd_is_reachable_)
4609     ffestd_R1227 (NULL);        /* Generate RETURN. */
4610
4611   if (ffestw_state (ffestw_stack_top ()) != FFESTV_stateSUBROUTINE5)
4612     ffestd_subr_labels_ (FALSE);/* Handle any undefined labels. */
4613
4614   stmt = ffestd_stmt_new_ (FFESTD_stmtidR1225_);
4615   ffestd_stmt_append_ (stmt);
4616 }
4617
4618 /* ffestd_R1226 -- ENTRY statement
4619
4620    ffestd_R1226(entryname,arglist,ending_token);
4621
4622    Make sure we're in a SUBROUTINE or FUNCTION, register arguments for the
4623    entry point name, and so on.  */
4624
4625 void
4626 ffestd_R1226 (ffesymbol entry)
4627 {
4628   ffestd_check_simple_ ();
4629
4630   if (!ffesta_seen_first_exec || ffecom_2pass_advise_entrypoint (entry))
4631     {
4632       ffestdStmt_ stmt;
4633
4634       stmt = ffestd_stmt_new_ (FFESTD_stmtidR1226_);
4635       ffestd_stmt_append_ (stmt);
4636       ffestd_subr_line_save_ (stmt);
4637       stmt->u.R1226.entry = entry;
4638       stmt->u.R1226.entrynum = ++ffestd_2pass_entrypoints_;
4639     }
4640
4641   ffestd_is_reachable_ = TRUE;
4642 }
4643
4644 /* ffestd_R1227 -- RETURN statement
4645
4646    ffestd_R1227(expr);
4647
4648    Make sure statement is valid here; implement.  expr and expr_token are
4649    both NULL if there was no expression.  */
4650
4651 void
4652 ffestd_R1227 (ffebld expr)
4653 {
4654   ffestdStmt_ stmt;
4655
4656   ffestd_check_simple_ ();
4657
4658   stmt = ffestd_stmt_new_ (FFESTD_stmtidR1227_);
4659   ffestd_stmt_append_ (stmt);
4660   ffestd_subr_line_save_ (stmt);
4661   stmt->u.R1227.pool = ffesta_output_pool;
4662   stmt->u.R1227.block = ffestw_stack_top ();
4663   stmt->u.R1227.expr = expr;
4664   ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
4665
4666   if (ffestd_block_level_ == 0)
4667     ffestd_is_reachable_ = FALSE;
4668 }
4669
4670 /* ffestd_R1228 -- CONTAINS statement
4671
4672    ffestd_R1228();  */
4673
4674 #if FFESTR_F90
4675 void
4676 ffestd_R1228 ()
4677 {
4678   assert (ffestd_block_level_ == 0);
4679
4680   ffestd_check_simple_ ();
4681
4682   /* Generate RETURN/STOP code here */
4683
4684   ffestd_subr_labels_ (ffestw_state (ffestw_stack_top ())
4685                        == FFESTV_stateMODULE5); /* Handle any undefined
4686                                                    labels. */
4687
4688   ffestd_subr_f90_ ();
4689   return;
4690
4691 #ifdef FFESTD_F90
4692   fputs ("- CONTAINS\n", dmpout);
4693 #endif
4694 }
4695
4696 #endif
4697 /* ffestd_R1229_start -- STMTFUNCTION statement begin
4698
4699    ffestd_R1229_start(func_name,func_arg_list,close_paren);
4700
4701    This function does not really need to do anything, since _finish_
4702    gets all the info needed, and ffestc_R1229_start has already
4703    done all the stuff that makes a two-phase operation (start and
4704    finish) for handling statement functions necessary.
4705
4706    03-Jan-91  JCB  2.0
4707       Do nothing, now that _finish_ does everything.  */
4708
4709 void
4710 ffestd_R1229_start (ffelexToken name UNUSED, ffesttTokenList args UNUSED)
4711 {
4712   ffestd_check_start_ ();
4713 }
4714
4715 /* ffestd_R1229_finish -- STMTFUNCTION statement list complete
4716
4717    ffestd_R1229_finish(s);
4718
4719    The statement function's symbol is passed.  Its list of dummy args is
4720    accessed via ffesymbol_dummyargs and its expansion expression (expr)
4721    is accessed via ffesymbol_sfexpr.
4722
4723    If sfexpr is NULL, an error occurred parsing the expansion expression, so
4724    just cancel the effects of ffestd_R1229_start and pretend nothing
4725    happened.  Otherwise, install the expression as the expansion for the
4726    statement function, then clean up.
4727
4728    03-Jan-91  JCB  2.0
4729       Takes sfunc sym instead of just the expansion expression as an
4730       argument, so this function can do all the work, and _start_ is just
4731       a nicety than can do nothing in a back end.  */
4732
4733 void
4734 ffestd_R1229_finish (ffesymbol s)
4735 {
4736   ffebld expr = ffesymbol_sfexpr (s);
4737
4738   ffestd_check_finish_ ();
4739
4740   if (expr == NULL)
4741     return;                     /* Nothing to do, definition didn't work. */
4742
4743   /* With gcc, cannot do anything here, because the backend hasn't even
4744      (necessarily) been notified that we're compiling a program unit! */
4745   ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
4746 }
4747
4748 /* ffestd_S3P4 -- INCLUDE line
4749
4750    ffestd_S3P4(filename,filename_token);
4751
4752    Make sure INCLUDE not preceded by any semicolons or a label def; implement.  */
4753
4754 void
4755 ffestd_S3P4 (ffebld filename)
4756 {
4757   FILE *fi;
4758   ffetargetCharacterDefault buildname;
4759   ffewhereFile wf;
4760
4761   ffestd_check_simple_ ();
4762
4763   assert (filename != NULL);
4764   if (ffebld_op (filename) != FFEBLD_opANY)
4765     {
4766       assert (ffebld_op (filename) == FFEBLD_opCONTER);
4767       assert (ffeinfo_basictype (ffebld_info (filename))
4768               == FFEINFO_basictypeCHARACTER);
4769       assert (ffeinfo_kindtype (ffebld_info (filename))
4770               == FFEINFO_kindtypeCHARACTERDEFAULT);
4771       buildname = ffebld_constant_characterdefault (ffebld_conter (filename));
4772       wf = ffewhere_file_new (ffetarget_text_characterdefault (buildname),
4773                               ffetarget_length_characterdefault (buildname));
4774       fi = ffecom_open_include (ffewhere_file_name (wf),
4775                                 ffelex_token_where_line (ffesta_tokens[0]),
4776                                 ffelex_token_where_column (ffesta_tokens[0]));
4777       if (fi != NULL)
4778         ffelex_set_include (wf, (ffelex_token_type (ffesta_tokens[0])
4779                                  == FFELEX_typeNAME), fi);
4780     }
4781 }
4782
4783 /* ffestd_V003_start -- STRUCTURE statement list begin
4784
4785    ffestd_V003_start(structure_name);
4786
4787    Verify that STRUCTURE is valid here, and begin accepting items in the list.  */
4788
4789 #if FFESTR_VXT
4790 void
4791 ffestd_V003_start (ffelexToken structure_name)
4792 {
4793   ffestd_check_start_ ();
4794   ffestd_subr_vxt_ ();
4795 }
4796
4797 /* ffestd_V003_item -- STRUCTURE statement for object-name
4798
4799    ffestd_V003_item(name_token,dim_list);
4800
4801    Make sure name_token identifies a valid object to be STRUCTUREd.  */
4802
4803 void
4804 ffestd_V003_item (ffelexToken name, ffesttDimList dims)
4805 {
4806   ffestd_check_item_ ();
4807 }
4808
4809 /* ffestd_V003_finish -- STRUCTURE statement list complete
4810
4811    ffestd_V003_finish();
4812
4813    Just wrap up any local activities.  */
4814
4815 void
4816 ffestd_V003_finish ()
4817 {
4818   ffestd_check_finish_ ();
4819 }
4820
4821 /* ffestd_V004 -- End a STRUCTURE
4822
4823    ffestd_V004(TRUE);  */
4824
4825 void
4826 ffestd_V004 (bool ok)
4827 {
4828 }
4829
4830 /* ffestd_V009 -- UNION statement
4831
4832    ffestd_V009();  */
4833
4834 void
4835 ffestd_V009 ()
4836 {
4837   ffestd_check_simple_ ();
4838 }
4839
4840 /* ffestd_V010 -- End a UNION
4841
4842    ffestd_V010(TRUE);  */
4843
4844 void
4845 ffestd_V010 (bool ok)
4846 {
4847 }
4848
4849 /* ffestd_V012 -- MAP statement
4850
4851    ffestd_V012();  */
4852
4853 void
4854 ffestd_V012 ()
4855 {
4856   ffestd_check_simple_ ();
4857 }
4858
4859 /* ffestd_V013 -- End a MAP
4860
4861    ffestd_V013(TRUE);  */
4862
4863 void
4864 ffestd_V013 (bool ok)
4865 {
4866 }
4867
4868 #endif
4869 /* ffestd_V014_start -- VOLATILE statement list begin
4870
4871    ffestd_V014_start();
4872
4873    Verify that VOLATILE is valid here, and begin accepting items in the list.  */
4874
4875 void
4876 ffestd_V014_start ()
4877 {
4878   ffestd_check_start_ ();
4879 }
4880
4881 /* ffestd_V014_item_object -- VOLATILE statement for object-name
4882
4883    ffestd_V014_item_object(name_token);
4884
4885    Make sure name_token identifies a valid object to be VOLATILEd.  */
4886
4887 void
4888 ffestd_V014_item_object (ffelexToken name UNUSED)
4889 {
4890   ffestd_check_item_ ();
4891 }
4892
4893 /* ffestd_V014_item_cblock -- VOLATILE statement for common-block-name
4894
4895    ffestd_V014_item_cblock(name_token);
4896
4897    Make sure name_token identifies a valid common block to be VOLATILEd.  */
4898
4899 void
4900 ffestd_V014_item_cblock (ffelexToken name UNUSED)
4901 {
4902   ffestd_check_item_ ();
4903 }
4904
4905 /* ffestd_V014_finish -- VOLATILE statement list complete
4906
4907    ffestd_V014_finish();
4908
4909    Just wrap up any local activities.  */
4910
4911 void
4912 ffestd_V014_finish ()
4913 {
4914   ffestd_check_finish_ ();
4915 }
4916
4917 /* ffestd_V016_start -- RECORD statement list begin
4918
4919    ffestd_V016_start();
4920
4921    Verify that RECORD is valid here, and begin accepting items in the list.  */
4922
4923 #if FFESTR_VXT
4924 void
4925 ffestd_V016_start ()
4926 {
4927   ffestd_check_start_ ();
4928 }
4929
4930 /* ffestd_V016_item_structure -- RECORD statement for common-block-name
4931
4932    ffestd_V016_item_structure(name_token);
4933
4934    Make sure name_token identifies a valid structure to be RECORDed.  */
4935
4936 void
4937 ffestd_V016_item_structure (ffelexToken name)
4938 {
4939   ffestd_check_item_ ();
4940 }
4941
4942 /* ffestd_V016_item_object -- RECORD statement for object-name
4943
4944    ffestd_V016_item_object(name_token,dim_list);
4945
4946    Make sure name_token identifies a valid object to be RECORDd.  */
4947
4948 void
4949 ffestd_V016_item_object (ffelexToken name, ffesttDimList dims)
4950 {
4951   ffestd_check_item_ ();
4952 }
4953
4954 /* ffestd_V016_finish -- RECORD statement list complete
4955
4956    ffestd_V016_finish();
4957
4958    Just wrap up any local activities.  */
4959
4960 void
4961 ffestd_V016_finish ()
4962 {
4963   ffestd_check_finish_ ();
4964 }
4965
4966 /* ffestd_V018_start -- REWRITE(...) statement list begin
4967
4968    ffestd_V018_start();
4969
4970    Verify that REWRITE is valid here, and begin accepting items in the
4971    list.  */
4972
4973 void
4974 ffestd_V018_start (ffestvFormat format)
4975 {
4976   ffestd_check_start_ ();
4977   ffestd_subr_vxt_ ();
4978 }
4979
4980 /* ffestd_V018_item -- REWRITE statement i/o item
4981
4982    ffestd_V018_item(expr,expr_token);
4983
4984    Implement output-list expression.  */
4985
4986 void
4987 ffestd_V018_item (ffebld expr)
4988 {
4989   ffestd_check_item_ ();
4990 }
4991
4992 /* ffestd_V018_finish -- REWRITE statement list complete
4993
4994    ffestd_V018_finish();
4995
4996    Just wrap up any local activities.  */
4997
4998 void
4999 ffestd_V018_finish ()
5000 {
5001   ffestd_check_finish_ ();
5002 }
5003
5004 /* ffestd_V019_start -- ACCEPT statement list begin
5005
5006    ffestd_V019_start();
5007
5008    Verify that ACCEPT is valid here, and begin accepting items in the
5009    list.  */
5010
5011 void
5012 ffestd_V019_start (ffestvFormat format)
5013 {
5014   ffestd_check_start_ ();
5015   ffestd_subr_vxt_ ();
5016 }
5017
5018 /* ffestd_V019_item -- ACCEPT statement i/o item
5019
5020    ffestd_V019_item(expr,expr_token);
5021
5022    Implement output-list expression.  */
5023
5024 void
5025 ffestd_V019_item (ffebld expr)
5026 {
5027   ffestd_check_item_ ();
5028 }
5029
5030 /* ffestd_V019_finish -- ACCEPT statement list complete
5031
5032    ffestd_V019_finish();
5033
5034    Just wrap up any local activities.  */
5035
5036 void
5037 ffestd_V019_finish ()
5038 {
5039   ffestd_check_finish_ ();
5040 }
5041
5042 #endif
5043 /* ffestd_V020_start -- TYPE statement list begin
5044
5045    ffestd_V020_start();
5046
5047    Verify that TYPE is valid here, and begin accepting items in the
5048    list.  */
5049
5050 void
5051 ffestd_V020_start (ffestvFormat format UNUSED)
5052 {
5053   ffestd_check_start_ ();
5054   ffestd_subr_vxt_ ();
5055 }
5056
5057 /* ffestd_V020_item -- TYPE statement i/o item
5058
5059    ffestd_V020_item(expr,expr_token);
5060
5061    Implement output-list expression.  */
5062
5063 void
5064 ffestd_V020_item (ffebld expr UNUSED)
5065 {
5066   ffestd_check_item_ ();
5067 }
5068
5069 /* ffestd_V020_finish -- TYPE statement list complete
5070
5071    ffestd_V020_finish();
5072
5073    Just wrap up any local activities.  */
5074
5075 void
5076 ffestd_V020_finish ()
5077 {
5078   ffestd_check_finish_ ();
5079 }
5080
5081 /* ffestd_V021 -- DELETE statement
5082
5083    ffestd_V021();
5084
5085    Make sure a DELETE is valid in the current context, and implement it.  */
5086
5087 #if FFESTR_VXT
5088 void
5089 ffestd_V021 ()
5090 {
5091   ffestd_check_simple_ ();
5092   ffestd_subr_vxt_ ();
5093 }
5094
5095 /* ffestd_V022 -- UNLOCK statement
5096
5097    ffestd_V022();
5098
5099    Make sure a UNLOCK is valid in the current context, and implement it.  */
5100
5101 void
5102 ffestd_V022 ()
5103 {
5104   ffestd_check_simple_ ();
5105   ffestd_subr_vxt_ ();
5106 }
5107
5108 /* ffestd_V023_start -- ENCODE(...) statement list begin
5109
5110    ffestd_V023_start();
5111
5112    Verify that ENCODE is valid here, and begin accepting items in the
5113    list.  */
5114
5115 void
5116 ffestd_V023_start ()
5117 {
5118   ffestd_check_start_ ();
5119   ffestd_subr_vxt_ ();
5120 }
5121
5122 /* ffestd_V023_item -- ENCODE statement i/o item
5123
5124    ffestd_V023_item(expr,expr_token);
5125
5126    Implement output-list expression.  */
5127
5128 void
5129 ffestd_V023_item (ffebld expr)
5130 {
5131   ffestd_check_item_ ();
5132 }
5133
5134 /* ffestd_V023_finish -- ENCODE statement list complete
5135
5136    ffestd_V023_finish();
5137
5138    Just wrap up any local activities.  */
5139
5140 void
5141 ffestd_V023_finish ()
5142 {
5143   ffestd_check_finish_ ();
5144 }
5145
5146 /* ffestd_V024_start -- DECODE(...) statement list begin
5147
5148    ffestd_V024_start();
5149
5150    Verify that DECODE is valid here, and begin accepting items in the
5151    list.  */
5152
5153 void
5154 ffestd_V024_start ()
5155 {
5156   ffestd_check_start_ ();
5157   ffestd_subr_vxt_ ();
5158 }
5159
5160 /* ffestd_V024_item -- DECODE statement i/o item
5161
5162    ffestd_V024_item(expr,expr_token);
5163
5164    Implement output-list expression.  */
5165
5166 void
5167 ffestd_V024_item (ffebld expr)
5168 {
5169   ffestd_check_item_ ();
5170 }
5171
5172 /* ffestd_V024_finish -- DECODE statement list complete
5173
5174    ffestd_V024_finish();
5175
5176    Just wrap up any local activities.  */
5177
5178 void
5179 ffestd_V024_finish ()
5180 {
5181   ffestd_check_finish_ ();
5182 }
5183
5184 /* ffestd_V025_start -- DEFINEFILE statement list begin
5185
5186    ffestd_V025_start();
5187
5188    Verify that DEFINEFILE is valid here, and begin accepting items in the
5189    list.  */
5190
5191 void
5192 ffestd_V025_start ()
5193 {
5194   ffestd_check_start_ ();
5195   ffestd_subr_vxt_ ();
5196 }
5197
5198 /* ffestd_V025_item -- DEFINE FILE statement item
5199
5200    ffestd_V025_item(u,ut,m,mt,n,nt,asv,asvt);
5201
5202    Implement item.  Treat each item kind of like a separate statement,
5203    since there's really no need to treat them as an aggregate.  */
5204
5205 void
5206 ffestd_V025_item (ffebld u, ffebld m, ffebld n, ffebld asv)
5207 {
5208   ffestd_check_item_ ();
5209 }
5210
5211 /* ffestd_V025_finish -- DEFINE FILE statement list complete
5212
5213    ffestd_V025_finish();
5214
5215    Just wrap up any local activities.  */
5216
5217 void
5218 ffestd_V025_finish ()
5219 {
5220   ffestd_check_finish_ ();
5221 }
5222
5223 /* ffestd_V026 -- FIND statement
5224
5225    ffestd_V026();
5226
5227    Make sure a FIND is valid in the current context, and implement it.  */
5228
5229 void
5230 ffestd_V026 ()
5231 {
5232   ffestd_check_simple_ ();
5233   ffestd_subr_vxt_ ();
5234 }
5235
5236 #endif
5237 /* ffestd_V027_start -- VXT PARAMETER statement list begin
5238
5239    ffestd_V027_start();
5240
5241    Verify that PARAMETER is valid here, and begin accepting items in the list.  */
5242
5243 void
5244 ffestd_V027_start ()
5245 {
5246   ffestd_check_start_ ();
5247   ffestd_subr_vxt_ ();
5248 }
5249
5250 /* ffestd_V027_item -- VXT PARAMETER statement assignment
5251
5252    ffestd_V027_item(dest,dest_token,source,source_token);
5253
5254    Make sure the source is a valid source for the destination; make the
5255    assignment.  */
5256
5257 void
5258 ffestd_V027_item (ffelexToken dest_token UNUSED, ffebld source UNUSED)
5259 {
5260   ffestd_check_item_ ();
5261 }
5262
5263 /* ffestd_V027_finish -- VXT PARAMETER statement list complete
5264
5265    ffestd_V027_finish();
5266
5267    Just wrap up any local activities.  */
5268
5269 void
5270 ffestd_V027_finish ()
5271 {
5272   ffestd_check_finish_ ();
5273 }
5274
5275 /* Any executable statement.  */
5276
5277 void
5278 ffestd_any ()
5279 {
5280   ffestdStmt_ stmt;
5281
5282   ffestd_check_simple_ ();
5283
5284   stmt = ffestd_stmt_new_ (FFESTD_stmtidR841_);
5285   ffestd_stmt_append_ (stmt);
5286   ffestd_subr_line_save_ (stmt);
5287 }