jpenix-quic updated this revision to Diff 461753. jpenix-quic added a comment.
Address comments from @awarzynski, @rovka, and @peixin. Also fixed the file header comments for EnvironmentDefaults.h, environment-defaults.h, and environment-default-list.h to match others in their respective folders. CHANGES SINCE LAST ACTION https://reviews.llvm.org/D130513/new/ https://reviews.llvm.org/D130513 Files: clang/include/clang/Driver/Options.td clang/lib/Driver/ToolChains/Flang.cpp flang/examples/external-hello.cpp flang/include/flang/Frontend/FrontendOptions.h flang/include/flang/Lower/Bridge.h flang/include/flang/Optimizer/Builder/Runtime/EnvironmentDefaults.h flang/include/flang/Runtime/environment-defaults.h flang/include/flang/Runtime/main.h flang/lib/Frontend/CompilerInvocation.cpp flang/lib/Frontend/FrontendActions.cpp flang/lib/Lower/Bridge.cpp flang/lib/Optimizer/Builder/CMakeLists.txt flang/lib/Optimizer/Builder/Runtime/EnvironmentDefaults.cpp flang/runtime/FortranMain/Fortran_main.c flang/runtime/environment-default-list.h flang/runtime/environment.cpp flang/runtime/environment.h flang/runtime/main.cpp flang/test/Driver/convert.f90 flang/test/Driver/driver-help-hidden.f90 flang/test/Driver/driver-help.f90 flang/test/Driver/emit-mlir.f90 flang/test/Driver/frontend-forwarding.f90 flang/test/Lower/convert.f90 flang/test/Lower/environment-defaults.f90 flang/test/Runtime/no-cpp-dep.c flang/tools/bbc/bbc.cpp flang/unittests/Runtime/CommandTest.cpp flang/unittests/Runtime/Stop.cpp
Index: flang/unittests/Runtime/Stop.cpp =================================================================== --- flang/unittests/Runtime/Stop.cpp +++ flang/unittests/Runtime/Stop.cpp @@ -26,7 +26,8 @@ TEST(TestProgramEnd, StopTestNoStopMessage) { putenv(const_cast<char *>("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, NoStopMessageTest) { putenv(const_cast<char *>("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), Index: flang/unittests/Runtime/CommandTest.cpp =================================================================== --- flang/unittests/Runtime/CommandTest.cpp +++ flang/unittests/Runtime/CommandTest.cpp @@ -49,7 +49,7 @@ 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 { Index: flang/tools/bbc/bbc.cpp =================================================================== --- flang/tools/bbc/bbc.cpp +++ flang/tools/bbc/bbc.cpp @@ -222,7 +222,7 @@ 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; Index: flang/test/Runtime/no-cpp-dep.c =================================================================== --- flang/test/Runtime/no-cpp-dep.c +++ flang/test/Runtime/no-cpp-dep.c @@ -16,18 +16,20 @@ 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; Index: flang/test/Lower/environment-defaults.f90 =================================================================== --- /dev/null +++ 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<tuple<i[[int_size:.*]], !fir.ref<!fir.array<0xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>> { +! CHECK: %[[VAL_0:.*]] = fir.zero_bits !fir.ref<tuple<i[[int_size]], !fir.ref<!fir.array<0xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>> +! CHECK: fir.has_value %[[VAL_0]] : !fir.ref<tuple<i[[int_size]], !fir.ref<!fir.array<0xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>> Index: flang/test/Lower/convert.f90 =================================================================== --- /dev/null +++ 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=<value> 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<i8>, !fir.ref<i8>>> { +! ALL: %[[VAL_0:.*]] = fir.undefined !fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>> +! ALL: %[[VAL_1:.*]] = fir.address_of(@[[FC_STR:.*]]) : !fir.ref<!fir.char<1,13>> +! ALL: %[[VAL_3:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.char<1,13>>) -> !fir.ref<i8> +! ALL: %[[VAL_4:.*]] = fir.insert_value %[[VAL_0]], %[[VAL_3]], [0 : index, 0 : index] : (!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>, !fir.ref<i8>) -> !fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>> +! ALL: %[[VAL_5:.*]] = fir.address_of(@[[OPT_STR:.*]]) : !fir.ref<!fir.char<1,[[OPT_STR_LEN:.*]]>> +! ALL: %[[VAL_7:.*]] = fir.convert %[[VAL_5]] : (!fir.ref<!fir.char<1,[[OPT_STR_LEN]]>>) -> !fir.ref<i8> +! ALL: %[[VAL_8:.*]] = fir.insert_value %[[VAL_4]], %[[VAL_7]], [0 : index, 1 : index] : (!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>, !fir.ref<i8>) -> !fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>> +! ALL: fir.has_value %[[VAL_8]] : !fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>> + +! 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<i[[int_size:.*]], !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>>> { +! ALL: %[[VAL_0:.*]] = fir.undefined tuple<i[[int_size]], !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>>> +! ALL: %[[VAL_1:.*]] = arith.constant 1 : i[[int_size]] +! ALL: %[[VAL_2:.*]] = fir.insert_value %[[VAL_0]], %[[VAL_1]], [0 : index] : (tuple<i[[int_size]], !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>, i[[int_size]]) -> tuple<i[[int_size]], !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>>> +! ALL: %[[VAL_3:.*]] = fir.address_of(@_QQEnvironmentDefaults.items) : !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>> +! ALL: %[[VAL_4:.*]] = fir.insert_value %[[VAL_2]], %[[VAL_3]], [1 : index] : (tuple<i[[int_size]], !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>, !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>>) -> tuple<i[[int_size]], !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>>> +! ALL: fir.has_value %[[VAL_4]] : tuple<i[[int_size]], !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>>> + +! ALL: fir.global @_QQEnvironmentDefaults constant : !fir.ref<tuple<i[[int_size]], !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>> { +! ALL: %[[VAL_0:.*]] = fir.address_of(@_QQEnvironmentDefaults.list) : !fir.ref<tuple<i[[int_size]], !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>> +! ALL: fir.has_value %[[VAL_0]] : !fir.ref<tuple<i[[int_size]], !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>> Index: flang/test/Driver/frontend-forwarding.f90 =================================================================== --- flang/test/Driver/frontend-forwarding.f90 +++ 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" Index: flang/test/Driver/emit-mlir.f90 =================================================================== --- flang/test/Driver/emit-mlir.f90 +++ 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<tuple<i[[int_size:.*]], !fir.ref<!fir.array<0xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>> { +! CHECK-NEXT: %[[VAL_0:.*]] = fir.zero_bits !fir.ref<tuple<i[[int_size]], !fir.ref<!fir.array<0xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>> +! CHECK-NEXT: fir.has_value %[[VAL_0]] : !fir.ref<tuple<i[[int_size]], !fir.ref<!fir.array<0xtuple<!fir.ref<i8>, !fir.ref<i8>>>>>> +! CHECK-NEXT: } ! CHECK-NEXT: } end program Index: flang/test/Driver/driver-help.f90 =================================================================== --- flang/test/Driver/driver-help.f90 +++ 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=<value> 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=<value> 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) Index: flang/test/Driver/driver-help-hidden.f90 =================================================================== --- flang/test/Driver/driver-help-hidden.f90 +++ 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=<value> 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 Index: flang/test/Driver/convert.f90 =================================================================== --- /dev/null +++ flang/test/Driver/convert.f90 @@ -0,0 +1,29 @@ +! Ensure argument -fconvert=<value> 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' Index: flang/runtime/main.cpp =================================================================== --- flang/runtime/main.cpp +++ flang/runtime/main.cpp @@ -27,9 +27,11 @@ } 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(). } Index: flang/runtime/environment.h =================================================================== --- flang/runtime/environment.h +++ flang/runtime/environment.h @@ -12,6 +12,8 @@ #include "flang/Decimal/decimal.h" #include <optional> +struct EnvironmentDefaultList; + namespace Fortran::runtime { class Terminator; @@ -31,13 +33,14 @@ 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{ Index: flang/runtime/environment.cpp =================================================================== --- flang/runtime/environment.cpp +++ flang/runtime/environment.cpp @@ -7,6 +7,7 @@ //===----------------------------------------------------------------------===// #include "environment.h" +#include "environment-default-list.h" #include "memory.h" #include "tools.h" #include <cstdio> @@ -14,10 +15,38 @@ #include <cstring> #include <limits> +#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, 0) == -1) { +#endif + Fortran::runtime::Terminator{__FILE__, __LINE__}.Crash( + std::strerror(errno)); + } + } +} + std::optional<Convert> GetConvertFromString(const char *x, std::size_t n) { static const char *keywords[]{ "UNKNOWN", "NATIVE", "LITTLE_ENDIAN", "BIG_ENDIAN", "SWAP", nullptr}; @@ -37,11 +66,16 @@ } } -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) Index: flang/runtime/environment-default-list.h =================================================================== --- /dev/null +++ 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_ */ Index: flang/runtime/FortranMain/Fortran_main.c =================================================================== --- flang/runtime/FortranMain/Fortran_main.c +++ 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; Index: flang/lib/Optimizer/Builder/Runtime/EnvironmentDefaults.cpp =================================================================== --- /dev/null +++ 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/Optimizer/Builder/BoxValue.h" +#include "flang/Optimizer/Builder/FIRBuilder.h" +#include "flang/Optimizer/Support/InternalNames.h" +#include "flang/Runtime/environment-defaults.h" +#include "llvm/ADT/ArrayRef.h" + +void fir::runtime::genEnvironmentDefaults( + fir::FirOpBuilder &builder, mlir::Location loc, + const std::vector<Fortran::runtime::EnvironmentDefault> &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<fir::HasValueOp>(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<fir::UndefOp>(loc, itemListTy); + llvm::SmallVector<mlir::Attribute, 2> idx = {mlir::Attribute{}, + mlir::Attribute{}}; + auto insertStringField = [&](const std::string &s, + llvm::ArrayRef<mlir::Attribute> idx) { + mlir::Value stringAddress = fir::getBase( + fir::factory::createStringLiteral(builder, loc, s + '\0')); + mlir::Value addr = builder.createConvert(loc, charRefTy, stringAddress); + return builder.create<fir::InsertValueOp>(loc, itemListTy, list, addr, + builder.getArrayAttr(idx)); + }; + + size_t n = 0; + for (const Fortran::runtime::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<fir::HasValueOp>(loc, list); + }; + builder.createGlobalConstant(loc, itemListTy, itemListName, listBuilder, + linkOnce); + + // Define the EnviornmentDefaultList object. + auto envDefaultListBuilder = [&](fir::FirOpBuilder &builder) { + mlir::Value envDefaultList = + builder.create<fir::UndefOp>(loc, envDefaultListTy); + mlir::Value numItems = + builder.createIntegerConstant(loc, intTy, envDefaults.size()); + envDefaultList = builder.create<fir::InsertValueOp>( + loc, envDefaultListTy, envDefaultList, numItems, + builder.getArrayAttr(zero)); + fir::GlobalOp itemList = builder.getNamedGlobal(itemListName); + assert(itemList && "missing environment default list"); + mlir::Value listAddr = builder.create<fir::AddrOfOp>( + loc, itemList.resultType(), itemList.getSymbol()); + envDefaultList = builder.create<fir::InsertValueOp>( + loc, envDefaultListTy, envDefaultList, listAddr, + builder.getArrayAttr(one)); + builder.create<fir::HasValueOp>(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<fir::AddrOfOp>( + loc, envDefaultList.resultType(), envDefaultList.getSymbol()); + builder.create<fir::HasValueOp>(loc, addr); + }); +} Index: flang/lib/Optimizer/Builder/CMakeLists.txt =================================================================== --- flang/lib/Optimizer/Builder/CMakeLists.txt +++ flang/lib/Optimizer/Builder/CMakeLists.txt @@ -12,6 +12,7 @@ Runtime/Character.cpp Runtime/Command.cpp Runtime/Derived.cpp + Runtime/EnvironmentDefaults.cpp Runtime/Inquiry.cpp Runtime/Numeric.cpp Runtime/Ragged.cpp Index: flang/lib/Lower/Bridge.cpp =================================================================== --- flang/lib/Lower/Bridge.cpp +++ 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 @@ // - 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 @@ /// 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. @@ -3342,11 +3362,12 @@ 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<Fortran::runtime::EnvironmentDefault> &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(); Index: flang/lib/Frontend/FrontendActions.cpp =================================================================== --- flang/lib/Frontend/FrontendActions.cpp +++ flang/lib/Frontend/FrontendActions.cpp @@ -149,7 +149,8 @@ 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()}; Index: flang/lib/Frontend/CompilerInvocation.cpp =================================================================== --- flang/lib/Frontend/CompilerInvocation.cpp +++ flang/lib/Frontend/CompilerInvocation.cpp @@ -180,6 +180,17 @@ opts.needProvenanceRangeToCharBlockMappings = true; } +/// Parse the argument specified for the -fconvert=<value> option +static std::optional<const char *> parseConvertArg(const char *s) { + return llvm::StringSwitch<std::optional<const char *>>(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 @@ } } + // Set conversion based on -fconvert=<value> + 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, Index: flang/include/flang/Runtime/main.h =================================================================== --- flang/include/flang/Runtime/main.h +++ 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 Index: flang/include/flang/Runtime/environment-defaults.h =================================================================== --- /dev/null +++ flang/include/flang/Runtime/environment-defaults.h @@ -0,0 +1,23 @@ +//===-- include/flang/Runtime/environment-defaults.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_DEFAULTS_H_ +#define FORTRAN_RUNTIME_ENVIRONMENT_DEFAULTS_H_ + +#include <string> + +namespace Fortran::runtime { + +struct EnvironmentDefault { + std::string varName; + std::string defaultValue; +}; + +} // namespace Fortran::runtime + +#endif // FORTRAN_RUNTIME_ENVIRONMENT_DEFAULTS_H_ Index: flang/include/flang/Optimizer/Builder/Runtime/EnvironmentDefaults.h =================================================================== --- /dev/null +++ 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 +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_OPTIMIZER_BUILDER_RUNTIME_ENVIRONMENTDEFAULTS_H +#define FORTRAN_OPTIMIZER_BUILDER_RUNTIME_ENVIRONMENTDEFAULTS_H + +#include <vector> + +// 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. + +namespace fir { +class FirOpBuilder; +} // namespace fir + +namespace mlir { +class Location; +} // namespace mlir + +namespace Fortran::runtime { +struct EnvironmentDefault; +} // namespace Fortran::runtime + +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<Fortran::runtime::EnvironmentDefault> &envDefaults); + +} // namespace fir::runtime +#endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_ENVIRONMENTDEFAULTS_H Index: flang/include/flang/Lower/Bridge.h =================================================================== --- flang/include/flang/Lower/Bridge.h +++ flang/include/flang/Lower/Bridge.h @@ -18,6 +18,7 @@ #include "flang/Lower/LoweringOptions.h" #include "flang/Optimizer/Builder/FIRBuilder.h" #include "flang/Optimizer/Support/KindMapping.h" +#include "flang/Runtime/environment-defaults.h" #include "mlir/IR/BuiltinOps.h" namespace Fortran { @@ -55,10 +56,11 @@ 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<Fortran::runtime::EnvironmentDefault> &envDefaults) { return LoweringBridge(ctx, semanticsContext, defaultKinds, intrinsics, targetCharacteristics, allCooked, triple, kindMap, - loweringOptions); + loweringOptions, envDefaults); } //===--------------------------------------------------------------------===// @@ -91,6 +93,11 @@ return loweringOptions; } + const std::vector<Fortran::runtime::EnvironmentDefault> & + getEnvironmentDefaults() const { + return envDefaults; + } + /// Create a folding context. Careful: this is very expensive. Fortran::evaluate::FoldingContext createFoldingContext() const; @@ -121,7 +128,8 @@ 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<Fortran::runtime::EnvironmentDefault> &envDefaults); LoweringBridge() = delete; LoweringBridge(const LoweringBridge &) = delete; @@ -134,6 +142,7 @@ std::unique_ptr<mlir::ModuleOp> module; fir::KindMapping &kindMap; const Fortran::lower::LoweringOptions &loweringOptions; + const std::vector<Fortran::runtime::EnvironmentDefault> &envDefaults; }; } // namespace lower Index: flang/include/flang/Frontend/FrontendOptions.h =================================================================== --- flang/include/flang/Frontend/FrontendOptions.h +++ flang/include/flang/Frontend/FrontendOptions.h @@ -16,6 +16,7 @@ #include "flang/Common/Fortran-features.h" #include "flang/Parser/characters.h" #include "flang/Parser/unparse.h" +#include "flang/Runtime/environment-defaults.h" #include "llvm/ADT/StringRef.h" #include "llvm/Support/MemoryBuffer.h" #include <cstdint> @@ -258,6 +259,9 @@ // 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<Fortran::runtime::EnvironmentDefault> envDefaults; + // The column after which characters are ignored in fixed form lines in the // source file. int fixedFormColumns = 72; Index: flang/examples/external-hello.cpp =================================================================== --- flang/examples/external-hello.cpp +++ flang/examples/external-hello.cpp @@ -42,7 +42,7 @@ } 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)(); Index: clang/lib/Driver/ToolChains/Flang.cpp =================================================================== --- clang/lib/Driver/ToolChains/Flang.cpp +++ clang/lib/Driver/ToolChains/Flang.cpp @@ -55,7 +55,8 @@ 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 { Index: clang/include/clang/Driver/Options.td =================================================================== --- clang/include/clang/Driver/Options.td +++ clang/include/clang/Driver/Options.td @@ -4817,7 +4817,6 @@ def fblas_matmul_limit_EQ : Joined<["-"], "fblas-matmul-limit=">, Group<gfortran_Group>; def fcheck_EQ : Joined<["-"], "fcheck=">, Group<gfortran_Group>; def fcoarray_EQ : Joined<["-"], "fcoarray=">, Group<gfortran_Group>; -def fconvert_EQ : Joined<["-"], "fconvert=">, Group<gfortran_Group>; def ffpe_trap_EQ : Joined<["-"], "ffpe-trap=">, Group<gfortran_Group>; def ffree_line_length_VALUE : Joined<["-"], "ffree-line-length-">, Group<gfortran_Group>; def finit_character_EQ : Joined<["-"], "finit-character=">, Group<gfortran_Group>; @@ -4918,6 +4917,8 @@ 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<f_Group>, Alias<ffixed_line_length_EQ>; +def fconvert_EQ : Joined<["-"], "fconvert=">, Group<f_Group>, + HelpText<"Set endian conversion of data for unformatted files">; def fopenacc : Flag<["-"], "fopenacc">, Group<f_Group>, HelpText<"Enable OpenACC">; def fdefault_double_8 : Flag<["-"],"fdefault-double-8">, Group<f_Group>,
_______________________________________________ cfe-commits mailing list cfe-commits@lists.llvm.org https://lists.llvm.org/cgi-bin/mailman/listinfo/cfe-commits