[PATCH 5/9] Add support for printing value of DWARF-based fixed-point type objects

Joel Brobecker brobecker@adacore.com
Sun Nov 8 06:30:13 GMT 2020


This commit introduces a new kind of type, meant to describe
fixed-point types, using a new code added specifically for
this purpose (TYPE_CODE_FIXED_POINT).

It then adds handling of fixed-point base types in the DWARF reader.

And finally, as a first step, this commit adds support for printing
the value of fixed-point type objects.

Note that this commit has a known issue: Trying to print the value
of a fixed-point object with a format letter (e.g. "print /x NAME")
causes the wrong value to be printed because the scaling factor
is not applied. Since the fix for this issue is isolated, and
this is not a regression, the fix will be made in a pach of its own.
This is meant to simplify review and archeology.

Also, other functionalities related to fixed-point type handling
(ptype, arithmetics, etc), will be added piecemeal as well, for
the same reasons (faciliate reviews and archeology). Related to this,
the testcase gdb.ada/fixed_cmp.exp is adjusted to compile the test
program with -fgnat-encodings=all, so as to force the use of GNAT
encodings, rather than rely on the compiler's default to use them.
The intent is to enhance this testcase to also test the pure DWARF
approach using -fgnat-encodings=minimal as soon as the corresponding
suport gets added in. Thus, the modification to the testcase is made
in a way that it prepares this testcase to be tested in both modes.

gdb/ChangeLog:

        * ada-valprint.c (ada_value_print_1): Add fixed-point type handling.
        * dwarf2/read.c (get_dwarf2_rational_constant)
        (get_dwarf2_unsigned_rational_constant, finish_fixed_point_type)
        (has_zero_over_zero_small_attribute): New functions.
        read_base_type, set_die_type): Add fixed-point type handling.
        * gdb-gdb.py.in: Add fixed-point type handling.
        * gdbtypes.c: #include "gmp-utils.h".
        (create_range_type, set_type_code): Add fixed-point type handling.
        (init_fixed_point_type): New function.
        (is_integral_type, is_scalar_type): Add fixed-point type handling.
        (print_fixed_point_type_info): New function.
        (recursive_dump_type, copy_type_recursive): Add fixed-point type
        handling.
        (fixed_point_type_storage): New typedef.
        (fixed_point_objfile_key): New static global.
        (allocate_fixed_point_type_info, is_fixed_point_type): New functions.
        (fixed_point_type_base_type, fixed_point_scaling_factor): New
        functions.
        * gdbtypes.h: #include "gmp-utils.h".
        (enum type_code) <TYPE_SPECIFIC_FIXED_POINT>: New enum.
        (union type_specific) <fixed_point_info>: New field.
        (struct fixed_point_type_info): New struct.
        (INIT_FIXED_POINT_SPECIFIC, TYPE_FIXED_POINT_INFO): New macros.
        (init_fixed_point_type, is_fixed_point_type)
        (fixed_point_type_base_type, fixed_point_scaling_factor)
        (allocate_fixed_point_type_info): Add declarations.
        * valprint.c (generic_val_print_fixed_point): New function.
        (generic_value_print): Add fixed-point type handling.
        * value.c (value_as_address, unpack_long): Add fixed-point type
        handling.

gdb/testsuite/ChangeLog:

        * gdb.ada/fixed_cmp.exp: Force compilation to use -fgnat-encodings=all.
        * gdb.ada/fixed_points.exp: Add fixed-point variables printing tests.
        * gdb.ada/fixed_points/pck.ads, gdb.ada/fixed_points/pck.adb:
        New files.
        * gdb.ada/fixed_points/fixed_points.adb: Add use of package Pck.

        * gdb.dwarf2/dw2-fixed-point.c, gdb.dwarf2/dw2-fixed-point.exp:
        New files.
---
 gdb/ada-valprint.c                                 |   3 +
 gdb/dwarf2/read.c                                  | 211 +++++++++++++++++++++
 gdb/gdb-gdb.py.in                                  |   5 +
 gdb/gdbtypes.c                                     | 133 ++++++++++++-
 gdb/gdbtypes.h                                     |  53 +++++-
 gdb/testsuite/gdb.ada/fixed_cmp.exp                |  34 ++--
 gdb/testsuite/gdb.ada/fixed_points.exp             |  11 ++
 .../gdb.ada/fixed_points/fixed_points.adb          |   4 +
 gdb/testsuite/gdb.ada/fixed_points/pck.adb         |  22 +++
 gdb/testsuite/gdb.ada/fixed_points/pck.ads         |  30 +++
 gdb/testsuite/gdb.dwarf2/dw2-fixed-point.c         |  49 +++++
 gdb/testsuite/gdb.dwarf2/dw2-fixed-point.exp       | 132 +++++++++++++
 gdb/valprint.c                                     |  33 ++++
 gdb/value.c                                        |  14 ++
 14 files changed, 716 insertions(+), 18 deletions(-)
 create mode 100644 gdb/testsuite/gdb.ada/fixed_points/pck.adb
 create mode 100644 gdb/testsuite/gdb.ada/fixed_points/pck.ads
 create mode 100644 gdb/testsuite/gdb.dwarf2/dw2-fixed-point.c
 create mode 100644 gdb/testsuite/gdb.dwarf2/dw2-fixed-point.exp

diff --git a/gdb/ada-valprint.c b/gdb/ada-valprint.c
index d7704f0..482069a 100644
--- a/gdb/ada-valprint.c
+++ b/gdb/ada-valprint.c
@@ -1027,6 +1027,9 @@ ada_value_print_1 (struct value *val, struct ui_file *stream, int recurse,
       deprecated_set_value_type (val, type);
     }
 
