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