forks
/
dexed
mirror of https://gitlab.com/basile.b/dexed.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity
dexed/src/ce_gdb.pas

1861 lines
50 KiB
Plaintext
Raw Blame History

unit ce_gdb;
{$I ce_defines.inc}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, RegExpr, ComCtrls,
PropEdits, GraphPropEdits, RTTIGrids, Dialogs, ExtCtrls, Menus, Buttons,
StdCtrls, ValEdit, process, fpjson, typinfo,
ce_common, ce_interfaces, ce_widget, ce_processes, ce_observer, ce_synmemo,
ce_sharedres, ce_stringrange, ce_dsgncontrols, ce_dialogs, ce_dbgitf,
ce_ddemangle, ce_writableComponent;
type
{$IFDEF CPU64}
TCpuRegister = (rax, rbx, rcx, rdx, rsi, rdi, rbp, rsp, r8, r9, r10, r11, r12, r13,
r14, r15, rip);
const stOffset = 24;
type
TFpuRegister = (st0, st1, st2, st3, st4, st5, st6, st7);
{$ENDIF}
{$IFDEF CPU32}
TCpuRegister = (eax, ebx, ecx, edx, esi, edi, ebp, esp, eip);
const stOffset = 16;
type
TFpuRegister = (st0, st1, st2, st3, st4, st5, st6, st7);
{$ENDIF}
TFLAG = (CF, PF, AF, ZF, SF, TF, IF_, DF, OF_, NT, RF, VM, AC, VIF, VIP, ID);
TEFLAG = set of TFLAG;
TSegRegister = (CS, SS, DS, ES, FS, GS);
{$IFDEF CPU64}
const segOffset = 18;
{$ELSE}
const segOffset = 10;
{$ENDIF}
type
// aliased to get hex display in object inspector.
TCpuGprValue = type PtrUInt;
// aliased to get hex display in object inspector.
TCPUSegValue = type word;
// displays a TCpuRegValue in hex
TCpuRegValueEditor = class(TIntegerProperty)
public
function GetValue: ansistring; override;
procedure SetValue(const NewValue: ansistring); override;
end;
// displays a TCPUSegValue in hex
TCpuSegValueEditor = class(TIntegerProperty)
public
function GetValue: ansistring; override;
procedure SetValue(const NewValue: ansistring); override;
end;
TSetGprEvent = procedure(reg: TCpuRegister; val: TCpuGprValue) of object;
// Makes a category for the general purpose registers in a object inspector
TInspectableGPR = class(TPersistent)
private
fRegisters: array[TCpuRegister] of TCpuGprValue;
fSetGprEvent: TSetGprEvent;
procedure setRegister(index: TCpuRegister; value: TCpuGprValue);
published
{$IFDEF CPU64}
property RAX: TCpuGprValue index TCpuRegister.rax read fRegisters[TCpuRegister.rax] write setRegister;
property RBX: TCpuGprValue index TCpuRegister.rbx read fRegisters[TCpuRegister.rbx] write setRegister;
property RCX: TCpuGprValue index TCpuRegister.rcx read fRegisters[TCpuRegister.rcx] write setRegister;
property RDX: TCpuGprValue index TCpuRegister.rdx read fRegisters[TCpuRegister.rdx] write setRegister;
property RSI: TCpuGprValue index TCpuRegister.rsi read fRegisters[TCpuRegister.rsi] write setRegister;
property RDI: TCpuGprValue index TCpuRegister.rdi read fRegisters[TCpuRegister.rdi] write setRegister;
property RBP: TCpuGprValue index TCpuRegister.rbp read fRegisters[TCpuRegister.rbp] write setRegister;
property RSP: TCpuGprValue index TCpuRegister.rsp read fRegisters[TCpuRegister.rsp] write setRegister;
property R8: TCpuGprValue index TCpuRegister.r8 read fRegisters[TCpuRegister.r8] write setRegister;
property R9: TCpuGprValue index TCpuRegister.r9 read fRegisters[TCpuRegister.r9] write setRegister;
property R10: TCpuGprValue index TCpuRegister.r10 read fRegisters[TCpuRegister.r10] write setRegister;
property R11: TCpuGprValue index TCpuRegister.r11 read fRegisters[TCpuRegister.r11] write setRegister;
property R12: TCpuGprValue index TCpuRegister.r12 read fRegisters[TCpuRegister.r12] write setRegister;
property R13: TCpuGprValue index TCpuRegister.r13 read fRegisters[TCpuRegister.r13] write setRegister;
property R14: TCpuGprValue index TCpuRegister.r14 read fRegisters[TCpuRegister.r14] write setRegister;
property R15: TCpuGprValue index TCpuRegister.r15 read fRegisters[TCpuRegister.r15] write setRegister;
property RIP: TCpuGprValue index TCpuRegister.rip read fRegisters[TCpuRegister.rip] write setRegister;
{$ELSE}
property EAX: TCpuRegValue index TCpuRegister.eax read fRegisters[TCpuRegister.eax] write setRegister;
property EBX: TCpuRegValue index TCpuRegister.ebx read fRegisters[TCpuRegister.ebx] write setRegister;
property ECX: TCpuRegValue index TCpuRegister.ecx read fRegisters[TCpuRegister.ecx] write setRegister;
property EDX: TCpuRegValue index TCpuRegister.edx read fRegisters[TCpuRegister.edx] write setRegister;
property ESI: TCpuRegValue index TCpuRegister.esi read fRegisters[TCpuRegister.esi] write setRegister;
property EDI: TCpuRegValue index TCpuRegister.edi read fRegisters[TCpuRegister.edi] write setRegister;
property EBP: TCpuRegValue index TCpuRegister.ebp read fRegisters[TCpuRegister.ebp] write setRegister;
property ESP: TCpuRegValue index TCpuRegister.esp read fRegisters[TCpuRegister.esp] write setRegister;
property EIP: TCpuRegValue index TCpuRegister.eip read fRegisters[TCpuRegister.eip] write setRegister;
{$ENDIF}
public
constructor create(eventGPR: TSetGprEvent);
procedure setInspectableRegister(index: TCpuRegister; value: PtrUInt);
end;
TSetSsrEvent = procedure(reg: TSegRegister; val: TCPUSegValue) of object;
// Makes a category for the segment registers in a object inspector
TInspectableSSR = class(TPersistent)
private
fRegisters: array[TSegRegister] of TCPUSegValue;
fSetSsrEvent: TSetSsrEvent;
procedure setRegister(index: TSegRegister; value: TCPUSegValue);
published
property CS: TCPUSegValue index TSegRegister.CS read fRegisters[TSegRegister.CS] write setRegister;
property SS: TCPUSegValue index TSegRegister.SS read fRegisters[TSegRegister.SS] write setRegister;
property DS: TCPUSegValue index TSegRegister.DS read fRegisters[TSegRegister.DS] write setRegister;
property ES: TCPUSegValue index TSegRegister.ES read fRegisters[TSegRegister.ES] write setRegister;
property FS: TCPUSegValue index TSegRegister.FS read fRegisters[TSegRegister.FS] write setRegister;
property GS: TCPUSegValue index TSegRegister.GS read fRegisters[TSegRegister.GS] write setRegister;
public
constructor create(eventSSR: TSetSsrEvent);
procedure setInspectableRegister(index: TSegRegister; value: TCPUSegValue);
end;
TSetFprEvent = procedure(reg: TFpuRegister; val: extended) of object;
// Makes a category for the floating point unit registers in a object inspector
TInspectableFPR = class(TPersistent)
private
fRegisters: array[TFpuRegister] of extended;
fSetFprEvent: TSetFprEvent;
procedure setRegister(index: TFpuRegister; value: extended);
published
property ST0: extended index TFpuRegister.st0 read fRegisters[TFpuRegister.st0] write setRegister;
property ST1: extended index TFpuRegister.st1 read fRegisters[TFpuRegister.st1] write setRegister;
property ST2: extended index TFpuRegister.st2 read fRegisters[TFpuRegister.st2] write setRegister;
property ST3: extended index TFpuRegister.st3 read fRegisters[TFpuRegister.st3] write setRegister;
property ST4: extended index TFpuRegister.st4 read fRegisters[TFpuRegister.st4] write setRegister;
property ST5: extended index TFpuRegister.st5 read fRegisters[TFpuRegister.st5] write setRegister;
property ST6: extended index TFpuRegister.st6 read fRegisters[TFpuRegister.st6] write setRegister;
property ST7: extended index TFpuRegister.st7 read fRegisters[TFpuRegister.st7] write setRegister;
public
constructor create(event: TSetFprEvent);
procedure setInspectableRegister(index: TFpuRegister; value: extended);
end;
// Makes a category for the SSE registers in a object inspector
TInspectableSSE = class(TPersistent)
// interpretation is a problem:
// 4 int ? 2 double ? 4 single ? ...
end;
// Makes a category for the local variables in an object inspector
TInspectableLocals= class(TPersistent)
private
fLocals: TStringList;
fPropIndex: integer;
procedure readProp(Reader: TReader);
procedure writeProp(Writer: TWriter);
protected
procedure DefineProperties(Filer: TFiler); override;
published
property raw: TStringList read fLocals;
public
constructor create;
destructor destroy; override;
procedure clear;
procedure add(const name,value: string);
end;
// Stores the registers content, to be displayable in an object inspector.
TInspectableCPU = class(TPersistent)
private
fFlags: TEFLAG;
fGpr: TInspectableGPR;
fFpr: TInspectableFPR;
fSsr: TInspectableSSR;
published
property CPU: TInspectableGPR read fGpr;
property FPU: TInspectableFPR read fFpr;
property SSR: TInspectableSSR read fSsr;
//
property EFLAGS: TEFLAG read fFlags;
public
constructor create(setGprEvent: TSetGprEvent; setSsrEvent: TSetSsrEvent;
setFprEvent: TSetFprEvent);
destructor destroy; override;
end;
// Represents an item in the call stack
TStackItem = class(TCollectionItem)
strict private
fFilename: string;
fFname: string;
fAddress: PtrUInt;
fLine: integer;
public
procedure setProperties(addr: PtrUint; fname, nme: string; lne: integer);
property address: ptruint read fAddress;
property filename: string read fFilename;
property line: integer read fLine;
property name: string read fFname;
end;
// The call stack
TStackItems = class
strict private
fItems: TCollection;
procedure listDblClick(sender: TObject);
public
constructor create;
destructor destroy; override;
procedure assignToList(list: TListView);
procedure addItem(addr: PtrUint; fname, nme: string; lne: integer);
procedure clear;
end;
// TODO-cGDB: assembly view
// Makes a category for shortcuts in the option editor.
TCEDebugShortcuts = class(TPersistent)
private
fStart, fStop, fPause, fContinue, fStep, fStepOver, fStack, fRegs,
fVariables: TShortCut;
published
property start: TShortCut read fStart write fStart;
property stop: TShortCut read fStop write fStop;
property pause: TShortCut read fPause write fPause;
property continue: TShortcut read fContinue write fContinue;
property step: TShortCut read fStep write fStep;
property stepOver: TShortCut read fStepOver write fStepOver;
property updateStack: TShortCut read fStack write fStack;
property updateRegisters: TShortCut read fRegs write fRegs;
property updateVariables: TShortCut read fVariables write fVariables;
public
procedure assign(source: TPersistent); override;
end;
TCEDebugOptionsBase = class(TWritableLfmTextComponent)
private
fAutoDemangle: boolean;
fAutoGetCallStack: boolean;
fAutoGetRegisters: boolean;
fAutoGetVariables: boolean;
fCommandsHistory: TStringList;
fIgnoredSignals: TStringList;
fShowGdbOutput: boolean;
fShowOutput: boolean;
fShortcuts: TCEDebugShortcuts;
procedure setIgnoredSignals(value: TStringList);
procedure setCommandsHistory(value: TStringList);
procedure setShortcuts(value: TCEDebugShortcuts);
published
property autoDemangle: boolean read fAutoDemangle write fAutoDemangle;
property autoGetCallStack: boolean read fAutoGetCallStack write fAutoGetCallStack;
property autoGetRegisters: boolean read fAutoGetRegisters write fAutoGetRegisters;
property autoGetVariables: boolean read fAutoGetVariables write fAutoGetVariables;
property commandsHistory: TStringList read fCommandsHistory write setCommandsHistory;
property ignoredSignals: TStringList read fIgnoredSignals write setIgnoredSignals;
property shortcuts: TCEDebugShortcuts read fShortcuts write setShortcuts;
property showGdbOutput: boolean read fShowGdbOutput write fShowGdbOutput;
property showOutput: boolean read fShowOutput write fShowOutput;
public
constructor create(aOwner: TComponent); override;
destructor destroy; override;
procedure assign(source: TPersistent); override;
end;
TCEDebugOptions = class(TCEDebugOptionsBase, ICEEditableOptions)
private
FonChangesApplied: TNotifyEvent;
fBackup: TCEDebugOptionsBase;
function optionedWantCategory(): string;
function optionedWantEditorKind: TOptionEditorKind;
function optionedWantContainer: TPersistent;
procedure optionedEvent(event: TOptionEditorEvent);
function optionedOptionsModified: boolean;
public
constructor create(aOwner: TComponent); override;
destructor destroy; override;
property onChangesApplied: TNotifyEvent read FonChangesApplied write FonChangesApplied;
end;
TGdbState = (gsNone, gsRunning, gsPaused);
{ TCEGdbWidget }
TCEGdbWidget = class(TCEWidget, ICEProjectObserver, ICEDocumentObserver, ICEDebugger, ICEMainMenuProvider)
btnContinue: TCEToolButton;
btnVariables: TCEToolButton;
btnNext: TCEToolButton;
btnOver: TCEToolButton;
btnPause: TCEToolButton;
btnReg: TCEToolButton;
btnStack: TCEToolButton;
btnStart: TCEToolButton;
btnStop: TCEToolButton;
button4: TCEToolButton;
Edit1: TComboBox;
lstCallStack: TListView;
Panel2: TPanel;
Panel3: TPanel;
btnSendCom: TSpeedButton;
stateViewer: TTIPropertyGrid;
ValueListEditor1: TValueListEditor;
procedure btnContClick(Sender: TObject);
procedure btnVariablesClick(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);
procedure btnStartClick(Sender: TObject);
procedure btnStopClick(Sender: TObject);
procedure Edit1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
protected
procedure setToolBarFlat(value: boolean); override;
private
fUpdateMenu: boolean;
fGdbState: TGdbState;
fSubj: TCEDebugObserverSubject;
fDoc: TCESynMemo;
fProj: ICECommonProject;
fJson: TJsonObject;
fLog: TStringList;
fFileLineBrks: TStringList;
fDocHandler: ICEMultiDocHandler;
fMsg: ICEMessagesDisplay;
fGdb: TCEProcess;
fInspState: TInspectableCPU;
fStackItems: TStackItems;
fCatchPause: boolean;
fOptions: TCEDebugOptions;
//
procedure optionsChangesApplied(sender: TObject);
procedure menuDeclare(item: TMenuItem);
procedure menuUpdate(item: TMenuItem);
//
procedure disableEditor;
procedure setState(value: TGdbState);
procedure updateButtonsState;
procedure startDebugging;
procedure killGdb;
procedure storeObserversBreakpoints;
// GDB output processors
procedure gdboutQuiet(sender: TObject);
procedure gdboutJsonize(sender: TObject);
procedure interpretJson;
// GDB commands & actions
procedure gdbCommand(aCommand: string; gdbOutProcessor: TNotifyEvent = nil);
procedure infoRegs;
procedure infoStack;
procedure infoVariables;
procedure sendCustomCommand;
procedure setGpr(reg: TCpuRegister; val: TCpuGprValue);
procedure setFpr(reg: TFpuRegister; val: extended);
procedure setSsr(reg: TSegRegister; val: TCPUSegValue);
//
procedure projNew(project: ICECommonProject);
procedure projChanged(project: ICECommonProject);
procedure projClosing(project: ICECommonProject);
procedure projFocused(project: ICECommonProject);
procedure projCompiling(project: ICECommonProject);
procedure projCompiled(project: ICECommonProject; success: boolean);
//
procedure docNew(document: TCESynMemo);
procedure docFocused(document: TCESynMemo);
procedure docChanged(document: TCESynMemo);
procedure docClosing(document: TCESynMemo);
//
function running: boolean;
function singleServiceName: string;
procedure addBreakPoint(const fname: string; line: integer; kind: TBreakPointKind);
procedure removeBreakPoint(const fname: string; line: integer);
procedure executeFromShortcut(sender: TObject);
public
constructor create(aOwner: TComponent); override;
destructor destroy; override;
end;
implementation
{$R *.lfm}
{$REGION TCEDebugOption --------------------------------------------------------}
const optFname = 'gdbcommander.txt';
procedure TCEDebugShortcuts.assign(source: TPersistent);
var
src: TCEDebugShortcuts;
begin
if source is TCEDebugShortcuts then
begin
src := TCEDebugShortcuts(source);
fStart := src.fStart;
fStop := src.fStop;
fPause := src.fPause;
fContinue := src.fContinue;
fStep := src.fStep;
fStepOver := src.fStepOver;
fStack := src.fStack;
fRegs := src.fRegs;
fVariables:= src.fVariables;
end
else inherited;
end;
constructor TCEDebugOptionsBase.create(aOwner: TComponent);
begin
inherited;
fAutoDemangle := true;
fAutoGetCallStack:= true;
fAutoGetRegisters:= true;
fAutoGetVariables:= true;
fShowGdbOutput:=true;
fIgnoredSignals := TStringList.Create;
fIgnoredSignals.Duplicates:= dupIgnore;
fCommandsHistory := TStringList.Create;
fCommandsHistory.Duplicates:= dupIgnore;
fShortcuts := TCEDebugShortcuts.Create;
end;
destructor TCEDebugOptionsBase.destroy;
begin
fIgnoredSignals.Free;
fCommandsHistory.Free;
fShortcuts.Free;
inherited;
end;
procedure TCEDebugOptionsBase.setIgnoredSignals(value: TStringList);
begin
fIgnoredSignals.Assign(value);
end;
procedure TCEDebugOptionsBase.setCommandsHistory(value: TStringList);
begin
fCommandsHistory.Assign(value);
end;
procedure TCEDebugOptionsBase.setShortcuts(value: TCEDebugShortcuts);
begin
fShortcuts.assign(value);
end;
procedure TCEDebugOptionsBase.assign(source: TPersistent);
var
src: TCEDebugOptionsBase;
begin
if source is TCEDebugOptionsBase then
begin
src := TCEDebugOptionsBase(source);
fAutoDemangle:=src.fAutoDemangle;
fAutoGetCallStack:=src.fAutoGetCallStack;
fAutoGetRegisters:=src.fAutoGetRegisters;
fAutoGetVariables:=src.autoGetVariables;
fShowGdbOutput:=src.fShowGdbOutput;
fShowOutput:=src.fShowOutput;
fIgnoredSignals.Assign(src.fIgnoredSignals);
fCommandsHistory.Assign(src.fCommandsHistory);
fShortcuts.assign(src.fShortcuts);
end
else inherited;
end;
constructor TCEDebugOptions.create(aOwner: TComponent);
var
fname: string;
begin
inherited;
fBackup := TCEDebugOptionsBase.create(self);
fname := getCoeditDocPath + optFname;
if fname.fileExists then
loadFromFile(fname);
EntitiesConnector.addObserver(self);
end;
destructor TCEDebugOptions.destroy;
begin
saveToFile(getCoeditDocPath + optFname);
EntitiesConnector.removeObserver(self);
inherited;
end;
function TCEDebugOptions.optionedWantCategory(): string;
begin
exit('Debugger');
end;
function TCEDebugOptions.optionedWantEditorKind: TOptionEditorKind;
begin
exit(oekGeneric);
end;
function TCEDebugOptions.optionedWantContainer: TPersistent;
begin
exit(self);
end;
procedure TCEDebugOptions.optionedEvent(event: TOptionEditorEvent);
begin
case event of
oeeSelectCat: fBackup.assign(self);
oeeCancel: assign(fBackup);
oeeAccept:
begin
fBackup.assign(self);
if assigned(FonChangesApplied) then
FonChangesApplied(self);
end;
end;
end;
function TCEDebugOptions.optionedOptionsModified: boolean;
begin
exit(false);
end;
{$ENDREGION}
{$REGION TStackItem/TStackItems ------------------------------------------------}
procedure TStackItem.setProperties(addr: PtrUint; fname, nme: string; lne: integer);
begin
fAddress:=addr;
fLine:=lne;
fFilename:=fname;
fFname:= nme;
end;
constructor TStackItems.create;
begin
fItems := TCollection.Create(TStackItem);
end;
destructor TStackItems.destroy;
begin
fItems.Free;
inherited;
end;
procedure TStackItems.assignToList(list: TListView);
var
i: integer;
litm: TListItem;
sitm: TStackItem;
begin
list.Clear;
list.ReadOnly:=true;
list.GridLines:=true;
list.ViewStyle:= TViewStyle.vsReport;
if list.ColumnCount <> 3 then
begin
list.Columns.Clear;
list.Columns.Add;
list.Columns.Add;
list.Columns.Add;
end;
list.Column[0].Caption:= 'function';
list.Column[1].Caption:= 'address';
list.Column[2].Caption:= 'filename';
list.Column[0].AutoSize:= true;
list.Column[1].AutoSize:= true;
list.Column[2].AutoSize:= true;
list.OnDblClick:= @listDblClick;
for i:= 0 to fItems.Count-1 do
begin
litm := list.Items.Add;
sitm := TStackItem(fItems.Items[i]);
litm.Caption := sitm.name;
{$IFDEF CPU64}
litm.SubItems.Add(format('0x%.16X', [sitm.address]));
{$ELSE}
litm.SubItems.Add(format('0x%.8X', [sitm.address]));
{$ENDIF}
litm.SubItems.Add(shortenPath(sitm.filename));
litm.Data:=sitm;
end;
end;
procedure TStackItems.listDblClick(sender: TObject);
var
lst: TListView;
itm: TStackItem;
nme: string;
doc: TCESynMemo;
begin
if (sender.isNil) or not (sender is TListView) then
exit;
lst := TListView(sender);
if lst.Selected.isNil or lst.Selected.Data.isNil then
exit;
itm := TStackItem(lst.Selected.Data);
nme := itm.filename;
if not nme.fileExists then
exit;
getMultiDocHandler.openDocument(nme);
doc := getMultiDocHandler.findDocument(nme);
if doc.isNotNil then
doc.CaretY:= itm.line;
end;
procedure TStackItems.addItem(addr: PtrUint; fname, nme: string; lne: integer);
begin
TStackItem(fItems.Add).setProperties(addr, fname, nme, lne);
end;
procedure TStackItems.clear;
begin
fItems.Clear;
end;
{$ENDREGION}
{$REGION TInspectableCPU -------------------------------------------------------}
function TCpuRegValueEditor.GetValue: ansistring;
begin
{$IFDEF CPU64}
result := '0x' + IntToHex(GetInt64Value, 16);
{$ELSE}
result := '0x' + IntToHex(GetOrdValue, 8);
{$ENDIF}
end;
procedure TCpuRegValueEditor.SetValue(const NewValue: ansistring);
begin
try
{$IFDEF CPU64}
SetInt64Value(StrToQWord(NewValue));
{$ELSE}
SetOrdValue(StrToInt(NewValue));
{$ENDIF}
except
end;
end;
function TCpuSegValueEditor.GetValue: ansistring;
begin
result := '0x' + IntToHex(GetOrdValue, 4);
end;
procedure TCpuSegValueEditor.SetValue(const NewValue: ansistring);
begin
try
SetOrdValue(StrToInt(NewValue));
except
end;
end;
constructor TInspectableGPR.create(eventGPR: TSetGprEvent);
begin
fSetGprEvent:=eventGPR;
end;
procedure TInspectableGPR.setInspectableRegister(index: TCpuRegister; value: PtrUInt);
begin
fRegisters[index] := value;
end;
procedure TInspectableGPR.setRegister(index: TCpuRegister; value: TCpuGprValue);
begin
fSetGprEvent(index, value);
fRegisters[index] := value;
end;
constructor TInspectableSSR.create(eventSSR: TSetSsrEvent);
begin
fSetSsrEvent:=eventSSR;
end;
procedure TInspectableSSR.setInspectableRegister(index: TSegRegister; value: TCPUSegValue);
begin
fRegisters[index] := value;
end;
procedure TInspectableSSR.setRegister(index: TSegRegister; value: TCPUSegValue);
begin
fSetSsrEvent(index, value);
fRegisters[index] := value;
end;
constructor TInspectableFPR.create(event: TSetFprEvent);
begin
fSetFprEvent:=event;
end;
procedure TInspectableFPR.setInspectableRegister(index: TFpuRegister; value: extended);
begin
fRegisters[index] := value;
end;
procedure TInspectableFPR.setRegister(index: TFpuRegister; value: extended);
begin
fSetFprEvent(index, value);
fRegisters[index] := value;
end;
constructor TInspectableLocals.create;
begin
fLocals := TStringList.Create;
end;
destructor TInspectableLocals.destroy;
begin
fLocals.Free;
inherited;
end;
procedure TInspectableLocals.DefineProperties(Filer: TFiler);
var
i: integer;
begin
//TODO-cGDB: The object inspector doesn't use DefineProperties to discover custom properties
inherited;
for i := 0 to fLocals.Count-1 do
begin
fPropIndex := i;
filer.DefineProperty(fLocals.Names[i], @readProp, @writeProp, true);
end;
end;
procedure TInspectableLocals.readProp(Reader: TReader);
begin
end;
procedure TInspectableLocals.writeProp(Writer: TWriter);
begin
try
writer.WriteString(fLocals.ValueFromIndex[fPropIndex]);
except
writer.WriteString('<N/A>');
end;
end;
procedure TInspectableLocals.clear;
begin
fLocals.Clear;
end;
procedure TInspectableLocals.add(const name,value: string);
begin
fLocals.Values[name] := value;
end;
constructor TInspectableCPU.create(setGprEvent: TSetGprEvent; setSsrEvent: TSetSsrEvent;
setFprEvent: TSetFprEvent);
begin
fGpr := TInspectableGPR.create(setGprEvent);
fSsr := TInspectableSSR.create(setSsrEvent);
fFpr := TInspectableFPR.create(setFprEvent);
end;
destructor TInspectableCPU.destroy;
begin
fGpr.Free;
fFPr.Free;
fSSr.Free;
inherited;
end;
{$ENDREGION}
{$REGION Common/standard comp --------------------------------------------------}
constructor TCEGdbWidget.create(aOwner: TComponent);
begin
inherited;
EntitiesConnector.addObserver(self);
EntitiesConnector.addSingleService(self);
fDocHandler:= getMultiDocHandler;
fMsg:= getMessageDisplay;
fFileLineBrks:= TStringList.Create;
fLog := TStringList.Create;
fInspState := TInspectableCPU.Create(@setGpr, @setSsr, @setFpr);
stateViewer.TIObject := fInspState;
fJson := TJsonObject.Create;
fStackItems := TStackItems.create;
fSubj:= TCEDebugObserverSubject.Create;
fOptions:= TCEDebugOptions.create(self);
fOptions.onChangesApplied:=@optionsChangesApplied;
Edit1.Items.Assign(fOptions.commandsHistory);
//
AssignPng(btnSendCom, 'ACCEPT');
setState(gsNone);
end;
destructor TCEGdbWidget.destroy;
begin
fOptions.commandsHistory.Assign(edit1.Items);
fOptions.Free;
fFileLineBrks.Free;
fLog.Free;
killGdb;
fInspState.Free;
fJson.Free;
fStackItems.Free;
EntitiesConnector.removeObserver(self);
fSubj.free;
inherited;
end;
procedure TCEGdbWidget.setToolBarFlat(value: boolean);
begin
inherited setToolBarFLat(value);
btnSendCom.Flat:=value;
end;
procedure TCEGdbWidget.menuDeclare(item: TMenuItem);
var
itm: TMenuItem;
bmp: TBitmap;
i: integer;
begin
item.Caption:='Debugger';
item.Clear;
bmp := TBitmap.Create;
itm := TMenuItem.Create(item);
itm.ShortCut:=fOptions.shortcuts.start;
itm.Caption:='Start';
itm.OnClick:= @executeFromShortcut;
itm.Tag:=0;
item.Add(itm);
btnStart.toBitmap(bmp);
itm.Bitmap.Assign(bmp);
i := item.GetImageList.Add(bmp, nil);
itm.ImageIndex:= i;
itm := TMenuItem.Create(item);
itm.ShortCut:=fOptions.shortcuts.stop;
itm.Caption:='Stop';
itm.OnClick:= @executeFromShortcut;
itm.Tag:=1;
item.Add(itm);
btnStop.toBitmap(bmp);
itm.Bitmap.Assign(bmp);
i := item.GetImageList.Add(bmp, nil);
itm.ImageIndex:= i;
itm := TMenuItem.Create(item);
itm.ShortCut:=fOptions.shortcuts.pause;
itm.Caption:='Pause';
itm.OnClick:= @executeFromShortcut;
itm.Tag:=2;
item.Add(itm);
btnPause.toBitmap(bmp);
itm.Bitmap.Assign(bmp);
i := item.GetImageList.Add(bmp, nil);
itm.ImageIndex:= i;
itm := TMenuItem.Create(item);
itm.ShortCut:=fOptions.shortcuts.continue;
itm.Caption:='Continue';
itm.OnClick:= @executeFromShortcut;
itm.Tag:=3;
item.Add(itm);
btnContinue.toBitmap(bmp);
itm.Bitmap.Assign(bmp);
i := item.GetImageList.Add(bmp, nil);
itm.ImageIndex:= i;
itm := TMenuItem.Create(item);
itm.ShortCut:=fOptions.shortcuts.step;
itm.Caption:='Step';
itm.OnClick:= @executeFromShortcut;
itm.Tag:=4;
item.Add(itm);
btnNext.toBitmap(bmp);
itm.Bitmap.Assign(bmp);
i := item.GetImageList.Add(bmp, nil);
itm.ImageIndex:= i;
itm := TMenuItem.Create(item);
itm.ShortCut:=fOptions.shortcuts.stepOver;
itm.Caption:='Step over';
itm.OnClick:= @executeFromShortcut;
itm.Tag:=5;
item.Add(itm);
btnOver.toBitmap(bmp);
itm.Bitmap.Assign(bmp);
i := item.GetImageList.Add(bmp, nil);
itm.ImageIndex:= i;
itm := TMenuItem.Create(item);
itm.Caption:= '-';
itm.Tag:=-1;
item.Add(itm);
itm := TMenuItem.Create(item);
itm.ShortCut:=fOptions.shortcuts.updateRegisters;
itm.Caption:='Update registers';
itm.OnClick:= @executeFromShortcut;
itm.Tag:=6;
item.Add(itm);
btnReg.toBitmap(bmp);
itm.Bitmap.Assign(bmp);
i := item.GetImageList.Add(bmp, nil);
itm.ImageIndex:= i;
itm := TMenuItem.Create(item);
itm.ShortCut:=fOptions.shortcuts.updateStack;
itm.Caption:='Update call stack';
itm.OnClick:= @executeFromShortcut;
itm.Tag:=7;
item.Add(itm);
btnStack.toBitmap(bmp);
itm.Bitmap.Assign(bmp);
i := item.GetImageList.Add(bmp, nil);
itm.ImageIndex:= i;
itm := TMenuItem.Create(item);
itm.ShortCut:=fOptions.shortcuts.updateVariables;
itm.Caption:='Update the variables';
itm.OnClick:= @executeFromShortcut;
itm.Tag:=8;
item.Add(itm);
btnVariables.toBitmap(bmp);
itm.Bitmap.Assign(bmp);
i := item.GetImageList.Add(bmp, nil);
itm.ImageIndex:= i;
bmp.Free;
end;
procedure TCEGdbWidget.menuUpdate(item: TMenuItem);
var
i: integer;
itm: TMenuItem;
begin
if item.isNil or not fUpdateMenu then
exit;
fUpdateMenu := false;
for i:= 0 to item.Count-1 do
begin
itm := item.Items[i];
case itm.Tag of
0: itm.ShortCut:=fOptions.shortcuts.start;
1: itm.ShortCut:=fOptions.shortcuts.stop;
2: itm.ShortCut:=fOptions.shortcuts.pause;
3: itm.ShortCut:=fOptions.shortcuts.continue;
4: itm.ShortCut:=fOptions.shortcuts.step;
5: itm.ShortCut:=fOptions.shortcuts.stepOver;
6: itm.ShortCut:=fOptions.shortcuts.updateRegisters;
7: itm.ShortCut:=fOptions.shortcuts.updateStack;
8: itm.ShortCut:=fOptions.shortcuts.updateVariables;
end;
end;
end;
procedure TCEGdbWidget.optionsChangesApplied(sender: TObject);
begin
fUpdateMenu:=true;
end;
procedure TCEGdbWidget.executeFromShortcut(sender: TObject);
begin
case TMenuItem(sender).Tag of
0: btnStart.Click;
1: btnStop.Click;
2: btnPause.Click;
3: btnContinue.Click;
4: btnNext.Click;
5: btnOver.Click;
6: btnReg.Click;
7: btnStack.Click;
8: btnVariables.Click;
end;
end;
{$ENDREGION}
{$REGION ICEProjectObserver ----------------------------------------------------}
procedure TCEGdbWidget.projNew(project: ICECommonProject);
begin
fProj := project;
end;
procedure TCEGdbWidget.projChanged(project: ICECommonProject);
begin
if fProj <> project then
exit;
end;
procedure TCEGdbWidget.projClosing(project: ICECommonProject);
begin
if fProj <> project then
exit;
fProj := nil;
end;
procedure TCEGdbWidget.projFocused(project: ICECommonProject);
begin
fProj := project;
end;
procedure TCEGdbWidget.projCompiling(project: ICECommonProject);
begin
end;
procedure TCEGdbWidget.projCompiled(project: ICECommonProject; success: boolean);
begin
end;
{$ENDREGION}
{$REGION ICEDocumentObserver ---------------------------------------------------}
procedure TCEGdbWidget.docNew(document: TCESynMemo);
begin
end;
procedure TCEGdbWidget.docFocused(document: TCESynMemo);
begin
fDoc := document;
end;
procedure TCEGdbWidget.docChanged(document: TCESynMemo);
begin
end;
procedure TCEGdbWidget.docClosing(document: TCESynMemo);
begin
if fDoc = document then
fDoc := nil;
end;
{$ENDREGION}
{$REGION Unsorted Debugging things ---------------------------------------------}
function TCEGdbWidget.running: boolean;
begin
if assigned(fGdb) then
exit(fGdb.Running)
else
exit(false);
end;
function TCEGdbWidget.singleServiceName: string;
begin
exit('ICEDebugger');
end;
procedure TCEGdbWidget.killGdb;
begin
if not assigned(fGdb) then
exit;
if fGdb.Running then
fGdb.Terminate(0);
FreeAndNil(fGdb);
end;
procedure TCEGdbWidget.storeObserversBreakpoints;
var
i,j: integer;
obs: ICEDebugObserver;
nme: string;
lne: integer;
knd: TBreakPointKind;
begin
fFileLineBrks.Clear;
for i:= 0 to fSubj.observersCount-1 do
begin
obs := fSubj.observers[i] as ICEDebugObserver;
for j := 0 to obs.debugQueryBpCount-1 do
begin
obs.debugQueryBreakPoint(j, nme, lne, knd);
{$PUSH}{$WARNINGS OFF}{$HINTS OFF}
fFileLineBrks.AddObject(nme, TObject(pointer(lne)));
{$POP}
end;
end;
end;
procedure TCEGdbWidget.addBreakPoint(const fname: string; line: integer; kind: TBreakPointKind);
begin
if fGdb.isNil or not fGdb.Running then
exit;
//TODO-cGDB: handle trace points
gdbCommand('break ' + fname + ':' + intToStr(line));
end;
procedure TCEGdbWidget.removeBreakPoint(const fname: string; line: integer);
begin
if fGdb.isNil or not fGdb.Running then
exit;
gdbCommand('clear ' + fname + ':' + intToStr(line));
end;
procedure TCEGdbWidget.setState(value: TGdbState);
begin
if fGdbState = value then
exit;
fGdbState:=value;
updateButtonsState;
end;
procedure TCEGdbWidget.updateButtonsState;
begin
case fGdbState of
gsNone:
begin
btnStart.Enabled:=true;
btnStop.Enabled:=false;
btnPause.Enabled:=false;
btnContinue.Enabled:=false;
btnNext.Enabled:=false;
btnOver.Enabled:=false;
btnReg.Enabled:=false;
btnVariables.Enabled:=false;
btnStack.Enabled:=false;
end;
gsPaused:
begin
btnStart.Enabled:=false;
btnStop.Enabled:=true;
btnPause.Enabled:=false;
btnContinue.Enabled:=true;
btnNext.Enabled:=true;
btnOver.Enabled:=true;
btnReg.Enabled:=true;
btnVariables.Enabled:=true;
btnStack.Enabled:=true;
end;
gsRunning:
begin
btnStart.Enabled:=false;
btnStop.Enabled:=true;
btnPause.Enabled:=true;
btnContinue.Enabled:=false;
btnNext.Enabled:=false;
btnOver.Enabled:=false;
btnReg.Enabled:=false;
btnVariables.Enabled:=false;
btnStack.Enabled:=false;
end;
end;
end;
procedure TCEGdbWidget.disableEditor;
begin
stateViewer.ItemIndex:=-1;
end;
procedure TCEGdbWidget.startDebugging;
var
str: string;
gdb: string;
i: integer;
begin
// protect
if fProj = nil then
exit;
if fProj.binaryKind <> executable then
exit;
str := fProj.outputFilename;
if not str.fileExists then
exit;
gdb := exeFullName('gdb');
if not gdb.fileExists then
exit;
subjDebugStart(fSubj, self as ICEDebugger);
// gdb process
killGdb;
fGdb := TCEProcess.create(nil);
fGdb.Executable:= gdb;
fgdb.Options:= [poUsePipes, poStderrToOutPut];
fgdb.Parameters.Add(str);
//TODO-cGDB: debugee environment
//TODO-cGDB: debugee command line
//TODO-cGDB: pass input to debugee
fgdb.Parameters.Add('--interpreter=mi');
fGdb.OnReadData:= @gdboutQuiet;
fGdb.OnTerminate:= @gdboutJsonize;
fgdb.execute;
// file:line breakpoints
storeObserversBreakpoints;
for i:= 0 to fFileLineBrks.Count-1 do
begin
str := 'break ' + fFileLineBrks.Strings[i] + ':' + intToStr(PtrUInt(fFileLineBrks.Objects[i])) + #10;
fGdb.Input.Write(str[1], str.length);
end;
// break on druntime exceptions + any throw'
gdbCommand('break onAssertError');
gdbCommand('break onAssertErrorMsg');
gdbCommand('break onUnittestErrorMsg');
gdbCommand('break onRangeError');
gdbCommand('break onFinalizeError');
gdbCommand('break onHiddenFuncError');
gdbCommand('break onOutOfMemoryError');
gdbCommand('break onInvalidMemoryOperationError');
gdbCommand('break onSwitchError');
gdbCommand('break onUnicodeError');
gdbCommand('break _d_throwc');
gdbCommand('break _d_throwdwarf');
gdbCommand('break _d_assertm');
gdbCommand('break _d_assert');
gdbCommand('break _d_assert_msg');
gdbCommand('break _d_array_bounds');
gdbCommand('break _d_arraybounds');
gdbCommand('break _d_switch_error');
gdbCommand('-gdb-set mi-async on');
fGdb.OnReadData := @gdboutJsonize;
// launch
gdbCommand('run');
setState(gsRunning);
end;
{$ENDREGION}
{$REGION GDB output processors -------------------------------------------------}
procedure parseGdbout(const str: string; var json: TJSONObject);
procedure parseProperty(node: TJSONObject; r: PStringRange); forward;
procedure parseProperty(node: TJSONArray; r: PStringRange); forward;
procedure parseCLI(node: TJSONObject; r: PStringRange);
var
lne: TStringRange;
msg: string = '';
begin
if r^.front = '"' then
r^.popFront;
while true do
begin
lne := r^.takeUntil(['\', '"']);
if (r^.empty) then
break
else if r^.front = '\' then
begin
r^.popFront;
if r^.front = 'n' then
begin
r^.popFront;
node.Arrays['CLI'].Add(msg + lne.yield);
msg := '';
end else
msg += lne.yield;
end
else if r^.front = '"' then
begin
r^.popFront;
if r^.front = #10 then
begin
r^.popFront;
break;
end;
end;
end;
end;
procedure parseInferior(node: TJSONObject; r: PStringRange);
begin
while true do
begin
// TODO-cGDB: detect invalid command after GDB prefix, maybe inferior output
if r^.empty or (r^.front in ['~','^','*','=','&',(*'+',*)'@']) then
break;
node.Arrays['OUT'].Add(r^.takeUntil(#10).yield);
if not r^.empty then
r^.popFront;
end;
end;
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
'a'..'z':
begin
r^.takeUntil('=').yield;
r^.popFront;
end;
'"':
begin
r^.popFront;
node.Strings[node.Count] := r^.takeUntil('"').yield;
r^.popFront;
end;
'{':
begin
r^.popFront;
node.Objects[node.Count] := TJSONObject.Create;
parseProperty(node.Objects[node.Count-1], r);
end;
']':
begin
r^.popFront;
exit;
end;
',': r^.popFront;
#10:
begin
r^.popFront;
exit;
end;
end;
end;
end;
procedure parseProperty(node: TJSONObject; r: PStringRange);
var
idt,v: 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
v := '';
r^.popFront;
while true do
begin
v += r^.takeUntil(['"','\']).yield;
if r^.front = '\' then
begin
v += '\';
r^.popFront;
if r^.front = '"' then
begin
r^.popFront;
v += '"';
end;
end else
break;
end;
node.Strings[idt] := v;
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
json.Clear;
if str.length = 0 then
exit;
rng.init(str);
json.Arrays['OUT'] := TJSONArray.Create;
json.Arrays['CLI'] := TJSONArray.Create;
while true do
begin
if rng.empty then
exit;
case rng.front of
// event
'*':
begin
parseProperty(json, rng.popUntil(',')^.popFront);
end;
// command answer (can be a simple '^done')
'^':
begin
parseProperty(json, rng.popUntil([',', #10]));
end;
// what would be output in a console by gdb
'~':
begin
parseCLI(json, rng.popFront);
end;
// internal gdb messages
'&':
begin
rng.popUntil(#10);
if not rng.empty then
rng.popFront;
end;
// async notify / status / out stream when remote (@)
'=', (*'+',*)'@':
begin
rng.popUntil(#10);
if not rng.empty then
rng.popFront;
end
else
begin
if rng.startsWith('(gdb)') then
rng.popFrontN(7)
// empty line, inferior output
else
parseInferior(json, @rng);
end;
end;
end;
end;
procedure TCEGdbWidget.interpretJson;
procedure autoGetStuff;
begin
if fOptions.autoGetCallStack then
infoStack;
if fOptions.autoGetRegisters then
infoRegs;
if fOptions.autoGetVariables then
infoVariables;
end;
var
i: integer;
val: TJSONData;
obj: TJSONObject;
arr: TJSONArray;
// common data
nme: string;
reason: string;
addr: PtrUint = 0;
fullname: string = '';
func:string = '';
line: integer = -1;
// registers data
number: integer = 0;
// signal data
sigmean: string;
signame: string;
brkreason: TCEDebugBreakReason;
// FPU
fFpuExtended: extended;
fFpuRaw: array[0..9] of Byte absolute fFpuExtended;
begin
val := fJson.Find('reason');
if val.isNotNil then
begin
reason := val.AsString;
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
val := obj.Find('fullname');
if val.isNotNil then
fullname := val.AsString;
val := obj.Find('line');
if val.isNotNil then
line := val.AsInteger;
if fDocHandler.findDocument(fullname).isNil and fullname.fileExists then
fDocHandler.openDocument(fullname);
setState(gsPaused);
autoGetStuff;
subjDebugBreak(fSubj, fullname, line, brkreason);
end;
end
else if reason = 'signal-received' then
begin
signame := 'unknown signal';
sigmean := 'unknown meaning';
val := fJson.Find('signal-name');
if val.isNotNil then
signame := val.AsString;
if (fOptions.ignoredSignals.Count <> 0) and
(fOptions.ignoredSignals.IndexOf(signame) <> -1) then
exit;
val := fJson.Find('signal-meaning');
if val.isNotNil then
sigmean := val.AsString;
obj := TJSONObject(fJson.Find('frame'));
if obj.isNotNil and (obj.JSONType = jtObject) then
begin
val := obj.Find('fullname');
if val.isNotNil then
fullname := val.AsString;
val := obj.Find('line');
if val.isNotNil then
line := val.AsInteger;
end;
if fCatchPause then
begin
fCatchPause := false;
if fDocHandler.findDocument(fullname).isNil and fullname.fileExists then
fDocHandler.openDocument(fullname);
autoGetStuff;
setState(gsPaused);
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
begin
gdbCommand('continue', @gdboutJsonize);
setState(gsRunning);
end
else
begin
if not fDocHandler.findDocument(fullname).isNil and fullname.fileExists then
fDocHandler.openDocument(fullname);
autoGetStuff;
setState(gsPaused);
subjDebugBreak(fSubj, fullname, line, dbSignal);
end;
end;
end
else if (reason = 'exited-normally') or (reason = 'exited-signalled') then
begin
setState(gsNone);
subjDebugStop(fSubj);
end;
end;
val := fJson.Find('msg');
if val.isNotNil then
begin
fMsg.message(val.AsString, nil, amcMisc, amkAuto);
end;
val := fJson.Find('register-values');
if val.isNotNil and (val.JSONType = jtArray) then
begin
arr := TJSONArray(val);
for i := 0 to arr.Count-1 do
begin
obj := TJSONObject(arr.Objects[i]);
if obj.isNil then
break
else
begin
val := obj.Find('number');
if val.isNotNil then
number := val.AsInteger;
val := obj.Find('value');
if val.isNotNil then case number of
0..integer(high(TCpuRegister)):
begin
fInspState.CPU.setInspectableRegister
(TCpuRegister(number), {$IFDEF CPU64}val.AsInt64{$ELSE}val.AsInteger{$ENDIF});
end;
segOffset..segOffset+5:
begin
fInspState.SSR.setInspectableRegister
(TSegRegister(number - segOffset), val.AsInteger);
end;
stOffset..stOffset+7:
begin
fFpuRaw[9] := StrToInt('$' + val.AsString[3..4]);
fFpuRaw[8] := StrToInt('$' + val.AsString[5..6]);
fFpuRaw[7] := StrToInt('$' + val.AsString[7..8]);
fFpuRaw[6] := StrToInt('$' + val.AsString[9..10]);
fFpuRaw[5] := StrToInt('$' + val.AsString[11..12]);
fFpuRaw[4] := StrToInt('$' + val.AsString[13..14]);
fFpuRaw[3] := StrToInt('$' + val.AsString[15..16]);
fFpuRaw[2] := StrToInt('$' + val.AsString[17..18]);
fFpuRaw[1] := StrToInt('$' + val.AsString[19..20]);
fFpuRaw[0] := StrToInt('$' + val.AsString[21..22]);
fInspState.FPU.setInspectableRegister
(TFpuRegister(number - stOffset), fFpuExtended);
end;
end;
// TODO-cGDB: get SSE registers
// TODO-cGDB: get EFLAGS
end;
end;
stateViewer.RefreshPropertyValues;
end;
val := fJson.Find('stack');
if val.isNotNil and (val.JSONType = jtArray) then
begin
fStackItems.clear;
lstCallStack.Clear;
arr := TJSONArray(val);
for i := 0 to arr.Count-1 do
begin
obj := arr.Objects[i];
if obj.isNil then
break;
val := obj.Find('fullname');
if val.isNotNil then
fullname:= val.AsString;
val := obj.Find('func');
if val.isNotNil then
begin
if fOptions.autoDemangle then
func:= demangle(val.AsString)
else
func := val.AsString;
end;
val := obj.Find('addr');
if val.isNotNil then
addr := val.AsInt64;
val := obj.Find('line');
if val.isNotNil then
line := val.AsInteger;
fStackItems.addItem(addr, fullname, func, line);
end;
fStackItems.assignToList(lstCallStack);
end;
val := fJson.Find('variables');
if val.isNotNil and (val.JSONType = jtArray) then
begin
ValueListEditor1.Clear;
arr := TJSONArray(val);
for i := 0 to arr.Count-1 do
begin
val := arr.Items[i];
if val.JSONType <> jtObject then
continue;
obj := TJSONObject(val);
val := obj.Find('name');
if val.isNil then
continue;
nme := val.AsString;
val := obj.Find('value');
if val.isNil then
continue;
ValueListEditor1.InsertRow(nme, val.AsString, true);
end;
end;
if fOptions.showGdbOutput then
begin
arr := TJSONArray(fJson.Find('CLI'));
if arr.isNotNil then
for i := 0 to arr.Count-1 do
fMsg.message(arr.Strings[i], nil, amcMisc, amkBub);
end;
if fOptions.showOutput then
begin
arr := TJSONArray(fJson.Find('OUT'));
if arr.isNotNil then
for i := 0 to arr.Count-1 do
fMsg.message(arr.Strings[i], nil, amcMisc, amkBub);
end;
end;
procedure TCEGdbWidget.gdboutJsonize(sender: TObject);
var
str: string;
lst: TStringList;
begin
if fMsg = nil then
exit;
fLog.Clear;
fGdb.getFullLines(fLog);
for str in fLog do
fMsg.message(str, nil, amcMisc, amkAuto);
if flog.Text.isEmpty then
exit;
parseGdbout(fLog.Text, fJson);
interpretJson;
//lst := TStringList.Create;
//try
// str := fJson.FormatJSON(DefaultFormat,2);
// lst.Text:= str;
// lst.SaveToFile('/home/basile/gdbmessage.json');
//finally
// lst.Free;
//end;
end;
procedure TCEGdbWidget.gdboutQuiet(sender: TObject);
begin
fGdb.OutputStack.Clear;
fGdb.OnReadData:=@gdboutJsonize;
end;
{$ENDREGION}
{$REGION GDB commands & actions ------------------------------------------------}
procedure TCEGdbWidget.gdbCommand(aCommand: string; gdbOutProcessor: TNotifyEvent = nil);
begin
if fGdb.isNil or not fGdb.Running then
exit;
aCommand += #10;
if assigned(gdbOutProcessor) then
fGdb.OnReadData := gdbOutProcessor;
fGdb.Input.Write(aCommand[1], aCommand.length);
end;
procedure TCEGdbWidget.infoRegs;
begin
disableEditor;
gdbCommand('-data-list-register-values r', @gdboutJsonize);
end;
procedure TCEGdbWidget.infoStack;
begin
gdbCommand('-stack-list-frames', @gdboutJsonize);
end;
procedure TCEGdbWidget.infoVariables;
begin
gdbCommand('-stack-list-variables 1');
end;
procedure TCEGdbWidget.btnStartClick(Sender: TObject);
begin
startDebugging;
end;
procedure TCEGdbWidget.btnContClick(Sender: TObject);
begin
gdbCommand('-exec-continue --all', @gdboutJsonize);
if assigned(fGdb) and fgdb.Running then
setState(gsRunning);
end;
procedure TCEGdbWidget.btnVariablesClick(Sender: TObject);
begin
infoVariables;
end;
procedure TCEGdbWidget.btnNextClick(Sender: TObject);
begin
gdbCommand('step', @gdboutJsonize);
if assigned(fGdb) and fgdb.Running then
setState(gsRunning);
end;
procedure TCEGdbWidget.btnOverClick(Sender: TObject);
begin
gdbCommand('next', @gdboutJsonize);
if assigned(fGdb) and fgdb.Running then
setState(gsRunning);
end;
procedure TCEGdbWidget.btnPauseClick(Sender: TObject);
begin
if assigned(fGdb) and fGdb.Running then
fCatchPause:=true;
gdbCommand('-exec-interrupt --all', @gdboutJsonize);
end;
procedure TCEGdbWidget.btnRegClick(Sender: TObject);
begin
infoRegs;
end;
procedure TCEGdbWidget.btnStackClick(Sender: TObject);
begin
infoStack;
end;
procedure TCEGdbWidget.btnStopClick(Sender: TObject);
begin
gdbCommand('kill', @gdboutJsonize);
subjDebugStop(fSubj);
setState(gsNone);
end;
procedure TCEGdbWidget.btnSendComClick(Sender: TObject);
begin
sendCustomCommand;
end;
procedure TCEGdbWidget.Edit1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Key = byte(#13) then
sendCustomCommand;
end;
procedure TCEGdbWidget.sendCustomCommand;
var
cmd: string;
begin
cmd := edit1.Text;
if cmd.isBlank or cmd.isEmpty then
exit;
gdbCommand(cmd, @gdboutJsonize);
if edit1.Items.IndexOf(cmd) = -1 then
edit1.Items.Add(cmd);
edit1.Text := '';
end;
procedure TCEGdbWidget.setGpr(reg: TCpuRegister; val: TCpuGprValue);
const
spec = 'set $%s = 0x%X';
var
cmd : string;
begin
cmd := format(spec, [GetEnumName(typeinfo(TCpuRegister),integer(reg)), val]);
gdbCommand(cmd);
end;
procedure TCEGdbWidget.setSsr(reg: TSegRegister; val: TCPUSegValue);
const
spec = 'set $%s = 0x%X';
var
cmd : string;
begin
cmd := format(spec, [GetEnumName(typeinfo(TSegRegister),integer(reg)), val]);
gdbCommand(cmd);
end;
procedure TCEGdbWidget.setFpr(reg: TFpuRegister; val: extended);
const
spec = 'set $%s = %.18g';
var
cmd : string;
begin
cmd := format(spec, [GetEnumName(typeinfo(TFpuRegister),integer(reg)), val]);
gdbCommand(cmd);
end;
{$ENDREGION}
initialization
RegisterPropertyEditor(TypeInfo(TCpuGprValue), nil, '', TCpuRegValueEditor);
RegisterPropertyEditor(TypeInfo(TCpuSegValue), nil, '', TCpuSegValueEditor);
end.
Reference in New Issue View Git Blame Copy Permalink