diff --git a/icons/arrow/go_down.png b/icons/arrow/go_down.png new file mode 100644 index 00000000..af237881 Binary files /dev/null and b/icons/arrow/go_down.png differ diff --git a/icons/arrow/go_jump.png b/icons/arrow/go_jump.png new file mode 100644 index 00000000..373dce95 Binary files /dev/null and b/icons/arrow/go_jump.png differ diff --git a/lazproj/coedit.lpi b/lazproj/coedit.lpi index e4dfefcc..30c314cd 100644 --- a/lazproj/coedit.lpi +++ b/lazproj/coedit.lpi @@ -13,7 +13,7 @@ - + @@ -111,6 +111,8 @@ + + diff --git a/src/ce_gdb.lfm b/src/ce_gdb.lfm index d589665a..c778da64 100644 --- a/src/ce_gdb.lfm +++ b/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] - Left = 129 + object btnReg: TCEToolButton[1] + 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] - Left = 113 + object button4: TCEToolButton[2] + 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 diff --git a/src/ce_gdb.pas b/src/ce_gdb.pas index 42f5beba..50e2136e 100644 --- a/src/ce_gdb.pas +++ b/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 - subjDebugBreak(fSubj, fullname, line, dbBreakPoint); + if fDocHandler.findDocument(fullname).isNil then + 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,12 +871,26 @@ begin if val.isNotNil then line := strToInt(val.AsString); end; - if dlgYesNo(format('The signal %s (%s) was received on line %d of file %s .' + 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 - subjDebugBreak(fSubj, fullname, line, dbSignal); + gdbCommand('continue', @gdboutJsonize) + 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); diff --git a/src/ce_synmemo.pas b/src/ce_synmemo.pas index d5cd5786..12a76b59 100644 --- a/src/ce_synmemo.pas +++ b/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); - m.Line := line; - m.ImageList := fImages; - m.ImageIndex := 0; - m.Visible := true; - Marks.Add(m); + setGutterIcon(line, giBulletRed); {$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 - marks.Line[line].Clear(true); + setGutterIcon(line, giNone); {$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:; - dbSignal:; + dbBreakPoint: setGutterIcon(line, giBreak); + dbStep, dbSignal: setGutterIcon(line, giStep); end; end; {$ENDREGION --------------------------------------------------------------------}