paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 19:59:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

* allow only one thread at a time to attach on a dll so the tls slot is allocated properly, resolves #12987

Browse Source 
git-svn-id: trunk@13648 -
This commit is contained in:
florian 2009-09-05 13:41:09 +00:00
parent 621ebe240e
commit 2f8e263560
2 changed files with 19 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
rtl/win/systhrd.inc
View File

@ -187,6 +187,8 @@ CONST
procedure SysInitMultithreading; procedure SysInitMultithreading;
begin begin
{ do not check IsMultiThread, as program could have altered it, out of Delphi habit } { 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 if TLSKey=$ffffffff then
begin begin
{ We're still running in single thread mode, setup the TLS } { We're still running in single thread mode, setup the TLS }
@ -200,10 +202,10 @@ CONST
procedure SysFiniMultithreading; procedure SysFiniMultithreading;
begin begin
if IsMultiThread then if IsMultiThread then
begin begin
TlsFree(TLSKey); TlsFree(TLSKey);
TLSKey:=$ffffffff; TLSKey:=$ffffffff;
end; end;
end; end;
function SysBeginThread(sa : Pointer;stacksize : ptruint; function SysBeginThread(sa : Pointer;stacksize : ptruint;
@ -342,10 +344,10 @@ end;
Const Const
wrSignaled = 0; wrSignaled = 0;
wrTimeout = 1; wrTimeout = 1;
wrAbandoned= 2; wrAbandoned= 2;
wrError = 3; wrError = 3;
type Tbasiceventstate=record type Tbasiceventstate=record
fhandle : THandle; fhandle : THandle;

12
rtl/win/syswin.inc
View File

@ -24,6 +24,8 @@ Const
Var Var
DLLBuf : Jmp_buf; DLLBuf : Jmp_buf;
MainThreadIdWin32 : DWORD; 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']; function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntryInformation){$endif FPC_HAS_INDIRECT_MAIN_INFORMATION} : longbool; [public,alias:'_FPC_DLL_Entry'];
var var
@ -37,6 +39,7 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
case DLLreason of case DLLreason of
DLL_PROCESS_ATTACH : DLL_PROCESS_ATTACH :
begin begin
WinInitCriticalSection(AttachingThread);
MainThreadIdWin32 := Win32GetCurrentThreadId; MainThreadIdWin32 := Win32GetCurrentThreadId;
If SetJmp(DLLBuf) = 0 then If SetJmp(DLLBuf) = 0 then
begin begin
@ -59,7 +62,8 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
DLL_THREAD_ATTACH : DLL_THREAD_ATTACH :
begin begin
inclocked(Thread_count); inclocked(Thread_count);
WinEnterCriticalSection(AttachingThread);
if (Win32GetCurrentThreadId <> MainThreadIdWin32) then if (Win32GetCurrentThreadId <> MainThreadIdWin32) then
begin begin
{ Set up TLS slot for the DLL } { Set up TLS slot for the DLL }
@ -73,14 +77,15 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
if assigned(Dll_Thread_Attach_Hook) then if assigned(Dll_Thread_Attach_Hook) then
Dll_Thread_Attach_Hook(DllParam); Dll_Thread_Attach_Hook(DllParam);
Dll_entry:=true; { return value is ignored } Dll_entry:=true; { return value is ignored }
end; WinLeaveCriticalSection(AttachingThread);
end;
DLL_THREAD_DETACH : DLL_THREAD_DETACH :
begin begin
declocked(Thread_count); declocked(Thread_count);
if assigned(Dll_Thread_Detach_Hook) then if assigned(Dll_Thread_Detach_Hook) then
Dll_Thread_Detach_Hook(DllParam); Dll_Thread_Detach_Hook(DllParam);
{ Release Threadvars } { Release Threadvars }
if (Win32GetCurrentThreadId <> MainThreadIdWin32) then if (Win32GetCurrentThreadId<>MainThreadIdWin32) then
DoneThread; { Assume everything is idempotent there } DoneThread; { Assume everything is idempotent there }
Dll_entry:=true; { return value is ignored } Dll_entry:=true; { return value is ignored }
end; end;
@ -94,6 +99,7 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
{ Free TLS resources used by ThreadVars } { Free TLS resources used by ThreadVars }
SysFiniMultiThreading; SysFiniMultiThreading;
WinDoneCriticalSection(AttachingThread);
end; end;
end; end;
end; end;