paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2026-01-06 00:00:54 +01:00
Code Issues Packages Projects Releases Wiki Activity

FPDebug: pchar

Browse Source 
git-svn-id: trunk@44179 -
This commit is contained in:
martin 2014-02-20 01:12:25 +00:00
parent 730a24305c
commit 0660f0e9f4
3 changed files with 47 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
components/fpdebug/fpdbgdwarf.pas
View File

@ -711,6 +711,7 @@ type
function GetAsCardinal: QWord; override;
function GetFieldFlags: TDbgSymbolValueFieldFlags; override;
function GetDataAddress: TFpDbgMemLocation; override;
function GetAsString: AnsiString; override;
end;
{ TDbgDwarfEnumSymbolValue }
@ -2302,10 +2303,17 @@ begin
end;
function TDbgDwarfPointerSymbolValue.GetFieldFlags: TDbgSymbolValueFieldFlags;
var
t: TDbgSymbol;
begin
Result := inherited GetFieldFlags;
//TODO: svfDataAddress should depend on (hidden) Pointer or Ref in the TypeInfo
Result := Result + [svfCardinal, svfOrdinal, svfSizeOfPointer, svfDataAddress] - [svfSize]; // data address
t := TypeInfo;
if (t <> nil) then t := t.TypeInfo;
if (t <> nil) and (t.Kind = skChar) and IsReadableMem(DataAddress) then // pchar
Result := Result + [svfString]; // data address
end;
function TDbgDwarfPointerSymbolValue.GetDataAddress: TFpDbgMemLocation;
@ -2324,6 +2332,28 @@ begin
FPointetToAddr := Result;
end;
function TDbgDwarfPointerSymbolValue.GetAsString: AnsiString;
var
t: TDbgSymbol;
i: Integer;
begin
t := TypeInfo;
if (t <> nil) then t := t.TypeInfo;
if (MemManager <> nil) and (t <> nil) and (t.Kind = skChar) and IsReadableMem(DataAddress) then begin // pchar
SetLength(Result, 2000);
i := 2000;
while (i > 0) and (not MemManager.ReadMemory(DataAddress, 2000, @Result[1])) do
i := i div 2;
SetLength(Result,i);
i := pos(#0, Result);
if i > 0 then
SetLength(Result,i-1);
exit;
end;
Result := inherited GetAsString;
end;
{ TDbgDwarfIntegerSymbolValue }
function TDbgDwarfIntegerSymbolValue.GetFieldFlags: TDbgSymbolValueFieldFlags;

9
components/fpdebug/fpdmemorytools.pas
View File

@ -248,7 +248,8 @@ function ConstLoc(AValue: QWord): TFpDbgMemLocation; inline;
function IsTargetAddr(ALocation: TFpDbgMemLocation): Boolean; inline;
function IsValidLoc(ALocation: TFpDbgMemLocation): Boolean; inline; // Valid, Nil allowed
function IsReadableLoc(ALocation: TFpDbgMemLocation): Boolean; inline; // Valid and not Nil
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
@ -321,6 +322,12 @@ begin
);
end;
function IsReadableMem(ALocation: TFpDbgMemLocation): Boolean;
begin
Result := (ALocation.MType in [mlfTargetMem, mlfSelfMem]) and
(ALocation.Address <> 0);
end;
function IsTargetNil(ALocation: TFpDbgMemLocation): Boolean;
begin
Result := (ALocation.MType = mlfTargetMem) and (ALocation.Address = 0);

11
components/fpdebug/fppascalbuilder.pas
View File

@ -5,7 +5,7 @@ unit FpPascalBuilder;
interface
uses
Classes, SysUtils, DbgIntfBaseTypes, FpDbgInfo, LazLoggerBase;
Classes, SysUtils, DbgIntfBaseTypes, FpDbgInfo, FpdMemoryTools, LazLoggerBase;
type
TTypeNameFlag = (
@ -36,7 +36,8 @@ function GetTypeName(out ATypeName: String; ADbgSymbol: TDbgSymbol; AFlags: TTyp
function GetTypeAsDeclaration(out ATypeDeclaration: String; ADbgSymbol: TDbgSymbol;
AFlags: TTypeDeclarationFlags = []; AnIndent: Integer = 0): Boolean;
function PrintPasValue(out APrintedValue: String; AResValue: TDbgSymbolValue; AnAddrSize: Integer; AFlags: TPrintPasValFlags = []): Boolean;
function PrintPasValue(out APrintedValue: String; AResValue: TDbgSymbolValue;
AnAddrSize: Integer; AFlags: TPrintPasValFlags = []): Boolean;
implementation
@ -407,11 +408,17 @@ function PrintPasValue(out APrintedValue: String; AResValue: TDbgSymbolValue;
procedure DoPointer;
var
s: String;
t: TDbgSymbol;
i: Integer;
begin
s := ResTypeName;
APrintedValue := '$'+IntToHex(AResValue.AsCardinal, AnAddrSize);
if s <> '' then
APrintedValue := s + '(' + APrintedValue + ')';
if svfString in AResValue.FieldFlags then
APrintedValue := APrintedValue + ' ' + AResValue.AsString;
Result := True;
end;