From 0ec3ac9b7fbd15698af7289e1214e8ff3d82ec14 Mon Sep 17 00:00:00 2001 From: Jonathon Penix Date: Tue, 19 Jul 2022 11:47:25 -0700 Subject: [PATCH] [Flang] Add -fconvert option to swap endianness for unformatted files. To accomplish this, this patch creates an optional list of environment variable default values to be set by the runtime to allow directly using the existing runtime implementation of FORT_CONVERT for I/O conversions. --- clang/include/clang/Driver/Options.td | 3 +- clang/lib/Driver/ToolChains/Flang.cpp | 3 +- flang/examples/external-hello.cpp | 2 +- flang/include/flang/Frontend/FrontendOptions.h | 4 + flang/include/flang/Lower/Bridge.h | 15 ++- flang/include/flang/Lower/EnvironmentDefault.h | 23 +++++ .../Builder/Runtime/EnvironmentDefaults.h | 45 +++++++++ flang/include/flang/Runtime/main.h | 5 +- flang/lib/Frontend/CompilerInvocation.cpp | 22 +++++ flang/lib/Frontend/FrontendActions.cpp | 3 +- flang/lib/Lower/Bridge.cpp | 25 ++++- flang/lib/Optimizer/Builder/CMakeLists.txt | 1 + .../Builder/Runtime/EnvironmentDefaults.cpp | 109 +++++++++++++++++++++ flang/runtime/FortranMain/Fortran_main.c | 4 +- flang/runtime/environment-default-list.h | 31 ++++++ flang/runtime/environment.cpp | 40 +++++++- flang/runtime/environment.h | 7 +- flang/runtime/main.cpp | 6 +- flang/test/Driver/convert.f90 | 29 ++++++ flang/test/Driver/driver-help-hidden.f90 | 1 + flang/test/Driver/driver-help.f90 | 2 + flang/test/Driver/emit-mlir.f90 | 4 + flang/test/Driver/frontend-forwarding.f90 | 2 + flang/test/Lower/convert.f90 | 46 +++++++++ flang/test/Lower/environment-defaults.f90 | 12 +++ flang/test/Runtime/no-cpp-dep.c | 6 +- flang/tools/bbc/bbc.cpp | 2 +- flang/unittests/Runtime/CommandTest.cpp | 2 +- flang/unittests/Runtime/Stop.cpp | 6 +- 29 files changed, 436 insertions(+), 24 deletions(-) create mode 100755 flang/include/flang/Lower/EnvironmentDefault.h create mode 100755 flang/include/flang/Optimizer/Builder/Runtime/EnvironmentDefaults.h create mode 100755 flang/lib/Optimizer/Builder/Runtime/EnvironmentDefaults.cpp create mode 100755 flang/runtime/environment-default-list.h create mode 100755 flang/test/Driver/convert.f90 create mode 100755 flang/test/Lower/convert.f90 create mode 100755 flang/test/Lower/environment-defaults.f90 diff --git a/clang/include/clang/Driver/Options.td b/clang/include/clang/Driver/Options.td index 05f4f5f..49a75ce 100644 --- a/clang/include/clang/Driver/Options.td +++ b/clang/include/clang/Driver/Options.td @@ -4837,7 +4837,6 @@ def static_libgfortran : Flag<["-"], "static-libgfortran">, Group, Group; def finit_character_EQ : Joined<["-"], "finit-character=">, Group; @@ -4938,6 +4937,8 @@ def ffixed_line_length_EQ : Joined<["-"], "ffixed-line-length=">, Group DocBrief<[{Set column after which characters are ignored in typical fixed-form lines in the source file}]>; def ffixed_line_length_VALUE : Joined<["-"], "ffixed-line-length-">, Group, Alias; +def fconvert_EQ : Joined<["-"], "fconvert=">, Group, + HelpText<"Set endian conversion of data for unformatted files">; def fopenacc : Flag<["-"], "fopenacc">, Group, HelpText<"Enable OpenACC">; def fdefault_double_8 : Flag<["-"],"fdefault-double-8">, Group, diff --git a/clang/lib/Driver/ToolChains/Flang.cpp b/clang/lib/Driver/ToolChains/Flang.cpp index b279529..d7ac459 100644 --- a/clang/lib/Driver/ToolChains/Flang.cpp +++ b/clang/lib/Driver/ToolChains/Flang.cpp @@ -55,7 +55,8 @@ void Flang::AddOtherOptions(const ArgList &Args, ArgStringList &CmdArgs) const { Args.AddAllArgs(CmdArgs, {options::OPT_module_dir, options::OPT_fdebug_module_writer, options::OPT_fintrinsic_modules_path, options::OPT_pedantic, - options::OPT_std_EQ, options::OPT_W_Joined}); + options::OPT_std_EQ, options::OPT_W_Joined, + options::OPT_fconvert_EQ}); } void Flang::AddPicOptions(const ArgList &Args, ArgStringList &CmdArgs) const { diff --git a/flang/examples/external-hello.cpp b/flang/examples/external-hello.cpp index f06126d..4991bf9 100644 --- a/flang/examples/external-hello.cpp +++ b/flang/examples/external-hello.cpp @@ -42,7 +42,7 @@ void input1() { } int main(int argc, const char *argv[], const char *envp[]) { - RTNAME(ProgramStart)(argc, argv, envp); + RTNAME(ProgramStart)(argc, argv, envp, nullptr); output1(); input1(); RTNAME(PauseStatement)(); diff --git a/flang/include/flang/Frontend/FrontendOptions.h b/flang/include/flang/Frontend/FrontendOptions.h index 96c4b67..f24741b 100644 --- a/flang/include/flang/Frontend/FrontendOptions.h +++ b/flang/include/flang/Frontend/FrontendOptions.h @@ -14,6 +14,7 @@ #define FORTRAN_FRONTEND_FRONTENDOPTIONS_H #include "flang/Common/Fortran-features.h" +#include "flang/Lower/EnvironmentDefault.h" #include "flang/Parser/characters.h" #include "flang/Parser/unparse.h" #include "llvm/ADT/StringRef.h" @@ -258,6 +259,9 @@ struct FrontendOptions { // The form to process files in, if specified. FortranForm fortranForm = FortranForm::Unknown; + // Default values for environment variables to be set by the runtime. + std::vector envDefaults; + // The column after which characters are ignored in fixed form lines in the // source file. int fixedFormColumns = 72; diff --git a/flang/include/flang/Lower/Bridge.h b/flang/include/flang/Lower/Bridge.h index dcc61bf..dabbe72 100644 --- a/flang/include/flang/Lower/Bridge.h +++ b/flang/include/flang/Lower/Bridge.h @@ -15,6 +15,7 @@ #include "flang/Common/Fortran.h" #include "flang/Lower/AbstractConverter.h" +#include "flang/Lower/EnvironmentDefault.h" #include "flang/Lower/LoweringOptions.h" #include "flang/Optimizer/Builder/FIRBuilder.h" #include "flang/Optimizer/Support/KindMapping.h" @@ -55,10 +56,11 @@ public: const Fortran::evaluate::TargetCharacteristics &targetCharacteristics, const Fortran::parser::AllCookedSources &allCooked, llvm::StringRef triple, fir::KindMapping &kindMap, - const Fortran::lower::LoweringOptions &loweringOptions) { + const Fortran::lower::LoweringOptions &loweringOptions, + const std::vector &envDefaults) { return LoweringBridge(ctx, semanticsContext, defaultKinds, intrinsics, targetCharacteristics, allCooked, triple, kindMap, - loweringOptions); + loweringOptions, envDefaults); } //===--------------------------------------------------------------------===// @@ -91,6 +93,11 @@ public: return loweringOptions; } + const std::vector & + getEnvironmentDefaults() const { + return envDefaults; + } + /// Create a folding context. Careful: this is very expensive. Fortran::evaluate::FoldingContext createFoldingContext() const; @@ -121,7 +128,8 @@ private: const Fortran::evaluate::TargetCharacteristics &targetCharacteristics, const Fortran::parser::AllCookedSources &cooked, llvm::StringRef triple, fir::KindMapping &kindMap, - const Fortran::lower::LoweringOptions &loweringOptions); + const Fortran::lower::LoweringOptions &loweringOptions, + const std::vector &envDefaults); LoweringBridge() = delete; LoweringBridge(const LoweringBridge &) = delete; @@ -134,6 +142,7 @@ private: std::unique_ptr module; fir::KindMapping &kindMap; const Fortran::lower::LoweringOptions &loweringOptions; + const std::vector &envDefaults; }; } // namespace lower diff --git a/flang/include/flang/Lower/EnvironmentDefault.h b/flang/include/flang/Lower/EnvironmentDefault.h new file mode 100755 index 0000000..0010af2 --- /dev/null +++ b/flang/include/flang/Lower/EnvironmentDefault.h @@ -0,0 +1,23 @@ +//===-- Lower/EnvironmentDefault.h ------------------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_LOWER_ENVIRONMENTDEFAULT_H +#define FORTRAN_LOWER_ENVIRONMENTDEFAULT_H + +#include + +namespace Fortran::lower { + +struct EnvironmentDefault { + std::string varName; + std::string defaultValue; +}; + +} // namespace Fortran::lower + +#endif // FORTRAN_LOWER_ENVIRONMENTDEFAULT_H diff --git a/flang/include/flang/Optimizer/Builder/Runtime/EnvironmentDefaults.h b/flang/include/flang/Optimizer/Builder/Runtime/EnvironmentDefaults.h new file mode 100755 index 0000000..18a24ba --- /dev/null +++ b/flang/include/flang/Optimizer/Builder/Runtime/EnvironmentDefaults.h @@ -0,0 +1,45 @@ +//===-- EnvironmentDefaults.h -----------------------------------*- 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 +// +//===----------------------------------------------------------------------===// + +// EnvironmentDefaults is a list of default values for environment variables +// that may be specified at compile time and set by the runtime during +// program startup if the variable is not already present in the environment. +// EnvironmentDefaults is intended to allow options controlled by environment +// variables to also be set on the command line at compile time without needing +// to define option-specific runtime calls or duplicate logic within the +// runtime. For example, the -fconvert command line option is implemented in +// terms of an default value for the FORT_CONVERT environment variable. + +#ifndef FORTRAN_OPTIMIZER_BUILDER_RUNTIME_ENVIRONMENTDEFAULTS_H +#define FORTRAN_OPTIMIZER_BUILDER_RUNTIME_ENVIRONMENTDEFAULTS_H + +#include + +namespace fir { +class FirOpBuilder; +} // namespace fir + +namespace mlir { +class Location; +} // namespace mlir + +namespace Fortran::lower { +struct EnvironmentDefault; +} // namespace Fortran::lower + +namespace fir::runtime { + +/// Create the list of environment variable defaults for the runtime to set. The +/// form of the generated list is defined in the runtime header file +/// environment-default-list.h +void genEnvironmentDefaults( + fir::FirOpBuilder &builder, mlir::Location loc, + const std::vector &envDefaults); + +} // namespace fir::runtime +#endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_ENVIRONMENTDEFAULTS_H diff --git a/flang/include/flang/Runtime/main.h b/flang/include/flang/Runtime/main.h index e3dcbaf..88232ea 100644 --- a/flang/include/flang/Runtime/main.h +++ b/flang/include/flang/Runtime/main.h @@ -12,8 +12,11 @@ #include "flang/Runtime/c-or-cpp.h" #include "flang/Runtime/entry-names.h" +struct EnvironmentDefaultList; + FORTRAN_EXTERN_C_BEGIN -void RTNAME(ProgramStart)(int, const char *[], const char *[]); +void RTNAME(ProgramStart)( + int, const char *[], const char *[], const struct EnvironmentDefaultList *); void RTNAME(ByteswapOption)(void); // -byteswapio FORTRAN_EXTERN_C_END diff --git a/flang/lib/Frontend/CompilerInvocation.cpp b/flang/lib/Frontend/CompilerInvocation.cpp index 0ad63b0..c182418 100644 --- a/flang/lib/Frontend/CompilerInvocation.cpp +++ b/flang/lib/Frontend/CompilerInvocation.cpp @@ -180,6 +180,17 @@ static void setUpFrontendBasedOnAction(FrontendOptions &opts) { opts.needProvenanceRangeToCharBlockMappings = true; } +/// Parse the argument specified for the -fconvert= option +static std::optional parseConvertArg(const char *s) { + return llvm::StringSwitch>(s) + .Case("unknown", "UNKNOWN") + .Case("native", "NATIVE") + .Case("little-endian", "LITTLE_ENDIAN") + .Case("big-endian", "BIG_ENDIAN") + .Case("swap", "SWAP") + .Default(std::nullopt); +} + static bool parseFrontendArgs(FrontendOptions &opts, llvm::opt::ArgList &args, clang::DiagnosticsEngine &diags) { unsigned numErrorsBefore = diags.getNumErrors(); @@ -399,6 +410,17 @@ static bool parseFrontendArgs(FrontendOptions &opts, llvm::opt::ArgList &args, } } + // Set conversion based on -fconvert= + if (const auto *arg = + args.getLastArg(clang::driver::options::OPT_fconvert_EQ)) { + const char *argValue = arg->getValue(); + if (auto convert = parseConvertArg(argValue)) + opts.envDefaults.push_back({"FORT_CONVERT", *convert}); + else + diags.Report(clang::diag::err_drv_invalid_value) + << arg->getAsString(args) << argValue; + } + // -f{no-}implicit-none opts.features.Enable( Fortran::common::LanguageFeature::ImplicitNoneTypeAlways, diff --git a/flang/lib/Frontend/FrontendActions.cpp b/flang/lib/Frontend/FrontendActions.cpp index be91a79..dfd2089 100644 --- a/flang/lib/Frontend/FrontendActions.cpp +++ b/flang/lib/Frontend/FrontendActions.cpp @@ -149,7 +149,8 @@ bool CodeGenAction::beginSourceFileAction() { ci.getInvocation().getSemanticsContext().intrinsics(), ci.getInvocation().getSemanticsContext().targetCharacteristics(), ci.getParsing().allCooked(), ci.getInvocation().getTargetOpts().triple, - kindMap, ci.getInvocation().getLoweringOpts()); + kindMap, ci.getInvocation().getLoweringOpts(), + ci.getInvocation().getFrontendOpts().envDefaults); // Create a parse tree and lower it to FIR Fortran::parser::Program &parseTree{*ci.getParsing().parseTree()}; diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index bd1bddc..b40dfd4 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -31,6 +31,7 @@ #include "flang/Optimizer/Builder/Character.h" #include "flang/Optimizer/Builder/FIRBuilder.h" #include "flang/Optimizer/Builder/Runtime/Character.h" +#include "flang/Optimizer/Builder/Runtime/EnvironmentDefaults.h" #include "flang/Optimizer/Builder/Runtime/Ragged.h" #include "flang/Optimizer/Builder/Todo.h" #include "flang/Optimizer/Dialect/FIRAttr.h" @@ -223,9 +224,12 @@ public: // - Define module variables and OpenMP/OpenACC declarative construct so // that they are available before lowering any function that may use // them. + bool hasMainProgram = false; for (Fortran::lower::pft::Program::Units &u : pft.getUnits()) { std::visit(Fortran::common::visitors{ [&](Fortran::lower::pft::FunctionLikeUnit &f) { + if (f.isMainProgram()) + hasMainProgram = true; declareFunction(f); }, [&](Fortran::lower::pft::ModuleLikeUnit &m) { @@ -262,6 +266,22 @@ public: /// processed. createGlobalOutsideOfFunctionLowering( [&]() { runtimeTypeInfoConverter.createTypeInfoGlobals(*this); }); + + // Create the list of any environment defaults for the runtime to set. The + // runtime default list is only created if there is a main program to ensure + // it only happens once and to provide consistent results if multiple files + // are compiled separately. + if (hasMainProgram) + createGlobalOutsideOfFunctionLowering([&]() { + // FIXME: Ideally, this would create a call to a runtime function + // accepting the list of environment defaults. That way, we would not + // need to add an extern pointer to the runtime and said pointer would + // not need to be generated even if no defaults are specified. + // However, generating main or changing when the runtime reads + // environment variables is required to do so. + fir::runtime::genEnvironmentDefaults(*builder, toLocation(), + bridge.getEnvironmentDefaults()); + }); } /// Declare a function. @@ -3347,11 +3367,12 @@ Fortran::lower::LoweringBridge::LoweringBridge( const Fortran::evaluate::TargetCharacteristics &targetCharacteristics, const Fortran::parser::AllCookedSources &cooked, llvm::StringRef triple, fir::KindMapping &kindMap, - const Fortran::lower::LoweringOptions &loweringOptions) + const Fortran::lower::LoweringOptions &loweringOptions, + const std::vector &envDefaults) : semanticsContext{semanticsContext}, defaultKinds{defaultKinds}, intrinsics{intrinsics}, targetCharacteristics{targetCharacteristics}, cooked{&cooked}, context{context}, kindMap{kindMap}, - loweringOptions{loweringOptions} { + loweringOptions{loweringOptions}, envDefaults{envDefaults} { // Register the diagnostic handler. context.getDiagEngine().registerHandler([](mlir::Diagnostic &diag) { llvm::raw_ostream &os = llvm::errs(); diff --git a/flang/lib/Optimizer/Builder/CMakeLists.txt b/flang/lib/Optimizer/Builder/CMakeLists.txt index 779256b..5f59ed3 100644 --- a/flang/lib/Optimizer/Builder/CMakeLists.txt +++ b/flang/lib/Optimizer/Builder/CMakeLists.txt @@ -12,6 +12,7 @@ add_flang_library(FIRBuilder Runtime/Character.cpp Runtime/Command.cpp Runtime/Derived.cpp + Runtime/EnvironmentDefaults.cpp Runtime/Inquiry.cpp Runtime/Numeric.cpp Runtime/Ragged.cpp diff --git a/flang/lib/Optimizer/Builder/Runtime/EnvironmentDefaults.cpp b/flang/lib/Optimizer/Builder/Runtime/EnvironmentDefaults.cpp new file mode 100755 index 0000000..a11b933 --- /dev/null +++ b/flang/lib/Optimizer/Builder/Runtime/EnvironmentDefaults.cpp @@ -0,0 +1,109 @@ +//===-- EnvironmentDefaults.cpp -------------------------------------------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#include "flang/Optimizer/Builder/Runtime/EnvironmentDefaults.h" +#include "flang/Lower/EnvironmentDefault.h" +#include "flang/Optimizer/Builder/BoxValue.h" +#include "flang/Optimizer/Builder/FIRBuilder.h" +#include "flang/Optimizer/Support/InternalNames.h" +#include "llvm/ADT/ArrayRef.h" + +void fir::runtime::genEnvironmentDefaults( + fir::FirOpBuilder &builder, mlir::Location loc, + const std::vector &envDefaults) { + std::string envDefaultListPtrName = + fir::NameUniquer::doGenerated("EnvironmentDefaults"); + + mlir::MLIRContext *context = builder.getContext(); + mlir::StringAttr linkOnce = builder.createLinkOnceLinkage(); + mlir::IntegerType intTy = builder.getIntegerType(8 * sizeof(int)); + fir::ReferenceType charRefTy = + fir::ReferenceType::get(builder.getIntegerType(8)); + fir::SequenceType itemListTy = fir::SequenceType::get( + envDefaults.size(), + mlir::TupleType::get(context, {charRefTy, charRefTy})); + mlir::TupleType envDefaultListTy = mlir::TupleType::get( + context, {intTy, fir::ReferenceType::get(itemListTy)}); + fir::ReferenceType envDefaultListRefTy = + fir::ReferenceType::get(envDefaultListTy); + + // If no defaults were specified, initialize with a null pointer. + if (envDefaults.empty()) { + builder.createGlobalConstant( + loc, envDefaultListRefTy, envDefaultListPtrName, + [&](fir::FirOpBuilder &builder) { + mlir::Value nullVal = + builder.createNullConstant(loc, envDefaultListRefTy); + builder.create(loc, nullVal); + }); + return; + } + + // Create the Item list. + mlir::IndexType idxTy = builder.getIndexType(); + mlir::IntegerAttr zero = builder.getIntegerAttr(idxTy, 0); + mlir::IntegerAttr one = builder.getIntegerAttr(idxTy, 1); + std::string itemListName = envDefaultListPtrName + ".items"; + auto listBuilder = [&](fir::FirOpBuilder &builder) { + mlir::Value list = builder.create(loc, itemListTy); + llvm::SmallVector idx = {mlir::Attribute{}, + mlir::Attribute{}}; + auto insertStringField = [&](const std::string &s, + llvm::ArrayRef idx) { + mlir::Value stringAddress = fir::getBase( + fir::factory::createStringLiteral(builder, loc, s + '\0')); + mlir::Value addr = builder.createConvert(loc, charRefTy, stringAddress); + return builder.create(loc, itemListTy, list, addr, + builder.getArrayAttr(idx)); + }; + + size_t n = 0; + for (const Fortran::lower::EnvironmentDefault &def : envDefaults) { + idx[0] = builder.getIntegerAttr(idxTy, n); + idx[1] = zero; + list = insertStringField(def.varName, idx); + idx[1] = one; + list = insertStringField(def.defaultValue, idx); + ++n; + } + builder.create(loc, list); + }; + builder.createGlobalConstant(loc, itemListTy, itemListName, listBuilder, + linkOnce); + + // Define the EnviornmentDefaultList object. + auto envDefaultListBuilder = [&](fir::FirOpBuilder &builder) { + mlir::Value envDefaultList = + builder.create(loc, envDefaultListTy); + mlir::Value numItems = + builder.createIntegerConstant(loc, intTy, envDefaults.size()); + envDefaultList = builder.create( + loc, envDefaultListTy, envDefaultList, numItems, + builder.getArrayAttr(zero)); + fir::GlobalOp itemList = builder.getNamedGlobal(itemListName); + assert(itemList && "missing environment default list"); + mlir::Value listAddr = builder.create( + loc, itemList.resultType(), itemList.getSymbol()); + envDefaultList = builder.create( + loc, envDefaultListTy, envDefaultList, listAddr, + builder.getArrayAttr(one)); + builder.create(loc, envDefaultList); + }; + fir::GlobalOp envDefaultList = builder.createGlobalConstant( + loc, envDefaultListTy, envDefaultListPtrName + ".list", + envDefaultListBuilder, linkOnce); + + // Define the pointer to the list used by the runtime. + builder.createGlobalConstant( + loc, envDefaultListRefTy, envDefaultListPtrName, + [&](fir::FirOpBuilder &builder) { + mlir::Value addr = builder.create( + loc, envDefaultList.resultType(), envDefaultList.getSymbol()); + builder.create(loc, addr); + }); +} diff --git a/flang/runtime/FortranMain/Fortran_main.c b/flang/runtime/FortranMain/Fortran_main.c index 0c26a9d..5d3eace 100644 --- a/flang/runtime/FortranMain/Fortran_main.c +++ b/flang/runtime/FortranMain/Fortran_main.c @@ -12,9 +12,11 @@ /* main entry into PROGRAM */ void _QQmain(void); +extern const struct EnvironmentDefaultList *_QQEnvironmentDefaults; + /* C main stub */ int main(int argc, const char *argv[], const char *envp[]) { - RTNAME(ProgramStart)(argc, argv, envp); + RTNAME(ProgramStart)(argc, argv, envp, _QQEnvironmentDefaults); _QQmain(); RTNAME(ProgramEndStatement)(); return 0; diff --git a/flang/runtime/environment-default-list.h b/flang/runtime/environment-default-list.h new file mode 100755 index 0000000..4da261b --- /dev/null +++ b/flang/runtime/environment-default-list.h @@ -0,0 +1,31 @@ +/*===-- runtime/environment-default-list.h --------------------------*- C -*-=== + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + * ===-----------------------------------------------------------------------=== + */ + +#ifndef FORTRAN_RUNTIME_ENVIRONMENT_DEFAULT_LIST_H_ +#define FORTRAN_RUNTIME_ENVIRONMENT_DEFAULT_LIST_H_ + +/* Try to maintain C compatibility to make it easier to both define environment + * defaults in non-Fortran main programs as well as pass through the environment + * default list in C code. + */ + +struct EnvironmentDefaultItem { + const char *name; + const char *value; +}; + +/* Default values for environment variables are packaged by lowering into an + * instance of this struct to be read and set by the runtime. + */ +struct EnvironmentDefaultList { + int numItems; + const struct EnvironmentDefaultItem *item; +}; + +#endif /* FORTRAN_RUNTIME_ENVIRONMENT_DEFAULT_LIST_H_ */ diff --git a/flang/runtime/environment.cpp b/flang/runtime/environment.cpp index 7ecbdce..62d9ee2 100644 --- a/flang/runtime/environment.cpp +++ b/flang/runtime/environment.cpp @@ -7,6 +7,7 @@ //===----------------------------------------------------------------------===// #include "environment.h" +#include "environment-default-list.h" #include "memory.h" #include "tools.h" #include @@ -14,10 +15,38 @@ #include #include +#ifdef _WIN32 +extern char **_environ; +#else +extern char **environ; +#endif + namespace Fortran::runtime { ExecutionEnvironment executionEnvironment; +static void SetEnvironmentDefaults(const EnvironmentDefaultList *envDefaults) { + if (!envDefaults) { + return; + } + + for (int itemIndex = 0; itemIndex < envDefaults->numItems; ++itemIndex) { + const char *name = envDefaults->item[itemIndex].name; + const char *value = envDefaults->item[itemIndex].value; +#ifdef _WIN32 + if (auto *x{std::getenv(name)}) { + continue; + } + if (_putenv_s(name, value) != 0) { +#else + if (setenv(name, value, /*overwrite=*/0) == -1) { +#endif + Fortran::runtime::Terminator{__FILE__, __LINE__}.Crash( + std::strerror(errno)); + } + } +} + std::optional GetConvertFromString(const char *x, std::size_t n) { static const char *keywords[]{ "UNKNOWN", "NATIVE", "LITTLE_ENDIAN", "BIG_ENDIAN", "SWAP", nullptr}; @@ -37,11 +66,16 @@ std::optional GetConvertFromString(const char *x, std::size_t n) { } } -void ExecutionEnvironment::Configure( - int ac, const char *av[], const char *env[]) { +void ExecutionEnvironment::Configure(int ac, const char *av[], + const char *env[], const EnvironmentDefaultList *envDefaults) { argc = ac; argv = av; - envp = env; + SetEnvironmentDefaults(envDefaults); +#ifdef _WIN32 + envp = _environ; +#else + envp = environ; +#endif listDirectedOutputLineLengthLimit = 79; // PGI default defaultOutputRoundingMode = decimal::FortranRounding::RoundNearest; // RP(==RN) diff --git a/flang/runtime/environment.h b/flang/runtime/environment.h index b6223a8..82a5ec8 100644 --- a/flang/runtime/environment.h +++ b/flang/runtime/environment.h @@ -12,6 +12,8 @@ #include "flang/Decimal/decimal.h" #include +struct EnvironmentDefaultList; + namespace Fortran::runtime { class Terminator; @@ -31,13 +33,14 @@ std::optional GetConvertFromString(const char *, std::size_t); struct ExecutionEnvironment { constexpr ExecutionEnvironment(){}; - void Configure(int argc, const char *argv[], const char *envp[]); + void Configure(int argc, const char *argv[], const char *envp[], + const EnvironmentDefaultList *envDefaults); const char *GetEnv( const char *name, std::size_t name_length, const Terminator &terminator); int argc{0}; const char **argv{nullptr}; - const char **envp{nullptr}; + char **envp{nullptr}; int listDirectedOutputLineLengthLimit{79}; // FORT_FMT_RECL enum decimal::FortranRounding defaultOutputRoundingMode{ diff --git a/flang/runtime/main.cpp b/flang/runtime/main.cpp index 56a4709..9645498 100644 --- a/flang/runtime/main.cpp +++ b/flang/runtime/main.cpp @@ -27,9 +27,11 @@ static void ConfigureFloatingPoint() { } extern "C" { -void RTNAME(ProgramStart)(int argc, const char *argv[], const char *envp[]) { +void RTNAME(ProgramStart)(int argc, const char *argv[], const char *envp[], + const EnvironmentDefaultList *envDefaults) { std::atexit(Fortran::runtime::NotifyOtherImagesOfNormalEnd); - Fortran::runtime::executionEnvironment.Configure(argc, argv, envp); + Fortran::runtime::executionEnvironment.Configure( + argc, argv, envp, envDefaults); ConfigureFloatingPoint(); // I/O is initialized on demand so that it works for non-Fortran main(). } diff --git a/flang/test/Driver/convert.f90 b/flang/test/Driver/convert.f90 new file mode 100755 index 0000000..b2cf6c2 --- /dev/null +++ b/flang/test/Driver/convert.f90 @@ -0,0 +1,29 @@ +! Ensure argument -fconvert= accepts all relevant options and produces an +! error if an invalid value is specified. + +!-------------------------- +! FLANG DRIVER (flang) +!-------------------------- +! RUN: %flang -### -fconvert=unknown %s 2>&1 | FileCheck %s --check-prefix=VALID +! RUN: %flang -### -fconvert=native %s 2>&1 | FileCheck %s --check-prefix=VALID +! RUN: %flang -### -fconvert=little-endian %s 2>&1 | FileCheck %s --check-prefix=VALID +! RUN: %flang -### -fconvert=big-endian %s 2>&1 | FileCheck %s --check-prefix=VALID +! RUN: %flang -### -fconvert=swap %s 2>&1 | FileCheck %s --check-prefix=VALID +! RUN: not %flang -fconvert=foobar %s 2>&1 | FileCheck %s --check-prefix=INVALID + +!----------------------------------------- +! FRONTEND FLANG DRIVER (flang-new -fc1) +!----------------------------------------- +! RUN: %flang_fc1 -emit-mlir -fconvert=unknown %s -o - | FileCheck %s --check-prefix=VALID_FC1 +! RUN: %flang_fc1 -emit-mlir -fconvert=native %s -o - | FileCheck %s --check-prefix=VALID_FC1 +! RUN: %flang_fc1 -emit-mlir -fconvert=little-endian %s -o - | FileCheck %s --check-prefix=VALID_FC1 +! RUN: %flang_fc1 -emit-mlir -fconvert=big-endian %s -o - | FileCheck %s --check-prefix=VALID_FC1 +! RUN: %flang_fc1 -emit-mlir -fconvert=swap %s -o - | FileCheck %s --check-prefix=VALID_FC1 +! RUN: not %flang_fc1 -fconvert=foobar %s 2>&1 | FileCheck %s --check-prefix=INVALID + +! Only test that the command executes without error. Correct handling of each +! option is handled in Lowering tests. +! VALID: -fconvert +! VALID_FC1: module + +! INVALID: error: invalid value 'foobar' in '-fconvert=foobar' diff --git a/flang/test/Driver/driver-help-hidden.f90 b/flang/test/Driver/driver-help-hidden.f90 index 8261620..e6309bb 100644 --- a/flang/test/Driver/driver-help-hidden.f90 +++ b/flang/test/Driver/driver-help-hidden.f90 @@ -24,6 +24,7 @@ ! CHECK-NEXT: Enable the old style PARAMETER statement ! CHECK-NEXT: -fbackslash Specify that backslash in string introduces an escape character ! CHECK-NEXT: -fcolor-diagnostics Enable colors in diagnostics +! CHECK-NEXT: -fconvert= Set endian conversion of data for unformatted files ! CHECK-NEXT: -fdefault-double-8 Set the default double precision kind to an 8 byte wide type ! CHECK-NEXT: -fdefault-integer-8 Set the default integer kind to an 8 byte wide type ! CHECK-NEXT: -fdefault-real-8 Set the default real kind to an 8 byte wide type diff --git a/flang/test/Driver/driver-help.f90 b/flang/test/Driver/driver-help.f90 index 99201e0..daddd25 100644 --- a/flang/test/Driver/driver-help.f90 +++ b/flang/test/Driver/driver-help.f90 @@ -24,6 +24,7 @@ ! HELP-NEXT: Enable the old style PARAMETER statement ! HELP-NEXT: -fbackslash Specify that backslash in string introduces an escape character ! HELP-NEXT: -fcolor-diagnostics Enable colors in diagnostics +! HELP-NEXT: -fconvert= Set endian conversion of data for unformatted files ! HELP-NEXT: -fdefault-double-8 Set the default double precision kind to an 8 byte wide type ! HELP-NEXT: -fdefault-integer-8 Set the default integer kind to an 8 byte wide type ! HELP-NEXT: -fdefault-real-8 Set the default real kind to an 8 byte wide type @@ -79,6 +80,7 @@ ! HELP-FC1-NEXT: Enable the old style PARAMETER statement ! HELP-FC1-NEXT: -fbackslash Specify that backslash in string introduces an escape character ! HELP-FC1-NEXT: -fcolor-diagnostics Enable colors in diagnostics +! HELP-FC1-NEXT: -fconvert= Set endian conversion of data for unformatted files ! HELP-FC1-NEXT: -fdebug-dump-all Dump symbols and the parse tree after the semantic checks ! HELP-FC1-NEXT: -fdebug-dump-parse-tree-no-sema ! HELP-FC1-NEXT: Dump the parse tree (skips the semantic checks) diff --git a/flang/test/Driver/emit-mlir.f90 b/flang/test/Driver/emit-mlir.f90 index 5392f0c..9391195 100644 --- a/flang/test/Driver/emit-mlir.f90 +++ b/flang/test/Driver/emit-mlir.f90 @@ -13,6 +13,10 @@ ! CHECK-LABEL: func @_QQmain() { ! CHECK-NEXT: return ! CHECK-NEXT: } +! CHECK-NEXT: fir.global @_QQEnvironmentDefaults constant : !fir.ref, !fir.ref>>>>> { +! CHECK-NEXT: %[[VAL_0:.*]] = fir.zero_bits !fir.ref, !fir.ref>>>>> +! CHECK-NEXT: fir.has_value %[[VAL_0]] : !fir.ref, !fir.ref>>>>> +! CHECK-NEXT: } ! CHECK-NEXT: } end program diff --git a/flang/test/Driver/frontend-forwarding.f90 b/flang/test/Driver/frontend-forwarding.f90 index 14d7985..7d8243d 100644 --- a/flang/test/Driver/frontend-forwarding.f90 +++ b/flang/test/Driver/frontend-forwarding.f90 @@ -7,6 +7,7 @@ ! RUN: -fdefault-integer-8 \ ! RUN: -fdefault-real-8 \ ! RUN: -flarge-sizes \ +! RUN: -fconvert=little-endian \ ! RUN: -mllvm -print-before-all\ ! RUN: -P \ ! RUN: | FileCheck %s @@ -17,4 +18,5 @@ ! CHECK: "-fdefault-integer-8" ! CHECK: "-fdefault-real-8" ! CHECK: "-flarge-sizes" +! CHECK: "-fconvert=little-endian" ! CHECK: "-mllvm" "-print-before-all" diff --git a/flang/test/Lower/convert.f90 b/flang/test/Lower/convert.f90 new file mode 100755 index 0000000..1ab93dc --- /dev/null +++ b/flang/test/Lower/convert.f90 @@ -0,0 +1,46 @@ +! RUN: %flang_fc1 -emit-fir -fconvert=unknown %s -o - | FileCheck %s --check-prefixes=ALL,UNKNOWN +! RUN: %flang_fc1 -emit-fir -fconvert=native %s -o - | FileCheck %s --check-prefixes=ALL,NATIVE +! RUN: %flang_fc1 -emit-fir -fconvert=little-endian %s -o - | FileCheck %s --check-prefixes=ALL,LITTLE_ENDIAN +! RUN: %flang_fc1 -emit-fir -fconvert=big-endian %s -o - | FileCheck %s --check-prefixes=ALL,BIG_ENDIAN +! RUN: %flang_fc1 -emit-fir -fconvert=swap %s -o - | FileCheck %s --check-prefixes=ALL,SWAP + +program test + continue +end + +! Try to test that -fconvert= flag results in a environment default list +! with the FORT_CONVERT option correctly specified. + +! ALL: fir.global linkonce @_QQEnvironmentDefaults.items constant : !fir.array<1xtuple, !fir.ref>> { +! ALL: %[[VAL_0:.*]] = fir.undefined !fir.array<1xtuple, !fir.ref>> +! ALL: %[[VAL_1:.*]] = fir.address_of(@[[FC_STR:.*]]) : !fir.ref> +! ALL: %[[VAL_3:.*]] = fir.convert %[[VAL_1]] : (!fir.ref>) -> !fir.ref +! ALL: %[[VAL_4:.*]] = fir.insert_value %[[VAL_0]], %[[VAL_3]], [0 : index, 0 : index] : (!fir.array<1xtuple, !fir.ref>>, !fir.ref) -> !fir.array<1xtuple, !fir.ref>> +! ALL: %[[VAL_5:.*]] = fir.address_of(@[[OPT_STR:.*]]) : !fir.ref> +! ALL: %[[VAL_7:.*]] = fir.convert %[[VAL_5]] : (!fir.ref>) -> !fir.ref +! ALL: %[[VAL_8:.*]] = fir.insert_value %[[VAL_4]], %[[VAL_7]], [0 : index, 1 : index] : (!fir.array<1xtuple, !fir.ref>>, !fir.ref) -> !fir.array<1xtuple, !fir.ref>> +! ALL: fir.has_value %[[VAL_8]] : !fir.array<1xtuple, !fir.ref>> + +! ALL: fir.global linkonce @[[FC_STR]] constant : !fir.char<1,13> { +! ALL: %[[VAL_0:.*]] = fir.string_lit "FORT_CONVERT\00"(13) : !fir.char<1,13> +! ALL: fir.has_value %[[VAL_0]] : !fir.char<1,13> + +! ALL: fir.global linkonce @[[OPT_STR]] constant : !fir.char<1,[[OPT_STR_LEN]]> { +! UNKNOWN: %[[VAL_0:.*]] = fir.string_lit "UNKNOWN\00"([[OPT_STR_LEN]]) : !fir.char<1,[[OPT_STR_LEN]]> +! NATIVE: %[[VAL_0:.*]] = fir.string_lit "NATIVE\00"([[OPT_STR_LEN]]) : !fir.char<1,[[OPT_STR_LEN]]> +! LITTLE_ENDIAN: %[[VAL_0:.*]] = fir.string_lit "LITTLE_ENDIAN\00"([[OPT_STR_LEN]]) : !fir.char<1,[[OPT_STR_LEN]]> +! BIG_ENDIAN: %[[VAL_0:.*]] = fir.string_lit "BIG_ENDIAN\00"([[OPT_STR_LEN]]) : !fir.char<1,[[OPT_STR_LEN]]> +! SWAP: %[[VAL_0:.*]] = fir.string_lit "SWAP\00"([[OPT_STR_LEN]]) : !fir.char<1,[[OPT_STR_LEN]]> +! ALL: fir.has_value %[[VAL_0]] : !fir.char<1,[[OPT_STR_LEN]]> + +! ALL: fir.global linkonce @_QQEnvironmentDefaults.list constant : tuple, !fir.ref>>>> { +! ALL: %[[VAL_0:.*]] = fir.undefined tuple, !fir.ref>>>> +! ALL: %[[VAL_1:.*]] = arith.constant 1 : i[[int_size]] +! ALL: %[[VAL_2:.*]] = fir.insert_value %[[VAL_0]], %[[VAL_1]], [0 : index] : (tuple, !fir.ref>>>>, i[[int_size]]) -> tuple, !fir.ref>>>> +! ALL: %[[VAL_3:.*]] = fir.address_of(@_QQEnvironmentDefaults.items) : !fir.ref, !fir.ref>>> +! ALL: %[[VAL_4:.*]] = fir.insert_value %[[VAL_2]], %[[VAL_3]], [1 : index] : (tuple, !fir.ref>>>>, !fir.ref, !fir.ref>>>) -> tuple, !fir.ref>>>> +! ALL: fir.has_value %[[VAL_4]] : tuple, !fir.ref>>>> + +! ALL: fir.global @_QQEnvironmentDefaults constant : !fir.ref, !fir.ref>>>>> { +! ALL: %[[VAL_0:.*]] = fir.address_of(@_QQEnvironmentDefaults.list) : !fir.ref, !fir.ref>>>>> +! ALL: fir.has_value %[[VAL_0]] : !fir.ref, !fir.ref>>>>> diff --git a/flang/test/Lower/environment-defaults.f90 b/flang/test/Lower/environment-defaults.f90 new file mode 100755 index 0000000..700f758 --- /dev/null +++ b/flang/test/Lower/environment-defaults.f90 @@ -0,0 +1,12 @@ +! RUN: %flang_fc1 -emit-fir %s -o - | FileCheck %s +! RUN: bbc -emit-fir -o - %s | FileCheck %s + +program test + continue +end + +! Test that a null pointer is generated for environment defaults if nothing is specified + +! CHECK: fir.global @_QQEnvironmentDefaults constant : !fir.ref, !fir.ref>>>>> { +! CHECK: %[[VAL_0:.*]] = fir.zero_bits !fir.ref, !fir.ref>>>>> +! CHECK: fir.has_value %[[VAL_0]] : !fir.ref, !fir.ref>>>>> diff --git a/flang/test/Runtime/no-cpp-dep.c b/flang/test/Runtime/no-cpp-dep.c index 2598516..74ab77f 100644 --- a/flang/test/Runtime/no-cpp-dep.c +++ b/flang/test/Runtime/no-cpp-dep.c @@ -16,18 +16,20 @@ Manually add declarations for the runtime functions that we want to make sure we're testing. We can't include any headers directly since they likely contain C++ code that would explode here. */ +struct EnvironmentDefaultList; struct Descriptor; double RTNAME(CpuTime)(); -void RTNAME(ProgramStart)(int, const char *[], const char *[]); +void RTNAME(ProgramStart)( + int, const char *[], const char *[], const struct EnvironmentDefaultList *); int32_t RTNAME(ArgumentCount)(); int32_t RTNAME(GetCommandArgument)(int32_t, const struct Descriptor *, const struct Descriptor *, const struct Descriptor *); int main() { double x = RTNAME(CpuTime)(); - RTNAME(ProgramStart)(0, 0, 0); + RTNAME(ProgramStart)(0, 0, 0, 0); int32_t c = RTNAME(ArgumentCount)(); int32_t v = RTNAME(GetCommandArgument)(0, 0, 0, 0); return x + c + v; diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index 5e84edd..bd40c9a 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -230,7 +230,7 @@ static mlir::LogicalResult convertFortranSourceToMLIR( auto burnside = Fortran::lower::LoweringBridge::create( ctx, semanticsContext, defKinds, semanticsContext.intrinsics(), semanticsContext.targetCharacteristics(), parsing.allCooked(), "", - kindMap, loweringOptions); + kindMap, loweringOptions, {}); burnside.lower(parseTree, semanticsContext); mlir::ModuleOp mlirModule = burnside.getModule(); std::error_code ec; diff --git a/flang/unittests/Runtime/CommandTest.cpp b/flang/unittests/Runtime/CommandTest.cpp index b44679c..eeb5f96 100644 --- a/flang/unittests/Runtime/CommandTest.cpp +++ b/flang/unittests/Runtime/CommandTest.cpp @@ -49,7 +49,7 @@ static OwningPtr EmptyIntDescriptor() { class CommandFixture : public ::testing::Test { protected: CommandFixture(int argc, const char *argv[]) { - RTNAME(ProgramStart)(argc, argv, {}); + RTNAME(ProgramStart)(argc, argv, {}, {}); } std::string GetPaddedStr(const char *text, std::size_t len) const { diff --git a/flang/unittests/Runtime/Stop.cpp b/flang/unittests/Runtime/Stop.cpp index 9d962bf..b13602ea 100644 --- a/flang/unittests/Runtime/Stop.cpp +++ b/flang/unittests/Runtime/Stop.cpp @@ -26,7 +26,8 @@ TEST(TestProgramEnd, StopTest) { TEST(TestProgramEnd, StopTestNoStopMessage) { putenv(const_cast("NO_STOP_MESSAGE=1")); - Fortran::runtime::executionEnvironment.Configure(0, nullptr, nullptr); + Fortran::runtime::executionEnvironment.Configure( + 0, nullptr, nullptr, nullptr); EXPECT_EXIT( RTNAME(StopStatement)(), testing::ExitedWithCode(EXIT_SUCCESS), ""); } @@ -52,7 +53,8 @@ TEST(TestProgramEnd, StopMessageTest) { TEST(TestProgramEnd, NoStopMessageTest) { putenv(const_cast("NO_STOP_MESSAGE=1")); - Fortran::runtime::executionEnvironment.Configure(0, nullptr, nullptr); + Fortran::runtime::executionEnvironment.Configure( + 0, nullptr, nullptr, nullptr); static const char *message{"bye bye"}; EXPECT_EXIT(RTNAME(StopStatementText)(message, std::strlen(message), /*isErrorStop=*/false, /*quiet=*/false), -- 2.7.4