[flang][lowering] Add support for lowering of the `i{a}char` intrinsics

[awarzynski]

Summary

This patch adds support for lowering of the i{a}char intrinsics from
Fortran to the FIR dialect of MLIR.

This is part of the upstreaming effort from the fir-dev branch in [1].

[1] https://github.com/flang-compiler/f18-llvm-project

Co-authored-by: Jean Perier <[e-mail]>
Co-authored-by: Valentin Clement <[e-mail]>
Co-authored-by: V Donaldson <[e-mail]>
Co-authored-by: zacharyselk <[e-mail]>
Co-authored-by: Eric Schweitz <[e-mail]>

[clementval]

LGTM.

Good job to bundle them together when we can :-)

[vdonaldson]

There is an ibclr.f90 test if that could be included as well.

[awarzynski]

In D121790#3386591, @vdonaldson wrote:

There is an ibclr.f90 test if that could be included as well.

I've added it in https://reviews.llvm.org/D121789.

flang/lib/Lower/IntrinsicCall.cpp

 #include "flang/Optimizer/Builder/Runtime/Numeric.h"
 #include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
 #include "flang/Optimizer/Builder/Runtime/Reduction.h"
 #include "flang/Optimizer/Builder/Runtime/Transformational.h"
 #include "flang/Optimizer/Dialect/FIROpsSupport.h"
 #include "flang/Optimizer/Support/FatalError.h"
 #include "mlir/Dialect/LLVMIR/LLVMDialect.h"
 #include "llvm/Support/CommandLine.h"
+#include "llvm/Support/Debug.h"
 
 #define DEBUG_TYPE "flang-lower-intrinsic"
 
 #define PGMATH_DECLARE
 #include "flang/Evaluate/pgmath.h.inc"
 
 /// This file implements lowering of Fortran intrinsic procedures.
 /// Intrinsics are lowered to a mix of FIR and MLIR operations as