+  if (is_fixed_point_type (type))
+    type = fixed_point_type_base_type (type);
+
   switch (type->code ())
     {
     default:
diff --git a/gdb/dwarf2/read.c b/gdb/dwarf2/read.c
index dbf0a3e..1f5152d 100644
--- a/gdb/dwarf2/read.c
+++ b/gdb/dwarf2/read.c
@@ -18130,6 +18130,157 @@ read_typedef (struct die_info *die, struct dwarf2_cu *cu)
   return this_type;
 }
 
+/* Assuming DIE is a rational DW_TAG_constant, read the DIE's
+   numerator and denominator into NUMERATOR and DENOMINATOR (resp).
+
+   If the numerator and/or numerator attribute is missing,
+   a complaint is filed, and NUMERATOR and DENOMINATOR are left
+   untouched.  */
+
+static void
+get_dwarf2_rational_constant (struct die_info *die, struct dwarf2_cu *cu,
+			      LONGEST *numerator, LONGEST *denominator)
+{
+  struct attribute *num_attr, *denom_attr;
+
+  num_attr = dwarf2_attr (die, DW_AT_GNU_numerator, cu);
+  if (num_attr == NULL)
+    complaint (_("DW_AT_GNU_numerator missing in %s DIE at %s"),
+	       dwarf_tag_name (die->tag), sect_offset_str (die->sect_off));
+
+  denom_attr = dwarf2_attr (die, DW_AT_GNU_denominator, cu);
+  if (denom_attr == NULL)
+    complaint (_("DW_AT_GNU_denominator missing in %s DIE at %s"),
+	       dwarf_tag_name (die->tag), sect_offset_str (die->sect_off));
+
+  if (num_attr == NULL || denom_attr == NULL)
+    return;
+
+  *numerator = num_attr->constant_value (1);
+  *denominator = denom_attr->constant_value (1);
+}
+
+/* Same as get_dwarf2_rational_constant, but extracting an unsigned
+   rational constant, rather than a signed one.
+
+   If the rational constant is has a negative value, a complaint
+   is filed, and NUMERATOR and DENOMINATOR are left untouched.  */
+
+static void
+get_dwarf2_unsigned_rational_constant (struct die_info *die,
+				       struct dwarf2_cu *cu,
+				       ULONGEST *numerator,
+				       ULONGEST *denominator)
+{
+  LONGEST num = 1, denom = 1;
+
+  get_dwarf2_rational_constant (die, cu, &num, &denom);
+  if (num < 0 && denom < 0)
+    {
+      num = -num;
+      denom = -denom;
+    }
+  else if (num < 0)
+    {
+      complaint (_("unexpected negative value for DW_AT_GNU_numerator"
+		   " in DIE at %s"),
+		 sect_offset_str (die->sect_off));
+      return;
+    }
+  else if (denom < 0)
+    {
+      complaint (_("unexpected negative value for DW_AT_GNU_denominator"
+		   " in DIE at %s"),
+		 sect_offset_str (die->sect_off));
+      return;
+    }
+
+  *numerator = num;
+  *denominator = denom;
+}
+
+/* Assiuming DIE corresponds to a fixed point type, finish the creation
+   of the corresponding TYPE by setting its TYPE_FIXED_POINT_INFO.
+   CU is the DIE's CU.  */
+
+static void
+finish_fixed_point_type (struct type *type, struct die_info *die,
+			 struct dwarf2_cu *cu)
+{
+  struct attribute *attr;
+  /* Numerator and denominator of our fixed-point type's scaling factor.
+     The default is a scaling factor of 1, which we use as a fallback
+     when we are not able to decode it (problem with the debugging info,
+     unsupported forms, bug in GDB, etc...).  Using that as the default
+     allows us to at least print the unscaled value, which might still
+     be useful to a user.  */
+  ULONGEST scale_num = 1;
+  ULONGEST scale_denom = 1;
+
+  gdb_assert (type->code () == TYPE_CODE_FIXED_POINT
+	      && TYPE_SPECIFIC_FIELD (type) == TYPE_SPECIFIC_FIXED_POINT);
+
+  attr = dwarf2_attr (die, DW_AT_binary_scale, cu);
+  if (!attr)
+    attr = dwarf2_attr (die, DW_AT_decimal_scale, cu);
+  if (!attr)
+    attr = dwarf2_attr (die, DW_AT_small, cu);
+
+  if (attr == NULL)
+    {
+      /* Scaling factor not found.  Assume a scaling factor of 1,
+	 and hope for the best.  At least the user will be able to see
+	 the encoded value.  */
+      complaint (_("no scale found for fixed-point type (DIE at %s)"),
+		 sect_offset_str (die->sect_off));
+    }
+  else if (attr->name == DW_AT_binary_scale)
+    {
+      LONGEST scale_exp = attr->constant_value (0);
+      ULONGEST *num_or_denom = scale_exp > 0 ? &scale_num : &scale_denom;
+
+      *num_or_denom = 1 << abs (scale_exp);
+    }
+  else if (attr->name == DW_AT_decimal_scale)
+    {
+      LONGEST scale_exp = attr->constant_value (0);
+      ULONGEST *num_or_denom = scale_exp > 0 ? &scale_num : &scale_denom;
+
+      *num_or_denom = uinteger_pow (10, abs (scale_exp));
+    }
+  else if (attr->name == DW_AT_small)
+    {
+      struct die_info *scale_die;
+      struct dwarf2_cu *scale_cu = cu;
+
+      scale_die = follow_die_ref (die, attr, &scale_cu);
+      if (scale_die->tag == DW_TAG_constant)
+	get_dwarf2_unsigned_rational_constant (scale_die, scale_cu,
+					       &scale_num, &scale_denom);
+      else
+	complaint (_("%s DIE not supported as target of DW_AT_small attribute"
+		     " (DIE at %s)"),
+		   dwarf_tag_name (die->tag), sect_offset_str (die->sect_off));
+    }
+  else
+    {
+      complaint (("unsupported scale attribute %s for fixed-point type"
+		   " (DIE at %s)"),
+		 dwarf_attr_name (attr->name),
+		 sect_offset_str (die->sect_off));
+    }
+
+  gdb_mpq &scaling_factor = TYPE_FIXED_POINT_INFO (type)->scaling_factor;
+
+  gdb_mpz tmp_z (scale_num);
+  mpz_set (mpq_numref (scaling_factor.val), tmp_z.val);
+
+  tmp_z = scale_denom;
+  mpz_set (mpq_denref (scaling_factor.val), tmp_z.val);
+
+  mpq_canonicalize (scaling_factor.val);
+}
+
 /* Allocate a floating-point type of size BITS and name NAME.  Pass NAME_HINT
    (which may be different from NAME) to the architecture back-end to allow
    it to guess the correct format if necessary.  */
