OSDN Git Service

2008-05-27 H.J. Lu <hongjiu.lu@intel.com>
[pf3gnuchains/gcc-fork.git] / gcc / dwarf2out.c
index ec6e121..2113410 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.  */
@@ -354,12 +373,13 @@ static void reg_save (const char *, unsigned, unsigned, HOST_WIDE_INT);
 #ifdef DWARF2_UNWIND_INFO
 static void initial_return_save (rtx);
 #endif
-static HOST_WIDE_INT stack_adjust_offset (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 (rtx);
+static bool clobbers_queued_reg_save (const_rtx);
 static void dwarf2out_frame_debug_expr (rtx, const char *);
 
 /* Support for complex CFA locations.  */
@@ -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.  */
@@ -1025,10 +1046,10 @@ initial_return_save (rtx rtl)
    contains.  */
 
 static HOST_WIDE_INT
-stack_adjust_offset (rtx pattern)
+stack_adjust_offset (const_rtx pattern)
 {
-  rtx src = SET_SRC (pattern);
-  rtx dest = SET_DEST (pattern);
+  const_rtx src = SET_SRC (pattern);
+  const_rtx dest = SET_DEST (pattern);
   HOST_WIDE_INT offset = 0;
   enum rtx_code code;
 
@@ -1286,7 +1307,7 @@ flush_queued_reg_saves (void)
    have a new location for?  */
 
 static bool
-clobbers_queued_reg_save (rtx insn)
+clobbers_queued_reg_save (const_rtx insn)
 {
   struct queued_reg_save *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);
@@ -2223,6 +2270,7 @@ output_call_frame_info (int for_eh)
      specialization doesn't.  */
   if (TARGET_USES_WEAK_UNWIND_INFO
       && ! flag_asynchronous_unwind_tables
+      && flag_exceptions
       && for_eh)
     for (i = 0; i < fde_table_in_use; i++)
       if ((fde_table[i].nothrow || fde_table[i].all_throwers_are_sibcalls)
@@ -2423,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,
@@ -2451,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,
@@ -2477,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])
@@ -2614,8 +2666,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;
 
@@ -2643,7 +2695,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);
 }
 
@@ -2662,7 +2715,7 @@ dwarf2out_frame_init (void)
   dwarf2out_def_cfa (NULL, STACK_POINTER_REGNUM, INCOMING_FRAME_SP_OFFSET);
 
 #ifdef DWARF2_UNWIND_INFO
-  if (DWARF2_UNWIND_INFO)
+  if (DWARF2_UNWIND_INFO || DWARF2_FRAME_INFO)
     initial_return_save (INCOMING_RETURN_ADDR_RTX);
 #endif
 }
@@ -2680,6 +2733,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
@@ -3651,14 +3739,13 @@ static void dwarf2out_start_source_file (unsigned, const char *);
 static void dwarf2out_end_source_file (unsigned);
 static void dwarf2out_begin_block (unsigned, unsigned);
 static void dwarf2out_end_block (unsigned, unsigned);
-static bool dwarf2out_ignore_block (tree);
+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);
 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.  */
 
@@ -3759,7 +3846,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;
@@ -3967,9 +4054,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")))
@@ -4052,15 +4136,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,
@@ -4069,14 +4144,14 @@ static HOST_WIDE_INT frame_pointer_fb_offset;
 
 /* Forward declarations for functions defined in this file.  */
 
-static int is_pseudo_reg (rtx);
+static int is_pseudo_reg (const_rtx);
 static tree type_main_variant (tree);
-static int is_tagged_type (tree);
+static int is_tagged_type (const_tree);
 static const char *dwarf_tag_name (unsigned);
 static const char *dwarf_attr_name (unsigned);
 static const char *dwarf_form_name (unsigned);
-static tree decl_ultimate_origin (tree);
-static tree block_ultimate_origin (tree);
+static tree decl_ultimate_origin (const_tree);
+static tree block_ultimate_origin (const_tree);
 static tree decl_class_context (tree);
 static void add_dwarf_attr (dw_die_ref, dw_attr_ref);
 static inline enum dw_val_class AT_class (dw_attr_ref);
@@ -4139,7 +4214,7 @@ static int decl_die_table_eq (const void *, const void *);
 static dw_die_ref lookup_decl_die (tree);
 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 (tree);
+static var_loc_list *lookup_decl_loc (const_tree);
 static void equate_decl_number_to_die (tree, dw_die_ref);
 static void add_var_loc_to_decl (tree, struct var_loc_node *);
 static void print_spaces (FILE *);
