diff --git a/Makefile.MinGW b/Makefile.MinGW index ff4566676..36330c31a 100644 --- a/Makefile.MinGW +++ b/Makefile.MinGW @@ -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 diff --git a/a2d.f90 b/a2d.f90 index 543486a70..07fa80705 100644 --- a/a2d.f90 +++ b/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) diff --git a/astro.F b/astro.F index 955bd5957..5883318ad 100644 --- a/astro.F +++ b/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 diff --git a/astro0.F90 b/astro0.F90 index db264c1ab..4769d94d2 100644 --- a/astro0.F90 +++ b/astro0.F90 @@ -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 diff --git a/decode1.F90 b/decode1.F90 index fdcb1d5f4..80cb74799 100644 --- a/decode1.F90 +++ b/decode1.F90 @@ -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 diff --git a/deep65.F b/deep65.F index dd4aa070b..ee48e0d77 100644 --- a/deep65.F +++ b/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 diff --git a/fthread.c b/fthread.c new file mode 100644 index 000000000..d8b0a13ec --- /dev/null +++ b/fthread.c @@ -0,0 +1,74 @@ +/* +* fthread.c +* +* pthread library interface to Fortran, for OSs supporting pthreads +* +* Adapted from code by V. Ganesh +*/ +#include +#include + +// 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); +} + diff --git a/ftn_init.F90 b/ftn_init.F90 index 7e525a413..b40f1f021 100644 --- a/ftn_init.F90 +++ b/ftn_init.F90 @@ -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' diff --git a/map65.py b/map65.py index 646a7a18c..25810b37a 100644 --- a/map65.py +++ b/map65.py @@ -1,4 +1,4 @@ -#----------------------------------------------------------------------- MAP65 +#------------------------------------------------------------------------ MAP65 # $Date$ $Revision$ # from Tkinter import * diff --git a/thcvf.f90 b/thcvf.f90 new file mode 100644 index 000000000..9285c6a32 --- /dev/null +++ b/thcvf.f90 @@ -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 diff --git a/thnix.f90 b/thnix.f90 new file mode 100644 index 000000000..271bc2836 --- /dev/null +++ b/thnix.f90 @@ -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