* win/sysos.inc: TTlsDirectory, new record type

    Used to support TlsCallbacks.

    Tls callback code added inside
    ifdef FPC_USE_TLS_DIRECTORY.
    NOTE: This code needs compiler changes also to work.

  * win/systhread.inc:
    Exec_Tls_callback: Callback for main executable.
    Several new external variables:
    FreePascal_TLS_callback, FreePascal_end_of_TLS_callback
    need to be placed into .CRT$XL* section,
    using  name '.section .CRT$XLFPC __FPC_tls_callbacks'
    extension to be provided by compiler change.
    tls_callbacks : pointer; external name '___crt_xl_start__';
    tls_data_start : pointer; external name '___tls_start__';
    tls_data_end : pointer; external name '___tls_end__';
    provided by linker script.
    tls_index : DWord that will contain the automatic
    TlsIndex generated by executable launch code (not used by
    FPC code, but might be used by code from loaded objects).
    _tls_used: TTlsdirectory record.

  * win32/system.pp and win64/system.pp:
    Code to force loading of _tls_used record.

git-svn-id: trunk@17893 -

rtl/win/sysos.inc

@@ -165,6 +165,13 @@ type
     wMilliseconds: Word;
   end;
 
+  TTlsDirectory=packed record
+    data_start, data_end : pointer;
+    index_pointer, callbacks_pointer : pointer;
+    zero_fill_size : dword;
+    flags : dword;
+  end;
+
 threadvar
   errno : longint;
 

rtl/win/syswin.inc

@@ -100,6 +100,94 @@ Procedure ExitDLL(Exitcode : longint);
     LongJmp(DLLBuf,1);
   end;
 
+{$ifdef FPC_USE_TLS_DIRECTORY}
+{ Process TLS callback function }
+{ This is only useful for executables
+  for DLLs, DLL_Entry gets called. PM }
+const
+   Thread_count : longint = 0;
+
+procedure Exec_Tls_callback(Handle : pointer; reason : Dword; Reserved : pointer);
+  stdcall; [public,alias:'_FPC_Tls_Callback'];
+  begin
+     if IsLibrary then
+       Exit;
+     case reason of
+       DLL_PROCESS_ATTACH :
+         begin
+           MainThreadIdWin32 := Win32GetCurrentThreadId;
+         end;
+       DLL_THREAD_ATTACH :
+         begin
+           inclocked(Thread_count);
+           if Win32GetCurrentThreadId <> MainThreadIdWin32 then
+           begin
+             { Initialize multithreading if not done }
+             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... }
+           end;
+
+           if assigned(Dll_Thread_Attach_Hook) then
+             Dll_Thread_Attach_Hook(DllParam);
+        end;
+       DLL_THREAD_DETACH :
+         begin
+           declocked(Thread_count);
+           if assigned(Dll_Thread_Detach_Hook) then
+             Dll_Thread_Detach_Hook(DllParam);
+           { Release Threadvars }
+           if Win32GetCurrentThreadId<>MainThreadIdWin32 then
+             DoneThread; { Assume everything is idempotent there }
+         end;
+       DLL_PROCESS_DETACH :
+         begin
+	   if MainThreadIDWin32=0 then // already been here.
+             exit;
+           If SetJmp(DLLBuf) = 0 then
+             FPC_Do_Exit;
+           if assigned(Dll_Process_Detach_Hook) then
+             Dll_Process_Detach_Hook(DllParam);
+
+           DoneThread;
+           { Free TLS resources used by ThreadVars }
+           SysFiniMultiThreading;
+           MainThreadIDWin32:=0;
+         end;
+     end;
+  end;
+
+const
+  FreePascal_TLS_callback : pointer = @Exec_Tls_callback;
+    public name '.section .CRT$XLFPC __FPC_tls_callbacks';
+  FreePascal_end_of_TLS_callback : pointer = nil;
+    public name '.section .CRT$XLZZZ __FPC_end_of_tls_callbacks';
+var
+  tls_callbacks : pointer; external name '___crt_xl_start__';
+  tls_data_start : pointer; external name '___tls_start__';
+  tls_data_end : pointer; external name '___tls_end__';
+{$ifdef win32}
+  tls_index : dword; external name '__tls_index';
+{$else not win32}
+  tls_index : dword; external name '_tls_index';
+{$endif not win32}
+
+const
+  _tls_used : TTlsDirectory = (
+    data_start : @tls_data_start;
+    data_end : @tls_data_end;
+    index_pointer : nil;
+    callbacks_pointer : @tls_callbacks;
+    zero_fill_size : 0;
+    flags : 0;
+  ); public name '__tls_used';
+{$endif FPC_USE_TLS_DIRECTORY}
+
+
 {****************************************************************************
                     Error Message writing using messageboxes
 ****************************************************************************}

rtl/win32/system.pp

@@ -992,5 +992,11 @@ begin
 {$endif VER2_2}
   InitWin32Widestrings;
   DispCallByIDProc:=@DoDispCallByIDError;
+{$ifdef FPC_USE_TLS_DIRECTORY}
+  { This code is only here to force
+    incorporation of _tls_used record in executable
+    when smartlinking is on }
+  _tls_used.Index_pointer:=@tls_index;
+{$endif FPC_USE_TLS_DIRECTORY}
 end.
 

rtl/win64/system.pp

@@ -983,4 +983,10 @@ begin
 {$endif VER2_2}
   InitWin32Widestrings;
   DispCallByIDProc:=@DoDispCallByIDError;
+{$ifdef FPC_USE_TLS_DIRECTORY}
+  { This code is only here to force
+    incorporation of _tls_used record in executable
+    when smartlinking is on }
+  _tls_used.Index_pointer:=@tls_index;
+{$endif FPC_USE_TLS_DIRECTORY}
 end.