flang/runtime/environment.cpp

   1 //===-- runtime/environment.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 "environment.h"
  10 #include "environment-default-list.h"
  11 #include "memory.h"
  12 #include "tools.h"
  13 #include <cstdio>
  14 #include <cstdlib>
  15 #include <cstring>
  16 #include <limits>
  17
  18 #ifdef _WIN32
  19 extern char **_environ;
  20 #else
  21 extern char **environ;
  22 #endif
  23
  24 namespace Fortran::runtime {
  25
  26 #ifndef FLANG_RUNTIME_NO_GLOBAL_VAR_DEFS
  27 RT_OFFLOAD_VAR_GROUP_BEGIN
  28 RT_VAR_ATTRS ExecutionEnvironment executionEnvironment;
  29 RT_OFFLOAD_VAR_GROUP_END
  30 #endif // FLANG_RUNTIME_NO_GLOBAL_VAR_DEFS
  31
  32 static void SetEnvironmentDefaults(const EnvironmentDefaultList *envDefaults) {
  33   if (!envDefaults) {
  34     return;
  35   }
  36
  37   for (int itemIndex = 0; itemIndex < envDefaults->numItems; ++itemIndex) {
  38     const char *name = envDefaults->item[itemIndex].name;
  39     const char *value = envDefaults->item[itemIndex].value;
  40 #ifdef _WIN32
  41     if (auto *x{std::getenv(name)}) {
  42       continue;
  43     }
  44     if (_putenv_s(name, value) != 0) {
  45 #else
  46     if (setenv(name, value, /*overwrite=*/0) == -1) {
  47 #endif
  48       Fortran::runtime::Terminator{__FILE__, __LINE__}.Crash(
  49           std::strerror(errno));
  50     }
  51   }
  52 }
  53
  54 RT_OFFLOAD_API_GROUP_BEGIN
  55 Fortran::common::optional<Convert> GetConvertFromString(
  56     const char *x, std::size_t n) {
  57   static const char *keywords[]{
  58       "UNKNOWN", "NATIVE", "LITTLE_ENDIAN", "BIG_ENDIAN", "SWAP", nullptr};
  59   switch (IdentifyValue(x, n, keywords)) {
  60   case 0:
  61     return Convert::Unknown;
  62   case 1:
  63     return Convert::Native;
  64   case 2:
  65     return Convert::LittleEndian;
  66   case 3:
  67     return Convert::BigEndian;
  68   case 4:
  69     return Convert::Swap;
  70   default:
  71     return Fortran::common::nullopt;
  72   }
  73 }
  74 RT_OFFLOAD_API_GROUP_END
  75
  76 void ExecutionEnvironment::Configure(int ac, const char *av[],
  77     const char *env[], const EnvironmentDefaultList *envDefaults) {
  78   argc = ac;
  79   argv = av;
  80   SetEnvironmentDefaults(envDefaults);
  81 #ifdef _WIN32
  82   envp = _environ;
  83 #else
  84   envp = environ;
  85 #endif
  86   listDirectedOutputLineLengthLimit = 79; // PGI default
  87   defaultOutputRoundingMode =
  88       decimal::FortranRounding::RoundNearest; // RP(==RN)
  89   conversion = Convert::Unknown;
  90
  91   if (auto *x{std::getenv("FORT_FMT_RECL")}) {
  92     char *end;
  93     auto n{std::strtol(x, &end, 10)};
  94     if (n > 0 && n < std::numeric_limits<int>::max() && *end == '\0') {
  95       listDirectedOutputLineLengthLimit = n;
  96     } else {
  97       std::fprintf(
  98           stderr, "Fortran runtime: FORT_FMT_RECL=%s is invalid; ignored\n", x);
  99     }
 100   }
 101
 102   if (auto *x{std::getenv("FORT_CONVERT")}) {
 103     if (auto convert{GetConvertFromString(x, std::strlen(x))}) {
 104       conversion = *convert;
 105     } else {
 106       std::fprintf(
 107           stderr, "Fortran runtime: FORT_CONVERT=%s is invalid; ignored\n", x);
 108     }
 109   }
 110
 111   if (auto *x{std::getenv("NO_STOP_MESSAGE")}) {
 112     char *end;
 113     auto n{std::strtol(x, &end, 10)};
 114     if (n >= 0 && n <= 1 && *end == '\0') {
 115       noStopMessage = n != 0;
 116     } else {
 117       std::fprintf(stderr,
 118           "Fortran runtime: NO_STOP_MESSAGE=%s is invalid; ignored\n", x);
 119     }
 120   }
 121
 122   if (auto *x{std::getenv("DEFAULT_UTF8")}) {
 123     char *end;
 124     auto n{std::strtol(x, &end, 10)};
 125     if (n >= 0 && n <= 1 && *end == '\0') {
 126       defaultUTF8 = n != 0;
 127     } else {
 128       std::fprintf(
 129           stderr, "Fortran runtime: DEFAULT_UTF8=%s is invalid; ignored\n", x);
 130     }
 131   }
 132
 133   if (auto *x{std::getenv("FORT_CHECK_POINTER_DEALLOCATION")}) {
 134     char *end;
 135     auto n{std::strtol(x, &end, 10)};
 136     if (n >= 0 && n <= 1 && *end == '\0') {
 137       checkPointerDeallocation = n != 0;
 138     } else {
 139       std::fprintf(stderr,
 140           "Fortran runtime: FORT_CHECK_POINTER_DEALLOCATION=%s is invalid; "
 141           "ignored\n",
 142           x);
 143     }
 144   }
 145
 146   // TODO: Set RP/ROUND='PROCESSOR_DEFINED' from environment
 147 }
 148
 149 const char *ExecutionEnvironment::GetEnv(
 150     const char *name, std::size_t name_length, const Terminator &terminator) {
 151   RUNTIME_CHECK(terminator, name && name_length);
 152
 153   OwningPtr<char> cStyleName{
 154       SaveDefaultCharacter(name, name_length, terminator)};
 155   RUNTIME_CHECK(terminator, cStyleName);
 156
 157   return std::getenv(cStyleName.get());
 158 }
 159 } // namespace Fortran::runtime