paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-25 23:09:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

DBG, Thread window: update while running

Browse Source 
git-svn-id: trunk@37809 -
This commit is contained in:
martin 2012-06-27 23:08:55 +00:00
parent ba756c80eb
commit 1b6c227bd8
2 changed files with 237 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

88
debugger/debugger.pp
View File

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

170
debugger/gdbmidebugger.pp
View File

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