Index: flang/include/flang/Lower/AbstractConverter.h =================================================================== --- flang/include/flang/Lower/AbstractConverter.h +++ flang/include/flang/Lower/AbstractConverter.h @@ -76,6 +76,9 @@ /// Get the mlir instance of a symbol. virtual mlir::Value getSymbolAddress(SymbolRef sym) = 0; + virtual fir::ExtendedValue + getSymbolExtValue(const Fortran::semantics::Symbol &sym) = 0; + /// Get the binding of an implied do variable by name. virtual mlir::Value impliedDoBinding(llvm::StringRef name) = 0; Index: flang/lib/Lower/Bridge.cpp =================================================================== --- flang/lib/Lower/Bridge.cpp +++ flang/lib/Lower/Bridge.cpp @@ -312,6 +312,13 @@ return lookupSymbol(sym).getAddr(); } + fir::ExtendedValue + getSymbolExtValue(const Fortran::semantics::Symbol &sym) override final { + Fortran::lower::SymbolBox sb = localSymbols.lookupSymbol(sym); + assert(sb && "symbol box not found"); + return sb.toExtendedValue(); + } + mlir::Value impliedDoBinding(llvm::StringRef name) override final { mlir::Value val = localSymbols.lookupImpliedDo(name); if (!val) Index: flang/lib/Lower/OpenMP.cpp =================================================================== --- flang/lib/Lower/OpenMP.cpp +++ flang/lib/Lower/OpenMP.cpp @@ -43,6 +43,19 @@ return dataRef ? std::get_if(&dataRef->u) : nullptr; } +// Get the mutable value for pointer or allocatable variable if it has +// mutableProperties. Else, get the base address of the extended value. +static mlir::Value getDataBaseValue(fir::ExtendedValue exv) { + return exv.match( + [&](const fir::MutableBoxValue &box) -> mlir::Value { + if (!box.getMutableProperties().isEmpty()) { + return box.getMutableProperties().addr; + } + return fir::getBase(exv); + }, + [&](const auto &) -> mlir::Value { return fir::getBase(exv); }); +} + template static void createPrivateVarSyms(Fortran::lower::AbstractConverter &converter, const T *clause) { @@ -812,6 +825,7 @@ const Fortran::parser::OmpAtomicWrite &atomicWrite) { auto &firOpBuilder = converter.getFirOpBuilder(); auto currentLocation = converter.getCurrentLocation(); + fir::ExtendedValue addressExv; mlir::Value address; // If no hint clause is specified, the effect is as if // hint(omp_sync_hint_none) had been specified. @@ -832,7 +846,8 @@ Fortran::common::Indirection>( &assignmentStmtVariable.u)) { if (const auto *name = getDesignatorNameIfDataRef(varDesignator->value())) { - address = converter.getSymbolAddress(*name->symbol); + addressExv = converter.getSymbolExtValue(*name->symbol); + address = getDataBaseValue(addressExv); } } @@ -849,8 +864,8 @@ const Fortran::parser::OmpAtomicRead &atomicRead) { auto &firOpBuilder = converter.getFirOpBuilder(); auto currentLocation = converter.getCurrentLocation(); - mlir::Value to_address; - mlir::Value from_address; + mlir::Value to_address, from_address; + fir::ExtendedValue to_addressExv, from_addressExv; // If no hint clause is specified, the effect is as if // hint(omp_sync_hint_none) had been specified. mlir::IntegerAttr hint = nullptr; @@ -868,7 +883,8 @@ &assignmentStmtExpr.u)) { if (const auto *name = getDesignatorNameIfDataRef(exprDesignator->value())) { - from_address = converter.getSymbolAddress(*name->symbol); + from_addressExv = converter.getSymbolExtValue(*name->symbol); + from_address = getDataBaseValue(from_addressExv); } } @@ -876,7 +892,8 @@ Fortran::common::Indirection>( &assignmentStmtVariable.u)) { if (const auto *name = getDesignatorNameIfDataRef(varDesignator->value())) { - to_address = converter.getSymbolAddress(*name->symbol); + to_addressExv = converter.getSymbolExtValue(*name->symbol); + to_address = getDataBaseValue(to_addressExv); } } Index: flang/test/Lower/OpenMP/atomic-read.f90 =================================================================== --- flang/test/Lower/OpenMP/atomic-read.f90 +++ flang/test/Lower/OpenMP/atomic-read.f90 @@ -44,3 +44,33 @@ g = h end program OmpAtomic +! Test lowering atomic read for pointer variables. +! Please notice to use %[[VAL_4]] and %[[VAL_1]] for operands of atomic +! operation, instead of %[[VAL_3]] and %[[VAL_0]]. + +!CHECK: func.func @_QPatomic_read_pointer() { +!CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box> {bindc_name = "x", uniq_name = "_QFatomic_read_pointerEx"} +!CHECK: %[[VAL_1:.*]] = fir.alloca !fir.ptr {uniq_name = "_QFatomic_read_pointerEx.addr"} +!CHECK: %[[VAL_2:.*]] = fir.zero_bits !fir.ptr +!CHECK: fir.store %[[VAL_2]] to %[[VAL_1]] : !fir.ref> +!CHECK: %[[VAL_3:.*]] = fir.alloca !fir.box> {bindc_name = "y", uniq_name = "_QFatomic_read_pointerEy"} +!CHECK: %[[VAL_4:.*]] = fir.alloca !fir.ptr {uniq_name = "_QFatomic_read_pointerEy.addr"} +!CHECK: %[[VAL_5:.*]] = fir.zero_bits !fir.ptr +!CHECK: fir.store %[[VAL_5]] to %[[VAL_4]] : !fir.ref> +!CHECK: omp.atomic.read %[[VAL_4]] = %[[VAL_1]] : !fir.ref> +!CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_4]] : !fir.ref> +!CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_6]] : !fir.ptr +!CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_1]] : !fir.ref> +!CHECK: fir.store %[[VAL_7]] to %[[VAL_8]] : !fir.ptr +!CHECK: return +!CHECK: } + +subroutine atomic_read_pointer() + integer, pointer :: x, y + + !$omp atomic read + y = x + + x = y +end + Index: flang/test/Lower/OpenMP/atomic-write.f90 =================================================================== --- flang/test/Lower/OpenMP/atomic-write.f90 +++ flang/test/Lower/OpenMP/atomic-write.f90 @@ -36,3 +36,29 @@ y = 10*x + z/2 end program OmpAtomicWrite +! Test lowering atomic read for pointer variables. +! Please notice to use %[[VAL_1]] for operands of atomic operation, instead +! of %[[VAL_0]]. + +!CHECK-LABEL: func.func @_QPatomic_write_pointer() { +!CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box> {bindc_name = "x", uniq_name = "_QFatomic_write_pointerEx"} +!CHECK: %[[VAL_1:.*]] = fir.alloca !fir.ptr {uniq_name = "_QFatomic_write_pointerEx.addr"} +!CHECK: %[[VAL_2:.*]] = fir.zero_bits !fir.ptr +!CHECK: fir.store %[[VAL_2]] to %[[VAL_1]] : !fir.ref> +!CHECK: %[[VAL_3:.*]] = arith.constant 1 : i32 +!CHECK: omp.atomic.write %[[VAL_1]] = %[[VAL_3]] : !fir.ref>, i32 +!CHECK: %[[VAL_4:.*]] = arith.constant 2 : i32 +!CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_1]] : !fir.ref> +!CHECK: fir.store %[[VAL_4]] to %[[VAL_5]] : !fir.ptr +!CHECK: return +!CHECK: } + +subroutine atomic_write_pointer() + integer, pointer :: x + + !$omp atomic write + x = 1 + + x = 2 +end +