diff options
Diffstat (limited to 'flang/lib/Lower/Bridge.cpp')
| -rw-r--r-- | flang/lib/Lower/Bridge.cpp | 101 |
1 files changed, 66 insertions, 35 deletions
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index f518599125e8..c7e2635230e9 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -11,7 +11,7 @@ //===----------------------------------------------------------------------===// #include "flang/Lower/Bridge.h" -#include "DirectivesCommon.h" + #include "flang/Common/Version.h" #include "flang/Lower/Allocatable.h" #include "flang/Lower/CallInterface.h" @@ -22,6 +22,7 @@ #include "flang/Lower/ConvertType.h" #include "flang/Lower/ConvertVariable.h" #include "flang/Lower/Cuda.h" +#include "flang/Lower/DirectivesCommon.h" #include "flang/Lower/HostAssociations.h" #include "flang/Lower/IO.h" #include "flang/Lower/IterationSpace.h" @@ -56,7 +57,7 @@ #include "flang/Optimizer/Support/InternalNames.h" #include "flang/Optimizer/Transforms/Passes.h" #include "flang/Parser/parse-tree.h" -#include "flang/Runtime/iostat.h" +#include "flang/Runtime/iostat-consts.h" #include "flang/Semantics/runtime-type-info.h" #include "flang/Semantics/symbol.h" #include "flang/Semantics/tools.h" @@ -556,8 +557,8 @@ public: return lookupSymbol(sym).getAddr(); } - fir::ExtendedValue - symBoxToExtendedValue(const Fortran::lower::SymbolBox &symBox) { + fir::ExtendedValue symBoxToExtendedValue( + const Fortran::lower::SymbolBox &symBox) override final { return symBox.match( [](const Fortran::lower::SymbolBox::Intrinsic &box) -> fir::ExtendedValue { return box.getAddr(); }, @@ -711,8 +712,8 @@ public: return bool(shallowLookupSymbol(sym)); } - bool createHostAssociateVarClone( - const Fortran::semantics::Symbol &sym) override final { + bool createHostAssociateVarClone(const Fortran::semantics::Symbol &sym, + bool skipDefaultInit) override final { mlir::Location loc = genLocation(sym.name()); mlir::Type symType = genType(sym); const auto *details = sym.detailsIf<Fortran::semantics::HostAssocDetails>(); @@ -769,13 +770,21 @@ public: // Initialise cloned allocatable hexv.match( [&](const fir::MutableBoxValue &box) -> void { - // Do not process pointers + const auto new_box = exv.getBoxOf<fir::MutableBoxValue>(); if (Fortran::semantics::IsPointer(sym.GetUltimate())) { + // Establish the pointer descriptors. The rank and type code/size + // at least must be set properly for later inquiry of the pointer + // to work, and new pointers are always given disassociated status + // by flang for safety, even if this is not required by the + // language. + auto empty = fir::factory::createUnallocatedBox( + *builder, loc, new_box->getBoxTy(), box.nonDeferredLenParams(), + {}); + builder->create<fir::StoreOp>(loc, empty, new_box->getAddr()); return; } - // Allocate storage for a pointer/allocatble descriptor. - // No shape/lengths to be passed to the alloca. - const auto new_box = exv.getBoxOf<fir::MutableBoxValue>(); + // Copy allocation status of Allocatables, creating new storage if + // needed. // allocate if allocated mlir::Value isAllocated = @@ -823,7 +832,22 @@ public: if_builder.end(); }, [&](const auto &) -> void { - // Do nothing + if (skipDefaultInit) + return; + // Initialize local/private derived types with default + // initialization (Fortran 2023 section 11.1.7.5 and OpenMP 5.2 + // section 5.3). Pointer and allocatable components, when allowed, + // also need to be established so that flang runtime can later work + // with them. + if (const Fortran::semantics::DeclTypeSpec *declTypeSpec = + sym.GetType()) + if (const Fortran::semantics::DerivedTypeSpec *derivedTypeSpec = + declTypeSpec->AsDerived()) + if (derivedTypeSpec->HasDefaultInitialization( + /*ignoreAllocatable=*/false, /*ignorePointer=*/false)) { + mlir::Value box = builder->createBox(loc, exv); + fir::runtime::genDerivedTypeInitialize(*builder, loc, box); + } }); return bindIfNewSymbol(sym, exv); @@ -1004,7 +1028,7 @@ public: fir::FirOpBuilder &getFirOpBuilder() override final { return *builder; } - mlir::ModuleOp &getModuleOp() override final { return bridge.getModule(); } + mlir::ModuleOp getModuleOp() override final { return bridge.getModule(); } mlir::MLIRContext &getMLIRContext() override final { return bridge.getMLIRContext(); @@ -1966,9 +1990,9 @@ private: Fortran::semantics::SemanticsContext &semanticsContext = bridge.getSemanticsContext(); for (const Fortran::semantics::Symbol *sym : info.localSymList) - createHostAssociateVarClone(*sym); + createHostAssociateVarClone(*sym, /*skipDefaultInit=*/false); for (const Fortran::semantics::Symbol *sym : info.localInitSymList) { - createHostAssociateVarClone(*sym); + createHostAssociateVarClone(*sym, /*skipDefaultInit=*/true); const auto *hostDetails = sym->detailsIf<Fortran::semantics::HostAssocDetails>(); assert(hostDetails && "missing locality spec host symbol"); @@ -1986,6 +2010,9 @@ private: sym->detailsIf<Fortran::semantics::HostAssocDetails>(); copySymbolBinding(hostDetails->symbol(), *sym); } + // Note that allocatable, types with ultimate components, and type + // requiring finalization are forbidden in LOCAL/LOCAL_INIT (F2023 C1130), + // so no clean-up needs to be generated for these entities. } /// Generate FIR for a DO construct. There are six variants: @@ -2304,7 +2331,7 @@ private: assert(!incrementLoopNestInfo.empty() && "empty loop nest"); mlir::Location loc = toLocation(); mlir::arith::IntegerOverflowFlags flags{}; - if (getLoweringOptions().getNSWOnLoopVarInc()) + if (!getLoweringOptions().getIntegerWrapAround()) flags = bitEnumSet(flags, mlir::arith::IntegerOverflowFlags::nsw); auto iofAttr = mlir::arith::IntegerOverflowFlagsAttr::get( builder->getContext(), flags); @@ -3011,8 +3038,10 @@ private: fir::getBase(genExprValue(*Fortran::semantics::GetExpr(bounds->upper), stmtCtx)))); if (bounds->step) - steps.push_back(fir::getBase( - genExprValue(*Fortran::semantics::GetExpr(bounds->step), stmtCtx))); + steps.push_back(builder->createConvert( + crtLoc, idxTy, + fir::getBase(genExprValue( + *Fortran::semantics::GetExpr(bounds->step), stmtCtx)))); else // If `step` is not present, assume it is `1`. steps.push_back(builder->createIntegerConstant(loc, idxTy, 1)); @@ -3085,7 +3114,7 @@ private: } /// Generate FIR for a SELECT CASE statement. - /// The selector may have CHARACTER, INTEGER, or LOGICAL type. + /// The selector may have CHARACTER, INTEGER, UNSIGNED, or LOGICAL type. void genFIR(const Fortran::parser::SelectCaseStmt &stmt) { Fortran::lower::pft::Evaluation &eval = getEval(); Fortran::lower::pft::Evaluation *parentConstruct = eval.parentConstruct; @@ -3121,6 +3150,10 @@ private: selector = builder->createConvert(loc, builder->getI1Type(), selector); } mlir::Type selectType = selector.getType(); + if (selectType.isUnsignedInteger()) + selectType = mlir::IntegerType::get( + builder->getContext(), selectType.getIntOrFloatBitWidth(), + mlir::IntegerType::SignednessSemantics::Signless); llvm::SmallVector<mlir::Attribute> attrList; llvm::SmallVector<mlir::Value> valueList; llvm::SmallVector<mlir::Block *> blockList; @@ -3134,9 +3167,10 @@ private: else if (isLogicalSelector) valueList.push_back(builder->createConvert( loc, selectType, createFIRExpr(toLocation(), expr, stmtCtx))); - else + else { valueList.push_back(builder->createIntegerConstant( loc, selectType, *Fortran::evaluate::ToInt64(*expr))); + } }; for (Fortran::lower::pft::Evaluation *e = eval.controlSuccessor; e; e = e->controlSuccessor) { @@ -4433,7 +4467,8 @@ private: // lowered. const bool isWholeAllocatableAssignment = !userDefinedAssignment && !isInsideHlfirWhere() && - Fortran::lower::isWholeAllocatable(assign.lhs); + Fortran::lower::isWholeAllocatable(assign.lhs) && + bridge.getLoweringOptions().getReallocateLHS(); const bool isUserDefAssignToPointerOrAllocatable = userDefinedAssignment && firstDummyIsPointerOrAllocatable(*userDefinedAssignment); @@ -6102,10 +6137,7 @@ void Fortran::lower::LoweringBridge::lower( } void Fortran::lower::LoweringBridge::parseSourceFile(llvm::SourceMgr &srcMgr) { - mlir::OwningOpRef<mlir::ModuleOp> owningRef = - mlir::parseSourceFile<mlir::ModuleOp>(srcMgr, &context); - module.reset(new mlir::ModuleOp(owningRef.get().getOperation())); - owningRef.release(); + module = mlir::parseSourceFile<mlir::ModuleOp>(srcMgr, &context); } Fortran::lower::LoweringBridge::LoweringBridge( @@ -6172,19 +6204,18 @@ Fortran::lower::LoweringBridge::LoweringBridge( }; // Create the module and attach the attributes. - module = std::make_unique<mlir::ModuleOp>( + module = mlir::OwningOpRef<mlir::ModuleOp>( mlir::ModuleOp::create(getPathLocation())); - assert(module.get() && "module was not created"); - fir::setTargetTriple(*module.get(), triple); - fir::setKindMapping(*module.get(), kindMap); - fir::setTargetCPU(*module.get(), targetMachine.getTargetCPU()); - fir::setTuneCPU(*module.get(), targetOpts.cpuToTuneFor); - fir::setTargetFeatures(*module.get(), targetMachine.getTargetFeatureString()); - fir::support::setMLIRDataLayout(*module.get(), - targetMachine.createDataLayout()); - fir::setIdent(*module.get(), Fortran::common::getFlangFullVersion()); + assert(*module && "module was not created"); + fir::setTargetTriple(*module, triple); + fir::setKindMapping(*module, kindMap); + fir::setTargetCPU(*module, targetMachine.getTargetCPU()); + fir::setTuneCPU(*module, targetOpts.cpuToTuneFor); + fir::setTargetFeatures(*module, targetMachine.getTargetFeatureString()); + fir::support::setMLIRDataLayout(*module, targetMachine.createDataLayout()); + fir::setIdent(*module, Fortran::common::getFlangFullVersion()); if (cgOpts.RecordCommandLine) - fir::setCommandline(*module.get(), *cgOpts.RecordCommandLine); + fir::setCommandline(*module, *cgOpts.RecordCommandLine); } void Fortran::lower::genCleanUpInRegionIfAny( |