浏览代码

* set stack margin on windows, so there is stack space left for exception handling in case of a stack overflow, resolves #40589

florian 1 年之前
父节点
当前提交
14ab1cfb71
共有 5 个文件被更改,包括 31 次插入1 次删除
  1. 2 0
      rtl/win/sysos.inc
  2. 4 1
      rtl/win/systhrd.inc
  3. 1 0
      rtl/win32/system.pp
  4. 2 0
      rtl/win64/system.pp
  5. 22 0
      tests/webtbs/tw40589.pp

+ 2 - 0
rtl/win/sysos.inc

@@ -273,6 +273,8 @@ type
   function GetModuleHandle(p : PAnsiChar) : THandle;
     stdcall;external KernelDLL name 'GetModuleHandleA';
 
+  function SetThreadStackGuarantee(StackSizeInBytes : PPtrUint) : BOOL;
+    stdcall;external KernelDLL name 'SetThreadStackGuarantee';
 {$else WINCE}
 
    { module functions }

+ 4 - 1
rtl/win/systhrd.inc

@@ -227,7 +227,10 @@ var
           - static threadvars, no callback: ThreadID remains 0 and
             initialization happens here. }
         if ThreadID=TThreadID(0) then
-          InitThread(ti.stklen);
+          begin
+            InitThread(ti.stklen);
+            SetThreadStackGuarantee(@StackMargin);
+          end;
 
         dispose(pthreadinfo(param));
 

+ 1 - 0
rtl/win32/system.pp

@@ -619,6 +619,7 @@ initialization
   { pass dummy value }
   StackLength := CheckInitialStkLen($1000000);
   StackBottom := StackTop - StackLength;
+  SetThreadStackGuarantee(@StackMargin);
 
   cmdshow:=startupinfo.wshowwindow;
   { Setup heap and threading, these may be already initialized from TLS callback }

+ 2 - 0
rtl/win64/system.pp

@@ -478,6 +478,8 @@ initialization
   { pass dummy value }
   StackLength := CheckInitialStkLen($1000000);
   StackBottom := StackTop - StackLength;
+  SetThreadStackGuarantee(@StackMargin);
+  
   { get some helpful informations }
   GetStartupInfo(@startupinfo);
   { some misc Win32 stuff }

+ 22 - 0
tests/webtbs/tw40589.pp

@@ -0,0 +1,22 @@
+{ %RESULT=202 }
+{ %opt=gl }
+
+{$mode objfpc}
+
+type
+  TForm1 = class
+    procedure Button1Click(Sender: TObject);
+  end;
+
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+  Button1Click(self);
+end;
+
+var
+  Form1 : TForm1;
+
+begin
+  Form1:=TForm1.Create;
+  Form1.Button1Click(nil);
+end.