Browse Source

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

git-svn-id: trunk@14557 -
florian 15 years ago
parent
commit
fb07fe5856
2 changed files with 50 additions and 42 deletions
  1. 45 36
      rtl/win/systhrd.inc
  2. 5 6
      rtl/win/syswin.inc

+ 45 - 36
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;

+ 5 - 6
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;
+