Strange behavior of Start-Pause-Continue-Stop code

Finally I made Start-Pause-Continue-Stop prototype partially working via multithreading. Nobody unfortunately succeeded to make it working regular Clearwin way. 'Partially' because... This code works if compile it this way

ftn95 runpausestop.F95 /undef /check /full_debug /clr /link /free /multi_threaded

but if add /win (to remove unneaded black screen) then it freezes when you click start-pause-continue-stop-start-pause-continue-stop etc....several times. What's wrong?

module coommoncrap
  real*8 progressBar1, progressBar2 
  integer btenab1, btpause1, btcontinue1, btStop1 
  integer btenab2, btpause2, btcontinue2, btStop2 
  integer k_pause1,k_Stop1, k_pause2,k_Stop2
end module coommoncrap

  program runpausestop 
  use coommoncrap  
  include <clearwin.ins>

  integer  cb_s1, cb_s2
  external cb_s1, cb_s2

  btenab1=1; btpause1=0; btcontinue1=0; btStop1=0;
  btenab2=1; btpause2=0; btcontinue2=0; btStop2=0;
  k_pause1=0; k_Stop1= 0

  i=winio@ ('%ww%ca[Run-pause-stop]%sy[3d_thin]&') 
  i=winio@ ('%50.10cw%ff%nl&', 56) 
  i=winio@ ('%50br %nl%ff&', progressBar1, RGB@(255,0,0) )
  i=winio@ ('%50br %nl%ff&', progressBar2, RGB@(211,255,0) )
  i=winio@('%~^tt[Run Th1]&', btenab1, cb_s1) 
  i=winio@('%~^tt[Pause]&', btpause1, 'set',k_pause1,1) 
  i=winio@('%~^tt[Continue]&', btContinue1, 'set',k_pause1,0) 
  i=winio@('%~^tt[Stop]%ff&', btStop1, 'set',k_Stop1,1) 
  i=winio@('%~^tt[Run Th2]%ff&', btenab2, cb_s2) 
  i=winio@('%ac[Esc]','exit') 
  end 

!---------------------- 
integer function cb_s1()
  include <clearwin.ins>
  external run1
  CALL CREATE_THREAD@(run1,42)
  cb_s1=1
end
integer function cb_s2()
  include <clearwin.ins>
  external run2
  CALL CREATE_THREAD@(run2,43)
  cb_s2=1
end

subroutine run1()
  use coommoncrap
  include <clearwin.ins>
  assembly_external (name='System.Threading.Thread.Sleep') thread_sleep

  lock   
  write(56,*)'1 is running'
  btpause1=1; btcontinue1=0; btStop1=1
  btenab1 = 0;    k_pause1=0; k_Stop1= 0
  call window_update@(btenab1)	
  end lock 

  a=2.0; n_DOcycles=50 
  do k=1,n_DOcycles
  progressBar1= k/(n_DOcycles+0.01)
  call window_update@(progressBar1)	
  do i=1,5000000 
  a=alog(exp(a)) 
    if(k_Stop1.eq.1) goto 1000
    if(btcontinue1.eq.1) btcontinue1=0
    do while (k_pause1.eq.1)
    if(btcontinue1.eq.0) btcontinue1=1
    if(k_Stop1.eq.1) goto 1000
    CALL TEMPORARY_YIELD@
    call sleep1@(0.5)
    call sound@(5555,1)
    enddo
  enddo 
  enddo 
1000  k_pause1=0
  lock;   write(56,*)'1 ended' 
  btenab1=1; btpause1=0; btcontinue1=0; btStop1=0; call window_update@(btenab1)	
  end lock
  call thread_sleep(50)
  
end 
!---------------------- 
subroutine run2()
  use coommoncrap
  include <clearwin.ins>

  lock;   write(56,*)'2 is running' 
  btenab2 = 0;  call window_update@(btenab2)	
  end lock
  a=2.0; n_DOcycles=10  
  do k=1, n_DOcycles
  progressBar2= k/(n_DOcycles+0.01)
  call window_update@(progressBar2)	
  do i=1,5000000 
  a=alog(exp(a)) 
  enddo 
  enddo 
  lock;   write(56,*) '2 ended' 
  btenab2 = 1;  call window_update@(btenab2)	
  end lock
end

Dan,

The documentation on crerate_thread@ states that the subroutines being started need an integer parameter, i.e. subroutine run1(icode), yours are missing.

Secondly, it says that .net provides multi-threading, a cursory glance does not show win32. Are you using .net?

Regards

Ian

Here run1 and run2 are two different subroutines. If this is just one subroutine and it is re-used in many threads, like in Threads example in Demo, then yes, we need additional parameter, as I understand documentation.

The only I suspect is bad in my code is that I open threads but do not close them....Could be this a reason of crash...(?)

Actually, I read the documentation as the create_thread@ expects the additional parameter, and one should have it present even if you don't use it.

Regards Ian

With method of trys and fails I found solution, which is still strange. If we add before this line line

1000  k_pause1=0

these two lines

1000   CALL TEMPORARY_YIELD@
       call sleep1@(0.015)
  k_pause1=0

or just one line call sleep1@(0.015) :roll: it works with no problem. Andrew, Paul, what is going on? Was and still is something wrong in my code?