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

Debugger: New interface for retrieving locals.

Browse Source
This commit is contained in:
Martin 2023-03-02 13:52:13 +01:00
parent 20bf681e0f
commit 179dc59dc6
12 changed files with 500 additions and 269 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

173
components/debuggerintf/dbgintfdebuggerbase.pp
View File

@ -161,7 +161,7 @@ type
procedure DoStateLeavePause; virtual;
procedure DoStateLeavePauseClean; virtual;
procedure DoStateChangeEx(const AOldState, ANewState: TDBGState); virtual;
property NotifiedState: TDBGState read FNotifiedState; // The last state seen by DoStateChange
// property NotifiedState: TDBGState read FNotifiedState; // The last state seen by DoStateChange
property OldState: TDBGState read FOldState; // The state before last DoStateChange
public
end;
@ -608,76 +608,14 @@ type
******************************************************************************
******************************************************************************}
// TODO: a more watch-like value object
TLocalsMonitor = class;
{ TLocalsValue }
TLocalsValue = class(TDbgEntityValue)
private
FName: String;
FValue: String;
protected
procedure DoAssign(AnOther: TDbgEntityValue); override;
public
property Name: String read FName;
property Value: String read FValue;
end;
{ TLocals }
TLocals = class(TDbgEntityValuesList)
private
function GetEntry(AnIndex: Integer): TLocalsValue;
function GetName(const AnIndex: Integer): String;
function GetValue(const AnIndex: Integer): String;
protected
function CreateEntry: TDbgEntityValue; override;
public
procedure Add(const AName, AValue: String);
procedure SetDataValidity({%H-}AValidity: TDebuggerDataState); virtual;
public
function Count: Integer;reintroduce; virtual;
property Entries[AnIndex: Integer]: TLocalsValue read GetEntry;
property Names[const AnIndex: Integer]: String read GetName;
property Values[const AnIndex: Integer]: String read GetValue;
end;
{ TLocalsList }
TLocalsList = class(TDbgEntitiesThreadStackList)
private
function GetEntry(AThreadId, AStackFrame: Integer): TLocals;
function GetEntryByIdx(AnIndex: Integer): TLocals;
protected
//function CreateEntry(AThreadId, AStackFrame: Integer): TDbgEntityValuesList; override;
public
property EntriesByIdx[AnIndex: Integer]: TLocals read GetEntryByIdx;
property Entries[AThreadId, AStackFrame: Integer]: TLocals read GetEntry; default;
end;
{ TLocalsSupplier }
TLocalsSupplier = class(TDebuggerDataSupplier)
private
function GetMonitor: TLocalsMonitor;
procedure SetMonitor(AValue: TLocalsMonitor);
property Monitor: TLocalsMonitor read GetMonitor write SetMonitor;
public
procedure TriggerInvalidateLocals;
procedure RequestData(ALocals: TLocals); virtual;
end;
{ TLocalsMonitor }
TLocalsMonitor = class(TDebuggerDataMonitor)
private
function GetSupplier: TLocalsSupplier;
procedure SetSupplier(AValue: TLocalsSupplier);
TLocalsSupplier = class(specialize TLocalsSupplierClassTemplate<TDebuggerDataSupplierBase>, TLocalsSupplierIntf)
protected
procedure InvalidateLocals; virtual;
procedure DoStateChange(const AOldState: TDBGState); virtual;
public
property Supplier: TLocalsSupplier read GetSupplier write SetSupplier;
destructor Destroy; override;
procedure RequestData(ALocalsList: TLocalsListIntf); virtual;
end;
{%endregion ^^^^^ Locals ^^^^^ }
@ -2626,70 +2564,6 @@ begin
ARegisters.SetDataValidity(ddsInvalid);
end;
{ TLocalsValue }
procedure TLocalsValue.DoAssign(AnOther: TDbgEntityValue);
begin
inherited DoAssign(AnOther);
FName := TLocalsValue(AnOther).FName;
FValue := TLocalsValue(AnOther).FValue;
end;
{ TLocalsListBase }
function TLocalsList.GetEntry(AThreadId, AStackFrame: Integer): TLocals;
begin
Result := TLocals(inherited Entries[AThreadId, AStackFrame]);
end;
function TLocalsList.GetEntryByIdx(AnIndex: Integer): TLocals;
begin
Result := TLocals(inherited EntriesByIdx[AnIndex]);
end;
{ TLocalsBase }
function TLocals.GetEntry(AnIndex: Integer): TLocalsValue;
begin
Result := TLocalsValue(inherited Entries[AnIndex]);
end;
function TLocals.GetName(const AnIndex: Integer): String;
begin
Result := Entries[AnIndex].Name;
end;
function TLocals.GetValue(const AnIndex: Integer): String;
begin
Result := Entries[AnIndex].Value;
end;
function TLocals.CreateEntry: TDbgEntityValue;
begin
Result := TLocalsValue.Create;
end;
procedure TLocals.Add(const AName, AValue: String);
var
v: TLocalsValue;
begin
assert(not Immutable, 'TLocalsBase.Add Immutable');
v := TLocalsValue(CreateEntry);
v.FName := AName;
v.FValue := AValue;
inherited Add(v);
end;
procedure TLocals.SetDataValidity(AValidity: TDebuggerDataState);
begin
//
end;
function TLocals.Count: Integer;
begin
Result := inherited Count;
end;
{ TRegisterDisplayValue }
function TRegisterDisplayValue.GetValue(ADispFormat: TRegisterDisplayFormat): String;
@ -4008,42 +3882,23 @@ end;
{ TLocalsSupplier }
function TLocalsSupplier.GetMonitor: TLocalsMonitor;
begin
Result := TLocalsMonitor(inherited Monitor);
end;
procedure TLocalsSupplier.SetMonitor(AValue: TLocalsMonitor);
begin
inherited Monitor := AValue;
end;
procedure TLocalsSupplier.TriggerInvalidateLocals;
procedure TLocalsSupplier.DoStateChange(const AOldState: TDBGState);
begin
if (Debugger = nil) then Exit;
DoStateChangeEx(AOldState, Debugger.State);
if Monitor <> nil then
Monitor.InvalidateLocals;
Monitor.DoStateChange(AOldState, Debugger.State);
end;
procedure TLocalsSupplier.RequestData(ALocals: TLocals);
destructor TLocalsSupplier.Destroy;
begin
ALocals.SetDataValidity(ddsInvalid)
inherited Destroy;
DoDestroy;
end;
{ TLocalsMonitor }
function TLocalsMonitor.GetSupplier: TLocalsSupplier;
procedure TLocalsSupplier.RequestData(ALocalsList: TLocalsListIntf);
begin
Result := TLocalsSupplier(inherited Supplier);
end;
procedure TLocalsMonitor.SetSupplier(AValue: TLocalsSupplier);
begin
inherited Supplier := AValue;
end;
procedure TLocalsMonitor.InvalidateLocals;
begin
//
ALocalsList.Validity := ddsInvalid;
end;
{ TBaseLineInfo }

