paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 11:59:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDebug: Improve target-mem read/write on Linux / Allow bigger writes

Browse Source 
git-svn-id: trunk@65225 -
This commit is contained in:
martin 2021-06-14 07:30:37 +00:00
parent 699930263c
commit 3deb9a41fe
1 changed files with 117 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

180
components/fpdebug/fpdbglinuxclasses.pas
View File

@ -293,6 +293,8 @@ type
{$ifndef VER2_6} {$ifndef VER2_6}
procedure OnForkEvent(Sender : TObject); procedure OnForkEvent(Sender : TObject);
{$endif} {$endif}
function ReadWordSize(Adr: TDbgPtr; out AVal: TDBGPtr): boolean; inline;
function WriteWordSize(Adr: TDbgPtr; AVal: TDBGPtr): boolean; inline;
protected protected
function GetRequiresExecutionInDebuggerThread: boolean; override; function GetRequiresExecutionInDebuggerThread: boolean; override;
procedure InitializeLoaders; override; procedure InitializeLoaders; override;
@ -913,73 +915,86 @@ begin
(ATargetInfo.machineType in [mt386, mtX86_64]); (ATargetInfo.machineType in [mt386, mtX86_64]);
end; end;
function TDbgLinuxProcess.ReadWordSize(Adr: TDbgPtr; out AVal: TDBGPtr
): boolean;
var
e: integer;
begin
AVal := TDbgPtr(fpPTrace(PTRACE_PEEKDATA, FCurrentThreadId, pointer(Adr), nil));
e := fpgeterrno;
Result := e = 0;
if not Result then
begin
DebugLn(DBG_WARNINGS, 'Failed to read data at address '+FormatAddress(Adr)+' from processid '+inttostr(FCurrentThreadId)+'. Errcode: '+inttostr(e));
result := false;
end;
end;
function TDbgLinuxProcess.WriteWordSize(Adr: TDbgPtr; AVal: TDBGPtr): boolean;
var
e: LongInt;
begin
fpPTrace(PTRACE_POKEDATA, FCurrentThreadId, pointer(Adr), pointer(AVal));
e := fpgeterrno;
Result := e = 0;
if not Result then
begin
DebugLn(DBG_WARNINGS, 'Failed to write data at address '+FormatAddress(Adr)+' from processid '+inttostr(FCurrentThreadId)+'. Errcode: '+inttostr(e));
result := false;
end;
end;
function TDbgLinuxProcess.ReadData(const AAdress: TDbgPtr; function TDbgLinuxProcess.ReadData(const AAdress: TDbgPtr;
const ASize: Cardinal; out AData): Boolean; const ASize: Cardinal; out AData): Boolean;
var var
WordSize: byte; WordSize, BytesDone: integer;
BufSize: int64;
function ReadWordSize(Adr: TDbgPtr; out AVal: TDBGPtr): boolean;
var
e: integer;
begin
errno := 0;
AVal := TDbgPtr(fpPTrace(PTRACE_PEEKDATA, FCurrentThreadId, pointer(Adr), nil));
e := fpgeterrno;
if e <> 0 then
begin
DebugLn(DBG_WARNINGS, 'Failed to read data at address '+FormatAddress(Adr)+' from processid '+inttostr(FCurrentThreadId)+'. Errcode: '+inttostr(e));
result := false;
end
else
result := true;
end;
var
AVal: TDbgPtr; AVal: TDbgPtr;
AAdressAlign: TDBGPtr;
BytesRead: integer;
ReadBytes: integer;
PB: PByte;
buf: pbyte; buf: pbyte;
AAdressAlign: TDBGPtr;
begin begin
BytesRead := 0;
result := false; result := false;
getmem(buf, ASize); fpseterrno(0);
try BytesDone := 0;
buf := @AData;
BufSize := ASize;
WordSize:=DBGPTRSIZE[Mode]; WordSize:=DBGPTRSIZE[Mode];
if AAdress mod WordSize <> 0 then
begin {$ifNdef LINUX_NO_PTRACE_ALIGN} // according to man, only peek/poke_user need align
AAdressAlign := ((PtrUInt(AAdress)) and not PtrUInt(WordSize - 1)); AAdressAlign := AAdress and (not TDBGPtr(WordSize - 1));
if AAdressAlign <> AAdress then begin
if not ReadWordSize(AAdressAlign, AVal) then if not ReadWordSize(AAdressAlign, AVal) then
Exit; Exit;
pb := @AVal; BytesDone := WordSize - (AAdress-AAdressAlign);
BytesRead:=WordSize-(AAdress-AAdressAlign); if BytesDone > ASize then
if BytesRead>=ASize then BytesDone := ASize;
BytesRead:=ASize; move(PByte(@AVal)[AAdress-AAdressAlign], buf[0], BytesDone);
move(pb[AAdress-AAdressAlign], buf[0], BytesRead);
inc(AAdressAlign, WordSize); inc(AAdressAlign, WordSize);
end end;
else {$else}
AAdressAlign := AAdress; AAdressAlign := AAdress;
{$endif}
while BytesRead<ASize do dec(BufSize, WordSize - 1); // full words only
begin
while BytesDone < BufSize do begin
if not ReadWordSize(AAdressAlign, AVal) then if not ReadWordSize(AAdressAlign, AVal) then
exit; Exit;
if WordSize<(ASize-BytesRead) then move(AVal, buf[BytesDone], WordSize);
ReadBytes:=WordSize inc(BytesDone, WordSize);
else
ReadBytes:=(ASize-BytesRead);
move(AVal, buf[BytesRead], ReadBytes);
inc(BytesRead, ReadBytes);
inc(AAdressAlign, WordSize); inc(AAdressAlign, WordSize);
end;
BufSize := ASize - BytesDone;
assert((BufSize>=0) and (BufSize<WordSize));
if BufSize > 0 then begin
if not ReadWordSize(AAdressAlign, AVal) then
Exit;
move(AVal, buf[BytesDone], BufSize);
end; end;
System.Move(buf^, AData, BytesRead);
finally
freemem(buf);
end;
MaskBreakpointsInReadData(AAdress, ASize, AData); MaskBreakpointsInReadData(AAdress, ASize, AData);
result := true; result := true;
end; end;
@ -987,38 +1002,55 @@ end;
function TDbgLinuxProcess.WriteData(const AAdress: TDbgPtr; function TDbgLinuxProcess.WriteData(const AAdress: TDbgPtr;
const ASize: Cardinal; const AData): Boolean; const ASize: Cardinal; const AData): Boolean;
var var
e: integer; WordSize, BytesDone: integer;
pi: TDBGPtr; BufSize: int64;
WordSize: integer; AVal: TDBGPtr;
buf: PByte;
AAdressAlign: TDBGPtr;
begin begin
result := false; result := false;
fpseterrno(0);
BytesDone := 0;
buf := @AData;
BufSize := ASize;
WordSize:=DBGPTRSIZE[Mode]; WordSize:=DBGPTRSIZE[Mode];
if ASize>WordSize then {$ifNdef LINUX_NO_PTRACE_ALIGN} // according to man, only peek/poke_user need align
DebugLn(DBG_WARNINGS, 'Can not write more then '+IntToStr(WordSize)+' bytes.') AAdressAlign := AAdress and (not TDBGPtr(WordSize - 1));
else if AAdressAlign <> AAdress then begin
begin if not ReadWordSize(AAdressAlign, AVal) then
if ASize<WordSize then Exit;
begin BytesDone := WordSize - (AAdress-AAdressAlign);
fpseterrno(0); if BytesDone > ASize then
pi := TDbgPtr(fpPTrace(PTRACE_PEEKDATA, FCurrentThreadId, pointer(AAdress), nil)); BytesDone := ASize;
e := fpgeterrno; move(buf[0], PByte(@AVal)[AAdress-AAdressAlign], BytesDone);
if e <> 0 then if not WriteWordSize(AAdressAlign, AVal) then
begin Exit;
DebugLn(DBG_WARNINGS, 'Failed to read data. Errcode: '+inttostr(e)); inc(AAdressAlign, WordSize);
result := false;
exit;
end; end;
end; {$else}
move(AData, pi, ASize); AAdressAlign := AAdress;
{$endif}
fpPTrace(PTRACE_POKEDATA, FCurrentThreadId, pointer(AAdress), pointer(pi)); dec(BufSize, WordSize - 1); // full words only
e := fpgeterrno;
if e <> 0 then while BytesDone < BufSize do begin
begin move(buf[BytesDone], AVal, WordSize);
DebugLn(DBG_WARNINGS, 'Failed to write data. Errcode: '+inttostr(e)); if not WriteWordSize(AAdressAlign, AVal) then
result := false; Exit;
inc(BytesDone, WordSize);
inc(AAdressAlign, WordSize);
end; end;
BufSize := ASize - BytesDone;
assert((BufSize>=0) and (BufSize<WordSize));
if BufSize > 0 then begin
if not ReadWordSize(AAdressAlign, AVal) then
Exit;
move(buf[BytesDone], AVal, BufSize);
if not WriteWordSize(AAdressAlign, AVal) then
Exit;
end; end;
result := true; result := true;