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

FpDebugger (pure): Refactored creation of new TDbgThreads

Browse Source 
git-svn-id: trunk@45407 -
This commit is contained in:
joost 2014-06-08 18:59:06 +00:00
parent 3e15f47c0e
commit 22e7389619
4 changed files with 62 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
components/fpdebug/fpdbgclasses.pp
View File

@ -278,6 +278,8 @@ type
function GetLastEventProcessIdentifier: THandle; virtual;
function DoBreak(BreakpointAddress: TDBGPtr; AThreadID: integer): Boolean;
procedure MaskBreakpointsInReadData(const AAdress: TDbgPtr; const ASize: Cardinal; var AData);
// Should create a TDbgThread-instance for the given ThreadIdentifier.
function CreateThread(AthreadIdentifier: THandle; out IsMainThread: boolean): TDbgThread; virtual; abstract;
public
class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory: string; AOnLog: TOnLog): TDbgProcess; virtual;
constructor Create(const AName: string; const AProcessID, AThreadID: Integer; AOnLog: TOnLog); virtual;
@ -304,6 +306,8 @@ type
function WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean; virtual; abstract;
function ResolveDebugEvent(AThread: TDbgThread): TFPDEvent; virtual; abstract;
function AddThread(AThreadIdentifier: THandle): TDbgThread;
function WriteData(const AAdress: TDbgPtr; const ASize: Cardinal; const AData): Boolean; virtual;
function GetInstructionPointerRegisterValue: TDbgPtr; virtual; abstract;
@ -775,8 +779,7 @@ begin
AThread := nil;
Result := FThreadMap.GetData(AID, Thread) and (Thread <> nil);
if Result
then AThread := Thread
else Log('Unknown thread ID %u for process %u', [AID, FProcessID]);
then AThread := Thread;
end;
function TDbgProcess.ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData): Boolean;
@ -823,6 +826,24 @@ begin
result := false;
end;
function TDbgProcess.AddThread(AThreadIdentifier: THandle): TDbgThread;
var
IsMainThread: boolean;
begin
result := CreateThread(AthreadIdentifier, IsMainThread);
if assigned(result) then
begin
FThreadMap.Add(AThreadIdentifier, Result);
if IsMainThread then
begin
assert(FMainThread=nil);
FMainThread := result;
end;
end
else
Log('Unknown thread ID %u for process %u', [AThreadIdentifier, ProcessID]);
end;
function TDbgProcess.RemoveBreak(const ALocation: TDbgPtr): Boolean;
var
ABreakPoint: TDbgBreakpoint;

4
components/fpdebug/fpdbgcontroller.pas
View File

@ -219,8 +219,8 @@ begin
// Just continue the process. Only the main-process is being debugged.
Continue;
if not FCurrentProcess.GetThread(AThreadIdentifier, FCurrentThread)
then Log('LOOP: Unable to retrieve current thread');
if not FCurrentProcess.GetThread(AThreadIdentifier, FCurrentThread) then
FCurrentThread := FCurrentProcess.AddThread(AThreadIdentifier);
FPDEvent:=FCurrentProcess.ResolveDebugEvent(FCurrentThread);
if (FPDEvent<>deInternalContinue) and assigned(FCurrentProcess.RunToBreakpoint) then begin

34
components/fpdebug/fpdbgdarwinclasses.pas
View File

