From 4910e764bb73a2bf5928beba260b8c40f063a607 Mon Sep 17 00:00:00 2001 From: Martin Date: Sun, 18 Sep 2022 01:44:59 +0200 Subject: [PATCH] FpDebug: Improve PChar handling in pointer math. --- components/fpdebug/fpdbgdwarf.pas | 38 +------ components/fpdebug/fpdbginfo.pas | 31 ++++- components/fpdebug/fpdmemorytools.pas | 107 +++++++++++++++++- components/fpdebug/fppascalparser.pas | 41 +++++++ .../lazdebuggerfp/test/testwatches.pas | 56 +++++++++ 5 files changed, 234 insertions(+), 39 deletions(-) diff --git a/components/fpdebug/fpdbgdwarf.pas b/components/fpdebug/fpdbgdwarf.pas index 19e84d7fd6..9b73840212 100644 --- a/components/fpdebug/fpdbgdwarf.pas +++ b/components/fpdebug/fpdbgdwarf.pas @@ -2509,28 +2509,11 @@ begin Result := GetAsWideString else if (MemManager <> nil) and (t <> nil) and (t.Kind = skChar) and IsReadableMem(GetDerefAddress) then begin // pchar - i := MemManager.MemLimits.MaxNullStringSearchLen; - if i = 0 then - i := 32*1024; - if i > MemManager.MemLimits.MaxMemReadSize then - i := MemManager.MemLimits.MaxMemReadSize; - if not MemManager.SetLength(Result, i) then begin - Result := ''; - SetLastError(MemManager.LastError); - exit; - end; - - if not Context.ReadMemory(GetDerefAddress, SizeVal(i), @Result[1], [mmfPartialRead]) then begin + if not MemManager.ReadPChar(GetDerefAddress, 0, Result) then begin Result := ''; SetLastError(Context.LastMemError); exit; end; - - i := Context.PartialReadResultLenght; - SetLength(Result,i); - i := pos(#0, Result); - if i > 0 then - SetLength(Result,i-1); end else Result := inherited GetAsString; @@ -2548,28 +2531,11 @@ begin exit; // skWideChar ??? if (MemManager <> nil) and (t <> nil) and (t.Kind = skChar) and IsReadableMem(GetDerefAddress) then begin // pchar - i := MemManager.MemLimits.MaxNullStringSearchLen * 2; - if i = 0 then - i := 32*1024 * 2; - if i > MemManager.MemLimits.MaxMemReadSize then - i := MemManager.MemLimits.MaxMemReadSize; - if not MemManager.SetLength(Result, i div 2) then begin - Result := ''; - SetLastError(MemManager.LastError); - exit; - end; - - if not Context.ReadMemory(GetDerefAddress, SizeVal(i), @Result[1], [mmfPartialRead]) then begin + if not MemManager.ReadPWChar(GetDerefAddress, 0, Result) then begin Result := ''; SetLastError(Context.LastMemError); exit; end; - - i := Context.PartialReadResultLenght; - SetLength(Result, i div 2); - i := pos(#0, Result); - if i > 0 then - SetLength(Result, i-1); end else Result := inherited GetAsWideString; diff --git a/components/fpdebug/fpdbginfo.pas b/components/fpdebug/fpdbginfo.pas index 3f986f565d..cd58c59436 100644 --- a/components/fpdebug/fpdbginfo.pas +++ b/components/fpdebug/fpdbginfo.pas @@ -227,11 +227,15 @@ type TFpValueConstWithType = class(TFpValue) private FType: TFpSymbol; + FValAddress: TFpDbgMemLocation; protected function GetTypeInfo: TFpSymbol; override; + function GetFieldFlags: TFpValueFieldFlags; override; + function GetAddress: TFpDbgMemLocation; override; public destructor Destroy; override; procedure SetTypeName(AName: String); + procedure SetAddress(AnAddress: TFpDbgMemLocation); end; { TFpValueConstNumber } @@ -784,7 +788,7 @@ end; function TFpValueConstString.GetFieldFlags: TFpValueFieldFlags; begin - Result := [svfString] + Result := [svfString] + inherited GetFieldFlags; end; function TFpValueConstString.GetAsString: AnsiString; @@ -817,7 +821,7 @@ end; function TFpValueConstChar.GetFieldFlags: TFpValueFieldFlags; begin - Result := [svfString, svfSize]; + Result := [svfString, svfSize] + inherited GetFieldFlags; if Length(FValue) = 1 then Result := Result + [svfOrdinal]; end; @@ -878,6 +882,7 @@ end; function TFpValueConstWideChar.GetFieldFlags: TFpValueFieldFlags; begin Result := [svfWideString, svfSize, svfOrdinal]; + Result := Result + inherited GetFieldFlags; end; function TFpValueConstWideChar.GetAsString: AnsiString; @@ -1144,6 +1149,20 @@ begin Result := FType; end; +function TFpValueConstWithType.GetFieldFlags: TFpValueFieldFlags; +begin + Result := []; + if IsValidLoc(FValAddress) then + Result := [svfAddress]; +end; + +function TFpValueConstWithType.GetAddress: TFpDbgMemLocation; +begin + Result := InvalidLoc; + if IsInitializedLoc(FValAddress) then + Result := FValAddress; +end; + destructor TFpValueConstWithType.Destroy; begin inherited Destroy; @@ -1158,6 +1177,11 @@ begin FType.SetName(AName); end; +procedure TFpValueConstWithType.SetAddress(AnAddress: TFpDbgMemLocation); +begin + FValAddress := AnAddress; +end; + { TPasParserConstNumberSymbolValue } function TFpValueConstNumber.GetKind: TDbgSymbolKind; @@ -1174,6 +1198,7 @@ begin Result := [svfOrdinal, svfInteger] else Result := [svfOrdinal, svfCardinal]; + Result := Result + inherited GetFieldFlags; end; function TFpValueConstNumber.GetAsCardinal: QWord; @@ -1203,6 +1228,7 @@ end; function TFpValueConstFloat.GetFieldFlags: TFpValueFieldFlags; begin Result := [svfFloat]; + Result := Result + inherited GetFieldFlags; end; function TFpValueConstFloat.GetAsFloat: Extended; @@ -1226,6 +1252,7 @@ end; function TFpValueConstBool.GetFieldFlags: TFpValueFieldFlags; begin Result := [svfOrdinal, svfBoolean]; + Result := Result + inherited GetFieldFlags; end; function TFpValueConstBool.GetAsBool: Boolean; diff --git a/components/fpdebug/fpdmemorytools.pas b/components/fpdebug/fpdmemorytools.pas index 4894600d70..0a6cc6bca2 100644 --- a/components/fpdebug/fpdmemorytools.pas +++ b/components/fpdebug/fpdmemorytools.pas @@ -397,6 +397,7 @@ type TFpDbgMemManager = class private const TMP_MEM_SIZE = 4096; + DEF_MAX_PCHAR_LEN = 32 * 1024; private FCacheManager: TFpDbgMemCacheManagerBase; FLastError: TFpError; @@ -440,6 +441,8 @@ type function SetLength(var ADest: AnsiString; ALength: Int64): Boolean; overload; function SetLength(var ADest: WideString; ALength: Int64): Boolean; overload; function CheckDataSize(ASize: Int64): Boolean; + function ReadPChar(const ALocation: TFpDbgMemLocation; AMaxChars: Int64; out AValue: AnsiString): Boolean; + function ReadPWChar(const ALocation: TFpDbgMemLocation; AMaxChars: Int64; out AValue: WideString): Boolean; property TargetMemConvertor: TFpDbgMemConvertor read FTargetMemConvertor; property SelfMemConvertor: TFpDbgMemConvertor read FSelfMemConvertor; @@ -495,6 +498,10 @@ operator - (const a,b: TFpDbgValueSize): TFpDbgValueSize; inline; operator * (const a: TFpDbgValueSize; b: Int64): TFpDbgValueSize; inline; operator + (const AnAddr: TFpDbgMemLocation; ASize: TFpDbgValueSize): TFpDbgMemLocation; inline; +operator + (const AnAddr: TFpDbgMemLocation; AVal: Int64): TFpDbgMemLocation; inline; +operator - (const AnAddr: TFpDbgMemLocation; AVal: Int64): TFpDbgMemLocation; inline; +operator + (const AnAddr: TFpDbgMemLocation; AVal: QWord): TFpDbgMemLocation; inline; +operator - (const AnAddr: TFpDbgMemLocation; AVal: QWord): TFpDbgMemLocation; inline; function LocToAddr(const ALocation: TFpDbgMemLocation): TDbgPtr; inline; // does not check valid function LocToAddrOrNil(const ALocation: TFpDbgMemLocation): TDbgPtr; inline; // save version @@ -836,6 +843,38 @@ begin {$POP} end; +operator + (const AnAddr: TFpDbgMemLocation; AVal: Int64): TFpDbgMemLocation; +begin + Result := AnAddr; + {$PUSH}{$R-}{$Q-} + Result.Address := AnAddr.Address + AVal; + {$POP} +end; + +operator - (const AnAddr: TFpDbgMemLocation; AVal: Int64): TFpDbgMemLocation; +begin + Result := AnAddr; + {$PUSH}{$R-}{$Q-} + Result.Address := AnAddr.Address - AVal; + {$POP} +end; + +operator + (const AnAddr: TFpDbgMemLocation; AVal: QWord): TFpDbgMemLocation; +begin + Result := AnAddr; + {$PUSH}{$R-}{$Q-} + Result.Address := AnAddr.Address + AVal; + {$POP} +end; + +operator - (const AnAddr: TFpDbgMemLocation; AVal: QWord): TFpDbgMemLocation; +begin + Result := AnAddr; + {$PUSH}{$R-}{$Q-} + Result.Address := AnAddr.Address - AVal; + {$POP} +end; + function LocToAddr(const ALocation: TFpDbgMemLocation): TDbgPtr; begin assert(ALocation.MType = mlfTargetMem, 'LocToAddr for other than mlfTargetMem'); @@ -1460,7 +1499,7 @@ begin Result := False; FPartialReadResultLenght := SizeToFullBytes(ASourceSize); DebugLn(FPDBG_VERBOSE_MEM, ['$ReadMem: ', dbgs(AReadDataType),' ', dbgs(ASourceLocation), ' ', dbgs(ASourceSize), ' Dest ', ADestSize]); - assert(AContext<>nil, 'TFpDbgMemManager.ReadMemory: AContext<>nil'); + assert((AContext<>nil) or not(ASourceLocation.MType in [mlfTargetRegister]), 'TFpDbgMemManager.ReadMemory: (AContext<>nil) or not(ASourceLocation.MType in [mlfTargetRegister])'); // To late for an error, Dest-mem is already allocated assert((FMemLimits.MaxMemReadSize = 0) or (SizeToFullBytes(ASourceSize) <= FMemLimits.MaxMemReadSize), 'TFpDbgMemManager.ReadMemory: (FMemLimits.MaxMemReadSize = 0) or (SizeToFullBytes(ASourceSize) <= FMemLimits.MaxMemReadSize)'); @@ -1628,6 +1667,10 @@ begin end end; end; + + if SourceReadSize < FPartialReadResultLenght then + FPartialReadResultLenght := SourceReadSize; + if SourceReadSize > ConvData.SourceSize.Size then SourceReadSize := ConvData.SourceSize.Size; @@ -1878,6 +1921,68 @@ begin Result := True; end; +function TFpDbgMemManager.ReadPChar(const ALocation: TFpDbgMemLocation; + AMaxChars: Int64; out AValue: AnsiString): Boolean; +var + i: QWord; +begin + Result := False; + if not IsReadableLoc(ALocation) then begin + FLastError := CreateError(fpInternalErrFailedReadMem); + exit; + end; + if AMaxChars <= 0 then + AMaxChars := DEF_MAX_PCHAR_LEN; + + i := MemLimits.MaxNullStringSearchLen; + if i = 0 then + i := MemLimits.MaxMemReadSize; + if (i > 0) and (AMaxChars > i) then + AMaxChars := i; + + SetLength(AValue, AMaxChars); + if ReadMemory(rdtRawRead, ALocation, SizeVal(AMaxChars), @AValue[1], AMaxChars, nil, [mmfPartialRead]) then begin + Result := True; + i := PartialReadResultLenght; + SetLength(AValue, i); + i := pos(#0, AValue); + if i > 0 then + SetLength(AValue, i-1); + exit; + end +end; + +function TFpDbgMemManager.ReadPWChar(const ALocation: TFpDbgMemLocation; + AMaxChars: Int64; out AValue: WideString): Boolean; +var + i: QWord; +begin + Result := False; + if not IsReadableLoc(ALocation) then begin + FLastError := CreateError(fpInternalErrFailedReadMem); + exit; + end; + if AMaxChars <= 0 then + AMaxChars := DEF_MAX_PCHAR_LEN; + + i := MemLimits.MaxNullStringSearchLen; + if i = 0 then + i := MemLimits.MaxMemReadSize div 2; + if (i > 0) and (AMaxChars > i) then + AMaxChars := i; + + SetLength(AValue, AMaxChars); + if ReadMemory(rdtRawRead, ALocation, SizeVal(AMaxChars*2), @AValue[1], AMaxChars*2, nil, [mmfPartialRead]) then begin + Result := True; + i := PartialReadResultLenght div 2; + SetLength(AValue, i); + i := pos(#0, AValue); + if i > 0 then + SetLength(AValue, i-1); + exit; + end +end; + initialization FPDBG_VERBOSE_MEM := DebugLogger.FindOrRegisterLogGroup('FPDBG_VERBOSE_MEM' {$IFDEF FPDBG_VERBOSE_MEM} , True {$ENDIF} ); diff --git a/components/fpdebug/fppascalparser.pas b/components/fpdebug/fppascalparser.pas index 3e45c78ddf..c6ec5bc24c 100644 --- a/components/fpdebug/fppascalparser.pas +++ b/components/fpdebug/fppascalparser.pas @@ -1098,12 +1098,46 @@ begin end; function TFpPasParserValueAddressOf.GetAsString: AnsiString; +var + a: TFpDbgMemLocation; + WResult: WideString; begin + a := FValue.Address; + + if (FValue.Kind = skChar) and IsTargetNotNil(a) then begin + if (FValue.DataSize = 1) and Context.MemManager.ReadPChar(a, 0, Result) then + exit; + if (FValue.DataSize = 2) and Context.MemManager.ReadPWChar(a, 0, WResult) then + exit(WResult); + end; + + //if (FValue.Kind = skChar) and IsTargetNotNil(a) and + // Context.MemManager.ReadPChar(a, 0, Result) + //then + // exit; + // + //if (FValue.Kind = skWideString) and IsTargetNotNil(a) and + // Context.MemManager.ReadPWChar(a, 0, WResult) + //then + // exit(WResult); + Result := FValue.AsString; end; function TFpPasParserValueAddressOf.GetAsWideString: WideString; +var + AResult: AnsiString; + a: TFpDbgMemLocation; begin + a := FValue.Address; + + if (FValue.Kind = skChar) and IsTargetNotNil(a) then begin + if (FValue.DataSize = 1) and Context.MemManager.ReadPChar(a, 0, AResult) then + exit(AResult); + if (FValue.DataSize = 2) and Context.MemManager.ReadPWChar(a, 0, Result) then + exit; + end; + Result := FValue.AsWideString; end; @@ -1221,6 +1255,7 @@ var IsPChar: Boolean; v: String; w: WideString; + a: TFpDbgMemLocation; begin Result := nil; assert(Count >= 2, 'TFpPascalExpressionPartBracketIndex.DoGetResultValue: Count >= 2'); @@ -1308,6 +1343,9 @@ begin end; TmpVal2 := TFpValueConstChar.Create(v[Offs]); + a := TmpVal.DataAddress; + if IsTargetAddr(a) and IsReadableMem(a) then + TFpValueConstChar(TmpVal2).SetAddress(a + Offs-1); end; skWideString: begin //TODO: move to FpDwarfValue.member ?? @@ -1332,6 +1370,9 @@ begin end; TmpVal2 := TFpValueConstWideChar.Create(w[Offs]); + a := TmpVal.DataAddress; + if IsTargetAddr(a) and IsReadableMem(a) then + TFpValueConstWideChar(TmpVal2).SetAddress(a + (Offs-1)*2); end; else begin diff --git a/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas b/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas index 66c5545f65..0edd09b7c4 100644 --- a/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas +++ b/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas @@ -2497,6 +2497,57 @@ end; end; + procedure AddWatches2(t: TWatchExpectationList; AName: String; APrefix: String; AChr1: Char; ALoc: TTestLoc = tlAny; APostFix: String = ''); + var + p, e: String; + i, c: Integer; + begin + p := APrefix; + e := APostFix; + + + t.Add(AName, p+'PChar2'+e+'+0', wePointer(weAnsiStr(AChr1+'abcd0123', 'Char'), 'PChar')); + t.Add(AName, p+'PChar2'+e+'+1', wePointer(weAnsiStr('abcd0123', 'Char'), 'PChar')); + t.Add(AName, p+'PChar2'+e+'+2', wePointer(weAnsiStr('bcd0123', 'Char'), 'PChar')); + + t.Add(AName, p+'PWideChar2'+e+'+0', wePointer(weWideStr(AChr1+'abcX0123', 'WideChar'), 'TPWChr')); + t.Add(AName, p+'PWideChar2'+e+'+1', wePointer(weWideStr('abcX0123', 'WideChar'), 'TPWChr')); + t.Add(AName, p+'PWideChar2'+e+'+2', wePointer(weWideStr('bcX0123', 'WideChar'), 'TPWChr')); + + + c := t.Count; + // .CharFromIndex. + //t.Add(AName, p+'PChar2'+e+'[0]', weChar(AChr1, 'Char')); + //t.Add(AName, p+'PChar2'+e+'[1]', weChar('a', 'Char')); + //t.Add(AName, '@'+p+'PChar2'+e+'[0]', wePointer(weAnsiStr(AChr1+'abcd0123', 'Char'), 'PChar')); + //t.Add(AName, '@'+p+'PChar2'+e+'[1]', wePointer(weAnsiStr('abcd0123', 'Char'), 'PChar')); + //t.Add(AName, '@'+p+'PChar2'+e+'[2]', wePointer(weAnsiStr('bcd0123', 'Char'), 'PChar')); + + t.Add(AName, '@'+p+'Ansi2'+e+'[1]', wePointer(weAnsiStr(AChr1+'abcd0123').IgnTypeName, '^Char')).IgnKindPtr(stDwarf2); + t.Add(AName, '@'+p+'Ansi2'+e+'[2]', wePointer(weAnsiStr('abcd0123').IgnTypeName, '^Char')).IgnKindPtr(stDwarf2); + t.Add(AName, '@'+p+'Ansi2'+e+'[3]', wePointer(weAnsiStr('bcd0123').IgnTypeName, '^Char')).IgnKindPtr(stDwarf2); +// t.Add(AName, '@'+p+'Ansi2'+e+'[1]+1', wePointer(weAnsiStr('abcd0123'), '^Char')).IgnKindPtr(stDwarf2).IgnKind(stDwarf3Up); + + t.Add(AName, '@'+p+'String10'+e+'[1]', wePointer(weShortStr(AChr1+'bc1', '').IgnTypeName, '^Char')); + t.Add(AName, '@'+p+'String10'+e+'[2]', wePointer(weShortStr('bc1', '').IgnTypeName, '^Char')); + + + // DWARF-3: .CharFromIndex. + t.Add(AName, '@'+p+'WideString2'+e+'[1]', wePointer(weWideStr(AChr1+'abcX0123', 'WideChar'), '^WideChar')) + .IgnAll(stDwarf3Up); + t.Add(AName, '@'+p+'WideString2'+e+'[2]', wePointer(weWideStr('abcX0123', 'WideChar'), '^WideChar')) + .IgnAll(stDwarf3Up); + t.Add(AName, '@'+p+'WideString2'+e+'[3]', wePointer(weWideStr('bcX0123', 'WideChar'), '^WideChar')) + .IgnAll(stDwarf3Up); + + for i := 0 to t.Count - 1 do begin + t.Tests[i].IgnTypeName; + t.Tests[i].IgnKind; + if i >= c then + t.Tests[i].IgnAll(stDwarf2); + end; + end; + procedure CmpWatches(t1, t2: TWatchExpectationList); var i, Thread: Integer; @@ -2584,6 +2635,11 @@ begin AddWatches(tp, 'glob var pointer', 'gvp_'); // pointer CmpWatches(t, tp); + t.Clear; + AddWatches2(t, 'glob var pchar', 'gv', 'B'); + t.EvaluateWatches; + t.CheckResults; + // TODO: field / field on nil object