diff --git a/flang-rt/lib/runtime/CMakeLists.txt b/flang-rt/lib/runtime/CMakeLists.txt index cc5d88e985329..f2dfeb7fb123d 100644 --- a/flang-rt/lib/runtime/CMakeLists.txt +++ b/flang-rt/lib/runtime/CMakeLists.txt @@ -29,15 +29,22 @@ set(supported_sources derived.cpp descriptor-io.cpp descriptor.cpp - dot-product.cpp + dot-product-integer.cpp + dot-product-real.cpp + dot-product-complex.cpp edit-input.cpp edit-output.cpp environment.cpp exceptions.cpp external-unit.cpp - extrema.cpp + extrema-maxloc.cpp + extrema-minloc.cpp + extrema-maxloc-dim.cpp + extrema-minloc-dim.cpp + extrema-value.cpp file.cpp - findloc.cpp + findloc-total.cpp + findloc-dim.cpp format.cpp inquiry.cpp internal-unit.cpp @@ -46,8 +53,18 @@ set(supported_sources io-error.cpp io-stmt.cpp iostat.cpp - matmul-transpose.cpp - matmul.cpp + matmul-transpose-integer.cpp + matmul-transpose-real.cpp + matmul-transpose-complex.cpp + matmul-transpose-extypes-int16.cpp + matmul-transpose-extypes-real10.cpp + matmul-transpose-extypes-real16.cpp + matmul-integer.cpp + matmul-real.cpp + matmul-complex.cpp + matmul-extypes-int16.cpp + matmul-extypes-real10.cpp + matmul-extypes-real16.cpp memory.cpp misc-intrinsic.cpp namelist.cpp @@ -112,17 +129,34 @@ set(gpu_sources derived-api.cpp derived.cpp descriptor.cpp - dot-product.cpp + dot-product-integer.cpp + dot-product-real.cpp + dot-product-complex.cpp edit-output.cpp - extrema.cpp + extrema-maxloc.cpp + extrema-minloc.cpp + extrema-maxloc-dim.cpp + extrema-minloc-dim.cpp + extrema-value.cpp environment.cpp - findloc.cpp + findloc-total.cpp + findloc-dim.cpp format.cpp inquiry.cpp internal-unit.cpp iostat.cpp - matmul-transpose.cpp - matmul.cpp + matmul-transpose-integer.cpp + matmul-transpose-real.cpp + matmul-transpose-complex.cpp + matmul-transpose-extypes-int16.cpp + matmul-transpose-extypes-real10.cpp + matmul-transpose-extypes-real16.cpp + matmul-integer.cpp + matmul-real.cpp + matmul-complex.cpp + matmul-extypes-int16.cpp + matmul-extypes-real10.cpp + matmul-extypes-real16.cpp memory.cpp misc-intrinsic.cpp non-tbp-dio.cpp diff --git a/flang-rt/lib/runtime/dot-product-complex.cpp b/flang-rt/lib/runtime/dot-product-complex.cpp new file mode 100644 index 0000000000000..ab79535363dd8 --- /dev/null +++ b/flang-rt/lib/runtime/dot-product-complex.cpp @@ -0,0 +1,42 @@ +//===-- lib/runtime/dot-product-complex.cpp ---------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +// Complex DOT_PRODUCT entry points. + +#include "dot-product.h" + +namespace Fortran::runtime { +extern "C" { +RT_EXT_API_GROUP_BEGIN + +void RTDEF(CppDotProductComplex4)(CppTypeFor &result, + const Descriptor &x, const Descriptor &y, const char *source, int line) { + result = DotProduct{}(x, y, source, line); +} +void RTDEF(CppDotProductComplex8)(CppTypeFor &result, + const Descriptor &x, const Descriptor &y, const char *source, int line) { + result = DotProduct{}(x, y, source, line); +} +#if HAS_FLOAT80 +void RTDEF(CppDotProductComplex10)( + CppTypeFor &result, const Descriptor &x, + const Descriptor &y, const char *source, int line) { + result = DotProduct{}(x, y, source, line); +} +#endif +#if HAS_LDBL128 || HAS_FLOAT128 +void RTDEF(CppDotProductComplex16)( + CppTypeFor &result, const Descriptor &x, + const Descriptor &y, const char *source, int line) { + result = DotProduct{}(x, y, source, line); +} +#endif + +RT_EXT_API_GROUP_END +} // extern "C" +} // namespace Fortran::runtime diff --git a/flang-rt/lib/runtime/dot-product-integer.cpp b/flang-rt/lib/runtime/dot-product-integer.cpp new file mode 100644 index 0000000000000..14ddc2e015909 --- /dev/null +++ b/flang-rt/lib/runtime/dot-product-integer.cpp @@ -0,0 +1,65 @@ +//===-- lib/runtime/dot-product-integer.cpp ---------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +// Integer and Unsigned DOT_PRODUCT entry points. + +#include "dot-product.h" + +namespace Fortran::runtime { +extern "C" { +RT_EXT_API_GROUP_BEGIN + +CppTypeFor RTDEF(DotProductInteger1)( + const Descriptor &x, const Descriptor &y, const char *source, int line) { + return DotProduct{}(x, y, source, line); +} +CppTypeFor RTDEF(DotProductInteger2)( + const Descriptor &x, const Descriptor &y, const char *source, int line) { + return DotProduct{}(x, y, source, line); +} +CppTypeFor RTDEF(DotProductInteger4)( + const Descriptor &x, const Descriptor &y, const char *source, int line) { + return DotProduct{}(x, y, source, line); +} +CppTypeFor RTDEF(DotProductInteger8)( + const Descriptor &x, const Descriptor &y, const char *source, int line) { + return DotProduct{}(x, y, source, line); +} +#ifdef __SIZEOF_INT128__ +CppTypeFor RTDEF(DotProductInteger16)( + const Descriptor &x, const Descriptor &y, const char *source, int line) { + return DotProduct{}(x, y, source, line); +} +#endif + +CppTypeFor RTDEF(DotProductUnsigned1)( + const Descriptor &x, const Descriptor &y, const char *source, int line) { + return DotProduct{}(x, y, source, line); +} +CppTypeFor RTDEF(DotProductUnsigned2)( + const Descriptor &x, const Descriptor &y, const char *source, int line) { + return DotProduct{}(x, y, source, line); +} +CppTypeFor RTDEF(DotProductUnsigned4)( + const Descriptor &x, const Descriptor &y, const char *source, int line) { + return DotProduct{}(x, y, source, line); +} +CppTypeFor RTDEF(DotProductUnsigned8)( + const Descriptor &x, const Descriptor &y, const char *source, int line) { + return DotProduct{}(x, y, source, line); +} +#ifdef __SIZEOF_INT128__ +CppTypeFor RTDEF(DotProductUnsigned16)( + const Descriptor &x, const Descriptor &y, const char *source, int line) { + return DotProduct{}(x, y, source, line); +} +#endif + +RT_EXT_API_GROUP_END +} // extern "C" +} // namespace Fortran::runtime diff --git a/flang-rt/lib/runtime/dot-product-real.cpp b/flang-rt/lib/runtime/dot-product-real.cpp new file mode 100644 index 0000000000000..69fd85ba85c15 --- /dev/null +++ b/flang-rt/lib/runtime/dot-product-real.cpp @@ -0,0 +1,45 @@ +//===-- lib/runtime/dot-product-real.cpp ------------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +// Real and Logical DOT_PRODUCT entry points. + +#include "dot-product.h" + +namespace Fortran::runtime { +extern "C" { +RT_EXT_API_GROUP_BEGIN + +CppTypeFor RTDEF(DotProductReal4)( + const Descriptor &x, const Descriptor &y, const char *source, int line) { + return DotProduct{}(x, y, source, line); +} +CppTypeFor RTDEF(DotProductReal8)( + const Descriptor &x, const Descriptor &y, const char *source, int line) { + return DotProduct{}(x, y, source, line); +} +#if HAS_FLOAT80 +CppTypeFor RTDEF(DotProductReal10)( + const Descriptor &x, const Descriptor &y, const char *source, int line) { + return DotProduct{}(x, y, source, line); +} +#endif +#if HAS_LDBL128 || HAS_FLOAT128 +CppTypeFor RTDEF(DotProductReal16)( + const Descriptor &x, const Descriptor &y, const char *source, int line) { + return DotProduct{}(x, y, source, line); +} +#endif + +bool RTDEF(DotProductLogical)( + const Descriptor &x, const Descriptor &y, const char *source, int line) { + return DotProduct{}(x, y, source, line); +} + +RT_EXT_API_GROUP_END +} // extern "C" +} // namespace Fortran::runtime diff --git a/flang-rt/lib/runtime/dot-product.cpp b/flang-rt/lib/runtime/dot-product.h similarity index 58% rename from flang-rt/lib/runtime/dot-product.cpp rename to flang-rt/lib/runtime/dot-product.h index 20612f1876c15..1c6d6ea546568 100644 --- a/flang-rt/lib/runtime/dot-product.cpp +++ b/flang-rt/lib/runtime/dot-product.h @@ -1,4 +1,4 @@ -//===-- lib/runtime/dot-product.cpp -----------------------------*- C++ -*-===// +//===-- lib/runtime/dot-product.h -------------------------------*- C++ -*-===// // // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. // See https://llvm.org/LICENSE.txt for license information. @@ -6,6 +6,9 @@ // //===----------------------------------------------------------------------===// +#ifndef FLANG_RT_RUNTIME_DOT_PRODUCT_H_ +#define FLANG_RT_RUNTIME_DOT_PRODUCT_H_ + #include "float.h" #include "flang-rt/runtime/descriptor.h" #include "flang-rt/runtime/terminator.h" @@ -154,106 +157,6 @@ template struct DotProduct { } }; -extern "C" { -RT_EXT_API_GROUP_BEGIN - -CppTypeFor RTDEF(DotProductInteger1)( - const Descriptor &x, const Descriptor &y, const char *source, int line) { - return DotProduct{}(x, y, source, line); -} -CppTypeFor RTDEF(DotProductInteger2)( - const Descriptor &x, const Descriptor &y, const char *source, int line) { - return DotProduct{}(x, y, source, line); -} -CppTypeFor RTDEF(DotProductInteger4)( - const Descriptor &x, const Descriptor &y, const char *source, int line) { - return DotProduct{}(x, y, source, line); -} -CppTypeFor RTDEF(DotProductInteger8)( - const Descriptor &x, const Descriptor &y, const char *source, int line) { - return DotProduct{}(x, y, source, line); -} -#ifdef __SIZEOF_INT128__ -CppTypeFor RTDEF(DotProductInteger16)( - const Descriptor &x, const Descriptor &y, const char *source, int line) { - return DotProduct{}(x, y, source, line); -} -#endif - -CppTypeFor RTDEF(DotProductUnsigned1)( - const Descriptor &x, const Descriptor &y, const char *source, int line) { - return DotProduct{}(x, y, source, line); -} -CppTypeFor RTDEF(DotProductUnsigned2)( - const Descriptor &x, const Descriptor &y, const char *source, int line) { - return DotProduct{}(x, y, source, line); -} -CppTypeFor RTDEF(DotProductUnsigned4)( - const Descriptor &x, const Descriptor &y, const char *source, int line) { - return DotProduct{}(x, y, source, line); -} -CppTypeFor RTDEF(DotProductUnsigned8)( - const Descriptor &x, const Descriptor &y, const char *source, int line) { - return DotProduct{}(x, y, source, line); -} -#ifdef __SIZEOF_INT128__ -CppTypeFor RTDEF(DotProductUnsigned16)( - const Descriptor &x, const Descriptor &y, const char *source, int line) { - return DotProduct{}(x, y, source, line); -} -#endif - -// TODO: REAL/COMPLEX(2 & 3) -// Intermediate results and operations are at least 64 bits -CppTypeFor RTDEF(DotProductReal4)( - const Descriptor &x, const Descriptor &y, const char *source, int line) { - return DotProduct{}(x, y, source, line); -} -CppTypeFor RTDEF(DotProductReal8)( - const Descriptor &x, const Descriptor &y, const char *source, int line) { - return DotProduct{}(x, y, source, line); -} -#if HAS_FLOAT80 -CppTypeFor RTDEF(DotProductReal10)( - const Descriptor &x, const Descriptor &y, const char *source, int line) { - return DotProduct{}(x, y, source, line); -} -#endif -#if HAS_LDBL128 || HAS_FLOAT128 -CppTypeFor RTDEF(DotProductReal16)( - const Descriptor &x, const Descriptor &y, const char *source, int line) { - return DotProduct{}(x, y, source, line); -} -#endif - -void RTDEF(CppDotProductComplex4)(CppTypeFor &result, - const Descriptor &x, const Descriptor &y, const char *source, int line) { - result = DotProduct{}(x, y, source, line); -} -void RTDEF(CppDotProductComplex8)(CppTypeFor &result, - const Descriptor &x, const Descriptor &y, const char *source, int line) { - result = DotProduct{}(x, y, source, line); -} -#if HAS_FLOAT80 -void RTDEF(CppDotProductComplex10)( - CppTypeFor &result, const Descriptor &x, - const Descriptor &y, const char *source, int line) { - result = DotProduct{}(x, y, source, line); -} -#endif -#if HAS_LDBL128 || HAS_FLOAT128 -void RTDEF(CppDotProductComplex16)( - CppTypeFor &result, const Descriptor &x, - const Descriptor &y, const char *source, int line) { - result = DotProduct{}(x, y, source, line); -} -#endif - -bool RTDEF(DotProductLogical)( - const Descriptor &x, const Descriptor &y, const char *source, int line) { - return DotProduct{}(x, y, source, line); -} - -RT_EXT_API_GROUP_END -} // extern "C" } // namespace Fortran::runtime + +#endif // FLANG_RT_RUNTIME_DOT_PRODUCT_H_ diff --git a/flang-rt/lib/runtime/extrema-maxloc-dim.cpp b/flang-rt/lib/runtime/extrema-maxloc-dim.cpp new file mode 100644 index 0000000000000..3591d2c73f6a8 --- /dev/null +++ b/flang-rt/lib/runtime/extrema-maxloc-dim.cpp @@ -0,0 +1,25 @@ +//===-- lib/runtime/extrema-maxloc-dim.cpp ----------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +// MAXLOC with DIM= entry point. + +#include "extrema.h" + +namespace Fortran::runtime { +extern "C" { +RT_EXT_API_GROUP_BEGIN + +void RTDEF(MaxlocDim)(Descriptor &result, const Descriptor &x, int kind, + int dim, const char *source, int line, const Descriptor *mask, bool back) { + TypedPartialMaxOrMinLoc( + "MAXLOC", result, x, kind, dim, source, line, mask, back); +} + +RT_EXT_API_GROUP_END +} // extern "C" +} // namespace Fortran::runtime diff --git a/flang-rt/lib/runtime/extrema-maxloc.cpp b/flang-rt/lib/runtime/extrema-maxloc.cpp new file mode 100644 index 0000000000000..c95ae4c834d94 --- /dev/null +++ b/flang-rt/lib/runtime/extrema-maxloc.cpp @@ -0,0 +1,103 @@ +//===-- lib/runtime/extrema-maxloc.cpp --------------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +// MAXLOC total reduction entry points. + +#include "extrema.h" + +namespace Fortran::runtime { +extern "C" { +RT_EXT_API_GROUP_BEGIN + +void RTDEF(MaxlocCharacter)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + CharacterMaxOrMinLoc( + "MAXLOC", result, x, kind, source, line, mask, back); +} +void RTDEF(MaxlocInteger1)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + TotalNumericMaxOrMinLoc( + "MAXLOC", result, x, kind, source, line, mask, back); +} +void RTDEF(MaxlocInteger2)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + TotalNumericMaxOrMinLoc( + "MAXLOC", result, x, kind, source, line, mask, back); +} +void RTDEF(MaxlocInteger4)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + TotalNumericMaxOrMinLoc( + "MAXLOC", result, x, kind, source, line, mask, back); +} +void RTDEF(MaxlocInteger8)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + TotalNumericMaxOrMinLoc( + "MAXLOC", result, x, kind, source, line, mask, back); +} +#ifdef __SIZEOF_INT128__ +void RTDEF(MaxlocInteger16)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + TotalNumericMaxOrMinLoc( + "MAXLOC", result, x, kind, source, line, mask, back); +} +#endif +void RTDEF(MaxlocUnsigned1)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + TotalNumericMaxOrMinLoc( + "MAXLOC", result, x, kind, source, line, mask, back); +} +void RTDEF(MaxlocUnsigned2)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + TotalNumericMaxOrMinLoc( + "MAXLOC", result, x, kind, source, line, mask, back); +} +void RTDEF(MaxlocUnsigned4)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + TotalNumericMaxOrMinLoc( + "MAXLOC", result, x, kind, source, line, mask, back); +} +void RTDEF(MaxlocUnsigned8)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + TotalNumericMaxOrMinLoc( + "MAXLOC", result, x, kind, source, line, mask, back); +} +#ifdef __SIZEOF_INT128__ +void RTDEF(MaxlocUnsigned16)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + TotalNumericMaxOrMinLoc( + "MAXLOC", result, x, kind, source, line, mask, back); +} +#endif +void RTDEF(MaxlocReal4)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + TotalNumericMaxOrMinLoc( + "MAXLOC", result, x, kind, source, line, mask, back); +} +void RTDEF(MaxlocReal8)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + TotalNumericMaxOrMinLoc( + "MAXLOC", result, x, kind, source, line, mask, back); +} +#if HAS_FLOAT80 +void RTDEF(MaxlocReal10)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + TotalNumericMaxOrMinLoc( + "MAXLOC", result, x, kind, source, line, mask, back); +} +#endif +#if HAS_LDBL128 || HAS_FLOAT128 +void RTDEF(MaxlocReal16)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + TotalNumericMaxOrMinLoc( + "MAXLOC", result, x, kind, source, line, mask, back); +} +#endif + +RT_EXT_API_GROUP_END +} // extern "C" +} // namespace Fortran::runtime diff --git a/flang-rt/lib/runtime/extrema-minloc-dim.cpp b/flang-rt/lib/runtime/extrema-minloc-dim.cpp new file mode 100644 index 0000000000000..a45ced050b967 --- /dev/null +++ b/flang-rt/lib/runtime/extrema-minloc-dim.cpp @@ -0,0 +1,25 @@ +//===-- lib/runtime/extrema-minloc-dim.cpp ----------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +// MINLOC with DIM= entry point. + +#include "extrema.h" + +namespace Fortran::runtime { +extern "C" { +RT_EXT_API_GROUP_BEGIN + +void RTDEF(MinlocDim)(Descriptor &result, const Descriptor &x, int kind, + int dim, const char *source, int line, const Descriptor *mask, bool back) { + TypedPartialMaxOrMinLoc( + "MINLOC", result, x, kind, dim, source, line, mask, back); +} + +RT_EXT_API_GROUP_END +} // extern "C" +} // namespace Fortran::runtime diff --git a/flang-rt/lib/runtime/extrema-minloc.cpp b/flang-rt/lib/runtime/extrema-minloc.cpp new file mode 100644 index 0000000000000..1e2c280f11a9e --- /dev/null +++ b/flang-rt/lib/runtime/extrema-minloc.cpp @@ -0,0 +1,103 @@ +//===-- lib/runtime/extrema-minloc.cpp --------------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +// MINLOC total reduction entry points. + +#include "extrema.h" + +namespace Fortran::runtime { +extern "C" { +RT_EXT_API_GROUP_BEGIN + +void RTDEF(MinlocCharacter)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + CharacterMaxOrMinLoc( + "MINLOC", result, x, kind, source, line, mask, back); +} +void RTDEF(MinlocInteger1)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + TotalNumericMaxOrMinLoc( + "MINLOC", result, x, kind, source, line, mask, back); +} +void RTDEF(MinlocInteger2)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + TotalNumericMaxOrMinLoc( + "MINLOC", result, x, kind, source, line, mask, back); +} +void RTDEF(MinlocInteger4)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + TotalNumericMaxOrMinLoc( + "MINLOC", result, x, kind, source, line, mask, back); +} +void RTDEF(MinlocInteger8)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + TotalNumericMaxOrMinLoc( + "MINLOC", result, x, kind, source, line, mask, back); +} +#ifdef __SIZEOF_INT128__ +void RTDEF(MinlocInteger16)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + TotalNumericMaxOrMinLoc( + "MINLOC", result, x, kind, source, line, mask, back); +} +#endif +void RTDEF(MinlocUnsigned1)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + TotalNumericMaxOrMinLoc( + "MINLOC", result, x, kind, source, line, mask, back); +} +void RTDEF(MinlocUnsigned2)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + TotalNumericMaxOrMinLoc( + "MINLOC", result, x, kind, source, line, mask, back); +} +void RTDEF(MinlocUnsigned4)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + TotalNumericMaxOrMinLoc( + "MINLOC", result, x, kind, source, line, mask, back); +} +void RTDEF(MinlocUnsigned8)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + TotalNumericMaxOrMinLoc( + "MINLOC", result, x, kind, source, line, mask, back); +} +#ifdef __SIZEOF_INT128__ +void RTDEF(MinlocUnsigned16)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + TotalNumericMaxOrMinLoc( + "MINLOC", result, x, kind, source, line, mask, back); +} +#endif +void RTDEF(MinlocReal4)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + TotalNumericMaxOrMinLoc( + "MINLOC", result, x, kind, source, line, mask, back); +} +void RTDEF(MinlocReal8)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + TotalNumericMaxOrMinLoc( + "MINLOC", result, x, kind, source, line, mask, back); +} +#if HAS_FLOAT80 +void RTDEF(MinlocReal10)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + TotalNumericMaxOrMinLoc( + "MINLOC", result, x, kind, source, line, mask, back); +} +#endif +#if HAS_LDBL128 || HAS_FLOAT128 +void RTDEF(MinlocReal16)(Descriptor &result, const Descriptor &x, int kind, + const char *source, int line, const Descriptor *mask, bool back) { + TotalNumericMaxOrMinLoc( + "MINLOC", result, x, kind, source, line, mask, back); +} +#endif + +RT_EXT_API_GROUP_END +} // extern "C" +} // namespace Fortran::runtime diff --git a/flang-rt/lib/runtime/extrema-value.cpp b/flang-rt/lib/runtime/extrema-value.cpp new file mode 100644 index 0000000000000..909322b5683cf --- /dev/null +++ b/flang-rt/lib/runtime/extrema-value.cpp @@ -0,0 +1,262 @@ +//===-- lib/runtime/extrema-value.cpp ---------------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +// MAXVAL, MINVAL, and NORM2 entry points. + +#include "extrema.h" + +namespace Fortran::runtime { +extern "C" { +RT_EXT_API_GROUP_BEGIN + +CppTypeFor RTDEF(MaxvalInteger1)(const Descriptor &x, + const char *source, int line, int dim, const Descriptor *mask) { + return TotalNumericMaxOrMin( + x, source, line, dim, mask, "MAXVAL"); +} +CppTypeFor RTDEF(MaxvalInteger2)(const Descriptor &x, + const char *source, int line, int dim, const Descriptor *mask) { + return TotalNumericMaxOrMin( + x, source, line, dim, mask, "MAXVAL"); +} +CppTypeFor RTDEF(MaxvalInteger4)(const Descriptor &x, + const char *source, int line, int dim, const Descriptor *mask) { + return TotalNumericMaxOrMin( + x, source, line, dim, mask, "MAXVAL"); +} +CppTypeFor RTDEF(MaxvalInteger8)(const Descriptor &x, + const char *source, int line, int dim, const Descriptor *mask) { + return TotalNumericMaxOrMin( + x, source, line, dim, mask, "MAXVAL"); +} +#ifdef __SIZEOF_INT128__ +CppTypeFor RTDEF(MaxvalInteger16)( + const Descriptor &x, const char *source, int line, int dim, + const Descriptor *mask) { + return TotalNumericMaxOrMin( + x, source, line, dim, mask, "MAXVAL"); +} +#endif + +CppTypeFor RTDEF(MaxvalUnsigned1)( + const Descriptor &x, const char *source, int line, int dim, + const Descriptor *mask) { + return TotalNumericMaxOrMin( + x, source, line, dim, mask, "MAXVAL"); +} +CppTypeFor RTDEF(MaxvalUnsigned2)( + const Descriptor &x, const char *source, int line, int dim, + const Descriptor *mask) { + return TotalNumericMaxOrMin( + x, source, line, dim, mask, "MAXVAL"); +} +CppTypeFor RTDEF(MaxvalUnsigned4)( + const Descriptor &x, const char *source, int line, int dim, + const Descriptor *mask) { + return TotalNumericMaxOrMin( + x, source, line, dim, mask, "MAXVAL"); +} +CppTypeFor RTDEF(MaxvalUnsigned8)( + const Descriptor &x, const char *source, int line, int dim, + const Descriptor *mask) { + return TotalNumericMaxOrMin( + x, source, line, dim, mask, "MAXVAL"); +} +#ifdef __SIZEOF_INT128__ +CppTypeFor RTDEF(MaxvalUnsigned16)( + const Descriptor &x, const char *source, int line, int dim, + const Descriptor *mask) { + return TotalNumericMaxOrMin( + x, source, line, dim, mask, "MAXVAL"); +} +#endif + +// TODO: REAL(2 & 3) +CppTypeFor RTDEF(MaxvalReal4)(const Descriptor &x, + const char *source, int line, int dim, const Descriptor *mask) { + return TotalNumericMaxOrMin( + x, source, line, dim, mask, "MAXVAL"); +} +CppTypeFor RTDEF(MaxvalReal8)(const Descriptor &x, + const char *source, int line, int dim, const Descriptor *mask) { + return TotalNumericMaxOrMin( + x, source, line, dim, mask, "MAXVAL"); +} +#if HAS_FLOAT80 +CppTypeFor RTDEF(MaxvalReal10)(const Descriptor &x, + const char *source, int line, int dim, const Descriptor *mask) { + return TotalNumericMaxOrMin( + x, source, line, dim, mask, "MAXVAL"); +} +#endif +#if HAS_LDBL128 || HAS_FLOAT128 +CppTypeFor RTDEF(MaxvalReal16)(const Descriptor &x, + const char *source, int line, int dim, const Descriptor *mask) { + return TotalNumericMaxOrMin( + x, source, line, dim, mask, "MAXVAL"); +} +#endif + +void RTDEF(MaxvalCharacter)(Descriptor &result, const Descriptor &x, + const char *source, int line, const Descriptor *mask) { + CharacterMaxOrMin(result, x, 0, source, line, mask, "MAXVAL"); +} + +CppTypeFor RTDEF(MinvalInteger1)(const Descriptor &x, + const char *source, int line, int dim, const Descriptor *mask) { + return TotalNumericMaxOrMin( + x, source, line, dim, mask, "MINVAL"); +} +CppTypeFor RTDEF(MinvalInteger2)(const Descriptor &x, + const char *source, int line, int dim, const Descriptor *mask) { + return TotalNumericMaxOrMin( + x, source, line, dim, mask, "MINVAL"); +} +CppTypeFor RTDEF(MinvalInteger4)(const Descriptor &x, + const char *source, int line, int dim, const Descriptor *mask) { + return TotalNumericMaxOrMin( + x, source, line, dim, mask, "MINVAL"); +} +CppTypeFor RTDEF(MinvalInteger8)(const Descriptor &x, + const char *source, int line, int dim, const Descriptor *mask) { + return TotalNumericMaxOrMin( + x, source, line, dim, mask, "MINVAL"); +} +#ifdef __SIZEOF_INT128__ +CppTypeFor RTDEF(MinvalInteger16)( + const Descriptor &x, const char *source, int line, int dim, + const Descriptor *mask) { + return TotalNumericMaxOrMin( + x, source, line, dim, mask, "MINVAL"); +} +#endif + +CppTypeFor RTDEF(MinvalUnsigned1)( + const Descriptor &x, const char *source, int line, int dim, + const Descriptor *mask) { + return TotalNumericMaxOrMin( + x, source, line, dim, mask, "MINVAL"); +} +CppTypeFor RTDEF(MinvalUnsigned2)( + const Descriptor &x, const char *source, int line, int dim, + const Descriptor *mask) { + return TotalNumericMaxOrMin( + x, source, line, dim, mask, "MINVAL"); +} +CppTypeFor RTDEF(MinvalUnsigned4)( + const Descriptor &x, const char *source, int line, int dim, + const Descriptor *mask) { + return TotalNumericMaxOrMin( + x, source, line, dim, mask, "MINVAL"); +} +CppTypeFor RTDEF(MinvalUnsigned8)( + const Descriptor &x, const char *source, int line, int dim, + const Descriptor *mask) { + return TotalNumericMaxOrMin( + x, source, line, dim, mask, "MINVAL"); +} +#ifdef __SIZEOF_INT128__ +CppTypeFor RTDEF(MinvalUnsigned16)( + const Descriptor &x, const char *source, int line, int dim, + const Descriptor *mask) { + return TotalNumericMaxOrMin( + x, source, line, dim, mask, "MINVAL"); +} +#endif + +// TODO: REAL(2 & 3) +CppTypeFor RTDEF(MinvalReal4)(const Descriptor &x, + const char *source, int line, int dim, const Descriptor *mask) { + return TotalNumericMaxOrMin( + x, source, line, dim, mask, "MINVAL"); +} +CppTypeFor RTDEF(MinvalReal8)(const Descriptor &x, + const char *source, int line, int dim, const Descriptor *mask) { + return TotalNumericMaxOrMin( + x, source, line, dim, mask, "MINVAL"); +} +#if HAS_FLOAT80 +CppTypeFor RTDEF(MinvalReal10)(const Descriptor &x, + const char *source, int line, int dim, const Descriptor *mask) { + return TotalNumericMaxOrMin( + x, source, line, dim, mask, "MINVAL"); +} +#endif +#if HAS_LDBL128 || HAS_FLOAT128 +CppTypeFor RTDEF(MinvalReal16)(const Descriptor &x, + const char *source, int line, int dim, const Descriptor *mask) { + return TotalNumericMaxOrMin( + x, source, line, dim, mask, "MINVAL"); +} +#endif + +void RTDEF(MinvalCharacter)(Descriptor &result, const Descriptor &x, + const char *source, int line, const Descriptor *mask) { + CharacterMaxOrMin(result, x, 0, source, line, mask, "MINVAL"); +} + +void RTDEF(MaxvalDim)(Descriptor &result, const Descriptor &x, int dim, + const char *source, int line, const Descriptor *mask) { + if (x.type().IsCharacter()) { + CharacterMaxOrMin(result, x, dim, source, line, mask, "MAXVAL"); + } else { + NumericMaxOrMin(result, x, dim, source, line, mask, "MAXVAL"); + } +} +void RTDEF(MinvalDim)(Descriptor &result, const Descriptor &x, int dim, + const char *source, int line, const Descriptor *mask) { + if (x.type().IsCharacter()) { + CharacterMaxOrMin(result, x, dim, source, line, mask, "MINVAL"); + } else { + NumericMaxOrMin(result, x, dim, source, line, mask, "MINVAL"); + } +} + +RT_EXT_API_GROUP_END +} // extern "C" + +// NORM2 + +extern "C" { +RT_EXT_API_GROUP_BEGIN + +// TODO: REAL(2 & 3) +CppTypeFor RTDEF(Norm2_4)( + const Descriptor &x, const char *source, int line, int dim) { + return GetTotalReduction( + x, source, line, dim, nullptr, Norm2Accumulator<4>{x}, "NORM2"); +} +CppTypeFor RTDEF(Norm2_8)( + const Descriptor &x, const char *source, int line, int dim) { + return GetTotalReduction( + x, source, line, dim, nullptr, Norm2Accumulator<8>{x}, "NORM2"); +} +#if HAS_FLOAT80 +CppTypeFor RTDEF(Norm2_10)( + const Descriptor &x, const char *source, int line, int dim) { + return GetTotalReduction( + x, source, line, dim, nullptr, Norm2Accumulator<10>{x}, "NORM2"); +} +#endif + +void RTDEF(Norm2Dim)(Descriptor &result, const Descriptor &x, int dim, + const char *source, int line) { + Terminator terminator{source, line}; + auto type{x.type().GetCategoryAndKind()}; + RUNTIME_CHECK(terminator, type); + if (type->first == TypeCategory::Real) { + ApplyFloatingPointKind( + type->second, terminator, result, x, dim, nullptr, terminator); + } else { + terminator.Crash("NORM2: bad type code %d", x.type().raw()); + } +} + +RT_EXT_API_GROUP_END +} // extern "C" +} // namespace Fortran::runtime diff --git a/flang-rt/lib/runtime/extrema.cpp b/flang-rt/lib/runtime/extrema.cpp deleted file mode 100644 index d68055df256a4..0000000000000 --- a/flang-rt/lib/runtime/extrema.cpp +++ /dev/null @@ -1,878 +0,0 @@ -//===-- lib/runtime/extrema.cpp ---------------------------------*- C++ -*-===// -// -// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. -// See https://llvm.org/LICENSE.txt for license information. -// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -// -//===----------------------------------------------------------------------===// - -// Implements MAXLOC, MINLOC, MAXVAL, & MINVAL for all required operand types -// and shapes and (for MAXLOC & MINLOC) result integer kinds. Also implements -// NORM2 using common infrastructure. - -#include "flang-rt/runtime/reduction-templates.h" -#include "flang/Common/float128.h" -#include "flang/Runtime/character.h" -#include "flang/Runtime/reduction.h" -#include -#include -#include -#include -#include - -namespace Fortran::runtime { - -// MAXLOC & MINLOC - -template struct NumericCompare { - using Type = T; - explicit RT_API_ATTRS NumericCompare(std::size_t /*elemLen*/, bool back) - : back_{back} {} - RT_API_ATTRS bool operator()(const T &value, const T &previous) const { - if (std::is_floating_point_v && previous != previous) { - return back_ || value == value; // replace NaN - } else if (value == previous) { - return back_; - } else if constexpr (IS_MAX) { - return value > previous; - } else { - return value < previous; - } - } - -private: - bool back_; -}; - -template class CharacterCompare { -public: - using Type = T; - explicit RT_API_ATTRS CharacterCompare(std::size_t elemLen, bool back) - : chars_{elemLen / sizeof(T)}, back_{back} {} - RT_API_ATTRS bool operator()(const T &value, const T &previous) const { - int cmp{CharacterScalarCompare(&value, &previous, chars_, chars_)}; - if (cmp == 0) { - return back_; - } else if constexpr (IS_MAX) { - return cmp > 0; - } else { - return cmp < 0; - } - } - -private: - std::size_t chars_; - bool back_; -}; - -template class ExtremumLocAccumulator { -public: - using Type = typename COMPARE::Type; - RT_API_ATTRS ExtremumLocAccumulator(const Descriptor &array, bool back) - : array_{array}, argRank_{array.rank()}, - compare_{array.ElementBytes(), back} { - Reinitialize(); - } - RT_API_ATTRS void Reinitialize() { - // per standard: result indices are all zero if no data - for (int j{0}; j < argRank_; ++j) { - extremumLoc_[j] = 0; - } - previous_ = nullptr; - } - RT_API_ATTRS int argRank() const { return argRank_; } - template - RT_API_ATTRS void GetResult(A *p, int zeroBasedDim = -1) { - if (zeroBasedDim >= 0) { - *p = extremumLoc_[zeroBasedDim]; - } else { - for (int j{0}; j < argRank_; ++j) { - p[j] = extremumLoc_[j]; - } - } - } - template - RT_API_ATTRS bool AccumulateAt(const SubscriptValue at[]) { - const auto &value{*array_.Element(at)}; - if (!previous_ || compare_(value, *previous_)) { - previous_ = &value; - for (int j{0}; j < argRank_; ++j) { - extremumLoc_[j] = at[j] - array_.GetDimension(j).LowerBound() + 1; - } - } - return true; - } - -private: - const Descriptor &array_; - int argRank_; - SubscriptValue extremumLoc_[maxRank]; - const Type *previous_{nullptr}; - COMPARE compare_; -}; - -template -static RT_API_ATTRS void LocationHelper(const char *intrinsic, - Descriptor &result, const Descriptor &x, int kind, const Descriptor *mask, - Terminator &terminator, bool back) { - ACCUMULATOR accumulator{x, back}; - DoTotalReduction(x, 0, mask, accumulator, intrinsic, terminator); - ApplyIntegerKind::template Functor, void>( - kind, terminator, accumulator, result); -} - -template class COMPARE> -inline RT_API_ATTRS void DoMaxOrMinLoc(const char *intrinsic, - Descriptor &result, const Descriptor &x, int kind, const char *source, - int line, const Descriptor *mask, bool back) { - using CppType = CppTypeFor; - Terminator terminator{source, line}; - LocationHelper>, CppType>( - intrinsic, result, x, kind, mask, terminator, back); -} - -template struct CharacterMaxOrMinLocHelper { - template struct Functor { - RT_API_ATTRS void operator()(const char *intrinsic, Descriptor &result, - const Descriptor &x, int kind, const char *source, int line, - const Descriptor *mask, bool back) const { - DoMaxOrMinLoc( - intrinsic, result, x, kind, source, line, mask, back); - } - }; -}; - -template -inline RT_API_ATTRS void CharacterMaxOrMinLoc(const char *intrinsic, - Descriptor &result, const Descriptor &x, int kind, const char *source, - int line, const Descriptor *mask, bool back) { - int rank{x.rank()}; - SubscriptValue extent[1]{rank}; - result.Establish(TypeCategory::Integer, kind, nullptr, 1, extent, - CFI_attribute_allocatable); - result.GetDimension(0).SetBounds(1, extent[0]); - Terminator terminator{source, line}; - if (int stat{result.Allocate(kNoAsyncObject)}) { - terminator.Crash( - "%s: could not allocate memory for result; STAT=%d", intrinsic, stat); - } - CheckIntegerKind(terminator, kind, intrinsic); - auto catKind{x.type().GetCategoryAndKind()}; - RUNTIME_CHECK(terminator, catKind.has_value()); - switch (catKind->first) { - case TypeCategory::Character: - ApplyCharacterKind::template Functor, - void>(catKind->second, terminator, intrinsic, result, x, kind, source, - line, mask, back); - break; - default: - terminator.Crash( - "%s: bad data type code (%d) for array", intrinsic, x.type().raw()); - } -} - -template -inline RT_API_ATTRS void TotalNumericMaxOrMinLoc(const char *intrinsic, - Descriptor &result, const Descriptor &x, int kind, const char *source, - int line, const Descriptor *mask, bool back) { - int rank{x.rank()}; - SubscriptValue extent[1]{rank}; - result.Establish(TypeCategory::Integer, kind, nullptr, 1, extent, - CFI_attribute_allocatable); - result.GetDimension(0).SetBounds(1, extent[0]); - Terminator terminator{source, line}; - if (int stat{result.Allocate(kNoAsyncObject)}) { - terminator.Crash( - "%s: could not allocate memory for result; STAT=%d", intrinsic, stat); - } - CheckIntegerKind(terminator, kind, intrinsic); - RUNTIME_CHECK(terminator, TypeCode(CAT, KIND) == x.type()); - DoMaxOrMinLoc( - intrinsic, result, x, kind, source, line, mask, back); -} - -extern "C" { -RT_EXT_API_GROUP_BEGIN - -void RTDEF(MaxlocCharacter)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - CharacterMaxOrMinLoc( - "MAXLOC", result, x, kind, source, line, mask, back); -} -void RTDEF(MaxlocInteger1)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - TotalNumericMaxOrMinLoc( - "MAXLOC", result, x, kind, source, line, mask, back); -} -void RTDEF(MaxlocInteger2)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - TotalNumericMaxOrMinLoc( - "MAXLOC", result, x, kind, source, line, mask, back); -} -void RTDEF(MaxlocInteger4)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - TotalNumericMaxOrMinLoc( - "MAXLOC", result, x, kind, source, line, mask, back); -} -void RTDEF(MaxlocInteger8)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - TotalNumericMaxOrMinLoc( - "MAXLOC", result, x, kind, source, line, mask, back); -} -#ifdef __SIZEOF_INT128__ -void RTDEF(MaxlocInteger16)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - TotalNumericMaxOrMinLoc( - "MAXLOC", result, x, kind, source, line, mask, back); -} -#endif -void RTDEF(MaxlocUnsigned1)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - TotalNumericMaxOrMinLoc( - "MAXLOC", result, x, kind, source, line, mask, back); -} -void RTDEF(MaxlocUnsigned2)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - TotalNumericMaxOrMinLoc( - "MAXLOC", result, x, kind, source, line, mask, back); -} -void RTDEF(MaxlocUnsigned4)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - TotalNumericMaxOrMinLoc( - "MAXLOC", result, x, kind, source, line, mask, back); -} -void RTDEF(MaxlocUnsigned8)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - TotalNumericMaxOrMinLoc( - "MAXLOC", result, x, kind, source, line, mask, back); -} -#ifdef __SIZEOF_INT128__ -void RTDEF(MaxlocUnsigned16)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - TotalNumericMaxOrMinLoc( - "MAXLOC", result, x, kind, source, line, mask, back); -} -#endif -void RTDEF(MaxlocReal4)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - TotalNumericMaxOrMinLoc( - "MAXLOC", result, x, kind, source, line, mask, back); -} -void RTDEF(MaxlocReal8)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - TotalNumericMaxOrMinLoc( - "MAXLOC", result, x, kind, source, line, mask, back); -} -#if HAS_FLOAT80 -void RTDEF(MaxlocReal10)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - TotalNumericMaxOrMinLoc( - "MAXLOC", result, x, kind, source, line, mask, back); -} -#endif -#if HAS_LDBL128 || HAS_FLOAT128 -void RTDEF(MaxlocReal16)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - TotalNumericMaxOrMinLoc( - "MAXLOC", result, x, kind, source, line, mask, back); -} -#endif -void RTDEF(MinlocCharacter)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - CharacterMaxOrMinLoc( - "MINLOC", result, x, kind, source, line, mask, back); -} -void RTDEF(MinlocInteger1)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - TotalNumericMaxOrMinLoc( - "MINLOC", result, x, kind, source, line, mask, back); -} -void RTDEF(MinlocInteger2)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - TotalNumericMaxOrMinLoc( - "MINLOC", result, x, kind, source, line, mask, back); -} -void RTDEF(MinlocInteger4)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - TotalNumericMaxOrMinLoc( - "MINLOC", result, x, kind, source, line, mask, back); -} -void RTDEF(MinlocInteger8)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - TotalNumericMaxOrMinLoc( - "MINLOC", result, x, kind, source, line, mask, back); -} -#ifdef __SIZEOF_INT128__ -void RTDEF(MinlocInteger16)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - TotalNumericMaxOrMinLoc( - "MINLOC", result, x, kind, source, line, mask, back); -} -#endif -void RTDEF(MinlocUnsigned1)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - TotalNumericMaxOrMinLoc( - "MINLOC", result, x, kind, source, line, mask, back); -} -void RTDEF(MinlocUnsigned2)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - TotalNumericMaxOrMinLoc( - "MINLOC", result, x, kind, source, line, mask, back); -} -void RTDEF(MinlocUnsigned4)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - TotalNumericMaxOrMinLoc( - "MINLOC", result, x, kind, source, line, mask, back); -} -void RTDEF(MinlocUnsigned8)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - TotalNumericMaxOrMinLoc( - "MINLOC", result, x, kind, source, line, mask, back); -} -#ifdef __SIZEOF_INT128__ -void RTDEF(MinlocUnsigned16)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - TotalNumericMaxOrMinLoc( - "MINLOC", result, x, kind, source, line, mask, back); -} -#endif -void RTDEF(MinlocReal4)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - TotalNumericMaxOrMinLoc( - "MINLOC", result, x, kind, source, line, mask, back); -} -void RTDEF(MinlocReal8)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - TotalNumericMaxOrMinLoc( - "MINLOC", result, x, kind, source, line, mask, back); -} -#if HAS_FLOAT80 -void RTDEF(MinlocReal10)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - TotalNumericMaxOrMinLoc( - "MINLOC", result, x, kind, source, line, mask, back); -} -#endif -#if HAS_LDBL128 || HAS_FLOAT128 -void RTDEF(MinlocReal16)(Descriptor &result, const Descriptor &x, int kind, - const char *source, int line, const Descriptor *mask, bool back) { - TotalNumericMaxOrMinLoc( - "MINLOC", result, x, kind, source, line, mask, back); -} -#endif - -RT_EXT_API_GROUP_END -} // extern "C" - -// MAXLOC/MINLOC with DIM= - -template class COMPARE> -static RT_API_ATTRS void DoPartialMaxOrMinLoc(const char *intrinsic, - Descriptor &result, const Descriptor &x, int kind, int dim, - const Descriptor *mask, Terminator &terminator, bool back) { - using CppType = CppTypeFor; - using Accumulator = ExtremumLocAccumulator>; - Accumulator accumulator{x, back}; - ApplyIntegerKind::template Functor, void>( - kind, terminator, result, x, dim, mask, terminator, intrinsic, - accumulator); -} - -template class COMPARE> -struct DoPartialMaxOrMinLocHelper { - template struct Functor { - // NVCC inlines more aggressively which causes too many specializations of - // this function to be inlined causing compiler timeouts. Set as - // noinline to allow compilation to complete. - RT_API_ATTRS RT_DEVICE_NOINLINE void operator()(const char *intrinsic, - Descriptor &result, const Descriptor &x, int kind, int dim, - const Descriptor *mask, bool back, Terminator &terminator) const { - DoPartialMaxOrMinLoc( - intrinsic, result, x, kind, dim, mask, terminator, back); - } - }; -}; - -template -inline RT_API_ATTRS void TypedPartialMaxOrMinLoc(const char *intrinsic, - Descriptor &result, const Descriptor &x, int kind, int dim, - const char *source, int line, const Descriptor *mask, bool back) { - Terminator terminator{source, line}; - CheckIntegerKind(terminator, kind, intrinsic); - auto catKind{x.type().GetCategoryAndKind()}; - RUNTIME_CHECK(terminator, catKind.has_value()); - const Descriptor *maskToUse{mask}; - SubscriptValue maskAt[maxRank]; // contents unused - if (mask && mask->rank() == 0) { - if (IsLogicalElementTrue(*mask, maskAt)) { - // A scalar MASK that's .TRUE. In this case, just get rid of the MASK. - maskToUse = nullptr; - } else { - // For scalar MASK arguments that are .FALSE., return all zeroes - - // Element size of the destination descriptor is the size - // of {TypeCategory::Integer, kind}. - CreatePartialReductionResult(result, x, - Descriptor::BytesFor(TypeCategory::Integer, kind), dim, terminator, - intrinsic, TypeCode{TypeCategory::Integer, kind}); - runtime::memset( - result.OffsetElement(), 0, result.Elements() * result.ElementBytes()); - return; - } - } - switch (catKind->first) { - case TypeCategory::Integer: - ApplyIntegerKind::template Functor, - void>(catKind->second, terminator, intrinsic, result, x, kind, dim, - maskToUse, back, terminator); - break; - case TypeCategory::Unsigned: - ApplyIntegerKind::template Functor, - void>(catKind->second, terminator, intrinsic, result, x, kind, dim, - maskToUse, back, terminator); - break; - case TypeCategory::Real: - ApplyFloatingPointKind::template Functor, - void>(catKind->second, terminator, intrinsic, result, x, kind, dim, - maskToUse, back, terminator); - break; - case TypeCategory::Character: - ApplyCharacterKind::template Functor, - void>(catKind->second, terminator, intrinsic, result, x, kind, dim, - maskToUse, back, terminator); - break; - default: - terminator.Crash( - "%s: bad data type code (%d) for array", intrinsic, x.type().raw()); - } -} - -extern "C" { -RT_EXT_API_GROUP_BEGIN - -void RTDEF(MaxlocDim)(Descriptor &result, const Descriptor &x, int kind, - int dim, const char *source, int line, const Descriptor *mask, bool back) { - TypedPartialMaxOrMinLoc( - "MAXLOC", result, x, kind, dim, source, line, mask, back); -} -void RTDEF(MinlocDim)(Descriptor &result, const Descriptor &x, int kind, - int dim, const char *source, int line, const Descriptor *mask, bool back) { - TypedPartialMaxOrMinLoc( - "MINLOC", result, x, kind, dim, source, line, mask, back); -} - -RT_EXT_API_GROUP_END -} // extern "C" - -// MAXVAL and MINVAL - -template -class NumericExtremumAccumulator { -public: - using Type = CppTypeFor; - explicit RT_API_ATTRS NumericExtremumAccumulator(const Descriptor &array) - : array_{array} {} - RT_API_ATTRS void Reinitialize() { - any_ = false; - extremum_ = MaxOrMinIdentity::Value(); - } - template - RT_API_ATTRS void GetResult(A *p, int /*zeroBasedDim*/ = -1) const { - *p = extremum_; - } - RT_API_ATTRS bool Accumulate(Type x) { - if (!any_) { - extremum_ = x; - any_ = true; - } else if (CAT == TypeCategory::Real && extremum_ != extremum_) { - extremum_ = x; // replace NaN - } else if constexpr (IS_MAXVAL) { - if (x > extremum_) { - extremum_ = x; - } - } else if (x < extremum_) { - extremum_ = x; - } - return true; - } - template - RT_API_ATTRS bool AccumulateAt(const SubscriptValue at[]) { - return Accumulate(*array_.Element(at)); - } - -private: - const Descriptor &array_; - bool any_{false}; - Type extremum_{MaxOrMinIdentity::Value()}; -}; - -template -inline RT_API_ATTRS CppTypeFor TotalNumericMaxOrMin( - const Descriptor &x, const char *source, int line, int dim, - const Descriptor *mask, const char *intrinsic) { - return GetTotalReduction(x, source, line, dim, mask, - NumericExtremumAccumulator{x}, intrinsic); -} - -template struct MaxOrMinHelper { - template struct Functor { - RT_API_ATTRS void operator()(Descriptor &result, const Descriptor &x, - int dim, const Descriptor *mask, const char *intrinsic, - Terminator &terminator) const { - DoMaxMinNorm2>( - result, x, dim, mask, intrinsic, terminator); - } - }; -}; - -template -inline RT_API_ATTRS void NumericMaxOrMin(Descriptor &result, - const Descriptor &x, int dim, const char *source, int line, - const Descriptor *mask, const char *intrinsic) { - Terminator terminator{source, line}; - auto type{x.type().GetCategoryAndKind()}; - RUNTIME_CHECK(terminator, type); - switch (type->first) { - case TypeCategory::Integer: - ApplyIntegerKind< - MaxOrMinHelper::template Functor, - void>( - type->second, terminator, result, x, dim, mask, intrinsic, terminator); - break; - case TypeCategory::Unsigned: - ApplyIntegerKind< - MaxOrMinHelper::template Functor, - void>( - type->second, terminator, result, x, dim, mask, intrinsic, terminator); - break; - case TypeCategory::Real: - ApplyFloatingPointKind< - MaxOrMinHelper::template Functor, void>( - type->second, terminator, result, x, dim, mask, intrinsic, terminator); - break; - default: - terminator.Crash("%s: bad type code %d", intrinsic, x.type().raw()); - } -} - -template class CharacterExtremumAccumulator { -public: - using Type = CppTypeFor; - explicit RT_API_ATTRS CharacterExtremumAccumulator(const Descriptor &array) - : array_{array}, charLen_{array_.ElementBytes() / KIND} {} - RT_API_ATTRS void Reinitialize() { extremum_ = nullptr; } - template - RT_API_ATTRS void GetResult(A *p, int /*zeroBasedDim*/ = -1) const { - static_assert(std::is_same_v); - std::size_t byteSize{array_.ElementBytes()}; - if (extremum_) { - runtime::memcpy(p, extremum_, byteSize); - } else { - // Empty array; fill with character 0 for MAXVAL. - // For MINVAL, set all of the bits. - runtime::memset(p, IS_MAXVAL ? 0 : 255, byteSize); - } - } - RT_API_ATTRS bool Accumulate(const Type *x) { - if (!extremum_) { - extremum_ = x; - } else { - int cmp{CharacterScalarCompare(x, extremum_, charLen_, charLen_)}; - if (IS_MAXVAL == (cmp > 0)) { - extremum_ = x; - } - } - return true; - } - template - RT_API_ATTRS bool AccumulateAt(const SubscriptValue at[]) { - return Accumulate(array_.Element(at)); - } - -private: - const Descriptor &array_; - std::size_t charLen_; - const Type *extremum_{nullptr}; -}; - -template struct CharacterMaxOrMinHelper { - template struct Functor { - RT_API_ATTRS void operator()(Descriptor &result, const Descriptor &x, - int dim, const Descriptor *mask, const char *intrinsic, - Terminator &terminator) const { - DoMaxMinNorm2>( - result, x, dim, mask, intrinsic, terminator); - } - }; -}; - -template -inline RT_API_ATTRS void CharacterMaxOrMin(Descriptor &result, - const Descriptor &x, int dim, const char *source, int line, - const Descriptor *mask, const char *intrinsic) { - Terminator terminator{source, line}; - auto type{x.type().GetCategoryAndKind()}; - RUNTIME_CHECK(terminator, type && type->first == TypeCategory::Character); - ApplyCharacterKind::template Functor, - void>( - type->second, terminator, result, x, dim, mask, intrinsic, terminator); -} - -extern "C" { -RT_EXT_API_GROUP_BEGIN - -CppTypeFor RTDEF(MaxvalInteger1)(const Descriptor &x, - const char *source, int line, int dim, const Descriptor *mask) { - return TotalNumericMaxOrMin( - x, source, line, dim, mask, "MAXVAL"); -} -CppTypeFor RTDEF(MaxvalInteger2)(const Descriptor &x, - const char *source, int line, int dim, const Descriptor *mask) { - return TotalNumericMaxOrMin( - x, source, line, dim, mask, "MAXVAL"); -} -CppTypeFor RTDEF(MaxvalInteger4)(const Descriptor &x, - const char *source, int line, int dim, const Descriptor *mask) { - return TotalNumericMaxOrMin( - x, source, line, dim, mask, "MAXVAL"); -} -CppTypeFor RTDEF(MaxvalInteger8)(const Descriptor &x, - const char *source, int line, int dim, const Descriptor *mask) { - return TotalNumericMaxOrMin( - x, source, line, dim, mask, "MAXVAL"); -} -#ifdef __SIZEOF_INT128__ -CppTypeFor RTDEF(MaxvalInteger16)( - const Descriptor &x, const char *source, int line, int dim, - const Descriptor *mask) { - return TotalNumericMaxOrMin( - x, source, line, dim, mask, "MAXVAL"); -} -#endif - -CppTypeFor RTDEF(MaxvalUnsigned1)( - const Descriptor &x, const char *source, int line, int dim, - const Descriptor *mask) { - return TotalNumericMaxOrMin( - x, source, line, dim, mask, "MAXVAL"); -} -CppTypeFor RTDEF(MaxvalUnsigned2)( - const Descriptor &x, const char *source, int line, int dim, - const Descriptor *mask) { - return TotalNumericMaxOrMin( - x, source, line, dim, mask, "MAXVAL"); -} -CppTypeFor RTDEF(MaxvalUnsigned4)( - const Descriptor &x, const char *source, int line, int dim, - const Descriptor *mask) { - return TotalNumericMaxOrMin( - x, source, line, dim, mask, "MAXVAL"); -} -CppTypeFor RTDEF(MaxvalUnsigned8)( - const Descriptor &x, const char *source, int line, int dim, - const Descriptor *mask) { - return TotalNumericMaxOrMin( - x, source, line, dim, mask, "MAXVAL"); -} -#ifdef __SIZEOF_INT128__ -CppTypeFor RTDEF(MaxvalUnsigned16)( - const Descriptor &x, const char *source, int line, int dim, - const Descriptor *mask) { - return TotalNumericMaxOrMin( - x, source, line, dim, mask, "MAXVAL"); -} -#endif - -// TODO: REAL(2 & 3) -CppTypeFor RTDEF(MaxvalReal4)(const Descriptor &x, - const char *source, int line, int dim, const Descriptor *mask) { - return TotalNumericMaxOrMin( - x, source, line, dim, mask, "MAXVAL"); -} -CppTypeFor RTDEF(MaxvalReal8)(const Descriptor &x, - const char *source, int line, int dim, const Descriptor *mask) { - return TotalNumericMaxOrMin( - x, source, line, dim, mask, "MAXVAL"); -} -#if HAS_FLOAT80 -CppTypeFor RTDEF(MaxvalReal10)(const Descriptor &x, - const char *source, int line, int dim, const Descriptor *mask) { - return TotalNumericMaxOrMin( - x, source, line, dim, mask, "MAXVAL"); -} -#endif -#if HAS_LDBL128 || HAS_FLOAT128 -CppTypeFor RTDEF(MaxvalReal16)(const Descriptor &x, - const char *source, int line, int dim, const Descriptor *mask) { - return TotalNumericMaxOrMin( - x, source, line, dim, mask, "MAXVAL"); -} -#endif - -void RTDEF(MaxvalCharacter)(Descriptor &result, const Descriptor &x, - const char *source, int line, const Descriptor *mask) { - CharacterMaxOrMin(result, x, 0, source, line, mask, "MAXVAL"); -} - -CppTypeFor RTDEF(MinvalInteger1)(const Descriptor &x, - const char *source, int line, int dim, const Descriptor *mask) { - return TotalNumericMaxOrMin( - x, source, line, dim, mask, "MINVAL"); -} -CppTypeFor RTDEF(MinvalInteger2)(const Descriptor &x, - const char *source, int line, int dim, const Descriptor *mask) { - return TotalNumericMaxOrMin( - x, source, line, dim, mask, "MINVAL"); -} -CppTypeFor RTDEF(MinvalInteger4)(const Descriptor &x, - const char *source, int line, int dim, const Descriptor *mask) { - return TotalNumericMaxOrMin( - x, source, line, dim, mask, "MINVAL"); -} -CppTypeFor RTDEF(MinvalInteger8)(const Descriptor &x, - const char *source, int line, int dim, const Descriptor *mask) { - return TotalNumericMaxOrMin( - x, source, line, dim, mask, "MINVAL"); -} -#ifdef __SIZEOF_INT128__ -CppTypeFor RTDEF(MinvalInteger16)( - const Descriptor &x, const char *source, int line, int dim, - const Descriptor *mask) { - return TotalNumericMaxOrMin( - x, source, line, dim, mask, "MINVAL"); -} -#endif - -CppTypeFor RTDEF(MinvalUnsigned1)( - const Descriptor &x, const char *source, int line, int dim, - const Descriptor *mask) { - return TotalNumericMaxOrMin( - x, source, line, dim, mask, "MINVAL"); -} -CppTypeFor RTDEF(MinvalUnsigned2)( - const Descriptor &x, const char *source, int line, int dim, - const Descriptor *mask) { - return TotalNumericMaxOrMin( - x, source, line, dim, mask, "MINVAL"); -} -CppTypeFor RTDEF(MinvalUnsigned4)( - const Descriptor &x, const char *source, int line, int dim, - const Descriptor *mask) { - return TotalNumericMaxOrMin( - x, source, line, dim, mask, "MINVAL"); -} -CppTypeFor RTDEF(MinvalUnsigned8)( - const Descriptor &x, const char *source, int line, int dim, - const Descriptor *mask) { - return TotalNumericMaxOrMin( - x, source, line, dim, mask, "MINVAL"); -} -#ifdef __SIZEOF_INT128__ -CppTypeFor RTDEF(MinvalUnsigned16)( - const Descriptor &x, const char *source, int line, int dim, - const Descriptor *mask) { - return TotalNumericMaxOrMin( - x, source, line, dim, mask, "MINVAL"); -} -#endif - -// TODO: REAL(2 & 3) -CppTypeFor RTDEF(MinvalReal4)(const Descriptor &x, - const char *source, int line, int dim, const Descriptor *mask) { - return TotalNumericMaxOrMin( - x, source, line, dim, mask, "MINVAL"); -} -CppTypeFor RTDEF(MinvalReal8)(const Descriptor &x, - const char *source, int line, int dim, const Descriptor *mask) { - return TotalNumericMaxOrMin( - x, source, line, dim, mask, "MINVAL"); -} -#if HAS_FLOAT80 -CppTypeFor RTDEF(MinvalReal10)(const Descriptor &x, - const char *source, int line, int dim, const Descriptor *mask) { - return TotalNumericMaxOrMin( - x, source, line, dim, mask, "MINVAL"); -} -#endif -#if HAS_LDBL128 || HAS_FLOAT128 -CppTypeFor RTDEF(MinvalReal16)(const Descriptor &x, - const char *source, int line, int dim, const Descriptor *mask) { - return TotalNumericMaxOrMin( - x, source, line, dim, mask, "MINVAL"); -} -#endif - -void RTDEF(MinvalCharacter)(Descriptor &result, const Descriptor &x, - const char *source, int line, const Descriptor *mask) { - CharacterMaxOrMin(result, x, 0, source, line, mask, "MINVAL"); -} - -void RTDEF(MaxvalDim)(Descriptor &result, const Descriptor &x, int dim, - const char *source, int line, const Descriptor *mask) { - if (x.type().IsCharacter()) { - CharacterMaxOrMin(result, x, dim, source, line, mask, "MAXVAL"); - } else { - NumericMaxOrMin(result, x, dim, source, line, mask, "MAXVAL"); - } -} -void RTDEF(MinvalDim)(Descriptor &result, const Descriptor &x, int dim, - const char *source, int line, const Descriptor *mask) { - if (x.type().IsCharacter()) { - CharacterMaxOrMin(result, x, dim, source, line, mask, "MINVAL"); - } else { - NumericMaxOrMin(result, x, dim, source, line, mask, "MINVAL"); - } -} - -RT_EXT_API_GROUP_END -} // extern "C" - -// NORM2 - -extern "C" { -RT_EXT_API_GROUP_BEGIN - -// TODO: REAL(2 & 3) -CppTypeFor RTDEF(Norm2_4)( - const Descriptor &x, const char *source, int line, int dim) { - return GetTotalReduction( - x, source, line, dim, nullptr, Norm2Accumulator<4>{x}, "NORM2"); -} -CppTypeFor RTDEF(Norm2_8)( - const Descriptor &x, const char *source, int line, int dim) { - return GetTotalReduction( - x, source, line, dim, nullptr, Norm2Accumulator<8>{x}, "NORM2"); -} -#if HAS_FLOAT80 -CppTypeFor RTDEF(Norm2_10)( - const Descriptor &x, const char *source, int line, int dim) { - return GetTotalReduction( - x, source, line, dim, nullptr, Norm2Accumulator<10>{x}, "NORM2"); -} -#endif - -void RTDEF(Norm2Dim)(Descriptor &result, const Descriptor &x, int dim, - const char *source, int line) { - Terminator terminator{source, line}; - auto type{x.type().GetCategoryAndKind()}; - RUNTIME_CHECK(terminator, type); - if (type->first == TypeCategory::Real) { - ApplyFloatingPointKind( - type->second, terminator, result, x, dim, nullptr, terminator); - } else { - terminator.Crash("NORM2: bad type code %d", x.type().raw()); - } -} - -RT_EXT_API_GROUP_END -} // extern "C" -} // namespace Fortran::runtime diff --git a/flang-rt/lib/runtime/extrema.h b/flang-rt/lib/runtime/extrema.h new file mode 100644 index 0000000000000..c363efdf3f961 --- /dev/null +++ b/flang-rt/lib/runtime/extrema.h @@ -0,0 +1,434 @@ +//===-- lib/runtime/extrema.h -----------------------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +// Implements MAXLOC, MINLOC, MAXVAL, & MINVAL for all required operand types +// and shapes and (for MAXLOC & MINLOC) result integer kinds. Also implements +// NORM2 using common infrastructure. + +#ifndef FLANG_RT_RUNTIME_EXTREMA_H_ +#define FLANG_RT_RUNTIME_EXTREMA_H_ + +#include "flang-rt/runtime/reduction-templates.h" +#include "flang/Common/float128.h" +#include "flang/Runtime/character.h" +#include "flang/Runtime/reduction.h" +#include +#include +#include +#include +#include + +namespace Fortran::runtime { + +// MAXLOC & MINLOC + +template struct NumericCompare { + using Type = T; + explicit RT_API_ATTRS NumericCompare(std::size_t /*elemLen*/, bool back) + : back_{back} {} + RT_API_ATTRS bool operator()(const T &value, const T &previous) const { + if (std::is_floating_point_v && previous != previous) { + return back_ || value == value; // replace NaN + } else if (value == previous) { + return back_; + } else if constexpr (IS_MAX) { + return value > previous; + } else { + return value < previous; + } + } + +private: + bool back_; +}; + +template class CharacterCompare { +public: + using Type = T; + explicit RT_API_ATTRS CharacterCompare(std::size_t elemLen, bool back) + : chars_{elemLen / sizeof(T)}, back_{back} {} + RT_API_ATTRS bool operator()(const T &value, const T &previous) const { + int cmp{CharacterScalarCompare(&value, &previous, chars_, chars_)}; + if (cmp == 0) { + return back_; + } else if constexpr (IS_MAX) { + return cmp > 0; + } else { + return cmp < 0; + } + } + +private: + std::size_t chars_; + bool back_; +}; + +template class ExtremumLocAccumulator { +public: + using Type = typename COMPARE::Type; + RT_API_ATTRS ExtremumLocAccumulator(const Descriptor &array, bool back) + : array_{array}, argRank_{array.rank()}, + compare_{array.ElementBytes(), back} { + Reinitialize(); + } + RT_API_ATTRS void Reinitialize() { + for (int j{0}; j < argRank_; ++j) { + extremumLoc_[j] = 0; + } + previous_ = nullptr; + } + RT_API_ATTRS int argRank() const { return argRank_; } + template + RT_API_ATTRS void GetResult(A *p, int zeroBasedDim = -1) { + if (zeroBasedDim >= 0) { + *p = extremumLoc_[zeroBasedDim]; + } else { + for (int j{0}; j < argRank_; ++j) { + p[j] = extremumLoc_[j]; + } + } + } + template + RT_API_ATTRS bool AccumulateAt(const SubscriptValue at[]) { + const auto &value{*array_.Element(at)}; + if (!previous_ || compare_(value, *previous_)) { + previous_ = &value; + for (int j{0}; j < argRank_; ++j) { + extremumLoc_[j] = at[j] - array_.GetDimension(j).LowerBound() + 1; + } + } + return true; + } + +private: + const Descriptor &array_; + int argRank_; + SubscriptValue extremumLoc_[maxRank]; + const Type *previous_{nullptr}; + COMPARE compare_; +}; + +template +inline RT_API_ATTRS void LocationHelper(const char *intrinsic, + Descriptor &result, const Descriptor &x, int kind, const Descriptor *mask, + Terminator &terminator, bool back) { + ACCUMULATOR accumulator{x, back}; + DoTotalReduction(x, 0, mask, accumulator, intrinsic, terminator); + ApplyIntegerKind::template Functor, void>( + kind, terminator, accumulator, result); +} + +template class COMPARE> +inline RT_API_ATTRS void DoMaxOrMinLoc(const char *intrinsic, + Descriptor &result, const Descriptor &x, int kind, const char *source, + int line, const Descriptor *mask, bool back) { + using CppType = CppTypeFor; + Terminator terminator{source, line}; + LocationHelper>, CppType>( + intrinsic, result, x, kind, mask, terminator, back); +} + +template struct CharacterMaxOrMinLocHelper { + template struct Functor { + RT_API_ATTRS void operator()(const char *intrinsic, Descriptor &result, + const Descriptor &x, int kind, const char *source, int line, + const Descriptor *mask, bool back) const { + DoMaxOrMinLoc( + intrinsic, result, x, kind, source, line, mask, back); + } + }; +}; + +template +inline RT_API_ATTRS void CharacterMaxOrMinLoc(const char *intrinsic, + Descriptor &result, const Descriptor &x, int kind, const char *source, + int line, const Descriptor *mask, bool back) { + int rank{x.rank()}; + SubscriptValue extent[1]{rank}; + result.Establish(TypeCategory::Integer, kind, nullptr, 1, extent, + CFI_attribute_allocatable); + result.GetDimension(0).SetBounds(1, extent[0]); + Terminator terminator{source, line}; + if (int stat{result.Allocate(kNoAsyncObject)}) { + terminator.Crash( + "%s: could not allocate memory for result; STAT=%d", intrinsic, stat); + } + CheckIntegerKind(terminator, kind, intrinsic); + auto catKind{x.type().GetCategoryAndKind()}; + RUNTIME_CHECK(terminator, catKind.has_value()); + switch (catKind->first) { + case TypeCategory::Character: + ApplyCharacterKind::template Functor, + void>(catKind->second, terminator, intrinsic, result, x, kind, source, + line, mask, back); + break; + default: + terminator.Crash( + "%s: bad data type code (%d) for array", intrinsic, x.type().raw()); + } +} + +template +inline RT_API_ATTRS void TotalNumericMaxOrMinLoc(const char *intrinsic, + Descriptor &result, const Descriptor &x, int kind, const char *source, + int line, const Descriptor *mask, bool back) { + int rank{x.rank()}; + SubscriptValue extent[1]{rank}; + result.Establish(TypeCategory::Integer, kind, nullptr, 1, extent, + CFI_attribute_allocatable); + result.GetDimension(0).SetBounds(1, extent[0]); + Terminator terminator{source, line}; + if (int stat{result.Allocate(kNoAsyncObject)}) { + terminator.Crash( + "%s: could not allocate memory for result; STAT=%d", intrinsic, stat); + } + CheckIntegerKind(terminator, kind, intrinsic); + RUNTIME_CHECK(terminator, TypeCode(CAT, KIND) == x.type()); + DoMaxOrMinLoc( + intrinsic, result, x, kind, source, line, mask, back); +} + +// MAXLOC/MINLOC with DIM= + +template class COMPARE> +inline RT_API_ATTRS void DoPartialMaxOrMinLoc(const char *intrinsic, + Descriptor &result, const Descriptor &x, int kind, int dim, + const Descriptor *mask, Terminator &terminator, bool back) { + using CppType = CppTypeFor; + using Accumulator = ExtremumLocAccumulator>; + Accumulator accumulator{x, back}; + ApplyIntegerKind::template Functor, void>( + kind, terminator, result, x, dim, mask, terminator, intrinsic, + accumulator); +} + +template class COMPARE> +struct DoPartialMaxOrMinLocHelper { + template struct Functor { + RT_API_ATTRS RT_DEVICE_NOINLINE void operator()(const char *intrinsic, + Descriptor &result, const Descriptor &x, int kind, int dim, + const Descriptor *mask, bool back, Terminator &terminator) const { + DoPartialMaxOrMinLoc( + intrinsic, result, x, kind, dim, mask, terminator, back); + } + }; +}; + +template +inline RT_API_ATTRS void TypedPartialMaxOrMinLoc(const char *intrinsic, + Descriptor &result, const Descriptor &x, int kind, int dim, + const char *source, int line, const Descriptor *mask, bool back) { + Terminator terminator{source, line}; + CheckIntegerKind(terminator, kind, intrinsic); + auto catKind{x.type().GetCategoryAndKind()}; + RUNTIME_CHECK(terminator, catKind.has_value()); + const Descriptor *maskToUse{mask}; + SubscriptValue maskAt[maxRank]; // contents unused + if (mask && mask->rank() == 0) { + if (IsLogicalElementTrue(*mask, maskAt)) { + maskToUse = nullptr; + } else { + CreatePartialReductionResult(result, x, + Descriptor::BytesFor(TypeCategory::Integer, kind), dim, terminator, + intrinsic, TypeCode{TypeCategory::Integer, kind}); + runtime::memset( + result.OffsetElement(), 0, result.Elements() * result.ElementBytes()); + return; + } + } + switch (catKind->first) { + case TypeCategory::Integer: + ApplyIntegerKind::template Functor, + void>(catKind->second, terminator, intrinsic, result, x, kind, dim, + maskToUse, back, terminator); + break; + case TypeCategory::Unsigned: + ApplyIntegerKind::template Functor, + void>(catKind->second, terminator, intrinsic, result, x, kind, dim, + maskToUse, back, terminator); + break; + case TypeCategory::Real: + ApplyFloatingPointKind::template Functor, + void>(catKind->second, terminator, intrinsic, result, x, kind, dim, + maskToUse, back, terminator); + break; + case TypeCategory::Character: + ApplyCharacterKind::template Functor, + void>(catKind->second, terminator, intrinsic, result, x, kind, dim, + maskToUse, back, terminator); + break; + default: + terminator.Crash( + "%s: bad data type code (%d) for array", intrinsic, x.type().raw()); + } +} + +// MAXVAL and MINVAL + +template +class NumericExtremumAccumulator { +public: + using Type = CppTypeFor; + explicit RT_API_ATTRS NumericExtremumAccumulator(const Descriptor &array) + : array_{array} {} + RT_API_ATTRS void Reinitialize() { + any_ = false; + extremum_ = MaxOrMinIdentity::Value(); + } + template + RT_API_ATTRS void GetResult(A *p, int /*zeroBasedDim*/ = -1) const { + *p = extremum_; + } + RT_API_ATTRS bool Accumulate(Type x) { + if (!any_) { + extremum_ = x; + any_ = true; + } else if (CAT == TypeCategory::Real && extremum_ != extremum_) { + extremum_ = x; // replace NaN + } else if constexpr (IS_MAXVAL) { + if (x > extremum_) { + extremum_ = x; + } + } else if (x < extremum_) { + extremum_ = x; + } + return true; + } + template + RT_API_ATTRS bool AccumulateAt(const SubscriptValue at[]) { + return Accumulate(*array_.Element(at)); + } + +private: + const Descriptor &array_; + bool any_{false}; + Type extremum_{MaxOrMinIdentity::Value()}; +}; + +template +inline RT_API_ATTRS CppTypeFor TotalNumericMaxOrMin( + const Descriptor &x, const char *source, int line, int dim, + const Descriptor *mask, const char *intrinsic) { + return GetTotalReduction(x, source, line, dim, mask, + NumericExtremumAccumulator{x}, intrinsic); +} + +template struct MaxOrMinHelper { + template struct Functor { + RT_API_ATTRS void operator()(Descriptor &result, const Descriptor &x, + int dim, const Descriptor *mask, const char *intrinsic, + Terminator &terminator) const { + DoMaxMinNorm2>( + result, x, dim, mask, intrinsic, terminator); + } + }; +}; + +template +inline RT_API_ATTRS void NumericMaxOrMin(Descriptor &result, + const Descriptor &x, int dim, const char *source, int line, + const Descriptor *mask, const char *intrinsic) { + Terminator terminator{source, line}; + auto type{x.type().GetCategoryAndKind()}; + RUNTIME_CHECK(terminator, type); + switch (type->first) { + case TypeCategory::Integer: + ApplyIntegerKind< + MaxOrMinHelper::template Functor, + void>( + type->second, terminator, result, x, dim, mask, intrinsic, terminator); + break; + case TypeCategory::Unsigned: + ApplyIntegerKind< + MaxOrMinHelper::template Functor, + void>( + type->second, terminator, result, x, dim, mask, intrinsic, terminator); + break; + case TypeCategory::Real: + ApplyFloatingPointKind< + MaxOrMinHelper::template Functor, void>( + type->second, terminator, result, x, dim, mask, intrinsic, terminator); + break; + default: + terminator.Crash("%s: bad type code %d", intrinsic, x.type().raw()); + } +} + +template class CharacterExtremumAccumulator { +public: + using Type = CppTypeFor; + explicit RT_API_ATTRS CharacterExtremumAccumulator(const Descriptor &array) + : array_{array}, charLen_{array_.ElementBytes() / KIND} {} + RT_API_ATTRS void Reinitialize() { extremum_ = nullptr; } + template + RT_API_ATTRS void GetResult(A *p, int /*zeroBasedDim*/ = -1) const { + static_assert(std::is_same_v); + std::size_t byteSize{array_.ElementBytes()}; + if (extremum_) { + runtime::memcpy(p, extremum_, byteSize); + } else { + runtime::memset(p, IS_MAXVAL ? 0 : 255, byteSize); + } + } + RT_API_ATTRS bool Accumulate(const Type *x) { + if (!extremum_) { + extremum_ = x; + } else { + int cmp{CharacterScalarCompare(x, extremum_, charLen_, charLen_)}; + if (IS_MAXVAL == (cmp > 0)) { + extremum_ = x; + } + } + return true; + } + template + RT_API_ATTRS bool AccumulateAt(const SubscriptValue at[]) { + return Accumulate(array_.Element(at)); + } + +private: + const Descriptor &array_; + std::size_t charLen_; + const Type *extremum_{nullptr}; +}; + +template struct CharacterMaxOrMinHelper { + template struct Functor { + RT_API_ATTRS void operator()(Descriptor &result, const Descriptor &x, + int dim, const Descriptor *mask, const char *intrinsic, + Terminator &terminator) const { + DoMaxMinNorm2>( + result, x, dim, mask, intrinsic, terminator); + } + }; +}; + +template +inline RT_API_ATTRS void CharacterMaxOrMin(Descriptor &result, + const Descriptor &x, int dim, const char *source, int line, + const Descriptor *mask, const char *intrinsic) { + Terminator terminator{source, line}; + auto type{x.type().GetCategoryAndKind()}; + RUNTIME_CHECK(terminator, type && type->first == TypeCategory::Character); + ApplyCharacterKind::template Functor, + void>( + type->second, terminator, result, x, dim, mask, intrinsic, terminator); +} + +} // namespace Fortran::runtime + +#endif // FLANG_RT_RUNTIME_EXTREMA_H_ diff --git a/flang-rt/lib/runtime/findloc-dim.cpp b/flang-rt/lib/runtime/findloc-dim.cpp new file mode 100644 index 0000000000000..105d610d06539 --- /dev/null +++ b/flang-rt/lib/runtime/findloc-dim.cpp @@ -0,0 +1,66 @@ +//===-- lib/runtime/findloc-dim.cpp -----------------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +// Implements FINDLOC with DIM= for all required operand types and shapes and +// result integer kinds. + +#include "findloc.h" + +namespace Fortran::runtime { +extern "C" { +RT_EXT_API_GROUP_BEGIN + +void RTDEF(FindlocDim)(Descriptor &result, const Descriptor &x, + const Descriptor &target, int kind, int dim, const char *source, int line, + const Descriptor *mask, bool back) { + Terminator terminator{source, line}; + CheckIntegerKind(terminator, kind, "FINDLOC"); + auto xType{x.type().GetCategoryAndKind()}; + auto targetType{target.type().GetCategoryAndKind()}; + RUNTIME_CHECK(terminator, xType.has_value() && targetType.has_value()); + switch (xType->first) { + case TypeCategory::Integer: + case TypeCategory::Unsigned: + ApplyIntegerKind< + PartialNumericFindlocSource::template Functor, + void>(xType->second, terminator, targetType->first, targetType->second, + result, x, target, kind, dim, mask, back, terminator); + break; + case TypeCategory::Real: + ApplyFloatingPointKind< + PartialNumericFindlocSource::template Functor, + void>(xType->second, terminator, targetType->first, targetType->second, + result, x, target, kind, dim, mask, back, terminator); + break; + case TypeCategory::Complex: + ApplyFloatingPointKind< + PartialNumericFindlocSource::template Functor, + void>(xType->second, terminator, targetType->first, targetType->second, + result, x, target, kind, dim, mask, back, terminator); + break; + case TypeCategory::Character: + RUNTIME_CHECK(terminator, + targetType->first == TypeCategory::Character && + targetType->second == xType->second); + ApplyCharacterKind(xType->second, + terminator, result, x, target, kind, dim, mask, back, terminator); + break; + case TypeCategory::Logical: + RUNTIME_CHECK(terminator, targetType->first == TypeCategory::Logical); + PartialLogicalFindlocHelper( + result, x, target, kind, dim, mask, back, terminator); + break; + default: + terminator.Crash( + "FINDLOC: bad data type code (%d) for array", x.type().raw()); + } +} + +RT_EXT_API_GROUP_END +} // extern "C" +} // namespace Fortran::runtime diff --git a/flang-rt/lib/runtime/findloc-total.cpp b/flang-rt/lib/runtime/findloc-total.cpp new file mode 100644 index 0000000000000..5777377f8334f --- /dev/null +++ b/flang-rt/lib/runtime/findloc-total.cpp @@ -0,0 +1,74 @@ +//===-- lib/runtime/findloc-total.cpp ---------------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +// Implements total FINDLOC for all required operand types and shapes and +// result integer kinds. + +#include "findloc.h" + +namespace Fortran::runtime { +extern "C" { +RT_EXT_API_GROUP_BEGIN + +void RTDEF(Findloc)(Descriptor &result, const Descriptor &x, + const Descriptor &target, int kind, const char *source, int line, + const Descriptor *mask, bool back) { + int rank{x.rank()}; + SubscriptValue extent[1]{rank}; + result.Establish(TypeCategory::Integer, kind, nullptr, 1, extent, + CFI_attribute_allocatable); + result.GetDimension(0).SetBounds(1, extent[0]); + Terminator terminator{source, line}; + if (int stat{result.Allocate(kNoAsyncObject)}) { + terminator.Crash( + "FINDLOC: could not allocate memory for result; STAT=%d", stat); + } + CheckIntegerKind(terminator, kind, "FINDLOC"); + auto xType{x.type().GetCategoryAndKind()}; + auto targetType{target.type().GetCategoryAndKind()}; + RUNTIME_CHECK(terminator, xType.has_value() && targetType.has_value()); + switch (xType->first) { + case TypeCategory::Integer: + case TypeCategory::Unsigned: + ApplyIntegerKind< + TotalNumericFindlocSource::template Functor, + void>(xType->second, terminator, targetType->first, targetType->second, + result, x, target, kind, 0, mask, back, terminator); + break; + case TypeCategory::Real: + ApplyFloatingPointKind< + TotalNumericFindlocSource::template Functor, void>( + xType->second, terminator, targetType->first, targetType->second, + result, x, target, kind, 0, mask, back, terminator); + break; + case TypeCategory::Complex: + ApplyFloatingPointKind< + TotalNumericFindlocSource::template Functor, + void>(xType->second, terminator, targetType->first, targetType->second, + result, x, target, kind, 0, mask, back, terminator); + break; + case TypeCategory::Character: + RUNTIME_CHECK(terminator, + targetType->first == TypeCategory::Character && + targetType->second == xType->second); + ApplyCharacterKind(xType->second, terminator, + result, x, target, kind, mask, back, terminator); + break; + case TypeCategory::Logical: + RUNTIME_CHECK(terminator, targetType->first == TypeCategory::Logical); + LogicalFindlocHelper(result, x, target, kind, mask, back, terminator); + break; + default: + terminator.Crash( + "FINDLOC: bad data type code (%d) for array", x.type().raw()); + } +} + +RT_EXT_API_GROUP_END +} // extern "C" +} // namespace Fortran::runtime diff --git a/flang-rt/lib/runtime/findloc.cpp b/flang-rt/lib/runtime/findloc.h similarity index 70% rename from flang-rt/lib/runtime/findloc.cpp rename to flang-rt/lib/runtime/findloc.h index d35f6d9bdb05f..bc7036724a7b7 100644 --- a/flang-rt/lib/runtime/findloc.cpp +++ b/flang-rt/lib/runtime/findloc.h @@ -1,4 +1,4 @@ -//===-- lib/runtime/findloc.cpp ---------------------------------*- C++ -*-===// +//===-- lib/runtime/findloc.h -----------------------------------*- C++ -*-===// // // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. // See https://llvm.org/LICENSE.txt for license information. @@ -9,6 +9,9 @@ // Implements FINDLOC for all required operand types and shapes and result // integer kinds. +#ifndef FLANG_RT_RUNTIME_FINDLOC_H_ +#define FLANG_RT_RUNTIME_FINDLOC_H_ + #include "flang-rt/runtime/reduction-templates.h" #include "flang/Runtime/character.h" #include "flang/Runtime/reduction.h" @@ -243,7 +246,7 @@ template struct CharacterFindlocHelper { } }; -static RT_API_ATTRS void LogicalFindlocHelper(Descriptor &result, +inline RT_API_ATTRS void LogicalFindlocHelper(Descriptor &result, const Descriptor &x, const Descriptor &target, int kind, const Descriptor *mask, bool back, Terminator &terminator) { using Accumulator = LocationAccumulator; @@ -253,68 +256,6 @@ static RT_API_ATTRS void LogicalFindlocHelper(Descriptor &result, kind, terminator, accumulator, result); } -extern "C" { -RT_EXT_API_GROUP_BEGIN - -void RTDEF(Findloc)(Descriptor &result, const Descriptor &x, - const Descriptor &target, int kind, const char *source, int line, - const Descriptor *mask, bool back) { - int rank{x.rank()}; - SubscriptValue extent[1]{rank}; - result.Establish(TypeCategory::Integer, kind, nullptr, 1, extent, - CFI_attribute_allocatable); - result.GetDimension(0).SetBounds(1, extent[0]); - Terminator terminator{source, line}; - if (int stat{result.Allocate(kNoAsyncObject)}) { - terminator.Crash( - "FINDLOC: could not allocate memory for result; STAT=%d", stat); - } - CheckIntegerKind(terminator, kind, "FINDLOC"); - auto xType{x.type().GetCategoryAndKind()}; - auto targetType{target.type().GetCategoryAndKind()}; - RUNTIME_CHECK(terminator, xType.has_value() && targetType.has_value()); - switch (xType->first) { - case TypeCategory::Integer: - case TypeCategory::Unsigned: - ApplyIntegerKind< - TotalNumericFindlocSource::template Functor, - void>(xType->second, terminator, targetType->first, targetType->second, - result, x, target, kind, 0, mask, back, terminator); - break; - case TypeCategory::Real: - ApplyFloatingPointKind< - TotalNumericFindlocSource::template Functor, void>( - xType->second, terminator, targetType->first, targetType->second, - result, x, target, kind, 0, mask, back, terminator); - break; - case TypeCategory::Complex: - ApplyFloatingPointKind< - TotalNumericFindlocSource::template Functor, - void>(xType->second, terminator, targetType->first, targetType->second, - result, x, target, kind, 0, mask, back, terminator); - break; - case TypeCategory::Character: - RUNTIME_CHECK(terminator, - targetType->first == TypeCategory::Character && - targetType->second == xType->second); - ApplyCharacterKind(xType->second, terminator, - result, x, target, kind, mask, back, terminator); - break; - case TypeCategory::Logical: - RUNTIME_CHECK(terminator, targetType->first == TypeCategory::Logical); - LogicalFindlocHelper(result, x, target, kind, mask, back, terminator); - break; - default: - terminator.Crash( - "FINDLOC: bad data type code (%d) for array", x.type().raw()); - } -} - -RT_EXT_API_GROUP_END -} // extern "C" - -// FINDLOC with DIM= - template struct PartialNumericFindlocSource { template struct Functor { RT_API_ATTRS RT_DEVICE_NOINLINE void operator()(TypeCategory targetCat, @@ -343,7 +284,7 @@ template struct PartialCharacterFindlocHelper { } }; -static RT_API_ATTRS void PartialLogicalFindlocHelper(Descriptor &result, +inline RT_API_ATTRS void PartialLogicalFindlocHelper(Descriptor &result, const Descriptor &x, const Descriptor &target, int kind, int dim, const Descriptor *mask, bool back, Terminator &terminator) { using Accumulator = LocationAccumulator; @@ -353,55 +294,6 @@ static RT_API_ATTRS void PartialLogicalFindlocHelper(Descriptor &result, accumulator); } -extern "C" { -RT_EXT_API_GROUP_BEGIN - -void RTDEF(FindlocDim)(Descriptor &result, const Descriptor &x, - const Descriptor &target, int kind, int dim, const char *source, int line, - const Descriptor *mask, bool back) { - Terminator terminator{source, line}; - CheckIntegerKind(terminator, kind, "FINDLOC"); - auto xType{x.type().GetCategoryAndKind()}; - auto targetType{target.type().GetCategoryAndKind()}; - RUNTIME_CHECK(terminator, xType.has_value() && targetType.has_value()); - switch (xType->first) { - case TypeCategory::Integer: - case TypeCategory::Unsigned: - ApplyIntegerKind< - PartialNumericFindlocSource::template Functor, - void>(xType->second, terminator, targetType->first, targetType->second, - result, x, target, kind, dim, mask, back, terminator); - break; - case TypeCategory::Real: - ApplyFloatingPointKind< - PartialNumericFindlocSource::template Functor, - void>(xType->second, terminator, targetType->first, targetType->second, - result, x, target, kind, dim, mask, back, terminator); - break; - case TypeCategory::Complex: - ApplyFloatingPointKind< - PartialNumericFindlocSource::template Functor, - void>(xType->second, terminator, targetType->first, targetType->second, - result, x, target, kind, dim, mask, back, terminator); - break; - case TypeCategory::Character: - RUNTIME_CHECK(terminator, - targetType->first == TypeCategory::Character && - targetType->second == xType->second); - ApplyCharacterKind(xType->second, - terminator, result, x, target, kind, dim, mask, back, terminator); - break; - case TypeCategory::Logical: - RUNTIME_CHECK(terminator, targetType->first == TypeCategory::Logical); - PartialLogicalFindlocHelper( - result, x, target, kind, dim, mask, back, terminator); - break; - default: - terminator.Crash( - "FINDLOC: bad data type code (%d) for array", x.type().raw()); - } -} - -RT_EXT_API_GROUP_END -} // extern "C" } // namespace Fortran::runtime + +#endif // FLANG_RT_RUNTIME_FINDLOC_H_ diff --git a/flang-rt/lib/runtime/matmul-complex.cpp b/flang-rt/lib/runtime/matmul-complex.cpp new file mode 100644 index 0000000000000..a5ae5d563c08f --- /dev/null +++ b/flang-rt/lib/runtime/matmul-complex.cpp @@ -0,0 +1,48 @@ +//===-- lib/runtime/matmul-complex.cpp --------------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +// Complex-involving MATMUL instances. + +#include "matmul.h" + +namespace Fortran::runtime { +extern "C" { +RT_EXT_API_GROUP_BEGIN + +// clang-format off +#define FOREACH_MATMUL_COMPLEX_PAIR(macro) \ + macro(Integer, 1, Complex, 4) macro(Integer, 1, Complex, 8) \ + macro(Integer, 2, Complex, 4) macro(Integer, 2, Complex, 8) \ + macro(Integer, 4, Complex, 4) macro(Integer, 4, Complex, 8) \ + macro(Integer, 8, Complex, 4) macro(Integer, 8, Complex, 8) \ + macro(Unsigned, 1, Complex, 4) macro(Unsigned, 1, Complex, 8) \ + macro(Unsigned, 2, Complex, 4) macro(Unsigned, 2, Complex, 8) \ + macro(Unsigned, 4, Complex, 4) macro(Unsigned, 4, Complex, 8) \ + macro(Unsigned, 8, Complex, 4) macro(Unsigned, 8, Complex, 8) \ + macro(Real, 4, Complex, 4) macro(Real, 4, Complex, 8) \ + macro(Real, 8, Complex, 4) macro(Real, 8, Complex, 8) \ + macro(Complex, 4, Integer, 1) macro(Complex, 4, Integer, 2) \ + macro(Complex, 4, Integer, 4) macro(Complex, 4, Integer, 8) \ + macro(Complex, 8, Integer, 1) macro(Complex, 8, Integer, 2) \ + macro(Complex, 8, Integer, 4) macro(Complex, 8, Integer, 8) \ + macro(Complex, 4, Unsigned, 1) macro(Complex, 4, Unsigned, 2) \ + macro(Complex, 4, Unsigned, 4) macro(Complex, 4, Unsigned, 8) \ + macro(Complex, 8, Unsigned, 1) macro(Complex, 8, Unsigned, 2) \ + macro(Complex, 8, Unsigned, 4) macro(Complex, 8, Unsigned, 8) \ + macro(Complex, 4, Real, 4) macro(Complex, 4, Real, 8) \ + macro(Complex, 8, Real, 4) macro(Complex, 8, Real, 8) \ + macro(Complex, 4, Complex, 4) macro(Complex, 4, Complex, 8) \ + macro(Complex, 8, Complex, 4) macro(Complex, 8, Complex, 8) + +FOREACH_MATMUL_COMPLEX_PAIR(MATMUL_INSTANCE) +FOREACH_MATMUL_COMPLEX_PAIR(MATMUL_DIRECT_INSTANCE) +// clang-format on + +RT_EXT_API_GROUP_END +} // extern "C" +} // namespace Fortran::runtime diff --git a/flang-rt/lib/runtime/matmul-extypes-int16.cpp b/flang-rt/lib/runtime/matmul-extypes-int16.cpp new file mode 100644 index 0000000000000..04b007b2ba2ec --- /dev/null +++ b/flang-rt/lib/runtime/matmul-extypes-int16.cpp @@ -0,0 +1,103 @@ +//===-- lib/runtime/matmul-extypes-int16.cpp --------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +// Extended-type MATMUL instances: Int16, Unsigned16. + +#include "matmul.h" + +namespace Fortran::runtime { +extern "C" { +RT_EXT_API_GROUP_BEGIN + +// clang-format off +#if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T +MATMUL_INSTANCE(Integer, 16, Integer, 1) +MATMUL_INSTANCE(Integer, 16, Integer, 2) +MATMUL_INSTANCE(Integer, 16, Integer, 4) +MATMUL_INSTANCE(Integer, 16, Integer, 8) +MATMUL_INSTANCE(Integer, 16, Integer, 16) +MATMUL_INSTANCE(Integer, 16, Real, 4) +MATMUL_INSTANCE(Integer, 16, Real, 8) +MATMUL_INSTANCE(Integer, 16, Complex, 4) +MATMUL_INSTANCE(Integer, 16, Complex, 8) +MATMUL_INSTANCE(Unsigned, 16, Real, 4) +MATMUL_INSTANCE(Unsigned, 16, Real, 8) +MATMUL_INSTANCE(Unsigned, 16, Complex, 4) +MATMUL_INSTANCE(Unsigned, 16, Complex, 8) +MATMUL_INSTANCE(Real, 4, Integer, 16) +MATMUL_INSTANCE(Real, 8, Integer, 16) +MATMUL_INSTANCE(Complex, 4, Integer, 16) +MATMUL_INSTANCE(Complex, 8, Integer, 16) +MATMUL_INSTANCE(Real, 4, Unsigned, 16) +MATMUL_INSTANCE(Real, 8, Unsigned, 16) +MATMUL_INSTANCE(Complex, 4, Unsigned, 16) +MATMUL_INSTANCE(Complex, 8, Unsigned, 16) +MATMUL_DIRECT_INSTANCE(Integer, 16, Integer, 1) +MATMUL_DIRECT_INSTANCE(Integer, 16, Integer, 2) +MATMUL_DIRECT_INSTANCE(Integer, 16, Integer, 4) +MATMUL_DIRECT_INSTANCE(Integer, 16, Integer, 8) +MATMUL_DIRECT_INSTANCE(Integer, 16, Integer, 16) +MATMUL_DIRECT_INSTANCE(Integer, 16, Real, 4) +MATMUL_DIRECT_INSTANCE(Integer, 16, Real, 8) +MATMUL_DIRECT_INSTANCE(Integer, 16, Complex, 4) +MATMUL_DIRECT_INSTANCE(Integer, 16, Complex, 8) +MATMUL_DIRECT_INSTANCE(Unsigned, 16, Real, 4) +MATMUL_DIRECT_INSTANCE(Unsigned, 16, Real, 8) +MATMUL_DIRECT_INSTANCE(Unsigned, 16, Complex, 4) +MATMUL_DIRECT_INSTANCE(Unsigned, 16, Complex, 8) +MATMUL_DIRECT_INSTANCE(Real, 4, Integer, 16) +MATMUL_DIRECT_INSTANCE(Real, 8, Integer, 16) +MATMUL_DIRECT_INSTANCE(Complex, 4, Integer, 16) +MATMUL_DIRECT_INSTANCE(Complex, 8, Integer, 16) +MATMUL_DIRECT_INSTANCE(Real, 4, Unsigned, 16) +MATMUL_DIRECT_INSTANCE(Real, 8, Unsigned, 16) +MATMUL_DIRECT_INSTANCE(Complex, 4, Unsigned, 16) +MATMUL_DIRECT_INSTANCE(Complex, 8, Unsigned, 16) + +#if HAS_FLOAT80 +MATMUL_INSTANCE(Integer, 16, Real, 10) +MATMUL_INSTANCE(Integer, 16, Complex, 10) +MATMUL_INSTANCE(Real, 10, Integer, 16) +MATMUL_INSTANCE(Complex, 10, Integer, 16) +MATMUL_INSTANCE(Unsigned, 16, Real, 10) +MATMUL_INSTANCE(Unsigned, 16, Complex, 10) +MATMUL_INSTANCE(Real, 10, Unsigned, 16) +MATMUL_INSTANCE(Complex, 10, Unsigned, 16) +MATMUL_DIRECT_INSTANCE(Integer, 16, Real, 10) +MATMUL_DIRECT_INSTANCE(Integer, 16, Complex, 10) +MATMUL_DIRECT_INSTANCE(Real, 10, Integer, 16) +MATMUL_DIRECT_INSTANCE(Complex, 10, Integer, 16) +MATMUL_DIRECT_INSTANCE(Unsigned, 16, Real, 10) +MATMUL_DIRECT_INSTANCE(Unsigned, 16, Complex, 10) +MATMUL_DIRECT_INSTANCE(Real, 10, Unsigned, 16) +MATMUL_DIRECT_INSTANCE(Complex, 10, Unsigned, 16) +#endif +#if HAS_LDBL128 || HAS_FLOAT128 +MATMUL_INSTANCE(Integer, 16, Real, 16) +MATMUL_INSTANCE(Integer, 16, Complex, 16) +MATMUL_INSTANCE(Real, 16, Integer, 16) +MATMUL_INSTANCE(Complex, 16, Integer, 16) +MATMUL_INSTANCE(Unsigned, 16, Real, 16) +MATMUL_INSTANCE(Unsigned, 16, Complex, 16) +MATMUL_INSTANCE(Real, 16, Unsigned, 16) +MATMUL_INSTANCE(Complex, 16, Unsigned, 16) +MATMUL_DIRECT_INSTANCE(Integer, 16, Real, 16) +MATMUL_DIRECT_INSTANCE(Integer, 16, Complex, 16) +MATMUL_DIRECT_INSTANCE(Real, 16, Integer, 16) +MATMUL_DIRECT_INSTANCE(Complex, 16, Integer, 16) +MATMUL_DIRECT_INSTANCE(Unsigned, 16, Real, 16) +MATMUL_DIRECT_INSTANCE(Unsigned, 16, Complex, 16) +MATMUL_DIRECT_INSTANCE(Real, 16, Unsigned, 16) +MATMUL_DIRECT_INSTANCE(Complex, 16, Unsigned, 16) +#endif +#endif // __SIZEOF_INT128__ +// clang-format on + +RT_EXT_API_GROUP_END +} // extern "C" +} // namespace Fortran::runtime diff --git a/flang-rt/lib/runtime/matmul-extypes-real10.cpp b/flang-rt/lib/runtime/matmul-extypes-real10.cpp new file mode 100644 index 0000000000000..f2c834b5d192f --- /dev/null +++ b/flang-rt/lib/runtime/matmul-extypes-real10.cpp @@ -0,0 +1,91 @@ +//===-- lib/runtime/matmul-extypes-real10.cpp -------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +// Extended-type MATMUL instances: Real10, Complex10. + +#include "matmul.h" + +namespace Fortran::runtime { +extern "C" { +RT_EXT_API_GROUP_BEGIN + +// clang-format off +#if HAS_FLOAT80 +MATMUL_INSTANCE(Integer, 1, Real, 10) MATMUL_INSTANCE(Integer, 1, Complex, 10) +MATMUL_INSTANCE(Integer, 2, Real, 10) MATMUL_INSTANCE(Integer, 2, Complex, 10) +MATMUL_INSTANCE(Integer, 4, Real, 10) MATMUL_INSTANCE(Integer, 4, Complex, 10) +MATMUL_INSTANCE(Integer, 8, Real, 10) MATMUL_INSTANCE(Integer, 8, Complex, 10) +MATMUL_INSTANCE(Unsigned, 1, Real, 10) MATMUL_INSTANCE(Unsigned, 1, Complex, 10) +MATMUL_INSTANCE(Unsigned, 2, Real, 10) MATMUL_INSTANCE(Unsigned, 2, Complex, 10) +MATMUL_INSTANCE(Unsigned, 4, Real, 10) MATMUL_INSTANCE(Unsigned, 4, Complex, 10) +MATMUL_INSTANCE(Unsigned, 8, Real, 10) MATMUL_INSTANCE(Unsigned, 8, Complex, 10) +MATMUL_INSTANCE(Real, 4, Real, 10) MATMUL_INSTANCE(Real, 4, Complex, 10) +MATMUL_INSTANCE(Real, 8, Real, 10) MATMUL_INSTANCE(Real, 8, Complex, 10) +MATMUL_INSTANCE(Real, 10, Integer, 1) MATMUL_INSTANCE(Real, 10, Integer, 2) +MATMUL_INSTANCE(Real, 10, Integer, 4) MATMUL_INSTANCE(Real, 10, Integer, 8) +MATMUL_INSTANCE(Real, 10, Unsigned, 1) MATMUL_INSTANCE(Real, 10, Unsigned, 2) +MATMUL_INSTANCE(Real, 10, Unsigned, 4) MATMUL_INSTANCE(Real, 10, Unsigned, 8) +MATMUL_INSTANCE(Real, 10, Real, 4) MATMUL_INSTANCE(Real, 10, Real, 8) +MATMUL_INSTANCE(Real, 10, Real, 10) +MATMUL_INSTANCE(Real, 10, Complex, 4) MATMUL_INSTANCE(Real, 10, Complex, 8) +MATMUL_INSTANCE(Real, 10, Complex, 10) +MATMUL_INSTANCE(Complex, 4, Real, 10) MATMUL_INSTANCE(Complex, 4, Complex, 10) +MATMUL_INSTANCE(Complex, 8, Real, 10) MATMUL_INSTANCE(Complex, 8, Complex, 10) +MATMUL_INSTANCE(Complex, 10, Integer, 1) MATMUL_INSTANCE(Complex, 10, Integer, 2) +MATMUL_INSTANCE(Complex, 10, Integer, 4) MATMUL_INSTANCE(Complex, 10, Integer, 8) +MATMUL_INSTANCE(Complex, 10, Unsigned, 1) MATMUL_INSTANCE(Complex, 10, Unsigned, 2) +MATMUL_INSTANCE(Complex, 10, Unsigned, 4) MATMUL_INSTANCE(Complex, 10, Unsigned, 8) +MATMUL_INSTANCE(Complex, 10, Real, 4) MATMUL_INSTANCE(Complex, 10, Real, 8) +MATMUL_INSTANCE(Complex, 10, Real, 10) +MATMUL_INSTANCE(Complex, 10, Complex, 4) MATMUL_INSTANCE(Complex, 10, Complex, 8) +MATMUL_INSTANCE(Complex, 10, Complex, 10) +MATMUL_DIRECT_INSTANCE(Integer, 1, Real, 10) MATMUL_DIRECT_INSTANCE(Integer, 1, Complex, 10) +MATMUL_DIRECT_INSTANCE(Integer, 2, Real, 10) MATMUL_DIRECT_INSTANCE(Integer, 2, Complex, 10) +MATMUL_DIRECT_INSTANCE(Integer, 4, Real, 10) MATMUL_DIRECT_INSTANCE(Integer, 4, Complex, 10) +MATMUL_DIRECT_INSTANCE(Integer, 8, Real, 10) MATMUL_DIRECT_INSTANCE(Integer, 8, Complex, 10) +MATMUL_DIRECT_INSTANCE(Unsigned, 1, Real, 10) MATMUL_DIRECT_INSTANCE(Unsigned, 1, Complex, 10) +MATMUL_DIRECT_INSTANCE(Unsigned, 2, Real, 10) MATMUL_DIRECT_INSTANCE(Unsigned, 2, Complex, 10) +MATMUL_DIRECT_INSTANCE(Unsigned, 4, Real, 10) MATMUL_DIRECT_INSTANCE(Unsigned, 4, Complex, 10) +MATMUL_DIRECT_INSTANCE(Unsigned, 8, Real, 10) MATMUL_DIRECT_INSTANCE(Unsigned, 8, Complex, 10) +MATMUL_DIRECT_INSTANCE(Real, 4, Real, 10) MATMUL_DIRECT_INSTANCE(Real, 4, Complex, 10) +MATMUL_DIRECT_INSTANCE(Real, 8, Real, 10) MATMUL_DIRECT_INSTANCE(Real, 8, Complex, 10) +MATMUL_DIRECT_INSTANCE(Real, 10, Integer, 1) MATMUL_DIRECT_INSTANCE(Real, 10, Integer, 2) +MATMUL_DIRECT_INSTANCE(Real, 10, Integer, 4) MATMUL_DIRECT_INSTANCE(Real, 10, Integer, 8) +MATMUL_DIRECT_INSTANCE(Real, 10, Unsigned, 1) MATMUL_DIRECT_INSTANCE(Real, 10, Unsigned, 2) +MATMUL_DIRECT_INSTANCE(Real, 10, Unsigned, 4) MATMUL_DIRECT_INSTANCE(Real, 10, Unsigned, 8) +MATMUL_DIRECT_INSTANCE(Real, 10, Real, 4) MATMUL_DIRECT_INSTANCE(Real, 10, Real, 8) +MATMUL_DIRECT_INSTANCE(Real, 10, Real, 10) +MATMUL_DIRECT_INSTANCE(Real, 10, Complex, 4) MATMUL_DIRECT_INSTANCE(Real, 10, Complex, 8) +MATMUL_DIRECT_INSTANCE(Real, 10, Complex, 10) +MATMUL_DIRECT_INSTANCE(Complex, 4, Real, 10) MATMUL_DIRECT_INSTANCE(Complex, 4, Complex, 10) +MATMUL_DIRECT_INSTANCE(Complex, 8, Real, 10) MATMUL_DIRECT_INSTANCE(Complex, 8, Complex, 10) +MATMUL_DIRECT_INSTANCE(Complex, 10, Integer, 1) MATMUL_DIRECT_INSTANCE(Complex, 10, Integer, 2) +MATMUL_DIRECT_INSTANCE(Complex, 10, Integer, 4) MATMUL_DIRECT_INSTANCE(Complex, 10, Integer, 8) +MATMUL_DIRECT_INSTANCE(Complex, 10, Unsigned, 1) MATMUL_DIRECT_INSTANCE(Complex, 10, Unsigned, 2) +MATMUL_DIRECT_INSTANCE(Complex, 10, Unsigned, 4) MATMUL_DIRECT_INSTANCE(Complex, 10, Unsigned, 8) +MATMUL_DIRECT_INSTANCE(Complex, 10, Real, 4) MATMUL_DIRECT_INSTANCE(Complex, 10, Real, 8) +MATMUL_DIRECT_INSTANCE(Complex, 10, Real, 10) +MATMUL_DIRECT_INSTANCE(Complex, 10, Complex, 4) MATMUL_DIRECT_INSTANCE(Complex, 10, Complex, 8) +MATMUL_DIRECT_INSTANCE(Complex, 10, Complex, 10) + +#if HAS_FLOAT128 +MATMUL_INSTANCE(Real, 10, Real, 16) MATMUL_INSTANCE(Real, 10, Complex, 16) +MATMUL_INSTANCE(Real, 16, Real, 10) MATMUL_INSTANCE(Real, 16, Complex, 10) +MATMUL_INSTANCE(Complex, 10, Real, 16) MATMUL_INSTANCE(Complex, 10, Complex, 16) +MATMUL_INSTANCE(Complex, 16, Real, 10) MATMUL_INSTANCE(Complex, 16, Complex, 10) +MATMUL_DIRECT_INSTANCE(Real, 10, Real, 16) MATMUL_DIRECT_INSTANCE(Real, 10, Complex, 16) +MATMUL_DIRECT_INSTANCE(Real, 16, Real, 10) MATMUL_DIRECT_INSTANCE(Real, 16, Complex, 10) +MATMUL_DIRECT_INSTANCE(Complex, 10, Real, 16) MATMUL_DIRECT_INSTANCE(Complex, 10, Complex, 16) +MATMUL_DIRECT_INSTANCE(Complex, 16, Real, 10) MATMUL_DIRECT_INSTANCE(Complex, 16, Complex, 10) +#endif +#endif // HAS_FLOAT80 + // clang-format on + + RT_EXT_API_GROUP_END +} // extern "C" +} // namespace Fortran::runtime diff --git a/flang-rt/lib/runtime/matmul-extypes-real16.cpp b/flang-rt/lib/runtime/matmul-extypes-real16.cpp new file mode 100644 index 0000000000000..5a58983efc531 --- /dev/null +++ b/flang-rt/lib/runtime/matmul-extypes-real16.cpp @@ -0,0 +1,64 @@ +//===-- lib/runtime/matmul-extypes-real16.cpp -------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +// Extended-type MATMUL instances: Real16, Complex16. + +#include "matmul.h" + +namespace Fortran::runtime { +extern "C" { +RT_EXT_API_GROUP_BEGIN + +// clang-format off +#if HAS_LDBL128 || HAS_FLOAT128 +MATMUL_INSTANCE(Integer, 1, Real, 16) MATMUL_INSTANCE(Integer, 1, Complex, 16) +MATMUL_INSTANCE(Integer, 2, Real, 16) MATMUL_INSTANCE(Integer, 2, Complex, 16) +MATMUL_INSTANCE(Integer, 4, Real, 16) MATMUL_INSTANCE(Integer, 4, Complex, 16) +MATMUL_INSTANCE(Integer, 8, Real, 16) MATMUL_INSTANCE(Integer, 8, Complex, 16) +MATMUL_INSTANCE(Real, 4, Real, 16) MATMUL_INSTANCE(Real, 4, Complex, 16) +MATMUL_INSTANCE(Real, 8, Real, 16) MATMUL_INSTANCE(Real, 8, Complex, 16) +MATMUL_INSTANCE(Real, 16, Integer, 1) MATMUL_INSTANCE(Real, 16, Integer, 2) +MATMUL_INSTANCE(Real, 16, Integer, 4) MATMUL_INSTANCE(Real, 16, Integer, 8) +MATMUL_INSTANCE(Real, 16, Real, 4) MATMUL_INSTANCE(Real, 16, Real, 8) +MATMUL_INSTANCE(Real, 16, Real, 16) +MATMUL_INSTANCE(Real, 16, Complex, 4) MATMUL_INSTANCE(Real, 16, Complex, 8) +MATMUL_INSTANCE(Real, 16, Complex, 16) +MATMUL_INSTANCE(Complex, 4, Real, 16) MATMUL_INSTANCE(Complex, 4, Complex, 16) +MATMUL_INSTANCE(Complex, 8, Real, 16) MATMUL_INSTANCE(Complex, 8, Complex, 16) +MATMUL_INSTANCE(Complex, 16, Integer, 1) MATMUL_INSTANCE(Complex, 16, Integer, 2) +MATMUL_INSTANCE(Complex, 16, Integer, 4) MATMUL_INSTANCE(Complex, 16, Integer, 8) +MATMUL_INSTANCE(Complex, 16, Real, 4) MATMUL_INSTANCE(Complex, 16, Real, 8) +MATMUL_INSTANCE(Complex, 16, Real, 16) +MATMUL_INSTANCE(Complex, 16, Complex, 4) MATMUL_INSTANCE(Complex, 16, Complex, 8) +MATMUL_INSTANCE(Complex, 16, Complex, 16) +MATMUL_DIRECT_INSTANCE(Integer, 1, Real, 16) MATMUL_DIRECT_INSTANCE(Integer, 1, Complex, 16) +MATMUL_DIRECT_INSTANCE(Integer, 2, Real, 16) MATMUL_DIRECT_INSTANCE(Integer, 2, Complex, 16) +MATMUL_DIRECT_INSTANCE(Integer, 4, Real, 16) MATMUL_DIRECT_INSTANCE(Integer, 4, Complex, 16) +MATMUL_DIRECT_INSTANCE(Integer, 8, Real, 16) MATMUL_DIRECT_INSTANCE(Integer, 8, Complex, 16) +MATMUL_DIRECT_INSTANCE(Real, 4, Real, 16) MATMUL_DIRECT_INSTANCE(Real, 4, Complex, 16) +MATMUL_DIRECT_INSTANCE(Real, 8, Real, 16) MATMUL_DIRECT_INSTANCE(Real, 8, Complex, 16) +MATMUL_DIRECT_INSTANCE(Real, 16, Integer, 1) MATMUL_DIRECT_INSTANCE(Real, 16, Integer, 2) +MATMUL_DIRECT_INSTANCE(Real, 16, Integer, 4) MATMUL_DIRECT_INSTANCE(Real, 16, Integer, 8) +MATMUL_DIRECT_INSTANCE(Real, 16, Real, 4) MATMUL_DIRECT_INSTANCE(Real, 16, Real, 8) +MATMUL_DIRECT_INSTANCE(Real, 16, Real, 16) +MATMUL_DIRECT_INSTANCE(Real, 16, Complex, 4) MATMUL_DIRECT_INSTANCE(Real, 16, Complex, 8) +MATMUL_DIRECT_INSTANCE(Real, 16, Complex, 16) +MATMUL_DIRECT_INSTANCE(Complex, 4, Real, 16) MATMUL_DIRECT_INSTANCE(Complex, 4, Complex, 16) +MATMUL_DIRECT_INSTANCE(Complex, 8, Real, 16) MATMUL_DIRECT_INSTANCE(Complex, 8, Complex, 16) +MATMUL_DIRECT_INSTANCE(Complex, 16, Integer, 1) MATMUL_DIRECT_INSTANCE(Complex, 16, Integer, 2) +MATMUL_DIRECT_INSTANCE(Complex, 16, Integer, 4) MATMUL_DIRECT_INSTANCE(Complex, 16, Integer, 8) +MATMUL_DIRECT_INSTANCE(Complex, 16, Real, 4) MATMUL_DIRECT_INSTANCE(Complex, 16, Real, 8) +MATMUL_DIRECT_INSTANCE(Complex, 16, Real, 16) +MATMUL_DIRECT_INSTANCE(Complex, 16, Complex, 4) MATMUL_DIRECT_INSTANCE(Complex, 16, Complex, 8) +MATMUL_DIRECT_INSTANCE(Complex, 16, Complex, 16) +#endif // HAS_LDBL128 || HAS_FLOAT128 + // clang-format on + + RT_EXT_API_GROUP_END +} // extern "C" +} // namespace Fortran::runtime diff --git a/flang-rt/lib/runtime/matmul-integer.cpp b/flang-rt/lib/runtime/matmul-integer.cpp new file mode 100644 index 0000000000000..99c430a99ca58 --- /dev/null +++ b/flang-rt/lib/runtime/matmul-integer.cpp @@ -0,0 +1,47 @@ +//===-- lib/runtime/matmul-integer.cpp --------------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +// Integer*Integer and Logical*Logical MATMUL instances. + +#include "matmul.h" + +namespace Fortran::runtime { +extern "C" { +RT_EXT_API_GROUP_BEGIN + +// clang-format off +#define FOREACH_MATMUL_INTEGER_PAIR(macro) \ + macro(Integer, 1, Integer, 1) macro(Integer, 1, Integer, 2) \ + macro(Integer, 1, Integer, 4) macro(Integer, 1, Integer, 8) \ + macro(Integer, 2, Integer, 1) macro(Integer, 2, Integer, 2) \ + macro(Integer, 2, Integer, 4) macro(Integer, 2, Integer, 8) \ + macro(Integer, 4, Integer, 1) macro(Integer, 4, Integer, 2) \ + macro(Integer, 4, Integer, 4) macro(Integer, 4, Integer, 8) \ + macro(Integer, 8, Integer, 1) macro(Integer, 8, Integer, 2) \ + macro(Integer, 8, Integer, 4) macro(Integer, 8, Integer, 8) + +FOREACH_MATMUL_INTEGER_PAIR(MATMUL_INSTANCE) +FOREACH_MATMUL_INTEGER_PAIR(MATMUL_DIRECT_INSTANCE) + +#define FOREACH_MATMUL_LOGICAL_PAIR(macro) \ + macro(Logical, 1, Logical, 1) macro(Logical, 1, Logical, 2) \ + macro(Logical, 1, Logical, 4) macro(Logical, 1, Logical, 8) \ + macro(Logical, 2, Logical, 1) macro(Logical, 2, Logical, 2) \ + macro(Logical, 2, Logical, 4) macro(Logical, 2, Logical, 8) \ + macro(Logical, 4, Logical, 1) macro(Logical, 4, Logical, 2) \ + macro(Logical, 4, Logical, 4) macro(Logical, 4, Logical, 8) \ + macro(Logical, 8, Logical, 1) macro(Logical, 8, Logical, 2) \ + macro(Logical, 8, Logical, 4) macro(Logical, 8, Logical, 8) + +FOREACH_MATMUL_LOGICAL_PAIR(MATMUL_INSTANCE) +FOREACH_MATMUL_LOGICAL_PAIR(MATMUL_DIRECT_INSTANCE) +// clang-format on + +RT_EXT_API_GROUP_END +} // extern "C" +} // namespace Fortran::runtime diff --git a/flang-rt/lib/runtime/matmul-real.cpp b/flang-rt/lib/runtime/matmul-real.cpp new file mode 100644 index 0000000000000..2caa0bb91a467 --- /dev/null +++ b/flang-rt/lib/runtime/matmul-real.cpp @@ -0,0 +1,44 @@ +//===-- lib/runtime/matmul-real.cpp -----------------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +// Real-involving MATMUL instances: {Int,Uint}*Real, Real*{Int,Uint}, Real*Real. + +#include "matmul.h" + +namespace Fortran::runtime { +extern "C" { +RT_EXT_API_GROUP_BEGIN + +// clang-format off +#define FOREACH_MATMUL_REAL_PAIR(macro) \ + macro(Integer, 1, Real, 4) macro(Integer, 1, Real, 8) \ + macro(Integer, 2, Real, 4) macro(Integer, 2, Real, 8) \ + macro(Integer, 4, Real, 4) macro(Integer, 4, Real, 8) \ + macro(Integer, 8, Real, 4) macro(Integer, 8, Real, 8) \ + macro(Unsigned, 1, Real, 4) macro(Unsigned, 1, Real, 8) \ + macro(Unsigned, 2, Real, 4) macro(Unsigned, 2, Real, 8) \ + macro(Unsigned, 4, Real, 4) macro(Unsigned, 4, Real, 8) \ + macro(Unsigned, 8, Real, 4) macro(Unsigned, 8, Real, 8) \ + macro(Real, 4, Integer, 1) macro(Real, 4, Integer, 2) \ + macro(Real, 4, Integer, 4) macro(Real, 4, Integer, 8) \ + macro(Real, 8, Integer, 1) macro(Real, 8, Integer, 2) \ + macro(Real, 8, Integer, 4) macro(Real, 8, Integer, 8) \ + macro(Real, 4, Unsigned, 1) macro(Real, 4, Unsigned, 2) \ + macro(Real, 4, Unsigned, 4) macro(Real, 4, Unsigned, 8) \ + macro(Real, 8, Unsigned, 1) macro(Real, 8, Unsigned, 2) \ + macro(Real, 8, Unsigned, 4) macro(Real, 8, Unsigned, 8) \ + macro(Real, 4, Real, 4) macro(Real, 4, Real, 8) \ + macro(Real, 8, Real, 4) macro(Real, 8, Real, 8) + +FOREACH_MATMUL_REAL_PAIR(MATMUL_INSTANCE) +FOREACH_MATMUL_REAL_PAIR(MATMUL_DIRECT_INSTANCE) +// clang-format on + +RT_EXT_API_GROUP_END +} // extern "C" +} // namespace Fortran::runtime diff --git a/flang-rt/lib/runtime/matmul-transpose-complex.cpp b/flang-rt/lib/runtime/matmul-transpose-complex.cpp new file mode 100644 index 0000000000000..d300bb00f6d00 --- /dev/null +++ b/flang-rt/lib/runtime/matmul-transpose-complex.cpp @@ -0,0 +1,48 @@ +//===-- lib/runtime/matmul-transpose-complex.cpp ----------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +// Complex-involving MATMUL-TRANSPOSE instances. + +#include "matmul-transpose.h" + +namespace Fortran::runtime { +extern "C" { +RT_EXT_API_GROUP_BEGIN + +// clang-format off +#define FOREACH_MATMUL_COMPLEX_PAIR(macro) \ + macro(Integer, 1, Complex, 4) macro(Integer, 1, Complex, 8) \ + macro(Integer, 2, Complex, 4) macro(Integer, 2, Complex, 8) \ + macro(Integer, 4, Complex, 4) macro(Integer, 4, Complex, 8) \ + macro(Integer, 8, Complex, 4) macro(Integer, 8, Complex, 8) \ + macro(Unsigned, 1, Complex, 4) macro(Unsigned, 1, Complex, 8) \ + macro(Unsigned, 2, Complex, 4) macro(Unsigned, 2, Complex, 8) \ + macro(Unsigned, 4, Complex, 4) macro(Unsigned, 4, Complex, 8) \ + macro(Unsigned, 8, Complex, 4) macro(Unsigned, 8, Complex, 8) \ + macro(Real, 4, Complex, 4) macro(Real, 4, Complex, 8) \ + macro(Real, 8, Complex, 4) macro(Real, 8, Complex, 8) \ + macro(Complex, 4, Integer, 1) macro(Complex, 4, Integer, 2) \ + macro(Complex, 4, Integer, 4) macro(Complex, 4, Integer, 8) \ + macro(Complex, 8, Integer, 1) macro(Complex, 8, Integer, 2) \ + macro(Complex, 8, Integer, 4) macro(Complex, 8, Integer, 8) \ + macro(Complex, 4, Unsigned, 1) macro(Complex, 4, Unsigned, 2) \ + macro(Complex, 4, Unsigned, 4) macro(Complex, 4, Unsigned, 8) \ + macro(Complex, 8, Unsigned, 1) macro(Complex, 8, Unsigned, 2) \ + macro(Complex, 8, Unsigned, 4) macro(Complex, 8, Unsigned, 8) \ + macro(Complex, 4, Real, 4) macro(Complex, 4, Real, 8) \ + macro(Complex, 8, Real, 4) macro(Complex, 8, Real, 8) \ + macro(Complex, 4, Complex, 4) macro(Complex, 4, Complex, 8) \ + macro(Complex, 8, Complex, 4) macro(Complex, 8, Complex, 8) + +FOREACH_MATMUL_COMPLEX_PAIR(MATMUL_INSTANCE) +FOREACH_MATMUL_COMPLEX_PAIR(MATMUL_DIRECT_INSTANCE) +// clang-format on + +RT_EXT_API_GROUP_END +} // extern "C" +} // namespace Fortran::runtime diff --git a/flang-rt/lib/runtime/matmul-transpose-extypes-int16.cpp b/flang-rt/lib/runtime/matmul-transpose-extypes-int16.cpp new file mode 100644 index 0000000000000..b0cc2857bcede --- /dev/null +++ b/flang-rt/lib/runtime/matmul-transpose-extypes-int16.cpp @@ -0,0 +1,103 @@ +//===-- lib/runtime/matmul-transpose-extypes-int16.cpp ----------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +// Extended-type MATMUL-TRANSPOSE instances: Int16, Unsigned16. + +#include "matmul-transpose.h" + +namespace Fortran::runtime { +extern "C" { +RT_EXT_API_GROUP_BEGIN + +// clang-format off +#if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T +MATMUL_INSTANCE(Integer, 16, Integer, 1) +MATMUL_INSTANCE(Integer, 16, Integer, 2) +MATMUL_INSTANCE(Integer, 16, Integer, 4) +MATMUL_INSTANCE(Integer, 16, Integer, 8) +MATMUL_INSTANCE(Integer, 16, Integer, 16) +MATMUL_INSTANCE(Integer, 16, Real, 4) +MATMUL_INSTANCE(Integer, 16, Real, 8) +MATMUL_INSTANCE(Integer, 16, Complex, 4) +MATMUL_INSTANCE(Integer, 16, Complex, 8) +MATMUL_INSTANCE(Unsigned, 16, Real, 4) +MATMUL_INSTANCE(Unsigned, 16, Real, 8) +MATMUL_INSTANCE(Unsigned, 16, Complex, 4) +MATMUL_INSTANCE(Unsigned, 16, Complex, 8) +MATMUL_INSTANCE(Real, 4, Integer, 16) +MATMUL_INSTANCE(Real, 8, Integer, 16) +MATMUL_INSTANCE(Complex, 4, Integer, 16) +MATMUL_INSTANCE(Complex, 8, Integer, 16) +MATMUL_INSTANCE(Real, 4, Unsigned, 16) +MATMUL_INSTANCE(Real, 8, Unsigned, 16) +MATMUL_INSTANCE(Complex, 4, Unsigned, 16) +MATMUL_INSTANCE(Complex, 8, Unsigned, 16) +MATMUL_DIRECT_INSTANCE(Integer, 16, Integer, 1) +MATMUL_DIRECT_INSTANCE(Integer, 16, Integer, 2) +MATMUL_DIRECT_INSTANCE(Integer, 16, Integer, 4) +MATMUL_DIRECT_INSTANCE(Integer, 16, Integer, 8) +MATMUL_DIRECT_INSTANCE(Integer, 16, Integer, 16) +MATMUL_DIRECT_INSTANCE(Integer, 16, Real, 4) +MATMUL_DIRECT_INSTANCE(Integer, 16, Real, 8) +MATMUL_DIRECT_INSTANCE(Integer, 16, Complex, 4) +MATMUL_DIRECT_INSTANCE(Integer, 16, Complex, 8) +MATMUL_DIRECT_INSTANCE(Unsigned, 16, Real, 4) +MATMUL_DIRECT_INSTANCE(Unsigned, 16, Real, 8) +MATMUL_DIRECT_INSTANCE(Unsigned, 16, Complex, 4) +MATMUL_DIRECT_INSTANCE(Unsigned, 16, Complex, 8) +MATMUL_DIRECT_INSTANCE(Real, 4, Integer, 16) +MATMUL_DIRECT_INSTANCE(Real, 8, Integer, 16) +MATMUL_DIRECT_INSTANCE(Complex, 4, Integer, 16) +MATMUL_DIRECT_INSTANCE(Complex, 8, Integer, 16) +MATMUL_DIRECT_INSTANCE(Real, 4, Unsigned, 16) +MATMUL_DIRECT_INSTANCE(Real, 8, Unsigned, 16) +MATMUL_DIRECT_INSTANCE(Complex, 4, Unsigned, 16) +MATMUL_DIRECT_INSTANCE(Complex, 8, Unsigned, 16) + +#if HAS_FLOAT80 +MATMUL_INSTANCE(Integer, 16, Real, 10) +MATMUL_INSTANCE(Integer, 16, Complex, 10) +MATMUL_INSTANCE(Real, 10, Integer, 16) +MATMUL_INSTANCE(Complex, 10, Integer, 16) +MATMUL_INSTANCE(Unsigned, 16, Real, 10) +MATMUL_INSTANCE(Unsigned, 16, Complex, 10) +MATMUL_INSTANCE(Real, 10, Unsigned, 16) +MATMUL_INSTANCE(Complex, 10, Unsigned, 16) +MATMUL_DIRECT_INSTANCE(Integer, 16, Real, 10) +MATMUL_DIRECT_INSTANCE(Integer, 16, Complex, 10) +MATMUL_DIRECT_INSTANCE(Real, 10, Integer, 16) +MATMUL_DIRECT_INSTANCE(Complex, 10, Integer, 16) +MATMUL_DIRECT_INSTANCE(Unsigned, 16, Real, 10) +MATMUL_DIRECT_INSTANCE(Unsigned, 16, Complex, 10) +MATMUL_DIRECT_INSTANCE(Real, 10, Unsigned, 16) +MATMUL_DIRECT_INSTANCE(Complex, 10, Unsigned, 16) +#endif +#if HAS_LDBL128 || HAS_FLOAT128 +MATMUL_INSTANCE(Integer, 16, Real, 16) +MATMUL_INSTANCE(Integer, 16, Complex, 16) +MATMUL_INSTANCE(Real, 16, Integer, 16) +MATMUL_INSTANCE(Complex, 16, Integer, 16) +MATMUL_INSTANCE(Unsigned, 16, Real, 16) +MATMUL_INSTANCE(Unsigned, 16, Complex, 16) +MATMUL_INSTANCE(Real, 16, Unsigned, 16) +MATMUL_INSTANCE(Complex, 16, Unsigned, 16) +MATMUL_DIRECT_INSTANCE(Integer, 16, Real, 16) +MATMUL_DIRECT_INSTANCE(Integer, 16, Complex, 16) +MATMUL_DIRECT_INSTANCE(Real, 16, Integer, 16) +MATMUL_DIRECT_INSTANCE(Complex, 16, Integer, 16) +MATMUL_DIRECT_INSTANCE(Unsigned, 16, Real, 16) +MATMUL_DIRECT_INSTANCE(Unsigned, 16, Complex, 16) +MATMUL_DIRECT_INSTANCE(Real, 16, Unsigned, 16) +MATMUL_DIRECT_INSTANCE(Complex, 16, Unsigned, 16) +#endif +#endif // __SIZEOF_INT128__ +// clang-format on + +RT_EXT_API_GROUP_END +} // extern "C" +} // namespace Fortran::runtime diff --git a/flang-rt/lib/runtime/matmul-transpose-extypes-real10.cpp b/flang-rt/lib/runtime/matmul-transpose-extypes-real10.cpp new file mode 100644 index 0000000000000..b69be16b4b3a2 --- /dev/null +++ b/flang-rt/lib/runtime/matmul-transpose-extypes-real10.cpp @@ -0,0 +1,91 @@ +//===-- lib/runtime/matmul-transpose-extypes-real10.cpp ---------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +// Extended-type MATMUL-TRANSPOSE instances: Real10, Complex10. + +#include "matmul-transpose.h" + +namespace Fortran::runtime { +extern "C" { +RT_EXT_API_GROUP_BEGIN + +// clang-format off +#if HAS_FLOAT80 +MATMUL_INSTANCE(Integer, 1, Real, 10) MATMUL_INSTANCE(Integer, 1, Complex, 10) +MATMUL_INSTANCE(Integer, 2, Real, 10) MATMUL_INSTANCE(Integer, 2, Complex, 10) +MATMUL_INSTANCE(Integer, 4, Real, 10) MATMUL_INSTANCE(Integer, 4, Complex, 10) +MATMUL_INSTANCE(Integer, 8, Real, 10) MATMUL_INSTANCE(Integer, 8, Complex, 10) +MATMUL_INSTANCE(Unsigned, 1, Real, 10) MATMUL_INSTANCE(Unsigned, 1, Complex, 10) +MATMUL_INSTANCE(Unsigned, 2, Real, 10) MATMUL_INSTANCE(Unsigned, 2, Complex, 10) +MATMUL_INSTANCE(Unsigned, 4, Real, 10) MATMUL_INSTANCE(Unsigned, 4, Complex, 10) +MATMUL_INSTANCE(Unsigned, 8, Real, 10) MATMUL_INSTANCE(Unsigned, 8, Complex, 10) +MATMUL_INSTANCE(Real, 4, Real, 10) MATMUL_INSTANCE(Real, 4, Complex, 10) +MATMUL_INSTANCE(Real, 8, Real, 10) MATMUL_INSTANCE(Real, 8, Complex, 10) +MATMUL_INSTANCE(Real, 10, Integer, 1) MATMUL_INSTANCE(Real, 10, Integer, 2) +MATMUL_INSTANCE(Real, 10, Integer, 4) MATMUL_INSTANCE(Real, 10, Integer, 8) +MATMUL_INSTANCE(Real, 10, Unsigned, 1) MATMUL_INSTANCE(Real, 10, Unsigned, 2) +MATMUL_INSTANCE(Real, 10, Unsigned, 4) MATMUL_INSTANCE(Real, 10, Unsigned, 8) +MATMUL_INSTANCE(Real, 10, Real, 4) MATMUL_INSTANCE(Real, 10, Real, 8) +MATMUL_INSTANCE(Real, 10, Real, 10) +MATMUL_INSTANCE(Real, 10, Complex, 4) MATMUL_INSTANCE(Real, 10, Complex, 8) +MATMUL_INSTANCE(Real, 10, Complex, 10) +MATMUL_INSTANCE(Complex, 4, Real, 10) MATMUL_INSTANCE(Complex, 4, Complex, 10) +MATMUL_INSTANCE(Complex, 8, Real, 10) MATMUL_INSTANCE(Complex, 8, Complex, 10) +MATMUL_INSTANCE(Complex, 10, Integer, 1) MATMUL_INSTANCE(Complex, 10, Integer, 2) +MATMUL_INSTANCE(Complex, 10, Integer, 4) MATMUL_INSTANCE(Complex, 10, Integer, 8) +MATMUL_INSTANCE(Complex, 10, Unsigned, 1) MATMUL_INSTANCE(Complex, 10, Unsigned, 2) +MATMUL_INSTANCE(Complex, 10, Unsigned, 4) MATMUL_INSTANCE(Complex, 10, Unsigned, 8) +MATMUL_INSTANCE(Complex, 10, Real, 4) MATMUL_INSTANCE(Complex, 10, Real, 8) +MATMUL_INSTANCE(Complex, 10, Real, 10) +MATMUL_INSTANCE(Complex, 10, Complex, 4) MATMUL_INSTANCE(Complex, 10, Complex, 8) +MATMUL_INSTANCE(Complex, 10, Complex, 10) +MATMUL_DIRECT_INSTANCE(Integer, 1, Real, 10) MATMUL_DIRECT_INSTANCE(Integer, 1, Complex, 10) +MATMUL_DIRECT_INSTANCE(Integer, 2, Real, 10) MATMUL_DIRECT_INSTANCE(Integer, 2, Complex, 10) +MATMUL_DIRECT_INSTANCE(Integer, 4, Real, 10) MATMUL_DIRECT_INSTANCE(Integer, 4, Complex, 10) +MATMUL_DIRECT_INSTANCE(Integer, 8, Real, 10) MATMUL_DIRECT_INSTANCE(Integer, 8, Complex, 10) +MATMUL_DIRECT_INSTANCE(Unsigned, 1, Real, 10) MATMUL_DIRECT_INSTANCE(Unsigned, 1, Complex, 10) +MATMUL_DIRECT_INSTANCE(Unsigned, 2, Real, 10) MATMUL_DIRECT_INSTANCE(Unsigned, 2, Complex, 10) +MATMUL_DIRECT_INSTANCE(Unsigned, 4, Real, 10) MATMUL_DIRECT_INSTANCE(Unsigned, 4, Complex, 10) +MATMUL_DIRECT_INSTANCE(Unsigned, 8, Real, 10) MATMUL_DIRECT_INSTANCE(Unsigned, 8, Complex, 10) +MATMUL_DIRECT_INSTANCE(Real, 4, Real, 10) MATMUL_DIRECT_INSTANCE(Real, 4, Complex, 10) +MATMUL_DIRECT_INSTANCE(Real, 8, Real, 10) MATMUL_DIRECT_INSTANCE(Real, 8, Complex, 10) +MATMUL_DIRECT_INSTANCE(Real, 10, Integer, 1) MATMUL_DIRECT_INSTANCE(Real, 10, Integer, 2) +MATMUL_DIRECT_INSTANCE(Real, 10, Integer, 4) MATMUL_DIRECT_INSTANCE(Real, 10, Integer, 8) +MATMUL_DIRECT_INSTANCE(Real, 10, Unsigned, 1) MATMUL_DIRECT_INSTANCE(Real, 10, Unsigned, 2) +MATMUL_DIRECT_INSTANCE(Real, 10, Unsigned, 4) MATMUL_DIRECT_INSTANCE(Real, 10, Unsigned, 8) +MATMUL_DIRECT_INSTANCE(Real, 10, Real, 4) MATMUL_DIRECT_INSTANCE(Real, 10, Real, 8) +MATMUL_DIRECT_INSTANCE(Real, 10, Real, 10) +MATMUL_DIRECT_INSTANCE(Real, 10, Complex, 4) MATMUL_DIRECT_INSTANCE(Real, 10, Complex, 8) +MATMUL_DIRECT_INSTANCE(Real, 10, Complex, 10) +MATMUL_DIRECT_INSTANCE(Complex, 4, Real, 10) MATMUL_DIRECT_INSTANCE(Complex, 4, Complex, 10) +MATMUL_DIRECT_INSTANCE(Complex, 8, Real, 10) MATMUL_DIRECT_INSTANCE(Complex, 8, Complex, 10) +MATMUL_DIRECT_INSTANCE(Complex, 10, Integer, 1) MATMUL_DIRECT_INSTANCE(Complex, 10, Integer, 2) +MATMUL_DIRECT_INSTANCE(Complex, 10, Integer, 4) MATMUL_DIRECT_INSTANCE(Complex, 10, Integer, 8) +MATMUL_DIRECT_INSTANCE(Complex, 10, Unsigned, 1) MATMUL_DIRECT_INSTANCE(Complex, 10, Unsigned, 2) +MATMUL_DIRECT_INSTANCE(Complex, 10, Unsigned, 4) MATMUL_DIRECT_INSTANCE(Complex, 10, Unsigned, 8) +MATMUL_DIRECT_INSTANCE(Complex, 10, Real, 4) MATMUL_DIRECT_INSTANCE(Complex, 10, Real, 8) +MATMUL_DIRECT_INSTANCE(Complex, 10, Real, 10) +MATMUL_DIRECT_INSTANCE(Complex, 10, Complex, 4) MATMUL_DIRECT_INSTANCE(Complex, 10, Complex, 8) +MATMUL_DIRECT_INSTANCE(Complex, 10, Complex, 10) + +#if HAS_FLOAT128 +MATMUL_INSTANCE(Real, 10, Real, 16) MATMUL_INSTANCE(Real, 10, Complex, 16) +MATMUL_INSTANCE(Real, 16, Real, 10) MATMUL_INSTANCE(Real, 16, Complex, 10) +MATMUL_INSTANCE(Complex, 10, Real, 16) MATMUL_INSTANCE(Complex, 10, Complex, 16) +MATMUL_INSTANCE(Complex, 16, Real, 10) MATMUL_INSTANCE(Complex, 16, Complex, 10) +MATMUL_DIRECT_INSTANCE(Real, 10, Real, 16) MATMUL_DIRECT_INSTANCE(Real, 10, Complex, 16) +MATMUL_DIRECT_INSTANCE(Real, 16, Real, 10) MATMUL_DIRECT_INSTANCE(Real, 16, Complex, 10) +MATMUL_DIRECT_INSTANCE(Complex, 10, Real, 16) MATMUL_DIRECT_INSTANCE(Complex, 10, Complex, 16) +MATMUL_DIRECT_INSTANCE(Complex, 16, Real, 10) MATMUL_DIRECT_INSTANCE(Complex, 16, Complex, 10) +#endif +#endif // HAS_FLOAT80 + // clang-format on + + RT_EXT_API_GROUP_END +} // extern "C" +} // namespace Fortran::runtime diff --git a/flang-rt/lib/runtime/matmul-transpose-extypes-real16.cpp b/flang-rt/lib/runtime/matmul-transpose-extypes-real16.cpp new file mode 100644 index 0000000000000..71d35961516df --- /dev/null +++ b/flang-rt/lib/runtime/matmul-transpose-extypes-real16.cpp @@ -0,0 +1,64 @@ +//===-- lib/runtime/matmul-transpose-extypes-real16.cpp ---------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +// Extended-type MATMUL-TRANSPOSE instances: Real16, Complex16. + +#include "matmul-transpose.h" + +namespace Fortran::runtime { +extern "C" { +RT_EXT_API_GROUP_BEGIN + +// clang-format off +#if HAS_LDBL128 || HAS_FLOAT128 +MATMUL_INSTANCE(Integer, 1, Real, 16) MATMUL_INSTANCE(Integer, 1, Complex, 16) +MATMUL_INSTANCE(Integer, 2, Real, 16) MATMUL_INSTANCE(Integer, 2, Complex, 16) +MATMUL_INSTANCE(Integer, 4, Real, 16) MATMUL_INSTANCE(Integer, 4, Complex, 16) +MATMUL_INSTANCE(Integer, 8, Real, 16) MATMUL_INSTANCE(Integer, 8, Complex, 16) +MATMUL_INSTANCE(Real, 4, Real, 16) MATMUL_INSTANCE(Real, 4, Complex, 16) +MATMUL_INSTANCE(Real, 8, Real, 16) MATMUL_INSTANCE(Real, 8, Complex, 16) +MATMUL_INSTANCE(Real, 16, Integer, 1) MATMUL_INSTANCE(Real, 16, Integer, 2) +MATMUL_INSTANCE(Real, 16, Integer, 4) MATMUL_INSTANCE(Real, 16, Integer, 8) +MATMUL_INSTANCE(Real, 16, Real, 4) MATMUL_INSTANCE(Real, 16, Real, 8) +MATMUL_INSTANCE(Real, 16, Real, 16) +MATMUL_INSTANCE(Real, 16, Complex, 4) MATMUL_INSTANCE(Real, 16, Complex, 8) +MATMUL_INSTANCE(Real, 16, Complex, 16) +MATMUL_INSTANCE(Complex, 4, Real, 16) MATMUL_INSTANCE(Complex, 4, Complex, 16) +MATMUL_INSTANCE(Complex, 8, Real, 16) MATMUL_INSTANCE(Complex, 8, Complex, 16) +MATMUL_INSTANCE(Complex, 16, Integer, 1) MATMUL_INSTANCE(Complex, 16, Integer, 2) +MATMUL_INSTANCE(Complex, 16, Integer, 4) MATMUL_INSTANCE(Complex, 16, Integer, 8) +MATMUL_INSTANCE(Complex, 16, Real, 4) MATMUL_INSTANCE(Complex, 16, Real, 8) +MATMUL_INSTANCE(Complex, 16, Real, 16) +MATMUL_INSTANCE(Complex, 16, Complex, 4) MATMUL_INSTANCE(Complex, 16, Complex, 8) +MATMUL_INSTANCE(Complex, 16, Complex, 16) +MATMUL_DIRECT_INSTANCE(Integer, 1, Real, 16) MATMUL_DIRECT_INSTANCE(Integer, 1, Complex, 16) +MATMUL_DIRECT_INSTANCE(Integer, 2, Real, 16) MATMUL_DIRECT_INSTANCE(Integer, 2, Complex, 16) +MATMUL_DIRECT_INSTANCE(Integer, 4, Real, 16) MATMUL_DIRECT_INSTANCE(Integer, 4, Complex, 16) +MATMUL_DIRECT_INSTANCE(Integer, 8, Real, 16) MATMUL_DIRECT_INSTANCE(Integer, 8, Complex, 16) +MATMUL_DIRECT_INSTANCE(Real, 4, Real, 16) MATMUL_DIRECT_INSTANCE(Real, 4, Complex, 16) +MATMUL_DIRECT_INSTANCE(Real, 8, Real, 16) MATMUL_DIRECT_INSTANCE(Real, 8, Complex, 16) +MATMUL_DIRECT_INSTANCE(Real, 16, Integer, 1) MATMUL_DIRECT_INSTANCE(Real, 16, Integer, 2) +MATMUL_DIRECT_INSTANCE(Real, 16, Integer, 4) MATMUL_DIRECT_INSTANCE(Real, 16, Integer, 8) +MATMUL_DIRECT_INSTANCE(Real, 16, Real, 4) MATMUL_DIRECT_INSTANCE(Real, 16, Real, 8) +MATMUL_DIRECT_INSTANCE(Real, 16, Real, 16) +MATMUL_DIRECT_INSTANCE(Real, 16, Complex, 4) MATMUL_DIRECT_INSTANCE(Real, 16, Complex, 8) +MATMUL_DIRECT_INSTANCE(Real, 16, Complex, 16) +MATMUL_DIRECT_INSTANCE(Complex, 4, Real, 16) MATMUL_DIRECT_INSTANCE(Complex, 4, Complex, 16) +MATMUL_DIRECT_INSTANCE(Complex, 8, Real, 16) MATMUL_DIRECT_INSTANCE(Complex, 8, Complex, 16) +MATMUL_DIRECT_INSTANCE(Complex, 16, Integer, 1) MATMUL_DIRECT_INSTANCE(Complex, 16, Integer, 2) +MATMUL_DIRECT_INSTANCE(Complex, 16, Integer, 4) MATMUL_DIRECT_INSTANCE(Complex, 16, Integer, 8) +MATMUL_DIRECT_INSTANCE(Complex, 16, Real, 4) MATMUL_DIRECT_INSTANCE(Complex, 16, Real, 8) +MATMUL_DIRECT_INSTANCE(Complex, 16, Real, 16) +MATMUL_DIRECT_INSTANCE(Complex, 16, Complex, 4) MATMUL_DIRECT_INSTANCE(Complex, 16, Complex, 8) +MATMUL_DIRECT_INSTANCE(Complex, 16, Complex, 16) +#endif // HAS_LDBL128 || HAS_FLOAT128 + // clang-format on + + RT_EXT_API_GROUP_END +} // extern "C" +} // namespace Fortran::runtime diff --git a/flang-rt/lib/runtime/matmul-transpose-integer.cpp b/flang-rt/lib/runtime/matmul-transpose-integer.cpp new file mode 100644 index 0000000000000..25e54413536ad --- /dev/null +++ b/flang-rt/lib/runtime/matmul-transpose-integer.cpp @@ -0,0 +1,47 @@ +//===-- lib/runtime/matmul-transpose-integer.cpp ----------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +// Integer*Integer and Logical*Logical MATMUL-TRANSPOSE instances. + +#include "matmul-transpose.h" + +namespace Fortran::runtime { +extern "C" { +RT_EXT_API_GROUP_BEGIN + +// clang-format off +#define FOREACH_MATMUL_INTEGER_PAIR(macro) \ + macro(Integer, 1, Integer, 1) macro(Integer, 1, Integer, 2) \ + macro(Integer, 1, Integer, 4) macro(Integer, 1, Integer, 8) \ + macro(Integer, 2, Integer, 1) macro(Integer, 2, Integer, 2) \ + macro(Integer, 2, Integer, 4) macro(Integer, 2, Integer, 8) \ + macro(Integer, 4, Integer, 1) macro(Integer, 4, Integer, 2) \ + macro(Integer, 4, Integer, 4) macro(Integer, 4, Integer, 8) \ + macro(Integer, 8, Integer, 1) macro(Integer, 8, Integer, 2) \ + macro(Integer, 8, Integer, 4) macro(Integer, 8, Integer, 8) + +FOREACH_MATMUL_INTEGER_PAIR(MATMUL_INSTANCE) +FOREACH_MATMUL_INTEGER_PAIR(MATMUL_DIRECT_INSTANCE) + +#define FOREACH_MATMUL_LOGICAL_PAIR(macro) \ + macro(Logical, 1, Logical, 1) macro(Logical, 1, Logical, 2) \ + macro(Logical, 1, Logical, 4) macro(Logical, 1, Logical, 8) \ + macro(Logical, 2, Logical, 1) macro(Logical, 2, Logical, 2) \ + macro(Logical, 2, Logical, 4) macro(Logical, 2, Logical, 8) \ + macro(Logical, 4, Logical, 1) macro(Logical, 4, Logical, 2) \ + macro(Logical, 4, Logical, 4) macro(Logical, 4, Logical, 8) \ + macro(Logical, 8, Logical, 1) macro(Logical, 8, Logical, 2) \ + macro(Logical, 8, Logical, 4) macro(Logical, 8, Logical, 8) + +FOREACH_MATMUL_LOGICAL_PAIR(MATMUL_INSTANCE) +FOREACH_MATMUL_LOGICAL_PAIR(MATMUL_DIRECT_INSTANCE) +// clang-format on + +RT_EXT_API_GROUP_END +} // extern "C" +} // namespace Fortran::runtime diff --git a/flang-rt/lib/runtime/matmul-transpose-real.cpp b/flang-rt/lib/runtime/matmul-transpose-real.cpp new file mode 100644 index 0000000000000..12b08da9a48b2 --- /dev/null +++ b/flang-rt/lib/runtime/matmul-transpose-real.cpp @@ -0,0 +1,44 @@ +//===-- lib/runtime/matmul-transpose-real.cpp -------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +// Real-involving MATMUL-TRANSPOSE instances. + +#include "matmul-transpose.h" + +namespace Fortran::runtime { +extern "C" { +RT_EXT_API_GROUP_BEGIN + +// clang-format off +#define FOREACH_MATMUL_REAL_PAIR(macro) \ + macro(Integer, 1, Real, 4) macro(Integer, 1, Real, 8) \ + macro(Integer, 2, Real, 4) macro(Integer, 2, Real, 8) \ + macro(Integer, 4, Real, 4) macro(Integer, 4, Real, 8) \ + macro(Integer, 8, Real, 4) macro(Integer, 8, Real, 8) \ + macro(Unsigned, 1, Real, 4) macro(Unsigned, 1, Real, 8) \ + macro(Unsigned, 2, Real, 4) macro(Unsigned, 2, Real, 8) \ + macro(Unsigned, 4, Real, 4) macro(Unsigned, 4, Real, 8) \ + macro(Unsigned, 8, Real, 4) macro(Unsigned, 8, Real, 8) \ + macro(Real, 4, Integer, 1) macro(Real, 4, Integer, 2) \ + macro(Real, 4, Integer, 4) macro(Real, 4, Integer, 8) \ + macro(Real, 8, Integer, 1) macro(Real, 8, Integer, 2) \ + macro(Real, 8, Integer, 4) macro(Real, 8, Integer, 8) \ + macro(Real, 4, Unsigned, 1) macro(Real, 4, Unsigned, 2) \ + macro(Real, 4, Unsigned, 4) macro(Real, 4, Unsigned, 8) \ + macro(Real, 8, Unsigned, 1) macro(Real, 8, Unsigned, 2) \ + macro(Real, 8, Unsigned, 4) macro(Real, 8, Unsigned, 8) \ + macro(Real, 4, Real, 4) macro(Real, 4, Real, 8) \ + macro(Real, 8, Real, 4) macro(Real, 8, Real, 8) + +FOREACH_MATMUL_REAL_PAIR(MATMUL_INSTANCE) +FOREACH_MATMUL_REAL_PAIR(MATMUL_DIRECT_INSTANCE) +// clang-format on + +RT_EXT_API_GROUP_END +} // extern "C" +} // namespace Fortran::runtime diff --git a/flang-rt/lib/runtime/matmul-transpose.cpp b/flang-rt/lib/runtime/matmul-transpose.h similarity index 97% rename from flang-rt/lib/runtime/matmul-transpose.cpp rename to flang-rt/lib/runtime/matmul-transpose.h index a720c7b422e4c..cb54adabd0ca7 100644 --- a/flang-rt/lib/runtime/matmul-transpose.cpp +++ b/flang-rt/lib/runtime/matmul-transpose.h @@ -1,4 +1,4 @@ -//===-- lib/runtime/matmul-transpose.cpp ------------------------*- C++ -*-===// +//===-- lib/runtime/matmul-transpose.h --------------------------*- C++ -*-===// // // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. // See https://llvm.org/LICENSE.txt for license information. @@ -20,13 +20,16 @@ // The usefulness of this optimization should be reviewed once Matmul is swapped // to use the faster BLAS routines. -#include "flang/Runtime/matmul-transpose.h" +#ifndef FLANG_RT_RUNTIME_MATMUL_TRANSPOSE_H_ +#define FLANG_RT_RUNTIME_MATMUL_TRANSPOSE_H_ + #include "flang-rt/runtime/descriptor.h" #include "flang-rt/runtime/terminator.h" #include "flang-rt/runtime/tools.h" #include "flang/Common/optional.h" #include "flang/Runtime/c-or-cpp.h" #include "flang/Runtime/cpp-type.h" +#include "flang/Runtime/entry-names.h" #include namespace { @@ -245,7 +248,7 @@ inline static RT_API_ATTRS void DoMatmulTranspose(Descriptor &result, x.OffsetElement(), y.OffsetElement(), xColumnByteStride); return; } - // else V*M -> V (not allowed because TRANSPOSE() is only defined for rank + // V*M -> V (not allowed because TRANSPOSE() is only defined for rank // 1 matrices terminator.Crash( "MATMUL-TRANSPOSE: unacceptable operand shapes (%jdx%jd, %jdx%jd)", @@ -349,10 +352,6 @@ struct MatmulTransposeHelper { }; } // namespace -namespace Fortran::runtime { -extern "C" { -RT_EXT_API_GROUP_BEGIN - #define MATMUL_INSTANCE(XCAT, XKIND, YCAT, YKIND) \ void RTDEF(MatmulTranspose##XCAT##XKIND##YCAT##YKIND)(Descriptor & result, \ const Descriptor &x, const Descriptor &y, const char *sourceFile, \ @@ -369,10 +368,4 @@ RT_EXT_API_GROUP_BEGIN YKIND>{}(result, x, y, sourceFile, line, false); \ } -#define MATMUL_FORCE_ALL_TYPES 0 - -#include "flang/Runtime/matmul-instances.inc" - -RT_EXT_API_GROUP_END -} // extern "C" -} // namespace Fortran::runtime +#endif // FLANG_RT_RUNTIME_MATMUL_TRANSPOSE_H_ diff --git a/flang-rt/lib/runtime/matmul.cpp b/flang-rt/lib/runtime/matmul.h similarity index 98% rename from flang-rt/lib/runtime/matmul.cpp rename to flang-rt/lib/runtime/matmul.h index 75e254289ad44..9582839a67a6d 100644 --- a/flang-rt/lib/runtime/matmul.cpp +++ b/flang-rt/lib/runtime/matmul.h @@ -1,4 +1,4 @@ -//===-- lib/runtime/matmul.cpp ----------------------------------*- C++ -*-===// +//===-- lib/runtime/matmul.h ------------------------------------*- C++ -*-===// // // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. // See https://llvm.org/LICENSE.txt for license information. @@ -19,13 +19,16 @@ // // Places where BLAS routines could be called are marked as TODO items. -#include "flang/Runtime/matmul.h" +#ifndef FLANG_RT_RUNTIME_MATMUL_H_ +#define FLANG_RT_RUNTIME_MATMUL_H_ + #include "flang-rt/runtime/descriptor.h" #include "flang-rt/runtime/terminator.h" #include "flang-rt/runtime/tools.h" #include "flang/Common/optional.h" #include "flang/Runtime/c-or-cpp.h" #include "flang/Runtime/cpp-type.h" +#include "flang/Runtime/entry-names.h" #include namespace { @@ -449,10 +452,6 @@ struct MatmulHelper { }; } // namespace -namespace Fortran::runtime { -extern "C" { -RT_EXT_API_GROUP_BEGIN - #define MATMUL_INSTANCE(XCAT, XKIND, YCAT, YKIND) \ void RTDEF(Matmul##XCAT##XKIND##YCAT##YKIND)(Descriptor & result, \ const Descriptor &x, const Descriptor &y, const char *sourceFile, \ @@ -469,10 +468,4 @@ RT_EXT_API_GROUP_BEGIN result, x, y, sourceFile, line, false); \ } -#define MATMUL_FORCE_ALL_TYPES 0 - -#include "flang/Runtime/matmul-instances.inc" - -RT_EXT_API_GROUP_END -} // extern "C" -} // namespace Fortran::runtime +#endif // FLANG_RT_RUNTIME_MATMUL_H_