+ add and use sysinit unit for Win64 (only one since we don't support cygwin and gprof there)

* switch Win64 to indirect entry information

git-svn-id: trunk@34307 -

.gitattributes

@@ -10016,6 +10016,7 @@ rtl/win64/classes.pp svneol=native#text/plain
 rtl/win64/rtldefs.inc svneol=native#text/plain
 rtl/win64/seh64.inc svneol=native#text/plain
 rtl/win64/signals.pp svneol=native#text/plain
+rtl/win64/sysinit.pp svneol=native#text/plain
 rtl/win64/system.pp svneol=native#text/plain
 rtl/win64/windows.pp svneol=native#text/plain
 rtl/wince/Makefile svneol=native#text/plain

compiler/systems.pas

@@ -320,12 +320,12 @@ interface
        systems_indirect_var_imports = systems_all_windows+[system_i386_nativent];
 
        { all systems that support indirect entry information }
-       systems_indirect_entry_information = systems_darwin+[system_i386_win32];
+       systems_indirect_entry_information = systems_darwin+[system_i386_win32,system_x86_64_win64];
 
        { all systems for which weak linking has been tested/is supported }
        systems_weak_linking = systems_darwin + systems_solaris + systems_linux + systems_android;
 
-       systems_internal_sysinit = [system_i386_linux,system_i386_win32,
+       systems_internal_sysinit = [system_i386_linux,system_i386_win32,system_x86_64_win64,
                                    system_powerpc64_linux]+systems_darwin;
 
        { all systems that use garbage collection for reference-counted types }

compiler/systems/t_win.pas

@@ -134,20 +134,25 @@ implementation
       hp           : tmodule;
       linkcygwin : boolean;
     begin
-      hp:=tmodule(loaded_units.first);
+      if target_info.system=system_i386_win32 then
-      while assigned(hp) do
+        begin
-       begin
+          hp:=tmodule(loaded_units.first);
-         linkcygwin := hp.linkothersharedlibs.find('cygwin') or hp.linkotherstaticlibs.find('cygwin');
+          while assigned(hp) do
-         if linkcygwin then
+           begin
-           break;
+             linkcygwin := hp.linkothersharedlibs.find('cygwin') or hp.linkotherstaticlibs.find('cygwin');
-         hp:=tmodule(hp.next);
+             if linkcygwin then
-       end;
+               break;
-      if cs_profile in current_settings.moduleswitches then
+             hp:=tmodule(hp.next);
-        linker.sysinitunit:='sysinitgprof'
+           end;
-      else if linkcygwin or (Linker.SharedLibFiles.Find('cygwin')<>nil) or (Linker.StaticLibFiles.Find('cygwin')<>nil) then
+          if cs_profile in current_settings.moduleswitches then
-        linker.sysinitunit:='sysinitcyg'
+            linker.sysinitunit:='sysinitgprof'
-      else
+          else if linkcygwin or (Linker.SharedLibFiles.Find('cygwin')<>nil) or (Linker.StaticLibFiles.Find('cygwin')<>nil) then
-        linker.sysinitunit:='sysinitpas';
+            linker.sysinitunit:='sysinitcyg'
+          else
+            linker.sysinitunit:='sysinitpas';
+        end
+      else if target_info.system=system_x86_64_win64 then
+        linker.sysinitunit:='sysinit';
     end;
 
 
@@ -1083,8 +1088,7 @@ implementation
 
     procedure TInternalLinkerWin.InitSysInitUnitName;
       begin
-        if target_info.system=system_i386_win32 then
+        GlobalInitSysInitUnitName(self)
-          GlobalInitSysInitUnitName(self);
       end;
 
     procedure TInternalLinkerWin.ConcatEntryName;
@@ -1767,8 +1771,7 @@ implementation
 
     procedure TExternalLinkerWin.InitSysInitUnitName;
       begin
-        if target_info.system=system_i386_win32 then
+        GlobalInitSysInitUnitName(self);
-          GlobalInitSysInitUnitName(self);
       end;
 
 

rtl/win/sysosh.inc

@@ -49,15 +49,17 @@ type
   end;
 {$endif WINCE}
 
-{$ifdef Win32}
+{$if defined(WIN32) or defined(WIN64)}
   {$define HAS_ENTRYINFORMATION_OS}
   TEntryInformationOS = record
+    {$ifdef WIN32}
     asm_exit : Procedure;stdcall;
+    {$endif WIN32}
     TlsKeyAddr : PDWord;
-    SysInstance: PLongInt;
+    SysInstance: {$ifdef CPU64}PQWord{$else}PLongInt{$endif};
     WideInitTables : Pointer;
   end;
-{$endif Win32}
+{$endif WIN32 or WIN64}
 
 const
 {$ifdef WINCE}

rtl/win64/Makefile.fpc

@@ -8,7 +8,7 @@ main=rtl
 [target]
 loaders=$(LOADERS)
 units=system uuchar objpas macpas iso7185 buildrtl cpall lineinfo lnfodwrf
-implicitunits=ctypes strings \
+implicitunits=sysinit ctypes strings \
       extpas \
       heaptrc \
       dos messages \

rtl/win64/buildrtl.pp

@@ -3,6 +3,7 @@ unit buildrtl;
   interface
 
     uses
+      sysinit,
       extpas,
       ctypes, strings,
       heaptrc, 

rtl/win64/sysinit.pp

@@ -0,0 +1,142 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2006 by Florian Klaempfl and Pavel Ozerski
+    member of the Free Pascal development team.
+
+    Win32 pascal only startup code
+
+    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.
+
+ **********************************************************************}
+unit sysinit;
+
+  interface
+
+  implementation
+
+   var
+      SysInstance : LongInt;
+      TlsKeyVar: DWord = $ffffffff;
+
+      InitFinalTable : record end; external name 'INITFINAL';
+      ThreadvarTablesTable : record end; external name 'FPC_THREADVARTABLES';
+      WideInitTables : record end; external name 'FPC_WIDEINITTABLES';
+{$ifdef FPC_HAS_RESSTRINITS}
+      ResStrInitTables : record end; external name 'FPC_RESSTRINITTABLES';
+{$endif FPC_HAS_RESSTRINITS}
+      ResourceStringTables : record end; external name 'FPC_RESOURCESTRINGTABLES';
+      valgrind_used : boolean;external name '__fpc_valgrind';
+
+{$if defined(FPC_USE_TLS_DIRECTORY) or defined(FPC_SECTION_THREADVARS)}
+   var
+      tlsdir: record end; external name '__tls_used';
+
+    procedure LinkIn(p1,p2,p3: Pointer); inline;
+      begin
+      end;
+{$endif}
+
+{$ifdef FPC_USE_TLS_DIRECTORY}
+    var
+      tls_callback_end: pointer; external name '__FPC_end_of_tls_callbacks';
+      tls_callback: pointer; external name '__FPC_tls_callbacks';
+{$endif FPC_USE_TLS_DIRECTORY}
+
+    procedure EXE_Entry(constref info : TEntryInformation); external name '_FPC_EXE_Entry';
+    function DLL_Entry(constref info : TEntryInformation) : longbool; external name '_FPC_DLL_Entry';
+    procedure PascalMain;external name 'PASCALMAIN';
+
+    function GetStdHandle(nStdHandle:DWORD) : THandle; stdcall; external 'kernel32' name 'GetStdHandle';
+    function GetConsoleMode(hConsoleHandle: THandle; var lpMode: DWORD): Boolean; stdcall; external 'kernel32' name 'GetConsoleMode';
+
+    const
+      STD_INPUT_HANDLE = qword(-10);
+      SysInitEntryInformation : TEntryInformation = (
+        InitFinalTable : @InitFinalTable;
+        ThreadvarTablesTable : @ThreadvarTablesTable;
+        ResourceStringTables : @ResourceStringTables;
+{$ifdef FPC_HAS_RESSTRINITS}
+        ResStrInitTables : @ResStrInitTables;
+{$else FPC_HAS_RESSTRINITS}
+        ResStrInitTables : nil;
+{$endif FPC_HAS_RESSTRINITS}
+        ResLocation : nil;
+        PascalMain : @PascalMain;
+        valgrind_used : false;
+        OS : (
+          TlsKeyAddr : @TlsKeyVar;
+          SysInstance : @SysInstance;
+          WideInitTables: @WideInitTables;
+          );
+        );
+
+
+    procedure SetupEntryInformation;
+      begin
+        { valgind_used is the only thng that can change at startup
+        EntryInformation.InitFinalTable:=@InitFinalTable;
+        EntryInformation.ThreadvarTablesTable:=@ThreadvarTablesTable;
+        EntryInformation.ResourceStringTables:=@ResourceStringTables;
+        EntryInformation.ResStrInitTables:=@ResStrInitTables;
+        EntryInformation.OS.asm_exit:=@asm_exit;
+        EntryInformation.OS.TlsKeyAddr:=@TlsKeyVar;
+        EntryInformation.OS.SysInstance:=@SysInstance;
+        EntryInformation.OS.WideInitTables:=@WideInitTables;
+        EntryInformation.PascalMain:=@PascalMain;}
+        SysInitEntryInformation.valgrind_used:=valgrind_used;
+      end;
+
+{$define FPC_INSSIDE_SYSINIT}
+{$include systlsdir.inc}
+
+    procedure _FPC_mainCRTStartup;stdcall;public name '_mainCRTStartup';
+    begin
+      IsConsole:=true;
+      { do it like it is necessary for the startup code linking against cygwin }
+      GetConsoleMode(GetStdHandle((Std_Input_Handle)),StartupConsoleMode);
+{$ifdef FPC_USE_TLS_DIRECTORY}
+      LinkIn(@tlsdir,@tls_callback_end,@tls_callback);
+{$endif}
+      SetupEntryInformation;
+      Exe_entry(SysInitEntryInformation);
+    end;
+
+
+    procedure _FPC_WinMainCRTStartup;stdcall;public name '_WinMainCRTStartup';
+    begin
+      IsConsole:=false;
+{$ifdef FPC_USE_TLS_DIRECTORY}
+      LinkIn(@tlsdir,@tls_callback_end,@tls_callback);
+{$endif}
+      SetupEntryInformation;
+      Exe_entry(SysInitEntryInformation);
+    end;
+
+
+    procedure _FPC_DLLMainCRTStartup(_hinstance : qword;_dllreason : dword;_dllparam:Pointer);stdcall;public name '_DLLMainCRTStartup';
+    begin
+      IsConsole:=true;
+      sysinstance:=_hinstance;
+      dllreason:=_dllreason;
+      dllparam:=PtrInt(_dllparam);
+      SetupEntryInformation;
+      DLL_Entry(SysInitEntryInformation);
+    end;
+
+
+    procedure _FPC_DLLWinMainCRTStartup(_hinstance : qword;_dllreason : dword;_dllparam:Pointer);stdcall;public name '_DLLWinMainCRTStartup';
+    begin
+      IsConsole:=false;
+      sysinstance:=_hinstance;
+      dllreason:=_dllreason;
+      dllparam:=PtrInt(_dllparam);
+      SetupEntryInformation;
+      DLL_Entry(SysInitEntryInformation);
+    end;
+
+end.

rtl/win64/system.pp

@@ -106,8 +106,15 @@ implementation
 {$asmmode att}
 
 var
+{$ifdef VER3_0}
   SysInstance : qword;
   FPCSysInstance: PQWord = @SysInstance; public name '_FPC_SysInstance';
+{$else VER3_0}
+  FPCSysInstance : PQWord;public name '_FPC_SysInstance';
+{$endif VER3_0}
+
+{$define FPC_SYSTEM_HAS_OSSETUPENTRYINFORMATION}
+procedure OsSetupEntryInformation(constref info: TEntryInformation); forward;
 
 {$ifdef FPC_USE_WIN64_SEH}
 function main_wrapper(arg: Pointer; proc: Pointer): ptrint; assembler; nostackframe;
@@ -143,8 +150,17 @@ procedure PascalMain;external name 'PASCALMAIN';
 { include code common with win32 }
 {$I syswin.inc}
 
+{$ifdef VER3_0}
 { TLS directory code }
 {$I systlsdir.inc}
+{$endif VER3_0}
+
+procedure OsSetupEntryInformation(constref info: TEntryInformation);
+begin
+  TlsKey := info.OS.TlsKeyAddr;
+  FPCSysInstance := info.OS.SysInstance;
+  WStrInitTablesTable := info.OS.WideInitTables;
+end;
 
 Procedure system_exit;
 begin
@@ -183,9 +199,15 @@ var
   _SS : Cardinal;
 
 
-
+{$ifdef VER3_0}
 procedure Exe_entry;[public,alias:'_FPC_EXE_Entry'];
+{$else VER3_0}
+procedure Exe_entry(constref info: TEntryInformation);[public,alias:'_FPC_EXE_Entry'];
+{$endif VER3_0}
   begin
+{$ifndef VER3_0}
+     SetupEntryInformation(info);
+{$endif VER3_0}
      IsLibrary:=false;
      { install the handlers for exe only ?
        or should we install them for DLL also ? (PM) }
@@ -199,6 +221,7 @@ procedure Exe_entry;[public,alias:'_FPC_EXE_Entry'];
         movl %eax,_SS(%rip)
         movq %rbp,%rsi
         xorq %rbp,%rbp
+{$ifdef VER3_0}
 {$ifdef FPC_USE_WIN64_SEH}
         xor  %rcx,%rcx
         lea  PASCALMAIN(%rip),%rdx
@@ -206,6 +229,17 @@ procedure Exe_entry;[public,alias:'_FPC_EXE_Entry'];
 {$else FPC_USE_WIN64_SEH}
         call PASCALMAIN
 {$endif FPC_USE_WIN64_SEH}
+{$else VER3_0}
+{$ifdef FPC_USE_WIN64_SEH}
+        xor  %rcx,%rcx
+        lea  EntryInformation(%rip),%rdx
+        movq TEntryInformation.PascalMain(%rdx),%rdx
+        call main_wrapper
+{$else FPC_USE_WIN64_SEH}
+        lea  EntryInformation(%rip),%rdx
+        call TEntryInformation.PascalMain(%rdx)
+{$endif FPC_USE_WIN64_SEH}
+{$endif VER3_0}
         movq %rsi,%rbp
      end ['RSI','RBP'];     { <-- specifying RSI allows compiler to save/restore it properly }
      { if we pass here there was no error ! }
@@ -213,6 +247,7 @@ procedure Exe_entry;[public,alias:'_FPC_EXE_Entry'];
   end;
 
 
+{$ifdef VER3_0}
 procedure _FPC_DLLMainCRTStartup(_hinstance : qword;_dllreason : dword;_dllparam:Pointer);stdcall;public name '_DLLMainCRTStartup';
 begin
   IsConsole:=true;
@@ -231,6 +266,7 @@ begin
   dllparam:=PtrInt(_dllparam);
   DLL_Entry;
 end;
+{$endif VER3_0}
 
 function is_prefetch(p : pointer) : boolean;
   var
@@ -457,7 +493,7 @@ procedure install_exception_handlers;
   end;
 {$endif ndef FPC_USE_WIN64_SEH}
 
-
+{$ifdef VER3_0}
 procedure LinkIn(p1,p2,p3: Pointer); inline;
 begin
 end;
@@ -481,6 +517,7 @@ begin
 {$endif FPC_USE_TLS_DIRECTORY}
   Exe_entry;
 end;
+{$endif VER3_0}
 
 {$ifdef FPC_SECTION_THREADVARS}
 function fpc_tls_add(addr: pointer): pointer; assembler; nostackframe;