diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h index 8ae93d364bfd0..7cf7089715b52 100644 --- a/flang/include/flang/Semantics/expression.h +++ b/flang/include/flang/Semantics/expression.h @@ -352,6 +352,7 @@ class ExpressionAnalyzer { const parser::ProcComponentRef &, ActualArguments &&, bool isSubroutine); std::optional CheckCall( parser::CharBlock, const ProcedureDesignator &, ActualArguments &); + bool CheckPPCIntrinsic(const ProcedureDesignator &, ActualArguments &); using AdjustActuals = std::optional>; bool ResolveForward(const Symbol &); diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp index 8d9b55540ed36..d877be0cbc0ae 100644 --- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp +++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp @@ -334,6 +334,10 @@ struct IntrinsicLibrary { /// is ignored because this is already reflected in the result type. mlir::Value genConversion(mlir::Type, llvm::ArrayRef); + // PPC intrinsic handlers. + template + void genMtfsf(llvm::ArrayRef); + /// In the template helper below: /// - "FN func" is a callback to generate the related intrinsic runtime call. /// - "FD funcDim" is a callback to generate the "dim" runtime call. @@ -880,6 +884,18 @@ static constexpr IntrinsicHandler handlers[]{ /*isElemental=*/true}, }; +// PPC specific intrinsic handlers. +static constexpr IntrinsicHandler ppcHandlers[]{ + {"__ppc_mtfsf", + &I::genMtfsf, + {{{"mask", asValue}, {"r", asValue}}}, + /*isElemental=*/false}, + {"__ppc_mtfsfi", + &I::genMtfsf, + {{{"bf", asValue}, {"i", asValue}}}, + /*isElemental=*/false}, +}; + static const IntrinsicHandler *findIntrinsicHandler(llvm::StringRef name) { auto compare = [](const IntrinsicHandler &handler, llvm::StringRef name) { return name.compare(handler.name) > 0; @@ -889,6 +905,15 @@ static const IntrinsicHandler *findIntrinsicHandler(llvm::StringRef name) { : nullptr; } +static const IntrinsicHandler *findPPCIntrinsicHandler(llvm::StringRef name) { + auto compare = [](const IntrinsicHandler &ppcHandler, llvm::StringRef name) { + return name.compare(ppcHandler.name) > 0; + }; + auto result = llvm::lower_bound(ppcHandlers, name, compare); + return result != std::end(ppcHandlers) && result->name == name ? result + : nullptr; +} + /// To make fir output more readable for debug, one can outline all intrinsic /// implementation in wrappers (overrides the IntrinsicHandler::outline flag). static llvm::cl::opt outlineAllIntrinsics( @@ -980,6 +1005,20 @@ static mlir::FunctionType genF64F64F64F64FuncType(mlir::MLIRContext *context) { return mlir::FunctionType::get(context, {t, t, t}, {t}); } +template +static mlir::FunctionType genVoidIntF64FuncType(mlir::MLIRContext *context) { + auto t = mlir::IntegerType::get(context, Bits); + auto u = mlir::FloatType::getF64(context); + return mlir::FunctionType::get(context, {t, u}, std::nullopt); +} + +template +static mlir::FunctionType genVoidIntIntFuncType(mlir::MLIRContext *context) { + auto t = mlir::IntegerType::get(context, BitsA); + auto u = mlir::IntegerType::get(context, BitsB); + return mlir::FunctionType::get(context, {t, u}, std::nullopt); +} + template static mlir::FunctionType genIntF64FuncType(mlir::MLIRContext *context) { auto t = mlir::FloatType::getF64(context); @@ -1865,15 +1904,30 @@ IntrinsicLibrary::genIntrinsicCall(llvm::StringRef specificName, this->resultMustBeFreed}; } - if (!resultType) - // Subroutine should have a handler, they are likely missing for now. - crashOnMissingIntrinsic(loc, name); + // If targeting PowerPC, check PPC intrinsic handlers. + auto mod = builder.getModule(); + if (fir::getTargetTriple(mod).isPPC()) { + if (const IntrinsicHandler *ppcHandler = findPPCIntrinsicHandler(name)) { + bool outline = ppcHandler->outline || outlineAllIntrinsics; + return {std::visit( + [&](auto &generator) -> fir::ExtendedValue { + return invokeHandler(generator, *ppcHandler, resultType, + args, outline, *this); + }, + ppcHandler->generator), + this->resultMustBeFreed}; + } + } // Try the runtime if no special handler was defined for the // intrinsic being called. Maths runtime only has numerical elemental. // No optional arguments are expected at this point, the code will // crash if it gets absent optional. + if (!resultType) + // Subroutine should have a handler, they are likely missing for now. + crashOnMissingIntrinsic(loc, name); + // FIXME: using toValue to get the type won't work with array arguments. llvm::SmallVector mlirArgs; for (const fir::ExtendedValue &extendedVal : args) { @@ -1971,12 +2025,20 @@ static std::string typeToString(mlir::Type t) { /// arguments. The mangling pattern is: /// fir...... /// e.g ACOS(COMPLEX(4)) is mangled as fir.acos.z4.z4 +/// For subroutines no result type is return but in order to still provide +/// a unique mangled name, we use "void" as the return type. As in: +/// fir..void.... +/// e.g. FREE(INTEGER(4)) is mangled as fir.free.void.i4 static std::string mangleIntrinsicProcedure(llvm::StringRef intrinsic, mlir::FunctionType funTy) { std::string name = "fir."; name.append(intrinsic.str()).append("."); - assert(funTy.getNumResults() == 1 && "only function mangling supported"); - name.append(typeToString(funTy.getResult(0))); + if (funTy.getNumResults() == 1) + name.append(typeToString(funTy.getResult(0))); + else if (funTy.getNumResults() == 0) + name.append("void"); + else + llvm_unreachable("more than one result value for function"); unsigned e = funTy.getNumInputs(); for (decltype(e) i = 0; i < e; ++i) name.append(".").append(typeToString(funTy.getInput(i))); @@ -5520,6 +5582,31 @@ mlir::Value IntrinsicLibrary::genExtremum(mlir::Type, return result; } +//===----------------------------------------------------------------------===// +// PowerPC specific intrinsic handlers. +//===----------------------------------------------------------------------===// +template +void IntrinsicLibrary::genMtfsf(llvm::ArrayRef args) { + assert(args.size() == 2); + llvm::SmallVector scalarArgs; + for (const fir::ExtendedValue &arg : args) + if (arg.getUnboxed()) + scalarArgs.emplace_back(fir::getBase(arg)); + else + mlir::emitError(loc, "nonscalar intrinsic argument"); + + mlir::FunctionType libFuncType; + mlir::func::FuncOp funcOp; + if (isImm) { + libFuncType = genVoidIntIntFuncType<32, 32>(builder.getContext()); + funcOp = builder.addNamedFunction(loc, "llvm.ppc.mtfsfi", libFuncType); + } else { + libFuncType = genVoidIntF64FuncType<32>(builder.getContext()); + funcOp = builder.addNamedFunction(loc, "llvm.ppc.mtfsf", libFuncType); + } + builder.create(loc, funcOp, scalarArgs); +} + //===----------------------------------------------------------------------===// // Argument lowering rules interface for intrinsic or intrinsic module // procedure. diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp index 3b0b2039cc7d5..3a31dba64eefe 100644 --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -1228,6 +1228,57 @@ bool CheckInterfaceForGeneric(const characteristics::Procedure &proc, .AnyFatalError(); } +bool CheckArgumentIsConstantExprInRange( + const evaluate::ActualArguments &actuals, int index, int lowerBound, + int upperBound, parser::ContextualMessages &messages) { + CHECK(index >= 0 && index < actuals.size()); + + const std::optional &argOptional{actuals[index]}; + if (!argOptional) { + DIE("Actual argument should have value"); + return false; + } + + const evaluate::ActualArgument &arg{argOptional.value()}; + const evaluate::Expr *argExpr{arg.UnwrapExpr()}; + CHECK(argExpr != nullptr); + + if (!IsConstantExpr(*argExpr)) { + messages.Say("Actual argument #%d must be a constant expression"_err_en_US, + index + 1); + return false; + } + + // This does not imply that the kind of the argument is 8. The kind + // for the intrinsic's argument should have been check prior. This is just + // a conversion so that we can read the constant value. + auto scalarValue{evaluate::ToInt64(argExpr)}; + CHECK(scalarValue.has_value()); + + if (*scalarValue < lowerBound || *scalarValue > upperBound) { + messages.Say( + "Argument #%d must be a constant expression in range %d-%d"_err_en_US, + index + 1, lowerBound, upperBound); + return false; + } + return true; +} + +bool CheckPPCIntrinsic(const Symbol &generic, const Symbol &specific, + const evaluate::ActualArguments &actuals, + evaluate::FoldingContext &context) { + parser::ContextualMessages &messages{context.messages()}; + + if (specific.name() == "__ppc_mtfsf") { + return CheckArgumentIsConstantExprInRange(actuals, 0, 0, 7, messages); + } + if (specific.name() == "__ppc_mtfsfi") { + return CheckArgumentIsConstantExprInRange(actuals, 0, 0, 7, messages) && + CheckArgumentIsConstantExprInRange(actuals, 1, 0, 15, messages); + } + return false; +} + bool CheckArguments(const characteristics::Procedure &proc, evaluate::ActualArguments &actuals, evaluate::FoldingContext &context, const Scope &scope, bool treatingExternalAsImplicit, diff --git a/flang/lib/Semantics/check-call.h b/flang/lib/Semantics/check-call.h index 439bdd0241e3a..1d03f81a989fa 100644 --- a/flang/lib/Semantics/check-call.h +++ b/flang/lib/Semantics/check-call.h @@ -37,6 +37,13 @@ bool CheckArguments(const evaluate::characteristics::Procedure &, bool treatingExternalAsImplicit, const evaluate::SpecificIntrinsic *intrinsic); +bool CheckPPCIntrinsic(const Symbol &generic, const Symbol &specific, + const evaluate::ActualArguments &actuals, + evaluate::FoldingContext &context); +bool CheckArgumentIsConstantExprInRange( + const evaluate::ActualArguments &actuals, int index, int lowerBound, + int upperBound, parser::ContextualMessages &messages); + // Checks actual arguments for the purpose of resolving a generic interface. bool CheckInterfaceForGeneric(const evaluate::characteristics::Procedure &, evaluate::ActualArguments &, const evaluate::FoldingContext &, diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp index 215341e9c9a27..06226f282c1cd 100644 --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -2518,6 +2518,11 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name, mightBeStructureConstructor)}; resolution = pair.first; dueToAmbiguity = pair.second; + if (context_.GetPPCBuiltinsScope() && + resolution->name().ToString().rfind("__ppc_", 0) == 0) { + semantics::CheckPPCIntrinsic( + *symbol, *resolution, arguments, GetFoldingContext()); + } if (resolution) { // re-resolve name to the specific procedure name.symbol = const_cast(resolution); diff --git a/flang/module/__fortran_ppc_intrinsics.f90 b/flang/module/__fortran_ppc_intrinsics.f90 index 1447df1e82290..906aba701ec37 100644 --- a/flang/module/__fortran_ppc_intrinsics.f90 +++ b/flang/module/__fortran_ppc_intrinsics.f90 @@ -157,4 +157,21 @@ end function func_r8r8i procedure :: __ppc_frsqrtes end interface frsqrtes public :: frsqrtes + +! mtfsf, mtfsfi + interface mtfsf + subroutine __ppc_mtfsf(mask, r) + integer(4), intent(in) :: mask + real(8), intent(in) :: r + end subroutine __ppc_mtfsf + end interface mtfsf + public :: mtfsf + + interface mtfsfi + subroutine __ppc_mtfsfi(bf, i) + integer(4), intent(in) :: bf + integer(4), intent(in) :: i + end subroutine __ppc_mtfsfi + end interface mtfsfi + public :: mtfsfi end module __Fortran_PPC_intrinsics diff --git a/flang/test/Lower/ppc-intrinsics.f90 b/flang/test/Lower/ppc-intrinsics.f90 index c0eef7eeb36c7..c18646ee2207d 100644 --- a/flang/test/Lower/ppc-intrinsics.f90 +++ b/flang/test/Lower/ppc-intrinsics.f90 @@ -185,3 +185,18 @@ subroutine frsqrtes_test(x) ! CHECK-FIR: fir.call @fir.__ppc_frsqrtes.f32.f32 ! CHECK-LLVMIR: call contract float @llvm.ppc.frsqrtes(float %{{[0-9]}}) end + +! CHECK-LABEL: mtfsf_test +subroutine mtfsf_test(r) + real(8) :: r + call mtfsf(1, r) +! CHECK-FIR: fir.call @fir.__ppc_mtfsf.void.i32.f64 +! CHECK-LLVMIR: call void @llvm.ppc.mtfsf(i32 {{[0-9]}}, double %{{[0-9]}}) +end + +! CHECK-LABEL: mtfsfi_test +subroutine mtfsfi_test() + call mtfsfi(1, 2) +! CHECK-FIR: fir.call @fir.__ppc_mtfsfi.void.i32.i32 +! CHECK-LLVMIR: call void @llvm.ppc.mtfsfi(i32 {{[0-9]}}, i32 {{[0-9]}}) +end