diff --git a/flang/docs/ProcedurePointer.md b/flang/docs/ProcedurePointer.md --- a/flang/docs/ProcedurePointer.md +++ b/flang/docs/ProcedurePointer.md @@ -113,13 +113,13 @@ **FIR for case 1** ``` -func.func private @foo1(!fir.boxproc<(!fir.ref) -> !fir.ref>) -func.func private @foo2(!fir.ref) -> !fir.ref>>) +func.func private @foo1(!fir.boxproc<(!fir.ref) -> f32>) +func.func private @foo2(!fir.ref) -> f32>>) -func.func @proc_pointer_dummy_argument(%0 : !fir.ref) -> !fir.ref>>) { - %1 = fir.load %0 : !fir.ref) -> !fir.ref>> - fir.call @foo1(%1) : ((!fir.ref) -> !fir.ref) -> () - fir.call @foo2(%0) : (!fir.ref) -> !fir.ref>>) -> () +func.func @proc_pointer_dummy_argument(%0 : !fir.ref) -> f32>>) { + %1 = fir.load %0 : !fir.ref) -> f32>> + fir.call @foo1(%1) : (!fir.boxproc<(!fir.ref) -> f32>) -> () + fir.call @foo2(%0) : (!fir.ref) -> f32>>) -> () return } ``` @@ -149,20 +149,20 @@ **FIR for case 2** ``` -func.func private @foo1(!fir.boxproc<(!fir.ref) -> !fir.ref>) -func.func private @foo2(!fir.ref) -> !fir.ref>>) +func.func private @foo1(!fir.boxproc<(!fir.ref) -> f32>) +func.func private @foo2(!fir.ref) -> f32>>) -fir.global internal @ProcedurePointer : !fir.boxproc<(!fir.ref) -> !fir.ref> { - %0 = fir.zero_bits (!fir.ref) -> !fir.ref - %1 = fir.emboxproc %0 : ((!fir.ref) -> !fir.ref) -> !fir.boxproc<(!fir.ref) -> !fir.ref> - fir.has_value %1 : !fir.boxproc<(!fir.ref) -> !fir.ref> +fir.global internal @ProcedurePointer : !fir.boxproc<(!fir.ref) -> f32> { + %0 = fir.zero_bits (!fir.ref) -> f32 + %1 = fir.emboxproc %0 : ((!fir.ref) -> f32) -> !fir.boxproc<(!fir.ref) -> f32> + fir.has_value %1 : !fir.boxproc<(!fir.ref) -> f32> } func.func @proc_pointer_global() { - %0 = fir.address_of(@ProcedurePointer) : !fir.ref) -> !fir.ref>> - %1 = fir.load %0 : !fir.ref) -> !fir.ref>> - fir.call @foo1(%1) : (!fir.boxproc<(!fir.ref) -> !fir.ref>) -> () - fir.call @foo2(%0) : (!fir.ref) -> !fir.ref>>) -> () + %0 = fir.address_of(@ProcedurePointer) : !fir.ref) -> f32>> + %1 = fir.load %0 : !fir.ref) -> f32>> + fir.call @foo1(%1) : (!fir.boxproc<(!fir.ref) -> f32>) -> () + fir.call @foo2(%0) : (!fir.ref) -> f32>>) -> () return } ``` @@ -192,18 +192,17 @@ **FIR for case 3** ``` -func.func private @foo1(!fir.boxproc<(!fir.ref) -> !fir.ref>) -func.func private @foo2(!fir.ref) -> !fir.ref>>) +func.func private @foo1(!fir.boxproc<(!fir.ref) -> f32>) +func.func private @foo2(!fir.ref) -> f32>>) func.func @proc_pointer_local() { - %0 = fir.alloca !fir.boxproc<(!fir.ref) -> !fir.ref> - %1 = fir.load %0 : !fir.ref) -> !fir.ref>> - %2 = fir.box_addr %1 : (!fir.boxproc<(!fir.ref) -> !fir.ref>) -> ((!fir.ref) -> !fir.ref) - %3 = fir.zero_bits (!fir.ref) -> !fir.ref - fir.store %3 to %2 : !fir.ref<(!fir.ref) -> !fir.ref> - %4 = fir.load %0 : !fir.ref) -> !fir.ref>> - fir.call @foo1(%4) : (!fir.boxproc<(!fir.ref) -> !fir.ref>) -> () - fir.call @foo2(%0) : (!fir.ref) -> !fir.ref>>) -> () + %0 = fir.alloca !fir.boxproc<(!fir.ref) -> f32> + %1 = fir.zero_bits (!fir.ref) -> f32 + %2 = fir.emboxproc %1 : ((!fir.ref) -> f32) -> !fir.boxproc<(!fir.ref) -> f32> + fir.store %2 to %0 : !fir.ref) -> f32>> + %4 = fir.load %0 : !fir.ref) -> f32>> + fir.call @foo1(%4) : (!fir.boxproc<(!fir.ref) -> f32>) -> () + fir.call @foo2(%0) : (!fir.ref) -> f32>>) -> () return } ``` @@ -344,32 +343,35 @@ **FIR** ``` -func.func @Procedure(%arg0 : !fir.ref) -> !fir.ref { +func.func @Procedure(%arg0 : !fir.ref) -> f32 { + %0 = fir.alloca f32 {bindc_name = "res", uniq_name = "_QFfuncEres"} %1 = fir.load %arg0 : !fir.ref %2 = fir.convert %1 : (i32) -> f32 - return %2 : f32 + fir.store %2 to %0 : !fir.ref + %3 = fir.load %0 : !fir.ref + return %3 : f32 } -func.func @Reference2Function() -> !fir.boxproc<(!fir.ref) -> !fir.ref> { - %0 = fir.alloca !fir.boxproc<(!fir.ref) -> !fir.ref> - %1 = fir.load %0 : !fir.ref) -> !fir.ref>> - return %1 : !fir.boxproc<(!fir.ref) -> !fir.ref> +func.func @Reference2Function() -> !fir.boxproc<(!fir.ref) -> f32> { + %0 = fir.alloca !fir.boxproc<(!fir.ref) -> f32> + %1 = fir.load %0 : !fir.ref) -> f32>> + return %1 : !fir.boxproc<(!fir.ref) -> f32> } -func.func @proc_pointer_assignment(%arg0 : !fir.ref) -> !fir.ref>>, %arg1 : !fir.ref) -> !fir.ref>>) { - %0 = fir.alloca !fir.boxproc<(!fir.ref) -> !fir.ref> {bindc_name = ".result"} +func.func @proc_pointer_assignment(%arg0 : !fir.ref) -> f32>>, %arg1 : !fir.ref) -> f32>>) { + %0 = fir.alloca !fir.boxproc<(!fir.ref) -> f32> {bindc_name = ".result"} // case 1: assignment from external procedure - %1 = fir.address_of(@Procedure) : (!fir.ref) -> !fir.ref - %2 = fir.emboxproc %1 : ((!fir.ref) -> !fir.ref) -> !fir.boxproc<(!fir.ref) -> !fir.ref> - fir.store %2 to %arg0 : !fir.ref) -> !fir.ref>> + %1 = fir.address_of(@Procedure) : (!fir.ref) -> f32 + %2 = fir.emboxproc %1 : ((!fir.ref) -> f32) -> !fir.boxproc<(!fir.ref) -> f32> + fir.store %2 to %arg0 : !fir.ref) -> f32>> // case2: assignment from procdure pointer - %3 = fir.load %arg1 : !fir.ref) -> !fir.ref>> - fir.store %3 to %arg0 : !fir.ref) -> !fir.ref>> + %3 = fir.load %arg1 : !fir.ref) -> f32>> + fir.store %3 to %arg0 : !fir.ref) -> f32>> // case3: assignment from a reference to a function whose result is a procedure pointer - %4 = fir.call @Reference2Function() : () -> !fir.boxproc<(!fir.ref) -> !fir.ref> - fir.store %4 to %0 : !fir.ref) -> !fir.ref>> - %5 = fir.load %0 : !fir.ref) -> !fir.ref>> - fir.store %5 to %arg0 : !fir.ref) -> !fir.ref>> + %4 = fir.call @Reference2Function() : () -> !fir.boxproc<(!fir.ref) -> f32> + fir.store %4 to %0 : !fir.ref) -> f32>> + %5 = fir.load %0 : !fir.ref) -> f32>> + fir.store %5 to %arg0 : !fir.ref) -> f32>> return } ``` @@ -402,19 +404,18 @@ **FIR** ``` -func.func @proc_pointer_component(%arg0 : (!fir.ref) -> !fir.ref, %arg1: !fir.ref) { +func.func @proc_pointer_component(%arg0 : !fir.boxproc<(!fir.ref) -> f32>, %arg1: !fir.ref) { %0 = fir.alloca !fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}> %1 = fir.field_index solve, !fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}> %2 = fir.coordinate_of %0, %1 : (!fir.ref,solve:!fir.boxproc<() -> ()>}>>, !fir.field) -> !fir.ref ()>> - %3 = fir.emboxproc %arg0 : ((!fir.ref) -> !fir.ref) -> !fir.boxproc<(!fir.ref) -> !fir.ref> - %4 = fir.convert %3 : (!fir.boxproc<(!fir.ref) -> !fir.ref>) -> !fir.boxproc<() -> ()> - fir.store %4 to %2 : !fir.ref ()>> + %3 = fir.convert %arg0 : (!fir.boxproc<(!fir.ref) -> f32>) -> !fir.boxproc<() -> ()> + fir.store %3 to %2 : !fir.ref ()>> %4 = fir.field_index solve, !fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}> %5 = fir.coordinate_of %0, %4 : (!fir.ref,solve:!fir.boxproc<() -> ()>}>>, !fir.field) -> !fir.ref ()>> %6 = fir.load %5 : !fir.ref ()>> - %7 = fir.convert %6 : (!fir.boxproc<() -> ()>) -> !fir.boxproc<(!fir.ref) -> !fir.ref> - %8 = fir.box_addr %7 : (!fir.boxproc<(!fir.ref) -> !fir.ref>) -> ((!fir.ref) -> !fir.ref) - %9 = fir.call %8(%arg1) : (!fir.ref) -> !fir.ref + %7 = fir.convert %6 : (!fir.boxproc<() -> ()>) -> !fir.boxproc<(!fir.ref) -> f32> + %8 = fir.box_addr %7 : (!fir.boxproc<(!fir.ref) -> f32>) -> ((!fir.ref) -> f32) + %9 = fir.call %8(%arg1) : (!fir.ref) -> f32 return } ``` @@ -469,12 +470,11 @@ NOTE: There are any number of possible implementations. -- `flang/lib/Optimizer/CodeGen/TypeConverter.h:64` TODO: BoxProcType type conversion -- `flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp:136` not yet implemented: record type with a boxproc type - fir.global for procedure pointers or +- `flang/lib/Optimizer/CodeGen/TypeConverter.h:64` TODO: BoxProcType type conversion - `flang/lib/Optimizer/CodeGen/CodeGen.cpp:2080` not yet implemented: fir.emboxproc codegen - `flang/lib/Optimizer/CodeGen/CodeGen.cpp:629` not yet implemented: fir.boxproc_host codegen - `flang/lib/Optimizer/CodeGen/CodeGen.cpp:1078` not yet implemented: fir.len_param_index codegen diff --git a/flang/include/flang/Optimizer/Dialect/FIRTypes.td b/flang/include/flang/Optimizer/Dialect/FIRTypes.td --- a/flang/include/flang/Optimizer/Dialect/FIRTypes.td +++ b/flang/include/flang/Optimizer/Dialect/FIRTypes.td @@ -356,6 +356,7 @@ unsigned getNumLenParams() { return getLenParamList().size(); } bool isDependentType() { return getNumLenParams(); } + bool isFinalized() const; void finalize(llvm::ArrayRef lenPList, llvm::ArrayRef typeList); diff --git a/flang/include/flang/Optimizer/Support/InternalNames.h b/flang/include/flang/Optimizer/Support/InternalNames.h --- a/flang/include/flang/Optimizer/Support/InternalNames.h +++ b/flang/include/flang/Optimizer/Support/InternalNames.h @@ -16,6 +16,7 @@ static constexpr llvm::StringRef typeDescriptorSeparator = ".dt."; static constexpr llvm::StringRef bindingTableSeparator = ".v."; +static constexpr llvm::StringRef boxprocSuffix = "UnboxProc"; namespace fir { diff --git a/flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp b/flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp --- a/flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp +++ b/flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp @@ -15,6 +15,7 @@ #include "flang/Optimizer/Dialect/FIRType.h" #include "flang/Optimizer/Support/FIRContext.h" #include "flang/Optimizer/Support/FatalError.h" +#include "flang/Optimizer/Support/InternalNames.h" #include "mlir/IR/PatternMatch.h" #include "mlir/Pass/Pass.h" #include "mlir/Transforms/DialectConversion.h" @@ -125,19 +126,20 @@ addConversion([&](RecordType ty) -> mlir::Type { if (!needsConversion(ty)) return ty; - // FIR record types can have recursive references, so conversion is a bit - // more complex than the other types. This conversion is not needed - // presently, so just emit a TODO message. Need to consider the uniqued - // name of the record, etc. Also, fir::RecordType::get returns the - // existing type being translated. So finalize() will not change it, and - // the translation would not do anything. So the type needs to be mutated, - // and this might require special care to comply with MLIR infrastructure. - - // TODO: this will be needed to support derived type containing procedure - // pointer components. - fir::emitFatalError( - loc, "not yet implemented: record type with a boxproc type"); - return RecordType::get(ty.getContext(), "*fixme*"); + auto rec = RecordType::get(ty.getContext(), + ty.getName().str() + boxprocSuffix.str()); + if (rec.isFinalized()) + return rec; + std::vector ps = ty.getLenParamList(); + std::vector cs; + for (auto t : ty.getTypeList()) { + if (needsConversion(t.second)) + cs.emplace_back(t.first, convertType(t.second)); + else + cs.emplace_back(t.first, t.second); + } + rec.finalize(ps, cs); + return rec; }); addArgumentMaterialization(materializeProcedure); addSourceMaterialization(materializeProcedure); @@ -322,8 +324,6 @@ } }); } - // TODO: any alternative implementation. Note: currently, the default code - // gen will not be able to handle boxproc and will give an error. } private: diff --git a/flang/lib/Optimizer/Dialect/FIRType.cpp b/flang/lib/Optimizer/Dialect/FIRType.cpp --- a/flang/lib/Optimizer/Dialect/FIRType.cpp +++ b/flang/lib/Optimizer/Dialect/FIRType.cpp @@ -63,11 +63,10 @@ } bool verifyRecordMemberType(mlir::Type ty) { - return !(ty.isa() || ty.isa() || - ty.isa() || ty.isa() || - ty.isa() || ty.isa() || ty.isa() || - ty.isa() || ty.isa() || - ty.isa()); + return !(ty.isa() || ty.isa() || + ty.isa() || ty.isa() || + ty.isa() || ty.isa() || ty.isa() || + ty.isa() || ty.isa()); } bool verifySameLists(llvm::ArrayRef a1, @@ -155,6 +154,7 @@ void setTypeList(llvm::ArrayRef list) { types = list; } llvm::ArrayRef getTypeList() const { return types; } + bool isFinalized() const { return finalized; } void finalize(llvm::ArrayRef lenParamList, llvm::ArrayRef typeList) { if (finalized) @@ -730,6 +730,8 @@ return getImpl()->getLenParamList(); } +bool fir::RecordType::isFinalized() const { return getImpl()->isFinalized(); } + detail::RecordTypeStorage const *fir::RecordType::uniqueKey() const { return getImpl(); } diff --git a/flang/lib/Optimizer/Support/InternalNames.cpp b/flang/lib/Optimizer/Support/InternalNames.cpp --- a/flang/lib/Optimizer/Support/InternalNames.cpp +++ b/flang/lib/Optimizer/Support/InternalNames.cpp @@ -337,6 +337,8 @@ static std::string getDerivedTypeObjectName(llvm::StringRef mangledTypeName, const llvm::StringRef separator) { + if (mangledTypeName.ends_with(boxprocSuffix)) + mangledTypeName = mangledTypeName.drop_back(boxprocSuffix.size()); auto result = fir::NameUniquer::deconstruct(mangledTypeName); if (result.first != fir::NameUniquer::NameKind::DERIVED_TYPE) return ""; diff --git a/flang/test/Fir/boxproc-2.fir b/flang/test/Fir/boxproc-2.fir --- a/flang/test/Fir/boxproc-2.fir +++ b/flang/test/Fir/boxproc-2.fir @@ -12,3 +12,35 @@ //CHECK-LABEL: func.func private @test5(((i32) -> f32) -> ()) func.func private @test5(!fir.boxproc<(!fir.boxproc<(i32) -> (f32)>) -> ()>) + +// CHECK-LABEL: func.func @proc_pointer_component( +// CHECK-SAME: %[[VAL_0:.*]]: (!fir.ref) -> f32, +// CHECK-SAME: %[[VAL_1:.*]]: !fir.ref) { + +func.func @proc_pointer_component(%arg0 : !fir.boxproc<(!fir.ref) -> f32>, %arg1: !fir.ref) { + %0 = fir.alloca !fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}> + %1 = fir.field_index solve, !fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}> + %2 = fir.coordinate_of %0, %1 : (!fir.ref,solve:!fir.boxproc<() -> ()>}>>, !fir.field) -> !fir.ref ()>> + %3 = fir.convert %arg0 : (!fir.boxproc<(!fir.ref) -> f32>) -> !fir.boxproc<() -> ()> + fir.store %3 to %2 : !fir.ref ()>> + %4 = fir.field_index solve, !fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}> + %5 = fir.coordinate_of %0, %4 : (!fir.ref,solve:!fir.boxproc<() -> ()>}>>, !fir.field) -> !fir.ref ()>> + %6 = fir.load %5 : !fir.ref ()>> + %7 = fir.convert %6 : (!fir.boxproc<() -> ()>) -> !fir.boxproc<(!fir.ref) -> f32> + %8 = fir.box_addr %7 : (!fir.boxproc<(!fir.ref) -> f32>) -> ((!fir.ref) -> f32) + %9 = fir.call %8(%arg1) : (!fir.ref) -> f32 + return + +// CHECK: %[[VAL_2:.*]] = fir.alloca !fir.type<_QFtestTmatrixUnboxProc{element:!fir.array<2x2xf32>,solve:() -> ()}> +// CHECK: %[[VAL_3:.*]] = fir.field_index solve, !fir.type<_QFtestTmatrixUnboxProc{element:!fir.array<2x2xf32>,solve:() -> ()}> +// CHECK: %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_3]] : (!fir.ref,solve:() -> ()}>>, !fir.field) -> !fir.ref<() -> ()> +// CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_0]] : ((!fir.ref) -> f32) -> (() -> ()) +// CHECK: fir.store %[[VAL_5]] to %[[VAL_4]] : !fir.ref<() -> ()> +// CHECK: %[[VAL_6:.*]] = fir.field_index solve, !fir.type<_QFtestTmatrixUnboxProc{element:!fir.array<2x2xf32>,solve:() -> ()}> +// CHECK: %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_6]] : (!fir.ref,solve:() -> ()}>>, !fir.field) -> !fir.ref<() -> ()> +// CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_7]] : !fir.ref<() -> ()> +// CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (() -> ()) -> ((!fir.ref) -> f32) +// CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : ((!fir.ref) -> f32) -> ((!fir.ref) -> f32) +// CHECK: %[[VAL_11:.*]] = fir.call %[[VAL_10]](%[[VAL_1]]) : (!fir.ref) -> f32 + +}