diff --git a/components/fpdebug/fpdbgclasses.pp b/components/fpdebug/fpdbgclasses.pp index 7f6267e2d6..d9e6d7051f 100644 --- a/components/fpdebug/fpdbgclasses.pp +++ b/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 diff --git a/components/fpdebug/fpdbgcontroller.pas b/components/fpdebug/fpdbgcontroller.pas index d290748fef..88e66197dc 100644 --- a/components/fpdebug/fpdbgcontroller.pas +++ b/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; diff --git a/components/fpdebug/fpdbgwinclasses.pas b/components/fpdebug/fpdbgwinclasses.pas index 098443d5bd..6b9c8a58af 100644 --- a/components/fpdebug/fpdbgwinclasses.pas +++ b/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, diff --git a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas b/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas index 69d9ada6e9..a4de95e78d 100644 --- a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas +++ b/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...