#97, fix handling of pause, handle stepping, handle gutter icons

lazproj/coedit.lpi

@@ -13,7 +13,7 @@
         <DpiAware Value="True"/>
       </XPManifest>
       <Icon Value="0"/>
-      <Resources Count="97">
+      <Resources Count="99">
         <Resource_0 FileName="../icons/window/layout_add.png" Type="RCDATA" ResourceName="LAYOUT_ADD"/>
         <Resource_1 FileName="../icons/window/layout.png" Type="RCDATA" ResourceName="LAYOUT"/>
         <Resource_2 FileName="../icons/window/application_go.png" Type="RCDATA" ResourceName="APPLICATION_GO"/>
@@ -111,6 +111,8 @@
         <Resource_94 FileName="../icons/other/stop.png" Type="RCDATA" ResourceName="STOP"/>
         <Resource_95 FileName="../icons/other/breaks.png" Type="RCDATA" ResourceName="BREAKS"/>
         <Resource_96 FileName="../icons/other/step.png" Type="RCDATA" ResourceName="STEP"/>
+        <Resource_97 FileName="../icons/arrow/go_down.png" Type="RCDATA" ResourceName="GO_DOWN"/>
+        <Resource_98 FileName="../icons/arrow/go_jump.png" Type="RCDATA" ResourceName="GO_JUMP"/>
       </Resources>
     </General>
     <i18n>

src/ce_gdb.lfm

@@ -89,20 +89,8 @@ inherited CEGdbWidget: TCEGdbWidget
     end
     inherited toolbar: TCEToolBar
       Width = 509
-      object button0: TCEToolButton[0]
+      object btnStack: TCEToolButton[0]
         Left = 213
-        Top = 0
-        Caption = 'button0'
-        scaledSeparator = False
-      end
-      object button1: TCEToolButton[1]
-        Left = 185
-        Top = 0
-        Caption = 'button1'
-        scaledSeparator = False
-      end
-      object btnStack: TCEToolButton[2]
-        Left = 157
         Hint = 'view call stack'
         Top = 0
         Caption = 'btnStack'
@@ -110,8 +98,8 @@ inherited CEGdbWidget: TCEGdbWidget
         resourceName = 'LIST'
         scaledSeparator = False
       end
-      object btnReg: TCEToolButton[3]
+      object btnReg: TCEToolButton[1]
-        Left = 129
+        Left = 185
         Hint = 'view CPU registers'
         Top = 0
         Caption = 'btnReg'
@@ -119,8 +107,8 @@ inherited CEGdbWidget: TCEGdbWidget
         resourceName = 'PROCESSOR'
         scaledSeparator = False
       end
-      object button4: TCEToolButton[4]
+      object button4: TCEToolButton[2]
-        Left = 113
+        Left = 169
         Height = 28
         Top = 0
         Width = 16
@@ -128,15 +116,16 @@ inherited CEGdbWidget: TCEGdbWidget
         Style = tbsDivider
         scaledSeparator = False
       end
-      object btnPause: TCEToolButton[5]
+      object btnPause: TCEToolButton[3]
         Left = 85
         Hint = 'pause debugging'
         Top = 0
         Caption = 'btnPause'
+        OnClick = btnPauseClick
         resourceName = 'PAUSE'
         scaledSeparator = False
       end
-      object btnStop: TCEToolButton[6]
+      object btnStop: TCEToolButton[4]
         Left = 29
         Hint = 'stop debugging'
         Top = 0
@@ -145,7 +134,7 @@ inherited CEGdbWidget: TCEGdbWidget
         resourceName = 'STOP'
         scaledSeparator = False
       end
-      object btnContinue: TCEToolButton[7]
+      object btnContinue: TCEToolButton[5]
         Left = 57
         Hint = 'continue debugging'
         Top = 0
@@ -154,7 +143,7 @@ inherited CEGdbWidget: TCEGdbWidget
         resourceName = 'PLAY'
         scaledSeparator = False
       end
