Index: flang/include/flang/Evaluate/intrinsics.h =================================================================== --- flang/include/flang/Evaluate/intrinsics.h +++ flang/include/flang/Evaluate/intrinsics.h @@ -80,6 +80,7 @@ // Make *this aware of the __Fortran_builtins module to expose TEAM_TYPE &c. void SupplyBuiltins(const semantics::Scope &) const; + void SupplyPPCBuiltins(const semantics::Scope &) const; // Check whether a name should be allowed to appear on an INTRINSIC // statement. Index: flang/include/flang/Semantics/semantics.h =================================================================== --- flang/include/flang/Semantics/semantics.h +++ flang/include/flang/Semantics/semantics.h @@ -216,6 +216,9 @@ void UseFortranBuiltinsModule(); const Scope *GetBuiltinsScope() const { return builtinsScope_; } + void UsePPCFortranBuiltinsModule(); + const Scope *GetPPCBuiltinsScope() const { return ppcBuiltinsScope_; } + // Saves a module file's parse tree so that it remains available // during semantics. parser::Program &SaveParseTree(parser::Program &&); @@ -276,6 +279,7 @@ UnorderedSymbolSet errorSymbols_; std::set tempNames_; const Scope *builtinsScope_{nullptr}; // module __Fortran_builtins + const Scope *ppcBuiltinsScope_{nullptr}; // PPC builtins std::list modFileParseTrees_; std::unique_ptr commonBlockMap_; bool anyDefinedIntrinsicOperator_{false}; Index: flang/lib/Evaluate/intrinsics.cpp =================================================================== --- flang/lib/Evaluate/intrinsics.cpp +++ flang/lib/Evaluate/intrinsics.cpp @@ -2351,6 +2351,10 @@ } } + void SupplyPPCBuiltins(const semantics::Scope &builtins) { + ppcBuiltinsScope_ = &builtins; + } + void SupplyBuiltins(const semantics::Scope &builtins) { builtinsScope_ = &builtins; } @@ -2385,6 +2389,7 @@ std::multimap specificFuncs_; std::multimap subroutines_; const semantics::Scope *builtinsScope_{nullptr}; + const semantics::Scope *ppcBuiltinsScope_{nullptr}; std::map aliases_; }; @@ -3055,7 +3060,6 @@ } } } - // If there was no exact match with a specific, try to match the related // generic and convert the result to the specific required type. for (auto specIter{specificRange.first}; specIter != specificRange.second; @@ -3161,6 +3165,11 @@ DEREF(impl_.get()).SupplyBuiltins(builtins); } +void IntrinsicProcTable::SupplyPPCBuiltins( + const semantics::Scope &builtins) const { + DEREF(impl_.get()).SupplyPPCBuiltins(builtins); +} + bool IntrinsicProcTable::IsIntrinsic(const std::string &name) const { return DEREF(impl_.get()).IsIntrinsic(name); } Index: flang/lib/Optimizer/Builder/IntrinsicCall.cpp =================================================================== --- flang/lib/Optimizer/Builder/IntrinsicCall.cpp +++ flang/lib/Optimizer/Builder/IntrinsicCall.cpp @@ -34,6 +34,7 @@ #include "flang/Optimizer/Builder/Todo.h" #include "flang/Optimizer/Dialect/FIROpsSupport.h" #include "flang/Optimizer/Support/FatalError.h" +#include "flang/Optimizer/Support/FIRContext.h" #include "flang/Optimizer/Support/Utils.h" #include "flang/Runtime/entry-names.h" #include "mlir/Dialect/Complex/IR/Complex.h" @@ -948,6 +949,16 @@ return mlir::FunctionType::get(context, {t, t}, {t}); } +static mlir::FunctionType genF32F32F32F32FuncType(mlir::MLIRContext *context) { + auto t = mlir::FloatType::getF32(context); + return mlir::FunctionType::get(context, {t, t, t}, {t}); +} + +static mlir::FunctionType genF64F64F64F64FuncType(mlir::MLIRContext *context) { + auto t = mlir::FloatType::getF64(context); + return mlir::FunctionType::get(context, {t, t, t}, {t}); +} + template static mlir::FunctionType genIntF64FuncType(mlir::MLIRContext *context) { auto t = mlir::FloatType::getF64(context); @@ -1329,6 +1340,21 @@ genComplexMathOp}, }; +static constexpr MathOperation ppcMathOperations[] = { + {"__ppc_fmadd", "llvm.fma.f32", genF32F32F32F32FuncType, + genMathOp}, + {"__ppc_fmadd", "llvm.fma.f64", genF64F64F64F64FuncType, + genMathOp}, + {"__ppc_fmsub", "llvm.ppc.fmsubs", genF32F32F32F32FuncType, genLibCall}, + {"__ppc_fmsub", "llvm.ppc.fmsub", genF64F64F64F64FuncType, genLibCall}, + {"__ppc_fnmadd", "llvm.ppc.fnmadds", genF32F32F32F32FuncType, genLibCall}, + {"__ppc_fnmadd", "llvm.ppc.fnmadd", genF64F64F64F64FuncType, genLibCall}, + {"__ppc_fnmsub", "llvm.ppc.fnmsub.f32", genF32F32F32F32FuncType, + genLibCall}, + {"__ppc_fnmsub", "llvm.ppc.fnmsub.f64", genF64F64F64F64FuncType, + genLibCall}, +}; + // This helper class computes a "distance" between two function types. // The distance measures how many narrowing conversions of actual arguments // and result of "from" must be made in order to use "to" instead of "from". @@ -1473,6 +1499,10 @@ static constexpr RtMap mathOps(mathOperations); static_assert(mathOps.Verify() && "map must be sorted"); +// PPC +static constexpr RtMap ppcMathOps(ppcMathOperations); +static_assert(ppcMathOps.Verify() && "map must be sorted"); + /// Look for a MathOperation entry specifying how to lower a mathematical /// operation defined by \p name with its result' and operands' types /// specified in the form of a FunctionType \p funcType. @@ -1490,6 +1520,13 @@ const MathOperation **bestNearMatch, FunctionDistance &bestMatchDistance) { auto range = mathOps.equal_range(name); + auto mod = builder.getModule(); + + // TODO - check the triple here? + if (range.first == range.second && + fir::getTargetTriple(mod).getArch() == llvm::Triple::ppc64le) { + range = ppcMathOps.equal_range(name); + } for (auto iter = range.first; iter != range.second && iter; ++iter) { const auto &impl = *iter; auto implType = impl.typeGenerator(builder.getContext()); @@ -1619,7 +1656,7 @@ static bool isIntrinsicModuleProcedure(llvm::StringRef name) { return name.startswith("c_") || name.startswith("compiler_") || - name.startswith("ieee_"); + name.startswith("ieee_") || name.startswith("__ppc_"); } /// Return the generic name of an intrinsic module procedure specific name. Index: flang/lib/Semantics/resolve-names.cpp =================================================================== --- flang/lib/Semantics/resolve-names.cpp +++ flang/lib/Semantics/resolve-names.cpp @@ -7184,6 +7184,11 @@ if (IsIntrinsic(name.source, flag)) { symbol = &MakeSymbol(InclusiveScope(), name.source, Attrs{Attr::INTRINSIC}); + } else if (const auto extBuiltinScope = currScope().context().GetPPCBuiltinsScope()) { + // Check if it is a builtin from the predefined module + symbol = FindSymbol(*extBuiltinScope, name); + if (!symbol) + symbol = &MakeSymbol(context().globalScope(), name.source, Attrs{}); } else { symbol = &MakeSymbol(context().globalScope(), name.source, Attrs{}); } Index: flang/lib/Semantics/semantics.cpp =================================================================== --- flang/lib/Semantics/semantics.cpp +++ flang/lib/Semantics/semantics.cpp @@ -468,6 +468,15 @@ } } +void SemanticsContext::UsePPCFortranBuiltinsModule() { + if (ppcBuiltinsScope_ == nullptr) { + ppcBuiltinsScope_ = GetBuiltinModule("__fortran_ppc_intrinsics"); + if (ppcBuiltinsScope_) { + intrinsics_.SupplyPPCBuiltins(*ppcBuiltinsScope_); + } + } +} + parser::Program &SemanticsContext::SaveParseTree(parser::Program &&tree) { return modFileParseTrees_.emplace_back(std::move(tree)); } @@ -480,11 +489,15 @@ const auto *frontModule{std::get_if>( &program_.v.front().u)}; if (frontModule && - std::get>(frontModule->value().t) - .statement.v.source == "__fortran_builtins") { + (std::get>(frontModule->value().t) + .statement.v.source == "__fortran_builtins" || + std::get>(frontModule->value().t) + .statement.v.source == "__fortran_ppc_intrinsics")) { // Don't try to read the builtins module when we're actually building it. } else { context_.UseFortranBuiltinsModule(); + // TODO: check platform specific + context_.UsePPCFortranBuiltinsModule(); } } return ValidateLabels(context_, program_) && Index: flang/module/__fortran_ppc_intrinsics.f90 =================================================================== --- /dev/null +++ flang/module/__fortran_ppc_intrinsics.f90 @@ -0,0 +1,40 @@ +!===-- module/__fortran_ppc_intrinsics.f90 ---------------------------------===! +! +! Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +! See https://llvm.org/LICENSE.txt for license information. +! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +! +!===------------------------------------------------------------------------===! + +module __Fortran_PPC_intrinsics + +#define SPECIFICS_R(F,G) G(F,4) G(F,8) +#define PRIVATE_R(G) private :: __ppc_##G##_r4, __ppc_##G##_r8 + +#define F_R(FUNC, KND) \ + elemental real(KND) function __ppc_##FUNC##_r##KND(a, x, y); \ + real(KND), intent(in) :: a, x, y; \ + end function __ppc_##FUNC##_r##KND; + + interface fmadd + SPECIFICS_R(fmadd, F_R) + end interface fmadd + PRIVATE_R(fmadd) + + interface fmsub + SPECIFICS_R(fmsub, F_R) + end interface fmsub + PRIVATE_R(fmsub) + + interface fnmadd + SPECIFICS_R(fnmadd, F_R) + end interface fnmadd + PRIVATE_R(fnmadd) + + interface fnmsub + SPECIFICS_R(fnmsub, F_R) + end interface fnmsub + PRIVATE_R(fnmsub) +#undef F_R + +end module Index: flang/test/Lower/ppc-intrinsics.f90 =================================================================== --- /dev/null +++ flang/test/Lower/ppc-intrinsics.f90 @@ -0,0 +1,67 @@ +! RUN: bbc -emit-fir %s -outline-intrinsics -o - | FileCheck --check-prefixes="CHECK-FIR" %s +! RUN: %flang_fc1 -emit-llvm %s -o - | FileCheck --check-prefixes="CHECK-LLVMIR" %s +! REQUIRES: powerpc-registered-target + +! CHECK-LABEL: fmadd_testr +subroutine fmadd_testr(a, x, y) + real :: a, x, y, z + z = fmadd(a, x, y) +! CHECK-FIR: fir.call @fir.__ppc_fmadd.f32.f32.f32.f32 +! CHECK-LLVMIR: call contract float @llvm.fma.f32(float %{{[0-9]}}, float %{{[0-9]}}, float %{{[0-9]}}) +end + +! CHECK-LABEL: fmadd_testd +subroutine fmadd_testd(a, x, y) + real(8) :: a, x, y, z + z = fmadd(a, x, y) +! CHECK-FIR: fir.call @fir.__ppc_fmadd.f64.f64.f64.f64 +! CHECK-LLVMIR: call contract double @llvm.fma.f64(double %{{[0-9]}}, double %{{[0-9]}}, double %{{[0-9]}}) +end + +! CHECK-LABEL: fnmadd_testr +subroutine fnmadd_testr(a, x, y) + real :: a, x, y, z + z = fnmadd(a, x, y) +! CHECK-FIR: fir.call @fir.__ppc_fnmadd.f32.f32.f32.f32 +! CHECK-LLVMIR: call contract float @llvm.ppc.fnmadds(float %{{[0-9]}}, float %{{[0-9]}}, float %{{[0-9]}}) +end + +! CHECK-LABEL: fnmadd_testd +subroutine fnmadd_testd(a, x, y) + real(8) :: a, x, y, z + z = fnmadd(a, x, y) +! CHECK-FIR: fir.call @fir.__ppc_fnmadd.f64.f64.f64.f64 +! CHECK-LLVMIR: call contract double @llvm.ppc.fnmadd(double %{{[0-9]}}, double %{{[0-9]}}, double %{{[0-9]}}) +end + +! CHECK-LABEL: fmsub_testr +subroutine fmsub_testr(a, x, y) + real :: a, x, y, z + z = fmsub(a, x, y) +! CHECK-FIR: fir.call @fir.__ppc_fmsub.f32.f32.f32.f32 +! CHECK-LLVMIR: call contract float @llvm.ppc.fmsubs(float %{{[0-9]}}, float %{{[0-9]}}, float %{{[0-9]}}) +end + +! CHECK-LABEL: fmsub_testd +subroutine fmsub_testd(a, x, y) + real(8) :: a, x, y, z + z = fmsub(a, x, y) +! CHECK-FIR: fir.call @fir.__ppc_fmsub.f64.f64.f64.f64 +! CHECK-LLVMIR: call contract double @llvm.ppc.fmsub(double %{{[0-9]}}, double %{{[0-9]}}, double %{{[0-9]}}) +end + +! CHECK-LABEL: fnmsub_testr +subroutine fnmsub_testr(a, x, y) + real :: a, x, y, z + z = fnmsub(a, x, y) +! CHECK-FIR: fir.call @fir.__ppc_fnmsub.f32.f32.f32.f32 +! CHECK-LLVMIR: call contract float @llvm.ppc.fnmsub.f32(float %{{[0-9]}}, float %{{[0-9]}}, float %{{[0-9]}}) +end + +! CHECK-LABEL: fnmsub_testd +subroutine fnmsub_testd(a, x, y) + real(8) :: a, x, y, z + z = fnmsub(a, x, y) +! CHECK-FIR: fir.call @fir.__ppc_fnmsub.f64.f64.f64.f64 +! CHECK-LLVMIR: call contract double @llvm.ppc.fnmsub.f64(double %{{[0-9]}}, double %{{[0-9]}}, double %{{[0-9]}}) +end Index: flang/tools/f18/CMakeLists.txt =================================================================== --- flang/tools/f18/CMakeLists.txt +++ flang/tools/f18/CMakeLists.txt @@ -8,6 +8,7 @@ "__fortran_builtins" "__fortran_ieee_exceptions" "__fortran_type_info" + "__fortran_ppc_intrinsics" "ieee_arithmetic" "ieee_exceptions" "ieee_features" @@ -27,6 +28,8 @@ set(base ${FLANG_INTRINSIC_MODULES_DIR}/${filename}) if(${filename} STREQUAL "__fortran_builtins") set(depends "") + elseif(${filename} STREQUAL "__fortran_ppc_intrinsics") + set(depends "") else() set(depends ${FLANG_INTRINSIC_MODULES_DIR}/__fortran_builtins.mod) if(NOT ${filename} STREQUAL "__fortran_type_info")