paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-10 03:48:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

Debugger: refactor register

Browse Source 
git-svn-id: trunk@44216 -
This commit is contained in:
martin 2014-02-24 01:44:49 +00:00
parent 1bdd42363f
commit ed539caf03
9 changed files with 1035 additions and 933 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

671
components/debuggerintf/dbgintfdebuggerbase.pp
View File

@ -182,14 +182,20 @@ type
TDebuggerDataMonitor = class
private
FSupplier: TDebuggerDataSupplier;
FUpdateCount: Integer;
procedure SetSupplier(const AValue: TDebuggerDataSupplier);
protected
procedure DoModified; virtual; // user-modified / xml-storable data modified
procedure DoNewSupplier; virtual;
property Supplier: TDebuggerDataSupplier read FSupplier write SetSupplier;
procedure DoStateChange(const {%H-}AOldState, {%H-}ANewState: TDBGState); virtual;
procedure DoBeginUpdate; virtual;
procedure DoEndUpdate; virtual;
function IsUpdating: Boolean;
public
destructor Destroy; override;
procedure BeginUpdate;
procedure EndUpdate;
end;
{ TDebuggerDataSupplier }
@ -216,6 +222,8 @@ type
public
constructor Create(const ADebugger: TDebuggerIntf);
destructor Destroy; override;
procedure BeginUpdate;
procedure EndUpdate;
end;
{$region Breakpoints **********************************************************}
@ -657,8 +665,9 @@ type
private
FName: String;
FValue: String;
public
protected
procedure DoAssign(AnOther: TDbgEntityValue); override;
public
property Name: String read FName;
property Value: String read FValue;
end;
@ -763,80 +772,106 @@ type
******************************************************************************
******************************************************************************}
TRegisterDisplayFormat =
(rdDefault, rdHex, rdBinary, rdOctal, rdDecimal, rdRaw
);
TRegisterDisplayFormat = (rdDefault, rdHex, rdBinary, rdOctal, rdDecimal, rdRaw);
TRegisterDisplayFormats = set of TRegisterDisplayFormat;
TRegistersFormat = record
Name: String;
Format: TRegisterDisplayFormat;
end;
{ TRegisterDisplayValue }
{ TRegistersFormatList }
TRegisterDisplayValue = class // Only created if ddsValid
private
FStringValue: String; // default, rdRaw is always in FStringValue
FNumValue: QWord;
FSize: Integer; // 2, 4 or 8 bytes
FFlags: set of (rdvHasNum); // Calculate numeric values.
FSupportedDispFormats: TRegisterDisplayFormats;
function GetValue(ADispFormat: TRegisterDisplayFormat): String;
public
procedure Assign(AnOther: TRegisterDisplayValue);
procedure SetAsNum(AValue: QWord; ASize: Integer);
procedure SetAsText(AValue: String);
procedure AddFormats(AFormats: TRegisterDisplayFormats);
property SupportedDispFormats: TRegisterDisplayFormats read FSupportedDispFormats;
property Value[ADispFormat: TRegisterDisplayFormat]: String read GetValue;
end;
TRegistersFormatList = class
{ TRegisterValue }
TRegisterValue = class(TDbgEntityValue)
private
FDataValidity: TDebuggerDataState;
FDisplayFormat: TRegisterDisplayFormat;
FModified: Boolean;
FName: String;
FValues: Array of TRegisterDisplayValue;
function GetHasValue: Boolean;
function GetHasValueFormat(ADispFormat: TRegisterDisplayFormat): Boolean;
function GetValue: String;
function GetValueObj: TRegisterDisplayValue;
function GetValueObjFormat(ADispFormat: TRegisterDisplayFormat): TRegisterDisplayValue;
procedure SetDisplayFormat(AValue: TRegisterDisplayFormat);
procedure SetValue(AValue: String);
function GetValueObject(ACreateNew: Boolean = False): TRegisterDisplayValue;
function GetValueObject(ADispFormat: TRegisterDisplayFormat; ACreateNew: Boolean = False): TRegisterDisplayValue;
procedure SetDataValidity(AValidity: TDebuggerDataState);
procedure ClearDispValues;
protected
procedure DoAssign(AnOther: TDbgEntityValue); override;
procedure DoDataValidityChanged({%H-}AnOldValidity: TDebuggerDataState); virtual;
procedure DoDisplayFormatChanged({%H-}AnOldFormat: TRegisterDisplayFormat); virtual;
procedure DoValueNotEvaluated; virtual;
public
destructor Destroy; override;
property Name: String read FName;
property Value: String read GetValue write SetValue;
property DisplayFormat: TRegisterDisplayFormat read FDisplayFormat write SetDisplayFormat;
property Modified: Boolean read FModified write FModified;
property DataValidity: TDebuggerDataState read FDataValidity write SetDataValidity;
property ValueObj: TRegisterDisplayValue read GetValueObj; // Will create the object for current DispFormat. Only use for setting data.
property HasValue: Boolean read GetHasValue;
property ValueObjFormat[ADispFormat: TRegisterDisplayFormat]: TRegisterDisplayValue read GetValueObjFormat; // Will create the object for current DispFormat. Only use for setting data.
property HasValueFormat[ADispFormat: TRegisterDisplayFormat]: Boolean read GetHasValueFormat;
end;
{ TRegisters }
TRegisters = class(TDbgEntityValuesList)
private
FCount: integer;
FFormats: array of TRegistersFormat;
function GetFormat(AName: String): TRegisterDisplayFormat;
procedure SetFormat(AName: String; AValue: TRegisterDisplayFormat);
FDataValidity: TDebuggerDataState;
function GetEntry(AnIndex: Integer): TRegisterValue;
function GetEntryByName(const AName: String): TRegisterValue;
procedure SetDataValidity(AValue: TDebuggerDataState);
protected
function IndexOf(const AName: String): integer;
function Add(const AName: String; AFormat: TRegisterDisplayFormat): integer;
property Count: Integer read FCount;
function CreateEntry: TDbgEntityValue; override;
procedure DoDataValidityChanged({%H-}AnOldValidity: TDebuggerDataState); virtual;
public
constructor Create;
procedure Clear;
property Format[AName: String]: TRegisterDisplayFormat read GetFormat write SetFormat; default;
function Count: Integer; reintroduce; virtual;
property Entries[AnIndex: Integer]: TRegisterValue read GetEntry; default;
property EntriesByName[const AName: String]: TRegisterValue read GetEntryByName; // autocreate
property DataValidity: TDebuggerDataState read FDataValidity write SetDataValidity;
end;
{ TBaseRegisters }
{ TRegistersList }
TBaseRegisters = class(TObject)
protected
FUpdateCount: Integer;
FFormatList: TRegistersFormatList;
function GetModified(const {%H-}AnIndex: Integer): Boolean; virtual;
function GetName(const {%H-}AnIndex: Integer): String; virtual;
function GetValue(const {%H-}AnIndex: Integer): String; virtual;
function GetFormat(const AnIndex: Integer): TRegisterDisplayFormat;
procedure SetFormat(const AnIndex: Integer; const AValue: TRegisterDisplayFormat); virtual;
procedure ChangeUpdating; virtual;
function Updating: Boolean;
public
property FormatList: TRegistersFormatList read FFormatList write FFormatList;
public
constructor Create;
function Count: Integer; virtual;
public
procedure BeginUpdate;
procedure EndUpdate;
property Modified[const AnIndex: Integer]: Boolean read GetModified;
property Names[const AnIndex: Integer]: String read GetName;
property Values[const AnIndex: Integer]: String read GetValue;
property Formats[const AnIndex: Integer]: TRegisterDisplayFormat
read GetFormat write SetFormat;
end;
{ TDBGRegisters }
TDBGRegisters = class(TBaseRegisters)
TRegistersList = class(TDbgEntitiesThreadStackList)
private
FDebugger: TDebuggerIntf; // reference to our debugger
FOnChange: TNotifyEvent;
FChanged: Boolean;
function GetEntry(AThreadId, AStackFrame: Integer): TRegisters;
function GetEntryByIdx(AnIndex: Integer): TRegisters;
protected
procedure Changed; virtual;
procedure DoChange;
procedure DoStateChange(const {%H-}AOldState: TDBGState); virtual;
function GetCount: Integer; virtual;
procedure ChangeUpdating; override;
property Debugger: TDebuggerIntf read FDebugger write FDebugger;
public
procedure FormatChanged(const {%H-}AnIndex: Integer); virtual;
function Count: Integer; override;
constructor Create(const ADebugger: TDebuggerIntf);
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property EntriesByIdx[AnIndex: Integer]: TRegisters read GetEntryByIdx;
property Entries[AThreadId, AStackFrame: Integer]: TRegisters read GetEntry; default;
end;
{ TRegisterSupplier }
TRegisterSupplier = class(TDebuggerDataSupplier)
private
FCurrentRegistersList: TRegistersList;
protected
procedure DoNewMonitor; override;
public
procedure RequestData(ARegisters: TRegisters); virtual;
property CurrentRegistersList: TRegistersList read FCurrentRegistersList write FCurrentRegistersList;
end;
{%endregion ^^^^^ Register ^^^^^ }
@ -1393,6 +1428,8 @@ type
TDebuggerPropertiesClass= class of TDebuggerProperties;
{ TDebuggerIntf }
TDebuggerIntf = class
private
FArguments: String;
@ -1414,7 +1451,7 @@ type
FOnConsoleOutput: TDBGOutputEvent;
FOnFeedback: TDBGFeedbackEvent;
FOnIdle: TNotifyEvent;
FRegisters: TDBGRegisters;
FRegisters: TRegisterSupplier;
FShowConsole: Boolean;
FSignals: TDBGSignals;
FState: TDBGState;
@ -1444,7 +1481,7 @@ type
function CreateBreakPoints: TDBGBreakPoints; virtual;
function CreateLocals: TLocalsSupplier; virtual;
function CreateLineInfo: TDBGLineInfo; virtual;
function CreateRegisters: TDBGRegisters; virtual;
function CreateRegisters: TRegisterSupplier; virtual;
function CreateCallStack: TCallStackSupplier; virtual;
function CreateDisassembler: TDBGDisassembler; virtual;
function CreateWatches: TWatchesSupplier; virtual;
@ -1541,7 +1578,7 @@ type
property FileName: String read FFileName write SetFileName; // The name of the exe to be debugged
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 Registers: TRegisterSupplier read FRegisters; // list of all registers
property Signals: TDBGSignals read FSignals; // A list of actions for signals we know
property ShowConsole: Boolean read FShowConsole write FShowConsole; // Indicates if the debugger should create a console for the debuggee
property State: TDBGState read FState; // The current state of the debugger
@ -1724,6 +1761,19 @@ begin
end;
end;
{ TRegisterSupplier }
procedure TRegisterSupplier.DoNewMonitor;
begin
inherited DoNewMonitor;
FCurrentRegistersList := nil;
end;
procedure TRegisterSupplier.RequestData(ARegisters: TRegisters);
begin
ARegisters.SetDataValidity(ddsInvalid);
end;
{ TLocalsValue }
procedure TLocalsValue.DoAssign(AnOther: TDbgEntityValue);
@ -1783,6 +1833,272 @@ begin
Result := inherited Count;
end;
{ TRegisterDisplayValue }
function TRegisterDisplayValue.GetValue(ADispFormat: TRegisterDisplayFormat): String;
const Digits = '01234567';
function IntToBase(Val, Base: Integer): String;
var
M: Integer;
begin
Result := '';
case Base of
2: M := 1;
8: M := 7;
end;
while Val > 0 do begin
Result := Digits[1 + (Val and m)] + Result;
Val := Val div Base;
end;
end;
begin
Result := '';
if not(ADispFormat in FSupportedDispFormats) then exit;
if (ADispFormat in [rdDefault, rdRaw]) or not (rdvHasNum in FFlags) then begin
Result := FStringValue;
exit;
end;
case ADispFormat of
rdHex: Result := IntToHex(FNumValue, FSize * 2);
rdBinary: Result := IntToBase(FNumValue, 2);
rdOctal: Result := IntToBase(FNumValue, 8);
rdDecimal: Result := IntToStr(FNumValue);
end;
end;
procedure TRegisterDisplayValue.Assign(AnOther: TRegisterDisplayValue);
begin
FStringValue := AnOther.FStringValue;
FNumValue := AnOther.FNumValue;
FFlags := AnOther.FFlags;
FSize := AnOther.FSize;
FSupportedDispFormats := AnOther.FSupportedDispFormats;
end;
procedure TRegisterDisplayValue.SetAsNum(AValue: QWord; ASize: Integer);
begin
if FNumValue = AValue then Exit;
FNumValue := AValue;
FSize := ASize;
Include(FFlags, rdvHasNum);
end;
procedure TRegisterDisplayValue.SetAsText(AValue: String);
begin
FStringValue := AValue;
end;
procedure TRegisterDisplayValue.AddFormats(AFormats: TRegisterDisplayFormats);
begin
FSupportedDispFormats := FSupportedDispFormats + AFormats;
end;
{ TRegisterValue }
function TRegisterValue.GetValue: String;
var
v: TRegisterDisplayValue;
begin
v := GetValueObject();
if v <> nil then begin
Result := v.Value[FDisplayFormat];
exit;
end;
Result := '';
DoValueNotEvaluated;
end;
function TRegisterValue.GetHasValue: Boolean;
begin
Result := GetValueObject <> nil;
end;
function TRegisterValue.GetHasValueFormat(ADispFormat: TRegisterDisplayFormat): Boolean;
begin
Result := GetValueObject(ADispFormat) <> nil;
end;
function TRegisterValue.GetValueObj: TRegisterDisplayValue;
begin
Result := GetValueObject(True);
end;
function TRegisterValue.GetValueObjFormat(ADispFormat: TRegisterDisplayFormat): TRegisterDisplayValue;
begin
Result := GetValueObject(ADispFormat, True);
end;
procedure TRegisterValue.SetDisplayFormat(AValue: TRegisterDisplayFormat);
var
Old: TRegisterDisplayFormat;
begin
assert(not Immutable, 'TRegisterValue.SetDisplayFormat: not Immutable');
if FDisplayFormat = AValue then Exit;
Old := FDisplayFormat;
FDisplayFormat := AValue;
DoDisplayFormatChanged(Old);
end;
procedure TRegisterValue.SetValue(AValue: String);
var
v: TRegisterDisplayValue;
begin
assert(not Immutable, 'TRegisterValue.SetValue: not Immutable');
v := GetValueObject(True);
v.FStringValue := AValue;
end;
function TRegisterValue.GetValueObject(ACreateNew: Boolean): TRegisterDisplayValue;
begin
Result := GetValueObject(FDisplayFormat, ACreateNew);
end;
function TRegisterValue.GetValueObject(ADispFormat: TRegisterDisplayFormat;
ACreateNew: Boolean): TRegisterDisplayValue;
var
i: Integer;
begin
for i := 0 to length(FValues) - 1 do
if ADispFormat in FValues[i].SupportedDispFormats then begin
Result := FValues[i];
exit;
end;
if not ACreateNew then begin
Result := nil;
exit;
end;
assert(not Immutable, 'TRegisterValue.GetValueObject: not Immutable');
Result := TRegisterDisplayValue.Create;
Result.FSupportedDispFormats := [ADispFormat];
i := length(FValues);
SetLength(FValues, i + 1);
FValues[i] := Result;
end;
procedure TRegisterValue.SetDataValidity(AValidity: TDebuggerDataState);
var
Old: TDebuggerDataState;
begin
assert(not Immutable, 'TRegisterValue.SetDataValidity: not Immutable');
if FDataValidity = AValidity then exit;
Old := FDataValidity;
FDataValidity := AValidity;
DoDataValidityChanged(Old);
end;
procedure TRegisterValue.ClearDispValues;
var
i: Integer;
begin
for i := 0 to Length(FValues) - 1 do
FValues[i].Free;
FValues := nil;
end;
procedure TRegisterValue.DoAssign(AnOther: TDbgEntityValue);
var
i: Integer;
begin
inherited DoAssign(AnOther);
FDataValidity := TRegisterValue(AnOther).FDataValidity;
FDisplayFormat := TRegisterValue(AnOther).FDisplayFormat;
FName := TRegisterValue(AnOther).FName;
SetLength(FValues, length(TRegisterValue(AnOther).FValues));
for i := 0 to length(TRegisterValue(AnOther).FValues) - 1 do begin
FValues[i] := TRegisterDisplayValue.Create;
FValues[i].Assign(TRegisterValue(AnOther).FValues[i]);
end;
end;
procedure TRegisterValue.DoDataValidityChanged(AnOldValidity: TDebuggerDataState);
begin
//
end;
procedure TRegisterValue.DoDisplayFormatChanged(AnOldFormat: TRegisterDisplayFormat);
begin
//
end;
procedure TRegisterValue.DoValueNotEvaluated;
begin
//
end;
destructor TRegisterValue.Destroy;
begin
inherited Destroy;
ClearDispValues;
end;
{ TRegisters }
function TRegisters.GetEntry(AnIndex: Integer): TRegisterValue;
begin
Result := TRegisterValue(inherited Entries[AnIndex]);
end;
function TRegisters.GetEntryByName(const AName: String): TRegisterValue;
var
i: Integer;
begin
for i := 0 to Count - 1 do begin
Result := Entries[i];
if Result.Name = AName then
exit;
end;
assert(not Immutable, 'TRegisters.GetEntryByName: not Immutable');
Result := TRegisterValue(CreateEntry);
Result.FName := AName;
Add(Result);
end;
procedure TRegisters.SetDataValidity(AValue: TDebuggerDataState);
var
Old: TDebuggerDataState;
begin
assert(not Immutable, 'TRegisters.SetDataValidity: not Immutable');
if FDataValidity = AValue then Exit;
Old := FDataValidity;
FDataValidity := AValue;
DoDataValidityChanged(Old);
end;
function TRegisters.CreateEntry: TDbgEntityValue;
begin
assert(not Immutable, 'TRegisters.CreateEntry: not Immutable');
Result := TRegisterValue.Create;
end;
procedure TRegisters.DoDataValidityChanged(AnOldValidity: TDebuggerDataState);
begin
//
end;
function TRegisters.Count: Integer;
begin
if FDataValidity = ddsValid then
Result := inherited Count
else
Result := 0;
end;
{ TRegistersList }
function TRegistersList.GetEntry(AThreadId, AStackFrame: Integer): TRegisters;
begin
Result := TRegisters(inherited Entries[AThreadId, AStackFrame]);
end;
function TRegistersList.GetEntryByIdx(AnIndex: Integer): TRegisters;
begin
Result := TRegisters(inherited EntriesByIdx[AnIndex]);
end;
{ TWatchesBase }
function TWatchesBase.GetItemBase(const AnIndex: Integer): TWatchBase;
@ -1843,12 +2159,42 @@ begin
//
end;
procedure TDebuggerDataMonitor.DoBeginUpdate;
begin
//
end;
procedure TDebuggerDataMonitor.DoEndUpdate;
begin
//
end;
function TDebuggerDataMonitor.IsUpdating: Boolean;
begin
Result := FUpdateCount > 0;
end;
destructor TDebuggerDataMonitor.Destroy;
begin
Supplier := nil;
inherited Destroy;
end;
procedure TDebuggerDataMonitor.BeginUpdate;
begin
inc(FUpdateCount);
if FUpdateCount = 1 then
DoBeginUpdate;
end;
procedure TDebuggerDataMonitor.EndUpdate;
begin
assert(FUpdateCount > 0, 'TDebuggerDataMonitor.EndUpdate: FUpdateCount > 0');
dec(FUpdateCount);
if FUpdateCount = 0 then
DoEndUpdate;
end;
{ TDebuggerDataSupplier }
procedure TDebuggerDataSupplier.SetMonitor(const AValue: TDebuggerDataMonitor);
@ -1931,6 +2277,16 @@ begin
inherited Destroy;
end;
procedure TDebuggerDataSupplier.BeginUpdate;
begin
FMonitor.BeginUpdate;
end;
procedure TDebuggerDataSupplier.EndUpdate;
begin
FMonitor.EndUpdate;
end;
{ ===========================================================================
TBaseBreakPoint
=========================================================================== }
@ -2713,185 +3069,6 @@ begin
FDebugger := ADebugger;
end;
{ TRegistersFormatList }
function TRegistersFormatList.GetFormat(AName: String): TRegisterDisplayFormat;
var
i: Integer;
begin
i := IndexOf(AName);
if i < 0
then Result := rdDefault
else Result := FFormats[i].Format;
end;
procedure TRegistersFormatList.SetFormat(AName: String; AValue: TRegisterDisplayFormat);
var
i: Integer;
begin
i := IndexOf(AName);
if i < 0
then Add(AName, AValue)
else FFormats[i].Format := AValue;
end;
function TRegistersFormatList.IndexOf(const AName: String): integer;
begin
Result := FCount - 1;
while Result >= 0 do begin
if FFormats[Result].Name = AName then exit;
dec(Result);
end;
end;
function TRegistersFormatList.Add(const AName: String;
AFormat: TRegisterDisplayFormat): integer;
begin
if FCount >= length(FFormats) then SetLength(FFormats, Max(Length(FFormats)*2, 16));
FFormats[FCount].Name := AName;
FFormats[FCount].Format := AFormat;
Result := FCount;
inc(FCount);
end;
constructor TRegistersFormatList.Create;
begin
FCount := 0;
end;
procedure TRegistersFormatList.Clear;
begin
FCount := 0;
end;
{ =========================================================================== }
{ TBaseRegisters }
{ =========================================================================== }
function TBaseRegisters.Count: Integer;
begin
Result := 0;
end;
procedure TBaseRegisters.BeginUpdate;
begin
inc(FUpdateCount);
if FUpdateCount = 1 then ChangeUpdating;
end;
procedure TBaseRegisters.EndUpdate;
begin
dec(FUpdateCount);
if FUpdateCount = 0 then ChangeUpdating;
end;
constructor TBaseRegisters.Create;
begin
inherited Create;
FormatList := nil;
end;
function TBaseRegisters.GetFormat(const AnIndex: Integer): TRegisterDisplayFormat;
var
s: String;
begin
Result := rdDefault;
if FFormatList = nil then exit;
s := Names[AnIndex];
if s <> '' then
Result := FFormatList[s];
end;
procedure TBaseRegisters.SetFormat(const AnIndex: Integer;
const AValue: TRegisterDisplayFormat);
var
s: String;
begin
if FFormatList = nil then exit;
s := Names[AnIndex];
if s <> '' then
FFormatList[s] := AValue;
end;
procedure TBaseRegisters.ChangeUpdating;
begin
//
end;
function TBaseRegisters.Updating: Boolean;
begin
Result := FUpdateCount <> 0;
end;
function TBaseRegisters.GetModified(const AnIndex: Integer): Boolean;
begin
Result := False;
end;
function TBaseRegisters.GetName(const AnIndex: Integer): String;
begin
Result := '';
end;
function TBaseRegisters.GetValue(const AnIndex: Integer): String;
begin
Result := '';
end;
{ =========================================================================== }
{ TDBGRegisters }
{ =========================================================================== }
function TDBGRegisters.Count: Integer;
begin
if (FDebugger <> nil)
and (FDebugger.State in [dsPause, dsInternalPause])
then Result := GetCount
else Result := 0;
end;
constructor TDBGRegisters.Create(const ADebugger: TDebuggerIntf);
begin
FChanged := False;
inherited Create;
FDebugger := ADebugger;
end;
procedure TDBGRegisters.DoChange;
begin
if Updating then begin
FChanged := True;
exit;
end;
FChanged := False;
if Assigned(FOnChange) then FOnChange(Self);
end;
procedure TDBGRegisters.DoStateChange(const AOldState: TDBGState);
begin
end;
procedure TDBGRegisters.FormatChanged(const AnIndex: Integer);
begin
//
end;
procedure TDBGRegisters.Changed;
begin
DoChange;
end;
function TDBGRegisters.GetCount: Integer;
begin
Result := 0;
end;
procedure TDBGRegisters.ChangeUpdating;
begin
inherited ChangeUpdating;
if (not Updating) and FChanged then DoChange;
end;
{ =========================================================================== }
{ TCallStackSupplier }
{ =========================================================================== }
@ -3953,9 +4130,9 @@ begin
Result := TDebuggerProperties.Create;
end;
function TDebuggerIntf.CreateRegisters: TDBGRegisters;
function TDebuggerIntf.CreateRegisters: TRegisterSupplier;
begin
Result := TDBGRegisters.Create(Self);
Result := TRegisterSupplier.Create(Self);
end;
function TDebuggerIntf.CreateSignals: TDBGSignals;

