f95-lang.c (yyerror, yylex): Remove.
* f95-lang.c (yyerror, yylex): Remove. (clear_binding_stack): Remove, fold into its only user. (LANG_HOOKS_PRINT_IDENTIFIER): Do not re-define. (ridpointers): Remove. (gfc_eh_initialized_p): Make static. (gfc_truthvalue_conversion): Move to convert.c. (gfc_be_parse_file): Clear binding level stack when done. (gfc_print_identifier): Remove. (pushlevel): Remove ignored 'ignore' argument. Update all callers. (poplevel): Remove unused 'reverse' argument. Update all callers. (ggc_p): Remove. (gfc_builtin_function): Make static. Do not attempt to make RTL for builtin functions. * convert.c (gfc_truthvalue_conversion): Moved here from f95-lang.c, and made static. * trans.h (pushlevel, poplevel): Adjust prototypes. (gfc_truthvalue_conversion, gfc_builtin_function): Remove prototypes. * trans-openmp.c: Update calls to pushlevel and poplevel. * trans.c: Likewise. * trans-decl.c: Likewise. From-SVN: r185015
This commit is contained in:
Steven Bosscher
parent
ca4adc913d
commit
87a60f68a9
7 changed files with 122 additions and 159 deletions
|
|
@ -1,3 +1,26 @@
|
|||
2012-03-06 Steven Bosscher <steven@gcc.gnu.org>
|
||||
|
||||
* f95-lang.c (yyerror, yylex): Remove.
|
||||
(clear_binding_stack): Remove, fold into its only user.
|
||||
(LANG_HOOKS_PRINT_IDENTIFIER): Do not re-define.
|
||||
(ridpointers): Remove.
|
||||
(gfc_eh_initialized_p): Make static.
|
||||
(gfc_truthvalue_conversion): Move to convert.c.
|
||||
(gfc_be_parse_file): Clear binding level stack when done.
|
||||
(gfc_print_identifier): Remove.
|
||||
(pushlevel): Remove ignored 'ignore' argument. Update all callers.
|
||||
(poplevel): Remove unused 'reverse' argument. Update all callers.
|
||||
(ggc_p): Remove.
|
||||
(gfc_builtin_function): Make static. Do not attempt to make RTL for
|
||||
builtin functions.
|
||||
* convert.c (gfc_truthvalue_conversion): Moved here from f95-lang.c,
|
||||
and made static.
|
||||
* trans.h (pushlevel, poplevel): Adjust prototypes.
|
||||
(gfc_truthvalue_conversion, gfc_builtin_function): Remove prototypes.
|
||||
* trans-openmp.c: Update calls to pushlevel and poplevel.
|
||||
* trans.c: Likewise.
|
||||
* trans-decl.c: Likewise.
|
||||
|
||||
2012-03-04 Mikael Morin <mikael@gcc.gnu.org>
|
||||
|
||||
PR fortran/50981
|
||||
|
|
|
|||
|
|
@ -60,6 +60,50 @@ along with GCC; see the file COPYING3. If not see
|
|||
|
||||
/* Subroutines of `convert'. */
|
||||
|
||||
/* Prepare expr to be an argument of a TRUTH_NOT_EXPR,
|
||||
or validate its data type for an `if' or `while' statement or ?..: exp.
|
||||
|
||||
This preparation consists of taking the ordinary
|
||||
representation of an expression expr and producing a valid tree
|
||||
boolean expression describing whether expr is nonzero. We could
|
||||
simply always do build_binary_op (NE_EXPR, expr, boolean_false_node, 1),
|
||||
but we optimize comparisons, &&, ||, and !.
|
||||
|
||||
The resulting type should always be `boolean_type_node'.
|
||||
This is much simpler than the corresponding C version because we have a
|
||||
distinct boolean type. */
|
||||
|
||||
static tree
|
||||
gfc_truthvalue_conversion (tree expr)
|
||||
{
|
||||
switch (TREE_CODE (TREE_TYPE (expr)))
|
||||
{
|
||||
case BOOLEAN_TYPE:
|
||||
if (TREE_TYPE (expr) == boolean_type_node)
|
||||
return expr;
|
||||
else if (COMPARISON_CLASS_P (expr))
|
||||
{
|
||||
TREE_TYPE (expr) = boolean_type_node;
|
||||
return expr;
|
||||
}
|
||||
else if (TREE_CODE (expr) == NOP_EXPR)
|
||||
return fold_build1_loc (input_location, NOP_EXPR,
|
||||
boolean_type_node, TREE_OPERAND (expr, 0));
|
||||
else
|
||||
return fold_build1_loc (input_location, NOP_EXPR, boolean_type_node,
|
||||
expr);
|
||||
|
||||
case INTEGER_TYPE:
|
||||
if (TREE_CODE (expr) == INTEGER_CST)
|
||||
return integer_zerop (expr) ? boolean_false_node : boolean_true_node;
|
||||
else
|
||||
return fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
|
||||
expr, build_int_cst (TREE_TYPE (expr), 0));
|
||||
|
||||
default:
|
||||
internal_error ("Unexpected type in truthvalue_conversion");
|
||||
}
|
||||
}
|
||||
|
||||
/* Create an expression whose value is that of EXPR,
|
||||
converted to type TYPE. The TREE_TYPE of the value
|
||||
|
|
|
|||
|
|
@ -60,7 +60,6 @@ lang_identifier {
|
|||
|
||||
union GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"),
|
||||
chain_next ("CODE_CONTAINS_STRUCT (TREE_CODE (&%h.generic), TS_COMMON) ? ((union lang_tree_node *) TREE_CHAIN (&%h.generic)) : NULL")))
|
||||
|
||||
lang_tree_node {
|
||||
union tree_node GTY((tag ("0"),
|
||||
desc ("tree_node_structure (&%h)"))) generic;
|
||||
|
|
@ -77,25 +76,18 @@ language_function {
|
|||
struct binding_level *binding_level;
|
||||
};
|
||||
|
||||
/* We don't have a lex/yacc lexer/parser, but toplev expects these to
|
||||
exist anyway. */
|
||||
void yyerror (const char *str);
|
||||
int yylex (void);
|
||||
|
||||
static void gfc_init_decl_processing (void);
|
||||
static void gfc_init_builtin_functions (void);
|
||||
static bool global_bindings_p (void);
|
||||
|
||||
/* Each front end provides its own. */
|
||||
static bool gfc_init (void);
|
||||
static void gfc_finish (void);
|
||||
static void gfc_write_global_declarations (void);
|
||||
static void gfc_print_identifier (FILE *, tree, int);
|
||||
void do_function_end (void);
|
||||
bool global_bindings_p (void);
|
||||
static void clear_binding_stack (void);
|
||||
static void gfc_be_parse_file (void);
|
||||
static alias_set_type gfc_get_alias_set (tree);
|
||||
static void gfc_init_ts (void);
|
||||
static tree gfc_builtin_function (tree);
|
||||
|
||||
#undef LANG_HOOKS_NAME
|
||||
#undef LANG_HOOKS_INIT
|
||||
|
|
@ -106,7 +98,6 @@ static void gfc_init_ts (void);
|
|||
#undef LANG_HOOKS_INIT_OPTIONS
|
||||
#undef LANG_HOOKS_HANDLE_OPTION
|
||||
#undef LANG_HOOKS_POST_OPTIONS
|
||||
#undef LANG_HOOKS_PRINT_IDENTIFIER
|
||||
#undef LANG_HOOKS_PARSE_FILE
|
||||
#undef LANG_HOOKS_MARK_ADDRESSABLE
|
||||
#undef LANG_HOOKS_TYPE_FOR_MODE
|
||||
|
|
@ -125,6 +116,7 @@ static void gfc_init_ts (void);
|
|||
#undef LANG_HOOKS_OMP_PRIVATE_OUTER_REF
|
||||
#undef LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES
|
||||
#undef LANG_HOOKS_BUILTIN_FUNCTION
|
||||
#undef LANG_HOOKS_BUILTIN_FUNCTION
|
||||
#undef LANG_HOOKS_GET_ARRAY_DESCR_INFO
|
||||
|
||||
/* Define lang hooks. */
|
||||
|
|
@ -137,7 +129,6 @@ static void gfc_init_ts (void);
|
|||
#define LANG_HOOKS_INIT_OPTIONS gfc_init_options
|
||||
#define LANG_HOOKS_HANDLE_OPTION gfc_handle_option
|
||||
#define LANG_HOOKS_POST_OPTIONS gfc_post_options
|
||||
#define LANG_HOOKS_PRINT_IDENTIFIER gfc_print_identifier
|
||||
#define LANG_HOOKS_PARSE_FILE gfc_be_parse_file
|
||||
#define LANG_HOOKS_TYPE_FOR_MODE gfc_type_for_mode
|
||||
#define LANG_HOOKS_TYPE_FOR_SIZE gfc_type_for_size
|
||||
|
|
@ -166,64 +157,13 @@ struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
|
|||
|
||||
static GTY(()) struct binding_level *free_binding_level;
|
||||
|
||||
/* The elements of `ridpointers' are identifier nodes
|
||||
for the reserved type names and storage classes.
|
||||
It is indexed by a RID_... value. */
|
||||
tree *ridpointers = NULL;
|
||||
|
||||
/* True means we've initialized exception handling. */
|
||||
bool gfc_eh_initialized_p;
|
||||
static bool gfc_eh_initialized_p;
|
||||
|
||||
/* The current translation unit. */
|
||||
static GTY(()) tree current_translation_unit;
|
||||
|
||||
|
||||
/* Prepare expr to be an argument of a TRUTH_NOT_EXPR,
|
||||
or validate its data type for an `if' or `while' statement or ?..: exp.
|
||||
|
||||
This preparation consists of taking the ordinary
|
||||
representation of an expression expr and producing a valid tree
|
||||
boolean expression describing whether expr is nonzero. We could
|
||||
simply always do build_binary_op (NE_EXPR, expr, boolean_false_node, 1),
|
||||
but we optimize comparisons, &&, ||, and !.
|
||||
|
||||
The resulting type should always be `boolean_type_node'.
|
||||
This is much simpler than the corresponding C version because we have a
|
||||
distinct boolean type. */
|
||||
|
||||
tree
|
||||
gfc_truthvalue_conversion (tree expr)
|
||||
{
|
||||
switch (TREE_CODE (TREE_TYPE (expr)))
|
||||
{
|
||||
case BOOLEAN_TYPE:
|
||||
if (TREE_TYPE (expr) == boolean_type_node)
|
||||
return expr;
|
||||
else if (COMPARISON_CLASS_P (expr))
|
||||
{
|
||||
TREE_TYPE (expr) = boolean_type_node;
|
||||
return expr;
|
||||
}
|
||||
else if (TREE_CODE (expr) == NOP_EXPR)
|
||||
return fold_build1_loc (input_location, NOP_EXPR,
|
||||
boolean_type_node, TREE_OPERAND (expr, 0));
|
||||
else
|
||||
return fold_build1_loc (input_location, NOP_EXPR, boolean_type_node,
|
||||
expr);
|
||||
|
||||
case INTEGER_TYPE:
|
||||
if (TREE_CODE (expr) == INTEGER_CST)
|
||||
return integer_zerop (expr) ? boolean_false_node : boolean_true_node;
|
||||
else
|
||||
return fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
|
||||
expr, build_int_cst (TREE_TYPE (expr), 0));
|
||||
|
||||
default:
|
||||
internal_error ("Unexpected type in truthvalue_conversion");
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void
|
||||
gfc_create_decls (void)
|
||||
{
|
||||
|
|
@ -255,7 +195,9 @@ gfc_be_parse_file (void)
|
|||
errorcount += errors;
|
||||
warningcount += warnings;
|
||||
|
||||
clear_binding_stack ();
|
||||
/* Clear the binding level stack. */
|
||||
while (!global_bindings_p ())
|
||||
poplevel (0, 0);
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -322,16 +264,6 @@ gfc_write_global_declarations (void)
|
|||
write_global_declarations ();
|
||||
}
|
||||
|
||||
|
||||
static void
|
||||
gfc_print_identifier (FILE * file ATTRIBUTE_UNUSED,
|
||||
tree node ATTRIBUTE_UNUSED,
|
||||
int indent ATTRIBUTE_UNUSED)
|
||||
{
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
/* These functions and variables deal with binding contours. We only
|
||||
need these functions for the list of PARM_DECLs, but we leave the
|
||||
functions more general; these are a simplified version of the
|
||||
|
|
@ -351,9 +283,7 @@ struct GTY(())
|
|||
binding_level {
|
||||
/* A chain of ..._DECL nodes for all variables, constants, functions,
|
||||
parameters and type declarations. These ..._DECL nodes are chained
|
||||
through the DECL_CHAIN field. Note that these ..._DECL nodes are stored
|
||||
in the reverse of the order supplied to be compatible with the
|
||||
back-end. */
|
||||
through the DECL_CHAIN field. */
|
||||
tree names;
|
||||
/* For each level (except the global one), a chain of BLOCK nodes for all
|
||||
the levels that were entered and exited one level down from this one. */
|
||||
|
|
@ -387,11 +317,10 @@ getdecls (void)
|
|||
return current_binding_level->names;
|
||||
}
|
||||
|
||||
/* Enter a new binding level. The input parameter is ignored, but has to be
|
||||
specified for back-end compatibility. */
|
||||
/* Enter a new binding level. */
|
||||
|
||||
void
|
||||
pushlevel (int ignore ATTRIBUTE_UNUSED)
|
||||
pushlevel (void)
|
||||
{
|
||||
struct binding_level *newlevel = ggc_alloc_binding_level ();
|
||||
|
||||
|
|
@ -413,29 +342,19 @@ pushlevel (int ignore ATTRIBUTE_UNUSED)
|
|||
|
||||
If FUNCTIONBODY is nonzero, this level is the body of a function,
|
||||
so create a block as if KEEP were set and also clear out all
|
||||
label names.
|
||||
|
||||
If REVERSE is nonzero, reverse the order of decls before putting
|
||||
them into the BLOCK. */
|
||||
label names. */
|
||||
|
||||
tree
|
||||
poplevel (int keep, int reverse, int functionbody)
|
||||
poplevel (int keep, int functionbody)
|
||||
{
|
||||
/* Points to a BLOCK tree node. This is the BLOCK node constructed for the
|
||||
binding level that we are about to exit and which is returned by this
|
||||
routine. */
|
||||
tree block_node = NULL_TREE;
|
||||
tree decl_chain;
|
||||
tree decl_chain = current_binding_level->names;
|
||||
tree subblock_chain = current_binding_level->blocks;
|
||||
tree subblock_node;
|
||||
|
||||
/* Reverse the list of XXXX_DECL nodes if desired. Note that the ..._DECL
|
||||
nodes chained through the `names' field of current_binding_level are in
|
||||
reverse order except for PARM_DECL node, which are explicitly stored in
|
||||
the right order. */
|
||||
decl_chain = (reverse) ? nreverse (current_binding_level->names)
|
||||
: current_binding_level->names;
|
||||
|
||||
/* If there were any declarations in the current binding level, or if this
|
||||
binding level is a function body, or if there are any nested blocks then
|
||||
create a BLOCK node to record them for the life of this function. */
|
||||
|
|
@ -513,10 +432,7 @@ pushdecl (tree decl)
|
|||
DECL_CONTEXT (decl) = current_function_decl;
|
||||
}
|
||||
|
||||
/* Put the declaration on the list. The list of declarations is in reverse
|
||||
order. The list will be reversed later if necessary. This needs to be
|
||||
this way for compatibility with the back-end. */
|
||||
|
||||
/* Put the declaration on the list. */
|
||||
DECL_CHAIN (decl) = current_binding_level->names;
|
||||
current_binding_level->names = decl;
|
||||
|
||||
|
|
@ -548,16 +464,6 @@ pushdecl_top_level (tree x)
|
|||
return t;
|
||||
}
|
||||
|
||||
|
||||
/* Clear the binding stack. */
|
||||
static void
|
||||
clear_binding_stack (void)
|
||||
{
|
||||
while (!global_bindings_p ())
|
||||
poplevel (0, 0, 0);
|
||||
}
|
||||
|
||||
|
||||
#ifndef CHAR_TYPE_SIZE
|
||||
#define CHAR_TYPE_SIZE BITS_PER_UNIT
|
||||
#endif
|
||||
|
|
@ -582,7 +488,7 @@ gfc_init_decl_processing (void)
|
|||
|
||||
/* Make the binding_level structure for global names. We move all
|
||||
variables that are in a COMMON block to this binding level. */
|
||||
pushlevel (0);
|
||||
pushlevel ();
|
||||
global_binding_level = current_binding_level;
|
||||
|
||||
/* Build common tree nodes. char_type_node is unsigned because we
|
||||
|
|
@ -617,17 +523,11 @@ gfc_get_alias_set (tree t)
|
|||
return -1;
|
||||
}
|
||||
|
||||
|
||||
/* press the big red button - garbage (ggc) collection is on */
|
||||
|
||||
int ggc_p = 1;
|
||||
|
||||
/* Builtin function initialization. */
|
||||
|
||||
tree
|
||||
static tree
|
||||
gfc_builtin_function (tree decl)
|
||||
{
|
||||
make_decl_rtl (decl);
|
||||
pushdecl (decl);
|
||||
return decl;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -2256,7 +2256,7 @@ trans_function_start (gfc_symbol * sym)
|
|||
init_function_start (fndecl);
|
||||
|
||||
/* function.c requires a push at the start of the function. */
|
||||
pushlevel (0);
|
||||
pushlevel ();
|
||||
}
|
||||
|
||||
/* Create thunks for alternate entry points. */
|
||||
|
|
@ -2398,7 +2398,7 @@ build_entry_thunks (gfc_namespace * ns, bool global)
|
|||
/* Finish off this function and send it for code generation. */
|
||||
DECL_SAVED_TREE (thunk_fndecl) = gfc_finish_block (&body);
|
||||
tmp = getdecls ();
|
||||
poplevel (1, 0, 1);
|
||||
poplevel (1, 1);
|
||||
BLOCK_SUPERCONTEXT (DECL_INITIAL (thunk_fndecl)) = thunk_fndecl;
|
||||
DECL_SAVED_TREE (thunk_fndecl)
|
||||
= build3_v (BIND_EXPR, tmp, DECL_SAVED_TREE (thunk_fndecl),
|
||||
|
|
@ -4400,7 +4400,7 @@ generate_coarray_init (gfc_namespace * ns __attribute((unused)))
|
|||
make_decl_rtl (fndecl);
|
||||
init_function_start (fndecl);
|
||||
|
||||
pushlevel (0);
|
||||
pushlevel ();
|
||||
gfc_init_block (&caf_init_block);
|
||||
|
||||
gfc_traverse_ns (ns, generate_coarray_sym_init);
|
||||
|
|
@ -4408,7 +4408,7 @@ generate_coarray_init (gfc_namespace * ns __attribute((unused)))
|
|||
DECL_SAVED_TREE (fndecl) = gfc_finish_block (&caf_init_block);
|
||||
decl = getdecls ();
|
||||
|
||||
poplevel (1, 0, 1);
|
||||
poplevel (1, 1);
|
||||
BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl;
|
||||
|
||||
DECL_SAVED_TREE (fndecl)
|
||||
|
|
@ -4971,7 +4971,7 @@ create_main_function (tree fndecl)
|
|||
rest_of_decl_compilation (ftn_main, 1, 0);
|
||||
make_decl_rtl (ftn_main);
|
||||
init_function_start (ftn_main);
|
||||
pushlevel (0);
|
||||
pushlevel ();
|
||||
|
||||
gfc_init_block (&body);
|
||||
|
||||
|
|
@ -5139,7 +5139,7 @@ create_main_function (tree fndecl)
|
|||
decl = getdecls ();
|
||||
|
||||
/* Finish off this function and send it for code generation. */
|
||||
poplevel (1, 0, 1);
|
||||
poplevel (1, 1);
|
||||
BLOCK_SUPERCONTEXT (DECL_INITIAL (ftn_main)) = ftn_main;
|
||||
|
||||
DECL_SAVED_TREE (ftn_main)
|
||||
|
|
@ -5428,7 +5428,7 @@ gfc_generate_function_code (gfc_namespace * ns)
|
|||
decl = getdecls ();
|
||||
|
||||
/* Finish off this function and send it for code generation. */
|
||||
poplevel (1, 0, 1);
|
||||
poplevel (1, 1);
|
||||
BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl;
|
||||
|
||||
DECL_SAVED_TREE (fndecl)
|
||||
|
|
@ -5522,7 +5522,7 @@ gfc_generate_constructors (void)
|
|||
|
||||
init_function_start (fndecl);
|
||||
|
||||
pushlevel (0);
|
||||
pushlevel ();
|
||||
|
||||
for (; gfc_static_ctors; gfc_static_ctors = TREE_CHAIN (gfc_static_ctors))
|
||||
{
|
||||
|
|
@ -5532,7 +5532,7 @@ gfc_generate_constructors (void)
|
|||
}
|
||||
|
||||
decl = getdecls ();
|
||||
poplevel (1, 0, 1);
|
||||
poplevel (1, 1);
|
||||
|
||||
BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl;
|
||||
DECL_SAVED_TREE (fndecl)
|
||||
|
|
|
|||
|
|
@ -651,7 +651,7 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
|
|||
gcc_assert (t == SUCCESS);
|
||||
|
||||
/* Create the init statement list. */
|
||||
pushlevel (0);
|
||||
pushlevel ();
|
||||
if (GFC_DESCRIPTOR_TYPE_P (type)
|
||||
&& GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE)
|
||||
{
|
||||
|
|
@ -691,13 +691,13 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
|
|||
else
|
||||
stmt = gfc_trans_assignment (e1, e2, false, false);
|
||||
if (TREE_CODE (stmt) != BIND_EXPR)
|
||||
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
|
||||
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
|
||||
else
|
||||
poplevel (0, 0, 0);
|
||||
poplevel (0, 0);
|
||||
OMP_CLAUSE_REDUCTION_INIT (c) = stmt;
|
||||
|
||||
/* Create the merge statement list. */
|
||||
pushlevel (0);
|
||||
pushlevel ();
|
||||
if (GFC_DESCRIPTOR_TYPE_P (type)
|
||||
&& GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE)
|
||||
{
|
||||
|
|
@ -714,9 +714,9 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
|
|||
else
|
||||
stmt = gfc_trans_assignment (e3, e4, false, true);
|
||||
if (TREE_CODE (stmt) != BIND_EXPR)
|
||||
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
|
||||
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
|
||||
else
|
||||
poplevel (0, 0, 0);
|
||||
poplevel (0, 0);
|
||||
OMP_CLAUSE_REDUCTION_MERGE (c) = stmt;
|
||||
|
||||
/* And stick the placeholder VAR_DECL into the clause as well. */
|
||||
|
|
@ -1001,20 +1001,20 @@ gfc_trans_omp_code (gfc_code *code, bool force_empty)
|
|||
{
|
||||
tree stmt;
|
||||
|
||||
pushlevel (0);
|
||||
pushlevel ();
|
||||
stmt = gfc_trans_code (code);
|
||||
if (TREE_CODE (stmt) != BIND_EXPR)
|
||||
{
|
||||
if (!IS_EMPTY_STMT (stmt) || force_empty)
|
||||
{
|
||||
tree block = poplevel (1, 0, 0);
|
||||
tree block = poplevel (1, 0);
|
||||
stmt = build3_v (BIND_EXPR, NULL, stmt, block);
|
||||
}
|
||||
else
|
||||
poplevel (0, 0, 0);
|
||||
poplevel (0, 0);
|
||||
}
|
||||
else
|
||||
poplevel (0, 0, 0);
|
||||
poplevel (0, 0);
|
||||
return stmt;
|
||||
}
|
||||
|
||||
|
|
@ -1501,7 +1501,7 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
|
|||
|
||||
if (pblock != &block)
|
||||
{
|
||||
pushlevel (0);
|
||||
pushlevel ();
|
||||
gfc_start_block (&block);
|
||||
}
|
||||
|
||||
|
|
@ -1612,12 +1612,12 @@ gfc_trans_omp_parallel_do (gfc_code *code)
|
|||
if (!do_clauses.ordered && do_clauses.sched_kind != OMP_SCHED_STATIC)
|
||||
pblock = █
|
||||
else
|
||||
pushlevel (0);
|
||||
pushlevel ();
|
||||
stmt = gfc_trans_omp_do (code, pblock, &do_clauses, omp_clauses);
|
||||
if (TREE_CODE (stmt) != BIND_EXPR)
|
||||
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
|
||||
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
|
||||
else
|
||||
poplevel (0, 0, 0);
|
||||
poplevel (0, 0);
|
||||
stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt,
|
||||
omp_clauses);
|
||||
OMP_PARALLEL_COMBINED (stmt) = 1;
|
||||
|
|
@ -1638,12 +1638,12 @@ gfc_trans_omp_parallel_sections (gfc_code *code)
|
|||
gfc_start_block (&block);
|
||||
omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
|
||||
code->loc);
|
||||
pushlevel (0);
|
||||
pushlevel ();
|
||||
stmt = gfc_trans_omp_sections (code, §ion_clauses);
|
||||
if (TREE_CODE (stmt) != BIND_EXPR)
|
||||
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
|
||||
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
|
||||
else
|
||||
poplevel (0, 0, 0);
|
||||
poplevel (0, 0);
|
||||
stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt,
|
||||
omp_clauses);
|
||||
OMP_PARALLEL_COMBINED (stmt) = 1;
|
||||
|
|
@ -1664,12 +1664,12 @@ gfc_trans_omp_parallel_workshare (gfc_code *code)
|
|||
gfc_start_block (&block);
|
||||
omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
|
||||
code->loc);
|
||||
pushlevel (0);
|
||||
pushlevel ();
|
||||
stmt = gfc_trans_omp_workshare (code, &workshare_clauses);
|
||||
if (TREE_CODE (stmt) != BIND_EXPR)
|
||||
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
|
||||
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
|
||||
else
|
||||
poplevel (0, 0, 0);
|
||||
poplevel (0, 0);
|
||||
stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt,
|
||||
omp_clauses);
|
||||
OMP_PARALLEL_COMBINED (stmt) = 1;
|
||||
|
|
@ -1763,7 +1763,7 @@ gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses)
|
|||
|
||||
code = code->block->next;
|
||||
|
||||
pushlevel (0);
|
||||
pushlevel ();
|
||||
|
||||
gfc_start_block (&block);
|
||||
pblock = █
|
||||
|
|
@ -1892,14 +1892,14 @@ gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses)
|
|||
{
|
||||
if (!IS_EMPTY_STMT (stmt))
|
||||
{
|
||||
tree bindblock = poplevel (1, 0, 0);
|
||||
tree bindblock = poplevel (1, 0);
|
||||
stmt = build3_v (BIND_EXPR, NULL, stmt, bindblock);
|
||||
}
|
||||
else
|
||||
poplevel (0, 0, 0);
|
||||
poplevel (0, 0);
|
||||
}
|
||||
else
|
||||
poplevel (0, 0, 0);
|
||||
poplevel (0, 0);
|
||||
|
||||
if (IS_EMPTY_STMT (stmt) && !clauses->nowait)
|
||||
stmt = gfc_trans_omp_barrier ();
|
||||
|
|
|
|||
|
|
@ -182,7 +182,7 @@ void
|
|||
gfc_start_block (stmtblock_t * block)
|
||||
{
|
||||
/* Start a new binding level. */
|
||||
pushlevel (0);
|
||||
pushlevel ();
|
||||
block->has_scope = 1;
|
||||
|
||||
/* The block is empty. */
|
||||
|
|
@ -215,7 +215,7 @@ gfc_merge_block_scope (stmtblock_t * block)
|
|||
|
||||
/* Remember the decls in this scope. */
|
||||
decl = getdecls ();
|
||||
poplevel (0, 0, 0);
|
||||
poplevel (0, 0);
|
||||
|
||||
/* Add them to the parent scope. */
|
||||
while (decl != NULL_TREE)
|
||||
|
|
@ -250,11 +250,11 @@ gfc_finish_block (stmtblock_t * stmtblock)
|
|||
|
||||
if (decl)
|
||||
{
|
||||
block = poplevel (1, 0, 0);
|
||||
block = poplevel (1, 0);
|
||||
expr = build3_v (BIND_EXPR, decl, expr, block);
|
||||
}
|
||||
else
|
||||
poplevel (0, 0, 0);
|
||||
poplevel (0, 0);
|
||||
}
|
||||
|
||||
return expr;
|
||||
|
|
|
|||
|
|
@ -427,8 +427,6 @@ int gfc_conv_procedure_call (gfc_se *, gfc_symbol *, gfc_actual_arglist *,
|
|||
|
||||
void gfc_conv_subref_array_arg (gfc_se *, gfc_expr *, int, sym_intent, bool);
|
||||
|
||||
/* gfc_trans_* shouldn't call push/poplevel, use gfc_push/pop_scope */
|
||||
|
||||
/* Generate code for a scalar assignment. */
|
||||
tree gfc_trans_scalar_assign (gfc_se *, gfc_se *, gfc_typespec, bool, bool,
|
||||
bool);
|
||||
|
|
@ -632,11 +630,9 @@ void gfc_trans_deferred_vars (gfc_symbol*, gfc_wrapped_block *);
|
|||
/* In f95-lang.c. */
|
||||
tree pushdecl (tree);
|
||||
tree pushdecl_top_level (tree);
|
||||
void pushlevel (int);
|
||||
tree poplevel (int, int, int);
|
||||
void pushlevel (void);
|
||||
tree poplevel (int, int);
|
||||
tree getdecls (void);
|
||||
tree gfc_truthvalue_conversion (tree);
|
||||
tree gfc_builtin_function (tree);
|
||||
|
||||
/* In trans-types.c. */
|
||||
struct array_descr_info;
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue