FpDebugger (pure): Refactored creation of new TDbgThreads

git-svn-id: trunk@45407 -

components/fpdebug/fpdbgclasses.pp

@@ -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
+  then AThread := Thread;
-  else Log('Unknown thread ID %u for process %u', [AID, FProcessID]);
 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;

components/fpdebug/fpdbgcontroller.pas

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

components/fpdebug/fpdbgdarwinclasses.pas

@@ -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)
+    Log('Failed to wait for debug event. Errcode: %d', [fpgeterrno])
-  else if WIFSTOPPED(FStatus) then
+  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
+    if act_listCtn>0 then
-      begin
+      ThreadIdentifier := act_list^[0];
-      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;
     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

components/fpdebug/fpdbgwinclasses.pas

@@ -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;