* win32 system unit doesn't depend anymore directly on the main program, this is necessary to be able to keep it in a dll

git-svn-id: trunk@9052 -

rtl/i386/fastmove.inc

@@ -864,15 +864,21 @@ end;
 
 {$asmmode att}
 {$ifdef FPC_HAS_VALGRINDBOOL}
+{$ifndef FPC_HAS_INDIRECT_MAIN_INFORMATION}
 var
   valgrind_used : boolean;external name '__fpc_valgrind';
+{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
 {$endif FPC_HAS_VALGRINDBOOL}
 
 procedure setup_fastmove;{$ifdef SYSTEMINLINE}inline;{$endif}
   begin
 {$ifdef FPC_HAS_VALGRINDBOOL}
     { workaround valgrind bug }
+{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}
+    if EntryInformation.valgrind_used then
+{$else FPC_HAS_INDIRECT_MAIN_INFORMATION}
     if valgrind_used then
+{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
       begin
         fastmoveproc_forward:=@Forwards_Valgrind;
         fastmoveproc_backward:=@Backwards_Valgrind;

rtl/inc/system.inc

@@ -700,14 +700,19 @@ type
     InitProc,
     FinalProc : TProcedure;
   end;
-  TInitFinalTable=record
+  TInitFinalTable = record
     TableCount,
     InitCount  : longint;
     Procs      : array[1..maxunits] of TInitFinalRec;
   end;
+  PInitFinalTable = ^TInitFinalTable;
 
+
+{$ifndef FPC_HAS_INDIRECT_MAIN_INFORMATION}
 var
   InitFinalTable : TInitFinalTable;external name 'INITFINAL';
+{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
+
 
 procedure fpc_InitializeUnits;[public,alias:'FPC_INITIALIZEUNITS']; compilerproc;
 var
@@ -715,7 +720,9 @@ var
 begin
   { call cpu/fpu initialisation routine }
   fpc_cpuinit;
-  with InitFinalTable do
+  with {$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}PInitFinalTable(EntryInformation.{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
+    InitFinalTable
+    {$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION})^{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION} do
    begin
      for i:=1 to TableCount do
       begin
@@ -731,7 +738,9 @@ end;
 
 procedure FinalizeUnits;[public,alias:'FPC_FINALIZEUNITS'];
 begin
-  with InitFinalTable do
+  with {$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}PInitFinalTable(EntryInformation.{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
+    InitFinalTable
+    {$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION})^{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION} do
    begin
      while (InitCount>0) do
       begin

rtl/inc/systemh.inc

@@ -293,6 +293,15 @@ Type
 { platform dependent types }
 {$i sysosh.inc}
 
+type
+  TEntryInformation = record
+    InitFinalTable : Pointer;
+    ThreadvarTablesTable : Pointer;
+    asm_exit : Procedure;stdcall;
+    PascalMain : Procedure;stdcall;
+    valgrind_used : boolean;
+  end;
+
 
 const
 { Maximum value of the biggest signed and unsigned integer type available}

rtl/inc/threadvr.inc

@@ -31,9 +31,12 @@ type
     count  : dword;
     tables : packed array [1..32767] of pltvInitEntry;
   end;
+  PltvInitTablesTable = ^TltvInitTablesTable;
 
+{$ifndef FPC_HAS_INDIRECT_MAIN_INFORMATION}
 var
   ThreadvarTablesTable : TltvInitTablesTable; external name 'FPC_THREADVARTABLES';
+{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
 
 procedure init_unit_threadvars (tableEntry : pltvInitEntry);
 begin
@@ -50,10 +53,14 @@ var
   i : integer;
 begin
 {$ifdef DEBUG_MT}
-  WriteLn ('init_all_unit_threadvars (',ThreadvarTablesTable.count,') units');
+  WriteLn ('init_all_unit_threadvars (',
+    {$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}PltvInitTablesTable(EntryInformation.{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
+      ThreadvarTablesTable{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION})^{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}.count,') units');
 {$endif}
-  for i := 1 to ThreadvarTablesTable.count do
-    init_unit_threadvars (ThreadvarTablesTable.tables[i]);
+  for i := 1 to {$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}PltvInitTablesTable(EntryInformation.{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
+    ThreadvarTablesTable{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION})^{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}.count do
+    init_unit_threadvars ({$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}PltvInitTablesTable(EntryInformation.{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
+      ThreadvarTablesTable{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION})^{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}.tables[i]);
 end;
 
 
@@ -77,10 +84,13 @@ var
   i : integer;
 begin
 {$ifdef DEBUG_MT}
-  WriteLn ('copy_all_unit_threadvars (',ThreadvarTablesTable.count,') units');
+  WriteLn ('copy_all_unit_threadvars (',{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}PltvInitTablesTable(EntryInformation.{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
+    ThreadvarTablesTable{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION})^{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}.count,') units');
 {$endif}
-  for i := 1 to ThreadvarTablesTable.count do
-    copy_unit_threadvars (ThreadvarTablesTable.tables[i]);
+  for i := 1 to {$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}PltvInitTablesTable(EntryInformation.{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
+    ThreadvarTablesTable{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION})^{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}.count do
+    copy_unit_threadvars ({$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}PltvInitTablesTable(EntryInformation.{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
+      ThreadvarTablesTable{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION})^{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}.tables[i]);
 end;
 
 procedure InitThreadVars(RelocProc : Pointer);

rtl/win32/sysinitcyg.pp

@@ -21,6 +21,11 @@ unit sysinitcyg;
 
     var
       SysInstance : Longint;external name '_FPC_SysInstance';
+      EntryInformation : TEntryInformation;
+
+      InitFinalTable : record end; external name 'INITFINAL';
+      ThreadvarTablesTable : record end; external name 'FPC_THREADVARTABLES';
+      valgrind_used : boolean;external name '__fpc_valgrind';
 
     procedure EXE_Entry; external name '_FPC_EXE_Entry';
     function DLL_Entry : longbool; external name '_FPC_DLL_Entry';
@@ -34,6 +39,24 @@ unit sysinitcyg;
     function GetStdHandle(nStdHandle:DWORD) : THandle; stdcall; external 'kernel32' name 'GetStdHandle';
     function GetConsoleMode(hConsoleHandle: THandle; var lpMode: DWORD): Boolean; stdcall; external 'kernel32' name 'GetConsoleMode';
 
+    procedure EXE_Entry(const info : TEntryInformation); external name '_FPC_EXE_Entry';
+    function DLL_entry(const info : TEntryInformation) : longbool; external name '_FPC_DLL_Entry';
+    procedure PascalMain;stdcall;external name 'PASCALMAIN';
+
+    procedure asm_exit;stdcall;public name 'asm_exit';
+      begin
+      end;
+
+    procedure SetupEntryInformation;
+      begin
+        EntryInformation.InitFinalTable:=@InitFinalTable;
+        EntryInformation.ThreadvarTablesTable:=@ThreadvarTablesTable;
+        EntryInformation.asm_exit:=@asm_exit;
+        EntryInformation.PascalMain:=@PascalMain;
+        EntryInformation.valgrind_used:=valgrind_used;
+      end;
+
+
     procedure CMainEXE;cdecl;
       begin
         asm
@@ -41,7 +64,8 @@ unit sysinitcyg;
           andl   $0xfffffff0,%esp
         end;
         __main;
-        EXE_Entry;
+        SetupEntryInformation;
+        EXE_Entry(EntryInformation);
       end;
 
 
@@ -52,7 +76,8 @@ unit sysinitcyg;
           andl   $0xfffffff0,%esp
         end;
         __main;
-        DLL_Entry;
+        SetupEntryInformation;
+        DLL_Entry(EntryInformation);
       end;
 
 
@@ -109,8 +134,4 @@ unit sysinitcyg;
         Cygwin_crt0(@CMainDLL);
       end;
 
-    procedure asm_exit;stdcall;public name 'asm_exit';
-      begin
-      end;
-
 end.

rtl/win32/sysinitgprof.pp

@@ -30,6 +30,11 @@ unit sysinitgprof;
 
     var
       SysInstance : Longint;external name '_FPC_SysInstance';
+      EntryInformation : TEntryInformation;
+
+      InitFinalTable : record end; external name 'INITFINAL';
+      ThreadvarTablesTable : record end; external name 'FPC_THREADVARTABLES';
+      valgrind_used : boolean;external name '__fpc_valgrind';
       stext : record end;external name '__text_start__';
       etext : record end;external name 'etext';
 
@@ -51,6 +56,26 @@ unit sysinitgprof;
     function GetStdHandle(nStdHandle:DWORD) : THandle; stdcall; external 'kernel32' name 'GetStdHandle';
     function GetConsoleMode(hConsoleHandle: THandle; var lpMode: DWORD): Boolean; stdcall; external 'kernel32' name 'GetConsoleMode';
 
+    procedure EXE_Entry(const info : TEntryInformation); external name '_FPC_EXE_Entry';
+    function DLL_entry(const info : TEntryInformation) : longbool; external name '_FPC_DLL_Entry';
+    procedure PascalMain;stdcall;external name 'PASCALMAIN';
+
+    procedure asm_exit;stdcall;public name 'asm_exit';
+      begin
+        _mcleanup;
+      end;
+
+
+    procedure SetupEntryInformation;
+      begin
+        EntryInformation.InitFinalTable:=@InitFinalTable;
+        EntryInformation.ThreadvarTablesTable:=@ThreadvarTablesTable;
+        EntryInformation.asm_exit:=@asm_exit;
+        EntryInformation.PascalMain:=@PascalMain;
+        EntryInformation.valgrind_used:=valgrind_used;
+      end;
+
+
     procedure EXEgmon_start;
       begin
         if monstarted=0 then
@@ -79,7 +104,8 @@ unit sysinitgprof;
         end;
         EXEgmon_start;
         __main;
-        EXE_Entry;
+        SetupEntryInformation;
+        EXE_Entry(EntryInformation);
       end;
 
 
@@ -91,7 +117,8 @@ unit sysinitgprof;
         end;
         DLLgmon_start;
         __main;
-        DLL_Entry;
+        SetupEntryInformation;
+        DLL_Entry(EntryInformation);
       end;
 
 
@@ -148,11 +175,4 @@ unit sysinitgprof;
         Cygwin_crt0(@CMainDLL);
       end;
 
-
-    procedure asm_exit;stdcall;public name 'asm_exit';
-      begin
-        _mcleanup;
-      end;
-
 end.
-

rtl/win32/sysinitpas.pp

@@ -21,9 +21,28 @@ unit sysinitpas;
 
     var
       SysInstance : Longint;external name '_FPC_SysInstance';
+      EntryInformation : TEntryInformation;
 
-    procedure EXE_Entry; external name '_FPC_EXE_Entry';
-    function DLL_entry : longbool; external name '_FPC_DLL_Entry';
+      InitFinalTable : record end; external name 'INITFINAL';
+      ThreadvarTablesTable : record end; external name 'FPC_THREADVARTABLES';
+      valgrind_used : boolean;external name '__fpc_valgrind';
+
+    procedure asm_exit;stdcall;public name 'asm_exit';
+      begin
+      end;
+
+    procedure EXE_Entry(const info : TEntryInformation); external name '_FPC_EXE_Entry';
+    function DLL_entry(const info : TEntryInformation) : longbool; external name '_FPC_DLL_Entry';
+    procedure PascalMain;stdcall;external name 'PASCALMAIN';
+
+    procedure SetupEntryInformation;
+      begin
+        EntryInformation.InitFinalTable:=@InitFinalTable;
+        EntryInformation.ThreadvarTablesTable:=@ThreadvarTablesTable;
+        EntryInformation.asm_exit:=@asm_exit;
+        EntryInformation.PascalMain:=@PascalMain;
+        EntryInformation.valgrind_used:=valgrind_used;
+      end;
 
     const
       STD_INPUT_HANDLE = dword(-10);
@@ -36,14 +55,16 @@ unit sysinitpas;
       IsConsole:=true;
       { do it like it is necessary for the startup code linking against cygwin }
       GetConsoleMode(GetStdHandle((Std_Input_Handle)),StartupConsoleMode);
-      Exe_entry;
+      SetupEntryInformation;
+      Exe_entry(EntryInformation);
     end;
 
 
     procedure _FPC_WinMainCRTStartup;stdcall;public name '_WinMainCRTStartup';
     begin
       IsConsole:=false;
-      Exe_entry;
+      SetupEntryInformation;
+      Exe_entry(EntryInformation);
     end;
 
 
@@ -53,7 +74,8 @@ unit sysinitpas;
       sysinstance:=_hinstance;
       dllreason:=_dllreason;
       dllparam:=_dllparam;
-      DLL_Entry;
+      SetupEntryInformation;
+      DLL_Entry(EntryInformation);
     end;
 
 
@@ -63,11 +85,8 @@ unit sysinitpas;
       sysinstance:=_hinstance;
       dllreason:=_dllreason;
       dllparam:=_dllparam;
-      DLL_Entry;
+      SetupEntryInformation;
+      DLL_Entry(EntryInformation);
     end;
 
-    procedure asm_exit;stdcall;public name 'asm_exit';
-      begin
-      end;
-
 end.

rtl/win32/system.pp

@@ -20,6 +20,8 @@ interface
   {$define SYSTEMEXCEPTIONDEBUG}
 {$endif SYSTEMDEBUG}
 
+{$define FPC_HAS_INDIRECT_MAIN_INFORMATION}
+
 {$ifdef cpui386}
   {$define Set_i386_Exception_handler}
 {$endif cpui386}
@@ -111,6 +113,7 @@ const
 implementation
 
 var
+  EntryInformation : TEntryInformation;
   SysInstance : Longint;public name '_FPC_SysInstance';
 
 {$ifdef CPUI386}
@@ -311,7 +314,9 @@ end;
 
 procedure install_exception_handlers;forward;
 procedure remove_exception_handlers;forward;
+{$ifndef FPC_HAS_INDIRECT_MAIN_INFORMATION}
 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';
@@ -338,7 +343,11 @@ begin
   { in 2.0 asm_exit does an exitprocess }
 {$ifndef ver2_0}
   { do cleanup required by the startup code }
+{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}
+  EntryInformation.asm_exit();
+{$else FPC_HAS_INDIRECT_MAIN_INFORMATION}
   asm_exit;
+{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
 {$endif ver2_0}
 
   { call exitprocess, with cleanup as required }
@@ -350,10 +359,11 @@ var
     to check if the call stack can be written on exceptions }
   _SS : Cardinal;
 
-procedure Exe_entry;[public,alias:'_FPC_EXE_Entry'];
+procedure Exe_entry(const info : TEntryInformation);[public,alias:'_FPC_EXE_Entry'];
   var
     ST : pointer;
   begin
+     EntryInformation:=info;
      IsLibrary:=false;
      { install the handlers for exe only ?
        or should we install them for DLL also ? (PM) }
@@ -380,7 +390,13 @@ procedure Exe_entry;[public,alias:'_FPC_EXE_Entry'];
         movw %ss,%ax
         movl %eax,_SS
         xorl %ebp,%ebp
-        call PASCALMAIN
+     end;
+{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}
+     EntryInformation.PascalMain();
+{$else FPC_HAS_INDIRECT_MAIN_INFORMATION}
+     PascalMain;
+{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
+     asm
         popl %ebp
      end;
      { if we pass here there was no error ! }
@@ -399,11 +415,11 @@ Var
 Const
      DLLExitOK : boolean = true;
 
-function Dll_entry : longbool; [public,alias:'_FPC_DLL_Entry'];
-var
-  res : longbool;
-
+function Dll_entry(const info : TEntryInformation) : longbool; [public,alias:'_FPC_DLL_Entry'];
+  var
+    res : longbool;
   begin
+     EntryInformation:=info;
      IsLibrary:=true;
      Dll_entry:=false;
      case DLLreason of
@@ -417,7 +433,11 @@ var
                    if not res then
                      exit(false);
                  end;
-               PASCALMAIN;
+{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}
+               EntryInformation.PascalMain();
+{$else FPC_HAS_INDIRECT_MAIN_INFORMATION}
+               PascalMain;
+{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
                Dll_entry:=true;
              end
            else