paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-23 06:49:49 +02:00
Code Issues Packages Projects Releases Wiki Activity

Support Windows XP where SetThreadStackGuarantee is absent.

Browse Source
This commit is contained in:
Rika Ichinose 2024-01-26 16:57:49 +03:00
parent a2f2af87d2
commit a774075f2f
4 changed files with 12 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
rtl/win/sysos.inc
View File

@ -273,8 +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; var
stdcall;external KernelDLL name 'SetThreadStackGuarantee'; SetThreadStackGuarantee: function(StackSizeInBytes : PPtrUint) : BOOL; stdcall;
{$else WINCE} {$else WINCE}
{ module functions } { module functions }
@ -304,7 +304,7 @@ type
procedure GetSystemInfo(lpSystemInfo: PSystemInfo); {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'GetSystemInfo'; procedure GetSystemInfo(lpSystemInfo: PSystemInfo); {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'GetSystemInfo';
function WinLoadLibraryW(lpLibFileName:pwidechar):THandle; {$ifdef wince}cdecl{$else}stdcall{$endif}; external KernelDLL name 'LoadLibraryW'; function WinLoadLibraryW(lpLibFileName:pwidechar):THandle; {$ifdef wince}cdecl{$else}stdcall{$endif}; external KernelDLL name 'LoadLibraryW';
function WinLoadLibraryA(lpLibFileName:pwidechar):THandle; {$ifdef wince}cdecl{$else}stdcall{$endif}; external KernelDLL name 'LoadLibraryA'; function WinGetModuleHandleW(lpModuleName:pwidechar):THandle; {$ifdef wince}cdecl{$else}stdcall{$endif}; external KernelDLL name 'GetModuleHandleW';
{$ifdef wince} {$ifdef wince}
function WinGetProcAddress(hModule:THandle; lpProcName:PAnsiChar):pointer; {$ifdef wince}cdecl{$else}stdcall{$endif}; external KernelDLL name 'GetProcAddressA'; function WinGetProcAddress(hModule:THandle; lpProcName:PAnsiChar):pointer; {$ifdef wince}cdecl{$else}stdcall{$endif}; external KernelDLL name 'GetProcAddressA';
{$else} {$else}

3
rtl/win/systhrd.inc
View File

@ -230,7 +230,8 @@ var
begin begin
InitThread(ti.stklen); InitThread(ti.stklen);
{$ifndef wince} {$ifndef wince}
SetThreadStackGuarantee(@StackMargin); if Assigned(SetThreadStackGuarantee) then
SetThreadStackGuarantee(@StackMargin);
{$endif wince} {$endif wince}
end; end;

4
rtl/win32/system.pp
View File

@ -619,7 +619,9 @@ initialization
{ pass dummy value } { pass dummy value }
StackLength := CheckInitialStkLen($1000000); StackLength := CheckInitialStkLen($1000000);
StackBottom := StackTop - StackLength; StackBottom := StackTop - StackLength;
SetThreadStackGuarantee(@StackMargin); CodePointer(SetThreadStackGuarantee) := WinGetProcAddress(WinGetModuleHandleW(KernelDLL), 'SetThreadStackGuarantee');
if Assigned(SetThreadStackGuarantee) then
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 }

4
rtl/win64/system.pp
View File

@ -478,7 +478,9 @@ initialization
{ pass dummy value } { pass dummy value }
StackLength := CheckInitialStkLen($1000000); StackLength := CheckInitialStkLen($1000000);
StackBottom := StackTop - StackLength; StackBottom := StackTop - StackLength;
SetThreadStackGuarantee(@StackMargin); CodePointer(SetThreadStackGuarantee) := WinGetProcAddress(WinGetModuleHandleW(KernelDLL), 'SetThreadStackGuarantee');
if Assigned(SetThreadStackGuarantee) then
SetThreadStackGuarantee(@StackMargin);
{ get some helpful informations } { get some helpful informations }
GetStartupInfo(@startupinfo); GetStartupInfo(@startupinfo);