diff --git a/components/fpdebug/fpdbgdwarf.pas b/components/fpdebug/fpdbgdwarf.pas index c58e2c7b2d..d52227a472 100644 --- a/components/fpdebug/fpdbgdwarf.pas +++ b/components/fpdebug/fpdbgdwarf.pas @@ -166,14 +166,15 @@ type *) FParentTypeSymbol: TFpSymbolDwarfType; FStructureValue: TFpValueDwarf; + FForcedSize: TFpDbgValueSize; // for typecast from array member procedure SetStructureValue(AValue: TFpValueDwarf); protected - function GetSizeFor(AnOtherValue: TFpValue; out ASize: QWord): Boolean; inline; + function GetSizeFor(AnOtherValue: TFpValue; out ASize: TFpDbgValueSize): Boolean; inline; function AddressSize: Byte; inline; // Address of the symbol (not followed any type deref, or location) function GetAddress: TFpDbgMemLocation; override; - function DoGetSize(out ASize: QWord): Boolean; override; + function DoGetSize(out ASize: TFpDbgValueSize): Boolean; override; function OrdOrAddress: TFpDbgMemLocation; // Address of the data (followed type deref, location, ...) function OrdOrDataAddr: TFpDbgMemLocation; @@ -359,19 +360,27 @@ type { TFpValueDwarfStruct } - TFpValueDwarfStruct = class(TFpValueDwarf) + { TFpValueDwarfStructBase } + + TFpValueDwarfStructBase = class(TFpValueDwarf) + protected + function GetMember(AIndex: Int64): TFpValue; override; + function GetMemberByName(AIndex: String): TFpValue; override; + end; + + TFpValueDwarfStruct = class(TFpValueDwarfStructBase) private FDataAddressDone: Boolean; protected procedure Reset; override; function GetFieldFlags: TFpValueFieldFlags; override; function GetAsCardinal: QWord; override; - function GetDataSize: QWord; override; + function GetDataSize: TFpDbgValueSize; override; end; { TFpValueDwarfStructTypeCast } - TFpValueDwarfStructTypeCast = class(TFpValueDwarf) + TFpValueDwarfStructTypeCast = class(TFpValueDwarfStructBase) private FDataAddressDone: Boolean; protected @@ -379,7 +388,7 @@ type function GetFieldFlags: TFpValueFieldFlags; override; function GetKind: TDbgSymbolKind; override; function GetAsCardinal: QWord; override; - function GetDataSize: QWord; override; + function GetDataSize: TFpDbgValueSize; override; function IsValidTypeCast: Boolean; override; end; @@ -395,10 +404,19 @@ type TFpValueDwarfArray = class(TFpValueDwarf) private + FEvalFlags: set of (efMemberSizeDone, efMemberSizeUnavail, + efStrideDone, efStrideUnavail, + efMainStrideDone, efMainStrideUnavail, + efRowMajorDone, efRowMajorUnavail); FAddrObj: TFpValueDwarfConstAddress; FArraySymbol: TFpSymbolDwarfTypeArray; FLastMember: TFpValueDwarf; + FRowMajor: Boolean; + FMemberSize: TFpDbgValueSize; + FStride, FMainStride: TFpDbgValueSize; + FStrides: array of bitpacked record Stride: TFpDbgValueSize; Done, Unavail: Boolean; end; // nested idx protected + procedure Reset; override; function GetFieldFlags: TFpValueFieldFlags; override; function GetKind: TDbgSymbolKind; override; function GetAsCardinal: QWord; override; @@ -409,9 +427,19 @@ type function GetIndexType(AIndex: Integer): TFpSymbol; override; function GetIndexTypeCount: Integer; override; function IsValidTypeCast: Boolean; override; + function DoGetOrdering(out ARowMajor: Boolean): Boolean; virtual; + function DoGetStride(out AStride: TFpDbgValueSize): Boolean; virtual; + function DoGetMemberSize(out ASize: TFpDbgValueSize): Boolean; virtual; // array.stride or typeinfe.size + function DoGetMainStride(out AStride: TFpDbgValueSize): Boolean; virtual; + function DoGetDimStride(AnIndex: integer; out AStride: TFpDbgValueSize): Boolean; virtual; public constructor Create(ADwarfTypeSymbol: TFpSymbolDwarfType; AnArraySymbol :TFpSymbolDwarfTypeArray); destructor Destroy; override; + function GetOrdering(out ARowMajor: Boolean): Boolean; inline; + function GetStride(out AStride: TFpDbgValueSize): Boolean; inline; // UnAdjusted Stride + function GetMemberSize(out ASize: TFpDbgValueSize): Boolean; inline; // array.stride or typeinfe.size + function GetMainStride(out AStride: TFpDbgValueSize): Boolean; inline; // Most inner idx + function GetDimStride(AnIndex: integer; out AStride: TFpDbgValueSize): Boolean; inline; // outer idx // AnIndex start at 1 end; { TFpValueDwarfSubroutine } @@ -462,15 +490,15 @@ type // LocalProcInfo: funtion for local var / param property LocalProcInfo: TFpSymbolDwarf read FLocalProcInfo write SetLocalProcInfo; - function DoForwardReadSize(const AValueObj: TFpValue; out ASize: QWord): Boolean; inline; - function DataSize: Integer; virtual; + function DoForwardReadSize(const AValueObj: TFpValue; out ASize: TFpDbgValueSize): Boolean; inline; + function DataSize: TFpDbgValueSize; virtual; protected function InitLocationParser(const {%H-}ALocationParser: TDwarfLocationExpression; AnInitLocParserData: PInitLocParserData = nil): Boolean; virtual; function ComputeDataMemberAddress(const AnInformationEntry: TDwarfInformationEntry; AValueObj: TFpValueDwarf; var AnAddress: TFpDbgMemLocation): Boolean; inline; function ConstRefOrExprFromAttrData(const AnAttribData: TDwarfAttribData; - AValueObj: TFpValueDwarf; out AValue: TDBGPtr; + AValueObj: TFpValueDwarf; out AValue: Int64; AReadState: PFpDwarfAtEntryDataReadState = nil; ADataSymbol: PFpSymbolDwarfData = nil): Boolean; function LocationFromAttrData(const AnAttribData: TDwarfAttribData; AValueObj: TFpValueDwarf; @@ -599,7 +627,8 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line protected procedure Init; override; procedure MemberVisibilityNeeded; override; - function DoReadSize(const AValueObj: TFpValue; out ASize: QWord): Boolean; override; + function DoReadSize(const AValueObj: TFpValue; out ASize: TFpDbgValueSize): Boolean; override; + function DoReadStride(AValueObj: TFpValueDwarf; out AStride: TFpDbgValueSize): Boolean; public (* GetTypedValueObject AnOuterType: If the type is a "chain" (Declaration > Pointer > ActualType) @@ -623,6 +652,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line Bounds (and maybe all such data) should be stored on the value object) *) procedure ResetValueBounds; virtual; + function ReadStride(AValueObj: TFpValueDwarf; out AStride: TFpDbgValueSize): Boolean; inline; end; { TFpSymbolDwarfTypeBasic } @@ -656,7 +686,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line protected procedure TypeInfoNeeded; override; procedure ForwardToSymbolNeeded; override; - function DoReadSize(const AValueObj: TFpValue; out ASize: QWord): Boolean; override; + function DoReadSize(const AValueObj: TFpValue; out ASize: TFpDbgValueSize): Boolean; override; function GetNextTypeInfoForDataAddress(ATargetType: TFpSymbolDwarfType): TFpSymbolDwarfType; override; public function GetTypedValueObject(ATypeCast: Boolean; AnOuterType: TFpSymbolDwarfType = nil): TFpValueDwarf; override; @@ -699,7 +729,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line procedure NameNeeded; override; procedure KindNeeded; override; - function DoReadSize(const AValueObj: TFpValue; out ASize: QWord): Boolean; override; + function DoReadSize(const AValueObj: TFpValue; out ASize: TFpDbgValueSize): Boolean; override; function GetNestedSymbolEx(AIndex: Int64; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol; override; function GetNestedSymbolCount: Integer; override; function GetFlags: TDbgSymbolFlags; override; @@ -722,7 +752,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line TFpSymbolDwarfTypePointer = class(TFpSymbolDwarfTypeModifierBase) protected procedure KindNeeded; override; - function DoReadSize(const AValueObj: TFpValue; out ASize: QWord): Boolean; override; + function DoReadSize(const AValueObj: TFpValue; out ASize: TFpDbgValueSize): Boolean; override; public function GetTypedValueObject(ATypeCast: Boolean; AnOuterType: TFpSymbolDwarfType = nil): TFpValueDwarf; override; end; @@ -801,6 +831,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line TFpSymbolDwarfDataMember = class(TFpSymbolDwarfDataWithLocation) protected + function DoReadSize(const AValueObj: TFpValue; out ASize: TFpDbgValueSize): Boolean; override; function GetValueAddress(AValueObj: TFpValueDwarf; out AnAddress: TFpDbgMemLocation): Boolean; override; function HasAddress: Boolean; override; end; @@ -836,14 +867,10 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line TFpSymbolDwarfTypeArray = class(TFpSymbolDwarfType) private FMembers: TRefCntObjList; - FRowMajor: Boolean; - FStrideInBits: Int64; - FDwarfArrayReadFlags: set of (didtStrideRead, didtOrdering); procedure CreateMembers; - procedure ReadStride(AValObject: TFpValueDwarf); - procedure ReadOrdering; protected procedure KindNeeded; override; + function DoReadOrdering(AValObject: TFpValueDwarf; out ARowMajor: Boolean): Boolean; function GetFlags: TDbgSymbolFlags; override; // GetNestedSymbolEx: returns the TYPE/range of each index. NOT the data @@ -898,7 +925,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line protected procedure NameNeeded; override; procedure KindNeeded; override; - function DoReadSize(const AValueObj: TFpValue; out ASize: QWord): Boolean; override; + function DoReadSize(const AValueObj: TFpValue; out ASize: TFpDbgValueSize): Boolean; override; function GetNestedSymbolEx(AIndex: Int64; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol; override; function GetNestedSymbolExByName(AIndex: String; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol; override; @@ -955,12 +982,25 @@ begin WriteStr(Result, ASubRangeBoundReadState); end; +{ TFpValueDwarfStructBase } + +function TFpValueDwarfStructBase.GetMember(AIndex: Int64): TFpValue; +begin + Result := inherited GetMember(AIndex); +end; + +function TFpValueDwarfStructBase.GetMemberByName(AIndex: String): TFpValue; +begin + Result := inherited GetMemberByName(AIndex); + +end; + { TFpValueDwarfSubroutine } function TFpValueDwarfSubroutine.IsValidTypeCast: Boolean; var f: TFpValueFieldFlags; - SrcSize: QWord; + SrcSize: TFpDbgValueSize; begin Result := HasTypeCastInfo; If not Result then @@ -1453,8 +1493,8 @@ begin FStructureValue.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FStructureValue, 'TDbgDwarfSymbolValue'){$ENDIF}; end; -function TFpValueDwarf.GetSizeFor(AnOtherValue: TFpValue; out ASize: QWord - ): Boolean; +function TFpValueDwarf.GetSizeFor(AnOtherValue: TFpValue; out + ASize: TFpDbgValueSize): Boolean; begin Result := AnOtherValue.GetSize(ASize); if (not Result) and IsError(AnOtherValue.LastError) then @@ -1596,8 +1636,20 @@ begin FCachedAddress := Result; end; -function TFpValueDwarf.DoGetSize(out ASize: QWord): Boolean; +function TFpValueDwarf.DoGetSize(out ASize: TFpDbgValueSize): Boolean; begin + if (TypeCastSourceValue = nil) then begin + Result := DbgSymbol.ReadSize(Self, ASize); + if Result then + exit; + end + else + if not IsZeroSize(FForcedSize) then begin + Result := True; + ASize := FForcedSize; + exit; + end; + if FTypeSymbol <> nil then begin Result := FTypeSymbol.ReadSize(Self, ASize); if (not Result) and IsError(FTypeSymbol.LastError) then @@ -1697,7 +1749,7 @@ end; function TFpValueDwarfSized.CanUseTypeCastAddress: Boolean; var - TypeSize, SrcSize: QWord; + TypeSize, SrcSize: TFpDbgValueSize; begin Result := True; // Can Use TypeCast-Address, if source has an Address, but NO Size @@ -1774,7 +1826,7 @@ end; function TFpValueDwarfInteger.GetAsInteger: Int64; var - Size: QWord; + Size: TFpDbgValueSize; begin if doneInt in FEvaluated then begin Result := FIntValue; @@ -1797,7 +1849,7 @@ end; function TFpValueDwarfCardinal.GetAsCardinal: QWord; var - Size: QWord; + Size: TFpDbgValueSize; begin if doneUInt in FEvaluated then begin Result := FValue; @@ -1832,7 +1884,7 @@ end; function TFpValueDwarfFloat.GetAsFloat: Extended; var - Size: QWord; + Size: TFpDbgValueSize; begin if doneFloat in FEvaluated then begin Result := FValue; @@ -1873,12 +1925,12 @@ end; function TFpValueDwarfChar.GetFieldFlags: TFpValueFieldFlags; var - Size: QWord; + Size: TFpDbgValueSize; begin if not GetSize(Size) then - Size := 0; + Size := ZeroSize; Result := inherited GetFieldFlags; - case Size of + case Size.Size of 1: Result := Result + [svfString]; 2: Result := Result + [svfWideString]; end; @@ -1886,12 +1938,12 @@ end; function TFpValueDwarfChar.GetAsString: AnsiString; var - Size: QWord; + Size: TFpDbgValueSize; begin if not GetSize(Size) then - Size := 0; + Size := ZeroSize; // Can typecast, because of FSize = 1, GetAsCardinal only read one byte - if Size = 2 then + if Size.Size = 2 then Result := GetAsWideString // temporary workaround for WideChar else if Size <> 1 then @@ -1902,11 +1954,11 @@ end; function TFpValueDwarfChar.GetAsWideString: WideString; var - Size: QWord; + Size: TFpDbgValueSize; begin if not GetSize(Size) then - Size := 0; - if Size > 2 then + Size := ZeroSize; + if Size.Size > 2 then Result := inherited GetAsWideString else Result := WideChar(Word(GetAsCardinal)); @@ -1916,7 +1968,7 @@ end; function TFpValueDwarfPointer.GetDerefAddress: TFpDbgMemLocation; var - Size: QWord; + Size: TFpDbgValueSize; begin if doneAddr in FEvaluated then begin Result := FPointetToAddr; @@ -1925,11 +1977,11 @@ begin Include(FEvaluated, doneAddr); if not GetSize(Size) then - Size := 0; + Size := ZeroSize; if (Size <= 0) then Result := InvalidLoc else - if not MemManager.ReadAddress(OrdOrDataAddr, Context.SizeOfAddress, Result) then + if not MemManager.ReadAddress(OrdOrDataAddr, SizeVal(Context.SizeOfAddress), Result) then SetLastError(MemManager.LastError); FPointetToAddr := Result; end; @@ -1961,10 +2013,10 @@ end; function TFpValueDwarfPointer.GetDataAddress: TFpDbgMemLocation; var - Size: QWord; + Size: TFpDbgValueSize; begin if not GetSize(Size) then - Size := 0; + Size := ZeroSize; if (Size <= 0) then Result := InvalidLoc else @@ -1975,7 +2027,7 @@ function TFpValueDwarfPointer.GetAsString: AnsiString; var t: TFpSymbol; i: Integer; - Size: QWord; + Size: TFpDbgValueSize; begin Result := ''; t := TypeInfo; @@ -1989,13 +2041,13 @@ begin if not t.ReadSize(nil, Size) then exit; - if Size = 2 then + if Size.Size = 2 then Result := GetAsWideString else if (MemManager <> nil) and (t <> nil) and (t.Kind = skChar) and IsReadableMem(GetDerefAddress) then begin // pchar SetLength(Result, 2000); i := 2000; - while (i > 0) and (not MemManager.ReadMemory(GetDerefAddress, i, @Result[1])) do + while (i > 0) and (not MemManager.ReadMemory(GetDerefAddress, SizeVal(i), @Result[1])) do i := i div 2; SetLength(Result,i); i := pos(#0, Result); @@ -2017,7 +2069,7 @@ begin if (MemManager <> nil) and (t <> nil) and (t.Kind = skChar) and IsReadableMem(GetDerefAddress) then begin // pchar SetLength(Result, 2000); i := 4000; // 2000 * 16 bit - while (i > 0) and (not MemManager.ReadMemory(GetDerefAddress, i, @Result[1])) do + while (i > 0) and (not MemManager.ReadMemory(GetDerefAddress, SizeVal(i), @Result[1])) do i := i div 2; SetLength(Result, i div 2); i := pos(#0, Result); @@ -2033,7 +2085,7 @@ var ti: TFpSymbol; addr: TFpDbgMemLocation; Tmp: TFpValueDwarfConstAddress; - Size: QWord; + Size: TFpDbgValueSize; begin //TODO: ?? if no TypeInfo.TypeInfo;, then return TFpValueDwarfConstAddress.Create(addr); (for mem dump) Result := nil; @@ -2053,7 +2105,7 @@ begin SetLastError(CreateError(fpErrAnyError, ['Can index element of unknown size'])); exit; end; - AIndex := AIndex * Size; + AIndex := AIndex * SizeToFullBytes(Size); end; addr := GetDerefAddress; if not IsTargetAddr(addr) then begin @@ -2109,7 +2161,7 @@ end; function TFpValueDwarfEnum.GetAsCardinal: QWord; var - Size: QWord; + Size: TFpDbgValueSize; begin if doneUInt in FEvaluated then begin Result := FValue; @@ -2212,10 +2264,10 @@ var t: TFpSymbol; hb, lb: Int64; DAddr: TFpDbgMemLocation; - Size: QWord; + Size: TFpDbgValueSize; begin if not GetSize(Size) then - Size := 0; + Size := ZeroSize; if (length(FMem) > 0) or (Size <= 0) then exit; t := TypeInfo; @@ -2230,7 +2282,7 @@ begin end; Cnt := 0; - for i := 0 to Size - 1 do + for i := 0 to Size.Size - 1 do Cnt := Cnt + (BitCount[FMem[i] and 15]) + (BitCount[(FMem[i] div 16) and 15]); FMemberCount := Cnt; @@ -2294,7 +2346,7 @@ end; function TFpValueDwarfSet.GetFieldFlags: TFpValueFieldFlags; var - Size: QWord; + Size: TFpDbgValueSize; begin Result := inherited GetFieldFlags; Result := Result + [svfMembers]; @@ -2361,19 +2413,19 @@ end; function TFpValueDwarfSet.GetAsCardinal: QWord; var - Size: QWord; + Size: TFpDbgValueSize; begin Result := 0; if not GetSize(Size) then exit; if (Size <= SizeOf(Result)) and (length(FMem) > 0) then - move(FMem[0], Result, Size); + move(FMem[0], Result, Min(SizeOf(Result), SizeToFullBytes(Size))); end; function TFpValueDwarfSet.IsValidTypeCast: Boolean; var f: TFpValueFieldFlags; - TypeSize, SrcSize: QWord; + TypeSize, SrcSize: TFpDbgValueSize; begin Result := HasTypeCastInfo; If not Result then @@ -2442,7 +2494,7 @@ begin Result := QWord(LocToAddrOrNil(Addr)); end; -function TFpValueDwarfStruct.GetDataSize: QWord; +function TFpValueDwarfStruct.GetDataSize: TFpDbgValueSize; begin Assert((FDataSymbol = nil) or (FDataSymbol.TypeInfo is TFpSymbolDwarf)); if (FDataSymbol <> nil) and (FDataSymbol.TypeInfo <> nil) then begin @@ -2450,10 +2502,10 @@ begin Result := TFpSymbolDwarf(FDataSymbol.TypeInfo).DataSize else if not GetSize(Result) then - Result := 0; + Result := ZeroSize; end else - Result := 0; + Result := ZeroSize; end; { TFpValueDwarfStructTypeCast } @@ -2493,7 +2545,7 @@ begin Result := QWord(LocToAddrOrNil(Addr)); end; -function TFpValueDwarfStructTypeCast.GetDataSize: QWord; +function TFpValueDwarfStructTypeCast.GetDataSize: TFpDbgValueSize; begin Assert((FTypeSymbol = nil) or (FTypeSymbol is TFpSymbolDwarf)); if FTypeSymbol <> nil then begin @@ -2501,16 +2553,16 @@ begin Result := TFpSymbolDwarf(FTypeSymbol).DataSize else if not GetSize(Result) then - Result := 0 + Result := ZeroSize; end else - Result := 0; + Result := ZeroSize; end; function TFpValueDwarfStructTypeCast.IsValidTypeCast: Boolean; var f: TFpValueFieldFlags; - SrcSize, TypeSize: QWord; + SrcSize, TypeSize: TFpDbgValueSize; begin Result := HasTypeCastInfo; if not Result then @@ -2565,6 +2617,13 @@ end; { TFpValueDwarfArray } +procedure TFpValueDwarfArray.Reset; +begin + FEvalFlags := []; + FStrides := nil; + inherited Reset; +end; + function TFpValueDwarfArray.GetFieldFlags: TFpValueFieldFlags; begin Result := inherited GetFieldFlags; @@ -2581,7 +2640,7 @@ end; function TFpValueDwarfArray.GetAsCardinal: QWord; begin // TODO cache - if not MemManager.ReadUnsignedInt(OrdOrAddress, AddressSize, Result) then begin + if not MemManager.ReadUnsignedInt(OrdOrAddress, SizeVal(AddressSize), Result) then begin SetLastError(MemManager.LastError); Result := 0; end; @@ -2597,6 +2656,7 @@ function TFpValueDwarfArray.GetMemberEx(const AIndex: array of Int64 var Addr: TFpDbgMemLocation; i: Integer; + Stride: TFpDbgValueSize; begin Result := nil; assert((FArraySymbol is TFpSymbolDwarfTypeArray) and (FArraySymbol.Kind = skArray)); @@ -2623,6 +2683,8 @@ begin FLastMember := TFpValueDwarf(FArraySymbol.TypeInfo.TypeCastValue(FAddrObj)); {$IFDEF WITH_REFCOUNT_DEBUG}FLastMember.DbgRenameReference(@FLastMember, 'TFpValueDwarfArray.FLastMember'){$ENDIF}; FLastMember.FContext := FContext; + if GetStride(Stride) then + TFpValueDwarf(FLastMember).FForcedSize := Stride; end else begin TFpValueDwarf(FLastMember).SetTypeCastInfo(FAddrObj); @@ -2683,7 +2745,7 @@ end; function TFpValueDwarfArray.IsValidTypeCast: Boolean; var f: TFpValueFieldFlags; - SrcSize, TypeSize: QWord; + SrcSize, TypeSize: TFpDbgValueSize; begin Result := HasTypeCastInfo; If not Result then @@ -2723,6 +2785,60 @@ begin Result := False; end; +function TFpValueDwarfArray.DoGetOrdering(out ARowMajor: Boolean): Boolean; +begin + Result := TFpSymbolDwarfTypeArray(TypeInfo).DoReadOrdering(Self, ARowMajor); +end; + +function TFpValueDwarfArray.DoGetStride(out AStride: TFpDbgValueSize): Boolean; +begin + Result := TFpSymbolDwarfType(TypeInfo).DoReadStride(Self, AStride); +end; + +function TFpValueDwarfArray.DoGetMemberSize(out ASize: TFpDbgValueSize + ): Boolean; +begin + ASize := ZeroSize; + Result := GetStride(ASize); + if (not Result) and (not IsError(LastError)) then begin + Result := TypeInfo.TypeInfo <> nil; + if Result then + TypeInfo.TypeInfo.ReadSize(Self, ASize); + end; +end; + +function TFpValueDwarfArray.DoGetMainStride(out AStride: TFpDbgValueSize + ): Boolean; +var + ExtraStride: TFpDbgValueSize; +begin + Result := GetMemberSize(AStride); + if Result and (not IsError(LastError)) then begin + assert(TypeInfo.NestedSymbolCount > 0, 'TFpValueDwarfArray.DoGetMainStride: TypeInfo.NestedSymbolCount > 0'); + Result := TFpSymbolDwarfType(TypeInfo.NestedSymbol[0]).DoReadStride(Self, ExtraStride); + if Result then + AStride := AStride + ExtraStride + else + Result := not IsError(LastError); + end; +end; + +function TFpValueDwarfArray.DoGetDimStride(AnIndex: integer; out + AStride: TFpDbgValueSize): Boolean; +var + ExtraStride: TFpDbgValueSize; +begin + Result := GetMemberSize(AStride); + if Result and (not IsError(LastError)) then begin + assert(TypeInfo.NestedSymbolCount > AnIndex, 'TFpValueDwarfArray.DoGetDimStride(): TypeInfo.NestedSymbolCount > 0'); + Result := TFpSymbolDwarfType(TypeInfo.NestedSymbol[AnIndex]).DoReadStride(Self, ExtraStride); + if Result then + AStride := AStride + ExtraStride + else + Result := not IsError(LastError); + end; +end; + constructor TFpValueDwarfArray.Create(ADwarfTypeSymbol: TFpSymbolDwarfType; AnArraySymbol: TFpSymbolDwarfTypeArray); begin @@ -2737,6 +2853,98 @@ begin inherited Destroy; end; +function TFpValueDwarfArray.GetOrdering(out ARowMajor: Boolean): Boolean; +begin + Result := not (efRowMajorUnavail in FEvalFlags); + if not Result then // If there was an error, then LastError should still be set + exit; + + if not (efRowMajorDone in FEvalFlags) then begin + Result := DoGetOrdering(FRowMajor); + if Result then + Include(FEvalFlags, efRowMajorDone) + else + Include(FEvalFlags, efRowMajorUnavail); + end; + + ARowMajor := FRowMajor; +end; + +function TFpValueDwarfArray.GetStride(out AStride: TFpDbgValueSize): Boolean; +begin + AStride := ZeroSize; + Result := not (efStrideUnavail in FEvalFlags); + if not Result then // If there was an error, then LastError should still be set + exit; + + if not (efStrideDone in FEvalFlags) then begin + Result := DoGetStride(FStride); + if Result then + Include(FEvalFlags, efStrideDone) + else + Include(FEvalFlags, efStrideUnavail); + end; + + AStride := FStride; +end; + +function TFpValueDwarfArray.GetMemberSize(out ASize: TFpDbgValueSize): Boolean; +begin + Result := not (efMemberSizeUnavail in FEvalFlags); + if not Result then // If there was an error, then LastError should still be set + exit; + + if not (efMemberSizeDone in FEvalFlags) then begin + Result := DoGetMemberSize(FMemberSize); + if Result then + Include(FEvalFlags, efMemberSizeDone) + else + Include(FEvalFlags, efMemberSizeUnavail); + end; + + ASize := FMemberSize; +end; + +function TFpValueDwarfArray.GetMainStride(out AStride: TFpDbgValueSize + ): Boolean; +begin + AStride := ZeroSize; + Result := not (efMainStrideUnavail in FEvalFlags); + if not Result then // If there was an error, then LastError should still be set + exit; + + if not (efMainStrideDone in FEvalFlags) then begin + Result := DoGetMainStride(FMainStride); + if Result then + Include(FEvalFlags, efMainStrideDone) + else + Include(FEvalFlags, efMainStrideUnavail); + end; + + AStride := FMainStride; +end; + +function TFpValueDwarfArray.GetDimStride(AnIndex: integer; out + AStride: TFpDbgValueSize): Boolean; +begin + AStride := ZeroSize; + Result := AnIndex < MemberCount; + if not Result then + exit; + if AnIndex < Length(FStrides) then + SetLength(FStrides, MemberCount); + + Result := not FStrides[AnIndex].Unavail; + if not Result then + exit; + if not FStrides[AnIndex].Done then begin + Result := DoGetDimStride(AnIndex, FStrides[AnIndex].Stride); + FStrides[AnIndex].Done := Result; + FStrides[AnIndex].Unavail := not Result; + end; + AStride := FStrides[AnIndex].Stride; +end; + { TDbgDwarfIdentifier } function TFpSymbolDwarf.GetNestedTypeInfo: TFpSymbolDwarfType; @@ -2832,13 +3040,13 @@ begin SetTypeInfo(NestedTypeInfo); end; -function TFpSymbolDwarf.DoForwardReadSize(const AValueObj: TFpValue; out ASize: QWord - ): Boolean; +function TFpSymbolDwarf.DoForwardReadSize(const AValueObj: TFpValue; out + ASize: TFpDbgValueSize): Boolean; begin Result := inherited DoReadSize(AValueObj, ASize); end; -function TFpSymbolDwarf.DataSize: Integer; +function TFpSymbolDwarf.DataSize: TFpDbgValueSize; var t: TFpSymbolDwarfType; begin @@ -2846,7 +3054,7 @@ begin if t <> nil then Result := t.DataSize else - Result := 0; + Result := ZeroSize; end; function TFpSymbolDwarf.InitLocationParser(const ALocationParser: TDwarfLocationExpression; @@ -2880,10 +3088,12 @@ function TFpSymbolDwarf.ComputeDataMemberAddress( const AnInformationEntry: TDwarfInformationEntry; AValueObj: TFpValueDwarf; var AnAddress: TFpDbgMemLocation): Boolean; var - AttrData: TDwarfAttribData; + AttrData, AttrDataBitSize, AttrDataBitOffset: TDwarfAttribData; Form: Cardinal; ConstOffs: Int64; InitLocParserData: TInitLocParserData; + ByteSize: TFpDbgValueSize; + BitOffset, BitSize: Int64; begin Result := True; if AnInformationEntry.GetAttribData(DW_AT_data_member_location, AttrData) then begin @@ -2913,12 +3123,47 @@ begin else begin SetLastError(CreateError(fpErrAnyError)); end; + + // Bit Offset + if Result and AnInformationEntry.GetAttribData(DW_AT_bit_offset, AttrDataBitOffset) then begin + // Make sure we have ALL the data needed + Result := InformationEntry.GetAttribData(DW_AT_bit_size, AttrDataBitSize); + if Result then + if InformationEntry.GetAttribData(DW_AT_byte_size, AttrData) then begin + ByteSize := ZeroSize; + Result := ConstRefOrExprFromAttrData(AttrData, AValueObj as TFpValueDwarf, ByteSize.Size); + end + else + Result := (TypeInfo <> nil) and TypeInfo.ReadSize(AValueObj, ByteSize); + + if Result then + Result := ConstRefOrExprFromAttrData(AttrDataBitOffset, AValueObj as TFpValueDwarf, BitOffset) and + ConstRefOrExprFromAttrData(AttrDataBitSize, AValueObj as TFpValueDwarf, BitSize); + + if Result then + AnAddress := AddBitOffset(AnAddress + ByteSize, -(BitOffset + BitSize)); + end; + + if not Result then + SetLastError(CreateError(fpErrAnyError)); + exit; end; + + // Dwarf 4 + if AnInformationEntry.GetAttribData(DW_AT_data_bit_offset, AttrData) then begin + Result := ConstRefOrExprFromAttrData(AttrData, AValueObj as TFpValueDwarf, BitOffset); + if Result then + AnAddress := AddBitOffset(AnAddress, BitOffset); + + if not Result then + SetLastError(CreateError(fpErrAnyError)); + end; + end; function TFpSymbolDwarf.ConstRefOrExprFromAttrData( const AnAttribData: TDwarfAttribData; AValueObj: TFpValueDwarf; out - AValue: TDBGPtr; AReadState: PFpDwarfAtEntryDataReadState; + AValue: Int64; AReadState: PFpDwarfAtEntryDataReadState; ADataSymbol: PFpSymbolDwarfData): Boolean; var Form: Cardinal; @@ -2997,7 +3242,7 @@ begin InitLocParserData.ObjectDataAddrPush := False; Result := LocationFromAttrData(AnAttribData, AValueObj, t, @InitLocParserData); if Result then - AValue := t.Address + AValue := Int64(t.Address) else SetLastError(CreateError(fpErrLocationParser)); end @@ -3120,7 +3365,7 @@ function TFpSymbolDwarf.GetDataAddress(AValueObj: TFpValueDwarf; var ti: TFpSymbolDwarfType; AttrData: TDwarfAttribData; - t: TDBGPtr; + t: Int64; dummy: Boolean; begin Assert(self is TFpSymbolDwarfType); @@ -3430,21 +3675,62 @@ begin end; function TFpSymbolDwarfType.DoReadSize(const AValueObj: TFpValue; out - ASize: QWord): Boolean; + ASize: TFpDbgValueSize): Boolean; var AttrData: TDwarfAttribData; + Bits: Int64; begin - ASize := 0; - Result := InformationEntry.GetAttribData(DW_AT_byte_size, AttrData); - if not Result then - exit; // Does not have a size / No error + ASize := ZeroSize; + Result := False; - Result := ConstRefOrExprFromAttrData(AttrData, AValueObj as TFpValueDwarf, ASize); - //if Result then - // exit; + if InformationEntry.GetAttribData(DW_AT_bit_size, AttrData) then begin + Result := ConstRefOrExprFromAttrData(AttrData, AValueObj as TFpValueDwarf, Bits); + if not Result then begin + // If AValueObj <> nil then + //AValueObj.LastError := LastError; + exit; + end; + ASize := SizeFromBits(Bits); + exit; + end; - // If AValueObj <> nil then - //AValueObj.LastError := LastError; + if InformationEntry.GetAttribData(DW_AT_byte_size, AttrData) then begin + Result := ConstRefOrExprFromAttrData(AttrData, AValueObj as TFpValueDwarf, ASize.Size); + if not Result then begin + // If AValueObj <> nil then + //AValueObj.LastError := LastError; + exit; + end; + end; + + // If it does not have a size => No error +end; + +function TFpSymbolDwarfType.DoReadStride(AValueObj: TFpValueDwarf; out + AStride: TFpDbgValueSize): Boolean; +var + BitStride: Int64; + AttrData: TDwarfAttribData; +begin + AStride := ZeroSize; + if InformationEntry.GetAttribData(DW_AT_bit_stride, AttrData) then begin + Result := ConstRefOrExprFromAttrData(AttrData, AValueObj as TFpValueDwarf, BitStride); + AStride := SizeFromBits(BitStride); + if not Result then begin + // If AValueObj <> nil then + //AValueObj.LastError := LastError; + end; + exit; + end; + + if InformationEntry.GetAttribData(DW_AT_byte_stride, AttrData) then begin + Result := ConstRefOrExprFromAttrData(AttrData, AValueObj as TFpValueDwarf, AStride.Size); + if not Result then begin + // If AValueObj <> nil then + //AValueObj.LastError := LastError; + end; + exit; + end; end; function TFpSymbolDwarfType.GetTypedValueObject(ATypeCast: Boolean; @@ -3464,6 +3750,12 @@ begin ti.ResetValueBounds; end; +function TFpSymbolDwarfType.ReadStride(AValueObj: TFpValueDwarf; out + AStride: TFpDbgValueSize): Boolean; +begin + Result := DoReadStride(AValueObj, AStride); +end; + class function TFpSymbolDwarfType.CreateTypeSubClass(AName: String; AnInformationEntry: TDwarfInformationEntry): TFpSymbolDwarfType; var @@ -3548,13 +3840,13 @@ end; function TFpSymbolDwarfTypeBasic.GetValueLowBound(AValueObj: TFpValue; out ALowBound: Int64): Boolean; var - Size: QWord; + Size: TFpDbgValueSize; begin Result := AValueObj.GetSize(Size); if not Result then exit; case Kind of - skInteger: ALowBound := -(int64( high(int64) shr (64 - Min(Size, 8) * 8)))-1; + skInteger: ALowBound := -(int64( high(int64) shr (64 - Min(Size.Size, 8) * 8)))-1; skCardinal: ALowBound := 0; else Result := False; @@ -3564,14 +3856,14 @@ end; function TFpSymbolDwarfTypeBasic.GetValueHighBound(AValueObj: TFpValue; out AHighBound: Int64): Boolean; var - Size: QWord; + Size: TFpDbgValueSize; begin Result := AValueObj.GetSize(Size); if not Result then exit; case Kind of - skInteger: AHighBound := int64( high(int64) shr (64 - Min(Size, 8) * 8)); - skCardinal: AHighBound := int64( high(qword) shr (64 - Min(Size, 8) * 8)); + skInteger: AHighBound := int64( high(int64) shr (64 - Min(Size.Size, 8) * 8)); + skCardinal: AHighBound := int64( high(qword) shr (64 - Min(Size.Size, 8) * 8)); else Result := False; end; @@ -3645,7 +3937,7 @@ begin end; function TFpSymbolDwarfTypeModifier.DoReadSize(const AValueObj: TFpValue; out - ASize: QWord): Boolean; + ASize: TFpDbgValueSize): Boolean; begin Result := inherited DoForwardReadSize(AValueObj, ASize); end; @@ -3691,7 +3983,7 @@ begin Result := AValueObj.MemManager <> nil; if not Result then exit; - AnAddress := AValueObj.MemManager.ReadAddress(AnAddress, CompilationUnit.AddressSize); + AnAddress := AValueObj.MemManager.ReadAddress(AnAddress, SizeVal(CompilationUnit.AddressSize)); Result := IsValidLoc(AnAddress); if (not Result) and @@ -3766,7 +4058,7 @@ begin end; function TFpSymbolDwarfTypeSubRange.DoReadSize(const AValueObj: TFpValue; out - ASize: QWord): Boolean; + ASize: TFpDbgValueSize): Boolean; var t: TFpSymbolDwarfType; begin @@ -3839,7 +4131,7 @@ function TFpSymbolDwarfTypeSubRange.GetValueLowBound(AValueObj: TFpValue; out ALowBound: Int64): Boolean; var AttrData: TDwarfAttribData; - t: TDBGPtr; + t: Int64; begin assert((AValueObj = nil) or (AValueObj is TFpValueDwarf), 'TFpSymbolDwarfTypeSubRange.GetValueLowBound: AValueObj is TFpValueDwarf('); if FLowBoundState = rfNotRead then begin @@ -3847,7 +4139,7 @@ begin ConstRefOrExprFromAttrData(AttrData, TFpValueDwarf(AValueObj), t, @FLowBoundState, @FLowBoundSymbol) else FLowBoundState := rfNotFound; - FLowBoundConst := int64(t); + FLowBoundConst := t; end; Result := FLowBoundState in [rfConst, rfValue, rfExpression]; @@ -3858,7 +4150,7 @@ function TFpSymbolDwarfTypeSubRange.GetValueHighBound(AValueObj: TFpValue; out AHighBound: Int64): Boolean; var AttrData: TDwarfAttribData; - t: TDBGPtr; + t: int64; begin assert((AValueObj = nil) or (AValueObj is TFpValueDwarf), 'TFpSymbolDwarfTypeSubRange.GetValueHighBound: AValueObj is TFpValueDwarf('); if FHighBoundState = rfNotRead then begin @@ -3866,7 +4158,7 @@ begin ConstRefOrExprFromAttrData(AttrData, TFpValueDwarf(AValueObj), t, @FHighBoundState, @FHighBoundSymbol) else FHighBoundState := rfNotFound; - FHighBoundConst := int64(t); + FHighBoundConst := t; end; Result := FHighBoundState in [rfConst, rfValue, rfExpression]; @@ -3880,7 +4172,7 @@ begin ConstRefOrExprFromAttrData(AttrData, TFpValueDwarf(AValueObj), t, @FCountState, @FCountSymbol) else FCountState := rfNotFound; - FCountConst := int64(t); + FCountConst := t; end; Result := FCountState in [rfConst, rfValue, rfExpression]; @@ -3907,9 +4199,10 @@ begin end; function TFpSymbolDwarfTypePointer.DoReadSize(const AValueObj: TFpValue; out - ASize: QWord): Boolean; + ASize: TFpDbgValueSize): Boolean; begin - ASize := CompilationUnit.AddressSize; + ASize := ZeroSize; + ASize.Size := CompilationUnit.AddressSize; Result := True; end; @@ -4007,7 +4300,7 @@ begin Result := AValueObj.MemManager <> nil; if not Result then exit; - AnAddress := AValueObj.MemManager.ReadAddress(AnAddress, CompilationUnit.AddressSize); + AnAddress := AValueObj.MemManager.ReadAddress(AnAddress, SizeVal(CompilationUnit.AddressSize)); Result := IsValidLoc(AnAddress); if not Result then @@ -4219,6 +4512,39 @@ end; { TFpSymbolDwarfDataMember } +function TFpSymbolDwarfDataMember.DoReadSize(const AValueObj: TFpValue; out + ASize: TFpDbgValueSize): Boolean; +// COPY OF TFpSymbolDwarfType.DoReadSize +var + AttrData: TDwarfAttribData; + Bits: Int64; +begin + ASize := ZeroSize; + Result := False; + + if InformationEntry.GetAttribData(DW_AT_bit_size, AttrData) then begin + Result := ConstRefOrExprFromAttrData(AttrData, AValueObj as TFpValueDwarf, Bits); + if not Result then begin + // If AValueObj <> nil then + //AValueObj.LastError := LastError; + exit; + end; + ASize := SizeFromBits(Bits); + exit; + end; + + if InformationEntry.GetAttribData(DW_AT_byte_size, AttrData) then begin + Result := ConstRefOrExprFromAttrData(AttrData, AValueObj as TFpValueDwarf, ASize.Size); + if not Result then begin + // If AValueObj <> nil then + //AValueObj.LastError := LastError; + exit; + end; + end; + + // If it does not have a size => No error +end; + function TFpSymbolDwarfDataMember.GetValueAddress(AValueObj: TFpValueDwarf; out AnAddress: TFpDbgMemLocation): Boolean; begin @@ -4462,52 +4788,31 @@ begin Info.ReleaseReference; end; -procedure TFpSymbolDwarfTypeArray.ReadStride(AValObject: TFpValueDwarf); -var - t: TFpSymbolDwarfType; - Size: QWord; -begin - if didtStrideRead in FDwarfArrayReadFlags then - exit; - Include(FDwarfArrayReadFlags, didtStrideRead); - if InformationEntry.ReadValue(DW_AT_bit_stride, FStrideInBits) then - exit; - - CreateMembers; - if (FMembers.Count > 0) and // TODO: stride for diff member - (TDbgDwarfSymbolBase(FMembers[0]).InformationEntry.ReadValue(DW_AT_byte_stride, FStrideInBits)) - then begin - FStrideInBits := FStrideInBits * 8; - exit; - end; - - t := NestedTypeInfo; - if not t.ReadSize(nil, Size) then // TODO: need value object for that member. - exit; - if t = nil then - FStrideInBits := 0 // TODO error - else - FStrideInBits := Size * 8; -end; - -procedure TFpSymbolDwarfTypeArray.ReadOrdering; -var - AVal: Integer; -begin - if didtOrdering in FDwarfArrayReadFlags then - exit; - Include(FDwarfArrayReadFlags, didtOrdering); - if InformationEntry.ReadValue(DW_AT_ordering, AVal) then - FRowMajor := AVal = DW_ORD_row_major - else - FRowMajor := True; // default (at least in pas) -end; - procedure TFpSymbolDwarfTypeArray.KindNeeded; begin SetKind(skArray); // Todo: static/dynamic? end; +function TFpSymbolDwarfTypeArray.DoReadOrdering(AValObject: TFpValueDwarf; out + ARowMajor: Boolean): Boolean; +var + AVal: Integer; + AttrData: TDwarfAttribData; +begin + Result := True; + ARowMajor := True; // default (at least in pas) + + if InformationEntry.GetAttribData(DW_AT_ordering, AttrData) then begin + Result := InformationEntry.ReadValue(AttrData, AVal); + if Result then + ARowMajor := AVal = DW_ORD_row_major + else + // If AValueObj <> nil then + //AValueObj.LastError := LastError; + ; + end; +end; + function TFpSymbolDwarfTypeArray.GetTypedValueObject(ATypeCast: Boolean; AnOuterType: TFpSymbolDwarfType): TFpValueDwarf; begin @@ -4564,17 +4869,21 @@ end; function TFpSymbolDwarfTypeArray.GetMemberAddress(AValObject: TFpValueDwarf; const AIndex: array of Int64): TFpDbgMemLocation; var - Idx, Offs, Factor: Int64; + Idx, Factor: Int64; LowBound, HighBound: int64; i: Integer; - bsize: Integer; m: TFpSymbolDwarf; + RowMajor: Boolean; + Offs, StrideInBits: TFpDbgValueSize; begin assert((AValObject is TFpValueDwarfArray), 'TFpSymbolDwarfTypeArray.GetMemberAddress AValObject'); - ReadOrdering; - ReadStride(AValObject); // TODO Stride per member (member = dimension/index) +// ReadOrdering; +// ReadStride(AValObject); // TODO Stride per member (member = dimension/index) Result := InvalidLoc; - if (FStrideInBits <= 0) or (FStrideInBits mod 8 <> 0) then + + if not TFpValueDwarfArray(AValObject).GetMainStride(StrideInBits) then + exit; + if (StrideInBits <= 0) then exit; CreateMembers; @@ -4595,12 +4904,14 @@ begin Exit; end; - Offs := 0; + Offs := ZeroSize; Factor := 1; + + if not TFpValueDwarfArray(AValObject).GetOrdering(RowMajor) then + exit; {$PUSH}{$R-}{$Q-} // TODO: check range of index - bsize := FStrideInBits div 8; - if FRowMajor then begin + if RowMajor then begin for i := Length(AIndex) - 1 downto 0 do begin Idx := AIndex[i]; m := TFpSymbolDwarf(FMembers[i]); @@ -4610,13 +4921,13 @@ begin exit; end; Idx := Idx - LowBound; - Offs := Offs + Idx * bsize * Factor; + Offs := Offs + StrideInBits * Idx * Factor; Factor := Factor * (HighBound - LowBound + 1); // TODO range check end else begin if m.GetValueLowBound(AValObject, LowBound) then Idx := Idx - LowBound; - Offs := Offs + Idx * bsize * Factor; + Offs := Offs + StrideInBits * Idx * Factor; end; end; end @@ -4630,19 +4941,19 @@ begin exit; end; Idx := Idx - LowBound; - Offs := Offs + Idx * bsize * Factor; + Offs := Offs + StrideInBits * Idx * Factor; Factor := Factor * (HighBound - LowBound + 1); // TODO range check end else begin if m.GetValueLowBound(AValObject, LowBound) then Idx := Idx - LowBound; - Offs := Offs + Idx * bsize * Factor; + Offs := Offs + StrideInBits * Idx * Factor; end; end; end; assert(IsReadableMem(Result), 'DwarfArray MemberAddress'); - Result.Address := Result.Address + Offs; + Result := Result + Offs; {$POP} end; @@ -4658,7 +4969,6 @@ var begin debuglnEnter(['TFpSymbolDwarfTypeArray.ResetValueBounds ' , Self.ClassName, dbgs(self)]); try inherited ResetValueBounds; - FDwarfArrayReadFlags := []; if FMembers <> nil then for i := 0 to FMembers.Count - 1 do if TObject(FMembers[i]) is TFpSymbolDwarfType then @@ -4938,9 +5248,10 @@ begin end; function TFpSymbolDwarfTypeProc.DoReadSize(const AValueObj: TFpValue; out - ASize: QWord): Boolean; + ASize: TFpDbgValueSize): Boolean; begin - ASize := FAddressInfo^.EndPC - FAddressInfo^.StartPC; + ASize := ZeroSize; + ASize.Size := FAddressInfo^.EndPC - FAddressInfo^.StartPC; Result := True; end; diff --git a/components/fpdebug/fpdbgdwarfconst.pas b/components/fpdebug/fpdbgdwarfconst.pas index 554dc1f2ee..7f4e9100fc 100644 --- a/components/fpdebug/fpdbgdwarfconst.pas +++ b/components/fpdebug/fpdbgdwarfconst.pas @@ -191,6 +191,8 @@ const DW_AT_elemental = $66 ; // flag DW_AT_pure = $67 ; // flag DW_AT_recursive = $68 ; // flag + // -- DWARF 4 -- + DW_AT_data_bit_offset = $6b ; // constant // block, constant, reference // --- --- DW_AT_lo_user = $2000; // --- DW_AT_hi_user = $3fff; // --- diff --git a/components/fpdebug/fpdbgdwarfdataclasses.pas b/components/fpdebug/fpdbgdwarfdataclasses.pas index f34ab80d49..c19dd6d3d3 100644 --- a/components/fpdebug/fpdbgdwarfdataclasses.pas +++ b/components/fpdebug/fpdbgdwarfdataclasses.pas @@ -1788,6 +1788,7 @@ procedure TDwarfLocationStack.PushConst(const AVal: TDBGPtr); begin if Length(FList) <= FCount then IncCapacity; + FList[FCount] := Default(TFpDbgMemLocation); with FList[FCount] do begin Address := AVal; MType := mlfConstant; @@ -1799,6 +1800,7 @@ procedure TDwarfLocationStack.PushTargetMem(const AVal: TDBGPtr); begin if Length(FList) <= FCount then IncCapacity; + FList[FCount] := Default(TFpDbgMemLocation); with FList[FCount] do begin Address := AVal; MType := mlfTargetMem; @@ -1900,7 +1902,7 @@ var begin //TODO: zero fill / sign extend if (ASize > SizeOf(AValue)) or (ASize > AddrSize) then exit(False); - Result := FMemManager.ReadAddress(AnAddress, ASize, AValue, FContext); + Result := FMemManager.ReadAddress(AnAddress, SizeVal(ASize), AValue, FContext); if not Result then SetError; end; @@ -1909,7 +1911,7 @@ var begin //TODO: zero fill / sign extend if (ASize > SizeOf(AValue)) or (ASize > AddrSize) then exit(False); - AValue := FMemManager.ReadAddressEx(AnAddress, AnAddrSpace, ASize, FContext); + AValue := FMemManager.ReadAddressEx(AnAddress, AnAddrSpace, SizeVal(ASize), FContext); Result := IsValidLoc(AValue); if not Result then SetError; diff --git a/components/fpdebug/fpdbgdwarffreepascal.pas b/components/fpdebug/fpdbgdwarffreepascal.pas index 8103023886..0bfe6788d9 100644 --- a/components/fpdebug/fpdbgdwarffreepascal.pas +++ b/components/fpdebug/fpdbgdwarffreepascal.pas @@ -118,7 +118,7 @@ type function GetDataAddressNext(AValueObj: TFpValueDwarf; var AnAddress: TFpDbgMemLocation; out ADoneWork: Boolean; ATargetType: TFpSymbolDwarfType): Boolean; override; function GetTypedValueObject(ATypeCast: Boolean; AnOuterType: TFpSymbolDwarfType = nil): TFpValueDwarf; override; - function DataSize: Integer; override; + function DataSize: TFpDbgValueSize; override; public property IsInternalPointer: Boolean read GetIsInternalPointer write FIsInternalPointer; // Class (also DynArray, but DynArray is handled without this) end; @@ -668,7 +668,7 @@ begin Result := AValueObj.MemManager <> nil; if not Result then exit; - AnAddress := AValueObj.MemManager.ReadAddress(AnAddress, CompilationUnit.AddressSize); + AnAddress := AValueObj.MemManager.ReadAddress(AnAddress, SizeVal(CompilationUnit.AddressSize)); Result := IsValidLoc(AnAddress); if (not Result) and @@ -689,14 +689,14 @@ begin Result := inherited GetTypedValueObject(ATypeCast, AnOuterType); end; -function TFpSymbolDwarfFreePascalTypePointer.DataSize: Integer; +function TFpSymbolDwarfFreePascalTypePointer.DataSize: TFpDbgValueSize; var - Size: QWord; + Size: TFpDbgValueSize; begin if Kind = skClass then begin // TODO: get a value object // though fpc does not yet write variable sizes if not NestedTypeInfo.ReadSize(nil, Size) then begin - Result := 0; + Result := ZeroSize; SetLastError(CreateError(fpErrAnyError, ['unknown size'])); exit; end; @@ -780,7 +780,8 @@ end; function TFpValueDwarfV2FreePascalShortString.GetAsString: AnsiString; var - len, Size: QWord; + len: QWord; + Size: TFpDbgValueSize; LenSym, StSym: TFpValueDwarf; begin if FValueDone then @@ -795,7 +796,7 @@ begin SetLastError(CreateError(fpErrAnyError)); exit(''); end; - if (Size < 0) or (len > Size) then begin + if (Size < len) then begin SetLastError(CreateError(fpErrAnyError)); exit(''); end; @@ -806,7 +807,7 @@ begin SetLength(Result, len); if len > 0 then - if not MemManager.ReadMemory(StSym.DataAddress, len, @Result[1]) then begin + if not MemManager.ReadMemory(StSym.DataAddress, SizeVal(len), @Result[1]) then begin Result := ''; // TODO: error SetLastError(MemManager.LastError); StSym.ReleaseReference; @@ -907,7 +908,7 @@ begin exit(0); // dyn array, but bad data Addr.Address := Addr.Address - AddressSize; //debugln(['TFpValueDwarfArray.GetMemberCount XXXXXXXXXXXXXXX dwarf 2 read len']); - if MemManager.ReadSignedInt(Addr, AddressSize, h) then begin + if MemManager.ReadSignedInt(Addr, SizeVal(AddressSize), h) then begin Result := Integer(h)+1; exit; end @@ -928,7 +929,7 @@ var Info: TDwarfInformationEntry; t: Cardinal; t2: TFpSymbol; - CharSize: QWord; + CharSize: TFpDbgValueSize; begin Result := FArrayOrStringType; if Result <> iasUnknown then @@ -959,8 +960,8 @@ begin // TODO: check the location parser, if it is a reference //FIsShortString := iasShortString; if not t2.ReadSize(nil, CharSize) then - CharSize := 0; // TODO: error - if (CharSize = 2) then + CharSize := ZeroSize; // TODO: error + if (CharSize.Size = 2) then FArrayOrStringType := iasUnicodeString else FArrayOrStringType := iasAnsiString; @@ -1095,7 +1096,7 @@ begin // read data and check for DW_OP_shr ? Addr2 := Addr; Addr2.Address := Addr2.Address - AddressSize; - if MemManager.ReadSignedInt(Addr2, AddressSize, i) then begin + if MemManager.ReadSignedInt(Addr2, SizeVal(AddressSize), i) then begin if (i shr 1) = HighBound then HighBound := i; end @@ -1116,7 +1117,7 @@ begin if t.Kind = skWideString then begin SetLength(WResult, HighBound-LowBound+1); - if not MemManager.ReadMemory(Addr, (HighBound-LowBound+1)*2, @WResult[1]) then begin + if not MemManager.ReadMemory(Addr, SizeVal((HighBound-LowBound+1)*2), @WResult[1]) then begin WResult := ''; SetLastError(MemManager.LastError); end; @@ -1124,7 +1125,7 @@ begin end else begin SetLength(Result, HighBound-LowBound+1); - if not MemManager.ReadMemory(Addr, HighBound-LowBound+1, @Result[1]) then begin + if not MemManager.ReadMemory(Addr, SizeVal(HighBound-LowBound+1), @Result[1]) then begin Result := ''; SetLastError(MemManager.LastError); end; diff --git a/components/fpdebug/fpdbginfo.pas b/components/fpdebug/fpdbginfo.pas index ba8f43cd21..0074664a57 100644 --- a/components/fpdebug/fpdbginfo.pas +++ b/components/fpdebug/fpdbginfo.pas @@ -96,7 +96,7 @@ type private FEvalFlags: set of (efSizeDone, efSizeUnavail); FLastError: TFpError; - FSize: QWord; + FSize: TFpDbgValueSize; protected procedure Reset; virtual; // keeps lastmember and structureninfo procedure SetLastError(ALastError: TFpError); @@ -112,9 +112,9 @@ type function GetAsFloat: Extended; virtual; function GetAddress: TFpDbgMemLocation; virtual; - function DoGetSize(out ASize: QWord): Boolean; virtual; + function DoGetSize(out ASize: TFpDbgValueSize): Boolean; virtual; function GetDataAddress: TFpDbgMemLocation; virtual; - function GetDataSize: QWord; virtual; + function GetDataSize: TFpDbgValueSize; virtual; function GetHasBounds: Boolean; virtual; function GetOrdHighBound: Int64; virtual; @@ -137,7 +137,7 @@ type constructor Create; property RefCount; - function GetSize(out ASize: QWord): Boolean; inline; + function GetSize(out ASize: TFpDbgValueSize): Boolean; inline; // Kind: determines which types of value are available property Kind: TDbgSymbolKind read GetKind; @@ -159,7 +159,7 @@ type *) property Address: TFpDbgMemLocation read GetAddress; property DataAddress: TFpDbgMemLocation read GetDataAddress; // - property DataSize: QWord read GetDataSize; + property DataSize: TFpDbgValueSize read GetDataSize; property HasBounds: Boolean read GetHasBounds; property OrdLowBound: Int64 read GetOrdLowBound; // need typecast for QuadWord @@ -352,7 +352,7 @@ type procedure NameNeeded; virtual; procedure SymbolTypeNeeded; virtual; procedure AddressNeeded; virtual; - function DoReadSize(const AValueObj: TFpValue; out ASize: QWord): Boolean; virtual; + function DoReadSize(const AValueObj: TFpValue; out ASize: TFpDbgValueSize): Boolean; virtual; procedure TypeInfoNeeded; virtual; procedure MemberVisibilityNeeded; virtual; //procedure Needed; virtual; @@ -367,7 +367,7 @@ type // Memory; Size is also part of type (byte vs word vs ...) property Address: TFpDbgMemLocation read GetAddress; // used by Proc/func // ReadSize: Return False means no value available, and an error may or may not have occurred - function ReadSize(const AValueObj: TFpValue; out ASize: QWord{TDbgPtr}): Boolean; inline; + function ReadSize(const AValueObj: TFpValue; out ASize: TFpDbgValueSize): Boolean; inline; // TypeInfo used by // stValue (Variable): Type // stType: Pointer: type pointed to / Array: Element Type / Func: Result / Class: itheritance @@ -431,7 +431,7 @@ type procedure KindNeeded; override; procedure NameNeeded; override; procedure SymbolTypeNeeded; override; - function DoReadSize(const AValueObj: TFpValue; out ASize: QWord): Boolean; override; + function DoReadSize(const AValueObj: TFpValue; out ASize: TFpDbgValueSize): Boolean; override; procedure TypeInfoNeeded; override; procedure MemberVisibilityNeeded; override; @@ -672,7 +672,7 @@ begin Result := InvalidLoc; end; -function TFpValue.DoGetSize(out ASize: QWord): Boolean; +function TFpValue.DoGetSize(out ASize: TFpDbgValueSize): Boolean; var ti: TFpSymbol; begin @@ -691,12 +691,12 @@ begin Result := Address; end; -function TFpValue.GetDataSize: QWord; +function TFpValue.GetDataSize: TFpDbgValueSize; begin GetSize(Result); end; -function TFpValue.GetSize(out ASize: QWord): Boolean; +function TFpValue.GetSize(out ASize: TFpDbgValueSize): Boolean; begin Result := False; if (efSizeUnavail in FEvalFlags) then // If there was an error, then LastError should still be set @@ -914,8 +914,8 @@ begin inherited Destroy; end; -function TFpSymbol.ReadSize(const AValueObj: TFpValue; out ASize: QWord - ): Boolean; +function TFpSymbol.ReadSize(const AValueObj: TFpValue; out + ASize: TFpDbgValueSize): Boolean; begin Result := DoReadSize(AValueObj, ASize); end; @@ -1120,10 +1120,10 @@ begin SetAddress(InvalidLoc); end; -function TFpSymbol.DoReadSize(const AValueObj: TFpValue; out ASize: QWord - ): Boolean; +function TFpSymbol.DoReadSize(const AValueObj: TFpValue; out + ASize: TFpDbgValueSize): Boolean; begin - ASize := 0; + ASize := ZeroSize; Result := False; end; @@ -1206,7 +1206,7 @@ begin end; function TFpSymbolForwarder.DoReadSize(const AValueObj: TFpValue; out - ASize: QWord): Boolean; + ASize: TFpDbgValueSize): Boolean; var p: TFpSymbol; begin diff --git a/components/fpdebug/fpdbgsymtablecontext.pas b/components/fpdebug/fpdbgsymtablecontext.pas index 96ebab17ea..239d51e1cf 100644 --- a/components/fpdebug/fpdbgsymtablecontext.pas +++ b/components/fpdebug/fpdbgsymtablecontext.pas @@ -92,6 +92,7 @@ begin i := FFpSymbolInfo.FSymbolList.IndexOf(AName); if i > -1 then begin + val := Default(TFpDbgMemLocation); val.Address:=FFpSymbolInfo.FSymbolList.Data[i]; val.MType:=mlfTargetMem; result := TFpValueConstAddress.Create(val); diff --git a/components/fpdebug/fpdmemorytools.pas b/components/fpdebug/fpdmemorytools.pas index eb55e0d15a..c5d14d4266 100644 --- a/components/fpdebug/fpdmemorytools.pas +++ b/components/fpdebug/fpdmemorytools.pas @@ -26,10 +26,44 @@ interface uses Classes, SysUtils, math, DbgIntfBaseTypes, FpErrorMessages, LazClasses, - Laz_AVL_Tree; + Laz_AVL_Tree, LazLoggerBase; type + TBitAddr = 0..63; // 0-7 for mem read // 0-63 for register read + TBitSize = -7..7; + + TFpDbgMemLocationType = ( + mlfUninitialized := 0, // like invalid, but not known // This (0) is the initial value + mlfInvalid, + mlfTargetMem, // an address in the target (debuggee) process + mlfSelfMem, // an address in this(the debuggers) process memory; the data is in TARGET format (endian, ...) + // the below will be mapped (and extended) according to endianess + mlfTargetRegister, // reads from the register + mlfConstant, // an (up to) SizeOf(TDbgPtr) (=8) Bytes Value (endian in format of debug process) + mlfConstantDeref // A constant that can be used instead of an address (location parser), + // If a value (e.g. literal numeric constant 0x1234) has no address, + // then this is treated as its virtual address. + // If (and only if) the value is attempted to be derefed, then + // it will yield the constant as the result of the deref. + // It can also be tested for nil. The virtual address is never nil. + // Any other access must result in an error. + // Used for PFoo(1234)^ or TObject(1234).Foo + ); + + TFpDbgValueSize = packed record + Size: Int64; // Also used for stride => can be negative + BitSize: TBitSize; // Must have the same sign as Size + end; + PFpDbgValueSize = ^TFpDbgValueSize; + + TFpDbgMemLocation = packed record + Address: TDbgPtr; + MType: TFpDbgMemLocationType; + BitOffset: TBitAddr; + end; + PFpDbgMemLocation = ^TFpDbgMemLocation; + TFpDbgAddressContext = class(TRefCountedObject) protected function GetAddress: TDbgPtr; virtual; abstract; @@ -73,20 +107,23 @@ type TFpDbgMemReadDataType = ( - rdtAddress, rdtSignedInt, rdtUnsignedInt, rdtfloat, + rdtRawRead, rdtAddress, rdtSignedInt, rdtUnsignedInt, rdtfloat, rdtEnum, rdtSet ); TFpDbgMemConvData = record - NewTargetAddress: TDbgPtr; - NewDestAddress: Pointer; - NewReadSize: Cardinal; - PrivData1, PrivData2: Pointer; + SourceLocation: TFpDbgMemLocation; + SourceSize: TFpDbgValueSize; + SourceFullSize: QWord; + DestSize: QWord; end; // Todo, cpu/language specific operations, endianess, sign extend, float .... default int value for bool // convert from debugge format to debuger format and back // TODO: currently it assumes target and own mem are in the same format + + { TFpDbgMemConvertor } + TFpDbgMemConvertor = class public (* PrepareTargetRead @@ -94,13 +131,12 @@ type In case of reading from a bit-offset more memory may be needed, and must be allocated here *) function PrepareTargetRead(AReadDataType: TFpDbgMemReadDataType; - ATargetPointer: TDbgPtr; ADestPointer: Pointer; - ATargetSize, ADestSize: Cardinal; - out AConvertorData: TFpDbgMemConvData + var AConvData: TFpDbgMemConvData; + const ADest: Pointer ): boolean; virtual; abstract; {function PrepareTargetRead(AReadDataType: TFpDbgMemReadDataType; - ATargetPointer: TDbgPtr; ADestPointer: Pointer; - ATargetSize, ADestSize: Cardinal; + ASourceMemPointer: TDbgPtr; ADestPointer: Pointer; + ASourceMemSize, ADestSize: Cardinal; AnOpts: TFpDbgMemReadOptions; out AConvertorData: TFpDbgMemConvData ): boolean; virtual; abstract;} @@ -109,13 +145,13 @@ type called after every Read operation. *) function FinishTargetRead(AReadDataType: TFpDbgMemReadDataType; - ATargetPointer: TDbgPtr; ADestPointer: Pointer; - ATargetSize, ADestSize: Cardinal; - AConvertorData: TFpDbgMemConvData + const AConvData: TFpDbgMemConvData; + const TmpData: Pointer; // can be equal to ADest + const ADest: Pointer ): boolean; virtual; abstract; {function FinishTargetRead(AReadDataType: TFpDbgMemReadDataType; - ATargetPointer: TDbgPtr; ADestPointer: Pointer; - ATargetSize, ADestSize: Cardinal; + ASourceMemPointer: TDbgPtr; ADestPointer: Pointer; + ASourceMemSize, ADestSize: Cardinal; AnOpts: TFpDbgMemReadOptions; AConvertorData: TFpDbgMemConvData ): boolean; virtual; abstract;} @@ -128,7 +164,7 @@ type adjust ADestPointer so it points to the low value part of the dest No conversion *) - procedure AdjustIntPointer(var ADataPointer: Pointer; ADataSize, ANewSize: Cardinal); virtual; abstract; + function AdjustIntPointer(var ADataPointer: Pointer; ADataSize, ANewSize: Cardinal): Boolean; virtual; abstract; //(* SignExtend: // Expects a signed integer value of ASourceSize bytes in the low value end // of the memory (total memory ADataPointer, ADestSize) @@ -147,19 +183,16 @@ type TFpDbgMemConvertorLittleEndian = class(TFpDbgMemConvertor) public function PrepareTargetRead(AReadDataType: TFpDbgMemReadDataType; - ATargetPointer: TDbgPtr; ADestPointer: Pointer; - ATargetSize, ADestSize: Cardinal; - out AConvertorData: TFpDbgMemConvData + var AConvData: TFpDbgMemConvData; + const ADest: Pointer ): boolean; override; function FinishTargetRead(AReadDataType: TFpDbgMemReadDataType; - {%H-}ATargetPointer: TDbgPtr; ADestPointer: Pointer; - ATargetSize, ADestSize: Cardinal; - {%H-}AConvertorData: TFpDbgMemConvData - ): boolean; override; + const AConvData: TFpDbgMemConvData; const TmpData: Pointer; + const ADest: Pointer): boolean; override; procedure FailedTargetRead({%H-}AConvertorData: TFpDbgMemConvData); override; - procedure AdjustIntPointer(var {%H-}ADataPointer: Pointer; ADataSize, ANewSize: Cardinal); override; + function AdjustIntPointer(var ADataPointer: Pointer; ADataSize, ANewSize: Cardinal): Boolean; override; //procedure SignExtend(ADataPointer: Pointer; ASourceSize, ADestSize: Cardinal); override; @@ -246,46 +279,27 @@ type * Provides access to TFpDbgMemConvertor * TODO: allow to pre-read and cache Target mem (e.g. before reading all fields of a record *) - TFpDbgMemLocationType = ( - mlfUninitialized := 0, // like invalid, but not known // This (0) is the initial value - mlfInvalid, - mlfTargetMem, // an address in the target (debuggee) process - mlfSelfMem, // an address in this(the debuggers) process memory; the data is in TARGET format (endian, ...) - // the below will be mapped (and extended) according to endianess - mlfTargetRegister, // reads from the register - mlfConstant, // an (up to) SizeOf(TDbgPtr) (=8) Bytes Value (endian in format of debug process) - mlfConstantDeref // A constant that can be used instead of an address (location parser), - // If a value (e.g. literal numeric constant 0x1234) has no address, - // then this is treated as its virtual address. - // If (and only if) the value is attempted to be derefed, then - // it will yield the constant as the result of the deref. - // It can also be tested for nil. The virtual address is never nil. - // Any other access must result in an error. - // Used for PFoo(1234)^ or TObject(1234).Foo - ); - - TFpDbgMemLocation = packed record - Address: TDbgPtr; - MType: TFpDbgMemLocationType; - end; - PFpDbgMemLocation = ^TFpDbgMemLocation; { TFpDbgMemManager } TFpDbgMemManager = class + private const + TMP_MEM_SIZE = 4096; private FCacheManager: TFpDbgMemCacheManagerBase; FDefaultContext: TFpDbgAddressContext; FLastError: TFpError; FMemReader: TFpDbgMemReaderBase; + FTmpMem: array[0..(TMP_MEM_SIZE div 8)+1] of qword; // MUST have at least ONE extra byte FTargetMemConvertor: TFpDbgMemConvertor; FSelfMemConvertor: TFpDbgMemConvertor; // used when resizing constants (or register values, which are already in self format) function GetCacheManager: TFpDbgMemCacheManagerBase; + procedure BitShiftMem(ASrcMem, ADestMem: Pointer; ASrcSize, ADestSize: cardinal; ABitCnt: Integer); protected function ReadMemory(AReadDataType: TFpDbgMemReadDataType; - const ALocation: TFpDbgMemLocation; ATargetSize: Cardinal; - ADest: Pointer; ADestSize: Cardinal; - AContext: TFpDbgAddressContext = nil): Boolean; + const ASourceLocation: TFpDbgMemLocation; const ASourceSize: TFpDbgValueSize; + const ADest: Pointer; const ADestSize: QWord; AContext: TFpDbgAddressContext + ): Boolean; public procedure SetCacheManager(ACacheMgr: TFpDbgMemCacheManagerBase); property CacheManager: TFpDbgMemCacheManagerBase read GetCacheManager; @@ -295,50 +309,51 @@ type destructor Destroy; override; procedure ClearLastError; - function ReadMemory(const ALocation: TFpDbgMemLocation; ASize: Cardinal; - ADest: Pointer; AContext: TFpDbgAddressContext = nil): Boolean; - function ReadMemoryEx(const ALocation: TFpDbgMemLocation; AnAddressSpace: TDbgPtr; ASize: Cardinal; ADest: Pointer; AContext: TFpDbgAddressContext = nil): Boolean; + function ReadMemory(const ASourceLocation: TFpDbgMemLocation; const ASize: TFpDbgValueSize; + const ADest: Pointer; AContext: TFpDbgAddressContext = nil + ): Boolean; inline; + function ReadMemoryEx(const ASourceLocation: TFpDbgMemLocation; AnAddressSpace: TDbgPtr; ASize: TFpDbgValueSize; ADest: Pointer; AContext: TFpDbgAddressContext = nil): Boolean; (* ReadRegister needs a Context, to get the thread/stackframe *) function ReadRegister(ARegNum: Cardinal; out AValue: TDbgPtr; AContext: TFpDbgAddressContext {= nil}): Boolean; // location will be invalid, if read failed - function ReadAddress(const ALocation: TFpDbgMemLocation; ASize: Cardinal; + function ReadAddress(const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; AContext: TFpDbgAddressContext = nil): TFpDbgMemLocation; function ReadAddressEx(const ALocation: TFpDbgMemLocation; AnAddressSpace: TDbgPtr; - ASize: Cardinal; AContext: TFpDbgAddressContext = nil): TFpDbgMemLocation; + ASize: TFpDbgValueSize; AContext: TFpDbgAddressContext = nil): TFpDbgMemLocation; // ALocation and AnAddress MUST NOT be the same variable on the callers side - function ReadAddress (const ALocation: TFpDbgMemLocation; ASize: Cardinal; + function ReadAddress (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; out AnAddress: TFpDbgMemLocation; AContext: TFpDbgAddressContext = nil): Boolean; inline; - //function ReadAddress (const ALocation: TFpDbgMemLocation; ASize: Cardinal; + //function ReadAddress (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; // out AnAddress: TFpDbgMemLocation; // AnOpts: TFpDbgMemReadOptions; AContext: TFpDbgAddressContext = nil): Boolean; - function ReadUnsignedInt(const ALocation: TFpDbgMemLocation; ASize: Cardinal; + function ReadUnsignedInt(const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; out AValue: QWord; AContext: TFpDbgAddressContext = nil): Boolean; inline; - //function ReadUnsignedInt(const ALocation: TFpDbgMemLocation; ASize: Cardinal; + //function ReadUnsignedInt(const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; // out AValue: QWord; // AnOpts: TFpDbgMemReadOptions; AContext: TFpDbgAddressContext = nil): Boolean; - function ReadSignedInt (const ALocation: TFpDbgMemLocation; ASize: Cardinal; + function ReadSignedInt (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; out AValue: Int64; AContext: TFpDbgAddressContext = nil): Boolean; inline; - //function ReadSignedInt (const ALocation: TFpDbgMemLocation; ASize: Cardinal; + //function ReadSignedInt (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; // out AValue: Int64; // AnOpts: TFpDbgMemReadOptions; AContext: TFpDbgAddressContext = nil): Boolean; // //enum/set: may need bitorder swapped - function ReadEnum (const ALocation: TFpDbgMemLocation; ASize: Cardinal; + function ReadEnum (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; out AValue: QWord; AContext: TFpDbgAddressContext = nil): Boolean; inline; - //function ReadEnum (const ALocation: TFpDbgMemLocation; ASize: Cardinal; + //function ReadEnum (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; // out AValue: QWord; // AnOpts: TFpDbgMemReadOptions; AContext: TFpDbgAddressContext = nil): Boolean; - function ReadSet (const ALocation: TFpDbgMemLocation; ASize: Cardinal; + function ReadSet (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; out AValue: TBytes; AContext: TFpDbgAddressContext = nil): Boolean; inline; - //function ReadSet (const ALocation: TFpDbgMemLocation; ASize: Cardinal; + //function ReadSet (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; // out AValue: TBytes; // AnOpts: TFpDbgMemReadOptions; AContext: TFpDbgAddressContext = nil): Boolean; - function ReadFloat (const ALocation: TFpDbgMemLocation; ASize: Cardinal; + function ReadFloat (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; out AValue: Extended; AContext: TFpDbgAddressContext = nil): Boolean; inline; - //function ReadFloat (const ALocation: TFpDbgMemLocation; ASize: Cardinal; + //function ReadFloat (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize; // out AValue: Extended; // AnOpts: TFpDbgMemReadOptions; AContext: TFpDbgAddressContext = nil): Boolean; @@ -357,95 +372,144 @@ function SelfLoc(AnAddress: TDbgPtr): TFpDbgMemLocation; inline; function SelfLoc(AnAddress: Pointer): TFpDbgMemLocation; inline; function ConstLoc(AValue: QWord): TFpDbgMemLocation; inline; -function IsTargetAddr(ALocation: TFpDbgMemLocation): Boolean; inline; -function IsConstData(ALocation: TFpDbgMemLocation): Boolean; inline; -function IsInitializedLoc(ALocation: TFpDbgMemLocation): Boolean; inline; -function IsValidLoc(ALocation: TFpDbgMemLocation): Boolean; inline; // Valid, Nil allowed -function IsReadableLoc(ALocation: TFpDbgMemLocation): Boolean; inline; // Valid and not Nil // can be const or reg -function IsReadableMem(ALocation: TFpDbgMemLocation): Boolean; inline; // Valid and target or sel <> nil -function IsTargetNil(ALocation: TFpDbgMemLocation): Boolean; inline; // valid targed = nil -function IsTargetNotNil(ALocation: TFpDbgMemLocation): Boolean; inline; // valid targed <> nil +function AddBitOffset(const AnAddr: TFpDbgMemLocation; ABitOffset: Int64): TFpDbgMemLocation; inline; -operator = (a,b: TFpDbgMemLocation): Boolean; inline; +function IsTargetAddr(const ALocation: TFpDbgMemLocation): Boolean; inline; +function IsConstData(const ALocation: TFpDbgMemLocation): Boolean; inline; +function IsInitializedLoc(const ALocation: TFpDbgMemLocation): Boolean; inline; +function IsValidLoc(const ALocation: TFpDbgMemLocation): Boolean; inline; // Valid, Nil allowed +function IsReadableLoc(const ALocation: TFpDbgMemLocation): Boolean; inline; // Valid and not Nil // can be const or reg +function IsReadableMem(const ALocation: TFpDbgMemLocation): Boolean; inline; // Valid and target or sel <> nil +function IsTargetNil(const ALocation: TFpDbgMemLocation): Boolean; inline; // valid targed = nil +function IsTargetNotNil(const ALocation: TFpDbgMemLocation): Boolean; inline; // valid targed <> nil -function LocToAddr(ALocation: TFpDbgMemLocation): TDbgPtr; inline; // does not check valid -function LocToAddrOrNil(ALocation: TFpDbgMemLocation): TDbgPtr; inline; // save version +function ZeroSize: TFpDbgValueSize; inline; +function SizeVal(const ASize: Int64): TFpDbgValueSize; inline; +function SizeFromBits(const ABits: Int64): TFpDbgValueSize; inline; -function EmptyMemReadOpts:TFpDbgMemReadOptions; +function IsZeroSize(const ASize: TFpDbgValueSize): Boolean; inline; +function IsByteSize(const ASize: TFpDbgValueSize): Boolean; inline; +function SizeToFullBytes(const ASize: TFpDbgValueSize): Int64; inline; // Bytes needed to contain this size +function SizeToBits(const ASize: TFpDbgValueSize): Int64; inline; // Bytes needed to contain this size -function dbgs(ALocation: TFpDbgMemLocation): String; overload; +operator = (const a,b: TFpDbgMemLocation): Boolean; inline; + +operator = (const a,b: TFpDbgValueSize): Boolean; inline; +operator = (const a: TFpDbgValueSize; b: Int64): Boolean; inline; +operator > (const a: TFpDbgValueSize; b: Int64): Boolean; inline; +operator >= (const a: TFpDbgValueSize; b: Int64): Boolean; inline; +operator < (const a: TFpDbgValueSize; b: Int64): Boolean; inline; +operator <= (const a: TFpDbgValueSize; b: Int64): Boolean; inline; + +operator + (const a,b: TFpDbgValueSize): TFpDbgValueSize; inline; +operator - (const a,b: TFpDbgValueSize): TFpDbgValueSize; inline; +operator * (const a: TFpDbgValueSize; b: Int64): TFpDbgValueSize; inline; + +operator + (const AnAddr: TFpDbgMemLocation; ASize: TFpDbgValueSize): TFpDbgMemLocation; inline; + +function LocToAddr(const ALocation: TFpDbgMemLocation): TDbgPtr; inline; // does not check valid +function LocToAddrOrNil(const ALocation: TFpDbgMemLocation): TDbgPtr; inline; // save version + +//function EmptyMemReadOpts:TFpDbgMemReadOptions; + +function dbgs(const ALocation: TFpDbgMemLocation): String; overload; +function dbgs(const ASize: TFpDbgValueSize): String; overload; +function dbgs(const AReadDataType: TFpDbgMemReadDataType): String; overload; implementation +var + DBG_VERBOSE: PLazLoggerLogGroup; function NilLoc: TFpDbgMemLocation; begin + Result := Default(TFpDbgMemLocation); Result.Address := 0; Result.MType := mlfTargetMem; end; function InvalidLoc: TFpDbgMemLocation; begin + Result := Default(TFpDbgMemLocation); Result.Address := 0; Result.MType := mlfInvalid; end; function UnInitializedLoc: TFpDbgMemLocation; begin + Result := Default(TFpDbgMemLocation); Result.Address := 0; Result.MType := mlfUninitialized; end; function TargetLoc(AnAddress: TDbgPtr): TFpDbgMemLocation; begin + Result := Default(TFpDbgMemLocation); Result.Address := AnAddress; Result.MType := mlfTargetMem; end; function RegisterLoc(ARegNum: Cardinal): TFpDbgMemLocation; begin + Result := Default(TFpDbgMemLocation); Result.Address := ARegNum; Result.MType := mlfTargetRegister; end; function SelfLoc(AnAddress: TDbgPtr): TFpDbgMemLocation; begin + Result := Default(TFpDbgMemLocation); Result.Address := AnAddress; Result.MType := mlfSelfMem; end; function SelfLoc(AnAddress: Pointer): TFpDbgMemLocation; begin + Result := Default(TFpDbgMemLocation); Result.Address := TDbgPtr(AnAddress); Result.MType := mlfSelfMem; end; function ConstLoc(AValue: QWord): TFpDbgMemLocation; begin + Result := Default(TFpDbgMemLocation); Result.Address := AValue; Result.MType := mlfConstant; end; -function IsTargetAddr(ALocation: TFpDbgMemLocation): Boolean; +function AddBitOffset(const AnAddr: TFpDbgMemLocation; ABitOffset: Int64 + ): TFpDbgMemLocation; +begin + {$PUSH}{$R-}{$Q-} + Result := AnAddr; + Result.Address := AnAddr.Address + ABitOffset div 8; + if (ABitOffset < 0) and ((ABitOffset and 7) <> 0) then + Result.Address := Result.Address - 1; // Going to ADD some bits back + // E.g. b=-1 means (b and 7) = 7 and that means adding 7 bits, instead of substracting 1 + Result.BitOffset := ABitOffset and 7; + {$POP} +end; + +function IsTargetAddr(const ALocation: TFpDbgMemLocation): Boolean; begin Result := ALocation.MType = mlfTargetMem; end; -function IsConstData(ALocation: TFpDbgMemLocation): Boolean; +function IsConstData(const ALocation: TFpDbgMemLocation): Boolean; begin Result := not(ALocation.MType in [mlfConstant, mlfConstantDeref]); end; -function IsInitializedLoc(ALocation: TFpDbgMemLocation): Boolean; +function IsInitializedLoc(const ALocation: TFpDbgMemLocation): Boolean; begin Result := ALocation.MType <> mlfUninitialized; end; -function IsValidLoc(ALocation: TFpDbgMemLocation): Boolean; +function IsValidLoc(const ALocation: TFpDbgMemLocation): Boolean; begin Result := not(ALocation.MType in [mlfInvalid, mlfUninitialized]); end; -function IsReadableLoc(ALocation: TFpDbgMemLocation): Boolean; +function IsReadableLoc(const ALocation: TFpDbgMemLocation): Boolean; begin Result := (not(ALocation.MType in [mlfInvalid, mlfUninitialized])) and ( (not(ALocation.MType in [mlfTargetMem, mlfSelfMem])) or @@ -453,34 +517,220 @@ begin ); end; -function IsReadableMem(ALocation: TFpDbgMemLocation): Boolean; +function IsReadableMem(const ALocation: TFpDbgMemLocation): Boolean; begin Result := (ALocation.MType in [mlfTargetMem, mlfSelfMem]) and (ALocation.Address <> 0); end; -function IsTargetNil(ALocation: TFpDbgMemLocation): Boolean; +function IsTargetNil(const ALocation: TFpDbgMemLocation): Boolean; begin Result := (ALocation.MType = mlfTargetMem) and (ALocation.Address = 0); end; -function IsTargetNotNil(ALocation: TFpDbgMemLocation): Boolean; +function IsTargetNotNil(const ALocation: TFpDbgMemLocation): Boolean; begin Result := (ALocation.MType = mlfTargetMem) and (ALocation.Address <> 0); end; -operator = (a, b: TFpDbgMemLocation): Boolean; +function ZeroSize: TFpDbgValueSize; begin - Result := (a.Address = b.Address) and (a.MType = b.MType); + Result.Size := 0; + Result.BitSize := 0; end; -function LocToAddr(ALocation: TFpDbgMemLocation): TDbgPtr; +function SizeVal(const ASize: Int64): TFpDbgValueSize; +begin + Result.Size := ASize; + Result.BitSize := 0; +end; + +function SizeFromBits(const ABits: Int64): TFpDbgValueSize; +begin + Result.Size := ABits div 8; + if ABits < 0 then + Result.BitSize := -((-ABits) and 7) + else + Result.BitSize := ABits and 7; +end; + +function IsZeroSize(const ASize: TFpDbgValueSize): Boolean; +begin + Result := (ASize.Size = 0) and (ASize.BitSize = 0); +end; + +function IsByteSize(const ASize: TFpDbgValueSize): Boolean; +begin + Result := (ASize.BitSize = 0); +end; + +function SizeToFullBytes(const ASize: TFpDbgValueSize): Int64; +begin + assert((ASize.Size=0) or (ASize.BitSize=0) or ( (ASize.Size<0) = (ASize.BitSize<0) ), '(ASize.Size=0) or (ASize.BitSize=0) or ( (ASize.Size<0) = (ASize.BitSize<0) )'); + if ASize < 0 then + Result := ASize.Size + (ASize.BitSize - 7) div 8 + else + Result := ASize.Size + (ASize.BitSize + 7) div 8; +end; + +function SizeToBits(const ASize: TFpDbgValueSize): Int64; +begin + assert((ASize.Size=0) or (ASize.BitSize=0) or ( (ASize.Size<0) = (ASize.BitSize<0) ), '(ASize.Size=0) or (ASize.BitSize=0) or ( (ASize.Size<0) = (ASize.BitSize<0) )'); + Result := ASize.Size * 8 + ASize.BitSize; +end; + +operator = (const a, b: TFpDbgMemLocation): Boolean; +begin + Result := (a.Address = b.Address) and (a.MType = b.MType) and (a.BitOffset = b.BitOffset); +end; + +operator = (const a, b: TFpDbgValueSize): Boolean; +begin + assert((a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) ), '(a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) )'); + assert((b.Size=0) or (b.BitSize=0) or ( (b.Size<0) = (b.BitSize<0) ), '(b.Size=0) or (b.BitSize=0) or ( (b.Size<0) = (b.BitSize<0) )'); + Result := (a.Size = b.Size) and (a.BitSize = b.BitSize); +end; + +operator = (const a: TFpDbgValueSize; b: Int64): Boolean; +begin + assert((a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) ), '(a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) )'); + Result := (a.Size = b) and (a.BitSize = 0); +end; + +operator>(const a: TFpDbgValueSize; b: Int64): Boolean; +begin + assert((a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) ), '(a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) )'); + Result := (a.Size > b) or + (a.Size = b) and (a.BitSize > 0); +end; + +operator>=(const a: TFpDbgValueSize; b: Int64): Boolean; +begin + assert((a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) ), '(a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) )'); + Result := (a.Size > b) or + (a.Size = b) and (a.BitSize >= 0); +end; + +operator<(const a: TFpDbgValueSize; b: Int64): Boolean; +begin + assert((a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) ), '(a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) )'); + Result := (a.Size < b) or + (a.Size = b) and (a.BitSize < 0); +end; + +operator<=(const a: TFpDbgValueSize; b: Int64): Boolean; +begin + assert((a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) ), '(a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) )'); + Result := (a.Size < b) or + (a.Size = b) and (a.BitSize <= 0); +end; + +operator + (const a, b: TFpDbgValueSize): TFpDbgValueSize; +var + bits, low3bits: Int64; +begin + assert((a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) ), '(a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) )'); + assert((b.Size=0) or (b.BitSize=0) or ( (b.Size<0) = (b.BitSize<0) ), '(b.Size=0) or (b.BitSize=0) or ( (b.Size<0) = (b.BitSize<0) )'); + {$PUSH}{$R-}{$Q-} + bits := a.BitSize + b.BitSize; + + Result.Size := a.Size + b.Size + bits div 8; + low3bits := bits and 7; + if low3bits = 0 then + Result.BitSize := 0 + else + if (Result.Size < 0) or ( (Result.Size=0) and (bits<0) ) then begin + if (bits > 0) then // bits have wrong sign + Result.Size := Result.Size + 1; + Result.BitSize := low3bits - 8; + end + else begin + if (bits < 0) then // bits have wrong sign + Result.Size := Result.Size - 1; + Result.BitSize := low3bits; + end; + {$POP} +end; + +operator - (const a, b: TFpDbgValueSize): TFpDbgValueSize; +var + bits, low3bits: Int64; +begin + assert((a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) ), '(a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) )'); + assert((b.Size=0) or (b.BitSize=0) or ( (b.Size<0) = (b.BitSize<0) ), '(b.Size=0) or (b.BitSize=0) or ( (b.Size<0) = (b.BitSize<0) )'); + {$PUSH}{$R-}{$Q-} + bits := a.BitSize - b.BitSize; + + Result.Size := a.Size - b.Size + bits div 8; + low3bits := bits and 7; + if low3bits = 0 then + Result.BitSize := 0 + else + if (Result.Size < 0) or ( (Result.Size=0) and (bits<0) ) then begin + if (bits > 0) then // bits have wrong sign + Result.Size := Result.Size + 1; + Result.BitSize := low3bits - 8; + end + else begin + if (bits < 0) then // bits have wrong sign + Result.Size := Result.Size - 1; + Result.BitSize := low3bits; + end; + {$POP} +end; + +operator * (const a: TFpDbgValueSize; b: Int64): TFpDbgValueSize; +var + bits, low3bits: Int64; +begin + assert((a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) ), '(a.Size=0) or (a.BitSize=0) or ( (a.Size<0) = (a.BitSize<0) )'); + {$PUSH}{$R-}{$Q-} + bits := a.BitSize * b; + + Result.Size := a.Size * b + bits div 8; + low3bits := bits and 7; + if low3bits = 0 then + Result.BitSize := 0 + else + if (Result.Size < 0) or ( (Result.Size=0) and (bits<0) ) then begin + if (bits > 0) then // bits have wrong sign + Result.Size := Result.Size + 1; + Result.BitSize := low3bits - 8; + end + else begin + if (bits < 0) then // bits have wrong sign + Result.Size := Result.Size - 1; + Result.BitSize := low3bits; + end; + {$POP} +end; + +operator + (const AnAddr: TFpDbgMemLocation; ASize: TFpDbgValueSize + ): TFpDbgMemLocation; +var + bits: Int64; +begin + assert((ASize.Size=0) or (ASize.BitSize=0) or ( (ASize.Size<0) = (ASize.BitSize<0) ), '(ASize.Size=0) or (ASize.BitSize=0) or ( (ASize.Size<0) = (ASize.BitSize<0) )'); + assert(AnAddr.MType in [mlfSelfMem, mlfTargetMem], '+: AnAddr.MType in [mlfSelfMem, mlfTargetMem]'); + Result := AnAddr; + {$PUSH}{$R-}{$Q-} + bits := AnAddr.BitOffset + ASize.BitSize; + + Result.Address := AnAddr.Address + ASize.Size + bits div 8; + if (bits < 0) and ((bits and 7) <> 0) then + Result.Address := Result.Address - 1; // Going to ADD some bits back + // E.g. bits=-1 means (bits and 7) = 7 and that means adding 7 bits, instead of substracting 1 + Result.BitOffset := bits and 7; + {$POP} +end; + +function LocToAddr(const ALocation: TFpDbgMemLocation): TDbgPtr; begin assert(ALocation.MType = mlfTargetMem, 'LocToAddr for other than mlfTargetMem'); Result := ALocation.Address; end; -function LocToAddrOrNil(ALocation: TFpDbgMemLocation): TDbgPtr; +function LocToAddrOrNil(const ALocation: TFpDbgMemLocation): TDbgPtr; begin if (ALocation.MType = mlfTargetMem) then Result := ALocation.Address @@ -488,44 +738,52 @@ begin Result := 0; end; -function {%H-}EmptyMemReadOpts: TFpDbgMemReadOptions; -begin - // -end; +//function {%H-}EmptyMemReadOpts: TFpDbgMemReadOptions; +//begin +// // +//end; -function dbgs(ALocation: TFpDbgMemLocation): String; +function dbgs(const ALocation: TFpDbgMemLocation): String; begin Result := ''; if not (ALocation.MType in [low(TFpDbgMemLocationType)..high(TFpDbgMemLocationType)]) then Result := 'Location=out-of-range' else - WriteStr(Result, 'Location=', ALocation.Address, ',', ALocation.MType) + WriteStr(Result, 'Location=', ALocation.Address, ':', ALocation.BitOffset, ', ', ALocation.MType); +end; + +function dbgs(const ASize: TFpDbgValueSize): String; +begin + WriteStr(Result, 'Size=', ASize.Size, ':', ASize.BitSize); +end; + +function dbgs(const AReadDataType: TFpDbgMemReadDataType): String; +begin + WriteStr(Result, AReadDataType); end; { TFpDbgMemConvertorLittleEndian } -function TFpDbgMemConvertorLittleEndian.PrepareTargetRead(AReadDataType: TFpDbgMemReadDataType; - ATargetPointer: TDbgPtr; ADestPointer: Pointer; ATargetSize, ADestSize: Cardinal; out - AConvertorData: TFpDbgMemConvData): boolean; +function TFpDbgMemConvertorLittleEndian.PrepareTargetRead( + AReadDataType: TFpDbgMemReadDataType; var AConvData: TFpDbgMemConvData; + const ADest: Pointer): boolean; begin - Result := ATargetSize <= ADestSize; + Result := AConvData.SourceFullSize <= AConvData.DestSize; if not Result then exit; - // just read to begin of data - AConvertorData.NewTargetAddress := ATargetPointer; - AConvertorData.NewDestAddress := ADestPointer; - AConvertorData.NewReadSize := Min(ATargetSize, ADestSize); case AReadDataType of rdtAddress, rdtSignedInt, rdtUnsignedInt, rdtEnum, rdtSet: ; rdtfloat: - Result := (ATargetSize = AConvertorData.NewReadSize) and - (ADestSize = SizeOf(Extended)) and // only can read to extended... TODO (if need more) - ( (ATargetSize = SizeOf(Extended)) or - (ATargetSize = SizeOf(Double)) or - (ATargetSize = SizeOf(Single)) or - (ATargetSize = SizeOf(real48)) - ) + // TODO: reading float from register / or mlfConstant...; + Result := IsByteSize(AConvData.SourceSize) and // only support exact size for FLOAT + (AConvData.DestSize = SizeOf(Extended)) and // only can read to extended... TODO (if need more) + ( (AConvData.SourceSize.Size = SizeOf(Extended)) or + (AConvData.SourceSize.Size = SizeOf(Double)) or + (AConvData.SourceSize.Size = SizeOf(Single)) or + (AConvData.SourceSize.Size = SizeOf(real48)) + ); + rdtRawRead: ; else begin Assert(False, 'TFpDbgMemConvertorLittleEndian.PrepareTargetRead'); Result := False; @@ -533,42 +791,72 @@ begin end; end; -function TFpDbgMemConvertorLittleEndian.FinishTargetRead(AReadDataType: TFpDbgMemReadDataType; - ATargetPointer: TDbgPtr; ADestPointer: Pointer; ATargetSize, ADestSize: Cardinal; - AConvertorData: TFpDbgMemConvData): boolean; +function TFpDbgMemConvertorLittleEndian.FinishTargetRead( + AReadDataType: TFpDbgMemReadDataType; + const AConvData: TFpDbgMemConvData; const TmpData: Pointer; + const ADest: Pointer): boolean; type Preal48 = ^real48; +var + s: Boolean; + b: TBitAddr; begin - Result := True; + Result := TmpData = ADest; + if not Result then + exit; case AReadDataType of rdtAddress, rdtUnsignedInt, rdtEnum, rdtSet: begin - if ATargetSize < ADestSize then - FillByte((ADestPointer + ATargetSize)^, ADestSize-ATargetSize, $00) + if AConvData.SourceFullSize < AConvData.DestSize then + FillByte((ADest + AConvData.SourceFullSize)^, AConvData.DestSize-AConvData.SourceFullSize, $00); + if AConvData.SourceSize.BitSize <> 0 then begin + assert(AConvData.SourceFullSize > 0, 'TFpDbgMemConvertorLittleEndian.FinishTargetRead: AConvData.SourceFullSize > 0'); + PByte(ADest + AConvData.SourceFullSize - 1)^ := Byte(PByte(ADest + AConvData.SourceFullSize - 1)^ and + (Byte($FF) shr (8 - AConvData.SourceSize.BitSize))); + end; end; rdtSignedInt: begin - if ATargetSize < ADestSize then - if (ATargetSize > 0) and ((PByte(ADestPointer + ATargetSize - 1)^ and $80) <> 0) - then - FillByte((ADestPointer + ATargetSize)^, ADestSize-ATargetSize, $FF) + if AConvData.SourceFullSize < AConvData.DestSize then begin + b := AConvData.SourceSize.BitSize; + s := False; + if (AConvData.SourceFullSize > 0) then begin + if b = 0 then + s := ((PByte(ADest + AConvData.SourceFullSize - 1)^ and $80) <> 0) + else + s := ((PByte(ADest + AConvData.SourceFullSize - 1)^ and (1 shl (b-1)) ) <> 0); + end; + + if s then + FillByte((ADest + AConvData.SourceFullSize)^, AConvData.DestSize-AConvData.SourceFullSize, $FF) else - FillByte((ADestPointer + ATargetSize)^, ADestSize-ATargetSize, $00); + FillByte((ADest + AConvData.SourceFullSize)^, AConvData.DestSize-AConvData.SourceFullSize, $00); + if b <> 0 then begin + assert(AConvData.SourceFullSize > 0, 'TFpDbgMemConvertorLittleEndian.FinishTargetRead: AConvData.SourceFullSize > 0'); + if s then + PByte(ADest + AConvData.SourceFullSize - 1)^ := Byte(PByte(ADest + AConvData.SourceFullSize - 1)^ or + (Byte($FF) shl b)) + else + PByte(ADest + AConvData.SourceFullSize - 1)^ := Byte(PByte(ADest + AConvData.SourceFullSize - 1)^ and + (Byte($FF) shr (8 - b))); + end; + end; end; rdtfloat: begin - assert((ADestSize = SizeOf(Extended))); - if (ATargetSize = SizeOf(Extended)) then + assert((AConvData.DestSize = SizeOf(Extended))); + if (AConvData.SourceFullSize = SizeOf(Extended)) then // else - if (ATargetSize = SizeOf(Double)) then - PExtended(ADestPointer)^ := PDouble(ADestPointer)^ + if (AConvData.SourceFullSize = SizeOf(Double)) then + PExtended(ADest)^ := PDouble(ADest)^ else - if (ATargetSize = SizeOf(real48)) then - PExtended(ADestPointer)^ := Preal48(ADestPointer)^ + if (AConvData.SourceFullSize = SizeOf(real48)) then + PExtended(ADest)^ := Preal48(ADest)^ else - if (ATargetSize = SizeOf(Single)) then - PExtended(ADestPointer)^ := PSingle(ADestPointer)^ + if (AConvData.SourceFullSize = SizeOf(Single)) then + PExtended(ADest)^ := PSingle(ADest)^ else Result := False; end; + rdtRawRead: ; // TODO: cut bits? else begin Assert(False, 'TFpDbgMemConvertorLittleEndian.FailedTargetRead'); Result := False; @@ -581,10 +869,10 @@ begin // end; -procedure TFpDbgMemConvertorLittleEndian.AdjustIntPointer(var ADataPointer: Pointer; - ADataSize, ANewSize: Cardinal); +function TFpDbgMemConvertorLittleEndian.AdjustIntPointer( + var ADataPointer: Pointer; ADataSize, ANewSize: Cardinal): Boolean; begin - Assert(ANewSize <= ADataSize, 'TFpDbgMemConvertorLittleEndian.AdjustIntPointer'); + Result := ANewSize <= ADataSize; // no adjustment needed end; @@ -803,81 +1091,227 @@ begin Result := FCacheManager; end; -function TFpDbgMemManager.ReadMemory(AReadDataType: TFpDbgMemReadDataType; - const ALocation: TFpDbgMemLocation; ATargetSize: Cardinal; ADest: Pointer; - ADestSize: Cardinal; AContext: TFpDbgAddressContext): Boolean; +procedure TFpDbgMemManager.BitShiftMem(ASrcMem, ADestMem: Pointer; ASrcSize, + ADestSize: cardinal; ABitCnt: Integer); var - Addr2: Pointer; - i: Integer; - TmpVal: TDbgPtr; - ConvData: TFpDbgMemConvData; + Next, Cur: Byte; +begin + Next := PByte(ASrcMem)^; + dec(ADestSize); + while ADestSize > 0 do begin + Cur := Next; + Next := PByte(ASrcMem + 1)^; + PByte(ADestMem)^ := Byte(( Cur shr ABitCnt) or ( Next shl (8 - ABitCnt) )); + ASrcMem := ASrcMem + 1; + ADestMem := ADestMem + 1; + dec(ADestSize); + end; + Cur := Next; + Next := 0; + if ASrcSize > ADestSize then + Next := PByte(ASrcMem + 1)^; + PByte(ADestMem)^ := Byte(( Cur shr ABitCnt) or ( Next shl (8 - ABitCnt) )); +end; + +function TFpDbgMemManager.ReadMemory(AReadDataType: TFpDbgMemReadDataType; + const ASourceLocation: TFpDbgMemLocation; const ASourceSize: TFpDbgValueSize; + const ADest: Pointer; const ADestSize: QWord; AContext: TFpDbgAddressContext + ): Boolean; +var + ConvData: TFpDbgMemConvData; + ReadData, ReadData2: Pointer; + TmpVal: TDbgPtr; + BitOffset, SourceExtraSize: Integer; + SourceReadSize, SourceFullSize: QWord; begin - FLastError := NoError; Result := False; + DebugLn(DBG_VERBOSE, ['$ReadMem: ', dbgs(AReadDataType),' ', dbgs(ASourceLocation), ' ', dbgs(ASourceSize), ' Dest ', ADestSize]); + if (ASourceLocation.MType in [mlfInvalid, mlfUninitialized]) or + (ASourceSize <= 0) + then begin + FLastError := CreateError(fpErrCanNotReadInvalidMem); + exit; + end; + + FLastError := NoError; if AContext = nil then AContext := FDefaultContext; - case ALocation.MType of - mlfInvalid, mlfUninitialized: - FLastError := CreateError(fpErrCanNotReadInvalidMem); - mlfTargetMem, mlfSelfMem: begin - Result := TargetMemConvertor.PrepareTargetRead(AReadDataType, ALocation.Address, - ADest, ATargetSize, ADestSize, ConvData); - if not Result then exit; - if ALocation.MType = mlfTargetMem then begin - Result := CacheManager.ReadMemory(ConvData.NewTargetAddress, ConvData.NewReadSize, ConvData.NewDestAddress); - if not Result then - FLastError := CreateError(fpErrCanNotReadMemAtAddr, [ALocation.Address]); - end - else - begin - try - move(Pointer(ConvData.NewTargetAddress)^, ConvData.NewDestAddress^, ConvData.NewReadSize); - Result := True; - except - Result := False; - end; + ConvData.SourceLocation := ASourceLocation; + ConvData.SourceSize := ASourceSize; // ONLY valid for target/self-mem // Currently set equal to ADestSize; + ConvData.SourceFullSize := SizeToFullBytes(ASourceSize); + ConvData.DestSize := ADestSize; + + if not TargetMemConvertor.PrepareTargetRead(AReadDataType, ConvData, ADest) then begin + FLastError := CreateError(fpErrCanNotReadMemAtAddr, [ASourceLocation.Address]); + exit; + end; + assert(ConvData.DestSize <= ADestSize, 'TFpDbgMemManager.ReadMemory: ConvData.DestSize <= ADestSize'); + + // SourceFullSize: excluding any size needed for BitOffset + SourceFullSize := ConvData.SourceFullSize; + if (SourceFullSize > TMP_MEM_SIZE) and (SourceFullSize > ConvData.DestSize) then begin + // The un-shifted (bit-offset) result must fully fit in either ADest or FTmpMem + FLastError := CreateError(fpErrFailedReadMem); + exit; + end; + + (* - If SourceFullSize does not fit into ADest, + then FinishTargetRead *MUST* copy the desired part + - If SourceFullSize is smaller than ADest, + then targetconverter *MUST* fill/zero/compute the missing data. + The read data will be alligned ot the first (smallest address) byte. + - targetconverter MUST treat FTmpMem as read-only + *) + + BitOffset := ConvData.SourceLocation.BitOffset; + SourceExtraSize := (BitOffset + ConvData.SourceSize.BitSize + 7) div 8; + + case ASourceLocation.MType of + mlfTargetMem, mlfSelfMem: begin + assert(BitOffset < 8, 'TFpDbgMemManager.ReadMemory: BitOffset < 8'); + if QWord(ConvData.SourceSize.Size) > high(SourceReadSize) - SourceExtraSize then begin + // bigger than max read size + FLastError := CreateError(fpErrCanNotReadMemAtAddr, [ASourceLocation.Address]); + exit; + end; + SourceReadSize := ConvData.SourceSize.Size + SourceExtraSize; + // TODO: separate check for selfmem // requires selfmem to have a size field + if (SourceReadSize > High(TDbgPtr) - ConvData.SourceLocation.Address) or + ( (SourceReadSize > ConvData.DestSize) and ((SourceReadSize - ConvData.DestSize) > TMP_MEM_SIZE) ) + then begin + FLastError := CreateError(fpErrCanNotReadMemAtAddr, [ASourceLocation.Address]); + exit; end; - if Result then - Result := TargetMemConvertor.FinishTargetRead(AReadDataType, ALocation.Address, - ADest, ATargetSize, ADestSize, ConvData) - else - TargetMemConvertor.FailedTargetRead(ConvData); + case ASourceLocation.MType of + mlfTargetMem: begin + ReadData2 := nil; + if SourceReadSize <= ConvData.DestSize then begin + // full read to ADest + ReadData := ADest; + Result := CacheManager.ReadMemory(ConvData.SourceLocation.Address, SourceReadSize, ADest); + end + else + if SourceReadSize <= TMP_MEM_SIZE then begin + // full read to FTmpMem; + // This is the ONLY read that has ReadData <> ADest + // *** FinishTargetRead must copy the data *** + ReadData := @FTmpMem[0]; + Result := CacheManager.ReadMemory(ConvData.SourceLocation.Address, SourceReadSize, ReadData); + end + else begin + // SPLIT read to ADest/FTmpMem; + // BitOffset must be none zero, otherwise the data must fully fit in either ADest or FTmpMem + // *** BitShift will copy the date into ADest *** + assert(BitOffset <> 0, 'TFpDbgMemManager.ReadMemory: BitOffset <> 0'); + ReadData := ADest; + ReadData2 := @FTmpMem[0]; + Result := CacheManager.ReadMemory(ConvData.SourceLocation.Address, ConvData.DestSize, ADest); + if Result then + Result := CacheManager.ReadMemory(ConvData.SourceLocation.Address + ConvData.DestSize, SourceReadSize - ConvData.DestSize, ReadData2); + end; + + if Result and (BitOffset <> 0) then begin + if (ReadData <> ADest) then begin + // Read to FTmpMem only + if (SourceFullSize <= ConvData.DestSize) then begin + BitShiftMem(ReadData, ADest, SourceReadSize, SourceFullSize, BitOffset); + ReadData := ADest; + end + else + BitShiftMem(ReadData, ReadData, SourceReadSize, SourceFullSize, BitOffset); + end + else + // Read to ADest or SPLIT + BitShiftMem(ReadData, ReadData, ConvData.DestSize, ConvData.DestSize, BitOffset); + + if ReadData2 <> nil then begin + // SPLIT read; ReadData=ADest + // Since SourceReadSize can have max 1 extra byte => there can only be one byte; which must fit into ADest after shifting BitOffset + PByte(ADest+ConvData.DestSize-1)^ := Byte(PByte(ADest+ConvData.DestSize-1)^ or + (PByte(ReadData2)^ shl (8 - BitOffset) )); + end; + end; + // ReadData is now a pointer to the FULL data. Either in ADest or FTmpMem + + end; + mlfSelfMem: begin // Can be cached TargetMem, or can be constant data from dwarf + try // accessinge SelfMem can fail, because there is on SelfmMem.Length that can be checked + Result := True; + if BitOffset <> 0 then begin + // BitShift will copy the data + if (SourceFullSize <= ConvData.DestSize) then + ReadData := @ConvData.SourceLocation.Address + else + ReadData := @FTmpMem[0]; + BitShiftMem(@ConvData.SourceLocation.Address, ReadData, SourceReadSize, SourceFullSize, BitOffset) + end + else begin + // no BitShift + ReadData := ADest; + if SourceFullSize > ConvData.DestSize then + ReadData := @ConvData.SourceLocation.Address // ReadData has to be read-only // FinishTargetRead must copy the data + else + move(Pointer(ConvData.SourceLocation.Address)^, ADest^, SourceFullSize); + end; + except + Result := False; + end; + end; + end; end; + mlfConstant, mlfConstantDeref, mlfTargetRegister: begin - case ALocation.MType of + If (BitOffset <> 0) or (not IsByteSize(ConvData.SourceSize)) then begin + // Not yet supported + FLastError := CreateError(fpErrCanNotReadMemAtAddr, [ConvData.SourceLocation.Address]); + Result := False; + exit; + end; + + case ASourceLocation.MType of mlfConstant, mlfConstantDeref: begin - TmpVal := ALocation.Address; - i := SizeOf(ALocation.Address); + TmpVal := ConvData.SourceLocation.Address; + SourceReadSize := SizeOf(ConvData.SourceLocation.Address); end; mlfTargetRegister: begin - i := FMemReader.RegisterSize(Cardinal(ALocation.Address)); - if i = 0 then + SourceReadSize := FMemReader.RegisterSize(Cardinal(ConvData.SourceLocation.Address)); + if SourceReadSize = 0 then exit; // failed - if not FMemReader.ReadRegister(Cardinal(ALocation.Address), TmpVal, AContext) then + if not FMemReader.ReadRegister(Cardinal(ConvData.SourceLocation.Address), TmpVal, AContext) then exit; // failed end; end; - if i > ATargetSize then - i := ATargetSize; + if SourceReadSize > ConvData.SourceSize.Size then + SourceReadSize := ConvData.SourceSize.Size; - Addr2 := @TmpVal; - if SizeOf(TmpVal) <> i then - FSelfMemConvertor.AdjustIntPointer(Addr2, SizeOf(TmpVal), i); + ReadData := @TmpVal; - Result := FSelfMemConvertor.PrepareTargetRead(AReadDataType, TDbgPtr(Addr2), - ADest, i, ADestSize, ConvData); - if not Result then exit; + if SizeOf(TmpVal) <> SourceReadSize then + // TODO: only needed if ADestSize > SourceReadSize ? + // Maybe do that after Move to ADest? // Maybe as part of FinishTargetRead ? + if not FSelfMemConvertor.AdjustIntPointer(ReadData, SizeOf(TmpVal), SourceReadSize) then begin + FLastError := CreateError(fpErrFailedReadMem); + exit; + end; - move(Pointer(ConvData.NewTargetAddress)^, ConvData.NewDestAddress^, ConvData.NewReadSize); - Result := TargetMemConvertor.FinishTargetRead(AReadDataType, TDbgPtr(Addr2), - ADest, i, ADestSize, ConvData); + if SourceReadSize <= ConvData.DestSize then begin + move(ReadData^, ADest^, Min(SizeOf(TmpVal) ,ConvData.DestSize)); // Little Endian only + ReadData := ADest; + end; + Result := True; end; end; + + if Result then + Result := TargetMemConvertor.FinishTargetRead(AReadDataType, ConvData, ReadData, ADest) + else + TargetMemConvertor.FailedTargetRead(ConvData); + if (not Result) and (not IsError(FLastError)) then FLastError := CreateError(fpErrFailedReadMem); end; @@ -918,81 +1352,31 @@ begin FLastError := NoError; end; -function TFpDbgMemManager.ReadMemory(const ALocation: TFpDbgMemLocation; ASize: Cardinal; - ADest: Pointer; AContext: TFpDbgAddressContext): Boolean; -var - Addr2: Pointer; - i: Integer; - TmpVal: TDbgPtr; - ConvData: TFpDbgMemConvData; +function TFpDbgMemManager.ReadMemory(const ASourceLocation: TFpDbgMemLocation; + const ASize: TFpDbgValueSize; const ADest: Pointer; + AContext: TFpDbgAddressContext): Boolean; begin - if ASize > High(TDbgPtr) - ALocation.Address then begin - FLastError := CreateError(fpErrCanNotReadMemAtAddr, [ALocation.Address]); + Result := ReadMemory(rdtRawRead, ASourceLocation, ASize, ADest, ASize.Size, AContext); +end; + +function TFpDbgMemManager.ReadMemoryEx( + const ASourceLocation: TFpDbgMemLocation; AnAddressSpace: TDbgPtr; + ASize: TFpDbgValueSize; ADest: Pointer; AContext: TFpDbgAddressContext + ): Boolean; +begin + FLastError := NoError; + if (ASourceLocation.BitOffset <> 0) then begin + // Not supported to read at bit offset + FLastError := CreateError(fpErrFailedReadMem); + Result := False; exit; end; - FLastError := NoError; - Result := False; - if AContext = nil then - AContext := FDefaultContext; - case ALocation.MType of - mlfInvalid, mlfUninitialized: ; - mlfTargetMem: - begin - Result := CacheManager.ReadMemory(ALocation.Address, ASize, ADest); - if not Result then - FLastError := CreateError(fpErrCanNotReadMemAtAddr, [ALocation.Address]); - end; - mlfSelfMem: - begin - move(Pointer(ALocation.Address)^, ADest^, ASize); - Result := True; - end; - mlfConstant, mlfConstantDeref, mlfTargetRegister: - begin - case ALocation.MType of - mlfConstant, mlfConstantDeref: begin - TmpVal := ALocation.Address; - i := SizeOf(ALocation.Address); - end; - mlfTargetRegister: begin - i := FMemReader.RegisterSize(Cardinal(ALocation.Address)); - if i = 0 then - exit; // failed - if not FMemReader.ReadRegister(Cardinal(ALocation.Address), TmpVal, AContext) then - exit; // failed - end; - end; - - Addr2 := @TmpVal; - if SizeOf(TmpVal) <> i then - FSelfMemConvertor.AdjustIntPointer(Addr2, SizeOf(TmpVal), i); - - Result := FSelfMemConvertor.PrepareTargetRead(rdtUnsignedInt, TDbgPtr(Addr2), - ADest, i, ASize, ConvData); - if not Result then exit; - - move(Pointer(ConvData.NewTargetAddress)^, ConvData.NewDestAddress^, ConvData.NewReadSize); - - Result := TargetMemConvertor.FinishTargetRead(rdtUnsignedInt, TDbgPtr(Addr2), - ADest, i, ASize, ConvData); - Result := True; - end; - end; - if (not Result) and (not IsError(FLastError)) then - FLastError := CreateError(fpErrFailedReadMem); -end; - -function TFpDbgMemManager.ReadMemoryEx(const ALocation: TFpDbgMemLocation; - AnAddressSpace: TDbgPtr; ASize: Cardinal; ADest: Pointer; - AContext: TFpDbgAddressContext): Boolean; -begin - FLastError := NoError; // AnAddressSpace is ignored, when not actually reading from target address - case ALocation.MType of - mlfTargetMem: Result := FMemReader.ReadMemoryEx(ALocation.Address, AnAddressSpace, ASize, ADest); + case ASourceLocation.MType of + mlfTargetMem: Result := FMemReader.ReadMemoryEx(ASourceLocation.Address, AnAddressSpace, SizeToFullBytes(ASize), ADest); else - Result := ReadMemory(ALocation, ASize, ADest, AContext); + Result := ReadMemory(ASourceLocation, ASize, ADest, AContext); end; if (not Result) and (not IsError(FLastError)) then FLastError := CreateError(fpErrFailedReadMem); @@ -1006,63 +1390,76 @@ begin if AContext = nil then AContext := FDefaultContext; Result := FMemReader.ReadRegister(ARegNum, AValue, AContext); + if not Result then + FLastError := CreateError(fpErrFailedReadMem); end; -function TFpDbgMemManager.ReadAddress(const ALocation: TFpDbgMemLocation; ASize: Cardinal; - AContext: TFpDbgAddressContext): TFpDbgMemLocation; +function TFpDbgMemManager.ReadAddress(const ALocation: TFpDbgMemLocation; + ASize: TFpDbgValueSize; AContext: TFpDbgAddressContext): TFpDbgMemLocation; begin + Result := Default(TFpDbgMemLocation); Result.MType := mlfTargetMem; if not ReadMemory(rdtAddress, ALocation, ASize, @Result.Address, SizeOf(Result.Address), AContext) then Result := InvalidLoc; end; function TFpDbgMemManager.ReadAddressEx(const ALocation: TFpDbgMemLocation; - AnAddressSpace: TDbgPtr; ASize: Cardinal; AContext: TFpDbgAddressContext): TFpDbgMemLocation; + AnAddressSpace: TDbgPtr; ASize: TFpDbgValueSize; + AContext: TFpDbgAddressContext): TFpDbgMemLocation; begin Result := InvalidLoc; end; -function TFpDbgMemManager.ReadAddress(const ALocation: TFpDbgMemLocation; ASize: Cardinal; out - AnAddress: TFpDbgMemLocation; AContext: TFpDbgAddressContext): Boolean; +function TFpDbgMemManager.ReadAddress(const ALocation: TFpDbgMemLocation; + ASize: TFpDbgValueSize; out AnAddress: TFpDbgMemLocation; + AContext: TFpDbgAddressContext): Boolean; begin - Result := ReadMemory(rdtAddress, ALocation, ASize, @AnAddress.Address, SizeOf(AnAddress.Address), AContext); + AnAddress := Default(TFpDbgMemLocation); + Result := ReadMemory(rdtAddress, ALocation, ASize, @AnAddress.Address, (SizeOf(AnAddress.Address)), AContext); if Result then AnAddress.MType := mlfTargetMem else AnAddress.MType := mlfInvalid; end; -function TFpDbgMemManager.ReadUnsignedInt(const ALocation: TFpDbgMemLocation; ASize: Cardinal; - out AValue: QWord; AContext: TFpDbgAddressContext): Boolean; +function TFpDbgMemManager.ReadUnsignedInt(const ALocation: TFpDbgMemLocation; + ASize: TFpDbgValueSize; out AValue: QWord; AContext: TFpDbgAddressContext + ): Boolean; begin - Result := ReadMemory(rdtUnsignedInt, ALocation, ASize, @AValue, SizeOf(AValue), AContext); + Result := ReadMemory(rdtUnsignedInt, ALocation, ASize, @AValue, (SizeOf(AValue)), AContext); end; -function TFpDbgMemManager.ReadSignedInt(const ALocation: TFpDbgMemLocation; ASize: Cardinal; - out AValue: Int64; AContext: TFpDbgAddressContext): Boolean; +function TFpDbgMemManager.ReadSignedInt(const ALocation: TFpDbgMemLocation; + ASize: TFpDbgValueSize; out AValue: Int64; AContext: TFpDbgAddressContext + ): Boolean; begin - Result := ReadMemory(rdtSignedInt, ALocation, ASize, @AValue, SizeOf(AValue), AContext); + Result := ReadMemory(rdtSignedInt, ALocation, ASize, @AValue, (SizeOf(AValue)), AContext); end; -function TFpDbgMemManager.ReadEnum(const ALocation: TFpDbgMemLocation; ASize: Cardinal; out - AValue: QWord; AContext: TFpDbgAddressContext): Boolean; +function TFpDbgMemManager.ReadEnum(const ALocation: TFpDbgMemLocation; + ASize: TFpDbgValueSize; out AValue: QWord; AContext: TFpDbgAddressContext + ): Boolean; begin - Result := ReadMemory(rdtEnum, ALocation, ASize, @AValue, SizeOf(AValue), AContext); + Result := ReadMemory(rdtEnum, ALocation, ASize, @AValue, (SizeOf(AValue)), AContext); end; -function TFpDbgMemManager.ReadSet(const ALocation: TFpDbgMemLocation; ASize: Cardinal; out - AValue: TBytes; AContext: TFpDbgAddressContext): Boolean; +function TFpDbgMemManager.ReadSet(const ALocation: TFpDbgMemLocation; + ASize: TFpDbgValueSize; out AValue: TBytes; AContext: TFpDbgAddressContext + ): Boolean; begin - SetLength(AValue, ASize); + SetLength(AValue, SizeToFullBytes(ASize)); Result := ASize > 0; if Result then - Result := ReadMemory(rdtSet, ALocation, ASize, @AValue[0], ASize, AContext); + Result := ReadMemory(rdtSet, ALocation, ASize, @AValue[0], Length(AValue), AContext); end; -function TFpDbgMemManager.ReadFloat(const ALocation: TFpDbgMemLocation; ASize: Cardinal; out - AValue: Extended; AContext: TFpDbgAddressContext): Boolean; +function TFpDbgMemManager.ReadFloat(const ALocation: TFpDbgMemLocation; + ASize: TFpDbgValueSize; out AValue: Extended; AContext: TFpDbgAddressContext + ): Boolean; begin - Result := ReadMemory(rdtfloat, ALocation, ASize, @AValue, SizeOf(AValue), AContext); + Result := ReadMemory(rdtfloat, ALocation, ASize, @AValue, (SizeOf(AValue)), AContext); end; +initialization + DBG_VERBOSE := DebugLogger.FindOrRegisterLogGroup('DBG_VERBOSE' {$IFDEF DBG_VERBOSE} , True {$ENDIF} ); + end. - diff --git a/components/fpdebug/fppascalbuilder.pas b/components/fpdebug/fppascalbuilder.pas index 5ec5767e44..efc3d2af2a 100644 --- a/components/fpdebug/fppascalbuilder.pas +++ b/components/fpdebug/fppascalbuilder.pas @@ -767,13 +767,13 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String; procedure DoInt; var n: Integer; - ValSize: QWord; + ValSize: TFpDbgValueSize; begin case ADisplayFormat of wdfUnsigned: APrintedValue := IntToStr(QWord(AValue.AsInteger)); wdfHex: begin if (svfSize in AValue.FieldFlags) and AValue.GetSize(ValSize) then - n := ValSize* 2 + n := SizeToFullBytes(ValSize)* 2 else begin n := 16; if QWord(AValue.AsInteger) <= high(Cardinal) then n := 8; @@ -797,13 +797,13 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String; procedure DoCardinal; var n: Integer; - ValSize: QWord; + ValSize: TFpDbgValueSize; begin case ADisplayFormat of wdfDecimal: APrintedValue := IntToStr(Int64(AValue.AsCardinal)); wdfHex: begin if (svfSize in AValue.FieldFlags) and AValue.GetSize(ValSize) then - n := ValSize* 2 + n := SizeToFullBytes(ValSize)* 2 else begin n := 16; if AValue.AsCardinal <= high(Cardinal) then n := 8; @@ -960,7 +960,7 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String; end; if (MemManager <> nil) and (MemManager.CacheManager <> nil) then - Cache := MemManager.CacheManager.AddCache(AValue.DataAddress.Address, AValue.DataSize) + Cache := MemManager.CacheManager.AddCache(AValue.DataAddress.Address, SizeToFullBytes(AValue.DataSize)) else Cache := nil; try @@ -1114,7 +1114,7 @@ var MemSize: Integer; MemDest: array of Byte; i: Integer; - ValSize: QWord; + ValSize: TFpDbgValueSize; begin if ADBGTypeInfo <> nil then ADBGTypeInfo^ := nil; if ANestLevel > 0 then begin @@ -1126,21 +1126,21 @@ begin MemAddr := UnInitializedLoc; if svfDataAddress in AValue.FieldFlags then begin MemAddr := AValue.DataAddress; - MemSize := AValue.DataSize; + MemSize := SizeToFullBytes(AValue.DataSize); end else if svfAddress in AValue.FieldFlags then begin MemAddr := AValue.Address; if not AValue.GetSize(ValSize) then - ValSize := 256; - MemSize := ValSize; + ValSize := SizeVal(256); + MemSize := SizeToFullBytes(ValSize); end; if MemSize < ARepeatCount then MemSize := ARepeatCount; if MemSize <= 0 then MemSize := 256; if IsTargetAddr(MemAddr) then begin SetLength(MemDest, MemSize); - if FMemManager.ReadMemory(MemAddr, MemSize, @MemDest[0]) then begin + if FMemManager.ReadMemory(MemAddr, SizeVal(MemSize), @MemDest[0]) then begin APrintedValue := IntToHex(MemAddr.Address, AnAddressSize*2)+ ':' + LineEnding; for i := 0 to high(MemDest) do begin if (i > 0) and (i mod 16 = 0) then diff --git a/components/fpdebug/fppascalparser.pas b/components/fpdebug/fppascalparser.pas index 25e91a3361..f322d582de 100644 --- a/components/fpdebug/fppascalparser.pas +++ b/components/fpdebug/fppascalparser.pas @@ -522,7 +522,7 @@ type protected function GetFieldFlags: TFpValueFieldFlags; override; function GetAddress: TFpDbgMemLocation; override; - function DoGetSize(out ASize: QWord): Boolean; override; + function DoGetSize(out ASize: TFpDbgValueSize): Boolean; override; function GetAsCardinal: QWord; override; // reads men function GetTypeInfo: TFpSymbol; override; // TODO: Cardinal? Why? // TODO: does not handle AOffset public @@ -621,7 +621,7 @@ begin Result := FValue.AsCardinal else if svfAddress in f then begin - if not FContext.MemManager.ReadUnsignedInt(FValue.Address, FContext.SizeOfAddress, Result) then + if not FContext.MemManager.ReadUnsignedInt(FValue.Address, SizeVal(FContext.SizeOfAddress), Result) then Result := 0; end else @@ -638,7 +638,7 @@ var ti: TFpSymbol; addr: TFpDbgMemLocation; Tmp: TFpValueConstAddress; - Size: QWord; + Size: TFpDbgValueSize; begin Result := nil; @@ -656,7 +656,7 @@ begin SetLastError(CreateError(fpErrAnyError, ['Can index element of unknown size'])); exit; end; - AIndex := AIndex * Size; + AIndex := AIndex * SizeToFullBytes(Size); end; addr.Address := addr.Address + AIndex; {$POP} @@ -766,7 +766,7 @@ end; function TFpPasParserValueDerefPointer.GetAddress: TFpDbgMemLocation; begin Result := FValue.DataAddress; - Result := Context.MemManager.ReadAddress(Result, Context.SizeOfAddress); + Result := Context.MemManager.ReadAddress(Result, SizeVal(Context.SizeOfAddress)); if FAddressOffset <> 0 then begin assert(IsTargetAddr(Result ), 'TFpPasParserValueDerefPointer.GetAddress: TargetLoc(Result)'); @@ -777,7 +777,8 @@ begin end; end; -function TFpPasParserValueDerefPointer.DoGetSize(out ASize: QWord): Boolean; +function TFpPasParserValueDerefPointer.DoGetSize(out ASize: TFpDbgValueSize + ): Boolean; var t: TFpSymbol; begin @@ -810,7 +811,7 @@ begin FCardinalRead := True; Addr := GetAddress; if not IsReadableLoc(Addr) then exit; - FCardinal := LocToAddrOrNil(m.ReadAddress(Addr, Ctx.SizeOfAddress)); + FCardinal := LocToAddrOrNil(m.ReadAddress(Addr, SizeVal(Ctx.SizeOfAddress))); Result := FCardinal; end; @@ -905,7 +906,7 @@ var ti: TFpSymbol; addr: TFpDbgMemLocation; Tmp: TFpValueConstAddress; - Size: QWord; + Size: TFpDbgValueSize; begin if (AIndex = 0) or (FValue = nil) then begin Result := FValue; @@ -927,7 +928,7 @@ begin SetLastError(CreateError(fpErrAnyError, ['Can index element of unknown size'])); exit; end; - AIndex := AIndex * Size; + AIndex := AIndex * SizeToFullBytes(Size); end; addr.Address := addr.Address + AIndex; {$POP} diff --git a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas b/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas index 3508c5d516..51d89e5b1b 100644 --- a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas +++ b/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas @@ -871,7 +871,7 @@ var CurContext: TFpDbgInfoContext; WatchPasExpr: TFpPascalExpression; R: TFpValue; - s: QWord; + s: TFpDbgValueSize; begin assert(FInternalBreakpoint=nil); debuglnEnter(DBG_BREAKPOINTS, ['>> TFPBreakpoint.SetBreak ADD ',FSource,':',FLine,'/',dbghex(Address),' ' ]); @@ -887,7 +887,7 @@ begin // TODO: Cache current value if WatchPasExpr.Valid and IsTargetNotNil(R.Address) and R.GetSize(s) then begin // pass context - FInternalBreakpoint := TFpDebugDebugger(Debugger).AddWatch(R.Address.Address, s, WatchKind, WatchScope); + FInternalBreakpoint := TFpDebugDebugger(Debugger).AddWatch(R.Address.Address, SizeToFullBytes(s), WatchKind, WatchScope); end; WatchPasExpr.Free; CurContext.ReleaseReference; @@ -1412,16 +1412,16 @@ begin if (ResValue.Kind = skClass) and (ResValue.AsCardinal <> 0) and (defClassAutoCast in EvalFlags) then begin CastName := ''; - if FMemManager.ReadAddress(ResValue.DataAddress, AContext.SizeOfAddress, ClassAddr) then begin + if FMemManager.ReadAddress(ResValue.DataAddress, SizeVal(AContext.SizeOfAddress), ClassAddr) then begin {$PUSH}{$Q-} ClassAddr.Address := ClassAddr.Address + TDBGPtr(3 * AContext.SizeOfAddress); {$POP} - if FMemManager.ReadAddress(ClassAddr, AContext.SizeOfAddress, CNameAddr) then begin - if (FMemManager.ReadUnsignedInt(CNameAddr, 1, NameLen)) then + if FMemManager.ReadAddress(ClassAddr, SizeVal(AContext.SizeOfAddress), CNameAddr) then begin + if (FMemManager.ReadUnsignedInt(CNameAddr, SizeVal(1), NameLen)) then if NameLen > 0 then begin SetLength(CastName, NameLen); CNameAddr.Address := CNameAddr.Address + 1; - FMemManager.ReadMemory(CNameAddr, NameLen, @CastName[1]); + FMemManager.ReadMemory(CNameAddr, SizeVal(NameLen), @CastName[1]); PasExpr2 := TFpPascalExpression.Create(CastName+'('+AExpression+')', AContext); PasExpr2.ResultValue; if PasExpr2.Valid then begin diff --git a/components/lazdebuggers/lazdebuggerfpgdbmi/fpgdbmidebugger.pp b/components/lazdebuggers/lazdebuggerfpgdbmi/fpgdbmidebugger.pp index c47e8214d6..368bfe0c7c 100644 --- a/components/lazdebuggers/lazdebuggerfpgdbmi/fpgdbmidebugger.pp +++ b/components/lazdebuggers/lazdebuggerfpgdbmi/fpgdbmidebugger.pp @@ -1052,14 +1052,14 @@ DebugLn(DBG_VERBOSE, [ErrorHandler.ErrorAsString(PasExpr.Error)]); if (ResValue.Kind = skClass) and (ResValue.AsCardinal <> 0) and (defClassAutoCast in EvalFlags) then begin CastName := ''; - if FMemManager.ReadAddress(ResValue.DataAddress, Ctx.SizeOfAddress, ClassAddr) then begin + if FMemManager.ReadAddress(ResValue.DataAddress, SizeVal(Ctx.SizeOfAddress), ClassAddr) then begin ClassAddr.Address := ClassAddr.Address + 3 * Ctx.SizeOfAddress; - if FMemManager.ReadAddress(ClassAddr, Ctx.SizeOfAddress, CNameAddr) then begin - if (FMemManager.ReadUnsignedInt(CNameAddr, 1, NameLen)) then + if FMemManager.ReadAddress(ClassAddr, SizeVal(Ctx.SizeOfAddress), CNameAddr) then begin + if (FMemManager.ReadUnsignedInt(CNameAddr, SizeVal(1), NameLen)) then if NameLen > 0 then begin SetLength(CastName, NameLen); CNameAddr.Address := CNameAddr.Address + 1; - FMemManager.ReadMemory(CNameAddr, NameLen, @CastName[1]); + FMemManager.ReadMemory(CNameAddr, SizeVal(NameLen), @CastName[1]); PasExpr2 := TFpPascalExpression.Create(CastName+'('+AExpression+')', Ctx); PasExpr2.ResultValue; if PasExpr2.Valid then begin diff --git a/components/lazdebuggers/lazdebuggerfplldb/fplldbdebugger.pas b/components/lazdebuggers/lazdebuggerfplldb/fplldbdebugger.pas index 46585bb92a..b8d674bf5d 100644 --- a/components/lazdebuggers/lazdebuggerfplldb/fplldbdebugger.pas +++ b/components/lazdebuggers/lazdebuggerfplldb/fplldbdebugger.pas @@ -1494,14 +1494,14 @@ DebugLn(DBG_VERBOSE, [ErrorHandler.ErrorAsString(PasExpr.Error)]); if (ResValue.Kind = skClass) and (ResValue.AsCardinal <> 0) and (defClassAutoCast in EvalFlags) then begin CastName := ''; - if FMemManager.ReadAddress(ResValue.DataAddress, Ctx.SizeOfAddress, ClassAddr) then begin + if FMemManager.ReadAddress(ResValue.DataAddress, SizeVal(Ctx.SizeOfAddress), ClassAddr) then begin ClassAddr.Address := ClassAddr.Address + 3 * Ctx.SizeOfAddress; - if FMemManager.ReadAddress(ClassAddr, Ctx.SizeOfAddress, CNameAddr) then begin - if (FMemManager.ReadUnsignedInt(CNameAddr, 1, NameLen)) then + if FMemManager.ReadAddress(ClassAddr, SizeVal(Ctx.SizeOfAddress), CNameAddr) then begin + if (FMemManager.ReadUnsignedInt(CNameAddr, SizeVal(1), NameLen)) then if NameLen > 0 then begin SetLength(CastName, NameLen); CNameAddr.Address := CNameAddr.Address + 1; - FMemManager.ReadMemory(CNameAddr, NameLen, @CastName[1]); + FMemManager.ReadMemory(CNameAddr, SizeVal(NameLen), @CastName[1]); PasExpr2 := TFpPascalExpression.Create(CastName+'('+AExpression+')', Ctx); PasExpr2.ResultValue; if PasExpr2.Valid then begin