gcc/f/std.c

   1 /* std.c -- Implementation File (module.c template V1.0)
   2    Copyright (C) 1995, 1996, 2000 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 #if FFECOM_TWOPASS
  73 typedef enum
  74   {
  75     FFESTD_stmtidENDDOLOOP_,
  76     FFESTD_stmtidENDLOGIF_,
  77     FFESTD_stmtidEXECLABEL_,
  78     FFESTD_stmtidFORMATLABEL_,
  79     FFESTD_stmtidR737A_,        /* let */
  80     FFESTD_stmtidR803_,         /* IF-block */
  81     FFESTD_stmtidR804_,         /* ELSE IF */
  82     FFESTD_stmtidR805_,         /* ELSE */
  83     FFESTD_stmtidR806_,         /* END IF */
  84     FFESTD_stmtidR807_,         /* IF-logical */
  85     FFESTD_stmtidR809_,         /* SELECT CASE */
  86     FFESTD_stmtidR810_,         /* CASE */
  87     FFESTD_stmtidR811_,         /* END SELECT */
  88     FFESTD_stmtidR819A_,        /* DO-iterative */
  89     FFESTD_stmtidR819B_,        /* DO WHILE */
  90     FFESTD_stmtidR825_,         /* END DO */
  91     FFESTD_stmtidR834_,         /* CYCLE */
  92     FFESTD_stmtidR835_,         /* EXIT */
  93     FFESTD_stmtidR836_,         /* GOTO */
  94     FFESTD_stmtidR837_,         /* GOTO-computed */
  95     FFESTD_stmtidR838_,         /* ASSIGN */
  96     FFESTD_stmtidR839_,         /* GOTO-assigned */
  97     FFESTD_stmtidR840_,         /* IF-arithmetic */
  98     FFESTD_stmtidR841_,         /* CONTINUE */
  99     FFESTD_stmtidR842_,         /* STOP */
 100     FFESTD_stmtidR843_,         /* PAUSE */
 101     FFESTD_stmtidR904_,         /* OPEN */
 102     FFESTD_stmtidR907_,         /* CLOSE */
 103     FFESTD_stmtidR909_,         /* READ */
 104     FFESTD_stmtidR910_,         /* WRITE */
 105     FFESTD_stmtidR911_,         /* PRINT */
 106     FFESTD_stmtidR919_,         /* BACKSPACE */
 107     FFESTD_stmtidR920_,         /* ENDFILE */
 108     FFESTD_stmtidR921_,         /* REWIND */
 109     FFESTD_stmtidR923A_,        /* INQUIRE */
 110     FFESTD_stmtidR923B_,        /* INQUIRE-iolength */
 111     FFESTD_stmtidR1001_,        /* FORMAT */
 112     FFESTD_stmtidR1103_,        /* END_PROGRAM */
 113     FFESTD_stmtidR1112_,        /* END_BLOCK_DATA */
 114     FFESTD_stmtidR1212_,        /* CALL */
 115     FFESTD_stmtidR1221_,        /* END_FUNCTION */
 116     FFESTD_stmtidR1225_,        /* END_SUBROUTINE */
 117     FFESTD_stmtidR1226_,        /* ENTRY */
 118     FFESTD_stmtidR1227_,        /* RETURN */
 119 #if FFESTR_VXT
 120     FFESTD_stmtidV018_,         /* REWRITE */
 121     FFESTD_stmtidV019_,         /* ACCEPT */
 122 #endif
 123     FFESTD_stmtidV020_,         /* TYPE */
 124 #if FFESTR_VXT
 125     FFESTD_stmtidV021_,         /* DELETE */
 126     FFESTD_stmtidV022_,         /* UNLOCK */
 127     FFESTD_stmtidV023_,         /* ENCODE */
 128     FFESTD_stmtidV024_,         /* DECODE */
 129     FFESTD_stmtidV025start_,    /* DEFINEFILE (start) */
 130     FFESTD_stmtidV025item_,     /* (DEFINEFILE item) */
 131     FFESTD_stmtidV025finish_,   /* (DEFINEFILE finish) */
 132     FFESTD_stmtidV026_,         /* FIND */
 133 #endif
 134     FFESTD_stmtid_,
 135   } ffestdStmtId_;
 136
 137 #endif
 138
 139 /* Internal typedefs. */
 140
 141 typedef struct _ffestd_expr_item_ *ffestdExprItem_;
 142 #if FFECOM_TWOPASS
 143 typedef struct _ffestd_stmt_ *ffestdStmt_;
 144 #endif
 145
 146 /* Private include files. */
 147
 148
 149 /* Internal structure definitions. */
 150
 151 struct _ffestd_expr_item_
 152   {
 153     ffestdExprItem_ next;
 154     ffebld expr;
 155     ffelexToken token;
 156   };
 157
 158 #if FFECOM_TWOPASS
 159 struct _ffestd_stmt_
 160   {
 161     ffestdStmt_ next;
 162     ffestdStmt_ previous;
 163     ffestdStmtId_ id;
 164 #if FFECOM_targetCURRENT == FFECOM_targetGCC
 165     char *filename;
 166     int filelinenum;
 167 #endif
 168     union
 169       {
 170         struct
 171           {
 172             ffestw block;
 173           }
 174         enddoloop;
 175         struct
 176           {
 177             ffelab label;
 178           }
 179         execlabel;
 180         struct
 181           {
 182             ffelab label;
 183           }
 184         formatlabel;
 185         struct
 186           {
 187             mallocPool pool;
 188             ffebld dest;
 189             ffebld source;
 190           }
 191         R737A;
 192         struct
 193           {
 194             mallocPool pool;
 195             ffestw block;
 196             ffebld expr;
 197           }
 198         R803;
 199         struct
 200           {
 201             mallocPool pool;
 202             ffestw block;
 203             ffebld expr;
 204           }
 205         R804;
 206         struct
 207           {
 208             ffestw block;
 209           }
 210         R805;
 211         struct
 212           {
 213             ffestw block;
 214           }
 215         R806;
 216         struct
 217           {
 218             mallocPool pool;
 219             ffebld expr;
 220           }
 221         R807;
 222         struct
 223           {
 224             mallocPool pool;
 225             ffestw block;
 226             ffebld expr;
 227           }
 228         R809;
 229         struct
 230           {
 231             mallocPool pool;
 232             ffestw block;
 233             unsigned long casenum;
 234           }
 235         R810;
 236         struct
 237           {
 238             ffestw block;
 239           }
 240         R811;
 241         struct
 242           {
 243             mallocPool pool;
 244             ffestw block;
 245             ffelab label;
 246             ffebld var;
 247             ffebld start;
 248             ffelexToken start_token;
 249             ffebld end;
 250             ffelexToken end_token;
 251             ffebld incr;
 252             ffelexToken incr_token;
 253           }
 254         R819A;
 255         struct
 256           {
 257             mallocPool pool;
 258             ffestw block;
 259             ffelab label;
 260             ffebld expr;
 261           }
 262         R819B;
 263         struct
 264           {
 265             ffestw block;
 266           }
 267         R834;
 268         struct
 269           {
 270             ffestw block;
 271           }
 272         R835;
 273         struct
 274           {
 275             ffelab label;
 276           }
 277         R836;
 278         struct
 279           {
 280             mallocPool pool;
 281             ffelab *labels;
 282             int count;
 283             ffebld expr;
 284           }
 285         R837;
 286         struct
 287           {
 288             mallocPool pool;
 289             ffelab label;
 290             ffebld target;
 291           }
 292         R838;
 293         struct
 294           {
 295             mallocPool pool;
 296             ffebld target;
 297           }
 298         R839;
 299         struct
 300           {
 301             mallocPool pool;
 302             ffebld expr;
 303             ffelab neg;
 304             ffelab zero;
 305             ffelab pos;
 306           }
 307         R840;
 308         struct
 309           {
 310             mallocPool pool;
 311             ffebld expr;
 312           }
 313         R842;
 314         struct
 315           {
 316             mallocPool pool;
 317             ffebld expr;
 318           }
 319         R843;
 320         struct
 321           {
 322             mallocPool pool;
 323             ffestpOpenStmt *params;
 324           }
 325         R904;
 326         struct
 327           {
 328             mallocPool pool;
 329             ffestpCloseStmt *params;
 330           }
 331         R907;
 332         struct
 333           {
 334             mallocPool pool;
 335             ffestpReadStmt *params;
 336             bool only_format;
 337             ffestvUnit unit;
 338             ffestvFormat format;
 339             bool rec;
 340             bool key;
 341             ffestdExprItem_ list;
 342           }
 343         R909;
 344         struct
 345           {
 346             mallocPool pool;
 347             ffestpWriteStmt *params;
 348             ffestvUnit unit;
 349             ffestvFormat format;
 350             bool rec;
 351             ffestdExprItem_ list;
 352           }
 353         R910;
 354         struct
 355           {
 356             mallocPool pool;
 357             ffestpPrintStmt *params;
 358             ffestvFormat format;
 359             ffestdExprItem_ list;
 360           }
 361         R911;
 362         struct
 363           {
 364             mallocPool pool;
 365             ffestpBeruStmt *params;
 366           }
 367         R919;
 368         struct
 369           {
 370             mallocPool pool;
 371             ffestpBeruStmt *params;
 372           }
 373         R920;
 374         struct
 375           {
 376             mallocPool pool;
 377             ffestpBeruStmt *params;
 378           }
 379         R921;
 380         struct
 381           {
 382             mallocPool pool;
 383             ffestpInquireStmt *params;
 384             bool by_file;
 385           }
 386         R923A;
 387         struct
 388           {
 389             mallocPool pool;
 390             ffestpInquireStmt *params;
 391             ffestdExprItem_ list;
 392           }
 393         R923B;
 394         struct
 395           {
 396             ffestsHolder str;
 397           }
 398         R1001;
 399         struct
 400           {
 401             mallocPool pool;
 402             ffebld expr;
 403           }
 404         R1212;
 405         struct
 406           {
 407             ffesymbol entry;
 408             int entrynum;
 409           }
 410         R1226;
 411         struct
 412           {
 413             mallocPool pool;
 414             ffestw block;
 415             ffebld expr;
 416           }
 417         R1227;
 418 #if FFESTR_VXT
 419         struct
 420           {
 421             mallocPool pool;
 422             ffestpRewriteStmt *params;
 423             ffestvFormat format;
 424             ffestdExprItem_ list;
 425           }
 426         V018;
 427         struct
 428           {
 429             mallocPool pool;
 430             ffestpAcceptStmt *params;
 431             ffestvFormat format;
 432             ffestdExprItem_ list;
 433           }
 434         V019;
 435 #endif
 436         struct
 437           {
 438             mallocPool pool;
 439             ffestpTypeStmt *params;
 440             ffestvFormat format;
 441             ffestdExprItem_ list;
 442           }
 443         V020;
 444 #if FFESTR_VXT
 445         struct
 446           {
 447             mallocPool pool;
 448             ffestpDeleteStmt *params;
 449           }
 450         V021;
 451         struct
 452           {
 453             mallocPool pool;
 454             ffestpBeruStmt *params;
 455           }
 456         V022;
 457         struct
 458           {
 459             mallocPool pool;
 460             ffestpVxtcodeStmt *params;
 461             ffestdExprItem_ list;
 462           }
 463         V023;
 464         struct
 465           {
 466             mallocPool pool;
 467             ffestpVxtcodeStmt *params;
 468             ffestdExprItem_ list;
 469           }
 470         V024;
 471         struct
 472           {
 473             ffebld u;
 474             ffebld m;
 475             ffebld n;
 476             ffebld asv;
 477           }
 478         V025item;
 479         struct
 480           {
 481             mallocPool pool;
 482           } V025finish;
 483         struct
 484           {
 485             mallocPool pool;
 486             ffestpFindStmt *params;
 487           }
 488         V026;
 489 #endif
 490       }
 491     u;
 492   };
 493
 494 #endif
 495
 496 /* Static objects accessed by functions in this module. */
 497
 498 static ffestdStatelet_ ffestd_statelet_ = FFESTD_stateletSIMPLE_;
 499 static int ffestd_block_level_ = 0;     /* Block level for reachableness. */
 500 static bool ffestd_is_reachable_;       /* Is the current stmt reachable?  */
 501 static ffelab ffestd_label_formatdef_ = NULL;
 502 #if FFECOM_TWOPASS
 503 static ffestdExprItem_ *ffestd_expr_list_;
 504 static struct
 505   {
 506     ffestdStmt_ first;
 507     ffestdStmt_ last;
 508   }
 509
 510 ffestd_stmt_list_
 511 =
 512 {
 513   NULL, NULL
 514 };
 515
 516 #endif
 517 #if FFECOM_targetCURRENT == FFECOM_targetGCC
 518 static int ffestd_2pass_entrypoints_ = 0;       /* # ENTRY statements
 519                                                    pending. */
 520 #endif
 521
 522 /* Static functions (internal). */
 523
 524 #if FFECOM_TWOPASS
 525 static void ffestd_stmt_append_ (ffestdStmt_ stmt);
 526 static ffestdStmt_ ffestd_stmt_new_ (ffestdStmtId_ id);
 527 static void ffestd_stmt_pass_ (void);
 528 #endif
 529 #if FFESTD_COPY_EASY_ && FFECOM_TWOPASS
 530 static ffestpInquireStmt *ffestd_subr_copy_easy_ (ffestpInquireIx max);
 531 #endif
 532 #if FFECOM_targetCURRENT == FFECOM_targetGCC
 533 static void ffestd_subr_vxt_ (void);
 534 #endif
 535 #if FFESTR_F90
 536 static void ffestd_subr_f90_ (void);
 537 #endif
 538 static void ffestd_subr_labels_ (bool unexpected);
 539 static void ffestd_R1001dump_ (ffests s, ffesttFormatList list);
 540 static void ffestd_R1001dump_1005_1_ (ffests s, ffesttFormatList f,
 541                                       const char *string);
 542 static void ffestd_R1001dump_1005_2_ (ffests s, ffesttFormatList f,
 543                                       const char *string);
 544 static void ffestd_R1001dump_1005_3_ (ffests s, ffesttFormatList f,
 545                                       const char *string);
 546 static void ffestd_R1001dump_1005_4_ (ffests s, ffesttFormatList f,
 547                                       const char *string);
 548 static void ffestd_R1001dump_1005_5_ (ffests s, ffesttFormatList f,
 549                                       const char *string);
 550 static void ffestd_R1001dump_1010_1_ (ffests s, ffesttFormatList f,
 551                                       const char *string);
 552 static void ffestd_R1001dump_1010_2_ (ffests s, ffesttFormatList f,
 553                                       const char *string);
 554 static void ffestd_R1001dump_1010_3_ (ffests s, ffesttFormatList f,
 555                                       const char *string);
 556 static void ffestd_R1001dump_1010_4_ (ffests s, ffesttFormatList f,
 557                                       const char *string);
 558 static void ffestd_R1001dump_1010_5_ (ffests s, ffesttFormatList f,
 559                                       const char *string);
 560 static void ffestd_R1001error_ (ffesttFormatList f);
 561 static void ffestd_R1001rtexpr_ (ffests s, ffesttFormatList f, ffebld expr);
 562
 563 /* Internal macros. */
 564
 565 #if FFECOM_targetCURRENT == FFECOM_targetGCC
 566 #define ffestd_subr_line_now_()                                        \
 567   ffeste_set_line (ffelex_token_where_filename (ffesta_tokens[0]), \
 568                    ffelex_token_where_filelinenum (ffesta_tokens[0]))
 569 #define ffestd_subr_line_restore_(s) \
 570   ffeste_set_line ((s)->filename, (s)->filelinenum)
 571 #define ffestd_subr_line_save_(s)                                          \
 572   ((s)->filename = ffelex_token_where_filename (ffesta_tokens[0]),         \
 573    (s)->filelinenum = ffelex_token_where_filelinenum (ffesta_tokens[0]))
 574 #else
 575 #define ffestd_subr_line_now_()
 576 #if FFECOM_TWOPASS
 577 #define ffestd_subr_line_restore_(s)
 578 #define ffestd_subr_line_save_(s)
 579 #endif  /* FFECOM_TWOPASS */
 580 #endif  /* FFECOM_targetCURRENT != FFECOM_targetGCC */
 581 #define ffestd_check_simple_() \
 582       assert(ffestd_statelet_ == FFESTD_stateletSIMPLE_)
 583 #define ffestd_check_start_() \
 584       assert(ffestd_statelet_ == FFESTD_stateletSIMPLE_); \
 585       ffestd_statelet_ = FFESTD_stateletATTRIB_
 586 #define ffestd_check_attrib_() \
 587       assert(ffestd_statelet_ == FFESTD_stateletATTRIB_)
 588 #define ffestd_check_item_() \
 589       assert(ffestd_statelet_ == FFESTD_stateletATTRIB_  \
 590             || ffestd_statelet_ == FFESTD_stateletITEM_); \
 591       ffestd_statelet_ = FFESTD_stateletITEM_
 592 #define ffestd_check_item_startvals_() \
 593       assert(ffestd_statelet_ == FFESTD_stateletATTRIB_  \
 594             || ffestd_statelet_ == FFESTD_stateletITEM_); \
 595       ffestd_statelet_ = FFESTD_stateletITEMVALS_
 596 #define ffestd_check_item_value_() \
 597       assert(ffestd_statelet_ == FFESTD_stateletITEMVALS_)
 598 #define ffestd_check_item_endvals_() \
 599       assert(ffestd_statelet_ == FFESTD_stateletITEMVALS_); \
 600       ffestd_statelet_ = FFESTD_stateletITEM_
 601 #define ffestd_check_finish_() \
 602       assert(ffestd_statelet_ == FFESTD_stateletATTRIB_  \
 603             || ffestd_statelet_ == FFESTD_stateletITEM_); \
 604       ffestd_statelet_ = FFESTD_stateletSIMPLE_
 605
 606 #if FFESTD_COPY_EASY_ && FFECOM_TWOPASS
 607 #define ffestd_subr_copy_accept_() (ffestpAcceptStmt *) \
 608       ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_acceptix)
 609 #define ffestd_subr_copy_beru_() (ffestpBeruStmt *) \
 610       ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_beruix)
 611 #define ffestd_subr_copy_close_() (ffestpCloseStmt *) \
 612       ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_closeix)
 613 #define ffestd_subr_copy_delete_() (ffestpDeleteStmt *) \
 614       ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_deleteix)
 615 #define ffestd_subr_copy_find_() (ffestpFindStmt *) \
 616       ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_findix)
 617 #define ffestd_subr_copy_inquire_() (ffestpInquireStmt *) \
 618       ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_inquireix)
 619 #define ffestd_subr_copy_open_() (ffestpOpenStmt *) \
 620       ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_openix)
 621 #define ffestd_subr_copy_print_() (ffestpPrintStmt *) \
 622       ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_printix)
 623 #define ffestd_subr_copy_read_() (ffestpReadStmt *) \
 624       ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_readix)
 625 #define ffestd_subr_copy_rewrite_() (ffestpRewriteStmt *) \
 626       ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_rewriteix)
 627 #define ffestd_subr_copy_type_() (ffestpTypeStmt *) \
 628       ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_typeix)
 629 #define ffestd_subr_copy_vxtcode_() (ffestpVxtcodeStmt *) \
 630       ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_vxtcodeix)
 631 #define ffestd_subr_copy_write_() (ffestpWriteStmt *) \
 632       ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_writeix)
 633 #endif
 634 \f
 635 /* ffestd_stmt_append_ -- Append statement to end of stmt list
 636
 637    ffestd_stmt_append_(ffestd_stmt_new_(FFESTD_stmtidR737A_));  */
 638
 639 #if FFECOM_TWOPASS
 640 static void
 641 ffestd_stmt_append_ (ffestdStmt_ stmt)
 642 {
 643   stmt->next = (ffestdStmt_) &ffestd_stmt_list_.first;
 644   stmt->previous = ffestd_stmt_list_.last;
 645   stmt->next->previous = stmt;
 646   stmt->previous->next = stmt;
 647 }
 648
 649 #endif
 650 /* ffestd_stmt_new_ -- Make new statement with given id
 651
 652    ffestdStmt_ stmt;
 653    stmt = ffestd_stmt_new_(FFESTD_stmtidR737A_);  */
 654
 655 #if FFECOM_TWOPASS
 656 static ffestdStmt_
 657 ffestd_stmt_new_ (ffestdStmtId_ id)
 658 {
 659   ffestdStmt_ stmt;
 660
 661   stmt = malloc_new_kp (ffe_pool_any_unit (), "ffestdStmt_", sizeof (*stmt));
 662   stmt->id = id;
 663   return stmt;
 664 }
 665
 666 #endif
 667 /* ffestd_stmt_pass_ -- Pass all statements on list to ffeste
 668
 669    ffestd_stmt_pass_();  */
 670
 671 #if FFECOM_TWOPASS
 672 static void
 673 ffestd_stmt_pass_ ()
 674 {
 675   ffestdStmt_ stmt;
 676   ffestdExprItem_ expr;         /* For traversing lists. */
 677   bool okay = (TREE_CODE (current_function_decl) != ERROR_MARK);
 678
 679 #if FFECOM_targetCURRENT == FFECOM_targetGCC
 680   if ((ffestd_2pass_entrypoints_ != 0) && okay)
 681     {
 682       tree which = ffecom_which_entrypoint_decl ();
 683       tree value;
 684       tree label;
 685       int pushok;
 686       int ents = ffestd_2pass_entrypoints_;
 687       tree duplicate;
 688
 689       expand_start_case (0, which, TREE_TYPE (which), "entrypoint dispatch");
 690
 691       stmt = ffestd_stmt_list_.first;
 692       do
 693         {
 694           while (stmt->id != FFESTD_stmtidR1226_)
 695             stmt = stmt->next;
 696
 697           if (stmt->u.R1226.entry != NULL)
 698             {
 699               value = build_int_2 (stmt->u.R1226.entrynum, 0);
 700               /* Yes, we really want to build a null LABEL_DECL here and not
 701                  put it on any list.  That's what pushcase wants, so that's
 702                  what it gets!  */
 703               label = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE);
 704
 705               pushok = pushcase (value, convert, label, &duplicate);
 706               assert (pushok == 0);
 707
 708               label = ffecom_temp_label ();
 709               TREE_USED (label) = 1;
 710               expand_goto (label);
 711
 712               ffesymbol_hook (stmt->u.R1226.entry).length_tree = label;
 713             }
 714           stmt = stmt->next;
 715         }
 716       while (--ents != 0);
 717
 718       expand_end_case (which);
 719     }
 720 #endif
 721
 722   for (stmt = ffestd_stmt_list_.first;
 723        stmt != (ffestdStmt_) &ffestd_stmt_list_.first;
 724        stmt = stmt->next)
 725     {
 726       switch (stmt->id)
 727         {
 728         case FFESTD_stmtidENDDOLOOP_:
 729           ffestd_subr_line_restore_ (stmt);
 730           if (okay)
 731             ffeste_do (stmt->u.enddoloop.block);
 732           ffestw_kill (stmt->u.enddoloop.block);
 733           break;
 734
 735         case FFESTD_stmtidENDLOGIF_:
 736           ffestd_subr_line_restore_ (stmt);
 737           if (okay)
 738             ffeste_end_R807 ();
 739           break;
 740
 741         case FFESTD_stmtidEXECLABEL_:
 742           if (okay)
 743             ffeste_labeldef_branch (stmt->u.execlabel.label);
 744           break;
 745
 746         case FFESTD_stmtidFORMATLABEL_:
 747           if (okay)
 748             ffeste_labeldef_format (stmt->u.formatlabel.label);
 749           break;
 750
 751         case FFESTD_stmtidR737A_:
 752           ffestd_subr_line_restore_ (stmt);
 753           if (okay)
 754             ffeste_R737A (stmt->u.R737A.dest, stmt->u.R737A.source);
 755           malloc_pool_kill (stmt->u.R737A.pool);
 756           break;
 757
 758         case FFESTD_stmtidR803_:
 759           ffestd_subr_line_restore_ (stmt);
 760           if (okay)
 761             ffeste_R803 (stmt->u.R803.block, stmt->u.R803.expr);
 762           malloc_pool_kill (stmt->u.R803.pool);
 763           break;
 764
 765         case FFESTD_stmtidR804_:
 766           ffestd_subr_line_restore_ (stmt);
 767           if (okay)
 768             ffeste_R804 (stmt->u.R803.block, stmt->u.R804.expr);
 769           malloc_pool_kill (stmt->u.R804.pool);
 770           break;
 771
 772         case FFESTD_stmtidR805_:
 773           ffestd_subr_line_restore_ (stmt);
 774           if (okay)
 775             ffeste_R805 (stmt->u.R803.block);
 776           break;
 777
 778         case FFESTD_stmtidR806_:
 779           ffestd_subr_line_restore_ (stmt);
 780           if (okay)
 781             ffeste_R806 (stmt->u.R806.block);
 782           ffestw_kill (stmt->u.R806.block);
 783           break;
 784
 785         case FFESTD_stmtidR807_:
 786           ffestd_subr_line_restore_ (stmt);
 787           if (okay)
 788             ffeste_R807 (stmt->u.R807.expr);
 789           malloc_pool_kill (stmt->u.R807.pool);
 790           break;
 791
 792         case FFESTD_stmtidR809_:
 793           ffestd_subr_line_restore_ (stmt);
 794           if (okay)
 795             ffeste_R809 (stmt->u.R809.block, stmt->u.R809.expr);
 796           malloc_pool_kill (stmt->u.R809.pool);
 797           break;
 798
 799         case FFESTD_stmtidR810_:
 800           ffestd_subr_line_restore_ (stmt);
 801           if (okay)
 802             ffeste_R810 (stmt->u.R810.block, stmt->u.R810.casenum);
 803           malloc_pool_kill (stmt->u.R810.pool);
 804           break;
 805
 806         case FFESTD_stmtidR811_:
 807           ffestd_subr_line_restore_ (stmt);
 808           if (okay)
 809             ffeste_R811 (stmt->u.R811.block);
 810           malloc_pool_kill (ffestw_select (stmt->u.R811.block)->pool);
 811           ffestw_kill (stmt->u.R811.block);
 812           break;
 813
 814         case FFESTD_stmtidR819A_:
 815           ffestd_subr_line_restore_ (stmt);
 816           if (okay)
 817             ffeste_R819A (stmt->u.R819A.block, stmt->u.R819A.label,
 818                           stmt->u.R819A.var,
 819                           stmt->u.R819A.start, stmt->u.R819A.start_token,
 820                           stmt->u.R819A.end, stmt->u.R819A.end_token,
 821                           stmt->u.R819A.incr, stmt->u.R819A.incr_token);
 822           ffelex_token_kill (stmt->u.R819A.start_token);
 823           ffelex_token_kill (stmt->u.R819A.end_token);
 824           if (stmt->u.R819A.incr_token != NULL)
 825             ffelex_token_kill (stmt->u.R819A.incr_token);
 826           malloc_pool_kill (stmt->u.R819A.pool);
 827           break;
 828
 829         case FFESTD_stmtidR819B_:
 830           ffestd_subr_line_restore_ (stmt);
 831           if (okay)
 832             ffeste_R819B (stmt->u.R819B.block, stmt->u.R819B.label,
 833                           stmt->u.R819B.expr);
 834           malloc_pool_kill (stmt->u.R819B.pool);
 835           break;
 836
 837         case FFESTD_stmtidR825_:
 838           ffestd_subr_line_restore_ (stmt);
 839           if (okay)
 840             ffeste_R825 ();
 841           break;
 842
 843         case FFESTD_stmtidR834_:
 844           ffestd_subr_line_restore_ (stmt);
 845           if (okay)
 846             ffeste_R834 (stmt->u.R834.block);
 847           break;
 848
 849         case FFESTD_stmtidR835_:
 850           ffestd_subr_line_restore_ (stmt);
 851           if (okay)
 852             ffeste_R835 (stmt->u.R835.block);
 853           break;
 854
 855         case FFESTD_stmtidR836_:
 856           ffestd_subr_line_restore_ (stmt);
 857           if (okay)
 858             ffeste_R836 (stmt->u.R836.label);
 859           break;
 860
 861         case FFESTD_stmtidR837_:
 862           ffestd_subr_line_restore_ (stmt);
 863           if (okay)
 864             ffeste_R837 (stmt->u.R837.labels, stmt->u.R837.count,
 865                          stmt->u.R837.expr);
 866           malloc_pool_kill (stmt->u.R837.pool);
 867           break;
 868
 869         case FFESTD_stmtidR838_:
 870           ffestd_subr_line_restore_ (stmt);
 871           if (okay)
 872             ffeste_R838 (stmt->u.R838.label, stmt->u.R838.target);
 873           malloc_pool_kill (stmt->u.R838.pool);
 874           break;
 875
 876         case FFESTD_stmtidR839_:
 877           ffestd_subr_line_restore_ (stmt);
 878           if (okay)
 879             ffeste_R839 (stmt->u.R839.target);
 880           malloc_pool_kill (stmt->u.R839.pool);
 881           break;
 882
 883         case FFESTD_stmtidR840_:
 884           ffestd_subr_line_restore_ (stmt);
 885           if (okay)
 886             ffeste_R840 (stmt->u.R840.expr, stmt->u.R840.neg, stmt->u.R840.zero,
 887                          stmt->u.R840.pos);
 888           malloc_pool_kill (stmt->u.R840.pool);
 889           break;
 890
 891         case FFESTD_stmtidR841_:
 892           ffestd_subr_line_restore_ (stmt);
 893           if (okay)
 894             ffeste_R841 ();
 895           break;
 896
 897         case FFESTD_stmtidR842_:
 898           ffestd_subr_line_restore_ (stmt);
 899           if (okay)
 900             ffeste_R842 (stmt->u.R842.expr);
 901           if (stmt->u.R842.pool != NULL)
 902             malloc_pool_kill (stmt->u.R842.pool);
 903           break;
 904
 905         case FFESTD_stmtidR843_:
 906           ffestd_subr_line_restore_ (stmt);
 907           if (okay)
 908             ffeste_R843 (stmt->u.R843.expr);
 909           malloc_pool_kill (stmt->u.R843.pool);
 910           break;
 911
 912         case FFESTD_stmtidR904_:
 913           ffestd_subr_line_restore_ (stmt);
 914           if (okay)
 915             ffeste_R904 (stmt->u.R904.params);
 916           malloc_pool_kill (stmt->u.R904.pool);
 917           break;
 918
 919         case FFESTD_stmtidR907_:
 920           ffestd_subr_line_restore_ (stmt);
 921           if (okay)
 922             ffeste_R907 (stmt->u.R907.params);
 923           malloc_pool_kill (stmt->u.R907.pool);
 924           break;
 925
 926         case FFESTD_stmtidR909_:
 927           ffestd_subr_line_restore_ (stmt);
 928           if (okay)
 929             ffeste_R909_start (stmt->u.R909.params, stmt->u.R909.only_format,
 930                                stmt->u.R909.unit, stmt->u.R909.format,
 931                                stmt->u.R909.rec, stmt->u.R909.key);
 932           for (expr = stmt->u.R909.list; expr != NULL; expr = expr->next)
 933             {
 934               if (okay)
 935                 ffeste_R909_item (expr->expr, expr->token);
 936               ffelex_token_kill (expr->token);
 937             }
 938           if (okay)
 939             ffeste_R909_finish ();
 940           malloc_pool_kill (stmt->u.R909.pool);
 941           break;
 942
 943         case FFESTD_stmtidR910_:
 944           ffestd_subr_line_restore_ (stmt);
 945           if (okay)
 946             ffeste_R910_start (stmt->u.R910.params, stmt->u.R910.unit,
 947                                stmt->u.R910.format, stmt->u.R910.rec);
 948           for (expr = stmt->u.R910.list; expr != NULL; expr = expr->next)
 949             {
 950               if (okay)
 951                 ffeste_R910_item (expr->expr, expr->token);
 952               ffelex_token_kill (expr->token);
 953             }
 954           if (okay)
 955             ffeste_R910_finish ();
 956           malloc_pool_kill (stmt->u.R910.pool);
 957           break;
 958
 959         case FFESTD_stmtidR911_:
 960           ffestd_subr_line_restore_ (stmt);
 961           if (okay)
 962             ffeste_R911_start (stmt->u.R911.params, stmt->u.R911.format);
 963           for (expr = stmt->u.R911.list; expr != NULL; expr = expr->next)
 964             {
 965               if (okay)
 966                 ffeste_R911_item (expr->expr, expr->token);
 967               ffelex_token_kill (expr->token);
 968             }
 969           if (okay)
 970             ffeste_R911_finish ();
 971           malloc_pool_kill (stmt->u.R911.pool);
 972           break;
 973
 974         case FFESTD_stmtidR919_:
 975           ffestd_subr_line_restore_ (stmt);
 976           if (okay)
 977             ffeste_R919 (stmt->u.R919.params);
 978           malloc_pool_kill (stmt->u.R919.pool);
 979           break;
 980
 981         case FFESTD_stmtidR920_:
 982           ffestd_subr_line_restore_ (stmt);
 983           if (okay)
 984             ffeste_R920 (stmt->u.R920.params);
 985           malloc_pool_kill (stmt->u.R920.pool);
 986           break;
 987
 988         case FFESTD_stmtidR921_:
 989           ffestd_subr_line_restore_ (stmt);
 990           if (okay)
 991             ffeste_R921 (stmt->u.R921.params);
 992           malloc_pool_kill (stmt->u.R921.pool);
 993           break;
 994
 995         case FFESTD_stmtidR923A_:
 996           ffestd_subr_line_restore_ (stmt);
 997           if (okay)
 998             ffeste_R923A (stmt->u.R923A.params, stmt->u.R923A.by_file);
 999           malloc_pool_kill (stmt->u.R923A.pool);
1000           break;
1001
1002         case FFESTD_stmtidR923B_:
1003           ffestd_subr_line_restore_ (stmt);
1004           if (okay)
1005             ffeste_R923B_start (stmt->u.R923B.params);
1006           for (expr = stmt->u.R923B.list; expr != NULL; expr = expr->next)
1007             {
1008               if (okay)
1009                 ffeste_R923B_item (expr->expr);
1010             }
1011           if (okay)
1012             ffeste_R923B_finish ();
1013           malloc_pool_kill (stmt->u.R923B.pool);
1014           break;
1015
1016         case FFESTD_stmtidR1001_:
1017           if (okay)
1018             ffeste_R1001 (&stmt->u.R1001.str);
1019           ffests_kill (&stmt->u.R1001.str);
1020           break;
1021
1022         case FFESTD_stmtidR1103_:
1023           if (okay)
1024             ffeste_R1103 ();
1025           break;
1026
1027         case FFESTD_stmtidR1112_:
1028           if (okay)
1029             ffeste_R1112 ();
1030           break;
1031
1032         case FFESTD_stmtidR1212_:
1033           ffestd_subr_line_restore_ (stmt);
1034           if (okay)
1035             ffeste_R1212 (stmt->u.R1212.expr);
1036           malloc_pool_kill (stmt->u.R1212.pool);
1037           break;
1038
1039         case FFESTD_stmtidR1221_:
1040           if (okay)
1041             ffeste_R1221 ();
1042           break;
1043
1044         case FFESTD_stmtidR1225_:
1045           if (okay)
1046             ffeste_R1225 ();
1047           break;
1048
1049         case FFESTD_stmtidR1226_:
1050           ffestd_subr_line_restore_ (stmt);
1051           if (stmt->u.R1226.entry != NULL)
1052             {
1053               if (okay)
1054                 ffeste_R1226 (stmt->u.R1226.entry);
1055             }
1056           break;
1057
1058         case FFESTD_stmtidR1227_:
1059           ffestd_subr_line_restore_ (stmt);
1060           if (okay)
1061             ffeste_R1227 (stmt->u.R1227.block, stmt->u.R1227.expr);
1062           malloc_pool_kill (stmt->u.R1227.pool);
1063           break;
1064
1065 #if FFESTR_VXT
1066         case FFESTD_stmtidV018_:
1067           ffestd_subr_line_restore_ (stmt);
1068           if (okay)
1069             ffeste_V018_start (stmt->u.V018.params, stmt->u.V018.format);
1070           for (expr = stmt->u.V018.list; expr != NULL; expr = expr->next)
1071             {
1072               if (okay)
1073                 ffeste_V018_item (expr->expr);
1074             }
1075           if (okay)
1076             ffeste_V018_finish ();
1077           malloc_pool_kill (stmt->u.V018.pool);
1078           break;
1079
1080         case FFESTD_stmtidV019_:
1081           ffestd_subr_line_restore_ (stmt);
1082           if (okay)
1083             ffeste_V019_start (stmt->u.V019.params, stmt->u.V019.format);
1084           for (expr = stmt->u.V019.list; expr != NULL; expr = expr->next)
1085             {
1086               if (okay)
1087                 ffeste_V019_item (expr->expr);
1088             }
1089           if (okay)
1090             ffeste_V019_finish ();
1091           malloc_pool_kill (stmt->u.V019.pool);
1092           break;
1093 #endif
1094
1095         case FFESTD_stmtidV020_:
1096           ffestd_subr_line_restore_ (stmt);
1097           if (okay)
1098             ffeste_V020_start (stmt->u.V020.params, stmt->u.V020.format);
1099           for (expr = stmt->u.V020.list; expr != NULL; expr = expr->next)
1100             {
1101               if (okay)
1102                 ffeste_V020_item (expr->expr);
1103             }
1104           if (okay)
1105             ffeste_V020_finish ();
1106           malloc_pool_kill (stmt->u.V020.pool);
1107           break;
1108
1109 #if FFESTR_VXT
1110         case FFESTD_stmtidV021_:
1111           ffestd_subr_line_restore_ (stmt);
1112           if (okay)
1113             ffeste_V021 (stmt->u.V021.params);
1114           malloc_pool_kill (stmt->u.V021.pool);
1115           break;
1116
1117         case FFESTD_stmtidV023_:
1118           ffestd_subr_line_restore_ (stmt);
1119           if (okay)
1120             ffeste_V023_start (stmt->u.V023.params);
1121           for (expr = stmt->u.V023.list; expr != NULL; expr = expr->next)
1122             {
1123               if (okay)
1124                 ffeste_V023_item (expr->expr);
1125             }
1126           if (okay)
1127             ffeste_V023_finish ();
1128           malloc_pool_kill (stmt->u.V023.pool);
1129           break;
1130
1131         case FFESTD_stmtidV024_:
1132           ffestd_subr_line_restore_ (stmt);
1133           if (okay)
1134             ffeste_V024_start (stmt->u.V024.params);
1135           for (expr = stmt->u.V024.list; expr != NULL; expr = expr->next)
1136             {
1137               if (okay)
1138                 ffeste_V024_item (expr->expr);
1139             }
1140           if (okay)
1141             ffeste_V024_finish ();
1142           malloc_pool_kill (stmt->u.V024.pool);
1143           break;
1144
1145         case FFESTD_stmtidV025start_:
1146           ffestd_subr_line_restore_ (stmt);
1147           if (okay)
1148             ffeste_V025_start ();
1149           break;
1150
1151         case FFESTD_stmtidV025item_:
1152           if (okay)
1153             ffeste_V025_item (stmt->u.V025item.u, stmt->u.V025item.m,
1154                               stmt->u.V025item.n, stmt->u.V025item.asv);
1155           break;
1156
1157         case FFESTD_stmtidV025finish_:
1158           if (okay)
1159             ffeste_V025_finish ();
1160           malloc_pool_kill (stmt->u.V025finish.pool);
1161           break;
1162
1163         case FFESTD_stmtidV026_:
1164           ffestd_subr_line_restore_ (stmt);
1165           if (okay)
1166             ffeste_V026 (stmt->u.V026.params);
1167           malloc_pool_kill (stmt->u.V026.pool);
1168           break;
1169 #endif
1170
1171         default:
1172           assert ("bad stmt->id" == NULL);
1173           break;
1174         }
1175     }
1176 }
1177
1178 #endif
1179 /* ffestd_subr_copy_easy_ -- Copy I/O statement data structure
1180
1181    ffestd_subr_copy_easy_();
1182
1183    Copies all data except tokens in the I/O data structure into a new
1184    structure that lasts as long as the output pool for the current
1185    statement.  Assumes that they are
1186    overlaid with each other (union) in stp.h and the typing
1187    and structure references assume (though not necessarily dangerous if
1188    FALSE) that INQUIRE has the most file elements.  */
1189
1190 #if FFESTD_COPY_EASY_ && FFECOM_TWOPASS
1191 static ffestpInquireStmt *
1192 ffestd_subr_copy_easy_ (ffestpInquireIx max)
1193 {
1194   ffestpInquireStmt *stmt;
1195   ffestpInquireIx ix;
1196
1197   stmt = (ffestpInquireStmt *) malloc_new_kp (ffesta_output_pool,
1198                                   "FFESTD easy", sizeof (ffestpFile) * max);
1199
1200   for (ix = 0; ix < max; ++ix)
1201     {
1202       if ((stmt->inquire_spec[ix].kw_or_val_present
1203            = ffestp_file.inquire.inquire_spec[ix].kw_or_val_present)
1204           && (stmt->inquire_spec[ix].value_present
1205               = ffestp_file.inquire.inquire_spec[ix].value_present))
1206         {
1207           if ((stmt->inquire_spec[ix].value_is_label
1208                = ffestp_file.inquire.inquire_spec[ix].value_is_label))
1209             stmt->inquire_spec[ix].u.label
1210               = ffestp_file.inquire.inquire_spec[ix].u.label;
1211           else
1212             stmt->inquire_spec[ix].u.expr
1213               = ffestp_file.inquire.inquire_spec[ix].u.expr;
1214         }
1215     }
1216
1217   return stmt;
1218 }
1219
1220 #endif
1221 /* ffestd_subr_labels_ -- Handle any undefined labels
1222
1223    ffestd_subr_labels_(FALSE);
1224
1225    For every undefined label, generate an error message and either define
1226    label as a FORMAT() statement (for FORMAT labels) or as a STOP statement
1227    (for all other labels).  */
1228
1229 static void
1230 ffestd_subr_labels_ (bool unexpected)
1231 {
1232   ffelab l;
1233   ffelabHandle h;
1234   ffelabNumber undef;
1235   ffesttFormatList f;
1236
1237   undef = ffelab_number () - ffestv_num_label_defines_;
1238
1239   for (h = ffelab_handle_first (); h != NULL; h = ffelab_handle_next (h))
1240     {
1241       l = ffelab_handle_target (h);
1242       if (ffewhere_line_is_unknown (ffelab_definition_line (l)))
1243         {                       /* Undefined label. */
1244           assert (!unexpected);
1245           assert (undef > 0);
1246           undef--;
1247           ffebad_start (FFEBAD_UNDEF_LABEL);
1248           if (ffelab_type (l) == FFELAB_typeLOOPEND)
1249             ffebad_here (0, ffelab_doref_line (l), ffelab_doref_column (l));
1250           else if (ffelab_type (l) != FFELAB_typeANY)
1251             ffebad_here (0, ffelab_firstref_line (l), ffelab_firstref_column (l));
1252           else if (!ffewhere_line_is_unknown (ffelab_firstref_line (l)))
1253             ffebad_here (0, ffelab_firstref_line (l), ffelab_firstref_column (l));
1254           else if (!ffewhere_line_is_unknown (ffelab_doref_line (l)))
1255             ffebad_here (0, ffelab_doref_line (l), ffelab_doref_column (l));
1256           else
1257             ffebad_here (0, ffelab_definition_line (l), ffelab_definition_column (l));
1258           ffebad_finish ();
1259
1260           switch (ffelab_type (l))
1261             {
1262             case FFELAB_typeFORMAT:
1263               ffelab_set_definition_line (l,
1264                               ffewhere_line_use (ffelab_firstref_line (l)));
1265               ffelab_set_definition_column (l,
1266                           ffewhere_column_use (ffelab_firstref_column (l)));
1267               ffestv_num_label_defines_++;
1268               f = ffestt_formatlist_create (NULL, NULL);
1269               ffestd_labeldef_format (l);
1270               ffestd_R1001 (f);
1271               ffestt_formatlist_kill (f);
1272               break;
1273
1274             case FFELAB_typeASSIGNABLE:
1275               ffelab_set_definition_line (l,
1276                               ffewhere_line_use (ffelab_firstref_line (l)));
1277               ffelab_set_definition_column (l,
1278                           ffewhere_column_use (ffelab_firstref_column (l)));
1279               ffestv_num_label_defines_++;
1280               ffelab_set_type (l, FFELAB_typeNOTLOOP);
1281               ffelab_set_blocknum (l, ffestw_blocknum (ffestw_stack_top ()));
1282               ffestd_labeldef_notloop (l);
1283               ffestd_R842 (NULL);
1284               break;
1285
1286             case FFELAB_typeNOTLOOP:
1287               ffelab_set_definition_line (l,
1288                               ffewhere_line_use (ffelab_firstref_line (l)));
1289               ffelab_set_definition_column (l,
1290                           ffewhere_column_use (ffelab_firstref_column (l)));
1291               ffestv_num_label_defines_++;
1292               ffelab_set_blocknum (l, ffestw_blocknum (ffestw_stack_top ()));
1293               ffestd_labeldef_notloop (l);
1294               ffestd_R842 (NULL);
1295               break;
1296
1297             default:
1298               assert ("bad label type" == NULL);
1299               /* Fall through. */
1300             case FFELAB_typeUNKNOWN:
1301             case FFELAB_typeANY:
1302               break;
1303             }
1304         }
1305     }
1306   ffelab_handle_done (h);
1307   assert (undef == 0);
1308 }
1309
1310 /* ffestd_subr_f90_ -- Report error about lack of full F90 support
1311
1312    ffestd_subr_f90_();  */
1313
1314 #if FFESTR_F90
1315 static void
1316 ffestd_subr_f90_ ()
1317 {
1318   ffebad_start (FFEBAD_F90);
1319   ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
1320                ffelex_token_where_column (ffesta_tokens[0]));
1321   ffebad_finish ();
1322 }
1323
1324 #endif
1325 /* ffestd_subr_vxt_ -- Report error about lack of full VXT support
1326
1327    ffestd_subr_vxt_();  */
1328
1329 #if FFECOM_targetCURRENT == FFECOM_targetGCC
1330 static void
1331 ffestd_subr_vxt_ ()
1332 {
1333   ffebad_start (FFEBAD_VXT_UNSUPPORTED);
1334   ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
1335                ffelex_token_where_column (ffesta_tokens[0]));
1336   ffebad_finish ();
1337 }
1338
1339 #endif
1340 /* ffestd_begin_uses -- Start a bunch of USE statements
1341
1342    ffestd_begin_uses();
1343
1344    Invoked before handling the first USE statement in a block of one or
1345    more USE statements.  _end_uses_(bool ok) is invoked before handling
1346    the first statement after the block (there are no BEGIN USE and END USE
1347    statements, but the semantics of USE statements effectively requires
1348    handling them as a single block rather than one statement at a time).  */
1349
1350 void
1351 ffestd_begin_uses ()
1352 {
1353 #if FFECOM_targetCURRENT == FFECOM_targetFFE
1354   fputs ("; begin_uses\n", dmpout);
1355 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
1356 #else
1357 #error
1358 #endif
1359 }
1360
1361 /* ffestd_do -- End of statement following DO-term-stmt etc
1362
1363    ffestd_do(TRUE);
1364
1365    Also invoked by _labeldef_branch_finish_ (or, in cases
1366    of errors, other _labeldef_ functions) when the label definition is
1367    for a DO-target (LOOPEND) label, once per matching/outstanding DO
1368    block on the stack.  These cases invoke this function with ok==TRUE, so
1369    only forced stack popping (via ffestd_eof_()) invokes it with ok==FALSE.  */
1370
1371 void
1372 ffestd_do (bool ok UNUSED)
1373 {
1374 #if FFECOM_ONEPASS
1375   ffestd_subr_line_now_ ();
1376   ffeste_do (ffestw_stack_top ());
1377 #else
1378   {
1379     ffestdStmt_ stmt;
1380
1381     stmt = ffestd_stmt_new_ (FFESTD_stmtidENDDOLOOP_);
1382     ffestd_stmt_append_ (stmt);
1383     ffestd_subr_line_save_ (stmt);
1384     stmt->u.enddoloop.block = ffestw_stack_top ();
1385   }
1386 #endif
1387
1388   --ffestd_block_level_;
1389   assert (ffestd_block_level_ >= 0);
1390 }
1391
1392 /* ffestd_end_uses -- End a bunch of USE statements
1393
1394    ffestd_end_uses(TRUE);
1395
1396    ok==TRUE means simply not popping due to ffestd_eof_()
1397    being called, because there is no formal END USES statement in Fortran.  */
1398
1399 #if FFESTR_F90
1400 void
1401 ffestd_end_uses (bool ok)
1402 {
1403 #if FFECOM_targetCURRENT == FFECOM_targetFFE
1404   fputs ("; end_uses\n", dmpout);
1405 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
1406 #else
1407 #error
1408 #endif
1409 }
1410
1411 /* ffestd_end_R740 -- End a WHERE(-THEN)
1412
1413    ffestd_end_R740(TRUE);  */
1414
1415 void
1416 ffestd_end_R740 (bool ok)
1417 {
1418   return;                       /* F90. */
1419 }
1420
1421 #endif
1422 /* ffestd_end_R807 -- End of statement following logical IF
1423
1424    ffestd_end_R807(TRUE);
1425
1426    Applies ONLY to logical IF, not to IF-THEN.  For example, does not
1427    ffelex_token_kill the construct name for an IF-THEN block (the name
1428    field is invalid for logical IF).  ok==TRUE iff statement following
1429    logical IF (substatement) is valid; else, statement is invalid or
1430    stack forcibly popped due to ffestd_eof_().  */
1431
1432 void
1433 ffestd_end_R807 (bool ok UNUSED)
1434 {
1435 #if FFECOM_ONEPASS
1436   ffestd_subr_line_now_ ();
1437   ffeste_end_R807 ();
1438 #else
1439   {
1440     ffestdStmt_ stmt;
1441
1442     stmt = ffestd_stmt_new_ (FFESTD_stmtidENDLOGIF_);
1443     ffestd_stmt_append_ (stmt);
1444     ffestd_subr_line_save_ (stmt);
1445   }
1446 #endif
1447
1448   --ffestd_block_level_;
1449   assert (ffestd_block_level_ >= 0);
1450 }
1451
1452 /* ffestd_exec_begin -- Executable statements can start coming in now
1453
1454    ffestd_exec_begin();  */
1455
1456 void
1457 ffestd_exec_begin ()
1458 {
1459   ffecom_exec_transition ();
1460
1461 #if FFECOM_targetCURRENT == FFECOM_targetFFE
1462   fputs ("{ begin_exec\n", dmpout);
1463 #endif
1464
1465 #if FFECOM_targetCURRENT == FFECOM_targetGCC
1466   if (ffestd_2pass_entrypoints_ != 0)
1467     {                           /* Process pending ENTRY statements now that
1468                                    info filled in. */
1469       ffestdStmt_ stmt;
1470       int ents = ffestd_2pass_entrypoints_;
1471
1472       stmt = ffestd_stmt_list_.first;
1473       do
1474         {
1475           while (stmt->id != FFESTD_stmtidR1226_)
1476             stmt = stmt->next;
1477
1478           if (!ffecom_2pass_advise_entrypoint (stmt->u.R1226.entry))
1479             {
1480               stmt->u.R1226.entry = NULL;
1481               --ffestd_2pass_entrypoints_;
1482             }
1483           stmt = stmt->next;
1484         }
1485       while (--ents != 0);
1486     }
1487 #endif
1488 }
1489
1490 /* ffestd_exec_end -- Executable statements can no longer come in now
1491
1492    ffestd_exec_end();  */
1493
1494 void
1495 ffestd_exec_end ()
1496 {
1497 #if FFECOM_targetCURRENT == FFECOM_targetGCC
1498   int old_lineno = lineno;
1499   const char *old_input_filename = input_filename;
1500 #endif
1501
1502   ffecom_end_transition ();
1503
1504 #if FFECOM_TWOPASS
1505   ffestd_stmt_pass_ ();
1506 #endif
1507
1508 #if FFECOM_targetCURRENT == FFECOM_targetFFE
1509   fputs ("} end_exec\n", dmpout);
1510   fputs ("> end_unit\n", dmpout);
1511 #endif
1512
1513 #if FFECOM_targetCURRENT == FFECOM_targetGCC
1514   ffecom_finish_progunit ();
1515
1516   if (ffestd_2pass_entrypoints_ != 0)
1517     {
1518       int ents = ffestd_2pass_entrypoints_;
1519       ffestdStmt_ stmt = ffestd_stmt_list_.first;
1520
1521       do
1522         {
1523           while (stmt->id != FFESTD_stmtidR1226_)
1524             stmt = stmt->next;
1525
1526           if (stmt->u.R1226.entry != NULL)
1527             {
1528               ffestd_subr_line_restore_ (stmt);
1529               ffecom_2pass_do_entrypoint (stmt->u.R1226.entry);
1530             }
1531           stmt = stmt->next;
1532         }
1533       while (--ents != 0);
1534     }
1535
1536   ffestd_stmt_list_.first = NULL;
1537   ffestd_stmt_list_.last = NULL;
1538   ffestd_2pass_entrypoints_ = 0;
1539
1540   lineno = old_lineno;
1541   input_filename = old_input_filename;
1542 #endif
1543 }
1544
1545 /* ffestd_init_3 -- Initialize for any program unit
1546
1547    ffestd_init_3();  */
1548
1549 void
1550 ffestd_init_3 ()
1551 {
1552 #if FFECOM_TWOPASS
1553   ffestd_stmt_list_.first = (ffestdStmt_) &ffestd_stmt_list_.first;
1554   ffestd_stmt_list_.last = (ffestdStmt_) &ffestd_stmt_list_.first;
1555 #endif
1556 }
1557
1558 /* Generate "code" for "any" label def.  */
1559
1560 void
1561 ffestd_labeldef_any (ffelab label UNUSED)
1562 {
1563 #if FFECOM_targetCURRENT == FFECOM_targetFFE
1564   fprintf (dmpout, "; any_label_def %lu\n", ffelab_value (label));
1565 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
1566 #else
1567 #error
1568 #endif
1569 }
1570
1571 /* ffestd_labeldef_branch -- Generate "code" for branch label def
1572
1573    ffestd_labeldef_branch(label);  */
1574
1575 void
1576 ffestd_labeldef_branch (ffelab label)
1577 {
1578 #if FFECOM_ONEPASS
1579   ffeste_labeldef_branch (label);
1580 #else
1581   {
1582     ffestdStmt_ stmt;
1583
1584     stmt = ffestd_stmt_new_ (FFESTD_stmtidEXECLABEL_);
1585     ffestd_stmt_append_ (stmt);
1586     stmt->u.execlabel.label = label;
1587   }
1588 #endif
1589
1590   ffestd_is_reachable_ = TRUE;
1591 }
1592
1593 /* ffestd_labeldef_format -- Generate "code" for FORMAT label def
1594
1595    ffestd_labeldef_format(label);  */
1596
1597 void
1598 ffestd_labeldef_format (ffelab label)
1599 {
1600   ffestd_label_formatdef_ = label;
1601
1602 #if FFECOM_ONEPASS
1603   ffeste_labeldef_format (label);
1604 #else
1605   {
1606     ffestdStmt_ stmt;
1607
1608     stmt = ffestd_stmt_new_ (FFESTD_stmtidFORMATLABEL_);
1609 #if 0
1610     /* Don't bother with this.  See FORMAT statement.  */
1611     /* Prepend FORMAT label instead of appending it, so all the
1612        FORMAT label/statement pairs end up at the top of the list.
1613        This helps ensure all decls for a block (in the GBE) are
1614        known before any executable statements are generated.  */
1615     stmt->previous = (ffestdStmt_) &ffestd_stmt_list_.first;
1616     stmt->next = ffestd_stmt_list_.first;
1617     stmt->next->previous = stmt;
1618     stmt->previous->next = stmt;
1619 #else
1620     ffestd_stmt_append_ (stmt);
1621 #endif
1622     stmt->u.formatlabel.label = label;
1623   }
1624 #endif
1625 }
1626
1627 /* ffestd_labeldef_useless -- Generate "code" for useless label def
1628
1629    ffestd_labeldef_useless(label);  */
1630
1631 void
1632 ffestd_labeldef_useless (ffelab label UNUSED)
1633 {
1634 #if FFECOM_targetCURRENT == FFECOM_targetFFE
1635   fprintf (dmpout, "; useless_label_def %lu\n", ffelab_value (label));
1636 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
1637 #else
1638 #error
1639 #endif
1640 }
1641
1642 /* ffestd_R423A -- PRIVATE statement (in R422 derived-type statement)
1643
1644    ffestd_R423A();  */
1645
1646 #if FFESTR_F90
1647 void
1648 ffestd_R423A ()
1649 {
1650   ffestd_check_simple_ ();
1651
1652 #if FFECOM_targetCURRENT == FFECOM_targetFFE
1653   fputs ("* PRIVATE_derived_type\n", dmpout);
1654 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
1655 #else
1656 #error
1657 #endif
1658 }
1659
1660 /* ffestd_R423B -- SEQUENCE statement (in R422 derived-type-stmt)
1661
1662    ffestd_R423B();  */
1663
1664 void
1665 ffestd_R423B ()
1666 {
1667   ffestd_check_simple_ ();
1668
1669 #if FFECOM_targetCURRENT == FFECOM_targetFFE
1670   fputs ("* SEQUENCE_derived_type\n", dmpout);
1671 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
1672 #else
1673 #error
1674 #endif
1675 }
1676
1677 /* ffestd_R424 -- derived-TYPE-def statement
1678
1679    ffestd_R424(access_token,access_kw,name_token);
1680
1681    Handle a derived-type definition.  */
1682
1683 void
1684 ffestd_R424 (ffelexToken access, ffestrOther access_kw, ffelexToken name)
1685 {
1686   ffestd_check_simple_ ();
1687
1688   ffestd_subr_f90_ ();
1689   return;
1690
1691 #ifdef FFESTD_F90
1692   char *a;
1693
1694   if (access == NULL)
1695     fprintf (dmpout, "* TYPE %s\n", ffelex_token_text (name));
1696   else
1697     {
1698       switch (access_kw)
1699         {
1700         case FFESTR_otherPUBLIC:
1701           a = "PUBLIC";
1702           break;
1703
1704         case FFESTR_otherPRIVATE:
1705           a = "PRIVATE";
1706           break;
1707
1708         default:
1709           assert (FALSE);
1710         }
1711       fprintf (dmpout, "* TYPE,%s: %s\n", a, ffelex_token_text (name));
1712     }
1713 #endif
1714 }
1715
1716 /* ffestd_R425 -- End a TYPE
1717
1718    ffestd_R425(TRUE);  */
1719
1720 void
1721 ffestd_R425 (bool ok)
1722 {
1723 #if FFECOM_targetCURRENT == FFECOM_targetFFE
1724   fprintf (dmpout, "* END_TYPE %s\n", ffelex_token_text (ffestw_name (ffestw_stack_top ())));
1725 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
1726 #else
1727 #error
1728 #endif
1729 }
1730
1731 /* ffestd_R519_start -- INTENT statement list begin
1732
1733    ffestd_R519_start();
1734
1735    Verify that INTENT is valid here, and begin accepting items in the list.  */
1736
1737 void
1738 ffestd_R519_start (ffestrOther intent_kw)
1739 {
1740   ffestd_check_start_ ();
1741
1742   ffestd_subr_f90_ ();
1743   return;
1744
1745 #ifdef FFESTD_F90
1746   char *a;
1747
1748   switch (intent_kw)
1749     {
1750     case FFESTR_otherIN:
1751       a = "IN";
1752       break;
1753
1754     case FFESTR_otherOUT:
1755       a = "OUT";
1756       break;
1757
1758     case FFESTR_otherINOUT:
1759       a = "INOUT";
1760       break;
1761
1762     default:
1763       assert (FALSE);
1764     }
1765   fprintf (dmpout, "* INTENT (%s) ", a);
1766 #endif
1767 }
1768
1769 /* ffestd_R519_item -- INTENT statement for name
1770
1771    ffestd_R519_item(name_token);
1772
1773    Make sure name_token identifies a valid object to be INTENTed.  */
1774
1775 void
1776 ffestd_R519_item (ffelexToken name)
1777 {
1778   ffestd_check_item_ ();
1779
1780   return;                       /* F90. */
1781
1782 #ifdef FFESTD_F90
1783   fprintf (dmpout, "%s,", ffelex_token_text (name));
1784 #endif
1785 }
1786
1787 /* ffestd_R519_finish -- INTENT statement list complete
1788
1789    ffestd_R519_finish();
1790
1791    Just wrap up any local activities.  */
1792
1793 void
1794 ffestd_R519_finish ()
1795 {
1796   ffestd_check_finish_ ();
1797
1798   return;                       /* F90. */
1799
1800 #ifdef FFESTD_F90
1801   fputc ('\n', dmpout);
1802 #endif
1803 }
1804
1805 /* ffestd_R520_start -- OPTIONAL statement list begin
1806
1807    ffestd_R520_start();
1808
1809    Verify that OPTIONAL is valid here, and begin accepting items in the list.  */
1810
1811 void
1812 ffestd_R520_start ()
1813 {
1814   ffestd_check_start_ ();
1815
1816   ffestd_subr_f90_ ();
1817   return;
1818
1819 #ifdef FFESTD_F90
1820   fputs ("* OPTIONAL ", dmpout);
1821 #endif
1822 }
1823
1824 /* ffestd_R520_item -- OPTIONAL statement for name
1825
1826    ffestd_R520_item(name_token);
1827
1828    Make sure name_token identifies a valid object to be OPTIONALed.  */
1829
1830 void
1831 ffestd_R520_item (ffelexToken name)
1832 {
1833   ffestd_check_item_ ();
1834
1835   return;                       /* F90. */
1836
1837 #ifdef FFESTD_F90
1838   fprintf (dmpout, "%s,", ffelex_token_text (name));
1839 #endif
1840 }
1841
1842 /* ffestd_R520_finish -- OPTIONAL statement list complete
1843
1844    ffestd_R520_finish();
1845
1846    Just wrap up any local activities.  */
1847
1848 void
1849 ffestd_R520_finish ()
1850 {
1851   ffestd_check_finish_ ();
1852
1853   return;                       /* F90. */
1854
1855 #ifdef FFESTD_F90
1856   fputc ('\n', dmpout);
1857 #endif
1858 }
1859
1860 /* ffestd_R521A -- PUBLIC statement
1861
1862    ffestd_R521A();
1863
1864    Verify that PUBLIC is valid here.  */
1865
1866 void
1867 ffestd_R521A ()
1868 {
1869   ffestd_check_simple_ ();
1870
1871   ffestd_subr_f90_ ();
1872   return;
1873
1874 #ifdef FFESTD_F90
1875   fputs ("* PUBLIC\n", dmpout);
1876 #endif
1877 }
1878
1879 /* ffestd_R521Astart -- PUBLIC statement list begin
1880
1881    ffestd_R521Astart();
1882
1883    Verify that PUBLIC is valid here, and begin accepting items in the list.  */
1884
1885 void
1886 ffestd_R521Astart ()
1887 {
1888   ffestd_check_start_ ();
1889
1890   ffestd_subr_f90_ ();
1891   return;
1892
1893 #ifdef FFESTD_F90
1894   fputs ("* PUBLIC ", dmpout);
1895 #endif
1896 }
1897
1898 /* ffestd_R521Aitem -- PUBLIC statement for name
1899
1900    ffestd_R521Aitem(name_token);
1901
1902    Make sure name_token identifies a valid object to be PUBLICed.  */
1903
1904 void
1905 ffestd_R521Aitem (ffelexToken name)
1906 {
1907   ffestd_check_item_ ();
1908
1909   return;                       /* F90. */
1910
1911 #ifdef FFESTD_F90
1912   fprintf (dmpout, "%s,", ffelex_token_text (name));
1913 #endif
1914 }
1915
1916 /* ffestd_R521Afinish -- PUBLIC statement list complete
1917
1918    ffestd_R521Afinish();
1919
1920    Just wrap up any local activities.  */
1921
1922 void
1923 ffestd_R521Afinish ()
1924 {
1925   ffestd_check_finish_ ();
1926
1927   return;                       /* F90. */
1928
1929 #ifdef FFESTD_F90
1930   fputc ('\n', dmpout);
1931 #endif
1932 }
1933
1934 /* ffestd_R521B -- PRIVATE statement
1935
1936    ffestd_R521B();
1937
1938    Verify that PRIVATE is valid here (outside a derived-type statement).  */
1939
1940 void
1941 ffestd_R521B ()
1942 {
1943   ffestd_check_simple_ ();
1944
1945   ffestd_subr_f90_ ();
1946   return;
1947
1948 #ifdef FFESTD_F90
1949   fputs ("* PRIVATE_outside_of_R422_derived_type_def\n", dmpout);
1950 #endif
1951 }
1952
1953 /* ffestd_R521Bstart -- PRIVATE statement list begin
1954
1955    ffestd_R521Bstart();
1956
1957    Verify that PRIVATE is valid here, and begin accepting items in the list.  */
1958
1959 void
1960 ffestd_R521Bstart ()
1961 {
1962   ffestd_check_start_ ();
1963
1964   ffestd_subr_f90_ ();
1965   return;
1966
1967 #ifdef FFESTD_F90
1968   fputs ("* PRIVATE ", dmpout);
1969 #endif
1970 }
1971
1972 /* ffestd_R521Bitem -- PRIVATE statement for name
1973
1974    ffestd_R521Bitem(name_token);
1975
1976    Make sure name_token identifies a valid object to be PRIVATEed.  */
1977
1978 void
1979 ffestd_R521Bitem (ffelexToken name)
1980 {
1981   ffestd_check_item_ ();
1982
1983   return;                       /* F90. */
1984
1985 #ifdef FFESTD_F90
1986   fprintf (dmpout, "%s,", ffelex_token_text (name));
1987 #endif
1988 }
1989
1990 /* ffestd_R521Bfinish -- PRIVATE statement list complete
1991
1992    ffestd_R521Bfinish();
1993
1994    Just wrap up any local activities.  */
1995
1996 void
1997 ffestd_R521Bfinish ()
1998 {
1999   ffestd_check_finish_ ();
2000
2001   return;                       /* F90. */
2002
2003 #ifdef FFESTD_F90
2004   fputc ('\n', dmpout);
2005 #endif
2006 }
2007
2008 #endif
2009 /* ffestd_R522 -- SAVE statement with no list
2010
2011    ffestd_R522();
2012
2013    Verify that SAVE is valid here, and flag everything as SAVEd.  */
2014
2015 void
2016 ffestd_R522 ()
2017 {
2018   ffestd_check_simple_ ();
2019
2020 #if FFECOM_targetCURRENT == FFECOM_targetFFE
2021   fputs ("* SAVE_all\n", dmpout);
2022 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
2023 #else
2024 #error
2025 #endif
2026 }
2027
2028 /* ffestd_R522start -- SAVE statement list begin
2029
2030    ffestd_R522start();
2031
2032    Verify that SAVE is valid here, and begin accepting items in the list.  */
2033
2034 void
2035 ffestd_R522start ()
2036 {
2037   ffestd_check_start_ ();
2038
2039 #if FFECOM_targetCURRENT == FFECOM_targetFFE
2040   fputs ("* SAVE ", dmpout);
2041 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
2042 #else
2043 #error
2044 #endif
2045 }
2046
2047 /* ffestd_R522item_object -- SAVE statement for object-name
2048
2049    ffestd_R522item_object(name_token);
2050
2051    Make sure name_token identifies a valid object to be SAVEd.  */
2052
2053 void
2054 ffestd_R522item_object (ffelexToken name UNUSED)
2055 {
2056   ffestd_check_item_ ();
2057
2058 #if FFECOM_targetCURRENT == FFECOM_targetFFE
2059   fprintf (dmpout, "%s,", ffelex_token_text (name));
2060 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
2061 #else
2062 #error
2063 #endif
2064 }
2065
2066 /* ffestd_R522item_cblock -- SAVE statement for common-block-name
2067
2068    ffestd_R522item_cblock(name_token);
2069
2070    Make sure name_token identifies a valid common block to be SAVEd.  */
2071
2072 void
2073 ffestd_R522item_cblock (ffelexToken name UNUSED)
2074 {
2075   ffestd_check_item_ ();
2076
2077 #if FFECOM_targetCURRENT == FFECOM_targetFFE
2078   fprintf (dmpout, "/%s/,", ffelex_token_text (name));
2079 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
2080 #else
2081 #error
2082 #endif
2083 }
2084
2085 /* ffestd_R522finish -- SAVE statement list complete
2086
2087    ffestd_R522finish();
2088
2089    Just wrap up any local activities.  */
2090
2091 void
2092 ffestd_R522finish ()
2093 {
2094   ffestd_check_finish_ ();
2095
2096 #if FFECOM_targetCURRENT == FFECOM_targetFFE
2097   fputc ('\n', dmpout);
2098 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
2099 #else
2100 #error
2101 #endif
2102 }
2103
2104 /* ffestd_R524_start -- DIMENSION statement list begin
2105
2106    ffestd_R524_start(bool virtual);
2107
2108    Verify that DIMENSION is valid here, and begin accepting items in the list.  */
2109
2110 void
2111 ffestd_R524_start (bool virtual UNUSED)
2112 {
2113   ffestd_check_start_ ();
2114
2115 #if FFECOM_targetCURRENT == FFECOM_targetFFE
2116   if (virtual)
2117     fputs ("* VIRTUAL ", dmpout);       /* V028. */
2118   else
2119     fputs ("* DIMENSION ", dmpout);
2120 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
2121 #else
2122 #error
2123 #endif
2124 }
2125
2126 /* ffestd_R524_item -- DIMENSION statement for object-name
2127
2128    ffestd_R524_item(name_token,dim_list);
2129
2130    Make sure name_token identifies a valid object to be DIMENSIONd.  */
2131
2132 void
2133 ffestd_R524_item (ffelexToken name UNUSED, ffesttDimList dims UNUSED)
2134 {
2135   ffestd_check_item_ ();
2136
2137 #if FFECOM_targetCURRENT == FFECOM_targetFFE
2138   fputs (ffelex_token_text (name), dmpout);
2139   fputc ('(', dmpout);
2140   ffestt_dimlist_dump (dims);
2141   fputs ("),", dmpout);
2142 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
2143 #else
2144 #error
2145 #endif
2146 }
2147
2148 /* ffestd_R524_finish -- DIMENSION statement list complete
2149
2150    ffestd_R524_finish();
2151
2152    Just wrap up any local activities.  */
2153
2154 void
2155 ffestd_R524_finish ()
2156 {
2157   ffestd_check_finish_ ();
2158
2159 #if FFECOM_targetCURRENT == FFECOM_targetFFE
2160   fputc ('\n', dmpout);
2161 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
2162 #else
2163 #error
2164 #endif
2165 }
2166
2167 /* ffestd_R525_start -- ALLOCATABLE statement list begin
2168
2169    ffestd_R525_start();
2170
2171    Verify that ALLOCATABLE is valid here, and begin accepting items in the
2172    list.  */
2173
2174 #if FFESTR_F90
2175 void
2176 ffestd_R525_start ()
2177 {
2178   ffestd_check_start_ ();
2179
2180   ffestd_subr_f90_ ();
2181   return;
2182
2183 #ifdef FFESTD_F90
2184   fputs ("* ALLOCATABLE ", dmpout);
2185 #endif
2186 }
2187
2188 /* ffestd_R525_item -- ALLOCATABLE statement for object-name
2189
2190    ffestd_R525_item(name_token,dim_list);
2191
2192    Make sure name_token identifies a valid object to be ALLOCATABLEd.  */
2193
2194 void
2195 ffestd_R525_item (ffelexToken name, ffesttDimList dims)
2196 {
2197   ffestd_check_item_ ();
2198
2199   return;                       /* F90. */
2200
2201 #ifdef FFESTD_F90
2202   fputs (ffelex_token_text (name), dmpout);
2203   if (dims != NULL)
2204     {
2205       fputc ('(', dmpout);
2206       ffestt_dimlist_dump (dims);
2207       fputc (')', dmpout);
2208     }
2209   fputc (',', dmpout);
2210 #endif
2211 }
2212
2213 /* ffestd_R525_finish -- ALLOCATABLE statement list complete
2214
2215    ffestd_R525_finish();
2216
2217    Just wrap up any local activities.  */
2218
2219 void
2220 ffestd_R525_finish ()
2221 {
2222   ffestd_check_finish_ ();
2223
2224   return;                       /* F90. */
2225
2226 #ifdef FFESTD_F90
2227   fputc ('\n', dmpout);
2228 #endif
2229 }
2230
2231 /* ffestd_R526_start -- POINTER statement list begin
2232
2233    ffestd_R526_start();
2234
2235    Verify that POINTER is valid here, and begin accepting items in the
2236    list.  */
2237
2238 void
2239 ffestd_R526_start ()
2240 {
2241   ffestd_check_start_ ();
2242
2243   ffestd_subr_f90_ ();
2244   return;
2245
2246 #ifdef FFESTD_F90
2247   fputs ("* POINTER ", dmpout);
2248 #endif
2249 }
2250
2251 /* ffestd_R526_item -- POINTER statement for object-name
2252
2253    ffestd_R526_item(name_token,dim_list);
2254
2255    Make sure name_token identifies a valid object to be POINTERd.  */
2256
2257 void
2258 ffestd_R526_item (ffelexToken name, ffesttDimList dims)
2259 {
2260   ffestd_check_item_ ();
2261
2262   return;                       /* F90. */
2263
2264 #ifdef FFESTD_F90
2265   fputs (ffelex_token_text (name), dmpout);
2266   if (dims != NULL)
2267     {
2268       fputc ('(', dmpout);
2269       ffestt_dimlist_dump (dims);
2270       fputc (')', dmpout);
2271     }
2272   fputc (',', dmpout);
2273 #endif
2274 }
2275
2276 /* ffestd_R526_finish -- POINTER statement list complete
2277
2278    ffestd_R526_finish();
2279
2280    Just wrap up any local activities.  */
2281
2282 void
2283 ffestd_R526_finish ()
2284 {
2285   ffestd_check_finish_ ();
2286
2287   return;                       /* F90. */
2288
2289 #ifdef FFESTD_F90
2290   fputc ('\n', dmpout);
2291 #endif
2292 }
2293
2294 /* ffestd_R527_start -- TARGET statement list begin
2295
2296    ffestd_R527_start();
2297
2298    Verify that TARGET is valid here, and begin accepting items in the
2299    list.  */
2300
2301 void
2302 ffestd_R527_start ()
2303 {
2304   ffestd_check_start_ ();
2305
2306   ffestd_subr_f90_ ();
2307   return;
2308
2309 #ifdef FFESTD_F90
2310   fputs ("* TARGET ", dmpout);
2311 #endif
2312 }
2313
2314 /* ffestd_R527_item -- TARGET statement for object-name
2315
2316    ffestd_R527_item(name_token,dim_list);
2317
2318    Make sure name_token identifies a valid object to be TARGETd.  */
2319
2320 void
2321 ffestd_R527_item (ffelexToken name, ffesttDimList dims)
2322 {
2323   ffestd_check_item_ ();
2324
2325   return;                       /* F90. */
2326
2327 #ifdef FFESTD_F90
2328   fputs (ffelex_token_text (name), dmpout);
2329   if (dims != NULL)
2330     {
2331       fputc ('(', dmpout);
2332       ffestt_dimlist_dump (dims);
2333       fputc (')', dmpout);
2334     }
2335   fputc (',', dmpout);
2336 #endif
2337 }
2338
2339 /* ffestd_R527_finish -- TARGET statement list complete
2340
2341    ffestd_R527_finish();
2342
2343    Just wrap up any local activities.  */
2344
2345 void
2346 ffestd_R527_finish ()
2347 {
2348   ffestd_check_finish_ ();
2349
2350   return;                       /* F90. */
2351
2352 #ifdef FFESTD_F90
2353   fputc ('\n', dmpout);
2354 #endif
2355 }
2356
2357 #endif
2358 /* ffestd_R537_start -- PARAMETER statement list begin
2359
2360    ffestd_R537_start();
2361
2362    Verify that PARAMETER is valid here, and begin accepting items in the list.  */
2363
2364 void
2365 ffestd_R537_start ()
2366 {
2367   ffestd_check_start_ ();
2368
2369 #if FFECOM_targetCURRENT == FFECOM_targetFFE
2370   fputs ("* PARAMETER (", dmpout);
2371 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
2372 #else
2373 #error
2374 #endif
2375 }
2376
2377 /* ffestd_R537_item -- PARAMETER statement assignment
2378
2379    ffestd_R537_item(dest,dest_token,source,source_token);
2380
2381    Make sure the source is a valid source for the destination; make the
2382    assignment.  */
2383
2384 void
2385 ffestd_R537_item (ffebld dest UNUSED, ffebld source UNUSED)
2386 {
2387   ffestd_check_item_ ();
2388
2389 #if FFECOM_targetCURRENT == FFECOM_targetFFE
2390   ffebld_dump (dest);
2391   fputc ('=', dmpout);
2392   ffebld_dump (source);
2393   fputc (',', dmpout);
2394 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
2395 #else
2396 #error
2397 #endif
2398 }
2399
2400 /* ffestd_R537_finish -- PARAMETER statement list complete
2401
2402    ffestd_R537_finish();
2403
2404    Just wrap up any local activities.  */
2405
2406 void
2407 ffestd_R537_finish ()
2408 {
2409   ffestd_check_finish_ ();
2410
2411 #if FFECOM_targetCURRENT == FFECOM_targetFFE
2412   fputs (")\n", dmpout);
2413 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
2414 #else
2415 #error
2416 #endif
2417 }
2418
2419 /* ffestd_R539 -- IMPLICIT NONE statement
2420
2421    ffestd_R539();
2422
2423    Verify that the IMPLICIT NONE statement is ok here and implement.  */
2424
2425 void
2426 ffestd_R539 ()
2427 {
2428   ffestd_check_simple_ ();
2429
2430 #if FFECOM_targetCURRENT == FFECOM_targetFFE
2431   fputs ("* IMPLICIT_NONE\n", dmpout);
2432 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
2433 #else
2434 #error
2435 #endif
2436 }
2437
2438 /* ffestd_R539start -- IMPLICIT statement
2439
2440    ffestd_R539start();
2441
2442    Verify that the IMPLICIT statement is ok here and implement.  */
2443
2444 void
2445 ffestd_R539start ()
2446 {
2447   ffestd_check_start_ ();
2448
2449 #if FFECOM_targetCURRENT == FFECOM_targetFFE
2450   fputs ("* IMPLICIT ", dmpout);
2451 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
2452 #else
2453 #error
2454 #endif
2455 }
2456
2457 /* ffestd_R539item -- IMPLICIT statement specification (R540)
2458
2459    ffestd_R539item(...);
2460
2461    Verify that the type and letter list are all ok and implement.  */
2462
2463 void
2464 ffestd_R539item (ffestpType type UNUSED, ffebld kind UNUSED,
2465                  ffelexToken kindt UNUSED, ffebld len UNUSED,
2466                  ffelexToken lent UNUSED, ffesttImpList letters UNUSED)
2467 {
2468 #if FFECOM_targetCURRENT == FFECOM_targetFFE
2469   char *a;
2470 #endif
2471
2472   ffestd_check_item_ ();
2473
2474 #if FFECOM_targetCURRENT == FFECOM_targetFFE
2475   switch (type)
2476     {
2477     case FFESTP_typeINTEGER:
2478       a = "INTEGER";
2479       break;
2480
2481     case FFESTP_typeBYTE:
2482       a = "BYTE";
2483       break;
2484
2485     case FFESTP_typeWORD:
2486       a = "WORD";
2487       break;
2488
2489     case FFESTP_typeREAL:
2490       a = "REAL";
2491       break;
2492
2493     case FFESTP_typeCOMPLEX:
2494       a = "COMPLEX";
2495       break;
2496
2497     case FFESTP_typeLOGICAL:
2498       a = "LOGICAL";
2499       break;
2500
2501     case FFESTP_typeCHARACTER:
2502       a = "CHARACTER";
2503       break;
2504
2505     case FFESTP_typeDBLPRCSN:
2506       a = "DOUBLE PRECISION";
2507       break;
2508
2509     case FFESTP_typeDBLCMPLX:
2510       a = "DOUBLE COMPLEX";
2511       break;
2512
2513 #if FFESTR_F90
2514     case FFESTP_typeTYPE:
2515       a = "TYPE";
2516       break;
2517 #endif
2518
2519     default:
2520       assert (FALSE);
2521       a = "?";
2522       break;
2523     }
2524   fprintf (dmpout, "%s(", a);
2525   if (kindt != NULL)
2526     {
2527       fputs ("kind=", dmpout);
2528       if (kind == NULL)
2529         fputs (ffelex_token_text (kindt), dmpout);
2530       else
2531         ffebld_dump (kind);
2532       if (lent != NULL)
2533         fputc (',', dmpout);
2534     }
2535   if (lent != NULL)
2536     {
2537       fputs ("len=", dmpout);
2538       if (len == NULL)
2539         fputs (ffelex_token_text (lent), dmpout);
2540       else
2541         ffebld_dump (len);
2542     }
2543   fputs (")(", dmpout);
2544   ffestt_implist_dump (letters);
2545   fputs ("),", dmpout);
2546 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
2547 #else
2548 #error
2549 #endif
2550 }
2551
2552 /* ffestd_R539finish -- IMPLICIT statement
2553
2554    ffestd_R539finish();
2555
2556    Finish up any local activities.  */
2557
2558 void
2559 ffestd_R539finish ()
2560 {
2561   ffestd_check_finish_ ();
2562
2563 #if FFECOM_targetCURRENT == FFECOM_targetFFE
2564   fputc ('\n', dmpout);
2565 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
2566 #else
2567 #error
2568 #endif
2569 }
2570
2571 /* ffestd_R542_start -- NAMELIST statement list begin
2572
2573    ffestd_R542_start();
2574
2575    Verify that NAMELIST is valid here, and begin accepting items in the list.  */
2576
2577 void
2578 ffestd_R542_start ()
2579 {
2580   ffestd_check_start_ ();
2581
2582 #if FFECOM_targetCURRENT == FFECOM_targetFFE
2583   fputs ("* NAMELIST ", dmpout);
2584 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
2585 #else
2586 #error
2587 #endif
2588 }
2589
2590 /* ffestd_R542_item_nlist -- NAMELIST statement for group-name
2591
2592    ffestd_R542_item_nlist(groupname_token);
2593
2594    Make sure name_token identifies a valid object to be NAMELISTd.  */
2595
2596 void
2597 ffestd_R542_item_nlist (ffelexToken name UNUSED)
2598 {
2599   ffestd_check_item_ ();
2600
2601 #if FFECOM_targetCURRENT == FFECOM_targetFFE
2602   fprintf (dmpout, "/%s/", ffelex_token_text (name));
2603 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
2604 #else
2605 #error
2606 #endif
2607 }
2608
2609 /* ffestd_R542_item_nitem -- NAMELIST statement for variable-name
2610
2611    ffestd_R542_item_nitem(name_token);
2612
2613    Make sure name_token identifies a valid object to be NAMELISTd.  */
2614
2615 void
2616 ffestd_R542_item_nitem (ffelexToken name UNUSED)
2617 {
2618   ffestd_check_item_ ();
2619
2620 #if FFECOM_targetCURRENT == FFECOM_targetFFE
2621   fprintf (dmpout, "%s,", ffelex_token_text (name));
2622 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
2623 #else
2624 #error
2625 #endif
2626 }
2627
2628 /* ffestd_R542_finish -- NAMELIST statement list complete
2629
2630    ffestd_R542_finish();
2631
2632    Just wrap up any local activities.  */
2633
2634 void
2635 ffestd_R542_finish ()
2636 {
2637   ffestd_check_finish_ ();
2638
2639 #if FFECOM_targetCURRENT == FFECOM_targetFFE
2640   fputc ('\n', dmpout);
2641 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
2642 #else
2643 #error
2644 #endif
2645 }
2646
2647 /* ffestd_R544_start -- EQUIVALENCE statement list begin
2648
2649    ffestd_R544_start();
2650
2651    Verify that EQUIVALENCE is valid here, and begin accepting items in the
2652    list.  */
2653
2654 #if 0
2655 void
2656 ffestd_R544_start ()
2657 {
2658   ffestd_check_start_ ();
2659
2660 #if FFECOM_targetCURRENT == FFECOM_targetFFE
2661   fputs ("* EQUIVALENCE (", dmpout);
2662 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
2663 #else
2664 #error
2665 #endif
2666 }
2667
2668 #endif
2669 /* ffestd_R544_item -- EQUIVALENCE statement assignment
2670
2671    ffestd_R544_item(exprlist);
2672
2673    Make sure the equivalence is valid, then implement it.  */
2674
2675 #if 0
2676 void
2677 ffestd_R544_item (ffesttExprList exprlist)
2678 {
2679   ffestd_check_item_ ();
2680
2681 #if FFECOM_targetCURRENT == FFECOM_targetFFE
2682   ffestt_exprlist_dump (exprlist);
2683   fputs ("),", dmpout);
2684 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
2685 #else
2686 #error
2687 #endif
2688 }
2689
2690 #endif
2691 /* ffestd_R544_finish -- EQUIVALENCE statement list complete
2692
2693    ffestd_R544_finish();
2694
2695    Just wrap up any local activities.  */
2696
2697 #if 0
2698 void
2699 ffestd_R544_finish ()
2700 {
2701   ffestd_check_finish_ ();
2702
2703 #if FFECOM_targetCURRENT == FFECOM_targetFFE
2704   fputs (")\n", dmpout);
2705 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
2706 #else
2707 #error
2708 #endif
2709 }
2710
2711 #endif
2712 /* ffestd_R547_start -- COMMON statement list begin
2713
2714    ffestd_R547_start();
2715
2716    Verify that COMMON is valid here, and begin accepting items in the list.  */
2717
2718 void
2719 ffestd_R547_start ()
2720 {
2721   ffestd_check_start_ ();
2722
2723 #if FFECOM_targetCURRENT == FFECOM_targetFFE
2724   fputs ("* COMMON ", dmpout);
2725 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
2726 #else
2727 #error
2728 #endif
2729 }
2730
2731 /* ffestd_R547_item_object -- COMMON statement for object-name
2732
2733    ffestd_R547_item_object(name_token,dim_list);
2734
2735    Make sure name_token identifies a valid object to be COMMONd.  */
2736
2737 void
2738 ffestd_R547_item_object (ffelexToken name UNUSED,
2739                          ffesttDimList dims UNUSED)
2740 {
2741   ffestd_check_item_ ();
2742
2743 #if FFECOM_targetCURRENT == FFECOM_targetFFE
2744   fputs (ffelex_token_text (name), dmpout);
2745   if (dims != NULL)
2746     {
2747       fputc ('(', dmpout);
2748       ffestt_dimlist_dump (dims);
2749       fputc (')', dmpout);
2750     }
2751   fputc (',', dmpout);
2752 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
2753 #else
2754 #error
2755 #endif
2756 }
2757
2758 /* ffestd_R547_item_cblock -- COMMON statement for common-block-name
2759
2760    ffestd_R547_item_cblock(name_token);
2761
2762    Make sure name_token identifies a valid common block to be COMMONd.  */
2763
2764 void
2765 ffestd_R547_item_cblock (ffelexToken name UNUSED)
2766 {
2767   ffestd_check_item_ ();
2768
2769 #if FFECOM_targetCURRENT == FFECOM_targetFFE
2770   if (name == NULL)
2771     fputs ("//,", dmpout);
2772   else
2773     fprintf (dmpout, "/%s/,", ffelex_token_text (name));
2774 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
2775 #else
2776 #error
2777 #endif
2778 }
2779
2780 /* ffestd_R547_finish -- COMMON statement list complete
2781
2782    ffestd_R547_finish();
2783
2784    Just wrap up any local activities.  */
2785
2786 void
2787 ffestd_R547_finish ()
2788 {
2789   ffestd_check_finish_ ();
2790
2791 #if FFECOM_targetCURRENT == FFECOM_targetFFE
2792   fputc ('\n', dmpout);
2793 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
2794 #else
2795 #error
2796 #endif
2797 }
2798
2799 /* ffestd_R620 -- ALLOCATE statement
2800
2801    ffestd_R620(exprlist,stat,stat_token);
2802
2803    Make sure the expression list is valid, then implement it.  */
2804
2805 #if FFESTR_F90
2806 void
2807 ffestd_R620 (ffesttExprList exprlist, ffebld stat)
2808 {
2809   ffestd_check_simple_ ();
2810
2811   ffestd_subr_f90_ ();
2812   return;
2813
2814 #ifdef FFESTD_F90
2815   fputs ("+ ALLOCATE (", dmpout);
2816   ffestt_exprlist_dump (exprlist);
2817   if (stat != NULL)
2818     {
2819       fputs (",stat=", dmpout);
2820       ffebld_dump (stat);
2821     }
2822   fputs (")\n", dmpout);
2823 #endif
2824 }
2825
2826 /* ffestd_R624 -- NULLIFY statement
2827
2828    ffestd_R624(pointer_name_list);
2829
2830    Make sure pointer_name_list identifies valid pointers for a NULLIFY.  */
2831
2832 void
2833 ffestd_R624 (ffesttExprList pointers)
2834 {
2835   ffestd_check_simple_ ();
2836
2837   ffestd_subr_f90_ ();
2838   return;
2839
2840 #ifdef FFESTD_F90
2841   fputs ("+ NULLIFY (", dmpout);
2842   assert (pointers != NULL);
2843   ffestt_exprlist_dump (pointers);
2844   fputs (")\n", dmpout);
2845 #endif
2846 }
2847
2848 /* ffestd_R625 -- DEALLOCATE statement
2849
2850    ffestd_R625(exprlist,stat,stat_token);
2851
2852    Make sure the equivalence is valid, then implement it.  */
2853
2854 void
2855 ffestd_R625 (ffesttExprList exprlist, ffebld stat)
2856 {
2857   ffestd_check_simple_ ();
2858
2859   ffestd_subr_f90_ ();
2860   return;
2861
2862 #ifdef FFESTD_F90
2863   fputs ("+ DEALLOCATE (", dmpout);
2864   ffestt_exprlist_dump (exprlist);
2865   if (stat != NULL)
2866     {
2867       fputs (",stat=", dmpout);
2868       ffebld_dump (stat);
2869     }
2870   fputs (")\n", dmpout);
2871 #endif
2872 }
2873
2874 #endif
2875 /* ffestd_R737A -- Assignment statement outside of WHERE
2876
2877    ffestd_R737A(dest_expr,source_expr);  */
2878
2879 void
2880 ffestd_R737A (ffebld dest, ffebld source)
2881 {
2882   ffestd_check_simple_ ();
2883
2884 #if FFECOM_ONEPASS
2885   ffestd_subr_line_now_ ();
2886   ffeste_R737A (dest, source);
2887 #else
2888   {
2889     ffestdStmt_ stmt;
2890
2891     stmt = ffestd_stmt_new_ (FFESTD_stmtidR737A_);
2892     ffestd_stmt_append_ (stmt);
2893     ffestd_subr_line_save_ (stmt);
2894     stmt->u.R737A.pool = ffesta_output_pool;
2895     stmt->u.R737A.dest = dest;
2896     stmt->u.R737A.source = source;
2897     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
2898   }
2899 #endif
2900 }
2901
2902 /* ffestd_R737B -- Assignment statement inside of WHERE
2903
2904    ffestd_R737B(dest_expr,source_expr);  */
2905
2906 #if FFESTR_F90
2907 void
2908 ffestd_R737B (ffebld dest, ffebld source)
2909 {
2910   ffestd_check_simple_ ();
2911
2912   return;                       /* F90. */
2913
2914 #ifdef FFESTD_F90
2915   fputs ("+ let_inside_where ", dmpout);
2916   ffebld_dump (dest);
2917   fputs ("=", dmpout);
2918   ffebld_dump (source);
2919   fputc ('\n', dmpout);
2920 #endif
2921 }
2922
2923 /* ffestd_R738 -- Pointer assignment statement
2924
2925    ffestd_R738(dest_expr,source_expr,source_token);
2926
2927    Make sure the assignment is valid.  */
2928
2929 void
2930 ffestd_R738 (ffebld dest, ffebld source)
2931 {
2932   ffestd_check_simple_ ();
2933
2934   ffestd_subr_f90_ ();
2935   return;
2936
2937 #ifdef FFESTD_F90
2938   fputs ("+ let_pointer ", dmpout);
2939   ffebld_dump (dest);
2940   fputs ("=>", dmpout);
2941   ffebld_dump (source);
2942   fputc ('\n', dmpout);
2943 #endif
2944 }
2945
2946 /* ffestd_R740 -- WHERE statement
2947
2948    ffestd_R740(expr,expr_token);
2949
2950    Make sure statement is valid here; implement.  */
2951
2952 void
2953 ffestd_R740 (ffebld expr)
2954 {
2955   ffestd_check_simple_ ();
2956
2957   ffestd_subr_f90_ ();
2958   return;
2959
2960 #ifdef FFESTD_F90
2961   fputs ("+ WHERE (", dmpout);
2962   ffebld_dump (expr);
2963   fputs (")\n", dmpout);
2964
2965   ++ffestd_block_level_;
2966   assert (ffestd_block_level_ > 0);
2967 #endif
2968 }
2969
2970 /* ffestd_R742 -- WHERE-construct statement
2971
2972    ffestd_R742(expr,expr_token);
2973
2974    Make sure statement is valid here; implement.  */
2975
2976 void
2977 ffestd_R742 (ffebld expr)
2978 {
2979   ffestd_check_simple_ ();
2980
2981   ffestd_subr_f90_ ();
2982   return;
2983
2984 #ifdef FFESTD_F90
2985   fputs ("+ WHERE_construct (", dmpout);
2986   ffebld_dump (expr);
2987   fputs (")\n", dmpout);
2988
2989   ++ffestd_block_level_;
2990   assert (ffestd_block_level_ > 0);
2991 #endif
2992 }
2993
2994 /* ffestd_R744 -- ELSE WHERE statement
2995
2996    ffestd_R744();
2997
2998    Make sure ffestd_kind_ identifies a WHERE block.
2999    Implement the ELSE of the current WHERE block.  */
3000
3001 void
3002 ffestd_R744 ()
3003 {
3004   ffestd_check_simple_ ();
3005
3006   return;                       /* F90. */
3007
3008 #ifdef FFESTD_F90
3009   fputs ("+ ELSE_WHERE\n", dmpout);
3010 #endif
3011 }
3012
3013 /* ffestd_R745 -- Implicit END WHERE statement.  */
3014
3015 void
3016 ffestd_R745 (bool ok)
3017 {
3018   return;                       /* F90. */
3019
3020 #ifdef FFESTD_F90
3021   fputs ("+ END_WHERE\n", dmpout);      /* Also see ffestd_R745. */
3022
3023   --ffestd_block_level_;
3024   assert (ffestd_block_level_ >= 0);
3025 #endif
3026 }
3027
3028 #endif
3029
3030 /* Block IF (IF-THEN) statement.  */
3031
3032 void
3033 ffestd_R803 (ffelexToken construct_name UNUSED, ffebld expr)
3034 {
3035   ffestd_check_simple_ ();
3036
3037 #if FFECOM_ONEPASS
3038   ffestd_subr_line_now_ ();
3039   ffeste_R803 (expr);           /* Don't bother with name. */
3040 #else
3041   {
3042     ffestdStmt_ stmt;
3043
3044     stmt = ffestd_stmt_new_ (FFESTD_stmtidR803_);
3045     ffestd_stmt_append_ (stmt);
3046     ffestd_subr_line_save_ (stmt);
3047     stmt->u.R803.pool = ffesta_output_pool;
3048     stmt->u.R803.block = ffestw_use (ffestw_stack_top ());
3049     stmt->u.R803.expr = expr;
3050     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3051   }
3052 #endif
3053
3054   ++ffestd_block_level_;
3055   assert (ffestd_block_level_ > 0);
3056 }
3057
3058 /* ELSE IF statement.  */
3059
3060 void
3061 ffestd_R804 (ffebld expr, ffelexToken name UNUSED)
3062 {
3063   ffestd_check_simple_ ();
3064
3065 #if FFECOM_ONEPASS
3066   ffestd_subr_line_now_ ();
3067   ffeste_R804 (expr);           /* Don't bother with name. */
3068 #else
3069   {
3070     ffestdStmt_ stmt;
3071
3072     stmt = ffestd_stmt_new_ (FFESTD_stmtidR804_);
3073     ffestd_stmt_append_ (stmt);
3074     ffestd_subr_line_save_ (stmt);
3075     stmt->u.R804.pool = ffesta_output_pool;
3076     stmt->u.R804.block = ffestw_use (ffestw_stack_top ());
3077     stmt->u.R804.expr = expr;
3078     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3079   }
3080 #endif
3081 }
3082
3083 /* ELSE statement.  */
3084
3085 void
3086 ffestd_R805 (ffelexToken name UNUSED)
3087 {
3088   ffestd_check_simple_ ();
3089
3090 #if FFECOM_ONEPASS
3091   ffestd_subr_line_now_ ();
3092   ffeste_R805 ();               /* Don't bother with name. */
3093 #else
3094   {
3095     ffestdStmt_ stmt;
3096
3097     stmt = ffestd_stmt_new_ (FFESTD_stmtidR805_);
3098     ffestd_stmt_append_ (stmt);
3099     ffestd_subr_line_save_ (stmt);
3100     stmt->u.R805.block = ffestw_use (ffestw_stack_top ());
3101   }
3102 #endif
3103 }
3104
3105 /* END IF statement.  */
3106
3107 void
3108 ffestd_R806 (bool ok UNUSED)
3109 {
3110 #if FFECOM_ONEPASS
3111   ffestd_subr_line_now_ ();
3112   ffeste_R806 ();
3113 #else
3114   {
3115     ffestdStmt_ stmt;
3116
3117     stmt = ffestd_stmt_new_ (FFESTD_stmtidR806_);
3118     ffestd_stmt_append_ (stmt);
3119     ffestd_subr_line_save_ (stmt);
3120     stmt->u.R806.block = ffestw_use (ffestw_stack_top ());
3121   }
3122 #endif
3123
3124   --ffestd_block_level_;
3125   assert (ffestd_block_level_ >= 0);
3126 }
3127
3128 /* ffestd_R807 -- Logical IF statement
3129
3130    ffestd_R807(expr,expr_token);
3131
3132    Make sure statement is valid here; implement.  */
3133
3134 void
3135 ffestd_R807 (ffebld expr)
3136 {
3137   ffestd_check_simple_ ();
3138
3139 #if FFECOM_ONEPASS
3140   ffestd_subr_line_now_ ();
3141   ffeste_R807 (expr);
3142 #else
3143   {
3144     ffestdStmt_ stmt;
3145
3146     stmt = ffestd_stmt_new_ (FFESTD_stmtidR807_);
3147     ffestd_stmt_append_ (stmt);
3148     ffestd_subr_line_save_ (stmt);
3149     stmt->u.R807.pool = ffesta_output_pool;
3150     stmt->u.R807.expr = expr;
3151     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3152   }
3153 #endif
3154
3155   ++ffestd_block_level_;
3156   assert (ffestd_block_level_ > 0);
3157 }
3158
3159 /* ffestd_R809 -- SELECT CASE statement
3160
3161    ffestd_R809(construct_name,expr,expr_token);
3162
3163    Make sure statement is valid here; implement.  */
3164
3165 void
3166 ffestd_R809 (ffelexToken construct_name UNUSED, ffebld expr)
3167 {
3168   ffestd_check_simple_ ();
3169
3170 #if FFECOM_ONEPASS
3171   ffestd_subr_line_now_ ();
3172   ffeste_R809 (ffestw_stack_top (), expr);
3173 #else
3174   {
3175     ffestdStmt_ stmt;
3176
3177     stmt = ffestd_stmt_new_ (FFESTD_stmtidR809_);
3178     ffestd_stmt_append_ (stmt);
3179     ffestd_subr_line_save_ (stmt);
3180     stmt->u.R809.pool = ffesta_output_pool;
3181     stmt->u.R809.block = ffestw_use (ffestw_stack_top ());
3182     stmt->u.R809.expr = expr;
3183     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3184     malloc_pool_use (ffestw_select (ffestw_stack_top ())->pool);
3185   }
3186 #endif
3187
3188   ++ffestd_block_level_;
3189   assert (ffestd_block_level_ > 0);
3190 }
3191
3192 /* ffestd_R810 -- CASE statement
3193
3194    ffestd_R810(case_value_range_list,name);
3195
3196    If casenum is 0, it's CASE DEFAULT.  Else it's the case ranges at
3197    the start of the first_stmt list in the select object at the top of
3198    the stack that match casenum.  */
3199
3200 void
3201 ffestd_R810 (unsigned long casenum)
3202 {
3203   ffestd_check_simple_ ();
3204
3205 #if FFECOM_ONEPASS
3206   ffestd_subr_line_now_ ();
3207   ffeste_R810 (ffestw_stack_top (), casenum);
3208 #else
3209   {
3210     ffestdStmt_ stmt;
3211
3212     stmt = ffestd_stmt_new_ (FFESTD_stmtidR810_);
3213     ffestd_stmt_append_ (stmt);
3214     ffestd_subr_line_save_ (stmt);
3215     stmt->u.R810.pool = ffesta_output_pool;
3216     stmt->u.R810.block = ffestw_stack_top ();
3217     stmt->u.R810.casenum = casenum;
3218     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3219   }
3220 #endif
3221 }
3222
3223 /* ffestd_R811 -- End a SELECT
3224
3225    ffestd_R811(TRUE);  */
3226
3227 void
3228 ffestd_R811 (bool ok UNUSED)
3229 {
3230 #if FFECOM_ONEPASS
3231   ffestd_subr_line_now_ ();
3232   ffeste_R811 (ffestw_stack_top ());
3233 #else
3234   {
3235     ffestdStmt_ stmt;
3236
3237     stmt = ffestd_stmt_new_ (FFESTD_stmtidR811_);
3238     ffestd_stmt_append_ (stmt);
3239     ffestd_subr_line_save_ (stmt);
3240     stmt->u.R811.block = ffestw_stack_top ();
3241   }
3242 #endif
3243
3244   --ffestd_block_level_;
3245   assert (ffestd_block_level_ >= 0);
3246 }
3247
3248 /* ffestd_R819A -- Iterative DO statement
3249
3250    ffestd_R819A(construct_name,label_token,expr,expr_token);
3251
3252    Make sure statement is valid here; implement.  */
3253
3254 void
3255 ffestd_R819A (ffelexToken construct_name UNUSED, ffelab label,
3256               ffebld var, ffebld start, ffelexToken start_token,
3257               ffebld end, ffelexToken end_token,
3258               ffebld incr, ffelexToken incr_token)
3259 {
3260   ffestd_check_simple_ ();
3261
3262 #if FFECOM_ONEPASS
3263   ffestd_subr_line_now_ ();
3264   ffeste_R819A (ffestw_stack_top (), label, var, start, end, incr,
3265                 incr_token);
3266 #else
3267   {
3268     ffestdStmt_ stmt;
3269
3270     stmt = ffestd_stmt_new_ (FFESTD_stmtidR819A_);
3271     ffestd_stmt_append_ (stmt);
3272     ffestd_subr_line_save_ (stmt);
3273     stmt->u.R819A.pool = ffesta_output_pool;
3274     stmt->u.R819A.block = ffestw_use (ffestw_stack_top ());
3275     stmt->u.R819A.label = label;
3276     stmt->u.R819A.var = var;
3277     stmt->u.R819A.start = start;
3278     stmt->u.R819A.start_token = ffelex_token_use (start_token);
3279     stmt->u.R819A.end = end;
3280     stmt->u.R819A.end_token = ffelex_token_use (end_token);
3281     stmt->u.R819A.incr = incr;
3282     stmt->u.R819A.incr_token = (incr_token == NULL) ? NULL
3283       : ffelex_token_use (incr_token);
3284     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3285   }
3286 #endif
3287
3288   ++ffestd_block_level_;
3289   assert (ffestd_block_level_ > 0);
3290 }
3291
3292 /* ffestd_R819B -- DO WHILE statement
3293
3294    ffestd_R819B(construct_name,label_token,expr,expr_token);
3295
3296    Make sure statement is valid here; implement.  */
3297
3298 void
3299 ffestd_R819B (ffelexToken construct_name UNUSED, ffelab label,
3300               ffebld expr)
3301 {
3302   ffestd_check_simple_ ();
3303
3304 #if FFECOM_ONEPASS
3305   ffestd_subr_line_now_ ();
3306   ffeste_R819B (ffestw_stack_top (), label, expr);
3307 #else
3308   {
3309     ffestdStmt_ stmt;
3310
3311     stmt = ffestd_stmt_new_ (FFESTD_stmtidR819B_);
3312     ffestd_stmt_append_ (stmt);
3313     ffestd_subr_line_save_ (stmt);
3314     stmt->u.R819B.pool = ffesta_output_pool;
3315     stmt->u.R819B.block = ffestw_use (ffestw_stack_top ());
3316     stmt->u.R819B.label = label;
3317     stmt->u.R819B.expr = expr;
3318     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3319   }
3320 #endif
3321
3322   ++ffestd_block_level_;
3323   assert (ffestd_block_level_ > 0);
3324 }
3325
3326 /* ffestd_R825 -- END DO statement
3327
3328    ffestd_R825(name_token);
3329
3330    Make sure ffestd_kind_ identifies a DO block.  If not
3331    NULL, make sure name_token gives the correct name.  Do whatever
3332    is specific to seeing END DO with a DO-target label definition on it,
3333    where the END DO is really treated as a CONTINUE (i.e. generate th
3334    same code you would for CONTINUE).  ffestd_do handles the actual
3335    generation of end-loop code.  */
3336
3337 void
3338 ffestd_R825 (ffelexToken name UNUSED)
3339 {
3340   ffestd_check_simple_ ();
3341
3342 #if FFECOM_ONEPASS
3343   ffestd_subr_line_now_ ();
3344   ffeste_R825 ();
3345 #else
3346   {
3347     ffestdStmt_ stmt;
3348
3349     stmt = ffestd_stmt_new_ (FFESTD_stmtidR825_);
3350     ffestd_stmt_append_ (stmt);
3351     ffestd_subr_line_save_ (stmt);
3352   }
3353 #endif
3354 }
3355
3356 /* ffestd_R834 -- CYCLE statement
3357
3358    ffestd_R834(name_token);
3359
3360    Handle a CYCLE within a loop.  */
3361
3362 void
3363 ffestd_R834 (ffestw block)
3364 {
3365   ffestd_check_simple_ ();
3366
3367 #if FFECOM_ONEPASS
3368   ffestd_subr_line_now_ ();
3369   ffeste_R834 (block);
3370 #else
3371   {
3372     ffestdStmt_ stmt;
3373
3374     stmt = ffestd_stmt_new_ (FFESTD_stmtidR834_);
3375     ffestd_stmt_append_ (stmt);
3376     ffestd_subr_line_save_ (stmt);
3377     stmt->u.R834.block = block;
3378   }
3379 #endif
3380 }
3381
3382 /* ffestd_R835 -- EXIT statement
3383
3384    ffestd_R835(name_token);
3385
3386    Handle a EXIT within a loop.  */
3387
3388 void
3389 ffestd_R835 (ffestw block)
3390 {
3391   ffestd_check_simple_ ();
3392
3393 #if FFECOM_ONEPASS
3394   ffestd_subr_line_now_ ();
3395   ffeste_R835 (block);
3396 #else
3397   {
3398     ffestdStmt_ stmt;
3399
3400     stmt = ffestd_stmt_new_ (FFESTD_stmtidR835_);
3401     ffestd_stmt_append_ (stmt);
3402     ffestd_subr_line_save_ (stmt);
3403     stmt->u.R835.block = block;
3404   }
3405 #endif
3406 }
3407
3408 /* ffestd_R836 -- GOTO statement
3409
3410    ffestd_R836(label);
3411
3412    Make sure label_token identifies a valid label for a GOTO.  Update
3413    that label's info to indicate it is the target of a GOTO.  */
3414
3415 void
3416 ffestd_R836 (ffelab label)
3417 {
3418   ffestd_check_simple_ ();
3419
3420 #if FFECOM_ONEPASS
3421   ffestd_subr_line_now_ ();
3422   ffeste_R836 (label);
3423 #else
3424   {
3425     ffestdStmt_ stmt;
3426
3427     stmt = ffestd_stmt_new_ (FFESTD_stmtidR836_);
3428     ffestd_stmt_append_ (stmt);
3429     ffestd_subr_line_save_ (stmt);
3430     stmt->u.R836.label = label;
3431   }
3432 #endif
3433
3434   if (ffestd_block_level_ == 0)
3435     ffestd_is_reachable_ = FALSE;
3436 }
3437
3438 /* ffestd_R837 -- Computed GOTO statement
3439
3440    ffestd_R837(labels,expr);
3441
3442    Make sure label_list identifies valid labels for a GOTO.  Update
3443    each label's info to indicate it is the target of a GOTO.  */
3444
3445 void
3446 ffestd_R837 (ffelab *labels, int count, ffebld expr)
3447 {
3448   ffestd_check_simple_ ();
3449
3450 #if FFECOM_ONEPASS
3451   ffestd_subr_line_now_ ();
3452   ffeste_R837 (labels, count, expr);
3453 #else
3454   {
3455     ffestdStmt_ stmt;
3456
3457     stmt = ffestd_stmt_new_ (FFESTD_stmtidR837_);
3458     ffestd_stmt_append_ (stmt);
3459     ffestd_subr_line_save_ (stmt);
3460     stmt->u.R837.pool = ffesta_output_pool;
3461     stmt->u.R837.labels = labels;
3462     stmt->u.R837.count = count;
3463     stmt->u.R837.expr = expr;
3464     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3465   }
3466 #endif
3467 }
3468
3469 /* ffestd_R838 -- ASSIGN statement
3470
3471    ffestd_R838(label_token,target_variable,target_token);
3472
3473    Make sure label_token identifies a valid label for an assignment.  Update
3474    that label's info to indicate it is the source of an assignment.  Update
3475    target_variable's info to indicate it is the target the assignment of that
3476    label.  */
3477
3478 void
3479 ffestd_R838 (ffelab label, ffebld target)
3480 {
3481   ffestd_check_simple_ ();
3482
3483 #if FFECOM_ONEPASS
3484   ffestd_subr_line_now_ ();
3485   ffeste_R838 (label, target);
3486 #else
3487   {
3488     ffestdStmt_ stmt;
3489
3490     stmt = ffestd_stmt_new_ (FFESTD_stmtidR838_);
3491     ffestd_stmt_append_ (stmt);
3492     ffestd_subr_line_save_ (stmt);
3493     stmt->u.R838.pool = ffesta_output_pool;
3494     stmt->u.R838.label = label;
3495     stmt->u.R838.target = target;
3496     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3497   }
3498 #endif
3499 }
3500
3501 /* ffestd_R839 -- Assigned GOTO statement
3502
3503    ffestd_R839(target,labels);
3504
3505    Make sure label_list identifies valid labels for a GOTO.  Update
3506    each label's info to indicate it is the target of a GOTO.  */
3507
3508 void
3509 ffestd_R839 (ffebld target, ffelab *labels UNUSED, int count UNUSED)
3510 {
3511   ffestd_check_simple_ ();
3512
3513 #if FFECOM_ONEPASS
3514   ffestd_subr_line_now_ ();
3515   ffeste_R839 (target);
3516 #else
3517   {
3518     ffestdStmt_ stmt;
3519
3520     stmt = ffestd_stmt_new_ (FFESTD_stmtidR839_);
3521     ffestd_stmt_append_ (stmt);
3522     ffestd_subr_line_save_ (stmt);
3523     stmt->u.R839.pool = ffesta_output_pool;
3524     stmt->u.R839.target = target;
3525     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3526   }
3527 #endif
3528
3529   if (ffestd_block_level_ == 0)
3530     ffestd_is_reachable_ = FALSE;
3531 }
3532
3533 /* ffestd_R840 -- Arithmetic IF statement
3534
3535    ffestd_R840(expr,expr_token,neg,zero,pos);
3536
3537    Make sure the labels are valid; implement.  */
3538
3539 void
3540 ffestd_R840 (ffebld expr, ffelab neg, ffelab zero, ffelab pos)
3541 {
3542   ffestd_check_simple_ ();
3543
3544 #if FFECOM_ONEPASS
3545   ffestd_subr_line_now_ ();
3546   ffeste_R840 (expr, neg, zero, pos);
3547 #else
3548   {
3549     ffestdStmt_ stmt;
3550
3551     stmt = ffestd_stmt_new_ (FFESTD_stmtidR840_);
3552     ffestd_stmt_append_ (stmt);
3553     ffestd_subr_line_save_ (stmt);
3554     stmt->u.R840.pool = ffesta_output_pool;
3555     stmt->u.R840.expr = expr;
3556     stmt->u.R840.neg = neg;
3557     stmt->u.R840.zero = zero;
3558     stmt->u.R840.pos = pos;
3559     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3560   }
3561 #endif
3562
3563   if (ffestd_block_level_ == 0)
3564     ffestd_is_reachable_ = FALSE;
3565 }
3566
3567 /* ffestd_R841 -- CONTINUE statement
3568
3569    ffestd_R841();  */
3570
3571 void
3572 ffestd_R841 (bool in_where UNUSED)
3573 {
3574   ffestd_check_simple_ ();
3575
3576 #if FFECOM_ONEPASS
3577   ffestd_subr_line_now_ ();
3578   ffeste_R841 ();
3579 #else
3580   {
3581     ffestdStmt_ stmt;
3582
3583     stmt = ffestd_stmt_new_ (FFESTD_stmtidR841_);
3584     ffestd_stmt_append_ (stmt);
3585     ffestd_subr_line_save_ (stmt);
3586   }
3587 #endif
3588 }
3589
3590 /* ffestd_R842 -- STOP statement
3591
3592    ffestd_R842(expr);  */
3593
3594 void
3595 ffestd_R842 (ffebld expr)
3596 {
3597   ffestd_check_simple_ ();
3598
3599 #if FFECOM_ONEPASS
3600   ffestd_subr_line_now_ ();
3601   ffeste_R842 (expr);
3602 #else
3603   {
3604     ffestdStmt_ stmt;
3605
3606     stmt = ffestd_stmt_new_ (FFESTD_stmtidR842_);
3607     ffestd_stmt_append_ (stmt);
3608     ffestd_subr_line_save_ (stmt);
3609     if (ffesta_outpooldisp () == FFESTA_pooldispPRESERVE)
3610       {
3611         /* This is a "spurious" (automatically-generated) STOP
3612            that follows a previous STOP or other statement.
3613            Make sure we don't have an expression in the pool,
3614            and then mark that the pool has already been killed.  */
3615         assert (expr == NULL);
3616         stmt->u.R842.pool = NULL;
3617         stmt->u.R842.expr = NULL;
3618       }
3619     else
3620       {
3621         stmt->u.R842.pool = ffesta_output_pool;
3622         stmt->u.R842.expr = expr;
3623         ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3624       }
3625   }
3626 #endif
3627
3628   if (ffestd_block_level_ == 0)
3629     ffestd_is_reachable_ = FALSE;
3630 }
3631
3632 /* ffestd_R843 -- PAUSE statement
3633
3634    ffestd_R843(expr,expr_token);
3635
3636    Make sure statement is valid here; implement.  expr and expr_token are
3637    both NULL if there was no expression.  */
3638
3639 void
3640 ffestd_R843 (ffebld expr)
3641 {
3642   ffestd_check_simple_ ();
3643
3644 #if FFECOM_ONEPASS
3645   ffestd_subr_line_now_ ();
3646   ffeste_R843 (expr);
3647 #else
3648   {
3649     ffestdStmt_ stmt;
3650
3651     stmt = ffestd_stmt_new_ (FFESTD_stmtidR843_);
3652     ffestd_stmt_append_ (stmt);
3653     ffestd_subr_line_save_ (stmt);
3654     stmt->u.R843.pool = ffesta_output_pool;
3655     stmt->u.R843.expr = expr;
3656     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3657   }
3658 #endif
3659 }
3660
3661 /* ffestd_R904 -- OPEN statement
3662
3663    ffestd_R904();
3664
3665    Make sure an OPEN is valid in the current context, and implement it.  */
3666
3667 void
3668 ffestd_R904 ()
3669 {
3670   ffestd_check_simple_ ();
3671
3672 #if FFECOM_targetCURRENT == FFECOM_targetGCC
3673 #define specified(something) \
3674       (ffestp_file.open.open_spec[something].kw_or_val_present)
3675
3676   /* Warn if there are any thing we don't handle via f2c libraries. */
3677
3678   if (specified (FFESTP_openixACTION)
3679       || specified (FFESTP_openixASSOCIATEVARIABLE)
3680       || specified (FFESTP_openixBLOCKSIZE)
3681       || specified (FFESTP_openixBUFFERCOUNT)
3682       || specified (FFESTP_openixCARRIAGECONTROL)
3683       || specified (FFESTP_openixDEFAULTFILE)
3684       || specified (FFESTP_openixDELIM)
3685       || specified (FFESTP_openixDISPOSE)
3686       || specified (FFESTP_openixEXTENDSIZE)
3687       || specified (FFESTP_openixINITIALSIZE)
3688       || specified (FFESTP_openixKEY)
3689       || specified (FFESTP_openixMAXREC)
3690       || specified (FFESTP_openixNOSPANBLOCKS)
3691       || specified (FFESTP_openixORGANIZATION)
3692       || specified (FFESTP_openixPAD)
3693       || specified (FFESTP_openixPOSITION)
3694       || specified (FFESTP_openixREADONLY)
3695       || specified (FFESTP_openixRECORDTYPE)
3696       || specified (FFESTP_openixSHARED)
3697       || specified (FFESTP_openixUSEROPEN))
3698     {
3699       ffebad_start (FFEBAD_OPEN_UNSUPPORTED);
3700       ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
3701                    ffelex_token_where_column (ffesta_tokens[0]));
3702       ffebad_finish ();
3703     }
3704
3705 #undef specified
3706 #endif
3707
3708 #if FFECOM_ONEPASS
3709   ffestd_subr_line_now_ ();
3710   ffeste_R904 (&ffestp_file.open);
3711 #else
3712   {
3713     ffestdStmt_ stmt;
3714
3715     stmt = ffestd_stmt_new_ (FFESTD_stmtidR904_);
3716     ffestd_stmt_append_ (stmt);
3717     ffestd_subr_line_save_ (stmt);
3718     stmt->u.R904.pool = ffesta_output_pool;
3719     stmt->u.R904.params = ffestd_subr_copy_open_ ();
3720     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3721   }
3722 #endif
3723 }
3724
3725 /* ffestd_R907 -- CLOSE statement
3726
3727    ffestd_R907();
3728
3729    Make sure a CLOSE is valid in the current context, and implement it.  */
3730
3731 void
3732 ffestd_R907 ()
3733 {
3734   ffestd_check_simple_ ();
3735
3736 #if FFECOM_ONEPASS
3737   ffestd_subr_line_now_ ();
3738   ffeste_R907 (&ffestp_file.close);
3739 #else
3740   {
3741     ffestdStmt_ stmt;
3742
3743     stmt = ffestd_stmt_new_ (FFESTD_stmtidR907_);
3744     ffestd_stmt_append_ (stmt);
3745     ffestd_subr_line_save_ (stmt);
3746     stmt->u.R907.pool = ffesta_output_pool;
3747     stmt->u.R907.params = ffestd_subr_copy_close_ ();
3748     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3749   }
3750 #endif
3751 }
3752
3753 /* ffestd_R909_start -- READ(...) statement list begin
3754
3755    ffestd_R909_start(FALSE);
3756
3757    Verify that READ is valid here, and begin accepting items in the
3758    list.  */
3759
3760 void
3761 ffestd_R909_start (bool only_format, ffestvUnit unit,
3762                    ffestvFormat format, bool rec, bool key)
3763 {
3764   ffestd_check_start_ ();
3765
3766 #if FFECOM_targetCURRENT == FFECOM_targetGCC
3767 #define specified(something) \
3768       (ffestp_file.read.read_spec[something].kw_or_val_present)
3769
3770   /* Warn if there are any thing we don't handle via f2c libraries. */
3771   if (specified (FFESTP_readixADVANCE)
3772       || specified (FFESTP_readixEOR)
3773       || specified (FFESTP_readixKEYEQ)
3774       || specified (FFESTP_readixKEYGE)
3775       || specified (FFESTP_readixKEYGT)
3776       || specified (FFESTP_readixKEYID)
3777       || specified (FFESTP_readixNULLS)
3778       || specified (FFESTP_readixSIZE))
3779     {
3780       ffebad_start (FFEBAD_READ_UNSUPPORTED);
3781       ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
3782                    ffelex_token_where_column (ffesta_tokens[0]));
3783       ffebad_finish ();
3784     }
3785
3786 #undef specified
3787 #endif
3788
3789 #if FFECOM_ONEPASS
3790   ffestd_subr_line_now_ ();
3791   ffeste_R909_start (&ffestp_file.read, only_format, unit, format, rec, key);
3792 #else
3793   {
3794     ffestdStmt_ stmt;
3795
3796     stmt = ffestd_stmt_new_ (FFESTD_stmtidR909_);
3797     ffestd_stmt_append_ (stmt);
3798     ffestd_subr_line_save_ (stmt);
3799     stmt->u.R909.pool = ffesta_output_pool;
3800     stmt->u.R909.params = ffestd_subr_copy_read_ ();
3801     stmt->u.R909.only_format = only_format;
3802     stmt->u.R909.unit = unit;
3803     stmt->u.R909.format = format;
3804     stmt->u.R909.rec = rec;
3805     stmt->u.R909.key = key;
3806     stmt->u.R909.list = NULL;
3807     ffestd_expr_list_ = &stmt->u.R909.list;
3808     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3809   }
3810 #endif
3811 }
3812
3813 /* ffestd_R909_item -- READ statement i/o item
3814
3815    ffestd_R909_item(expr,expr_token);
3816
3817    Implement output-list expression.  */
3818
3819 void
3820 ffestd_R909_item (ffebld expr, ffelexToken expr_token)
3821 {
3822   ffestd_check_item_ ();
3823
3824 #if FFECOM_ONEPASS
3825   ffeste_R909_item (expr);
3826 #else
3827   {
3828     ffestdExprItem_ item
3829     = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
3830                                        sizeof (*item));
3831
3832     item->next = NULL;
3833     item->expr = expr;
3834     item->token = ffelex_token_use (expr_token);
3835     *ffestd_expr_list_ = item;
3836     ffestd_expr_list_ = &item->next;
3837   }
3838 #endif
3839 }
3840
3841 /* ffestd_R909_finish -- READ statement list complete
3842
3843    ffestd_R909_finish();
3844
3845    Just wrap up any local activities.  */
3846
3847 void
3848 ffestd_R909_finish ()
3849 {
3850   ffestd_check_finish_ ();
3851
3852 #if FFECOM_ONEPASS
3853   ffeste_R909_finish ();
3854 #else
3855   /* Nothing to do, it's implicit. */
3856 #endif
3857 }
3858
3859 /* ffestd_R910_start -- WRITE(...) statement list begin
3860
3861    ffestd_R910_start();
3862
3863    Verify that WRITE is valid here, and begin accepting items in the
3864    list.  */
3865
3866 void
3867 ffestd_R910_start (ffestvUnit unit, ffestvFormat format, bool rec)
3868 {
3869   ffestd_check_start_ ();
3870
3871 #if FFECOM_targetCURRENT == FFECOM_targetGCC
3872 #define specified(something) \
3873       (ffestp_file.write.write_spec[something].kw_or_val_present)
3874
3875   /* Warn if there are any thing we don't handle via f2c libraries. */
3876   if (specified (FFESTP_writeixADVANCE)
3877       || specified (FFESTP_writeixEOR))
3878     {
3879       ffebad_start (FFEBAD_WRITE_UNSUPPORTED);
3880       ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
3881                    ffelex_token_where_column (ffesta_tokens[0]));
3882       ffebad_finish ();
3883     }
3884
3885 #undef specified
3886 #endif
3887
3888 #if FFECOM_ONEPASS
3889   ffestd_subr_line_now_ ();
3890   ffeste_R910_start (&ffestp_file.write, unit, format, rec);
3891 #else
3892   {
3893     ffestdStmt_ stmt;
3894
3895     stmt = ffestd_stmt_new_ (FFESTD_stmtidR910_);
3896     ffestd_stmt_append_ (stmt);
3897     ffestd_subr_line_save_ (stmt);
3898     stmt->u.R910.pool = ffesta_output_pool;
3899     stmt->u.R910.params = ffestd_subr_copy_write_ ();
3900     stmt->u.R910.unit = unit;
3901     stmt->u.R910.format = format;
3902     stmt->u.R910.rec = rec;
3903     stmt->u.R910.list = NULL;
3904     ffestd_expr_list_ = &stmt->u.R910.list;
3905     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3906   }
3907 #endif
3908 }
3909
3910 /* ffestd_R910_item -- WRITE statement i/o item
3911
3912    ffestd_R910_item(expr,expr_token);
3913
3914    Implement output-list expression.  */
3915
3916 void
3917 ffestd_R910_item (ffebld expr, ffelexToken expr_token)
3918 {
3919   ffestd_check_item_ ();
3920
3921 #if FFECOM_ONEPASS
3922   ffeste_R910_item (expr);
3923 #else
3924   {
3925     ffestdExprItem_ item
3926     = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
3927                                        sizeof (*item));
3928
3929     item->next = NULL;
3930     item->expr = expr;
3931     item->token = ffelex_token_use (expr_token);
3932     *ffestd_expr_list_ = item;
3933     ffestd_expr_list_ = &item->next;
3934   }
3935 #endif
3936 }
3937
3938 /* ffestd_R910_finish -- WRITE statement list complete
3939
3940    ffestd_R910_finish();
3941
3942    Just wrap up any local activities.  */
3943
3944 void
3945 ffestd_R910_finish ()
3946 {
3947   ffestd_check_finish_ ();
3948
3949 #if FFECOM_ONEPASS
3950   ffeste_R910_finish ();
3951 #else
3952   /* Nothing to do, it's implicit. */
3953 #endif
3954 }
3955
3956 /* ffestd_R911_start -- PRINT statement list begin
3957
3958    ffestd_R911_start();
3959
3960    Verify that PRINT is valid here, and begin accepting items in the
3961    list.  */
3962
3963 void
3964 ffestd_R911_start (ffestvFormat format)
3965 {
3966   ffestd_check_start_ ();
3967
3968 #if FFECOM_ONEPASS
3969   ffestd_subr_line_now_ ();
3970   ffeste_R911_start (&ffestp_file.print, format);
3971 #else
3972   {
3973     ffestdStmt_ stmt;
3974
3975     stmt = ffestd_stmt_new_ (FFESTD_stmtidR911_);
3976     ffestd_stmt_append_ (stmt);
3977     ffestd_subr_line_save_ (stmt);
3978     stmt->u.R911.pool = ffesta_output_pool;
3979     stmt->u.R911.params = ffestd_subr_copy_print_ ();
3980     stmt->u.R911.format = format;
3981     stmt->u.R911.list = NULL;
3982     ffestd_expr_list_ = &stmt->u.R911.list;
3983     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
3984   }
3985 #endif
3986 }
3987
3988 /* ffestd_R911_item -- PRINT statement i/o item
3989
3990    ffestd_R911_item(expr,expr_token);
3991
3992    Implement output-list expression.  */
3993
3994 void
3995 ffestd_R911_item (ffebld expr, ffelexToken expr_token)
3996 {
3997   ffestd_check_item_ ();
3998
3999 #if FFECOM_ONEPASS
4000   ffeste_R911_item (expr);
4001 #else
4002   {
4003     ffestdExprItem_ item
4004     = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
4005                                        sizeof (*item));
4006
4007     item->next = NULL;
4008     item->expr = expr;
4009     item->token = ffelex_token_use (expr_token);
4010     *ffestd_expr_list_ = item;
4011     ffestd_expr_list_ = &item->next;
4012   }
4013 #endif
4014 }
4015
4016 /* ffestd_R911_finish -- PRINT statement list complete
4017
4018    ffestd_R911_finish();
4019
4020    Just wrap up any local activities.  */
4021
4022 void
4023 ffestd_R911_finish ()
4024 {
4025   ffestd_check_finish_ ();
4026
4027 #if FFECOM_ONEPASS
4028   ffeste_R911_finish ();
4029 #else
4030   /* Nothing to do, it's implicit. */
4031 #endif
4032 }
4033
4034 /* ffestd_R919 -- BACKSPACE statement
4035
4036    ffestd_R919();
4037
4038    Make sure a BACKSPACE is valid in the current context, and implement it.  */
4039
4040 void
4041 ffestd_R919 ()
4042 {
4043   ffestd_check_simple_ ();
4044
4045 #if FFECOM_ONEPASS
4046   ffestd_subr_line_now_ ();
4047   ffeste_R919 (&ffestp_file.beru);
4048 #else
4049   {
4050     ffestdStmt_ stmt;
4051
4052     stmt = ffestd_stmt_new_ (FFESTD_stmtidR919_);
4053     ffestd_stmt_append_ (stmt);
4054     ffestd_subr_line_save_ (stmt);
4055     stmt->u.R919.pool = ffesta_output_pool;
4056     stmt->u.R919.params = ffestd_subr_copy_beru_ ();
4057     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
4058   }
4059 #endif
4060 }
4061
4062 /* ffestd_R920 -- ENDFILE statement
4063
4064    ffestd_R920();
4065
4066    Make sure a ENDFILE is valid in the current context, and implement it.  */
4067
4068 void
4069 ffestd_R920 ()
4070 {
4071   ffestd_check_simple_ ();
4072
4073 #if FFECOM_ONEPASS
4074   ffestd_subr_line_now_ ();
4075   ffeste_R920 (&ffestp_file.beru);
4076 #else
4077   {
4078     ffestdStmt_ stmt;
4079
4080     stmt = ffestd_stmt_new_ (FFESTD_stmtidR920_);
4081     ffestd_stmt_append_ (stmt);
4082     ffestd_subr_line_save_ (stmt);
4083     stmt->u.R920.pool = ffesta_output_pool;
4084     stmt->u.R920.params = ffestd_subr_copy_beru_ ();
4085     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
4086   }
4087 #endif
4088 }
4089
4090 /* ffestd_R921 -- REWIND statement
4091
4092    ffestd_R921();
4093
4094    Make sure a REWIND is valid in the current context, and implement it.  */
4095
4096 void
4097 ffestd_R921 ()
4098 {
4099   ffestd_check_simple_ ();
4100
4101 #if FFECOM_ONEPASS
4102   ffestd_subr_line_now_ ();
4103   ffeste_R921 (&ffestp_file.beru);
4104 #else
4105   {
4106     ffestdStmt_ stmt;
4107
4108     stmt = ffestd_stmt_new_ (FFESTD_stmtidR921_);
4109     ffestd_stmt_append_ (stmt);
4110     ffestd_subr_line_save_ (stmt);
4111     stmt->u.R921.pool = ffesta_output_pool;
4112     stmt->u.R921.params = ffestd_subr_copy_beru_ ();
4113     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
4114   }
4115 #endif
4116 }
4117
4118 /* ffestd_R923A -- INQUIRE statement (non-IOLENGTH version)
4119
4120    ffestd_R923A(bool by_file);
4121
4122    Make sure an INQUIRE is valid in the current context, and implement it.  */
4123
4124 void
4125 ffestd_R923A (bool by_file)
4126 {
4127   ffestd_check_simple_ ();
4128
4129 #if FFECOM_targetCURRENT == FFECOM_targetGCC
4130 #define specified(something) \
4131       (ffestp_file.inquire.inquire_spec[something].kw_or_val_present)
4132
4133   /* Warn if there are any thing we don't handle via f2c libraries. */
4134   if (specified (FFESTP_inquireixACTION)
4135       || specified (FFESTP_inquireixCARRIAGECONTROL)
4136       || specified (FFESTP_inquireixDEFAULTFILE)
4137       || specified (FFESTP_inquireixDELIM)
4138       || specified (FFESTP_inquireixKEYED)
4139       || specified (FFESTP_inquireixORGANIZATION)
4140       || specified (FFESTP_inquireixPAD)
4141       || specified (FFESTP_inquireixPOSITION)
4142       || specified (FFESTP_inquireixREAD)
4143       || specified (FFESTP_inquireixREADWRITE)
4144       || specified (FFESTP_inquireixRECORDTYPE)
4145       || specified (FFESTP_inquireixWRITE))
4146     {
4147       ffebad_start (FFEBAD_INQUIRE_UNSUPPORTED);
4148       ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
4149                    ffelex_token_where_column (ffesta_tokens[0]));
4150       ffebad_finish ();
4151     }
4152
4153 #undef specified
4154 #endif
4155
4156 #if FFECOM_ONEPASS
4157   ffestd_subr_line_now_ ();
4158   ffeste_R923A (&ffestp_file.inquire, by_file);
4159 #else
4160   {
4161     ffestdStmt_ stmt;
4162
4163     stmt = ffestd_stmt_new_ (FFESTD_stmtidR923A_);
4164     ffestd_stmt_append_ (stmt);
4165     ffestd_subr_line_save_ (stmt);
4166     stmt->u.R923A.pool = ffesta_output_pool;
4167     stmt->u.R923A.params = ffestd_subr_copy_inquire_ ();
4168     stmt->u.R923A.by_file = by_file;
4169     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
4170   }
4171 #endif
4172 }
4173
4174 /* ffestd_R923B_start -- INQUIRE(IOLENGTH=expr) statement list begin
4175
4176    ffestd_R923B_start();
4177
4178    Verify that INQUIRE is valid here, and begin accepting items in the
4179    list.  */
4180
4181 void
4182 ffestd_R923B_start ()
4183 {
4184   ffestd_check_start_ ();
4185
4186 #if FFECOM_ONEPASS
4187   ffestd_subr_line_now_ ();
4188   ffeste_R923B_start (&ffestp_file.inquire);
4189 #else
4190   {
4191     ffestdStmt_ stmt;
4192
4193     stmt = ffestd_stmt_new_ (FFESTD_stmtidR923B_);
4194     ffestd_stmt_append_ (stmt);
4195     ffestd_subr_line_save_ (stmt);
4196     stmt->u.R923B.pool = ffesta_output_pool;
4197     stmt->u.R923B.params = ffestd_subr_copy_inquire_ ();
4198     stmt->u.R923B.list = NULL;
4199     ffestd_expr_list_ = &stmt->u.R923B.list;
4200     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
4201   }
4202 #endif
4203 }
4204
4205 /* ffestd_R923B_item -- INQUIRE statement i/o item
4206
4207    ffestd_R923B_item(expr,expr_token);
4208
4209    Implement output-list expression.  */
4210
4211 void
4212 ffestd_R923B_item (ffebld expr)
4213 {
4214   ffestd_check_item_ ();
4215
4216 #if FFECOM_ONEPASS
4217   ffeste_R923B_item (expr);
4218 #else
4219   {
4220     ffestdExprItem_ item
4221     = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
4222                                        sizeof (*item));
4223
4224     item->next = NULL;
4225     item->expr = expr;
4226     *ffestd_expr_list_ = item;
4227     ffestd_expr_list_ = &item->next;
4228   }
4229 #endif
4230 }
4231
4232 /* ffestd_R923B_finish -- INQUIRE statement list complete
4233
4234    ffestd_R923B_finish();
4235
4236    Just wrap up any local activities.  */
4237
4238 void
4239 ffestd_R923B_finish ()
4240 {
4241   ffestd_check_finish_ ();
4242
4243 #if FFECOM_ONEPASS
4244   ffeste_R923B_finish ();
4245 #else
4246   /* Nothing to do, it's implicit. */
4247 #endif
4248 }
4249
4250 /* ffestd_R1001 -- FORMAT statement
4251
4252    ffestd_R1001(format_list);  */
4253
4254 void
4255 ffestd_R1001 (ffesttFormatList f)
4256 {
4257   ffestsHolder str;
4258   ffests s = &str;
4259
4260   ffestd_check_simple_ ();
4261
4262   if (ffestd_label_formatdef_ == NULL)
4263     return;                     /* Nothing to hook it up to (no label def). */
4264
4265   ffests_new (s, malloc_pool_image (), 80);
4266   ffests_putc (s, '(');
4267   ffestd_R1001dump_ (s, f);     /* Build the string in s. */
4268   ffests_putc (s, ')');
4269
4270 #if FFECOM_ONEPASS
4271   ffeste_R1001 (s);
4272   ffests_kill (s);              /* Kill the string in s. */
4273 #else
4274   {
4275     ffestdStmt_ stmt;
4276
4277     stmt = ffestd_stmt_new_ (FFESTD_stmtidR1001_);
4278 #if 0
4279     /* Don't bother with this.  After all, things like cilists also are
4280        declared midway through code-generation.  Perhaps the only problems
4281        the gcc back end has with midway declarations are with stack vars,
4282        maybe only with vars that can be put in registers.  Unless/until the
4283        need is established, handle FORMAT just like cilists and others; at
4284        that point, they'd likely *all* have to be fixed, which would be
4285        very painful anyway.  */
4286     /* Insert FORMAT statement just after the first item on the
4287        statement list, which must be a FORMAT label, which see.  */
4288     assert (ffestd_stmt_list_.first->id == FFESTD_stmtidFORMATLABEL_);
4289     stmt->previous = ffestd_stmt_list_.first;
4290     stmt->next = ffestd_stmt_list_.first->next;
4291     stmt->next->previous = stmt;
4292     stmt->previous->next = stmt;
4293 #else
4294     ffestd_stmt_append_ (stmt);
4295 #endif
4296     stmt->u.R1001.str = str;
4297   }
4298 #endif
4299
4300   ffestd_label_formatdef_ = NULL;
4301 }
4302
4303 /* ffestd_R1001dump_ -- Dump list of formats
4304
4305    ffesttFormatList list;
4306    ffestd_R1001dump_(list,0);
4307
4308    The formats in the list are dumped.  */
4309
4310 static void
4311 ffestd_R1001dump_ (ffests s, ffesttFormatList list)
4312 {
4313   ffesttFormatList next;
4314
4315   for (next = list->next; next != list; next = next->next)
4316     {
4317       if (next != list->next)
4318         ffests_putc (s, ',');
4319       switch (next->type)
4320         {
4321         case FFESTP_formattypeI:
4322           ffestd_R1001dump_1005_3_ (s, next, "I");
4323           break;
4324
4325         case FFESTP_formattypeB:
4326 #if FFECOM_targetCURRENT == FFECOM_targetFFE
4327           ffestd_R1001dump_1005_3_ (s, next, "B");
4328 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
4329           ffestd_R1001error_ (next);
4330 #else
4331 #error
4332 #endif
4333           break;
4334
4335         case FFESTP_formattypeO:
4336           ffestd_R1001dump_1005_3_ (s, next, "O");
4337           break;
4338
4339         case FFESTP_formattypeZ:
4340           ffestd_R1001dump_1005_3_ (s, next, "Z");
4341           break;
4342
4343         case FFESTP_formattypeF:
4344           ffestd_R1001dump_1005_4_ (s, next, "F");
4345           break;
4346
4347         case FFESTP_formattypeE:
4348           ffestd_R1001dump_1005_5_ (s, next, "E");
4349           break;
4350
4351         case FFESTP_formattypeEN:
4352 #if FFECOM_targetCURRENT == FFECOM_targetFFE
4353           ffestd_R1001dump_1005_5_ (s, next, "EN");
4354 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
4355           ffestd_R1001error_ (next);
4356 #else
4357 #error
4358 #endif
4359           break;
4360
4361         case FFESTP_formattypeG:
4362           ffestd_R1001dump_1005_5_ (s, next, "G");
4363           break;
4364
4365         case FFESTP_formattypeL:
4366           ffestd_R1001dump_1005_2_ (s, next, "L");
4367           break;
4368
4369         case FFESTP_formattypeA:
4370           ffestd_R1001dump_1005_1_ (s, next, "A");
4371           break;
4372
4373         case FFESTP_formattypeD:
4374           ffestd_R1001dump_1005_4_ (s, next, "D");
4375           break;
4376
4377         case FFESTP_formattypeQ:
4378 #if FFECOM_targetCURRENT == FFECOM_targetFFE
4379           ffestd_R1001dump_1010_1_ (s, next, "Q");
4380 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
4381           ffestd_R1001error_ (next);
4382 #else
4383 #error
4384 #endif
4385           break;
4386
4387         case FFESTP_formattypeDOLLAR:
4388           ffestd_R1001dump_1010_1_ (s, next, "$");
4389           break;
4390
4391         case FFESTP_formattypeP:
4392           ffestd_R1001dump_1010_4_ (s, next, "P");
4393           break;
4394
4395         case FFESTP_formattypeT:
4396           ffestd_R1001dump_1010_5_ (s, next, "T");
4397           break;
4398
4399         case FFESTP_formattypeTL:
4400           ffestd_R1001dump_1010_5_ (s, next, "TL");
4401           break;
4402
4403         case FFESTP_formattypeTR:
4404           ffestd_R1001dump_1010_5_ (s, next, "TR");
4405           break;
4406
4407         case FFESTP_formattypeX:
4408           ffestd_R1001dump_1010_3_ (s, next, "X");
4409           break;
4410
4411         case FFESTP_formattypeS:
4412           ffestd_R1001dump_1010_1_ (s, next, "S");
4413           break;
4414
4415         case FFESTP_formattypeSP:
4416           ffestd_R1001dump_1010_1_ (s, next, "SP");
4417           break;
4418
4419         case FFESTP_formattypeSS:
4420           ffestd_R1001dump_1010_1_ (s, next, "SS");
4421           break;
4422
4423         case FFESTP_formattypeBN:
4424           ffestd_R1001dump_1010_1_ (s, next, "BN");
4425           break;
4426
4427         case FFESTP_formattypeBZ:
4428           ffestd_R1001dump_1010_1_ (s, next, "BZ");
4429           break;
4430
4431         case FFESTP_formattypeSLASH:
4432           ffestd_R1001dump_1010_2_ (s, next, "/");
4433           break;
4434
4435         case FFESTP_formattypeCOLON:
4436           ffestd_R1001dump_1010_1_ (s, next, ":");
4437           break;
4438
4439         case FFESTP_formattypeR1016:
4440           switch (ffelex_token_type (next->t))
4441             {
4442             case FFELEX_typeCHARACTER:
4443               {
4444                 char *p = ffelex_token_text (next->t);
4445                 ffeTokenLength i = ffelex_token_length (next->t);
4446
4447                 ffests_putc (s, '\002');
4448                 while (i-- != 0)
4449                   {
4450                     if (*p == '\002')
4451                       ffests_putc (s, '\002');
4452                     ffests_putc (s, *p);
4453                     ++p;
4454                   }
4455                 ffests_putc (s, '\002');
4456               }
4457               break;
4458
4459             case FFELEX_typeHOLLERITH:
4460               {
4461                 char *p = ffelex_token_text (next->t);
4462                 ffeTokenLength i = ffelex_token_length (next->t);
4463
4464                 ffests_printf (s, "%" ffeTokenLength_f "uH", i);
4465                 while (i-- != 0)
4466                   {
4467                     ffests_putc (s, *p);
4468                     ++p;
4469                   }
4470               }
4471               break;
4472
4473             default:
4474               assert (FALSE);
4475             }
4476           break;
4477
4478         case FFESTP_formattypeFORMAT:
4479           if (next->u.R1003D.R1004.present)
4480             {
4481               if (next->u.R1003D.R1004.rtexpr)
4482                 ffestd_R1001rtexpr_ (s, next, next->u.R1003D.R1004.u.expr);
4483               else
4484                 ffests_printf (s, "%lu", next->u.R1003D.R1004.u.unsigned_val);
4485             }
4486
4487           ffests_putc (s, '(');
4488           ffestd_R1001dump_ (s, next->u.R1003D.format);
4489           ffests_putc (s, ')');
4490           break;
4491
4492         default:
4493           assert (FALSE);
4494         }
4495     }
4496 }
4497
4498 /* ffestd_R1001dump_1005_1_ -- Dump a particular format
4499
4500    ffesttFormatList f;
4501    ffestd_R1001dump_1005_1_(f,"I");
4502
4503    The format is dumped with form [r]X[w].  */
4504
4505 static void
4506 ffestd_R1001dump_1005_1_ (ffests s, ffesttFormatList f, const char *string)
4507 {
4508   assert (!f->u.R1005.R1007_or_R1008.present);
4509   assert (!f->u.R1005.R1009.present);
4510
4511   if (f->u.R1005.R1004.present)
4512     {
4513       if (f->u.R1005.R1004.rtexpr)
4514         ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
4515       else
4516         ffests_printf (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
4517     }
4518
4519   ffests_puts (s, string);
4520
4521   if (f->u.R1005.R1006.present)
4522     {
4523       if (f->u.R1005.R1006.rtexpr)
4524         ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
4525       else
4526         ffests_printf (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
4527     }
4528 }
4529
4530 /* ffestd_R1001dump_1005_2_ -- Dump a particular format
4531
4532    ffesttFormatList f;
4533    ffestd_R1001dump_1005_2_(f,"I");
4534
4535    The format is dumped with form [r]Xw.  */
4536
4537 static void
4538 ffestd_R1001dump_1005_2_ (ffests s, ffesttFormatList f, const char *string)
4539 {
4540   assert (!f->u.R1005.R1007_or_R1008.present);
4541   assert (!f->u.R1005.R1009.present);
4542   assert (f->u.R1005.R1006.present);
4543
4544   if (f->u.R1005.R1004.present)
4545     {
4546       if (f->u.R1005.R1004.rtexpr)
4547         ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
4548       else
4549         ffests_printf (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
4550     }
4551
4552   ffests_puts (s, string);
4553
4554   if (f->u.R1005.R1006.rtexpr)
4555     ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
4556   else
4557     ffests_printf (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
4558 }
4559
4560 /* ffestd_R1001dump_1005_3_ -- Dump a particular format
4561
4562    ffesttFormatList f;
4563    ffestd_R1001dump_1005_3_(f,"I");
4564
4565    The format is dumped with form [r]Xw[.m].  */
4566
4567 static void
4568 ffestd_R1001dump_1005_3_ (ffests s, ffesttFormatList f, const char *string)
4569 {
4570   assert (!f->u.R1005.R1009.present);
4571   assert (f->u.R1005.R1006.present);
4572
4573   if (f->u.R1005.R1004.present)
4574     {
4575       if (f->u.R1005.R1004.rtexpr)
4576         ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
4577       else
4578         ffests_printf (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
4579     }
4580
4581   ffests_puts (s, string);
4582
4583   if (f->u.R1005.R1006.rtexpr)
4584     ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
4585   else
4586     ffests_printf (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
4587
4588   if (f->u.R1005.R1007_or_R1008.present)
4589     {
4590       ffests_putc (s, '.');
4591       if (f->u.R1005.R1007_or_R1008.rtexpr)
4592         ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1007_or_R1008.u.expr);
4593       else
4594         ffests_printf (s, "%lu", f->u.R1005.R1007_or_R1008.u.unsigned_val);
4595     }
4596 }
4597
4598 /* ffestd_R1001dump_1005_4_ -- Dump a particular format
4599
4600    ffesttFormatList f;
4601    ffestd_R1001dump_1005_4_(f,"I");
4602
4603    The format is dumped with form [r]Xw.d.  */
4604
4605 static void
4606 ffestd_R1001dump_1005_4_ (ffests s, ffesttFormatList f, const char *string)
4607 {
4608   assert (!f->u.R1005.R1009.present);
4609   assert (f->u.R1005.R1007_or_R1008.present);
4610   assert (f->u.R1005.R1006.present);
4611
4612   if (f->u.R1005.R1004.present)
4613     {
4614       if (f->u.R1005.R1004.rtexpr)
4615         ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
4616       else
4617         ffests_printf (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
4618     }
4619
4620   ffests_puts (s, string);
4621
4622   if (f->u.R1005.R1006.rtexpr)
4623     ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
4624   else
4625     ffests_printf (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
4626
4627   ffests_putc (s, '.');
4628   if (f->u.R1005.R1007_or_R1008.rtexpr)
4629     ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1007_or_R1008.u.expr);
4630   else
4631     ffests_printf (s, "%lu", f->u.R1005.R1007_or_R1008.u.unsigned_val);
4632 }
4633
4634 /* ffestd_R1001dump_1005_5_ -- Dump a particular format
4635
4636    ffesttFormatList f;
4637    ffestd_R1001dump_1005_5_(f,"I");
4638
4639    The format is dumped with form [r]Xw.d[Ee].  */
4640
4641 static void
4642 ffestd_R1001dump_1005_5_ (ffests s, ffesttFormatList f, const char *string)
4643 {
4644   assert (f->u.R1005.R1007_or_R1008.present);
4645   assert (f->u.R1005.R1006.present);
4646
4647   if (f->u.R1005.R1004.present)
4648     {
4649       if (f->u.R1005.R1004.rtexpr)
4650         ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
4651       else
4652         ffests_printf (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
4653     }
4654
4655   ffests_puts (s, string);
4656
4657   if (f->u.R1005.R1006.rtexpr)
4658     ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
4659   else
4660     ffests_printf (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
4661
4662   ffests_putc (s, '.');
4663   if (f->u.R1005.R1007_or_R1008.rtexpr)
4664     ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1007_or_R1008.u.expr);
4665   else
4666     ffests_printf (s, "%lu", f->u.R1005.R1007_or_R1008.u.unsigned_val);
4667
4668   if (f->u.R1005.R1009.present)
4669     {
4670       ffests_putc (s, 'E');
4671       if (f->u.R1005.R1009.rtexpr)
4672         ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1009.u.expr);
4673       else
4674         ffests_printf (s, "%lu", f->u.R1005.R1009.u.unsigned_val);
4675     }
4676 }
4677
4678 /* ffestd_R1001dump_1010_1_ -- Dump a particular format
4679
4680    ffesttFormatList f;
4681    ffestd_R1001dump_1010_1_(f,"I");
4682
4683    The format is dumped with form X.  */
4684
4685 static void
4686 ffestd_R1001dump_1010_1_ (ffests s, ffesttFormatList f, const char *string)
4687 {
4688   assert (!f->u.R1010.val.present);
4689
4690   ffests_puts (s, string);
4691 }
4692
4693 /* ffestd_R1001dump_1010_2_ -- Dump a particular format
4694
4695    ffesttFormatList f;
4696    ffestd_R1001dump_1010_2_(f,"I");
4697
4698    The format is dumped with form [r]X.  */
4699
4700 static void
4701 ffestd_R1001dump_1010_2_ (ffests s, ffesttFormatList f, const char *string)
4702 {
4703   if (f->u.R1010.val.present)
4704     {
4705       if (f->u.R1010.val.rtexpr)
4706         ffestd_R1001rtexpr_ (s, f, f->u.R1010.val.u.expr);
4707       else
4708         ffests_printf (s, "%lu", f->u.R1010.val.u.unsigned_val);
4709     }
4710
4711   ffests_puts (s, string);
4712 }
4713
4714 /* ffestd_R1001dump_1010_3_ -- Dump a particular format
4715
4716    ffesttFormatList f;
4717    ffestd_R1001dump_1010_3_(f,"I");
4718
4719    The format is dumped with form nX.  */
4720
4721 static void
4722 ffestd_R1001dump_1010_3_ (ffests s, ffesttFormatList f, const char *string)
4723 {
4724   assert (f->u.R1010.val.present);
4725
4726   if (f->u.R1010.val.rtexpr)
4727     ffestd_R1001rtexpr_ (s, f, f->u.R1010.val.u.expr);
4728   else
4729     ffests_printf (s, "%lu", f->u.R1010.val.u.unsigned_val);
4730
4731   ffests_puts (s, string);
4732 }
4733
4734 /* ffestd_R1001dump_1010_4_ -- Dump a particular format
4735
4736    ffesttFormatList f;
4737    ffestd_R1001dump_1010_4_(f,"I");
4738
4739    The format is dumped with form kX.  Note that k is signed.  */
4740
4741 static void
4742 ffestd_R1001dump_1010_4_ (ffests s, ffesttFormatList f, const char *string)
4743 {
4744   assert (f->u.R1010.val.present);
4745
4746   if (f->u.R1010.val.rtexpr)
4747     ffestd_R1001rtexpr_ (s, f, f->u.R1010.val.u.expr);
4748   else
4749     ffests_printf (s, "%ld", f->u.R1010.val.u.signed_val);
4750
4751   ffests_puts (s, string);
4752 }
4753
4754 /* ffestd_R1001dump_1010_5_ -- Dump a particular format
4755
4756    ffesttFormatList f;
4757    ffestd_R1001dump_1010_5_(f,"I");
4758
4759    The format is dumped with form Xn.  */
4760
4761 static void
4762 ffestd_R1001dump_1010_5_ (ffests s, ffesttFormatList f, const char *string)
4763 {
4764   assert (f->u.R1010.val.present);
4765
4766   ffests_puts (s, string);
4767
4768   if (f->u.R1010.val.rtexpr)
4769     ffestd_R1001rtexpr_ (s, f, f->u.R1010.val.u.expr);
4770   else
4771     ffests_printf (s, "%lu", f->u.R1010.val.u.unsigned_val);
4772 }
4773
4774 /* ffestd_R1001error_ -- Complain about FORMAT specification not supported
4775
4776    ffesttFormatList f;
4777    ffestd_R1001error_(f);
4778
4779    An error message is produced.  */
4780
4781 static void
4782 ffestd_R1001error_ (ffesttFormatList f)
4783 {
4784   ffebad_start (FFEBAD_FORMAT_UNSUPPORTED);
4785   ffebad_here (0, ffelex_token_where_line (f->t), ffelex_token_where_column (f->t));
4786   ffebad_finish ();
4787 }
4788
4789 static void
4790 ffestd_R1001rtexpr_ (ffests s, ffesttFormatList f, ffebld expr)
4791 {
4792   if ((expr == NULL)
4793       || (ffebld_op (expr) != FFEBLD_opCONTER)
4794       || (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeINTEGER)
4795       || (ffeinfo_kindtype (ffebld_info (expr)) == FFEINFO_kindtypeINTEGER4))
4796     {
4797       ffebad_start (FFEBAD_FORMAT_VARIABLE);
4798       ffebad_here (0, ffelex_token_where_line (f->t), ffelex_token_where_column (f->t));
4799       ffebad_finish ();
4800     }
4801   else
4802     {
4803       int val;
4804
4805       switch (ffeinfo_kindtype (ffebld_info (expr)))
4806         {
4807 #if FFETARGET_okINTEGER1
4808         case FFEINFO_kindtypeINTEGER1:
4809           val = ffebld_constant_integer1 (ffebld_conter (expr));
4810           break;
4811 #endif
4812
4813 #if FFETARGET_okINTEGER2
4814         case FFEINFO_kindtypeINTEGER2:
4815           val = ffebld_constant_integer2 (ffebld_conter (expr));
4816           break;
4817 #endif
4818
4819 #if FFETARGET_okINTEGER3
4820         case FFEINFO_kindtypeINTEGER3:
4821           val = ffebld_constant_integer3 (ffebld_conter (expr));
4822           break;
4823 #endif
4824
4825         default:
4826           assert ("bad INTEGER constant kind type" == NULL);
4827           /* Fall through. */
4828         case FFEINFO_kindtypeANY:
4829           return;
4830         }
4831       ffests_printf (s, "%ld", (long) val);
4832     }
4833 }
4834
4835 /* ffestd_R1102 -- PROGRAM statement
4836
4837    ffestd_R1102(name_token);
4838
4839    Make sure ffestd_kind_ identifies an empty block.  Make sure name_token
4840    gives a valid name.  Implement the beginning of a main program.  */
4841
4842 void
4843 ffestd_R1102 (ffesymbol s, ffelexToken name UNUSED)
4844 {
4845   ffestd_check_simple_ ();
4846
4847   assert (ffestd_block_level_ == 0);
4848   ffestd_is_reachable_ = TRUE;
4849
4850   ffecom_notify_primary_entry (s);
4851   ffe_set_is_mainprog (TRUE);   /* Is a main program. */
4852   ffe_set_is_saveall (TRUE);    /* Main program always has implicit SAVE. */
4853
4854   ffestw_set_sym (ffestw_stack_top (), s);
4855
4856 #if FFECOM_targetCURRENT == FFECOM_targetFFE
4857   if (name == NULL)
4858     fputs ("< PROGRAM_unnamed\n", dmpout);
4859   else
4860     fprintf (dmpout, "< PROGRAM %s\n", ffelex_token_text (name));
4861 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
4862 #else
4863 #error
4864 #endif
4865 }
4866
4867 /* ffestd_R1103 -- End a PROGRAM
4868
4869    ffestd_R1103();  */
4870
4871 void
4872 ffestd_R1103 (bool ok UNUSED)
4873 {
4874   assert (ffestd_block_level_ == 0);
4875
4876   if (FFESTD_IS_END_OPTIMIZED_ && ffestd_is_reachable_)
4877     ffestd_R842 (NULL);         /* Generate STOP. */
4878
4879   if (ffestw_state (ffestw_stack_top ()) != FFESTV_statePROGRAM5)
4880     ffestd_subr_labels_ (FALSE);/* Handle any undefined labels. */
4881
4882 #if FFECOM_ONEPASS
4883   ffeste_R1103 ();
4884 #else
4885   {
4886     ffestdStmt_ stmt;
4887
4888     stmt = ffestd_stmt_new_ (FFESTD_stmtidR1103_);
4889     ffestd_stmt_append_ (stmt);
4890   }
4891 #endif
4892 }
4893
4894 /* ffestd_R1105 -- MODULE statement
4895
4896    ffestd_R1105(name_token);
4897
4898    Make sure ffestd_kind_ identifies an empty block.  Make sure name_token
4899    gives a valid name.  Implement the beginning of a module.  */
4900
4901 #if FFESTR_F90
4902 void
4903 ffestd_R1105 (ffelexToken name)
4904 {
4905   assert (ffestd_block_level_ == 0);
4906
4907   ffestd_check_simple_ ();
4908
4909   ffestd_subr_f90_ ();
4910   return;
4911
4912 #ifdef FFESTD_F90
4913   fprintf (dmpout, "* MODULE %s\n", ffelex_token_text (name));
4914 #endif
4915 }
4916
4917 /* ffestd_R1106 -- End a MODULE
4918
4919    ffestd_R1106(TRUE);  */
4920
4921 void
4922 ffestd_R1106 (bool ok)
4923 {
4924   assert (ffestd_block_level_ == 0);
4925
4926   /* Generate any wrap-up code here (unlikely in MODULE!). */
4927
4928   if (ffestw_state (ffestw_stack_top ()) != FFESTV_stateMODULE5)
4929     ffestd_subr_labels_ (TRUE); /* Handle any undefined labels (unlikely). */
4930
4931   return;                       /* F90. */
4932
4933 #ifdef FFESTD_F90
4934   fprintf (dmpout, "< END_MODULE %s\n",
4935            ffelex_token_text (ffestw_name (ffestw_stack_top ())));
4936 #endif
4937 }
4938
4939 /* ffestd_R1107_start -- USE statement list begin
4940
4941    ffestd_R1107_start();
4942
4943    Verify that USE is valid here, and begin accepting items in the list.  */
4944
4945 void
4946 ffestd_R1107_start (ffelexToken name, bool only)
4947 {
4948   ffestd_check_start_ ();
4949
4950   ffestd_subr_f90_ ();
4951   return;
4952
4953 #ifdef FFESTD_F90
4954   fprintf (dmpout, "* USE %s,", ffelex_token_text (name));      /* NB
4955                                                                    _shriek_begin_uses_. */
4956   if (only)
4957     fputs ("only: ", dmpout);
4958 #endif
4959 }
4960
4961 /* ffestd_R1107_item -- USE statement for name
4962
4963    ffestd_R1107_item(local_token,use_token);
4964
4965    Make sure name_token identifies a valid object to be USEed.  local_token
4966    may be NULL if _start_ was called with only==TRUE.  */
4967
4968 void
4969 ffestd_R1107_item (ffelexToken local, ffelexToken use)
4970 {
4971   ffestd_check_item_ ();
4972   assert (use != NULL);
4973
4974   return;                       /* F90. */
4975
4976 #ifdef FFESTD_F90
4977   if (local != NULL)
4978     fprintf (dmpout, "%s=>", ffelex_token_text (local));
4979   fprintf (dmpout, "%s,", ffelex_token_text (use));
4980 #endif
4981 }
4982
4983 /* ffestd_R1107_finish -- USE statement list complete
4984
4985    ffestd_R1107_finish();
4986
4987    Just wrap up any local activities.  */
4988
4989 void
4990 ffestd_R1107_finish ()
4991 {
4992   ffestd_check_finish_ ();
4993
4994   return;                       /* F90. */
4995
4996 #ifdef FFESTD_F90
4997   fputc ('\n', dmpout);
4998 #endif
4999 }
5000
5001 #endif
5002 /* ffestd_R1111 -- BLOCK DATA statement
5003
5004    ffestd_R1111(name_token);
5005
5006    Make sure ffestd_kind_ identifies no current program unit.  If not
5007    NULL, make sure name_token gives a valid name.  Implement the beginning
5008    of a block data program unit.  */
5009
5010 void
5011 ffestd_R1111 (ffesymbol s, ffelexToken name UNUSED)
5012 {
5013   assert (ffestd_block_level_ == 0);
5014   ffestd_is_reachable_ = TRUE;
5015
5016   ffestd_check_simple_ ();
5017
5018   ffecom_notify_primary_entry (s);
5019   ffestw_set_sym (ffestw_stack_top (), s);
5020
5021 #if FFECOM_targetCURRENT == FFECOM_targetFFE
5022   if (name == NULL)
5023     fputs ("< BLOCK_DATA_unnamed\n", dmpout);
5024   else
5025     fprintf (dmpout, "< BLOCK_DATA %s\n", ffelex_token_text (name));
5026 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
5027 #else
5028 #error
5029 #endif
5030 }
5031
5032 /* ffestd_R1112 -- End a BLOCK DATA
5033
5034    ffestd_R1112(TRUE);  */
5035
5036 void
5037 ffestd_R1112 (bool ok UNUSED)
5038 {
5039   assert (ffestd_block_level_ == 0);
5040
5041   /* Generate any return-like code here (not likely for BLOCK DATA!). */
5042
5043   if (ffestw_state (ffestw_stack_top ()) != FFESTV_stateBLOCKDATA5)
5044     ffestd_subr_labels_ (TRUE); /* Handle any undefined labels. */
5045
5046 #if FFECOM_ONEPASS
5047   ffeste_R1112 ();
5048 #else
5049   {
5050     ffestdStmt_ stmt;
5051
5052     stmt = ffestd_stmt_new_ (FFESTD_stmtidR1112_);
5053     ffestd_stmt_append_ (stmt);
5054   }
5055 #endif
5056 }
5057
5058 /* ffestd_R1202 -- INTERFACE statement
5059
5060    ffestd_R1202(operator,defined_name);
5061
5062    Make sure ffestd_kind_ identifies an INTERFACE block.
5063    Implement the end of the current interface.
5064
5065    06-Jun-90  JCB  1.1
5066       Allow no operator or name to mean INTERFACE by itself; missed this
5067       valid form when originally doing syntactic analysis code.  */
5068
5069 #if FFESTR_F90
5070 void
5071 ffestd_R1202 (ffestpDefinedOperator operator, ffelexToken name)
5072 {
5073   ffestd_check_simple_ ();
5074
5075   ffestd_subr_f90_ ();
5076   return;
5077
5078 #ifdef FFESTD_F90
5079   switch (operator)
5080     {
5081     case FFESTP_definedoperatorNone:
5082       if (name == NULL)
5083         fputs ("* INTERFACE_unnamed\n", dmpout);
5084       else
5085         fprintf (dmpout, "* INTERFACE %s\n", ffelex_token_text (name));
5086       break;
5087
5088     case FFESTP_definedoperatorOPERATOR:
5089       fprintf (dmpout, "* INTERFACE_OPERATOR (.%s.)\n", ffelex_token_text (name));
5090       break;
5091
5092     case FFESTP_definedoperatorASSIGNMENT:
5093       fputs ("* INTERFACE_ASSIGNMENT (=)\n", dmpout);
5094       break;
5095
5096     case FFESTP_definedoperatorPOWER:
5097       fputs ("* INTERFACE_OPERATOR (**)\n", dmpout);
5098       break;
5099
5100     case FFESTP_definedoperatorMULT:
5101       fputs ("* INTERFACE_OPERATOR (*)\n", dmpout);
5102       break;
5103
5104     case FFESTP_definedoperatorADD:
5105       fputs ("* INTERFACE_OPERATOR (+)\n", dmpout);
5106       break;
5107
5108     case FFESTP_definedoperatorCONCAT:
5109       fputs ("* INTERFACE_OPERATOR (//)\n", dmpout);
5110       break;
5111
5112     case FFESTP_definedoperatorDIVIDE:
5113       fputs ("* INTERFACE_OPERATOR (/)\n", dmpout);
5114       break;
5115
5116     case FFESTP_definedoperatorSUBTRACT:
5117       fputs ("* INTERFACE_OPERATOR (-)\n", dmpout);
5118       break;
5119
5120     case FFESTP_definedoperatorNOT:
5121       fputs ("* INTERFACE_OPERATOR (.not.)\n", dmpout);
5122       break;
5123
5124     case FFESTP_definedoperatorAND:
5125       fputs ("* INTERFACE_OPERATOR (.and.)\n", dmpout);
5126       break;
5127
5128     case FFESTP_definedoperatorOR:
5129       fputs ("* INTERFACE_OPERATOR (.or.)\n", dmpout);
5130       break;
5131
5132     case FFESTP_definedoperatorEQV:
5133       fputs ("* INTERFACE_OPERATOR (.eqv.)\n", dmpout);
5134       break;
5135
5136     case FFESTP_definedoperatorNEQV:
5137       fputs ("* INTERFACE_OPERATOR (.neqv.)\n", dmpout);
5138       break;
5139
5140     case FFESTP_definedoperatorEQ:
5141       fputs ("* INTERFACE_OPERATOR (==)\n", dmpout);
5142       break;
5143
5144     case FFESTP_definedoperatorNE:
5145       fputs ("* INTERFACE_OPERATOR (/=)\n", dmpout);
5146       break;
5147
5148     case FFESTP_definedoperatorLT:
5149       fputs ("* INTERFACE_OPERATOR (<)\n", dmpout);
5150       break;
5151
5152     case FFESTP_definedoperatorLE:
5153       fputs ("* INTERFACE_OPERATOR (<=)\n", dmpout);
5154       break;
5155
5156     case FFESTP_definedoperatorGT:
5157       fputs ("* INTERFACE_OPERATOR (>)\n", dmpout);
5158       break;
5159
5160     case FFESTP_definedoperatorGE:
5161       fputs ("* INTERFACE_OPERATOR (>=)\n", dmpout);
5162       break;
5163
5164     default:
5165       assert (FALSE);
5166       break;
5167     }
5168 #endif
5169 }
5170
5171 /* ffestd_R1203 -- End an INTERFACE
5172
5173    ffestd_R1203(TRUE);  */
5174
5175 void
5176 ffestd_R1203 (bool ok)
5177 {
5178   return;                       /* F90. */
5179
5180 #ifdef FFESTD_F90
5181   fputs ("* END_INTERFACE\n", dmpout);
5182 #endif
5183 }
5184
5185 /* ffestd_R1205_start -- MODULE PROCEDURE statement list begin
5186
5187    ffestd_R1205_start();
5188
5189    Verify that MODULE PROCEDURE is valid here, and begin accepting items in
5190    the list.  */
5191
5192 void
5193 ffestd_R1205_start ()
5194 {
5195   ffestd_check_start_ ();
5196
5197   return;                       /* F90. */
5198
5199 #ifdef FFESTD_F90
5200   fputs ("* MODULE_PROCEDURE ", dmpout);
5201 #endif
5202 }
5203
5204 /* ffestd_R1205_item -- MODULE PROCEDURE statement for name
5205
5206    ffestd_R1205_item(name_token);
5207
5208    Make sure name_token identifies a valid object to be MODULE PROCEDUREed.  */
5209
5210 void
5211 ffestd_R1205_item (ffelexToken name)
5212 {
5213   ffestd_check_item_ ();
5214   assert (name != NULL);
5215
5216   return;                       /* F90. */
5217
5218 #ifdef FFESTD_F90
5219   fprintf (dmpout, "%s,", ffelex_token_text (name));
5220 #endif
5221 }
5222
5223 /* ffestd_R1205_finish -- MODULE PROCEDURE statement list complete
5224
5225    ffestd_R1205_finish();
5226
5227    Just wrap up any local activities.  */
5228
5229 void
5230 ffestd_R1205_finish ()
5231 {
5232   ffestd_check_finish_ ();
5233
5234   return;                       /* F90. */
5235
5236 #ifdef FFESTD_F90
5237   fputc ('\n', dmpout);
5238 #endif
5239 }
5240
5241 #endif
5242 /* ffestd_R1207_start -- EXTERNAL statement list begin
5243
5244    ffestd_R1207_start();
5245
5246    Verify that EXTERNAL is valid here, and begin accepting items in the list.  */
5247
5248 void
5249 ffestd_R1207_start ()
5250 {
5251   ffestd_check_start_ ();
5252
5253 #if FFECOM_targetCURRENT == FFECOM_targetFFE
5254   fputs ("* EXTERNAL (", dmpout);
5255 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
5256 #else
5257 #error
5258 #endif
5259 }
5260
5261 /* ffestd_R1207_item -- EXTERNAL statement for name
5262
5263    ffestd_R1207_item(name_token);
5264
5265    Make sure name_token identifies a valid object to be EXTERNALd.  */
5266
5267 void
5268 ffestd_R1207_item (ffelexToken name)
5269 {
5270   ffestd_check_item_ ();
5271   assert (name != NULL);
5272
5273 #if FFECOM_targetCURRENT == FFECOM_targetFFE
5274   fprintf (dmpout, "%s,", ffelex_token_text (name));
5275 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
5276 #else
5277 #error
5278 #endif
5279 }
5280
5281 /* ffestd_R1207_finish -- EXTERNAL statement list complete
5282
5283    ffestd_R1207_finish();
5284
5285    Just wrap up any local activities.  */
5286
5287 void
5288 ffestd_R1207_finish ()
5289 {
5290   ffestd_check_finish_ ();
5291
5292 #if FFECOM_targetCURRENT == FFECOM_targetFFE
5293   fputs (")\n", dmpout);
5294 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
5295 #else
5296 #error
5297 #endif
5298 }
5299
5300 /* ffestd_R1208_start -- INTRINSIC statement list begin
5301
5302    ffestd_R1208_start();
5303
5304    Verify that INTRINSIC is valid here, and begin accepting items in the list.  */
5305
5306 void
5307 ffestd_R1208_start ()
5308 {
5309   ffestd_check_start_ ();
5310
5311 #if FFECOM_targetCURRENT == FFECOM_targetFFE
5312   fputs ("* INTRINSIC (", dmpout);
5313 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
5314 #else
5315 #error
5316 #endif
5317 }
5318
5319 /* ffestd_R1208_item -- INTRINSIC statement for name
5320
5321    ffestd_R1208_item(name_token);
5322
5323    Make sure name_token identifies a valid object to be INTRINSICd.  */
5324
5325 void
5326 ffestd_R1208_item (ffelexToken name)
5327 {
5328   ffestd_check_item_ ();
5329   assert (name != NULL);
5330
5331 #if FFECOM_targetCURRENT == FFECOM_targetFFE
5332   fprintf (dmpout, "%s,", ffelex_token_text (name));
5333 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
5334 #else
5335 #error
5336 #endif
5337 }
5338
5339 /* ffestd_R1208_finish -- INTRINSIC statement list complete
5340
5341    ffestd_R1208_finish();
5342
5343    Just wrap up any local activities.  */
5344
5345 void
5346 ffestd_R1208_finish ()
5347 {
5348   ffestd_check_finish_ ();
5349
5350 #if FFECOM_targetCURRENT == FFECOM_targetFFE
5351   fputs (")\n", dmpout);
5352 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
5353 #else
5354 #error
5355 #endif
5356 }
5357
5358 /* ffestd_R1212 -- CALL statement
5359
5360    ffestd_R1212(expr,expr_token);
5361
5362    Make sure statement is valid here; implement.  */
5363
5364 void
5365 ffestd_R1212 (ffebld expr)
5366 {
5367   ffestd_check_simple_ ();
5368
5369 #if FFECOM_ONEPASS
5370   ffestd_subr_line_now_ ();
5371   ffeste_R1212 (expr);
5372 #else
5373   {
5374     ffestdStmt_ stmt;
5375
5376     stmt = ffestd_stmt_new_ (FFESTD_stmtidR1212_);
5377     ffestd_stmt_append_ (stmt);
5378     ffestd_subr_line_save_ (stmt);
5379     stmt->u.R1212.pool = ffesta_output_pool;
5380     stmt->u.R1212.expr = expr;
5381     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
5382   }
5383 #endif
5384 }
5385
5386 /* ffestd_R1213 -- Defined assignment statement
5387
5388    ffestd_R1213(dest_expr,source_expr,source_token);
5389
5390    Make sure the assignment is valid.  */
5391
5392 #if FFESTR_F90
5393 void
5394 ffestd_R1213 (ffebld dest, ffebld source)
5395 {
5396   ffestd_check_simple_ ();
5397
5398   ffestd_subr_f90_ ();
5399   return;
5400
5401 #ifdef FFESTD_F90
5402   fputs ("+ let_defined ", dmpout);
5403   ffebld_dump (dest);
5404   fputs ("=", dmpout);
5405   ffebld_dump (source);
5406   fputc ('\n', dmpout);
5407 #endif
5408 }
5409
5410 #endif
5411 /* ffestd_R1219 -- FUNCTION statement
5412
5413    ffestd_R1219(funcname,arglist,ending_token,kind,kindt,len,lent,
5414          recursive);
5415
5416    Make sure statement is valid here, register arguments for the
5417    function name, and so on.
5418
5419    06-Jun-90  JCB  2.0
5420       Added the kind, len, and recursive arguments.  */
5421
5422 void
5423 ffestd_R1219 (ffesymbol s, ffelexToken funcname UNUSED,
5424               ffesttTokenList args UNUSED, ffestpType type UNUSED,
5425               ffebld kind UNUSED, ffelexToken kindt UNUSED,
5426               ffebld len UNUSED, ffelexToken lent UNUSED,
5427               bool recursive UNUSED, ffelexToken result UNUSED,
5428               bool separate_result UNUSED)
5429 {
5430 #if FFECOM_targetCURRENT == FFECOM_targetFFE
5431   char *a;
5432 #endif
5433
5434   assert (ffestd_block_level_ == 0);
5435   ffestd_is_reachable_ = TRUE;
5436
5437   ffestd_check_simple_ ();
5438
5439   ffecom_notify_primary_entry (s);
5440   ffestw_set_sym (ffestw_stack_top (), s);
5441
5442 #if FFECOM_targetCURRENT == FFECOM_targetFFE
5443   switch (type)
5444     {
5445     case FFESTP_typeINTEGER:
5446       a = "INTEGER";
5447       break;
5448
5449     case FFESTP_typeBYTE:
5450       a = "BYTE";
5451       break;
5452
5453     case FFESTP_typeWORD:
5454       a = "WORD";
5455       break;
5456
5457     case FFESTP_typeREAL:
5458       a = "REAL";
5459       break;
5460
5461     case FFESTP_typeCOMPLEX:
5462       a = "COMPLEX";
5463       break;
5464
5465     case FFESTP_typeLOGICAL:
5466       a = "LOGICAL";
5467       break;
5468
5469     case FFESTP_typeCHARACTER:
5470       a = "CHARACTER";
5471       break;
5472
5473     case FFESTP_typeDBLPRCSN:
5474       a = "DOUBLE PRECISION";
5475       break;
5476
5477     case FFESTP_typeDBLCMPLX:
5478       a = "DOUBLE COMPLEX";
5479       break;
5480
5481 #if FFESTR_F90
5482     case FFESTP_typeTYPE:
5483       a = "TYPE";
5484       break;
5485 #endif
5486
5487     case FFESTP_typeNone:
5488       a = "";
5489       break;
5490
5491     default:
5492       assert (FALSE);
5493       a = "?";
5494       break;
5495     }
5496   fprintf (dmpout, "< FUNCTION %s ", ffelex_token_text (funcname));
5497   if (recursive)
5498     fputs ("RECURSIVE ", dmpout);
5499   fprintf (dmpout, "%s(", a);
5500   if (kindt != NULL)
5501     {
5502       fputs ("kind=", dmpout);
5503       if (kind == NULL)
5504         fputs (ffelex_token_text (kindt), dmpout);
5505       else
5506         ffebld_dump (kind);
5507       if (lent != NULL)
5508         fputc (',', dmpout);
5509     }
5510   if (lent != NULL)
5511     {
5512       fputs ("len=", dmpout);
5513       if (len == NULL)
5514         fputs (ffelex_token_text (lent), dmpout);
5515       else
5516         ffebld_dump (len);
5517     }
5518   fprintf (dmpout, ")");
5519   if (args != NULL)
5520     {
5521       fputs (" (", dmpout);
5522       ffestt_tokenlist_dump (args);
5523       fputc (')', dmpout);
5524     }
5525   if (result != NULL)
5526     fprintf (dmpout, " result(%s)", ffelex_token_text (result));
5527   fputc ('\n', dmpout);
5528 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
5529 #else
5530 #error
5531 #endif
5532 }
5533
5534 /* ffestd_R1221 -- End a FUNCTION
5535
5536    ffestd_R1221(TRUE);  */
5537
5538 void
5539 ffestd_R1221 (bool ok UNUSED)
5540 {
5541   assert (ffestd_block_level_ == 0);
5542
5543   if (FFESTD_IS_END_OPTIMIZED_ && ffestd_is_reachable_)
5544     ffestd_R1227 (NULL);        /* Generate RETURN. */
5545
5546   if (ffestw_state (ffestw_stack_top ()) != FFESTV_stateFUNCTION5)
5547     ffestd_subr_labels_ (FALSE);/* Handle any undefined labels. */
5548
5549 #if FFECOM_ONEPASS
5550   ffeste_R1221 ();
5551 #else
5552   {
5553     ffestdStmt_ stmt;
5554
5555     stmt = ffestd_stmt_new_ (FFESTD_stmtidR1221_);
5556     ffestd_stmt_append_ (stmt);
5557   }
5558 #endif
5559 }
5560
5561 /* ffestd_R1223 -- SUBROUTINE statement
5562
5563    ffestd_R1223(subrname,arglist,ending_token,recursive_token);
5564
5565    Make sure statement is valid here, register arguments for the
5566    subroutine name, and so on.
5567
5568    06-Jun-90  JCB  2.0
5569       Added the recursive argument.  */
5570
5571 void
5572 ffestd_R1223 (ffesymbol s, ffelexToken subrname UNUSED,
5573               ffesttTokenList args UNUSED, ffelexToken final UNUSED,
5574               bool recursive UNUSED)
5575 {
5576   assert (ffestd_block_level_ == 0);
5577   ffestd_is_reachable_ = TRUE;
5578
5579   ffestd_check_simple_ ();
5580
5581   ffecom_notify_primary_entry (s);
5582   ffestw_set_sym (ffestw_stack_top (), s);
5583
5584 #if FFECOM_targetCURRENT == FFECOM_targetFFE
5585   fprintf (dmpout, "< SUBROUTINE %s ", ffelex_token_text (subrname));
5586   if (recursive)
5587     fputs ("recursive ", dmpout);
5588   if (args != NULL)
5589     {
5590       fputc ('(', dmpout);
5591       ffestt_tokenlist_dump (args);
5592       fputc (')', dmpout);
5593     }
5594   fputc ('\n', dmpout);
5595 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
5596 #else
5597 #error
5598 #endif
5599 }
5600
5601 /* ffestd_R1225 -- End a SUBROUTINE
5602
5603    ffestd_R1225(TRUE);  */
5604
5605 void
5606 ffestd_R1225 (bool ok UNUSED)
5607 {
5608   assert (ffestd_block_level_ == 0);
5609
5610   if (FFESTD_IS_END_OPTIMIZED_ && ffestd_is_reachable_)
5611     ffestd_R1227 (NULL);        /* Generate RETURN. */
5612
5613   if (ffestw_state (ffestw_stack_top ()) != FFESTV_stateSUBROUTINE5)
5614     ffestd_subr_labels_ (FALSE);/* Handle any undefined labels. */
5615
5616 #if FFECOM_ONEPASS
5617   ffeste_R1225 ();
5618 #else
5619   {
5620     ffestdStmt_ stmt;
5621
5622     stmt = ffestd_stmt_new_ (FFESTD_stmtidR1225_);
5623     ffestd_stmt_append_ (stmt);
5624   }
5625 #endif
5626 }
5627
5628 /* ffestd_R1226 -- ENTRY statement
5629
5630    ffestd_R1226(entryname,arglist,ending_token);
5631
5632    Make sure we're in a SUBROUTINE or FUNCTION, register arguments for the
5633    entry point name, and so on.  */
5634
5635 void
5636 ffestd_R1226 (ffesymbol entry)
5637 {
5638   ffestd_check_simple_ ();
5639
5640 #if (FFECOM_targetCURRENT == FFECOM_targetFFE) || FFECOM_ONEPASS
5641   ffestd_subr_line_now_ ();
5642   ffeste_R1226 (entry);
5643 #else
5644   if (!ffesta_seen_first_exec || ffecom_2pass_advise_entrypoint (entry))
5645     {
5646       ffestdStmt_ stmt;
5647
5648       stmt = ffestd_stmt_new_ (FFESTD_stmtidR1226_);
5649       ffestd_stmt_append_ (stmt);
5650       ffestd_subr_line_save_ (stmt);
5651       stmt->u.R1226.entry = entry;
5652       stmt->u.R1226.entrynum = ++ffestd_2pass_entrypoints_;
5653     }
5654 #endif
5655
5656   ffestd_is_reachable_ = TRUE;
5657 }
5658
5659 /* ffestd_R1227 -- RETURN statement
5660
5661    ffestd_R1227(expr);
5662
5663    Make sure statement is valid here; implement.  expr and expr_token are
5664    both NULL if there was no expression.  */
5665
5666 void
5667 ffestd_R1227 (ffebld expr)
5668 {
5669   ffestd_check_simple_ ();
5670
5671 #if FFECOM_ONEPASS
5672   ffestd_subr_line_now_ ();
5673   ffeste_R1227 (ffestw_stack_top (), expr);
5674 #else
5675   {
5676     ffestdStmt_ stmt;
5677
5678     stmt = ffestd_stmt_new_ (FFESTD_stmtidR1227_);
5679     ffestd_stmt_append_ (stmt);
5680     ffestd_subr_line_save_ (stmt);
5681     stmt->u.R1227.pool = ffesta_output_pool;
5682     stmt->u.R1227.block = ffestw_stack_top ();
5683     stmt->u.R1227.expr = expr;
5684     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
5685   }
5686 #endif
5687
5688   if (ffestd_block_level_ == 0)
5689     ffestd_is_reachable_ = FALSE;
5690 }
5691
5692 /* ffestd_R1228 -- CONTAINS statement
5693
5694    ffestd_R1228();  */
5695
5696 #if FFESTR_F90
5697 void
5698 ffestd_R1228 ()
5699 {
5700   assert (ffestd_block_level_ == 0);
5701
5702   ffestd_check_simple_ ();
5703
5704   /* Generate RETURN/STOP code here */
5705
5706   ffestd_subr_labels_ (ffestw_state (ffestw_stack_top ())
5707                        == FFESTV_stateMODULE5); /* Handle any undefined
5708                                                    labels. */
5709
5710   ffestd_subr_f90_ ();
5711   return;
5712
5713 #ifdef FFESTD_F90
5714   fputs ("- CONTAINS\n", dmpout);
5715 #endif
5716 }
5717
5718 #endif
5719 /* ffestd_R1229_start -- STMTFUNCTION statement begin
5720
5721    ffestd_R1229_start(func_name,func_arg_list,close_paren);
5722
5723    This function does not really need to do anything, since _finish_
5724    gets all the info needed, and ffestc_R1229_start has already
5725    done all the stuff that makes a two-phase operation (start and
5726    finish) for handling statement functions necessary.
5727
5728    03-Jan-91  JCB  2.0
5729       Do nothing, now that _finish_ does everything.  */
5730
5731 void
5732 ffestd_R1229_start (ffelexToken name UNUSED, ffesttTokenList args UNUSED)
5733 {
5734   ffestd_check_start_ ();
5735
5736 #if FFECOM_targetCURRENT == FFECOM_targetFFE
5737 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
5738 #else
5739 #error
5740 #endif
5741 }
5742
5743 /* ffestd_R1229_finish -- STMTFUNCTION statement list complete
5744
5745    ffestd_R1229_finish(s);
5746
5747    The statement function's symbol is passed.  Its list of dummy args is
5748    accessed via ffesymbol_dummyargs and its expansion expression (expr)
5749    is accessed via ffesymbol_sfexpr.
5750
5751    If sfexpr is NULL, an error occurred parsing the expansion expression, so
5752    just cancel the effects of ffestd_R1229_start and pretend nothing
5753    happened.  Otherwise, install the expression as the expansion for the
5754    statement function, then clean up.
5755
5756    03-Jan-91  JCB  2.0
5757       Takes sfunc sym instead of just the expansion expression as an
5758       argument, so this function can do all the work, and _start_ is just
5759       a nicety than can do nothing in a back end.  */
5760
5761 void
5762 ffestd_R1229_finish (ffesymbol s)
5763 {
5764 #if FFECOM_targetCURRENT == FFECOM_targetFFE
5765   ffebld args = ffesymbol_dummyargs (s);
5766 #endif
5767   ffebld expr = ffesymbol_sfexpr (s);
5768
5769   ffestd_check_finish_ ();
5770
5771   if (expr == NULL)
5772     return;                     /* Nothing to do, definition didn't work. */
5773
5774 #if FFECOM_targetCURRENT == FFECOM_targetFFE
5775   fprintf (dmpout, "* stmtfunction %s(", ffesymbol_text (s));
5776   for (; args != NULL; args = ffebld_trail (args))
5777     fprintf (dmpout, "%s,", ffesymbol_text (ffebld_symter (ffebld_head (args))));
5778   fputs (")=", dmpout);
5779   ffebld_dump (expr);
5780   fputc ('\n', dmpout);
5781 #if 0                           /* Normally no need to preserve the
5782                                    expression. */
5783   ffesymbol_set_sfexpr (s, NULL);       /* Except expr.c sees NULL
5784                                            as recursive reference!
5785                                            So until we can use something
5786                                            convenient, like a "permanent"
5787                                            expression, don't worry about
5788                                            wasting some memory in the
5789                                            stand-alone FFE. */
5790 #else
5791   ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
5792 #endif
5793 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
5794   /* With gcc, cannot do anything here, because the backend hasn't even
5795      (necessarily) been notified that we're compiling a program unit! */
5796
5797 #if 0                           /* Must preserve the expression for gcc. */
5798   ffesymbol_set_sfexpr (s, NULL);
5799 #else
5800   ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
5801 #endif
5802 #else
5803 #error
5804 #endif
5805 }
5806
5807 /* ffestd_S3P4 -- INCLUDE line
5808
5809    ffestd_S3P4(filename,filename_token);
5810
5811    Make sure INCLUDE not preceded by any semicolons or a label def; implement.  */
5812
5813 void
5814 ffestd_S3P4 (ffebld filename)
5815 {
5816   FILE *fi;
5817   ffetargetCharacterDefault buildname;
5818   ffewhereFile wf;
5819
5820   ffestd_check_simple_ ();
5821
5822   assert (filename != NULL);
5823   if (ffebld_op (filename) != FFEBLD_opANY)
5824     {
5825       assert (ffebld_op (filename) == FFEBLD_opCONTER);
5826       assert (ffeinfo_basictype (ffebld_info (filename))
5827               == FFEINFO_basictypeCHARACTER);
5828       assert (ffeinfo_kindtype (ffebld_info (filename))
5829               == FFEINFO_kindtypeCHARACTERDEFAULT);
5830       buildname = ffebld_constant_characterdefault (ffebld_conter (filename));
5831       wf = ffewhere_file_new (ffetarget_text_characterdefault (buildname),
5832                               ffetarget_length_characterdefault (buildname));
5833       fi = ffecom_open_include (ffewhere_file_name (wf),
5834                                 ffelex_token_where_line (ffesta_tokens[0]),
5835                                 ffelex_token_where_column (ffesta_tokens[0]));
5836       if (fi == NULL)
5837         ffewhere_file_kill (wf);
5838       else
5839         ffelex_set_include (wf, (ffelex_token_type (ffesta_tokens[0])
5840                                  == FFELEX_typeNAME), fi);
5841     }
5842 }
5843
5844 /* ffestd_V003_start -- STRUCTURE statement list begin
5845
5846    ffestd_V003_start(structure_name);
5847
5848    Verify that STRUCTURE is valid here, and begin accepting items in the list.  */
5849
5850 #if FFESTR_VXT
5851 void
5852 ffestd_V003_start (ffelexToken structure_name)
5853 {
5854   ffestd_check_start_ ();
5855
5856 #if FFECOM_targetCURRENT == FFECOM_targetFFE
5857   if (structure_name == NULL)
5858     fputs ("* STRUCTURE_unnamed ", dmpout);
5859   else
5860     fprintf (dmpout, "* STRUCTURE %s ", ffelex_token_text (structure_name));
5861 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
5862   ffestd_subr_vxt_ ();
5863 #else
5864 #error
5865 #endif
5866 }
5867
5868 /* ffestd_V003_item -- STRUCTURE statement for object-name
5869
5870    ffestd_V003_item(name_token,dim_list);
5871
5872    Make sure name_token identifies a valid object to be STRUCTUREd.  */
5873
5874 void
5875 ffestd_V003_item (ffelexToken name, ffesttDimList dims)
5876 {
5877   ffestd_check_item_ ();
5878
5879 #if FFECOM_targetCURRENT == FFECOM_targetFFE
5880   fputs (ffelex_token_text (name), dmpout);
5881   if (dims != NULL)
5882     {
5883       fputc ('(', dmpout);
5884       ffestt_dimlist_dump (dims);
5885       fputc (')', dmpout);
5886     }
5887   fputc (',', dmpout);
5888 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
5889 #else
5890 #error
5891 #endif
5892 }
5893
5894 /* ffestd_V003_finish -- STRUCTURE statement list complete
5895
5896    ffestd_V003_finish();
5897
5898    Just wrap up any local activities.  */
5899
5900 void
5901 ffestd_V003_finish ()
5902 {
5903   ffestd_check_finish_ ();
5904
5905 #if FFECOM_targetCURRENT == FFECOM_targetFFE
5906   fputc ('\n', dmpout);
5907 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
5908 #else
5909 #error
5910 #endif
5911 }
5912
5913 /* ffestd_V004 -- End a STRUCTURE
5914
5915    ffestd_V004(TRUE);  */
5916
5917 void
5918 ffestd_V004 (bool ok)
5919 {
5920 #if FFECOM_targetCURRENT == FFECOM_targetFFE
5921   fputs ("* END_STRUCTURE\n", dmpout);
5922 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
5923 #else
5924 #error
5925 #endif
5926 }
5927
5928 /* ffestd_V009 -- UNION statement
5929
5930    ffestd_V009();  */
5931
5932 void
5933 ffestd_V009 ()
5934 {
5935   ffestd_check_simple_ ();
5936
5937 #if FFECOM_targetCURRENT == FFECOM_targetFFE
5938   fputs ("* UNION\n", dmpout);
5939 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
5940 #else
5941 #error
5942 #endif
5943 }
5944
5945 /* ffestd_V010 -- End a UNION
5946
5947    ffestd_V010(TRUE);  */
5948
5949 void
5950 ffestd_V010 (bool ok)
5951 {
5952 #if FFECOM_targetCURRENT == FFECOM_targetFFE
5953   fputs ("* END_UNION\n", dmpout);
5954 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
5955 #else
5956 #error
5957 #endif
5958 }
5959
5960 /* ffestd_V012 -- MAP statement
5961
5962    ffestd_V012();  */
5963
5964 void
5965 ffestd_V012 ()
5966 {
5967   ffestd_check_simple_ ();
5968
5969 #if FFECOM_targetCURRENT == FFECOM_targetFFE
5970   fputs ("* MAP\n", dmpout);
5971 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
5972 #else
5973 #error
5974 #endif
5975 }
5976
5977 /* ffestd_V013 -- End a MAP
5978
5979    ffestd_V013(TRUE);  */
5980
5981 void
5982 ffestd_V013 (bool ok)
5983 {
5984 #if FFECOM_targetCURRENT == FFECOM_targetFFE
5985   fputs ("* END_MAP\n", dmpout);
5986 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
5987 #else
5988 #error
5989 #endif
5990 }
5991
5992 #endif
5993 /* ffestd_V014_start -- VOLATILE statement list begin
5994
5995    ffestd_V014_start();
5996
5997    Verify that VOLATILE is valid here, and begin accepting items in the list.  */
5998
5999 void
6000 ffestd_V014_start ()
6001 {
6002   ffestd_check_start_ ();
6003
6004 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6005   fputs ("* VOLATILE (", dmpout);
6006 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
6007   ffestd_subr_vxt_ ();
6008 #else
6009 #error
6010 #endif
6011 }
6012
6013 /* ffestd_V014_item_object -- VOLATILE statement for object-name
6014
6015    ffestd_V014_item_object(name_token);
6016
6017    Make sure name_token identifies a valid object to be VOLATILEd.  */
6018
6019 void
6020 ffestd_V014_item_object (ffelexToken name UNUSED)
6021 {
6022   ffestd_check_item_ ();
6023
6024 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6025   fprintf (dmpout, "%s,", ffelex_token_text (name));
6026 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
6027 #else
6028 #error
6029 #endif
6030 }
6031
6032 /* ffestd_V014_item_cblock -- VOLATILE statement for common-block-name
6033
6034    ffestd_V014_item_cblock(name_token);
6035
6036    Make sure name_token identifies a valid common block to be VOLATILEd.  */
6037
6038 void
6039 ffestd_V014_item_cblock (ffelexToken name UNUSED)
6040 {
6041   ffestd_check_item_ ();
6042
6043 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6044   fprintf (dmpout, "/%s/,", ffelex_token_text (name));
6045 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
6046 #else
6047 #error
6048 #endif
6049 }
6050
6051 /* ffestd_V014_finish -- VOLATILE statement list complete
6052
6053    ffestd_V014_finish();
6054
6055    Just wrap up any local activities.  */
6056
6057 void
6058 ffestd_V014_finish ()
6059 {
6060   ffestd_check_finish_ ();
6061
6062 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6063   fputs (")\n", dmpout);
6064 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
6065 #else
6066 #error
6067 #endif
6068 }
6069
6070 /* ffestd_V016_start -- RECORD statement list begin
6071
6072    ffestd_V016_start();
6073
6074    Verify that RECORD is valid here, and begin accepting items in the list.  */
6075
6076 #if FFESTR_VXT
6077 void
6078 ffestd_V016_start ()
6079 {
6080   ffestd_check_start_ ();
6081
6082 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6083   fputs ("* RECORD ", dmpout);
6084 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
6085   ffestd_subr_vxt_ ();
6086 #else
6087 #error
6088 #endif
6089 }
6090
6091 /* ffestd_V016_item_structure -- RECORD statement for common-block-name
6092
6093    ffestd_V016_item_structure(name_token);
6094
6095    Make sure name_token identifies a valid structure to be RECORDed.  */
6096
6097 void
6098 ffestd_V016_item_structure (ffelexToken name)
6099 {
6100   ffestd_check_item_ ();
6101
6102 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6103   fprintf (dmpout, "/%s/,", ffelex_token_text (name));
6104 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
6105 #else
6106 #error
6107 #endif
6108 }
6109
6110 /* ffestd_V016_item_object -- RECORD statement for object-name
6111
6112    ffestd_V016_item_object(name_token,dim_list);
6113
6114    Make sure name_token identifies a valid object to be RECORDd.  */
6115
6116 void
6117 ffestd_V016_item_object (ffelexToken name, ffesttDimList dims)
6118 {
6119   ffestd_check_item_ ();
6120
6121 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6122   fputs (ffelex_token_text (name), dmpout);
6123   if (dims != NULL)
6124     {
6125       fputc ('(', dmpout);
6126       ffestt_dimlist_dump (dims);
6127       fputc (')', dmpout);
6128     }
6129   fputc (',', dmpout);
6130 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
6131 #else
6132 #error
6133 #endif
6134 }
6135
6136 /* ffestd_V016_finish -- RECORD statement list complete
6137
6138    ffestd_V016_finish();
6139
6140    Just wrap up any local activities.  */
6141
6142 void
6143 ffestd_V016_finish ()
6144 {
6145   ffestd_check_finish_ ();
6146
6147 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6148   fputc ('\n', dmpout);
6149 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
6150 #else
6151 #error
6152 #endif
6153 }
6154
6155 /* ffestd_V018_start -- REWRITE(...) statement list begin
6156
6157    ffestd_V018_start();
6158
6159    Verify that REWRITE is valid here, and begin accepting items in the
6160    list.  */
6161
6162 void
6163 ffestd_V018_start (ffestvFormat format)
6164 {
6165   ffestd_check_start_ ();
6166
6167 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6168
6169 #if FFECOM_ONEPASS
6170   ffestd_subr_line_now_ ();
6171   ffeste_V018_start (&ffestp_file.rewrite, format);
6172 #else
6173   {
6174     ffestdStmt_ stmt;
6175
6176     stmt = ffestd_stmt_new_ (FFESTD_stmtidV018_);
6177     ffestd_stmt_append_ (stmt);
6178     ffestd_subr_line_save_ (stmt);
6179     stmt->u.V018.pool = ffesta_output_pool;
6180     stmt->u.V018.params = ffestd_subr_copy_rewrite_ ();
6181     stmt->u.V018.format = format;
6182     stmt->u.V018.list = NULL;
6183     ffestd_expr_list_ = &stmt->u.V018.list;
6184     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
6185   }
6186 #endif
6187
6188 #endif
6189 #if FFECOM_targetCURRENT == FFECOM_targetGCC
6190   ffestd_subr_vxt_ ();
6191 #endif
6192 }
6193
6194 /* ffestd_V018_item -- REWRITE statement i/o item
6195
6196    ffestd_V018_item(expr,expr_token);
6197
6198    Implement output-list expression.  */
6199
6200 void
6201 ffestd_V018_item (ffebld expr)
6202 {
6203   ffestd_check_item_ ();
6204
6205 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6206
6207 #if FFECOM_ONEPASS
6208   ffeste_V018_item (expr);
6209 #else
6210   {
6211     ffestdExprItem_ item
6212     = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
6213                                        sizeof (*item));
6214
6215     item->next = NULL;
6216     item->expr = expr;
6217     *ffestd_expr_list_ = item;
6218     ffestd_expr_list_ = &item->next;
6219   }
6220 #endif
6221
6222 #endif
6223 #if FFECOM_targetCURRENT == FFECOM_targetGCC
6224 #endif
6225 }
6226
6227 /* ffestd_V018_finish -- REWRITE statement list complete
6228
6229    ffestd_V018_finish();
6230
6231    Just wrap up any local activities.  */
6232
6233 void
6234 ffestd_V018_finish ()
6235 {
6236   ffestd_check_finish_ ();
6237
6238 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6239
6240 #if FFECOM_ONEPASS
6241   ffeste_V018_finish ();
6242 #else
6243   /* Nothing to do, it's implicit. */
6244 #endif
6245
6246 #endif
6247 #if FFECOM_targetCURRENT == FFECOM_targetGCC
6248 #endif
6249 }
6250
6251 /* ffestd_V019_start -- ACCEPT statement list begin
6252
6253    ffestd_V019_start();
6254
6255    Verify that ACCEPT is valid here, and begin accepting items in the
6256    list.  */
6257
6258 void
6259 ffestd_V019_start (ffestvFormat format)
6260 {
6261   ffestd_check_start_ ();
6262
6263 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6264
6265 #if FFECOM_ONEPASS
6266   ffestd_subr_line_now_ ();
6267   ffeste_V019_start (&ffestp_file.accept, format);
6268 #else
6269   {
6270     ffestdStmt_ stmt;
6271
6272     stmt = ffestd_stmt_new_ (FFESTD_stmtidV019_);
6273     ffestd_stmt_append_ (stmt);
6274     ffestd_subr_line_save_ (stmt);
6275     stmt->u.V019.pool = ffesta_output_pool;
6276     stmt->u.V019.params = ffestd_subr_copy_accept_ ();
6277     stmt->u.V019.format = format;
6278     stmt->u.V019.list = NULL;
6279     ffestd_expr_list_ = &stmt->u.V019.list;
6280     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
6281   }
6282 #endif
6283
6284 #endif
6285 #if FFECOM_targetCURRENT == FFECOM_targetGCC
6286   ffestd_subr_vxt_ ();
6287 #endif
6288 }
6289
6290 /* ffestd_V019_item -- ACCEPT statement i/o item
6291
6292    ffestd_V019_item(expr,expr_token);
6293
6294    Implement output-list expression.  */
6295
6296 void
6297 ffestd_V019_item (ffebld expr)
6298 {
6299   ffestd_check_item_ ();
6300
6301 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6302
6303 #if FFECOM_ONEPASS
6304   ffeste_V019_item (expr);
6305 #else
6306   {
6307     ffestdExprItem_ item
6308     = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
6309                                        sizeof (*item));
6310
6311     item->next = NULL;
6312     item->expr = expr;
6313     *ffestd_expr_list_ = item;
6314     ffestd_expr_list_ = &item->next;
6315   }
6316 #endif
6317
6318 #endif
6319 #if FFECOM_targetCURRENT == FFECOM_targetGCC
6320 #endif
6321 }
6322
6323 /* ffestd_V019_finish -- ACCEPT statement list complete
6324
6325    ffestd_V019_finish();
6326
6327    Just wrap up any local activities.  */
6328
6329 void
6330 ffestd_V019_finish ()
6331 {
6332   ffestd_check_finish_ ();
6333
6334 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6335
6336 #if FFECOM_ONEPASS
6337   ffeste_V019_finish ();
6338 #else
6339   /* Nothing to do, it's implicit. */
6340 #endif
6341
6342 #endif
6343 #if FFECOM_targetCURRENT == FFECOM_targetGCC
6344 #endif
6345 }
6346
6347 #endif
6348 /* ffestd_V020_start -- TYPE statement list begin
6349
6350    ffestd_V020_start();
6351
6352    Verify that TYPE is valid here, and begin accepting items in the
6353    list.  */
6354
6355 void
6356 ffestd_V020_start (ffestvFormat format UNUSED)
6357 {
6358   ffestd_check_start_ ();
6359
6360 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6361
6362 #if FFECOM_ONEPASS
6363   ffestd_subr_line_now_ ();
6364   ffeste_V020_start (&ffestp_file.type, format);
6365 #else
6366   {
6367     ffestdStmt_ stmt;
6368
6369     stmt = ffestd_stmt_new_ (FFESTD_stmtidV020_);
6370     ffestd_stmt_append_ (stmt);
6371     ffestd_subr_line_save_ (stmt);
6372     stmt->u.V020.pool = ffesta_output_pool;
6373     stmt->u.V020.params = ffestd_subr_copy_type_ ();
6374     stmt->u.V020.format = format;
6375     stmt->u.V020.list = NULL;
6376     ffestd_expr_list_ = &stmt->u.V020.list;
6377     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
6378   }
6379 #endif
6380
6381 #endif
6382 #if FFECOM_targetCURRENT == FFECOM_targetGCC
6383   ffestd_subr_vxt_ ();
6384 #endif
6385 }
6386
6387 /* ffestd_V020_item -- TYPE statement i/o item
6388
6389    ffestd_V020_item(expr,expr_token);
6390
6391    Implement output-list expression.  */
6392
6393 void
6394 ffestd_V020_item (ffebld expr UNUSED)
6395 {
6396   ffestd_check_item_ ();
6397
6398 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6399
6400 #if FFECOM_ONEPASS
6401   ffeste_V020_item (expr);
6402 #else
6403   {
6404     ffestdExprItem_ item
6405     = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
6406                                        sizeof (*item));
6407
6408     item->next = NULL;
6409     item->expr = expr;
6410     *ffestd_expr_list_ = item;
6411     ffestd_expr_list_ = &item->next;
6412   }
6413 #endif
6414
6415 #endif
6416 #if FFECOM_targetCURRENT == FFECOM_targetGCC
6417 #endif
6418 }
6419
6420 /* ffestd_V020_finish -- TYPE statement list complete
6421
6422    ffestd_V020_finish();
6423
6424    Just wrap up any local activities.  */
6425
6426 void
6427 ffestd_V020_finish ()
6428 {
6429   ffestd_check_finish_ ();
6430
6431 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6432
6433 #if FFECOM_ONEPASS
6434   ffeste_V020_finish ();
6435 #else
6436   /* Nothing to do, it's implicit. */
6437 #endif
6438
6439 #endif
6440 #if FFECOM_targetCURRENT == FFECOM_targetGCC
6441 #endif
6442 }
6443
6444 /* ffestd_V021 -- DELETE statement
6445
6446    ffestd_V021();
6447
6448    Make sure a DELETE is valid in the current context, and implement it.  */
6449
6450 #if FFESTR_VXT
6451 void
6452 ffestd_V021 ()
6453 {
6454   ffestd_check_simple_ ();
6455
6456 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6457
6458 #if FFECOM_ONEPASS
6459   ffestd_subr_line_now_ ();
6460   ffeste_V021 (&ffestp_file.delete);
6461 #else
6462   {
6463     ffestdStmt_ stmt;
6464
6465     stmt = ffestd_stmt_new_ (FFESTD_stmtidV021_);
6466     ffestd_stmt_append_ (stmt);
6467     ffestd_subr_line_save_ (stmt);
6468     stmt->u.V021.pool = ffesta_output_pool;
6469     stmt->u.V021.params = ffestd_subr_copy_delete_ ();
6470     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
6471   }
6472 #endif
6473
6474 #endif
6475 #if FFECOM_targetCURRENT == FFECOM_targetGCC
6476   ffestd_subr_vxt_ ();
6477 #endif
6478 }
6479
6480 /* ffestd_V022 -- UNLOCK statement
6481
6482    ffestd_V022();
6483
6484    Make sure a UNLOCK is valid in the current context, and implement it.  */
6485
6486 void
6487 ffestd_V022 ()
6488 {
6489   ffestd_check_simple_ ();
6490
6491 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6492
6493 #if FFECOM_ONEPASS
6494   ffestd_subr_line_now_ ();
6495   ffeste_V022 (&ffestp_file.beru);
6496 #else
6497   {
6498     ffestdStmt_ stmt;
6499
6500     stmt = ffestd_stmt_new_ (FFESTD_stmtidV022_);
6501     ffestd_stmt_append_ (stmt);
6502     ffestd_subr_line_save_ (stmt);
6503     stmt->u.V022.pool = ffesta_output_pool;
6504     stmt->u.V022.params = ffestd_subr_copy_beru_ ();
6505     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
6506   }
6507 #endif
6508
6509 #endif
6510 #if FFECOM_targetCURRENT == FFECOM_targetGCC
6511   ffestd_subr_vxt_ ();
6512 #endif
6513 }
6514
6515 /* ffestd_V023_start -- ENCODE(...) statement list begin
6516
6517    ffestd_V023_start();
6518
6519    Verify that ENCODE is valid here, and begin accepting items in the
6520    list.  */
6521
6522 void
6523 ffestd_V023_start ()
6524 {
6525   ffestd_check_start_ ();
6526
6527 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6528
6529 #if FFECOM_ONEPASS
6530   ffestd_subr_line_now_ ();
6531   ffeste_V023_start (&ffestp_file.vxtcode);
6532 #else
6533   {
6534     ffestdStmt_ stmt;
6535
6536     stmt = ffestd_stmt_new_ (FFESTD_stmtidV023_);
6537     ffestd_stmt_append_ (stmt);
6538     ffestd_subr_line_save_ (stmt);
6539     stmt->u.V023.pool = ffesta_output_pool;
6540     stmt->u.V023.params = ffestd_subr_copy_vxtcode_ ();
6541     stmt->u.V023.list = NULL;
6542     ffestd_expr_list_ = &stmt->u.V023.list;
6543     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
6544   }
6545 #endif
6546
6547 #endif
6548 #if FFECOM_targetCURRENT == FFECOM_targetGCC
6549   ffestd_subr_vxt_ ();
6550 #endif
6551 }
6552
6553 /* ffestd_V023_item -- ENCODE statement i/o item
6554
6555    ffestd_V023_item(expr,expr_token);
6556
6557    Implement output-list expression.  */
6558
6559 void
6560 ffestd_V023_item (ffebld expr)
6561 {
6562   ffestd_check_item_ ();
6563
6564 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6565
6566 #if FFECOM_ONEPASS
6567   ffeste_V023_item (expr);
6568 #else
6569   {
6570     ffestdExprItem_ item
6571     = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
6572                                        sizeof (*item));
6573
6574     item->next = NULL;
6575     item->expr = expr;
6576     *ffestd_expr_list_ = item;
6577     ffestd_expr_list_ = &item->next;
6578   }
6579 #endif
6580
6581 #endif
6582 #if FFECOM_targetCURRENT == FFECOM_targetGCC
6583 #endif
6584 }
6585
6586 /* ffestd_V023_finish -- ENCODE statement list complete
6587
6588    ffestd_V023_finish();
6589
6590    Just wrap up any local activities.  */
6591
6592 void
6593 ffestd_V023_finish ()
6594 {
6595   ffestd_check_finish_ ();
6596
6597 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6598
6599 #if FFECOM_ONEPASS
6600   ffeste_V023_finish ();
6601 #else
6602   /* Nothing to do, it's implicit. */
6603 #endif
6604
6605 #endif
6606 #if FFECOM_targetCURRENT == FFECOM_targetGCC
6607 #endif
6608 }
6609
6610 /* ffestd_V024_start -- DECODE(...) statement list begin
6611
6612    ffestd_V024_start();
6613
6614    Verify that DECODE is valid here, and begin accepting items in the
6615    list.  */
6616
6617 void
6618 ffestd_V024_start ()
6619 {
6620   ffestd_check_start_ ();
6621
6622 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6623
6624 #if FFECOM_ONEPASS
6625   ffestd_subr_line_now_ ();
6626   ffeste_V024_start (&ffestp_file.vxtcode);
6627 #else
6628   {
6629     ffestdStmt_ stmt;
6630
6631     stmt = ffestd_stmt_new_ (FFESTD_stmtidV024_);
6632     ffestd_stmt_append_ (stmt);
6633     ffestd_subr_line_save_ (stmt);
6634     stmt->u.V024.pool = ffesta_output_pool;
6635     stmt->u.V024.params = ffestd_subr_copy_vxtcode_ ();
6636     stmt->u.V024.list = NULL;
6637     ffestd_expr_list_ = &stmt->u.V024.list;
6638     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
6639   }
6640 #endif
6641
6642 #endif
6643 #if FFECOM_targetCURRENT == FFECOM_targetGCC
6644   ffestd_subr_vxt_ ();
6645 #endif
6646 }
6647
6648 /* ffestd_V024_item -- DECODE statement i/o item
6649
6650    ffestd_V024_item(expr,expr_token);
6651
6652    Implement output-list expression.  */
6653
6654 void
6655 ffestd_V024_item (ffebld expr)
6656 {
6657   ffestd_check_item_ ();
6658
6659 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6660
6661 #if FFECOM_ONEPASS
6662   ffeste_V024_item (expr);
6663 #else
6664   {
6665     ffestdExprItem_ item
6666     = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
6667                                        sizeof (*item));
6668
6669     item->next = NULL;
6670     item->expr = expr;
6671     *ffestd_expr_list_ = item;
6672     ffestd_expr_list_ = &item->next;
6673   }
6674 #endif
6675
6676 #endif
6677 #if FFECOM_targetCURRENT == FFECOM_targetGCC
6678 #endif
6679 }
6680
6681 /* ffestd_V024_finish -- DECODE statement list complete
6682
6683    ffestd_V024_finish();
6684
6685    Just wrap up any local activities.  */
6686
6687 void
6688 ffestd_V024_finish ()
6689 {
6690   ffestd_check_finish_ ();
6691
6692 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6693
6694 #if FFECOM_ONEPASS
6695   ffeste_V024_finish ();
6696 #else
6697   /* Nothing to do, it's implicit. */
6698 #endif
6699
6700 #endif
6701 #if FFECOM_targetCURRENT == FFECOM_targetGCC
6702 #endif
6703 }
6704
6705 /* ffestd_V025_start -- DEFINEFILE statement list begin
6706
6707    ffestd_V025_start();
6708
6709    Verify that DEFINEFILE is valid here, and begin accepting items in the
6710    list.  */
6711
6712 void
6713 ffestd_V025_start ()
6714 {
6715   ffestd_check_start_ ();
6716
6717 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6718
6719 #if FFECOM_ONEPASS
6720   ffestd_subr_line_now_ ();
6721   ffeste_V025_start ();
6722 #else
6723   {
6724     ffestdStmt_ stmt;
6725
6726     stmt = ffestd_stmt_new_ (FFESTD_stmtidV025start_);
6727     ffestd_stmt_append_ (stmt);
6728     ffestd_subr_line_save_ (stmt);
6729     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
6730   }
6731 #endif
6732
6733 #endif
6734 #if FFECOM_targetCURRENT == FFECOM_targetGCC
6735   ffestd_subr_vxt_ ();
6736 #endif
6737 }
6738
6739 /* ffestd_V025_item -- DEFINE FILE statement item
6740
6741    ffestd_V025_item(u,ut,m,mt,n,nt,asv,asvt);
6742
6743    Implement item.  Treat each item kind of like a separate statement,
6744    since there's really no need to treat them as an aggregate.  */
6745
6746 void
6747 ffestd_V025_item (ffebld u, ffebld m, ffebld n, ffebld asv)
6748 {
6749   ffestd_check_item_ ();
6750
6751 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6752
6753 #if FFECOM_ONEPASS
6754   ffeste_V025_item (u, m, n, asv);
6755 #else
6756   {
6757     ffestdStmt_ stmt;
6758
6759     stmt = ffestd_stmt_new_ (FFESTD_stmtidV025item_);
6760     ffestd_stmt_append_ (stmt);
6761     stmt->u.V025item.u = u;
6762     stmt->u.V025item.m = m;
6763     stmt->u.V025item.n = n;
6764     stmt->u.V025item.asv = asv;
6765   }
6766 #endif
6767
6768 #endif
6769 #if FFECOM_targetCURRENT == FFECOM_targetGCC
6770 #endif
6771 }
6772
6773 /* ffestd_V025_finish -- DEFINE FILE statement list complete
6774
6775    ffestd_V025_finish();
6776
6777    Just wrap up any local activities.  */
6778
6779 void
6780 ffestd_V025_finish ()
6781 {
6782   ffestd_check_finish_ ();
6783
6784 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6785
6786 #if FFECOM_ONEPASS
6787   ffeste_V025_finish ();
6788 #else
6789   {
6790     ffestdStmt_ stmt;
6791
6792     stmt = ffestd_stmt_new_ (FFESTD_stmtidV025finish_);
6793     stmt->u.V025finish.pool = ffesta_output_pool;
6794     ffestd_stmt_append_ (stmt);
6795   }
6796 #endif
6797
6798 #endif
6799 #if FFECOM_targetCURRENT == FFECOM_targetGCC
6800 #endif
6801 }
6802
6803 /* ffestd_V026 -- FIND statement
6804
6805    ffestd_V026();
6806
6807    Make sure a FIND is valid in the current context, and implement it.  */
6808
6809 void
6810 ffestd_V026 ()
6811 {
6812   ffestd_check_simple_ ();
6813
6814 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6815
6816 #if FFECOM_ONEPASS
6817   ffestd_subr_line_now_ ();
6818   ffeste_V026 (&ffestp_file.find);
6819 #else
6820   {
6821     ffestdStmt_ stmt;
6822
6823     stmt = ffestd_stmt_new_ (FFESTD_stmtidV026_);
6824     ffestd_stmt_append_ (stmt);
6825     ffestd_subr_line_save_ (stmt);
6826     stmt->u.V026.pool = ffesta_output_pool;
6827     stmt->u.V026.params = ffestd_subr_copy_find_ ();
6828     ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
6829   }
6830 #endif
6831
6832 #endif
6833 #if FFECOM_targetCURRENT == FFECOM_targetGCC
6834   ffestd_subr_vxt_ ();
6835 #endif
6836 }
6837
6838 #endif
6839 /* ffestd_V027_start -- VXT PARAMETER statement list begin
6840
6841    ffestd_V027_start();
6842
6843    Verify that PARAMETER is valid here, and begin accepting items in the list.  */
6844
6845 void
6846 ffestd_V027_start ()
6847 {
6848   ffestd_check_start_ ();
6849
6850 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6851   fputs ("* PARAMETER_vxt ", dmpout);
6852 #else
6853 #if FFECOM_targetCURRENT == FFECOM_targetGCC
6854   ffestd_subr_vxt_ ();
6855 #endif
6856 #endif
6857 }
6858
6859 /* ffestd_V027_item -- VXT PARAMETER statement assignment
6860
6861    ffestd_V027_item(dest,dest_token,source,source_token);
6862
6863    Make sure the source is a valid source for the destination; make the
6864    assignment.  */
6865
6866 void
6867 ffestd_V027_item (ffelexToken dest_token UNUSED, ffebld source UNUSED)
6868 {
6869   ffestd_check_item_ ();
6870
6871 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6872   fputs (ffelex_token_text (dest_token), dmpout);
6873   fputc ('=', dmpout);
6874   ffebld_dump (source);
6875   fputc (',', dmpout);
6876 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
6877 #else
6878 #error
6879 #endif
6880 }
6881
6882 /* ffestd_V027_finish -- VXT PARAMETER statement list complete
6883
6884    ffestd_V027_finish();
6885
6886    Just wrap up any local activities.  */
6887
6888 void
6889 ffestd_V027_finish ()
6890 {
6891   ffestd_check_finish_ ();
6892
6893 #if FFECOM_targetCURRENT == FFECOM_targetFFE
6894   fputc ('\n', dmpout);
6895 #elif FFECOM_targetCURRENT == FFECOM_targetGCC
6896 #else
6897 #error
6898 #endif
6899 }
6900
6901 /* Any executable statement.  */
6902
6903 void
6904 ffestd_any ()
6905 {
6906   ffestd_check_simple_ ();
6907
6908 #if FFECOM_ONEPASS
6909   ffestd_subr_line_now_ ();
6910   ffeste_R841 ();
6911 #else
6912   {
6913     ffestdStmt_ stmt;
6914
6915     stmt = ffestd_stmt_new_ (FFESTD_stmtidR841_);
6916     ffestd_stmt_append_ (stmt);
6917     ffestd_subr_line_save_ (stmt);
6918   }
6919 #endif
6920 }