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. */
}
};
+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;
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;
/* 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)
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.
--- /dev/null
+# 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}]
--- /dev/null
+-- 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;
projects / thirdparty / binutils-gdb.git / commitdiff
