Commit e90c9dc0 by Andreas Jaeger Committed by Andreas Jaeger

lex.c (ffelex_file_fixed): Remove usage of REDUCE_CARD_SIZE_AFTER_BIGGY.


	* lex.c (ffelex_file_fixed): Remove usage of
	REDUCE_CARD_SIZE_AFTER_BIGGY.

	* expr.c (ffeexpr_exprstack_push_operand_): Remove code depenend
	on WEIRD_NONFORTRAN_RULES.

	* com.c (ffecom_arg_ptr_to_expr): Remove
	PASS_HOLLERITH_BY_DESCRIPTOR dependend code.
	(ffecom_const_expr): Remove usage of NEWCOMMON.
	(ffecom_expand_let_stmt): Remove MOVE_EXPR.

From-SVN: r67287
parent 1174a658
2003-06-01 Andreas Jaeger <aj@suse.de>
* lex.c (ffelex_file_fixed): Remove usage of
REDUCE_CARD_SIZE_AFTER_BIGGY.
* expr.c (ffeexpr_exprstack_push_operand_): Remove code depenend
on WEIRD_NONFORTRAN_RULES.
* com.c (ffecom_arg_ptr_to_expr): Remove
PASS_HOLLERITH_BY_DESCRIPTOR dependend code.
(ffecom_const_expr): Remove usage of NEWCOMMON.
(ffecom_expand_let_stmt): Remove MOVE_EXPR.
2003-05-31 Bud Davis <bdavis9659@comcast.net> 2003-05-31 Bud Davis <bdavis9659@comcast.net>
PR fortran/10843 PR fortran/10843
......
...@@ -168,7 +168,7 @@ tree ffecom_tree_type[FFEINFO_basictype][FFEINFO_kindtype]; ...@@ -168,7 +168,7 @@ tree ffecom_tree_type[FFEINFO_basictype][FFEINFO_kindtype];
appropriate _tree_type array element. */ appropriate _tree_type array element. */
static GTY(()) tree ffecom_tree_fun_type[FFEINFO_basictype][FFEINFO_kindtype]; static GTY(()) tree ffecom_tree_fun_type[FFEINFO_basictype][FFEINFO_kindtype];
static GTY(()) tree static GTY(()) tree
ffecom_tree_ptr_to_fun_type[FFEINFO_basictype][FFEINFO_kindtype]; ffecom_tree_ptr_to_fun_type[FFEINFO_basictype][FFEINFO_kindtype];
static GTY(()) tree ffecom_tree_subr_type; static GTY(()) tree ffecom_tree_subr_type;
static GTY(()) tree ffecom_tree_ptr_to_subr_type; static GTY(()) tree ffecom_tree_ptr_to_subr_type;
...@@ -604,18 +604,18 @@ struct lang_identifier GTY(()) ...@@ -604,18 +604,18 @@ struct lang_identifier GTY(())
(((struct lang_identifier *)(NODE))->invented) (((struct lang_identifier *)(NODE))->invented)
/* The resulting tree type. */ /* The resulting tree type. */
union lang_tree_node union lang_tree_node
GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"), GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"),
chain_next ("(union lang_tree_node *)TREE_CHAIN (&%h.generic)"))) chain_next ("(union lang_tree_node *)TREE_CHAIN (&%h.generic)")))
{ {
union tree_node GTY ((tag ("0"), union tree_node GTY ((tag ("0"),
desc ("tree_node_structure (&%h)"))) desc ("tree_node_structure (&%h)")))
generic; generic;
struct lang_identifier GTY ((tag ("1"))) identifier; struct lang_identifier GTY ((tag ("1"))) identifier;
}; };
/* Fortran doesn't use either of these. */ /* Fortran doesn't use either of these. */
struct lang_decl GTY(()) struct lang_decl GTY(())
{ {
}; };
struct lang_type GTY(()) struct lang_type GTY(())
...@@ -2918,7 +2918,7 @@ ffecom_do_entry_ (ffesymbol fn, int entrynum) ...@@ -2918,7 +2918,7 @@ ffecom_do_entry_ (ffesymbol fn, int entrynum)
finish_function (0); finish_function (0);
input_location = old_loc; input_location = old_loc;
ffecom_doing_entry_ = FALSE; ffecom_doing_entry_ = FALSE;
} }
...@@ -7294,7 +7294,7 @@ ffecom_sym_transform_ (ffesymbol s) ...@@ -7294,7 +7294,7 @@ ffecom_sym_transform_ (ffesymbol s)
ffeinfoKindtype kt; ffeinfoKindtype kt;
ffeglobal g; ffeglobal g;
location_t old_loc = input_location; location_t old_loc = input_location;
/* Must ensure special ASSIGN variables are declared at top of outermost /* Must ensure special ASSIGN variables are declared at top of outermost
block, else they'll end up in the innermost block when their first block, else they'll end up in the innermost block when their first
ASSIGN is seen, which leaves them out of scope when they're the ASSIGN is seen, which leaves them out of scope when they're the
...@@ -10111,9 +10111,6 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length) ...@@ -10111,9 +10111,6 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length)
case FFEBLD_opPERCENT_DESCR: case FFEBLD_opPERCENT_DESCR:
switch (ffeinfo_basictype (ffebld_info (expr))) switch (ffeinfo_basictype (ffebld_info (expr)))
{ {
#ifdef PASS_HOLLERITH_BY_DESCRIPTOR
case FFEINFO_basictypeHOLLERITH:
#endif
case FFEINFO_basictypeCHARACTER: case FFEINFO_basictypeCHARACTER:
break; /* Passed by descriptor anyway. */ break; /* Passed by descriptor anyway. */
...@@ -10129,21 +10126,6 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length) ...@@ -10129,21 +10126,6 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length)
break; break;
} }
#ifdef PASS_HOLLERITH_BY_DESCRIPTOR
if ((ffeinfo_basictype (ffebld_info (expr)) == FFEINFO_basictypeHOLLERITH)
&& (length != NULL))
{ /* Pass Hollerith by descriptor. */
ffetargetHollerith h;
assert (ffebld_op (expr) == FFEBLD_opCONTER);
h = ffebld_cu_val_hollerith (ffebld_constant_union
(ffebld_conter (expr)));
*length
= build_int_2 (h.length, 0);
TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node;
}
#endif
if (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeCHARACTER) if (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeCHARACTER)
return ffecom_ptr_to_expr (expr); return ffecom_ptr_to_expr (expr);
...@@ -10608,7 +10590,7 @@ ffecom_constantunion_with_type (ffebldConstantUnion *cu, ...@@ -10608,7 +10590,7 @@ ffecom_constantunion_with_type (ffebldConstantUnion *cu,
{ {
#if FFETARGET_okINTEGER1 #if FFETARGET_okINTEGER1
case FFEBLD_constINTEGER1: case FFEBLD_constINTEGER1:
val = ffebld_cu_val_integer1 (*cu); val = ffebld_cu_val_integer1 (*cu);
item = build_int_2 (val, (val < 0) ? -1 : 0); item = build_int_2 (val, (val < 0) ? -1 : 0);
break; break;
#endif #endif
...@@ -10695,10 +10677,6 @@ ffecom_const_expr (ffebld expr) ...@@ -10695,10 +10677,6 @@ ffecom_const_expr (ffebld expr)
if (ffebld_arity (expr) == 0 if (ffebld_arity (expr) == 0
&& (ffebld_op (expr) != FFEBLD_opSYMTER && (ffebld_op (expr) != FFEBLD_opSYMTER
#if NEWCOMMON
/* ~~Enable once common/equivalence is handled properly? */
|| ffebld_where (expr) == FFEINFO_whereCOMMON
#endif
|| ffebld_where (expr) == FFEINFO_whereGLOBAL || ffebld_where (expr) == FFEINFO_whereGLOBAL
|| ffebld_where (expr) == FFEINFO_whereINTRINSIC)) || ffebld_where (expr) == FFEINFO_whereINTRINSIC))
{ {
...@@ -10930,16 +10908,6 @@ ffecom_expand_let_stmt (ffebld dest, ffebld source) ...@@ -10930,16 +10908,6 @@ ffecom_expand_let_stmt (ffebld dest, ffebld source)
expr_tree = source_tree; expr_tree = source_tree;
else if (assign_temp) else if (assign_temp)
{ {
#ifdef MOVE_EXPR
/* The back end understands a conceptual move (evaluate source;
store into dest), so use that, in case it can determine
that it is going to use, say, two registers as temporaries
anyway. So don't use the temp (and someday avoid generating
it, once this code starts triggering regularly). */
expr_tree = ffecom_2s (MOVE_EXPR, void_type_node,
dest_tree,
source_tree);
#else
expr_tree = ffecom_2s (MODIFY_EXPR, void_type_node, expr_tree = ffecom_2s (MODIFY_EXPR, void_type_node,
assign_temp, assign_temp,
source_tree); source_tree);
...@@ -10947,7 +10915,6 @@ ffecom_expand_let_stmt (ffebld dest, ffebld source) ...@@ -10947,7 +10915,6 @@ ffecom_expand_let_stmt (ffebld dest, ffebld source)
expr_tree = ffecom_2s (MODIFY_EXPR, void_type_node, expr_tree = ffecom_2s (MODIFY_EXPR, void_type_node,
dest_tree, dest_tree,
assign_temp); assign_temp);
#endif
} }
else else
expr_tree = ffecom_2s (MODIFY_EXPR, void_type_node, expr_tree = ffecom_2s (MODIFY_EXPR, void_type_node,
......
/* expr.c -- Implementation File (module.c template V1.0) /* expr.c -- Implementation File (module.c template V1.0)
Copyright (C) 1995, 1996, 1997, 1998, 2001, 2002 Copyright (C) 1995, 1996, 1997, 1998, 2001, 2002, 2003
Free Software Foundation, Inc. Free Software Foundation, Inc.
Contributed by James Craig Burley. Contributed by James Craig Burley.
...@@ -9577,15 +9577,6 @@ static void ...@@ -9577,15 +9577,6 @@ static void
ffeexpr_exprstack_push_operand_ (ffeexprExpr_ e) ffeexpr_exprstack_push_operand_ (ffeexprExpr_ e)
{ {
ffeexpr_exprstack_push_ (e); ffeexpr_exprstack_push_ (e);
#ifdef WEIRD_NONFORTRAN_RULES
if ((ffeexpr_stack_->exprstack != NULL)
&& (ffeexpr_stack_->exprstack->expr->type == FFEEXPR_exprtypeBINARY_)
&& (ffeexpr_stack_->exprstack->expr->u.operator.prec
== FFEEXPR_operatorprecedenceHIGHEST_)
&& (ffeexpr_stack_->exprstack->expr->u.operator.as
== FFEEXPR_operatorassociativityL2R_))
ffeexpr_reduce_ ();
#endif
} }
/* ffeexpr_exprstack_push_unary_ -- Push a unary operator onto the stack /* ffeexpr_exprstack_push_unary_ -- Push a unary operator onto the stack
...@@ -11519,7 +11510,7 @@ ffeexpr_reduced_ugly2log_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op, ...@@ -11519,7 +11510,7 @@ ffeexpr_reduced_ugly2log_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op,
FFETARGET_charactersizeNONE, FFETARGET_charactersizeNONE,
FFEEXPR_contextLET)); FFEEXPR_contextLET));
} }
return reduced; return reduced;
} }
......
...@@ -1028,7 +1028,6 @@ ffelex_hash_ (FILE *finput) ...@@ -1028,7 +1028,6 @@ ffelex_hash_ (FILE *finput)
goto skipline; goto skipline;
} }
} }
else if (c == 'd') else if (c == 'd')
{ {
if (getc (finput) == 'e' if (getc (finput) == 'e'
...@@ -1450,9 +1449,6 @@ ffelex_include_ () ...@@ -1450,9 +1449,6 @@ ffelex_include_ ()
if (card_length != 0) if (card_length != 0)
{ {
#ifdef REDUCE_CARD_SIZE_AFTER_BIGGY /* Define if occasional large lines. */
#error "need to handle possible reduction of card size here!!"
#endif
assert (ffelex_card_size_ >= card_length); /* It shrunk?? */ assert (ffelex_card_size_ >= card_length); /* It shrunk?? */
memcpy (ffelex_card_image_, card_image, card_length); memcpy (ffelex_card_image_, card_image, card_length);
} }
...@@ -1756,18 +1752,6 @@ ffelex_file_fixed (ffewhereFile wf, FILE *f) ...@@ -1756,18 +1752,6 @@ ffelex_file_fixed (ffewhereFile wf, FILE *f)
beginning_of_line_again: /* :::::::::::::::::::: */ beginning_of_line_again: /* :::::::::::::::::::: */
#ifdef REDUCE_CARD_SIZE_AFTER_BIGGY /* Define if occasional large lines. */
if (ffelex_card_size_ != FFELEX_columnINITIAL_SIZE_)
{
ffelex_card_image_
= malloc_resize_ks (malloc_pool_image (),
ffelex_card_image_,
FFELEX_columnINITIAL_SIZE_ + 9,
ffelex_card_size_ + 9);
ffelex_card_size_ = FFELEX_columnINITIAL_SIZE_;
}
#endif
first_line: /* :::::::::::::::::::: */ first_line: /* :::::::::::::::::::: */
c = latest_char_in_file; c = latest_char_in_file;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment