[RFC][PATCH 1/1] dwarf, fortran: add support for DW_TAG_entry_point

[Nils-Christian Kempke <nils-christian.kempke@intel.com>]

Fortran provides additional entry-points for subroutine and functions.
These entry points may use only a subset of the parameters of the
original subroutine.  The entry points may be described via the DWARF
tag DW_TAG_entry_point.

This commit adds support for parsing the DW_TAG_entry_point DWARF tag.
Currently, between ifx/ifort/gfortran, only ifort is actually emitting
this tag.  Both, ifx and gfortran use the DW_TAG_subprogram tag as
workaround/alternative.  Thus, this patch really only adds more ifort
support.  Even so, some of the attached tests still fail for ifort, due
to some wrong debug info generated for variables when using the entry
keyword.

After this patch it is possible to set a breakpoint in gdb with the
ifort compiled example at the entry points 'foo' and 'tim', which was not
possible before.

For gfortran there actually exists a bug on bugzilla, asking for the use
of DW_TAG_entry_point over DW_TAG_subprogram:

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=37134

This patch was originally posted here

https://sourceware.org/legacy-ml/gdb-patches/2017-07/msg00317.html

but its review/pinging got lost after a while.  I reworked it to fit the
current GDB.

gdb/ChangeLog:
2022-21-03  Nils-Christian Kempke  <nils-christian.kempke@intel.com>

	* dwarf2/read.c (add_partial_entry_point): New function handling
	the DW_TAG_entry_point.
	(add_partial_symbol): Add DW_TAG_entry_point.
	(add_partial_subprogram): Search for entry_points as children of
	subprograms.
	(process_die): Handle DW_TAG_entry_point.
	(die_needs_namespace): Add DW_TAG_entry_point.
	(dwarf2_get_pc_bounds_entry_point): New helper handling the
	bounds of a DW_TAG_entry_point.
	(dwarf2_get_pc_bounds): Call dwarf2_get_pc_bounds_entry_point
	for DW_TAG_entry_point.
	(load_partial_dies): Save DW_TAG_entry_points.
	(new_symbol): Process DW_TAG_entry_point.
	(read_type_die_1): Handle DW_TAG_entry_point.

gdb/testsuite/ChangeLog:
2022-21-03  Nils-Christian Kempke  <nils-christian.kempke@intel.com>

	* gdb.fortran/entry-point.exp: New test.
	* gdb.fortran/entry-point.f90: New test source file.

Co-authored-by: Bernhard Heckel <bernhard.heckel@intel.com>
Co-authored-by: Tim Wiederhake  <tim.wiederhake@intel.com>

Signed-off-by: Nils-Christian Kempke <nils-christian.kempke@intel.com>
---
 gdb/dwarf2/read.c                         | 101 ++++++++++++++++++++++
 gdb/testsuite/gdb.fortran/entry-point.exp |  67 ++++++++++++++
 gdb/testsuite/gdb.fortran/entry-point.f90 |  48 ++++++++++
 3 files changed, 216 insertions(+)
 create mode 100644 gdb/testsuite/gdb.fortran/entry-point.exp
 create mode 100644 gdb/testsuite/gdb.fortran/entry-point.f90

