Handle biased types

Message ID 20190812150229.9738-1-tromey@adacore.com
State New, archived
Headers

Commit Message

Tom Tromey Aug. 12, 2019, 3:02 p.m. UTC
  In Ada, the programmer can request that a range type with a non-zero
base be stored in the minimal number of bits required for the range.
This is done by biasing the values; so, for example, a range of -7..-4
may be stored as two bits with a bias of -7.

This patch implements this for gdb.  It is done by adding a bias to
struct range_bounds and then adjusting a few spots to handle this.

The test case is written to use -fgnat-encodings=minimal, but a future
compiler patch will change the compiler to emit DW_AT_GNU_bias with
-fgnat-encodings=gdb.  It seemed good to get the gdb patch in first.

Tested on x86-64 Fedora 29; plus a variety of targets using AdaCore's
internal test suite.

gdb/ChangeLog
2019-08-12  Tom Tromey  <tromey@adacore.com>

	* ada-valprint.c (ada_val_print_num): Don't recurse for range
	types.
	(has_negatives): Unbias a range type bound.
	* dwarf2read.c (read_subrange_type): Handle DW_AT_GNU_bias.
	* gdbtypes.c (operator==): Handle new field.
	(create_range_type): Add "bias" parameter.
	(create_static_range_type, resolve_dynamic_range): Update.
	* gdbtypes.h (struct range_bounds) <bias>: New member.
	(create_range_type): Add bias parameter.
	* printcmd.c (print_scalar_formatted): Unbias range types.
	* value.c (unpack_long): Unbias range types.
	(pack_long): Bias range types.

gdb/testsuite/ChangeLog
2019-08-12  Tom Tromey  <tromey@adacore.com>

	* gdb.ada/bias.exp: New file.
	* gdb.ada/bias/bias.adb: New file.
	* gdb.ada/print_chars.exp: Add regression test.
	* gdb.ada/print_chars/foo.adb (My_Character): New type.
	(MC): New variable.
---
 gdb/ChangeLog                             | 15 ++++++
 gdb/ada-lang.c                            |  2 +-
 gdb/ada-valprint.c                        |  9 +++-
 gdb/dwarf2read.c                          |  7 ++-
 gdb/gdbtypes.c                            | 12 +++--
 gdb/gdbtypes.h                            |  8 +++-
 gdb/printcmd.c                            | 50 ++++++++++++--------
 gdb/testsuite/ChangeLog                   |  8 ++++
 gdb/testsuite/gdb.ada/bias.exp            | 56 +++++++++++++++++++++++
 gdb/testsuite/gdb.ada/bias/bias.adb       | 52 +++++++++++++++++++++
 gdb/testsuite/gdb.ada/bias/pck.adb        | 23 ++++++++++
 gdb/testsuite/gdb.ada/bias/pck.ads        | 20 ++++++++
 gdb/testsuite/gdb.ada/print_chars.exp     |  2 +-
 gdb/testsuite/gdb.ada/print_chars/foo.adb |  3 ++
 gdb/value.c                               | 18 ++++++--
 15 files changed, 251 insertions(+), 34 deletions(-)
 create mode 100644 gdb/testsuite/gdb.ada/bias.exp
 create mode 100644 gdb/testsuite/gdb.ada/bias/bias.adb
 create mode 100644 gdb/testsuite/gdb.ada/bias/pck.adb
 create mode 100644 gdb/testsuite/gdb.ada/bias/pck.ads
  

Comments

Tom Tromey Sept. 3, 2019, 4:20 p.m. UTC | #1
>>>>> "Tom" == Tom Tromey <tromey@adacore.com> writes:

Tom> In Ada, the programmer can request that a range type with a non-zero
Tom> base be stored in the minimal number of bits required for the range.
Tom> This is done by biasing the values; so, for example, a range of -7..-4
Tom> may be stored as two bits with a bias of -7.

Tom> This patch implements this for gdb.  It is done by adding a bias to
Tom> struct range_bounds and then adjusting a few spots to handle this.

Tom> The test case is written to use -fgnat-encodings=minimal, but a future
Tom> compiler patch will change the compiler to emit DW_AT_GNU_bias with
Tom> -fgnat-encodings=gdb.  It seemed good to get the gdb patch in first.

