[PATCH 0/2] Add some agent expression support for Ada

[PATCH 0/2] Add some agent expression support for Ada

[Tom Tromey]

I recently found out that adding a bit of agent expression support for
Ada would improve the performance of some remote testing that is done
internally at AdaCore.  This series fixes the simplest things: support
for scalar variables, and support for range types.

Tested on x86-64 Fedora 36.

Tom

[PATCH 1/2] Implement some agent expressions for Ada

[Tom Tromey]

Ada historically has not implemented agent expressions, and some Ada
constructs probably cannot reasonably be converted to agent
expressions.  However, a subset of simple operations can be, and this
patch represents a first step in that direction.

On one internal AdaCore test case, this improves the performance of a
conditional breakpoint from 5 minutes to 5 seconds.

The main tricky part in this patch is ensuring the converted
expressions detect the cases that will not work.  This is done by
examining the code in the corresponding evaluation methods.
---
 gdb/ada-exp.h                         | 26 +++++++++-
 gdb/ada-lang.c                        | 69 ++++++++++++++++++++++++---
 gdb/testsuite/gdb.ada/ax-ada.exp      | 31 ++++++++++++
 gdb/testsuite/gdb.ada/ax-ada/prog.adb | 20 ++++++++
 4 files changed, 138 insertions(+), 8 deletions(-)
 create mode 100644 gdb/testsuite/gdb.ada/ax-ada.exp
 create mode 100644 gdb/testsuite/gdb.ada/ax-ada/prog.adb

diff --git a/gdb/ada-exp.h b/gdb/ada-exp.h
index 36ac3aaddb7..409cac4668f 100644
--- a/gdb/ada-exp.h
+++ b/gdb/ada-exp.h
@@ -130,6 +130,14 @@ class ada_wrapped_operation
 
   enum exp_opcode opcode () const override
   { return std::get<0> (m_storage)->opcode (); }
+
+protected:
+
+  void do_generate_ax (struct expression *exp,
+		       struct agent_expr *ax,
+		       struct axs_value *value,
+		       struct type *cast_type)
+    override;
 };
 
 /* An Ada string constant.  */
@@ -255,6 +263,18 @@ class ada_binop_equal_operation
 			    arg1, arg2);
   }
 
+  void do_generate_ax (struct expression *exp,
+		       struct agent_expr *ax,
+		       struct axs_value *value,
+		       struct type *cast_type)
+    override
+  {
+    gen_expr_binop (exp, opcode (),
+		    std::get<1> (this->m_storage).get (),
+		    std::get<2> (this->m_storage).get (),
+		    ax, value);
+  }
+
   enum exp_opcode opcode () const override
   { return std::get<0> (m_storage); }
 };
@@ -380,7 +400,11 @@ class ada_var_value_operation
 
 protected:
 
-  using operation::do_generate_ax;
+  void do_generate_ax (struct expression *exp,
+		       struct agent_expr *ax,
+		       struct axs_value *value,
+		       struct type *cast_type)
+    override;
 };
 
 /* Variant of var_msym_value_operation for Ada.  */
diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 40f85914a56..ce5faef40a4 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -60,6 +60,7 @@
 #include <algorithm>
 #include "ada-exp.h"
 #include "charset.h"
+#include "ax-gdb.h"
 
 /* Define whether or not the C operator '/' truncates towards zero for
    differently signed operands (truncation direction is undefined in C).
@@ -9207,6 +9208,23 @@ ada_enum_name (const char *name)
     }
 }
 
+/* If TYPE is a dynamic type, return the base type.  Otherwise, if
+   there is no parallel type, return nullptr.  */
+
+static struct type *
+find_base_type (struct type *type)
+{
+  struct type *raw_real_type
+    = ada_check_typedef (ada_get_base_type (type));
+
+  /* No parallel XVS or XVE type.  */
+  if (type == raw_real_type
+      && ada_find_parallel_type (type, "___XVE") == nullptr)
+    return nullptr;
+
+  return raw_real_type;
+}
+
 /* If VAL is wrapped in an aligner or subtype wrapper, return the
    value it wraps.  */
 
