[flang] Added storage specification for [hl]fir.declare.

flang/include/flang/Optimizer/Dialect/FIROps.td

@@ -3178,9 +3178,11 @@ def fir_IsPresentOp : fir_SimpleOp<"is_present", [NoMemoryEffect]> {
 // operations if the values are unused. fir.declare may be used to generate
 // debug information so we would like to keep this around even if the value
 // is not used.
-def fir_DeclareOp : fir_Op<"declare", [AttrSizedOperandSegments,
-    MemoryEffects<[MemAlloc<DebuggingResource>]>,
-    DeclareOpInterfaceMethods<fir_FortranVariableOpInterface>]> {
+def fir_DeclareOp
+    : fir_Op<"declare", [AttrSizedOperandSegments,
+                         MemoryEffects<[MemAlloc<DebuggingResource>]>,
+                         DeclareOpInterfaceMethods<
+                             fir_FortranVariableStorageOpInterface>]> {
   let summary = "declare a variable";
 
   let description = [{
@@ -3203,6 +3205,11 @@ def fir_DeclareOp : fir_Op<"declare", [AttrSizedOperandSegments,
     It must always be provided for characters and parametrized derived types
     when memref is not a box value or address.
 
+    The storage and storage_offset operands are optional and are required
+    for FortranVariableStorageOpInterface, where they are documented.
+    If these operands are absent, then the storage of the declared variable
+    is only known to start where the memref operand points to.
+
     Example:
 
     CHARACTER(n), OPTIONAL, TARGET :: c(10:, 20:)
@@ -3220,21 +3227,22 @@ def fir_DeclareOp : fir_Op<"declare", [AttrSizedOperandSegments,
    ```
   }];
 
-  let arguments = (ins
-    AnyRefOrBox:$memref,
-    Optional<AnyShapeOrShiftType>:$shape,
-    Variadic<AnyIntegerType>:$typeparams,
-    Optional<fir_DummyScopeType>:$dummy_scope,
-    Builtin_StringAttr:$uniq_name,
-    OptionalAttr<fir_FortranVariableFlagsAttr>:$fortran_attrs,
-    OptionalAttr<cuf_DataAttributeAttr>:$data_attr
-  );
+  let arguments = (ins AnyRefOrBox:$memref,
+      Optional<AnyShapeOrShiftType>:$shape,
+      Variadic<AnyIntegerType>:$typeparams,
+      Optional<fir_DummyScopeType>:$dummy_scope,
+      Optional<AnyReferenceLike>:$storage,
+      DefaultValuedAttr<UI64Attr, "0">:$storage_offset,
+      Builtin_StringAttr:$uniq_name,
+      OptionalAttr<fir_FortranVariableFlagsAttr>:$fortran_attrs,
+      OptionalAttr<cuf_DataAttributeAttr>:$data_attr);
 
   let results = (outs AnyRefOrBox);
 
   let assemblyFormat = [{
     $memref (`(` $shape^ `)`)? (`typeparams` $typeparams^)?
     (`dummy_scope` $dummy_scope^)?
+    (`storage` `(` $storage^ `[` $storage_offset `]` `)`)?
     attr-dict `:` functional-type(operands, results)
   }];
 

flang/include/flang/Optimizer/Dialect/FIRTypes.td

@@ -610,9 +610,10 @@ def AnyCompositeLike : TypeConstraint<Or<[fir_RecordType.predicate,
     "any composite">;
 
 // Reference types
-def AnyReferenceLike : TypeConstraint<Or<[fir_ReferenceType.predicate,
-    fir_HeapType.predicate, fir_PointerType.predicate,
-    fir_LLVMPointerType.predicate]>, "any reference">;
+def AnyReferenceLike
+    : Type<Or<[fir_ReferenceType.predicate, fir_HeapType.predicate,
+               fir_PointerType.predicate, fir_LLVMPointerType.predicate]>,
+           "any reference">;
 
 def FuncType : TypeConstraint<FunctionType.predicate, "function type">;
 

flang/include/flang/Optimizer/Dialect/FortranVariableInterface.h

@@ -19,6 +19,11 @@
 #include "mlir/IR/BuiltinTypes.h"
 #include "mlir/IR/OpDefinition.h"
 
+namespace fir::detail {
+/// Verify operations implementing FortranVariableStorageOpInterface.
+mlir::LogicalResult verifyFortranVariableStorageOpInterface(mlir::Operation *);
+} // namespace fir::detail
+
 #include "flang/Optimizer/Dialect/FortranVariableInterface.h.inc"
 
 #endif // FORTRAN_OPTIMIZER_DIALECT_FORTRANVARIABLEINTERFACE_H

flang/include/flang/Optimizer/Dialect/FortranVariableInterface.td

@@ -213,4 +213,56 @@ def fir_FortranVariableOpInterface : OpInterface<"FortranVariableOpInterface"> {
 
 }
 
+def fir_FortranVariableStorageOpInterface
+    : OpInterface<"FortranVariableStorageOpInterface",
+                  [fir_FortranVariableOpInterface]> {
+  let description = [{
+    An extension of FortranVariableOpInterface for operations that provide
+    information about the physical storage layout of the variable.
+    The operations provide the raw address of the physical storage
+    and the byte offset where the variable begins within the physical
+    storage.
+    The storage is a reference to an array of known size consisting
+    of i8 elements. This is how Flang represents COMMON and EQUIVALENCE
+    storage blocks with the member variables located within the storage
+    at different offsets. The storage offset for a variable must not
+    exceed the storage size. Note that the zero-sized variables
+    may start at the offset that is after the final byte of the storage.
+    When getStorage() returns nullptr, getStorageOffset() must return 0.
+    This means that nothing is known about the physical storage
+    of the variable (beyond the information maybe provided
+    by the concrete operation itself, e.g. fir.declare defines
+    the physical storage of a variable via memref operand,
+    where the variable starts).
+  }];
+
+  let methods =
+      [InterfaceMethod<
+           /*desc=*/"Returns the raw address of the physical storage",
+           /*retTy=*/"mlir::Value",
+           /*methodName=*/"getStorage",
+           /*args=*/(ins),
+           /*methodBody=*/[{}],
+           /*defaultImplementation=*/[{
+        ConcreteOp op = mlir::cast<ConcreteOp>(this->getOperation());
+        return op.getStorage();
+      }]>,
+       InterfaceMethod<
+           /*desc=*/"Returns the byte offset where the variable begins "
+                    "within the physical storage",
+           /*retTy=*/"std::uint64_t",
+           /*methodName=*/"getStorageOffset",
+           /*args=*/(ins),
+           /*methodBody=*/[{}],
+           /*defaultImplementation=*/[{
+        ConcreteOp op = mlir::cast<ConcreteOp>(this->getOperation());
+        return op.getStorageOffset();
+      }]>,
+  ];
+
+  let cppNamespace = "fir";
+  let verify =
+      [{ return detail::verifyFortranVariableStorageOpInterface($_op); }];
+}
+
 #endif  // FORTRANVARIABLEINTERFACE

flang/include/flang/Optimizer/HLFIR/HLFIROps.td

@@ -35,16 +35,22 @@ class hlfir_Op<string mnemonic, list<Trait> traits>
 // removed by dead code elimination if the value result is unused. Information
 // from the declare operation can be used to generate debug information so we
 // don't want to remove it as dead code
-def hlfir_DeclareOp : hlfir_Op<"declare", [AttrSizedOperandSegments,
-    MemoryEffects<[MemAlloc<DebuggingResource>]>,
-    DeclareOpInterfaceMethods<fir_FortranVariableOpInterface>]> {
+def hlfir_DeclareOp
+    : hlfir_Op<"declare", [AttrSizedOperandSegments,
+                           MemoryEffects<[MemAlloc<DebuggingResource>]>,
+                           DeclareOpInterfaceMethods<
+                               fir_FortranVariableStorageOpInterface>]> {
   let summary = "declare a variable and produce an SSA value that can be used as a variable in HLFIR operations";
 
   let description = [{
     Tie the properties of a Fortran variable to an address. The properties
     include bounds, length parameters, and Fortran attributes.
 
     The arguments are the same as for fir.declare.
+    The storage and storage_offset operands are optional and are required
+    for FortranVariableStorageOpInterface, where they are documented.
+    If these operands are absent, then the storage of the declared variable
+    is only known to start where the memref operand points to.
 
     The main difference with fir.declare is that hlfir.declare returns two
     values:
@@ -84,21 +90,22 @@ def hlfir_DeclareOp : hlfir_Op<"declare", [AttrSizedOperandSegments,
    ```
   }];
 
-  let arguments = (ins
-    AnyRefOrBox:$memref,
-    Optional<AnyShapeOrShiftType>:$shape,
-    Variadic<AnyIntegerType>:$typeparams,
-    Optional<fir_DummyScopeType>:$dummy_scope,
-    Builtin_StringAttr:$uniq_name,
-    OptionalAttr<fir_FortranVariableFlagsAttr>:$fortran_attrs,
-    OptionalAttr<cuf_DataAttributeAttr>:$data_attr
-  );
+  let arguments = (ins AnyRefOrBox:$memref,
+      Optional<AnyShapeOrShiftType>:$shape,
+      Variadic<AnyIntegerType>:$typeparams,
+      Optional<fir_DummyScopeType>:$dummy_scope,
+      Optional<AnyReferenceLike>:$storage,
+      DefaultValuedAttr<UI64Attr, "0">:$storage_offset,
+      Builtin_StringAttr:$uniq_name,
+      OptionalAttr<fir_FortranVariableFlagsAttr>:$fortran_attrs,
+      OptionalAttr<cuf_DataAttributeAttr>:$data_attr);
 
   let results = (outs AnyFortranVariable, AnyRefOrBoxLike);
 
   let assemblyFormat = [{
     $memref (`(` $shape^ `)`)? (`typeparams` $typeparams^)?
     (`dummy_scope` $dummy_scope^)?
+    (`storage` `(` $storage^ `[` $storage_offset `]` `)`)?
     attr-dict `:` functional-type(operands, results)
   }];
 

flang/lib/Optimizer/Builder/FIRBuilder.cpp

@@ -423,10 +423,11 @@ mlir::Value fir::FirOpBuilder::genTempDeclareOp(
     llvm::ArrayRef<mlir::Value> typeParams,
     fir::FortranVariableFlagsAttr fortranAttrs) {
   auto nameAttr = mlir::StringAttr::get(builder.getContext(), name);
-  return fir::DeclareOp::create(builder, loc, memref.getType(), memref, shape,
-                                typeParams,
-                                /*dummy_scope=*/nullptr, nameAttr, fortranAttrs,
-                                cuf::DataAttributeAttr{});
+  return fir::DeclareOp::create(
+      builder, loc, memref.getType(), memref, shape, typeParams,
+      /*dummy_scope=*/nullptr,
+      /*storage=*/nullptr,
+      /*storage_offset=*/0, nameAttr, fortranAttrs, cuf::DataAttributeAttr{});
 }
 
 mlir::Value fir::FirOpBuilder::genStackSave(mlir::Location loc) {

flang/lib/Optimizer/Dialect/FortranVariableInterface.cpp

@@ -68,3 +68,31 @@ fir::FortranVariableOpInterface::verifyDeclareLikeOpImpl(mlir::Value memref) {
   }
   return mlir::success();
 }
+
+mlir::LogicalResult
+fir::detail::verifyFortranVariableStorageOpInterface(mlir::Operation *op) {
+  auto storageIface = mlir::cast<fir::FortranVariableStorageOpInterface>(op);
+  mlir::Value storage = storageIface.getStorage();
+  std::uint64_t storageOffset = storageIface.getStorageOffset();
+  if (!storage) {
+    if (storageOffset != 0)
+      return op->emitOpError(
+          "storage offset specified without the storage reference");
+    return mlir::success();
+  }
+
+  auto storageType =
+      mlir::dyn_cast<fir::SequenceType>(fir::unwrapRefType(storage.getType()));
+  if (!storageType || storageType.getDimension() != 1)
+    return op->emitOpError("storage must be a vector");
+  if (storageType.hasDynamicExtents())
+    return op->emitOpError("storage must have known extent");
+  if (storageType.getEleTy() != mlir::IntegerType::get(op->getContext(), 8))
+    return op->emitOpError("storage must be an array of i8 elements");
+  if (storageOffset > storageType.getConstantArraySize())
+    return op->emitOpError("storage offset exceeds the storage size");
+  // TODO: we should probably verify that the (offset + sizeof(var))
+  // is within the storage object, but this requires mlir::DataLayout.
+  // Can we make it available during the verification?
+  return mlir::success();
+}

flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp

@@ -279,7 +279,8 @@ void hlfir::DeclareOp::build(mlir::OpBuilder &builder,
   auto [hlfirVariableType, firVarType] =
       getDeclareOutputTypes(inputType, hasExplicitLbs);
   build(builder, result, {hlfirVariableType, firVarType}, memref, shape,
-        typeparams, dummy_scope, nameAttr, fortran_attrs, data_attr);
+        typeparams, dummy_scope, /*storage=*/nullptr, /*storage_offset=*/0,
+        nameAttr, fortran_attrs, data_attr);
 }
 
 llvm::LogicalResult hlfir::DeclareOp::verify() {

flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp

@@ -305,6 +305,8 @@ class DeclareOpConversion : public mlir::OpRewritePattern<hlfir::DeclareOp> {
     auto firDeclareOp = fir::DeclareOp::create(
         rewriter, loc, memref.getType(), memref, declareOp.getShape(),
         declareOp.getTypeparams(), declareOp.getDummyScope(),
+        /*storage=*/declareOp.getStorage(),
+        /*storage_offset=*/declareOp.getStorageOffset(),
         declareOp.getUniqName(), fortranAttrs, dataAttr);
 
     // Propagate other attributes from hlfir.declare to fir.declare.

flang/test/Fir/declare.fir

@@ -143,3 +143,22 @@ func.func @array_declare_unlimited_polymorphic_boxaddr(%arg0: !fir.ref<!fir.clas
 // CHECK-LABEL: func.func @array_declare_unlimited_polymorphic_boxaddr(
 // CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.class<!fir.ptr<!fir.array<?x?xnone>>>>) {
 // CHECK:  %[[VAL_1:.*]] = fir.declare %[[VAL_0]] {uniq_name = "x"} : (!fir.ref<!fir.class<!fir.ptr<!fir.array<?x?xnone>>>>) -> !fir.ref<!fir.class<!fir.ptr<!fir.array<?x?xnone>>>>
+
+// CHECK-LABEL:   func.func @vars_within_physical_storage() {
+// CHECK:           %[[VAL_2:.*]] = fir.address_of(@block_) : !fir.ref<!fir.array<8xi8>>
+// CHECK:           %[[VAL_6:.*]] = fir.declare %{{.*}} storage(%[[VAL_2]][0]) {uniq_name = "a"} : (!fir.ref<f32>, !fir.ref<!fir.array<8xi8>>) -> !fir.ref<f32>
+// CHECK:           %[[VAL_9:.*]] = fir.declare %{{.*}} storage(%[[VAL_2]][4]) {uniq_name = "b"} : (!fir.ref<f32>, !fir.ref<!fir.array<8xi8>>) -> !fir.ref<f32>
+fir.global common @block_(dense<0> : vector<8xi8>) {alignment = 4 : i64} : !fir.array<8xi8>
+func.func @vars_within_physical_storage() {
+  %c4 = arith.constant 4 : index
+  %c0 = arith.constant 0 : index
+  %1 = fir.address_of(@block_) : !fir.ref<!fir.array<8xi8>>
+  %2 = fir.convert %1 : (!fir.ref<!fir.array<8xi8>>) -> !fir.ref<!fir.array<?xi8>>
+  %3 = fir.coordinate_of %2, %c0 : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+  %4 = fir.convert %3 : (!fir.ref<i8>) -> !fir.ref<f32>
+  %5 = fir.declare %4 storage (%1[0]) {uniq_name = "a"} : (!fir.ref<f32>, !fir.ref<!fir.array<8xi8>>) -> !fir.ref<f32>
+  %6 = fir.coordinate_of %2, %c4 : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+  %7 = fir.convert %6 : (!fir.ref<i8>) -> !fir.ref<f32>
+  %8 = fir.declare %7 storage (%1[4]) {uniq_name = "b"} : (!fir.ref<f32>, !fir.ref<!fir.array<8xi8>>) -> !fir.ref<f32>
+  return
+}

flang/test/Fir/invalid.fir

@@ -1426,3 +1426,60 @@ func.func @wrong_weights_number_in_if_then_else(%cond: i1) {
   }
   return
 }
+
+// -----
+
+func.func @fir_declare_bad_storage_offset(%arg0: !fir.ref<!fir.array<8xi8>>) {
+  %c0 = arith.constant 0 : index
+  %addr = fir.address_of(@block_) : !fir.ref<!fir.array<8xi8>>
+  %2 = fir.convert %addr : (!fir.ref<!fir.array<8xi8>>) -> !fir.ref<!fir.array<?xi8>>
+  %var = fir.coordinate_of %2, %c0 : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+  // expected-error@+1 {{negative integer literal not valid for unsigned integer type}}
+  %decl = fir.declare %var storage (%addr[-1]) {uniq_name = "a"} : (!fir.ref<i8>, !fir.ref<!fir.array<8xi8>>) -> !fir.ref<i8>
+  return
+}
+
+// -----
+
+"func.func"() <{function_type = (!fir.ref<!fir.array<8xi8>>) -> (), sym_name = "fir_declare_bad_storage_offset"}> ({
+^bb0(%arg0: !fir.ref<!fir.array<8xi8>>):
+  %0 = "arith.constant"() <{value = 0 : index}> : () -> index
+  %1 = "fir.address_of"() <{symbol = @block_}> : () -> !fir.ref<!fir.array<8xi8>>
+  %2 = "fir.convert"(%1) : (!fir.ref<!fir.array<8xi8>>) -> !fir.ref<!fir.array<?xi8>>
+  %3 = "fir.coordinate_of"(%2, %0) <{baseType = !fir.ref<!fir.array<?xi8>>}> : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+// expected-error@+1 {{storage offset specified without the storage reference}}
+  %4 = "fir.declare"(%3) <{operandSegmentSizes = array<i32: 1, 0, 0, 0, 0>, storage_offset = 1 : ui64, uniq_name = "a"}> : (!fir.ref<i8>) -> !fir.ref<i8>
+  "func.return"() : () -> ()
+}) : () -> ()
+
+// -----
+
+func.func @fir_declare_bad_storage(%arg0: !fir.ref<i8>) {
+  // expected-error@+1 {{storage must be a vector}}
+  %decl = fir.declare %arg0 storage (%arg0[0]) {uniq_name = "a"} : (!fir.ref<i8>, !fir.ref<i8>) -> !fir.ref<i8>
+  return
+}
+
+// -----
+
+func.func @fir_declare_bad_storage(%arg0: !fir.ref<i8>, %arg1: !fir.ref<!fir.array<?xi8>>) {
+  // expected-error@+1 {{storage must have known extent}}
+  %decl = fir.declare %arg0 storage (%arg1[0]) {uniq_name = "a"} : (!fir.ref<i8>, !fir.ref<!fir.array<?xi8>>) -> !fir.ref<i8>
+  return
+}
+
+// -----
+
+func.func @fir_declare_bad_storage(%arg0: !fir.ref<i8>, %arg1: !fir.ref<!fir.array<1xi32>>) {
+  // expected-error@+1 {{storage must be an array of i8 elements}}
+  %decl = fir.declare %arg0 storage (%arg1[0]) {uniq_name = "a"} : (!fir.ref<i8>, !fir.ref<!fir.array<1xi32>>) -> !fir.ref<i8>
+  return
+}
+
+// -----
+
+func.func @fir_declare_bad_storage_offset(%arg0: !fir.ref<i8>, %arg1: !fir.ref<!fir.array<1xi8>>) {
+  // expected-error@+1 {{storage offset exceeds the storage size}}
+  %decl = fir.declare %arg0 storage (%arg1[2]) {uniq_name = "a"} : (!fir.ref<i8>, !fir.ref<!fir.array<1xi8>>) -> !fir.ref<i8>
+  return
+}

flang/test/HLFIR/declare-codegen.fir

@@ -237,3 +237,30 @@ func.func @rebox_scalar_attrs(%arg0: !fir.class<!fir.ptr<!fir.type<sometype{i:i3
 // CHECK-LABEL: @rebox_scalar_attrs
 // CHECK: fir.rebox %{{.*}} : (!fir.class<!fir.ptr<!fir.type<sometype{i:i32}>>>) -> !fir.class<!fir.type<sometype{i:i32}>>
 // CHECK: return
+
+func.func @vars_within_physical_storage() {
+  %c4 = arith.constant 4 : index
+  %c0 = arith.constant 0 : index
+  %1 = fir.address_of(@block_) : !fir.ref<!fir.array<8xi8>>
+  %2 = fir.convert %1 : (!fir.ref<!fir.array<8xi8>>) -> !fir.ref<!fir.array<?xi8>>
+  %3 = fir.coordinate_of %2, %c0 : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+  %4 = fir.convert %3 : (!fir.ref<i8>) -> !fir.ref<f32>
+  %5:2 = hlfir.declare %4 storage (%1[0]) {uniq_name = "a"} : (!fir.ref<f32>, !fir.ref<!fir.array<8xi8>>) -> (!fir.ref<f32>, !fir.ref<f32>)
+  %6 = fir.coordinate_of %2, %c4 : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+  %7 = fir.convert %6 : (!fir.ref<i8>) -> !fir.ref<f32>
+  %8:2 = hlfir.declare %7 storage (%1[4]) {uniq_name = "b"} : (!fir.ref<f32>, !fir.ref<!fir.array<8xi8>>) -> (!fir.ref<f32>, !fir.ref<f32>)
+  return
+}
+// CHECK-LABEL:   func.func @vars_within_physical_storage() {
+// CHECK:           %[[VAL_0:.*]] = arith.constant 4 : index
+// CHECK:           %[[VAL_1:.*]] = arith.constant 0 : index
+// CHECK:           %[[VAL_2:.*]] = fir.address_of(@block_) : !fir.ref<!fir.array<8xi8>>
+// CHECK:           %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.array<8xi8>>) -> !fir.ref<!fir.array<?xi8>>
+// CHECK:           %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_1]] : (!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.declare %[[VAL_5]] storage(%[[VAL_2]][0]) {uniq_name = "a"} : (!fir.ref<f32>, !fir.ref<!fir.array<8xi8>>) -> !fir.ref<f32>
+// CHECK:           %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_0]] : (!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.declare %[[VAL_8]] storage(%[[VAL_2]][4]) {uniq_name = "b"} : (!fir.ref<f32>, !fir.ref<!fir.array<8xi8>>) -> !fir.ref<f32>
+// CHECK:           return
+// CHECK:         }