paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-01 15:32:35 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazDebuggerFPDServer: Retrieve disassembled code from the fpdserver

Browse Source 
git-svn-id: trunk@49294 -
This commit is contained in:
joost 2015-06-08 19:20:20 +00:00
parent 4897c219cd
commit a4c7f8664f
2 changed files with 104 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
components/lazdebuggers/lazdebuggerfpdserver/fpdserverdebugger.pas
View File

@ -217,6 +217,20 @@ type
procedure DoOnCommandFailed(ACommandResponse: TJSonObject); override;
end;
{ TFPDSendDisassembleCommand }
TFPDSendDisassembleCommand = class(TFPDSendCommand)
private
FDisassembler: TDBGDisassembler;
FStartAddr: TDBGPtr;
FLinesCount: integer;
protected
procedure ComposeJSon(AJsonObject: TJSONObject); override;
public
constructor create(ADisassembler: TDBGDisassembler; AStartAddr: TDBGPtr; ALinesCount: integer);
procedure DoOnCommandSuccesfull(ACommandResponse: TJSonObject); override;
end;
{ TFPDSocketThread }
TFPDSocketThread = class(TThread)
@ -278,6 +292,7 @@ type
function CreateBreakPoints: TDBGBreakPoints; override;
function CreateWatches: TWatchesSupplier; override;
function CreateCallStack: TCallStackSupplier; override;
function CreateDisassembler: TDBGDisassembler; override;
function RequestCommand(const ACommand: TDBGCommand; const AParams: array of const): Boolean; override;
// These methods are called by several TFPDSendCommands after success or failure of a command. (Most common
// because the TFPDSendCommands do not have access to TFPDServerDebugger's protected methods theirself)
@ -324,6 +339,17 @@ type
function FindByUID(AnUID: integer): TFPBreakpoint;
end;
{ TFPDBGDisassembler }
TFPDBGDisassembler = class(TDBGDisassembler)
protected
function PrepareEntries(AnAddr: TDbgPtr; ALinesBefore, ALinesAfter: Integer): boolean; override;
public
// Used in the succes callback of the TFPDSendDisassembleCommand command to add
// the retrieved range of assembly instructions.
procedure AddRange(ARange: TDBGDisassemblerEntryRange);
end;
{ TFPWatches }
TFPWatches = class(TWatchesSupplier)
@ -353,6 +379,22 @@ end;
var GCommandUID: integer = 0;
{ TFPDBGDisassembler }
function TFPDBGDisassembler.PrepareEntries(AnAddr: TDbgPtr; ALinesBefore, ALinesAfter: Integer): boolean;
begin
Assert(ALinesBefore<>0,'TFPDBGDisassembler.PrepareEntries LinesBefore not supported');
TFPDServerDebugger(Debugger).QueueCommand(TFPDSendDisassembleCommand.create(self, AnAddr, ALinesAfter+1));
result := false;
end;
procedure TFPDBGDisassembler.AddRange(ARange: TDBGDisassemblerEntryRange);
begin
EntryRanges.AddRange(ARange);
Changed;
end;
{ TFPCallStackSupplier }
procedure TFPCallStackSupplier.RequestCount(ACallstack: TCallStackBase);
@ -1184,6 +1226,11 @@ begin
Result:=TFPCallStackSupplier.Create(Self);
end;
function TFPDServerDebugger.CreateDisassembler: TDBGDisassembler;
begin
Result:=TFPDBGDisassembler.Create(Self);
end;
function TFPDServerDebugger.RequestCommand(const ACommand: TDBGCommand; const AParams: array of const): Boolean;
var
ASendCommand: TFPDSendEvaluateCommand;

57
components/lazdebuggers/lazdebuggerfpdserver/fpdserverdebuggercommands.inc
View File

@ -252,6 +252,63 @@ begin
end;
end;
{ TFPDSendDisassembleCommand }
procedure TFPDSendDisassembleCommand.ComposeJSon(AJsonObject: TJSONObject);
begin
inherited ComposeJSon(AJsonObject);
AJsonObject.Add('command','disassemble');
if FStartAddr>0 then
AJsonObject.Add('address', Dec2Numb(FStartAddr, 8, 16));
if FLinesCount>0 then
AJsonObject.Add('lines', FLinesCount);
end;
constructor TFPDSendDisassembleCommand.create(ADisassembler: TDBGDisassembler;
AStartAddr: TDBGPtr; ALinesCount: integer);
begin
inherited create(true);
FDisassembler := ADisassembler;
FLinesCount:=ALinesCount;
FStartAddr:=AStartAddr;
end;
procedure TFPDSendDisassembleCommand.DoOnCommandSuccesfull(ACommandResponse: TJSonObject);
var
JSonCallStackArr: TJSONArray;
JSonCallStackEntryObj: TJSONObject;
ARange: TDBGDisassemblerEntryRange;
AnEntry: TDisassemblerEntry;
i: Integer;
begin
if assigned(FDisassembler) then
begin
JSonCallStackArr := ACommandResponse.Get('disassembly', TJSONArray(nil));
if assigned(JSonCallStackArr) and (JSonCallStackArr.Count>0) then
begin
ARange := TDBGDisassemblerEntryRange.Create;
ARange.RangeStartAddr:=Hex2Dec(ACommandResponse.Get('startaddress', Dec2Numb(FStartAddr, 8, 16)));
for i := 0 to JSonCallStackArr.Count-1 do
begin
JSonCallStackEntryObj := JSonCallStackArr.Items[i] as TJSONObject;
AnEntry.Addr:=Hex2Dec(JSonCallStackEntryObj.Get('address', '0'));
AnEntry.Dump:=JSonCallStackEntryObj.Get('dump', '');
AnEntry.Statement:=JSonCallStackEntryObj.Get('statement', '');
AnEntry.SrcFileName:=JSonCallStackEntryObj.Get('srcfilename', '');
AnEntry.SrcFileLine:=JSonCallStackEntryObj.Get('srcfileline', 0);
AnEntry.SrcStatementIndex:=JSonCallStackEntryObj.Get('srcstatementindex', 0);
AnEntry.SrcStatementCount:=JSonCallStackEntryObj.Get('srcstatementcount', 0);
AnEntry.FuncName:=JSonCallStackEntryObj.Get('functionname', '');
AnEntry.Offset:=JSonCallStackEntryObj.Get('offset', 0);
ARange.Append(@AnEntry);
end;
ARange.RangeEndAddr:=Hex2Dec(ACommandResponse.Get('endaddress', Dec2Numb(AnEntry.Addr, 8, 16)));
ARange.LastEntryEndAddr:=Hex2Dec(ACommandResponse.Get('lastentryendaddress', '0'));
TFPDBGDisassembler(FDisassembler).AddRange(ARange);
end
end;
end;
procedure TFPDSendCallStackCommand.DoOnCommandFailed(ACommandResponse: TJSonObject);
begin
FCallStack.SetCountValidity(ddsInvalid);