[flang-commits] [flang] e78e4a1 - [flang] lower F77 calls in HLFIR
Jean Perier via flang-commits
flang-commits at lists.llvm.org
Thu Dec 1 02:22:53 PST 2022
Author: Jean Perier
Date: 2022-12-01T11:22:38+01:00
New Revision: e78e4a176147a1a971f2093b3a927f51479074ab
URL: https://github.com/llvm/llvm-project/commit/e78e4a176147a1a971f2093b3a927f51479074ab
DIFF: https://github.com/llvm/llvm-project/commit/e78e4a176147a1a971f2093b3a927f51479074ab.diff
LOG: [flang] lower F77 calls in HLFIR
Use recently added hlfir.associate/hlfir.end_associate to deal
with the cases where the actual argument is an expression.
Differential Revision: https://reviews.llvm.org/D139009
Added:
flang/test/Lower/HLFIR/calls-f77.f90
Modified:
flang/include/flang/Lower/ConvertCall.h
flang/include/flang/Optimizer/Builder/HLFIRTools.h
flang/lib/Lower/Bridge.cpp
flang/lib/Lower/ConvertCall.cpp
flang/lib/Lower/ConvertExprToHLFIR.cpp
flang/lib/Optimizer/Builder/HLFIRTools.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Lower/ConvertCall.h b/flang/include/flang/Lower/ConvertCall.h
index 05da6250e7d83..c38e48685db4e 100644
--- a/flang/include/flang/Lower/ConvertCall.h
+++ b/flang/include/flang/Lower/ConvertCall.h
@@ -19,6 +19,7 @@
#include "flang/Lower/AbstractConverter.h"
#include "flang/Lower/CallInterface.h"
+#include "flang/Optimizer/Builder/HLFIRTools.h"
namespace Fortran::lower {
@@ -38,5 +39,13 @@ fir::ExtendedValue genCallOpAndResult(
mlir::Value argumentHostAssocs(Fortran::lower::AbstractConverter &converter,
mlir::Value arg);
+/// Lower a ProcedureRef to HLFIR. If this is a function call, return the
+/// lowered result value. Return nothing otherwise.
+llvm::Optional<hlfir::EntityWithAttributes> convertCallToHLFIR(
+ mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+ const evaluate::ProcedureRef &procRef,
+ llvm::Optional<mlir::Type> resultType, Fortran::lower::SymMap &symMap,
+ Fortran::lower::StatementContext &stmtCtx);
+
} // namespace Fortran::lower
#endif // FORTRAN_LOWER_CONVERTCALL_H
diff --git a/flang/include/flang/Optimizer/Builder/HLFIRTools.h b/flang/include/flang/Optimizer/Builder/HLFIRTools.h
index b2da7c51cff6d..8f64075f37053 100644
--- a/flang/include/flang/Optimizer/Builder/HLFIRTools.h
+++ b/flang/include/flang/Optimizer/Builder/HLFIRTools.h
@@ -23,6 +23,8 @@ class FirOpBuilder;
namespace hlfir {
+class AssociateOp;
+
/// Is this an SSA value type for the value of a Fortran expression?
inline bool isFortranValueType(mlir::Type type) {
return type.isa<hlfir::ExprType>() || fir::isa_trivial(type);
@@ -151,12 +153,40 @@ EntityWithAttributes genDeclare(mlir::Location loc, fir::FirOpBuilder &builder,
llvm::StringRef name,
fir::FortranVariableFlagsAttr flags);
+/// Generate an hlfir.associate to build a variable from an expression value.
+/// The type of the variable must be provided so that scalar logicals are
+/// properly typed when placed in memory.
+hlfir::AssociateOp genAssociateExpr(mlir::Location loc,
+ fir::FirOpBuilder &builder,
+ hlfir::Entity value,
+ mlir::Type variableType,
+ llvm::StringRef name);
+
+/// Get the raw address of a variable (simple fir.ref/fir.ptr, or fir.heap
+/// value). The returned value should be used with care, it does not contain any
+/// stride, shape, and type parameter information. For pointers and
+/// allocatables, this returns the address of the target.
+mlir::Value genVariableRawAddress(mlir::Location loc,
+ fir::FirOpBuilder &builder,
+ hlfir::Entity var);
+
+/// Get a fir.boxchar for character scalar or array variable (the shape is lost
+/// for arrays).
+mlir::Value genVariableBoxChar(mlir::Location loc, fir::FirOpBuilder &builder,
+ hlfir::Entity var);
+
/// If the entity is a variable, load its value (dereference pointers and
/// allocatables if needed). Do nothing if the entity os already a variable or
/// if it is not a scalar entity of numerical or logical type.
Entity loadTrivialScalar(mlir::Location loc, fir::FirOpBuilder &builder,
Entity entity);
+/// If \p entity is a POINTER or ALLOCATABLE, dereference it and return the
+/// target entity. Return \p entity otherwise.
+hlfir::Entity derefPointersAndAllocatables(mlir::Location loc,
+ fir::FirOpBuilder &builder,
+ Entity entity);
+
/// Compute the lower and upper bounds of an entity.
llvm::SmallVector<std::pair<mlir::Value, mlir::Value>>
genBounds(mlir::Location loc, fir::FirOpBuilder &builder, Entity entity);
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index ec380b244491b..18919132759d3 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -14,6 +14,7 @@
#include "flang/Lower/Allocatable.h"
#include "flang/Lower/CallInterface.h"
#include "flang/Lower/Coarray.h"
+#include "flang/Lower/ConvertCall.h"
#include "flang/Lower/ConvertExpr.h"
#include "flang/Lower/ConvertExprToHLFIR.h"
#include "flang/Lower/ConvertType.h"
@@ -1097,10 +1098,22 @@ class FirConverter : public Fortran::lower::AbstractConverter {
Fortran::lower::pft::Evaluation &eval = getEval();
setCurrentPosition(stmt.v.source);
assert(stmt.typedCall && "Call was not analyzed");
- // Call statement lowering shares code with function call lowering.
- mlir::Value res = Fortran::lower::createSubroutineCall(
- *this, *stmt.typedCall, explicitIterSpace, implicitIterSpace,
- localSymbols, stmtCtx, /*isUserDefAssignment=*/false);
+ mlir::Value res{};
+ if (bridge.getLoweringOptions().getLowerToHighLevelFIR()) {
+ llvm::Optional<mlir::Type> resultType = llvm::None;
+ if (stmt.typedCall->hasAlternateReturns())
+ resultType = builder->getIndexType();
+ auto hlfirRes = Fortran::lower::convertCallToHLFIR(
+ toLocation(), *this, *stmt.typedCall, resultType, localSymbols,
+ stmtCtx);
+ if (hlfirRes)
+ res = *hlfirRes;
+ } else {
+ // Call statement lowering shares code with function call lowering.
+ res = Fortran::lower::createSubroutineCall(
+ *this, *stmt.typedCall, explicitIterSpace, implicitIterSpace,
+ localSymbols, stmtCtx, /*isUserDefAssignment=*/false);
+ }
if (!res)
return; // "Normal" subroutine call.
// Call with alternate return specifiers.
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 3e01888d31bd6..0b093503fd774 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -11,6 +11,7 @@
//===----------------------------------------------------------------------===//
#include "flang/Lower/ConvertCall.h"
+#include "flang/Lower/ConvertExprToHLFIR.h"
#include "flang/Lower/ConvertVariable.h"
#include "flang/Lower/StatementContext.h"
#include "flang/Lower/SymbolMap.h"
@@ -21,6 +22,7 @@
#include "flang/Optimizer/Builder/MutableBox.h"
#include "flang/Optimizer/Builder/Todo.h"
#include "flang/Optimizer/Dialect/FIROpsSupport.h"
+#include "flang/Optimizer/HLFIR/HLFIROps.h"
#include "llvm/Support/Debug.h"
#define DEBUG_TYPE "flang-lower-expr"
@@ -400,3 +402,183 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
return callResult;
}
+
+/// Is this a call to an elemental procedure with at least one array argument?
+static bool
+isElementalProcWithArrayArgs(const Fortran::evaluate::ProcedureRef &procRef) {
+ if (procRef.IsElemental())
+ for (const std::optional<Fortran::evaluate::ActualArgument> &arg :
+ procRef.arguments())
+ if (arg && arg->Rank() != 0)
+ return true;
+ return false;
+}
+
+/// helper to detect statement functions
+static bool
+isStatementFunctionCall(const Fortran::evaluate::ProcedureRef &procRef) {
+ if (const Fortran::semantics::Symbol *symbol = procRef.proc().GetSymbol())
+ if (const auto *details =
+ symbol->detailsIf<Fortran::semantics::SubprogramDetails>())
+ return details->stmtFunction().has_value();
+ return false;
+}
+
+namespace {
+class CallBuilder {
+public:
+ CallBuilder(mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+ Fortran::lower::SymMap &symMap,
+ Fortran::lower::StatementContext &stmtCtx)
+ : converter{converter}, symMap{symMap}, stmtCtx{stmtCtx}, loc{loc} {}
+
+ llvm::Optional<hlfir::EntityWithAttributes>
+ gen(const Fortran::evaluate::ProcedureRef &procRef,
+ llvm::Optional<mlir::Type> resultType) {
+ mlir::Location loc = getLoc();
+ fir::FirOpBuilder &builder = getBuilder();
+ if (isElementalProcWithArrayArgs(procRef))
+ TODO(loc, "lowering elemental call to HLFIR");
+ if (procRef.proc().GetSpecificIntrinsic())
+ TODO(loc, "lowering ProcRef to HLFIR");
+ if (isStatementFunctionCall(procRef))
+ TODO(loc, "lowering Statement function call to HLFIR");
+
+ Fortran::lower::CallerInterface caller(procRef, converter);
+ using PassBy = Fortran::lower::CallerInterface::PassEntityBy;
+ mlir::FunctionType callSiteType = caller.genFunctionType();
+
+ llvm::SmallVector<llvm::Optional<hlfir::EntityWithAttributes>>
+ loweredActuals;
+ // Lower the actual arguments
+ for (const Fortran::lower::CallInterface<
+ Fortran::lower::CallerInterface>::PassedEntity &arg :
+ caller.getPassedArguments())
+ if (const auto *actual = arg.entity) {
+ const auto *expr = actual->UnwrapExpr();
+ if (!expr)
+ TODO(loc, "assumed type actual argument");
+ loweredActuals.emplace_back(Fortran::lower::convertExprToHLFIR(
+ loc, getConverter(), *expr, getSymMap(), getStmtCtx()));
+ } else {
+ // Optional dummy argument for which there is no actual argument.
+ loweredActuals.emplace_back(llvm::None);
+ }
+
+ llvm::SmallVector<hlfir::AssociateOp> exprAssociations;
+ for (auto [actual, arg] :
+ llvm::zip(loweredActuals, caller.getPassedArguments())) {
+ mlir::Type argTy = callSiteType.getInput(arg.firArgument);
+ if (!actual) {
+ // Optional dummy argument for which there is no actual argument.
+ caller.placeInput(arg, builder.create<fir::AbsentOp>(loc, argTy));
+ continue;
+ }
+
+ const auto *expr = arg.entity->UnwrapExpr();
+ if (!expr)
+ TODO(loc, "assumed type actual argument");
+
+ const bool actualMayBeDynamicallyAbsent =
+ arg.isOptional() && Fortran::evaluate::MayBePassedAsAbsentOptional(
+ *expr, getConverter().getFoldingContext());
+ if (actualMayBeDynamicallyAbsent)
+ TODO(loc, "passing optional arguments in HLFIR");
+
+ const bool isSimplyContiguous =
+ actual->isScalar() || Fortran::evaluate::IsSimplyContiguous(
+ *expr, getConverter().getFoldingContext());
+
+ switch (arg.passBy) {
+ case PassBy::Value: {
+ // True pass-by-value semantics.
+ auto value = hlfir::loadTrivialScalar(loc, builder, *actual);
+ if (!value.isValue())
+ TODO(loc, "Passing CPTR an CFUNCTPTR VALUE in HLFIR");
+ caller.placeInput(arg, builder.createConvert(loc, argTy, value));
+ } break;
+ case PassBy::BaseAddressValueAttribute: {
+ // VALUE attribute or pass-by-reference to a copy semantics. (byval*)
+ TODO(loc, "HLFIR PassBy::BaseAddressValueAttribute");
+ } break;
+ case PassBy::BaseAddress:
+ case PassBy::BoxChar: {
+ hlfir::Entity entity = *actual;
+ if (entity.isVariable()) {
+ entity = hlfir::derefPointersAndAllocatables(loc, builder, entity);
+ // Copy-in non contiguous variable
+ if (!isSimplyContiguous)
+ TODO(loc, "HLFIR copy-in/copy-out");
+ } else {
+ hlfir::AssociateOp associate = hlfir::genAssociateExpr(
+ loc, builder, entity, argTy, "adapt.valuebyref");
+ exprAssociations.push_back(associate);
+ entity = hlfir::Entity{associate.getBase()};
+ }
+ mlir::Value addr =
+ arg.passBy == PassBy::BaseAddress
+ ? hlfir::genVariableRawAddress(loc, builder, entity)
+ : hlfir::genVariableBoxChar(loc, builder, entity);
+ caller.placeInput(arg, builder.createConvert(loc, argTy, addr));
+ } break;
+ case PassBy::CharBoxValueAttribute: {
+ TODO(loc, "HLFIR PassBy::CharBoxValueAttribute");
+ } break;
+ case PassBy::AddressAndLength:
+ // PassBy::AddressAndLength is only used for character results. Results
+ // are not handled here.
+ fir::emitFatalError(
+ loc, "unexpected PassBy::AddressAndLength for actual arguments");
+ break;
+ case PassBy::CharProcTuple: {
+ TODO(loc, "HLFIR PassBy::CharProcTuple");
+ } break;
+ case PassBy::Box: {
+ TODO(loc, "HLFIR PassBy::Box");
+ } break;
+ case PassBy::MutableBox: {
+ TODO(loc, "HLFIR PassBy::MutableBox");
+ } break;
+ }
+ }
+ // Prepare lowered arguments according to the interface
+ // and map the lowered values to the dummy
+ // arguments.
+ fir::ExtendedValue result = Fortran::lower::genCallOpAndResult(
+ loc, getConverter(), getSymMap(), getStmtCtx(), caller, callSiteType,
+ resultType);
+ mlir::Value resultFirBase = fir::getBase(result);
+
+ /// Clean-up associations and copy-in.
+ for (auto associate : exprAssociations)
+ builder.create<hlfir::EndAssociateOp>(loc, associate);
+ if (!resultFirBase)
+ return llvm::None; // subroutine call.
+ if (fir::isa_trivial(resultFirBase.getType()))
+ return hlfir::EntityWithAttributes{resultFirBase};
+ return hlfir::genDeclare(loc, builder, result, "tmp.funcresult",
+ fir::FortranVariableFlagsAttr{});
+ // TODO: "move" non pointer results into hlfir.expr.
+ }
+
+private:
+ mlir::Location getLoc() const { return loc; }
+ Fortran::lower::AbstractConverter &getConverter() { return converter; }
+ fir::FirOpBuilder &getBuilder() { return converter.getFirOpBuilder(); }
+ Fortran::lower::SymMap &getSymMap() { return symMap; }
+ Fortran::lower::StatementContext &getStmtCtx() { return stmtCtx; }
+
+ Fortran::lower::AbstractConverter &converter;
+ Fortran::lower::SymMap &symMap;
+ Fortran::lower::StatementContext &stmtCtx;
+ mlir::Location loc;
+};
+} // namespace
+
+llvm::Optional<hlfir::EntityWithAttributes> Fortran::lower::convertCallToHLFIR(
+ mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+ const evaluate::ProcedureRef &procRef,
+ llvm::Optional<mlir::Type> resultType, Fortran::lower::SymMap &symMap,
+ Fortran::lower::StatementContext &stmtCtx) {
+ return CallBuilder(loc, converter, symMap, stmtCtx).gen(procRef, resultType);
+}
diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp
index 8a10cd11cb5fa..81b4d63889729 100644
--- a/flang/lib/Lower/ConvertExprToHLFIR.cpp
+++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp
@@ -13,7 +13,10 @@
#include "flang/Lower/ConvertExprToHLFIR.h"
#include "flang/Evaluate/shape.h"
#include "flang/Lower/AbstractConverter.h"
+#include "flang/Lower/CallInterface.h"
+#include "flang/Lower/ConvertCall.h"
#include "flang/Lower/ConvertConstant.h"
+#include "flang/Lower/ConvertType.h"
#include "flang/Lower/StatementContext.h"
#include "flang/Lower/SymbolMap.h"
#include "flang/Optimizer/Builder/Todo.h"
@@ -281,7 +284,12 @@ class HlfirBuilder {
template <typename T>
hlfir::EntityWithAttributes
gen(const Fortran::evaluate::FunctionRef<T> &expr) {
- TODO(getLoc(), "lowering funcRef to HLFIR");
+ mlir::Type resType =
+ Fortran::lower::TypeBuilder<T>::genType(getConverter(), expr);
+ return Fortran::lower::convertCallToHLFIR(getLoc(), getConverter(), expr,
+ resType, getSymMap(),
+ getStmtCtx())
+ .value();
}
template <typename T>
diff --git a/flang/lib/Optimizer/Builder/HLFIRTools.cpp b/flang/lib/Optimizer/Builder/HLFIRTools.cpp
index 1a7e349b5602f..aa6e90e98e727 100644
--- a/flang/lib/Optimizer/Builder/HLFIRTools.cpp
+++ b/flang/lib/Optimizer/Builder/HLFIRTools.cpp
@@ -159,16 +159,78 @@ hlfir::genDeclare(mlir::Location loc, fir::FirOpBuilder &builder,
return mlir::cast<fir::FortranVariableOpInterface>(declareOp.getOperation());
}
-/// If the entity is a variable, load its value (dereference pointers and
-/// allocatables if needed). Do nothing if the entity os already a variable or
-/// if it is not a scalar entity of numerical or logical type.
+hlfir::AssociateOp hlfir::genAssociateExpr(mlir::Location loc,
+ fir::FirOpBuilder &builder,
+ hlfir::Entity value,
+ mlir::Type variableType,
+ llvm::StringRef name) {
+ assert(value.isValue() && "must not be a variable");
+ mlir::Value shape{};
+ if (value.isArray())
+ TODO(loc, "associating array expressions");
+
+ mlir::Value source = value;
+ // Lowered scalar expression values for numerical and logical may have a
+ //
diff erent type than what is required for the type in memory (logical
+ // expressions are typically manipulated as i1, but needs to be stored
+ // according to the fir.logical<kind> so that the storage size is correct).
+ // Character length mismatches are ignored (it is ok for one to be dynamic
+ // and the other static).
+ mlir::Type varEleTy = getFortranElementType(variableType);
+ mlir::Type valueEleTy = getFortranElementType(value.getType());
+ if (varEleTy != valueEleTy && !(valueEleTy.isa<fir::CharacterType>() &&
+ varEleTy.isa<fir::CharacterType>())) {
+ assert(value.isScalar() && fir::isa_trivial(value.getType()));
+ source = builder.createConvert(loc, fir::unwrapPassByRefType(variableType),
+ value);
+ }
+ llvm::SmallVector<mlir::Value> lenParams;
+ genLengthParameters(loc, builder, value, lenParams);
+ return builder.create<hlfir::AssociateOp>(loc, source, name, shape, lenParams,
+ fir::FortranVariableFlagsAttr{});
+}
+
+mlir::Value hlfir::genVariableRawAddress(mlir::Location loc,
+ fir::FirOpBuilder &builder,
+ hlfir::Entity var) {
+ assert(var.isVariable() && "only address of variables can be taken");
+ mlir::Value baseAddr = var.getFirBase();
+ if (var.isMutableBox())
+ baseAddr = builder.create<fir::LoadOp>(loc, baseAddr);
+ // Get raw address.
+ if (baseAddr.getType().isa<fir::BaseBoxType>()) {
+ auto addrType =
+ fir::ReferenceType::get(fir::unwrapPassByRefType(baseAddr.getType()));
+ baseAddr = builder.create<fir::BoxAddrOp>(loc, addrType, baseAddr);
+ }
+ return baseAddr;
+}
+
+mlir::Value hlfir::genVariableBoxChar(mlir::Location loc,
+ fir::FirOpBuilder &builder,
+ hlfir::Entity var) {
+ assert(var.isVariable() && "only address of variables can be taken");
+ if (var.getType().isa<fir::BoxCharType>())
+ return var;
+ mlir::Value addr = genVariableRawAddress(loc, builder, var);
+ llvm::SmallVector<mlir::Value> lengths;
+ genLengthParameters(loc, builder, var, lengths);
+ assert(lengths.size() == 1);
+ auto charType = var.getFortranElementType().cast<fir::CharacterType>();
+ auto boxCharType =
+ fir::BoxCharType::get(builder.getContext(), charType.getFKind());
+ auto scalarAddr =
+ builder.createConvert(loc, fir::ReferenceType::get(charType), addr);
+ return builder.create<fir::EmboxCharOp>(loc, boxCharType, scalarAddr,
+ lengths[0]);
+}
+
hlfir::Entity hlfir::loadTrivialScalar(mlir::Location loc,
fir::FirOpBuilder &builder,
Entity entity) {
if (entity.isVariable() && entity.isScalar() &&
fir::isa_trivial(entity.getFortranElementType())) {
- if (entity.isMutableBox())
- TODO(loc, "load pointer/allocatable scalar");
+ entity = derefPointersAndAllocatables(loc, builder, entity);
return Entity{builder.create<fir::LoadOp>(loc, entity)};
}
return entity;
@@ -247,3 +309,11 @@ std::pair<mlir::Value, mlir::Value> hlfir::genVariableFirBaseShapeAndParams(
return {fir::getBase(exv), variableInterface.getShape()};
return {fir::getBase(exv), builder.createShape(loc, exv)};
}
+
+hlfir::Entity hlfir::derefPointersAndAllocatables(mlir::Location loc,
+ fir::FirOpBuilder &builder,
+ Entity entity) {
+ if (entity.isMutableBox())
+ return hlfir::Entity{builder.create<fir::LoadOp>(loc, entity).getResult()};
+ return entity;
+}
diff --git a/flang/test/Lower/HLFIR/calls-f77.f90 b/flang/test/Lower/HLFIR/calls-f77.f90
new file mode 100644
index 0000000000000..c830d2a92c746
--- /dev/null
+++ b/flang/test/Lower/HLFIR/calls-f77.f90
@@ -0,0 +1,188 @@
+! Test lowering of F77 calls to HLFIR
+! RUN: bbc -emit-fir -hlfir -o - %s 2>&1 | FileCheck %s
+
+! -----------------------------------------------------------------------------
+! Test lowering of F77 procedure reference arguments
+! -----------------------------------------------------------------------------
+
+subroutine call_no_arg()
+ call void()
+end subroutine
+! CHECK-LABEL: func.func @_QPcall_no_arg() {
+! CHECK-NEXT: fir.call @_QPvoid() fastmath<contract> : () -> ()
+! CHECK-NEXT: return
+
+subroutine call_int_arg_var(n)
+ integer :: n
+ call take_i4(n)
+end subroutine
+! CHECK-LABEL: func.func @_QPcall_int_arg_var(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i32>
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFcall_int_arg_varEn"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+! CHECK: fir.call @_QPtake_i4(%[[VAL_1]]#1) fastmath<contract> : (!fir.ref<i32>) -> ()
+
+subroutine call_int_arg_expr()
+ call take_i4(42)
+end subroutine
+! CHECK-LABEL: func.func @_QPcall_int_arg_expr() {
+! CHECK: %[[VAL_0:.*]] = arith.constant 42 : i32
+! CHECK: %[[VAL_1:.*]]:3 = hlfir.associate %[[VAL_0]] {uniq_name = "adapt.valuebyref"} : (i32) -> (!fir.ref<i32>, !fir.ref<i32>, i1)
+! CHECK: fir.call @_QPtake_i4(%[[VAL_1]]#0) fastmath<contract> : (!fir.ref<i32>) -> ()
+! CHECK: hlfir.end_associate %[[VAL_1]]#1, %[[VAL_1]]#2 : !fir.ref<i32>, i1
+
+subroutine call_real_arg_expr()
+ call take_r4(0.42)
+end subroutine
+! CHECK-LABEL: func.func @_QPcall_real_arg_expr() {
+! CHECK: %[[VAL_0:.*]] = arith.constant 4.200000e-01 : f32
+! CHECK: %[[VAL_1:.*]]:3 = hlfir.associate %[[VAL_0]] {uniq_name = "adapt.valuebyref"} : (f32) -> (!fir.ref<f32>, !fir.ref<f32>, i1)
+! CHECK: fir.call @_QPtake_r4(%[[VAL_1]]#0) fastmath<contract> : (!fir.ref<f32>) -> ()
+! CHECK: hlfir.end_associate %[[VAL_1]]#1, %[[VAL_1]]#2 : !fir.ref<f32>, i1
+
+subroutine call_real_arg_var(x)
+ real :: x
+ call take_r4(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPcall_real_arg_var(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<f32>
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFcall_real_arg_varEx"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>)
+! CHECK: fir.call @_QPtake_r4(%[[VAL_1]]#1) fastmath<contract> : (!fir.ref<f32>) -> ()
+
+subroutine call_logical_arg_var(x)
+ logical :: x
+ call take_l4(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPcall_logical_arg_var(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.logical<4>>
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFcall_logical_arg_varEx"} : (!fir.ref<!fir.logical<4>>) -> (!fir.ref<!fir.logical<4>>, !fir.ref<!fir.logical<4>>)
+! CHECK: fir.call @_QPtake_l4(%[[VAL_1]]#1) fastmath<contract> : (!fir.ref<!fir.logical<4>>) -> ()
+
+subroutine call_logical_arg_expr()
+ call take_l4(.true.)
+end subroutine
+! CHECK-LABEL: func.func @_QPcall_logical_arg_expr() {
+! CHECK: %[[VAL_0:.*]] = arith.constant true
+! CHECK: %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (i1) -> !fir.logical<4>
+! CHECK: %[[VAL_2:.*]]:3 = hlfir.associate %[[VAL_1]] {uniq_name = "adapt.valuebyref"} : (!fir.logical<4>) -> (!fir.ref<!fir.logical<4>>, !fir.ref<!fir.logical<4>>, i1)
+! CHECK: fir.call @_QPtake_l4(%[[VAL_2]]#0) fastmath<contract> : (!fir.ref<!fir.logical<4>>) -> ()
+! CHECK: hlfir.end_associate %[[VAL_2]]#1, %[[VAL_2]]#2 : !fir.ref<!fir.logical<4>>, i1
+
+subroutine call_logical_arg_expr_2()
+ call take_l8(.true._8)
+end subroutine
+! CHECK-LABEL: func.func @_QPcall_logical_arg_expr_2() {
+! CHECK: %[[VAL_0:.*]] = arith.constant true
+! CHECK: %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (i1) -> !fir.logical<8>
+! CHECK: %[[VAL_2:.*]]:3 = hlfir.associate %[[VAL_1]] {uniq_name = "adapt.valuebyref"} : (!fir.logical<8>) -> (!fir.ref<!fir.logical<8>>, !fir.ref<!fir.logical<8>>, i1)
+! CHECK: fir.call @_QPtake_l8(%[[VAL_2]]#0) fastmath<contract> : (!fir.ref<!fir.logical<8>>) -> ()
+! CHECK: hlfir.end_associate %[[VAL_2]]#1, %[[VAL_2]]#2 : !fir.ref<!fir.logical<8>>, i1
+
+subroutine call_char_arg_var(x)
+ character(*) :: x
+ call take_c(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPcall_char_arg_var(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxchar<1>
+! CHECK: %[[VAL_1:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]]#0 typeparams %[[VAL_1]]#1 {uniq_name = "_QFcall_char_arg_varEx"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+! CHECK: fir.call @_QPtake_c(%[[VAL_2]]#0) fastmath<contract> : (!fir.boxchar<1>) -> ()
+
+subroutine call_char_arg_var_expr(x)
+ character(*) :: x
+ call take_c(x//x)
+end subroutine
+! CHECK-LABEL: func.func @_QPcall_char_arg_var_expr(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxchar<1>
+! CHECK: %[[VAL_1:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]]#0 typeparams %[[VAL_1]]#1 {uniq_name = "_QFcall_char_arg_var_exprEx"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+! CHECK: %[[VAL_3:.*]] = arith.addi %[[VAL_1]]#1, %[[VAL_1]]#1 : index
+! CHECK: %[[VAL_4:.*]] = hlfir.concat %[[VAL_2]]#0, %[[VAL_2]]#0 len %[[VAL_3]] : (!fir.boxchar<1>, !fir.boxchar<1>, index) -> !hlfir.expr<!fir.char<1,?>>
+! CHECK: %[[VAL_5:.*]]:3 = hlfir.associate %[[VAL_4]] typeparams %[[VAL_3]] {uniq_name = "adapt.valuebyref"} : (!hlfir.expr<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>, i1)
+! CHECK: fir.call @_QPtake_c(%[[VAL_5]]#0) fastmath<contract> : (!fir.boxchar<1>) -> ()
+! CHECK: hlfir.end_associate %[[VAL_5]]#1, %[[VAL_5]]#2 : !fir.ref<!fir.char<1,?>>, i1
+
+subroutine call_arg_array_var(n)
+ integer :: n(10, 20)
+ call take_arr(n)
+end subroutine
+! CHECK-LABEL: func.func @_QPcall_arg_array_var(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.array<10x20xi32>>
+! CHECK: %[[VAL_1:.*]] = arith.constant 10 : index
+! CHECK: %[[VAL_2:.*]] = arith.constant 20 : index
+! CHECK: %[[VAL_3:.*]] = fir.shape %[[VAL_1]], %[[VAL_2]] : (index, index) -> !fir.shape<2>
+! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_0]](%[[VAL_3]]) {uniq_name = "_QFcall_arg_array_varEn"} : (!fir.ref<!fir.array<10x20xi32>>, !fir.shape<2>) -> (!fir.ref<!fir.array<10x20xi32>>, !fir.ref<!fir.array<10x20xi32>>)
+! CHECK: fir.call @_QPtake_arr(%[[VAL_4]]#1) fastmath<contract> : (!fir.ref<!fir.array<10x20xi32>>) -> ()
+
+subroutine call_arg_array_2(n)
+ integer, contiguous, optional :: n(:, :)
+ call take_arr_2(n)
+end subroutine
+! CHECK-LABEL: func.func @_QPcall_arg_array_2(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?x?xi32>>
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<contiguous, optional>, uniq_name = "_QFcall_arg_array_2En"} : (!fir.box<!fir.array<?x?xi32>>) -> (!fir.box<!fir.array<?x?xi32>>, !fir.box<!fir.array<?x?xi32>>)
+! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]]#1 : (!fir.box<!fir.array<?x?xi32>>) -> !fir.ref<!fir.array<?x?xi32>>
+! CHECK: fir.call @_QPtake_arr_2(%[[VAL_2]]) fastmath<contract> : (!fir.ref<!fir.array<?x?xi32>>) -> ()
+
+! -----------------------------------------------------------------------------
+! Test lowering of function results
+! -----------------------------------------------------------------------------
+
+subroutine return_integer()
+ integer :: ifoo
+ print *, ifoo()
+end subroutine
+! CHECK-LABEL: func.func @_QPreturn_integer(
+! CHECK: fir.call @_QPifoo() fastmath<contract> : () -> i32
+
+
+subroutine return_logical()
+ logical :: lfoo
+ print *, lfoo()
+end subroutine
+! CHECK-LABEL: func.func @_QPreturn_logical(
+! CHECK: fir.call @_QPlfoo() fastmath<contract> : () -> !fir.logical<4>
+
+subroutine return_complex()
+ complex :: cplxfoo
+ print *, cplxfoo()
+end subroutine
+! CHECK-LABEL: func.func @_QPreturn_complex(
+! CHECK: fir.call @_QPcplxfoo() fastmath<contract> : () -> !fir.complex<4>
+
+subroutine return_char(n)
+ integer(8) :: n
+ character(n) :: c2foo
+ print *, c2foo()
+end subroutine
+! CHECK-LABEL: func.func @_QPreturn_char(
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare {{.*}}n
+! CHECK: %[[VAL_2:.*]] = arith.constant -1 : i32
+! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_1]]#1 : !fir.ref<i64>
+! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> index
+! CHECK: %[[VAL_9:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_10:.*]] = arith.cmpi sgt, %[[VAL_8]], %[[VAL_9]] : index
+! CHECK: %[[VAL_11:.*]] = arith.select %[[VAL_10]], %[[VAL_8]], %[[VAL_9]] : index
+! CHECK: %[[VAL_13:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_11]] : index) {bindc_name = ".result"}
+! CHECK: %[[VAL_14:.*]] = fir.call @_QPc2foo(%[[VAL_13]], %[[VAL_11]]) fastmath<contract> : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+! CHECK: %[[VAL_15:.*]]:2 = hlfir.declare %[[VAL_13]] typeparams %[[VAL_11]] {uniq_name = "tmp.funcresult"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+
+! -----------------------------------------------------------------------------
+! Test calls with alternate returns
+! -----------------------------------------------------------------------------
+
+! CHECK-LABEL: func.func @_QPalternate_return_call(
+subroutine alternate_return_call(n1, n2, k)
+ integer :: n1, n2, k
+ ! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare {{.*}}k
+ ! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare {{.*}}n1
+ ! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare {{.*}}n2
+ ! CHECK: %[[selector:.*]] = fir.call @_QPalternate_return(%[[VAL_4]]#1, %[[VAL_5]]#1) fastmath<contract> : (!fir.ref<i32>, !fir.ref<i32>) -> index
+ ! CHECK-NEXT: fir.select %[[selector]] : index [1, ^[[block1:bb[0-9]+]], 2, ^[[block2:bb[0-9]+]], unit, ^[[blockunit:bb[0-9]+]]
+ call alternate_return(n1, *5, n2, *7)
+ ! CHECK: ^[[blockunit]]: // pred: ^bb0
+ k = 0; return;
+ ! CHECK: ^[[block1]]: // pred: ^bb0
+5 k = -1; return;
+ ! CHECK: ^[[block2]]: // pred: ^bb0
+7 k = 1; return
+end
More information about the flang-commits
mailing list