maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

[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
This commit is contained in:
Katherine Rasmussen 2022-09-01 17:01:52 -07:00
parent a1aa0390cb
commit aa1a2ffdbf
4 changed files with 83 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
flang/lib/Evaluate/intrinsics.cpp
View File

@ -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")};

3
flang/module/__fortran_builtins.f90
View File

@ -39,6 +39,9 @@ module __Fortran_builtins
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, &

7
flang/module/iso_fortran_env.f90
View File

@ -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.

21
flang/test/Semantics/atomic07.f90
View File

@ -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)