15
components/debuggerintf/dbgintfmiscclasses.pas
View File

@ -286,8 +286,14 @@ begin
end;
procedure TDbgEntityValuesList.Clear;
var
i: Integer;
begin
Assert(not Immutable, 'TDbgEntityValuesList.Clear Immutable');
if FList.Count = 0 then
exit;
for i := 0 to FList.Count - 1 do
TDbgEntityValue(FList[i]).FOwner := nil;
FList.Clear;
DoCleared;
end;
@ -443,11 +449,16 @@ end;
procedure TDbgEntitiesThreadStackList.Clear;
var
i: Integer;
i, j: Integer;
begin
Assert(not Immutable, 'TDbgEntitiesThreadStackList.Clear Immutable');
for i := 0 to Length(FList) - 1 do
if Length(FList) = 0 then
exit;
for i := 0 to Length(FList) - 1 do begin
for j := 0 to FList[i].List.Count - 1 do
TDbgEntityValuesList(FList[i].List[j]).FOwner := nil;
FList[i].List.Free;
end;
SetLength(FList, 0);
DoCleared;
end;

28
components/lazdebuggerfp/fpgdbmidebugger.pp
View File

@ -32,9 +32,9 @@ type
public
constructor Create(ADebugger: TFpGDBMIDebugger);
function ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean; override;
function ReadMemoryEx(AnAddress, AnAddressSpace: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean; override;
function ReadMemoryEx({%H-}AnAddress, {%H-}AnAddressSpace:{%H-} TDbgPtr; ASize: {%H-}Cardinal; ADest: Pointer): Boolean; override;
function ReadRegister(ARegNum: Cardinal; out AValue: TDbgPtr): Boolean; override;
function RegisterSize(ARegNum: Cardinal): Integer; override;
function RegisterSize({%H-}ARegNum: Cardinal): Integer; override;
end;
{ TFpGDBMIAndWin32DbgMemReader }
@ -102,6 +102,8 @@ type
var AResText: String;
out ATypeInfo: TDBGType;
EvalFlags: TDBGEvaluateFlags = []): Boolean;
property CurrentThreadId;
property CurrentStackFrame;
public
class function Caption: String; override;
public
@ -162,7 +164,7 @@ type
FRequestedSources: TStringList;
protected
function FpDebugger: TFpGDBMIDebugger;
procedure DoStateChange(const AOldState: TDBGState); override;
procedure DoStateChange(const {%H-}AOldState: TDBGState); override;
procedure ClearSources;
public
constructor Create(const ADebugger: TDebuggerIntf);
@ -308,6 +310,8 @@ var
rname: String;
v: String;
i: Integer;
Reg: TRegisters;
RegVObj: TRegisterDisplayValue;
begin
Result := False;
// 32 bit gdb dwarf names
@ -324,10 +328,15 @@ begin
else
exit;
end;
for i := 0 to FDebugger.Registers.Count - 1 do
if UpperCase(FDebugger.Registers.Names[i]) = rname then
Reg := FDebugger.Registers.CurrentRegistersList[FDebugger.CurrentThreadId, FDebugger.CurrentStackFrame];
for i := 0 to Reg.Count - 1 do
if UpperCase(Reg[i].Name) = rname then
begin
v := FDebugger.Registers.Values[i];
RegVObj := Reg[i].ValueObjFormat[rdDefault];
if RegVObj <> nil then
v := RegVObj.Value[rdDefault]
else
v := '';
debugln(['TFpGDBMIDbgMemReader.ReadRegister ',rname, ' ', v]);
Result := true;
try
@ -887,7 +896,7 @@ var
begin
if FNeedRegValues then begin
FNeedRegValues := False;
FpDebugger.Registers.Values[0];
FpDebugger.Registers.CurrentRegistersList[FpDebugger.CurrentThreadId, FpDebugger.CurrentStackFrame].Count;
QueueCommand;
exit;
end;
@ -940,12 +949,11 @@ begin
if FEvaluationCmdObj <> nil then exit;
FpDebugger.Threads.CurrentThreads.Count; // trigger threads, in case
if FpDebugger.Registers.Count = 0 then // trigger register, in case
if FpDebugger.Registers.CurrentRegistersList[FpDebugger.CurrentThreadId, FpDebugger.CurrentStackFrame].Count = 0 then // trigger register, in case
FNeedRegValues := True
else
begin
FNeedRegValues := False;
FpDebugger.Registers.Values[0];
end;
// Join the queue, registers and threads are needed first
@ -1534,7 +1542,7 @@ end;
class function TFpGDBMIDebugger.Caption: String;
begin
Result := 'GNU remote debugger (with fpdebug)';
Result := 'GNU debugger (with fpdebug)';
end;
constructor TFpGDBMIDebugger.Create(const AExternalDebugger: String);

