FpDebug: started DisplayFormat

git-svn-id: trunk@44896 -

components/fpdebug/fppascalbuilder.pas

@@ -5,8 +5,8 @@ unit FpPascalBuilder;
 interface
 
 uses
-  Classes, SysUtils, DbgIntfBaseTypes, FpDbgInfo, FpdMemoryTools, FpErrorMessages,
+  Classes, SysUtils, DbgIntfBaseTypes, DbgIntfDebuggerBase, FpDbgInfo, FpdMemoryTools,
-  LazLoggerBase;
+  FpErrorMessages, LazLoggerBase;
 
 type
   TTypeNameFlag = (
@@ -39,18 +39,24 @@ type
   TFpPascalPrettyPrinter = class
   private
     FAddressSize: Integer;
+    FMemManager: TFpDbgMemManager;
     function InternalPrintValue(out APrintedValue: String;
                                 AValue: TFpDbgValue;
                                 AnAddressSize: Integer;
                                 AFlags: TFpPrettyPrintValueFlags;
-                                ANestLevel: Integer; AnIndent: String
+                                ANestLevel: Integer; AnIndent: String;
+                                ADisplayFormat: TWatchDisplayFormat;
+                                ARepaetCount: Integer = -1
                                ): Boolean;
   public
     constructor Create(AnAddressSize: Integer);
     function PrintValue(out APrintedValue: String;
                         AValue: TFpDbgValue;
-                        AFlags: TFpPrettyPrintValueFlags = []): Boolean;
+                        ADisplayFormat: TWatchDisplayFormat = wdfDefault;
+                        ARepaetCount: Integer = -1
+                       ): Boolean;
     property AddressSize: Integer read FAddressSize write FAddressSize;
+    property MemManager: TFpDbgMemManager read FMemManager write FMemManager;
   end;
 
 
@@ -422,7 +428,8 @@ end;
 
 function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
   AValue: TFpDbgValue; AnAddressSize: Integer; AFlags: TFpPrettyPrintValueFlags;
-  ANestLevel: Integer; AnIndent: String): Boolean;
+  ANestLevel: Integer; AnIndent: String; ADisplayFormat: TWatchDisplayFormat;
+  ARepaetCount: Integer): Boolean;
 
 
   function ResTypeName: String;
@@ -438,15 +445,29 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
     s: String;
     v: QWord;
   begin
-    s := ResTypeName;
+    if ((ADisplayFormat = wdfDefault) and (ANestLevel=0)) or // default for unested: with typename
-    v := AValue.AsCardinal;
+       (ADisplayFormat = wdfStructure)
-    if v = 0 then
+    then
-      APrintedValue := 'nil'
+      s := ResTypeName
     else
-      APrintedValue := '$'+IntToHex(AValue.AsCardinal, AnAddressSize);
+      s := '';
+
+    v := AValue.AsCardinal;
+    case ADisplayFormat of
+      wdfDecimal, wdfUnsigned: APrintedValue := IntToStr(AValue.AsCardinal);
+      wdfHex: APrintedValue := '$'+IntToHex(AValue.AsCardinal, AnAddressSize*2);
+      else begin //wdfPointer/Default ;
+          if v = 0 then
+            APrintedValue := 'nil'
+          else
+            APrintedValue := '$'+IntToHex(AValue.AsCardinal, AnAddressSize*2);
+        end;
+    end;
+
     if s <> '' then
       APrintedValue := s + '(' + APrintedValue + ')';
 
+    if ADisplayFormat = wdfPointer then exit; // no data
     if svfString in AValue.FieldFlags then
       APrintedValue := APrintedValue + ' ' + AValue.AsString;
 
@@ -454,14 +475,50 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
   end;
 
   procedure DoInt;
+  var
+    n: Integer;
   begin
-    APrintedValue := IntToStr(AValue.AsInteger);
+    case ADisplayFormat of
+      wdfUnsigned: APrintedValue := IntToStr(QWord(AValue.AsInteger));
+      wdfHex: begin
+          if svfSize in AValue.FieldFlags then
+            n := AValue.Size * 2
+          else begin
+            n := 16;
+            if QWord(AValue.AsInteger) <= high(Cardinal) then n := 8;
+            if QWord(AValue.AsInteger) <= high(Word) then n := 3;
+            if QWord(AValue.AsInteger) <= high(Byte) then n := 2;
+          end;
+          APrintedValue := '$'+IntToHex(QWord(AValue.AsInteger), n);
+        end;
+      // TODO wdfChar:
+      else
+          APrintedValue := IntToStr(AValue.AsInteger);
+    end;
     Result := True;
   end;
 
   procedure DoCardinal;
+  var
+    n: Integer;
   begin
-    APrintedValue := IntToStr(AValue.AsCardinal);
+    case ADisplayFormat of
+      wdfDecimal: APrintedValue := IntToStr(Int64(AValue.AsCardinal));
+      wdfHex: begin
+          if svfSize in AValue.FieldFlags then
+            n := AValue.Size * 2
+          else begin
+            n := 16;
+            if AValue.AsCardinal <= high(Cardinal) then n := 8;
+            if AValue.AsCardinal <= high(Word) then n := 4;
+            if AValue.AsCardinal <= high(Byte) then n := 2;
+          end;
+          APrintedValue := '$'+IntToHex(AValue.AsCardinal, n);
+        end;
+      // TODO wdfChar:
+      else
+          APrintedValue := IntToStr(AValue.AsCardinal);
+    end;
     Result := True;
   end;
 
@@ -546,6 +603,14 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
       Result := True;
       exit;
     end;
+    if ADisplayFormat = wdfPointer then begin
+      s := ResTypeName;
+      APrintedValue := '$'+IntToHex(AValue.AsCardinal, AnAddressSize*2);
+      if s <> '' then
+        APrintedValue := s + '(' + APrintedValue + ')';
+      Result := True;
+      exit;
+    end;
 
     if ( (AValue.Kind in [skClass, skObject]) and (ppvSkipClassBody in AFlags) ) or
        ( (AValue.Kind in [skRecord]) and (ppvSkipRecordBody in AFlags) )
@@ -554,7 +619,7 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
       case AValue.Kind of
         skRecord: APrintedValue := '{record:}' + APrintedValue;
         skObject: APrintedValue := '{object:}' + APrintedValue;
-        skClass:  APrintedValue := '{class:}' + APrintedValue + '(' + '$'+IntToHex(AValue.AsCardinal, AnAddressSize) + ')';
+        skClass:  APrintedValue := '{class:}' + APrintedValue + '(' + '$'+IntToHex(AValue.AsCardinal, AnAddressSize*2) + ')';
       end;
       Result := True;
       exit;
@@ -572,7 +637,7 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
       if (m = nil) or (m.Kind in [skProcedure, skFunction]) then
         continue;
       s := '';
-      InternalPrintValue(s, m, AnAddressSize, fl, ANestLevel+1, AnIndent);
+      InternalPrintValue(s, m, AnAddressSize, fl, ANestLevel+1, AnIndent, ADisplayFormat);
       if m.DbgSymbol <> nil then
         s := m.DbgSymbol.Name + ' = ' + s;
       if APrintedValue = ''
@@ -588,48 +653,96 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
     s: String;
     i: Integer;
     m: TFpDbgValue;
-    c, d: Integer;
+    Cnt, FullCnt, d: Integer;
   begin
     APrintedValue := '';
-    c := AValue.MemberCount;
+    Cnt := AValue.MemberCount;
-    if (c = 0) and (svfOrdinal in AValue.FieldFlags) then begin  // dyn array
+    FullCnt := Cnt;
+    if (Cnt = 0) and (svfOrdinal in AValue.FieldFlags) then begin  // dyn array
       APrintedValue := 'nil';
       Result := True;
       exit;
     end;
     if (ANestLevel > 2) then begin
       s := ResTypeName;
-      APrintedValue := s+'(...)'; // TODO len and addr (dyn array)
+      APrintedValue := s+'({'+IntToStr(FullCnt)+' elements})'; // TODO len and addr (dyn array)
       Result := True;
       exit;
     end;
-    if      (ANestLevel > 1) and (c > 5) then c := 5
+    if      (ANestLevel > 1) and (Cnt > 3) then Cnt := 3
-    else if (ANestLevel > 0) and (c > 15) then c := 15
+    else if (ANestLevel > 0) and (Cnt > 10) then Cnt := 10
-    else if (c > 500) then c := 500;
+    else if (Cnt > 300) then Cnt := 300;
     d := 0;
     // TODO: use valueobject for bounds
     if (AValue.IndexTypeCount > 0) and AValue.IndexType[0].HasBounds then
       d := AValue.IndexType[0].OrdLowBound;
-    for i := d to d + c - 1 do begin
+    for i := d to d + Cnt - 1 do begin
       m := AValue.Member[i];
       if m <> nil then
-        InternalPrintValue(s, m, AnAddressSize, AFlags, ANestLevel+1, AnIndent)
+        InternalPrintValue(s, m, AnAddressSize, AFlags, ANestLevel+1, AnIndent, ADisplayFormat)
       else
         s := '{error}';
       if APrintedValue = ''
       then APrintedValue := s
       else APrintedValue := APrintedValue + ', ' + s;
     end;
-    if c < AValue.MemberCount then
+    if Cnt < FullCnt then
-      APrintedValue := APrintedValue + ', ...';
+      APrintedValue := APrintedValue + ', {'+IntToStr(FullCnt-Cnt)+' more elements}';
     APrintedValue := '(' + APrintedValue + ')';
     Result := True;
   end;
+var
+  MemAddr: TFpDbgMemLocation;
+  MemSize: Integer;
+  MemDest: array of Byte;
+  i: Integer;
 begin
   if ANestLevel > 0 then begin
     AnIndent := AnIndent + '  ';
   end;
 
+  if ADisplayFormat = wdfMemDump then begin
+    if FMemManager <> nil then begin
+      MemAddr := UnInitializedLoc;
+      if svfDataAddress in AValue.FieldFlags then begin
+        MemAddr := AValue.DataAddress;
+        MemSize := AValue.DataSize;
+        if MemSize = 0 then MemSize := 256;
+      end
+      else
+      if svfAddress in AValue.FieldFlags then begin
+        MemAddr := AValue.Address;
+        MemSize := AValue.Size;
+      end;
+
+      if IsTargetAddr(MemAddr) then begin
+        if MemSize < 32 then MemSize := 32;
+        SetLength(MemDest, MemSize);
+        if FMemManager.ReadMemory(MemAddr, MemSize, @MemDest[0]) then begin
+          APrintedValue := IntToHex(MemAddr.Address, AnAddressSize*2)+ ':' + LineEnding;
+          for i := 0 to high(MemDest) do begin
+            if (i > 0) and (i mod 16 = 0) then
+              APrintedValue := APrintedValue + LineEnding
+            else
+            if (i > 0) and (i mod 8 = 0) then
+              APrintedValue := APrintedValue + '  '
+            else
+            if (i > 0)  then
+              APrintedValue := APrintedValue + ' ';
+            APrintedValue := APrintedValue + IntToHex(MemDest[i], 2);
+          end;
+        end
+        else begin
+          APrintedValue := 'Cannot read memory at address '+ IntToHex(MemAddr.Address, AnAddressSize*2);
+        end;
+        exit;
+      end;
+    end;
+
+    APrintedValue := 'Cannot read memory for expression';
+    exit
+  end;
+
   Result := False;
   case AValue.Kind of
     skUnit: ;
@@ -666,9 +779,9 @@ begin
 end;
 
 function TFpPascalPrettyPrinter.PrintValue(out APrintedValue: String; AValue: TFpDbgValue;
-  AFlags: TFpPrettyPrintValueFlags): Boolean;
+  ADisplayFormat: TWatchDisplayFormat; ARepaetCount: Integer): Boolean;
 begin