@@ -18171,6 +18322,32 @@ dwarf2_init_integer_type (struct dwarf2_cu *cu, struct objfile *objfile,
   return type;
 }
 
+/* Return true if DIE has a DW_AT_small attribute whose value is
+   a constant rational, where both the numerator and denominator
+   are equal to zero.
+
+   CU is the DIE's Compilation Unit.  */
+
+static bool
+has_zero_over_zero_small_attribute (struct die_info *die,
+				    struct dwarf2_cu *cu)
+{
+  struct attribute *attr = dwarf2_attr (die, DW_AT_small, cu);
+  if (attr == NULL)
+    return false;
+
+  struct dwarf2_cu *scale_cu = cu;
+  struct die_info *scale_die
+    = follow_die_ref (die, attr, &scale_cu);
+
+  if (scale_die->tag != DW_TAG_constant)
+    return false;
+
+  LONGEST num = 1, denom = 1;
+  get_dwarf2_rational_constant (scale_die, cu, &num, &denom);
+  return (num == 0 && denom == 0);
+}
+
 /* Initialise and return a floating point type of size BITS suitable for
    use as a component of a complex number.  The NAME_HINT is passed through
    when initialising the floating point type and is the name of the complex
@@ -18281,6 +18458,31 @@ read_base_type (struct die_info *die, struct dwarf2_cu *cu)
 	}
     }
 
+  if ((encoding == DW_ATE_signed_fixed || encoding == DW_ATE_unsigned_fixed)
+      && cu->language == language_ada
+      && has_zero_over_zero_small_attribute (die, cu))
+    {
+      /* brobecker/2018-02-24: This is a fixed point type for which
+	 the scaling factor is represented as fraction whose value
+	 does not make sense (zero divided by zero), so we should
+	 normally never see these.  However, there is a small category
+	 of fixed point types for which GNAT is unable to provide
+	 the scaling factor via the standard DWARF mechanisms, and
+	 for which the info is provided via the GNAT encodings instead.
+	 This is likely what this DIE is about.
+
+	 Ideally, GNAT should be declaring this type the same way
+	 it declares other fixed point types when using the legacy
+	 GNAT encoding, which is to use a simple signed or unsigned
+	 base type.  A report to the GNAT team has been created to
+	 look into it.  In the meantime, pretend this type is a simple
+	 signed or unsigned integral, rather than a fixed point type,
+	 to avoid any confusion later on as to how to process this type.  */
+      encoding = (encoding == DW_ATE_signed_fixed
+		  ? DW_ATE_signed
+		  : DW_ATE_unsigned);
+    }
+
   switch (encoding)
     {
       case DW_ATE_address:
@@ -18357,6 +18559,14 @@ read_base_type (struct die_info *die, struct dwarf2_cu *cu)
 	  return set_die_type (die, type, cu);
 	}
 	break;
+      case DW_ATE_signed_fixed:
+	type = init_fixed_point_type (objfile, bits, 0, name);
+	finish_fixed_point_type (type, die, cu);
+	break;
+      case DW_ATE_unsigned_fixed:
+	type = init_fixed_point_type (objfile, bits, 1, name);
+	finish_fixed_point_type (type, die, cu);
+	break;
 
       default:
 	complaint (_("unsupported DW_AT_encoding: '%s'"),
@@ -24789,6 +24999,7 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu,
       && type->code () != TYPE_CODE_METHODPTR
       && type->code () != TYPE_CODE_MEMBERPTR
       && type->code () != TYPE_CODE_METHOD
+      && type->code () != TYPE_CODE_FIXED_POINT
       && !HAVE_GNAT_AUX_INFO (type))
     INIT_GNAT_SPECIFIC (type);
 
diff --git a/gdb/gdb-gdb.py.in b/gdb/gdb-gdb.py.in
index 6594ac1..ff68bd7 100644
--- a/gdb/gdb-gdb.py.in
+++ b/gdb/gdb-gdb.py.in
@@ -229,6 +229,11 @@ class StructMainTypePrettyPrinter:
             # tail_call_list is not printed.
         elif type_specific_kind == "TYPE_SPECIFIC_SELF_TYPE":
             img = "self_type = %s" % type_specific['self_type']
+        elif type_specific_kind == "TYPE_SPECIFIC_FIXED_POINT":
+            # The scaling factor is an opaque structure, so we cannot
+            # decode its value from Python (not without insider knowledge).
+            img = ('scaling_factor: <opaque> (call __gmpz_dump with '
+                   ' _mp_num and _mp_den fields if needed)')
         else:
             img = ("type_specific = ??? (unknown type_secific_kind: %s)"
                    % type_specific_kind)
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 686edaf..a3a6f07 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -40,6 +40,7 @@
 #include "gdbcore.h"
 #include "floatformat.h"
 #include <algorithm>
