mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-11 16:56:01 +02:00
FpDebug (pure): Added Linux-support
git-svn-id: trunk@45732 -
This commit is contained in:
joost
parent
eb3d246fd5
commit
5f0402b4c2
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -1282,6 +1282,8 @@ components/fpdebug/fpdbgdwarfdataclasses.pas svneol=native#text/pascal
|
||||
components/fpdebug/fpdbgdwarffreepascal.pas svneol=native#text/pascal
|
||||
components/fpdebug/fpdbgdwarfverboseprinter.pas svneol=native#text/pascal
|
||||
components/fpdebug/fpdbginfo.pas svneol=native#text/pascal
|
||||
components/fpdebug/fpdbglinuxclasses.pas svneol=native#text/plain
|
||||
components/fpdebug/fpdbglinuxextra.pas svneol=native#text/plain
|
||||
components/fpdebug/fpdbgloader.pp svneol=native#text/pascal
|
||||
components/fpdebug/fpdbgpetypes.pp svneol=native#text/pascal
|
||||
components/fpdebug/fpdbgsymbols.pas svneol=native#text/pascal
|
||||
|
||||
@ -352,6 +352,10 @@ uses
|
||||
uses
|
||||
FpDbgDarwinClasses;
|
||||
{$endif}
|
||||
{$ifdef linux}
|
||||
uses
|
||||
FpDbgLinuxClasses;
|
||||
{$endif}
|
||||
|
||||
var
|
||||
GOSDbgClasses : TOSDbgClasses;
|
||||
@ -370,6 +374,9 @@ begin
|
||||
{$ifdef darwin}
|
||||
RegisterDbgClasses;
|
||||
{$endif darwin}
|
||||
{$ifdef linux}
|
||||
RegisterDbgClasses;
|
||||
{$endif linux}
|
||||
end;
|
||||
result := GOSDbgClasses;
|
||||
end;
|
||||
|
||||
563
components/fpdebug/fpdbglinuxclasses.pas
Normal file
563
components/fpdebug/fpdbglinuxclasses.pas
Normal file
@ -0,0 +1,563 @@
|
||||
unit FpDbgLinuxClasses;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes,
|
||||
SysUtils,
|
||||
BaseUnix,
|
||||
process,
|
||||
FpDbgClasses,
|
||||
FpDbgLoader,
|
||||
DbgIntfBaseTypes,
|
||||
FpDbgLinuxExtra,
|
||||
FpDbgInfo,
|
||||
FpDbgUtil,
|
||||
LazLoggerBase;
|
||||
|
||||
type
|
||||
user_regs_struct64 = record
|
||||
r15: cuint64;
|
||||
r14: cuint64;
|
||||
r13: cuint64;
|
||||
r12: cuint64;
|
||||
rbp: cuint64;
|
||||
rbx: cuint64;
|
||||
r11: cuint64;
|
||||
r10: cuint64;
|
||||
r9 : cuint64;
|
||||
r8 : cuint64;
|
||||
rax: cuint64;
|
||||
rcx: cuint64;
|
||||
rdx: cuint64;
|
||||
rsi: cuint64;
|
||||
rdi: cuint64;
|
||||
orig_rax: cuint64;
|
||||
rip: cuint64;
|
||||
cs : cuint64;
|
||||
eflags: cuint64;
|
||||
rsp: cuint64;
|
||||
ss : cuint64;
|
||||
fs_base: cuint64;
|
||||
gs_base: cuint64;
|
||||
ds : cuint64;
|
||||
es : cuint64;
|
||||
fs : cuint64;
|
||||
gs : cuint64;
|
||||
end;
|
||||
|
||||
user_regs_struct32 = record
|
||||
ebx: cuint32;
|
||||
ecx: cuint32;
|
||||
edx: cuint32;
|
||||
esi: cuint32;
|
||||
edi: cuint32;
|
||||
ebp: cuint32;
|
||||
eax: cuint32;
|
||||
xds: cuint32;
|
||||
xes: cuint32;
|
||||
xfs: cuint32;
|
||||
xgs: cuint32;
|
||||
orig_eax: cuint32;
|
||||
eip: cuint32;
|
||||
xcs: cuint32;
|
||||
eflags: cuint32;
|
||||
esp: cuint32;
|
||||
xss: cuint32;
|
||||
end;
|
||||
|
||||
type
|
||||
|
||||
{ TDbgLinuxThread }
|
||||
|
||||
TDbgLinuxThread = class(TDbgThread)
|
||||
private
|
||||
FUserRegsStruct32: user_regs_struct32;
|
||||
FUserRegsStruct64: user_regs_struct64;
|
||||
FUserRegsChanged: boolean;
|
||||
protected
|
||||
function ReadThreadState: boolean;
|
||||
public
|
||||
function ResetInstructionPointerAfterBreakpoint: boolean; override;
|
||||
procedure BeforeContinue; override;
|
||||
procedure LoadRegisterValues; override;
|
||||
end;
|
||||
|
||||
{ TDbgLinuxProcess }
|
||||
|
||||
TDbgLinuxProcess = class(TDbgProcess)
|
||||
private
|
||||
FStatus: cint;
|
||||
FProcessStarted: boolean;
|
||||
FProcProcess: TProcess;
|
||||
FIsTerminating: boolean;
|
||||
FExceptionSignal: PtrUInt;
|
||||
procedure OnForkEvent(Sender : TObject);
|
||||
protected
|
||||
function InitializeLoader: TDbgImageLoader; override;
|
||||
function CreateThread(AthreadIdentifier: THandle; out IsMainThread: boolean): TDbgThread; override;
|
||||
function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; override;
|
||||
public
|
||||
class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory: string; AOnLog: TOnLog): TDbgProcess; override;
|
||||
constructor Create(const AName: string; const AProcessID, AThreadID: Integer; AOnLog: TOnLog); override;
|
||||
destructor Destroy; override;
|
||||
|
||||
function ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData): Boolean; override;
|
||||
function WriteData(const AAdress: TDbgPtr; const ASize: Cardinal; const AData): Boolean; override;
|
||||
|
||||
function GetInstructionPointerRegisterValue: TDbgPtr; override;
|
||||
function GetStackPointerRegisterValue: TDbgPtr; override;
|
||||
function GetStackBasePointerRegisterValue: TDbgPtr; override;
|
||||
procedure TerminateProcess; override;
|
||||
|
||||
function Continue(AProcess: TDbgProcess; AThread: TDbgThread; SingleStep: boolean): boolean; override;
|
||||
function WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean; override;
|
||||
end;
|
||||
|
||||
procedure RegisterDbgClasses;
|
||||
|
||||
implementation
|
||||
|
||||
procedure RegisterDbgClasses;
|
||||
begin
|
||||
OSDbgClasses.DbgProcessClass:=TDbgLinuxProcess;
|
||||
OSDbgClasses.DbgThreadClass:=TDbgLinuxThread;
|
||||
end;
|
||||
|
||||
Function WIFSTOPPED(Status: Integer): Boolean;
|
||||
begin
|
||||
WIFSTOPPED:=((Status and $FF)=$7F);
|
||||
end;
|
||||
|
||||
{ TDbgLinuxThread }
|
||||
|
||||
procedure TDbgLinuxProcess.OnForkEvent(Sender: TObject);
|
||||
var
|
||||
e: integer;
|
||||
begin
|
||||
fpPTrace(PTRACE_TRACEME, 0, nil, nil);
|
||||
e := fpgeterrno;
|
||||
if e <> 0 then
|
||||
begin
|
||||
writeln('Failed to start trace of process. Errcode: '+inttostr(e));
|
||||
end
|
||||
end;
|
||||
|
||||
function TDbgLinuxThread.ReadThreadState: boolean;
|
||||
var
|
||||
e: integer;
|
||||
begin
|
||||
result := true;
|
||||
errno:=0;
|
||||
fpPTrace(PTRACE_GETREGS, Process.ProcessID, nil, @FUserRegsStruct64);
|
||||
e := fpgeterrno;
|
||||
if e <> 0 then
|
||||
begin
|
||||
log('Failed to read thread registers from processid '+inttostr(Process.ProcessID)+'. Errcode: '+inttostr(e));
|
||||
result := false;
|
||||
end;
|
||||
FRegisterValueListValid:=false;
|
||||
end;
|
||||
|
||||
function TDbgLinuxThread.ResetInstructionPointerAfterBreakpoint: boolean;
|
||||
begin
|
||||
result := true;
|
||||
|
||||
if Process.Mode=dm32 then
|
||||
Dec(FUserRegsStruct32.eip)
|
||||
else
|
||||
Dec(FUserRegsStruct64.rip);
|
||||
FUserRegsChanged:=true;
|
||||
end;
|
||||
|
||||
procedure TDbgLinuxThread.BeforeContinue;
|
||||
var
|
||||
e: integer;
|
||||
begin
|
||||
if FUserRegsChanged then
|
||||
begin
|
||||
fpPTrace(PTRACE_SETREGS, Process.ProcessID, nil, @FUserRegsStruct64);
|
||||
e := fpgeterrno;
|
||||
if e <> 0 then
|
||||
begin
|
||||
log('Failed to set thread registers. Errcode: '+inttostr(e));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDbgLinuxThread.LoadRegisterValues;
|
||||
begin
|
||||
if Process.Mode=dm32 then with FUserRegsStruct32 do
|
||||
begin
|
||||
FRegisterValueList.DbgRegisterAutoCreate['eax'].SetValue(eax, IntToStr(eax),4,0);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['ecx'].SetValue(ecx, IntToStr(ecx),4,1);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['edx'].SetValue(edx, IntToStr(edx),4,2);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['ebx'].SetValue(ebx, IntToStr(ebx),4,3);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['esp'].SetValue(esp, IntToStr(esp),4,4);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['ebp'].SetValue(ebp, IntToStr(ebp),4,5);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['esi'].SetValue(esi, IntToStr(esi),4,6);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['edi'].SetValue(edi, IntToStr(edi),4,7);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['eip'].SetValue(eip, IntToStr(eip),4,8);
|
||||
|
||||
FRegisterValueList.DbgRegisterAutoCreate['eflags'].Setx86EFlagsValue(eflags);
|
||||
|
||||
FRegisterValueList.DbgRegisterAutoCreate['cs'].SetValue(xcs, IntToStr(xcs),4,0);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['ss'].SetValue(xss, IntToStr(xss),4,0);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['ds'].SetValue(xds, IntToStr(xds),4,0);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['es'].SetValue(xes, IntToStr(xes),4,0);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['fs'].SetValue(xfs, IntToStr(xfs),4,0);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['gs'].SetValue(xgs, IntToStr(xgs),4,0);
|
||||
end else with FUserRegsStruct64 do
|
||||
begin
|
||||
FRegisterValueList.DbgRegisterAutoCreate['rax'].SetValue(rax, IntToStr(rax),8,0);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['rbx'].SetValue(rbx, IntToStr(rbx),8,3);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['rcx'].SetValue(rcx, IntToStr(rcx),8,2);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['rdx'].SetValue(rdx, IntToStr(rdx),8,1);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['rsi'].SetValue(rsi, IntToStr(rsi),8,4);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['rdi'].SetValue(rdi, IntToStr(rdi),8,5);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['rbp'].SetValue(rbp, IntToStr(rbp),8,6);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['rsp'].SetValue(rsp, IntToStr(rsp),8,7);
|
||||
|
||||
FRegisterValueList.DbgRegisterAutoCreate['r8'].SetValue(r8, IntToStr(r8),8,8);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['r9'].SetValue(r9, IntToStr(r9),8,9);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['r10'].SetValue(r10, IntToStr(r10),8,10);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['r11'].SetValue(r11, IntToStr(r11),8,11);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['r12'].SetValue(r12, IntToStr(r12),8,12);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['r13'].SetValue(r13, IntToStr(r13),8,13);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['r14'].SetValue(r14, IntToStr(r14),8,14);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['r15'].SetValue(r15, IntToStr(r15),8,15);
|
||||
|
||||
FRegisterValueList.DbgRegisterAutoCreate['rip'].SetValue(rip, IntToStr(rip),8,16);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['eflags'].Setx86EFlagsValue(eflags);
|
||||
|
||||
FRegisterValueList.DbgRegisterAutoCreate['cs'].SetValue(cs, IntToStr(cs),8,43);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['fs'].SetValue(fs, IntToStr(fs),8,46);
|
||||
FRegisterValueList.DbgRegisterAutoCreate['gs'].SetValue(gs, IntToStr(gs),8,47);
|
||||
end;
|
||||
FRegisterValueListValid:=true;
|
||||
FUserRegsChanged:=false;
|
||||
end;
|
||||
|
||||
{ TDbgLinuxProcess }
|
||||
|
||||
function TDbgLinuxProcess.InitializeLoader: TDbgImageLoader;
|
||||
begin
|
||||
result := TDbgImageLoader.Create(Name);
|
||||
end;
|
||||
|
||||
function TDbgLinuxProcess.CreateThread(AthreadIdentifier: THandle; out IsMainThread: boolean): TDbgThread;
|
||||
begin
|
||||
IsMainThread:=true;
|
||||
if AthreadIdentifier>-1 then
|
||||
result := TDbgLinuxThread.Create(Self, AthreadIdentifier, AthreadIdentifier)
|
||||
else
|
||||
result := nil;
|
||||
end;
|
||||
|
||||
constructor TDbgLinuxProcess.Create(const AName: string; const AProcessID,
|
||||
AThreadID: Integer; AOnLog: TOnLog);
|
||||
begin
|
||||
inherited Create(AName, AProcessID, AThreadID, AOnLog);
|
||||
|
||||
LoadInfo;
|
||||
|
||||
if DbgInfo.HasInfo
|
||||
then FSymInstances.Add(Self);
|
||||
end;
|
||||
|
||||
destructor TDbgLinuxProcess.Destroy;
|
||||
begin
|
||||
FProcProcess.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
class function TDbgLinuxProcess.StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory: string; AOnLog: TOnLog): TDbgProcess;
|
||||
var
|
||||
PID: TPid;
|
||||
AProcess: TProcess;
|
||||
AnExecutabeFilename: string;
|
||||
begin
|
||||
result := nil;
|
||||
|
||||
AnExecutabeFilename:=ExcludeTrailingPathDelimiter(AFileName);
|
||||
if DirectoryExists(AnExecutabeFilename) then
|
||||
begin
|
||||
DebugLn(format('Can not debug %s, because it''s a directory',[AnExecutabeFilename]));
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if not FileExists(AFileName) then
|
||||
begin
|
||||
DebugLn(format('Can not find %s.',[AnExecutabeFilename]));
|
||||
Exit;
|
||||
end;
|
||||
|
||||
AProcess := TProcess.Create(nil);
|
||||
try
|
||||
AProcess.OnForkEvent:=@OnForkEvent;
|
||||
AProcess.Executable:=AnExecutabeFilename;
|
||||
AProcess.Parameters:=AParams;
|
||||
AProcess.Environment:=AnEnvironment;
|
||||
AProcess.CurrentDirectory:=AWorkingDirectory;
|
||||
AProcess.Execute;
|
||||
PID:=AProcess.ProcessID;
|
||||
|
||||
sleep(100);
|
||||
result := TDbgLinuxProcess.Create(AFileName, Pid, -1, AOnLog);
|
||||
except
|
||||
AProcess.Free;
|
||||
raise;
|
||||
end;
|
||||
|
||||
TDbgLinuxProcess(result).FProcProcess := AProcess;
|
||||
end;
|
||||
|
||||
function TDbgLinuxProcess.ReadData(const AAdress: TDbgPtr;
|
||||
const ASize: Cardinal; out AData): Boolean;
|
||||
|
||||
var
|
||||
WordSize: byte;
|
||||
|
||||
function ReadWordSize(Adr: TDbgPtr; out AVal: TDBGPtr): boolean;
|
||||
var
|
||||
e: integer;
|
||||
begin
|
||||
errno := 0;
|
||||
AVal := TDbgPtr(fpPTrace(PTRACE_PEEKDATA, Process.ProcessID, pointer(Adr), nil));
|
||||
e := fpgeterrno;
|
||||
if e <> 0 then
|
||||
begin
|
||||
log('Failed to read data at address '+FormatAddress(Adr)+' from processid '+inttostr(Process.ProcessID)+'. Errcode: '+inttostr(e));
|
||||
result := false;
|
||||
end
|
||||
else
|
||||
result := true;
|
||||
end;
|
||||
|
||||
var
|
||||
AVal: TDbgPtr;
|
||||
AAdressAlign: TDBGPtr;
|
||||
BytesRead: integer;
|
||||
ReadBytes: integer;
|
||||
PB: PByte;
|
||||
buf: pbyte;
|
||||
begin
|
||||
BytesRead := 0;
|
||||
result := false;
|
||||
getmem(buf, ASize);
|
||||
try
|
||||
WordSize:=DBGPTRSIZE[Mode];
|
||||
if AAdress mod WordSize <> 0 then
|
||||
begin
|
||||
AAdressAlign := ((PtrUInt(AAdress)) and not PtrUInt(WordSize - 1));
|
||||
if not ReadWordSize(AAdressAlign, AVal) then
|
||||
Exit;
|
||||
pb := @AVal;
|
||||
BytesRead:=WordSize-(AAdress-AAdressAlign);
|
||||
if BytesRead>=ASize then
|
||||
BytesRead:=ASize;
|
||||
move(pb[AAdress-AAdressAlign], buf[0], BytesRead);
|
||||
inc(AAdressAlign, WordSize);
|
||||
end
|
||||
else
|
||||
AAdressAlign:=AAdress;
|
||||
|
||||
while BytesRead<ASize do
|
||||
begin
|
||||
if not ReadWordSize(AAdressAlign, AVal) then
|
||||
exit;
|
||||
if WordSize<(ASize-BytesRead) then
|
||||
ReadBytes:=WordSize
|
||||
else
|
||||
ReadBytes:=(ASize-BytesRead);
|
||||
move(AVal, buf[BytesRead], ReadBytes);
|
||||
inc(BytesRead, ReadBytes);
|
||||
inc(AAdressAlign, WordSize);
|
||||
|
||||
end;
|
||||
System.Move(buf^, AData, BytesRead);
|
||||
finally
|
||||
freemem(buf);
|
||||
end;
|
||||
MaskBreakpointsInReadData(AAdress, ASize, AData);
|
||||
result := true;
|
||||
end;
|
||||
|
||||
function TDbgLinuxProcess.WriteData(const AAdress: TDbgPtr;
|
||||
const ASize: Cardinal; const AData): Boolean;
|
||||
var
|
||||
e: integer;
|
||||
pi: TDBGPtr;
|
||||
WordSize: integer;
|
||||
begin
|
||||
result := false;
|
||||
WordSize:=DBGPTRSIZE[Mode];
|
||||
|
||||
if ASize>WordSize then
|
||||
log('Can not write more then '+IntToStr(WordSize)+' bytes.')
|
||||
else
|
||||
begin
|
||||
if ASize<WordSize then
|
||||
begin
|
||||
fpseterrno(0);
|
||||
pi := TDbgPtr(fpPTrace(PTRACE_PEEKDATA, Process.ProcessID, pointer(AAdress), nil));
|
||||
e := fpgeterrno;
|
||||
if e <> 0 then
|
||||
begin
|
||||
log('Failed to read data. Errcode: '+inttostr(e));
|
||||
result := false;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
move(AData, pi, ASize);
|
||||
|
||||
fpPTrace(PTRACE_POKEDATA, Process.ProcessID, pointer(AAdress), pointer(pi));
|
||||
e := fpgeterrno;
|
||||
if e <> 0 then
|
||||
begin
|
||||
log('Failed to write data. Errcode: '+inttostr(e));
|
||||
result := false;
|
||||
end;
|
||||
end;
|
||||
|
||||
result := true;
|
||||
end;
|
||||
|
||||
function TDbgLinuxProcess.GetInstructionPointerRegisterValue: TDbgPtr;
|
||||
begin
|
||||
if Mode=dm32 then
|
||||
result := TDbgLinuxThread(FMainThread).FUserRegsStruct32.eip
|
||||
else
|
||||
result := TDbgLinuxThread(FMainThread).FUserRegsStruct64.rip;
|
||||
end;
|
||||
|
||||
function TDbgLinuxProcess.GetStackPointerRegisterValue: TDbgPtr;
|
||||
begin
|
||||
if Mode=dm32 then
|
||||
result := TDbgLinuxThread(FMainThread).FUserRegsStruct32.esp
|
||||
else
|
||||
result := TDbgLinuxThread(FMainThread).FUserRegsStruct64.rsp;
|
||||
end;
|
||||
|
||||
function TDbgLinuxProcess.GetStackBasePointerRegisterValue: TDbgPtr;
|
||||
begin
|
||||
if Mode=dm32 then
|
||||
result := TDbgLinuxThread(FMainThread).FUserRegsStruct32.ebp
|
||||
else
|
||||
result := TDbgLinuxThread(FMainThread).FUserRegsStruct64.rbp;
|
||||
end;
|
||||
|
||||
procedure TDbgLinuxProcess.TerminateProcess;
|
||||
begin
|
||||
FIsTerminating:=true;
|
||||
if fpkill(ProcessID,SIGKILL)<>0 then
|
||||
begin
|
||||
log('Failed to send SIGKILL to process %d. Errno: %d',[ProcessID, errno]);
|
||||
FIsTerminating:=false;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDbgLinuxProcess.Continue(AProcess: TDbgProcess; AThread: TDbgThread; SingleStep: boolean): boolean;
|
||||
var
|
||||
e: integer;
|
||||
begin
|
||||
fpseterrno(0);
|
||||
AThread.NextIsSingleStep:=SingleStep;
|
||||
AThread.BeforeContinue;
|
||||
if SingleStep or assigned(FCurrentBreakpoint) then
|
||||
fpPTrace(PTRACE_SINGLESTEP, ProcessID, pointer(1), pointer(FExceptionSignal))
|
||||
else if FIsTerminating then
|
||||
fpPTrace(PTRACE_KILL, ProcessID, pointer(1), nil)
|
||||
else
|
||||
fpPTrace(PTRACE_CONT, ProcessID, pointer(1), pointer(FExceptionSignal));
|
||||
e := fpgeterrno;
|
||||
if e <> 0 then
|
||||
begin
|
||||
log('Failed to continue process. Errcode: '+inttostr(e));
|
||||
result := false;
|
||||
end
|
||||
else
|
||||
result := true;
|
||||
end;
|
||||
|
||||
function TDbgLinuxProcess.WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean;
|
||||
begin
|
||||
ThreadIdentifier:=1;
|
||||
|
||||
ProcessIdentifier:=FpWaitPid(-1, FStatus, 0);
|
||||
|
||||
result := ProcessIdentifier<>-1;
|
||||
if not result then
|
||||
Log('Failed to wait for debug event. Errcode: %d', [fpgeterrno]);
|
||||
end;
|
||||
|
||||
function TDbgLinuxProcess.AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent;
|
||||
|
||||
begin
|
||||
FExceptionSignal:=0;
|
||||
if wifexited(FStatus) or wifsignaled(FStatus) then
|
||||
begin
|
||||
SetExitCode(wexitStatus(FStatus));
|
||||
|
||||
result := deExitProcess
|
||||
end
|
||||
else if WIFSTOPPED(FStatus) then
|
||||
begin
|
||||
//log('Stopped ',FStatus, ' signal: ',wstopsig(FStatus));
|
||||
TDbgLinuxThread(AThread).ReadThreadState;
|
||||
case wstopsig(FStatus) of
|
||||
SIGTRAP:
|
||||
begin if not FProcessStarted then
|
||||
begin
|
||||
result := deCreateProcess;
|
||||
FProcessStarted:=true;
|
||||
end
|
||||
else
|
||||
result := deBreakpoint;
|
||||
end;
|
||||
SIGBUS:
|
||||
begin
|
||||
ExceptionClass:='SIGBUS';
|
||||
FExceptionSignal:=SIGBUS;
|
||||
result := deException;
|
||||
end;
|
||||
SIGINT:
|
||||
begin
|
||||
ExceptionClass:='SIGINT';
|
||||
FExceptionSignal:=SIGINT;
|
||||
result := deException;
|
||||
end;
|
||||
SIGSEGV:
|
||||
begin
|
||||
ExceptionClass:='SIGSEGV';
|
||||
FExceptionSignal:=SIGSEGV;
|
||||
result := deException;
|
||||
end;
|
||||
SIGKILL:
|
||||
begin
|
||||
if FIsTerminating then
|
||||
result := deInternalContinue
|
||||
else
|
||||
begin
|
||||
ExceptionClass:='SIGKILL';
|
||||
FExceptionSignal:=SIGKILL;
|
||||
result := deException;
|
||||
end;
|
||||
end;
|
||||
else
|
||||
begin
|
||||
ExceptionClass:='Unknown exception code '+inttostr(wstopsig(FStatus));
|
||||
FExceptionSignal:=wstopsig(FStatus);
|
||||
result := deException;
|
||||
end;
|
||||
end; {case}
|
||||
if result=deException then
|
||||
ExceptionClass:='External: '+ExceptionClass;
|
||||
end
|
||||
else
|
||||
raise exception.CreateFmt('Received unknown status %d from process with pid=%d',[FStatus, ProcessID]);
|
||||
end;
|
||||
|
||||
end.
|
||||
67
components/fpdebug/fpdbglinuxextra.pas
Normal file
67
components/fpdebug/fpdbglinuxextra.pas
Normal file
@ -0,0 +1,67 @@
|
||||
unit FpDbgLinuxExtra;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes,
|
||||
BaseUnix,
|
||||
SysUtils;
|
||||
|
||||
const
|
||||
PTRACE_TRACEME = 0;
|
||||
PTRACE_PEEKTEXT = 1;
|
||||
PTRACE_PEEKDATA = 2;
|
||||
PTRACE_PEEKUSR = 3;
|
||||
PTRACE_POKETEXT = 4;
|
||||
PTRACE_POKEDATA = 5;
|
||||
PTRACE_POKEUSR = 6;
|
||||
PTRACE_CONT = 7;
|
||||
PTRACE_KILL = 8;
|
||||
PTRACE_SINGLESTEP = 9;
|
||||
PTRACE_GETREGS = 12;
|
||||
PTRACE_SETREGS = 13;
|
||||
PTRACE_GETFPREGS = 14;
|
||||
PTRACE_SETFPREGS = 15;
|
||||
PTRACE_ATTACH = 16;
|
||||
|
||||
RIP = 16;
|
||||
|
||||
function fpPTrace(ptrace_request: cint; pid: TPid; addr: Pointer; data: pointer): PtrInt;
|
||||
|
||||
implementation
|
||||
|
||||
type
|
||||
TSysResult = int64; // all platforms, cint=32-bit.
|
||||
// On platforms with off_t =64-bit, people should
|
||||
// use int64, and typecast all calls that don't
|
||||
// return off_t to cint.
|
||||
TSysParam = int64;
|
||||
|
||||
const
|
||||
syscall_nr_ptrace = 101;
|
||||
|
||||
function Do_SysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; external name 'FPC_SYSCALL4';
|
||||
|
||||
|
||||
function fpPTrace(ptrace_request: cint; pid: TPid; addr: Pointer; data: pointer): PtrInt;
|
||||
var
|
||||
res : TSysResult;
|
||||
ret : PtrInt;
|
||||
begin
|
||||
if (ptrace_request > 0) and (ptrace_request < 4) then
|
||||
data := @ret;
|
||||
|
||||
res := do_syscall(TSysParam(syscall_nr_ptrace), TSysParam(ptrace_request), TSysParam(pid), TSysParam(addr), TSysParam(data));
|
||||
if (res >= 0) and (ptrace_request > 0) and (ptrace_request < 4) then
|
||||
begin
|
||||
errno:=0;
|
||||
result := ret;
|
||||
end
|
||||
else
|
||||
result := res;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -11,12 +11,6 @@
|
||||
<OtherUnitFiles Value="."/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<MsgFileName Value=""/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Description Value="A set of helperclasses for implementing a debugger.
|
||||
|
||||
@ -34,7 +28,7 @@ File(s) with other licenses (see also header in file(s):
|
||||
|
||||
(Any modifications/translations of this file are from duby)
|
||||
"/>
|
||||
<Files Count="29">
|
||||
<Files Count="31">
|
||||
<Item1>
|
||||
<Filename Value="fpdbgclasses.pp"/>
|
||||
<UnitName Value="FpDbgClasses"/>
|
||||
@ -154,6 +148,14 @@ File(s) with other licenses (see also header in file(s):
|
||||
<Filename Value="fpdbgsymtable.pas"/>
|
||||
<UnitName Value="fpDbgSymTable"/>
|
||||
</Item29>
|
||||
<Item30>
|
||||
<Filename Value="fpdbglinuxclasses.pas"/>
|
||||
<UnitName Value="FpDbgLinuxClasses"/>
|
||||
</Item30>
|
||||
<Item31>
|
||||
<Filename Value="fpdbglinuxextra.pas"/>
|
||||
<UnitName Value="FpDbgLinuxExtra"/>
|
||||
</Item31>
|
||||
</Files>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<RequiredPkgs Count="3">
|
||||
|
||||
@ -13,7 +13,7 @@ uses
|
||||
FpImgReaderMachoFile, FpImgReaderMacho, FpPascalBuilder, FpDbgInfo,
|
||||
FpdMemoryTools, FpErrorMessages, FPDbgController, FpDbgDwarfVerbosePrinter,
|
||||
FpDbgDwarfDataClasses, FpDbgDwarfFreePascal, fpDbgSymTableContext,
|
||||
fpDbgSymTable, LazarusPackageIntf;
|
||||
fpDbgSymTable, FpDbgLinuxClasses, FpDbgLinuxExtra, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
@ -47,6 +47,8 @@ type
|
||||
{ TElfFile }
|
||||
|
||||
TElfFile = class(TObject)
|
||||
private
|
||||
FIs64Bit: boolean;
|
||||
protected
|
||||
function Load32BitFile(ALoader: TDbgFileLoader): Boolean;
|
||||
function Load64BitFile(ALoader: TDbgFileLoader): Boolean;
|
||||
@ -56,6 +58,7 @@ type
|
||||
seccount : Integer;
|
||||
function LoadFromFile(ALoader: TDbgFileLoader): Boolean;
|
||||
function FindSection(const Name: String): Integer;
|
||||
property Is64Bit: boolean read FIs64Bit;
|
||||
end;
|
||||
|
||||
{ TElfDbgSource }
|
||||
@ -131,7 +134,7 @@ var
|
||||
begin
|
||||
Result := ALoader.Read(0, sizeof(hdr), @hdr) = sizeof(hdr);
|
||||
if not Result then Exit;
|
||||
|
||||
FIs64Bit:=true;
|
||||
SetLength(sect, hdr.e_shnum);
|
||||
//ALoader.Position := hdr.e_shoff;
|
||||
|
||||
@ -284,7 +287,7 @@ begin
|
||||
p^.Loaded := False;
|
||||
FSections.Objects[idx] := TObject(p);
|
||||
end;
|
||||
|
||||
SetImage64Bit(fElfFile.Is64Bit);
|
||||
inherited Create(ASource, OwnSource);
|
||||
end;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user