[PATCH,dwarf,gfortran] Change DWARF-2 output for Fortran COMMON symbols

[George Helffrich <george at geology dot bristol dot ac dot uk>]

Dear List -

This patch changes the way that Fortran COMMON symbols are represented 
in DWARF output
to use the DW_TAG_common_block tag.  This fixes problems that arise, on 
some systems (e.g. Darwin) with relocating symbols in .comm.  The patch 
has no effect on non-Fortran
.comm symbols.

The patch is against the 4.3-20070810 snapshot (reason: builds a 
working gfortran).

Tested on powerpc-apple-darwin8.8.0, i386-apple-darwin8.10.1, 
sparc64-unknown-freebsd6.0.
(n.b. Darwin systems require a patched gdb, sigh -- see Radar 5579453 
for the GDB patch)

Passes gcc/testsuite/gcc.dg/debug/dwarf2/dwarf2.exp (... and others)

2007-11-5  George Helffrich  <ghfbsd@gly.bris.ac.uk>

       *dwarf2out.c (gen_decl_die, decls_for_scope): Output DWARF DIE
       for symbols in Fortran common using DW_AT_common_block.  This 
allows
       some GDB ports (e.g. Darwin) to relocate references to COMMON 
data
       properly.
       (add_pubname_string, add_pubname, dw_expand_expr, common_check): 
New
       routines for ditto.

--- gcc/dwarf2out.c.orig    Wed Aug  8 23:29:12 2007
+++ gcc/dwarf2out.c Sun Nov  4 15:45:34 2007
@@ -7405,18 +7405,24 @@
 /* Add a new entry to .debug_pubnames if appropriate.  */

 static void
-add_pubname (tree decl, dw_die_ref die)
+add_pubname_string (const char *str, dw_die_ref die)
 {
   pubname_entry e;

-  if (! TREE_PUBLIC (decl))
-    return;
-
   e.die = die;
-  e.name = xstrdup (dwarf2_name (decl, 1));
+  e.name = xstrdup(str);
   VEC_safe_push (pubname_entry, gc, pubname_table, &e);
 }

+static void
+add_pubname (tree decl, dw_die_ref die)
+{
+
+  if (TREE_PUBLIC (decl))
+    add_pubname_string (dwarf2_name (decl, 1), die);
+
+}
+
 /* Add a new entry to .debug_pubtypes if appropriate.  */

 static void
@@ -10377,6 +10383,63 @@
   return rtl;
 }

+/* This is a specialized subset of expand_expr to evaluate a 
DECL_VALUE_EXPR.
+   We stop if we find decls that haven't been expanded, or if the 
expression is
+   getting so complex we won't be able to represent it anyway.  
Returns NULL on
+   failure.  */
+
+static rtx
+dw_expand_expr (tree expr)
+{
+  switch (TREE_CODE (expr))
+    {
+    case VAR_DECL:
+    case PARM_DECL:
+      if (DECL_HAS_VALUE_EXPR_P (expr))
+       return dw_expand_expr (DECL_VALUE_EXPR (expr));
+      /* FALLTHRU */
+
+    case CONST_DECL:
+    case RESULT_DECL:
+      return DECL_RTL_IF_SET (expr);
+
+    case INTEGER_CST:
+      return expand_expr (expr, NULL_RTX, VOIDmode, 
EXPAND_INITIALIZER);
+
+    case COMPONENT_REF:
+    case ARRAY_REF:
+    case ARRAY_RANGE_REF:
+    case BIT_FIELD_REF:
+      {
+       enum machine_mode mode;
+       HOST_WIDE_INT bitsize, bitpos;
+       tree offset, tem;
+       int volatilep = 0, unsignedp = 0;
+       rtx x;
+
+       tem = get_inner_reference (expr, &bitsize, &bitpos, &offset,
+                                  &mode, &unsignedp, &volatilep, true);
+
+       x = dw_expand_expr (tem);
+       if (x == NULL || !MEM_P (x))
+         return NULL;
+       if (offset != NULL)
+         {
+           if (!host_integerp (offset, 0))
+             return NULL;
+           x = adjust_address_nv (x, mode, tree_low_cst (offset, 0));
+         }
+       if (bitpos != 0)
+         x = adjust_address_nv (x, mode, bitpos / BITS_PER_UNIT);
+
+       return x;
+      }
+
+    default:
+      return NULL;
+    }
+}
+
 /* Generate RTL for the variable DECL to represent its location.  */

 static rtx
