From fb07fe5856d2fa57cb601214f286090458a193da Mon Sep 17 00:00:00 2001 From: florian Date: Wed, 6 Jan 2010 21:26:49 +0000 Subject: [PATCH] * always assume a multithreaded application when using threadvars in dlls, resolves #14992 git-svn-id: trunk@14557 - --- rtl/win/systhrd.inc | 81 +++++++++++++++++++++++++-------------------- rtl/win/syswin.inc | 11 +++--- 2 files changed, 50 insertions(+), 42 deletions(-) diff --git a/rtl/win/systhrd.inc b/rtl/win/systhrd.inc index d5f6233b0b..345cae28e1 100644 --- a/rtl/win/systhrd.inc +++ b/rtl/win/systhrd.inc @@ -56,6 +56,18 @@ function ResetEvent(hEvent:THandle):LONGBOOL; stdcall; external KernelDLL name function SetEvent(hEvent:THandle):LONGBOOL; stdcall; external KernelDLL name 'SetEvent'; {$endif WINCE} +procedure WinInitCriticalSection(var cs : TRTLCriticalSection); + {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'InitializeCriticalSection'; + +procedure WinDoneCriticalSection(var cs : TRTLCriticalSection); + {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'DeleteCriticalSection'; + +procedure WinEnterCriticalSection(var cs : TRTLCriticalSection); + {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'EnterCriticalSection'; + +procedure WinLeaveCriticalSection(var cs : TRTLCriticalSection); + {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'LeaveCriticalSection'; + CONST WAIT_OBJECT_0 = 0; WAIT_ABANDONED_0 = $80; @@ -74,6 +86,9 @@ CONST const TLSKey : DWord = $ffffffff; + var + MainThreadIdWin32 : DWORD; + AttachingThread : TRTLCriticalSection; procedure SysInitThreadvar(var offset : dword;size : dword); begin @@ -99,6 +114,32 @@ CONST TlsSetValue(tlskey,dataindex); end; + function SysRelocateThreadvar(offset : dword) : pointer; forward; + + procedure SysInitMultithreading; + begin + { do not check IsMultiThread, as program could have altered it, out of Delphi habit } + + { the thread attach/detach code uses locks to avoid multiple calls of this } + if TLSKey=$ffffffff then + begin + { We're still running in single thread mode, setup the TLS } + TLSKey:=TlsAlloc; + InitThreadVars(@SysRelocateThreadvar); + + IsMultiThread:=true; + end; + end; + + + procedure SysFiniMultithreading; + begin + if IsMultiThread then + begin + TlsFree(TLSKey); + TLSKey:=$ffffffff; + end; + end; function SysRelocateThreadvar(offset : dword) : pointer; var @@ -114,7 +155,7 @@ CONST movl %fs:(0x2c),%eax orl %eax,%eax jnz .LAddressInEAX - { this works on Windows 7, but I don't know if it works on other OSes (FK) } + { this works on Windows 7, but I don't know if it works on other OSes (FK) } movl %fs:(0x18),%eax movl 0xe10(%eax,%edx,4),%eax jmp .LToDataIndex @@ -136,6 +177,7 @@ CONST if dataindex=nil then begin SysAllocateThreadVars; + dataindex:=TlsGetValue(tlskey); end; SetLastError(errorsave); @@ -185,29 +227,6 @@ CONST ThreadMain:=ti.f(ti.p); end; - procedure SysInitMultithreading; - begin - { do not check IsMultiThread, as program could have altered it, out of Delphi habit } - - { the thread attach/detach code uses locks to avoid multiple calls of this } - if TLSKey=$ffffffff then - begin - { We're still running in single thread mode, setup the TLS } - TLSKey:=TlsAlloc; - InitThreadVars(@SysRelocateThreadvar); - { allocate the thread vars for the main thread } - IsMultiThread:=true; - end; - end; - - procedure SysFiniMultithreading; - begin - if IsMultiThread then - begin - TlsFree(TLSKey); - TLSKey:=$ffffffff; - end; - end; function SysBeginThread(sa : Pointer;stacksize : ptruint; ThreadFunction : tthreadfunc;p : pointer; @@ -308,18 +327,6 @@ CONST Delphi/Win32 compatibility *****************************************************************************} -procedure WinInitCriticalSection(var cs : TRTLCriticalSection); - {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'InitializeCriticalSection'; - -procedure WinDoneCriticalSection(var cs : TRTLCriticalSection); - {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'DeleteCriticalSection'; - -procedure WinEnterCriticalSection(var cs : TRTLCriticalSection); - {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'EnterCriticalSection'; - -procedure WinLeaveCriticalSection(var cs : TRTLCriticalSection); - {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'LeaveCriticalSection'; - procedure SySInitCriticalSection(var cs); begin WinInitCriticalSection(PRTLCriticalSection(@cs)^); @@ -474,4 +481,6 @@ begin end; SetThreadManager(WinThreadManager); ThreadID := GetCurrentThreadID; + if IsLibrary then + SysInitMultithreading; end; diff --git a/rtl/win/syswin.inc b/rtl/win/syswin.inc index d4d241a2f4..e003199d92 100644 --- a/rtl/win/syswin.inc +++ b/rtl/win/syswin.inc @@ -23,9 +23,6 @@ Const DLLExitOK : boolean = true; Var DLLBuf : Jmp_buf; - MainThreadIdWin32 : DWORD; - AttachingThread : TRTLCriticalSection; - function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntryInformation){$endif FPC_HAS_INDIRECT_MAIN_INFORMATION} : longbool; [public,alias:'_FPC_DLL_Entry']; begin @@ -39,6 +36,7 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry begin WinInitCriticalSection(AttachingThread); MainThreadIdWin32 := Win32GetCurrentThreadId; + If SetJmp(DLLBuf) = 0 then begin {$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION} @@ -56,13 +54,13 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry inclocked(Thread_count); WinEnterCriticalSection(AttachingThread); - if (Win32GetCurrentThreadId <> MainThreadIdWin32) then + if Win32GetCurrentThreadId <> MainThreadIdWin32 then begin { Set up TLS slot for the DLL } SysInitMultiThreading; { Allocate Threadvars } { NS : no idea what is correct to pass here - pass dummy value for now } - { passing a dummy is ok, the correct value is read from the coff header of SysInstance (FK) } + { passing a dummy is ok, the correct value is read from the coff header of SysInstance (FK) } InitThread($1000000); { Assume everything is idempotent there, as the thread could have been created with BeginThread... } end; @@ -77,7 +75,7 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry if assigned(Dll_Thread_Detach_Hook) then Dll_Thread_Detach_Hook(DllParam); { Release Threadvars } - if (Win32GetCurrentThreadId<>MainThreadIdWin32) then + if Win32GetCurrentThreadId<>MainThreadIdWin32 then DoneThread; { Assume everything is idempotent there } Dll_entry:=true; { return value is ignored } end; @@ -309,3 +307,4 @@ procedure InitWin32Widestrings; widestringmanager.LowerUnicodeStringProc:=@Win32UnicodeLower; {$endif VER2_2} end; +