ON TIMER substitute

[anonymous1337]

@DesignDevil: What compiler errors do you get, exactly? The only problem I see is Option Explicit. Just remove those lines.

[DesignDevil]

I try to compile the timer.bas at first - how descriped. But i get these errors:

Code: Select all

timer.bas(38) warning 1(1): Passing scalar as pointer, at parameter 1 of CONDWAIT()
timer.bas(38) error 1: Argument count mismatch
                        condwait( ctx->cond )
                                            ^
timer.bas(77) warning 5(0): Implicit conversion
timer.bas(78) warning 3(1): Passing different pointer types, at parameter 1 of THREADCREATE()
timer.bas(78) warning 1(1): Passing scalar as pointer, at parameter 2 of THREADCREATE()
timer.bas(78) warning 5(0): Implicit conversion
timer.bas(100) warning 1(1): Passing scalar as pointer, at parameter 1 of CONDSIGNAL()
timer.bas(140) warning 1(1): Passing scalar as pointer, at parameter 1 of CONDSIGNAL()
timer.bas(141) warning 1(1): Passing scalar as pointer, at parameter 1 of THREADWAIT()
timer.bas(142) warning 1(1): Passing scalar as pointer, at parameter 1 of CONDDESTROY()

[DesignDevil]

Ok, i think i got it. The wrong point is that there is no MUTEX in the CondWait Statement. I added the Mutex to the structure. I hope that this is correct because it works.

This is the "new" timer.bas:

Code: Select all

'' timer.bas
''
'' simple timer library using threads
'' (note: to use this library *always* compile the client using the -mt option for threading safety)
''
'' to compile: fbc timer.bas -lib
''

#Include Once "timer.bi"

Enum TIMER_STATES
	TIMER_STATE_KILLED
	TIMER_STATE_RUNNING
	TIMER_STATE_STOPPED
	TIMER_STATE_EXITING
End Enum

Type TIMER_CTX
	state		As TIMER_STATES
	interval	As Integer
	callback	As TIMER_CALLBACK
	userdata	As Integer
	cond		As Integer
	thread	As Integer
	mutex    As Integer
End Type

'':::::
Private Sub timer_thread( ByVal ctx As TIMER_CTX Ptr )
       
	Do
		Select Case ctx->state
			Case TIMER_STATE_EXITING
				Exit Do
			
			Case TIMER_STATE_STOPPED
				MutexLock( ctx->mutex )
				CondWait( ctx->cond, ctx->mutex )
				MutexUnLock( ctx->mutex )
				
			Case TIMER_STATE_RUNNING
				Dim interval As Integer
			
				interval = ctx->interval
				Do
					Sleep IIf( interval <= 100, interval, 100 ), 1
					
					If( ctx->state <> TIMER_STATE_RUNNING ) Then
						Exit Do
					End If
					
					interval -= 100
				Loop While( interval > 0 )
				
				If( interval <= 0 ) Then
					ctx->callback( ctx->userdata )
				End If
		End Select
	Loop
       
End Sub

'':::::
Function timercreate( ByVal interval As Integer, ByVal callback As TIMER_CALLBACK, ByVal userdata As Integer = 0 ) As Integer
       
	Dim As TIMER_CTX Ptr ctx
	
	ctx = Allocate( Len( TIMER_CTX ) )
	
	ctx->state    = TIMER_STATE_STOPPED
	ctx->interval = interval
	ctx->callback = callback
	ctx->userdata = userdata
	ctx->cond     = Condcreate( )
	ctx->thread   = ThreadCreate( @timer_thread, CInt( ctx ) )
	ctx->mutex    = MutexCreate()
	
	Function = CInt( ctx )

End Function

'':::::
Sub timeron( ByVal id As Integer )
       
	Dim ctx As TIMER_CTX Ptr = Cast( TIMER_CTX Ptr, id )
	
	If( ctx = 0 ) Then
		Exit Sub
	End If
	
	If( ctx->state = TIMER_STATE_KILLED ) Then
		Exit Sub
	End If
	
	ctx->state = TIMER_STATE_RUNNING
	Condsignal( ctx->cond )

End Sub

'':::::
Sub timeroff( ByVal id As Integer )
       
	Dim ctx As TIMER_CTX Ptr = Cast( TIMER_CTX Ptr, id )
	
	If( ctx = 0 ) Then
		Exit Sub
	End If
	
	If( ctx->state = TIMER_STATE_KILLED ) Then
		Exit Sub
	End If
	
	ctx->state = TIMER_STATE_STOPPED

