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
26ExecutionEnvironment executionEnvironment;
27
28static 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
50std::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
69void 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
129const 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

source code of flang/runtime/environment.cpp