paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-06 13:45:56 +02:00
Code Issues Packages Projects Releases Wiki Activity

FPDebug: refactor (use value-object for data address of members)

Browse Source 
git-svn-id: trunk@44382 -
This commit is contained in:
martin 2014-03-08 22:07:32 +00:00
parent 8cec6d7044
commit 32f60ff178
1 changed files with 85 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

139
components/fpdebug/fpdbgdwarf.pas
View File

@ -599,10 +599,18 @@ type
FValueSymbol: TDbgDwarfValueIdentifier; FValueSymbol: TDbgDwarfValueIdentifier;
FTypeCastTargetType: TDbgDwarfTypeIdentifier; FTypeCastTargetType: TDbgDwarfTypeIdentifier;
FTypeCastSourceValue: TFpDbgValue; FTypeCastSourceValue: TFpDbgValue;
FStructureValue: TFpDbgDwarfValue;
FLastMember: TFpDbgDwarfValue;
FLastError: TFpError; FLastError: TFpError;
function MemManager: TFpDbgMemManager; inline; function MemManager: TFpDbgMemManager; inline;
function AddressSize: Byte; inline; function AddressSize: Byte; inline;
procedure SetStructureValue(AValue: TFpDbgDwarfValue);
protected protected
procedure DoReferenceAdded; override;
procedure DoReferenceReleased; override;
procedure CircleBackRefActiveChanged(NewActive: Boolean); override;
procedure SetLastMember(ALastMember: TFpDbgDwarfValue);
function GetLastError: TFpError; override; function GetLastError: TFpError; override;
function DataAddr: TFpDbgMemLocation; function DataAddr: TFpDbgMemLocation;
function OrdOrDataAddr: TFpDbgMemLocation; function OrdOrDataAddr: TFpDbgMemLocation;
@ -612,8 +620,6 @@ type
function GetFieldFlags: TFpDbgValueFieldFlags; override; function GetFieldFlags: TFpDbgValueFieldFlags; override;
function HasTypeCastInfo: Boolean; function HasTypeCastInfo: Boolean;
function IsValidTypeCast: Boolean; virtual; function IsValidTypeCast: Boolean; virtual;
procedure DoReferenceAdded; override;
procedure DoReferenceReleased; override;
function GetKind: TDbgSymbolKind; override; function GetKind: TDbgSymbolKind; override;
function GetAddress: TFpDbgMemLocation; override; function GetAddress: TFpDbgMemLocation; override;
function GetMemberCount: Integer; override; function GetMemberCount: Integer; override;
@ -628,7 +634,8 @@ type
procedure SetValueSymbol(AValueSymbol: TDbgDwarfValueIdentifier); procedure SetValueSymbol(AValueSymbol: TDbgDwarfValueIdentifier);
function SetTypeCastInfo(AStructure: TDbgDwarfTypeIdentifier; function SetTypeCastInfo(AStructure: TDbgDwarfTypeIdentifier;
ASource: TFpDbgValue): Boolean; // Used for Typecast ASource: TFpDbgValue): Boolean; // Used for Typecast
// SourceValue: TFpDbgValue // StructureValue: Any Value returned via GetMember points to its structure
property StructureValue: TFpDbgDwarfValue read FStructureValue write SetStructureValue;
end; end;
{ TFpDbgDwarfValueSized } { TFpDbgDwarfValueSized }
@ -825,7 +832,6 @@ type
TFpDbgDwarfValueArray = class(TFpDbgDwarfValue) TFpDbgDwarfValueArray = class(TFpDbgDwarfValue)
private private
FResVal: TFpDbgValue;
FAddrObj: TFpDbgDwarfValueConstAddress; FAddrObj: TFpDbgDwarfValueConstAddress;
protected protected
function GetFieldFlags: TFpDbgValueFieldFlags; override; function GetFieldFlags: TFpDbgValueFieldFlags; override;
@ -906,15 +912,15 @@ type
TDbgDwarfValueIdentifier = class(TDbgDwarfIdentifier) // var, const, member, ... TDbgDwarfValueIdentifier = class(TDbgDwarfIdentifier) // var, const, member, ...
private private
// StructureValueInfo, Member and subproc may need containing class // StructureValueInfo, Member and subproc may need containing class
FStructureValueInfo: TFpDbgSymbolBase; FStructureValueInfo: TDbgDwarfIdentifier;
procedure SetStructureValueInfo(AValue: TFpDbgSymbolBase); procedure SetStructureValueInfo(AValue: TDbgDwarfIdentifier);
protected protected
FValueObject: TFpDbgDwarfValue; FValueObject: TFpDbgDwarfValue;
FMembers: TFpDbgCircularRefCntObjList; FMembers: TFpDbgCircularRefCntObjList;
procedure CircleBackRefActiveChanged(ANewActive: Boolean); override; procedure CircleBackRefActiveChanged(ANewActive: Boolean); override;
procedure SetParentTypeInfo(AValue: TDbgDwarfIdentifier); override; procedure SetParentTypeInfo(AValue: TDbgDwarfIdentifier); override;
function GetValueAddress(AValueObj: TFpDbgDwarfValue; out AnAddress: TFpDbgMemLocation): Boolean; virtual; function GetValueAddress({%H-}AValueObj: TFpDbgDwarfValue;{%H-} out AnAddress: TFpDbgMemLocation): Boolean; virtual;
function GetValueDataAddress(AValueObj: TFpDbgDwarfValue; out AnAddress: TFpDbgMemLocation; function GetValueDataAddress(AValueObj: TFpDbgDwarfValue; out AnAddress: TFpDbgMemLocation;
ATargetType: TDbgDwarfTypeIdentifier = nil): Boolean; ATargetType: TDbgDwarfTypeIdentifier = nil): Boolean;
procedure KindNeeded; override; procedure KindNeeded; override;
@ -928,7 +934,7 @@ type
destructor Destroy; override; destructor Destroy; override;
class function CreateValueSubClass(AName: String; AnInformationEntry: TDwarfInformationEntry): TDbgDwarfValueIdentifier; class function CreateValueSubClass(AName: String; AnInformationEntry: TDwarfInformationEntry): TDbgDwarfValueIdentifier;
property StructureValueInfo: TFpDbgSymbolBase read FStructureValueInfo write SetStructureValueInfo; property StructureValueInfo: TDbgDwarfIdentifier read FStructureValueInfo write SetStructureValueInfo;
end; end;
{ TDbgDwarfValueLocationIdentifier } { TDbgDwarfValueLocationIdentifier }
@ -1164,7 +1170,6 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
.ParentTypeInfo --> nil .ParentTypeInfo --> nil
ParentTypeInfo: has a weak RefCount (only AddRef, if self has other refs) ParentTypeInfo: has a weak RefCount (only AddRef, if self has other refs)
StructureValueInfo: weak Ref (Struct has a ref to member, via parent)
AnObject = TDbgDwarfIdentifierVariable AnObject = TDbgDwarfIdentifierVariable
@ -1184,7 +1189,6 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
FField = TDbgDwarfIdentifierMember (declared in TBarBase) FField = TDbgDwarfIdentifierMember (declared in TBarBase)
|-- .TypeInfo --> Integer = TDbgDwarfBaseIdentifierBase [*1] |-- .TypeInfo --> Integer = TDbgDwarfBaseIdentifierBase [*1]
|-- .ParentTypeInfo --> TBarBase |-- .ParentTypeInfo --> TBarBase
|-- .StructureValueInfo --> AnObject
[*1] May have TDbgDwarfTypeIdentifierDeclaration or others [*1] May have TDbgDwarfTypeIdentifierDeclaration or others
*) *)
@ -1935,8 +1939,8 @@ begin
// FAddrObj.RefCount: hold by self // FAddrObj.RefCount: hold by self
i := 1; i := 1;
// FAddrObj.RefCount: hold by FResVal (ignore only, if FResVAl is not hold by others) // FAddrObj.RefCount: hold by FLastMember (ignore only, if FLastMember is not hold by others)
if (FResVal <> nil) and (FResVal.RefCount = 1) then if (FLastMember <> nil) and (FLastMember.RefCount = 1) then
i := 2; i := 2;
if (FAddrObj = nil) or (FAddrObj.RefCount > i) then begin if (FAddrObj = nil) or (FAddrObj.RefCount > i) then begin
FAddrObj.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FAddrObj, 'TDbgDwarfArraySymbolValue'){$ENDIF}; FAddrObj.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FAddrObj, 'TDbgDwarfArraySymbolValue'){$ENDIF};
@ -1947,15 +1951,15 @@ begin
FAddrObj.Update(Addr); FAddrObj.Update(Addr);
end; end;
if (FResVal = nil) or (FResVal.RefCount > 1) then begin if (FLastMember = nil) or (FLastMember.RefCount > 1) then begin
FResVal.ReleaseReference; SetLastMember(TFpDbgDwarfValue(FOwner.TypeInfo.TypeCastValue(FAddrObj)));
FResVal := FOwner.TypeInfo.TypeCastValue(FAddrObj); FLastMember.ReleaseReference;
end end
else begin else begin
TFpDbgDwarfValue(FResVal).SetTypeCastInfo(TDbgDwarfTypeIdentifier(FOwner.TypeInfo), FAddrObj); TFpDbgDwarfValue(FLastMember).SetTypeCastInfo(TDbgDwarfTypeIdentifier(FOwner.TypeInfo), FAddrObj);
end; end;
Result := FResVal; Result := FLastMember;
end; end;
function TFpDbgDwarfValueArray.GetMemberCount: Integer; function TFpDbgDwarfValueArray.GetMemberCount: Integer;
@ -2037,7 +2041,6 @@ end;
destructor TFpDbgDwarfValueArray.Destroy; destructor TFpDbgDwarfValueArray.Destroy;
begin begin
FAddrObj.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FAddrObj, 'TDbgDwarfArraySymbolValue'){$ENDIF}; FAddrObj.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FAddrObj, 'TDbgDwarfArraySymbolValue'){$ENDIF};
FResVal.ReleaseReference;
inherited Destroy; inherited Destroy;
end; end;
@ -2681,10 +2684,9 @@ begin
FMembers := TFpDbgCircularRefCntObjList.Create; FMembers := TFpDbgCircularRefCntObjList.Create;
FMembers.Add(tmp); FMembers.Add(tmp);
TDbgDwarfValueIdentifier(tmp).StructureValueInfo := Self;
Result := tmp.Value; Result := tmp.Value;
end; end;
SetLastMember(TFpDbgDwarfValue(Result));
end; end;
function TFpDbgDwarfValueStructTypeCast.GetMember(AIndex: Integer): TFpDbgValue; function TFpDbgDwarfValueStructTypeCast.GetMember(AIndex: Integer): TFpDbgValue;
@ -2702,10 +2704,9 @@ begin
FMembers := TFpDbgCircularRefCntObjList.Create; FMembers := TFpDbgCircularRefCntObjList.Create;
FMembers.Add(tmp); FMembers.Add(tmp);
TDbgDwarfValueIdentifier(tmp).StructureValueInfo := Self;
Result := tmp.Value; Result := tmp.Value;
end; end;
SetLastMember(TFpDbgDwarfValue(Result));
end; end;
function TFpDbgDwarfValueStructTypeCast.GetMemberCount: Integer; function TFpDbgDwarfValueStructTypeCast.GetMemberCount: Integer;
@ -2812,6 +2813,18 @@ begin
Result := FOwner.FCU.FAddressSize; Result := FOwner.FCU.FAddressSize;
end; end;
procedure TFpDbgDwarfValue.SetStructureValue(AValue: TFpDbgDwarfValue);
begin
if FStructureValue = AValue then
exit;
if CircleBackRefsActive and (FStructureValue <> nil) then
FStructureValue.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FStructureValue, 'TDbgDwarfSymbolValue'){$ENDIF};
FStructureValue := AValue;
if CircleBackRefsActive and (FStructureValue <> nil) then
FStructureValue.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FStructureValue, 'TDbgDwarfSymbolValue'){$ENDIF};
end;
function TFpDbgDwarfValue.GetLastError: TFpError; function TFpDbgDwarfValue.GetLastError: TFpError;
begin begin
Result := FLastError; Result := FLastError;
@ -2937,15 +2950,42 @@ end;
procedure TFpDbgDwarfValue.DoReferenceAdded; procedure TFpDbgDwarfValue.DoReferenceAdded;
begin begin
inherited DoReferenceAdded; inherited DoReferenceAdded;
if (FValueSymbol <> nil) and (RefCount = 2) then DoPlainReferenceAdded;
FValueSymbol.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FValueSymbol, 'TDbgDwarfSymbolValue'){$ENDIF};
end; end;
procedure TFpDbgDwarfValue.DoReferenceReleased; procedure TFpDbgDwarfValue.DoReferenceReleased;
begin begin
inherited DoReferenceReleased; inherited DoReferenceReleased;
if (FValueSymbol <> nil) and (RefCount = 1) then DoPlainReferenceReleased;
NilThenReleaseRef(FValueSymbol {$IFDEF WITH_REFCOUNT_DEBUG}, @FValueSymbol, 'TDbgDwarfSymbolValue'{$ENDIF}); end;
procedure TFpDbgDwarfValue.CircleBackRefActiveChanged(NewActive: Boolean);
begin
inherited CircleBackRefActiveChanged(NewActive);
if NewActive then;
if CircleBackRefsActive then begin
if FValueSymbol <> nil then
FValueSymbol.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FValueSymbol, 'TDbgDwarfSymbolValue'){$ENDIF};
if FStructureValue <> nil then
FStructureValue.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FStructureValue, 'TDbgDwarfSymbolValue'){$ENDIF};
end
else begin
if FValueSymbol <> nil then
FValueSymbol.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FValueSymbol, 'TDbgDwarfSymbolValue'){$ENDIF};
if FStructureValue <> nil then
FStructureValue.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FStructureValue, 'TDbgDwarfSymbolValue'){$ENDIF};
end;
end;
procedure TFpDbgDwarfValue.SetLastMember(ALastMember: TFpDbgDwarfValue);
begin
if FLastMember <> nil then
FLastMember.ReleaseCirclularReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FLastMember, 'TDbgDwarfSymbolValue'){$ENDIF};
FLastMember := ALastMember;
if FLastMember <> nil then begin
FLastMember.SetStructureValue(Self);
FLastMember.AddCirclularReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FLastMember, 'TDbgDwarfSymbolValue'){$ENDIF};
end;
end; end;
function TFpDbgDwarfValue.GetKind: TDbgSymbolKind; function TFpDbgDwarfValue.GetKind: TDbgSymbolKind;
@ -2988,6 +3028,7 @@ begin
if m <> nil then if m <> nil then
Result := m.Value; Result := m.Value;
end; end;
SetLastMember(TFpDbgDwarfValue(Result));
end; end;
function TFpDbgDwarfValue.GetMember(AIndex: Integer): TFpDbgValue; function TFpDbgDwarfValue.GetMember(AIndex: Integer): TFpDbgValue;
@ -3000,6 +3041,7 @@ begin
if m <> nil then if m <> nil then
Result := m.Value; Result := m.Value;
end; end;
SetLastMember(TFpDbgDwarfValue(Result));
end; end;
function TFpDbgDwarfValue.GetDbgSymbol: TFpDbgSymbol; function TFpDbgDwarfValue.GetDbgSymbol: TFpDbgSymbol;
@ -3033,6 +3075,7 @@ destructor TFpDbgDwarfValue.Destroy;
begin begin
ReleaseRefAndNil(FTypeCastTargetType); ReleaseRefAndNil(FTypeCastTargetType);
ReleaseRefAndNil(FTypeCastSourceValue); ReleaseRefAndNil(FTypeCastSourceValue);
SetLastMember(nil);
inherited Destroy; inherited Destroy;
end; end;
@ -3040,10 +3083,11 @@ procedure TFpDbgDwarfValue.SetValueSymbol(AValueSymbol: TDbgDwarfValueIdentifier
begin begin
if FValueSymbol = AValueSymbol then if FValueSymbol = AValueSymbol then
exit; exit;
if (FValueSymbol <> nil) and (RefCount >= 2) then
if CircleBackRefsActive and (FValueSymbol <> nil) then
FValueSymbol.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FValueSymbol, 'TDbgDwarfSymbolValue'){$ENDIF}; FValueSymbol.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FValueSymbol, 'TDbgDwarfSymbolValue'){$ENDIF};
FValueSymbol := AValueSymbol; FValueSymbol := AValueSymbol;
if (FValueSymbol <> nil) and (RefCount >= 2) then if CircleBackRefsActive and (FValueSymbol <> nil) then
FValueSymbol.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FValueSymbol, 'TDbgDwarfSymbolValue'){$ENDIF}; FValueSymbol.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FValueSymbol, 'TDbgDwarfSymbolValue'){$ENDIF};
end; end;
@ -3143,9 +3187,14 @@ begin
if (ti = nil) or not (ti.SymbolType = stType) then exit; if (ti = nil) or not (ti.SymbolType = stType) then exit;
FValueObject := TDbgDwarfTypeIdentifier(ti).GetTypedValueObject(False); FValueObject := TDbgDwarfTypeIdentifier(ti).GetTypedValueObject(False);
FValueObject.MakePlainRefToCirclular;
if FValueObject <> nil then if FValueObject <> nil then
FValueObject.SetValueSymbol(self); FValueObject.SetValueSymbol(self);
// Used as reference to "self"
if StructureValueInfo <> nil then
FValueObject.SetStructureValue(TFpDbgDwarfValue(StructureValueInfo.Value)); // TODO: on request only
Result := FValueObject; Result := FValueObject;
end; end;
@ -5345,6 +5394,7 @@ begin
if Result <> nil then exit; if Result <> nil then exit;
FValueObject := TFpDbgDwarfValueEnumMember.Create(Self); FValueObject := TFpDbgDwarfValueEnumMember.Create(Self);
FValueObject.MakePlainRefToCirclular;
FValueObject.SetValueSymbol(self); FValueObject.SetValueSymbol(self);
Result := FValueObject; Result := FValueObject;
@ -5645,7 +5695,7 @@ end;
{ TDbgDwarfValueIdentifier } { TDbgDwarfValueIdentifier }
procedure TDbgDwarfValueIdentifier.SetStructureValueInfo(AValue: TFpDbgSymbolBase); procedure TDbgDwarfValueIdentifier.SetStructureValueInfo(AValue: TDbgDwarfIdentifier);
begin begin
if FStructureValueInfo = AValue then Exit; if FStructureValueInfo = AValue then Exit;
@ -5809,7 +5859,8 @@ begin
FreeAndNil(FMembers); FreeAndNil(FMembers);
if FValueObject <> nil then begin if FValueObject <> nil then begin
FValueObject.SetValueSymbol(nil); FValueObject.SetValueSymbol(nil);
ReleaseRefAndNil(FValueObject); FValueObject.ReleaseCirclularReference;
FValueObject := nil;
end; end;
ParentTypeInfo := nil; ParentTypeInfo := nil;
inherited Destroy; inherited Destroy;
@ -6032,23 +6083,13 @@ begin
if not Result then if not Result then
exit; exit;
if (StructureValueInfo <> nil) and (ParentTypeInfo <> nil) then begin if (AValueObj <> nil) and (AValueObj.StructureValue <> nil) and (ParentTypeInfo <> nil) then begin
Assert((ParentTypeInfo is TDbgDwarfIdentifier) and (ParentTypeInfo.SymbolType = stType), ''); Assert((ParentTypeInfo is TDbgDwarfIdentifier) and (ParentTypeInfo.SymbolType = stType), '');
if AValueObj.StructureValue.GetDwarfDataAddress(BaseAddr, TDbgDwarfTypeIdentifier(ParentTypeInfo)) then begin
if StructureValueInfo is TDbgDwarfValueIdentifier then begin
if TDbgDwarfValueIdentifier(StructureValueInfo).GetValueDataAddress(AValueObj, BaseAddr, TDbgDwarfTypeIdentifier(ParentTypeInfo)) then begin
ALocationParser.FStack.Push(BaseAddr, lseValue);
exit
end;
end
else
if StructureValueInfo is TFpDbgDwarfValueStructTypeCast then begin
if TFpDbgDwarfValueStructTypeCast(StructureValueInfo).GetDwarfDataAddress(BaseAddr, TDbgDwarfTypeIdentifier(ParentTypeInfo)) then begin
ALocationParser.FStack.Push(BaseAddr, lseValue); ALocationParser.FStack.Push(BaseAddr, lseValue);
exit exit
end; end;
end; end;
end;
debugln(FPDBG_DWARF_ERRORS, ['DWARF ERROR in TDbgDwarfIdentifierMember.InitLocationParser Error: ',ErrorCode(LastError),' ValueObject=', DbgSName(FValueObject)]); debugln(FPDBG_DWARF_ERRORS, ['DWARF ERROR in TDbgDwarfIdentifierMember.InitLocationParser Error: ',ErrorCode(LastError),' ValueObject=', DbgSName(FValueObject)]);
if not IsError(LastError) then if not IsError(LastError) then
@ -6064,17 +6105,7 @@ end;
function TDbgDwarfIdentifierMember.HasAddress: Boolean; function TDbgDwarfIdentifierMember.HasAddress: Boolean;
begin begin
Result := (FStructureValueInfo <> nil) and (FInformationEntry.HasAttrib(DW_AT_data_member_location)); Result := (FInformationEntry.HasAttrib(DW_AT_data_member_location));
if not Result then
exit;
if FStructureValueInfo is TDbgDwarfIdentifier then
Result := (TDbgDwarfIdentifier(FStructureValueInfo).HasAddress)
else
if FStructureValueInfo is TFpDbgValue then begin
Assert(FStructureValueInfo is TFpDbgDwarfValueStructTypeCast);
// Todo: move check to TDbgDwarfStructTypeCastSymbolValue
Result := TFpDbgDwarfValue(FStructureValueInfo).HasDwarfDataAddress;
end;
end; end;
{ TDbgDwarfIdentifierStructure } { TDbgDwarfIdentifierStructure }
@ -6949,7 +6980,7 @@ begin
Result := TDbgDwarfValueIdentifier.CreateValueSubClass('self', InfoEntry); Result := TDbgDwarfValueIdentifier.CreateValueSubClass('self', InfoEntry);
FSelfParameter := Result; FSelfParameter := Result;
{$IFDEF WITH_REFCOUNT_DEBUG}FSelfParameter.DbgRenameReference(@FSelfParameter, 'FSelfParameter');{$ENDIF} {$IFDEF WITH_REFCOUNT_DEBUG}FSelfParameter.DbgRenameReference(@FSelfParameter, 'FSelfParameter');{$ENDIF}
//FSelfParameter.ParentTypeInfo := Self; //FSelfParameter.DbgSymbol.ParentTypeInfo := Self;
debugln(FPDBG_DWARF_SEARCH, ['TDbgDwarfProcSymbol.GetSelfParameter ', dbgs(InfoEntry.FScope, FCU), DbgSName(Result)]); debugln(FPDBG_DWARF_SEARCH, ['TDbgDwarfProcSymbol.GetSelfParameter ', dbgs(InfoEntry.FScope, FCU), DbgSName(Result)]);
end; end;
end; end;