[flang] Support PDT type descriptors in codegen

This change updates the mapping of derived types and type descriptor
object names to support kind parametrized derived types (PDT).
It moves the custom name mapping to the internal name utility.

To improve robustness and error reporting, type descriptors are also now
required to be generated in all compilation unit that manipulates
derived types. The previous codegen relied on the fact that descriptors
not defined in the current FIR module were available externally. Errors
with missing type descriptors were only caught at link time.

This patch makes derived type definition mandatory, except if the
derived types are expected to not have derived type descriptors (builtin
types), or if the newly added debug switch `--ignore-missing-type-desc`
is set. In those cases, a null pointer is used as type descriptor
pointer. The debug switch intends to help testing FIR to LLVM passes
without having to bother providing type descriptor data structures that
are normally built by the front-end.

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

flang/include/flang/Optimizer/CodeGen/CodeGen.h

@@ -35,9 +35,24 @@ struct TargetRewriteOptions {
 std::unique_ptr<mlir::OperationPass<mlir::ModuleOp>> createFirTargetRewritePass(
     const TargetRewriteOptions &options = TargetRewriteOptions());
 
-/// Convert FIR to the LLVM IR dialect
+/// FIR to LLVM translation pass options.
+struct FIRToLLVMPassOptions {
+  // Do not fail when type descriptors are not found when translating
+  // operations that uses them at the LLVM level like fir.embox. Instead,
+  // just use a null pointer.
+  // This is useful to test translating programs manually written where a
+  // frontend did not generate type descriptor data structures. However, note
+  // that this programs would crash at runtime if the derived type descriptors
+  // are required by the runtime, so this only an option to help debugging.
+  bool ignoreMissingTypeDescriptors = false;
+};
+
+/// Convert FIR to the LLVM IR dialect with default options.
 std::unique_ptr<mlir::Pass> createFIRToLLVMPass();
 
+/// Convert FIR to the LLVM IR dialect
+std::unique_ptr<mlir::Pass> createFIRToLLVMPass(FIRToLLVMPassOptions options);
+
 using LLVMIRLoweringPrinter =
     std::function<void(llvm::Module &, llvm::raw_ostream &)>;
 /// Convert the LLVM IR dialect to LLVM-IR proper

flang/include/flang/Optimizer/Dialect/FIRTypes.td

@@ -323,8 +323,6 @@ def fir_RecordType : FIR_Type<"Record", "type"> {
 
     void finalize(llvm::ArrayRef<TypePair> lenPList,
                   llvm::ArrayRef<TypePair> typeList);
-    
-    std::string translateNameToFrontendMangledName() const;
 
     detail::RecordTypeStorage const *uniqueKey() const;
   }];

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

@@ -137,6 +137,11 @@ struct NameUniquer {
   static bool belongsToModule(llvm::StringRef uniquedName,
                               llvm::StringRef moduleName);
 
+  /// Given a mangled derived type name, get the name of the related derived
+  /// type descriptor object. Returns an empty string if \p mangledTypeName is
+  /// not a valid mangled derived type name.
+  static std::string getTypeDescriptorName(llvm::StringRef mangledTypeName);
+
 private:
   static std::string intAsString(std::int64_t i);
   static std::string doKind(std::int64_t kind);

flang/include/flang/Tools/CLOptions.inc

@@ -37,6 +37,18 @@ static llvm::cl::opt<std::size_t> arrayStackAllocationThreshold(
         "place all array allocations more than <size> elements on the heap"),
     llvm::cl::init(~static_cast<std::size_t>(0)), llvm::cl::Hidden);
 
