[flang][OpenMP] Fix resolve common block in data-sharing clauses

[peixin]

Summary

The previous resolve only creates the host associated varaibles for
common block members, but does not replace the original objects with
the new created ones. Fix it and also compute the sizes and offsets
for the host common block members if they are host associated.

[peixin]

flang/lib/Semantics/compute-offsets.cpp

305

@klausler @schweitz For common block in OpenMP data-sharing clauses, each member is host associated, so it requires the computation of sizes and offsets. Is doing it here acceptable? It is not easy to do it when resovling the comon blcok in OpenMP clauses.

[kiranchandramohan]

flang/lib/Semantics/compute-offsets.cpp

305

Could you clarify why it is difficult to do in resolve-directives.cpp/check-omp-structure.cpp?
Also, would adding this here affect non-openmp host-association?

[peixin]

flang/lib/Semantics/compute-offsets.cpp

305

Could you clarify why it is difficult to do in resolve-directives.cpp/check-omp-structure.cpp?

There is no helper functions to compute the sizes and offsets in resolve-directives.cpp. Copy some code here will be requied. It is kind of redundant.

Also, would adding this here affect non-openmp host-association?

This will compute sizes and offsets for all host-associated variables, but I don't see any problem here. When creating one host associated variable, why not copy the sizes and offsets? Currently, the host associated mlir::Value is only obtained through HostAssocDetails and the sizes and offsets are ignored. This does not cause any problem for now since Fortran common block does not have host association.

[peixin]

flang/lib/Semantics/compute-offsets.cpp

305

I noticed the debug-dump-symbols info as follows:

program main
  integer :: x(2)
  real :: a, c
  integer :: b(2)
  common /blk/ a, b, c
  !$omp parallel private(/blk/, x)
    call sub(a, b, c, x)
  !$omp end parallel
end program

$ flang-new -fc1 -fdebug-dump-symbols test.f90
  MainProgram scope: main size=8 alignment=4
    a size=4 offset=0: ObjectEntity type: REAL(4)
    b size=8 offset=4: ObjectEntity type: INTEGER(4) shape: 1_8:2_8
    c size=4 offset=12: ObjectEntity type: REAL(4)
    x size=8 offset=0: ObjectEntity type: INTEGER(4) shape: 1_8:2_8
    blk size=16 offset=0: CommonBlockDetails alignment=4: a b c

Without this patch, it shows as follows:

$ flang-new -fc1 -fdebug-dump-symbols test.f90 -fopenmp
  MainProgram scope: main size=8 alignment=4
    a size=4 offset=0: ObjectEntity type: REAL(4)
    b size=8 offset=4: ObjectEntity type: INTEGER(4) shape: 1_8:2_8
    c size=4 offset=12: ObjectEntity type: REAL(4)
    x size=8 offset=0: ObjectEntity type: INTEGER(4) shape: 1_8:2_8
    blk size=16 offset=0: CommonBlockDetails alignment=4: a b c
    Block scope: size=0 alignment=1
      a (OmpPrivate): HostAssoc
      b (OmpPrivate): HostAssoc
      c (OmpPrivate): HostAssoc
      x (OmpPrivate): HostAssoc

The sizes, offsets, and alignment for both the Block scope and hostassoc variables are either missed or incorrect.

With this patch, it shows as follows:

$ flang-new -fc1 -fdebug-dump-symbols test.f90 -fopenmp
  MainProgram scope: main size=8 alignment=4
    a size=4 offset=0: ObjectEntity type: REAL(4)
    b size=8 offset=4: ObjectEntity type: INTEGER(4) shape: 1_8:2_8
    c size=4 offset=12: ObjectEntity type: REAL(4)
    x size=8 offset=0: ObjectEntity type: INTEGER(4) shape: 1_8:2_8
    blk size=16 offset=0: CommonBlockDetails alignment=4: a b c
    Block scope: size=24 alignment=4
      a (OmpPrivate) size=4 offset=0: HostAssoc
      b (OmpPrivate) size=8 offset=4: HostAssoc
      c (OmpPrivate) size=4 offset=12: HostAssoc
      x (OmpPrivate) size=8 offset=0: HostAssoc

The sizes, offsets, and alignment are all correct now.

[peixin]

flang/lib/Semantics/compute-offsets.cpp

305

ping. This blocks the lowering of private, firstprivate, and copyin clauses for common block.

[kiranchandramohan]

flang/lib/Semantics/compute-offsets.cpp

305

I will have a look at this later today.

BTW, isn't it possible to get the associated host symbol and get the offsets now?

[peixin]

flang/lib/Semantics/compute-offsets.cpp

305

Without this patch, it doesn't compute the offsets.

Here are two problems. One is to compute the sizes and offsets for the associated symbol. The fix is the following:

