[flang] REAL(KIND=3) and COMPLEX(KIND=3) descriptors

Update descriptor generation to correctly set the `type` field for
REAL(3) and COMPLEX(3) objects.

Author: vdonaldson

flang/include/flang/ISO_Fortran_binding.h

@@ -43,8 +43,7 @@ typedef unsigned char CFI_attribute_t;
 typedef signed char CFI_type_t;
 /* These codes are required to be macros (i.e., #ifdef will work).
  * They are not required to be distinct, but neither are they required
- * to have had their synonyms combined.  Codes marked as extensions may be
- * place holders for as yet unimplemented types.
+ * to have had their synonyms combined.
  */
 #define CFI_type_signed_char 1
 #define CFI_type_short 2
@@ -56,7 +55,7 @@ typedef signed char CFI_type_t;
 #define CFI_type_int16_t 8
 #define CFI_type_int32_t 9
 #define CFI_type_int64_t 10
-#define CFI_type_int128_t 11 /* extension */
+#define CFI_type_int128_t 11 /* extension kind=16 */
 #define CFI_type_int_least8_t 12
 #define CFI_type_int_least16_t 13
 #define CFI_type_int_least32_t 14
@@ -88,8 +87,8 @@ typedef signed char CFI_type_t;
 #define CFI_type_char 40
 #define CFI_type_cptr 41
 #define CFI_type_struct 42
-#define CFI_type_char16_t 43 /* extension */
-#define CFI_type_char32_t 44 /* extension */
+#define CFI_type_char16_t 43 /* extension kind=2 */
+#define CFI_type_char32_t 44 /* extension kind=4 */
 #define CFI_TYPE_LAST CFI_type_char32_t
 #define CFI_type_other (-1) // must be negative
 

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

@@ -13,80 +13,12 @@
 #ifndef FORTRAN_OPTIMIZER_SUPPORT_TYPECODE_H
 #define FORTRAN_OPTIMIZER_SUPPORT_TYPECODE_H
 
-#include "flang/ISO_Fortran_binding.h"
-#include "llvm/Support/ErrorHandling.h"
+#include "flang/Optimizer/Dialect/Support/KindMapping.h"
+#include "mlir/IR/Types.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 16:  return CFI_type_half_float_Complex; // CFI_type_bfloat_Complex ?
-  case 32:  return CFI_type_float_Complex;
-  case 64:  return CFI_type_double_Complex;
-  case 80:  return CFI_type_extended_double_Complex;
-  case 128: return CFI_type_float128_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 16:  return CFI_type_half_float; // CFI_type_bfloat ?
-  case 32:  return CFI_type_float;
-  case 64:  return CFI_type_double;
-  case 80:  return CFI_type_extended_double;
-  case 128: return CFI_type_float128;
-  default:  llvm_unreachable("unsupported real size");
-  }
-  // clang-format on
-}
-
-static constexpr int derivedToTypeCode() { return CFI_type_struct; }
-
+/// Return the ISO_Fortran_binding.h type code for mlir type \p ty.
+int getTypeCode(mlir::Type ty, KindMapping &kindMap);
 } // namespace fir
 
 #endif // FORTRAN_OPTIMIZER_SUPPORT_TYPECODE_H

flang/lib/Optimizer/CodeGen/CodeGen.cpp

