Skip to content

Commit

Permalink
Use iso_c_binding for building signal handlers
Browse files Browse the repository at this point in the history
  • Loading branch information
awvwgk committed May 7, 2022
1 parent 76c6af2 commit 7906b97
Show file tree
Hide file tree
Showing 3 changed files with 31 additions and 14 deletions.
14 changes: 10 additions & 4 deletions src/mctc/error.f90
Original file line number Diff line number Diff line change
Expand Up @@ -66,14 +66,20 @@ subroutine terminate(signal)
end select
end subroutine terminate

subroutine wsigint
subroutine xtb_wsigint(signal) bind(c)
use, intrinsic :: iso_c_binding, only : c_int
use xtb_mctc_io, only : stderr
implicit none
integer(c_int), intent(in) :: signal
write(stderr,'("recieved SIGINT, terminating...")')
call terminate(-1)
end subroutine wsigint
end subroutine xtb_wsigint

subroutine wsigterm
subroutine xtb_wsigterm(signal) bind(c)
use, intrinsic :: iso_c_binding, only : c_int
use xtb_mctc_io, only : stderr
implicit none
integer(c_int), intent(in) :: signal
write(stderr,'("recieved SIGTERM, terminating...")')
call terminate(-1)
end subroutine wsigterm
end subroutine xtb_wsigterm
26 changes: 18 additions & 8 deletions src/mctc/mctc_init.F90
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,7 @@
! along with xtb. If not, see <https://www.gnu.org/licenses/>.

subroutine mctc_init(progname,ntimer,verbose)
use, intrinsic :: iso_c_binding, only : c_int, c_funptr, c_funloc
use xtb_mctc_global
use xtb_mctc_timings
use xtb_mctc_filetools
Expand All @@ -30,17 +31,26 @@ subroutine mctc_init(progname,ntimer,verbose)

!! ========================================================================
! signal processing
external :: wSIGTERM
external :: wSIGINT
interface
subroutine xtb_wsigint(signal) bind(C)
import :: c_int
integer(c_int), value :: signal
end subroutine xtb_wsigint
subroutine xtb_wsigterm(signal) bind(C)
import :: c_int
integer(c_int), value :: signal
end subroutine xtb_wsigterm
subroutine xtb_signal_handler(signal, handler) bind(C)
import :: c_int, c_funptr
integer(c_int), value :: signal
type(c_funptr), value :: handler
end subroutine xtb_signal_handler
end interface
! here two important signal handlers are installed, it seems that
! FORTRAN by itself cannot handle signals in the way I expected it
! to do, but this will force it to die when I hit CTRL^C.
! UPDATE: Since the FORTRAN standard does not specify which signals
! are handled by the language, some compilers may handle no
! signals at all. This is *non-standard* so it will break
! your program on some platforms with some compilers!
call signal(2,wSIGINT)
call signal(15,wSIGTERM)
call xtb_signal_handler(2_c_int, c_funloc(wSIGINT))
call xtb_signal_handler(15_c_int, c_funloc(wSIGTERM))

! initialize the timing system
call start_timing_run
Expand Down
5 changes: 3 additions & 2 deletions src/mctc/signal.c
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,8 @@

typedef void (*sighandler_t)(int);

void signal_( int* signum, sighandler_t handler)
void
xtb_signal_handler(int signum, sighandler_t handler)
{
signal(*signum, handler);
signal(signum, handler);
}

0 comments on commit 7906b97

Please sign in to comment.