337 lines · cpp
1//===-- lib/runtime/environment.cpp -----------------------------*- C++ -*-===//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-exception6//7//===----------------------------------------------------------------------===//8 9#include "flang-rt/runtime/environment.h"10#include "environment-default-list.h"11#include "memory.h"12#include "flang-rt/runtime/tools.h"13#include <cstdio>14#include <cstdlib>15#include <cstring>16#include <limits>17 18#ifdef _WIN3219extern char **_environ;20#elif defined(__FreeBSD__)21// FreeBSD has environ in crt rather than libc. Using "extern char** environ"22// in the code of a shared library makes it fail to link with -Wl,--no-undefined23// See https://reviews.freebsd.org/D30842#84064224#else25extern char **environ;26#endif27 28namespace Fortran::runtime {29 30#ifndef FLANG_RUNTIME_NO_GLOBAL_VAR_DEFS31RT_OFFLOAD_VAR_GROUP_BEGIN32RT_VAR_ATTRS ExecutionEnvironment executionEnvironment;33RT_OFFLOAD_VAR_GROUP_END34#endif // FLANG_RUNTIME_NO_GLOBAL_VAR_DEFS35 36// Optional callback routines to be invoked pre and post execution37// environment setup.38// RTNAME(RegisterConfigureEnv) will return true if callback function(s)39// is(are) successfully added to small array of pointers. False if more40// than nConfigEnvCallback registrations for either pre or post functions.41 42static int nPreConfigEnvCallback{0};43static void (*PreConfigEnvCallback[ExecutionEnvironment::nConfigEnvCallback])(44 int, const char *[], const char *[], const EnvironmentDefaultList *){45 nullptr};46 47static int nPostConfigEnvCallback{0};48static void (*PostConfigEnvCallback[ExecutionEnvironment::nConfigEnvCallback])(49 int, const char *[], const char *[], const EnvironmentDefaultList *){50 nullptr};51 52static void SetEnvironmentDefaults(const EnvironmentDefaultList *envDefaults) {53 if (!envDefaults) {54 return;55 }56 57 for (int itemIndex = 0; itemIndex < envDefaults->numItems; ++itemIndex) {58 const char *name = envDefaults->item[itemIndex].name;59 const char *value = envDefaults->item[itemIndex].value;60#ifdef _WIN3261 if (auto *x{std::getenv(name)}) {62 continue;63 }64 if (_putenv_s(name, value) != 0) {65#else66 if (setenv(name, value, /*overwrite=*/0) == -1) {67#endif68 Fortran::runtime::Terminator{__FILE__, __LINE__}.Crash(69 std::strerror(errno));70 }71 }72}73 74RT_OFFLOAD_API_GROUP_BEGIN75common::optional<Convert> GetConvertFromString(const char *x, std::size_t n) {76 static const char *keywords[]{77 "UNKNOWN", "NATIVE", "LITTLE_ENDIAN", "BIG_ENDIAN", "SWAP", nullptr};78 switch (IdentifyValue(x, n, keywords)) {79 case 0:80 return Convert::Unknown;81 case 1:82 return Convert::Native;83 case 2:84 return Convert::LittleEndian;85 case 3:86 return Convert::BigEndian;87 case 4:88 return Convert::Swap;89 default:90 return common::nullopt;91 }92}93RT_OFFLOAD_API_GROUP_END94 95void ExecutionEnvironment::Configure(int ac, const char *av[],96 const char *env[], const EnvironmentDefaultList *envDefaults) {97 argc = ac;98 argv = av;99 SetEnvironmentDefaults(envDefaults);100 101 if (0 != nPreConfigEnvCallback) {102 // Run an optional callback function after the core of the103 // ExecutionEnvironment() logic.104 for (int i{0}; i != nPreConfigEnvCallback; ++i) {105 PreConfigEnvCallback[i](ac, av, env, envDefaults);106 }107 }108 109#ifdef _WIN32110 envp = _environ;111#elif defined(__FreeBSD__)112 auto envpp{reinterpret_cast<char ***>(dlsym(RTLD_DEFAULT, "environ"))};113 if (envpp) {114 envp = *envpp;115 }116#else117 envp = environ;118#endif119 listDirectedOutputLineLengthLimit = 79; // PGI default120 defaultOutputRoundingMode =121 decimal::FortranRounding::RoundNearest; // RP(==RN)122 conversion = Convert::Unknown;123 124 if (auto *x{std::getenv("FORT_FMT_RECL")}) {125 char *end;126 auto n{std::strtol(x, &end, 10)};127 if (n > 0 && n < std::numeric_limits<int>::max() && *end == '\0') {128 listDirectedOutputLineLengthLimit = n;129 } else {130 std::fprintf(131 stderr, "Fortran runtime: FORT_FMT_RECL=%s is invalid; ignored\n", x);132 }133 }134 135 if (auto *x{std::getenv("FORT_CONVERT")}) {136 if (auto convert{GetConvertFromString(x, std::strlen(x))}) {137 conversion = *convert;138 } else {139 std::fprintf(140 stderr, "Fortran runtime: FORT_CONVERT=%s is invalid; ignored\n", x);141 }142 }143 144 if (auto *x{std::getenv("FORT_TRUNCATE_STREAM")}) {145 char *end;146 auto n{std::strtol(x, &end, 10)};147 if (n >= 0 && n <= 1 && *end == '\0') {148 truncateStream = n != 0;149 } else {150 std::fprintf(stderr,151 "Fortran runtime: FORT_TRUNCATE_STREAM=%s is invalid; ignored\n", x);152 }153 }154 155 if (auto *x{std::getenv("NO_STOP_MESSAGE")}) {156 char *end;157 auto n{std::strtol(x, &end, 10)};158 if (n >= 0 && n <= 1 && *end == '\0') {159 noStopMessage = n != 0;160 } else {161 std::fprintf(stderr,162 "Fortran runtime: NO_STOP_MESSAGE=%s is invalid; ignored\n", x);163 }164 }165 166 if (auto *x{std::getenv("DEFAULT_UTF8")}) {167 char *end;168 auto n{std::strtol(x, &end, 10)};169 if (n >= 0 && n <= 1 && *end == '\0') {170 defaultUTF8 = n != 0;171 } else {172 std::fprintf(173 stderr, "Fortran runtime: DEFAULT_UTF8=%s is invalid; ignored\n", x);174 }175 }176 177 if (auto *x{std::getenv("FORT_CHECK_POINTER_DEALLOCATION")}) {178 char *end;179 auto n{std::strtol(x, &end, 10)};180 if (n >= 0 && n <= 1 && *end == '\0') {181 checkPointerDeallocation = n != 0;182 } else {183 std::fprintf(stderr,184 "Fortran runtime: FORT_CHECK_POINTER_DEALLOCATION=%s is invalid; "185 "ignored\n",186 x);187 }188 }189 190 if (auto *x{std::getenv("FLANG_RT_DEBUG")}) {191 internalDebugging = std::strtol(x, nullptr, 10);192 }193 194 if (auto *x{std::getenv("ACC_OFFLOAD_STACK_SIZE")}) {195 char *end;196 auto n{std::strtoul(x, &end, 10)};197 if (n > 0 && n < std::numeric_limits<std::size_t>::max() && *end == '\0') {198 cudaStackLimit = n;199 } else {200 std::fprintf(stderr,201 "Fortran runtime: ACC_OFFLOAD_STACK_SIZE=%s is invalid; ignored\n",202 x);203 }204 }205 206 if (auto *x{std::getenv("NV_CUDAFOR_DEVICE_IS_MANAGED")}) {207 char *end;208 auto n{std::strtol(x, &end, 10)};209 if (n >= 0 && n <= 1 && *end == '\0') {210 cudaDeviceIsManaged = n != 0;211 } else {212 std::fprintf(stderr,213 "Fortran runtime: NV_CUDAFOR_DEVICE_IS_MANAGED=%s is invalid; "214 "ignored\n",215 x);216 }217 }218 219 // TODO: Set RP/ROUND='PROCESSOR_DEFINED' from environment220 221 if (0 != nPostConfigEnvCallback) {222 // Run an optional callback function in reverse order of registration223 // after the core of the ExecutionEnvironment() logic.224 for (int i{0}; i != nPostConfigEnvCallback; ++i) {225 PostConfigEnvCallback[i](ac, av, env, envDefaults);226 }227 }228}229 230const char *ExecutionEnvironment::GetEnv(231 const char *name, std::size_t name_length, const Terminator &terminator) {232 RUNTIME_CHECK(terminator, name && name_length);233 234 OwningPtr<char> cStyleName{235 SaveDefaultCharacter(name, name_length, terminator)};236 RUNTIME_CHECK(terminator, cStyleName);237 238 return std::getenv(cStyleName.get());239}240 241std::int32_t ExecutionEnvironment::SetEnv(const char *name,242 std::size_t name_length, const char *value, std::size_t value_length,243 const Terminator &terminator) {244 245 RUNTIME_CHECK(terminator, name && name_length && value && value_length);246 247 OwningPtr<char> cStyleName{248 SaveDefaultCharacter(name, name_length, terminator)};249 RUNTIME_CHECK(terminator, cStyleName);250 251 OwningPtr<char> cStyleValue{252 SaveDefaultCharacter(value, value_length, terminator)};253 RUNTIME_CHECK(terminator, cStyleValue);254 255 std::int32_t status{0};256 257#ifdef _WIN32258 259 status = _putenv_s(cStyleName.get(), cStyleValue.get());260 261#else262 263 constexpr int overwrite = 1;264 status = setenv(cStyleName.get(), cStyleValue.get(), overwrite);265 266#endif267 268 if (status != 0) {269 status = errno;270 }271 272 return status;273}274 275std::int32_t ExecutionEnvironment::UnsetEnv(276 const char *name, std::size_t name_length, const Terminator &terminator) {277 278 RUNTIME_CHECK(terminator, name && name_length);279 280 OwningPtr<char> cStyleName{281 SaveDefaultCharacter(name, name_length, terminator)};282 RUNTIME_CHECK(terminator, cStyleName);283 284 std::int32_t status{0};285 286#ifdef _WIN32287 288 // Passing empty string as value will unset the variable289 status = _putenv_s(cStyleName.get(), "");290 291#else292 293 status = unsetenv(cStyleName.get());294 295#endif296 297 if (status != 0) {298 status = errno;299 }300 301 return status;302}303 304extern "C" {305 306// User supplied callback functions to further customize the configuration307// of the runtime environment.308// The pre and post callback functions are called upon entry and exit309// of ExecutionEnvironment::Configure() respectively.310 311bool RTNAME(RegisterConfigureEnv)(312 ExecutionEnvironment::ConfigEnvCallbackPtr pre,313 ExecutionEnvironment::ConfigEnvCallbackPtr post) {314 bool ret{true};315 316 if (nullptr != pre) {317 if (nPreConfigEnvCallback < ExecutionEnvironment::nConfigEnvCallback) {318 PreConfigEnvCallback[nPreConfigEnvCallback++] = pre;319 } else {320 ret = false;321 }322 }323 324 if (ret && nullptr != post) {325 if (nPostConfigEnvCallback < ExecutionEnvironment::nConfigEnvCallback) {326 PostConfigEnvCallback[nPostConfigEnvCallback++] = post;327 } else {328 ret = false;329 }330 }331 332 return ret;333}334} // extern "C"335 336} // namespace Fortran::runtime337