-  InternalPrintValue(APrintedValue, AValue, AddressSize, AFlags, 0, '');
+  InternalPrintValue(APrintedValue, AValue, AddressSize, [], 0, '', ADisplayFormat, ARepaetCount);
 end;
 
 end.

components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas

@@ -593,7 +593,7 @@ begin
     else
       begin
       FPrettyPrinter.AddressSize:=AContext.SizeOfAddress;
-      if FPrettyPrinter.PrintValue(AVal, APasExpr.ResultValue, []) then
+      if FPrettyPrinter.PrintValue(AVal, APasExpr.ResultValue) then
         begin
         AWatchValue.Value := AVal; //IntToStr(APasExpr.ResultValue.AsInteger);
         AWatchValue.Validity := ddsValid;

components/lazdebuggers/lazdebuggerfpgdbmi/fpgdbmidebugger.pp

@@ -937,6 +937,8 @@ var
   PasExpr: TFpPascalExpression;
   ResValue: TFpDbgValue;
   s: String;
+  DispFormat: TWatchDisplayFormat;
+  RepeatCnt: Integer;
 
   function IsWatchValueAlive: Boolean;
   begin
@@ -957,7 +959,7 @@ var
 
   procedure DoPointer;
   begin
-    if not FPrettyPrinter.PrintValue(AResText, ResValue, []) then
+    if not FPrettyPrinter.PrintValue(AResText, ResValue, DispFormat, RepeatCnt) then
       exit;
     ATypeInfo := TDBGType.Create(skPointer, ResTypeName);
     ATypeInfo.Value.AsPointer := Pointer(ResValue.AsCardinal); // TODO: no cut off
@@ -966,7 +968,7 @@ var
 
   procedure DoSimple;
   begin
-    if not FPrettyPrinter.PrintValue(AResText, ResValue, []) then
+    if not FPrettyPrinter.PrintValue(AResText, ResValue, DispFormat, RepeatCnt) then
       exit;
     ATypeInfo := TDBGType.Create(skSimple, ResTypeName);
     ATypeInfo.Value.AsString := AResText;
@@ -974,7 +976,7 @@ var
 
   procedure DoEnum;
   begin
-    if not FPrettyPrinter.PrintValue(AResText, ResValue, []) then
+    if not FPrettyPrinter.PrintValue(AResText, ResValue, DispFormat, RepeatCnt) then
       exit;
     ATypeInfo := TDBGType.Create(skEnum, ResTypeName);
     ATypeInfo.Value.AsString := AResText;
@@ -982,7 +984,7 @@ var
 
   procedure DoSet;
   begin
-    if not FPrettyPrinter.PrintValue(AResText, ResValue, []) then
+    if not FPrettyPrinter.PrintValue(AResText, ResValue, DispFormat, RepeatCnt) then
       exit;
     ATypeInfo := TDBGType.Create(skSet, ResTypeName);
     ATypeInfo.Value.AsString := AResText;
@@ -996,7 +998,7 @@ var
     DBGType: TGDBType;
     f: TDBGField;
   begin
-    if not FPrettyPrinter.PrintValue(AResText, ResValue, []) then
+    if not FPrettyPrinter.PrintValue(AResText, ResValue, DispFormat, RepeatCnt) then
       exit;
     ATypeInfo := TDBGType.Create(skRecord, ResTypeName);
     ATypeInfo.Value.AsString := AResText;
@@ -1010,7 +1012,7 @@ var
         else
           begin
             DBGType := TGDBType.Create(skSimple, ResTypeName(m));
-            FPrettyPrinter.PrintValue(s2, m, []);
+            FPrettyPrinter.PrintValue(s2, m, DispFormat, RepeatCnt);
             DBGType.Value.AsString := s2;
             n := '';
             if m.DbgSymbol <> nil then n := m.DbgSymbol.Name;
@@ -1033,7 +1035,7 @@ var
     PasExpr2: TFpPascalExpression;
   begin
     if (ResValue.Kind = skClass) and (ResValue.AsCardinal = 0) then begin
