libdw: Handle DW_OP_GNU_variable_value.

Handle DW_OP_GNU_variable_value in dwarf_getlocation[_attr,_die].
DW_OP_GNU_variable_value takes one argument a DIE reference that
describes a value given by a location of const_value attribute.

To test handling of the new operand the varlocs test is adapted
to print out all DIEs and attributes with expressions or location
lists (the original varlocs test only prints out variables and
arguments of function DIEs).

Signed-off-by: Mark Wielaard <[email protected]>

5 files changed, 421 insertions, 7 deletions

diff --git a/tests/ChangeLog b/tests/ChangeLog
index beac0e21..f39a0277 100644
--- a/tests/ChangeLog
+++ b/tests/ChangeLog
@@ -1,3 +1,19 @@
+2017-11-03  Mark Wielaard  <[email protected]>
+
+	* run-exprlocs.sh: New test.
+	* testfile-stridex.bz2: New testfile.
+	* Makefile.am (TESTS): Add run-exprlocs.sh.
+	(EXTRA_DIST): Add run-exprlocs.sh and testfile-stridex.bz2.
+	* varlocs.c (dwarf_tag_string): New function.
+	(dwarf_attr_string): Likewise.
+	(dwarf_form_string): Likewise.
+	(print_expr): Fix typo in error message.r
+	Handle DW_OP_GNU_variable_value.
+	(attr_arg): New struct.
+	(handle_attr): New function.
+	(handle_die): Likewise.
+	(main): Handle --exprlocs argument. Call handle_die.
+
 2017-10-16  Mark Wielaard  <[email protected]>
 
 	* md5-sha1-test.c: Removed.
diff --git a/tests/Makefile.am b/tests/Makefile.am
index ec42b80c..f992b12f 100644
--- a/tests/Makefile.am
+++ b/tests/Makefile.am
@@ -112,7 +112,7 @@ TESTS = run-arextract.sh run-arsymtest.sh run-ar.sh newfile test-nlist \
 	run-dwfl-report-elf-align.sh run-addr2line-test.sh \
 	run-addr2line-i-test.sh run-addr2line-i-lex-test.sh \
 	run-addr2line-i-demangle-test.sh run-addr2line-alt-debugpath.sh \
-	run-varlocs.sh run-funcretval.sh \
+	run-varlocs.sh run-exprlocs.sh run-funcretval.sh \
 	run-backtrace-native.sh run-backtrace-data.sh run-backtrace-dwarf.sh \
 	run-backtrace-native-biarch.sh run-backtrace-native-core.sh \
 	run-backtrace-native-core-biarch.sh run-backtrace-core-x86_64.sh \
@@ -284,7 +284,7 @@ EXTRA_DIST = run-arextract.sh run-arsymtest.sh run-ar.sh \
 	     testfileppc32.bz2 testfileppc64.bz2 \
 	     testfiles390.bz2 testfiles390x.bz2 \
 	     testfilearm.bz2 testfileaarch64.bz2 \
-	     run-varlocs.sh \
+	     run-varlocs.sh run-exprlocs.sh testfile-stridex.bz2 \
 	     testfile_const_type.c testfile_const_type.bz2 \
 	     testfile_implicit_pointer.c testfile_implicit_pointer.bz2 \
 	     testfile_parameter_ref.c testfile_parameter_ref.bz2 \
