FpDebugServer: Added basic "evaluate" command

git-svn-id: trunk@49166 -

components/debuggerintf/dbgintfdebuggerbase.pp

@@ -146,6 +146,16 @@ type
   (* TValidState: State for breakpoints *)
   TValidState = (vsUnknown, vsValid, vsInvalid);
 
+const
+  DebuggerDataStateStr : array[TDebuggerDataState] of string = (
+    'Unknown',
+    'Requested',
+    'Evaluating',
+    'Valid',
+    'Invalid',
+    'Error');
+
+type
   TDBGEvaluateFlag =
     (defNoTypeInfo,        // No Typeinfo object will be returned
      defSimpleTypeInfo,    // Returns: Kind (skSimple, skClass, ..); TypeName (but does make no attempt to avoid an alias)

components/fpdebug/app/fpd/fpdloop.pas

@@ -80,9 +80,6 @@ type
   TPDDbgMemReader = class(TDbgMemReader)
   protected
     function GetDbgProcess: TDbgProcess; override;
-  public
-    function ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean; override;
-    function ReadMemoryEx(AnAddress, AnAddressSpace: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean; override;
   end;
 
 
@@ -98,16 +95,6 @@ begin
   result := GController.CurrentProcess;
 end;
 
-function TPDDbgMemReader.ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean;
-begin
-  result := GetDbgProcess.ReadData(AnAddress, ASize, ADest^);
-end;
-
-function TPDDbgMemReader.ReadMemoryEx(AnAddress, AnAddressSpace: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean;
-begin
-  result := GetDbgProcess.ReadData(AnAddress, ASize, ADest^);
-end;
-
 { TFPDLoop }
 
 procedure TFPDLoop.GControllerExceptionEvent(var continue: boolean; const ExceptionClass, ExceptionMessage: string);

components/fpdebug/app/fpdserver/debuginoutputprocessor.pas

@@ -10,6 +10,7 @@ uses
   fpjson,
   FpDbgUtil,
   DebugThreadCommand,
+  DbgIntfDebuggerBase,
   debugthread,
   FpDbgClasses,
   typinfo,
@@ -149,6 +150,8 @@ begin
       JSonEvent.Add('breakpointLocation', FormatAddress(AnEvent.BreakpointAddr));
     if AnEvent.SendByConnectionIdentifier>0 then
       JSonEvent.Add('connIdentifier', AnEvent.SendByConnectionIdentifier);
+    if AnEvent.Validity<>ddsUnknown then
+      JSonEvent.Add('validity', DebuggerDataStateStr[AnEvent.Validity]);
     if AnEvent.LocationRec.Address <> 0 then
       begin
       JSonLocationRec := TJSONObject.Create;

components/fpdebug/app/fpdserver/debugthread.pas

@@ -9,6 +9,8 @@ uses
   Classes,
   SysUtils,
   FPDbgController,
+  FpDbgDwarfDataClasses,
+  FpdMemoryTools,
   DbgIntfBaseTypes,
   DbgIntfDebuggerBase,
   lazCollections,
@@ -51,6 +53,7 @@ type
     AnUID: variant;
     BreakpointAddr: TDBGPtr;
     LocationRec: TDBGLocationRec;
+    Validity: TDebuggerDataState;
   end;
 
   // Each listener should implement this interface.
@@ -109,11 +112,15 @@ type
     FCommandQueue: TFpDebugThreadCommandQueue;
     FController: TDbgController;
     FListenerList: TThreadList;
+    FMemConverter: TFpDbgMemConvertorLittleEndian;
+    FMemReader: TDbgMemReader;
+    FMemManager: TFpDbgMemManager;
   protected
     // Handlers for the FController-events
     procedure FControllerHitBreakpointEvent(var continue: boolean; const Breakpoint: TDbgBreakpoint);
     procedure FControllerProcessExitEvent(ExitCode: DWord);
     procedure FControllerCreateProcessEvent(var continue: boolean);
+    procedure FControllerDebugInfoLoaded(Sender: TObject);
     // Main debug thread-loop
     procedure Execute; override;
     // Send an event to all listeners
@@ -155,6 +162,32 @@ implementation
 var
   FFpDebugThread: TFpDebugThread;
 
+type
+
+  { TFpDbgMemReader }
+
+  TFpDbgMemReader = class(TDbgMemReader)
+    private
+      FDebugThread: TFpDebugThread;
+    protected
+      function GetDbgProcess: TDbgProcess; override;
+    public
+      constructor create(ADebugThread: TFpDebugThread);
+  end;
+
+{ TFpDbgMemReader }
+
+function TFpDbgMemReader.GetDbgProcess: TDbgProcess;
+begin
+  result := FDebugThread.FController.CurrentProcess;
+end;
+
+constructor TFpDbgMemReader.create(ADebugThread: TFpDebugThread);
+begin
+  Inherited Create;
+  FDebugThread:=ADebugThread;
+end;
+
 { TFpDebugThreadCommand }
 
 procedure TFpDebugThreadCommand.Log(const AString: string; const ALogLevel: TFPDLogLevel);
@@ -228,6 +261,12 @@ begin
   AnEvent.InstructionPointerRegValue:=0;
   AnEvent.BreakpointAddr:=0;
   AnEvent.LocationRec.Address:=0;
+  AnEvent.Validity:=ddsUnknown;
+end;
+
+procedure TFpDebugThread.FControllerDebugInfoLoaded(Sender: TObject);
+begin
+  TFpDwarfInfo(FController.CurrentProcess.DbgInfo).MemManager := FMemManager;
 end;
 
 procedure TFpDebugThread.FControllerHitBreakpointEvent(var continue: boolean; const Breakpoint: TDbgBreakpoint);
@@ -280,6 +319,7 @@ begin
   FController.OnCreateProcessEvent:=@FControllerCreateProcessEvent;
   FController.OnProcessExitEvent:=@FControllerProcessExitEvent;
   FController.OnHitBreakpointEvent:=@FControllerHitBreakpointEvent;
+  FController.OnDebugInfoLoaded:=@FControllerDebugInfoLoaded;
   FController.OnLog:=@SendLogMessage;
 
   try
@@ -348,6 +388,10 @@ begin
   inherited create(false);
   FCommandQueue := TFpDebugThreadCommandQueue.create(100, INFINITE, 100);
   FListenerList:=TThreadList.Create;
+
+  FMemReader := TFpDbgMemReader.Create(self);
+  FMemConverter := TFpDbgMemConvertorLittleEndian.Create;
+  FMemManager := TFpDbgMemManager.Create(FMemReader, FMemConverter);
 end;
 
 destructor TFpDebugThread.Destroy;
@@ -355,6 +399,9 @@ begin
   FListenerList.Free;
   FCommandQueue.Free;
   inherited Destroy;
+  FMemManager.Free;
+  FMemConverter.Free;
+  FMemReader.Free;
 end;
 
 class function TFpDebugThread.Instance: TFpDebugThread;

components/fpdebug/app/fpdserver/debugthreadcommand.pas

@@ -11,6 +11,9 @@ uses
   FpDbgClasses,
   FpDbgUtil,
   FpDbgInfo,
+  FpPascalParser,
+  FpPascalBuilder,
+  FpErrorMessages,
   DbgIntfDebuggerBase,
   DbgIntfBaseTypes,
   strutils,
@@ -160,6 +163,21 @@ type
     property Address: string read GetAddress write SetAddress;
   end;
 
+  { TFpDebugThreadEvaluateCommand }
+
+  TFpDebugThreadEvaluateCommand = class(TFpDebugThreadCommand)
+  private
+    FExpression: string;
+    FResText: string;
+    FValidity: TDebuggerDataState;
+  public
+    function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
+    class function TextName: string; override;
+    procedure ComposeSuccessEvent(var AnEvent: TFpDebugEvent); override;
+  published
+    property Expression: string read FExpression write FExpression;
+  end;
+
 implementation
 
 { TFpDebugThreadCommandList }
@@ -167,6 +185,75 @@ implementation
 var
   GFpDebugThreadCommandList: TFpDebugThreadCommandList = nil;
 
+{ TFpDebugThreadEvaluateCommand }
+
+procedure TFpDebugThreadEvaluateCommand.ComposeSuccessEvent(var AnEvent: TFpDebugEvent);
+begin
+  inherited ComposeSuccessEvent(AnEvent);
+  AnEvent.Message:=FResText;
+  AnEvent.Validity:=FValidity;
+end;
+
+function TFpDebugThreadEvaluateCommand.Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean;
+var
+  AContext: TFpDbgInfoContext;
+  APasExpr: TFpPascalExpression;
+  ADbgInfo: TDbgInfo;
+  Res: Boolean;
+  APrettyPrinter: TFpPascalPrettyPrinter;
+  ATypeInfo: TDBGType;
+
+begin
+  Result := False;
+  ADbgInfo := AController.CurrentProcess.DbgInfo;
+  AContext := ADbgInfo.FindContext(AController.CurrentThread.ID, 0, AController.CurrentProcess.GetInstructionPointerRegisterValue);
+  if AContext = nil then
+    begin
+    FValidity:=ddsInvalid;
+    exit;
+    end;
+
+  Result := True;
+  AContext.MemManager.DefaultContext := AContext;
+  APasExpr := TFpPascalExpression.Create(FExpression, AContext);
+  try
+    APasExpr.ResultValue; // trigger full validation
+    if not APasExpr.Valid then
+      begin
+      FResText := ErrorHandler.ErrorAsString(APasExpr.Error);
+      FValidity := ddsError;
+      end
+    else
+      begin
+      APrettyPrinter := TFpPascalPrettyPrinter.Create(sizeof(pointer));
+      try
+        APrettyPrinter.AddressSize:=AContext.SizeOfAddress;
+        APrettyPrinter.MemManager := AContext.MemManager;
+        Res := APrettyPrinter.PrintValue(FResText, ATypeInfo, APasExpr.ResultValue);
+        if Res then
+          begin
+          FValidity:=ddsValid;
+          end
+        else
+          begin
+          FResText := 'Error';
+          FValidity:=ddsValid;
+          end;
+      finally
+        APrettyPrinter.Free;
+      end;
+      end;
+  finally
+    APasExpr.Free;
+    AContext.ReleaseReference;
+  end;
+end;
+
+class function TFpDebugThreadEvaluateCommand.TextName: string;
+begin
+  result := 'evaluate';
+end;
+
 { TFpDebugThreadQuitDebugServerCommand }
 
 function TFpDebugThreadQuitDebugServerCommand.PreExecute(AController: TDbgController; out DoQueueCommand: boolean): boolean;
@@ -474,6 +561,7 @@ initialization
   TFpDebugThreadCommandList.instance.Add(TFpDebugThreadAddBreakpointCommand);
   TFpDebugThreadCommandList.instance.Add(TFpDebugThreadRemoveBreakpointCommand);
   TFpDebugThreadCommandList.instance.Add(TFpDebugThreadGetLocationInfoCommand);
+  TFpDebugThreadCommandList.instance.Add(TFpDebugThreadEvaluateCommand);
 finalization
   GFpDebugThreadCommandList.Free;
 end.

components/fpdebug/fpdbgclasses.pp

@@ -119,6 +119,8 @@ type
   protected
     function GetDbgProcess: TDbgProcess; virtual; abstract;
   public
+    function ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean; override;
+    function ReadMemoryEx(AnAddress, AnAddressSpace: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean; override;
     function ReadRegister(ARegNum: Cardinal; out AValue: TDbgPtr; AContext: TFpDbgAddressContext): Boolean; override;
     function RegisterSize(ARegNum: Cardinal): Integer; override;
   end;
@@ -439,6 +441,17 @@ end;
 
 { TDbgMemReader }
 
+function TDbgMemReader.ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean;
+begin
+  result := GetDbgProcess.ReadData(AnAddress, ASize, ADest^);
+end;
+
+function TDbgMemReader.ReadMemoryEx(AnAddress, AnAddressSpace: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean;
+begin
+  Assert(AnAddressSpace>0,'TDbgMemReader.ReadMemoryEx ignores AddressSpace');
+  result := GetDbgProcess.ReadData(AnAddress, ASize, ADest^);
+end;
+
 function TDbgMemReader.ReadRegister(ARegNum: Cardinal; out AValue: TDbgPtr; AContext: TFpDbgAddressContext): Boolean;
 var
   ARegister: TDbgRegisterValue;