struct IntrinsicLibrary {
   template <Extremum, ExtremumBehavior>
   mlir::Value genExtremum(mlir::Type, llvm::ArrayRef<mlir::Value>);
   /// Lowering for the IAND intrinsic. The IAND intrinsic expects two arguments
   /// in the llvm::ArrayRef.
   mlir::Value genIand(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genIbclr(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genIbits(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genIbset(mlir::Type, llvm::ArrayRef<mlir::Value>);
+  fir::ExtendedValue genIchar(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genIeor(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genIshft(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genIshftc(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genLbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genNull(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genLen(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genLenTrim(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genMaxloc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
static constexpr IntrinsicHandler handlers[]{
      /*isElemental=*/false},
     {"eoshift",
      &I::genEoshift,
      {{{"array", asBox},
        {"shift", asAddr},
        {"boundary", asBox, handleDynamicOptional},
        {"dim", asValue}}},
      /*isElemental=*/false},
+    {"iachar", &I::genIchar},
     {"iand", &I::genIand},
     {"ibclr", &I::genIbclr},
     {"ibits", &I::genIbits},
     {"ibset", &I::genIbset},
+    {"ichar", &I::genIchar},
     {"ieor", &I::genIeor},
     {"ishft", &I::genIshft},
     {"ishftc", &I::genIshftc},
     {"len",
      &I::genLen,
      {{{"string", asInquired}, {"kind", asValue}}},
      /*isElemental=*/false},
     {"len_trim", &I::genLenTrim},
mlir::Value IntrinsicLibrary::genIbset(mlir::Type resultType,
   // Return:  I | (1 << POS)
   assert(args.size() == 2);
   mlir::Value pos = builder.createConvert(loc, resultType, args[1]);
   mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
   auto mask = builder.create<mlir::arith::ShLIOp>(loc, one, pos);
   return builder.create<mlir::arith::OrIOp>(loc, args[0], mask);
 }
 
+// ICHAR
+fir::ExtendedValue
+IntrinsicLibrary::genIchar(mlir::Type resultType,
+                           llvm::ArrayRef<fir::ExtendedValue> args) {
+  // There can be an optional kind in second argument.
+  assert(args.size() == 2);
+  const fir::CharBoxValue *charBox = args[0].getCharBox();
+  if (!charBox)
+    llvm::report_fatal_error("expected character scalar");
+
+  fir::factory::CharacterExprHelper helper{builder, loc};
+  mlir::Value buffer = charBox->getBuffer();
+  mlir::Type bufferTy = buffer.getType();
+  mlir::Value charVal;
+  if (auto charTy = bufferTy.dyn_cast<fir::CharacterType>()) {
+    assert(charTy.singleton());
+    charVal = buffer;
+  } else {
+    // Character is in memory, cast to fir.ref<char> and load.
+    mlir::Type ty = fir::dyn_cast_ptrEleTy(bufferTy);
+    if (!ty)
+      llvm::report_fatal_error("expected memory type");
+    // The length of in the character type may be unknown. Casting
+    // to a singleton ref is required before loading.
+    fir::CharacterType eleType = helper.getCharacterType(ty);
+    fir::CharacterType charType =
+        fir::CharacterType::get(builder.getContext(), eleType.getFKind(), 1);
+    mlir::Type toTy = builder.getRefType(charType);
+    mlir::Value cast = builder.createConvert(loc, toTy, buffer);
+    charVal = builder.create<fir::LoadOp>(loc, cast);
+  }
+  LLVM_DEBUG(llvm::dbgs() << "ichar(" << charVal << ")\n");
+  auto code = helper.extractCodeFromSingleton(charVal);
+  return builder.create<mlir::arith::ExtUIOp>(loc, resultType, code);
+}
+
 // IEOR
 mlir::Value IntrinsicLibrary::genIeor(mlir::Type resultType,
                                       llvm::ArrayRef<mlir::Value> args) {
   assert(args.size() == 2);
   return builder.create<mlir::arith::XOrIOp>(loc, args[0], args[1]);
 }
 
 // ISHFT

flang/test/Lower/Intrinsics/ichar.f90

+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+! RUN: %flang_fc1 -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: ichar_test
+subroutine ichar_test(c)
+  character(1) :: c
+  character :: str(10)
+  ! CHECK-DAG: %[[unbox:.*]]:2 = fir.unboxchar
+  ! CHECK-DAG: %[[J:.*]] = fir.alloca i32 {{{.*}}uniq_name = "{{.*}}Ej"}
+  ! CHECK-DAG: %[[STR:.*]] = fir.alloca !fir.array{{.*}} {{{.*}}uniq_name = "{{.*}}Estr"}
+  ! CHECK: %[[BOX:.*]] = fir.convert %[[unbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1>>
+  ! CHECK: %[[PTR:.*]] = fir.load %[[BOX]] : !fir.ref<!fir.char<1>>
+  ! CHECK: %[[CHAR:.*]] = fir.extract_value %[[PTR]], [0 : index] :
+  ! CHECK: %[[ARG:.*]] = arith.extui %[[CHAR]] : i8 to i32
+  ! CHECK: fir.call @{{.*}}OutputInteger32{{.*}}%[[ARG]]
+  ! CHECK: fir.call @{{.*}}EndIoStatement
+  print *, ichar(c)
+
+  ! CHECK-DAG: %{{.*}} = fir.load %[[J]] : !fir.ref<i32>
+  ! CHECK: %[[PTR1:.*]] = fir.coordinate_of %[[STR]], %
+  ! CHECK: %[[PTR2:.*]] = fir.load %[[PTR1]] : !fir.ref<!fir.char<1>>
+  ! CHECK: %[[CHAR:.*]] = fir.extract_value %[[PTR2]], [0 : index] :
+  ! CHECK: %[[ARG:.*]] = arith.extui %[[CHAR]] : i8 to i32
+  ! CHECK: fir.call @{{.*}}OutputInteger32{{.*}}%[[ARG]]
+  ! CHECK: fir.call @{{.*}}EndIoStatement
+  print *, ichar(str(J))
+
+  ! "Magic" 88 below is the value returned by IACHAR (’X’)
+  ! CHECK: %[[c88:.*]] = arith.constant 88 : i32
+  ! CHECK-NEXT: fir.call @{{.*}}OutputInteger32({{.*}}, %[[c88]])
+  ! CHECK-NEXT: fir.call @{{.*}}EndIoStatement
+  print *, iachar('X')
+end subroutine