paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-09 15:53:44 +01:00
Code Issues Packages Projects Releases Wiki Activity

FpDebug: Remove circular refs

Browse Source 
git-svn-id: trunk@61953 -
This commit is contained in:
martin 2019-09-29 21:43:54 +00:00
parent ab5154ae18
commit aa60af3f9e
2 changed files with 8 additions and 159 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
components/fpdebug/fpdbgdwarf.pas
View File

@ -169,10 +169,6 @@ type
procedure SetStructureValue(AValue: TFpValueDwarf);
protected
function GetSizeFor(AnOtherValue: TFpValue; out ASize: QWord): Boolean; inline;
procedure DoReferenceAdded; override;
procedure DoReferenceReleased; override;
procedure CircleBackRefActiveChanged(NewActive: Boolean); override;
function AddressSize: Byte; inline;
// Address of the symbol (not followed any type deref, or location)
@ -453,10 +449,6 @@ type
function GetNestedTypeInfo: TFpSymbolDwarfType;
function GetTypeInfo: TFpSymbolDwarfType; inline;
protected
(* There will be a circular reference between parenttype and self
"self" will only set its reference to parenttype, if self has other references. *)
procedure DoReferenceAdded; override;
procedure DoReferenceReleased; override;
procedure SetLocalProcInfo(AValue: TFpSymbolDwarf); virtual;
function DoGetNestedTypeInfo: TFpSymbolDwarfType; virtual;
@ -1454,10 +1446,9 @@ begin
if FStructureValue = AValue then
exit;
if CircleBackRefsActive and (FStructureValue <> nil) then
FStructureValue.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FStructureValue, 'TDbgDwarfSymbolValue'){$ENDIF};
FStructureValue.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FStructureValue, 'TDbgDwarfSymbolValue'){$ENDIF};
FStructureValue := AValue;
if CircleBackRefsActive and (FStructureValue <> nil) then
if FStructureValue <> nil then
FStructureValue.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FStructureValue, 'TDbgDwarfSymbolValue'){$ENDIF};
end;
@ -1582,35 +1573,6 @@ begin
Result := False;
end;
procedure TFpValueDwarf.DoReferenceAdded;
begin
inherited DoReferenceAdded;
DoPlainReferenceAdded;
end;
procedure TFpValueDwarf.DoReferenceReleased;
begin
inherited DoReferenceReleased;
DoPlainReferenceReleased;
end;
procedure TFpValueDwarf.CircleBackRefActiveChanged(NewActive: Boolean);
begin
inherited CircleBackRefActiveChanged(NewActive);
//if NewActive then;
if CircleBackRefsActive then begin
if FDataSymbol <> nil then
FDataSymbol.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FDataSymbol, ClassName+'.FDataSymbol'){$ENDIF};
if FStructureValue <> nil then
FStructureValue.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FStructureValue, 'TDbgDwarfSymbolValue'){$ENDIF}; end
else begin
if FDataSymbol <> nil then
FDataSymbol.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FDataSymbol, ClassName+'.FDataSymbol'){$ENDIF};
if FStructureValue <> nil then
FStructureValue.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FStructureValue, 'TDbgDwarfSymbolValue'){$ENDIF};
end;
end;
function TFpValueDwarf.GetKind: TDbgSymbolKind;
begin
Result := FTypeSymbol.Kind;
@ -1699,9 +1661,8 @@ end;
destructor TFpValueDwarf.Destroy;
begin
FTypeCastSourceValue.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FTypeCastSourceValue, ClassName+'.FTypeCastSourceValue'){$ENDIF};
// do not call reset()
if CircleBackRefsActive and (FStructureValue <> nil) then
FStructureValue.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FStructureValue, 'TDbgDwarfSymbolValue'){$ENDIF};
FStructureValue.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FStructureValue, 'TDbgDwarfSymbolValue'){$ENDIF};
FDataSymbol.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FDataSymbol, ClassName+'.FDataSymbol'){$ENDIF};
inherited Destroy;
end;
@ -1710,10 +1671,9 @@ begin
if FDataSymbol = AValueSymbol then
exit;
if CircleBackRefsActive and (FDataSymbol <> nil) then
FDataSymbol.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FDataSymbol, ClassName+'.FDataSymbol'){$ENDIF};
FDataSymbol.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FDataSymbol, ClassName+'.FDataSymbol'){$ENDIF};
FDataSymbol := AValueSymbol;
if CircleBackRefsActive and (FDataSymbol <> nil) then
if FDataSymbol <> nil then
FDataSymbol.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FDataSymbol, ClassName+'.FDataSymbol'){$ENDIF};
end;
@ -2802,18 +2762,6 @@ begin
FLocalProcInfo.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FLocalProcInfo, 'FLocalProcInfo'){$ENDIF};
end;
procedure TFpSymbolDwarf.DoReferenceAdded;
begin
inherited DoReferenceAdded;
DoPlainReferenceAdded;
end;
procedure TFpSymbolDwarf.DoReferenceReleased;
begin
inherited DoReferenceReleased;
DoPlainReferenceReleased;
end;
function TFpSymbolDwarf.DoGetNestedTypeInfo: TFpSymbolDwarfType;
var
FwdInfoPtr: Pointer;
@ -3307,7 +3255,6 @@ destructor TFpSymbolDwarf.Destroy;
begin
inherited Destroy;
FNestedTypeInfo.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FNestedTypeInfo, ClassName+'.FNestedTypeInfo'){$ENDIF};
Assert(not CircleBackRefsActive, 'CircleBackRefsActive can not be is destructor');
FLocalProcInfo.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FLocalProcInfo, 'FLocalProcInfo'){$ENDIF};
end;

