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