-      object btnStart: TCEToolButton[8]
+      object btnStart: TCEToolButton[6]
         Left = 1
         Hint = 'start debugging'
         Top = 0
@@ -163,6 +152,24 @@ inherited CEGdbWidget: TCEGdbWidget
         resourceName = 'POWER'
         scaledSeparator = False
       end
+      object btnNext: TCEToolButton[7]
+        Left = 113
+        Hint = 'step to next instruction, including in calls'
+        Top = 0
+        Caption = 'btnNext'
+        OnClick = btnNextClick
+        resourceName = 'GO_DOWN'
+        scaledSeparator = False
+      end
+      object btnOver: TCEToolButton[8]
+        Left = 141
+        Hint = 'step to the next instruction, excluding calls'
+        Top = 0
+        Caption = 'btnOver'
+        OnClick = btnOverClick
+        resourceName = 'GO_JUMP'
+        scaledSeparator = False
+      end
     end
   end
   inherited contextMenu: TPopupMenu

src/ce_gdb.pas

@@ -158,6 +158,17 @@ type
     from: string;
   end;
 
+  {{}
+  TGDBMI_Frame = record
+    level: integer;
+    func: string;
+    adrress: ptruint;
+    fname: string;  // named "file"
+    line: integer;
+    from: string;
+  end;
+  }
+
   {
     breakpoint:
 
@@ -213,13 +224,13 @@ type
   { TCEGdbWidget }
   TCEGdbWidget = class(TCEWidget, ICEProjectObserver, ICEDocumentObserver, ICEDebugger)
     btnContinue: TCEToolButton;
+    btnNext: TCEToolButton;
+    btnOver: TCEToolButton;
     btnPause: TCEToolButton;
     btnReg: TCEToolButton;
     btnStack: TCEToolButton;
     btnStart: TCEToolButton;
     btnStop: TCEToolButton;
-    button0: TCEToolButton;
-    button1: TCEToolButton;
     button4: TCEToolButton;
     Edit1: TEdit;
     lstCallStack: TListView;
@@ -228,6 +239,9 @@ type
     btnSendCom: TSpeedButton;
     stateViewer: TTIPropertyGrid;
     procedure btnContClick(Sender: TObject);
+    procedure btnNextClick(Sender: TObject);
+    procedure btnOverClick(Sender: TObject);
+    procedure btnPauseClick(Sender: TObject);
     procedure btnRegClick(Sender: TObject);
     procedure btnSendComClick(Sender: TObject);
     procedure btnStackClick(Sender: TObject);
@@ -249,8 +263,10 @@ type
     fInspState: TInspectableState;
     fShowCLI: boolean;
     fStackItems: TStackItems;
+    fCatchPause: boolean;
     //
     procedure startDebugging;
+    procedure pauseDebugee;
     procedure killGdb;
     procedure storeObserversBreakpoints;
     // GDB output processors
@@ -595,9 +611,30 @@ begin
   gdbCommand('break _d_arraybounds');
   gdbCommand('break _d_switch_error');
   fGdb.OnReadData := @gdboutJsonize;
+  gdbCommand('-gdb-set mi-async on');
   // launch
   gdbCommand('run');
 end;
+
+procedure TCEGdbWidget.pauseDebugee;
+var
+  proc: TProcess;
+begin
+  // TODO-cGDB: pause using the PID is safer
+  proc := TProcess.Create(nil);
+  try
+    fCatchPause := true;
+    proc.Executable:= 'kill';
+    proc.ShowWindow:= swoHIDE;
+    proc.Parameters.Add('-s');
+    proc.Parameters.Add('USR1');
+    proc.Parameters.Add(fProj.outputFilename.extractFileName);
+    proc.Execute;
+    while proc.Running do;
+  finally
+    proc.Free;
+  end;
+end;
 {$ENDREGION}
 
 {$REGIOn GDB output processors -------------------------------------------------}
@@ -773,6 +810,7 @@ var
   obj: TJSONObject;
   arr: TJSONArray;
   // common data
+  reason: string;
   addr: PtrUint = 0;
   fullname: string = '';
   func:string = '';
@@ -783,14 +821,20 @@ var
   // signal data
   sigmean: string;
   signame: string;
+  brkreason: TCEDebugBreakReason;
 begin
 
   val := fJson.Find('reason');
   if val.isNotNil then
   begin
+    reason := val.AsString;
 
-    if val.AsString = 'breakpoint-hit' then
+    if (reason = 'breakpoint-hit') or (reason = 'end-stepping-range') then
     begin
+      case reason of
+        'breakpoint-hit': brkreason := dbBreakPoint;
+        'end-stepping-range': brkreason := dbStep;
+      end;
       obj := TJSONObject(fJson.Find('frame'));
       if obj.isNotNil and (obj.JSONType = jtObject) then
       begin
@@ -800,13 +844,14 @@ begin
         val := obj.Find('line');
         if val.isNotNil then
           line := strToInt(val.AsString);
-        if (line <> -1) and fullname.fileExists then
+        if fDocHandler.findDocument(fullname).isNil then
-          subjDebugBreak(fSubj, fullname, line, dbBreakPoint);
+          fDocHandler.openDocument(fullname);
+        subjDebugBreak(fSubj, fullname, line, brkreason);
       end;
     end
 
     //TODO-cGDB: in the settings, option to automatically ignore particular signals.
-    else if val.AsString = 'signal-received' then
+    else if reason = 'signal-received' then
     begin
       signame := 'unknown signal';
       sigmean := 'unknown meaning';
@@ -815,7 +860,7 @@ begin
         signame := val.AsString;
       val := fJson.Find('signal-meaning');
       if val.isNotNil then
-        sigmean += val.AsString;
+        sigmean := val.AsString;
       obj := TJSONObject(fJson.Find('frame'));
       if obj.isNotNil and (obj.JSONType = jtObject) then
       begin
@@ -826,13 +871,27 @@ begin
         if val.isNotNil then
           line := strToInt(val.AsString);
       end;
+      if fCatchPause then
+      begin
+        fCatchPause := false;
+        if fDocHandler.findDocument(fullname).isNil then
+          fDocHandler.openDocument(fullname);
+        subjDebugBreak(fSubj, fullname, line, dbSignal);
+      end
+      else
+      begin
         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, fullname]),
         'Unexpected signal received') = mrNo then
           gdbCommand('continue', @gdboutJsonize)
