mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-29 11:29:35 +02:00
FpDebug: Improve PChar handling in pointer math.
This commit is contained in:
Martin
parent
9f577dc548
commit
4910e764bb
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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} );
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user