24
components/lazdebuggergdbmi/gdbmidebugger.pp
View File

@ -894,7 +894,7 @@ type
procedure Changed;
constructor Create(const ADebugger: TDebuggerIntf);
destructor Destroy; override;
procedure RequestData(ALocals: TLocals); override;
procedure RequestData(ALocals: TLocalsListIntf); override;
end;
{ TGDBMIDebuggerBase }
@ -1224,7 +1224,7 @@ type
TGDBMIDebuggerCommandLocals = class(TGDBMIDebuggerCommand)
private
FLocals: TLocals;
FLocals: TLocalsListIntf;
protected
procedure DoLockQueueExecute; override;
procedure DoUnLockQueueExecute; override;
@ -1232,7 +1232,7 @@ type
procedure DoUnLockQueueExecuteForInstr; override;
function DoExecute: Boolean; override;
public
constructor Create(AOwner: TGDBMIDebuggerBase; ALocals: TLocals);
constructor Create(AOwner: TGDBMIDebuggerBase; ALocals: TLocalsListIntf);
destructor Destroy; override;
function DebugText: String; override;
end;
@ -11077,6 +11077,7 @@ function TGDBMIDebuggerCommandLocals.DoExecute: Boolean;
LocList, List: TGDBMINameValueList;
Item: PGDBMINameValue;
Name, Value: String;
r: TLzDbgWatchDataIntf;
begin
LocList := TGDBMINameValueList.Create(AParams);
List := TGDBMINameValueList.Create('');
@ -11129,7 +11130,8 @@ function TGDBMIDebuggerCommandLocals.DoExecute: Boolean;
else
Value := ProcessGDBResultStruct(Value, [prNoLeadingTab, prMakePrintAble, prStripAddressFromString]);
FLocals.Add(Name, Value);
r := FLocals.Add(Name);
r.CreatePrePrinted(Value);
end;
FreeAndNil(List);
FreeAndNil(LocList);
@ -11146,7 +11148,6 @@ begin
FContext.StackContext := ccUseLocal;
FContext.StackFrame := FLocals.StackFrame;
FLocals.Clear;
// args
ExecuteCommand('-stack-list-arguments 1 %0:d %0:d',
[FTheDebugger.FCurrentStackFrame], R, [cfNoStackContext]);
@ -11165,19 +11166,20 @@ begin
AddLocals(List.Values['locals']);
FreeAndNil(List);
end;
FLocals.SetDataValidity(ddsValid);
FLocals.Validity := ddsValid;
end;
constructor TGDBMIDebuggerCommandLocals.Create(AOwner: TGDBMIDebuggerBase; ALocals: TLocals);
constructor TGDBMIDebuggerCommandLocals.Create(AOwner: TGDBMIDebuggerBase;
ALocals: TLocalsListIntf);
begin
inherited Create(AOwner);
FLocals := ALocals;
FLocals.AddReference;
FLocals.BeginUpdate;
end;
destructor TGDBMIDebuggerCommandLocals.Destroy;
begin
ReleaseRefAndNil(FLocals);
FLocals.EndUpdate;
inherited Destroy;
end;
@ -11192,7 +11194,7 @@ end;
procedure TGDBMILocals.Changed;
begin
TriggerInvalidateLocals;
TriggerInvalidateLocalsValues;
end;
constructor TGDBMILocals.Create(const ADebugger: TDebuggerIntf);
@ -11229,7 +11231,7 @@ begin
and (Debugger.State <> dsInternalPause);
end;
procedure TGDBMILocals.RequestData(ALocals: TLocals);
procedure TGDBMILocals.RequestData(ALocals: TLocalsListIntf);
var
EvaluationCmdObj: TGDBMIDebuggerCommandLocals;
begin

27
components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas
View File