@@ -1272,119 +1272,42 @@ struct EmboxCommonConversion : public FIROpConversion<OP> {
       mlir::Location loc, mlir::ConversionPatternRewriter &rewriter,
       mlir::Type boxEleTy, mlir::ValueRange lenParams = {}) const {
     auto i64Ty = mlir::IntegerType::get(rewriter.getContext(), 64);
-    auto getKindMap = [&]() -> fir::KindMapping & {
-      return this->lowerTy().getKindMap();
-    };
-    auto doInteger =
-        [&](mlir::Type type,
-            unsigned width) -> std::tuple<mlir::Value, mlir::Value> {
-      int typeCode = fir::integerBitsToTypeCode(width);
-      return {
-          genTypeStrideInBytes(loc, i64Ty, rewriter, this->convertType(type)),
-          this->genConstantOffset(loc, rewriter, typeCode)};
-    };
-    auto doLogical =
-        [&](mlir::Type type,
-            unsigned width) -> std::tuple<mlir::Value, mlir::Value> {
-      int typeCode = fir::logicalBitsToTypeCode(width);
-      return {
-          genTypeStrideInBytes(loc, i64Ty, rewriter, this->convertType(type)),
-          this->genConstantOffset(loc, rewriter, typeCode)};
-    };
-    auto doFloat = [&](mlir::Type type,
-                       unsigned width) -> std::tuple<mlir::Value, mlir::Value> {
-      int typeCode = fir::realBitsToTypeCode(width);
-      return {
-          genTypeStrideInBytes(loc, i64Ty, rewriter, this->convertType(type)),
-          this->genConstantOffset(loc, rewriter, typeCode)};
-    };
-    auto doComplex =
-        [&](mlir::Type type,
-            unsigned width) -> std::tuple<mlir::Value, mlir::Value> {
-      auto typeCode = fir::complexBitsToTypeCode(width);
-      return {
-          genTypeStrideInBytes(loc, i64Ty, rewriter, this->convertType(type)),
-          this->genConstantOffset(loc, rewriter, typeCode)};
-    };
-    auto doCharacter = [&](fir::CharacterType type, mlir::ValueRange lenParams)
-        -> std::tuple<mlir::Value, mlir::Value> {
-      unsigned bitWidth = getKindMap().getCharacterBitsize(type.getFKind());
-      auto typeCode = fir::characterBitsToTypeCode(bitWidth);
-      auto typeCodeVal = this->genConstantOffset(loc, rewriter, typeCode);
-
-      bool lengthIsConst = (type.getLen() != fir::CharacterType::unknownLen());
-      mlir::Value eleSize =
-          genTypeStrideInBytes(loc, i64Ty, rewriter, this->convertType(type));
-
-      if (!lengthIsConst) {
-        // If length is constant, then the fir::CharacterType will be
-        // represented as an array of known size of elements having
-        // the corresponding LLVM type. In this case eleSize already
-        // holds correct memory size. If length is not constant, then
-        // the fir::CharacterType will decay to a scalar type,
-        // so we have to multiply it by the non-constant length
-        // to get its size in memory.
+    if (auto eleTy = fir::dyn_cast_ptrEleTy(boxEleTy))
+      boxEleTy = eleTy;
+    if (auto seqTy = boxEleTy.dyn_cast<fir::SequenceType>())
+      return getSizeAndTypeCode(loc, rewriter, seqTy.getEleTy(), lenParams);
+    if (boxEleTy.isa<mlir::NoneType>()) // unlimited polymorphic or assumed type
+      return {rewriter.create<mlir::LLVM::ConstantOp>(loc, i64Ty, 0),
+              this->genConstantOffset(loc, rewriter, CFI_type_other)};
+    mlir::Value typeCodeVal = this->genConstantOffset(
+        loc, rewriter,
+        fir::getTypeCode(boxEleTy, this->lowerTy().getKindMap()));
+    if (fir::isa_integer(boxEleTy) || boxEleTy.dyn_cast<fir::LogicalType>() ||
+        fir::isa_real(boxEleTy) || fir::isa_complex(boxEleTy))
+      return {genTypeStrideInBytes(loc, i64Ty, rewriter,
+                                   this->convertType(boxEleTy)),
+              typeCodeVal};
+    if (auto charTy = boxEleTy.dyn_cast<fir::CharacterType>()) {
+      mlir::Value size =
+          genTypeStrideInBytes(loc, i64Ty, rewriter, this->convertType(charTy));
+      if (charTy.getLen() == fir::CharacterType::unknownLen()) {
+        // Multiply the single character size by the length.
         assert(!lenParams.empty());
         auto len64 = FIROpConversion<OP>::integerCast(loc, rewriter, i64Ty,
                                                       lenParams.back());
-        eleSize =
-            rewriter.create<mlir::LLVM::MulOp>(loc, i64Ty, eleSize, len64);
+        size = rewriter.create<mlir::LLVM::MulOp>(loc, i64Ty, size, len64);
       }
-      return {eleSize, typeCodeVal};
+      return {size, typeCodeVal};
     };
-    // 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, ty.getWidth());
-      auto ty = boxEleTy.cast<fir::IntegerType>();
-      return doInteger(ty, getKindMap().getIntegerBitsize(ty.getFKind()));
-    }
-    // Floating point types.
-    if (fir::isa_real(boxEleTy)) {
-      if (auto ty = boxEleTy.dyn_cast<mlir::FloatType>())
-        return doFloat(ty, ty.getWidth());
-      auto ty = boxEleTy.cast<fir::RealType>();
-      return doFloat(ty, getKindMap().getRealBitsize(ty.getFKind()));
-    }
-    // Complex types.
-    if (fir::isa_complex(boxEleTy)) {
-      if (auto ty = boxEleTy.dyn_cast<mlir::ComplexType>())
-        return doComplex(
-            ty, ty.getElementType().cast<mlir::FloatType>().getWidth());
-      auto ty = boxEleTy.cast<fir::ComplexType>();
-      return doComplex(ty, getKindMap().getRealBitsize(ty.getFKind()));
-    }
-    // Character types.
-    if (auto ty = boxEleTy.dyn_cast<fir::CharacterType>())
-      return doCharacter(ty, lenParams);
-    // Logical type.
-    if (auto ty = boxEleTy.dyn_cast<fir::LogicalType>())
-      return doLogical(ty, 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 eleSize = genTypeStrideInBytes(loc, i64Ty, rewriter,
-                                          this->convertType(boxEleTy));
-      return {eleSize,
-              this->genConstantOffset(loc, rewriter, fir::derivedToTypeCode())};
-    }
-    // Reference type.
     if (fir::isa_ref_type(boxEleTy)) {
       auto ptrTy = mlir::LLVM::LLVMPointerType::get(
           mlir::LLVM::LLVMVoidType::get(rewriter.getContext()));
-      mlir::Value size = genTypeStrideInBytes(loc, i64Ty, rewriter, ptrTy);
-      return {size, this->genConstantOffset(loc, rewriter, CFI_type_cptr)};
+      return {genTypeStrideInBytes(loc, i64Ty, rewriter, ptrTy), typeCodeVal};
     }
-    // Unlimited polymorphic or assumed type. Use 0 and CFI_type_other since the
-    // information is not none at this point.
-    if (boxEleTy.isa<mlir::NoneType>())
-      return {rewriter.create<mlir::LLVM::ConstantOp>(loc, i64Ty, 0),
-              this->genConstantOffset(loc, rewriter, CFI_type_other)};
+    if (boxEleTy.isa<fir::RecordType>())
+      return {genTypeStrideInBytes(loc, i64Ty, rewriter,
+                                   this->convertType(boxEleTy)),
+              typeCodeVal};
     fir::emitFatalError(loc, "unhandled type in fir.box code generation");
   }
 

flang/lib/Optimizer/Support/CMakeLists.txt

@@ -3,6 +3,7 @@ get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS)
 add_flang_library(FIRSupport
   InitFIR.cpp
   InternalNames.cpp
+  TypeCode.cpp
 
   DEPENDS
   FIROpsIncGen

flang/lib/Optimizer/Support/TypeCode.cpp

@@ -0,0 +1,107 @@
+//===-- Optimizer/Support/TypeCode.cpp ------------------------------------===//
+//
+// 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 "flang/Optimizer/Support/TypeCode.h"
+#include "flang/ISO_Fortran_binding.h"
+#include "flang/Optimizer/Dialect/FIRType.h"
+#include "llvm/Support/ErrorHandling.h"
+
+namespace fir {
+
+/// Return the ISO_C_BINDING intrinsic module value of type \p ty.
+int getTypeCode(mlir::Type ty, fir::KindMapping &kindMap) {
+  unsigned width = 0;
+  if (mlir::IntegerType intTy = ty.dyn_cast<mlir::IntegerType>()) {
+    switch (intTy.getWidth()) {
+    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;
+    }
+    llvm_unreachable("unsupported integer type");
+  }
+  if (fir::LogicalType logicalTy = ty.dyn_cast<fir::LogicalType>()) {
+    switch (kindMap.getLogicalBitsize(logicalTy.getFKind())) {
+    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;
+    }
+    llvm_unreachable("unsupported logical type");
+  }
+  if (mlir::FloatType floatTy = ty.dyn_cast<mlir::FloatType>()) {
+    switch (floatTy.getWidth()) {
+    case 16:
+      return floatTy.isBF16() ? CFI_type_bfloat : CFI_type_half_float;
+    case 32:
+      return CFI_type_float;
+    case 64:
+      return CFI_type_double;
+    case 80:
+      return CFI_type_extended_double;
+    case 128:
+      return CFI_type_float128;
+    }
+    llvm_unreachable("unsupported real type");
+  }
+  if (fir::isa_complex(ty)) {
+    if (mlir::ComplexType complexTy = ty.dyn_cast<mlir::ComplexType>()) {
+      mlir::FloatType floatTy =
+          complexTy.getElementType().cast<mlir::FloatType>();
+      if (floatTy.isBF16())
+        return CFI_type_bfloat_Complex;
+      width = floatTy.getWidth();
+    } else if (fir::ComplexType complexTy = ty.dyn_cast<fir::ComplexType>()) {
+      auto FKind = complexTy.getFKind();
+      if (FKind == 3)
+        return CFI_type_bfloat_Complex;
+      width = kindMap.getRealBitsize(FKind);
+    }
+    switch (width) {
+    case 16:
+      return CFI_type_half_float_Complex;
+    case 32:
+      return CFI_type_float_Complex;
+    case 64:
+      return CFI_type_double_Complex;
+    case 80:
+      return CFI_type_extended_double_Complex;
+    case 128:
+      return CFI_type_float128_Complex;
+    }
+    llvm_unreachable("unsupported complex size");
+  }
+  if (fir::CharacterType charTy = ty.dyn_cast<fir::CharacterType>()) {
+    switch (kindMap.getCharacterBitsize(charTy.getFKind())) {
+    case 8:
+      return CFI_type_char;
+    case 16:
+      return CFI_type_char16_t;
+    case 32:
+      return CFI_type_char32_t;
+    }
+    llvm_unreachable("unsupported character type");
+  }
+  if (fir::isa_ref_type(ty))
+    return CFI_type_cptr;
+  if (ty.isa<fir::RecordType>())
+    return CFI_type_struct;
+  llvm_unreachable("unsupported type");
+}
+
+} // namespace fir