forks
/
dexed
mirror of https://gitlab.com/basile.b/dexed.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

debugger: only use the central BP database 

debugger: parses internal GDB messages as CLI
This commit is contained in:
Basile Burg 2017-09-03 12:13:44 +02:00
parent 3e20fc1f88
commit 84f9988c72
No known key found for this signature in database
GPG Key ID: 1868039F415CB8CF
3 changed files with 72 additions and 140 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/ce_dbgitf.pas
View File

@ -10,6 +10,7 @@ uses
type
TBreakPointKind = (
bpkNone, // nothing
bpkBreak, // break point
bpkWatch // watch point
);
@ -21,6 +22,7 @@ type
function running: boolean;
procedure addBreakPoint(const fname: string; line: integer; kind: TBreakPointKind = bpkBreak);
procedure removeBreakPoint(const fname: string; line: integer; kind: TBreakPointKind = bpkBreak);
procedure removeBreakPoints(const fname: string);
end;
// Enumerates th e reason why debuging breaks.
@ -40,11 +42,6 @@ type
procedure debugStart(debugger: ICEDebugger);
// a debugging session terminates. Any pointer to a ICEDebugger becomes invalid.
procedure debugStop;
// the debuger wants to know how many times debugQueryBreakPoints must be called.
function debugQueryBpCount: integer;
// the debuger wants breakpoints.
procedure debugQueryBreakPoint(const index: integer; out fname: string;
out line: integer; out kind: TBreakPointKind);
// a break happens when code in fname at line is executed.
procedure debugBreak(const fname: string; line: integer; reason: TCEDebugBreakReason);
// debugging continue

102
src/ce_gdb.pas
View File

