Skip to content

Commit d4adb2e

Browse files
JDPailleuxJDPailleux
committed
[flang] Implement CHDIR intrinsic
1 parent 95ff3b5 commit d4adb2e

File tree

9 files changed

+200
-4
lines changed

9 files changed

+200
-4
lines changed

‎flang/docs/Intrinsics.md

Lines changed: 32 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -767,7 +767,7 @@ This phase currently supports all the intrinsic procedures listed above but the
767767
| Object characteristic inquiry functions | ALLOCATED, ASSOCIATED, EXTENDS_TYPE_OF, IS_CONTIGUOUS, PRESENT, RANK, SAME_TYPE, STORAGE_SIZE |
768768
| Type inquiry intrinsic functions | BIT_SIZE, DIGITS, EPSILON, HUGE, KIND, MAXEXPONENT, MINEXPONENT, NEW_LINE, PRECISION, RADIX, RANGE, TINY|
769769
| Non-standard intrinsic functions | AND, OR, XOR, SHIFT, ZEXT, IZEXT, COSD, SIND, TAND, ACOSD, ASIND, ATAND, ATAN2D, COMPL, EQV, NEQV, INT8, JINT, JNINT, KNINT, QCMPLX, DREAL, DFLOAT, QEXT, QFLOAT, QREAL, DNUM, NUM, JNUM, KNUM, QNUM, RNUM, RAN, RANF, ILEN, SIZEOF, MCLOCK, SECNDS, COTAN, IBCHNG, ISHA, ISHC, ISHL, IXOR, IARG, IARGC, NARGS, GETPID, NUMARG, BADDRESS, IADDR, CACHESIZE, EOF, FP_CLASS, INT_PTR_KIND, ISNAN, MALLOC, FREE, GETUID, GETGID |
770-
| Intrinsic subroutines |MVBITS (elemental), CPU_TIME, DATE_AND_TIME, EVENT_QUERY, EXECUTE_COMMAND_LINE, GET_COMMAND, GET_COMMAND_ARGUMENT, GET_ENVIRONMENT_VARIABLE, MOVE_ALLOC, RANDOM_INIT, RANDOM_NUMBER, RANDOM_SEED, SIGNAL, SLEEP, SYSTEM, SYSTEM_CLOCK |
770+
| Intrinsic subroutines |MVBITS (elemental), CHDIR, CPU_TIME, DATE_AND_TIME, EVENT_QUERY, EXECUTE_COMMAND_LINE, GET_COMMAND, GET_COMMAND_ARGUMENT, GET_ENVIRONMENT_VARIABLE, MOVE_ALLOC, RANDOM_INIT, RANDOM_NUMBER, RANDOM_SEED, SIGNAL, SLEEP, SYSTEM, SYSTEM_CLOCK |
771771
| Atomic intrinsic subroutines | ATOMIC_ADD |
772772
| Collective intrinsic subroutines | CO_REDUCE |
773773
| Library subroutines | BACKTRACE, FDATE, GETLOG, GETENV |
@@ -1064,3 +1064,34 @@ This intrinsic is an alias for `LEN_TRIM`, without the optional KIND argument.
10641064
- **Arguments:** `TIME` - a REAL value into which the elapsed CPU time in
10651065
seconds is written
10661066
- **RETURN value:** same as TIME argument
1067+
1068+
### Non-Standard Intrinsics: CHDIR
1069+
1070+
#### Description
1071+
`CHDIR(NAME[, STATUS])` Change current working directory to a specified path.
1072+
1073+
This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit.
1074+
*STATUS* is `INTENT(OUT)` and provide the following:
1075+
1076+
| | |
1077+
|------------|---------------------------------------------------------------------------------------------------|
1078+
| `NAME` | The type shall be `CHARACTER` of default kind and shall specify a valid path within the file system. |
1079+
| `STATUS` | (Optional) Status flag. Returns 0 on success, a system specific and nonzero error code otherwise. The type shall be `INTEGER` and of the default kind. |
1080+
1081+
#### Usage and Info
1082+
1083+
- **Standard:** GNU extension
1084+
- **Class:** Subroutine, function
1085+
- **Syntax:** `CALL CHDIR(NAME[, STATUS])` and `STATUS = CHDIR(NAME)`
1086+
1087+
#### Example
1088+
```Fortran
1089+
program chdir_func
1090+
character(len=) :: path
1091+
integer :: status
1092+
1093+
call chdir("/tmp")
1094+
status = chdir("..")
1095+
print *, "status: ", status
1096+
end program chdir_func
1097+
```