@ -116,13 +116,13 @@ type
TFpThreadWorkerLocalsUpdate = class(TFpThreadWorkerLocals)
private
FLocals: TLocals;
FLocals: TLocalsListIntf;
procedure DoLocalsFreed_DecRef(Sender: TObject);
protected
procedure UpdateLocals_DecRef(Data: PtrInt = 0); override;
procedure DoRemovedFromLinkedList; override; // _DecRef
public
constructor Create(ADebugger: TFpDebugDebuggerBase; ALocals: TLocals);
constructor Create(ADebugger: TFpDebugDebuggerBase; ALocals: TLocalsListIntf);
end;
{ TFpThreadWorkerModifyUpdate }
@ -528,7 +528,7 @@ type
procedure DoStateLeavePause; override;
public
destructor Destroy; override;
procedure RequestData(ALocals: TLocals); override;
procedure RequestData(ALocals: TLocalsListIntf); override;
end;
{ TFPRegisters }
@ -683,7 +683,7 @@ begin
FDebugger.OnFeedback(self, 'Failed to modify value', '', ftError, [frOk]);
end;
//
FDebugger.Locals.TriggerInvalidateLocals;
FDebugger.Locals.TriggerInvalidateLocalsValues;
FDebugger.Watches.TriggerInvalidateWatchValues;
FDebugger.CallStack.CurrentCallStackList.Clear;
@ -998,24 +998,27 @@ var
i: Integer;
r: TResultEntry;
dbg: TFpDebugDebugger;
rv: TLzDbgWatchDataIntf;
begin
assert(system.ThreadID = classes.MainThreadID, 'TFpThreadWorkerLocals.UpdateLocals_DecRef: system.ThreadID = classes.MainThreadID');
if FLocals <> nil then begin
FLocals.RemoveFreeNotification(@DoLocalsFreed_DecRef);
FLocals.Clear;
if FResults = nil then begin
FLocals.SetDataValidity(ddsInvalid);
FLocals.Validity := ddsInvalid;
FLocals := nil;
UnQueue_DecRef;
exit;
end;
FLocals.BeginUpdate;
for i := 0 to FResults.Count - 1 do begin
r := FResults[i];
FLocals.Add(r.Name, r.Value);
rv := FLocals.Add(r.Name);
rv.CreatePrePrinted(r.Value);
end;
FLocals.SetDataValidity(ddsValid);
FLocals.Validity := ddsValid;
FLocals.EndUpdate;
FLocals := nil;
end;
@ -1034,7 +1037,7 @@ begin
end
else begin
FLocals.RemoveFreeNotification(@DoLocalsFreed_DecRef);
FLocals.SetDataValidity(ddsInvalid);
FLocals.Validity := ddsInvalid;
end;
FLocals := nil;
end;
@ -1042,7 +1045,7 @@ begin
end;
constructor TFpThreadWorkerLocalsUpdate.Create(ADebugger: TFpDebugDebuggerBase;
ALocals: TLocals);
ALocals: TLocalsListIntf);
begin
// Runs in IDE thread (TThread.Queue)
assert(system.ThreadID = classes.MainThreadID, 'TFpThreadWorkerLocals.Create: system.ThreadID = classes.MainThreadID');
@ -1875,12 +1878,12 @@ begin
inherited Destroy;
end;
procedure TFPLocals.RequestData(ALocals: TLocals);
procedure TFPLocals.RequestData(ALocals: TLocalsListIntf);
var
WorkItem: TFpThreadWorkerLocalsUpdate;
begin
if not FpDebugger.IsPausedAndValid then begin
ALocals.SetDataValidity(ddsInvalid);
ALocals.Validity := ddsInvalid;
exit;
end;

25
components/lazdebuggers/lazdebuggerfpdserver/fpdserverdebugger.pas
View File

@ -212,12 +212,12 @@ type
TFPDSendLocalsCommand = class(TFPDSendCommand)
private
FLocals: TLocals;
FLocals: TLocalsListIntf;
procedure DoLocalsFreed(Sender: TObject);
protected
procedure ComposeJSon(AJsonObject: TJSONObject); override;
public
constructor create(ALocals: TLocals);
constructor create(ALocals: TLocalsListIntf);
destructor Destroy; override;
procedure DoOnCommandSuccesfull(ACommandResponse: TJSonObject); override;
procedure DoOnCommandFailed(ACommandResponse: TJSonObject); override;
@ -383,7 +383,7 @@ type
TFPLocals = class(TLocalsSupplier)
public
procedure RequestData(ALocals: TLocals); override;
procedure RequestData(ALocals: TLocalsListIntf); override;
end;
{ TFPRegisters }
@ -511,7 +511,7 @@ begin
AJsonObject.Add('command','locals');
end;
constructor TFPDSendLocalsCommand.create(ALocals: TLocals);
constructor TFPDSendLocalsCommand.create(ALocals: TLocalsListIntf);
begin
inherited create(True);
ALocals.AddFreeNotification(@DoLocalsFreed);
@ -530,39 +530,42 @@ var
JSonLocalsArr: TJSONArray;
JSonLocalsEntryObj: TJSONObject;
i: Integer;
r: TLzDbgWatchDataIntf;
begin
inherited DoOnCommandSuccesfull(ACommandResponse);
if assigned(FLocals) then
begin
FLocals.Clear;
FLocals.BeginUpdate;
JSonLocalsArr := ACommandResponse.Get('locals', TJSONArray(nil));
if assigned(JSonLocalsArr) and (JSonLocalsArr.Count>0) then
begin
for i := 0 to JSonLocalsArr.Count - 1 do
begin
JSonLocalsEntryObj := JSonLocalsArr.Items[i] as TJSONObject;
FLocals.Add(JSonLocalsEntryObj.Get('name', ''), JSonLocalsEntryObj.Get('value', ''));
r := FLocals.Add(JSonLocalsEntryObj.Get('name', ''));
r.CreatePrePrinted(JSonLocalsEntryObj.Get('value', ''));
end;
end;
FLocals.SetDataValidity(ddsValid);
FLocals.Validity := ddsValid;
FLocals.EndUpdate;
end;
end;
procedure TFPDSendLocalsCommand.DoOnCommandFailed(ACommandResponse: TJSonObject);
begin
FLocals.SetDataValidity(ddsInvalid);
FLocals.Validity := ddsInvalid;
end;
procedure TFPLocals.RequestData(ALocals: TLocals);
procedure TFPLocals.RequestData(ALocals: TLocalsListIntf);
begin
if (Debugger = nil) or not(Debugger.State = dsPause)
then begin
ALocals.SetDataValidity(ddsInvalid);
ALocals.Validity := ddsInvalid;
exit;
end;
TFPDServerDebugger(Debugger).QueueCommand(TFPDSendLocalsCommand.create(ALocals));
ALocals.SetDataValidity(ddsRequested);
ALocals.Validity := ddsRequested;
end;
{ TFPDBGDisassembler }

30
components/lazdebuggers/lazdebuggerfpgdbmi/fpgdbmidebugger.pp
View File

