[fir] Add external name interop pass

[clementval]

Summary

Add the external name conversion pass needed for compiler
interoperability. This pass convert the Flang internal symbol name to
the common gfortran convention.

Clean up old passes without implementation in the Passes.ts file so
the project and fir-opt can build correctly.

This patch is part of the upstreaming effort from fir-dev branch.

[mehdi_amini]

flang/include/flang/Optimizer/Transforms/Passes.td

27

Can you clarify why are these all needed?

I would think that no dependent dialect is needed at all here.
(do you have a failing test if you remove them?)

40

This method still exists in the header.
(same for the others)

[clementval]

flang/include/flang/Optimizer/Transforms/Passes.td

27

I guess this was a mistake on our side and we were thinking we needed to add "allowed" dialects here but it indeed not needed and I'll update the patch to remove these extra dependencies.

40

Right I forgot to clean the header as well.

[clementval]

Cleanup header and remove useless dialects dependencies.

flang/include/flang/Optimizer/Support/InternalNames.h

struct NameUniquer {
   /// Entry point for the PROGRAM (called by the runtime)
   /// Can be overridden with the `--main-entry-name=<name>` option.
   static llvm::StringRef doProgramEntry();
 
   /// Decompose `uniquedName` into the parse name, symbol type, and scope info
   static std::pair<NameKind, DeconstructedName>
   deconstruct(llvm::StringRef uniquedName);
 
+  /// Check if the name is an external facing name.
+  static bool isExternalFacingUniquedName(
+      const std::pair<NameKind, DeconstructedName> &deconstructResult);
+
+  /// Check whether the name should be re-mangle with external ABI convention.
+  static bool needExternalNameMangling(llvm::StringRef uniquedName);
+
 private:
   static std::string intAsString(std::int64_t i);
   static std::string doKind(std::int64_t kind);
   static std::string doKinds(llvm::ArrayRef<std::int64_t> kinds);
   static std::string toLower(llvm::StringRef name);
 
   NameUniquer() = delete;
   NameUniquer(const NameUniquer &) = delete;
   NameUniquer(NameUniquer &&) = delete;
   NameUniquer &operator=(const NameUniquer &) = delete;
 };
 
 } // namespace fir
 
 #endif // FORTRAN_OPTIMIZER_SUPPORT_INTERNALNAMES_H

flang/include/flang/Optimizer/Transforms/Passes.h

 std::unique_ptr<mlir::Pass> createFirToCfgPass();
 
 /// A pass to convert the FIR dialect from "Mem-SSA" form to "Reg-SSA"
 /// form. This pass is a port of LLVM's mem2reg pass, but modified for the FIR
 /// dialect as well as the restructuring of MLIR's representation to present PHI
 /// nodes as block arguments.
 std::unique_ptr<mlir::Pass> createMemToRegPass();
 
+std::unique_ptr<mlir::Pass> createExternalNameConversionPass();
+
 /// Support for inlining on FIR.
 bool canLegallyInline(mlir::Operation *op, mlir::Region *reg,
                       mlir::BlockAndValueMapping &map);
 
 // declarative passes
 #define GEN_PASS_REGISTRATION
 #include "flang/Optimizer/Transforms/Passes.h.inc"
 
 } // namespace fir
 
 #endif // OPTIMIZER_TRANSFORMS_PASSES_H

flang/include/flang/Optimizer/Transforms/Passes.td

 //
 //===----------------------------------------------------------------------===//
 
 #ifndef FLANG_OPTIMIZER_TRANSFORMS_PASSES
 #define FLANG_OPTIMIZER_TRANSFORMS_PASSES
 
 include "mlir/Pass/PassBase.td"
 
