procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

f95-lang.c (poplevel): Don't clear BLOCK_VARS if functionbody.

Browse source 
* f95-lang.c (poplevel): Don't clear BLOCK_VARS if functionbody.
	* trans-decl.c (gfc_build_qualified_array): Build accurate debug type
	even if nest.
	(build_entry_thunks, gfc_generate_function_code,
	gfc_generate_constructors): Ensure DECL_SAVED_TREE is a BIND_EXPR
	with DECL_INITIAL as its BLOCK.

From-SVN: r140945
This commit is contained in:
Jakub Jelinek 2008-10-07 20:15:32 +02:00 • committed by Jakub Jelinek
parent a107f08636
commit c7c79a09d6
3 changed files with 27 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
gcc/fortran/ChangeLog
View file

@ -1,3 +1,12 @@
2008-10-07 Jakub Jelinek <jakub@redhat.com>
* f95-lang.c (poplevel): Don't clear BLOCK_VARS if functionbody.
* trans-decl.c (gfc_build_qualified_array): Build accurate debug type
even if nest.
(build_entry_thunks, gfc_generate_function_code,
gfc_generate_constructors): Ensure DECL_SAVED_TREE is a BIND_EXPR
with DECL_INITIAL as its BLOCK.
2008-10-05 Paul Thomas <pault@gcc.gnu.org>
PR fortran/35680

10
gcc/fortran/f95-lang.c
View file

@ -430,14 +430,8 @@ poplevel (int keep, int reverse, int functionbody)
current_binding_level = current_binding_level->level_chain;
if (functionbody)
{
/* This is the top level block of a function. The ..._DECL chain stored
in BLOCK_VARS are the function's parameters (PARM_DECL nodes). Don't
leave them in the BLOCK because they are found in the FUNCTION_DECL
instead. */
DECL_INITIAL (current_function_decl) = block_node;
BLOCK_VARS (block_node) = 0;
}
/* This is the top level block of a function. */
DECL_INITIAL (current_function_decl) = block_node;
else if (current_binding_level == global_binding_level)
/* When using gfc_start_block/gfc_finish_block from middle-end hooks,
don't add newly created BLOCKs as subblocks of global_binding_level. */

19
gcc/fortran/trans-decl.c
View file

@ -704,7 +704,7 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym)
layout_type (type);
}
if (nest || write_symbols == NO_DEBUG)
if (write_symbols == NO_DEBUG)
return;
if (TYPE_NAME (type) != NULL_TREE
@ -1761,7 +1761,7 @@ build_entry_thunks (gfc_namespace * ns)
thunk_fndecl = thunk_sym->backend_decl;
gfc_start_block (&body);
gfc_init_block (&body);
/* Pass extra parameter identifying this entry point. */
tmp = build_int_cst (gfc_array_index_type, el->id);
@ -1869,8 +1869,12 @@ build_entry_thunks (gfc_namespace * ns)
/* 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);
BLOCK_SUPERCONTEXT (DECL_INITIAL (thunk_fndecl)) = thunk_fndecl;
DECL_SAVED_TREE (thunk_fndecl)
= build3_v (BIND_EXPR, tmp, DECL_SAVED_TREE (thunk_fndecl),
DECL_INITIAL (thunk_fndecl));
/* Output the GENERIC tree. */
dump_function (TDI_original, thunk_fndecl);
@ -3652,7 +3656,7 @@ gfc_generate_function_code (gfc_namespace * ns)
trans_function_start (sym);
gfc_start_block (&block);
gfc_init_block (&block);
if (ns->entries && ns->proc_name->ts.type == BT_CHARACTER)
{
@ -3886,11 +3890,16 @@ gfc_generate_function_code (gfc_namespace * ns)
saved_function_decls = NULL_TREE;
DECL_SAVED_TREE (fndecl) = gfc_finish_block (&block);
decl = getdecls ();
/* Finish off this function and send it for code generation. */
poplevel (1, 0, 1);
BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl;
DECL_SAVED_TREE (fndecl)
= build3_v (BIND_EXPR, decl, DECL_SAVED_TREE (fndecl),
DECL_INITIAL (fndecl));
/* Output the GENERIC tree. */
dump_function (TDI_original, fndecl);
@ -3969,9 +3978,13 @@ gfc_generate_constructors (void)
DECL_SAVED_TREE (fndecl) = build_stmt (EXPR_STMT, tmp);
}
decl = getdecls ();
poplevel (1, 0, 1);
BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl;
DECL_SAVED_TREE (fndecl)
= build3_v (BIND_EXPR, decl, DECL_SAVED_TREE (fndecl),
DECL_INITIAL (fndecl));
free_after_parsing (cfun);
free_after_compilation (cfun);