675
components/lazdebuggergdbmi/gdbmidebugger.pp
View File

@ -744,7 +744,7 @@ type
function CreateBreakPoints: TDBGBreakPoints; override;
function CreateLocals: TLocalsSupplier; override;
function CreateLineInfo: TDBGLineInfo; override;
function CreateRegisters: TDBGRegisters; override;
function CreateRegisters: TRegisterSupplier; override;
function CreateCallStack: TCallStackSupplier; override;
function CreateDisassembler: TDBGDisassembler; override;
function CreateWatches: TWatchesSupplier; override;
@ -1121,94 +1121,36 @@ type
{%region ***** Register ***** }
{ TGDBMIDebuggerCommandRegisterNames }
TStringArray = Array of string;
TBoolArray = Array of Boolean;
TGDBMIDebuggerCommandRegisterNames = class(TGDBMIDebuggerCommand)
TGDBMIRegisterSupplier = class;
{ TGDBMIDebuggerCommandRegisterUpdate }
TGDBMIDebuggerCommandRegisterUpdate = class(TGDBMIDebuggerCommand)
private
FNames: Array of String;
function GetNames(Index: Integer): string;
FRegisters: TRegisters;
FGDBMIRegSupplier: TGDBMIRegisterSupplier;
protected
function DoExecute: Boolean; override;
procedure DoCancel; override;
public
constructor Create(AOwner: TGDBMIDebugger; AGDBMIRegSupplier: TGDBMIRegisterSupplier; ARegisters: TRegisters);
destructor Destroy; override;
//function DebugText: String; override;
function Count: Integer;
property Names[Index: Integer]: string read GetNames;
end;
{ TGDBMIDebuggerCommandRegisterValues }
{ TGDBMIRegisterSupplier }
TGDBMIDebuggerCommandRegisterValues = class(TGDBMIDebuggerCommand)
TGDBMIRegisterSupplier = class(TRegisterSupplier)
private
FRegistersToUpdate: TStringArray;
FFormat: TRegisterDisplayFormat;
FRegNamesCache: TStringArray;
protected
function DoExecute: Boolean; override;
procedure DoStateChange(const AOldState: TDBGState); override;
public
// updates the given array directly
constructor Create(AOwner: TGDBMIDebugger;
RegistersToUpdate: TStringArray;
AFormat: TRegisterDisplayFormat = rdDefault
);
function DebugText: String; override;
property Format: TRegisterDisplayFormat read FFormat;
end;
{ TGDBMIDebuggerCommandRegisterModified }
TGDBMIDebuggerCommandRegisterModified = class(TGDBMIDebuggerCommand)
private
FModifiedToUpdate: TBoolArray;
protected
function DoExecute: Boolean; override;
public
// updates the given array directly
constructor Create(AOwner: TGDBMIDebugger; ModifiedToUpdate: TBoolArray);
function DebugText: String; override;
end;
{ TGDBMIRegisters }
TGDBMIRegisters = class(TDBGRegisters)
private
FRegNames: TStringArray;
FRegValues: Array [TRegisterDisplayFormat] of TStringArray;
FRegModified: TBoolArray;
FFormats: Array of TRegisterDisplayFormat;
FGetRegisterCmdObj: TGDBMIDebuggerCommandRegisterNames;
FRegistersReqState: TGDBMIEvaluationState;
FInRegistersNeeded: Boolean;
FGetModifiedCmd: TGDBMIDebuggerCommandRegisterModified;
FModifiedReqState: TGDBMIEvaluationState;
FInModifiedNeeded: Boolean;
FGetValuesCmdObj: Array [TRegisterDisplayFormat] of TGDBMIDebuggerCommandRegisterValues;
FValuesReqState: Array [TRegisterDisplayFormat] of TGDBMIEvaluationState;
FInValuesNeeded: Array [TRegisterDisplayFormat] of Boolean;
function GetDebugger: TGDBMIDebugger;
procedure RegistersNeeded;
procedure ValuesNeeded(AFormat: TRegisterDisplayFormat);
procedure ModifiedNeeded;
procedure DoGetRegisterNamesDestroyed(Sender: TObject);
procedure DoGetRegisterNamesFinished(Sender: TObject);
procedure DoGetRegValuesDestroyed(Sender: TObject);
procedure DoGetRegValuesFinished(Sender: TObject);
procedure DoGetRegModifiedDestroyed(Sender: TObject);
procedure DoGetRegModifiedFinished(Sender: TObject);
protected
procedure DoStateChange(const {%H-}AOldState: TDBGState); override;
procedure Invalidate;
function GetCount: Integer; override;
function GetModified(const AnIndex: Integer): Boolean; override;
function GetName(const AnIndex: Integer): String; override;
function GetValue(const AnIndex: Integer): String; override;
property Debugger: TGDBMIDebugger read GetDebugger;
public
procedure Changed; override;
procedure Changed;
procedure RequestData(ARegisters: TRegisters); override;
end;
{%endregion ^^^^^ Register ^^^^^ }
@ -1571,6 +1513,190 @@ begin
then Result := 8;
end;
{ TGDBMIDebuggerCommandRegisterUpdate }
function TGDBMIDebuggerCommandRegisterUpdate.DoExecute: Boolean;
procedure UpdateFormat(AFormat: TRegisterDisplayFormat);
const
// rdDefault, rdHex, rdBinary, rdOctal, rdDecimal, rdRaw
FormatChar : array [TRegisterDisplayFormat] of string =
('N', 'x', 't', 'o', 'd', 'r');
var
i, idx: Integer;
Num: QWord;
List, ValList: TGDBMINameValueList;
Item: PGDBMINameValue;
RegVal: TRegisterValue;
RegValObj: TRegisterDisplayValue;
t: String;
NumErr: word;
R: TGDBMIExecResult;
begin
if (not ExecuteCommand('-data-list-register-values %s', [FormatChar[AFormat]], R)) or
(R.State = dsError)
then begin
for i := 0 to FRegisters.Count - 1 do
if FRegisters[i].DataValidity in [ddsRequested, ddsEvaluating] then
FRegisters[i].DataValidity := ddsInvalid;
Exit;
end;
ValList := TGDBMINameValueList.Create('');
List := TGDBMINameValueList.Create(R, ['register-values']);
for i := 0 to List.Count - 1 do
begin
Item := List.Items[i];
ValList.Init(Item^.Name);
idx := StrToIntDef(Unquote(ValList.Values['number']), -1);
if (idx < 0) or (idx > High(FGDBMIRegSupplier.FRegNamesCache)) then Continue;
RegVal := FRegisters.EntriesByName[FGDBMIRegSupplier.FRegNamesCache[idx]];
if (RegVal.DataValidity = ddsValid) and (RegVal.HasValueFormat[AFormat]) then continue;
t := Unquote(ValList.Values['value']);
RegValObj := RegVal.ValueObjFormat[AFormat];
if (AFormat in [rdDefault, rdRaw]) or (RegValObj.SupportedDispFormats = [AFormat]) then
RegValObj.SetAsText(t);
Val(t, Num, NumErr);
if NumErr <> 0 then
RegValObj.SetAsText(t)
else
begin
RegValObj.SetAsNum(Num, FTheDebugger.TargetPtrSize);
RegValObj.AddFormats([rdBinary, rdDecimal, rdOctal, rdHex]);
end;
if AFormat = RegVal.DisplayFormat then
RegVal.DataValidity := ddsValid;
end;
FreeAndNil(List);
FreeAndNil(ValList);
end;
var
R: TGDBMIExecResult;
List: TGDBMINameValueList;
i, idx: Integer;
ChangedRegList: TGDBMINameValueList;
begin
Result := True;
DebugLn(['|||||||||||||| ', dbgs(FRegisters.DataValidity), ' ', FRegisters.StackFrame]);
if FRegisters.DataValidity = ddsEvaluating then // in process
exit;
FContext.ThreadContext := ccUseLocal;
FContext.StackContext := ccUseLocal;
FContext.ThreadId := FRegisters.ThreadId;
FContext.StackFrame := FRegisters.StackFrame;
FGDBMIRegSupplier.BeginUpdate;
try
if length(FGDBMIRegSupplier.FRegNamesCache) = 0 then begin
if (not ExecuteCommand('-data-list-register-names', R, [cfNoThreadContext, cfNoStackContext])) or
(R.State = dsError)
then begin
if FRegisters.DataValidity in [ddsRequested, ddsEvaluating] then
FRegisters.DataValidity := ddsInvalid;
exit;
end;
List := TGDBMINameValueList.Create(R, ['register-names']);
SetLength(FGDBMIRegSupplier.FRegNamesCache, List.Count);
for i := 0 to List.Count - 1 do
FGDBMIRegSupplier.FRegNamesCache[i] := UnQuote(List.GetString(i));
FreeAndNil(List);
end;
if FRegisters.DataValidity = ddsRequested then begin
ChangedRegList := nil;
if (FRegisters.StackFrame = 0) and // need modified, run before all others
ExecuteCommand('-data-list-changed-registers', R, [cfscIgnoreError]) and
(R.State <> dsError)
then
ChangedRegList := TGDBMINameValueList.Create(R, ['changed-registers']);
// Need all registers
FRegisters.DataValidity := ddsEvaluating;
UpdateFormat(rdDefault);
FRegisters.DataValidity := ddsValid;
if ChangedRegList <> nil then begin
for i := 0 to ChangedRegList.Count - 1 do begin
idx := StrToIntDef(Unquote(ChangedRegList.GetString(i)), -1);
if (idx < 0) or (idx > High(FGDBMIRegSupplier.FRegNamesCache)) then Continue;
FRegisters.EntriesByName[FGDBMIRegSupplier.FRegNamesCache[idx]].Modified := True;
end;
FreeAndNil(ChangedRegList);
end;
end;
// check for individual updates / displayformat
for i := 0 to FRegisters.Count - 1 do begin
if not FRegisters[i].HasValue then
UpdateFormat(FRegisters[i].DisplayFormat);
end;
finally
FGDBMIRegSupplier.EndUpdate;
end;
end;
procedure TGDBMIDebuggerCommandRegisterUpdate.DoCancel;
begin
if FRegisters.DataValidity in [ddsRequested, ddsEvaluating] then
FRegisters.DataValidity := ddsInvalid;
inherited DoCancel;
end;
constructor TGDBMIDebuggerCommandRegisterUpdate.Create(AOwner: TGDBMIDebugger;
AGDBMIRegSupplier: TGDBMIRegisterSupplier; ARegisters: TRegisters);
begin
inherited Create(AOwner);
FGDBMIRegSupplier := AGDBMIRegSupplier;
FRegisters := ARegisters;
FRegisters.AddReference;
end;
destructor TGDBMIDebuggerCommandRegisterUpdate.Destroy;
begin
inherited Destroy;
FRegisters.ReleaseReference;
end;
{ TGDBMIRegisterSupplier }
procedure TGDBMIRegisterSupplier.DoStateChange(const AOldState: TDBGState);
begin
if not( (AOldState in [dsPause, dsInternalPause]) and (Debugger.State in [dsPause, dsInternalPause]) )
then
SetLength(FRegNamesCache, 0);
inherited DoStateChange(AOldState);
end;
procedure TGDBMIRegisterSupplier.Changed;
begin
if CurrentRegistersList <> nil
then CurrentRegistersList.Clear;
end;
procedure TGDBMIRegisterSupplier.RequestData(ARegisters: TRegisters);
var
ForceQueue: Boolean;
Cmd: TGDBMIDebuggerCommandRegisterUpdate;
begin
if (Debugger = nil) or not(Debugger.State in [dsPause, dsStop]) then
exit;
Cmd := TGDBMIDebuggerCommandRegisterUpdate.Create(TGDBMIDebugger(Debugger), Self, ARegisters);
//Cmd.OnExecuted := @DoGetRegisterNamesFinished;
//Cmd.OnDestroy := @DoGetRegisterNamesDestroyed;
Cmd.Priority := GDCMD_PRIOR_LOCALS;
Cmd.Properties := [dcpCancelOnRun];
ForceQueue := (TGDBMIDebugger(Debugger).FCurrentCommand <> nil)
and (TGDBMIDebugger(Debugger).FCurrentCommand is TGDBMIDebuggerCommandExecute)
and (not TGDBMIDebuggerCommandExecute(TGDBMIDebugger(Debugger).FCurrentCommand).NextExecQueued)
and (Debugger.State <> dsInternalPause);
TGDBMIDebugger(Debugger).QueueCommand(Cmd, ForceQueue);
end;
{ TGDBMIDebuggerChangeFilenameBase }
function TGDBMIDebuggerChangeFilenameBase.DoChangeFilename: Boolean;
@ -3073,50 +3199,6 @@ begin
Result := length(FThreads);
end;
{ TGDBMIDebuggerCommandRegisterModified }
function TGDBMIDebuggerCommandRegisterModified.DoExecute: Boolean;
var
R: TGDBMIExecResult;
List: TGDBMINameValueList;
n, idx: Integer;
begin
Result := True;
FContext.StackContext := ccNotRequired;
if length(FModifiedToUpdate) = 0
then exit;
for n := Low(FModifiedToUpdate) to High(FModifiedToUpdate) do
FModifiedToUpdate[n] := False;
ExecuteCommand('-data-list-changed-registers', R, [cfscIgnoreError]);
if R.State = dsError then Exit;
List := TGDBMINameValueList.Create(R, ['changed-registers']);
for n := 0 to List.Count - 1 do
begin
idx := StrToIntDef(Unquote(List.GetString(n)), -1);
if idx < Low(FModifiedToUpdate) then Continue;
if idx > High(FModifiedToUpdate) then Continue;
FModifiedToUpdate[idx] := True;
end;
FreeAndNil(List);
end;
constructor TGDBMIDebuggerCommandRegisterModified.Create(AOwner: TGDBMIDebugger;
ModifiedToUpdate: TBoolArray);
begin
inherited Create(AOwner);
FModifiedToUpdate := ModifiedToUpdate;
end;
function TGDBMIDebuggerCommandRegisterModified.DebugText: String;
begin
Result := Format('%s: Reg-Cnt=%d', [ClassName, length(FModifiedToUpdate)]);
end;
{ TGDBMINameValueBasedList }
constructor TGDBMINameValueBasedList.Create;
@ -6368,92 +6450,6 @@ begin
Result := Format('%s: Source=%s', [ClassName, FSource]);
end;
{ TGDBMIDebuggerCommandRegisterValues }
function TGDBMIDebuggerCommandRegisterValues.DoExecute: Boolean;
const
// rdDefault, rdHex, rdBinary, rdOctal, rdDecimal, rdRaw
FormatChar : array [TRegisterDisplayFormat] of string =
('N', 'x', 't', 'o', 'd', 'r');
var
R: TGDBMIExecResult;
List, ValList: TGDBMINameValueList;
Item: PGDBMINameValue;
n, idx: Integer;
begin
Result := True;
//FContext.StackContext := ccNotRequired;
if length(FRegistersToUpdate) = 0
then exit;
for n := Low(FRegistersToUpdate) to High(FRegistersToUpdate) do
FRegistersToUpdate[n] := '';
ExecuteCommand('-data-list-register-values %s', [FormatChar[FFormat]], R);
if R.State = dsError then Exit;
ValList := TGDBMINameValueList.Create('');
List := TGDBMINameValueList.Create(R, ['register-values']);
for n := 0 to List.Count - 1 do
begin
Item := List.Items[n];
ValList.Init(Item^.Name);
idx := StrToIntDef(Unquote(ValList.Values['number']), -1);
if (idx >= Low(FRegistersToUpdate)) and
(idx <= High(FRegistersToUpdate))
then FRegistersToUpdate[idx] := Unquote(ValList.Values['value']);
end;
FreeAndNil(List);
FreeAndNil(ValList);
end;
constructor TGDBMIDebuggerCommandRegisterValues.Create(AOwner: TGDBMIDebugger;
RegistersToUpdate: TStringArray; AFormat: TRegisterDisplayFormat = rdDefault);
begin
inherited Create(AOwner);
FRegistersToUpdate := RegistersToUpdate;
FFormat := AFormat;
end;
function TGDBMIDebuggerCommandRegisterValues.DebugText: String;
begin
Result := SysUtils.Format('%s: Reg-Cnt=%d', [ClassName, length(FRegistersToUpdate)]);
end;
{ TGDBMIDebuggerCommandRegisterNames }
function TGDBMIDebuggerCommandRegisterNames.GetNames(Index: Integer): string;
begin
Result := FNames[Index];
end;
function TGDBMIDebuggerCommandRegisterNames.DoExecute: Boolean;
var
R: TGDBMIExecResult;
List: TGDBMINameValueList;
n: Integer;
begin
Result := True;
FContext.ThreadContext := ccNotRequired;
FContext.StackContext := ccNotRequired;
ExecuteCommand('-data-list-register-names', R);
if R.State = dsError then Exit;
List := TGDBMINameValueList.Create(R, ['register-names']);
SetLength(FNames, List.Count);
for n := 0 to List.Count - 1 do
FNames[n] := UnQuote(List.GetString(n));
FreeAndNil(List);
end;
function TGDBMIDebuggerCommandRegisterNames.Count: Integer;
begin
Result := length(FNames);
end;
{ TGDBMIDebuggerCommandStackDepth }
function TGDBMIDebuggerCommandStackDepth.DoExecute: Boolean;
@ -7168,9 +7164,9 @@ begin
Result := TGDBMIDebuggerProperties.Create;
end;
function TGDBMIDebugger.CreateRegisters: TDBGRegisters;
function TGDBMIDebugger.CreateRegisters: TRegisterSupplier;
begin
Result := TGDBMIRegisters.Create(Self);
Result := TGDBMIRegisterSupplier.Create(Self);
end;
function TGDBMIDebugger.CreateWatches: TWatchesSupplier;
@ -7381,7 +7377,8 @@ end;
procedure TGDBMIDebugger.DoThreadChanged;
begin
TGDBMICallstack(CallStack).DoThreadChanged;
TGDBMIRegisters(Registers).Changed;
if Registers.CurrentRegistersList <> nil then
Registers.CurrentRegistersList.Clear;
end;
procedure TGDBMIDebugger.DoRelease;
@ -9701,267 +9698,6 @@ end;
{%endregion ^^^^^ BreakPoints ^^^^^ }
{ =========================================================================== }
{ TGDBMIRegisters }
{ =========================================================================== }
procedure TGDBMIRegisters.Changed;
begin
Invalidate;
inherited Changed;
end;
procedure TGDBMIRegisters.DoStateChange(const AOldState: TDBGState);
begin
if Debugger <> nil
then begin
case Debugger.State of
dsPause: DoChange;
dsStop, dsInit:
begin
FRegistersReqState := esInvalid;
Invalidate;
end;
else
Invalidate
end;
end
else Invalidate;
end;
procedure TGDBMIRegisters.Invalidate;
var
n: Integer;
i: TRegisterDisplayFormat;
begin
for n := Low(FRegModified) to High(FRegModified) do
FRegModified[n] := False;
for i := low(TRegisterDisplayFormat) to high(TRegisterDisplayFormat) do begin
for n := Low(FRegValues[i]) to High(FRegValues[i]) do
FRegValues[i][n] := '';
FValuesReqState[i] := esInvalid;
end;
FModifiedReqState := esInvalid;
end;
function TGDBMIRegisters.GetCount: Integer;
begin
if (Debugger <> nil)
and (Debugger.State = dsPause)
then RegistersNeeded;
Result := Length(FRegNames);
end;
function TGDBMIRegisters.GetModified(const AnIndex: Integer): Boolean;
begin
if (Debugger <> nil)
and (Debugger.State = dsPause)
and (FModifiedReqState <> esValid)
then ModifiedNeeded;
if (FModifiedReqState = esValid)
and (AnIndex >= Low(FRegModified))
and (AnIndex <= High(FRegModified))
then Result := FRegModified[AnIndex]
else Result := False;
end;
function TGDBMIRegisters.GetName(const AnIndex: Integer): String;
begin
if (Debugger <> nil)
and (Debugger.State = dsPause)
then RegistersNeeded;
if (FRegistersReqState = esValid)
and (AnIndex >= Low(FRegNames))
and (AnIndex <= High(FRegNames))
then Result := FRegNames[AnIndex]
else Result := '';
end;
function TGDBMIRegisters.GetValue(const AnIndex: Integer): String;
begin
if (Debugger <> nil)
and (Debugger.State = dsPause)
then ValuesNeeded(Formats[AnIndex]);
if (FValuesReqState[FFormats[AnIndex]] = esValid)
and (FRegistersReqState = esValid)
and (AnIndex >= Low(FRegValues[Formats[AnIndex]]))
and (AnIndex <= High(FRegValues[Formats[AnIndex]]))
then Result := FRegValues[Formats[AnIndex]][AnIndex]
else Result := '';
end;
procedure TGDBMIRegisters.DoGetRegisterNamesDestroyed(Sender: TObject);
begin
if FGetRegisterCmdObj = Sender
then FGetRegisterCmdObj := nil;
end;
procedure TGDBMIRegisters.DoGetRegisterNamesFinished(Sender: TObject);
var
Cmd: TGDBMIDebuggerCommandRegisterNames;
n: Integer;
f: TRegisterDisplayFormat;
begin
Cmd := TGDBMIDebuggerCommandRegisterNames(Sender);
SetLength(FRegNames, Cmd.Count);
SetLength(FRegModified, Cmd.Count);
SetLength(FFormats, Cmd.Count);
for f := low(TRegisterDisplayFormat) to high(TRegisterDisplayFormat) do begin
SetLength(FRegValues[f], Cmd.Count);
FValuesReqState[f] := esInvalid;
end;
FModifiedReqState := esInvalid;
for n := 0 to Cmd.Count - 1 do
begin
FRegNames[n] := Cmd.Names[n];
for f := low(TRegisterDisplayFormat) to high(TRegisterDisplayFormat) do
FRegValues[f][n] := '';
FRegModified[n] := False;
FFormats[n] := rdDefault;
end;
FGetRegisterCmdObj:= nil;
FRegistersReqState := esValid;
if not FInRegistersNeeded
then Changed;
end;
procedure TGDBMIRegisters.RegistersNeeded;
var
ForceQueue: Boolean;
begin
if (Debugger = nil) or (FRegistersReqState in [esRequested, esValid])
then Exit;
if (Debugger.State in [dsPause, dsStop])
then begin
FInRegistersNeeded := True;
FRegistersReqState := esRequested;
SetLength(FRegNames, 0);
FGetRegisterCmdObj := TGDBMIDebuggerCommandRegisterNames.Create(TGDBMIDebugger(Debugger));
FGetRegisterCmdObj.OnExecuted := @DoGetRegisterNamesFinished;
FGetRegisterCmdObj.OnDestroy := @DoGetRegisterNamesDestroyed;
FGetRegisterCmdObj.Priority := GDCMD_PRIOR_LOCALS;
FGetRegisterCmdObj.Properties := [dcpCancelOnRun];
ForceQueue := (TGDBMIDebugger(Debugger).FCurrentCommand <> nil)
and (TGDBMIDebugger(Debugger).FCurrentCommand is TGDBMIDebuggerCommandExecute)
and (not TGDBMIDebuggerCommandExecute(TGDBMIDebugger(Debugger).FCurrentCommand).NextExecQueued)
and (Debugger.State <> dsInternalPause);
TGDBMIDebugger(Debugger).QueueCommand(FGetRegisterCmdObj, ForceQueue);
(* DoEvaluationFinished may be called immediately at this point *)
FInRegistersNeeded := False;
end;
end;
function TGDBMIRegisters.GetDebugger: TGDBMIDebugger;
begin
Result := TGDBMIDebugger(inherited Debugger);
end;
procedure TGDBMIRegisters.DoGetRegValuesDestroyed(Sender: TObject);
var
Cmd: TGDBMIDebuggerCommandRegisterValues;
begin
Cmd := TGDBMIDebuggerCommandRegisterValues(Sender);
if FGetValuesCmdObj[Cmd.Format] = Sender
then FGetValuesCmdObj[Cmd.Format] := nil;
end;
procedure TGDBMIRegisters.DoGetRegValuesFinished(Sender: TObject);
var
Cmd: TGDBMIDebuggerCommandRegisterValues;
begin
Cmd := TGDBMIDebuggerCommandRegisterValues(Sender);
FValuesReqState[Cmd.Format] := esValid;
FGetValuesCmdObj[Cmd.Format] := nil;
if not FInValuesNeeded[Cmd.Format]
then inherited Changed;
end;
procedure TGDBMIRegisters.ValuesNeeded(AFormat: TRegisterDisplayFormat);
var
ForceQueue: Boolean;
begin
if (Debugger <> nil) and (Debugger.State = dsPause)
then RegistersNeeded;
if (Debugger = nil)
or (not (Debugger.State in [dsPause, dsStop]))
or (FRegistersReqState <> esValid)
or (FValuesReqState[AFormat] in [esRequested, esValid])
or (Count = 0)
then Exit;
FInValuesNeeded[AFormat] := True;
FValuesReqState[AFormat] := esRequested;
FGetValuesCmdObj[AFormat] := TGDBMIDebuggerCommandRegisterValues.Create
(Debugger, FRegValues[AFormat], AFormat);
FGetValuesCmdObj[AFormat].OnExecuted := @DoGetRegValuesFinished;
FGetValuesCmdObj[AFormat].OnDestroy := @DoGetRegValuesDestroyed;
FGetValuesCmdObj[AFormat].Priority := GDCMD_PRIOR_LOCALS;
FGetValuesCmdObj[AFormat].Properties := [dcpCancelOnRun];
ForceQueue := (Debugger.FCurrentCommand <> nil)
and (Debugger.FCurrentCommand is TGDBMIDebuggerCommandExecute)
and (not TGDBMIDebuggerCommandExecute(Debugger.FCurrentCommand).NextExecQueued)
and (Debugger.State <> dsInternalPause);
Debugger.QueueCommand(FGetValuesCmdObj[AFormat], ForceQueue);
(* DoEvaluationFinished may be called immediately at this point *)
FInValuesNeeded[AFormat] := False;
end;
procedure TGDBMIRegisters.DoGetRegModifiedDestroyed(Sender: TObject);
begin
if FGetModifiedCmd = Sender
then FGetModifiedCmd := nil;
end;
procedure TGDBMIRegisters.DoGetRegModifiedFinished(Sender: TObject);
begin
FModifiedReqState := esValid;
FGetModifiedCmd := nil;
if not FInModifiedNeeded
then inherited Changed;
end;
procedure TGDBMIRegisters.ModifiedNeeded;
var
ForceQueue: Boolean;
begin
if (Debugger <> nil) and (Debugger.State = dsPause)
then RegistersNeeded;
if (Debugger = nil)
or (not (Debugger.State in [dsPause, dsStop]))
or (FRegistersReqState <> esValid)
or (FModifiedReqState in [esRequested, esValid])
or (Count = 0)
then Exit;
FInModifiedNeeded := True;
FModifiedReqState := esRequested;
FGetModifiedCmd := TGDBMIDebuggerCommandRegisterModified.Create(Debugger, FRegModified);
FGetModifiedCmd.OnExecuted := @DoGetRegModifiedFinished;
FGetModifiedCmd.OnDestroy := @DoGetRegModifiedDestroyed;
FGetModifiedCmd.Priority := GDCMD_PRIOR_LOCALS;
FGetModifiedCmd.Properties := [dcpCancelOnRun];
ForceQueue := (Debugger.FCurrentCommand <> nil)
and (Debugger.FCurrentCommand is TGDBMIDebuggerCommandExecute)
and (not TGDBMIDebuggerCommandExecute(Debugger.FCurrentCommand).NextExecQueued)
and (Debugger.State <> dsInternalPause);
Debugger.QueueCommand(FGetModifiedCmd, ForceQueue);
(* DoEvaluationFinished may be called immediately at this point *)
FInModifiedNeeded := False;
end;
{ =========================================================================== }
{ TGDBMIWatches }
{ =========================================================================== }
@ -10204,7 +9940,6 @@ begin
if TGDBMIDebugger(Debugger).FCurrentStackFrame = idx then Exit;
TGDBMIDebugger(Debugger).FCurrentStackFrame := idx;
TGDBMIRegisters(Debugger.Registers).Changed;
if cs <> nil then
cs.CurrentIndex := idx;
end;

