diff --git a/lazproj/coedit.lpi b/lazproj/coedit.lpi
index c232fae5..44d35d11 100644
--- a/lazproj/coedit.lpi
+++ b/lazproj/coedit.lpi
@@ -134,7 +134,7 @@
-
+
@@ -355,6 +355,13 @@
+
+
+
+
+
+
+
diff --git a/lazproj/coedit.lpr b/lazproj/coedit.lpr
index 876402f1..3a5d7c55 100644
--- a/lazproj/coedit.lpr
+++ b/lazproj/coedit.lpr
@@ -10,7 +10,7 @@ uses
ce_observer, ce_libman, ce_tools, ce_dcd, ce_main, ce_writableComponent,
ce_symstring, ce_staticmacro, ce_inspectors, ce_editoroptions, ce_dockoptions,
ce_shortcutseditor, ce_mru, ce_processes, ce_dubproject, ce_dialogs,
-ce_dubprojeditor;
+ce_dubprojeditor, ce_gdb;
{$R *.res}
diff --git a/src/ce_editor.lfm b/src/ce_editor.lfm
index 313e05e3..783f3936 100644
--- a/src/ce_editor.lfm
+++ b/src/ce_editor.lfm
@@ -1,7 +1,7 @@
inherited CEEditorWidget: TCEEditorWidget
- Left = 1324
+ Left = 704
Height = 406
- Top = 92
+ Top = 245
Width = 465
Caption = 'Source editor'
ClientHeight = 406
@@ -19,7 +19,7 @@ inherited CEEditorWidget: TCEEditorWidget
ClientWidth = 465
object PageControl: TExtendedNotebook[0]
Left = 3
- Height = 375
+ Height = 380
Top = 3
Width = 459
Align = alClient
@@ -32,8 +32,8 @@ inherited CEEditorWidget: TCEEditorWidget
end
object editorStatus: TStatusBar[1]
Left = 3
- Height = 23
- Top = 380
+ Height = 18
+ Top = 385
Width = 459
BorderSpacing.Around = 2
Panels = <
diff --git a/src/ce_gdb.lfm b/src/ce_gdb.lfm
new file mode 100644
index 00000000..135a618b
--- /dev/null
+++ b/src/ce_gdb.lfm
@@ -0,0 +1,151 @@
+inherited CEGdbWidget: TCEGdbWidget
+ Left = 640
+ Height = 521
+ Top = 213
+ Width = 517
+ Caption = 'GDB commander'
+ ClientHeight = 521
+ ClientWidth = 517
+ inherited Back: TPanel
+ Height = 521
+ Width = 517
+ ClientHeight = 521
+ ClientWidth = 517
+ inherited Content: TPanel
+ Height = 521
+ Width = 517
+ ClientHeight = 521
+ ClientWidth = 517
+ object Panel1: TPanel[0]
+ Left = 2
+ Height = 30
+ Top = 2
+ Width = 513
+ Align = alTop
+ BorderSpacing.Around = 2
+ BevelOuter = bvNone
+ ClientHeight = 30
+ ClientWidth = 513
+ PopupMenu = contextMenu
+ TabOrder = 0
+ object btnStart: TBitBtn
+ Left = 2
+ Height = 26
+ Hint = 'start debugging'
+ Top = 2
+ Width = 28
+ Align = alLeft
+ BorderSpacing.Around = 2
+ Layout = blGlyphBottom
+ OnClick = btnStartClick
+ Spacing = 0
+ TabOrder = 0
+ end
+ object lstfilter: TListFilterEdit
+ Left = 92
+ Height = 26
+ Top = 2
+ Width = 419
+ ButtonWidth = 28
+ NumGlyphs = 1
+ Align = alClient
+ Anchors = [akTop, akLeft, akRight]
+ BorderSpacing.Around = 2
+ MaxLength = 0
+ TabOrder = 1
+ end
+ object btnStop: TBitBtn
+ Left = 32
+ Height = 26
+ Hint = 'stop debuging'
+ Top = 2
+ Width = 28
+ Align = alLeft
+ BorderSpacing.Around = 2
+ Layout = blGlyphBottom
+ OnClick = btnStopClick
+ Spacing = 0
+ TabOrder = 2
+ end
+ object btnCont: TBitBtn
+ Left = 62
+ Height = 26
+ Hint = 'continue debugging'
+ Top = 2
+ Width = 28
+ Align = alLeft
+ BorderSpacing.Around = 2
+ Layout = blGlyphBottom
+ OnClick = btnContClick
+ Spacing = 0
+ TabOrder = 3
+ end
+ end
+ object Panel2: TPanel[1]
+ Left = 0
+ Height = 487
+ Top = 34
+ Width = 517
+ Align = alClient
+ BevelOuter = bvNone
+ Caption = 'Panel2'
+ ClientHeight = 487
+ ClientWidth = 517
+ TabOrder = 1
+ object TreeView1: TTreeView
+ Left = 4
+ Height = 447
+ Top = 4
+ Width = 509
+ Align = alClient
+ BorderSpacing.Around = 4
+ DefaultItemHeight = 16
+ ScrollBars = ssAutoBoth
+ TabOrder = 0
+ Items.Data = {
+ F9FFFFFF020001000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000
+ 00000003000000454158
+ }
+ end
+ object Panel3: TPanel
+ Left = 4
+ Height = 28
+ Top = 455
+ Width = 509
+ Align = alBottom
+ BorderSpacing.Around = 4
+ BevelOuter = bvNone
+ ClientHeight = 28
+ ClientWidth = 509
+ TabOrder = 1
+ object Edit1: TEdit
+ Left = 0
+ Height = 24
+ Hint = 'custom GDB command'
+ Top = 2
+ Width = 481
+ Align = alClient
+ BorderSpacing.Top = 2
+ BorderSpacing.Bottom = 2
+ OnKeyUp = Edit1KeyUp
+ TabOrder = 0
+ end
+ object btnSendCom: TBitBtn
+ Left = 481
+ Height = 28
+ Top = 0
+ Width = 28
+ Align = alRight
+ Layout = blGlyphBottom
+ OnClick = btnSendComClick
+ TabOrder = 1
+ end
+ end
+ end
+ end
+ end
+ inherited contextMenu: TPopupMenu
+ left = 56
+ top = 64
+ end
+end
diff --git a/src/ce_gdb.pas b/src/ce_gdb.pas
new file mode 100644
index 00000000..ea0570f3
--- /dev/null
+++ b/src/ce_gdb.pas
@@ -0,0 +1,278 @@
+unit ce_gdb;
+
+{$I ce_defines.inc}
+
+interface
+
+uses
+ Classes, SysUtils, FileUtil, ListFilterEdit, Forms, Controls, Graphics,
+ Dialogs, ExtCtrls, Menus, Buttons, ComCtrls, StdCtrls, process, ce_common,
+ ce_interfaces, ce_widget, ce_processes, ce_observer, ce_synmemo, ce_sharedres;
+
+type
+
+ TCpuRegs = (eax);
+
+ { TCEGdbWidget }
+ TCEGdbWidget = class(TCEWidget, ICEProjectObserver)
+ btnSendCom: TBitBtn;
+ btnStop: TBitBtn;
+ btnStart: TBitBtn;
+ btnCont: TBitBtn;
+ Edit1: TEdit;
+ lstfilter: TListFilterEdit;
+ Panel1: TPanel;
+ Panel2: TPanel;
+ Panel3: TPanel;
+ TreeView1: TTreeView;
+ procedure btnContClick(Sender: TObject);
+ procedure btnSendComClick(Sender: TObject);
+ procedure btnStartClick(Sender: TObject);
+ procedure btnStopClick(Sender: TObject);
+ procedure Edit1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+ private
+ fProj: ICECommonProject;
+ fLog: TStringList;
+ fFileLineBrks: TStringList;
+ fDocHandler: ICEMultiDocHandler;
+ fMsg: ICEMessagesDisplay;
+ fGdb: TCEProcess;
+ fRegs: array[TCpuRegs] of UIntPtr;
+ //
+ procedure startDebugging;
+ procedure killGdb;
+ procedure updateFileLineBrks;
+ // GDB output processors
+ procedure processInfoRegs(sender: TObject);
+ procedure processInfoStack(sender: TObject);
+ procedure processSilently(sender: TObject);
+ procedure gdbOutput(sender: TObject);
+ // GDB commands & actions
+ procedure gdbCommand(aCommand: string; outputCatcher: TNotifyEvent = nil);
+ procedure infoRegs;
+ procedure infoStack;
+
+ //
+ procedure projNew(aProject: ICECommonProject);
+ procedure projChanged(aProject: ICECommonProject);
+ procedure projClosing(aProject: ICECommonProject);
+ procedure projFocused(aProject: ICECommonProject);
+ procedure projCompiling(aProject: ICECommonProject);
+ public
+ constructor create(aOwner: TComponent); override;
+ destructor destroy; override;
+ end;
+
+
+implementation
+{$R *.lfm}
+
+{$REGION Common/standard comp --------------------------------------------------}
+constructor TCEGdbWidget.create(aOwner: TComponent);
+begin
+ inherited;
+ EntitiesConnector.addObserver(self);
+ fDocHandler:= getMultiDocHandler;
+ fMsg:= getMessageDisplay;
+ fFileLineBrks:= TStringList.Create;
+ fLog := TStringList.Create;
+ //
+ AssignPng(btnSendCom, 'accept');
+end;
+
+destructor TCEGdbWidget.destroy;
+begin
+ fFileLineBrks.Free;
+ fLog.Free;
+ killGdb;
+ EntitiesConnector.removeObserver(self);
+ inherited;
+end;
+{$ENDREGION}
+
+{$REGION ICEProjectObserver ----------------------------------------------------}
+procedure TCEGdbWidget.projNew(aProject: ICECommonProject);
+begin
+ fProj := aProject;
+end;
+
+procedure TCEGdbWidget.projChanged(aProject: ICECommonProject);
+begin
+ if fProj <> aProject then
+ exit;
+end;
+
+procedure TCEGdbWidget.projClosing(aProject: ICECommonProject);
+begin
+ if fProj <> aProject then
+ exit;
+ fProj := nil;
+end;
+
+procedure TCEGdbWidget.projFocused(aProject: ICECommonProject);
+begin
+ fProj := aProject;
+end;
+
+procedure TCEGdbWidget.projCompiling(aProject: ICECommonProject);
+begin
+end;
+{$ENDREGION}
+
+{$REGION Unsorted Debugging things ---------------------------------------------}
+procedure TCEGdbWidget.killGdb;
+begin
+ if not assigned(fGdb) then
+ exit;
+ if fGdb.Running then
+ fGdb.Terminate(0);
+ FreeAndNil(fGdb);
+end;
+
+procedure TCEGdbWidget.updateFileLineBrks;
+var
+ i,j: integer;
+ doc: TCESynMemo;
+ nme: string;
+begin
+ fFileLineBrks.Clear;
+ if fDocHandler = nil then exit;
+ //
+ for i:= 0 to fDocHandler.documentCount-1 do
+ begin
+ doc := fDocHandler.document[i];
+ if not doc.isDSource then
+ continue;
+ nme := doc.fileName;
+ if not FileExists(nme) then
+ continue;
+ {$WARNINGS OFF}
+ for j := 0 to doc.breakPointsCount-1 do
+ fFileLineBrks.AddObject(nme, TObject(pointer(doc.BreakPointLine(j))));
+ {$WARNINGS ON}
+ end;
+end;
+
+procedure TCEGdbWidget.startDebugging;
+var
+ str: string;
+ i: integer;
+begin
+ // protect
+ if fProj = nil then exit;
+ if fProj.binaryKind <> executable then exit;
+ str := fProj.outputFilename;
+ if not FileExists(str) then exit;
+ // gdb process
+ killGdb;
+ fGdb := TCEProcess.create(nil);
+ fGdb.Executable:= 'gdb' + exeExt;
+ fgdb.Options:= [poUsePipes, poStderrToOutPut];
+ fgdb.Parameters.Add(str);
+ fGdb.OnReadData:= @gdbOutput;
+ fGdb.OnTerminate:= @gdbOutput;
+ fgdb.execute;
+ // file:line breakpoints
+ updateFileLineBrks;
+ for i:= 0 to fFileLineBrks.Count-1 do
+ begin
+ str := 'b ' + fFileLineBrks.Strings[i] + ':' + intToStr(PtrUInt(fFileLineBrks.Objects[i])) + #10;
+ fGdb.Input.Write(str[1], length(str));
+ end;
+ // launch
+ gdbCommand('run');
+end;
+{$ENDREGION}
+
+{$REGIOn GDB output processors -------------------------------------------------}
+procedure TCEGdbWidget.gdbOutput(sender: TObject);
+var
+ str: string;
+begin
+ if fMsg = nil then
+ exit;
+ fLog.Clear;
+ fGdb.getFullLines(fLog);
+ for str in fLog do
+ fMsg.message(str, nil, amcMisc, amkAuto);
+end;
+
+procedure TCEGdbWidget.processSilently(sender: TObject);
+begin
+ fGdb.OutputStack.Clear;
+ fGdb.OnReadData:=@gdbOutput;
+end;
+
+procedure TCEGdbWidget.processInfoRegs(sender: TObject);
+begin
+ try
+ //
+ finally
+ fGdb.OnReadData:=@gdbOutput;
+ end;
+end;
+
+procedure TCEGdbWidget.processInfoStack(sender: TObject);
+begin
+ try
+ //
+ finally
+ fGdb.OnReadData:=@gdbOutput;
+ end;
+end;
+{$ENDREGION}
+
+{$REGIOn GDB commands & actions ------------------------------------------------}
+procedure TCEGdbWidget.gdbCommand(aCommand: string; outputCatcher: TNotifyEvent = nil);
+begin
+ if fGdb = nil then exit;
+ if not fGdb.Running then exit;
+ //
+ aCommand += #10;
+ if assigned(outputCatcher) then
+ fGdb.OnReadData := outputCatcher;
+ fGdb.Input.Write(aCommand[1], length(aCommand));
+end;
+
+procedure TCEGdbWidget.infoRegs;
+begin
+ gdbCommand('info registers', @processInfoRegs);
+end;
+
+procedure TCEGdbWidget.infoStack;
+begin
+ gdbCommand('info stack', @processInfoStack);
+end;
+
+procedure TCEGdbWidget.btnStartClick(Sender: TObject);
+begin
+ startDebugging;
+end;
+
+procedure TCEGdbWidget.btnContClick(Sender: TObject);
+begin
+ gdbCommand('continue');
+end;
+
+procedure TCEGdbWidget.btnStopClick(Sender: TObject);
+begin
+ gdbCommand('stop');
+ killGdb;
+end;
+
+procedure TCEGdbWidget.btnSendComClick(Sender: TObject);
+begin
+ gdbCommand(edit1.Text);
+ edit1.Text := '';
+end;
+
+procedure TCEGdbWidget.Edit1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+begin
+ if Key <> byte(#13) then exit;
+ gdbCommand(edit1.Text);
+ edit1.Text := '';
+end;
+{$ENDREGION}
+
+end.
+
diff --git a/src/ce_main.pas b/src/ce_main.pas
index 6ce4620e..91c5491d 100644
--- a/src/ce_main.pas
+++ b/src/ce_main.pas
@@ -12,7 +12,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_infos, ce_dubproject, ce_dialogs, ce_dubprojeditor, ce_gdb;
type
@@ -216,6 +216,7 @@ type
fSymlWidg: TCESymbolListWidget;
fInfoWidg: TCEInfoWidget;
fDubProjWidg: TCEDubProjectEditorWidget;
+ fGdbWidg: TCEGdbWidget;
fInitialized: boolean;
fRunnableSw: string;
@@ -734,6 +735,7 @@ begin
fSymlWidg := TCESymbolListWidget.create(self);
fInfoWidg := TCEInfoWidget.create(self);
fDubProjWidg:= TCEDubProjectEditorWidget.create(self);
+ fGdbWidg := TCEGdbWidget.create(self);
getMessageDisplay(fMsgs);
@@ -751,6 +753,7 @@ begin
fWidgList.addWidget(@fSymlWidg);
fWidgList.addWidget(@fInfoWidg);
fWidgList.addWidget(@fDubProjWidg);
+ fWidgList.addWidget(@fGdbWidg);
fWidgList.sort(@CompareWidgCaption);
for widg in fWidgList do