FPGDBMIDebugger: fix queuing / eval some values direct

git-svn-id: trunk@44116 -

components/fpdebug/fppascalbuilder.pas

@@ -27,10 +27,15 @@ type
   );
   TTypeDeclarationFlags = set of TTypeDeclarationFlag;
 
+  TPrintPasValFlag = (dummyx1);
+  TPrintPasValFlags = set of TPrintPasValFlag;
+
 function GetTypeName(out ATypeName: String; ADbgSymbol: TDbgSymbol; AFlags: TTypeNameFlags = []): Boolean;
 function GetTypeAsDeclaration(out ATypeDeclaration: String; ADbgSymbol: TDbgSymbol;
   AFlags: TTypeDeclarationFlags = []; AnIndent: Integer = 0): Boolean;
 
+function PrintPasValue(out APrintedValue: String; AResValue: TDbgSymbolValue; AnAddrSize: Integer; AFlags: TPrintPasValFlags = []): Boolean;
+
 implementation
 
 function GetTypeName(out ATypeName: String; ADbgSymbol: TDbgSymbol;
@@ -386,6 +391,128 @@ begin
     ATypeDeclaration := GetIndent + ATypeDeclaration;
 end;
 
+function PrintPasValue(out APrintedValue: String; AResValue: TDbgSymbolValue;
+  AnAddrSize: Integer; AFlags: TPrintPasValFlags): Boolean;
+
+  function ResTypeName: String;
+  begin
+    if not((AResValue.TypeInfo<> nil) and
+           GetTypeName(Result, AResValue.TypeInfo, []))
+    then
+      Result := '';
+  end;
+
+  procedure DoPointer;
+  var
+    s: String;
+  begin
+    s := ResTypeName;
+    APrintedValue := '$'+IntToHex(AResValue.AsCardinal, AnAddrSize);
+    if s <> '' then
+      APrintedValue := s + '(' + APrintedValue + ')';
+    Result := True;
+  end;
+
+  procedure DoInt;
+  begin
+    APrintedValue := IntToStr(AResValue.AsInteger);
+    Result := True;
+  end;
+
+  procedure DoCardinal;
+  begin
+    APrintedValue := IntToStr(AResValue.AsCardinal);
+    Result := True;
+  end;
+
+  procedure DoBool;
+  begin
+    if AResValue.AsBool then begin
+      APrintedValue := 'True';
+      if AResValue.AsCardinal <> 1 then
+        APrintedValue := APrintedValue + '(' + IntToStr(AResValue.AsCardinal) + ')';
+    end
+    else
+      APrintedValue := 'False';
+    Result := True;
+  end;
+
+  procedure DoChar;
+  begin
+    APrintedValue := '''' + AResValue.AsString + ''''; // Todo escape
+    Result := True;
+  end;
+
+  procedure DoFloat;
+  begin
+    APrintedValue := FloatToStr(AResValue.AsFloat);
+    Result := True;
+  end;
+
+  procedure DoEnum;
+  var
+    s: String;
+  begin
+    APrintedValue := AResValue.AsString;
+    if APrintedValue = '' then begin
+      s := ResTypeName;
+      APrintedValue := s + '(' + IntToStr(AResValue.AsCardinal) + ')';
+    end;
+    Result := True;
+  end;
+
+  procedure DoEnumVal;
+  begin
+    APrintedValue := AResValue.AsString;
+    if APrintedValue <> '' then
+      APrintedValue := APrintedValue + ':=';
+    APrintedValue := APrintedValue+ IntToStr(AResValue.AsCardinal);
+    Result := True;
+  end;
+
+  procedure DoSet;
+  var
+    s: String;
+    i: Integer;
+  begin
+    APrintedValue := '';
+    for i := 0 to AResValue.MemberCount-1 do
+      if i = 0
+      then APrintedValue := AResValue.Member[i].AsString
+      else APrintedValue := APrintedValue + ', ' + AResValue.Member[i].AsString;
+    APrintedValue := '[' + APrintedValue + ']';
+    Result := True;
+  end;
+
+begin
+  Result := False;
+  case AResValue.Kind of
+    skUnit: ;
+    skProcedure: ;
+    skFunction: ;
+    skPointer:   DoPointer;
+    skInteger:   DoInt;
+    skCardinal:  DoCardinal;
+    skBoolean:   DoBool;
+    skChar:      DoChar;
+    skFloat:     DoFloat;
+    skString: ;
+    skAnsiString: ;
+    skCurrency: ;
+    skVariant: ;
+    skWideString: ;
+    skEnum:      DoEnum;
+    skEnumValue: DoEnumVal;
+    skSet:       DoSet;
+    skRecord: ;
+    skObject: ;
+    skClass: ;
+    skInterface: ;
+    skArray: ;
+  end;
+
+end;
+
 
 end.
 

components/lazdebuggerfp/fpgdbmidebugger.pp

@@ -86,6 +86,7 @@ type
     procedure LoadDwarf;
     procedure UnLoadDwarf;
     function  RequestCommand(const ACommand: TDBGCommand; const AParams: array of const): Boolean; override;
+    procedure QueueCommand(const ACommand: TGDBMIDebuggerCommand; ForceQueue: Boolean = False);
 
     procedure GetCurrentContext(out AThreadId, AStackFrame: Integer);
     function  GetLocationForContext(AThreadId, AStackFrame: Integer): TDBGPtr;
@@ -112,15 +113,37 @@ type
     function DoExecute: Boolean; override;
   end;
 
+  TFPGDBMIWatches = class;
+
+  { TFpGDBMIDebuggerCommandEvaluate }
+
+  TFpGDBMIDebuggerCommandEvaluate = class(TGDBMIDebuggerCommand)
+  private
+    FOwner: TFPGDBMIWatches;
+  protected
+    function DoExecute: Boolean; override;
+    procedure DoFree; override;
+    procedure DoCancel; override;
+    procedure DoLockQueueExecute; override;
+    procedure DoUnLockQueueExecute; override;
+  public
+    constructor Create(AOwner: TFPGDBMIWatches);
+  end;
+
   { TFPGDBMIWatches }
 
   TFPGDBMIWatches = class(TGDBMIWatches)
   private
     FWatchEvalList: TList;
+    FWatchEvalLock: Integer;
+    FNeedRegValues: Boolean;
+    FEvaluationCmdObj: TFpGDBMIDebuggerCommandEvaluate;
     procedure DoWatchFreed(Sender: TObject);
   protected
     function  FpDebugger: TFpGDBMIDebugger;
     //procedure DoStateChange(const AOldState: TDBGState); override;
+    procedure ProcessEvalList;
+    procedure QueueCommand;
     procedure InternalRequestData(AWatchValue: TWatchValueBase); override;
   public
     constructor Create(const ADebugger: TDebuggerIntf);
@@ -147,6 +170,42 @@ type
     procedure Cancel(const ASource: String); override;
   end;
 
+{ TFpGDBMIDebuggerCommandEvaluate }
+
+function TFpGDBMIDebuggerCommandEvaluate.DoExecute: Boolean;
+begin
+  FOwner.FEvaluationCmdObj := nil;
+  FOwner.ProcessEvalList;
+end;
+
+procedure TFpGDBMIDebuggerCommandEvaluate.DoFree;
+begin
+  FOwner.FEvaluationCmdObj := nil;
+  inherited DoFree;
+end;
+
+procedure TFpGDBMIDebuggerCommandEvaluate.DoCancel;
+begin
+  FOwner.FEvaluationCmdObj := nil;
+  inherited DoCancel;
+end;
+
+procedure TFpGDBMIDebuggerCommandEvaluate.DoLockQueueExecute;
+begin
+  //
+end;
+
+procedure TFpGDBMIDebuggerCommandEvaluate.DoUnLockQueueExecute;
+begin
+  //
+end;
+
+constructor TFpGDBMIDebuggerCommandEvaluate.Create(AOwner: TFPGDBMIWatches);
+begin
+  inherited Create(AOwner.FpDebugger);
+  FOwner := AOwner;
+end;
+
 { TFpGDBMIAndWin32DbgMemReader }
 
 destructor TFpGDBMIAndWin32DbgMemReader.Destroy;
@@ -813,14 +872,20 @@ begin
   FWatchEvalList.Remove(pointer(Sender));
 end;
 
-procedure TFPGDBMIWatches.InternalRequestData(AWatchValue: TWatchValueBase);
+procedure TFPGDBMIWatches.ProcessEvalList;
 var
+  WatchValue: TWatchValueBase;
   PasExpr: TFpPascalExpression;
   ResValue: TDbgSymbolValue;
   ResTypeInfo: TDBGType;
   ResText: String;
   Ctx: TDbgInfoAddressContext;
 
+  function IsWatchValueAlive: Boolean;
+  begin
+    Result := (FWatchEvalList.Count > 0) and (FWatchEvalList[0] = Pointer(WatchValue));
+  end;
+
   function ResTypeName: String;
   begin
     if not((ResValue.TypeInfo<> nil) and
@@ -830,109 +895,157 @@ var
   end;
 
   procedure DoPointer;
-  var
-    s: String;
   begin
-    s := ResTypeName;
+    if not PrintPasValue(ResText, ResValue, ctx.SizeOfAddress, []) then
-    ResTypeInfo := TDBGType.Create(skSimple, s); // TODO, IDE must learn pointer
+      exit;
-    ResText := '$'+IntToHex(ResValue.AsCardinal, Ctx.SizeOfAddress);
+    ResTypeInfo := TDBGType.Create(skSimple, ResTypeName); // TODO, IDE must learn pointer
-    if s <> '' then
-      ResText := s + '(' + ResText + ')';
     ResTypeInfo.Value.AsString := ResText;
     //ResTypeInfo.Value.AsPointer := ; // ???
   end;
 
-  procedure DoInt;
+  procedure DoSimple;
-  var
-    s: String;
   begin
-    s := ResTypeName;
+    if not PrintPasValue(ResText, ResValue, ctx.SizeOfAddress, []) then
-    ResTypeInfo := TDBGType.Create(skSimple, s); // TODO, IDE must learn skInteger;
+      exit;
-    ResText := IntToStr(ResValue.AsInteger);
+    ResTypeInfo := TDBGType.Create(skSimple, ResTypeName);
     ResTypeInfo.Value.AsString := ResText;
   end;
 
-  procedure DoCardinal;
+  procedure DoEnum;
-  var
-    s: String;
   begin
-    s := ResTypeName;
+    if not PrintPasValue(ResText, ResValue, ctx.SizeOfAddress, []) then
-    ResTypeInfo := TDBGType.Create(skSimple, s); // TODO, IDE must learn skInteger;
+      exit;
-    ResText := IntToStr(ResValue.AsCardinal);
+    ResTypeInfo := TDBGType.Create(skEnum, ResTypeName);
+    ResTypeInfo.Value.AsString := ResText;
+  end;
+
+  procedure DoSet;
+  begin
+    if not PrintPasValue(ResText, ResValue, ctx.SizeOfAddress, []) then
+      exit;
+    ResTypeInfo := TDBGType.Create(skSet, ResTypeName);
     ResTypeInfo.Value.AsString := ResText;
   end;
 
 begin
+  if FNeedRegValues then begin
+    FNeedRegValues := False;
+    FpDebugger.Registers.Values[0];
+    QueueCommand;
+    exit;
+  end;
+
+  if FWatchEvalLock > 0 then
+    exit;
+  inc(FWatchEvalLock);
+  try // TODO: if the stack/thread is changed, registers will be wrong
+    while (FWatchEvalList.Count > 0) and (FEvaluationCmdObj = nil) do begin
+      try
+        WatchValue := TWatchValueBase(FWatchEvalList[0]);
+        ResTypeInfo := nil;
+        Ctx := FpDebugger.GetInfoContextForContext(WatchValue.ThreadId, WatchValue.StackFrame);
+
+        PasExpr := TFpPascalExpression.Create(WatchValue.Expression, Ctx);
+        if not IsWatchValueAlive then
+          continue;
+
+        if not (PasExpr.Valid and (PasExpr.ResultValue <> nil)) then begin
+          if not IsWatchValueAlive then
+            continue;
+          debugln(['TFPGDBMIWatches.InternalRequestData FAILED']);
+          inherited InternalRequestData(WatchValue);
+          continue;
+        end;
+        if not IsWatchValueAlive then
+          continue;
+
+        ResValue := PasExpr.ResultValue;
+
+        case PasExpr.ResultValue.Kind of
+          skUnit: ;
+          skProcedure: ;
+          skFunction: ;
+          skPointer:  DoPointer;
+          skInteger:  DoSimple;
+          skCardinal: DoSimple;
+          skBoolean:  DoSimple;
+          skChar:     DoSimple;
+          skFloat:    DoSimple;
+          skString: ;
+          skAnsiString: ;
+          skCurrency: ;
+          skVariant: ;
+          skWideString: ;
+          skEnum:      DoEnum;
+          skEnumValue: DoSimple;
+          skSet:       DoSet;
+          skRecord: ;
+          skObject: ;
+          skClass: ;
+          skInterface: ;
+          skArray: ;
+        end;
+
+
+        if IsWatchValueAlive then begin
+          if ResTypeInfo = nil then begin
+            debugln(['TFPGDBMIWatches.InternalRequestData FAILED']);
+            inherited InternalRequestData(WatchValue);
+            continue;
+          end;
+
+          debugln(['TFPGDBMIWatches.InternalRequestData   GOOOOOOD']);
+          WatchValue.Value    := ResText;
+          WatchValue.TypeInfo := ResTypeInfo;
+          WatchValue.Validity := ddsValid;
+        end;
+
+
+      finally
+        if IsWatchValueAlive then begin
+          WatchValue.RemoveFreeeNotification(@DoWatchFreed);
+          FWatchEvalList.Remove(pointer(WatchValue));
+        end;
+        PasExpr.Free;
+        Application.ProcessMessages;
+      end;
+    end;
+  finally
+    dec(FWatchEvalLock);
+  end;
+end;
+
+procedure TFPGDBMIWatches.QueueCommand;
+begin
+  FEvaluationCmdObj := TFpGDBMIDebuggerCommandEvaluate.Create(Self);
+  FEvaluationCmdObj.Properties := [dcpCancelOnRun];
+  // If a ExecCmd is running, then defer exec until the exec cmd is done
+  FpDebugger.QueueCommand(FEvaluationCmdObj, ForceQueuing);
+end;
+
+procedure TFPGDBMIWatches.InternalRequestData(AWatchValue: TWatchValueBase);
+begin
+  if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause]) then begin
+    AWatchValue.Validity := ddsInvalid;
+    Exit;
+  end;
 
   AWatchValue.AddFreeeNotification(@DoWatchFreed); // we may call gdb
   FWatchEvalList.Add(pointer(AWatchValue));
