OSDN Git Service

2008-10-30 Catherine Moore <clm@codesourcery.com>
[pf3gnuchains/gcc-fork.git] / gcc / dwarf2out.c
index 4c6364c..614871e 100644 (file)
@@ -137,6 +137,9 @@ dwarf2out_do_cfi_asm (void)
 {
   int enc;
 
+#ifdef MIPS_DEBUGGING_INFO
+  return false;
+#endif
   if (!flag_dwarf2_cfi_asm || !dwarf2out_do_frame ())
     return false;
   if (!eh_personality_libfunc)
@@ -4486,6 +4489,8 @@ static bool dwarf2out_ignore_block (const_tree);
 static void dwarf2out_global_decl (tree);
 static void dwarf2out_type_decl (tree, int);
 static void dwarf2out_imported_module_or_decl (tree, tree, tree, bool);
+static void dwarf2out_imported_module_or_decl_1 (tree, tree, tree,
+                                                dw_die_ref);
 static void dwarf2out_abstract_function (tree);
 static void dwarf2out_var_location (rtx);
 static void dwarf2out_begin_function (tree);
@@ -4743,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")))
 {
@@ -4955,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);
@@ -4987,7 +4998,7 @@ static void record_comdat_symbol_number (dw_die_ref, htab_t, unsigned);
 static void add_sibling_attributes (dw_die_ref);
 static void build_abbrev_table (dw_die_ref);
 static void output_location_lists (dw_die_ref);
-static int constant_size (long unsigned);
+static int constant_size (unsigned HOST_WIDE_INT);
 static unsigned long size_of_die (dw_die_ref);
 static void calc_die_sizes (dw_die_ref);
 static void mark_dies (dw_die_ref);
@@ -5093,6 +5104,7 @@ static void gen_unspecified_parameters_die (tree, dw_die_ref);
 static void gen_formal_types_die (tree, dw_die_ref);
 static void gen_subprogram_die (tree, dw_die_ref);
 static void gen_variable_die (tree, dw_die_ref);
+static void gen_const_die (tree, dw_die_ref);
 static void gen_label_die (tree, dw_die_ref);
 static void gen_lexical_block_die (tree, dw_die_ref, int);
 static void gen_inlined_subroutine_die (tree, dw_die_ref, int);
@@ -7503,7 +7515,7 @@ build_abbrev_table (dw_die_ref die)
 /* Return the power-of-two number of bytes necessary to represent VALUE.  */
 
 static int
-constant_size (long unsigned int value)
+constant_size (unsigned HOST_WIDE_INT value)
 {
   int log;
 
@@ -7564,8 +7576,10 @@ size_of_die (dw_die_ref die)
          size += 1 + 2*HOST_BITS_PER_LONG/HOST_BITS_PER_CHAR; /* block */
          break;
        case dw_val_class_vec:
-         size += 1 + (a->dw_attr_val.v.val_vec.length
-                      * a->dw_attr_val.v.val_vec.elt_size); /* block */
+         size += constant_size (a->dw_attr_val.v.val_vec.length
+                                * a->dw_attr_val.v.val_vec.elt_size)
+                 + a->dw_attr_val.v.val_vec.length
+                   * a->dw_attr_val.v.val_vec.elt_size; /* block */
          break;
        case dw_val_class_flag:
          size += 1;
@@ -7764,7 +7778,18 @@ value_format (dw_attr_ref a)
     case dw_val_class_long_long:
       return DW_FORM_block1;
     case dw_val_class_vec:
-      return DW_FORM_block1;
+      switch (constant_size (a->dw_attr_val.v.val_vec.length
+                            * a->dw_attr_val.v.val_vec.elt_size))
+       {
+       case 1:
+         return DW_FORM_block1;
+       case 2:
+         return DW_FORM_block2;
+       case 4:
+         return DW_FORM_block4;
+       default:
+         gcc_unreachable ();
+       }
     case dw_val_class_flag:
       return DW_FORM_flag;
     case dw_val_class_die_ref:
@@ -8056,7 +8081,8 @@ output_die (dw_die_ref die)
            unsigned int i;
            unsigned char *p;
 
-           dw2_asm_output_data (1, len * elt_size, "%s", name);
+           dw2_asm_output_data (constant_size (len * elt_size),
+                                len * elt_size, "%s", name);
            if (elt_size > sizeof (HOST_WIDE_INT))
              {
                elt_size /= 2;
@@ -9872,6 +9898,48 @@ concatn_mem_loc_descriptor (rtx concatn, enum machine_mode mode,
   return cc_loc_result;
 }
 
+/* Try to handle TLS MEMs, for which mem_loc_descriptor on XEXP (mem, 0)
+   failed.  */
+
+static dw_loc_descr_ref
+tls_mem_loc_descriptor (rtx mem)
+{
+  tree base;
+  dw_loc_descr_ref loc_result, loc_result2;
+
+  if (MEM_EXPR (mem) == NULL_TREE || MEM_OFFSET (mem) == NULL_RTX)
+    return NULL;
+
+  base = get_base_address (MEM_EXPR (mem));
+  if (base == NULL
+      || TREE_CODE (base) != VAR_DECL
+      || !DECL_THREAD_LOCAL_P (base))
+    return NULL;
+
+  loc_result = loc_descriptor_from_tree_1 (MEM_EXPR (mem), 2);
+  if (loc_result == NULL)
+    return NULL;
+
+  if (INTVAL (MEM_OFFSET (mem)))
+    {
+      if (INTVAL (MEM_OFFSET (mem)) >= 0)
+       add_loc_descr (&loc_result,
+                      new_loc_descr (DW_OP_plus_uconst,
+                                     INTVAL (MEM_OFFSET (mem)), 0));
+      else
+       {
+         loc_result2 = mem_loc_descriptor (MEM_OFFSET (mem), GET_MODE (mem),
+                                           VAR_INIT_STATUS_INITIALIZED);
+         if (loc_result2 == 0)
+           return NULL;
+         add_loc_descr (&loc_result, loc_result2);
+         add_loc_descr (&loc_result, new_loc_descr (DW_OP_plus, 0, 0));
+       }
+    }
+
+  return loc_result;
+}
+
 /* The following routine converts the RTL for a variable or parameter
    (resident in memory) into an equivalent Dwarf representation of a
    mechanism for getting the address of that same variable onto the top of a
@@ -9940,11 +10008,23 @@ mem_loc_descriptor (rtx rtl, enum machine_mode mode,
         distinction between OP_REG and OP_BASEREG.  */
       if (REGNO (rtl) < FIRST_PSEUDO_REGISTER)
        mem_loc_result = based_loc_descr (rtl, 0, VAR_INIT_STATUS_INITIALIZED);
+      else if (stack_realign_drap
+              && crtl->drap_reg
+              && crtl->args.internal_arg_pointer == rtl
+              && REGNO (crtl->drap_reg) < FIRST_PSEUDO_REGISTER)
+       {
+         /* If RTL is internal_arg_pointer, which has been optimized
+            out, use DRAP instead.  */
+         mem_loc_result = based_loc_descr (crtl->drap_reg, 0,
+                                           VAR_INIT_STATUS_INITIALIZED);
+       }
       break;
 
     case MEM:
       mem_loc_result = mem_loc_descriptor (XEXP (rtl, 0), GET_MODE (rtl),
                                           VAR_INIT_STATUS_INITIALIZED);
+      if (mem_loc_result == NULL)
+       mem_loc_result = tls_mem_loc_descriptor (rtl);
       if (mem_loc_result != 0)
        add_loc_descr (&mem_loc_result, new_loc_descr (DW_OP_deref, 0, 0));
       break;
@@ -10027,9 +10107,12 @@ mem_loc_descriptor (rtx rtl, enum machine_mode mode,
                                          INTVAL (XEXP (rtl, 1)), 0));
          else
            {
-             add_loc_descr (&mem_loc_result,
-                            mem_loc_descriptor (XEXP (rtl, 1), mode,
-                                                VAR_INIT_STATUS_INITIALIZED));
+             dw_loc_descr_ref mem_loc_result2
+               = mem_loc_descriptor (XEXP (rtl, 1), mode,
+                                     VAR_INIT_STATUS_INITIALIZED);
+             if (mem_loc_result2 == 0)
+               break;
+             add_loc_descr (&mem_loc_result, mem_loc_result2);
              add_loc_descr (&mem_loc_result,
                             new_loc_descr (DW_OP_plus, 0, 0));
            }
@@ -10079,6 +10162,12 @@ mem_loc_descriptor (rtx rtl, enum machine_mode mode,
                                                   VAR_INIT_STATUS_INITIALIZED);
       break;
 
+    case UNSPEC:
+      /* If delegitimize_address couldn't do anything with the UNSPEC, we
+        can't express it in the debug info.  This can happen e.g. with some
+        TLS UNSPECs.  */
+      break;
+
     default:
       gcc_unreachable ();
     }
@@ -10175,6 +10264,8 @@ loc_descriptor (rtx rtl, enum var_init_status initialized)
     case MEM:
       loc_result = mem_loc_descriptor (XEXP (rtl, 0), GET_MODE (rtl),
                                       initialized);
+      if (loc_result == NULL)
+       loc_result = tls_mem_loc_descriptor (rtl);
       break;
 
     case CONCAT:
@@ -10207,6 +10298,8 @@ loc_descriptor (rtx rtl, enum var_init_status initialized)
        /* Create the first one, so we have something to add to.  */
        loc_result = loc_descriptor (XEXP (RTVEC_ELT (par_elems, 0), 0),
                                     initialized);
+       if (loc_result == NULL)
+         return NULL;
        mode = GET_MODE (XEXP (RTVEC_ELT (par_elems, 0), 0));
        add_loc_descr_op_piece (&loc_result, GET_MODE_SIZE (mode));
        for (i = 1; i < num_elem; i++)
@@ -10215,6 +10308,8 @@ loc_descriptor (rtx rtl, enum var_init_status initialized)
 
            temp = loc_descriptor (XEXP (RTVEC_ELT (par_elems, i), 0),
                                   initialized);
+           if (temp == NULL)
+             return NULL;
            add_loc_descr (&loc_result, temp);
            mode = GET_MODE (XEXP (RTVEC_ELT (par_elems, i), 0));
            add_loc_descr_op_piece (&loc_result, GET_MODE_SIZE (mode));
@@ -10293,7 +10388,7 @@ loc_descriptor_from_tree_1 (tree loc, int want_address)
               /* The way DW_OP_GNU_push_tls_address is specified, we
                  can only look up addresses of objects in the current
                  module.  */
-             if (DECL_EXTERNAL (loc))
+             if (DECL_EXTERNAL (loc) && !targetm.binds_local_p (loc))
                return 0;
              first_op = INTERNAL_DW_OP_tls_addr;
              second_op = DW_OP_GNU_push_tls_address;
@@ -10415,7 +10510,10 @@ loc_descriptor_from_tree_1 (tree loc, int want_address)
        if (offset != NULL_TREE)
          {
            /* Variable offset.  */
-           add_loc_descr (&ret, loc_descriptor_from_tree_1 (offset, 0));
+           ret1 = loc_descriptor_from_tree_1 (offset, 0);
+           if (ret1 == 0)
+             return 0;
+           add_loc_descr (&ret, ret1);
            add_loc_descr (&ret, new_loc_descr (DW_OP_plus, 0, 0));
          }
 
@@ -11541,8 +11639,8 @@ secname_for_decl (const_tree decl)
   return secname;
 }
 
