flang/runtime/command.cpp

   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 static bool IsValidCharDescriptor(const Descriptor *value) {
  41   return value && value->IsAllocated() &&
  42       value->type() == TypeCode(TypeCategory::Character, 1) &&
  43       value->rank() == 0;
  44 }
  45
  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;
  52 }
  53
  54 static void FillWithSpaces(const Descriptor &value, std::size_t offset = 0) {
  55   if (offset < value.ElementBytes()) {
  56     std::memset(
  57         value.OffsetElement(offset), ' ', value.ElementBytes() - offset);
  58   }
  59 }
  60
  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) {
  64
  65   std::int64_t toCopy{std::min(rawValueLength,
  66       static_cast<std::int64_t>(value.ElementBytes() - offset))};
  67   if (toCopy < 0) {
  68     return ToErrmsg(errmsg, StatValueTooShort);
  69   }
  70
  71   std::memcpy(value.OffsetElement(offset), rawValue, toCopy);
  72
  73   if (rawValueLength > toCopy) {
  74     return ToErrmsg(errmsg, StatValueTooShort);
  75   }
  76
  77   return StatOk;
  78 }
  79
  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)};
  83
  84   std::int64_t len{StringLength(rawValue)};
  85   if (len <= 0) {
  86     if (haveValue) {
  87       FillWithSpaces(*value);
  88     }
  89     return ToErrmsg(errmsg, StatMissingArgument);
  90   }
  91
  92   std::int32_t stat{StatOk};
  93   if (haveValue) {
  94     stat = CopyToDescriptor(*value, rawValue, len, errmsg, offset);
  95   }
  96
  97   offset += len;
  98   return stat;
  99 }
 100
 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);
 107 }
 108
 109 template <int KIND> struct FitsInIntegerKind {
 110   bool operator()([[maybe_unused]] std::int64_t value) {
 111     if constexpr (KIND >= 8) {
 112       return true;
 113     } else {
 114       return value <= std::numeric_limits<Fortran::runtime::CppTypeFor<
 115                           Fortran::common::TypeCategory::Integer, KIND>>::max();
 116     }
 117   }
 118 };
 119
 120 static bool FitsInDescriptor(
 121     const Descriptor *length, std::int64_t value, Terminator &terminator) {
 122   auto typeCode{length->type().GetCategoryAndKind()};
 123   int kind{typeCode->second};
 124   return Fortran::runtime::ApplyIntegerKind<FitsInIntegerKind, bool>(
 125       kind, terminator, value);
 126 }
 127
 128 std::int32_t RTNAME(GetCommandArgument)(std::int32_t n, const Descriptor *value,
 129     const Descriptor *length, const Descriptor *errmsg, const char *sourceFile,
 130     int line) {
 131   Terminator terminator{sourceFile, line};
 132
 133   if (value) {
 134     RUNTIME_CHECK(terminator, IsValidCharDescriptor(value));
 135     FillWithSpaces(*value);
 136   }
 137
 138   // Store 0 in case we error out later on.
 139   if (length) {
 140     RUNTIME_CHECK(terminator, IsValidIntDescriptor(length));
 141     StoreLengthToDescriptor(length, 0, terminator);
 142   }
 143
 144   if (n < 0 || n >= executionEnvironment.argc) {
 145     return ToErrmsg(errmsg, StatInvalidArgumentNumber);
 146   }
 147
 148   const char *arg{executionEnvironment.argv[n]};
 149   std::int64_t argLen{StringLength(arg)};
 150   if (argLen <= 0) {
 151     return ToErrmsg(errmsg, StatMissingArgument);
 152   }
 153
 154   if (length && FitsInDescriptor(length, argLen, terminator)) {
 155     StoreLengthToDescriptor(length, argLen, terminator);
 156   }
 157
 158   if (value) {
 159     return CopyToDescriptor(*value, arg, argLen, errmsg);
 160   }
 161
 162   return StatOk;
 163 }
 164
 165 std::int32_t RTNAME(GetCommand)(const Descriptor *value,
 166     const Descriptor *length, const Descriptor *errmsg, const char *sourceFile,
 167     int line) {
 168   Terminator terminator{sourceFile, line};
 169
 170   if (value) {
 171     RUNTIME_CHECK(terminator, IsValidCharDescriptor(value));
 172   }
 173
 174   // Store 0 in case we error out later on.
 175   if (length) {
 176     RUNTIME_CHECK(terminator, IsValidIntDescriptor(length));
 177     StoreLengthToDescriptor(length, 0, terminator);
 178   }
 179
 180   auto shouldContinue = [&](std::int32_t stat) -> bool {
 181     // We continue as long as everything is ok OR the value descriptor is
 182     // too short, but we still need to compute the length.
 183     return stat == StatOk || (length && stat == StatValueTooShort);
 184   };
 185
 186   std::size_t offset{0};
 187
 188   if (executionEnvironment.argc == 0) {
 189     return CheckAndCopyToDescriptor(value, "", errmsg, offset);
 190   }
 191
 192   // value = argv[0]
 193   std::int32_t stat{CheckAndCopyToDescriptor(
 194       value, executionEnvironment.argv[0], errmsg, offset)};
 195   if (!shouldContinue(stat)) {
 196     return stat;
 197   }
 198
 199   // value += " " + argv[1:n]
 200   for (std::int32_t i{1}; i < executionEnvironment.argc; ++i) {
 201     stat = CheckAndCopyToDescriptor(value, " ", errmsg, offset);
 202     if (!shouldContinue(stat)) {
 203       return stat;
 204     }
 205
 206     stat = CheckAndCopyToDescriptor(
 207         value, executionEnvironment.argv[i], errmsg, offset);
 208     if (!shouldContinue(stat)) {
 209       return stat;
 210     }
 211   }
 212
 213   if (length && FitsInDescriptor(length, offset, terminator)) {
 214     StoreLengthToDescriptor(length, offset, terminator);
 215   }
 216
 217   // value += spaces for padding
 218   if (value) {
 219     FillWithSpaces(*value, offset);
 220   }
 221
 222   return stat;
 223 }
 224
 225 static std::size_t LengthWithoutTrailingSpaces(const Descriptor &d) {
 226   std::size_t s{d.ElementBytes() - 1};
 227   while (*d.OffsetElement(s) == ' ') {
 228     --s;
 229   }
 230   return s + 1;
 231 }
 232
 233 std::int32_t RTNAME(GetEnvVariable)(const Descriptor &name,
 234     const Descriptor *value, const Descriptor *length, bool trim_name,
 235     const Descriptor *errmsg, const char *sourceFile, int line) {
 236   Terminator terminator{sourceFile, line};
 237
 238   if (value) {
 239     RUNTIME_CHECK(terminator, IsValidCharDescriptor(value));
 240     FillWithSpaces(*value);
 241   }
 242
 243   // Store 0 in case we error out later on.
 244   if (length) {
 245     RUNTIME_CHECK(terminator, IsValidIntDescriptor(length));
 246     StoreLengthToDescriptor(length, 0, terminator);
 247   }
 248
 249   const char *rawValue{nullptr};
 250   std::size_t nameLength{
 251       trim_name ? LengthWithoutTrailingSpaces(name) : name.ElementBytes()};
 252   if (nameLength != 0) {
 253     rawValue = executionEnvironment.GetEnv(
 254         name.OffsetElement(), nameLength, terminator);
 255   }
 256   if (!rawValue) {
 257     return ToErrmsg(errmsg, StatMissingEnvVariable);
 258   }
 259
 260   std::int64_t varLen{StringLength(rawValue)};
 261   if (length && FitsInDescriptor(length, varLen, terminator)) {
 262     StoreLengthToDescriptor(length, varLen, terminator);
 263   }
 264
 265   if (value) {
 266     return CopyToDescriptor(*value, rawValue, varLen, errmsg);
 267   }
 268   return StatOk;
 269 }
 270
 271 } // namespace Fortran::runtime