End Sub

'':::::
Sub timerdestroy( ByVal id As Integer )
       
	Dim ctx As TIMER_CTX Ptr = Cast( TIMER_CTX Ptr, id )
	
	If( ctx = 0 ) Then
		Exit Sub
	End If
	
	If( ctx->state = TIMER_STATE_KILLED ) Then
		Exit Sub
	End If
	
	ctx->state = TIMER_STATE_EXITING
	
	Condsignal( ctx->cond )
	ThreadWait( ctx->thread )                       
	CondDestroy( ctx->cond )
	MutexDestroy(ctx->mutex )
	
	ctx->state = TIMER_STATE_KILLED
	
	DeAllocate( ctx )
       
End Sub

[/code]

[jmg]

This is an old thread, but I'll bump it, to ask if there is a newer version of this ? Google does not find much...

I can download and compile like this (used Apr 17, 2010 version of timer.bas)
"C:\FreeBASIC\FreeBASIC_1.05.0_Win32\fbc.exe" timer.bas -lib
"C:\FreeBASIC\FreeBASIC_1.05.0_Win32\fbc.exe" -g TestTimer.bas
"C:\FreeBASIC\fbdebugger292\fbdbg 32\fbdebugger.exe" C:\FreeBASIC\COM_tests\TestTimer.exe

and it spits many warnings, but does actually seem to operate as expected ? (console pgm, Win10)

Q: Is there any version around, without all the warnings ?
Or, does anyone suggest timers from allegro.bas as being better ?

I'm looking for very simple timer interrupts, to allow simulate/emulate of basic code, that will eventually run on a microcontroller.

Warnings:
C:\FreeBASIC\COM_tests>"C:\FreeBASIC\FreeBASIC_1.05.0_Win32\fbc.exe" timer.bas -lib
timer.bas(37) warning 1(1): Passing scalar as pointer, at parameter 1 of MUTEXLOCK()
timer.bas(38) warning 1(1): Passing scalar as pointer, at parameter 1 of CONDWAIT()
timer.bas(38) warning 1(1): Passing scalar as pointer, at parameter 2 of CONDWAIT()
timer.bas(39) warning 1(1): Passing scalar as pointer, at parameter 1 of MUTEXUNLOCK()
timer.bas(74) warning 5(0): Implicit conversion
timer.bas(75) warning 3(1): Passing different pointer types, at parameter 1 of THREADCREATE()
timer.bas(75) warning 1(1): Passing scalar as pointer, at parameter 2 of THREADCREATE()
timer.bas(75) warning 5(0): Implicit conversion
timer.bas(76) warning 5(0): Implicit conversion
timer.bas(96) warning 1(1): Passing scalar as pointer, at parameter 1 of CONDSIGNAL()
timer.bas(132) warning 1(1): Passing scalar as pointer, at parameter 1 of CONDSIGNAL()
timer.bas(133) warning 1(1): Passing scalar as pointer, at parameter 1 of THREADWAIT()
timer.bas(134) warning 1(1): Passing scalar as pointer, at parameter 1 of CONDDESTROY()
timer.bas(135) warning 1(1): Passing scalar as pointer, at parameter 1 of MUTEXDESTROY()
timer.bas() warning 20(2): Object files or libraries with mixed multithreading (-mt) options, .\libtimer.a

C:\FreeBASIC\COM_tests>"C:\FreeBASIC\FreeBASIC_1.05.0_Win32\fbc.exe" -g TestTimer.bas
TestTimer.bas() warning 20(2): Object files or libraries with mixed multithreading (-mt) options, .\libtimer.a

[MrSwiss]

This is an old thread, but I'll bump it, ...

It is generally speaking, a less than clever idea, because:
The FBC compiler's (32/64) have evolved since then, and may therefore,
not be compatible, any longer. (aka: refrain form "bumping" old threads!)

[jmg]

The FBC compiler's (32/64) have evolved since then, and may therefore, not be compatible, any longer.

Err, yes, that's rather the point.
The code here compiles, but produces warnings, that look rather similar to the warnings reported above.

So, maybe those warnings where always there, or maybe someone has discovered a way to remove the warnings on any version of FBC ?
It looks less like a compiler portability issue than a wrapper type issue.

[adele]

Hi,

