Browse Source

Adjust passing of TlsKey so that it works correctly for indirect entry information

rtl/win32/sysinit.inc:
  * TlsKeyVar is a mere variable, not a public one
rtl/win32/system.pp:
  * new public variable FPCTlsKey to hold the pointer to the TlsKey variable
  * Exe_entry: setup FPCTlsKey
rtl/win/syswin.inc, Dll_entry:
  * setup FPCTlsKey
  * adjust TlsKey usage
rtl/win/systhrd.inc:
  - get rid of the TlsKey property again
  * TlsKey is now a pointer to the TlsKey variable; in case of no indirect main information that is declared locally otherwise it must have been set through the entry information
  * adjust usages of TlsKey
rtl/inc/heaptrc.pp:
  * TlsKey is now a PDword instead of a DWord

git-svn-id: branches/svenbarth/packages@32581 -
svenbarth 9 years ago
parent
commit
4b46eaeb45
5 changed files with 26 additions and 39 deletions
  1. 3 3
      rtl/inc/heaptrc.pp
  2. 18 34
      rtl/win/systhrd.inc
  3. 2 1
      rtl/win/syswin.inc
  4. 1 1
      rtl/win32/sysinit.inc
  5. 2 0
      rtl/win32/system.pp

+ 3 - 3
rtl/inc/heaptrc.pp

@@ -931,7 +931,7 @@ var
    edata : ptruint; external name '__data_end__';
    sbss : ptruint; external name '__bss_start__';
    ebss : ptruint; external name '__bss_end__';
-   TLSKey : DWord; external name '_FPC_TlsKey';
+   TLSKey : PDWord; external name '_FPC_TlsKey';
    TLSSize : DWord; external name '_FPC_TlsSize';
 
 function TlsGetValue(dwTlsIndex : DWord) : pointer;
@@ -1007,9 +1007,9 @@ begin
   if (ptruint(p)>=ptruint(@sbss)) and (ptruint(p)<ptruint(@ebss)) then
     exit;
   { is program multi-threaded and p inside Threadvar range? }
-  if TlsKey<>-1 then
+  if TlsKey^<>-1 then
     begin
-      datap:=TlsGetValue(tlskey);
+      datap:=TlsGetValue(tlskey^);
       if ((ptruint(p)>=ptruint(datap)) and
           (ptruint(p)<ptruint(datap)+TlsSize)) then
         exit;

+ 18 - 34
rtl/win/systhrd.inc

@@ -91,31 +91,15 @@ var
                              Threadvar support
 *****************************************************************************}
 
