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("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 if (auto *x{std::getenv("NV_CUDAFOR_DEVICE_IS_MANAGED")}) {
159 char *end;
160 auto n{std::strtol(x, &end, 10)};
161 if (n >= 0 && n <= 1 && *end == '\0') {
162 cudaDeviceIsManaged = n != 0;
163 } else {
164 std::fprintf(stderr,
165 "Fortran runtime: NV_CUDAFOR_DEVICE_IS_MANAGED=%s is invalid; "
166 "ignored\n",
167 x);
168 }
169 }
170
171 // TODO: Set RP/ROUND='PROCESSOR_DEFINED' from environment
172}
173
174const char *ExecutionEnvironment::GetEnv(
175 const char *name, std::size_t name_length, const Terminator &terminator) {
176 RUNTIME_CHECK(terminator, name && name_length);
177
178 OwningPtr<char> cStyleName{
179 SaveDefaultCharacter(name, name_length, terminator)};
180 RUNTIME_CHECK(terminator, cStyleName);
181
182 return std::getenv(cStyleName.get());
183}
184
185std::int32_t ExecutionEnvironment::SetEnv(const char *name,
186 std::size_t name_length, const char *value, std::size_t value_length,
187 const Terminator &terminator) {
188
189 RUNTIME_CHECK(terminator, name && name_length && value && value_length);
190
191 OwningPtr<char> cStyleName{
192 SaveDefaultCharacter(name, name_length, terminator)};
193 RUNTIME_CHECK(terminator, cStyleName);
194
195 OwningPtr<char> cStyleValue{
196 SaveDefaultCharacter(value, value_length, terminator)};
197 RUNTIME_CHECK(terminator, cStyleValue);
198
199 std::int32_t status{0};
200
201#ifdef _WIN32
202
203 status = _putenv_s(cStyleName.get(), cStyleValue.get());
204
205#else
206
207 constexpr int overwrite = 1;
208 status = setenv(cStyleName.get(), cStyleValue.get(), overwrite);
209
210#endif
211
212 if (status != 0) {
213 status = errno;
214 }
215
216 return status;
217}
218
219std::int32_t ExecutionEnvironment::UnsetEnv(
220 const char *name, std::size_t name_length, const Terminator &terminator) {
221
222 RUNTIME_CHECK(terminator, name && name_length);
223
224 OwningPtr<char> cStyleName{
225 SaveDefaultCharacter(name, name_length, terminator)};
226 RUNTIME_CHECK(terminator, cStyleName);
227
228 std::int32_t status{0};
229
230#ifdef _WIN32
231
232 // Passing empty string as value will unset the variable
233 status = _putenv_s(cStyleName.get(), "");
234
235#else
236
237 status = unsetenv(cStyleName.get());
238
239#endif
240
241 if (status != 0) {
242 status = errno;
243 }
244
245 return status;
246}
247
248} // namespace Fortran::runtime
249

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