[flang][OpenMP] Support lowering of threadprivate directive for non global variables

[peixin]

Summary

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.

[peixin]

ping

[NimishMishra]

Thanks for the patch. I have a few comments and questions.

flang/lib/Lower/OpenMP.cpp

1681

Won't something like the following work:

mlir::Region &region = global.getRegion();
mlir::Block &block = region.back();
firOpBuilder.setInsertionPointToEnd(&block);
genInit(firOpBuilder);

1681

Maybe std::function<mlir::Value (fir::FirOpBuilder &)> genInit could be considered. Then a return box or a return undef could allow to take b.create<fir::HasValueOp>(currentLocation, ...); outside genInit (since the operation is anyway common).

flang/test/Lower/OpenMP/threadprivate-non-global.f90

28

Is the intent of keeping duplicate instances of w, a, and b to check if multiple instances to same instances is threadprivatized once? If so, do we need to check behaviour of the following:

integer, target :: x
integer, pointer :: a
a => x

30

Have we skipped FIR checks for this call? I don't suppose we need to check for the same, but confirming once anyway.

[peixin]

flang/lib/Lower/OpenMP.cpp

1681

I think no. There may be no block when instantiating the variables.

1681

Well, what you are proposing is the code style problem. This is following FIR lowering (flang/lib/Lower/ConvertVariable.cpp). I think it's better to keep the same style as FIR lowering.

flang/test/Lower/OpenMP/threadprivate-non-global.f90

28

Good catch. It's definitely a typo. Will remove it.

30

No. This call is not for FIR checking. Instead, it is for handling unassociated pointer (a) and unallocated allocatable (b). Printing an unassociated pointer or unallocated allocatable may cause one segfault in some cases if someone try to test execution of this test case. So, add one external call to handle it. Anyway, what I would like to do is to keep the test case simple and clean, but still meaningful in fortran.

[peixin]

flang/lib/Lower/OpenMP.cpp

1681

Will remove this lambda and reuse the function in ConvertVariable.cpp on next update.

[NimishMishra]

flang/test/Lower/OpenMP/threadprivate-non-global.f90

30

This makes sense. Thank you.

[peixin]

Fix the typo and reuse the function in ConvertVariable.cpp.

[peixin]

rebase

[NimishMishra]

I am OK with reusing createGlobalInitialization from ConvertVariable.cpp

flang/include/flang/Lower/ConvertVariable.h

 #define FORTRAN_LOWER_CONVERT_VARIABLE_H
 
 #include "flang/Lower/Support/Utils.h"
 #include "mlir/IR/Value.h"
 #include "llvm/ADT/DenseMap.h"
 
 namespace fir {
 class ExtendedValue;
+class FirOpBuilder;
+class GlobalOp;
 } // namespace fir
 
 namespace Fortran ::lower {
 class AbstractConverter;
 class CallerInterface;
 class StatementContext;
 class SymMap;
 namespace pft {

 // here to deal with this while lowering the initial expression value.
 
 /// Create initial-data-target fir.box in a global initializer region.
 /// This handles the local instantiation of the target variable.
 mlir::Value genInitialDataTarget(Fortran::lower::AbstractConverter &,
                                  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<void(fir::FirOpBuilder &)> genInit);
+
 /// Generate address \p addr inside an initializer.
 fir::ExtendedValue
 genExtAddrInInitializer(Fortran::lower::AbstractConverter &converter,
                         mlir::Location loc, const SomeExpr &addr);
 
 /// Create global variable from a compiler generated object symbol that
 /// describes a derived type for the runtime.
 void createRuntimeTypeInfoGlobal(Fortran::lower::AbstractConverter &converter,
                                  mlir::Location loc,
                                  const Fortran::semantics::Symbol &typeInfoSym);
 
 } // namespace Fortran::lower
 #endif // FORTRAN_LOWER_CONVERT_VARIABLE_H

flang/lib/Lower/ConvertVariable.cpp

 }
 
 /// Does this global already have an initializer ?
 static bool globalIsInitialized(fir::GlobalOp global) {
   return !global.getRegion().empty() || global.getInitVal();
 }
 
 /// Call \p genInit to generate code inside \p global initializer region.