-    {$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}
-    function GetTLSKey: DWord; inline;
-      begin
-        if not Assigned(EntryInformation.Platform.TLSKeyAddr) then
-          { this is the case during application startup, as the tlsentry is called first }
-          Result:=$ffffffff
-        else
-          Result:=EntryInformation.Platform.TLSKeyAddr^;
-      end;
-
-    procedure SetTLSKey(value : DWord); inline;
-      begin
-        if Assigned(EntryInformation.Platform.TLSKeyAddr) then
-          EntryInformation.Platform.TLSKeyAddr^:=value;
-      end;
-    {$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
-
     var
       // public names are used by heaptrc unit
       threadvarblocksize : dword; public name '_FPC_TlsSize';
       {$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}
-      property TLSKey : DWord read GetTLSKey write SetTLSKey;
-      {$else}
-      TLSKey : DWord = $ffffffff; public name '_FPC_TlsKey';
-      {$endif}
+      TLSKey : PDword; external name '_FPC_TlsKey';
+      {$else FPC_HAS_INDIRECT_MAIN_INFORMATION}
+      TLSKeyVar : DWord = $ffffffff;
+      TLSKey : PDWord = @TLSKey; public name '_FPC_TlsKey';
+      {$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
 
 
     var
@@ -143,15 +127,15 @@ var
         { these aren't allocated yet ...            }
         { allocate room on the heap for the thread vars }
         errorsave:=GetLastError;
-        if tlskey=$ffffffff then
+        if tlskey^=$ffffffff then
           RunError(226);
-        dataindex:=TlsGetValue(tlskey);
+        dataindex:=TlsGetValue(tlskey^);
         if dataindex=nil then
           begin
             dataindex:=pointer(LocalAlloc(LMEM_FIXED or LMEM_ZEROINIT,threadvarblocksize));
             if dataindex=nil then
               RunError(226);
-            TlsSetValue(tlskey,dataindex);
+            TlsSetValue(tlskey^,dataindex);
           end;
         SetLastError(errorsave);
       end;
@@ -163,10 +147,10 @@ var
         { 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
            { We're still running in single thread mode, setup the TLS }
-           TLSKey:=TlsAlloc;
+           TLSKey^:=TlsAlloc;
            InitThreadVars(@SysRelocateThreadvar);
 
            IsMultiThread:=true;
@@ -176,9 +160,9 @@ var
 
     procedure SysFiniMultithreading;
       begin
-        if TLSKey<>$ffffffff then
-          TlsFree(TLSKey);
-        TLSKey:=$ffffffff;
+        if TLSKey^<>$ffffffff then
+          TlsFree(TLSKey^);
+        TLSKey^:=$ffffffff;
       end;
 
     function SysRelocateThreadvar(offset : dword) : pointer;
@@ -187,11 +171,11 @@ var
         errorsave : dword;
       begin
         errorsave:=GetLastError;
-        dataindex:=TlsGetValue(tlskey);
+        dataindex:=TlsGetValue(tlskey^);
         if dataindex=nil then
           begin
             SysAllocateThreadVars;
-            dataindex:=TlsGetValue(tlskey);
+            dataindex:=TlsGetValue(tlskey^);
             InitThread($1000000);
           end;
         SetLastError(errorsave);
@@ -203,12 +187,12 @@ var
       var
         p: pointer;
       begin
-        if TLSKey<>$ffffffff then
+        if TLSKey^<>$ffffffff then
           begin
-            p:=TlsGetValue(tlskey);
+            p:=TlsGetValue(tlskey^);
             if Assigned(p) then
               LocalFree(p);
-            TlsSetValue(tlskey, nil);
+            TlsSetValue(tlskey^, nil);
           end;
       end;
 

+ 2 - 1
rtl/win/syswin.inc

@@ -380,6 +380,7 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
      FPCResStrInitTables:=info.ResStrInitTables;
      FPCResourceStringTables:=info.ResourceStringTables;
      FPCSysInstance:=info.Platform.SysInstanceAddr^;
+     FPCTlsKey:=info.Platform.TlsKeyAddr;
      WStrInitTablesTable:=info.WideInitTables;
 {$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
      IsLibrary:=true;
@@ -421,7 +422,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 TlsGetValue(TLSKey)<>nil then
+           if TlsGetValue(TLSKey^)<>nil then
              DoneThread; { Assume everything is idempotent there }
          end;
        DLL_PROCESS_DETACH :

+ 1 - 1
rtl/win32/sysinit.inc

@@ -16,7 +16,7 @@
 
    var
       SysInstance : Longint;
-      TlsKeyVar: DWord = $ffffffff; public name '_FPC_TlsKey';
+      TlsKeyVar: DWord = $ffffffff;
 
       InitFinalTable : record end; external name 'INITFINAL';
       ThreadvarTablesTable : record end; external name 'FPC_THREADVARTABLES';

+ 2 - 0
rtl/win32/system.pp

@@ -109,6 +109,7 @@ Const
 implementation
 
 var
+  FPCTlsKey : plongword;public name '_FPC_TlsKey';
   FPCSysInstance : Longint;public name '_FPC_SysInstance';
   FPCResStrInitTables : Pointer;public name '_FPC_ResStrInitTables';
   FPCResourceStringTables : Pointer;public name '_FPC_ResourceStringTables';
@@ -213,6 +214,7 @@ procedure Exe_entry(const info : TEntryInformation);[public,alias:'_FPC_EXE_Entr
      FPCResStrInitTables:=info.ResStrInitTables;
      FPCResourceStringTables:=info.ResourceStringTables;
      FPCSysInstance:=info.Platform.SysInstanceAddr^;
+     FPCTlsKey:=info.Platform.TlsKeyAddr;
      WStrInitTablesTable:=info.WideInitTables;
      IsLibrary:=false;
      { install the handlers for exe only ?