Thread (encore une fois) et interruption

[djes]

Je comprends parfaitement pourquoi tu veux utiliser les threads, et tu as raison d'essayer d'abord sur un programme simple pour bien comprendre le principe. Pour moi y'a pas de souci à ce niveau-là, ni dans ta façon "portable" d'utiliser les timers. Essaye simplement d'éviter les variables globales, et utilise plutôt les pointeurs, ça évite de se mélanger les pinceaux. En tous cas c'est mieux parti

[G-Rom]

3) Je veux remplir ma liste en arrière plan quoiqu'il arrive, sans perte de message, overflow ou latence : tu imagines si mon programme rate l'appui du bouton 'ALARME' juste parce qu'il est en train de traiter autre chose ?

C'est pas possible ce que tu dis... ton doigt n'est pas plus rapide qu'un microprocesseur , comment veut tu loupé l'appuis sur un bouton ?
ton programme principal dois peut être tourné à 1ms , il a le temps de regardé l'état du réseau , de traiter les messages...
si tu met moins de temps que le proc pour appuyer sur le bouton , que lui met de temps à faire un tour de boucle , alors chapeau !

voila comment je ferais à ta place :

Code : Tout sélectionner

Procedure lecture_reseau()
  ;...  
EndProcedure
List message.i()

refrechTimer.i = 0


OpenWindow(0,0,0,100,100,"...")

Repeat
  
  event = WindowEvent()
   
  
  surveille_reseau = lecture_reseau()
  
  If surveille_reseau = #True  ; MESSAGE RECU !
    
    ; commande reseau....
  
  Else
    ForEach message()  ; TRAITEMENT DES MESSAGES !
      
    Next 
  EndIf   
  
    
  If refrechTimer < ElapsedMilliseconds()
    refrechTimer = ElapsedMilliseconds() + 100
    ; Mise à jour des gadgets
    ; de la fenetre
    ; etc...
  EndIf 
  
Until event = #PB_Event_CloseWindow 

[Golfy]

C'est vrai qu'il doit y avoir un problème dans mon programme
Je vais devoir le reprendre en profondeur...

pour info, voici le serveur (qui effectue en permanence la translation Serial <--> Network) en mode console (et pas de thread).
Il ne semble pas y avoir de saturation des buffers (serial ou network) qui font 4096 octets... le max que j'ai vu est de 150 oct.
Le serveur semble sûr car même l'application VelbusLink (le prgramme de Velbus pour programmer les modules) n'a pas de problème.

