paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-01 22:20:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDebug: refactor, each value in an expression keeps its own context (prepare for fpc nested proc)

Browse Source 
git-svn-id: trunk@44611 -
This commit is contained in:
martin 2014-04-05 22:27:53 +00:00
parent be67c54950
commit 79bd1ed96f
5 changed files with 387 additions and 125 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

224
components/fpdebug/fpdbgdwarf.pas
View File

@ -35,6 +35,15 @@
unit FpDbgDwarf;
{$mode objfpc}{$H+}
{off $INLINE OFF}
(* Notes:
* FpDbgDwarfValues and Context
The Values do not add a reference to the Context. Yet they require the Context.
It is the users responsibility to keep the context, as long as any value exists.
*)
interface
@ -77,6 +86,7 @@ type
function SymbolToValue(ASym: TFpDbgSymbol): TFpDbgValue; inline;
procedure AddRefToVal(AVal: TFpDbgValue); inline;
function GetSelfParameter: TFpDbgValue; virtual;
function FindExportedSymbolInUnits(const AName: String; PNameUpper, PNameLower: PChar;
SkipCompUnit: TDwarfCompilationUnit): TFpDbgValue; inline;
@ -100,9 +110,33 @@ type
TDbgDwarfTypeIdentifierClass = class of TDbgDwarfTypeIdentifier;
{%region Value objects }
{ TFpDbgDwarfValueBase }
TFpDbgDwarfValueBase = class(TFpDbgValue)
private
FContext: TDbgInfoAddressContext;
public
property Context: TDbgInfoAddressContext read FContext;
end;
{ TFpDbgDwarfValueTypeDefinition }
TFpDbgDwarfValueTypeDefinition = class(TFpDbgDwarfValueBase)
private
FSymbol: TFpDbgSymbol; // stType
protected
function GetKind: TDbgSymbolKind; override;
function GetDbgSymbol: TFpDbgSymbol; override;
public
constructor Create(ASymbol: TFpDbgSymbol); // Only for stType
destructor Destroy; override;
function GetTypeCastedValue(ADataVal: TFpDbgValue): TFpDbgValue; override;
end;
{ TFpDbgDwarfValue }
TFpDbgDwarfValue = class(TFpDbgValue)
TFpDbgDwarfValue = class(TFpDbgDwarfValueBase)
private
FOwner: TDbgDwarfTypeIdentifier; // the creator, usually the type
FValueSymbol: TDbgDwarfValueIdentifier;
@ -239,12 +273,16 @@ type
TFpDbgDwarfValuePointer = class(TFpDbgDwarfValueNumeric)
private
FLastAddrMember: TFpDbgValue;
FPointetToAddr: TFpDbgMemLocation;
protected
function GetAsCardinal: QWord; override;
function GetFieldFlags: TFpDbgValueFieldFlags; override;
function GetDataAddress: TFpDbgMemLocation; override;
function GetAsString: AnsiString; override;
function GetMember(AIndex: Int64): TFpDbgValue; override;
public
destructor Destroy; override;
end;
{ TFpDbgDwarfValueEnum }
@ -452,7 +490,7 @@ type
TDbgDwarfValueLocationIdentifier = class(TDbgDwarfValueIdentifier)
private
procedure FrameBaseNeeded(ASender: TObject);
procedure FrameBaseNeeded(ASender: TObject); // Sender = TDwarfLocationExpression
protected
function GetValueObject: TFpDbgValue; override;
function InitLocationParser(const ALocationParser: TDwarfLocationExpression;
@ -779,7 +817,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
function StateMachineValid: Boolean;
function ReadVirtuality(out AFlags: TDbgSymbolFlags): Boolean;
protected
function GetFrameBase: TDbgPtr;
function GetFrameBase(ASender: TDwarfLocationExpression): TDbgPtr;
procedure KindNeeded; override;
procedure SizeNeeded; override;
function GetFlags: TDbgSymbolFlags; override;
@ -926,7 +964,7 @@ begin
Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FlastResult, 'FindSymbol'){$ENDIF};
end
else begin
Result := TFpDbgValueTypeDeclaration.Create(ASym);
Result := TFpDbgDwarfValueTypeDefinition.Create(ASym);
{$IFDEF WITH_REFCOUNT_DEBUG}Result.DbgRenameReference(@FlastResult, 'FindSymbol'){$ENDIF};
end;
ASym.ReleaseReference;
@ -937,6 +975,13 @@ begin
AVal.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FlastResult, 'FindSymbol'){$ENDIF};
end;
function TDbgDwarfInfoAddressContext.GetSelfParameter: TFpDbgValue;
begin
Result := TDbgDwarfProcSymbol(FSymbol).GetSelfParameter(FAddress);
if TFpDbgDwarfValueBase(Result).FContext = nil then
TFpDbgDwarfValueBase(Result).FContext := Self;
end;
function TDbgDwarfInfoAddressContext.FindExportedSymbolInUnits(const AName: String;
PNameUpper, PNameLower: PChar; SkipCompUnit: TDwarfCompilationUnit): TFpDbgValue;
var
@ -1002,7 +1047,7 @@ var
InfoEntryInheritance: TDwarfInformationEntry;
FwdInfoPtr: Pointer;
FwdCompUint: TDwarfCompilationUnit;
SelfParam: TFpDbgDwarfValue;
SelfParam: TFpDbgValue;
begin
Result := nil;
InfoEntry.AddReference;
@ -1015,7 +1060,7 @@ begin
if InfoEntry.GoNamedChildEx(PNameUpper, PNameLower) then begin
if InfoEntry.IsAddressInStartScope(FAddress) then begin
SelfParam := TDbgDwarfProcSymbol(FSymbol).GetSelfParameter(FAddress);
SelfParam := GetSelfParameter;
if (SelfParam <> nil) then begin
// TODO: only valid, as long as context is valid, because if context is freed, then self is lost too
Result := SelfParam.MemberByName[AName];
@ -1169,15 +1214,59 @@ begin
FlastResult.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FlastResult, 'FindSymbol'){$ENDIF};
FlastResult := Result;
assert((Result = nil) or (Result is TFpDbgDwarfValueBase), 'TDbgDwarfInfoAddressContext.FindSymbol: (Result = nil) or (Result is TFpDbgDwarfValueBase)');
if (Result <> nil) and (TFpDbgDwarfValueBase(Result).FContext = nil) then
TFpDbgDwarfValueBase(Result).FContext := Self;
end;
end;
{ TFpDbgDwarfValueTypeDefinition }
function TFpDbgDwarfValueTypeDefinition.GetKind: TDbgSymbolKind;
begin
Result := skNone;
end;
function TFpDbgDwarfValueTypeDefinition.GetDbgSymbol: TFpDbgSymbol;
begin
Result := FSymbol;
end;
constructor TFpDbgDwarfValueTypeDefinition.Create(ASymbol: TFpDbgSymbol);
begin
inherited Create;
FSymbol := ASymbol;
FSymbol.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FSymbol, 'TFpDbgDwarfValueTypeDefinition'){$ENDIF};
end;
destructor TFpDbgDwarfValueTypeDefinition.Destroy;
begin
inherited Destroy;
FSymbol.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FSymbol, 'TFpDbgDwarfValueTypeDefinition'){$ENDIF};
end;
function TFpDbgDwarfValueTypeDefinition.GetTypeCastedValue(ADataVal: TFpDbgValue): TFpDbgValue;
begin
Result := FSymbol.TypeCastValue(ADataVal);
assert((Result = nil) or (Result is TFpDbgDwarfValue), 'TFpDbgDwarfValueTypeDefinition.GetTypeCastedValue: (Result = nil) or (Result is TFpDbgDwarfValue)');
if (Result <> nil) and (TFpDbgDwarfValue(Result).FContext = nil) then
TFpDbgDwarfValue(Result).FContext := FContext;
end;
{ TFpDbgDwarfValue }
function TFpDbgDwarfValue.MemManager: TFpDbgMemManager;
begin
assert((FOwner <> nil) and (FOwner.CompilationUnit <> nil) and (FOwner.CompilationUnit.Owner <> nil), 'TDbgDwarfSymbolValue.MemManager');
Result := FOwner.CompilationUnit.Owner.MemManager;
Result := nil;
if FContext <> nil then
Result := FContext.MemManager;
if Result = nil then begin
// Either a typecast, or a member gotten from a typecast,...
assert((FOwner <> nil) and (FOwner.CompilationUnit <> nil) and (FOwner.CompilationUnit.Owner <> nil), 'TDbgDwarfSymbolValue.MemManager');
Result := FOwner.CompilationUnit.Owner.MemManager;
end;
end;
function TFpDbgDwarfValue.GetDataAddressCache(AIndex: Integer): TFpDbgMemLocation;
@ -1390,10 +1479,14 @@ 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
if (FLastMember <> nil) then begin
FLastMember.SetStructureValue(Self);
FLastMember.AddCirclularReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FLastMember, 'TDbgDwarfSymbolValue'){$ENDIF};
if (FLastMember.FContext = nil) then
FLastMember.FContext := FContext;
end;
end;
@ -1490,8 +1583,8 @@ end;
destructor TFpDbgDwarfValue.Destroy;
begin
ReleaseRefAndNil(FTypeCastTargetType);
ReleaseRefAndNil(FTypeCastSourceValue);
FTypeCastTargetType.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FTypeCastTargetType, ClassName+'.FTypeCastTargetType'){$ENDIF};
FTypeCastSourceValue.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FTypeCastSourceValue, ClassName+'.FTypeCastSourceValue'){$ENDIF};
SetLastMember(nil);
inherited Destroy;
end;
@ -1515,18 +1608,18 @@ begin
if FTypeCastSourceValue <> ASource then begin
if FTypeCastSourceValue <> nil then
FTypeCastSourceValue.ReleaseReference;
FTypeCastSourceValue.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FTypeCastSourceValue, ClassName+'.FTypeCastSourceValue'){$ENDIF};
FTypeCastSourceValue := ASource;
if FTypeCastSourceValue <> nil then
FTypeCastSourceValue.AddReference;
FTypeCastSourceValue.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FTypeCastSourceValue, ClassName+'.FTypeCastSourceValue'){$ENDIF};
end;
if FTypeCastTargetType <> AStructure then begin
if FTypeCastTargetType <> nil then
FTypeCastTargetType.ReleaseReference;
FTypeCastTargetType.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FTypeCastTargetType, ClassName+'.FTypeCastTargetType'){$ENDIF};
FTypeCastTargetType := AStructure;
if FTypeCastTargetType <> nil then
FTypeCastTargetType.AddReference;
FTypeCastTargetType.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FTypeCastTargetType, ClassName+'.FTypeCastTargetType'){$ENDIF};
end;
Result := IsValidTypeCast;
@ -1795,6 +1888,53 @@ begin
Result := inherited GetAsString;
end;
function TFpDbgDwarfValuePointer.GetMember(AIndex: Int64): TFpDbgValue;
var
ti: TFpDbgSymbol;
addr: TFpDbgMemLocation;
Tmp: TFpDbgDwarfValueConstAddress;
begin
//TODO: ?? if no TypeInfo.TypeInfo;, then return TFpDbgDwarfValueConstAddress.Create(addr); (for mem dump)
Result := nil;
ReleaseRefAndNil(FLastAddrMember);
if (TypeInfo = nil) then begin // TODO dedicanted error code
FLastError := CreateError(fpErrAnyError, ['Can not dereference an untyped pointer']);
exit;
end;
// TODO re-use last member
ti := TypeInfo.TypeInfo;
{$PUSH}{$R-}{$Q-} // TODO: check overflow
if ti <> nil then
AIndex := AIndex * ti.Size;
addr := DataAddress;
if not IsTargetAddr(addr) then begin
FLastError := CreateError(fpErrAnyError, ['Internal dereference error']);
exit;
end;
addr.Address := addr.Address + AIndex;
{$POP}
Tmp := TFpDbgDwarfValueConstAddress.Create(addr);
if ti <> nil then begin
Result := ti.TypeCastValue(Tmp);
Tmp.ReleaseReference;
SetLastMember(TFpDbgDwarfValue(Result));
Result.ReleaseReference;
end
else begin
Result := Tmp;
FLastAddrMember := Result;
end;
end;
destructor TFpDbgDwarfValuePointer.Destroy;
begin
FLastAddrMember.ReleaseReference;
inherited Destroy;
end;
{ TFpDbgDwarfValueEnum }
procedure TFpDbgDwarfValueEnum.InitMemberIndex;
@ -2667,7 +2807,7 @@ begin
//exit;
end;
LocationParser := TDwarfLocationExpression.Create(@Val[0], Length(Val), CompilationUnit);
LocationParser := TDwarfLocationExpression.Create(@Val[0], Length(Val), CompilationUnit, AValueObj.MemManager);
InitLocationParser(LocationParser, AValueObj, AnObjectDataAddress);
LocationParser.Evaluate;
@ -2872,7 +3012,7 @@ begin
FreeAndNil(FMembers);
if FValueObject <> nil then begin
FValueObject.SetValueSymbol(nil);
FValueObject.ReleaseCirclularReference;
FValueObject.ReleaseCirclularReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FValueObject, ClassName+'.FValueObject'){$ENDIF};
FValueObject := nil;
end;
ParentTypeInfo := nil;
@ -2910,7 +3050,7 @@ begin
p := ParentTypeInfo;
// TODO: what if parent is declaration?
if (p <> nil) and (p is TDbgDwarfProcSymbol) then begin
fb := TDbgDwarfProcSymbol(p).GetFrameBase;
fb := TDbgDwarfProcSymbol(p).GetFrameBase(ASender as TDwarfLocationExpression);
(ASender as TDwarfLocationExpression).FrameBase := fb;
if fb = 0 then begin
debugln(FPDBG_DWARF_ERRORS, ['DWARF ERROR in TDbgDwarfValueLocationIdentifier.FrameBaseNeeded result is 0']);
@ -2938,6 +3078,7 @@ begin
if (ti = nil) or not (ti.SymbolType = stType) then exit;
FValueObject := TDbgDwarfTypeIdentifier(ti).GetTypedValueObject(False);
{$IFDEF WITH_REFCOUNT_DEBUG}FValueObject.DbgRenameReference(@FValueObject, ClassName+'.FValueObject');{$ENDIF}
if FValueObject <> nil then begin
FValueObject.MakePlainRefToCirclular;
FValueObject.SetValueSymbol(self);
@ -3136,10 +3277,10 @@ begin
AnAddress := t;
end
else begin
Result := CompilationUnit.Owner.MemManager <> nil;
Result := AValueObj.MemManager <> nil;
if not Result then
exit;
AnAddress := CompilationUnit.Owner.MemManager.ReadAddress(AnAddress, CompilationUnit.AddressSize);
AnAddress := AValueObj.MemManager.ReadAddress(AnAddress, CompilationUnit.AddressSize);
AValueObj.DataAddressCache[ATargetCacheIndex] := AnAddress;
end;
Result := IsValidLoc(AnAddress);
@ -3147,8 +3288,8 @@ begin
if Result then
Result := inherited GetDataAddress(AValueObj, AnAddress, ATargetType, ATargetCacheIndex)
else
if IsError(CompilationUnit.Owner.MemManager.LastError) then
SetLastError(CompilationUnit.Owner.MemManager.LastError);
if IsError(AValueObj.MemManager.LastError) then
SetLastError(AValueObj.MemManager.LastError);
// Todo: other error
end;
@ -3494,10 +3635,10 @@ begin
AnAddress := t;
end
else begin
Result := CompilationUnit.Owner.MemManager <> nil;
Result := AValueObj.MemManager <> nil;
if not Result then
exit;
AnAddress := CompilationUnit.Owner.MemManager.ReadAddress(AnAddress, CompilationUnit.AddressSize);
AnAddress := AValueObj.MemManager.ReadAddress(AnAddress, CompilationUnit.AddressSize);
AValueObj.DataAddressCache[ATargetCacheIndex] := AnAddress;
end;
Result := IsValidLoc(AnAddress);
@ -3505,8 +3646,8 @@ begin
if Result then
Result := inherited GetDataAddress(AValueObj, AnAddress, ATargetType, ATargetCacheIndex)
else
if IsError(CompilationUnit.Owner.MemManager.LastError) then
SetLastError(CompilationUnit.Owner.MemManager.LastError);
if IsError(AValueObj.MemManager.LastError) then
SetLastError(AValueObj.MemManager.LastError);
// Todo: other error
end;
@ -3564,6 +3705,7 @@ begin
if Result <> nil then exit;
FValueObject := TFpDbgDwarfValueEnumMember.Create(Self);
{$IFDEF WITH_REFCOUNT_DEBUG}FValueObject.DbgRenameReference(@FValueObject, ClassName+'.FValueObject');{$ENDIF}
FValueObject.MakePlainRefToCirclular;
FValueObject.SetValueSymbol(self);
@ -4263,7 +4405,7 @@ begin
end;
end;
function TDbgDwarfProcSymbol.GetFrameBase: TDbgPtr;
function TDbgDwarfProcSymbol.GetFrameBase(ASender: TDwarfLocationExpression): TDbgPtr;
var
Val: TByteDynArray;
begin
@ -4281,22 +4423,22 @@ begin
exit;
end;
FFrameBaseParser := TDwarfLocationExpression.Create(@Val[0], Length(Val), CompilationUnit);
FFrameBaseParser := TDwarfLocationExpression.Create(@Val[0], Length(Val), CompilationUnit, ASender.MemManager);
FFrameBaseParser.Evaluate;
if FFrameBaseParser.ResultKind in [lseValue] then
Result := FFrameBaseParser.ResultData;
if IsError(FFrameBaseParser.LastError) then begin
SetLastError(FFrameBaseParser.LastError);
debugln(FPDBG_DWARF_ERRORS, ['TDbgDwarfProcSymbol.GetFrameBase location parser failed ', ErrorHandler.ErrorAsString(LastError)]);
end
else
if Result = 0 then begin
debugln(FPDBG_DWARF_ERRORS, ['TDbgDwarfProcSymbol.GetFrameBase location parser failed. result is 0']);
end;
end;
if FFrameBaseParser.ResultKind in [lseValue] then
Result := FFrameBaseParser.ResultData;
if IsError(FFrameBaseParser.LastError) then begin
SetLastError(FFrameBaseParser.LastError);
debugln(FPDBG_DWARF_ERRORS, ['TDbgDwarfProcSymbol.GetFrameBase location parser failed ', ErrorHandler.ErrorAsString(LastError)]);
end
else
if Result = 0 then begin
debugln(FPDBG_DWARF_ERRORS, ['TDbgDwarfProcSymbol.GetFrameBase location parser failed. result is 0']);
end;
end;
procedure TDbgDwarfProcSymbol.KindNeeded;