-static void
-createGlobalInitialization(fir::FirOpBuilder &builder, fir::GlobalOp global,
-                           std::function<void(fir::FirOpBuilder &)> genInit) {
+void Fortran::lower::createGlobalInitialization(
+    fir::FirOpBuilder &builder, fir::GlobalOp global,
   mlir::Region &region = global.getRegion();
   region.push_back(new mlir::Block);
   mlir::Block &block = region.back();
   auto insertPt = builder.saveInsertionPoint();
   builder.setInsertionPointToStart(&block);
   genInit(builder);
   builder.restoreInsertionPoint(insertPt);
 }
static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
   if (!global)
     global = builder.createGlobal(loc, symTy, globalName, linkage,
                                   mlir::Attribute{}, isConst);
   if (Fortran::semantics::IsAllocatableOrPointer(sym)) {
     const auto *details =
         sym.detailsIf<Fortran::semantics::ObjectEntityDetails>();
     if (details && details->init()) {
       auto expr = *details->init();
-      createGlobalInitialization(builder, global, [&](fir::FirOpBuilder &b) {
-        mlir::Value box =
-            Fortran::lower::genInitialDataTarget(converter, loc, symTy, expr);
+      Fortran::lower::createGlobalInitialization(
+          builder, global, [&](fir::FirOpBuilder &b) {
+            mlir::Value box = Fortran::lower::genInitialDataTarget(
+                converter, loc, symTy, expr);
             b.create<fir::HasValueOp>(loc, box);
           });
     } else {
       // Create unallocated/disassociated descriptor if no explicit init
-      createGlobalInitialization(builder, global, [&](fir::FirOpBuilder &b) {
+      Fortran::lower::createGlobalInitialization(
+          builder, global, [&](fir::FirOpBuilder &b) {
             mlir::Value box =
                 fir::factory::createUnallocatedBox(b, loc, symTy, llvm::None);
             b.create<fir::HasValueOp>(loc, box);
           });
     }
 
   } else if (const auto *details =
                  sym.detailsIf<Fortran::semantics::ObjectEntityDetails>()) {
     if (details->init()) {
-      createGlobalInitialization(
+      Fortran::lower::createGlobalInitialization(
           builder, global, [&](fir::FirOpBuilder &builder) {
             Fortran::lower::StatementContext stmtCtx(
                 /*cleanupProhibited=*/true);
             fir::ExtendedValue initVal = genInitializerExprValue(
                 converter, loc, details->init().value(), stmtCtx);
             mlir::Value castTo =
                 builder.createConvert(loc, symTy, fir::getBase(initVal));
             builder.create<fir::HasValueOp>(loc, castTo);
           });
     } else if (hasDefaultInitialization(sym)) {
-      createGlobalInitialization(
+      Fortran::lower::createGlobalInitialization(
           builder, global, [&](fir::FirOpBuilder &builder) {
             Fortran::lower::StatementContext stmtCtx(
                 /*cleanupProhibited=*/true);
             mlir::Value initVal =
                 genDefaultInitializerValue(converter, loc, sym, symTy, stmtCtx);
             mlir::Value castTo = builder.createConvert(loc, symTy, initVal);
             builder.create<fir::HasValueOp>(loc, castTo);
           });
     }
   } else if (sym.has<Fortran::semantics::CommonBlockDetails>()) {
     mlir::emitError(loc, "COMMON symbol processed elsewhere");
   } else {
     TODO(loc, "global"); // Procedure pointer or something else
   }
   // Creates undefined initializer for globals without initializers
   if (!globalIsInitialized(global)) {
     // TODO: Is it really required to add the undef init if the Public
     // visibility is set ? We need to make sure the global is not optimized out
     // by LLVM if unused in the current compilation unit, but at least for
     // BIND(C) variables, an initial value may be given in another compilation
     // unit (on the C side), and setting an undef init here creates linkage
     // 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<fir::HasValueOp>(
               loc, builder.create<fir::UndefOp>(loc, symTy));
         });
   }
   // Set public visibility to prevent global definition to be optimized out
   // even if they have no initializer and are unused in this compilation unit.
   global.setVisibility(mlir::SymbolTable::Visibility::Public);
static fir::GlobalOp defineGlobalAggregateStore(
   if (!global)
     global = builder.createGlobal(loc, aggTy, aggName, linkage);
 
   if (const Fortran::semantics::Symbol *initSym =
           aggregate.getInitialValueSymbol())
     if (const auto *objectDetails =
             initSym->detailsIf<Fortran::semantics::ObjectEntityDetails>())
       if (objectDetails->init()) {
-        createGlobalInitialization(
+        Fortran::lower::createGlobalInitialization(
             builder, global, [&](fir::FirOpBuilder &builder) {
               Fortran::lower::StatementContext stmtCtx;
               mlir::Value initVal = fir::getBase(genInitializerExprValue(
                   converter, loc, objectDetails->init().value(), stmtCtx));
               builder.create<fir::HasValueOp>(loc, initVal);
             });
         return global;
       }
   // 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::createGlobalInitialization(
+      builder, global, [&](fir::FirOpBuilder &builder) {
         Fortran::lower::StatementContext stmtCtx;
         mlir::Value initVal = builder.create<fir::UndefOp>(loc, aggTy);
         builder.create<fir::HasValueOp>(loc, initVal);
       });
   return global;
 }
 
 /// Declare a GlobalOp for the storage of a global equivalence described
 /// by \p aggregate. The global is named \p aggName and is created with
 /// the provided \p linkage.
 /// No initializer is built for the created GlobalOp.
 /// This is to be used when lowering the scope that uses members of an
for (const Fortran::semantics::MutableSymbolRef &mem : cmnBlkMems) {
           ++tupIdx;
           offset = mem->offset() + mem->size();
         }
       }
     }
     LLVM_DEBUG(llvm::dbgs() << "}\n");
     builder.create<fir::HasValueOp>(loc, cb);
   };
-  createGlobalInitialization(builder, global, initFunc);
+  Fortran::lower::createGlobalInitialization(builder, global, initFunc);
 }
 
 void Fortran::lower::defineCommonBlocks(
     Fortran::lower::AbstractConverter &converter,
     const Fortran::semantics::CommonBlockList &commonBlocks) {
   // Common blocks may depend on another common block address (if they contain
   // pointers with initial targets). To cover this case, create all common block
   // fir::Global before creating the initial values (if any).

flang/lib/Lower/OpenMP.cpp

 //===-- OpenMP.cpp -- Open MP directive lowering --------------------------===//
 //
 // 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
 //
 //===----------------------------------------------------------------------===//
 //
 // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Lower/OpenMP.h"
 #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"
 #include "flang/Optimizer/Builder/FIRBuilder.h"
 #include "flang/Optimizer/Builder/Todo.h"
 #include "flang/Parser/parse-tree.h"
 #include "flang/Semantics/tools.h"
 #include "mlir/Dialect/OpenMP/OpenMPDialect.h"
if (const Fortran::semantics::Symbol *common =
     // Generate ThreadprivateOp and rebind the common block.
     mlir::Value commonThreadprivateValue =
         firOpBuilder.create<mlir::omp::ThreadprivateOp>(
             currentLocation, commonValue.getType(), commonValue);
     converter.bindSymbol(*common, commonThreadprivateValue);
     // 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<fir::BoxType>().getEleTy();
+      Fortran::lower::createGlobalInitialization(
+          firOpBuilder, global, [&](fir::FirOpBuilder &b) {
+            mlir::Value nullAddr =
+                b.createNullConstant(currentLocation, baseAddrType);
+            mlir::Value box =
+                b.create<fir::EmboxOp>(currentLocation, ty, nullAddr);
+            b.create<fir::HasValueOp>(currentLocation, box);
+          });
+    } else {
+      Fortran::lower::createGlobalInitialization(
+          firOpBuilder, global, [&](fir::FirOpBuilder &b) {
+            mlir::Value undef = b.create<fir::UndefOp>(currentLocation, ty);
+            b.create<fir::HasValueOp>(currentLocation, undef);
+          });
+    }
+    mlir::Value symValue = firOpBuilder.create<fir::AddrOfOp>(
+        currentLocation, global.resultType(), global.getSymbol());
+    symThreadprivateValue = firOpBuilder.create<mlir::omp::ThreadprivateOp>(
+        currentLocation, symValue.getType(), symValue);
   } else {
     mlir::Value symValue = converter.getSymbolAddress(sym);
     symThreadprivateValue = firOpBuilder.create<mlir::omp::ThreadprivateOp>(
         currentLocation, symValue.getType(), symValue);
   }
 
   fir::ExtendedValue sexv = converter.getSymbolExtendedValue(sym);
   fir::ExtendedValue symThreadprivateExv =

