diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp index 44d59fbe29c69..94b3432b1c633 100644 --- a/flang/lib/Lower/IntrinsicCall.cpp +++ b/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 genIbits(mlir::Type, llvm::ArrayRef); mlir::Value genIbset(mlir::Type, llvm::ArrayRef); + fir::ExtendedValue genIchar(mlir::Type, llvm::ArrayRef); mlir::Value genIeor(mlir::Type, llvm::ArrayRef); mlir::Value genIshft(mlir::Type, llvm::ArrayRef); mlir::Value genIshftc(mlir::Type, llvm::ArrayRef); @@ -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(loc, args[0], mask); } +// ICHAR +fir::ExtendedValue +IntrinsicLibrary::genIchar(mlir::Type resultType, + llvm::ArrayRef 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()) { + assert(charTy.singleton()); + charVal = buffer; + } else { + // Character is in memory, cast to fir.ref 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(loc, cast); + } + LLVM_DEBUG(llvm::dbgs() << "ichar(" << charVal << ")\n"); + auto code = helper.extractCodeFromSingleton(charVal); + return builder.create(loc, resultType, code); +} + // IEOR mlir::Value IntrinsicLibrary::genIeor(mlir::Type resultType, llvm::ArrayRef args) { diff --git a/flang/test/Lower/Intrinsics/ichar.f90 b/flang/test/Lower/Intrinsics/ichar.f90 new file mode 100644 index 0000000000000..5cf7fcdc3bae4 --- /dev/null +++ b/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.ref> + ! CHECK: %[[PTR:.*]] = fir.load %[[BOX]] : !fir.ref> + ! 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 + ! CHECK: %[[PTR1:.*]] = fir.coordinate_of %[[STR]], % + ! CHECK: %[[PTR2:.*]] = fir.load %[[PTR1]] : !fir.ref> + ! 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