Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

[flang][Runtime] Add SIGNAL intrinisic #79337

Closed
wants to merge 4 commits into from

Conversation

tblah
Copy link
Contributor

@tblah tblah commented Jan 24, 2024

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 change seemed too large to be justified by a non-standard intrinsic.

I have not found open source code using this intrinsic. This is needed for a proprietary code base.

@llvmbot
Copy link
Collaborator

llvmbot commented Jan 24, 2024

@llvm/pr-subscribers-flang-fir-hlfir
@llvm/pr-subscribers-flang-semantics

@llvm/pr-subscribers-flang-runtime

Author: Tom Eccles (tblah)

Changes

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 change seemed too large to be justified by a non-standard intrinsic.

I have not found open source code using this intrinsic. This is needed for a proprietary code base.


Full diff: https://github.com/llvm/llvm-project/pull/79337.diff

10 Files Affected:

  • (modified) flang/docs/Intrinsics.md (+1-1)
  • (modified) flang/include/flang/Optimizer/Builder/IntrinsicCall.h (+1)
  • (modified) flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h (+7)
  • (modified) flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h (+7)
  • (modified) flang/include/flang/Runtime/extensions.h (+4)
  • (modified) flang/lib/Evaluate/intrinsics.cpp (+12)
  • (modified) flang/lib/Optimizer/Builder/IntrinsicCall.cpp (+16)
  • (modified) flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp (+65)
  • (modified) flang/runtime/extensions.cpp (+12)
  • (added) flang/test/Lower/Intrinsics/signal.f90 (+77)
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index 5ade25740329771..b1eba7692e49218 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, SIGNAL, 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 80f79d42fc2b75c..115e018b9d513d5 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 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..e316d5dcd580617 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
 
@@ -64,6 +65,12 @@ 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 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);
+
 } // 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 1ed750f3b70e0f3..977f9324dd97167 100644
--- a/flang/include/flang/Runtime/extensions.h
+++ b/flang/include/flang/Runtime/extensions.h
@@ -14,6 +14,7 @@
 
 #define FORTRAN_PROCEDURE_NAME(name) name##_
 
+#include "flang/Runtime/entry-names.h"
 #include <cstddef>
 #include <cstdint>
 
@@ -35,5 +36,8 @@ 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));
+
 } // extern "C"
 #endif // FORTRAN_RUNTIME_EXTENSIONS_H_
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index da6d5970089884c..a53ee27a52f6e61 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},
 };
 
 // TODO: Intrinsic subroutine EVENT_QUERY
@@ -1412,9 +1421,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 a0baa409fe44b4b..e2ab8e51258dd60 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},
@@ -5578,6 +5582,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 63d66adf222f640..85357f1d937782e 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"
@@ -20,6 +21,7 @@
 #include "flang/Semantics/tools.h"
 #include "llvm/Support/Debug.h"
 #include <optional>
+#include <signal.h>
 
 #define DEBUG_TYPE "flang-lower-runtime"
 
@@ -235,3 +237,66 @@ void fir::runtime::genSystemClock(fir::FirOpBuilder &builder,
   if (max)
     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);
+}
diff --git a/flang/runtime/extensions.cpp b/flang/runtime/extensions.cpp
index 2740c854b807818..1b5a726cf86c5ca 100644
--- a/flang/runtime/extensions.cpp
+++ b/flang/runtime/extensions.cpp
@@ -16,6 +16,7 @@
 #include "flang/Runtime/descriptor.h"
 #include "flang/Runtime/io-api.h"
 #include <ctime>
+#include <signal.h>
 
 #ifdef _WIN32
 inline void CtimeBuffer(char *buffer, size_t bufsize, const time_t cur_time,
@@ -113,5 +114,16 @@ 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));
+}
+
 } // namespace Fortran::runtime
 } // extern "C"
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

@klausler klausler removed their request for review January 24, 2024 17:42
Copy link
Contributor

@vzakhari vzakhari left a comment

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Thanks for the changes!