flang/test/Lower/OpenMP/threadprivate-non-global.f90

+! 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<!fir.box<!fir.ptr<i32>>>
+!CHECK-DAG:  [[NEWADDR0:%.*]] = omp.threadprivate [[ADDR0]] : !fir.ref<!fir.box<!fir.ptr<i32>>> -> !fir.ref<!fir.box<!fir.ptr<i32>>>
+!CHECK-DAG:  [[ADDR1:%.*]] = fir.address_of(@_QFEb) : !fir.ref<!fir.box<!fir.heap<f32>>>
+!CHECK-DAG:  [[NEWADDR1:%.*]] = omp.threadprivate [[ADDR1]] : !fir.ref<!fir.box<!fir.heap<f32>>> -> !fir.ref<!fir.box<!fir.heap<f32>>>
+!CHECK-DAG:  [[ADDR2:%.*]] = fir.address_of(@_QFEw) : !fir.ref<!fir.complex<4>>
+!CHECK-DAG:  [[NEWADDR2:%.*]] = omp.threadprivate [[ADDR2]] : !fir.ref<!fir.complex<4>> -> !fir.ref<!fir.complex<4>>
+!CHECK-DAG:  [[ADDR3:%.*]] = fir.address_of(@_QFEx) : !fir.ref<i32>
+!CHECK-DAG:  [[NEWADDR3:%.*]] = omp.threadprivate [[ADDR3]] : !fir.ref<i32> -> !fir.ref<i32>
+!CHECK-DAG:  [[ADDR4:%.*]] = fir.address_of(@_QFEy) : !fir.ref<f32>
+!CHECK-DAG:  [[NEWADDR4:%.*]] = omp.threadprivate [[ADDR4]] : !fir.ref<f32> -> !fir.ref<f32>
+!CHECK-DAG:  [[ADDR5:%.*]] = fir.address_of(@_QFEz) : !fir.ref<!fir.logical<4>>
+!CHECK-DAG:  [[NEWADDR5:%.*]] = omp.threadprivate [[ADDR5]] : !fir.ref<!fir.logical<4>> -> !fir.ref<!fir.logical<4>>
+  !$omp threadprivate(x, y, z, w, a, b)
+
+  call sub(a, b)
+
+!CHECK-DAG:  %{{.*}} = fir.load [[NEWADDR3]] : !fir.ref<i32>
+!CHECK-DAG:  %{{.*}} = fir.load [[NEWADDR4]] : !fir.ref<f32>
+!CHECK-DAG:  %{{.*}} = fir.load [[NEWADDR5]] : !fir.ref<!fir.logical<4>>
+!CHECK-DAG:  %{{.*}} = fir.load [[NEWADDR2]] : !fir.ref<!fir.complex<4>>
+!CHECK-DAG:  %{{.*}} = fir.load [[NEWADDR0]] : !fir.ref<!fir.box<!fir.ptr<i32>>>
+!CHECK-DAG:  %{{.*}} = fir.load [[NEWADDR1]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+  print *, x, y, z, w, a, b
+
+  !$omp parallel
+!CHECK-DAG:    [[ADDR68:%.*]] = omp.threadprivate [[ADDR0]] : !fir.ref<!fir.box<!fir.ptr<i32>>> -> !fir.ref<!fir.box<!fir.ptr<i32>>>
+!CHECK-DAG:    [[ADDR69:%.*]] = omp.threadprivate [[ADDR1]] : !fir.ref<!fir.box<!fir.heap<f32>>> -> !fir.ref<!fir.box<!fir.heap<f32>>>
+!CHECK-DAG:    [[ADDR70:%.*]] = omp.threadprivate [[ADDR2]] : !fir.ref<!fir.complex<4>> -> !fir.ref<!fir.complex<4>>
+!CHECK-DAG:    [[ADDR71:%.*]] = omp.threadprivate [[ADDR3]] : !fir.ref<i32> -> !fir.ref<i32>
+!CHECK-DAG:    [[ADDR72:%.*]] = omp.threadprivate [[ADDR4]] : !fir.ref<f32> -> !fir.ref<f32>
+!CHECK-DAG:    [[ADDR73:%.*]] = omp.threadprivate [[ADDR5]] : !fir.ref<!fir.logical<4>> -> !fir.ref<!fir.logical<4>>
+!CHECK-DAG:    %{{.*}} = fir.load [[ADDR71]] : !fir.ref<i32>
+!CHECK-DAG:    %{{.*}} = fir.load [[ADDR72]] : !fir.ref<f32>
+!CHECK-DAG:    %{{.*}} = fir.load [[ADDR73]] : !fir.ref<!fir.logical<4>>
+!CHECK-DAG:    %{{.*}} = fir.load [[ADDR70]] : !fir.ref<!fir.complex<4>>
+!CHECK-DAG:    %{{.*}} = fir.load [[ADDR68]] : !fir.ref<!fir.box<!fir.ptr<i32>>>
+!CHECK-DAG:    %{{.*}} = fir.load [[ADDR69]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+    print *, x, y, z, w, a, b
+  !$omp end parallel
+
+!CHECK-DAG:  %{{.*}} = fir.load [[NEWADDR3]] : !fir.ref<i32>
+!CHECK-DAG:  %{{.*}} = fir.load [[NEWADDR4]] : !fir.ref<f32>
+!CHECK-DAG:  %{{.*}} = fir.load [[NEWADDR5]] : !fir.ref<!fir.logical<4>>
+!CHECK-DAG:  %{{.*}} = fir.load [[NEWADDR2]] : !fir.ref<!fir.complex<4>>
+!CHECK-DAG:  %{{.*}} = fir.load [[NEWADDR0]] : !fir.ref<!fir.box<!fir.ptr<i32>>>
+!CHECK-DAG:  %{{.*}} = fir.load [[NEWADDR1]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+  print *, x, y, z, w, a, b
+
+!CHECK:  return
+
+!CHECK-DAG: fir.global internal @_QFEa : !fir.box<!fir.ptr<i32>> {
+!CHECK-DAG:   [[Z0:%.*]] = fir.zero_bits !fir.ptr<i32>
+!CHECK-DAG:   [[E0:%.*]] = fir.embox [[Z0]] : (!fir.ptr<i32>) -> !fir.box<!fir.ptr<i32>>
+!CHECK-DAG:   fir.has_value [[E0]] : !fir.box<!fir.ptr<i32>>
+!CHECK-DAG: }
+!CHECK-DAG: fir.global internal @_QFEb : !fir.box<!fir.heap<f32>> {
+!CHECK-DAG:   [[Z1:%.*]] = fir.zero_bits !fir.heap<f32>
+!CHECK-DAG:   [[E1:%.*]] = fir.embox [[Z1]] : (!fir.heap<f32>) -> !fir.box<!fir.heap<f32>>
+!CHECK-DAG:   fir.has_value [[E1]] : !fir.box<!fir.heap<f32>>
+!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