[Flang] Map `ieee_fma` intrinsic to `llvm.fma`

[sunshaoce]

Summary

Map ieee_fma intrinsic to LLVM IR as llvm.fma.

[klausler]

Most target architectures support FMA and related instructions, and there's a standard IEEE_FMA generic function in the intrinsic module IEEE_ARITHMETIC in Fortran 2018. Please implement FMA in a way that is not just for RISC-V.

[sunshaoce]

Address @klausler's comment. And, I’m not sure if the fmadd intrinsic is in the right place in the intrinsic.md.

[klausler]

Don't add a new nonstandard intrinsic when the standard already has a standard name for FMA, namely the procedure IEEE_FMA in the intrinsic module IEEE_ARITHMETIC. See subclause 17.11.4 in Fortran 2018.

The technique that has worked for us in the implementation of other procedures in intrinsic modules is to first declare a builtin intrinsic procedure, say "builtin_fma", in the module fortran_builtins, and then rename it in the intrinsic module via "use fortran_builtins, only: ieee_fma => builtin_fma". Then implement "builtin_fma" like any other standard intrinsic function. If you look in fortran_builtins for declarations of other INTRINSIC procedures, you'll be able to find useful examples.

[sunshaoce]

@klausler, thanks for your detailed comments. I have tried to follow them.

[klausler]

flang/lib/Evaluate/intrinsics.cpp

884 ↗

(On Diff #528435)

IEEE_FMA doesn't work for COMPLEX. Use "SameReal" here, not "SameFloating".

[sunshaoce]

Replace SameFloating with SameReal

flang/include/flang/Semantics/semantics.h

public:
   void UseFortranBuiltinsModule();
   const Scope *GetBuiltinsScope() const { return builtinsScope_; }
 
   void UsePPCFortranBuiltinTypesModule();
   void UsePPCFortranBuiltinsModule();
   Scope *GetPPCBuiltinTypesScope() { return ppcBuiltinTypesScope_; }
   const Scope *GetPPCBuiltinsScope() const { return ppcBuiltinsScope_; }
 
+  void UseRISCVFortranBuiltinsModule();
+  const Scope *GetRISCVBuiltinsScope() const { return riscvBuiltinsScope_; }
+
   // Saves a module file's parse tree so that it remains available
   // during semantics.
   parser::Program &SaveParseTree(parser::Program &&);
 
   // Ensures a common block definition does not conflict with previous
   // appearances in the program and consolidate information about
   // common blocks at the program level for later checks and lowering.
   // This can obviously not check any conflicts between different compilation
private:
   };
   std::map<SymbolRef, const IndexVarInfo, SymbolAddressCompare>
       activeIndexVars_;
   UnorderedSymbolSet errorSymbols_;
   std::set<std::string> tempNames_;
   const Scope *builtinsScope_{nullptr}; // module __Fortran_builtins
   Scope *ppcBuiltinTypesScope_{nullptr}; // module __Fortran_PPC_types
   const Scope *ppcBuiltinsScope_{nullptr}; // module __Fortran_PPC_intrinsics
