diff --git a/debugger/debugger.pp b/debugger/debugger.pp index 59569b5fa3..58c707de6f 100644 --- a/debugger/debugger.pp +++ b/debugger/debugger.pp @@ -1719,6 +1719,7 @@ type APath: string; AUnitInvoPrv: TDebuggerUnitInfoProvider = nil ); + procedure ClearLocation; // TODO need a way to call Changed on TCallStack or TThreads // corrently done in SetThreadState public constructor Create; constructor Create(const AIndex:Integer; const AnAdress: TDbgPtr; @@ -2138,6 +2139,7 @@ type FThreadId: Integer; FThreadName: String; FThreadState: String; + procedure SetThreadState(AValue: String); protected procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string; @@ -2158,7 +2160,7 @@ type constructor CreateCopy(const ASource: TThreadEntry); property ThreadId: Integer read FThreadId; property ThreadName: String read FThreadName; - property ThreadState: String read FThreadState; + property ThreadState: String read FThreadState write SetThreadState; end; { TThreads } @@ -2168,6 +2170,7 @@ type FCurrentThreadId: Integer; FList: TList; function GetEntry(const AnIndex: Integer): TThreadEntry; + function GetEntryById(const AnID: Integer): TThreadEntry; procedure SetCurrentThreadId(const AValue: Integer); virtual; protected procedure Assign(AOther: TThreads); @@ -2185,7 +2188,9 @@ type function Count: Integer; virtual; procedure Clear; virtual; procedure Add(AThread: TThreadEntry); + procedure Remove(AThread: TThreadEntry); property Entries[const AnIndex: Integer]: TThreadEntry read GetEntry; default; + property EntryById[const AnID: Integer]: TThreadEntry read GetEntryById; property CurrentThreadId: Integer read FCurrentThreadId write SetCurrentThreadId; end; @@ -2199,6 +2204,7 @@ type procedure SetCurrentThreadId(const AValue: Integer); override; procedure SetSnapShot(const AValue: TThreads); protected + Paused: Boolean; // Todo: introduce Supplie.ReadyForRequest property SnapShot: TThreads read FSnapShot write SetSnapShot; public constructor Create(AMonitor: TThreadsMonitor); @@ -2247,7 +2253,9 @@ type procedure DoStateEnterPause; override; procedure DoStateLeavePause; override; procedure DoStateLeavePauseClean; override; + procedure DoCleanAfterPause; virtual; public + procedure Changed; // TODO: needed because entries can not notify the monitor property CurrentThreads: TCurrentThreads read GetCurrentThreads; property Monitor: TThreadsMonitor read GetMonitor write SetMonitor; end; @@ -5555,17 +5563,25 @@ end; function TCurrentThreads.Count: Integer; begin - case FDataValidity of - ddsUnknown: begin - Result := 0; - FDataValidity := ddsRequested; - FMonitor.RequestData; - if FDataValidity = ddsValid then Result := inherited Count(); - end; - ddsRequested, ddsEvaluating: Result := 0; - ddsValid: Result := inherited Count; - ddsInvalid, ddsError: Result := 0; + if (FDataValidity = ddsUnknown) and Paused then begin + FDataValidity := ddsRequested; + Paused := False; + FMonitor.RequestData; end; + + Result := inherited Count; + + //case FDataValidity of + // ddsUnknown: begin + // Result := 0; + // FDataValidity := ddsRequested; + // FMonitor.RequestData; + // if FDataValidity = ddsValid then Result := inherited Count(); + // end; + // ddsRequested, ddsEvaluating: Result := 0; + // ddsValid: Result := inherited Count; + // ddsInvalid, ddsError: Result := 0; + //end; end; procedure TCurrentThreads.Clear; @@ -5593,6 +5609,12 @@ begin Inherited Monitor := AValue; end; +procedure TThreadsSupplier.Changed; +begin + if Monitor <> nil + then Monitor.Changed; +end; + procedure TThreadsSupplier.ChangeCurrentThread(ANewId: Integer); begin // @@ -5607,6 +5629,7 @@ procedure TThreadsSupplier.DoStateEnterPause; begin if (CurrentThreads = nil) then Exit; CurrentThreads.SetValidity(ddsUnknown); + CurrentThreads.Paused := True; end; procedure TThreadsSupplier.DoStateLeavePause; @@ -5619,6 +5642,11 @@ procedure TThreadsSupplier.DoStateLeavePauseClean; begin if (CurrentThreads = nil) then Exit; CurrentThreads.SnapShot := nil; + DoCleanAfterPause; +end; + +procedure TThreadsSupplier.DoCleanAfterPause; +begin if Monitor <> nil then Monitor.Clear; end; @@ -5788,6 +5816,13 @@ end; { TThreadEntry } +procedure TThreadEntry.SetThreadState(AValue: String); +begin + if FThreadState = AValue then Exit; + FThreadState := AValue; + ClearLocation; +end; + procedure TThreadEntry.LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string; AUnitInvoPrv: TDebuggerUnitInfoProvider = nil); begin @@ -5835,6 +5870,20 @@ begin Result := TThreadEntry(FList[AnIndex]); end; +function TThreads.GetEntryById(const AnID: Integer): TThreadEntry; +var + i: Integer; +begin + i := Count - 1; + while i >= 0 do begin + Result := Entries[i]; + if Result.ThreadId = AnID then + exit; + dec(i); + end; + Result := nil; +end; + procedure TThreads.SetCurrentThreadId(const AValue: Integer); begin if FCurrentThreadId = AValue then exit; @@ -5910,6 +5959,12 @@ begin FList.Add(TThreadEntry.CreateCopy(AThread)); end; +procedure TThreads.Remove(AThread: TThreadEntry); +begin + FList.Remove(AThread); + AThread.Free; +end; + { TDebuggerProperties } constructor TDebuggerProperties.Create; @@ -9218,6 +9273,17 @@ begin AConfig.SetValue(APath + 'State', s); end; +procedure TCallStackEntry.ClearLocation; +begin + FIndex := 0; + FAdress := 0; + FFunctionName := ''; + FLine := 0; + if FArguments <> nil then + FArguments.Clear; + SetUnitInfo(TDebuggerUnitInfo.Create('','')); +end; + constructor TCallStackEntry.Create; begin FArguments := TStringlist.Create; diff --git a/debugger/gdbmidebugger.pp b/debugger/gdbmidebugger.pp index ea1e4af0de..d0606100c7 100644 --- a/debugger/gdbmidebugger.pp +++ b/debugger/gdbmidebugger.pp @@ -1392,6 +1392,7 @@ type procedure RequestMasterData; override; procedure ChangeCurrentThread(ANewId: Integer); override; property Debugger: TGDBMIDebugger read GetDebugger; + procedure DoCleanAfterPause; override; public constructor Create(const ADebugger: TDebugger); destructor Destroy; override; @@ -1590,14 +1591,40 @@ var function DoExecAsync(var Line: String): Boolean; var S: String; + i: Integer; + ct: TCurrentThreads; + t: TThreadEntry; begin Result := False; S := GetPart('*', ',', Line); - case StringCase(S, ['stopped', 'started', 'disappeared']) of + case StringCase(S, ['stopped', 'started', 'disappeared', 'running']) of 0: begin // stopped - AStoppedParams := Line; - end; + AStoppedParams := Line; + end; 1, 2:; // Known, but undocumented classes + 3: begin // running,thread-id="1" // running,thread-id="all" + if (FTheDebugger.Threads.Monitor <> nil) and + (FTheDebugger.Threads.Monitor.CurrentThreads <> nil) + then begin + ct := FTheDebugger.Threads.Monitor.CurrentThreads; + S := GetPart('thread-id="', '"', Line); + if s = 'all' then begin + for i := 0 to ct.Count - 1 do + ct[i].ThreadState := 'running'; // TODO enum? + end + else begin + S := S + ','; + while s <> '' do begin + i := StrToIntDef(GetPart('', ',', s), -1); + if i < 0 then Continue; + t := ct.EntryById[i]; + if t <> nil then + t.ThreadState := 'running'; // TODO enum? + end; + end; + FTheDebugger.Threads.Changed; + end; + end; else // Assume targetoutput, strip char and continue DebugLn('[DBGTGT] *'); @@ -1606,6 +1633,49 @@ var end; end; + procedure DoMsgAsync(var Line: String); + var + S: String; + i, x: Integer; + ct: TCurrentThreads; + t: TThreadEntry; + begin + S := GetPart('=', ',', Line, False, False); + x := StringCase(S, ['thread-created', 'thread-exited']); + case x of // thread-group-exited // thread-group-added,id="i1" + 0,1: begin + i := StrToIntDef(GetPart(',id="', '"', Line, False, False), -1); + if (i > 0) and (FTheDebugger.Threads.Monitor <> nil) and + (FTheDebugger.Threads.Monitor.CurrentThreads <> nil) + then begin + ct := FTheDebugger.Threads.Monitor.CurrentThreads; + t := ct.EntryById[i]; + case x of + 0: begin + if t = nil then begin + t := TThreadEntry.Create(0, 0, nil, '', nil, 0, i, '', 'unknown'); + ct.Add(t); + t.Free; + end + else + debugln('GDBMI: Duplicate thread'); + end; + 1: begin + if t <> nil then begin + ct.Remove(t); + end + else + debugln('GDBMI: Missing thread'); + end; + end; + FTheDebugger.Threads.Changed; + end; + end; + end; + + FTheDebugger.DoNotifyAsync(Line); + end; + procedure DoStatusAsync(const Line: String); begin DebugLn('[Debugger] Status output: ', Line); @@ -1711,7 +1781,7 @@ begin '&': DoLogStream(S); '*': if DoExecAsync(S) then Continue; '+': DoStatusAsync(S); - '=': FTheDebugger.DoNotifyAsync(S); + '=': DoMsgAsync(S); else // since target output isn't prefixed (yet?) // one of our known commands could be part of it. @@ -2194,6 +2264,17 @@ begin (* DoEvaluationFinished may be called immediately at this point *) end; +procedure TGDBMIThreads.DoCleanAfterPause; +begin + if (Debugger.State <> dsRun) or (Monitor = nil) then begin + inherited DoCleanAfterPause; + exit; + end; + + //for i := 0 to Monitor.CurrentThreads.Count - 1 do + // Monitor.CurrentThreads[i].ClearLocation; // TODO enum? +end; + { TGDBMIDebuggerCommandThreads } function TGDBMIDebuggerCommandThreads.GetThread(AnIndex: Integer): TThreadEntry; @@ -10137,16 +10218,85 @@ var procedure DoExecAsync(Line: String); var - EventText: String; + S: String; + ct: TCurrentThreads; + i: Integer; + t: TThreadEntry; begin - EventText := GetPart(['*'], [','], Line, False, False); - if EventText = 'running' - then - DoDbgEvent(ecProcess, etProcessStart, 'Process Start: ' + FTheDebugger.FileName) + S := GetPart(['*'], [','], Line); + if S = 'running' + then begin + if (FTheDebugger.Threads.Monitor <> nil) and + (FTheDebugger.Threads.Monitor.CurrentThreads <> nil) + then begin + ct := FTheDebugger.Threads.Monitor.CurrentThreads; + S := GetPart('thread-id="', '"', Line); + if s = 'all' then begin + for i := 0 to ct.Count - 1 do + ct[i].ThreadState := 'running'; // TODO enum? + end + else begin + S := S + ','; + while s <> '' do begin + i := StrToIntDef(GetPart('', ',', s), -1); + if i < 0 then Continue; + t := ct.EntryById[i]; + if t <> nil then + t.ThreadState := 'running'; // TODO enum? + end; + end; + FTheDebugger.Threads.Changed; + end; + + DoDbgEvent(ecProcess, etProcessStart, 'Process Start: ' + FTheDebugger.FileName); + end else DebugLn('[WARNING] Debugger: Unexpected async-record: ', Line); end; + procedure DoMsgAsync(var Line: String); + var + S: String; + i, x: Integer; + ct: TCurrentThreads; + t: TThreadEntry; + begin + S := GetPart('=', ',', Line, False, False); + x := StringCase(S, ['thread-created', 'thread-exited']); + case x of // thread-group-exited // thread-group-added,id="i1" + 0,1: begin + i := StrToIntDef(GetPart(',id="', '"', Line, False, False), -1); + if (i > 0) and (FTheDebugger.Threads.Monitor <> nil) and + (FTheDebugger.Threads.Monitor.CurrentThreads <> nil) + then begin + ct := FTheDebugger.Threads.Monitor.CurrentThreads; + t := ct.EntryById[i]; + case x of + 0: begin + if t = nil then begin + t := TThreadEntry.Create(0, 0, nil, '', nil, 0, i, '', 'unknown'); + ct.Add(t); + t.Free; + end + else + debugln('GDBMI: Duplicate thread'); + end; + 1: begin + if t <> nil then begin + ct.Remove(t); + end + else + debugln('GDBMI: Missing thread'); + end; + end; + FTheDebugger.Threads.Changed; + end; + end; + end; + + FTheDebugger.DoNotifyAsync(Line); + end; + procedure DoStatusAsync(const Line: String); begin DebugLn('[WARNING] Debugger: Unexpected async-record: ', Line); @@ -10174,7 +10324,7 @@ begin '&': DoLogStream(S); '*': DoExecAsync(S); '+': DoStatusAsync(S); - '=': FTheDebugger.DoNotifyAsync(S); + '=': DoMsgAsync(S); else DebugLn('[WARNING] Debugger: Unknown record: ', S); end;