mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-11 13:56:05 +02:00
FPGDBMIDebugger: structured values
git-svn-id: trunk@44121 -
This commit is contained in:
parent
c789f1367f
commit
a503dc1f3c
@ -492,6 +492,8 @@ type
|
||||
{ TDBGType }
|
||||
|
||||
TDBGType = class(TObject)
|
||||
private
|
||||
function GetFields: TDBGFields;
|
||||
protected
|
||||
FAncestor: String;
|
||||
FResult: TDBGType;
|
||||
@ -515,7 +517,7 @@ type
|
||||
destructor Destroy; override;
|
||||
property Ancestor: String read FAncestor;
|
||||
property Arguments: TDBGTypes read FArguments;
|
||||
property Fields: TDBGFields read FFields;
|
||||
property Fields: TDBGFields read GetFields;
|
||||
property Kind: TDBGSymbolKind read FKind;
|
||||
property Attributes: TDBGSymbolAttributes read FAttributes;
|
||||
property TypeName: String read FTypeName; // Name/Alias as in type section. One pascal token, or empty
|
||||
@ -2482,6 +2484,13 @@ end;
|
||||
|
||||
{ TDBGPType }
|
||||
|
||||
function TDBGType.GetFields: TDBGFields;
|
||||
begin
|
||||
if FFields = nil then
|
||||
FFields := TDBGFields.Create;
|
||||
Result := FFields;
|
||||
end;
|
||||
|
||||
procedure TDBGType.Init;
|
||||
begin
|
||||
//
|
||||
|
@ -1191,6 +1191,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
|
||||
procedure TypeInfoNeeded; override; // nil or inherited
|
||||
function GetTypedValueObject(ATypeCast: Boolean): TDbgDwarfSymbolValue; override;
|
||||
|
||||
// GetMember, if AIndex > Count then parent
|
||||
function GetMember(AIndex: Integer): TDbgSymbol; override;
|
||||
function GetMemberByName(AIndex: String): TDbgSymbol; override;
|
||||
function GetMemberCount: Integer; override;
|
||||
@ -2653,7 +2654,7 @@ begin
|
||||
if FSize <> 1 then
|
||||
Result := inherited GetAsString
|
||||
else
|
||||
Result := char(byte(GetAsCardinal));
|
||||
Result := SysToUTF8(char(byte(GetAsCardinal)));
|
||||
end;
|
||||
|
||||
function TDbgDwarfCharSymbolValue.GetAsWideString: WideString;
|
||||
@ -5575,8 +5576,15 @@ var
|
||||
ti: TDbgSymbol;
|
||||
begin
|
||||
ti := TypeInfo;
|
||||
if ti <> nil then
|
||||
Result := ti.MemberCount
|
||||
if ti <> nil then begin
|
||||
Result := ti.MemberCount;
|
||||
//TODO: cache result
|
||||
if ti.Kind in [skClass, skObject] then
|
||||
while ti.TypeInfo <> nil do begin
|
||||
ti := ti.TypeInfo;
|
||||
Result := Result + ti.MemberCount;
|
||||
end;
|
||||
end
|
||||
else
|
||||
Result := inherited GetMemberCount;
|
||||
end;
|
||||
@ -5948,9 +5956,17 @@ begin
|
||||
end;
|
||||
|
||||
function TDbgDwarfIdentifierStructure.GetMember(AIndex: Integer): TDbgSymbol;
|
||||
var
|
||||
ti: TDbgSymbol;
|
||||
begin
|
||||
CreateMembers;
|
||||
Result := TDbgSymbol(FMembers[AIndex]);
|
||||
if AIndex >= FMembers.Count then begin
|
||||
ti := TypeInfo;
|
||||
if ti <> nil then
|
||||
Result := ti.Member[AIndex - FMembers.Count];
|
||||
end
|
||||
else
|
||||
Result := TDbgSymbol(FMembers[AIndex]);
|
||||
end;
|
||||
|
||||
destructor TDbgDwarfIdentifierStructure.Destroy;
|
||||
|
@ -148,7 +148,7 @@ type
|
||||
(* Member:
|
||||
* skClass, skStructure:
|
||||
stType: it excludes BaseClass (TODO: decide?)
|
||||
stValue: ???
|
||||
stValue: includes
|
||||
* skSet
|
||||
stType: all members
|
||||
stValue: only members set in value (Only impremented for DbgSymbolValue)
|
||||
@ -293,7 +293,7 @@ type
|
||||
(* Member:
|
||||
* skClass, skStructure:
|
||||
stType: it excludes BaseClass (TODO: decide?)
|
||||
stValue: ???
|
||||
includes
|
||||
* skSet
|
||||
stType: all members
|
||||
stValue: only members set in value (Only impremented for DbgSymbolValue)
|
||||
|
@ -5,7 +5,7 @@ unit FpPascalBuilder;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, DbgIntfBaseTypes, FpDbgInfo;
|
||||
Classes, SysUtils, DbgIntfBaseTypes, FpDbgInfo, LazLoggerBase;
|
||||
|
||||
type
|
||||
TTypeNameFlag = (
|
||||
@ -27,7 +27,9 @@ type
|
||||
);
|
||||
TTypeDeclarationFlags = set of TTypeDeclarationFlag;
|
||||
|
||||
TPrintPasValFlag = (dummyx1);
|
||||
TPrintPasValFlag = (
|
||||
ppvSkipClassBody, ppvSkipRecordBody
|
||||
);
|
||||
TPrintPasValFlags = set of TPrintPasValFlag;
|
||||
|
||||
function GetTypeName(out ATypeName: String; ADbgSymbol: TDbgSymbol; AFlags: TTypeNameFlags = []): Boolean;
|
||||
@ -474,16 +476,69 @@ function PrintPasValue(out APrintedValue: String; AResValue: TDbgSymbolValue;
|
||||
var
|
||||
s: String;
|
||||
i: Integer;
|
||||
m: TDbgSymbolValue;
|
||||
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;
|
||||
for i := 0 to AResValue.MemberCount-1 do begin
|
||||
m := AResValue.Member[i];
|
||||
if svfIdentifier in m.FieldFlags then
|
||||
s := m.AsString
|
||||
else
|
||||
if svfOrdinal in m.FieldFlags then // set of byte
|
||||
s := IntToStr(m.AsCardinal)
|
||||
else
|
||||
Continue; // Todo: missing member
|
||||
if APrintedValue = ''
|
||||
then APrintedValue := s
|
||||
else APrintedValue := APrintedValue + ', ' + s;
|
||||
end;
|
||||
APrintedValue := '[' + APrintedValue + ']';
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
procedure DoStructure;
|
||||
var
|
||||
s, s2: String;
|
||||
i: Integer;
|
||||
m: TDbgSymbolValue;
|
||||
fl: TPrintPasValFlags;
|
||||
begin
|
||||
if ( (AResValue.Kind in [skClass, skObject]) and (ppvSkipClassBody in AFlags) ) or
|
||||
( (AResValue.Kind in [skRecord]) and (ppvSkipRecordBody in AFlags) )
|
||||
then begin
|
||||
APrintedValue := ResTypeName;
|
||||
case AResValue.Kind of
|
||||
skRecord: APrintedValue := '{record:}' + APrintedValue;
|
||||
skObject: APrintedValue := '{object:}' + APrintedValue;
|
||||
skClass: APrintedValue := '{class:}' + APrintedValue + '(' + '$'+IntToHex(AResValue.AsCardinal, AnAddrSize) + ')';
|
||||
end;
|
||||
Result := True;
|
||||
exit;
|
||||
end;
|
||||
|
||||
s2 := LineEnding;
|
||||
if AFlags <> [] then s2 := ' ';;
|
||||
fl := [ppvSkipClassBody];
|
||||
if ppvSkipClassBody in AFlags then
|
||||
fl := [ppvSkipClassBody, ppvSkipRecordBody];
|
||||
|
||||
APrintedValue := '';
|
||||
for i := 0 to AResValue.MemberCount-1 do begin
|
||||
m := AResValue.Member[i];
|
||||
if (m = nil) or (m.Kind in [skProcedure, skFunction]) then
|
||||
continue;
|
||||
s := '';
|
||||
PrintPasValue(s, m, AnAddrSize, fl);
|
||||
if m.DbgSymbol <> nil then
|
||||
s := m.DbgSymbol.Name + ' = ' + s;
|
||||
if APrintedValue = ''
|
||||
then APrintedValue := s
|
||||
else APrintedValue := APrintedValue + '; ' + s2 + s;
|
||||
end;
|
||||
APrintedValue := '(' + APrintedValue + ')';
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
begin
|
||||
Result := False;
|
||||
case AResValue.Kind of
|
||||
@ -504,9 +559,9 @@ begin
|
||||
skEnum: DoEnum;
|
||||
skEnumValue: DoEnumVal;
|
||||
skSet: DoSet;
|
||||
skRecord: ;
|
||||
skObject: ;
|
||||
skClass: ;
|
||||
skRecord: DoStructure;
|
||||
skObject: DoStructure;
|
||||
skClass: DoStructure;
|
||||
skInterface: ;
|
||||
skArray: ;
|
||||
end;
|
||||
|
@ -226,7 +226,7 @@ begin
|
||||
ADest, ASize,
|
||||
BytesRead) and
|
||||
(BytesRead = ASize);
|
||||
DebugLn(['*&*&*&*& ReadMem ', dbgs(Result), ' at ', AnAddress, ' Size ',ASize, ' br=',BytesRead, ' b1',PBYTE(ADest)^]);
|
||||
//DebugLn(['*&*&*&*& ReadMem ', dbgs(Result), ' at ', AnAddress, ' Size ',ASize, ' br=',BytesRead, ' b1',PBYTE(ADest)^]);
|
||||
{$ELSE}
|
||||
Result := inherited ReadMemory(AnAddress, ASize, ADest);
|
||||
{$ENDIF}
|
||||
@ -886,10 +886,11 @@ var
|
||||
Result := (FWatchEvalList.Count > 0) and (FWatchEvalList[0] = Pointer(WatchValue));
|
||||
end;
|
||||
|
||||
function ResTypeName: String;
|
||||
function ResTypeName(v: TDbgSymbolValue = nil): String;
|
||||
begin
|
||||
if not((ResValue.TypeInfo<> nil) and
|
||||
GetTypeName(Result, ResValue.TypeInfo, []))
|
||||
if v = nil then v := ResValue;
|
||||
if not((v.TypeInfo<> nil) and
|
||||
GetTypeName(Result, v.TypeInfo, []))
|
||||
then
|
||||
Result := '';
|
||||
end;
|
||||
@ -898,7 +899,7 @@ var
|
||||
begin
|
||||
if not PrintPasValue(ResText, ResValue, ctx.SizeOfAddress, []) then
|
||||
exit;
|
||||
ResTypeInfo := TDBGType.Create(skSimple, ResTypeName); // TODO, IDE must learn pointer
|
||||
ResTypeInfo := TDBGType.Create(skPointer, ResTypeName);
|
||||
ResTypeInfo.Value.AsString := ResText;
|
||||
//ResTypeInfo.Value.AsPointer := ; // ???
|
||||
end;
|
||||
@ -927,6 +928,57 @@ var
|
||||
ResTypeInfo.Value.AsString := ResText;
|
||||
end;
|
||||
|
||||
procedure DoRecord;
|
||||
begin
|
||||
if not PrintPasValue(ResText, ResValue, ctx.SizeOfAddress, []) then
|
||||
exit;
|
||||
ResTypeInfo := TDBGType.Create(skRecord, ResTypeName);
|
||||
ResTypeInfo.Value.AsString := ResText;
|
||||
end;
|
||||
|
||||
procedure DoObject;
|
||||
begin
|
||||
if not PrintPasValue(ResText, ResValue, ctx.SizeOfAddress, []) then
|
||||
exit;
|
||||
ResTypeInfo := TDBGType.Create(skObject, ResTypeName);
|
||||
ResTypeInfo.Value.AsString := ResText;
|
||||
end;
|
||||
|
||||
procedure DoClass;
|
||||
var
|
||||
m: TDbgSymbolValue;
|
||||
s, s2, n: String;
|
||||
DBGType: TGDBType;
|
||||
f: TDBGField;
|
||||
i: Integer;
|
||||
begin
|
||||
if not PrintPasValue(ResText, ResValue, ctx.SizeOfAddress, []) then
|
||||
exit;
|
||||
ResTypeInfo := TDBGType.Create(skClass, ResTypeName);
|
||||
ResTypeInfo.Value.AsString := ResText;
|
||||
|
||||
if not(defFullTypeInfo in WatchValue.EvaluateFlags) then exit;
|
||||
s := ResTypeName;
|
||||
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));
|
||||
PrintPasValue(s2, m, ctx.SizeOfAddress, []);
|
||||
DBGType.Value.AsString := s2;
|
||||
n := '';
|
||||
if m.DbgSymbol <> nil then n := m.DbgSymbol.Name;
|
||||
// TODO visibility // flags virtual, constructor
|
||||
f := TDBGField.Create(n, DBGType, flPublic, [], s); //todo parent class,, instead of s
|
||||
ResTypeInfo.Fields.Add(f);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
if FNeedRegValues then begin
|
||||
FNeedRegValues := False;
|
||||
@ -979,9 +1031,9 @@ begin
|
||||
skEnum: DoEnum;
|
||||
skEnumValue: DoSimple;
|
||||
skSet: DoSet;
|
||||
skRecord: ;
|
||||
skObject: ;
|
||||
skClass: ;
|
||||
skRecord: DoRecord;
|
||||
skObject: DoObject;
|
||||
skClass: DoClass;
|
||||
skInterface: ;
|
||||
skArray: ;
|
||||
end;
|
||||
@ -1248,7 +1300,27 @@ var
|
||||
t: TCallStackEntryBase;
|
||||
s: TCallStackBase;
|
||||
f: TCallStackEntryBase;
|
||||
//Instr: TGDBMIDebuggerInstruction;
|
||||
begin
|
||||
(*
|
||||
Instr := TGDBMIDebuggerInstruction.Create(Format('-stack-list-frames %d %d', [AStackFrame, AStackFrame]), AThreadId, [], 0);
|
||||
Instr.AddReference;
|
||||
Instr.Cmd := TGDBMIDebuggerCommand.Create(Self);
|
||||
FTheDebugger.FInstructionQueue.RunInstruction(Instr);
|
||||
ok := Instr.IsSuccess and Instr.FHasResult;
|
||||
AResult := Instr.ResultData;
|
||||
Instr.Cmd.ReleaseReference;
|
||||
Instr.Cmd := nil;
|
||||
Instr.ReleaseReference;
|
||||
|
||||
if ok then begin
|
||||
List := TGDBMINameValueList.Create(R, ['stack']);
|
||||
Result := List.Values['frame'];
|
||||
List.Free;
|
||||
end;
|
||||
*)
|
||||
|
||||
|
||||
Result := 0;
|
||||
if (AThreadId <= 0) then begin
|
||||
GetCurrentContext(AThreadId, AStackFrame);
|
||||
|
Loading…
Reference in New Issue
Block a user