gcc/f/std.c

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