[fir] Add fir.embox conversion

Convert a `fir.embox` operation to LLVM IR dialect.
A `fir.embox` is converted to a sequence of operation that
create, allocate if needed, and populate a descriptor.

Current limitiation: alignment is set by default but should be retrieved in the specific target.

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

Reviewed By: kiranchandramohan, awarzynski

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

Co-authored-by: Eric Schweitz <eschweitz@nvidia.com>
Co-authored-by: Jean Perier <jperier@nvidia.com>

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

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

flang/include/flang/Optimizer/Support/TypeCode.h

@@ -0,0 +1,90 @@
+//===-- Optimizer/Support/TypeCode.h ----------------------------*- 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
+//
+//===----------------------------------------------------------------------===//
+//
+// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_OPTIMIZER_SUPPORT_TYPECODE_H
+#define FORTRAN_OPTIMIZER_SUPPORT_TYPECODE_H
+
+#include "flang/ISO_Fortran_binding.h"
+#include "llvm/Support/ErrorHandling.h"
+
+namespace fir {
+
+//===----------------------------------------------------------------------===//
+// Translations of category and bitwidths to the type codes defined in flang's
+// ISO_Fortran_binding.h.
+//===----------------------------------------------------------------------===//
+
+inline int characterBitsToTypeCode(unsigned bitwidth) {
+  // clang-format off
+  switch (bitwidth) {
+  case 8:  return CFI_type_char;
+  case 16: return CFI_type_char16_t;
+  case 32: return CFI_type_char32_t;
+  default: llvm_unreachable("unsupported character size");
+  }
+  // clang-format on
+}
+
+inline int complexBitsToTypeCode(unsigned bitwidth) {
+  // clang-format off
+  switch (bitwidth) {
+  case 32:  return CFI_type_float_Complex;
+  case 64:  return CFI_type_double_Complex;
+  case 80:
+  case 128: return CFI_type_long_double_Complex;
+  default:  llvm_unreachable("unsupported complex size");
+  }
+  // clang-format on
+}
+
+inline int integerBitsToTypeCode(unsigned bitwidth) {
+  // clang-format off
+  switch (bitwidth) {
+  case 8:   return CFI_type_int8_t;
+  case 16:  return CFI_type_int16_t;
+  case 32:  return CFI_type_int32_t;
+  case 64:  return CFI_type_int64_t;
+  case 128: return CFI_type_int128_t;
+  default:  llvm_unreachable("unsupported integer size");
+  }
+  // clang-format on
+}
+
+inline int logicalBitsToTypeCode(unsigned bitwidth) {
+  // clang-format off
+  switch (bitwidth) {
+  case 8: return CFI_type_Bool;
+  case 16: return CFI_type_int_least16_t;
+  case 32: return CFI_type_int_least32_t;
+  case 64: return CFI_type_int_least64_t;
+  default: llvm_unreachable("unsupported logical size");
+  }
+  // clang-format on
+}
+
+inline int realBitsToTypeCode(unsigned bitwidth) {
+  // clang-format off
+  switch (bitwidth) {
+  case 32:  return CFI_type_float;
+  case 64:  return CFI_type_double;
+  case 80:
+  case 128: return CFI_type_long_double;
+  default:  llvm_unreachable("unsupported real size");
+  }
+  // clang-format on
+}
+
+static constexpr int derivedToTypeCode() { return CFI_type_struct; }
+
+} // namespace fir
+
+#endif // FORTRAN_OPTIMIZER_SUPPORT_TYPECODE_H

flang/lib/Optimizer/CodeGen/CodeGen.cpp

@@ -15,6 +15,7 @@
 #include "flang/ISO_Fortran_binding.h"
 #include "flang/Optimizer/Dialect/FIRAttr.h"
 #include "flang/Optimizer/Dialect/FIROps.h"
+#include "flang/Optimizer/Support/TypeCode.h"
 #include "mlir/Conversion/ArithmeticToLLVM/ArithmeticToLLVM.h"
 #include "mlir/Conversion/LLVMCommon/Pattern.h"
 #include "mlir/Conversion/StandardToLLVM/ConvertStandardToLLVM.h"
@@ -28,6 +29,9 @@
 // fir::LLVMTypeConverter for converting to LLVM IR dialect types.
 #include "TypeConverter.h"
 
+// TODO: This should really be recovered from the specified target.
+static constexpr unsigned defaultAlign = 8;
+
 /// `fir.box` attribute values as defined for CFI_attribute_t in
 /// flang/ISO_Fortran_binding.h.
 static constexpr unsigned kAttrPointer = CFI_attribute_pointer;
@@ -61,12 +65,20 @@ protected:
     return lowerTy().convertType(ty);
   }
 
