[fir] Add external name interop pass

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.

Reviewed By: schweitz

Differential Revision: https://reviews.llvm.org/D111057

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

@@ -126,6 +126,13 @@ struct NameUniquer {
   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);

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

@@ -22,25 +22,7 @@ class Region;
 
 namespace fir {
 
-/// Convert fir.select_type to the standard dialect
-std::unique_ptr<mlir::Pass> createControlFlowLoweringPass();
-
-/// Effects aware CSE pass
-std::unique_ptr<mlir::Pass> createCSEPass();
-
-/// Convert FIR loop constructs to the Affine dialect
-std::unique_ptr<mlir::Pass> createPromoteToAffinePass();
-
-/// Convert `fir.do_loop` and `fir.if` to a CFG.  This
-/// conversion enables the `createLowerToCFGPass` to transform these to CFG
-/// form.
-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,

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

@@ -16,36 +16,12 @@
 
 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()";
 }
 
 #endif // FLANG_OPTIMIZER_TRANSFORMS_PASSES

flang/lib/Optimizer/Support/InternalNames.cpp

@@ -302,3 +302,18 @@ fir::NameUniquer::deconstruct(llvm::StringRef uniq) {
   }
   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

@@ -1,5 +1,6 @@
 add_flang_library(FIRTransforms
   Inliner.cpp
+  ExternalNameConversion.cpp
 
   DEPENDS
   FIRDialect

flang/lib/Optimizer/Transforms/ExternalNameConversion.cpp

@@ -0,0 +1,192 @@
+//===- 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

@@ -0,0 +1,26 @@
+//===- 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

@@ -0,0 +1,10 @@
+// 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

@@ -0,0 +1,29 @@
+// 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

@@ -11,6 +11,18 @@ target_link_libraries(fir-opt PRIVATE
 
   # 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

@@ -13,11 +13,13 @@
 
 #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",

flang/unittests/Optimizer/InternalNamesTest.cpp

@@ -221,4 +221,36 @@ TEST(InternalNamesTest, complexdeconstructTest) {
   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