@ -444,6 +444,8 @@ type
protected
procedure setToolBarFlat(value: boolean); override;
private
fSynchronizedDocuments: TStringList;
fSynchronizingBreakpoints: boolean;
fSyms: ICESymStringExpander;
fExe: string;
fOutputName: string;
@ -485,9 +487,7 @@ type
procedure updateButtonsState;
procedure startDebugging;
procedure killGdb;
procedure storeObserversBreakpoints;
procedure updateDebugeeOptionsEditor;
procedure synchronizeBreakpointsFromDoc;
procedure deleteRedirectedIO;
// GDB output processors
procedure gdboutQuiet(sender: TObject);
@ -525,6 +525,7 @@ type
kind: TBreakPointKind = bpkBReak);
procedure removeBreakPoint(const fname: string; line: integer;
kind: TBreakPointKind = bpkBreak);
procedure removeBreakPoints(const fname: string);
procedure executeFromShortcut(sender: TObject);
public
constructor create(aOwner: TComponent); override;
@ -1173,6 +1174,7 @@ begin
Edit1.Items.Assign(fOptions.commandsHistory);
fAddWatchPointKind := wpkWrite;
fBreakPoints := TPersistentBreakPoints.create(self);
fSynchronizedDocuments := TStringList.Create;
TCEListViewCopyMenu.create(lstCallStack);
TCEListViewCopyMenu.create(lstAsm);
@ -1195,6 +1197,7 @@ begin
fInspState.Free;
fJson.Free;
fStackItems.Free;
fSynchronizedDocuments.Free;
EntitiesConnector.removeObserver(self);
fSubj.free;
inherited;
@ -1406,11 +1409,22 @@ begin
end;
procedure TCEGdbWidget.docFocused(document: TCESynMemo);
var
i: integer;
b: TPersistentBreakPoint;
begin
fDoc := document;
if fGdbState = gsNone then
updateDebugeeOptionsEditor;
synchronizeBreakpointsFromDoc;
fSynchronizingBreakpoints:= true;
if fSynchronizedDocuments.IndexOf(document.fileName) = -1 then
for i:= 0 to fBreakPoints.count-1 do
begin
b := fBreakPoints.item[i];
if b.filename = fDoc.fileName then
fDoc.addBreakpoint(b.line);
end;
fSynchronizingBreakpoints:= false;
end;
procedure TCEGdbWidget.docChanged(document: TCESynMemo);
@ -1418,9 +1432,14 @@ begin
end;
procedure TCEGdbWidget.docClosing(document: TCESynMemo);
var
i: integer;
begin
if fDoc <> document then
exit;
i := fSynchronizedDocuments.IndexOf(fDoc.fileName);
if i <> -1 then
fSynchronizedDocuments.delete(i);
fDoc := nil;
if fGdbState = gsNone then
updateDebugeeOptionsEditor;
@ -1451,25 +1470,6 @@ begin
updateDebugeeOptionsEditor;
end;
procedure TCEGdbWidget.storeObserversBreakpoints;
var
i,j: integer;
obs: ICEDebugObserver;
nme: string;
lne: integer;
knd: TBreakPointKind;
begin
for i:= 0 to fSubj.observersCount-1 do
begin
obs := fSubj.observers[i] as ICEDebugObserver;
for j := 0 to obs.debugQueryBpCount-1 do
begin
obs.debugQueryBreakPoint(j, nme, lne, knd);
fBreakPoints.addItem(nme, lne, knd);
end;
end;
end;
procedure TCEGdbWidget.waitCommandProcessed;
var
i: integer = 0;
@ -1489,6 +1489,8 @@ var
r: boolean;
a: boolean = false;
begin
if fSynchronizingBreakpoints then
exit;
if assigned(fBreakPoints) then
a := fBreakPoints.addItem(fname, line, kind);
if not a or fGdb.isNil or not fGdb.Running then
@ -1537,6 +1539,11 @@ begin
end;
end;
procedure TCEGdbWidget.removeBreakPoints(const fname: string);
begin
fBreakPoints.clearFile(fname);
end;
procedure TCEGdbWidget.setState(value: TGdbState);
begin
if fGdbState = value then
@ -1713,7 +1720,6 @@ begin
fGdb.OnTerminate:= @gdboutJsonize;
fgdb.execute;
// file:line breakpoints
storeObserversBreakpoints;
for i:= 0 to fBreakPoints.Count-1 do
begin
b := fBreakPoints[i];
@ -1806,46 +1812,6 @@ begin
end;
end;
procedure TCEGdbWidget.synchronizeBreakpointsFromDoc;
var
i: integer;
c: integer;
j: integer;
l: integer;
k: TBreakPointKind;
s: string;
b: boolean;
f: ICEDebugObserver;
begin
if fDoc.isNil then
exit;
f := fDoc as ICEDebugObserver;
if not assigned(f) then
exit;
c := f.debugQueryBpCount;
if c <> 0 then
begin
for i := fBreakPoints.count-1 downto 0 do
begin
b := false;
if not (fBreakPoints[i].filename = fDoc.fileName) then
continue;
for j := 0 to c-1 do
begin
f.debugQueryBreakPoint(j, s, l, k);
if l = fBreakPoints[i].line then
begin
b := true;
break;
end;
end;
if not b then
fBreakPoints.items.Delete(i);
end;
end
else fBreakPoints.clearFile(fDoc.fileName);
end;
procedure TCEGdbWidget.deleteRedirectedIO;
begin
if fOptions.keepRedirectedStreams then
@ -2043,9 +2009,7 @@ begin
// internal gdb messages
'&':
begin
rng.popUntil(#10);
if not rng.empty then
rng.popFront;
parseCLI(json, rng.popFront);
end;
// async notify / status / out stream when remote (@)
'=', '+','@':
@ -2243,6 +2207,7 @@ begin
subjDebugStop(fSubj);
deleteRedirectedIO;
updateDebugeeOptionsEditor;
killGdb;
end;
end;
@ -2428,7 +2393,7 @@ begin
fShowFromCustomCommand := false;
if fJson.findArray('CLI', arr) then
for i := 0 to arr.Count-1 do
fMsg.message(arr.Strings[i], nil, amcMisc, amkBub);
fMsg.message(arr.Strings[i], nil, amcMisc, amkAuto);
end;
end;
@ -2518,7 +2483,7 @@ end;
procedure TCEGdbWidget.infoVariables;
begin
gdbCommand('-stack-list-variables --skip-unavailable --simple-values');
gdbCommand('-stack-list-variables --skip-unavailable --all-values');
end;
procedure TCEGdbWidget.infoThreads;
@ -2604,6 +2569,7 @@ begin
setState(gsNone);
deleteRedirectedIO;
updateDebugeeOptionsEditor;
killGdb;
end;
procedure TCEGdbWidget.btnWatchClick(Sender: TObject);

103
src/ce_synmemo.pas
View File

@ -82,8 +82,6 @@ type
fFontSize: Integer;
fSourceFilename: string;
procedure setFolds(someFolds: TCollection);
procedure writeBreakpoints(str: TStream);
procedure readBreakpoints(str: TStream);
published
property caretPosition: Integer read fCaretPosition write fCaretPosition;
property sourceFilename: string read fSourceFilename write fSourceFilename;
@ -93,8 +91,6 @@ type
public
constructor create(aComponent: TComponent); override;
destructor destroy; override;
procedure DefineProperties(Filer: TFiler); override;
//
procedure beforeSave; override;
procedure afterLoad; override;
procedure save;
@ -204,7 +200,6 @@ type
fD2Highlighter: TSynD2Syn;
fTxtHighlighter: TSynTxtSyn;
fImages: TImageList;
fBreakPoints: TFPList;
fMatchSelectionOpts: TSynSearchOptions;
fMatchIdentOpts: TSynSearchOptions;
fMatchOpts: TIdentifierMatchOptions;
@ -282,18 +277,15 @@ type
procedure patchClipboardIndentation;
//
procedure gutterClick(Sender: TObject; X, Y, Line: integer; mark: TSynEditMark);
procedure addBreakPoint(line: integer);
procedure removeBreakPoint(line: integer);
procedure removeDebugTimeMarks;
function findBreakPoint(line: integer): boolean;
procedure debugStart(debugger: ICEDebugger);
procedure debugStop;
procedure debugContinue;
function debugQueryBpCount: integer;
procedure debugQueryBreakPoint(const index: integer; out fname: string; out line: integer; out kind: TBreakPointKind);
procedure debugQueryBreakPoint(const line: integer; out fname: string; out kind: TBreakPointKind);
procedure debugBreak(const fname: string; line: integer; reason: TCEDebugBreakReason);
function breakPointsCount: integer;
function breakPointLine(index: integer): integer;
protected
procedure DoEnter; override;
procedure DoExit; override;
@ -322,6 +314,8 @@ type
procedure save;
procedure saveTempFile;
//
procedure addBreakPoint(line: integer);
procedure removeBreakPoint(line: integer);
procedure curlyBraceCloseAndIndent;
procedure insertLeadingDDocSymbol(c: char);
procedure commentSelection;
@ -576,42 +570,11 @@ begin
inherited;
end;
procedure TCESynMemoCache.DefineProperties(Filer: TFiler);
begin
inherited;
Filer.DefineBinaryProperty('breakpoints', @readBreakpoints, @writeBreakpoints, true);
end;
procedure TCESynMemoCache.setFolds(someFolds: TCollection);
begin
fFolds.Assign(someFolds);
end;
procedure TCESynMemoCache.writeBreakpoints(str: TStream);
var
i: integer;
begin
if fMemo.isNil then exit;
{$HINTS OFF}
for i:= 0 to fMemo.fBreakPoints.Count-1 do
str.Write(PtrUint(fMemo.fBreakPoints.Items[i]), sizeOf(PtrUint));
{$HINTS ON}
end;
procedure TCESynMemoCache.readBreakpoints(str: TStream);
var
i, cnt: integer;
line: ptrUint = 0;
begin
if fMemo.isNil then exit;
cnt := str.Size div sizeOf(PtrUint);
for i := 0 to cnt-1 do
begin
str.Read(line, sizeOf(line));
fMemo.addBreakPoint(line);
end;
end;
procedure TCESynMemoCache.beforeSave;
var
i, start, prev: Integer;
@ -941,7 +904,6 @@ begin
fImages.AddResourceName(HINSTANCE, 'STEP');
fImages.AddResourceName(HINSTANCE, 'CAMERA_GO');
fImages.AddResourceName(HINSTANCE, 'WARNING');
fBreakPoints := TFPList.Create;
fPositions := TCESynMemoPositions.create(self);
fMultiDocSubject := TCEMultiDocSubject.create;
@ -978,7 +940,6 @@ begin
fMultiDocSubject.Free;
fPositions.Free;
fCompletion.Free;
fBreakPoints.Free;
fCallTipStrings.Free;
fLexToks.Clear;
fLexToks.Free;
@ -3237,17 +3198,12 @@ end;
{$REGION debugging/breakpoints -----------------------------------------------------------}
function TCESynMemo.breakPointsCount: integer;
var
i: integer;
begin
exit(fBreakPoints.Count);
end;
function TCESynMemo.BreakPointLine(index: integer): integer;
begin
if index >= fBreakPoints.Count then
exit(0);
{$PUSH}{$WARNINGS OFF}{$HINTS OFF}
exit(Integer(fBreakPoints.Items[index]));
{$POP}
result := 0;
for i := 0 to marks.count-1 do
result += byte(marks[i].ImageIndex = integer(giBreakSet));
end;
procedure TCESynMemo.addBreakPoint(line: integer);
@ -3255,9 +3211,6 @@ begin
if findBreakPoint(line) then
exit;
addGutterIcon(line, giBreakSet);
{$PUSH}{$WARNINGS OFF}{$HINTS OFF}
fBreakPoints.Add(pointer(line));
{$POP}
if assigned(fDebugger) then
fDebugger.addBreakPoint(fFilename, line, bpkBreak);
end;
@ -3267,9 +3220,6 @@ begin
if not findBreakPoint(line) then
exit;
removeGutterIcon(line, giBreakSet);
{$PUSH}{$WARNINGS OFF}{$HINTS OFF}
fBreakPoints.Remove(pointer(line));
{$POP}
if assigned(fDebugger) then
fDebugger.removeBreakPoint(fFilename, line);
end;
@ -3308,10 +3258,17 @@ begin
end;
function TCESynMemo.findBreakPoint(line: integer): boolean;
var
m: TSynEditMarkLine;
i: integer;
begin
{$PUSH}{$WARNINGS OFF}{$HINTS OFF}
exit(fBreakPoints.IndexOf(pointer(line)) <> -1);
{$POP}
result := false;
if line <= lines.count then
m := marks.Line[line];
if m.isNotNil then
for i := 0 to m.count - 1 do
if m[i].ImageIndex = integer(giBreakSet) then
exit(true);
end;
procedure TCESynMemo.gutterClick(Sender: TObject; X, Y, Line: integer; mark: TSynEditMark);
@ -3370,8 +3327,18 @@ begin
end;
procedure TCESynMemo.debugStart(debugger: ICEDebugger);
var
i: integer;
m: TSynEditMark;
begin
fDebugger := debugger;
fDebugger.removeBreakPoints(fileName);
for i := 0 to marks.count - 1 do
begin
m := marks[i];
if m.ImageIndex = integer(giBreakSet) then
fDebugger.addBreakPoint(filename, m.line, bpkBreak);
end;
end;
procedure TCESynMemo.debugStop;
@ -3386,15 +3353,17 @@ end;
function TCESynMemo.debugQueryBpCount: integer;
begin
exit(fBreakPoints.Count);
exit(breakPointsCount());
end;
procedure TCESynMemo.debugQueryBreakPoint(const index: integer; out fname: string;
out line: integer; out kind: TBreakPointKind);
procedure TCESynMemo.debugQueryBreakPoint(const line: integer; out fname: string; out kind: TBreakPointKind);
begin
fname:= fFilename;
line := breakPointLine(index);
kind := bpkBreak;
if findBreakPoint(line) then
begin
fname:= fFilename;
kind := bpkBreak;
end
else kind := bpkNone;
end;
procedure TCESynMemo.debugBreak(const fname: string; line: integer;