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

* always assume a multithreaded application when using threadvars in dlls, resolves #14992

Browse Source 
git-svn-id: trunk@14557 -
This commit is contained in:
florian 2010-01-06 21:26:49 +00:00
parent 0b4b9b5220
commit fb07fe5856
2 changed files with 50 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

79
rtl/win/systhrd.inc
View File

@ -56,6 +56,18 @@ function ResetEvent(hEvent:THandle):LONGBOOL; stdcall; external KernelDLL name
function SetEvent(hEvent:THandle):LONGBOOL; stdcall; external KernelDLL name 'SetEvent'; function SetEvent(hEvent:THandle):LONGBOOL; stdcall; external KernelDLL name 'SetEvent';
{$endif WINCE} {$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 CONST
WAIT_OBJECT_0 = 0; WAIT_OBJECT_0 = 0;
WAIT_ABANDONED_0 = $80; WAIT_ABANDONED_0 = $80;
@ -74,6 +86,9 @@ CONST
const const
TLSKey : DWord = $ffffffff; TLSKey : DWord = $ffffffff;
var
MainThreadIdWin32 : DWORD;
AttachingThread : TRTLCriticalSection;
procedure SysInitThreadvar(var offset : dword;size : dword); procedure SysInitThreadvar(var offset : dword;size : dword);
begin begin
@ -99,6 +114,32 @@ CONST
TlsSetValue(tlskey,dataindex); TlsSetValue(tlskey,dataindex);
end; 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; function SysRelocateThreadvar(offset : dword) : pointer;
var var
@ -136,6 +177,7 @@ CONST
if dataindex=nil then if dataindex=nil then
begin begin
SysAllocateThreadVars; SysAllocateThreadVars;
dataindex:=TlsGetValue(tlskey); dataindex:=TlsGetValue(tlskey);
end; end;
SetLastError(errorsave); SetLastError(errorsave);
@ -185,29 +227,6 @@ CONST
ThreadMain:=ti.f(ti.p); ThreadMain:=ti.f(ti.p);
end; 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; function SysBeginThread(sa : Pointer;stacksize : ptruint;
ThreadFunction : tthreadfunc;p : pointer; ThreadFunction : tthreadfunc;p : pointer;
@ -308,18 +327,6 @@ CONST
Delphi/Win32 compatibility 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); procedure SySInitCriticalSection(var cs);
begin begin
WinInitCriticalSection(PRTLCriticalSection(@cs)^); WinInitCriticalSection(PRTLCriticalSection(@cs)^);
@ -474,4 +481,6 @@ begin
end; end;
SetThreadManager(WinThreadManager); SetThreadManager(WinThreadManager);
ThreadID := GetCurrentThreadID; ThreadID := GetCurrentThreadID;
if IsLibrary then
SysInitMultithreading;
end; end;

9
rtl/win/syswin.inc
View File

@ -23,9 +23,6 @@ Const
DLLExitOK : boolean = true; DLLExitOK : boolean = true;
Var Var
DLLBuf : Jmp_buf; 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']; 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 begin
@ -39,6 +36,7 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
begin begin
WinInitCriticalSection(AttachingThread); WinInitCriticalSection(AttachingThread);
MainThreadIdWin32 := Win32GetCurrentThreadId; MainThreadIdWin32 := Win32GetCurrentThreadId;
If SetJmp(DLLBuf) = 0 then If SetJmp(DLLBuf) = 0 then
begin begin
{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION} {$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}
@ -56,7 +54,7 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
inclocked(Thread_count); inclocked(Thread_count);
WinEnterCriticalSection(AttachingThread); 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 }
SysInitMultiThreading; SysInitMultiThreading;
@ -77,7 +75,7 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
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;
@ -309,3 +307,4 @@ procedure InitWin32Widestrings;
widestringmanager.LowerUnicodeStringProc:=@Win32UnicodeLower; widestringmanager.LowerUnicodeStringProc:=@Win32UnicodeLower;
{$endif VER2_2} {$endif VER2_2}
end; end;