Index: flang/docs/Extensions.md =================================================================== --- flang/docs/Extensions.md +++ flang/docs/Extensions.md @@ -240,6 +240,9 @@ * The legacy extension intrinsic functions `IZEXT` and `JZEXT` are supported; `ZEXT` has different behavior with various older compilers, so it is not supported. +* The name `IARGC` is accepted as an alias for the generic intrinsic + function `COMMAND_ARGUMENT_COUNT`. +* Intrinsic subroutine GETARG(pos, value). ### Extensions supported when enabled by options Index: flang/docs/Intrinsics.md =================================================================== --- flang/docs/Intrinsics.md +++ flang/docs/Intrinsics.md @@ -625,6 +625,7 @@ CALL GET_COMMAND([COMMAND, LENGTH, STATUS, ERRMSG ]) CALL GET_COMMAND_ARGUMENT(NUMBER [, VALUE, LENGTH, STATUS, ERRMSG ]) CALL GET_ENVIRONMENT_VARIABLE(NAME [, VALUE, LENGTH, STATUS, TRIM_NAME, ERRMSG ]) +CALL GETARG(POS, VALUE) CALL MOVE_ALLOC(ALLOCATABLE INTENT(INOUT) FROM, ALLOCATABLE INTENT(OUT) TO [, STAT, ERRMSG ]) CALL RANDOM_INIT(LOGICAL(k1) INTENT(IN) REPEATABLE, LOGICAL(k2) INTENT(IN) IMAGE_DISTINCT) CALL RANDOM_NUMBER(REAL(k) INTENT(OUT) HARVEST(..)) Index: flang/include/flang/Optimizer/Builder/Runtime/Command.h =================================================================== --- flang/include/flang/Optimizer/Builder/Runtime/Command.h +++ flang/include/flang/Optimizer/Builder/Runtime/Command.h @@ -24,7 +24,7 @@ mlir::Value genCommandArgumentCount(fir::FirOpBuilder &, mlir::Location); /// Generate a call to the GetCommandArgument runtime function which implements -/// the GET_COMMAND_ARGUMENT intrinsic. +/// the GET_COMMAND_ARGUMENT (or GNU extension GETARG) intrinsic. /// \p value, \p length and \p errmsg must be fir.box that can be absent (but /// not null mlir values). The status value is returned. mlir::Value genGetCommandArgument(fir::FirOpBuilder &, mlir::Location, Index: flang/include/flang/Runtime/command.h =================================================================== --- flang/include/flang/Runtime/command.h +++ flang/include/flang/Runtime/command.h @@ -31,7 +31,7 @@ const Descriptor *length = nullptr, const Descriptor *errmsg = nullptr, const char *sourceFile = nullptr, int line = 0); -// 16.9.83 GET_COMMAND_ARGUMENT +// 16.9.83 GET_COMMAND_ARGUMENT (or GNU extension GETARG) // Try to get the value of the n'th argument. // Returns a STATUS as described in the standard. std::int32_t RTNAME(GetCommandArgument)(std::int32_t n, Index: flang/lib/Evaluate/intrinsics.cpp =================================================================== --- flang/lib/Evaluate/intrinsics.cpp +++ flang/lib/Evaluate/intrinsics.cpp @@ -476,10 +476,6 @@ SameInt, Rank::dimReduced, IntrinsicClass::transformationalFunction}, {"iany", {{"array", SameInt, Rank::array}, MissingDIM, OptionalMASK}, SameInt, Rank::scalar, IntrinsicClass::transformationalFunction}, - {"iparity", {{"array", SameInt, Rank::array}, RequiredDIM, OptionalMASK}, - SameInt, Rank::dimReduced, IntrinsicClass::transformationalFunction}, - {"iparity", {{"array", SameInt, Rank::array}, MissingDIM, OptionalMASK}, - SameInt, Rank::scalar, IntrinsicClass::transformationalFunction}, {"iand", {{"i", SameInt}, {"j", SameInt, Rank::elementalOrBOZ}}, SameInt}, {"iand", {{"i", BOZ}, {"j", SameInt}}, SameInt}, {"ibclr", {{"i", SameInt}, {"pos", AnyInt}}, SameInt}, @@ -498,6 +494,10 @@ {"int_ptr_kind", {}, DefaultInt, Rank::scalar}, {"ior", {{"i", SameInt}, {"j", SameInt, Rank::elementalOrBOZ}}, SameInt}, {"ior", {{"i", BOZ}, {"j", SameInt}}, SameInt}, + {"iparity", {{"array", SameInt, Rank::array}, RequiredDIM, OptionalMASK}, + SameInt, Rank::dimReduced, IntrinsicClass::transformationalFunction}, + {"iparity", {{"array", SameInt, Rank::array}, MissingDIM, OptionalMASK}, + SameInt, Rank::scalar, IntrinsicClass::transformationalFunction}, {"ishft", {{"i", SameInt}, {"shift", AnyInt}}, SameInt}, {"ishftc", {{"i", SameInt}, {"shift", AnyInt}, @@ -869,6 +869,7 @@ // compatibility and builtins. static const std::pair genericAlias[]{ {"and", "iand"}, + {"iargc", "command_argument_count"}, {"imag", "aimag"}, {"or", "ior"}, {"xor", "ieor"}, @@ -1153,6 +1154,11 @@ {"errmsg", DefaultChar, Rank::scalar, Optionality::optional, common::Intent::InOut}}, {}, Rank::elemental, IntrinsicClass::impureSubroutine}, + {"getarg", + {{"pos", AnyInt, Rank::scalar}, + {"value", DefaultChar, Rank::scalar, Optionality::required, + common::Intent::Out}}, + {}, Rank::elemental, IntrinsicClass::impureSubroutine}, {"move_alloc", {{"from", SameType, Rank::known, Optionality::required, common::Intent::InOut}, Index: flang/lib/Lower/IntrinsicCall.cpp =================================================================== --- flang/lib/Lower/IntrinsicCall.cpp +++ flang/lib/Lower/IntrinsicCall.cpp @@ -500,6 +500,7 @@ mlir::ArrayRef args); void genGetCommandArgument(mlir::ArrayRef args); void genGetEnvironmentVariable(llvm::ArrayRef); + void genGetArg(llvm::ArrayRef); /// Lowering for the IAND intrinsic. The IAND intrinsic expects two arguments /// in the llvm::ArrayRef. mlir::Value genIand(mlir::Type, llvm::ArrayRef); @@ -801,6 +802,10 @@ {"trim_name", asAddr}, {"errmsg", asBox, handleDynamicOptional}}}, /*isElemental=*/false}, + {"getarg", + &I::genGetArg, + {{{"pos", asValue}, {"value", asBox}}}, + /*isElemental=*/false}, {"iachar", &I::genIchar}, {"iand", &I::genIand}, {"ibclr", &I::genIbclr}, @@ -3084,6 +3089,21 @@ } } +// GETARG +void IntrinsicLibrary::genGetArg(llvm::ArrayRef args) { + assert(args.size() == 2); + mlir::Value pos = fir::getBase(args[0]); + mlir::Value valBox = fir::getBase(args[1]); + + mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType()); + mlir::Value lenBox = + builder.create(loc, boxNoneTy).getResult(); + mlir::Value errBox = + builder.create(loc, boxNoneTy).getResult(); + (void)fir::runtime::genGetCommandArgument(builder, loc, pos, valBox, lenBox, + errBox); +} + // IAND mlir::Value IntrinsicLibrary::genIand(mlir::Type resultType, llvm::ArrayRef args) { Index: flang/test/Lower/Intrinsics/getarg.f90 =================================================================== --- /dev/null +++ flang/test/Lower/Intrinsics/getarg.f90 @@ -0,0 +1,23 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s +! RUN: flang-new -fc1 -emit-fir %s -o - | FileCheck %s + +! CHECK-LABEL: func.func @_QPgetarg_test( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref {fir.bindc_name = "pos"}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.boxchar<1> {fir.bindc_name = "value"}) { +! CHECK: %[[VAL_2:.*]]:2 = fir.unboxchar %[[VAL_1]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK: %[[VAL_3:.*]] = arith.constant 32 : index +! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_0]] : !fir.ref +! CHECK: %[[VAL_5:.*]] = fir.embox %[[VAL_2]]#0 typeparams %[[VAL_3]] : (!fir.ref>, index) -> +! !fir.box> +! CHECK: %[[VAL_6:.*]] = fir.absent !fir.box +! CHECK: %[[VAL_7:.*]] = fir.absent !fir.box +! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_5]] : (!fir.box>) -> !fir.box +! CHECK: %[[VAL_12:.*]] = fir.call @_FortranAGetCommandArgument(%[[VAL_4]], %[[VAL_10]], %[[VAL_6]], %[[VAL_7]], %[[VAL_11:.*]], %[[VAL_9:.*]]) : (i32, !fir.box, !fir.box, !fir.box, !fir.ref, i32) -> i32 +! CHECK: return +! CHECK: } + +subroutine getarg_test(pos, value) + integer :: pos + character(len=32) :: value + call getarg(pos, value) +end subroutine getarg_test Index: flang/test/Lower/Intrinsics/iargc.f90 =================================================================== --- /dev/null +++ flang/test/Lower/Intrinsics/iargc.f90 @@ -0,0 +1,9 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s +! RUN: flang-new -fc1 -emit-fir %s -o - | FileCheck %s + +! CHECK-LABEL: iargc_test +subroutine iargc_test() + integer :: arg_count + ! CHECK: %[[ArgCount:.*]] = fir.call @_FortranAArgumentCount() : () -> i32 + arg_count = iargc() +end subroutine iargc_test