-def AffineDialectPromotion : FunctionPass<"promote-to-affine"> {
-  let summary = "Promotes fir.do_loop and fir.where to affine.for and affine.if where possible";
+def ExternalNameConversion : Pass<"external-name-interop", "mlir::ModuleOp"> {
+  let summary = "Convert name for external interoperability";
   let description = [{
-    TODO
+    Demangle FIR internal name and mangle them for external interoperability.
   }];
-  let constructor = "fir::createPromoteToAffinePass()";
-}
-
-def BasicCSE : FunctionPass<"basic-cse"> {
-  let summary = "Basic common sub-expression elimination";
-  let description = [{
-      TODO
-  }];
-  let constructor = "fir::createCSEPass()";
-}
-
-def ControlFlowLowering : FunctionPass<"lower-control-flow"> {
-  let summary = "Convert affine dialect, fir.select_type to standard dialect";
-  let description = [{
-      TODO
-  }];
-  let constructor = "fir::createControlFlowLoweringPass()";
-}
-
-def CFGConversion : FunctionPass<"cfg-conversion"> {
-  let summary = "Convert FIR structured control flow ops to CFG ops.";
-  let description = [{
-      TODO
-  }];
-  let constructor = "fir::createFirToCfgPass()";
+  let constructor = "::fir::createExternalNameConversionPass()";
+  let dependentDialects = [
+    "fir::FIROpsDialect", "mlir::LLVM::LLVMDialect",
+    "mlir::acc::OpenACCDialect", "mlir::omp::OpenMPDialect"
+  ];
 }
 
 #endif // FLANG_OPTIMIZER_TRANSFORMS_PASSES

flang/lib/Optimizer/Support/InternalNames.cpp

for (std::size_t i = 2, end{uniq.size()}; i != end;) {
         assert(false && "unknown uniquing code");
         break;
       }
     }
     return {nk, DeconstructedName(modules, host, name, kinds)};
   }
   return {NameKind::NOT_UNIQUED, DeconstructedName(uniq)};
 }
+
+bool fir::NameUniquer::isExternalFacingUniquedName(
+    const std::pair<fir::NameUniquer::NameKind,
+                    fir::NameUniquer::DeconstructedName> &deconstructResult) {
+  return (deconstructResult.first == NameKind::PROCEDURE ||
+          deconstructResult.first == NameKind::COMMON) &&
+         deconstructResult.second.modules.empty() &&
+         !deconstructResult.second.host;
+}
+
+bool fir::NameUniquer::needExternalNameMangling(llvm::StringRef uniquedName) {
+  auto result = fir::NameUniquer::deconstruct(uniquedName);
+  return result.first != fir::NameUniquer::NameKind::NOT_UNIQUED &&
+         fir::NameUniquer::isExternalFacingUniquedName(result);
+}

flang/lib/Optimizer/Transforms/CMakeLists.txt

 add_flang_library(FIRTransforms
   Inliner.cpp
+  ExternalNameConversion.cpp
 
   DEPENDS
   FIRDialect
   FIRSupport
   FIROptTransformsPassIncGen
 
   LINK_LIBS
   FIRDialect
   MLIRAffineToStandard
   MLIRLLVMIR
   MLIROpenACC
   MLIROpenMP
   FIRSupport
 )

flang/lib/Optimizer/Transforms/ExternalNameConversion.cpp

