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