-/* Check whether decl is a Fortran COMMON symbol.  If not, NULL_RTX is returned.
-   If so, the rtx for the SYMBOL_REF for the COMMON block is returned, and the
+/* Check whether decl is a Fortran COMMON symbol.  If not, NULL_TREE is
+   returned.  If so, the decl for the COMMON block is returned, and the
    value is the offset into the common block for the symbol.  */
 
 static tree
@@ -11591,6 +11689,32 @@ fortran_common (tree decl, HOST_WIDE_INT *value)
   return cvar;
 }
 
+/* Dereference a location expression LOC if DECL is passed by invisible
+   reference.  */
+
+static dw_loc_descr_ref
+loc_by_reference (dw_loc_descr_ref loc, tree decl)
+{
+  HOST_WIDE_INT size;
+  enum dwarf_location_atom op;
+
+  if (loc == NULL)
+    return NULL;
+
+  if ((TREE_CODE (decl) != PARM_DECL && TREE_CODE (decl) != RESULT_DECL)
+      || !DECL_BY_REFERENCE (decl))
+    return loc;
+
+  size = int_size_in_bytes (TREE_TYPE (decl));
+  if (size > DWARF2_ADDR_SIZE || size == -1)
+    return 0;
+  else if (size == DWARF2_ADDR_SIZE)
+    op = DW_OP_deref;
+  else
+    op = DW_OP_deref_size;
+  add_loc_descr (&loc, new_loc_descr (op, size, 0));
+  return loc;
+}
 
 /* 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
@@ -11649,8 +11773,8 @@ add_location_or_const_value_attribute (dw_die_ref die, tree decl,
       else
        initialized = VAR_INIT_STATUS_INITIALIZED;
 
-      list = new_loc_list (loc_descriptor (varloc, initialized),
-                          node->label, node->next->label, secname, 1);
+      descr = loc_by_reference (loc_descriptor (varloc, initialized), decl);
+      list = new_loc_list (descr, node->label, node->next->label, secname, 1);
       node = node->next;
 
       for (; node->next; node = node->next)
@@ -11661,8 +11785,9 @@ add_location_or_const_value_attribute (dw_die_ref die, tree decl,
            enum var_init_status initialized =
              NOTE_VAR_LOCATION_STATUS (node->var_loc_note);
            varloc = NOTE_VAR_LOCATION (node->var_loc_note);
-           add_loc_descr_to_loc_list (&list,
-                                      loc_descriptor (varloc, initialized),
+           descr = loc_by_reference (loc_descriptor (varloc, initialized),
+                                     decl);
+           add_loc_descr_to_loc_list (&list, descr,
                                       node->label, node->next->label, secname);
          }
 
@@ -11683,8 +11808,9 @@ add_location_or_const_value_attribute (dw_die_ref die, tree decl,
                                           current_function_funcdef_no);
              endname = ggc_strdup (label_id);
            }
-         add_loc_descr_to_loc_list (&list,
-                                    loc_descriptor (varloc, initialized),
+         descr = loc_by_reference (loc_descriptor (varloc, initialized),
+                                   decl);
+         add_loc_descr_to_loc_list (&list, descr,
                                     node->label, endname, secname);
        }
 
@@ -11714,6 +11840,7 @@ add_location_or_const_value_attribute (dw_die_ref die, tree decl,
       descr = loc_descriptor (NOTE_VAR_LOCATION (node->var_loc_note), status);
       if (descr)
        {
+         descr = loc_by_reference (descr, decl);
          add_AT_location_description (die, attr, descr);
          return;
        }
@@ -11724,6 +11851,7 @@ add_location_or_const_value_attribute (dw_die_ref die, tree decl,
   descr = loc_descriptor_from_tree (decl);
   if (descr)
     {
+      descr = loc_by_reference (descr, decl);
       add_AT_location_description (die, attr, descr);
       return;
     }
@@ -11732,6 +11860,153 @@ add_location_or_const_value_attribute (dw_die_ref die, tree decl,
   tree_add_const_value_attribute (die, decl);
 }
 
+/* Helper function for tree_add_const_value_attribute.  Natively encode
+   initializer INIT into an array.  Return true if successful.  */
+
+static bool
+native_encode_initializer (tree init, unsigned char *array, int size)
+{
+  tree type;
+
+  if (init == NULL_TREE)
+    return false;
+
+  STRIP_NOPS (init);
+  switch (TREE_CODE (init))
+    {
+    case STRING_CST:
+      type = TREE_TYPE (init);
+      if (TREE_CODE (type) == ARRAY_TYPE)
+       {
+         tree enttype = TREE_TYPE (type);
+         enum machine_mode mode = TYPE_MODE (enttype);
+
+         if (GET_MODE_CLASS (mode) != MODE_INT || GET_MODE_SIZE (mode) != 1)
+           return false;
+         if (int_size_in_bytes (type) != size)
+           return false;
+         if (size > TREE_STRING_LENGTH (init))
+           {
+             memcpy (array, TREE_STRING_POINTER (init),
+                     TREE_STRING_LENGTH (init));
+             memset (array + TREE_STRING_LENGTH (init),
+                     '\0', size - TREE_STRING_LENGTH (init));
+           }
+         else
+           memcpy (array, TREE_STRING_POINTER (init), size);
+         return true;
+       }
+      return false;
+    case CONSTRUCTOR:
+      type = TREE_TYPE (init);
+      if (int_size_in_bytes (type) != size)
+       return false;
+      if (TREE_CODE (type) == ARRAY_TYPE)
+       {
+         HOST_WIDE_INT min_index;
+         unsigned HOST_WIDE_INT cnt;
+         int curpos = 0, fieldsize;
+         constructor_elt *ce;
+
+         if (TYPE_DOMAIN (type) == NULL_TREE
+             || !host_integerp (TYPE_MIN_VALUE (TYPE_DOMAIN (type)), 0))
+           return false;
+
+         fieldsize = int_size_in_bytes (TREE_TYPE (type));
+         if (fieldsize <= 0)
+           return false;
+
+         min_index = tree_low_cst (TYPE_MIN_VALUE (TYPE_DOMAIN (type)), 0);
+         memset (array, '\0', size);
+         for (cnt = 0;
+              VEC_iterate (constructor_elt, CONSTRUCTOR_ELTS (init), cnt, ce);
+              cnt++)
+           {
+             tree val = ce->value;
+             tree index = ce->index;
+             int pos = curpos;
+             if (index && TREE_CODE (index) == RANGE_EXPR)
+               pos = (tree_low_cst (TREE_OPERAND (index, 0), 0) - min_index)
+                     * fieldsize;
+             else if (index)
+               pos = (tree_low_cst (index, 0) - min_index) * fieldsize;
+
+             if (val)
+               {
+                 STRIP_NOPS (val);
+                 if (!native_encode_initializer (val, array + pos, fieldsize))
+                   return false;
+               }
+             curpos = pos + fieldsize;
+             if (index && TREE_CODE (index) == RANGE_EXPR)
+               {
+                 int count = tree_low_cst (TREE_OPERAND (index, 1), 0)
+                             - tree_low_cst (TREE_OPERAND (index, 0), 0);
+                 while (count > 0)
+                   {
+                     if (val)
+                       memcpy (array + curpos, array + pos, fieldsize);
+                     curpos += fieldsize;
+                   }
+               }
+             gcc_assert (curpos <= size);
+           }
+         return true;
+       }
+      else if (TREE_CODE (type) == RECORD_TYPE
+              || TREE_CODE (type) == UNION_TYPE)
+       {
+         tree field = NULL_TREE;
+         unsigned HOST_WIDE_INT cnt;
+         constructor_elt *ce;
+
+         if (int_size_in_bytes (type) != size)
+           return false;
+
+         if (TREE_CODE (type) == RECORD_TYPE)
+           field = TYPE_FIELDS (type);
+
+         for (cnt = 0;
+              VEC_iterate (constructor_elt, CONSTRUCTOR_ELTS (init), cnt, ce);
+              cnt++, field = field ? TREE_CHAIN (field) : 0)
+           {
+             tree val = ce->value;
+             int pos, fieldsize;
+
+             if (ce->index != 0)
+               field = ce->index;
+
+             if (val)
+               STRIP_NOPS (val);
+
+             if (field == NULL_TREE || DECL_BIT_FIELD (field))
+               return false;
+
+             if (TREE_CODE (TREE_TYPE (field)) == ARRAY_TYPE
+                 && TYPE_DOMAIN (TREE_TYPE (field))
+                 && ! TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (field))))
+               return false;
+             else if (DECL_SIZE_UNIT (field) == NULL_TREE
+                      || !host_integerp (DECL_SIZE_UNIT (field), 0))
+               return false;
+             fieldsize = tree_low_cst (DECL_SIZE_UNIT (field), 0);
+             pos = int_byte_position (field);
+             gcc_assert (pos + fieldsize <= size);
+             if (val
+                 && !native_encode_initializer (val, array + pos, fieldsize))
+               return false;
+           }
+         return true;
+       }
+      return false;
+    case VIEW_CONVERT_EXPR:
+    case NON_LVALUE_EXPR:
+      return native_encode_initializer (TREE_OPERAND (init, 0), array, size);
+    default:
+      return native_encode_expr (init, array, size) == size;
+    }
+}
+
 /* If we don't have a copy of this variable in memory for some reason (such
    as a C++ member constant that doesn't have an out-of-line definition),
    we should tell the debugger about the constant value.  */