369
debugger/debugger.pp
View File

@ -867,8 +867,6 @@ type
property OnChange;
end;
{ TLocals }
{ TIDELocals }
TIDELocals = class(TLocals)
@ -1019,36 +1017,93 @@ type
******************************************************************************
******************************************************************************}
TRegistersMonitor = class;
TRegistersNotification = class(TDebuggerChangeNotification)
public
property OnChange;
end;
{ TIDERegisterValue }
TIDERegisterValue = class(TRegisterValue)
protected
procedure DoDataValidityChanged(AnOldValidity: TDebuggerDataState); override;
procedure DoDisplayFormatChanged(AnOldFormat: TRegisterDisplayFormat); override;
end;
{ TIDERegisters }
TIDERegistersNotification = class(TDebuggerNotification)
TIDERegisters = class(TRegisters)
protected
function CreateEntry: TDbgEntityValue; override;
end;
{ TCurrentIDERegisters }
TCurrentIDERegisters = class(TIDERegisters)
private
FOnChange: TNotifyEvent;
FMonitor: TRegistersMonitor;
procedure DoDataValidityChanged(AnOldValidity: TDebuggerDataState); override;
public
property OnChange: TNotifyEvent read FOnChange write FOnChange;
constructor Create(AMonitor: TRegistersMonitor; AThreadId, AStackFrame: Integer);
function Count: Integer; override;
end;
TIDERegisters = class(TBaseRegisters)
TIDERegistersList = class(TRegistersList)
private
FNotificationList: TList;
FMaster: TDBGRegisters;
procedure RegistersChanged(Sender: TObject);
procedure SetMaster(const AMaster: TDBGRegisters);
//function GetEntry(const AThreadId: Integer; const AStackFrame: Integer): TIDERegisters;
//function GetEntryByIdx(const AnIndex: Integer): TIDERegisters;
protected
function GetModified(const AnIndex: Integer): Boolean; override;
function GetName(const AnIndex: Integer): String; override;
function GetValue(const AnIndex: Integer): String; override;
procedure SetFormat(const AnIndex: Integer; const AValue: TRegisterDisplayFormat); override;
//function CreateEntry(AThreadId, AStackFrame: Integer): TDbgEntityValuesList; override; // TIDERegisters
//procedure DoAssign(AnOther: TDbgEntitiesThreadStackList); override; // Immutable
// XML
public
//property EntriesByIdx[const AnIndex: Integer]: TIDERegisters read GetEntryByIdx;
//property Entries[const AThreadId: Integer; const AStackFrame: Integer]: TIDERegisters
// read GetEntry; default;
end;
{ TCurrentIDERegistersList }
TCurrentIDERegistersList = class(TIDERegistersList)
private
FMonitor: TRegistersMonitor;
protected
procedure NotifyChange;
procedure DoCleared; override;
function CreateEntry(AThreadId, AStackFrame: Integer): TRegisters; override; // TIDERegisters
public
constructor Create(AMonitor: TRegistersMonitor);
end;
{ TRegistersMonitor }
TRegistersMonitor = class(TDebuggerDataMonitorEx)
private
FCurrentRegistersList: TCurrentIDERegistersList;
FNotificationList: TDebuggerChangeNotificationList;
FFlags: set of (rmNeedNotifyChange);
function GetSupplier: TRegisterSupplier;
procedure SetSupplier(const AValue: TRegisterSupplier);
protected
procedure DoStateEnterPause; override;
//procedure DoStateLeavePause; override;
procedure DoStateLeavePauseClean; override;
procedure DoEndUpdate; override;
procedure NotifyChange(ARegisters: TCurrentIDERegisters);
procedure DoNewSupplier; override;
procedure RequestData(ARegisters: TCurrentIDERegisters);
//function CreateSnapshot(CreateEmpty: Boolean = False): TObject; override;
public
constructor Create;
destructor Destroy; override;
procedure AddNotification(const ANotification: TIDERegistersNotification);
procedure RemoveNotification(const ANotification: TIDERegistersNotification);
function Count: Integer; override;
property Master: TDBGRegisters read FMaster write SetMaster;
procedure Clear;
procedure AddNotification(const ANotification: TRegistersNotification);
procedure RemoveNotification(const ANotification: TRegistersNotification);
property CurrentRegistersList: TCurrentIDERegistersList read FCurrentRegistersList;
//property Snapshots[AnID: Pointer]: TIDERegistersList read GetSnapshot;
property Supplier: TRegisterSupplier read GetSupplier write SetSupplier;
end;
{%endregion ^^^^^ Register ^^^^^ }
@ -3309,13 +3364,14 @@ begin
inherited;
FNotificationList := TDebuggerChangeNotificationList.Create;
FCurrentLocalsList := TCurrentLocalsList.Create(Self);
FCurrentLocalsList.AddReference;
end;
destructor TLocalsMonitor.Destroy;
begin
FNotificationList.Clear;
inherited Destroy;
FreeAndNil(FCurrentLocalsList);
ReleaseRefAndNil(FCurrentLocalsList);
FreeAndNil(FNotificationList);
end;
@ -6357,124 +6413,179 @@ end;
(******************************************************************************)
(******************************************************************************)
{ =========================================================================== }
{ TIDERegisters }
{ =========================================================================== }
{ TIDERegisterValue }
procedure TIDERegisters.AddNotification(const ANotification: TIDERegistersNotification);
procedure TIDERegisterValue.DoDataValidityChanged(AnOldValidity: TDebuggerDataState);
begin
if (Owner <> nil) and (Owner is TCurrentIDERegisters) then
TCurrentIDERegisters(Owner).DoDataValidityChanged(AnOldValidity);
end;
procedure TIDERegisterValue.DoDisplayFormatChanged(AnOldFormat: TRegisterDisplayFormat);
begin
if not HasValueFormat[DisplayFormat] then begin
DataValidity := ddsRequested;
if (Owner <> nil) and (Owner is TCurrentIDERegisters) then
TCurrentIDERegisters(Owner).FMonitor.RequestData(TCurrentIDERegisters(Owner));
end
else
if (Owner <> nil) and (Owner is TCurrentIDERegisters) then
TCurrentIDERegisters(Owner).FMonitor.NotifyChange(TCurrentIDERegisters(Owner));
end;
{ TIDERegisters }
function TIDERegisters.CreateEntry: TDbgEntityValue;
begin
Result := TIDERegisterValue.Create;
end;
{ TCurrentIDERegisters }
procedure TCurrentIDERegisters.DoDataValidityChanged(AnOldValidity: TDebuggerDataState);
begin
inherited DoDataValidityChanged(AnOldValidity);
if not( (DataValidity in [ddsRequested, ddsEvaluating]) and
(AnOldValidity in [ddsUnknown, ddsRequested, ddsEvaluating]) )
then
FMonitor.NotifyChange(Self);
end;
constructor TCurrentIDERegisters.Create(AMonitor: TRegistersMonitor; AThreadId,
AStackFrame: Integer);
begin
FMonitor := AMonitor;
inherited Create(AThreadId, AStackFrame);
end;
function TCurrentIDERegisters.Count: Integer;
begin
case DataValidity of
ddsUnknown: begin
AddReference;
try
Result := 0;
DataValidity := ddsRequested;
FMonitor.RequestData(Self); // Locals can be cleared, if debugger is "run" again
if DataValidity = ddsValid then Result := inherited Count();
finally
ReleaseReference;
end;
end;
ddsRequested, ddsEvaluating: Result := 0;
ddsValid: Result := inherited Count;
ddsInvalid, ddsError: Result := 0;
end;
end;
{ TCurrentIDERegistersList }
procedure TCurrentIDERegistersList.DoCleared;
begin
inherited DoCleared;
FMonitor.NotifyChange(nil);
end;
function TCurrentIDERegistersList.CreateEntry(AThreadId, AStackFrame: Integer): TRegisters;
begin
Result := TCurrentIDERegisters.Create(FMonitor, AThreadId, AStackFrame);
end;
constructor TCurrentIDERegistersList.Create(AMonitor: TRegistersMonitor);
begin
FMonitor := AMonitor;
inherited Create;
end;
{ TRegistersMonitor }
function TRegistersMonitor.GetSupplier: TRegisterSupplier;
begin
Result := TRegisterSupplier(inherited Supplier);
end;
procedure TRegistersMonitor.SetSupplier(const AValue: TRegisterSupplier);
begin
inherited Supplier := AValue;
end;
procedure TRegistersMonitor.DoStateEnterPause;
begin
inherited DoStateEnterPause;
if CurrentRegistersList = nil then exit;
Clear;
end;
procedure TRegistersMonitor.DoStateLeavePauseClean;
begin
inherited DoStateLeavePauseClean;
if CurrentRegistersList = nil then exit;
Clear;
end;
procedure TRegistersMonitor.DoEndUpdate;
begin
inherited DoEndUpdate;
if rmNeedNotifyChange in FFlags then
NotifyChange(nil);
end;
procedure TRegistersMonitor.NotifyChange(ARegisters: TCurrentIDERegisters);
begin
if IsUpdating then begin
Include(FFlags, rmNeedNotifyChange);
exit;
end;
Exclude(FFlags, rmNeedNotifyChange);
FNotificationList.NotifyChange(ARegisters);
end;
procedure TRegistersMonitor.DoNewSupplier;
begin
inherited DoNewSupplier;
NotifyChange(nil);
if Supplier <> nil then
Supplier.CurrentRegistersList := FCurrentRegistersList;
end;
procedure TRegistersMonitor.RequestData(ARegisters: TCurrentIDERegisters);
begin
if Supplier <> nil
then Supplier.RequestData(ARegisters)
else ARegisters.DataValidity := ddsInvalid;
end;
constructor TRegistersMonitor.Create;
begin
inherited Create;
FNotificationList := TDebuggerChangeNotificationList.Create;
FCurrentRegistersList := TCurrentIDERegistersList.Create(Self);
FCurrentRegistersList.AddReference;
end;
destructor TRegistersMonitor.Destroy;
begin
FNotificationList.Clear;
inherited Destroy;
ReleaseRefAndNil(FCurrentRegistersList);
FreeAndNil(FNotificationList);
end;
procedure TRegistersMonitor.Clear;
begin
FCurrentRegistersList.Clear;
end;
procedure TRegistersMonitor.AddNotification(const ANotification: TRegistersNotification);
begin
FNotificationList.Add(ANotification);
ANotification.AddReference;
end;
constructor TIDERegisters.Create;
begin
FNotificationList := TList.Create;
inherited Create;
FFormatList := TRegistersFormatList.Create;
end;
destructor TIDERegisters.Destroy;
var
n: Integer;
begin
for n := FNotificationList.Count - 1 downto 0 do
TDebuggerNotification(FNotificationList[n]).ReleaseReference;
inherited;
FreeAndNil(FNotificationList);
FreeAndNil(FFormatList);
end;
procedure TIDERegisters.RegistersChanged(Sender: TObject);
begin
NotifyChange;
end;
procedure TIDERegisters.SetMaster(const AMaster: TDBGRegisters);
var
DoNotify: Boolean;
begin
if FMaster = AMaster then Exit;
if FMaster <> nil
then begin
FMaster.OnChange := nil;
FMaster.FormatList := nil;
DoNotify := FMaster.Count <> 0;
end
else DoNotify := False;
FMaster := AMaster;
if FMaster <> nil
then begin
FMaster.OnChange := @RegistersChanged;
FMaster.FormatList := FormatList;
DoNotify := DoNotify or (FMaster.Count <> 0);
end;
if DoNotify
then NotifyChange;
end;
function TIDERegisters.GetModified(const AnIndex: Integer): Boolean;
begin
if Master = nil
then Result := inherited GetModified(AnIndex)
else Result := Master.Modified[AnIndex];
end;
function TIDERegisters.GetName(const AnIndex: Integer): String;
begin
if Master = nil
then Result := inherited GetName(AnIndex)
else Result := Master.Names[AnIndex];
end;
function TIDERegisters.GetValue(const AnIndex: Integer): String;
begin
if Master = nil
then Result := inherited GetValue(AnIndex)
else Result := Master.Values[AnIndex];
end;
procedure TIDERegisters.SetFormat(const AnIndex: Integer;
const AValue: TRegisterDisplayFormat);
begin
inherited SetFormat(AnIndex, AValue);
if Master <> nil
then Master.FormatChanged(AnIndex);
NotifyChange;
end;
procedure TIDERegisters.NotifyChange;
var
n: Integer;
Notification: TIDERegistersNotification;
begin
for n := 0 to FNotificationList.Count - 1 do
begin
Notification := TIDERegistersNotification(FNotificationList[n]);
if Assigned(Notification.FOnChange)
then Notification.FOnChange(Self);
end;
end;
procedure TIDERegisters.RemoveNotification(const ANotification: TIDERegistersNotification);
procedure TRegistersMonitor.RemoveNotification(const ANotification: TRegistersNotification);
begin
FNotificationList.Remove(ANotification);
ANotification.ReleaseReference;
end;
function TIDERegisters.Count: Integer;
begin
if Master = nil
then Result := 0
else Result := Master.Count;
end;
(******************************************************************************)
(******************************************************************************)

