diff --git a/components/fpdebug/fpdbgdwarf.pas b/components/fpdebug/fpdbgdwarf.pas index bc92fe12dc..9d06840be9 100644 --- a/components/fpdebug/fpdbgdwarf.pas +++ b/components/fpdebug/fpdbgdwarf.pas @@ -811,6 +811,17 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line destructor Destroy; override; end; + { TDbgDwarfUnit } + + TDbgDwarfUnit = class(TDbgDwarfIdentifier) + private + FLastChildByName: TDbgSymbol; + protected + procedure Init; override; + function GetMemberByName(AIndex: String): TDbgSymbol; override; + public + destructor Destroy; override; + end; type TDwarfSection = (dsAbbrev, dsARanges, dsFrame, dsInfo, dsLine, dsLoc, dsMacinfo, dsPubNames, dsPubTypes, dsRanges, dsStr); @@ -833,6 +844,7 @@ const { TDbgDwarf } type + TDbgDwarf = class(TDbgInfo) private FCompilationUnits: TList; @@ -842,12 +854,13 @@ type protected function GetCompilationUnitClass: TDwarfCompilationUnitClass; virtual; function FindCompilationUnitByOffs(AOffs: QWord): TDwarfCompilationUnit; + function FindProcSymbol(AAddress: TDbgPtr): TDbgSymbol; public constructor Create(ALoader: TDbgImageLoader); override; destructor Destroy; override; + function FindContext(AAddress: TDbgPtr): TDbgInfoAddressContext; override; function FindSymbol(AAddress: TDbgPtr): TDbgSymbol; override; //function FindSymbol(const AName: String): TDbgSymbol; override; - function FindIdentifier(AAddress: TDbgPtr; AName: String): TDbgSymbol; function GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr; override; function GetLineAddressMap(const AFileName: String): PDWarfLineMap; function LoadCompilationUnits: Integer; @@ -865,6 +878,22 @@ type public end; + { TDbgDwarfInfoAddressContext } + + TDbgDwarfInfoAddressContext = class(TDbgInfoAddressContext) + private + FSymbol: TDbgSymbol; + FAddress: TDbgPtr; + FDwarf: TDbgDwarf; + protected + function GetSymbolAtAddress: TDbgSymbol; override; + function GetAddress: TDbgPtr; override; + public + constructor Create(AnAddress: TDbgPtr; ASymbol: TDbgSymbol; ADwarf: TDbgDwarf); + destructor Destroy; override; + function FindSymbol(const AName: String): TDbgSymbol; override; + end; + function DwarfTagToString(AValue: Integer): String; function DwarfAttributeToString(AValue: Integer): String; @@ -1331,6 +1360,119 @@ begin end; end; +{ TDbgDwarfInfoAddressContext } + +function TDbgDwarfInfoAddressContext.GetSymbolAtAddress: TDbgSymbol; +begin + Result := FSymbol; +end; + +function TDbgDwarfInfoAddressContext.GetAddress: TDbgPtr; +begin + Result := FAddress; +end; + +constructor TDbgDwarfInfoAddressContext.Create(AnAddress: TDbgPtr; ASymbol: TDbgSymbol; + ADwarf: TDbgDwarf); +begin + inherited Create; + AddReference; + FAddress := AnAddress; + FDwarf := ADwarf; + FSymbol := ASymbol; + FSymbol.AddReference; +end; + +destructor TDbgDwarfInfoAddressContext.Destroy; +begin + FSymbol.ReleaseReference; + inherited Destroy; +end; + +function TDbgDwarfInfoAddressContext.FindSymbol(const AName: String): TDbgSymbol; +var + SubRoutine: TDbgDwarfProcSymbol; // TDbgSymbol; + CU: TDwarfCompilationUnit; + //Scope, + StartScopeIdx: Integer; + InfoEntry: TDwarfInformationEntry; + s, InfoName: String; +begin + Result := nil; + if (FSymbol = nil) or not(FSymbol is TDbgDwarfProcSymbol) then + exit; + + SubRoutine := TDbgDwarfProcSymbol(FSymbol); + s := UpperCase(AName); + + try + CU := SubRoutine.FCU; + InfoEntry := SubRoutine.InformationEntry.Clone; + //InfoEntry := TDwarfInformationEntry.Create(CU, nil); + //InfoEntry.ScopeIndex := SubRoutine.FAddressInfo^.ScopeIndex; + + while InfoEntry.HasValidScope do begin + debugln(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier Searching ', dbgs(InfoEntry.FScope, CU)]); + StartScopeIdx := InfoEntry.ScopeIndex; + + if InfoEntry.ReadValue(DW_AT_name, InfoName) then begin + if UpperCase(InfoName) = s then begin + Result := TDbgDwarfIdentifier.CreateSubClass(AName, InfoEntry); + DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier found ', dbgs(InfoEntry.FScope, CU), DbgSName(Result)]); + break; + end; + end; + + if InfoEntry.GoNamedChildEx(AName) then begin + Result := TDbgDwarfIdentifier.CreateSubClass(AName, InfoEntry); + DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier found ', dbgs(InfoEntry.FScope, CU), DbgSName(Result)]); + break; + end; + + // Search parent(s) + InfoEntry.ScopeIndex := StartScopeIdx; + InfoEntry.GoParent; + end; + + // other units + + finally + ReleaseRefAndNil(InfoEntry); + end; +end; + +{ TDbgDwarfUnit } + +procedure TDbgDwarfUnit.Init; +begin + inherited Init; + SetSymbolType(stNone); + SetKind(skUnit); +end; + +function TDbgDwarfUnit.GetMemberByName(AIndex: String): TDbgSymbol; +var + Ident: TDwarfInformationEntry; + ti: TDbgSymbol; +begin + // Todo, param to only search external. + ReleaseRefAndNil(FLastChildByName); + Result := nil; + + Ident := FInformationEntry.Clone; + Ident.GoNamedChildEx(AIndex); + if Ident <> nil then + Result := TDbgDwarfIdentifier.CreateSubClass('', Ident); + ReleaseRefAndNil(Ident); + FLastChildByName := Result; +end; + +destructor TDbgDwarfUnit.Destroy; +begin + ReleaseRefAndNil(FLastChildByName); + inherited Destroy; +end; + { TDbgDwarfIdentifierSubRange } procedure TDbgDwarfIdentifierSubRange.ReadBounds; @@ -2577,6 +2719,8 @@ begin // Value types DW_TAG_member: Result := TDbgDwarfIdentifierMember; DW_TAG_subprogram: Result := TDbgDwarfProcSymbol; + // + DW_TAG_compile_unit: Result := TDbgDwarfUnit; else Result := TDbgDwarfIdentifier; @@ -3571,110 +3715,22 @@ begin inherited Destroy; end; -function TDbgDwarf.FindSymbol(AAddress: TDbgPtr): TDbgSymbol; +function TDbgDwarf.FindContext(AAddress: TDbgPtr): TDbgInfoAddressContext; var - n: Integer; - CU: TDwarfCompilationUnit; - Iter: TMapIterator; - Info: PDwarfAddressInfo; - MinMaxSet: boolean; + Proc: TDbgSymbol; begin Result := nil; - for n := 0 to FCompilationUnits.Count - 1 do - begin - CU := TDwarfCompilationUnit(FCompilationUnits[n]); - if not CU.Valid then Continue; - MinMaxSet := CU.FMinPC <> CU.FMaxPC; - if MinMaxSet and ((AAddress < CU.FMinPC) or (AAddress > CU.FMaxPC)) - then Continue; - - CU.BuildAddressMap; - - Iter := TMapIterator.Create(CU.FAddressMap); - try - if Iter.EOM - then begin - if MinMaxSet - then Exit // minmaxset and no procs defined ??? - else Continue; - end; - - if not Iter.Locate(AAddress) - then begin - if not Iter.BOM - then Iter.Previous; - - if Iter.BOM - then begin - if MinMaxSet - then Exit // minmaxset and no proc @ minpc ??? - else Continue; - end; - end; - - // iter is at the closest defined adress before AAddress - Info := Iter.DataPtr; - if AAddress > Info^.EndPC - then begin - if MinMaxSet - then Exit // minmaxset and no proc @ maxpc ??? - else Continue; - end; - - Result := TDbgDwarfProcSymbol.Create(CU, Iter.DataPtr, AAddress); - finally - Iter.Free; - end; - end; -end; - -function TDbgDwarf.FindIdentifier(AAddress: TDbgPtr; AName: String): TDbgSymbol; -var - SubRoutine: TDbgDwarfProcSymbol; // TDbgSymbol; - CU: TDwarfCompilationUnit; - //Scope, - StartScopeIdx: Integer; - InfoEntry: TDwarfInformationEntry; -begin - Result := nil; - SubRoutine := TDbgDwarfProcSymbol(FindSymbol(AAddress)); - if SubRoutine = nil then + Proc := FindProcSymbol(AAddress); + if Proc = nil then exit; - try - CU := SubRoutine.FCU; - InfoEntry := TDwarfInformationEntry.Create(CU, nil); - InfoEntry.ScopeIndex := SubRoutine.FAddressInfo^.ScopeIndex; + Result := TDbgDwarfInfoAddressContext.Create(AAddress, Proc, Self); + Proc.ReleaseReference; +end; - while InfoEntry.HasValidScope do begin - debugln(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier Searching ', dbgs(InfoEntry.FScope, CU)]); - StartScopeIdx := InfoEntry.ScopeIndex; - - if InfoEntry.GoNamedChildEx(AName) then begin - Result := TDbgDwarfIdentifier.CreateSubClass(AName, InfoEntry); - DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier found ', dbgs(InfoEntry.FScope, CU), DbgSName(Result)]); - break; - end; - - // Search parent(s) - InfoEntry.ScopeIndex := StartScopeIdx; - InfoEntry.GoParent; - end; - - // unitname? - -//// debugln: -// if Result <> nil then begin -// TDbgDwarfIdentifier(Result).TypeInfo; // debugln... -// if TDbgDwarfIdentifier(Result).TypeInfo <> nil then TDbgDwarfIdentifier(Result).TypeInfo.TypeInfo; -// end; -//// end debugln - - - finally - ReleaseRefAndNil(SubRoutine); - ReleaseRefAndNil(InfoEntry); - end; +function TDbgDwarf.FindSymbol(AAddress: TDbgPtr): TDbgSymbol; +begin + Result := FindProcSymbol(AAddress); end; function TDbgDwarf.GetCompilationUnit(AIndex: Integer): TDwarfCompilationUnit; @@ -3708,6 +3764,63 @@ begin Result := nil; end; +function TDbgDwarf.FindProcSymbol(AAddress: TDbgPtr): TDbgSymbol; +var + n: Integer; + CU: TDwarfCompilationUnit; + Iter: TMapIterator; + Info: PDwarfAddressInfo; + MinMaxSet: boolean; +begin + Result := nil; + for n := 0 to FCompilationUnits.Count - 1 do + begin + CU := TDwarfCompilationUnit(FCompilationUnits[n]); + if not CU.Valid then Continue; + MinMaxSet := CU.FMinPC <> CU.FMaxPC; + if MinMaxSet and ((AAddress < CU.FMinPC) or (AAddress > CU.FMaxPC)) + then Continue; + + CU.BuildAddressMap; + + Iter := TMapIterator.Create(CU.FAddressMap); + try + if Iter.EOM + then begin + if MinMaxSet + then Exit // minmaxset and no procs defined ??? + else Continue; + end; + + if not Iter.Locate(AAddress) + then begin + if not Iter.BOM + then Iter.Previous; + + if Iter.BOM + then begin + if MinMaxSet + then Exit // minmaxset and no proc @ minpc ??? + else Continue; + end; + end; + + // iter is at the closest defined adress before AAddress + Info := Iter.DataPtr; + if AAddress > Info^.EndPC + then begin + if MinMaxSet + then Exit // minmaxset and no proc @ maxpc ??? + else Continue; + end; + + Result := TDbgDwarfProcSymbol.Create(CU, Iter.DataPtr, AAddress); + finally + Iter.Free; + end; + end; +end; + function TDbgDwarf.GetLineAddress(const AFileName: String; ALine: Cardinal): TDbgPtr; var n: Integer; diff --git a/components/fpdebug/fpdbginfo.pas b/components/fpdebug/fpdbginfo.pas index 9ddf255177..ea61d9df8f 100644 --- a/components/fpdebug/fpdbginfo.pas +++ b/components/fpdebug/fpdbginfo.pas @@ -209,6 +209,19 @@ type function GetMemberCount: Integer; override; end; + { TDbgInfoAddressContext } + + TDbgInfoAddressContext = class(TRefCountedObject) + protected + function GetAddress: TDbgPtr; virtual; abstract; + function GetSymbolAtAddress: TDbgSymbol; virtual; + public + property Address: TDbgPtr read GetAddress; + property SymbolAtAddress: TDbgSymbol read GetSymbolAtAddress; + // search this, and all parent context + function FindSymbol(const AName: String): TDbgSymbol; virtual; + end; + { TDbgInfo } TDbgInfo = class(TObject) @@ -218,8 +231,9 @@ type procedure SetHasInfo; public constructor Create({%H-}ALoader: TDbgImageLoader); virtual; - function FindSymbol(const {%H-}AName: String): TDbgSymbol; virtual; - function FindSymbol({%H-}AAddress: TDbgPtr): TDbgSymbol; virtual; + function FindContext({%H-}AAddress: TDbgPtr): TDbgInfoAddressContext; virtual; + function FindSymbol(const {%H-}AName: String): TDbgSymbol; virtual; deprecated; + function FindSymbol({%H-}AAddress: TDbgPtr): TDbgSymbol; virtual; deprecated; property HasInfo: Boolean read FHasInfo; function GetLineAddress(const {%H-}AFileName: String; {%H-}ALine: Cardinal): TDbgPtr; virtual; end; @@ -234,6 +248,18 @@ begin WriteStr(Result, ADbgSymbolKind); end; +{ TDbgInfoAddressContext } + +function TDbgInfoAddressContext.GetSymbolAtAddress: TDbgSymbol; +begin + Result := nil; +end; + +function TDbgInfoAddressContext.FindSymbol(const AName: String): TDbgSymbol; +begin + Result := nil; +end; + { TDbgSymbol } constructor TDbgSymbol.Create(const AName: String); @@ -661,6 +687,11 @@ begin inherited Create; end; +function TDbgInfo.FindContext(AAddress: TDbgPtr): TDbgInfoAddressContext; +begin + Result := nil; +end; + function TDbgInfo.FindSymbol(const AName: String): TDbgSymbol; begin Result := nil; diff --git a/components/fpdebug/test/testpascalparser.pas b/components/fpdebug/test/testpascalparser.pas index 519a6b23af..fe94c0ba36 100644 --- a/components/fpdebug/test/testpascalparser.pas +++ b/components/fpdebug/test/testpascalparser.pas @@ -392,6 +392,15 @@ begin TestExpr([0,0,1], TFpPascalExpressionPartIdentifer, 'a', 0); TestExpr([0,1], TFpPascalExpressionPartIdentifer, 'b', 0); + CreateExpr('f[a]', True); + TestExpr([], TFpPascalExpressionPartBracketIndex, '[', 2); + TestExpr([0], TFpPascalExpressionPartIdentifer, 'f', 0); + TestExpr([1], TFpPascalExpressionPartIdentifer, 'a', 0); + + CreateExpr('TFoo(f^[0]).a', True); + + CreateExpr('^^int(1)', True); + finally CurrentTestExprObj.Free; end; diff --git a/components/fpdebug/test/testtypeinfo.pas b/components/fpdebug/test/testtypeinfo.pas index a7d9660c3b..ac66bfe4b2 100644 --- a/components/fpdebug/test/testtypeinfo.pas +++ b/components/fpdebug/test/testtypeinfo.pas @@ -44,10 +44,14 @@ var function TTestPascalExpression.GetDbgTyeForIdentifier(AnIdent: String): TDbgSymbol; var Loc: TDBGPtr; + Ctx: TDbgInfoAddressContext; begin Result := nil; - if (FDwarfInfo <> nil) and (AnIdent <> '') then - Result := FDwarfInfo.FindIdentifier(Location, AnIdent); + if (FDwarfInfo <> nil) and (AnIdent <> '') then begin + Ctx := FDwarfInfo.FindContext(Location); + Result := Ctx.FindSymbol(AnIdent); + Ctx.ReleaseReference; + end; end; procedure TTestTypInfo.LoadDwarf(AFileName: String); @@ -261,6 +265,8 @@ GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s); DoTest('testc2.a5', skArray); AssertTrue(TestText + ' Flag: ', sfStatArray in Expr.ResultType.Flags); GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s); +GetTypeAsDeclaration(s, Expr.ResultType, [tdfSkipClassBody, tdfSkipRecordBody]); DebugLn(s); + DoTest('testc2.a6', skArray); AssertTrue(TestText + ' Flag: ', sfDynArray in Expr.ResultType.Flags); @@ -272,6 +278,37 @@ GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s); + DoTest('a1[1]', skBoolean); +GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s); + + DoTest('a1[3]', skBoolean); +GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s); + + + DoTest('a1b[1]', skArray); +GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s); + + DoTest('a1b[3]', skArray); +GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s); + + + DoTest('a1b[1][3]', skBoolean); +GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s); + + DoTest('a1b[3][4]', skBoolean); +GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s); + + + DoTest('TTestClass(0)', skClass); +GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s); + + DoTest('TTestClass(0).FWord', skCardinal); +GetTypeAsDeclaration(s, Expr.ResultType); DebugLn(s); + + + DoTest('TTestClass2(0).enum4', skPointer); + DoTest('TTestClass2(0).enum4^', skEnum); + FreeAndNil(expr); end; @@ -292,5 +329,6 @@ end; initialization RegisterTest(TTestTypInfo); + DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_SEARCH' {$IFDEF FPDBG_DWARF_SEARCH} , True {$ENDIF} )^.Enabled := True; end. diff --git a/debugger/fpgdbmidebugger.pp b/debugger/fpgdbmidebugger.pp index 79197a9b2b..6237cb74a1 100644 --- a/debugger/fpgdbmidebugger.pp +++ b/debugger/fpgdbmidebugger.pp @@ -38,12 +38,19 @@ type property Debugger: TFpGDBMIDebugger read FDebugger; end; +const + MAX_CTX_CACHE = 10; + +type { TFpGDBMIDebugger } TFpGDBMIDebugger = class(TGDBMIDebugger) private FImageLoader: TDbgImageLoader; FDwarfInfo: TDbgDwarf; + // cache last context + FlastStackFrame, FLastThread: Integer; + FLastContext: array [0..MAX_CTX_CACHE-1] of TDbgInfoAddressContext; protected function CreateCommandStartDebugging(AContinueCommand: TGDBMIDebuggerCommand): TGDBMIDebuggerCommandStartDebugging; override; function CreateLineInfo: TDBGLineInfo; override; @@ -56,6 +63,7 @@ type procedure GetCurrentContext(out AThreadId, AStackFrame: Integer); function GetLocationForContext(AThreadId, AStackFrame: Integer): TDBGPtr; + function GetInfoContextForContext(AThreadId, AStackFrame: Integer): TDbgInfoAddressContext; function CreateTypeRequestCache: TGDBPTypeRequestCache; override; public class function Caption: String; override; @@ -113,13 +121,19 @@ type function TFpGDBMIPascalExpression.GetDbgTyeForIdentifier(AnIdent: String): TDbgSymbol; var Loc: TDBGPtr; + Ctx: TDbgInfoAddressContext; begin Result := nil; if FDebugger.HasDwarf then begin if AnIdent <> '' then begin - Loc := FDebugger.GetLocationForContext(FThreadId, FStackFrame); - if (Loc <> 0) then - Result := FDebugger.FDwarfInfo.FindIdentifier(Loc, AnIdent); + //Loc := FDebugger.GetLocationForContext(FThreadId, FStackFrame); + //if (Loc <> 0) then begin + Ctx := FDebugger.GetInfoContextForContext(FThreadId, FStackFrame); + //Ctx := FDebugger.FDwarfInfo.FindContext(Loc); + if Ctx <> nil then + Result := Ctx.FindSymbol(AnIdent); + //Ctx.ReleaseReference; + //end; end; end; end; @@ -439,7 +453,7 @@ const ASrcTypeName, ADeRefTypeName, ABaseTypeName: String; ASrcType, ABaseType: TDbgSymbol); var - s, s2: String; + s: String; ElemPointerLevel: Integer; ElemDeRefType, ElemBaseType: TDbgSymbol; ElemSrcTypeName, ElemDeRefTypeName, ElemBaseTypeName: String; @@ -724,10 +738,16 @@ end; { TFpGDBMIDebugger } procedure TFpGDBMIDebugger.DoState(const OldState: TDBGState); +var + i: Integer; begin inherited DoState(OldState); if State in [dsStop, dsError, dsNone] then UnLoadDwarf; + + if OldState in [dsPause, dsInternalPause] then + for i := 0 to MAX_CTX_CACHE-1 do + ReleaseRefAndNil(FLastContext[i]); end; function TFpGDBMIDebugger.HasDwarf: Boolean; @@ -830,6 +850,40 @@ begin end; +function TFpGDBMIDebugger.GetInfoContextForContext(AThreadId, + AStackFrame: Integer): TDbgInfoAddressContext; +var + Addr: TDBGPtr; +begin + if (AThreadId <= 0) then begin + GetCurrentContext(AThreadId, AStackFrame); + end; + + Addr := GetLocationForContext(AThreadId, AStackFrame); + + if Addr = 0 then begin + Result := nil; + exit; + end; + + if (AStackFrame >= FlastStackFrame) and + (AStackFrame - FlastStackFrame < MAX_CTX_CACHE) and + (FLastContext[AStackFrame - FlastStackFrame] <> nil) and + (FLastContext[AStackFrame - FlastStackFrame].Address = Addr) + then begin +DebugLn('cached contex'); + Result := FLastContext[AStackFrame - FlastStackFrame]; + exit; + end; + + Result := FDwarfInfo.FindContext(Addr); + + FLastThread := AThreadId; + FlastStackFrame := AStackFrame; + FLastContext[0].ReleaseReference; + FLastContext[0] := Result; +end; + type TGDBMIDwarfTypeIdentifier = class(TDbgDwarfTypeIdentifier) public