@ -172,25 +172,25 @@ type
TFpGDBMIDebuggerCommandLocals = class(TGDBMIDebuggerCommand)
private
FOwner: TFPGDBMILocals;
FLocals: TLocals;
FLocals: TLocalsListIntf;
procedure DoLocalsFreed(Sender: TObject);
protected
function DoExecute: Boolean; override;
procedure DoLockQueueExecute; override;
procedure DoUnLockQueueExecute; override;
public
constructor Create(AOwner: TFPGDBMILocals; ALocals: TLocals);
constructor Create(AOwner: TFPGDBMILocals; ALocals: TLocalsListIntf);
end;
{ TFPGDBMILocals }
TFPGDBMILocals = class(TGDBMILocals)
private
procedure ProcessLocals(ALocals: TLocals);
procedure ProcessLocals(ALocals: TLocalsListIntf);
protected
function FpDebugger: TFpGDBMIDebugger;
public
procedure RequestData(ALocals: TLocals); override;
procedure RequestData(ALocals: TLocalsListIntf); override;
end;
{ TFpGDBMILineInfo }
@ -224,7 +224,7 @@ begin
if (CurrentDebugger <> nil) and (CurrentDebugger.Watches <> nil) then
CurrentDebugger.Watches.TriggerInvalidateWatchValues;
if (CurrentDebugger <> nil) and (CurrentDebugger.Locals <> nil) then
CurrentDebugger.Locals.TriggerInvalidateLocals;
CurrentDebugger.Locals.TriggerInvalidateLocalsValues;
end;
{ TFpGDBMIDebuggerCommandLocals }
@ -253,7 +253,8 @@ begin
//
end;
constructor TFpGDBMIDebuggerCommandLocals.Create(AOwner: TFPGDBMILocals; ALocals: TLocals);
constructor TFpGDBMIDebuggerCommandLocals.Create(AOwner: TFPGDBMILocals;
ALocals: TLocalsListIntf);
begin
inherited Create(AOwner.FpDebugger);
FOwner := AOwner;
@ -264,32 +265,33 @@ end;
{ TFPGDBMILocals }
procedure TFPGDBMILocals.ProcessLocals(ALocals: TLocals);
procedure TFPGDBMILocals.ProcessLocals(ALocals: TLocalsListIntf);
var
Ctx: TFpDbgSymbolScope;
ProcVal: TFpValue;
i: Integer;
m: TFpValue;
n, v: String;
r: TLzDbgWatchDataIntf;
begin
FpDebugger.LockUnLoadDwarf;
try
Ctx := FpDebugger.GetInfoContextForContext(ALocals.ThreadId, ALocals.StackFrame);
if (Ctx = nil) or (Ctx.SymbolAtAddress = nil) then begin
ALocals.SetDataValidity(ddsInvalid);
ALocals.Validity := ddsInvalid;
exit;
end;
ProcVal := Ctx.ProcedureAtAddress;
if (ProcVal = nil) then begin
ALocals.SetDataValidity(ddsInvalid);
ALocals.Validity := ddsInvalid;
exit;
end;
FpDebugger.FPrettyPrinter.AddressSize := ctx.SizeOfAddress;
FpDebugger.FPrettyPrinter.Context := ctx.LocationContext;
ALocals.Clear;
ALocals.BeginUpdate;
for i := 0 to ProcVal.MemberCount - 1 do begin
m := ProcVal.Member[i];
if m <> nil then begin
@ -299,11 +301,13 @@ begin
n := '';
FpDebugger.FPrettyPrinter.PrintValue(v, m);
m.ReleaseReference;
ALocals.Add(n, v);
r := ALocals.Add(n);
r.CreatePrePrinted(v);
end;
end;
ProcVal.ReleaseReference;
ALocals.SetDataValidity(ddsValid);
ALocals.Validity := ddsValid;
ALocals.EndUpdate;
finally
FpDebugger.UnLockUnLoadDwarf;
end;
@ -314,7 +318,7 @@ begin
Result := TFpGDBMIDebugger(Debugger);
end;
procedure TFPGDBMILocals.RequestData(ALocals: TLocals);
procedure TFPGDBMILocals.RequestData(ALocals: TLocalsListIntf);
var
LocalsCmdObj: TFpGDBMIDebuggerCommandLocals;
begin

32
components/lazdebuggers/lazdebuggerfplldb/fplldbdebugger.pas
View File

@ -226,13 +226,13 @@ type
TFpLldbDebuggerCommandLocals = class(TLldbDebuggerCommand)
private
FOwner: TFPLldbLocals;
FLocals: TLocals;
FLocals: TLocalsListIntf;
procedure DoLocalsFreed(Sender: TObject);
protected
procedure DoExecute; override;
procedure DoCancel; override;
public
constructor Create(AOwner: TFPLldbLocals; ALocals: TLocals);
constructor Create(AOwner: TFPLldbLocals; ALocals: TLocalsListIntf);
end;
{ TFPLldbLocals }
@ -240,12 +240,12 @@ type
TFPLldbLocals = class(TLocalsSupplier)
private
FLocalsEvalCancel: Boolean;
procedure ProcessLocals(ALocals: TLocals);
procedure ProcessLocals(ALocals: TLocalsListIntf);
protected
function FpDebugger: TFpLldbDebugger;
procedure DoStateChange(const AOldState: TDBGState); override;
public
procedure RequestData(ALocals: TLocals); override;
procedure RequestData(ALocals: TLocalsListIntf); override;
end;
{ TFpLldbLineInfo }
@ -392,7 +392,8 @@ begin
TFpLldbDebugger(Debugger).MemReader.Enabled := False;
end;
constructor TFpLldbDebuggerCommandLocals.Create(AOwner: TFPLldbLocals; ALocals: TLocals);
constructor TFpLldbDebuggerCommandLocals.Create(AOwner: TFPLldbLocals;
ALocals: TLocalsListIntf);
begin
inherited Create(AOwner.FpDebugger);
FOwner := AOwner;
@ -404,16 +405,17 @@ end;
{ TFPLldbLocals }
procedure TFPLldbLocals.ProcessLocals(ALocals: TLocals);
procedure TFPLldbLocals.ProcessLocals(ALocals: TLocalsListIntf);
var
Ctx: TFpDbgSymbolScope;
ProcVal: TFpValue;
i: Integer;
m: TFpValue;
n, v: String;
r: TLzDbgWatchDataIntf;
begin
if FLocalsEvalCancel then begin
ALocals.SetDataValidity(ddsInvalid);
ALocals.Validity := ddsInvalid;
exit;
end;
@ -422,23 +424,23 @@ begin
ProcVal := nil;
try
if (Ctx = nil) or (Ctx.SymbolAtAddress = nil) then begin
ALocals.SetDataValidity(ddsInvalid);
ALocals.Validity := ddsInvalid;
exit;
end;
ProcVal := Ctx.ProcedureAtAddress;
if (ProcVal = nil) then begin
ALocals.SetDataValidity(ddsInvalid);
ALocals.Validity := ddsInvalid;
exit;
end;
FpDebugger.FPrettyPrinter.AddressSize := ctx.SizeOfAddress;
FpDebugger.FPrettyPrinter.Context := ctx.LocationContext;
ALocals.Clear;
ALocals.BeginUpdate;
for i := 0 to ProcVal.MemberCount - 1 do begin
if FLocalsEvalCancel then begin
ALocals.SetDataValidity(ddsInvalid);
ALocals.Validity := ddsInvalid;
exit;
end;
m := ProcVal.Member[i];
@ -449,10 +451,12 @@ begin
n := '';
FpDebugger.FPrettyPrinter.PrintValue(v, m);
m.ReleaseReference;
ALocals.Add(n, v);
r := ALocals.Add(n);
r.CreatePrePrinted(v);
end;
end;
ALocals.SetDataValidity(ddsValid);
ALocals.Validity := ddsValid;
ALocals.EndUpdate;
finally
Ctx.ReleaseReference;
ProcVal.ReleaseReference;
@ -471,7 +475,7 @@ begin
FLocalsEvalCancel := False;
end;
procedure TFPLldbLocals.RequestData(ALocals: TLocals);
procedure TFPLldbLocals.RequestData(ALocals: TLocalsListIntf);
var
LocalsCmdObj: TFpLldbDebuggerCommandLocals;
begin

