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-exception
6//
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 _WIN32
19extern char **_environ;
20#else
21extern char **environ;
22#endif
23
24namespace Fortran::runtime {
25
26#ifndef FLANG_RUNTIME_NO_GLOBAL_VAR_DEFS
27RT_OFFLOAD_VAR_GROUP_BEGIN
28RT_VAR_ATTRS ExecutionEnvironment executionEnvironment;
29RT_OFFLOAD_VAR_GROUP_END
30#endif // FLANG_RUNTIME_NO_GLOBAL_VAR_DEFS
31
32static 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: name, value: value, /*overwrite=*/replace: 0) == -1) {
47#endif
48 Fortran::runtime::Terminator{__FILE__, __LINE__}.Crash(
49 std::strerror(errno));
50 }
51 }
52}
53
54RT_OFFLOAD_API_GROUP_BEGIN
55Fortran::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}
74RT_OFFLOAD_API_GROUP_END
75
76void 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("FLANG_RT_DEBUG")}) {
147 internalDebugging = std::strtol(x, nullptr, 10);
148 }
149
150 if (auto *x{std::getenv("ACC_OFFLOAD_STACK_SIZE")}) {
151 char *end;
152 auto n{std::strtoul(x, &end, 10)};
153 if (n > 0 && n < std::numeric_limits<std::size_t>::max() && *end == '\0') {
154 cudaStackLimit = n;
155 } else {
156 std::fprintf(stderr,
157 "Fortran runtime: ACC_OFFLOAD_STACK_SIZE=%s is invalid; ignored\n",
158 x);
159 }
160 }
161
162 if (auto *x{std::getenv("NV_CUDAFOR_DEVICE_IS_MANAGED")}) {
163 char *end;
164 auto n{std::strtol(x, &end, 10)};
165 if (n >= 0 && n <= 1 && *end == '\0') {
166 cudaDeviceIsManaged = n != 0;
167 } else {
168 std::fprintf(stderr,
169 "Fortran runtime: NV_CUDAFOR_DEVICE_IS_MANAGED=%s is invalid; "
170 "ignored\n",
171 x);
172 }
173 }
174
175 // TODO: Set RP/ROUND='PROCESSOR_DEFINED' from environment
176}
177
178const char *ExecutionEnvironment::GetEnv(
179 const char *name, std::size_t name_length, const Terminator &terminator) {
180 RUNTIME_CHECK(terminator, name && name_length);
181
182 OwningPtr<char> cStyleName{
183 SaveDefaultCharacter(name, name_length, terminator)};
184 RUNTIME_CHECK(terminator, cStyleName);
185
186 return std::getenv(cStyleName.get());
187}
188
189std::int32_t ExecutionEnvironment::SetEnv(const char *name,
190 std::size_t name_length, const char *value, std::size_t value_length,
191 const Terminator &terminator) {
192
193 RUNTIME_CHECK(terminator, name && name_length && value && value_length);
194
195 OwningPtr<char> cStyleName{
196 SaveDefaultCharacter(name, name_length, terminator)};
197 RUNTIME_CHECK(terminator, cStyleName);
198
199 OwningPtr<char> cStyleValue{
200 SaveDefaultCharacter(value, value_length, terminator)};
201 RUNTIME_CHECK(terminator, cStyleValue);
202
203 std::int32_t status{0};
204
205#ifdef _WIN32
206
207 status = _putenv_s(cStyleName.get(), cStyleValue.get());
208
209#else
210
211 constexpr int overwrite = 1;
212 status = setenv(cStyleName.get(), cStyleValue.get(), overwrite);
213
214#endif
215
216 if (status != 0) {
217 status = errno;
218 }
219
220 return status;
221}
222
223std::int32_t ExecutionEnvironment::UnsetEnv(
224 const char *name, std::size_t name_length, const Terminator &terminator) {
225
226 RUNTIME_CHECK(terminator, name && name_length);
227
228 OwningPtr<char> cStyleName{
229 SaveDefaultCharacter(name, name_length, terminator)};
230 RUNTIME_CHECK(terminator, cStyleName);
231
232 std::int32_t status{0};
233
234#ifdef _WIN32
235
236 // Passing empty string as value will unset the variable
237 status = _putenv_s(cStyleName.get(), "");
238
239#else
240
241 status = unsetenv(cStyleName.get());
242
243#endif
244
245 if (status != 0) {
246 status = errno;
247 }
248
249 return status;
250}
251
252} // namespace Fortran::runtime
253

source code of flang-rt/lib/runtime/environment.cpp