if (!symbol.has<ObjectEntityDetails>() && !symbol.has<ProcEntityDetails>() &&
    !symbol.has<HostAssocDetails>()) {

Again, Fortran common block doesn't have host association, so it is not included here.

The other is to compute the sizes and offsets for the host symbol, it needs more changes as follows:

if (symbol.has<HostAssocDetails>()) {
  symbol.GetUltimate().set_size(s.size);
  symbol.GetUltimate().set_offset(offset_);
}

All in all, there is nowhere to compute the sizes and offsets for the host and associated symbols of common block members. With this patch, it compute the sizes and offsets of the associated symbols and set the sizes and offsets for the host symbols according to the computation results of the host symbols.

[kiranchandramohan]

flang/include/flang/Semantics/symbol.h

355

Should this be a CHECK? Will there be valid cases where index is greater?

flang/lib/Semantics/compute-offsets.cpp

305

When creating one host associated variable, why not copy the sizes and offsets? .

I guess the idea was that we could always access the host variable and then get the sizes and offsets. Copying should only be done if the host-associated variable's offset and size can differ from the host variable.

305

The other is to compute the sizes and offsets for the host symbol, it needs more changes as follows:

Why doesn't this happen now and why do we have to do it during processing of the host-associated symbol? I am assuming DoSymbol function will be called separately for the host symbol now.

[peixin]

flang/include/flang/Semantics/symbol.h

355

Thanks for the notice. It should be a CHECK.

flang/lib/Semantics/compute-offsets.cpp

305

It also makes sense to me. I update this with one new solution, which does not compute the offsets/sizes for the associated variables. The previous design does not consider if common block member is one host associated varible or one ObjectEntity.

305

Push one new solution. Please check if it is more reasonble, which does not change the original design of DoSymbol function.

[peixin]

This needs rebase. Doing it.

[peixin]

rebase

[peixin]

ping

[peixin]

ping

[peixin]

ping

[kiranchandramohan]

This looks fine. Can you add a debug-dump-symbols test as well?

[peixin]

Rebase and add the test case as suggested.

[kiranchandramohan]

LGTM. Please wait a day before you submit incase other reviewers have comments.

flang/include/flang/Semantics/symbol.h

private:
   SymbolVector objects_;
 };
 
 class CommonBlockDetails : public WithBindName {
 public:
   MutableSymbolVector &objects() { return objects_; }
   const MutableSymbolVector &objects() const { return objects_; }
   void add_object(Symbol &object) { objects_.emplace_back(object); }
+  void replace_object(Symbol &object, unsigned index) {
+    CHECK(index < (unsigned)objects_.size());
+    objects_[index] = object;
+  }
   std::size_t alignment() const { return alignment_; }
   void set_alignment(std::size_t alignment) { alignment_ = alignment; }
 
 private:
   MutableSymbolVector objects_;
   std::size_t alignment_{0}; // required alignment in bytes
 };
 

flang/lib/Semantics/compute-offsets.cpp

