paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 20:59:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

FPDebug: more reading type info

Browse Source 
git-svn-id: trunk@43179 -
This commit is contained in:
martin 2013-10-08 18:33:34 +00:00
parent 7c7a6705e6
commit 786941f5aa
4 changed files with 391 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

269
components/fpdebug/fpdbgdwarf.pas
View File

@ -253,6 +253,7 @@ type
FAbbrevData: PDwarfAbbrevEntry; FAbbrevData: PDwarfAbbrevEntry;
FFlags: set of (dieAbbrevValid); FFlags: set of (dieAbbrevValid);
function GetAbbrev: TDwarfAbbrev;
procedure ScopeChanged; inline; procedure ScopeChanged; inline;
function SearchScope: Boolean; function SearchScope: Boolean;
function PrepareAbbrev: Boolean; inline; function PrepareAbbrev: Boolean; inline;
@ -265,8 +266,8 @@ type
constructor Create(ACompUnit: TDwarfCompilationUnit; AScope: TDwarfScopeInfo); constructor Create(ACompUnit: TDwarfCompilationUnit; AScope: TDwarfScopeInfo);
property CompUnit: TDwarfCompilationUnit read FCompUnit; property CompUnit: TDwarfCompilationUnit read FCompUnit;
property Abbrev: TDwarfAbbrev read FAbbrev write SetAbbrev; property Abbrev: TDwarfAbbrev read GetAbbrev write SetAbbrev;
property AbbrevData: PDwarfAbbrevEntry read FAbbrevData; property AbbrevData: PDwarfAbbrevEntry read FAbbrevData; // only valid if Abbrev is available
function HasAttrib(AnAttrib: Cardinal): boolean; function HasAttrib(AnAttrib: Cardinal): boolean;
function AttribIdx(AnAttrib: Cardinal; out AInfoPointer: pointer): Integer; function AttribIdx(AnAttrib: Cardinal; out AInfoPointer: pointer): Integer;
@ -492,8 +493,10 @@ type
procedure Decode; procedure Decode;
end; end;
TDbgDwarfIdentifier = class;
TDbgDwarfTypeIdentifier = class; TDbgDwarfTypeIdentifier = class;
TDbgDwarfIdentifierClass = class of TDbgDwarfIdentifier;
TDbgDwarfTypeIdentifierClass = class of TDbgDwarfTypeIdentifier;
{ TDbgDwarfIdentifier } { TDbgDwarfIdentifier }
TDbgDwarfIdentifier = class(TDbgSymbol) TDbgDwarfIdentifier = class(TDbgSymbol)
@ -517,15 +520,20 @@ type
//function GetSize: Integer; override; //function GetSize: Integer; override;
property TypeInfo: TDbgDwarfTypeIdentifier read GetTypeInfo; property TypeInfo: TDbgDwarfTypeIdentifier read GetTypeInfo;
property InformationEntry: TDwarfInformationEntry read FInformationEntry; property InformationEntry: TDwarfInformationEntry read FInformationEntry;
class function GetSubClass(ATag: Cardinal): TDbgDwarfIdentifierClass;
public public
class function CreateSubClass(AName: String; AnInformationEntry: TDwarfInformationEntry): TDbgDwarfIdentifier;
constructor Create(AName: String; AnInformationEntry: TDwarfInformationEntry); virtual; constructor Create(AName: String; AnInformationEntry: TDwarfInformationEntry); virtual;
constructor Create(AName: String; AnInformationEntry: TDwarfInformationEntry;
AKind: TDbgSymbolKind; AAddress: TDbgPtr);
destructor Destroy; override; destructor Destroy; override;
//constructor Create(AName: String; AAddress: TDbgPtr; ACompilationUnit: TDwarfCompilationUnit; //constructor Create(AName: String; AAddress: TDbgPtr; ACompilationUnit: TDwarfCompilationUnit;
// AScope: TDwarfScopeInfo); // AScope: TDwarfScopeInfo);
//destructor Destroy; override; //destructor Destroy; override;
property IdentifierName: String read GetIdentifierName; property IdentifierName: String read GetIdentifierName;
end; end;
TDbgDwarfIdentifierClass = class of TDbgDwarfIdentifier;
{ TDbgDwarfValueIdentifier }
TDbgDwarfValueIdentifier = class(TDbgDwarfIdentifier) // var, const, member, ... TDbgDwarfValueIdentifier = class(TDbgDwarfIdentifier) // var, const, member, ...
public public
@ -535,36 +543,95 @@ type
{ TDbgDwarfTypeIdentifier } { TDbgDwarfTypeIdentifier }
(* Types and allowed tags in dwarf 2 (* Types and allowed tags in dwarf 2
DW_TAG_typedef
| DW_TAG_base_type DW_TAG_enumeration_type, DW_TAG_subroutine_type, DW_TAG_union_type,
DECL Y DW_TAG_ptr_to_member_type, DW_TAG_set_type, DW_TAG_subrange_type, DW_TAG_file_type,
DW_AT_abstract_origin Y DW_TAG_thrown_type
DW_AT_accessibility Y
DW_AT_bit_offset Y DW_TAG_base_type
DW_AT_bit_size Y | DW_TAG_typedef
DW_AT_byte_size Y | | DW_TAG_string_type
DW_AT_declaration Y | | | DW_TAG_array_type
DW_AT_encoding Y | | | | DW_TAG_class_type
DW_AT_name Y Y | | | | | DW_TAG_structure_type
DW_AT_sibling Y Y DW_AT_encoding Y : :
DW_AT_start_scope Y DW_AT_bit_offset Y : :
DW_AT_type Y DW_AT_bit_size Y : :
DW_AT_visibility Y DW_AT_byte_size Y Y Y Y Y
DW_AT_name Y Y Y Y Y Y
DW_AT_sibling Y Y Y Y Y Y
DECL Y Y Y Y Y
DW_AT_abstract_origin Y Y Y Y Y
DW_AT_accessibility Y Y Y Y Y
DW_AT_declaration Y Y Y Y Y
DW_AT_start_scope Y Y Y Y Y
DW_AT_visibility Y Y Y Y Y
DW_AT_type Y Y
DW_AT_ordering Y
DW_AT_segment Y
DW_AT_stride_size Y
DW_AT_string_length Y
DW_TAG_pointer_type
| DW_TAG_reference_type
| | DW_TAG_packed_type
| | | DW_TAG_const_type
| | | | DW_TAG_volatile_type
DW_AT_address_class Y Y
DW_AT_sibling Y Y Y Y Y
DW_AT_type Y Y Y Y Y
DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
*) *)
TDbgDwarfTypeIdentifier = class(TDbgDwarfIdentifier) TDbgDwarfTypeIdentifier = class(TDbgDwarfIdentifier)
private protected
function GetIsBaseType: Boolean; virtual;
function GetIsPointerType: Boolean; virtual;
function GetPointedToType: TDbgDwarfTypeIdentifier; virtual;
public public
class function CreateTybeSubClass(AName: String; AnInformationEntry: TDwarfInformationEntry): TDbgDwarfTypeIdentifier;
property TypeInfo; property TypeInfo;
property IsBaseType: Boolean read GetIsBaseType;
property IsPointerType: Boolean read GetIsPointerType;
property PointedToType: TDbgDwarfTypeIdentifier read GetPointedToType;
end;
{ TDbgDwarfBaseTypeIdentifier }
TDbgDwarfBaseIdentifierBase = class(TDbgDwarfTypeIdentifier)
protected
function GetIsBaseType: Boolean; override;
end;
{ TDbgDwarfTypeIdentifierModifier }
TDbgDwarfTypeIdentifierModifier = class(TDbgDwarfTypeIdentifier)
protected
function GetIsBaseType: Boolean; override;
function GetIsPointerType: Boolean; override;
function GetPointedToType: TDbgDwarfTypeIdentifier; override;
end;
{ TDbgDwarfTypeIdentifierDeclaration }
TDbgDwarfTypeIdentifierDeclaration = class(TDbgDwarfTypeIdentifierModifier)
protected
end;
{ TDbgDwarfTypeIdentifierPointer }
TDbgDwarfTypeIdentifierPointer = class(TDbgDwarfTypeIdentifier)
protected
function GetIsPointerType: Boolean; override;
function GetPointedToType: TDbgDwarfTypeIdentifier; override;
end; end;
{ TDbgDwarfProcSymbol } { TDbgDwarfProcSymbol }
TDbgDwarfProcSymbol = class(TDbgSymbol) TDbgDwarfProcSymbol = class(TDbgDwarfIdentifier)
private private
FCU: TDwarfCompilationUnit; //FCU: TDwarfCompilationUnit;
FAddress: TDbgPtr; FAddress: TDbgPtr;
FAddressInfo: PDwarfAddressInfo; FAddressInfo: PDwarfAddressInfo;
FStateMachine: TDwarfLineInfoStateMachine; FStateMachine: TDwarfLineInfoStateMachine;
@ -580,7 +647,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
// function GetReference: TDbgSymbol; override; // function GetReference: TDbgSymbol; override;
function GetSize: Integer; override; function GetSize: Integer; override;
public public
constructor Create(ACompilationUnit: TDwarfCompilationUnit; AInfo: PDwarfAddressInfo; AAddress: TDbgPtr); constructor Create(ACompilationUnit: TDwarfCompilationUnit; AInfo: PDwarfAddressInfo; AAddress: TDbgPtr); overload;
destructor Destroy; override; destructor Destroy; override;
end; end;
@ -1090,6 +1157,86 @@ begin
end; end;
end; end;
{ TDbgDwarfTypeIdentifierModifier }
function TDbgDwarfTypeIdentifierModifier.GetIsBaseType: Boolean;
var
ti: TDbgDwarfTypeIdentifier;
begin
ti := TypeInfo;
if ti <> nil
then Result := ti.IsBaseType
else Result := False;
end;
function TDbgDwarfTypeIdentifierModifier.GetIsPointerType: Boolean;
var
ti: TDbgDwarfTypeIdentifier;
begin
ti := TypeInfo;
if ti <> nil
then Result := ti.IsPointerType
else Result := False;
end;
function TDbgDwarfTypeIdentifierModifier.GetPointedToType: TDbgDwarfTypeIdentifier;
begin
Result := TypeInfo;
if Result <> nil then
Result := Result.PointedToType;
end;
{ TDbgDwarfTypeIdentifierPointer }
function TDbgDwarfTypeIdentifierPointer.GetIsPointerType: Boolean;
begin
Result := True;
end;
function TDbgDwarfTypeIdentifierPointer.GetPointedToType: TDbgDwarfTypeIdentifier;
begin
Result := TypeInfo;
end;
{ TDbgDwarfBaseTypeIdentifier }
function TDbgDwarfBaseIdentifierBase.GetIsBaseType: Boolean;
begin
Result := True;
end;
{ TDbgDwarfTypeIdentifier }
function TDbgDwarfTypeIdentifier.GetPointedToType: TDbgDwarfTypeIdentifier;
begin
Result := nil;
end;
function TDbgDwarfTypeIdentifier.GetIsBaseType: Boolean;
begin
Result := False;
end;
function TDbgDwarfTypeIdentifier.GetIsPointerType: Boolean;
begin
Result := False;
end;
class function TDbgDwarfTypeIdentifier.CreateTybeSubClass(AName: String;
AnInformationEntry: TDwarfInformationEntry): TDbgDwarfTypeIdentifier;
var
c: TDbgDwarfIdentifierClass;
begin
c := GetSubClass(AnInformationEntry.Abbrev.tag);
if c.InheritsFrom(TDbgDwarfTypeIdentifier) then
Result := TDbgDwarfTypeIdentifierClass(c).Create(AName, AnInformationEntry, skNone, 0)
else
Result := nil;
end;
{ TDbgDwarfValueIdentifier }
{ TDbgDwarfTypeIdentifier } { TDbgDwarfTypeIdentifier }
{ TDwarfInformationEntry } { TDwarfInformationEntry }
@ -1108,6 +1255,12 @@ begin
FInformationData := nil; FInformationData := nil;
end; end;
function TDwarfInformationEntry.GetAbbrev: TDwarfAbbrev;
begin
PrepareAbbrev;
Result := FAbbrev;
end;
function TDwarfInformationEntry.SearchScope: Boolean; function TDwarfInformationEntry.SearchScope: Boolean;
var var
l, h, m: Integer; l, h, m: Integer;
@ -1361,14 +1514,51 @@ begin
InfoEntry.SearchScope; InfoEntry.SearchScope;
//DebugLn(['!!!! TYPE !!! ', dbgs(InfoEntry.FScope, FwdCompUint), DbgsDump(InfoEntry.FScope, FwdCompUint) ]); //DebugLn(['!!!! TYPE !!! ', dbgs(InfoEntry.FScope, FwdCompUint), DbgsDump(InfoEntry.FScope, FwdCompUint) ]);
DebugLn(['!!!! TYPE !!! ', dbgs(InfoEntry.FScope, FwdCompUint) ]); DebugLn(['!!!! TYPE !!! ', dbgs(InfoEntry.FScope, FwdCompUint) ]);
FTypeInfo := TDbgDwarfTypeIdentifier.Create('', InfoEntry); FTypeInfo := TDbgDwarfTypeIdentifier.CreateTybeSubClass('', InfoEntry);
InfoEntry.ReleaseReference; ReleaseRefAndNil(InfoEntry);
Result := FTypeInfo; Result := FTypeInfo;
end; end;
end; end;
class function TDbgDwarfIdentifier.GetSubClass(ATag: Cardinal): TDbgDwarfIdentifierClass;
begin
case ATag of
DW_TAG_variable, DW_TAG_formal_parameter, DW_TAG_constant, DW_TAG_member:
Result := TDbgDwarfValueIdentifier;
DW_TAG_base_type: Result := TDbgDwarfBaseIdentifierBase;
DW_TAG_typedef: Result := TDbgDwarfTypeIdentifierDeclaration;
DW_TAG_pointer_type: Result := TDbgDwarfTypeIdentifierPointer;
DW_TAG_packed_type,
DW_TAG_const_type,
DW_TAG_volatile_type: Result := TDbgDwarfTypeIdentifierModifier;
DW_TAG_reference_type,
DW_TAG_string_type, DW_TAG_array_type, DW_TAG_class_type,
DW_TAG_structure_type,
DW_TAG_enumeration_type, DW_TAG_subroutine_type, DW_TAG_union_type,
DW_TAG_ptr_to_member_type, DW_TAG_set_type, DW_TAG_subrange_type, DW_TAG_file_type,
DW_TAG_thrown_type:
Result := TDbgDwarfTypeIdentifier;
else
Result := TDbgDwarfIdentifier;
end;
end;
class function TDbgDwarfIdentifier.CreateSubClass(AName: String;
AnInformationEntry: TDwarfInformationEntry): TDbgDwarfIdentifier;
begin
Result := GetSubClass(AnInformationEntry.Abbrev.tag).Create(AName, AnInformationEntry, skNone, 0);
end;
constructor TDbgDwarfIdentifier.Create(AName: String; constructor TDbgDwarfIdentifier.Create(AName: String;
AnInformationEntry: TDwarfInformationEntry); AnInformationEntry: TDwarfInformationEntry);
begin
Create(AName, AnInformationEntry, skNone, 0);
end;
constructor TDbgDwarfIdentifier.Create(AName: String;
AnInformationEntry: TDwarfInformationEntry; AKind: TDbgSymbolKind; AAddress: TDbgPtr);
begin begin
if AName = '' then if AName = '' then
AnInformationEntry.ReadValue(DW_AT_name, AName); AnInformationEntry.ReadValue(DW_AT_name, AName);
@ -1377,7 +1567,8 @@ begin
FCU := AnInformationEntry.CompUnit; FCU := AnInformationEntry.CompUnit;
FInformationEntry := AnInformationEntry; FInformationEntry := AnInformationEntry;
FInformationEntry.AddReference; FInformationEntry.AddReference;
inherited Create('', skNone, 0);
inherited Create(AName, AKind, AAddress);
end; end;
destructor TDbgDwarfIdentifier.Destroy; destructor TDbgDwarfIdentifier.Destroy;
@ -2162,18 +2353,25 @@ end;
{ TDbgDwarfSymbol } { TDbgDwarfSymbol }
constructor TDbgDwarfProcSymbol.Create(ACompilationUnit: TDwarfCompilationUnit; AInfo: PDwarfAddressInfo; AAddress: TDbgPtr); constructor TDbgDwarfProcSymbol.Create(ACompilationUnit: TDwarfCompilationUnit; AInfo: PDwarfAddressInfo; AAddress: TDbgPtr);
var
InfoEntry: TDwarfInformationEntry;
begin begin
FAddress := AAddress; FAddress := AAddress;
FAddressInfo := AInfo; FAddressInfo := AInfo;
FCU := ACompilationUnit; FCU := ACompilationUnit;
InfoEntry := TDwarfInformationEntry.Create(FCU, nil);
InfoEntry.ScopeIndex := AInfo^.ScopeIndex;
inherited Create( inherited Create(
String(FAddressInfo^.Name), String(FAddressInfo^.Name),
InfoEntry,
skProcedure, //todo: skFunction skProcedure, //todo: skFunction
FAddressInfo^.StartPC FAddressInfo^.StartPC
); );
InfoEntry.ReleaseReference;
//BuildLineInfo( //BuildLineInfo(
// AFile: String = ''; ALine: Integer = -1; AFlags: TDbgSymbolFlags = []; const AReference: TDbgSymbol = nil); // AFile: String = ''; ALine: Integer = -1; AFlags: TDbgSymbolFlags = []; const AReference: TDbgSymbol = nil);
@ -2360,19 +2558,6 @@ begin
end; end;
function TDbgDwarf.FindIdentifier(AAddress: TDbgPtr; AName: String): TDbgSymbol; function TDbgDwarf.FindIdentifier(AAddress: TDbgPtr; AName: String): TDbgSymbol;
function DbgSymbolClassForTag(ATag: Cardinal): TDbgDwarfIdentifierClass;
begin
case ATag of
DW_TAG_variable, DW_TAG_formal_parameter, DW_TAG_constant, DW_TAG_member:
Result := TDbgDwarfValueIdentifier;
DW_TAG_typedef:
Result := TDbgDwarfTypeIdentifier;
else
Result := TDbgDwarfIdentifier;
end;
end;
var var
SubRoutine: TDbgDwarfProcSymbol; // TDbgSymbol; SubRoutine: TDbgDwarfProcSymbol; // TDbgSymbol;
CU: TDwarfCompilationUnit; CU: TDwarfCompilationUnit;
@ -2410,9 +2595,9 @@ begin
if UpperCase(EntryName) = UpperCase(AName) then begin if UpperCase(EntryName) = UpperCase(AName) then begin
// TODO: check DW_AT_start_scope; // TODO: check DW_AT_start_scope;
Result := DbgSymbolClassForTag(InfoEntry.Abbrev.tag).Create(AName, InfoEntry); Result := TDbgDwarfIdentifier.CreateSubClass(AName, InfoEntry);
//DebugLn(['!!!! FOUND !!! ', dbgs(InfoEntry.FScope, CU), DbgsDump(InfoEntry.FScope, CU) ]); //DebugLn(['!!!! FOUND !!! ', dbgs(InfoEntry.FScope, CU), DbgsDump(InfoEntry.FScope, CU) ]);
DebugLn(['!!!! FOUND !!! ', dbgs(InfoEntry.FScope, CU)]); DebugLn(['!!!! FOUND !!! ', dbgs(InfoEntry.FScope, CU), DbgSName(Result)]);
break; break;
end; end;