28
components/lazdebuggers/lazdebuggerintf/lazdebuggerintf.pas
View File

@ -285,6 +285,34 @@ type
{%endregion ^^^^^ Watches ^^^^^ }
{%region ^^^^^ Locals ^^^^^ }
TLocalsListIntf = interface(TDbgDataRequestIntf)
function Add(AName: String): TLzDbgWatchDataIntf;
function GetStackFrame: Integer;
function GetThreadId: Integer;
procedure SetValidity(AValue: TDebuggerDataState);
property ThreadId: Integer read GetThreadId;
property StackFrame: Integer read GetStackFrame;
property Validity: TDebuggerDataState {read GetValidity} write SetValidity;
end;
TLocalsSupplierIntf = interface;
TLocalsMonitorIntf = interface(specialize TInternalDbgMonitorIntf<TLocalsSupplierIntf>)
procedure InvalidateLocalValues;
procedure DoStateChange(const AOldState, ANewState: TDBGState); //deprecated;
end;
TLocalsSupplierIntf = interface(specialize TInternalDbgSupplierIntf<TLocalsMonitorIntf>)
procedure RequestData(ALocalsList: TLocalsListIntf);
end;
{%endregion ^^^^^ Locals ^^^^^ }
implementation

85
components/lazdebuggers/lazdebuggerintf/lazdebuggertemplate.pas
View File

@ -31,15 +31,21 @@ type
generic TDbgDataRequestTemplateBase<_BASE: TObject; _SENDER_INTF: TDbgDataRequestIntf> = class(_BASE)
private type
TDbgDataRequestEventList = specialize TFPGList<TDbgDataRequestEvent>;
private
strict private
FEventLists: array [TDbgDataRequestEventType] of TDbgDataRequestEventList;
FUpdateCount: Integer;
function GetIsUpdating: boolean; inline;
protected
procedure AddNotification(AnEventType: TDbgDataRequestEventType; AnEvent: TDbgDataRequestEvent);
procedure RemoveNotification(AnEventType: TDbgDataRequestEventType; AnEvent: TDbgDataRequestEvent);
procedure CallNotifications(AnEventType: TDbgDataRequestEventType; AnEventData: TDbgDataRequestEventData);
procedure BeginUpdate; virtual;
procedure EndUpdate; virtual;
procedure BeginUpdate;
procedure EndUpdate;
procedure DoBeginUpdating; virtual;
procedure DoEndUpdating; virtual;
property UpdateCount: Integer read FUpdateCount;
property IsUpdating: boolean read GetIsUpdating;
procedure DoDestroy; // FPC can not compile "destructor Destroy; override;"
end;
@ -50,7 +56,7 @@ type
= class(specialize TDbgDataRequestTemplateBase<_BASE, _SENDER_INTF>, TDbgDataRequestIntf)
private type
TNotifyEventList = specialize TFPGList<TNotifyEvent>;
private
strict private
FFreeNotifyList: TNotifyEventList;
protected
procedure AddFreeNotification(ANotification: TNotifyEvent);
@ -127,10 +133,38 @@ type
procedure TriggerInvalidateWatchValues; virtual;
end;
{ TLocalsMonitorClassTemplate }
generic TLocalsMonitorClassTemplate<_BASE: TObject> = class(
specialize TInternalDbgMonitorBase<_BASE, TLocalsMonitorIntf, TLocalsSupplierIntf>,
TLocalsMonitorIntf
)
protected
procedure InvalidateLocalValues; virtual;
procedure DoStateChange(const AOldState, ANewState: TDBGState); virtual; // deprecated;
end;
{ TLocalsSupplierClassTemplate }
generic TLocalsSupplierClassTemplate<_BASE: TObject> = class(
specialize TInternalDbgSupplierBase<_BASE, TLocalsSupplierIntf, TLocalsMonitorIntf>,
TLocalsSupplierIntf
)
protected
public
procedure RequestData(ALocalsList: TLocalsListIntf); virtual;
procedure TriggerInvalidateLocalsValues; virtual;
end;
implementation
{ TDbgDataRequestTemplateBase }
function TDbgDataRequestTemplateBase.GetIsUpdating: boolean;
begin
Result := FUpdateCount > 0;
end;
procedure TDbgDataRequestTemplateBase.AddNotification(
AnEventType: TDbgDataRequestEventType; AnEvent: TDbgDataRequestEvent);
begin
@ -163,10 +197,24 @@ end;
procedure TDbgDataRequestTemplateBase.BeginUpdate;
begin
//
inc(FUpdateCount);
if FUpdateCount = 1 then
DoBeginUpdating;
end;
procedure TDbgDataRequestTemplateBase.EndUpdate;
begin
dec(FUpdateCount);
if FUpdateCount = 0 then
DoEndUpdating;
end;
procedure TDbgDataRequestTemplateBase.DoBeginUpdating;
begin
//
end;
procedure TDbgDataRequestTemplateBase.DoEndUpdating;
begin
//
end;
@ -294,6 +342,33 @@ begin
Monitor.InvalidateWatchValues;
end;
{ TLocalsMonitorClassTemplate }
procedure TLocalsMonitorClassTemplate.InvalidateLocalValues;
begin
//
end;
procedure TLocalsMonitorClassTemplate.DoStateChange(const AOldState,
ANewState: TDBGState);
begin
//
end;
{ TLocalsSupplierClassTemplate }
procedure TLocalsSupplierClassTemplate.RequestData(ALocalsList: TLocalsListIntf
);
begin
ALocalsList.Validity := ddsError;
end;
procedure TLocalsSupplierClassTemplate.TriggerInvalidateLocalsValues;
begin
if (Self <> nil) and (Monitor <> nil) then
Monitor.InvalidateLocalValues;
end;
end.