@@ -11739,10 +12014,14 @@ add_location_or_const_value_attribute (dw_die_ref die, tree decl,
 static void
 tree_add_const_value_attribute (dw_die_ref var_die, tree decl)
 {
-  tree init = DECL_INITIAL (decl);
+  tree init;
   tree type = TREE_TYPE (decl);
   rtx rtl;
 
+  if (TREE_CODE (decl) != VAR_DECL && TREE_CODE (decl) != CONST_DECL)
+    return;
+
+  init = DECL_INITIAL (decl);
   if (TREE_READONLY (decl) && ! TREE_THIS_VOLATILE (decl) && init)
     /* OK */;
   else
@@ -11751,6 +12030,19 @@ tree_add_const_value_attribute (dw_die_ref var_die, tree decl)
   rtl = rtl_for_decl_init (init, type);
   if (rtl)
     add_const_value_attribute (var_die, rtl);
+  /* If the host and target are sane, try harder.  */
+  else if (CHAR_BIT == 8 && BITS_PER_UNIT == 8
+          && initializer_constant_valid_p (init, type))
+    {
+      HOST_WIDE_INT size = int_size_in_bytes (TREE_TYPE (init));
+      if (size > 0 && (int) size == size)
+       {
+         unsigned char *array = GGC_CNEWVEC (unsigned char, size);
+
+         if (native_encode_initializer (init, array, size))
+           add_AT_vec (var_die, DW_AT_const_value, size, 1, array);
+       }
+    }
 }
 
 /* Convert the CFI instructions for the current function into a
@@ -11997,6 +12289,9 @@ add_subscript_info (dw_die_ref type_die, tree type, bool collapse_p)
     {
       tree domain = TYPE_DOMAIN (type);
 
+      if (TYPE_STRING_FLAG (type) && is_fortran () && dimension_number > 0)
+       break;
+
       /* Arrays come in three flavors: Unspecified bounds, fixed bounds,
         and (in GNU C only) variable bounds.  Handle all three forms
         here.  */
@@ -12530,7 +12825,40 @@ gen_array_type_die (tree type, dw_die_ref context_die)
 
   bool collapse_nested_arrays = !is_ada ();
   tree element_type;
-  
+
+  /* Emit DW_TAG_string_type for Fortran character types (with kind 1 only, as
+     DW_TAG_string_type doesn't have DW_AT_type attribute).  */
+  if (TYPE_STRING_FLAG (type)
+      && TREE_CODE (type) == ARRAY_TYPE
+      && is_fortran ()
+      && TYPE_MODE (TREE_TYPE (type)) == TYPE_MODE (char_type_node))
+    {
+      HOST_WIDE_INT size;
+
+      array_die = new_die (DW_TAG_string_type, scope_die, type);
+      add_name_attribute (array_die, type_tag (type));
+      equate_type_number_to_die (type, array_die);
+      size = int_size_in_bytes (type);
+      if (size >= 0)
+       add_AT_unsigned (array_die, DW_AT_byte_size, size);
+      else if (TYPE_DOMAIN (type) != NULL_TREE
+              && TYPE_MAX_VALUE (TYPE_DOMAIN (type)) != NULL_TREE
+              && DECL_P (TYPE_MAX_VALUE (TYPE_DOMAIN (type))))
+       {
+         tree szdecl = TYPE_MAX_VALUE (TYPE_DOMAIN (type));
+         dw_loc_descr_ref loc = loc_descriptor_from_tree (szdecl);
+
+         size = int_size_in_bytes (TREE_TYPE (szdecl));
+         if (loc && size > 0)
+           {
+             add_AT_loc (array_die, DW_AT_string_length, loc);
+             if (size != DWARF2_ADDR_SIZE)
+               add_AT_unsigned (array_die, DW_AT_byte_size, size);
+           }
+       }
+      return;
+    }
+
   /* ??? The SGI dwarf reader fails for array of array of enum types
      (e.g. const enum machine_mode insn_operand_mode[2][10]) unless the inner
      array type comes before the outer array type.  We thus call gen_type_die
@@ -12557,7 +12885,8 @@ gen_array_type_die (tree type, dw_die_ref context_die)
   /* For Fortran multidimensional arrays use DW_ORD_col_major ordering.  */
   if (is_fortran ()
       && TREE_CODE (type) == ARRAY_TYPE
-      && TREE_CODE (TREE_TYPE (type)) == ARRAY_TYPE)
+      && TREE_CODE (TREE_TYPE (type)) == ARRAY_TYPE
+      && !TYPE_STRING_FLAG (TREE_TYPE (type)))
     add_AT_unsigned (array_die, DW_AT_ordering, DW_ORD_col_major);
 
 #if 0
