+ Move EXEC_callback into separate file win/systlsdir.inc

* In win32/sysinitXX units, rename EntryInforation
    to SysInitEntryInformation.
    include new win/systlsdir.inc file from
    win/syswin.inc for win64 target
    and from win32/sysinit.inc for win32 target.
    Set fields of both SysInitEntryInformation and EntryInformation
    by converting them into typed constants.

git-svn-id: trunk@19779 -

.gitattributes

@@ -8162,6 +8162,7 @@ rtl/win/sysheap.inc svneol=native#text/plain
 rtl/win/sysos.inc svneol=native#text/plain
 rtl/win/sysosh.inc svneol=native#text/plain
 rtl/win/systhrd.inc svneol=native#text/plain
+rtl/win/systlsdir.inc svneol=native#text/plain
 rtl/win/sysutils.pp svneol=native#text/plain
 rtl/win/syswin.inc svneol=native#text/plain
 rtl/win/tthread.inc svneol=native#text/plain

rtl/inc/thread.inc

@@ -603,7 +603,7 @@ begin
   SetThreadManager(NoThreadManager);
 end;
 
-Procedure InitSystemThreads;
+Procedure InitSystemThreads; public name '_FPC_InitSystemThreads';
 begin
   { This should be changed to a real value during
     thread driver initialization if appropriate. }

rtl/win/systhrd.inc

@@ -95,7 +95,8 @@ var
       threadvarblocksize : dword = 0;
 
     const
-      TLSKey : DWord = $ffffffff;
+      TLSKey : DWord = $ffffffff; public name '_FPC_TlsKey';
+
     var
       MainThreadIdWin32 : DWORD;
 
@@ -110,7 +111,7 @@ var
       end;
 
 
-    procedure SysAllocateThreadVars;
+    procedure SysAllocateThreadVars; public name '_FPC_SysAllocateThreadVars';
       var
         dataindex : pointer;
         errorsave : dword;
@@ -482,7 +483,7 @@ end;
 Var
   WinThreadManager : TThreadManager;
 
-Procedure InitSystemThreads;
+Procedure InitSystemThreads;public name '_FPC_InitSystemThreads';
 {$IFDEF SUPPORT_WIN95}
 var
   KernelHandle : THandle;

rtl/win/systlsdir.inc

