Re: [PATCH] Handle nested Ada functions with gnat-llvm

[Tom de Vries <tdevries@suse.de>]

On 4/23/26 9:10 PM, Tom Tromey wrote:
> In Ada, a nested function can refer to variables in lexically
> enclosing outer scopes.  Ordinarily this is implemented in DWARF using
> DW_AT_static_link, so that the correct outer function invocation can
> be found from the nested function.
> 
> However, LLVM does not implement the DWARF DW_AT_static_link feature,
> so this approach isn't possible.
> 
> gnat-llvm, though, implements "unnesting" manually, passing an
> activation record parameter to nested functions.  This activation
> record can be used to find the correct outer frame.
> 
> This patch adds a new language method to enable this.  A new test case
> is included; this test will fail if the static link or some similar
> feature is not implemented (i.e., a naive unwind looking for the next
> instance of the outer function will fail).

This looks fine to me.

Reviewed-By: Tom de Vries <tdevries@suse.de>

Thanks,
- Tom

> ---
>   gdb/ada-lang.c                                | 83 +++++++++++++++++++
>   gdb/frame.c                                   |  6 +-
>   gdb/language.c                                |  8 ++
>   gdb/language.h                                | 12 +++
>   gdb/testsuite/gdb.ada/nested-confounding.exp  | 35 ++++++++
>   .../gdb.ada/nested-confounding/nested.adb     | 52 ++++++++++++
>   6 files changed, 195 insertions(+), 1 deletion(-)
>   create mode 100644 gdb/testsuite/gdb.ada/nested-confounding.exp
>   create mode 100644 gdb/testsuite/gdb.ada/nested-confounding/nested.adb
> 
> diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
> index 71a338ce17e..2f2c0227322 100644
> --- a/gdb/ada-lang.c
> +++ b/gdb/ada-lang.c
> @@ -14038,6 +14038,11 @@ class ada_language : public language_defn
>     const struct lang_varobj_ops *varobj_ops () const override
>     { return &ada_varobj_ops; }
>   
> +  /* See language.h.  */
> +
> +  frame_info_ptr follow_static_link (const frame_info_ptr &frame) const
> +    override;
> +
>   protected:
>     /* See language.h.  */
>   
> @@ -14048,6 +14053,84 @@ class ada_language : public language_defn
>     }
>   };
>   
> +frame_info_ptr
> +ada_language::follow_static_link (const frame_info_ptr &frame) const
> +{
> +  const block *frame_block = get_frame_block (frame, nullptr);
> +  if (frame_block == nullptr)
> +    return {};
> +  frame_block = frame_block->function_block ();
> +
> +  /* LLVM doesn't implement DW_AT_static_link, but for Ada we can
> +     search for the pointer to the activation record.  Then, we can go
> +     up the stack and find the frame where this activation record is
> +     defined.  Note that we don't use the activation record directly,
> +     because that is type-erased and just holds pointers.  */
> +  symbol *arec = nullptr;
> +  for (symbol *iter : block_iterator_range (frame_block))
> +    {
> +      /* The activation record argument is an artificial argument
> +	 whose name starts with "AREC".  */
> +      if (iter->is_argument () && iter->is_artificial ()
> +	  && startswith (iter->linkage_name (), "AREC"))
> +	{
> +	  arec = iter;
> +	  break;
> +	}
> +    }
> +
> +  if (arec == nullptr)
> +    return {};
> +
> +  /* We aren't interested in ordinary (non-quit) exceptions that might
> +     occur here -- we just want to return an empty frame if something
> +     goes wrong.  */
> +  try
> +    {
> +      value *val = read_var_value (arec, frame_block, frame);
> +      CORE_ADDR arec_address = value_as_address (val);
> +
> +      for (frame_info_ptr frame_iter = get_prev_frame (frame);
> +	   frame_iter != nullptr;
> +	   frame_iter = get_prev_frame (frame_iter))
> +	{
> +	  /* Stacks can be quite deep: give the user a chance to stop
> +	     this.  */
> +	  QUIT;
> +
> +	  frame_block = get_frame_block (frame_iter, nullptr);
> +	  if (frame_block == nullptr)
> +	    continue;
> +	  frame_block = frame_block->function_block ();
> +
> +	  for (symbol *iter : block_iterator_range (frame_block))
> +	    {
> +	      /* The activation record itself is an artificial
> +		 non-argument of record type, whose name starts with
> +		 "AREC", and that has the same address as the argument
> +		 passed down to the callee.  */
> +	      if (!iter->is_argument () && iter->is_artificial ()
> +		  && startswith (iter->linkage_name (), "AREC")
> +		  && iter->type ()->code () == TYPE_CODE_STRUCT)
> +		{
> +		  value *outer = read_var_value (iter, frame_block,
> +						 frame_iter);
> +		  CORE_ADDR outer_address = outer->address ();
> +		  if (outer_address == arec_address)
> +		    return frame_iter;
> +		}
> +	    }
> +	}
> +    }
> +  catch (const gdb_exception_error &ex)
> +    {
> +      /* Ignore.  */
> +    }
> +
> +  return {};
> +}
> +
> +
>   /* Single instance of the Ada language class.  */
>   
>   static ada_language ada_language_defn;
> diff --git a/gdb/frame.c b/gdb/frame.c
> index 7a83f5e61c0..06f604a8683 100644
> --- a/gdb/frame.c
> +++ b/gdb/frame.c
> @@ -3245,7 +3245,11 @@ frame_follow_static_link (const frame_info_ptr &initial_frame)
>   
>     const struct dynamic_prop *static_link = frame_block->static_link ();
>     if (static_link == nullptr)
> -    return {};
> +    {
> +      const language_defn *lang
> +	= language_def (get_frame_language (initial_frame));
> +      return lang->follow_static_link (initial_frame);
> +    }
>   
>     CORE_ADDR upper_frame_base;
>   
> diff --git a/gdb/language.c b/gdb/language.c
> index 439ef293622..4e1dc5682f0 100644
> --- a/gdb/language.c
> +++ b/gdb/language.c
> @@ -917,6 +917,14 @@ language_defn::value_string (struct gdbarch *gdbarch,
>   
>   /* See language.h.  */
>   
> +frame_info_ptr
> +language_defn::follow_static_link (const frame_info_ptr &frame) const
> +{
> +  return {};
> +}
> +
> +/* See language.h.  */
> +
>   struct type *
>   language_bool_type (const struct language_defn *la,
>   		    struct gdbarch *gdbarch)
> diff --git a/gdb/language.h b/gdb/language.h
> index b43dae66107..75154d9c591 100644
> --- a/gdb/language.h
> +++ b/gdb/language.h
> @@ -638,6 +638,18 @@ struct language_defn
>   
>     virtual const struct lang_varobj_ops *varobj_ops () const;
>   
> +  /* Normally a "static link" (a reference to an outer frame) is
> +     represented by DW_AT_static_link in DWARF.  However, some
> +     compilers do not emit this -- but do provide some
> +     language-specific way to find the correct outer frame.  If the
> +     ordinary search for a static link fails for a given frame, then
> +     this method will be called for that frame's language.  It should
> +     either return the correct outer instance, if one exists, or a
> +     null frame if no such frame exists.  */
> +
> +  virtual frame_info_ptr follow_static_link (const frame_info_ptr &frame)
> +    const;
> +
>   protected:
>   
>     /* This is the overridable part of the GET_SYMBOL_NAME_MATCHER method.
> diff --git a/gdb/testsuite/gdb.ada/nested-confounding.exp b/gdb/testsuite/gdb.ada/nested-confounding.exp
> new file mode 100644
> index 00000000000..79cf10b3d58
> --- /dev/null
> +++ b/gdb/testsuite/gdb.ada/nested-confounding.exp
> @@ -0,0 +1,35 @@
> +# Copyright 2026 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/>.
> +
> +# A test case for a nested function that requires a static link.
> +
> +load_lib "ada.exp"
> +
> +require allow_ada_tests
> +
> +standard_ada_testfile nested
> +
> +if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} {
> +    return
> +}
> +
> +clean_restart ${testfile}
> +set bp_location [gdb_get_line_number "BREAK" "${testdir}/nested.adb"]
> +runto "nested.adb:$bp_location"
> +
> +# In the innermost call, the passed id and the reference to the outer
> +# id are different.
> +gdb_test "print id" [quotemeta {$@DECIMAL = 28}]
> +gdb_test "print outer_id" [quotemeta {$@DECIMAL = 23}]
> diff --git a/gdb/testsuite/gdb.ada/nested-confounding/nested.adb b/gdb/testsuite/gdb.ada/nested-confounding/nested.adb
> new file mode 100644
> index 00000000000..44f7c7866fe
> --- /dev/null
> +++ b/gdb/testsuite/gdb.ada/nested-confounding/nested.adb
> @@ -0,0 +1,52 @@
> +--  Copyright 2026 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 Nested is
> +   type Proc_Access is access procedure (Id: Integer);
> +
> +   procedure Parent (My_Id : Integer; Call : access procedure (Id: Integer));
> +
> +   procedure Do_Nothing (Id : Boolean);
> +
> +   procedure Do_Nothing (Id : Boolean) is
> +   begin
> +      null;
> +   end Do_Nothing;
> +
> +   procedure Parent (My_Id : Integer; Call : access procedure (Id: Integer)) is
> +      procedure Inner (Id : Integer);
> +
> +      Outer_Id : Integer := My_Id;
> +
> +      procedure Inner (Id : Integer) is
> +      begin
> +         Do_Nothing (Id = Outer_Id); -- BREAK
> +      end Inner;
> +
> +   begin
> +
> +      --  This setup ensures that when Inner is reached, the most
> +      --  recent invocation of Parent will not be the correct one for
> +      --  the purposes of finding "Outer_Id".
> +      if Call = null then
> +         Parent (My_Id + 5, Inner'Access);
> +      else
> +         Call (Outer_Id);
> +      end if;
> +   end Parent;
> +
> +begin
> +   Parent (23, null);
> +end Nested;
> 
> base-commit: f797b25fdc7ca4a48c09802082426b71e56898aa