34
components/fpdebug/fpdbgdwarfdataclasses.pas
View File

@ -648,9 +648,11 @@ type
FCU: TDwarfCompilationUnit;
FData: PByte;
FMaxData: PByte;
FMemManager: TFpDbgMemManager;
public
//TODO: caller keeps data, and determines livetime of data
constructor Create(AExpressionData: Pointer; AMaxCount: Integer; ACU: TDwarfCompilationUnit);
constructor Create(AExpressionData: Pointer; AMaxCount: Integer; ACU: TDwarfCompilationUnit;
AMemManager: TFpDbgMemManager);
procedure Evaluate;
function ResultKind: TDwarfLocationStackEntryKind;
function ResultData: TDbgPtr;
@ -658,6 +660,7 @@ type
property FrameBase: TDbgPtr read FFrameBase write FFrameBase;
property OnFrameBaseNeeded: TNotifyEvent read FOnFrameBaseNeeded write FOnFrameBaseNeeded;
property LastError: TFpError read FLastError;
property MemManager: TFpDbgMemManager read FMemManager;
end;
function ULEB128toOrdinal(var p: PByte): QWord;
@ -1710,31 +1713,30 @@ end;
{ TDwarfLocationExpression }
constructor TDwarfLocationExpression.Create(AExpressionData: Pointer; AMaxCount: Integer;
ACU: TDwarfCompilationUnit);
ACU: TDwarfCompilationUnit; AMemManager: TFpDbgMemManager);
begin
FStack.Clear;
FCU := ACU;
FData := AExpressionData;
FMaxData := FData + AMaxCount;
FMaxData := FData + AMaxCount;FMemManager := AMemManager;
end;
procedure TDwarfLocationExpression.Evaluate;
var
CurInstr, CurData: PByte;
MemManager: TFpDbgMemManager;
AddrSize: Byte;
procedure SetError(AnInternalErrorCode: TFpErrorCode = fpErrNoError);
begin
FStack.Push(InvalidLoc, lseError); // Mark as failed
if IsError(MemManager.LastError)
then FLastError := CreateError(fpErrLocationParserMemRead, MemManager.LastError, [])
if IsError(FMemManager.LastError)
then FLastError := CreateError(fpErrLocationParserMemRead, FMemManager.LastError, [])
else FLastError := CreateError(fpErrLocationParser, []);
debugln(FPDBG_DWARF_ERRORS,
['DWARF ERROR in TDwarfLocationExpression: Failed at Pos=', CurInstr-FData,
' OpCode=', IntToHex(CurInstr^, 2), ' Depth=', FStack.Count,
' Data: ', dbgMemRange(FData, FMaxData-FData),
' MemReader.LastError: ', ErrorHandler.ErrorAsString(MemManager.LastError),
' MemReader.LastError: ', ErrorHandler.ErrorAsString(FMemManager.LastError),
' Extra: ', ErrorHandler.ErrorAsString(AnInternalErrorCode, []) ]);
end;
@ -1756,7 +1758,7 @@ var
begin
//TODO: zero fill / sign extend
if (ASize > SizeOf(AValue)) or (ASize > AddrSize) then exit(False);
Result := MemManager.ReadAddress(AnAddress, ASize, AValue);
Result := FMemManager.ReadAddress(AnAddress, ASize, AValue);
if not Result then
SetError;
end;
@ -1765,7 +1767,7 @@ var
begin
//TODO: zero fill / sign extend
if (ASize > SizeOf(AValue)) or (ASize > AddrSize) then exit(False);
AValue := MemManager.ReadAddressEx(AnAddress, AnAddrSpace, ASize);
AValue := FMemManager.ReadAddressEx(AnAddress, AnAddrSpace, ASize);
Result := IsValidLoc(AValue);
if not Result then
SetError;
@ -1803,8 +1805,8 @@ var
Entry, Entry2: TDwarfLocationStackEntry;
begin
AddrSize := FCU.FAddressSize;
MemManager := FCU.FOwner.MemManager;
MemManager.ClearLastError;
FMemManager := FCU.FOwner.FMemManager;
FMemManager.ClearLastError;
FLastError := NoError;
CurData := FData;
while CurData < FMaxData do begin
@ -1853,14 +1855,14 @@ begin
DW_OP_lit0..DW_OP_lit31: FStack.Push(CurInstr^-DW_OP_lit0, lseValue);
DW_OP_reg0..DW_OP_reg31: begin
if not MemManager.ReadRegister(CurInstr^-DW_OP_reg0, NewValue) then begin
if not FMemManager.ReadRegister(CurInstr^-DW_OP_reg0, NewValue) then begin
SetError;
exit;
end;
FStack.Push(NewValue, lseRegister);
end;
DW_OP_regx: begin
if not MemManager.ReadRegister(ULEB128toOrdinal(CurData), NewValue) then begin
if not FMemManager.ReadRegister(ULEB128toOrdinal(CurData), NewValue) then begin
SetError;
exit;
end;
@ -1868,7 +1870,7 @@ begin
end;
DW_OP_breg0..DW_OP_breg31: begin
if not MemManager.ReadRegister(CurInstr^-DW_OP_breg0, NewValue) then begin
if not FMemManager.ReadRegister(CurInstr^-DW_OP_breg0, NewValue) then begin
SetError;
exit;
end;
@ -1877,7 +1879,7 @@ begin
{$POP}
end;
DW_OP_bregx: begin
if not MemManager.ReadRegister(ULEB128toOrdinal(CurData), NewValue) then begin
if not FMemManager.ReadRegister(ULEB128toOrdinal(CurData), NewValue) then begin
SetError;
exit;
end;
@ -2417,6 +2419,7 @@ end;
constructor TDwarfInformationEntry.Create(ACompUnit: TDwarfCompilationUnit;
AnInformationEntry: Pointer);
begin
inherited Create;
AddReference;
FCompUnit := ACompUnit;
FInformationEntry := AnInformationEntry;
@ -2426,6 +2429,7 @@ end;
constructor TDwarfInformationEntry.Create(ACompUnit: TDwarfCompilationUnit;
AScope: TDwarfScopeInfo);
begin
inherited Create;
AddReference;
FCompUnit := ACompUnit;
FScope := AScope;