-      if not FPrettyPrinter.PrintValue(AResText, ResValue, []) then
+      if not FPrettyPrinter.PrintValue(AResText, ResValue, DispFormat, RepeatCnt) then
         exit;
       ATypeInfo := TDBGType.Create(skSimple, ResTypeName);
       ATypeInfo.Value.AsString := AResText;
@@ -1042,7 +1044,7 @@ var
     end;
 
     CastName := '';
-    if (defClassAutoCast in EvalFlags) then begin
+    if (defClassAutoCast in EvalFlags) and (ResValue.Kind = skClass) then begin
       if FMemManager.ReadAddress(ResValue.DataAddress, Ctx.SizeOfAddress, ClassAddr) then begin
         ClassAddr.Address := ClassAddr.Address + 3 * Ctx.SizeOfAddress;
         if FMemManager.ReadAddress(ClassAddr, Ctx.SizeOfAddress, CNameAddr) then begin
@@ -1065,7 +1067,7 @@ var
     end;
 
 
-    if not FPrettyPrinter.PrintValue(AResText, ResValue, []) then
+    if not FPrettyPrinter.PrintValue(AResText, ResValue, DispFormat, RepeatCnt) then
       exit;
     if CastName <> '' then AResText := CastName + AResText;
     //if PasExpr.ResultValue.Kind = skObject then
@@ -1083,7 +1085,7 @@ var
         else
           begin
             DBGType := TGDBType.Create(skSimple, ResTypeName(m));
-            FPrettyPrinter.PrintValue(s2, m, []);
+            FPrettyPrinter.PrintValue(s2, m, DispFormat, RepeatCnt);
             DBGType.Value.AsString := s2;
             n := '';
             if m.DbgSymbol <> nil then n := m.DbgSymbol.Name;
@@ -1099,7 +1101,7 @@ var
 
   procedure DoArray;
   begin
-    if not FPrettyPrinter.PrintValue(AResText, ResValue, []) then
+    if not FPrettyPrinter.PrintValue(AResText, ResValue, DispFormat, RepeatCnt) then
       exit;
     ATypeInfo := TDBGType.Create(skArray, ResTypeName);
     ATypeInfo.Value.AsString := AResText;
@@ -1122,14 +1124,21 @@ begin
   //  FMemReader.FStackFrame := CurrentStackFrame;
   end;
 
-  if AWatchValue <> nil then
+  if AWatchValue <> nil then begin
-    Ctx := GetInfoContextForContext(AWatchValue.ThreadId, AWatchValue.StackFrame)
+    Ctx := GetInfoContextForContext(AWatchValue.ThreadId, AWatchValue.StackFrame);
-  else
+    DispFormat := AWatchValue.DisplayFormat;
+    RepeatCnt := AWatchValue.RepeatCount;
+  end
+  else begin
     Ctx := GetInfoContextForContext(CurrentThreadId, CurrentStackFrame);
+    DispFormat := wdfDefault;
+    RepeatCnt := -1;
+  end;
   if Ctx = nil then exit;
 
   FMemManager.DefaultContext := Ctx;
   FPrettyPrinter.AddressSize := ctx.SizeOfAddress;
+  FPrettyPrinter.MemManager := ctx.MemManager;
 
   PasExpr := TFpPascalExpression.Create(AExpression, Ctx);
   try
@@ -1187,7 +1196,8 @@ DebugLn(ErrorHandler.ErrorAsString(PasExpr.Error));
       PasExpr.FixPCharIndexAccess := True;
       PasExpr.ResetEvaluation;
       ResValue := PasExpr.ResultValue;
-      if (ResValue=nil) or (not FPrettyPrinter.PrintValue(s, ResValue, [])) then s := 'Failed';
+      if (ResValue=nil) or (not FPrettyPrinter.PrintValue(s, ResValue, DispFormat, RepeatCnt)) then
+        s := 'Failed';
       AResText := 'PChar: '+AResText+ LineEnding + 'String: '+s;
     end;