+#include "gmp-utils.h"
 
 /* Initialize BADNESS constants.  */
 
@@ -950,6 +951,8 @@ create_range_type (struct type *result_type, struct type *index_type,
 
   result_type->set_bounds (bounds);
 
+  if (index_type->code () == TYPE_CODE_FIXED_POINT)
+    result_type->set_is_unsigned (index_type->is_unsigned ());
   /* Note that the signed-ness of a range type can't simply be copied
      from the underlying type.  Consider a case where the underlying
      type is 'int', but the range type can hold 0..65535, and where
@@ -957,7 +960,7 @@ create_range_type (struct type *result_type, struct type *index_type,
      case, if we copy the underlying type's sign, then reading some
      range values will cause an unwanted sign extension.  So, we have
      some heuristics here instead.  */
-  if (low_bound->kind () == PROP_CONST && low_bound->const_val () >= 0)
+  else if (low_bound->kind () == PROP_CONST && low_bound->const_val () >= 0)
     result_type->set_is_unsigned (true);
   /* Ada allows the declaration of range types whose upper bound is
      less than the lower bound, so checking the lower bound is not
@@ -3136,6 +3139,9 @@ set_type_code (struct type *type, enum type_code code)
 	break;
       case TYPE_CODE_FUNC:
 	INIT_FUNC_SPECIFIC (type);
+        break;
+      case TYPE_CODE_FIXED_POINT:
+	INIT_FIXED_POINT_SPECIFIC (type);
 	break;
     }
 }
@@ -3352,6 +3358,24 @@ init_pointer_type (struct objfile *objfile,
   return t;
 }
 
+/* Allocate a TYPE_CODE_FIXED_POINT type structure associated with OBJFILE.
+   BIT is the pointer type size in bits.
+   UNSIGNED_P should be nonzero if the type is unsigned.
+   NAME is the type name.  */
+
+struct type *
+init_fixed_point_type (struct objfile *objfile,
+		       int bit, int unsigned_p, const char *name)
+{
+  struct type *t;
+
+  t = init_type (objfile, TYPE_CODE_FIXED_POINT, bit, name);
+  if (unsigned_p)
+    t->set_is_unsigned (true);
+
+  return t;
+}
+
 /* See gdbtypes.h.  */
 
 unsigned
@@ -3498,6 +3522,7 @@ is_integral_type (struct type *t)
   t = check_typedef (t);
   return
     ((t != NULL)
+     && !is_fixed_point_type (t)
      && ((t->code () == TYPE_CODE_INT)
 	 || (t->code () == TYPE_CODE_ENUM)
 	 || (t->code () == TYPE_CODE_FLAGS)
@@ -3523,6 +3548,9 @@ is_scalar_type (struct type *type)
 {
   type = check_typedef (type);
 
+  if (is_fixed_point_type (type))
+    return 0; /* Implemented as a scalar, but more like a floating point.  */
+
   switch (type->code ())
     {
     case TYPE_CODE_ARRAY:
@@ -4887,6 +4915,16 @@ print_gnat_stuff (struct type *type, int spaces)
     }
 }
 
+/* Print the contents of the TYPE's type_specific union, assuming that
+   its type-specific kind is TYPE_SPECIFIC_FIXED_POINT.  */
+
+static void
+print_fixed_point_type_info (struct type *type, int spaces)
+{
+  printfi_filtered (spaces + 2, "scaling factor: %s\n",
+		    fixed_point_scaling_factor (type).str ().get ());
+}
+
 static struct obstack dont_print_type_obstack;
 
 /* Print the dynamic_prop PROP.  */
@@ -5025,6 +5063,9 @@ recursive_dump_type (struct type *type, int spaces)
     case TYPE_CODE_NAMESPACE:
       printf_filtered ("(TYPE_CODE_NAMESPACE)");
       break;
+    case TYPE_CODE_FIXED_POINT:
+      printf_filtered ("(TYPE_CODE_FIXED_POINT)");
+      break;
     default:
       printf_filtered ("(UNKNOWN TYPE CODE)");
       break;
@@ -5217,6 +5258,12 @@ recursive_dump_type (struct type *type, int spaces)
 	puts_filtered ("\n");
 	break;
 
+      case TYPE_SPECIFIC_FIXED_POINT:
+	printfi_filtered (spaces, "fixed_point_info ");
+	print_fixed_point_type_info (type, spaces);
+	puts_filtered ("\n");
+	break;
+
     case TYPE_SPECIFIC_INT:
       if (type->bit_size_differs_p ())
 	{
@@ -5449,6 +5496,11 @@ copy_type_recursive (struct objfile *objfile,
 			  copy_type_recursive (objfile, TYPE_SELF_TYPE (type),
 					       copied_types));
       break;
+    case TYPE_SPECIFIC_FIXED_POINT:
+      INIT_FIXED_POINT_SPECIFIC (new_type);
+      TYPE_FIXED_POINT_INFO (new_type)->scaling_factor
+	= TYPE_FIXED_POINT_INFO (type)->scaling_factor;
+      break;
     case TYPE_SPECIFIC_INT:
       TYPE_SPECIFIC_FIELD (new_type) = TYPE_SPECIFIC_INT;
       TYPE_MAIN_TYPE (new_type)->type_specific.int_stuff
@@ -5752,6 +5804,85 @@ append_composite_type_field (struct type *t, const char *name,
   append_composite_type_field_aligned (t, name, field, 0);
 }
 
+
+
+/* We manage the lifetimes of fixed_point_type_info objects by
+   attaching them to the objfile.  Currently, these objects are
+   modified during construction, and GMP does not provide a way to
+   hash the contents of an mpq_t; so it's a bit of a pain to hash-cons
+   them.  If we did do this, they could be moved to the per-BFD and
+   shared across objfiles.  */
+typedef std::vector<std::unique_ptr<fixed_point_type_info>>
+    fixed_point_type_storage;
+
+/* Key used for managing the storage of fixed-point type info.  */
+static const struct objfile_key<fixed_point_type_storage>
+    fixed_point_objfile_key;
+
+/* See gdbtypes.h.  */
+
+fixed_point_type_info *
+allocate_fixed_point_type_info (struct type *type)
+{
+  std::unique_ptr<fixed_point_type_info> up (new fixed_point_type_info);
+  fixed_point_type_info *result;
+
+  if (TYPE_OBJFILE_OWNED (type))
+    {
+      fixed_point_type_storage *storage
+	= fixed_point_objfile_key.get (TYPE_OBJFILE (type));
+      if (storage == nullptr)
+	storage = fixed_point_objfile_key.emplace (TYPE_OBJFILE (type));
+      result = up.get ();
+      storage->push_back (std::move (up));
+    }
+  else
+    {
+      /* We just leak the memory, because that's what we do generally
+	 for non-objfile-attached types.  */
+      result = up.release ();
+    }
+
+  return result;
+}
+
+/* See gdbtypes.h.  */
+
+int
+is_fixed_point_type (struct type *type)
+{
+  while (check_typedef (type)->code () == TYPE_CODE_RANGE)
+    type = TYPE_TARGET_TYPE (check_typedef (type));
+  type = check_typedef (type);
+
+  return type->code () == TYPE_CODE_FIXED_POINT;
+}
+
+/* See gdbtypes.h.  */
+
+struct type *
+fixed_point_type_base_type (struct type *type)
+{
+  while (check_typedef (type)->code () == TYPE_CODE_RANGE)
+    type = TYPE_TARGET_TYPE (check_typedef (type));
+  type = check_typedef (type);
+
+  gdb_assert (type->code () == TYPE_CODE_FIXED_POINT);
+  return type;
+}
+
+/* See gdbtypes.h.  */
+
+const gdb_mpq &
+fixed_point_scaling_factor (struct type *type)
+{
+  type = fixed_point_type_base_type (type);
+
+  return TYPE_FIXED_POINT_INFO (type)->scaling_factor;
+}
+
+
+
 static struct gdbarch_data *gdbtypes_data;
 
 const struct builtin_type *
diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
index 4d574e2..254f227 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -52,6 +52,7 @@
 #include "gdbsupport/print-utils.h"
 #include "dwarf2.h"
 #include "gdb_obstack.h"
+#include "gmp-utils.h"
 
 /* Forward declarations for prototypes.  */
 struct field;
@@ -189,7 +190,10 @@ enum type_code
     TYPE_CODE_INTERNAL_FUNCTION,
 
     /* * Methods implemented in extension languages.  */
-    TYPE_CODE_XMETHOD
+    TYPE_CODE_XMETHOD,
+
+    /* * Fixed Point type.  */
+    TYPE_CODE_FIXED_POINT,
   };
 
 /* * Some bits for the type's instance_flags word.  See the macros
@@ -600,7 +604,8 @@ enum type_specific_kind
   /* Note: This is used by TYPE_CODE_FUNC and TYPE_CODE_METHOD.  */
   TYPE_SPECIFIC_FUNC,
   TYPE_SPECIFIC_SELF_TYPE,
-  TYPE_SPECIFIC_INT
+  TYPE_SPECIFIC_INT,
+  TYPE_SPECIFIC_FIXED_POINT,
 };
 
 union type_owner
@@ -766,6 +771,10 @@ union type_specific
 
   struct type *self_type;
 
+  /* * For TYPE_CODE_FIXED_POINT types, the info necessary to decode
+     values of that type.  */
+  struct fixed_point_type_info *fixed_point_info;
+
   /* * An integer-like scalar type may be stored in just part of its
      enclosing storage bytes.  This structure describes this
      situation.  */
@@ -1678,6 +1687,14 @@ struct call_site
     struct call_site_parameter parameter[1];
   };
 
+/* The type-specific info for TYPE_CODE_FIXED_POINT types.  */
+
+struct fixed_point_type_info
+{
+  /* The fixed point type's scaling factor.  */
+  gdb_mpq scaling_factor;
+};
+
 /* * The default value of TYPE_CPLUS_SPECIFIC(T) points to this shared
    static structure.  */
 
@@ -1725,6 +1742,13 @@ extern void allocate_gnat_aux_type (struct type *);
      TYPE_ZALLOC (type,							       \
 		  sizeof (*TYPE_MAIN_TYPE (type)->type_specific.func_stuff)))
 