Merci pour vos aides, je dois encore améliorer ma programmation (vieille de 15 ans... oui, j'ai connu les GOTO ).
Des conseils pour améliorer le codage en PureBasic ?

Code : Tout sélectionner

; Velbus server 1.0 by Golfy (Purebasic 4.60)
; v2   -> try to delay message from Ethernet -> Velbus
; v2.1 -> inform about bad frame (from wich client)
; v2.2 -> correction with CRC checksum (add & $FF)
; v2.3 -> added INI file with 2 parameters (COM and TCPPort)
; v2.4 -> added last time if Bad Checksum
; v2.5 -> added buffer max monitor + list connexion (31/07/2012)
; Default parameters : COM4 and 8080 
version$ = "2.5"
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
  Port$ = "COM4"
CompilerElse
  Port$ = "/dev/ttyS0"
CompilerEndIf
Port = 8080

OpenConsole()
EnableGraphicalConsole(1)


; declare useful procedures
Declare.i AnalyseMessage(*bus,Len.i, clientID.i)
Declare.s Hexa2(*B,longueur.i)
Declare.i LectureNet()
Declare.i CheckSum(*B,longueur.i)


; if parameter are transmit after commandline
If FindString(UCase(ProgramParameter(0)),"H",1) Or FindString(UCase(ProgramParameter(0)),"?",1)
	PrintN("PB_Velbus-server.exe SERIALport NETWORKport (ex: PB_Velbus-server.exe COM4 8131)")
	PrintN("PB_Velbus-server.exe                         default = COM4 and 8080")
	Input()
	End
EndIf

	
If ProgramParameter(0) : port$ = ProgramParameter(0) : EndIf
If ProgramParameter(1) : port  = Val(ProgramParameter(1)) : EndIf
If ProgramParameter(0) = ""
	If OpenFile(0,"PB_Velbus-server.ini")
		port$=ReadString(0)
		port =Val(ReadString(0))
		CloseFile(0)
	Else
		PrintN("Start with default parameters...")
		Delay(2000)
	EndIf
EndIf

PrintN("Opening serial "+port$+"...")
If OpenSerialPort(0, Port$, 9600, #PB_SerialPort_NoParity, 8, 1, #PB_SerialPort_NoHandshake, 2048, 2048)
	PrintN("PB_Velbus-Server "+version$+" : open port "+port$+" done")
Else
	PrintN("Erreur port "+port$)
	Delay(2000)
	End
EndIf

If InitNetwork() = 0
	PrintN("Error : Can't initialize the network !")
	Delay(2000)
  End
EndIf

;declare structure and variables
*BSin = AllocateMemory(4096)
*BNin = AllocateMemory(4096)
*BFull  = AllocateMemory(7)
*BReady = AllocateMemory(7)

PokeB(*BFull+0,$0F)
PokeB(*BFull+1,$F8)
PokeB(*BFull+2,$00)
PokeB(*BFull+3,$01)
PokeB(*BFull+4,$0B)
PokeB(*BFull+5,$ED)
PokeB(*BFull+6,$04)

PokeB(*BReady+0,$0F)
PokeB(*BReady+1,$F8)
PokeB(*BReady+2,$00)
PokeB(*BReady+3,$01)
PokeB(*BReady+4,$0C)
PokeB(*BReady+5,$EC)
PokeB(*BReady+6,$04)


Structure Vmsg
	Len.i
	*cmd
EndStructure

Structure netclient
	portID.i
	CRCErr.i
	IPAdd.s
	CRCDelay.i
EndStructure


Global NewList messages.Vmsg()
Global NewList Client.netclient()
Global TXNET.q = 0
Global TXBUS.q = 0
Global BPnet.q = 0
Global BPbus.q = 0
Global RXLenMax.i = 0
Global MaxMsg.i = 0


If CreateNetworkServer(0, Port)
  ClearConsole()
	PrintN("Listening Ethernet port : "+Str(port)+" / Serial port : "+port$)
  HauteurCurseur = 0
  d = ElapsedMilliseconds()
  dbp = ElapsedMilliseconds()
  uptime=Date()
  
  Repeat
  	; server is alive : show date (french format)
  	If Date() <> dd
	  	dd = Date()
	  	ConsoleLocate(62,0)
	  	PrintN(FormatDate("%dd/%mm/%yy %hh:%ii:%ss",Date()))
	  	utime = Date()-uptime
	  	yt = utime/31536000
	  	mt = (utime-31536000*yt)/2635200
	  	dt = (utime-2635200*mt)/86400
	  	ConsoleLocate(0,6)
	  	PrintN("Velbus-server UpTime : "+Str(yt)+" year, "+Str(mt)+" month, "+Str(dt)+" day(s) and "+FormatDate("%hh:%ii:%ss",utime))
	  	
	  	ForEach Client()
	  		de = (ElapsedMilliseconds()-Client()\CRCDelay)/1000
	  		If client()\CRCErr>10 And de > 60
	  			ConsoleLocate(0,9)
	  			PrintN("Closing client "+client()\IPAdd+", "+Str(Client()\portID)+" because too many errors in one minut ("+Str(client()\CRCErr)+")")
	  			CloseNetworkConnection(Client()\portID)
	  			DeleteElement(Client(),1)
	  		ElseIf de > 60
	  			Client()\CRCErr   = 0
	  			Client()\CRCDelay = ElapsedMilliseconds()
	  		EndIf
	  	Next
	  	
	  EndIf
	  
	  u= ElapsedMilliseconds()-dbp
	  If u > 1000
	  	debitnet.f = ((TXNET-BPnet)*8/(u/1000))/1024
	  	debitbus.f = ((TXBUS-BPbus)*8/(u/1000))/1024
	  	ConsoleColor(14,0)
	  	ConsoleLocate(20,3)
	  	PrintN("BP Net : "+StrF(debitnet.f,2)+" kbps ")
	  	ConsoleColor(15,0)
	  	ConsoleLocate(42,3)
	  	PrintN("BP Velbus : "+StrF(debitbus.f,2)+" kbps ")
	  	ConsoleColor(7,0)
	  	BPnet = TXNET
	  	BPbus = TXBUS
	  	dbp=ElapsedMilliseconds()
	  EndIf
	  
	  
  	; Send bufferised messages with 60ms delay
  	If ListSize(messages()) And ElapsedMilliseconds()-d > 40
  		Err = FirstElement(messages())
  		Err = WriteSerialPortData(0, messages()\cmd, messages()\len)
  		err = FreeMemory(messages()\cmd)
  		Err = DeleteElement(messages(),1)
  		d = ElapsedMilliseconds()
  		If ListSize(messages()) > MaxMsg
  			MaxMsg = ListSize(messages())
  		EndIf
  		ConsoleLocate(20,4)
	  	PrintN("Queue : "+Str(ListSize(messages()))+" msgs    (Max : "+Str(MaxMsg)+")     ")
  	EndIf
  	
    SEvent = NetworkServerEvent()
    If SEvent
     	ConsoleLocate(0,2)
    	PrintN("[N]")    	
      ClientID = EventClient()
      Select SEvent
      	Case #PB_NetworkEvent_Connect
      		; new client connected
      		ConsoleLocate(0,7)
      		AddElement(Client())
      		Client()\portID = ClientID
      		IP$=IPString(GetClientIP(ClientID))
      		Client()\IPAdd = IP$
      		Client()\CRCErr + 0
      		Client()\CRCDelay = ElapsedMilliseconds()
        	Space(80)
      		ConsoleLocate(5,2)
      		PrintN("Nb Client:"+Str(ListSize(Client())))
      		ConsoleLocate(0,7)
      		PrintN("-------------------------------------------------------------------------")
      		ForEach Client()
      			PrintN("Open Connexion ID "+Str(Client()\portID)+" for "+Client()\IPAdd+"  ("+FormatDate("%dd/%mm/%yy %hh:%ii:%ss",Date())+")    ")
      		Next	
      	Case #PB_NetworkEvent_Data
      		RXLen = ReceiveNetworkData(ClientID, *BNin, 4096)
      		If RXLen > 5
      			N = AnalyseMessage(*BNin,RXLen,ClientID)
      			TXNET=TXNET+RXLen
       			ConsoleLocate(20,2)
	    			PrintN("Eth-> "+Str(TXNET)+" ("+Str(RXLen)+")  ")
       			;PrintN("NET --> VelBUS : "+Str(N)+" messages received ("+Str(RXLen)+" bytes received)")
      		EndIf
      		
      	Case #PB_NetworkEvent_Disconnect
      		; client has diconnected
      		ConsoleLocate(0,7)
        	ForEach Client()
        		If Client()\portID = ClientID
        			ip$=Client()\IPAdd
        			DeleteElement(Client(),1)
        			Space(80)
        			ConsoleLocate(0,7)
        			PrintN("-------------------------------------------------------------------------")
		      		ForEach Client()
		      			PrintN("Open Connexion ID "+Str(Client()\portID)+" for "+Client()\IPAdd+"  ("+FormatDate("%dd/%mm/%yy %hh:%ii:%ss",Date())+")  ")
		      		Next	
        			PrintN("Closed Connexion ID "+Str(ClientID)+" for "+ip$+"  ("+FormatDate("%dd/%mm/%yy %hh:%ii:%ss",Date())+")  ")
        		EndIf
        	Next
      		ConsoleLocate(5,2)
      		PrintN("Nb Client:"+Str(ListSize(Client())))        	
      EndSelect
    EndIf
    
    ; SERIAL TO NETWORK ==========================================================================
    Serial = AvailableSerialPortInput(0)
    If Serial
    	ConsoleLocate(0,2)
    	PrintN("[S]")
    	RXLen = ReadSerialPortData(0,*BSin,Serial)
    	If RXlen = Serial
    	            z = 0
            	  	For y=0 To RXLen
                		a$ = RSet(Hex(PeekB(*Bsin+y) & $FF),2,"0")
                		If a$ = "0F"
                		  cmd$ = "<-- 0F "
                		  z = y
                		ElseIf a$ = "04" And y-z > 3
                			cmd$=cmd$+"04 ("+Str(y)+")-"
                			Debug cmd$
                			cmd$ = ""
                		Else 
                			cmd$=cmd$+a$+" "
                		EndIf
                	Next y

	    	ForEach Client()
	    		Err = SendNetworkData(Client()\portID, *BSin, RXLen)
	    	Next
	    	TXBUS = TXBUS + RXLen
	    	If RXLen > RXLenMax
	    		RXLenMax = RXLen
	    	EndIf
	    	ConsoleLocate(42,2)
	    	PrintN("VBus-> "+Str(TXBUS)+" ("+Str(RXLen)+"/"+Str(RXLenmax)+") ")
	    Else
	      Debug "Oct disponibles : "+Str(Serial)+" / Oct envoyés : "+Str(RXLen)
	    EndIf
    EndIf	
    
    
  Until Quit = 1 
  
  CloseNetworkServer(0)
Else
  PrintN("Error : Can't create the server (port in use ?).")
EndIf

  
End   

; ------
; Procedure for Network/BUS command
; _______________________________________________________________________________________________________
Procedure.i AnalyseMessage(*bus,full.i,ClientID)
	; Format de trame :
	; OF FB ** RL xx xx xx CK 04 - 0F FB ** ....
	; 12 34 56 78 9A ..... 
	stx = 0
	etx = 0
	lng = 0
	counter = 0
	z = 0
	For y=0 To full
		a$ = RSet(Hex(PeekB(*bus+y) & $FF),2,"0")
		If a$ = "0F"
		  cmd$ = "--> 0F "
		  z = y
		ElseIf a$ = "04"
			cmd$=cmd$+"04 ("+Str(y)+")-"
			Debug cmd$
			cmd$ = ""
		Else 
			cmd$=cmd$+a$+" "
		EndIf
	Next y
	
	t = 0
	Repeat
		If PeekB(*bus+t) & $FF = $0F
			counter+1
			fixlen = 4
			varlen = PeekB(*bus+t+3) & $0F
			fintrame = t+fixlen+varlen+1
			crcloc = fintrame-1
			tlen = fixlen+varlen+2
			crc = checksum(*bus+t,tlen-3)
			If PeekB(*bus+fintrame) & $FF = $04 And (PeekB(*bus+crcloc) & $FF)=crc
				AddElement(messages())
				messages()\len = tlen
				messages()\Cmd = AllocateMemory(messages()\len)
				CopyMemory(*bus+t,messages()\cmd,messages()\len)
				t = t+(messages()\len-2)
			Else
			  Debug "CRC Velbus : "+Str(PeekB(*bus+crcloc) & $FF)+"  CRC PB : "+Str(crc)
				ForEach client()
					If Client()\portID = ClientID
						Client()\CRCErr + 1
						ConsoleLocate(0,8)
						ConsoleColor(12,0)
						PrintN("Bad frame from "+Str(ClientID)+ ": Event has become "+Str(Client()\CRCErr)+" times ("+FormatDate("%dd/%mm/%yyyy %hh:%ii:%ss",Date())+")   ")
						ConsoleColor(7,0)
					EndIf
				Next
			EndIf
		EndIf
		t = t + 1
			
	Until t=>full
	ProcedureReturn ListSize(messages())
EndProcedure
; _______________________________________________________________________________________________________
	

Procedure.i CheckSum(*B,longueur.i)
	 somme=0																; Initialize Counter
	 For tr=0 To longueur										; Loop from 0 to checksum byte -1
			Somme=Somme+(PeekB(*B+tr) & $FF	)		; Adding each byte from the packet
	 Next tr
	 Somme = (Somme & $FF) ! $FF						; As PureBasic use signed integer, need to remove higher value
	 Somme = (Somme + 1) & $FF							; (AND operation) and inverse with XOR (!), them add '1'
	 ProcedureReturn Somme								; Return the checksum value
EndProcedure

[Backup]

Merci pour vos indications.
1) Je note que le programme de Dobro fonctionne avec des appels à des API Windows... quid si je compile sous Linux (oui certains utilisateurs Velbus sont Win, d'autres Linux) ? les timer Purebasic ne sont pas fiables ?

tu n'es pas tres curieux d'essayer ....
je t'avais pourtant donné les pistes

les timer sont TRES fiables !
mais c'est comme tout, faut prendre sont temps de comprendre le truc

voici la version timer Standards .... ( pas portable puisqu'il semble qu'on n'a pas de callback sous Linux ) <--- Reedité apres une remarque de G-Rom

Code : Tout sélectionner

Global cnt
Global dte
Global ddd
Global gct.d

enumeration
	#window
	#timer_1 
	#date
	#Compteur
	#timer_compt
	#text_main
	#text_thread
	#text_timer
EndEnumeration


Declare  tachecompte(void.i)
Declare  affichedate()
Declare  globalcount()
Declare  TimerProc(hwnd.l, uMsg.l, idEvent.l, dwTime.l)
Declare  WindowCallback(WindowID,message,wParam,lParam)



OpenWindow(#window,100,100,200,100,"TestThread")
TextGadget(#date, 70,10,120,20,"date",#PB_Text_Border)
TextGadget(#Compteur, 70,30,120,20,"cnt",#PB_Text_Border)
TextGadget(#timer_compt, 70,50,120,20,"timercnt",#PB_Text_Border)
TextGadget(#text_main, 10,10,120,20,"main")
TextGadget(#text_thread, 10,30,120,20,"thread")
TextGadget(#text_timer, 10,50,120,20,"timer")

; **** preparation du bin's ***********

AddWindowTimer(#window, #timer_1, 1000)

SetWindowCallback(@WindowCallback()) ; active le callback

th = CreateThread(@tachecompte(),1000) ; active le Thread
dte=Date()
ddd = ElapsedMilliseconds()
; ****** fin de preparation du bin's ******


; *** boucle principale ******
Repeat
	affichedate()
	
	select waitWindowEvent(2)
		case #PB_Event_Timer
		if EventTimer() = #timer_1
			globalcount()
		endif
		case #PB_Event_CloseWindow
		break
	endselect
forever
; **** fin boucle principale ***
CloseWindow(0)
End



; ************* zone des procedures *******************
Procedure tachecompte(void.i)
	; le Thread
	z = 0
	cnt = 0
	Repeat
		Delay(1000)
		cnt+1
		SetGadgetText(#Compteur, Str(cnt)+" ")
	forever
EndProcedure

Procedure affichedate()
	; le main joué par le callback
	SetGadgetText(#date,FormatDate("%hh:%ii:%ss", Date()-dte)+" - "+Str((ElapsedMilliseconds()-ddd)/100))
EndProcedure

Procedure globalcount()
	; le code joué par le timer
	gct = gct + 0.1
	SetGadgetText(#timer_compt, StrD(gct,1)+" ")     
	
EndProcedure




Procedure WindowCallback(WindowID,message,wParam,lParam)
	; by Dobro
	res=#PB_ProcessPureBasicEvents
	Select message
		case #WM_MOVE ; se charge de continuer a incrementer la date si on bouge la fenetre !!
		affichedate()
		ProcedureReturn #True
		case #WM_TIMER
		if wParam=#timer_1
			globalcount()
		endif
		ProcedureReturn #True
	EndSelect
	ProcedureReturn res ; important , laissez passer les autres evenements !!!
EndProcedure
; EPB

[djes]

Il est bien ton petit code, Golfy, ça hacke bien, c'est pour ça qu'on aime PB

Pour ton fichier de config, je te conseille la lib preferences, c'est bien pratique ! Je crois que tu n'auras pas trop de soucis avec les threads . Si je devais te conseiller un truc, c'est d'un peu ranger tout ça, mais tu dois le savoir... Si je vois un code sympa avec une bonne gestion de file d'attente, je pense à toi

[G-Rom]

voici la version portable :

@Dobro
SetWindowCallback() n'est pas portable

[Backup]

voici la version portable :

@Dobro
SetWindowCallback() n'est pas portable

ha bon ?

ha oui .. tiens


il n'y a pas de CallBack sous Linux ?

arf ! ça complique .. du coup