@ -93,6 +93,7 @@ type
procedure OnForkEvent(Sender : TObject);
protected
function InitializeLoader: TDbgImageLoader; override;
function CreateThread(AthreadIdentifier: THandle; out IsMainThread: boolean): TDbgThread; 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;
@ -345,6 +346,15 @@ begin
end;
end;
function TDbgDarwinProcess.CreateThread(AthreadIdentifier: THandle; out IsMainThread: boolean): TDbgThread;
begin
IsMainThread:=true;
if AthreadIdentifier>-1 then
result := TDbgDarwinThread.Create(Self, AthreadIdentifier, AthreadIdentifier)
else
result := nil;
end;
constructor TDbgDarwinProcess.Create(const AName: string; const AProcessID,
AThreadID: Integer; AOnLog: TOnLog);
var
@ -525,35 +535,24 @@ var
aKernResult: kern_return_t;
act_list: thread_act_array_t;
act_listCtn: mach_msg_type_number_t;
i: Integer;
AThread: TDbgThread;
begin
ThreadIdentifier:=-1;
ProcessIdentifier:=FpWaitPid(-1, FStatus, 0);
result := ProcessIdentifier<>-1;
if not result then
writeln('Failed to wait for debug event. Errcode: ', fpgeterrno)
else if WIFSTOPPED(FStatus) then
Log('Failed to wait for debug event. Errcode: %d', [fpgeterrno])
else if (WIFSTOPPED(FStatus)) then
begin
// Read thread-information
aKernResult := task_threads(FTaskPort, act_list, act_listCtn);
if aKernResult <> KERN_SUCCESS then
begin
Log('Failed to call task_threads. Mach error: '+mach_error_string(aKernResult));
end;
for i := 0 to act_listCtn-1 do
begin
if not GetThread(act_list^[i], AThread) then
begin
AThread := TDbgDarwinThread.Create(Self, act_list^[i], act_list^[i]);
FThreadMap.Add(act_list^[i], AThread);
if FMainThread=nil then
FMainThread := AThread;
end;
end;
ThreadIdentifier:=act_list^[0];
TDbgDarwinThread(FMainThread).ReadThreadState;
if act_listCtn>0 then
ThreadIdentifier := act_list^[0];
end
end;
@ -577,6 +576,7 @@ begin
else if WIFSTOPPED(FStatus) then
begin
writeln('Stopped ',FStatus, ' signal: ',wstopsig(FStatus));
TDbgDarwinThread(AThread).ReadThreadState;
case wstopsig(FStatus) of
SIGTRAP:
begin

35
components/fpdebug/fpdbgwinclasses.pas
View File

@ -104,6 +104,8 @@ type
function Continue(AProcess: TDbgProcess; AThread: TDbgThread): boolean; override;
function WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean; override;
function ResolveDebugEvent(AThread: TDbgThread): TFPDEvent; override;
function CreateThread(AthreadIdentifier: THandle; out IsMainThread: boolean): TDbgThread; override;
procedure StartProcess(const AThreadID: DWORD; const AInfo: TCreateProcessDebugInfo);
function GetInstructionPointerRegisterValue: TDbgPtr; override;
@ -115,7 +117,6 @@ type
function AddrOffset: Int64; override;
function AddLib(const AInfo: TLoadDLLDebugInfo): TDbgLibrary;
procedure AddThread(const AID: Integer; const AInfo: TCreateThreadDebugInfo);
procedure RemoveLib(const AInfo: TUnloadDLLDebugInfo);
end;
@ -433,9 +434,6 @@ function TDbgWinProcess.HandleDebugEvent(const ADebugEvent: TDebugEvent): Boolea
begin
Result := False;
case ADebugEvent.dwDebugEventCode of
CREATE_THREAD_DEBUG_EVENT: begin
AddThread(ADebugEvent.dwThreadId, ADebugEvent.CreateThread)
end;
EXIT_THREAD_DEBUG_EVENT: begin
RemoveThread(ADebugEvent.dwThreadId);
end;
@ -878,6 +876,24 @@ begin
end;
end;
function TDbgWinProcess.CreateThread(AthreadIdentifier: THandle; out IsMainThread: boolean): TDbgThread;
begin
case MDebugEvent.dwDebugEventCode of
CREATE_THREAD_DEBUG_EVENT :
begin
result := OSDbgClasses.DbgThreadClass.Create(Self, AThreadIdentifier, MDebugEvent.CreateThread.hThread);
IsMainThread := false;
end;
CREATE_PROCESS_DEBUG_EVENT :
begin
result := OSDbgClasses.DbgThreadClass.Create(Self, AThreadIdentifier, MDebugEvent.CreateProcessInfo.hThread);
IsMainThread := true;
end
else
result := nil;
end; {case}
end;
procedure TDbgWinProcess.StartProcess(const AThreadID: DWORD;const AInfo: TCreateProcessDebugInfo);
var
s: string;
@ -892,9 +908,6 @@ begin
if DbgInfo.HasInfo
then FSymInstances.Add(Self);
FMainThread := OSDbgClasses.DbgThreadClass.Create(Self, AThreadID, AInfo.hThread);
FThreadMap.Add(FMainThread.ID, FMainThread);
end;
function TDbgWinProcess.GetInstructionPointerRegisterValue: TDbgPtr;
@ -957,14 +970,6 @@ begin
then FSymInstances.Add(Result);
end;
procedure TDbgWinProcess.AddThread(const AID: Integer; const AInfo: TCreateThreadDebugInfo);
var
Thread: TDbgThread;
begin
Thread := OSDbgClasses.DbgThreadClass.Create(Self, AID, AInfo.hThread);
FThreadMap.Add(AID, Thread);
end;
procedure TDbgWinProcess.RemoveLib(const AInfo: TUnloadDLLDebugInfo);
var
Lib: TDbgLibrary;