Rework TlsKey handling on Windows so that it works as intended with indirect main information

rtl/inc/system.inc:
  * SetupEntryInformation: call new, optional function OSSetupEntryInformation to handle platform specific entry information initialization
rtl/win/sysosh.inc, TEntryInformationOS:
  + new field TlsKeyAddr which will hold the address to the main binary's TlsKey variable
win32/sysinit.inc:
  + provide the variable holding the TlsKey and pass that on to the entry information record
win32/system.pp:
  + new OS specific entry information initialization (currently only the TlsKey)
win/systhrd.inc:
  * declare TlsKey as a pointer to a DWord value instead of a DWord; on non-indirect entry platforms this is initialized with the address of new variable TlsKeyVar, on indirect entry platforms it will be initialized by the entry information initialization
  * adjust usages of TlsKey from DWord to PDWord
win/systlsdir.inc:
  * TlsKey is now a PDWord and (in sysinit) points to TlsKeyVar
win/syswin.inc:
  * adjust TlsKey usage
inc/heaptrc.pp:
  * TlsKey is now a PDWord, thus adjust the import and the usage

git-svn-id: trunk@33091 -

rtl/inc/heaptrc.pp

@@ -915,7 +915,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;
@@ -989,9 +989,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;

rtl/inc/system.inc

@@ -126,6 +126,9 @@ begin
   EntryInformation := info;
   FPCResStrInitTables := info.ResStrInitTables;
   FPCResourceStringTables := info.ResourceStringTables;
+{$ifdef FPC_SYSTEM_HAS_OSSETUPENTRYINFORMATION}
+  OSSetupEntryInformation(info);
+{$endif FPC_SYSTEM_HAS_OSSETUPENTRYINFORMATION}
 end;
 {$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
 

rtl/win/sysosh.inc

@@ -53,6 +53,7 @@ type
   {$define HAS_ENTRYINFORMATION_OS}
   TEntryInformationOS = record
     asm_exit : Procedure;stdcall;
+    TlsKeyAddr : PDWord;
   end;
 {$endif Win32}
 

rtl/win/systhrd.inc

@@ -94,7 +94,12 @@ var
     var
       // public names are used by heaptrc unit
       threadvarblocksize : dword; public name '_FPC_TlsSize';
-      TLSKey : DWord = $ffffffff; public name '_FPC_TlsKey';
+      {$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}
+      TLSKey : PDword = nil; public name '_FPC_TlsKey';
+      {$else FPC_HAS_INDIRECT_MAIN_INFORMATION}
+      TLSKeyVar : DWord = $ffffffff;
+      TLSKey : PDWord = @TLSKeyVar; public name '_FPC_TlsKey';
+      {$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
 
     var
       MainThreadIdWin32 : DWORD;
@@ -121,15 +126,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;
@@ -141,10 +146,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;
@@ -154,9 +159,9 @@ var
 
     procedure SysFiniMultithreading;
       begin
-        if TLSKey<>$ffffffff then
+        if TLSKey^<>$ffffffff then
-          TlsFree(TLSKey);
+          TlsFree(TLSKey^);
-        TLSKey:=$ffffffff;
+        TLSKey^:=$ffffffff;
       end;
 
     function SysRelocateThreadvar(offset : dword) : pointer;
@@ -165,11 +170,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);
@@ -181,12 +186,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;
 

rtl/win/systlsdir.inc

@@ -33,7 +33,7 @@ Const
   DLL_THREAD_DETACH = 3;
 
 var
-   TlsKey : dword; external name '_FPC_TlsKey';
+   TlsKey : PDWord = @TlsKeyVar;
 
 type
   TTlsDirectory=packed record
@@ -107,7 +107,7 @@ procedure Exec_Tls_callback(Handle : pointer; reason : Dword; Reserved : pointer
          end;
        DLL_THREAD_DETACH :
          begin
-           if TlsGetValue(TLSKey)<>nil then
+           if TlsGetValue(TLSKey^)<>nil then
              DoneThread; { Assume everything is idempotent there }
          end;
      end;

rtl/win/syswin.inc

@@ -400,7 +400,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 :

rtl/win32/sysinit.inc

@@ -16,6 +16,7 @@
 
    var
       SysInstance : Longint;external name '_FPC_SysInstance';
+      TlsKeyVar: DWord = $ffffffff;
 
       InitFinalTable : record end; external name 'INITFINAL';
       ThreadvarTablesTable : record end; external name 'FPC_THREADVARTABLES';
@@ -65,6 +66,7 @@
         valgrind_used : false;
         OS : (
           asm_exit : @asm_exit;
+          TlsKeyAddr : @TlsKeyVar;
           );
         );
 
@@ -78,6 +80,7 @@
         EntryInformation.ResStrInitTables:=@ResStrInitTables;
         EntryInformation.WideInitTables:=@WideInitTables;
         EntryInformation.OS.asm_exit:=@asm_exit;
+        EntryInformation.OS.TlsKeyAddr:=@TlsKeyVar;
         EntryInformation.PascalMain:=@PascalMain;}
         SysInitEntryInformation.valgrind_used:=valgrind_used;
       end;

rtl/win32/system.pp

@@ -113,6 +113,9 @@ implementation
 var
   SysInstance : Longint;public name '_FPC_SysInstance';
 
+{$define FPC_SYSTEM_HAS_OSSETUPENTRYINFORMATION}
+procedure OsSetupEntryInformation(const info: TEntryInformation); forward;
+
 {$ifdef FPC_USE_WIN32_SEH}
 function main_wrapper(arg: Pointer; proc: Pointer): ptrint; forward;
 procedure OutermostHandler; external name '__FPC_DEFAULT_HANDLER';
@@ -130,6 +133,10 @@ end;
 { include code common with win64 }
 {$I syswin.inc}
 
+procedure OsSetupEntryInformation(const info: TEntryInformation);
+begin
+  TlsKey := info.OS.TlsKeyAddr;
+end;
 
 {*****************************************************************************
                          System Dependent Exit code