@@ -4151,7 +4226,7 @@ static void loc_checksum (dw_loc_descr_ref, struct md5_ctx *);
 static void attr_checksum (dw_attr_ref, struct md5_ctx *, int *);
 static void die_checksum (dw_die_ref, struct md5_ctx *, int *);
 static int same_loc_p (dw_loc_descr_ref, dw_loc_descr_ref, int *);
-static int same_dw_val_p (dw_val_node *, dw_val_node *, int *);
+static int same_dw_val_p (const dw_val_node *, const dw_val_node *, int *);
 static int same_attr_p (dw_attr_ref, dw_attr_ref, int *);
 static int same_die_p (dw_die_ref, dw_die_ref, int *);
 static int same_die_p_wrap (dw_die_ref, dw_die_ref);
@@ -4186,23 +4261,24 @@ 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);
 static void output_aranges (void);
 static unsigned int add_ranges_num (int);
-static unsigned int add_ranges (tree);
+static unsigned int add_ranges (const_tree);
 static unsigned int add_ranges_by_labels (const char *, const char *);
 static void output_ranges (void);
 static void output_line_info (void);
 static void output_file_names (void);
 static dw_die_ref base_type_die (tree);
 static int is_base_type (tree);
-static bool is_subrange_type (tree);
+static bool is_subrange_type (const_tree);
 static dw_die_ref subrange_type_die (tree, dw_die_ref);
 static dw_die_ref modified_type_die (tree, int, int, dw_die_ref);
