OSDN Git Service

2008-06-26 H.J. Lu <hongjiu.lu@intel.com>
[pf3gnuchains/gcc-fork.git] / gcc / dwarf2out.c
index d818f0d..80bdc0a 100644 (file)
@@ -1,6 +1,6 @@
 /* Output Dwarf2 format symbol table information from GCC.
    Copyright (C) 1992, 1993, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
-   2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+   2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
    Contributed by Gary Funck (gary@intrepid.com).
    Derived from DWARF 1 implementation of Ron Guilmette (rfg@monkeys.com).
    Extensively modified by Jason Merrill (jason@cygnus.com).
@@ -315,6 +315,14 @@ static GTY(()) unsigned fde_table_in_use;
    fde_table.  */
 #define FDE_TABLE_INCREMENT 256
 
+/* Get the current fde_table entry we should use.  */
+
+static inline dw_fde_ref
+current_fde (void)
+{
+  return fde_table_in_use ? &fde_table[fde_table_in_use - 1] : NULL;
+}
+
 /* A list of call frame insns for the CIE.  */
 static GTY(()) dw_cfi_ref cie_cfi_head;
 
@@ -339,6 +347,17 @@ static GTY ((param_is (struct indirect_string_node))) htab_t debug_str_hash;
 static GTY(()) int dw2_string_counter;
 static GTY(()) unsigned long dwarf2out_cfi_label_num;
 
+/* True if the compilation unit places functions in more than one section.  */
+static GTY(()) bool have_multiple_function_sections = false;
+
+/* Whether the default text and cold text sections have been used at all.  */
+
+static GTY(()) bool text_section_used = false;
+static GTY(()) bool cold_text_section_used = false;
+
+/* The default cold text section.  */
+static GTY(()) section *cold_text_section;
+
 #if defined (DWARF2_DEBUGGING_INFO) || defined (DWARF2_UNWIND_INFO)
 
 /* Forward declarations for functions defined in this file.  */
@@ -357,6 +376,7 @@ static void initial_return_save (rtx);
 static HOST_WIDE_INT stack_adjust_offset (const_rtx);
 static void output_cfi (dw_cfi_ref, dw_fde_ref, int);
 static void output_call_frame_info (int);
+static void dwarf2out_note_section_used (void);
 static void dwarf2out_stack_adjust (rtx, bool);
 static void flush_queued_reg_saves (void);
 static bool clobbers_queued_reg_save (const_rtx);
