paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-05 02:18:59 +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; LFreeOnTerminate : Boolean;
begin 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 try
if LThread.FInitialSuspended then if LThread.FInitialSuspended then
begin begin
@ -142,9 +142,11 @@ end;
procedure TThread.SysDestroy; procedure TThread.SysDestroy;
begin begin
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: enter');{$ENDIF}
{ exception in constructor } { exception in constructor }
if not assigned(FSuspendEvent) then if not assigned(FSuspendEvent) then
exit; exit;
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: have suspendevent');{$ENDIF}
{ exception in constructor } { exception in constructor }
if (FHandle = TThreadID(0)) then if (FHandle = TThreadID(0)) then
begin begin
@ -154,25 +156,40 @@ begin
{ Thread itself called destroy ? } { Thread itself called destroy ? }
if (FThreadID = GetCurrentThreadID) then if (FThreadID = GetCurrentThreadID) then
begin 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 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!'); 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; FFreeOnTerminate := false;
end end
else else
begin 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} { avoid recursion}
FFreeOnTerminate := false; FFreeOnTerminate := false;
{ you can't join yourself, so only for FThreadID<>GetCurrentThreadID } { you can't join yourself, so only for FThreadID<>GetCurrentThreadID }
{ and you can't join twice -> make sure we didn't join already } { and you can't join twice -> make sure we didn't join already }
if not FThreadReaped then if not FThreadReaped then
begin begin
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: reaping thread');{$ENDIF}
Terminate; Terminate;
if (FSuspendedInternal or FInitialSuspended) then if (FSuspendedInternal or FInitialSuspended) then
begin
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: resuming thread in order to reap');{$ENDIF}
Resume; Resume;
end;
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: waiting on thread');{$ENDIF}
WaitFor; WaitFor;
end; end;
end; end;
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: destroying RTL suspend event');{$ENDIF}
RtlEventDestroy(FSuspendEvent); RtlEventDestroy(FSuspendEvent);
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: freeing fatal exception if it exists');{$ENDIF}
FFatalException.Free; FFatalException.Free;
FFatalException := nil; FFatalException := nil;
end; end;
@ -188,6 +205,7 @@ begin
end end
else else
begin begin
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('resuming thread '+IntToStr(ptruint(self)));{$ENDIF}
{ don't compare with ord(true) or ord(longbool(true)), } { don't compare with ord(true) or ord(longbool(true)), }
{ becaue a longbool's "true" value is anyting <> false } { becaue a longbool's "true" value is anyting <> false }
if FSuspended and if FSuspended and
@ -195,7 +213,8 @@ begin
begin begin
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('resuming '+IntToStr(ptruint(self)));{$ENDIF} {$IFDEF DEBUGWASMTHREADS}DebugWriteln('resuming '+IntToStr(ptruint(self)));{$ENDIF}
RtlEventSetEvent(FSuspendEvent); RtlEventSetEvent(FSuspendEvent);
end end;
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('resumed thread '+IntToStr(ptruint(self)));{$ENDIF}
end end
end; end;