diff --git a/tests/run-exprlocs.sh b/tests/run-exprlocs.sh
new file mode 100755
index 00000000..379ca52b
--- /dev/null
+++ b/tests/run-exprlocs.sh
@@ -0,0 +1,180 @@
+#! /bin/sh
+# Copyright (C) 2017 Red Hat, Inc.
+# This file is part of elfutils.
+#
+# This file 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.
+#
+# elfutils 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/>.
+
+. $srcdir/test-subr.sh
+
+# https://gcc.gnu.org/bugzilla/show_bug.cgi?id=77589
+#
+# program repro
+#   type small_stride
+#      character*40 long_string
+#      integer      small_pad
+#   end type small_stride
+#   type(small_stride), dimension (20), target :: unpleasant
+#   character*40, pointer, dimension(:):: c40pt
+#   integer i
+#   do i = 0,19
+#      unpleasant(i+1)%small_pad = i+1
+#      unpleasant(i+1)%long_string = char (ichar('0') + i) // '-hello'
+#   end do
+#   c40pt => unpleasant%long_string
+#   print *, c40pt  ! break-here
+# end program repro
+#
+# Needs GCC7+
+# gfortran -o testfile-stridex dwarf-stridex.f90 -Wall -g
+
+testfiles testfile-stridex
+
+testrun_compare ${abs_top_builddir}/tests/varlocs --exprlocs -e testfile-stridex <<\EOF
+module 'testfile-stridex'
+[b] CU 'dwarf-stridex.f90'@400717
+  producer (strp)
+  language (data1)
+  identifier_case (data1)
+  name (strp)
+  comp_dir (strp)
+  low_pc (addr)
+  high_pc (data8)
+  stmt_list (sec_offset)
+  [2e] base_type "integer(kind=8)"
+    byte_size (data1)
+    encoding (data1)
+    name (strp)
+  [35] structure_type "small_stride"
+    name (strp)
+    byte_size (data1)
+    decl_file (data1)
+    decl_line (data1)
+    sibling (ref4)
+    [41] member "long_string"
+      name (strp)
+      decl_file (data1)
+      decl_line (data1)
+      type (ref4)
+      data_member_location (data1) {plus_uconst(0)}
+    [4d] member "small_pad"
+      name (strp)
+      decl_file (data1)
+      decl_line (data1)
+      type (ref4)
+      data_member_location (data1) {plus_uconst(40)}
+  [5a] string_type
+    byte_size (data1)
+  [5c] base_type "integer(kind=4)"
+    byte_size (data1)
+    encoding (data1)
+    name (strp)
+  [63] const_type
+    type (ref4)
+  [68] subprogram "main"
+    external (flag_present)
+    name (strp)
+    decl_file (data1)
+    decl_line (data1)
+    type (ref4)
+    low_pc (addr)
+    high_pc (data8)
+    frame_base (exprloc) {call_frame_cfa {bregx(7,8)}}
+    GNU_all_tail_call_sites (flag_present)
+    sibling (ref4)
+    [89] formal_parameter "argc"
+      name (strp)
+      decl_file (data1)
+      decl_line (data1)
+      type (ref4)
+      location (exprloc) {fbreg(-20)}
+    [97] formal_parameter "argv"
+      name (strp)
+      decl_file (data1)
+      decl_line (data1)
+      type (ref4)
+      location (exprloc) {fbreg(-32), deref}
+  [a7] pointer_type
+    byte_size (data1)
+    type (ref4)
+  [ad] base_type "character(kind=1)"
+    byte_size (data1)
+    encoding (data1)
+    name (strp)
+  [b4] subprogram "repro"
+    name (strp)
+    decl_file (data1)
+    decl_line (data1)
+    main_subprogram (flag_present)
+    calling_convention (data1)
+    low_pc (addr)
+    high_pc (data8)
+    frame_base (exprloc) {call_frame_cfa {bregx(7,8)}}
+    GNU_all_tail_call_sites (flag_present)
+    sibling (ref4)
+    [d2] variable "c40pt"
+      name (strp)
+      decl_file (data1)
+      decl_line (data1)
+      type (ref4)
+      location (exprloc) {fbreg(-128)}
+    [e1] variable "span.0"
+      name (strp)
+      type (ref4)
+      artificial (flag_present)
+      location (exprloc) {fbreg(-80)}
+    [ee] variable "i"
+      name (string)
+      decl_file (data1)
+      decl_line (data1)
+      type (ref4)
+      location (exprloc) {fbreg(-68)}
+    [fb] variable "unpleasant"
+      name (strp)
+      decl_file (data1)
+      decl_line (data1)
+      type (ref4)
+      location (exprloc) {fbreg(-1008)}
+    [10a] lexical_block
+      low_pc (addr)
+      high_pc (data8)
+      sibling (ref4)
+      [11f] lexical_block
+        low_pc (addr)
+        high_pc (data8)
+    [131] lexical_block
+      low_pc (addr)
+      high_pc (data8)
+      [142] lexical_block
+        low_pc (addr)
+        high_pc (data8)
+        [153] lexical_block
+          low_pc (addr)
+          high_pc (data8)
+  [167] array_type
+    data_location (exprloc) {push_object_address, deref}
+    associated (exprloc) {push_object_address, deref, lit0, ne}
+    type (ref4)
+    sibling (ref4)
+    [178] subrange_type
+      lower_bound (exprloc) {push_object_address, plus_uconst(32), deref}
+      upper_bound (exprloc) {push_object_address, plus_uconst(40), deref}
+      byte_stride (exprloc) {push_object_address, plus_uconst(24), deref, GNU_variable_value([e1]) {fbreg(-80)}, mul}
+  [18f] array_type
+    type (ref4)
+    [194] subrange_type
+      type (ref4)
+      upper_bound (sdata)
+EOF
+
+exit 0
diff --git a/tests/testfile-stridex.bz2 b/tests/testfile-stridex.bz2
new file mode 100755
index 00000000..ff909f4a
--- /dev/null
+++ b/tests/testfile-stridex.bz2
diff --git a/tests/varlocs.c b/tests/varlocs.c
index c3fba89e..cc77559b 100644
--- a/tests/varlocs.c
+++ b/tests/varlocs.c
@@ -75,6 +75,45 @@ dwarf_encoding_string (unsigned int code)
   return NULL;
 }
 
