diff --git a/flang/include/flang/Semantics/semantics.h b/flang/include/flang/Semantics/semantics.h index d37c1f6922adb..1c4654f6438b6 100644 --- a/flang/include/flang/Semantics/semantics.h +++ b/flang/include/flang/Semantics/semantics.h @@ -216,6 +216,9 @@ class SemanticsContext { 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 @@ class SemanticsContext { UnorderedSymbolSet errorSymbols_; std::set tempNames_; const Scope *builtinsScope_{nullptr}; // module __Fortran_builtins + const Scope *ppcBuiltinsScope_{nullptr}; // module __Fortran_PPC_intrinsics std::list modFileParseTrees_; std::unique_ptr commonBlockMap_; bool anyDefinedIntrinsicOperator_{false}; diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp index 49e34e60d3a7d..ed8c00b51e30d 100644 --- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp +++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp @@ -33,6 +33,7 @@ #include "flang/Optimizer/Builder/Runtime/Transformational.h" #include "flang/Optimizer/Builder/Todo.h" #include "flang/Optimizer/Dialect/FIROpsSupport.h" +#include "flang/Optimizer/Support/FIRContext.h" #include "flang/Optimizer/Support/FatalError.h" #include "flang/Optimizer/Support/Utils.h" #include "flang/Runtime/entry-names.h" @@ -948,6 +949,16 @@ static mlir::FunctionType genF128F128F128FuncType(mlir::MLIRContext *context) { 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 @@ static constexpr MathOperation mathOperations[] = { 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 @@ using RtMap = Fortran::common::StaticMultimapView; 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,12 @@ searchMathOperation(fir::FirOpBuilder &builder, llvm::StringRef name, const MathOperation **bestNearMatch, FunctionDistance &bestMatchDistance) { auto range = mathOps.equal_range(name); + auto mod = builder.getModule(); + + // Search ppcMathOps only if targetting PowerPC arch + if (fir::getTargetTriple(mod).isPPC() && range.first == range.second) { + 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 +1655,7 @@ mlir::Value toValue(const fir::ExtendedValue &val, fir::FirOpBuilder &builder, 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. diff --git a/flang/lib/Semantics/CMakeLists.txt b/flang/lib/Semantics/CMakeLists.txt index 54d4787c958a9..e8022e1261c8e 100644 --- a/flang/lib/Semantics/CMakeLists.txt +++ b/flang/lib/Semantics/CMakeLists.txt @@ -57,4 +57,5 @@ add_flang_library(FortranSemantics Support FrontendOpenMP FrontendOpenACC + TargetParser ) diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index fd425147c6c56..edd5a604632d5 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -7184,6 +7184,12 @@ void ResolveNamesVisitor::HandleProcedureName( if (IsIntrinsic(name.source, flag)) { symbol = &MakeSymbol(InclusiveScope(), name.source, Attrs{Attr::INTRINSIC}); + } else if (const auto ppcBuiltinScope = + currScope().context().GetPPCBuiltinsScope()) { + // Check if it is a builtin from the predefined module + symbol = FindSymbol(*ppcBuiltinScope, name); + if (!symbol) + symbol = &MakeSymbol(context().globalScope(), name.source, Attrs{}); } else { symbol = &MakeSymbol(context().globalScope(), name.source, Attrs{}); } diff --git a/flang/lib/Semantics/semantics.cpp b/flang/lib/Semantics/semantics.cpp index 20fd0ab6c6d45..65c44336a7438 100644 --- a/flang/lib/Semantics/semantics.cpp +++ b/flang/lib/Semantics/semantics.cpp @@ -42,6 +42,8 @@ #include "flang/Semantics/scope.h" #include "flang/Semantics/symbol.h" #include "llvm/Support/raw_ostream.h" +#include "llvm/TargetParser/Host.h" +#include "llvm/TargetParser/Triple.h" namespace Fortran::semantics { @@ -468,6 +470,12 @@ void SemanticsContext::UseFortranBuiltinsModule() { } } +void SemanticsContext::UsePPCFortranBuiltinsModule() { + if (ppcBuiltinsScope_ == nullptr) { + ppcBuiltinsScope_ = GetBuiltinModule("__fortran_ppc_intrinsics"); + } +} + parser::Program &SemanticsContext::SaveParseTree(parser::Program &&tree) { return modFileParseTrees_.emplace_back(std::move(tree)); } @@ -480,11 +488,20 @@ bool Semantics::Perform() { 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(); + llvm::Triple targetTriple{llvm::Triple( + llvm::Triple::normalize(llvm::sys::getDefaultTargetTriple()))}; + // Only use __Fortran_PPC_intrinsics module when targetting PowerPC arch + if (targetTriple.isPPC()) { + context_.UsePPCFortranBuiltinsModule(); + } } } return ValidateLabels(context_, program_) && diff --git a/flang/module/__fortran_ppc_intrinsics.f90 b/flang/module/__fortran_ppc_intrinsics.f90 new file mode 100644 index 0000000000000..9b83239731020 --- /dev/null +++ b/flang/module/__fortran_ppc_intrinsics.f90 @@ -0,0 +1,55 @@ +!===-- 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 + + private + +! fmadd, fmsub, fnmadd, fnmsub + abstract interface + elemental real(4) function func_r4r4r4r4(a, x, y) + real(4), intent(in) :: a, x, y + end function func_r4r4r4r4 + elemental real(8) function func_r8r8r8r8(a, x, y) + real(8), intent(in) :: a, x, y + end function func_r8r8r8r8 + end interface + + procedure(func_r4r4r4r4) :: __ppc_fmadd_r4 + procedure(func_r8r8r8r8) :: __ppc_fmadd_r8 + interface fmadd + procedure :: __ppc_fmadd_r4 + procedure :: __ppc_fmadd_r8 + end interface fmadd + public :: fmadd + + procedure(func_r4r4r4r4) :: __ppc_fmsub_r4 + procedure(func_r8r8r8r8) :: __ppc_fmsub_r8 + interface fmsub + procedure :: __ppc_fmsub_r4 + procedure :: __ppc_fmsub_r8 + end interface fmsub + public :: fmsub + + procedure(func_r4r4r4r4) :: __ppc_fnmadd_r4 + procedure(func_r8r8r8r8) :: __ppc_fnmadd_r8 + interface fnmadd + procedure :: __ppc_fnmadd_r4 + procedure :: __ppc_fnmadd_r8 + end interface fnmadd + public :: fnmadd + + procedure(func_r4r4r4r4) :: __ppc_fnmsub_r4 + procedure(func_r8r8r8r8) :: __ppc_fnmsub_r8 + interface fnmsub + procedure :: __ppc_fnmsub_r4 + procedure :: __ppc_fnmsub_r8 + end interface fnmsub + public :: fnmsub + +end module __Fortran_PPC_intrinsics diff --git a/flang/test/Lower/ppc-intrinsics.f90 b/flang/test/Lower/ppc-intrinsics.f90 new file mode 100644 index 0000000000000..293a35a63b061 --- /dev/null +++ b/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: target=powerpc{{.*}} + +! 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 diff --git a/flang/tools/f18/CMakeLists.txt b/flang/tools/f18/CMakeLists.txt index b046850557d0f..71de5e71ae5e3 100644 --- a/flang/tools/f18/CMakeLists.txt +++ b/flang/tools/f18/CMakeLists.txt @@ -8,6 +8,7 @@ set(MODULES "__fortran_builtins" "__fortran_ieee_exceptions" "__fortran_type_info" + "__fortran_ppc_intrinsics" "ieee_arithmetic" "ieee_exceptions" "ieee_features" @@ -27,6 +28,8 @@ if (NOT CMAKE_CROSSCOMPILING) 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")