2
components/fpdebug/fpdbgdwarffreepascal.pas
View File

@ -59,7 +59,7 @@ var
StartScopeIdx: Integer;
begin
if (Length(AName) = length(selfname)) and (CompareUtf8BothCase(PNameUpper, PNameLower, @selfname[1])) then begin
Result := TDbgDwarfProcSymbol(Symbol).GetSelfParameter(Address);
Result := GetSelfParameter;
if Result <> nil then begin
AddRefToVal(Result);
exit;

21
components/fpdebug/fpdbginfo.pas
View File

@ -191,6 +191,7 @@ type
property OrdHighBound: Int64 read GetOrdHighBound; // need typecast for QuadWord
// memdump
public
function GetTypeCastedValue(ADataVal: TFpDbgValue): TFpDbgValue; virtual; // only if Symbol is a type
// base class? Or Member includes member from base
(* Member:
* skClass, skStructure:
@ -201,6 +202,7 @@ type
stValue: only members set in value (Only impremented for DbgSymbolValue)
* skArray: (differs from TFpDbgSymbol)
The values. The type of each Index-dimension is avail via IndexType
* skPointer: deref the pointer, with index (0 = normal deref)
NOTE: Values returned by Member/MemberByName are volatile.
They maybe released or changed when Member is called again.
To keep a returned Value a reference can be added (AddReference)
@ -254,9 +256,9 @@ type
constructor Create(AnAddress: TFpDbgMemLocation);
end;
{ TFpDbgValueTypeDeclaration }
{ TFpDbgValueTypeDefinition }
TFpDbgValueTypeDeclaration = class(TFpDbgValue)
TFpDbgValueTypeDefinition = class(TFpDbgValue)
private
FSymbol: TFpDbgSymbol; // stType
protected
@ -267,7 +269,6 @@ type
destructor Destroy; override;
end;
{ TFpDbgSymbol }
TFpDbgSymbol = class(TFpDbgSymbolBase)
@ -571,6 +572,12 @@ begin
AddReference;
end;
function TFpDbgValue.GetTypeCastedValue(ADataVal: TFpDbgValue): TFpDbgValue;
begin
assert(False, 'TFpDbgValue.GetTypeCastedValue: False');
Result := nil;
end;
function TFpDbgValue.GetTypeInfo: TFpDbgSymbol;
begin
if (DbgSymbol <> nil) and (DbgSymbol.SymbolType = stValue) then
@ -744,24 +751,24 @@ end;
{ TFpDbgValueTypeDeclaration }
function TFpDbgValueTypeDeclaration.GetKind: TDbgSymbolKind;
function TFpDbgValueTypeDefinition.GetKind: TDbgSymbolKind;
begin
Result := skNone;
end;
function TFpDbgValueTypeDeclaration.GetDbgSymbol: TFpDbgSymbol;
function TFpDbgValueTypeDefinition.GetDbgSymbol: TFpDbgSymbol;
begin
Result := FSymbol;
end;
constructor TFpDbgValueTypeDeclaration.Create(ASymbol: TFpDbgSymbol);
constructor TFpDbgValueTypeDefinition.Create(ASymbol: TFpDbgSymbol);
begin
inherited Create;
FSymbol := ASymbol;
FSymbol.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FSymbol, 'TFpDbgValueTypeDeclaration'){$ENDIF};
end;
destructor TFpDbgValueTypeDeclaration.Destroy;
destructor TFpDbgValueTypeDefinition.Destroy;
begin
inherited Destroy;
FSymbol.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FSymbol, 'TFpDbgValueTypeDeclaration'){$ENDIF};