+  mlir::LLVM::ConstantOp
+  genI32Constant(mlir::Location loc, mlir::ConversionPatternRewriter &rewriter,
+                 int value) const {
+    mlir::Type i32Ty = rewriter.getI32Type();
+    mlir::IntegerAttr attr = rewriter.getI32IntegerAttr(value);
+    return rewriter.create<mlir::LLVM::ConstantOp>(loc, i32Ty, attr);
+  }
+
   mlir::LLVM::ConstantOp
   genConstantOffset(mlir::Location loc,
                     mlir::ConversionPatternRewriter &rewriter,
                     int offset) const {
-    auto ity = lowerTy().offsetType();
+    mlir::Type ity = lowerTy().offsetType();
-    auto cattr = rewriter.getI32IntegerAttr(offset);
+    mlir::IntegerAttr cattr = rewriter.getI32IntegerAttr(offset);
     return rewriter.create<mlir::LLVM::ConstantOp>(loc, ity, cattr);
   }
 
@@ -153,6 +165,28 @@ protected:
         loc, mlir::LLVM::ICmpPredicate::ne, maskRes, c0);
   }
 
+  // Get the element type given an LLVM type that is of the form
+  // [llvm.ptr](array|struct|vector)+ and the provided indexes.
+  static mlir::Type getBoxEleTy(mlir::Type type,
+                                llvm::ArrayRef<unsigned> indexes) {
+    if (auto t = type.dyn_cast<mlir::LLVM::LLVMPointerType>())
+      type = t.getElementType();
+    for (auto i : indexes) {
+      if (auto t = type.dyn_cast<mlir::LLVM::LLVMStructType>()) {
+        assert(!t.isOpaque() && i < t.getBody().size());
+        type = t.getBody()[i];
+      } else if (auto t = type.dyn_cast<mlir::LLVM::LLVMArrayType>()) {
+        type = t.getElementType();
+      } else if (auto t = type.dyn_cast<mlir::VectorType>()) {
+        type = t.getElementType();
+      } else {
+        fir::emitFatalError(mlir::UnknownLoc::get(type.getContext()),
+                            "request for invalid box element type");
+      }
+    }
+    return type;
+  }
+
   template <typename... ARGS>
   mlir::LLVM::GEPOp genGEP(mlir::Location loc, mlir::Type ty,
                            mlir::ConversionPatternRewriter &rewriter,
@@ -1183,6 +1217,318 @@ struct ZeroOpConversion : public FIROpConversion<fir::ZeroOp> {
   }
 };
 
