diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp --- a/flang/lib/Lower/IntrinsicCall.cpp +++ b/flang/lib/Lower/IntrinsicCall.cpp @@ -24,6 +24,7 @@ #include "flang/Optimizer/Builder/Complex.h" #include "flang/Optimizer/Builder/FIRBuilder.h" #include "flang/Optimizer/Builder/MutableBox.h" +#include "flang/Optimizer/Builder/Runtime/Character.h" #include "flang/Optimizer/Builder/Runtime/Inquiry.h" #include "flang/Optimizer/Builder/Runtime/RTBuilder.h" #include "flang/Optimizer/Builder/Runtime/Reduction.h" @@ -275,6 +276,9 @@ mlir::Value genDim(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genDotProduct(mlir::Type, llvm::ArrayRef); + template + fir::ExtendedValue genCharacterCompare(mlir::Type, + llvm::ArrayRef); template mlir::Value genExtremum(mlir::Type, llvm::ArrayRef); /// Lowering for the IAND intrinsic. The IAND intrinsic expects two arguments @@ -283,6 +287,8 @@ mlir::Value genIbits(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genLbound(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genNull(mlir::Type, llvm::ArrayRef); + fir::ExtendedValue genLen(mlir::Type, llvm::ArrayRef); + fir::ExtendedValue genLenTrim(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genSize(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genSum(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genUbound(mlir::Type, llvm::ArrayRef); @@ -352,6 +358,9 @@ // The following may be omitted in the table below. Fortran::lower::IntrinsicArgumentLoweringRules argLoweringRules = {}; bool isElemental = true; + /// Code heavy intrinsic can be outlined to make FIR + /// more readable. + bool outline = false; }; constexpr auto asValue = Fortran::lower::LowerIntrinsicArgAs::Value; @@ -399,6 +408,15 @@ /*isElemental=*/false}, {"iand", &I::genIand}, {"ibits", &I::genIbits}, + {"len", + &I::genLen, + {{{"string", asInquired}, {"kind", asValue}}}, + /*isElemental=*/false}, + {"len_trim", &I::genLenTrim}, + {"lge", &I::genCharacterCompare}, + {"lgt", &I::genCharacterCompare}, + {"lle", &I::genCharacterCompare}, + {"llt", &I::genCharacterCompare}, {"min", &I::genExtremum}, {"null", &I::genNull, {{{"mold", asInquired}}}, /*isElemental=*/false}, {"sum", @@ -423,6 +441,14 @@ : nullptr; } +/// To make fir output more readable for debug, one can outline all intrinsic +/// implementation in wrappers (overrides the IntrinsicHandler::outline flag). +static llvm::cl::opt outlineAllIntrinsics( + "outline-intrinsics", + llvm::cl::desc( + "Lower all intrinsic procedure implementation in their own functions"), + llvm::cl::init(false)); + //===----------------------------------------------------------------------===// // Math runtime description and matching utility //===----------------------------------------------------------------------===// @@ -861,7 +887,7 @@ llvm::Optional resultType, llvm::ArrayRef args) { if (const IntrinsicHandler *handler = findIntrinsicHandler(name)) { - bool outline = false; + bool outline = handler->outline || outlineAllIntrinsics; return std::visit( [&](auto &generator) -> fir::ExtendedValue { return invokeHandler(generator, *handler, resultType, args, outline, @@ -1350,6 +1376,43 @@ return builder.create(loc, lenIsZero, zero, res2); } +// LEN +// Note that this is only used for an unrestricted intrinsic LEN call. +// Other uses of LEN are rewritten as descriptor inquiries by the front-end. +fir::ExtendedValue +IntrinsicLibrary::genLen(mlir::Type resultType, + llvm::ArrayRef args) { + // Optional KIND argument reflected in result type and otherwise ignored. + assert(args.size() == 1 || args.size() == 2); + mlir::Value len = fir::factory::readCharLen(builder, loc, args[0]); + return builder.createConvert(loc, resultType, len); +} + +// LEN_TRIM +fir::ExtendedValue +IntrinsicLibrary::genLenTrim(mlir::Type resultType, + llvm::ArrayRef args) { + // Optional KIND argument reflected in result type and otherwise ignored. + assert(args.size() == 1 || args.size() == 2); + const fir::CharBoxValue *charBox = args[0].getCharBox(); + if (!charBox) + TODO(loc, "character array len_trim"); + auto len = + fir::factory::CharacterExprHelper(builder, loc).createLenTrim(*charBox); + return builder.createConvert(loc, resultType, len); +} + +// LGE, LGT, LLE, LLT +template +fir::ExtendedValue +IntrinsicLibrary::genCharacterCompare(mlir::Type type, + llvm::ArrayRef args) { + assert(args.size() == 2); + return fir::runtime::genCharCompare( + builder, loc, pred, fir::getBase(args[0]), fir::getLen(args[0]), + fir::getBase(args[1]), fir::getLen(args[1])); +} + // Compare two FIR values and return boolean result as i1. template static mlir::Value createExtremumCompare(mlir::Location loc, diff --git a/flang/lib/Optimizer/Builder/FIRBuilder.cpp b/flang/lib/Optimizer/Builder/FIRBuilder.cpp --- a/flang/lib/Optimizer/Builder/FIRBuilder.cpp +++ b/flang/lib/Optimizer/Builder/FIRBuilder.cpp @@ -543,10 +543,9 @@ return fir::factory::CharacterExprHelper{builder, loc} .readLengthFromBox(x.getAddr()); }, - [&](const fir::MutableBoxValue &) -> mlir::Value { - // MutableBoxValue must be read into another category to work with them - // outside of allocation/assignment contexts. - fir::emitFatalError(loc, "readCharLen on MutableBoxValue"); + [&](const fir::MutableBoxValue &x) -> mlir::Value { + return readCharLen(builder, loc, + fir::factory::genMutableBoxRead(builder, loc, x)); }, [&](const auto &) -> mlir::Value { fir::emitFatalError( diff --git a/flang/test/Lower/Intrinsics/len.f90 b/flang/test/Lower/Intrinsics/len.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/Intrinsics/len.f90 @@ -0,0 +1,76 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! CHECK-LABEL: len_test +subroutine len_test(i, c) + integer :: i + character(*) :: c + ! CHECK: %[[c:.*]]:2 = fir.unboxchar %arg1 + ! CHECK: %[[xx:.*]] = fir.convert %[[c]]#1 : (index) -> i32 + ! CHECK: fir.store %[[xx]] to %arg0 + i = len(c) + end subroutine + + ! CHECK-LABEL: len_test_array + ! CHECK-SAME: %[[arg0:.*]]: !fir.ref {fir.bindc_name = "i"}, %[[arg1:.*]]: !fir.boxchar<1> {fir.bindc_name = "c"} + subroutine len_test_array(i, c) + integer :: i + character(*) :: c(100) + ! CHECK: %[[c:.*]]:2 = fir.unboxchar %[[arg1]] + ! CHECK: %[[xx:.*]] = fir.convert %[[c]]#1 : (index) -> i32 + ! CHECK: fir.store %[[xx]] to %[[arg0]] + i = len(c) + end subroutine + + ! CHECK-LABEL: func @_QPlen_test_assumed_shape_array( + ! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref {fir.bindc_name = "i"}, + ! CHECK-SAME: %[[VAL_1:.*]]: !fir.box>> {fir.bindc_name = "c"}) { + subroutine len_test_assumed_shape_array(i, c) + integer :: i + character(*) :: c(:) + ! CHECK: %[[VAL_2:.*]] = fir.box_elesize %[[VAL_1]] : (!fir.box>>) -> index + ! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (index) -> i32 + ! CHECK: fir.store %[[VAL_3]] to %[[VAL_0]] : !fir.ref + i = len(c) + end subroutine + + ! CHECK-LABEL: func @_QPlen_test_array_alloc( + ! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref {fir.bindc_name = "i"}, + ! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref>>>> {fir.bindc_name = "c"}) { + subroutine len_test_array_alloc(i, c) + integer :: i + character(:), allocatable :: c(:) + ! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_1]] : !fir.ref>>>> + ! CHECK: %[[VAL_3:.*]] = fir.box_elesize %[[VAL_2]] : (!fir.box>>>) -> index + ! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (index) -> i32 + ! CHECK: fir.store %[[VAL_4]] to %[[VAL_0]] : !fir.ref + i = len(c) + end subroutine + + ! CHECK-LABEL: func @_QPlen_test_array_local_alloc( + ! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref {fir.bindc_name = "i"}) + subroutine len_test_array_local_alloc(i) + integer :: i + character(:), allocatable :: c(:) + ! CHECK: %[[VAL_5:.*]] = fir.alloca index {uniq_name = "_QFlen_test_array_local_allocEc.len"} + ! CHECK: %[[VAL_7:.*]] = arith.constant 10 : i32 + ! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_7]] : (i32) -> index + ! CHECK: fir.store %[[VAL_10]] to %[[VAL_5]] : !fir.ref + allocate(character(10):: c(100)) + ! CHECK: %[[VAL_13:.*]] = fir.load %[[VAL_5]] : !fir.ref + ! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_13]] : (index) -> i32 + ! CHECK: fir.store %[[VAL_14]] to %[[VAL_0]] : !fir.ref + i = len(c) + end subroutine + + ! CHECK-LABEL: func @_QPlen_test_alloc_explicit_len( + ! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref {fir.bindc_name = "i"}, + ! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref {fir.bindc_name = "n"}, + ! CHECK-SAME: %[[VAL_2:.*]]: !fir.ref>>>> {fir.bindc_name = "c"}) { + subroutine len_test_alloc_explicit_len(i, n, c) + integer :: i + integer :: n + character(n), allocatable :: c(:) + ! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_1]] : !fir.ref + ! CHECK: fir.store %[[VAL_3]] to %[[VAL_0]] : !fir.ref + i = len(c) + end subroutine diff --git a/flang/test/Lower/Intrinsics/len_trim.f90 b/flang/test/Lower/Intrinsics/len_trim.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/Intrinsics/len_trim.f90 @@ -0,0 +1,20 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! CHECK-LABEL: len_trim_test +integer function len_trim_test(c) +character(*) :: c +ltrim = len_trim(c) +! CHECK-DAG: %[[c0:.*]] = arith.constant 0 : index +! CHECK-DAG: %[[c1:.*]] = arith.constant 1 : index +! CHECK-DAG: %[[cm1:.*]] = arith.constant -1 : index +! CHECK-DAG: %[[lastChar:.*]] = arith.subi {{.*}}, %[[c1]] +! CHECK: %[[iterateResult:.*]]:2 = fir.iterate_while (%[[index:.*]] = %[[lastChar]] to %[[c0]] step %[[cm1]]) and ({{.*}}) iter_args({{.*}}) { + ! CHECK: %[[addr:.*]] = fir.coordinate_of {{.*}}, %[[index]] + ! CHECK: %[[codeAddr:.*]] = fir.convert %[[addr]] + ! CHECK: %[[code:.*]] = fir.load %[[codeAddr]] + ! CHECK: %[[bool:.*]] = arith.cmpi eq + ! CHECK: fir.result %[[bool]], %[[index]] +! CHECK: } +! CHECK: %[[len:.*]] = arith.addi %[[iterateResult]]#1, %[[c1]] +! CHECK: select %[[iterateResult]]#0, %[[c0]], %[[len]] +end function diff --git a/flang/test/Lower/Intrinsics/lge_lgt_lle_llt.f90 b/flang/test/Lower/Intrinsics/lge_lgt_lle_llt.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/Intrinsics/lge_lgt_lle_llt.f90 @@ -0,0 +1,33 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +subroutine lge_test + character*3 :: c1(3) + character*7 :: c2(3) + ! c1(1) = 'a'; c1(2) = 'B'; c1(3) = 'c'; + ! c2(1) = 'A'; c2(2) = 'b'; c2(3) = 'c'; + ! CHECK: BeginExternalListOutput + ! CHECK: fir.do_loop + ! CHECK: CharacterCompareScalar1 + ! CHECK: OutputDescriptor + ! CHECK: EndIoStatement + print*, lge(c1, c2) + ! CHECK: BeginExternalListOutput + ! CHECK: fir.do_loop + ! CHECK: CharacterCompareScalar1 + ! CHECK: OutputDescriptor + ! CHECK: EndIoStatement + print*, lgt(c1, c2) + ! CHECK: BeginExternalListOutput + ! CHECK: fir.do_loop + ! CHECK: CharacterCompareScalar1 + ! CHECK: OutputDescriptor + ! CHECK: EndIoStatement + print*, lle(c1, c2) + ! CHECK: BeginExternalListOutput + ! CHECK: fir.do_loop + ! CHECK: CharacterCompareScalar1 + ! CHECK: OutputDescriptor + ! CHECK: EndIoStatement + print*, llt(c1, c2) + end + \ No newline at end of file