diff --git a/flang/include/flang/Lower/ConvertVariable.h b/flang/include/flang/Lower/ConvertVariable.h --- a/flang/include/flang/Lower/ConvertVariable.h +++ b/flang/include/flang/Lower/ConvertVariable.h @@ -23,6 +23,8 @@ namespace fir { class ExtendedValue; +class FirOpBuilder; +class GlobalOp; } // namespace fir namespace Fortran ::lower { @@ -88,6 +90,11 @@ mlir::Location, mlir::Type boxType, const SomeExpr &initialTarget); +/// Call \p genInit to generate code inside \p global initializer region. +void createGlobalInitialization( + fir::FirOpBuilder &builder, fir::GlobalOp global, + std::function genInit); + /// Generate address \p addr inside an initializer. fir::ExtendedValue genExtAddrInInitializer(Fortran::lower::AbstractConverter &converter, diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp --- a/flang/lib/Lower/ConvertVariable.cpp +++ b/flang/lib/Lower/ConvertVariable.cpp @@ -360,9 +360,9 @@ } /// Call \p genInit to generate code inside \p global initializer region. -static void -createGlobalInitialization(fir::FirOpBuilder &builder, fir::GlobalOp global, - std::function genInit) { +void Fortran::lower::createGlobalInitialization( + fir::FirOpBuilder &builder, fir::GlobalOp global, + std::function genInit) { mlir::Region ®ion = global.getRegion(); region.push_back(new mlir::Block); mlir::Block &block = region.back(); @@ -424,24 +424,26 @@ sym.detailsIf(); if (details && details->init()) { auto expr = *details->init(); - createGlobalInitialization(builder, global, [&](fir::FirOpBuilder &b) { - mlir::Value box = - Fortran::lower::genInitialDataTarget(converter, loc, symTy, expr); - b.create(loc, box); - }); + Fortran::lower::createGlobalInitialization( + builder, global, [&](fir::FirOpBuilder &b) { + mlir::Value box = Fortran::lower::genInitialDataTarget( + converter, loc, symTy, expr); + b.create(loc, box); + }); } else { // Create unallocated/disassociated descriptor if no explicit init - createGlobalInitialization(builder, global, [&](fir::FirOpBuilder &b) { - mlir::Value box = - fir::factory::createUnallocatedBox(b, loc, symTy, llvm::None); - b.create(loc, box); - }); + Fortran::lower::createGlobalInitialization( + builder, global, [&](fir::FirOpBuilder &b) { + mlir::Value box = + fir::factory::createUnallocatedBox(b, loc, symTy, llvm::None); + b.create(loc, box); + }); } } else if (const auto *details = sym.detailsIf()) { if (details->init()) { - createGlobalInitialization( + Fortran::lower::createGlobalInitialization( builder, global, [&](fir::FirOpBuilder &builder) { Fortran::lower::StatementContext stmtCtx( /*cleanupProhibited=*/true); @@ -452,7 +454,7 @@ builder.create(loc, castTo); }); } else if (hasDefaultInitialization(sym)) { - createGlobalInitialization( + Fortran::lower::createGlobalInitialization( builder, global, [&](fir::FirOpBuilder &builder) { Fortran::lower::StatementContext stmtCtx( /*cleanupProhibited=*/true); @@ -477,7 +479,7 @@ // conflicts. if (sym.attrs().test(Fortran::semantics::Attr::BIND_C)) TODO(loc, "BIND(C) module variable linkage"); - createGlobalInitialization( + Fortran::lower::createGlobalInitialization( builder, global, [&](fir::FirOpBuilder &builder) { builder.create( loc, builder.create(loc, symTy)); @@ -683,7 +685,7 @@ if (const auto *objectDetails = initSym->detailsIf()) if (objectDetails->init()) { - createGlobalInitialization( + Fortran::lower::createGlobalInitialization( builder, global, [&](fir::FirOpBuilder &builder) { Fortran::lower::StatementContext stmtCtx; mlir::Value initVal = fir::getBase(genInitializerExprValue( @@ -695,11 +697,12 @@ // Equivalence has no Fortran initial value. Create an undefined FIR initial // value to ensure this is consider an object definition in the IR regardless // of the linkage. - createGlobalInitialization(builder, global, [&](fir::FirOpBuilder &builder) { - Fortran::lower::StatementContext stmtCtx; - mlir::Value initVal = builder.create(loc, aggTy); - builder.create(loc, initVal); - }); + Fortran::lower::createGlobalInitialization( + builder, global, [&](fir::FirOpBuilder &builder) { + Fortran::lower::StatementContext stmtCtx; + mlir::Value initVal = builder.create(loc, aggTy); + builder.create(loc, initVal); + }); return global; } @@ -1012,7 +1015,7 @@ LLVM_DEBUG(llvm::dbgs() << "}\n"); builder.create(loc, cb); }; - createGlobalInitialization(builder, global, initFunc); + Fortran::lower::createGlobalInitialization(builder, global, initFunc); } void Fortran::lower::defineCommonBlocks( diff --git a/flang/lib/Lower/OpenMP.cpp b/flang/lib/Lower/OpenMP.cpp --- a/flang/lib/Lower/OpenMP.cpp +++ b/flang/lib/Lower/OpenMP.cpp @@ -14,6 +14,7 @@ #include "flang/Common/idioms.h" #include "flang/Lower/Bridge.h" #include "flang/Lower/ConvertExpr.h" +#include "flang/Lower/ConvertVariable.h" #include "flang/Lower/PFTBuilder.h" #include "flang/Lower/StatementContext.h" #include "flang/Optimizer/Builder/BoxValue.h" @@ -1666,6 +1667,39 @@ // Generate the threadprivate value for the common block member. symThreadprivateValue = genCommonBlockMember(converter, sym, commonThreadprivateValue); + } else if (!var.isGlobal()) { + // Non-global variable which can be in threadprivate directive must be one + // variable in main program, and it has implicit SAVE attribute. Take it as + // with SAVE attribute, so to create GlobalOp for it to simplify the + // translation to LLVM IR. + mlir::Type ty = converter.genType(sym); + std::string globalName = converter.mangleName(sym); + mlir::StringAttr linkage = firOpBuilder.createInternalLinkage(); + fir::GlobalOp global = + firOpBuilder.createGlobal(currentLocation, ty, globalName, linkage); + + // Create default initialization for non-character scalar. + if (Fortran::semantics::IsAllocatableOrPointer(sym)) { + mlir::Type baseAddrType = ty.dyn_cast().getEleTy(); + Fortran::lower::createGlobalInitialization( + firOpBuilder, global, [&](fir::FirOpBuilder &b) { + mlir::Value nullAddr = + b.createNullConstant(currentLocation, baseAddrType); + mlir::Value box = + b.create(currentLocation, ty, nullAddr); + b.create(currentLocation, box); + }); + } else { + Fortran::lower::createGlobalInitialization( + firOpBuilder, global, [&](fir::FirOpBuilder &b) { + mlir::Value undef = b.create(currentLocation, ty); + b.create(currentLocation, undef); + }); + } + mlir::Value symValue = firOpBuilder.create( + currentLocation, global.resultType(), global.getSymbol()); + symThreadprivateValue = firOpBuilder.create( + currentLocation, symValue.getType(), symValue); } else { mlir::Value symValue = converter.getSymbolAddress(sym); symThreadprivateValue = firOpBuilder.create( diff --git a/flang/test/Lower/OpenMP/threadprivate-non-global.f90 b/flang/test/Lower/OpenMP/threadprivate-non-global.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/OpenMP/threadprivate-non-global.f90 @@ -0,0 +1,91 @@ +! This test checks lowering of OpenMP Threadprivate Directive. +! Test for non-character non-SAVEd non-initialized scalars with or without +! allocatable or pointer attribute in main program. + +!RUN: %flang_fc1 -emit-fir -fopenmp %s -o - | FileCheck %s + +program test + integer :: x + real :: y + logical :: z + complex :: w + integer, pointer :: a + real, allocatable :: b + +!CHECK-DAG: [[ADDR0:%.*]] = fir.address_of(@_QFEa) : !fir.ref>> +!CHECK-DAG: [[NEWADDR0:%.*]] = omp.threadprivate [[ADDR0]] : !fir.ref>> -> !fir.ref>> +!CHECK-DAG: [[ADDR1:%.*]] = fir.address_of(@_QFEb) : !fir.ref>> +!CHECK-DAG: [[NEWADDR1:%.*]] = omp.threadprivate [[ADDR1]] : !fir.ref>> -> !fir.ref>> +!CHECK-DAG: [[ADDR2:%.*]] = fir.address_of(@_QFEw) : !fir.ref> +!CHECK-DAG: [[NEWADDR2:%.*]] = omp.threadprivate [[ADDR2]] : !fir.ref> -> !fir.ref> +!CHECK-DAG: [[ADDR3:%.*]] = fir.address_of(@_QFEx) : !fir.ref +!CHECK-DAG: [[NEWADDR3:%.*]] = omp.threadprivate [[ADDR3]] : !fir.ref -> !fir.ref +!CHECK-DAG: [[ADDR4:%.*]] = fir.address_of(@_QFEy) : !fir.ref +!CHECK-DAG: [[NEWADDR4:%.*]] = omp.threadprivate [[ADDR4]] : !fir.ref -> !fir.ref +!CHECK-DAG: [[ADDR5:%.*]] = fir.address_of(@_QFEz) : !fir.ref> +!CHECK-DAG: [[NEWADDR5:%.*]] = omp.threadprivate [[ADDR5]] : !fir.ref> -> !fir.ref> + !$omp threadprivate(x, y, z, w, a, b) + + call sub(a, b) + +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR3]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR4]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR5]] : !fir.ref> +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR2]] : !fir.ref> +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR0]] : !fir.ref>> +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR1]] : !fir.ref>> + print *, x, y, z, w, a, b + + !$omp parallel +!CHECK-DAG: [[ADDR68:%.*]] = omp.threadprivate [[ADDR0]] : !fir.ref>> -> !fir.ref>> +!CHECK-DAG: [[ADDR69:%.*]] = omp.threadprivate [[ADDR1]] : !fir.ref>> -> !fir.ref>> +!CHECK-DAG: [[ADDR70:%.*]] = omp.threadprivate [[ADDR2]] : !fir.ref> -> !fir.ref> +!CHECK-DAG: [[ADDR71:%.*]] = omp.threadprivate [[ADDR3]] : !fir.ref -> !fir.ref +!CHECK-DAG: [[ADDR72:%.*]] = omp.threadprivate [[ADDR4]] : !fir.ref -> !fir.ref +!CHECK-DAG: [[ADDR73:%.*]] = omp.threadprivate [[ADDR5]] : !fir.ref> -> !fir.ref> +!CHECK-DAG: %{{.*}} = fir.load [[ADDR71]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.load [[ADDR72]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.load [[ADDR73]] : !fir.ref> +!CHECK-DAG: %{{.*}} = fir.load [[ADDR70]] : !fir.ref> +!CHECK-DAG: %{{.*}} = fir.load [[ADDR68]] : !fir.ref>> +!CHECK-DAG: %{{.*}} = fir.load [[ADDR69]] : !fir.ref>> + print *, x, y, z, w, a, b + !$omp end parallel + +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR3]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR4]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR5]] : !fir.ref> +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR2]] : !fir.ref> +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR0]] : !fir.ref>> +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR1]] : !fir.ref>> + print *, x, y, z, w, a, b + +!CHECK: return + +!CHECK-DAG: fir.global internal @_QFEa : !fir.box> { +!CHECK-DAG: [[Z0:%.*]] = fir.zero_bits !fir.ptr +!CHECK-DAG: [[E0:%.*]] = fir.embox [[Z0]] : (!fir.ptr) -> !fir.box> +!CHECK-DAG: fir.has_value [[E0]] : !fir.box> +!CHECK-DAG: } +!CHECK-DAG: fir.global internal @_QFEb : !fir.box> { +!CHECK-DAG: [[Z1:%.*]] = fir.zero_bits !fir.heap +!CHECK-DAG: [[E1:%.*]] = fir.embox [[Z1]] : (!fir.heap) -> !fir.box> +!CHECK-DAG: fir.has_value [[E1]] : !fir.box> +!CHECK-DAG: } +!CHECK-DAG: fir.global internal @_QFEw : !fir.complex<4> { +!CHECK-DAG: [[Z2:%.*]] = fir.undefined !fir.complex<4> +!CHECK-DAG: fir.has_value [[Z2]] : !fir.complex<4> +!CHECK-DAG: } +!CHECK-DAG: fir.global internal @_QFEx : i32 { +!CHECK-DAG: [[Z3:%.*]] = fir.undefined i32 +!CHECK-DAG: fir.has_value [[Z3]] : i32 +!CHECK-DAG: } +!CHECK-DAG: fir.global internal @_QFEy : f32 { +!CHECK-DAG: [[Z4:%.*]] = fir.undefined f32 +!CHECK-DAG: fir.has_value [[Z4]] : f32 +!CHECK-DAG: } +!CHECK-DAG: fir.global internal @_QFEz : !fir.logical<4> { +!CHECK-DAG: [[Z5:%.*]] = fir.undefined !fir.logical<4> +!CHECK-DAG: fir.has_value [[Z5]] : !fir.logical<4> +!CHECK-DAG: } +end