[flang] Fix bug in character casting. Add missing sext/trunc in code gen.

[clementval]

Summary

This patch is part of the upstreaming effort from fir-dev branch.
It also ensures all descriptors created inline complies with LBOUND
requirement that the lower bound is 1 when the related dimension
extent is zero.

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

Co-authored-by: Eric Schweitz <[e-mail]>
Co-authored-by: Jean Perier <[e-mail]>

[PeteSteinfeld]

All builds and tests correctly and looks good.

Thanks, Valentin!

flang/lib/Optimizer/CodeGen/CodeGen.cpp

std::tuple<mlir::Value, mlir::Value> getSizeAndTypeCode(
     };
     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 byteWidth = genConstantIndex(loc, i64Ty, rewriter, width / 8);
+      auto len64 = FIROpConversion<OP>::integerCast(loc, rewriter, i64Ty, len);
       auto size =
-          rewriter.create<mlir::LLVM::MulOp>(loc, i64Ty, byteWidth, len);
+          rewriter.create<mlir::LLVM::MulOp>(loc, i64Ty, byteWidth, len64);
       return {size, typeCodeVal};
     };
     auto getKindMap = [&]() -> fir::KindMapping & {
       return this->lowerTy().getKindMap();
     };
     // Pointer-like types.
     if (auto eleTy = fir::dyn_cast_ptrEleTy(boxEleTy))
       boxEleTy = eleTy;
struct EmboxCommonConversion : public FIROpConversion<OP> {
   mlir::Value shiftSubstringBase(mlir::ConversionPatternRewriter &rewriter,
                                  mlir::Location loc, mlir::Value base,
                                  mlir::Value lowerBound) const {
     llvm::SmallVector<mlir::Value> gepOperands;
     auto baseType =
         base.getType().cast<mlir::LLVM::LLVMPointerType>().getElementType();
     if (baseType.isa<mlir::LLVM::LLVMArrayType>()) {
       auto idxTy = this->lowerTy().indexType();
-      mlir::Value zero = genConstantIndex(loc, idxTy, rewriter, 0);
-      gepOperands.push_back(zero);
-    }
+      gepOperands.push_back(genConstantIndex(loc, idxTy, rewriter, 0));
+      gepOperands.push_back(lowerBound);
+    } else {
       gepOperands.push_back(lowerBound);
+    }
     return this->genGEP(loc, base.getType(), rewriter, base, gepOperands);
   }
 
   /// 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,
