1651f58bfSDiana Picus //===-- runtime/environment.cpp -------------------------------------------===//
2f7be2518Speter klausler //
3f7be2518Speter klausler // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4f7be2518Speter klausler // See https://llvm.org/LICENSE.txt for license information.
5f7be2518Speter klausler // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6f7be2518Speter klausler //
7f7be2518Speter klausler //===----------------------------------------------------------------------===//
8f7be2518Speter klausler 
9f7be2518Speter klausler #include "environment.h"
10824bf908SDiana Picus #include "memory.h"
118f2c5c43Speter klausler #include "tools.h"
1295696d56Speter klausler #include <cstdio>
13f7be2518Speter klausler #include <cstdlib>
148f2c5c43Speter klausler #include <cstring>
15f7be2518Speter klausler #include <limits>
16f7be2518Speter klausler 
17f7be2518Speter klausler namespace Fortran::runtime {
188f2c5c43Speter klausler 
19f7be2518Speter klausler ExecutionEnvironment executionEnvironment;
20f7be2518Speter klausler 
GetConvertFromString(const char * x,std::size_t n)218f2c5c43Speter klausler std::optional<Convert> GetConvertFromString(const char *x, std::size_t n) {
228f2c5c43Speter klausler   static const char *keywords[]{
238f2c5c43Speter klausler       "UNKNOWN", "NATIVE", "LITTLE_ENDIAN", "BIG_ENDIAN", "SWAP", nullptr};
248f2c5c43Speter klausler   switch (IdentifyValue(x, n, keywords)) {
258f2c5c43Speter klausler   case 0:
268f2c5c43Speter klausler     return Convert::Unknown;
278f2c5c43Speter klausler   case 1:
288f2c5c43Speter klausler     return Convert::Native;
298f2c5c43Speter klausler   case 2:
308f2c5c43Speter klausler     return Convert::LittleEndian;
318f2c5c43Speter klausler   case 3:
328f2c5c43Speter klausler     return Convert::BigEndian;
338f2c5c43Speter klausler   case 4:
348f2c5c43Speter klausler     return Convert::Swap;
358f2c5c43Speter klausler   default:
368f2c5c43Speter klausler     return std::nullopt;
378f2c5c43Speter klausler   }
388f2c5c43Speter klausler }
398f2c5c43Speter klausler 
Configure(int ac,const char * av[],const char * env[])40f7be2518Speter klausler void ExecutionEnvironment::Configure(
41f7be2518Speter klausler     int ac, const char *av[], const char *env[]) {
42f7be2518Speter klausler   argc = ac;
43f7be2518Speter klausler   argv = av;
44f7be2518Speter klausler   envp = env;
45f7be2518Speter klausler   listDirectedOutputLineLengthLimit = 79; // PGI default
4695696d56Speter klausler   defaultOutputRoundingMode =
4795696d56Speter klausler       decimal::FortranRounding::RoundNearest; // RP(==RN)
488f2c5c43Speter klausler   conversion = Convert::Unknown;
49f7be2518Speter klausler 
50f7be2518Speter klausler   if (auto *x{std::getenv("FORT_FMT_RECL")}) {
51f7be2518Speter klausler     char *end;
52f7be2518Speter klausler     auto n{std::strtol(x, &end, 10)};
53f7be2518Speter klausler     if (n > 0 && n < std::numeric_limits<int>::max() && *end == '\0') {
54f7be2518Speter klausler       listDirectedOutputLineLengthLimit = n;
55f7be2518Speter klausler     } else {
56f7be2518Speter klausler       std::fprintf(
57f7be2518Speter klausler           stderr, "Fortran runtime: FORT_FMT_RECL=%s is invalid; ignored\n", x);
58f7be2518Speter klausler     }
59f7be2518Speter klausler   }
60f7be2518Speter klausler 
618f2c5c43Speter klausler   if (auto *x{std::getenv("FORT_CONVERT")}) {
628f2c5c43Speter klausler     if (auto convert{GetConvertFromString(x, std::strlen(x))}) {
638f2c5c43Speter klausler       conversion = *convert;
648f2c5c43Speter klausler     } else {
658f2c5c43Speter klausler       std::fprintf(
668f2c5c43Speter klausler           stderr, "Fortran runtime: FORT_CONVERT=%s is invalid; ignored\n", x);
678f2c5c43Speter klausler     }
688f2c5c43Speter klausler   }
698f2c5c43Speter klausler 
704a0af824SPeter Klausler   if (auto *x{std::getenv("NO_STOP_MESSAGE")}) {
714a0af824SPeter Klausler     char *end;
724a0af824SPeter Klausler     auto n{std::strtol(x, &end, 10)};
734a0af824SPeter Klausler     if (n >= 0 && n <= 1 && *end == '\0') {
744a0af824SPeter Klausler       noStopMessage = n != 0;
754a0af824SPeter Klausler     } else {
764a0af824SPeter Klausler       std::fprintf(stderr,
774a0af824SPeter Klausler           "Fortran runtime: NO_STOP_MESSAGE=%s is invalid; ignored\n", x);
784a0af824SPeter Klausler     }
794a0af824SPeter Klausler   }
804a0af824SPeter Klausler 
81*bafbae23SPeter Klausler   if (auto *x{std::getenv("DEFAULT_UTF8")}) {
82*bafbae23SPeter Klausler     char *end;
83*bafbae23SPeter Klausler     auto n{std::strtol(x, &end, 10)};
84*bafbae23SPeter Klausler     if (n >= 0 && n <= 1 && *end == '\0') {
85*bafbae23SPeter Klausler       defaultUTF8 = n != 0;
86*bafbae23SPeter Klausler     } else {
87*bafbae23SPeter Klausler       std::fprintf(
88*bafbae23SPeter Klausler           stderr, "Fortran runtime: DEFAULT_UTF8=%s is invalid; ignored\n", x);
89*bafbae23SPeter Klausler     }
90*bafbae23SPeter Klausler   }
91*bafbae23SPeter Klausler 
92f7be2518Speter klausler   // TODO: Set RP/ROUND='PROCESSOR_DEFINED' from environment
93f7be2518Speter klausler }
94fc2ba5e5SDiana Picus 
GetEnv(const char * name,std::size_t name_length,const Terminator & terminator)95fc2ba5e5SDiana Picus const char *ExecutionEnvironment::GetEnv(
96824bf908SDiana Picus     const char *name, std::size_t name_length, const Terminator &terminator) {
97824bf908SDiana Picus   RUNTIME_CHECK(terminator, name && name_length);
98fc2ba5e5SDiana Picus 
99824bf908SDiana Picus   OwningPtr<char> cStyleName{
100824bf908SDiana Picus       SaveDefaultCharacter(name, name_length, terminator)};
101824bf908SDiana Picus   RUNTIME_CHECK(terminator, cStyleName);
102824bf908SDiana Picus 
103824bf908SDiana Picus   return std::getenv(cStyleName.get());
104fc2ba5e5SDiana Picus }
1051f879005STim Keith } // namespace Fortran::runtime
106