+//===- ExternalNameConversion.cpp -- convert name with external convention ===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "PassDetail.h"
+#include "flang/Optimizer/Dialect/FIROps.h"
+#include "flang/Optimizer/Support/InternalNames.h"
+#include "flang/Optimizer/Transforms/Passes.h"
+#include "mlir/Dialect/LLVMIR/LLVMDialect.h"
+#include "mlir/Dialect/OpenACC/OpenACC.h"
+#include "mlir/Dialect/OpenMP/OpenMPDialect.h"
+#include "mlir/IR/SymbolTable.h"
+#include "mlir/Pass/Pass.h"
+#include "mlir/Transforms/DialectConversion.h"
+
+//===----------------------------------------------------------------------===//
+// Helper functions
+//===----------------------------------------------------------------------===//
+
+/// Mangle the name with gfortran convention.
+std::string
+mangleExternalName(const std::pair<fir::NameUniquer::NameKind,
+                                   fir::NameUniquer::DeconstructedName>
+                       result) {
+  if (result.first == fir::NameUniquer::NameKind::COMMON &&
+      result.second.name.empty())
+    return "__BLNK__";
+  return result.second.name + "_";
+}
+
+//===----------------------------------------------------------------------===//
+// Rewrite patterns
+//===----------------------------------------------------------------------===//
+
+namespace {
+
+class MangleNameOnCallOp : public mlir::OpRewritePattern<fir::CallOp> {
+public:
+  using OpRewritePattern::OpRewritePattern;
+
+  mlir::LogicalResult
+  matchAndRewrite(fir::CallOp op,
+                  mlir::PatternRewriter &rewriter) const override {
+    rewriter.startRootUpdate(op);
+    auto callee = op.callee();
+    if (callee.hasValue()) {
+      auto result = fir::NameUniquer::deconstruct(
+          callee.getValue().getRootReference().getValue());
+      if (fir::NameUniquer::isExternalFacingUniquedName(result))
+        op.calleeAttr(
+            SymbolRefAttr::get(op.getContext(), mangleExternalName(result)));
+    }
+    rewriter.finalizeRootUpdate(op);
+    return success();
+  }
+};
+
+struct MangleNameOnFuncOp : public mlir::OpRewritePattern<mlir::FuncOp> {
+public:
+  using OpRewritePattern::OpRewritePattern;
+
+  mlir::LogicalResult
+  matchAndRewrite(mlir::FuncOp op,
+                  mlir::PatternRewriter &rewriter) const override {
+    rewriter.startRootUpdate(op);
+    auto result = fir::NameUniquer::deconstruct(op.sym_name());
+    if (fir::NameUniquer::isExternalFacingUniquedName(result)) {
+      auto newName = mangleExternalName(result);
+      op.sym_nameAttr(rewriter.getStringAttr(newName));
+      SymbolTable::setSymbolName(op, newName);
+    }
+    rewriter.finalizeRootUpdate(op);
+    return success();
+  }
+};
+
+struct MangleNameForCommonBlock : public mlir::OpRewritePattern<fir::GlobalOp> {
+public:
+  using OpRewritePattern::OpRewritePattern;
+
+  mlir::LogicalResult
+  matchAndRewrite(fir::GlobalOp op,
+                  mlir::PatternRewriter &rewriter) const override {
+    rewriter.startRootUpdate(op);
+    auto result = fir::NameUniquer::deconstruct(
+        op.symref().getRootReference().getValue());
+    if (fir::NameUniquer::isExternalFacingUniquedName(result)) {
+      auto newName = mangleExternalName(result);
+      op.symrefAttr(mlir::SymbolRefAttr::get(op.getContext(), newName));
+      SymbolTable::setSymbolName(op, newName);
+    }
+    rewriter.finalizeRootUpdate(op);
+    return success();
+  }
+};
+
+struct MangleNameOnAddrOfOp : public mlir::OpRewritePattern<fir::AddrOfOp> {
+public:
+  using OpRewritePattern::OpRewritePattern;
+
+  mlir::LogicalResult
+  matchAndRewrite(fir::AddrOfOp op,
+                  mlir::PatternRewriter &rewriter) const override {
+    auto result = fir::NameUniquer::deconstruct(
+        op.symbol().getRootReference().getValue());
+    if (fir::NameUniquer::isExternalFacingUniquedName(result)) {
+      auto newName =
+          SymbolRefAttr::get(op.getContext(), mangleExternalName(result));
+      rewriter.replaceOpWithNewOp<fir::AddrOfOp>(op, op.resTy().getType(),
+                                                 newName);
+    }
+    return success();
+  }
+};
+
+struct MangleNameOnEmboxProcOp
+    : public mlir::OpRewritePattern<fir::EmboxProcOp> {
+public:
+  using OpRewritePattern::OpRewritePattern;
+
+  mlir::LogicalResult
+  matchAndRewrite(fir::EmboxProcOp op,
+                  mlir::PatternRewriter &rewriter) const override {
+    rewriter.startRootUpdate(op);
+    auto result = fir::NameUniquer::deconstruct(
+        op.funcname().getRootReference().getValue());
+    if (fir::NameUniquer::isExternalFacingUniquedName(result))
+      op.funcnameAttr(
+          SymbolRefAttr::get(op.getContext(), mangleExternalName(result)));
+    rewriter.finalizeRootUpdate(op);
+    return success();
+  }
+};
+
+class ExternalNameConversionPass
+    : public fir::ExternalNameConversionBase<ExternalNameConversionPass> {
+public:
+  mlir::ModuleOp getModule() { return getOperation(); }
+  void runOnOperation() override;
+};
+} // namespace
+
+void ExternalNameConversionPass::runOnOperation() {
+  auto op = getOperation();
+  auto *context = &getContext();
+
+  mlir::OwningRewritePatternList patterns(context);
+  patterns.insert<MangleNameOnCallOp, MangleNameOnCallOp, MangleNameOnFuncOp,
+                  MangleNameForCommonBlock, MangleNameOnAddrOfOp,
+                  MangleNameOnEmboxProcOp>(context);
+
+  ConversionTarget target(*context);
+  target.addLegalDialect<fir::FIROpsDialect, LLVM::LLVMDialect,
+                         acc::OpenACCDialect, omp::OpenMPDialect>();
+
+  target.addDynamicallyLegalOp<fir::CallOp>([](fir::CallOp op) {
+    if (op.callee().hasValue())
+      return !fir::NameUniquer::needExternalNameMangling(
+          op.callee().getValue().getRootReference().getValue());
+    return true;
+  });
+
+  target.addDynamicallyLegalOp<mlir::FuncOp>([](mlir::FuncOp op) {
+    return !fir::NameUniquer::needExternalNameMangling(op.sym_name());
+  });
+
+  target.addDynamicallyLegalOp<fir::GlobalOp>([](fir::GlobalOp op) {
+    return !fir::NameUniquer::needExternalNameMangling(
+        op.symref().getRootReference().getValue());
+  });
+
+  target.addDynamicallyLegalOp<fir::AddrOfOp>([](fir::AddrOfOp op) {
+    return !fir::NameUniquer::needExternalNameMangling(
+        op.symbol().getRootReference().getValue());
+  });
+
+  target.addDynamicallyLegalOp<fir::EmboxProcOp>([](fir::EmboxProcOp op) {
+    return !fir::NameUniquer::needExternalNameMangling(
+        op.funcname().getRootReference().getValue());
+  });
+
+  if (failed(applyPartialConversion(op, target, std::move(patterns))))
+    signalPassFailure();
+}
+
+std::unique_ptr<mlir::Pass> fir::createExternalNameConversionPass() {
+  return std::make_unique<ExternalNameConversionPass>();
+}

