1 //===-- runtime/environment.cpp -------------------------------------------===// 2 // 3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. 4 // See https://llvm.org/LICENSE.txt for license information. 5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception 6 // 7 //===----------------------------------------------------------------------===// 8 9 #include "environment.h" 10 #include "environment-default-list.h" 11 #include "memory.h" 12 #include "tools.h" 13 #include <cstdio> 14 #include <cstdlib> 15 #include <cstring> 16 #include <limits> 17 18 #ifdef _WIN32 19 extern char **_environ; 20 #else 21 extern char **environ; 22 #endif 23 24 namespace Fortran::runtime { 25 26 #ifndef FLANG_RUNTIME_NO_GLOBAL_VAR_DEFS 27 RT_OFFLOAD_VAR_GROUP_BEGIN 28 RT_VAR_ATTRS ExecutionEnvironment executionEnvironment; 29 RT_OFFLOAD_VAR_GROUP_END 30 #endif // FLANG_RUNTIME_NO_GLOBAL_VAR_DEFS 31 32 static void SetEnvironmentDefaults(const EnvironmentDefaultList *envDefaults) { 33 if (!envDefaults) { 34 return; 35 } 36 37 for (int itemIndex = 0; itemIndex < envDefaults->numItems; ++itemIndex) { 38 const char *name = envDefaults->item[itemIndex].name; 39 const char *value = envDefaults->item[itemIndex].value; 40 #ifdef _WIN32 41 if (auto *x{std::getenv(name)}) { 42 continue; 43 } 44 if (_putenv_s(name, value) != 0) { 45 #else 46 if (setenv(name, value, /*overwrite=*/0) == -1) { 47 #endif 48 Fortran::runtime::Terminator{__FILE__, __LINE__}.Crash( 49 std::strerror(errno)); 50 } 51 } 52 } 53 54 RT_OFFLOAD_API_GROUP_BEGIN 55 Fortran::common::optional<Convert> GetConvertFromString( 56 const char *x, std::size_t n) { 57 static const char *keywords[]{ 58 "UNKNOWN", "NATIVE", "LITTLE_ENDIAN", "BIG_ENDIAN", "SWAP", nullptr}; 59 switch (IdentifyValue(x, n, keywords)) { 60 case 0: 61 return Convert::Unknown; 62 case 1: 63 return Convert::Native; 64 case 2: 65 return Convert::LittleEndian; 66 case 3: 67 return Convert::BigEndian; 68 case 4: 69 return Convert::Swap; 70 default: 71 return Fortran::common::nullopt; 72 } 73 } 74 RT_OFFLOAD_API_GROUP_END 75 76 void ExecutionEnvironment::Configure(int ac, const char *av[], 77 const char *env[], const EnvironmentDefaultList *envDefaults) { 78 argc = ac; 79 argv = av; 80 SetEnvironmentDefaults(envDefaults); 81 #ifdef _WIN32 82 envp = _environ; 83 #else 84 envp = environ; 85 #endif 86 listDirectedOutputLineLengthLimit = 79; // PGI default 87 defaultOutputRoundingMode = 88 decimal::FortranRounding::RoundNearest; // RP(==RN) 89 conversion = Convert::Unknown; 90 91 if (auto *x{std::getenv("FORT_FMT_RECL")}) { 92 char *end; 93 auto n{std::strtol(x, &end, 10)}; 94 if (n > 0 && n < std::numeric_limits<int>::max() && *end == '\0') { 95 listDirectedOutputLineLengthLimit = n; 96 } else { 97 std::fprintf( 98 stderr, "Fortran runtime: FORT_FMT_RECL=%s is invalid; ignored\n", x); 99 } 100 } 101 102 if (auto *x{std::getenv("FORT_CONVERT")}) { 103 if (auto convert{GetConvertFromString(x, std::strlen(x))}) { 104 conversion = *convert; 105 } else { 106 std::fprintf( 107 stderr, "Fortran runtime: FORT_CONVERT=%s is invalid; ignored\n", x); 108 } 109 } 110 111 if (auto *x{std::getenv("NO_STOP_MESSAGE")}) { 112 char *end; 113 auto n{std::strtol(x, &end, 10)}; 114 if (n >= 0 && n <= 1 && *end == '\0') { 115 noStopMessage = n != 0; 116 } else { 117 std::fprintf(stderr, 118 "Fortran runtime: NO_STOP_MESSAGE=%s is invalid; ignored\n", x); 119 } 120 } 121 122 if (auto *x{std::getenv("DEFAULT_UTF8")}) { 123 char *end; 124 auto n{std::strtol(x, &end, 10)}; 125 if (n >= 0 && n <= 1 && *end == '\0') { 126 defaultUTF8 = n != 0; 127 } else { 128 std::fprintf( 129 stderr, "Fortran runtime: DEFAULT_UTF8=%s is invalid; ignored\n", x); 130 } 131 } 132 133 if (auto *x{std::getenv("FORT_CHECK_POINTER_DEALLOCATION")}) { 134 char *end; 135 auto n{std::strtol(x, &end, 10)}; 136 if (n >= 0 && n <= 1 && *end == '\0') { 137 checkPointerDeallocation = n != 0; 138 } else { 139 std::fprintf(stderr, 140 "Fortran runtime: FORT_CHECK_POINTER_DEALLOCATION=%s is invalid; " 141 "ignored\n", 142 x); 143 } 144 } 145 146 if (auto *x{std::getenv("ACC_OFFLOAD_STACK_SIZE")}) { 147 char *end; 148 auto n{std::strtoul(x, &end, 10)}; 149 if (n > 0 && n < std::numeric_limits<std::size_t>::max() && *end == '\0') { 150 cudaStackLimit = n; 151 } else { 152 std::fprintf(stderr, 153 "Fortran runtime: ACC_OFFLOAD_STACK_SIZE=%s is invalid; ignored\n", 154 x); 155 } 156 } 157 158 // TODO: Set RP/ROUND='PROCESSOR_DEFINED' from environment 159 } 160 161 const char *ExecutionEnvironment::GetEnv( 162 const char *name, std::size_t name_length, const Terminator &terminator) { 163 RUNTIME_CHECK(terminator, name && name_length); 164 165 OwningPtr<char> cStyleName{ 166 SaveDefaultCharacter(name, name_length, terminator)}; 167 RUNTIME_CHECK(terminator, cStyleName); 168 169 return std::getenv(cStyleName.get()); 170 } 171 } // namespace Fortran::runtime 172