@@ -10609,6 +10672,104 @@
   return secname;
 }

+/* Check whether decl is a COMMON symbol.  If not, NULL_RTX is 
returned.  If so,
+   the rtx for the SYMBOL_REF for the COMMON block is returned, and 
the value
+   is the offset into the common block for the symbol. */
+
+static rtx
+common_check (tree decl, HOST_WIDE_INT *value)
+{
+  rtx home;
+  rtx sym_addr;
+  rtx res = NULL_RTX;
+
+  /* If the decl isn't a VAR_DECL, or if it isn't public or static, or 
if
+     it does not have a value (the offset into the common area), or if 
it
+     is thread local (as opposed to global) then it isn't common, and 
shouldn't
+     be handled as such.  */
+  if (TREE_CODE (decl) != VAR_DECL
+      || !TREE_PUBLIC(decl)
+      || !TREE_STATIC(decl)
+      || !DECL_HAS_VALUE_EXPR_P(decl)
+      || DECL_THREAD_LOCAL_P (decl))
+    return NULL;
+
+  home = DECL_RTL (decl);
+  if (home == NULL_RTX || GET_CODE (home) != MEM)
+    return NULL;
+
+  sym_addr = dw_expand_expr (DECL_VALUE_EXPR (decl));
+  if (sym_addr == NULL_RTX || GET_CODE (sym_addr) != MEM)
+    return NULL;
+
+  sym_addr = XEXP (sym_addr, 0);
+  if (GET_CODE (sym_addr) == CONST)
+    sym_addr = XEXP (sym_addr, 0);
+  if ((GET_CODE (sym_addr) == SYMBOL_REF || GET_CODE (sym_addr) == 
PLUS)
+      && (DECL_INITIAL (decl) == 0
+            || (!strcmp (lang_hooks.name, "GNU C++")
+                 && DECL_INITIAL (decl) == error_mark_node)))
+    {
+
+      /* We have sym that will go into a common area, meaning that it
+         will get storage reserved with a .comm/.lcomm assembler 
pseudo-op.
+
+         Determine name of common area this symbol will be an offset 
into,
+         and offset into that area.  Also retrieve the decl for the 
area
+         that the symbol is offset into. */
+      tree cdecl = NULL;
+
+      switch (GET_CODE (sym_addr))
+        {
+          case PLUS:
+            if (GET_CODE (XEXP (sym_addr, 0)) == CONST_INT)
+              {
+               /*
+                name =
+                  targetm.strip_name_encoding(XSTR (XEXP (sym_addr, 
1), 0));
+               */
+               res = XEXP (sym_addr, 1);
+                *value = INTVAL (XEXP (sym_addr, 0));
+                cdecl = SYMBOL_REF_DECL (XEXP (sym_addr, 1));
+              }
+            else
+              {
+               /*
+                name =
+                  targetm.strip_name_encoding(XSTR (XEXP (sym_addr, 
0), 0));
+               */
+               res = XEXP (sym_addr, 0);
+                *value = INTVAL (XEXP (sym_addr, 1));
+                cdecl = SYMBOL_REF_DECL (XEXP (sym_addr, 0));
+              }
+            break;
+
+          case SYMBOL_REF:
+           /*
+            name = targetm.strip_name_encoding(XSTR (sym_addr, 0));
+           */
+           res = sym_addr;
+            *value = 0;
+            cdecl = SYMBOL_REF_DECL (sym_addr);
+            break;
+
+          default:
+            error ("common symbol debug info is not structured as "
+                  "symbol+offset");
+        }
+
+      /* Check area common symbol is offset into.  If this is not 
public, then
+        it is not a symbol in a common block.  It must be a .lcomm 
symbol, not
+        a .comm symbol.  */
+      if (cdecl == NULL || !TREE_PUBLIC(cdecl))
+        res = NULL_RTX;
+    }
+  else
+    res = NULL_RTX;
+
+  return res;
+}
+
 /* Generate *either* a DW_AT_location attribute or else a 
DW_AT_const_value
    data attribute for a variable or a parameter.  We generate the
    DW_AT_const_value attribute only in those cases where the given 
variable
@@ -12297,9 +12458,10 @@
 static void
 gen_variable_die (tree decl, dw_die_ref context_die)
 {
+  HOST_WIDE_INT off;
+  rtx csym;
+  dw_die_ref var_die;
   tree origin = decl_ultimate_origin (decl);
-  dw_die_ref var_die = new_die (DW_TAG_variable, context_die, decl);
-
   dw_die_ref old_die = lookup_decl_die (decl);
   int declaration = (DECL_EXTERNAL (decl)
                     /* If DECL is COMDAT and has not actually been
@@ -12323,6 +12485,35 @@
                         && DECL_COMDAT (decl) && !TREE_ASM_WRITTEN 
(decl))
                     || class_or_namespace_scope_p (context_die));

+  csym = common_check (decl, &off);
+
+  /* Symbol in common gets emitted as a child of the common block, in 
the form
+     of a data member.  Format of entry is rather tricky in order to be
+     acceptable to gdb's relocation mechanism for COMMON-based 
symbols. */
+  if (csym)
+    {
+      tree blok;
+      dw_die_ref com_die;
+      const char *cnam = targetm.strip_name_encoding(XSTR (csym, 0));
+      dw_loc_descr_ref loc = mem_loc_descriptor (csym, 
dw_val_class_addr,
+                                     VAR_INIT_STATUS_INITIALIZED);
+
+      blok = (tree) TREE_OPERAND (DECL_VALUE_EXPR (decl), 0);
+      var_die = new_die (DW_TAG_common_block, context_die, decl);
+      add_name_and_src_coords_attributes (var_die, blok);
+      add_AT_flag (var_die, DW_AT_external, 1);
+      add_AT_loc (var_die, DW_AT_location, loc);
+      com_die = new_die (DW_TAG_member, var_die, decl);
+      add_name_and_src_coords_attributes (com_die, decl);
+      add_type_attribute (com_die, TREE_TYPE (decl), TREE_READONLY 
(decl),
+                         TREE_THIS_VOLATILE (decl), context_die);
+      add_AT_loc (com_die, DW_AT_data_member_location, 
int_loc_descriptor(off));
+      add_pubname_string (cnam, var_die); /* ??? needed? */
+      return;
+    }
+
+  var_die = new_die (DW_TAG_variable, context_die, decl);
+
   if (origin != NULL)
     add_abstract_origin_attribute (var_die, origin);

@@ -13283,7 +13474,12 @@
             these might be optimized out.  We are called for these 
later
             in varpool_analyze_pending_decls. */
          if (TREE_CODE (decl) == VAR_DECL && TREE_STATIC (decl))
-           ;
+           {
+             /* ...but DO produce debug information for COMMON symbols 
*/
+             if (TREE_PUBLIC (decl) && DECL_HAS_VALUE_EXPR_P (decl) &&
+                 !DECL_THREAD_LOCAL_P (decl))
+               gen_decl_die (decl, context_die);
+           }
          else
            gen_decl_die (decl, context_die);
        }
@@ -13611,6 +13807,16 @@
         variable declarations or definitions.  */
       if (debug_info_level <= DINFO_LEVEL_TERSE)
        break;
+
+      /* If this is the global definition of the Fortran COMMON block, 
we don't
+         need to do anything.  Syntactically, the block itself has no 
identity,
+        just its constituent identifiers. */
+      if (TREE_CODE (decl) == VAR_DECL
+          && TREE_PUBLIC (decl)
+          && TREE_STATIC (decl)
+         && is_fortran ()
+         && !DECL_HAS_VALUE_EXPR_P (decl))
+        break;

       /* Output any DIEs that are needed to specify the type of this 
data
         object.  */