flang/lib/Optimizer/Transforms/PassDetail.h

+//===- PassDetail.h - Optimizer Transforms Pass class details ---*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+#ifndef FORTRAN_OPTMIZER_TRANSFORMS_PASSDETAIL_H
+#define FORTRAN_OPTMIZER_TRANSFORMS_PASSDETAIL_H
+
+#include "flang/Optimizer/Dialect/FIRDialect.h"
+#include "mlir/Dialect/LLVMIR/LLVMDialect.h"
+#include "mlir/Dialect/OpenACC/OpenACC.h"
+#include "mlir/Dialect/OpenMP/OpenMPDialect.h"
+#include "mlir/Dialect/StandardOps/IR/Ops.h"
+#include "mlir/Pass/Pass.h"
+#include "mlir/Pass/PassRegistry.h"
+
+namespace fir {
+
+#define GEN_PASS_CLASSES
+#include "flang/Optimizer/Transforms/Passes.h.inc"
+
+} // namespace fir
+
+#endif // FORTRAN_OPTMIZER_TRANSFORMS_PASSDETAIL_H

flang/test/Fir/external-mangling-emboxproc.fir

+// RUN: fir-opt --external-name-interop %s | FileCheck %s
+
+func @_QPfoo() {  
+  %e6 = fir.alloca tuple<i32,f64>
+  %0 = fir.emboxproc @_QPfoo_impl, %e6 : ((!fir.box<!fir.type<derived3{f:f32}>>) -> (), !fir.ref<tuple<i32,f64>>) -> !fir.boxproc<(!fir.box<!fir.type<derived3{f:f32}>>) -> ()>  
+  return
+}
+func private @_QPfoo_impl(!fir.ref<i32>)
+
+// CHECK: %{{.*}}= fir.emboxproc @foo_impl_

