From fd80be998c2fafbd4a1c270205cfb228f045e580 Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Tue, 18 Aug 2020 14:38:09 -0700 Subject: [PATCH 1/2] Support for target specific lowering in the Tilikum bridge. To generate correct code for a chosen target, the Tilikum bridge must know what the selected target is and the conventions used for the specific target ABI. The properties of the target influence the calling conventions and LLVM IR that must be generated. Tilikum is the last point before any high-level abstractions must be considered and correctly translated to LLVM IR. These changed rework the Tilikum bridge to use a target specifier and convert the calling conventions and memory layouts appropriate for the selected target. Two target specifications are implemented. i386-unknown-linux-gnu and x86_64-unknown-linux-gnu. Others can be added as needed. Two high-level type abstractions are considered: COMPLEX and CHARACTER. Moving these target specific lowerings to a common place in code gen eliminates the need to perform heroics with custom code in lowering and/or reliance on assuming the target is known by implication at compiler compile-time. --- .../flang/Optimizer/CodeGen/CGPasses.td | 21 +- .../include/flang/Optimizer/CodeGen/CodeGen.h | 12 + .../include/flang/Optimizer/Dialect/FIROps.td | 36 +- .../include/flang/Optimizer/Dialect/FIRType.h | 60 +- .../flang/Optimizer/Support/FIRContext.h | 12 +- flang/lib/Lower/ComplexExpr.cpp | 4 +- flang/lib/Lower/ConvertExpr.cpp | 17 +- flang/lib/Lower/ConvertType.cpp | 2 +- flang/lib/Lower/FIRBuilder.cpp | 2 +- flang/lib/Lower/IO.cpp | 4 +- flang/lib/Lower/IntrinsicCall.cpp | 12 +- flang/lib/Lower/Mangler.cpp | 2 +- flang/lib/Lower/RTBuilder.h | 4 +- flang/lib/Optimizer/CMakeLists.txt | 1 + flang/lib/Optimizer/CodeGen/CodeGen.cpp | 217 +++--- flang/lib/Optimizer/CodeGen/PassDetail.h | 1 + flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp | 700 +++++++++++++++++- flang/lib/Optimizer/CodeGen/Target.cpp | 189 +++++ flang/lib/Optimizer/CodeGen/Target.h | 108 +++ flang/lib/Optimizer/Dialect/FIRDialect.cpp | 9 +- flang/lib/Optimizer/Dialect/FIROps.cpp | 14 +- flang/lib/Optimizer/Dialect/FIRType.cpp | 237 ++++-- flang/lib/Optimizer/Support/FIRContext.cpp | 15 +- flang/test/Fir/boxchar.fir | 5 +- flang/test/Fir/compare.fir | 11 +- flang/test/Fir/complex.fir | 10 +- flang/test/Fir/convert.fir | 4 +- flang/test/Fir/target.fir | 117 +++ flang/test/Lower/bbcnull.f90 | 4 + flang/test/Lower/dummy-procedure.f90 | 26 +- flang/test/Lower/intrinsics.f90 | 24 +- flang/test/Lower/procedure-declarations.f90 | 14 +- flang/test/Lower/stmt-function.f90 | 6 +- flang/tools/bbc/bbc.cpp | 20 +- flang/tools/tco/tco.cpp | 1 + flang/unittests/Lower/RTBuilder.cpp | 2 +- mlir/lib/Target/LLVMIR/ModuleTranslation.cpp | 18 + 37 files changed, 1614 insertions(+), 327 deletions(-) create mode 100644 flang/lib/Optimizer/CodeGen/Target.cpp create mode 100644 flang/lib/Optimizer/CodeGen/Target.h create mode 100644 flang/test/Fir/target.fir create mode 100644 flang/test/Lower/bbcnull.f90 diff --git a/flang/include/flang/Optimizer/CodeGen/CGPasses.td b/flang/include/flang/Optimizer/CodeGen/CGPasses.td index 187147b8375fd..70f7574d67ea5 100644 --- a/flang/include/flang/Optimizer/CodeGen/CGPasses.td +++ b/flang/include/flang/Optimizer/CodeGen/CGPasses.td @@ -17,8 +17,27 @@ include "mlir/Pass/PassBase.td" def CodeGenRewrite : FunctionPass<"cg-rewrite"> { - let summary = "Rewrite some FIR ops into their code-gen forms."; + let summary = "Rewrite some FIR ops into their code-gen forms. " + "Fuse specific subgraphs into single Ops for code generation."; let constructor = "fir::createFirCodeGenRewritePass()"; + let dependentDialects = ["fir::FIROpsDialect"]; +} + +def TargetRewrite : Pass<"target-rewrite", "mlir::ModuleOp"> { + let summary = "Rewrite some FIR dialect into target specific forms. " + "Certain abstractions in the FIR dialect need to be rewritten " + "to reflect representations that may differ based on the " + "target machine."; + let constructor = "fir::createFirTargetRewritePass()"; + let dependentDialects = ["fir::FIROpsDialect"]; + let options = [ + Option<"noCharacterConversion", "no-character-conversion", + "bool", /*default=*/"false", + "Disable target-specific conversion of CHARACTER.">, + Option<"noComplexConversion", "no-complex-conversion", + "bool", /*default=*/"false", + "Disable target-specific conversion of COMPLEX."> + ]; } #endif // FLANG_OPTIMIZER_CODEGEN_PASSES diff --git a/flang/include/flang/Optimizer/CodeGen/CodeGen.h b/flang/include/flang/Optimizer/CodeGen/CodeGen.h index a90d0a50dac64..03754a19dea31 100644 --- a/flang/include/flang/Optimizer/CodeGen/CodeGen.h +++ b/flang/include/flang/Optimizer/CodeGen/CodeGen.h @@ -9,6 +9,7 @@ #ifndef OPTIMIZER_CODEGEN_CODEGEN_H #define OPTIMIZER_CODEGEN_CODEGEN_H +#include "mlir/IR/Module.h" #include "mlir/Pass/Pass.h" #include "mlir/Pass/PassRegistry.h" #include @@ -21,6 +22,17 @@ struct NameUniquer; /// the code gen (to LLVM-IR dialect) conversion. std::unique_ptr createFirCodeGenRewritePass(); +/// FirTargetRewritePass options. +struct TargetRewriteOptions { + bool noCharacterConversion{}; + bool noComplexConversion{}; +}; + +/// Prerequiste pass for code gen. Perform intermediate rewrites to tailor the +/// IR for the chosen target. +std::unique_ptr> createFirTargetRewritePass( + const TargetRewriteOptions &options = TargetRewriteOptions()); + /// Convert FIR to the LLVM IR dialect std::unique_ptr createFIRToLLVMPass(NameUniquer &uniquer); diff --git a/flang/include/flang/Optimizer/Dialect/FIROps.td b/flang/include/flang/Optimizer/Dialect/FIROps.td index a4508e9682443..b2e7de4899f8a 100644 --- a/flang/include/flang/Optimizer/Dialect/FIROps.td +++ b/flang/include/flang/Optimizer/Dialect/FIROps.td @@ -30,14 +30,16 @@ def fir_Type : Type, // Fortran intrinsic types def fir_CharacterType : Type()">, "FIR character type">; -def fir_ComplexType : Type()">, +def fir_ComplexType : Type()">, "FIR complex type">; -def fir_IntegerType : Type()">, +def fir_IntegerType : Type()">, "FIR integer type">; def fir_LogicalType : Type()">, "FIR logical type">; def fir_RealType : Type()">, "FIR real type">; +def fir_VectorType : Type()">, + "FIR vector type">; // Generalized FIR and standard dialect types representing intrinsic types def AnyIntegerLike : TypeConstraint()">, // Composable types def AnyCompositeLike : TypeConstraint, "any composite">; + fir_VectorType.predicate, IsTupleTypePred]>, "any composite">; // Reference to an entity type def fir_ReferenceType : Type()">, @@ -77,6 +79,10 @@ def fir_PointerType : Type()">, def AnyReferenceLike : TypeConstraint, "any reference">; +// The legal types of global symbols +def AnyAddressableLike : TypeConstraint, "any addressable">; + // A descriptor tuple (captures a reference to an entity and other information) def fir_BoxType : Type()">, "box type">; @@ -723,7 +729,7 @@ class fir_IntegralSwitchTerminatorOp() || getSelector().getType().isa() || - getSelector().getType().isa())) + getSelector().getType().isa())) return emitOpError("must be an integer"); auto cases = getAttrOfType(getCasesAttr()).getValue(); auto count = getNumDest(); @@ -847,7 +853,7 @@ def fir_SelectCaseOp : fir_SwitchTerminatorOp<"select_case"> { let verifier = [{ if (!(getSelector().getType().isa() || getSelector().getType().isa() || - getSelector().getType().isa() || + getSelector().getType().isa() || getSelector().getType().isa() || getSelector().getType().isa())) return emitOpError("must be an integer, character, or logical"); @@ -2349,6 +2355,8 @@ def fir_CallOp : fir_Op<"call", [CallOpInterface]> { let extraClassDeclaration = [{ static constexpr StringRef calleeAttrName() { return "callee"; } + mlir::FunctionType getFunctionType(); + /// Get the argument operands to the called function. operand_range getArgOperands() { if (auto calling = getAttrOfType(calleeAttrName())) @@ -2410,7 +2418,6 @@ def fir_DispatchOp : fir_Op<"dispatch", []> { parser.resolveOperands( operands, calleeType.getInputs(), calleeLoc, result.operands)) return mlir::failure(); - result.addAttribute("fn_type", mlir::TypeAttr::get(calleeType)); return mlir::success(); }]; @@ -2422,10 +2429,8 @@ def fir_DispatchOp : fir_Op<"dispatch", []> { p.printOperands(args()); } p << ')'; - p.printOptionalAttrDict(getAttrs(), {"fn_type", "method"}); - auto resTy{getResultTypes()}; - llvm::SmallVector argTy(getOperandTypes()); - p << " : " << mlir::FunctionType::get(argTy, resTy, getContext()); + p.printOptionalAttrDict(getAttrs(), {"method"}); + p << " : " << getFunctionType(); }]; let extraClassDeclaration = [{ @@ -2676,7 +2681,7 @@ def fir_ConstcOp : fir_Op<"constc", [NoSideEffect]> { }]; let verifier = [{ - if (!getType().isa()) + if (!getType().isa()) return emitOpError("must be a !fir.complex type"); return mlir::success(); }]; @@ -2747,7 +2752,8 @@ def fir_AddrOfOp : fir_OneResultOp<"address_of", [NoSideEffect]> { let description = [{ Convert a symbol (a function or global reference) to an SSA-value to be - used in other Operations. + used in other Operations. References to Fortran symbols are distinguished + via this operation from other arbitrary constant values. ```mlir %p = fir.address_of(@symbol) : !fir.ref @@ -2756,7 +2762,7 @@ def fir_AddrOfOp : fir_OneResultOp<"address_of", [NoSideEffect]> { let arguments = (ins SymbolRefAttr:$symbol); - let results = (outs fir_ReferenceType:$resTy); + let results = (outs AnyAddressableLike:$resTy); let assemblyFormat = "`(` $symbol `)` attr-dict `:` type($resTy)"; } @@ -2814,8 +2820,8 @@ def fir_ConvertOp : fir_OneResultOp<"convert", [NoSideEffect]> { def FortranTypeAttr : Attr()">, Or<[CPred<"$_self.cast().getValue().isa()">, - CPred<"$_self.cast().getValue().isa()">, - CPred<"$_self.cast().getValue().isa()">, + CPred<"$_self.cast().getValue().isa()">, + CPred<"$_self.cast().getValue().isa()">, CPred<"$_self.cast().getValue().isa()">, CPred<"$_self.cast().getValue().isa()">, CPred<"$_self.cast().getValue().isa()">]>]>, diff --git a/flang/include/flang/Optimizer/Dialect/FIRType.h b/flang/include/flang/Optimizer/Dialect/FIRType.h index eca5a219e3125..8721aa391b3bb 100644 --- a/flang/include/flang/Optimizer/Dialect/FIRType.h +++ b/flang/include/flang/Optimizer/Dialect/FIRType.h @@ -43,10 +43,10 @@ struct BoxTypeStorage; struct BoxCharTypeStorage; struct BoxProcTypeStorage; struct CharacterTypeStorage; -struct CplxTypeStorage; +struct ComplexTypeStorage; struct FieldTypeStorage; struct HeapTypeStorage; -struct IntTypeStorage; +struct IntegerTypeStorage; struct LenTypeStorage; struct LogicalTypeStorage; struct PointerTypeStorage; @@ -58,6 +58,7 @@ struct ShapeTypeStorage; struct ShapeShiftTypeStorage; struct SliceTypeStorage; struct TypeDescTypeStorage; +struct VectorTypeStorage; } // namespace detail // These isa_ routines follow the precedent of llvm::isa_or_null<> @@ -125,11 +126,11 @@ class CharacterType /// Model of a Fortran COMPLEX intrinsic type, including the KIND type /// parameter. COMPLEX is a floating point type with a real and imaginary /// member. -class CplxType : public mlir::Type::TypeBase { +class ComplexType : public mlir::Type::TypeBase { public: using Base::Base; - static CplxType get(mlir::MLIRContext *ctxt, KindTy kind); + static fir::ComplexType get(mlir::MLIRContext *ctxt, KindTy kind); /// Get the corresponding fir.real type. mlir::Type getElementType() const; @@ -139,19 +140,18 @@ class CplxType : public mlir::Type::TypeBase { +class IntegerType : public mlir::Type::TypeBase { public: using Base::Base; - static IntType get(mlir::MLIRContext *ctxt, KindTy kind); + static fir::IntegerType get(mlir::MLIRContext *ctxt, KindTy kind); KindTy getFKind() const; }; /// Model of a Fortran LOGICAL intrinsic type, including the KIND type /// parameter. -class LogicalType - : public mlir::Type::TypeBase { +class LogicalType : public mlir::Type::TypeBase { public: using Base::Base; static LogicalType get(mlir::MLIRContext *ctxt, KindTy kind); @@ -414,14 +414,6 @@ class RecordType : public mlir::Type::TypeBase() || t.isa(); @@ -430,12 +422,38 @@ inline bool isa_real(mlir::Type t) { /// Is `t` an integral type? inline bool isa_integer(mlir::Type t) { return t.isa() || t.isa() || - t.isa(); + t.isa(); } +/// Replacement for the standard dialect's vector type. Relaxes some of the +/// constraints and imposes some new ones. +class VectorType : public mlir::Type::TypeBase { +public: + using Base::Base; + + static fir::VectorType get(uint64_t len, mlir::Type eleTy); + mlir::Type getEleTy() const; + uint64_t getLen() const; + + static mlir::LogicalResult + verifyConstructionInvariants(mlir::Location, uint64_t len, mlir::Type eleTy); + static bool isValidElementType(mlir::Type t) { + return isa_real(t) || isa_integer(t); + } +}; + +mlir::Type parseFirType(FIROpsDialect *, mlir::DialectAsmParser &parser); + +void printFirType(FIROpsDialect *, mlir::Type ty, mlir::DialectAsmPrinter &p); + +/// Guarantee `type` is a scalar integral type (standard Integer, standard +/// Index, or FIR Int). Aborts execution if condition is false. +void verifyIntegralType(mlir::Type type); + /// Is `t` a FIR or MLIR Complex type? inline bool isa_complex(mlir::Type t) { - return t.isa() || t.isa(); + return t.isa() || t.isa(); } inline bool isa_char_string(mlir::Type t) { diff --git a/flang/include/flang/Optimizer/Support/FIRContext.h b/flang/include/flang/Optimizer/Support/FIRContext.h index f02b213551ef6..2bd249cefa3f7 100644 --- a/flang/include/flang/Optimizer/Support/FIRContext.h +++ b/flang/include/flang/Optimizer/Support/FIRContext.h @@ -29,21 +29,24 @@ namespace fir { class KindMapping; struct NameUniquer; -/// Set the target triple for the module. +/// Set the target triple for the module. `triple` must not be deallocated while +/// module `mod` is still live. void setTargetTriple(mlir::ModuleOp mod, llvm::Triple &triple); /// Get a pointer to the Triple instance from the Module. If none was set, /// returns a nullptr. llvm::Triple *getTargetTriple(mlir::ModuleOp mod); -/// Set the name uniquer for the module. +/// Set the name uniquer for the module. `uniquer` must not be deallocated while +/// module `mod` is still live. void setNameUniquer(mlir::ModuleOp mod, NameUniquer &uniquer); /// Get a pointer to the NameUniquer instance from the Module. If none was set, /// returns a nullptr. NameUniquer *getNameUniquer(mlir::ModuleOp mod); -/// Set the kind mapping for the module. +/// Set the kind mapping for the module. `kindMap` must not be deallocated while +/// module `mod` is still live. void setKindMapping(mlir::ModuleOp mod, KindMapping &kindMap); /// Get a pointer to the KindMapping instance from the Module. If none was set, @@ -53,6 +56,9 @@ KindMapping *getKindMapping(mlir::ModuleOp mod); /// Helper for determining the target from the host, etc. Tools may use this /// function to provide a consistent interpretation of the `--target=` /// command-line option. +/// An empty string ("") or "default" will specify that the default triple +/// should be used. "native" will specify that the host machine be used to +/// construct the triple. std::string determineTargetTriple(llvm::StringRef triple); } // namespace fir diff --git a/flang/lib/Lower/ComplexExpr.cpp b/flang/lib/Lower/ComplexExpr.cpp index 1a66c95f8ed87..03a91dc00e266 100644 --- a/flang/lib/Lower/ComplexExpr.cpp +++ b/flang/lib/Lower/ComplexExpr.cpp @@ -16,7 +16,7 @@ mlir::Type Fortran::lower::ComplexExprHelper::getComplexPartType(mlir::Type complexType) { return Fortran::lower::convertReal( - builder.getContext(), complexType.cast().getFKind()); + builder.getContext(), complexType.cast().getFKind()); } mlir::Type @@ -27,7 +27,7 @@ Fortran::lower::ComplexExprHelper::getComplexPartType(mlir::Value cplx) { mlir::Value Fortran::lower::ComplexExprHelper::createComplex(fir::KindTy kind, mlir::Value real, mlir::Value imag) { - auto complexTy = fir::CplxType::get(builder.getContext(), kind); + auto complexTy = fir::ComplexType::get(builder.getContext(), kind); mlir::Value und = builder.create(loc, complexTy); return insert(insert(und, real), imag); } diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 593c5f8fb3460..9c0de546492fe 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -32,6 +32,7 @@ #include "llvm/Support/CommandLine.h" #include "llvm/Support/ErrorHandling.h" #include "llvm/Support/raw_ostream.h" +#define DEBUG_TYPE "flang-lower-expr" #define TODO() llvm_unreachable("not yet implemented") @@ -362,7 +363,7 @@ class ExprLowering { Fortran::lower::getUnrestrictedIntrinsicSymbolRefAttr( builder, getLoc(), genericName, signature); mlir::Value funcPtr = - builder.create(getLoc(), signature, symbolRefAttr); + builder.create(getLoc(), signature, symbolRefAttr); return funcPtr; } const auto *symbol = proc.GetSymbol(); @@ -374,7 +375,7 @@ class ExprLowering { } auto name = converter.mangleName(*symbol); auto func = Fortran::lower::getOrDeclareFunction(name, proc, converter); - mlir::Value funcPtr = builder.create( + mlir::Value funcPtr = builder.create( getLoc(), func.getType(), builder.getSymbolRefAttr(name)); return funcPtr; } @@ -1350,6 +1351,7 @@ class ExprLowering { } } auto result = genval(details.stmtFunction().value()); + LLVM_DEBUG(llvm::errs() << "stmt-function: " << result << '\n'); // Remove dummy local arguments from the map. for (const auto *dummySymbol : details.dummyArgs()) symMap.erase(*dummySymbol); @@ -1469,7 +1471,7 @@ class ExprLowering { if (callSiteType.getNumResults() != funcOpType.getNumResults() || callSiteType.getNumInputs() != funcOpType.getNumInputs()) funcPointer = - builder.create(getLoc(), funcOpType, symbolAttr); + builder.create(getLoc(), funcOpType, symbolAttr); else funcSymbolAttr = symbolAttr; } @@ -1585,6 +1587,8 @@ mlir::Value Fortran::lower::createSomeExpression( const Fortran::evaluate::Expr &expr, Fortran::lower::SymMap &symMap) { Fortran::lower::ExpressionContext unused; + LLVM_DEBUG(llvm::errs() << "expr: "; expr.AsFortran(llvm::errs()); + llvm::errs() << '\n'); return ExprLowering{loc, converter, symMap, unused}.genValue(expr); } @@ -1593,6 +1597,8 @@ fir::ExtendedValue Fortran::lower::createSomeExtendedExpression( const Fortran::evaluate::Expr &expr, Fortran::lower::SymMap &symMap, const Fortran::lower::ExpressionContext &context) { + LLVM_DEBUG(llvm::errs() << "expr: "; expr.AsFortran(llvm::errs()); + llvm::errs() << '\n'); return ExprLowering{loc, converter, symMap, context}.genExtValue(expr); } @@ -1601,6 +1607,8 @@ mlir::Value Fortran::lower::createSomeAddress( const Fortran::evaluate::Expr &expr, Fortran::lower::SymMap &symMap) { Fortran::lower::ExpressionContext unused; + LLVM_DEBUG(llvm::errs() << "address: "; expr.AsFortran(llvm::errs()); + llvm::errs() << '\n'); return ExprLowering{loc, converter, symMap, unused}.genAddr(expr); } @@ -1609,6 +1617,8 @@ fir::ExtendedValue Fortran::lower::createSomeExtendedAddress( const Fortran::evaluate::Expr &expr, Fortran::lower::SymMap &symMap, const Fortran::lower::ExpressionContext &context) { + LLVM_DEBUG(llvm::errs() << "address: "; expr.AsFortran(llvm::errs()); + llvm::errs() << '\n'); return ExprLowering{loc, converter, symMap, context}.genExtAddr(expr); } @@ -1618,6 +1628,7 @@ fir::ExtendedValue Fortran::lower::createStringLiteral( assert(str.size() == len); Fortran::lower::SymMap unused1; Fortran::lower::ExpressionContext unused2; + LLVM_DEBUG(llvm::errs() << "string-lit: \"" << str << "\"\n"); return ExprLowering{loc, converter, unused1, unused2}.genStringLit(str, len); } diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp index 276df03d6288d..96539f0516698 100644 --- a/flang/lib/Lower/ConvertType.cpp +++ b/flang/lib/Lower/ConvertType.cpp @@ -167,7 +167,7 @@ genFIRType(mlir::MLIRContext *context, int KIND) { if (Fortran::evaluate::IsValidKindOfIntrinsicType( Fortran::common::TypeCategory::Complex, KIND)) - return fir::CplxType::get(context, KIND); + return fir::ComplexType::get(context, KIND); return {}; } diff --git a/flang/lib/Lower/FIRBuilder.cpp b/flang/lib/Lower/FIRBuilder.cpp index c355d65824fff..a1efb3fb03d98 100644 --- a/flang/lib/Lower/FIRBuilder.cpp +++ b/flang/lib/Lower/FIRBuilder.cpp @@ -153,7 +153,7 @@ mlir::Value Fortran::lower::FirOpBuilder::convertWithSemantics( auto eleTy = helper.getComplexPartType(toTy); auto cast = createConvert(loc, eleTy, val); llvm::APFloat zero{ - kindMap.getFloatSemantics(toTy.cast().getFKind()), 0}; + kindMap.getFloatSemantics(toTy.cast().getFKind()), 0}; auto imag = createRealConstant(loc, eleTy, zero); return helper.createComplex(toTy, cast, imag); } diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp index c44e2ca441eed..e2edade57c260 100644 --- a/flang/lib/Lower/IO.cpp +++ b/flang/lib/Lower/IO.cpp @@ -202,7 +202,7 @@ static mlir::FuncOp getOutputFunc(mlir::Location loc, return ty.getWidth() <= 32 ? getIORuntimeFunc(loc, builder) : getIORuntimeFunc(loc, builder); - if (auto ty = type.dyn_cast()) + if (auto ty = type.dyn_cast()) return ty.getFKind() <= 4 ? getIORuntimeFunc(loc, builder) : getIORuntimeFunc(loc, builder); @@ -282,7 +282,7 @@ static mlir::FuncOp getInputFunc(mlir::Location loc, return ty.getWidth() <= 32 ? getIORuntimeFunc(loc, builder) : getIORuntimeFunc(loc, builder); - if (auto ty = type.dyn_cast()) + if (auto ty = type.dyn_cast()) return ty.getFKind() <= 4 ? getIORuntimeFunc(loc, builder) : getIORuntimeFunc(loc, builder); diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp index 8590588b07ee6..086354a80ffc6 100644 --- a/flang/lib/Lower/IntrinsicCall.cpp +++ b/flang/lib/Lower/IntrinsicCall.cpp @@ -517,7 +517,7 @@ class FunctionDistance { // - or use evaluate/type.h if (auto r{t.dyn_cast()}) return r.getFKind() * 4; - if (auto cplx{t.dyn_cast()}) + if (auto cplx{t.dyn_cast()}) return cplx.getFKind() * 4; llvm_unreachable("not a floating-point type"); } @@ -537,8 +537,8 @@ class FunctionDistance { ? Conversion::Narrow : Conversion::Extend; } - if (auto fromCplxTy{from.dyn_cast()}) { - if (auto toCplxTy{to.dyn_cast()}) { + if (auto fromCplxTy{from.dyn_cast()}) { + if (auto toCplxTy{to.dyn_cast()}) { return getFloatingPointWidth(fromCplxTy) > getFloatingPointWidth(toCplxTy) ? Conversion::Narrow @@ -909,7 +909,7 @@ IntrinsicLibrary::outlineInWrapper(GeneratorType generator, auto funcType = getFunctionType(resultType, args, builder); auto wrapper = getWrapper(generator, name, funcType); - return builder.create(loc, wrapper, args).getResult(0); + return builder.create(loc, wrapper, args).getResult(0); } fir::ExtendedValue @@ -929,7 +929,7 @@ IntrinsicLibrary::outlineInWrapper(ExtendedGenerator generator, auto funcType = getFunctionType(resultType, mlirArgs, builder); auto wrapper = getWrapper(generator, name, funcType); auto mlirResult = - builder.create(loc, wrapper, mlirArgs).getResult(0); + builder.create(loc, wrapper, mlirArgs).getResult(0); return toExtendedValue(mlirResult, builder, loc); } @@ -956,7 +956,7 @@ IntrinsicLibrary::getRuntimeCallGenerator(llvm::StringRef name, for (const auto &pair : llvm::zip(actualFuncType.getInputs(), args)) convertedArguments.push_back( builder.createConvert(loc, std::get<0>(pair), std::get<1>(pair))); - auto call = builder.create(loc, funcOp, convertedArguments); + auto call = builder.create(loc, funcOp, convertedArguments); mlir::Type soughtType = soughtFuncType.getResult(0); return builder.createConvert(loc, soughtType, call.getResult(0)); }; diff --git a/flang/lib/Lower/Mangler.cpp b/flang/lib/Lower/Mangler.cpp index 7a3b23cffeb9f..6731a5855087d 100644 --- a/flang/lib/Lower/Mangler.cpp +++ b/flang/lib/Lower/Mangler.cpp @@ -136,7 +136,7 @@ static std::string typeToString(mlir::Type t) { if (auto i{t.dyn_cast()}) { return "i" + std::to_string(i.getWidth()); } - if (auto cplx{t.dyn_cast()}) { + if (auto cplx{t.dyn_cast()}) { return "z" + std::to_string(cplx.getFKind()); } if (auto real{t.dyn_cast()}) { diff --git a/flang/lib/Lower/RTBuilder.h b/flang/lib/Lower/RTBuilder.h index 4b9745786e56f..733357b25a84f 100644 --- a/flang/lib/Lower/RTBuilder.h +++ b/flang/lib/Lower/RTBuilder.h @@ -193,13 +193,13 @@ constexpr TypeBuilderFunc getModel() { template <> constexpr TypeBuilderFunc getModel() { return [](mlir::MLIRContext *context) -> mlir::Type { - return fir::CplxType::get(context, sizeof(float)); + return fir::ComplexType::get(context, sizeof(float)); }; } template <> constexpr TypeBuilderFunc getModel() { return [](mlir::MLIRContext *context) -> mlir::Type { - return fir::CplxType::get(context, sizeof(double)); + return fir::ComplexType::get(context, sizeof(double)); }; } template <> diff --git a/flang/lib/Optimizer/CMakeLists.txt b/flang/lib/Optimizer/CMakeLists.txt index 69f0496cfab67..e71a177c76abf 100644 --- a/flang/lib/Optimizer/CMakeLists.txt +++ b/flang/lib/Optimizer/CMakeLists.txt @@ -15,6 +15,7 @@ add_flang_library(FIROptimizer CodeGen/CodeGen.cpp CodeGen/PreCGRewrite.cpp + CodeGen/Target.cpp Transforms/ControlFlowConverter.cpp Transforms/CSE.cpp diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index 4342bb545f69a..fb82365b907c9 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -12,11 +12,13 @@ #include "flang/Optimizer/CodeGen/CodeGen.h" #include "DescriptorModel.h" +#include "Target.h" #include "flang/Lower/Support/TypeCode.h" #include "flang/Optimizer/Dialect/FIRAttr.h" #include "flang/Optimizer/Dialect/FIRDialect.h" #include "flang/Optimizer/Dialect/FIROps.h" #include "flang/Optimizer/Dialect/FIRType.h" +#include "flang/Optimizer/Support/FIRContext.h" #include "flang/Optimizer/Support/InternalNames.h" #include "flang/Optimizer/Support/KindMapping.h" #include "mlir/Conversion/StandardToLLVM/ConvertStandardToLLVM.h" @@ -36,14 +38,19 @@ #include "llvm/Support/CommandLine.h" #include "llvm/Support/FileSystem.h" #include "llvm/Support/raw_ostream.h" + #define DEBUG_TYPE "flang-codegen" +//===----------------------------------------------------------------------===// +/// \file +/// /// The Tilikum bridge performs the conversion of operations from both the FIR /// and standard dialects to the LLVM-IR dialect. /// /// Some FIR operations may be lowered to other dialects, such as standard, but /// some FIR operations will pass through to the Tilikum bridge. This may be /// necessary to preserve the semantics of the Fortran program. +//===----------------------------------------------------------------------===// #undef TODO #define TODO() llvm::report_fatal_error("tilikum: not yet implemented") @@ -84,30 +91,47 @@ namespace { /// This converts FIR types to LLVM types (for now) class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { public: - FIRToLLVMTypeConverter(mlir::MLIRContext *context, fir::NameUniquer &uniquer) - : LLVMTypeConverter(context), kindMapping(context), uniquer(uniquer) { + FIRToLLVMTypeConverter(mlir::ModuleOp module) + : LLVMTypeConverter(module.getContext()), + kindMapping(*fir::getKindMapping(module)), + uniquer(*fir::getNameUniquer(module)), + specifics(fir::CodeGenSpecifics::get(module.getContext(), + *fir::getTargetTriple(module), + *fir::getKindMapping(module))) { + LLVM_DEBUG(llvm::errs() << "FIR type converter\n"); + + // Each conversion should return a value of type mlir::LLVM::LLVMType. addConversion([&](fir::BoxType box) { return convertBoxType(box); }); - addConversion( - [&](fir::BoxCharType boxchar) { return convertBoxCharType(boxchar); }); + addConversion([&](fir::BoxCharType boxchar) { + LLVM_DEBUG(llvm::errs() << "type convert: " << boxchar << '\n'); + return unwrap( + convertType(specifics->boxcharMemoryType(boxchar.getEleTy()))); + }); addConversion( [&](fir::BoxProcType boxproc) { return convertBoxProcType(boxproc); }); addConversion( [&](fir::CharacterType charTy) { return convertCharType(charTy); }); - addConversion([&](fir::CplxType cplx) { - return convertComplexType(cplx.getFKind()); - }); + addConversion( + [&](mlir::ComplexType cmplx) { return convertComplexType(cmplx); }); + addConversion( + [&](fir::ComplexType cmplx) { return convertComplexType(cmplx); }); addConversion( [&](fir::RecordType derived) { return convertRecordType(derived); }); addConversion([&](fir::FieldType field) { return mlir::LLVM::LLVMType::getInt32Ty(field.getContext()); }); addConversion([&](fir::HeapType heap) { return convertPointerLike(heap); }); - addConversion([&](fir::IntType intr) { return convertIntegerType(intr); }); + addConversion([&](fir::IntegerType intTy) { + return mlir::LLVM::LLVMType::getIntNTy( + &getContext(), kindMapping.getIntegerBitsize(intTy.getFKind())); + }); addConversion([&](fir::LenType field) { return mlir::LLVM::LLVMType::getInt32Ty(field.getContext()); }); - addConversion( - [&](fir::LogicalType logical) { return convertLogicalType(logical); }); + addConversion([&](fir::LogicalType boolTy) { + return mlir::LLVM::LLVMType::getIntNTy( + &getContext(), kindMapping.getLogicalBitsize(boolTy.getFKind())); + }); addConversion( [&](fir::PointerType pointer) { return convertPointerLike(pointer); }); addConversion( @@ -120,10 +144,19 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { addConversion([&](fir::TypeDescType tdesc) { return convertTypeDescType(tdesc.getContext()); }); - addConversion( - [&](mlir::TupleType tuple) { return convertTupleType(tuple); }); - addConversion( - [&](mlir::ComplexType cmplx) { return convertComplexType(cmplx); }); + addConversion([&](fir::VectorType vecTy) { + return mlir::LLVM::LLVMType::getVectorTy( + unwrap(convertType(vecTy.getEleTy())), vecTy.getLen()); + }); + addConversion([&](mlir::TupleType tuple) { + LLVM_DEBUG(llvm::errs() << "type convert: " << tuple << '\n'); + SmallVector inMembers; + tuple.getFlattenedTypes(inMembers); + SmallVector members; + for (auto mem : inMembers) + members.push_back(convertType(mem).cast()); + return mlir::LLVM::LLVMType::getStructTy(&getContext(), members); + }); addConversion([&](mlir::NoneType none) { return mlir::LLVM::LLVMStructType::getLiteral(none.getContext(), llvm::None); @@ -154,13 +187,6 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { }); } - // This returns the type of a single column. Rows are added by the caller. - // fir.dims --> llvm<"[r x [3 x i64]]"> - mlir::LLVM::LLVMType dimsType() { - auto i64Ty = mlir::LLVM::LLVMType::getInt64Ty(&getContext()); - return mlir::LLVM::LLVMType::getArrayTy(i64Ty, 3); - } - // i32 is used here because LLVM wants i32 constants when indexing into struct // types. Indexing into other aggregate types is more flexible. mlir::LLVM::LLVMType offsetType() { @@ -209,14 +235,6 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { .getPointerTo(); } - // fir.boxchar --> llvm<"{ ix*, i64 }"> where ix is kind mapping - mlir::LLVM::LLVMType convertBoxCharType(fir::BoxCharType boxchar) { - auto ptrTy = convertCharType(boxchar.getEleTy()).getPointerTo(); - auto i64Ty = mlir::LLVM::LLVMType::getInt64Ty(&getContext()); - SmallVector tuple{ptrTy, i64Ty}; - return mlir::LLVM::LLVMType::getStructTy(&getContext(), tuple); - } - // fir.boxproc --> llvm<"{ any*, i8* }"> mlir::LLVM::LLVMType convertBoxProcType(fir::BoxProcType boxproc) { auto funcTy = convertType(boxproc.getEleTy()); @@ -236,16 +254,22 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { characterBitsize(charTy)); } + // Convert a complex value's element type based on its Fortran kind. mlir::LLVM::LLVMType convertComplexPartType(fir::KindTy kind) { auto realID = kindMapping.getComplexTypeID(kind); return fromRealTypeID(realID, kind); } - // fir.complex --> llvm<"{ anyfloat, anyfloat }"> - mlir::LLVM::LLVMType convertComplexType(fir::KindTy kind) { - auto realTy = convertComplexPartType(kind); - SmallVector tuple{realTy, realTy}; - return mlir::LLVM::LLVMType::getStructTy(&getContext(), tuple); + // Use the target specifics to figure out how to map complex to LLVM IR. The + // use of complex values in function signatures is handled before conversion + // to LLVM IR dialect here. + // + // fir.complex | std.complex --> llvm<"{t,t}"> + template + mlir::LLVM::LLVMType convertComplexType(C cmplx) { + LLVM_DEBUG(llvm::errs() << "type convert: " << cmplx << '\n'); + auto eleTy = cmplx.getElementType(); + return unwrap(convertType(specifics->complexMemoryType(eleTy))); } mlir::LLVM::LLVMType getDefaultInt() { @@ -253,18 +277,6 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { return mlir::LLVM::LLVMType::getInt64Ty(&getContext()); } - // fir.int --> llvm.ix where ix is a kind mapping - mlir::LLVM::LLVMType convertIntegerType(fir::IntType intTy) { - return mlir::LLVM::LLVMType::getIntNTy( - &getContext(), kindMapping.getIntegerBitsize(intTy.getFKind())); - } - - // fir.logical --> llvm.ix where ix is a kind mapping - mlir::LLVM::LLVMType convertLogicalType(fir::LogicalType boolTy) { - return mlir::LLVM::LLVMType::getIntNTy( - &getContext(), kindMapping.getLogicalBitsize(boolTy.getFKind())); - } - template mlir::LLVM::LLVMType convertPointerLike(A &ty) { mlir::Type eleTy = ty.getEleTy(); @@ -323,23 +335,6 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { return baseTy.getPointerTo(); } - // tuple --> llvm<"{ ts... }"> - mlir::LLVM::LLVMType convertTupleType(mlir::TupleType tuple) { - SmallVector inMembers; - tuple.getFlattenedTypes(inMembers); - SmallVector members; - for (auto mem : inMembers) - members.push_back(convertType(mem).cast()); - return mlir::LLVM::LLVMType::getStructTy(&getContext(), members); - } - - // complex --> llvm<"{t,t}"> - mlir::LLVM::LLVMType convertComplexType(mlir::ComplexType complex) { - auto eleTy = unwrap(convertType(complex.getElementType())); - SmallVector tuple{eleTy, eleTy}; - return mlir::LLVM::LLVMType::getStructTy(&getContext(), tuple); - } - // fir.tdesc --> llvm<"i8*"> // FIXME: for now use a void*, however pointer identity is not sufficient for // the f18 object v. class distinction @@ -423,6 +418,7 @@ class FIRToLLVMTypeConverter : public mlir::LLVMTypeConverter { private: fir::KindMapping kindMapping; fir::NameUniquer &uniquer; + std::unique_ptr specifics; static StringMap identStructCache; }; @@ -486,7 +482,7 @@ class FIROpConversion : public mlir::OpConversionPattern { mlir::ConversionPatternRewriter &rewriter) const { auto c0 = genConstantOffset(loc, rewriter, 0); auto c3 = genConstantOffset(loc, rewriter, 3); - llvm::SmallVector args = {box, c0, c3}; + SmallVector args = {box, c0, c3}; auto pty = unwrap(resultTy).getPointerTo(); auto p = rewriter.create(loc, pty, args); return rewriter.create(loc, resultTy, p); @@ -494,8 +490,8 @@ class FIROpConversion : public mlir::OpConversionPattern { /// Method to construct code sequence to get the triple for dimension `dim` /// from a box. - llvm::SmallVector - getDimsFromBox(mlir::Location loc, llvm::ArrayRef retTys, + SmallVector + getDimsFromBox(mlir::Location loc, ArrayRef retTys, mlir::Value box, mlir::Value dim, mlir::ConversionPatternRewriter &rewriter) const { auto c0 = genConstantOffset(loc, rewriter, 0); @@ -738,7 +734,7 @@ struct BoxDimsOpConversion : public FIROpConversion { mlir::LogicalResult matchAndRewrite(fir::BoxDimsOp boxdims, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { - llvm::SmallVector resultTypes = { + SmallVector resultTypes = { convertType(boxdims.getResult(0).getType()), convertType(boxdims.getResult(1).getType()), convertType(boxdims.getResult(2).getType()), @@ -903,7 +899,7 @@ struct StringLitOpConversion : public FIROpConversion { auto charTy = rewriter.getIntegerType(bits); auto det = mlir::VectorType::get({size}, charTy); // convert each character to a precise bitsize - llvm::SmallVector vec; + SmallVector vec; for (auto a : arr.getValue()) vec.push_back(mlir::IntegerAttr::get( charTy, a.cast().getValue().sextOrTrunc(bits))); @@ -942,7 +938,7 @@ struct CmpcOpConversion : public FIROpConversion { matchAndRewrite(fir::CmpcOp cmp, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { auto ctxt = cmp.getContext(); - auto kind = cmp.lhs().getType().cast().getFKind(); + auto kind = cmp.lhs().getType().cast().getFKind(); auto ty = convertType(fir::RealType::get(ctxt, kind)); auto loc = cmp.getLoc(); auto pos0 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(0), ctxt); @@ -995,7 +991,7 @@ struct ConstcOpConversion : public FIROpConversion { auto loc = conc.getLoc(); auto ctx = conc.getContext(); auto ty = convertType(conc.getType()); - auto ct = conc.getType().cast(); + auto ct = conc.getType().cast(); auto ety = lowerTy().convertComplexPartType(ct.getFKind()); auto ri = mlir::FloatAttr::get(ety, getValue(conc.getReal())); auto rp = rewriter.create(loc, ety, ri); @@ -1010,7 +1006,7 @@ struct ConstcOpConversion : public FIROpConversion { return success(); } - inline llvm::APFloat getValue(mlir::Attribute attr) const { + inline APFloat getValue(mlir::Attribute attr) const { return attr.cast().getValue(); } }; @@ -1143,7 +1139,7 @@ struct ConvertOpConversion : public FIROpConversion { static mlir::Type getComplexEleTy(mlir::Type complex) { if (auto cc = complex.dyn_cast()) return cc.getElementType(); - return complex.cast().getElementType(); + return complex.cast().getElementType(); } }; @@ -1188,23 +1184,42 @@ struct DTEntryOpConversion : public FIROpConversion { } }; +/// Perform an extension or truncation as needed on an integer value. Lowering +/// to the specific target may involve some sign-extending or truncation of +/// values, particularly to fit them from abstract box types to the appropriate +/// reified structures. +static mlir::Value integerCast(mlir::Location loc, + mlir::ConversionPatternRewriter &rewriter, + mlir::LLVM::LLVMType ty, mlir::Value val) { + auto toSize = ty.getPrimitiveSizeInBits(); + auto fromSize = + val.getType().cast().getPrimitiveSizeInBits(); + if (toSize < fromSize) + return rewriter.create(loc, ty, val); + if (toSize > fromSize) + return rewriter.create(loc, ty, val); + return val; +} + /// create a CHARACTER box struct EmboxCharOpConversion : public FIROpConversion { using FIROpConversion::FIROpConversion; mlir::LogicalResult - matchAndRewrite(fir::EmboxCharOp emboxchar, OperandTy operands, + matchAndRewrite(fir::EmboxCharOp emboxChar, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { auto a = operands[0]; - auto b = operands[1]; - auto loc = emboxchar.getLoc(); - auto ctx = emboxchar.getContext(); - auto ty = convertType(emboxchar.getType()); + auto b1 = operands[1]; + auto loc = emboxChar.getLoc(); + auto ctx = emboxChar.getContext(); + auto ty = convertType(emboxChar.getType()); auto c0 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(0), ctx); auto c1 = mlir::ArrayAttr::get(rewriter.getI32IntegerAttr(1), ctx); auto un = rewriter.create(loc, ty); + auto lenTy = unwrap(ty).cast().getBody()[1]; + auto b = integerCast(loc, rewriter, lenTy, b1); auto r = rewriter.create(loc, ty, un, a, c0); - rewriter.replaceOpWithNewOp(emboxchar, ty, r, b, + rewriter.replaceOpWithNewOp(emboxChar, ty, r, b, c1); return success(); } @@ -1244,20 +1259,6 @@ struct EmboxCommonConversion : public FIROpConversion { return boxPtrTy.getPointerElementTy().getStructElementType(i); } - // Perform an extension or truncation as needed on an integer value - mlir::Value integerCast(mlir::Location loc, - mlir::ConversionPatternRewriter &rewriter, - mlir::LLVM::LLVMType ty, mlir::Value val) const { - auto toSize = ty.getPrimitiveSizeInBits(); - auto fromSize = - val.getType().cast().getPrimitiveSizeInBits(); - if (toSize < fromSize) - return rewriter.create(loc, ty, val); - if (toSize > fromSize) - return rewriter.create(loc, ty, val); - return val; - } - // Get the element size and CFI type code of the boxed value. std::tuple getSizeAndTypeCode(mlir::Location loc, @@ -1296,7 +1297,7 @@ struct EmboxCommonConversion : public FIROpConversion { if (fir::isa_integer(boxEleTy)) { if (auto ty = boxEleTy.dyn_cast()) return doInteger(ty.getWidth()); - auto ty = boxEleTy.cast(); + auto ty = boxEleTy.cast(); return doInteger(getKindMap().getIntegerBitsize(ty.getFKind())); } if (fir::isa_real(boxEleTy)) { @@ -1309,7 +1310,7 @@ struct EmboxCommonConversion : public FIROpConversion { if (auto ty = boxEleTy.dyn_cast()) return doComplex( ty.getElementType().cast().getWidth()); - auto ty = boxEleTy.cast(); + auto ty = boxEleTy.cast(); return doComplex(getKindMap().getRealBitsize(ty.getFKind())); } if (auto ty = boxEleTy.dyn_cast()) @@ -1546,7 +1547,7 @@ struct ValueOpCommon { // Translate the arguments pertaining to any multidimensional array to // row-major order for LLVM-IR. - static void toRowMajor(llvm::SmallVectorImpl &attrs, + static void toRowMajor(SmallVectorImpl &attrs, mlir::LLVM::LLVMType ty) { assert(ty && "type is null"); const auto end = attrs.size(); @@ -1699,7 +1700,7 @@ struct XArrayCoorOpConversion prevExt = rewriter.create(loc, idxTy, prevExt, nextExt); } - llvm::SmallVector args{base, off}; + SmallVector args{base, off}; rewriter.replaceOpWithNewOp(coor, ty, args); return success(); } @@ -2027,7 +2028,7 @@ struct FieldIndexOpConversion : public FIROpConversion { auto type = field.on_type().cast(); // note: using std::string to dodge a bug in g++ 7.4.0 std::string tyName = type.getName().str(); - llvm::Twine methodName = "_QQOFFSETOF_" + tyName + "_" + fldName; + Twine methodName = "_QQOFFSETOF_" + tyName + "_" + fldName; return methodName.str(); } }; @@ -2147,8 +2148,7 @@ struct GlobalOpConversion : public FIROpConversion { return success(); } - mlir::LLVM::Linkage - convertLinkage(llvm::Optional optLinkage) const { + mlir::LLVM::Linkage convertLinkage(Optional optLinkage) const { if (optLinkage.hasValue()) { auto name = optLinkage.getValue(); if (name == "internal") @@ -2193,7 +2193,7 @@ struct NoReassocOpConversion : public FIROpConversion { }; void genCondBrOp(mlir::Location loc, mlir::Value cmp, mlir::Block *dest, - llvm::Optional destOps, + Optional destOps, mlir::ConversionPatternRewriter &rewriter, mlir::Block *newBlock) { if (destOps.hasValue()) @@ -2214,7 +2214,7 @@ void genBrOp(A caseOp, mlir::Block *dest, llvm::Optional destOps, } void genCaseLadderStep(mlir::Location loc, mlir::Value cmp, mlir::Block *dest, - llvm::Optional destOps, + Optional destOps, mlir::ConversionPatternRewriter &rewriter) { auto *thisBlock = rewriter.getInsertionBlock(); auto *newBlock = createBlock(rewriter, dest); @@ -2387,15 +2387,15 @@ struct UnboxCharOpConversion : public FIROpConversion { matchAndRewrite(fir::UnboxCharOp unboxchar, OperandTy operands, mlir::ConversionPatternRewriter &rewriter) const override { auto *ctx = unboxchar.getContext(); + auto lenTy = unwrap(convertType(unboxchar.getType(1))); auto loc = unboxchar.getLoc(); auto tuple = operands[0]; auto ty = unwrap(tuple.getType()); mlir::Value ptr = genExtractValueWithIndex(loc, tuple, ty, rewriter, ctx, 0); - mlir::Value len = - genExtractValueWithIndex(loc, tuple, ty, rewriter, ctx, 1); - std::vector repls = {ptr, len}; - unboxchar.replaceAllUsesWith(repls); + auto len1 = genExtractValueWithIndex(loc, tuple, ty, rewriter, ctx, 1); + auto len = integerCast(loc, rewriter, lenTy, len1); + unboxchar.replaceAllUsesWith(llvm::ArrayRef{ptr, len}); rewriter.eraseOp(unboxchar); return success(); } @@ -2735,7 +2735,7 @@ struct NegcOpConversion : public FIROpConversion { struct FIRToLLVMLoweringPass : public mlir::PassWrapper> { - FIRToLLVMLoweringPass(fir::NameUniquer &uniquer) : uniquer{uniquer} {} + FIRToLLVMLoweringPass(fir::NameUniquer &) {} mlir::ModuleOp getModule() { return getOperation(); } @@ -2744,7 +2744,7 @@ struct FIRToLLVMLoweringPass return; auto *context = getModule().getContext(); - FIRToLLVMTypeConverter typeConverter{context, uniquer}; + FIRToLLVMTypeConverter typeConverter{getModule()}; auto loc = mlir::UnknownLoc::get(context); mlir::OwningRewritePatternList pattern; pattern.insert< @@ -2784,9 +2784,6 @@ struct FIRToLLVMLoweringPass signalPassFailure(); } } - -private: - fir::NameUniquer &uniquer; }; /// Lower from LLVM IR dialect to proper LLVM-IR and dump the module diff --git a/flang/lib/Optimizer/CodeGen/PassDetail.h b/flang/lib/Optimizer/CodeGen/PassDetail.h index acebb30415613..f5b80ac325328 100644 --- a/flang/lib/Optimizer/CodeGen/PassDetail.h +++ b/flang/lib/Optimizer/CodeGen/PassDetail.h @@ -9,6 +9,7 @@ #ifndef OPTMIZER_CODEGEN_PASSDETAIL_H #define OPTMIZER_CODEGEN_PASSDETAIL_H +#include "flang/Optimizer/Dialect/FIRDialect.h" #include "mlir/Pass/Pass.h" #include "mlir/Pass/PassRegistry.h" diff --git a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp index 209f28a533419..3cf21489f87b9 100644 --- a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp +++ b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp @@ -11,18 +11,28 @@ //===----------------------------------------------------------------------===// #include "PassDetail.h" +#include "Target.h" #include "flang/Optimizer/CodeGen/CodeGen.h" #include "flang/Optimizer/Dialect/FIRDialect.h" #include "flang/Optimizer/Dialect/FIROps.h" #include "flang/Optimizer/Dialect/FIRType.h" +#include "flang/Optimizer/Support/FIRContext.h" #include "flang/Optimizer/Transforms/Passes.h" #include "mlir/Pass/Pass.h" #include "mlir/Transforms/DialectConversion.h" +#include "llvm/ADT/STLExtras.h" +#include "llvm/ADT/TypeSwitch.h" #include "llvm/Support/CommandLine.h" -#define DEBUG_TYPE "flang-codegen-rewrite" +#include + +//===----------------------------------------------------------------------===// +// Codegen rewrite: rewriting of subgraphs of ops +//===----------------------------------------------------------------------===// using namespace fir; +#define DEBUG_TYPE "flang-codegen-rewrite" + static void populateShape(llvm::SmallVectorImpl &vec, ShapeOp shape) { vec.append(shape.extents().begin(), shape.extents().end()); @@ -54,7 +64,7 @@ class EmboxConversion : public mlir::OpRewritePattern { if (shapeVal) return rewriteDynamicShape(embox, rewriter, shapeVal); if (auto boxTy = embox.getType().dyn_cast()) - if (auto seqTy = boxTy.getEleTy().dyn_cast()) + if (auto seqTy = boxTy.getEleTy().dyn_cast()) if (seqTy.hasConstantShape()) return rewriteStaticShape(embox, rewriter, seqTy); return mlir::failure(); @@ -62,7 +72,7 @@ class EmboxConversion : public mlir::OpRewritePattern { mlir::LogicalResult rewriteStaticShape(EmboxOp embox, mlir::PatternRewriter &rewriter, - fir::SequenceType seqTy) const { + SequenceType seqTy) const { auto loc = embox.getLoc(); llvm::SmallVector shapeOpers; auto idxTy = rewriter.getIndexType(); @@ -202,9 +212,8 @@ class CodeGenRewrite : public CodeGenRewriteBase { target.addLegalDialect(); target.addIllegalOp(); target.addDynamicallyLegalOp([](EmboxOp embox) { - return !( - embox.getShape() || - embox.getType().cast().getEleTy().isa()); + return !(embox.getShape() || + embox.getType().cast().getEleTy().isa()); }); // Do the conversions. @@ -272,9 +281,682 @@ class CodeGenRewrite : public CodeGenRewriteBase { } // namespace -/// Convert FIR's structured control flow ops to CFG ops. This -/// conversion enables the `createLowerToCFGPass` to transform these to CFG -/// form. +/// Convert FIR's structured control flow ops to CFG ops. This conversion +/// enables the `createLowerToCFGPass` to transform these to CFG form. std::unique_ptr fir::createFirCodeGenRewritePass() { return std::make_unique(); } + +//===----------------------------------------------------------------------===// +// Target rewrite: reriting of ops to make target-specific lowerings manifest. +//===----------------------------------------------------------------------===// + +#undef DEBUG_TYPE +#define DEBUG_TYPE "flang-target-rewrite" + +namespace { + +/// Fixups for updating a FuncOp's arguments and return values. +struct FixupTy { + // clang-format off + enum class Codes { + ArgumentAsLoad, ArgumentType, CharPair, ReturnAsStore, ReturnType, + Split, Trailing + }; + // clang-format on + + FixupTy(Codes code, std::size_t index, std::size_t second = 0) + : code{code}, index{index}, second{second} {} + FixupTy(Codes code, std::size_t index, + std::function &&finalizer) + : code{code}, index{index}, finalizer{finalizer} {} + FixupTy(Codes code, std::size_t index, std::size_t second, + std::function &&finalizer) + : code{code}, index{index}, second{second}, finalizer{finalizer} {} + + Codes code; + std::size_t index; + std::size_t second{}; + llvm::Optional> finalizer{}; +}; // namespace + +/// Target-specific rewriting of the IR. This is a prerequisite pass to code +/// generation that traverses the IR and modifies types and operations to a +/// form that appropriate for the specific target. LLVM IR has specific idioms +/// that are used for distinct target processor and ABI combinations. +class TargetRewrite : public TargetRewriteBase { +public: + TargetRewrite(const TargetRewriteOptions &options) { + noCharacterConversion = options.noCharacterConversion; + noComplexConversion = options.noComplexConversion; + } + + void runOnOperation() override final { + auto &context = getContext(); + mlir::OpBuilder rewriter(&context); + auto mod = getModule(); + auto specifics = CodeGenSpecifics::get(getOperation().getContext(), + *getTargetTriple(getOperation()), + *getKindMapping(getOperation())); + setMembers(specifics.get(), &rewriter); + + // Perform type conversion on signatures and call sites. + if (mlir::failed(convertTypes(mod))) { + mlir::emitError(mlir::UnknownLoc::get(&context), + "error in converting types to target abi"); + signalPassFailure(); + } + + // Convert ops in target-specific patterns. + mod.walk([&](mlir::Operation *op) { + if (auto call = dyn_cast(op)) { + if (!hasPortableSignature(call.getFunctionType())) + convertCallOp(call); + } else if (auto dispatch = dyn_cast(op)) { + if (!hasPortableSignature(dispatch.getFunctionType())) + convertCallOp(dispatch); + } else if (auto addr = dyn_cast(op)) { + if (addr.getType().isa() && + !hasPortableSignature(addr.getType())) + convertAddrOp(addr); + } + }); + + clearMembers(); + } + + mlir::ModuleOp getModule() { return getOperation(); } + + template + std::function + rewriteCallComplexResultType(A ty, B &newResTys, B &newInTys, C &newOpers) { + auto m = specifics->complexReturnType(ty.getElementType()); + // Currently targets mandate COMPLEX is a single aggregate or packed + // scalar, included the sret case. + assert(m.size() == 1 && "target lowering of complex return not supported"); + auto resTy = std::get(m[0]); + auto attr = std::get(m[0]); + auto loc = mlir::UnknownLoc::get(resTy.getContext()); + if (attr.isSRet()) { + assert(isa_ref_type(resTy)); + mlir::Value stack = + rewriter->create(loc, dyn_cast_ptrEleTy(resTy)); + newInTys.push_back(resTy); + newOpers.push_back(stack); + return [=](mlir::Operation *) -> mlir::Value { + auto memTy = ReferenceType::get(ty); + auto cast = rewriter->create(loc, memTy, stack); + return rewriter->create(loc, cast); + }; + } + newResTys.push_back(resTy); + return [=](mlir::Operation *call) -> mlir::Value { + auto mem = rewriter->create(loc, resTy); + rewriter->create(loc, call->getResult(0), mem); + auto memTy = ReferenceType::get(ty); + auto cast = rewriter->create(loc, memTy, mem); + return rewriter->create(loc, cast); + }; + } + + template + void rewriteCallComplexInputType(A ty, mlir::Value oper, B &newInTys, + C &newOpers) { + auto m = specifics->complexArgumentType(ty.getElementType()); + auto *ctx = ty.getContext(); + auto loc = mlir::UnknownLoc::get(ctx); + if (m.size() == 1) { + // COMPLEX is a single aggregate + auto resTy = std::get(m[0]); + auto attr = std::get(m[0]); + auto oldRefTy = ReferenceType::get(ty); + if (attr.isByVal()) { + auto mem = rewriter->create(loc, ty); + rewriter->create(loc, oper, mem); + newOpers.push_back(rewriter->create(loc, resTy, mem)); + } else { + auto mem = rewriter->create(loc, resTy); + auto cast = rewriter->create(loc, oldRefTy, mem); + rewriter->create(loc, oper, cast); + newOpers.push_back(rewriter->create(loc, mem)); + } + newInTys.push_back(resTy); + } else { + assert(m.size() == 2); + // COMPLEX is split into 2 separate arguments + auto iTy = rewriter->getIntegerType(32); + for (auto e : llvm::enumerate(m)) { + auto &tup = e.value(); + auto ty = std::get(tup); + auto index = e.index(); + mlir::Value idx = rewriter->create( + loc, iTy, mlir::IntegerAttr::get(iTy, index)); + auto val = rewriter->create(loc, ty, oper, idx); + newInTys.push_back(ty); + newOpers.push_back(val); + } + } + } + + // Convert fir.call and fir.dispatch Ops. + template + void convertCallOp(A callOp) { + auto fnTy = callOp.getFunctionType(); + auto loc = callOp.getLoc(); + rewriter->setInsertionPoint(callOp); + llvm::SmallVector newResTys; + llvm::SmallVector newInTys; + llvm::SmallVector newOpers; + // FIXME: if the call is indirect, the first argument must still be the + // function to call. + llvm::Optional> wrap; + if (fnTy.getResults().size() == 1) { + mlir::Type ty = fnTy.getResult(0); + llvm::TypeSwitch(ty) + .template Case([&](fir::ComplexType cmplx) { + wrap = rewriteCallComplexResultType(cmplx, newResTys, newInTys, + newOpers); + }) + .template Case([&](mlir::ComplexType cmplx) { + wrap = rewriteCallComplexResultType(cmplx, newResTys, newInTys, + newOpers); + }) + .Default([&](mlir::Type ty) { newResTys.push_back(ty); }); + } else if (fnTy.getResults().size() > 1) { + // If the function is returning more than 1 result, do not perform any + // target-specific lowering. (FIXME?) This may need to be revisited. + newResTys.insert(newResTys.end(), fnTy.getResults().begin(), + fnTy.getResults().end()); + } + llvm::SmallVector trailingInTys; + llvm::SmallVector trailingOpers; + for (auto e : + llvm::enumerate(llvm::zip(fnTy.getInputs(), callOp.getOperands()))) { + mlir::Type ty = std::get<0>(e.value()); + mlir::Value oper = std::get<1>(e.value()); + unsigned index = e.index(); + llvm::TypeSwitch(ty) + .template Case([&](BoxCharType boxTy) { + bool sret; + if constexpr (std::is_same_v, fir::CallOp>) { + sret = callOp.callee() && + functionArgIsSRet(index, + getModule().lookupSymbol( + *callOp.callee())); + } else { + // TODO: dispatch case; how do we put arguments on a call? + sret = false; + llvm_unreachable("not implemented"); + } + auto m = specifics->boxcharArgumentType(boxTy.getEleTy(), sret); + auto unbox = + rewriter->create(loc, std::get(m[0]), + std::get(m[1]), oper); + // unboxed CHARACTER arguments + for (auto e : llvm::enumerate(m)) { + unsigned idx = e.index(); + auto attr = std::get(e.value()); + auto argTy = std::get(e.value()); + if (attr.isAppend()) { + trailingInTys.push_back(argTy); + trailingOpers.push_back(unbox.getResult(idx)); + } else { + newInTys.push_back(argTy); + newOpers.push_back(unbox.getResult(idx)); + } + } + }) + .template Case([&](fir::ComplexType cmplx) { + rewriteCallComplexInputType(cmplx, oper, newInTys, newOpers); + }) + .template Case([&](mlir::ComplexType cmplx) { + rewriteCallComplexInputType(cmplx, oper, newInTys, newOpers); + }) + .Default([&](mlir::Type ty) { newInTys.push_back(ty); }); + } + newInTys.insert(newInTys.end(), trailingInTys.begin(), trailingInTys.end()); + newOpers.insert(newOpers.end(), trailingOpers.begin(), trailingOpers.end()); + if constexpr (std::is_same_v, fir::CallOp>) { + assert(callOp.callee().hasValue() && "indirect call not implemented"); + auto newCall = rewriter->create(loc, callOp.callee().getValue(), + newResTys, newOpers); + LLVM_DEBUG(llvm::errs() << "replacing call with " << newCall << '\n'); + if (wrap.hasValue()) + replaceOp(callOp, (*wrap)(newCall.getOperation())); + else + replaceOp(callOp, newCall.getResults()); + } else { + // A is fir::DispatchOp + llvm_unreachable("not implemented"); // TODO + } + } + + // Result type fixup for fir::ComplexType and mlir::ComplexType + template + void lowerComplexSignatureRes(A cmplx, B &newResTys, B &newInTys) { + if (noComplexConversion) { + newResTys.push_back(cmplx); + } else { + for (auto &tup : specifics->complexReturnType(cmplx.getElementType())) { + auto argTy = std::get(tup); + if (std::get(tup).isSRet()) + newInTys.push_back(argTy); + else + newResTys.push_back(argTy); + } + } + } + + // Argument type fixup for fir::ComplexType and mlir::ComplexType + template + void lowerComplexSignatureArg(A cmplx, B &newInTys) { + if (noComplexConversion) + newInTys.push_back(cmplx); + else + for (auto &tup : specifics->complexArgumentType(cmplx.getElementType())) + newInTys.push_back(std::get(tup)); + } + + /// Taking the address of a function. Modify the signature as needed. + void convertAddrOp(AddrOfOp addrOp) { + auto addrTy = addrOp.getType().cast(); + llvm::SmallVector newResTys; + llvm::SmallVector newInTys; + for (mlir::Type ty : addrTy.getResults()) { + llvm::TypeSwitch(ty) + .Case([&](fir::ComplexType ty) { + lowerComplexSignatureRes(ty, newResTys, newInTys); + }) + .Case([&](mlir::ComplexType ty) { + lowerComplexSignatureRes(ty, newResTys, newInTys); + }) + .Default([&](mlir::Type ty) { newResTys.push_back(ty); }); + } + llvm::SmallVector trailingInTys; + for (mlir::Type ty : addrTy.getInputs()) { + llvm::TypeSwitch(ty) + .Case([&](BoxCharType box) { + if (noCharacterConversion) { + newInTys.push_back(box); + } else { + for (auto &tup : specifics->boxcharArgumentType(box.getEleTy())) { + auto attr = std::get(tup); + auto argTy = std::get(tup); + auto &vec = attr.isAppend() ? trailingInTys : newInTys; + vec.push_back(argTy); + } + } + }) + .Case( + [&](fir::ComplexType ty) { lowerComplexSignatureArg(ty, newInTys); }) + .Case([&](mlir::ComplexType ty) { + lowerComplexSignatureArg(ty, newInTys); + }) + .Default([&](mlir::Type ty) { newInTys.push_back(ty); }); + } + // append trailing input types + newInTys.insert(newInTys.end(), trailingInTys.begin(), trailingInTys.end()); + // replace this op with a new one with the updated signature + auto newTy = rewriter->getFunctionType(newInTys, newResTys); + auto newOp = + rewriter->create(addrOp.getLoc(), newTy, addrOp.symbol()); + replaceOp(addrOp, newOp.getOperation()->getResults()); + } + + /// Convert the type signatures on all the functions present in the module. + /// As the type signature is being changed, this must also update the + /// function itself to use any new arguments, etc. + mlir::LogicalResult convertTypes(mlir::ModuleOp mod) { + for (auto fn : mod.getOps()) + convertSignature(fn); + return mlir::success(); + } + + /// If the signature does not need any special target-specific converions, + /// then it is considered portable for any target, and this function will + /// return `true`. Otherwise, the signature is not portable and `false` is + /// returned. + bool hasPortableSignature(mlir::Type signature) { + assert(signature.isa()); + auto func = signature.dyn_cast(); + for (auto ty : func.getResults()) + if ((ty.isa() && !noCharacterConversion) || + (isa_complex(ty) && !noComplexConversion)) { + LLVM_DEBUG(llvm::errs() << "rewrite " << signature << " for target\n"); + return false; + } + for (auto ty : func.getInputs()) + if ((ty.isa() && !noCharacterConversion) || + (isa_complex(ty) && !noComplexConversion)) { + LLVM_DEBUG(llvm::errs() << "rewrite " << signature << " for target\n"); + return false; + } + return true; + } + + /// Rewrite the signatures and body of the `FuncOp`s in the module for + /// the immediately subsequent target code gen. + void convertSignature(mlir::FuncOp func) { + auto funcTy = func.getType().cast(); + if (hasPortableSignature(funcTy)) + return; + llvm::SmallVector newResTys; + llvm::SmallVector newInTys; + llvm::SmallVector fixups; + + // Convert return value(s) + for (auto ty : funcTy.getResults()) + llvm::TypeSwitch(ty) + .Case([&](fir::ComplexType cmplx) { + if (noComplexConversion) + newResTys.push_back(cmplx); + else + doComplexReturn(func, cmplx, newResTys, newInTys, fixups); + }) + .Case([&](mlir::ComplexType cmplx) { + if (noComplexConversion) + newResTys.push_back(cmplx); + else + doComplexReturn(func, cmplx, newResTys, newInTys, fixups); + }) + .Default([&](mlir::Type ty) { newResTys.push_back(ty); }); + + // Convert arguments + llvm::SmallVector trailingTys; + for (auto e : llvm::enumerate(funcTy.getInputs())) { + auto ty = e.value(); + unsigned index = e.index(); + llvm::TypeSwitch(ty) + .Case([&](BoxCharType boxTy) { + if (noCharacterConversion) { + newInTys.push_back(boxTy); + } else { + // Convert a CHARACTER argument type. This can involve separating + // the pointer and the LEN into two arguments and moving the LEN + // argument to the end of the arg list. + bool sret = functionArgIsSRet(index, func); + for (auto e : llvm::enumerate(specifics->boxcharArgumentType( + boxTy.getEleTy(), sret))) { + auto &tup = e.value(); + auto index = e.index(); + auto attr = std::get(tup); + auto argTy = std::get(tup); + if (attr.isAppend()) { + trailingTys.push_back(argTy); + } else { + if (sret) { + fixups.emplace_back(FixupTy::Codes::CharPair, + newInTys.size(), index); + } else { + fixups.emplace_back(FixupTy::Codes::Trailing, + newInTys.size(), trailingTys.size()); + } + newInTys.push_back(argTy); + } + } + } + }) + .Case([&](fir::ComplexType cmplx) { + if (noComplexConversion) + newInTys.push_back(cmplx); + else + doComplexArg(func, cmplx, newInTys, fixups); + }) + .Case([&](mlir::ComplexType cmplx) { + if (noComplexConversion) + newInTys.push_back(cmplx); + else + doComplexArg(func, cmplx, newInTys, fixups); + }) + .Default([&](mlir::Type ty) { newInTys.push_back(ty); }); + } + + if (!func.empty()) { + // If the function has a body, then apply the fixups to the arguments and + // return ops as required. These fixups are done in place. + auto loc = func.getLoc(); + const auto fixupSize = fixups.size(); + const auto oldArgTys = func.getType().getInputs(); + int offset = 0; + for (std::remove_const_t i = 0; i < fixupSize; ++i) { + const auto &fixup = fixups[i]; + switch (fixup.code) { + case FixupTy::Codes::ArgumentAsLoad: { + // Argument was pass-by-value, but is now pass-by-reference and + // possibly with a different element type. + auto newArg = + func.front().insertArgument(fixup.index, newInTys[fixup.index]); + rewriter->setInsertionPointToStart(&func.front()); + auto oldArgTy = ReferenceType::get(oldArgTys[fixup.index - offset]); + auto cast = rewriter->create(loc, oldArgTy, newArg); + auto load = rewriter->create(loc, cast); + func.getArgument(fixup.index + 1).replaceAllUsesWith(load); + func.front().eraseArgument(fixup.index + 1); + } break; + case FixupTy::Codes::ArgumentType: { + // Argument is pass-by-value, but its type is likely been modified to + // suit the target ABI convention. + auto newArg = + func.front().insertArgument(fixup.index, newInTys[fixup.index]); + rewriter->setInsertionPointToStart(&func.front()); + auto mem = + rewriter->create(loc, newInTys[fixup.index]); + rewriter->create(loc, newArg, mem); + auto oldArgTy = ReferenceType::get(oldArgTys[fixup.index - offset]); + auto cast = rewriter->create(loc, oldArgTy, mem); + mlir::Value load = rewriter->create(loc, cast); + func.getArgument(fixup.index + 1).replaceAllUsesWith(load); + func.front().eraseArgument(fixup.index + 1); + LLVM_DEBUG(llvm::errs() + << "old argument: " << oldArgTy.getEleTy() + << ", repl: " << load << ", new argument: " + << func.getArgument(fixup.index).getType() << '\n'); + } break; + case FixupTy::Codes::CharPair: { + // The FIR boxchar argument has been split into a pair of distinct + // arguments that are in juxtaposition to each other. + auto newArg = + func.front().insertArgument(fixup.index, newInTys[fixup.index]); + if (fixup.second == 1) { + rewriter->setInsertionPointToStart(&func.front()); + auto boxTy = oldArgTys[fixup.index - offset - fixup.second]; + auto box = rewriter->create( + loc, boxTy, func.front().getArgument(fixup.index - 1), newArg); + func.getArgument(fixup.index + 1).replaceAllUsesWith(box); + func.front().eraseArgument(fixup.index + 1); + offset++; + } + } break; + case FixupTy::Codes::ReturnAsStore: { + // The value being returned is now being returned in memory (callee + // stack space) through a hidden reference argument. + auto newArg = + func.front().insertArgument(fixup.index, newInTys[fixup.index]); + offset++; + func.walk([&](mlir::ReturnOp ret) { + rewriter->setInsertionPoint(ret); + auto oldOper = ret.getOperand(0); + auto oldOperTy = ReferenceType::get(oldOper.getType()); + auto cast = rewriter->create(loc, oldOperTy, newArg); + rewriter->create(loc, oldOper, cast); + rewriter->create(loc); + ret.erase(); + }); + } break; + case FixupTy::Codes::ReturnType: { + // The function is still returning a value, but its type has likely + // changed to suit the target ABI convention. + func.walk([&](mlir::ReturnOp ret) { + rewriter->setInsertionPoint(ret); + auto oldOper = ret.getOperand(0); + auto oldOperTy = ReferenceType::get(oldOper.getType()); + auto mem = + rewriter->create(loc, newResTys[fixup.index]); + auto cast = rewriter->create(loc, oldOperTy, mem); + rewriter->create(loc, oldOper, cast); + mlir::Value load = rewriter->create(loc, mem); + rewriter->create(loc, load); + ret.erase(); + }); + } break; + case FixupTy::Codes::Split: { + // The FIR argument has been split into a pair of distinct arguments + // that are in juxtaposition to each other. (For COMPLEX value.) + auto newArg = + func.front().insertArgument(fixup.index, newInTys[fixup.index]); + if (fixup.second == 1) { + rewriter->setInsertionPointToStart(&func.front()); + auto cplxTy = oldArgTys[fixup.index - offset - fixup.second]; + auto undef = rewriter->create(loc, cplxTy); + auto iTy = rewriter->getIntegerType(32); + mlir::Value zero = rewriter->create( + loc, iTy, mlir::IntegerAttr::get(iTy, 0)); + mlir::Value one = rewriter->create( + loc, iTy, mlir::IntegerAttr::get(iTy, 1)); + auto cplx1 = rewriter->create( + loc, cplxTy, undef, func.front().getArgument(fixup.index - 1), + zero); + auto cplx = rewriter->create(loc, cplxTy, cplx1, + newArg, one); + func.getArgument(fixup.index + 1).replaceAllUsesWith(cplx); + func.front().eraseArgument(fixup.index + 1); + offset++; + } + } break; + case FixupTy::Codes::Trailing: { + // The FIR argument has been split into a pair of distinct arguments. + // The first part of the pair appears in the original argument + // position. The second part of the pair is appended after all the + // original arguments. (Boxchar arguments.) + auto newBufArg = + func.front().insertArgument(fixup.index, newInTys[fixup.index]); + auto newLenArg = func.front().addArgument(trailingTys[fixup.second]); + auto boxTy = oldArgTys[fixup.index - offset]; + rewriter->setInsertionPointToStart(&func.front()); + auto box = + rewriter->create(loc, boxTy, newBufArg, newLenArg); + func.getArgument(fixup.index + 1).replaceAllUsesWith(box); + func.front().eraseArgument(fixup.index + 1); + } break; + } + } + } + + // Set the new type and finalize the arguments, etc. + newInTys.insert(newInTys.end(), trailingTys.begin(), trailingTys.end()); + auto newFuncTy = + mlir::FunctionType::get(newInTys, newResTys, func.getContext()); + LLVM_DEBUG(llvm::errs() << "new func: " << newFuncTy << '\n'); + func.setType(newFuncTy); + + for (auto &fixup : fixups) + if (fixup.finalizer) + (*fixup.finalizer)(func); + } + + inline bool functionArgIsSRet(unsigned index, mlir::FuncOp func) { + if (auto attr = func.getArgAttrOfType(index, "llvm.sret")) + return attr.getValue(); + return false; + } + + /// Convert a complex return value. This can involve converting the return + /// value to a "hidden" first argument or packing the complex into a wide + /// GPR. + template + void doComplexReturn(mlir::FuncOp func, A cmplx, B &newResTys, B &newInTys, + C &fixups) { + if (noComplexConversion) { + newResTys.push_back(cmplx); + return; + } + auto m = specifics->complexReturnType(cmplx.getElementType()); + assert(m.size() == 1); + auto &tup = m[0]; + auto attr = std::get(tup); + auto argTy = std::get(tup); + if (attr.isSRet()) { + bool argNo = newInTys.size(); + fixups.emplace_back( + FixupTy::Codes::ReturnAsStore, argNo, [=](mlir::FuncOp func) { + func.setArgAttr(argNo, "llvm.sret", rewriter->getBoolAttr(true)); + }); + newInTys.push_back(argTy); + return; + } + fixups.emplace_back(FixupTy::Codes::ReturnType, newResTys.size()); + newResTys.push_back(argTy); + } + + /// Convert a complex argument value. This can involve storing the value to + /// a temporary memory location or factoring the value into two distinct + /// arguments. + template + void doComplexArg(mlir::FuncOp func, A cmplx, B &newInTys, C &fixups) { + if (noComplexConversion) { + newInTys.push_back(cmplx); + return; + } + auto m = specifics->complexArgumentType(cmplx.getElementType()); + const auto fixupCode = + m.size() > 1 ? FixupTy::Codes::Split : FixupTy::Codes::ArgumentType; + for (auto e : llvm::enumerate(m)) { + auto &tup = e.value(); + auto index = e.index(); + auto attr = std::get(tup); + auto argTy = std::get(tup); + auto argNo = newInTys.size(); + if (attr.isByVal()) { + if (auto align = attr.getAlignment()) + fixups.emplace_back( + FixupTy::Codes::ArgumentAsLoad, argNo, [=](mlir::FuncOp func) { + func.setArgAttr(argNo, "llvm.byval", + rewriter->getBoolAttr(true)); + func.setArgAttr(argNo, "llvm.align", + rewriter->getIntegerAttr( + rewriter->getIntegerType(32), align)); + }); + else + fixups.emplace_back(FixupTy::Codes::ArgumentAsLoad, newInTys.size(), + [=](mlir::FuncOp func) { + func.setArgAttr(argNo, "llvm.byval", + rewriter->getBoolAttr(true)); + }); + } else { + if (auto align = attr.getAlignment()) + fixups.emplace_back(fixupCode, argNo, index, [=](mlir::FuncOp func) { + func.setArgAttr( + argNo, "llvm.align", + rewriter->getIntegerAttr(rewriter->getIntegerType(32), align)); + }); + else + fixups.emplace_back(fixupCode, argNo, index); + } + newInTys.push_back(argTy); + } + } + +private: + // Replace `op` and remove it. + void replaceOp(mlir::Operation *op, mlir::ValueRange newValues) { + op->replaceAllUsesWith(newValues); + op->dropAllReferences(); + op->erase(); + } + + inline void setMembers(CodeGenSpecifics *s, mlir::OpBuilder *r) { + specifics = s; + rewriter = r; + } + + inline void clearMembers() { setMembers(nullptr, nullptr); } + + CodeGenSpecifics *specifics{}; + mlir::OpBuilder *rewriter; +}; // namespace +} // namespace + +std::unique_ptr> +fir::createFirTargetRewritePass(const TargetRewriteOptions &options) { + return std::make_unique(options); +} diff --git a/flang/lib/Optimizer/CodeGen/Target.cpp b/flang/lib/Optimizer/CodeGen/Target.cpp new file mode 100644 index 0000000000000..bab10e5bee6ec --- /dev/null +++ b/flang/lib/Optimizer/CodeGen/Target.cpp @@ -0,0 +1,189 @@ +//===-- Target.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 +// +//===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// + +#include "Target.h" +#include "flang/Optimizer/Dialect/FIRType.h" +#include "flang/Optimizer/Support/KindMapping.h" +#include "mlir/IR/StandardTypes.h" +#include "mlir/IR/TypeRange.h" +#include "llvm/ADT/Triple.h" + +#define DEBUG_TYPE "flang-codegen-target" + +using namespace fir; + +// Reduce a REAL/float type to the floating point semantics. +static const llvm::fltSemantics &floatToSemantics(KindMapping &kindMap, + mlir::Type type) { + assert(isa_real(type)); + if (auto ty = type.dyn_cast()) + return kindMap.getFloatSemantics(ty.getFKind()); + return type.cast().getFloatSemantics(); +} + +namespace { +template +struct GenericTarget : public CodeGenSpecifics { + using CodeGenSpecifics::CodeGenSpecifics; + using AT = CodeGenSpecifics::Attributes; + + mlir::Type complexMemoryType(mlir::Type eleTy) const override { + assert(fir::isa_real(eleTy)); + // { t, t } struct of 2 eleTy + mlir::TypeRange range = {eleTy, eleTy}; + return mlir::TupleType::get(range, eleTy.getContext()); + } + + mlir::Type boxcharMemoryType(mlir::Type eleTy) const override { + auto idxTy = mlir::IntegerType::get(S::defaultWidth, eleTy.getContext()); + auto ptrTy = fir::ReferenceType::get(eleTy); + // { t*, index } + mlir::TypeRange range = {ptrTy, idxTy}; + return mlir::TupleType::get(range, eleTy.getContext()); + } + + Marshalling boxcharArgumentType(mlir::Type eleTy, bool sret) const override { + CodeGenSpecifics::Marshalling marshal; + auto idxTy = mlir::IntegerType::get(S::defaultWidth, eleTy.getContext()); + auto ptrTy = fir::ReferenceType::get(eleTy); + marshal.emplace_back(ptrTy, AT{}); + // Return value arguments are grouped as a pair. Others are passed in a + // split format with all pointers first (in the declared position) and all + // LEN arguments appended after all of the dummy arguments. + // NB: Other conventions/ABIs can/should be supported via options. + marshal.emplace_back(idxTy, AT{0, {}, {}, /*append=*/!sret}); + return marshal; + } +}; +} // namespace + +//===----------------------------------------------------------------------===// +// i386 (x86 32 bit) linux target specifics. +//===----------------------------------------------------------------------===// + +namespace { +struct TargetI386 : public GenericTarget { + using GenericTarget::GenericTarget; + + static constexpr int defaultWidth = 32; + + CodeGenSpecifics::Marshalling + complexArgumentType(mlir::Type eleTy) const override { + assert(fir::isa_real(eleTy)); + CodeGenSpecifics::Marshalling marshal; + // { t, t } struct of 2 eleTy, byval, align 4 + mlir::TypeRange range = {eleTy, eleTy}; + auto structTy = mlir::TupleType::get(range, eleTy.getContext()); + marshal.emplace_back(fir::ReferenceType::get(structTy), + AT{4, /*byval=*/true, {}}); + return marshal; + } + + CodeGenSpecifics::Marshalling + complexReturnType(mlir::Type eleTy) const override { + assert(fir::isa_real(eleTy)); + CodeGenSpecifics::Marshalling marshal; + const auto *sem = &floatToSemantics(kindMap, eleTy); + if (sem == &llvm::APFloat::IEEEsingle()) { + // i64 pack both floats in a 64-bit GPR + marshal.emplace_back(mlir::IntegerType::get(64, eleTy.getContext()), + AT{}); + } else if (sem == &llvm::APFloat::IEEEdouble()) { + // { t, t } struct of 2 eleTy, sret, align 4 + mlir::TypeRange range = {eleTy, eleTy}; + auto structTy = mlir::TupleType::get(range, eleTy.getContext()); + marshal.emplace_back(fir::ReferenceType::get(structTy), + AT{4, {}, /*sret=*/true}); + } else { + llvm_unreachable("not implemented"); + } + return marshal; + } +}; +} // namespace + +//===----------------------------------------------------------------------===// +// x86_64 (x86 64 bit) linux target specifics. +//===----------------------------------------------------------------------===// + +namespace { +struct TargetX86_64 : public GenericTarget { + using GenericTarget::GenericTarget; + + static constexpr int defaultWidth = 64; + + CodeGenSpecifics::Marshalling + complexArgumentType(mlir::Type eleTy) const override { + CodeGenSpecifics::Marshalling marshal; + const auto *sem = &floatToSemantics(kindMap, eleTy); + if (sem == &llvm::APFloat::IEEEsingle()) { + // <2 x t> vector of 2 eleTy + marshal.emplace_back(fir::VectorType::get(2, eleTy), AT{}); + } else if (sem == &llvm::APFloat::IEEEdouble()) { + // two distinct double arguments + marshal.emplace_back(eleTy, AT{}); + marshal.emplace_back(eleTy, AT{}); + } else { + llvm_unreachable("not implemented"); + } + return marshal; + } + + CodeGenSpecifics::Marshalling + complexReturnType(mlir::Type eleTy) const override { + CodeGenSpecifics::Marshalling marshal; + const auto *sem = &floatToSemantics(kindMap, eleTy); + if (sem == &llvm::APFloat::IEEEsingle()) { + // <2 x t> vector of 2 eleTy + marshal.emplace_back(fir::VectorType::get(2, eleTy), AT{}); + } else if (sem == &llvm::APFloat::IEEEdouble()) { + // { double, double } struct of 2 double + mlir::TypeRange range = {eleTy, eleTy}; + marshal.emplace_back(mlir::TupleType::get(range, eleTy.getContext()), + AT{}); + } else { + llvm_unreachable("not implemented"); + } + return marshal; + } +}; +} // namespace + +// Instantiate the overloaded target instance based on the triple value. +// Currently, the implementation only instantiates `i386-unknown-linux-gnu` and +// `x86_64-unknown-linux-gnu` like triples. Other targets should be added to +// this file as needed. +std::unique_ptr +fir::CodeGenSpecifics::get(mlir::MLIRContext *ctx, llvm::Triple &trp, + KindMapping &kindMap) { + switch (trp.getArch()) { + default: + break; + case llvm::Triple::ArchType::x86: + switch (trp.getOS()) { + default: + break; + case llvm::Triple::OSType::Linux: + return std::make_unique(ctx, trp, kindMap); + } + break; + case llvm::Triple::ArchType::x86_64: + switch (trp.getOS()) { + default: + break; + case llvm::Triple::OSType::Linux: + return std::make_unique(ctx, trp, kindMap); + } + break; + } + llvm::report_fatal_error("target not implemented"); +} diff --git a/flang/lib/Optimizer/CodeGen/Target.h b/flang/lib/Optimizer/CodeGen/Target.h new file mode 100644 index 0000000000000..44b1067d958fa --- /dev/null +++ b/flang/lib/Optimizer/CodeGen/Target.h @@ -0,0 +1,108 @@ +//===- Target.h - target specific details -----------------------*- 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 +// +//===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// + +#ifndef OPTMIZER_CODEGEN_TARGET_H +#define OPTMIZER_CODEGEN_TARGET_H + +#include "mlir/IR/Types.h" +#include +#include +#include + +namespace llvm { +class Triple; +} // namespace llvm + +namespace fir { +class KindMapping; + +namespace details { +/// Extra information about how to marshal an argument or return value that +/// modifies a signature per a particular ABI's calling convention. +/// Note: llvm::Attribute is not used directly, because its use depends on an +/// LLVMContext. +class Attributes { +public: + Attributes() : alignment{0}, byval{false}, sret{false}, append{false} {} + Attributes(unsigned short alignment, bool byval = false, bool sret = false, + bool append = false) + : alignment{alignment}, byval{byval}, sret{sret}, append{append} {} + + unsigned getAlignment() const { return alignment; } + bool hasAlignment() const { return alignment != 0; } + bool isByVal() const { return byval; } + bool returnValueAsArgument() const { return isSRet(); } + bool isSRet() const { return sret; } + bool isAppend() const { return append; } + +private: + unsigned short alignment{}; + bool byval : 1; + bool sret : 1; + bool append : 1; +}; + +} // namespace details + +/// Some details of how to represent certain features depend on the target and +/// ABI that is being used. These specifics are captured here and guide the +/// lowering of FIR to LLVM-IR dialect. +class CodeGenSpecifics { +public: + using Attributes = details::Attributes; + using Marshalling = std::vector>; + + static std::unique_ptr + get(mlir::MLIRContext *ctx, llvm::Triple &trp, KindMapping &kindMap); + + CodeGenSpecifics(mlir::MLIRContext *ctx, llvm::Triple &trp, + KindMapping &kindMap) + : context{*ctx}, triple{trp}, kindMap{kindMap} {} + CodeGenSpecifics() = delete; + virtual ~CodeGenSpecifics() {} + + /// Type presentation of a `complex` type value in memory. + virtual mlir::Type complexMemoryType(mlir::Type eleTy) const = 0; + + /// Type presentation of a `complex` type argument when passed by + /// value. An argument value may need to be passed as a (safe) reference + /// argument. + virtual Marshalling complexArgumentType(mlir::Type eleTy) const = 0; + + /// Type presentation of a `complex` type return value. Such a return + /// value may need to be converted to a hidden reference argument. + virtual Marshalling complexReturnType(mlir::Type eleTy) const = 0; + + /// Type presentation of a `boxchar` type value in memory. + virtual mlir::Type boxcharMemoryType(mlir::Type eleTy) const = 0; + + /// Type presentation of a `boxchar` type argument when passed by value. An + /// argument value may need to be passed as a (safe) reference argument. + /// + /// A function that returns a `boxchar` type value must already have + /// converted that return value to an sret argument. This requirement is in + /// keeping with Fortran semantics, which require the caller to allocate the + /// space for the return CHARACTER value and pass a pointer and the length of + /// that space (a boxchar) to the called function. Such functions should be + /// annotated with an Attribute to distinguish the sret argument. + virtual Marshalling boxcharArgumentType(mlir::Type eleTy, + bool sret = false) const = 0; + +protected: + mlir::MLIRContext &context; + llvm::Triple &triple; + KindMapping &kindMap; +}; + +} // namespace fir + +#endif // OPTMIZER_CODEGEN_TARGET_H diff --git a/flang/lib/Optimizer/Dialect/FIRDialect.cpp b/flang/lib/Optimizer/Dialect/FIRDialect.cpp index 6ecac9fc881fc..0ae5f6106fa5a 100644 --- a/flang/lib/Optimizer/Dialect/FIRDialect.cpp +++ b/flang/lib/Optimizer/Dialect/FIRDialect.cpp @@ -43,10 +43,11 @@ struct FIRInlinerInterface : public mlir::DialectInlinerInterface { fir::FIROpsDialect::FIROpsDialect(mlir::MLIRContext *ctx) : mlir::Dialect("fir", ctx, mlir::TypeID::get()) { - addTypes(); + addTypes(); addAttributes(); addOperations< diff --git a/flang/lib/Optimizer/Dialect/FIROps.cpp b/flang/lib/Optimizer/Dialect/FIROps.cpp index c1a2d14643de9..8daadc9bd1ba1 100644 --- a/flang/lib/Optimizer/Dialect/FIROps.cpp +++ b/flang/lib/Optimizer/Dialect/FIROps.cpp @@ -167,6 +167,11 @@ mlir::Type fir::BoxDimsOp::getTupleType() { // CallOp //===----------------------------------------------------------------------===// +mlir::FunctionType fir::CallOp::getFunctionType() { + return mlir::FunctionType::get(getOperandTypes(), getResultTypes(), + getContext()); +} + static void printCallOp(mlir::OpAsmPrinter &p, fir::CallOp &op) { auto callee = op.callee(); bool isDirect = callee.hasValue(); @@ -323,7 +328,8 @@ mlir::ParseResult fir::parseCmpcOp(mlir::OpAsmParser &parser, void fir::ConvertOp::getCanonicalizationPatterns( OwningRewritePatternList &results, MLIRContext *context) { results.insert(context); + CombineConvertOptPattern, ForwardConstantConvertPattern>( + context); } mlir::OpFoldResult fir::ConvertOp::fold(llvm::ArrayRef opnds) { @@ -348,7 +354,7 @@ mlir::OpFoldResult fir::ConvertOp::fold(llvm::ArrayRef opnds) { bool fir::ConvertOp::isIntegerCompatible(mlir::Type ty) { return ty.isa() || ty.isa() || - ty.isa() || ty.isa() || + ty.isa() || ty.isa() || ty.isa(); } @@ -412,8 +418,8 @@ void fir::CoordinateOp::build(OpBuilder &builder, OperationState &result, //===----------------------------------------------------------------------===// mlir::FunctionType fir::DispatchOp::getFunctionType() { - auto attr = getAttr("fn_type").cast(); - return attr.getValue().cast(); + return mlir::FunctionType::get(getOperandTypes(), getResultTypes(), + getContext()); } //===----------------------------------------------------------------------===// diff --git a/flang/lib/Optimizer/Dialect/FIRType.cpp b/flang/lib/Optimizer/Dialect/FIRType.cpp index 524b54bf09ee0..bf2b226e9c55d 100644 --- a/flang/lib/Optimizer/Dialect/FIRType.cpp +++ b/flang/lib/Optimizer/Dialect/FIRType.cpp @@ -108,8 +108,8 @@ CharacterType parseCharacter(mlir::DialectAsmParser &parser) { } // `complex` `<` kind `>` -CplxType parseComplex(mlir::DialectAsmParser &parser) { - return parseKindSingleton(parser); +fir::ComplexType parseComplex(mlir::DialectAsmParser &parser) { + return parseKindSingleton(parser); } // `shape` `<` rank `>` @@ -138,8 +138,8 @@ HeapType parseHeap(mlir::DialectAsmParser &parser, mlir::Location loc) { } // `int` `<` kind `>` -IntType parseInteger(mlir::DialectAsmParser &parser) { - return parseKindSingleton(parser); +fir::IntegerType parseInteger(mlir::DialectAsmParser &parser) { + return parseKindSingleton(parser); } // `len` @@ -173,6 +173,19 @@ TypeDescType parseTypeDesc(mlir::DialectAsmParser &parser, mlir::Location loc) { return parseTypeSingleton(parser, loc); } +// `vector` `<` len `:` type `>` +fir::VectorType parseVector(mlir::DialectAsmParser &parser, + mlir::Location loc) { + int64_t len = 0; + mlir::Type eleTy; + if (parser.parseLess() || parser.parseInteger(len) || parser.parseColon() || + parser.parseType(eleTy) || parser.parseGreater()) { + parser.emitError(parser.getNameLoc(), "invalid vector type"); + return {}; + } + return fir::VectorType::get(len, eleTy); +} + // `void` mlir::Type parseVoid(mlir::DialectAsmParser &parser) { return parser.getBuilder().getNoneType(); @@ -187,7 +200,7 @@ SequenceType parseSequence(mlir::DialectAsmParser &parser, mlir::Location) { } SequenceType::Shape shape; if (parser.parseOptionalStar()) { - if (parser.parseDimensionList(shape, true)) { + if (parser.parseDimensionList(shape, /*allowDynamic=*/true)) { parser.emitError(parser.getNameLoc(), "invalid shape"); return {}; } @@ -212,7 +225,7 @@ SequenceType parseSequence(mlir::DialectAsmParser &parser, mlir::Location) { /// Is `ty` a standard or FIR integer type? static bool isaIntegerType(mlir::Type ty) { // TODO: why aren't we using isa_integer? investigatation required. - return ty.isa() || ty.isa(); + return ty.isa() || ty.isa(); } bool verifyRecordMemberType(mlir::Type ty) { @@ -385,6 +398,8 @@ mlir::Type fir::parseFirType(FIROpsDialect *, mlir::DialectAsmParser &parser) { return parseDerived(parser, loc); if (typeNameLit == "void") return parseVoid(parser); + if (typeNameLit == "vector") + return parseVector(parser, loc); parser.emitError(parser.getNameLoc(), "unknown FIR type " + typeNameLit); return {}; @@ -405,14 +420,14 @@ struct CharacterTypeStorage : public mlir::TypeStorage { } bool operator==(const KeyTy &key) const { - return key == KeyTy{ getFKind(), getLen() }; + return key == KeyTy{getFKind(), getLen()}; } static CharacterTypeStorage *construct(mlir::TypeStorageAllocator &allocator, const KeyTy &key) { auto *storage = allocator.allocate(); - return new (storage) CharacterTypeStorage{ std::get<0>(key), - std::get<1>(key) }; + return new (storage) + CharacterTypeStorage{std::get<0>(key), std::get<1>(key)}; } KindTy getFKind() const { return kind; } @@ -425,7 +440,7 @@ struct CharacterTypeStorage : public mlir::TypeStorage { private: CharacterTypeStorage() = delete; explicit CharacterTypeStorage(KindTy kind, CharacterType::LenType len) - : kind{ kind }, len{ len } {} + : kind{kind}, len{len} {} }; struct ShapeTypeStorage : public mlir::TypeStorage { @@ -438,7 +453,7 @@ struct ShapeTypeStorage : public mlir::TypeStorage { static ShapeTypeStorage *construct(mlir::TypeStorageAllocator &allocator, unsigned rank) { auto *storage = allocator.allocate(); - return new (storage) ShapeTypeStorage{ rank }; + return new (storage) ShapeTypeStorage{rank}; } unsigned getRank() const { return rank; } @@ -448,7 +463,7 @@ struct ShapeTypeStorage : public mlir::TypeStorage { private: ShapeTypeStorage() = delete; - explicit ShapeTypeStorage(unsigned rank) : rank{ rank } {} + explicit ShapeTypeStorage(unsigned rank) : rank{rank} {} }; struct ShapeShiftTypeStorage : public mlir::TypeStorage { using KeyTy = unsigned; @@ -460,7 +475,7 @@ struct ShapeShiftTypeStorage : public mlir::TypeStorage { static ShapeShiftTypeStorage *construct(mlir::TypeStorageAllocator &allocator, unsigned rank) { auto *storage = allocator.allocate(); - return new (storage) ShapeShiftTypeStorage{ rank }; + return new (storage) ShapeShiftTypeStorage{rank}; } unsigned getRank() const { return rank; } @@ -470,7 +485,7 @@ struct ShapeShiftTypeStorage : public mlir::TypeStorage { private: ShapeShiftTypeStorage() = delete; - explicit ShapeShiftTypeStorage(unsigned rank) : rank{ rank } {} + explicit ShapeShiftTypeStorage(unsigned rank) : rank{rank} {} }; struct SliceTypeStorage : public mlir::TypeStorage { using KeyTy = unsigned; @@ -482,7 +497,7 @@ struct SliceTypeStorage : public mlir::TypeStorage { static SliceTypeStorage *construct(mlir::TypeStorageAllocator &allocator, unsigned rank) { auto *storage = allocator.allocate(); - return new (storage) SliceTypeStorage{ rank }; + return new (storage) SliceTypeStorage{rank}; } unsigned getRank() const { return rank; } @@ -492,7 +507,7 @@ struct SliceTypeStorage : public mlir::TypeStorage { private: SliceTypeStorage() = delete; - explicit SliceTypeStorage(unsigned rank) : rank{ rank } {} + explicit SliceTypeStorage(unsigned rank) : rank{rank} {} }; /// The type of a derived type part reference @@ -506,7 +521,7 @@ struct FieldTypeStorage : public mlir::TypeStorage { static FieldTypeStorage *construct(mlir::TypeStorageAllocator &allocator, KindTy) { auto *storage = allocator.allocate(); - return new (storage) FieldTypeStorage{ 0 }; + return new (storage) FieldTypeStorage{0}; } private: @@ -525,7 +540,7 @@ struct LenTypeStorage : public mlir::TypeStorage { static LenTypeStorage *construct(mlir::TypeStorageAllocator &allocator, KindTy) { auto *storage = allocator.allocate(); - return new (storage) LenTypeStorage{ 0 }; + return new (storage) LenTypeStorage{0}; } private: @@ -544,7 +559,7 @@ struct LogicalTypeStorage : public mlir::TypeStorage { static LogicalTypeStorage *construct(mlir::TypeStorageAllocator &allocator, KindTy kind) { auto *storage = allocator.allocate(); - return new (storage) LogicalTypeStorage{ kind }; + return new (storage) LogicalTypeStorage{kind}; } KindTy getFKind() const { return kind; } @@ -554,21 +569,21 @@ struct LogicalTypeStorage : public mlir::TypeStorage { private: LogicalTypeStorage() = delete; - explicit LogicalTypeStorage(KindTy kind) : kind{ kind } {} + explicit LogicalTypeStorage(KindTy kind) : kind{kind} {} }; /// `INTEGER` storage -struct IntTypeStorage : public mlir::TypeStorage { +struct IntegerTypeStorage : public mlir::TypeStorage { using KeyTy = KindTy; static unsigned hashKey(const KeyTy &key) { return llvm::hash_combine(key); } bool operator==(const KeyTy &key) const { return key == getFKind(); } - static IntTypeStorage *construct(mlir::TypeStorageAllocator &allocator, - KindTy kind) { - auto *storage = allocator.allocate(); - return new (storage) IntTypeStorage{ kind }; + static IntegerTypeStorage *construct(mlir::TypeStorageAllocator &allocator, + KindTy kind) { + auto *storage = allocator.allocate(); + return new (storage) IntegerTypeStorage{kind}; } KindTy getFKind() const { return kind; } @@ -577,22 +592,22 @@ struct IntTypeStorage : public mlir::TypeStorage { KindTy kind; private: - IntTypeStorage() = delete; - explicit IntTypeStorage(KindTy kind) : kind{ kind } {} + IntegerTypeStorage() = delete; + explicit IntegerTypeStorage(KindTy kind) : kind{kind} {} }; /// `COMPLEX` storage -struct CplxTypeStorage : public mlir::TypeStorage { +struct ComplexTypeStorage : public mlir::TypeStorage { using KeyTy = KindTy; static unsigned hashKey(const KeyTy &key) { return llvm::hash_combine(key); } bool operator==(const KeyTy &key) const { return key == getFKind(); } - static CplxTypeStorage *construct(mlir::TypeStorageAllocator &allocator, - KindTy kind) { - auto *storage = allocator.allocate(); - return new (storage) CplxTypeStorage{ kind }; + static ComplexTypeStorage *construct(mlir::TypeStorageAllocator &allocator, + KindTy kind) { + auto *storage = allocator.allocate(); + return new (storage) ComplexTypeStorage{kind}; } KindTy getFKind() const { return kind; } @@ -601,8 +616,8 @@ struct CplxTypeStorage : public mlir::TypeStorage { KindTy kind; private: - CplxTypeStorage() = delete; - explicit CplxTypeStorage(KindTy kind) : kind{ kind } {} + ComplexTypeStorage() = delete; + explicit ComplexTypeStorage(KindTy kind) : kind{kind} {} }; /// `REAL` storage (for reals of unsupported sizes) @@ -616,7 +631,7 @@ struct RealTypeStorage : public mlir::TypeStorage { static RealTypeStorage *construct(mlir::TypeStorageAllocator &allocator, KindTy kind) { auto *storage = allocator.allocate(); - return new (storage) RealTypeStorage{ kind }; + return new (storage) RealTypeStorage{kind}; } KindTy getFKind() const { return kind; } @@ -626,7 +641,7 @@ struct RealTypeStorage : public mlir::TypeStorage { private: RealTypeStorage() = delete; - explicit RealTypeStorage(KindTy kind) : kind{ kind } {} + explicit RealTypeStorage(KindTy kind) : kind{kind} {} }; /// Boxed object (a Fortran descriptor) @@ -634,7 +649,7 @@ struct BoxTypeStorage : public mlir::TypeStorage { using KeyTy = std::tuple; static unsigned hashKey(const KeyTy &key) { - auto hashVal{ llvm::hash_combine(std::get(key)) }; + auto hashVal{llvm::hash_combine(std::get(key))}; return llvm::hash_combine( hashVal, llvm::hash_combine(std::get(key))); } @@ -647,8 +662,8 @@ struct BoxTypeStorage : public mlir::TypeStorage { static BoxTypeStorage *construct(mlir::TypeStorageAllocator &allocator, const KeyTy &key) { auto *storage = allocator.allocate(); - return new (storage) BoxTypeStorage{ std::get(key), - std::get(key) }; + return new (storage) BoxTypeStorage{std::get(key), + std::get(key)}; } mlir::Type getElementType() const { return eleTy; } @@ -661,7 +676,7 @@ struct BoxTypeStorage : public mlir::TypeStorage { private: BoxTypeStorage() = delete; explicit BoxTypeStorage(mlir::Type eleTy, mlir::AffineMapAttr map) - : eleTy{ eleTy }, map{ map } {} + : eleTy{eleTy}, map{map} {} }; /// Boxed CHARACTER object type @@ -675,7 +690,7 @@ struct BoxCharTypeStorage : public mlir::TypeStorage { static BoxCharTypeStorage *construct(mlir::TypeStorageAllocator &allocator, KindTy kind) { auto *storage = allocator.allocate(); - return new (storage) BoxCharTypeStorage{ kind }; + return new (storage) BoxCharTypeStorage{kind}; } KindTy getFKind() const { return kind; } @@ -690,7 +705,7 @@ struct BoxCharTypeStorage : public mlir::TypeStorage { private: BoxCharTypeStorage() = delete; - explicit BoxCharTypeStorage(KindTy kind) : kind{ kind } {} + explicit BoxCharTypeStorage(KindTy kind) : kind{kind} {} }; /// Boxed PROCEDURE POINTER object type @@ -705,7 +720,7 @@ struct BoxProcTypeStorage : public mlir::TypeStorage { mlir::Type eleTy) { assert(eleTy && "element type is null"); auto *storage = allocator.allocate(); - return new (storage) BoxProcTypeStorage{ eleTy }; + return new (storage) BoxProcTypeStorage{eleTy}; } mlir::Type getElementType() const { return eleTy; } @@ -715,7 +730,7 @@ struct BoxProcTypeStorage : public mlir::TypeStorage { private: BoxProcTypeStorage() = delete; - explicit BoxProcTypeStorage(mlir::Type eleTy) : eleTy{ eleTy } {} + explicit BoxProcTypeStorage(mlir::Type eleTy) : eleTy{eleTy} {} }; /// Pointer-like object storage @@ -730,7 +745,7 @@ struct ReferenceTypeStorage : public mlir::TypeStorage { mlir::Type eleTy) { assert(eleTy && "element type is null"); auto *storage = allocator.allocate(); - return new (storage) ReferenceTypeStorage{ eleTy }; + return new (storage) ReferenceTypeStorage{eleTy}; } mlir::Type getElementType() const { return eleTy; } @@ -740,7 +755,7 @@ struct ReferenceTypeStorage : public mlir::TypeStorage { private: ReferenceTypeStorage() = delete; - explicit ReferenceTypeStorage(mlir::Type eleTy) : eleTy{ eleTy } {} + explicit ReferenceTypeStorage(mlir::Type eleTy) : eleTy{eleTy} {} }; /// Pointer object storage @@ -755,7 +770,7 @@ struct PointerTypeStorage : public mlir::TypeStorage { mlir::Type eleTy) { assert(eleTy && "element type is null"); auto *storage = allocator.allocate(); - return new (storage) PointerTypeStorage{ eleTy }; + return new (storage) PointerTypeStorage{eleTy}; } mlir::Type getElementType() const { return eleTy; } @@ -765,7 +780,7 @@ struct PointerTypeStorage : public mlir::TypeStorage { private: PointerTypeStorage() = delete; - explicit PointerTypeStorage(mlir::Type eleTy) : eleTy{ eleTy } {} + explicit PointerTypeStorage(mlir::Type eleTy) : eleTy{eleTy} {} }; /// Heap memory reference object storage @@ -780,7 +795,7 @@ struct HeapTypeStorage : public mlir::TypeStorage { mlir::Type eleTy) { assert(eleTy && "element type is null"); auto *storage = allocator.allocate(); - return new (storage) HeapTypeStorage{ eleTy }; + return new (storage) HeapTypeStorage{eleTy}; } mlir::Type getElementType() const { return eleTy; } @@ -790,7 +805,7 @@ struct HeapTypeStorage : public mlir::TypeStorage { private: HeapTypeStorage() = delete; - explicit HeapTypeStorage(mlir::Type eleTy) : eleTy{ eleTy } {} + explicit HeapTypeStorage(mlir::Type eleTy) : eleTy{eleTy} {} }; /// Sequence-like object storage @@ -799,22 +814,21 @@ struct SequenceTypeStorage : public mlir::TypeStorage { std::tuple; static unsigned hashKey(const KeyTy &key) { - auto shapeHash{ hash_value(std::get(key)) }; + auto shapeHash = hash_value(std::get(key)); shapeHash = llvm::hash_combine(shapeHash, std::get(key)); return llvm::hash_combine(shapeHash, std::get(key)); } bool operator==(const KeyTy &key) const { - return key == KeyTy{ getShape(), getElementType(), getLayoutMap() }; + return key == KeyTy{getShape(), getElementType(), getLayoutMap()}; } static SequenceTypeStorage *construct(mlir::TypeStorageAllocator &allocator, const KeyTy &key) { auto *storage = allocator.allocate(); - return new ( - storage) SequenceTypeStorage{ std::get(key), - std::get(key), - std::get(key) }; + return new (storage) SequenceTypeStorage{ + std::get(key), std::get(key), + std::get(key)}; } SequenceType::Shape getShape() const { return shape; } @@ -830,7 +844,7 @@ struct SequenceTypeStorage : public mlir::TypeStorage { SequenceTypeStorage() = delete; explicit SequenceTypeStorage(const SequenceType::Shape &shape, mlir::Type eleTy, mlir::AffineMapAttr map) - : shape{ shape }, eleTy{ eleTy }, map{ map } {} + : shape{shape}, eleTy{eleTy}, map{map} {} }; /// Derived type storage @@ -846,7 +860,7 @@ struct RecordTypeStorage : public mlir::TypeStorage { static RecordTypeStorage *construct(mlir::TypeStorageAllocator &allocator, const KeyTy &key) { auto *storage = allocator.allocate(); - return new (storage) RecordTypeStorage{ key }; + return new (storage) RecordTypeStorage{key}; } llvm::StringRef getName() const { return name; } @@ -877,7 +891,7 @@ struct RecordTypeStorage : public mlir::TypeStorage { private: RecordTypeStorage() = delete; explicit RecordTypeStorage(llvm::StringRef name) - : name{ name }, finalized{ false } {} + : name{name}, finalized{false} {} }; /// Type descriptor type storage @@ -892,7 +906,7 @@ struct TypeDescTypeStorage : public mlir::TypeStorage { mlir::Type ofTy) { assert(ofTy && "descriptor type is null"); auto *storage = allocator.allocate(); - return new (storage) TypeDescTypeStorage{ ofTy }; + return new (storage) TypeDescTypeStorage{ofTy}; } // The type described by this type descriptor instance @@ -903,12 +917,46 @@ struct TypeDescTypeStorage : public mlir::TypeStorage { private: TypeDescTypeStorage() = delete; - explicit TypeDescTypeStorage(mlir::Type ofTy) : ofTy{ ofTy } {} + explicit TypeDescTypeStorage(mlir::Type ofTy) : ofTy{ofTy} {} +}; + +/// Vector type storage +struct VectorTypeStorage : public mlir::TypeStorage { + using KeyTy = std::tuple; + + static unsigned hashKey(const KeyTy &key) { + return llvm::hash_combine(std::get(key), + std::get(key)); + } + + bool operator==(const KeyTy &key) const { + return key == KeyTy{getLen(), getEleTy()}; + } + + static VectorTypeStorage *construct(mlir::TypeStorageAllocator &allocator, + const KeyTy &key) { + auto *storage = allocator.allocate(); + return new (storage) + VectorTypeStorage{std::get(key), std::get(key)}; + } + + uint64_t getLen() const { return len; } + mlir::Type getEleTy() const { return eleTy; } + +protected: + uint64_t len; + mlir::Type eleTy; + +private: + VectorTypeStorage() = delete; + explicit VectorTypeStorage(uint64_t len, mlir::Type eleTy) + : len{len}, eleTy{eleTy} {} }; } // namespace detail -template bool inbounds(A v, B lb, B ub) { +template +bool inbounds(A v, B lb, B ub) { return v >= lb && v < ub; } @@ -946,9 +994,8 @@ bool isa_aggregate(mlir::Type t) { mlir::Type dyn_cast_ptrEleTy(mlir::Type t) { return llvm::TypeSwitch(t) - .Case([](auto p) { - return p.getEleTy(); - }) + .Case( + [](auto p) { return p.getEleTy(); }) .Default([](mlir::Type) { return mlir::Type{}; }); } @@ -989,23 +1036,23 @@ KindTy fir::LogicalType::getFKind() const { return getImpl()->getFKind(); } // INTEGER -IntType fir::IntType::get(mlir::MLIRContext *ctxt, KindTy kind) { +fir::IntegerType fir::IntegerType::get(mlir::MLIRContext *ctxt, KindTy kind) { return Base::get(ctxt, kind); } -KindTy fir::IntType::getFKind() const { return getImpl()->getFKind(); } +KindTy fir::IntegerType::getFKind() const { return getImpl()->getFKind(); } // COMPLEX -CplxType fir::CplxType::get(mlir::MLIRContext *ctxt, KindTy kind) { +fir::ComplexType fir::ComplexType::get(mlir::MLIRContext *ctxt, KindTy kind) { return Base::get(ctxt, kind); } -mlir::Type fir::CplxType::getElementType() const { +mlir::Type fir::ComplexType::getElementType() const { return fir::RealType::get(getContext(), getFKind()); } -KindTy fir::CplxType::getFKind() const { return getImpl()->getFKind(); } +KindTy fir::ComplexType::getFKind() const { return getImpl()->getFKind(); } // REAL @@ -1084,8 +1131,8 @@ fir::ReferenceType::verifyConstructionInvariants(mlir::Location loc, eleTy.isa() || eleTy.isa() || eleTy.isa() || eleTy.isa() || eleTy.isa()) - return mlir::emitError(loc, "cannot build a reference to type: ") << eleTy - << '\n'; + return mlir::emitError(loc, "cannot build a reference to type: ") + << eleTy << '\n'; return mlir::success(); } @@ -1113,8 +1160,8 @@ mlir::LogicalResult fir::PointerType::verifyConstructionInvariants(mlir::Location loc, mlir::Type eleTy) { if (canBePointerOrHeapElementType(eleTy)) - return mlir::emitError(loc, "cannot build a pointer to type: ") << eleTy - << '\n'; + return mlir::emitError(loc, "cannot build a pointer to type: ") + << eleTy << '\n'; return mlir::success(); } @@ -1180,7 +1227,7 @@ bool fir::SequenceType::hasConstantInterior() const { if (rows == dim) return true; auto shape = getShape(); - for (unsigned i{ rows }, size{ dim }; i < size; ++i) + for (unsigned i{rows}, size{dim}; i < size; ++i) if (shape[i] != getUnknownExtent()) return false; return true; @@ -1195,7 +1242,8 @@ mlir::LogicalResult fir::SequenceType::verifyConstructionInvariants( eleTy.isa() || eleTy.isa() || eleTy.isa() || eleTy.isa() || eleTy.isa() || eleTy.isa() || eleTy.isa() || - eleTy.isa() || eleTy.isa()) + eleTy.isa() || eleTy.isa() || + eleTy.isa()) return mlir::emitError(loc, "cannot build an array of this element type: ") << eleTy << '\n'; return mlir::success(); @@ -1288,9 +1336,9 @@ mlir::Type fir::RecordType::getType(llvm::StringRef ident) { return {}; } -/// Type descriptor type -/// -/// This is the type of a type descriptor object (similar to a class instance) +//===----------------------------------------------------------------------===// +// Type descriptor type +//===----------------------------------------------------------------------===// TypeDescType fir::TypeDescType::get(mlir::Type ofType) { assert(!ofType.isa()); @@ -1312,6 +1360,27 @@ fir::TypeDescType::verifyConstructionInvariants(mlir::Location loc, return mlir::success(); } +//===----------------------------------------------------------------------===// +// Vector type +//===----------------------------------------------------------------------===// + +fir::VectorType fir::VectorType::get(uint64_t len, mlir::Type eleTy) { + return Base::get(eleTy.getContext(), len, eleTy); +} + +mlir::Type fir::VectorType::getEleTy() const { return getImpl()->getEleTy(); } + +uint64_t fir::VectorType::getLen() const { return getImpl()->getLen(); } + +mlir::LogicalResult +fir::VectorType::verifyConstructionInvariants(mlir::Location loc, uint64_t len, + mlir::Type eleTy) { + if (!(fir::isa_real(eleTy) || fir::isa_integer(eleTy))) + return mlir::emitError(loc, "cannot build a vector of type ") + << eleTy << '\n'; + return mlir::success(); +} + namespace { void printBounds(llvm::raw_ostream &os, const SequenceType::Shape &bounds) { @@ -1372,7 +1441,7 @@ void fir::printFirType(FIROpsDialect *, mlir::Type ty, os << '>'; return; } - if (auto type = ty.dyn_cast()) { + if (auto type = ty.dyn_cast()) { // Fortran intrinsic type COMPLEX os << "complex<" << type.getFKind() << '>'; return; @@ -1427,7 +1496,7 @@ void fir::printFirType(FIROpsDialect *, mlir::Type ty, os << '>'; return; } - if (auto type = ty.dyn_cast()) { + if (auto type = ty.dyn_cast()) { // Fortran intrinsic type INTEGER os << "int<" << type.getFKind() << '>'; return; @@ -1480,4 +1549,10 @@ void fir::printFirType(FIROpsDialect *, mlir::Type ty, os << '>'; return; } + if (auto type = ty.dyn_cast()) { + os << "vector<" << type.getLen() << ':'; + p.printType(type.getEleTy()); + os << '>'; + return; + } } diff --git a/flang/lib/Optimizer/Support/FIRContext.cpp b/flang/lib/Optimizer/Support/FIRContext.cpp index b7d008f558b3a..4f1dd03781e1e 100644 --- a/flang/lib/Optimizer/Support/FIRContext.cpp +++ b/flang/lib/Optimizer/Support/FIRContext.cpp @@ -23,7 +23,7 @@ void fir::setTargetTriple(mlir::ModuleOp mod, llvm::Triple &triple) { mod.setAttr(tripleName, fir::OpaqueAttr::get(mod.getContext(), &triple)); } -llvm::Triple *getTargetTriple(mlir::ModuleOp mod) { +llvm::Triple *fir::getTargetTriple(mlir::ModuleOp mod) { if (auto triple = mod.getAttrOfType(tripleName)) return static_cast(triple.getPointer()); return nullptr; @@ -35,7 +35,7 @@ void fir::setNameUniquer(mlir::ModuleOp mod, fir::NameUniquer &uniquer) { mod.setAttr(uniquerName, fir::OpaqueAttr::get(mod.getContext(), &uniquer)); } -fir::NameUniquer *getNameUniquer(mlir::ModuleOp mod) { +fir::NameUniquer *fir::getNameUniquer(mlir::ModuleOp mod) { if (auto triple = mod.getAttrOfType(uniquerName)) return static_cast(triple.getPointer()); return nullptr; @@ -47,16 +47,19 @@ void fir::setKindMapping(mlir::ModuleOp mod, fir::KindMapping &kindMap) { mod.setAttr(kindMapName, fir::OpaqueAttr::get(mod.getContext(), &kindMap)); } -fir::KindMapping *getKindMapping(mlir::ModuleOp mod) { +fir::KindMapping *fir::getKindMapping(mlir::ModuleOp mod) { if (auto triple = mod.getAttrOfType(kindMapName)) return static_cast(triple.getPointer()); return nullptr; } std::string fir::determineTargetTriple(llvm::StringRef triple) { - // Treat "native" and "" as stand-ins for the host machine. - if (triple.empty() || (triple == "native")) - return llvm::sys::getHostCPUName().str(); + // Treat "" or "default" as stand-ins for the default machine. + if (triple.empty() || triple == "default") + return llvm::sys::getDefaultTargetTriple(); + // Treat "native" as stand-in for the host machine. + if (triple == "native") + return llvm::sys::getProcessTriple(); // TODO: normalize the triple? return triple.str(); } diff --git a/flang/test/Fir/boxchar.fir b/flang/test/Fir/boxchar.fir index c5ac9ceb1ef60..22c4e0c8e9412 100644 --- a/flang/test/Fir/boxchar.fir +++ b/flang/test/Fir/boxchar.fir @@ -1,7 +1,6 @@ -// RUN: tco %s | FileCheck %s +// RUN: tco --target=x86_64-unknown-linux-gnu %s | FileCheck %s // Test of building and passing boxchar. -// TODO: split argument into two distinct parameters. func @callee(%x : !fir.boxchar<1>) @@ -11,7 +10,7 @@ func @get_name() { %2 = constant 9 : i64 %3 = fir.convert %1 : (!fir.ref>>) -> !fir.ref> %4 = fir.emboxchar %3, %2 : (!fir.ref>, i64) -> !fir.boxchar<1> - // CHECK: call void @callee({ i8*, i64 } { i8* getelementptr inbounds ([9 x i8], [9 x i8]* @name, i32 0, i32 0), i64 9 }) + // CHECK: call void @callee(i8* getelementptr inbounds ([9 x i8], [9 x i8]* @name, i32 0, i32 0), i64 9) fir.call @callee(%4) : (!fir.boxchar<1>) -> () return } diff --git a/flang/test/Fir/compare.fir b/flang/test/Fir/compare.fir index f569c97a49b5b..3ac8bedde2836 100644 --- a/flang/test/Fir/compare.fir +++ b/flang/test/Fir/compare.fir @@ -1,4 +1,4 @@ -// RUN: tco -emit-fir %s | tco | FileCheck %s +// RUN: tco -emit-fir %s | tco --target=x86_64-unknown-linux-gnu | FileCheck %s // CHECK-LABEL: define i1 @cmp(x86_fp80 %0, x86_fp80 %1) func @cmp(%a : !fir.real<10>, %b : !fir.real<10>) -> i1 { @@ -14,7 +14,7 @@ func @cmp2(%a : !fir.real<16>, %b : !fir.real<16>) -> i1 { return %1 : i1 } -// CHECK-LABEL: define i1 @cmp3({ float, float } %0, { float, float } %1) +// CHECK-LABEL: define i1 @cmp3(<2 x float> %0, <2 x float> %1) func @cmp3(%a : !fir.complex<4>, %b : !fir.complex<4>) -> i1 { // CHECK: fcmp ueq float %1 = fir.cmpc "ueq", %a, %b : !fir.complex<4> @@ -35,10 +35,11 @@ func @neg2(%a : !fir.real<8>) -> !fir.real<8> { return %1 : !fir.real<8> } -// CHECK-LABEL: define { double, double } @neg3({ double, double } %0) +// CHECK-LABEL: define { double, double } @neg3(double %0, double %1) func @neg3(%a : !fir.complex<8>) -> !fir.complex<8> { -// CHECK: %[[r3:.*]] = fneg double -// CHECK: insertvalue { double, double } %0, double %[[r3]] + // CHECK: %[[g2:.*]] = insertvalue { double, double } % + // CHECK: %[[r3:.*]] = fneg double + // CHECK: insertvalue { double, double } %[[g2]], double %[[r3]] %1 = fir.negc %a : !fir.complex<8> return %1 : !fir.complex<8> } diff --git a/flang/test/Fir/complex.fir b/flang/test/Fir/complex.fir index 6d7cfdfcb068d..971551328ddc2 100644 --- a/flang/test/Fir/complex.fir +++ b/flang/test/Fir/complex.fir @@ -1,12 +1,12 @@ // RUN: cc -c %S/print_complex.c -// RUN: tco %s | FileCheck %s --check-prefix=LLVMIR -// RUN: tco %s | llc | as -o %t +// RUN: tco --target=x86_64-unknown-linux-gnu %s | FileCheck %s --check-prefix=LLVMIR +// RUN: tco --target=x86_64-unknown-linux-gnu %s | llc | as -o %t // RUN: cc %t print_complex.o // RUN: ./a.out | FileCheck %s --check-prefix=EXECHECK // EXECHECK: <0.935893, 2.252526> -// LLVMIR-LABEL: define { float, float } @foo +// LLVMIR-LABEL: define <2 x float> @foo(<2 x float> % func @foo(%a : !fir.complex<4>, %b : !fir.complex<4>, %c : !fir.complex<4>, %d : !fir.complex<4>, %e : !fir.complex<4>) -> !fir.complex<4> { // LLVMIR-COUNT-2: extractvalue // LLVMIR: fadd float @@ -23,7 +23,7 @@ func @foo(%a : !fir.complex<4>, %b : !fir.complex<4>, %c : !fir.complex<4>, %d : return %4 : !fir.complex<4> } -// LLVMIR-LABEL: define float @real_part({ float, float } %0) +// LLVMIR-LABEL: define float @real_part(<2 x float> %0) func @real_part(%a : !fir.complex<4>) -> f32 { %0 = constant 0 : i32 // LLVMIR: extractvalue @@ -31,7 +31,7 @@ func @real_part(%a : !fir.complex<4>) -> f32 { return %1 : f32 } -// LLVMIR-LABEL: define { float, float } @conj +// LLVMIR-LABEL: define <2 x float> @conj(<2 x float> % func @conj(%a : !fir.complex<4>) -> !fir.complex<4> { %0 = constant 1 : i32 // LLVMIR: extractvalue diff --git a/flang/test/Fir/convert.fir b/flang/test/Fir/convert.fir index ad480133c6ad7..1fde7ac96d025 100644 --- a/flang/test/Fir/convert.fir +++ b/flang/test/Fir/convert.fir @@ -1,6 +1,6 @@ -// RUN: tco %s | FileCheck %s +// RUN: tco --target=x86_64-unknown-linux-gnu %s | FileCheck %s -// CHECK-LABEL: define { double, double } @c({ float, float } +// CHECK-LABEL: define { double, double } @c(<2 x float> % func @c(%x : !fir.complex<4>) -> !fir.complex<8> { // CHECK: %[[R:.*]] = extractvalue { float, float } %{{.*}}, 0 // CHECK: %[[I:.*]] = extractvalue { float, float } %{{.*}}, 1 diff --git a/flang/test/Fir/target.fir b/flang/test/Fir/target.fir new file mode 100644 index 0000000000000..fc39816301647 --- /dev/null +++ b/flang/test/Fir/target.fir @@ -0,0 +1,117 @@ +// RUN: tco --target=i386-unknown-linux-gnu %s | FileCheck %s --check-prefix=I32 +// RUN: tco --target=x86_64-unknown-linux-gnu %s | FileCheck %s --check-prefix=X64 + +// I32-LABEL: define i64 @gen4() +// X64-LABEL: define <2 x float> @gen4() +func @gen4() -> !fir.complex<4> { + %1 = fir.undefined !fir.complex<4> + %2 = constant 2.0 : f32 + %3 = fir.convert %2 : (f32) -> !fir.real<4> + %c0 = constant 0 : i32 + %4 = fir.insert_value %1, %3, %c0 : (!fir.complex<4>, !fir.real<4>, i32) -> !fir.complex<4> + %c1 = constant 1 : i32 + %5 = constant -42.0 : f32 + %6 = fir.insert_value %4, %5, %c1 : (!fir.complex<4>, f32, i32) -> !fir.complex<4> + // I32: store { float, float } { float 2.000000e+00, float -4.200000e+01 } + // I32: %[[load:.*]] = load i64, i64* + // I32: ret i64 %[[load]] + // X64: store { float, float } { float 2.000000e+00, float -4.200000e+01 } + // X64: %[[load:.*]] = load <2 x float>, <2 x float>* + // X64: ret <2 x float> %[[load]] + return %6 : !fir.complex<4> +} + +// I32-LABEL: define void @gen8({ double, double }* sret % +// X64-LABEL: define { double, double } @gen8() +func @gen8() -> !fir.complex<8> { + %1 = fir.undefined !fir.complex<8> + %2 = constant 1.0 : f64 + %3 = constant -4.0 : f64 + %c0 = constant 0 : i32 + %4 = fir.insert_value %1, %3, %c0 : (!fir.complex<8>, f64, i32) -> !fir.complex<8> + %c1 = constant 1 : i32 + %5 = fir.insert_value %4, %2, %c1 : (!fir.complex<8>, f64, i32) -> !fir.complex<8> + // I32: store { double, double } { double -4.000000e+00, double 1.000000e+00 } + // I64: store { double, double } { double -4.000000e+00, double 1.000000e+00 } + // I64: %[[load:.*]] = load { double, double } + // I64: ret { double, double } %[[load]] + return %5 : !fir.complex<8> +} + +// I32: declare void @sink4({ float, float }*) +// X64: declare void @sink4(<2 x float>) +func @sink4(!fir.complex<4>) -> () + +// I32: declare void @sink8({ double, double }*) +// X64: declare void @sink8(double, double) +func @sink8(!fir.complex<8>) -> () + +// I32-LABEL: define void @call4() +// X64-LABEL: define void @call4() +func @call4() { + // I32: = call i64 @gen4() + // X64: = call <2 x float> @gen4() + %1 = fir.call @gen4() : () -> !fir.complex<4> + // I32: call void @sink4({ float, float }* % + // X64: call void @sink4(<2 x float> % + fir.call @sink4(%1) : (!fir.complex<4>) -> () + return +} + +// I32-LABEL: define void @call8() +// X64-LABEL: define void @call8() +func @call8() { + // I32: call void @gen8({ double, double }* % + // X64: = call { double, double } @gen8() + %1 = fir.call @gen8() : () -> !fir.complex<8> + // I32: call void @sink8({ double, double }* % + // X64: call void @sink8(double %4, double %5) + fir.call @sink8(%1) : (!fir.complex<8>) -> () + return +} + +// I32-LABEL: define i64 @char1lensum(i8* %0, i8* %1, i32 %2, i32 %3) +// X64-LABEL: define i64 @char1lensum(i8* %0, i8* %1, i64 %2, i64 %3) +func @char1lensum(%arg0 : !fir.boxchar<1>, %arg1 : !fir.boxchar<1>) -> i64 { + // X64-DAG: %[[p0:.*]] = insertvalue { i8*, i64 } undef, i8* %1, 0 + // X64-DAG: = insertvalue { i8*, i64 } %[[p0]], i64 %3, 1 + // X64-DAG: %[[p1:.*]] = insertvalue { i8*, i64 } undef, i8* %0, 0 + // X64-DAG: = insertvalue { i8*, i64 } %[[p1]], i64 %2, 1 + %1:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref>, i64) + %2:2 = fir.unboxchar %arg1 : (!fir.boxchar<1>) -> (!fir.ref>, i64) + // I32: %[[add:.*]] = add i64 % + // X64: %[[add:.*]] = add i64 % + %3 = addi %1#1, %2#1 : i64 + // I32: ret i64 %[[add]] + // X64: ret i64 %[[add]] + return %3 : i64 +} + +// I32-LABEL: define void @char1copy(i8* sret %0, i32 %1, i8* %2, i32 %3) +// I64-LABEL: define void @char1copy(i8* sret %0, i64 %1, i8* %2, i64 %3) +func @char1copy(%arg0 : !fir.boxchar<1> {llvm.sret = true}, %arg1 : !fir.boxchar<1>) { + // I32-DAG: %[[p0:.*]] = insertvalue { i8*, i32 } undef, i8* %2, 0 + // I32-DAG: = insertvalue { i8*, i32 } %[[p0]], i32 %3, 1 + // I32-DAG: %[[p1:.*]] = insertvalue { i8*, i32 } undef, i8* %0, 0 + // I32-DAG: = insertvalue { i8*, i32 } %[[p1]], i32 %1, 1 + // X64-DAG: %[[p0:.*]] = insertvalue { i8*, i64 } undef, i8* %2, 0 + // X64-DAG: = insertvalue { i8*, i64 } %[[p0]], i64 %3, 1 + // X64-DAG: %[[p1:.*]] = insertvalue { i8*, i64 } undef, i8* %0, 0 + // X64-DAG: = insertvalue { i8*, i64 } %[[p1]], i64 %1, 1 + %1:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref>>, i64) + %2:2 = fir.unboxchar %arg1 : (!fir.boxchar<1>) -> (!fir.ref>>, i64) + %c0 = constant 0 : index + %c1 = constant 1 : index + %3 = fir.convert %1#1 : (i64) -> index + %last = subi %3, %c1 : index + fir.do_loop %i = %c0 to %last step %c1 { + %in_pos = fir.coordinate_of %2#0, %i : (!fir.ref>>, index) -> !fir.ref> + %out_pos = fir.coordinate_of %1#0, %i : (!fir.ref>>, index) -> !fir.ref> + %ch = fir.load %in_pos : !fir.ref> + fir.store %ch to %out_pos : !fir.ref> + } + // I32: ret void + // X64: ret void + return +} + diff --git a/flang/test/Lower/bbcnull.f90 b/flang/test/Lower/bbcnull.f90 new file mode 100644 index 0000000000000..8b27c796dbeab --- /dev/null +++ b/flang/test/Lower/bbcnull.f90 @@ -0,0 +1,4 @@ +! RUN: bbc --version | FileCheck %s +! CHECK: LLVM version + +! This test is intentionally empty. diff --git a/flang/test/Lower/dummy-procedure.f90 b/flang/test/Lower/dummy-procedure.f90 index a9baa2976756a..71e2ce3c42d20 100644 --- a/flang/test/Lower/dummy-procedure.f90 +++ b/flang/test/Lower/dummy-procedure.f90 @@ -33,8 +33,8 @@ real function func(x) real function test_func() real :: func, prefoo external :: func - !CHECK: %[[f:.*]] = constant @_QPfunc : (!fir.ref) -> f32 - !CHECK: %[[fcast:.*]] = fir.convert %f : ((!fir.ref) -> f32) -> (() -> ()) + !CHECK: %[[f:.*]] = fir.address_of(@_QPfunc) : (!fir.ref) -> f32 + !CHECK: %[[fcast:.*]] = fir.convert %[[f]] : ((!fir.ref) -> f32) -> (() -> ()) !CHECK: fir.call @_QPprefoo(%[[fcast]]) : (() -> ()) -> f32 test_func = prefoo(func) end function @@ -69,8 +69,8 @@ subroutine sub(x) ! CHECK-LABEL: func @_QPtest_sub subroutine test_sub() external :: sub - !CHECK: %[[f:.*]] = constant @_QPsub : (!fir.ref) -> () - !CHECK: %[[fcast:.*]] = fir.convert %f : ((!fir.ref) -> ()) -> (() -> ()) + !CHECK: %[[f:.*]] = fir.address_of(@_QPsub) : (!fir.ref) -> () + !CHECK: %[[fcast:.*]] = fir.convert %[[f]] : ((!fir.ref) -> ()) -> (() -> ()) !CHECK: fir.call @_QPprefoo_sub(%[[fcast]]) : (() -> ()) -> () call prefoo_sub(sub) end subroutine @@ -81,8 +81,8 @@ subroutine test_sub() ! CHECK-LABEL: func @_QPtest_acos subroutine test_acos(x) intrinsic :: acos - !CHECK: %[[f:.*]] = constant @fir.acos.f32.ref_f32 : (!fir.ref) -> f32 - !CHECK: %[[fcast:.*]] = fir.convert %f : ((!fir.ref) -> f32) -> (() -> ()) + !CHECK: %[[f:.*]] = fir.address_of(@fir.acos.f32.ref_f32) : (!fir.ref) -> f32 + !CHECK: %[[fcast:.*]] = fir.convert %[[f]] : ((!fir.ref) -> f32) -> (() -> ()) !CHECK: fir.call @_QPfoo_acos(%[[fcast]]) : (() -> ()) -> () call foo_acos(acos) end subroutine @@ -91,8 +91,8 @@ subroutine test_acos(x) ! CHECK-LABEL: func @_QPtest_aimag subroutine test_aimag() intrinsic :: aimag - !CHECK: %[[f:.*]] = constant @fir.aimag.f32.ref_z4 : (!fir.ref>) -> f32 - !CHECK: %[[fcast:.*]] = fir.convert %f : ((!fir.ref>) -> f32) -> (() -> ()) + !CHECK: %[[f:.*]] = fir.address_of(@fir.aimag.f32.ref_z4) : (!fir.ref>) -> f32 + !CHECK: %[[fcast:.*]] = fir.convert %[[f]] : ((!fir.ref>) -> f32) -> (() -> ()) !CHECK: fir.call @_QPfoo_aimag(%[[fcast]]) : (() -> ()) -> () call foo_aimag(aimag) end subroutine @@ -101,8 +101,8 @@ subroutine test_aimag() ! CHECK-LABEL: func @_QPtest_len subroutine test_len() intrinsic :: len - ! CHECK: %[[f:.*]] = constant @fir.len.i32.bc1 : (!fir.boxchar<1>) -> i32 - ! CHECK: %[[fcast:.*]] = fir.convert %f : ((!fir.boxchar<1>) -> i32) -> (() -> ()) + ! CHECK: %[[f:.*]] = fir.address_of(@fir.len.i32.bc1) : (!fir.boxchar<1>) -> i32 + ! CHECK: %[[fcast:.*]] = fir.convert %[[f]] : ((!fir.boxchar<1>) -> i32) -> (() -> ()) !CHECK: fir.call @_QPfoo_len(%[[fcast]]) : (() -> ()) -> () call foo_len(len) end subroutine @@ -112,8 +112,8 @@ subroutine test_len() ! CHECK-LABEL: func @_QPtest_iabs subroutine test_iabs() intrinsic :: iabs - ! CHECK: %[[f:.*]] = constant @fir.abs.i32.ref_i32 : (!fir.ref) -> i32 - ! CHECK: %[[fcast:.*]] = fir.convert %f : ((!fir.ref) -> i32) -> (() -> ()) + ! CHECK: %[[f:.*]] = fir.address_of(@fir.abs.i32.ref_i32) : (!fir.ref) -> i32 + ! CHECK: %[[fcast:.*]] = fir.convert %[[f]] : ((!fir.ref) -> i32) -> (() -> ()) ! CHECK: fir.call @_QPfoo_iabs(%[[fcast]]) : (() -> ()) -> () call foo_iabs(iabs) end subroutine @@ -137,7 +137,7 @@ subroutine todo3(dummy_proc) ! CHECK-LABEL: func @fir.acos.f32.ref_f32(%arg0: !fir.ref) -> f32 !CHECK: %[[load:.*]] = fir.load %arg0 - !CHECK: %[[res:.*]] = call @__fs_acos_1(%[[load]]) : (f32) -> f32 + !CHECK: %[[res:.*]] = fir.call @__fs_acos_1(%[[load]]) : (f32) -> f32 !CHECK: return %[[res]] : f32 !CHECK-LABEL: func @fir.aimag.f32.ref_z4(%arg0: !fir.ref>) diff --git a/flang/test/Lower/intrinsics.f90 b/flang/test/Lower/intrinsics.f90 index e7c4b6cc5480e..52390b280e55f 100644 --- a/flang/test/Lower/intrinsics.f90 +++ b/flang/test/Lower/intrinsics.f90 @@ -13,7 +13,7 @@ subroutine abs_testi(a, b) ! CHECK-LABEL: abs_testr subroutine abs_testr(a, b) real :: a, b - ! CHECK: call @llvm.fabs.f32 + ! CHECK: fir.call @llvm.fabs.f32 b = abs(a) end subroutine @@ -23,7 +23,7 @@ subroutine abs_testz(a, b) real :: b ! CHECK: fir.extract_value ! CHECK: fir.extract_value - ! CHECK: call @{{.*}}hypot + ! CHECK: fir.call @{{.*}}hypot b = abs(a) end subroutine @@ -40,7 +40,7 @@ subroutine aimag_test(a, b) ! CHECK-LABEL: aint_test subroutine aint_test(a, b) real :: a, b - ! CHECK: call @llvm.trunc.f32 + ! CHECK: fir.call @llvm.trunc.f32 b = aint(a) end subroutine @@ -48,7 +48,7 @@ subroutine aint_test(a, b) ! CHECK-LABEL: anint_test subroutine anint_test(a, b) real :: a, b - ! CHECK: call @llvm.round.f32 + ! CHECK: fir.call @llvm.round.f32 b = anint(a) end subroutine @@ -106,7 +106,7 @@ subroutine ceiling_test1(i, a) integer :: i real :: a i = ceiling(a) - ! CHECK: %[[f:.*]] = call @llvm.ceil.f32 + ! CHECK: %[[f:.*]] = fir.call @llvm.ceil.f32 ! CHECK: fir.convert %[[f]] : (f32) -> i32 end subroutine ! CHECK-LABEL: ceiling_test2 @@ -114,7 +114,7 @@ subroutine ceiling_test2(i, a) integer(8) :: i real :: a i = ceiling(a, 8) - ! CHECK: %[[f:.*]] = call @llvm.ceil.f32 + ! CHECK: %[[f:.*]] = fir.call @llvm.ceil.f32 ! CHECK: fir.convert %[[f]] : (f32) -> i64 end subroutine @@ -135,7 +135,7 @@ subroutine floor_test1(i, a) integer :: i real :: a i = floor(a) - ! CHECK: %[[f:.*]] = call @llvm.floor.f32 + ! CHECK: %[[f:.*]] = fir.call @llvm.floor.f32 ! CHECK: fir.convert %[[f]] : (f32) -> i32 end subroutine ! CHECK-LABEL: floor_test2 @@ -143,7 +143,7 @@ subroutine floor_test2(i, a) integer(8) :: i real :: a i = floor(a, 8) - ! CHECK: %[[f:.*]] = call @llvm.floor.f32 + ! CHECK: %[[f:.*]] = fir.call @llvm.floor.f32 ! CHECK: fir.convert %[[f]] : (f32) -> i64 end subroutine @@ -242,14 +242,14 @@ subroutine nint_test1(i, a) integer :: i real :: a i = nint(a) - ! CHECK: call @llvm.lround.i32.f32 + ! CHECK: fir.call @llvm.lround.i32.f32 end subroutine ! CHECK-LABEL: nint_test2 subroutine nint_test2(i, a) integer(8) :: i real(8) :: a i = nint(a, 8) - ! CHECK: call @llvm.lround.i64.f64 + ! CHECK: fir.call @llvm.lround.i64.f64 end subroutine @@ -270,7 +270,7 @@ subroutine sign_testi(a, b, c) ! CHECK-LABEL: sign_testr subroutine sign_testr(a, b, c) real a, b, c - ! CHECK-DAG: call {{.*}}fabs + ! CHECK-DAG: fir.call {{.*}}fabs ! CHECK-DAG: fir.negf ! CHECK-DAG: fir.cmpf "olt" ! CHECK: select @@ -281,6 +281,6 @@ subroutine sign_testr(a, b, c) ! CHECK-LABEL: sqrt_testr subroutine sqrt_testr(a, b) real :: a, b - ! CHECK: call {{.*}}sqrt + ! CHECK: fir.call {{.*}}sqrt b = sqrt(a) end subroutine diff --git a/flang/test/Lower/procedure-declarations.f90 b/flang/test/Lower/procedure-declarations.f90 index 164db03adff93..48f458750b9a8 100644 --- a/flang/test/Lower/procedure-declarations.f90 +++ b/flang/test/Lower/procedure-declarations.f90 @@ -14,7 +14,7 @@ ! CHECK-LABEL: func @_QPpass_foo() { subroutine pass_foo() external :: foo - ! CHECK: %[[f:.*]] = constant @_QPfoo + ! CHECK: %[[f:.*]] = fir.address_of(@_QPfoo) ! CHECK: fir.convert %[[f]] : ((!fir.ref>) -> ()) -> (() -> ()) call bar(foo) end subroutine @@ -42,7 +42,7 @@ subroutine call_foo2(i) ! CHECK-LABEL: func @_QPpass_foo2() { subroutine pass_foo2() external :: foo2 - ! CHECK: %[[f:.*]] = constant @_QPfoo2 + ! CHECK: %[[f:.*]] = fir.address_of(@_QPfoo2) ! CHECK: fir.convert %[[f]] : ((!fir.ref>) -> ()) -> (() -> ()) call bar(foo2) end subroutine @@ -68,7 +68,7 @@ subroutine foo3(i) ! CHECK-LABEL: func @_QPpass_foo3() { subroutine pass_foo3() external :: foo3 - ! CHECK: %[[f:.*]] = constant @_QPfoo3 + ! CHECK: %[[f:.*]] = fir.address_of(@_QPfoo3) ! CHECK: fir.convert %[[f]] : ((!fir.ref>) -> ()) -> (() -> ()) call bar(foo3) end subroutine @@ -89,7 +89,7 @@ subroutine call_foo4(i) ! CHECK-LABEL: func @_QPpass_foo4() { subroutine pass_foo4() external :: foo4 - ! CHECK: %[[f:.*]] = constant @_QPfoo4 + ! CHECK: %[[f:.*]] = fir.address_of(@_QPfoo4) ! CHECK: fir.convert %[[f]] : ((!fir.ref>) -> ()) -> (() -> ()) call bar(foo4) end subroutine @@ -103,7 +103,7 @@ subroutine foo5(i) ! CHECK-LABEL: func @_QPpass_foo5() { subroutine pass_foo5() external :: foo5 - ! CHECK: %[[f:.*]] = constant @_QPfoo5 + ! CHECK: %[[f:.*]] = fir.address_of(@_QPfoo5) ! CHECK: fir.convert %[[f]] : ((!fir.ref>) -> ()) -> (() -> ()) call bar(foo5) end subroutine @@ -129,7 +129,7 @@ subroutine call_foo6(i) ! CHECK-LABEL: func @_QPpass_foo6() { subroutine pass_foo6() external :: foo6 - ! CHECK: %[[f:.*]] = constant @_QPfoo6 : (!fir.ref>) -> () + ! CHECK: %[[f:.*]] = fir.address_of(@_QPfoo6) : (!fir.ref>) -> () ! CHECK: fir.convert %[[f]] : ((!fir.ref>) -> ()) -> (() -> ()) call bar(foo6) end subroutine @@ -144,7 +144,7 @@ subroutine pass_foo7() ! CHECK-LABEL: func @_QPcall_foo7(%arg0: !fir.ref>) -> f32 { function call_foo7(i) integer :: i(10) - ! CHECK: %[[f:.*]] = constant @_QPfoo7 : () -> () + ! CHECK: %[[f:.*]] = fir.address_of(@_QPfoo7) : () -> () ! CHECK: %[[funccast:.*]] = fir.convert %[[f]] : (() -> ()) -> ((!fir.ref>) -> f32) ! CHECK: fir.call %[[funccast]](%arg0) : (!fir.ref>) -> f32 call_foo7 = foo7(i) diff --git a/flang/test/Lower/stmt-function.f90 b/flang/test/Lower/stmt-function.f90 index 47f8c934b6c88..7912fbbaeb0b8 100644 --- a/flang/test/Lower/stmt-function.f90 +++ b/flang/test/Lower/stmt-function.f90 @@ -92,7 +92,7 @@ integer function test_stmt_character(c, j) func(argc, argj) = len_trim(argc, 4) + argj !CHECK-DAG: %[[j:.*]] = fir.load %arg1 !CHECK-DAG: %[[c4:.*]] = constant 4 : - !CHECK-DAG: %[[len_trim:.*]] = call @fir.len_trim.i32.bc1.i32(%[[c]], %[[c4]]) + !CHECK-DAG: %[[len_trim:.*]] = fir.call @fir.len_trim.i32.bc1.i32(%[[c]], %[[c4]]) !CHECK: addi %[[len_trim]], %[[j]] test_stmt_character = func(c, j) end function @@ -101,7 +101,7 @@ integer function test_stmt_character(c, j) ! CHECK-LABEL: @_QPbug247 subroutine bug247(r) I(R) = R - ! CHECK: call {{.*}}OutputInteger + ! CHECK: fir.call {{.*}}OutputInteger PRINT *, I(2.5) - ! CHECK: call {{.*}}EndIo + ! CHECK: fir.call {{.*}}EndIo END subroutine bug247 diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index bf8b7f9c859cc..da8ba2bcd3a8a 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -5,6 +5,10 @@ // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// /// /// \file /// This is a tool for translating Fortran sources to the FIR dialect of MLIR. @@ -19,6 +23,7 @@ #include "flang/Lower/Support/Verifier.h" #include "flang/Optimizer/Dialect/FIRDialect.h" #include "flang/Optimizer/OptPasses.h" +#include "flang/Optimizer/Support/FIRContext.h" #include "flang/Optimizer/Support/InternalNames.h" #include "flang/Optimizer/Support/KindMapping.h" #include "flang/Parser/characters.h" @@ -137,7 +142,10 @@ static void printModule(mlir::ModuleOp mlirModule, llvm::raw_ostream &out) { out << '\n'; } -// Convert Fortran input to MLIR (target is FIR dialect) +//===----------------------------------------------------------------------===// +// Translate Fortran input to FIR, a dialect of MLIR. +//===----------------------------------------------------------------------===// + static mlir::LogicalResult convertFortranSourceToMLIR( std::string path, Fortran::parser::Options options, const ProgramName &programPrefix, @@ -211,13 +219,18 @@ static mlir::LogicalResult convertFortranSourceToMLIR( return mlir::failure(); } - // MLIR+FIR + // translate to FIR dialect of MLIR + llvm::Triple triple(fir::determineTargetTriple(targetTriple)); fir::NameUniquer nameUniquer; auto burnside = Fortran::lower::LoweringBridge::create( semanticsContext.defaultKinds(), semanticsContext.intrinsics(), parsing.cooked()); burnside.lower(parseTree, nameUniquer, semanticsContext); mlir::ModuleOp mlirModule = burnside.getModule(); + fir::KindMapping kindMap(mlirModule.getContext()); + fir::setTargetTriple(mlirModule, triple); + fir::setNameUniquer(mlirModule, nameUniquer); + fir::setKindMapping(mlirModule, kindMap); std::error_code ec; std::string outputName = outputFilename; if (!outputName.size()) @@ -308,9 +321,8 @@ int main(int argc, char **argv) { if (includeDirs.size() == 0) includeDirs.push_back("."); - if (!intrinsicModuleDir.empty()) { + if (!intrinsicModuleDir.empty()) includeDirs.insert(includeDirs.begin(), intrinsicModuleDir); - } Fortran::parser::Options options; options.predefinitions.emplace_back("__F18", "1"); diff --git a/flang/tools/tco/tco.cpp b/flang/tools/tco/tco.cpp index 14267a0d4fdb2..6f74fb9efbf8b 100644 --- a/flang/tools/tco/tco.cpp +++ b/flang/tools/tco/tco.cpp @@ -116,6 +116,7 @@ static int compileFIR(const mlir::PassPipelineCLParser &passPipeline) { // pm.addPass(fir::createMemToRegPass()); pm.addPass(fir::createFirCodeGenRewritePass()); + pm.addPass(fir::createFirTargetRewritePass()); pm.addPass(fir::createFIRToLLVMPass(uniquer)); pm.addPass(fir::createLLVMDialectToLLVMPass(out.os())); } diff --git a/flang/unittests/Lower/RTBuilder.cpp b/flang/unittests/Lower/RTBuilder.cpp index b475b5e59ab0e..f68cf9844c9b8 100644 --- a/flang/unittests/Lower/RTBuilder.cpp +++ b/flang/unittests/Lower/RTBuilder.cpp @@ -29,7 +29,7 @@ TEST(RTBuilderTest, ComplexRuntimeInterface) { auto c99_cacosf_funcTy = c99_cacosf_signature.cast(); EXPECT_EQ(c99_cacosf_funcTy.getNumInputs(), 1u); EXPECT_EQ(c99_cacosf_funcTy.getNumResults(), 1u); - auto cplx_ty = fir::CplxType::get(&ctx, 4); + auto cplx_ty = fir::ComplexType::get(&ctx, 4); EXPECT_EQ(c99_cacosf_funcTy.getInput(0), cplx_ty); EXPECT_EQ(c99_cacosf_funcTy.getResult(0), cplx_ty); } diff --git a/mlir/lib/Target/LLVMIR/ModuleTranslation.cpp b/mlir/lib/Target/LLVMIR/ModuleTranslation.cpp index 093a9e62c3c8e..1667838e36e06 100644 --- a/mlir/lib/Target/LLVMIR/ModuleTranslation.cpp +++ b/mlir/lib/Target/LLVMIR/ModuleTranslation.cpp @@ -849,6 +849,24 @@ LogicalResult ModuleTranslation::convertOneFunction(LLVMFuncOp func) { llvm::AttrBuilder().addAlignmentAttr(llvm::Align(attr.getInt()))); } + if (auto attr = func.getArgAttrOfType(argIdx, "llvm.sret")) { + auto argTy = mlirArg.getType().dyn_cast(); + if (!argTy.isPointerTy()) + return func.emitError( + "llvm.sret attribute attached to LLVM non-pointer argument"); + if (attr.getValue()) + llvmArg.addAttr(llvm::Attribute::AttrKind::StructRet); + } + + if (auto attr = func.getArgAttrOfType(argIdx, "llvm.byval")) { + auto argTy = mlirArg.getType().dyn_cast(); + if (!argTy.isPointerTy()) + return func.emitError( + "llvm.byval attribute attached to LLVM non-pointer argument"); + if (attr.getValue()) + llvmArg.addAttr(llvm::Attribute::AttrKind::ByVal); + } + valueMapping[mlirArg] = &llvmArg; argIdx++; } From 6403fed74ad450ffe74a92cfd1612c5a53f7ef9c Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Mon, 31 Aug 2020 13:56:58 -0700 Subject: [PATCH 2/2] disable affine in bbc fix a few bugs --- .../flang/Optimizer/Dialect/FIRDialect.h | 10 ++++------ .../Optimizer/Transforms/RewritePatterns.td | 5 +++-- flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp | 20 +++++++++++-------- flang/lib/Optimizer/Dialect/FIROps.cpp | 2 +- flang/tools/bbc/bbc.cpp | 2 +- 5 files changed, 21 insertions(+), 18 deletions(-) diff --git a/flang/include/flang/Optimizer/Dialect/FIRDialect.h b/flang/include/flang/Optimizer/Dialect/FIRDialect.h index 74cd946ed589b..8d3b7e6b64106 100644 --- a/flang/include/flang/Optimizer/Dialect/FIRDialect.h +++ b/flang/include/flang/Optimizer/Dialect/FIRDialect.h @@ -9,14 +9,14 @@ #ifndef OPTIMIZER_DIALECT_FIRDIALECT_H #define OPTIMIZER_DIALECT_FIRDIALECT_H +#include "mlir/Conversion/Passes.h" +#include "mlir/Dialect/Affine/Passes.h" #include "mlir/IR/Dialect.h" #include "mlir/InitAllDialects.h" #include "mlir/Pass/Pass.h" #include "mlir/Pass/PassRegistry.h" -#include "mlir/Transforms/Passes.h" #include "mlir/Transforms/LocationSnapshot.h" -#include "mlir/Dialect/Affine/Passes.h" -#include "mlir/Conversion/Passes.h" +#include "mlir/Transforms/Passes.h" namespace fir { @@ -81,9 +81,7 @@ inline void registerGeneralPasses() { mlir::registerConvertAffineToStandardPass(); } -inline void registerFIRPasses() { - registerGeneralPasses(); -} +inline void registerFIRPasses() { registerGeneralPasses(); } } // namespace fir diff --git a/flang/include/flang/Optimizer/Transforms/RewritePatterns.td b/flang/include/flang/Optimizer/Transforms/RewritePatterns.td index 97bc1a4ae4638..087c27f9e5f5e 100644 --- a/flang/include/flang/Optimizer/Transforms/RewritePatterns.td +++ b/flang/include/flang/Optimizer/Transforms/RewritePatterns.td @@ -51,8 +51,9 @@ def createConstantOp "rewriter.getIndexAttr($1.dyn_cast().getInt()))">; def ForwardConstantConvertPattern - : Pat<(fir_ConvertOp:$res (ConstantOp $attr)), + : Pat<(fir_ConvertOp:$res (ConstantOp:$cnt $attr)), (createConstantOp $res, $attr), - [(IndexTypePred $res)]>; + [(IndexTypePred $res) + ,(IntegerTypePred $cnt)]>; #endif // FIR_REWRITE_PATTERNS diff --git a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp index 3cf21489f87b9..4d2583fddf2b1 100644 --- a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp +++ b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp @@ -453,7 +453,7 @@ class TargetRewrite : public TargetRewriteBase { if (fnTy.getResults().size() == 1) { mlir::Type ty = fnTy.getResult(0); llvm::TypeSwitch(ty) - .template Case([&](fir::ComplexType cmplx) { + .template Case([&](fir::ComplexType cmplx) { wrap = rewriteCallComplexResultType(cmplx, newResTys, newInTys, newOpers); }) @@ -506,13 +506,16 @@ class TargetRewrite : public TargetRewriteBase { } } }) - .template Case([&](fir::ComplexType cmplx) { + .template Case([&](fir::ComplexType cmplx) { rewriteCallComplexInputType(cmplx, oper, newInTys, newOpers); }) .template Case([&](mlir::ComplexType cmplx) { rewriteCallComplexInputType(cmplx, oper, newInTys, newOpers); }) - .Default([&](mlir::Type ty) { newInTys.push_back(ty); }); + .Default([&](mlir::Type ty) { + newInTys.push_back(ty); + newOpers.push_back(oper); + }); } newInTys.insert(newInTys.end(), trailingInTys.begin(), trailingInTys.end()); newOpers.insert(newOpers.end(), trailingOpers.begin(), trailingOpers.end()); @@ -564,7 +567,7 @@ class TargetRewrite : public TargetRewriteBase { llvm::SmallVector newInTys; for (mlir::Type ty : addrTy.getResults()) { llvm::TypeSwitch(ty) - .Case([&](fir::ComplexType ty) { + .Case([&](fir::ComplexType ty) { lowerComplexSignatureRes(ty, newResTys, newInTys); }) .Case([&](mlir::ComplexType ty) { @@ -587,8 +590,9 @@ class TargetRewrite : public TargetRewriteBase { } } }) - .Case( - [&](fir::ComplexType ty) { lowerComplexSignatureArg(ty, newInTys); }) + .Case([&](fir::ComplexType ty) { + lowerComplexSignatureArg(ty, newInTys); + }) .Case([&](mlir::ComplexType ty) { lowerComplexSignatureArg(ty, newInTys); }) @@ -647,7 +651,7 @@ class TargetRewrite : public TargetRewriteBase { // Convert return value(s) for (auto ty : funcTy.getResults()) llvm::TypeSwitch(ty) - .Case([&](fir::ComplexType cmplx) { + .Case([&](fir::ComplexType cmplx) { if (noComplexConversion) newResTys.push_back(cmplx); else @@ -696,7 +700,7 @@ class TargetRewrite : public TargetRewriteBase { } } }) - .Case([&](fir::ComplexType cmplx) { + .Case([&](fir::ComplexType cmplx) { if (noComplexConversion) newInTys.push_back(cmplx); else diff --git a/flang/lib/Optimizer/Dialect/FIROps.cpp b/flang/lib/Optimizer/Dialect/FIROps.cpp index 8daadc9bd1ba1..78651dbd6650d 100644 --- a/flang/lib/Optimizer/Dialect/FIROps.cpp +++ b/flang/lib/Optimizer/Dialect/FIROps.cpp @@ -999,7 +999,7 @@ static constexpr llvm::StringRef getTargetOffsetAttr() { template static A getSubOperands(unsigned pos, A allArgs, mlir::DenseIntElementsAttr ranges, - AdditionalArgs &&... additionalArgs) { + AdditionalArgs &&...additionalArgs) { unsigned start = 0; for (unsigned i = 0; i < pos; ++i) start += (*(ranges.begin() + i)).getZExtValue(); diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index da8ba2bcd3a8a..c4602ac5dcc84 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -264,7 +264,7 @@ static mlir::LogicalResult convertFortranSourceToMLIR( pm.addPass(std::make_unique()); pm.addPass(mlir::createCanonicalizerPass()); pm.addPass(fir::createCSEPass()); - pm.addPass(fir::createPromoteToAffinePass()); + // pm.addPass(fir::createPromoteToAffinePass()); pm.addPass(fir::createFirToCfgPass()); pm.addPass(fir::createControlFlowLoweringPass()); pm.addPass(mlir::createLowerToCFGPass());