paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-10-15 11:16:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpGdbmiDebugger, FPDebug: move code for watches dbginfo

Browse Source 
git-svn-id: trunk@44974 -
This commit is contained in:
martin 2014-05-08 16:29:54 +00:00
parent f35d89328d
commit 89d29e376f
2 changed files with 170 additions and 226 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

166
components/fpdebug/fppascalbuilder.pas
View File

@ -29,10 +29,17 @@ type
TTypeDeclarationFlags = set of TTypeDeclarationFlag; TTypeDeclarationFlags = set of TTypeDeclarationFlag;
TFpPrettyPrintValueFlag = ( TFpPrettyPrintValueFlag = (
ppvCreateDbgType,
ppvSkipClassBody, ppvSkipRecordBody ppvSkipClassBody, ppvSkipRecordBody
); );
TFpPrettyPrintValueFlags = set of TFpPrettyPrintValueFlag; TFpPrettyPrintValueFlags = set of TFpPrettyPrintValueFlag;
const
PV_FORWARD_FLAGS = [ppvSkipClassBody, ppvSkipRecordBody];
type
PDBGType = ^TDBGType;
{ TFpPascalPrettyPrinter } { TFpPascalPrettyPrinter }
@ -46,7 +53,8 @@ type
AFlags: TFpPrettyPrintValueFlags; AFlags: TFpPrettyPrintValueFlags;
ANestLevel: Integer; AnIndent: String; ANestLevel: Integer; AnIndent: String;
ADisplayFormat: TWatchDisplayFormat; ADisplayFormat: TWatchDisplayFormat;
ARepeatCount: Integer = -1 ARepeatCount: Integer = -1;
ADBGTypeInfo: PDBGType = nil
): Boolean; ): Boolean;
public public
constructor Create(AnAddressSize: Integer); constructor Create(AnAddressSize: Integer);
@ -55,6 +63,12 @@ type
ADisplayFormat: TWatchDisplayFormat = wdfDefault; ADisplayFormat: TWatchDisplayFormat = wdfDefault;
ARepeatCount: Integer = -1 ARepeatCount: Integer = -1
): Boolean; ): Boolean;
function PrintValue(out APrintedValue: String;
out ADBGTypeInfo: TDBGType;
AValue: TFpDbgValue;
ADisplayFormat: TWatchDisplayFormat = wdfDefault;
ARepeatCount: Integer = -1
): Boolean;
property AddressSize: Integer read FAddressSize write FAddressSize; property AddressSize: Integer read FAddressSize write FAddressSize;
property MemManager: TFpDbgMemManager read FMemManager write FMemManager; property MemManager: TFpDbgMemManager read FMemManager write FMemManager;
end; end;
@ -429,7 +443,7 @@ end;
function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String; function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
AValue: TFpDbgValue; AnAddressSize: Integer; AFlags: TFpPrettyPrintValueFlags; AValue: TFpDbgValue; AnAddressSize: Integer; AFlags: TFpPrettyPrintValueFlags;
ANestLevel: Integer; AnIndent: String; ADisplayFormat: TWatchDisplayFormat; ANestLevel: Integer; AnIndent: String; ADisplayFormat: TWatchDisplayFormat;
ARepeatCount: Integer): Boolean; ARepeatCount: Integer; ADBGTypeInfo: PDBGType): Boolean;
function ResTypeName: String; function ResTypeName: String;
@ -439,6 +453,13 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
then then
Result := ''; Result := '';
end; end;
function ResTypeName(AVal : TFpDbgValue): String;
begin
if not((AVal.TypeInfo<> nil) and
GetTypeName(Result, AVal.TypeInfo, []))
then
Result := '';
end;
procedure DoPointer; procedure DoPointer;
var var
@ -452,6 +473,11 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
else else
s := ''; s := '';
if (ppvCreateDbgType in AFlags) then begin
ADBGTypeInfo^ := TDBGType.Create(skPointer, s);
ADBGTypeInfo^.Value.AsPointer := Pointer(AValue.AsCardinal); // TODO: no cut off
end;
v := AValue.AsCardinal; v := AValue.AsCardinal;
case ADisplayFormat of case ADisplayFormat of
wdfDecimal, wdfUnsigned: APrintedValue := IntToStr(AValue.AsCardinal); wdfDecimal, wdfUnsigned: APrintedValue := IntToStr(AValue.AsCardinal);
@ -495,6 +521,11 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
else else
APrintedValue := IntToStr(AValue.AsInteger); APrintedValue := IntToStr(AValue.AsInteger);
end; end;
if (ppvCreateDbgType in AFlags) then begin
ADBGTypeInfo^ := TDBGType.Create(skSimple, ResTypeName);
//ADBGTypeInfo^.Value.As64Bits := QWord(AValue.AsInteger); // TODO: no cut off
end;
Result := True; Result := True;
end; end;
@ -519,6 +550,11 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
else else
APrintedValue := IntToStr(AValue.AsCardinal); APrintedValue := IntToStr(AValue.AsCardinal);
end; end;
if (ppvCreateDbgType in AFlags) then begin
ADBGTypeInfo^ := TDBGType.Create(skSimple, ResTypeName);
//ADBGTypeInfo^.Value.As64Bits := QWord(AValue.AsiCardinal); // TODO: no cut off
end;
Result := True; Result := True;
end; end;
@ -531,18 +567,28 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
end end
else else
APrintedValue := 'False'; APrintedValue := 'False';
if (ppvCreateDbgType in AFlags) then begin
ADBGTypeInfo^ := TDBGType.Create(skSimple, ResTypeName);
end;
Result := True; Result := True;
end; end;
procedure DoChar; procedure DoChar;
begin begin
APrintedValue := '''' + AValue.AsString + ''''; // Todo escape APrintedValue := '''' + AValue.AsString + ''''; // Todo escape
if (ppvCreateDbgType in AFlags) then begin
ADBGTypeInfo^ := TDBGType.Create(skSimple, ResTypeName);
end;
Result := True; Result := True;
end; end;
procedure DoFloat; procedure DoFloat;
begin begin
APrintedValue := FloatToStr(AValue.AsFloat); APrintedValue := FloatToStr(AValue.AsFloat);
if (ppvCreateDbgType in AFlags) then begin
ADBGTypeInfo^ := TDBGType.Create(skSimple, ResTypeName);
end;
Result := True; Result := True;
end; end;
@ -554,6 +600,12 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
if APrintedValue = '' then begin if APrintedValue = '' then begin
s := ResTypeName; s := ResTypeName;
APrintedValue := s + '(' + IntToStr(AValue.AsCardinal) + ')'; APrintedValue := s + '(' + IntToStr(AValue.AsCardinal) + ')';
end
else if (ppvCreateDbgType in AFlags) then
s := ResTypeName;
if (ppvCreateDbgType in AFlags) then begin
ADBGTypeInfo^ := TDBGType.Create(skEnum, s);
end; end;
Result := True; Result := True;
end; end;
@ -564,6 +616,10 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
if APrintedValue <> '' then if APrintedValue <> '' then
APrintedValue := APrintedValue + ':='; APrintedValue := APrintedValue + ':=';
APrintedValue := APrintedValue+ IntToStr(AValue.AsCardinal); APrintedValue := APrintedValue+ IntToStr(AValue.AsCardinal);
if (ppvCreateDbgType in AFlags) then begin
ADBGTypeInfo^ := TDBGType.Create(skSimple, ResTypeName);
end;
Result := True; Result := True;
end; end;
@ -588,30 +644,50 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
else APrintedValue := APrintedValue + ', ' + s; else APrintedValue := APrintedValue + ', ' + s;
end; end;
APrintedValue := '[' + APrintedValue + ']'; APrintedValue := '[' + APrintedValue + ']';
if (ppvCreateDbgType in AFlags) then begin
ADBGTypeInfo^ := TDBGType.Create(skSet, ResTypeName);
end;
Result := True; Result := True;
end; end;
procedure DoStructure; procedure DoStructure;
var var
s, s2: String; s, s2, MbName, MbVal: String;
i: Integer; i: Integer;
m: TFpDbgValue; m: TFpDbgValue;
fl: TFpPrettyPrintValueFlags; fl: TFpPrettyPrintValueFlags;
f: TDBGField;
begin begin
if (AValue.Kind = skClass) and (AValue.AsCardinal = 0) then begin if (AValue.Kind = skClass) and (AValue.AsCardinal = 0) then begin
APrintedValue := 'nil'; APrintedValue := 'nil';
Result := True; if (ppvCreateDbgType in AFlags) then begin
exit; ADBGTypeInfo^ := TDBGType.Create(skSimple, ResTypeName);
end; end;
if ADisplayFormat = wdfPointer then begin
s := ResTypeName;
APrintedValue := '$'+IntToHex(AValue.AsCardinal, AnAddressSize*2);
if s <> '' then
APrintedValue := s + '(' + APrintedValue + ')';
Result := True; Result := True;
exit; exit;
end; end;
if (ppvCreateDbgType in AFlags) then begin
s := ResTypeName;
case AValue.Kind of
skRecord: ADBGTypeInfo^ := TDBGType.Create(skRecord, s);
skObject: ADBGTypeInfo^ := TDBGType.Create(skClass, s);
skClass: ADBGTypeInfo^ := TDBGType.Create(skClass, s);
end;
end;
if ADisplayFormat = wdfPointer then begin
if not (ppvCreateDbgType in AFlags) then
s := ResTypeName;
APrintedValue := '$'+IntToHex(AValue.AsCardinal, AnAddressSize*2);
if s <> '' then
APrintedValue := s + '(' + APrintedValue + ')';
Result := True;
if not (ppvCreateDbgType in AFlags) then
exit;
end
else
if ( (AValue.Kind in [skClass, skObject]) and (ppvSkipClassBody in AFlags) ) or if ( (AValue.Kind in [skClass, skObject]) and (ppvSkipClassBody in AFlags) ) or
( (AValue.Kind in [skRecord]) and (ppvSkipRecordBody in AFlags) ) ( (AValue.Kind in [skRecord]) and (ppvSkipRecordBody in AFlags) )
then begin then begin
@ -622,7 +698,8 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
skClass: APrintedValue := '{class:}' + APrintedValue + '(' + '$'+IntToHex(AValue.AsCardinal, AnAddressSize*2) + ')'; skClass: APrintedValue := '{class:}' + APrintedValue + '(' + '$'+IntToHex(AValue.AsCardinal, AnAddressSize*2) + ')';
end; end;
Result := True; Result := True;
exit; if not (ppvCreateDbgType in AFlags) then
exit;
end; end;
s2 := LineEnding; s2 := LineEnding;
@ -631,20 +708,39 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
//if ppvSkipClassBody in AFlags then //if ppvSkipClassBody in AFlags then
// fl := [ppvSkipClassBody, ppvSkipRecordBody]; // fl := [ppvSkipClassBody, ppvSkipRecordBody];
APrintedValue := ''; if not Result then
APrintedValue := '';
for i := 0 to AValue.MemberCount-1 do begin for i := 0 to AValue.MemberCount-1 do begin
m := AValue.Member[i]; m := AValue.Member[i];
if (m = nil) or (m.Kind in [skProcedure, skFunction]) then if (m = nil) or (m.Kind in [skProcedure, skFunction]) then
continue; continue;
s := ''; s := '';
InternalPrintValue(s, m, AnAddressSize, fl, ANestLevel+1, AnIndent, ADisplayFormat); InternalPrintValue(MbVal, m, AnAddressSize, fl, ANestLevel+1, AnIndent, ADisplayFormat);
if m.DbgSymbol <> nil then if m.DbgSymbol <> nil then begin
s := m.DbgSymbol.Name + ' = ' + s; MbName := m.DbgSymbol.Name;
if APrintedValue = '' s := MbName + ' = ' + MbVal;
then APrintedValue := s end
else APrintedValue := APrintedValue + '; ' + s2 + s; else begin
MbName := '';
s := MbVal;
end;
if not Result then begin
if APrintedValue = ''
then APrintedValue := s
else APrintedValue := APrintedValue + '; ' + s2 + s;
end;
if (ppvCreateDbgType in AFlags) then begin
s := '';
if m.ContextTypeInfo <> nil then s := m.ContextTypeInfo.Name;
f := TDBGField.Create(MbName, TDBGType.Create(skSimple, ResTypeName(m)),
flPublic, [], s);
f.DBGType.Value.AsString := MbVal;
ADBGTypeInfo^.Fields.Add(f);
end;
end; end;
APrintedValue := '(' + APrintedValue + ')'; if not Result then
APrintedValue := '(' + APrintedValue + ')';
Result := True; Result := True;
end; end;
@ -656,6 +752,14 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
Cnt, FullCnt, d: Integer; Cnt, FullCnt, d: Integer;
begin begin
APrintedValue := ''; APrintedValue := '';
if (ppvCreateDbgType in AFlags) then begin
ADBGTypeInfo^ := TDBGType.Create(skArray, ResTypeName);
//ATypeInfo.Len;
//ATypeInfo.BoundLow;
//ATypeInfo.BoundHigh;
end;
Cnt := AValue.MemberCount; Cnt := AValue.MemberCount;
FullCnt := Cnt; FullCnt := Cnt;
if (Cnt = 0) and (svfOrdinal in AValue.FieldFlags) then begin // dyn array if (Cnt = 0) and (svfOrdinal in AValue.FieldFlags) then begin // dyn array
@ -680,7 +784,7 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
for i := d to d + Cnt - 1 do begin for i := d to d + Cnt - 1 do begin
m := AValue.Member[i]; m := AValue.Member[i];
if m <> nil then if m <> nil then
InternalPrintValue(s, m, AnAddressSize, AFlags, ANestLevel+1, AnIndent, ADisplayFormat) InternalPrintValue(s, m, AnAddressSize, AFlags * PV_FORWARD_FLAGS, ANestLevel+1, AnIndent, ADisplayFormat)
else else
s := '{error}'; s := '{error}';
if APrintedValue = '' if APrintedValue = ''
@ -698,6 +802,7 @@ var
MemDest: array of Byte; MemDest: array of Byte;
i: Integer; i: Integer;
begin begin
if ADBGTypeInfo <> nil then ADBGTypeInfo^ := nil;
if ANestLevel > 0 then begin if ANestLevel > 0 then begin
AnIndent := AnIndent + ' '; AnIndent := AnIndent + ' ';
end; end;
@ -770,6 +875,9 @@ begin
skArray: DoArray; skArray: DoArray;
end; end;
if (ADBGTypeInfo <> nil) and (ADBGTypeInfo^ <> nil) then
ADBGTypeInfo^.Value.AsString := APrintedValue;
if IsError(AValue.LastError) then if IsError(AValue.LastError) then
APrintedValue := ErrorHandler.ErrorAsString(AValue.LastError); APrintedValue := ErrorHandler.ErrorAsString(AValue.LastError);
end; end;
@ -781,12 +889,18 @@ end;
function TFpPascalPrettyPrinter.PrintValue(out APrintedValue: String; AValue: TFpDbgValue; function TFpPascalPrettyPrinter.PrintValue(out APrintedValue: String; AValue: TFpDbgValue;
ADisplayFormat: TWatchDisplayFormat; ARepeatCount: Integer): Boolean; ADisplayFormat: TWatchDisplayFormat; ARepeatCount: Integer): Boolean;
var
x: QWord;
begin begin
x:= GetTickCount64; Result := InternalPrintValue(APrintedValue, AValue,
Result := InternalPrintValue(APrintedValue, AValue, AddressSize, [], 0, '', ADisplayFormat, ARepeatCount); AddressSize, [], 0, '', ADisplayFormat, ARepeatCount);
debugln([' TFpPascalPrettyPrinter.PrintValue ', (GetTickCount64-x)/1000]); end;
function TFpPascalPrettyPrinter.PrintValue(out APrintedValue: String; out
ADBGTypeInfo: TDBGType; AValue: TFpDbgValue; ADisplayFormat: TWatchDisplayFormat;
ARepeatCount: Integer): Boolean;
begin
Result := InternalPrintValue(APrintedValue, AValue,
AddressSize, [ppvCreateDbgType], 0, '',
ADisplayFormat, ARepeatCount, @ADBGTypeInfo);
end; end;
end. end.