-  try
-    ResTypeInfo := nil;
-    Ctx := FpDebugger.GetInfoContextForContext(AWatchValue.ThreadId, AWatchValue.StackFrame);
-    PasExpr := TFpPascalExpression.Create(AWatchValue.Expression, Ctx);
 
-    if FWatchEvalList.IndexOf(pointer(AWatchValue)) < 0 then
+  if FEvaluationCmdObj <> nil then exit;
-      exit;
 
-    if not (PasExpr.Valid and (PasExpr.ResultValue <> nil)) then begin
+  FpDebugger.Threads.CurrentThreads.Count; // trigger threads, in case
-      if FWatchEvalList.IndexOf(pointer(AWatchValue)) < 0 then
+  if FpDebugger.Registers.Count = 0 then   // trigger register, in case
-        exit;
+    FNeedRegValues := True
-      debugln(['TFPGDBMIWatches.InternalRequestData FAILED']);
+  else
-      inherited InternalRequestData(AWatchValue);
+  begin
-      exit;
+    FNeedRegValues := False;
-    end;
+    FpDebugger.Registers.Values[0];
-    if FWatchEvalList.IndexOf(pointer(AWatchValue)) < 0 then
-      exit;
-
-    ResValue := PasExpr.ResultValue;
-
-    case PasExpr.ResultValue.Kind of
-      skUnit: ;
-      skProcedure: ;
-      skFunction: ;
-      skPointer: DoPointer;
-      skInteger: DoInt;
-      skCardinal: DoCardinal;
-      skBoolean: ;
-      skChar: ;
-      skFloat: ;
-      skString: ;
-      skAnsiString: ;
-      skCurrency: ;
-      skVariant: ;
-      skWideString: ;
-      skEnum: ;
-      skEnumValue: ;
-      skSet: ;
-      skRecord: ;
-      skObject: ;
-      skClass: ;
-      skInterface: ;
-      skArray: ;
-    end;
-
-
-    if FWatchEvalList.IndexOf(pointer(AWatchValue)) >= 0 then begin
-      if ResTypeInfo = nil then begin
-        debugln(['TFPGDBMIWatches.InternalRequestData FAILED']);
-        inherited InternalRequestData(AWatchValue);
-        exit;
-      end;
-
-      debugln(['TFPGDBMIWatches.InternalRequestData   GOOOOOOD']);
-      AWatchValue.Value    := ResText;
-      AWatchValue.TypeInfo := ResTypeInfo;
-      AWatchValue.Validity := ddsValid;
-    end;
-
-
-  finally
-    AWatchValue.RemoveFreeeNotification(@DoWatchFreed);
-    FWatchEvalList.Remove(pointer(AWatchValue));
-    PasExpr.Free;
   end;
 