19
components/lazdebuggers/lazdebuggerlldb/lldbdebugger.pas
View File

@ -198,14 +198,14 @@ type
TLldbDebuggerCommandLocals = class(TLldbDebuggerCommand)
private
FLocals: TLocals;
FLocals: TLocalsListIntf;
FLocalsInstr: TLldbInstructionLocals;
procedure DoLocalsFreed(Sender: TObject);
procedure LocalsInstructionFinished(Sender: TObject);
protected
procedure DoExecute; override;
public
constructor Create(AOwner: TLldbDebugger; ALocals: TLocals);
constructor Create(AOwner: TLldbDebugger; ALocals: TLocalsListIntf);
destructor Destroy; override;
end;
@ -478,7 +478,7 @@ type
TLldbLocals = class(TLocalsSupplier)
public
procedure RequestData(ALocals: TLocals); override;
procedure RequestData(ALocals: TLocalsListIntf); override;
end;
{%endregion ^^^^^ Locals ^^^^^ }
@ -1301,14 +1301,17 @@ procedure TLldbDebuggerCommandLocals.LocalsInstructionFinished(Sender: TObject
var
n: String;
i: Integer;
r: TLzDbgWatchDataIntf;
begin
if FLocals <> nil then begin
FLocals.Clear;
FLocals.BeginUpdate;
for i := 0 to FLocalsInstr.Res.Count - 1 do begin
n := FLocalsInstr.Res.Names[i];
FLocals.Add(n, FLocalsInstr.Res.Values[n]);
r := FLocals.Add(n);
r.CreatePrePrinted(FLocalsInstr.Res.Values[n]);
end;
FLocals.SetDataValidity(ddsValid);
FLocals.Validity := ddsValid;
FLocals.EndUpdate;
end;
ReleaseRefAndNil(FLocalsInstr);
@ -1343,7 +1346,7 @@ begin
end;
constructor TLldbDebuggerCommandLocals.Create(AOwner: TLldbDebugger;
ALocals: TLocals);
ALocals: TLocalsListIntf);
begin
FLocals := ALocals;
FLocals.AddFreeNotification(@DoLocalsFreed);
@ -1670,7 +1673,7 @@ end;
{ TLldbLocals }
procedure TLldbLocals.RequestData(ALocals: TLocals);
procedure TLldbLocals.RequestData(ALocals: TLocalsListIntf);
var
Cmd: TLldbDebuggerCommandLocals;
begin

2
components/lazdebuggers/lazdebugtestbase/ttestdbgexecuteables.pas
View File

@ -8,7 +8,7 @@ uses
Classes, SysUtils, fgl, TestDbgConfig, TestDbgCompilerProcess,
TestOutputLogger, TTestDebuggerClasses, TestCommonSources, LazDebuggerIntf,
LazDebuggerIntfBaseTypes, LazFileUtils, LazLoggerBase, FileUtil,
LazStringUtils, DbgIntfDebuggerBase, fpcunit;
LazStringUtils, DbgIntfDebuggerBase, IdeDebuggerBase, fpcunit;
type

177
ide/packages/idedebugger/debugger.pp
View File

