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

* Some additional thread debugging statements

Browse Source
This commit is contained in:
Michaël Van Canneyt 2025-04-03 11:59:45 +02:00
parent fb126e32f9
commit a797828619
1 changed files with 21 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
rtl/wasicommon/tthread.inc
View File

@ -63,7 +63,7 @@ Var
LFreeOnTerminate : Boolean;
begin
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('In threadfunc. Thread object: '+IntToStr(PTrUint(LThread)));{$ENDIF}
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('In threadfunc. Thread object: '+IntToStr(PTrUint(LThread))+' thread id :'+IntToStr(ptrint(Lthread.FThreadID)));{$ENDIF}
try
if LThread.FInitialSuspended then
begin
@ -142,9 +142,11 @@ end;
procedure TThread.SysDestroy;
begin
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: enter');{$ENDIF}
{ exception in constructor }
if not assigned(FSuspendEvent) then
exit;
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: have suspendevent');{$ENDIF}
{ exception in constructor }
if (FHandle = TThreadID(0)) then
begin
@ -154,25 +156,40 @@ begin
{ Thread itself called destroy ? }
if (FThreadID = GetCurrentThreadID) then
begin
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: '+IntToStr(PtrInt(FThreadID))+' = '+IntToStr(PtrInt(GetCurrentThreadID)));{$ENDIF}
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: thread itself is freeing');{$ENDIF}
if not(FFreeOnTerminate) and not FFinished then
begin
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: error condition');{$ENDIF}
raise EThreadDestroyCalled.Create('A thread cannot destroy itself except by setting FreeOnTerminate and leaving!');
end;
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: clearing FreeOnTerminate');{$ENDIF}
FFreeOnTerminate := false;
end
else
begin
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: other thread is freeing');{$ENDIF}
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: '+IntToStr(PtrInt(FThreadID))+' = '+IntToStr(PtrInt(GetCurrentThreadID)));{$ENDIF}
{ avoid recursion}
FFreeOnTerminate := false;
{ you can't join yourself, so only for FThreadID<>GetCurrentThreadID }
{ and you can't join twice -> make sure we didn't join already }
if not FThreadReaped then
begin
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: reaping thread');{$ENDIF}
Terminate;
if (FSuspendedInternal or FInitialSuspended) then
begin
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: resuming thread in order to reap');{$ENDIF}
Resume;
end;
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: waiting on thread');{$ENDIF}
WaitFor;
end;
end;
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: destroying RTL suspend event');{$ENDIF}
RtlEventDestroy(FSuspendEvent);
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: freeing fatal exception if it exists');{$ENDIF}
FFatalException.Free;
FFatalException := nil;
end;
@ -188,6 +205,7 @@ begin
end
else
begin
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('resuming thread '+IntToStr(ptruint(self)));{$ENDIF}
{ don't compare with ord(true) or ord(longbool(true)), }
{ becaue a longbool's "true" value is anyting <> false }
if FSuspended and
@ -195,7 +213,8 @@ begin
begin
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('resuming '+IntToStr(ptruint(self)));{$ENDIF}
RtlEventSetEvent(FSuspendEvent);
end
end;
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('resumed thread '+IntToStr(ptruint(self)));{$ENDIF}
end
end;