197
debugger/fpgdbmidebugger.pp
View File

@ -11,6 +11,20 @@ uses
type type
TFpGDBMIDebugger = class;
{ TFpGDBPTypeRequestCache }
TFpGDBPTypeRequestCache = class(TGDBPTypeRequestCache)
private
FDebugger: TFpGDBMIDebugger;
FInIndexOf: Boolean;
public
constructor Create(ADebugger: TFpGDBMIDebugger);
function IndexOf(AThreadId, AStackFrame: Integer; ARequest: TGDBPTypeRequest): Integer; override;
property Debugger: TFpGDBMIDebugger read FDebugger;
end;
{ TFpGDBMIDebugger } { TFpGDBMIDebugger }
TFpGDBMIDebugger = class(TGDBMIDebugger) TFpGDBMIDebugger = class(TGDBMIDebugger)
@ -30,6 +44,7 @@ type
procedure GetCurrentContext(out AThreadId, AStackFrame: Integer); procedure GetCurrentContext(out AThreadId, AStackFrame: Integer);
function GetLocationForContext(AThreadId, AStackFrame: Integer): TDBGPtr; function GetLocationForContext(AThreadId, AStackFrame: Integer): TDBGPtr;
procedure AddToGDBMICache(AThreadId, AStackFrame: Integer; AnIdent: TDbgSymbol); procedure AddToGDBMICache(AThreadId, AStackFrame: Integer; AnIdent: TDbgSymbol);
function CreateTypeRequestCache: TGDBPTypeRequestCache; override;
public public
class function Caption: String; override; class function Caption: String; override;
public public
@ -53,6 +68,7 @@ type
TFPGDBMIWatches = class(TGDBMIWatches) TFPGDBMIWatches = class(TGDBMIWatches)
private private
protected protected
function FpDebugger: TFpGDBMIDebugger;
//procedure DoStateChange(const AOldState: TDBGState); override; //procedure DoStateChange(const AOldState: TDBGState); override;
procedure InternalRequestData(AWatchValue: TCurrentWatchValue); override; procedure InternalRequestData(AWatchValue: TCurrentWatchValue); override;
public public
@ -80,14 +96,77 @@ type
procedure Cancel(const ASource: String); override; procedure Cancel(const ASource: String); override;
end; end;
{ TFpGDBPTypeRequestCache }
constructor TFpGDBPTypeRequestCache.Create(ADebugger: TFpGDBMIDebugger);
begin
FDebugger := ADebugger;
FInIndexOf := False;
inherited Create;
end;
function TFpGDBPTypeRequestCache.IndexOf(AThreadId, AStackFrame: Integer;
ARequest: TGDBPTypeRequest): Integer;
var
IdentName: String;
Loc: TDBGPtr;
Ident: TDbgSymbol;
begin
Result := inherited IndexOf(AThreadId, AStackFrame, ARequest);
if (Result > 0) or FInIndexOf then
exit;
FInIndexOf := True;
try
if FDebugger.HasDwarf and (ARequest.ReqType = gcrtPType) then begin
if copy(ARequest.Request, 1, 6) = 'ptype ' then
IdentName := trim(copy(ARequest.Request, 7, length(ARequest.Request)))
else
if copy(ARequest.Request, 1, 7) = 'whatis ' then
IdentName := trim(copy(ARequest.Request, 8, length(ARequest.Request)));
if IdentName <> '' then begin
Loc := FDebugger.GetLocationForContext(AThreadId, AStackFrame);
if (Loc <> 0) then begin
Ident := FDebugger.FDwarfInfo.FindIdentifier(Loc, IdentName);
if Ident <> nil then begin
FDebugger.AddToGDBMICache(AThreadId, AStackFrame, Ident);
Result := inherited IndexOf(AThreadId, AStackFrame, ARequest);
end;
ReleaseRefAndNil(Ident);
end;
end;
end;
finally
FInIndexOf := False;
end;
end;
{ TFPGDBMIWatches } { TFPGDBMIWatches }
function TFPGDBMIWatches.FpDebugger: TFpGDBMIDebugger;
begin
Result := TFpGDBMIDebugger(Debugger);
end;
procedure TFPGDBMIWatches.InternalRequestData(AWatchValue: TCurrentWatchValue); procedure TFPGDBMIWatches.InternalRequestData(AWatchValue: TCurrentWatchValue);
var var
Loc: TDBGPtr; Loc: TDBGPtr;
Ident: TDbgSymbol;
begin begin
Loc := TFpGDBMIDebugger(Debugger).GetLocationForContext(AWatchValue.ThreadId, AWatchValue.StackFrame); //if FpDebugger.HasDwarf then begin
// Loc := FpDebugger.GetLocationForContext(AWatchValue.ThreadId, AWatchValue.StackFrame);
//
// if (Loc <> 0) then begin
// Ident := FpDebugger.FDwarfInfo.FindIdentifier(Loc, AWatchValue.Watch.Expression);
//
// if Ident <> nil then
// FpDebugger.AddToGDBMICache(AWatchValue.ThreadId, AWatchValue.StackFrame, Ident);
//
// ReleaseRefAndNil(Ident);
// end;
//end;
inherited InternalRequestData(AWatchValue); inherited InternalRequestData(AWatchValue);
end; end;
@ -217,24 +296,24 @@ var
CurThread, CurStack: Integer; CurThread, CurStack: Integer;
begin begin
if HasDwarf and (ACommand = dcEvaluate) then begin if HasDwarf and (ACommand = dcEvaluate) then begin
GetCurrentContext(CurThread, CurStack); //GetCurrentContext(CurThread, CurStack);
Loc := GetLocationForContext(-1, -1); //Loc := GetLocationForContext(CurThread, CurStack);
//
//if (Loc <> 0) then begin
// Ident := FDwarfInfo.FindIdentifier(Loc, String(AParams[0].VAnsiString));
//
// if Ident <> nil then
// AddToGDBMICache(CurThread, CurStack, Ident);
//
// ReleaseRefAndNil(Ident);
//end;
if (Loc <> 0) then begin // //EvalFlags := [];
Ident := FDwarfInfo.FindIdentifier(Loc, String(AParams[0].VAnsiString)); // //if high(AParams) >= 3 then
// // EvalFlags := TDBGEvaluateFlags(AParams[3].VInteger);
if Ident <> nil then // //Result := GDBEvaluate(String(AParams[0].VAnsiString),
AddToGDBMICache(CurThread, CurStack, Ident); // // String(AParams[1].VPointer^), TGDBType(AParams[2].VPointer^),
// // EvalFlags);
ReleaseRefAndNil(Ident);
end;
//EvalFlags := [];
//if high(AParams) >= 3 then
// EvalFlags := TDBGEvaluateFlags(AParams[3].VInteger);
//Result := GDBEvaluate(String(AParams[0].VAnsiString),
// String(AParams[1].VPointer^), TGDBType(AParams[2].VPointer^),
// EvalFlags);
Result := inherited RequestCommand(ACommand, AParams); Result := inherited RequestCommand(ACommand, AParams);
end end
else else
@ -315,10 +394,25 @@ procedure TFpGDBMIDebugger.AddToGDBMICache(AThreadId, AStackFrame: Integer;
const const
GdbCmdPType = 'ptype '; GdbCmdPType = 'ptype ';
GdbCmdWhatIs = 'whatis '; GdbCmdWhatIs = 'whatis ';
procedure MaybeAdd(AType: TGDBCommandRequestType; AQuery, AAnswer: String);
var
AReq: TGDBPTypeRequest;
begin
AReq.ReqType := AType;
AReq.Request := AQuery;
if TypeRequestCache.IndexOf(AThreadId, AStackFrame, AReq) < 0 then begin
AReq.Result := ParseTypeFromGdb(AAnswer);
TypeRequestCache.Add(AThreadId, AStackFrame, AReq);
debugln(['TFpGDBMIDebugger.AddToGDBMICache ', AReq.Request, ' T:', AThreadId, ' S:',AStackFrame, ' >> ', AAnswer]);
end;
end;
var var
TypeIdent: TDbgDwarfTypeIdentifier; TypeIdent: TDbgDwarfTypeIdentifier;
VarName, TypeName: String; VarName, TypeName: String;
AReq: TGDBPTypeRequest; AReq: TGDBPTypeRequest;
IsPointer: Boolean;
begin begin
(* Simulate gdb answers *) (* Simulate gdb answers *)
//TypeRequestCache //TypeRequestCache
@ -328,48 +422,49 @@ begin
TypeIdent := TDbgDwarfValueIdentifier(AnIdent).TypeInfo; TypeIdent := TDbgDwarfValueIdentifier(AnIdent).TypeInfo;
if TypeIdent = nil then exit; if TypeIdent = nil then exit;
TypeName := TypeIdent.IdentifierName; TypeName := TypeIdent.IdentifierName;
IsPointer := TypeIdent.IsPointerType;
while (TypeIdent <> nil) and TypeIdent.IsPointerType do
TypeIdent := TypeIdent.PointedToType;
if TypeIdent = nil then exit;
if TGDBMIDwarfTypeIdentifier(TypeIdent).InformationEntry.Abbrev.tag = DW_TAG_typedef
then
TypeIdent := TDbgDwarfValueIdentifier(TypeIdent).TypeInfo;
if TGDBMIDwarfTypeIdentifier(TypeIdent).InformationEntry.Abbrev.tag = DW_TAG_base_type if TGDBMIDwarfTypeIdentifier(TypeIdent).IsBaseType then begin
then begin if IsPointer then begin
AReq.ReqType := gcrtPType; MaybeAdd(gcrtPType, GdbCmdPType + VarName, Format('type = ^%s', [TypeName]));
AReq.Request := GdbCmdPType + VarName; MaybeAdd(gcrtPType, GdbCmdWhatIs + VarName, Format('type = ^%s', [TypeName]));
if TypeRequestCache.IndexOf(AThreadId, AStackFrame, AReq) < 0 then begin MaybeAdd(gcrtPType, GdbCmdPType + GDBMIMaybeApplyBracketsToExpr(VarName) + '^',
AReq.Result := ParseTypeFromGdb(Format('type = %s', [TypeName])); Format('type = %s', [TypeName]));
TypeRequestCache.Add(AThreadId, AStackFrame, AReq) MaybeAdd(gcrtPType, GdbCmdWhatIs + GDBMIMaybeApplyBracketsToExpr(VarName) + '^',
end; Format('type = %s', [TypeName]));
end
AReq.ReqType := gcrtPType; else begin
AReq.Request := GdbCmdWhatIs + VarName; MaybeAdd(gcrtPType, GdbCmdPType + VarName, Format('type = %s', [TypeName]));
if TypeRequestCache.IndexOf(AThreadId, AStackFrame, AReq) < 0 then begin MaybeAdd(gcrtPType, GdbCmdWhatIs + VarName, Format('type = %s', [TypeName]));
AReq.Result := ParseTypeFromGdb(Format('type = %s', [TypeName]));
TypeRequestCache.Add(AThreadId, AStackFrame, AReq)
end; end;
end; end;
end; end;
(* (*
ptype i
~"type = LONGINT\n"
whatis i
~"type = LONGINT\n"
>> TCmdLineDebugger.SendCmdLn "ptype i"
<< TCmdLineDebugger.ReadLn "&"ptype i\n""
<< TCmdLineDebugger.ReadLn "~"type = LONGINT\n""
<< TCmdLineDebugger.ReadLn "^done"
<< TCmdLineDebugger.ReadLn "(gdb) "
>> TCmdLineDebugger.SendCmdLn "whatis i"
<< TCmdLineDebugger.ReadLn "&"whatis i\n""
<< TCmdLineDebugger.ReadLn "~"type = LONGINT\n""
<< TCmdLineDebugger.ReadLn "^done"
<< TCmdLineDebugger.ReadLn "(gdb) "
>> TCmdLineDebugger.SendCmdLn "-data-evaluate-expression i"
<< TCmdLineDebugger.ReadLn "^done,value="0""
<< TCmdLineDebugger.ReadLn "(gdb) "
ptype @i
~"type = ^LONGINT\n"
ptype (@i)^
~"type = LONGINT\n"
whatis @i
~"type = ^LONGINT\n"
*) *)
end;
function TFpGDBMIDebugger.CreateTypeRequestCache: TGDBPTypeRequestCache;
begin
Result := TFpGDBPTypeRequestCache.Create(Self);
end; end;
function TFpGDBMIDebugger.CreateCommandStartDebugging(AContinueCommand: TGDBMIDebuggerCommand): TGDBMIDebuggerCommandStartDebugging; function TFpGDBMIDebugger.CreateCommandStartDebugging(AContinueCommand: TGDBMIDebuggerCommand): TGDBMIDebuggerCommandStartDebugging;

14
debugger/gdbmidebugger.pp
View File

@ -40,8 +40,8 @@ interface
uses uses
Classes, SysUtils, strutils, Controls, Math, Variants, LCLProc, LazClasses, LazLoggerBase, Classes, SysUtils, strutils, Controls, Math, Variants, LCLProc, LazClasses, LazLoggerBase,
Dialogs, DebugUtils, Debugger, FileUtil, BaseIDEIntf, CmdLineDebugger, GDBTypeInfo, Maps, Dialogs, DebugUtils, Debugger, FileUtil, LazLoggerProfiling, BaseIDEIntf, CmdLineDebugger,
GDBMIDebugInstructions, LCLIntf, Forms, GDBTypeInfo, Maps, GDBMIDebugInstructions, LCLIntf, Forms,
{$IFdef MSWindows} {$IFdef MSWindows}
Windows, Windows,
{$ENDIF} {$ENDIF}
@ -779,6 +779,7 @@ type
property CurrentStackFrameValid: Boolean read FCurrentStackFrameValid; property CurrentStackFrameValid: Boolean read FCurrentStackFrameValid;
property CurrentThreadIdValid: Boolean read FCurrentThreadIdValid; property CurrentThreadIdValid: Boolean read FCurrentThreadIdValid;
function CreateTypeRequestCache: TGDBPTypeRequestCache; virtual;
property TypeRequestCache: TGDBPTypeRequestCache read FTypeRequestCache; property TypeRequestCache: TGDBPTypeRequestCache read FTypeRequestCache;
public public
class function CreateProperties: TDebuggerProperties; override; // Creates debuggerproperties class function CreateProperties: TDebuggerProperties; override; // Creates debuggerproperties
@ -5524,7 +5525,7 @@ function TGDBMIDebuggerCommandExecute.ProcessStopped(const AParams: String;
finally finally
FTheDebugger.QueueExecuteUnlock; FTheDebugger.QueueExecuteUnlock;
end; end;
// Before anything else goes => correct the thred // Before anything else goes => correct the thread
if fixed if fixed
then F := ''; then F := '';
{$ENDIF} {$ENDIF}
@ -7048,7 +7049,7 @@ begin
FCommandQueueExecLock := 0; FCommandQueueExecLock := 0;
FRunQueueOnUnlock := False; FRunQueueOnUnlock := False;
FThreadGroups := TStringList.Create; FThreadGroups := TStringList.Create;
FTypeRequestCache := TGDBPTypeRequestCache.Create; FTypeRequestCache := CreateTypeRequestCache;
FMaxLineForUnitCache := TStringList.Create; FMaxLineForUnitCache := TStringList.Create;
FInProcessStopped := False; FInProcessStopped := False;
FNeedStateToIdle := False; FNeedStateToIdle := False;
@ -7372,6 +7373,11 @@ begin
List.Free; List.Free;
end; end;
function TGDBMIDebugger.CreateTypeRequestCache: TGDBPTypeRequestCache;
begin
Result := TGDBPTypeRequestCache.Create;
end;
procedure TGDBMIDebugger.DoNotifyAsync(Line: String); procedure TGDBMIDebugger.DoNotifyAsync(Line: String);
var var
EventText: String; EventText: String;

15
debugger/gdbtypeinfo.pp
View File

@ -298,7 +298,7 @@ type
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
procedure Clear; procedure Clear;
function IndexOf(AThreadId, AStackFrame: Integer; ARequest: TGDBPTypeRequest): Integer; function IndexOf(AThreadId, AStackFrame: Integer; ARequest: TGDBPTypeRequest): Integer; virtual;
procedure Add(AThreadId, AStackFrame: Integer; ARequest: TGDBPTypeRequest); procedure Add(AThreadId, AStackFrame: Integer; ARequest: TGDBPTypeRequest);
property Request[Index: Integer]: TGDBPTypeRequest read GetRequest; property Request[Index: Integer]: TGDBPTypeRequest read GetRequest;
end; end;
@ -417,6 +417,7 @@ type
function CreatePTypeValueList(AResultValues: String): TStringList; function CreatePTypeValueList(AResultValues: String): TStringList;
function ParseTypeFromGdb(const ATypeText: string): TGDBPTypeResult; function ParseTypeFromGdb(const ATypeText: string): TGDBPTypeResult;
function GDBMIMaybeApplyBracketsToExpr(e: string): string;
function dbgs(AFlag: TGDBPTypeResultFlag): string; overload; function dbgs(AFlag: TGDBPTypeResultFlag): string; overload;
function dbgs(AFlags: TGDBPTypeResultFlags): string; overload; function dbgs(AFlags: TGDBPTypeResultFlags): string; overload;
@ -438,7 +439,7 @@ const
var var
DBGMI_TYPE_INFO, DBG_WARNINGS: PLazLoggerLogGroup; DBGMI_TYPE_INFO, DBG_WARNINGS: PLazLoggerLogGroup;
function ApplyBrackets(e: string): string; function GDBMIMaybeApplyBracketsToExpr(e: string): string;
var var
i: Integer; i: Integer;
f: Boolean; f: Boolean;
@ -1331,7 +1332,7 @@ begin
(* ptype ArrayBaseWithoutIndex^ *) (* ptype ArrayBaseWithoutIndex^ *)
// FPC 2.2.4 encoded "var param" in a special way, and we need an extra deref) // FPC 2.2.4 encoded "var param" in a special way, and we need an extra deref)
IdxPart.VarParam := True; IdxPart.VarParam := True;
IdxPart.InitReq(AReqPtr, GdbCmdPType + ApplyBrackets(GetTextToIdx(i-1, [toSkipArrayIdx])) + '^'); IdxPart.InitReq(AReqPtr, GdbCmdPType + GDBMIMaybeApplyBracketsToExpr(GetTextToIdx(i-1, [toSkipArrayIdx])) + '^');
Result := True; Result := True;
exit; exit;
end; end;
@ -1346,8 +1347,8 @@ begin
then begin then begin
(* ptype ArrayBaseWithoutIndex^ or ptype ArrayBaseWithoutIndex^^ *) (* ptype ArrayBaseWithoutIndex^ or ptype ArrayBaseWithoutIndex^^ *)
if IdxPart.VarParam if IdxPart.VarParam
then IdxPart.InitDeRefReq(AReqPtr, GdbCmdPType + ApplyBrackets(GetTextToIdx(i-1, [toSkipArrayIdx])) + '^^') then IdxPart.InitDeRefReq(AReqPtr, GdbCmdPType + GDBMIMaybeApplyBracketsToExpr(GetTextToIdx(i-1, [toSkipArrayIdx])) + '^^')
else IdxPart.InitDeRefReq(AReqPtr, GdbCmdPType + ApplyBrackets(GetTextToIdx(i-1, [toSkipArrayIdx])) + '^'); else IdxPart.InitDeRefReq(AReqPtr, GdbCmdPType + GDBMIMaybeApplyBracketsToExpr(GetTextToIdx(i-1, [toSkipArrayIdx])) + '^');
Result := True; Result := True;
exit; exit;
end; end;
@ -2059,8 +2060,8 @@ function TGDBType.RequireRequests(ARequired: TGDBTypeProcessRequests; ACustomDat
gptrPTypeExpr: Result := GdbCmdPType + FPTypeExpression; gptrPTypeExpr: Result := GdbCmdPType + FPTypeExpression;
gptrWhatisExpr: Result := GdbCmdWhatIs + FPTypeExpression; gptrWhatisExpr: Result := GdbCmdWhatIs + FPTypeExpression;
gptrPTypeOfWhatis: Result := GdbCmdPType + PCLenToString(FReqResults[gptrWhatisExpr].Result.BaseName); gptrPTypeOfWhatis: Result := GdbCmdPType + PCLenToString(FReqResults[gptrWhatisExpr].Result.BaseName);
gptrPTypeExprDeRef: Result := GdbCmdPType + ApplyBrackets(FPTypeExpression) + '^'; gptrPTypeExprDeRef: Result := GdbCmdPType + GDBMIMaybeApplyBracketsToExpr(FPTypeExpression) + '^';
gptrPTypeExprDeDeRef: Result := GdbCmdPType + ApplyBrackets(FPTypeExpression) + '^^'; gptrPTypeExprDeDeRef: Result := GdbCmdPType + GDBMIMaybeApplyBracketsToExpr(FPTypeExpression) + '^^';
gptrEvalExpr: Result := GdbCmdEvaluate+Quote(FExpression); gptrEvalExpr: Result := GdbCmdEvaluate+Quote(FExpression);
gptrEvalExprDeRef: Result := GdbCmdEvaluate+Quote(FExpression+'^'); gptrEvalExprDeRef: Result := GdbCmdEvaluate+Quote(FExpression+'^');
gptrEvalExprCast: Result := GdbCmdEvaluate+Quote(InternalTypeName+'('+FExpression+')'); gptrEvalExprCast: Result := GdbCmdEvaluate+Quote(InternalTypeName+'('+FExpression+')');