From a107f086365bc6adb37c6d81f029af3d7fc73c52 Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Tue, 7 Oct 2008 20:14:16 +0200 Subject: [PATCH] re PR debug/37738 (Fortran DW_TAG_common_block has incorrect placement/scope) PR debug/37738 * dwarf2out.c (common_block_die_table): New variable. (common_block_die_table_hash, common_block_die_table_eq): New functions. (gen_variable_die): Look up a DW_TAG_common_block die for a particular COMMON block in the current scope rather than globally. Optimize DW_OP_addr SYMBOL_REF DW_OP_plus_uconst off into DW_OP_addr SYMBOL_REF+off. * gfortran.dg/debug/pr37738.f: New test. From-SVN: r140944 --- gcc/ChangeLog | 11 ++++ gcc/dwarf2out.c | 67 +++++++++++++++++++++-- gcc/testsuite/ChangeLog | 5 ++ gcc/testsuite/gfortran.dg/debug/pr37738.f | 30 ++++++++++ 4 files changed, 109 insertions(+), 4 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/debug/pr37738.f diff --git a/gcc/ChangeLog b/gcc/ChangeLog index a2c1ae337b1..5582866162a 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,14 @@ +2008-10-07 Jakub Jelinek + + PR debug/37738 + * dwarf2out.c (common_block_die_table): New variable. + (common_block_die_table_hash, common_block_die_table_eq): New + functions. + (gen_variable_die): Look up a DW_TAG_common_block die for a particular + COMMON block in the current scope rather than globally. Optimize + DW_OP_addr SYMBOL_REF DW_OP_plus_uconst off into + DW_OP_addr SYMBOL_REF+off. + 2008-10-07 Eric Botcazou * tree-ssa-loop-ivopts.c (may_be_nonaddressable_p) : diff --git a/gcc/dwarf2out.c b/gcc/dwarf2out.c index 37bf21f07a2..ed4d74d0e51 100644 --- a/gcc/dwarf2out.c +++ b/gcc/dwarf2out.c @@ -4748,6 +4748,10 @@ static GTY((param_is (struct dwarf_file_data))) htab_t file_table; The key is a DECL_UID() which is a unique number identifying each decl. */ static GTY ((param_is (struct die_struct))) htab_t decl_die_table; +/* A hash table of references to DIE's that describe COMMON blocks. + The key is DECL_UID() ^ die_parent. */ +static GTY ((param_is (struct die_struct))) htab_t common_block_die_table; + /* Node of the variable location list. */ struct var_loc_node GTY ((chain_next ("%h.next"))) { @@ -4960,6 +4964,8 @@ static void equate_type_number_to_die (tree, dw_die_ref); static hashval_t decl_die_table_hash (const void *); static int decl_die_table_eq (const void *, const void *); static dw_die_ref lookup_decl_die (tree); +static hashval_t common_block_die_table_hash (const void *); +static int common_block_die_table_eq (const void *, const void *); static hashval_t decl_loc_table_hash (const void *); static int decl_loc_table_eq (const void *, const void *); static var_loc_list *lookup_decl_loc (const_tree); @@ -13812,6 +13818,26 @@ gen_subprogram_die (tree decl, dw_die_ref context_die) } +/* Returns a hash value for X (which really is a die_struct). */ + +static hashval_t +common_block_die_table_hash (const void *x) +{ + const_dw_die_ref d = (const_dw_die_ref) x; + return (hashval_t) d->decl_id ^ htab_hash_pointer (d->die_parent); +} + +/* Return nonzero if decl_id and die_parent of die_struct X is the same + as decl_id and die_parent of die_struct Y. */ + +static int +common_block_die_table_eq (const void *x, const void *y) +{ + const_dw_die_ref d = (const_dw_die_ref) x; + const_dw_die_ref e = (const_dw_die_ref) y; + return d->decl_id == e->decl_id && d->die_parent == e->die_parent; +} + /* Generate a DIE to represent a declared data object. */ static void @@ -13853,6 +13879,7 @@ gen_variable_die (tree decl, dw_die_ref context_die) tree field; dw_die_ref com_die; dw_loc_descr_ref loc; + die_node com_die_arg; var_die = lookup_decl_die (decl); if (var_die) @@ -13863,21 +13890,41 @@ gen_variable_die (tree decl, dw_die_ref context_die) if (loc) { if (off) - add_loc_descr (&loc, new_loc_descr (DW_OP_plus_uconst, + { + /* Optimize the common case. */ + if (loc->dw_loc_opc == DW_OP_addr + && loc->dw_loc_next == NULL + && GET_CODE (loc->dw_loc_oprnd1.v.val_addr) + == SYMBOL_REF) + loc->dw_loc_oprnd1.v.val_addr + = plus_constant (loc->dw_loc_oprnd1.v.val_addr, off); + else + add_loc_descr (&loc, + new_loc_descr (DW_OP_plus_uconst, off, 0)); + } add_AT_loc (var_die, DW_AT_location, loc); remove_AT (var_die, DW_AT_declaration); } } return; } + + if (common_block_die_table == NULL) + common_block_die_table + = htab_create_ggc (10, common_block_die_table_hash, + common_block_die_table_eq, NULL); + field = TREE_OPERAND (DECL_VALUE_EXPR (decl), 0); - com_die = lookup_decl_die (com_decl); + com_die_arg.decl_id = DECL_UID (com_decl); + com_die_arg.die_parent = context_die; + com_die = (dw_die_ref) htab_find (common_block_die_table, &com_die_arg); loc = loc_descriptor_from_tree (com_decl); if (com_die == NULL) { const char *cnam = IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (com_decl)); + void **slot; com_die = new_die (DW_TAG_common_block, context_die, decl); add_name_and_src_coords_attributes (com_die, com_decl); @@ -13891,7 +13938,9 @@ gen_variable_die (tree decl, dw_die_ref context_die) else if (DECL_EXTERNAL (decl)) add_AT_flag (com_die, DW_AT_declaration, 1); add_pubname_string (cnam, com_die); /* ??? needed? */ - equate_decl_number_to_die (com_decl, com_die); + com_die->decl_id = DECL_UID (com_decl); + slot = htab_find_slot (common_block_die_table, com_die, INSERT); + *slot = (void *) com_die; } else if (get_AT (com_die, DW_AT_location) == NULL && loc) { @@ -13907,7 +13956,17 @@ gen_variable_die (tree decl, dw_die_ref context_die) if (loc) { if (off) - add_loc_descr (&loc, new_loc_descr (DW_OP_plus_uconst, off, 0)); + { + /* Optimize the common case. */ + if (loc->dw_loc_opc == DW_OP_addr + && loc->dw_loc_next == NULL + && GET_CODE (loc->dw_loc_oprnd1.v.val_addr) == SYMBOL_REF) + loc->dw_loc_oprnd1.v.val_addr + = plus_constant (loc->dw_loc_oprnd1.v.val_addr, off); + else + add_loc_descr (&loc, new_loc_descr (DW_OP_plus_uconst, + off, 0)); + } add_AT_loc (var_die, DW_AT_location, loc); } else if (DECL_EXTERNAL (decl)) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 4ad05b06a82..d3fdf004267 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2008-10-07 Jakub Jelinek + + PR debug/37738 + * gfortran.dg/debug/pr37738.f: New test. + 2008-10-07 Eric Botcazou * gnat.dg/loop_optimization4.adb: New test. diff --git a/gcc/testsuite/gfortran.dg/debug/pr37738.f b/gcc/testsuite/gfortran.dg/debug/pr37738.f new file mode 100644 index 00000000000..b0a787b2e52 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/debug/pr37738.f @@ -0,0 +1,30 @@ +C PR debug/37738 +C { dg-do compile } +C { dg-skip-if "DWARF-2 only" { "*-*-*" } { "*" } { "-gdwarf-2" } } +C { dg-options "-dA" } + + subroutine a + integer*4 a_i, c_i + common /block/a_i, c_i + a_i = 1 + c_i = 4 + end subroutine a + subroutine b + integer*4 b_i + common /block/b_i, d_i + b_i = 2 + d_i = 5 + end subroutine b + subroutine c + integer*4 a_i, c_i + common /block/a_i, c_i + if (a_i .ne. 2) call abort + if (c_i .ne. 5) call abort + end subroutine c + program abc + call a + call b + call c + end program abc + +C { dg-final { scan-assembler-times "DIE\[^\n\]*DW_TAG_common_block" 3 } }