From 786941f5aaa8fb66fbdb3330dd837a2aaecbb84a Mon Sep 17 00:00:00 2001 From: martin Date: Tue, 8 Oct 2013 18:33:34 +0000 Subject: [PATCH] FPDebug: more reading type info git-svn-id: trunk@43179 - --- components/fpdebug/fpdbgdwarf.pas | 269 +++++++++++++++++++++++++----- debugger/fpgdbmidebugger.pp | 197 ++++++++++++++++------ debugger/gdbmidebugger.pp | 14 +- debugger/gdbtypeinfo.pp | 15 +- 4 files changed, 391 insertions(+), 104 deletions(-) diff --git a/components/fpdebug/fpdbgdwarf.pas b/components/fpdebug/fpdbgdwarf.pas index 86560beba1..05f336f93f 100644 --- a/components/fpdebug/fpdbgdwarf.pas +++ b/components/fpdebug/fpdbgdwarf.pas @@ -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; - Result := FTypeInfo; + 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; diff --git a/debugger/fpgdbmidebugger.pp b/debugger/fpgdbmidebugger.pp index 2c52e84d41..6a8c548f81 100644 --- a/debugger/fpgdbmidebugger.pp +++ b/debugger/fpgdbmidebugger.pp @@ -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; diff --git a/debugger/gdbmidebugger.pp b/debugger/gdbmidebugger.pp index aaee7fc5bb..e7a0e8d6a0 100644 --- a/debugger/gdbmidebugger.pp +++ b/debugger/gdbmidebugger.pp @@ -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; diff --git a/debugger/gdbtypeinfo.pp b/debugger/gdbtypeinfo.pp index cae6a9bdf2..10c1c09ba7 100644 --- a/debugger/gdbtypeinfo.pp +++ b/debugger/gdbtypeinfo.pp @@ -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+')');