From ebcb804bf17bd398837f60e3c2863ac1e4e9a992 Mon Sep 17 00:00:00 2001 From: martin Date: Thu, 30 Jan 2014 14:15:31 +0000 Subject: [PATCH] FPDebug: more Value handling git-svn-id: trunk@43852 - --- components/fpdebug/fpdbgdwarf.pas | 39 ++- components/fpdebug/fpdbginfo.pas | 56 +++- components/fpdebug/fppascalparser.pas | 444 +++++++++++++------------- 3 files changed, 311 insertions(+), 228 deletions(-) diff --git a/components/fpdebug/fpdbgdwarf.pas b/components/fpdebug/fpdbgdwarf.pas index 99c5821bc5..d2de32b399 100644 --- a/components/fpdebug/fpdbgdwarf.pas +++ b/components/fpdebug/fpdbgdwarf.pas @@ -590,13 +590,15 @@ type private FOwner: TDbgDwarfValueIdentifier; // nor refcounted protected + procedure DoReferenceAdded; override; + procedure DoReferenceReleased; override; function GetKind: TDbgSymbolKind; override; + function GetAddress: TDbgPtr; override; function GetMemberCount: Integer; override; function GetMemberByName(AIndex: String): TDbgSymbolValue; override; function GetMember(AIndex: Integer): TDbgSymbolValue; override; function GetDbgSymbol: TDbgSymbol; override; public - constructor Create; procedure SetOwner(AOwner: TDbgDwarfValueIdentifier); // SourceValue: TDbgSymbolValue end; @@ -1653,6 +1655,20 @@ end; { TDbgDwarfSymbolValue } +procedure TDbgDwarfSymbolValue.DoReferenceAdded; +begin + inherited DoReferenceAdded; + if (FOwner <> nil) and (RefCount = 2) then + FOwner.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FOwner, 'TDbgDwarfSymbolValue'){$ENDIF}; +end; + +procedure TDbgDwarfSymbolValue.DoReferenceReleased; +begin + inherited DoReferenceReleased; + if (FOwner <> nil) and (RefCount = 1) then + FOwner.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FOwner, 'TDbgDwarfSymbolValue'){$ENDIF}; +end; + function TDbgDwarfSymbolValue.GetKind: TDbgSymbolKind; begin if FOwner <> nil then @@ -1661,6 +1677,14 @@ begin Result := inherited GetKind; end; +function TDbgDwarfSymbolValue.GetAddress: TDbgPtr; +begin + if FOwner <> nil then + Result := FOwner.Address + else + Result := inherited GetAddress; +end; + function TDbgDwarfSymbolValue.GetMemberCount: Integer; begin if FOwner <> nil then @@ -1698,15 +1722,15 @@ begin Result := FOwner; end; -constructor TDbgDwarfSymbolValue.Create; -begin - inherited Create; - AddReference; -end; - procedure TDbgDwarfSymbolValue.SetOwner(AOwner: TDbgDwarfValueIdentifier); begin + if FOwner = AOwner then + exit; + if (FOwner <> nil) and (RefCount >= 2) then + FOwner.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FOwner, 'TDbgDwarfSymbolValue'){$ENDIF}; FOwner := AOwner; + if (FOwner <> nil) and (RefCount >= 2) then + FOwner.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FOwner, 'TDbgDwarfSymbolValue'){$ENDIF}; end; { TDbgDwarfIdentifierParameter } @@ -4418,6 +4442,7 @@ begin Result := False; if InheritedLoc then begin // TODO, only keep address, if failed because there was no tag. + // LocationFromTag calls InitLocationParser, whirh calls interited GetStructureBaseAddress if LocationFromTag(DW_AT_data_member_location, t) then begin AnAddress := t; Result := True; diff --git a/components/fpdebug/fpdbginfo.pas b/components/fpdebug/fpdbginfo.pas index 215c5768ac..e39ce6753b 100644 --- a/components/fpdebug/fpdbginfo.pas +++ b/components/fpdebug/fpdbginfo.pas @@ -91,20 +91,30 @@ type { TDbgSymbolValue } TDbgSymbolValue = class(TRefCountedObject) + private protected + function GetKind: TDbgSymbolKind; virtual; function GetAsBool: Boolean; virtual; function GetAsCardinal: QWord; virtual; function GetAsInteger: Int64; virtual; function GetAsString: AnsiString; virtual; function GetAsWideString: WideString; virtual; - function GetKind: TDbgSymbolKind; virtual; + + function GetAddress: TDbgPtr; virtual; + function GetSize: Integer; virtual; + function GetDataAddress: TDbgPtr; virtual; + function GetDataSize: Integer; virtual; + function GetMember(AIndex: Integer): TDbgSymbolValue; virtual; function GetMemberByName(AIndex: String): TDbgSymbolValue; virtual; function GetMemberCount: Integer; virtual; function GetDbgSymbol: TDbgSymbol; virtual; + function GetTypeInfo: TDbgSymbol; virtual; public + constructor Create; // Kind: determines which types of value are available property Kind: TDbgSymbolKind read GetKind; + // AvailableInfo: set of (svInteger, svCardinal... svAddress); property AsInteger: Int64 read GetAsInteger; property AsCardinal: QWord read GetAsCardinal; @@ -113,7 +123,12 @@ type property AsWideString: WideString read GetAsWideString; // complex // double - // memdump / Address / Size / Memory + + property Address: TDbgPtr read GetAddress; // Address of variable + property Size: Integer read GetSize; // Size of variable + property DataAddress: TDbgPtr read GetDataAddress; // Address of Data, if avail (e.g. String, TObject, ..., BUT NOT record) + property DataSize: Integer read GetDataSize; // Sive of Data, if avail (e.g. String, TObject, ..., BUT NOT record) + // memdump public (* Member: For TypeInfo (skType) it excludes BaseClass @@ -127,6 +142,7 @@ type (* DbgSymbol: The TDbgSymbol from which this value came, maybe nil. Maybe a stType, then there is no Value *) property DbgSymbol: TDbgSymbol read GetDbgSymbol; + property TypeInfo: TDbgSymbol read GetTypeInfo; end; { TDbgSymbol } @@ -239,7 +255,7 @@ type property HasOrdinalValue: Boolean read GetHasOrdinalValue; property OrdinalValue: Int64 read GetOrdinalValue; // need typecast for QuadWord - //TypeCastValue(AValue: TDbgSymbolValue): TDbgSymbolValue; + //function TypeCastValue(AValue: TDbgSymbolValue): TDbgSymbolValue; end; { TDbgSymbolForwarder } @@ -327,6 +343,20 @@ begin Result := nil; end; +constructor TDbgSymbolValue.Create; +begin + inherited Create; + AddReference; +end; + +function TDbgSymbolValue.GetTypeInfo: TDbgSymbol; +begin + if (DbgSymbol <> nil) and (DbgSymbol.SymbolType = stValue) then + Result := DbgSymbol.TypeInfo + else + Result := nil; +end; + function TDbgSymbolValue.GetKind: TDbgSymbolKind; begin Result := skNone; @@ -347,6 +377,26 @@ begin Result := 0; end; +function TDbgSymbolValue.GetAddress: TDbgPtr; +begin + Result := 0; +end; + +function TDbgSymbolValue.GetDataAddress: TDbgPtr; +begin + Result := 0; +end; + +function TDbgSymbolValue.GetDataSize: Integer; +begin + Result := 0; +end; + +function TDbgSymbolValue.GetSize: Integer; +begin + Result := 0; +end; + function TDbgSymbolValue.GetAsBool: Boolean; begin Result := False; diff --git a/components/fpdebug/fppascalparser.pas b/components/fpdebug/fppascalparser.pas index 17c2f8af2b..3fdf694aef 100644 --- a/components/fpdebug/fppascalparser.pas +++ b/components/fpdebug/fppascalparser.pas @@ -50,7 +50,6 @@ type FTextExpression: String; FExpressionPart: TFpPascalExpressionPart; FValid: Boolean; - function GetResultType: TDbgSymbol; function GetResultValue: TDbgSymbolValue; procedure Parse; procedure SetError(AMsg: String); @@ -64,7 +63,6 @@ type function DebugDump: String; property Error: String read FError; property Valid: Boolean read FValid; - //property ResultType: TDbgSymbol read GetResultType; deprecated; property ResultValue: TDbgSymbolValue read GetResultValue; // May be a type, if expression is a type end; @@ -77,12 +75,8 @@ type FParent: TFpPascalExpressionPartContainer; FStartChar: PChar; FExpression: TFpPascalExpression; - FResultType: TDbgSymbol; - FResultTypeFlag: (rtUnknown, rtType, rtTypeCast); FResultValue: TDbgSymbolValue; FResultValDone: Boolean; - function GetResultType: TDbgSymbol; - function GetResultTypeCast: TDbgSymbol; function GetResultValue: TDbgSymbolValue; function GetSurroundingOpenBracket: TFpPascalExpressionPartBracket; function GetTopParent: TFpPascalExpressionPart; @@ -96,7 +90,6 @@ type function DebugDump(AIndent: String): String; virtual; protected procedure Init; virtual; - function DoGetResultType: TDbgSymbol; virtual; function DoGetIsTypeCast: Boolean; virtual; function DoGetResultValue: TDbgSymbolValue; virtual; @@ -124,8 +117,6 @@ type property Parent: TFpPascalExpressionPartContainer read FParent write SetParent; property TopParent: TFpPascalExpressionPart read GetTopParent; // or self property SurroundingBracket: TFpPascalExpressionPartBracket read GetSurroundingOpenBracket; // incl self - property ResultType: TDbgSymbol read GetResultType; deprecated; - property ResultTypeCast: TDbgSymbol read GetResultTypeCast; deprecated; property ResultValue: TDbgSymbolValue read GetResultValue; end; @@ -155,14 +146,10 @@ type { TFpPascalExpressionPartIdentifer } TFpPascalExpressionPartIdentifer = class(TFpPascalExpressionPartContainer) - private - FDbgSymbol: TDbgSymbol; protected - function DoGetResultType: TDbgSymbol; override; + //function DoGetResultType: TDbgSymbol; override; function DoGetIsTypeCast: Boolean; override; function DoGetResultValue: TDbgSymbolValue; override; - public - destructor Destroy; override; end; TFpPascalExpressionPartConstant = class(TFpPascalExpressionPartContainer) @@ -191,7 +178,7 @@ type { TFpPascalExpressionPartBracket } TFpPascalExpressionPartBracket = class(TFpPascalExpressionPartWithPrecedence) - // ome, but not all bracket expr have precedence + // some, but not all bracket expr have precedence private FIsClosed: boolean; FIsClosing: boolean; @@ -219,7 +206,7 @@ type TFpPascalExpressionPartBracketSubExpression = class(TFpPascalExpressionPartRoundBracket) protected function HandleNextPartInBracket(APart: TFpPascalExpressionPart): TFpPascalExpressionPart; override; - function DoGetResultType: TDbgSymbol; override; + //function DoGetResultType: TDbgSymbol; override; function DoGetResultValue: TDbgSymbolValue; override; end; @@ -229,7 +216,7 @@ type // function arguments or type cast // this acts a operator: first element is the function/type protected procedure Init; override; - function DoGetResultType: TDbgSymbol; override; + //function DoGetResultType: TDbgSymbol; override; function DoGetIsTypeCast: Boolean; override; function IsValidAfterPart(APrevPart: TFpPascalExpressionPart): Boolean; override; function HandleNextPartInBracket(APart: TFpPascalExpressionPart): TFpPascalExpressionPart; override; @@ -256,7 +243,7 @@ type // array[1] protected procedure Init; override; - function DoGetResultType: TDbgSymbol; override; + //function DoGetResultType: TDbgSymbol; override; function IsValidAfterPart(APrevPart: TFpPascalExpressionPart): Boolean; override; function HandleNextPartInBracket(APart: TFpPascalExpressionPart): TFpPascalExpressionPart; override; function MaybeHandlePrevPart(APrevPart: TFpPascalExpressionPart; @@ -303,7 +290,7 @@ type TFpPascalExpressionPartOperatorAddressOf = class(TFpPascalExpressionPartUnaryOperator) // @ protected procedure Init; override; - function DoGetResultType: TDbgSymbol; override; + function DoGetResultValue: TDbgSymbolValue; override; end; { TFpPascalExpressionPartOperatorMakeRef } @@ -312,7 +299,7 @@ type protected procedure Init; override; function IsValidNextPart(APart: TFpPascalExpressionPart): Boolean; override; - function DoGetResultType: TDbgSymbol; override; + function DoGetResultValue: TDbgSymbolValue; override; function DoGetIsTypeCast: Boolean; override; end; @@ -321,7 +308,7 @@ type TFpPascalExpressionPartOperatorDeRef = class(TFpPascalExpressionPartUnaryOperator) // ptrval^ protected procedure Init; override; - function DoGetResultType: TDbgSymbol; override; + function DoGetResultValue: TDbgSymbolValue; override; function MaybeHandlePrevPart(APrevPart: TFpPascalExpressionPart; var AResult: TFpPascalExpressionPart): Boolean; override; function FindLeftSideOperandByPrecedence({%H-}AnOperator: TFpPascalExpressionPartWithPrecedence): @@ -360,7 +347,6 @@ type protected procedure Init; override; function IsValidNextPart(APart: TFpPascalExpressionPart): Boolean; override; - function DoGetResultType: TDbgSymbol; override; function DoGetResultValue: TDbgSymbolValue; override; end; @@ -380,32 +366,6 @@ const type - { TPasParserWrapperSymbolValue } - - TPasParserWrapperSymbolValue = class(TDbgSymbolValue) - private - FSymbol: TDbgSymbol; - protected - function GetKind: TDbgSymbolKind; override; - function GetDbgSymbol: TDbgSymbol; override; - public - constructor Create(ATypeInfo: TDbgSymbol); - end; - - { TPasParserConstNumberSymbolValue } - - TPasParserConstNumberSymbolValue = class(TDbgSymbolValue) - private - FValue: QWord; - FSigned: Boolean; - protected - function GetKind: TDbgSymbolKind; override; - function GetAsCardinal: QWord; override; - function GetAsInteger: Int64; override; - public - constructor Create(AValue: QWord; ASigned: Boolean = False); - end; - { TPasParserSymbolPointer } TPasParserSymbolPointer = class(TDbgSymbol) @@ -433,6 +393,100 @@ type destructor Destroy; override; end; + { TPasParserWrapperSymbolValue } + + TPasParserWrapperSymbolValue = class(TDbgSymbolValue) + private + FSymbol: TDbgSymbol; + protected + function GetKind: TDbgSymbolKind; override; + function GetDbgSymbol: TDbgSymbol; override; + public + constructor Create(ATypeInfo: TDbgSymbol); + destructor Destroy; override; + end; + + { TPasParserConstNumberSymbolValue } + + TPasParserConstNumberSymbolValue = class(TDbgSymbolValue) + private + FValue: QWord; + FSigned: Boolean; + protected + function GetKind: TDbgSymbolKind; override; + function GetAsCardinal: QWord; override; + function GetAsInteger: Int64; override; + public + constructor Create(AValue: QWord; ASigned: Boolean = False); + end; + + { TPasParserAddressOfSymbolValue } + + TPasParserAddressOfSymbolValue = class(TDbgSymbolValue) + private + FValue: TDbgSymbolValue; + FTypeInfo: TDbgSymbol; + function GetPointedToValue: TDbgSymbolValue; + protected + function GetKind: TDbgSymbolKind; override; + function GetAsInteger: Int64; override; + function GetAsCardinal: QWord; override; + function GetTypeInfo: TDbgSymbol; override; + public + constructor Create(AValue: TDbgSymbolValue); + destructor Destroy; override; + property PointedToValue: TDbgSymbolValue read GetPointedToValue; + end; + +{ TPasParserAddressOfSymbolValue } + +function TPasParserAddressOfSymbolValue.GetPointedToValue: TDbgSymbolValue; +begin + Result := FValue; +end; + +function TPasParserAddressOfSymbolValue.GetKind: TDbgSymbolKind; +begin + Result := skPointer; +end; + +function TPasParserAddressOfSymbolValue.GetAsInteger: Int64; +begin + Result := Int64(FValue.Address); +end; + +function TPasParserAddressOfSymbolValue.GetAsCardinal: QWord; +begin + Result := QWord(FValue.Address); +end; + +function TPasParserAddressOfSymbolValue.GetTypeInfo: TDbgSymbol; +begin + Result := FTypeInfo; + if Result <> nil then + exit; + if FValue.TypeInfo = nil then + exit; + + FTypeInfo := TPasParserSymbolPointer.Create(FValue.TypeInfo); + {$IFDEF WITH_REFCOUNT_DEBUG}FTypeInfo.DbgRenameReference(@FTypeInfo, 'TPasParserAddressOfSymbolValue');{$ENDIF} + Result := FTypeInfo; +end; + +constructor TPasParserAddressOfSymbolValue.Create(AValue: TDbgSymbolValue); +begin + inherited Create; + FValue := AValue; + FValue.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FValue, 'TPasParserAddressOfSymbolValue'){$ENDIF}; +end; + +destructor TPasParserAddressOfSymbolValue.Destroy; +begin + inherited Destroy; + FValue.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FValue, 'TPasParserAddressOfSymbolValue'){$ENDIF}; + FTypeInfo.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FTypeInfo, 'TPasParserAddressOfSymbolValue'){$ENDIF}; +end; + { TPasParserConstNumberSymbolValue } function TPasParserConstNumberSymbolValue.GetKind: TDbgSymbolKind; @@ -476,6 +530,13 @@ constructor TPasParserWrapperSymbolValue.Create(ATypeInfo: TDbgSymbol); begin inherited Create; FSymbol := ATypeInfo; + FSymbol.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FSymbol, 'TPasParserWrapperSymbolValue'){$ENDIF}; +end; + +destructor TPasParserWrapperSymbolValue.Destroy; +begin + inherited Destroy; + FSymbol.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FSymbol, 'TPasParserWrapperSymbolValue'){$ENDIF}; end; { TPasParserSymbolArrayDeIndex } @@ -536,39 +597,39 @@ begin inherited Init; end; -function TFpPascalExpressionPartBracketIndex.DoGetResultType: TDbgSymbol; -var - tmp: TDbgSymbol; -begin - Result := nil; - if Count <> 2 then exit; - - tmp := Items[0].ResultType; - if tmp = nil then exit; - - if (tmp.Kind = skArray) then begin - // TODO: check type of index - if tmp.MemberCount < 1 then exit; // TODO error - if tmp.MemberCount = 1 then begin - Result := tmp.TypeInfo; - Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultType'){$ENDIF}; - exit; - end; - - Result := TPasParserSymbolArrayDeIndex.Create(tmp); - end - else - if (tmp.Kind = skPointer) then begin - Result := tmp.TypeInfo; - Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultType'){$ENDIF}; - exit; - end - else - if (tmp.Kind = skString) then begin - //TODO - exit; - end; -end; +//function TFpPascalExpressionPartBracketIndex.DoGetResultType: TDbgSymbol; +//var +// tmp: TDbgSymbol; +//begin +// Result := nil; +// if Count <> 2 then exit; +// +// tmp := Items[0].ResultType; +// if tmp = nil then exit; +// +// if (tmp.Kind = skArray) then begin +// // TODO: check type of index +// if tmp.MemberCount < 1 then exit; // TODO error +// if tmp.MemberCount = 1 then begin +// Result := tmp.TypeInfo; +// Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultType'){$ENDIF}; +// exit; +// end; +// +// Result := TPasParserSymbolArrayDeIndex.Create(tmp); +// end +// else +// if (tmp.Kind = skPointer) then begin +// Result := tmp.TypeInfo; +// Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultType'){$ENDIF}; +// exit; +// end +// else +// if (tmp.Kind = skString) then begin +// //TODO +// exit; +// end; +//end; function TFpPascalExpressionPartBracketIndex.IsValidAfterPart(APrevPart: TFpPascalExpressionPart): Boolean; begin @@ -657,22 +718,22 @@ begin inherited Init; end; -function TFpPascalExpressionPartBracketArgumentList.DoGetResultType: TDbgSymbol; -begin - Result := nil; - - if (Count = 2) then begin - Result := Items[0].ResultTypeCast; - if Result <> nil then begin - // This is a typecast - // TODO: verify cast compatibilty - Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultType'){$ENDIF}; - exit; - end; - end; - - Result := inherited DoGetResultType; -end; +//function TFpPascalExpressionPartBracketArgumentList.DoGetResultType: TDbgSymbol; +//begin +// Result := nil; +// +// if (Count = 2) then begin +// Result := Items[0].ResultTypeCast; +// if Result <> nil then begin +// // This is a typecast +// // TODO: verify cast compatibilty +// Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultType'){$ENDIF}; +// exit; +// end; +// end; +// +// Result := inherited DoGetResultType; +//end; function TFpPascalExpressionPartBracketArgumentList.DoGetIsTypeCast: Boolean; begin @@ -750,15 +811,15 @@ begin Add(APart); end; -function TFpPascalExpressionPartBracketSubExpression.DoGetResultType: TDbgSymbol; -begin - if Count <> 1 then - Result := nil - else - Result := Items[0].ResultType; - if Result <> nil then - Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultType'){$ENDIF}; -end; +//function TFpPascalExpressionPartBracketSubExpression.DoGetResultType: TDbgSymbol; +//begin +// if Count <> 1 then +// Result := nil +// else +// Result := Items[0].ResultType; +// if Result <> nil then +// Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultType'){$ENDIF}; +//end; function TFpPascalExpressionPartBracketSubExpression.DoGetResultValue: TDbgSymbolValue; begin @@ -772,21 +833,21 @@ end; { TFpPascalExpressionPartIdentifer } -function TFpPascalExpressionPartIdentifer.DoGetResultType: TDbgSymbol; -begin - Result := ResultValue.DbgSymbol; - if Result = nil then - exit; - - case Result.SymbolType of - stValue: Result := Result.TypeInfo; - stType: Result := Result; - else Result := nil; - end; - - if Result <> nil then - Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultType'){$ENDIF}; -end; +//function TFpPascalExpressionPartIdentifer.DoGetResultType: TDbgSymbol; +//begin +// Result := ResultValue.DbgSymbol; +// if Result = nil then +// exit; +// +// case Result.SymbolType of +// stValue: Result := Result.TypeInfo; +// stType: Result := Result; +// else Result := nil; +// end; +// +// if Result <> nil then +// Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultType'){$ENDIF}; +//end; function TFpPascalExpressionPartIdentifer.DoGetIsTypeCast: Boolean; begin @@ -794,28 +855,23 @@ begin end; function TFpPascalExpressionPartIdentifer.DoGetResultValue: TDbgSymbolValue; +var + DbgSymbol: TDbgSymbol; begin Result := nil; - // Need to keep a ref, because ValueObject might not reference its owner - assert(FDbgSymbol = nil, 'TFpPascalExpressionPartIdentifer.DoGetResultValue: not yet done'); - FDbgSymbol := FExpression.GetDbgSymbolForIdentifier(GetText); - {$IFDEF WITH_REFCOUNT_DEBUG}if FDbgSymbol <> nil then FDbgSymbol.DbgRenameReference(FDbgSymbol, 'DoGetResultValue'){$ENDIF}; - - if FDbgSymbol = nil then + DbgSymbol := FExpression.GetDbgSymbolForIdentifier(GetText); + if DbgSymbol = nil then exit; - Result := FDbgSymbol.Value; + + Result := DbgSymbol.Value; if Result = nil then begin - Result := TPasParserWrapperSymbolValue.Create(FDbgSymbol); - if Result <> nil then Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultValue'){$ENDIF}; + Result := TPasParserWrapperSymbolValue.Create(DbgSymbol); + {$IFDEF WITH_REFCOUNT_DEBUG}Result.DbgRenameReference(nil, 'DoGetResultValue'){$ENDIF}; end else Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultValue'){$ENDIF}; -end; -destructor TFpPascalExpressionPartIdentifer.Destroy; -begin - inherited Destroy; - FDbgSymbol.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(FDbgSymbol, 'DoGetResultValue'){$ENDIF}; + DbgSymbol.ReleaseReference; // hold via value end; { TFpPascalExpressionPartConstantNumber } @@ -823,7 +879,7 @@ end; function TFpPascalExpressionPartConstantNumber.DoGetResultValue: TDbgSymbolValue; begin Result := TPasParserConstNumberSymbolValue.Create(StrToQWordDef(GetText, 0)); - Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultValue'){$ENDIF}; + {$IFDEF WITH_REFCOUNT_DEBUG}Result.DbgRenameReference(nil, 'DoGetResultValue'){$ENDIF}; end; { TFpPascalExpressionPartOperatorUnaryPlusMinus } @@ -997,14 +1053,6 @@ begin FExpressionPart := CurPart; end; -function TFpPascalExpression.GetResultType: TDbgSymbol; -begin - if (FExpressionPart = nil) or (not Valid) then - Result := nil - else - Result := FExpressionPart.ResultType; -end; - function TFpPascalExpression.GetResultValue: TDbgSymbolValue; begin if (FExpressionPart = nil) or (not Valid) then @@ -1081,34 +1129,6 @@ begin Result := TFpPascalExpressionPartBracket(tmp); end; -function TFpPascalExpressionPart.GetResultType: TDbgSymbol; -begin - if FResultTypeFlag = rtUnknown then begin - FResultType := DoGetResultType; - if DoGetIsTypeCast - then FResultTypeFlag := rtTypeCast - else FResultTypeFlag := rtType; - end; - if FResultTypeFlag = rtType then - Result := FResultType - else - Result := nil; -end; - -function TFpPascalExpressionPart.GetResultTypeCast: TDbgSymbol; -begin - if FResultTypeFlag = rtUnknown then begin - FResultType := DoGetResultType; - if DoGetIsTypeCast - then FResultTypeFlag := rtTypeCast - else FResultTypeFlag := rtType; - end; - if FResultTypeFlag = rtTypeCast then - Result := FResultType - else - Result := nil; -end; - function TFpPascalExpressionPart.GetResultValue: TDbgSymbolValue; begin Result := FResultValue; @@ -1162,11 +1182,6 @@ begin // end; -function TFpPascalExpressionPart.DoGetResultType: TDbgSymbol; -begin - Result := nil; -end; - function TFpPascalExpressionPart.DoGetIsTypeCast: Boolean; begin Result := False; @@ -1242,7 +1257,7 @@ begin FExpression := AExpression; FStartChar := AStartChar; FEndChar := AnEndChar; - FResultTypeFlag := rtUnknown; + //FResultTypeFlag := rtUnknown; FResultValDone := False; Init; end; @@ -1250,7 +1265,7 @@ end; destructor TFpPascalExpressionPart.Destroy; begin inherited Destroy; - FResultType.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultType'){$ENDIF}; + //FResultType.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultType'){$ENDIF}; FResultValue.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultValue'){$ENDIF}; end; @@ -1549,16 +1564,19 @@ begin inherited Init; end; -function TFpPascalExpressionPartOperatorAddressOf.DoGetResultType: TDbgSymbol; +function TFpPascalExpressionPartOperatorAddressOf.DoGetResultValue: TDbgSymbolValue; +var + tmp: TDbgSymbolValue; begin Result := nil; if Count <> 1 then exit; - Result := Items[0].ResultType; - if Result = nil then + tmp := Items[0].ResultValue; + if (tmp = nil) or (tmp.Address = 0) then exit; - Result := TPasParserSymbolPointer.Create(Result); - {$IFDEF WITH_REFCOUNT_DEBUG}Result.DbgRenameReference(nil, 'DoGetResultType');{$ENDIF} + + Result := TPasParserAddressOfSymbolValue.Create(tmp); + {$IFDEF WITH_REFCOUNT_DEBUG}Result.DbgRenameReference(nil, 'DoGetResultValue');{$ENDIF} end; { TFpPascalExpressionPartOperatorMakeRef } @@ -1580,16 +1598,19 @@ begin ); end; -function TFpPascalExpressionPartOperatorMakeRef.DoGetResultType: TDbgSymbol; +function TFpPascalExpressionPartOperatorMakeRef.DoGetResultValue: TDbgSymbolValue; +var + tmp: TDbgSymbolValue; begin Result := nil; if Count <> 1 then exit; - Result := Items[0].ResultTypeCast; - if Result = nil then + tmp := Items[0].ResultValue; + if (tmp.DbgSymbol = nil) or (tmp.DbgSymbol.SymbolType <> stType) then exit; - Result := TPasParserSymbolPointer.Create(Result); - {$IFDEF WITH_REFCOUNT_DEBUG}Result.DbgRenameReference(nil, 'DoGetResultType');{$ENDIF} + + Result := TPasParserWrapperSymbolValue.Create(TPasParserSymbolPointer.Create(tmp.DbgSymbol)); + {$IFDEF WITH_REFCOUNT_DEBUG}Result.DbgRenameReference(nil, 'DoGetResultValue');{$ENDIF} end; function TFpPascalExpressionPartOperatorMakeRef.DoGetIsTypeCast: Boolean; @@ -1605,23 +1626,30 @@ begin inherited Init; end; -function TFpPascalExpressionPartOperatorDeRef.DoGetResultType: TDbgSymbol; +function TFpPascalExpressionPartOperatorDeRef.DoGetResultValue: TDbgSymbolValue; +var + tmp: TDbgSymbolValue; begin Result := nil; if Count <> 1 then exit; - Result := Items[0].ResultType; - if Result = nil then - exit;; + tmp := Items[0].ResultValue; + if tmp = nil then + exit; - if Result.Kind = skPointer then - Result := Result.TypeInfo - //if Result.Kind = skArray then // dynarray + if tmp is TPasParserAddressOfSymbolValue then begin + Result := TPasParserAddressOfSymbolValue(tmp).PointedToValue; + Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultValue'){$ENDIF}; + end + else + if tmp.Kind = skPointer then begin + // TODO + //Result := Result.TypeInfo; + end + //if tmp.Kind = skArray then // dynarray else Result := nil; - if Result <> nil then - Result.AddReference; end; function TFpPascalExpressionPartOperatorDeRef.MaybeHandlePrevPart(APrevPart: TFpPascalExpressionPart; @@ -1684,25 +1712,6 @@ begin Result := Result and (APart is TFpPascalExpressionPartIdentifer); end; -function TFpPascalExpressionPartOperatorMemberOf.DoGetResultType: TDbgSymbol; -var - tmp: TDbgSymbol; -begin - Result := nil; - if Count <> 2 then exit; - - tmp := Items[0].ResultType; - if tmp = nil then exit; - // Todo unit - if (tmp.Kind = skClass) or (tmp.Kind = skRecord) then begin - tmp := tmp.MemberByName[Items[1].GetText]; - if (tmp <> nil) and (tmp.SymbolType = stValue) then begin - Result := tmp.TypeInfo; - Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultType'){$ENDIF}; - end; - end; -end; - function TFpPascalExpressionPartOperatorMemberOf.DoGetResultValue: TDbgSymbolValue; var tmp: TDbgSymbolValue; @@ -1713,7 +1722,6 @@ begin tmp := Items[0].ResultValue; if (tmp = nil) then exit; // Todo unit - // TODO MAy need AddReference for the symbol if (tmp.Kind = skClass) or (tmp.Kind = skRecord) then begin Result := tmp.MemberByName[Items[1].GetText]; if Result <> nil then