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