102
components/fpdebug/fpdbginfo.pas
View File

@ -36,31 +36,6 @@ uses
LazLoggerBase, LazClasses;
type
{ TFpDbgCircularRefCountedObject }
TFpDbgCircularRefCountedObject = class(TRefCountedObject)
private
FCircleRefCount: Integer;
protected
(* InOrder to activate, and use an interited class must override
DoReferenceAdded; and DoReferenceReleased;
And Point then to
DoPlainReferenceAdded; and DoPlainReferenceReleased;
*)
procedure DoPlainReferenceAdded; inline;
procedure DoPlainReferenceReleased; inline;
// Receive the *strong* reference (always set)
// The circle back ref will only be set, if this is also referenced by others
procedure AddCirclularReference{$IFDEF WITH_REFCOUNT_DEBUG}(DebugIdAdr: Pointer = nil; DebugIdTxt: String = ''){$ENDIF};
procedure ReleaseCirclularReference{$IFDEF WITH_REFCOUNT_DEBUG}(DebugIdAdr: Pointer = nil; DebugIdTxt: String = ''){$ENDIF};
procedure MakePlainRefToCirclular;
procedure MakeCirclularRefToPlain;
function CircleBackRefsActive: Boolean; inline;
procedure CircleBackRefActiveChanged({%H-}NewActive: Boolean); virtual;
end;
TDbgSymbolType = (
stNone,
@ -117,7 +92,7 @@ type
{ TFpValue }
TFpValue = class(TFpDbgCircularRefCountedObject)
TFpValue = class(TRefCountedObject)
private
FEvalFlags: set of (efSizeDone, efSizeUnavail);
FLastError: TFpError;
@ -326,7 +301,7 @@ type
{ TFpSymbol }
TFpSymbol = class(TFpDbgCircularRefCountedObject)
TFpSymbol = class(TRefCountedObject)
private
FEvaluatedFields: TFpSymbolFields;
FLastError: TFpError;
@ -567,79 +542,6 @@ begin
FValue := AValue;
end;
{ TFpDbgCircularRefCountedObject }
procedure TFpDbgCircularRefCountedObject.DoPlainReferenceAdded;
begin
if (RefCount = FCircleRefCount + 1) then
CircleBackRefActiveChanged(True);
end;
procedure TFpDbgCircularRefCountedObject.DoPlainReferenceReleased;
begin
if (RefCount = FCircleRefCount) then
CircleBackRefActiveChanged(False);
end;
procedure TFpDbgCircularRefCountedObject.AddCirclularReference{$IFDEF WITH_REFCOUNT_DEBUG}(DebugIdAdr: Pointer = nil; DebugIdTxt: String = ''){$ENDIF};
begin
if CircleBackRefsActive then begin
AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(DebugIdAdr, DebugIdTxt){$ENDIF};
inc(FCircleRefCount);
end
else begin
inc(FCircleRefCount);
AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(DebugIdAdr, DebugIdTxt){$ENDIF};
end;
end;
procedure TFpDbgCircularRefCountedObject.ReleaseCirclularReference{$IFDEF WITH_REFCOUNT_DEBUG}(DebugIdAdr: Pointer = nil; DebugIdTxt: String = ''){$ENDIF};
var
i: Integer;
begin
if self = nil then
exit;
Assert(FCircleRefCount > 0, 'ReleaseCirclularReference > 0');
if CircleBackRefsActive then begin
dec(FCircleRefCount);
ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(DebugIdAdr, DebugIdTxt){$ENDIF};
end
else begin
i := RefCount;
ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(DebugIdAdr, DebugIdTxt){$ENDIF};
if i > 1 then // if i was 1, then self is destroyed
dec(FCircleRefCount);
end;
end;
procedure TFpDbgCircularRefCountedObject.MakePlainRefToCirclular;
begin
Assert(FCircleRefCount < RefCount, 'MakePlainRefToCirclular < max');
inc(FCircleRefCount);
if (RefCount = FCircleRefCount) then
CircleBackRefActiveChanged(False);
end;
procedure TFpDbgCircularRefCountedObject.MakeCirclularRefToPlain;
begin
Assert(FCircleRefCount > 0, 'MakeCirclularRefToPlain > 0');
dec(FCircleRefCount);
if (RefCount = FCircleRefCount + 1) then
CircleBackRefActiveChanged(True);
end;
function TFpDbgCircularRefCountedObject.CircleBackRefsActive: Boolean;
begin
Result := (RefCount > FCircleRefCount);
end;
procedure TFpDbgCircularRefCountedObject.CircleBackRefActiveChanged(NewActive: Boolean);
begin
//
end;
{ TFpDbgCircularRefCntObjList }
{ TDbgSymbolValue }
function TFpValue.GetAsString: AnsiString;