mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-11 13:59:14 +02:00
FPDebug/GDBMI: memreader via gdb
git-svn-id: trunk@43567 -
This commit is contained in:
martin
parent
fc6bd246ea
commit
100ac0c220
@ -26,6 +26,21 @@ type
|
||||
constructor Create(ATextExpression: String; ADebugger: TFpGDBMIDebugger; AThreadId, AStackFrame: Integer);
|
||||
end;
|
||||
|
||||
{ TFpGDBMIDbgMemReader }
|
||||
|
||||
TFpGDBMIDbgMemReader = class(TFpDbgMemReaderBase)
|
||||
private
|
||||
// TODO
|
||||
//FThreadId: Integer;
|
||||
//FStackFrame: Integer;
|
||||
FDebugger: TFpGDBMIDebugger;
|
||||
public
|
||||
constructor Create(ADebugger: TFpGDBMIDebugger);
|
||||
function ReadMemory(AnAddress: FpDbgInfo.TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean; override;
|
||||
function ReadMemoryEx(AnAddress, AnAddressSpace: FpDbgInfo.TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean; override;
|
||||
function ReadRegister(ARegNum: Integer; out AValue: FpDbgInfo.TDbgPtr): Boolean; override;
|
||||
end;
|
||||
|
||||
{ TFpGDBPTypeRequestCache }
|
||||
|
||||
TFpGDBPTypeRequestCache = class(TGDBPTypeRequestCache)
|
||||
@ -48,6 +63,7 @@ type
|
||||
private
|
||||
FImageLoader: TDbgImageLoader;
|
||||
FDwarfInfo: TDbgDwarf;
|
||||
FMemReader: TFpGDBMIDbgMemReader;
|
||||
// cache last context
|
||||
FlastStackFrame, FLastThread: Integer;
|
||||
FLastContext: array [0..MAX_CTX_CACHE-1] of TDbgInfoAddressContext;
|
||||
@ -65,6 +81,7 @@ type
|
||||
function GetLocationForContext(AThreadId, AStackFrame: Integer): TDBGPtr;
|
||||
function GetInfoContextForContext(AThreadId, AStackFrame: Integer): TDbgInfoAddressContext;
|
||||
function CreateTypeRequestCache: TGDBPTypeRequestCache; override;
|
||||
property CurrentCommand;
|
||||
public
|
||||
class function Caption: String; override;
|
||||
public
|
||||
@ -116,6 +133,85 @@ type
|
||||
procedure Cancel(const ASource: String); override;
|
||||
end;
|
||||
|
||||
{ TFpGDBMIDbgMemReader }
|
||||
|
||||
constructor TFpGDBMIDbgMemReader.Create(ADebugger: TFpGDBMIDebugger);
|
||||
begin
|
||||
FDebugger := ADebugger;
|
||||
end;
|
||||
|
||||
type TGDBMIDebuggerCommandHack = class(TGDBMIDebuggerCommand) end;
|
||||
|
||||
function TFpGDBMIDbgMemReader.ReadMemory(AnAddress: FpDbgInfo.TDbgPtr; ASize: Cardinal;
|
||||
ADest: Pointer): Boolean;
|
||||
var
|
||||
cmd: TGDBMIDebuggerCommandHack;
|
||||
R: TGDBMIExecResult;
|
||||
MemDump: TGDBMIMemoryDumpResultList;
|
||||
i: Integer;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
cmd := TGDBMIDebuggerCommandHack(TFpGDBMIDebugger(FDebugger).CurrentCommand);
|
||||
if cmd = nil then exit;
|
||||
|
||||
if not cmd.ExecuteCommand('-data-read-memory %u x 1 1 %u', [AnAddress, ASize], R, [cfNoThreadContext, cfNoStackContext])
|
||||
then
|
||||
exit;
|
||||
if R.State = dsError then exit;
|
||||
|
||||
MemDump := TGDBMIMemoryDumpResultList.Create(R);
|
||||
|
||||
for i := 0 to MemDump.Count - 1 do begin
|
||||
PByte(ADest + i)^ := Byte(MemDump.ItemNum[i]);
|
||||
end;
|
||||
|
||||
debugln(['TFpGDBMIDbgMemReader.ReadMemory ', dbgs(AnAddress), ' ', dbgMemRange(ADest, ASize)]);
|
||||
end;
|
||||
|
||||
function TFpGDBMIDbgMemReader.ReadMemoryEx(AnAddress, AnAddressSpace: FpDbgInfo.TDbgPtr;
|
||||
ASize: Cardinal; ADest: Pointer): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function TFpGDBMIDbgMemReader.ReadRegister(ARegNum: Integer; out
|
||||
AValue: FpDbgInfo.TDbgPtr): Boolean;
|
||||
var
|
||||
rname: String;
|
||||
v: String;
|
||||
i: Integer;
|
||||
begin
|
||||
Result := False;
|
||||
// 32 bit gdb dwarf names
|
||||
case ARegNum of
|
||||
0: rname := 'EAX'; // RAX
|
||||
1: rname := 'ECX'; // RDX
|
||||
2: rname := 'EDX'; // RCX
|
||||
3: rname := 'EBX'; // RBX
|
||||
4: rname := 'ESP';
|
||||
5: rname := 'EBP';
|
||||
6: rname := 'ESI';
|
||||
7: rname := 'EDI';
|
||||
8: rname := 'EIP';
|
||||
else
|
||||
exit;
|
||||
end;
|
||||
for i := 0 to FDebugger.Registers.Count - 1 do
|
||||
if UpperCase(FDebugger.Registers.Names[i]) = rname then
|
||||
begin
|
||||
v := FDebugger.Registers.Values[i];
|
||||
debugln(['TFpGDBMIDbgMemReader.ReadRegister ',rname, ' ', v]);
|
||||
Result := true;
|
||||
try
|
||||
AValue := StrToQWord(v);
|
||||
except
|
||||
Result := False;
|
||||
end;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TFpGDBMIPascalExpression }
|
||||
|
||||
function TFpGDBMIPascalExpression.GetDbgTyeForIdentifier(AnIdent: String): TDbgSymbol;
|
||||
@ -607,8 +703,21 @@ DebugLn(['######## '+ARequest.Request, ' ## FOUND: ', dbgs(Result)]);
|
||||
if IdentName <> '' then begin
|
||||
PasExpr := TFpGDBMIPascalExpression.Create(IdentName, FDebugger, AThreadId, AStackFrame);
|
||||
if PasExpr.Valid then begin
|
||||
(*
|
||||
if (TFpPascalExpressionHack(PasExpr).ExpressionPart <> nil) and
|
||||
(TFpPascalExpressionHack(PasExpr).ExpressionPart is TFpPascalExpressionPartIdentifer)
|
||||
then begin
|
||||
PasExpr.ResultType;
|
||||
rt := TFpPascalExpressionPartIdentifer(TFpPascalExpressionHack(PasExpr).ExpressionPart).FDbgType;
|
||||
if (rt <> nil) then begin
|
||||
debugln(['@@@@@ ',rt.ClassName]);
|
||||
if (rt <> nil) and (rt is TDbgDwarfIdentifierVariable) then begin
|
||||
DebugLn(['########### ', rt.Address ]);
|
||||
end;end;
|
||||
end;
|
||||
*)
|
||||
rt := PasExpr.ResultType;
|
||||
if (rt = nil) and (TFpPascalExpressionHack(PasExpr).ExpressionPart <> nil) then
|
||||
if (rt = nil) and (TFpPascalExpressionHack(PasExpr).ExpressionPart <> nil) then
|
||||
rt := TFpPascalExpressionHack(PasExpr).ExpressionPart.ResultTypeCast;
|
||||
if rt <> nil then begin
|
||||
AddType(IdentName, rt);
|
||||
@ -763,8 +872,11 @@ begin
|
||||
if not FImageLoader.IsValid then begin
|
||||
FreeAndNil(FImageLoader);
|
||||
exit;
|
||||
end;;
|
||||
end;
|
||||
FMemReader := TFpGDBMIDbgMemReader.Create(Self);
|
||||
|
||||
FDwarfInfo := TDbgDwarf.Create(FImageLoader);
|
||||
FDwarfInfo.MemReader := FMemReader;
|
||||
FDwarfInfo.LoadCompilationUnits;
|
||||
end;
|
||||
|
||||
@ -773,6 +885,7 @@ begin
|
||||
debugln(['TFpGDBMIDebugger.UnLoadDwarf ']);
|
||||
FreeAndNil(FDwarfInfo);
|
||||
FreeAndNil(FImageLoader);
|
||||
FreeAndNil(FMemReader);
|
||||
end;
|
||||
|
||||
function TFpGDBMIDebugger.RequestCommand(const ACommand: TDBGCommand;
|
||||
|
||||
@ -817,6 +817,45 @@ type
|
||||
function NeedReset: Boolean; override;
|
||||
end;
|
||||
|
||||
{%region ***** TGDBMINameValueList and Parsers ***** }
|
||||
|
||||
{ TGDBMINameValueBasedList }
|
||||
|
||||
TGDBMINameValueBasedList = class
|
||||
protected
|
||||
FNameValueList: TGDBMINameValueList;
|
||||
procedure PreParse; virtual; abstract;
|
||||
public
|
||||
constructor Create;
|
||||
constructor Create(const AResultValues: String);
|
||||
constructor Create(AResult: TGDBMIExecResult);
|
||||
destructor Destroy; override;
|
||||
procedure Init(AResultValues: string);
|
||||
procedure Init(AResult: TGDBMIExecResult);
|
||||
end;
|
||||
|
||||
{ TGDBMIMemoryDumpResultList }
|
||||
|
||||
TGDBMIMemoryDumpResultList = class(TGDBMINameValueBasedList)
|
||||
private
|
||||
FAddr: TDBGPtr;
|
||||
function GetItem(Index: Integer): TPCharWithLen;
|
||||
function GetItemNum(Index: Integer): Integer;
|
||||
function GetItemTxt(Index: Integer): string;
|
||||
protected
|
||||
procedure PreParse; override;
|
||||
public
|
||||
// Expected input format: 1 row with hex values
|
||||
function Count: Integer;
|
||||
property Item[Index: Integer]: TPCharWithLen read GetItem;
|
||||
property ItemTxt[Index: Integer]: string read GetItemTxt;
|
||||
property ItemNum[Index: Integer]: Integer read GetItemNum;
|
||||
property Addr: TDBGPtr read FAddr;
|
||||
function AsText(AStartOffs, ACount: Integer; AAddrWidth: Integer): string;
|
||||
end;
|
||||
|
||||
{%endregion *^^^* TGDBMINameValueList and Parsers *^^^* }
|
||||
|
||||
|
||||
resourcestring
|
||||
gdbmiErrorOnRunCommand = 'The debugger encountered an error when trying to '
|
||||
@ -903,45 +942,6 @@ type
|
||||
type
|
||||
TGDBMIEvaluationState = (esInvalid, esRequested, esValid);
|
||||
|
||||
{%region ***** TGDBMINameValueList and Parsers ***** }
|
||||
|
||||
{ TGDBMINameValueBasedList }
|
||||
|
||||
TGDBMINameValueBasedList = class
|
||||
protected
|
||||
FNameValueList: TGDBMINameValueList;
|
||||
procedure PreParse; virtual; abstract;
|
||||
public
|
||||
constructor Create;
|
||||
constructor Create(const AResultValues: String);
|
||||
constructor Create(AResult: TGDBMIExecResult);
|
||||
destructor Destroy; override;
|
||||
procedure Init(AResultValues: string);
|
||||
procedure Init(AResult: TGDBMIExecResult);
|
||||
end;
|
||||
|
||||
{ TGDBMIMemoryDumpResultList }
|
||||
|
||||
TGDBMIMemoryDumpResultList = class(TGDBMINameValueBasedList)
|
||||
private
|
||||
FAddr: TDBGPtr;
|
||||
function GetItem(Index: Integer): TPCharWithLen;
|
||||
function GetItemNum(Index: Integer): Integer;
|
||||
function GetItemTxt(Index: Integer): string;
|
||||
protected
|
||||
procedure PreParse; override;
|
||||
public
|
||||
// Expected input format: 1 row with hex values
|
||||
function Count: Integer;
|
||||
property Item[Index: Integer]: TPCharWithLen read GetItem;
|
||||
property ItemTxt[Index: Integer]: string read GetItemTxt;
|
||||
property ItemNum[Index: Integer]: Integer read GetItemNum;
|
||||
property Addr: TDBGPtr read FAddr;
|
||||
function AsText(AStartOffs, ACount: Integer; AAddrWidth: Integer): string;
|
||||
end;
|
||||
|
||||
{%endregion *^^^* TGDBMINameValueList and Parsers *^^^* }
|
||||
|
||||
const
|
||||
// priorities for commands
|
||||
GDCMD_PRIOR_IMMEDIATE = 999; // run immediate (request without callback)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user