+static const char *
+dwarf_tag_string (unsigned int tag)
+{
+  switch (tag)
+    {
+#define DWARF_ONE_KNOWN_DW_TAG(NAME, CODE) case CODE: return #NAME;
+      DWARF_ALL_KNOWN_DW_TAG
+#undef DWARF_ONE_KNOWN_DW_TAG
+    default:
+      return NULL;
+    }
+}
+
+static const char *
+dwarf_attr_string (unsigned int attrnum)
+{
+  switch (attrnum)
+    {
+#define DWARF_ONE_KNOWN_DW_AT(NAME, CODE) case CODE: return #NAME;
+      DWARF_ALL_KNOWN_DW_AT
+#undef DWARF_ONE_KNOWN_DW_AT
+    default:
+      return NULL;
+    }
+}
+
+static const char *
+dwarf_form_string (unsigned int form)
+{
+  switch (form)
+    {
+#define DWARF_ONE_KNOWN_DW_FORM(NAME, CODE) case CODE: return #NAME;
+      DWARF_ALL_KNOWN_DW_FORM
+#undef DWARF_ONE_KNOWN_DW_FORM
+    default:
+      return NULL;
+    }
+}
+
 /* BASE must be a base type DIE referenced by a typed DWARF expression op.  */
 static void
 print_base_type (Dwarf_Die *base)
@@ -386,7 +425,7 @@ print_expr (Dwarf_Attribute *attr, Dwarf_Op *expr, Dwarf_Addr addr)
 
 	Dwarf_Die impl_die;
 	if (dwarf_getlocation_die (attr, expr, &impl_die) != 0)