45
debugger/debuggerdlg.pp
View File

@ -69,6 +69,8 @@ type
FLocalsNotification: TLocalsNotification;
FWatchesMonitor: TWatchesMonitor;
FWatchesNotification: TWatchesNotification;
FRegistersMonitor: TRegistersMonitor;
FRegistersNotification: TRegistersNotification;
FBreakPoints: TIDEBreakPoints;
FBreakpointsNotification: TIDEBreakPointsNotification;
function GetSnapshotNotification: TSnapshotNotification;
@ -76,16 +78,19 @@ type
function GetCallStackNotification: TCallStackNotification;
function GetLocalsNotification: TLocalsNotification;
function GetWatchesNotification: TWatchesNotification;
function GetRegistersNotification: TRegistersNotification;
function GetBreakpointsNotification: TIDEBreakPointsNotification;
procedure SetSnapshotManager(const AValue: TSnapshotManager);
procedure SetThreadsMonitor(const AValue: TThreadsMonitor);
procedure SetCallStackMonitor(const AValue: TCallStackMonitor);
procedure SetLocalsMonitor(const AValue: TLocalsMonitor);
procedure SetWatchesMonitor(const AValue: TWatchesMonitor);
procedure SetRegistersMonitor(AValue: TRegistersMonitor);
procedure SetBreakPoints(const AValue: TIDEBreakPoints);
protected
procedure JumpToUnitSource(AnUnitInfo: TDebuggerUnitInfo; ALine: Integer);
procedure DoWatchesChanged; virtual; // called if the WatchesMonitor object was changed
procedure DoRegistersChanged; virtual; // called if the WatchesMonitor object was changed
procedure DoBreakPointsChanged; virtual; // called if the BreakPoint(Monitor) object was changed
function GetBreakPointImageIndex(ABreakPoint: TIDEBreakPoint; AIsCurLine: Boolean = False): Integer;
property SnapshotNotification: TSnapshotNotification read GetSnapshotNotification;
@ -93,6 +98,7 @@ type
property CallStackNotification: TCallStackNotification read GetCallStackNotification;
property LocalsNotification: TLocalsNotification read GetLocalsNotification;
property WatchesNotification: TWatchesNotification read GetWatchesNotification;
property RegistersNotification: TRegistersNotification read GetRegistersNotification;
property BreakpointsNotification: TIDEBreakPointsNotification read GetBreakpointsNotification;
protected
// publish as needed
@ -101,6 +107,7 @@ type
property CallStackMonitor: TCallStackMonitor read FCallStackMonitor write SetCallStackMonitor;
property LocalsMonitor: TLocalsMonitor read FLocalsMonitor write SetLocalsMonitor;
property WatchesMonitor: TWatchesMonitor read FWatchesMonitor write SetWatchesMonitor;
property RegistersMonitor: TRegistersMonitor read FRegistersMonitor write SetRegistersMonitor;
property BreakPoints: TIDEBreakPoints read FBreakPoints write SetBreakPoints;
public
destructor Destroy; override;
@ -162,6 +169,17 @@ begin
Result := FSnapshotNotification;
end;
function TDebuggerDlg.GetRegistersNotification: TRegistersNotification;
begin
If FRegistersNotification = nil then begin
FRegistersNotification := TRegistersNotification.Create;
FRegistersNotification.AddReference;
if (FRegistersMonitor <> nil)
then FRegistersMonitor.AddNotification(FRegistersNotification);
end;
Result := FRegistersNotification;
end;
function TDebuggerDlg.GetThreadsNotification: TThreadsNotification;
begin
if FThreadsNotification = nil then begin
@ -217,6 +235,22 @@ begin
Result := FBreakpointsNotification;
end;
procedure TDebuggerDlg.SetRegistersMonitor(AValue: TRegistersMonitor);
begin
if FRegistersMonitor = AValue then exit;
BeginUpdate;
try
if (FRegistersMonitor <> nil) and (FRegistersNotification <> nil)
then FRegistersMonitor.RemoveNotification(FRegistersNotification);
FRegistersMonitor := AValue;
if (FRegistersMonitor <> nil) and (FRegistersNotification <> nil)
then FRegistersMonitor.AddNotification(FRegistersNotification);
DoRegistersChanged;
finally
EndUpdate;
end;
end;
procedure TDebuggerDlg.SetSnapshotManager(const AValue: TSnapshotManager);
begin
if FSnapshotManager = AValue then exit;
@ -350,6 +384,11 @@ begin
//
end;
procedure TDebuggerDlg.DoRegistersChanged;
begin
//
end;
procedure TDebuggerDlg.DoBreakPointsChanged;
begin
//
@ -438,6 +477,12 @@ begin
SetWatchesMonitor(nil);
ReleaseRefAndNil(FWatchesNotification);
if FRegistersNotification <> nil then begin;
FRegistersNotification.OnChange := nil;
end;
SetRegistersMonitor(nil);
ReleaseRefAndNil(FRegistersNotification);
if FBreakpointsNotification <> nil then begin;
FBreakpointsNotification.OnAdd := nil;
FBreakpointsNotification.OnRemove := nil;

