[PATCH 4/6] Dwarf: Fortran, support DW_TAG_entry_point.

[Tim Wiederhake <tim dot wiederhake at intel dot com>]

From: Bernhard Heckel <bernhard.heckel@intel.com>

Fortran provides additional entry-points to an subprogram.  Those entry-points
may have only a subset of parameters of the original subprogram as well.

Add support for parsing DW_TAG_entry_point's for Fortran.

xxxx-yy-zz  Bernhard Heckel  <bernhard.heckel@intel.com>
            Tim Wiederhake  <tim.wiederhake@intel.com>

gdb/ChangeLog:
	* gdb/dwarf2read.c (add_partial_symbol): Handle DW_TAG_entry_point.
	(add_partial_entry_point): New function.
	(add_partial_subprogram): Search for entry_points.
	(process_die): Handle DW_TAG_entry_point.
	(dwarf2_get_pc_bounds): Update low pc from DWARF.
	(load_partial_dies): Save DW_TAG_entry_point's.
	(load_partial_dies): Save DW_TAG_entry_point to hash table.
	(load_partial_dies): Look into child's of DW_TAG_sub_program
	for fortran.
	(new_symbol_full): Process DW_TAG_entry_point.
	(read_type_die_1): Handle DW_TAG_entry_point.

gdb/testsuite/ChangeLog:
	* gdb.fortran/entry_point.f90: New file.
	* gdb.fortran/entry_point.exp: New file.


---
 gdb/dwarf2read.c                          | 100 +++++++++++++++++++++++++++++-
 gdb/testsuite/gdb.fortran/entry_point.exp |  70 +++++++++++++++++++++
 gdb/testsuite/gdb.fortran/entry_point.f90 |  48 ++++++++++++++
 3 files changed, 217 insertions(+), 1 deletion(-)
 create mode 100644 gdb/testsuite/gdb.fortran/entry_point.exp
 create mode 100644 gdb/testsuite/gdb.fortran/entry_point.f90

diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index 6d38d70..c3c01a7 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -1556,6 +1556,10 @@ static void add_partial_module (struct partial_die_info *pdi, CORE_ADDR *lowpc,
 static void add_partial_enumeration (struct partial_die_info *enum_pdi,
 				     struct dwarf2_cu *cu);
 
+static void add_partial_entry_point (struct partial_die_info *pdi,
+				     CORE_ADDR *lowpc, CORE_ADDR *highpc,
+				     int need_pc, struct dwarf2_cu *cu);
+
 static void add_partial_subprogram (struct partial_die_info *pdi,
 				    CORE_ADDR *lowpc, CORE_ADDR *highpc,
 				    int need_pc, struct dwarf2_cu *cu);
@@ -7132,6 +7136,32 @@ add_partial_symbol (struct partial_die_info *pdi, struct dwarf2_cu *cu)
 
   switch (pdi->tag)
     {
+    case DW_TAG_entry_point:
+      {
+	/* Don't know any other language than fortran which is
+	   using DW_TAG_entry_point.  */
+	if (cu->language == language_fortran)
+	  {
+	    addr = gdbarch_adjust_dwarf2_addr (gdbarch, pdi->lowpc + baseaddr);
+	    /* DW_TAG_entry_point provides an additional entry_point to an
+	       existing sub_program.  Therefore, we inherit the "external"
+	       attribute from the sub_program to which the entry_point
+	       belongs to.  */
+	    if (pdi->die_parent->is_external)
+	      add_psymbol_to_list (actual_name, strlen (actual_name),
+				   built_actual_name != NULL,
+				   VAR_DOMAIN, LOC_BLOCK,
+				   &objfile->global_psymbols,
+				   addr, cu->language, objfile);
+	    else
+	      add_psymbol_to_list (actual_name, strlen (actual_name),
+				   built_actual_name != NULL,
+				   VAR_DOMAIN, LOC_BLOCK,
+				   &objfile->static_psymbols,
+				   addr, cu->language, objfile);
+	  }
+	break;
+      }
     case DW_TAG_subprogram:
       addr = gdbarch_adjust_dwarf2_addr (gdbarch, pdi->lowpc + baseaddr);
       if (pdi->is_external || cu->language == language_ada)
@@ -7332,6 +7362,18 @@ add_partial_module (struct partial_die_info *pdi, CORE_ADDR *lowpc,
     scan_partial_symbols (pdi->die_child, lowpc, highpc, set_addrmap, cu);
 }
 
+static void
+add_partial_entry_point (struct partial_die_info *pdi,
+			 CORE_ADDR *p_lowpc, CORE_ADDR *p_highpc,
+			 int set_addrmap, struct dwarf2_cu *cu)
+{
+  if (pdi->name == NULL)
+    complaint (&symfile_complaints,
+	       _("DW_TAG_entry_point have to have a name"));
+  else
+    add_partial_symbol (pdi, cu);
+}
+
 /* Read a partial die corresponding to a subprogram and create a partial
    symbol for that subprogram.  When the CU language allows it, this
    routine also defines a partial symbol for each nested subprogram
@@ -7402,6 +7444,16 @@ add_partial_subprogram (struct partial_die_info *pdi,
 	  pdi = pdi->die_sibling;
 	}
     }
+  else if (cu->language == language_fortran)
+    {
+      pdi = pdi->die_child;
+      while (pdi != NULL)
+	{
+	  if (pdi->tag == DW_TAG_entry_point)
+	    add_partial_entry_point (pdi, lowpc, highpc, set_addrmap, cu);
+	  pdi = pdi->die_sibling;
+	}
+    }
 }
 
 /* Read a partial die corresponding to an enumeration type.  */
@@ -8508,6 +8560,7 @@ process_die (struct die_info *die, struct dwarf2_cu *cu)
     case DW_TAG_type_unit:
       read_type_unit_scope (die, cu);
       break;
+    case DW_TAG_entry_point:
     case DW_TAG_subprogram:
     case DW_TAG_inlined_subroutine:
       read_func_scope (die, cu);
@@ -12499,6 +12552,27 @@ dwarf2_get_pc_bounds (struct die_info *die, CORE_ADDR *lowpc,
   CORE_ADDR high = 0;
   enum pc_bounds_kind ret;
 
+  if (die->tag == DW_TAG_entry_point)
+    {
+      /* Entry_point is embedded in an subprogram.  Therefore, we can use the
+	 highpc from its enveloping subprogram and get the lowpc from DWARF.  */
+      ret = dwarf2_get_pc_bounds (die->parent, lowpc, highpc, cu, pst);
+      if (ret == PC_BOUNDS_NOT_PRESENT || ret == PC_BOUNDS_INVALID)
+	return ret;
+
+      attr = dwarf2_attr (die, DW_AT_low_pc, cu);
+      if (!attr)
+	{
+	  complaint (&symfile_complaints,
+		     _("DW_TAG_entry_point is missing DW_AT_low_pc"));
+	  return PC_BOUNDS_INVALID;
+	}
+      low = attr_value_as_address (attr);
+      *lowpc = low;
+
+      return PC_BOUNDS_HIGH_LOW;
+    }
+
   attr_high = dwarf2_attr (die, DW_AT_high_pc, cu);
   if (attr_high)
     {
@@ -16029,6 +16103,7 @@ load_partial_dies (const struct die_reader_specs *reader,
 	  && abbrev->tag != DW_TAG_constant
 	  && abbrev->tag != DW_TAG_enumerator
 	  && abbrev->tag != DW_TAG_subprogram
+	  && abbrev->tag != DW_TAG_entry_point
 	  && abbrev->tag != DW_TAG_lexical_block
 	  && abbrev->tag != DW_TAG_variable
 	  && abbrev->tag != DW_TAG_namespace
@@ -16155,6 +16230,7 @@ load_partial_dies (const struct die_reader_specs *reader,
       if (load_all
 	  || abbrev->tag == DW_TAG_constant
 	  || abbrev->tag == DW_TAG_subprogram
+	  || abbrev->tag == DW_TAG_entry_point
 	  || abbrev->tag == DW_TAG_variable
 	  || abbrev->tag == DW_TAG_namespace
 	  || part_die->is_declaration)
@@ -16197,7 +16273,9 @@ load_partial_dies (const struct die_reader_specs *reader,
 		      || last_die->tag == DW_TAG_union_type))
 	      || (cu->language == language_ada
 		  && (last_die->tag == DW_TAG_subprogram
-		      || last_die->tag == DW_TAG_lexical_block))))
+		      || last_die->tag == DW_TAG_lexical_block))
+	      || (cu->language == language_fortran
+		  && last_die->tag == DW_TAG_subprogram)))
 	{
 	  nesting_level++;
 	  parent_die = last_die;
@@ -19058,6 +19136,25 @@ new_symbol_full (struct die_info *die, struct type *type, struct dwarf2_cu *cu,
 	  SYMBOL_ACLASS_INDEX (sym) = LOC_LABEL;
 	  add_symbol_to_list (sym, cu->list_in_scope);
 	  break;
+	case DW_TAG_entry_point:
+	  /* Don't know any other language than fortran which is
+	     using DW_TAG_entry_point.  */
+	  if (cu->language == language_fortran)
+	    {
+	      /* SYMBOL_BLOCK_VALUE (sym) will be filled in later by
+	      	 finish_block.  */
+	      SYMBOL_ACLASS_INDEX (sym) = LOC_BLOCK;
+	      /* DW_TAG_entry_point provides an additional entry_point to an
+		 existing sub_program.  Therefore, we inherit the "external"
+		 attribute from the sub_program to which the entry_point
+		 belongs to.  */
+	      attr2 = dwarf2_attr (die->parent, DW_AT_external, cu);
+	      if (attr2 && (DW_UNSND (attr2) != 0))
+		list_to_add = &global_symbols;
+	      else
+		list_to_add = cu->list_in_scope;
+	    }
+	  break;
 	case DW_TAG_subprogram:
 	  /* SYMBOL_BLOCK_VALUE (sym) will be filled in later by
 	     finish_block.  */
@@ -19743,6 +19840,7 @@ read_type_die_1 (struct die_info *die, struct dwarf2_cu *cu)
     case DW_TAG_enumeration_type:
       this_type = read_enumeration_type (die, cu);
       break;
+    case DW_TAG_entry_point:
     case DW_TAG_subprogram:
     case DW_TAG_subroutine_type:
     case DW_TAG_inlined_subroutine:
diff --git a/gdb/testsuite/gdb.fortran/entry_point.exp b/gdb/testsuite/gdb.fortran/entry_point.exp
new file mode 100644
index 0000000..950ffe2
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/entry_point.exp
@@ -0,0 +1,70 @@
+# Copyright 2017 Free Software Foundation, Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+if { [skip_fortran_tests] } { return -1 }
+
+standard_testfile .f90
+load_lib "fortran.exp"
+
+if {[prepare_for_testing $testfile.exp $testfile $srcfile {debug f90}]} {
+    return -1
+}
+
+if ![runto MAIN__] then {
+    perror "couldn't run to breakpoint MAIN__"
+    continue
+}
+
+# Test if we can set a breakpoint via entry-point name
+set ept_name "foo"
+gdb_breakpoint $ept_name
+gdb_test "continue" \
+    [multi_line "Breakpoint $decimal, $ept_name \\(j=1, k=2, l=3, i1=4\\) at .*" \
+                ".*"] \
+    "continue to breakpoint: $ept_name"
+
+gdb_test "print j" "= 1" "print j, entered via $ept_name"
+gdb_test "print k" "= 2" "print k, entered via $ept_name"
+gdb_test "print l" "= 3" "print l, entered via $ept_name"
+gdb_test "print i1" "= 4" "print i1, entered via $ept_name"
+gdb_test "info args" \
+  [multi_line "j = 1" \
+              "k = 2" \
+              "l = 3" \
+              "i1 = 4"] \
+   "info args, entered via $ept_name"
+
+# Test if we can set a breakpoint via function name
+set ept_name "bar"
+gdb_breakpoint $ept_name
+gdb_test "continue" \
+    [multi_line "Breakpoint $decimal, $ept_name \\(i=4, j=5, k=6, i1=7\\) at .*" \
+                ".*"] \
+    "continue to breakpoint: $ept_name"
+
+gdb_test "print i" "= 4" "print i, entered via $ept_name"
+gdb_test "print j" "= 5" "print j, entered via $ept_name"
+gdb_test "print k" "= 6" "print k, entered via $ept_name"
+gdb_test "print i1" "= 7" "print i1, entered via $ept_name"
+
+set ept_name "baz"
+gdb_breakpoint $ept_name
+gdb_test "continue" \
+    [multi_line "Breakpoint $decimal, $ept_name \\(j=1\\) at .*" \
+                ".*"] \
+    "continue to breakpoint: $ept_name"
+
+gdb_test "print j" "= 1" "print j, entered via $ept_name"
+gdb_test "info args" "j = 1" "info args, entered via $ept_name"
diff --git a/gdb/testsuite/gdb.fortran/entry_point.f90 b/gdb/testsuite/gdb.fortran/entry_point.f90
new file mode 100644
index 0000000..1d43930
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/entry_point.f90
@@ -0,0 +1,48 @@
+! Copyright 2017 Free Software Foundation, Inc.
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+program TestEntryPoint
+
+  call foo(1,2,3,4)
+  call bar(4,5,6,7)
+  call baz(1)
+
+end program TestEntryPoint
+
+  subroutine bar(I,J,K,I1)
+    INTEGER I,J,K,L,I1
+    INTEGER A
+    REAL    C
+
+    A = 0
+    C = 0.0
+
+    A = I + K + I1
+    goto 1000
+
+    entry foo(J,K,L,I1)
+    A = J + K + L + I1
+
+200 C = J
+    goto 1000
+
+    entry baz(J)
+    goto 200
+
+1000 A = C + 1
+     C = J * 1.5
+
+    return
+  end subroutine
-- 
2.7.4