Browse Source

Merged revisions 9020-9021,9025,9028-9029,9033,9035,9052-9053,9059,9074,9076-9082,9084,9086,9088-9090,9096,9108,9113 via svnmerge from
http://svn.freepascal.org/svn/fpc/trunk

........
r9020 | florian | 2007-11-01 00:19:48 +0100 (Thu, 01 Nov 2007) | 1 line

* use only windows exceptions for stack checking on win32/win64, resolves #9166
........
r9028 | florian | 2007-11-01 11:18:05 +0100 (Thu, 01 Nov 2007) | 1 line

* don't care about __stklen anymore
........
r9029 | florian | 2007-11-01 11:28:49 +0100 (Thu, 01 Nov 2007) | 1 line

* avoid generation of __stklen if not necessary
........
r9052 | florian | 2007-11-01 22:59:43 +0100 (Thu, 01 Nov 2007) | 1 line

* win32 system unit doesn't depend anymore directly on the main program, this is necessary to be able to keep it in a dll
........
r9053 | florian | 2007-11-01 23:19:24 +0100 (Thu, 01 Nov 2007) | 2 lines

* test doesn't apply to win32 and win64 anymore
........
r9113 | florian | 2007-11-03 19:39:14 +0100 (Sat, 03 Nov 2007) | 2 lines

* diabled it for windows
........

git-svn-id: branches/fixes_2_2@9847 -

peter 17 years ago
parent
commit
b2ac305a78

+ 6 - 0
compiler/options.pas

@@ -1992,6 +1992,12 @@ begin
     else
     else
       def_system_macro('FPC_CPUCROSSCOMPILING');
       def_system_macro('FPC_CPUCROSSCOMPILING');
 
 
+  if (tf_no_generic_stackcheck in target_info.flags) then
+    if def then
+      def_system_macro('FPC_NO_GENERIC_STACK_CHECK')
+    else
+      undef_system_macro('FPC_NO_GENERIC_STACK_CHECK');
+
   { Code generation flags }
   { Code generation flags }
   if def and
   if def and
      (tf_pic_default in target_info.flags) then
      (tf_pic_default in target_info.flags) then

+ 7 - 4
compiler/pmodules.pas

@@ -363,10 +363,13 @@ implementation
         current_asmdata.asmlists[al_globals].concat(Tai_align.Create(const_align(32)));
         current_asmdata.asmlists[al_globals].concat(Tai_align.Create(const_align(32)));
         current_asmdata.asmlists[al_globals].concat(Tai_string.Create('FPC '+full_version_string+
         current_asmdata.asmlists[al_globals].concat(Tai_string.Create('FPC '+full_version_string+
           ' ['+date_string+'] for '+target_cpu_string+' - '+target_info.shortname));
           ' ['+date_string+'] for '+target_cpu_string+' - '+target_info.shortname));
-        { stacksize can be specified and is now simulated }
-        new_section(current_asmdata.asmlists[al_globals],sec_data,'__stklen', sizeof(aint));
-        current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('__stklen',AT_DATA,sizeof(aint)));
-        current_asmdata.asmlists[al_globals].concat(Tai_const.Create_aint(stacksize));
+        if not(tf_no_generic_stackcheck in target_info.flags) then
+          begin
+            { stacksize can be specified and is now simulated }
+            new_section(current_asmdata.asmlists[al_globals],sec_data,'__stklen', sizeof(aint));
+            current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('__stklen',AT_DATA,sizeof(aint)));
+            current_asmdata.asmlists[al_globals].concat(Tai_const.Create_aint(stacksize));
+          end;
 {$IFDEF POWERPC}
 {$IFDEF POWERPC}
         { AmigaOS4 "stack cookie" support }
         { AmigaOS4 "stack cookie" support }
         if ( target_info.system = system_powerpc_amiga ) then
         if ( target_info.system = system_powerpc_amiga ) then

+ 2 - 1
compiler/psub.pas

@@ -950,7 +950,8 @@ implementation
 
 
             { Already reserve all registers for stack checking code and
             { Already reserve all registers for stack checking code and
               generate the call to the helper function }
               generate the call to the helper function }
