[flang-commits] [flang] c3477c5 - [flang] Add CHARACTER type lowering helpers and runtime.
Eric Schweitz via flang-commits
flang-commits at lists.llvm.org
Fri Jun 26 11:02:08 PDT 2020
Author: Eric Schweitz
Date: 2020-06-26T11:01:52-07:00
New Revision: c3477c51e5995983b9f837c1cd9e7528a5b1bdb2
URL: https://github.com/llvm/llvm-project/commit/c3477c51e5995983b9f837c1cd9e7528a5b1bdb2
DIFF: https://github.com/llvm/llvm-project/commit/c3477c51e5995983b9f837c1cd9e7528a5b1bdb2.diff
LOG: [flang] Add CHARACTER type lowering helpers and runtime.
In order for these files to build properly, this patch rolls up a number of changes that have been made to various files that have been upstreamed.
Implementations for the interfaces included in Bridge.h and IntrinsicCall.h will be included in a future diff.
Differential revision: https://reviews.llvm.org/D82608
Added:
flang/include/flang/Lower/Bridge.h
flang/include/flang/Lower/CharacterExpr.h
flang/include/flang/Lower/CharacterRuntime.h
flang/include/flang/Lower/IntrinsicCall.h
flang/lib/Lower/CharacterExpr.cpp
flang/lib/Lower/CharacterRuntime.cpp
Modified:
flang/include/flang/Lower/FIRBuilder.h
flang/include/flang/Lower/PFTBuilder.h
flang/include/flang/Lower/Support/BoxValue.h
flang/include/flang/Optimizer/Support/KindMapping.h
flang/lib/Lower/CMakeLists.txt
flang/lib/Lower/OpenMP.cpp
flang/lib/Lower/PFTBuilder.cpp
flang/lib/Lower/RTBuilder.h
flang/lib/Lower/SymbolMap.h
flang/lib/Optimizer/Support/KindMapping.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Lower/Bridge.h b/flang/include/flang/Lower/Bridge.h
new file mode 100644
index 000000000000..aee7a0ef5bd8
--- /dev/null
+++ b/flang/include/flang/Lower/Bridge.h
@@ -0,0 +1,117 @@
+//===-- Lower/Bridge.h -- main interface to lowering ------------*- C++ -*-===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+///
+/// \file
+/// Implements lowering. Convert Fortran source to
+/// [MLIR](https://github.com/tensorflow/mlir).
+///
+/// [Coding style](https://llvm.org/docs/CodingStandards.html)
+///
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_LOWER_BRIDGE_H
+#define FORTRAN_LOWER_BRIDGE_H
+
+#include "flang/Common/Fortran.h"
+#include "flang/Lower/AbstractConverter.h"
+#include "flang/Optimizer/Support/KindMapping.h"
+#include "mlir/IR/Module.h"
+
+namespace fir {
+struct NameUniquer;
+}
+
+namespace Fortran {
+namespace common {
+class IntrinsicTypeDefaultKinds;
+} // namespace common
+namespace evaluate {
+class IntrinsicProcTable;
+} // namespace evaluate
+namespace parser {
+class CookedSource;
+struct Program;
+} // namespace parser
+namespace semantics {
+class SemanticsContext;
+} // namespace semantics
+
+namespace lower {
+
+//===----------------------------------------------------------------------===//
+// Lowering bridge
+//===----------------------------------------------------------------------===//
+
+/// The lowering bridge converts the front-end parse trees and semantics
+/// checking residual to MLIR (FIR dialect) code.
+class LoweringBridge {
+public:
+ /// Create a lowering bridge instance.
+ static LoweringBridge
+ create(const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds,
+ const Fortran::evaluate::IntrinsicProcTable &intrinsics,
+ const Fortran::parser::CookedSource &cooked) {
+ return LoweringBridge{defaultKinds, intrinsics, cooked};
+ }
+
+ //===--------------------------------------------------------------------===//
+ // Getters
+ //===--------------------------------------------------------------------===//
+
+ mlir::MLIRContext &getMLIRContext() { return *context.get(); }
+ mlir::ModuleOp &getModule() { return *module.get(); }
+ const Fortran::common::IntrinsicTypeDefaultKinds &getDefaultKinds() const {
+ return defaultKinds;
+ }
+ const Fortran::evaluate::IntrinsicProcTable &getIntrinsicTable() const {
+ return intrinsics;
+ }
+ const Fortran::parser::CookedSource *getCookedSource() const {
+ return cooked;
+ }
+
+ /// Get the kind map.
+ const fir::KindMapping &getKindMap() const { return kindMap; }
+
+ /// Create a folding context. Careful: this is very expensive.
+ Fortran::evaluate::FoldingContext createFoldingContext() const;
+
+ bool validModule() { return getModule(); }
+
+ //===--------------------------------------------------------------------===//
+ // Perform the creation of an mlir::ModuleOp
+ //===--------------------------------------------------------------------===//
+
+ /// Read in an MLIR input file rather than lowering Fortran sources.
+ /// This is intended to be used for testing.
+ void parseSourceFile(llvm::SourceMgr &);
+
+ /// Cross the bridge from the Fortran parse-tree, etc. to MLIR dialects
+ void lower(const Fortran::parser::Program &program, fir::NameUniquer &uniquer,
+ const Fortran::semantics::SemanticsContext &semanticsContext);
+
+private:
+ explicit LoweringBridge(
+ const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds,
+ const Fortran::evaluate::IntrinsicProcTable &intrinsics,
+ const Fortran::parser::CookedSource &cooked);
+ LoweringBridge() = delete;
+ LoweringBridge(const LoweringBridge &) = delete;
+
+ const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds;
+ const Fortran::evaluate::IntrinsicProcTable &intrinsics;
+ const Fortran::parser::CookedSource *cooked;
+ std::unique_ptr<mlir::MLIRContext> context;
+ std::unique_ptr<mlir::ModuleOp> module;
+ fir::KindMapping kindMap;
+};
+
+} // namespace lower
+} // namespace Fortran
+
+#endif // FORTRAN_LOWER_BRIDGE_H
diff --git a/flang/include/flang/Lower/CharacterExpr.h b/flang/include/flang/Lower/CharacterExpr.h
new file mode 100644
index 000000000000..2b0bb562fe1c
--- /dev/null
+++ b/flang/include/flang/Lower/CharacterExpr.h
@@ -0,0 +1,140 @@
+//===-- Lower/CharacterExpr.h -- lowering of characters ---------*- C++ -*-===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_LOWER_CHARACTEREXPR_H
+#define FORTRAN_LOWER_CHARACTEREXPR_H
+
+#include "flang/Lower/FIRBuilder.h"
+#include "flang/Lower/Support/BoxValue.h"
+
+namespace Fortran::lower {
+
+/// Helper to facilitate lowering of CHARACTER in FIR.
+class CharacterExprHelper {
+public:
+ /// Constructor.
+ explicit CharacterExprHelper(FirOpBuilder &builder, mlir::Location loc)
+ : builder{builder}, loc{loc} {}
+ CharacterExprHelper(const CharacterExprHelper &) = delete;
+
+ /// Unless otherwise stated, all mlir::Value inputs of these pseudo-fir ops
+ /// must be of type:
+ /// - fir.boxchar<kind> (dynamic length character),
+ /// - fir.ref<fir.array<len x fir.char<kind>>> (character with compile time
+ /// constant length),
+ /// - fir.array<len x fir.char<kind>> (compile time constant character)
+
+ /// Copy the \p count first characters of \p src into \p dest.
+ /// \p count can have any integer type.
+ void createCopy(mlir::Value dest, mlir::Value src, mlir::Value count);
+
+ /// Set characters of \p str at position [\p lower, \p upper) to blanks.
+ /// \p lower and \upper bounds are zero based.
+ /// If \p upper <= \p lower, no padding is done.
+ /// \p upper and \p lower can have any integer type.
+ void createPadding(mlir::Value str, mlir::Value lower, mlir::Value upper);
+
+ /// Create str(lb:ub), lower bounds must always be specified, upper
+ /// bound is optional.
+ mlir::Value createSubstring(mlir::Value str,
+ llvm::ArrayRef<mlir::Value> bounds);
+
+ /// Return blank character of given \p type !fir.char<kind>
+ mlir::Value createBlankConstant(fir::CharacterType type);
+
+ /// Lower \p lhs = \p rhs where \p lhs and \p rhs are scalar characters.
+ /// It handles cases where \p lhs and \p rhs may overlap.
+ void createAssign(mlir::Value lhs, mlir::Value rhs);
+
+ /// Lower an assignment where the buffer and LEN parameter are known and do
+ /// not need to be unboxed.
+ void createAssign(mlir::Value lptr, mlir::Value llen, mlir::Value rptr,
+ mlir::Value rlen);
+
+ /// Create lhs // rhs in temp obtained with fir.alloca
+ mlir::Value createConcatenate(mlir::Value lhs, mlir::Value rhs);
+
+ /// LEN_TRIM intrinsic.
+ mlir::Value createLenTrim(mlir::Value str);
+
+ /// Embox \p addr and \p len and return fir.boxchar.
+ /// Take care of type conversions before emboxing.
+ /// \p len is converted to the integer type for character lengths if needed.
+ mlir::Value createEmboxChar(mlir::Value addr, mlir::Value len);
+
+ /// Unbox \p boxchar into (fir.ref<fir.char<kind>>, getLengthType()).
+ std::pair<mlir::Value, mlir::Value> createUnboxChar(mlir::Value boxChar);
+
+ /// Allocate a temp of fir::CharacterType type and length len.
+ /// Returns related fir.ref<fir.char<kind>>.
+ mlir::Value createCharacterTemp(mlir::Type type, mlir::Value len);
+
+ /// Allocate a temp of compile time constant length.
+ /// Returns related fir.ref<fir.array<len x fir.char<kind>>>.
+ mlir::Value createCharacterTemp(mlir::Type type, int len) {
+ return createTemp(type, len);
+ }
+
+ /// Return buffer/length pair of character str, if str is a constant,
+ /// it is allocated into a temp, otherwise, its memory reference is
+ /// returned as the buffer.
+ /// The buffer type of str is of type:
+ /// - fir.ref<fir.array<len x fir.char<kind>>> if str has compile time
+ /// constant length.
+ /// - fir.ref<fir.char<kind>> if str has dynamic length.
+ std::pair<mlir::Value, mlir::Value> materializeCharacter(mlir::Value str);
+
+ /// Return true if \p type is a character literal type (is
+ /// fir.array<len x fir.char<kind>>).;
+ static bool isCharacterLiteral(mlir::Type type);
+
+ /// Return true if \p type is one of the following type
+ /// - fir.boxchar<kind>
+ /// - fir.ref<fir.array<len x fir.char<kind>>>
+ /// - fir.array<len x fir.char<kind>>
+ static bool isCharacter(mlir::Type type);
+
+ /// Extract the kind of a character type
+ static int getCharacterKind(mlir::Type type);
+
+ /// Return the integer type that must be used to manipulate
+ /// Character lengths. TODO: move this to FirOpBuilder?
+ mlir::Type getLengthType() { return builder.getIndexType(); }
+
+private:
+ fir::CharBoxValue materializeValue(const fir::CharBoxValue &str);
+ fir::CharBoxValue toDataLengthPair(mlir::Value character);
+ mlir::Type getReferenceType(const fir::CharBoxValue &c) const;
+ mlir::Value createEmbox(const fir::CharBoxValue &str);
+ mlir::Value createLoadCharAt(const fir::CharBoxValue &str, mlir::Value index);
+ void createStoreCharAt(const fir::CharBoxValue &str, mlir::Value index,
+ mlir::Value c);
+ void createCopy(const fir::CharBoxValue &dest, const fir::CharBoxValue &src,
+ mlir::Value count);
+ void createPadding(const fir::CharBoxValue &str, mlir::Value lower,
+ mlir::Value upper);
+ fir::CharBoxValue createTemp(mlir::Type type, mlir::Value len);
+ void createLengthOneAssign(const fir::CharBoxValue &lhs,
+ const fir::CharBoxValue &rhs);
+ void createAssign(const fir::CharBoxValue &lhs, const fir::CharBoxValue &rhs);
+ fir::CharBoxValue createConcatenate(const fir::CharBoxValue &lhs,
+ const fir::CharBoxValue &rhs);
+ fir::CharBoxValue createSubstring(const fir::CharBoxValue &str,
+ llvm::ArrayRef<mlir::Value> bounds);
+ mlir::Value createLenTrim(const fir::CharBoxValue &str);
+ mlir::Value createTemp(mlir::Type type, int len);
+ mlir::Value createBlankConstantCode(fir::CharacterType type);
+
+private:
+ FirOpBuilder &builder;
+ mlir::Location loc;
+};
+
+} // namespace Fortran::lower
+
+#endif // FORTRAN_LOWER_CHARACTEREXPR_H
diff --git a/flang/include/flang/Lower/CharacterRuntime.h b/flang/include/flang/Lower/CharacterRuntime.h
new file mode 100644
index 000000000000..d2992f76406a
--- /dev/null
+++ b/flang/include/flang/Lower/CharacterRuntime.h
@@ -0,0 +1,36 @@
+//===-- Lower/CharacterRuntime.h -- lower CHARACTER operations --*- C++ -*-===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_LOWER_CHARACTERRUNTIME_H
+#define FORTRAN_LOWER_CHARACTERRUNTIME_H
+
+#include "mlir/Dialect/StandardOps/IR/Ops.h"
+
+namespace Fortran {
+namespace lower {
+class AbstractConverter;
+
+/// Generate call to a character comparison for two ssa-values of type
+/// `boxchar`.
+mlir::Value genBoxCharCompare(AbstractConverter &converter, mlir::Location loc,
+ mlir::CmpIPredicate cmp, mlir::Value lhs,
+ mlir::Value rhs);
+
+/// Generate call to a character comparison op for two unboxed variables. There
+/// are 4 arguments, 2 for the lhs and 2 for the rhs. Each CHARACTER must pass a
+/// reference to its buffer (`ref<char<K>>`) and its LEN type parameter (some
+/// integral type).
+mlir::Value genRawCharCompare(AbstractConverter &converter, mlir::Location loc,
+ mlir::CmpIPredicate cmp, mlir::Value lhsBuff,
+ mlir::Value lhsLen, mlir::Value rhsBuff,
+ mlir::Value rhsLen);
+
+} // namespace lower
+} // namespace Fortran
+
+#endif // FORTRAN_LOWER_CHARACTERRUNTIME_H
diff --git a/flang/include/flang/Lower/FIRBuilder.h b/flang/include/flang/Lower/FIRBuilder.h
index f1fb15048c95..fa9efe267b54 100644
--- a/flang/include/flang/Lower/FIRBuilder.h
+++ b/flang/include/flang/Lower/FIRBuilder.h
@@ -70,6 +70,10 @@ class FirOpBuilder : public mlir::OpBuilder {
/// Safely create a reference type to the type `eleTy`.
mlir::Type getRefType(mlir::Type eleTy);
+ /// Create a null constant of type RefType and value 0. Need to pass in the
+ /// Location information.
+ mlir::Value createNullConstant(mlir::Location loc);
+
/// Create an integer constant of type \p type and value \p i.
mlir::Value createIntegerConstant(mlir::Location loc, mlir::Type integerType,
std::int64_t i);
diff --git a/flang/include/flang/Lower/IntrinsicCall.h b/flang/include/flang/Lower/IntrinsicCall.h
new file mode 100644
index 000000000000..dcae96380450
--- /dev/null
+++ b/flang/include/flang/Lower/IntrinsicCall.h
@@ -0,0 +1,66 @@
+//===-- Lower/IntrinsicCall.h -- lowering of intrinsics ---------*- C++ -*-===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_LOWER_INTRINSICCALL_H
+#define FORTRAN_LOWER_INTRINSICCALL_H
+
+#include "flang/Lower/FIRBuilder.h"
+
+namespace fir {
+class ExtendedValue;
+}
+
+namespace Fortran::lower {
+
+// TODO: Expose interface to get specific intrinsic function address.
+// TODO: Handle intrinsic subroutine.
+// TODO: Intrinsics that do not require their arguments to be defined
+// (e.g shape inquiries) might not fit in the current interface that
+// requires mlir::Value to be provided.
+// TODO: Error handling interface ?
+// TODO: Implementation is incomplete. Many intrinsics to tbd.
+
+/// Helper for building calls to intrinsic functions in the runtime support
+/// libraries.
+class IntrinsicCallOpsHelper {
+public:
+ explicit IntrinsicCallOpsHelper(FirOpBuilder &builder, mlir::Location loc)
+ : builder(builder), loc(loc) {}
+ IntrinsicCallOpsHelper(const IntrinsicCallOpsHelper &) = delete;
+
+ /// Generate the FIR+MLIR operations for the generic intrinsic \p name
+ /// with arguments \p args and expected result type \p resultType.
+ /// Returned mlir::Value is the returned Fortran intrinsic value.
+ fir::ExtendedValue genIntrinsicCall(llvm::StringRef name,
+ mlir::Type resultType,
+ llvm::ArrayRef<fir::ExtendedValue> args);
+
+ //===--------------------------------------------------------------------===//
+ // Direct access to intrinsics that may be used by lowering outside
+ // of intrinsic call lowering.
+ //===--------------------------------------------------------------------===//
+
+ /// Generate maximum. There must be at least one argument and all arguments
+ /// must have the same type.
+ mlir::Value genMax(llvm::ArrayRef<mlir::Value> args);
+
+ /// Generate minimum. Same constraints as genMax.
+ mlir::Value genMin(llvm::ArrayRef<mlir::Value> args);
+
+ /// Generate power function x**y with given the expected
+ /// result type.
+ mlir::Value genPow(mlir::Type resultType, mlir::Value x, mlir::Value y);
+
+private:
+ FirOpBuilder &builder;
+ mlir::Location loc;
+};
+
+} // namespace Fortran::lower
+
+#endif // FORTRAN_LOWER_INTRINSICCALL_H
diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h
index 852700b8c0b1..1201470de704 100644
--- a/flang/include/flang/Lower/PFTBuilder.h
+++ b/flang/include/flang/Lower/PFTBuilder.h
@@ -234,6 +234,12 @@ struct Evaluation : EvaluationVariant {
return visit(common::visitors{
[](auto &r) { return pft::isDirective<std::decay_t<decltype(r)>>; }});
}
+ constexpr bool isNopConstructStmt() const {
+ return visit(common::visitors{[](auto &r) {
+ return pft::isNopConstructStmt<std::decay_t<decltype(r)>>;
+ }});
+ }
+
/// Return the predicate: "This is a non-initial, non-terminal construct
/// statement." For an IfConstruct, this is ElseIfStmt and ElseStmt.
constexpr bool isIntermediateConstructStmt() const {
@@ -241,14 +247,40 @@ struct Evaluation : EvaluationVariant {
return pft::isIntermediateConstructStmt<std::decay_t<decltype(r)>>;
}});
}
- constexpr bool isNopConstructStmt() const {
- return visit(common::visitors{[](auto &r) {
- return pft::isNopConstructStmt<std::decay_t<decltype(r)>>;
- }});
+
+ /// Return the first non-nop successor of an evaluation, possibly exiting
+ /// from one or more enclosing constructs.
+ Evaluation &nonNopSuccessor() const {
+ Evaluation *successor = lexicalSuccessor;
+ if (successor && successor->isNopConstructStmt()) {
+ successor = successor->parentConstruct->constructExit;
+ }
+ assert(successor && "missing successor");
+ return *successor;
}
- /// Return FunctionLikeUnit to which this evaluation
- /// belongs. Nullptr if it does not belong to such unit.
+ /// Return true if this Evaluation has at least one nested evaluation.
+ bool hasNestedEvaluations() const {
+ return evaluationList && !evaluationList->empty();
+ }
+
+ /// Return nested evaluation list.
+ EvaluationList &getNestedEvaluations() {
+ assert(evaluationList && "no nested evaluations");
+ return *evaluationList;
+ }
+
+ Evaluation &getFirstNestedEvaluation() {
+ assert(hasNestedEvaluations() && "no nested evaluations");
+ return evaluationList->front();
+ }
+
+ Evaluation &getLastNestedEvaluation() {
+ assert(hasNestedEvaluations() && "no nested evaluations");
+ return evaluationList->back();
+ }
+
+ /// Return the FunctionLikeUnit containing this evaluation (or nullptr).
FunctionLikeUnit *getOwningProcedure() const;
bool lowerAsStructured() const;
@@ -297,9 +329,9 @@ struct Evaluation : EvaluationVariant {
Evaluation *controlSuccessor{nullptr}; // set for some statements
Evaluation *constructExit{nullptr}; // set for constructs
bool isNewBlock{false}; // evaluation begins a new basic block
- bool isUnstructured{false}; // evaluation has unstructured control flow
- bool skip{false}; // evaluation has been processed in advance
- class mlir::Block *block{nullptr}; // isNewBlock block
+ bool isUnstructured{false}; // evaluation has unstructured control flow
+ bool skip{false}; // evaluation has been processed in advance
+ mlir::Block *block{nullptr}; // isNewBlock block
llvm::SmallVector<mlir::Block *, 1> localBlocks{}; // construct local blocks
int printIndex{0}; // (ActionStmt, ConstructStmt) evaluation index for dumps
};
@@ -333,13 +365,13 @@ struct Variable {
: sym{&sym}, depth{depth}, global{global} {}
const Fortran::semantics::Symbol &getSymbol() const { return *sym; }
-
+
bool isGlobal() const { return global; }
bool isHeapAlloc() const { return heapAlloc; }
bool isPointer() const { return pointer; }
bool isTarget() const { return target; }
int getDepth() const { return depth; }
-
+
void setHeapAlloc(bool to = true) { heapAlloc = to; }
void setPointer(bool to = true) { pointer = to; }
void setTarget(bool to = true) { target = to; }
diff --git a/flang/include/flang/Lower/Support/BoxValue.h b/flang/include/flang/Lower/Support/BoxValue.h
index 3516cd352969..0d5dec97ef09 100644
--- a/flang/include/flang/Lower/Support/BoxValue.h
+++ b/flang/include/flang/Lower/Support/BoxValue.h
@@ -11,6 +11,7 @@
#include "mlir/IR/Value.h"
#include "llvm/ADT/SmallVector.h"
+#include "llvm/Support/Compiler.h"
#include "llvm/Support/raw_ostream.h"
#include <utility>
#include <variant>
@@ -67,7 +68,7 @@ class CharBoxValue : public AbstractBox {
friend llvm::raw_ostream &operator<<(llvm::raw_ostream &,
const CharBoxValue &);
- void dump() const { llvm::errs() << *this; }
+ LLVM_DUMP_METHOD void dump() const { llvm::errs() << *this; }
protected:
mlir::Value len;
@@ -117,7 +118,7 @@ class ArrayBoxValue : public AbstractBox, public AbstractArrayBox {
friend llvm::raw_ostream &operator<<(llvm::raw_ostream &,
const ArrayBoxValue &);
- void dump() const { operator<<(llvm::errs(), *this); }
+ LLVM_DUMP_METHOD void dump() const { operator<<(llvm::errs(), *this); }
};
/// Expressions of type CHARACTER and with rank > 0.
@@ -134,7 +135,7 @@ class CharArrayBoxValue : public CharBoxValue, public AbstractArrayBox {
friend llvm::raw_ostream &operator<<(llvm::raw_ostream &,
const CharArrayBoxValue &);
- void dump() const { operator<<(llvm::errs(), *this); }
+ LLVM_DUMP_METHOD void dump() const { operator<<(llvm::errs(), *this); }
};
/// Expressions that are procedure POINTERs may need a set of references to
@@ -152,7 +153,7 @@ class ProcBoxValue : public AbstractBox {
friend llvm::raw_ostream &operator<<(llvm::raw_ostream &,
const ProcBoxValue &);
- void dump() const { operator<<(llvm::errs(), *this); }
+ LLVM_DUMP_METHOD void dump() const { operator<<(llvm::errs(), *this); }
protected:
mlir::Value hostContext;
@@ -185,7 +186,7 @@ class BoxValue : public AbstractBox, public AbstractArrayBox {
}
friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const BoxValue &);
- void dump() const { operator<<(llvm::errs(), *this); }
+ LLVM_DUMP_METHOD void dump() const { operator<<(llvm::errs(), *this); }
protected:
mlir::Value len;
@@ -220,7 +221,7 @@ class ExtendedValue {
}
/// LLVM style debugging of extended values
- void dump() const { llvm::errs() << *this << '\n'; }
+ LLVM_DUMP_METHOD void dump() const { llvm::errs() << *this << '\n'; }
friend llvm::raw_ostream &operator<<(llvm::raw_ostream &,
const ExtendedValue &);
diff --git a/flang/include/flang/Optimizer/Support/KindMapping.h b/flang/include/flang/Optimizer/Support/KindMapping.h
index 8c8ed1f24afd..b65f8285c3a8 100644
--- a/flang/include/flang/Optimizer/Support/KindMapping.h
+++ b/flang/include/flang/Optimizer/Support/KindMapping.h
@@ -1,4 +1,4 @@
-//===-- Optimizer/Support/KindMapping.h -------------------------*- C++ -*-===//
+//===-- Optimizer/Support/KindMapping.h -- support kind mapping -*- C++ -*-===//
//
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
// See https://llvm.org/LICENSE.txt for license information.
@@ -14,15 +14,9 @@
#include "llvm/IR/Type.h"
namespace llvm {
-template <typename>
-class Optional;
struct fltSemantics;
} // namespace llvm
-namespace mlir {
-class MLIRContext;
-} // namespace mlir
-
namespace fir {
/// The kind mapping is an encoded string that informs FIR how the Fortran KIND
@@ -57,24 +51,27 @@ class KindMapping {
explicit KindMapping(mlir::MLIRContext *context, llvm::StringRef map);
/// Get the size in bits of !fir.char<kind>
- Bitsize getCharacterBitsize(KindTy kind);
+ Bitsize getCharacterBitsize(KindTy kind) const;
/// Get the size in bits of !fir.int<kind>
- Bitsize getIntegerBitsize(KindTy kind);
+ Bitsize getIntegerBitsize(KindTy kind) const;
/// Get the size in bits of !fir.logical<kind>
- Bitsize getLogicalBitsize(KindTy kind);
+ Bitsize getLogicalBitsize(KindTy kind) const;
+
+ /// Get the size in bits of !fir.real<kind>
+ Bitsize getRealBitsize(KindTy kind) const;
/// Get the LLVM Type::TypeID of !fir.real<kind>
- LLVMTypeID getRealTypeID(KindTy kind);
+ LLVMTypeID getRealTypeID(KindTy kind) const;
/// Get the LLVM Type::TypeID of !fir.complex<kind>
- LLVMTypeID getComplexTypeID(KindTy kind);
+ LLVMTypeID getComplexTypeID(KindTy kind) const;
mlir::MLIRContext *getContext() const { return context; }
/// Get the float semantics of !fir.real<kind>
- const llvm::fltSemantics &getFloatSemantics(KindTy kind);
+ const llvm::fltSemantics &getFloatSemantics(KindTy kind) const;
private:
MatchResult badMapString(const llvm::Twine &ptr);
diff --git a/flang/lib/Lower/CMakeLists.txt b/flang/lib/Lower/CMakeLists.txt
index 8602c23cc578..5409c801e339 100644
--- a/flang/lib/Lower/CMakeLists.txt
+++ b/flang/lib/Lower/CMakeLists.txt
@@ -2,6 +2,8 @@ set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-error -Wno-unused-parameter")
get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS)
add_flang_library(FortranLower
+ CharacterExpr.cpp
+ CharacterRuntime.cpp
ComplexExpr.cpp
ConvertType.cpp
DoLoopHelper.cpp
diff --git a/flang/lib/Lower/CharacterExpr.cpp b/flang/lib/Lower/CharacterExpr.cpp
new file mode 100644
index 000000000000..87c28a1b555f
--- /dev/null
+++ b/flang/lib/Lower/CharacterExpr.cpp
@@ -0,0 +1,453 @@
+//===-- CharacterExpr.cpp -------------------------------------------------===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Lower/CharacterExpr.h"
+#include "flang/Lower/ConvertType.h"
+#include "flang/Lower/DoLoopHelper.h"
+#include "flang/Lower/IntrinsicCall.h"
+
+//===----------------------------------------------------------------------===//
+// CharacterExprHelper implementation
+//===----------------------------------------------------------------------===//
+
+/// Get fir.char<kind> type with the same kind as inside str.
+static fir::CharacterType getCharacterType(mlir::Type type) {
+ if (auto boxType = type.dyn_cast<fir::BoxCharType>())
+ return boxType.getEleTy();
+ if (auto refType = type.dyn_cast<fir::ReferenceType>())
+ type = refType.getEleTy();
+ if (auto seqType = type.dyn_cast<fir::SequenceType>())
+ type = seqType.getEleTy();
+ if (auto charType = type.dyn_cast<fir::CharacterType>())
+ return charType;
+ llvm_unreachable("Invalid character value type");
+}
+
+static fir::CharacterType getCharacterType(const fir::CharBoxValue &box) {
+ return getCharacterType(box.getBuffer().getType());
+}
+
+static bool needToMaterialize(const fir::CharBoxValue &box) {
+ return box.getBuffer().getType().isa<fir::SequenceType>() ||
+ box.getBuffer().getType().isa<fir::CharacterType>();
+}
+
+static std::optional<fir::SequenceType::Extent>
+getCompileTimeLength(const fir::CharBoxValue &box) {
+ // FIXME: should this just return box.getLen() ??
+ auto type = box.getBuffer().getType();
+ if (type.isa<fir::CharacterType>())
+ return 1;
+ if (auto refType = type.dyn_cast<fir::ReferenceType>())
+ type = refType.getEleTy();
+ if (auto seqType = type.dyn_cast<fir::SequenceType>()) {
+ auto shape = seqType.getShape();
+ assert(shape.size() == 1 && "only scalar character supported");
+ if (shape[0] != fir::SequenceType::getUnknownExtent())
+ return shape[0];
+ }
+ return {};
+}
+
+fir::CharBoxValue Fortran::lower::CharacterExprHelper::materializeValue(
+ const fir::CharBoxValue &str) {
+ if (!needToMaterialize(str))
+ return str;
+ auto variable = builder.create<fir::AllocaOp>(loc, str.getBuffer().getType());
+ builder.create<fir::StoreOp>(loc, str.getBuffer(), variable);
+ return {variable, str.getLen()};
+}
+
+fir::CharBoxValue
+Fortran::lower::CharacterExprHelper::toDataLengthPair(mlir::Value character) {
+ auto lenType = getLengthType();
+ auto type = character.getType();
+ if (auto boxCharType = type.dyn_cast<fir::BoxCharType>()) {
+ auto refType = builder.getRefType(boxCharType.getEleTy());
+ auto unboxed =
+ builder.create<fir::UnboxCharOp>(loc, refType, lenType, character);
+ return {unboxed.getResult(0), unboxed.getResult(1)};
+ }
+ if (auto seqType = type.dyn_cast<fir::CharacterType>()) {
+ // Materialize length for usage into character manipulations.
+ auto len = builder.createIntegerConstant(loc, lenType, 1);
+ return {character, len};
+ }
+ if (auto refType = type.dyn_cast<fir::ReferenceType>())
+ type = refType.getEleTy();
+ if (auto seqType = type.dyn_cast<fir::SequenceType>()) {
+ assert(seqType.hasConstantShape() &&
+ "ssa array value must have constant length");
+ auto shape = seqType.getShape();
+ assert(shape.size() == 1 && "only scalar character supported");
+ // Materialize length for usage into character manipulations.
+ auto len = builder.createIntegerConstant(loc, lenType, shape[0]);
+ // FIXME: this seems to work for tests, but don't think it is correct
+ if (auto load = dyn_cast<fir::LoadOp>(character.getDefiningOp()))
+ return {load.memref(), len};
+ return {character, len};
+ }
+ if (auto charTy = type.dyn_cast<fir::CharacterType>()) {
+ auto len = builder.createIntegerConstant(loc, lenType, 1);
+ return {character, len};
+ }
+ llvm::report_fatal_error("unexpected character type");
+}
+
+/// Get fir.ref<fir.char<kind>> type.
+mlir::Type Fortran::lower::CharacterExprHelper::getReferenceType(
+ const fir::CharBoxValue &box) const {
+ return builder.getRefType(getCharacterType(box));
+}
+
+mlir::Value
+Fortran::lower::CharacterExprHelper::createEmbox(const fir::CharBoxValue &box) {
+ // BoxChar require a reference.
+ auto str = box;
+ if (needToMaterialize(box))
+ str = materializeValue(box);
+ auto kind = getCharacterType(str).getFKind();
+ auto boxCharType = fir::BoxCharType::get(builder.getContext(), kind);
+ auto refType = getReferenceType(str);
+ // So far, fir.emboxChar fails lowering to llvm when it is given
+ // fir.data<fir.array<len x fir.char<kind>>> types, so convert to
+ // fir.data<fir.char<kind>> if needed.
+ auto buff = str.getBuffer();
+ if (refType != str.getBuffer().getType())
+ buff = builder.createConvert(loc, refType, buff);
+ // Convert in case the provided length is not of the integer type that must
+ // be used in boxchar.
+ auto lenType = getLengthType();
+ auto len = str.getLen();
+ if (str.getLen().getType() != lenType)
+ len = builder.createConvert(loc, lenType, len);
+ return builder.create<fir::EmboxCharOp>(loc, boxCharType, buff, len);
+}
+
+mlir::Value Fortran::lower::CharacterExprHelper::createLoadCharAt(
+ const fir::CharBoxValue &str, mlir::Value index) {
+ // In case this is addressing a length one character scalar simply return
+ // the single character.
+ if (str.getBuffer().getType().isa<fir::CharacterType>())
+ return str.getBuffer();
+ auto addr = builder.create<fir::CoordinateOp>(loc, getReferenceType(str),
+ str.getBuffer(), index);
+ return builder.create<fir::LoadOp>(loc, addr);
+}
+
+void Fortran::lower::CharacterExprHelper::createStoreCharAt(
+ const fir::CharBoxValue &str, mlir::Value index, mlir::Value c) {
+ assert(!needToMaterialize(str) && "not in memory");
+ auto addr = builder.create<fir::CoordinateOp>(loc, getReferenceType(str),
+ str.getBuffer(), index);
+ builder.create<fir::StoreOp>(loc, c, addr);
+}
+
+void Fortran::lower::CharacterExprHelper::createCopy(
+ const fir::CharBoxValue &dest, const fir::CharBoxValue &src,
+ mlir::Value count) {
+ Fortran::lower::DoLoopHelper{builder, loc}.createLoop(
+ count, [&](Fortran::lower::FirOpBuilder &, mlir::Value index) {
+ auto charVal = createLoadCharAt(src, index);
+ createStoreCharAt(dest, index, charVal);
+ });
+}
+
+void Fortran::lower::CharacterExprHelper::createPadding(
+ const fir::CharBoxValue &str, mlir::Value lower, mlir::Value upper) {
+ auto blank = createBlankConstant(getCharacterType(str));
+ // Always create the loop, if upper < lower, no iteration will be
+ // executed.
+ Fortran::lower::DoLoopHelper{builder, loc}.createLoop(
+ lower, upper, [&](Fortran::lower::FirOpBuilder &, mlir::Value index) {
+ createStoreCharAt(str, index, blank);
+ });
+}
+
+fir::CharBoxValue
+Fortran::lower::CharacterExprHelper::createTemp(mlir::Type type,
+ mlir::Value len) {
+ assert(type.isa<fir::CharacterType>() && "expected fir character type");
+ llvm::SmallVector<mlir::Value, 3> sizes{len};
+ auto ref = builder.allocateLocal(loc, type, llvm::StringRef{}, sizes);
+ return {ref, len};
+}
+
+// Simple length one character assignment without loops.
+void Fortran::lower::CharacterExprHelper::createLengthOneAssign(
+ const fir::CharBoxValue &lhs, const fir::CharBoxValue &rhs) {
+ auto addr = lhs.getBuffer();
+ auto refType = getReferenceType(lhs);
+ addr = builder.createConvert(loc, refType, addr);
+
+ auto val = rhs.getBuffer();
+ if (!needToMaterialize(rhs)) {
+ mlir::Value rhsAddr = rhs.getBuffer();
+ rhsAddr = builder.createConvert(loc, refType, rhsAddr);
+ val = builder.create<fir::LoadOp>(loc, rhsAddr);
+ }
+
+ builder.create<fir::StoreOp>(loc, val, addr);
+}
+
+void Fortran::lower::CharacterExprHelper::createAssign(
+ const fir::CharBoxValue &lhs, const fir::CharBoxValue &rhs) {
+ auto rhsCstLen = getCompileTimeLength(rhs);
+ auto lhsCstLen = getCompileTimeLength(lhs);
+ bool compileTimeSameLength =
+ lhsCstLen && rhsCstLen && *lhsCstLen == *rhsCstLen;
+
+ if (compileTimeSameLength && *lhsCstLen == 1) {
+ createLengthOneAssign(lhs, rhs);
+ return;
+ }
+
+ // Copy the minimum of the lhs and rhs lengths and pad the lhs remainder
+ // if needed.
+ mlir::Value copyCount = lhs.getLen();
+ if (!compileTimeSameLength)
+ copyCount = Fortran::lower::IntrinsicCallOpsHelper{builder, loc}.genMin(
+ {lhs.getLen(), rhs.getLen()});
+
+ fir::CharBoxValue safeRhs = rhs;
+ if (needToMaterialize(rhs)) {
+ // TODO: revisit now that character constant handling changed.
+ // Need to materialize the constant to get its elements.
+ // (No equivalent of fir.coordinate_of for array value).
+ safeRhs = materializeValue(rhs);
+ } else {
+ // If rhs is in memory, always assumes rhs might overlap with lhs
+ // in a way that require a temp for the copy. That can be optimize later.
+ // Only create a temp of copyCount size because we do not need more from
+ // rhs.
+ auto temp = createTemp(getCharacterType(rhs), copyCount);
+ createCopy(temp, rhs, copyCount);
+ safeRhs = temp;
+ }
+
+ // Actual copy
+ createCopy(lhs, safeRhs, copyCount);
+
+ // Pad if needed.
+ if (!compileTimeSameLength) {
+ auto one = builder.createIntegerConstant(loc, lhs.getLen().getType(), 1);
+ auto maxPadding = builder.create<mlir::SubIOp>(loc, lhs.getLen(), one);
+ createPadding(lhs, copyCount, maxPadding);
+ }
+}
+
+fir::CharBoxValue Fortran::lower::CharacterExprHelper::createConcatenate(
+ const fir::CharBoxValue &lhs, const fir::CharBoxValue &rhs) {
+ mlir::Value len =
+ builder.create<mlir::AddIOp>(loc, lhs.getLen(), rhs.getLen());
+ auto temp = createTemp(getCharacterType(rhs), len);
+ createCopy(temp, lhs, lhs.getLen());
+ auto one = builder.createIntegerConstant(loc, len.getType(), 1);
+ auto upperBound = builder.create<mlir::SubIOp>(loc, len, one);
+ auto lhsLen =
+ builder.createConvert(loc, builder.getIndexType(), lhs.getLen());
+ Fortran::lower::DoLoopHelper{builder, loc}.createLoop(
+ lhs.getLen(), upperBound, one,
+ [&](Fortran::lower::FirOpBuilder &bldr, mlir::Value index) {
+ auto rhsIndex = bldr.create<mlir::SubIOp>(loc, index, lhsLen);
+ auto charVal = createLoadCharAt(rhs, rhsIndex);
+ createStoreCharAt(temp, index, charVal);
+ });
+ return temp;
+}
+
+fir::CharBoxValue Fortran::lower::CharacterExprHelper::createSubstring(
+ const fir::CharBoxValue &box, llvm::ArrayRef<mlir::Value> bounds) {
+ // Constant need to be materialize in memory to use fir.coordinate_of.
+ auto str = box;
+ if (needToMaterialize(box))
+ str = materializeValue(box);
+
+ auto nbounds{bounds.size()};
+ if (nbounds < 1 || nbounds > 2) {
+ mlir::emitError(loc, "Incorrect number of bounds in substring");
+ return {mlir::Value{}, mlir::Value{}};
+ }
+ mlir::SmallVector<mlir::Value, 2> castBounds;
+ // Convert bounds to length type to do safe arithmetic on it.
+ for (auto bound : bounds)
+ castBounds.push_back(builder.createConvert(loc, getLengthType(), bound));
+ auto lowerBound = castBounds[0];
+ // FIR CoordinateOp is zero based but Fortran substring are one based.
+ auto one = builder.createIntegerConstant(loc, lowerBound.getType(), 1);
+ auto offset = builder.create<mlir::SubIOp>(loc, lowerBound, one).getResult();
+ auto idxType = builder.getIndexType();
+ if (offset.getType() != idxType)
+ offset = builder.createConvert(loc, idxType, offset);
+ auto substringRef = builder.create<fir::CoordinateOp>(
+ loc, getReferenceType(str), str.getBuffer(), offset);
+
+ // Compute the length.
+ mlir::Value substringLen{};
+ if (nbounds < 2) {
+ substringLen =
+ builder.create<mlir::SubIOp>(loc, str.getLen(), castBounds[0]);
+ } else {
+ substringLen =
+ builder.create<mlir::SubIOp>(loc, castBounds[1], castBounds[0]);
+ }
+ substringLen = builder.create<mlir::AddIOp>(loc, substringLen, one);
+
+ // Set length to zero if bounds were reversed (Fortran 2018 9.4.1)
+ auto zero = builder.createIntegerConstant(loc, substringLen.getType(), 0);
+ auto cdt = builder.create<mlir::CmpIOp>(loc, mlir::CmpIPredicate::slt,
+ substringLen, zero);
+ substringLen = builder.create<mlir::SelectOp>(loc, cdt, zero, substringLen);
+
+ return {substringRef, substringLen};
+}
+
+mlir::Value Fortran::lower::CharacterExprHelper::createLenTrim(
+ const fir::CharBoxValue &str) {
+ // Note: Runtime for LEN_TRIM should also be available at some
+ // point. For now use an inlined implementation.
+ auto indexType = builder.getIndexType();
+ auto len = builder.createConvert(loc, indexType, str.getLen());
+ auto one = builder.createIntegerConstant(loc, indexType, 1);
+ auto minusOne = builder.createIntegerConstant(loc, indexType, -1);
+ auto zero = builder.createIntegerConstant(loc, indexType, 0);
+ auto trueVal = builder.createIntegerConstant(loc, builder.getI1Type(), 1);
+ auto blank = createBlankConstantCode(getCharacterType(str));
+ mlir::Value lastChar = builder.create<mlir::SubIOp>(loc, len, one);
+
+ auto iterWhile = builder.create<fir::IterWhileOp>(
+ loc, lastChar, zero, minusOne, trueVal, lastChar);
+ auto insPt = builder.saveInsertionPoint();
+ builder.setInsertionPointToStart(iterWhile.getBody());
+ auto index = iterWhile.getInductionVar();
+ // Look for first non-blank from the right of the character.
+ auto c = createLoadCharAt(str, index);
+ c = builder.createConvert(loc, blank.getType(), c);
+ auto isBlank =
+ builder.create<mlir::CmpIOp>(loc, mlir::CmpIPredicate::eq, blank, c);
+ llvm::SmallVector<mlir::Value, 2> results = {isBlank, index};
+ builder.create<fir::ResultOp>(loc, results);
+ builder.restoreInsertionPoint(insPt);
+ // Compute length after iteration (zero if all blanks)
+ mlir::Value newLen =
+ builder.create<mlir::AddIOp>(loc, iterWhile.getResult(1), one);
+ auto result =
+ builder.create<SelectOp>(loc, iterWhile.getResult(0), zero, newLen);
+ return builder.createConvert(loc, getLengthType(), result);
+}
+
+mlir::Value Fortran::lower::CharacterExprHelper::createTemp(mlir::Type type,
+ int len) {
+ assert(type.isa<fir::CharacterType>() && "expected fir character type");
+ assert(len >= 0 && "expected positive length");
+ fir::SequenceType::Shape shape{len};
+ auto seqType = fir::SequenceType::get(shape, type);
+ return builder.create<fir::AllocaOp>(loc, seqType);
+}
+
+// Returns integer with code for blank. The integer has the same
+// size as the character. Blank has ascii space code for all kinds.
+mlir::Value Fortran::lower::CharacterExprHelper::createBlankConstantCode(
+ fir::CharacterType type) {
+ auto bits = builder.getKindMap().getCharacterBitsize(type.getFKind());
+ auto intType = builder.getIntegerType(bits);
+ return builder.createIntegerConstant(loc, intType, ' ');
+}
+
+mlir::Value Fortran::lower::CharacterExprHelper::createBlankConstant(
+ fir::CharacterType type) {
+ return builder.createConvert(loc, type, createBlankConstantCode(type));
+}
+
+void Fortran::lower::CharacterExprHelper::createCopy(mlir::Value dest,
+ mlir::Value src,
+ mlir::Value count) {
+ createCopy(toDataLengthPair(dest), toDataLengthPair(src), count);
+}
+
+void Fortran::lower::CharacterExprHelper::createPadding(mlir::Value str,
+ mlir::Value lower,
+ mlir::Value upper) {
+ createPadding(toDataLengthPair(str), lower, upper);
+}
+
+mlir::Value Fortran::lower::CharacterExprHelper::createSubstring(
+ mlir::Value str, llvm::ArrayRef<mlir::Value> bounds) {
+ return createEmbox(createSubstring(toDataLengthPair(str), bounds));
+}
+
+void Fortran::lower::CharacterExprHelper::createAssign(mlir::Value lhs,
+ mlir::Value rhs) {
+ createAssign(toDataLengthPair(lhs), toDataLengthPair(rhs));
+}
+
+mlir::Value
+Fortran::lower::CharacterExprHelper::createLenTrim(mlir::Value str) {
+ return createLenTrim(toDataLengthPair(str));
+}
+
+void Fortran::lower::CharacterExprHelper::createAssign(mlir::Value lptr,
+ mlir::Value llen,
+ mlir::Value rptr,
+ mlir::Value rlen) {
+ createAssign(fir::CharBoxValue{lptr, llen}, fir::CharBoxValue{rptr, rlen});
+}
+
+mlir::Value
+Fortran::lower::CharacterExprHelper::createConcatenate(mlir::Value lhs,
+ mlir::Value rhs) {
+ return createEmbox(
+ createConcatenate(toDataLengthPair(lhs), toDataLengthPair(rhs)));
+}
+
+mlir::Value
+Fortran::lower::CharacterExprHelper::createEmboxChar(mlir::Value addr,
+ mlir::Value len) {
+ return createEmbox(fir::CharBoxValue{addr, len});
+}
+
+std::pair<mlir::Value, mlir::Value>
+Fortran::lower::CharacterExprHelper::createUnboxChar(mlir::Value boxChar) {
+ auto box = toDataLengthPair(boxChar);
+ return {box.getBuffer(), box.getLen()};
+}
+
+mlir::Value
+Fortran::lower::CharacterExprHelper::createCharacterTemp(mlir::Type type,
+ mlir::Value len) {
+ return createEmbox(createTemp(type, len));
+}
+
+std::pair<mlir::Value, mlir::Value>
+Fortran::lower::CharacterExprHelper::materializeCharacter(mlir::Value str) {
+ auto box = toDataLengthPair(str);
+ if (needToMaterialize(box))
+ box = materializeValue(box);
+ return {box.getBuffer(), box.getLen()};
+}
+
+bool Fortran::lower::CharacterExprHelper::isCharacterLiteral(mlir::Type type) {
+ if (auto seqType = type.dyn_cast<fir::SequenceType>())
+ return seqType.getEleTy().isa<fir::CharacterType>();
+ return false;
+}
+
+bool Fortran::lower::CharacterExprHelper::isCharacter(mlir::Type type) {
+ if (type.isa<fir::BoxCharType>())
+ return true;
+ if (auto refType = type.dyn_cast<fir::ReferenceType>())
+ type = refType.getEleTy();
+ if (auto seqType = type.dyn_cast<fir::SequenceType>()) {
+ type = seqType.getEleTy();
+ }
+ return type.isa<fir::CharacterType>();
+}
+
+int Fortran::lower::CharacterExprHelper::getCharacterKind(mlir::Type type) {
+ return getCharacterType(type).getFKind();
+}
diff --git a/flang/lib/Lower/CharacterRuntime.cpp b/flang/lib/Lower/CharacterRuntime.cpp
new file mode 100644
index 000000000000..af95885f985d
--- /dev/null
+++ b/flang/lib/Lower/CharacterRuntime.cpp
@@ -0,0 +1,129 @@
+//===-- CharacterRuntime.cpp -- runtime for CHARACTER type entities -------===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Lower/CharacterRuntime.h"
+#include "../../runtime/character.h"
+#include "RTBuilder.h"
+#include "flang/Lower/Bridge.h"
+#include "flang/Lower/CharacterExpr.h"
+#include "flang/Lower/FIRBuilder.h"
+#include "mlir/Dialect/StandardOps/IR/Ops.h"
+
+using namespace Fortran::runtime;
+
+#define NAMIFY_HELPER(X) #X
+#define NAMIFY(X) NAMIFY_HELPER(IONAME(X))
+#define mkRTKey(X) mkKey(RTNAME(X))
+
+namespace Fortran::lower {
+/// Static table of CHARACTER runtime calls
+///
+/// This logical map contains the name and type builder function for each
+/// runtime function listed in the tuple. This table is fully constructed at
+/// compile-time. Use the `mkRTKey` macro to access the table.
+static constexpr std::tuple<
+ mkRTKey(CharacterCompareScalar), mkRTKey(CharacterCompareScalar1),
+ mkRTKey(CharacterCompareScalar2), mkRTKey(CharacterCompareScalar4),
+ mkRTKey(CharacterCompare)>
+ newCharRTTable;
+} // namespace Fortran::lower
+
+using namespace Fortran::lower;
+
+/// Helper function to retrieve the name of the IO function given the key `A`
+template <typename A>
+static constexpr const char *getName() {
+ return std::get<A>(newCharRTTable).name;
+}
+
+/// Helper function to retrieve the type model signature builder of the IO
+/// function as defined by the key `A`
+template <typename A>
+static constexpr FuncTypeBuilderFunc getTypeModel() {
+ return std::get<A>(newCharRTTable).getTypeModel();
+}
+
+inline int64_t getLength(mlir::Type argTy) {
+ return argTy.cast<fir::SequenceType>().getShape()[0];
+}
+
+/// Get (or generate) the MLIR FuncOp for a given runtime function.
+template <typename E>
+static mlir::FuncOp getRuntimeFunc(mlir::Location loc,
+ Fortran::lower::FirOpBuilder &builder) {
+ auto name = getName<E>();
+ auto func = builder.getNamedFunction(name);
+ if (func)
+ return func;
+ auto funTy = getTypeModel<E>()(builder.getContext());
+ func = builder.createFunction(loc, name, funTy);
+ func.setAttr("fir.runtime", builder.getUnitAttr());
+ return func;
+}
+
+/// Helper function to recover the KIND from the FIR type.
+static int discoverKind(mlir::Type ty) {
+ if (auto charTy = ty.dyn_cast<fir::CharacterType>())
+ return charTy.getFKind();
+ if (auto eleTy = fir::dyn_cast_ptrEleTy(ty))
+ return discoverKind(eleTy);
+ if (auto arrTy = ty.dyn_cast<fir::SequenceType>())
+ return discoverKind(arrTy.getEleTy());
+ if (auto boxTy = ty.dyn_cast<fir::BoxCharType>())
+ return discoverKind(boxTy.getEleTy());
+ if (auto boxTy = ty.dyn_cast<fir::BoxType>())
+ return discoverKind(boxTy.getEleTy());
+ llvm_unreachable("unexpected character type");
+}
+
+//===----------------------------------------------------------------------===//
+// Lower character operations
+//===----------------------------------------------------------------------===//
+
+mlir::Value
+Fortran::lower::genRawCharCompare(Fortran::lower::AbstractConverter &converter,
+ mlir::Location loc, mlir::CmpIPredicate cmp,
+ mlir::Value lhsBuff, mlir::Value lhsLen,
+ mlir::Value rhsBuff, mlir::Value rhsLen) {
+ auto &builder = converter.getFirOpBuilder();
+ mlir::FuncOp beginFunc;
+ switch (discoverKind(lhsBuff.getType())) {
+ case 1:
+ beginFunc = getRuntimeFunc<mkRTKey(CharacterCompareScalar1)>(loc, builder);
+ break;
+ case 2:
+ beginFunc = getRuntimeFunc<mkRTKey(CharacterCompareScalar2)>(loc, builder);
+ break;
+ case 4:
+ beginFunc = getRuntimeFunc<mkRTKey(CharacterCompareScalar4)>(loc, builder);
+ break;
+ default:
+ llvm_unreachable("runtime does not support CHARACTER KIND");
+ }
+ auto fTy = beginFunc.getType();
+ auto lptr = builder.createConvert(loc, fTy.getInput(0), lhsBuff);
+ auto llen = builder.createConvert(loc, fTy.getInput(2), lhsLen);
+ auto rptr = builder.createConvert(loc, fTy.getInput(1), rhsBuff);
+ auto rlen = builder.createConvert(loc, fTy.getInput(3), rhsLen);
+ llvm::SmallVector<mlir::Value, 4> args = {lptr, rptr, llen, rlen};
+ auto tri = builder.create<mlir::CallOp>(loc, beginFunc, args).getResult(0);
+ auto zero = builder.createIntegerConstant(loc, tri.getType(), 0);
+ return builder.create<mlir::CmpIOp>(loc, cmp, tri, zero);
+}
+
+mlir::Value
+Fortran::lower::genBoxCharCompare(Fortran::lower::AbstractConverter &converter,
+ mlir::Location loc, mlir::CmpIPredicate cmp,
+ mlir::Value lhs, mlir::Value rhs) {
+ auto &builder = converter.getFirOpBuilder();
+ Fortran::lower::CharacterExprHelper helper{builder, loc};
+ auto lhsPair = helper.materializeCharacter(lhs);
+ auto rhsPair = helper.materializeCharacter(rhs);
+ return genRawCharCompare(converter, loc, cmp, lhsPair.first, lhsPair.second,
+ rhsPair.first, rhsPair.second);
+}
diff --git a/flang/lib/Lower/OpenMP.cpp b/flang/lib/Lower/OpenMP.cpp
index ad75eff0adb3..5eb6a1866d29 100644
--- a/flang/lib/Lower/OpenMP.cpp
+++ b/flang/lib/Lower/OpenMP.cpp
@@ -7,7 +7,7 @@
//===----------------------------------------------------------------------===//
#include "flang/Lower/OpenMP.h"
-#include "flang/Lower/AbstractConverter.h"
+#include "flang/Lower/Bridge.h"
#include "flang/Lower/PFTBuilder.h"
#include "flang/Parser/parse-tree.h"
diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp
index e23370ec9512..7195086d8e3f 100644
--- a/flang/lib/Lower/PFTBuilder.cpp
+++ b/flang/lib/Lower/PFTBuilder.cpp
@@ -170,13 +170,24 @@ class PFTBuilder {
void exitModule() {
parentVariantStack.pop_back();
- resetFunctionList();
+ resetFunctionState();
+ }
+
+ /// Ensure that a function has a branch target after the last user statement.
+ void endFunctionBody() {
+ if (lastLexicalEvaluation) {
+ static const parser::ContinueStmt endTarget{};
+ addEvaluation(
+ lower::pft::Evaluation{endTarget, parentVariantStack.back(), {}, {}});
+ lastLexicalEvaluation = nullptr;
+ }
}
/// Initialize a new function-like unit and make it the builder's focus.
template <typename A>
bool enterFunction(const A &func,
const semantics::SemanticsContext &semanticsContext) {
+ endFunctionBody(); // enclosing host subprogram body, if any
auto &unit = addFunction(lower::pft::FunctionLikeUnit{
func, parentVariantStack.back(), semanticsContext});
labelEvaluationMap = &unit.labelEvaluationMap;
@@ -188,17 +199,13 @@ class PFTBuilder {
}
void exitFunction() {
- // Guarantee that there is a branch target after the last user statement.
- static const parser::ContinueStmt endTarget{};
- addEvaluation(
- lower::pft::Evaluation{endTarget, parentVariantStack.back(), {}, {}});
- lastLexicalEvaluation = nullptr;
+ endFunctionBody();
analyzeBranches(nullptr, *evaluationListStack.back()); // add branch links
popEvaluationList();
labelEvaluationMap = nullptr;
assignSymbolLabelMap = nullptr;
parentVariantStack.pop_back();
- resetFunctionList();
+ resetFunctionState();
}
/// Initialize a new construct and make it the builder's focus.
@@ -219,12 +226,14 @@ class PFTBuilder {
constructAndDirectiveStack.pop_back();
}
- /// Reset functionList to an enclosing function's functionList.
- void resetFunctionList() {
+ /// Reset function state to that of an enclosing host function.
+ void resetFunctionState() {
if (!parentVariantStack.empty()) {
parentVariantStack.back().visit(common::visitors{
[&](lower::pft::FunctionLikeUnit &p) {
functionList = &p.nestedFunctions;
+ labelEvaluationMap = &p.labelEvaluationMap;
+ assignSymbolLabelMap = &p.assignSymbolLabelMap;
},
[&](lower::pft::ModuleLikeUnit &p) {
functionList = &p.nestedFunctions;
@@ -346,13 +355,10 @@ class PFTBuilder {
/// Set the exit of a construct, possibly from multiple enclosing constructs.
void setConstructExit(lower::pft::Evaluation &eval) {
- eval.constructExit = eval.evaluationList->back().lexicalSuccessor;
- if (eval.constructExit && eval.constructExit->isNopConstructStmt()) {
- eval.constructExit = eval.constructExit->parentConstruct->constructExit;
- }
- assert(eval.constructExit && "missing construct exit");
+ eval.constructExit = &eval.evaluationList->back().nonNopSuccessor();
}
+ /// Mark the target of a branch as a new block.
void markBranchTarget(lower::pft::Evaluation &sourceEvaluation,
lower::pft::Evaluation &targetEvaluation) {
sourceEvaluation.isUnstructured = true;
@@ -360,6 +366,22 @@ class PFTBuilder {
sourceEvaluation.controlSuccessor = &targetEvaluation;
}
targetEvaluation.isNewBlock = true;
+ // If this is a branch into the body of a construct (usually illegal,
+ // but allowed in some legacy cases), then the targetEvaluation and its
+ // ancestors must be marked as unstructured.
+ auto *sourceConstruct = sourceEvaluation.parentConstruct;
+ auto *targetConstruct = targetEvaluation.parentConstruct;
+ if (targetEvaluation.isConstructStmt() &&
+ &targetConstruct->getFirstNestedEvaluation() == &targetEvaluation)
+ // A branch to an initial constructStmt is a branch to the construct.
+ targetConstruct = targetConstruct->parentConstruct;
+ if (targetConstruct) {
+ while (sourceConstruct && sourceConstruct != targetConstruct)
+ sourceConstruct = sourceConstruct->parentConstruct;
+ if (sourceConstruct != targetConstruct)
+ for (auto *eval = &targetEvaluation; eval; eval = eval->parentConstruct)
+ eval->isUnstructured = true;
+ }
}
void markBranchTarget(lower::pft::Evaluation &sourceEvaluation,
parser::Label label) {
@@ -370,20 +392,9 @@ class PFTBuilder {
markBranchTarget(sourceEvaluation, *targetEvaluation);
}
- /// Return the first non-nop successor of an evaluation, possibly exiting
- /// from one or more enclosing constructs.
- lower::pft::Evaluation *exitSuccessor(lower::pft::Evaluation &eval) {
- lower::pft::Evaluation *successor{eval.lexicalSuccessor};
- if (successor && successor->isNopConstructStmt()) {
- successor = successor->parentConstruct->constructExit;
- }
- assert(successor && "missing exit successor");
- return successor;
- }
-
- /// Mark the exit successor of an Evaluation as a new block.
+ /// Mark the successor of an Evaluation as a new block.
void markSuccessorAsNewBlock(lower::pft::Evaluation &eval) {
- exitSuccessor(eval)->isNewBlock = true;
+ eval.nonNopSuccessor().isNewBlock = true;
}
template <typename A>
@@ -521,7 +532,8 @@ class PFTBuilder {
[&](const parser::AssignedGotoStmt &) {
// Although this statement is a branch, it doesn't have any
// explicit control successors. So the code at the end of the
- // loop won't mark the exit successor. Do that here.
+ // loop won't mark the successor. Do that here.
+ eval.isUnstructured = true;
markSuccessorAsNewBlock(eval);
},
@@ -542,7 +554,7 @@ class PFTBuilder {
lastConstructStmtEvaluation = &eval;
},
[&](const parser::EndSelectStmt &) {
- eval.lexicalSuccessor->isNewBlock = true;
+ eval.nonNopSuccessor().isNewBlock = true;
lastConstructStmtEvaluation = nullptr;
},
[&](const parser::ChangeTeamStmt &s) {
@@ -563,7 +575,7 @@ class PFTBuilder {
eval.isUnstructured = true; // infinite loop
return;
}
- eval.lexicalSuccessor->isNewBlock = true;
+ eval.nonNopSuccessor().isNewBlock = true;
eval.controlSuccessor = &evaluationList.back();
if (std::holds_alternative<parser::ScalarLogicalExpr>(control->u)) {
eval.isUnstructured = true; // while loop
@@ -702,7 +714,7 @@ class PFTBuilder {
markSuccessorAsNewBlock(eval);
lastIfStmtEvaluation->isUnstructured = true;
}
- lastIfStmtEvaluation->controlSuccessor = exitSuccessor(eval);
+ lastIfStmtEvaluation->controlSuccessor = &eval.nonNopSuccessor();
lastIfStmtEvaluation = nullptr;
}
@@ -718,7 +730,7 @@ class PFTBuilder {
parentConstruct->isUnstructured = true;
}
- // The lexical successor of a branch starts a new block.
+ // The successor of a branch starts a new block.
if (eval.controlSuccessor && eval.isActionStmt() &&
eval.lowerAsUnstructured()) {
markSuccessorAsNewBlock(eval);
@@ -1041,6 +1053,16 @@ struct SymbolDependenceDepth {
void Fortran::lower::pft::FunctionLikeUnit::processSymbolTable(
const semantics::Scope &scope) {
+ // TODO: handle equivalence and common blocks
+ if (!scope.equivalenceSets().empty()) {
+ llvm::errs() << "TODO: equivalence not yet handled in lowering.\n"
+ << "note: equivalence used in "
+ << (scope.GetName() && !scope.GetName()->empty()
+ ? scope.GetName()->ToString()
+ : "unnamed program"s)
+ << "\n";
+ exit(1);
+ }
SymbolDependenceDepth sdd{varList};
for (const auto &iter : scope)
sdd.analyze(iter.second.get());
diff --git a/flang/lib/Lower/RTBuilder.h b/flang/lib/Lower/RTBuilder.h
index a2a1c7c86cb4..9082e85d6fd8 100644
--- a/flang/lib/Lower/RTBuilder.h
+++ b/flang/lib/Lower/RTBuilder.h
@@ -212,22 +212,41 @@ struct RuntimeTableKey<RT(ATs...)> {
// Runtime table building (constexpr folded)
//===----------------------------------------------------------------------===//
-#if defined(__clang__)
-#pragma clang diagnostic push
-#pragma clang diagnostic ignored "-Wgnu-string-literal-operator-template"
-#endif
-
-// clang++ generates warnings about usage of a GNU extension, ignore them
template <char... Cs>
using RuntimeIdentifier = std::integer_sequence<char, Cs...>;
-template <typename T, T... Cs>
-static constexpr RuntimeIdentifier<Cs...> operator""_rt_ident() {
+
+namespace details {
+template <typename T, T... As, T... Bs>
+static constexpr std::integer_sequence<T, As..., Bs...>
+concat(std::integer_sequence<T, As...>, std::integer_sequence<T, Bs...>) {
return {};
}
-
-#if defined(__clang__)
-#pragma clang diagnostic pop
-#endif
+template <typename T, T... As, T... Bs, typename... Cs>
+static constexpr auto concat(std::integer_sequence<T, As...>,
+ std::integer_sequence<T, Bs...>, Cs...) {
+ return concat(std::integer_sequence<T, As..., Bs...>{}, Cs{}...);
+}
+template <typename T>
+static constexpr std::integer_sequence<T> concat(std::integer_sequence<T>) {
+ return {};
+}
+template <typename T, T a>
+static constexpr auto filterZero(std::integer_sequence<T, a>) {
+ if constexpr (a != 0) {
+ return std::integer_sequence<T, a>{};
+ } else {
+ return std::integer_sequence<T>{};
+ }
+}
+template <typename T, T... b>
+static constexpr auto filter(std::integer_sequence<T, b...>) {
+ if constexpr (sizeof...(b) > 0) {
+ return details::concat(filterZero(std::integer_sequence<T, b>{})...);
+ } else {
+ return std::integer_sequence<T>{};
+ }
+}
+} // namespace details
template <typename...>
struct RuntimeTableEntry;
@@ -239,11 +258,23 @@ struct RuntimeTableEntry<RuntimeTableKey<KT>, RuntimeIdentifier<Cs...>> {
static constexpr const char name[sizeof...(Cs) + 1] = {Cs..., '\0'};
};
-#define QuoteKey(X) #X##_rt_ident
-#define ExpandKey(X) QuoteKey(X)
+#undef E
+#define E(L, I) (I < sizeof(L) / sizeof(*L) ? L[I] : 0)
+#define QuoteKey(X) #X
+#define MacroExpandKey(X) \
+ E(X, 0), E(X, 1), E(X, 2), E(X, 3), E(X, 4), E(X, 5), E(X, 6), E(X, 7), \
+ E(X, 8), E(X, 9), E(X, 10), E(X, 11), E(X, 12), E(X, 13), E(X, 14), \
+ E(X, 15), E(X, 16), E(X, 17), E(X, 18), E(X, 19), E(X, 20), E(X, 21), \
+ E(X, 22), E(X, 23), E(X, 24), E(X, 25), E(X, 26), E(X, 27), E(X, 28), \
+ E(X, 29), E(X, 30), E(X, 31), E(X, 32), E(X, 33), E(X, 34), E(X, 35), \
+ E(X, 36), E(X, 37), E(X, 38), E(X, 39), E(X, 40), E(X, 41), E(X, 42), \
+ E(X, 43), E(X, 44), E(X, 45), E(X, 46), E(X, 47), E(X, 48), E(X, 49)
+#define ExpandKey(X) MacroExpandKey(QuoteKey(X))
+#define FullSeq(X) std::integer_sequence<char, ExpandKey(X)>
+#define AsSequence(X) decltype(Fortran::lower::details::filter(FullSeq(X){}))
#define mkKey(X) \
Fortran::lower::RuntimeTableEntry< \
- Fortran::lower::RuntimeTableKey<decltype(X)>, decltype(ExpandKey(X))>
+ Fortran::lower::RuntimeTableKey<decltype(X)>, AsSequence(X)>
} // namespace Fortran::lower
diff --git a/flang/lib/Lower/SymbolMap.h b/flang/lib/Lower/SymbolMap.h
index a1128d1d4381..3c99febc1517 100644
--- a/flang/lib/Lower/SymbolMap.h
+++ b/flang/lib/Lower/SymbolMap.h
@@ -19,6 +19,7 @@
#include "llvm/ADT/DenseMap.h"
#include "llvm/ADT/Optional.h"
#include "llvm/ADT/SmallVector.h"
+#include "llvm/Support/Compiler.h"
namespace Fortran::lower {
@@ -238,7 +239,7 @@ class SymMap {
void clear() { symbolMap.clear(); }
/// Dump the map. For debugging.
- void dump() const;
+ LLVM_DUMP_METHOD void dump() const;
private:
/// Add `symbol` to the current map and bind a `box`.
diff --git a/flang/lib/Optimizer/Support/KindMapping.cpp b/flang/lib/Optimizer/Support/KindMapping.cpp
index 8731c0bb087e..e1debae9a920 100644
--- a/flang/lib/Optimizer/Support/KindMapping.cpp
+++ b/flang/lib/Optimizer/Support/KindMapping.cpp
@@ -8,7 +8,6 @@
#include "flang/Optimizer/Support/KindMapping.h"
#include "mlir/Dialect/LLVMIR/LLVMDialect.h"
-#include "llvm/ADT/Optional.h"
#include "llvm/Support/CommandLine.h"
/// Allow the user to set the FIR intrinsic type kind value to LLVM type
@@ -219,26 +218,33 @@ MatchResult fir::KindMapping::parse(llvm::StringRef kindMap) {
return mlir::success();
}
-Bitsize fir::KindMapping::getCharacterBitsize(KindTy kind) {
+Bitsize fir::KindMapping::getCharacterBitsize(KindTy kind) const {
return getIntegerLikeBitsize<'a'>(kind, intMap);
}
-Bitsize fir::KindMapping::getIntegerBitsize(KindTy kind) {
+Bitsize fir::KindMapping::getIntegerBitsize(KindTy kind) const {
return getIntegerLikeBitsize<'i'>(kind, intMap);
}
-Bitsize fir::KindMapping::getLogicalBitsize(KindTy kind) {
+Bitsize fir::KindMapping::getLogicalBitsize(KindTy kind) const {
return getIntegerLikeBitsize<'l'>(kind, intMap);
}
-LLVMTypeID fir::KindMapping::getRealTypeID(KindTy kind) {
+LLVMTypeID fir::KindMapping::getRealTypeID(KindTy kind) const {
return getFloatLikeTypeID<'r'>(kind, floatMap);
}
-LLVMTypeID fir::KindMapping::getComplexTypeID(KindTy kind) {
+LLVMTypeID fir::KindMapping::getComplexTypeID(KindTy kind) const {
return getFloatLikeTypeID<'c'>(kind, floatMap);
}
-const llvm::fltSemantics &fir::KindMapping::getFloatSemantics(KindTy kind) {
+Bitsize fir::KindMapping::getRealBitsize(KindTy kind) const {
+ auto typeId = getFloatLikeTypeID<'r'>(kind, floatMap);
+ llvm::LLVMContext llCtxt; // FIXME
+ return llvm::Type::getPrimitiveType(llCtxt, typeId)->getPrimitiveSizeInBits();
+}
+
+const llvm::fltSemantics &
+fir::KindMapping::getFloatSemantics(KindTy kind) const {
return getFloatSemanticsOfKind<'r'>(kind, floatMap);
}
More information about the flang-commits
mailing list