[flang-commits] [flang] aa1a2ff - [flang] Add atomic_fetch_or to the list of intrinsics
Katherine Rasmussen via flang-commits
flang-commits at lists.llvm.org
Thu Sep 29 09:35:25 PDT 2022
Author: Katherine Rasmussen
Date: 2022-09-29T09:29:27-07:00
New Revision: aa1a2ffdbf607fb49e27cab08f2f8f215ef11011
URL: https://github.com/llvm/llvm-project/commit/aa1a2ffdbf607fb49e27cab08f2f8f215ef11011
DIFF: https://github.com/llvm/llvm-project/commit/aa1a2ffdbf607fb49e27cab08f2f8f215ef11011.diff
LOG: [flang] Add atomic_fetch_or to the list of intrinsics
Add the atomic subroutine, atomic_fetch_or, to the list of
intrinsic subroutines. Add new enumerators to deal with the rank
of the atom dummy argument, and the kind of atomic_int_kind. Use
check for a coindexed-object for the fourth dummy argument. Move
atomic_int_kind and atomic_logical_kind definitions from
iso_fortran_env module to the __fortran_builtins module to allow
for access to those values when analyzing `atomic_fetch_or`
calls in flang/lib/Evaluate/intrinsics.cpp.
Reviewed By: jeanPerier
Differential Revision: https://reviews.llvm.org/D133174
Added:
Modified:
flang/lib/Evaluate/intrinsics.cpp
flang/module/__fortran_builtins.f90
flang/module/iso_fortran_env.f90
flang/test/Semantics/atomic07.f90
Removed:
################################################################################
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index b87f44b9d6b9c..bd4d0fe2b217c 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -91,6 +91,7 @@ ENUM_CLASS(KindCode, none, defaultIntegerKind,
addressable, // for PRESENT(), &c.; anything (incl. procedure) but BOZ
nullPointerType, // for ASSOCIATED(NULL())
exactKind, // a single explicit exactKindValue
+ atomicIntKind, // atomic_int_kind from iso_fortran_env
)
struct TypePattern {
@@ -176,6 +177,8 @@ static constexpr TypePattern KINDComplex{ComplexType, KindCode::effectiveKind};
static constexpr TypePattern KINDChar{CharType, KindCode::effectiveKind};
static constexpr TypePattern KINDLogical{LogicalType, KindCode::effectiveKind};
+static constexpr TypePattern AtomicInt{IntType, KindCode::atomicIntKind};
+
// The default rank pattern for dummy arguments and function results is
// "elemental".
ENUM_CLASS(Rank,
@@ -186,6 +189,7 @@ ENUM_CLASS(Rank,
matrix,
array, // not scalar, rank is known and greater than zero
coarray, // rank is known and can be scalar; has nonzero corank
+ atom, // is scalar and has nonzero corank or is coindexed
known, // rank is known and can be scalar
anyOrAssumedRank, // rank can be unknown; assumed-type TYPE(*) allowed
conformable, // scalar, or array of same rank & shape as "array" argument
@@ -1087,6 +1091,16 @@ static const SpecificIntrinsicInterface specificIntrinsicFunction[]{
static const IntrinsicInterface intrinsicSubroutine[]{
{"abort", {}, {}, Rank::elemental, IntrinsicClass::impureSubroutine},
+ {"atomic_fetch_or",
+ {{"atom", AtomicInt, Rank::atom, Optionality::required,
+ common::Intent::InOut},
+ {"value", AnyInt, Rank::scalar, Optionality::required,
+ common::Intent::In},
+ {"old", AtomicInt, Rank::scalar, Optionality::required,
+ common::Intent::Out},
+ {"stat", AnyInt, Rank::scalar, Optionality::optional,
+ common::Intent::Out}},
+ {}, Rank::elemental, IntrinsicClass::atomicSubroutine},
{"co_broadcast",
{{"a", AnyData, Rank::anyOrAssumedRank, Optionality::required,
common::Intent::InOut},
@@ -1252,6 +1266,33 @@ static DynamicType GetBuiltinDerivedType(
return DynamicType{derived};
}
+static std::int64_t GetBuiltinKind(
+ const semantics::Scope *builtinsScope, const char *which) {
+ if (!builtinsScope) {
+ common::die("INTERNAL: The __fortran_builtins module was not found, and "
+ "the kind '%s' was required",
+ which);
+ }
+ auto iter{
+ builtinsScope->find(semantics::SourceName{which, std::strlen(which)})};
+ if (iter == builtinsScope->cend()) {
+ common::die(
+ "INTERNAL: The __fortran_builtins module does not define the kind '%s'",
+ which);
+ }
+ const semantics::Symbol &symbol{*iter->second};
+ const auto &details{
+ DEREF(symbol.detailsIf<semantics::ObjectEntityDetails>())};
+ if (const auto kind{ToInt64(details.init())}) {
+ return *kind;
+ } else {
+ common::die(
+ "INTERNAL: The __fortran_builtins module does not define the kind '%s'",
+ which);
+ return -1;
+ }
+}
+
// Ensure that the keywords of arguments to MAX/MIN and their variants
// are of the form A123 with no duplicates or leading zeroes.
static bool CheckMaxMinArgument(std::optional<parser::CharBlock> keyword,
@@ -1523,6 +1564,16 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
case KindCode::exactKind:
argOk = type->kind() == d.typePattern.exactKindValue;
break;
+ case KindCode::atomicIntKind:
+ argOk = type->kind() ==
+ GetBuiltinKind(builtinsScope, "__builtin_atomic_int_kind");
+ if (!argOk) {
+ messages.Say(arg->sourceLocation(),
+ "Actual argument for '%s=' must have kind=atomic_int_kind, but is '%s'"_err_en_US,
+ d.keyword, type->AsFortran());
+ return std::nullopt;
+ }
+ break;
default:
CRASH_NO_CASE;
}
@@ -1606,6 +1657,15 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
return std::nullopt;
}
break;
+ case Rank::atom:
+ argOk = rank == 0 && (IsCoarray(*arg) || ExtractCoarrayRef(*arg));
+ if (!argOk) {
+ messages.Say(arg->sourceLocation(),
+ "'%s=' argument must be a scalar coarray or coindexed object for intrinsic '%s'"_err_en_US,
+ d.keyword, name);
+ return std::nullopt;
+ }
+ break;
case Rank::known:
if (!knownArg) {
knownArg = arg;
@@ -1858,6 +1918,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
case Rank::shape:
case Rank::array:
case Rank::coarray:
+ case Rank::atom:
case Rank::known:
case Rank::anyOrAssumedRank:
case Rank::reduceOperation:
@@ -2482,6 +2543,8 @@ static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
}
} else if (name == "associated") {
return CheckAssociated(call, context);
+ } else if (name == "atomic_fetch_or") {
+ return CheckForCoindexedObject(context, call.arguments[3], name, "stat");
} else if (name == "co_broadcast" || name == "co_max" || name == "co_min" ||
name == "co_sum") {
bool aOk{CheckForCoindexedObject(context, call.arguments[0], name, "a")};
diff --git a/flang/module/__fortran_builtins.f90 b/flang/module/__fortran_builtins.f90
index 487041ae2bc68..a22aa4699f7ad 100644
--- a/flang/module/__fortran_builtins.f90
+++ b/flang/module/__fortran_builtins.f90
@@ -39,6 +39,9 @@
integer(kind=int64) :: __id
end type
+ integer, parameter :: __builtin_atomic_int_kind = selected_int_kind(18)
+ integer, parameter :: __builtin_atomic_logical_kind = __builtin_atomic_int_kind
+
procedure(type(__builtin_c_ptr)) :: __builtin_c_loc
intrinsic :: __builtin_ieee_is_nan, __builtin_ieee_is_negative, &
diff --git a/flang/module/iso_fortran_env.f90 b/flang/module/iso_fortran_env.f90
index 6ac9a501b199e..34406897174fd 100644
--- a/flang/module/iso_fortran_env.f90
+++ b/flang/module/iso_fortran_env.f90
@@ -16,13 +16,12 @@ module iso_fortran_env
use __Fortran_builtins, only: &
event_type => __builtin_event_type, &
lock_type => __builtin_lock_type, &
- team_type => __builtin_team_type
+ team_type => __builtin_team_type, &
+ atomic_int_kind => __builtin_atomic_int_kind, &
+ atomic_logical_kind => __builtin_atomic_logical_kind
implicit none
- integer, parameter :: atomic_int_kind = selected_int_kind(18)
- integer, parameter :: atomic_logical_kind = atomic_int_kind
-
! TODO: Use PACK([x],test) in place of the array constructor idiom
! [(x, integer::j=1,COUNT([test]))] below once PACK() can be folded.
diff --git a/flang/test/Semantics/atomic07.f90 b/flang/test/Semantics/atomic07.f90
index 263f99e154cba..14cf1222a6592 100644
--- a/flang/test/Semantics/atomic07.f90
+++ b/flang/test/Semantics/atomic07.f90
@@ -1,5 +1,4 @@
! RUN: %python %S/test_errors.py %s %flang_fc1
-! XFAIL: *
! This test checks for semantic errors in atomic_fetch_or subroutine calls based on
! the interface defined in section 16.9.26 of the Fortran 2018 standard.
@@ -8,8 +7,9 @@ program test_atomic_fetch_or
implicit none
integer(kind=atomic_int_kind) :: scalar_coarray[*], non_scalar_coarray(10)[*], val, old_val, non_coarray
- integer(kind=atomic_int_kind) :: repeated_atom[*], repeated_old, repeated_val, array(10)
- integer :: status, default_kind_coarray[*], not_same_kind_as_atom, coindexed_status[*], extra_arg, repeated_status, status_array(10)
+ integer(kind=atomic_int_kind) :: repeated_atom[*], repeated_old, repeated_val, array(10), val_coarray[*], old_val_coarray[*]
+ integer :: status, default_kind_coarray[*], not_same_kind_as_atom, coindexed_status[*]
+ integer :: extra_arg, repeated_status, status_array(10)
integer(kind=1) :: kind1_coarray[*]
real :: non_integer_coarray[*], not_same_type_as_atom
logical :: non_integer
@@ -24,15 +24,18 @@ program test_atomic_fetch_or
!___ non-standard-conforming calls ___
- !ERROR: 'atom=' argument must be a scalar coarray for intrinsic 'atomic_fetch_or'
+ !ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_fetch_or'
call atomic_fetch_or(non_scalar_coarray, val, old_val)
- !ERROR: 'atom=' argument must be a coarray or a coindexed object for intrinsic 'atomic_fetch_or'
+ !ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_fetch_or'
call atomic_fetch_or(non_coarray, val, old_val)
- !ERROR: 'atom=' argument must be a coarray or a coindexed object for intrinsic 'atomic_fetch_or'
+ !ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_fetch_or'
call atomic_fetch_or(array, val, old_val)
+ !ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_fetch_or'
+ call atomic_fetch_or(non_scalar_coarray[1], val, old_val)
+
!ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind, but is 'INTEGER(4)'
call atomic_fetch_or(default_kind_coarray, val, old_val)
@@ -66,8 +69,12 @@ program test_atomic_fetch_or
!ERROR: 'stat=' argument has unacceptable rank 1
call atomic_fetch_or(scalar_coarray, val, old_val, status_array)
+ !ERROR: 'stat' argument to 'atomic_fetch_or' may not be a coindexed object
call atomic_fetch_or(scalar_coarray, val, old_val, coindexed_status[1])
+ !ERROR: 'stat' argument to 'atomic_fetch_or' may not be a coindexed object
+ call atomic_fetch_or(scalar_coarray[1], val_coarray[1], old_val_coarray[1], coindexed_status[1])
+
!ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' must be definable
call atomic_fetch_or(scalar_coarray, val, old_val, 1)
@@ -120,7 +127,7 @@ program test_atomic_fetch_or
call atomic_fetch_or(scalar_coarray, val, old_val, atom=repeated_atom)
!ERROR: keyword argument to intrinsic 'atomic_fetch_or' was supplied positionally by an earlier actual argument
- call atomic_fetch_or(scalar_coarray, val, old_val, val=repeated_val)
+ call atomic_fetch_or(scalar_coarray, val, old_val, value=repeated_val)
!ERROR: keyword argument to intrinsic 'atomic_fetch_or' was supplied positionally by an earlier actual argument
call atomic_fetch_or(scalar_coarray, val, old_val, status, stat=repeated_status)
More information about the flang-commits
mailing list