151
debugger/registersdlg.pp
View File

@ -80,14 +80,13 @@ type
procedure DispDefaultClick(Sender: TObject);
procedure lvRegistersSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
procedure ToolButtonDispTypeClick(Sender: TObject);
function GetCurrentRegisters: TRegisters;
private
FRegisters: TIDERegisters;
FRegistersNotification: TIDERegistersNotification;
FNeedUpdateAgain: Boolean;
FPowerImgIdx, FPowerImgIdxGrey: Integer;
procedure RegistersChanged(Sender: TObject);
procedure SetRegisters(const AValue: TIDERegisters);
function IndexOfName(AName: String): Integer;
protected
procedure DoRegistersChanged; override;
procedure DoBeginUpdate; override;
procedure DoEndUpdate; override;
function ColSizeGetter(AColId: Integer; var ASize: Integer): Boolean;
@ -96,7 +95,10 @@ type
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Registers: TIDERegisters read FRegisters write SetRegisters;
property RegistersMonitor;
property ThreadsMonitor;
property CallStackMonitor;
//property SnapshotManager;
end;
@ -132,9 +134,10 @@ var
i: Integer;
begin
inherited Create(AOwner);
FRegistersNotification := TIDERegistersNotification.Create;
FRegistersNotification.AddReference;
FRegistersNotification.OnChange := @RegistersChanged;
ThreadsNotification.OnCurrent := @RegistersChanged;
CallstackNotification.OnCurrent := @RegistersChanged;
RegistersNotification.OnChange := @RegistersChanged;
Caption:= lisRegisters;
lvRegisters.Columns[0].Caption:= lisName;
lvRegisters.Columns[1].Caption:= lisValue;
@ -190,9 +193,6 @@ end;
destructor TRegistersDlg.Destroy;
begin
SetRegisters(nil);
FRegistersNotification.OnChange := nil;
FRegistersNotification.ReleaseReference;
inherited Destroy;
end;
@ -226,23 +226,23 @@ end;
procedure TRegistersDlg.DispDefaultClick(Sender: TObject);
var
n, i: Integer;
n: Integer;
Item: TListItem;
Reg: TRegisters;
RegVal: TRegisterValue;
begin
ToolButtonPower.Down := True;
FRegisters.BeginUpdate;
try
for n := 0 to lvRegisters.Items.Count -1 do
begin
Item := lvRegisters.Items[n];
if Item.Selected then begin
i := IndexOfName(Item.Caption);
if i >= 0
then FRegisters.Formats[i] := TRegisterDisplayFormat(TMenuItem(Sender).Tag);
end;
Reg := GetCurrentRegisters;
if Reg = nil then exit;
for n := 0 to lvRegisters.Items.Count -1 do
begin
Item := lvRegisters.Items[n];
if Item.Selected then begin
RegVal := Reg.EntriesByName[Item.Caption];
if RegVal <> nil then
RegVal.DisplayFormat := TRegisterDisplayFormat(TMenuItem(Sender).Tag);
end;
finally
FRegisters.EndUpdate;
end;
lvRegistersSelectItem(nil, nil, True);
end;
@ -250,23 +250,28 @@ end;
procedure TRegistersDlg.lvRegistersSelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
var
n, i, j: Integer;
n, j: Integer;
SelFormat: TRegisterDisplayFormat;
MultiFormat: Boolean;
Reg: TRegisters;
RegVal: TRegisterValue;
begin
j := 0;
MultiFormat := False;
SelFormat := rdDefault;
Reg := GetCurrentRegisters;
if Reg = nil then exit;
for n := 0 to lvRegisters.Items.Count -1 do
begin
Item := lvRegisters.Items[n];
if Item.Selected then begin
i := IndexOfName(Item.Caption);
if i >= 0 then begin
RegVal := Reg.EntriesByName[Item.Caption];
if RegVal <> nil then begin
if j = 0
then SelFormat := FRegisters.Formats[i];
then SelFormat := RegVal.DisplayFormat;
inc(j);
if SelFormat <> FRegisters.Formats[i] then begin
if SelFormat <> RegVal.DisplayFormat then begin
MultiFormat := True;
break;
end;
@ -321,25 +326,53 @@ begin
ToolButtonDispType.CheckMenuDropdown;
end;
function TRegistersDlg.GetCurrentRegisters: TRegisters;
var
CurThreadId, CurStackFrame: Integer;
begin
Result := nil;
if (ThreadsMonitor = nil) or
(ThreadsMonitor.CurrentThreads = nil) or
(CallStackMonitor = nil) or
(CallStackMonitor.CurrentCallStackList = nil) or
(RegistersMonitor = nil)
then
exit;
CurThreadId := ThreadsMonitor.CurrentThreads.CurrentThreadId;
if (CallStackMonitor.CurrentCallStackList.EntriesForThreads[CurThreadId] = nil) then
exit;
CurStackFrame := CallStackMonitor.CurrentCallStackList.EntriesForThreads[CurThreadId].CurrentIndex;
Result := RegistersMonitor.CurrentRegistersList[CurThreadId, CurStackFrame];
end;
procedure TRegistersDlg.RegistersChanged(Sender: TObject);
var
n, idx: Integer;
n, idx, Cnt: Integer;
List: TStringList;
Item: TListItem;
S: String;
Reg: TRegisters;
begin
if (not ToolButtonPower.Down) then exit;
if IsUpdating then begin
FNeedUpdateAgain := True;
exit;
end;
FNeedUpdateAgain := False;
Reg := GetCurrentRegisters;
if Reg = nil then begin
lvRegisters.Items.Clear;
exit;
end;
List := TStringList.Create;
try
BeginUpdate;
try
if FRegisters = nil
then begin
lvRegisters.Items.Clear;
Exit;
end;
//Get existing items
for n := 0 to lvRegisters.Items.Count - 1 do
begin
@ -350,23 +383,26 @@ begin
end;
// add/update entries
for n := 0 to FRegisters.Count - 1 do
Cnt := Reg.Count; // Count may trigger changes
FNeedUpdateAgain := False; // changes after this point, and we must update again
for n := 0 to Cnt - 1 do
begin
idx := List.IndexOf(Uppercase(FRegisters.Names[n]));
idx := List.IndexOf(Uppercase(Reg[n].Name));
if idx = -1
then begin
// New entry
Item := lvRegisters.Items.Add;
Item.Caption := FRegisters.Names[n];
Item.SubItems.Add(FRegisters.Values[n]);
Item.Caption := Reg[n].Name;
Item.SubItems.Add(Reg[n].Value);
end
else begin
// Existing entry
Item := TListItem(List.Objects[idx]);
Item.SubItems[0] := FRegisters.Values[n];
Item.SubItems[0] := Reg[n].Value;
List.Delete(idx);
end;
if FRegisters.Modified[n]
if Reg[n].Modified
then Item.ImageIndex := 0
else Item.ImageIndex := -1;
end;
@ -381,37 +417,13 @@ begin
finally
List.Free;
end;
lvRegistersSelectItem(nil, nil, True);
end;
procedure TRegistersDlg.SetRegisters(const AValue: TIDERegisters);
procedure TRegistersDlg.DoRegistersChanged;
begin
if FRegisters = AValue then Exit;
BeginUpdate;
try
if FRegisters <> nil
then begin
FRegisters.RemoveNotification(FRegistersNotification);
end;
FRegisters := AValue;
if FRegisters <> nil
then begin
FRegisters.AddNotification(FRegistersNotification);
end;
RegistersChanged(FRegisters);
finally
EndUpdate;
end;
end;
function TRegistersDlg.IndexOfName(AName: String): Integer;
begin
Result := FRegisters.Count - 1;
while (Result >= 0) and (FRegisters.Names[Result] <> AName) do dec(Result);
RegistersChanged(nil);
end;
procedure TRegistersDlg.DoBeginUpdate;
@ -422,6 +434,7 @@ end;
procedure TRegistersDlg.DoEndUpdate;
begin
lvRegisters.EndUpdate;
if FNeedUpdateAgain then RegistersChanged(nil);
end;
function TRegistersDlg.ColSizeGetter(AColId: Integer; var ASize: Integer): Boolean;

