Page 3 of 4
Re: Get own threadID without passing as parameter
Posted: Fri May 01, 2020 5:28 pm
by NicTheQuick
I still do not get why you want to know the thread's handle inside the thread.
You do not need to kill the thread by itself. It simply can return.
You do not need to check if it is running, because if it is not running you can not even check this.
You do not need to pause the thread from inside. For this you can use locks (CreateMutex()).
And if the thread is paused you can not resume it from inside because ehhm... it's paused.
So what is your idea behind that?
Also here is an OS independent version using some wrapper procedures with very little constant overhead:
Code: Select all
EnableExplicit
Prototype.i threadFunction(*data)
Structure ThreadInfo
*data
proc.threadFunction
mutex.i
threadId.i
EndStructure
Threaded _myThreadId.i
Procedure ThreadWrapper_(*threadInfo.ThreadInfo)
With *threadInfo
LockMutex(\mutex)
_myThreadId = \threadId
UnlockMutex(\mutex)
\proc(\data)
FreeMutex(\mutex)
EndWith
FreeStructure(*threadInfo)
EndProcedure
Procedure CreateThread_(proc.threadFunction, *data)
Protected *threadInfo.ThreadInfo = AllocateStructure(ThreadInfo)
With *threadInfo
\data = *data
\proc = proc
\mutex = CreateMutex()
LockMutex(\mutex)
\threadId = CreateThread(@ThreadWrapper_(), *threadInfo)
UnlockMutex(\mutex)
ProcedureReturn \threadId
EndWith
EndProcedure
;----------------------------------------------
; Now just use CreateThread_() instead of CreateThread()
; and retrieve the thread ID returned from CreateThread()
; inside the thread using the global variable _myThreadId
Procedure MyThread(dummy.i)
Debug "inside thread: " + _myThreadId
EndProcedure
Define thread.i = CreateThread_(@MyThread(), 0)
Debug "outside thread: " + thread
Delay(100)
Re: Get own threadID without passing as parameter
Posted: Fri May 01, 2020 8:19 pm
by LiK137
NicTheQuick, Thanks very much.
In fact, I need to link ClientID, cmdID and ThreadHandle together from inside threadprocedure.
Thread must get it's handle, get cmdID bundled with him and process instruction.
GUI is going to work apart from Device being attached to server on localhost.
if GUI not responds or fails it just been disconnected but not stops or hangs device.
The treaded variable in your provided solution also I do not think possible to realize.
Same procedure is initialized for each cmd so single treaded variable cannot be evaluated under this condition.
I am going to use Shardik's solution by linking handle, threadID, cmdID and ClientID together to make possible to lookup cmdID of ClientID of ThreadID
Thank You very much
Re: Get own threadID without passing as parameter
Posted: Sat May 02, 2020 1:16 am
by NicTheQuick
LiK137 wrote:The treaded variable in your provided solution also I do not think possible to realize.
Same procedure is initialized for each cmd so single treaded variable cannot be evaluated under this condition.
I am going to use Shardik's solution by linking handle, threadID, cmdID and ClientID together to make possible to lookup cmdID of ClientID of ThreadID
Thank You very much
Sorry. I am not sure if I understand you correctly because your English seems a bit broken but it is also not my mother tongue. So maybe it's also myfault.
So you mean because the same procedure (in this case ThreadWrapper_()) is used for every created thread, the variable '_myThreadId' can not be used? That's wrong. Variables declared with the 'Threaded' keyword are unique for every thread. Because 'ThreadWrapper_()' is already running in a new thread there will be no race condition at all. My code is functional and safe.
But of course Shardik's code works as well and is more elegant if you only want to run on Windows. You also could bundle the versions of the different operating systems into one module or procedure and post it in the Tricks 'n' Tips section.