-static int type_is_enum (tree);
-static unsigned int dbx_reg_number (rtx);
+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, 
@@ -4212,7 +4288,7 @@ static dw_loc_descr_ref multiple_reg_loc_descriptor (rtx, rtx,
 static dw_loc_descr_ref int_loc_descriptor (HOST_WIDE_INT);
 static dw_loc_descr_ref based_loc_descr (rtx, HOST_WIDE_INT,
                                         enum var_init_status);
-static int is_based_loc (rtx);
+static int is_based_loc (const_rtx);
 static dw_loc_descr_ref mem_loc_descriptor (rtx, enum machine_mode mode,
                                            enum var_init_status);
 static dw_loc_descr_ref concat_loc_descriptor (rtx, rtx,
@@ -4221,18 +4297,18 @@ static dw_loc_descr_ref loc_descriptor (rtx, enum var_init_status);
 static dw_loc_descr_ref loc_descriptor_from_tree_1 (tree, int);
 static dw_loc_descr_ref loc_descriptor_from_tree (tree);
 static HOST_WIDE_INT ceiling (HOST_WIDE_INT, unsigned int);
-static tree field_type (tree);
-static unsigned int simple_type_align_in_bits (tree);
-static unsigned int simple_decl_align_in_bits (tree);
-static unsigned HOST_WIDE_INT simple_type_size_in_bits (tree);
-static HOST_WIDE_INT field_byte_offset (tree);
+static tree field_type (const_tree);
+static unsigned int simple_type_align_in_bits (const_tree);
+static unsigned int simple_decl_align_in_bits (const_tree);
+static unsigned HOST_WIDE_INT simple_type_size_in_bits (const_tree);
+static HOST_WIDE_INT field_byte_offset (const_tree);
 static void add_AT_location_description        (dw_die_ref, enum dwarf_attribute,
                                         dw_loc_descr_ref);
 static void add_data_member_location_attribute (dw_die_ref, tree);
 static void add_const_value_attribute (dw_die_ref, rtx);
 static void insert_int (HOST_WIDE_INT, unsigned, unsigned char *);
 static HOST_WIDE_INT extract_int (const unsigned char *, unsigned);
-static void insert_float (rtx, unsigned char *);
+static void insert_float (const_rtx, unsigned char *);
 static rtx rtl_for_decl_location (tree);
 static void add_location_or_const_value_attribute (dw_die_ref, tree,
                                                   enum dwarf_attribute);
@@ -4256,12 +4332,13 @@ static inline int local_scope_p (dw_die_ref);
 static inline int class_or_namespace_scope_p (dw_die_ref);
 static void add_type_attribute (dw_die_ref, tree, int, int, dw_die_ref);
 static void add_calling_convention_attribute (dw_die_ref, tree);
-static const char *type_tag (tree);
-static tree member_declared_type (tree);
+static const char *type_tag (const_tree);
+static tree member_declared_type (const_tree);
 #if 0
 static const char *decl_start_label (tree);
 #endif
 static void gen_array_type_die (tree, dw_die_ref);
+static void gen_descr_array_type_die (tree, struct array_descr_info *, dw_die_ref);
 #if 0
 static void gen_entry_point_die (tree, dw_die_ref);
 #endif
@@ -4290,7 +4367,7 @@ static void gen_type_die (tree, dw_die_ref);
 static void gen_tagged_type_instantiation_die (tree, dw_die_ref);
 static void gen_block_die (tree, dw_die_ref, int);
 static void decls_for_scope (tree, dw_die_ref, int);
-static int is_redundant_typedef (tree);
+static int is_redundant_typedef (const_tree);
 static void gen_namespace_die (tree);
 static void gen_decl_die (tree, dw_die_ref);
 static dw_die_ref force_decl_die (tree);
@@ -4354,7 +4431,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)
 
@@ -4437,7 +4514,7 @@ dwarf2out_set_demangle_name_func (const char *(*func) (const char *))
 /* Test if rtl node points to a pseudo register.  */
 
 static inline int
-is_pseudo_reg (rtx rtl)
+is_pseudo_reg (const_rtx rtl)
 {
   return ((REG_P (rtl) && REGNO (rtl) >= FIRST_PSEUDO_REGISTER)
          || (GET_CODE (rtl) == SUBREG
@@ -4467,7 +4544,7 @@ type_main_variant (tree type)
 /* Return nonzero if the given type node represents a tagged type.  */
 
 static inline int
-is_tagged_type (tree type)
+is_tagged_type (const_tree type)
 {
   enum tree_code code = TREE_CODE (type);
 
@@ -4560,8 +4637,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:
@@ -4580,8 +4655,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:
@@ -4668,8 +4761,8 @@ dwarf_attr_name (unsigned int attr)
       return "DW_AT_return_addr";
     case DW_AT_start_scope:
       return "DW_AT_start_scope";
-    case DW_AT_stride_size:
-      return "DW_AT_stride_size";
+    case DW_AT_bit_stride:
+      return "DW_AT_bit_stride";
     case DW_AT_upper_bound:
       return "DW_AT_upper_bound";
     case DW_AT_abstract_origin:
@@ -4737,8 +4830,8 @@ dwarf_attr_name (unsigned int attr)
       return "DW_AT_associated";
     case DW_AT_data_location:
       return "DW_AT_data_location";
-    case DW_AT_stride:
-      return "DW_AT_stride";
+    case DW_AT_byte_stride:
+      return "DW_AT_byte_stride";
     case DW_AT_entry_pc:
       return "DW_AT_entry_pc";
     case DW_AT_use_UTF8:
@@ -4863,7 +4956,7 @@ dwarf_form_name (unsigned int form)
    given block.  */
 
 static tree
-decl_ultimate_origin (tree decl)
+decl_ultimate_origin (const_tree decl)
 {
   if (!CODE_CONTAINS_STRUCT (TREE_CODE (decl), TS_DECL_COMMON))
     return NULL_TREE;
@@ -4888,7 +4981,7 @@ decl_ultimate_origin (tree decl)
    given block.  */
 
 static tree
-block_ultimate_origin (tree block)
+block_ultimate_origin (const_tree block)
 {
   tree immediate_origin = BLOCK_ABSTRACT_ORIGIN (block);
 
@@ -5734,7 +5827,7 @@ decl_loc_table_eq (const void *x, const void *y)
 /* Return the var_loc list associated with a given declaration.  */
 
 static inline var_loc_list *
-lookup_decl_loc (tree decl)
+lookup_decl_loc (const_tree decl)
 {
   return htab_find_with_hash (decl_loc_table, decl, DECL_UID (decl));
 }
@@ -6099,7 +6192,7 @@ same_loc_p (dw_loc_descr_ref loc1, dw_loc_descr_ref loc2, int *mark)
 
 /* Do the values look the same?  */
 static int
-same_dw_val_p (dw_val_node *v1, dw_val_node *v2, int *mark)
+same_dw_val_p (const dw_val_node *v1, const dw_val_node *v2, int *mark)
 {
   dw_loc_descr_ref loc1, loc2;
   rtx r1, r2;
@@ -6299,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:
@@ -7063,40 +7157,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
@@ -7432,18 +7492,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
@@ -7667,7 +7732,7 @@ add_ranges_num (int num)
    range terminator if BLOCK is NULL.  */
 
 static unsigned int
-add_ranges (tree block)
+add_ranges (const_tree block)
 {
   return add_ranges_num (block ? BLOCK_NUMBER (block) : 0);
 }
@@ -8167,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)
@@ -8433,9 +8498,9 @@ base_type_die (tree type)
 
     case FIXED_POINT_TYPE:
       if (TYPE_UNSIGNED (type))
-       encoding = DW_ATE_signed_fixed;
-      else
        encoding = DW_ATE_unsigned_fixed;
+      else
+       encoding = DW_ATE_signed_fixed;
       break;
 
       /* Dwarf2 doesn't know anything about complex ints, so use
@@ -8515,7 +8580,7 @@ is_base_type (tree type)
    ERROR_MARK node.  */
 
 static inline unsigned HOST_WIDE_INT
-simple_type_size_in_bits (tree type)
+simple_type_size_in_bits (const_tree type)
 {
   if (TREE_CODE (type) == ERROR_MARK)
     return BITS_PER_WORD;
@@ -8531,7 +8596,7 @@ simple_type_size_in_bits (tree type)
    emitted as a subrange type.  */
 
 static inline bool
-is_subrange_type (tree type)
+is_subrange_type (const_tree type)
 {
   tree subtype = TREE_TYPE (type);
 
@@ -8724,7 +8789,8 @@ modified_type_die (tree type, int is_const_type, int is_volatile_type,
      don't output a DW_TAG_typedef, since there isn't one in the
      user's program; just attach a DW_AT_name to the type.  */
   if (name
-      && (TREE_CODE (name) != TYPE_DECL || TREE_TYPE (name) == qualified_type))
+      && (TREE_CODE (name) != TYPE_DECL
+         || (TREE_TYPE (name) == qualified_type && DECL_NAME (name))))
     {
       if (TREE_CODE (name) == TYPE_DECL)
        /* Could just call add_name_and_src_coords_attributes here,
@@ -8757,7 +8823,7 @@ modified_type_die (tree type, int is_const_type, int is_volatile_type,
    an enumerated type.  */
 
 static inline int
-type_is_enum (tree type)
+type_is_enum (const_tree type)
 {
   return TREE_CODE (type) == ENUMERAL_TYPE;
 }
@@ -8765,7 +8831,7 @@ type_is_enum (tree type)
 /* Return the DBX register number described by a given RTL node.  */
 
 static unsigned int
-dbx_reg_number (rtx rtl)
+dbx_reg_number (const_rtx rtl)
 {
   unsigned regno = REGNO (rtl);
 
@@ -8991,7 +9057,7 @@ based_loc_descr (rtx reg, HOST_WIDE_INT offset,
 /* Return true if this RTL expression describes a base+offset calculation.  */
 
 static inline int
-is_based_loc (rtx rtl)
+is_based_loc (const_rtx rtl)
 {
   return (GET_CODE (rtl) == PLUS
          && ((REG_P (XEXP (rtl, 0))
@@ -9437,16 +9503,33 @@ 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)
            return 0;
@@ -9457,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;
@@ -9524,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:
@@ -9840,7 +9921,7 @@ ceiling (HOST_WIDE_INT value, unsigned int boundary)
    ERROR_MARK node.  */
 
 static inline tree
-field_type (tree decl)
+field_type (const_tree decl)
 {
   tree type;
 
@@ -9859,13 +9940,13 @@ field_type (tree decl)
    be an ERROR_MARK node.  */
 
 static inline unsigned
-simple_type_align_in_bits (tree type)
+simple_type_align_in_bits (const_tree type)
 {
   return (TREE_CODE (type) != ERROR_MARK) ? TYPE_ALIGN (type) : BITS_PER_WORD;
 }
 
 static inline unsigned
-simple_decl_align_in_bits (tree decl)
+simple_decl_align_in_bits (const_tree decl)
 {
   return (TREE_CODE (decl) != ERROR_MARK) ? DECL_ALIGN (decl) : BITS_PER_WORD;
 }
@@ -9896,7 +9977,7 @@ round_up_to_align (HOST_WIDE_INT t, unsigned int align)
    just yet).  */
 
 static HOST_WIDE_INT
-field_byte_offset (tree decl)
+field_byte_offset (const_tree decl)
 {
   HOST_WIDE_INT object_offset_in_bits;
   HOST_WIDE_INT bitpos_int;
@@ -10162,7 +10243,7 @@ extract_int (const unsigned char *src, unsigned int size)
 /* Writes floating point values to dw_vec_const array.  */
 
 static void
-insert_float (rtx rtl, unsigned char *array)
+insert_float (const_rtx rtl, unsigned char *array)
 {
   REAL_VALUE_TYPE rv;
   long val[4];
@@ -10343,9 +10424,12 @@ reference_to_unused (tree * tp, int * walk_subtrees,
     return *tp;
   else if (!flag_unit_at_a_time)
     return NULL_TREE;
+  /* ???  The C++ FE emits debug information for using decls, so
+     putting gcc_unreachable here falls over.  See PR31899.  For now
+     be conservative.  */
   else if (!cgraph_global_info_ready
           && (TREE_CODE (*tp) == VAR_DECL || TREE_CODE (*tp) == FUNCTION_DECL))
-    gcc_unreachable ();
+    return *tp;
   else if (DECL_P (*tp) && TREE_CODE (*tp) == VAR_DECL)
     {
       struct varpool_node *node = varpool_node (*tp);
@@ -10359,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;
 }
@@ -10403,6 +10489,43 @@ rtl_for_decl_init (tree init, tree type)
   else if (initializer_constant_valid_p (init, type)
           && ! walk_tree (&init, reference_to_unused, NULL, NULL))
     {
+      /* Convert vector CONSTRUCTOR initializers to VECTOR_CST if
+        possible.  */
+      if (TREE_CODE (type) == VECTOR_TYPE)
+       switch (TREE_CODE (init))
+         {
+         case VECTOR_CST:
+           break;
+         case CONSTRUCTOR:
+           if (TREE_CONSTANT (init))
+             {
+               VEC(constructor_elt,gc) *elts = CONSTRUCTOR_ELTS (init);
+               bool constant_p = true;
+               tree value;
+               unsigned HOST_WIDE_INT ix;
+
+               /* Even when ctor is constant, it might contain non-*_CST
+                  elements (e.g. { 1.0/0.0 - 1.0/0.0, 0.0 }) and those don't
+                  belong into VECTOR_CST nodes.  */
+               FOR_EACH_CONSTRUCTOR_VALUE (elts, ix, value)
+                 if (!CONSTANT_CLASS_P (value))
+                   {
+                     constant_p = false;
+                     break;
+                   }
+
+               if (constant_p)
+                 {
+                   init = build_vector_from_ctor (type, elts);
+                   break;
+                 }
+             }
+           /* FALLTHRU */
+
+         default:
+           return NULL;
+         }
+
       rtl = expand_expr (init, NULL_RTX, VOIDmode, EXPAND_INITIALIZER);
 
       /* If expand_expr returns a MEM, it wasn't immediate.  */
@@ -10622,7 +10745,7 @@ rtl_for_decl_location (tree decl)
    XXX: If you split a variable across multiple sections, we won't notice.  */
 
 static const char *
-secname_for_decl (tree decl)
+secname_for_decl (const_tree decl)
 {
   const char *secname;
 
@@ -10637,13 +10760,64 @@ secname_for_decl (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
@@ -10820,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;
@@ -10967,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;
@@ -11314,7 +11487,8 @@ add_name_and_src_coords_attributes (dw_die_ref die, tree decl)
          && TREE_PUBLIC (decl)
          && DECL_ASSEMBLER_NAME (decl) != DECL_NAME (decl)
          && !DECL_ABSTRACT (decl)
-         && !(TREE_CODE (decl) == VAR_DECL && DECL_REGISTER (decl)))
+         && !(TREE_CODE (decl) == VAR_DECL && DECL_REGISTER (decl))
+         && !is_fortran ())
        add_AT_string (die, DW_AT_MIPS_linkage_name,
                       IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (decl)));
     }
@@ -11429,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));
 }
@@ -11471,11 +11647,20 @@ add_type_attribute (dw_die_ref object_die, tree type, int decl_const,
 /* Given an object die, add the calling convention attribute for the
    function call type.  */
 static void
-add_calling_convention_attribute (dw_die_ref subr_die, tree type)
+add_calling_convention_attribute (dw_die_ref subr_die, tree decl)
 {
   enum dwarf_calling_convention value = DW_CC_normal;
 
-  value = targetm.dwarf_calling_convention (type);
+  value = targetm.dwarf_calling_convention (TREE_TYPE (decl));
+
+  /* DWARF doesn't provide a way to identify a program's source-level
+     entry point.  DW_AT_calling_convention attributes are only meant
+     to describe functions' calling conventions.  However, lacking a
+     better way to signal the Fortran main program, we use this for the
+     time being, following existing custom.  */
+  if (is_fortran ()
+      && !strcmp (IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (decl)), "MAIN__"))
+    value = DW_CC_program;
 
   /* Only add the attribute if the backend requests it, and
      is not DW_CC_normal.  */
@@ -11488,7 +11673,7 @@ add_calling_convention_attribute (dw_die_ref subr_die, tree type)
    was declared without a tag.  */
 
 static const char *
-type_tag (tree type)
+type_tag (const_tree type)
 {
   const char *name = 0;
 
@@ -11526,7 +11711,7 @@ type_tag (tree type)
    for bit field types.  */
 
 static inline tree
-member_declared_type (tree member)
+member_declared_type (const_tree member)
 {
   return (DECL_BIT_FIELD_TYPE (member)
          ? DECL_BIT_FIELD_TYPE (member) : TREE_TYPE (member));
@@ -11583,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
@@ -11623,6 +11814,167 @@ gen_array_type_die (tree type, dw_die_ref context_die)
     add_pubtype (type, array_die);
 }
 
+static dw_loc_descr_ref
+descr_info_loc (tree val, tree base_decl)
+{
+  HOST_WIDE_INT size;
+  dw_loc_descr_ref loc, loc2;
+  enum dwarf_location_atom op;
+
+  if (val == base_decl)
+    return new_loc_descr (DW_OP_push_object_address, 0, 0);
+
+  switch (TREE_CODE (val))
+    {
+    CASE_CONVERT:
+      return descr_info_loc (TREE_OPERAND (val, 0), base_decl);
+    case INTEGER_CST:
+      if (host_integerp (val, 0))
+       return int_loc_descriptor (tree_low_cst (val, 0));
+      break;
+    case INDIRECT_REF:
+      size = int_size_in_bytes (TREE_TYPE (val));
+      if (size < 0)
+       break;
+      loc = descr_info_loc (TREE_OPERAND (val, 0), base_decl);
+      if (!loc)
+       break;
+      if (size == DWARF2_ADDR_SIZE)
+       add_loc_descr (&loc, new_loc_descr (DW_OP_deref, 0, 0));
+      else
+       add_loc_descr (&loc, new_loc_descr (DW_OP_deref_size, size, 0));
+      return loc;
+    case POINTER_PLUS_EXPR:
+    case PLUS_EXPR:
+      if (host_integerp (TREE_OPERAND (val, 1), 1)
+         && (unsigned HOST_WIDE_INT) tree_low_cst (TREE_OPERAND (val, 1), 1)
+            < 16384)
+       {
+         loc = descr_info_loc (TREE_OPERAND (val, 0), base_decl);
+         if (!loc)
+           break;
+         add_loc_descr (&loc,
+                        new_loc_descr (DW_OP_plus_uconst,
+                                       tree_low_cst (TREE_OPERAND (val, 1),
+                                                     1), 0));
+       }
+      else
+       {
+         op = DW_OP_plus;
+       do_binop:
+         loc = descr_info_loc (TREE_OPERAND (val, 0), base_decl);
+         if (!loc)
+           break;
+         loc2 = descr_info_loc (TREE_OPERAND (val, 1), base_decl);
+         if (!loc2)
+           break;
+         add_loc_descr (&loc, loc2);
+         add_loc_descr (&loc2, new_loc_descr (op, 0, 0));
+       }
+      return loc;
+    case MINUS_EXPR:
+      op = DW_OP_minus;
+      goto do_binop;
+    case MULT_EXPR:
+      op = DW_OP_mul;
+      goto do_binop;
+    case EQ_EXPR:
+      op = DW_OP_eq;
+      goto do_binop;
+    case NE_EXPR:
+      op = DW_OP_ne;
+      goto do_binop;
+    default:
+      break;
+    }
+  return NULL;
+}
+
+static void
+add_descr_info_field (dw_die_ref die, enum dwarf_attribute attr,
+                     tree val, tree base_decl)
+{
+  dw_loc_descr_ref loc;
+
+  if (host_integerp (val, 0))
+    {
+      add_AT_unsigned (die, attr, tree_low_cst (val, 0));
+      return;
+    }
+
+  loc = descr_info_loc (val, base_decl);
+  if (!loc)
+    return;
+
+  add_AT_loc (die, attr, loc);
+}
+
+/* This routine generates DIE for array with hidden descriptor, details
+   are filled into *info by a langhook.  */
+
+static void
+gen_descr_array_type_die (tree type, struct array_descr_info *info,
+                         dw_die_ref context_die)
+{
+  dw_die_ref scope_die = scope_die_for (type, context_die);
+  dw_die_ref array_die;
+  int dim;
+
+  array_die = new_die (DW_TAG_array_type, scope_die, type);
+  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);
+  if (info->associated)
+    add_descr_info_field (array_die, DW_AT_associated, info->associated,
+                         info->base_decl);
+  if (info->allocated)
+    add_descr_info_field (array_die, DW_AT_allocated, info->allocated,
+                         info->base_decl);
+
+  for (dim = 0; dim < info->ndimensions; dim++)
+    {
+      dw_die_ref subrange_die
+       = new_die (DW_TAG_subrange_type, array_die, NULL);
+
+      if (info->dimen[dim].lower_bound)
+       {
+         /* If it is the default value, omit it.  */
+         if ((is_c_family () || is_java ())
+             && integer_zerop (info->dimen[dim].lower_bound))
+           ;
+         else if (is_fortran ()
+                  && integer_onep (info->dimen[dim].lower_bound))
+           ;
+         else
+           add_descr_info_field (subrange_die, DW_AT_lower_bound,
+                                 info->dimen[dim].lower_bound,
+                                 info->base_decl);
+       }
+      if (info->dimen[dim].upper_bound)
+       add_descr_info_field (subrange_die, DW_AT_upper_bound,
+                             info->dimen[dim].upper_bound,
+                             info->base_decl);
+      if (info->dimen[dim].stride)
+       add_descr_info_field (subrange_die, DW_AT_byte_stride,
+                             info->dimen[dim].stride,
+                             info->base_decl);
+    }
+
+  gen_type_die (info->element_type, context_die);
+  add_type_attribute (array_die, info->element_type, 0, 0, context_die);
+
+  if (get_AT (array_die, DW_AT_name))
+    add_pubtype (type, array_die);
+}
+
 #if 0
 static void
 gen_entry_point_die (tree decl, dw_die_ref context_die)
@@ -11670,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.  */
@@ -11790,8 +12166,11 @@ gen_formal_parameter_die (tree node, dw_die_ref context_die)
        add_abstract_origin_attribute (parm_die, origin);
       else
        {
+         tree type = TREE_TYPE (node);
          add_name_and_src_coords_attributes (parm_die, node);
-         add_type_attribute (parm_die, TREE_TYPE (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);
@@ -11934,7 +12313,6 @@ dwarf2out_abstract_function (tree decl)
 {
   dw_die_ref old_die;
   tree save_fn;
-  struct function *save_cfun;
   tree context;
   int was_abstract = DECL_ABSTRACT (decl);
 
@@ -11958,9 +12336,8 @@ dwarf2out_abstract_function (tree decl)
 
   /* Pretend we've just finished compiling this function.  */
   save_fn = current_function_decl;
-  save_cfun = cfun;
   current_function_decl = decl;
-  cfun = DECL_STRUCT_FUNCTION (decl);
+  push_cfun (DECL_STRUCT_FUNCTION (decl));
 
   set_decl_abstract_flags (decl, 1);
   dwarf2out_decl (decl);
@@ -11968,7 +12345,7 @@ dwarf2out_abstract_function (tree decl)
     set_decl_abstract_flags (decl, 0);
 
   current_function_decl = save_fn;
-  cfun = save_cfun;
+  pop_cfun ();
 }
 
 /* Helper function of premark_used_types() which gets called through
@@ -12154,6 +12531,10 @@ gen_subprogram_die (tree decl, dw_die_ref context_die)
            add_AT_unsigned (subr_die, DW_AT_inline, DW_INL_not_inlined);
        }
 
+      if (DECL_DECLARED_INLINE_P (decl)
+         && lookup_attribute ("artificial", DECL_ATTRIBUTES (decl)))
+       add_AT_flag (subr_die, DW_AT_artificial, 1);
+
       equate_decl_number_to_die (decl, subr_die);
     }
   else if (!DECL_EXTERNAL (decl))
@@ -12323,7 +12704,7 @@ gen_subprogram_die (tree decl, dw_die_ref context_die)
 #endif
     }
   /* Add the calling convention attribute if requested.  */
-  add_calling_convention_attribute (subr_die, TREE_TYPE (decl));
+  add_calling_convention_attribute (subr_die, decl);
 
 }
 
@@ -12332,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
@@ -12358,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);
 
@@ -12393,8 +12806,14 @@ gen_variable_die (tree decl, dw_die_ref context_die)
     }
   else
     {
+      tree type = TREE_TYPE (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, TREE_TYPE (decl), TREE_READONLY (decl),
+      add_type_attribute (var_die, type, TREE_READONLY (decl),
                          TREE_THIS_VOLATILE (decl), context_die);
 
       if (TREE_PUBLIC (decl))
@@ -12484,7 +12903,7 @@ add_call_src_coords_attributes (tree stmt, dw_die_ref die)
    first subblock's abstract origin is the function's outermost block,
    then we're looking at the main entry point.  */
 static bool
-is_inlined_entry_point (tree stmt)
+is_inlined_entry_point (const_tree stmt)
 {
   tree decl, block;
 
@@ -12732,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;
@@ -12865,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)
@@ -12988,6 +13407,7 @@ gen_type_die_with_usage (tree type, dw_die_ref context_die,
                                enum debug_info_usage usage)
 {
   int need_pop;
+  struct array_descr_info info;
 
   if (type == NULL_TREE || type == error_mark_node)
     return;
@@ -13006,6 +13426,16 @@ gen_type_die_with_usage (tree type, dw_die_ref context_die,
       return;
     }
 
+  /* If this is an array type with hidden descriptor, handle it first.  */
+  if (!TREE_ASM_WRITTEN (type)
+      && lang_hooks.types.get_array_descr_info
+      && lang_hooks.types.get_array_descr_info (type, &info))
+    {
+      gen_descr_array_type_die (type, &info, context_die);
+      TREE_ASM_WRITTEN (type) = 1;
+      return;
+    }
+
   /* We are going to output a DIE to represent the unqualified version
      of this type (i.e. without any const or volatile qualifiers) so
      get the main variant (i.e. the unqualified version) of this type
@@ -13316,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);
@@ -13339,7 +13774,7 @@ decls_for_scope (tree stmt, dw_die_ref context_die, int depth)
 /* Is this a typedef we can avoid emitting?  */
 
 static inline int
-is_redundant_typedef (tree decl)
+is_redundant_typedef (const_tree decl)
 {
   if (TYPE_DECL_IS_STUB (decl))
     return 1;
@@ -13443,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;
@@ -13622,7 +14054,8 @@ gen_decl_die (tree decl, dw_die_ref context_die)
         was generated within the original definition of an inline function) we
         have to generate a special (abbreviated) DW_TAG_structure_type,
         DW_TAG_union_type, or DW_TAG_enumeration_type DIE here.  */
-      if (TYPE_DECL_IS_STUB (decl) && decl_ultimate_origin (decl) != NULL_TREE)
+      if (TYPE_DECL_IS_STUB (decl) && decl_ultimate_origin (decl) != NULL_TREE
+         && is_tagged_type (TREE_TYPE (decl)))
        {
          gen_tagged_type_instantiation_die (TREE_TYPE (decl), context_die);
          break;
@@ -13647,9 +14080,22 @@ 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.  */
-      gen_type_die (TREE_TYPE (decl), context_die);
+      if (TREE_CODE (decl) == RESULT_DECL && DECL_BY_REFERENCE (decl))
+       gen_type_die (TREE_TYPE (TREE_TYPE (decl)), context_die);
+      else
+       gen_type_die (TREE_TYPE (decl), context_die);
 
       /* And its containing type.  */
       origin = decl_class_context (decl);
@@ -13683,7 +14129,10 @@ gen_decl_die (tree decl, dw_die_ref context_die)
       break;
 
     case PARM_DECL:
-      gen_type_die (TREE_TYPE (decl), context_die);
+      if (DECL_BY_REFERENCE (decl))
+       gen_type_die (TREE_TYPE (TREE_TYPE (decl)), context_die);
+      else
+       gen_type_die (TREE_TYPE (decl), context_die);
       gen_formal_parameter_die (decl, context_die);
       break;
 
@@ -13707,7 +14156,15 @@ 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.  */
+     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);
 }
@@ -13949,7 +14406,7 @@ dwarf2out_end_block (unsigned int line ATTRIBUTE_UNUSED, unsigned int blocknum)
    we may end up calling them anyway.  */
 
 static bool
-dwarf2out_ignore_block (tree block)
+dwarf2out_ignore_block (const_tree block)
 {
   tree decl;
 
@@ -14084,7 +14541,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;
 
@@ -14521,6 +14978,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: