Procházet zdrojové kódy

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 před 17 roky
rodič
revize
b2ac305a78

+ 6 - 0
compiler/options.pas

@@ -1992,6 +1992,12 @@ begin
     else
       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 }
   if def and
      (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_string.Create('FPC '+full_version_string+
           ' ['+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}
         { AmigaOS4 "stack cookie" support }
         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
               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
                (procdef.proctypeoption<>potype_proginit) then
               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_requires_proper_alignment,
             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;

+ 5 - 2
compiler/systems/i_win.pas

@@ -33,7 +33,9 @@ unit i_win;
             name         : 'Win32 for i386';
             shortname    : 'Win32';
             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;
             unit_env     : 'WIN32UNITS';
             extradefines : 'MSWINDOWS;WINDOWS';
@@ -93,7 +95,8 @@ unit i_win;
             name         : 'Win64 for x64';
             shortname    : 'Win64';
             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;
             unit_env     : 'WIN64UNITS';
             extradefines : 'MSWINDOWS;WINDOWS';

+ 6 - 0
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;

+ 21 - 3
rtl/inc/system.inc

@@ -44,7 +44,11 @@ const
 var
   { widechar, because also used by widestring -> pwidechar conversions }
   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';
+{$endif FPC_NO_GENERIC_STACK_CHECK}
 
 { checks whether the given suggested size for the stack of the current
  thread is acceptable. If this is the case, returns it unaltered.
@@ -653,6 +657,11 @@ end;
                          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}
 
 {$IFOPT S+}
@@ -691,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
@@ -706,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
@@ -722,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

+ 9 - 0
rtl/inc/systemh.inc

@@ -294,6 +294,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}

+ 16 - 6
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);

+ 27 - 6
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.

+ 29 - 9
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.
-

+ 29 - 10
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.

+ 37 - 15
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
@@ -1083,7 +1103,7 @@ begin
    end;
 end;
 
-(* ProcessID cached to avoid repeated calls to GetCurrentProcess. *)
+{ ProcessID cached to avoid repeated calls to GetCurrentProcess. }
 
 var
   ProcessID: SizeUInt;
@@ -1093,9 +1113,10 @@ begin
  GetProcessID := ProcessID;
 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;
 
 {
@@ -1105,15 +1126,16 @@ const
 }
 
 begin
-  StackLength := CheckInitialStkLen(InitialStkLen);
+  { pass dummy value }
+  StackLength := CheckInitialStkLen($1000000);
   StackBottom := StackTop - StackLength;
   { get some helpful informations }
   GetStartupInfo(@startupinfo);
-  
-  SysResetFPU;  
+
+  SysResetFPU;
   if not(IsLibrary) then
     SysInitFPU;
-  
+
   { some misc Win32 stuff }
   hprevinst:=0;
   if not IsLibrary then

+ 7 - 5
rtl/win64/system.pp

@@ -1136,17 +1136,19 @@ begin
 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;
 
 
 begin
-  SysResetFPU;    
+  SysResetFPU;
   if not(IsLibrary) then
     SysInitFPU;
-  StackLength := CheckInitialStkLen(InitialStkLen);
+  { pass dummy value }
+  StackLength := CheckInitialStkLen($1000000);
   StackBottom := StackTop - StackLength;
   { get some helpful informations }
   GetStartupInfo(@startupinfo);

+ 1 - 0
tests/tbs/tb0193.pp

@@ -1,3 +1,4 @@
+{ %skiptarget=win32,win64 }
 { %OPT=-Cg- }
 { Old file: tbs0227.pp }
 { 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}
 
 {$mode objfpc}