flang/test/Fir/external-mangling.fir

+// RUN: fir-opt --external-name-interop %s | FileCheck %s
+
+func @_QPfoo() {  
+  %c0 = constant 0 : index
+  %0 = fir.address_of(@_QBa) : !fir.ref<!fir.array<4xi8>>
+  %1 = fir.convert %0 : (!fir.ref<!fir.array<4xi8>>) -> !fir.ref<!fir.array<?xi8>>
+  %2 = fir.coordinate_of %1, %c0 : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+  %3 = fir.convert %2 : (!fir.ref<i8>) -> !fir.ref<i32>
+  %4 = fir.address_of(@_QB) : !fir.ref<!fir.array<4xi8>>
+  %5 = fir.convert %4 : (!fir.ref<!fir.array<4xi8>>) -> !fir.ref<!fir.array<?xi8>>
+  %6 = fir.coordinate_of %5, %c0 : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+  %7 = fir.convert %6 : (!fir.ref<i8>) -> !fir.ref<f32>
+  fir.call @_QPbar(%3) : (!fir.ref<i32>) -> ()
+  fir.call @_QPbar2(%7) : (!fir.ref<f32>) -> ()
+  return
+}
+fir.global common @_QBa(dense<0> : vector<4xi8>) : !fir.array<4xi8>
+fir.global common @_QB(dense<0> : vector<4xi8>) : !fir.array<4xi8>
+func private @_QPbar(!fir.ref<i32>)
+func private @_QPbar2(!fir.ref<f32>)
+
+// CHECK: func @foo_
+// CHECK: %{{.*}} = fir.address_of(@a_) : !fir.ref<!fir.array<4xi8>>
+// CHECK: %{{.*}} = fir.address_of(@__BLNK__) : !fir.ref<!fir.array<4xi8>>
+// CHECK: fir.call @bar_
+// CHECK: fir.call @bar2_
+// CHECK: fir.global common @a_(dense<0> : vector<4xi8>) : !fir.array<4xi8>
+// CHECK: fir.global common @__BLNK__(dense<0> : vector<4xi8>) : !fir.array<4xi8>
+// CHECK: func private @bar_(!fir.ref<i32>)

flang/tools/fir-opt/CMakeLists.txt

 add_flang_tool(fir-opt fir-opt.cpp)
 llvm_update_compile_flags(fir-opt)
 get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS)
 
 target_link_libraries(fir-opt PRIVATE
   FIRDialect
   FIRSupport
   FIRTransforms
   FIRCodeGen
   ${dialect_libs}
 
   # TODO: these should be transitive dependencies from a target providing
   # "registerFIRPasses()"
+  MLIRIR
+  MLIRLLVMIR
+  MLIRPass
+  MLIRStandardToLLVM
+  MLIRTransforms
   MLIRAffineToStandard
+  MLIRAnalysis
+  MLIRSCFToStandard
+  MLIRParser
+  MLIRStandardToLLVM
+  MLIRSupport
+  MLIRVectorToLLVM
   MLIROptLib
+
 )