@@ -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,
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I am not sure if it matters, but why not use a function pointer type? I guess a void (*)() type would do for any function pointer returning void.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Thanks for taking a look, yeah I'll update it so that it is easier to read. But I don't think it matters. Since LLVM 17 there has been no support for typed pointers in LLVM IR: https://llvm.org/docs/OpaquePointers.html

static_cast<std::int64_t>(reinterpret_cast<std::uintptr_t>(SIG_ERR));
mlir::Value sigErr = builder.createIntegerConstant(loc, int64, sigErrVal);
returnStatus(sigErr);
errno = EINVAL;
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

What effect does this have?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Here I am trying to emulate what signal would do when given an invalid argument. errno is a global variable and wouldn't be difficult to declare and read from in the fortran program using signal, so I added this just in case. EINVAL generally means something like "invalid argument".

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Hmm, but errno is set here during the compilation not during the program execution. Am I missing something?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Ahh you are right. Oops!

I will remove the special case for windows. SIG_IGN and SIG_DFL are in C89 so the Windows implementation of signal may still support them, and if they aren't, presumably the programmer would realize while trying to look up/include the correct integer constants to use.

@kiranchandramohan
Copy link
Contributor

I have not found open source code using this intrinsic.

The CFL3D code in NASA's repository uses it. https://github.com/nasa/CFL3D/blob/776d5169f34d26ae65701c87038e63b125b7d86a/source/ronnie/main.F#L136

The Windows CI is failing.

******************** TEST 'Flang :: Lower/Intrinsics/signal.f90' FAILED ********************
  | Exit Code: 1
  |  
  | Command Output (stdout):
  | --
  | # RUN: at line 2
  | bbc -emit-hlfir -o - C:\ws\src\flang\test\Lower\Intrinsics\signal.f90 \| c:\ws\src\build\bin\filecheck.exe C:\ws\src\flang\test\Lower\Intrinsics\signal.f90
  | # executed command: bbc -emit-hlfir -o - 'C:\ws\src\flang\test\Lower\Intrinsics\signal.f90'
  | # note: command had no output on stdout or stderr
  | # executed command: 'c:\ws\src\build\bin\filecheck.exe' 'C:\ws\src\flang\test\Lower\Intrinsics\signal.f90'
  | # .---command stderr------------
  | # \| C:\ws\src\flang\test\Lower\Intrinsics\signal.f90:52:10: error: CHECK: expected string not found in input
  | # \| ! CHECK: %[[VAL_30:.*]] = arith.constant 1 : i32
  | # \|          ^
  | # \| <stdin>:81:36: note: scanning from here
  | # \|  %c12_i32 = arith.constant 12 : i32
  | # \|                                    ^
  | # \| <stdin>:85:4: note: possible intended match here
  | # \|  %c0_i32 = arith.constant 0 : i32
  | # \|    ^
  | # \|
  | # \| Input file: <stdin>
  | # \| Check file: C:\ws\src\flang\test\Lower\Intrinsics\signal.f90
  | # \|
  | # \| -dump-input=help explains the following input dump.
  | # \|
  | # \| Input was:
  | # \| <<<<<<
  | # \|             .
  | # \|             .
  | # \|             .
  | # \|            76:  fir.global internal @_QMmFsetup_signalsECsigusr1 constant : i32 {
  | # \|            77:  %c10_i32 = arith.constant 10 : i32
  | # \|            78:  fir.has_value %c10_i32 : i32
  | # \|            79:  }
  | # \|            80:  fir.global internal @_QMmFsetup_signalsECsigusr2 constant : i32 {
  | # \|            81:  %c12_i32 = arith.constant 12 : i32
  | # \| check:52'0                                        X error: no match found
  | # \|            82:  fir.has_value %c12_i32 : i32
  | # \| check:52'0     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  | # \|            83:  }
  | # \| check:52'0     ~~~
  | # \|            84:  fir.global internal @_QMmFsetup_signalsEstat : i32 {
  | # \| check:52'0     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  | # \|            85:  %c0_i32 = arith.constant 0 : i32
  | # \| check:52'0     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  | # \| check:52'1        ?                               possible intended match
  | # \|            86:  fir.has_value %c0_i32 : i32
  | # \| check:52'0     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  | # \|            87:  }
  | # \| check:52'0     ~~~
  | # \|            88:  func.func private @_FortranASignal(i64, !fir.llvm_ptr<() -> ()>) -> i64 attributes {fir.runtime}
  | # \| check:52'0     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  | # \|            89: }
  | # \| check:52'0     ~~
  | # \| >>>>>>
  | # `-----------------------------
  | # error: command failed with exit status: 1
 