-  Application.ProcessMessages;
+  // Join the queue, registers and threads are needed first
+  QueueCommand;
 end;
 
 constructor TFPGDBMIWatches.Create(const ADebugger: TDebuggerIntf);
@@ -1108,6 +1221,12 @@ begin
     Result := inherited RequestCommand(ACommand, AParams);
 end;
 
+procedure TFpGDBMIDebugger.QueueCommand(const ACommand: TGDBMIDebuggerCommand;
+  ForceQueue: Boolean);
+begin
+  inherited QueueCommand(ACommand, ForceQueue);
+end;
+
 procedure TFpGDBMIDebugger.GetCurrentContext(out AThreadId, AStackFrame: Integer);
 begin
   if CurrentThreadIdValid then begin

components/lazdebuggergdbmi/gdbmidebugger.pp

@@ -622,6 +622,7 @@ type
     procedure DoStateChange(const AOldState: TDBGState); override;
     procedure Changed;
     procedure Clear;
+    function  ForceQueuing: Boolean;
     procedure InternalRequestData(AWatchValue: TWatchValueBase); override;
     property  ParentFPListChangeStamp: Integer read FParentFPListChangeStamp;
   public
@@ -714,8 +715,6 @@ type
     function  ExecuteCommand(const ACommand: String; const AValues: array of const; const AFlags: TGDBMICommandFlags; var AResult: TGDBMIExecResult): Boolean; overload;
     function  ExecuteCommandFull(const ACommand: String; const AValues: array of const; const AFlags: TGDBMICommandFlags; const ACallback: TGDBMICallback; const ATag: PtrInt; var AResult: TGDBMIExecResult): Boolean; overload;
     procedure RunQueue;
