diff --git a/src/ce_gdb.pas b/src/ce_gdb.pas index b6706489..035d5f17 100644 --- a/src/ce_gdb.pas +++ b/src/ce_gdb.pas @@ -8,7 +8,7 @@ uses Classes, SysUtils, FileUtil, ListFilterEdit, Forms, Controls, Graphics, RegExpr, ComCtrls, PropEdits, GraphPropEdits, RTTIGrids, Dialogs, ExtCtrls, Menus, strutils, Buttons, StdCtrls, process ,ce_common, ce_interfaces, ce_widget, ce_processes, - ce_observer, ce_synmemo, ce_sharedres, ce_stringrange; + ce_observer, ce_synmemo, ce_sharedres, ce_stringrange, fpjson; type @@ -32,6 +32,42 @@ type // aliased to get hex display in object inspector. TCpuRegValue = type PtrInt; + // Interprets a GDBMI message as a JSON + TGdbMessage = class + private + fCli: string; + fOut: string; + fComponents: TJSONObject; + public + constructor create; + destructor destroy; override; + // called by the widget when the process receives + procedure parse(str: string); + // after parse, contains the standard CLI messages + property cli: string read fCli; + // after parse, contains the debuggee output + property stdout: string read fOut; + // after parse, contains the message components + property components: TJSONObject read fComponents; + end; + + // Makes a category for the GP registers in a project inspector + TInspectableGPR = class(TPersistent) + end; + + // Makes a category for the FP registers in a project inspector + TInspectableFPR = class(TPersistent) + end; + + // Makes a category for the SSE registers in a project inspector + TInspectableSSER = class(TPersistent) + end; + + // Makes a category for the call stack in a project inspector + TInspectableStack = class(Tpersistent) + end; + + // Stores the stack and the registers content, to be displayable in // an object inspector. TInspectableState = class(TPersistent) @@ -94,10 +130,6 @@ type public constructor create; destructor destroy; override; - // called on the result of "info stack" - procedure parseCallStack(stream: TStream); - // called on the result of "info register" - procedure parseRegisters(stream: TStream); end; TCpuRegValueEditor = class(TIntegerProperty) @@ -122,7 +154,7 @@ type ~"\nBreakpoint " ~"2, D main (args=...) at /home/basile/Dev/dproj/Resource.d/src/resource.d:39\n" ~"39\t getopt(args, config.passThrough, \"h|help\", &wantHelp);\n" - *stopped,reason="breakpoint-hit",disp="keep",bkptno="2",frame={addr="0x000000000049dc7a",func="D main",args=[{name="args",value="..."}],file="/home/basile/Dev/dproj/Resource.d/src/resource.d",fullname="/home/basile/Dev/dproj/Resource.d/src/resource.d",line="39"},thread-id="1",stopped-threads="all",core="3" + *stopped,reason="breakpoint-hit",disp="keep",bkptno="2",frame={addr="0x000000000049dc7a", func="D main",args=[{name="args",value="..."}],file="/home/basile/Dev/dproj/Resource.d/src/resource.d",fullname="/home/basile/Dev/dproj/Resource.d/src/resource.d",line="39"},thread-id="1",stopped-threads="all",core="3" (gdb) . line starting with = is to parse as TGDBMI_Breakpoint, thorically its [opt token]=, no token for breakpoint reached since it's not a result @@ -189,6 +221,7 @@ type procedure btnStopClick(Sender: TObject); procedure Edit1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); private + fDoc: TCESynMemo; fProj: ICECommonProject; fLog: TStringList; fFileLineBrks: TStringList; @@ -196,18 +229,18 @@ type fMsg: ICEMessagesDisplay; fGdb: TCEAutoBufferedProcess; fInspState: TInspectableState; + fGdbMessage: TGdbMessage; // procedure startDebugging; procedure killGdb; procedure updateFileLineBrks; procedure editorModBrk(sender: TCESynMemo; line: integer; modification: TBreakPointModification); // GDB output processors - procedure processInfoRegs(sender: TObject); - procedure processInfoStack(sender: TObject); - procedure processSilently(sender: TObject); - procedure gdbOutput(sender: TObject); + procedure gdboutQuiet(sender: TObject); + procedure gdboutJsonize(sender: TObject); + procedure interpretJson; // GDB commands & actions - procedure gdbCommand(aCommand: string; outputCatcher: TNotifyEvent = nil); + procedure gdbCommand(aCommand: string; gdboutProcessor: TNotifyEvent = nil); procedure infoRegs; procedure infoStack; // @@ -231,13 +264,132 @@ type implementation {$R *.lfm} + + +{$REGION TGdbMessage -----------------------------------------------------------} +constructor TGdbMessage.create; +begin + fComponents := TJSONObject.Create; +end; + +destructor TGdbMessage.destroy; +begin + fComponents.Free; + inherited; +end; + +procedure TGdbMessage.parse(str: string); + + procedure parseProperty(node: TJSONObject; r: PStringRange); forward; + procedure parseProperty(node: TJSONArray; r: PStringRange); forward; + + procedure parseProperty(node: TJSONArray; r: PStringRange); + var + c: char; + begin + while true do + begin + if r^.empty then + exit; + c := r^.front; + case c of + '{': + begin + r^.popFront; + node.Objects[node.Count] := TJSONObject.Create; + parseProperty(node.Objects[node.Count-1], r); + end; + ']': + begin + r^.popFront; + exit; + end; + ',': r^.popFront; + end; + end; + end; + + procedure parseProperty(node: TJSONObject; r: PStringRange); + var + idt: string; + c: char; + begin + while true do + begin + if r^.empty then + exit; + c := r^.front; + case c of + ',': + begin + r^.popFront; + end; + 'a'..'z': + begin + idt := r^.takeUntil('=').yield; + r^.popFront; + end; + '"': + begin + node.Strings[idt] := r^.popFront^.takeUntil('"').yield; + r^.popFront; + end; + '{': + begin + r^.popFront; + node.Objects[idt] := TJSONObject.Create; + parseProperty(node.Objects[idt], r); + end; + '[': + begin + r^.popFront; + node.Arrays[idt] := TJSONArray.Create; + parseProperty(node.Arrays[idt], r); + end; + '}', ']': + begin + r^.popFront; + exit; + end; + ' ', #9: + r^.popFront; + #10: + begin + r^.popFront; + exit; + end; + end; + end; + end; + +var + rng: TStringRange = (ptr: nil; pos: 0; len: 0); +begin + fComponents.Clear; + if str.length = 0 then + exit; + rng.init(str); + while true do + begin + if rng.empty then + exit; + if rng.front = '*' then + parseProperty(fComponents, rng.popUntil(',')^.popFront); + rng.popUntil(#10); + if not rng.empty then + rng.popFront; + end; +end; +{$ENDREGION} + + {$REGION TInspectableState -----------------------------------------------------} function TCpuRegValueEditor.GetValue: ansistring; begin {$IFDEF CPU64} result := '0x' + IntToHex(GetInt64Value, 16); {$ELSE} - result := '0x' + IntToHex(GetInt64Value, 8); + result := '0x' + IntToHex(GetOrdValue, 8); {$ENDIF} end; @@ -253,26 +405,6 @@ begin fCallStack.free; fWordSpliter.Free; inherited; -end; - -procedure TInspectableState.parseCallStack(stream: TStream); -var - rng: TStringRange = (ptr: nil; pos: 0; len: 0); - str: string; - i,j: integer; -begin - - -end; - -procedure TInspectableState.parseRegisters(stream: TStream); -var - reg: string; - val: string; - rng: TStringRange = (ptr: nil; pos: 0; len: 0); -begin - - end; {$ENDREGION} @@ -287,6 +419,7 @@ begin fLog := TStringList.Create; fInspState := TInspectableState.Create; stateViewer.TIObject := fInspState; + fGdbMessage:= TGdbMessage.create; // AssignPng(btnSendCom, 'ACCEPT'); end; @@ -297,6 +430,7 @@ begin fLog.Free; killGdb; fInspState.Free; + fGdbMessage.Free; EntitiesConnector.removeObserver(self); inherited; end; @@ -346,6 +480,7 @@ procedure TCEGdbWidget.docFocused(document: TCESynMemo); begin if document.isDSource then document.onBreakpointModify := @editorModBrk; + fDoc := document; end; procedure TCEGdbWidget.docChanged(document: TCESynMemo); @@ -354,6 +489,8 @@ end; procedure TCEGdbWidget.docClosing(document: TCESynMemo); begin + if fDoc = document then + fDoc := nil; end; {$ENDREGION} @@ -429,8 +566,8 @@ begin fgdb.Options:= [poUsePipes, poStderrToOutPut]; fgdb.Parameters.Add(str); fgdb.Parameters.Add('--interpreter=mi'); - fGdb.OnReadData:= @gdbOutput; - fGdb.OnTerminate:= @gdbOutput; + fGdb.OnReadData:= @gdboutJsonize; + fGdb.OnTerminate:= @gdboutJsonize; fgdb.execute; // file:line breakpoints updateFileLineBrks; @@ -440,7 +577,7 @@ begin fGdb.Input.Write(str[1], str.length); end; // break on druntime exceptions heper + throw' - fGdb.OnReadData := @processSilently; + fGdb.OnReadData := @gdboutQuiet; gdbCommand('break onAssertError'); gdbCommand('break onAssertErrorMsg'); gdbCommand('break onUnittestErrorMsg'); @@ -452,74 +589,104 @@ begin gdbCommand('break onSwitchError'); gdbCommand('break onUnicodeError'); gdbCommand('break _d_throwc'); - fGdb.OnReadData := @gdbOutput; + fGdb.OnReadData := @gdboutJsonize; // launch gdbCommand('run'); end; {$ENDREGION} {$REGIOn GDB output processors -------------------------------------------------} -procedure TCEGdbWidget.gdbOutput(sender: TObject); +procedure TCEGdbWidget.interpretJson; +var + jsn: TJSONObject; + val: TJSONData; + obj: TJSONObject; + // brkp data + fne: string = ''; + lne: integer = -1; + doc: TCESynMemo; +begin + jsn := fGdbMessage.components; + val := jsn.Find('reason'); + if val.isNotNil and (val.AsString = 'breakpoint-hit') then + begin + obj := TJSONObject(jsn.Find('frame')); + if obj.isNotNil and (obj.JSONType = jtObject) then + begin + val := obj.Find('fullname'); + if val.isNotNil then + fne := val.AsString; + val := obj.Find('line'); + if val.isNotNil then + lne := strToInt(val.AsString); + if (lne <> -1) and fne.fileExists then + begin + getMultiDocHandler.openDocument(fne); + fDoc.setFocus; + fDoc.CaretY:= lne; + end; + end; + end; +end; + +procedure TCEGdbWidget.gdboutJsonize(sender: TObject); var str: string; + lst: TStringList; begin if fMsg = nil then exit; fLog.Clear; fGdb.getFullLines(fLog); + //fGdb.OutputStack.Clear; for str in fLog do fMsg.message(str, nil, amcMisc, amkAuto); + + if flog.Text.isEmpty then + exit; + + fGdbMessage.parse(fLog.Text); + interpretJson; + + lst := TStringList.Create; + try + str := fGdbMessage.components.FormatJSON(DefaultFormat,2); + lst.Text:= str; + lst.SaveToFile('/home/basile/gdbmessage.json'); + finally + lst.Free; + end; end; -procedure TCEGdbWidget.processSilently(sender: TObject); +procedure TCEGdbWidget.gdboutQuiet(sender: TObject); begin fGdb.OutputStack.Clear; - fGdb.OnReadData:=@gdbOutput; -end; - -procedure TCEGdbWidget.processInfoRegs(sender: TObject); -begin - try - fInspState.parseRegisters(fgdb.OutputStack); - fgdb.OutputStack.Clear; - finally - fGdb.OnReadData:=@gdbOutput; - end; -end; - -procedure TCEGdbWidget.processInfoStack(sender: TObject); -begin - try - fInspState.parseCallStack(fgdb.OutputStack); - fgdb.OutputStack.Clear; - finally - fGdb.OnReadData:=@gdbOutput; - end; + fGdb.OnReadData:=@gdboutJsonize; end; {$ENDREGION} {$REGIOn GDB commands & actions ------------------------------------------------} -procedure TCEGdbWidget.gdbCommand(aCommand: string; outputCatcher: TNotifyEvent = nil); +procedure TCEGdbWidget.gdbCommand(aCommand: string; gdboutProcessor: TNotifyEvent = nil); begin if fGdb = nil then exit; if not fGdb.Running then exit; // aCommand += #10; - if assigned(outputCatcher) then - fGdb.OnReadData := outputCatcher; + if assigned(gdboutProcessor) then + fGdb.OnReadData := gdboutProcessor; fGdb.Input.Write(aCommand[1], aCommand.length); end; procedure TCEGdbWidget.infoRegs; begin // GDBMI output format, "info registers" is for CLI output - gdbCommand('-data-list-register-values d', @processInfoRegs); + gdbCommand('-data-list-register-values d', @gdboutJsonize); end; procedure TCEGdbWidget.infoStack; begin // GDBMI output format, "info frame" is for CLI output - gdbCommand('-stack-info-frame', @processInfoStack); + gdbCommand('-stack-info-frame', @gdboutJsonize); end; procedure TCEGdbWidget.btnStartClick(Sender: TObject); @@ -529,7 +696,7 @@ end; procedure TCEGdbWidget.btnContClick(Sender: TObject); begin - gdbCommand('continue'); + gdbCommand('continue', @gdboutJsonize); end; procedure TCEGdbWidget.btnRegClick(Sender: TObject); @@ -539,13 +706,13 @@ end; procedure TCEGdbWidget.btnStopClick(Sender: TObject); begin - gdbCommand('kill'); + gdbCommand('kill', @gdboutQuiet); killGdb; end; procedure TCEGdbWidget.btnSendComClick(Sender: TObject); begin - gdbCommand(edit1.Text); + gdbCommand(edit1.Text, @gdboutJsonize); edit1.Text := ''; end; @@ -557,7 +724,7 @@ end; procedure TCEGdbWidget.Edit1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key <> byte(#13) then exit; - gdbCommand(edit1.Text); + gdbCommand(edit1.Text, @gdboutJsonize); edit1.Text := ''; end; {$ENDREGION} diff --git a/src/ce_main.pas b/src/ce_main.pas index e03cde5a..315e2cd3 100644 --- a/src/ce_main.pas +++ b/src/ce_main.pas @@ -14,7 +14,7 @@ uses ce_widget, ce_messages, ce_interfaces, ce_editor, ce_projinspect, ce_projconf, ce_search, ce_miniexplorer, ce_libman, ce_libmaneditor, ce_todolist, ce_observer, ce_toolseditor, ce_procinput, ce_optionseditor, ce_symlist, ce_mru, ce_processes, - ce_infos, ce_dubproject, ce_dialogs, ce_dubprojeditor, (*ce_gdb,*) ce_dfmt, + ce_infos, ce_dubproject, ce_dialogs, ce_dubprojeditor, ce_gdb, ce_dfmt, ce_lcldragdrop, ce_projgroup, ce_projutils, ce_stringrange; type @@ -362,7 +362,7 @@ type fInfoWidg: TCEInfoWidget; fDubProjWidg: TCEDubProjectEditorWidget; fPrjGrpWidg: TCEProjectGroupWidget; - //fGdbWidg: TCEGdbWidget; + fGdbWidg: TCEGdbWidget; fDfmtWidg: TCEDfmtWidget; fCompStart: TDateTime; @@ -1277,7 +1277,7 @@ begin fDfmtWidg := TCEDfmtWidget.create(self); fPrjGrpWidg := TCEProjectGroupWidget.create(self); - //fGdbWidg := TCEGdbWidget.create(self); + fGdbWidg := TCEGdbWidget.create(self); getMessageDisplay(fMsgs); @@ -1298,7 +1298,7 @@ begin fWidgList.addWidget(@fDfmtWidg); fWidgList.addWidget(@fPrjGrpWidg); - //fWidgList.addWidget(@fGdbWidg); + fWidgList.addWidget(@fGdbWidg); fWidgList.sort(@CompareWidgCaption);