mirror of https://gitlab.com/basile.b/dexed.git
initial work on #42, GDB integration
This commit is contained in:
Basile Burg
parent
bfd1a9c6a8
commit
7eab8308cf
|
|
@ -134,7 +134,7 @@
|
|||
<PackageName Value="LCL"/>
|
||||
</Item6>
|
||||
</RequiredPackages>
|
||||
<Units Count="42">
|
||||
<Units Count="43">
|
||||
<Unit0>
|
||||
<Filename Value="coedit.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
|
|
@ -355,6 +355,13 @@
|
|||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit41>
|
||||
<Unit42>
|
||||
<Filename Value="..\src\ce_gdb.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="CEGdbWidget"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit42>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
|
|
|
|||
|
|
@ -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}
|
||||
|
||||
|
|
|
|||
|
|
@ -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 = <
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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.
|
||||
|
||||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue