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