[flang-commits] [flang] [flang] Retain internal and BIND(C) host procedure link in FIR (PR #87796)

[via flang-commits]

https://github.com/jeanPerier created https://github.com/llvm/llvm-project/pull/87796

Currently, it is not possible to find back which fun.func is the host procedure of some internal procedure because the mangling of the internal procedure does not contain info about the BIND(C) name of the host.
This info may be useful to ensure dwarf DW_TAG_subprogram of internal procedures are nested under DW_TAG_subprogram  of host procedures for instance.

>From 7fc7b0d49e6dcdf0f91d41eded2339ea9b99ecec Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Fri, 5 Apr 2024 08:35:00 -0700
Subject: [PATCH] [flang] Retain internal and BIND(C) host procedure link in
 FIR

Currently, it is not possible to find back which fun.func is the
host procedure of some internal procedure because the mangling
of the internal procedure does not contain info about the BIND(C)
name of the host.
This info may be useful to ensure dwarf DW_TAG_subprogram of internal
procedures are nested under DW_TAG_subprogram  of host procedures for
instance.
---
 .../flang/Optimizer/Dialect/FIROpsSupport.h       |  7 +++++++
 flang/lib/Lower/CallInterface.cpp                 | 15 +++++++++++++++
 .../HLFIR/internal-procedures-bindc-host.f90      | 13 +++++++++++++
 3 files changed, 35 insertions(+)
 create mode 100644 flang/test/Lower/HLFIR/internal-procedures-bindc-host.f90

diff --git a/flang/include/flang/Optimizer/Dialect/FIROpsSupport.h b/flang/include/flang/Optimizer/Dialect/FIROpsSupport.h
index 3266ea3aa7fdc6..c5dd21199676c3 100644
--- a/flang/include/flang/Optimizer/Dialect/FIROpsSupport.h
+++ b/flang/include/flang/Optimizer/Dialect/FIROpsSupport.h
@@ -109,6 +109,13 @@ static constexpr llvm::StringRef getInternalProcedureAttrName() {
   return "fir.internal_proc";
 }
 
+/// Attribute to link an internal procedure to its host procedure symbol when
+/// the internal procedure mangled name does not allow retrieving the host
+/// func.func because the host is BIND(C).
+static constexpr llvm::StringRef getHostSymbolAttrName() {
+  return "fir.host_symbol";
+}
+
 /// Attribute containing the original name of a function from before the
 /// ExternalNameConverision pass runs
 static constexpr llvm::StringRef getInternalFuncNameAttrName() {
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index 29cdb3cff589ba..d3135ba34ee4b2 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -589,6 +589,21 @@ void Fortran::lower::CalleeInterface::setFuncAttrs(
 static void addSymbolAttribute(mlir::func::FuncOp func,
                                const Fortran::semantics::Symbol &sym,
                                mlir::MLIRContext &mlirContext) {
+  // The link between an internal procedure and its host procedure is lost
+  // in FIR if the host is BIND(C) since the internal mangling will not
+  // allow retrieving the host bind(C) name, and therefore func.func symbol.
+  // Preserve it as an attribute so that this can be later retrieved.
+  if (sym.owner().kind() == Fortran::semantics::Scope::Kind::Subprogram)
+    if (const Fortran::semantics::Symbol *hostProcedure = sym.owner().symbol())
+      if (Fortran::semantics::IsBindCProcedure(*hostProcedure)) {
+        std::string hostName = Fortran::lower::mangle::mangleName(
+            *hostProcedure, /*keepExternalInScope=*/true);
+        func->setAttr(
+            fir::getHostSymbolAttrName(),
+            mlir::SymbolRefAttr::get(
+                &mlirContext, mlir::StringAttr::get(&mlirContext, hostName)));
+      }
+
   // Only add this on bind(C) functions for which the symbol is not reflected in
   // the current context.
   if (!Fortran::semantics::IsBindCProcedure(sym))
diff --git a/flang/test/Lower/HLFIR/internal-procedures-bindc-host.f90 b/flang/test/Lower/HLFIR/internal-procedures-bindc-host.f90
new file mode 100644
index 00000000000000..cb7470ce92dc03
--- /dev/null
+++ b/flang/test/Lower/HLFIR/internal-procedures-bindc-host.f90
@@ -0,0 +1,13 @@
+! Test fir.host_sym attribute to retain link between internal
+! and host procedure in FIR even when BIND(C) is involved.
+
+! RUN: bbc -emit-hlfir -o - %s | FileCheck %s
+
+subroutine foo() bind(c, name="some_c_name")
+  call bar()
+contains
+ subroutine bar()
+ end subroutine
+end subroutine
+! CHECK: func.func @some_c_name()
+! CHECK: func.func private @_QFfooPbar() attributes {fir.host_symbol = @some_c_name, llvm.linkage = #llvm.linkage<internal>}