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

Fpdebug: for qemu one needs to single step over a breakpoint before continue will work.

Browse Source
This commit is contained in:
ccrause 2024-01-28 12:41:52 +02:00 committed by Martin
parent 5213bd9c76
commit ceb2b0340b
1 changed files with 25 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
components/fpdebug/fpdbgrspclasses.pas
View File

@ -526,12 +526,24 @@ begin
end; 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);
var
res: boolean;
s: string;
begin
res := RspConnection.SingleStep();
TDbgRspThread(TheThread).ResetPauseStates; // So BeforeContinue will not run again
TDbgRspThread(TheThread).FIsPaused := True;
if res then
RspConnection.WaitForSignal(s)
else
DebugLn(DBG_WARNINGS, ['Error local single stepping thread ', TheThread.ID]);
end;
var var
ThreadToContinue: TDbgRspThread; ThreadToContinue: TDbgRspThread;
PC: word; PC: word;
s: string;
tempState: integer;
initRegs: TInitializedRegisters;
begin begin
// Terminating process and all threads // Terminating process and all threads
if FIsTerminating or (FStatus = SIGHUP) then if FIsTerminating or (FStatus = SIGHUP) then
@ -559,23 +571,8 @@ begin
TempRemoveBreakInstructionCode(PC); TempRemoveBreakInstructionCode(PC);
ThreadToContinue.BeforeContinue; ThreadToContinue.BeforeContinue;
while (ThreadToContinue.GetInstructionPointerRegisterValue = PC) do if (ThreadToContinue.GetInstructionPointerRegisterValue = PC) then
begin DoLocalStep(ThreadToContinue);
result := RspConnection.SingleStep();
TDbgRspThread(ThreadToContinue).ResetPauseStates; // So BeforeContinue will not run again
ThreadToContinue.FIsPaused := True;
if result then
begin
tempState := RspConnection.WaitForSignal(s); // TODO: Update registers cache for this thread
if (tempState = SIGTRAP) then
break; // if the command jumps back an itself....
end
else
begin
DebugLn(DBG_WARNINGS, ['Error single stepping other thread ', ThreadToContinue.ID]);
break;
end;
end;
end; end;
end; end;
@ -609,11 +606,15 @@ begin
if not FIsTerminating then if not FIsTerminating then
begin begin
AThread.BeforeContinue; AThread.BeforeContinue;
if SingleStep then
result := RspConnection.SingleStep() // In qemu, needs to step over breakpoint for continue command to work
else DoLocalStep(AThread);
if not SingleStep then
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;
@ -624,7 +625,6 @@ end;
function TDbgRspProcess.WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean; function TDbgRspProcess.WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean;
var var
s: string; s: string;
initRegs: TInitializedRegisters;
begin begin
debugln(DBG_VERBOSE, ['Entering WaitForDebugEvent, FStatus = ', FStatus]); debugln(DBG_VERBOSE, ['Entering WaitForDebugEvent, FStatus = ', FStatus]);
// Currently only single process/thread // Currently only single process/thread