source: trunk/signal-checkpoint/signal_checkpoint.F90 @ 70

!--------------------------------------------------------------!
! 2012/04/20 (C) Gabriel Moreau
! Licence LGPLv2 or letter
! $Id: signal_checkpoint.F90 70 2012-05-25 16:16:35Z g7moreau $
!--------------------------------------------------------------!

module Signal_Checkpoint

#ifdef __INTEL_COMPILER
use IFPORT, only: signal
#endif

implicit none
private

integer, external :: signal_checkpoint_trap_callback_intel_
external          :: signal_checkpoint_trap_callback_gfortran_

integer, parameter :: SIGHUP  =  1  ! Signal HUP
integer, parameter :: SIGINT  =  2  ! Signal INT
integer, parameter :: SIGQUIT =  3  ! Signal QUIT
integer, parameter :: SIGUSR1 = 10  ! Signal USR1
integer, parameter :: SIGUSR2 = 12  ! Signal USR2
integer, parameter :: SIGTERM = 15  ! Signal TERM

! False public, only for trap procedure
integer, public :: INTERNAL_RECEIVED_COUNT_ = 0  ! Global Counter
integer, public :: INTERNAL_ERROR_ON_EXIT_  = 0
integer, public :: INTERNAL_SIGNAL_EXIT_    = 0

public :: SIGHUP
public :: SIGINT
public :: SIGQUIT
public :: SIGUSR1
public :: SIGUSR2
public :: SIGTERM
public :: signal_checkpoint_connect
public :: signal_checkpoint_is_received
public :: signal_checkpoint_received_times
public :: signal_checkpoint_ask_for_exit_code

!--------------------------------------------------------------!
contains
!--------------------------------------------------------------!

subroutine signal_checkpoint_connect (SIG_NUM, EXIT)
   integer, intent(in) :: SIG_NUM
   logical, intent(in), optional :: EXIT


#ifdef __INTEL_COMPILER
   integer :: ERR

   if (present(EXIT)) then
      INTERNAL_SIGNAL_EXIT_ = SIG_NUM
   end if

   ERR = signal(SIG_NUM, signal_checkpoint_trap_callback_intel_, -1)
#endif

#ifdef __GNUC__
   intrinsic signal

   if (present(EXIT)) then
      INTERNAL_SIGNAL_EXIT_ = SIG_NUM
   end if

   call signal(SIG_NUM, signal_checkpoint_trap_callback_gfortran_)
#endif

end subroutine

!--------------------------------------------------------------!

function signal_checkpoint_is_received () result (IS_RECEIVED)
   logical :: IS_RECEIVED

   IS_RECEIVED = (INTERNAL_RECEIVED_COUNT_ > 0)
end function

!--------------------------------------------------------------!

function signal_checkpoint_received_times () result (RECEIVED_TIMES)
   integer :: RECEIVED_TIMES

   RECEIVED_TIMES = INTERNAL_RECEIVED_COUNT_
end function

!--------------------------------------------------------------!

function signal_checkpoint_ask_for_exit_code () result (EXIT)
   logical :: EXIT
   
   EXIT = ( INTERNAL_ERROR_ON_EXIT_ /= 0 )
end function

!--------------------------------------------------------------!
end module
!--------------------------------------------------------------!


!--------------------------------------------------------------!
! Internal trap procedure and function
! Must be external to be C compatible
!--------------------------------------------------------------!

subroutine signal_checkpoint_trap_callback_gfortran_ (SIG_NUM)
   use Signal_Checkpoint
   integer, intent(in) :: SIG_NUM

!       print *, "SIG1 : ", SIG_NUM
!  if (SIG_NUM == INTERNAL_SIGNAL_EXIT_) then
!      print *, "SIG2 : ", INTERNAL_SIGNAL_EXIT_
!      INTERNAL_ERROR_ON_EXIT_ = 1
!      print *, "SIG3 : ", INTERNAL_SIGNAL_EXIT_
!   end if
   INTERNAL_RECEIVED_COUNT_ = INTERNAL_RECEIVED_COUNT_ + 1
end subroutine

!--------------------------------------------------------------!

function signal_checkpoint_trap_callback_intel_ (SIG_NUM) result (ONE)
   use Signal_Checkpoint
   integer, intent(in) :: SIG_NUM
   integer :: ONE

!   if (SIG_NUM == INTERNAL_SIGNAL_EXIT_) then
!      INTERNAL_ERROR_ON_EXIT_ = 1
!   end if
   INTERNAL_RECEIVED_COUNT_ = INTERNAL_RECEIVED_COUNT_ + 1
   ONE = 1
end

!--------------------------------------------------------------!
!--------------------------------------------------------------!