mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-09 17:48:46 +02:00
* always assume a multithreaded application when using threadvars in dlls, resolves #14992
git-svn-id: trunk@14557 -
This commit is contained in:
florian
parent
0b4b9b5220
commit
fb07fe5856
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user