Re: [PATCH 2/3] Implement real literal extension for Ada

[Luis Machado <luis.machado@arm.com>]

Hi Tom,

On 3/1/22 17:00, Tom Tromey via Gdb-patches wrote:
> Sometimes it is convenient to be able to specify the exact bits of a
> floating-point literal.  For example, you may want to set a
> floating-point register to a denormalized value, or to a particular
> NaN.
> 
> In C, you can do this by combining the "{}" cast with an array
> literal, like:
> 
>      (gdb) p {double}{0x576488BDD2AE9FFE}
>      $1 = 9.8765449999999996e+112
> 
> This patch adds a somewhat similar idea to Ada.  It extends the lexer
> to allow "l" and "f" suffixes in a based literal.  The "f" indicates a
> floating-point literal, and the "l"s control the size of the
> floating-point type.
> 
> Note that this differs from Ada's based real literals.  I believe
> those can also be used to control the bits of a floating-point value,
> but they are a bit more cumbersome to use (simplest is binary but
> that's also very lengthy).  Also, these aren't implemented in GDB.
> 
> I chose not to allow this extension to work with based integer
> literals with exponents.  That didn't seem very useful.
> ---
>   gdb/NEWS                                  |  8 ++
>   gdb/ada-lex.l                             | 98 ++++++++++++++++++-----
>   gdb/doc/gdb.texinfo                       | 16 ++++
>   gdb/testsuite/gdb.ada/float-bits.exp      | 50 ++++++++++++
>   gdb/testsuite/gdb.ada/float-bits/prog.adb | 22 +++++
>   5 files changed, 174 insertions(+), 20 deletions(-)
>   create mode 100644 gdb/testsuite/gdb.ada/float-bits.exp
>   create mode 100644 gdb/testsuite/gdb.ada/float-bits/prog.adb
> 
> diff --git a/gdb/NEWS b/gdb/NEWS
> index dc2cac1871b..2876ca822ad 100644
> --- a/gdb/NEWS
> +++ b/gdb/NEWS
> @@ -136,6 +136,14 @@ info win
>     This command now includes information about the width of the tui
>     windows in its output.
>   
> +* GDB's Ada parser now supports an extension for specifying the exact
> +  byte contents of a floating-point literal.  This can be useful for
> +  setting floating-point registers to a precise value without loss of
> +  precision.  The syntax is an extension of the based literal syntax.
> +  Use, e.g., "16lf#0123abcd#" -- the number of "l"s controls the width
> +  of the floating-point type, and the "f" is the marker for floating
> +  point.
> +
>   * New targets
>   
>   GNU/Linux/LoongArch    loongarch*-*-linux*
> diff --git a/gdb/ada-lex.l b/gdb/ada-lex.l
> index aab53b397ec..8e64d3a2926 100644
> --- a/gdb/ada-lex.l
> +++ b/gdb/ada-lex.l
> @@ -122,7 +122,11 @@ static int paren_depth;
>   				      e_ptr + 1);
>   		 }
>   
> -{NUM10}"#"{HEXDIG}({HEXDIG}|_)*"#" {
> +	/* The "llf" is a gdb extension to allow a floating-point
> +	   constant to be written in some other base.  The
> +	   floating-point number is formed by reinterpreting the
> +	   bytes, allowing direct control over the bits.  */
> +{NUM10}(l{0,2}f)?"#"{HEXDIG}({HEXDIG}|_)*"#" {
>   		   canonicalizeNumeral (numbuf, yytext);
>   		   return processInt (pstate, numbuf, strchr (numbuf, '#') + 1,
>   				      NULL);
> @@ -347,18 +351,36 @@ static int
>   processInt (struct parser_state *par_state, const char *base0,
>   	    const char *num0, const char *exp0)
>   {
> -  ULONGEST result;
>     long exp;
>     int base;
> -  const char *trailer;
> +  /* For the based literal with an "f" prefix, we'll return a
> +     floating-point number.  This counts the the number of "l"s seen,
> +     to decide the width of the floating-point number to return.  -1
> +     means no "f".  */
> +  int floating_point_l_count = -1;
>   
>     if (base0 == NULL)
>       base = 10;
>     else
>       {
> -      base = strtol (base0, (char **) NULL, 10);
> +      char *end_of_base;
> +      base = strtol (base0, &end_of_base, 10);
>         if (base < 2 || base > 16)
>   	error (_("Invalid base: %d."), base);
> +      while (*end_of_base == 'l')
> +	{
> +	  ++floating_point_l_count;
> +	  ++end_of_base;
> +	}
> +      /* This assertion is ensured by the pattern.  */
> +      gdb_assert (floating_point_l_count == -1 || *end_of_base == 'f');
> +      if (*end_of_base == 'f')
> +	{
> +	  ++end_of_base;
> +	  ++floating_point_l_count;
> +	}
> +      /* This assertion is ensured by the pattern.  */
> +      gdb_assert (*end_of_base == '#');
>       }
>   
>     if (exp0 == NULL)
> @@ -366,26 +388,62 @@ processInt (struct parser_state *par_state, const char *base0,
>     else
>       exp = strtol(exp0, (char **) NULL, 10);
>   
> -  errno = 0;
> -  result = strtoulst (num0, &trailer, base);
> -  if (errno == ERANGE)
> -    error (_("Integer literal out of range"));
> -  if (isxdigit(*trailer))
> -    error (_("Invalid digit `%c' in based literal"), *trailer);
> +  gdb_mpz result;
> +  while (isxdigit (*num0))
> +    {
> +      int dig = fromhex (*num0);
> +      if (dig >= base)
> +	error (_("Invalid digit `%c' in based literal"), *num0);
> +      mpz_mul_ui (result.val, result.val, base);
> +      mpz_add_ui (result.val, result.val, dig);
> +      ++num0;
> +    }
>   
>     while (exp > 0)
>       {
> -      if (result > (ULONG_MAX / base))
> -	error (_("Integer literal out of range"));
> -      result *= base;
> +      mpz_mul_ui (result.val, result.val, base);
>         exp -= 1;
>       }
>   
> -  if ((result >> (gdbarch_int_bit (par_state->gdbarch ())-1)) == 0)
> +  if (floating_point_l_count > -1)
> +    {
> +      struct type *fp_type;
> +      if (floating_point_l_count == 0)
> +	fp_type = language_lookup_primitive_type (par_state->language (),
> +						  par_state->gdbarch (),
> +						  "float");
> +      else if (floating_point_l_count == 1)
> +	fp_type = language_lookup_primitive_type (par_state->language (),
> +						  par_state->gdbarch (),
> +						  "long_float");
> +      else
> +	{
> +	  /* This assertion is ensured by the pattern.  */
> +	  gdb_assert (floating_point_l_count == 2);
> +	  fp_type = language_lookup_primitive_type (par_state->language (),
> +						    par_state->gdbarch (),
> +						    "long_long_float");
> +	}
> +
> +      yylval.typed_val_float.type = fp_type;
> +      result.write (gdb::make_array_view (yylval.typed_val_float.val,
> +					  TYPE_LENGTH (fp_type)),
> +		    type_byte_order (fp_type),
> +		    true);
> +
> +      return FLOAT;
> +    }
> +
> +  gdb_mpz maxval (ULONGEST_MAX / base);
> +  if (mpz_cmp (result.val, maxval.val) > 0)
> +    error (_("Integer literal out of range"));
> +
> +  LONGEST value = result.as_integer<LONGEST> ();
> +  if ((value >> (gdbarch_int_bit (par_state->gdbarch ())-1)) == 0)
>       yylval.typed_val.type = type_int (par_state);
> -  else if ((result >> (gdbarch_long_bit (par_state->gdbarch ())-1)) == 0)
> +  else if ((value >> (gdbarch_long_bit (par_state->gdbarch ())-1)) == 0)
>       yylval.typed_val.type = type_long (par_state);
> -  else if (((result >> (gdbarch_long_bit (par_state->gdbarch ())-1)) >> 1) == 0)
> +  else if (((value >> (gdbarch_long_bit (par_state->gdbarch ())-1)) >> 1) == 0)
>       {
>         /* We have a number representable as an unsigned integer quantity.
>            For consistency with the C treatment, we will treat it as an
> @@ -396,18 +454,18 @@ processInt (struct parser_state *par_state, const char *base0,
>          */
>         yylval.typed_val.type
>   	= builtin_type (par_state->gdbarch ())->builtin_unsigned_long;
> -      if (result & LONGEST_SIGN)
> +      if (value & LONGEST_SIGN)
>   	yylval.typed_val.val =
> -	  (LONGEST) (result & ~LONGEST_SIGN)
> +	  (LONGEST) (value & ~LONGEST_SIGN)
>   	  - (LONGEST_SIGN>>1) - (LONGEST_SIGN>>1);
>         else
> -	yylval.typed_val.val = (LONGEST) result;
> +	yylval.typed_val.val = (LONGEST) value;
>         return INT;
>       }
>     else
>       yylval.typed_val.type = type_long_long (par_state);
>   
> -  yylval.typed_val.val = (LONGEST) result;
> +  yylval.typed_val.val = value;
>     return INT;
>   }
>   
> diff --git a/gdb/doc/gdb.texinfo b/gdb/doc/gdb.texinfo
> index f7f5f7a6158..9d5f9b5aa94 100644
> --- a/gdb/doc/gdb.texinfo
> +++ b/gdb/doc/gdb.texinfo
> @@ -18189,6 +18189,9 @@ context.
>   Should your program
>   redefine these names in a package or procedure (at best a dubious practice),
>   you will have to use fully qualified names to access their new definitions.
> +
> +@item
> +Based real literals are not implemented.
>   @end itemize
>   
>   @node Additions to Ada
> @@ -18247,6 +18250,19 @@ complex conditional breaks:
>   (@value{GDBP}) condition 1 (report(i); k += 1; A(k) > 100)
>   @end smallexample
>   
> +@item
> +An extension to based literals can be used to specify the exact bits
> +of a real value.  After the base, you can use from zero to two
> +@samp{l} characters, followed by an @samp{f}.  The number of @samp{l}
> +characters controls the width of the resulting real constant: zero
> +means @code{Float} is used, one means @code{Long_Float}, and two means
> +@code{Long_Long_Float}.
> +
> +@smallexample
> +(@value{GDBP}) print 16f#41b80000#
> +$1 = 23.0
> +@end smallexample
> +
>   @item
>   Rather than use catenation and symbolic character names to introduce special
>   characters into strings, one may instead use a special bracket notation,
> diff --git a/gdb/testsuite/gdb.ada/float-bits.exp b/gdb/testsuite/gdb.ada/float-bits.exp
> new file mode 100644
> index 00000000000..61db5f325ad
> --- /dev/null
> +++ b/gdb/testsuite/gdb.ada/float-bits.exp
> @@ -0,0 +1,50 @@
> +# 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 floating-point literal extension.
> +
> +load_lib "ada.exp"
> +
> +if { [skip_ada_tests] } { return -1 }
> +
> +standard_ada_testfile prog
> +
> +if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} {
> +    return -1
> +}
> +
> +clean_restart ${testfile}
> +
> +set bp_location [gdb_get_line_number "BREAK" ${testdir}/prog.adb]
> +runto "prog.adb:$bp_location"
> +
> +gdb_test "print 16f#41b80000#" " = 23.0"
> +gdb_test "print val_float" " = 23.0"
> +gdb_test "print val_float := 16f#41b80000#" " = 23.0"
> +gdb_test "print val_float" " = 23.0" \
> +    "print val_float after assignment"
> +
> +gdb_test "print 16lf#bc0d83c94fb6d2ac#" " = -2.0e-19"
> +gdb_test "print val_double" " = -2.0e-19"
> +gdb_test "print val_double := 16lf#bc0d83c94fb6d2ac#" " = -2.0e-19"
> +gdb_test "print val_double" " = -2.0e-19" \
> +    "print val_double after assignment"
> +
> +gdb_test "print 16llf#7FFFF7FF4054A56FA5B99019A5C8#" " = 5.0e\\+25"
> +gdb_test "print val_long_double" " = 5.0e\\+25"
> +gdb_test "print val_long_double := 16llf#7FFFF7FF4054A56FA5B99019A5C8#" \
> +    " = 5.0e\\+25"
> +gdb_test "print val_long_double" " = 5.0e\\+25" \
> +    "print val_long_double after assignment"
> diff --git a/gdb/testsuite/gdb.ada/float-bits/prog.adb b/gdb/testsuite/gdb.ada/float-bits/prog.adb
> new file mode 100644
> index 00000000000..0d8c18f8d47
> --- /dev/null
> +++ b/gdb/testsuite/gdb.ada/float-bits/prog.adb
> @@ -0,0 +1,22 @@
> +--  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/>.
> +
> +procedure Prog is
> +   Val_Float : Float := 23.0;
> +   Val_Double : Long_Float := -2.0e-19;
> +   Val_Long_Double : Long_Long_Float := 5.0e+25;
> +begin
> +   null; -- BREAK
> +end Prog;


I think the floating point representations may differ between 
architectures/bit-sizes.

I noticed 5 failures in this test for aarch64-linux and arm-linux.

FAIL: gdb.ada/float-bits.exp: print 16llf#7FFFF7FF4054A56FA5B99019A5C8#
FAIL: gdb.ada/float-bits.exp: print val_long_double
FAIL: gdb.ada/float-bits.exp: print val_long_double := 
16llf#7FFFF7FF4054A56FA5B99019A5C8#
FAIL: gdb.ada/float-bits.exp: print val_long_double after assignment
FAIL: gdb.ada/float-bits.exp: print

Some of the expected values don't really match. If the output is 
supposed to differ, maybe we should compare hex values instead?

Also, for 32-bit targets, I'm seeing size-related issues.

Here's one example for aarch64:

(expected)

(gdb) print 16llf#7FFFF7FF4054A56FA5B99019A5C8#^M
$9 = 5.0e+25

(actual)

(gdb) print 16llf#7FFFF7FF4054A56FA5B99019A5C8#
$9 = 1.68104996779424899119072698287782049e-4932

And for arm 32-bit;

(expected)

(gdb) print 16llf#7FFFF7FF4054A56FA5B99019A5C8#^M
$9 = 5.0e+25

(actual)

(gdb) print 16llf#7FFFF7FF4054A56FA5B99019A5C8#
Cannot export value 2596145952482202326224873165792712 as 64-bits 
unsigned integer (must be between 0 and 18446744073709551615)

Regards,
Luis