-            if (cs_check_stack in entryswitches) and
+            if not(tf_no_generic_stackcheck in target_info.flags) and
+               (cs_check_stack in entryswitches) and
                not(po_assembler in procdef.procoptions) and
                not(po_assembler in procdef.procoptions) and
                (procdef.proctypeoption<>potype_proginit) then
                (procdef.proctypeoption<>potype_proginit) then
               begin
               begin

+ 3 - 1
compiler/systems.pas

@@ -312,7 +312,9 @@ interface
             tf_dwarf_only_local_labels,          // only use local labels inside the Dwarf debug_info section (needed for e.g. Darwin)
             tf_dwarf_only_local_labels,          // only use local labels inside the Dwarf debug_info section (needed for e.g. Darwin)
             tf_requires_proper_alignment,
             tf_requires_proper_alignment,
             tf_no_pic_supported,
             tf_no_pic_supported,
-            tf_pic_default
+            tf_pic_default,
+            { the os does some kind of stack checking and it can be converted into a rte 202 }
+            tf_no_generic_stackcheck
        );
        );
 
 
        psysteminfo = ^tsysteminfo;
        psysteminfo = ^tsysteminfo;

+ 5 - 2
compiler/systems/i_win.pas

@@ -33,7 +33,9 @@ unit i_win;
             name         : 'Win32 for i386';
             name         : 'Win32 for i386';
             shortname    : 'Win32';
             shortname    : 'Win32';
             flags        : [tf_files_case_aware,tf_has_dllscanner,tf_use_function_relative_addresses,tf_smartlink_library
             flags        : [tf_files_case_aware,tf_has_dllscanner,tf_use_function_relative_addresses,tf_smartlink_library
-                            ,tf_smartlink_sections{,tf_section_threadvars}{,tf_needs_dwarf_cfi},tf_winlikewidestring,tf_no_pic_supported];
+                            ,tf_smartlink_sections{,tf_section_threadvars}{,tf_needs_dwarf_cfi},
+                            tf_winlikewidestring,tf_no_pic_supported,
+                            tf_no_generic_stackcheck];
             cpu          : cpu_i386;
             cpu          : cpu_i386;
             unit_env     : 'WIN32UNITS';
             unit_env     : 'WIN32UNITS';
             extradefines : 'MSWINDOWS;WINDOWS';
             extradefines : 'MSWINDOWS;WINDOWS';
@@ -93,7 +95,8 @@ unit i_win;
             name         : 'Win64 for x64';
             name         : 'Win64 for x64';
             shortname    : 'Win64';
             shortname    : 'Win64';
             flags        : [tf_files_case_aware,tf_has_dllscanner,tf_use_function_relative_addresses,
             flags        : [tf_files_case_aware,tf_has_dllscanner,tf_use_function_relative_addresses,
-                            tf_smartlink_sections,tf_smartlink_library,tf_winlikewidestring,tf_no_pic_supported];
+                            tf_smartlink_sections,tf_smartlink_library,tf_winlikewidestring,tf_no_pic_supported,
+                            tf_no_generic_stackcheck];
             cpu          : cpu_x86_64;
             cpu          : cpu_x86_64;
             unit_env     : 'WIN64UNITS';
             unit_env     : 'WIN64UNITS';
             extradefines : 'MSWINDOWS;WINDOWS';
             extradefines : 'MSWINDOWS;WINDOWS';

+ 6 - 0
rtl/i386/fastmove.inc

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

+ 21 - 3
rtl/inc/system.inc

@@ -44,7 +44,11 @@ const
 var
 var
   { widechar, because also used by widestring -> pwidechar conversions }
   { widechar, because also used by widestring -> pwidechar conversions }
   emptychar : widechar;public name 'FPC_EMPTYCHAR';
   emptychar : widechar;public name 'FPC_EMPTYCHAR';
+{$ifndef FPC_NO_GENERIC_STACK_CHECK}
+  { if the OS does the stack checking, we don't need any stklen from the
+    main program }
   initialstklen : SizeUint;external name '__stklen';
   initialstklen : SizeUint;external name '__stklen';
+{$endif FPC_NO_GENERIC_STACK_CHECK}
 
 
 { checks whether the given suggested size for the stack of the current
 { checks whether the given suggested size for the stack of the current
  thread is acceptable. If this is the case, returns it unaltered.
  thread is acceptable. If this is the case, returns it unaltered.
@@ -653,6 +657,11 @@ end;
                          Stack check code
                          Stack check code
 *****************************************************************************}
 *****************************************************************************}
 
 