void ComputeOffsetsHelper::DoCommonBlock(Symbol &commonBlock) {
   offset_ = 0;
   alignment_ = 0;
   std::size_t minSize{0};
   std::size_t minAlignment{0};
   for (auto &object : details.objects()) {
     Symbol &symbol{*object};
     auto errorSite{
         commonBlock.name().empty() ? symbol.name() : commonBlock.name()};
-    if (std::size_t padding{DoSymbol(symbol)}) {
+    if (std::size_t padding{DoSymbol(symbol.GetUltimate())}) {
       context_.Say(errorSite,
           "COMMON block /%s/ requires %zd bytes of padding before '%s' for alignment"_port_en_US,
           commonBlock.name(), padding, symbol.name());
     }
     auto eqIter{equivalenceBlock_.end()};
     auto iter{dependents_.find(symbol)};
     if (iter == dependents_.end()) {
       eqIter = equivalenceBlock_.find(symbol);
if (object.substringStart) {
     }
     result += kind * (*object.substringStart - 1);
   }
   return result;
 }
 
 std::size_t ComputeOffsetsHelper::DoSymbol(Symbol &symbol) {
   if (!symbol.has<ObjectEntityDetails>() && !symbol.has<ProcEntityDetails>()) {
     return 0;
   }
   SizeAndAlignment s{GetSizeAndAlignment(symbol, true)};
   if (s.size == 0) {
     return 0;
   }
   std::size_t previousOffset{offset_};
   offset_ = Align(offset_, s.alignment);
   std::size_t padding{offset_ - previousOffset};

flang/lib/Semantics/resolve-directives.cpp

common::visit(
             if (auto *symbol{ResolveOmpCommonBlockName(&name)}) {
               if (!dataCopyingAttributeFlags.test(ompFlag)) {
                 CheckMultipleAppearances(
                     name, *symbol, Symbol::Flag::OmpCommonBlock);
               }
               // 2.15.3 When a named common block appears in a list, it has the
               // same meaning as if every explicit member of the common block
               // appeared in the list
-              for (auto &object : symbol->get<CommonBlockDetails>().objects()) {
+              auto &details{symbol->get<CommonBlockDetails>()};
+              unsigned index{0};
+              for (auto &object : details.objects()) {
                 if (auto *resolvedObject{
                         ResolveOmp(*object, ompFlag, currScope())}) {
                   if (dataCopyingAttributeFlags.test(ompFlag)) {
                     CheckDataCopyingClause(name, *resolvedObject, ompFlag);
                   } else {
                     AddToContextObjectWithDSA(*resolvedObject, ompFlag);
                   }
+                  details.replace_object(*resolvedObject, index);
                 }
+                index++;
               }
             } else {
               context_.Say(name.source, // 2.15.3
                   "COMMON block must be declared in the same scoping unit "
                   "in which the OpenMP directive or clause appears"_err_en_US);
             }
           },
       },

flang/test/Semantics/OpenMP/omp-common-block.f90

+! RUN: %flang_fc1 -fopenmp -fdebug-dump-symbols %s | FileCheck %s
+
+program main
+  !CHECK: a size=4 offset=0: ObjectEntity type: REAL(4)
+  !CHECK: b size=8 offset=4: ObjectEntity type: INTEGER(4) shape: 1_8:2_8
+  !CHECK: c size=4 offset=12: ObjectEntity type: REAL(4)
+  !CHECK: blk size=16 offset=0: CommonBlockDetails alignment=4: a b c
+  real :: a, c
+  integer :: b(2)
+  common /blk/ a, b, c
+  !$omp parallel private(/blk/)
+    !CHECK: OtherConstruct scope: size=0 alignment=1
+    !CHECK:   a (OmpPrivate): HostAssoc
+    !CHECK:   b (OmpPrivate): HostAssoc
+    !CHECK:   c (OmpPrivate): HostAssoc
+    call sub(a, b, c)
+  !$omp end parallel
+end program

flang/test/Semantics/OpenMP/omp-threadprivate04.f90

 ! RUN: %python %S/../test_errors.py %s %flang_fc1 -fopenmp
 ! OpenMP Version 5.1
 ! Check OpenMP construct validity for the following directives:
 ! 2.21.2 Threadprivate Directive
 
 program main
   integer :: i, N = 10
-  integer, save :: x
-  common /blk/ y
+  integer, save :: x1, x2, x3, x4, x5, x6, x7, x8, x9
+  common /blk1/ y1, /blk2/ y2, /blk3/ y3, /blk4/ y4, /blk5/ y5
 
-  !$omp threadprivate(x, /blk/)
+  !$omp threadprivate(x1, x2, x3, x4, x5, x6, x7, x8, x9)
+  !$omp threadprivate(/blk1/, /blk2/, /blk3/, /blk4/, /blk5/)
 
-  !$omp parallel num_threads(x)
+  !$omp parallel num_threads(x1)
   !$omp end parallel
 
-  !$omp single copyprivate(x, /blk/)
+  !$omp single copyprivate(x2, /blk1/)
   !$omp end single
 
-  !$omp do schedule(static, x)
+  !$omp do schedule(static, x3)
   do i = 1, N
-    y = x
+    y1 = x3
   end do
   !$omp end do
 
-  !$omp parallel copyin(x, /blk/)
+  !$omp parallel copyin(x4, /blk2/)
   !$omp end parallel
 
-  !$omp parallel if(x > 1)
+  !$omp parallel if(x5 > 1)
   !$omp end parallel
 
-  !$omp teams thread_limit(x)
+  !$omp teams thread_limit(x6)
   !$omp end teams
 
   !ERROR: A THREADPRIVATE variable cannot be in PRIVATE clause
   !ERROR: A THREADPRIVATE variable cannot be in PRIVATE clause
-  !$omp parallel private(x, /blk/)
+  !$omp parallel private(x7, /blk3/)
   !$omp end parallel
 
   !ERROR: A THREADPRIVATE variable cannot be in FIRSTPRIVATE clause
   !ERROR: A THREADPRIVATE variable cannot be in FIRSTPRIVATE clause
-  !$omp parallel firstprivate(x, /blk/)
+  !$omp parallel firstprivate(x8, /blk4/)
   !$omp end parallel
 
   !ERROR: A THREADPRIVATE variable cannot be in SHARED clause
   !ERROR: A THREADPRIVATE variable cannot be in SHARED clause
-  !$omp parallel shared(x, /blk/)
+  !$omp parallel shared(x9, /blk5/)
   !$omp end parallel
 end