paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 20:59:08 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDebug: debugln for Linux

Browse Source 
git-svn-id: trunk@61828 -
This commit is contained in:
martin 2019-09-08 18:52:33 +00:00
parent e393217c1c
commit 999d567e45
1 changed files with 44 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
components/fpdebug/fpdbglinuxclasses.pas
View File

@ -2,6 +2,7 @@ unit FpDbgLinuxClasses;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
{$packrecords c} {$packrecords c}
{off $define DebuglnLinuxDebugEvents}
interface interface
@ -427,6 +428,9 @@ begin
exit; exit;
result := fpkill(ID, SIGSTOP)=0; result := fpkill(ID, SIGSTOP)=0;
{$IFDEF DebuglnLinuxDebugEvents}
debugln('TDbgLinuxThread.RequestInternalPause fpkill(%d, SIGSTOP) => %s', [ID, dbgs(Result)]);
{$ENDIF}
if not result then if not result then
begin begin
// TODO: errChld -> remove thread // TODO: errChld -> remove thread
@ -978,6 +982,10 @@ var
PID: THandle; PID: THandle;
IP: TDBGPtr; IP: TDBGPtr;
begin begin
{$IFDEF DebuglnLinuxDebugEvents}
debuglnEnter(['>>>>> TDbgLinuxProcess.Continue TID:', AThread.ID, ' SingleStep:', SingleStep ]); try
{$ENDIF}
// Terminating process and all threads // Terminating process and all threads
if FIsTerminating then begin if FIsTerminating then begin
fpseterrno(0); fpseterrno(0);
@ -1006,6 +1014,9 @@ begin
while (ThreadToContinue.GetInstructionPointerRegisterValue = IP) do begin while (ThreadToContinue.GetInstructionPointerRegisterValue = IP) do begin
fpseterrno(0); fpseterrno(0);
{$IFDEF DebuglnLinuxDebugEvents}
Debugln(['Single-stepping other TID: ', ThreadToContinue.ID]);
{$ENDIF}
fpPTrace(PTRACE_SINGLESTEP, ThreadToContinue.ID, pointer(1), pointer(wstopsig(TDbgLinuxThread(ThreadToContinue).FExceptionSignal))); fpPTrace(PTRACE_SINGLESTEP, ThreadToContinue.ID, pointer(1), pointer(wstopsig(TDbgLinuxThread(ThreadToContinue).FExceptionSignal)));
TDbgLinuxThread(ThreadToContinue).ResetPauseStates; // So BeforeContinue will not run again TDbgLinuxThread(ThreadToContinue).ResetPauseStates; // So BeforeContinue will not run again
@ -1034,6 +1045,9 @@ begin
TDbgLinuxThread(AThread).FIsSteppingBreakPoint := True; TDbgLinuxThread(AThread).FIsSteppingBreakPoint := True;
fpseterrno(0); fpseterrno(0);
AThread.BeforeContinue; AThread.BeforeContinue;
{$IFDEF DebuglnLinuxDebugEvents}
Debugln(['Single-stepping current']);
{$ENDIF}
fpPTrace(PTRACE_SINGLESTEP, AThread.ID, pointer(1), pointer(wstopsig(TDbgLinuxThread(AThread).FExceptionSignal))); fpPTrace(PTRACE_SINGLESTEP, AThread.ID, pointer(1), pointer(wstopsig(TDbgLinuxThread(AThread).FExceptionSignal)));
TDbgLinuxThread(AThread).ResetPauseStates; TDbgLinuxThread(AThread).ResetPauseStates;
Result := CheckNoError; Result := CheckNoError;
@ -1048,6 +1062,9 @@ begin
if (ThreadToContinue.FHasExceptionSignal) then begin if (ThreadToContinue.FHasExceptionSignal) then begin
Assert(not ThreadToContinue.FIsInInternalPause, 'internal pause should not have deferred sig'); Assert(not ThreadToContinue.FIsInInternalPause, 'internal pause should not have deferred sig');
AThread.NextIsSingleStep:=False; // UNDO AThread.NextIsSingleStep:=False; // UNDO
{$IFDEF DebuglnLinuxDebugEvents}
debugln(['Exit for DEFERRED event TID', ThreadToContinue.Id]);
{$ENDIF}
exit; // WaitForDebugEvent will report the event // AThread will now be treaded as paused. exit; // WaitForDebugEvent will report the event // AThread will now be treaded as paused.
end; end;
@ -1057,6 +1074,9 @@ begin
for TDbgThread(ThreadToContinue) in FThreadMap do begin for TDbgThread(ThreadToContinue) in FThreadMap do begin
if (ThreadToContinue <> AThread) and (ThreadToContinue.FIsPaused) then begin if (ThreadToContinue <> AThread) and (ThreadToContinue.FIsPaused) then begin
fpseterrno(0); fpseterrno(0);
{$IFDEF DebuglnLinuxDebugEvents}
Debugln(['RUN other TID: ', ThreadToContinue.ID]);
{$ENDIF}
fpPTrace(PTRACE_CONT, ThreadToContinue.ID, pointer(1), pointer(wstopsig(ThreadToContinue.FExceptionSignal))); fpPTrace(PTRACE_CONT, ThreadToContinue.ID, pointer(1), pointer(wstopsig(ThreadToContinue.FExceptionSignal)));
CheckNoError; // only log CheckNoError; // only log
ThreadToContinue.ResetPauseStates; ThreadToContinue.ResetPauseStates;
@ -1066,6 +1086,9 @@ begin
if not FIsTerminating then begin if not FIsTerminating then begin
fpseterrno(0); fpseterrno(0);
//AThread.BeforeContinue; //AThread.BeforeContinue;
{$IFDEF DebuglnLinuxDebugEvents}
Debugln(['RUN ']);
{$ENDIF}
if SingleStep then if SingleStep then
fpPTrace(PTRACE_SINGLESTEP, AThread.ID, pointer(1), pointer(wstopsig(TDbgLinuxThread(AThread).FExceptionSignal))) fpPTrace(PTRACE_SINGLESTEP, AThread.ID, pointer(1), pointer(wstopsig(TDbgLinuxThread(AThread).FExceptionSignal)))
else else
@ -1076,6 +1099,9 @@ begin
if not FThreadMap.HasId(AThread.ID) then if not FThreadMap.HasId(AThread.ID) then
AThread.Free; AThread.Free;
{$IFDEF DebuglnLinuxDebugEvents}
finally debuglnExit(['<<<<< TDbgLinuxProcess.Continue ' ]); end;
{$ENDIF}
end; end;
function TDbgLinuxProcess.WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean; function TDbgLinuxProcess.WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean;
@ -1113,6 +1139,9 @@ begin
DebugLn(DBG_WARNINGS, 'ThreadID of main thread does not match the ProcessID'); DebugLn(DBG_WARNINGS, 'ThreadID of main thread does not match the ProcessID');
ProcessIdentifier := ProcessID; ProcessIdentifier := ProcessID;
{$IFDEF DebuglnLinuxDebugEvents}
debugln(['##### GOT EVENT FOR ',pid, ' st ', FStatus]);
{$ENDIF}
end; end;
end; end;
@ -1257,12 +1286,16 @@ begin
TDbgLinuxThread(AThread).FIsSteppingBreakPoint := False; TDbgLinuxThread(AThread).FIsSteppingBreakPoint := False;
if Result in [deException, deBreakpoint, deFinishedStep] then begin // deFinishedStep will not be set here if Result in [deException, deBreakpoint, deFinishedStep] then begin // deFinishedStep will not be set here
{$IFDEF DebuglnLinuxDebugEvents}
debuglnenter('STOP ALL THREADS');
{$ENDIF}
// Signal all other threads to pause // Signal all other threads to pause
for TDbgThread(ThreadToPause) in FThreadMap do begin for TDbgThread(ThreadToPause) in FThreadMap do begin
if (ThreadToPause <> AThread) and (not ThreadToPause.FIsPaused) then begin if (ThreadToPause <> AThread) and (not ThreadToPause.FIsPaused) then begin
// Check if any thread is already interrupted // Check if any thread is already interrupted
ThreadSignaled := WaitForThread(WaitStatus, True); ThreadSignaled := WaitForThread(WaitStatus, True);
while ThreadSignaled <> nil do begin while ThreadSignaled <> nil do begin
if not ThreadSignaled.FIsPaused then if not ThreadSignaled.FIsPaused then
ThreadSignaled.CheckStatusReceived(WaitStatus); ThreadSignaled.CheckStatusReceived(WaitStatus);
@ -1277,12 +1310,23 @@ begin
ThreadSignaled := WaitForThread(WaitStatus, False); ThreadSignaled := WaitForThread(WaitStatus, False);
if (ThreadSignaled <> nil) and (not ThreadSignaled.FIsPaused) then if (ThreadSignaled <> nil) and (not ThreadSignaled.FIsPaused) then
ThreadSignaled.CheckStatusReceived(WaitStatus); ThreadSignaled.CheckStatusReceived(WaitStatus);
DebugLn(DBG_VERBOSE and (not ThreadToPause.FIsPaused), ['Re-Request Internal pause for ', ThreadToPause.ID]);
end; end;
end; end;
end; end;
{$IFDEF DebuglnLinuxDebugEvents}
debuglnexit('<<');
{$ENDIF}
end; end;
{$IFDEF DebuglnLinuxDebugEvents}
for TDbgThread(ThreadToPause) in FThreadMap do
debugln([ThreadToPause.id, ' =athrd:', ThreadToPause = AThread, ' psd:', ThreadToPause.FIsPaused,ThreadToPause.FIsInInternalPause,' has:',ThreadToPause.FHasExceptionSignal, ' exs:', ThreadToPause.FExceptionSignal]);
debugln('<<<<<<<<<<<<<<<<<<<<<<<<');
{$ENDIF}
end; end;
initialization initialization