+/* "struct fixed_point_type_info" has a field that has a destructor.
+   See allocate_fixed_point_type_info to understand how this is
+   handled.  */
+#define INIT_FIXED_POINT_SPECIFIC(type) \
+  (TYPE_SPECIFIC_FIELD (type) = TYPE_SPECIFIC_FIXED_POINT, \
+   TYPE_FIXED_POINT_INFO (type) = allocate_fixed_point_type_info (type))
+
 #define TYPE_MAIN_TYPE(thistype) (thistype)->main_type
 #define TYPE_TARGET_TYPE(thistype) TYPE_MAIN_TYPE(thistype)->target_type
 #define TYPE_POINTER_TYPE(thistype) (thistype)->pointer_type
@@ -1821,6 +1845,9 @@ extern void set_type_vptr_basetype (struct type *, struct type *);
   (TYPE_CPLUS_SPECIFIC(thistype)->virtual_field_bits == NULL ? 0 \
     : B_TST(TYPE_CPLUS_SPECIFIC(thistype)->virtual_field_bits, (index)))
 
+#define TYPE_FIXED_POINT_INFO(thistype) \
+  (TYPE_MAIN_TYPE(thistype)->type_specific.fixed_point_info)
+
 #define FIELD_NAME(thisfld) ((thisfld).name)
 #define FIELD_LOC_KIND(thisfld) ((thisfld).loc_kind)
 #define FIELD_BITPOS_LVAL(thisfld) ((thisfld).loc.bitpos)
