OpenEuphoria

2. Re: Thread Local Storage

• Posted by petelomax Feb 07, 2013
• 1483 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 

4. Re: Thread Local Storage

• Posted by petelomax Feb 08, 2013
• 1426 views

Erm, threads (in Phix), obviously! Specifically my implementation of c_proc/c_func want to save and call_back wants to restore ebp, which works fine single-threaded using a single static var but will go rather pear-shaped once CreateThread gets involved.

I have just spent about 10 months refactoring Phix innards towards being thread safe, dunno where OpenEu has got to on that front.

Pete