LazDebuggerFp, FpDebug: (windows only) implemented switching threads while paused. (On Linux only one thread is currently paused, so switching is not possible)

git-svn-id: trunk@59571 -

components/fpdebug/fpdbgclasses.pp

@@ -341,6 +341,8 @@ type
 
     function AddThread(AThreadIdentifier: THandle): TDbgThread;
     function GetThreadArray: TFPDThreadArray;
+    procedure ThreadsBeforeContinue;
+    procedure ThreadsClearCallStack;
     procedure LoadInfo; override;
 
     function WriteData(const AAdress: TDbgPtr; const ASize: Cardinal; const AData): Boolean; virtual;
@@ -1032,6 +1034,44 @@ begin
   end;
 end;
 
+procedure TDbgProcess.ThreadsBeforeContinue;
+var
+  Iterator: TMapIterator;
+  Thread: TDbgThread;
+begin
+  Iterator := TMapIterator.Create(FThreadMap);
+  try
+    Iterator.First;
+    while not Iterator.EOM do
+    begin
+      Iterator.GetData(Thread);
+      Thread.BeforeContinue;
+      iterator.Next;
+    end;
+  finally
+    Iterator.Free;
+  end;
+end;
+
+procedure TDbgProcess.ThreadsClearCallStack;
+var
+  Iterator: TMapIterator;
+  Thread: TDbgThread;
+begin
+  Iterator := TMapIterator.Create(FThreadMap);
+  try
+    Iterator.First;
+    while not Iterator.EOM do
+    begin
+      Iterator.GetData(Thread);
+      Thread.ClearCallStack;
+      iterator.Next;
+    end;
+  finally
+    Iterator.Free;
+  end;
+end;
+
 function TDbgProcess.RemoveBreak(const ABreakPoint: TFpInternalBreakpoint
   ): Boolean;
 begin

components/fpdebug/fpdbgcontroller.pas

@@ -143,6 +143,8 @@ type
     FConsoleTty: string;
     FRedirectConsoleOutput: boolean;
     FWorkingDirectory: string;
+    function GetCurrentThreadId: Integer;
+    procedure SetCurrentThreadId(AValue: Integer);
     procedure SetEnvironment(AValue: TStrings);
     procedure SetExecutableFilename(AValue: string);
     procedure SetOnLog(AValue: TOnLog);
@@ -175,6 +177,7 @@ type
     property OnLog: TOnLog read FOnLog write SetOnLog;
     property CurrentProcess: TDbgProcess read FCurrentProcess;
     property CurrentThread: TDbgThread read FCurrentThread;
+    property CurrentThreadId: Integer read GetCurrentThreadId write SetCurrentThreadId;
     property MainProcess: TDbgProcess read FMainProcess;
     property Params: TStringList read FParams write SetParams;
     property Environment: TStrings read FEnvironment write SetEnvironment;
@@ -617,6 +620,25 @@ begin
   FEnvironment.Assign(AValue);
 end;
 
+function TDbgController.GetCurrentThreadId: Integer;
+begin
+  Result := FCurrentThread.ID;
+end;
+
+procedure TDbgController.SetCurrentThreadId(AValue: Integer);
+var
+  ExistingThread: TDbgThread;
+begin
+  if FCurrentThread.ID = AValue then Exit;
+
+  if not FCurrentProcess.GetThread(AValue, ExistingThread) then begin
+    debugln(['SetCurrentThread() unknown thread id: ', AValue]);
+    // raise ...
+    exit;
+  end;
+  FCurrentThread := ExistingThread;
+end;
+
 procedure TDbgController.SetOnLog(AValue: TOnLog);
 begin
   if FOnLog=AValue then Exit;

components/fpdebug/fpdbgwinclasses.pas

@@ -515,9 +515,9 @@ begin
       AThread.NextIsSingleStep:=SingleStep;
       if SingleStep or assigned(FCurrentBreakpoint) then
         TDbgWinThread(AThread).SetSingleStep;
-      AThread.BeforeContinue;
     end;
   end;
+  AProcess.ThreadsBeforeContinue;
 
   case MDebugEvent.Exception.ExceptionRecord.ExceptionCode of
    EXCEPTION_BREAKPOINT,

components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas

@@ -251,6 +251,7 @@ type
     procedure DoStateEnterPause; override;
   public
     procedure RequestMasterData; override;
+    procedure ChangeCurrentThread(ANewId: Integer); override;
   end;
 
   { TFPDBGDisassembler }
@@ -365,6 +366,7 @@ begin
   ThreadArray := TFpDebugDebugger(Debugger).FDbgController.CurrentProcess.GetThreadArray;
   for i := 0 to high(ThreadArray) do
     begin
+    ThreadArray[i].PrepareCallStackEntryList(1);
     CallStack := ThreadArray[i].CallStackEntryList;
     if ThreadArray[i].ID = TFpDebugDebugger(Debugger).FDbgController.CurrentThread.ID then
       State := 'stopped'
@@ -408,6 +410,19 @@ begin
   CurrentThreads.SetValidity(ddsValid);
 end;
 
+procedure TFPThreads.ChangeCurrentThread(ANewId: Integer);
+begin
+  inherited ChangeCurrentThread(ANewId);
+  if not(Debugger.State in [dsPause, dsInternalPause]) then exit;
+
+  {$IFDEF windows}
+  TFpDebugDebugger(Debugger).FDbgController.CurrentThreadId := ANewId;
+  if CurrentThreads <> nil
+  then CurrentThreads.CurrentThreadId := ANewId;
+  Changed;
+  {$ENDIF}
+end;
+
 { TFpDebugDebuggerProperties }
 
 constructor TFpDebugDebuggerProperties.Create;
@@ -517,9 +532,9 @@ end;
 procedure TFPCallStackSupplier.DoStateLeavePause;
 begin
   if (TFpDebugDebugger(Debugger).FDbgController <> nil) and
-     (TFpDebugDebugger(Debugger).FDbgController.CurrentThread <> nil)
+     (TFpDebugDebugger(Debugger).FDbgController.CurrentProcess <> nil)
   then
-    TFpDebugDebugger(Debugger).FDbgController.CurrentThread.ClearCallStack;
+    TFpDebugDebugger(Debugger).FDbgController.CurrentProcess.ThreadsClearCallStack;
   inherited DoStateLeavePause;
 end;
 
@@ -1663,8 +1678,8 @@ end;
 
 procedure TFpDebugDebugger.FDbgControllerCreateProcessEvent(var continue: boolean);
 begin
-  // This will trigger setting the breakpoints, but won't trigger the evaluation
-  // of the callstack or disassembler.
+  // This will trigger setting the breakpoints,
+  // may also trigger the evaluation of the callstack or disassembler.
   SetState(dsInternalPause);
 
   if not SetSoftwareExceptionBreakpoint then
@@ -1858,6 +1873,13 @@ begin
     DebugLn('DebugLoopFinished');
     {$endif DBG_FPDEBUG_VERBOSE}
 
+    (* Need to ensure CurrentThreadId is correct,
+       because any callstack (never mind which to which IDE-thread object it belongs
+       will always get the data for the current thread only
+     TODO: callstacks need a field with the thread-id to which they belong *)
+    if (Threads <> nil) and (Threads.CurrentThreads <> nil) then
+      Threads.CurrentThreads.CurrentThreadId := FDbgController.CurrentThreadId;
+
     FDbgController.SendEvents(Cont); // This may free the TFpDebugDebugger (self)
 
     FQuickPause:=false; // TODO: there may be other events: deInternalContinue, deLoadLibrary...