230
components/lazdebuggers/lazdebuggerfpgdbmi/fpgdbmidebugger.pp
View File

@ -96,7 +96,7 @@ type
procedure DoWatchFreed(Sender: TObject); procedure DoWatchFreed(Sender: TObject);
function EvaluateExpression(AWatchValue: TWatchValue; function EvaluateExpression(AWatchValue: TWatchValue;
AExpression: String; AExpression: String;
var AResText: String; out AResText: String;
out ATypeInfo: TDBGType; out ATypeInfo: TDBGType;
EvalFlags: TDBGEvaluateFlags = []): Boolean; EvalFlags: TDBGEvaluateFlags = []): Boolean;
property CurrentThreadId; property CurrentThreadId;
@ -112,6 +112,9 @@ procedure Register;
implementation implementation
var
FPGDBDBG_VERBOSE, FPGDBDBG_ERROR: PLazLoggerLogGroup;
type type
{ TFpGDBMIDebuggerCommandStartDebugging } { TFpGDBMIDebuggerCommandStartDebugging }
@ -383,7 +386,7 @@ end;
procedure TFpGDBMIAndWin32DbgMemReader.OpenProcess(APid: Cardinal); procedure TFpGDBMIAndWin32DbgMemReader.OpenProcess(APid: Cardinal);
begin begin
{$IFdef MSWindows} {$IFdef MSWindows}
debugln(['OPEN process ',APid]); debugln(FPGDBDBG_VERBOSE, ['OPEN process ',APid]);
if APid <> 0 then if APid <> 0 then
hProcess := windows.OpenProcess(PROCESS_CREATE_THREAD or PROCESS_QUERY_INFORMATION or PROCESS_VM_OPERATION or PROCESS_VM_WRITE or PROCESS_VM_READ, False, APid); hProcess := windows.OpenProcess(PROCESS_CREATE_THREAD or PROCESS_QUERY_INFORMATION or PROCESS_VM_OPERATION or PROCESS_VM_WRITE or PROCESS_VM_READ, False, APid);
{$ENDIF} {$ENDIF}
@ -435,7 +438,7 @@ begin
MemDump.Free; MemDump.Free;
Result := True; Result := True;
debugln(['TFpGDBMIDbgMemReader.ReadMemory ', dbgs(AnAddress), ' ', dbgMemRange(ADest, ASize)]); debugln(FPGDBDBG_VERBOSE, ['TFpGDBMIDbgMemReader.ReadMemory ', dbgs(AnAddress), ' ', dbgMemRange(ADest, ASize)]);
end; end;
function TFpGDBMIDbgMemReader.ReadMemoryEx(AnAddress, AnAddressSpace: TDbgPtr; function TFpGDBMIDbgMemReader.ReadMemoryEx(AnAddress, AnAddressSpace: TDbgPtr;
@ -503,7 +506,7 @@ begin
else else
v := ''; v := '';
if pos(' ', v) > 1 then v := copy(v, 1, pos(' ', v)-1); if pos(' ', v) > 1 then v := copy(v, 1, pos(' ', v)-1);
debugln(['TFpGDBMIDbgMemReader.ReadRegister ',rname, ' ', v]); debugln(FPGDBDBG_VERBOSE, ['TFpGDBMIDbgMemReader.ReadRegister ',rname, ' ', v]);
Result := true; Result := true;
try try
AValue := StrToQWord(v); AValue := StrToQWord(v);
@ -738,7 +741,7 @@ end;
procedure TFpGDBMIDebugger.LoadDwarf; procedure TFpGDBMIDebugger.LoadDwarf;
begin begin
UnLoadDwarf; UnLoadDwarf;
debugln(['TFpGDBMIDebugger.LoadDwarf ']); debugln(FPGDBDBG_VERBOSE, ['TFpGDBMIDebugger.LoadDwarf ']);
FImageLoader := TDbgImageLoader.Create(FileName); FImageLoader := TDbgImageLoader.Create(FileName);
if not FImageLoader.IsValid then begin if not FImageLoader.IsValid then begin
FreeAndNil(FImageLoader); FreeAndNil(FImageLoader);
@ -759,7 +762,7 @@ end;
procedure TFpGDBMIDebugger.UnLoadDwarf; procedure TFpGDBMIDebugger.UnLoadDwarf;
begin begin
debugln(['TFpGDBMIDebugger.UnLoadDwarf ']); debugln(FPGDBDBG_VERBOSE, ['TFpGDBMIDebugger.UnLoadDwarf ']);
FreeAndNil(FDwarfInfo); FreeAndNil(FDwarfInfo);
FreeAndNil(FImageLoader); FreeAndNil(FImageLoader);
FreeAndNil(FMemReader); FreeAndNil(FMemReader);
@ -851,7 +854,7 @@ begin
t := Threads.CurrentThreads.EntryById[AThreadId]; t := Threads.CurrentThreads.EntryById[AThreadId];
if t = nil then begin if t = nil then begin
DebugLn(['NO Threads']); DebugLn(FPGDBDBG_ERROR, ['NO Threads']);
exit; exit;
end; end;
if AStackFrame = 0 then begin if AStackFrame = 0 then begin
@ -862,12 +865,12 @@ begin
s := CallStack.CurrentCallStackList.EntriesForThreads[AThreadId]; s := CallStack.CurrentCallStackList.EntriesForThreads[AThreadId];
if s = nil then begin if s = nil then begin
DebugLn(['NO Stackframe list for thread']); DebugLn(FPGDBDBG_ERROR, ['NO Stackframe list for thread']);
exit; exit;
end; end;
f := s.Entries[AStackFrame]; f := s.Entries[AStackFrame];
if f = nil then begin if f = nil then begin
DebugLn(['NO Stackframe']); DebugLn(FPGDBDBG_ERROR, ['NO Stackframe']);
exit; exit;
end; end;
@ -909,7 +912,7 @@ begin
exit; exit;
end; end;
DebugLn(['* FDwarfInfo.FindContext ', dbgs(Addr)]); DebugLn(FPGDBDBG_VERBOSE, ['* FDwarfInfo.FindContext ', dbgs(Addr)]);
Result := FDwarfInfo.FindContext(AThreadId, AStackFrame, Addr); Result := FDwarfInfo.FindContext(AThreadId, AStackFrame, Addr);
FLastThread := AThreadId; FLastThread := AThreadId;
@ -929,9 +932,8 @@ begin
FWatchEvalList.Remove(pointer(Sender)); FWatchEvalList.Remove(pointer(Sender));
end; end;
function TFpGDBMIDebugger.EvaluateExpression(AWatchValue: TWatchValue; function TFpGDBMIDebugger.EvaluateExpression(AWatchValue: TWatchValue; AExpression: String;
AExpression: String; var AResText: String; out ATypeInfo: TDBGType; out AResText: String; out ATypeInfo: TDBGType; EvalFlags: TDBGEvaluateFlags): Boolean;
EvalFlags: TDBGEvaluateFlags): Boolean;
var var
Ctx: TFpDbgInfoContext; Ctx: TFpDbgInfoContext;
PasExpr: TFpPascalExpression; PasExpr: TFpPascalExpression;
@ -949,171 +951,11 @@ var
); );
end; end;
function ResTypeName(v: TFpDbgValue = nil): String;
begin
if v = nil then v := ResValue;
if not((v.TypeInfo<> nil) and
GetTypeName(Result, v.TypeInfo, []))
then
Result := '';
end;
procedure DoPointer;
begin
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
ATypeInfo.Value.AsString := AResText;
end;
procedure DoSimple;
begin
if not FPrettyPrinter.PrintValue(AResText, ResValue, DispFormat, RepeatCnt) then
exit;
ATypeInfo := TDBGType.Create(skSimple, ResTypeName);
ATypeInfo.Value.AsString := AResText;
end;
procedure DoEnum;
begin
if not FPrettyPrinter.PrintValue(AResText, ResValue, DispFormat, RepeatCnt) then
exit;
ATypeInfo := TDBGType.Create(skEnum, ResTypeName);
ATypeInfo.Value.AsString := AResText;
end;
procedure DoSet;
begin
if not FPrettyPrinter.PrintValue(AResText, ResValue, DispFormat, RepeatCnt) then
exit;
ATypeInfo := TDBGType.Create(skSet, ResTypeName);
ATypeInfo.Value.AsString := AResText;
end;
procedure DoRecord;
var
s2, n: String;
m: TFpDbgValue;
i: Integer;
DBGType: TGDBType;
f: TDBGField;
begin
if not FPrettyPrinter.PrintValue(AResText, ResValue, DispFormat, RepeatCnt) then
exit;
ATypeInfo := TDBGType.Create(skRecord, ResTypeName);
ATypeInfo.Value.AsString := AResText;
if not(defFullTypeInfo in EvalFlags) then exit;
for i := 0 to ResValue.MemberCount - 1 do begin
m := ResValue.Member[i];
if m = nil then Continue; // Todo: procedures.
case m.Kind of
skProcedure, skFunction: ; // DBGType := TGDBType.Create(skProcedure, TGDBTypes.CreateFromCSV(Params))
else
begin
DBGType := TGDBType.Create(skSimple, ResTypeName(m));
FPrettyPrinter.PrintValue(s2, m, DispFormat, RepeatCnt);
DBGType.Value.AsString := s2;
n := '';
if m.DbgSymbol <> nil then n := m.DbgSymbol.Name;
f := TDBGField.Create(n, DBGType, flPublic);
ATypeInfo.Fields.Add(f);
end;
end;
end;
end;
procedure DoClass;
var
m: TFpDbgValue;
s, s2, n, CastName: String;
DBGType: TGDBType;
f: TDBGField;
i: Integer;
ClassAddr, CNameAddr: TFpDbgMemLocation;
NameLen: QWord;
PasExpr2: TFpPascalExpression;
begin
if (ResValue.Kind = skClass) and (ResValue.AsCardinal = 0) then begin
if not FPrettyPrinter.PrintValue(AResText, ResValue, DispFormat, RepeatCnt) then
exit;
ATypeInfo := TDBGType.Create(skSimple, ResTypeName);
ATypeInfo.Value.AsString := AResText;
Result := True;
exit;
end;
CastName := '';
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
if (FMemManager.ReadUnsignedInt(CNameAddr, 1, NameLen)) then
if NameLen > 0 then begin
SetLength(CastName, NameLen);
CNameAddr.Address := CNameAddr.Address + 1;
FMemManager.ReadMemory(CNameAddr, NameLen, @CastName[1]);
PasExpr2 := TFpPascalExpression.Create(CastName+'('+AExpression+')', Ctx);
if PasExpr2.Valid and (PasExpr2.ResultValue <> nil) then begin
PasExpr.Free;
PasExpr := PasExpr2;
ResValue := PasExpr.ResultValue;
end
else
PasExpr2.Free;
end;
end;
end;
end;
if not FPrettyPrinter.PrintValue(AResText, ResValue, DispFormat, RepeatCnt) then
exit;
if CastName <> '' then AResText := CastName + AResText;
//if PasExpr.ResultValue.Kind = skObject then
// ATypeInfo := TDBGType.Create(skObject, ResTypeName)
//else
ATypeInfo := TDBGType.Create(skClass, ResTypeName);
ATypeInfo.Value.AsString := AResText;
if not(defFullTypeInfo in EvalFlags) then exit;
for i := 0 to ResValue.MemberCount - 1 do begin
m := ResValue.Member[i];
if m = nil then Continue; // Todo: procedures.
case m.Kind of
skProcedure, skFunction: ; // DBGType := TGDBType.Create(skProcedure, TGDBTypes.CreateFromCSV(Params))
else
begin
DBGType := TGDBType.Create(skSimple, ResTypeName(m));
FPrettyPrinter.PrintValue(s2, m, DispFormat, RepeatCnt);
DBGType.Value.AsString := s2;
n := '';
if m.DbgSymbol <> nil then n := m.DbgSymbol.Name;
s := '';
if m.ContextTypeInfo <> nil then s := m.ContextTypeInfo.Name;
// TODO visibility // flags virtual, constructor
f := TDBGField.Create(n, DBGType, flPublic, [], s);
ATypeInfo.Fields.Add(f);
end;
end;
end;
end;
procedure DoArray;
begin
if not FPrettyPrinter.PrintValue(AResText, ResValue, DispFormat, RepeatCnt) then
exit;
ATypeInfo := TDBGType.Create(skArray, ResTypeName);
ATypeInfo.Value.AsString := AResText;
//ATypeInfo.Len;
//ATypeInfo.BoundLow;
//ATypeInfo.BoundHigh;
end;
begin begin
Result := False; Result := False;
ATypeInfo := nil; ATypeInfo := nil;
AResText := '';
if AWatchValue <> nil then begin if AWatchValue <> nil then begin
EvalFlags := AWatchValue.EvaluateFlags; EvalFlags := AWatchValue.EvaluateFlags;
AExpression := AWatchValue.Expression; AExpression := AWatchValue.Expression;
@ -1148,7 +990,7 @@ begin
if not IsWatchValueAlive then exit; if not IsWatchValueAlive then exit;
if not PasExpr.Valid then begin if not PasExpr.Valid then begin
DebugLn(ErrorHandler.ErrorAsString(PasExpr.Error)); DebugLn(FPGDBDBG_VERBOSE, [ErrorHandler.ErrorAsString(PasExpr.Error)]);
if ErrorCode(PasExpr.Error) <> fpErrAnyError then begin if ErrorCode(PasExpr.Error) <> fpErrAnyError then begin
Result := True; Result := True;
AResText := ErrorHandler.ErrorAsString(PasExpr.Error);; AResText := ErrorHandler.ErrorAsString(PasExpr.Error);;
@ -1167,28 +1009,6 @@ DebugLn(ErrorHandler.ErrorAsString(PasExpr.Error));
ResValue := PasExpr.ResultValue; ResValue := PasExpr.ResultValue;
case ResValue.Kind of case ResValue.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: DoRecord;
skObject: DoClass;
skClass: DoClass;
skInterface: ;
skArray: DoArray;
skNone: begin skNone: begin
// maybe type // maybe type
TiSym := ResValue.DbgSymbol; TiSym := ResValue.DbgSymbol;
@ -1206,6 +1026,13 @@ DebugLn(ErrorHandler.ErrorAsString(PasExpr.Error));
exit; exit;
end; end;
end; end;
else
begin
if defNoTypeInfo in EvalFlags then
FPrettyPrinter.PrintValue(AResText, ResValue, DispFormat, RepeatCnt)
else
FPrettyPrinter.PrintValue(AResText, ATypeInfo, ResValue, DispFormat, RepeatCnt);
end;
end; end;
if not IsWatchValueAlive then exit; if not IsWatchValueAlive then exit;
@ -1219,10 +1046,10 @@ DebugLn(ErrorHandler.ErrorAsString(PasExpr.Error));
AResText := 'PChar: '+AResText+ LineEnding + 'String: '+s; AResText := 'PChar: '+AResText+ LineEnding + 'String: '+s;
end; end;
if ATypeInfo <> nil then begin if (ATypeInfo <> nil) or (AResText <> '') then begin
Result := True; Result := True;
debugln(['TFPGDBMIWatches.InternalRequestData GOOOOOOD ', AExpression]); debugln(FPGDBDBG_VERBOSE, ['TFPGDBMIWatches.InternalRequestData GOOOOOOD ', AExpression]);
if AWatchValue <> nil then begin; if AWatchValue <> nil then begin
AWatchValue.Value := AResText; AWatchValue.Value := AResText;
AWatchValue.TypeInfo := ATypeInfo; AWatchValue.TypeInfo := ATypeInfo;
if IsError(ResValue.LastError) then if IsError(ResValue.LastError) then
@ -1289,5 +1116,8 @@ begin
end; end;
initialization
FPGDBDBG_VERBOSE := DebugLogger.FindOrRegisterLogGroup('FPGDBDBG_VERBOSE' {$IFDEF FPGDBDBG_VERBOSE} , True {$ENDIF} );
FPGDBDBG_ERROR := DebugLogger.FindOrRegisterLogGroup('FPGDBDBG_ERROR' {$IFDEF FPGDBDBG_ERROR} , True {$ENDIF} );
end. end.