paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 19:19:19 +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

267
components/fpdebug/fpdbgdwarf.pas
View File

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

197
debugger/fpgdbmidebugger.pp
View File

@ -11,6 +11,20 @@ uses
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 = class(TGDBMIDebugger)
@ -30,6 +44,7 @@ type
procedure GetCurrentContext(out AThreadId, AStackFrame: Integer);
function GetLocationForContext(AThreadId, AStackFrame: Integer): TDBGPtr;
procedure AddToGDBMICache(AThreadId, AStackFrame: Integer; AnIdent: TDbgSymbol);
function CreateTypeRequestCache: TGDBPTypeRequestCache; override;
public
class function Caption: String; override;
public
@ -53,6 +68,7 @@ type
TFPGDBMIWatches = class(TGDBMIWatches)
private
protected
function FpDebugger: TFpGDBMIDebugger;
//procedure DoStateChange(const AOldState: TDBGState); override;
procedure InternalRequestData(AWatchValue: TCurrentWatchValue); override;
public
@ -80,14 +96,77 @@ type
procedure Cancel(const ASource: String); override;
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 }
function TFPGDBMIWatches.FpDebugger: TFpGDBMIDebugger;
begin
Result := TFpGDBMIDebugger(Debugger);
end;
procedure TFPGDBMIWatches.InternalRequestData(AWatchValue: TCurrentWatchValue);
var
Loc: TDBGPtr;
Ident: TDbgSymbol;
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);
end;
@ -217,24 +296,24 @@ var
CurThread, CurStack: Integer;
begin
if HasDwarf and (ACommand = dcEvaluate) then begin
GetCurrentContext(CurThread, CurStack);
Loc := GetLocationForContext(-1, -1);
//GetCurrentContext(CurThread, CurStack);
//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
Ident := FDwarfInfo.FindIdentifier(Loc, String(AParams[0].VAnsiString));
if Ident <> nil then
AddToGDBMICache(CurThread, CurStack, Ident);
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);
// //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);
end
else
@ -315,10 +394,25 @@ procedure TFpGDBMIDebugger.AddToGDBMICache(AThreadId, AStackFrame: Integer;
const
GdbCmdPType = 'ptype ';
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
TypeIdent: TDbgDwarfTypeIdentifier;
VarName, TypeName: String;
AReq: TGDBPTypeRequest;
IsPointer: Boolean;
begin
(* Simulate gdb answers *)
//TypeRequestCache
@ -328,48 +422,49 @@ begin
TypeIdent := TDbgDwarfValueIdentifier(AnIdent).TypeInfo;
if TypeIdent = nil then exit;
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
then begin
AReq.ReqType := gcrtPType;
AReq.Request := GdbCmdPType + VarName;
if TypeRequestCache.IndexOf(AThreadId, AStackFrame, AReq) < 0 then begin
AReq.Result := ParseTypeFromGdb(Format('type = %s', [TypeName]));
TypeRequestCache.Add(AThreadId, AStackFrame, AReq)
end;
AReq.ReqType := gcrtPType;
AReq.Request := GdbCmdWhatIs + VarName;
if TypeRequestCache.IndexOf(AThreadId, AStackFrame, AReq) < 0 then begin
AReq.Result := ParseTypeFromGdb(Format('type = %s', [TypeName]));
TypeRequestCache.Add(AThreadId, AStackFrame, AReq)
if TGDBMIDwarfTypeIdentifier(TypeIdent).IsBaseType then begin
if IsPointer then begin
MaybeAdd(gcrtPType, GdbCmdPType + VarName, Format('type = ^%s', [TypeName]));
MaybeAdd(gcrtPType, GdbCmdWhatIs + VarName, Format('type = ^%s', [TypeName]));
MaybeAdd(gcrtPType, GdbCmdPType + GDBMIMaybeApplyBracketsToExpr(VarName) + '^',
Format('type = %s', [TypeName]));
MaybeAdd(gcrtPType, GdbCmdWhatIs + GDBMIMaybeApplyBracketsToExpr(VarName) + '^',
Format('type = %s', [TypeName]));
end
else begin
MaybeAdd(gcrtPType, GdbCmdPType + VarName, Format('type = %s', [TypeName]));
MaybeAdd(gcrtPType, GdbCmdWhatIs + VarName, Format('type = %s', [TypeName]));
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;
function TFpGDBMIDebugger.CreateCommandStartDebugging(AContinueCommand: TGDBMIDebuggerCommand): TGDBMIDebuggerCommandStartDebugging;

14
debugger/gdbmidebugger.pp
View File

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

15
debugger/gdbtypeinfo.pp
View File

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