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 namespace Fortran::runtime {
19 std::int32_t RTNAME(ArgumentCount)() {
20   int argc{executionEnvironment.argc};
21   if (argc > 1) {
22     // C counts the command name as one of the arguments, but Fortran doesn't.
23     return argc - 1;
24   }
25   return 0;
26 }
27 
28 // Returns the length of the \p string. Assumes \p string is valid.
29 static std::int64_t StringLength(const char *string) {
30   std::size_t length{std::strlen(string)};
31   if constexpr (sizeof(std::size_t) < sizeof(std::int64_t)) {
32     return static_cast<std::int64_t>(length);
33   } else {
34     std::size_t max{std::numeric_limits<std::int64_t>::max()};
35     return length > max ? 0 // Just fail.
36                         : static_cast<std::int64_t>(length);
37   }
38 }
39 
40 std::int64_t RTNAME(ArgumentLength)(std::int32_t n) {
41   if (n < 0 || n >= executionEnvironment.argc ||
42       !executionEnvironment.argv[n]) {
43     return 0;
44   }
45 
46   return StringLength(executionEnvironment.argv[n]);
47 }
48 
49 static bool IsValidCharDescriptor(const Descriptor *value) {
50   return value && value->IsAllocated() &&
51       value->type() == TypeCode(TypeCategory::Character, 1) &&
52       value->rank() == 0;
53 }
54 
55 static bool IsValidIntDescriptor(const Descriptor *length) {
56   auto typeCode{length->type().GetCategoryAndKind()};
57   // Check that our descriptor is allocated and is a scalar integer with
58   // kind != 1 (i.e. with a large enough decimal exponent range).
59   return length->IsAllocated() && length->rank() == 0 &&
60       length->type().IsInteger() && typeCode && typeCode->second != 1;
61 }
62 
63 static void FillWithSpaces(const Descriptor &value, std::size_t offset = 0) {
64   if (offset < value.ElementBytes()) {
65     std::memset(
66         value.OffsetElement(offset), ' ', value.ElementBytes() - offset);
67   }
68 }
69 
70 static std::int32_t CopyToDescriptor(const Descriptor &value,
71     const char *rawValue, std::int64_t rawValueLength, const Descriptor *errmsg,
72     std::size_t offset = 0) {
73 
74   std::int64_t toCopy{std::min(rawValueLength,
75       static_cast<std::int64_t>(value.ElementBytes() - offset))};
76   if (toCopy < 0) {
77     return ToErrmsg(errmsg, StatValueTooShort);
78   }
79 
80   std::memcpy(value.OffsetElement(offset), rawValue, toCopy);
81 
82   if (rawValueLength > toCopy) {
83     return ToErrmsg(errmsg, StatValueTooShort);
84   }
85 
86   return StatOk;
87 }
88 
89 static std::int32_t CheckAndCopyToDescriptor(const Descriptor *value,
90     const char *rawValue, const Descriptor *errmsg, std::size_t &offset) {
91   bool haveValue{IsValidCharDescriptor(value)};
92 
93   std::int64_t len{StringLength(rawValue)};
94   if (len <= 0) {
95     if (haveValue) {
96       FillWithSpaces(*value);
97     }
98     return ToErrmsg(errmsg, StatMissingArgument);
99   }
100 
101   std::int32_t stat{StatOk};
102   if (haveValue) {
103     stat = CopyToDescriptor(*value, rawValue, len, errmsg, offset);
104   }
105 
106   offset += len;
107   return stat;
108 }
109 
110 std::int32_t RTNAME(ArgumentValue)(
111     std::int32_t n, const Descriptor *value, const Descriptor *errmsg) {
112   if (IsValidCharDescriptor(value)) {
113     FillWithSpaces(*value);
114   }
115 
116   if (n < 0 || n >= executionEnvironment.argc) {
117     return ToErrmsg(errmsg, StatInvalidArgumentNumber);
118   }
119 
120   if (IsValidCharDescriptor(value)) {
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     return CopyToDescriptor(*value, arg, argLen, errmsg);
128   }
129 
130   return StatOk;
131 }
132 
133 template <int KIND> struct FitsInIntegerKind {
134   bool operator()(std::int64_t value) {
135     return value <= std::numeric_limits<Fortran::runtime::CppTypeFor<
136                         Fortran::common::TypeCategory::Integer, KIND>>::max();
137   }
138 };
139 
140 std::int32_t RTNAME(GetCommand)(const Descriptor *value,
141     const Descriptor *length, const Descriptor *errmsg, const char *sourceFile,
142     int line) {
143   Terminator terminator{sourceFile, line};
144 
145   auto storeLength = [&](std::int64_t value) {
146     auto typeCode{length->type().GetCategoryAndKind()};
147     int kind{typeCode->second};
148     Fortran::runtime::ApplyIntegerKind<Fortran::runtime::StoreIntegerAt, void>(
149         kind, terminator, *length, /* atIndex = */ 0, value);
150   };
151 
152   if (value) {
153     RUNTIME_CHECK(terminator, IsValidCharDescriptor(value));
154   }
155 
156   // Store 0 in case we error out later on.
157   if (length) {
158     RUNTIME_CHECK(terminator, IsValidIntDescriptor(length));
159     storeLength(0);
160   }
161 
162   auto shouldContinue = [&](std::int32_t stat) -> bool {
163     // We continue as long as everything is ok OR the value descriptor is
164     // too short, but we still need to compute the length.
165     return stat == StatOk || (length && stat == StatValueTooShort);
166   };
167 
168   std::size_t offset{0};
169 
170   if (executionEnvironment.argc == 0) {
171     return CheckAndCopyToDescriptor(value, "", errmsg, offset);
172   }
173 
174   // value = argv[0]
175   std::int32_t stat{CheckAndCopyToDescriptor(
176       value, executionEnvironment.argv[0], errmsg, offset)};
177   if (!shouldContinue(stat)) {
178     return stat;
179   }
180 
181   // value += " " + argv[1:n]
182   for (std::int32_t i{1}; i < executionEnvironment.argc; ++i) {
183     stat = CheckAndCopyToDescriptor(value, " ", errmsg, offset);
184     if (!shouldContinue(stat)) {
185       return stat;
186     }
187 
188     stat = CheckAndCopyToDescriptor(
189         value, executionEnvironment.argv[i], errmsg, offset);
190     if (!shouldContinue(stat)) {
191       return stat;
192     }
193   }
194 
195   auto fitsInLength = [&](std::int64_t value) -> bool {
196     auto typeCode{length->type().GetCategoryAndKind()};
197     int kind{typeCode->second};
198     return Fortran::runtime::ApplyIntegerKind<FitsInIntegerKind, bool>(
199         kind, terminator, value);
200   };
201 
202   if (length && fitsInLength(offset)) {
203     storeLength(offset);
204   }
205 
206   // value += spaces for padding
207   if (value) {
208     FillWithSpaces(*value, offset);
209   }
210 
211   return stat;
212 }
213 
214 static std::size_t LengthWithoutTrailingSpaces(const Descriptor &d) {
215   std::size_t s{d.ElementBytes() - 1};
216   while (*d.OffsetElement(s) == ' ') {
217     --s;
218   }
219   return s + 1;
220 }
221 
222 static const char *GetEnvVariableValue(
223     const Descriptor &name, bool trim_name, const char *sourceFile, int line) {
224   std::size_t nameLength{
225       trim_name ? LengthWithoutTrailingSpaces(name) : name.ElementBytes()};
226   if (nameLength == 0) {
227     return nullptr;
228   }
229 
230   Terminator terminator{sourceFile, line};
231   const char *value{executionEnvironment.GetEnv(
232       name.OffsetElement(), nameLength, terminator)};
233   return value;
234 }
235 
236 std::int32_t RTNAME(EnvVariableValue)(const Descriptor &name,
237     const Descriptor *value, bool trim_name, const Descriptor *errmsg,
238     const char *sourceFile, int line) {
239   if (IsValidCharDescriptor(value)) {
240     FillWithSpaces(*value);
241   }
242 
243   const char *rawValue{GetEnvVariableValue(name, trim_name, sourceFile, line)};
244   if (!rawValue) {
245     return ToErrmsg(errmsg, StatMissingEnvVariable);
246   }
247 
248   if (IsValidCharDescriptor(value)) {
249     return CopyToDescriptor(*value, rawValue, StringLength(rawValue), errmsg);
250   }
251 
252   return StatOk;
253 }
254 
255 std::int64_t RTNAME(EnvVariableLength)(
256     const Descriptor &name, bool trim_name, const char *sourceFile, int line) {
257   const char *value{GetEnvVariableValue(name, trim_name, sourceFile, line)};
258   if (!value) {
259     return 0;
260   }
261   return StringLength(value);
262 }
263 } // namespace Fortran::runtime
264