‎flang/include/flang/Optimizer/Builder/IntrinsicCall.h

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -202,6 +202,8 @@ struct IntrinsicLibrary {
202202
mlir::Value genBtest(mlir::Type, llvm::ArrayRef<mlir::Value>);
203203
mlir::Value genCeiling(mlir::Type, llvm::ArrayRef<mlir::Value>);
204204
fir::ExtendedValue genChar(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
205+
fir::ExtendedValue genChdir(std::optional<mlir::Type> resultType,
206+
llvm::ArrayRef<fir::ExtendedValue>);
205207
template <mlir::arith::CmpIPredicate pred>
206208
fir::ExtendedValue genCharacterCompare(mlir::Type,
207209
llvm::ArrayRef<fir::ExtendedValue>);

‎flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -90,6 +90,10 @@ void genSignal(fir::FirOpBuilder &builder, mlir::Location loc,
9090
void genSleep(fir::FirOpBuilder &builder, mlir::Location loc,
9191
mlir::Value seconds);
9292

93+
/// generate chdir runtime call
94+
mlir::Value genChdir(fir::FirOpBuilder &builder, mlir::Location loc,
95+
mlir::Value name);
96+
9397
} // namespace runtime
9498
} // namespace fir
9599

‎flang/include/flang/Runtime/extensions.h

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -69,5 +69,8 @@ std::int64_t FORTRAN_PROCEDURE_NAME(access)(const char *name,
6969
std::int64_t nameLength, const char *mode, std::int64_t modeLength);
7070
#endif
7171

72+
// GNU extension subroutine CHDIR(NAME, [STATUS])
73+
int RTNAME(Chdir)(const char *name);
74+
7275
} // extern "C"
7376
#endif // FORTRAN_RUNTIME_EXTENSIONS_H_