@@ -0,0 +1,148 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2008 by Florian Klaempfl and Pavel Ozerski
+    member of the Free Pascal development team.
+
+    FPC Pascal system unit part shared by win32/win64.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ TLS Directory code }
+
+{$ifdef FPC_USE_TLS_DIRECTORY}
+{ Process TLS callback function }
+{ This is only useful for executables
+  for DLLs, DLL_Entry gets called. PM }
+{ The consts are the same as for DDL_Entry,
+  but as this file can be either in system unit or sysinitXXX
+  we need to rename them with EXEC prefix
+  to avoid duplicate entries. }
+Const
+   EXEC_PROCESS_ATTACH = 1;
+   EXEC_THREAD_ATTACH = 2;
+   EXEC_PROCESS_DETACH = 0;
+   EXEC_THREAD_DETACH = 3;
+{$ifdef FPC_INSSIDE_SYSINIT}
+var
+   TlsKey : dword; external name '_FPC_TlsKey';
+
+type
+  TTlsDirectory=packed record
+    data_start, data_end : pointer;
+    index_pointer, callbacks_pointer : pointer;
+    zero_fill_size : dword;
+    flags : dword;
+  end;
+
+
+function TlsGetValue(dwTlsIndex : DWord) : pointer; stdcall;
+  external 'kernel32' name 'TlsGetValue';
+
+procedure InitSystemThreads; external name '_FPC_InitSystemThreads';
+procedure SysAllocateThreadVars; external name '_FPC_SysAllocateThreadVars';
+{$endif FPC_INSSIDE_SYSINIT}
+
+procedure Exec_Tls_callback(Handle : pointer; reason : Dword; Reserved : pointer);
+  stdcall; [public,alias:'_FPC_Tls_Callback'];
+  begin
+     if IsLibrary then
+       Exit;
+     case reason of
+       { For executables, EXEC_PROCESS_ATTACH is called *before* the entry point,
+         and EXEC_PROCESS_DETACH is called *after* RTL shuts down and calls ExitProcess.
+         It isn't a good idea to handle resources of the main thread at these points.
+         InitSystemThreads is necessary however, because if some statically loaded
+         DLL creates a thread, it will invoke EXEC_THREAD_ATTACH before anything else is
+         initialized.
+         TODO: The problem is that InitSystemThreads depends (in case of Win32)
+         on EntryInformation which is not available at this point.
+         Solving it properly needs to move this routine
+         to sysinit unit or something like that.
+         Exec_Tls_Callback is now part of sysinit unit for win32
+         and the EntryInformation is a constant which sholud prevent troubles }
+       EXEC_PROCESS_ATTACH:
+         InitSystemThreads;
+
+       EXEC_THREAD_ATTACH :
+         begin
+         {  !!! SysInitMultithreading must NOT be called here. Windows guarantees that
+            the main thread invokes PROCESS_ATTACH, not THREAD_ATTACH. So this always
+            executes in non-main thread. SysInitMultithreading() here will cause
+            initial threadvars to be copied to TLS of non-main thread, and threadvars
+            of the main thread will be reinitialized upon the next access with zeroes,
+            ending up in a delayed failure which is very hard to debug.
+            Fortunately this nasty scenario can happen only when the first non-main thread
+            was created outside of RTL (Sergei).
+         }
+           { 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;
+       EXEC_THREAD_DETACH :
+         begin
+           if TlsGetValue(TLSKey)<>nil then
+             DoneThread; { Assume everything is idempotent there }
+         end;
+     end;
+  end;
+
+
+{ Mingw tlssup.c source code has
+  _CRTALLOC(".CRT$XLA") PIMAGE_TLS_CALLBACK __xl_a = 0;
+  _CRTALLOC(".CRT$XLZ") PIMAGE_TLS_CALLBACK __xl_z = 0;
+  and the callback pointer is set to:
+  (&__xl_a+1), (+1 meaning =+sizeof(pointer))
+  I am not sure this can be compatible with
+}
+
+const
+  FreePascal_TLS_callback : pointer = @Exec_Tls_callback;
+    public name '__FPC_tls_callbacks' section '.CRT$XLFPC';
+  FreePascal_end_of_TLS_callback : pointer = nil;
+    public name '__FPC_end_of_tls_callbacks' section '.CRT$XLZZZ';
+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__';
+
+  _tls_index : dword; cvar; external;
+
+const
+  _tls_used : TTlsDirectory = (
+    data_start : @tls_data_start;
+    data_end : @tls_data_end;
+    index_pointer : @_tls_index;
+    callbacks_pointer : @tls_callbacks;
+    zero_fill_size : 0;
+    flags : 0;
+  ); cvar; public;
+
+{$ifdef win64}
+  { This is a hack to support external linking.
+    All released win64 versions of GNU binutils miss proper prefix handling
+    when searching for _tls_used and expect two leading underscores.
+    The issue has been fixed in binutils snapshots, but not released yet.
+
+    TODO: This should be removed as soon as next version of binutils (>2.21) is
+    released and we upgrade to it. }
+    __tls_used : TTlsDirectory = (
+      data_start : @tls_data_start;
+      data_end : @tls_data_end;
+      index_pointer : @_tls_index;
+      callbacks_pointer : @tls_callbacks;
+      zero_fill_size : 0;
+      flags : 0;
+    ); cvar; public;
+{$endif win64}
+{$endif FPC_USE_TLS_DIRECTORY}
+

rtl/win/syswin.inc

@@ -327,104 +327,9 @@ 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 }
-
-procedure Exec_Tls_callback(Handle : pointer; reason : Dword; Reserved : pointer);
-  stdcall; [public,alias:'_FPC_Tls_Callback'];
-  begin
-     if IsLibrary then
-       Exit;
-     case reason of
-       { For executables, DLL_PROCESS_ATTACH is called *before* the entry point,
-         and DLL_PROCESS_DETACH is called *after* RTL shuts down and calls ExitProcess.
-         It isn't a good idea to handle resources of the main thread at these points.
-         InitSystemThreads is necessary however, because if some statically loaded
-         DLL creates a thread, it will invoke DLL_THREAD_ATTACH before anything else is
-         initialized.
-         TODO: The problem is that InitSystemThreads depends (in case of Win32) on EntryInformation
-         which is not available at this point. Solving it properly needs to move this routine
-         to sysinit unit or something like that. }
-//       DLL_PROCESS_ATTACH:
-//         InitSystemThreads;
-
-       DLL_THREAD_ATTACH :
-         begin
-         {  !!! SysInitMultithreading must NOT be called here. Windows guarantees that
-            the main thread invokes PROCESS_ATTACH, not THREAD_ATTACH. So this always
-            executes in non-main thread. SysInitMultithreading() here will cause
-            initial threadvars to be copied to TLS of non-main thread, and threadvars
-            of the main thread will be reinitialized upon the next access with zeroes,
-            ending up in a delayed failure which is very hard to debug.
-            Fortunately this nasty scenario can happen only when the first non-main thread
-            was created outside of RTL (Sergei).
-         }
-           { 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;
-       DLL_THREAD_DETACH :
-         begin
-           if TlsGetValue(TLSKey)<>nil then
-             DoneThread; { Assume everything is idempotent there }
-         end;
-     end;
-  end;
-
-
-{ Mingw tlssup.c source code has
-  _CRTALLOC(".CRT$XLA") PIMAGE_TLS_CALLBACK __xl_a = 0;
-  _CRTALLOC(".CRT$XLZ") PIMAGE_TLS_CALLBACK __xl_z = 0;
-  and the callback pointer is set to:
-  (&__xl_a+1), (+1 meaning =+sizeof(pointer))
-  I am not sure this can be compatible with
-}
-
-const
-  FreePascal_TLS_callback : pointer = @Exec_Tls_callback;
-    public name '__FPC_tls_callbacks' section '.CRT$XLFPC';
-  FreePascal_end_of_TLS_callback : pointer = nil;
-    public name '__FPC_end_of_tls_callbacks' section '.CRT$XLZZZ';
-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__';
-
-  _tls_index : dword; cvar; external;
-
-const
-  _tls_used : TTlsDirectory = (
-    data_start : @tls_data_start;
-    data_end : @tls_data_end;
-    index_pointer : @_tls_index;
-    callbacks_pointer : @tls_callbacks;
-    zero_fill_size : 0;
-    flags : 0;
-  ); cvar; public;
-
 {$ifdef win64}
-  { This is a hack to support external linking.
-    All released win64 versions of GNU binutils miss proper prefix handling
-    when searching for _tls_used and expect two leading underscores.
-    The issue has been fixed in binutils snapshots, but not released yet.
-
-    TODO: This should be removed as soon as next version of binutils (>2.21) is
-    released and we upgrade to it. }
-    __tls_used : TTlsDirectory = (
-      data_start : @tls_data_start;
-      data_end : @tls_data_end;
-      index_pointer : @_tls_index;
-      callbacks_pointer : @tls_callbacks;
-      zero_fill_size : 0;
-      flags : 0;
-    ); cvar; public;
+{$include systlsdir.inc}
 {$endif win64}
-{$endif FPC_USE_TLS_DIRECTORY}
 
 
 {****************************************************************************
@@ -681,7 +586,7 @@ var
 {$endif}
 
 function GetACP:UINT; stdcall; external 'kernel32' name 'GetACP';
-function GetConsoleCP:UINT; stdcall; external 'kernel32' name 'GetConsoleCP'; 
+function GetConsoleCP:UINT; stdcall; external 'kernel32' name 'GetConsoleCP';
 
 function Win32GetStandardCodePage(const stdcp: TStandardCodePageEnum): TSystemCodePage;
   begin

rtl/win32/sysinit.inc

@@ -13,10 +13,9 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
- 
+
    var
       SysInstance : Longint;external name '_FPC_SysInstance';
-      EntryInformation : TEntryInformation;
 
       InitFinalTable : record end; external name 'INITFINAL';
       ThreadvarTablesTable : record end; external name 'FPC_THREADVARTABLES';
@@ -46,12 +45,25 @@
 
     const
       STD_INPUT_HANDLE = dword(-10);
+      SysInitEntryInformation : TEntryInformation = (
+        InitFinalTable : @InitFinalTable;
+        ThreadvarTablesTable : @ThreadvarTablesTable;
+        asm_exit : @asm_exit;
+        PascalMain : @PascalMain;
+        valgrind_used : false;
+        );
+
 
     procedure SetupEntryInformation;
       begin
+        { valgind_used is the only thng that can change at startup
         EntryInformation.InitFinalTable:=@InitFinalTable;
         EntryInformation.ThreadvarTablesTable:=@ThreadvarTablesTable;
         EntryInformation.asm_exit:=@asm_exit;
-        EntryInformation.PascalMain:=@PascalMain;
-        EntryInformation.valgrind_used:=valgrind_used;
+        EntryInformation.PascalMain:=@PascalMain;}
+        SysInitEntryInformation.valgrind_used:=valgrind_used;
       end;
+
+{$define FPC_INSSIDE_SYSINIT}
+{$include systlsdir.inc}
+

rtl/win32/sysinitcyg.pp

@@ -41,7 +41,7 @@ unit sysinitcyg;
 {$ifdef FPC_USE_TLS_DIRECTORY}
         LinkIn(@tlsdir,@tls_callback_end,@tls_callback);
 {$endif}
-        EXE_Entry(EntryInformation);
+        EXE_Entry(SysInitEntryInformation);
       end;
 
 
@@ -53,7 +53,7 @@ unit sysinitcyg;
         end;
         __main;
         SetupEntryInformation;
-        DLL_Entry(EntryInformation);
+        DLL_Entry(SysInitEntryInformation);
       end;
 
 

rtl/win32/sysinitgprof.pp

@@ -75,7 +75,7 @@ unit sysinitgprof;
 {$ifdef FPC_USE_TLS_DIRECTORY}
         LinkIn(@tlsdir,@tls_callback_end,@tls_callback);
 {$endif}
-        EXE_Entry(EntryInformation);
+        EXE_Entry(SysInitEntryInformation);
       end;
 
 
@@ -88,7 +88,7 @@ unit sysinitgprof;
         DLLgmon_start;
         __main;
         SetupEntryInformation;
-        DLL_Entry(EntryInformation);
+        DLL_Entry(SysInitEntryInformation);
       end;
 
 

rtl/win32/sysinitpas.pp

@@ -35,7 +35,7 @@ unit sysinitpas;
       LinkIn(@tlsdir,@tls_callback_end,@tls_callback);
 {$endif}
       SetupEntryInformation;
-      Exe_entry(EntryInformation);
+      Exe_entry(SysInitEntryInformation);
     end;
 
 
@@ -46,7 +46,7 @@ unit sysinitpas;
       LinkIn(@tlsdir,@tls_callback_end,@tls_callback);
 {$endif}
       SetupEntryInformation;
-      Exe_entry(EntryInformation);
+      Exe_entry(SysInitEntryInformation);
     end;
 
 
@@ -57,7 +57,7 @@ unit sysinitpas;
       dllreason:=_dllreason;
       dllparam:=_dllparam;
       SetupEntryInformation;
-      DLL_Entry(EntryInformation);
+      DLL_Entry(SysInitEntryInformation);
     end;
 
 
@@ -68,7 +68,7 @@ unit sysinitpas;
       dllreason:=_dllreason;
       dllparam:=_dllparam;
       SetupEntryInformation;
-      DLL_Entry(EntryInformation);
+      DLL_Entry(SysInitEntryInformation);
     end;
 
 end.

rtl/win32/system.pp

@@ -123,8 +123,19 @@ Const
 implementation
 
 var
-  EntryInformation : TEntryInformation;
   SysInstance : Longint;public name '_FPC_SysInstance';
+  InitFinalTable : record end; external name 'INITFINAL';
+  ThreadvarTablesTable : record end; external name 'FPC_THREADVARTABLES';
+  procedure PascalMain;stdcall;external name 'PASCALMAIN';
+  procedure asm_exit;stdcall;external name 'asm_exit';
+const
+  EntryInformation : TEntryInformation = (
+    InitFinalTable : @InitFinalTable;
+    ThreadvarTablesTable : @ThreadvarTablesTable;
+    asm_exit : @asm_exit;
+    PascalMain : @PascalMain;
+    valgrind_used : false;
+    );
 
 { include system independent routines }
 {$I system.inc}
@@ -142,7 +153,6 @@ procedure PascalMain;stdcall;external name 'PASCALMAIN';
 {$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
 procedure fpc_do_exit;stdcall;external name 'FPC_DO_EXIT';
 Procedure ExitDLL(Exitcode : longint); forward;
-procedure asm_exit;stdcall;external name 'asm_exit';
 
 Procedure system_exit;
 begin
@@ -653,7 +663,12 @@ function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
 	     DataDirectory : array[1..$80] of byte;
 	  end;
 	begin
-	  result:=tpeheader((pointer(SysInstance)+(tdosheader(pointer(SysInstance)^).e_lfanew))^).SizeOfStackReserve;
+          if (SysInstance=0) and not IsLibrary then
+            SysInstance:=getmodulehandle(nil);
+          if (SysInstance=0) then
+            result:=stklen
+          else
+            result:=tpeheader((pointer(SysInstance)+(tdosheader(pointer(SysInstance)^).e_lfanew))^).SizeOfStackReserve;
 	end;