Re: Get own threadID without passing as parameter
Posted: Sat May 02, 2020 10:09 am
by LiK137
NicTheQuick,
Once upon a time a man was cleaning his ears and mute the world (In which post You think my English got broken?, may be we both should take English course?)
I am posting my test code which will be then used after all bugs in my code corrected. The code may have incorrect usage of mutex or semaphore as I am not familiar with them very well.
Server.pb
Code: Select all
Global tmpCounter
Global Semaphore = CreateSemaphore()
Global Mutex = CreateMutex()
Import ""
GetThreadId(ThreadHandle.I)
EndImport
Structure TParseData
XPath.s
XMD.s
*XData
EndStructure
Structure TCMDo
*srv.TServer
clID.i
cmdID.i
EndStructure
Structure TCMData
szData.i
pathData.s
*memData
EndStructure
Structure TCMDef
cmdParentID.i
cmdID.i
CMD.s
inData.TCMData
outData.TCMData
CMDState.i
clID.i
EndStructure
Structure TClient
clID.i
IP.s
Port.l
connStat.b
thdID.i
exiThd.b
CMD.TCMDef
EndStructure
Structure TServer
srvID.i
Port.l
Protocol.l
IPv.l
interfaceIP.s
Map Clients.TClient()
EndStructure
#DataBuff = 1024
Declare thdCMDo(*srv.TServer)
Procedure INITsrv(*srv.TServer)
InitNetwork()
UseMD5Fingerprint()
Protected hThread
Protected srvMod, SERVent, ServerID, ClientID
Protected *Buffer0 = AllocateMemory(#DataBuff),
DoneQty, StepQty
If *srv\Port > 0 And *srv\Port < 65000
If *srv\Protocol = #PB_Network_TCP Or *srv\Protocol = #PB_Network_UDP
If *srv\IPv = #PB_Network_IPv4 Or *srv\IPv = #PB_Network_IPv6
srvMod = *srv\Protocol | *srv\IPv
Else
srvMod = *srv\Protocol
EndIf
Else
srvMod = #PB_Network_TCP | #PB_Network_IPv4
EndIf
If *srv\interfaceIP = ""
*srv\srvID = CreateNetworkServer(#PB_Any, *srv\Port, srvMod)
Else
*srv\srvID = CreateNetworkServer(#PB_Any, *srv\Port, srvMod, *srv\interfaceIP)
EndIf
Repeat
SERVent = NetworkServerEvent()
Select SERVent
Case #PB_NetworkEvent_None
Delay(10)
Case #PB_NetworkEvent_Connect ;- #PB_NetworkEvent_Connect
ServerID = EventServer()
ClientID = EventClient()
LockMutex(Mutex)
*srv\Clients(Str(ClientID))\clID = ClientID
*srv\Clients(Str(ClientID))\IP = IPString(GetClientIP(ClientID), #PB_Network_IPv4)
*srv\Clients(Str(ClientID))\Port = GetClientPort(ClientID)
*srv\Clients(Str(ClientID))\CMD\clID = ClientID
*srv\Clients(Str(ClientID))\CMD\inData\memData = AllocateMemory(#DataBuff)
*srv\Clients(Str(ClientID))\CMD\outData\memData = AllocateMemory(#DataBuff)
*srv\Clients(Str(ClientID))\connStat = #True
UnlockMutex(Mutex)
Case #PB_NetworkEvent_Disconnect ;- #PB_NetworkEvent_Disconnect
ServerID = EventServer()
ClientID = EventClient()
LockMutex(Mutex)
*srv\Clients(Str(ClientID))\connStat = #False
UnlockMutex(Mutex)
;{ TestPurpose
; If FindMapElement(*srv\Clients(), Str(ClientID))
; FreeMemory(*srv\Clients(Str(ClientID))\CMD\inData\memData)
; FreeMemory(*srv\Clients(Str(ClientID))\CMD\outData\memData)
; DeleteMapElement(*srv\Clients(), Str(ClientID))
; EndIf
;
; If FindMapElement(*srv\Clients(), Str(ClientID))
; Debug "Found but shouldnt: " + *srv\Clients(Str(ClientID))\clID
; Else
; Debug "DeleteMapOK"
; EndIf
;
; If MapSize(*srv\Clients()) = 0
; Debug "OK"
; EndIf
;}
Case #PB_NetworkEvent_Data ;- #PB_NetworkEvent_Data
ServerID = EventServer()
ClientID = EventClient()
If FindMapElement(*srv\Clients(), Str(ClientID))
DoneQty = 0
StepQty = 0
Repeat
Qty = ReceiveNetworkData(ClientID, *Buffer0, #DataBuff) ; take the coins
If Qty > 0
DoneQty + Qty
LockMutex(Mutex)
If DoneQty >= MemorySize(*srv\Clients(Str(ClientID))\CMD\inData\memData) ; bank is not empty ?
*srv\Clients(Str(ClientID))\CMD\inData\memData = ReAllocateMemory(*srv\Clients(Str(ClientID))\CMD\inData\memData, MemorySize(*srv\Clients(Str(ClientID))\CMD\inData\memData) + #DataBuff)
EndIf
CopyMemory(*Buffer0, *srv\Clients(Str(ClientID))\CMD\inData\memData + StepQty, Qty)
UnlockMutex(Mutex)
StepQty + Qty
EndIf
Until Qty <= 0 ; quit if bank is empty
*srv\Clients(Str(ClientID))\CMD\inData\szData = DoneQty
FillMemory(*Buffer0, #DataBuff, 0, #PB_Byte)
hThread = CreateThread(@thdCMDo(), *srv)
LockMutex(Mutex)
*srv\Clients(Str(ClientID))\thdID = GetThreadID(ThreadID(hThread))
UnlockMutex(Mutex)
; Debug "Internal thdID: " + *srv\Clients(Str(ClientID))\thdID
EndIf
EndSelect
ForEver
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure thdCMDo(*srv.TServer)
Protected thdID = GetCurrentThreadId_()
Protected clID
Protected CounterTMP = tmpCounter
Protected *cpSrv.TServer = AllocateMemory(SizeOf(TServer));AllocateStructure(TServer)
InitializeStructure(*cpSrv, TServer)
Delay(1000)
LockMutex(Mutex)
CopyStructure(*srv, *cpSrv, TServer)
UnlockMutex(Mutex)
Delay(1000)
Repeat
ForEach *cpSrv\Clients()
If MapKey(*cpSrv\Clients()) <> ""
If thdID = *cpSrv\Clients()\thdID
clID = *cpSrv\Clients()\clID
tmpCounter + 1
Debug Str(tmpCounter) + " Found for client: " + clID
Debug "Data for Client: " + Str(clID) + " | " + PeekS(*cpSrv\Clients(Str(clID))\CMD\inData\memData, *cpSrv\Clients(Str(clID))\CMD\inData\szData, #PB_Unicode) + "|"
Break 2
EndIf
EndIf
Next
Until tmpCounter <> CounterTMP
Debug "Last found element for client: " + Str(*cpSrv\Clients(Str(clID))\clID) + " is: " + tmpCounter
ClearStructure(*cpSrv, TServer)
Debug "chkIfClear Interface: " + *cpSrv\interfaceIP
; FreeStructure(*cpSrv.TServer)
EndProcedure
Define *srv.TServer = AllocateMemory(SizeOf(TServer));AllocateStructure(TServer)
InitializeStructure(*srv, TServer)
*srv\Port = 8888
*srv\Protocol = #PB_Network_TCP
*srv\interfaceIP = "127.0.0.1"
Define MainTHD = CreateThread(@INITsrv(), *srv)
Repeat
Delay(10)
ForEver
Client.pb
Code: Select all
Procedure Cli()
If InitNetwork() = 0
MessageRequester("Error", "Can't initialize the network !", 0)
End
EndIf
#String = "TEST"
*String = AllocateMemory(StringByteLength("TEST", #PB_Unicode)+2)
PokeS(*String, #String, StringByteLength("TEST", #PB_Unicode), #PB_Unicode)
UseMD5Fingerprint()
Debug Fingerprint(*String, StringByteLength("TEST", #PB_Unicode), #PB_Cipher_MD5)
#cliPort = 8888;6832
#ConSize = 10000
Dim Connexn(#ConSize)
Debug "Connecting"
For i = 1 To #ConSize
Connexn(i) = OpenNetworkConnection("127.0.0.1", #cliPort, #PB_Network_TCP)
Next
Debug "SendDataFull"
For i = 1 To #ConSize
If Connexn(i) And ConnectionID(Connexn(i))
SendNetworkData(Connexn(i), *String, StringByteLength("TEST", #PB_Unicode))
EndIf
Next
Debug "SendDataShort"
For i = 1 To 10
If Connexn(i) And ConnectionID(Connexn(i))
SendNetworkData(Connexn(i), *String, StringByteLength("TEST", #PB_Unicode))
EndIf
Next
Debug "Disconnect"
For i = 1 To #ConSize
If Connexn(i) And ConnectionID(Connexn(i))
CloseNetworkConnection(Connexn(i))
EndIf
Next
EndProcedure
Cli()
little bit shortened
Re: Get own threadID without passing as parameter
Posted: Sat May 02, 2020 11:14 am
by infratec
A first hint:
Code: Select all
Define srv.TServer
InitNetwork()
srv\Port = 8888
srv\Protocol = #PB_Network_TCP
srv\interfaceIP = "127.0.0.1"
srv\Mutex = CreateMutex()
srv\Thread = CreateThread(@INITsrv(), @srv)
Repeat
Delay(10)
ForEver
Re: Get own threadID without passing as parameter
Posted: Sat May 02, 2020 11:29 am
by LiK137
Could you please explain the advantages of @srv over *srv ?
Is it more crashproof or faster to access or more safe?
Thank You in advance
Applied changes according Your hints but would like to know difference
Re: Get own threadID without passing as parameter
Posted: Sat May 02, 2020 11:58 am
by infratec
My server version:
Code: Select all
EnableExplicit
#DataBuffSize = 1024
Structure TCMDataStructure
szData.i
pathData.s
*memData
EndStructure
Structure TClientStructure
Thread.i
clID.i
IP.i
Port.i
LastTime.i
Mutex.i
Disconnected.i
ThreadDone.i
List TCMDataList.TCMDataStructure()
EndStructure
Structure TServerStructure
Thread.i
Mutex.i
srvID.i
Port.i
Protocol.i
IPv.i
interfaceIP.s
Map ClientMap.TClientStructure()
EndStructure
Procedure thdCMDo(*TClient.TClientStructure)
Protected Recv$
LockMutex(*TClient\Mutex)
If *TClient\Disconnected
*TClient\ThreadDone = #True
Else
ForEach *TClient\TCMDataList()
Recv$ + PeekS(*TClient\TCMDataList()\memData, *TClient\TCMDataList()\szData, #PB_UTF8|#PB_ByteLength)
FreeMemory(*TClient\TCMDataList()\memData)
DeleteElement(*TClient\TCMDataList())
Next
Debug "Data for Client: " + Str(*TClient\clID) + " | " + Recv$ + "|"
EndIf
UnlockMutex(*TClient\Mutex)
EndProcedure
Procedure INITsrv(*srv.TServerStructure)
Protected.i hThread, srvMod, SERVent, ServerID, ClientID, Qty, DoneQty, StepQty
Protected *Buffer0, *TClient.TClientStructure
If *srv\Port > 0 And *srv\Port < 65000
If *srv\Protocol = #PB_Network_TCP Or *srv\Protocol = #PB_Network_UDP
If *srv\IPv = #PB_Network_IPv4 Or *srv\IPv = #PB_Network_IPv6
srvMod = *srv\Protocol | *srv\IPv
Else
srvMod = *srv\Protocol
EndIf
Else
srvMod = #PB_Network_TCP | #PB_Network_IPv4
EndIf
If *srv\interfaceIP = ""
*srv\srvID = CreateNetworkServer(#PB_Any, *srv\Port, srvMod)
Else
*srv\srvID = CreateNetworkServer(#PB_Any, *srv\Port, srvMod, *srv\interfaceIP)
EndIf
Repeat
SERVent = NetworkServerEvent()
Select SERVent
Case #PB_NetworkEvent_None
Delay(10)
Case #PB_NetworkEvent_Connect ;- #PB_NetworkEvent_Connect
ClientID = EventClient()
Debug "Connection: " + Str(ClientID)
LockMutex(*srv\Mutex)
*TClient = FindMapElement(*srv\ClientMap(), Str(ClientID))
If *TClient = #Null
*TClient = AddMapElement(*srv\ClientMap(), Str(ClientID))
UnlockMutex(*srv\Mutex)
If *TClient
*TClient\Mutex = CreateMutex()
*TClient\clID = ClientID
*TClient\IP = GetClientIP(ClientID)
*TClient\Port = GetClientPort(ClientID)
*TClient\LastTime = Date()
EndIf
Else
UnlockMutex(*srv\Mutex)
*TClient\LastTime = Date()
EndIf
Case #PB_NetworkEvent_Disconnect ;- #PB_NetworkEvent_Disconnect
ClientID = EventClient()
LockMutex(*srv\Mutex)
*TClient = FindMapElement(*srv\ClientMap(), Str(ClientID))
If *TClient
Debug "Disconnect : " + Str(ClientID)
LockMutex(*TClient\Mutex)
If *TClient\Thread ; already data received
*TClient\Disconnected = #True
UnlockMutex(*TClient\Mutex)
Else
UnlockMutex(*TClient\Mutex)
FreeMutex(*TClient\Mutex)
DeleteMapElement(*srv\ClientMap(), Str(ClientID))
EndIf
EndIf
UnlockMutex(*srv\Mutex)
Case #PB_NetworkEvent_Data ;- #PB_NetworkEvent_Data
ClientID = EventClient()
LockMutex(*srv\Mutex)
*TClient = FindMapElement(*srv\ClientMap(), Str(ClientID))
If *TClient
*TClient\LastTime = Date()
LockMutex(*TClient\Mutex)
Repeat
If AddElement(*TClient\TCMDataList())
*TClient\TCMDataList()\memData = AllocateMemory(#DataBuffSize, #PB_Memory_NoClear)
If *TClient\TCMDataList()\memData
*TClient\TCMDataList()\szData = ReceiveNetworkData(ClientID, *TClient\TCMDataList()\memData, #DataBuffSize)
If *TClient\TCMDataList()\szData <= 0
FreeMemory(*TClient\TCMDataList()\memData)
DeleteElement(*TClient\TCMDataList())
EndIf
Else
DeleteElement(*TClient\TCMDataList())
EndIf
Else
Break
EndIf
Until *TClient\TCMDataList()\szData < #DataBuffSize
If ListSize(*TClient\TCMDataList())
*TClient\ThreadDone = #False
*TClient\Thread = CreateThread(@thdCMDo(), *TClient)
EndIf
UnlockMutex(*TClient\Mutex)
EndIf
UnlockMutex(*srv\Mutex)
EndSelect
ForEver
EndIf
EndProcedure
Define srv.TServerStructure, MaxTimeWithoutData.i
InitNetwork()
srv\Port = 8888
srv\Protocol = #PB_Network_TCP
srv\interfaceIP = "127.0.0.1"
srv\Mutex = CreateMutex()
srv\Thread = CreateThread(@INITsrv(), @srv)
Repeat
Delay(10000) ; sleep 10 seconds
MaxTimeWithoutData = Date() - 300 ; 5 minutes
If TryLockMutex(srv\Mutex)
ForEach srv\ClientMap()
If srv\ClientMap()\LastTime < MaxTimeWithoutData Or (srv\ClientMap()\Disconnected And srv\ClientMap()\ThreadDone)
Debug "Main Delete: " + Str(srv\ClientMap()\clID)
LockMutex(srv\ClientMap()\Mutex)
ForEach(srv\ClientMap()\TCMDataList())
FreeMemory(srv\ClientMap()\TCMDataList()\memData)
Next
ResetList(srv\ClientMap()\TCMDataList())
UnlockMutex(srv\ClientMap()\Mutex)
FreeMutex(srv\ClientMap()\Mutex)
DeleteMapElement(srv\ClientMap())
EndIf
Next
UnlockMutex(srv\Mutex)
EndIf
ForEver
You need no AllocateMemory() ...
I changed the transmitted strings to UTF8 because it's faster.
Re: Get own threadID without passing as parameter
Posted: Sat May 02, 2020 12:04 pm
by infratec
Improved the code above.
Errorhandling if ReceiveBNetworkData() results in <= 0
Re: Get own threadID without passing as parameter
Posted: Sat May 02, 2020 12:08 pm
by infratec
Improved the code above.
Forgot to free the receive memory if disconnevt or timeout reached.
Normally you get no disconnect event.
Re: Get own threadID without passing as parameter
Posted: Sat May 02, 2020 12:19 pm
by LiK137
Code: Select all
Case #PB_NetworkEvent_Disconnect ;- #PB_NetworkEvent_Disconnect
ClientID = EventClient()
ForEach(*srv\ClientMap()\TCMDataList()) ;Line:96
FreeMemory(*srv\ClientMap()\TCMDataList()\memData)
Next
LockMutex(*srv\Mutex)
DeleteMapElement(*srv\ClientMap(), Str(ClientID))
UnlockMutex(*srv\Mutex)
[15:14:09] [ERROR] LiKliSer.pbi (Line: 96)
[15:14:09] [ERROR] Invalid memory access. (read error at address 28)
[15:14:24] The Program was killed.
Now There is such error
Re: Get own threadID without passing as parameter
Posted: Sat May 02, 2020 12:35 pm
by infratec
Improved code above.
New Mutex for locking if disconnect is faster than output.
Client:
Code: Select all
#String = "TEST "
#cliPort = 8888
#ConSize = 10000
Procedure Cli()
Dim Connexn(#ConSize)
Debug "Connecting"
For i = 1 To #ConSize
Connexn(i) = OpenNetworkConnection("127.0.0.1", #cliPort, #PB_Network_TCP)
Next
Debug "SendDataFull"
For i = 1 To #ConSize
If Connexn(i) And ConnectionID(Connexn(i))
SendNetworkString(Connexn(i), #String + Str(i), #PB_UTF8)
EndIf
Next
Debug "SendDataShort"
For i = 1 To 10
If Connexn(i) And ConnectionID(Connexn(i))
SendNetworkString(Connexn(i), #String + Str(i), #PB_UTF8)
EndIf
Next
Delay(3000)
Debug "Disconnect"
For i = 1 To #ConSize
If Connexn(i) And ConnectionID(Connexn(i))
CloseNetworkConnection(Connexn(i))
EndIf
Next
EndProcedure
If InitNetwork()
Cli()
Else
MessageRequester("Error", "Can't initialize the network !", 0)
EndIf
Re: Get own threadID without passing as parameter
Posted: Sat May 02, 2020 1:20 pm
by infratec
Improved the code above.
Now it should work as it should.
But the Client is strange.
Because the disconnect is faster than the data can be processed.
Re: Get own threadID without passing as parameter
Posted: Sat May 02, 2020 2:34 pm
by infratec
Again small improvements.
Now I also updated the client, to see from which number I get the data.
Re: Get own threadID without passing as parameter
Posted: Sat May 02, 2020 5:56 pm
by mk-soft
Just to see how something can work.
Threads management:
Mini Thread Control
Network for strings and data over64kb:
Modul NetworkTCP
Network for big data and encryption (string, data, files, linked lists:
Module NetworkData
Re: Get own threadID without passing as parameter
Posted: Sun May 03, 2020 12:58 am
by Olliv
That is good ! (Even if I have no network except my smartphone...)
Once upon a time a guy that I am, who discovers the term << Bank note >> !!!
@LiK137
I think #DataBuff should be a variable.
This allows it to adapt :
If UDP : DataBuff = Coins
If TCP : DataBuff = Bank notes
@mk-soft
Thank you for this very good recall