+  // module __Fortran_RISCV_intrinsics
+  const Scope *riscvBuiltinsScope_{nullptr};
   std::list<parser::Program> modFileParseTrees_;
   std::unique_ptr<CommonBlockMap> commonBlockMap_;
   bool anyDefinedIntrinsicOperator_{false};
 };
 
 class Semantics {
 public:
   explicit Semantics(SemanticsContext &context, parser::Program &program,

flang/lib/Optimizer/Builder/IntrinsicCall.cpp

static constexpr MathOperation ppcMathOperations[] = {
     {"__ppc_fnmsub", "llvm.ppc.fnmsub.f64", genF64F64F64F64FuncType,
      genLibCall},
     {"__ppc_fre", "llvm.ppc.fre", genF64F64FuncType, genLibCall},
     {"__ppc_fres", "llvm.ppc.fres", genF32F32FuncType, genLibCall},
     {"__ppc_frsqrte", "llvm.ppc.frsqrte", genF64F64FuncType, genLibCall},
     {"__ppc_frsqrtes", "llvm.ppc.frsqrtes", genF32F32FuncType, genLibCall},
 };
 
+static constexpr MathOperation riscvMathOperations[] = {
+    {"__riscv_fmadd", "llvm.fma.f32", genF32F32F32F32FuncType,
+     genMathOp<mlir::math::FmaOp>},
+    {"__riscv_fmadd", "llvm.fma.f64", genF64F64F64F64FuncType,
+     genMathOp<mlir::math::FmaOp>},
+};
+
 // 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".
 // For instance, the distance between ACOS(REAL(10)) and ACOS(REAL(8)) is
 // greater than the one between ACOS(REAL(10)) and ACOS(REAL(16)). This means
 // if no implementation of ACOS(REAL(10)) is available, it is better to use
 // ACOS(REAL(16)) with casts rather than ACOS(REAL(8)).
 // Note that this is not a symmetric distance and the order of "from" and "to"

 using RtMap = Fortran::common::StaticMultimapView<MathOperation>;
 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");
 
+// RISCV
+static constexpr RtMap riscvMathOps(riscvMathOperations);
+static_assert(riscvMathOps.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.
 /// If exact match for the given types is found, then the function
 /// returns a pointer to the corresponding MathOperation.
 /// Otherwise, the function returns nullptr.
 /// If there is a MathOperation that can be used with additional
 /// type casts for the operands or/and result (non-exact match),
 /// then it is returned via \p bestNearMatch argument, and
 /// \p bestMatchDistance specifies the FunctionDistance between
 /// the requested operation and the non-exact match.
 static const MathOperation *
 searchMathOperation(fir::FirOpBuilder &builder, llvm::StringRef name,
                     mlir::FunctionType funcType,
                     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);
   }
+  // Search riscvMathOps only if targetting RISCV arch
+  if (fir::getTargetTriple(mod).isRISCV() && range.first == range.second) {
+    range = riscvMathOps.equal_range(name);
+  }
   for (auto iter = range.first; iter != range.second && iter; ++iter) {
     const auto &impl = *iter;
     auto implType = impl.typeGenerator(builder.getContext());
     if (funcType == implType)
       return &impl; // exact match
 
     FunctionDistance distance(funcType, implType);
     if (distance.isSmallerThan(bestMatchDistance)) {

 }
 
 //===----------------------------------------------------------------------===//
 // IntrinsicLibrary
 //===----------------------------------------------------------------------===//
 
 static bool isIntrinsicModuleProcedure(llvm::StringRef name) {
   return name.startswith("c_") || name.startswith("compiler_") ||
-         name.startswith("ieee_") || name.startswith("__ppc_");
+         name.startswith("ieee_") || name.startswith("__ppc_") ||
+         name.startswith("__riscv_");
 }
 
 /// Return the generic name of an intrinsic module procedure specific name.
 /// Remove any "__builtin_" prefix, and any specific suffix of the form
 /// {_[ail]?[0-9]+}*, such as _1 or _a4.
 llvm::StringRef genericName(llvm::StringRef specificName) {
   const std::string builtin = "__builtin_";
   llvm::StringRef name = specificName.startswith(builtin)

flang/lib/Semantics/resolve-names.cpp

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 if (const auto riscvBuiltinScope =
+                   currScope().context().GetRISCVBuiltinsScope()) {
+      // Check if it is a builtin from the predefined module
+      symbol = FindSymbol(*riscvBuiltinScope, name);
+      if (!symbol)
+        symbol = &MakeSymbol(context().globalScope(), name.source, Attrs{});
     } else {
       symbol = &MakeSymbol(context().globalScope(), name.source, Attrs{});
     }
     Resolve(name, *symbol);
     ConvertToProcEntity(*symbol);
     if (!symbol->attrs().test(Attr::INTRINSIC)) {
       if (CheckImplicitNoneExternal(name.source, *symbol)) {
         MakeExternal(*symbol);

flang/lib/Semantics/semantics.cpp

 }
 
 void SemanticsContext::UsePPCFortranBuiltinsModule() {
   if (ppcBuiltinsScope_ == nullptr) {
     ppcBuiltinsScope_ = GetBuiltinModule("__fortran_ppc_intrinsics");
   }
 }
 
+void SemanticsContext::UseRISCVFortranBuiltinsModule() {
+  if (riscvBuiltinsScope_ == nullptr) {
+    riscvBuiltinsScope_ = GetBuiltinModule("__fortran_riscv_intrinsics");
+  }
+}
+
 parser::Program &SemanticsContext::SaveParseTree(parser::Program &&tree) {
   return modFileParseTrees_.emplace_back(std::move(tree));
 }
 
 bool Semantics::Perform() {
   // Implicitly USE the __Fortran_builtins module so that special types
   // (e.g., __builtin_team_type) are available to semantics, esp. for
   // intrinsic checking.
   if (!program_.v.empty()) {
     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_ppc_intrinsics" ||
             std::get<parser::Statement<parser::ModuleStmt>>(
                 frontModule->value().t)
-                    .statement.v.source == "__fortran_ppc_types")) {
+                    .statement.v.source == "__fortran_ppc_types" ||
+            std::get<parser::Statement<parser::ModuleStmt>>(
+                frontModule->value().t)
+                    .statement.v.source == "__fortran_riscv_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_.UsePPCFortranBuiltinTypesModule();
         context_.UsePPCFortranBuiltinsModule();
       }
+      if (targetTriple.isRISCV()) {
+        context_.UseRISCVFortranBuiltinsModule();
+      }
     }
   }
   return ValidateLabels(context_, program_) &&
       parser::CanonicalizeDo(program_) && // force line break
       CanonicalizeAcc(context_.messages(), program_) &&
       CanonicalizeOmp(context_.messages(), program_) &&
       PerformStatementSemantics(context_, program_) &&
       ModFileWriter{context_}.WriteAll();

flang/module/__fortran_riscv_intrinsics.f90

+!===-- module/__fortran_riscv_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_RISCV_intrinsics
+
+  private
+
+  ! fmadd
+  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) :: __riscv_fmadd_r4
+  procedure(func_r8r8r8r8) :: __riscv_fmadd_r8
+  interface fmadd
+    procedure :: __riscv_fmadd_r4
+    procedure :: __riscv_fmadd_r8
+  end interface fmadd
+  public :: fmadd
+
+end module __Fortran_RISCV_intrinsics

flang/test/Lower/riscv-intrinsics.f90

+! 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
+! RUN: %flang -S %s -o - | FileCheck --check-prefixes="CHECK-ASM" %s
+! REQUIRES: target=riscv{{.*}}
+
+! CHECK-LABEL: fmadd_s_test
+! CHECK-FIR: fir.call @fir.__riscv_fmadd.f32.f32.f32.f32
+! CHECK-LLVMIR: call contract float @llvm.fma.f32(float %{{[0-9]}}, float %{{[0-9]}}, float %{{[0-9]}})
+! CHECK-ASM: fmadd.s fa{{[0-9]}}, fa{{[0-9]}}, fa{{[0-9]}}, fa{{[0-9]}}
+subroutine fmadd_s_test(a, x, y)
+  real :: a, x, y, z
+  z = fmadd(a, x, y)
+end
+
+! CHECK-LABEL: fmadd_d_test
+! CHECK-FIR: fir.call @fir.__riscv_fmadd.f64.f64.f64.f64
+! CHECK-LLVMIR: call contract double @llvm.fma.f64(double %{{[0-9]}}, double %{{[0-9]}}, double %{{[0-9]}})
+! CHECK-ASM: fmadd.d fa{{[0-9]}}, fa{{[0-9]}}, fa{{[0-9]}}, fa{{[0-9]}}
+subroutine fmadd_d_test(a, x, y)
+  real(8) :: a, x, y, z
+  z = fmadd(a, x, y)
+end

flang/tools/f18/CMakeLists.txt

 set(LLVM_LINK_COMPONENTS
   FrontendOpenACC
   FrontendOpenMP
   Support
   )
 
 set(MODULES
   "__fortran_builtins"
   "__fortran_ieee_exceptions"
   "__fortran_type_info"
   "__fortran_ppc_types"
   "__fortran_ppc_intrinsics"
+  "__fortran_riscv_intrinsics"
   "ieee_arithmetic"
   "ieee_exceptions"
   "ieee_features"
   "iso_c_binding"
   "iso_fortran_env"
   "omp_lib"
   "__fortran_builtins"
   "__fortran_type_info"
 )
 
 # Create module files directly from the top-level module source directory.
 # If CMAKE_CROSSCOMPILING, then the newly built flang-new executable was
 # cross compiled, and thus can't be executed on the build system and thus
 # can't be used for generating module files.
 if (NOT CMAKE_CROSSCOMPILING)
   foreach(filename ${MODULES})
     set(base ${FLANG_INTRINSIC_MODULES_DIR}/${filename})
     if(${filename} STREQUAL "__fortran_builtins")
       set(depends "")
     elseif(${filename} STREQUAL "__fortran_ppc_types")
       set(depends "")
     elseif(${filename} STREQUAL "__fortran_ppc_intrinsics")
       set(depends ${FLANG_INTRINSIC_MODULES_DIR}/__fortran_ppc_types.mod)
+    elseif(${filename} STREQUAL "__fortran_riscv_intrinsics")
+      set(depends "")
     else()
       set(depends ${FLANG_INTRINSIC_MODULES_DIR}/__fortran_builtins.mod)
       if(NOT ${filename} STREQUAL "__fortran_type_info")
         set(depends ${FLANG_INTRINSIC_MODULES_DIR}/__fortran_type_info.mod)
       endif()
       if(${filename} STREQUAL "ieee_arithmetic" OR
          ${filename} STREQUAL "ieee_exceptions")
         set(depends ${FLANG_INTRINSIC_MODULES_DIR}/__fortran_ieee_exceptions.mod)