appropriate _tree_type array element. */
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];
static GTY(()) tree ffecom_tree_subr_type;
static GTY(()) tree ffecom_tree_ptr_to_subr_type;
(((struct lang_identifier *)(NODE))->invented)
/* The resulting tree type. */
-union lang_tree_node
+union lang_tree_node
GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"),
chain_next ("(union lang_tree_node *)TREE_CHAIN (&%h.generic)")))
{
- union tree_node GTY ((tag ("0"),
- desc ("tree_node_structure (&%h)")))
+ union tree_node GTY ((tag ("0"),
+ desc ("tree_node_structure (&%h)")))
generic;
struct lang_identifier GTY ((tag ("1"))) identifier;
};
/* Fortran doesn't use either of these. */
-struct lang_decl GTY(())
+struct lang_decl GTY(())
{
};
struct lang_type GTY(())
finish_function (0);
input_location = old_loc;
-
+
ffecom_doing_entry_ = FALSE;
}
ffeinfoKindtype kt;
ffeglobal g;
location_t old_loc = input_location;
-
+
/* Must ensure special ASSIGN variables are declared at top of outermost
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
case FFEBLD_opPERCENT_DESCR:
switch (ffeinfo_basictype (ffebld_info (expr)))
{
-#ifdef PASS_HOLLERITH_BY_DESCRIPTOR
- case FFEINFO_basictypeHOLLERITH:
-#endif
case FFEINFO_basictypeCHARACTER:
break; /* Passed by descriptor anyway. */
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)
return ffecom_ptr_to_expr (expr);
{
#if FFETARGET_okINTEGER1
case FFEBLD_constINTEGER1:
- val = ffebld_cu_val_integer1 (*cu);
+ val = ffebld_cu_val_integer1 (*cu);
item = build_int_2 (val, (val < 0) ? -1 : 0);
break;
#endif
if (ffebld_arity (expr) == 0
&& (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_whereINTRINSIC))
{
expr_tree = source_tree;
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,
assign_temp,
source_tree);
expr_tree = ffecom_2s (MODIFY_EXPR, void_type_node,
dest_tree,
assign_temp);
-#endif
}
else
expr_tree = ffecom_2s (MODIFY_EXPR, void_type_node,
/* 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.
Contributed by James Craig Burley.
ffeexpr_exprstack_push_operand_ (ffeexprExpr_ 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
FFETARGET_charactersizeNONE,
FFEEXPR_contextLET));
}
-
+
return reduced;
}
goto skipline;
}
}
-
else if (c == 'd')
{
if (getc (finput) == 'e'
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?? */
memcpy (ffelex_card_image_, card_image, card_length);
}
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: /* :::::::::::::::::::: */
c = latest_char_in_file;