mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-25 17:11:08 +02:00
* set stack margin on windows, so there is stack space left for exception handling in case of a stack overflow, resolves #40589
This commit is contained in:
parent
c4fc5fc916
commit
14ab1cfb71
@ -273,6 +273,8 @@ type
|
|||||||
function GetModuleHandle(p : PAnsiChar) : THandle;
|
function GetModuleHandle(p : PAnsiChar) : THandle;
|
||||||
stdcall;external KernelDLL name 'GetModuleHandleA';
|
stdcall;external KernelDLL name 'GetModuleHandleA';
|
||||||
|
|
||||||
|
function SetThreadStackGuarantee(StackSizeInBytes : PPtrUint) : BOOL;
|
||||||
|
stdcall;external KernelDLL name 'SetThreadStackGuarantee';
|
||||||
{$else WINCE}
|
{$else WINCE}
|
||||||
|
|
||||||
{ module functions }
|
{ module functions }
|
||||||
|
@ -227,7 +227,10 @@ var
|
|||||||
- static threadvars, no callback: ThreadID remains 0 and
|
- static threadvars, no callback: ThreadID remains 0 and
|
||||||
initialization happens here. }
|
initialization happens here. }
|
||||||
if ThreadID=TThreadID(0) then
|
if ThreadID=TThreadID(0) then
|
||||||
InitThread(ti.stklen);
|
begin
|
||||||
|
InitThread(ti.stklen);
|
||||||
|
SetThreadStackGuarantee(@StackMargin);
|
||||||
|
end;
|
||||||
|
|
||||||
dispose(pthreadinfo(param));
|
dispose(pthreadinfo(param));
|
||||||
|
|
||||||
|
@ -619,6 +619,7 @@ initialization
|
|||||||
{ pass dummy value }
|
{ pass dummy value }
|
||||||
StackLength := CheckInitialStkLen($1000000);
|
StackLength := CheckInitialStkLen($1000000);
|
||||||
StackBottom := StackTop - StackLength;
|
StackBottom := StackTop - StackLength;
|
||||||
|
SetThreadStackGuarantee(@StackMargin);
|
||||||
|
|
||||||
cmdshow:=startupinfo.wshowwindow;
|
cmdshow:=startupinfo.wshowwindow;
|
||||||
{ Setup heap and threading, these may be already initialized from TLS callback }
|
{ Setup heap and threading, these may be already initialized from TLS callback }
|
||||||
|
@ -478,6 +478,8 @@ initialization
|
|||||||
{ pass dummy value }
|
{ pass dummy value }
|
||||||
StackLength := CheckInitialStkLen($1000000);
|
StackLength := CheckInitialStkLen($1000000);
|
||||||
StackBottom := StackTop - StackLength;
|
StackBottom := StackTop - StackLength;
|
||||||
|
SetThreadStackGuarantee(@StackMargin);
|
||||||
|
|
||||||
{ get some helpful informations }
|
{ get some helpful informations }
|
||||||
GetStartupInfo(@startupinfo);
|
GetStartupInfo(@startupinfo);
|
||||||
{ some misc Win32 stuff }
|
{ some misc Win32 stuff }
|
||||||
|
22
tests/webtbs/tw40589.pp
Normal file
22
tests/webtbs/tw40589.pp
Normal file
@ -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.
|
Loading…
Reference in New Issue
Block a user