diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -345,10 +345,16 @@ return builder.create(loc, fir::getBase(v)); }, [&](const fir::MutableBoxValue &box) -> fir::ExtendedValue { - TODO(loc, "genLoad for MutableBoxValue"); + return genLoad(builder, loc, + fir::factory::genMutableBoxRead(builder, loc, box)); }, [&](const fir::BoxValue &box) -> fir::ExtendedValue { - TODO(loc, "genLoad for BoxValue"); + if (box.isUnlimitedPolymorphic()) + fir::emitFatalError( + loc, + "lowering attempting to load an unlimited polymorphic entity"); + return genLoad(builder, loc, + fir::factory::readBoxValue(builder, loc, box)); }, [&](const auto &) -> fir::ExtendedValue { fir::emitFatalError( 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 @@ -110,6 +110,9 @@ static bool isAbsent(llvm::ArrayRef args, size_t argIndex) { return args.size() <= argIndex || isAbsent(args[argIndex]); } +static bool isAbsent(llvm::ArrayRef args, size_t argIndex) { + return args.size() <= argIndex || !args[argIndex]; +} /// Test if an ExtendedValue is present. static bool isPresent(const fir::ExtendedValue &exv) { return !isAbsent(exv); } @@ -437,9 +440,11 @@ fir::ExtendedValue genAdjustRtCall(mlir::Type, llvm::ArrayRef); mlir::Value genAimag(mlir::Type, llvm::ArrayRef); + mlir::Value genAint(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genAll(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genAllocated(mlir::Type, llvm::ArrayRef); + mlir::Value genAnint(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genAny(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genAssociated(mlir::Type, llvm::ArrayRef); @@ -452,12 +457,15 @@ template fir::ExtendedValue genCharacterCompare(mlir::Type, llvm::ArrayRef); + mlir::Value genCmplx(mlir::Type, llvm::ArrayRef); + mlir::Value genConjg(mlir::Type, llvm::ArrayRef); void genCpuTime(llvm::ArrayRef); fir::ExtendedValue genCshift(mlir::Type, llvm::ArrayRef); void genDateAndTime(llvm::ArrayRef); mlir::Value genDim(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genDotProduct(mlir::Type, llvm::ArrayRef); + mlir::Value genDprod(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genEoshift(mlir::Type, llvm::ArrayRef); void genExit(llvm::ArrayRef); mlir::Value genExponent(mlir::Type, llvm::ArrayRef); @@ -505,6 +513,7 @@ fir::ExtendedValue genScan(mlir::Type, llvm::ArrayRef); mlir::Value genSetExponent(mlir::Type resultType, llvm::ArrayRef args); + mlir::Value genSign(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genSize(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genSum(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genSpread(mlir::Type, llvm::ArrayRef); @@ -517,6 +526,10 @@ fir::ExtendedValue genUbound(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genUnpack(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genVerify(mlir::Type, llvm::ArrayRef); + /// Implement all conversion functions like DBLE, the first argument is + /// the value to convert. There may be an additional KIND arguments that + /// is ignored because this is already reflected in the result type. + mlir::Value genConversion(mlir::Type, llvm::ArrayRef); /// Define the different FIR generators that can be mapped to intrinsic to /// generate the related code. @@ -621,6 +634,7 @@ {{{"string", asAddr}}}, /*isElemental=*/true}, {"aimag", &I::genAimag}, + {"aint", &I::genAint}, {"all", &I::genAll, {{{"mask", asAddr}, {"dim", asValue}}}, @@ -629,6 +643,7 @@ &I::genAllocated, {{{"array", asInquired}, {"scalar", asInquired}}}, /*isElemental=*/false}, + {"anint", &I::genAnint}, {"any", &I::genAny, {{{"mask", asAddr}, {"dim", asValue}}}, @@ -640,7 +655,11 @@ {"btest", &I::genBtest}, {"ceiling", &I::genCeiling}, {"char", &I::genChar}, + {"cmplx", + &I::genCmplx, + {{{"x", asValue}, {"y", asValue, handleDynamicOptional}}}}, {"command_argument_count", &I::genCommandArgumentCount}, + {"conjg", &I::genConjg}, {"count", &I::genCount, {{{"mask", asAddr}, {"dim", asValue}, {"kind", asValue}}}, @@ -660,11 +679,13 @@ {"zone", asAddr, handleDynamicOptional}, {"values", asBox, handleDynamicOptional}}}, /*isElemental=*/false}, + {"dble", &I::genConversion}, {"dim", &I::genDim}, {"dot_product", &I::genDotProduct, {{{"vector_a", asBox}, {"vector_b", asBox}}}, /*isElemental=*/false}, + {"dprod", &I::genDprod}, {"eoshift", &I::genEoshift, {{{"array", asBox}, @@ -811,6 +832,7 @@ {"kind", asValue}}}, /*isElemental=*/true}, {"set_exponent", &I::genSetExponent}, + {"sign", &I::genSign}, {"size", &I::genSize, {{{"array", asBox}, @@ -928,6 +950,16 @@ return mlir::FunctionType::get(context, {t, t}, {t}); } +static mlir::FunctionType genF80F80F80FuncType(mlir::MLIRContext *context) { + auto t = mlir::FloatType::getF80(context); + return mlir::FunctionType::get(context, {t, t}, {t}); +} + +static mlir::FunctionType genF128F128F128FuncType(mlir::MLIRContext *context) { + auto t = mlir::FloatType::getF128(context); + return mlir::FunctionType::get(context, {t, t}, {t}); +} + template static mlir::FunctionType genIntF64FuncType(mlir::MLIRContext *context) { auto t = mlir::FloatType::getF64(context); @@ -948,6 +980,10 @@ static constexpr RuntimeFunction llvmIntrinsics[] = { {"abs", "llvm.fabs.f32", genF32F32FuncType}, {"abs", "llvm.fabs.f64", genF64F64FuncType}, + {"aint", "llvm.trunc.f32", genF32F32FuncType}, + {"aint", "llvm.trunc.f64", genF64F64FuncType}, + {"anint", "llvm.round.f32", genF32F32FuncType}, + {"anint", "llvm.round.f64", genF64F64FuncType}, // ceil is used for CEILING but is different, it returns a real. {"ceil", "llvm.ceil.f32", genF32F32FuncType}, {"ceil", "llvm.ceil.f64", genF64F64FuncType}, @@ -960,6 +996,10 @@ {"nint", "llvm.lround.i32.f32", genIntF32FuncType<32>}, {"pow", "llvm.pow.f32", genF32F32F32FuncType}, {"pow", "llvm.pow.f64", genF64F64F64FuncType}, + {"sign", "llvm.copysign.f32", genF32F32F32FuncType}, + {"sign", "llvm.copysign.f64", genF64F64F64FuncType}, + {"sign", "llvm.copysign.f80", genF80F80F80FuncType}, + {"sign", "llvm.copysign.f128", genF128F128F128FuncType}, }; // This helper class computes a "distance" between two function types. @@ -1611,6 +1651,13 @@ return getRuntimeCallGenerator(name, soughtFuncType)(builder, loc, args); } +mlir::Value IntrinsicLibrary::genConversion(mlir::Type resultType, + llvm::ArrayRef args) { + // There can be an optional kind in second argument. + assert(args.size() >= 1); + return builder.convertWithSemantics(loc, resultType, args[0]); +} + // ABS mlir::Value IntrinsicLibrary::genAbs(mlir::Type resultType, llvm::ArrayRef args) { @@ -1679,6 +1726,15 @@ args[0], true /* isImagPart */); } +// AINT +mlir::Value IntrinsicLibrary::genAint(mlir::Type resultType, + llvm::ArrayRef args) { + assert(args.size() >= 1 && args.size() <= 2); + // Skip optional kind argument to search the runtime; it is already reflected + // in result type. + return genRuntimeCall("aint", resultType, {args[0]}); +} + // ALL fir::ExtendedValue IntrinsicLibrary::genAll(mlir::Type resultType, @@ -1740,6 +1796,15 @@ }); } +// ANINT +mlir::Value IntrinsicLibrary::genAnint(mlir::Type resultType, + llvm::ArrayRef args) { + assert(args.size() >= 1 && args.size() <= 2); + // Skip optional kind argument to search the runtime; it is already reflected + // in result type. + return genRuntimeCall("anint", resultType, {args[0]}); +} + // ANY fir::ExtendedValue IntrinsicLibrary::genAny(mlir::Type resultType, @@ -1871,6 +1936,20 @@ return fir::CharBoxValue{cast, len}; } +// CMPLX +mlir::Value IntrinsicLibrary::genCmplx(mlir::Type resultType, + llvm::ArrayRef args) { + assert(args.size() >= 1); + fir::factory::Complex complexHelper(builder, loc); + mlir::Type partType = complexHelper.getComplexPartType(resultType); + mlir::Value real = builder.createConvert(loc, partType, args[0]); + mlir::Value imag = isAbsent(args, 1) + ? builder.createRealZeroConstant(loc, partType) + : builder.createConvert(loc, partType, args[1]); + return fir::factory::Complex{builder, loc}.createComplex(resultType, real, + imag); +} + // COMMAND_ARGUMENT_COUNT fir::ExtendedValue IntrinsicLibrary::genCommandArgumentCount( mlir::Type resultType, llvm::ArrayRef args) { @@ -1882,6 +1961,21 @@ ; } +// CONJG +mlir::Value IntrinsicLibrary::genConjg(mlir::Type resultType, + llvm::ArrayRef args) { + assert(args.size() == 1); + if (resultType != args[0].getType()) + llvm_unreachable("argument type mismatch"); + + mlir::Value cplx = args[0]; + auto imag = fir::factory::Complex{builder, loc}.extractComplexPart( + cplx, /*isImagPart=*/true); + auto negImag = builder.create(loc, imag); + return fir::factory::Complex{builder, loc}.insertComplexPart( + cplx, negImag, /*isImagPart=*/true); +} + // COUNT fir::ExtendedValue IntrinsicLibrary::genCount(mlir::Type resultType, @@ -2030,6 +2124,17 @@ return builder.create(loc, cmp, diff, zero); } +// DPROD +mlir::Value IntrinsicLibrary::genDprod(mlir::Type resultType, + llvm::ArrayRef args) { + assert(args.size() == 2); + assert(fir::isa_real(resultType) && + "Result must be double precision in DPROD"); + mlir::Value a = builder.createConvert(loc, resultType, args[0]); + mlir::Value b = builder.createConvert(loc, resultType, args[1]); + return builder.create(loc, a, b); +} + // DOT_PRODUCT fir::ExtendedValue IntrinsicLibrary::genDotProduct(mlir::Type resultType, @@ -3010,51 +3115,19 @@ fir::getBase(args[1]))); } -// SPREAD -fir::ExtendedValue -IntrinsicLibrary::genSpread(mlir::Type resultType, - llvm::ArrayRef args) { - - assert(args.size() == 3); - - // Handle source argument - mlir::Value source = builder.createBox(loc, args[0]); - fir::BoxValue sourceTmp = source; - unsigned sourceRank = sourceTmp.rank(); - - // Handle Dim argument - mlir::Value dim = fir::getBase(args[1]); - - // Handle ncopies argument - mlir::Value ncopies = fir::getBase(args[2]); - - // Generate result descriptor - mlir::Type resultArrayType = - builder.getVarLenSeqTy(resultType, sourceRank + 1); - fir::MutableBoxValue resultMutableBox = - fir::factory::createTempMutableBox(builder, loc, resultArrayType); - mlir::Value resultIrBox = - fir::factory::getMutableIRBox(builder, loc, resultMutableBox); - - fir::runtime::genSpread(builder, loc, resultIrBox, source, dim, ncopies); - - return readAndAddCleanUp(resultMutableBox, resultType, - "unexpected result for SPREAD"); -} - -// SUM -fir::ExtendedValue -IntrinsicLibrary::genSum(mlir::Type resultType, - llvm::ArrayRef args) { - return genProdOrSum(fir::runtime::genSum, fir::runtime::genSumDim, resultType, - builder, loc, stmtCtx, "unexpected result for Sum", args); -} - -// SYSTEM_CLOCK -void IntrinsicLibrary::genSystemClock(llvm::ArrayRef args) { - assert(args.size() == 3); - Fortran::lower::genSystemClock(builder, loc, fir::getBase(args[0]), - fir::getBase(args[1]), fir::getBase(args[2])); +// SIGN +mlir::Value IntrinsicLibrary::genSign(mlir::Type resultType, + llvm::ArrayRef args) { + assert(args.size() == 2); + if (resultType.isa()) { + mlir::Value abs = genAbs(resultType, {args[0]}); + mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0); + auto neg = builder.create(loc, zero, abs); + auto cmp = builder.create( + loc, mlir::arith::CmpIPredicate::slt, args[1], zero); + return builder.create(loc, cmp, neg, abs); + } + return genRuntimeCall("sign", resultType, args); } // SIZE @@ -3103,6 +3176,53 @@ .getResults()[0]; } +// SPREAD +fir::ExtendedValue +IntrinsicLibrary::genSpread(mlir::Type resultType, + llvm::ArrayRef args) { + + assert(args.size() == 3); + + // Handle source argument + mlir::Value source = builder.createBox(loc, args[0]); + fir::BoxValue sourceTmp = source; + unsigned sourceRank = sourceTmp.rank(); + + // Handle Dim argument + mlir::Value dim = fir::getBase(args[1]); + + // Handle ncopies argument + mlir::Value ncopies = fir::getBase(args[2]); + + // Generate result descriptor + mlir::Type resultArrayType = + builder.getVarLenSeqTy(resultType, sourceRank + 1); + fir::MutableBoxValue resultMutableBox = + fir::factory::createTempMutableBox(builder, loc, resultArrayType); + mlir::Value resultIrBox = + fir::factory::getMutableIRBox(builder, loc, resultMutableBox); + + fir::runtime::genSpread(builder, loc, resultIrBox, source, dim, ncopies); + + return readAndAddCleanUp(resultMutableBox, resultType, + "unexpected result for SPREAD"); +} + +// SUM +fir::ExtendedValue +IntrinsicLibrary::genSum(mlir::Type resultType, + llvm::ArrayRef args) { + return genProdOrSum(fir::runtime::genSum, fir::runtime::genSumDim, resultType, + builder, loc, stmtCtx, "unexpected result for Sum", args); +} + +// SYSTEM_CLOCK +void IntrinsicLibrary::genSystemClock(llvm::ArrayRef args) { + assert(args.size() == 3); + Fortran::lower::genSystemClock(builder, loc, fir::getBase(args[0]), + fir::getBase(args[1]), fir::getBase(args[2])); +} + // TRANSFER fir::ExtendedValue IntrinsicLibrary::genTransfer(mlir::Type resultType, diff --git a/flang/test/Lower/Intrinsics/aint.f90 b/flang/test/Lower/Intrinsics/aint.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/Intrinsics/aint.f90 @@ -0,0 +1,12 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! CHECK-LABEL: func @_QPaint_test( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref{{.*}}, %[[VAL_1:.*]]: !fir.ref{{.*}}) { +subroutine aint_test(a, b) +! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_0]] : !fir.ref +! CHECK: %[[VAL_3:.*]] = fir.call @llvm.trunc.f32(%[[VAL_2]]) : (f32) -> f32 +! CHECK: fir.store %[[VAL_3]] to %[[VAL_1]] : !fir.ref +! CHECK: return + real :: a, b + b = aint(a) +end subroutine diff --git a/flang/test/Lower/Intrinsics/anint.f90 b/flang/test/Lower/Intrinsics/anint.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/Intrinsics/anint.f90 @@ -0,0 +1,9 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! CHECK-LABEL: anint_test +subroutine anint_test(a, b) + real :: a, b + ! CHECK: fir.call @llvm.round.f32 + b = anint(a) +end subroutine + \ No newline at end of file diff --git a/flang/test/Lower/Intrinsics/cmplx.f90 b/flang/test/Lower/Intrinsics/cmplx.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/Intrinsics/cmplx.f90 @@ -0,0 +1,157 @@ +! This test focus on cmplx with Y argument that may turn out +! to be absent at runtime because it is an unallocated allocatable, +! a disassociated pointer, or an optional argument. +! CMPLX without such argument is re-written by the front-end as a +! complex constructor that is tested elsewhere. +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! CHECK-LABEL: func @_QPcmplx_test_scalar_ptr( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref +! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref>> +subroutine cmplx_test_scalar_ptr(x, y) + real :: x + real, pointer :: y + print *, cmplx(x, y) +! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_0]] : !fir.ref +! CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_1]] : !fir.ref>> +! CHECK: %[[VAL_9:.*]] = fir.box_addr %[[VAL_8]] : (!fir.box>) -> !fir.ptr +! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (!fir.ptr) -> i64 +! CHECK: %[[VAL_11:.*]] = arith.constant 0 : i64 +! CHECK: %[[VAL_12:.*]] = arith.cmpi ne, %[[VAL_10]], %[[VAL_11]] : i64 +! CHECK: %[[VAL_13:.*]] = fir.if %[[VAL_12]] -> (f32) { +! CHECK: %[[VAL_14:.*]] = fir.load %[[VAL_1]] : !fir.ref>> +! CHECK: %[[VAL_15:.*]] = fir.box_addr %[[VAL_14]] : (!fir.box>) -> !fir.ptr +! CHECK: %[[VAL_16:.*]] = fir.load %[[VAL_15]] : !fir.ptr +! CHECK: fir.result %[[VAL_16]] : f32 +! CHECK: } else { +! CHECK: %[[VAL_17:.*]] = arith.constant 0.000000e+00 : f32 +! CHECK: fir.result %[[VAL_17]] : f32 +! CHECK: } +! CHECK: %[[VAL_18:.*]] = fir.undefined !fir.complex<4> +! CHECK: %[[VAL_19:.*]] = fir.insert_value %[[VAL_18]], %[[VAL_7]], [0 : index] : (!fir.complex<4>, f32) -> !fir.complex<4> +! CHECK: fir.insert_value %[[VAL_19]], %[[VAL_21:.*]], [1 : index] : (!fir.complex<4>, f32) -> !fir.complex<4> +end subroutine + +! CHECK-LABEL: func @_QPcmplx_test_scalar_optional( +! CHECK-SAME: %[[VAL_0:[^:]*]]: !fir.ref +! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref +subroutine cmplx_test_scalar_optional(x, y) + real :: x + real, optional :: y + print *, cmplx(x, y) +! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_0]] : !fir.ref +! CHECK: %[[VAL_8:.*]] = fir.is_present %[[VAL_1]] : (!fir.ref) -> i1 +! CHECK: %[[VAL_9:.*]] = fir.if %[[VAL_8]] -> (f32) { +! CHECK: %[[VAL_10:.*]] = fir.load %[[VAL_1]] : !fir.ref +! CHECK: fir.result %[[VAL_10]] : f32 +! CHECK: } else { +! CHECK: %[[VAL_11:.*]] = arith.constant 0.000000e+00 : f32 +! CHECK: fir.result %[[VAL_11]] : f32 +! CHECK: } +! CHECK: %[[VAL_12:.*]] = fir.undefined !fir.complex<4> +! CHECK: %[[VAL_13:.*]] = fir.insert_value %[[VAL_12]], %[[VAL_7]], [0 : index] : (!fir.complex<4>, f32) -> !fir.complex<4> +! CHECK: fir.insert_value %[[VAL_13]], %[[VAL_15:.*]], [1 : index] : (!fir.complex<4>, f32) -> !fir.complex<4> +end subroutine + +! CHECK-LABEL: func @_QPcmplx_test_scalar_alloc_optional( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref +! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref>> +subroutine cmplx_test_scalar_alloc_optional(x, y) + real :: x + integer(8), allocatable, optional :: y + print *, cmplx(x, y) +! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_0]] : !fir.ref +! CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_1]] : !fir.ref>> +! CHECK: %[[VAL_9:.*]] = fir.box_addr %[[VAL_8]] : (!fir.box>) -> !fir.heap +! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (!fir.heap) -> i64 +! CHECK: %[[VAL_11:.*]] = arith.constant 0 : i64 +! CHECK: %[[VAL_12:.*]] = arith.cmpi ne, %[[VAL_10]], %[[VAL_11]] : i64 +! CHECK: %[[VAL_13:.*]] = fir.if %[[VAL_12]] -> (i64) { +! CHECK: %[[VAL_14:.*]] = fir.load %[[VAL_1]] : !fir.ref>> +! CHECK: %[[VAL_15:.*]] = fir.box_addr %[[VAL_14]] : (!fir.box>) -> !fir.heap +! CHECK: %[[VAL_16:.*]] = fir.load %[[VAL_15]] : !fir.heap +! CHECK: fir.result %[[VAL_16]] : i64 +! CHECK: } else { +! CHECK: %[[VAL_17:.*]] = arith.constant 0 : i64 +! CHECK: fir.result %[[VAL_17]] : i64 +! CHECK: } +! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_19:.*]] : (i64) -> f32 +! CHECK: %[[VAL_20:.*]] = fir.undefined !fir.complex<4> +! CHECK: %[[VAL_21:.*]] = fir.insert_value %[[VAL_20]], %[[VAL_7]], [0 : index] : (!fir.complex<4>, f32) -> !fir.complex<4> +! CHECK: fir.insert_value %[[VAL_21]], %[[VAL_18]], [1 : index] : (!fir.complex<4>, f32) -> !fir.complex<4> +end subroutine + +! CHECK-LABEL: func @_QPcmplx_test_pointer_result( +! CHECK-SAME: %[[VAL_0:[^:]*]]: !fir.ref +! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref +subroutine cmplx_test_pointer_result(x, y) + real :: x + interface + function return_pointer() + real, pointer :: return_pointer + end function + end interface + print *, cmplx(x, return_pointer()) +! CHECK: %[[VAL_9:.*]] = fir.call @_QPreturn_pointer() : () -> !fir.box> +! CHECK: fir.save_result %[[VAL_9]] to %[[VAL_2:.*]] : !fir.box>, !fir.ref>> +! CHECK: %[[VAL_10:.*]] = fir.load %[[VAL_2]] : !fir.ref>> +! CHECK: %[[VAL_11:.*]] = fir.box_addr %[[VAL_10]] : (!fir.box>) -> !fir.ptr +! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (!fir.ptr) -> i64 +! CHECK: %[[VAL_13:.*]] = arith.constant 0 : i64 +! CHECK: %[[VAL_14:.*]] = arith.cmpi ne, %[[VAL_12]], %[[VAL_13]] : i64 +! CHECK: %[[VAL_15:.*]] = fir.if %[[VAL_14]] -> (f32) { +! CHECK: %[[VAL_16:.*]] = fir.load %[[VAL_2]] : !fir.ref>> +! CHECK: %[[VAL_17:.*]] = fir.box_addr %[[VAL_16]] : (!fir.box>) -> !fir.ptr +! CHECK: %[[VAL_18:.*]] = fir.load %[[VAL_17]] : !fir.ptr +! CHECK: fir.result %[[VAL_18]] : f32 +! CHECK: } else { +! CHECK: %[[VAL_19:.*]] = arith.constant 0.000000e+00 : f32 +! CHECK: fir.result %[[VAL_19]] : f32 +! CHECK: } +! CHECK: %[[VAL_20:.*]] = fir.undefined !fir.complex<4> +! CHECK: %[[VAL_21:.*]] = fir.insert_value %[[VAL_20]], %[[VAL_8]], [0 : index] : (!fir.complex<4>, f32) -> !fir.complex<4> +! CHECK: fir.insert_value %[[VAL_21]], %[[VAL_23:.*]], [1 : index] : (!fir.complex<4>, f32) -> !fir.complex<4> +end subroutine + +! CHECK-LABEL: func @_QPcmplx_array( +! CHECK-SAME: %[[VAL_0:[^:]*]]: !fir.box> +! CHECK-SAME: %[[VAL_1:.*]]: !fir.box> +subroutine cmplx_array(x, y) + ! Important, note that the shape is taken from `x` and not `y` that + ! may be absent. + real :: x(:) + real, optional :: y(:) + print *, cmplx(x, y) +! CHECK: %[[VAL_7:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_8:.*]]:3 = fir.box_dims %[[VAL_0]], %[[VAL_7]] : (!fir.box>, index) -> (index, index, index) +! CHECK: %[[VAL_9:.*]] = fir.array_load %[[VAL_0]] : (!fir.box>) -> !fir.array +! CHECK: %[[VAL_10:.*]] = fir.is_present %[[VAL_1]] : (!fir.box>) -> i1 +! CHECK: %[[VAL_11:.*]] = fir.zero_bits !fir.ref> +! CHECK: %[[VAL_12:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_13:.*]] = fir.shape %[[VAL_12]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_14:.*]] = fir.embox %[[VAL_11]](%[[VAL_13]]) : (!fir.ref>, !fir.shape<1>) -> !fir.box> +! CHECK: %[[VAL_15:.*]] = arith.select %[[VAL_10]], %[[VAL_1]], %[[VAL_14]] : !fir.box> +! CHECK: %[[VAL_16:.*]] = fir.array_load %[[VAL_15]] {fir.optional} : (!fir.box>) -> !fir.array +! CHECK: %[[VAL_17:.*]] = fir.allocmem !fir.array>, %[[VAL_8]]#1 {uniq_name = ".array.expr"} +! CHECK: %[[VAL_18:.*]] = fir.shape %[[VAL_8]]#1 : (index) -> !fir.shape<1> +! CHECK: %[[VAL_19:.*]] = fir.array_load %[[VAL_17]](%[[VAL_18]]) : (!fir.heap>>, !fir.shape<1>) -> !fir.array> +! CHECK: %[[VAL_20:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_21:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_22:.*]] = arith.subi %[[VAL_8]]#1, %[[VAL_20]] : index +! CHECK: %[[VAL_23:.*]] = fir.do_loop %[[VAL_24:.*]] = %[[VAL_21]] to %[[VAL_22]] step %[[VAL_20]] unordered iter_args(%[[VAL_25:.*]] = %[[VAL_19]]) -> (!fir.array>) { + ! CHECK: %[[VAL_26:.*]] = fir.array_fetch %[[VAL_9]], %[[VAL_24]] : (!fir.array, index) -> f32 + ! CHECK: %[[VAL_27:.*]] = fir.if %[[VAL_10]] -> (f32) { + ! CHECK: %[[VAL_28:.*]] = fir.array_fetch %[[VAL_16]], %[[VAL_24]] : (!fir.array, index) -> f32 + ! CHECK: fir.result %[[VAL_28]] : f32 + ! CHECK: } else { + ! CHECK: %[[VAL_29:.*]] = arith.constant 0.000000e+00 : f32 + ! CHECK: fir.result %[[VAL_29]] : f32 + ! CHECK: } + ! CHECK: %[[VAL_30:.*]] = fir.undefined !fir.complex<4> + ! CHECK: %[[VAL_31:.*]] = fir.insert_value %[[VAL_30]], %[[VAL_26]], [0 : index] : (!fir.complex<4>, f32) -> !fir.complex<4> + ! CHECK: %[[VAL_32:.*]] = fir.insert_value %[[VAL_31]], %[[VAL_33:.*]], [1 : index] : (!fir.complex<4>, f32) -> !fir.complex<4> + ! CHECK: %[[VAL_34:.*]] = fir.array_update %[[VAL_25]], %[[VAL_32]], %[[VAL_24]] : (!fir.array>, !fir.complex<4>, index) -> !fir.array> + ! CHECK: fir.result %[[VAL_34]] : !fir.array> +! CHECK: } +! CHECK: fir.array_merge_store +end subroutine diff --git a/flang/test/Lower/Intrinsics/conjg.f90 b/flang/test/Lower/Intrinsics/conjg.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/Intrinsics/conjg.f90 @@ -0,0 +1,10 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! CHECK-LABEL: conjg_test +subroutine conjg_test(z1, z2) + complex :: z1, z2 + ! CHECK: fir.extract_value + ! CHECK: negf + ! CHECK: fir.insert_value + z2 = conjg(z1) +end subroutine diff --git a/flang/test/Lower/Intrinsics/dble.f90 b/flang/test/Lower/Intrinsics/dble.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/Intrinsics/dble.f90 @@ -0,0 +1,8 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! CHECK-LABEL: dble_test +subroutine dble_test(a) + real :: a + ! CHECK: fir.convert {{.*}} : (f32) -> f64 + print *, dble(a) +end subroutine diff --git a/flang/test/Lower/Intrinsics/dprod.f90 b/flang/test/Lower/Intrinsics/dprod.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/Intrinsics/dprod.f90 @@ -0,0 +1,14 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! CHECK-LABEL: dprod_test +subroutine dprod_test (x, y, z) + real :: x,y + double precision :: z + z = dprod(x,y) + ! CHECK-DAG: %[[x:.*]] = fir.load %arg0 + ! CHECK-DAG: %[[y:.*]] = fir.load %arg1 + ! CHECK-DAG: %[[a:.*]] = fir.convert %[[x]] : (f32) -> f64 + ! CHECK-DAG: %[[b:.*]] = fir.convert %[[y]] : (f32) -> f64 + ! CHECK: %[[res:.*]] = arith.mulf %[[a]], %[[b]] + ! CHECK: fir.store %[[res]] to %arg2 +end subroutine diff --git a/flang/test/Lower/Intrinsics/sign.f90 b/flang/test/Lower/Intrinsics/sign.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/Intrinsics/sign.f90 @@ -0,0 +1,29 @@ +! RUN: bbc %s -o - | FileCheck %s + +! CHECK-LABEL: sign_testi +subroutine sign_testi(a, b, c) + integer a, b, c + ! CHECK: %[[VAL_1:.*]] = arith.shrsi %{{.*}}, %{{.*}} : i32 + ! CHECK: %[[VAL_2:.*]] = arith.xori %{{.*}}, %[[VAL_1]] : i32 + ! CHECK: %[[VAL_3:.*]] = arith.subi %[[VAL_2]], %[[VAL_1]] : i32 + ! CHECK-DAG: %[[VAL_4:.*]] = arith.subi %{{.*}}, %[[VAL_3]] : i32 + ! CHECK-DAG: %[[VAL_5:.*]] = arith.cmpi slt, %{{.*}}, %{{.*}} : i32 + ! CHECK: select %[[VAL_5]], %[[VAL_4]], %[[VAL_3]] : i32 + c = sign(a, b) +end subroutine + +! CHECK-LABEL: sign_testr +subroutine sign_testr(a, b, c) + real a, b, c + ! CHECK-NOT: fir.call @{{.*}}fabs + ! CHECK: fir.call @{{.*}}copysign{{.*}} : (f32, f32) -> f32 + c = sign(a, b) +end subroutine + +! CHECK-LABEL: sign_testr2 +subroutine sign_testr2(a, b, c) + real(KIND=16) a, b, c + ! CHECK-NOT: fir.call @{{.*}}fabs + ! CHECK: fir.call @{{.*}}copysign{{.*}} : (f128, f128) -> f128 + c = sign(a, b) +end subroutine