Tom> Tested on x86-64 Fedora 29; plus a variety of targets using AdaCore's
Tom> internal test suite.

I'm going to check this in now.

Tom
  

Patch

diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 21a8e92462f..851095a75a6 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -2361,7 +2361,7 @@  has_negatives (struct type *type)
     case TYPE_CODE_INT:
       return !TYPE_UNSIGNED (type);
     case TYPE_CODE_RANGE:
-      return TYPE_LOW_BOUND (type) < 0;
+      return TYPE_LOW_BOUND (type) - TYPE_RANGE_DATA (type)->bias < 0;
     }
 }
 
diff --git a/gdb/ada-valprint.c b/gdb/ada-valprint.c
index 0654049d77b..3060eb676b6 100644
--- a/gdb/ada-valprint.c
+++ b/gdb/ada-valprint.c
@@ -841,8 +841,15 @@  ada_val_print_num (struct type *type, const gdb_byte *valaddr,
       fputs_filtered (str.c_str (), stream);
       return;
     }
-  else if (TYPE_CODE (type) == TYPE_CODE_RANGE)
+  else if (TYPE_CODE (type) == TYPE_CODE_RANGE
+	   && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ENUM
+	       || TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_BOOL
+	       || TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_CHAR))
     {
+      /* For enum-valued ranges, we want to recurse, because we'll end
+	 up printing the constant's name rather than its numeric
+	 value.  Character and fixed-point types are also printed
+	 differently, so recuse for those as well.  */
       struct type *target_type = TYPE_TARGET_TYPE (type);
 
       if (TYPE_LENGTH (type) != TYPE_LENGTH (target_type))
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index de9755f6ce3..8abc98bc6a3 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -17895,6 +17895,11 @@  read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
 	}
     }
 
+  LONGEST bias = 0;
+  struct attribute *bias_attr = dwarf2_attr (die, DW_AT_GNU_bias, cu);
+  if (bias_attr != nullptr && attr_form_is_constant (bias_attr))
+    bias = dwarf2_get_attr_constant_value (bias_attr, 0);
+
   /* Normally, the DWARF producers are expected to use a signed
      constant form (Eg. DW_FORM_sdata) to express negative bounds.
      But this is unfortunately not always the case, as witnessed
@@ -17911,7 +17916,7 @@  read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
       && !TYPE_UNSIGNED (base_type) && (high.data.const_val & negative_mask))
     high.data.const_val |= negative_mask;
 
-  range_type = create_range_type (NULL, orig_base_type, &low, &high);
+  range_type = create_range_type (NULL, orig_base_type, &low, &high, bias);
 
   if (high_bound_is_count)
     TYPE_RANGE_DATA (range_type)->flag_upper_bound_is_count = 1;
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 177455e6126..4bc02e08f96 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -901,7 +901,8 @@  operator== (const range_bounds &l, const range_bounds &r)
   return (FIELD_EQ (low)
 	  && FIELD_EQ (high)
 	  && FIELD_EQ (flag_upper_bound_is_count)
-	  && FIELD_EQ (flag_bound_evaluated));
+	  && FIELD_EQ (flag_bound_evaluated)
+	  && FIELD_EQ (bias));
 
 #undef FIELD_EQ
 }
@@ -912,7 +913,8 @@  operator== (const range_bounds &l, const range_bounds &r)
 struct type *
 create_range_type (struct type *result_type, struct type *index_type,
 		   const struct dynamic_prop *low_bound,
-		   const struct dynamic_prop *high_bound)
+		   const struct dynamic_prop *high_bound,
+		   LONGEST bias)
 {
   /* The INDEX_TYPE should be a type capable of holding the upper and lower
      bounds, as such a zero sized, or void type makes no sense.  */
