From: Tom Tromey Date: Tue, 7 Apr 2026 17:38:48 +0000 (-0600) Subject: Handle nested Ada functions with gnat-llvm X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=26d17a9b24dfd4a3894bc19ac752466ea10e80b2;p=thirdparty%2Fbinutils-gdb.git Handle nested Ada functions with gnat-llvm 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). Reviewed-By: Tom de Vries --- diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index 19d8e4ee13b..35ebd924021 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -13954,6 +13954,11 @@ public: 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. */ @@ -13964,6 +13969,84 @@ protected: } }; +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 4137e1d5edd..cefdde5ed1e 100644 --- a/gdb/frame.c +++ b/gdb/frame.c @@ -3226,7 +3226,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 31213577052..3e3be66a676 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 . + +# 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 . + +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;