signal handling example

Author: scivision

CMakeLists.txt

@@ -35,3 +35,5 @@ set(CMAKE_CXX_STANDARD 11)
 add_subdirectory(c)
 
 add_subdirectory(cxx)
+
+add_subdirectory(signal)

signal/CMakeLists.txt

@@ -0,0 +1,10 @@
+add_library(c_sigint OBJECT c_interface.c)
+
+add_library(c_ifc OBJECT c_interface.F90)
+
+add_executable(waitForSIGINT $<TARGET_OBJECTS:c_sigint> $<TARGET_OBJECTS:c_ifc>)
+if(WIN32)
+  target_sources(waitForSIGINT PRIVATE main_windows.f90)
+else()
+  target_sources(waitForSIGINT PRIVATE main_unix.f90)
+endif()

signal/README.md

@@ -0,0 +1 @@
+Fortran signal handling, based on https://fortran-lang.discourse.group/t/volatile-needed/1648

signal/c_interface.F90

@@ -0,0 +1,23 @@
+module c_interface
+
+use, intrinsic :: ISO_C_Binding, only: C_FUNPTR
+
+implicit none (type, external)
+
+interface
+
+subroutine signalterm_C(handler) bind(C)
+import C_FUNPTR
+type(C_FUNPTR), intent(in), value :: handler
+end subroutine signalterm_C
+
+#ifndef __WIN32__
+subroutine signalusr1_C(handler) bind(C)
+import C_FUNPTR
+type(C_FUNPTR), intent(in), value :: handler
+end subroutine signalusr1_C
+#endif
+
+end interface
+
+end module c_interface

signal/c_interface.c

@@ -0,0 +1,11 @@
+#include <signal.h>
+
+void signalterm_c(void (*handler)(int)){
+  signal(SIGTERM, handler);
+}
+
+#ifndef __WIN32__
+void signalusr1_c(void (*handler)(int)){
+  signal(SIGUSR1, handler);
+}
+#endif

signal/main_unix.f90

@@ -0,0 +1,70 @@
+program wait_for_SIGTERM
+use, intrinsic :: ISO_C_binding
+
+use c_interface
+
+implicit none (type, external)
+
+logical, volatile :: interface_SIGTERM, interface_SIGUSR1
+
+call init
+
+do while( .not. interface_SIGTERM)
+enddo
+
+contains
+
+subroutine init()
+
+call signalterm_c(c_funloc(catchSIGTERM))
+call signalusr1_c(c_funloc(catchSIGUSR1))
+call interface_setSIGTERM(.false.)
+call interface_setSIGUSR1(.false.)
+
+end subroutine init
+
+subroutine catchSIGTERM(signal) bind(C)
+!! Set global variable interface_SIGTERM to .true.
+!! details This function can be registered to catch signals send to the executable.
+integer(C_INT), value :: signal
+
+
+print'(a,i0)', ' received signal ',signal
+call interface_setSIGTERM(.not. interface_SIGTERM)
+
+end subroutine catchSIGTERM
+
+
+subroutine catchSIGUSR1(signal) bind(C)
+!! Set global variable interface_SIGUSR1 to .true.
+!! This function can be registered to catch signals send to the executable.
+integer(C_INT), value :: signal
+
+print'(a,i0)', ' received signal ',signal
+call interface_setSIGUSR1(.not. interface_SIGUSR1)
+
+end subroutine catchSIGUSR1
+
+
+subroutine interface_setSIGTERM(state)
+!! Set global variable interface_SIGTERM.
+logical, intent(in) :: state
+
+
+interface_SIGTERM = state
+print*, 'set SIGTERM to',state
+
+end subroutine interface_setSIGTERM
+
+
+subroutine interface_setSIGUSR1(state)
+!! Set global variable interface_SIGUSR.
+logical, intent(in) :: state
+
+
+interface_SIGUSR1 = state
+print*, 'set SIGUSR1 to',state
+
+end subroutine interface_setSIGUSR1
+
+end program

signal/main_windows.f90

@@ -0,0 +1,49 @@
+program wait_for_SIGTERM
+use, intrinsic :: ISO_C_binding
+
+use c_interface
+
+implicit none (type, external)
+
+logical, volatile :: interface_SIGTERM
+
+call init
+
+do while( .not. interface_SIGTERM)
+
+
+enddo
+
+contains
+
+subroutine init()
+
+call signalterm_c(c_funloc(catchSIGTERM))
+call interface_setSIGTERM(.false.)
+
+end subroutine init
+
+subroutine catchSIGTERM(signal) bind(C)
+!! Set global variable interface_SIGTERM to .true.
+!! details This function can be registered to catch signals send to the executable.
+integer(C_INT), value :: signal
+
+
+print'(a,i0)', ' received signal ',signal
+call interface_setSIGTERM(.not. interface_SIGTERM)
+
+end subroutine catchSIGTERM
+
+
+subroutine interface_setSIGTERM(state)
+!! Set global variable interface_SIGTERM.
+logical, intent(in) :: state
+
+
+interface_SIGTERM = state
+print*, 'set SIGTERM to',state
+
+end subroutine interface_setSIGTERM
+
+
+end program