From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from simark.ca by simark.ca with LMTP id IfyHOP5u6mlRNzcAWB0awg (envelope-from ) for ; Thu, 23 Apr 2026 15:11:58 -0400 Authentication-Results: simark.ca; dkim=pass (2048-bit key; secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=h7BDGQjO; dkim-atps=neutral Received: by simark.ca (Postfix, from userid 112) id E44531E093; Thu, 23 Apr 2026 15:11:58 -0400 (EDT) X-Spam-Checker-Version: SpamAssassin 4.0.1 (2024-03-25) on simark.ca X-Spam-Level: X-Spam-Status: No, score=-2.4 required=5.0 tests=ARC_SIGNED,ARC_VALID,BAYES_00, DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,MAILING_LIST_MULTI, RCVD_IN_DNSWL_MED,RCVD_IN_VALIDITY_CERTIFIED_BLOCKED, RCVD_IN_VALIDITY_RPBL_BLOCKED,RCVD_IN_VALIDITY_SAFE_BLOCKED autolearn=ham autolearn_force=no version=4.0.1 Received: from vm01.sourceware.org (vm01.sourceware.org [38.145.34.32]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange x25519 server-signature ECDSA (prime256v1) server-digest SHA256) (No client certificate requested) by simark.ca (Postfix) with ESMTPS id DA8E11E093 for ; Thu, 23 Apr 2026 15:11:57 -0400 (EDT) Received: from vm01.sourceware.org (localhost [127.0.0.1]) by sourceware.org (Postfix) with ESMTP id 7A2C04BA2E12 for ; Thu, 23 Apr 2026 19:11:57 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 7A2C04BA2E12 Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=h7BDGQjO Received: from mail-oo1-xc29.google.com (mail-oo1-xc29.google.com [IPv6:2607:f8b0:4864:20::c29]) by sourceware.org (Postfix) with ESMTPS id 1249D4BAE7D8 for ; Thu, 23 Apr 2026 19:10:45 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 1249D4BAE7D8 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 1249D4BAE7D8 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2607:f8b0:4864:20::c29 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1776971445; cv=none; b=kwtEJWI6kX4yHF0XlXLQ/1V/J8V3sbc5+1bMiCIt34t1KlleS6IZ0JzMJ8PuAXzatsVa1fJivzuhsWVB+Ru/Unx55uIxjWp/pHRURDI+I14W3FOxBJxFkyZzVuHGNLQVdoXF3ISHV4p4il2wTlAktkHXBxnm+JRl85z2T0BR6Wo= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1776971445; c=relaxed/simple; bh=LuE6dJN6RLR6ErI5vi4/oD7J/N3X30AsjiPjn9fqo+I=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=AiqsleZUNO/0tNVtPpoMqSfV7lOFABYa9RA8PUWNG05NJxHeTWlIyCRDGviMPG9M7Vgflm14AgABLAiKRae5CSYhtBNMBQgwN3CtTc8bLzD82U0U4Hb6AanEKgdfFH5gWkBkQCXA7Wd8pKk5GnBlCi2TifvNUuz7DS9c6w0ZYz8= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 1249D4BAE7D8 Received: by mail-oo1-xc29.google.com with SMTP id 006d021491bc7-67c250805ccso2628092eaf.1 for ; Thu, 23 Apr 2026 12:10:45 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1776971444; x=1777576244; darn=sourceware.org; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:from:to:cc:subject:date:message-id:reply-to; bh=KJCc5CUPly7+owBv+4ByCbfrQxGkLdKpXFR7ErcSF20=; b=h7BDGQjOYtABHcCwJm5JJ17wGmERqBqswJqn8Iz/+kElxD43Q/hhmBPK72RbujhWBZ MJzSSOawgptYeZavSHTk3BpVfCQ1o0KjNMZ6vbziTvy90SpGxwtWhp9zH89157G/PgFY KiuSmlg3/+itz0d8ypI2bvvCe7veCgfS8dEwXkJ8yb4l+pdt3UAAXXOkIc/YkHvG97le vXBSXJlnKMKf8Lbo7lB7EB9xtQtnZ2bQHZO3NI7reh17Ncb8D1JCFa3qT7avauikVNIr MWPA+FnzHABT2e82hVYjK1owdDpsCQp0yQbq/cgC9MnNr3Sl9EaF1xLFvgE9MNEdQXVn 5qOQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20251104; t=1776971444; x=1777576244; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:x-gm-gg:x-gm-message-state:from:to:cc:subject:date :message-id:reply-to; bh=KJCc5CUPly7+owBv+4ByCbfrQxGkLdKpXFR7ErcSF20=; b=Ep59K+By1G5ujdOwgnwN98+bS7DiyFriUhTGX42TWPG/eaDTM6gM5qHiHpoWSOVIL7 V6Cyo7NQoJsUDw9ys+37Yki17dlEk4ErUTyWaq5nCCdCqovEAx1xl/svV+xZLHvKVfdZ RhFwUylp+TvzFhNRWmZbBllOMjcq9GsMkdwdy1TTAWCciVGQWg4XVQbGkf/z1+JPeBBC u2y4YjdA4AFl0MsM9TrROafUd+GonP+jX05VbYVBbCLdz1G2oBe+/it1WzgYKh3yXfvJ qed6A0eSl5ZF003KyUXUvxpozeXTN4/C1tPvxRAoTB7Hy0AL9H1quPiyshgYJR8WHAZR 0sBQ== X-Gm-Message-State: AOJu0Yy2kuTTlasPZ/vrn5LT6YLinMAKxNwbk25A4gQMmczhPKx93kOI HPwyS0diHm24s151w6T9vgMoeAs+SORVFdUHAUgZizUggfKV3Jp85XT96k8XzsLyg5aPA1qjtM2 Z0k8= X-Gm-Gg: AeBDiesgg9XCl8essPo2TL/NqVbEsj5B8W1MFtpCXvjCN3el6v4An7HbrG+i235rp3c iyMHwwRVHBf+aGrsodjbIEd7CIcdXB0okuloSAOiYIT1k3TlmtGosQY+yDaeKjrcDDgCFlaDGBu z+V1fgrnu/dodP16ivbxbwVNkfORWWuWSyxMaMG5DmpxVJtMjnWaCODlfssLFr5VnEAjPS9AlMc 6y2j25AME0bxsiIrHARLyu5EpULgYHO6w9rvN3pXMefzWx2yKlqinGY6JdQmmhVkU8ZVJcqGbJM jHw52hZlSzv7SrYpgxhh5Q26tg9/XaPK5vZB1lhA4vYdFrdVOpOw3GeYMyxVmZrmU1/cU6G5KUL OKUZfdtSblboQp6TYh3rKFGqxcwNyfHBQLfMEAHH/DagA9QC1ouANtM6OZ7eXkVcL9EbbuFoJ5a UrjA8Irl1Spps47gc0NNiBmG++LUNDDiM8aX8xMRxP3CLd630245bbIg== X-Received: by 2002:a05:6820:2002:b0:694:9175:9d47 with SMTP id 006d021491bc7-6949175acafmr9084632eaf.18.1776971443984; Thu, 23 Apr 2026 12:10:43 -0700 (PDT) Received: from bapiya (75-166-225-82.hlrn.qwest.net. [75.166.225.82]) by smtp.gmail.com with ESMTPSA id 586e51a60fabf-42fb269f69bsm7774588fac.12.2026.04.23.12.10.43 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 23 Apr 2026 12:10:43 -0700 (PDT) From: Tom Tromey To: gdb-patches@sourceware.org Cc: Tom Tromey Subject: [PATCH] Handle nested Ada functions with gnat-llvm Date: Thu, 23 Apr 2026 13:10:41 -0600 Message-ID: <20260423191041.2665677-1-tromey@adacore.com> X-Mailer: git-send-email 2.53.0 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-BeenThere: gdb-patches@sourceware.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gdb-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gdb-patches-bounces~public-inbox=simark.ca@sourceware.org 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). --- 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 . + +# 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; base-commit: f797b25fdc7ca4a48c09802082426b71e56898aa -- 2.53.0