@@ -2192,6 +2219,8 @@ extern struct type *init_decfloat_type (struct objfile *, int, const char *);
 extern struct type *init_complex_type (const char *, struct type *);
 extern struct type *init_pointer_type (struct objfile *, int, const char *,
 				       struct type *);
+extern struct type *init_fixed_point_type (struct objfile *, int, int,
+					   const char *);
 
 /* Helper functions to construct architecture-owned types.  */
 extern struct type *arch_type (struct gdbarch *, enum type_code, int,
@@ -2529,6 +2558,26 @@ extern int type_not_allocated (const struct type *type);
 
 extern int type_not_associated (const struct type *type);
 
+/* Return True if TYPE is a TYPE_CODE_FIXED_POINT or if TYPE is
+   range whose base type is a TYPE_CODE_FIXED_POINT.  */
+extern int is_fixed_point_type (struct type *type);
+
+/* Assuming that TYPE is a fixed point type, return its base type.
+
+   In other words, this returns the type after having peeled all
+   intermediate type layers (such as TYPE_CODE_RANGE, for instance).
+   The TYPE_CODE of the type returned is guaranteed to be
+   a TYPE_CODE_FIXED_POINT.  */
+extern struct type *fixed_point_type_base_type (struct type *type);
+
+/* Given TYPE, which is a fixed point type, return its scaling factor.  */
+extern const gdb_mpq &fixed_point_scaling_factor (struct type *type);
+
+/* Allocate a fixed-point type info for TYPE.  This should only be
+   called by INIT_FIXED_POINT_SPECIFIC.  */
+extern fixed_point_type_info *allocate_fixed_point_type_info
+  (struct type *type);
+
 /* * When the type includes explicit byte ordering, return that.
    Otherwise, the byte ordering from gdbarch_byte_order for 
    get_type_arch is returned.  */
diff --git a/gdb/testsuite/gdb.ada/fixed_cmp.exp b/gdb/testsuite/gdb.ada/fixed_cmp.exp
index 38e41c4..10e2c9a 100644
--- a/gdb/testsuite/gdb.ada/fixed_cmp.exp
+++ b/gdb/testsuite/gdb.ada/fixed_cmp.exp
@@ -19,25 +19,29 @@ if { [skip_ada_tests] } { return -1 }
 
 standard_ada_testfile fixed
 
-if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } {
-  return -1
-}
+foreach_with_prefix scenario {all} {
+    set flags [list debug additional_flags=-fgnat-encodings=$scenario]
+
+    if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != "" } {
+      return -1
+    }
 
-clean_restart ${testfile}
+    clean_restart ${testfile}
 
-set bp_location [gdb_get_line_number "STOP" ${testdir}/fixed.adb]
-runto "fixed.adb:$bp_location"
+    set bp_location [gdb_get_line_number "STOP" ${testdir}/fixed.adb]
+    runto "fixed.adb:$bp_location"
 
-gdb_test "print My_Var > 10.0" \
-         "= true"
+    gdb_test "print My_Var > 10.0" \
+             "= true"
 
-gdb_test "print My_Var > 20.0" \
-         "= false"
+    gdb_test "print My_Var > 20.0" \
+             "= false"
 
-# Do the same, but with integer values.
+    # Do the same, but with integer values.
 
-gdb_test "print My_Var > 10" \
-         "= true"
+    gdb_test "print My_Var > 10" \
+             "= true"
 
-gdb_test "print My_Var > 20" \
-         "= false"
+    gdb_test "print My_Var > 20" \
+             "= false"
+}
diff --git a/gdb/testsuite/gdb.ada/fixed_points.exp b/gdb/testsuite/gdb.ada/fixed_points.exp
index f991f56..655ee95 100644
--- a/gdb/testsuite/gdb.ada/fixed_points.exp
+++ b/gdb/testsuite/gdb.ada/fixed_points.exp
@@ -49,3 +49,14 @@ gdb_test "print Overprecise_Object" \
 
 gdb_test "ptype Overprecise_Object" \
          "= delta 0.135791"
+
+# FP*_Var...
+
+gdb_test "print fp1_var" \
+         " = 0.25"
+
+gdb_test "print fp2_var" \
+         " = -0.01"
+
+gdb_test "print fp3_var" \
+         " = 0.1"
diff --git a/gdb/testsuite/gdb.ada/fixed_points/fixed_points.adb b/gdb/testsuite/gdb.ada/fixed_points/fixed_points.adb
index a2720e3..f0a34ba 100644
--- a/gdb/testsuite/gdb.ada/fixed_points/fixed_points.adb
+++ b/gdb/testsuite/gdb.ada/fixed_points/fixed_points.adb
@@ -14,6 +14,7 @@
 --  along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 with System;
+with Pck; use Pck;
 
 procedure Fixed_Points is
 
@@ -59,4 +60,7 @@ begin
    Subtype_Object := 1.0/16.0;
    New_Type_Object := 1.0/16.0;
    Overprecise_Object := Overprecise_Fixed_Point'Small * 2;
