PBDLL60: Thread Local Storage example

[Florent Heyworth]

Thread local storage (TLS) is an easy and efficient way to provide thread safety to your apps. It can be used in any type of application although it's usually used in DLLs that you want to distribute. It provides a way to implement thread safety in a generic way.

This is how it works:
Each thread gets an index which is TLSIndex(%TLS_MINIMUM_AVAILABLE). However the TLS index is a bit array (representing flags) which is declared as a global variable. It should be initialised on process startup and cleared at process end.

Below is code for two files:
- TLSTST.BAS should be compiled to a DLL
- TEST.BAS exercises the DLL in multiple threads, setting and retrieving error values

FILE TLSTST.BAS
-----------------------------------------------------------

'*******************************************************************************************************
' FILE TLSTST.BAS
'*******************************************************************************************************
#COMPILE DLL "TLSTST.DLL"
 
#INCLUDE "win32api.inc"
 
GLOBAL dwTlsIndex AS DWORD 'Tls index (Bit array)

 
SUB tls_setLastError ALIAS "tls_setLastError" ( BYVAL dwErrorNum AS DWORD ) EXPORT
   'Sets the last error code
 
   CALL TlsSetValue( dwTlsIndex, BYVAL dwErrorNum ) 'set the error value for the thread
 
END SUB
 
FUNCTION tls_getLastError ALIAS "tls_getLastError" ( ) EXPORT AS DWORD
   'Gets the last error code
 
   FUNCTION =  TlsGetValue( dwTlsIndex ) 'retrieve the error value for the thread
 
END FUNCTION

 
FUNCTION LibMain(BYVAL lInstance AS LONG, _
                 BYVAL lReason    AS LONG, _
                 BYVAL lReserved  AS LONG) EXPORT AS LONG

 
    SELECT CASE lReason
 
        CASE %DLL_PROCESS_ATTACH
 
             dwTlsIndex = TlsAlloc() 'alloc on process attach
             IF dwTlsIndex = %TLS_OUT_OF_INDEXES THEN
                FUNCTION = %FALSE
                EXIT FUNCTION
             END IF
             CALL TlsSetValue( dwTlsIndex, BYVAL %NULL )
             FUNCTION = %TRUE
 
        CASE %DLL_THREAD_ATTACH
 
             CALL TlsSetValue( dwTlsIndex, BYVAL %NULL )
             FUNCTION = %TRUE
 
        CASE %DLL_THREAD_DETACH
 
             FUNCTION = %TRUE
 
        CASE %DLL_PROCESS_DETACH
 
             CALL TlsFree( dwTlsIndex ) 'free on process detach
             FUNCTION = %TRUE
 
    END SELECT
 
END FUNCTION

The exerciser code:
FILE TEST.BAS
---------------------------------------------------------------

'***************************************************************************************************
'FILE TEST.BAS
'***************************************************************************************************
#COMPILE EXE
#REGISTER NONE
 
#INCLUDE "win32api.inc"
 
#IF NOT %DEF(%NULL)
%NULL = 0
#ENDIF
 
DECLARE SUB tls_setLastError LIB "TLSTST.DLL"ALIAS "tls_setLastError"( BYVAL dwErrNum AS DWORD )
DECLARE FUNCTION tls_getLastError LIB "TLSTST.DLL"ALIAS "tls_getLastError"( ) AS DWORD
 
TYPE tStruc
     lThreadNum AS LONG
     lFirst AS LONG
     lSecond AS LONG
END TYPE
 
SUB setError2( t1 AS tStruc PTR )
    
   @t1.lSecond = tls_getLastError()
       
END SUB
    
FUNCTION setError1( BYVAL lNum AS LONG ) AS DWORD
   LOCAL lFirst AS LONG
   LOCAL lSecond AS LONG
   LOCAL i AS LONG
   LOCAL dwResult AS DWORD
   LOCAL t1 AS tStruc PTR
 
   'some activity
   IF lNum MOD 2 = 0 THEN
      FOR i = 0 TO 100000
        CALL tls_setLastError( lNum ) 'set error
      NEXT
      t1 = HeapAlloc( GetProcessHeap(), %HEAP_ZERO_MEMORY, LEN(tStruc) ) 'alloc return structure
      @t1.lThreadNum = lNum
       
      @t1.lFirst = tls_getLastError() 'set error
      CALL tls_setLastError( lNum + 100)  'increase error
      dwResult =  SuspendThread(  GetCurrentThread() ) 'suspend thread using its pseudo handle
   ELSE
      dwResult =  SuspendThread(  GetCurrentThread() ) 'suspend thread using its pseudo handle
      FOR i = 0 TO 100000
        CALL tls_setLastError( lNum )  'set error
      NEXT
      t1 = HeapAlloc( GetProcessHeap(), %HEAP_ZERO_MEMORY, LEN(tStruc) ) 'alloc return structure
      @t1.lThreadNum = lNum
 
      @t1.lFirst = tls_getLastError()
      CALL tls_setLastError( lNum + 100)
   END IF
 
  CALL setError2( @t1 )
  FUNCTION = t1 'set exit value

 
END FUNCTION
 
FUNCTION PBMAIN() AS LONG
   LOCAL lNum AS LONG
   LOCAL lResult AS LONG
   LOCAL i AS LONG
   DIM lThreadNum(0:99) AS LONG
   LOCAL dwStruc AS DWORD
   LOCAL sMsg AS STRING
   LOCAL t2 AS tStruc PTR
  
   FOR i = 0 TO 99
       THREAD CREATE setError1( i ) TO lThreadNum(i)
   NEXT
 
   SLEEP 100
    
   'Resume the theads
   FOR i = 0 TO 99
       THREAD RESUME lThreadNum(i) TO lResult
       lResult = WaitForSingleObject( lThreadNum(i), %INFINITE )
       CALL GetExitCodeThread( BYVAL lThreadNum(i), BYVAL VARPTR(dwStruc) ) 'get the thread return
        
       t2 = dwStruc 'Get exit code values from type PTR
        
       sMsg = sMsg + "THREAD: " + FORMAT$(@t2.lThreadNum, "000") + " - First Result = " + FORMAT$(@t2.lFirst,"000") _ '+ CHR$(13) _
          + " THREAD: " + FORMAT$(@t2.lThreadNum, "000") + " - Second Result = " + FORMAT$(@t2.lSecond,"000") + "; "'show results
       
 
       CALL HeapFree( GetProcessHeap(), 0&, BYVAL t2 ) 'de-alloc thread return structure
   NEXT
 
   FOR i = 0 TO 99
        
       THREAD CLOSE lThreadNum(i) TO lResult
   NEXT
 
   MSGBOX sMsg
   MSGBOX "End of TLS Demo"
 
END FUNCTION