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 | RT_OFFLOAD_VAR_GROUP_BEGIN |
27 | RT_VAR_ATTRS ExecutionEnvironment executionEnvironment; |
28 | RT_OFFLOAD_VAR_GROUP_END |
29 | |
30 | static 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 | |
52 | RT_OFFLOAD_API_GROUP_BEGIN |
53 | Fortran::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 | } |
72 | RT_OFFLOAD_API_GROUP_END |
73 | |
74 | void 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 | |
147 | const 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 | |