mirror of
https://github.com/saitohirga/WSJT-X.git
synced 2024-11-03 16:01:18 -05:00
65 lines
1.4 KiB
Fortran
65 lines
1.4 KiB
Fortran
|
subroutine cs_init
|
||
|
|
use dfmt
|
||
|
|
type (RTL_CRITICAL_SECTION) ncrit1
|
||
|
|
character*12 csub0
|
||
|
|
common/mtxcom/ltrace,mtx,mtxstate,csub0
|
||
|
|
ltrace=1
|
||
|
|
mtx=loc(ncrit1)
|
||
|
|
mtxstate=0
|
||
|
|
csub0='**unlocked**'
|
||
|
|
call InitializeCriticalSection(mtx)
|
||
|
|
return
|
||
|
|
end subroutine cs_init
|
||
|
|
|
||
|
|
subroutine cs_destroy
|
||
|
|
use dfmt
|
||
|
|
type (RTL_CRITICAL_SECTION) ncrit1
|
||
|
|
character*12 csub0
|
||
|
|
common/mtxcom/ltrace,mtx,mtxstate,csub0
|
||
|
|
call DeleteCriticalSection(mtx)
|
||
|
|
return
|
||
|
|
end subroutine cs_destroy
|
||
|
|
|
||
|
|
subroutine th_create(sub)
|
||
|
|
use dfmt
|
||
|
|
external sub
|
||
|
|
ith=CreateThread(0,0,sub,0,0,id)
|
||
|
|
return
|
||
|
|
end subroutine th_create
|
||
|
|
|
||
|
|
subroutine th_exit
|
||
|
|
use dfmt
|
||
|
|
ncode=0
|
||
|
|
call ExitThread(ncode)
|
||
|
|
return
|
||
|
|
end subroutine th_exit
|
||
|
|
|
||
|
|
subroutine cs_lock(csub)
|
||
|
|
use dfmt
|
||
|
|
character*(*) csub
|
||
|
|
character*12 csub0
|
||
|
|
common/mtxcom/ltrace,mtx,mtxstate,csub0
|
||
|
|
n=TryEnterCriticalSection(mtx)
|
||
|
|
if(n.eq.0) then
|
||
|
|
! Another thread has already locked the mutex
|
||
|
|
call EnterCriticalSection(mtx)
|
||
|
|
iz=index(csub0,' ')
|
||
|
|
if(ltrace.ge.1) print*,'"',csub,'" requested the mutex when "', &
|
||
|
|
csub0(:iz-1),'" owned it.'
|
||
|
|
endif
|
||
|
|
mtxstate=1
|
||
|
|
csub0=csub
|
||
|
|
if(ltrace.ge.3) print*,'Mutex locked by ',csub
|
||
|
|
return
|
||
|
|
end subroutine cs_lock
|
||
|
|
|
||
|
|
subroutine cs_unlock
|
||
|
|
use dfmt
|
||
|
|
character*12 csub0
|
||
|
|
common/mtxcom/ltrace,mtx,mtxstate,csub0
|
||
|
|
mtxstate=0
|
||
|
|
if(ltrace.ge.3) print*,'Mutex unlocked'
|
||
|
|
call LeaveCriticalSection(mtx)
|
||
|
|
return
|
||
|
|
end subroutine cs_unlock
|