[flang][OpenMP] Support for privatization in common block

[NimishMishra]

Summary

This patch provides support for usage of common block in private/firstprivate and lastprivate clauses/

Depends on: D127215

[kiranchandramohan]

flang/lib/Lower/OpenMP.cpp

388–390

Did you miss including the copyFirstPrivateSymbol in the else block?

[NimishMishra]

flang/lib/Lower/OpenMP.cpp

388–390

Yes. Thank you for the spot.

[kiranchandramohan]

LG.

flang/lib/Lower/OpenMP.cpp

404–405

Nit: Add braces here.

flang/lib/Lower/Bridge.cpp

public:
   mlir::Type genType(Fortran::common::TypeCategory tc) override final {
     return Fortran::lower::getFIRType(
         &getMLIRContext(), tc, bridge.getDefaultKinds().GetDefaultKind(tc),
         std::nullopt);
   }
 
   bool createHostAssociateVarClone(
       const Fortran::semantics::Symbol &sym) override final {
-    bool success{false};
-    if (const auto *commonDet =
-            sym.detailsIf<Fortran::semantics::CommonBlockDetails>()) {
-      for (const auto &mem : commonDet->objects())
-        success = genHostAssociateVarClone(*mem);
-    } else
-      success = genHostAssociateVarClone(sym);
-    return success;
-  }
-
-  bool genHostAssociateVarClone(const Fortran::semantics::Symbol &sym) {
     mlir::Location loc = genLocation(sym.name());
     mlir::Type symType = genType(sym);
     const auto *details = sym.detailsIf<Fortran::semantics::HostAssocDetails>();
     assert(details && "No host-association found");
     const Fortran::semantics::Symbol &hsym = details->symbol();
     mlir::Type hSymType = genType(hsym);
     Fortran::lower::SymbolBox hsb = lookupSymbol(hsym);
 

flang/lib/Lower/OpenMP.cpp

if (const auto &defaultClause =
                Fortran::parser::OmpDefaultClause::Type::Firstprivate)
         collectSymbols(Fortran::semantics::Symbol::Flag::OmpFirstPrivate);
     }
   }
 }
 
 void DataSharingProcessor::privatize() {
   for (auto sym : privatizedSymbols) {
+    if (const auto *commonDet =
+            sym->detailsIf<Fortran::semantics::CommonBlockDetails>()) {
+      for (const auto mem : commonDet->objects()) {
+        cloneSymbol(&*mem);
+        copyFirstPrivateSymbol(&*mem);
+      }
+    } else {
       cloneSymbol(sym);
       copyFirstPrivateSymbol(sym);
     }
   }
+}
 
 void DataSharingProcessor::copyLastPrivatize(mlir::Operation *op) {
   insertLastPrivateCompare(op);
-  for (auto sym : privatizedSymbols)
+  for (auto sym : privatizedSymbols) {
+    if (const auto *commonDet =
+            sym->detailsIf<Fortran::semantics::CommonBlockDetails>()) {
+      for (const auto mem : commonDet->objects()) {
+        copyLastPrivateSymbol(&*mem, &lastPrivIP);
+      }
+    } else
       copyLastPrivateSymbol(sym, &lastPrivIP);
   }
+}
 
 void DataSharingProcessor::defaultPrivatize() {
   for (auto sym : defaultSymbols) {
     if (!symbolsInNestedRegions.contains(sym) &&
         !symbolsInParentRegions.contains(sym) &&
         !privatizedSymbols.contains(sym)) {
       cloneSymbol(sym);
       copyFirstPrivateSymbol(sym);

flang/test/Lower/OpenMP/Todo/firstprivate-commonblock.f90

-! RUN: %not_todo_cmd bbc -emit-fir -fopenmp -o - %s 2>&1 | FileCheck %s
-! RUN: %not_todo_cmd %flang_fc1 -emit-fir -fopenmp -o - %s 2>&1 | FileCheck %s
-! XFAIL: *
-
-! CHECK: not yet implemented: Common Block in privatization clause
-subroutine firstprivate_common
-  common /c/ x, y
-  real x, y
-  !$omp parallel firstprivate(/c/)
-  !$omp end parallel
-end subroutine

flang/test/Lower/OpenMP/Todo/lastprivate-commonblock.f90

-! RUN: %not_todo_cmd bbc -emit-fir -fopenmp -o - %s 2>&1 | FileCheck %s
-! RUN: %not_todo_cmd %flang_fc1 -emit-fir -fopenmp -o - %s 2>&1 | FileCheck %s
-! XFAIL: *
-
-! CHECK: not yet implemented: Common Block in privatization clause
-subroutine lastprivate_common
-  common /c/ x, y
-  real x, y
-  !$omp do lastprivate(/c/)
-  do i=1,100
-  end do
-  !$omp end do
-end subroutine

flang/test/Lower/OpenMP/firstprivate-commonblock.f90

+! RUN: %flang_fc1 -emit-fir -fopenmp -o - %s 2>&1 | FileCheck %s
+
+!CHECK: func.func @_QPfirstprivate_common() {
+!CHECK: %[[val_0:.*]] = fir.address_of(@_QCc) : !fir.ref<!fir.array<8xi8>>
+!CHECK: %[[val_1:.*]] = fir.convert %[[val_0]] : (!fir.ref<!fir.array<8xi8>>) -> !fir.ref<!fir.array<?xi8>>
+!CHECK: %[[val_c0:.*]] = arith.constant 0 : index
+!CHECK: %[[val_2:.*]] = fir.coordinate_of %[[val_1]], %[[val_c0]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+!CHECK: %[[val_3:.*]] = fir.convert %[[val_2]] : (!fir.ref<i8>) -> !fir.ref<f32>
+!CHECK: %[[val_4:.*]] = fir.convert %[[val_0]] : (!fir.ref<!fir.array<8xi8>>) -> !fir.ref<!fir.array<?xi8>>
+!CHECK: %[[val_c4:.*]] = arith.constant 4 : index
+!CHECK: %[[val_5:.*]] = fir.coordinate_of %[[val_4]], %[[val_c4]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+!CHECK: %[[val_6:.*]] = fir.convert %[[val_5]] : (!fir.ref<i8>) -> !fir.ref<f32>
+!CHECK: omp.parallel {
+!CHECK: %[[val_7:.*]] = fir.alloca f32 {bindc_name = "x", pinned, uniq_name = "_QFfirstprivate_commonEx"}
+!CHECK: %[[val_8:.*]] = fir.load %[[val_3]] : !fir.ref<f32>
+!CHECK: fir.store %[[val_8]] to %[[val_7]] : !fir.ref<f32>
+!CHECK: %[[val_9:.*]] = fir.alloca f32 {bindc_name = "y", pinned, uniq_name = "_QFfirstprivate_commonEy"}
+!CHECK: %[[val_10:.*]] = fir.load %[[val_6]] : !fir.ref<f32>
+!CHECK: fir.store %[[val_10]] to %[[val_9]] : !fir.ref<f32>
+!CHECK: omp.terminator
+!CHECK: }
+!CHECK: return
+!CHECK: }
+
+subroutine firstprivate_common
+  common /c/ x, y
+  real x, y
+  !$omp parallel firstprivate(/c/)
+  !$omp end parallel
+end subroutine

flang/test/Lower/OpenMP/lastprivate-commonblock.f90

+! RUN: %flang_fc1 -emit-fir -fopenmp -o - %s 2>&1 | FileCheck %s 
+
+!CHECK: func.func @_QPlastprivate_common() {
+!CHECK: %[[val_0:.*]] = fir.alloca i32 {adapt.valuebyref}
+!CHECK: %[[val_1:.*]] = fir.alloca i32 {bindc_name = "i", uniq_name = "_QFlastprivate_commonEi"}
+!CHECK: %[[val_2:.*]] = fir.address_of(@_QCc) : !fir.ref<!fir.array<8xi8>>
+!CHECK: %[[val_3:.*]] = fir.convert %[[val_2]] : (!fir.ref<!fir.array<8xi8>>) -> !fir.ref<!fir.array<?xi8>>
+!CHECK: %[[val_c0:.*]] = arith.constant 0 : index
+!CHECK: %[[val_4:.*]] = fir.coordinate_of %[[val_3]], %[[val_c0]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+!CHECK: %[[val_5:.*]] = fir.convert %[[val_4]] : (!fir.ref<i8>) -> !fir.ref<f32>
+!CHECK: %[[val_6:.*]] = fir.convert %[[val_2]] : (!fir.ref<!fir.array<8xi8>>) -> !fir.ref<!fir.array<?xi8>>
+!CHECK: %[[val_c4:.*]] = arith.constant 4 : index
+!CHECK: %[[val_7:.*]] = fir.coordinate_of %[[val_6]], %[[val_c4]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+!CHECK: %[[val_8:.*]] = fir.convert %[[val_7]] : (!fir.ref<i8>) -> !fir.ref<f32>
+!CHECK: %[[val_9:.*]] = fir.alloca f32 {bindc_name = "x", pinned, uniq_name = "_QFlastprivate_commonEx"}
+!CHECK: %[[val_10:.*]] = fir.alloca f32 {bindc_name = "y", pinned, uniq_name = "_QFlastprivate_commonEy"}
+!CHECK: %[[val_c1_i32:.*]] = arith.constant 1 : i32
+!CHECK: %[[val_c100_i32:.*]] = arith.constant 100 : i32
+!CHECK: %[[val_c1_i32_0:.*]] = arith.constant 1 : i32
+!CHECK: omp.wsloop   for (%[[arg:.*]]) : i32 = (%[[val_c1_i32]]) to (%[[val_c100_i32]]) inclusive step (%[[val_c1_i32_0]]) {
+!CHECK: fir.store %[[arg]] to %[[val_0]] : !fir.ref<i32>
+!CHECK: %[[val_11:.*]] = arith.cmpi eq, %[[arg]], %[[val_c100_i32]] : i32
+!CHECK: fir.if %[[val_11]] {
+!CHECK: %[[val_12:.*]] = fir.load %[[val_9]] : !fir.ref<f32>
+!CHECK: fir.store %[[val_12]] to %[[val_5]] : !fir.ref<f32>
+!CHECK: %[[val_13:.*]] = fir.load %[[val_10]] : !fir.ref<f32>
+!CHECK: fir.store %[[val_13]] to %[[val_8]] : !fir.ref<f32>
+!CHECK: }
+!CHECK: omp.yield
+!CHECK: }
+!CHECK: return
+!CHECK: }
+subroutine lastprivate_common
+  common /c/ x, y
+  real x, y
+  !$omp do lastprivate(/c/)
+  do i=1,100
+  end do
+  !$omp end do
+end subroutine