@@ -9227,13 +9245,8 @@ unwrap_value (struct value *val)
     }
   else
     {
-      struct type *raw_real_type =
-	ada_check_typedef (ada_get_base_type (type));
-
-      /* If there is no parallel XVS or XVE type, then the value is
-	 already unwrapped.  Return it without further modification.  */
-      if ((type == raw_real_type)
-	  && ada_find_parallel_type (type, "___XVE") == NULL)
+      struct type *raw_real_type = find_base_type (type);
+      if (raw_real_type == nullptr)
 	return val;
 
       return
@@ -10659,6 +10672,21 @@ ada_wrapped_operation::evaluate (struct type *expect_type,
   return result;
 }
 
+void
+ada_wrapped_operation::do_generate_ax (struct expression *exp,
+				       struct agent_expr *ax,
+				       struct axs_value *value,
+				       struct type *cast_type)
+{
+  std::get<0> (m_storage)->generate_ax (exp, ax, value, cast_type);
+
+  struct type *type = value->type;
+  if (ada_is_aligner_type (type))
+    error (_("Aligner types cannot be handled in agent expressions"));
+  else if (find_base_type (type) != nullptr)
+    error (_("Dynamic types cannot be handled in agent expressions"));
+}
+
 value *
 ada_string_operation::evaluate (struct type *expect_type,
 				struct expression *exp,
@@ -11009,6 +11037,33 @@ ada_var_value_operation::resolve (struct expression *exp,
   return false;
 }
 
+void
+ada_var_value_operation::do_generate_ax (struct expression *exp,
+					 struct agent_expr *ax,
+					 struct axs_value *value,
+					 struct type *cast_type)
+{
+  symbol *sym = std::get<0> (m_storage).symbol;
+
+  if (sym->domain () == UNDEF_DOMAIN)
+    error (_("Unexpected unresolved symbol, %s, during evaluation"),
+	   sym->print_name ());
+
+  struct type *type = static_unwrap_type (sym->type ());
+  if (ada_is_tagged_type (type, 0)
+      || (type->code () == TYPE_CODE_REF
+	  && ada_is_tagged_type (type->target_type (), 0)))
+    error (_("Tagged types cannot be handled in agent expressions"));
+
+  if ((type->code () == TYPE_CODE_STRUCT
+       && dynamic_template_type (type) != NULL)
+      || (type->code () == TYPE_CODE_UNION
+	  && ada_find_parallel_type (type, "___XVU") != NULL))
+    error (_("Dynamic types cannot be handled in agent expressions"));
+
+  var_value_operation::do_generate_ax (exp, ax, value, cast_type);
+}
+
 value *
 ada_atr_val_operation::evaluate (struct type *expect_type,
 				 struct expression *exp,
diff --git a/gdb/testsuite/gdb.ada/ax-ada.exp b/gdb/testsuite/gdb.ada/ax-ada.exp
new file mode 100644
index 00000000000..b08f7c4362c
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/ax-ada.exp
@@ -0,0 +1,31 @@
+# Copyright 2019-2023 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"
+
+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 "START" ${testdir}/prog.adb]
+runto "prog.adb:$bp_location"
+
+gdb_test "maint agent-eval variable = 23" ".*end"
diff --git a/gdb/testsuite/gdb.ada/ax-ada/prog.adb b/gdb/testsuite/gdb.ada/ax-ada/prog.adb
new file mode 100644
index 00000000000..3852711e88c
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/ax-ada/prog.adb
@@ -0,0 +1,20 @@
+--  Copyright 2023 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
+   Variable : Integer := 23;
+begin
+   null; -- START
+end Prog;
-- 
2.38.1

[PATCH 2/2] Handle range types in ax-gdb.c

[Tom Tromey]

A range type can usually be treated the same as its underlying integer
type, at least for the purposes of agent expressions.  This patch
arranges for range types to be handled this way in ax-gdb.c, letting a
somewhat larger subset of Ada expressions be compiled.
---
 gdb/ax-gdb.c                          | 60 +++++++++++++++++----------
 gdb/testsuite/gdb.ada/ax-ada.exp      |  1 +
 gdb/testsuite/gdb.ada/ax-ada/prog.adb |  3 ++
 3 files changed, 42 insertions(+), 22 deletions(-)

diff --git a/gdb/ax-gdb.c b/gdb/ax-gdb.c
index fc214e7dfe1..dc2c25410fe 100644
--- a/gdb/ax-gdb.c
+++ b/gdb/ax-gdb.c
@@ -353,6 +353,16 @@ gen_extend (struct agent_expr *ax, struct type *type)
   ((type->is_unsigned () ? ax_zero_ext : ax_ext) (ax, bits));
 }
 
+/* A helper that returns the target type if TYPE is a range type, or
+   otherwise just returns TYPE.  */
+
+static struct type *
+strip_range_type (struct type *type)
+{
+  if (type->code () == TYPE_CODE_RANGE)
+    return type->target_type ();
+  return type;
+}
 
 /* Assume that the top of the stack contains a value of type "pointer
    to TYPE"; generate code to fetch its value.  Note that TYPE is the
@@ -366,8 +376,7 @@ gen_fetch (struct agent_expr *ax, struct type *type)
       ax_trace_quick (ax, type->length ());
     }
 
-  if (type->code () == TYPE_CODE_RANGE)
-    type = type->target_type ();
+  type = strip_range_type (type);
 
   switch (type->code ())
     {
@@ -832,9 +841,12 @@ static void
 gen_usual_arithmetic (struct agent_expr *ax, struct axs_value *value1,
 		      struct axs_value *value2)
 {
+  struct type *type1 = strip_range_type (value1->type);
+  struct type *type2 = strip_range_type (value2->type);
+
   /* Do the usual binary conversions.  */
-  if (value1->type->code () == TYPE_CODE_INT
-      && value2->type->code () == TYPE_CODE_INT)
+  if (type1->code () == TYPE_CODE_INT
+      && type2->code () == TYPE_CODE_INT)
     {
       /* The ANSI integral promotions seem to work this way: Order the
 	 integer types by size, and then by signedness: an n-bit
@@ -842,18 +854,18 @@ gen_usual_arithmetic (struct agent_expr *ax, struct axs_value *value1,
 	 type.  Promote to the "wider" of the two types, and always
 	 promote at least to int.  */
       struct type *target = max_type (builtin_type (ax->gdbarch)->builtin_int,
-				      max_type (value1->type, value2->type));
+				      max_type (type1, type2));
 
       /* Deal with value2, on the top of the stack.  */
-      gen_conversion (ax, value2->type, target);
+      gen_conversion (ax, type2, target);
 
       /* Deal with value1, not on the top of the stack.  Don't
 	 generate the `swap' instructions if we're not actually going
 	 to do anything.  */
-      if (is_nontrivial_conversion (value1->type, target))
+      if (is_nontrivial_conversion (type1, target))
 	{
 	  ax_simple (ax, aop_swap);
-	  gen_conversion (ax, value1->type, target);
+	  gen_conversion (ax, type1, target);
 	  ax_simple (ax, aop_swap);
 	}
 
@@ -892,6 +904,7 @@ gen_cast (struct agent_expr *ax, struct axs_value *value, struct type *type)
   require_rvalue (ax, value);
   /* Dereference typedefs.  */
   type = check_typedef (type);
+  type = strip_range_type (type);
 
   switch (type->code ())
     {
@@ -960,7 +973,7 @@ gen_ptradd (struct agent_expr *ax, struct axs_value *value,
 	    struct axs_value *value1, struct axs_value *value2)
 {
   gdb_assert (value1->type->is_pointer_or_reference ());
-  gdb_assert (value2->type->code () == TYPE_CODE_INT);
+  gdb_assert (strip_range_type (value2->type)->code () == TYPE_CODE_INT);
 
   gen_scale (ax, aop_mul, value1->type);
   ax_simple (ax, aop_add);
@@ -976,7 +989,7 @@ gen_ptrsub (struct agent_expr *ax, struct axs_value *value,
 	    struct axs_value *value1, struct axs_value *value2)
 {
   gdb_assert (value1->type->is_pointer_or_reference ());
-  gdb_assert (value2->type->code () == TYPE_CODE_INT);
+  gdb_assert (strip_range_type (value2->type)->code () == TYPE_CODE_INT);
 
   gen_scale (ax, aop_mul, value1->type);
   ax_simple (ax, aop_sub);
@@ -1048,14 +1061,15 @@ gen_binop (struct agent_expr *ax, struct axs_value *value,
 	   int may_carry, const char *name)
 {
   /* We only handle INT op INT.  */
-  if ((value1->type->code () != TYPE_CODE_INT)
-      || (value2->type->code () != TYPE_CODE_INT))
+  struct type *type1 = strip_range_type (value1->type);
+  if ((type1->code () != TYPE_CODE_INT)
+      || (strip_range_type (value2->type)->code () != TYPE_CODE_INT))
     error (_("Invalid combination of types in %s."), name);
 
-  ax_simple (ax, value1->type->is_unsigned () ? op_unsigned : op);
+  ax_simple (ax, type1->is_unsigned () ? op_unsigned : op);
   if (may_carry)
-    gen_extend (ax, value1->type);	/* catch overflow */
-  value->type = value1->type;
+    gen_extend (ax, type1);	/* catch overflow */
+  value->type = type1;
   value->kind = axs_rvalue;
 }
 
@@ -1064,8 +1078,9 @@ static void
 gen_logical_not (struct agent_expr *ax, struct axs_value *value,
 		 struct type *result_type)
 {
-  if (value->type->code () != TYPE_CODE_INT
-      && value->type->code () != TYPE_CODE_PTR)
+  struct type *type = strip_range_type (value->type);
+  if (type->code () != TYPE_CODE_INT
+      && type->code () != TYPE_CODE_PTR)
     error (_("Invalid type of operand to `!'."));
 
   ax_simple (ax, aop_log_not);
@@ -1076,11 +1091,12 @@ gen_logical_not (struct agent_expr *ax, struct axs_value *value,
 static void
 gen_complement (struct agent_expr *ax, struct axs_value *value)
 {
-  if (value->type->code () != TYPE_CODE_INT)
+  struct type *type = strip_range_type (value->type);
+  if (type->code () != TYPE_CODE_INT)
     error (_("Invalid type of operand to `~'."));
 
   ax_simple (ax, aop_bit_not);
-  gen_extend (ax, value->type);
+  gen_extend (ax, type);
 }
 \f
 
@@ -2078,7 +2094,7 @@ gen_expr_binop_rest (struct expression *exp,
   switch (op)
     {
     case BINOP_ADD:
-      if (value1->type->code () == TYPE_CODE_INT
+      if (strip_range_type (value1->type)->code () == TYPE_CODE_INT
 	  && value2->type->is_pointer_or_reference ())
 	{
 	  /* Swap the values and proceed normally.  */
@@ -2086,7 +2102,7 @@ gen_expr_binop_rest (struct expression *exp,
 	  gen_ptradd (ax, value, value2, value1);
 	}
       else if (value1->type->is_pointer_or_reference ()
-	       && value2->type->code () == TYPE_CODE_INT)
+	       && strip_range_type (value2->type)->code () == TYPE_CODE_INT)
 	gen_ptradd (ax, value, value1, value2);
       else
 	gen_binop (ax, value, value1, value2,
@@ -2094,7 +2110,7 @@ gen_expr_binop_rest (struct expression *exp,
       break;
     case BINOP_SUB:
       if (value1->type->is_pointer_or_reference ()
-	  && value2->type->code () == TYPE_CODE_INT)
+	  && strip_range_type (value2->type)->code () == TYPE_CODE_INT)
 	gen_ptrsub (ax,value, value1, value2);
       else if (value1->type->is_pointer_or_reference ()
 	       && value2->type->is_pointer_or_reference ())
diff --git a/gdb/testsuite/gdb.ada/ax-ada.exp b/gdb/testsuite/gdb.ada/ax-ada.exp
index b08f7c4362c..d0464b7a5b8 100644
--- a/gdb/testsuite/gdb.ada/ax-ada.exp
+++ b/gdb/testsuite/gdb.ada/ax-ada.exp
@@ -29,3 +29,4 @@ set bp_location [gdb_get_line_number "START" ${testdir}/prog.adb]
 runto "prog.adb:$bp_location"
 
 gdb_test "maint agent-eval variable = 23" ".*end"
+gdb_test "maint agent-eval range_variable = 23" ".*end"
diff --git a/gdb/testsuite/gdb.ada/ax-ada/prog.adb b/gdb/testsuite/gdb.ada/ax-ada/prog.adb
index 3852711e88c..85148d0c9c5 100644
--- a/gdb/testsuite/gdb.ada/ax-ada/prog.adb
+++ b/gdb/testsuite/gdb.ada/ax-ada/prog.adb
@@ -14,7 +14,10 @@
 --  along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 procedure Prog is
+   type Range_Type is range -15 .. 73;
+
    Variable : Integer := 23;
+   Range_Variable : Range_Type := 23;
 begin
    null; -- START
 end Prog;
-- 
2.38.1

Re: [PATCH 1/2] Implement some agent expressions for Ada

[Simon Marchi]

> @@ -10659,6 +10672,21 @@ ada_wrapped_operation::evaluate (struct type *expect_type,
>    return result;
>  }
>  
> +void
> +ada_wrapped_operation::do_generate_ax (struct expression *exp,
> +				       struct agent_expr *ax,
> +				       struct axs_value *value,
> +				       struct type *cast_type)
> +{
> +  std::get<0> (m_storage)->generate_ax (exp, ax, value, cast_type);
> +
> +  struct type *type = value->type;
> +  if (ada_is_aligner_type (type))
> +    error (_("Aligner types cannot be handled in agent expressions"));
> +  else if (find_base_type (type) != nullptr)
> +    error (_("Dynamic types cannot be handled in agent expressions"));
Is it on purpose that you do these checks after calling generate_ax?

I don't really understand the Ada bits, so I can't really comment more
than that.

Simon

Re: [PATCH 2/2] Handle range types in ax-gdb.c

[Simon Marchi]

On 1/4/23 11:44, Tom Tromey via Gdb-patches wrote:
> A range type can usually be treated the same as its underlying integer
> type, at least for the purposes of agent expressions.  This patch
> arranges for range types to be handled this way in ax-gdb.c, letting a
> somewhat larger subset of Ada expressions be compiled.

Instead of stripping the range type at many places (possibly forgetting
some), I wonder if this could be done systematically before, when we
build the axs_values.

Simon

Re: [PATCH 1/2] Implement some agent expressions for Ada

[Tom Tromey]

>> +  std::get<0> (m_storage)->generate_ax (exp, ax, value, cast_type);
>> +
>> +  struct type *type = value->type;
>> +  if (ada_is_aligner_type (type))
>> +    error (_("Aligner types cannot be handled in agent expressions"));
>> +  else if (find_base_type (type) != nullptr)
>> +    error (_("Dynamic types cannot be handled in agent expressions"));

Simon> Is it on purpose that you do these checks after calling generate_ax?

It's intentional, because it is the type of the wrapped value that is
being checked.

Tom

Re: [PATCH 2/2] Handle range types in ax-gdb.c

[Tom Tromey]

>>>>> "Simon" == Simon Marchi <simark@simark.ca> writes:

Simon> On 1/4/23 11:44, Tom Tromey via Gdb-patches wrote:
>> A range type can usually be treated the same as its underlying integer
>> type, at least for the purposes of agent expressions.  This patch
>> arranges for range types to be handled this way in ax-gdb.c, letting a
>> somewhat larger subset of Ada expressions be compiled.

Simon> Instead of stripping the range type at many places (possibly forgetting
Simon> some), I wonder if this could be done systematically before, when we
Simon> build the axs_values.

I didn't really consider this option, but now when looking at it, it
seems there are many more places that assign to 'type'.

Tom

Re: [PATCH 0/2] Add some agent expression support for Ada

[Tom Tromey]

>>>>> "Tom" == Tom Tromey via Gdb-patches <gdb-patches@sourceware.org> writes:

Tom> I recently found out that adding a bit of agent expression support for
Tom> Ada would improve the performance of some remote testing that is done
Tom> internally at AdaCore.  This series fixes the simplest things: support
Tom> for scalar variables, and support for range types.

Tom> Tested on x86-64 Fedora 36.

I'm going to check these in now.

Tom