* make heaptrc aware of the fact that multi threading could be initialized before heaptrc itself is initialized, this is currently the case for windows dlls

git-svn-id: trunk@14560 -
This commit is contained in:
florian 2010-01-07 13:41:43 +00:00
parent fb07fe5856
commit e6648da567
7 changed files with 60 additions and 3 deletions

3
.gitattributes vendored
View File

@ -10157,6 +10157,9 @@ tests/webtbs/tw1485.pp svneol=native#text/plain
tests/webtbs/tw1489.pp svneol=native#text/plain
tests/webtbs/tw14958a.pp svneol=native#text/plain
tests/webtbs/tw14958b.pp svneol=native#text/plain
tests/webtbs/tw14992a.pp svneol=native#text/pascal
tests/webtbs/tw14992b.pp svneol=native#text/pascal
tests/webtbs/tw14992c.pp svneol=native#text/pascal
tests/webtbs/tw1501.pp svneol=native#text/plain
tests/webtbs/tw15015.pp svneol=native#text/plain
tests/webtbs/tw15088.pp svneol=native#text/plain

View File

@ -1344,6 +1344,12 @@ begin
Rewrite(error_file);
end;
{$endif EXTRA}
{ if multithreading was initialized before heaptrc gets initialized (this is currently
the case for windows dlls), then RelocateHeap gets never called and the lock
must be initialized already here
}
if IsMultithread then
initcriticalsection(todo_lock);
end;
procedure TraceExit;

View File

@ -177,7 +177,6 @@ CONST
if dataindex=nil then
begin
SysAllocateThreadVars;
dataindex:=TlsGetValue(tlskey);
end;
SetLastError(errorsave);
@ -484,3 +483,4 @@ begin
if IsLibrary then
SysInitMultithreading;
end;

View File

@ -56,9 +56,9 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
WinEnterCriticalSection(AttachingThread);
if Win32GetCurrentThreadId <> MainThreadIdWin32 then
begin
{ Set up TLS slot for the DLL }
SysInitMultiThreading;
{ Allocate Threadvars }
SysAllocateThreadVars;
{ 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) }
InitThread($1000000); { Assume everything is idempotent there, as the thread could have been created with BeginThread... }

7
tests/webtbs/tw14992a.pp Normal file
View File

@ -0,0 +1,7 @@
{ %target=win32,wince,win64 }
{ %opt=-gh }
{ %norun }
library dll1;
begin
IsMultiThread:=True;
end.

7
tests/webtbs/tw14992b.pp Normal file
View File

@ -0,0 +1,7 @@
{ %target=win32,wince,win64 }
{ %opt=-gh }
{ %norun }
library dll2;
begin
IsMultiThread:=True;
end.

34
tests/webtbs/tw14992c.pp Normal file
View File

@ -0,0 +1,34 @@
{ %target=win32,wince,win64 }
{ %opt=-gh }
{$AppType CONSOLE}
uses Windows;
{$C+}
var
dll1, dll2: HModule;
function T1(Parameter: Pointer): LongInt;
begin
//Sleep(100);
end;
function T2(Parameter: Pointer): LongInt;
begin
//Sleep(100);
end;
var
h: array[0..1] of THandle;
id1, id2: DWORD;
p : pointer;
begin
IsMultiThread:=True;
dll1:=LoadLibrary('tw14992a.dll');
dll2:=LoadLibrary('tw14992b.dll');
h[0]:=BeginThread(nil, 0, @T1, nil, 0, id1);
h[1]:=BeginThread(nil, 0, @T2, nil, 0, id2);
WaitForMultipleObjects(Length(h), @h[0], true, infinite);
FreeLibrary(dll2);
FreeLibrary(dll1);
end.