mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-19 14:29:29 +02:00
FPDebug: more Value handling
git-svn-id: trunk@43832 -
This commit is contained in:
martin
parent
2979e368b8
commit
e8f2625b6d
@ -589,35 +589,62 @@ type
|
||||
TDbgDwarfSymbolValue = class(TDbgSymbolValue)
|
||||
private
|
||||
FOwner: TDbgDwarfValueIdentifier; // nor refcounted
|
||||
protected
|
||||
function GetKind: TDbgSymbolKind; 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;
|
||||
|
||||
{ TDbgDwarfIntegerSymbolValue }
|
||||
|
||||
TDbgDwarfIntegerSymbolValue = class(TDbgDwarfSymbolValue)
|
||||
private
|
||||
FValue: Int64;
|
||||
FValue: QWord;
|
||||
FIntValue: Int64;
|
||||
FSize: Integer;
|
||||
FEvaluated: Boolean;
|
||||
FEvaluated: set of (doneUInt, doneInt);
|
||||
protected
|
||||
function GetAsCardinal: QWord; override;
|
||||
function GetAsInteger: Int64; override;
|
||||
public
|
||||
constructor Create(ASize: Integer);
|
||||
end;
|
||||
|
||||
{ TDbgDwarfCardinalSymbolValue }
|
||||
{ TDbgDwarfFloatSymbolValue }
|
||||
|
||||
TDbgDwarfCardinalSymbolValue = class(TDbgDwarfSymbolValue)
|
||||
private
|
||||
FValue: QWord;
|
||||
FSize: Integer;
|
||||
FEvaluated: Boolean;
|
||||
TDbgDwarfFloatSymbolValue = class(TDbgDwarfIntegerSymbolValue) // TDbgDwarfSymbolValue
|
||||
protected
|
||||
function GetAsCardinal: QWord; override;
|
||||
public
|
||||
constructor Create(ASize: Integer);
|
||||
//
|
||||
end;
|
||||
|
||||
{ TDbgDwarfBooleanSymbolValue }
|
||||
|
||||
TDbgDwarfBooleanSymbolValue = class(TDbgDwarfIntegerSymbolValue)
|
||||
protected
|
||||
function GetAsBool: Boolean; override;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfCharSymbolValue }
|
||||
|
||||
TDbgDwarfCharSymbolValue = class(TDbgDwarfIntegerSymbolValue)
|
||||
protected
|
||||
// returns single char(byte) / widechar
|
||||
function GetAsString: AnsiString; override;
|
||||
function GetAsWideString: WideString; override;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfPointerSymbolValue }
|
||||
|
||||
TDbgDwarfPointerSymbolValue = class(TDbgDwarfIntegerSymbolValue)
|
||||
end;
|
||||
|
||||
TDbgDwarfStructSymbolValue = class(TDbgDwarfSymbolValue)
|
||||
end;
|
||||
|
||||
{ TDbgDwarfIdentifier }
|
||||
@ -679,6 +706,10 @@ type
|
||||
|
||||
procedure KindNeeded; override;
|
||||
procedure MemberVisibilityNeeded; override;
|
||||
function GetMember(AIndex: Integer): TDbgSymbol; override;
|
||||
function GetMemberByName(AIndex: String): TDbgSymbol; override;
|
||||
function GetMemberCount: Integer; override;
|
||||
|
||||
procedure Init; override;
|
||||
public
|
||||
destructor Destroy; override;
|
||||
@ -843,6 +874,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
|
||||
procedure KindNeeded; override;
|
||||
procedure ForwardToSymbolNeeded; override;
|
||||
function GetStructureBaseAddress(out AnAddress: TDbgPtr; AMember: TDbgDwarfIdentifier; InheritedLoc: Boolean): Boolean; override;
|
||||
function GetTypedValueObject: TDbgDwarfSymbolValue; override;
|
||||
public
|
||||
property IsInternalPointer: Boolean read GetIsInternalPointer write FIsInternalPointer; // Class (also DynArray, but DynArray is handled without this)
|
||||
end;
|
||||
@ -907,6 +939,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
|
||||
protected
|
||||
procedure KindNeeded; override;
|
||||
procedure TypeInfoNeeded; override; // nil or inherited
|
||||
function GetTypedValueObject: TDbgDwarfSymbolValue; override;
|
||||
|
||||
function GetMember(AIndex: Integer): TDbgSymbol; override;
|
||||
function GetMemberByName(AIndex: String): TDbgSymbol; override;
|
||||
@ -1533,28 +1566,57 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfBooleanSymbolValue }
|
||||
|
||||
function TDbgDwarfBooleanSymbolValue.GetAsBool: Boolean;
|
||||
begin
|
||||
Result := QWord(GetAsInteger) <> 0;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfCharSymbolValue }
|
||||
|
||||
function TDbgDwarfCharSymbolValue.GetAsString: AnsiString;
|
||||
begin
|
||||
if FSize <> 1 then
|
||||
Result := inherited GetAsString
|
||||
else
|
||||
Result := char(byte(GetAsCardinal));
|
||||
end;
|
||||
|
||||
function TDbgDwarfCharSymbolValue.GetAsWideString: WideString;
|
||||
begin
|
||||
if FSize > 2 then
|
||||
Result := inherited GetAsString
|
||||
else
|
||||
Result := WideChar(Word(GetAsCardinal));
|
||||
end;
|
||||
|
||||
{ TDbgDwarfCardinalSymbolValue }
|
||||
|
||||
function TDbgDwarfCardinalSymbolValue.GetAsCardinal: QWord;
|
||||
function TDbgDwarfIntegerSymbolValue.GetAsCardinal: QWord;
|
||||
var
|
||||
m: TFpDbgMemReaderBase;
|
||||
addr: TDbgPtr;
|
||||
begin
|
||||
if FEvaluated then begin
|
||||
// TODO: memory representation of values is not dwar, but platform - move
|
||||
if doneUInt in FEvaluated then begin
|
||||
Result := FValue;
|
||||
exit;
|
||||
end;
|
||||
Include(FEvaluated, doneUInt);
|
||||
|
||||
if (FOwner = nil) or (FOwner.FCU = nil) or
|
||||
(FOwner.FCU.FOwner = nil) or (FOwner.FCU.FOwner.MemReader = nil) or
|
||||
((FSize <= 0) or (FSize > SizeOf(Result)))
|
||||
then begin
|
||||
Result := inherited GetAsInteger;
|
||||
FValue := Result;
|
||||
exit;
|
||||
end;
|
||||
|
||||
addr := FOwner.Address;
|
||||
if (addr = 0) then begin
|
||||
Result := inherited GetAsInteger;
|
||||
FValue := Result;
|
||||
exit;
|
||||
end;
|
||||
|
||||
@ -1563,59 +1625,79 @@ begin
|
||||
Result := 0;
|
||||
m.ReadMemory(addr, FSize, @Result);
|
||||
|
||||
FValue := Result;
|
||||
end;
|
||||
|
||||
constructor TDbgDwarfCardinalSymbolValue.Create(ASize: Integer);
|
||||
begin
|
||||
inherited Create;
|
||||
FSize := ASize;
|
||||
FEvaluated := False;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfIntegerSymbolValue }
|
||||
|
||||
function TDbgDwarfIntegerSymbolValue.GetAsInteger: Int64;
|
||||
var
|
||||
m: TFpDbgMemReaderBase;
|
||||
addr: TDbgPtr;
|
||||
begin
|
||||
if FEvaluated then begin
|
||||
Result := FValue;
|
||||
exit;
|
||||
end;
|
||||
if (FOwner = nil) or (FOwner.FCU = nil) or
|
||||
(FOwner.FCU.FOwner = nil) or (FOwner.FCU.FOwner.MemReader = nil) or
|
||||
((FSize <= 0) or (FSize > SizeOf(Result)))
|
||||
then begin
|
||||
Result := inherited GetAsInteger;
|
||||
if doneInt in FEvaluated then begin
|
||||
Result := FIntValue;
|
||||
exit;
|
||||
end;
|
||||
Include(FEvaluated, doneInt);
|
||||
|
||||
addr := FOwner.Address;
|
||||
if (addr = 0) then begin
|
||||
Result := inherited GetAsInteger;
|
||||
exit;
|
||||
end;
|
||||
|
||||
m := FOwner.FCU.FOwner.MemReader;
|
||||
// TODO endian
|
||||
Result := 0;
|
||||
m.ReadMemory(addr, FSize, @Result);
|
||||
|
||||
Result := GetAsCardinal;
|
||||
// sign extend
|
||||
if Result and (int64(1) shl (FSize * 8 - 1)) <> 0 then
|
||||
Result := Result or (int64(-1) shl (FSize * 8));
|
||||
|
||||
FIntValue := Result;
|
||||
end;
|
||||
|
||||
constructor TDbgDwarfIntegerSymbolValue.Create(ASize: Integer);
|
||||
begin
|
||||
inherited Create;
|
||||
FSize := ASize;
|
||||
FEvaluated := False;
|
||||
FEvaluated := [];
|
||||
end;
|
||||
|
||||
{ TDbgDwarfSymbolValue }
|
||||
|
||||
function TDbgDwarfSymbolValue.GetKind: TDbgSymbolKind;
|
||||
begin
|
||||
if FOwner <> nil then
|
||||
Result := FOwner.Kind
|
||||
else
|
||||
Result := inherited GetKind;
|
||||
end;
|
||||
|
||||
function TDbgDwarfSymbolValue.GetMemberCount: Integer;
|
||||
begin
|
||||
if FOwner <> nil then
|
||||
Result := FOwner.MemberCount
|
||||
else
|
||||
Result := inherited GetMemberCount;
|
||||
end;
|
||||
|
||||
function TDbgDwarfSymbolValue.GetMemberByName(AIndex: String): TDbgSymbolValue;
|
||||
var
|
||||
m: TDbgSymbol;
|
||||
begin
|
||||
Result := nil;
|
||||
if FOwner <> nil then begin
|
||||
m := FOwner.MemberByName[AIndex];
|
||||
if m <> nil then
|
||||
Result := m.Value;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDbgDwarfSymbolValue.GetMember(AIndex: Integer): TDbgSymbolValue;
|
||||
var
|
||||
m: TDbgSymbol;
|
||||
begin
|
||||
Result := nil;
|
||||
if FOwner <> nil then begin
|
||||
m := FOwner.Member[AIndex];
|
||||
if m <> nil then
|
||||
Result := m.Value;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDbgDwarfSymbolValue.GetDbgSymbol: TDbgSymbol;
|
||||
begin
|
||||
Result := FOwner;
|
||||
end;
|
||||
|
||||
constructor TDbgDwarfSymbolValue.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
@ -4037,6 +4119,15 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDbgDwarfTypeIdentifierPointer.GetTypedValueObject: TDbgDwarfSymbolValue;
|
||||
begin
|
||||
if IsInternalPointer then
|
||||
Result := NestedTypeInfo.GetTypedValueObject
|
||||
else
|
||||
// TODO:
|
||||
Result := TDbgDwarfPointerSymbolValue.Create(FCU.FAddressSize);
|
||||
end;
|
||||
|
||||
{ TDbgDwarfTypeIdentifierDeclaration }
|
||||
|
||||
function TDbgDwarfTypeIdentifierDeclaration.DoGetNestedTypeInfo: TDbgDwarfTypeIdentifier;
|
||||
@ -4105,6 +4196,39 @@ begin
|
||||
inherited MemberVisibilityNeeded;
|
||||
end;
|
||||
|
||||
function TDbgDwarfValueIdentifier.GetMember(AIndex: Integer): TDbgSymbol;
|
||||
var
|
||||
ti: TDbgSymbol;
|
||||
begin
|
||||
ti := TypeInfo;
|
||||
if ti <> nil then
|
||||
Result := ti.Member[AIndex]
|
||||
else
|
||||
Result := inherited GetMember(AIndex);
|
||||
end;
|
||||
|
||||
function TDbgDwarfValueIdentifier.GetMemberByName(AIndex: String): TDbgSymbol;
|
||||
var
|
||||
ti: TDbgSymbol;
|
||||
begin
|
||||
ti := TypeInfo;
|
||||
if ti <> nil then
|
||||
Result := ti.MemberByName[AIndex]
|
||||
else
|
||||
Result := inherited GetMemberByName(AIndex);
|
||||
end;
|
||||
|
||||
function TDbgDwarfValueIdentifier.GetMemberCount: Integer;
|
||||
var
|
||||
ti: TDbgSymbol;
|
||||
begin
|
||||
ti := TypeInfo;
|
||||
if ti <> nil then
|
||||
Result := ti.MemberCount
|
||||
else
|
||||
Result := inherited GetMemberCount;
|
||||
end;
|
||||
|
||||
procedure TDbgDwarfValueIdentifier.Init;
|
||||
begin
|
||||
inherited Init;
|
||||
@ -4396,6 +4520,11 @@ begin
|
||||
NewInfo.ReleaseReference;
|
||||
end;
|
||||
|
||||
function TDbgDwarfIdentifierStructure.GetTypedValueObject: TDbgDwarfSymbolValue;
|
||||
begin
|
||||
Result := TDbgDwarfStructSymbolValue.Create;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfTypeIdentifierModifier }
|
||||
|
||||
procedure TDbgDwarfTypeIdentifierModifier.TypeInfoNeeded;
|
||||
@ -4464,12 +4593,12 @@ end;
|
||||
function TDbgDwarfBaseIdentifierBase.GetTypedValueObject: TDbgDwarfSymbolValue;
|
||||
begin
|
||||
case Kind of
|
||||
skPointer: ;
|
||||
skPointer: Result := TDbgDwarfPointerSymbolValue.Create(Size);
|
||||
skInteger: Result := TDbgDwarfIntegerSymbolValue.Create(Size);
|
||||
skCardinal: Result := TDbgDwarfCardinalSymbolValue.Create(Size);
|
||||
skBoolean: ;
|
||||
skChar: ;
|
||||
skFloat: ;
|
||||
skCardinal: Result := TDbgDwarfIntegerSymbolValue.Create(Size);
|
||||
skBoolean: Result := TDbgDwarfBooleanSymbolValue.Create(Size);
|
||||
skChar: Result := TDbgDwarfCharSymbolValue.Create(Size);
|
||||
skFloat: Result := TDbgDwarfFloatSymbolValue.Create(Size);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -86,6 +86,8 @@ type
|
||||
);
|
||||
TDbgSymbolFields = set of TDbgSymbolField;
|
||||
|
||||
TDbgSymbol = class;
|
||||
|
||||
{ TDbgSymbolValue }
|
||||
|
||||
TDbgSymbolValue = class(TRefCountedObject)
|
||||
@ -93,12 +95,38 @@ type
|
||||
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 GetMember(AIndex: Integer): TDbgSymbolValue; virtual;
|
||||
function GetMemberByName(AIndex: String): TDbgSymbolValue; virtual;
|
||||
function GetMemberCount: Integer; virtual;
|
||||
function GetDbgSymbol: TDbgSymbol; virtual;
|
||||
public
|
||||
// Kind: determines which types of value are available
|
||||
property Kind: TDbgSymbolKind read GetKind;
|
||||
|
||||
property AsInteger: Int64 read GetAsInteger;
|
||||
property AsCardinal: QWord read GetAsCardinal;
|
||||
property AsBool: Boolean read GetAsBool;
|
||||
// memdump
|
||||
//function AsPrintable: String; virtual;
|
||||
property AsString: AnsiString read GetAsString;
|
||||
property AsWideString: WideString read GetAsWideString;
|
||||
// complex
|
||||
// double
|
||||
// memdump / Address / Size / Memory
|
||||
public
|
||||
(* Member:
|
||||
For TypeInfo (skType) it excludes BaseClass
|
||||
For Value (skValue): ???
|
||||
*)
|
||||
// base class? Or Member inncludes member from base
|
||||
property MemberCount: Integer read GetMemberCount;
|
||||
property Member[AIndex: Integer]: TDbgSymbolValue read GetMember;
|
||||
property MemberByName[AIndex: String]: TDbgSymbolValue read GetMemberByName; // Includes inheritance
|
||||
|
||||
(* DbgSymbol: The TDbgSymbol from which this value came, maybe nil.
|
||||
Maybe a stType, then there is no Value *)
|
||||
property DbgSymbol: TDbgSymbol read GetDbgSymbol;
|
||||
end;
|
||||
|
||||
{ TDbgSymbol }
|
||||
@ -115,7 +143,7 @@ type
|
||||
FSize: Integer;
|
||||
FTypeInfo: TDbgSymbol;
|
||||
FReference: TDbgSymbol;
|
||||
FMemberVisibility: TDbgSymbolMemberVisibility;
|
||||
FMemberVisibility: TDbgSymbolMemberVisibility; // Todo: not cached
|
||||
|
||||
function GetSymbolType: TDbgSymbolType; inline;
|
||||
function GetKind: TDbgSymbolKind; inline;
|
||||
@ -182,14 +210,18 @@ type
|
||||
// stValue (Variable): Type
|
||||
// stType: Pointer: type pointed to / Array: Element Type / Func: Result / Class: itheritance
|
||||
property TypeInfo: TDbgSymbol read GetTypeInfo;
|
||||
property MemberVisibility: TDbgSymbolMemberVisibility read GetMemberVisibility;
|
||||
// Location
|
||||
property FileName: String read GetFile;
|
||||
property Line: Cardinal read GetLine;
|
||||
property Column: Cardinal read GetColumn;
|
||||
// Methods for structures (record / class / enum)
|
||||
// array: each member represents an index (enum or subrange) and has low/high bounds
|
||||
property MemberVisibility: TDbgSymbolMemberVisibility read GetMemberVisibility;
|
||||
property MemberCount: Integer read GetMemberCount;
|
||||
(* Member:
|
||||
For TypeInfo (skType) it excludes BaseClass
|
||||
For Value (skValue): ???
|
||||
*)
|
||||
property Member[AIndex: Integer]: TDbgSymbol read GetMember;
|
||||
property MemberByName[AIndex: String]: TDbgSymbol read GetMemberByName; // Includes inheritance
|
||||
//
|
||||
@ -198,15 +230,16 @@ type
|
||||
// Reference: opposite of TypeInfo / The variable to which a type belongs
|
||||
property Reference: TDbgSymbol read GetReference write SetReference;
|
||||
property Parent: TDbgSymbol read GetParent; deprecated;
|
||||
//property Children[AIndex: Integer]: TDbgSymbol read GetChild;
|
||||
// VALUE
|
||||
property Value: TDbgSymbolValue read GetValueObject;
|
||||
property HasOrdinalValue: Boolean read GetHasOrdinalValue;
|
||||
property OrdinalValue: Int64 read GetOrdinalValue; // need typecast for QuadWord
|
||||
// for Subranges
|
||||
property HasBounds: Boolean read GetHasBounds;
|
||||
property OrdLowBound: Int64 read GetOrdLowBound; // need typecast for QuadWord
|
||||
property OrdHighBound: Int64 read GetOrdHighBound; // need typecast for QuadWord
|
||||
// VALUE
|
||||
property Value: TDbgSymbolValue read GetValueObject;
|
||||
property HasOrdinalValue: Boolean read GetHasOrdinalValue;
|
||||
property OrdinalValue: Int64 read GetOrdinalValue; // need typecast for QuadWord
|
||||
|
||||
//TypeCastValue(AValue: TDbgSymbolValue): TDbgSymbolValue;
|
||||
end;
|
||||
|
||||
{ TDbgSymbolForwarder }
|
||||
@ -279,6 +312,41 @@ end;
|
||||
|
||||
{ TDbgSymbolValue }
|
||||
|
||||
function TDbgSymbolValue.GetAsString: AnsiString;
|
||||
begin
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
function TDbgSymbolValue.GetAsWideString: WideString;
|
||||
begin
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
function TDbgSymbolValue.GetDbgSymbol: TDbgSymbol;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TDbgSymbolValue.GetKind: TDbgSymbolKind;
|
||||
begin
|
||||
Result := skNone;
|
||||
end;
|
||||
|
||||
function TDbgSymbolValue.GetMember(AIndex: Integer): TDbgSymbolValue;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TDbgSymbolValue.GetMemberByName(AIndex: String): TDbgSymbolValue;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TDbgSymbolValue.GetMemberCount: Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function TDbgSymbolValue.GetAsBool: Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
@ -51,11 +51,12 @@ type
|
||||
FExpressionPart: TFpPascalExpressionPart;
|
||||
FValid: Boolean;
|
||||
function GetResultType: TDbgSymbol;
|
||||
function GetResultValue: TDbgSymbolValue;
|
||||
procedure Parse;
|
||||
procedure SetError(AMsg: String);
|
||||
function PosFromPChar(APChar: PChar): Integer;
|
||||
protected
|
||||
function GetDbgTyeForIdentifier({%H-}AnIdent: String): TDbgSymbol; virtual;
|
||||
function GetDbgSymbolForIdentifier({%H-}AnIdent: String): TDbgSymbol; virtual;
|
||||
property ExpressionPart: TFpPascalExpressionPart read FExpressionPart;
|
||||
public
|
||||
constructor Create(ATextExpression: String);
|
||||
@ -63,7 +64,8 @@ type
|
||||
function DebugDump: String;
|
||||
property Error: String read FError;
|
||||
property Valid: Boolean read FValid;
|
||||
property ResultType: TDbgSymbol read GetResultType;
|
||||
//property ResultType: TDbgSymbol read GetResultType; deprecated;
|
||||
property ResultValue: TDbgSymbolValue read GetResultValue; // May be a type, if expression is a type
|
||||
end;
|
||||
|
||||
|
||||
@ -77,8 +79,11 @@ type
|
||||
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;
|
||||
procedure SetEndChar(AValue: PChar);
|
||||
@ -93,6 +98,7 @@ type
|
||||
procedure Init; virtual;
|
||||
function DoGetResultType: TDbgSymbol; virtual;
|
||||
function DoGetIsTypeCast: Boolean; virtual;
|
||||
function DoGetResultValue: TDbgSymbolValue; virtual;
|
||||
|
||||
Procedure ReplaceInParent(AReplacement: TFpPascalExpressionPart);
|
||||
procedure DoHandleEndOfExpression; virtual;
|
||||
@ -118,8 +124,9 @@ 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;
|
||||
property ResultTypeCast: TDbgSymbol read GetResultTypeCast;
|
||||
property ResultType: TDbgSymbol read GetResultType; deprecated;
|
||||
property ResultTypeCast: TDbgSymbol read GetResultTypeCast; deprecated;
|
||||
property ResultValue: TDbgSymbolValue read GetResultValue;
|
||||
end;
|
||||
|
||||
{ TFpPascalExpressionPartContainer }
|
||||
@ -149,11 +156,11 @@ type
|
||||
|
||||
TFpPascalExpressionPartIdentifer = class(TFpPascalExpressionPartContainer)
|
||||
private
|
||||
FDbgType: TDbgSymbol; // may be a variable or function or a type ...
|
||||
FDbgTypeDone: Boolean;
|
||||
FDbgSymbol: TDbgSymbol;
|
||||
protected
|
||||
function DoGetResultType: TDbgSymbol; override;
|
||||
function DoGetIsTypeCast: Boolean; override;
|
||||
function DoGetResultValue: TDbgSymbolValue; override;
|
||||
public
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
@ -161,7 +168,11 @@ type
|
||||
TFpPascalExpressionPartConstant = class(TFpPascalExpressionPartContainer)
|
||||
end;
|
||||
|
||||
{ TFpPascalExpressionPartConstantNumber }
|
||||
|
||||
TFpPascalExpressionPartConstantNumber = class(TFpPascalExpressionPartConstant)
|
||||
protected
|
||||
function DoGetResultValue: TDbgSymbolValue; override;
|
||||
end;
|
||||
|
||||
TFpPascalExpressionPartConstantText = class(TFpPascalExpressionPartConstant)
|
||||
@ -209,6 +220,7 @@ type
|
||||
protected
|
||||
function HandleNextPartInBracket(APart: TFpPascalExpressionPart): TFpPascalExpressionPart; override;
|
||||
function DoGetResultType: TDbgSymbol; override;
|
||||
function DoGetResultValue: TDbgSymbolValue; override;
|
||||
end;
|
||||
|
||||
{ TFpPascalExpressionPartBracketArgumentList }
|
||||
@ -349,6 +361,7 @@ type
|
||||
procedure Init; override;
|
||||
function IsValidNextPart(APart: TFpPascalExpressionPart): Boolean; override;
|
||||
function DoGetResultType: TDbgSymbol; override;
|
||||
function DoGetResultValue: TDbgSymbolValue; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -367,6 +380,32 @@ 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)
|
||||
@ -394,6 +433,51 @@ type
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
{ TPasParserConstNumberSymbolValue }
|
||||
|
||||
function TPasParserConstNumberSymbolValue.GetKind: TDbgSymbolKind;
|
||||
begin
|
||||
if FSigned then
|
||||
Result := skInteger
|
||||
else
|
||||
Result := skCardinal;
|
||||
end;
|
||||
|
||||
function TPasParserConstNumberSymbolValue.GetAsCardinal: QWord;
|
||||
begin
|
||||
Result := FValue;
|
||||
end;
|
||||
|
||||
function TPasParserConstNumberSymbolValue.GetAsInteger: Int64;
|
||||
begin
|
||||
Result := Int64(FValue);
|
||||
end;
|
||||
|
||||
constructor TPasParserConstNumberSymbolValue.Create(AValue: QWord; ASigned: Boolean);
|
||||
begin
|
||||
inherited Create;
|
||||
FValue := AValue;
|
||||
FSigned := ASigned;
|
||||
end;
|
||||
|
||||
{ TPasParserTypeCastSymbolValue }
|
||||
|
||||
function TPasParserWrapperSymbolValue.GetKind: TDbgSymbolKind;
|
||||
begin
|
||||
Result := skNone;
|
||||
end;
|
||||
|
||||
function TPasParserWrapperSymbolValue.GetDbgSymbol: TDbgSymbol;
|
||||
begin
|
||||
Result := FSymbol;
|
||||
end;
|
||||
|
||||
constructor TPasParserWrapperSymbolValue.Create(ATypeInfo: TDbgSymbol);
|
||||
begin
|
||||
inherited Create;
|
||||
FSymbol := ATypeInfo;
|
||||
end;
|
||||
|
||||
{ TPasParserSymbolArrayDeIndex }
|
||||
|
||||
function TPasParserSymbolArrayDeIndex.GetMemberCount: Integer;
|
||||
@ -467,7 +551,7 @@ begin
|
||||
if tmp.MemberCount < 1 then exit; // TODO error
|
||||
if tmp.MemberCount = 1 then begin
|
||||
Result := tmp.TypeInfo;
|
||||
Result.AddReference;
|
||||
Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultType'){$ENDIF};
|
||||
exit;
|
||||
end;
|
||||
|
||||
@ -476,7 +560,7 @@ begin
|
||||
else
|
||||
if (tmp.Kind = skPointer) then begin
|
||||
Result := tmp.TypeInfo;
|
||||
Result.AddReference;
|
||||
Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultType'){$ENDIF};
|
||||
exit;
|
||||
end
|
||||
else
|
||||
@ -582,7 +666,7 @@ begin
|
||||
if Result <> nil then begin
|
||||
// This is a typecast
|
||||
// TODO: verify cast compatibilty
|
||||
Result.AddReference;
|
||||
Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultType'){$ENDIF};
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
@ -673,42 +757,73 @@ begin
|
||||
else
|
||||
Result := Items[0].ResultType;
|
||||
if Result <> nil then
|
||||
Result.AddReference;
|
||||
Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultType'){$ENDIF};
|
||||
end;
|
||||
|
||||
function TFpPascalExpressionPartBracketSubExpression.DoGetResultValue: TDbgSymbolValue;
|
||||
begin
|
||||
if Count <> 1 then
|
||||
Result := nil
|
||||
else
|
||||
Result := Items[0].ResultValue;
|
||||
if Result <> nil then
|
||||
Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultValue'){$ENDIF};
|
||||
end;
|
||||
|
||||
{ TFpPascalExpressionPartIdentifer }
|
||||
|
||||
function TFpPascalExpressionPartIdentifer.DoGetResultType: TDbgSymbol;
|
||||
begin
|
||||
Result := nil;
|
||||
if (FDbgType = nil) and not FDbgTypeDone then
|
||||
FDbgType := FExpression.GetDbgTyeForIdentifier(GetText);
|
||||
FDbgTypeDone := True;
|
||||
if FDbgType = nil then
|
||||
Result := ResultValue.DbgSymbol;
|
||||
if Result = nil then
|
||||
exit;
|
||||
|
||||
case FDbgType.SymbolType of
|
||||
stValue: Result := FDbgType.TypeInfo;
|
||||
stType: Result := FDbgType;
|
||||
case Result.SymbolType of
|
||||
stValue: Result := Result.TypeInfo;
|
||||
stType: Result := Result;
|
||||
else Result := nil;
|
||||
end;
|
||||
|
||||
if Result <> nil then
|
||||
Result.AddReference;
|
||||
Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultType'){$ENDIF};
|
||||
end;
|
||||
|
||||
function TFpPascalExpressionPartIdentifer.DoGetIsTypeCast: Boolean;
|
||||
begin
|
||||
if (FDbgType = nil) and not FDbgTypeDone then
|
||||
FDbgType := FExpression.GetDbgTyeForIdentifier(GetText);
|
||||
FDbgTypeDone := True;
|
||||
Result := (FDbgType <> nil) and (FDbgType.SymbolType = stType);
|
||||
Result := (ResultValue <> nil) and (ResultValue.DbgSymbol <> nil) and (ResultValue.DbgSymbol.SymbolType = stType);
|
||||
end;
|
||||
|
||||
function TFpPascalExpressionPartIdentifer.DoGetResultValue: TDbgSymbolValue;
|
||||
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
|
||||
exit;
|
||||
Result := FDbgSymbol.Value;
|
||||
if Result = nil then begin
|
||||
Result := TPasParserWrapperSymbolValue.Create(FDbgSymbol);
|
||||
if Result <> nil then Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultValue'){$ENDIF};
|
||||
end
|
||||
else
|
||||
Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultValue'){$ENDIF};
|
||||
end;
|
||||
|
||||
destructor TFpPascalExpressionPartIdentifer.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
ReleaseRefAndNil(FDbgType);
|
||||
FDbgSymbol.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(FDbgSymbol, 'DoGetResultValue'){$ENDIF};
|
||||
end;
|
||||
|
||||
{ TFpPascalExpressionPartConstantNumber }
|
||||
|
||||
function TFpPascalExpressionPartConstantNumber.DoGetResultValue: TDbgSymbolValue;
|
||||
begin
|
||||
Result := TPasParserConstNumberSymbolValue.Create(StrToQWordDef(GetText, 0));
|
||||
Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultValue'){$ENDIF};
|
||||
end;
|
||||
|
||||
{ TFpPascalExpressionPartOperatorUnaryPlusMinus }
|
||||
@ -803,14 +918,14 @@ var
|
||||
'&': while TokenEndPtr^ in ['0'..'7'] do inc(TokenEndPtr);
|
||||
'%': while TokenEndPtr^ in ['0'..'1'] do inc(TokenEndPtr);
|
||||
'0'..'9':
|
||||
if (TokenEndPtr^ = '0') and ((TokenEndPtr + 1)^ = 'x') and
|
||||
((TokenEndPtr + 2)^ in ['a'..'z', 'A'..'Z', '0'..'9'])
|
||||
if (CurPtr^ = '0') and ((CurPtr + 1)^ in ['x', 'X']) and
|
||||
((CurPtr + 2)^ in ['a'..'z', 'A'..'Z', '0'..'9'])
|
||||
then begin
|
||||
inc(TokenEndPtr, 3);
|
||||
inc(TokenEndPtr, 2);
|
||||
while TokenEndPtr^ in ['a'..'z', 'A'..'Z', '0'..'9'] do inc(TokenEndPtr);
|
||||
end
|
||||
else
|
||||
while TokenEndPtr^ in ['0'..'0'] do inc(TokenEndPtr);
|
||||
while TokenEndPtr^ in ['0'..'9'] do inc(TokenEndPtr);
|
||||
end;
|
||||
AddPart(TFpPascalExpressionPartConstantNumber);
|
||||
end;
|
||||
@ -890,6 +1005,14 @@ begin
|
||||
Result := FExpressionPart.ResultType;
|
||||
end;
|
||||
|
||||
function TFpPascalExpression.GetResultValue: TDbgSymbolValue;
|
||||
begin
|
||||
if (FExpressionPart = nil) or (not Valid) then
|
||||
Result := nil
|
||||
else
|
||||
Result := FExpressionPart.ResultValue;
|
||||
end;
|
||||
|
||||
procedure TFpPascalExpression.SetError(AMsg: String);
|
||||
begin
|
||||
FValid := False;
|
||||
@ -902,7 +1025,7 @@ begin
|
||||
Result := APChar - @FTextExpression[1] + 1;
|
||||
end;
|
||||
|
||||
function TFpPascalExpression.GetDbgTyeForIdentifier(AnIdent: String): TDbgSymbol;
|
||||
function TFpPascalExpression.GetDbgSymbolForIdentifier(AnIdent: String): TDbgSymbol;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
@ -986,6 +1109,16 @@ begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TFpPascalExpressionPart.GetResultValue: TDbgSymbolValue;
|
||||
begin
|
||||
Result := FResultValue;
|
||||
if FResultValDone then
|
||||
exit;
|
||||
FResultValue := DoGetResultValue;
|
||||
FResultValDone := True;
|
||||
Result := FResultValue;
|
||||
end;
|
||||
|
||||
procedure TFpPascalExpressionPart.SetParent(AValue: TFpPascalExpressionPartContainer);
|
||||
begin
|
||||
if FParent = AValue then Exit;
|
||||
@ -1039,6 +1172,11 @@ begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function TFpPascalExpressionPart.DoGetResultValue: TDbgSymbolValue;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
procedure TFpPascalExpressionPart.ReplaceInParent(AReplacement: TFpPascalExpressionPart);
|
||||
var
|
||||
i: Integer;
|
||||
@ -1105,13 +1243,15 @@ begin
|
||||
FStartChar := AStartChar;
|
||||
FEndChar := AnEndChar;
|
||||
FResultTypeFlag := rtUnknown;
|
||||
FResultValDone := False;
|
||||
Init;
|
||||
end;
|
||||
|
||||
destructor TFpPascalExpressionPart.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
ReleaseRefAndNil(FResultType);
|
||||
FResultType.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultType'){$ENDIF};
|
||||
FResultValue.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultValue'){$ENDIF};
|
||||
end;
|
||||
|
||||
function TFpPascalExpressionPart.HandleNextPart(APart: TFpPascalExpressionPart): TFpPascalExpressionPart;
|
||||
@ -1418,6 +1558,7 @@ begin
|
||||
if Result = nil then
|
||||
exit;
|
||||
Result := TPasParserSymbolPointer.Create(Result);
|
||||
{$IFDEF WITH_REFCOUNT_DEBUG}Result.DbgRenameReference(nil, 'DoGetResultType');{$ENDIF}
|
||||
end;
|
||||
|
||||
{ TFpPascalExpressionPartOperatorMakeRef }
|
||||
@ -1448,6 +1589,7 @@ begin
|
||||
if Result = nil then
|
||||
exit;
|
||||
Result := TPasParserSymbolPointer.Create(Result);
|
||||
{$IFDEF WITH_REFCOUNT_DEBUG}Result.DbgRenameReference(nil, 'DoGetResultType');{$ENDIF}
|
||||
end;
|
||||
|
||||
function TFpPascalExpressionPartOperatorMakeRef.DoGetIsTypeCast: Boolean;
|
||||
@ -1556,10 +1698,29 @@ begin
|
||||
tmp := tmp.MemberByName[Items[1].GetText];
|
||||
if (tmp <> nil) and (tmp.SymbolType = stValue) then begin
|
||||
Result := tmp.TypeInfo;
|
||||
Result.AddReference;
|
||||
Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultType'){$ENDIF};
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFpPascalExpressionPartOperatorMemberOf.DoGetResultValue: TDbgSymbolValue;
|
||||
var
|
||||
tmp: TDbgSymbolValue;
|
||||
begin
|
||||
Result := nil;
|
||||
if Count <> 2 then exit;
|
||||
|
||||
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
|
||||
Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultValue'){$ENDIF};
|
||||
Assert((Result=nil) or (Result.DbgSymbol=nil)or(Result.DbgSymbol.SymbolType=stValue), 'member is value');
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user