-      else if (line <> -1) and fullname.fileExists then
+        else
+        begin
+          if not fDocHandler.findDocument(fullname).isNil then
+            fDocHandler.openDocument(fullname);
           subjDebugBreak(fSubj, fullname, line, dbSignal);
         end;
+      end;
+    end;
 
   end;
 
@@ -971,6 +1030,21 @@ begin
   gdbCommand('continue', @gdboutJsonize);
 end;
 
+procedure TCEGdbWidget.btnNextClick(Sender: TObject);
+begin
+  gdbCommand('step', @gdboutJsonize);
+end;
+
+procedure TCEGdbWidget.btnOverClick(Sender: TObject);
+begin
+  gdbCommand('next', @gdboutJsonize);
+end;
+
+procedure TCEGdbWidget.btnPauseClick(Sender: TObject);
+begin
+  pauseDebugee;
+end;
+
 procedure TCEGdbWidget.btnRegClick(Sender: TObject);
 begin
   infoRegs;
@@ -978,8 +1052,8 @@ end;
 
 procedure TCEGdbWidget.btnStopClick(Sender: TObject);
 begin
+  pauseDebugee;
   gdbCommand('kill', @gdboutJsonize);
-  killGdb;
 end;
 
 procedure TCEGdbWidget.btnSendComClick(Sender: TObject);

src/ce_synmemo.pas

@@ -116,6 +116,15 @@ type
 
   TSortDialog = class;
 
+  TGutterIcon = (
+    giBulletRed   = 0,          // breakpoint
+    giBulletGreen = 1,
+    giBulletBlack = 2,
+    giBreak       = 3,          // break point reached
+    giStep        = 4,          // step / signal / pause
+    giNone        = high(byte)  // remove
+  );
+
   TCESynMemo = class(TSynEdit, ICEDebugObserver)
   private
     fFilename: string;
@@ -186,11 +195,6 @@ type
       Selected: boolean; Index: integer): boolean;
     procedure completionCodeCompletion(var value: string; SourceValue: string;
       var SourceStart, SourceEnd: TPoint; KeyChar: TUTF8Char; Shift: TShiftState);
-    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 showCallTips(const tips: string);
     function lexCanCloseBrace: boolean;
     procedure handleStatusChanged(Sender: TObject; Changes: TSynStatusChanges);
@@ -199,7 +203,13 @@ type
     procedure setSelectionOrWordCase(upper: boolean);
     procedure sortSelectedLines(descending, caseSensitive: boolean);
     procedure tokFoundForCaption(const token: PLexToken; out stop: boolean);
+    procedure setGutterIcon(line: integer; value: TGutterIcon);
     //
+    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;
     function debugQueryBpCount: integer;
@@ -2430,17 +2440,10 @@ begin
 end;
 
 procedure TCESynMemo.addBreakPoint(line: integer);
-var
-  m: TSynEditMark;
 begin
   if findBreakPoint(line) then
     exit;
-  m:= TSynEditMark.Create(self);
+  setGutterIcon(line, giBulletRed);
-  m.Line := line;
-  m.ImageList := fImages;
-  m.ImageIndex := 0;
-  m.Visible := true;
-  Marks.Add(m);
   {$PUSH}{$WARNINGS OFF}{$HINTS OFF}
   fBreakPoints.Add(pointer(line));
   {$POP}
@@ -2452,8 +2455,7 @@ procedure TCESynMemo.removeBreakPoint(line: integer);
 begin
   if not findBreakPoint(line) then
     exit;
-  if marks.Line[line].isNotNil and (marks.Line[line].Count > 0) then
+  setGutterIcon(line, giNone);
-    marks.Line[line].Clear(true);
   {$PUSH}{$WARNINGS OFF}{$HINTS OFF}
   fBreakPoints.Remove(pointer(line));
   {$POP}
@@ -2462,8 +2464,15 @@ begin
 end;
 
 procedure TCESynMemo.removeDebugTimeMarks;
+var
+  i: integer;
 begin
-  //TODO-cGDB: clean gutter marks generated during the session
+  for i:= 0 to Lines.Count-1 do
+  begin
+    Marks.ClearLine(i);
+    if findBreakPoint(i) then
+      setGutterIcon(i, giBulletRed);
+  end;
 end;
 
 function TCESynMemo.findBreakPoint(line: integer): boolean;
@@ -2481,6 +2490,22 @@ begin
     addBreakPoint(line);
 end;
 
+procedure TCESynMemo.setGutterIcon(line: integer; value: TGutterIcon);
+var
+  m: TSynEditMark;
+begin
+  Marks.ClearLine(line);
+  if value <> giNone then
+  begin
+    m:= TSynEditMark.Create(self);
+    m.Line := line;
+    m.ImageList := fImages;
+    m.ImageIndex := longint(value);
+    m.Visible := true;
+    Marks.Add(m);
+  end;
+end;
+
 procedure TCESynMemo.debugStart(debugger: ICEDebugger);
 begin
   fDebugger := debugger;
@@ -2512,10 +2537,10 @@ begin
     exit;
   showPage;
   caretY := line;
-  // TODO-cDBG: add markup according to break reason
+  removeDebugTimeMarks;
   case reason of
-    dbBreakPoint:;
+    dbBreakPoint: setGutterIcon(line, giBreak);
-    dbSignal:;
+    dbStep, dbSignal: setGutterIcon(line, giStep);
   end;
 end;
 {$ENDREGION --------------------------------------------------------------------}