Re: Thread Local Storage
- Posted by petelomax Feb 07, 2013
- 1617 views
Huh, no takers I see 
In case anyone is (ever) interested, my very first stab:
-- -- ptls0.ew -- -- First stab at a wrapper for TLS(Thread Local Storage) -- Implements TlsAlloc, TlsSetValue, TlsGetValue, and TlsFree. -- -- Note: This probably has reference-counting issues when storing anything -- other than integers (which may include results from allocate(n)). -- integer init = 0 atom kernel32, xTlsAlloc, xTlsSetValue, xTlsGetValue, xTlsFree, xGetLastError constant TLS_OUT_OF_INDEXES = -1 --0xFFFFFFFF constant ERROR_SUCCESS = 0 procedure Init() kernel32 = open_dll("kernel32.dll") xTlsAlloc = define_c_func(kernel32,"TlsAlloc", {}, -- void C_INT) -- DWORD xTlsSetValue = define_c_func(kernel32,"TlsSetValue", {C_INT, -- DWORD dwTlsIndex C_PTR}, -- LPVOID lpTlsValue C_INT) -- BOOL xTlsGetValue = define_c_func(kernel32,"TlsGetValue", {C_INT}, -- DWORD dwTlsIndex C_PTR) -- LPVOID xTlsFree = define_c_func(kernel32,"TlsFree", {C_INT}, -- DWORD dwTlsIndex C_INT) -- BOOL xGetLastError = define_c_func(kernel32, "GetLastError", {}, C_INT) -- DWORD init = 1 end procedure global function TlsAlloc() integer res if not init then Init() end if res = c_func(xTlsAlloc,{}) if res=TLS_OUT_OF_INDEXES then ?9/0 end if return res end function global procedure TlsSetValue(integer dwTlsIndex, atom a=0) if not init then ?9/0 end if -- you must call TlsAlloc before this! if c_func(xTlsSetValue,{dwTlsIndex, a})=0 then ?c_func(xGetLastError,{}) ?9/0 end if end procedure global function TlsGetValue(integer dwTlsIndex) atom res if not init then ?9/0 end if -- you must call TlsAlloc before this! res = c_func(xTlsGetValue,{dwTlsIndex}) if res=0 then if c_func(xGetLastError,{})!=ERROR_SUCCESS then ?9/0 end if end if return res end function global procedure TlsFree(integer dwTlsIndex) if not init then ?9/0 end if -- you must call TlsAlloc before this! if c_func(xTlsFree,{dwTlsIndex})=0 then ?c_func(xGetLastError,{}) ?9/0 end if end procedure
And then I went Phix-specific to allow any object to be stored and take care of the refcount issues:
-- -- ptls.ew -- -- Phix wrapper for TLS(Thread Local Storage) -- Implements TlsAlloc, TlsSetValue, TlsGetValue, and TlsFree. -- -- This file is automatically included when needed; there should be no need -- to manually include this file, unless you want an explicit namespace -- -- Technical note: -- TLS can thwart reference counting. -- If you TlsSetValue(idx,{a,b}) there is a "hidden" ref count held within -- the TLS (to prevent premature deallocation), and each thread should call -- TlsSetValue(idx[,0]) before terminating to avoid memory leaks. -- TerminateThread() will prevent your code from performing said cleanup. -- --DEV -- see pCritSec.e (opTlsGetValue done, but just get something working first!) -- integer init = 0 atom kernel32, xTlsAlloc, xTlsSetValue, -- xTlsGetValue, xTlsFree, xGetLastError constant TLS_OUT_OF_INDEXES = -1 --0xFFFFFFFF constant ERROR_SUCCESS = 0 procedure Init() kernel32 = open_dll("kernel32.dll") xTlsAlloc = define_c_func(kernel32,"TlsAlloc", {}, -- void C_INT) -- DWORD xTlsSetValue = define_c_func(kernel32,"TlsSetValue", {C_INT, -- DWORD dwTlsIndex C_PTR}, -- LPVOID lpTlsValue C_INT) -- BOOL -- xTlsGetValue = define_c_func(kernel32,"TlsGetValue", -- {C_INT}, -- DWORD dwTlsIndex -- C_PTR) -- LPVOID xTlsFree = define_c_func(kernel32,"TlsFree", {C_INT}, -- DWORD dwTlsIndex C_INT) -- BOOL xGetLastError = define_c_func(kernel32, "GetLastError", {}, C_INT) -- DWORD init = 1 end procedure global function TlsAlloc() integer res if not init then Init() end if res = c_func(xTlsAlloc,{}) if res=TLS_OUT_OF_INDEXES then ?9/0 end if return res end function global procedure TlsSetValue(integer dwTlsIndex, object o=0) atom a if not init then ?9/0 end if -- you must call TlsAlloc before this! if integer(o) then a = o else -- Store non-integers as (atom)<ref of o>. This will *always* -- be a 64-bit float in the range #40000001..#7FFFFFFF, which -- is above the #3FFFFFFF limit for 31-bit integers. #ilasm{ opLoadMem,%eax,o, -- mov eax,[o] push_ebx, -- push ebx(=0) push_eax, -- push eax fild_qword_esp, -- fild qword[esp] add_esp_imm8,8, -- add esp,8 opLeaMov,%edx,a, -- mov edx,addr a call_rel32,%isOpCode,0,0,%opMovbi} -- call StoreFlt end if -- prevent decref(o), and instead cause decref(prev): #ilasm{ opLoadMem,%eax,dwTlsIndex, -- mov eax,[dwTlsIndex] push_eax, -- push eax call_mem32,%isApiFn,0,0,%opTlsGetValue, -- call TlsGetValue opStoreMem,%eax,o } -- mov [o],eax if c_func(xTlsSetValue,{dwTlsIndex, a})=0 then ?c_func(xGetLastError,{}) ?9/0 end if end procedure global function TlsGetValue(integer dwTlsIndex) atom res object o if not init then ?9/0 end if -- you must call TlsAlloc before this! -- res = c_func(xTlsGetValue,{dwTlsIndex}) #ilasm{ opLoadMem,%eax,dwTlsIndex, -- mov eax,[dwTlsIndex] push_eax, -- push eax call_mem32,%isApiFn,0,0,%opTlsGetValue, -- call TlsGetValue push_ebx, -- push ebx(=0) push_eax, -- push eax fild_qword_esp, -- fild qword[esp] add_esp_imm8,8, -- add esp,8 opLeaMov,%edx,res, -- mov edx,addr res call_rel32,%isOpCode,0,0,%opMovbi} -- call StoreFlt if res=0 then -- 0 may be genuinely valid, or there may have been an error if c_func(xGetLastError,{})!=ERROR_SUCCESS then ?9/0 end if end if if integer(res) then o = res else -- Convert (atom)<ref of value> back to ref, and incref it: #ilasm{ opLoadMem,%eax,res, -- mov eax,[res] sub_esp_imm8,8, -- sub esp,8 fld_qword_sib,%ebx_eax4, -- fld qword[ebx+eax*4] fistp_qword_esp, -- fistp qword[esp] pop_eax, -- pop eax add_esp_imm8,4, -- add esp,4 inc_sibd8,%ebx_eax4,-8, -- inc dword [ebx+eax*4-8] ; increment refcount. opStoreMem,%eax,o } -- mov [o],eax end if return o end function global procedure TlsFree(integer dwTlsIndex) if not init then ?9/0 end if -- you must call TlsAlloc before this! if c_func(xTlsFree,{dwTlsIndex})=0 then ?c_func(xGetLastError,{}) ?9/0 end if end procedure