231
components/fpdebug/fppascalparser.pas
View File

@ -392,19 +392,20 @@ type
{%region DebugSymbol }
{ TPasParserSymbolPointer
used by TPasParserSymbolValueMakeReftype.GetDbgSymbol
used by TFpPasParserValueMakeReftype.GetDbgSymbol
}
TPasParserSymbolPointer = class(TFpDbgSymbol)
private
FPointerLevels: Integer;
FPointedTo: TFpDbgSymbol;
FContext: TDbgInfoAddressContext;
protected
// NameNeeded // "^TPointedTo"
procedure TypeInfoNeeded; override;
public
constructor Create(const APointedTo: TFpDbgSymbol; APointerLevels: Integer);
constructor Create(const APointedTo: TFpDbgSymbol);
constructor Create(const APointedTo: TFpDbgSymbol; AContext: TDbgInfoAddressContext; APointerLevels: Integer);
constructor Create(const APointedTo: TFpDbgSymbol; AContext: TDbgInfoAddressContext);
destructor Destroy; override;
function TypeCastValue(AValue: TFpDbgValue): TFpDbgValue; override;
end;
@ -430,18 +431,24 @@ type
{ TFpPasParserValue }
TFpPasParserValue = class(TFpDbgValue)
private
FContext: TDbgInfoAddressContext;
protected
function DebugText(AIndent: String): String; virtual;
public
constructor Create(AContext: TDbgInfoAddressContext);
property Context: TDbgInfoAddressContext read FContext;
end;
{ TFpPasParserValueCastToPointer
used by TPasParserSymbolPointer.TypeCastValue (which is used by TPasParserSymbolValueMakeReftype.GetDbgSymbol)
used by TPasParserSymbolPointer.TypeCastValue (which is used by TFpPasParserValueMakeReftype.GetDbgSymbol)
}
TFpPasParserValueCastToPointer = class(TFpPasParserValue)
private
FValue: TFpDbgValue;
FTypeSymbol: TFpDbgSymbol;
FLastMember: TFpDbgValue;
protected
function DebugText(AIndent: String): String; override;
protected
@ -450,8 +457,9 @@ type
function GetTypeInfo: TFpDbgSymbol; override;
function GetAsCardinal: QWord; override;
function GetDataAddress: TFpDbgMemLocation; override;
function GetMember(AIndex: Int64): TFpDbgValue; override;
public
constructor Create(AValue: TFpDbgValue; ATypeInfo: TFpDbgSymbol);
constructor Create(AValue: TFpDbgValue; ATypeInfo: TFpDbgSymbol; AContext: TDbgInfoAddressContext);
destructor Destroy; override;
end;
@ -466,9 +474,10 @@ type
protected
function GetDbgSymbol: TFpDbgSymbol; override; // returns a TPasParserSymbolPointer
public
constructor Create(ATypeInfo: TFpDbgSymbol);
constructor Create(ATypeInfo: TFpDbgSymbol; AContext: TDbgInfoAddressContext);
destructor Destroy; override;
procedure IncRefLevel;
function GetTypeCastedValue(ADataVal: TFpDbgValue): TFpDbgValue; override;
end;
{ TFpPasParserValueDerefPointer
@ -478,7 +487,6 @@ type
TFpPasParserValueDerefPointer = class(TFpPasParserValue)
private
FValue: TFpDbgValue;
FExpression: TFpPascalExpression; // MemReader / AddrSize
FAddressOffset: Int64; // Add to address
FCardinal: QWord; // todo: TFpDbgMemLocation ?
FCardinalRead: Boolean;
@ -491,8 +499,8 @@ type
function GetAsCardinal: QWord; override; // reads men
function GetTypeInfo: TFpDbgSymbol; override; // TODO: Cardinal? Why? // TODO: does not handle AOffset
public
constructor Create(AValue: TFpDbgValue; AExpression: TFpPascalExpression);
constructor Create(AValue: TFpDbgValue; AExpression: TFpPascalExpression; AOffset: Int64);
constructor Create(AValue: TFpDbgValue; AContext: TDbgInfoAddressContext);
constructor Create(AValue: TFpDbgValue; AContext: TDbgInfoAddressContext; AOffset: Int64);
destructor Destroy; override;
end;
@ -502,6 +510,7 @@ type
private
FValue: TFpDbgValue;
FTypeInfo: TFpDbgSymbol;
FLastMember: TFpDbgValue;
function GetPointedToValue: TFpDbgValue;
protected
function DebugText(AIndent: String): String; override;
@ -512,8 +521,9 @@ type
function GetAsCardinal: QWord; override;
function GetTypeInfo: TFpDbgSymbol; override;
function GetDataAddress: TFpDbgMemLocation; override;
function GetMember(AIndex: Int64): TFpDbgValue; override;
public
constructor Create(AValue: TFpDbgValue);
constructor Create(AValue: TFpDbgValue; AContext: TDbgInfoAddressContext);
destructor Destroy; override;
property PointedToValue: TFpDbgValue read GetPointedToValue;
end;
@ -541,6 +551,12 @@ begin
Result := AIndent + DbgSName(Self) + ' DbsSym='+DbgSName(DbgSymbol)+' Type='+DbgSName(TypeInfo) + LineEnding;
end;
constructor TFpPasParserValue.Create(AContext: TDbgInfoAddressContext);
begin
FContext := AContext;
inherited Create;
end;
{ TPasParserSymbolValueCastToPointer }
function TFpPasParserValueCastToPointer.DebugText(AIndent: String): String;
@ -557,7 +573,8 @@ end;
function TFpPasParserValueCastToPointer.GetFieldFlags: TFpDbgValueFieldFlags;
begin
if svfCardinal in FValue.FieldFlags then
if (FValue.FieldFlags * [svfAddress, svfCardinal] <> [])
then
Result := [svfOrdinal, svfCardinal, svfSizeOfPointer, svfDataAddress]
else
Result := [];
@ -569,22 +586,61 @@ begin
end;
function TFpPasParserValueCastToPointer.GetAsCardinal: QWord;
var
f: TFpDbgValueFieldFlags;
begin
if svfCardinal in FValue.FieldFlags then
Result := 0;
f := FValue.FieldFlags;
if svfCardinal in f then
Result := FValue.AsCardinal
else
if svfAddress in f then begin
if not FContext.MemManager.ReadUnsignedInt(FValue.Address, FContext.SizeOfAddress, Result) then
Result := 0;
end
else
Result := 0;
end;
function TFpPasParserValueCastToPointer.GetDataAddress: TFpDbgMemLocation;
begin
Result := TargetLoc(TDbgPtr(FValue.AsCardinal));
Result := TargetLoc(TDbgPtr(AsCardinal));
end;
function TFpPasParserValueCastToPointer.GetMember(AIndex: Int64): TFpDbgValue;
var
ti: TFpDbgSymbol;
addr: TFpDbgMemLocation;
Tmp: TFpDbgValueConstAddress;
begin
Result := nil;
ti := FTypeSymbol.TypeInfo;
addr := DataAddress;
if not IsTargetAddr(addr) then begin
//LastError := CreateError(fpErrAnyError, ['Internal dereference error']);
exit;
end;
{$PUSH}{$R-}{$Q-} // TODO: check overflow
if ti <> nil then
AIndex := AIndex * ti.Size;
addr.Address := addr.Address + AIndex;
{$POP}
Tmp := TFpDbgValueConstAddress.Create(addr);
if ti <> nil then begin
Result := ti.TypeCastValue(Tmp);
Tmp.ReleaseReference;
end
else
Result := Tmp;
FLastMember := Result;
end;
constructor TFpPasParserValueCastToPointer.Create(AValue: TFpDbgValue;
ATypeInfo: TFpDbgSymbol);
ATypeInfo: TFpDbgSymbol; AContext: TDbgInfoAddressContext);
begin
inherited Create;
inherited Create(AContext);
FValue := AValue;
FValue.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FValue, 'TPasParserSymbolValueCastToPointer'){$ENDIF};
FTypeSymbol := ATypeInfo;
@ -594,6 +650,7 @@ end;
destructor TFpPasParserValueCastToPointer.Destroy;
begin
FLastMember.ReleaseReference;
FValue.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FValue, 'TPasParserSymbolValueCastToPointer'){$ENDIF};
FTypeSymbol.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FTypeSymbol, 'TPasParserSymbolValueCastToPointer'){$ENDIF};
inherited Destroy;
@ -612,15 +669,16 @@ end;
function TFpPasParserValueMakeReftype.GetDbgSymbol: TFpDbgSymbol;
begin
if FTypeSymbol = nil then begin
FTypeSymbol := TPasParserSymbolPointer.Create(FSourceTypeSymbol, FRefLevel);
FTypeSymbol := TPasParserSymbolPointer.Create(FSourceTypeSymbol, FContext, FRefLevel);
{$IFDEF WITH_REFCOUNT_DEBUG}FTypeSymbol.DbgRenameReference(@FSourceTypeSymbol, 'TPasParserSymbolValueMakeReftype'){$ENDIF};
end;
Result := FTypeSymbol;
end;
constructor TFpPasParserValueMakeReftype.Create(ATypeInfo: TFpDbgSymbol);
constructor TFpPasParserValueMakeReftype.Create(ATypeInfo: TFpDbgSymbol;
AContext: TDbgInfoAddressContext);
begin
inherited Create;
inherited Create(AContext);
FSourceTypeSymbol := ATypeInfo;
FSourceTypeSymbol.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FSourceTypeSymbol, 'TPasParserSymbolValueMakeReftype'){$ENDIF};
FRefLevel := 1;
@ -638,6 +696,11 @@ begin
inc(FRefLevel);
end;
function TFpPasParserValueMakeReftype.GetTypeCastedValue(ADataVal: TFpDbgValue): TFpDbgValue;
begin
Result := DbgSymbol.TypeCastValue(ADataVal);
end;
{ TPasParserDerefPointerSymbolValue }
@ -698,7 +761,7 @@ begin
Result := FCardinal;
if FCardinalRead then exit;
Ctx := FExpression.Context;
Ctx := Context;
if Ctx = nil then exit;
AddrSize := Ctx.SizeOfAddress;
if (AddrSize <= 0) or (AddrSize > SizeOf(FCardinal)) then exit;
@ -727,18 +790,17 @@ begin
end;
constructor TFpPasParserValueDerefPointer.Create(AValue: TFpDbgValue;
AExpression: TFpPascalExpression);
AContext: TDbgInfoAddressContext);
begin
Create(AValue, AExpression, 0);
Create(AValue, AContext, 0);
end;
constructor TFpPasParserValueDerefPointer.Create(AValue: TFpDbgValue;
AExpression: TFpPascalExpression; AOffset: Int64);
AContext: TDbgInfoAddressContext; AOffset: Int64);
begin
inherited Create;
inherited Create(AContext);
FValue := AValue;
FValue.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FValue, 'TPasParserDerefPointerSymbolValue'){$ENDIF};
FExpression := AExpression;
FAddressOffset := AOffset;
end;
@ -790,7 +852,7 @@ begin
if FValue.TypeInfo = nil then
exit;
FTypeInfo := TPasParserSymbolPointer.Create(FValue.TypeInfo);
FTypeInfo := TPasParserSymbolPointer.Create(FValue.TypeInfo, FContext);
{$IFDEF WITH_REFCOUNT_DEBUG}FTypeInfo.DbgRenameReference(@FTypeInfo, 'TPasParserAddressOfSymbolValue');{$ENDIF}
Result := FTypeInfo;
end;
@ -800,9 +862,44 @@ begin
Result := FValue.Address;
end;
constructor TFpPasParserValueAddressOf.Create(AValue: TFpDbgValue);
function TFpPasParserValueAddressOf.GetMember(AIndex: Int64): TFpDbgValue;
var
ti: TFpDbgSymbol;
addr: TFpDbgMemLocation;
Tmp: TFpDbgValueConstAddress;
begin
inherited Create;
if (AIndex = 0) or (FValue = nil) then begin
Result := FValue;
exit;
end;
Result := nil;
ti := FValue.TypeInfo;
addr := FValue.Address;
if not IsTargetAddr(addr) then begin
//LastError := CreateError(fpErrAnyError, ['Internal dereference error']);
exit;
end;
{$PUSH}{$R-}{$Q-} // TODO: check overflow
if ti <> nil then
AIndex := AIndex * ti.Size;
addr.Address := addr.Address + AIndex;
{$POP}
Tmp := TFpDbgValueConstAddress.Create(addr);
if ti <> nil then begin
Result := ti.TypeCastValue(Tmp);
Tmp.ReleaseReference;
end
else
Result := Tmp;
FLastMember := Result;
end;
constructor TFpPasParserValueAddressOf.Create(AValue: TFpDbgValue;
AContext: TDbgInfoAddressContext);
begin
inherited Create(AContext);
FValue := AValue;
FValue.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FValue, 'TPasParserAddressOfSymbolValue'){$ENDIF};
end;
@ -810,6 +907,7 @@ end;
destructor TFpPasParserValueAddressOf.Destroy;
begin
inherited Destroy;
FLastMember.ReleaseReference;
FValue.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FValue, 'TPasParserAddressOfSymbolValue'){$ENDIF};
FTypeInfo.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FTypeInfo, 'TPasParserAddressOfSymbolValue'){$ENDIF};
end;
@ -847,15 +945,17 @@ procedure TPasParserSymbolPointer.TypeInfoNeeded;
var
t: TPasParserSymbolPointer;
begin
t := TPasParserSymbolPointer.Create(FPointedTo, FPointerLevels-1);
assert(FPointerLevels > 1, 'TPasParserSymbolPointer.TypeInfoNeeded: FPointerLevels > 1');
t := TPasParserSymbolPointer.Create(FPointedTo, FContext, FPointerLevels-1);
SetTypeInfo(t);
t.ReleaseReference;
end;
constructor TPasParserSymbolPointer.Create(const APointedTo: TFpDbgSymbol;
APointerLevels: Integer);
AContext: TDbgInfoAddressContext; APointerLevels: Integer);
begin
inherited Create('');
FContext := AContext;
FPointerLevels := APointerLevels;
FPointedTo := APointedTo;
FPointedTo.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(FPointedTo, 'TPasParserSymbolPointer'){$ENDIF};
@ -865,9 +965,10 @@ begin
SetSymbolType(stType);
end;
constructor TPasParserSymbolPointer.Create(const APointedTo: TFpDbgSymbol);
constructor TPasParserSymbolPointer.Create(const APointedTo: TFpDbgSymbol;
AContext: TDbgInfoAddressContext);
begin
Create(APointedTo, 1);
Create(APointedTo, AContext, 1);
end;
destructor TPasParserSymbolPointer.Destroy;
@ -878,7 +979,7 @@ end;
function TPasParserSymbolPointer.TypeCastValue(AValue: TFpDbgValue): TFpDbgValue;
begin
Result := TFpPasParserValueCastToPointer.Create(AValue, Self);
Result := TFpPasParserValueCastToPointer.Create(AValue, Self, FContext);
end;
@ -931,15 +1032,15 @@ begin
end // Kind = skArray
else
if (TmpVal.Kind = skPointer) then begin
if (TmpVal.TypeInfo = nil) or (TmpVal.TypeInfo.TypeInfo = nil) or
(TmpVal.TypeInfo.TypeInfo.Size <= 0)
then begin
SetError('Can not dereference an untyped pointer');
TmpVal.ReleaseReference;
exit;
end;
//if (TmpVal.TypeInfo = nil) or (TmpVal.TypeInfo.TypeInfo = nil) or
// (TmpVal.TypeInfo.TypeInfo.Size <= 0)
//then begin
// SetError('Can not dereference an untyped pointer');
// TmpVal.ReleaseReference;
// exit;
//end;
// TODO: check svfDataAddress / readable ? (see normal pointer deref);
ti := TmpVal.TypeInfo.TypeInfo;
//ti := TmpVal.TypeInfo.TypeInfo;
if (svfInteger in TmpIndex.FieldFlags) then
Offs := TmpIndex.AsInteger
else
@ -952,12 +1053,17 @@ begin
TmpVal.ReleaseReference;
exit;
end;
{$PUSH}{$R-}{$Q-} // TODO: check overflow
Offs := Offs * ti.Size;
{$POP}
TmpDeref := TFpPasParserValueDerefPointer.Create(TmpVal, Expression, Offs);
TmpVal2 := ti.TypeCastValue(TmpDeref);
TmpDeref.ReleaseReference;
TmpVal2 := TmpVal.Member[Offs];
if IsError(TmpVal.LastError) then
SetError('Error dereferencing'); // TODO: set correct error
if TmpVal2 <> nil then TmpVal2.AddReference;
//{$PUSH}{$R-}{$Q-} // TODO: check overflow
//Offs := Offs * ti.Size;
//{$POP}
//TmpDeref := TFpPasParserValueDerefPointer.Create(TmpVal, Expression, Offs);
//TmpVal2 := ti.TypeCastValue(TmpDeref);
//TmpDeref.ReleaseReference;
end
else
if (TmpVal.Kind = skString) then begin
@ -1126,7 +1232,8 @@ begin
// This is a typecast
tmp2 := Items[1].ResultValue;
if tmp2 <> nil then
Result := tmp.DbgSymbol.TypeCastValue(tmp2);
Result := tmp.GetTypeCastedValue(tmp2);
//Result := tmp.DbgSymbol.TypeCastValue(tmp2);
if Result <> nil then
{$IFDEF WITH_REFCOUNT_DEBUG}Result.DbgRenameReference(nil, 'DoGetResultValue'){$ENDIF};
exit;
@ -2047,7 +2154,7 @@ begin
if (tmp = nil) or not IsTargetAddr(tmp.Address) then
exit;
Result := TFpPasParserValueAddressOf.Create(tmp);
Result := TFpPasParserValueAddressOf.Create(tmp, Expression.Context);
{$IFDEF WITH_REFCOUNT_DEBUG}Result.DbgRenameReference(nil, 'DoGetResultValue');{$ENDIF}
end;
@ -2090,7 +2197,7 @@ begin
if (tmp.DbgSymbol = nil) or (tmp.DbgSymbol.SymbolType <> stType) then
exit;
Result := TFpPasParserValueMakeReftype.Create(tmp.DbgSymbol);
Result := TFpPasParserValueMakeReftype.Create(tmp.DbgSymbol, Expression.Context);
{$IFDEF WITH_REFCOUNT_DEBUG}Result.DbgRenameReference(nil, 'DoGetResultValue'){$ENDIF};
end;
@ -2109,7 +2216,7 @@ end;
function TFpPascalExpressionPartOperatorDeRef.DoGetResultValue: TFpDbgValue;
var
tmp, tmp2: TFpDbgValue;
tmp: TFpDbgValue;
begin
Result := nil;
if Count <> 1 then exit;
@ -2118,7 +2225,7 @@ begin
if tmp = nil then
exit;
if tmp is TFpPasParserValueAddressOf then begin
if tmp is TFpPasParserValueAddressOf then begin // TODO: remove IF, handled in GetMember
Result := TFpPasParserValueAddressOf(tmp).PointedToValue;
Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultValue'){$ENDIF};
end
@ -2127,16 +2234,18 @@ begin
if (svfDataAddress in tmp.FieldFlags) and (IsReadableLoc(tmp.DataAddress)) and // TODO, what if Not readable addr
(tmp.TypeInfo <> nil) //and (tmp.TypeInfo.TypeInfo <> nil)
then begin
//TODO: maybe introduce a method TypeCastFromAddress, so we can skip the twp2 object
//todo, if tmp2 is a TPasParserAddressOfSymbolValue, then no new object is neede....
tmp2 := TFpPasParserValueDerefPointer.Create(tmp, Expression);
if (tmp.TypeInfo.TypeInfo <> nil) then
Result := tmp.TypeInfo.TypeInfo.TypeCastValue(tmp2)
else
Result := tmp2;
{$IFDEF WITH_REFCOUNT_DEBUG} if Result <> nil then Result.DbgRenameReference(nil, 'DoGetResultValue'){$ENDIF};
if (tmp.TypeInfo.TypeInfo <> nil) then
tmp2.ReleaseReference;
Result := tmp.Member[0];
if Result <> nil then
Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultValue'){$ENDIF};
//tmp2 := TFpPasParserValueDerefPointer.Create(tmp, Expression);
//if (tmp.TypeInfo.TypeInfo <> nil) then
// Result := tmp.TypeInfo.TypeInfo.TypeCastValue(tmp2)
//else
// Result := tmp2;
//{$IFDEF WITH_REFCOUNT_DEBUG} if Result <> nil then Result.DbgRenameReference(nil, 'DoGetResultValue'){$ENDIF};
//if (tmp.TypeInfo.TypeInfo <> nil) then
// tmp2.ReleaseReference;
end;
end
//if tmp.Kind = skArray then // dynarray