+   Do_Nothing (FP1_Var'Address);
+   Do_Nothing (FP2_Var'Address);
+   Do_Nothing (FP3_Var'Address);
 end Fixed_Points;
diff --git a/gdb/testsuite/gdb.ada/fixed_points/pck.adb b/gdb/testsuite/gdb.ada/fixed_points/pck.adb
new file mode 100644
index 0000000..16f0384
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/fixed_points/pck.adb
@@ -0,0 +1,22 @@
+--  Copyright 2016-2020 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/>.
+
+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/fixed_points/pck.ads b/gdb/testsuite/gdb.ada/fixed_points/pck.ads
new file mode 100644
index 0000000..4d900dc
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/fixed_points/pck.ads
@@ -0,0 +1,30 @@
+--  Copyright 2016-2020 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
+   type FP1_Type is delta 0.1 range -1.0 .. +1.0;
+   FP1_Var : FP1_Type := 0.25;
+
+   type FP2_Type is delta 0.01 digits 14;
+   FP2_Var : FP2_Type := -0.01;
+
+   type FP3_Type is delta 0.1 range 0.0 .. 1.0 with Small => 0.1/3.0;
+   FP3_Var : FP3_Type := 0.1;
+
+   procedure Do_Nothing (A : System.Address);
+end pck;
+
diff --git a/gdb/testsuite/gdb.dwarf2/dw2-fixed-point.c b/gdb/testsuite/gdb.dwarf2/dw2-fixed-point.c
new file mode 100644
index 0000000..d9c811c
--- /dev/null
+++ b/gdb/testsuite/gdb.dwarf2/dw2-fixed-point.c
@@ -0,0 +1,49 @@
+/* Copyright 2016-2020 Free Software Foundation, Inc.
+
+   This file is part of GDB.
+
+   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/>.  */
+
+#include <stdint.h>
+
+/* Simulate an Ada variable declared inside package Pck as follow:
+      type FP1_Type is delta 0.1 range -1.0 .. +1.0;
+      FP1_Var : FP1_Type := 0.25;  */
+int8_t pck__fp1_var = 4;
+
+/* Simulate an Ada variable declared inside package Pck as follow:
+      type FP2_Type is delta 0.01 digits 14;
+      FP2_Var : FP2_Type := -0.01;  */
+int32_t pck__fp2_var = -1;
+
+/* Simulate an Ada variable declared inside package Pck as follow:
+      type FP3_Type is delta 0.1 range 0.0 .. 1.0 with Small => 0.1/3.0;
+      FP3_Var : FP3_Type := 0.1;  */
+int8_t pck__fp3_var = 3;
+
+/* Simulate an Ada variable declared inside package Pck as follow:
+      type FP1_Type is delta 0.1 range -1.0 .. +1.0;
+      FP1_Var : FP1_Type := 1.0;  */
+int8_t pck__fp1_range_var = 16;
+
+int
+main (void)
+{
+  pck__fp1_var++;
+  pck__fp2_var++;
+  pck__fp3_var++;
+  pck__fp1_range_var++;
+
+  return 0;
+}
diff --git a/gdb/testsuite/gdb.dwarf2/dw2-fixed-point.exp b/gdb/testsuite/gdb.dwarf2/dw2-fixed-point.exp
new file mode 100644
index 0000000..bf88ffe
--- /dev/null
+++ b/gdb/testsuite/gdb.dwarf2/dw2-fixed-point.exp
@@ -0,0 +1,132 @@
+# Copyright 2016-2020 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 dwarf.exp
+
+# This test can only be run on targets which support DWARF-2 and use gas.
+if {![dwarf2_support]} {
+    return 0
+}
+
+standard_testfile dw2-fixed-point.c dw2-fixed-point-dw.S
+
+# Make some DWARF for the test.
+set asm_file [standard_output_file $srcfile2]
+Dwarf::assemble $asm_file {
+    cu {} {
+ 	DW_TAG_compile_unit {
+                {DW_AT_language @DW_LANG_Ada95}
+                {DW_AT_name     pck.ads}
+                {DW_AT_comp_dir /tmp}
+        } {
+            declare_labels fp1_base_type fp2_base_type fp3_small \
+                fp3_base_type fp1_range_type
+
+            fp1_base_type: DW_TAG_base_type {
+                {DW_AT_byte_size     1 DW_FORM_sdata}
+                {DW_AT_encoding      @DW_ATE_signed_fixed}
+                {DW_AT_name          pck__fp1_type}
+                {DW_AT_binary_scale  -4 DW_FORM_sdata}
+            }
+
+            DW_TAG_variable {
+                {DW_AT_name pck__fp1_var}
+                {DW_AT_type :$fp1_base_type}
+                {DW_AT_location {
+                    DW_OP_addr [gdb_target_symbol pck__fp1_var]
+                } SPECIAL_expr}
+                {external 1 flag}
+            }
+
+            fp2_base_type: DW_TAG_base_type {
+                {DW_AT_byte_size     1 DW_FORM_sdata}
+                {DW_AT_encoding      @DW_ATE_signed_fixed}
+                {DW_AT_name          pck__fp2_type}
+                {DW_AT_decimal_scale -2 DW_FORM_sdata}
+            }
+
+            DW_TAG_variable {
+                {DW_AT_name pck__fp2_var}
+                {DW_AT_type :$fp2_base_type}
+                {DW_AT_location {
+                    DW_OP_addr [gdb_target_symbol pck__fp2_var]
+                } SPECIAL_expr}
+                {external 1 flag}
+            }
+
+            fp3_small: DW_TAG_constant {
+                {DW_AT_GNU_numerator   1 DW_FORM_data1}
+                {DW_AT_GNU_denominator 30 DW_FORM_sdata}
+            }
+
+            fp3_base_type: DW_TAG_base_type {
+                {DW_AT_byte_size     1 DW_FORM_sdata}
+                {DW_AT_encoding      @DW_ATE_signed_fixed}
+                {DW_AT_name          pck__fp3_type}
+                {DW_AT_small         :$fp3_small}
+            }
+
+            DW_TAG_variable {
+                {DW_AT_name pck__fp3_var}
+                {DW_AT_type :$fp3_base_type}
+                {DW_AT_location {
+                    DW_OP_addr [gdb_target_symbol pck__fp3_var]
+                } SPECIAL_expr}
+                {external 1 flag}
+            }
+
+            fp1_range_type: DW_TAG_subrange_type {
+                 {DW_AT_lower_bound 0xf0 DW_FORM_data1}
+                 {DW_AT_upper_bound 0x10 DW_FORM_data1}
+                 {DW_AT_name foo__fp1_range_type}
+                 {DW_AT_type :$fp1_base_type}
+             }
+
+             DW_TAG_variable {
+                 {DW_AT_name pck__fp1_range_var}
+                 {DW_AT_type :$fp1_range_type}
+                 {DW_AT_location {
+                     DW_OP_addr [gdb_target_symbol pck__fp1_range_var]
+                 } SPECIAL_expr}
+                 {external 1 flag}
+             }
+	}
+    }
+}
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} \
+	  [list $srcfile $asm_file] {nodebug}] } {
+    return -1
+}
+
+if ![runto_main] {
+    return -1
+}
+
+# Do the testing in Ada mode, since this is the language for which
+# this feature has been implemented, and where we know the language
+# has the concept of fixed-point types.
+gdb_test_no_output "set lang ada"
+
+gdb_test "print pck.fp1_var" \
+         " = 0.25"
+
+gdb_test "print pck.fp2_var" \
+         " = -0.01"
+
+gdb_test "print pck.fp3_var" \
+         " = 0.1"
+
+gdb_test "print pck.fp1_range_var" \
+         " = 1"
diff --git a/gdb/valprint.c b/gdb/valprint.c
index 2d9d1fb..38ae0bd 100644
--- a/gdb/valprint.c
+++ b/gdb/valprint.c
@@ -794,6 +794,31 @@ generic_val_print_float (struct type *type, struct ui_file *stream,
   print_floating (valaddr, type, stream);
 }
 
