/* ste.c -- Implementation File (module.c template V1.0)
- Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+ Copyright (C) 1995, 1996, 2000 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
#include "proj.h"
#if FFECOM_targetCURRENT == FFECOM_targetGCC
-#include "rtl.j"
-#include "toplev.j"
+#include "rtl.h"
+#include "toplev.h"
+#include "ggc.h"
#endif
#include "ste.h"
struct gbe_block *outer;
ffestw block;
int lineno;
- char *input_filename;
+ const char *input_filename;
bool is_stmt;
} *gbe_block;
free (b);
- clear_momentary ();
-
ffecom_end_compstmt ();
}
free (b);
- clear_momentary ();
-
ffecom_end_compstmt ();
}
#define ffeste_end_block_(b) \
do \
{ \
- clear_momentary (); \
ffecom_end_compstmt (); \
} while(0)
#define ffeste_start_stmt_() ffeste_start_block_(NULL)
#endif /* ! defined (ENABLE_CHECKING) */
-/* Begin an iterative DO loop. Pass the block to start if applicable.
-
- NOTE: Does _two_ push_momentary () calls, which the caller must
- undo (by calling ffeste_end_iterdo_). */
+/* Begin an iterative DO loop. Pass the block to start if
+ applicable. */
#if FFECOM_targetCURRENT == FFECOM_targetGCC
static void
tincr_saved = ffecom_save_tree (tincr);
- preserve_momentary ();
-
/* Want to have tstart, tend for just this statement. */
ffeste_start_stmt_ ();
if (size == NULL_TREE) /* Already filled in for CHARACTER type. */
{ /* "(ftnlen) sizeof(type)" */
size = size_binop (CEIL_DIV_EXPR,
- TYPE_SIZE (ffecom_tree_type[bt][kt]),
- size_int (TYPE_PRECISION (char_type_node)));
+ TYPE_SIZE_UNIT (ffecom_tree_type[bt][kt]),
+ size_int (TYPE_PRECISION (char_type_node)
+ / BITS_PER_UNIT));
#if 0 /* Assume that while it is possible that char * is wider than
ftnlen, no object in Fortran space can get big enough for its
size to be wider than ftnlen. I really hope nobody wastes
= is_complex ? ffecom_f2c_ftnlen_two_node : ffecom_f2c_ftnlen_one_node;
else
{
- num_elements = size_binop (CEIL_DIV_EXPR,
- TYPE_SIZE (TREE_TYPE (TREE_TYPE (variable))),
- size);
- num_elements = size_binop (CEIL_DIV_EXPR,
- num_elements,
- size_int (TYPE_PRECISION
- (char_type_node)));
+ num_elements
+ = size_binop (CEIL_DIV_EXPR,
+ TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (variable))),
+ convert (sizetype, size));
+ num_elements = size_binop (CEIL_DIV_EXPR, num_elements,
+ size_int (TYPE_PRECISION (char_type_node)
+ / BITS_PER_UNIT));
num_elements = convert (ffecom_f2c_ftnlen_type_node,
num_elements);
}
if (size == NULL_TREE) /* Already filled in for CHARACTER type. */
{ /* "(ftnlen) sizeof(type)" */
size = size_binop (CEIL_DIV_EXPR,
- TYPE_SIZE (ffecom_tree_type[bt][kt]),
- size_int (TYPE_PRECISION (char_type_node)));
+ TYPE_SIZE_UNIT (ffecom_tree_type[bt][kt]),
+ size_int (TYPE_PRECISION (char_type_node)
+ / BITS_PER_UNIT));
#if 0 /* Assume that while it is possible that char * is wider than
ftnlen, no object in Fortran space can get big enough for its
size to be wider than ftnlen. I really hope nobody wastes
num_elements = ffecom_integer_one_node;
else
{
- num_elements = size_binop (CEIL_DIV_EXPR,
- TYPE_SIZE (TREE_TYPE (TREE_TYPE (variable))),
- size);
- num_elements = size_binop (CEIL_DIV_EXPR,
- num_elements,
- size_int (TYPE_PRECISION
- (char_type_node)));
+ num_elements
+ = size_binop (CEIL_DIV_EXPR,
+ TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (variable))),
+ convert (sizetype, size));
+ num_elements = size_binop (CEIL_DIV_EXPR, num_elements,
+ size_int (TYPE_PRECISION (char_type_node)
+ / BITS_PER_UNIT));
num_elements = convert (ffecom_f2c_ftnlen_type_node,
num_elements);
}
if (size == NULL_TREE) /* Already filled in for CHARACTER type. */
{ /* "(ftnlen) sizeof(type)" */
size = size_binop (CEIL_DIV_EXPR,
- TYPE_SIZE (ffecom_tree_type[bt][kt]),
- size_int (TYPE_PRECISION (char_type_node)));
+ TYPE_SIZE_UNIT (ffecom_tree_type[bt][kt]),
+ size_int (TYPE_PRECISION (char_type_node)
+ / BITS_PER_UNIT));
#if 0 /* Assume that while it is possible that char * is wider than
ftnlen, no object in Fortran space can get big enough for its
size to be wider than ftnlen. I really hope nobody wastes
= is_complex ? ffecom_f2c_ftnlen_two_node : ffecom_f2c_ftnlen_one_node;
else
{
- num_elements = size_binop (CEIL_DIV_EXPR,
- TYPE_SIZE (TREE_TYPE (TREE_TYPE (variable))),
- size);
+ num_elements
+ = size_binop (CEIL_DIV_EXPR,
+ TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (variable))),
+ convert (sizetype, size));
num_elements = size_binop (CEIL_DIV_EXPR, num_elements,
- size_int (TYPE_PRECISION
- (char_type_node)));
+ size_int (TYPE_PRECISION (char_type_node)
+ / BITS_PER_UNIT));
num_elements = convert (ffecom_f2c_ftnlen_type_node,
num_elements);
}
static tree f2c_alist_struct = NULL_TREE;
tree t;
tree ttype;
- int yes;
tree field;
tree inits, initn;
bool constantp = TRUE;
{
tree ref;
- push_obstacks_nochange ();
- end_temporary_allocation ();
-
ref = make_node (RECORD_TYPE);
errfield = ffecom_decl_field (ref, NULL_TREE, "err",
TYPE_FIELDS (ref) = errfield;
layout_type (ref);
- resume_temporary_allocation ();
- pop_obstacks ();
+ ggc_add_tree_root (&f2c_alist_struct, 1);
f2c_alist_struct = ref;
}
TREE_CONSTANT (inits) = constantp ? 1 : 0;
TREE_STATIC (inits) = 1;
- yes = suspend_momentary ();
-
t = build_decl (VAR_DECL,
ffecom_get_invented_identifier ("__g77_alist_%d",
mynumber++),
t = ffecom_start_decl (t, 1);
ffecom_finish_decl (t, inits, 0);
- resume_momentary (yes);
-
/* Prepare run-time expressions. */
if (! unitexp)
static tree f2c_cilist_struct = NULL_TREE;
tree t;
tree ttype;
- int yes;
tree field;
tree inits, initn;
bool constantp = TRUE;
{
tree ref;
- push_obstacks_nochange ();
- end_temporary_allocation ();
-
ref = make_node (RECORD_TYPE);
errfield = ffecom_decl_field (ref, NULL_TREE, "err",
TYPE_FIELDS (ref) = errfield;
layout_type (ref);
- resume_temporary_allocation ();
- pop_obstacks ();
+ ggc_add_tree_root (&f2c_cilist_struct, 1);
f2c_cilist_struct = ref;
}
TREE_CONSTANT (inits) = constantp ? 1 : 0;
TREE_STATIC (inits) = 1;
- yes = suspend_momentary ();
-
t = build_decl (VAR_DECL,
ffecom_get_invented_identifier ("__g77_cilist_%d",
mynumber++),
t = ffecom_start_decl (t, 1);
ffecom_finish_decl (t, inits, 0);
- resume_momentary (yes);
-
/* Prepare run-time expressions. */
if (! unitexp)
static tree f2c_close_struct = NULL_TREE;
tree t;
tree ttype;
- int yes;
tree field;
tree inits, initn;
tree ignore; /* Ignore length info for certain fields. */
{
tree ref;
- push_obstacks_nochange ();
- end_temporary_allocation ();
-
ref = make_node (RECORD_TYPE);
errfield = ffecom_decl_field (ref, NULL_TREE, "err",
TYPE_FIELDS (ref) = errfield;
layout_type (ref);
- resume_temporary_allocation ();
- pop_obstacks ();
+ ggc_add_tree_root (&f2c_close_struct, 1);
f2c_close_struct = ref;
}
TREE_CONSTANT (inits) = constantp ? 1 : 0;
TREE_STATIC (inits) = 1;
- yes = suspend_momentary ();
-
t = build_decl (VAR_DECL,
ffecom_get_invented_identifier ("__g77_cllist_%d",
mynumber++),
t = ffecom_start_decl (t, 1);
ffecom_finish_decl (t, inits, 0);
- resume_momentary (yes);
-
/* Prepare run-time expressions. */
if (! unitexp)
static tree f2c_icilist_struct = NULL_TREE;
tree t;
tree ttype;
- int yes;
tree field;
tree inits, initn;
bool constantp = TRUE;
{
tree ref;
- push_obstacks_nochange ();
- end_temporary_allocation ();
-
ref = make_node (RECORD_TYPE);
errfield = ffecom_decl_field (ref, NULL_TREE, "err",
TYPE_FIELDS (ref) = errfield;
layout_type (ref);
- resume_temporary_allocation ();
- pop_obstacks ();
+ ggc_add_tree_root (&f2c_icilist_struct, 1);
f2c_icilist_struct = ref;
}
else if (unitexp && unitlenexp)
{
/* An array, but all the info is constant, so compute now. */
- unitnuminit = size_binop (CEIL_DIV_EXPR,
- TYPE_SIZE (TREE_TYPE (TREE_TYPE (unitexp))),
- unitlenexp);
- unitnuminit = size_binop (CEIL_DIV_EXPR,
- unitnuminit,
- size_int (TYPE_PRECISION
- (char_type_node)));
+ unitnuminit
+ = size_binop (CEIL_DIV_EXPR,
+ TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (unitexp))),
+ convert (sizetype, unitlenexp));
+ unitnuminit = size_binop (CEIL_DIV_EXPR, unitnuminit,
+ size_int (TYPE_PRECISION (char_type_node)
+ / BITS_PER_UNIT));
unitnumexp = unitnuminit;
}
else
TREE_CONSTANT (inits) = constantp ? 1 : 0;
TREE_STATIC (inits) = 1;
- yes = suspend_momentary ();
-
t = build_decl (VAR_DECL,
ffecom_get_invented_identifier ("__g77_icilist_%d",
mynumber++),
t = ffecom_start_decl (t, 1);
ffecom_finish_decl (t, inits, 0);
- resume_momentary (yes);
-
/* Prepare run-time expressions. */
if (! unitexp)
&& unitexp != error_mark_node
&& unitlenexp != error_mark_node)
{
- unitnumexp = size_binop (CEIL_DIV_EXPR,
- TYPE_SIZE (TREE_TYPE (TREE_TYPE (unitexp))),
- unitlenexp);
- unitnumexp = size_binop (CEIL_DIV_EXPR,
- unitnumexp,
- size_int (TYPE_PRECISION
- (char_type_node)));
+ unitnumexp
+ = size_binop (CEIL_DIV_EXPR,
+ TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (unitexp))),
+ convert (sizetype, unitlenexp));
+ unitnumexp = size_binop (CEIL_DIV_EXPR, unitnumexp,
+ size_int (TYPE_PRECISION (char_type_node)
+ / BITS_PER_UNIT));
ffeste_f2c_compile_ (unitnumfield, unitnumexp);
}
static tree f2c_inquire_struct = NULL_TREE;
tree t;
tree ttype;
- int yes;
tree field;
tree inits, initn;
bool constantp = TRUE;
{
tree ref;
- push_obstacks_nochange ();
- end_temporary_allocation ();
-
ref = make_node (RECORD_TYPE);
errfield = ffecom_decl_field (ref, NULL_TREE, "err",
TYPE_FIELDS (ref) = errfield;
layout_type (ref);
- resume_temporary_allocation ();
- pop_obstacks ();
+ ggc_add_tree_root (&f2c_inquire_struct, 1);
f2c_inquire_struct = ref;
}
TREE_CONSTANT (inits) = constantp ? 1 : 0;
TREE_STATIC (inits) = 1;
- yes = suspend_momentary ();
-
t = build_decl (VAR_DECL,
ffecom_get_invented_identifier ("__g77_inlist_%d",
mynumber++),
t = ffecom_start_decl (t, 1);
ffecom_finish_decl (t, inits, 0);
- resume_momentary (yes);
-
/* Prepare run-time expressions. */
ffeste_f2c_prepare_int_ (unit_spec, unitexp);
static tree f2c_open_struct = NULL_TREE;
tree t;
tree ttype;
- int yes;
tree field;
tree inits, initn;
tree ignore; /* Ignore length info for certain fields. */
{
tree ref;
- push_obstacks_nochange ();
- end_temporary_allocation ();
-
ref = make_node (RECORD_TYPE);
errfield = ffecom_decl_field (ref, NULL_TREE, "err",
TYPE_FIELDS (ref) = errfield;
layout_type (ref);
- resume_temporary_allocation ();
- pop_obstacks ();
+ ggc_add_tree_root (&f2c_open_struct, 1);
f2c_open_struct = ref;
}
TREE_CONSTANT (inits) = constantp ? 1 : 0;
TREE_STATIC (inits) = 1;
- yes = suspend_momentary ();
-
t = build_decl (VAR_DECL,
ffecom_get_invented_identifier ("__g77_olist_%d",
mynumber++),
t = ffecom_start_decl (t, 1);
ffecom_finish_decl (t, inits, 0);
- resume_momentary (yes);
-
/* Prepare run-time expressions. */
if (! unitexp)
c->previous_stmt = c->previous_stmt->previous_stmt;
}
while ((c != (ffestwCase) &s->first_rel) && (casenum == c->casenum));
-
- clear_momentary ();
}
#else
#error
target_tree,
label_tree);
expand_expr_stmt (expr_tree);
-
- clear_momentary ();
}
}
#else
error ("ASSIGNed GOTO target variable is too small");
expand_computed_goto (convert (TREE_TYPE (null_pointer_node), t));
-
- clear_momentary ();
}
#else
#error
TREE_SIDE_EFFECTS (callit) = 1;
expand_expr_stmt (callit);
-
- clear_momentary ();
}
#else
#error
TREE_SIDE_EFFECTS (callit) = 1;
expand_expr_stmt (callit);
-
- clear_momentary ();
}
#if 0 /* Old approach for phantom g77 run-time
library. */
TREE_SIDE_EFFECTS (callit) = 1;
expand_expr_stmt (callit);
-
- clear_momentary ();
}
#endif
#else
TREE_CONSTANT (t) = 1;
TREE_STATIC (t) = 1;
- push_obstacks_nochange ();
- end_temporary_allocation ();
-
var = ffecom_lookup_label (ffeste_label_formatdef_);
if ((var != NULL_TREE)
&& (TREE_CODE (var) == VAR_DECL))
expand_decl_init (var);
}
- resume_temporary_allocation ();
- pop_obstacks ();
-
ffeste_label_formatdef_ = NULL;
}
#else
OSDN Git Service