@ -753,12 +753,13 @@ type
private
FCurrentResData: TCurrentResData;
FCurrentBackEndExpression: String;
FUpdateCount: Integer;
// FUpdateCount: Integer;
FDbgBackendConverter: TIdeDbgValueConvertSelector;
protected
(* TWatchValueIntf *)
procedure BeginUpdate; reintroduce;
procedure EndUpdate; reintroduce;
procedure DoBeginUpdating; override;
procedure DoEndUpdating; override;
function ResData: TLzDbgWatchDataIntf;
function GetDbgValConverter: TLazDbgValueConvertSelectorIntf;
private
@ -930,16 +931,30 @@ type
{ TCurrentLocals }
TCurrentLocals = class(TIDELocals)
TCurrentLocals = class(specialize TDbgDataRequestTemplateBase<TIDELocals, TLocalsListIntf>, TLocalsListIntf)
private
FMonitor: TIdeLocalsMonitor;
FSnapShot: TIDELocals;
FDataValidity: TDebuggerDataState;
procedure SetSnapShot(const AValue: TIDELocals);
private
(* TLocalsListIntf *)
FCurrentResName: String;
FCurrentResData: TCurrentResData;
FCurrentResList: TRefCntObjList;
FCurrentValidity: TDebuggerDataState;
function GetStackFrame: Integer;
function GetThreadId: Integer;
procedure DoBeginUpdating; override;
procedure DoEndUpdating; override;
procedure SetValidity(AValue: TDebuggerDataState);
function Add(AName: String): TLzDbgWatchDataIntf; overload;
procedure FinishCurrentRes;
protected
property SnapShot: TIDELocals read FSnapShot write SetSnapShot;
public
constructor Create(AMonitor: TIdeLocalsMonitor; AThreadId, AStackFrame: Integer);
destructor Destroy; override;
function Count: Integer; override;
procedure SetDataValidity(AValidity: TDebuggerDataState); override;
end;
@ -996,7 +1011,7 @@ type
procedure DoStateEnterPause; override;
procedure DoStateLeavePause; override;
procedure DoStateLeavePauseClean; override;
procedure InvalidateLocals; override;
procedure InvalidateLocalValues; override;
procedure NotifyChange(ALocals: TCurrentLocals);
procedure DoNewSupplier; override;
procedure RequestData(ALocals: TCurrentLocals);
@ -3149,9 +3164,9 @@ begin
Clear;
end;
procedure TIdeLocalsMonitor.InvalidateLocals;
procedure TIdeLocalsMonitor.InvalidateLocalValues;
begin
inherited InvalidateLocals;
inherited InvalidateLocalValues;
if FLocalsList <> nil then
FLocalsList.Clear;
end;
@ -3938,47 +3953,44 @@ end;
{ TCurrentWatchValue }
procedure TCurrentWatchValue.BeginUpdate;
procedure TCurrentWatchValue.DoBeginUpdating;
begin
AddReference;
if FUpdateCount = 0 then
FCurrentBackEndExpression := GetBackendExpression;
inc(FUpdateCount);
FCurrentBackEndExpression := GetBackendExpression;
end;
procedure TCurrentWatchValue.EndUpdate;
procedure TCurrentWatchValue.DoEndUpdating;
var
NewValid: TDebuggerDataState;
begin
//assert(Validity = ddsRequested, 'TCurrentWatchValue.EndUpdate: Validity = ddsRequested');
dec(FUpdateCount);
if (FUpdateCount = 0) then begin
NewValid := ddsValid;
NewValid := ddsValid;
FCurrentResData := FCurrentResData.RootResultData;
if (FCurrentResData <> nil) and (FCurrentResData.FNewResultData <> nil) then begin
FCurrentResData.Done;
SetResultData(FCurrentResData.FNewResultData);
FCurrentResData := FCurrentResData.RootResultData;
if (FCurrentResData <> nil) and (FCurrentResData.FNewResultData <> nil) then begin
FCurrentResData.Done;
SetResultData(FCurrentResData.FNewResultData);
FCurrentResData.FNewResultData := nil;
if ResultData.ValueKind = rdkError then
NewValid := ddsError;
if ResultData.ValueKind = rdkError then
NewValid := ddsError;
FreeAndNil(FCurrentResData);
end
else
NewValid := ddsInvalid;
FreeAndNil(FCurrentResData);
end
else
NewValid := ddsInvalid;
if Validity = ddsRequested then
SetValidity(NewValid)
else
DoDataValidityChanged(ddsRequested);
if Validity = ddsRequested then
SetValidity(NewValid)
else
DoDataValidityChanged(ddsRequested);
end;
ReleaseReference; // Last statemnet, may call Destroy
end;
function TCurrentWatchValue.ResData: TLzDbgWatchDataIntf;
begin
assert(FUpdateCount > 0, 'TCurrentWatchValue.ResData: FUpdateCount > 0');
assert(UpdateCount > 0, 'TCurrentWatchValue.ResData: FUpdateCount > 0');
if FCurrentResData = nil then
FCurrentResData := TCurrentResData.Create;
Result := FCurrentResData;
@ -4013,7 +4025,7 @@ end;
function TCurrentWatchValue.GetBackendExpression: String;
begin
if FUpdateCount > 0 then
if UpdateCount > 0 then
Result := FCurrentBackEndExpression
else
Result := inherited GetBackendExpression;
@ -4021,7 +4033,7 @@ end;
function TCurrentWatchValue.GetValidity: TDebuggerDataState;
begin
if FUpdateCount > 0 then
if UpdateCount > 0 then
Result := ddsRequested // prevent reading FValue
else
Result := inherited GetValidity;
@ -4047,7 +4059,7 @@ end;
procedure TCurrentWatchValue.DoDataValidityChanged(AnOldValidity: TDebuggerDataState);
begin
if FUpdateCount > 0 then
if UpdateCount > 0 then
exit;
if Validity = ddsRequested then exit;
if Watch <> nil then
@ -4063,7 +4075,7 @@ destructor TCurrentWatchValue.Destroy;
var
e: TMethodList;
begin
assert(FUpdateCount=0, 'TCurrentWatchValue.Destroy: FUpdateCount=0');
assert(UpdateCount=0, 'TCurrentWatchValue.Destroy: FUpdateCount=0');
FCurrentResData := FCurrentResData.RootResultData;
if (FCurrentResData <> nil) and (FResultData = nil) then
FCurrentResData.FreeResultAndSubData;
@ -7041,6 +7053,87 @@ begin
then FSnapShot.Assign(Self);
end;
function TCurrentLocals.GetStackFrame: Integer;
begin
Result := StackFrame;
end;
function TCurrentLocals.GetThreadId: Integer;
begin
Result := ThreadId;
end;
procedure TCurrentLocals.DoBeginUpdating;
begin
AddReference;
Clear;
if (FCurrentResList = nil) then
FCurrentResList := TRefCntObjList.Create
else
FCurrentResList.Clear;
FCurrentValidity := ddsValid;
end;
procedure TCurrentLocals.DoEndUpdating;
var
i: Integer;
begin
FinishCurrentRes;
for i := 0 to FCurrentResList.Count - 1 do
Add(TLocalsValue(FCurrentResList[i]));
FCurrentResList.Clear;
SetDataValidity(FCurrentValidity);
ReleaseReference;
end;
procedure TCurrentLocals.SetValidity(AValue: TDebuggerDataState);
begin
if UpdateCount > 0 then begin
FCurrentValidity := AValue;
end
else begin
if AValue <> ddsValid then
Clear
else
if FCurrentResData <> nil then
FinishCurrentRes;
SetDataValidity(AValue);
end;
end;
function TCurrentLocals.Add(AName: String): TLzDbgWatchDataIntf;
begin
FinishCurrentRes;
FCurrentResName := AName;
FCurrentResData := TCurrentResData.Create;
Result := FCurrentResData;
end;
procedure TCurrentLocals.FinishCurrentRes;
var
v: TLocalsValue;
begin
FCurrentResData := FCurrentResData.RootResultData;
// TODO: maybe create an error entry, if only FNewResultData is missing
if (FCurrentResData = nil) or (FCurrentResData.FNewResultData = nil) then
exit;
FCurrentResData.Done;
v := TLocalsValue(CreateEntry);
v.Init(FCurrentResName, FCurrentResData.FNewResultData);
FCurrentResData.FNewResultData := nil;
if IsUpdating then
FCurrentResList.Add(v)
else
Add(v);
FreeAndNil(FCurrentResData);
end;
constructor TCurrentLocals.Create(AMonitor: TIdeLocalsMonitor; AThreadId, AStackFrame: Integer);
begin
FMonitor := AMonitor;
@ -7048,6 +7141,20 @@ begin
inherited Create(AThreadId, AStackFrame);
end;
destructor TCurrentLocals.Destroy;
begin
inherited Destroy;
FCurrentResData := FCurrentResData.RootResultData;
if (FCurrentResData <> nil) {and (FResultData = nil)} then
FCurrentResData.FreeResultAndSubData;
FCurrentResData.Free;
FCurrentResList.Free;
DoDestroy;
end;
function TCurrentLocals.Count: Integer;
begin
case FDataValidity of