-    procedure QueueCommand(const ACommand: TGDBMIDebuggerCommand; ForceQueue: Boolean = False);
-    procedure UnQueueCommand(const ACommand: TGDBMIDebuggerCommand);
     procedure CancelAllQueued;
     procedure CancelBeforeRun;
     procedure CancelAfterStop;
@@ -737,6 +736,8 @@ type
     {$ENDIF}
     procedure QueueExecuteLock;
     procedure QueueExecuteUnlock;
+    procedure QueueCommand(const ACommand: TGDBMIDebuggerCommand; ForceQueue: Boolean = False);
+    procedure UnQueueCommand(const ACommand: TGDBMIDebuggerCommand);
 
     function ConvertToGDBPath(APath: string; ConvType: TConvertToGDBPathType = cgptNone): string;
     function  ChangeFileName: Boolean; override;
@@ -10009,9 +10010,16 @@ begin
   FCommandList.Clear;
 end;
 
+function TGDBMIWatches.ForceQueuing: Boolean;
+begin
+  Result := (TGDBMIDebugger(Debugger).FCurrentCommand <> nil)
+            and (TGDBMIDebugger(Debugger).FCurrentCommand is TGDBMIDebuggerCommandExecute)
+            and (not TGDBMIDebuggerCommandExecute(TGDBMIDebugger(Debugger).FCurrentCommand).NextExecQueued)
+            and (Debugger.State <> dsInternalPause);
+end;
+
 procedure TGDBMIWatches.InternalRequestData(AWatchValue: TWatchValueBase);
 var
-  ForceQueue: Boolean;
   EvaluationCmdObj: TGDBMIDebuggerCommandEvaluate;
 begin
   if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause]) then begin
@@ -10025,12 +10033,8 @@ begin
   EvaluationCmdObj.OnDestroy    := @DoEvaluationDestroyed;
   EvaluationCmdObj.Properties := [dcpCancelOnRun];
   // If a ExecCmd is running, then defer exec until the exec cmd is done
-  ForceQueue := (TGDBMIDebugger(Debugger).FCurrentCommand <> nil)
-            and (TGDBMIDebugger(Debugger).FCurrentCommand is TGDBMIDebuggerCommandExecute)
-            and (not TGDBMIDebuggerCommandExecute(TGDBMIDebugger(Debugger).FCurrentCommand).NextExecQueued)
-            and (Debugger.State <> dsInternalPause);
   FCommandList.Add(EvaluationCmdObj);
-  TGDBMIDebugger(Debugger).QueueCommand(EvaluationCmdObj, ForceQueue);
+  TGDBMIDebugger(Debugger).QueueCommand(EvaluationCmdObj, ForceQueuing);
   (* DoEvaluationFinished may be called immediately at this point *)
 end;