From 0ce9055f115adcc758f3ef863f17345318501bd3 Mon Sep 17 00:00:00 2001 From: martin Date: Tue, 20 Aug 2019 18:58:47 +0000 Subject: [PATCH] FpDebug: Fix/Improve watches of Function/-ref git-svn-id: trunk@61732 - --- components/fpdebug/fpdbgdwarf.pas | 86 ++++++++++++++++++++++++-- components/fpdebug/fpdbginfo.pas | 2 + components/fpdebug/fppascalbuilder.pas | 26 ++++---- 3 files changed, 96 insertions(+), 18 deletions(-) diff --git a/components/fpdebug/fpdbgdwarf.pas b/components/fpdebug/fpdbgdwarf.pas index 6348579350..dda63f5460 100644 --- a/components/fpdebug/fpdbgdwarf.pas +++ b/components/fpdebug/fpdbgdwarf.pas @@ -919,6 +919,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line procedure KindNeeded; override; procedure SizeNeeded; override; function GetFlags: TDbgSymbolFlags; override; + procedure TypeInfoNeeded; override; function GetColumn: Cardinal; override; function GetFile: String; override; @@ -934,6 +935,22 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line function GetSelfParameter(AnAddress: TDbgPtr = 0): TFpValueDwarf; end; + { TFpSymbolDwarfTypeProc } + + TFpSymbolDwarfTypeProc = class(TFpSymbolDwarfType) + private + FDataSymbol: TFpSymbolDwarfDataProc; + protected + procedure ForwardToSymbolNeeded; override; + procedure CircleBackRefActiveChanged(ANewActive: Boolean); override; + procedure NameNeeded; override; + procedure KindNeeded; override; + procedure TypeInfoNeeded; override; + public + constructor Create(AName: String; AnInformationEntry: TDwarfInformationEntry; + ADataSymbol: TFpSymbolDwarfDataProc); + end; + { TFpSymbolDwarfDataVariable } TFpSymbolDwarfDataVariable = class(TFpSymbolDwarfDataWithLocation) @@ -1676,7 +1693,7 @@ end; procedure TFpValueDwarf.CircleBackRefActiveChanged(NewActive: Boolean); begin inherited CircleBackRefActiveChanged(NewActive); - if NewActive then; + //if NewActive then; if CircleBackRefsActive then begin if FValueSymbol <> nil then FValueSymbol.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FValueSymbol, 'TDbgDwarfSymbolValue'){$ENDIF}; @@ -3246,7 +3263,7 @@ begin Result := GetValueAddress(AValueObj, AnAddress); Result := Result and IsReadableLoc(AnAddress); if Result then begin - Result := TFpSymbolDwarfType(TypeInfo).GetDataAddress(AValueObj, AnAddress, ATargetType, 1); + Result := TFpSymbolDwarf(TypeInfo).GetDataAddress(AValueObj, AnAddress, ATargetType, 1); if not Result then SetLastError(TypeInfo.LastError); end; end; @@ -5036,10 +5053,7 @@ end; procedure TFpSymbolDwarfDataProc.KindNeeded; begin - if TypeInfo <> nil then - SetKind(skFunction) - else - SetKind(skProcedure); + SetKind(TypeInfo.Kind); end; procedure TFpSymbolDwarfDataProc.SizeNeeded; @@ -5056,6 +5070,15 @@ begin Result := Result + flg; end; +procedure TFpSymbolDwarfDataProc.TypeInfoNeeded; +var + t: TFpSymbolDwarfTypeProc; +begin + t := TFpSymbolDwarfTypeProc.Create('', InformationEntry, Self); // returns with 1 circulor ref + SetTypeInfo(t); // TODO: avoid adding a reference, already got one.... + t.ReleaseReference; +end; + function TFpSymbolDwarfDataProc.GetSelfParameter(AnAddress: TDbgPtr): TFpValueDwarf; const this1: string = 'THIS'; @@ -5099,6 +5122,57 @@ begin InfoEntry.ReleaseReference; end; +{ TFpSymbolDwarfTypeProc } + +procedure TFpSymbolDwarfTypeProc.ForwardToSymbolNeeded; +begin + SetForwardToSymbol(FDataSymbol); // Does *NOT* add reference +end; + +procedure TFpSymbolDwarfTypeProc.CircleBackRefActiveChanged(ANewActive: Boolean + ); +begin + inherited CircleBackRefActiveChanged(ANewActive); + if (FDataSymbol = nil) then + exit; + + if ANewActive then + FDataSymbol.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FDataSymbol, 'FDataSymbol'){$ENDIF} + else + FDataSymbol.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FDataSymbol, 'FDataSymbol'){$ENDIF}; +end; + +procedure TFpSymbolDwarfTypeProc.NameNeeded; +begin + case Kind of + skFunction: SetName('function'); + skProcedure: SetName('procedure'); + else SetName(''); + end; +end; + +procedure TFpSymbolDwarfTypeProc.KindNeeded; +begin + if TypeInfo <> nil then + SetKind(skFunction) + else + SetKind(skProcedure); +end; + +procedure TFpSymbolDwarfTypeProc.TypeInfoNeeded; +begin + SetTypeInfo(FDataSymbol.NestedTypeInfo); +end; + +constructor TFpSymbolDwarfTypeProc.Create(AName: String; + AnInformationEntry: TDwarfInformationEntry; + ADataSymbol: TFpSymbolDwarfDataProc); +begin + inherited Create(AName, AnInformationEntry); + MakePlainRefToCirclular; // Done for the Caller // So we can set FDataSymbol without back-ref + FDataSymbol := ADataSymbol; +end; + { TFpSymbolDwarfDataVariable } function TFpSymbolDwarfDataVariable.GetValueAddress(AValueObj: TFpValueDwarf; out diff --git a/components/fpdebug/fpdbginfo.pas b/components/fpdebug/fpdbginfo.pas index aad5521813..40e0914bea 100644 --- a/components/fpdebug/fpdbginfo.pas +++ b/components/fpdebug/fpdbginfo.pas @@ -602,6 +602,8 @@ procedure TFpDbgCircularRefCountedObject.ReleaseCirclularReference{$IFDEF WITH_R var i: Integer; begin + if self = nil then + exit; Assert(FCircleRefCount > 0, 'ReleaseCirclularReference > 0'); if CircleBackRefsActive then begin dec(FCircleRefCount); diff --git a/components/fpdebug/fppascalbuilder.pas b/components/fpdebug/fppascalbuilder.pas index 8b60939ee4..37290d64bf 100644 --- a/components/fpdebug/fppascalbuilder.pas +++ b/components/fpdebug/fppascalbuilder.pas @@ -100,9 +100,7 @@ begin Result := ADbgSymbol <> nil; if not Result then exit; - if (ADbgSymbol.SymbolType = stValue) and - not((ADbgSymbol.Kind = skProcedure) or (ADbgSymbol.Kind = skFunction)) - then begin + if (ADbgSymbol.SymbolType = stValue) then begin ADbgSymbol := ADbgSymbol.TypeInfo; Result := ADbgSymbol <> nil; if not Result then @@ -456,9 +454,7 @@ begin if not Result then exit; VarName := ''; - if (ADbgSymbol.SymbolType = stValue) and - not((ADbgSymbol.Kind = skProcedure) or (ADbgSymbol.Kind = skFunction)) - then begin + if (ADbgSymbol.SymbolType = stValue) then begin if tdfIncludeVarName in AFlags then VarName := ADbgSymbol.Name; ADbgSymbol := ADbgSymbol.TypeInfo; @@ -673,27 +669,29 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String; var s: String; proc: TFpSymbolDwarf; - v: TDBGPtr; t: TFpSymbol; par: TFpValueDwarf; + v: TFpDbgMemLocation; + va: TDBGPtr; begin proc := nil; - v := AValue.DataAddress.Address; + v := AValue.DataAddress; + va := v.Address; if (ppvCreateDbgType in AFlags) then begin ADBGTypeInfo^ := TDBGType.Create(AValue.Kind, ''); if AValue.Kind in [skFunctionRef, skProcedureRef] then - ADBGTypeInfo^.Value.AsPointer := Pointer(v); // TODO: no cut off + ADBGTypeInfo^.Value.AsPointer := Pointer(va); // TODO: no cut off end; // TODO: depending on verbosity: TypeName($0123456) if AValue.Kind in [skFunctionRef, skProcedureRef] then begin - if v = 0 then + if va = 0 then APrintedValue := 'nil' else - APrintedValue := '$'+IntToHex(v, AnAddressSize*2); + APrintedValue := '$'+IntToHex(va, AnAddressSize*2); t := AValue.TypeInfo; - proc := TFpSymbolDwarf(TDbgDwarfSymbolBase(t).CompilationUnit.Owner.FindSymbol(v)); + proc := TFpSymbolDwarf(TDbgDwarfSymbolBase(t).CompilationUnit.Owner.FindSymbol(va)); if proc <> nil then begin //t := proc; s := proc.Name; @@ -715,6 +713,10 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String; GetTypeAsDeclaration(s, t); APrintedValue := APrintedValue + s; + if (AValue.Kind in [skFunction, skProcedure]) and IsReadableLoc(v) then begin + APrintedValue := APrintedValue + ' AT ' + '$'+IntToHex(va, AnAddressSize*2); + end; + ReleaseRefAndNil(proc); Result := True; end;