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
19extern char **_environ;
20#else
21extern char **environ;
22#endif
23
24namespace Fortran::runtime {
25
26RT_OFFLOAD_VAR_GROUP_BEGIN
27RT_VAR_ATTRS ExecutionEnvironment executionEnvironment;
28RT_OFFLOAD_VAR_GROUP_END
29
30static void SetEnvironmentDefaults(const EnvironmentDefaultList *envDefaults) {
31 if (!envDefaults) {
32 return;
33 }
34
35 for (int itemIndex = 0; itemIndex < envDefaults->numItems; ++itemIndex) {
36 const char *name = envDefaults->item[itemIndex].name;
37 const char *value = envDefaults->item[itemIndex].value;
38#ifdef _WIN32
39 if (auto *x{std::getenv(name)}) {
40 continue;
41 }
42 if (_putenv_s(name, value) != 0) {
43#else
44 if (setenv(name: name, value: value, /*overwrite=*/replace: 0) == -1) {
45#endif
46 Fortran::runtime::Terminator{__FILE__, __LINE__}.Crash(
47 std::strerror(errno));
48 }
49 }
50}
51
52RT_OFFLOAD_API_GROUP_BEGIN
53Fortran::common::optional<Convert> GetConvertFromString(
54 const char *x, std::size_t n) {
55 static const char *keywords[]{
56 "UNKNOWN", "NATIVE", "LITTLE_ENDIAN", "BIG_ENDIAN", "SWAP", nullptr};
57 switch (IdentifyValue(x, n, keywords)) {
58 case 0:
59 return Convert::Unknown;
60 case 1:
61 return Convert::Native;
62 case 2:
63 return Convert::LittleEndian;
64 case 3:
65 return Convert::BigEndian;
66 case 4:
67 return Convert::Swap;
68 default:
69 return Fortran::common::nullopt;
70 }
71}
72RT_OFFLOAD_API_GROUP_END
73
74void ExecutionEnvironment::Configure(int ac, const char *av[],
75 const char *env[], const EnvironmentDefaultList *envDefaults) {
76 argc = ac;
77 argv = av;
78 SetEnvironmentDefaults(envDefaults);
79#ifdef _WIN32
80 envp = _environ;
81#else
82 envp = environ;
83#endif
84 listDirectedOutputLineLengthLimit = 79; // PGI default
85 defaultOutputRoundingMode =
86 decimal::FortranRounding::RoundNearest; // RP(==RN)
87 conversion = Convert::Unknown;
88
89 if (auto *x{std::getenv(name: "FORT_FMT_RECL")}) {
90 char *end;
91 auto n{std::strtol(nptr: x, endptr: &end, base: 10)};
92 if (n > 0 && n < std::numeric_limits<int>::max() && *end == '\0') {
93 listDirectedOutputLineLengthLimit = n;
94 } else {
95 std::fprintf(
96 stderr, format: "Fortran runtime: FORT_FMT_RECL=%s is invalid; ignored\n", x);
97 }
98 }
99
100 if (auto *x{std::getenv(name: "FORT_CONVERT")}) {
101 if (auto convert{GetConvertFromString(x, std::strlen(x))}) {
102 conversion = *convert;
103 } else {
104 std::fprintf(
105 stderr, format: "Fortran runtime: FORT_CONVERT=%s is invalid; ignored\n", x);
106 }
107 }
108
109 if (auto *x{std::getenv(name: "NO_STOP_MESSAGE")}) {
110 char *end;
111 auto n{std::strtol(nptr: x, endptr: &end, base: 10)};
112 if (n >= 0 && n <= 1 && *end == '\0') {
113 noStopMessage = n != 0;
114 } else {
115 std::fprintf(stderr,
116 format: "Fortran runtime: NO_STOP_MESSAGE=%s is invalid; ignored\n", x);
117 }
118 }
119
120 if (auto *x{std::getenv(name: "DEFAULT_UTF8")}) {
121 char *end;
122 auto n{std::strtol(nptr: x, endptr: &end, base: 10)};
123 if (n >= 0 && n <= 1 && *end == '\0') {
124 defaultUTF8 = n != 0;
125 } else {
126 std::fprintf(
127 stderr, format: "Fortran runtime: DEFAULT_UTF8=%s is invalid; ignored\n", x);
128 }
129 }
130
131 if (auto *x{std::getenv(name: "FORT_CHECK_POINTER_DEALLOCATION")}) {
132 char *end;
133 auto n{std::strtol(nptr: x, endptr: &end, base: 10)};
134 if (n >= 0 && n <= 1 && *end == '\0') {
135 checkPointerDeallocation = n != 0;
136 } else {
137 std::fprintf(stderr,
138 format: "Fortran runtime: FORT_CHECK_POINTER_DEALLOCATION=%s is invalid; "
139 "ignored\n",
140 x);
141 }
142 }
143
144 // TODO: Set RP/ROUND='PROCESSOR_DEFINED' from environment
145}
146
147const char *ExecutionEnvironment::GetEnv(
148 const char *name, std::size_t name_length, const Terminator &terminator) {
149 RUNTIME_CHECK(terminator, name && name_length);
150
151 OwningPtr<char> cStyleName{
152 SaveDefaultCharacter(name, name_length, terminator)};
153 RUNTIME_CHECK(terminator, cStyleName);
154
155 return std::getenv(name: cStyleName.get());
156}
157} // namespace Fortran::runtime
158

source code of flang/runtime/environment.cpp