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

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

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

Co-authored-by: Jean Perier <jperier@nvidia.com>
Co-authored-by: Valentin Clement <clementval@gmail.com>
Co-authored-by: V Donaldson <vdonaldson@nvidia.com>
Co-authored-by: zacharyselk <zrselk@gmail.com>
Co-authored-by: Eric Schweitz <eschweitz@nvidia.com>

flang/lib/Lower/IntrinsicCall.cpp

@@ -34,6 +34,7 @@
 #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"
 
@@ -460,6 +461,7 @@ struct IntrinsicLibrary {
   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>);
@@ -634,10 +636,12 @@ static constexpr IntrinsicHandler handlers[]{
        {"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},
@@ -1950,6 +1954,42 @@ mlir::Value IntrinsicLibrary::genIbset(mlir::Type resultType,
   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) {

flang/test/Lower/Intrinsics/ichar.f90

@@ -0,0 +1,33 @@
+! 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