FPGDBMIDebugger: structured values

git-svn-id: trunk@44121 -
This commit is contained in:
martin 2014-02-17 23:51:55 +00:00
parent c789f1367f
commit a503dc1f3c
5 changed files with 176 additions and 24 deletions

View File

@ -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
//

View File

@ -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;

View File

@ -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)

View File

@ -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;

View File

@ -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);