gdb commander, mioutput to json + test with brkpts

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 gdboutQuiet(sender: TObject);
-    procedure processInfoStack(sender: TObject);
+    procedure gdboutJsonize(sender: TObject);
-    procedure processSilently(sender: TObject);
+    procedure interpretJson;
-    procedure gdbOutput(sender: TObject);
     // 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.OnReadData:= @gdboutJsonize;
-  fGdb.OnTerminate:= @gdbOutput;
+  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;
+  fGdb.OnReadData:=@gdboutJsonize;
-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;
 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
+  if assigned(gdboutProcessor) then
-    fGdb.OnReadData := outputCatcher;
+    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}

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);