+{ be compatible with old code }
+{$ifdef FPC_NO_GENERIC_STACK_CHECK}
+{$define NO_GENERIC_STACK_CHECK}
+{$endif FPC_NO_GENERIC_STACK_CHECK}
+
 {$IFNDEF NO_GENERIC_STACK_CHECK}
 {$IFNDEF NO_GENERIC_STACK_CHECK}
 
 
 {$IFOPT S+}
 {$IFOPT S+}
@@ -691,14 +700,19 @@ type
     InitProc,
     InitProc,
     FinalProc : TProcedure;
     FinalProc : TProcedure;
   end;
   end;
-  TInitFinalTable=record
+  TInitFinalTable = record
     TableCount,
     TableCount,
     InitCount  : longint;
     InitCount  : longint;
     Procs      : array[1..maxunits] of TInitFinalRec;
     Procs      : array[1..maxunits] of TInitFinalRec;
   end;
   end;
+  PInitFinalTable = ^TInitFinalTable;
+
 
 
+{$ifndef FPC_HAS_INDIRECT_MAIN_INFORMATION}
 var
 var
   InitFinalTable : TInitFinalTable;external name 'INITFINAL';
   InitFinalTable : TInitFinalTable;external name 'INITFINAL';
+{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
+
 
 
 procedure fpc_InitializeUnits;[public,alias:'FPC_INITIALIZEUNITS']; compilerproc;
 procedure fpc_InitializeUnits;[public,alias:'FPC_INITIALIZEUNITS']; compilerproc;
 var
 var
@@ -706,7 +720,9 @@ var
 begin
 begin
   { call cpu/fpu initialisation routine }
   { call cpu/fpu initialisation routine }
   fpc_cpuinit;
   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
    begin
      for i:=1 to TableCount do
      for i:=1 to TableCount do
       begin
       begin
@@ -722,7 +738,9 @@ end;
 
 
 procedure FinalizeUnits;[public,alias:'FPC_FINALIZEUNITS'];
 procedure FinalizeUnits;[public,alias:'FPC_FINALIZEUNITS'];
 begin
 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
    begin
      while (InitCount>0) do
      while (InitCount>0) do
       begin
       begin

+ 9 - 0
rtl/inc/systemh.inc

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

+ 16 - 6
rtl/inc/threadvr.inc

@@ -31,9 +31,12 @@ type
     count  : dword;
     count  : dword;
     tables : packed array [1..32767] of pltvInitEntry;
     tables : packed array [1..32767] of pltvInitEntry;
   end;
   end;
+  PltvInitTablesTable = ^TltvInitTablesTable;
 
 
+{$ifndef FPC_HAS_INDIRECT_MAIN_INFORMATION}
 var
 var
   ThreadvarTablesTable : TltvInitTablesTable; external name 'FPC_THREADVARTABLES';
   ThreadvarTablesTable : TltvInitTablesTable; external name 'FPC_THREADVARTABLES';
+{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
 
 
 procedure init_unit_threadvars (tableEntry : pltvInitEntry);
 procedure init_unit_threadvars (tableEntry : pltvInitEntry);
 begin
 begin
@@ -50,10 +53,14 @@ var
   i : integer;
   i : integer;
 begin
 begin
 {$ifdef DEBUG_MT}
 {$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}
 {$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;
 end;
 
 
 
 
@@ -77,10 +84,13 @@ var
   i : integer;
   i : integer;
 begin
 begin
 {$ifdef DEBUG_MT}
 {$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}
 {$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;
 end;
 
 
 procedure InitThreadVars(RelocProc : Pointer);
 procedure InitThreadVars(RelocProc : Pointer);

+ 27 - 6
rtl/win32/sysinitcyg.pp

@@ -21,6 +21,11 @@ unit sysinitcyg;
 
 
     var
     var
       SysInstance : Longint;external name '_FPC_SysInstance';
       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';
     procedure EXE_Entry; external name '_FPC_EXE_Entry';
     function DLL_Entry : longbool; external name '_FPC_DLL_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 GetStdHandle(nStdHandle:DWORD) : THandle; stdcall; external 'kernel32' name 'GetStdHandle';
     function GetConsoleMode(hConsoleHandle: THandle; var lpMode: DWORD): Boolean; stdcall; external 'kernel32' name 'GetConsoleMode';
     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;
     procedure CMainEXE;cdecl;
       begin
       begin
         asm
         asm
@@ -41,7 +64,8 @@ unit sysinitcyg;
           andl   $0xfffffff0,%esp
           andl   $0xfffffff0,%esp
         end;
         end;
         __main;
         __main;
-        EXE_Entry;
+        SetupEntryInformation;
+        EXE_Entry(EntryInformation);
       end;
       end;
 
 
 
 
@@ -52,7 +76,8 @@ unit sysinitcyg;
           andl   $0xfffffff0,%esp
           andl   $0xfffffff0,%esp
         end;
         end;
         __main;
         __main;
-        DLL_Entry;
+        SetupEntryInformation;
+        DLL_Entry(EntryInformation);
       end;
       end;
 
 
 
 
@@ -109,8 +134,4 @@ unit sysinitcyg;
         Cygwin_crt0(@CMainDLL);
         Cygwin_crt0(@CMainDLL);
       end;
       end;
 
 
-    procedure asm_exit;stdcall;public name 'asm_exit';
-      begin
-      end;
-
 end.
 end.

+ 29 - 9
rtl/win32/sysinitgprof.pp

@@ -30,6 +30,11 @@ unit sysinitgprof;
 
 
     var
     var
       SysInstance : Longint;external name '_FPC_SysInstance';
       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__';
       stext : record end;external name '__text_start__';
       etext : record end;external name 'etext';
       etext : record end;external name 'etext';
 
 
@@ -51,6 +56,26 @@ unit sysinitgprof;
     function GetStdHandle(nStdHandle:DWORD) : THandle; stdcall; external 'kernel32' name 'GetStdHandle';
     function GetStdHandle(nStdHandle:DWORD) : THandle; stdcall; external 'kernel32' name 'GetStdHandle';
     function GetConsoleMode(hConsoleHandle: THandle; var lpMode: DWORD): Boolean; stdcall; external 'kernel32' name 'GetConsoleMode';
     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;
     procedure EXEgmon_start;
       begin
       begin
         if monstarted=0 then
         if monstarted=0 then
@@ -79,7 +104,8 @@ unit sysinitgprof;
         end;
         end;
         EXEgmon_start;
         EXEgmon_start;
         __main;
         __main;
-        EXE_Entry;
+        SetupEntryInformation;
+        EXE_Entry(EntryInformation);
       end;
       end;
 
 
 
 
@@ -91,7 +117,8 @@ unit sysinitgprof;
         end;
         end;
         DLLgmon_start;
         DLLgmon_start;
         __main;
         __main;
-        DLL_Entry;
+        SetupEntryInformation;
+        DLL_Entry(EntryInformation);
       end;
       end;
 
 
 
 
@@ -148,11 +175,4 @@ unit sysinitgprof;
         Cygwin_crt0(@CMainDLL);
         Cygwin_crt0(@CMainDLL);
       end;
       end;
 
 
-
-    procedure asm_exit;stdcall;public name 'asm_exit';
-      begin
-        _mcleanup;
-      end;
-
 end.
 end.
-

+ 29 - 10
rtl/win32/sysinitpas.pp

@@ -21,9 +21,28 @@ unit sysinitpas;
 
 
     var
     var
       SysInstance : Longint;external name '_FPC_SysInstance';
       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
     const
       STD_INPUT_HANDLE = dword(-10);
       STD_INPUT_HANDLE = dword(-10);
@@ -36,14 +55,16 @@ unit sysinitpas;
       IsConsole:=true;
       IsConsole:=true;
       { do it like it is necessary for the startup code linking against cygwin }
       { do it like it is necessary for the startup code linking against cygwin }
       GetConsoleMode(GetStdHandle((Std_Input_Handle)),StartupConsoleMode);
       GetConsoleMode(GetStdHandle((Std_Input_Handle)),StartupConsoleMode);
-      Exe_entry;
+      SetupEntryInformation;
+      Exe_entry(EntryInformation);
     end;
     end;
 
 
 
 
     procedure _FPC_WinMainCRTStartup;stdcall;public name '_WinMainCRTStartup';
     procedure _FPC_WinMainCRTStartup;stdcall;public name '_WinMainCRTStartup';
     begin
     begin
       IsConsole:=false;
       IsConsole:=false;
-      Exe_entry;
+      SetupEntryInformation;
+      Exe_entry(EntryInformation);
     end;
     end;
 
 
 
 
@@ -53,7 +74,8 @@ unit sysinitpas;
       sysinstance:=_hinstance;
       sysinstance:=_hinstance;
       dllreason:=_dllreason;
       dllreason:=_dllreason;
       dllparam:=_dllparam;
       dllparam:=_dllparam;
-      DLL_Entry;
+      SetupEntryInformation;
+      DLL_Entry(EntryInformation);
     end;
     end;
 
 
 
 
@@ -63,11 +85,8 @@ unit sysinitpas;
       sysinstance:=_hinstance;
       sysinstance:=_hinstance;
       dllreason:=_dllreason;
       dllreason:=_dllreason;
       dllparam:=_dllparam;
       dllparam:=_dllparam;
-      DLL_Entry;
+      SetupEntryInformation;
+      DLL_Entry(EntryInformation);
     end;
     end;
 
 
-    procedure asm_exit;stdcall;public name 'asm_exit';
-      begin
-      end;
-
 end.
 end.

+ 37 - 15
rtl/win32/system.pp

@@ -20,6 +20,8 @@ interface
   {$define SYSTEMEXCEPTIONDEBUG}
   {$define SYSTEMEXCEPTIONDEBUG}
 {$endif SYSTEMDEBUG}
 {$endif SYSTEMDEBUG}
 
 
+{$define FPC_HAS_INDIRECT_MAIN_INFORMATION}
+
 {$ifdef cpui386}
 {$ifdef cpui386}
   {$define Set_i386_Exception_handler}
   {$define Set_i386_Exception_handler}
 {$endif cpui386}
 {$endif cpui386}
@@ -111,6 +113,7 @@ const
 implementation
 implementation
 
 
 var
 var
+  EntryInformation : TEntryInformation;
   SysInstance : Longint;public name '_FPC_SysInstance';
   SysInstance : Longint;public name '_FPC_SysInstance';
 
 
 {$ifdef CPUI386}
 {$ifdef CPUI386}
@@ -311,7 +314,9 @@ end;
 
 
 procedure install_exception_handlers;forward;
 procedure install_exception_handlers;forward;
 procedure remove_exception_handlers;forward;
 procedure remove_exception_handlers;forward;
+{$ifndef FPC_HAS_INDIRECT_MAIN_INFORMATION}
 procedure PascalMain;stdcall;external name 'PASCALMAIN';
 procedure PascalMain;stdcall;external name 'PASCALMAIN';
+{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
 procedure fpc_do_exit;stdcall;external name 'FPC_DO_EXIT';
 procedure fpc_do_exit;stdcall;external name 'FPC_DO_EXIT';
 Procedure ExitDLL(Exitcode : longint); forward;
 Procedure ExitDLL(Exitcode : longint); forward;
 procedure asm_exit;stdcall;external name 'asm_exit';
 procedure asm_exit;stdcall;external name 'asm_exit';
@@ -338,7 +343,11 @@ begin
   { in 2.0 asm_exit does an exitprocess }
   { in 2.0 asm_exit does an exitprocess }
 {$ifndef ver2_0}
 {$ifndef ver2_0}
   { do cleanup required by the startup code }
   { do cleanup required by the startup code }
+{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}
+  EntryInformation.asm_exit();
+{$else FPC_HAS_INDIRECT_MAIN_INFORMATION}
   asm_exit;
   asm_exit;
+{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
 {$endif ver2_0}
 {$endif ver2_0}
 
 
   { call exitprocess, with cleanup as required }
   { call exitprocess, with cleanup as required }
@@ -350,10 +359,11 @@ var
     to check if the call stack can be written on exceptions }
     to check if the call stack can be written on exceptions }
   _SS : Cardinal;
   _SS : Cardinal;
 
 
-procedure Exe_entry;[public,alias:'_FPC_EXE_Entry'];
+procedure Exe_entry(const info : TEntryInformation);[public,alias:'_FPC_EXE_Entry'];
   var
   var
     ST : pointer;
     ST : pointer;
   begin
   begin
+     EntryInformation:=info;
      IsLibrary:=false;
      IsLibrary:=false;
      { install the handlers for exe only ?
      { install the handlers for exe only ?
        or should we install them for DLL also ? (PM) }
        or should we install them for DLL also ? (PM) }
@@ -380,7 +390,13 @@ procedure Exe_entry;[public,alias:'_FPC_EXE_Entry'];
         movw %ss,%ax
         movw %ss,%ax
         movl %eax,_SS
         movl %eax,_SS
         xorl %ebp,%ebp
         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
         popl %ebp
      end;
      end;
      { if we pass here there was no error ! }
      { if we pass here there was no error ! }
@@ -399,11 +415,11 @@ Var
 Const
 Const
      DLLExitOK : boolean = true;
      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
   begin
+     EntryInformation:=info;
      IsLibrary:=true;
      IsLibrary:=true;
      Dll_entry:=false;
      Dll_entry:=false;
      case DLLreason of
      case DLLreason of
@@ -417,7 +433,11 @@ var
                    if not res then
                    if not res then
                      exit(false);
                      exit(false);
                  end;
                  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;
                Dll_entry:=true;
              end
              end
            else
            else
@@ -1083,7 +1103,7 @@ begin
    end;
    end;
 end;
 end;
 
 
-(* ProcessID cached to avoid repeated calls to GetCurrentProcess. *)
+{ ProcessID cached to avoid repeated calls to GetCurrentProcess. }
 
 
 var
 var
   ProcessID: SizeUInt;
   ProcessID: SizeUInt;
@@ -1093,9 +1113,10 @@ begin
  GetProcessID := ProcessID;
  GetProcessID := ProcessID;
 end;
 end;
 
 
-function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
-begin
-  result := stklen;
+function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;assembler;
+asm
+  movl  %fs:(4),%eax
+  subl  %fs:(8),%eax
 end;
 end;
 
 
 {
 {
@@ -1105,15 +1126,16 @@ const
 }
 }
 
 
 begin
 begin
-  StackLength := CheckInitialStkLen(InitialStkLen);
+  { pass dummy value }
+  StackLength := CheckInitialStkLen($1000000);
   StackBottom := StackTop - StackLength;
   StackBottom := StackTop - StackLength;
   { get some helpful informations }
   { get some helpful informations }
   GetStartupInfo(@startupinfo);
   GetStartupInfo(@startupinfo);
-  
-  SysResetFPU;  
+
+  SysResetFPU;
   if not(IsLibrary) then
   if not(IsLibrary) then
     SysInitFPU;
     SysInitFPU;
-  
+
   { some misc Win32 stuff }
   { some misc Win32 stuff }
   hprevinst:=0;
   hprevinst:=0;
   if not IsLibrary then
   if not IsLibrary then

+ 7 - 5
rtl/win64/system.pp

@@ -1136,17 +1136,19 @@ begin
 end;
 end;
 
 
 
 
-function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
-begin
-  result := stklen;
+function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;assembler;
+asm
+  movq  %gs:(8),%rax
+  subq  %gs:(16),%rax
 end;
 end;
 
 
 
 
 begin
 begin
-  SysResetFPU;    
+  SysResetFPU;
   if not(IsLibrary) then
   if not(IsLibrary) then
     SysInitFPU;
     SysInitFPU;
-  StackLength := CheckInitialStkLen(InitialStkLen);
+  { pass dummy value }
+  StackLength := CheckInitialStkLen($1000000);
   StackBottom := StackTop - StackLength;
   StackBottom := StackTop - StackLength;
   { get some helpful informations }
   { get some helpful informations }
   GetStartupInfo(@startupinfo);
   GetStartupInfo(@startupinfo);

+ 1 - 0
tests/tbs/tb0193.pp

@@ -1,3 +1,4 @@
+{ %skiptarget=win32,win64 }
 { %OPT=-Cg- }
 { %OPT=-Cg- }
 { Old file: tbs0227.pp }
 { Old file: tbs0227.pp }
 { external var does strange things when declared in localsymtable OK 0.99.11 (PFV) }
 { external var does strange things when declared in localsymtable OK 0.99.11 (PFV) }

+ 4 - 0
tests/test/twide3.pp

@@ -1,3 +1,7 @@
+{ %skiptarget=win32,win64,wince }
+{ This test is only usefull if the local codepage is utf-8 which
+  usually not the case on windows
+}
 {$codepage utf-8}
 {$codepage utf-8}
 
 
 {$mode objfpc}
 {$mode objfpc}