A short time ago, I was written this little code for a server software.
I needed a possibility to process routines in background in a comfortable way.
I designed it as pb includefile and I am hoping, my codecomments are effectual explicative.
But please excuse my funny english.
Code: Select all
; 2008 (c) By Marc-Sven Rudolf ( Hroudtwolf )
; http://www.PureBasic-Lounge.com
; PureBasic 4.x (Demo)
; Windows, Linux, OS-X
; **********************************************************************
;-* Deco class ( Parent: cQueue ) :: cQUEUEITEM
; **********************************************************************
Interface IcQUEUEITEM
SetNext ( *Item )
GetNext ()
Get ()
Release ()
EndInterface
Structure cQUEUEITEM
*VTABLE
*PreviousItem
*NextItem
*ptrData
EndStructure
Procedure cQUEUEITEM_SetNext ( *This.cQUEUEITEM , *Item )
*This\NextItem = *Item
ProcedureReturn #Null
EndProcedure
Procedure cQUEUEITEM_GetNext ( *This.cQUEUEITEM )
ProcedureReturn *This\NextItem
EndProcedure
Procedure cQUEUEITEM_Get ( *This.cQUEUEITEM )
ProcedureReturn *This\ptrData
EndProcedure
Procedure cQUEUEITEM_Release ( *This.cQUEUEITEM )
FreeMemory ( *This )
ProcedureReturn #Null
EndProcedure
Procedure CreateObject_cQUEUEITEM ( *ptrData , lSize.l )
Protected *This.cQUEUEITEM = AllocateMemory ( SizeOf ( cQUEUEITEM ) )
If Not *This
ProcedureReturn #Null
EndIf
If Not *ptrData
FreeMemory ( *This )
ProcedureReturn #Null
EndIf
*This\VTABLE = ? VT_cQUEUEITEM
*This\ptrData = AllocateMemory ( lSize )
CopyMemory ( *ptrData , *This\ptrData , lSize )
ProcedureReturn *This
EndProcedure
; *********************************************************************
;-* Deco class ( Parent:individual ) :: cQUEUE
; *********************************************************************
Interface IcQUEUE
Enqueue ( *ptrData )
Dequeue ()
Release ()
EndInterface
Structure cQUEUE
*VTABLE
*First .IcQUEUEITEM
*Last .IcQUEUEITEM
lFieldSize .l
lLimit .l
lCount .l
EndStructure
; ************************************************
; * \Enqueue ( *ptrData )
; ************************************************
; * Push an new entry to the end of the queue
; *
; * *ptrData - Pointer to the datablock you want
; * to push to the queue
; ************************************************
; * Returns TRUE if it was succesfully.
; ************************************************
Procedure cQUEUE_Enqueue ( *This.cQUEUE , *ptrData )
Protected *Item.IcQUEUEITEM
If Not *ptrData
ProcedureReturn #False
EndIf
If *This\lLimit <> -1
If *This\lLimit < *This\lCount
ProcedureReturn #False
EndIf
EndIf
If Not *This\First
*This\First = CreateObject_cQUEUEITEM ( *ptrData , *This\lFieldSize )
*This\Last = *This\First
*This\lCount + 1
ProcedureReturn #True
EndIf
*Item = CreateObject_cQUEUEITEM ( *ptrData , *This\lFieldSize )
*This\Last\SetNext ( *Item )
*This\Last = *Item
*This\lCount + 1
ProcedureReturn #True
EndProcedure
; ************************************************
; * \Dequeue ( *ptrData )
; ************************************************
; * Retrieves an entry from the head of the queue
; * and removes it from the queue.
; *
; ************************************************
; * Returns a pointer to a datablock or NULL
; ************************************************
Procedure cQUEUE_Dequeue ( *This.cQUEUE )
Protected *ptrData
Protected *Item
If *This\First
*Item = *This\First\GetNext ()
*ptrData = *This\First\Get ()
*This\First\Release ()
*This\First = *Item
*This\lCount - 1
ProcedureReturn *ptrData
EndIf
ProcedureReturn #Null
EndProcedure
; ************************************************
; * \Release ()
; ************************************************
; * Releases the whole queue.
; *
; ************************************************
; * Returns a pointer to a datablock or NULL
; ************************************************
Procedure cQUEUE_Release ( *This.IcQUEUE )
Protected *Item
Repeat
*Item = *This\Dequeue ()
If *Item
FreeMemory ( *Item )
EndIf
Until *Item = #Null
FreeMemory ( *This )
ProcedureReturn #Null
EndProcedure
; ************************************************
; * CreateObject_cQUEUE ( lFieldSize.l , [lLimit.l] )
; ************************************************
; * Creates a new object.
; *
; * lFieldSize - Size of a queue item
; * lLimit - (optional) amount of queue items
; ************************************************
; * Returns a pointer to the new object or NULL
; ************************************************
Procedure CreateObject_cQUEUE ( lFieldSize.l , lLimit.l = -1 )
Protected *This.cQUEUE = AllocateMemory ( SizeOf ( cQUEUE ) )
If Not *This
ProcedureReturn #Null
EndIf
If Not lFieldSize
FreeMemory ( *This )
ProcedureReturn #Null
EndIf
*This\VTABLE = ? VT_cQUEUE
*This\lFieldSize = lFieldSize
*This\lLimit = lLimit
ProcedureReturn *This
EndProcedure
; ************************************************
; * Virtual table
; ************************************************
DataSection
VT_cQueue:
Data.l @ cQUEUE_Enqueue ()
Data.l @ cQUEUE_Dequeue ()
Data.l @ cQUEUE_Release ()
VT_cQUEUEITEM:
Data.l @ cQUEUEITEM_SetNext ()
Data.l @ cQUEUEITEM_GetNext ()
Data.l @ cQUEUEITEM_Get ()
Data.l @ cQUEUEITEM_Release ()
EndDataSection
; **********************************************************************
;-* none public variables & types
; **********************************************************************
Enumeration 1
#BCKPROC_MSG_UPDATE
#BCKPROC_MSG_USERMSG ; Startpoint for usermessages. i.ex.: #BCKPROC_MSG_CHANGEIT = #BCKPROC_MSG_USERMSG
EndEnumeration ; #BCKPROC_MSG_DOIT = #BCKPROC_MSG_USERMSG + 1
; #BCKPROC_MSG_GIVEIT = #BCKPROC_MSG_USERMSG + 2
Prototype.l pBckProcCallback ( lMsgID.l , lParam1.l , lParam2.l )
Structure tBCKPROCMSG
lMsgID.l
lParam1.l
lParam2.l
EndStructure
Structure tBCKPROC
nThread .l
bCancel .b
wProcessLatency.w
*Queue .IcQUEUE
*ReplyQueue .IcQUEUE
*Callback .pBckProcCallback
*Mutex
*UserData
EndStructure
; **********************************************************************
;-* none public functions
; **********************************************************************
Procedure _BckProcessorThread ( *Thread.tBckProc )
Protected *Msg.tBCKPROCMSG
Repeat
LockMutex ( *Thread\Mutex )
*Msg = *Thread\Queue\Dequeue ()
If *Msg
If *Thread\Callback
*Thread\Callback ( *Msg\lMsgID , *Msg\lParam1 , *Msg\lParam2 )
EndIf
FreeMemory ( *Msg )
EndIf
If *Thread\Callback
*Thread\Callback ( #BCKPROC_MSG_UPDATE , #Null , #Null )
EndIf
Delay ( *Thread\wProcessLatency )
UnlockMutex ( *Thread\Mutex )
Until *Thread\bCancel
ProcedureReturn #Null
EndProcedure
Procedure _BckProcessor_GetData ()
Static BckProc.tBCKPROC
If Not BckProc\Queue
BckProc\wProcessLatency = 10
BckProc\Queue = CreateObject_cQUEUE ( SizeOf ( tBCKPROCMSG ) )
BckProc\ReplyQueue = CreateObject_cQUEUE ( SizeOf ( tBCKPROCMSG ) )
If Not BckProc\Mutex
BckProc\Mutex = CreateMutex ()
EndIf
BckProc\nThread = CreateThread ( @ _BckProcessorThread () , BckProc )
EndIf
ProcedureReturn BckProc
EndProcedure
;-**********************************************************************
;-* !!! Public includefile functions !!!
;-**********************************************************************
; ************************************************
; * BckProcessor_SetCallback ( *CallbackProc )
; ************************************************
; * Sets a new callback which should receive
; * messages.
; * It is neccasary to call this function at first
; * to start the background-processor.
; * If you call it again, it just will change the
; * current callbackaddress.
; ************************************************
; * Returns TRUE/FALSE
; ************************************************
Procedure BckProcessor_SetCallback ( *CallbackProc )
Protected *BckProc.tBCKPROC = _BckProcessor_GetData ()
If Not *CallbackProc
ProcedureReturn #False
EndIf
LockMutex ( *BckProc\Mutex )
*BckProc\Callback = *CallbackProc
UnlockMutex ( *BckProc\Mutex )
ProcedureReturn #True
EndProcedure
; ************************************************
; * BckProcessor_SendMessage ( lMsgID.l , lParam1.l , lParam2.l )
; ************************************************
; * Sends an message to the background-process.
; * The message will pushed to a queue.
; ************************************************
; * Returns TRUE/FALSE
; ************************************************
Procedure BckProcessor_SendMessage ( lMsgID.l , lParam1.l , lParam2.l )
Protected *BckProc.tBCKPROC = _BckProcessor_GetData ()
Protected ptrData.tBCKPROCMSG
If Not lMsgID
ProcedureReturn #False
EndIf
ptrData\lMsgID = lMsgID
ptrData\lParam1 = lParam1
ptrData\lParam2 = lParam2
LockMutex ( *BckProc\Mutex )
*BckProc\Queue\Enqueue ( ptrData )
UnlockMutex ( *BckProc\Mutex )
ProcedureReturn #True
EndProcedure
; ************************************************
; * BckProcessor_SetLatency ( wTimeMS.w )
; ************************************************
; * This function sets the latency time in
; * milliseconds.
; * As higher the value is, as slower iterates
; * the background processer messages from
; * the queue.
; ************************************************
; * Returns NULL
; ************************************************
Procedure BckProcessor_SetLatency ( wTimeOut.w )
Protected *BckProc.tBCKPROC = _BckProcessor_GetData ()
LockMutex ( *BckProc\Mutex )
*BckProc\wProcessLatency = wTimeOut
UnlockMutex ( *BckProc\Mutex )
ProcedureReturn #Null
EndProcedure
; ************************************************
; * BckProcessor_SetUserdata ( *Userdata )
; ************************************************
; * Sets an address to a userdata dataset.
; *
; ************************************************
; * Returns NULL
; ************************************************
Procedure BckProcessor_SetUserdata ( *Userdata )
Protected *BckProc.tBCKPROC = _BckProcessor_GetData ()
LockMutex ( *BckProc\Mutex )
*BckProc\Userdata = *Userdata
UnlockMutex ( *BckProc\Mutex )
ProcedureReturn #Null
EndProcedure
; ************************************************
; * BckProcessor_GetUserdata ()
; ************************************************
; * Retrieves the adress to a userdata dataset.
; *
; ************************************************
; * See description
; ************************************************
Procedure BckProcessor_GetUserdata ()
Protected *BckProc.tBCKPROC = _BckProcessor_GetData ()
Protected *Userdata
LockMutex ( *BckProc\Mutex )
*Userdata = *BckProc\Userdata
UnlockMutex ( *BckProc\Mutex )
ProcedureReturn *Userdata
EndProcedure
; ************************************************
; * BckProcessor_Cancel ( wTimeOut.w )
; ************************************************
; * This function cancels/terminates the
; * background processor.
; * It is neccasary before breaking the current process.
; * Recall "BckProcessor_SetCallback" for restarting
; * background processor.
; ************************************************
; * Returns NULL
; ************************************************
Procedure BckProcessor_Cancel ( wTimeOut.w )
Protected *BckProc.tBCKPROC = _BckProcessor_GetData ()
*BckProc\bCancel = #True
WaitThread ( *BckProc\nThread , wTimeOut )
If IsThread ( *BckProc\nThread )
KillThread ( *BckProc\nThread )
EndIf
*BckProc\Queue\Release ()
*BckProc\ReplyQueue\Release ()
*BckProc\Queue = #Null
*BckProc\ReplyQueue = #Null
ProcedureReturn #Null
EndProcedure
; ************************************************
; * BckProcessor_GetReplyMessage ( *Message.tBCKPROCMSG )
; ************************************************
; * Copies a message, if available, to *Message.
; *
; * ATTENTION: CALL THIS FUNCTION AS OFTEN AS
; * POSSIBLE! 'CAUSE THE QUEUE IS RAISING
; * HIGHER AND HIGHER INTO THE RAM!
; *
; ************************************************
; * Returns TRUE if a message is available.
; * Returns FALSE if not or *Message is NULL.
; ************************************************
Procedure BckProcessor_GetReplyMessage ( *Message.tBCKPROCMSG )
Protected *BckProc.tBCKPROC = _BckProcessor_GetData ()
If Not *Message
ProcedureReturn #False
EndIf
LockMutex ( *BckProc\Mutex )
*Msg = *BckProc\ReplyQueue\Dequeue ()
If Not *Msg
UnlockMutex ( *BckProc\Mutex )
ProcedureReturn #False
EndIf
CopyMemory ( *Msg , *Message , SizeOf ( tBCKPROCMSG ) )
FreeMemory ( *Msg )
UnlockMutex ( *BckProc\Mutex )
ProcedureReturn #True
EndProcedure
; ************************************************
; * BckProcessor_GetReplyMessage ( *Message.tBCKPROCMSG )
; ************************************************
; * Sends a message from callback to the mainthread.
; *
; * ATTENTION: DON'T CALL THIS FUNCTION OUTSIDE
; * A CALLBACK! IT IS NOT SAFE.
; *
; ************************************************
; * Returns TRUE if a message is available.
; * Returns FALSE if not or *Message is NULL.
; ************************************************
Procedure BckProcessor_SendReplyMessage ( lMsgID.l , lParam1.l , lParam2.l )
Protected *BckProc.tBCKPROC = _BckProcessor_GetData ()
Protected ptrData.tBCKPROCMSG
If Not lMsgID
ProcedureReturn #False
EndIf
ptrData\lMsgID = lMsgID
ptrData\lParam1 = lParam1
ptrData\lParam2 = lParam2
*BckProc\ReplyQueue\Enqueue ( ptrData )
ProcedureReturn #True
EndProcedure Code: Select all
IncludeFile "backproc.inc.pb"
#BCKPROC_MSG_TEST = #BCKPROC_MSG_USERMSG + 1
Procedure ProcessorCallback ( lMsgID.l , lParam1.l , lParam2.l )
Static bUpdate.b
Select lMsgID
Case #BCKPROC_MSG_UPDATE
PrintN ( "Message received: UPDATE" )
Case #BCKPROC_MSG_TEST
PrintN ( "Message received: TEST ; Param1: " + Str ( lParam1 ) + " ; Param2: " + Str ( lParam2 ) )
EndSelect
EndProcedure
Define.w nCount
OpenConsole ()
BckProcessor_SetCallback ( @ ProcessorCallback () )
BckProcessor_SetLatency ( 500 )
PrintN ( "Press any key to abort test." )
Repeat
Delay ( 50 )
nCount + 1
If nCount > 50
nCount = 0
BckProcessor_SendMessage ( #BCKPROC_MSG_TEST , 1 , 2 )
EndIf
Until Inkey ()
BckProcessor_Cancel ( 1000 )
CloseConsole ()
Regards
Wolf
