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<std::string> tempNames_;
const Scope *builtinsScope_{nullptr}; // module __Fortran_builtins
+ const Scope *ppcBuiltinsScope_{nullptr}; // PPC builtins
std::list<parser::Program> modFileParseTrees_;
std::unique_ptr<CommonBlockMap> 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<std::string, const SpecificIntrinsicInterface *> specificFuncs_;
std::multimap<std::string, const IntrinsicInterface *> subroutines_;
const semantics::Scope *builtinsScope_{nullptr};
+ const semantics::Scope *ppcBuiltinsScope_{nullptr};
std::map<std::string, std::string> 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 <int Bits>
static mlir::FunctionType genIntF64FuncType(mlir::MLIRContext *context) {
auto t = mlir::FloatType::getF64(context);
@@ -1329,6 +1340,21 @@
genComplexMathOp<mlir::complex::TanhOp>},
};
+static constexpr MathOperation ppcMathOperations[] = {
+ {"__ppc_fmadd", "llvm.fma.f32", genF32F32F32F32FuncType,
+ genMathOp<mlir::math::FmaOp>},
+ {"__ppc_fmadd", "llvm.fma.f64", genF64F64F64F64FuncType,
+ genMathOp<mlir::math::FmaOp>},
+ {"__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<common::Indirection<parser::Module>>(
&program_.v.front().u)};
if (frontModule &&
- std::get<parser::Statement<parser::ModuleStmt>>(frontModule->value().t)
- .statement.v.source == "__fortran_builtins") {
+ (std::get<parser::Statement<parser::ModuleStmt>>(frontModule->value().t)
+ .statement.v.source == "__fortran_builtins" ||
+ std::get<parser::Statement<parser::ModuleStmt>>(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")