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 @@ -197,6 +197,34 @@ args[1], mask, rank); } +/// Process calls to DotProduct +template +static fir::ExtendedValue +genDotProd(FN func, mlir::Type resultType, fir::FirOpBuilder &builder, + mlir::Location loc, Fortran::lower::StatementContext *stmtCtx, + llvm::ArrayRef args) { + + assert(args.size() == 2); + + // Handle required vector arguments + mlir::Value vectorA = fir::getBase(args[0]); + mlir::Value vectorB = fir::getBase(args[1]); + + mlir::Type eleTy = fir::dyn_cast_ptrOrBoxEleTy(vectorA.getType()) + .cast() + .getEleTy(); + if (fir::isa_complex(eleTy)) { + mlir::Value result = builder.createTemporary(loc, eleTy); + func(builder, loc, vectorA, vectorB, result); + return builder.create(loc, result); + } + + auto resultBox = builder.create( + loc, fir::BoxType::get(builder.getI1Type())); + return func(builder, loc, vectorA, vectorB, resultBox); +} + + // TODO error handling -> return a code or directly emit messages ? struct IntrinsicLibrary { @@ -240,6 +268,8 @@ fir::ExtendedValue genAssociated(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genChar(mlir::Type, llvm::ArrayRef); + fir::ExtendedValue genDotProduct(mlir::Type, + llvm::ArrayRef); template mlir::Value genExtremum(mlir::Type, llvm::ArrayRef); /// Lowering for the IAND intrinsic. The IAND intrinsic expects two arguments @@ -351,6 +381,10 @@ {{{"pointer", asInquired}, {"target", asInquired}}}, /*isElemental=*/false}, {"char", &I::genChar}, + {"dot_product", + &I::genDotProduct, + {{{"vector_a", asBox}, {"vector_b", asBox}}}, + /*isElemental=*/false}, {"iand", &I::genIand}, {"min", &I::genExtremum}, {"sum", @@ -1226,6 +1260,14 @@ return fir::CharBoxValue{cast, len}; } +// DOT_PRODUCT +fir::ExtendedValue +IntrinsicLibrary::genDotProduct(mlir::Type resultType, + llvm::ArrayRef args) { + return genDotProd(fir::runtime::genDotProduct, resultType, builder, loc, + stmtCtx, args); +} + // IAND mlir::Value IntrinsicLibrary::genIand(mlir::Type resultType, llvm::ArrayRef args) { diff --git a/flang/test/Lower/Intrinsics/dot_product.f90 b/flang/test/Lower/Intrinsics/dot_product.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/Intrinsics/dot_product.f90 @@ -0,0 +1,247 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s +! RUN: %flang_fc1 -emit-fir %s -o - | FileCheck %s + +! DOT_PROD +! CHECK-LABEL: dot_prod_int_default +! CHECK-SAME: %[[x:arg0]]: !fir.box> +! CHECK-SAME: %[[y:arg1]]: !fir.box> +! CHECK-SAME: %[[z:arg2]]: !fir.box> +subroutine dot_prod_int_default (x, y, z) + integer, dimension(1:) :: x,y + integer, dimension(1:) :: z + ! CHECK-DAG: %[[x_conv:.*]] = fir.convert %[[x]] : (!fir.box>) -> !fir.box + ! CHECK-DAG: %[[y_conv:.*]] = fir.convert %[[y]] : (!fir.box>) -> !fir.box + ! CHECK-DAG: %[[res:.*]] = fir.call @_FortranADotProductInteger4(%[[x_conv]], %[[y_conv]], %{{[0-9]+}}, %{{.*}}) : (!fir.box, !fir.box, !fir.ref, i32) -> i32 + z = dot_product(x,y) +end subroutine + +! CHECK-LABEL: dot_prod_int_kind_1 +! CHECK-SAME: %[[x:arg0]]: !fir.box> +! CHECK-SAME: %[[y:arg1]]: !fir.box> +! CHECK-SAME: %[[z:arg2]]: !fir.box> +subroutine dot_prod_int_kind_1 (x, y, z) + integer(kind=1), dimension(1:) :: x,y + integer(kind=1), dimension(1:) :: z + ! CHECK-DAG: %[[x_conv:.*]] = fir.convert %[[x]] : (!fir.box>) -> !fir.box + ! CHECK-DAG: %[[y_conv:.*]] = fir.convert %[[y]] : (!fir.box>) -> !fir.box + ! CHECK-DAG: %[[res:.*]] = fir.call @_FortranADotProductInteger1(%[[x_conv]], %[[y_conv]], %{{[0-9]+}}, %{{.*}}) : (!fir.box, !fir.box, !fir.ref, i32) -> i8 + z = dot_product(x,y) +end subroutine + +! CHECK-LABEL: dot_prod_int_kind_2 +! CHECK-SAME: %[[x:arg0]]: !fir.box> +! CHECK-SAME: %[[y:arg1]]: !fir.box> +! CHECK-SAME: %[[z:arg2]]: !fir.box> +subroutine dot_prod_int_kind_2 (x, y, z) + integer(kind=2), dimension(1:) :: x,y + integer(kind=2), dimension(1:) :: z + ! CHECK-DAG: %[[x_conv:.*]] = fir.convert %[[x]] : (!fir.box>) -> !fir.box + ! CHECK-DAG: %[[y_conv:.*]] = fir.convert %[[y]] : (!fir.box>) -> !fir.box + ! CHECK-DAG: %[[res:.*]] = fir.call @_FortranADotProductInteger2(%[[x_conv]], %[[y_conv]], %{{[0-9]+}}, %{{.*}}) : (!fir.box, !fir.box, !fir.ref, i32) -> i16 + z = dot_product(x,y) +end subroutine + +! CHECK-LABEL: dot_prod_int_kind_4 +! CHECK-SAME: %[[x:arg0]]: !fir.box> +! CHECK-SAME: %[[y:arg1]]: !fir.box> +! CHECK-SAME: %[[z:arg2]]: !fir.box> +subroutine dot_prod_int_kind_4 (x, y, z) + integer(kind=4), dimension(1:) :: x,y + integer(kind=4), dimension(1:) :: z + ! CHECK-DAG: %[[x_conv:.*]] = fir.convert %[[x]] : (!fir.box>) -> !fir.box + ! CHECK-DAG: %[[y_conv:.*]] = fir.convert %[[y]] : (!fir.box>) -> !fir.box + ! CHECK-DAG: %[[res:.*]] = fir.call @_FortranADotProductInteger4(%[[x_conv]], %[[y_conv]], %{{[0-9]+}}, %{{.*}}) : (!fir.box, !fir.box, !fir.ref, i32) -> i32 + z = dot_product(x,y) +end subroutine + +! CHECK-LABEL: dot_prod_int_kind_8 +! CHECK-SAME: %[[x:arg0]]: !fir.box> +! CHECK-SAME: %[[y:arg1]]: !fir.box> +! CHECK-SAME: %[[z:arg2]]: !fir.box> +subroutine dot_prod_int_kind_8 (x, y, z) + integer(kind=8), dimension(1:) :: x,y + integer(kind=8), dimension(1:) :: z + ! CHECK-DAG: %[[x_conv:.*]] = fir.convert %[[x]] : (!fir.box>) -> !fir.box + ! CHECK-DAG: %[[y_conv:.*]] = fir.convert %[[y]] : (!fir.box>) -> !fir.box + ! CHECK-DAG: %[[res:.*]] = fir.call @_FortranADotProductInteger8(%[[x_conv]], %[[y_conv]], %{{[0-9]+}}, %{{.*}}) : (!fir.box, !fir.box, !fir.ref, i32) -> i64 + z = dot_product(x,y) +end subroutine + +! CHECK-LABEL: dot_prod_int_kind_16 +! CHECK-SAME: %[[x:arg0]]: !fir.box> +! CHECK-SAME: %[[y:arg1]]: !fir.box> +! CHECK-SAME: %[[z:arg2]]: !fir.box> +subroutine dot_prod_int_kind_16 (x, y, z) + integer(kind=16), dimension(1:) :: x,y + integer(kind=16), dimension(1:) :: z + ! CHECK-DAG: %[[x_conv:.*]] = fir.convert %[[x]] : (!fir.box>) -> !fir.box + ! CHECK-DAG: %[[y_conv:.*]] = fir.convert %[[y]] : (!fir.box>) -> !fir.box + ! CHECK-DAG: %[[res:.*]] = fir.call @_FortranADotProductInteger16(%[[x_conv]], %[[y_conv]], %{{[0-9]+}}, %{{.*}}) : (!fir.box, !fir.box, !fir.ref, i32) -> i128 + z = dot_product(x,y) +end subroutine + +! CHECK-LABEL: dot_prod_real_kind_default +! CHECK-SAME: %[[x:arg0]]: !fir.box> +! CHECK-SAME: %[[y:arg1]]: !fir.box> +! CHECK-SAME: %[[z:arg2]]: !fir.box> +subroutine dot_prod_real_kind_default (x, y, z) + real, dimension(1:) :: x,y + real, dimension(1:) :: z + ! CHECK-DAG: %[[x_conv:.*]] = fir.convert %[[x]] : (!fir.box>) -> !fir.box + ! CHECK-DAG: %[[y_conv:.*]] = fir.convert %[[y]] : (!fir.box>) -> !fir.box + ! CHECK-DAG: %[[res:.*]] = fir.call @_FortranADotProductReal4(%[[x_conv]], %[[y_conv]], %{{[0-9]+}}, %{{.*}}) : (!fir.box, !fir.box, !fir.ref, i32) -> f32 + z = dot_product(x,y) +end subroutine + +! CHECK-LABEL: dot_prod_real_kind_4 +! CHECK-SAME: %[[x:arg0]]: !fir.box> +! CHECK-SAME: %[[y:arg1]]: !fir.box> +! CHECK-SAME: %[[z:arg2]]: !fir.box> +subroutine dot_prod_real_kind_4 (x, y, z) + real(kind=4), dimension(1:) :: x,y + real(kind=4), dimension(1:) :: z + ! CHECK-DAG: %[[x_conv:.*]] = fir.convert %[[x]] : (!fir.box>) -> !fir.box + ! CHECK-DAG: %[[y_conv:.*]] = fir.convert %[[y]] : (!fir.box>) -> !fir.box + ! CHECK-DAG: %[[res:.*]] = fir.call @_FortranADotProductReal4(%[[x_conv]], %[[y_conv]], %{{[0-9]+}}, %{{.*}}) : (!fir.box, !fir.box, !fir.ref, i32) -> f32 + z = dot_product(x,y) +end subroutine + +! CHECK-LABEL: dot_prod_real_kind_8 +! CHECK-SAME: %[[x:arg0]]: !fir.box> +! CHECK-SAME: %[[y:arg1]]: !fir.box> +! CHECK-SAME: %[[z:arg2]]: !fir.box> +subroutine dot_prod_real_kind_8 (x, y, z) + real(kind=8), dimension(1:) :: x,y + real(kind=8), dimension(1:) :: z + ! CHECK-DAG: %[[x_conv:.*]] = fir.convert %[[x]] : (!fir.box>) -> !fir.box + ! CHECK-DAG: %[[y_conv:.*]] = fir.convert %[[y]] : (!fir.box>) -> !fir.box + ! CHECK-DAG: %[[res:.*]] = fir.call @_FortranADotProductReal8(%[[x_conv]], %[[y_conv]], %{{[0-9]+}}, %{{.*}}) : (!fir.box, !fir.box, !fir.ref, i32) -> f64 + z = dot_product(x,y) +end subroutine + +! CHECK-LABEL: dot_prod_real_kind_10 +! CHECK-SAME: %[[x:arg0]]: !fir.box> +! CHECK-SAME: %[[y:arg1]]: !fir.box> +! CHECK-SAME: %[[z:arg2]]: !fir.box> +subroutine dot_prod_real_kind_10 (x, y, z) + real(kind=10), dimension(1:) :: x,y + real(kind=10), dimension(1:) :: z + ! CHECK-DAG: %[[x_conv:.*]] = fir.convert %[[x]] : (!fir.box>) -> !fir.box + ! CHECK-DAG: %[[y_conv:.*]] = fir.convert %[[y]] : (!fir.box>) -> !fir.box + ! CHECK-DAG: %[[res:.*]] = fir.call @_FortranADotProductReal10(%[[x_conv]], %[[y_conv]], %{{[0-9]+}}, %{{.*}}) : (!fir.box, !fir.box, !fir.ref, i32) -> f80 + z = dot_product(x,y) +end subroutine + +! CHECK-LABEL: dot_prod_real_kind_16 +! CHECK-SAME: %[[x:arg0]]: !fir.box> +! CHECK-SAME: %[[y:arg1]]: !fir.box> +! CHECK-SAME: %[[z:arg2]]: !fir.box> +subroutine dot_prod_real_kind_16 (x, y, z) + real(kind=16), dimension(1:) :: x,y + real(kind=16), dimension(1:) :: z + ! CHECK-DAG: %[[x_conv:.*]] = fir.convert %[[x]] : (!fir.box>) -> !fir.box + ! CHECK-DAG: %[[y_conv:.*]] = fir.convert %[[y]] : (!fir.box>) -> !fir.box + ! CHECK-DAG: %[[res:.*]] = fir.call @_FortranADotProductReal16(%[[x_conv]], %[[y_conv]], %{{[0-9]+}}, %{{.*}}) : (!fir.box, !fir.box, !fir.ref, i32) -> f128 + z = dot_product(x,y) +end subroutine + +! CHECK-LABEL: dot_prod_double_default +! CHECK-SAME: %[[x:arg0]]: !fir.box> +! CHECK-SAME: %[[y:arg1]]: !fir.box> +! CHECK-SAME: %[[z:arg2]]: !fir.box> +subroutine dot_prod_double_default (x, y, z) + double precision, dimension(1:) :: x,y + double precision, dimension(1:) :: z + ! CHECK-DAG: %[[x_conv:.*]] = fir.convert %[[x]] : (!fir.box>) -> !fir.box + ! CHECK-DAG: %[[y_conv:.*]] = fir.convert %[[y]] : (!fir.box>) -> !fir.box + ! CHECK-DAG: %[[res:.*]] = fir.call @_FortranADotProductReal8(%[[x_conv]], %[[y_conv]], %{{[0-9]+}}, %{{.*}}) : (!fir.box, !fir.box, !fir.ref, i32) -> f64 + z = dot_product(x,y) +end subroutine + +! CHECK-LABEL: dot_prod_complex_default +! CHECK-SAME: %[[x:arg0]]: !fir.box>> +! CHECK-SAME: %[[y:arg1]]: !fir.box>> +! CHECK-SAME: %[[z:arg2]]: !fir.box>> +subroutine dot_prod_complex_default (x, y, z) + complex, dimension(1:) :: x,y + complex, dimension(1:) :: z + ! CHECK-DAG: %0 = fir.alloca !fir.complex<4> + ! CHECK-DAG: %[[res_conv:[0-9]+]] = fir.convert %0 : (!fir.ref>) -> !fir.ref> + ! CHECK-DAG: %[[x_conv:.*]] = fir.convert %[[x]] : (!fir.box>>) -> !fir.box + ! CHECK-DAG: %[[y_conv:.*]] = fir.convert %[[y]] : (!fir.box>>) -> !fir.box + ! CHECK-DAG: fir.call @_FortranACppDotProductComplex4(%[[res_conv]], %[[x_conv]], %[[y_conv]], %{{[0-9]+}}, %{{.*}}) : (!fir.ref>, !fir.box, !fir.box, !fir.ref, i32) -> none + z = dot_product(x,y) +end subroutine + +! CHECK-LABEL: dot_prod_complex_kind_4 +! CHECK-SAME: %[[x:arg0]]: !fir.box>> +! CHECK-SAME: %[[y:arg1]]: !fir.box>> +! CHECK-SAME: %[[z:arg2]]: !fir.box>> +subroutine dot_prod_complex_kind_4 (x, y, z) + complex(kind=4), dimension(1:) :: x,y + complex(kind=4), dimension(1:) :: z + ! CHECK-DAG: %0 = fir.alloca !fir.complex<4> + ! CHECK-DAG: %[[res_conv:[0-9]+]] = fir.convert %0 : (!fir.ref>) -> !fir.ref> + ! CHECK-DAG: %[[x_conv:.*]] = fir.convert %[[x]] : (!fir.box>>) -> !fir.box + ! CHECK-DAG: %[[y_conv:.*]] = fir.convert %[[y]] : (!fir.box>>) -> !fir.box + ! CHECK-DAG: fir.call @_FortranACppDotProductComplex4(%[[res_conv]], %[[x_conv]], %[[y_conv]], %{{[0-9]+}}, %{{.*}}) : (!fir.ref>, !fir.box, !fir.box, !fir.ref, i32) -> none + z = dot_product(x,y) +end subroutine + +! CHECK-LABEL: dot_prod_complex_kind_8 +! CHECK-SAME: %[[x:arg0]]: !fir.box>> +! CHECK-SAME: %[[y:arg1]]: !fir.box>> +! CHECK-SAME: %[[z:arg2]]: !fir.box>> +subroutine dot_prod_complex_kind_8 (x, y, z) + complex(kind=8), dimension(1:) :: x,y + complex(kind=8), dimension(1:) :: z + ! CHECK-DAG: %0 = fir.alloca !fir.complex<8> + ! CHECK-DAG: %[[res_conv:[0-9]+]] = fir.convert %0 : (!fir.ref>) -> !fir.ref> + ! CHECK-DAG: %[[x_conv:.*]] = fir.convert %[[x]] : (!fir.box>>) -> !fir.box + ! CHECK-DAG: %[[y_conv:.*]] = fir.convert %[[y]] : (!fir.box>>) -> !fir.box + ! CHECK-DAG: fir.call @_FortranACppDotProductComplex8(%[[res_conv]], %[[x_conv]], %[[y_conv]], %{{[0-9]+}}, %{{.*}}) : (!fir.ref>, !fir.box, !fir.box, !fir.ref, i32) -> none + z = dot_product(x,y) +end subroutine + +! CHECK-LABEL: dot_prod_complex_kind_10 +! CHECK-SAME: %[[x:arg0]]: !fir.box>> +! CHECK-SAME: %[[y:arg1]]: !fir.box>> +! CHECK-SAME: %[[z:arg2]]: !fir.box>> +subroutine dot_prod_complex_kind_10 (x, y, z) + complex(kind=10), dimension(1:) :: x,y + complex(kind=10), dimension(1:) :: z + ! CHECK-DAG: %0 = fir.alloca !fir.complex<10> + ! CHECK-DAG: %[[res_conv:[0-9]+]] = fir.convert %0 : (!fir.ref>) -> !fir.ref> + ! CHECK-DAG: %[[x_conv:.*]] = fir.convert %[[x]] : (!fir.box>>) -> !fir.box + ! CHECK-DAG: %[[y_conv:.*]] = fir.convert %[[y]] : (!fir.box>>) -> !fir.box + ! CHECK-DAG: fir.call @_FortranACppDotProductComplex10(%[[res_conv]], %[[x_conv]], %[[y_conv]], %{{[0-9]+}}, %{{.*}}) : (!fir.ref>, !fir.box, !fir.box, !fir.ref, i32) -> () + z = dot_product(x,y) +end subroutine + +! CHECK-LABEL: dot_prod_complex_kind_16 +! CHECK-SAME: %[[x:arg0]]: !fir.box>> +! CHECK-SAME: %[[y:arg1]]: !fir.box>> +! CHECK-SAME: %[[z:arg2]]: !fir.box>> +subroutine dot_prod_complex_kind_16 (x, y, z) + complex(kind=16), dimension(1:) :: x,y + complex(kind=16), dimension(1:) :: z + ! CHECK-DAG: %0 = fir.alloca !fir.complex<16> + ! CHECK-DAG: %[[res_conv:[0-9]+]] = fir.convert %0 : (!fir.ref>) -> !fir.ref> + ! CHECK-DAG: %[[x_conv:.*]] = fir.convert %[[x]] : (!fir.box>>) -> !fir.box + ! CHECK-DAG: %[[y_conv:.*]] = fir.convert %[[y]] : (!fir.box>>) -> !fir.box + ! CHECK-DAG: fir.call @_FortranACppDotProductComplex16(%[[res_conv]], %[[x_conv]], %[[y_conv]], %{{[0-9]+}}, %{{.*}}) : (!fir.ref>, !fir.box, !fir.box, !fir.ref, i32) -> () + z = dot_product(x,y) +end subroutine + +! CHECK-LABEL: dot_prod_logical +! CHECK-SAME: %[[x:arg0]]: !fir.box>> +! CHECK-SAME: %[[y:arg1]]: !fir.box>> +! CHECK-SAME: %[[z:arg2]]: !fir.box>> +subroutine dot_prod_logical (x, y, z) + logical, dimension(1:) :: x,y + logical, dimension(1:) :: z + ! CHECK-DAG: %[[x_conv:.*]] = fir.convert %[[x]] : (!fir.box>>) -> !fir.box + ! CHECK-DAG: %[[y_conv:.*]] = fir.convert %[[y]] : (!fir.box>>) -> !fir.box + ! CHECK-DAG: %[[res:.*]] = fir.call @_FortranADotProductLogical(%[[x_conv]], %[[y_conv]], %{{[0-9]+}}, %{{.*}}) : (!fir.box, !fir.box, !fir.ref, i32) -> i1 + z = dot_product(x,y) +end subroutine