1 //===-- runtime/command.cpp -----------------------------------------------===//
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
7 //===----------------------------------------------------------------------===//
9 #include "flang/Runtime/command.h"
10 #include "environment.h"
12 #include "terminator.h"
14 #include "flang/Runtime/descriptor.h"
18 namespace Fortran::runtime
{
19 std::int32_t RTNAME(ArgumentCount
)() {
20 int argc
{executionEnvironment
.argc
};
22 // C counts the command name as one of the arguments, but Fortran doesn't.
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
);
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
);
40 static bool IsValidCharDescriptor(const Descriptor
*value
) {
41 return value
&& value
->IsAllocated() &&
42 value
->type() == TypeCode(TypeCategory::Character
, 1) &&
46 static bool IsValidIntDescriptor(const Descriptor
*length
) {
47 auto typeCode
{length
->type().GetCategoryAndKind()};
48 // Check that our descriptor is allocated and is a scalar integer with
49 // kind != 1 (i.e. with a large enough decimal exponent range).
50 return length
->IsAllocated() && length
->rank() == 0 &&
51 length
->type().IsInteger() && typeCode
&& typeCode
->second
!= 1;
54 static void FillWithSpaces(const Descriptor
&value
, std::size_t offset
= 0) {
55 if (offset
< value
.ElementBytes()) {
57 value
.OffsetElement(offset
), ' ', value
.ElementBytes() - offset
);
61 static std::int32_t CopyToDescriptor(const Descriptor
&value
,
62 const char *rawValue
, std::int64_t rawValueLength
, const Descriptor
*errmsg
,
63 std::size_t offset
= 0) {
65 std::int64_t toCopy
{std::min(rawValueLength
,
66 static_cast<std::int64_t>(value
.ElementBytes() - offset
))};
68 return ToErrmsg(errmsg
, StatValueTooShort
);
71 std::memcpy(value
.OffsetElement(offset
), rawValue
, toCopy
);
73 if (rawValueLength
> toCopy
) {
74 return ToErrmsg(errmsg
, StatValueTooShort
);
80 static std::int32_t CheckAndCopyToDescriptor(const Descriptor
*value
,
81 const char *rawValue
, const Descriptor
*errmsg
, std::size_t &offset
) {
82 bool haveValue
{IsValidCharDescriptor(value
)};
84 std::int64_t len
{StringLength(rawValue
)};
87 FillWithSpaces(*value
);
89 return ToErrmsg(errmsg
, StatMissingArgument
);
92 std::int32_t stat
{StatOk
};
94 stat
= CopyToDescriptor(*value
, rawValue
, len
, errmsg
, offset
);
101 static void StoreLengthToDescriptor(
102 const Descriptor
*length
, std::int64_t value
, Terminator
&terminator
) {
103 auto typeCode
{length
->type().GetCategoryAndKind()};
104 int kind
{typeCode
->second
};
105 Fortran::runtime::ApplyIntegerKind
<Fortran::runtime::StoreIntegerAt
, void>(
106 kind
, terminator
, *length
, /* atIndex = */ 0, value
);
109 template <int KIND
> struct FitsInIntegerKind
{
110 bool operator()(std::int64_t value
) {
111 return value
<= std::numeric_limits
<Fortran::runtime::CppTypeFor
<
112 Fortran::common::TypeCategory::Integer
, KIND
>>::max();
116 static bool FitsInDescriptor(
117 const Descriptor
*length
, std::int64_t value
, Terminator
&terminator
) {
118 auto typeCode
{length
->type().GetCategoryAndKind()};
119 int kind
{typeCode
->second
};
120 return Fortran::runtime::ApplyIntegerKind
<FitsInIntegerKind
, bool>(
121 kind
, terminator
, value
);
124 std::int32_t RTNAME(GetCommandArgument
)(std::int32_t n
, const Descriptor
*value
,
125 const Descriptor
*length
, const Descriptor
*errmsg
, const char *sourceFile
,
127 Terminator terminator
{sourceFile
, line
};
130 RUNTIME_CHECK(terminator
, IsValidCharDescriptor(value
));
131 FillWithSpaces(*value
);
134 // Store 0 in case we error out later on.
136 RUNTIME_CHECK(terminator
, IsValidIntDescriptor(length
));
137 StoreLengthToDescriptor(length
, 0, terminator
);
140 if (n
< 0 || n
>= executionEnvironment
.argc
) {
141 return ToErrmsg(errmsg
, StatInvalidArgumentNumber
);
144 const char *arg
{executionEnvironment
.argv
[n
]};
145 std::int64_t argLen
{StringLength(arg
)};
147 return ToErrmsg(errmsg
, StatMissingArgument
);
150 if (length
&& FitsInDescriptor(length
, argLen
, terminator
)) {
151 StoreLengthToDescriptor(length
, argLen
, terminator
);
155 return CopyToDescriptor(*value
, arg
, argLen
, errmsg
);
161 std::int32_t RTNAME(GetCommand
)(const Descriptor
*value
,
162 const Descriptor
*length
, const Descriptor
*errmsg
, const char *sourceFile
,
164 Terminator terminator
{sourceFile
, line
};
167 RUNTIME_CHECK(terminator
, IsValidCharDescriptor(value
));
170 // Store 0 in case we error out later on.
172 RUNTIME_CHECK(terminator
, IsValidIntDescriptor(length
));
173 StoreLengthToDescriptor(length
, 0, terminator
);
176 auto shouldContinue
= [&](std::int32_t stat
) -> bool {
177 // We continue as long as everything is ok OR the value descriptor is
178 // too short, but we still need to compute the length.
179 return stat
== StatOk
|| (length
&& stat
== StatValueTooShort
);
182 std::size_t offset
{0};
184 if (executionEnvironment
.argc
== 0) {
185 return CheckAndCopyToDescriptor(value
, "", errmsg
, offset
);
189 std::int32_t stat
{CheckAndCopyToDescriptor(
190 value
, executionEnvironment
.argv
[0], errmsg
, offset
)};
191 if (!shouldContinue(stat
)) {
195 // value += " " + argv[1:n]
196 for (std::int32_t i
{1}; i
< executionEnvironment
.argc
; ++i
) {
197 stat
= CheckAndCopyToDescriptor(value
, " ", errmsg
, offset
);
198 if (!shouldContinue(stat
)) {
202 stat
= CheckAndCopyToDescriptor(
203 value
, executionEnvironment
.argv
[i
], errmsg
, offset
);
204 if (!shouldContinue(stat
)) {
209 if (length
&& FitsInDescriptor(length
, offset
, terminator
)) {
210 StoreLengthToDescriptor(length
, offset
, terminator
);
213 // value += spaces for padding
215 FillWithSpaces(*value
, offset
);
221 static std::size_t LengthWithoutTrailingSpaces(const Descriptor
&d
) {
222 std::size_t s
{d
.ElementBytes() - 1};
223 while (*d
.OffsetElement(s
) == ' ') {
229 std::int32_t RTNAME(GetEnvVariable
)(const Descriptor
&name
,
230 const Descriptor
*value
, const Descriptor
*length
, bool trim_name
,
231 const Descriptor
*errmsg
, const char *sourceFile
, int line
) {
232 Terminator terminator
{sourceFile
, line
};
235 RUNTIME_CHECK(terminator
, IsValidCharDescriptor(value
));
236 FillWithSpaces(*value
);
239 // Store 0 in case we error out later on.
241 RUNTIME_CHECK(terminator
, IsValidIntDescriptor(length
));
242 StoreLengthToDescriptor(length
, 0, terminator
);
245 const char *rawValue
{nullptr};
246 std::size_t nameLength
{
247 trim_name
? LengthWithoutTrailingSpaces(name
) : name
.ElementBytes()};
248 if (nameLength
!= 0) {
249 rawValue
= executionEnvironment
.GetEnv(
250 name
.OffsetElement(), nameLength
, terminator
);
253 return ToErrmsg(errmsg
, StatMissingEnvVariable
);
256 std::int64_t varLen
{StringLength(rawValue
)};
257 if (length
&& FitsInDescriptor(length
, varLen
, terminator
)) {
258 StoreLengthToDescriptor(length
, varLen
, terminator
);
262 return CopyToDescriptor(*value
, rawValue
, varLen
, errmsg
);
267 } // namespace Fortran::runtime