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

Tom Tromey via Gdb-patches
2022-03-01T17:02:46Z

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;
--
2.31.1