‎flang/lib/Evaluate/intrinsics.cpp

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -404,6 +404,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
404404
DefaultLogical},
405405
{"ceiling", {{"a", AnyReal}, DefaultingKIND}, KINDInt},
406406
{"char", {{"i", AnyInt, Rank::elementalOrBOZ}, DefaultingKIND}, KINDChar},
407+
{"chdir", {{"name", DefaultChar, Rank::scalar, Optionality::required}},
408+
TypePattern{IntType, KindCode::greaterOrEqualToKind, 4}},
407409
{"cmplx", {{"x", AnyComplex}, DefaultingKIND}, KINDComplex},
408410
{"cmplx",
409411
{{"x", AnyIntUnsignedOrReal, Rank::elementalOrBOZ},
@@ -1403,6 +1405,11 @@ static const IntrinsicInterface intrinsicSubroutine[]{
14031405
{"stat", AnyInt, Rank::scalar, Optionality::optional,
14041406
common::Intent::Out}},
14051407
{}, Rank::elemental, IntrinsicClass::atomicSubroutine},
1408+
{"chdir",
1409+
{{"name", DefaultChar, Rank::scalar, Optionality::required},
1410+
{"status", AnyInt, Rank::scalar, Optionality::optional,
1411+
common::Intent::Out}},
1412+
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
14061413
{"co_broadcast",
14071414
{{"a", AnyData, Rank::anyOrAssumedRank, Optionality::required,
14081415
common::Intent::InOut},
@@ -2719,8 +2726,8 @@ bool IntrinsicProcTable::Implementation::IsDualIntrinsic(
27192726
const std::string &name) const {
27202727
// Collection for some intrinsics with function and subroutine form,
27212728
// in order to pass the semantic check.
2722-
static const std::string dualIntrinsic[]{
2723-
{"etime"s}, {"getcwd"s}, {"rename"s}, {"second"s}, {"system"s}};
2729+
static const std::string dualIntrinsic[]{{"chdir"s}, {"etime"s}, {"getcwd"s},
2730+
{"rename"s}, {"second"s}, {"system"s}};
27242731

27252732
return llvm::is_contained(dualIntrinsic, name);
27262733
}

‎flang/lib/Optimizer/Builder/IntrinsicCall.cpp

Lines changed: 33 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -185,6 +185,10 @@ static constexpr IntrinsicHandler handlers[]{
185185
{"c_ptr_ne", &I::genCPtrCompare<mlir::arith::CmpIPredicate::ne>},
186186
{"ceiling", &I::genCeiling},
187187
{"char", &I::genChar},
188+
{"chdir",
189+
&I::genChdir,
190+
{{{"name", asAddr}, {"status", asAddr, handleDynamicOptional}}},
191+
/*isElemental=*/false},
188192
{"cmplx",
189193
&I::genCmplx,
190194
{{{"x", asValue}, {"y", asValue, handleDynamicOptional}}}},
@@ -3075,6 +3079,35 @@ IntrinsicLibrary::genChar(mlir::Type type,
30753079
return fir::CharBoxValue{cast, len};
30763080
}
30773081

3082+
// CHDIR
3083+
fir::ExtendedValue
3084+
IntrinsicLibrary::genChdir(std::optional<mlir::Type> resultType,
3085+
llvm::ArrayRef<fir::ExtendedValue> args) {
3086+
assert((args.size() == 1 && resultType.has_value()) ||
3087+
(args.size() >= 1 && !resultType.has_value()));
3088+
mlir::Value name = fir::getBase(args[0]);
3089+
mlir::Value status = fir::runtime::genChdir(builder, loc, name);
3090+
3091+
if (resultType.has_value()) {
3092+
return status;
3093+
} else {
3094+
// Subroutine form, store status and return none.
3095+
if (!isStaticallyAbsent(args[1])) {
3096+
mlir::Value statusAddr = fir::getBase(args[1]);
3097+
statusAddr.dump();
3098+
mlir::Value statusIsPresentAtRuntime =
3099+
builder.genIsNotNullAddr(loc, statusAddr);
3100+
builder.genIfThen(loc, statusIsPresentAtRuntime)
3101+
.genThen([&]() {
3102+
builder.createStoreWithConvert(loc, status, statusAddr);
3103+
})
3104+
.end();
3105+
}
3106+
}
3107+
3108+
return {};
3109+
}
3110+
30783111
// CMPLX
30793112
mlir::Value IntrinsicLibrary::genCmplx(mlir::Type resultType,
30803113
llvm::ArrayRef<mlir::Value> args) {

‎flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -385,3 +385,13 @@ void fir::runtime::genSleep(fir::FirOpBuilder &builder, mlir::Location loc,
385385
fir::runtime::getRuntimeFunc<mkRTKey(Sleep)>(loc, builder)};
386386
builder.create<fir::CallOp>(loc, func, seconds);
387387
}
388+
389+
/// generate chdir runtime call
390+
mlir::Value fir::runtime::genChdir(fir::FirOpBuilder &builder,
391+
mlir::Location loc, mlir::Value name) {
392+
mlir::func::FuncOp func{
393+
fir::runtime::getRuntimeFunc<mkRTKey(Chdir)>(loc, builder)};
394+
llvm::SmallVector<mlir::Value> args =
395+
fir::runtime::createArguments(builder, loc, func.getFunctionType(), name);
396+
return builder.create<fir::CallOp>(loc, func, args).getResult(0);
397+
}

‎flang/runtime/extensions.cpp

Lines changed: 13 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -51,7 +51,9 @@ inline void CtimeBuffer(char *buffer, size_t bufsize, const time_t cur_time,
5151

5252
#ifndef _WIN32
5353
// posix-compliant and has getlogin_r and F_OK
54-
#include <unistd.h>
54+
#include <unistd.h>
55+
#else
56+
#include <direct.h>
5557
#endif
5658

5759
extern "C" {
@@ -248,5 +250,15 @@ std::int64_t FORTRAN_PROCEDURE_NAME(access)(const char *name,
248250
}
249251
#endif
250252

253+
// CHDIR(DIR)
254+
int RTNAME(Chdir)(const char *name) {
255+
// chdir alias seems to be deprecated on Windows.
256+
#ifndef _WIN32
257+
return chdir(name);
258+
#else
259+
return _chdir(name);
260+
#endif
261+
}
262+
251263
} // namespace Fortran::runtime
252264
} // extern "C"

‎flang/test/Lower/Intrinsics/chdir.f90

Lines changed: 94 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,94 @@
1+
! RUN: bbc -emit-hlfir %s -o - | FileCheck %s
2+
3+
subroutine test_chdir()
4+
implicit none
5+
! CHECK-LABEL: func.func @_QPtest_chdir() {
6+
7+
call chdir("..")
8+
! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QQclX2E2E) : !fir.ref<!fir.char<1,2>>
9+
! CHECK: %[[C_2:.*]] = arith.constant 2 : index
10+
! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] typeparams %[[C_2]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQclX2E2E"} : (!fir.ref<!fir.char<1,2>>, index) -> (!fir.ref<!fir.char<1,2>>, !fir.ref<!fir.char<1,2>>)
11+
! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]]#1 : (!fir.ref<!fir.char<1,2>>) -> !fir.ref<i8>
12+
! CHECK: %[[VAL_3:.*]] = fir.call @_FortranAChdir(%[[VAL_2]]) fastmath<contract> : (!fir.ref<i8>) -> i32
13+
end subroutine
14+
15+
subroutine test_chdir_subroutine_status_i4()
16+
implicit none
17+
integer(4) :: stat
18+
! CHECK-LABEL: func.func @_QPtest_chdir_subroutine_status_i4() {
19+
20+
call chdir("..", STATUS=stat)
21+
! CHECK: %[[VAL_0:.*]] = fir.alloca i32 {bindc_name = "stat", uniq_name = "_QFtest_chdir_subroutine_status_i4Estat"}
22+
! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtest_chdir_subroutine_status_i4Estat"} : (!fir.ref<i32>) ->
23+
! (!fir.ref<i32>, !fir.ref<i32>)
24+
! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QQclX2E2E) : !fir.ref<!fir.char<1,2>>
25+
! CHECK: %[[C_2:.*]] = arith.constant 2 : index
26+
! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] typeparams %[[C_2]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = {{.*}} : (!fir.ref<!fir.char<1,2>>, index) -> (!fir.ref<!fir.char<1,2>>, !fir.ref<!fir.char<1,2>>)
27+
! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]]#1 : (!fir.ref<!fir.char<1,2>>) -> !fir.ref<i8>
28+
! CHECK: %[[VAL_5:.*]] = fir.call @_FortranAChdir(%[[VAL_4]]) fastmath<contract> : (!fir.ref<i8>) -> i32
29+
! CHECK: %[[VAL_6:.*]] = fir.convert %{{.*}} : (!fir.ref<i32>) -> i64
30+
! CHECK: %[[C_0_I64:.*]] = arith.constant 0 : i64
31+
! CHECK: %[[VAL_7:.*]] = arith.cmpi ne, %[[VAL_6]], %[[C_0_I64]] : i64
32+
! CHECK: fir.if %[[VAL_7]] {
33+
! CHECK: fir.store %[[VAL_5]] to %[[VAL_1]]#1 : !fir.ref<i32>
34+
! CHECK: }
35+
end subroutine
36+
37+
subroutine test_chdir_function_status_i4()
38+
implicit none
39+
integer(4) :: stat
40+
! CHECK-LABEL: func.func @_QPtest_chdir_function_status_i4() {
41+
42+
stat = chdir("..")
43+
! CHECK: %[[VAL_0:.*]] = fir.alloca i32 {bindc_name = "stat", uniq_name = "_QFtest_chdir_function_status_i4Estat"}
44+
! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtest_chdir_function_status_i4Estat"} : (!fir.ref<i32>) ->
45+
! (!fir.ref<i32>, !fir.ref<i32>)
46+
! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QQclX2E2E) : !fir.ref<!fir.char<1,2>>
47+
! CHECK: %[[C_2:.*]] = arith.constant 2 : index
48+
! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] typeparams %[[C_2]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = {{.*}} : (!fir.ref<!fir.char<1,2>>, index) -> (!fir.ref<!fir.char<1,2>>, !fir.ref<!fir.char<1,2>>)
49+
! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]]#1 : (!fir.ref<!fir.char<1,2>>) -> !fir.ref<i8>
50+
! CHECK: %[[VAL_5:.*]] = fir.call @_FortranAChdir(%[[VAL_4]]) fastmath<contract> : (!fir.ref<i8>) -> i32
51+
! CHECK: hlfir.assign %[[VAL_5]] to %[[VAL_1]]#0 : i32, !fir.ref<i32>
52+
end subroutine
53+
54+
subroutine test_chdir_subroutine_status_i8()
55+
implicit none
56+
integer(8) :: stat
57+
! CHECK-LABEL: func.func @_QPtest_chdir_subroutine_status_i8() {
58+
59+
call chdir("..", STATUS=stat)
60+
! CHECK: %[[VAL_0:.*]] = fir.alloca i64 {bindc_name = "stat", uniq_name = "_QFtest_chdir_subroutine_status_i8Estat"}
61+
! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtest_chdir_subroutine_status_i8Estat"} : (!fir.ref<i64>) ->
62+
! (!fir.ref<i64>, !fir.ref<i64>)
63+
! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QQclX2E2E) : !fir.ref<!fir.char<1,2>>
64+
! CHECK: %[[C_2:.*]] = arith.constant 2 : index
65+
! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] typeparams %[[C_2]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = {{.*}} : (!fir.ref<!fir.char<1,2>>, index) -> (!fir.ref<!fir.char<1,2>>, !fir.ref<!fir.char<1,2>>)
66+
! CHECK: %[[VAL_4:.*]] = fir.convert %{{.*}} : (!fir.ref<!fir.char<1,2>>) -> !fir.ref<i8>
67+
! CHECK: %[[VAL_5:.*]] = fir.call @_FortranAChdir(%[[VAL_4]]) fastmath<contract> : (!fir.ref<i8>) -> i32
68+
! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_1]]#1 : (!fir.ref<i64>) -> i64
69+
! CHECK: %[[C_0_I64:.*]] = arith.constant 0 : i64
70+
! CHECK: %[[VAL_7:.*]] = arith.cmpi ne, %[[VAL_6]], %[[C_0_I64]] : i64
71+
! CHECK: fir.if %[[VAL_7]] {
72+
! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_5]] : (i32) -> i64
73+
! CHECK: fir.store %[[VAL_8]] to %[[VAL_1]]#1 : !fir.ref<i64>
74+
! CHECK: }
75+
end subroutine
76+
77+
subroutine test_chdir_function_status_i8()
78+
implicit none
79+
integer(8) :: stat
80+
! CHECK-LABEL: func.func @_QPtest_chdir_function_status_i8() {
81+
82+
stat = chdir("..")
83+
! CHECK: %[[VAL_0:.*]] = fir.alloca i64 {bindc_name = "stat", uniq_name = "_QFtest_chdir_function_status_i8Estat"}
84+
! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtest_chdir_function_status_i8Estat"} : (!fir.ref<i64>) ->
85+
! (!fir.ref<i64>, !fir.ref<i64>)
86+
! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QQclX2E2E) : !fir.ref<!fir.char<1,2>>
87+
! CHECK: %[[C_2:.*]] = arith.constant 2 : index
88+
! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] typeparams %[[C_2]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = {{.*}} : (!fir.ref<!fir.char<1,2>>, index) -> (!fir.ref<!fir.char<1,2>>, !fir.ref<!fir.char<1,2>>)
89+
! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]]#1 : (!fir.ref<!fir.char<1,2>>) -> !fir.ref<i8>
90+
! CHECK: %[[VAL_5:.*]] = fir.call @_FortranAChdir(%[[VAL_4]]) fastmath<contract> : (!fir.ref<i8>) -> i32
91+
! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> i64
92+
! CHECK: hlfir.assign %[[VAL_6]] to %[[VAL_1]]#0 : i64, !fir.ref<i64>
93+
end subroutine
94+

0 commit comments

Comments
 (0)