[flang-commits] [flang] [flang][Runtime] Add SIGNAL intrinisic (PR #79337)
Tom Eccles via flang-commits
flang-commits at lists.llvm.org
Fri Jan 26 06:08:50 PST 2024
https://github.com/tblah updated https://github.com/llvm/llvm-project/pull/79337
>From 1e5722827cc120ce5b0ccfdb27d7514667ea25a3 Mon Sep 17 00:00:00 2001
From: Tom Eccles <tom.eccles at arm.com>
Date: Fri, 26 Jan 2024 11:09:29 +0000
Subject: [PATCH 1/4] [flang][runtime] Implement SLEEP intrinsic (#79074)
This intrinsic is a gnu extension. See
https://gcc.gnu.org/onlinedocs/gfortran/SLEEP.html
This intrinsic is used in minighost:
https://github.com/Mantevo/miniGhost/blob/c2102b521568a74862fa5abb074b1fc8041fc222/ref/MG_UTILS.F#L606
---
flang/docs/Intrinsics.md | 3 +--
.../flang/Optimizer/Builder/IntrinsicCall.h | 1 +
.../Optimizer/Builder/Runtime/Intrinsics.h | 4 +++
flang/include/flang/Runtime/extensions.h | 5 ++++
flang/lib/Evaluate/intrinsics.cpp | 4 +++
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 7 +++++
.../Optimizer/Builder/Runtime/Intrinsics.cpp | 10 +++++++
flang/runtime/extensions.cpp | 13 +++++++++
flang/test/Lower/Intrinsics/sleep.f90 | 27 +++++++++++++++++++
9 files changed, 72 insertions(+), 2 deletions(-)
create mode 100644 flang/test/Lower/Intrinsics/sleep.f90
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index 5ade25740329771..a3888111430a0e2 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -757,7 +757,7 @@ This phase currently supports all the intrinsic procedures listed above but the
| Object characteristic inquiry functions | ALLOCATED, ASSOCIATED, EXTENDS_TYPE_OF, IS_CONTIGUOUS, PRESENT, RANK, SAME_TYPE, STORAGE_SIZE |
| Type inquiry intrinsic functions | BIT_SIZE, DIGITS, EPSILON, HUGE, KIND, MAXEXPONENT, MINEXPONENT, NEW_LINE, PRECISION, RADIX, RANGE, TINY|
| 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 |
-| 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, SYSTEM_CLOCK |
+| 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, SLEEP, SYSTEM_CLOCK |
| Atomic intrinsic subroutines | ATOMIC_ADD |
| Collective intrinsic subroutines | CO_REDUCE |
| Library subroutines | FDATE, GETLOG |
@@ -908,4 +908,3 @@ used in constant expressions have currently no folding support at all.
- If a condition occurs that would assign a nonzero value to `CMDSTAT` but the `CMDSTAT` variable is not present, error termination is initiated.
- On POSIX-compatible systems, the child process (async process) will be terminated with no effect on the parent process (continues).
- On Windows, error termination is not initiated.
-
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index 80f79d42fc2b75c..275878a0b2ad174 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -339,6 +339,7 @@ struct IntrinsicLibrary {
fir::ExtendedValue genStorageSize(mlir::Type,
llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genSum(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+ void genSleep(llvm::ArrayRef<fir::ExtendedValue>);
void genSystemClock(llvm::ArrayRef<fir::ExtendedValue>);
mlir::Value genTand(mlir::Type, llvm::ArrayRef<mlir::Value>);
mlir::Value genTrailz(mlir::Type, llvm::ArrayRef<mlir::Value>);
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
index 9a37c15e9fb4ce2..a92e03afa60d778 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
@@ -64,6 +64,10 @@ void genTransferSize(fir::FirOpBuilder &builder, mlir::Location loc,
/// all intrinsic arguments are optional and may appear here as mlir::Value{}
void genSystemClock(fir::FirOpBuilder &, mlir::Location, mlir::Value count,
mlir::Value rate, mlir::Value max);
+
+/// generate sleep runtime call
+void genSleep(fir::FirOpBuilder &builder, mlir::Location loc,
+ mlir::Value seconds);
} // namespace runtime
} // namespace fir
diff --git a/flang/include/flang/Runtime/extensions.h b/flang/include/flang/Runtime/extensions.h
index 1ed750f3b70e0f3..515e9eb3e7b5e1d 100644
--- a/flang/include/flang/Runtime/extensions.h
+++ b/flang/include/flang/Runtime/extensions.h
@@ -12,6 +12,8 @@
#ifndef FORTRAN_RUNTIME_EXTENSIONS_H_
#define FORTRAN_RUNTIME_EXTENSIONS_H_
+#include "flang/Runtime/entry-names.h"
+
#define FORTRAN_PROCEDURE_NAME(name) name##_
#include <cstddef>
@@ -35,5 +37,8 @@ void FORTRAN_PROCEDURE_NAME(getarg)(
// GNU extension subroutine GETLOG(C).
void FORTRAN_PROCEDURE_NAME(getlog)(char *name, std::int64_t length);
+// GNU extension subroutine SLEEP(SECONDS)
+void RTNAME(Sleep)(std::int64_t seconds);
+
} // extern "C"
#endif // FORTRAN_RUNTIME_EXTENSIONS_H_
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index da6d5970089884c..be45a54c30d1393 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1395,6 +1395,10 @@ static const IntrinsicInterface intrinsicSubroutine[]{
{"count_max", AnyInt, Rank::scalar, Optionality::optional,
common::Intent::Out}},
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
+ {"sleep",
+ {{"seconds", AnyInt, Rank::scalar, Optionality::required,
+ common::Intent::In}},
+ {}, Rank::elemental, IntrinsicClass::impureSubroutine},
};
// TODO: Intrinsic subroutine EVENT_QUERY
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index a0baa409fe44b4b..467ee7810c68a1b 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -556,6 +556,7 @@ static constexpr IntrinsicHandler handlers[]{
{"dim", asAddr, handleDynamicOptional},
{"kind", asValue}}},
/*isElemental=*/false},
+ {"sleep", &I::genSleep, {{{"seconds", asValue}}}, /*isElemental=*/false},
{"spacing", &I::genSpacing},
{"spread",
&I::genSpread,
@@ -5924,6 +5925,12 @@ void IntrinsicLibrary::genSystemClock(llvm::ArrayRef<fir::ExtendedValue> args) {
fir::getBase(args[1]), fir::getBase(args[2]));
}
+// SLEEP
+void IntrinsicLibrary::genSleep(llvm::ArrayRef<fir::ExtendedValue> args) {
+ assert(args.size() == 1 && "SLEEP has one compulsory argument");
+ fir::runtime::genSleep(builder, loc, fir::getBase(args[0]));
+}
+
// TRANSFER
fir::ExtendedValue
IntrinsicLibrary::genTransfer(mlir::Type resultType,
diff --git a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
index 63d66adf222f640..9058ff6325b1229 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
@@ -12,6 +12,7 @@
#include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
#include "flang/Optimizer/Dialect/FIROpsSupport.h"
#include "flang/Parser/parse-tree.h"
+#include "flang/Runtime/extensions.h"
#include "flang/Runtime/misc-intrinsic.h"
#include "flang/Runtime/pointer.h"
#include "flang/Runtime/random.h"
@@ -235,3 +236,12 @@ void fir::runtime::genSystemClock(fir::FirOpBuilder &builder,
if (max)
makeCall(getRuntimeFunc<mkRTKey(SystemClockCountMax)>(loc, builder), max);
}
+
+void fir::runtime::genSleep(fir::FirOpBuilder &builder, mlir::Location loc,
+ mlir::Value seconds) {
+ mlir::Type int64 = builder.getIntegerType(64);
+ seconds = builder.create<fir::ConvertOp>(loc, int64, seconds);
+ mlir::func::FuncOp func{
+ fir::runtime::getRuntimeFunc<mkRTKey(Sleep)>(loc, builder)};
+ builder.create<fir::CallOp>(loc, func, seconds);
+}
\ No newline at end of file
diff --git a/flang/runtime/extensions.cpp b/flang/runtime/extensions.cpp
index 2740c854b807818..6170937f839a62b 100644
--- a/flang/runtime/extensions.cpp
+++ b/flang/runtime/extensions.cpp
@@ -14,8 +14,11 @@
#include "tools.h"
#include "flang/Runtime/command.h"
#include "flang/Runtime/descriptor.h"
+#include "flang/Runtime/entry-names.h"
#include "flang/Runtime/io-api.h"
+#include <chrono>
#include <ctime>
+#include <thread>
#ifdef _WIN32
inline void CtimeBuffer(char *buffer, size_t bufsize, const time_t cur_time,
@@ -113,5 +116,15 @@ void FORTRAN_PROCEDURE_NAME(getlog)(char *arg, std::int64_t length) {
#endif
}
+// CALL SLEEP(SECONDS)
+void RTNAME(Sleep)(std::int64_t seconds) {
+ // ensure that conversion to unsigned makes sense,
+ // sleep(0) is an immidiate return anyway
+ if (seconds < 1) {
+ return;
+ }
+ std::this_thread::sleep_for(std::chrono::seconds(seconds));
+}
+
} // namespace Fortran::runtime
} // extern "C"
diff --git a/flang/test/Lower/Intrinsics/sleep.f90 b/flang/test/Lower/Intrinsics/sleep.f90
new file mode 100644
index 000000000000000..c4a7b381602cadb
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/sleep.f90
@@ -0,0 +1,27 @@
+! RUN: bbc -emit-hlfir %s -o - | FileCheck %s
+
+subroutine test_sleep()
+! CHECK-LABEL: func.func @_QPtest_sleep() {
+
+ call sleep(1_2)
+! CHECK: %[[VAL_0:.*]] = arith.constant 1 : i16
+! CHECK: %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (i16) -> i64
+! CHECK: %[[VAL_2:.*]] = fir.call @_FortranASleep(%[[VAL_1]]) fastmath<contract> : (i64) -> none
+
+ call sleep(1_4)
+! CHECK: %[[VAL_3:.*]] = arith.constant 1 : i32
+! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (i32) -> i64
+! CHECK: %[[VAL_5:.*]] = fir.call @_FortranASleep(%[[VAL_4]]) fastmath<contract> : (i64) -> none
+
+ call sleep(1_8)
+! CHECK: %[[VAL_6:.*]] = arith.constant 1 : i64
+! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (i64) -> i64
+! CHECK: %[[VAL_8:.*]] = fir.call @_FortranASleep(%[[VAL_7]]) fastmath<contract> : (i64) -> none
+
+ call sleep(1_16)
+! CHECK: %[[VAL_9:.*]] = arith.constant 1 : i128
+! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i128) -> i64
+! CHECK: %[[VAL_11:.*]] = fir.call @_FortranASleep(%[[VAL_10]]) fastmath<contract> : (i64) -> none
+end
+! CHECK: return
+! CHECK: }
>From c0a8cbc568ccdc16eb8f6d709f92388fd16f590a Mon Sep 17 00:00:00 2001
From: Tom Eccles <tom.eccles at arm.com>
Date: Wed, 24 Jan 2024 12:08:22 +0000
Subject: [PATCH 2/4] [flang][Runtime] Add SIGNAL intrinisic
The intrinsic is defined as a GNU extension here:
https://gcc.gnu.org/onlinedocs/gfortran/SIGNAL.html
And as an IBM extension here:
https://www.ibm.com/docs/en/xffbg/121.141?topic=procedures-signali-proc-extension
The IBM version provides a compatible subset of the functionality
offered by the GNU version. This patch supports most of the GNU
features, but not calling SIGNAL as a function. We don't currently
support intrinsics being both subroutines AND functions and this changed
seemed too large to be justified by a non-standard intrinsic.
I cannot point to open source code Fortran using this intrinsic. This is
needed for a proprietary code base.
---
flang/docs/Intrinsics.md | 2 +-
.../flang/Optimizer/Builder/IntrinsicCall.h | 1 +
.../Optimizer/Builder/Runtime/Intrinsics.h | 8 ++
.../Optimizer/Builder/Runtime/RTBuilder.h | 7 ++
flang/include/flang/Runtime/extensions.h | 4 +
flang/lib/Evaluate/intrinsics.cpp | 12 +++
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 16 ++++
.../Optimizer/Builder/Runtime/Intrinsics.cpp | 66 +++++++++++++++-
flang/runtime/extensions.cpp | 12 +++
flang/test/Lower/Intrinsics/signal.f90 | 77 +++++++++++++++++++
10 files changed, 203 insertions(+), 2 deletions(-)
create mode 100644 flang/test/Lower/Intrinsics/signal.f90
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index a3888111430a0e2..c40bcb886bc7c65 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -757,7 +757,7 @@ This phase currently supports all the intrinsic procedures listed above but the
| Object characteristic inquiry functions | ALLOCATED, ASSOCIATED, EXTENDS_TYPE_OF, IS_CONTIGUOUS, PRESENT, RANK, SAME_TYPE, STORAGE_SIZE |
| Type inquiry intrinsic functions | BIT_SIZE, DIGITS, EPSILON, HUGE, KIND, MAXEXPONENT, MINEXPONENT, NEW_LINE, PRECISION, RADIX, RANGE, TINY|
| 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 |
-| 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, SLEEP, SYSTEM_CLOCK |
+| 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_CLOCK |
| Atomic intrinsic subroutines | ATOMIC_ADD |
| Collective intrinsic subroutines | CO_REDUCE |
| Library subroutines | FDATE, GETLOG |
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index 275878a0b2ad174..04f6ab4a35bb0df 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -339,6 +339,7 @@ struct IntrinsicLibrary {
fir::ExtendedValue genStorageSize(mlir::Type,
llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genSum(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+ void genSignalSubroutine(llvm::ArrayRef<fir::ExtendedValue>);
void genSleep(llvm::ArrayRef<fir::ExtendedValue>);
void genSystemClock(llvm::ArrayRef<fir::ExtendedValue>);
mlir::Value genTand(mlir::Type, llvm::ArrayRef<mlir::Value>);
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
index a92e03afa60d778..737c631e45c1f6f 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
@@ -20,6 +20,7 @@
namespace mlir {
class Location;
+class Type;
class Value;
} // namespace mlir
@@ -65,9 +66,16 @@ void genTransferSize(fir::FirOpBuilder &builder, mlir::Location loc,
void genSystemClock(fir::FirOpBuilder &, mlir::Location, mlir::Value count,
mlir::Value rate, mlir::Value max);
+// generate signal runtime call
+// CALL SIGNAL(NUMBER, HANDLER [, STATUS])
+// status can be {} or a value. It may also be dynamically absent
+void genSignal(fir::FirOpBuilder &builder, mlir::Location loc,
+ mlir::Value number, mlir::Value handler, mlir::Value status);
+
/// generate sleep runtime call
void genSleep(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value seconds);
+
} // namespace runtime
} // namespace fir
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h b/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
index 99558cf03d4ffe7..e230fc989b9d26c 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
@@ -137,6 +137,13 @@ constexpr TypeBuilderFunc getModel<void *>() {
};
}
template <>
+constexpr TypeBuilderFunc getModel<void (*)(int)>() {
+ return [](mlir::MLIRContext *context) -> mlir::Type {
+ return fir::LLVMPointerType::get(context,
+ mlir::IntegerType::get(context, 8));
+ };
+}
+template <>
constexpr TypeBuilderFunc getModel<void **>() {
return [](mlir::MLIRContext *context) -> mlir::Type {
return fir::ReferenceType::get(
diff --git a/flang/include/flang/Runtime/extensions.h b/flang/include/flang/Runtime/extensions.h
index 515e9eb3e7b5e1d..7d0952206fc195a 100644
--- a/flang/include/flang/Runtime/extensions.h
+++ b/flang/include/flang/Runtime/extensions.h
@@ -16,6 +16,7 @@
#define FORTRAN_PROCEDURE_NAME(name) name##_
+#include "flang/Runtime/entry-names.h"
#include <cstddef>
#include <cstdint>
@@ -37,6 +38,9 @@ void FORTRAN_PROCEDURE_NAME(getarg)(
// GNU extension subroutine GETLOG(C).
void FORTRAN_PROCEDURE_NAME(getlog)(char *name, std::int64_t length);
+// GNU extension function STATUS = SIGNAL(number, handler)
+std::int64_t RTNAME(Signal)(std::int64_t number, void (*handler)(int));
+
// GNU extension subroutine SLEEP(SECONDS)
void RTNAME(Sleep)(std::int64_t seconds);
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index be45a54c30d1393..afb650abb86fb1d 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1395,6 +1395,15 @@ static const IntrinsicInterface intrinsicSubroutine[]{
{"count_max", AnyInt, Rank::scalar, Optionality::optional,
common::Intent::Out}},
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
+ {"signal",
+ {{"number", AnyInt, Rank::scalar, Optionality::required,
+ common::Intent::In},
+ // note: any pointer also accepts AnyInt
+ {"handler", AnyPointer, Rank::scalar, Optionality::required,
+ common::Intent::In},
+ {"status", AnyInt, Rank::scalar, Optionality::optional,
+ common::Intent::Out}},
+ {}, Rank::elemental, IntrinsicClass::impureSubroutine},
{"sleep",
{{"seconds", AnyInt, Rank::scalar, Optionality::required,
common::Intent::In}},
@@ -1416,9 +1425,12 @@ static DynamicType GetBuiltinDerivedType(
auto iter{
builtinsScope->find(semantics::SourceName{which, std::strlen(which)})};
if (iter == builtinsScope->cend()) {
+ // keep the string all together
+ // clang-format off
common::die(
"INTERNAL: The __fortran_builtins module does not define the type '%s'",
which);
+ // clang-format on
}
const semantics::Symbol &symbol{*iter->second};
const semantics::Scope &scope{DEREF(symbol.scope())};
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 467ee7810c68a1b..273aee3733bfa40 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -550,6 +550,10 @@ static constexpr IntrinsicHandler handlers[]{
{"shiftl", &I::genShift<mlir::arith::ShLIOp>},
{"shiftr", &I::genShift<mlir::arith::ShRUIOp>},
{"sign", &I::genSign},
+ {"signal",
+ &I::genSignalSubroutine,
+ {{{"number", asValue}, {"handler", asAddr}, {"status", asAddr}}},
+ /*isElemental=*/false},
{"size",
&I::genSize,
{{{"array", asBox},
@@ -5579,6 +5583,18 @@ mlir::Value IntrinsicLibrary::genShiftA(mlir::Type resultType,
shifted);
}
+// SIGNAL
+void IntrinsicLibrary::genSignalSubroutine(
+ llvm::ArrayRef<fir::ExtendedValue> args) {
+ assert(args.size() == 2 || args.size() == 3);
+ mlir::Value number = fir::getBase(args[0]);
+ mlir::Value handler = fir::getBase(args[1]);
+ mlir::Value status;
+ if (args.size() == 3)
+ status = fir::getBase(args[2]);
+ fir::runtime::genSignal(builder, loc, number, handler, status);
+}
+
// SIGN
mlir::Value IntrinsicLibrary::genSign(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args) {
diff --git a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
index 9058ff6325b1229..022f8b97cd37272 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
@@ -21,6 +21,7 @@
#include "flang/Semantics/tools.h"
#include "llvm/Support/Debug.h"
#include <optional>
+#include <signal.h>
#define DEBUG_TYPE "flang-lower-runtime"
@@ -237,6 +238,69 @@ void fir::runtime::genSystemClock(fir::FirOpBuilder &builder,
makeCall(getRuntimeFunc<mkRTKey(SystemClockCountMax)>(loc, builder), max);
}
+// CALL SIGNAL(NUMBER, HANDLER [, STATUS])
+// The definition of the SIGNAL intrinsic allows HANDLER to be a function
+// pointer or an integer. STATUS can be dynamically optional
+void fir::runtime::genSignal(fir::FirOpBuilder &builder, mlir::Location loc,
+ mlir::Value number, mlir::Value handler,
+ mlir::Value status) {
+ assert(mlir::isa<mlir::IntegerType>(number.getType()));
+ if (status)
+ assert(mlir::isa<mlir::IntegerType>(fir::unwrapRefType(status.getType())));
+ mlir::Type int64 = builder.getIntegerType(64);
+ number = builder.create<fir::ConvertOp>(loc, int64, number);
+
+ // we can return like a function or via the status argument
+ auto returnStatus = [&](mlir::Value stat) -> mlir::Value {
+ if (status) {
+ // status might be dynamically optional, so test if it is present
+ mlir::Value isPresent =
+ builder.create<IsPresentOp>(loc, builder.getI1Type(), status);
+ builder.genIfOp(loc, /*results=*/{}, isPresent, /*withElseRegion=*/false)
+ .genThen([&]() {
+ stat = builder.create<fir::ConvertOp>(
+ loc, fir::unwrapRefType(status.getType()), stat);
+ builder.create<fir::StoreOp>(loc, stat, status);
+ })
+ .end();
+ }
+ return {};
+ };
+
+ mlir::Type handlerUnwrappedTy = fir::unwrapRefType(handler.getType());
+ if (mlir::isa_and_nonnull<mlir::IntegerType>(handlerUnwrappedTy)) {
+#if _WIN32
+ // The windows documentation doesn't mention any support for passing
+ // SIG_DFL or SIG_IGN as integer arguments, so just return an error.
+
+ // reinterpret cast: the GNU extension is defined with STATUS as an integer
+ // but on Windows SIG_ERR is a void *
+ const std::int64_t sigErrVal =
+ static_cast<std::int64_t>(reinterpret_cast<std::uintptr_t>(SIG_ERR));
+ mlir::Value sigErr = builder.createIntegerConstant(loc, int64, sigErrVal);
+ returnStatus(sigErr);
+ errno = EINVAL;
+ return;
+#endif // _WIN32
+ // else just pass the integer as a function pointer like one would to
+ // signal(2)
+ handler = builder.create<fir::LoadOp>(loc, handler);
+ mlir::Type fnPtrTy = fir::LLVMPointerType::get(
+ mlir::FunctionType::get(handler.getContext(), {}, {}));
+ handler = builder.create<fir::ConvertOp>(loc, fnPtrTy, handler);
+ } else {
+ assert(mlir::isa<fir::BoxProcType>(handler.getType()));
+ handler = builder.create<fir::BoxAddrOp>(loc, handler);
+ }
+
+ mlir::func::FuncOp func{
+ fir::runtime::getRuntimeFunc<mkRTKey(Signal)>(loc, builder)};
+ mlir::Value stat =
+ builder.create<fir::CallOp>(loc, func, mlir::ValueRange{number, handler})
+ ->getResult(0);
+ returnStatus(stat);
+}
+
void fir::runtime::genSleep(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value seconds) {
mlir::Type int64 = builder.getIntegerType(64);
@@ -244,4 +308,4 @@ void fir::runtime::genSleep(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::func::FuncOp func{
fir::runtime::getRuntimeFunc<mkRTKey(Sleep)>(loc, builder)};
builder.create<fir::CallOp>(loc, func, seconds);
-}
\ No newline at end of file
+}
diff --git a/flang/runtime/extensions.cpp b/flang/runtime/extensions.cpp
index 6170937f839a62b..3ac98000335d7d0 100644
--- a/flang/runtime/extensions.cpp
+++ b/flang/runtime/extensions.cpp
@@ -18,6 +18,7 @@
#include "flang/Runtime/io-api.h"
#include <chrono>
#include <ctime>
+#include <signal.h>
#include <thread>
#ifdef _WIN32
@@ -116,6 +117,17 @@ void FORTRAN_PROCEDURE_NAME(getlog)(char *arg, std::int64_t length) {
#endif
}
+std::int64_t RTNAME(Signal)(std::int64_t number, void (*handler)(int)) {
+ // using auto for portability:
+ // on Windows, this is a void *
+ // on POSIX, this has the same type as handler
+ auto result = signal(number, handler);
+
+ // GNU defines the intrinsic as returning an integer, not a pointer. So we
+ // have to reinterpret_cast
+ return static_cast<int64_t>(reinterpret_cast<std::uintptr_t>(result));
+}
+
// CALL SLEEP(SECONDS)
void RTNAME(Sleep)(std::int64_t seconds) {
// ensure that conversion to unsigned makes sense,
diff --git a/flang/test/Lower/Intrinsics/signal.f90 b/flang/test/Lower/Intrinsics/signal.f90
new file mode 100644
index 000000000000000..d6678000677e1cd
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/signal.f90
@@ -0,0 +1,77 @@
+! test lowering of the SIGNAL intrinsic subroutine
+! RUN: bbc -emit-hlfir -o - %s | FileCheck %s
+
+module m
+contains
+! CHECK-LABEL: func.func @handler(
+! CHECK-SAME: %[[VAL_0:.*]]: i32 {fir.bindc_name = "signum"}) attributes {fir.bindc_name = "handler"} {
+ subroutine handler(signum) bind(C)
+ use iso_c_binding, only: c_int
+ integer(c_int), value :: signum
+ end subroutine
+
+! CHECK-LABEL: func.func @_QMmPsetup_signals(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "optional_status", fir.optional}) {
+ subroutine setup_signals(optional_status)
+ ! not portable accross systems
+ integer, parameter :: SIGFPE = 8
+ integer, parameter :: SIGUSR1 = 10
+ integer, parameter :: SIGUSR2 = 12
+ integer, parameter :: SIGPIPE = 13
+ integer, parameter :: SIG_IGN = 1
+ integer :: stat = 0
+ integer, optional, intent(out) :: optional_status
+
+! CHECK: %[[VAL_1:.*]] = fir.alloca i32
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<intent_out, optional>, uniq_name = "_QMmFsetup_signalsEoptional_status"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+! CHECK: %[[VAL_14:.*]]:2 = hlfir.declare %{{.*}} {uniq_name = "_QMmFsetup_signalsEstat"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+
+ call signal(SIGFPE, handler)
+! CHECK: %[[VAL_15:.*]] = arith.constant 8 : i32
+! CHECK: %[[VAL_16:.*]] = fir.address_of(@handler) : (i32) -> ()
+! CHECK: %[[VAL_17:.*]] = fir.emboxproc %[[VAL_16]] : ((i32) -> ()) -> !fir.boxproc<() -> ()>
+! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_15]] : (i32) -> i64
+! CHECK: %[[VAL_19:.*]] = fir.box_addr %[[VAL_17]] : (!fir.boxproc<() -> ()>) -> (() -> ())
+! CHECK: %[[VAL_20:.*]] = fir.call @_FortranASignal(%[[VAL_18]], %[[VAL_19]]) fastmath<contract> : (i64, () -> ()) -> i64
+
+ call signal(SIGUSR1, handler, stat)
+! CHECK: %[[VAL_21:.*]] = arith.constant 10 : i32
+! CHECK: %[[VAL_22:.*]] = fir.address_of(@handler) : (i32) -> ()
+! CHECK: %[[VAL_23:.*]] = fir.emboxproc %[[VAL_22]] : ((i32) -> ()) -> !fir.boxproc<() -> ()>
+! CHECK: %[[VAL_24:.*]] = fir.convert %[[VAL_21]] : (i32) -> i64
+! CHECK: %[[VAL_25:.*]] = fir.box_addr %[[VAL_23]] : (!fir.boxproc<() -> ()>) -> (() -> ())
+! CHECK: %[[VAL_26:.*]] = fir.call @_FortranASignal(%[[VAL_24]], %[[VAL_25]]) fastmath<contract> : (i64, () -> ()) -> i64
+! CHECK: %[[VAL_27:.*]] = fir.is_present %[[VAL_14]]#1 : (!fir.ref<i32>) -> i1
+! CHECK: fir.if %[[VAL_27]] {
+! CHECK: %[[VAL_28:.*]] = fir.convert %[[VAL_26]] : (i64) -> i32
+! CHECK: fir.store %[[VAL_28]] to %[[VAL_14]]#1 : !fir.ref<i32>
+! CHECK: }
+
+ call signal(SIGUSR2, SIG_IGN, stat)
+! CHECK: %[[VAL_29:.*]] = arith.constant 12 : i32
+! CHECK: %[[VAL_30:.*]] = arith.constant 1 : i32
+! CHECK: fir.store %[[VAL_30]] to %[[VAL_1]] : !fir.ref<i32>
+! CHECK: %[[VAL_31:.*]] = fir.convert %[[VAL_29]] : (i32) -> i64
+! CHECK: %[[VAL_32:.*]] = fir.load %[[VAL_1]] : !fir.ref<i32>
+! CHECK: %[[VAL_33:.*]] = fir.convert %[[VAL_32]] : (i32) -> !fir.llvm_ptr<() -> ()>
+! CHECK: %[[VAL_34:.*]] = fir.call @_FortranASignal(%[[VAL_31]], %[[VAL_33]]) fastmath<contract> : (i64, !fir.llvm_ptr<() -> ()>) -> i64
+! CHECK: %[[VAL_35:.*]] = fir.is_present %[[VAL_14]]#1 : (!fir.ref<i32>) -> i1
+! CHECK: fir.if %[[VAL_35]] {
+! CHECK: %[[VAL_36:.*]] = fir.convert %[[VAL_34]] : (i64) -> i32
+! CHECK: fir.store %[[VAL_36]] to %[[VAL_14]]#1 : !fir.ref<i32>
+! CHECK: }
+
+ call signal(SIGPIPE, handler, optional_status)
+! CHECK: %[[VAL_37:.*]] = arith.constant 13 : i32
+! CHECK: %[[VAL_38:.*]] = fir.address_of(@handler) : (i32) -> ()
+! CHECK: %[[VAL_39:.*]] = fir.emboxproc %[[VAL_38]] : ((i32) -> ()) -> !fir.boxproc<() -> ()>
+! CHECK: %[[VAL_40:.*]] = fir.convert %[[VAL_37]] : (i32) -> i64
+! CHECK: %[[VAL_41:.*]] = fir.box_addr %[[VAL_39]] : (!fir.boxproc<() -> ()>) -> (() -> ())
+! CHECK: %[[VAL_42:.*]] = fir.call @_FortranASignal(%[[VAL_40]], %[[VAL_41]]) fastmath<contract> : (i64, () -> ()) -> i64
+! CHECK: %[[VAL_43:.*]] = fir.is_present %[[VAL_2]]#1 : (!fir.ref<i32>) -> i1
+! CHECK: fir.if %[[VAL_43]] {
+! CHECK: %[[VAL_44:.*]] = fir.convert %[[VAL_42]] : (i64) -> i32
+! CHECK: fir.store %[[VAL_44]] to %[[VAL_2]]#1 : !fir.ref<i32>
+! CHECK: }
+ end subroutine
+end module
>From d3e5b5697f925609bb6711cacb8cd852f1ea3dee Mon Sep 17 00:00:00 2001
From: Tom Eccles <tom.eccles at arm.com>
Date: Wed, 24 Jan 2024 21:50:22 +0000
Subject: [PATCH 3/4] Use more accurate pointer type
---
flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h | 5 +++--
1 file changed, 3 insertions(+), 2 deletions(-)
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h b/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
index e230fc989b9d26c..c9884ef7df8bb4d 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
@@ -139,8 +139,9 @@ constexpr TypeBuilderFunc getModel<void *>() {
template <>
constexpr TypeBuilderFunc getModel<void (*)(int)>() {
return [](mlir::MLIRContext *context) -> mlir::Type {
- return fir::LLVMPointerType::get(context,
- mlir::IntegerType::get(context, 8));
+ return fir::LLVMPointerType::get(
+ context,
+ mlir::FunctionType::get(context, /*inputs=*/{}, /*results*/ {}));
};
}
template <>
>From 8c525683597c2a7981280ba1920ab70b4e855120 Mon Sep 17 00:00:00 2001
From: Tom Eccles <tom.eccles at arm.com>
Date: Thu, 25 Jan 2024 11:12:00 +0000
Subject: [PATCH 4/4] Remove Windows special case
It turns out SIG_DFL and SIG_IGN are part of the C89 standard so I presume
they are supported on Windows.
---
.../Optimizer/Builder/Runtime/Intrinsics.cpp | 51 ++++++-------------
1 file changed, 16 insertions(+), 35 deletions(-)
diff --git a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
index 022f8b97cd37272..638bfd60a246a64 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
@@ -245,45 +245,12 @@ void fir::runtime::genSignal(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value number, mlir::Value handler,
mlir::Value status) {
assert(mlir::isa<mlir::IntegerType>(number.getType()));
- if (status)
- assert(mlir::isa<mlir::IntegerType>(fir::unwrapRefType(status.getType())));
mlir::Type int64 = builder.getIntegerType(64);
number = builder.create<fir::ConvertOp>(loc, int64, number);
- // we can return like a function or via the status argument
- auto returnStatus = [&](mlir::Value stat) -> mlir::Value {
- if (status) {
- // status might be dynamically optional, so test if it is present
- mlir::Value isPresent =
- builder.create<IsPresentOp>(loc, builder.getI1Type(), status);
- builder.genIfOp(loc, /*results=*/{}, isPresent, /*withElseRegion=*/false)
- .genThen([&]() {
- stat = builder.create<fir::ConvertOp>(
- loc, fir::unwrapRefType(status.getType()), stat);
- builder.create<fir::StoreOp>(loc, stat, status);
- })
- .end();
- }
- return {};
- };
-
mlir::Type handlerUnwrappedTy = fir::unwrapRefType(handler.getType());
if (mlir::isa_and_nonnull<mlir::IntegerType>(handlerUnwrappedTy)) {
-#if _WIN32
- // The windows documentation doesn't mention any support for passing
- // SIG_DFL or SIG_IGN as integer arguments, so just return an error.
-
- // reinterpret cast: the GNU extension is defined with STATUS as an integer
- // but on Windows SIG_ERR is a void *
- const std::int64_t sigErrVal =
- static_cast<std::int64_t>(reinterpret_cast<std::uintptr_t>(SIG_ERR));
- mlir::Value sigErr = builder.createIntegerConstant(loc, int64, sigErrVal);
- returnStatus(sigErr);
- errno = EINVAL;
- return;
-#endif // _WIN32
- // else just pass the integer as a function pointer like one would to
- // signal(2)
+ // pass the integer as a function pointer like one would to signal(2)
handler = builder.create<fir::LoadOp>(loc, handler);
mlir::Type fnPtrTy = fir::LLVMPointerType::get(
mlir::FunctionType::get(handler.getContext(), {}, {}));
@@ -298,7 +265,21 @@ void fir::runtime::genSignal(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value stat =
builder.create<fir::CallOp>(loc, func, mlir::ValueRange{number, handler})
->getResult(0);
- returnStatus(stat);
+
+ // return status code via status argument (if present)
+ if (status) {
+ assert(mlir::isa<mlir::IntegerType>(fir::unwrapRefType(status.getType())));
+ // status might be dynamically optional, so test if it is present
+ mlir::Value isPresent =
+ builder.create<IsPresentOp>(loc, builder.getI1Type(), status);
+ builder.genIfOp(loc, /*results=*/{}, isPresent, /*withElseRegion=*/false)
+ .genThen([&]() {
+ stat = builder.create<fir::ConvertOp>(
+ loc, fir::unwrapRefType(status.getType()), stat);
+ builder.create<fir::StoreOp>(loc, stat, status);
+ })
+ .end();
+ }
}
void fir::runtime::genSleep(fir::FirOpBuilder &builder, mlir::Location loc,
More information about the flang-commits
mailing list