flang/tools/fir-opt/fir-opt.cpp

 //===- fir-opt.cpp - FIR Optimizer Driver -----------------------*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 //
 // This is to be like LLVM's opt program, only for FIR.  Such a program is
 // required for roundtrip testing, etc.
 //
 //===----------------------------------------------------------------------===//
 
 #include "mlir/Support/MlirOptMain.h"
 #include "flang/Optimizer/Support/InitFIR.h"
+#include "flang/Optimizer/Transforms/Passes.h"
 
 using namespace mlir;
 
 int main(int argc, char **argv) {
   fir::support::registerMLIRPassesForFortranTools();
+  fir::registerOptTransformPasses();
   DialectRegistry registry;
   fir::support::registerDialects(registry);
   return failed(MlirOptMain(argc, argv, "FIR modular optimizer driver\n",
       registry, /*preloadDialectsInContext=*/false));
 }

flang/unittests/Optimizer/InternalNamesTest.cpp

TEST(InternalNamesTest, complexdeconstructTest) {
   validateDeconstructedName(actual, expectedNameKind, expectedComponents);
 
   actual = NameUniquer::deconstruct("_QFmstartGmpitop");
   expectedNameKind = NameKind::NAMELIST_GROUP;
   expectedComponents = {{}, {"mstart"}, "mpitop", {}};
   validateDeconstructedName(actual, expectedNameKind, expectedComponents);
 }
 
+TEST(InternalNamesTest, needExternalNameMangling) {
+  ASSERT_FALSE(
+      NameUniquer::needExternalNameMangling("_QMmodSs1modSs2modFsubPfun"));
+  ASSERT_FALSE(NameUniquer::needExternalNameMangling("omp_num_thread"));
+  ASSERT_FALSE(NameUniquer::needExternalNameMangling(""));
+  ASSERT_FALSE(NameUniquer::needExternalNameMangling("_QDTmytypeK2K8K18"));
+  ASSERT_FALSE(NameUniquer::needExternalNameMangling("exit_"));
+  ASSERT_TRUE(NameUniquer::needExternalNameMangling("_QPfoo"));
+  ASSERT_TRUE(NameUniquer::needExternalNameMangling("_QPbar"));
+  ASSERT_TRUE(NameUniquer::needExternalNameMangling("_QBa"));
+}
+
+TEST(InternalNamesTest, isExternalFacingUniquedName) {
+  std::pair result = NameUniquer::deconstruct("_QMmodSs1modSs2modFsubPfun");
+
+  ASSERT_FALSE(NameUniquer::isExternalFacingUniquedName(result));
+  result = NameUniquer::deconstruct("omp_num_thread");
+  ASSERT_FALSE(NameUniquer::isExternalFacingUniquedName(result));
+  result = NameUniquer::deconstruct("");
+  ASSERT_FALSE(NameUniquer::isExternalFacingUniquedName(result));
+  result = NameUniquer::deconstruct("_QDTmytypeK2K8K18");
+  ASSERT_FALSE(NameUniquer::isExternalFacingUniquedName(result));
+  result = NameUniquer::deconstruct("exit_");
+  ASSERT_FALSE(NameUniquer::isExternalFacingUniquedName(result));
+  result = NameUniquer::deconstruct("_QPfoo");
+  ASSERT_TRUE(NameUniquer::isExternalFacingUniquedName(result));
+  result = NameUniquer::deconstruct("_QPbar");
+  ASSERT_TRUE(NameUniquer::isExternalFacingUniquedName(result));
+  result = NameUniquer::deconstruct("_QBa");
+  ASSERT_TRUE(NameUniquer::isExternalFacingUniquedName(result));
+}
+
 // main() from gtest_main