mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-13 21:02:55 +02:00
FpDebug: consolidate some string related code
This commit is contained in:
Martin
parent
baa905dd96
commit
747b9e5552
@ -508,22 +508,22 @@ type
|
||||
|
||||
TFpValueDwarfString = class(TFpValueDwarf)
|
||||
private
|
||||
FValue: String;
|
||||
FValueDone: Boolean;
|
||||
FLenSize: TFpDbgValueSize;
|
||||
FHasLenSize, FLenSizeDone: Boolean;
|
||||
protected
|
||||
FValue: String;
|
||||
FValueDone: Boolean;
|
||||
function GetLenSize(out ASize: TFpDbgValueSize): boolean;
|
||||
function GetStringLen: Int64;
|
||||
function GetStringLen(out ALen: Int64): boolean;
|
||||
|
||||
function GetFieldFlags: TFpValueFieldFlags; override;
|
||||
function GetAsString: AnsiString; override;
|
||||
function GetAsWideString: WideString; override;
|
||||
public
|
||||
function GetSubString(AStartIndex, ALen: Int64; out ASubStr: AnsiString;
|
||||
AIgnoreBounds: Boolean = False): Boolean; override;
|
||||
function GetSubWideString(AStartIndex, ALen: Int64; out ASubStr: WideString;
|
||||
AIgnoreBounds: Boolean = False): Boolean; override;
|
||||
public
|
||||
procedure Reset; override;
|
||||
end;
|
||||
|
||||
@ -4092,14 +4092,15 @@ begin
|
||||
Result := FHasLenSize;
|
||||
end;
|
||||
|
||||
function TFpValueDwarfString.GetStringLen: Int64;
|
||||
function TFpValueDwarfString.GetStringLen(out ALen: Int64): boolean;
|
||||
var
|
||||
t: TFpSymbolDwarfType;
|
||||
HasSize: Boolean;
|
||||
ASize: TFpDbgValueSize;
|
||||
HasLenSize: Boolean;
|
||||
LenSize: TFpDbgValueSize;
|
||||
ALenLoc: TFpDbgMemLocation;
|
||||
begin
|
||||
Result := -1;
|
||||
Result := False;
|
||||
ALen := -1;
|
||||
|
||||
t := TypeInfo;
|
||||
if t <> nil then
|
||||
@ -4107,23 +4108,25 @@ begin
|
||||
if (t = nil) or not(t is TFpSymbolDwarfTypeString) then
|
||||
exit;
|
||||
|
||||
HasSize := GetLenSize(ASize);
|
||||
HasLenSize := GetLenSize(LenSize);
|
||||
|
||||
if TFpSymbolDwarfTypeString(t).DoReadLengthLocation(Self, ALenLoc) then begin
|
||||
if not HasSize then
|
||||
ASize := SizeVal(AddressSize);
|
||||
if not Context.ReadSignedInt(ALenLoc, ASize, Result) then begin
|
||||
if not HasLenSize then
|
||||
LenSize := SizeVal(AddressSize);
|
||||
Result := Context.ReadSignedInt(ALenLoc, LenSize, ALen);
|
||||
if not Result then begin
|
||||
SetLastError(Context.LastMemError);
|
||||
Result := -1;
|
||||
ALen := -1;
|
||||
end;
|
||||
end
|
||||
else
|
||||
if HasSize then begin
|
||||
Result := SizeToFullBytes(ASize);
|
||||
if HasLenSize then begin
|
||||
ALen := SizeToFullBytes(LenSize);
|
||||
Result := True;
|
||||
end
|
||||
else begin
|
||||
SetLastError(CreateError(fpErrAnyError));
|
||||
Result := -1;
|
||||
ALen := -1;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -4140,6 +4143,7 @@ function TFpValueDwarfString.GetAsString: AnsiString;
|
||||
var
|
||||
ALen: Int64;
|
||||
WResult: WideString;
|
||||
RResult: RawByteString;
|
||||
begin
|
||||
if FValueDone then
|
||||
exit(FValue);
|
||||
@ -4148,32 +4152,20 @@ begin
|
||||
FValue := '';
|
||||
FValueDone := True;
|
||||
|
||||
ALen := GetStringLen;
|
||||
if ALen <= 0 then
|
||||
exit;
|
||||
|
||||
if (MemManager.MemLimits.MaxStringLen > 0) and
|
||||
(QWord(ALen) > MemManager.MemLimits.MaxStringLen)
|
||||
then
|
||||
ALen := MemManager.MemLimits.MaxStringLen;
|
||||
if not GetStringLen(ALen) then
|
||||
exit; // Error should be set by GetStringLen
|
||||
|
||||
if Kind = skWideString then begin
|
||||
SetLength(WResult, ALen);
|
||||
if not (Context.ReadMemory(DataAddress, SizeVal(ALen*2), @WResult[1]))
|
||||
then begin
|
||||
SetLastError(Context.LastMemError);
|
||||
Result := '';
|
||||
end
|
||||
if not Context.ReadWString(DataAddress, ALen, WResult) then
|
||||
SetLastError(Context.LastMemError)
|
||||
else
|
||||
Result := WResult;
|
||||
end
|
||||
else begin
|
||||
SetLength(Result, ALen);
|
||||
if not (Context.ReadMemory(DataAddress, SizeVal(ALen), @Result[1]))
|
||||
then begin
|
||||
SetLastError(Context.LastMemError);
|
||||
Result := '';
|
||||
end;
|
||||
if not Context.ReadString(DataAddress, ALen, RResult) then
|
||||
SetLastError(Context.LastMemError)
|
||||
else
|
||||
Result := RResult;
|
||||
end;
|
||||
|
||||
FValue := Result;
|
||||
@ -4189,6 +4181,7 @@ function TFpValueDwarfString.GetSubString(AStartIndex, ALen: Int64; out
|
||||
var
|
||||
AFullLen: Int64;
|
||||
WResult: WideString;
|
||||
RResult: RawByteString;
|
||||
begin
|
||||
// TODO: if FValueDone, and covers selected range, then use FValue;
|
||||
ASubStr := '';
|
||||
@ -4203,8 +4196,7 @@ begin
|
||||
AStartIndex := 0;
|
||||
end;
|
||||
|
||||
AFullLen := GetStringLen;
|
||||
if AFullLen <= 0 then begin
|
||||
if (not GetStringLen(AFullLen)) or (AFullLen <= 0) then begin
|
||||
Result := AIgnoreBounds;
|
||||
exit;
|
||||
end;
|
||||
@ -4217,30 +4209,21 @@ begin
|
||||
if ALen <= 0 then
|
||||
exit;
|
||||
|
||||
if (MemManager.MemLimits.MaxStringLen > 0) and
|
||||
(QWord(ALen) > MemManager.MemLimits.MaxStringLen)
|
||||
then
|
||||
ALen := MemManager.MemLimits.MaxStringLen;
|
||||
|
||||
if Kind = skWideString then begin
|
||||
SetLength(WResult, ALen);
|
||||
if not (Context.ReadMemory(DataAddress + AStartIndex*2, SizeVal(ALen*2), @WResult[1]))
|
||||
then begin
|
||||
SetLastError(Context.LastMemError);
|
||||
WResult := '';
|
||||
exit;
|
||||
end
|
||||
{$PUSH}{$Q-}{$R-}
|
||||
if not Context.ReadWString(DataAddress+AStartIndex*2, ALen, WResult, True) then
|
||||
{$POP}
|
||||
SetLastError(Context.LastMemError)
|
||||
else
|
||||
ASubStr := WResult;
|
||||
end
|
||||
else begin
|
||||
SetLength(ASubStr, ALen);
|
||||
if not (Context.ReadMemory(DataAddress + AStartIndex, SizeVal(ALen), @ASubStr[1]))
|
||||
then begin
|
||||
SetLastError(Context.LastMemError);
|
||||
ASubStr := '';
|
||||
exit;
|
||||
end;
|
||||
{$PUSH}{$Q-}{$R-}
|
||||
if not Context.ReadString(DataAddress+AStartIndex, ALen, RResult, True) then
|
||||
{$POP}
|
||||
SetLastError(Context.LastMemError)
|
||||
else
|
||||
ASubStr := RResult;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -254,13 +254,15 @@ type
|
||||
function IsValidTypeCast: Boolean; override;
|
||||
function GetFieldFlags: TFpValueFieldFlags; override;
|
||||
function GetKind: TDbgSymbolKind; override;
|
||||
//function GetAsString: AnsiString; override;
|
||||
function GetAsString: AnsiString; override;
|
||||
//function GetAsWideString: WideString; override;
|
||||
function GetMemberCount: Integer; override;
|
||||
procedure SetAsCardinal(AValue: QWord); override;
|
||||
function GetAsCardinal: QWord; override;
|
||||
//function GetSubString(AStartIndex, ALen: Int64; out ASubStr: AnsiString;
|
||||
// AIgnoreBounds: Boolean = False): Boolean; override;
|
||||
public
|
||||
function GetFpcRefCount(out ARefCount: Int64): Boolean; override;
|
||||
function GetSubString(AStartIndex, ALen: Int64; out ASubStr: AnsiString;
|
||||
AIgnoreBounds: Boolean = False): Boolean; override;
|
||||
//function GetSubWideString(AStartIndex, ALen: Int64; out ASubStr: WideString;
|
||||
// AIgnoreBounds: Boolean = False): Boolean; override;
|
||||
end;
|
||||
@ -289,13 +291,13 @@ type
|
||||
FValueDone, FBoundsDone: Boolean;
|
||||
FDynamicCodePage: TSystemCodePage;
|
||||
function GetCodePage: TSystemCodePage;
|
||||
function ObtainDynamicCodePage(Addr: TFpDbgMemLocation; out Codepage: TSystemCodePage): Boolean;
|
||||
procedure CalcBounds;
|
||||
// check if this is a string, and return bounds
|
||||
function CheckTypeAndGetAddr(out AnAddr: TFpDbgMemLocation): boolean;
|
||||
protected
|
||||
function IsValidTypeCast: Boolean; override;
|
||||
function GetFieldFlags: TFpValueFieldFlags; override;
|
||||
function GetStringLen(out ALen: Int64): boolean; inline;
|
||||
function GetAsString: AnsiString; override;
|
||||
function GetAsWideString: WideString; override;
|
||||
procedure SetAsCardinal(AValue: QWord); override;
|
||||
@ -340,6 +342,34 @@ uses
|
||||
var
|
||||
FPDBG_DWARF_VERBOSE: PLazLoggerLogGroup;
|
||||
|
||||
function ObtainDynamicCodePage(Addr: TFpDbgMemLocation; AContext: TFpDbgLocationContext;
|
||||
TypeInfo: TFpSymbolDwarfType; out Codepage: TSystemCodePage): Boolean;
|
||||
var
|
||||
CodepageOffset: SmallInt;
|
||||
v: Cardinal;
|
||||
begin
|
||||
// Only call this function for non-empty strings!
|
||||
Result := False;
|
||||
if not IsTargetNotNil(Addr) then
|
||||
exit;
|
||||
|
||||
// Only AnsiStrings in fpc 3.0.0 and higher have a dynamic codepage.
|
||||
v := TFpDwarfFreePascalSymbolClassMapDwarf3(TypeInfo.CompilationUnit.DwarfSymbolClassMap).FCompilerVersion;
|
||||
if (v >= $030000) then begin
|
||||
// Too bad the debug-information does not deliver this information. So we
|
||||
// use these hardcoded information, and hope that FPC does not change and
|
||||
// we never reach this point for a compilationunit that is not compiled by
|
||||
// fpc.
|
||||
if v >= $030300 { $030301 } then
|
||||
CodepageOffset := TypeInfo.CompilationUnit.AddressSize + SizeOf(Longint) + SizeOf(Word) + SizeOf(Word)
|
||||
else
|
||||
CodepageOffset := TypeInfo.CompilationUnit.AddressSize * 3;
|
||||
Addr.Address := Addr.Address - CodepageOffset;
|
||||
if AContext.ReadMemory(Addr, SizeVal(2), @Codepage) then
|
||||
Result := CodePageToCodePageName(Codepage) <> '';
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TFpDwarfFreePascalSymbolClassMap }
|
||||
|
||||
function TFpDwarfFreePascalSymbolClassMap.CanHandleCompUnit(
|
||||
@ -632,8 +662,6 @@ function TFpDwarfFreePascalSymbolScope.FindExportedSymbolInUnits(
|
||||
var
|
||||
i: Integer;
|
||||
CU: TDwarfCompilationUnit;
|
||||
FoundInfoEntry: TDwarfInformationEntry;
|
||||
FndIsExternal: Boolean;
|
||||
s: String;
|
||||
begin
|
||||
if not FSearchSpecialCuDone then begin
|
||||
@ -1318,7 +1346,7 @@ begin
|
||||
len := LenSym.AsCardinal;
|
||||
LenSym.ReleaseReference;
|
||||
|
||||
if not GetSize(Size) then begin;
|
||||
if not GetSize(Size) then begin
|
||||
SetLastError(CreateError(fpErrAnyError));
|
||||
exit('');
|
||||
end;
|
||||
@ -1569,6 +1597,51 @@ begin
|
||||
Result := skAnsiString;
|
||||
end;
|
||||
|
||||
function TFpValueDwarfFreePascalString.GetAsString: AnsiString;
|
||||
var
|
||||
ALen: Int64;
|
||||
WResult: WideString;
|
||||
RResult: RawByteString;
|
||||
Codepage: TSystemCodePage;
|
||||
begin
|
||||
if FValueDone then
|
||||
exit(FValue);
|
||||
|
||||
Result := '';
|
||||
FValue := '';
|
||||
FValueDone := True;
|
||||
|
||||
if not GetStringLen(ALen) then
|
||||
exit;
|
||||
|
||||
if Kind = skWideString then begin
|
||||
if not Context.ReadWString(DataAddress, ALen, WResult) then
|
||||
SetLastError(Context.LastMemError)
|
||||
else
|
||||
Result := WResult;
|
||||
end
|
||||
else
|
||||
if Kind = skAnsiString then begin
|
||||
if not Context.ReadString(DataAddress, ALen, RResult) then begin
|
||||
SetLastError(Context.LastMemError);
|
||||
end
|
||||
else begin
|
||||
if ObtainDynamicCodePage(DataAddress, Context, TypeInfo, Codepage) then
|
||||
SetCodePage(RResult, Codepage, False);
|
||||
Result := RResult;
|
||||
end;
|
||||
end
|
||||
else begin
|
||||
// ShortString;
|
||||
if not Context.ReadString(DataAddress, ALen, RResult) then
|
||||
SetLastError(Context.LastMemError)
|
||||
else
|
||||
Result := RResult;
|
||||
end;
|
||||
|
||||
FValue := Result;
|
||||
end;
|
||||
|
||||
function TFpValueDwarfFreePascalString.GetMemberCount: Integer;
|
||||
var
|
||||
ALen: Int64;
|
||||
@ -1598,6 +1671,105 @@ begin
|
||||
Result := inherited GetAsCardinal;
|
||||
end;
|
||||
|
||||
function TFpValueDwarfFreePascalString.GetFpcRefCount(out ARefCount: Int64): Boolean;
|
||||
var
|
||||
Addr: TFpDbgMemLocation;
|
||||
begin
|
||||
ARefCount := 0;
|
||||
Result := (Kind = skAnsiString);
|
||||
if not Result then
|
||||
exit;
|
||||
|
||||
GetDwarfDataAddress(Addr);
|
||||
if (not IsValidLoc(Addr)) and
|
||||
(HasTypeCastInfo) and
|
||||
(svfOrdinal in TypeCastSourceValue.FieldFlags)
|
||||
then
|
||||
Addr := TargetLoc(TypeCastSourceValue.AsCardinal);
|
||||
|
||||
Result := IsTargetNil(Addr);
|
||||
if Result then
|
||||
exit;
|
||||
|
||||
if not MemManager.MemModel.IsReadableLocation(Addr) then
|
||||
exit;
|
||||
|
||||
if TFpDwarfFreePascalSymbolClassMap(TypeInfo.CompilationUnit.DwarfSymbolClassMap).FCompilerVersion >= $030301
|
||||
then begin
|
||||
Addr:= Addr - AddressSize - 4;
|
||||
Result := Context.ReadSignedInt(Addr, SizeVal(4), ARefCount);
|
||||
end
|
||||
else begin
|
||||
Addr:= Addr - (AddressSize * 2);
|
||||
Result := Context.ReadSignedInt(Addr, SizeVal(AddressSize), ARefCount);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFpValueDwarfFreePascalString.GetSubString(AStartIndex, ALen: Int64; out
|
||||
ASubStr: AnsiString; AIgnoreBounds: Boolean): Boolean;
|
||||
var
|
||||
AFullLen: Int64;
|
||||
WResult: WideString;
|
||||
RResult: RawByteString;
|
||||
Codepage: TSystemCodePage;
|
||||
begin
|
||||
// TODO: if FValueDone, and covers selected range, then use FValue;
|
||||
ASubStr := '';
|
||||
Result := True;
|
||||
if ALen <= 0 then
|
||||
exit;
|
||||
|
||||
dec(AStartIndex);
|
||||
if AStartIndex < 0 then begin // not supported, return partial
|
||||
Result := AIgnoreBounds;
|
||||
ALen := ALen + AStartIndex;
|
||||
AStartIndex := 0;
|
||||
end;
|
||||
|
||||
if (not GetStringLen(AFullLen)) or (AFullLen <= 0) then begin
|
||||
Result := AIgnoreBounds;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if AStartIndex + ALen > AFullLen then begin
|
||||
Result := AIgnoreBounds;
|
||||
ALen := AFullLen - AStartIndex;
|
||||
end;
|
||||
|
||||
if ALen <= 0 then
|
||||
exit;
|
||||
|
||||
if Kind = skWideString then begin
|
||||
{$PUSH}{$Q-}{$R-}
|
||||
if not Context.ReadWString(DataAddress+AStartIndex*2, ALen, WResult, True) then
|
||||
{$POP}
|
||||
SetLastError(Context.LastMemError)
|
||||
else
|
||||
ASubStr := WResult;
|
||||
end
|
||||
else
|
||||
if Kind = skAnsiString then begin
|
||||
{$PUSH}{$Q-}{$R-}
|
||||
if not Context.ReadString(DataAddress+AStartIndex, ALen, RResult) then begin
|
||||
{$POP}
|
||||
SetLastError(Context.LastMemError);
|
||||
end
|
||||
else begin
|
||||
if ObtainDynamicCodePage(DataAddress, Context, TypeInfo, Codepage) then
|
||||
SetCodePage(RResult, Codepage, False);
|
||||
ASubStr := RResult;
|
||||
end;
|
||||
end
|
||||
else begin
|
||||
{$PUSH}{$Q-}{$R-}
|
||||
if not Context.ReadString(DataAddress+AStartIndex, ALen, RResult, True) then
|
||||
{$POP}
|
||||
SetLastError(Context.LastMemError)
|
||||
else
|
||||
ASubStr := RResult;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TFpSymbolDwarfV3FreePascalSymbolTypeArray }
|
||||
|
||||
function TFpSymbolDwarfV3FreePascalSymbolTypeArray.GetInternalStringType: TArrayOrStringType;
|
||||
@ -1765,12 +1937,24 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFpValueDwarfV3FreePascalString.GetStringLen(out ALen: Int64): boolean;
|
||||
begin
|
||||
ALen := 0;
|
||||
Result := True; // Todo: add error checks
|
||||
CalcBounds;
|
||||
if FHighBound < FLowBound then
|
||||
exit; // empty string
|
||||
{$PUSH}{$Q-}{$R-}
|
||||
ALen := FHighBound-FLowBound+1;
|
||||
{$POP}
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function TFpValueDwarfV3FreePascalString.GetSubString(AStartIndex, ALen: Int64;
|
||||
out ASubStr: AnsiString; AIgnoreBounds: Boolean): Boolean;
|
||||
var
|
||||
Addr: TFpDbgMemLocation;
|
||||
Addr, StartAddr: TFpDbgMemLocation;
|
||||
FullLen: Int64;
|
||||
t: TFpSymbol;
|
||||
WResult: WideString;
|
||||
RResult: RawByteString;
|
||||
Codepage: TSystemCodePage;
|
||||
@ -1784,13 +1968,7 @@ begin
|
||||
AStartIndex := 1;
|
||||
end;
|
||||
|
||||
// get length
|
||||
CalcBounds;
|
||||
if FHighBound < FLowBound then
|
||||
exit; // empty string
|
||||
{$PUSH}{$Q-}{$R-}
|
||||
FullLen := FHighBound-FLowBound+1;
|
||||
{$POP}
|
||||
GetStringLen(FullLen);
|
||||
|
||||
if AStartIndex - 1 + ALen > FullLen then begin
|
||||
Result := AIgnoreBounds;
|
||||
@ -1814,22 +1992,11 @@ begin
|
||||
exit(False);
|
||||
|
||||
|
||||
if (MemManager.MemLimits.MaxStringLen > 0) and
|
||||
(QWord(ALen) > MemManager.MemLimits.MaxStringLen)
|
||||
then
|
||||
ALen := MemManager.MemLimits.MaxStringLen;
|
||||
|
||||
if ALen <= 0 then
|
||||
exit;
|
||||
|
||||
t := TypeInfo;
|
||||
if t.Kind = skWideString then begin
|
||||
if Kind = skWideString then begin
|
||||
{$PUSH}{$Q-}{$R-}
|
||||
Addr.Address := Addr.Address + (AStartIndex - 1) * 2;
|
||||
{$POP}
|
||||
if not ( (MemManager.SetLength(WResult, ALen)) and
|
||||
(Context.ReadMemory(Addr, SizeVal(ALen*2), @WResult[1])) )
|
||||
then
|
||||
if not Context.ReadWString(Addr, ALen, WResult, True) then
|
||||
SetLastError(Context.LastMemError)
|
||||
else
|
||||
ASubStr := WResult;
|
||||
@ -1839,23 +2006,20 @@ begin
|
||||
{$PUSH}{$Q-}{$R-}
|
||||
Addr.Address := Addr.Address + AStartIndex - 1;
|
||||
{$POP}
|
||||
if not ( (MemManager.SetLength(ASubStr, ALen)) and
|
||||
(Context.ReadMemory(Addr, SizeVal(ALen), @ASubStr[1])) )
|
||||
then begin
|
||||
ASubStr := '';
|
||||
SetLastError(Context.LastMemError);
|
||||
end;
|
||||
if not Context.ReadString(Addr, ALen, RResult, True) then
|
||||
SetLastError(Context.LastMemError)
|
||||
else
|
||||
ASubStr := RResult;
|
||||
end
|
||||
else begin
|
||||
StartAddr := Addr;
|
||||
{$PUSH}{$Q-}{$R-}
|
||||
Addr.Address := Addr.Address + QWord(AStartIndex - 1);
|
||||
{$POP}
|
||||
if not ( (MemManager.SetLength(RResult, ALen)) and
|
||||
(Context.ReadMemory(Addr, SizeVal(ALen), @RResult[1])) )
|
||||
then begin
|
||||
if not Context.ReadString(Addr, ALen, RResult, True) then begin
|
||||
SetLastError(Context.LastMemError);
|
||||
end else begin
|
||||
if ObtainDynamicCodePage(Addr, Codepage) then
|
||||
if ObtainDynamicCodePage(StartAddr, Context, TypeInfo, Codepage) then
|
||||
begin
|
||||
SetCodePage(RResult, Codepage, False);
|
||||
FDynamicCodePage:=Codepage;
|
||||
@ -1876,7 +2040,6 @@ end;
|
||||
|
||||
function TFpValueDwarfV3FreePascalString.GetAsString: AnsiString;
|
||||
var
|
||||
t: TFpSymbol;
|
||||
Len: Int64;
|
||||
Addr: TFpDbgMemLocation;
|
||||
WResult: WideString;
|
||||
@ -1894,45 +2057,26 @@ begin
|
||||
if not CheckTypeAndGetAddr(Addr) then
|
||||
exit;
|
||||
|
||||
// get length
|
||||
CalcBounds;
|
||||
if FHighBound < FLowBound then
|
||||
exit; // empty string
|
||||
{$PUSH}{$Q-}{$R-}
|
||||
Len := FHighBound-FLowBound+1;
|
||||
{$POP}
|
||||
GetStringLen(Len);
|
||||
|
||||
if (MemManager.MemLimits.MaxStringLen > 0) and
|
||||
(QWord(Len) > MemManager.MemLimits.MaxStringLen)
|
||||
then
|
||||
Len := MemManager.MemLimits.MaxStringLen;
|
||||
|
||||
|
||||
t := TypeInfo;
|
||||
if t.Kind = skWideString then begin
|
||||
if not ( (MemManager.SetLength(WResult, Len)) and
|
||||
(Context.ReadMemory(Addr, SizeVal(Len*2), @WResult[1])) )
|
||||
then
|
||||
if Kind = skWideString then begin
|
||||
if not Context.ReadWString(Addr, Len, WResult) then
|
||||
SetLastError(Context.LastMemError)
|
||||
else
|
||||
Result := WResult;
|
||||
end else
|
||||
if Addr.Address = Address.Address + 1 then begin
|
||||
// shortstring
|
||||
if not ( (MemManager.SetLength(Result, Len)) and
|
||||
(Context.ReadMemory(Addr, SizeVal(Len), @Result[1])) )
|
||||
then begin
|
||||
Result := '';
|
||||
SetLastError(Context.LastMemError);
|
||||
end;
|
||||
if not Context.ReadString(Addr, Len, RResult) then
|
||||
SetLastError(Context.LastMemError)
|
||||
else
|
||||
Result := RResult;
|
||||
end
|
||||
else begin
|
||||
if not ( (MemManager.SetLength(RResult, Len)) and
|
||||
(Context.ReadMemory(Addr, SizeVal(Len), @RResult[1])) )
|
||||
then begin
|
||||
if not Context.ReadString(Addr, Len, RResult) then begin
|
||||
SetLastError(Context.LastMemError);
|
||||
end else begin
|
||||
if ObtainDynamicCodePage(Addr, Codepage) then
|
||||
if ObtainDynamicCodePage(Addr, Context, TypeInfo, Codepage) then
|
||||
begin
|
||||
SetCodePage(RResult, Codepage, False);
|
||||
FDynamicCodePage:=Codepage;
|
||||
@ -1982,7 +2126,7 @@ var
|
||||
Addr: TFpDbgMemLocation;
|
||||
begin
|
||||
ARefCount := 0;
|
||||
Result := (TypeInfo.Kind = skString);
|
||||
Result := (TypeInfo.Kind in [skString, skAnsiString]); // todo only skAnsiString;
|
||||
if not Result then
|
||||
exit;
|
||||
|
||||
@ -2011,32 +2155,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFpValueDwarfV3FreePascalString.ObtainDynamicCodePage(Addr: TFpDbgMemLocation; out
|
||||
Codepage: TSystemCodePage): Boolean;
|
||||
var
|
||||
CodepageOffset: SmallInt;
|
||||
begin
|
||||
// Only call this function for non-empty strings!
|
||||
Result := False;
|
||||
if not IsTargetNotNil(Addr) then
|
||||
exit;
|
||||
|
||||
// Only AnsiStrings in fpc 3.0.0 and higher have a dynamic codepage.
|
||||
if (TypeInfo.Kind = skString) and (TFpDwarfFreePascalSymbolClassMapDwarf3(TypeInfo.CompilationUnit.DwarfSymbolClassMap).FCompilerVersion >= $030000) then begin
|
||||
// Too bad the debug-information does not deliver this information. So we
|
||||
// use these hardcoded information, and hope that FPC does not change and
|
||||
// we never reach this point for a compilationunit that is not compiled by
|
||||
// fpc.
|
||||
if TFpDwarfFreePascalSymbolClassMapDwarf3(TypeInfo.CompilationUnit.DwarfSymbolClassMap).FCompilerVersion >= $030300 { $030301 } then
|
||||
CodepageOffset := AddressSize + SizeOf(Longint) + SizeOf(Word) + SizeOf(Word)
|
||||
else
|
||||
CodepageOffset := AddressSize * 3;
|
||||
Addr.Address := Addr.Address - CodepageOffset;
|
||||
if Context.ReadMemory(Addr, SizeVal(2), @Codepage) then
|
||||
Result := CodePageToCodePageName(Codepage) <> '';
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFpValueDwarfV3FreePascalString.CalcBounds;
|
||||
var
|
||||
t, t2: TFpSymbol;
|
||||
@ -2070,7 +2188,7 @@ begin
|
||||
if not MemManager.MemModel.IsReadableLocation(Addr) then
|
||||
exit;
|
||||
|
||||
assert((TypeInfo <> nil) and (TypeInfo.CompilationUnit <> nil) and (TypeInfo.CompilationUnit.DwarfSymbolClassMap is TFpDwarfFreePascalSymbolClassMapDwarf3), 'TFpValueDwarfV3FreePascalString.GetAsString: (Owner <> nil) and (Owner.CompilationUnit <> nil) and (TypeInfo.CompilationUnit.DwarfSymbolClassMap is TFpDwarfFreePascalSymbolClassMapDwarf3)');
|
||||
assert((TypeInfo <> nil) and (TypeInfo.CompilationUnit <> nil) and (TypeInfo.CompilationUnit.DwarfSymbolClassMap is TFpDwarfFreePascalSymbolClassMapDwarf3), 'TFpValueDwarfV3FreePascalString.CalcBounds: (Owner <> nil) and (Owner.CompilationUnit <> nil) and (TypeInfo.CompilationUnit.DwarfSymbolClassMap is TFpDwarfFreePascalSymbolClassMapDwarf3)');
|
||||
if (TFpDwarfFreePascalSymbolClassMapDwarf3(TypeInfo.CompilationUnit.DwarfSymbolClassMap).FCompilerVersion > 0) and
|
||||
(TFpDwarfFreePascalSymbolClassMapDwarf3(TypeInfo.CompilationUnit.DwarfSymbolClassMap).FCompilerVersion < $030100)
|
||||
then begin
|
||||
|
||||
@ -163,6 +163,9 @@ type
|
||||
//function ReadFloat (const ALocation: TFpDbgMemLocation; ASize: TFpDbgValueSize;
|
||||
// out AValue: Extended;
|
||||
// AnOpts: TFpDbgMemReadOptions): Boolean; inline;
|
||||
|
||||
function ReadString(const ALocation: TFpDbgMemLocation; ALen: Int64; out AValue: RawByteString; AnIgnoreMaxStringLen: boolean = False): Boolean;
|
||||
function ReadWString(const ALocation: TFpDbgMemLocation; ALen: Int64; out AValue: WideString; AnIgnoreMaxStringLen: boolean = False): Boolean;
|
||||
end;
|
||||
|
||||
|
||||
@ -1104,6 +1107,56 @@ begin
|
||||
Result := MemManager.ReadMemory(rdtfloat, ALocation, ASize, @AValue, (SizeOf(AValue)), Self);
|
||||
end;
|
||||
|
||||
function TFpDbgLocationContext.ReadString(const ALocation: TFpDbgMemLocation; ALen: Int64; out
|
||||
AValue: RawByteString; AnIgnoreMaxStringLen: boolean): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
AValue := '';
|
||||
|
||||
if (not AnIgnoreMaxStringLen) and
|
||||
(MemManager.MemLimits.MaxStringLen > 0) and
|
||||
(ALen > MemManager.MemLimits.MaxStringLen)
|
||||
then
|
||||
ALen := MemManager.MemLimits.MaxStringLen;
|
||||
|
||||
if ALen = 0 then begin
|
||||
Result := True;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if not MemManager.SetLength(AValue, ALen) then
|
||||
exit;
|
||||
|
||||
Result := ReadMemory(ALocation, SizeVal(Length(AValue)), @AValue[1]);
|
||||
if not Result then
|
||||
AValue := ''
|
||||
end;
|
||||
|
||||
function TFpDbgLocationContext.ReadWString(const ALocation: TFpDbgMemLocation; ALen: Int64; out
|
||||
AValue: WideString; AnIgnoreMaxStringLen: boolean): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
AValue := '';
|
||||
|
||||
if (not AnIgnoreMaxStringLen) and
|
||||
(MemManager.MemLimits.MaxStringLen > 0) and
|
||||
(ALen > MemManager.MemLimits.MaxStringLen)
|
||||
then
|
||||
ALen := MemManager.MemLimits.MaxStringLen;
|
||||
|
||||
if ALen = 0 then begin
|
||||
Result := True;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if not MemManager.SetLength(AValue, ALen) then
|
||||
exit;
|
||||
|
||||
Result := ReadMemory(ALocation, SizeVal(Length(AValue)*2), @AValue[1]);
|
||||
if not Result then
|
||||
AValue := ''
|
||||
end;
|
||||
|
||||
{ TFpDbgMemLimits }
|
||||
|
||||
procedure TFpDbgMemLimits.SetMaxMemReadSize(AValue: QWord);
|
||||
@ -2013,7 +2066,9 @@ function TFpDbgMemManager.SetLength(var ADest: RawByteString; ALength: Int64
|
||||
): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
if (FMemLimits.MaxMemReadSize > 0) and (ALength > FMemLimits.MaxMemReadSize) then begin
|
||||
if (ALength < 0) or
|
||||
( (FMemLimits.MaxMemReadSize > 0) and (ALength > FMemLimits.MaxMemReadSize) )
|
||||
then begin
|
||||
FLastError := CreateError(fpErrReadMemSizeLimit);
|
||||
exit;
|
||||
end;
|
||||
@ -2025,7 +2080,9 @@ function TFpDbgMemManager.SetLength(var ADest: AnsiString; ALength: Int64
|
||||
): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
if (FMemLimits.MaxMemReadSize > 0) and (ALength > FMemLimits.MaxMemReadSize) then begin
|
||||
if (ALength < 0) or
|
||||
( (FMemLimits.MaxMemReadSize > 0) and (ALength > FMemLimits.MaxMemReadSize) )
|
||||
then begin
|
||||
FLastError := CreateError(fpErrReadMemSizeLimit);
|
||||
exit;
|
||||
end;
|
||||
@ -2037,7 +2094,9 @@ function TFpDbgMemManager.SetLength(var ADest: WideString; ALength: Int64
|
||||
): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
if (FMemLimits.MaxMemReadSize > 0) and (ALength * 2 > FMemLimits.MaxMemReadSize) then begin
|
||||
if (ALength < 0) or
|
||||
( (FMemLimits.MaxMemReadSize > 0) and (ALength * 2 > FMemLimits.MaxMemReadSize) )
|
||||
then begin
|
||||
FLastError := CreateError(fpErrReadMemSizeLimit);
|
||||
exit;
|
||||
end;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user