diff --git a/gdb/dwarf2/read.c b/gdb/dwarf2/read.c
index f9c942d91d..c10196298e 100644
--- a/gdb/dwarf2/read.c
+++ b/gdb/dwarf2/read.c
@@ -1128,6 +1128,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 (partial_die_info *pdi, CORE_ADDR *lowpc,
+				     CORE_ADDR *highpc, int need_pc,
+				     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);
@@ -7928,6 +7932,25 @@ 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 languages other than Fortran which are using the
+	 DW_TAG_entry_point.  */
+      if (cu->per_cu->lang == language_fortran)
+	{
+	  /* DW_TAG_entry_point provides an additional entry_point to an
+	    existing sub_program.  Therefore, we inherit the "external"
+	    attribute from the sub_program the entry_point belongs to.  */
+	  addr = (gdbarch_adjust_dwarf2_addr (gdbarch, pdi->lowpc + baseaddr)
+		  - baseaddr);
+	  where = (pdi->die_parent->is_external ? psymbol_placement::GLOBAL
+						: psymbol_placement::STATIC);
+
+	  psymbol.domain = VAR_DOMAIN;
+	  psymbol.aclass = LOC_BLOCK;
+	  psymbol.ginfo.set_section_index (SECT_OFF_TEXT (objfile));
+	  psymbol.ginfo.value.address = addr;
+	}
+      break;
     case DW_TAG_inlined_subroutine:
     case DW_TAG_subprogram:
       addr = (gdbarch_adjust_dwarf2_addr (gdbarch, pdi->lowpc + baseaddr)
@@ -8127,6 +8150,18 @@ add_partial_module (struct partial_die_info *pdi, CORE_ADDR *lowpc,
     scan_partial_symbols (pdi->die_child, lowpc, highpc, set_addrmap, cu);
 }
 
+/* Read a partial die corresponding to a Fortran entry point.  */
+
+static void
+add_partial_entry_point (partial_die_info *pdi, CORE_ADDR *lowpc,
+			 CORE_ADDR *highpc, int set_addrmap, dwarf2_cu *cu)
+{
+  if (pdi->name (cu) == nullptr)
+    complaint (_("DW_TAG_entry_point has to have a name"));
+  else
+    add_partial_symbol (pdi, cu);
+}
+
 static int
 dwarf2_ranges_read (unsigned, CORE_ADDR *, CORE_ADDR *, struct dwarf2_cu *,
 		    dwarf2_psymtab *, dwarf_tag);
@@ -8218,6 +8253,12 @@ add_partial_subprogram (struct partial_die_info *pdi,
 	      || pdi->tag == DW_TAG_inlined_subroutine
 	      || pdi->tag == DW_TAG_lexical_block)
 	    add_partial_subprogram (pdi, lowpc, highpc, set_addrmap, cu);
+	  if (pdi->tag == DW_TAG_entry_point
+	      && cu->per_cu->lang == language_fortran)
+	    {
+	      /* Entry points are only added as children of subprograms.  */
+	      add_partial_entry_point (pdi, lowpc, highpc, set_addrmap, cu);
+	    }
 	  pdi = pdi->die_sibling;
 	}
     }
@@ -9678,6 +9719,7 @@ process_die (struct die_info *die, struct dwarf2_cu *cu)
 	  && die->parent->tag == DW_TAG_subprogram)
 	cu->processing_has_namespace_info = true;
       /* Fall through.  */
+    case DW_TAG_entry_point:
     case DW_TAG_inlined_subroutine:
       read_func_scope (die, cu);
       break;
@@ -9792,6 +9834,7 @@ die_needs_namespace (struct die_info *die, struct dwarf2_cu *cu)
     case DW_TAG_enumerator:
     case DW_TAG_subprogram:
     case DW_TAG_inlined_subroutine:
+    case DW_TAG_entry_point:
     case DW_TAG_member:
     case DW_TAG_imported_declaration:
       return 1;
@@ -14062,6 +14105,39 @@ dwarf2_ranges_read (unsigned offset, CORE_ADDR *low_return,
   return 1;
 }
 
+static pc_bounds_kind
+dwarf2_get_pc_bounds_entry_point (die_info *die, CORE_ADDR *lowpc,
+				  CORE_ADDR *highpc, dwarf2_cu *cu,
+				  dwarf2_psymtab *pst)
+{
+  CORE_ADDR low = 0;
+  CORE_ADDR high = 0;
+
+  /* A Entry_point is embedded in an subprogram.  Therefore, we can use
+     the highpc from it's enveloping subprogram and get the lowpc from
+     DWARF.  */
+  if (PC_BOUNDS_INVALID == dwarf2_get_pc_bounds (die->parent, &low, &high, cu,
+						 pst))
+    return PC_BOUNDS_INVALID;
+
+  attribute *attr_low = dwarf2_attr (die, DW_AT_low_pc, cu);
+  if (!attr_low)
+    {
+      complaint (_("DW_TAG_entry_point is missing DW_AT_low_pc"));
+      return PC_BOUNDS_INVALID;
+    }
+  low = attr_low->as_address ();
+  if (high <= low)
+    return PC_BOUNDS_INVALID;
+  if (low == 0 && !cu->per_objfile->per_bfd->has_section_at_zero)
+    return PC_BOUNDS_INVALID;
+
+  *lowpc = low;
+  if (highpc)
+    *highpc = high;
+  return PC_BOUNDS_HIGH_LOW;
+}
+
 /* Get low and high pc attributes from a die.  See enum pc_bounds_kind
    definition for the return value.  *LOWPC and *HIGHPC are set iff
    neither PC_BOUNDS_NOT_PRESENT nor PC_BOUNDS_INVALID are returned.  */
