[flang][AIX] BIND(C) derived type alignment for AIX

flang/include/flang/Optimizer/CodeGen/TypeConverter.h

@@ -62,7 +62,7 @@ class LLVMTypeConverter : public mlir::LLVMTypeConverter {
   // fir.type<name(p : TY'...){f : TY...}>  -->  llvm<"%name = { ty... }">
   std::optional<llvm::LogicalResult>
   convertRecordType(fir::RecordType derived,
-                    llvm::SmallVectorImpl<mlir::Type> &results);
+                    llvm::SmallVectorImpl<mlir::Type> &results, bool isPacked);
 
   // Is an extended descriptor needed given the element type of a fir.box type ?
   // Extended descriptors are required for derived types.

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

@@ -346,6 +346,9 @@ def fir_RecordType : FIR_Type<"Record", "type"> {
     void finalize(llvm::ArrayRef<TypePair> lenPList,
                   llvm::ArrayRef<TypePair> typeList);
 
+    bool isPacked() const;
+    void pack(bool);
+
     detail::RecordTypeStorage const *uniqueKey() const;
   }];
 }

flang/lib/Lower/ConvertType.cpp

@@ -20,6 +20,8 @@
 #include "mlir/IR/Builders.h"
 #include "mlir/IR/BuiltinTypes.h"
 #include "llvm/Support/Debug.h"
+#include "llvm/TargetParser/Host.h"
+#include "llvm/TargetParser/Triple.h"
 
 #define DEBUG_TYPE "flang-lower-type"
 