@@ -12585,8 +12914,12 @@ gen_array_type_die (tree type, dw_die_ref context_die)
   element_type = TREE_TYPE (type);
   if (collapse_nested_arrays)
     while (TREE_CODE (element_type) == ARRAY_TYPE)
-      element_type = TREE_TYPE (element_type);
-  
+      {
+       if (TYPE_STRING_FLAG (element_type) && is_fortran ())
+         break;
+       element_type = TREE_TYPE (element_type);
+      }
+
 #ifndef MIPS_DEBUGGING_INFO
   gen_type_die (element_type, context_die);
 #endif
@@ -12611,6 +12944,8 @@ descr_info_loc (tree val, tree base_decl)
     {
     CASE_CONVERT:
       return descr_info_loc (TREE_OPERAND (val, 0), base_decl);
+    case VAR_DECL:
+      return loc_descriptor_from_tree_1 (val, 0);
     case INTEGER_CST:
       if (host_integerp (val, 0))
        return int_loc_descriptor (tree_low_cst (val, 0));
@@ -12952,11 +13287,13 @@ gen_formal_parameter_die (tree node, dw_die_ref context_die)
          tree type = TREE_TYPE (node);
          add_name_and_src_coords_attributes (parm_die, node);
          if (DECL_BY_REFERENCE (node))
-           type = TREE_TYPE (type);
-         add_type_attribute (parm_die, type,
-                             TREE_READONLY (node),
-                             TREE_THIS_VOLATILE (node),
-                             context_die);
+           add_type_attribute (parm_die, TREE_TYPE (type), 0, 0,
+                               context_die);
+         else
+           add_type_attribute (parm_die, type,
+                               TREE_READONLY (node),
+                               TREE_THIS_VOLATILE (node),
+                               context_die);
          if (DECL_ARTIFICIAL (node))
            add_AT_flag (parm_die, DW_AT_artificial, 1);
        }
@@ -13491,6 +13828,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
@@ -13531,44 +13888,100 @@ 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)
+       {
+         if (get_AT (var_die, DW_AT_location) == NULL)
+           {
+             loc = loc_descriptor_from_tree (com_decl);
+             if (loc)
+               {
+                 if (off)
+                   {
+                     /* 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);
 
-      if (lookup_decl_die (decl))
-       return;
       field = TREE_OPERAND (DECL_VALUE_EXPR (decl), 0);
-      var_die = lookup_decl_die (com_decl);
-      if (var_die == NULL)
+      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));
-         dw_loc_descr_ref loc = loc_descriptor_from_tree (com_decl);
+         void **slot;
 
-         var_die = new_die (DW_TAG_common_block, context_die, decl);
-         add_name_and_src_coords_attributes (var_die, com_decl);
-         add_AT_flag (var_die, DW_AT_external, 1);
+         com_die = new_die (DW_TAG_common_block, context_die, decl);
+         add_name_and_src_coords_attributes (com_die, com_decl);
          if (loc)
-           add_AT_loc (var_die, DW_AT_location, loc);
+           {
+             add_AT_loc (com_die, DW_AT_location, loc);
+             /* Avoid sharing the same loc descriptor between
+                DW_TAG_common_block and DW_TAG_variable.  */
+             loc = loc_descriptor_from_tree (com_decl);
+           }
           else if (DECL_EXTERNAL (decl))
-           add_AT_flag (var_die, DW_AT_declaration, 1);
-         add_pubname_string (cnam, var_die); /* ??? needed? */
-         equate_decl_number_to_die (com_decl, var_die);
+           add_AT_flag (com_die, DW_AT_declaration, 1);
+         add_pubname_string (cnam, com_die); /* ??? needed? */
+         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 (var_die, DW_AT_location) == NULL)
+      else if (get_AT (com_die, DW_AT_location) == NULL && loc)
        {
-         dw_loc_descr_ref loc = loc_descriptor_from_tree (com_decl);
-
-         if (loc)
+         add_AT_loc (com_die, DW_AT_location, loc);
+         loc = loc_descriptor_from_tree (com_decl);
+         remove_AT (com_die, DW_AT_declaration);
+       }
+      var_die = new_die (DW_TAG_variable, com_die, decl);
+      add_name_and_src_coords_attributes (var_die, decl);
+      add_type_attribute (var_die, TREE_TYPE (decl), TREE_READONLY (decl),
+                         TREE_THIS_VOLATILE (decl), context_die);
+      add_AT_flag (var_die, DW_AT_external, 1);
+      if (loc)
+       {
+         if (off)
            {
-             add_AT_loc (var_die, DW_AT_location, loc);
-             remove_AT (var_die, DW_AT_declaration);
+             /* 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);
        }
-      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));
-      equate_decl_number_to_die (decl, com_die);
+      else if (DECL_EXTERNAL (decl))
+       add_AT_flag (var_die, DW_AT_declaration, 1);
+      equate_decl_number_to_die (decl, var_die);
       return;
     }
 
@@ -13610,14 +14023,15 @@ gen_variable_die (tree decl, dw_die_ref context_die)
   else
     {
       tree type = TREE_TYPE (decl);
+
+      add_name_and_src_coords_attributes (var_die, decl);
       if ((TREE_CODE (decl) == PARM_DECL
           || TREE_CODE (decl) == RESULT_DECL)
          && DECL_BY_REFERENCE (decl))
-       type = TREE_TYPE (type);
-
-      add_name_and_src_coords_attributes (var_die, decl);
-      add_type_attribute (var_die, type, TREE_READONLY (decl),
-                         TREE_THIS_VOLATILE (decl), context_die);
+       add_type_attribute (var_die, TREE_TYPE (type), 0, 0, context_die);
+      else
+       add_type_attribute (var_die, type, TREE_READONLY (decl),
+                           TREE_THIS_VOLATILE (decl), context_die);
 
       if (TREE_PUBLIC (decl))
        add_AT_flag (var_die, DW_AT_external, 1);
@@ -13646,6 +14060,24 @@ gen_variable_die (tree decl, dw_die_ref context_die)
     tree_add_const_value_attribute (var_die, decl);
 }
 
+/* Generate a DIE to represent a named constant.  */
+
+static void
+gen_const_die (tree decl, dw_die_ref context_die)
+{
+  dw_die_ref const_die;
+  tree type = TREE_TYPE (decl);
+
+  const_die = new_die (DW_TAG_constant, context_die, decl);
+  add_name_and_src_coords_attributes (const_die, decl);
+  add_type_attribute (const_die, type, 1, 0, context_die);
+  if (TREE_PUBLIC (decl))
+    add_AT_flag (const_die, DW_AT_external, 1);
+  if (DECL_ARTIFICIAL (decl))
+    add_AT_flag (const_die, DW_AT_artificial, 1);
+  tree_add_const_value_attribute (const_die, decl);
+}
+
 /* Generate a DIE to represent a label identifier.  */
 
 static void
@@ -14557,6 +14989,9 @@ decls_for_scope (tree stmt, dw_die_ref context_die, int depth)
          if (TREE_CODE (decl) == VAR_DECL && TREE_STATIC (decl)
              && !(is_fortran () && TREE_PUBLIC (decl)))
            ;
+         else if (TREE_CODE (decl) == IMPORTED_DECL)
+           dwarf2out_imported_module_or_decl_1 (decl, DECL_NAME (decl),
+                                                stmt, context_die);
          else
            gen_decl_die (decl, context_die);
        }
@@ -14744,11 +15179,15 @@ gen_namespace_die (tree decl)
      they are an alias of.  */
   if (DECL_ABSTRACT_ORIGIN (decl) == NULL)
     {
-      /* Output a real namespace.  */
+      /* Output a real namespace or module.  */
       dw_die_ref namespace_die
        = new_die (is_fortran () ? DW_TAG_module : DW_TAG_namespace,
                   context_die, decl);
-      add_name_and_src_coords_attributes (namespace_die, decl);
+      /* For Fortran modules defined in different CU don't add src coords.  */
+      if (namespace_die->die_tag == DW_TAG_module && DECL_EXTERNAL (decl))
+       add_name_attribute (namespace_die, dwarf2_name (decl, 0));
+      else
+       add_name_and_src_coords_attributes (namespace_die, decl);
       if (DECL_EXTERNAL (decl))
        add_AT_flag (namespace_die, DW_AT_declaration, 1);
       equate_decl_number_to_die (decl, namespace_die);
@@ -14786,8 +15225,20 @@ gen_decl_die (tree decl, dw_die_ref context_die)
       break;
 
     case CONST_DECL:
-      /* The individual enumerators of an enum type get output when we output
-        the Dwarf representation of the relevant enum type itself.  */
+      if (!is_fortran ())
+       {
+         /* The individual enumerators of an enum type get output when we output
+            the Dwarf representation of the relevant enum type itself.  */
+         break;
+       }
+
+      /* Emit its type.  */
+      gen_type_die (TREE_TYPE (decl), context_die);
+
+      /* And its containing namespace.  */
+      context_die = declare_in_namespace (decl, context_die);
+
+      gen_const_die (decl, context_die);
       break;
 
     case FUNCTION_DECL:
@@ -14932,6 +15383,7 @@ gen_decl_die (tree decl, dw_die_ref context_die)
       break;
 
     case NAMESPACE_DECL:
+    case IMPORTED_DECL:
       gen_namespace_die (decl);
       break;
 
@@ -14966,44 +15418,20 @@ dwarf2out_type_decl (tree decl, int local)
 }
 
 /* Output debug information for imported module or decl DECL.
-   NAME is non-NULL name in context if the decl has been renamed.
-   CHILD is true if decl is one of the renamed decls as part of
-   importing whole module.  */
-
+   NAME is non-NULL name in the lexical block if the decl has been renamed.
+   LEXICAL_BLOCK is the lexical block (which TREE_CODE is a BLOCK)
+   that DECL belongs to.
+   LEXICAL_BLOCK_DIE is the DIE of LEXICAL_BLOCK.  */
 static void
-dwarf2out_imported_module_or_decl (tree decl, tree name, tree context,
-                                  bool child)
+dwarf2out_imported_module_or_decl_1 (tree decl,
+                                    tree name,
+                                    tree lexical_block,
+                                    dw_die_ref lexical_block_die)
 {
-  dw_die_ref imported_die, at_import_die;
-  dw_die_ref scope_die;
   expanded_location xloc;
+  dw_die_ref imported_die = NULL;
+  dw_die_ref at_import_die;
 
-  if (debug_info_level <= DINFO_LEVEL_TERSE)
-    return;
-
-  gcc_assert (decl);
-
-  /* To emit DW_TAG_imported_module or DW_TAG_imported_decl, we need two DIEs.
-     We need decl DIE for reference and scope die. First, get DIE for the decl
-     itself.  */
-
-  /* Get the scope die for decl context. Use comp_unit_die for global module
-     or decl. If die is not found for non globals, force new die.  */
-  if (context
-      && TYPE_P (context)
-      && !should_emit_struct_debug (context, DINFO_USAGE_DIR_USE))
-    return;
-  scope_die = get_context_die (context);
-
-  if (child)
-    {
-      gcc_assert (scope_die->die_child);
-      gcc_assert (scope_die->die_child->die_tag == DW_TAG_imported_module);
-      gcc_assert (TREE_CODE (decl) != NAMESPACE_DECL);
-      scope_die = scope_die->die_child;
-    }
-
-  /* For TYPE_DECL or CONST_DECL, lookup TREE_TYPE.  */
   if (TREE_CODE (decl) == TYPE_DECL || TREE_CODE (decl) == CONST_DECL)
     {
       if (is_base_type (TREE_TYPE (decl)))
@@ -15021,6 +15449,19 @@ dwarf2out_imported_module_or_decl (tree decl, tree name, tree context,
          gcc_assert (at_import_die);
        }
     }
+  else if (TREE_CODE (decl) == IMPORTED_DECL)
+    {
+      tree imported_ns_decl;
+      /* IMPORTED_DECL nodes that are not imported namespace are just not
+         supported yet.  */
+      gcc_assert (DECL_INITIAL (decl)
+                 && TREE_CODE (DECL_INITIAL (decl)) == NAMESPACE_DECL);
+      imported_ns_decl = DECL_INITIAL (decl);
+      at_import_die = lookup_decl_die (imported_ns_decl);
+      if (!at_import_die)
+       at_import_die = force_decl_die (imported_ns_decl);
+      gcc_assert (at_import_die);
+    }
   else
     {
       at_import_die = lookup_decl_die (decl);
@@ -15044,20 +15485,66 @@ dwarf2out_imported_module_or_decl (tree decl, tree name, tree context,
        }
     }
 
-  /* OK, now we have DIEs for decl as well as scope. Emit imported die.  */
   if (TREE_CODE (decl) == NAMESPACE_DECL)
-    imported_die = new_die (DW_TAG_imported_module, scope_die, context);
+    imported_die = new_die (DW_TAG_imported_module,
+                           lexical_block_die,
+                           lexical_block);
   else
-    imported_die = new_die (DW_TAG_imported_declaration, scope_die, context);
+    imported_die = new_die (DW_TAG_imported_declaration,
+                           lexical_block_die,
+                           lexical_block);
 
   xloc = expand_location (input_location);
   add_AT_file (imported_die, DW_AT_decl_file, lookup_filename (xloc.file));
   add_AT_unsigned (imported_die, DW_AT_decl_line, xloc.line);
   if (name)
-    add_AT_string (imported_die, DW_AT_name, IDENTIFIER_POINTER (name));
+    add_AT_string (imported_die, DW_AT_name,
+                  IDENTIFIER_POINTER (name));
   add_AT_die_ref (imported_die, DW_AT_import, at_import_die);
 }
 
+/* Output debug information for imported module or decl DECL.
+   NAME is non-NULL name in context if the decl has been renamed.
+   CHILD is true if decl is one of the renamed decls as part of
+   importing whole module.  */
+
+static void
+dwarf2out_imported_module_or_decl (tree decl, tree name, tree context,
+                                  bool child)
+{
+  /* dw_die_ref at_import_die;  */
+  dw_die_ref scope_die;
+
+  if (debug_info_level <= DINFO_LEVEL_TERSE)
+    return;
+
+  gcc_assert (decl);
+
+  /* To emit DW_TAG_imported_module or DW_TAG_imported_decl, we need two DIEs.
+     We need decl DIE for reference and scope die. First, get DIE for the decl
+     itself.  */
+
+  /* Get the scope die for decl context. Use comp_unit_die for global module
+     or decl. If die is not found for non globals, force new die.  */
+  if (context
+      && TYPE_P (context)
+      && !should_emit_struct_debug (context, DINFO_USAGE_DIR_USE))
+    return;
+  scope_die = get_context_die (context);
+
+  if (child)
+    {
+      gcc_assert (scope_die->die_child);
+      gcc_assert (scope_die->die_child->die_tag == DW_TAG_imported_module);
+      gcc_assert (TREE_CODE (decl) != NAMESPACE_DECL);
+      scope_die = scope_die->die_child;
+    }
+
+  /* OK, now we have DIEs for decl as well as scope. Emit imported die.  */
+  dwarf2out_imported_module_or_decl_1 (decl, name, context, scope_die);
+
+}
+
 /* Write the debugging output for DECL.  */
 
 void
@@ -15132,7 +15619,17 @@ dwarf2out_decl (tree decl)
        return;
       break;
 
+    case CONST_DECL:
+      if (debug_info_level <= DINFO_LEVEL_TERSE)
+       return;
+      if (!is_fortran ())
+       return;
+      if (TREE_STATIC (decl) && decl_function_context (decl))
+       context_die = lookup_decl_die (DECL_CONTEXT (decl));
+      break;
+
     case NAMESPACE_DECL:
+    case IMPORTED_DECL:
       if (debug_info_level <= DINFO_LEVEL_TERSE)
        return;
       if (lookup_decl_die (decl) != NULL)