@tblah
Copy link
Contributor Author

tblah commented Jan 25, 2024

The CFL3D code in NASA's repository uses it. https://github.com/nasa/CFL3D/blob/776d5169f34d26ae65701c87038e63b125b7d86a/source/ronnie/main.F#L136

Thanks for finding this. Do you know off the top of your head which compiler they are using? The 3 argument version seems to be using a defintion which is not compatible with the GFortran version that I have implemented here (the third argument is an INTENT(OUT) and they are passing a literal -1).

@tblah
Copy link
Contributor Author

tblah commented Jan 25, 2024

The CFL3D code in NASA's repository uses it. https://github.com/nasa/CFL3D/blob/776d5169f34d26ae65701c87038e63b125b7d86a/source/ronnie/main.F#L136

Thanks for finding this. Do you know off the top of your head which compiler they are using? The 3 argument version seems to be using a defintion which is not compatible with the GFortran version that I have implemented here (the third argument is an INTENT(OUT) and they are passing a literal -1).

CFL3D has an example Makefile using gfortran, but in my own test, if -1 is given as the status argument, gfortran will generate code that segfaults.

It looks like ifort has a different definition of the third argument: https://www.intel.com/content/www/us/en/docs/fortran-compiler/developer-guide-reference/2023-0/signal.html.

I will update to make status INTENT(INOUT) and supporting the ifort flags.

It wouldn't be easy to support both meanings of this argument, because junk values left in the variable passed as the status argument might be misinterpreted, and we can't pass literals to an INTENT(INOUT) argument.

Flang-new does correctly refuse to compile the code in CFL3D. I propose we continue to follow the gfortran intrinsic.

@tblah
Copy link
Contributor Author

tblah commented Jan 26, 2024

I'm not sure what went wrong with Windows CI, but it probably is not related to this patch. I'll run it again after rebasing.

[5379/5382] Generating ../../../../include/flang/ieee_exceptions.f18.mod
[5380/5382] Generating ../../../../incllvm-lit.py: C:\ws\src\llvm\utils\lit\lit\llvm\config.py:57: note: using lit tools: C:\Program Files\Git\usr\bin
llvm-lit.py: C:\ws\src\llvm\utils\lit\lit\llvm\config.py:270: fatal: Could not run process ['C:/ws/src/build/./bin\\llvm-config', '--assertion-mode']
lude/flang/ieee_arithmetic.mod
[5381/5382] Generating ../../../../include/flang/ieee_arithmetic.f18.mod
[5381/5382] Running the Flang regression tests
FAILED: tools/flang/test/CMakeFiles/check-flang
cmd.exe /C "cd /D C:\ws\src\build\tools\flang\test && C:\Python39\python.exe C:/ws/src/build/./bin/llvm-lit.py -v --xunit-xml-output C:/ws/src/build/test-results.xml --timeout=1200 --time-tests --param flang_site_config=C:/ws/src/build/tools/flang/test/lit.site.cfg.py C:/ws/src/build/tools/flang/test"
ninja: build stopped: subcommand failed.

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.
It turns out SIG_DFL and SIG_IGN are part of the C89 standard so I presume
they are supported on Windows.
tblah added a commit that referenced this pull request Jan 26, 2024
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.
@yi-wu-arm
Copy link
Contributor

yi-wu-arm commented Jan 26, 2024

I've built it on Windows MSVC and it passed all tests.

@tblah
Copy link
Contributor Author

tblah commented Jan 26, 2024

I resolved conflicts and merged manually. See afa52de

@tblah tblah closed this Jan 26, 2024
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
flang:fir-hlfir flang:runtime flang:semantics flang Flang issues not falling into any other category
Projects
None yet
Development

Successfully merging this pull request may close these issues.

None yet

5 participants