it took a while, but I had remembered two threads concerning ON TIMER GOSUB()
At least the one of them works "noWarn/noError" , at least on my machine, a few minutes ago:

Code: Select all

'onTimerGosub().bas
'
' from : (FXM): 
' https://www.freebasic.net/forum/viewtopic.php?f=2&t=23453&p=206667&hilit=timer#p206661

' Q: what´s that? 
' A: some kind of ON TIMER GOSUB 
/'
 what does it?
(FXM:)
The thread calls the procedure 'onTime()' about 
each 3 seconds. Adjust the SLEEPs to yout fits. 
whatever the loop time of your "normal" job (during 
the 'sleep xx00' in the thread, your "normal" job 
continues to work):
'/

/' (me:)  
   tested using Win10 RS4/x64, FBC 1.05/x64
   commandline:  fbc  -s console <name>
   added some visualization, to demonstrate then
   interruptions by the Subroutine "onTime()"
   Changed the Sleep() cycles to higher values 
   Main code by FXM
'/  

sub OnTime
   Sleep 50 ' needed not to scramble screen, I don´t know why
  ?:print "Here from: Subroutine OnTime() : " & Time()
End sub

Sub thread (Byval p as any Ptr)
  while *cptr(integer ptr, p) = 0
    onTime()
    Sleep 2200
  wend
  print "stop thread"
end sub

dim as integer EndOfThread = 0
dim as any ptr pt = threadcreate(@thread, @endOfThread)
' mainloop
while inkey=""
  ' do your "normal" job here
  ' ( poor man´s ClrEol()  ;-) )
   Locate CsrLin,1: Print "                   ";
   ' only some computation
   Locate CsrLin,1: Print Timer() / Rnd();
   Locate csrLin,1
   sleep 77 ' don't eat all CPU cycles
wend
'end
endOfThread = 1
ThreadWait(pt)
'
Print:Print "DONE."
Sleep 
' Similar functions see:
' D.J.Peters,
' https://www.freebasic.net/forum/viewtopic.php?f=7&t=23454&p=206666&hilit=timer#p206666

Have a nice day!
Adi

[MrSwiss]

Another Time-Thread example but, using a MUTEX, to have everything separated.
Meaning: if Main runs; Time is blocked, by cons: if Time runs; Main is blocked.
See: Re: can a tread access a normal Function
It is NEW, which means to say: nothing to do, with "ON" (anything) ...

The example is a skeleton, for a separate thread (from Main) and, can thus be
adapted to anybodys needs ...

=====
timer.bas() warning 20(2): Object files or libraries with mixed multithreading (-mt) options, .\libtimer.a
On the significant warning above:

• library must be compiled using: -mt (compiler switch), because
• main is automatically compiled this way (thread code used)

If these optional switches are different, then: Warning. (Should be Error, IMO.)

[badidea]

A non-threading alternative:

Code: Select all

var t1 = timer + 3.0
print "waiting 3 sec..."
while timer < t1
	sleep 1,1 
wend
print "done"

Wrapped in some fancy class:

Code: Select all

type timer_type
	private:
		dim as string nameStr
		dim as double endTime
	public:
		declare sub start(delay as double)
		declare sub start(delay as double, nameStr as string)
		declare function ended() as boolean 
end type

sub timer_type.start(delay as double)
	endTime = timer + delay
	print this.nameStr & " started" 
end sub

sub timer_type.start(delay as double, nameStr as string)
	endTime = timer + delay
	this.nameStr = nameStr
	print this.nameStr & " started" 
end sub

function timer_type.ended() as boolean
	if timer > endTime then
		print this.nameStr & " ended" 
		return true
	else
		return false
	end if
end function

dim as timer_type myTimer(3-1)

myTimer(0).start(3.0, "egg timer (3 sec)")
myTimer(1).start(5.0, "pasta timer (5 sec)")
myTimer(2).start(12.0, "final timer (12 sec)")

while inkey <> chr(27)
	if myTimer(0).ended() = true then myTimer(0).start(3.0) 'restart
	if myTimer(1).ended() = true then myTimer(1).start(5.0) 'restart
	if myTimer(2).ended() = true then exit while 'end
	sleep 1,1
wend
print "end"

One needs to poll the timers in the loop for this.

Edit: Text clarified

[MrSwiss]

There are simpler alternatives: ???

You've obviously NOT read the post, by OP ... (original poster).
Please make that a habit, before launching a "shot from the hip".

Btw: a thread eliminates polling, that is why, they are useful ...