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

Shorten win/systhrd.inc; fix SetThreadStackGuarantee signature.

Browse Source
This commit is contained in:
Rika Ichinose 2024-04-29 22:46:55 +03:00 committed by FPK
parent dd63ea1425
commit 6489b6fc36
5 changed files with 28 additions and 83 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
rtl/win/sysheap.inc
View File

@ -18,13 +18,6 @@
OS Memory allocation / deallocation OS Memory allocation / deallocation
****************************************************************************} ****************************************************************************}
{ memory functions }
function GetProcessHeap : THandle;
{$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'GetProcessHeap';
function HeapAlloc(hHeap : THandle; dwFlags : DWord; dwBytes : SIZE_T) : pointer;
{$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'HeapAlloc';
function HeapFree(hHeap : THandle; dwFlags : dword; lpMem: pointer) : boolean;
{$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'HeapFree';
{$IFDEF SYSTEMDEBUG} {$IFDEF SYSTEMDEBUG}
function WinAPIHeapSize(hHeap : THandle; dwFlags : DWord; ptr : Pointer) : SIZE_T; function WinAPIHeapSize(hHeap : THandle; dwFlags : DWord; ptr : Pointer) : SIZE_T;
{$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'HeapSize'; {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'HeapSize';

21
rtl/win/sysos.inc
View File

@ -275,14 +275,31 @@ type
function GetModuleHandle(p : PAnsiChar) : THandle; function GetModuleHandle(p : PAnsiChar) : THandle;
stdcall;external KernelDLL name 'GetModuleHandleA'; stdcall;external KernelDLL name 'GetModuleHandleA';
{ memory functions }
const
HEAP_ZERO_MEMORY = $8;
function GetProcessHeap : THandle;
{$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'GetProcessHeap';
function HeapAlloc(hHeap : THandle; dwFlags : DWord; dwBytes : SIZE_T) : pointer;
{$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'HeapAlloc';
function HeapFree(hHeap : THandle; dwFlags : dword; lpMem: pointer) : boolean;
{$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'HeapFree';
{$ifdef win64} {$ifdef win64}
{ all win64 versions have this function, including 64 bit XP } { all win64 versions have this function, including 64 bit XP }
function SetThreadStackGuarantee(StackSizeInBytes : PPtrUint) : BOOL; function SetThreadStackGuarantee(StackSizeInBytes : PUint32) : BOOL;
stdcall;external KernelDLL name 'SetThreadStackGuarantee'; stdcall;external KernelDLL name 'SetThreadStackGuarantee';
{$else win64} {$else win64}
var var
SetThreadStackGuarantee: function(StackSizeInBytes : PPtrUint) : BOOL; stdcall; SetThreadStackGuarantee: function(StackSizeInBytes : PUint32) : BOOL; stdcall;
{$endif win64} {$endif win64}
{ Helper to pass StackMargin. SetThreadStackGuarantee accepts PULONG (which is PUint32, not PPtrUint) and writes previous guarantee to the same place. }
procedure SetThreadStackGuaranteeTo(guarantee: uint32); inline;
begin
SetThreadStackGuarantee(@guarantee);
end;
{$else WINCE} {$else WINCE}
{ module functions } { module functions }

79
rtl/win/systhrd.inc
View File

@ -19,11 +19,6 @@
Local WINApi imports Local WINApi imports
*****************************************************************************} *****************************************************************************}
const
{ LocalAlloc flags }
LMEM_FIXED = 0;
LMEM_ZEROINIT = 64;
{$ifndef WINCE} {$ifndef WINCE}
function TlsAlloc : DWord; function TlsAlloc : DWord;
stdcall;external KernelDLL name 'TlsAlloc'; stdcall;external KernelDLL name 'TlsAlloc';
@ -40,9 +35,6 @@ function CreateThread(lpThreadAttributes : pointer;
{$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'CreateThread'; {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'CreateThread';
procedure ExitThread(dwExitCode : DWord); procedure ExitThread(dwExitCode : DWord);
{$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'ExitThread'; {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'ExitThread';
function LocalAlloc(uFlags:DWord; dwBytes:SIZE_T):Pointer;
{$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'LocalAlloc';
function LocalFree(hMem : Pointer):Pointer; {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'LocalFree';
procedure Sleep(dwMilliseconds: DWord); {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'Sleep'; procedure Sleep(dwMilliseconds: DWord); {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'Sleep';
function WinSuspendThread (threadHandle : THandle) : dword; {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'SuspendThread'; function WinSuspendThread (threadHandle : THandle) : dword; {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'SuspendThread';
function WinResumeThread (threadHandle : THandle) : dword; {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'ResumeThread'; function WinResumeThread (threadHandle : THandle) : dword; {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'ResumeThread';
@ -78,21 +70,10 @@ procedure WinLeaveCriticalSection(var cs : TRTLCriticalSection);
CONST CONST
WAIT_OBJECT_0 = 0; WAIT_OBJECT_0 = 0;
WAIT_ABANDONED_0 = $80;
WAIT_TIMEOUT = $102; WAIT_TIMEOUT = $102;
WAIT_IO_COMPLETION = $c0;
WAIT_ABANDONED = $80;
WAIT_FAILED = $ffffffff;
{$ifndef SUPPORT_WIN95}
function WinTryEnterCriticalSection(var cs : TRTLCriticalSection):longint; function WinTryEnterCriticalSection(var cs : TRTLCriticalSection):longint;
{$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'TryEnterCriticalSection'; {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'TryEnterCriticalSection';
{$else SUPPORT_WIN95}
type
TTryEnterCriticalSection = function(var cs : TRTLCriticalSection):longint; stdcall;
var
WinTryEnterCriticalSection : TTryEnterCriticalSection;
{$endif SUPPORT_WIN95}
{***************************************************************************** {*****************************************************************************
Threadvar support Threadvar support
@ -138,7 +119,7 @@ var
dataindex:=TlsGetValue(tlskey^); dataindex:=TlsGetValue(tlskey^);
if dataindex=nil then if dataindex=nil then
begin begin
dataindex:=pointer(LocalAlloc(LMEM_FIXED or LMEM_ZEROINIT,threadvarblocksize)); dataindex:=HeapAlloc(GetProcessHeap,HEAP_ZERO_MEMORY,threadvarblocksize);
if dataindex=nil then if dataindex=nil then
RunError(226); RunError(226);
TlsSetValue(tlskey^,dataindex); TlsSetValue(tlskey^,dataindex);
@ -194,8 +175,7 @@ var
if TLSKey^<>$ffffffff then if TLSKey^<>$ffffffff then
begin begin
p:=TlsGetValue(tlskey^); p:=TlsGetValue(tlskey^);
if Assigned(p) then HeapFree(GetProcessHeap,0,p); { HeapFree is OK with nil. }
LocalFree(p);
TlsSetValue(tlskey^, nil); TlsSetValue(tlskey^, nil);
end; end;
end; end;
@ -233,7 +213,7 @@ var
{$ifdef win32} {$ifdef win32}
if Assigned(SetThreadStackGuarantee) then if Assigned(SetThreadStackGuarantee) then
{$endif win32} {$endif win32}
SetThreadStackGuarantee(@StackMargin); SetThreadStackGuaranteeTo(StackMargin);
{$endif wince} {$endif wince}
end; end;
@ -375,10 +355,10 @@ var
var var
thrdinfo: THREADNAME_INFO; thrdinfo: THREADNAME_INFO;
begin begin
thrdinfo:=Default(THREADNAME_INFO);
thrdinfo.dwType:=$1000; thrdinfo.dwType:=$1000;
thrdinfo.szName:=@ThreadName[1]; thrdinfo.szName:=@ThreadName[1];
thrdinfo.dwThreadID:=threadHandle; thrdinfo.dwThreadID:=threadHandle;
thrdinfo.dwFlags:=0;
try try
RaiseException(MS_VC_EXCEPTION, 0, SizeOf(thrdinfo) div SizeOf(PtrUInt), @thrdinfo); RaiseException(MS_VC_EXCEPTION, 0, SizeOf(thrdinfo) div SizeOf(PtrUInt), @thrdinfo);
except except
@ -473,35 +453,6 @@ begin
WinEnterCriticalSection(PRTLCriticalSection(@cs)^); WinEnterCriticalSection(PRTLCriticalSection(@cs)^);
end; end;
{$ifdef SUPPORT_WIN95}
function Win95TryEnterCriticalSection(var cs : TRTLCriticalSection):longint;stdcall;
var
MyThreadID : DWORD;
begin
MyThreadId:=GetCurrentThreadId();
if InterlockedIncrement(cs.LockCount)=0 then
begin
cs.OwningThread:=MyThreadId;
cs.RecursionCount:=1;
result:=1;
end
else
begin
if cs.OwningThread=MyThreadId then
begin
InterlockedDecrement(cs.LockCount);
InterlockedIncrement(cs.RecursionCount);
result:=1;
end
else
begin
InterlockedDecrement(cs.LockCount);
result:=0;
end;
end;
end;
{$endif SUPPORT_WIN95}
function SysTryEnterCriticalSection(var cs):longint; function SysTryEnterCriticalSection(var cs):longint;
begin begin
result:=WinTryEnterCriticalSection(PRTLCriticalSection(@cs)^); result:=WinTryEnterCriticalSection(PRTLCriticalSection(@cs)^);
@ -521,14 +472,8 @@ Const
function intBasicEventCreate(EventAttributes : Pointer; function intBasicEventCreate(EventAttributes : Pointer;
AManualReset,InitialState : Boolean;const Name : ansistring):pEventState; AManualReset,InitialState : Boolean;const Name : ansistring):pEventState;
var
n : PAnsiChar;
begin begin
if Length(Name) = 0 then Result := PEventState(CreateEvent(EventAttributes, AManualReset, InitialState,Pointer(Name)));
n := Nil
else
n := PAnsiChar(Name);
Result := PEventState(CreateEvent(EventAttributes, AManualReset, InitialState,n));
end; end;
procedure intbasiceventdestroy(state:peventstate); procedure intbasiceventdestroy(state:peventstate);
@ -627,12 +572,10 @@ begin
end; end;
Var
WinThreadManager : TThreadManager;
Procedure InitSystemThreads;public name '_FPC_InitSystemThreads'; Procedure InitSystemThreads;public name '_FPC_InitSystemThreads';
{$ifndef WINCE}
var var
WinThreadManager : TThreadManager;
{$ifndef WINCE}
KernelHandle : THandle; KernelHandle : THandle;
{$endif} {$endif}
begin begin
@ -685,14 +628,6 @@ begin
KernelHandle:=GetModuleHandle(KernelDLL); KernelHandle:=GetModuleHandle(KernelDLL);
{$endif} {$endif}
{$IFDEF SUPPORT_WIN95}
{ Try to find TryEnterCriticalSection function }
if KernelHandle<>0 then
WinTryEnterCriticalSection:=TTryEnterCriticalSection(WinGetProcAddress(KernelHandle,'TryEnterCriticalSection'));
if not assigned(WinTryEnterCriticalSection) then
WinTryEnterCriticalSection:=@Win95TryEnterCriticalSection;
{$ENDIF SUPPORT_WIN95}
{$ifndef WINCE} {$ifndef WINCE}
if KernelHandle<>0 then if KernelHandle<>0 then
begin begin

2
rtl/win32/system.pp
View File

@ -628,7 +628,7 @@ initialization
StackBottom := StackTop - StackLength; StackBottom := StackTop - StackLength;
CodePointer(SetThreadStackGuarantee) := WinGetProcAddress(WinGetModuleHandleW(KernelDLL), 'SetThreadStackGuarantee'); CodePointer(SetThreadStackGuarantee) := WinGetProcAddress(WinGetModuleHandleW(KernelDLL), 'SetThreadStackGuarantee');
if Assigned(SetThreadStackGuarantee) then if Assigned(SetThreadStackGuarantee) then
SetThreadStackGuarantee(@StackMargin); SetThreadStackGuaranteeTo(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 }

2
rtl/win64/system.pp
View File

@ -485,7 +485,7 @@ initialization
{ pass dummy value } { pass dummy value }
StackLength := CheckInitialStkLen($1000000); StackLength := CheckInitialStkLen($1000000);
StackBottom := StackTop - StackLength; StackBottom := StackTop - StackLength;
SetThreadStackGuarantee(@StackMargin); SetThreadStackGuaranteeTo(StackMargin);
{ get some helpful informations } { get some helpful informations }
GetStartupInfo(@startupinfo); GetStartupInfo(@startupinfo);