mirror of https://gitlab.com/basile.b/dexed.git
#97, allow to add breakpoints while the inferior runs
This commit is contained in:
parent
33bee887bb
commit
3eebc99a7e
|
@ -412,6 +412,7 @@ type
|
||||||
fInspState: TInspectableCPU;
|
fInspState: TInspectableCPU;
|
||||||
fStackItems: TStackItems;
|
fStackItems: TStackItems;
|
||||||
fCatchPause: boolean;
|
fCatchPause: boolean;
|
||||||
|
fSilentPause: boolean;
|
||||||
fOptions: TCEDebugOptions;
|
fOptions: TCEDebugOptions;
|
||||||
fAddWatchPointKind: TAddWatchPointKind;
|
fAddWatchPointKind: TAddWatchPointKind;
|
||||||
fBreakPoints: TPersistentBreakPoints;
|
fBreakPoints: TPersistentBreakPoints;
|
||||||
|
@ -420,6 +421,8 @@ type
|
||||||
fLastFunction: string;
|
fLastFunction: string;
|
||||||
fLastOffset: string;
|
fLastOffset: string;
|
||||||
fLastLine: string;
|
fLastLine: string;
|
||||||
|
fCommandProcessed: boolean;
|
||||||
|
procedure waitCommandProcessed;
|
||||||
procedure clearDisplays;
|
procedure clearDisplays;
|
||||||
procedure updateMenu;
|
procedure updateMenu;
|
||||||
procedure optionsChangesApplied(sender: TObject);
|
procedure optionsChangesApplied(sender: TObject);
|
||||||
|
@ -666,7 +669,6 @@ end;
|
||||||
{$ENDREGION}
|
{$ENDREGION}
|
||||||
|
|
||||||
{$REGION TPersistentBreakpoints ------------------------------------------------}
|
{$REGION TPersistentBreakpoints ------------------------------------------------}
|
||||||
|
|
||||||
constructor TPersistentBreakPoints.create(aOwner: TComponent);
|
constructor TPersistentBreakPoints.create(aOwner: TComponent);
|
||||||
var
|
var
|
||||||
fname: string;
|
fname: string;
|
||||||
|
@ -1280,24 +1282,79 @@ begin
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TCEGdbWidget.waitCommandProcessed;
|
||||||
|
var
|
||||||
|
i: integer = 0;
|
||||||
|
begin
|
||||||
|
while not fCommandProcessed do
|
||||||
|
begin
|
||||||
|
application.ProcessMessages;
|
||||||
|
i += 1;
|
||||||
|
if i = high(integer) then
|
||||||
|
i := 0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TCEGdbWidget.addBreakPoint(const fname: string; line: integer;
|
procedure TCEGdbWidget.addBreakPoint(const fname: string; line: integer;
|
||||||
kind: TBreakPointKind = bpkBreak);
|
kind: TBreakPointKind = bpkBreak);
|
||||||
|
var
|
||||||
|
r: boolean;
|
||||||
begin
|
begin
|
||||||
if assigned(fBreakPoints) then
|
if assigned(fBreakPoints) then
|
||||||
fBreakPoints.addItem(fname, line, kind);
|
fBreakPoints.addItem(fname, line, kind);
|
||||||
if fGdb.isNil or not fGdb.Running then
|
if fGdb.isNil or not fGdb.Running then
|
||||||
exit;
|
exit;
|
||||||
|
r := fGdbState = gsRunning;
|
||||||
|
if r then
|
||||||
|
begin
|
||||||
|
// TODO-cGDB: follow state of https://sourceware.org/bugzilla/show_bug.cgi?id=18077
|
||||||
|
// "async mode" is not activated until a break is triggered.
|
||||||
|
// The action for the "pause" button is also affected.
|
||||||
|
// The problem exist still in GDB 7.12
|
||||||
|
fSilentPause := true;
|
||||||
|
gdbCommand('-exec-interrupt --all', @gdboutJsonize);
|
||||||
|
waitCommandProcessed;
|
||||||
|
fSilentPause := false;
|
||||||
|
end;
|
||||||
gdbCommand('break ' + fname + ':' + intToStr(line));
|
gdbCommand('break ' + fname + ':' + intToStr(line));
|
||||||
|
if r then
|
||||||
|
waitCommandProcessed;
|
||||||
|
if r then
|
||||||
|
begin
|
||||||
|
fSilentPause := true;
|
||||||
|
gdbCommand('-exec-continue --all', @gdboutJsonize);
|
||||||
|
waitCommandProcessed;
|
||||||
|
fSilentPause := false;
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCEGdbWidget.removeBreakPoint(const fname: string; line: integer;
|
procedure TCEGdbWidget.removeBreakPoint(const fname: string; line: integer;
|
||||||
kind: TBreakPointKind = bpkBreak);
|
kind: TBreakPointKind = bpkBreak);
|
||||||
|
var
|
||||||
|
r: boolean;
|
||||||
begin
|
begin
|
||||||
if assigned(fBreakPoints) then
|
if assigned(fBreakPoints) then
|
||||||
fBreakPoints.deleteItem(fname, line, kind);
|
fBreakPoints.deleteItem(fname, line, kind);
|
||||||
if fGdb.isNil or not fGdb.Running then
|
if fGdb.isNil or not fGdb.Running then
|
||||||
exit;
|
exit;
|
||||||
|
r := fGdbState = gsRunning;
|
||||||
|
if r then
|
||||||
|
begin
|
||||||
|
fSilentPause := true;
|
||||||
|
gdbCommand('-exec-interrupt --all', @gdboutJsonize);
|
||||||
|
waitCommandProcessed;
|
||||||
|
fSilentPause := false;
|
||||||
|
end;
|
||||||
gdbCommand('clear ' + fname + ':' + intToStr(line));
|
gdbCommand('clear ' + fname + ':' + intToStr(line));
|
||||||
|
if r then
|
||||||
|
waitCommandProcessed;
|
||||||
|
if r then
|
||||||
|
begin
|
||||||
|
fSilentPause := true;
|
||||||
|
gdbCommand('-exec-continue --all', @gdboutJsonize);
|
||||||
|
waitCommandProcessed;
|
||||||
|
fSilentPause := false;
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCEGdbWidget.setState(value: TGdbState);
|
procedure TCEGdbWidget.setState(value: TGdbState);
|
||||||
|
@ -1863,7 +1920,7 @@ begin
|
||||||
readOutput;
|
readOutput;
|
||||||
subjDebugBreak(fSubj, fLastFilename, line, dbSignal);
|
subjDebugBreak(fSubj, fLastFilename, line, dbSignal);
|
||||||
end
|
end
|
||||||
else
|
else if not fSilentPause then
|
||||||
begin
|
begin
|
||||||
if dlgYesNo(format('The signal %s (%s) was received on line %d of file %s .'
|
if dlgYesNo(format('The signal %s (%s) was received on line %d of file %s .'
|
||||||
+ LineEnding + 'Do you wish to pause execution ?', [signame, sigmean, line, fLastFilename]),
|
+ LineEnding + 'Do you wish to pause execution ?', [signame, sigmean, line, fLastFilename]),
|
||||||
|
@ -2088,6 +2145,7 @@ procedure TCEGdbWidget.gdboutJsonize(sender: TObject);
|
||||||
var
|
var
|
||||||
str: string;
|
str: string;
|
||||||
begin
|
begin
|
||||||
|
fCommandProcessed := true;
|
||||||
if fMsg = nil then
|
if fMsg = nil then
|
||||||
exit;
|
exit;
|
||||||
|
|
||||||
|
@ -2137,6 +2195,7 @@ end;
|
||||||
|
|
||||||
procedure TCEGdbWidget.gdboutQuiet(sender: TObject);
|
procedure TCEGdbWidget.gdboutQuiet(sender: TObject);
|
||||||
begin
|
begin
|
||||||
|
fCommandProcessed := true;
|
||||||
fGdb.OutputStack.Clear;
|
fGdb.OutputStack.Clear;
|
||||||
fGdb.OnReadData:=@gdboutJsonize;
|
fGdb.OnReadData:=@gdboutJsonize;
|
||||||
end;
|
end;
|
||||||
|
@ -2147,6 +2206,7 @@ procedure TCEGdbWidget.gdbCommand(aCommand: string; gdbOutProcessor: TNotifyEven
|
||||||
begin
|
begin
|
||||||
if fGdb.isNil or not fGdb.Running then
|
if fGdb.isNil or not fGdb.Running then
|
||||||
exit;
|
exit;
|
||||||
|
fCommandProcessed := false;
|
||||||
aCommand += #10;
|
aCommand += #10;
|
||||||
if assigned(gdbOutProcessor) then
|
if assigned(gdbOutProcessor) then
|
||||||
fGdb.OnReadData := gdbOutProcessor;
|
fGdb.OnReadData := gdbOutProcessor;
|
||||||
|
|
Loading…
Reference in New Issue