@@ -14078,6 +14154,9 @@ 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)
+    return dwarf2_get_pc_bounds_entry_point (die, lowpc, highpc, cu, pst);
+
   attr_high = dwarf2_attr (die, DW_AT_high_pc, cu);
   if (attr_high)
     {
@@ -19066,6 +19145,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_inlined_subroutine
 	  && abbrev->tag != DW_TAG_lexical_block
 	  && abbrev->tag != DW_TAG_variable
@@ -19190,6 +19270,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)
@@ -21789,6 +21870,25 @@ new_symbol (struct die_info *die, struct type *type, struct dwarf2_cu *cu,
 	  sym->set_domain (LABEL_DOMAIN);
 	  add_symbol_to_list (sym, cu->list_in_scope);
 	  break;
+	case DW_TAG_entry_point:
+	  /* Don't know any language other than Fortran using the
+	     DW_TAG_entry_point.  */
+	  if (cu->per_cu->lang == language_fortran)
+	    {
+	      /* SYMBOL_BLOCK_VALUE (sym) will be filled in later by
+		 finish_block.  */
+	       sym->set_aclass_index (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 != nullptr && attr2->as_boolean ())
+		list_to_add = cu->get_builder ()->get_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.  */
@@ -22492,6 +22592,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 0000000000..45f5c351e7
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/entry-point.exp
@@ -0,0 +1,67 @@
+# Copyright 2022 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/>.
+#
+# Test Fortran entry points for subroutines.
+
+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 { ![fortran_runto_main] } {
+    untested "could not run to main"
+    return -1
+}
+
+# Test if we can set a breakpoint via the entry-point name.
+set entry_point_name "foo"
+gdb_breakpoint $entry_point_name
+gdb_continue_to_breakpoint "continue to breakpoint: $entry_point_name" \
+    ".*entry foo\\(J,K,L,I1\\).*"
+
+gdb_test "print j" "= 11" "print j, entered via $entry_point_name"
+gdb_test "print k" "= 22" "print k, entered via $entry_point_name"
+gdb_test "print l" "= 33" "print l, entered via $entry_point_name"
+gdb_test "print i1" "= 44" "print i1, entered via $entry_point_name"
+gdb_test "info args" \
+    [multi_line "j = 11" \
+		"k = 22" \
+		"l = 33" \
+		"i1 = 44"] \
+    "info args, entered via $entry_point_name"
+
+# Test if we can set a breakpoint via the function name.
+set entry_point_name "bar"
+gdb_breakpoint $entry_point_name
+gdb_continue_to_breakpoint "continue to breakpoint: $entry_point_name" \
+    ".*subroutine bar\\(I,J,K,I1\\).*"
+
+gdb_test "print i" "= 444" "print i, entered via $entry_point_name"
+gdb_test "print j" "= 555" "print j, entered via $entry_point_name"
+gdb_test "print k" "= 666" "print k, entered via $entry_point_name"
+gdb_test "print i1" "= 777" "print i1, entered via $entry_point_name"
+
+# Test a second entry point.
+set entry_point_name "foobar"
+gdb_breakpoint $entry_point_name
+gdb_continue_to_breakpoint "continue to breakpoint: $entry_point_name" \
+    ".* entry foobar\\(J\\).*"
+
+gdb_test "print j" "= 1" "print j, entered via $entry_point_name"
+gdb_test "info args" "j = 1" "info args, entered via $entry_point_name"
diff --git a/gdb/testsuite/gdb.fortran/entry-point.f90 b/gdb/testsuite/gdb.fortran/entry-point.f90
new file mode 100644
index 0000000000..f1e12f7304
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/entry-point.f90
@@ -0,0 +1,48 @@
+! Copyright 2022 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(11,22,33,44)
+  call bar(444,555,666,777)
+  call foobar(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 foobar(J)
+    goto 200
+
+1000 A = C + 1
+     C = J * 1.5
+
+    return
+  end subroutine
-- 
2.25.1

Intel Deutschland GmbH
Registered Address: Am Campeon 10, 85579 Neubiberg, Germany
Tel: +49 89 99 8853-0, www.intel.de <http://www.intel.de>
Managing Directors: Christin Eisenschmid, Sharon Heck, Tiffany Doon Silva  
Chairperson of the Supervisory Board: Nicole Lau
Registered Office: Munich
Commercial Register: Amtsgericht Muenchen HRB 186928