@@ -932,6 +934,7 @@  create_range_type (struct type *result_type, struct type *index_type,
     TYPE_ZALLOC (result_type, sizeof (struct range_bounds));
   TYPE_RANGE_DATA (result_type)->low = *low_bound;
   TYPE_RANGE_DATA (result_type)->high = *high_bound;
+  TYPE_RANGE_DATA (result_type)->bias = bias;
 
   if (low_bound->kind == PROP_CONST && low_bound->data.const_val >= 0)
     TYPE_UNSIGNED (result_type) = 1;
@@ -968,7 +971,7 @@  create_static_range_type (struct type *result_type, struct type *index_type,
   high.kind = PROP_CONST;
   high.data.const_val = high_bound;
 
-  result_type = create_range_type (result_type, index_type, &low, &high);
+  result_type = create_range_type (result_type, index_type, &low, &high, 0);
 
   return result_type;
 }
@@ -2015,9 +2018,10 @@  resolve_dynamic_range (struct type *dyn_range_type,
   static_target_type
     = resolve_dynamic_type_internal (TYPE_TARGET_TYPE (dyn_range_type),
 				     addr_stack, 0);
+  LONGEST bias = TYPE_RANGE_DATA (dyn_range_type)->bias;
   static_range_type = create_range_type (copy_type (dyn_range_type),
 					 static_target_type,
-					 &low_bound, &high_bound);
+					 &low_bound, &high_bound, bias);
   TYPE_RANGE_DATA (static_range_type)->flag_bound_evaluated = 1;
   return static_range_type;
 }
diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
index 7268d3e4aa3..c62b8a31ba7 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -617,6 +617,11 @@  struct range_bounds
 
   struct dynamic_prop high;
 
+  /* * The bias.  Sometimes a range value is biased before storage.
+     The bias is added to the stored bits to form the true value.  */
+
+  LONGEST bias;
+
   /* True if HIGH range bound contains the number of elements in the
      subrange.  This affects how the final high bound is computed.  */
 
@@ -1951,7 +1956,8 @@  extern struct type *create_array_type_with_stride
 
 extern struct type *create_range_type (struct type *, struct type *,
 				       const struct dynamic_prop *,
-				       const struct dynamic_prop *);
+				       const struct dynamic_prop *,
+				       LONGEST);
 
 extern struct type *create_array_type (struct type *, struct type *,
 				       struct type *);
