LazDebuggerFPDServer: Retrieve disassembled code from the fpdserver

git-svn-id: trunk@49294 -

components/lazdebuggers/lazdebuggerfpdserver/fpdserverdebugger.pas

@@ -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;

components/lazdebuggers/lazdebuggerfpdserver/fpdserverdebuggercommands.inc

@@ -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);