-	  error (EXIT_FAILURE, 0, "dwarf_getlocation_due: %s",
+	  error (EXIT_FAILURE, 0, "dwarf_getlocation_die: %s",
 		 dwarf_errmsg (-1));
 
 	printf ("%s([%" PRIx64 "],%" PRId64 ") ", opname,
@@ -413,6 +452,46 @@ print_expr (Dwarf_Attribute *attr, Dwarf_Op *expr, Dwarf_Addr addr)
       }
       break;
 
+    case DW_OP_GNU_variable_value:
+      /* Special, DIE offset. Referenced DIE has a location or const_value
+	 attribute. */
+      {
+	if (attr == NULL)
+	  error (EXIT_FAILURE, 0, "%s used in CFI", opname);
+
+	Dwarf_Attribute attrval;
+	if (dwarf_getlocation_attr (attr, expr, &attrval) != 0)
+	  error (EXIT_FAILURE, 0, "dwarf_getlocation_attr: %s",
+		 dwarf_errmsg (-1));
+
+	Dwarf_Die impl_die;
+	if (dwarf_getlocation_die (attr, expr, &impl_die) != 0)
+	  error (EXIT_FAILURE, 0, "dwarf_getlocation_die: %s",
+		 dwarf_errmsg (-1));
+
+	printf ("%s([%" PRIx64 "]) ", opname, dwarf_dieoffset (&impl_die));
+
+	if (dwarf_whatattr (&attrval) == DW_AT_const_value)
+	  printf ("<constant value>"); // Lookup type...
+	else
+	  {
+	    // Lookup the location description at the current address.
+	    Dwarf_Op *exprval;
+	    size_t exprval_len;
+	    int locs = dwarf_getlocation_addr (&attrval, addr,
+					       &exprval, &exprval_len, 1);
+	    if (locs == 0)
+	      printf ("<no location>"); // This means "optimized out".
+	    else if (locs == 1)
+	      print_expr_block (&attrval, exprval, exprval_len, addr);
+	    else
+	      error (EXIT_FAILURE, 0,
+		     "dwarf_getlocation_addr attrval at addr 0x%" PRIx64
+		     ", locs (%d): %s", addr, locs, dwarf_errmsg (-1));
+	  }
+      }
+      break;
+
     case DW_OP_GNU_entry_value:
       /* Special, unsigned size plus expression block. All registers
 	 inside the block should be interpreted as they had on
@@ -759,9 +838,133 @@ handle_function (Dwarf_Die *funcdie, void *arg __attribute__((unused)))
   return DWARF_CB_OK;
 }
 
+struct attr_arg
+{
+  int depth;
+  Dwarf_Addr entrypc;
+};
+
+static int
+handle_attr (Dwarf_Attribute *attr, void *arg)
+{
+  int depth = ((struct attr_arg *) arg)->depth;
+  Dwarf_Addr entrypc = ((struct attr_arg *) arg)->entrypc;
+
+  unsigned int code = dwarf_whatattr (attr);
+  unsigned int form = dwarf_whatform (attr);
+
+  printf ("%*s%s (%s)", depth * 2, "",
+	  dwarf_attr_string (code), dwarf_form_string (form));
+
+  /* If we can get an DWARF expression (or location lists) from this
+     attribute we'll print it, otherwise we'll ignore it.  But if
+     there is an error while the attribute has the "correct" form then
+     we'll report an error (we can only really check DW_FORM_exprloc
+     other forms can be ambiguous).  */
+  Dwarf_Op *expr;
+  size_t exprlen;
+  bool printed = false;
+  int res = dwarf_getlocation (attr, &expr, &exprlen);
+  if (res == 0)
+    {
+      printf (" ");
+      print_expr_block (attr, expr, exprlen, entrypc);
+      printf ("\n");
+      printed = true;
+    }
+  else if (form == DW_FORM_exprloc)
+    {
+      error (0, 0, "%s dwarf_getlocation failed: %s",
+	     dwarf_attr_string (code), dwarf_errmsg (-1));
+      return DWARF_CB_ABORT;
+    }
+  else
+    {
+      Dwarf_Addr base, begin, end;
+      ptrdiff_t offset = 0;
+      while ((offset = dwarf_getlocations (attr, offset,
+					   &base, &begin, &end,
+					   &expr, &exprlen)) > 0)
+	{
+	  if (! printed)
+	    printf ("\n");
+	  printf ("%*s", depth * 2, "");
+	  print_expr_block_addrs (attr, begin, end, expr, exprlen);
+	  printed = true;
+	}
+    }
+
+  if (! printed)
+    printf ("\n");
+
+  return DWARF_CB_OK;
+}
+
+static void
+handle_die (Dwarf_Die *die, int depth, bool outer_has_frame_base,
+	    Dwarf_Addr outer_entrypc)
+{
+  /* CU DIE already printed.  */
+  if (depth > 0)
+    {
+      const char *name = dwarf_diename (die);
+      if (name != NULL)
+	printf ("%*s[%" PRIx64 "] %s \"%s\"\n", depth * 2, "",
+		dwarf_dieoffset (die), dwarf_tag_string (dwarf_tag (die)),
+		name);
+      else
+	printf ("%*s[%" PRIx64 "] %s\n", depth * 2, "",
+		dwarf_dieoffset (die), dwarf_tag_string (dwarf_tag (die)));
+    }
+
+  struct attr_arg arg;
+  arg.depth = depth + 1;
+
+  /* The (lowest) address to use for (looking up) operands that depend
+     on address.  */
+  Dwarf_Addr die_entrypc;
+  if (dwarf_entrypc (die, &die_entrypc) != 0 || die_entrypc == 0)
+    die_entrypc = outer_entrypc;
+  arg.entrypc = die_entrypc;
+
+  /* Whether this or the any outer DIE has a frame base. Used as
+     sanity check when printing experssions that use DW_OP_fbreg.  */
+  bool die_has_frame_base = dwarf_hasattr (die, DW_AT_frame_base);
+  die_has_frame_base |= outer_has_frame_base;
+  has_frame_base = die_has_frame_base;
+
+  /* Look through all attributes to find those that contain DWARF
+     expressions and print those.  We expect to handle all attributes,
+     anything else is an error.  */
+  if (dwarf_getattrs (die, handle_attr, &arg, 0) != 1)
+    error (EXIT_FAILURE, 0, "Couldn't get all attributes: %s",
+	   dwarf_errmsg (-1));
+
+  /* Handle children and siblings recursively depth first.  */
+  Dwarf_Die child;
+  if (dwarf_haschildren (die) != 0 && dwarf_child (die, &child) == 0)
+    handle_die (&child, depth + 1, die_has_frame_base, die_entrypc);
+
+  Dwarf_Die sibling;
+  if (dwarf_siblingof (die, &sibling) == 0)
+    handle_die (&sibling, depth, outer_has_frame_base, outer_entrypc);
+}
+
 int
 main (int argc, char *argv[])
 {
+  /* With --exprlocs we process all DIEs looking for any attribute
+     which contains an DWARF expression (but not location lists) and
+     print those.  Otherwise we process all function DIEs and print
+     all DWARF expressions and location lists associated with
+     parameters and variables). */
+  bool exprlocs = false;
+  if (argc > 1 && strcmp ("--exprlocs", argv[1]) == 0)
+    {
+      exprlocs = true;
+      argv[1] = "";
+    }
+
   int remaining;
   Dwfl *dwfl;
   (void) argp_parse (dwfl_standard_argp (), argc, argv, 0, &remaining,
@@ -773,10 +976,11 @@ main (int argc, char *argv[])
   while ((cu = dwfl_nextcu (dwfl, cu, &dwbias)) != NULL)
     {
       /* Only walk actual compile units (not partial units) that
-	 contain code.  */
+	 contain code if we are only interested in the function variable
+	 locations.  */
       Dwarf_Addr cubase;
       if (dwarf_tag (cu) == DW_TAG_compile_unit
-	  && dwarf_lowpc (cu, &cubase) == 0)
+	  && (exprlocs || dwarf_lowpc (cu, &cubase) == 0))
 	{
 	  Dwfl_Module *mod = dwfl_cumodule (cu);
 	  Dwarf_Addr modbias;
@@ -806,14 +1010,28 @@ main (int argc, char *argv[])
 	  cfi_eh = dwarf_getcfi_elf (elf);
 	  cfi_eh_bias = dwbias - elfbias;
 
-	  // Get the actual CU DIE and walk all functions inside it.
+	  // Get the actual CU DIE and walk all all DIEs (or just the
+	  // functions) inside it.
 	  Dwarf_Die cudie;
 	  uint8_t offsize;
 	  uint8_t addrsize;
 	  if (dwarf_diecu (cu, &cudie, &addrsize, &offsize) == NULL)
 	    error (EXIT_FAILURE, 0, "dwarf_diecu %s", dwarf_errmsg (-1));
 
-	  if (dwarf_getfuncs (cu, handle_function, NULL, 0) != 0)
+	  if (exprlocs)
+	    {
+	      Dwarf_Addr entrypc;
+	      if (dwarf_entrypc (cu, &entrypc) != 0)
+		entrypc = 0;
+
+	      /* XXX - Passing true for has_frame_base is not really true.
+		 We do it because we want to resolve all DIEs and all
+		 attributes. Technically we should check that the DIE
+		 (types) are referenced from variables that are defined in
+		 a context (function) that has a frame base.  */
+	      handle_die (cu, 0, true /* Should be false */, entrypc);
+	    }
+	  else if (dwarf_getfuncs (cu, handle_function, NULL, 0) != 0)
 	    error (EXIT_FAILURE, 0, "dwarf_getfuncs %s",
 		   dwarf_errmsg (-1));
 	}