@@ -586,7 +606,7 @@ dwarf_cfi_name (unsigned int cfi_opc)
 static inline dw_cfi_ref
 new_cfi (void)
 {
-  dw_cfi_ref cfi = ggc_alloc (sizeof (dw_cfi_node));
+  dw_cfi_ref cfi = GGC_NEW (dw_cfi_node);
 
   cfi->dw_cfi_next = NULL;
   cfi->dw_cfi_oprnd1.dw_cfi_reg_num = 0;
@@ -629,7 +649,9 @@ add_fde_cfi (const char *label, dw_cfi_ref cfi)
 {
   if (label)
     {
-      dw_fde_ref fde = &fde_table[fde_table_in_use - 1];
+      dw_fde_ref fde = current_fde ();
+
+      gcc_assert (fde != NULL);
 
       if (*label == 0)
        label = dwarf2out_cfi_label ();
@@ -701,6 +723,7 @@ static void
 lookup_cfa (dw_cfa_location *loc)
 {
   dw_cfi_ref cfi;
+  dw_fde_ref fde;
 
   loc->reg = INVALID_REGNUM;
   loc->offset = 0;
@@ -710,12 +733,10 @@ lookup_cfa (dw_cfa_location *loc)
   for (cfi = cie_cfi_head; cfi; cfi = cfi->dw_cfi_next)
     lookup_cfa_1 (cfi, loc);
 
-  if (fde_table_in_use)
-    {
-      dw_fde_ref fde = &fde_table[fde_table_in_use - 1];
-      for (cfi = fde->dw_fde_cfi; cfi; cfi = cfi->dw_cfi_next)
-       lookup_cfa_1 (cfi, loc);
-    }
+  fde = current_fde ();
+  if (fde)
+    for (cfi = fde->dw_fde_cfi; cfi; cfi = cfi->dw_cfi_next)
+      lookup_cfa_1 (cfi, loc);
 }
 
 /* The current rule for calculating the DWARF2 canonical frame address.  */
@@ -1230,7 +1251,7 @@ queue_reg_save (const char *label, rtx reg, rtx sreg, HOST_WIDE_INT offset)
 
   if (q == NULL)
     {
-      q = ggc_alloc (sizeof (*q));
+      q = GGC_NEW (struct queued_reg_save);
       q->next = queued_reg_saves;
       queued_reg_saves = q;
     }
@@ -1522,7 +1543,7 @@ static dw_cfa_location cfa_temp;
 static void
 dwarf2out_frame_debug_expr (rtx expr, const char *label)
 {
-  rtx src, dest;
+  rtx src, dest, span;
   HOST_WIDE_INT offset;
 
   /* If RTX_FRAME_RELATED_P is set on a PARALLEL, process each member of
@@ -1872,7 +1893,32 @@ dwarf2out_frame_debug_expr (rtx expr, const char *label)
        }
 
       def_cfa_1 (label, &cfa);
-      queue_reg_save (label, src, NULL_RTX, offset);
+      {
+       span = targetm.dwarf_register_span (src);
+
+       if (!span)
+         queue_reg_save (label, src, NULL_RTX, offset);
+       else
+         {
+           /* We have a PARALLEL describing where the contents of SRC
+              live.  Queue register saves for each piece of the
+              PARALLEL.  */
+           int par_index;
+           int limit;
+           HOST_WIDE_INT span_offset = offset;
+
+           gcc_assert (GET_CODE (span) == PARALLEL);
+
+           limit = XVECLEN (span, 0);
+           for (par_index = 0; par_index < limit; par_index++)
+             {
+               rtx elem = XVECEXP (span, 0, par_index);
+
+               queue_reg_save (label, elem, NULL_RTX, span_offset);
+               span_offset += GET_MODE_SIZE (GET_MODE (elem));
+             }
+         }
+      }
       break;
 
     default:
@@ -2079,7 +2125,8 @@ output_cfi (dw_cfi_ref cfi, dw_fde_ref fde, int for_eh)
     dw2_asm_output_data (1, (cfi->dw_cfi_opc
                             | (cfi->dw_cfi_oprnd1.dw_cfi_offset & 0x3f)),
                         "DW_CFA_advance_loc " HOST_WIDE_INT_PRINT_HEX,
-                        cfi->dw_cfi_oprnd1.dw_cfi_offset);
+                        ((unsigned HOST_WIDE_INT)
+                         cfi->dw_cfi_oprnd1.dw_cfi_offset));
   else if (cfi->dw_cfi_opc == DW_CFA_offset)
     {
       r = DWARF2_FRAME_REG_OUT (cfi->dw_cfi_oprnd1.dw_cfi_reg_num, for_eh);
@@ -2424,12 +2471,6 @@ output_call_frame_info (int for_eh)
 
       if (for_eh)
        {
-         rtx sym_ref = gen_rtx_SYMBOL_REF (Pmode, fde->dw_fde_begin);
-         SYMBOL_REF_FLAGS (sym_ref) |= SYMBOL_FLAG_LOCAL;
-         dw2_asm_output_encoded_addr_rtx (fde_encoding,
-                                          sym_ref,
-                                          false,
-                                          "FDE initial location");
          if (fde->dw_fde_switched_sections)
            {
              rtx sym_ref2 = gen_rtx_SYMBOL_REF (Pmode,
@@ -2452,14 +2493,20 @@ output_call_frame_info (int for_eh)
                                    "FDE address range");
            }
          else
-           dw2_asm_output_delta (size_of_encoded_value (fde_encoding),
-                                 fde->dw_fde_end, fde->dw_fde_begin,
-                                 "FDE address range");
+           {
+             rtx sym_ref = gen_rtx_SYMBOL_REF (Pmode, fde->dw_fde_begin);
+             SYMBOL_REF_FLAGS (sym_ref) |= SYMBOL_FLAG_LOCAL;
+             dw2_asm_output_encoded_addr_rtx (fde_encoding,
+                                              sym_ref,
+                                              false,
+                                              "FDE initial location");
+             dw2_asm_output_delta (size_of_encoded_value (fde_encoding),
+                                   fde->dw_fde_end, fde->dw_fde_begin,
+                                   "FDE address range");
+           }
        }
       else
        {
-         dw2_asm_output_addr (DWARF2_ADDR_SIZE, fde->dw_fde_begin,
-                              "FDE initial location");
          if (fde->dw_fde_switched_sections)
            {
              dw2_asm_output_addr (DWARF2_ADDR_SIZE,
@@ -2478,9 +2525,13 @@ output_call_frame_info (int for_eh)
                                    "FDE address range");
            }
          else
-           dw2_asm_output_delta (DWARF2_ADDR_SIZE,
-                                 fde->dw_fde_end, fde->dw_fde_begin,
-                                 "FDE address range");
+           {
+             dw2_asm_output_addr (DWARF2_ADDR_SIZE, fde->dw_fde_begin,
+                                  "FDE initial location");
+             dw2_asm_output_delta (DWARF2_ADDR_SIZE,
+                                   fde->dw_fde_end, fde->dw_fde_begin,
+                                   "FDE address range");
+           }
        }
 
       if (augmentation[0])
@@ -2592,8 +2643,7 @@ dwarf2out_begin_prologue (unsigned int line ATTRIBUTE_UNUSED,
   if (fde_table_in_use == fde_table_allocated)
     {
       fde_table_allocated += FDE_TABLE_INCREMENT;
-      fde_table = ggc_realloc (fde_table,
-                              fde_table_allocated * sizeof (dw_fde_node));
+      fde_table = GGC_RESIZEVEC (dw_fde_node, fde_table, fde_table_allocated);
       memset (fde_table + fde_table_in_use, 0,
              FDE_TABLE_INCREMENT * sizeof (dw_fde_node));
     }
@@ -2615,8 +2665,8 @@ dwarf2out_begin_prologue (unsigned int line ATTRIBUTE_UNUSED,
   fde->dw_fde_cfi = NULL;
   fde->funcdef_number = current_function_funcdef_no;
   fde->nothrow = TREE_NOTHROW (current_function_decl);
-  fde->uses_eh_lsda = cfun->uses_eh_lsda;
-  fde->all_throwers_are_sibcalls = cfun->all_throwers_are_sibcalls;
+  fde->uses_eh_lsda = crtl->uses_eh_lsda;
+  fde->all_throwers_are_sibcalls = crtl->all_throwers_are_sibcalls;
 
   args_size = old_args_size = 0;
 
@@ -2644,7 +2694,8 @@ dwarf2out_end_epilogue (unsigned int line ATTRIBUTE_UNUSED,
   ASM_GENERATE_INTERNAL_LABEL (label, FUNC_END_LABEL,
                               current_function_funcdef_no);
   ASM_OUTPUT_LABEL (asm_out_file, label);
-  fde = &fde_table[fde_table_in_use - 1];
+  fde = current_fde ();
+  gcc_assert (fde != NULL);
   fde->dw_fde_end = xstrdup (label);
 }
 
@@ -2652,7 +2703,7 @@ void
 dwarf2out_frame_init (void)
 {
   /* Allocate the initial hunk of the fde_table.  */
-  fde_table = ggc_alloc_cleared (FDE_TABLE_INCREMENT * sizeof (dw_fde_node));
+  fde_table = GGC_CNEWVEC (dw_fde_node, FDE_TABLE_INCREMENT);
   fde_table_allocated = FDE_TABLE_INCREMENT;
   fde_table_in_use = 0;
 
@@ -2681,6 +2732,41 @@ dwarf2out_frame_finish (void)
     output_call_frame_info (1);
 #endif
 }
+
+/* Note that the current function section is being used for code.  */
+
+static void
+dwarf2out_note_section_used (void)
+{
+  section *sec = current_function_section ();
+  if (sec == text_section)
+    text_section_used = true;
+  else if (sec == cold_text_section)
+    cold_text_section_used = true;
+}
+
+void
+dwarf2out_switch_text_section (void)
+{
+  dw_fde_ref fde = current_fde ();
+
+  gcc_assert (cfun && fde);
+
+  fde->dw_fde_switched_sections = true;
+  fde->dw_fde_hot_section_label = crtl->subsections.hot_section_label;
+  fde->dw_fde_hot_section_end_label = crtl->subsections.hot_section_end_label;
+  fde->dw_fde_unlikely_section_label = crtl->subsections.cold_section_label;
+  fde->dw_fde_unlikely_section_end_label = crtl->subsections.cold_section_end_label;
+  have_multiple_function_sections = true;
+
+  /* Reset the current label on switching text sections, so that we
+     don't attempt to advance_loc4 between labels in different sections.  */
+  fde->dw_fde_current_label = NULL;
+
+  /* There is no need to mark used sections when not debugging.  */
+  if (cold_text_section != NULL)
+    dwarf2out_note_section_used ();
+}
 #endif
 \f
 /* And now, the subset of the debugging information support code necessary
@@ -3141,7 +3227,7 @@ static inline dw_loc_descr_ref
 new_loc_descr (enum dwarf_location_atom op, unsigned HOST_WIDE_INT oprnd1,
               unsigned HOST_WIDE_INT oprnd2)
 {
-  dw_loc_descr_ref descr = ggc_alloc_cleared (sizeof (dw_loc_descr_node));
+  dw_loc_descr_ref descr = GGC_CNEW (dw_loc_descr_node);
 
   descr->dw_loc_opc = op;
   descr->dw_loc_oprnd1.val_class = dw_val_class_unsigned_const;
@@ -3659,7 +3745,6 @@ static void dwarf2out_imported_module_or_decl (tree, tree);
 static void dwarf2out_abstract_function (tree);
 static void dwarf2out_var_location (rtx);
 static void dwarf2out_begin_function (tree);
-static void dwarf2out_switch_text_section (void);
 
 /* The debug hooks structure.  */
 
@@ -3760,7 +3845,7 @@ DEF_VEC_ALLOC_O(dw_attr_node,gc);
    The children of each node form a circular list linked by
    die_sib.  die_child points to the node *before* the "first" child node.  */
 
-typedef struct die_struct GTY(())
+typedef struct die_struct GTY((chain_circular ("%h.die_sib")))
 {
   enum dwarf_tag die_tag;
   char *die_symbol;
@@ -3968,9 +4053,6 @@ static GTY(()) unsigned line_info_table_allocated;
 /* Number of elements in line_info_table currently in use.  */
 static GTY(()) unsigned line_info_table_in_use;
 
-/* True if the compilation unit places functions in more than one section.  */
-static GTY(()) bool have_multiple_function_sections = false;
-
 /* A pointer to the base of a table that contains line information
    for each source code line outside of .text in the compilation unit.  */
 static GTY ((length ("separate_line_info_table_allocated")))
@@ -4053,15 +4135,6 @@ static GTY(()) int label_num;
 /* Cached result of previous call to lookup_filename.  */
 static GTY(()) struct dwarf_file_data * file_table_last_lookup;
 
-/* Whether the default text and cold text sections have been used at
-   all.  */
-
-static GTY(()) bool text_section_used = false;
-static GTY(()) bool cold_text_section_used = false;
-
-/* The default cold text section.  */
-static GTY(()) section *cold_text_section;
-
 #ifdef DWARF2_DEBUGGING_INFO
 
 /* Offset from the "steady-state frame pointer" to the frame base,
@@ -4187,6 +4260,7 @@ static void output_compilation_unit_header (void);
 static void output_comp_unit (dw_die_ref, int);
 static const char *dwarf2_name (tree, int);
 static void add_pubname (tree, dw_die_ref);
+static void add_pubname_string (const char *, dw_die_ref);
 static void add_pubtype (tree, dw_die_ref);
 static void output_pubnames (VEC (pubname_entry,gc) *);
 static void add_arange (tree, dw_die_ref);
@@ -4206,7 +4280,7 @@ static int type_is_enum (const_tree);
 static unsigned int dbx_reg_number (const_rtx);
 static void add_loc_descr_op_piece (dw_loc_descr_ref *, int);
 static dw_loc_descr_ref reg_loc_descriptor (rtx, enum var_init_status);
-static dw_loc_descr_ref one_reg_loc_descriptor (unsigned int, 
+static dw_loc_descr_ref one_reg_loc_descriptor (unsigned int,
                                                enum var_init_status);
 static dw_loc_descr_ref multiple_reg_loc_descriptor (rtx, rtx,
                                                     enum var_init_status);
@@ -4356,7 +4430,7 @@ static int maybe_emit_file (struct dwarf_file_data *fd);
 
 /* Section flags for .debug_str section.  */
 #define DEBUG_STR_SECTION_FLAGS \
-  (HAVE_GAS_SHF_MERGE && flag_merge_constants                  \
+  (HAVE_GAS_SHF_MERGE && flag_merge_debug_strings              \
    ? SECTION_DEBUG | SECTION_MERGE | SECTION_STRINGS | 1       \
    : SECTION_DEBUG)
 
@@ -4562,8 +4636,6 @@ dwarf_tag_name (unsigned int tag)
       return "DW_TAG_namelist";
     case DW_TAG_namelist_item:
       return "DW_TAG_namelist_item";
-    case DW_TAG_namespace:
-      return "DW_TAG_namespace";
     case DW_TAG_packed_type:
       return "DW_TAG_packed_type";
     case DW_TAG_subprogram:
@@ -4582,8 +4654,26 @@ dwarf_tag_name (unsigned int tag)
       return "DW_TAG_variable";
     case DW_TAG_volatile_type:
       return "DW_TAG_volatile_type";
+    case DW_TAG_dwarf_procedure:
+      return "DW_TAG_dwarf_procedure";
+    case DW_TAG_restrict_type:
+      return "DW_TAG_restrict_type";
+    case DW_TAG_interface_type:
+      return "DW_TAG_interface_type";
+    case DW_TAG_namespace:
+      return "DW_TAG_namespace";
     case DW_TAG_imported_module:
       return "DW_TAG_imported_module";
+    case DW_TAG_unspecified_type:
+      return "DW_TAG_unspecified_type";
+    case DW_TAG_partial_unit:
+      return "DW_TAG_partial_unit";
+    case DW_TAG_imported_unit:
+      return "DW_TAG_imported_unit";
+    case DW_TAG_condition:
+      return "DW_TAG_condition";
+    case DW_TAG_shared_type:
+      return "DW_TAG_shared_type";
     case DW_TAG_MIPS_loop:
       return "DW_TAG_MIPS_loop";
     case DW_TAG_format_label:
@@ -5656,7 +5746,7 @@ splice_child_die (dw_die_ref parent, dw_die_ref child)
 static inline dw_die_ref
 new_die (enum dwarf_tag tag_value, dw_die_ref parent_die, tree t)
 {
-  dw_die_ref die = ggc_alloc_cleared (sizeof (die_node));
+  dw_die_ref die = GGC_CNEW (die_node);
 
   die->die_tag = tag_value;
 
@@ -5666,7 +5756,7 @@ new_die (enum dwarf_tag tag_value, dw_die_ref parent_die, tree t)
     {
       limbo_die_node *limbo_node;
 
-      limbo_node = ggc_alloc_cleared (sizeof (limbo_die_node));
+      limbo_node = GGC_CNEW (limbo_die_node);
       limbo_node->die = die;
       limbo_node->created_for = t;
       limbo_node->next = limbo_die_list;
@@ -5713,7 +5803,7 @@ decl_die_table_eq (const void *x, const void *y)
 static inline dw_die_ref
 lookup_decl_die (tree decl)
 {
-  return htab_find_with_hash (decl_die_table, decl, DECL_UID (decl));
+  return (dw_die_ref) htab_find_with_hash (decl_die_table, decl, DECL_UID (decl));
 }
 
 /* Returns a hash value for X (which really is a var_loc_list).  */
@@ -5738,7 +5828,8 @@ decl_loc_table_eq (const void *x, const void *y)
 static inline var_loc_list *
 lookup_decl_loc (const_tree decl)
 {
-  return htab_find_with_hash (decl_loc_table, decl, DECL_UID (decl));
+  return (var_loc_list *)
+    htab_find_with_hash (decl_loc_table, decl, DECL_UID (decl));
 }
 
 /* Equate a DIE to a particular declaration.  */
@@ -5766,12 +5857,12 @@ add_var_loc_to_decl (tree decl, struct var_loc_node *loc)
   slot = htab_find_slot_with_hash (decl_loc_table, decl, decl_id, INSERT);
   if (*slot == NULL)
     {
-      temp = ggc_alloc_cleared (sizeof (var_loc_list));
+      temp = GGC_CNEW (var_loc_list);
       temp->decl_id = decl_id;
       *slot = temp;
     }
   else
-    temp = *slot;
+    temp = (var_loc_list *) *slot;
 
   if (temp->last)
     {
@@ -6263,7 +6354,7 @@ compute_section_prefix (dw_die_ref unit_die)
 {
   const char *die_name = get_AT_string (unit_die, DW_AT_name);
   const char *base = die_name ? lbasename (die_name) : "anonymous";
-  char *name = alloca (strlen (base) + 64);
+  char *name = XALLOCAVEC (char, strlen (base) + 64);
   char *p;
   int i, mark;
   unsigned char checksum[16];
@@ -6301,6 +6392,7 @@ is_type_die (dw_die_ref die)
     {
     case DW_TAG_array_type:
     case DW_TAG_class_type:
+    case DW_TAG_interface_type:
     case DW_TAG_enumeration_type:
     case DW_TAG_pointer_type:
     case DW_TAG_reference_type:
@@ -6384,7 +6476,7 @@ assign_symbol_names (dw_die_ref die)
     {
       if (comdat_symbol_id)
        {
-         char *p = alloca (strlen (comdat_symbol_id) + 64);
+         char *p = XALLOCAVEC (char, strlen (comdat_symbol_id) + 64);
 
          sprintf (p, "%s.%s.%x", DIE_LABEL_PREFIX,
                   comdat_symbol_id, comdat_symbol_number++);
@@ -6408,7 +6500,8 @@ struct cu_hash_table_entry
 static hashval_t
 htab_cu_hash (const void *of)
 {
-  const struct cu_hash_table_entry *entry = of;
+  const struct cu_hash_table_entry *const entry =
+    (const struct cu_hash_table_entry *) of;
 
   return htab_hash_string (entry->cu->die_symbol);
 }
@@ -6416,8 +6509,9 @@ htab_cu_hash (const void *of)
 static int
 htab_cu_eq (const void *of1, const void *of2)
 {
-  const struct cu_hash_table_entry *entry1 = of1;
-  const struct die_struct *entry2 = of2;
+  const struct cu_hash_table_entry *const entry1 =
+    (const struct cu_hash_table_entry *) of1;
+  const struct die_struct *const entry2 = (const struct die_struct *) of2;
 
   return !strcmp (entry1->cu->die_symbol, entry2->die_symbol);
 }
@@ -6425,7 +6519,8 @@ htab_cu_eq (const void *of1, const void *of2)
 static void
 htab_cu_del (void *what)
 {
-  struct cu_hash_table_entry *next, *entry = what;
+  struct cu_hash_table_entry *next,
+    *entry = (struct cu_hash_table_entry *) what;
 
   while (entry)
     {
@@ -6645,8 +6740,8 @@ build_abbrev_table (dw_die_ref die)
       if (abbrev_die_table_in_use >= abbrev_die_table_allocated)
        {
          n_alloc = abbrev_die_table_allocated + ABBREV_DIE_TABLE_INCREMENT;
-         abbrev_die_table = ggc_realloc (abbrev_die_table,
-                                         sizeof (dw_die_ref) * n_alloc);
+         abbrev_die_table = GGC_RESIZEVEC (dw_die_ref, abbrev_die_table,
+                                           n_alloc);
 
          memset (&abbrev_die_table[abbrev_die_table_allocated], 0,
                 (n_alloc - abbrev_die_table_allocated) * sizeof (dw_die_ref));
@@ -7036,7 +7131,7 @@ static inline dw_loc_list_ref
 new_loc_list (dw_loc_descr_ref expr, const char *begin, const char *end,
              const char *section, unsigned int gensym)
 {
-  dw_loc_list_ref retlist = ggc_alloc_cleared (sizeof (dw_loc_list_node));
+  dw_loc_list_ref retlist = GGC_CNEW (dw_loc_list_node);
 
   retlist->begin = begin;
   retlist->end = end;
@@ -7065,40 +7160,6 @@ add_loc_descr_to_loc_list (dw_loc_list_ref *list_head, dw_loc_descr_ref descr,
   *d = new_loc_list (descr, begin, end, section, 0);
 }
 
-/* Note that the current function section is being used for code.  */
-
-static void
-dwarf2out_note_section_used (void)
-{
-  section *sec = current_function_section ();
-  if (sec == text_section)
-    text_section_used = true;
-  else if (sec == cold_text_section)
-    cold_text_section_used = true;
-}
-
-static void
-dwarf2out_switch_text_section (void)
-{
-  dw_fde_ref fde;
-
-  gcc_assert (cfun);
-
-  fde = &fde_table[fde_table_in_use - 1];
-  fde->dw_fde_switched_sections = true;
-  fde->dw_fde_hot_section_label = cfun->hot_section_label;
-  fde->dw_fde_hot_section_end_label = cfun->hot_section_end_label;
-  fde->dw_fde_unlikely_section_label = cfun->cold_section_label;
-  fde->dw_fde_unlikely_section_end_label = cfun->cold_section_end_label;
-  have_multiple_function_sections = true;
-
-  /* Reset the current label on switching text sections, so that we
-     don't attempt to advance_loc4 between labels in different sections.  */
-  fde->dw_fde_current_label = NULL;
-
-  dwarf2out_note_section_used ();
-}
-
 /* Output the location list given to us.  */
 
 static void
@@ -7400,7 +7461,7 @@ output_comp_unit (dw_die_ref die, int output_if_empty)
   oldsym = die->die_symbol;
   if (oldsym)
     {
-      tmp = alloca (strlen (oldsym) + 24);
+      tmp = XALLOCAVEC (char, strlen (oldsym) + 24);
 
       sprintf (tmp, ".gnu.linkonce.wi.%s", oldsym);
       secname = tmp;
@@ -7434,18 +7495,23 @@ dwarf2_name (tree decl, int scope)
 /* 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
@@ -7539,9 +7605,8 @@ add_arange (tree decl, dw_die_ref die)
   if (arange_table_in_use == arange_table_allocated)
     {
       arange_table_allocated += ARANGE_TABLE_INCREMENT;
-      arange_table = ggc_realloc (arange_table,
-                                 (arange_table_allocated
-                                  * sizeof (dw_die_ref)));
+      arange_table = GGC_RESIZEVEC (dw_die_ref, arange_table,
+                                   arange_table_allocated);
       memset (arange_table + arange_table_in_use, 0,
              ARANGE_TABLE_INCREMENT * sizeof (dw_die_ref));
     }
@@ -7652,9 +7717,8 @@ add_ranges_num (int num)
   if (in_use == ranges_table_allocated)
     {
       ranges_table_allocated += RANGES_TABLE_INCREMENT;
-      ranges_table
-       = ggc_realloc (ranges_table, (ranges_table_allocated
-                                     * sizeof (struct dw_ranges_struct)));
+      ranges_table = GGC_RESIZEVEC (struct dw_ranges_struct, ranges_table,
+                                   ranges_table_allocated);
       memset (ranges_table + ranges_table_in_use, 0,
              RANGES_TABLE_INCREMENT * sizeof (struct dw_ranges_struct));
     }
@@ -7685,10 +7749,9 @@ add_ranges_by_labels (const char *begin, const char *end)
   if (in_use == ranges_by_label_allocated)
     {
       ranges_by_label_allocated += RANGES_TABLE_INCREMENT;
-      ranges_by_label
-       = ggc_realloc (ranges_by_label,
-                      (ranges_by_label_allocated
-                       * sizeof (struct dw_ranges_by_label_struct)));
+      ranges_by_label = GGC_RESIZEVEC (struct dw_ranges_by_label_struct,
+                                      ranges_by_label,
+                                      ranges_by_label_allocated);
       memset (ranges_by_label + ranges_by_label_in_use, 0,
              RANGES_TABLE_INCREMENT
              * sizeof (struct dw_ranges_by_label_struct));
@@ -7813,8 +7876,8 @@ struct dir_info
 static int
 file_info_cmp (const void *p1, const void *p2)
 {
-  const struct file_info *s1 = p1;
-  const struct file_info *s2 = p2;
+  const struct file_info *const s1 = (const struct file_info *) p1;
+  const struct file_info *const s2 = (const struct file_info *) p2;
   const unsigned char *cp1;
   const unsigned char *cp2;
 
@@ -7857,8 +7920,8 @@ struct file_name_acquire_data
 static int
 file_name_acquire (void ** slot, void *data)
 {
-  struct file_name_acquire_data *fnad = data;
-  struct dwarf_file_data *d = *slot;
+  struct file_name_acquire_data *fnad = (struct file_name_acquire_data *) data;
+  struct dwarf_file_data *d = (struct dwarf_file_data *) *slot;
   struct file_info *fi;
   const char *f;
 
@@ -7928,8 +7991,8 @@ output_file_names (void)
   numfiles = last_emitted_file->emitted_number;
 
   /* Allocate the various arrays we need.  */
-  files = alloca (numfiles * sizeof (struct file_info));
-  dirs = alloca (numfiles * sizeof (struct dir_info));
+  files = XALLOCAVEC (struct file_info, numfiles);
+  dirs = XALLOCAVEC (struct dir_info, numfiles);
 
   fnad.files = files;
   fnad.used_files = 0;
@@ -7987,8 +8050,8 @@ output_file_names (void)
      where we would have to check out every combination of every single
      possible prefix.  Instead we use a heuristic which provides nearly optimal
      results in most cases and never is much off.  */
-  saved = alloca (ndirs * sizeof (int));
-  savehere = alloca (ndirs * sizeof (int));
+  saved = XALLOCAVEC (int, ndirs);
+  savehere = XALLOCAVEC (int, ndirs);
 
   memset (saved, '\0', ndirs * sizeof (saved[0]));
   for (i = 0; i < ndirs; i++)
@@ -8054,7 +8117,7 @@ output_file_names (void)
   /* We have to emit them in the order of emitted_number since that's
      used in the debug info generation.  To do this efficiently we
      generate a back-mapping of the indices first.  */
-  backmap = alloca (numfiles * sizeof (int));
+  backmap = XALLOCAVEC (int, numfiles);
   for (i = 0; i < numfiles; i++)
     backmap[files[i].file_idx->emitted_number - 1] = i;
 
@@ -8169,7 +8232,7 @@ output_line_info (void)
   current_line = 1;
 
   if (cfun && in_cold_section_p)
-    strcpy (prev_line_label, cfun->cold_section_label);
+    strcpy (prev_line_label, crtl->subsections.cold_section_label);
   else
     strcpy (prev_line_label, text_section_label);
   for (lt_index = 1; lt_index < line_info_table_in_use; ++lt_index)
@@ -8847,7 +8910,7 @@ one_reg_loc_descriptor (unsigned int regno, enum var_init_status initialized)
    designates a value that spans more than one register.  */
 
 static dw_loc_descr_ref
-multiple_reg_loc_descriptor (rtx rtl, rtx regs, 
+multiple_reg_loc_descriptor (rtx rtl, rtx regs,
                             enum var_init_status initialized)
 {
   int nregs, size, i;
@@ -9235,7 +9298,7 @@ mem_loc_descriptor (rtx rtl, enum machine_mode mode,
       break;
 
     case CONCATN:
-      mem_loc_result = concatn_mem_loc_descriptor (rtl, mode, 
+      mem_loc_result = concatn_mem_loc_descriptor (rtl, mode,
                                                   VAR_INIT_STATUS_INITIALIZED);
       break;
 
@@ -9440,15 +9503,32 @@ loc_descriptor_from_tree_1 (tree loc, int want_address)
       if (DECL_THREAD_LOCAL_P (loc))
        {
          rtx rtl;
+         unsigned first_op;
+         unsigned second_op;
 
-         /* If this is not defined, we have no way to emit the data.  */
-         if (!targetm.have_tls || !targetm.asm_out.output_dwarf_dtprel)
-           return 0;
-
-         /* 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))
-           return 0;
+         if (targetm.have_tls)
+           {
+             /* If this is not defined, we have no way to emit the
+                data.  */
+             if (!targetm.asm_out.output_dwarf_dtprel)
+               return 0;
+
+              /* 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))
+               return 0;
+             first_op = INTERNAL_DW_OP_tls_addr;
+             second_op = DW_OP_GNU_push_tls_address;
+           }
+         else
+           {
+             if (!targetm.emutls.debug_form_tls_address)
+               return 0;
+             loc = emutls_decl (loc);
+             first_op = DW_OP_addr;
+             second_op = DW_OP_form_tls_address;
+           }
 
          rtl = rtl_for_decl_location (loc);
          if (rtl == NULL_RTX)
@@ -9460,11 +9540,11 @@ loc_descriptor_from_tree_1 (tree loc, int want_address)
          if (! CONSTANT_P (rtl))
            return 0;
 
-         ret = new_loc_descr (INTERNAL_DW_OP_tls_addr, 0, 0);
+         ret = new_loc_descr (first_op, 0, 0);
          ret->dw_loc_oprnd1.val_class = dw_val_class_addr;
          ret->dw_loc_oprnd1.v.val_addr = rtl;
 
-         ret1 = new_loc_descr (DW_OP_GNU_push_tls_address, 0, 0);
+         ret1 = new_loc_descr (second_op, 0, 0);
          add_loc_descr (&ret, ret1);
 
          have_address = 1;
@@ -9527,9 +9607,7 @@ loc_descriptor_from_tree_1 (tree loc, int want_address)
     case COMPOUND_EXPR:
       return loc_descriptor_from_tree_1 (TREE_OPERAND (loc, 1), want_address);
 
-    case NOP_EXPR:
-    case CONVERT_EXPR:
-    case NON_LVALUE_EXPR:
+    CASE_CONVERT:
     case VIEW_CONVERT_EXPR:
     case SAVE_EXPR:
     case GIMPLE_MODIFY_STMT:
@@ -10215,7 +10293,7 @@ add_const_value_attribute (dw_die_ref die, rtx rtl)
        if (SCALAR_FLOAT_MODE_P (mode))
          {
            unsigned int length = GET_MODE_SIZE (mode);
-           unsigned char *array = ggc_alloc (length);
+           unsigned char *array = GGC_NEWVEC (unsigned char, length);
 
            insert_float (rtl, array);
            add_AT_vec (die, DW_AT_const_value, length / 4, 4, array);
@@ -10236,7 +10314,7 @@ add_const_value_attribute (dw_die_ref die, rtx rtl)
        enum machine_mode mode = GET_MODE (rtl);
        unsigned int elt_size = GET_MODE_UNIT_SIZE (mode);
        unsigned int length = CONST_VECTOR_NUNITS (rtl);
-       unsigned char *array = ggc_alloc (length * elt_size);
+       unsigned char *array = GGC_NEWVEC (unsigned char, length * elt_size);
        unsigned int i;
        unsigned char *p;
 
@@ -10365,6 +10443,8 @@ reference_to_unused (tree * tp, int * walk_subtrees,
       if (!node->output)
        return *tp;
     }
+  else if (TREE_CODE (*tp) == STRING_CST && !TREE_ASM_WRITTEN (*tp))
+    return *tp;
 
   return NULL_TREE;
 }
@@ -10680,13 +10760,64 @@ secname_for_decl (const_tree decl)
       secname = TREE_STRING_POINTER (sectree);
     }
   else if (cfun && in_cold_section_p)
-    secname = cfun->cold_section_label;
+    secname = crtl->subsections.cold_section_label;
   else
     secname = text_section_label;
 
   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
+   value is the offset into the common block for the symbol.  */
+
+static tree
+fortran_common (tree decl, HOST_WIDE_INT *value)
+{
+  tree val_expr, cvar;
+  enum machine_mode mode;
+  HOST_WIDE_INT bitsize, bitpos;
+  tree offset;
+  int volatilep = 0, unsignedp = 0;
+
+  /* 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)
+      || !is_fortran ())
+    return NULL_TREE;
+
+  val_expr = DECL_VALUE_EXPR (decl);
+  if (TREE_CODE (val_expr) != COMPONENT_REF)
+    return NULL_TREE;
+
+  cvar = get_inner_reference (val_expr, &bitsize, &bitpos, &offset,
+                             &mode, &unsignedp, &volatilep, true);
+
+  if (cvar == NULL_TREE
+      || TREE_CODE (cvar) != VAR_DECL
+      || DECL_ARTIFICIAL (cvar)
+      || !TREE_PUBLIC (cvar))
+    return NULL_TREE;
+
+  *value = 0;
+  if (offset != NULL)
+    {
+      if (!host_integerp (offset, 0))
+       return NULL_TREE;
+      *value = tree_low_cst (offset, 0);
+    }
+  if (bitpos != 0)
+    *value += bitpos / BITS_PER_UNIT;
+
+  return cvar;
+}
+
+
 /* 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
@@ -10756,7 +10887,7 @@ 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, 
+           add_loc_descr_to_loc_list (&list,
                                       loc_descriptor (varloc, initialized),
                                       node->label, node->next->label, secname);
          }
@@ -10778,7 +10909,7 @@ 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, 
+         add_loc_descr_to_loc_list (&list,
                                     loc_descriptor (varloc, initialized),
                                     node->label, endname, secname);
        }
@@ -10863,7 +10994,8 @@ convert_cfa_to_fb_loc_list (HOST_WIDE_INT offset)
   dw_cfa_location last_cfa, next_cfa;
   const char *start_label, *last_label, *section;
 
-  fde = &fde_table[fde_table_in_use - 1];
+  fde = current_fde ();
+  gcc_assert (fde != NULL);
 
   section = secname_for_decl (current_function_decl);
   list_tail = &list;
@@ -11010,9 +11142,7 @@ add_bound_info (dw_die_ref subrange_die, enum dwarf_attribute bound_attr, tree b
        add_AT_unsigned (subrange_die, bound_attr, tree_low_cst (bound, 0));
       break;
 
-    case CONVERT_EXPR:
-    case NOP_EXPR:
-    case NON_LVALUE_EXPR:
+    CASE_CONVERT:
     case VIEW_CONVERT_EXPR:
       add_bound_info (subrange_die, bound_attr, TREE_OPERAND (bound, 0));
       break;
@@ -11473,6 +11603,8 @@ class_or_namespace_scope_p (dw_die_ref context_die)
 {
   return (context_die
          && (context_die->die_tag == DW_TAG_structure_type
+             || context_die->die_tag == DW_TAG_class_type
+             || context_die->die_tag == DW_TAG_interface_type
              || context_die->die_tag == DW_TAG_union_type
              || context_die->die_tag == DW_TAG_namespace));
 }
@@ -11636,6 +11768,12 @@ gen_array_type_die (tree type, dw_die_ref context_die)
       add_AT_flag (array_die, DW_AT_GNU_vector, 1);
     }
 
+  /* 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)
+    add_AT_unsigned (array_die, DW_AT_ordering, DW_ORD_col_major);
+
 #if 0
   /* We default the array ordering.  SDB will probably do
      the right things even if DW_AT_ordering is not present.  It's not even
@@ -11688,8 +11826,7 @@ descr_info_loc (tree val, tree base_decl)
 
   switch (TREE_CODE (val))
     {
-    case NOP_EXPR:
-    case CONVERT_EXPR:
+    CASE_CONVERT:
       return descr_info_loc (TREE_OPERAND (val, 0), base_decl);
     case INTEGER_CST:
       if (host_integerp (val, 0))
@@ -11787,6 +11924,11 @@ gen_descr_array_type_die (tree type, struct array_descr_info *info,
   add_name_attribute (array_die, type_tag (type));
   equate_type_number_to_die (type, array_die);
 
+  /* For Fortran multidimensional arrays use DW_ORD_col_major ordering.  */
+  if (is_fortran ()
+      && info->ndimensions >= 2)
+    add_AT_unsigned (array_die, DW_AT_ordering, DW_ORD_col_major);
+
   if (info->data_location)
     add_descr_info_field (array_die, DW_AT_data_location, info->data_location,
                          info->base_decl);
@@ -11880,12 +12022,36 @@ gen_inlined_enumeration_type_die (tree type, dw_die_ref context_die)
   add_abstract_origin_attribute (type_die, type);
 }
 
+/* Determine what tag to use for a record type.  */
+
+static enum dwarf_tag
+record_type_tag (tree type)
+{
+  if (! lang_hooks.types.classify_record)
+    return DW_TAG_structure_type;
+
+  switch (lang_hooks.types.classify_record (type))
+    {
+    case RECORD_IS_STRUCT:
+      return DW_TAG_structure_type;
+
+    case RECORD_IS_CLASS:
+      return DW_TAG_class_type;
+
+    case RECORD_IS_INTERFACE:
+      return DW_TAG_interface_type;
+
+    default:
+      gcc_unreachable ();
+    }
+}
+
 /* Generate a DIE to represent an inlined instance of a structure type.  */
 
 static void
 gen_inlined_structure_type_die (tree type, dw_die_ref context_die)
 {
-  dw_die_ref type_die = new_die (DW_TAG_structure_type, context_die, type);
+  dw_die_ref type_die = new_die (record_type_tag (type), context_die, type);
 
   /* We do not check for TREE_ASM_WRITTEN (type) being set, as the type may
      be incomplete and such types are not marked.  */
@@ -12193,7 +12359,7 @@ premark_used_types_helper (void **slot, void *data ATTRIBUTE_UNUSED)
   tree type;
   dw_die_ref die;
 
-  type = *slot;
+  type = (tree) *slot;
   die = lookup_type_die (type);
   if (die != NULL)
     die->die_perennial_p = 1;
@@ -12392,7 +12558,7 @@ gen_subprogram_die (tree decl, dw_die_ref context_die)
        }
       else
        {  /* Do nothing for now; maybe need to duplicate die, one for
-             hot section and ond for cold section, then use the hot/cold
+             hot section and one for cold section, then use the hot/cold
              section begin/end labels to generate the aranges...  */
          /*
            add_AT_lbl_id (subr_die, DW_AT_low_pc, hot_section_label);
@@ -12547,9 +12713,10 @@ gen_subprogram_die (tree decl, dw_die_ref context_die)
 static void
 gen_variable_die (tree decl, dw_die_ref context_die)
 {
+  HOST_WIDE_INT off;
+  tree com_decl;
+  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
@@ -12573,6 +12740,37 @@ gen_variable_die (tree decl, dw_die_ref context_die)
                         && DECL_COMDAT (decl) && !TREE_ASM_WRITTEN (decl))
                     || class_or_namespace_scope_p (context_die));
 
+  com_decl = fortran_common (decl, &off);
+
+  /* Symbol in common gets emitted as a child of the common block, in the form
+     of a data member.
+
+     ??? This creates a new common block die for every common block symbol.
+     Better to share same common block die for all symbols in that block.  */
+  if (com_decl)
+    {
+      tree field;
+      dw_die_ref com_die;
+      const char *cnam = IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (com_decl));
+      dw_loc_descr_ref loc = loc_descriptor_from_tree (com_decl);
+
+      field = 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, field);
+      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);
 
@@ -12953,7 +13151,7 @@ gen_compile_unit_die (const char *filename)
     language = DW_LANG_Ada95;
   else if (strcmp (language_string, "GNU F77") == 0)
     language = DW_LANG_Fortran77;
-  else if (strcmp (language_string, "GNU F95") == 0)
+  else if (strcmp (language_string, "GNU Fortran") == 0)
     language = DW_LANG_Fortran95;
   else if (strcmp (language_string, "GNU Pascal") == 0)
     language = DW_LANG_Pascal83;
@@ -13086,7 +13284,7 @@ gen_struct_or_union_type_die (tree type, dw_die_ref context_die,
       dw_die_ref old_die = type_die;
 
       type_die = new_die (TREE_CODE (type) == RECORD_TYPE
-                         ? DW_TAG_structure_type : DW_TAG_union_type,
+                         ? record_type_tag (type) : DW_TAG_union_type,
                          scope_die, type);
       equate_type_number_to_die (type, type_die);
       if (old_die)
@@ -13548,8 +13746,13 @@ decls_for_scope (tree stmt, dw_die_ref context_die, int depth)
            add_child_die (context_die, die);
          /* Do not produce debug information for static variables since
             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))
+            in varpool_analyze_pending_decls.
+
+            But *do* produce it for Fortran COMMON variables because,
+            even though they are static, their names can differ depending
+            on the scope, which we need to preserve.  */
+         if (TREE_CODE (decl) == VAR_DECL && TREE_STATIC (decl)
+             && !(is_fortran () && TREE_PUBLIC (decl)))
            ;
          else
            gen_decl_die (decl, context_die);
@@ -13675,11 +13878,8 @@ force_type_die (tree type)
       else
        context_die = comp_unit_die;
 
-      type_die = lookup_type_die (type);
-      if (type_die)
-       return type_die;
-      gen_type_die (type, context_die);
-      type_die = lookup_type_die (type);
+      type_die = modified_type_die (type, TYPE_READONLY (type),
+                                   TYPE_VOLATILE (type), context_die);
       gcc_assert (type_die);
     }
   return type_die;
@@ -13880,6 +14080,16 @@ gen_decl_die (tree decl, dw_die_ref context_die)
       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.  */
       if (TREE_CODE (decl) == RESULT_DECL && DECL_BY_REFERENCE (decl))
@@ -13944,9 +14154,17 @@ static void
 dwarf2out_global_decl (tree decl)
 {
   /* Output DWARF2 information for file-scope tentative data object
-     declarations, file-scope (extern) function declarations (which had no
-     corresponding body) and file-scope tagged type declarations and
-     definitions which have not yet been forced out.  */
+     declarations, file-scope (extern) function declarations (which
+     had no corresponding body) and file-scope tagged type declarations
+     and definitions which have not yet been forced out.
+
+     Ignore the global decl of any Fortran COMMON blocks which also
+     wind up here though they have already been described in the local
+     scope for the procedures using them.  */
+  if (TREE_CODE (decl) == VAR_DECL
+      && TREE_PUBLIC (decl) && TREE_STATIC (decl) && is_fortran ())
+    return;
+
   if (TREE_CODE (decl) != FUNCTION_DECL || !DECL_INITIAL (decl))
     dwarf2out_decl (decl);
 }
@@ -14205,15 +14423,16 @@ dwarf2out_ignore_block (const_tree block)
 static int
 file_table_eq (const void *p1_p, const void *p2_p)
 {
-  const struct dwarf_file_data * p1 = p1_p;
-  const char * p2 = p2_p;
+  const struct dwarf_file_data *const p1 =
+    (const struct dwarf_file_data *) p1_p;
+  const char *const p2 = (const char *) p2_p;
   return strcmp (p1->filename, p2) == 0;
 }
 
 static hashval_t
 file_table_hash (const void *p_p)
 {
-  const struct dwarf_file_data * p = p_p;
+  const struct dwarf_file_data *const p = (const struct dwarf_file_data *) p_p;
   return htab_hash_string (p->filename);
 }
 
@@ -14245,9 +14464,9 @@ lookup_filename (const char *file_name)
   slot = htab_find_slot_with_hash (file_table, file_name,
                                   htab_hash_string (file_name), INSERT);
   if (*slot)
-    return *slot;
+    return (struct dwarf_file_data *) *slot;
 
-  created = ggc_alloc (sizeof (struct dwarf_file_data));
+  created = GGC_NEW (struct dwarf_file_data);
   created->filename = file_name;
   created->emitted_number = 0;
   *slot = created;
@@ -14301,7 +14520,7 @@ dwarf2out_var_location (rtx loc_note)
     return;
   prev_insn = PREV_INSN (loc_note);
 
-  newloc = ggc_alloc_cleared (sizeof (struct var_loc_node));
+  newloc = GGC_CNEW (struct var_loc_node);
   /* If the insn we processed last time is the previous insn
      and it is also a var location note, use the label we emitted
      last time.  */
@@ -14323,7 +14542,7 @@ dwarf2out_var_location (rtx loc_note)
   newloc->next = NULL;
 
   if (cfun && in_cold_section_p)
-    newloc->section_label = cfun->cold_section_label;
+    newloc->section_label = crtl->subsections.cold_section_label;
   else
     newloc->section_label = text_section_label;
 
@@ -14389,9 +14608,9 @@ dwarf2out_source_line (unsigned int line, const char *filename)
            {
              separate_line_info_table_allocated += LINE_INFO_TABLE_INCREMENT;
              separate_line_info_table
-               = ggc_realloc (separate_line_info_table,
-                              separate_line_info_table_allocated
-                              * sizeof (dw_separate_line_info_entry));
+               = GGC_RESIZEVEC (dw_separate_line_info_entry,
+                                separate_line_info_table,
+                                separate_line_info_table_allocated);
              memset (separate_line_info_table
                       + separate_line_info_table_in_use,
                      0,
@@ -14418,9 +14637,8 @@ dwarf2out_source_line (unsigned int line, const char *filename)
            {
              line_info_table_allocated += LINE_INFO_TABLE_INCREMENT;
              line_info_table
-               = ggc_realloc (line_info_table,
-                              (line_info_table_allocated
-                               * sizeof (dw_line_info_entry)));
+               = GGC_RESIZEVEC (dw_line_info_entry, line_info_table,
+                                line_info_table_allocated);
              memset (line_info_table + line_info_table_in_use, 0,
                      LINE_INFO_TABLE_INCREMENT * sizeof (dw_line_info_entry));
            }
@@ -14531,15 +14749,13 @@ dwarf2out_init (const char *filename ATTRIBUTE_UNUSED)
   decl_scope_table = VEC_alloc (tree, gc, 256);
 
   /* Allocate the initial hunk of the abbrev_die_table.  */
-  abbrev_die_table = ggc_alloc_cleared (ABBREV_DIE_TABLE_INCREMENT
-                                       * sizeof (dw_die_ref));
+  abbrev_die_table = GGC_CNEWVEC (dw_die_ref, ABBREV_DIE_TABLE_INCREMENT);
   abbrev_die_table_allocated = ABBREV_DIE_TABLE_INCREMENT;
   /* Zero-th entry is allocated, but unused.  */
   abbrev_die_table_in_use = 1;
 
   /* Allocate the initial hunk of the line_info_table.  */
-  line_info_table = ggc_alloc_cleared (LINE_INFO_TABLE_INCREMENT
-                                      * sizeof (dw_line_info_entry));
+  line_info_table = GGC_CNEWVEC (dw_line_info_entry, LINE_INFO_TABLE_INCREMENT);
   line_info_table_allocated = LINE_INFO_TABLE_INCREMENT;
 
   /* Zero-th entry is allocated, but unused.  */
@@ -14760,6 +14976,7 @@ prune_unused_types_walk (dw_die_ref die)
     case DW_TAG_structure_type:
     case DW_TAG_union_type:
     case DW_TAG_class_type:
+    case DW_TAG_interface_type:
     case DW_TAG_friend:
     case DW_TAG_variant_part:
     case DW_TAG_enumeration_type:
@@ -14902,8 +15119,8 @@ prune_unused_types (void)
 static int
 file_table_relative_p (void ** slot, void *param)
 {
-  bool *p = param;
-  struct dwarf_file_data *d = *slot;
+  bool *p = (bool *) param;
+  struct dwarf_file_data *d = (struct dwarf_file_data *) *slot;
   if (!IS_ABSOLUTE_PATH (d->filename))
     {
       *p = true;