mirror of https://github.com/saitohirga/WSJT-X.git
Starting to insert mutex lockouts around Fortran I/O
git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/map65@1298 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
This commit is contained in:
Joe Taylor
parent
11548e07bf
commit
174936fe37
|
|
@ -3,7 +3,7 @@
|
|||
CC = /mingw/bin/gcc
|
||||
FC = g95
|
||||
CFLAGS = -I. -fPIC
|
||||
FFLAGS = -Wall -Wno-precision-loss -fbounds-check -fPIC
|
||||
FFLAGS = -Wall -Wno-precision-loss -fbounds-check -fPIC -fno-second-underscore
|
||||
|
||||
.f.o:
|
||||
${FC} ${CPPFLAGS} ${FFLAGS} -c -o ${<:.f=.o} $<
|
||||
|
|
@ -19,7 +19,7 @@ SRCF90 = a2d.f90 astro0.f90 audio_init.f90 azdist0.f90 \
|
|||
runqqq.f90 fivehz.f90 flushqqq.f90 \
|
||||
rfile.f90 rfile3a.F90 spec.f90 map65a.F90 display.F90 \
|
||||
getfile.f90 getfile2.f90 recvpkt.f90 savetf2.F90 \
|
||||
symspec.f90 sec_midn.F90 getdphi.f90
|
||||
symspec.f90 sec_midn.F90 getdphi.f90 thnix.f90
|
||||
|
||||
SRCCOM = datcom.f90 gcom1.f90 gcom2.f90 gcom3.f90 gcom4.f90 spcom.f90
|
||||
|
||||
|
|
@ -38,8 +38,7 @@ SRCF77 = indexx.f gen65.f chkmsg.f \
|
|||
|
||||
SRC2F77 = four2a.f filbig.f
|
||||
|
||||
SRCS2C = ptt.c igray.c wrapkarn.c cutil.c \
|
||||
start_portaudio.c
|
||||
SRCS2C = ptt.c igray.c wrapkarn.c cutil.c start_portaudio.c fthread.c
|
||||
|
||||
OBJF77 = ${SRCF77:.f=.o}
|
||||
|
||||
|
|
@ -62,7 +61,7 @@ map65.spec: map65.py astro.py g.py options.py palettes.py smeter.py specjt.py
|
|||
--icon wsjt.ico --tk --onefile map65.py
|
||||
|
||||
deep65.o: deep65.F
|
||||
$(FC) -c -O0 -Wall -fPIC deep65.F
|
||||
$(FC) -c -O0 -Wall -fPIC -fno-second-underscore deep65.F
|
||||
|
||||
jtaudio.o: jtaudio.c
|
||||
$(CC) -c -DWin32 -o jtaudio.o jtaudio.c
|
||||
|
|
@ -97,6 +96,6 @@ plrr_subs.o: plrr_subs_win.c
|
|||
.PHONY : clean
|
||||
|
||||
clean:
|
||||
rm *.o Audio.pyd map65.spec MAP65.EXE
|
||||
rm -f *.o Audio.pyd map65.spec MAP65.EXE
|
||||
|
||||
|
||||
|
|
|
|||
3
a2d.f90
3
a2d.f90
|
|
@ -1,4 +1,3 @@
|
|||
!---------------------------------------------------- a2d
|
||||
subroutine a2d(iarg)
|
||||
|
||||
! Start the PortAudio streams for audio input and output.
|
||||
|
|
@ -9,6 +8,7 @@ subroutine a2d(iarg)
|
|||
! This call does not normally return, as the background portion of
|
||||
! JTaudio goes into a test-and-sleep loop.
|
||||
|
||||
call cs_lock('a2d')
|
||||
write(*,1000)
|
||||
1000 format('Using Linrad for input, PortAudio for output.')
|
||||
idevout=ndevout
|
||||
|
|
@ -21,6 +21,7 @@ subroutine a2d(iarg)
|
|||
if(idevout.lt.0 .or. idevout.ge.numdevs) idevout=ndefout
|
||||
if(idevout.eq.0) idevout=ndefout
|
||||
idevin=0
|
||||
call cs_unlock
|
||||
ierr=jtaudio(idevin,idevout,y1,y2,NMAX,iwrite,iwave,nwave, &
|
||||
11025,NSPB,TRPeriod,TxOK,ndebug,Transmitting, &
|
||||
Tsec,ngo,nmode,tbuf,ibuf,ndsec)
|
||||
|
|
|
|||
5
astro.F
5
astro.F
|
|
@ -24,11 +24,12 @@ C NB: may want to smooth the Tsky map to 10 degrees or so.
|
|||
if(first) then
|
||||
do i=80,1,-1
|
||||
if(ichar(AppDir(i:i)).ne.0 .and.
|
||||
+ ichar(AppDir(i:i)).ne.32) goto 1
|
||||
+ ichar(AppDir(i:i)).ne.32) go to 1
|
||||
enddo
|
||||
1 lenappdir=i
|
||||
call zero(nsky,180*180)
|
||||
fname=Appdir(1:lenappdir)//'/TSKY.DAT'
|
||||
call cs_lock('astro')
|
||||
#ifdef CVF
|
||||
open(13,file=fname,status='old',form='binary',err=10)
|
||||
read(13) nsky
|
||||
|
|
@ -40,9 +41,11 @@ C NB: may want to smooth the Tsky map to 10 degrees or so.
|
|||
#endif
|
||||
ltsky=.true.
|
||||
first=.false.
|
||||
call cs_unlock
|
||||
endif
|
||||
go to 20
|
||||
10 ltsky=.false.
|
||||
call cs_unlock
|
||||
|
||||
20 call grid2deg(MyGrid,elon,lat)
|
||||
lon=-elon
|
||||
|
|
|
|||
|
|
@ -1,4 +1,3 @@
|
|||
!--------------------------------------------------- astro0
|
||||
subroutine astro0(nyear,month,nday,uth8,nfreq,grid,cauxra,cauxdec, &
|
||||
AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8,ntsky,ndop,ndop00, &
|
||||
dbMoon8,RAMoon8,DecMoon8,HA8,Dgrd8,sd8,poloffset8,xnr8,dfdt,dfdt0, &
|
||||
|
|
@ -16,6 +15,7 @@ subroutine astro0(nyear,month,nday,uth8,nfreq,grid,cauxra,cauxdec, &
|
|||
data uth8z/0.d0/,imin0/-99/
|
||||
save
|
||||
|
||||
call cs_lock('astro0a')
|
||||
auxra=0.
|
||||
i=index(cauxra,':')
|
||||
if(i.eq.0) then
|
||||
|
|
@ -48,6 +48,7 @@ subroutine astro0(nyear,month,nday,uth8,nfreq,grid,cauxra,cauxdec, &
|
|||
if(mode.eq.'JT6M') nmode=4
|
||||
uth=uth8
|
||||
|
||||
call cs_unlock
|
||||
call astro(AppDir,nyear,month,nday,uth,nfreq,hisgrid,2,nmode,1, &
|
||||
AzSun,ElSun,AzMoon,ElMoon,ntsky,doppler00,doppler, &
|
||||
dbMoon,RAMoon,DecMoon,HA,Dgrd,sd,poloffset,xnr,auxra,auxdec, &
|
||||
|
|
@ -96,6 +97,7 @@ subroutine astro0(nyear,month,nday,uth8,nfreq,grid,cauxra,cauxdec, &
|
|||
isec=3600*uth8
|
||||
|
||||
if(isec.ne.isec0 .and. ndecoding.eq.0) then
|
||||
call cs_lock('astro0b')
|
||||
ih=uth8
|
||||
im=mod(imin,60)
|
||||
is=mod(isec,60)
|
||||
|
|
@ -113,6 +115,7 @@ subroutine astro0(nyear,month,nday,uth8,nfreq,grid,cauxra,cauxdec, &
|
|||
call flushqqq(14)
|
||||
nsetftx=0
|
||||
isec0=isec
|
||||
call cs_unlock
|
||||
endif
|
||||
|
||||
return
|
||||
|
|
|
|||
|
|
@ -55,9 +55,11 @@ subroutine decode1(iarg)
|
|||
ns0=999999
|
||||
endif
|
||||
if(n.lt.ns0 .and. utcdate(1:1).eq.'2') then
|
||||
call cs_lock('decode1a')
|
||||
write(21,1001) utcdate(:11)
|
||||
1001 format(/'UTC Date: ',a11/'---------------------')
|
||||
ns0=n
|
||||
call cs_unlock
|
||||
endif
|
||||
|
||||
if(transmitting.eq.1 .and. (sending.ne.sending0 .or. &
|
||||
|
|
@ -67,9 +69,11 @@ subroutine decode1(iarg)
|
|||
is=mod(n,60)
|
||||
cshort=' '
|
||||
if(sendingsh.eq.1) cshort='(Shorthand)'
|
||||
call cs_lock('decode1b')
|
||||
write(21,1010) ih,im,is,mode,sending,cshort
|
||||
1010 format(3i2.2,' Transmitting: ',a6,2x,a28,2x,a11)
|
||||
call flushqqq(21)
|
||||
call cs_unlock
|
||||
sending0=sending
|
||||
sendingsh0=sendingsh
|
||||
mode0=mode
|
||||
|
|
|
|||
10
deep65.F
10
deep65.F
|
|
@ -34,6 +34,8 @@
|
|||
modified=0 !@@@
|
||||
if(mycall.eq.mycall0 .and. hiscall.eq.hiscall0 .and.
|
||||
+ hisgrid.eq.hisgrid0 .and. modified.eq.modified0) go to 30
|
||||
|
||||
call cs_lock('deep65a')
|
||||
rewind 23
|
||||
k=0
|
||||
icall=0
|
||||
|
|
@ -100,7 +102,10 @@ C Insert CQ message
|
|||
enddo
|
||||
10 continue
|
||||
enddo
|
||||
20 ntot=k
|
||||
|
||||
20 continue
|
||||
call cs_unlock
|
||||
ntot=k
|
||||
neme0=neme
|
||||
|
||||
30 mycall0=mycall
|
||||
|
|
@ -141,8 +146,11 @@ C Insert CQ message
|
|||
enddo
|
||||
|
||||
C ### DO NOT REMOVE ###
|
||||
call cs_lock('deep65b')
|
||||
rewind 77
|
||||
write(77,*) p1,p2
|
||||
call cs_unlock
|
||||
|
||||
C ### Works OK without it (in both Windows and Linux) if compiled
|
||||
C ### without optimization. However, in Windows this is a colossal
|
||||
C ### pain because of the way McMillan Installer wants to run the
|
||||
|
|
|
|||
|
|
@ -0,0 +1,74 @@
|
|||
/*
|
||||
* fthread.c
|
||||
*
|
||||
* pthread library interface to Fortran, for OSs supporting pthreads
|
||||
*
|
||||
* Adapted from code by V. Ganesh
|
||||
*/
|
||||
#include <stdio.h>
|
||||
#include <pthread.h>
|
||||
|
||||
// Create a new fortran thread through a subroutine.
|
||||
void fthread_create_(void *(*thread_func)(void *), pthread_t *theThread)
|
||||
{
|
||||
pthread_create(theThread, NULL, thread_func, NULL);
|
||||
}
|
||||
|
||||
/*
|
||||
// Yield control to other threads
|
||||
void fthread_yield_()
|
||||
{
|
||||
pthread_yield();
|
||||
}
|
||||
*/
|
||||
|
||||
// Return my own thread ID
|
||||
pthread_t fthread_self_()
|
||||
{
|
||||
return pthread_self();
|
||||
}
|
||||
|
||||
// Lock the execution of all threads until we have the mutex
|
||||
int fthread_mutex_lock_(pthread_mutex_t **theMutex)
|
||||
{
|
||||
return(pthread_mutex_lock(*theMutex));
|
||||
}
|
||||
|
||||
int fthread_mutex_trylock_(pthread_mutex_t **theMutex)
|
||||
{
|
||||
return(pthread_mutex_trylock(*theMutex));
|
||||
}
|
||||
|
||||
// Unlock the execution of all threads that were stopped by this mutex
|
||||
void fthread_mutex_unlock_(pthread_mutex_t **theMutex)
|
||||
{
|
||||
pthread_mutex_unlock(*theMutex);
|
||||
}
|
||||
|
||||
// Get a new mutex object
|
||||
void fthread_mutex_init_(pthread_mutex_t **theMutex)
|
||||
{
|
||||
*theMutex = (pthread_mutex_t *) malloc(sizeof(pthread_mutex_t));
|
||||
pthread_mutex_init(*theMutex, NULL);
|
||||
}
|
||||
|
||||
// Release a mutex object
|
||||
void fthread_mutex_destroy_(pthread_mutex_t **theMutex)
|
||||
{
|
||||
pthread_mutex_destroy(*theMutex);
|
||||
free(*theMutex);
|
||||
}
|
||||
|
||||
// Waits for thread ID to join
|
||||
void fthread_join(pthread_t *theThread)
|
||||
{
|
||||
int value = 0;
|
||||
pthread_join(*theThread, (void **)&value);
|
||||
}
|
||||
|
||||
// Exit from a thread
|
||||
void fthread_exit_(void *status)
|
||||
{
|
||||
pthread_exit(status);
|
||||
}
|
||||
|
||||
|
|
@ -30,7 +30,8 @@ subroutine ftn_init
|
|||
include 'gcom3.f90'
|
||||
include 'gcom4.f90'
|
||||
|
||||
! print*,'ftn_init.F90 nport=', nport, 'pttport=', pttport
|
||||
call cs_init
|
||||
call cs_lock('ftn_init')
|
||||
i=ptt(nport,pttport,0,iptt) !Clear the PTT line
|
||||
addpfx=' '
|
||||
nrw26=0
|
||||
|
|
@ -146,7 +147,7 @@ subroutine ftn_init
|
|||
open(29,file=appdir(:iz)//'/debug.txt',status='unknown')
|
||||
#endif
|
||||
|
||||
|
||||
call cs_unlock
|
||||
return
|
||||
|
||||
910 print*,'Error opening DECODED.TXT'
|
||||
|
|
|
|||
2
map65.py
2
map65.py
|
|
@ -1,4 +1,4 @@
|
|||
#----------------------------------------------------------------------- MAP65
|
||||
#------------------------------------------------------------------------ MAP65
|
||||
# $Date$ $Revision$
|
||||
#
|
||||
from Tkinter import *
|
||||
|
|
|
|||
|
|
@ -0,0 +1,64 @@
|
|||
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
|
||||
|
|
@ -0,0 +1,54 @@
|
|||
subroutine cs_init
|
||||
character*12 csub0
|
||||
common/mtxcom/ltrace,mtx,mtxstate,csub0
|
||||
ltrace=0
|
||||
mtxstate=0
|
||||
csub0='**unlocked**'
|
||||
call fthread_mutex_init(mtx)
|
||||
return
|
||||
end subroutine cs_init
|
||||
|
||||
subroutine cs_destroy
|
||||
character*12 csub0
|
||||
common/mtxcom/ltrace,mtx,mtxstate,csub0
|
||||
call fthread_mutex_destroy(mtx)
|
||||
return
|
||||
end subroutine cs_destroy
|
||||
|
||||
subroutine th_create(sub)
|
||||
call fthread_create(sub,id)
|
||||
return
|
||||
end subroutine th_create
|
||||
|
||||
subroutine th_exit
|
||||
call fthread_exit
|
||||
return
|
||||
end subroutine th_exit
|
||||
|
||||
subroutine cs_lock(csub)
|
||||
character*(*) csub
|
||||
character*12 csub0
|
||||
integer fthread_mutex_lock,fthread_mutex_trylock
|
||||
common/mtxcom/ltrace,mtx,mtxstate,csub0
|
||||
n=fthread_mutex_trylock(mtx)
|
||||
if(n.ne.0) then
|
||||
! Another thread has already locked the mutex
|
||||
n=fthread_mutex_lock(mtx)
|
||||
iz=index(csub0,' ')
|
||||
if(ltrace.ge.1) print*,'"',csub,'" requested 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
|
||||
character*12 csub0
|
||||
common/mtxcom/ltrace,mtx,mtxstate,csub0
|
||||
if(ltrace.ge.3) print*,'Mutex unlocked,',ltrace,mtx,mtxstate,csub0
|
||||
mtxstate=0
|
||||
call fthread_mutex_unlock(mtx)
|
||||
return
|
||||
end subroutine cs_unlock
|
||||
Loading…
Reference in New Issue