From 99624b9b9ae9bb50a36a2bdfafb3a6f32443b7a9 Mon Sep 17 00:00:00 2001 From: martin Date: Fri, 13 May 2011 14:00:35 +0000 Subject: [PATCH] DBG: Refactor Master/Slave class structure (locals) git-svn-id: trunk@30721 - --- debugger/debugger.pp | 462 ++++++++++++++++++----------- debugger/gdbmidebugger.pp | 190 +++--------- debugger/localsdlg.pp | 149 ++++++++-- debugger/test/Gdbmi/testbase.pas | 10 +- debugger/test/Gdbmi/testdisass.pas | 6 +- ide/basedebugmanager.pas | 4 +- ide/debugmanager.pas | 10 +- 7 files changed, 481 insertions(+), 350 deletions(-) diff --git a/debugger/debugger.pp b/debugger/debugger.pp index 9cf65f6ad1..d492aaaec7 100644 --- a/debugger/debugger.pp +++ b/debugger/debugger.pp @@ -217,7 +217,9 @@ type TWatch = class; TWatchesMonitor = class; TWatchesSupplier = class; - TIDELocals = class; + TLocalsMonitor = class; + TLocalsSupplier = class; + TCurrentLocals = class; TIDELineInfo = class; TCallStack = class; TCallStackMonitor = class; @@ -1008,69 +1010,112 @@ type ****************************************************************************** ******************************************************************************} - { TBaseLocals } + TLocalsNotification = class(TDebuggerChangeNotification) + public + property OnChange; + end; - TBaseLocals = class(TObject) + { TLocals } + + TLocals = class(TObject) private + function GetName(const AnIndex: Integer): String; + function GetValue(const AnIndex: Integer): String; protected - function GetName(const AnIndex: Integer): String; virtual; - function GetValue(const AnIndex: Integer): String; virtual; + FLocals: TStringList; + FStackFrame: Integer; + FThreadId: Integer; public constructor Create; + destructor Destroy; override; function Count: Integer; virtual; public property Names[const AnIndex: Integer]: String read GetName; property Values[const AnIndex: Integer]: String read GetValue; + property ThreadId: Integer read FThreadId; + property StackFrame: Integer read FStackFrame; end; - { TIDELocals } + { TLocalsList } - { TIDELocalsNotification } - TDBGLocals = class; - - TIDELocalsNotification = class(TDebuggerNotification) + TLocalsList = class private - FOnChange: TNotifyEvent; - public - property OnChange: TNotifyEvent read FOnChange write FOnChange; - end; - - TIDELocals = class(TBaseLocals) - private - FNotificationList: TList; - FMaster: TDBGLocals; - procedure LocalsChanged(Sender: TObject); - procedure SetMaster(const AMaster: TDBGLocals); + FList: TList; + function GetEntry(const AThreadId: Integer; const AStackFrame: Integer): TLocals; protected - procedure NotifyChange; - function GetName(const AnIndex: Integer): String; override; - function GetValue(const AnIndex: Integer): String; override; + function CreateEntry(const AThreadId: Integer; const AStackFrame: Integer): TLocals; virtual; + public + //procedure Assign(AnOther: TWatchValueList); + constructor Create; + destructor Destroy; override; + procedure Clear; + property Entries[const AThreadId: Integer; const AStackFrame: Integer]: TLocals + read GetEntry; default; + end; + + { TCurrentLocals } + + TCurrentLocals = class(TLocals) + private + FMonitor: TLocalsMonitor; + FDataValidity: TDebuggerDataState; + public + constructor Create(AMonitor: TLocalsMonitor; AThreadId, AStackFrame: Integer); + function Count: Integer; override; + procedure Clear; + procedure Add(const AName, AValue: String); + procedure SetDataValidity(AValidity: TDebuggerDataState); + end; + + { TCurrentLocalsList } + + TCurrentLocalsList = class(TLocalsList) + private + FMonitor: TLocalsMonitor; + protected + function CreateEntry(const AThreadId: Integer; const AStackFrame: Integer): TLocals; + override; + public + constructor Create(AMonitor: TLocalsMonitor); + end; + + { TLocalsMonitor } + + TLocalsMonitor = class(TDebuggerDataMonitor) + private + FCurrentLocalsList: TCurrentLocalsList; + FNotificationList: TDebuggerChangeNotificationList; + function GetSupplier: TLocalsSupplier; + procedure SetSupplier(const AValue: TLocalsSupplier); + protected + procedure NotifyChange(ALocals: TCurrentLocals); + procedure DoNewSupplier; override; + procedure RequestData(ALocals: TCurrentLocals); public constructor Create; destructor Destroy; override; - procedure AddNotification(const ANotification: TIDELocalsNotification); - procedure RemoveNotification(const ANotification: TIDELocalsNotification); - function Count: Integer; override; - property Master: TDBGLocals read FMaster write SetMaster; + procedure Clear; + procedure AddNotification(const ANotification: TLocalsNotification); + procedure RemoveNotification(const ANotification: TLocalsNotification); + property CurrentLocalsList: TCurrentLocalsList read FCurrentLocalsList; + property Supplier: TLocalsSupplier read GetSupplier write SetSupplier; end; - { TDBGLocals } + { TLocalsSupplier } - TDBGLocals = class(TBaseLocals) + TLocalsSupplier = class(TDebuggerDataSupplier) private - FDebugger: TDebugger; // reference to our debugger - FOnChange: TNotifyEvent; + function GetCurrentLocalsList: TCurrentLocalsList; + function GetMonitor: TLocalsMonitor; + procedure SetMonitor(const AValue: TLocalsMonitor); protected - procedure Changed; virtual; - procedure DoChange; - procedure DoStateChange(const AOldState: TDBGState); virtual; - function GetCount: Integer; virtual; - property Debugger: TDebugger read FDebugger; + procedure RequestData(ALocals: TCurrentLocals); virtual; public - function Count: Integer; override; - constructor Create(const ADebugger: TDebugger); - property OnChange: TNotifyEvent read FOnChange write FOnChange; + procedure DoStateChange(const AOldState: TDBGState); virtual; + property CurrentLocalsList: TCurrentLocalsList read GetCurrentLocalsList; + property Monitor: TLocalsMonitor read GetMonitor write SetMonitor; end; + {%endregion ^^^^^ Locals ^^^^^ } @@ -2068,7 +2113,7 @@ type FExternalDebugger: String; //FExceptions: TDBGExceptions; FFileName: String; - FLocals: TDBGLocals; + FLocals: TLocalsSupplier; FLineInfo: TDBGLineInfo; FOnConsoleOutput: TDBGOutputEvent; FOnFeedback: TDBGFeedbackEvent; @@ -2098,7 +2143,7 @@ type procedure SetFileName(const AValue: String); protected function CreateBreakPoints: TDBGBreakPoints; virtual; - function CreateLocals: TDBGLocals; virtual; + function CreateLocals: TLocalsSupplier; virtual; function CreateLineInfo: TDBGLineInfo; virtual; function CreateRegisters: TDBGRegisters; virtual; function CreateCallStack: TCallStackSupplier; virtual; @@ -2177,7 +2222,7 @@ type property ExitCode: Integer read FExitCode; property ExternalDebugger: String read FExternalDebugger; // The name of the debugger executable property FileName: String read FFileName write SetFileName; // The name of the exe to be debugged - property Locals: TDBGLocals read FLocals; // list of all localvars etc + property Locals: TLocalsSupplier read FLocals; // list of all localvars etc property LineInfo: TDBGLineInfo read FLineInfo; // list of all source LineInfo property Registers: TDBGRegisters read FRegisters; // list of all registers property Signals: TDBGSignals read FSignals; // A list of actions for signals we know @@ -2331,6 +2376,168 @@ begin Result:=bpaStop; end; +{ TCurrentLocalsList } + +function TCurrentLocalsList.CreateEntry(const AThreadId: Integer; + const AStackFrame: Integer): TLocals; +begin + Result := TCurrentLocals.Create(FMonitor, AThreadId, AStackFrame); +end; + +constructor TCurrentLocalsList.Create(AMonitor: TLocalsMonitor); +begin + FMonitor := AMonitor; + inherited Create; +end; + +{ TLocalsList } + +function TLocalsList.GetEntry(const AThreadId: Integer; const AStackFrame: Integer): TLocals; +var + i: Integer; +begin + i := FList.Count - 1; + while i >= 0 do begin + Result := TLocals(FList[i]); + if (Result.ThreadId = AThreadId) and (Result.StackFrame = AStackFrame) + then exit; + dec(i); + end; + Result := CreateEntry(AThreadId, AStackFrame); + if Result = nil then exit; + FList.Add(Result); +end; + +function TLocalsList.CreateEntry(const AThreadId: Integer; + const AStackFrame: Integer): TLocals; +begin + Result := nil; +end; + +constructor TLocalsList.Create; +begin + FList := TList.Create; + inherited Create; +end; + +destructor TLocalsList.Destroy; +begin + Clear; + inherited Destroy; + FList.Free; +end; + +procedure TLocalsList.Clear; +begin + while FList.Count > 0 do begin + TObject(FList[0]).Free; + FList.Delete(0); + end; +end; + +{ TLocalsSupplier } + +function TLocalsSupplier.GetCurrentLocalsList: TCurrentLocalsList; +begin + if Monitor <> nil + then Result := Monitor.CurrentLocalsList + else Result := nil; +end; + +function TLocalsSupplier.GetMonitor: TLocalsMonitor; +begin + Result := TLocalsMonitor(inherited Monitor); +end; + +procedure TLocalsSupplier.SetMonitor(const AValue: TLocalsMonitor); +begin + inherited Monitor := AValue; +end; + +procedure TLocalsSupplier.RequestData(ALocals: TCurrentLocals); +begin + ALocals.SetDataValidity(ddsInvalid) +end; + +procedure TLocalsSupplier.DoStateChange(const AOldState: TDBGState); +begin + if FDebugger.State = dsPause + then begin + if Monitor<> nil + then Monitor.Clear; + end + else begin + if (AOldState = dsPause) or (AOldState = dsNone) { Force clear on initialisation } + then begin + if Monitor<> nil + then Monitor.Clear; + end; + end; +end; + +{ TLocalsMonitor } + +function TLocalsMonitor.GetSupplier: TLocalsSupplier; +begin + Result := TLocalsSupplier(inherited Supplier); +end; + +procedure TLocalsMonitor.SetSupplier(const AValue: TLocalsSupplier); +begin + inherited Supplier := AValue; +end; + +procedure TLocalsMonitor.NotifyChange(ALocals: TCurrentLocals); +begin + FNotificationList.NotifyChange(ALocals); +end; + +procedure TLocalsMonitor.DoNewSupplier; +begin + inherited DoNewSupplier; + NotifyChange(nil); +end; + +procedure TLocalsMonitor.RequestData(ALocals: TCurrentLocals); +begin + if Supplier <> nil + then Supplier.RequestData(ALocals) + else ALocals.SetDataValidity(ddsInvalid); +end; + +constructor TLocalsMonitor.Create; +begin + inherited; + FNotificationList := TDebuggerChangeNotificationList.Create; + FCurrentLocalsList := TCurrentLocalsList.Create(Self); +end; + +destructor TLocalsMonitor.Destroy; +begin + FNotificationList.Clear; + inherited Destroy; + FreeAndNil(FCurrentLocalsList); + FreeAndNil(FNotificationList); +end; + +procedure TLocalsMonitor.Clear; +begin + FCurrentLocalsList.Clear; + NotifyChange(nil); +end; + +procedure TLocalsMonitor.AddNotification(const ANotification: TLocalsNotification); +begin + FNotificationList.Add(ANotification); +end; + +procedure TLocalsMonitor.RemoveNotification(const ANotification: TLocalsNotification); +begin + FNotificationList.Remove(ANotification); +end; + +{ TCurrentWatchValue } + procedure TCurrentWatchValue.SetTypeInfo(const AValue: TDBGType); begin if FTypeInfo<> nil then @@ -2379,6 +2586,7 @@ begin dec(i); end; Result := CreateEntry(AThreadId, AStackFrame, ADisplayFormat); + if Result = nil then exit; FList.Add(Result); Result.RequestData; end; @@ -3320,9 +3528,9 @@ begin Result := TDBGExceptions.Create(Self, TDBGException); end; -function TDebugger.CreateLocals: TDBGLocals; +function TDebugger.CreateLocals: TLocalsSupplier; begin - Result := TDBGLocals.Create(Self); + Result := TLocalsSupplier.Create(Self); end; function TDebugger.CreateLineInfo: TDBGLineInfo; @@ -5529,162 +5737,80 @@ end; (******************************************************************************) { =========================================================================== } -{ TBaseLocals } +{ TLocals } { =========================================================================== } -function TBaseLocals.Count: Integer; +function TLocals.Count: Integer; begin - Result := 0; + Result := FLocals.Count; end; -constructor TBaseLocals.Create; +constructor TLocals.Create; begin + FLocals := TStringList.Create; inherited Create; end; -function TBaseLocals.GetName(const AnIndex: Integer): String; +destructor TLocals.Destroy; begin - Result := ''; + inherited Destroy; + FreeAndNil(FLocals); end; -function TBaseLocals.GetValue(const AnIndex: Integer): String; +function TLocals.GetName(const AnIndex: Integer): String; begin - Result := ''; + Result := FLocals.Names[AnIndex]; +end; + +function TLocals.GetValue(const AnIndex: Integer): String; +begin + Result := FLocals[AnIndex]; + Result := GetPart('=', '', Result); end; { =========================================================================== } -{ TIDELocals } +{ TCurrentLocals } { =========================================================================== } -procedure TIDELocals.AddNotification(const ANotification: TIDELocalsNotification); +constructor TCurrentLocals.Create(AMonitor: TLocalsMonitor; AThreadId, AStackFrame: Integer); begin - FNotificationList.Add(ANotification); - ANotification.AddReference; -end; - -constructor TIDELocals.Create; -begin - FNotificationList := TList.Create; + FMonitor := AMonitor; + FDataValidity := ddsUnknown; + FThreadId := AThreadId; + FStackFrame := AStackFrame; inherited Create; end; -destructor TIDELocals.Destroy; -var - n: Integer; +function TCurrentLocals.Count: Integer; begin - for n := FNotificationList.Count - 1 downto 0 do - TDebuggerNotification(FNotificationList[n]).ReleaseReference; - - inherited; - - FreeAndNil(FNotificationList); -end; - -procedure TIDELocals.LocalsChanged(Sender: TObject); -begin - NotifyChange; -end; - -procedure TIDELocals.SetMaster(const AMaster: TDBGLocals); -var - DoNotify: Boolean; -begin - if FMaster = AMaster then Exit; - - if FMaster <> nil - then begin - FMaster.OnChange := nil; - DoNotify := FMaster.Count <> 0; - end - else DoNotify := False; - - FMaster := AMaster; - - if FMaster <> nil - then begin - FMaster.OnChange := @LocalsChanged; - DoNotify := DoNotify or (FMaster.Count <> 0); - end; - - if DoNotify - then NotifyChange; -end; - -procedure TIDELocals.NotifyChange; -var - n: Integer; - Notification: TIDELocalsNotification; -begin - for n := 0 to FNotificationList.Count - 1 do - begin - Notification := TIDELocalsNotification(FNotificationList[n]); - if Assigned(Notification.FOnChange) - then Notification.FOnChange(Self); + case FDataValidity of + ddsUnknown: begin + Result := 0; + FDataValidity := ddsRequested; + FMonitor.RequestData(Self); + if FDataValidity = ddsValid then Result := inherited Count; + end; + ddsRequested, ddsEvaluating: Result := 0; + ddsValid: Result := inherited Count; + ddsInvalid, ddsError: Result := 0; end; end; -function TIDELocals.GetName(const AnIndex: Integer): String; +procedure TCurrentLocals.Clear; begin - if Master = nil - then Result := inherited GetName(AnIndex) - else Result := Master.Names[AnIndex]; + FLocals.Clear; end; -function TIDELocals.GetValue(const AnIndex: Integer): String; +procedure TCurrentLocals.Add(const AName, AValue: String); begin - if Master = nil - then Result := inherited GetValue(AnIndex) - else Result := Master.Values[AnIndex]; + FLocals.Add(AName + '=' + AValue); end; -procedure TIDELocals.RemoveNotification(const ANotification: TIDELocalsNotification); +procedure TCurrentLocals.SetDataValidity(AValidity: TDebuggerDataState); begin - FNotificationList.Remove(ANotification); - ANotification.ReleaseReference; -end; - -function TIDELocals.Count: Integer; -begin - if Master = nil - then Result := 0 - else Result := Master.Count; -end; - -{ =========================================================================== } -{ TDBGLocals } -{ =========================================================================== } - -function TDBGLocals.Count: Integer; -begin - if (FDebugger <> nil) - and (FDebugger.State = dsPause) - then Result := GetCount - else Result := 0; -end; - -constructor TDBGLocals.Create(const ADebugger: TDebugger); -begin - inherited Create; - FDebugger := ADebugger; -end; - -procedure TDBGLocals.DoChange; -begin - if Assigned(FOnChange) then FOnChange(Self); -end; - -procedure TDBGLocals.DoStateChange(const AOldState: TDBGState); -begin -end; - -procedure TDBGLocals.Changed; -begin - DoChange; -end; - -function TDBGLocals.GetCount: Integer; -begin - Result := 0; + if FDataValidity = AValidity then exit; + FDataValidity := AValidity; + FMonitor.NotifyChange(Self); end; (******************************************************************************) diff --git a/debugger/gdbmidebugger.pp b/debugger/gdbmidebugger.pp index 5c4b3b4357..10bb99eb0d 100644 --- a/debugger/gdbmidebugger.pp +++ b/debugger/gdbmidebugger.pp @@ -373,7 +373,7 @@ type function ChangeFileName: Boolean; override; function CreateBreakPoints: TDBGBreakPoints; override; - function CreateLocals: TDBGLocals; override; + function CreateLocals: TLocalsSupplier; override; function CreateLineInfo: TDBGLineInfo; override; function CreateRegisters: TDBGRegisters; override; function CreateCallStack: TCallStackSupplier; override; @@ -388,7 +388,6 @@ type procedure ClearCommandQueue; procedure DoState(const OldState: TDBGState); override; procedure DoThreadChanged; - procedure DoCallStackChanged; property TargetPID: Integer read FTargetInfo.TargetPID; property TargetPtrSize: Byte read FTargetInfo.TargetPtrSize; property TargetFlags: TGDBMITargetFlags read FTargetInfo.TargetFlags write FTargetInfo.TargetFlags; @@ -580,36 +579,26 @@ type TGDBMIDebuggerCommandLocals = class(TGDBMIDebuggerCommand) private - FResult: TStringList; + FLocals: TCurrentLocals; protected function DoExecute: Boolean; override; public - constructor Create(AOwner: TGDBMIDebugger); - destructor Destroy; override; + constructor Create(AOwner: TGDBMIDebugger; ALocals: TCurrentLocals); function DebugText: String; override; - property Result: TStringList read FResult; end; { TGDBMILocals } - TGDBMILocals = class(TDBGLocals) + TGDBMILocals = class(TLocalsSupplier) private - FEvaluatedState: TGDBMIEvaluationState; - FEvaluationCmdObj: TGDBMIDebuggerCommandLocals; - FInLocalsNeeded: Boolean; - FLocals: TStringList; - procedure LocalsNeeded; - procedure CancelEvaluation; + FCommandList: TList; + procedure CancelEvaluation; deprecated; procedure DoEvaluationDestroyed(Sender: TObject); - procedure DoEvaluationFinished(Sender: TObject); protected - procedure DoStateChange(const AOldState: TDBGState); override; - procedure Invalidate; - function GetCount: Integer; override; - function GetName(const AnIndex: Integer): String; override; - function GetValue(const AnIndex: Integer): String; override; + procedure CancelAllCommands; + procedure RequestData(ALocals: TCurrentLocals); override; public - procedure Changed; override; + procedure Changed; constructor Create(const ADebugger: TDebugger); destructor Destroy; override; end; @@ -1160,7 +1149,7 @@ type {%endregion ^^^^^ Disassembler ^^^^^ } - {%region ***** Register ***** } + {%region ***** Threads ***** } { TGDBMIDebuggerCommandThreads } @@ -1221,7 +1210,7 @@ type procedure DoStateChange(const AOldState: TDBGState); override; end; - {%endregion ^^^^^ Register ^^^^^ } + {%endregion ^^^^^ Threads ^^^^^ } {%region ***** TGDBMIExpression ***** } @@ -5271,7 +5260,7 @@ begin Result := TGDBMIDisassembler.Create(Self); end; -function TGDBMIDebugger.CreateLocals: TDBGLocals; +function TGDBMIDebugger.CreateLocals: TLocalsSupplier; begin Result := TGDBMILocals.Create(Self); end; @@ -5397,15 +5386,9 @@ end; procedure TGDBMIDebugger.DoThreadChanged; begin TGDBMICallstack(CallStack).DoThreadChanged; - TGDBMILocals(Locals).Changed; TGDBMIRegisters(Registers).Changed; end; -procedure TGDBMIDebugger.DoCallStackChanged; -begin - TGDBMILocals(Locals).Changed; -end; - procedure TGDBMIDebugger.DoRelease; begin SetState(dsDestroying); @@ -7197,7 +7180,7 @@ function TGDBMIDebuggerCommandLocals.DoExecute: Boolean; else Value := '''' + GetText(addr) + ''''; end; - FResult.Add(Name + '=' + Value); + FLocals.Add(Name, Value); end; FreeAndNil(List); FreeAndNil(LocList); @@ -7208,6 +7191,7 @@ var List: TGDBMINameValueList; begin Result := True; + FLocals.Clear; // args ExecuteCommand('-stack-list-arguments 1 %0:d %0:d', [FTheDebugger.FCurrentStackFrame], R); @@ -7226,18 +7210,13 @@ begin AddLocals(List.Values['locals']); FreeAndNil(List); end; + FLocals.SetDataValidity(ddsValid); end; -constructor TGDBMIDebuggerCommandLocals.Create(AOwner: TGDBMIDebugger); +constructor TGDBMIDebuggerCommandLocals.Create(AOwner: TGDBMIDebugger; ALocals: TCurrentLocals); begin inherited Create(AOwner); - FResult := TStringList.Create; -end; - -destructor TGDBMIDebuggerCommandLocals.Destroy; -begin - inherited Destroy; - FreeAndNil(FResult); + FLocals := ALocals; end; function TGDBMIDebuggerCommandLocals.DebugText: String; @@ -7251,134 +7230,62 @@ end; procedure TGDBMILocals.Changed; begin - Invalidate; - inherited Changed; + if Monitor <> nil + then Monitor.Clear; end; constructor TGDBMILocals.Create(const ADebugger: TDebugger); begin - FLocals := TStringList.Create; - FLocals.Sorted := True; - FEvaluatedState := esInvalid; - FEvaluationCmdObj := nil; + FCommandList := TList.Create; inherited; end; destructor TGDBMILocals.Destroy; begin - CancelEvaluation; + CancelAllCommands; inherited; - FreeAndNil(FLocals); + FreeAndNil(FCommandList); end; -procedure TGDBMILocals.DoStateChange(const AOldState: TDBGState); +procedure TGDBMILocals.CancelAllCommands; +var + i: Integer; begin - if (Debugger <> nil) - and (Debugger.State = dsPause) - then begin - DoChange; - end - else begin - Invalidate; - end; + for i := 0 to FCommandList.Count-1 do + with TGDBMIDebuggerCommandStack(FCommandList[i]) do begin + OnExecuted := nil; + OnDestroy := nil; + Cancel; + end; + FCommandList.Clear; end; -procedure TGDBMILocals.Invalidate; +procedure TGDBMILocals.RequestData(ALocals: TCurrentLocals); +var + ForceQueue: Boolean; + EvaluationCmdObj: TGDBMIDebuggerCommandLocals; begin - FEvaluatedState := esInvalid; - CancelEvaluation; - FLocals.Clear; -end; + if (Debugger = nil) or (Debugger.State <> dsPause) then Exit; -function TGDBMILocals.GetCount: Integer; -begin - if (Debugger <> nil) - and (Debugger.State = dsPause) - then begin - LocalsNeeded; - if FEvaluatedState = esValid - then Result := FLocals.Count - else Result := 0; - end - else Result := 0; -end; - -function TGDBMILocals.GetName(const AnIndex: Integer): String; -begin - if (Debugger <> nil) - and (Debugger.State = dsPause) - then begin - LocalsNeeded; - Result := FLocals.Names[AnIndex]; - end - else Result := ''; -end; - -function TGDBMILocals.GetValue(const AnIndex: Integer): String; -begin - if (Debugger <> nil) - and (Debugger.State = dsPause) - then begin - LocalsNeeded; - Result := FLocals[AnIndex]; - Result := GetPart('=', '', Result); - end - else Result := ''; + EvaluationCmdObj := TGDBMIDebuggerCommandLocals.Create(TGDBMIDebugger(Debugger), ALocals); + EvaluationCmdObj.OnDestroy := @DoEvaluationDestroyed; + EvaluationCmdObj.Priority := GDCMD_PRIOR_LOCALS; + EvaluationCmdObj.Properties := [dcpCancelOnRun]; + ForceQueue := (TGDBMIDebugger(Debugger).FCurrentCommand <> nil) + and (TGDBMIDebugger(Debugger).FCurrentCommand is TGDBMIDebuggerCommandExecute) + and (not TGDBMIDebuggerCommandExecute(TGDBMIDebugger(Debugger).FCurrentCommand).NextExecQueued); + FCommandList.add(EvaluationCmdObj); + TGDBMIDebugger(Debugger).QueueCommand(EvaluationCmdObj, ForceQueue); + (* DoEvaluationFinished may be called immediately at this point *) end; procedure TGDBMILocals.DoEvaluationDestroyed(Sender: TObject); begin - if FEvaluationCmdObj = Sender - then FEvaluationCmdObj := nil; -end; - -procedure TGDBMILocals.DoEvaluationFinished(Sender: TObject); -var - Cmd: TGDBMIDebuggerCommandLocals; -begin - FLocals.Clear; - FEvaluatedState := esValid; - FEvaluationCmdObj := nil; - Cmd := TGDBMIDebuggerCommandLocals(Sender); - FLocals.Assign(Cmd.Result); - // Do not recursively call, whoever is requesting the locals - if not FInLocalsNeeded - then inherited Changed; -end; - -procedure TGDBMILocals.LocalsNeeded; -var - ForceQueue: Boolean; -begin - if Debugger = nil then Exit; - if FEvaluatedState in [esRequested, esValid] then Exit; - - FLocals.Clear; - FInLocalsNeeded := True; - FEvaluatedState := esRequested; - FEvaluationCmdObj := TGDBMIDebuggerCommandLocals.Create(TGDBMIDebugger(Debugger)); - FEvaluationCmdObj.OnExecuted := @DoEvaluationFinished; - FEvaluationCmdObj.OnDestroy := @DoEvaluationDestroyed; - FEvaluationCmdObj.Priority := GDCMD_PRIOR_LOCALS; - FEvaluationCmdObj.Properties := [dcpCancelOnRun]; - ForceQueue := (TGDBMIDebugger(Debugger).FCurrentCommand <> nil) - and (TGDBMIDebugger(Debugger).FCurrentCommand is TGDBMIDebuggerCommandExecute) - and (not TGDBMIDebuggerCommandExecute(TGDBMIDebugger(Debugger).FCurrentCommand).NextExecQueued); - TGDBMIDebugger(Debugger).QueueCommand(FEvaluationCmdObj, ForceQueue); - (* DoEvaluationFinished may be called immediately at this point *) - FInLocalsNeeded := False; + FCommandList.Remove(Sender); end; procedure TGDBMILocals.CancelEvaluation; begin - FEvaluatedState := esInvalid; - if FEvaluationCmdObj <> nil - then begin - FEvaluationCmdObj.OnExecuted := nil;; - FEvaluationCmdObj.OnDestroy := nil;; - FEvaluationCmdObj.Cancel; - end; - FEvaluationCmdObj := nil; end; {%endregion ^^^^^ BreakPoints ^^^^^ } @@ -7839,7 +7746,6 @@ end; procedure TGDBMICallStack.DoSetIndexCommandExecuted(Sender: TObject); begin TGDBMIDebugger(Debugger).FCurrentStackFrame := TGDBMIDebuggerCommandStackSetCurrent(Sender).NewCurrent; - TGDBMIDebugger(Debugger).DoCallStackChanged; TGDBMIDebuggerCommandStackSetCurrent(Sender).Callstack.CurrentIndex := TGDBMIDebuggerCommandStackSetCurrent(Sender).NewCurrent; end; diff --git a/debugger/localsdlg.pp b/debugger/localsdlg.pp index 86ca0289cb..fb7e020c4f 100644 --- a/debugger/localsdlg.pp +++ b/debugger/localsdlg.pp @@ -40,13 +40,25 @@ uses ComCtrls, Debugger, DebuggerDlg; type + + { TLocalsDlg } + TLocalsDlg = class(TDebuggerDlg) lvLocals: TListView; private - FLocals: TIDELocals; - FLocalsNotification: TIDELocalsNotification; + FCallStackMonitor: TCallStackMonitor; + FLocalsMonitor: TLocalsMonitor; + FLocalsNotification: TLocalsNotification; + FThreadsMonitor: TThreadsMonitor; + FThreadsNotification: TThreadsNotification; + FCallstackNotification: TCallStackNotification; + procedure ContextChanged(Sender: TObject); procedure LocalsChanged(Sender: TObject); - procedure SetLocals(const AValue: TIDELocals); + procedure SetCallStackMonitor(const AValue: TCallStackMonitor); + procedure SetLocals(const AValue: TLocalsMonitor); + procedure SetThreadsMonitor(const AValue: TThreadsMonitor); + function GetThreadId: Integer; + function GetStackframe: Integer; protected procedure DoBeginUpdate; override; procedure DoEndUpdate; override; @@ -54,7 +66,9 @@ type constructor Create(AOwner: TComponent); override; destructor Destroy; override; - property Locals: TIDELocals read FLocals write SetLocals; + property LocalsMonitor: TLocalsMonitor read FLocalsMonitor write SetLocals; + property ThreadsMonitor: TThreadsMonitor read FThreadsMonitor write SetThreadsMonitor; + property CallStackMonitor: TCallStackMonitor read FCallStackMonitor write SetCallStackMonitor; end; @@ -70,9 +84,18 @@ uses constructor TLocalsDlg.Create(AOwner: TComponent); begin inherited Create(AOwner); - FLocalsNotification := TIDELocalsNotification.Create; + FLocalsNotification := TLocalsNotification.Create; FLocalsNotification.AddReference; FLocalsNotification.OnChange := @LocalsChanged; + + FThreadsNotification := TThreadsNotification.Create; + FThreadsNotification.AddReference; + FThreadsNotification.OnCurrent := @ContextChanged; + + FCallstackNotification := TCallStackNotification.Create; + FCallstackNotification.AddReference; + FCallstackNotification.OnCurrent := @ContextChanged; + Caption:= lisLocals; lvLocals.Columns[0].Caption:= lisLocalsDlgName; lvLocals.Columns[1].Caption:= lisLocalsDlgValue; @@ -83,26 +106,48 @@ begin SetLocals(nil); FLocalsNotification.OnChange := nil; FLocalsNotification.ReleaseReference; + FThreadsNotification.OnCurrent := nil; + FThreadsNotification.ReleaseReference; + FCallstackNotification.OnCurrent := nil; + FCallstackNotification.ReleaseReference; inherited Destroy; end; +procedure TLocalsDlg.ContextChanged(Sender: TObject); +begin + LocalsChanged(nil); +end; + procedure TLocalsDlg.LocalsChanged(Sender: TObject); var n, idx: Integer; List: TStringList; Item: TListItem; S: String; + Locals: TLocals; begin + if (FThreadsMonitor = nil) or (FCallStackMonitor = nil) then begin + lvLocals.Items.Clear; + exit; + end; + if GetStackframe < 0 then begin // TODO need dedicated validity property + lvLocals.Items.Clear; + exit; + end; + List := TStringList.Create; try BeginUpdate; try - if FLocals = nil + if FLocalsMonitor <> nil + then Locals := LocalsMonitor.CurrentLocalsList[GetThreadId, GetStackframe] + else Locals := nil; + if Locals = nil then begin lvLocals.Items.Clear; Exit; end; - + //Get existing items for n := 0 to lvLocals.Items.Count - 1 do begin @@ -113,20 +158,20 @@ begin end; // add/update entries - for n := 0 to FLocals.Count - 1 do + for n := 0 to Locals.Count - 1 do begin - idx := List.IndexOf(Uppercase(FLocals.Names[n])); + idx := List.IndexOf(Uppercase(Locals.Names[n])); if idx = -1 then begin // New entry Item := lvLocals.Items.Add; - Item.Caption := FLocals.Names[n]; - Item.SubItems.Add(FLocals.Values[n]); + Item.Caption := Locals.Names[n]; + Item.SubItems.Add(Locals.Values[n]); end else begin // Existing entry Item := TListItem(List.Objects[idx]); - Item.SubItems[0] := FLocals.Values[n]; + Item.SubItems[0] := Locals.Values[n]; List.Delete(idx); end; end; @@ -143,30 +188,82 @@ begin end; end; -procedure TLocalsDlg.SetLocals(const AValue: TIDELocals); +procedure TLocalsDlg.SetCallStackMonitor(const AValue: TCallStackMonitor); begin - if FLocals = AValue then Exit; - + if FCallStackMonitor = AValue then exit; BeginUpdate; try - if FLocals <> nil - then begin - FLocals.RemoveNotification(FLocalsNotification); - end; + if FCallStackMonitor <> nil + then FCallStackMonitor.RemoveNotification(FCallstackNotification); - FLocals := AValue; + FCallStackMonitor := AValue; - if FLocals <> nil - then begin - FLocals.AddNotification(FLocalsNotification); - end; - - LocalsChanged(FLocals); + if FCallStackMonitor <> nil + then FCallStackMonitor.AddNotification(FCallstackNotification); + + LocalsChanged(nil); finally EndUpdate; end; end; +procedure TLocalsDlg.SetLocals(const AValue: TLocalsMonitor); +begin + if FLocalsMonitor = AValue then Exit; + + BeginUpdate; + try + if FLocalsMonitor <> nil + then begin + FLocalsMonitor.RemoveNotification(FLocalsNotification); + end; + + FLocalsMonitor := AValue; + + if FLocalsMonitor <> nil + then begin + FLocalsMonitor.AddNotification(FLocalsNotification); + end; + + LocalsChanged(FLocalsMonitor); + finally + EndUpdate; + end; +end; + +procedure TLocalsDlg.SetThreadsMonitor(const AValue: TThreadsMonitor); +begin + if FThreadsMonitor = AValue then exit; + BeginUpdate; + try + if FThreadsMonitor <> nil + then FThreadsMonitor.RemoveNotification(FThreadsNotification); + + FThreadsMonitor := AValue; + + if FThreadsMonitor <> nil + then FThreadsMonitor.AddNotification(FThreadsNotification); + + LocalsChanged(nil); + finally + EndUpdate; + end; +end; + +function TLocalsDlg.GetThreadId: Integer; +begin + Result := -1; + if (FThreadsMonitor = nil) then exit; + Result := FThreadsMonitor.CurrentThreads.CurrentThreadId; +end; + +function TLocalsDlg.GetStackframe: Integer; +begin + Result := -1; + if (FCallStackMonitor = nil) then exit; + Result := FCallStackMonitor.CurrentCallStackList.EntriesForThreads[GetThreadId].CurrentIndex; +end; + procedure TLocalsDlg.DoBeginUpdate; begin lvLocals.BeginUpdate; diff --git a/debugger/test/Gdbmi/testbase.pas b/debugger/test/Gdbmi/testbase.pas index 0cb2e969f0..a174c9a8e9 100644 --- a/debugger/test/Gdbmi/testbase.pas +++ b/debugger/test/Gdbmi/testbase.pas @@ -177,7 +177,7 @@ type FSignals: TIDESignals; //FBreakPoints: TIDEBreakPoints; //FBreakPointGroups: TIDEBreakPointGroups; - FLocals: TIDELocals; + FLocals: TLocalsMonitor; FLineInfo: TIDELineInfo; FWatches: TWatchesMonitor; FThreads: TThreadsMonitor; @@ -223,7 +223,7 @@ type property Exceptions: TIDEExceptions read FExceptions; // A list of exceptions we should ignore property CallStack: TCallStackMonitor read FCallStack; property Disassembler: TIDEDisassembler read FDisassembler; - property Locals: TIDELocals read FLocals; + property Locals: TLocalsMonitor read FLocals; property LineInfo: TIDELineInfo read FLineInfo; property Registers: TIDERegisters read FRegisters; property Signals: TIDESignals read FSignals; // A list of actions for signals we know of @@ -377,7 +377,7 @@ begin FThreads := TThreadsMonitor.Create; FExceptions := TIDEExceptions.Create; FSignals := TIDESignals.Create; - FLocals := TIDELocals.Create; + FLocals := TLocalsMonitor.Create; FLineInfo := TIDELineInfo.Create; FCallStack := TCallStackMonitor.Create; FDisassembler := TIDEDisassembler.Create; @@ -388,7 +388,7 @@ begin //TManagedBreakpoints(FBreakpoints).Master := FDebugger.BreakPoints; FWatches.Supplier := Result.Watches; FThreads.Supplier := Result.Threads; - FLocals.Master := Result.Locals; + FLocals.Supplier := Result.Locals; FLineInfo.Master := Result.LineInfo; FCallStack.Supplier := Result.CallStack; FDisassembler.Master := Result.Disassembler; @@ -412,7 +412,7 @@ begin //TManagedBreakpoints(FBreakpoints).Master := nil; FWatches.Supplier := nil; FThreads.Supplier := nil; - FLocals.Master := nil; + FLocals.Supplier := nil; FLineInfo.Master := nil; FCallStack.Supplier := nil; FDisassembler.Master := nil; diff --git a/debugger/test/Gdbmi/testdisass.pas b/debugger/test/Gdbmi/testdisass.pas index edd072cd8e..c01906cd95 100644 --- a/debugger/test/Gdbmi/testdisass.pas +++ b/debugger/test/Gdbmi/testdisass.pas @@ -47,7 +47,7 @@ type FSignals: TIDESignals; //FBreakPoints: TIDEBreakPoints; //FBreakPointGroups: TIDEBreakPointGroups; - FLocals: TIDELocals; + FLocals: TLocalsMonitor; FLineInfo: TIDELineInfo; FWatches: TWatchesMonitor; FThreads: TThreadsMonitor; @@ -339,7 +339,7 @@ var FThreads := TThreadsMonitor.Create; FExceptions := TIDEExceptions.Create; FSignals := TIDESignals.Create; - FLocals := TIDELocals.Create; + FLocals := TLocalsMonitor.Create; FLineInfo := TIDELineInfo.Create; FCallStack := TCallStackMonitor.Create; FRegisters := TIDERegisters.Create; @@ -347,7 +347,7 @@ var //TManagedBreakpoints(FBreakpoints).Master := FDebugger.BreakPoints; FWatches.Supplier := Gdb.Watches; FThreads.Supplier := Gdb.Threads; - FLocals.Master := Gdb.Locals; + FLocals.Supplier := Gdb.Locals; FLineInfo.Master := Gdb.LineInfo; FCallStack.Supplier := Gdb.CallStack; FExceptions.Master := Gdb.Exceptions; diff --git a/ide/basedebugmanager.pas b/ide/basedebugmanager.pas index 4ec1b1cedd..ca29b54dc0 100644 --- a/ide/basedebugmanager.pas +++ b/ide/basedebugmanager.pas @@ -89,7 +89,7 @@ type FSignals: TIDESignals; FBreakPoints: TIDEBreakPoints; FBreakPointGroups: TIDEBreakPointGroups; - FLocals: TIDELocals; + FLocals: TLocalsMonitor; FLineInfo: TIDELineInfo; FWatches: TWatchesMonitor; FThreads: TThreadsMonitor; @@ -173,7 +173,7 @@ type property Exceptions: TIDEExceptions read FExceptions; // A list of exceptions we should ignore property CallStack: TCallStackMonitor read FCallStack; property Disassembler: TIDEDisassembler read FDisassembler; - property Locals: TIDELocals read FLocals; + property Locals: TLocalsMonitor read FLocals; property LineInfo: TIDELineInfo read FLineInfo; property Registers: TIDERegisters read FRegisters; property Signals: TIDESignals read FSignals; // A list of actions for signals we know of diff --git a/ide/debugmanager.pas b/ide/debugmanager.pas index 43872bca54..9bfdbff747 100644 --- a/ide/debugmanager.pas +++ b/ide/debugmanager.pas @@ -1199,7 +1199,9 @@ var TheDialog: TLocalsDlg; begin TheDialog := TLocalsDlg(FDialogs[ddtLocals]); - TheDialog.Locals := FLocals; + TheDialog.LocalsMonitor := FLocals; + TheDialog.ThreadsMonitor := FThreads; + TheDialog.CallStackMonitor := FCallStack; end; procedure TDebugManager.InitRegistersDlg; @@ -1270,7 +1272,7 @@ begin FThreads := TThreadsMonitor.Create; FExceptions := TProjectExceptions.Create; FSignals := TIDESignals.Create; - FLocals := TIDELocals.Create; + FLocals := TLocalsMonitor.Create; FLineInfo := TIDELineInfo.Create; FCallStack := TCallStackMonitor.Create; FDisassembler := TIDEDisassembler.Create; @@ -2281,7 +2283,7 @@ begin TManagedBreakpoints(FBreakpoints).Master := nil; FWatches.Supplier := nil; FThreads.Supplier := nil; - FLocals.Master := nil; + FLocals.Supplier := nil; FLineInfo.Master := nil; FCallStack.Supplier := nil; FDisassembler.Master := nil; @@ -2293,7 +2295,7 @@ begin TManagedBreakpoints(FBreakpoints).Master := FDebugger.BreakPoints; FWatches.Supplier := FDebugger.Watches; FThreads.Supplier := FDebugger.Threads; - FLocals.Master := FDebugger.Locals; + FLocals.Supplier := FDebugger.Locals; FLineInfo.Master := FDebugger.LineInfo; FCallStack.Supplier := FDebugger.CallStack; FDisassembler.Master := FDebugger.Disassembler;