+/// Common base class for embox to descriptor conversion.
+template <typename OP>
+struct EmboxCommonConversion : public FIROpConversion<OP> {
+  using FIROpConversion<OP>::FIROpConversion;
+
+  // Find the LLVMFuncOp in whose entry block the alloca should be inserted.
+  // The order to find the LLVMFuncOp is as follows:
+  // 1. The parent operation of the current block if it is a LLVMFuncOp.
+  // 2. The first ancestor that is a LLVMFuncOp.
+  mlir::LLVM::LLVMFuncOp
+  getFuncForAllocaInsert(mlir::ConversionPatternRewriter &rewriter) const {
+    mlir::Operation *parentOp = rewriter.getInsertionBlock()->getParentOp();
+    return mlir::isa<mlir::LLVM::LLVMFuncOp>(parentOp)
+               ? mlir::cast<mlir::LLVM::LLVMFuncOp>(parentOp)
+               : parentOp->getParentOfType<mlir::LLVM::LLVMFuncOp>();
+  }
+
+  // Generate an alloca of size 1 and type \p toTy.
+  mlir::LLVM::AllocaOp
+  genAllocaWithType(mlir::Location loc, mlir::Type toTy, unsigned alignment,
+                    mlir::ConversionPatternRewriter &rewriter) const {
+    auto thisPt = rewriter.saveInsertionPoint();
+    mlir::LLVM::LLVMFuncOp func = getFuncForAllocaInsert(rewriter);
+    rewriter.setInsertionPointToStart(&func.front());
+    auto size = this->genI32Constant(loc, rewriter, 1);
+    auto al = rewriter.create<mlir::LLVM::AllocaOp>(loc, toTy, size, alignment);
+    rewriter.restoreInsertionPoint(thisPt);
+    return al;
+  }
+
+  static int getCFIAttr(fir::BoxType boxTy) {
+    auto eleTy = boxTy.getEleTy();
+    if (eleTy.isa<fir::PointerType>())
+      return CFI_attribute_pointer;
+    if (eleTy.isa<fir::HeapType>())
+      return CFI_attribute_allocatable;
+    return CFI_attribute_other;
+  }
+
+  static fir::RecordType unwrapIfDerived(fir::BoxType boxTy) {
+    return fir::unwrapSequenceType(fir::dyn_cast_ptrOrBoxEleTy(boxTy))
+        .template dyn_cast<fir::RecordType>();
+  }
+  static bool isDerivedTypeWithLenParams(fir::BoxType boxTy) {
+    auto recTy = unwrapIfDerived(boxTy);
+    return recTy && recTy.getNumLenParams() > 0;
+  }
+  static bool isDerivedType(fir::BoxType boxTy) {
+    return unwrapIfDerived(boxTy) != nullptr;
+  }
+
+  // Get the element size and CFI type code of the boxed value.
+  std::tuple<mlir::Value, mlir::Value> getSizeAndTypeCode(
+      mlir::Location loc, mlir::ConversionPatternRewriter &rewriter,
+      mlir::Type boxEleTy, mlir::ValueRange lenParams = {}) const {
+    auto doInteger =
+        [&](unsigned width) -> std::tuple<mlir::Value, mlir::Value> {
+      int typeCode = fir::integerBitsToTypeCode(width);
+      return {this->genConstantOffset(loc, rewriter, width / 8),
+              this->genConstantOffset(loc, rewriter, typeCode)};
+    };
+    auto doLogical =
+        [&](unsigned width) -> std::tuple<mlir::Value, mlir::Value> {
+      int typeCode = fir::logicalBitsToTypeCode(width);
+      return {this->genConstantOffset(loc, rewriter, width / 8),
+              this->genConstantOffset(loc, rewriter, typeCode)};
+    };
+    auto doFloat = [&](unsigned width) -> std::tuple<mlir::Value, mlir::Value> {
+      int typeCode = fir::realBitsToTypeCode(width);
+      return {this->genConstantOffset(loc, rewriter, width / 8),
+              this->genConstantOffset(loc, rewriter, typeCode)};
+    };
+    auto doComplex =
+        [&](unsigned width) -> std::tuple<mlir::Value, mlir::Value> {
+      auto typeCode = fir::complexBitsToTypeCode(width);
+      return {this->genConstantOffset(loc, rewriter, width / 8 * 2),
+              this->genConstantOffset(loc, rewriter, typeCode)};
+    };
+    auto doCharacter =
+        [&](unsigned width,
+            mlir::Value len) -> std::tuple<mlir::Value, mlir::Value> {
+      auto typeCode = fir::characterBitsToTypeCode(width);
+      auto typeCodeVal = this->genConstantOffset(loc, rewriter, typeCode);
+      if (width == 8)
+        return {len, typeCodeVal};
+      auto byteWidth = this->genConstantOffset(loc, rewriter, width / 8);
+      auto i64Ty = mlir::IntegerType::get(&this->lowerTy().getContext(), 64);
+      auto size =
+          rewriter.create<mlir::LLVM::MulOp>(loc, i64Ty, byteWidth, len);
+      return {size, typeCodeVal};
+    };
+    auto getKindMap = [&]() -> fir::KindMapping & {
+      return this->lowerTy().getKindMap();
+    };
+    // Pointer-like types.
+    if (auto eleTy = fir::dyn_cast_ptrEleTy(boxEleTy))
+      boxEleTy = eleTy;
+    // Integer types.
+    if (fir::isa_integer(boxEleTy)) {
+      if (auto ty = boxEleTy.dyn_cast<mlir::IntegerType>())
+        return doInteger(ty.getWidth());
+      auto ty = boxEleTy.cast<fir::IntegerType>();
+      return doInteger(getKindMap().getIntegerBitsize(ty.getFKind()));
+    }
+    // Floating point types.
+    if (fir::isa_real(boxEleTy)) {
+      if (auto ty = boxEleTy.dyn_cast<mlir::FloatType>())
+        return doFloat(ty.getWidth());
+      auto ty = boxEleTy.cast<fir::RealType>();
+      return doFloat(getKindMap().getRealBitsize(ty.getFKind()));
+    }
+    // Complex types.
+    if (fir::isa_complex(boxEleTy)) {
+      if (auto ty = boxEleTy.dyn_cast<mlir::ComplexType>())
+        return doComplex(
+            ty.getElementType().cast<mlir::FloatType>().getWidth());
+      auto ty = boxEleTy.cast<fir::ComplexType>();
+      return doComplex(getKindMap().getRealBitsize(ty.getFKind()));
+    }
+    // Character types.
+    if (auto ty = boxEleTy.dyn_cast<fir::CharacterType>()) {
+      auto charWidth = getKindMap().getCharacterBitsize(ty.getFKind());
+      if (ty.getLen() != fir::CharacterType::unknownLen()) {
+        auto len = this->genConstantOffset(loc, rewriter, ty.getLen());
+        return doCharacter(charWidth, len);
+      }
+      assert(!lenParams.empty());
+      return doCharacter(charWidth, lenParams.back());
+    }
+    // Logical type.
+    if (auto ty = boxEleTy.dyn_cast<fir::LogicalType>())
+      return doLogical(getKindMap().getLogicalBitsize(ty.getFKind()));
+    // Array types.
+    if (auto seqTy = boxEleTy.dyn_cast<fir::SequenceType>())
+      return getSizeAndTypeCode(loc, rewriter, seqTy.getEleTy(), lenParams);
+    // Derived-type types.
+    if (boxEleTy.isa<fir::RecordType>()) {
+      auto ptrTy = mlir::LLVM::LLVMPointerType::get(
+          this->lowerTy().convertType(boxEleTy));
+      auto nullPtr = rewriter.create<mlir::LLVM::NullOp>(loc, ptrTy);
+      auto one =
+          genConstantIndex(loc, this->lowerTy().offsetType(), rewriter, 1);
+      auto gep = rewriter.create<mlir::LLVM::GEPOp>(
+          loc, ptrTy, mlir::ValueRange{nullPtr, one});
+      auto eleSize = rewriter.create<mlir::LLVM::PtrToIntOp>(
+          loc, this->lowerTy().indexType(), gep);
+      return {eleSize,
+              this->genConstantOffset(loc, rewriter, fir::derivedToTypeCode())};
+    }
+    // Reference type.
+    if (fir::isa_ref_type(boxEleTy)) {
+      // FIXME: use the target pointer size rather than sizeof(void*)
+      return {this->genConstantOffset(loc, rewriter, sizeof(void *)),
+              this->genConstantOffset(loc, rewriter, CFI_type_cptr)};
+    }
+    fir::emitFatalError(loc, "unhandled type in fir.box code generation");
+  }
+
+  /// Basic pattern to write a field in the descriptor
+  mlir::Value insertField(mlir::ConversionPatternRewriter &rewriter,
+                          mlir::Location loc, mlir::Value dest,
+                          ArrayRef<unsigned> fldIndexes, mlir::Value value,
+                          bool bitcast = false) const {
+    auto boxTy = dest.getType();
+    auto fldTy = this->getBoxEleTy(boxTy, fldIndexes);
+    if (bitcast)
+      value = rewriter.create<mlir::LLVM::BitcastOp>(loc, fldTy, value);
+    else
+      value = this->integerCast(loc, rewriter, fldTy, value);
+    SmallVector<mlir::Attribute, 2> attrs;
+    for (auto i : fldIndexes)
+      attrs.push_back(rewriter.getI32IntegerAttr(i));
+    auto indexesAttr = mlir::ArrayAttr::get(rewriter.getContext(), attrs);
+    return rewriter.create<mlir::LLVM::InsertValueOp>(loc, boxTy, dest, value,
+                                                      indexesAttr);
+  }
+
+  inline mlir::Value
+  insertBaseAddress(mlir::ConversionPatternRewriter &rewriter,
+                    mlir::Location loc, mlir::Value dest,
+                    mlir::Value base) const {
+    return insertField(rewriter, loc, dest, {0}, base, /*bitCast=*/true);
+  }
+
+  /// Get the address of the type descriptor global variable that was created by
+  /// lowering for derived type \p recType.
+  template <typename BOX>
+  mlir::Value
+  getTypeDescriptor(BOX box, mlir::ConversionPatternRewriter &rewriter,
+                    mlir::Location loc, fir::RecordType recType) const {
+    std::string name = recType.getLoweredName();
+    auto module = box->template getParentOfType<mlir::ModuleOp>();
+    if (auto global = module.template lookupSymbol<fir::GlobalOp>(name)) {
+      auto ty = mlir::LLVM::LLVMPointerType::get(
+          this->lowerTy().convertType(global.getType()));
+      return rewriter.create<mlir::LLVM::AddressOfOp>(loc, ty,
+                                                      global.sym_name());
+    }
+    if (auto global =
+            module.template lookupSymbol<mlir::LLVM::GlobalOp>(name)) {
+      // The global may have already been translated to LLVM.
+      auto ty = mlir::LLVM::LLVMPointerType::get(global.getType());
+      return rewriter.create<mlir::LLVM::AddressOfOp>(loc, ty,
+                                                      global.sym_name());
+    }
+    // The global does not exist in the current translation unit, but may be
+    // defined elsewhere (e.g., type defined in a module).
+    // For now, create a extern_weak symbol (will become nullptr if unresolved)
+    // to support generating code without the front-end generated symbols.
+    // These could be made available_externally 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());
+    // TODO: The symbol should be lowered to constant in lowering, they are read
+    // only.
+    modBuilder.create<mlir::LLVM::GlobalOp>(loc, i8Ty, /*isConstant=*/false,
+                                            mlir::LLVM::Linkage::ExternWeak,
+                                            name, mlir::Attribute{});
+    auto ty = mlir::LLVM::LLVMPointerType::get(i8Ty);
+    return rewriter.create<mlir::LLVM::AddressOfOp>(loc, ty, name);
+  }
+
+  template <typename BOX>
+  std::tuple<fir::BoxType, mlir::Value, mlir::Value>
+  consDescriptorPrefix(BOX box, mlir::ConversionPatternRewriter &rewriter,
+                       unsigned rank, mlir::ValueRange lenParams) const {
+    auto loc = box.getLoc();
+    auto boxTy = box.getType().template dyn_cast<fir::BoxType>();
+    auto convTy = this->lowerTy().convertBoxType(boxTy, rank);
+    auto llvmBoxPtrTy = convTy.template cast<mlir::LLVM::LLVMPointerType>();
+    auto llvmBoxTy = llvmBoxPtrTy.getElementType();
+    mlir::Value descriptor =
+        rewriter.create<mlir::LLVM::UndefOp>(loc, llvmBoxTy);
+
+    llvm::SmallVector<mlir::Value> typeparams = lenParams;
+    if constexpr (!std::is_same_v<BOX, fir::EmboxOp>) {
+      if (!box.substr().empty() && fir::hasDynamicSize(boxTy.getEleTy()))
+        typeparams.push_back(box.substr()[1]);
+    }
+
+    // Write each of the fields with the appropriate values
+    auto [eleSize, cfiTy] =
+        getSizeAndTypeCode(loc, rewriter, boxTy.getEleTy(), typeparams);
+    descriptor =
+        insertField(rewriter, loc, descriptor, {kElemLenPosInBox}, eleSize);
+    descriptor = insertField(rewriter, loc, descriptor, {kVersionPosInBox},
+                             this->genI32Constant(loc, rewriter, CFI_VERSION));
+    descriptor = insertField(rewriter, loc, descriptor, {kRankPosInBox},
+                             this->genI32Constant(loc, rewriter, rank));
+    descriptor = insertField(rewriter, loc, descriptor, {kTypePosInBox}, cfiTy);
+    descriptor =
+        insertField(rewriter, loc, descriptor, {kAttributePosInBox},
+                    this->genI32Constant(loc, rewriter, getCFIAttr(boxTy)));
+    const bool hasAddendum = isDerivedType(boxTy);
+    descriptor =
+        insertField(rewriter, loc, descriptor, {kF18AddendumPosInBox},
+                    this->genI32Constant(loc, rewriter, hasAddendum ? 1 : 0));
+
+    if (hasAddendum) {
+      auto isArray =
+          fir::dyn_cast_ptrOrBoxEleTy(boxTy).template isa<fir::SequenceType>();
+      unsigned typeDescFieldId = isArray ? kOptTypePtrPosInBox : kDimsPosInBox;
+      auto typeDesc =
+          getTypeDescriptor(box, rewriter, loc, unwrapIfDerived(boxTy));
+      descriptor =
+          insertField(rewriter, loc, descriptor, {typeDescFieldId}, typeDesc,
+                      /*bitCast=*/true);
+    }
+
+    return {boxTy, descriptor, eleSize};
+  }
+
+  /// If the embox is not in a globalOp body, allocate storage for the box;
+  /// store the value inside and return the generated alloca. Return the input
+  /// value otherwise.
+  mlir::Value
+  placeInMemoryIfNotGlobalInit(mlir::ConversionPatternRewriter &rewriter,
+                               mlir::Location loc, mlir::Value boxValue) const {
+    auto *thisBlock = rewriter.getInsertionBlock();
+    if (thisBlock && mlir::isa<mlir::LLVM::GlobalOp>(thisBlock->getParentOp()))
+      return boxValue;
+    auto boxPtrTy = mlir::LLVM::LLVMPointerType::get(boxValue.getType());
+    auto alloca = genAllocaWithType(loc, boxPtrTy, defaultAlign, rewriter);
+    rewriter.create<mlir::LLVM::StoreOp>(loc, boxValue, alloca);
+    return alloca;
+  }
+};
+
+/// Create a generic box on a memory reference. This conversions lowers the
+/// abstract box to the appropriate, initialized descriptor.
+struct EmboxOpConversion : public EmboxCommonConversion<fir::EmboxOp> {
+  using EmboxCommonConversion::EmboxCommonConversion;
+
+  mlir::LogicalResult
+  matchAndRewrite(fir::EmboxOp embox, OpAdaptor adaptor,
+                  mlir::ConversionPatternRewriter &rewriter) const override {
+    assert(!embox.getShape() && "There should be no dims on this embox op");
+    auto [boxTy, dest, eleSize] =
+        consDescriptorPrefix(embox, rewriter, /*rank=*/0,
+                             /*lenParams=*/adaptor.getOperands().drop_front(1));
+    dest = insertBaseAddress(rewriter, embox.getLoc(), dest,
+                             adaptor.getOperands()[0]);
+    if (isDerivedTypeWithLenParams(boxTy))
+      return rewriter.notifyMatchFailure(
+          embox, "fir.embox codegen of derived with length parameters not "
+                 "implemented yet");
+    auto result = placeInMemoryIfNotGlobalInit(rewriter, embox.getLoc(), dest);
+    rewriter.replaceOp(embox, result);
+    return success();
+  }
+};
+
 // Code shared between insert_value and extract_value Ops.
 struct ValueOpCommon {
   // Translate the arguments pertaining to any multidimensional array to
@@ -1719,9 +2065,9 @@ public:
         BoxTypeDescOpConversion, CallOpConversion, CmpcOpConversion,
         ConstcOpConversion, ConvertOpConversion, DispatchOpConversion,
         DispatchTableOpConversion, DTEntryOpConversion, DivcOpConversion,
-        EmboxCharOpConversion, ExtractValueOpConversion, HasValueOpConversion,
+        EmboxOpConversion, EmboxCharOpConversion, ExtractValueOpConversion,
-        GenTypeDescOpConversion, GlobalLenOpConversion, GlobalOpConversion,
+        HasValueOpConversion, GenTypeDescOpConversion, GlobalLenOpConversion,
-        InsertOnRangeOpConversion, InsertValueOpConversion,
+        GlobalOpConversion, InsertOnRangeOpConversion, InsertValueOpConversion,
         IsPresentOpConversion, LoadOpConversion, NegcOpConversion,
         MulcOpConversion, SelectCaseOpConversion, SelectOpConversion,
         SelectRankOpConversion, SelectTypeOpConversion, ShapeOpConversion,

flang/lib/Optimizer/Dialect/FIRType.cpp

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

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

@@ -1368,3 +1368,165 @@ func @box_tdesc(%arg0: !fir.box<f64>) {
 // CHECK:         %[[GEP:.*]] = llvm.getelementptr %[[ARG0]][%[[C0]], %[[TYPE_POS]]] : (!llvm.ptr<struct<(ptr<f64>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})>>, i32, i32) -> !llvm.ptr<i8>
 // CHECK:         %[[LOAD:.*]] = llvm.load %[[GEP]] : !llvm.ptr<i{{.*}}>
 // CHECK:         %{{.*}} = llvm.inttoptr %[[LOAD]] : i{{.*}} to !llvm.ptr<i{{.*}}>
+
+// -----
+
+// Test `fir.embox` conversion.
+
+// Check basic creation of a descriptor and insertion of values.
+// The indices used to insert values into the descriptor correspond the 
+// position of the fields in the descriptor as defined in `CFI_cdesc_t` in
+// flang/ISO_Fortran_binding.h.
+
+func @embox0(%arg0: !fir.ref<!fir.array<100xi32>>) {
+  %0 = fir.embox %arg0() : (!fir.ref<!fir.array<100xi32>>) -> !fir.box<!fir.array<100xi32>>
+  return
+}
+
+// CHECK-LABEL: func @embox0(
+// CHECK-SAME:               %[[ARG0:.*]]: !llvm.ptr<array<100 x i32>>
+// CHECK:         %[[C1:.*]] = llvm.mlir.constant(1 : i32) : i32
+// CHECK:         %[[ALLOCA:.*]] = llvm.alloca %[[C1]] x !llvm.struct<(ptr<array<100 x i32>>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})> {alignment = 8 : i64} : (i32) -> !llvm.ptr<struct<(ptr<array<100 x i32>>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})>>
+// CHECK:         %[[DESC:.*]] = llvm.mlir.undef : !llvm.struct<(ptr<array<100 x i32>>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})>
+// CHECK:         %[[ELEM_SIZE:.*]] = llvm.mlir.constant(4 : i32) : i32
+// CHECK:         %[[TYPE_CODE:.*]] = llvm.mlir.constant(9 : i32) : i32
+// CHECK:         %[[I64_ELEM_SIZE:.*]] = llvm.sext %[[ELEM_SIZE]] : i32 to i64
+// CHECK:         %[[DESC0:.*]] = llvm.insertvalue %[[I64_ELEM_SIZE]], %[[DESC]][1 : i32] : !llvm.struct<(ptr<array<100 x i32>>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})>
+// CHECK:         %[[CFI_VERSION:.*]] = llvm.mlir.constant(20180515 : i32) : i32
+// CHECK:         %[[DESC1:.*]] = llvm.insertvalue %[[CFI_VERSION]], %[[DESC0]][2 : i32] : !llvm.struct<(ptr<array<100 x i32>>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})>
+// CHECK:         %[[RANK:.*]] = llvm.mlir.constant(0 : i32) : i32
+// CHECK:         %[[RANK_I8:.*]] = llvm.trunc %[[RANK]] : i32 to i8
+// CHECK:         %[[DESC2:.*]] = llvm.insertvalue %[[RANK_I8]], %[[DESC1]][3 : i32] : !llvm.struct<(ptr<array<100 x i32>>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})>
+// CHECK:         %[[TYPE_CODE_I8:.*]] = llvm.trunc %[[TYPE_CODE]] : i32 to i8
+// CHECK:         %[[DESC3:.*]] = llvm.insertvalue %[[TYPE_CODE_I8]], %[[DESC2]][4 : i32] : !llvm.struct<(ptr<array<100 x i32>>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})>
+// CHECK:         %[[ATTR:.*]] = llvm.mlir.constant(0 : i32) : i32
+// CHECK:         %[[ATTR_I8:.*]] = llvm.trunc %[[ATTR]] : i32 to i8
+// CHECK:         %[[DESC4:.*]] = llvm.insertvalue %[[ATTR_I8]], %[[DESC3]][5 : i32] : !llvm.struct<(ptr<array<100 x i32>>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})>
+// CHECK:         %[[F18ADDENDUM:.*]] = llvm.mlir.constant(0 : i32) : i32
+// CHECK:         %[[F18ADDENDUM_I8:.*]] = llvm.trunc %[[F18ADDENDUM]] : i32 to i8
+// CHECK:         %[[DESC5:.*]] = llvm.insertvalue %[[F18ADDENDUM_I8]], %[[DESC4]][6 : i32] : !llvm.struct<(ptr<array<100 x i32>>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})>
+// CHECK:         %[[ADDR:.*]] = llvm.bitcast %[[ARG0]] : !llvm.ptr<array<100 x i32>> to !llvm.ptr<array<100 x i32>>
+// CHECK:         %[[DESC6:.*]] = llvm.insertvalue %[[ADDR]], %[[DESC5]][0 : i32] : !llvm.struct<(ptr<array<100 x i32>>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})>
+// CHECK:         llvm.store %[[DESC6]], %[[ALLOCA]] : !llvm.ptr<struct<(ptr<array<100 x i32>>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})>>
+
+// Check `fir.embox` in a `fir.global`. Descriptors created by `fir.embox` 
+// conversion are not generating `alloca` instructions. This test make sure of
+// that.
+
+fir.global @box_global : !fir.ref<!fir.array<?xi32>> {
+  %arr = fir.zero_bits !fir.ref<!fir.array<?xi32>>
+  %0 = arith.constant 0 : index
+  %3 = fir.embox %arr: (!fir.ref<!fir.array<?xi32>>) -> !fir.box<!fir.array<?xi32>>
+  fir.has_value %arr : !fir.ref<!fir.array<?xi32>>
+}
+
+// CHECK-LABEL: llvm.mlir.global external @box_global
+// CHECK-NOT:     llvm.alloca
+
+// Check `fir.embox` conversion of a POINTER entity. Make sure that the
+// attribute in the descriptor is set to 1 (value of CFI_attribute_pointer
+// in flang/ISO_Fortran_binding.h).
+
+func @embox_pointer(%arg0: !fir.ref<i32>) {
+  %0 = fir.embox %arg0 : (!fir.ref<i32>) -> !fir.box<!fir.ptr<i32>>
+  return
+}
+
+// CHECK-LABEL: llvm.func @embox_pointer
+// Check 1st 1 constant to skip it.
+// CHECK: %{{.*}} = llvm.mlir.constant(1 : i32) : i32
+// CHECK: %[[CFI_ATTR_POINTER:.*]] = llvm.mlir.constant(1 : i32) : i32
+// CHECK: %[[ATTR_I8:.*]] = llvm.trunc %[[CFI_ATTR_POINTER]] : i32 to i8
+// CHECK: %{{.*}} = llvm.insertvalue %[[ATTR_I8]], %{{.*}}[5 : i32] : !llvm.struct<(ptr<i32>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})>
+
+// Check `fir.embox` conversion of an ALLOCATABLE entity. Make sure that the
+// attribute in the descriptor is set to 2 (value of CFI_attribute_allocatable
+// in flang/ISO_Fortran_binding.h).
+
+func @embox_allocatable(%arg0: !fir.heap<!fir.array<?x!fir.char<1,10>>>) {
+  %0 = fir.embox %arg0 : (!fir.heap<!fir.array<?x!fir.char<1,10>>>) -> !fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>
+  return
+}
+
+// CHECK-LABEL: llvm.func @embox_allocatable
+// CHECK: %[[CFI_ATTR_ALLOCATABLE:.*]] = llvm.mlir.constant(2 : i32) : i32
+// CHECK: %[[ATTR_I8:.*]] = llvm.trunc %[[CFI_ATTR_ALLOCATABLE]] : i32 to i8
+// CHECK: %{{.*}} = llvm.insertvalue %[[ATTR_I8]], %{{.*}}[5 : i32] : !llvm.struct<(ptr<array<10 x i8>>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})>
+
+// Check `fir.embox` conversion of a type code.
+
+func @embox_typecode0(%arg0: !fir.ref<i64>) {
+  %0 = fir.embox %arg0 : (!fir.ref<i64>) -> !fir.box<!fir.ptr<i64>>
+  return
+}
+
+// CHECK-LABEL: llvm.func @embox_typecode0
+// CHECK: %[[TYPE_CODE_I64:.*]] = llvm.mlir.constant(10 : i32) : i32
+// CHECK: %[[TYPE_CODE_I64_I8:.*]] = llvm.trunc %[[TYPE_CODE_I64]] : i32 to i8
+// CHECK: %{{.*}} = llvm.insertvalue %[[TYPE_CODE_I64_I8]], %{{.*}}[4 : i32] : !llvm.struct<(ptr<i64>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})>
+
+func @embox_typecode1(%arg0: !fir.ref<f32>) {
+  %0 = fir.embox %arg0 : (!fir.ref<f32>) -> !fir.box<!fir.ptr<f32>>
+  return
+}
+
+// CHECK-LABEL: llvm.func @embox_typecode1
+// CHECK: %[[TYPE_CODE_F32:.*]] = llvm.mlir.constant(25 : i32) : i32
+// CHECK: %[[TYPE_CODE_F32_I8:.*]] = llvm.trunc %[[TYPE_CODE_I64]] : i32 to i8
+// CHECK: %{{.*}} = llvm.insertvalue %[[TYPE_CODE_F32_I8]], %{{.*}}[4 : i32] : !llvm.struct<(ptr<f32>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})>
+
+func @embox_typecode2(%arg0: !fir.ref<f128>) {
+  %0 = fir.embox %arg0 : (!fir.ref<f128>) -> !fir.box<!fir.ptr<f128>>
+  return
+}
+
+// CHECK-LABEL: llvm.func @embox_typecode2
+// CHECK: %[[TYPE_CODE_F128:.*]] = llvm.mlir.constant(27 : i32) : i32
+// CHECK: %[[TYPE_CODE_F128_I8:.*]] = llvm.trunc %[[TYPE_CODE_F128]] : i32 to i8
+// CHECK: %{{.*}} = llvm.insertvalue %[[TYPE_CODE_F128_I8]], %{{.*}}[4 : i32] : !llvm.struct<(ptr<f128>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})>
+
+func @embox_typecode3(%arg0: !fir.ref<!fir.complex<4>>) {
+  %0 = fir.embox %arg0 : (!fir.ref<!fir.complex<4>>) -> !fir.box<!fir.ptr<!fir.complex<4>>>
+  return
+}
+
+// CHECK-LABEL: llvm.func @embox_typecode3
+// CHECK: %[[TYPE_CODE_CPLX4:.*]] = llvm.mlir.constant(28 : i32) : i32
+// CHECK: %[[TYPE_CODE_CPLX4_I8:.*]] = llvm.trunc %[[TYPE_CODE_F128]] : i32 to i8
+// CHECK: %{{.*}} = llvm.insertvalue %[[TYPE_CODE_CPLX4_I8]], %{{.*}}[4 : i32] : !llvm.struct<(ptr<struct<(f32, f32)>>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})>
+
+func @embox_typecode4(%arg0: !fir.ref<!fir.logical<1>>) {
+  %0 = fir.embox %arg0 : (!fir.ref<!fir.logical<1>>) -> !fir.box<!fir.ptr<!fir.logical<1>>>
+  return
+}
+
+// CHECK-LABEL: llvm.func @embox_typecode4
+// CHECK: %[[TYPE_CODE_I64:.*]] = llvm.mlir.constant(31 : i32) : i32
+// CHECK: %[[TYPE_CODE_I64_I8:.*]] = llvm.trunc %[[TYPE_CODE_I64]] : i32 to i8
+// CHECK: %{{.*}} = llvm.insertvalue %[[TYPE_CODE_I64_I8]], %{{.*}}[4 : i32] : !llvm.struct<(ptr<i8>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})>
+
+// -----
+
+// Test `fir.embox` conversion. This test creates a global so it needs to be
+// split from others.
+
+// Check descriptor for a derived type. Check that the f18Addendum flag is set
+// to 1 meaning the addendum is present (true) and the addendum values are
+// inserted.
+
+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 extern_weak @_QMtest_dinitE.dt.tseq() : i8
+// CHECK-LABEL: llvm.func @embox1
+// CHECK:         %[[TYPE_CODE:.*]] = llvm.mlir.constant(34 : i32) : i32
+// CHECK:         %[[TYPE_CODE_I8:.*]] = llvm.trunc %[[TYPE_CODE]] : i32 to i8
+// CHECK:         %{{.*}} = llvm.insertvalue %[[TYPE_CODE_I8]], %{{.*}}[4 : i32] : !llvm.struct<(ptr<struct<"_QMtest_dinitTtseq", (i32)>>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, ptr<i{{.*}}>, array<1 x i{{.*}}>)>
+// CHECK:         %[[F18ADDENDUM:.*]] = llvm.mlir.constant(1 : i32) : i32
+// CHECK:         %[[F18ADDENDUM_I8:.*]] = llvm.trunc %[[F18ADDENDUM]] : i32 to i8
+// CHECK:         %{{.*}} = llvm.insertvalue %[[F18ADDENDUM_I8]], %18[6 : i32] : !llvm.struct<(ptr<struct<"_QMtest_dinitTtseq", (i32)>>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, ptr<i{{.*}}>, array<1 x i{{.*}}>)>
+// CHECK:         %[[TDESC:.*]] = llvm.mlir.addressof @_QMtest_dinitE.dt.tseq : !llvm.ptr<i8>
+// CHECK:         %[[TDESC_CAST:.*]] = llvm.bitcast %22 : !llvm.ptr<i8> to !llvm.ptr<i8>
+// CHECK:         %{{.*}} = llvm.insertvalue %[[TDESC_CAST]], %{{.*}}[7 : i32] : !llvm.struct<(ptr<struct<"_QMtest_dinitTtseq", (i32)>>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, ptr<i{{.*}}>, array<1 x i{{.*}}>)>