+/* generic_val_print helper for TYPE_CODE_FIXED_POINT.  */
+
+static void
+generic_val_print_fixed_point (struct value *val, struct ui_file *stream,
+			       const struct value_print_options *options)
+{
+  if (options->format)
+    value_print_scalar_formatted (val, options, 0, stream);
+  else
+    {
+      struct type *type = value_type (val);
+
+      const gdb_byte *valaddr = value_contents_for_printing (val);
+      gdb_mpf f;
+
+      f.read_fixed_point (valaddr, TYPE_LENGTH (type),
+			  type_byte_order (type), type->is_unsigned (),
+			  fixed_point_scaling_factor (type));
+
+      const char *fmt = TYPE_LENGTH (type) < 4 ? "%.11Fg" : "%.17Fg";
+      gdb::unique_xmalloc_ptr<char> str = gmp_string_asprintf (fmt, f.val);
+      fprintf_filtered (stream, "%s", str.get ());
+    }
+}
+
 /* generic_value_print helper for TYPE_CODE_COMPLEX.  */
 
 static void
@@ -844,6 +869,10 @@ generic_value_print (struct value *val, struct ui_file *stream, int recurse,
   struct type *type = value_type (val);
 
   type = check_typedef (type);
+
+  if (is_fixed_point_type (type))
+    type = fixed_point_type_base_type (type);
+
   switch (type->code ())
     {
     case TYPE_CODE_ARRAY:
@@ -909,6 +938,10 @@ generic_value_print (struct value *val, struct ui_file *stream, int recurse,
 	generic_val_print_float (type, stream, val, options);
       break;
 
+    case TYPE_CODE_FIXED_POINT:
+      generic_val_print_fixed_point (val, stream, options);
+      break;
+
     case TYPE_CODE_VOID:
       fputs_filtered (decorations->void_name, stream);
       break;
diff --git a/gdb/value.c b/gdb/value.c
index 7db3d3e..3b207cd 100644
--- a/gdb/value.c
+++ b/gdb/value.c
@@ -2758,6 +2758,9 @@ value_as_address (struct value *val)
 LONGEST
 unpack_long (struct type *type, const gdb_byte *valaddr)
 {
+  if (is_fixed_point_type (type))
+    type = fixed_point_type_base_type (type);
+
   enum bfd_endian byte_order = type_byte_order (type);
   enum type_code code = type->code ();
   int len = TYPE_LENGTH (type);
@@ -2806,6 +2809,17 @@ unpack_long (struct type *type, const gdb_byte *valaddr)
     case TYPE_CODE_DECFLOAT:
       return target_float_to_longest (valaddr, type);
 
+    case TYPE_CODE_FIXED_POINT:
+      {
+	gdb_mpq vq;
+	vq.read_fixed_point (valaddr, len, byte_order, nosign,
+			     fixed_point_scaling_factor (type));
+
+	gdb_mpz vz;
+	mpz_tdiv_q (vz.val, mpq_numref (vq.val), mpq_denref (vq.val));
+	return vz.as_integer<LONGEST> ();
+      }
+
     case TYPE_CODE_PTR:
     case TYPE_CODE_REF:
     case TYPE_CODE_RVALUE_REF:
-- 
2.1.4



More information about the Gdb-patches mailing list