diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Command.h b/flang/include/flang/Optimizer/Builder/Runtime/Command.h --- a/flang/include/flang/Optimizer/Builder/Runtime/Command.h +++ b/flang/include/flang/Optimizer/Builder/Runtime/Command.h @@ -32,5 +32,14 @@ mlir::Value length, mlir::Value status, mlir::Value errmsg); +/// Generate call to GET_ENVIRONMENT_VARIABLE intrinsic runtime routine. +/// Note that GET_ENVIRONMENT_ARGUMENT intrinsic is split between 2 functions in +/// implementation; EnvVariableValue and EnvVariableLength. So we handle each +/// seperately. +void genGetEnvironmentVariable(fir::FirOpBuilder &, mlir::Location, + mlir::Value number, mlir::Value value, + mlir::Value length, mlir::Value status, + mlir::Value trimName, mlir::Value errmsg); + } // namespace fir::runtime #endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_COMMAND_H diff --git a/flang/lib/Optimizer/Builder/Runtime/Command.cpp b/flang/lib/Optimizer/Builder/Runtime/Command.cpp --- a/flang/lib/Optimizer/Builder/Runtime/Command.cpp +++ b/flang/lib/Optimizer/Builder/Runtime/Command.cpp @@ -13,6 +13,18 @@ using namespace Fortran::runtime; +// Certain runtime intrinsics should only be run when select parameters of the +// intrisic are supplied. In certain cases one of these parameters may not be +// given, however the intrinsic needs to be run due to another required +// parameter being supplied. In this case the missing parameter is assigned to +// have an "absent" value. This typically happens in IntrinsicCall.cpp. For this +// reason the extra indirection with `isAbsent` is needed for testing whether a +// given parameter is actually present (so that parameters with "value" absent +// are not considered as present). +inline bool isAbsent(mlir::Value val) { + return mlir::isa_and_nonnull(val.getDefiningOp()); +} + mlir::Value fir::runtime::genCommandArgumentCount(fir::FirOpBuilder &builder, mlir::Location loc) { auto argumentCountFunc = @@ -30,26 +42,17 @@ auto argumentLengthFunc = fir::runtime::getRuntimeFunc(loc, builder); - auto isPresent = [&](mlir::Value val) -> bool { - return !mlir::isa_and_nonnull(val.getDefiningOp()); - }; - mlir::Value valueResult; - // Run `ArgumentValue` intrisc only if we have either "value", "status" or - // "errmsg" `ArgumentValue` "requires" existing values for its arguments - // "value" and "errmsg". So in the case they aren't given, but the user has - // requested "status", we have to assign "absent" values to them before - // calling `ArgumentValue`. This happens in IntrinsicCall.cpp. For this reason - // we need extra indirection with `isPresent` for testing whether "value" or - // "errmsg" is present. - if (isPresent(value) || status || isPresent(errmsg)) { + // Run `ArgumentValue` intrinsic only if we have a "value" in either "VALUE", + // "STATUS" or "ERRMSG" parameters. + if (!isAbsent(value) || status || !isAbsent(errmsg)) { llvm::SmallVector args = fir::runtime::createArguments( builder, loc, argumentValueFunc.getType(), number, value, errmsg); valueResult = builder.create(loc, argumentValueFunc, args).getResult(0); } - // Only save result of ArgumentValue if "status" parameter has been given + // Only save result of `ArgumentValue` if "STATUS" parameter has been given if (status) { const mlir::Value statusLoaded = builder.create(loc, status); mlir::Value resultCast = @@ -57,6 +60,7 @@ builder.create(loc, resultCast, status); } + // Only run `ArgumentLength` intrinsic if "LENGTH" parameter provided if (length) { llvm::SmallVector args = fir::runtime::createArguments( builder, loc, argumentLengthFunc.getType(), number); @@ -68,3 +72,55 @@ builder.create(loc, resultCast, length); } } + +void fir::runtime::genGetEnvironmentVariable( + fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value name, + mlir::Value value, mlir::Value length, mlir::Value status, + mlir::Value trimName, mlir::Value errmsg) { + auto valueFunc = + fir::runtime::getRuntimeFunc(loc, builder); + auto lengthFunc = + fir::runtime::getRuntimeFunc(loc, builder); + + mlir::Value sourceFile; + mlir::Value sourceLine; + // We only need `sourceFile` and `sourceLine` variables when calling either + // `EnvVariableValue` or `EnvVariableLength` below. + if (!isAbsent(value) || status || !isAbsent(errmsg) || length) { + sourceFile = fir::factory::locationToFilename(builder, loc); + sourceLine = fir::factory::locationToLineNo( + builder, loc, valueFunc.getType().getInput(5)); + } + + mlir::Value valueResult; + // Run `EnvVariableValue` intrinsic only if we have a "value" in either + // "VALUE", "STATUS" or "ERRMSG" parameters. + if (!isAbsent(value) || status || !isAbsent(errmsg)) { + llvm::SmallVector args = fir::runtime::createArguments( + builder, loc, valueFunc.getType(), name, value, trimName, errmsg, + sourceFile, sourceLine); + valueResult = + builder.create(loc, valueFunc, args).getResult(0); + } + + // Only save result of `EnvVariableValue` if "STATUS" parameter provided + if (status) { + const mlir::Value statusLoaded = builder.create(loc, status); + mlir::Value resultCast = + builder.createConvert(loc, statusLoaded.getType(), valueResult); + builder.create(loc, resultCast, status); + } + + // Only run `EnvVariableLength` intrinsic if "LENGTH" parameter provided + if (length) { + llvm::SmallVector args = + fir::runtime::createArguments(builder, loc, lengthFunc.getType(), name, + trimName, sourceFile, sourceLine); + mlir::Value result = + builder.create(loc, lengthFunc, args).getResult(0); + const mlir::Value lengthLoaded = builder.create(loc, length); + mlir::Value resultCast = + builder.createConvert(loc, lengthLoaded.getType(), result); + builder.create(loc, resultCast, length); + } +} diff --git a/flang/unittests/Optimizer/Builder/Runtime/CommandTest.cpp b/flang/unittests/Optimizer/Builder/Runtime/CommandTest.cpp --- a/flang/unittests/Optimizer/Builder/Runtime/CommandTest.cpp +++ b/flang/unittests/Optimizer/Builder/Runtime/CommandTest.cpp @@ -36,3 +36,24 @@ EXPECT_TRUE(block) << "Failed to retrieve the block!"; checkBlockForCallOp(block, "_FortranAArgumentLength", /*nbArgs=*/1); } + +TEST_F(RuntimeCallTest, genGetEnvironmentVariable) { + mlir::Location loc = firBuilder->getUnknownLoc(); + mlir::Type intTy = firBuilder->getDefaultIntegerType(); + mlir::Type charTy = fir::BoxType::get(firBuilder->getNoneType()); + mlir::Value number = firBuilder->create(loc, intTy); + mlir::Value value = firBuilder->create(loc, charTy); + mlir::Value trimName = firBuilder->create(loc, i1Ty); + mlir::Value errmsg = firBuilder->create(loc, charTy); + // genGetCommandArgument expects `length` and `status` to be memory references + mlir::Value length = firBuilder->create(loc, intTy); + mlir::Value status = firBuilder->create(loc, intTy); + + fir::runtime::genGetEnvironmentVariable( + *firBuilder, loc, number, value, length, status, trimName, errmsg); + checkCallOpFromResultBox( + value, "_FortranAEnvVariableValue", /*nbArgs=*/6, /*addLocArgs=*/false); + mlir::Block *block = firBuilder->getBlock(); + EXPECT_TRUE(block) << "Failed to retrieve the block!"; + checkBlockForCallOp(block, "_FortranAEnvVariableLength", /*nbArgs=*/4); +} diff --git a/flang/unittests/Optimizer/Builder/Runtime/RuntimeCallTestBase.h b/flang/unittests/Optimizer/Builder/Runtime/RuntimeCallTestBase.h --- a/flang/unittests/Optimizer/Builder/Runtime/RuntimeCallTestBase.h +++ b/flang/unittests/Optimizer/Builder/Runtime/RuntimeCallTestBase.h @@ -33,6 +33,7 @@ kindMap = std::make_unique(&context); firBuilder = std::make_unique(mod, *kindMap); + i1Ty = firBuilder->getI1Type(); i8Ty = firBuilder->getI8Type(); i16Ty = firBuilder->getIntegerType(16); i32Ty = firBuilder->getI32Type(); @@ -58,6 +59,7 @@ std::unique_ptr firBuilder; // Commonly used types + mlir::Type i1Ty; mlir::Type i8Ty; mlir::Type i16Ty; mlir::Type i32Ty;