matchAndRewrite(fir::cg::XEmboxOp xbox, OpAdaptor adaptor,
     unsigned shapeOffset = xbox.shapeOffset();
     bool hasShift = !xbox.shift().empty();
     unsigned shiftOffset = xbox.shiftOffset();
     bool hasSlice = !xbox.slice().empty();
     unsigned sliceOffset = xbox.sliceOffset();
     mlir::Location loc = xbox.getLoc();
     mlir::Value zero = genConstantIndex(loc, i64Ty, rewriter, 0);
     mlir::Value one = genConstantIndex(loc, i64Ty, rewriter, 1);
-    mlir::Value prevDim = integerCast(loc, rewriter, i64Ty, eleSize);
     mlir::Value prevPtrOff = one;
     mlir::Type eleTy = boxTy.getEleTy();
     const unsigned rank = xbox.getRank();
     llvm::SmallVector<mlir::Value> gepArgs;
     unsigned constRows = 0;
     mlir::Value ptrOffset = zero;
-    if (auto memEleTy = fir::dyn_cast_ptrEleTy(xbox.memref().getType()))
-      if (auto seqTy = memEleTy.dyn_cast<fir::SequenceType>()) {
-        mlir::Type seqEleTy = seqTy.getEleTy();
-        // Adjust the element scaling factor if the element is a dependent type.
-        if (fir::hasDynamicSize(seqEleTy)) {
-          if (fir::isa_char(seqEleTy)) {
-            assert(xbox.lenParams().size() == 1);
-            prevPtrOff = integerCast(loc, rewriter, i64Ty,
-                                     operands[xbox.lenParamOffset()]);
-          } else if (seqEleTy.isa<fir::RecordType>()) {
-            TODO(loc, "generate call to calculate size of PDT");
-          } else {
-            return rewriter.notifyMatchFailure(xbox, "unexpected dynamic type");
-          }
-        } else {
-          constRows = seqTy.getConstantRows();
-        }
-      }
-
-    bool hasSubcomp = !xbox.subcomponent().empty();
-    if (!xbox.substr().empty())
-      TODO(loc, "codegen of fir.embox with substring");
+    mlir::Type memEleTy = fir::dyn_cast_ptrEleTy(xbox.memref().getType());
+    assert(memEleTy.isa<fir::SequenceType>());
+    auto seqTy = memEleTy.cast<fir::SequenceType>();
+      if (auto charTy = seqEleTy.dyn_cast<fir::CharacterType>()) {
+        mlir::LLVM::ConstantOp charSize = genConstantIndex(
+            loc, i64Ty, rewriter, lowerTy().characterBitsize(charTy) / 8);
+        mlir::Value castedLen =
+            integerCast(loc, rewriter, i64Ty, operands[xbox.lenParamOffset()]);
+        auto byteOffset =
+            rewriter.create<mlir::LLVM::MulOp>(loc, i64Ty, charSize, castedLen);
+        prevPtrOff = integerCast(loc, rewriter, i64Ty, byteOffset);
+        // prevPtrOff = ;
+        fir::emitFatalError(loc, "unexpected dynamic type");
 
-    mlir::Value stepExpr;
+    const auto hasSubcomp = !xbox.subcomponent().empty();
+    const bool hasSubstr = !xbox.substr().empty();
+    /// Compute initial element stride that will be use to compute the step in
+    /// each dimension.
+    mlir::Value prevDimByteStride = integerCast(loc, rewriter, i64Ty, eleSize);
     if (hasSubcomp) {
       // We have a subcomponent. The step value needs to be the number of
       // bytes per element (which is a derived type).
-      mlir::Type ty0 = base.getType();
-      [[maybe_unused]] auto ptrTy = ty0.dyn_cast<mlir::LLVM::LLVMPointerType>();
-      assert(ptrTy && "expected pointer type");
-      mlir::Type memEleTy = fir::dyn_cast_ptrEleTy(xbox.memref().getType());
-      assert(memEleTy && "expected fir pointer type");
-      auto seqTy = memEleTy.dyn_cast<fir::SequenceType>();
-      assert(seqTy && "expected sequence type");
-      mlir::Type seqEleTy = seqTy.getEleTy();
       auto eleTy = mlir::LLVM::LLVMPointerType::get(convertType(seqEleTy));
-      stepExpr = computeDerivedTypeSize(loc, eleTy, i64Ty, rewriter);
+      prevDimByteStride = computeDerivedTypeSize(loc, eleTy, i64Ty, rewriter);
+    } else if (hasSubstr) {
+      // We have a substring. The step value needs to be the number of bytes
+      // per CHARACTER element.
+      auto charTy = seqEleTy.cast<fir::CharacterType>();
+      if (fir::hasDynamicSize(charTy)) {
+        prevDimByteStride = prevPtrOff;
+      } else {
+        prevDimByteStride = genConstantIndex(
+            loc, i64Ty, rewriter,
+            charTy.getLen() * lowerTy().characterBitsize(charTy) / 8);
+      }
     }
 
     // Process the array subspace arguments (shape, shift, etc.), if any,
     // translating everything to values in the descriptor wherever the entity
     // has a dynamic array dimension.
     for (unsigned di = 0, descIdx = 0; di < rank; ++di) {
       mlir::Value extent = operands[shapeOffset];
       mlir::Value outerExtent = extent;
for (unsigned di = 0, descIdx = 0; di < rank; ++di) {
                 xbox.slice()[3 * di + 1].getDefiningOp())) {
           // This dimension contains a scalar expression in the array slice op.
           // The dimension is loop invariant, will be dropped, and will not
           // appear in the descriptor.
           skipNext = true;
         }
       }
       if (!skipNext) {
+        // store extent
         if (hasSlice)
           extent = computeTripletExtent(rewriter, loc, operands[sliceOffset],
                                         operands[sliceOffset + 1],
                                         operands[sliceOffset + 2], zero, i64Ty);
-        // store lower bound (normally 0) for BIND(C) interoperability.
+        // Lower bound is normalized to 0 for BIND(C) interoperability.
         mlir::Value lb = zero;
         const bool isaPointerOrAllocatable =
             eleTy.isa<fir::PointerType>() || eleTy.isa<fir::HeapType>();
         // Lower bound is defaults to 1 for POINTER, ALLOCATABLE, and
         // denormalized descriptors.
-        if (isaPointerOrAllocatable || !normalizedLowerBound(xbox)) {
+        if (isaPointerOrAllocatable || !normalizedLowerBound(xbox))
           lb = one;
-          // If there is a shifted origin, and no fir.slice, and this is not
-          // a normalized descriptor then use the value from the shift op as
-          // the lower bound.
-          if (hasShift && !(hasSlice || hasSubcomp)) {
-            lb = operands[shiftOffset];
-            auto extentIsEmpty = rewriter.create<mlir::LLVM::ICmpOp>(
-                loc, mlir::LLVM::ICmpPredicate::eq, extent, zero);
-            lb = rewriter.create<mlir::LLVM::SelectOp>(loc, extentIsEmpty, one,
-                                                       lb);
-          }
-        }
+        if (hasShift && !(hasSlice || hasSubcomp || hasSubstr) &&
+            (isaPointerOrAllocatable || !normalizedLowerBound(xbox))) {
         dest = insertLowerBound(rewriter, loc, dest, descIdx, lb);
 
         dest = insertExtent(rewriter, loc, dest, descIdx, extent);
 
         // store step (scaled by shaped extent)
-
-        mlir::Value step = hasSubcomp ? stepExpr : prevDim;
+        mlir::Value step = prevDimByteStride;
         if (hasSlice)
           step = rewriter.create<mlir::LLVM::MulOp>(loc, i64Ty, step,
                                                     operands[sliceOffset + 2]);
         dest = insertStride(rewriter, loc, dest, descIdx, step);
         ++descIdx;
       }
 
       // compute the stride and offset for the next natural dimension
-      prevDim =
-          rewriter.create<mlir::LLVM::MulOp>(loc, i64Ty, prevDim, outerExtent);
+      prevDimByteStride = rewriter.create<mlir::LLVM::MulOp>(
+          loc, i64Ty, prevDimByteStride, outerExtent);
       if (constRows == 0)
         prevPtrOff = rewriter.create<mlir::LLVM::MulOp>(loc, i64Ty, prevPtrOff,
                                                         outerExtent);
       else
         --constRows;
 
       // increment iterators
       ++shapeOffset;
       if (hasShift)
         ++shiftOffset;
       if (hasSlice)
         sliceOffset += 3;
     }
-    if (hasSlice || hasSubcomp || !xbox.substr().empty()) {
+    if (hasSlice || hasSubcomp || hasSubstr) {
       llvm::SmallVector<mlir::Value> args = {ptrOffset};
       args.append(gepArgs.rbegin(), gepArgs.rend());
       if (hasSubcomp) {
         // For each field in the path add the offset to base via the args list.
         // In the most general case, some offsets must be computed since
         // they are not be known until runtime.
         if (fir::hasDynamicSize(fir::unwrapSequenceType(
                 fir::unwrapPassByRefType(xbox.memref().getType()))))
           TODO(loc, "fir.embox codegen dynamic size component in derived type");
         args.append(operands.begin() + xbox.subcomponentOffset(),
                     operands.begin() + xbox.subcomponentOffset() +
                         xbox.subcomponent().size());
       }
       base =
           rewriter.create<mlir::LLVM::GEPOp>(loc, base.getType(), base, args);
-      if (!xbox.substr().empty())
+      if (hasSubstr)
         base = shiftSubstringBase(rewriter, loc, base,
                                   operands[xbox.substrOffset()]);
     }
     dest = insertBaseAddress(rewriter, loc, dest, base);
     if (isDerivedTypeWithLenParams(boxTy))
       TODO(loc, "fir.embox codegen of derived with length parameters");
 
     mlir::Value result = placeInMemoryIfNotGlobalInit(rewriter, loc, dest);

flang/test/Fir/embox-write.fir

+// RUN: fir-opt %s | tco | FileCheck %s
+
+// CHECK-LABEL: @set_all_n
+func.func @set_all_n(%n : index, %x : i32) {
+  %aTmp = fir.alloca i32, %n
+  %aMem = fir.convert %aTmp : (!fir.ref<i32>) -> !fir.ref<!fir.array<?xi32>>
+  %c1 = arith.constant 1 : index
+  %aDim = fir.shape %n : (index) -> !fir.shape<1>
+  %a = fir.embox %aMem(%aDim) : (!fir.ref<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xi32>>
+  // CHECK-DAG: %[[IV:.*]] = phi i64
+  // CHECK-DAG: %[[LCV:.*]] = phi i64
+  // CHECK: icmp sgt i64 %[[LCV]], 0
+  fir.do_loop %i = %c1 to %n step %c1 unordered {
+    %1 = fir.coordinate_of %a, %i : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32>
+    // CHECK: store i32 %{{.*}}, ptr %{{.*}}
+    fir.store %x to %1 : !fir.ref<i32>
+  }
+  return
+}