diff --git a/gdb/printcmd.c b/gdb/printcmd.c
index 7529842e73b..b2ea2d4885c 100644
--- a/gdb/printcmd.c
+++ b/gdb/printcmd.c
@@ -405,21 +405,30 @@  print_scalar_formatted (const gdb_byte *valaddr, struct type *type,
 
   /* Historically gdb has printed floats by first casting them to a
      long, and then printing the long.  PR cli/16242 suggests changing
-     this to using C-style hex float format.  */
-  gdb::byte_vector converted_float_bytes;
-  if (TYPE_CODE (type) == TYPE_CODE_FLT
-      && (options->format == 'o'
-	  || options->format == 'x'
-	  || options->format == 't'
-	  || options->format == 'z'
-	  || options->format == 'd'
-	  || options->format == 'u'))
-    {
-      LONGEST val_long = unpack_long (type, valaddr);
-      converted_float_bytes.resize (TYPE_LENGTH (type));
-      store_signed_integer (converted_float_bytes.data (), TYPE_LENGTH (type),
-			    byte_order, val_long);
-      valaddr = converted_float_bytes.data ();
+     this to using C-style hex float format.
+
+     Biased range types must also be unbiased here; the unbiasing is
+     done by unpack_long.  */
+  gdb::byte_vector converted_bytes;
+  /* Some cases below will unpack the value again.  In the biased
+     range case, we want to avoid this, so we store the unpacked value
+     here for possible use later.  */
+  gdb::optional<LONGEST> val_long;
+  if ((TYPE_CODE (type) == TYPE_CODE_FLT
+       && (options->format == 'o'
+	   || options->format == 'x'
+	   || options->format == 't'
+	   || options->format == 'z'
+	   || options->format == 'd'
+	   || options->format == 'u'))
+      || (TYPE_CODE (type) == TYPE_CODE_RANGE
+	  && TYPE_RANGE_DATA (type)->bias != 0))
+    {
+      val_long.emplace (unpack_long (type, valaddr));
+      converted_bytes.resize (TYPE_LENGTH (type));
+      store_signed_integer (converted_bytes.data (), TYPE_LENGTH (type),
+			    byte_order, *val_long);
+      valaddr = converted_bytes.data ();
     }
 
   /* Printing a non-float type as 'f' will interpret the data as if it were
@@ -469,7 +478,8 @@  print_scalar_formatted (const gdb_byte *valaddr, struct type *type,
       {
 	struct value_print_options opts = *options;
 
-	LONGEST val_long = unpack_long (type, valaddr);
+	if (!val_long.has_value ())
+	  val_long.emplace (unpack_long (type, valaddr));
 
 	opts.format = 0;
 	if (TYPE_UNSIGNED (type))
@@ -477,15 +487,15 @@  print_scalar_formatted (const gdb_byte *valaddr, struct type *type,
  	else
 	  type = builtin_type (gdbarch)->builtin_true_char;
 
-	value_print (value_from_longest (type, val_long), stream, &opts);
+	value_print (value_from_longest (type, *val_long), stream, &opts);
       }
       break;
 
     case 'a':
       {
-	CORE_ADDR addr = unpack_pointer (type, valaddr);
-
-	print_address (gdbarch, addr, stream);
+	if (!val_long.has_value ())
+	  val_long.emplace (unpack_long (type, valaddr));
+	print_address (gdbarch, *val_long, stream);
       }
       break;
 
diff --git a/gdb/testsuite/gdb.ada/bias.exp b/gdb/testsuite/gdb.ada/bias.exp
new file mode 100644
index 00000000000..76ca6c08c63
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/bias.exp
@@ -0,0 +1,56 @@ 
+# Copyright 2019 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/>.
+
+load_lib "ada.exp"
+
+standard_ada_testfile bias
+
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable \
+	 {debug additional_flags=-fgnat-encodings=minimal}] != "" } {
+  return -1
+}
+
+clean_restart ${testfile}
+
+set bp_location [gdb_get_line_number "STOP" ${testdir}/bias.adb]
+runto "bias.adb:$bp_location"
+
+gdb_test "print x" " = 64"
+gdb_test "print y" " = -5"
+
+gdb_test "print cval" " = 65"
+gdb_test "print/c cval" " = 65 'A'"
+
+# Some binary arithmetic checks.
+gdb_test "print y < y1" " = false"
+gdb_test "print y <= y1" " = false"
+gdb_test "print y > y1" " = true"
+gdb_test "print y >= y1" " = true"
+gdb_test "print y = y" " = true"
+gdb_test "print y /= y" " = false"
+gdb_test "print y /= y1" " = true"
+
+gdb_test "print x + x1" " = 65"
+gdb_test "ptype x + x1" "type = range 1 \\.\\. 64"
+gdb_test "print x / x1" " = 64"
+gdb_test "print x * x1" " = 64"
+gdb_test "print x - x1" " = 63"
+
+# Test that storing un-biases.
+gdb_test "print x := 5" " = 5"
+gdb_test "print x" " = 5" "re-read x after storing"
+
+gdb_test "print spr" " = \\(r => -4, s => -5\\)"
+gdb_test "print a" " = \\(-7, -5, -4\\)"
diff --git a/gdb/testsuite/gdb.ada/bias/bias.adb b/gdb/testsuite/gdb.ada/bias/bias.adb
new file mode 100644
index 00000000000..ad46d20dd20
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/bias/bias.adb
@@ -0,0 +1,52 @@ 
+--  Copyright 2019 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/>.
+
+with Pck; use Pck;
+
+procedure Bias is
+   type Small is range -7 .. -4;
+   for Small'Size use 2;
+   Y : Small := -5;
+   Y1 : Small := -7;
+
+   type Repeat_Count_T is range 1 .. 2 ** 6;
+   for Repeat_Count_T'Size use 6;
+   X : Repeat_Count_T := 64;
+   X1 : Repeat_Count_T := 1;
+
+   type Char_Range is range 65 .. 68;
+   for Char_Range'Size use 2;
+   Cval : Char_Range := 65;
+
+   type Some_Packed_Record is record
+      R: Small;
+      S: Small;
+   end record;
+   pragma Pack (Some_Packed_Record);
+   SPR : Some_Packed_Record := (R => -4, S => -5);
+
+   type Packed_Array is array (1 .. 3) of Small;
+   pragma pack (Packed_Array);
+   A : Packed_Array := (-7, -5, -4);
+
+begin
+   Do_Nothing (Y'Address);		--  STOP
+   Do_Nothing (Y1'Address);
+   Do_Nothing (X'Address);
+   Do_Nothing (X1'Address);
+   Do_Nothing (Cval'Address);
+   Do_Nothing (SPR'Address);
+   Do_Nothing (A'Address);
+end Bias;
diff --git a/gdb/testsuite/gdb.ada/bias/pck.adb b/gdb/testsuite/gdb.ada/bias/pck.adb
new file mode 100644
index 00000000000..fb433861df0
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/bias/pck.adb
@@ -0,0 +1,23 @@ 
+--  Copyright 2012-2019 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/>.
+
+with System;
+
+package body Pck is
+   procedure Do_Nothing (A : System.Address) is
+   begin
+      null;
+   end Do_Nothing;
+end Pck;
diff --git a/gdb/testsuite/gdb.ada/bias/pck.ads b/gdb/testsuite/gdb.ada/bias/pck.ads
new file mode 100644
index 00000000000..a40fa62c8eb
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/bias/pck.ads
@@ -0,0 +1,20 @@ 
+--  Copyright 2012-2019 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/>.
+
+with System;
+
+package Pck is
+   procedure Do_Nothing (A : System.Address);
+end Pck;
diff --git a/gdb/testsuite/gdb.ada/print_chars.exp b/gdb/testsuite/gdb.ada/print_chars.exp
index 992b1347641..9a0e2157844 100644
--- a/gdb/testsuite/gdb.ada/print_chars.exp
+++ b/gdb/testsuite/gdb.ada/print_chars.exp
@@ -39,4 +39,4 @@  gdb_test "print WWC" \
          "= 99 'c'"  \
          "print WWC"
 
-
+gdb_test "print MC" " = 77 'M'"
diff --git a/gdb/testsuite/gdb.ada/print_chars/foo.adb b/gdb/testsuite/gdb.ada/print_chars/foo.adb
index 40d0c060942..c89c0d3cef9 100644
--- a/gdb/testsuite/gdb.ada/print_chars/foo.adb
+++ b/gdb/testsuite/gdb.ada/print_chars/foo.adb
@@ -19,6 +19,9 @@  procedure Foo is
    C : Character := 'a';
    WC : Wide_Character := 'b';
    WWC : Wide_Wide_Character := 'c';
+
+   type My_Character is new Character;
+   MC : My_Character := 'M';
 begin
    Do_Nothing (C'Address);  -- START
    Do_Nothing (WC'Address);
diff --git a/gdb/value.c b/gdb/value.c
index 9103d8f41c3..d58a964649b 100644
--- a/gdb/value.c
+++ b/gdb/value.c
@@ -2751,10 +2751,16 @@  unpack_long (struct type *type, const gdb_byte *valaddr)
     case TYPE_CODE_CHAR:
     case TYPE_CODE_RANGE:
     case TYPE_CODE_MEMBERPTR:
-      if (nosign)
-	return extract_unsigned_integer (valaddr, len, byte_order);
-      else
-	return extract_signed_integer (valaddr, len, byte_order);
+      {
+	LONGEST result;
+	if (nosign)
+	  result = extract_unsigned_integer (valaddr, len, byte_order);
+	else
+	  result = extract_signed_integer (valaddr, len, byte_order);
+	if (code == TYPE_CODE_RANGE)
+	  result += TYPE_RANGE_DATA (type)->bias;
+	return result;
+      }
 
     case TYPE_CODE_FLT:
     case TYPE_CODE_DECFLOAT:
@@ -3315,12 +3321,14 @@  pack_long (gdb_byte *buf, struct type *type, LONGEST num)
 
   switch (TYPE_CODE (type))
     {
+    case TYPE_CODE_RANGE:
+      num -= TYPE_RANGE_DATA (type)->bias;
+      /* Fall through.  */
     case TYPE_CODE_INT:
     case TYPE_CODE_CHAR:
     case TYPE_CODE_ENUM:
     case TYPE_CODE_FLAGS:
     case TYPE_CODE_BOOL:
-    case TYPE_CODE_RANGE:
     case TYPE_CODE_MEMBERPTR:
       store_signed_integer (buf, len, byte_order, num);
       break;