4
ide/basedebugmanager.pas
View File

@ -117,7 +117,7 @@ type
FLineInfo: TIDELineInfo;
FWatches: TWatchesMonitor;
FThreads: TThreadsMonitor;
FRegisters: TIDERegisters;
FRegisters: TRegistersMonitor;
FSnapshots: TSnapshotManager;
FManagerStates: TDebugManagerStates;
function GetState: TDBGState; virtual; abstract;
@ -220,7 +220,7 @@ type
property Disassembler: TIDEDisassembler read FDisassembler;
property Locals: TLocalsMonitor read FLocals;
property LineInfo: TIDELineInfo read FLineInfo;
property Registers: TIDERegisters read FRegisters;
property Registers: TRegistersMonitor read FRegisters;
property Signals: TIDESignals read FSignals; // A list of actions for signals we know of
property Watches: TWatchesMonitor read FWatches;
property Threads: TThreadsMonitor read FThreads;

10
ide/debugmanager.pas
View File

@ -1583,7 +1583,9 @@ var
TheDialog: TRegistersDlg;
begin
TheDialog := TRegistersDlg(FDialogs[ddtRegisters]);
TheDialog.Registers := FRegisters;
TheDialog.ThreadsMonitor := FThreads;
TheDialog.CallStackMonitor := FCallStack;
TheDialog.RegistersMonitor := FRegisters;
end;
procedure TDebugManager.InitAssemblerDlg;
@ -1663,7 +1665,7 @@ begin
FLineInfo := TIDELineInfo.Create;
FCallStack := TCallStackMonitor.Create;
FDisassembler := TIDEDisassembler.Create;
FRegisters := TIDERegisters.Create;
FRegisters := TRegistersMonitor.Create;
FSnapshots := TSnapshotManager.Create;
FSnapshots.Threads := FThreads;
@ -2955,7 +2957,7 @@ begin
FCallStack.Supplier := nil;
FDisassembler.Master := nil;
FSignals.Master := nil;
FRegisters.Master := nil;
FRegisters.Supplier := nil;
FSnapshots.Debugger := nil;
end
else begin
@ -2969,7 +2971,7 @@ begin
FCallStack.UnitInfoProvider := FUnitInfoProvider;
FDisassembler.Master := FDebugger.Disassembler;
FSignals.Master := FDebugger.Signals;
FRegisters.Master := FDebugger.Registers;
FRegisters.Supplier := FDebugger.Registers;
FSnapshots.Debugger := FDebugger;
FDebugger.Exceptions := FExceptions;