147
ide/packages/idedebugger/idedebuggerbase.pas
View File

@ -191,6 +191,64 @@ type
destructor Destroy; override;
end;
{ TLocalsValue }
TLocalsValue = class(TDbgEntityValue)
private
FName: String;
FValue: String;
protected
procedure DoAssign(AnOther: TDbgEntityValue); override;
public
procedure Init(AName: String; AValue: TWatchResultData);
property Name: String read FName;
property Value: String read FValue;
end;
{ TLocals }
TLocals = class(TDbgEntityValuesList)
private
function GetEntry(AnIndex: Integer): TLocalsValue;
function GetName(const AnIndex: Integer): String;
function GetValue(const AnIndex: Integer): String;
protected
function CreateEntry: TDbgEntityValue; override;
public
procedure Add(const AName, AValue: String); overload; deprecated;
procedure SetDataValidity({%H-}AValidity: TDebuggerDataState); virtual;
public
function Count: Integer;reintroduce; virtual;
property Entries[AnIndex: Integer]: TLocalsValue read GetEntry;
property Names[const AnIndex: Integer]: String read GetName;
property Values[const AnIndex: Integer]: String read GetValue;
end;
{ TLocalsList }
TLocalsList = class(TDbgEntitiesThreadStackList)
private
function GetEntry(AThreadId, AStackFrame: Integer): TLocals;
function GetEntryByIdx(AnIndex: Integer): TLocals;
protected
//function CreateEntry(AThreadId, AStackFrame: Integer): TDbgEntityValuesList; override;
public
property EntriesByIdx[AnIndex: Integer]: TLocals read GetEntryByIdx;
property Entries[AThreadId, AStackFrame: Integer]: TLocals read GetEntry; default;
end;
{ TLocalsMonitor }
TLocalsMonitor = class(specialize TLocalsMonitorClassTemplate<TDebuggerDataHandler>, TLocalsMonitorIntf)
protected
procedure DoStateChange(const AOldState, ANewState: TDBGState); reintroduce;
// from TDebuggerDataMonitor
procedure DoModified; virtual; // user-modified / xml-storable data modified
public
destructor Destroy; override;
end;
implementation
var
@ -866,6 +924,95 @@ begin
inherited Destroy;
end;
{ TLocalsValue }
procedure TLocalsValue.DoAssign(AnOther: TDbgEntityValue);
begin
inherited DoAssign(AnOther);
FName := TLocalsValue(AnOther).FName;
FValue := TLocalsValue(AnOther).FValue;
end;
procedure TLocalsValue.Init(AName: String; AValue: TWatchResultData);
begin
FName := AName;
FValue := AValue.AsString;
AValue.Free;
end;
{ TLocalsList }
function TLocalsList.GetEntry(AThreadId, AStackFrame: Integer): TLocals;
begin
Result := TLocals(inherited Entries[AThreadId, AStackFrame]);
end;
function TLocalsList.GetEntryByIdx(AnIndex: Integer): TLocals;
begin
Result := TLocals(inherited EntriesByIdx[AnIndex]);
end;
{ TLocals }
function TLocals.GetEntry(AnIndex: Integer): TLocalsValue;
begin
Result := TLocalsValue(inherited Entries[AnIndex]);
end;
function TLocals.GetName(const AnIndex: Integer): String;
begin
Result := Entries[AnIndex].Name;
end;
function TLocals.GetValue(const AnIndex: Integer): String;
begin
Result := Entries[AnIndex].Value;
end;
function TLocals.CreateEntry: TDbgEntityValue;
begin
Result := TLocalsValue.Create;
end;
procedure TLocals.Add(const AName, AValue: String);
var
v: TLocalsValue;
begin
assert(not Immutable, 'TLocalsBase.Add Immutable');
v := TLocalsValue(CreateEntry);
v.FName := AName;
v.FValue := AValue;
inherited Add(v);
end;
procedure TLocals.SetDataValidity(AValidity: TDebuggerDataState);
begin
//
end;
function TLocals.Count: Integer;
begin
Result := inherited Count;
end;
{ TLocalsMonitor }
procedure TLocalsMonitor.DoStateChange(const AOldState, ANewState: TDBGState);
begin
DoStateChangeEx(AOldState, ANewState);
end;
procedure TLocalsMonitor.DoModified;
begin
//
end;
destructor TLocalsMonitor.Destroy;
begin
inherited Destroy;
DoDestroy;
end;
initialization
DBG_DATA_MONITORS := DebugLogger.FindOrRegisterLogGroup('DBG_DATA_MONITORS' {$IFDEF DBG_DATA_MONITORS} , True {$ENDIF} );