aboutsummaryrefslogtreecommitdiff
path: root/flang/lib
diff options
context:
space:
mode:
Diffstat (limited to 'flang/lib')
-rw-r--r--flang/lib/Frontend/CompilerInvocation.cpp9
-rw-r--r--flang/lib/Frontend/FrontendAction.cpp11
-rw-r--r--flang/lib/Lower/OpenMP/OpenMP.cpp84
-rw-r--r--flang/lib/Lower/OpenMP/ReductionProcessor.cpp137
-rw-r--r--flang/lib/Lower/OpenMP/ReductionProcessor.h18
-rw-r--r--flang/lib/Optimizer/Builder/IntrinsicCall.cpp9
-rw-r--r--flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp29
-rw-r--r--flang/lib/Semantics/check-omp-structure.cpp2
8 files changed, 253 insertions, 46 deletions
diff --git a/flang/lib/Frontend/CompilerInvocation.cpp b/flang/lib/Frontend/CompilerInvocation.cpp
index 4707de0..2e3fa1f 100644
--- a/flang/lib/Frontend/CompilerInvocation.cpp
+++ b/flang/lib/Frontend/CompilerInvocation.cpp
@@ -581,6 +581,8 @@ static bool parseFrontendArgs(FrontendOptions &opts, llvm::opt::ArgList &args,
// pre-processed inputs.
.Case("f95", Language::Fortran)
.Case("f95-cpp-input", Language::Fortran)
+ // CUDA Fortran
+ .Case("cuda", Language::Fortran)
.Default(Language::Unknown);
// Flang's intermediate representations.
@@ -877,6 +879,13 @@ static bool parseDialectArgs(CompilerInvocation &res, llvm::opt::ArgList &args,
if (args.hasArg(clang::driver::options::OPT_flarge_sizes))
res.getDefaultKinds().set_sizeIntegerKind(8);
+ // -x cuda
+ auto language = args.getLastArgValue(clang::driver::options::OPT_x);
+ if (language.equals("cuda")) {
+ res.getFrontendOpts().features.Enable(
+ Fortran::common::LanguageFeature::CUDA);
+ }
+
// -fopenmp and -fopenacc
if (args.hasArg(clang::driver::options::OPT_fopenacc)) {
res.getFrontendOpts().features.Enable(
diff --git a/flang/lib/Frontend/FrontendAction.cpp b/flang/lib/Frontend/FrontendAction.cpp
index 599b4e1..bb1c239 100644
--- a/flang/lib/Frontend/FrontendAction.cpp
+++ b/flang/lib/Frontend/FrontendAction.cpp
@@ -86,9 +86,14 @@ bool FrontendAction::beginSourceFile(CompilerInstance &ci,
invoc.collectMacroDefinitions();
}
- // Enable CUDA Fortran if source file is *.cuf/*.CUF.
- invoc.getFortranOpts().features.Enable(Fortran::common::LanguageFeature::CUDA,
- getCurrentInput().getIsCUDAFortran());
+ if (!invoc.getFortranOpts().features.IsEnabled(
+ Fortran::common::LanguageFeature::CUDA)) {
+ // Enable CUDA Fortran if source file is *.cuf/*.CUF and not already
+ // enabled.
+ invoc.getFortranOpts().features.Enable(
+ Fortran::common::LanguageFeature::CUDA,
+ getCurrentInput().getIsCUDAFortran());
+ }
// Decide between fixed and free form (if the user didn't express any
// preference, use the file extension to decide)
diff --git a/flang/lib/Lower/OpenMP/OpenMP.cpp b/flang/lib/Lower/OpenMP/OpenMP.cpp
index 4f0bb80c..25bb4d9 100644
--- a/flang/lib/Lower/OpenMP/OpenMP.cpp
+++ b/flang/lib/Lower/OpenMP/OpenMP.cpp
@@ -601,6 +601,10 @@ genParallelOp(Fortran::lower::AbstractConverter &converter,
return reductionSymbols;
};
+ mlir::UnitAttr byrefAttr;
+ if (ReductionProcessor::doReductionByRef(reductionVars))
+ byrefAttr = converter.getFirOpBuilder().getUnitAttr();
+
OpWithBodyGenInfo genInfo =
OpWithBodyGenInfo(converter, semaCtx, currentLocation, eval)
.setGenNested(genNested)
@@ -620,7 +624,7 @@ genParallelOp(Fortran::lower::AbstractConverter &converter,
: mlir::ArrayAttr::get(converter.getFirOpBuilder().getContext(),
reductionDeclSymbols),
procBindKindAttr, /*private_vars=*/llvm::SmallVector<mlir::Value>{},
- /*privatizers=*/nullptr);
+ /*privatizers=*/nullptr, byrefAttr);
}
bool privatize = !outerCombined;
@@ -684,7 +688,8 @@ genParallelOp(Fortran::lower::AbstractConverter &converter,
delayedPrivatizationInfo.privatizers.empty()
? nullptr
: mlir::ArrayAttr::get(converter.getFirOpBuilder().getContext(),
- privatizers));
+ privatizers),
+ byrefAttr);
}
static mlir::omp::SectionOp
@@ -793,6 +798,58 @@ genTaskGroupOp(Fortran::lower::AbstractConverter &converter,
/*task_reductions=*/nullptr, allocateOperands, allocatorOperands);
}
+// This helper function implements the functionality of "promoting"
+// non-CPTR arguments of use_device_ptr to use_device_addr
+// arguments (automagic conversion of use_device_ptr ->
+// use_device_addr in these cases). The way we do so currently is
+// through the shuffling of operands from the devicePtrOperands to
+// deviceAddrOperands where neccesary and re-organizing the types,
+// locations and symbols to maintain the correct ordering of ptr/addr
+// input -> BlockArg.
+//
+// This effectively implements some deprecated OpenMP functionality
+// that some legacy applications unfortunately depend on
+// (deprecated in specification version 5.2):
+//
+// "If a list item in a use_device_ptr clause is not of type C_PTR,
+// the behavior is as if the list item appeared in a use_device_addr
+// clause. Support for such list items in a use_device_ptr clause
+// is deprecated."
+static void promoteNonCPtrUseDevicePtrArgsToUseDeviceAddr(
+ llvm::SmallVector<mlir::Value> &devicePtrOperands,
+ llvm::SmallVector<mlir::Value> &deviceAddrOperands,
+ llvm::SmallVector<mlir::Type> &useDeviceTypes,
+ llvm::SmallVector<mlir::Location> &useDeviceLocs,
+ llvm::SmallVector<const Fortran::semantics::Symbol *> &useDeviceSymbols) {
+ auto moveElementToBack = [](size_t idx, auto &vector) {
+ auto *iter = std::next(vector.begin(), idx);
+ vector.push_back(*iter);
+ vector.erase(iter);
+ };
+
+ // Iterate over our use_device_ptr list and shift all non-cptr arguments into
+ // use_device_addr.
+ for (auto *it = devicePtrOperands.begin(); it != devicePtrOperands.end();) {
+ if (!fir::isa_builtin_cptr_type(fir::unwrapRefType(it->getType()))) {
+ deviceAddrOperands.push_back(*it);
+ // We have to shuffle the symbols around as well, to maintain
+ // the correct Input -> BlockArg for use_device_ptr/use_device_addr.
+ // NOTE: However, as map's do not seem to be included currently
+ // this isn't as pertinent, but we must try to maintain for
+ // future alterations. I believe the reason they are not currently
+ // is that the BlockArg assign/lowering needs to be extended
+ // to a greater set of types.
+ auto idx = std::distance(devicePtrOperands.begin(), it);
+ moveElementToBack(idx, useDeviceTypes);
+ moveElementToBack(idx, useDeviceLocs);
+ moveElementToBack(idx, useDeviceSymbols);
+ it = devicePtrOperands.erase(it);
+ continue;
+ }
+ ++it;
+ }
+}
+
static mlir::omp::DataOp
genDataOp(Fortran::lower::AbstractConverter &converter,
Fortran::semantics::SemanticsContext &semaCtx,
@@ -815,6 +872,20 @@ genDataOp(Fortran::lower::AbstractConverter &converter,
useDeviceSymbols);
cp.processUseDeviceAddr(deviceAddrOperands, useDeviceTypes, useDeviceLocs,
useDeviceSymbols);
+ // This function implements the deprecated functionality of use_device_ptr
+ // that allows users to provide non-CPTR arguments to it with the caveat
+ // that the compiler will treat them as use_device_addr. A lot of legacy
+ // code may still depend on this functionality, so we should support it
+ // in some manner. We do so currently by simply shifting non-cptr operands
+ // from the use_device_ptr list into the front of the use_device_addr list
+ // whilst maintaining the ordering of useDeviceLocs, useDeviceSymbols and
+ // useDeviceTypes to use_device_ptr/use_device_addr input for BlockArg
+ // ordering.
+ // TODO: Perhaps create a user provideable compiler option that will
+ // re-introduce a hard-error rather than a warning in these cases.
+ promoteNonCPtrUseDevicePtrArgsToUseDeviceAddr(
+ devicePtrOperands, deviceAddrOperands, useDeviceTypes, useDeviceLocs,
+ useDeviceSymbols);
cp.processMap(currentLocation, llvm::omp::Directive::OMPD_target_data,
stmtCtx, mapOperands);
@@ -1583,7 +1654,7 @@ static void createWsLoop(Fortran::lower::AbstractConverter &converter,
llvm::SmallVector<const Fortran::semantics::Symbol *> reductionSymbols;
mlir::omp::ClauseOrderKindAttr orderClauseOperand;
mlir::omp::ClauseScheduleKindAttr scheduleValClauseOperand;
- mlir::UnitAttr nowaitClauseOperand, scheduleSimdClauseOperand;
+ mlir::UnitAttr nowaitClauseOperand, byrefOperand, scheduleSimdClauseOperand;
mlir::IntegerAttr orderedClauseOperand;
mlir::omp::ScheduleModifierAttr scheduleModClauseOperand;
std::size_t loopVarTypeSize;
@@ -1600,6 +1671,9 @@ static void createWsLoop(Fortran::lower::AbstractConverter &converter,
convertLoopBounds(converter, loc, lowerBound, upperBound, step,
loopVarTypeSize);
+ if (ReductionProcessor::doReductionByRef(reductionVars))
+ byrefOperand = firOpBuilder.getUnitAttr();
+
auto wsLoopOp = firOpBuilder.create<mlir::omp::WsLoopOp>(
loc, lowerBound, upperBound, step, linearVars, linearStepVars,
reductionVars,
@@ -1609,8 +1683,8 @@ static void createWsLoop(Fortran::lower::AbstractConverter &converter,
reductionDeclSymbols),
scheduleValClauseOperand, scheduleChunkClauseOperand,
/*schedule_modifiers=*/nullptr,
- /*simd_modifier=*/nullptr, nowaitClauseOperand, orderedClauseOperand,
- orderClauseOperand,
+ /*simd_modifier=*/nullptr, nowaitClauseOperand, byrefOperand,
+ orderedClauseOperand, orderClauseOperand,
/*inclusive=*/firOpBuilder.getUnitAttr());
// Handle attribute based clauses.
diff --git a/flang/lib/Lower/OpenMP/ReductionProcessor.cpp b/flang/lib/Lower/OpenMP/ReductionProcessor.cpp
index a8b98f3..e6a63dd 100644
--- a/flang/lib/Lower/OpenMP/ReductionProcessor.cpp
+++ b/flang/lib/Lower/OpenMP/ReductionProcessor.cpp
@@ -14,9 +14,16 @@
#include "flang/Lower/AbstractConverter.h"
#include "flang/Optimizer/Builder/Todo.h"
+#include "flang/Optimizer/Dialect/FIRType.h"
#include "flang/Optimizer/HLFIR/HLFIROps.h"
#include "flang/Parser/tools.h"
#include "mlir/Dialect/OpenMP/OpenMPDialect.h"
+#include "llvm/Support/CommandLine.h"
+
+static llvm::cl::opt<bool> forceByrefReduction(
+ "force-byref-reduction",
+ llvm::cl::desc("Pass all reduction arguments by reference"),
+ llvm::cl::Hidden);
namespace Fortran {
namespace lower {
@@ -76,16 +83,24 @@ bool ReductionProcessor::supportedIntrinsicProcReduction(
}
std::string ReductionProcessor::getReductionName(llvm::StringRef name,
- mlir::Type ty) {
+ mlir::Type ty, bool isByRef) {
+ ty = fir::unwrapRefType(ty);
+
+ // extra string to distinguish reduction functions for variables passed by
+ // reference
+ llvm::StringRef byrefAddition{""};
+ if (isByRef)
+ byrefAddition = "_byref";
+
return (llvm::Twine(name) +
(ty.isIntOrIndex() ? llvm::Twine("_i_") : llvm::Twine("_f_")) +
- llvm::Twine(ty.getIntOrFloatBitWidth()))
+ llvm::Twine(ty.getIntOrFloatBitWidth()) + byrefAddition)
.str();
}
std::string ReductionProcessor::getReductionName(
Fortran::parser::DefinedOperator::IntrinsicOperator intrinsicOp,
- mlir::Type ty) {
+ mlir::Type ty, bool isByRef) {
std::string reductionName;
switch (intrinsicOp) {
@@ -108,13 +123,14 @@ std::string ReductionProcessor::getReductionName(
break;
}
- return getReductionName(reductionName, ty);
+ return getReductionName(reductionName, ty, isByRef);
}
mlir::Value
ReductionProcessor::getReductionInitValue(mlir::Location loc, mlir::Type type,
ReductionIdentifier redId,
fir::FirOpBuilder &builder) {
+ type = fir::unwrapRefType(type);
assert((fir::isa_integer(type) || fir::isa_real(type) ||
type.isa<fir::LogicalType>()) &&
"only integer, logical and real types are currently supported");
@@ -188,6 +204,7 @@ mlir::Value ReductionProcessor::createScalarCombiner(
fir::FirOpBuilder &builder, mlir::Location loc, ReductionIdentifier redId,
mlir::Type type, mlir::Value op1, mlir::Value op2) {
mlir::Value reductionOp;
+ type = fir::unwrapRefType(type);
switch (redId) {
case ReductionIdentifier::MAX:
reductionOp =
@@ -268,7 +285,8 @@ mlir::Value ReductionProcessor::createScalarCombiner(
mlir::omp::ReductionDeclareOp ReductionProcessor::createReductionDecl(
fir::FirOpBuilder &builder, llvm::StringRef reductionOpName,
- const ReductionIdentifier redId, mlir::Type type, mlir::Location loc) {
+ const ReductionIdentifier redId, mlir::Type type, mlir::Location loc,
+ bool isByRef) {
mlir::OpBuilder::InsertionGuard guard(builder);
mlir::ModuleOp module = builder.getModule();
@@ -278,14 +296,24 @@ mlir::omp::ReductionDeclareOp ReductionProcessor::createReductionDecl(
return decl;
mlir::OpBuilder modBuilder(module.getBodyRegion());
+ mlir::Type valTy = fir::unwrapRefType(type);
+ if (!isByRef)
+ type = valTy;
decl = modBuilder.create<mlir::omp::ReductionDeclareOp>(loc, reductionOpName,
type);
builder.createBlock(&decl.getInitializerRegion(),
decl.getInitializerRegion().end(), {type}, {loc});
builder.setInsertionPointToEnd(&decl.getInitializerRegion().back());
+
mlir::Value init = getReductionInitValue(loc, type, redId, builder);
- builder.create<mlir::omp::YieldOp>(loc, init);
+ if (isByRef) {
+ mlir::Value alloca = builder.create<fir::AllocaOp>(loc, valTy);
+ builder.createStoreWithConvert(loc, init, alloca);
+ builder.create<mlir::omp::YieldOp>(loc, alloca);
+ } else {
+ builder.create<mlir::omp::YieldOp>(loc, init);
+ }
builder.createBlock(&decl.getReductionRegion(),
decl.getReductionRegion().end(), {type, type},
@@ -294,14 +322,45 @@ mlir::omp::ReductionDeclareOp ReductionProcessor::createReductionDecl(
builder.setInsertionPointToEnd(&decl.getReductionRegion().back());
mlir::Value op1 = decl.getReductionRegion().front().getArgument(0);
mlir::Value op2 = decl.getReductionRegion().front().getArgument(1);
+ mlir::Value outAddr = op1;
+
+ op1 = builder.loadIfRef(loc, op1);
+ op2 = builder.loadIfRef(loc, op2);
mlir::Value reductionOp =
createScalarCombiner(builder, loc, redId, type, op1, op2);
- builder.create<mlir::omp::YieldOp>(loc, reductionOp);
+ if (isByRef) {
+ builder.create<fir::StoreOp>(loc, reductionOp, outAddr);
+ builder.create<mlir::omp::YieldOp>(loc, outAddr);
+ } else {
+ builder.create<mlir::omp::YieldOp>(loc, reductionOp);
+ }
return decl;
}
+// TODO: By-ref vs by-val reductions are currently toggled for the whole
+// operation (possibly effecting multiple reduction variables).
+// This could cause a problem with openmp target reductions because
+// by-ref trivial types may not be supported.
+bool ReductionProcessor::doReductionByRef(
+ const llvm::SmallVectorImpl<mlir::Value> &reductionVars) {
+ if (reductionVars.empty())
+ return false;
+ if (forceByrefReduction)
+ return true;
+
+ for (mlir::Value reductionVar : reductionVars) {
+ if (auto declare =
+ mlir::dyn_cast<hlfir::DeclareOp>(reductionVar.getDefiningOp()))
+ reductionVar = declare.getMemref();
+
+ if (!fir::isa_trivial(fir::unwrapRefType(reductionVar.getType())))
+ return true;
+ }
+ return false;
+}
+
void ReductionProcessor::addReductionDecl(
mlir::Location currentLocation,
Fortran::lower::AbstractConverter &converter,
@@ -315,6 +374,37 @@ void ReductionProcessor::addReductionDecl(
const auto &redOperator{
std::get<Fortran::parser::OmpReductionOperator>(reduction.t)};
const auto &objectList{std::get<Fortran::parser::OmpObjectList>(reduction.t)};
+
+ if (!std::holds_alternative<Fortran::parser::DefinedOperator>(
+ redOperator.u)) {
+ if (const auto *reductionIntrinsic =
+ std::get_if<Fortran::parser::ProcedureDesignator>(&redOperator.u)) {
+ if (!ReductionProcessor::supportedIntrinsicProcReduction(
+ *reductionIntrinsic)) {
+ return;
+ }
+ } else {
+ return;
+ }
+ }
+
+ // initial pass to collect all recuction vars so we can figure out if this
+ // should happen byref
+ for (const Fortran::parser::OmpObject &ompObject : objectList.v) {
+ if (const auto *name{
+ Fortran::parser::Unwrap<Fortran::parser::Name>(ompObject)}) {
+ if (const Fortran::semantics::Symbol * symbol{name->symbol}) {
+ if (reductionSymbols)
+ reductionSymbols->push_back(symbol);
+ mlir::Value symVal = converter.getSymbolAddress(*symbol);
+ if (auto declOp = symVal.getDefiningOp<hlfir::DeclareOp>())
+ symVal = declOp.getBase();
+ reductionVars.push_back(symVal);
+ }
+ }
+ }
+ const bool isByRef = doReductionByRef(reductionVars);
+
if (const auto &redDefinedOp =
std::get_if<Fortran::parser::DefinedOperator>(&redOperator.u)) {
const auto &intrinsicOp{
@@ -338,23 +428,20 @@ void ReductionProcessor::addReductionDecl(
if (const auto *name{
Fortran::parser::Unwrap<Fortran::parser::Name>(ompObject)}) {
if (const Fortran::semantics::Symbol * symbol{name->symbol}) {
- if (reductionSymbols)
- reductionSymbols->push_back(symbol);
mlir::Value symVal = converter.getSymbolAddress(*symbol);
if (auto declOp = symVal.getDefiningOp<hlfir::DeclareOp>())
symVal = declOp.getBase();
- mlir::Type redType =
- symVal.getType().cast<fir::ReferenceType>().getEleTy();
- reductionVars.push_back(symVal);
- if (redType.isa<fir::LogicalType>())
+ auto redType = symVal.getType().cast<fir::ReferenceType>();
+ if (redType.getEleTy().isa<fir::LogicalType>())
decl = createReductionDecl(
firOpBuilder,
- getReductionName(intrinsicOp, firOpBuilder.getI1Type()), redId,
- redType, currentLocation);
- else if (redType.isIntOrIndexOrFloat()) {
- decl = createReductionDecl(firOpBuilder,
- getReductionName(intrinsicOp, redType),
- redId, redType, currentLocation);
+ getReductionName(intrinsicOp, firOpBuilder.getI1Type(),
+ isByRef),
+ redId, redType, currentLocation, isByRef);
+ else if (redType.getEleTy().isIntOrIndexOrFloat()) {
+ decl = createReductionDecl(
+ firOpBuilder, getReductionName(intrinsicOp, redType, isByRef),
+ redId, redType, currentLocation, isByRef);
} else {
TODO(currentLocation, "Reduction of some types is not supported");
}
@@ -374,21 +461,17 @@ void ReductionProcessor::addReductionDecl(
if (const auto *name{
Fortran::parser::Unwrap<Fortran::parser::Name>(ompObject)}) {
if (const Fortran::semantics::Symbol * symbol{name->symbol}) {
- if (reductionSymbols)
- reductionSymbols->push_back(symbol);
mlir::Value symVal = converter.getSymbolAddress(*symbol);
if (auto declOp = symVal.getDefiningOp<hlfir::DeclareOp>())
symVal = declOp.getBase();
- mlir::Type redType =
- symVal.getType().cast<fir::ReferenceType>().getEleTy();
- reductionVars.push_back(symVal);
- assert(redType.isIntOrIndexOrFloat() &&
+ auto redType = symVal.getType().cast<fir::ReferenceType>();
+ assert(redType.getEleTy().isIntOrIndexOrFloat() &&
"Unsupported reduction type");
decl = createReductionDecl(
firOpBuilder,
getReductionName(getRealName(*reductionIntrinsic).ToString(),
- redType),
- redId, redType, currentLocation);
+ redType, isByRef),
+ redId, redType, currentLocation, isByRef);
reductionDeclSymbols.push_back(mlir::SymbolRefAttr::get(
firOpBuilder.getContext(), decl.getSymName()));
}
diff --git a/flang/lib/Lower/OpenMP/ReductionProcessor.h b/flang/lib/Lower/OpenMP/ReductionProcessor.h
index 00770fe..679580f 100644
--- a/flang/lib/Lower/OpenMP/ReductionProcessor.h
+++ b/flang/lib/Lower/OpenMP/ReductionProcessor.h
@@ -14,6 +14,7 @@
#define FORTRAN_LOWER_REDUCTIONPROCESSOR_H
#include "flang/Optimizer/Builder/FIRBuilder.h"
+#include "flang/Optimizer/Dialect/FIRType.h"
#include "flang/Parser/parse-tree.h"
#include "flang/Semantics/symbol.h"
#include "flang/Semantics/type.h"
@@ -71,11 +72,15 @@ public:
static const Fortran::semantics::SourceName
getRealName(const Fortran::parser::ProcedureDesignator &pd);
- static std::string getReductionName(llvm::StringRef name, mlir::Type ty);
+ static bool
+ doReductionByRef(const llvm::SmallVectorImpl<mlir::Value> &reductionVars);
+
+ static std::string getReductionName(llvm::StringRef name, mlir::Type ty,
+ bool isByRef);
static std::string getReductionName(
Fortran::parser::DefinedOperator::IntrinsicOperator intrinsicOp,
- mlir::Type ty);
+ mlir::Type ty, bool isByRef);
/// This function returns the identity value of the operator \p
/// reductionOpName. For example:
@@ -103,9 +108,11 @@ public:
/// symbol table. The declaration has a constant initializer with the neutral
/// value `initValue`, and the reduction combiner carried over from `reduce`.
/// TODO: Generalize this for non-integer types, add atomic region.
- static mlir::omp::ReductionDeclareOp createReductionDecl(
- fir::FirOpBuilder &builder, llvm::StringRef reductionOpName,
- const ReductionIdentifier redId, mlir::Type type, mlir::Location loc);
+ static mlir::omp::ReductionDeclareOp
+ createReductionDecl(fir::FirOpBuilder &builder,
+ llvm::StringRef reductionOpName,
+ const ReductionIdentifier redId, mlir::Type type,
+ mlir::Location loc, bool isByRef);
/// Creates a reduction declaration and associates it with an OpenMP block
/// directive.
@@ -124,6 +131,7 @@ mlir::Value
ReductionProcessor::getReductionOperation(fir::FirOpBuilder &builder,
mlir::Type type, mlir::Location loc,
mlir::Value op1, mlir::Value op2) {
+ type = fir::unwrapRefType(type);
assert(type.isIntOrIndexOrFloat() &&
"only integer and float types are currently supported");
if (type.isIntOrIndex())
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index ca5ab6f..94fcfa3 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -922,6 +922,8 @@ mlir::Value genComplexMathOp(fir::FirOpBuilder &builder, mlir::Location loc,
constexpr auto FuncTypeReal16Real16 = genFuncType<Ty::Real<16>, Ty::Real<16>>;
constexpr auto FuncTypeReal16Real16Real16 =
genFuncType<Ty::Real<16>, Ty::Real<16>, Ty::Real<16>>;
+constexpr auto FuncTypeReal16Real16Real16Real16 =
+ genFuncType<Ty::Real<16>, Ty::Real<16>, Ty::Real<16>, Ty::Real<16>>;
constexpr auto FuncTypeReal16Integer4Real16 =
genFuncType<Ty::Real<16>, Ty::Integer<4>, Ty::Real<16>>;
constexpr auto FuncTypeInteger4Real16 =
@@ -1143,6 +1145,8 @@ static constexpr MathOperation mathOperations[] = {
{"fma", "llvm.fma.f64",
genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Real<8>, Ty::Real<8>>,
genMathOp<mlir::math::FmaOp>},
+ {"fma", RTNAME_STRING(FmaF128), FuncTypeReal16Real16Real16Real16,
+ genLibF128Call},
{"gamma", "tgammaf", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall},
{"gamma", "tgamma", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall},
{"gamma", RTNAME_STRING(TgammaF128), FuncTypeReal16Real16, genLibF128Call},
@@ -5208,6 +5212,8 @@ mlir::Value IntrinsicLibrary::genMod(mlir::Type resultType,
// MODULO
mlir::Value IntrinsicLibrary::genModulo(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args) {
+ // TODO: we'd better generate a runtime call here, when runtime error
+ // checking is needed (to detect 0 divisor) or when precise math is requested.
assert(args.size() == 2);
// No floored modulo op in LLVM/MLIR yet. TODO: add one to MLIR.
// In the meantime, use a simple inlined implementation based on truncated
@@ -5233,10 +5239,7 @@ mlir::Value IntrinsicLibrary::genModulo(mlir::Type resultType,
return builder.create<mlir::arith::SelectOp>(loc, mustAddP, remPlusP,
remainder);
}
- // Real case
- if (resultType == mlir::FloatType::getF128(builder.getContext()))
- TODO(loc, "REAL(KIND=16): in MODULO intrinsic");
auto remainder = builder.create<mlir::arith::RemFOp>(loc, args[0], args[1]);
mlir::Value zero = builder.createRealZeroConstant(loc, remainder.getType());
auto remainderIsNotZero = builder.create<mlir::arith::CmpFOp>(
diff --git a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
index 638bfd6..57c47da 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
@@ -27,6 +27,24 @@
using namespace Fortran::runtime;
+namespace {
+/// Placeholder for real*16 version of RandomNumber Intrinsic
+struct ForcedRandomNumberReal16 {
+ static constexpr const char *name = ExpandAndQuoteKey(RTNAME(RandomNumber16));
+ static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+ return [](mlir::MLIRContext *ctx) {
+ auto boxTy =
+ fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
+ auto strTy = fir::runtime::getModel<const char *>()(ctx);
+ auto intTy = fir::runtime::getModel<int>()(ctx);
+ ;
+ return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy},
+ mlir::NoneType::get(ctx));
+ };
+ }
+};
+} // namespace
+
mlir::Value fir::runtime::genAssociated(fir::FirOpBuilder &builder,
mlir::Location loc, mlir::Value pointer,
mlir::Value target) {
@@ -100,8 +118,15 @@ void fir::runtime::genRandomInit(fir::FirOpBuilder &builder, mlir::Location loc,
void fir::runtime::genRandomNumber(fir::FirOpBuilder &builder,
mlir::Location loc, mlir::Value harvest) {
- mlir::func::FuncOp func =
- fir::runtime::getRuntimeFunc<mkRTKey(RandomNumber)>(loc, builder);
+ mlir::func::FuncOp func;
+ auto boxEleTy = fir::dyn_cast_ptrOrBoxEleTy(harvest.getType());
+ auto eleTy = fir::unwrapSequenceType(boxEleTy);
+ if (eleTy.isF128()) {
+ func = fir::runtime::getRuntimeFunc<ForcedRandomNumberReal16>(loc, builder);
+ } else {
+ func = fir::runtime::getRuntimeFunc<mkRTKey(RandomNumber)>(loc, builder);
+ }
+
mlir::FunctionType funcTy = func.getFunctionType();
mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
mlir::Value sourceLine =
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 54101ab..bf4debe 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -2948,7 +2948,7 @@ void OmpStructureChecker::Enter(const parser::OmpClause::UseDevicePtr &x) {
if (name->symbol) {
if (!(IsBuiltinCPtr(*(name->symbol)))) {
context_.Say(itr->second->source,
- "'%s' in USE_DEVICE_PTR clause must be of type C_PTR"_err_en_US,
+ "Use of non-C_PTR type '%s' in USE_DEVICE_PTR is deprecated, use USE_DEVICE_ADDR instead"_warn_en_US,
name->ToString());
} else {
useDevicePtrNameList.push_back(*name);
generated by cgit v1.1 at 2025-09-28 12:57:14 +0000