xref: /llvm-project/flang/runtime/command.cpp (revision 1e6672af2497042d5dad0236c2ad9e61f879ac07)
10c375296SDiana Picus //===-- runtime/command.cpp -----------------------------------------------===//
20c375296SDiana Picus //
30c375296SDiana Picus // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
40c375296SDiana Picus // See https://llvm.org/LICENSE.txt for license information.
50c375296SDiana Picus // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
60c375296SDiana Picus //
70c375296SDiana Picus //===----------------------------------------------------------------------===//
80c375296SDiana Picus 
9830c0b90SPeter Klausler #include "flang/Runtime/command.h"
100c375296SDiana Picus #include "environment.h"
1137089baeSDiana Picus #include "stat.h"
12824bf908SDiana Picus #include "terminator.h"
13873f081eSDiana Picus #include "tools.h"
1437089baeSDiana Picus #include "flang/Runtime/descriptor.h"
15fc2ba5e5SDiana Picus #include <cstdlib>
16af63d179SDiana Picus #include <limits>
170c375296SDiana Picus 
18de58aa83SYi Wu #ifdef _WIN32
19864d2531SSlava Zakharin #include "flang/Common/windows-include.h"
2068413219Sjiajie zhang #include <direct.h>
2168413219Sjiajie zhang #define getcwd _getcwd
2268413219Sjiajie zhang #define PATH_MAX MAX_PATH
23de58aa83SYi Wu 
24de58aa83SYi Wu // On Windows GetCurrentProcessId returns a DWORD aka uint32_t
25de58aa83SYi Wu #include <processthreadsapi.h>
26de58aa83SYi Wu inline pid_t getpid() { return GetCurrentProcessId(); }
27de58aa83SYi Wu #else
28de58aa83SYi Wu #include <unistd.h> //getpid()
2968413219Sjiajie zhang 
3068413219Sjiajie zhang #ifndef PATH_MAX
3168413219Sjiajie zhang #define PATH_MAX 4096
3268413219Sjiajie zhang #endif
33de58aa83SYi Wu #endif
34de58aa83SYi Wu 
350c375296SDiana Picus namespace Fortran::runtime {
36af63d179SDiana Picus std::int32_t RTNAME(ArgumentCount)() {
370c375296SDiana Picus   int argc{executionEnvironment.argc};
380c375296SDiana Picus   if (argc > 1) {
390c375296SDiana Picus     // C counts the command name as one of the arguments, but Fortran doesn't.
400c375296SDiana Picus     return argc - 1;
410c375296SDiana Picus   }
420c375296SDiana Picus   return 0;
430c375296SDiana Picus }
44af63d179SDiana Picus 
45de58aa83SYi Wu pid_t RTNAME(GetPID)() { return getpid(); }
46de58aa83SYi Wu 
479df0ba59SDiana Picus // Returns the length of the \p string. Assumes \p string is valid.
489df0ba59SDiana Picus static std::int64_t StringLength(const char *string) {
499df0ba59SDiana Picus   std::size_t length{std::strlen(string)};
50*1e6672afSserge-sans-paille   if (length <= std::numeric_limits<std::int64_t>::max())
51af63d179SDiana Picus     return static_cast<std::int64_t>(length);
52*1e6672afSserge-sans-paille   return 0;
53af63d179SDiana Picus }
5437089baeSDiana Picus 
55873f081eSDiana Picus static void FillWithSpaces(const Descriptor &value, std::size_t offset = 0) {
56873f081eSDiana Picus   if (offset < value.ElementBytes()) {
57873f081eSDiana Picus     std::memset(
58873f081eSDiana Picus         value.OffsetElement(offset), ' ', value.ElementBytes() - offset);
59873f081eSDiana Picus   }
6037089baeSDiana Picus }
6137089baeSDiana Picus 
62e2b896aaSYi Wu static std::int32_t CheckAndCopyCharsToDescriptor(const Descriptor *value,
63873f081eSDiana Picus     const char *rawValue, const Descriptor *errmsg, std::size_t &offset) {
64873f081eSDiana Picus   bool haveValue{IsValidCharDescriptor(value)};
65873f081eSDiana Picus 
66873f081eSDiana Picus   std::int64_t len{StringLength(rawValue)};
67873f081eSDiana Picus   if (len <= 0) {
68873f081eSDiana Picus     if (haveValue) {
69873f081eSDiana Picus       FillWithSpaces(*value);
70873f081eSDiana Picus     }
71873f081eSDiana Picus     return ToErrmsg(errmsg, StatMissingArgument);
72873f081eSDiana Picus   }
73873f081eSDiana Picus 
74873f081eSDiana Picus   std::int32_t stat{StatOk};
75873f081eSDiana Picus   if (haveValue) {
76e2b896aaSYi Wu     stat = CopyCharsToDescriptor(*value, rawValue, len, errmsg, offset);
77873f081eSDiana Picus   }
78873f081eSDiana Picus 
79873f081eSDiana Picus   offset += len;
80873f081eSDiana Picus   return stat;
81873f081eSDiana Picus }
82873f081eSDiana Picus 
83873f081eSDiana Picus template <int KIND> struct FitsInIntegerKind {
841c35c1a7SPeter Klausler   bool operator()([[maybe_unused]] std::int64_t value) {
851c35c1a7SPeter Klausler     if constexpr (KIND >= 8) {
861c35c1a7SPeter Klausler       return true;
871c35c1a7SPeter Klausler     } else {
88873f081eSDiana Picus       return value <= std::numeric_limits<Fortran::runtime::CppTypeFor<
89873f081eSDiana Picus                           Fortran::common::TypeCategory::Integer, KIND>>::max();
90873f081eSDiana Picus     }
911c35c1a7SPeter Klausler   }
92873f081eSDiana Picus };
93873f081eSDiana Picus 
94eb7a02eaSDiana Picus static bool FitsInDescriptor(
95eb7a02eaSDiana Picus     const Descriptor *length, std::int64_t value, Terminator &terminator) {
96eb7a02eaSDiana Picus   auto typeCode{length->type().GetCategoryAndKind()};
97eb7a02eaSDiana Picus   int kind{typeCode->second};
98eb7a02eaSDiana Picus   return Fortran::runtime::ApplyIntegerKind<FitsInIntegerKind, bool>(
99eb7a02eaSDiana Picus       kind, terminator, value);
100eb7a02eaSDiana Picus }
101eb7a02eaSDiana Picus 
102eb7a02eaSDiana Picus std::int32_t RTNAME(GetCommandArgument)(std::int32_t n, const Descriptor *value,
103873f081eSDiana Picus     const Descriptor *length, const Descriptor *errmsg, const char *sourceFile,
104873f081eSDiana Picus     int line) {
105873f081eSDiana Picus   Terminator terminator{sourceFile, line};
106873f081eSDiana Picus 
107eb7a02eaSDiana Picus   if (value) {
108eb7a02eaSDiana Picus     RUNTIME_CHECK(terminator, IsValidCharDescriptor(value));
109eb7a02eaSDiana Picus     FillWithSpaces(*value);
110eb7a02eaSDiana Picus   }
111eb7a02eaSDiana Picus 
112eb7a02eaSDiana Picus   // Store 0 in case we error out later on.
113eb7a02eaSDiana Picus   if (length) {
114eb7a02eaSDiana Picus     RUNTIME_CHECK(terminator, IsValidIntDescriptor(length));
115e2b896aaSYi Wu     StoreIntToDescriptor(length, 0, terminator);
116eb7a02eaSDiana Picus   }
117eb7a02eaSDiana Picus 
118eb7a02eaSDiana Picus   if (n < 0 || n >= executionEnvironment.argc) {
119eb7a02eaSDiana Picus     return ToErrmsg(errmsg, StatInvalidArgumentNumber);
120eb7a02eaSDiana Picus   }
121eb7a02eaSDiana Picus 
122eb7a02eaSDiana Picus   const char *arg{executionEnvironment.argv[n]};
123eb7a02eaSDiana Picus   std::int64_t argLen{StringLength(arg)};
124eb7a02eaSDiana Picus   if (argLen <= 0) {
125eb7a02eaSDiana Picus     return ToErrmsg(errmsg, StatMissingArgument);
126eb7a02eaSDiana Picus   }
127eb7a02eaSDiana Picus 
128eb7a02eaSDiana Picus   if (length && FitsInDescriptor(length, argLen, terminator)) {
129e2b896aaSYi Wu     StoreIntToDescriptor(length, argLen, terminator);
130eb7a02eaSDiana Picus   }
131eb7a02eaSDiana Picus 
132eb7a02eaSDiana Picus   if (value) {
133e2b896aaSYi Wu     return CopyCharsToDescriptor(*value, arg, argLen, errmsg);
134eb7a02eaSDiana Picus   }
135eb7a02eaSDiana Picus 
136eb7a02eaSDiana Picus   return StatOk;
137eb7a02eaSDiana Picus }
138eb7a02eaSDiana Picus 
139eb7a02eaSDiana Picus std::int32_t RTNAME(GetCommand)(const Descriptor *value,
140eb7a02eaSDiana Picus     const Descriptor *length, const Descriptor *errmsg, const char *sourceFile,
141eb7a02eaSDiana Picus     int line) {
142eb7a02eaSDiana Picus   Terminator terminator{sourceFile, line};
143873f081eSDiana Picus 
144873f081eSDiana Picus   if (value) {
145873f081eSDiana Picus     RUNTIME_CHECK(terminator, IsValidCharDescriptor(value));
146873f081eSDiana Picus   }
147873f081eSDiana Picus 
148873f081eSDiana Picus   // Store 0 in case we error out later on.
149873f081eSDiana Picus   if (length) {
150873f081eSDiana Picus     RUNTIME_CHECK(terminator, IsValidIntDescriptor(length));
151e2b896aaSYi Wu     StoreIntToDescriptor(length, 0, terminator);
152873f081eSDiana Picus   }
153873f081eSDiana Picus 
154873f081eSDiana Picus   auto shouldContinue = [&](std::int32_t stat) -> bool {
155873f081eSDiana Picus     // We continue as long as everything is ok OR the value descriptor is
156873f081eSDiana Picus     // too short, but we still need to compute the length.
157873f081eSDiana Picus     return stat == StatOk || (length && stat == StatValueTooShort);
158873f081eSDiana Picus   };
159873f081eSDiana Picus 
160873f081eSDiana Picus   std::size_t offset{0};
161873f081eSDiana Picus 
162873f081eSDiana Picus   if (executionEnvironment.argc == 0) {
163e2b896aaSYi Wu     return CheckAndCopyCharsToDescriptor(value, "", errmsg, offset);
164873f081eSDiana Picus   }
165873f081eSDiana Picus 
166873f081eSDiana Picus   // value = argv[0]
167e2b896aaSYi Wu   std::int32_t stat{CheckAndCopyCharsToDescriptor(
168873f081eSDiana Picus       value, executionEnvironment.argv[0], errmsg, offset)};
169873f081eSDiana Picus   if (!shouldContinue(stat)) {
170873f081eSDiana Picus     return stat;
171873f081eSDiana Picus   }
172873f081eSDiana Picus 
173873f081eSDiana Picus   // value += " " + argv[1:n]
174873f081eSDiana Picus   for (std::int32_t i{1}; i < executionEnvironment.argc; ++i) {
175e2b896aaSYi Wu     stat = CheckAndCopyCharsToDescriptor(value, " ", errmsg, offset);
176873f081eSDiana Picus     if (!shouldContinue(stat)) {
177873f081eSDiana Picus       return stat;
178873f081eSDiana Picus     }
179873f081eSDiana Picus 
180e2b896aaSYi Wu     stat = CheckAndCopyCharsToDescriptor(
181873f081eSDiana Picus         value, executionEnvironment.argv[i], errmsg, offset);
182873f081eSDiana Picus     if (!shouldContinue(stat)) {
183873f081eSDiana Picus       return stat;
184873f081eSDiana Picus     }
185873f081eSDiana Picus   }
186873f081eSDiana Picus 
187eb7a02eaSDiana Picus   if (length && FitsInDescriptor(length, offset, terminator)) {
188e2b896aaSYi Wu     StoreIntToDescriptor(length, offset, terminator);
189873f081eSDiana Picus   }
190873f081eSDiana Picus 
191873f081eSDiana Picus   // value += spaces for padding
192873f081eSDiana Picus   if (value) {
193873f081eSDiana Picus     FillWithSpaces(*value, offset);
194873f081eSDiana Picus   }
195873f081eSDiana Picus 
196873f081eSDiana Picus   return stat;
197873f081eSDiana Picus }
198873f081eSDiana Picus 
199fc2ba5e5SDiana Picus static std::size_t LengthWithoutTrailingSpaces(const Descriptor &d) {
2005b4c3506SKrzysztof Parzyszek   std::size_t s{d.ElementBytes()}; // This can be 0.
2015b4c3506SKrzysztof Parzyszek   while (s != 0 && *d.OffsetElement(s - 1) == ' ') {
202fc2ba5e5SDiana Picus     --s;
203fc2ba5e5SDiana Picus   }
2045b4c3506SKrzysztof Parzyszek   return s;
205fc2ba5e5SDiana Picus }
206fc2ba5e5SDiana Picus 
20748b5a06dSLeandro Lupori std::int32_t RTNAME(GetEnvVariable)(const Descriptor &name,
20848b5a06dSLeandro Lupori     const Descriptor *value, const Descriptor *length, bool trim_name,
20948b5a06dSLeandro Lupori     const Descriptor *errmsg, const char *sourceFile, int line) {
210824bf908SDiana Picus   Terminator terminator{sourceFile, line};
2119df0ba59SDiana Picus 
21248b5a06dSLeandro Lupori   if (value) {
21348b5a06dSLeandro Lupori     RUNTIME_CHECK(terminator, IsValidCharDescriptor(value));
214873f081eSDiana Picus     FillWithSpaces(*value);
2159df0ba59SDiana Picus   }
2169df0ba59SDiana Picus 
21748b5a06dSLeandro Lupori   // Store 0 in case we error out later on.
21848b5a06dSLeandro Lupori   if (length) {
21948b5a06dSLeandro Lupori     RUNTIME_CHECK(terminator, IsValidIntDescriptor(length));
220e2b896aaSYi Wu     StoreIntToDescriptor(length, 0, terminator);
22148b5a06dSLeandro Lupori   }
22248b5a06dSLeandro Lupori 
22348b5a06dSLeandro Lupori   const char *rawValue{nullptr};
22448b5a06dSLeandro Lupori   std::size_t nameLength{
22548b5a06dSLeandro Lupori       trim_name ? LengthWithoutTrailingSpaces(name) : name.ElementBytes()};
22648b5a06dSLeandro Lupori   if (nameLength != 0) {
22748b5a06dSLeandro Lupori     rawValue = executionEnvironment.GetEnv(
22848b5a06dSLeandro Lupori         name.OffsetElement(), nameLength, terminator);
22948b5a06dSLeandro Lupori   }
2309df0ba59SDiana Picus   if (!rawValue) {
2319df0ba59SDiana Picus     return ToErrmsg(errmsg, StatMissingEnvVariable);
2329df0ba59SDiana Picus   }
2339df0ba59SDiana Picus 
23448b5a06dSLeandro Lupori   std::int64_t varLen{StringLength(rawValue)};
23548b5a06dSLeandro Lupori   if (length && FitsInDescriptor(length, varLen, terminator)) {
236e2b896aaSYi Wu     StoreIntToDescriptor(length, varLen, terminator);
2379df0ba59SDiana Picus   }
2389df0ba59SDiana Picus 
23948b5a06dSLeandro Lupori   if (value) {
240e2b896aaSYi Wu     return CopyCharsToDescriptor(*value, rawValue, varLen, errmsg);
24148b5a06dSLeandro Lupori   }
2429df0ba59SDiana Picus   return StatOk;
2439df0ba59SDiana Picus }
2449df0ba59SDiana Picus 
24568413219Sjiajie zhang std::int32_t RTNAME(GetCwd)(
24668413219Sjiajie zhang     const Descriptor &cwd, const char *sourceFile, int line) {
24768413219Sjiajie zhang   Terminator terminator{sourceFile, line};
24868413219Sjiajie zhang 
24968413219Sjiajie zhang   RUNTIME_CHECK(terminator, IsValidCharDescriptor(&cwd));
25068413219Sjiajie zhang 
25168413219Sjiajie zhang   char *buf{(char *)AllocateMemoryOrCrash(terminator, PATH_MAX)};
25268413219Sjiajie zhang 
25368413219Sjiajie zhang   if (!getcwd(buf, PATH_MAX)) {
25468413219Sjiajie zhang     return StatMissingCurrentWorkDirectory;
25568413219Sjiajie zhang   }
25668413219Sjiajie zhang 
25768413219Sjiajie zhang   std::int64_t strLen{StringLength(buf)};
25868413219Sjiajie zhang   std::int32_t status{CopyCharsToDescriptor(cwd, buf, strLen)};
25968413219Sjiajie zhang 
26068413219Sjiajie zhang   std::free(buf);
26168413219Sjiajie zhang   return status;
26268413219Sjiajie zhang }
26368413219Sjiajie zhang 
2640c375296SDiana Picus } // namespace Fortran::runtime
265