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

Merge branch 'fixes-fpdbgrspclasses' into 'main'

Browse Source 
Fixes fpdbgrspclasses

See merge request freepascal.org/lazarus/lazarus!269
This commit is contained in:
Martin 2024-02-06 13:34:41 +00:00
commit 69f6fa4ec1
1 changed files with 16 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
components/fpdebug/fpdbgrspclasses.pas
View File

@ -74,6 +74,7 @@ type
FRegArrayLength: integer; FRegArrayLength: integer;
function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; override; function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; override;
function CreateWatchPointData: TFpWatchPointData; override;
procedure InitializeLoaders; override; procedure InitializeLoaders; override;
// Insert/Delete break points on target // Insert/Delete break points on target
// TODO: if target doesn't support break points or have limited break points // TODO: if target doesn't support break points or have limited break points
@ -527,7 +528,7 @@ end;
function TDbgRspProcess.Continue(AProcess: TDbgProcess; AThread: TDbgThread; SingleStep: boolean): boolean; function TDbgRspProcess.Continue(AProcess: TDbgProcess; AThread: TDbgThread; SingleStep: boolean): boolean;
procedure DoLocalStep(TheThread: TDbgThread); function DoLocalStep(TheThread: TDbgThread): Integer;
var var
res: boolean; res: boolean;
s: string; s: string;
@ -536,9 +537,12 @@ function TDbgRspProcess.Continue(AProcess: TDbgProcess; AThread: TDbgThread; Sin
TDbgRspThread(TheThread).ResetPauseStates; // So BeforeContinue will not run again TDbgRspThread(TheThread).ResetPauseStates; // So BeforeContinue will not run again
TDbgRspThread(TheThread).FIsPaused := True; TDbgRspThread(TheThread).FIsPaused := True;
if res then if res then
RspConnection.WaitForSignal(s) Result := RspConnection.WaitForSignal(s)
else else
begin
DebugLn(DBG_WARNINGS, ['Error local single stepping thread ', TheThread.ID]); DebugLn(DBG_WARNINGS, ['Error local single stepping thread ', TheThread.ID]);
Result := -1;
end;
end; end;
var var
@ -572,7 +576,9 @@ begin
ThreadToContinue.BeforeContinue; ThreadToContinue.BeforeContinue;
if (ThreadToContinue.GetInstructionPointerRegisterValue = PC) then if (ThreadToContinue.GetInstructionPointerRegisterValue = PC) then
DoLocalStep(ThreadToContinue); repeat
FStatus := DoLocalStep(ThreadToContinue);
until (FStatus = -1) or (FStatus = SIGTRAP);
end; end;
end; end;
@ -608,15 +614,15 @@ begin
AThread.BeforeContinue; AThread.BeforeContinue;
// In qemu, needs to step over breakpoint for continue command to work // In qemu, needs to step over breakpoint for continue command to work
DoLocalStep(AThread); FStatus := DoLocalStep(AThread);
if not SingleStep then if not SingleStep then
begin begin
result := RspConnection.Continue(); result := RspConnection.Continue();
TDbgRspThread(AThread).ResetPauseStates; TDbgRspThread(AThread).ResetPauseStates;
end;
FStatus := 0; // should update status by calling WaitForSignal FStatus := 0; // should update status by calling WaitForSignal
end; end;
end;
if not FThreadMap.HasId(AThread.ID) then if not FThreadMap.HasId(AThread.ID) then
AThread.Free; AThread.Free;
@ -812,6 +818,11 @@ begin
end; end;
end; end;
function TDbgRspProcess.CreateWatchPointData: TFpWatchPointData;
begin
Result := TFpRspWatchPointData.Create;
end;
initialization initialization
DBG_VERBOSE := DebugLogger.FindOrRegisterLogGroup('DBG_VERBOSE' {$IFDEF DBG_VERBOSE} , True {$ENDIF} ); DBG_VERBOSE := DebugLogger.FindOrRegisterLogGroup('DBG_VERBOSE' {$IFDEF DBG_VERBOSE} , True {$ENDIF} );
DBG_WARNINGS := DebugLogger.FindOrRegisterLogGroup('DBG_WARNINGS' {$IFDEF DBG_WARNINGS} , True {$ENDIF} ); DBG_WARNINGS := DebugLogger.FindOrRegisterLogGroup('DBG_WARNINGS' {$IFDEF DBG_WARNINGS} , True {$ENDIF} );