@@ -385,9 +387,19 @@ struct TypeBuilderImpl {
     // with dozens of components/parents (modern Fortran).
     derivedTypeInConstruction.try_emplace(&derivedScope, rec);
 
+    auto targetTriple{llvm::Triple(
+        llvm::Triple::normalize(llvm::sys::getDefaultTargetTriple()))};
+    // Always generate packed FIR struct type for bind(c) derived type for AIX
+    if (targetTriple.getOS() == llvm::Triple::OSType::AIX &&
+        tySpec.typeSymbol().attrs().test(Fortran::semantics::Attr::BIND_C) &&
+        !IsIsoCType(&tySpec)) {
+      rec.pack(true);
+    }
+
     // Gather the record type fields.
     // (1) The data components.
     if (converter.getLoweringOptions().getLowerToHighLevelFIR()) {
+      size_t prev_offset{0};
       // In HLFIR the parent component is the first fir.type component.
       for (const auto &componentName :
            typeSymbol.get<Fortran::semantics::DerivedTypeDetails>()
@@ -397,7 +409,37 @@ struct TypeBuilderImpl {
                "failed to find derived type component symbol");
         const Fortran::semantics::Symbol &component = scopeIter->second.get();
         mlir::Type ty = genSymbolType(component);
+        if (rec.isPacked()) {
+          auto compSize{component.size()};
+          auto compOffset{component.offset()};
+
+          if (prev_offset < compOffset) {
+            size_t pad{compOffset - prev_offset};
+            mlir::Type i8Ty{mlir::IntegerType::get(context, 8)};
+            fir::SequenceType::Shape shape{static_cast<int64_t>(pad)};
+            mlir::Type padTy{fir::SequenceType::get(shape, i8Ty)};
+            prev_offset += pad;
+            cs.emplace_back("", padTy);
+          }
+          prev_offset += compSize;
+        }
         cs.emplace_back(converter.getRecordTypeFieldName(component), ty);
+        if (rec.isPacked()) {
+          // For the last component, determine if any padding is needed.
+          if (componentName ==
+              typeSymbol.get<Fortran::semantics::DerivedTypeDetails>()
+                  .componentNames()
+                  .back()) {
+            auto compEnd{component.offset() + component.size()};
+            if (compEnd < derivedScope.size()) {
+              size_t pad{derivedScope.size() - compEnd};
+              mlir::Type i8Ty{mlir::IntegerType::get(context, 8)};
+              fir::SequenceType::Shape shape{static_cast<int64_t>(pad)};
+              mlir::Type padTy{fir::SequenceType::get(shape, i8Ty)};
+              cs.emplace_back("", padTy);
+            }
+          }
+        }
       }
     } else {
       for (const auto &component :

flang/lib/Optimizer/CodeGen/TypeConverter.cpp

@@ -82,7 +82,7 @@ LLVMTypeConverter::LLVMTypeConverter(mlir::ModuleOp module, bool applyTBAA,
       [&](fir::PointerType pointer) { return convertPointerLike(pointer); });
   addConversion(
       [&](fir::RecordType derived, llvm::SmallVectorImpl<mlir::Type> &results) {
-        return convertRecordType(derived, results);
+        return convertRecordType(derived, results, derived.isPacked());
       });
   addConversion(
       [&](fir::ReferenceType ref) { return convertPointerLike(ref); });
@@ -133,8 +133,10 @@ mlir::Type LLVMTypeConverter::indexType() const {
 }
 
 // fir.type<name(p : TY'...){f : TY...}>  -->  llvm<"%name = { ty... }">
-std::optional<llvm::LogicalResult> LLVMTypeConverter::convertRecordType(
-    fir::RecordType derived, llvm::SmallVectorImpl<mlir::Type> &results) {
+std::optional<llvm::LogicalResult>
+LLVMTypeConverter::convertRecordType(fir::RecordType derived,
+                                     llvm::SmallVectorImpl<mlir::Type> &results,
+                                     bool isPacked) {
   auto name = fir::NameUniquer::dropTypeConversionMarkers(derived.getName());
   auto st = mlir::LLVM::LLVMStructType::getIdentified(&getContext(), name);
 
@@ -156,7 +158,7 @@ std::optional<llvm::LogicalResult> LLVMTypeConverter::convertRecordType(
     else
       members.push_back(mlir::cast<mlir::Type>(convertType(mem.second)));
   }
-  if (mlir::failed(st.setBody(members, /*isPacked=*/false)))
+  if (mlir::failed(st.setBody(members, isPacked)))
     return mlir::failure();
   results.push_back(st);
   return mlir::success();

flang/lib/Optimizer/Dialect/FIRType.cpp

@@ -165,16 +165,20 @@ struct RecordTypeStorage : public mlir::TypeStorage {
     setTypeList(typeList);
   }
 
+  bool isPacked() const { return packed; }
+  void pack(bool p) { packed = p; }
+
 protected:
   std::string name;
   bool finalized;
+  bool packed;
   std::vector<RecordType::TypePair> lens;
   std::vector<RecordType::TypePair> types;
 
 private:
   RecordTypeStorage() = delete;
   explicit RecordTypeStorage(llvm::StringRef name)
-      : name{name}, finalized{false} {}
+      : name{name}, finalized{false}, packed{false} {}
 };
 
 } // namespace detail
@@ -973,6 +977,10 @@ RecordType::TypeList fir::RecordType::getLenParamList() const {
 
 bool fir::RecordType::isFinalized() const { return getImpl()->isFinalized(); }
 
+void fir::RecordType::pack(bool p) { getImpl()->pack(p); }
+
+bool fir::RecordType::isPacked() const { return getImpl()->isPacked(); }
+
 detail::RecordTypeStorage const *fir::RecordType::uniqueKey() const {
   return getImpl();
 }

flang/lib/Semantics/compute-offsets.cpp

@@ -17,6 +17,8 @@
 #include "flang/Semantics/symbol.h"
 #include "flang/Semantics/tools.h"
 #include "flang/Semantics/type.h"
+#include "llvm/TargetParser/Host.h"
+#include "llvm/TargetParser/Triple.h"
 #include <algorithm>
 #include <vector>
 
@@ -51,9 +53,12 @@ class ComputeOffsetsHelper {
   SymbolAndOffset Resolve(const SymbolAndOffset &);
   std::size_t ComputeOffset(const EquivalenceObject &);
   // Returns amount of padding that was needed for alignment
-  std::size_t DoSymbol(Symbol &);
+  std::size_t DoSymbol(
+      Symbol &, std::optional<const size_t> newAlign = std::nullopt);
   SizeAndAlignment GetSizeAndAlignment(const Symbol &, bool entire);
   std::size_t Align(std::size_t, std::size_t);
+  std::optional<size_t> CompAlignment(const Symbol &);
+  std::optional<size_t> HasSpecialAlign(const Symbol &, Scope &);
 
   SemanticsContext &context_;
   std::size_t offset_{0};
@@ -65,6 +70,60 @@ class ComputeOffsetsHelper {
       equivalenceBlock_;
 };
 
+static bool isReal8OrLarger(const Fortran::semantics::DeclTypeSpec *type) {
+  return ((type->IsNumeric(common::TypeCategory::Real) ||
+              type->IsNumeric(common::TypeCategory::Complex)) &&
+      evaluate::ToInt64(type->numericTypeSpec().kind()) > 4);
+}
+
+std::optional<size_t> ComputeOffsetsHelper::CompAlignment(const Symbol &sym) {
+  size_t max_align{0};
+  bool contain_double{false};
+  const auto derivedTypeSpec{sym.GetType()->AsDerived()};
+  DirectComponentIterator directs{*derivedTypeSpec};
+  for (auto it = directs.begin(); it != directs.end(); ++it) {
+    auto type{it->GetType()};
+    auto s{GetSizeAndAlignment(*it, true)};
+    if (isReal8OrLarger(type)) {
+      max_align = std::max(max_align, 4UL);
+      contain_double = true;
+    } else if (type->AsDerived()) {
+      if (const auto newAlgin = CompAlignment(*it)) {
+        max_align = std::max(max_align, s.alignment);
+      } else {
+        return std::nullopt;
+      }
+    } else {
+      max_align = std::max(max_align, s.alignment);
+    }
+  }
+
+  if (contain_double)
+    return max_align;
+  else
+    return std::nullopt;
+}
+
+std::optional<size_t> ComputeOffsetsHelper::HasSpecialAlign(const Symbol &sym,
+                                                            Scope &scope) {
+  // On AIX, if the component that is not the first component and is
+  // a float of 8 bytes or larger, it has the 4-byte alignment.
+  // Only set the special alignment for bind(c) derived type on that platform.
+  if (const auto type = sym.GetType()) {
+    auto &symOwner{sym.owner()};
+    if (symOwner.symbol() && symOwner.IsDerivedType() &&
+        symOwner.symbol()->attrs().HasAny({semantics::Attr::BIND_C}) &&
+        &sym != &(*scope.GetSymbols().front())) {
+      if (isReal8OrLarger(type)) {
+        return 4UL;
+      } else if (type->AsDerived()) {
+        return CompAlignment(sym);
+      }
+    }
+  }
+  return std::nullopt;
+}
+
 void ComputeOffsetsHelper::Compute(Scope &scope) {
   for (Scope &child : scope.children()) {
     ComputeOffsets(context_, child);
@@ -113,7 +172,15 @@ void ComputeOffsetsHelper::Compute(Scope &scope) {
     if (!FindCommonBlockContaining(*symbol) &&
         dependents_.find(symbol) == dependents_.end() &&
         equivalenceBlock_.find(symbol) == equivalenceBlock_.end()) {
-      DoSymbol(*symbol);
+
+      std::optional<size_t> newAlign{std::nullopt};
+      // Handle special alignment requirement for AIX
+      auto triple{llvm::Triple(
+          llvm::Triple::normalize(llvm::sys::getDefaultTargetTriple()))};
+      if (triple.getOS() == llvm::Triple::OSType::AIX) {
+        newAlign = HasSpecialAlign(*symbol, scope);
+      }
+      DoSymbol(*symbol, newAlign);
       if (auto *generic{symbol->detailsIf<GenericDetails>()}) {
         if (Symbol * specific{generic->specific()};
             specific && !FindCommonBlockContaining(*specific)) {
@@ -313,7 +380,8 @@ std::size_t ComputeOffsetsHelper::ComputeOffset(
   return result;
 }
 
-std::size_t ComputeOffsetsHelper::DoSymbol(Symbol &symbol) {
+std::size_t ComputeOffsetsHelper::DoSymbol(
+    Symbol &symbol, std::optional<const size_t> newAlign) {
   if (!symbol.has<ObjectEntityDetails>() && !symbol.has<ProcEntityDetails>()) {
     return 0;
   }
@@ -322,12 +390,16 @@ std::size_t ComputeOffsetsHelper::DoSymbol(Symbol &symbol) {
     return 0;
   }
   std::size_t previousOffset{offset_};
-  offset_ = Align(offset_, s.alignment);
+  size_t alignVal{s.alignment};
+  if (newAlign) {
+    alignVal = newAlign.value();
+  }
+  offset_ = Align(offset_, alignVal);
   std::size_t padding{offset_ - previousOffset};
   symbol.set_size(s.size);
   symbol.set_offset(offset_);
   offset_ += s.size;
-  alignment_ = std::max(alignment_, s.alignment);
+  alignment_ = std::max(alignment_, alignVal);
   return padding;
 }
 

flang/test/Lower/derived-types-bindc.f90

@@ -0,0 +1,44 @@
+! Test padding for BIND(C) derived types lowering for AIX target
+! RUN: %flang_fc1 -emit-llvm %s -o - | FileCheck %s
+
+! REQUIRES: target={{.+}}-aix{{.*}}
+
+subroutine s1()
+  use, intrinsic :: iso_c_binding
+  type, bind(c) :: t0
+    character(c_char) :: x1
+    real(c_double) :: x2
+  end type
+  type(t0) :: xt0
+! CHECK-DAG: %_QFs1Tt0 = type <{ [1 x i8], [3 x i8], double }>
+
+  type, bind(c) :: t1
+    integer(c_short) :: x1
+    real(c_double) :: x2
+  end type
+  type(t1) :: xt1
+! CHECK-DAG: %_QFs1Tt1 = type <{ i16, [2 x i8], double }>
+
+  type, bind(c) :: t2
+    integer(c_short) :: x1
+    real(c_double) :: x2
+    character(c_char) :: x3
+  end type
+  type(t2) :: xt2
+! CHECK-DAG: %_QFs1Tt2 = type <{ i16, [2 x i8], double, [1 x i8], [3 x i8] }>
+
+  type, bind(c) :: t3
+    character(c_char) :: x1
+    complex(c_double_complex) :: x2
+  end type
+  type(t3) :: xt3
+! CHECK-DAG: %_QFs1Tt3 = type <{ [1 x i8], [3 x i8], { double, double } }>
+
+  type, bind(c) :: t4
+    integer(c_short) :: x1
+    complex(c_double_complex) :: x2
+    character(c_char) :: x3
+  end type
+  type(t4) :: xt4
+! CHECK-DAG: %_QFs1Tt4 = type <{ i16, [2 x i8], { double, double }, [1 x i8], [3 x i8] }>
+end subroutine s1