+/// Shared option in tools to ignore missing runtime type descriptor objects
+/// when translating FIR to LLVM. The resulting program will crash if the
+/// runtime needs the derived type descriptors, this is only a debug option to
+/// allow compiling manually written FIR programs involving derived types
+/// without having to write the derived type descriptors which are normally
+/// generated by the frontend.
+static llvm::cl::opt<bool> ignoreMissingTypeDescriptors(
+    "ignore-missing-type-desc",
+    llvm::cl::desc("ignore failures to find derived type descriptors when "
+                   "translating FIR to LLVM"),
+    llvm::cl::init(false), llvm::cl::Hidden);
+
 namespace {
 /// Optimizer Passes
 DisableOption(CfgConversion, "cfg-conversion", "disable FIR to CFG pass");
@@ -107,7 +119,10 @@ inline void addTargetRewritePass(mlir::PassManager &pm) {
 }
 
 inline void addFIRToLLVMPass(mlir::PassManager &pm) {
-  addPassConditionally(pm, disableFirToLlvmIr, fir::createFIRToLLVMPass);
+  fir::FIRToLLVMPassOptions options;
+  options.ignoreMissingTypeDescriptors = ignoreMissingTypeDescriptors;
+  addPassConditionally(pm, disableFirToLlvmIr,
+      [&]() { return fir::createFIRToLLVMPass(options); });
 }
 
 inline void addLLVMDialectToLLVMPass(

flang/lib/Optimizer/CodeGen/CodeGen.cpp

@@ -66,8 +66,9 @@ namespace {
 template <typename FromOp>
 class FIROpConversion : public mlir::ConvertOpToLLVMPattern<FromOp> {
 public:
-  explicit FIROpConversion(fir::LLVMTypeConverter &lowering)
-      : mlir::ConvertOpToLLVMPattern<FromOp>(lowering) {}
+  explicit FIROpConversion(fir::LLVMTypeConverter &lowering,
+                           const fir::FIRToLLVMPassOptions &options)
+      : mlir::ConvertOpToLLVMPattern<FromOp>(lowering), options(options) {}
 
 protected:
   mlir::Type convertType(mlir::Type ty) const {
@@ -251,6 +252,8 @@ protected:
   fir::LLVMTypeConverter &lowerTy() const {
     return *static_cast<fir::LLVMTypeConverter *>(this->getTypeConverter());
   }
+
+  const fir::FIRToLLVMPassOptions &options;
 };
 
 /// FIR conversion pattern template
@@ -1259,7 +1262,8 @@ struct EmboxCommonConversion : public FIROpConversion<OP> {
   mlir::Value
   getTypeDescriptor(BOX box, mlir::ConversionPatternRewriter &rewriter,
                     mlir::Location loc, fir::RecordType recType) const {
-    std::string name = recType.translateNameToFrontendMangledName();
+    std::string name =
+        fir::NameUniquer::getTypeDescriptorName(recType.getName());
     auto module = box->template getParentOfType<mlir::ModuleOp>();
     if (auto global = module.template lookupSymbol<fir::GlobalOp>(name)) {
       auto ty = mlir::LLVM::LLVMPointerType::get(
@@ -1274,24 +1278,15 @@ struct EmboxCommonConversion : public FIROpConversion<OP> {
       return rewriter.create<mlir::LLVM::AddressOfOp>(loc, ty,
                                                       global.getSymName());
     }
-    if (fir::NameUniquer::belongsToModule(
-            name, Fortran::semantics::typeInfoBuiltinModule)) {
-      // Type info derived types do not have type descriptors since they are the
-      // types defining type descriptors.
-      return rewriter.create<mlir::LLVM::NullOp>(
-          loc, ::getVoidPtrType(box.getContext()));
-    }
-    // The global does not exist in the current translation unit, but may be
-    // defined elsewhere (e.g., type defined in a module).
-    // Create an available_externally global to require the symbols to be
-    // defined elsewhere and to cause link-time failure otherwise.
-    auto i8Ty = rewriter.getIntegerType(8);
-    mlir::OpBuilder modBuilder(module.getBodyRegion());
-    modBuilder.create<mlir::LLVM::GlobalOp>(
-        loc, i8Ty, /*isConstant=*/true,
-        mlir::LLVM::Linkage::AvailableExternally, name, mlir::Attribute{});
-    auto ty = mlir::LLVM::LLVMPointerType::get(i8Ty);
-    return rewriter.create<mlir::LLVM::AddressOfOp>(loc, ty, name);
+    // Type info derived types do not have type descriptors since they are the
+    // types defining type descriptors.
+    if (!this->options.ignoreMissingTypeDescriptors &&
+        !fir::NameUniquer::belongsToModule(
+            name, Fortran::semantics::typeInfoBuiltinModule))
+      fir::emitFatalError(
+          loc, "runtime derived type info descriptor was not generated");
+    return rewriter.create<mlir::LLVM::NullOp>(
+        loc, ::getVoidPtrType(box.getContext()));
   }
 
   template <typename BOX>
@@ -3233,8 +3228,9 @@ struct NegcOpConversion : public FIROpConversion<fir::NegcOp> {
 /// These operations are normally dead after the pre-codegen pass.
 template <typename FromOp>
 struct MustBeDeadConversion : public FIROpConversion<FromOp> {
-  explicit MustBeDeadConversion(fir::LLVMTypeConverter &lowering)
-      : FIROpConversion<FromOp>(lowering) {}
+  explicit MustBeDeadConversion(fir::LLVMTypeConverter &lowering,
+                                const fir::FIRToLLVMPassOptions &options)
+      : FIROpConversion<FromOp>(lowering, options) {}
   using OpAdaptor = typename FromOp::Adaptor;
 
   mlir::LogicalResult
@@ -3274,6 +3270,8 @@ namespace {
 /// This pass is not complete yet. We are upstreaming it in small patches.
 class FIRToLLVMLowering : public fir::FIRToLLVMLoweringBase<FIRToLLVMLowering> {
 public:
+  FIRToLLVMLowering() = default;
+  FIRToLLVMLowering(fir::FIRToLLVMPassOptions options) : options{options} {}
   mlir::ModuleOp getModule() { return getOperation(); }
 
   void runOnOperation() override final {
@@ -3306,8 +3304,8 @@ public:
         SliceOpConversion, StoreOpConversion, StringLitOpConversion,
         SubcOpConversion, UnboxCharOpConversion, UnboxProcOpConversion,
         UndefOpConversion, UnreachableOpConversion, XArrayCoorOpConversion,
-        XEmboxOpConversion, XReboxOpConversion, ZeroOpConversion>(
-        typeConverter);
+        XEmboxOpConversion, XReboxOpConversion, ZeroOpConversion>(typeConverter,
+                                                                  options);
     mlir::populateStdToLLVMConversionPatterns(typeConverter, pattern);
     mlir::arith::populateArithmeticToLLVMConversionPatterns(typeConverter,
                                                             pattern);
@@ -3325,6 +3323,9 @@ public:
       signalPassFailure();
     }
   }
+
+private:
+  fir::FIRToLLVMPassOptions options;
 };
 
 /// Lower from LLVM IR dialect to proper LLVM-IR and dump the module
@@ -3362,6 +3363,11 @@ std::unique_ptr<mlir::Pass> fir::createFIRToLLVMPass() {
   return std::make_unique<FIRToLLVMLowering>();
 }
 
+std::unique_ptr<mlir::Pass>
+fir::createFIRToLLVMPass(FIRToLLVMPassOptions options) {
+  return std::make_unique<FIRToLLVMLowering>(options);
+}
+
 std::unique_ptr<mlir::Pass>
 fir::createLLVMDialectToLLVMPass(raw_ostream &output,
                                  fir::LLVMIRLoweringPrinter printer) {

flang/lib/Optimizer/Dialect/FIRType.cpp

@@ -642,12 +642,6 @@ unsigned fir::RecordType::getFieldIndex(llvm::StringRef ident) {
   return std::numeric_limits<unsigned>::max();
 }
 
-std::string fir::RecordType::translateNameToFrontendMangledName() const {
-  auto split = getName().split('T');
-  std::string name = (split.first + "E.dt." + split.second).str();
-  return name;
-}
-
 //===----------------------------------------------------------------------===//
 // ReferenceType
 //===----------------------------------------------------------------------===//

flang/lib/Optimizer/Support/InternalNames.cpp

@@ -324,3 +324,29 @@ bool fir::NameUniquer::belongsToModule(llvm::StringRef uniquedName,
   return !result.second.modules.empty() &&
          result.second.modules[0] == moduleName;
 }
+
+static std::string
+mangleTypeDescriptorKinds(llvm::ArrayRef<std::int64_t> kinds) {
+  if (kinds.empty())
+    return "";
+  std::string result = "";
+  for (std::int64_t kind : kinds)
+    result += "." + std::to_string(kind);
+  return result;
+}
+
+std::string
+fir::NameUniquer::getTypeDescriptorName(llvm::StringRef mangledTypeName) {
+  auto result = deconstruct(mangledTypeName);
+  if (result.first != NameKind::DERIVED_TYPE)
+    return "";
+  std::string varName = ".dt." + result.second.name +
+                        mangleTypeDescriptorKinds(result.second.kinds);
+  llvm::SmallVector<llvm::StringRef> modules;
+  for (const std::string &mod : result.second.modules)
+    modules.push_back(mod);
+  llvm::Optional<llvm::StringRef> host;
+  if (result.second.host)
+    host = *result.second.host;
+  return doVariable(modules, host, varName);
+}

flang/test/Fir/convert-to-llvm.fir

@@ -1618,12 +1618,14 @@ func @embox_typecode4(%arg0: !fir.ref<!fir.logical<1>>) {
 // to 1 meaning the addendum is present (true) and the addendum values are
 // inserted.
 
+fir.global linkonce @_QMtest_dinitE.dt.tseq constant : i8
+
 func @embox1(%arg0: !fir.ref<!fir.type<_QMtest_dinitTtseq{i:i32}>>) {
   %0 = fir.embox %arg0() : (!fir.ref<!fir.type<_QMtest_dinitTtseq{i:i32}>>) -> !fir.box<!fir.type<_QMtest_dinitTtseq{i:i32}>>
   return
 }
 
-// CHECK: llvm.mlir.global available_externally constant @_QMtest_dinitE.dt.tseq() : i8
+// CHECK: llvm.mlir.global linkonce constant @_QMtest_dinitE.dt.tseq() : i8
 // CHECK-LABEL: llvm.func @embox1
 // CHECK:         %[[TYPE_CODE:.*]] = llvm.mlir.constant(42 : i32) : i32
 // CHECK:         %[[TYPE_CODE_I8:.*]] = llvm.trunc %[[TYPE_CODE]] : i32 to i8

flang/test/Fir/ignore-missing-type-descriptor.fir

@@ -0,0 +1,21 @@
+// Test the option to avoid failing if derived type descriptors are not found.
+// This is a debug option to allow manually writing derived type fir.embox without
+// having to care with providing an ABI compliant derived type descriptor object.
+// Missing derived type descriptor pointers are replaced by null pointers.
+// RUN: tco --ignore-missing-type-desc -o - %s | FileCheck %s
+
+!some_freestyle_type = type !fir.type<some_not_mangled_type{j:i32}>
+
+func private @bar(!fir.box<!some_freestyle_type>)
+
+func @test_embox(%addr: !fir.ref<!some_freestyle_type>) {
+  %0 = fir.embox %addr : (!fir.ref<!some_freestyle_type>) -> !fir.box<!some_freestyle_type>
+  fir.call @bar(%0) : (!fir.box<!some_freestyle_type>) -> ()
+  return
+}
+// CHECK-LABEL: define void @test_embox(
+// CHECK-SAME: %some_not_mangled_type* %[[ADDR:.*]])
+// CHECK: insertvalue { %some_not_mangled_type*, i64, i32, i8, i8, i8, i8, i8*, [1 x i64] }
+// CHECK-SAME: { %some_not_mangled_type* undef, i64 ptrtoint (%some_not_mangled_type* getelementptr (%some_not_mangled_type, %some_not_mangled_type* null, i32 1) to i64),
+// CHECK-SAME: i32 20180515, i8 0, i8 42, i8 0, i8 1, i8* null, [1 x i64] undef },
+// CHECK-SAME: %some_not_mangled_type* %[[ADDR]], 0,