1//===-- runtime/command.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 "flang/Runtime/command.h"
10#include "environment.h"
11#include "stat.h"
12#include "terminator.h"
13#include "tools.h"
14#include "flang/Runtime/descriptor.h"
15#include <cstdlib>
16#include <limits>
17
18#ifdef _WIN32
19#define WIN32_LEAN_AND_MEAN
20#define NOMINMAX
21#include <windows.h>
22
23// On Windows GetCurrentProcessId returns a DWORD aka uint32_t
24#include <processthreadsapi.h>
25inline pid_t getpid() { return GetCurrentProcessId(); }
26#else
27#include <unistd.h> //getpid()
28#endif
29
30namespace Fortran::runtime {
31std::int32_t RTNAME(ArgumentCount)() {
32 int argc{executionEnvironment.argc};
33 if (argc > 1) {
34 // C counts the command name as one of the arguments, but Fortran doesn't.
35 return argc - 1;
36 }
37 return 0;
38}
39
40pid_t RTNAME(GetPID)() { return getpid(); }
41
42// Returns the length of the \p string. Assumes \p string is valid.
43static std::int64_t StringLength(const char *string) {
44 std::size_t length{std::strlen(s: string)};
45 if constexpr (sizeof(std::size_t) < sizeof(std::int64_t)) {
46 return static_cast<std::int64_t>(length);
47 } else {
48 std::size_t max{std::numeric_limits<std::int64_t>::max()};
49 return length > max ? 0 // Just fail.
50 : static_cast<std::int64_t>(length);
51 }
52}
53
54static void FillWithSpaces(const Descriptor &value, std::size_t offset = 0) {
55 if (offset < value.ElementBytes()) {
56 std::memset(
57 s: value.OffsetElement(offset), c: ' ', n: value.ElementBytes() - offset);
58 }
59}
60
61static std::int32_t CheckAndCopyCharsToDescriptor(const Descriptor *value,
62 const char *rawValue, const Descriptor *errmsg, std::size_t &offset) {
63 bool haveValue{IsValidCharDescriptor(value)};
64
65 std::int64_t len{StringLength(rawValue)};
66 if (len <= 0) {
67 if (haveValue) {
68 FillWithSpaces(value: *value);
69 }
70 return ToErrmsg(errmsg, StatMissingArgument);
71 }
72
73 std::int32_t stat{StatOk};
74 if (haveValue) {
75 stat = CopyCharsToDescriptor(*value, rawValue, len, errmsg, offset);
76 }
77
78 offset += len;
79 return stat;
80}
81
82template <int KIND> struct FitsInIntegerKind {
83 bool operator()([[maybe_unused]] std::int64_t value) {
84 if constexpr (KIND >= 8) {
85 return true;
86 } else {
87 return value <= std::numeric_limits<Fortran::runtime::CppTypeFor<
88 Fortran::common::TypeCategory::Integer, KIND>>::max();
89 }
90 }
91};
92
93static bool FitsInDescriptor(
94 const Descriptor *length, std::int64_t value, Terminator &terminator) {
95 auto typeCode{length->type().GetCategoryAndKind()};
96 int kind{typeCode->second};
97 return Fortran::runtime::ApplyIntegerKind<FitsInIntegerKind, bool>(
98 kind, terminator, value);
99}
100
101std::int32_t RTNAME(GetCommandArgument)(std::int32_t n, const Descriptor *value,
102 const Descriptor *length, const Descriptor *errmsg, const char *sourceFile,
103 int line) {
104 Terminator terminator{sourceFile, line};
105
106 if (value) {
107 RUNTIME_CHECK(terminator, IsValidCharDescriptor(value));
108 FillWithSpaces(*value);
109 }
110
111 // Store 0 in case we error out later on.
112 if (length) {
113 RUNTIME_CHECK(terminator, IsValidIntDescriptor(length));
114 StoreIntToDescriptor(length, 0, terminator);
115 }
116
117 if (n < 0 || n >= executionEnvironment.argc) {
118 return ToErrmsg(errmsg, StatInvalidArgumentNumber);
119 }
120
121 const char *arg{executionEnvironment.argv[n]};
122 std::int64_t argLen{StringLength(arg)};
123 if (argLen <= 0) {
124 return ToErrmsg(errmsg, StatMissingArgument);
125 }
126
127 if (length && FitsInDescriptor(length, argLen, terminator)) {
128 StoreIntToDescriptor(length, argLen, terminator);
129 }
130
131 if (value) {
132 return CopyCharsToDescriptor(*value, arg, argLen, errmsg);
133 }
134
135 return StatOk;
136}
137
138std::int32_t RTNAME(GetCommand)(const Descriptor *value,
139 const Descriptor *length, const Descriptor *errmsg, const char *sourceFile,
140 int line) {
141 Terminator terminator{sourceFile, line};
142
143 if (value) {
144 RUNTIME_CHECK(terminator, IsValidCharDescriptor(value));
145 }
146
147 // Store 0 in case we error out later on.
148 if (length) {
149 RUNTIME_CHECK(terminator, IsValidIntDescriptor(length));
150 StoreIntToDescriptor(length, 0, terminator);
151 }
152
153 auto shouldContinue = [&](std::int32_t stat) -> bool {
154 // We continue as long as everything is ok OR the value descriptor is
155 // too short, but we still need to compute the length.
156 return stat == StatOk || (length && stat == StatValueTooShort);
157 };
158
159 std::size_t offset{0};
160
161 if (executionEnvironment.argc == 0) {
162 return CheckAndCopyCharsToDescriptor(value, "", errmsg, offset);
163 }
164
165 // value = argv[0]
166 std::int32_t stat{CheckAndCopyCharsToDescriptor(
167 value, executionEnvironment.argv[0], errmsg, offset)};
168 if (!shouldContinue(stat)) {
169 return stat;
170 }
171
172 // value += " " + argv[1:n]
173 for (std::int32_t i{1}; i < executionEnvironment.argc; ++i) {
174 stat = CheckAndCopyCharsToDescriptor(value, " ", errmsg, offset);
175 if (!shouldContinue(stat)) {
176 return stat;
177 }
178
179 stat = CheckAndCopyCharsToDescriptor(
180 value, executionEnvironment.argv[i], errmsg, offset);
181 if (!shouldContinue(stat)) {
182 return stat;
183 }
184 }
185
186 if (length && FitsInDescriptor(length, offset, terminator)) {
187 StoreIntToDescriptor(length, offset, terminator);
188 }
189
190 // value += spaces for padding
191 if (value) {
192 FillWithSpaces(*value, offset);
193 }
194
195 return stat;
196}
197
198static std::size_t LengthWithoutTrailingSpaces(const Descriptor &d) {
199 std::size_t s{d.ElementBytes() - 1};
200 while (*d.OffsetElement(s) == ' ') {
201 --s;
202 }
203 return s + 1;
204}
205
206std::int32_t RTNAME(GetEnvVariable)(const Descriptor &name,
207 const Descriptor *value, const Descriptor *length, bool trim_name,
208 const Descriptor *errmsg, const char *sourceFile, int line) {
209 Terminator terminator{sourceFile, line};
210
211 if (value) {
212 RUNTIME_CHECK(terminator, IsValidCharDescriptor(value));
213 FillWithSpaces(*value);
214 }
215
216 // Store 0 in case we error out later on.
217 if (length) {
218 RUNTIME_CHECK(terminator, IsValidIntDescriptor(length));
219 StoreIntToDescriptor(length, 0, terminator);
220 }
221
222 const char *rawValue{nullptr};
223 std::size_t nameLength{
224 trim_name ? LengthWithoutTrailingSpaces(name) : name.ElementBytes()};
225 if (nameLength != 0) {
226 rawValue = executionEnvironment.GetEnv(
227 name.OffsetElement(), nameLength, terminator);
228 }
229 if (!rawValue) {
230 return ToErrmsg(errmsg, StatMissingEnvVariable);
231 }
232
233 std::int64_t varLen{StringLength(rawValue)};
234 if (length && FitsInDescriptor(length, varLen, terminator)) {
235 StoreIntToDescriptor(length, varLen, terminator);
236 }
237
238 if (value) {
239 return CopyCharsToDescriptor(*value, rawValue, varLen, errmsg);
240 }
241 return StatOk;
242}
243
244} // namespace Fortran::runtime
245

source code of flang/runtime/command.cpp