[flang-commits] [PATCH] D148130: [flang] Change TYPE(*) arrays passing convention

[Jean Perier via Phabricator via flang-commits]

jeanPerier created this revision.
jeanPerier added reviewers: clementval, PeteSteinfeld.
jeanPerier added a project: Flang.
Herald added subscribers: sunshaoce, mehdi_amini, jdoerfert.
Herald added a project: All.
jeanPerier requested review of this revision.

- Fix the BIND(C) assumed-shape case: TYPE(*) assumed shape are passed via CFI_cdesc_t according to Fortran 2018 standard 18.3.6 point 2 (5).
- Align the none BIND(C) case with the BIND(C) case. There is little point passing TYPE(*) assumed size via descriptor, use a simple address. C710 ensures there is no way the knowledge of the actual type will be required when manipulating the dummy.

Depends on D148128 <https://reviews.llvm.org/D148128>


Repository:
  rG LLVM Github Monorepo

https://reviews.llvm.org/D148130

Files:
  flang/lib/Lower/CallInterface.cpp
  flang/lib/Lower/ConvertExpr.cpp
  flang/test/Lower/assumed-type.f90
  flang/test/Lower/polymorphic-types.f90


Index: flang/test/Lower/polymorphic-types.f90
===================================================================
--- flang/test/Lower/polymorphic-types.f90
+++ flang/test/Lower/polymorphic-types.f90
@@ -179,6 +179,6 @@
   end subroutine assumed_type_dummy_array
 
   ! CHECK-LABEL: func.func @assumed_type_dummy_array(
-  ! CHECK-SAME: %{{.*}}: !fir.ref<none>
+  ! CHECK-SAME: %{{.*}}: !fir.box<!fir.array<?xnone>>
 
 end module
Index: flang/test/Lower/assumed-type.f90
===================================================================
--- flang/test/Lower/assumed-type.f90
+++ flang/test/Lower/assumed-type.f90
@@ -23,8 +23,8 @@
 
 ! CHECK-LABEL: func.func @_QMassumed_type_testPcall_assumed() {
 ! CHECK: %[[I:.*]] = fir.alloca i32 {bindc_name = "i", fir.target, uniq_name = "_QMassumed_type_testFcall_assumedEi"}
-! CHECK: %[[BOX_NONE:.*]] = fir.embox %[[I]] : (!fir.ref<i32>) -> !fir.box<none>
-! CHECK: fir.call @_QPassumed(%[[BOX_NONE]]) fastmath<contract> : (!fir.box<none>) -> ()
+! CHECK: %[[CONV:.*]] = fir.convert %[[I]] : (!fir.ref<i32>) -> !fir.ref<none>
+! CHECK: fir.call @_QPassumed(%[[CONV]]) {{.*}}: (!fir.ref<none>) -> ()
 
   subroutine call_assumed_r()
     integer, target :: i(10)
@@ -32,12 +32,9 @@
   end subroutine
 
 ! CHECK-LABEL: func.func @_QMassumed_type_testPcall_assumed_r() {
-! CHECK: %[[C10:.*]] = arith.constant 10 : index
 ! CHECK: %[[I:.*]] = fir.alloca !fir.array<10xi32> {bindc_name = "i", fir.target, uniq_name = "_QMassumed_type_testFcall_assumed_rEi"}
-! CHECK: %[[SHAPE:.*]] = fir.shape %[[C10]] : (index) -> !fir.shape<1>
-! CHECK: %[[BOX_NONE:.*]] = fir.embox %[[I]](%[[SHAPE]]) : (!fir.ref<!fir.array<10xi32>>, !fir.shape<1>) -> !fir.box<!fir.array<10xnone>>
-! CHECK: %[[CONV:.*]] = fir.convert %[[BOX_NONE]] : (!fir.box<!fir.array<10xnone>>) -> !fir.box<!fir.array<?xnone>>
-! CHECK: fir.call @_QPassumed_r(%[[CONV]]) {{.*}} : (!fir.box<!fir.array<?xnone>>) -> ()
+! CHECK: %[[CONV:.*]] = fir.convert %[[I]] : (!fir.ref<!fir.array<10xi32>>) -> !fir.ref<!fir.array<?xnone>>
+! CHECK: fir.call @_QPassumed_r(%[[CONV]]) {{.*}} : (!fir.ref<!fir.array<?xnone>>) -> ()
 
   subroutine assumed_type_optional_to_intrinsic(a)
     type(*), optional :: a(:)
Index: flang/lib/Lower/ConvertExpr.cpp
===================================================================
--- flang/lib/Lower/ConvertExpr.cpp
+++ flang/lib/Lower/ConvertExpr.cpp
@@ -1844,8 +1844,22 @@
         const Fortran::evaluate::Symbol *assumedTypeSym =
             arg.value()->GetAssumedTypeDummy();
         auto symBox = symMap.lookupSymbol(*assumedTypeSym);
-        operands.emplace_back(
-            converter.getSymbolExtendedValue(*assumedTypeSym, &symMap));
+        ExtValue exv =
+            converter.getSymbolExtendedValue(*assumedTypeSym, &symMap);
+        if (argLowering) {
+          fir::ArgLoweringRule argRules =
+              fir::lowerIntrinsicArgumentAs(*argLowering, arg.index());
+          // Note: usages of TYPE(*) is limited by C710 but C_LOC and
+          // IS_CONTIGUOUS may require an assumed size TYPE(*) to be passed to
+          // the intrinsic library utility as a fir.box.
+          if (argRules.lowerAs == fir::LowerIntrinsicArgAs::Box &&
+              !fir::getBase(exv).getType().isa<fir::BaseBoxType>()) {
+            operands.emplace_back(
+                fir::factory::createBoxValue(builder, loc, exv));
+            continue;
+          }
+        }
+        operands.emplace_back(std::move(exv));
         continue;
       }
       if (!expr) {
Index: flang/lib/Lower/CallInterface.cpp
===================================================================
--- flang/lib/Lower/CallInterface.cpp
+++ flang/lib/Lower/CallInterface.cpp
@@ -878,7 +878,7 @@
     if ((obj.type.attrs() & shapeRequiringBox).any())
       // Need to pass shape/coshape info in fir.box.
       return true;
-    if (obj.type.type().IsPolymorphic())
+    if (obj.type.type().IsPolymorphic() && !obj.type.type().IsAssumedType())
       // Need to pass dynamic type info in fir.box.
       return true;
     if (const Fortran::semantics::DerivedTypeSpec *derived =
@@ -965,14 +965,7 @@
     mlir::Type boxType = fir::wrapInClassOrBoxType(
         type, obj.type.type().IsPolymorphic(), obj.type.type().IsAssumedType());
 
-    if (obj.type.type().IsAssumedType() && isBindC) {
-      mlir::Type voidPtrType = fir::ReferenceType::get(
-          mlir::NoneType::get(&interface.converter.getMLIRContext()));
-      addFirOperand(voidPtrType, nextPassedArgPosition(), Property::BaseAddress,
-                    attrs);
-      addPassedArg(PassEntityBy::BaseAddress, entity, characteristics);
-    } else if (obj.attrs.test(Attrs::Allocatable) ||
-               obj.attrs.test(Attrs::Pointer)) {
+    if (obj.attrs.test(Attrs::Allocatable) || obj.attrs.test(Attrs::Pointer)) {
       // Pass as fir.ref<fir.box> or fir.ref<fir.class>
       mlir::Type boxRefType = fir::ReferenceType::get(boxType);
       addFirOperand(boxRefType, nextPassedArgPosition(), Property::MutableBox,


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D148130.512820.patch
Type: text/x-patch
Size: 5015 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20230412/04573b17/attachment-0001.bin>