rewrite to use block/scope structure of GBE
From-SVN: r26515
This commit is contained in:
Craig Burley
Craig Burley
parent
fc5045f3a7
commit
c7e4ee3a6d
109
gcc/f/ChangeLog
109
gcc/f/ChangeLog
@ -1,3 +1,112 @@
|
||||
Sat Apr 17 13:53:43 1999 Craig Burley <craig@jcb-sc.com>
|
||||
|
||||
Rewrite to use block/scope structure of GBE and to ensure
|
||||
variables (especially those going on stack/reg) are declared
|
||||
before executable code generated:
|
||||
* bld.c (ffebld_new_item, ffebld_new_one, ffebld_new_two):
|
||||
Support new hooks.
|
||||
* bld.h (ffebld_item_hook, ffebld_item_set_hook,
|
||||
ffebld_nonter_hook, ffebld_nonter_set_hook): Ditto.
|
||||
* bld.h (ffebld_basictype, ffebld_kind, ffebld_kindtype,
|
||||
ffebld_rank, ffebld_where): New convenience macros (used
|
||||
by rest of this patch).
|
||||
* com.c, com.h (ffecom_push_calltemps, ffecom_pop_calltemps,
|
||||
ffecom_push_tempvar, ffecom_pop_tempvar): Remove temp-var-
|
||||
handling mechanism.
|
||||
* com.c (ffecom_call_, ffecom_call_binop_, ffecom_tree_divide_,
|
||||
ffecom_call_gfrt): Support passing hooks for temp-var info.
|
||||
(ffecom_expr_power_integer_): Takes opPOWER expression, instead
|
||||
of its left and right operands, so it can get at the hook.
|
||||
(ffecom_prepare_let_char_, ffecom_prepare_arg_ptr_to_expr,
|
||||
ffecom_prepare_end, ffecom_prepare_expr_, ffecom_prepare_expr_rw,
|
||||
ffecom_prepare_expr_w, ffecom_prepare_return_expr,
|
||||
ffecom_prepare_ptr_to_expr): New functions supporting expression
|
||||
pre-scanning.
|
||||
(bison_rule_compstmt_): Return the tree, as in the CFE.
|
||||
(delete_block): New function, from CFE.
|
||||
(kept_level_p): New function, from CFE, modified.
|
||||
(ffecom_start_compstmt, ffecom_end_compstmt): New functions,
|
||||
replacing ffecom_start_compstmt_ and ffecom_end_compstmt_ macros,
|
||||
and they do real work.
|
||||
(struct binding_level): Add prep_state member. Initialize to 0.
|
||||
(ffecom_get_invented_identifier): Now takes either or both a
|
||||
string and an integer, using -1 to denote no integer.
|
||||
(ffecom_do_entry_): Disallow temp-var generation via expressions
|
||||
in body of function, since the exprs aren't prescanned.
|
||||
(ffecom_expr_rw): Now takes destination tree.
|
||||
(ffecom_expr_w): New function, now used in some places
|
||||
ffecom_expr_rw had been used.
|
||||
(ffecom_expr_intrinsic_): Move huge f2c-related comment to bottom
|
||||
of source file, to avoid annoying problems editing com.c using
|
||||
Emacs C-mode.
|
||||
(ffecom_expr_power_integer_): Make a temp var for division, if
|
||||
necessary.
|
||||
Handle expanded statement expression as does CFE.
|
||||
(ffecom_start_progunit_): Disallow temp-var generation in body
|
||||
of function, since expressions are not prescanned at this level.
|
||||
(ffecom_sym_transform_): Transform ASSIGN variables as well,
|
||||
so these are all transformed up front, before code-generation
|
||||
begins.
|
||||
(ffecom_arg_ptr_to_const_expr, ffecom_const_expr,
|
||||
ffecom_ptr_to_const_expr): New functions to transform expressions
|
||||
only if the results will surely be constants.
|
||||
(ffecom_arg_ptr_to_expr): Precompute size, for convenience
|
||||
obtaining temp vars.
|
||||
(ffecom_expand_let_stmt): Guess at usability of destination
|
||||
pre-expansion, to provide better prescan preparation (fewer
|
||||
spurious temp vars).
|
||||
(ffecom_init_0): Disallow temp-var generation in global scope.
|
||||
(ffecom_type_expr): New function, returns just the type tree
|
||||
for the expression.
|
||||
(start_function): Disallow temp-var generation in parm scope.
|
||||
(incomplete_type_error): Fix introductory comment.
|
||||
(poplevel): Update (somewhat) from CFE.
|
||||
(pushlevel): Update (somewhat) from CFE.
|
||||
* stc.c (ffestc_R838): Mark ASSIGNed variable as so.
|
||||
* std.c (ffestd_stmt_pass_, ffestd_R803, ffestd_R804, ffestd_R805,
|
||||
ffestd_R806): Remember and pass through the ffestw block info
|
||||
for these (IFTHEN, ELSEIF, ELSE, and ENDIF) statements.
|
||||
* ste.c (ffeste_end_iterdo_): Now takes ffestw block argument.
|
||||
(ffeste_io_inlist_): Add prototype.
|
||||
(ffeste_f2c_*): Macros rewritten, new ones added.
|
||||
(ffeste_start_block_, ffeste_end_block_, ffeste_start_stmt_,
|
||||
ffeste_end_stmt_): New macros/functions, depending on whether
|
||||
checking is enabled, to keep track of symmetry of other ste.c code.
|
||||
(ffeste_begin_iterdo_, ffeste_end_iterdo_, ffeste_io_impdo_,
|
||||
ffeste_io_dofio_, ffeste_io_dolio_, ffeste_io_douio_,
|
||||
ffeste_io_ialist_, ffeste_io_cilist_, ffeste_io_cllist_,
|
||||
ffeste_icilist_, ffeste_io_inlist_, ffeste_io_olist_,
|
||||
ffeste_subr_beru_, ffeste_do, ffeste_end_R807, ffeste_R737A,
|
||||
ffeste_R803, ffeste_R804, ffeste_R805, ffeste_R806, ffeste_R807,
|
||||
ffeste_R809, ffeste_R810, ffeste_R811, ffeste_R819A, ffeste_R819B,
|
||||
ffeste_R837, ffeste_R838, ffeste_R839, ffeste_R840, ffeste_R904,
|
||||
ffeste_R907, ffeste_R909_start, ffeste_R909_item, ffeste_R909_finish,
|
||||
ffeste_R910_start, ffeste_R910_item, ffeste_R910_finish,
|
||||
ffeste_R911_start, ffeste_R911_item, ffeste_R911_finish,
|
||||
ffeste_R923A, ffeste_R1212, ffeste_R1227): Prescan/prepare
|
||||
all pertinent expressions, update to new com.c interface, etc.
|
||||
(ffeste_io_impdo_): Relocate.
|
||||
(ffeste_R834, ffeste_R835, ffeste_R836, ffeste_R1226): Don't
|
||||
bother calling clear_momentary, nothing was generated.
|
||||
(ffeste_R842, ffeste_R843): Update to new com.c interface.
|
||||
(ffeste_R1226): Don't try to stuff error_mark_node's DECL_INITIAL.
|
||||
(ffeste_terminate_2): When checking enabled, make sure all blocks
|
||||
and statements have been ended.
|
||||
* ste.h (ffeste_R803, ffeste_R804, ffeste_R805, ffeste_R806):
|
||||
These now take ffestw block argument.
|
||||
(ffeste_terminate_2): When checking enabled, it's a function, not
|
||||
a macro.
|
||||
* stw.h (struct _ffestw_): New variable for IFTHEN.
|
||||
(ffestw_ifthen_fake_else, ffestw_set_ifthen_fake_else): New
|
||||
accessor macros.
|
||||
* symbol.c, symbol.h: Support new ASSIGN'ed-to info.
|
||||
|
||||
* com.c: Clean up commentary per GNU coding standards.
|
||||
|
||||
* bld.h (ffebld_size, ffebld_size_known): Canonize.
|
||||
|
||||
* version.c: Bump version.
|
||||
|
||||
Sun Apr 11 21:33:33 1999 Mumit Khan <khan@xraylith.wisc.edu>
|
||||
|
||||
* g77spec.c (lang_specific_driver): Check whether MATH_LIBRARY is
|
||||
|
||||
@ -5573,6 +5573,9 @@ ffebld_new_item (ffebld head, ffebld trail)
|
||||
x->op = FFEBLD_opITEM;
|
||||
x->u.item.head = head;
|
||||
x->u.item.trail = trail;
|
||||
#ifdef FFECOM_itemHOOK
|
||||
x->u.item.hook = FFECOM_itemNULL;
|
||||
#endif
|
||||
return x;
|
||||
}
|
||||
|
||||
@ -5655,6 +5658,9 @@ ffebld_new_one (ffebldOp o, ffebld left)
|
||||
#endif
|
||||
x->op = o;
|
||||
x->u.nonter.left = left;
|
||||
#ifdef FFECOM_nonterHOOK
|
||||
x->u.nonter.hook = FFECOM_nonterNULL;
|
||||
#endif
|
||||
return x;
|
||||
}
|
||||
|
||||
@ -5703,6 +5709,9 @@ ffebld_new_two (ffebldOp o, ffebld left, ffebld right)
|
||||
x->op = o;
|
||||
x->u.nonter.left = left;
|
||||
x->u.nonter.right = right;
|
||||
#ifdef FFECOM_nonterHOOK
|
||||
x->u.nonter.hook = FFECOM_nonterNULL;
|
||||
#endif
|
||||
return x;
|
||||
}
|
||||
|
||||
|
||||
19
gcc/f/bld.h
19
gcc/f/bld.h
@ -406,12 +406,18 @@ struct _ffebld_
|
||||
{
|
||||
ffebld left;
|
||||
ffebld right;
|
||||
#ifdef FFECOM_nonterHOOK
|
||||
ffecomNonter hook; /* Whatever the compiler/backend wants! */
|
||||
#endif
|
||||
}
|
||||
nonter;
|
||||
struct
|
||||
{
|
||||
ffebld head;
|
||||
ffebld trail;
|
||||
#ifdef FFECOM_itemHOOK
|
||||
ffecomItem hook; /* Whatever the compiler/backend wants! */
|
||||
#endif
|
||||
}
|
||||
item;
|
||||
struct
|
||||
@ -748,6 +754,7 @@ ffetargetCharacterSize ffebld_size_max (ffebld b);
|
||||
#define ffebld_arrter_set_pad(b,p) ((b)->u.arrter.pad = (p))
|
||||
#define ffebld_arrter_set_size(b,s) ((b)->u.arrter.size = (s))
|
||||
#define ffebld_arrter_size(b) ((b)->u.arrter.size)
|
||||
#define ffebld_basictype(b) (ffeinfo_basictype (ffebld_info ((b))))
|
||||
#if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstPROGUNIT_
|
||||
#define ffebld_constant_pool() ffe_pool_program_unit()
|
||||
#elif FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstFILE_
|
||||
@ -944,6 +951,10 @@ ffetargetCharacterSize ffebld_size_max (ffebld b);
|
||||
#define ffebld_init_3()
|
||||
#define ffebld_init_4()
|
||||
#define ffebld_init_list(l,b) (*(l) = NULL, *(b) = (l))
|
||||
#define ffebld_item_hook(b) ((b)->u.item.hook)
|
||||
#define ffebld_item_set_hook(b,h) ((b)->u.item.hook = (h))
|
||||
#define ffebld_kind(b) (ffeinfo_kind (ffebld_info ((b))))
|
||||
#define ffebld_kindtype(b) (ffeinfo_kindtype (ffebld_info ((b))))
|
||||
#define ffebld_labter(b) ((b)->u.labter)
|
||||
#define ffebld_labtok(b) ((b)->u.labtok)
|
||||
#define ffebld_left(b) ((b)->u.nonter.left)
|
||||
@ -987,8 +998,11 @@ ffetargetCharacterSize ffebld_size_max (ffebld b);
|
||||
#define ffebld_new_arrayref(l,r) ffebld_new_two(FFEBLD_opARRAYREF,(l),(r))
|
||||
#define ffebld_new_substr(l,r) ffebld_new_two(FFEBLD_opSUBSTR,(l),(r))
|
||||
#define ffebld_new_impdo(l,r) ffebld_new_two(FFEBLD_opIMPDO,(l),(r))
|
||||
#define ffebld_nonter_hook(b) ((b)->u.nonter.hook)
|
||||
#define ffebld_nonter_set_hook(b,h) ((b)->u.nonter.hook = (h))
|
||||
#define ffebld_op(b) ((b)->op)
|
||||
#define ffebld_pool() (ffebld_pool_stack_.pool)
|
||||
#define ffebld_rank(b) (ffeinfo_rank (ffebld_info ((b))))
|
||||
#define ffebld_right(b) ((b)->u.nonter.right)
|
||||
#define ffebld_set_accter(b,a) ((b)->u.accter.array = (a))
|
||||
#define ffebld_set_arrter(b,a) ((b)->u.arrter.array = (a))
|
||||
@ -1000,8 +1014,8 @@ ffetargetCharacterSize ffebld_size_max (ffebld b);
|
||||
#define ffebld_set_left(b,l) ((b)->u.nonter.left = (l))
|
||||
#define ffebld_set_right(b,r) ((b)->u.nonter.right = (r))
|
||||
#define ffebld_set_trail(b,t) ((b)->u.item.trail = (t))
|
||||
#define ffebld_size(b) (ffeinfo_size((b)->info))
|
||||
#define ffebld_size_known(b) ffebld_size(b)
|
||||
#define ffebld_size(b) (ffeinfo_size (ffebld_info ((b))))
|
||||
#define ffebld_size_known(b) ffebld_size((b))
|
||||
#define ffebld_symter(b) ((b)->u.symter.symbol)
|
||||
#define ffebld_symter_generic(b) ((b)->u.symter.generic)
|
||||
#define ffebld_symter_doiter(b) ((b)->u.symter.do_iter)
|
||||
@ -1018,6 +1032,7 @@ ffetargetCharacterSize ffebld_size_max (ffebld b);
|
||||
#define ffebld_terminate_3()
|
||||
#define ffebld_terminate_4()
|
||||
#define ffebld_trail(b) ((b)->u.item.trail)
|
||||
#define ffebld_where(b) (ffeinfo_where (ffebld_info ((b))))
|
||||
|
||||
/* End of #include file. */
|
||||
|
||||
|
||||
3312
gcc/f/com.c
3312
gcc/f/com.c
File diff suppressed because it is too large
Load Diff
31
gcc/f/com.h
31
gcc/f/com.h
@ -56,6 +56,7 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
|
||||
|
||||
#if FFECOM_targetCURRENT == FFECOM_targetGCC
|
||||
#define FFECOM_constantNULL NULL_TREE
|
||||
#define FFECOM_nonterNULL NULL_TREE
|
||||
#define FFECOM_globalNULL NULL_TREE
|
||||
#define FFECOM_labelNULL NULL_TREE
|
||||
#define FFECOM_storageNULL NULL_TREE
|
||||
@ -202,6 +203,8 @@ typedef enum
|
||||
|
||||
typedef tree ffecomConstant;
|
||||
#define FFECOM_constantHOOK
|
||||
typedef tree ffecomNonter;
|
||||
#define FFECOM_nonterHOOK
|
||||
typedef tree ffecomLabel;
|
||||
#define FFECOM_globalHOOK
|
||||
typedef tree ffecomGlobal;
|
||||
@ -279,15 +282,20 @@ tree ffecom_3 (enum tree_code code, tree type, tree node1, tree node2,
|
||||
tree ffecom_3s (enum tree_code code, tree type, tree node1, tree node2,
|
||||
tree node3);
|
||||
tree ffecom_arg_expr (ffebld expr, tree *length);
|
||||
tree ffecom_arg_ptr_to_const_expr (ffebld expr, tree *length);
|
||||
tree ffecom_arg_ptr_to_expr (ffebld expr, tree *length);
|
||||
tree ffecom_call_gfrt (ffecomGfrt ix, tree args);
|
||||
tree ffecom_call_gfrt (ffecomGfrt ix, tree args, tree hook);
|
||||
tree ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt,
|
||||
ffeinfoKindtype kt, tree tree_type);
|
||||
tree ffecom_const_expr (ffebld expr);
|
||||
tree ffecom_decl_field (tree context, tree prevfield, const char *name,
|
||||
tree type);
|
||||
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
|
||||
void ffecom_close_include (FILE *f);
|
||||
int ffecom_decode_include_option (char *spec);
|
||||
#if FFECOM_targetCURRENT == FFECOM_targetGCC
|
||||
tree ffecom_end_compstmt (void);
|
||||
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
|
||||
void ffecom_end_transition (void);
|
||||
void ffecom_exec_transition (void);
|
||||
void ffecom_expand_let_stmt (ffebld dest, ffebld source);
|
||||
@ -295,7 +303,8 @@ void ffecom_expand_let_stmt (ffebld dest, ffebld source);
|
||||
tree ffecom_expr (ffebld expr);
|
||||
tree ffecom_expr_assign (ffebld expr);
|
||||
tree ffecom_expr_assign_w (ffebld expr);
|
||||
tree ffecom_expr_rw (ffebld expr);
|
||||
tree ffecom_expr_rw (tree type, ffebld expr);
|
||||
tree ffecom_expr_w (tree type, ffebld expr);
|
||||
void ffecom_finish_compile (void);
|
||||
void ffecom_finish_decl (tree decl, tree init, bool is_top_level);
|
||||
void ffecom_finish_progunit (void);
|
||||
@ -308,6 +317,8 @@ void ffecom_init_2 (void);
|
||||
tree ffecom_list_expr (ffebld list);
|
||||
tree ffecom_list_ptr_to_expr (ffebld list);
|
||||
tree ffecom_lookup_label (ffelab label);
|
||||
tree ffecom_make_tempvar (const char *commentary, tree type,
|
||||
ffetargetCharacterSize size, int elements);
|
||||
tree ffecom_modify (tree newtype, tree lhs, tree rhs);
|
||||
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
|
||||
void ffecom_file (char *name);
|
||||
@ -316,14 +327,18 @@ void ffecom_notify_init_symbol (ffesymbol s);
|
||||
void ffecom_notify_primary_entry (ffesymbol fn);
|
||||
FILE *ffecom_open_include (char *name, ffewhereLine l, ffewhereColumn c);
|
||||
#if FFECOM_targetCURRENT == FFECOM_targetGCC
|
||||
void ffecom_pop_calltemps (void);
|
||||
void ffecom_pop_tempvar (tree var);
|
||||
void ffecom_prepare_arg_ptr_to_expr (ffebld expr);
|
||||
bool ffecom_prepare_end (void);
|
||||
void ffecom_prepare_expr_ (ffebld expr, ffebld dest);
|
||||
void ffecom_prepare_expr_rw (tree type, ffebld expr);
|
||||
void ffecom_prepare_expr_w (tree type, ffebld expr);
|
||||
void ffecom_prepare_ptr_to_expr (ffebld expr);
|
||||
void ffecom_prepare_return_expr (ffebld expr);
|
||||
tree ffecom_ptr_to_const_expr (ffebld expr);
|
||||
tree ffecom_ptr_to_expr (ffebld expr);
|
||||
void ffecom_push_calltemps (void);
|
||||
tree ffecom_push_tempvar (tree type, ffetargetCharacterSize size,
|
||||
int elements, bool auto_pop);
|
||||
tree ffecom_return_expr (ffebld expr);
|
||||
tree ffecom_save_tree (tree t);
|
||||
void ffecom_start_compstmt (void);
|
||||
tree ffecom_start_decl (tree decl, bool is_init);
|
||||
void ffecom_sym_commit (ffesymbol s);
|
||||
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
|
||||
@ -335,6 +350,7 @@ void ffecom_sym_retract (ffesymbol s);
|
||||
tree ffecom_temp_label (void);
|
||||
tree ffecom_truth_value (tree expr);
|
||||
tree ffecom_truth_value_invert (tree expr);
|
||||
tree ffecom_type_expr (ffebld expr);
|
||||
tree ffecom_which_entrypoint_decl (void);
|
||||
|
||||
/* These need to be in the front end with exactly these interfaces,
|
||||
@ -360,6 +376,7 @@ int mark_addressable (tree expr);
|
||||
#define ffecom_f2c_typecode(bt,kt) ffecom_f2c_typecode_[(bt)][(kt)]
|
||||
#define ffecom_label_kind() ffecom_label_kind_
|
||||
#define ffecom_pointer_kind() ffecom_pointer_kind_
|
||||
#define ffecom_prepare_expr(e) ffecom_prepare_expr_ ((e), NULL)
|
||||
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
|
||||
|
||||
#define ffecom_init_1()
|
||||
|
||||
@ -10000,6 +10000,10 @@ ffestc_R838 (ffelexToken label_token, ffebld target,
|
||||
return;
|
||||
ffestc_labeldef_branch_begin_ ();
|
||||
|
||||
/* Mark target symbol as target of an ASSIGN. */
|
||||
if (ffebld_op (target) == FFEBLD_opSYMTER)
|
||||
ffesymbol_set_assigned (ffebld_symter (target), TRUE);
|
||||
|
||||
if (ffestc_labelref_is_assignable_ (label_token, &label))
|
||||
ffestd_R838 (label, target);
|
||||
|
||||
|
||||
87
gcc/f/std.c
87
gcc/f/std.c
@ -192,15 +192,27 @@ struct _ffestd_stmt_
|
||||
struct
|
||||
{
|
||||
mallocPool pool;
|
||||
ffestw block;
|
||||
ffebld expr;
|
||||
}
|
||||
R803;
|
||||
struct
|
||||
{
|
||||
mallocPool pool;
|
||||
ffestw block;
|
||||
ffebld expr;
|
||||
}
|
||||
R804;
|
||||
struct
|
||||
{
|
||||
ffestw block;
|
||||
}
|
||||
R805;
|
||||
struct
|
||||
{
|
||||
ffestw block;
|
||||
}
|
||||
R806;
|
||||
struct
|
||||
{
|
||||
mallocPool pool;
|
||||
@ -750,27 +762,28 @@ ffestd_stmt_pass_ ()
|
||||
case FFESTD_stmtidR803_:
|
||||
ffestd_subr_line_restore_ (stmt);
|
||||
if (okay)
|
||||
ffeste_R803 (stmt->u.R803.expr);
|
||||
ffeste_R803 (stmt->u.R803.block, stmt->u.R803.expr);
|
||||
malloc_pool_kill (stmt->u.R803.pool);
|
||||
break;
|
||||
|
||||
case FFESTD_stmtidR804_:
|
||||
ffestd_subr_line_restore_ (stmt);
|
||||
if (okay)
|
||||
ffeste_R804 (stmt->u.R804.expr);
|
||||
ffeste_R804 (stmt->u.R803.block, stmt->u.R804.expr);
|
||||
malloc_pool_kill (stmt->u.R804.pool);
|
||||
break;
|
||||
|
||||
case FFESTD_stmtidR805_:
|
||||
ffestd_subr_line_restore_ (stmt);
|
||||
if (okay)
|
||||
ffeste_R805 ();
|
||||
ffeste_R805 (stmt->u.R803.block);
|
||||
break;
|
||||
|
||||
case FFESTD_stmtidR806_:
|
||||
ffestd_subr_line_restore_ (stmt);
|
||||
if (okay)
|
||||
ffeste_R806 ();
|
||||
ffeste_R806 (stmt->u.R806.block);
|
||||
ffestw_kill (stmt->u.R806.block);
|
||||
break;
|
||||
|
||||
case FFESTD_stmtidR807_:
|
||||
@ -1597,7 +1610,19 @@ ffestd_labeldef_format (ffelab label)
|
||||
ffestdStmt_ stmt;
|
||||
|
||||
stmt = ffestd_stmt_new_ (FFESTD_stmtidFORMATLABEL_);
|
||||
#if 0
|
||||
/* Don't bother with this. See FORMAT statement. */
|
||||
/* Prepend FORMAT label instead of appending it, so all the
|
||||
FORMAT label/statement pairs end up at the top of the list.
|
||||
This helps ensure all decls for a block (in the GBE) are
|
||||
known before any executable statements are generated. */
|
||||
stmt->previous = (ffestdStmt_) &ffestd_stmt_list_.first;
|
||||
stmt->next = ffestd_stmt_list_.first;
|
||||
stmt->next->previous = stmt;
|
||||
stmt->previous->next = stmt;
|
||||
#else
|
||||
ffestd_stmt_append_ (stmt);
|
||||
#endif
|
||||
stmt->u.formatlabel.label = label;
|
||||
}
|
||||
#endif
|
||||
@ -2989,13 +3014,7 @@ ffestd_R744 ()
|
||||
#endif
|
||||
}
|
||||
|
||||
/* ffestd_R745 -- Implicit END WHERE statement
|
||||
|
||||
ffestd_R745(TRUE);
|
||||
|
||||
Implement the end of the current WHERE "block". ok==TRUE iff statement
|
||||
following WHERE (substatement) is valid; else, statement is invalid
|
||||
or stack forcibly popped due to ffestd_eof_(). */
|
||||
/* ffestd_R745 -- Implicit END WHERE statement. */
|
||||
|
||||
void
|
||||
ffestd_R745 (bool ok)
|
||||
@ -3011,11 +3030,8 @@ ffestd_R745 (bool ok)
|
||||
}
|
||||
|
||||
#endif
|
||||
/* ffestd_R803 -- Block IF (IF-THEN) statement
|
||||
|
||||
ffestd_R803(construct_name,expr,expr_token);
|
||||
|
||||
Make sure statement is valid here; implement. */
|
||||
/* Block IF (IF-THEN) statement. */
|
||||
|
||||
void
|
||||
ffestd_R803 (ffelexToken construct_name UNUSED, ffebld expr)
|
||||
@ -3033,6 +3049,7 @@ ffestd_R803 (ffelexToken construct_name UNUSED, ffebld expr)
|
||||
ffestd_stmt_append_ (stmt);
|
||||
ffestd_subr_line_save_ (stmt);
|
||||
stmt->u.R803.pool = ffesta_output_pool;
|
||||
stmt->u.R803.block = ffestw_use (ffestw_stack_top ());
|
||||
stmt->u.R803.expr = expr;
|
||||
ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
|
||||
}
|
||||
@ -3042,13 +3059,7 @@ ffestd_R803 (ffelexToken construct_name UNUSED, ffebld expr)
|
||||
assert (ffestd_block_level_ > 0);
|
||||
}
|
||||
|
||||
/* ffestd_R804 -- ELSE IF statement
|
||||
|
||||
ffestd_R804(expr,expr_token,name_token);
|
||||
|
||||
Make sure ffestd_kind_ identifies an IF block. If not
|
||||
NULL, make sure name_token gives the correct name. Implement the else
|
||||
of the IF block. */
|
||||
/* ELSE IF statement. */
|
||||
|
||||
void
|
||||
ffestd_R804 (ffebld expr, ffelexToken name UNUSED)
|
||||
@ -3066,19 +3077,14 @@ ffestd_R804 (ffebld expr, ffelexToken name UNUSED)
|
||||
ffestd_stmt_append_ (stmt);
|
||||
ffestd_subr_line_save_ (stmt);
|
||||
stmt->u.R804.pool = ffesta_output_pool;
|
||||
stmt->u.R804.block = ffestw_use (ffestw_stack_top ());
|
||||
stmt->u.R804.expr = expr;
|
||||
ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
/* ffestd_R805 -- ELSE statement
|
||||
|
||||
ffestd_R805(name_token);
|
||||
|
||||
Make sure ffestd_kind_ identifies an IF block. If not
|
||||
NULL, make sure name_token gives the correct name. Implement the ELSE
|
||||
of the IF block. */
|
||||
/* ELSE statement. */
|
||||
|
||||
void
|
||||
ffestd_R805 (ffelexToken name UNUSED)
|
||||
@ -3095,13 +3101,12 @@ ffestd_R805 (ffelexToken name UNUSED)
|
||||
stmt = ffestd_stmt_new_ (FFESTD_stmtidR805_);
|
||||
ffestd_stmt_append_ (stmt);
|
||||
ffestd_subr_line_save_ (stmt);
|
||||
stmt->u.R805.block = ffestw_use (ffestw_stack_top ());
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
/* ffestd_R806 -- End an IF-THEN
|
||||
|
||||
ffestd_R806(TRUE); */
|
||||
/* END IF statement. */
|
||||
|
||||
void
|
||||
ffestd_R806 (bool ok UNUSED)
|
||||
@ -3116,6 +3121,7 @@ ffestd_R806 (bool ok UNUSED)
|
||||
stmt = ffestd_stmt_new_ (FFESTD_stmtidR806_);
|
||||
ffestd_stmt_append_ (stmt);
|
||||
ffestd_subr_line_save_ (stmt);
|
||||
stmt->u.R806.block = ffestw_use (ffestw_stack_top ());
|
||||
}
|
||||
#endif
|
||||
|
||||
@ -4273,7 +4279,24 @@ ffestd_R1001 (ffesttFormatList f)
|
||||
ffestdStmt_ stmt;
|
||||
|
||||
stmt = ffestd_stmt_new_ (FFESTD_stmtidR1001_);
|
||||
#if 0
|
||||
/* Don't bother with this. After all, things like cilists also are
|
||||
declared midway through code-generation. Perhaps the only problems
|
||||
the gcc back end has with midway declarations are with stack vars,
|
||||
maybe only with vars that can be put in registers. Unless/until the
|
||||
need is established, handle FORMAT just like cilists and others; at
|
||||
that point, they'd likely *all* have to be fixed, which would be
|
||||
very painful anyway. */
|
||||
/* Insert FORMAT statement just after the first item on the
|
||||
statement list, which must be a FORMAT label, which see. */
|
||||
assert (ffestd_stmt_list_.first->id == FFESTD_stmtidFORMATLABEL_);
|
||||
stmt->previous = ffestd_stmt_list_.first;
|
||||
stmt->next = ffestd_stmt_list_.first->next;
|
||||
stmt->next->previous = stmt;
|
||||
stmt->previous->next = stmt;
|
||||
#else
|
||||
ffestd_stmt_append_ (stmt);
|
||||
#endif
|
||||
stmt->u.R1001.str = str;
|
||||
}
|
||||
#endif
|
||||
|
||||
3012
gcc/f/ste.c
3012
gcc/f/ste.c
File diff suppressed because it is too large
Load Diff
12
gcc/f/ste.h
12
gcc/f/ste.h
@ -62,10 +62,10 @@ void ffeste_end_R807 (void);
|
||||
void ffeste_labeldef_branch (ffelab label);
|
||||
void ffeste_labeldef_format (ffelab label);
|
||||
void ffeste_R737A (ffebld dest, ffebld source);
|
||||
void ffeste_R803 (ffebld expr);
|
||||
void ffeste_R804 (ffebld expr);
|
||||
void ffeste_R805 (void);
|
||||
void ffeste_R806 (void);
|
||||
void ffeste_R803 (ffestw block, ffebld expr);
|
||||
void ffeste_R804 (ffestw block, ffebld expr);
|
||||
void ffeste_R805 (ffestw block);
|
||||
void ffeste_R806 (ffestw block);
|
||||
void ffeste_R807 (ffebld expr);
|
||||
void ffeste_R809 (ffestw block, ffebld expr);
|
||||
void ffeste_R810 (ffestw block, unsigned long casenum);
|
||||
@ -159,7 +159,11 @@ void ffeste_V026 (ffestpFindStmt *info);
|
||||
#endif /* FFECOM_targetCURRENT == FFECOM_targetFFE */
|
||||
#define ffeste_terminate_0()
|
||||
#define ffeste_terminate_1()
|
||||
#ifdef ENABLE_CHECKING
|
||||
void ffeste_terminate_2 (void);
|
||||
#else
|
||||
#define ffeste_terminate_2()
|
||||
#endif
|
||||
#define ffeste_terminate_3()
|
||||
#define ffeste_terminate_4()
|
||||
|
||||
|
||||
@ -81,6 +81,7 @@ struct _ffestw_
|
||||
tree select_texpr_; /* tree for end case. */
|
||||
bool select_break_; /* TRUE when CASE should start with gen
|
||||
"break;". */
|
||||
int ifthen_fake_else_; /* Number of fake `else' introductions. */
|
||||
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC*/
|
||||
};
|
||||
|
||||
@ -137,6 +138,7 @@ ffestw ffestw_use (ffestw block);
|
||||
#define ffestw_do_iter_var(b) ((b)->do_iter_var_)
|
||||
#define ffestw_do_iter_var_t(b) ((b)->do_iter_var_t_)
|
||||
#define ffestw_do_tvar(b) ((b)->do_tvar_)
|
||||
#define ffestw_ifthen_fake_else(b) ((b)->ifthen_fake_else_)
|
||||
#define ffestw_init_1()
|
||||
#define ffestw_init_2()
|
||||
#define ffestw_init_3()
|
||||
@ -156,6 +158,7 @@ ffestw ffestw_use (ffestw block);
|
||||
#define ffestw_set_do_iter_var(b,v) ((b)->do_iter_var_ = (v))
|
||||
#define ffestw_set_do_iter_var_t(b,t) ((b)->do_iter_var_t_ = (t))
|
||||
#define ffestw_set_do_tvar(b,d) ((b)->do_tvar_ = (d))
|
||||
#define ffestw_set_ifthen_fake_else(b,e) ((b)->ifthen_fake_else_ = (e))
|
||||
#define ffestw_set_label(b,l) ((b)->label_ = (l))
|
||||
#define ffestw_set_line(b,l) ((b)->line_ = (l))
|
||||
#define ffestw_set_name(b,n) ((b)->name_ = (n))
|
||||
|
||||
@ -255,6 +255,7 @@ ffesymbol_new_ (ffename n)
|
||||
s->reported = FALSE;
|
||||
s->explicit_where = FALSE;
|
||||
s->namelisted = FALSE;
|
||||
s->assigned = FALSE;
|
||||
|
||||
ffename_set_symbol (n, s);
|
||||
|
||||
|
||||
@ -151,11 +151,13 @@ struct _ffesymbol_
|
||||
away. */
|
||||
bool explicit_where; /* TRUE if INTRINSIC/EXTERNAL explicit. */
|
||||
bool namelisted; /* TRUE if in NAMELIST (needs static alloc). */
|
||||
bool assigned; /* TRUE if ever ASSIGNed to. */
|
||||
};
|
||||
|
||||
#define ffesymbol_accretes(s) ((s)->accretes)
|
||||
#define ffesymbol_accretion(s) ((s)->accretion)
|
||||
#define ffesymbol_arraysize(s) ((s)->array_size)
|
||||
#define ffesymbol_assigned(s) ((s)->assigned)
|
||||
#define ffesymbol_attr(s,a) ((s)->attrs & ((ffesymbolAttrs) 1 << (a)))
|
||||
#define ffesymbol_attrs(s) ((s)->attrs)
|
||||
const char *ffesymbol_attrs_string (ffesymbolAttrs attrs);
|
||||
@ -231,6 +233,7 @@ bool ffesymbol_retractable (void);
|
||||
#define ffesymbol_set_accretes(s,a) ((s)->accretes = (a))
|
||||
#define ffesymbol_set_accretion(s,a) ((s)->accretion = (a))
|
||||
#define ffesymbol_set_arraysize(s,a) ((s)->array_size = (a))
|
||||
#define ffesymbol_set_assigned(s,a) ((s)->assigned = (a))
|
||||
#define ffesymbol_set_attr(s,a) ((s)->attrs |= ((ffesymbolAttrs) 1 << (a)))
|
||||
#define ffesymbol_set_attrs(s,a) ((s)->attrs = (a))
|
||||
#define ffesymbol_set_common(s,c) ((s)->common = (c))
|
||||
|
||||
@ -1 +1 @@
|
||||
const char *ffe_version_string = "0.5.24-19990405";
|
||||
const char *ffe_version_string = "0.5.24-19990417";
|
||||
|
||||
Loading…
Reference in New Issue
Block a user