mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-06 03:20:18 +02:00
FpDebug: started DisplayFormat
git-svn-id: trunk@44896 -
This commit is contained in:
martin
parent
31b29671af
commit
6281c4adcf
@ -5,8 +5,8 @@ unit FpPascalBuilder;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, DbgIntfBaseTypes, FpDbgInfo, FpdMemoryTools, FpErrorMessages,
|
||||
LazLoggerBase;
|
||||
Classes, SysUtils, DbgIntfBaseTypes, DbgIntfDebuggerBase, FpDbgInfo, FpdMemoryTools,
|
||||
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;
|
||||
v := AValue.AsCardinal;
|
||||
if v = 0 then
|
||||
APrintedValue := 'nil'
|
||||
if ((ADisplayFormat = wdfDefault) and (ANestLevel=0)) or // default for unested: with typename
|
||||
(ADisplayFormat = wdfStructure)
|
||||
then
|
||||
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;
|
||||
if (c = 0) and (svfOrdinal in AValue.FieldFlags) then begin // dyn array
|
||||
Cnt := AValue.MemberCount;
|
||||
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
|
||||
else if (ANestLevel > 0) and (c > 15) then c := 15
|
||||
else if (c > 500) then c := 500;
|
||||
if (ANestLevel > 1) and (Cnt > 3) then Cnt := 3
|
||||
else if (ANestLevel > 0) and (Cnt > 10) then Cnt := 10
|
||||
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
|
||||
APrintedValue := APrintedValue + ', ...';
|
||||
if Cnt < FullCnt then
|
||||
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.
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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
|
||||
Ctx := GetInfoContextForContext(AWatchValue.ThreadId, AWatchValue.StackFrame)
|
||||
else
|
||||
if AWatchValue <> nil then begin
|
||||
Ctx := GetInfoContextForContext(AWatchValue.ThreadId, AWatchValue.StackFrame);
|
||||
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;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user