From ed539caf030cba68552afeb223d007293622118b Mon Sep 17 00:00:00 2001 From: martin Date: Mon, 24 Feb 2014 01:44:49 +0000 Subject: [PATCH] Debugger: refactor register git-svn-id: trunk@44216 - --- .../debuggerintf/dbgintfdebuggerbase.pp | 671 ++++++++++------- .../debuggerintf/dbgintfmiscclasses.pas | 15 +- components/lazdebuggerfp/fpgdbmidebugger.pp | 28 +- components/lazdebuggergdbmi/gdbmidebugger.pp | 675 ++++++------------ debugger/debugger.pp | 369 ++++++---- debugger/debuggerdlg.pp | 45 ++ debugger/registersdlg.pp | 151 ++-- ide/basedebugmanager.pas | 4 +- ide/debugmanager.pas | 10 +- 9 files changed, 1035 insertions(+), 933 deletions(-) diff --git a/components/debuggerintf/dbgintfdebuggerbase.pp b/components/debuggerintf/dbgintfdebuggerbase.pp index 09804ca4de..6420b3ff33 100644 --- a/components/debuggerintf/dbgintfdebuggerbase.pp +++ b/components/debuggerintf/dbgintfdebuggerbase.pp @@ -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; diff --git a/components/debuggerintf/dbgintfmiscclasses.pas b/components/debuggerintf/dbgintfmiscclasses.pas index b07b49df35..0a5f467396 100644 --- a/components/debuggerintf/dbgintfmiscclasses.pas +++ b/components/debuggerintf/dbgintfmiscclasses.pas @@ -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; diff --git a/components/lazdebuggerfp/fpgdbmidebugger.pp b/components/lazdebuggerfp/fpgdbmidebugger.pp index fd56bb2ae2..65fba0f1a6 100644 --- a/components/lazdebuggerfp/fpgdbmidebugger.pp +++ b/components/lazdebuggerfp/fpgdbmidebugger.pp @@ -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); diff --git a/components/lazdebuggergdbmi/gdbmidebugger.pp b/components/lazdebuggergdbmi/gdbmidebugger.pp index 3eed5ac91b..972cc8eef1 100644 --- a/components/lazdebuggergdbmi/gdbmidebugger.pp +++ b/components/lazdebuggergdbmi/gdbmidebugger.pp @@ -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; diff --git a/debugger/debugger.pp b/debugger/debugger.pp index d646760876..af4512cca3 100644 --- a/debugger/debugger.pp +++ b/debugger/debugger.pp @@ -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; (******************************************************************************) (******************************************************************************) diff --git a/debugger/debuggerdlg.pp b/debugger/debuggerdlg.pp index 4af6b6ae06..da3a50d553 100644 --- a/debugger/debuggerdlg.pp +++ b/debugger/debuggerdlg.pp @@ -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; diff --git a/debugger/registersdlg.pp b/debugger/registersdlg.pp index 615b2e6991..97a4a9932a 100644 --- a/debugger/registersdlg.pp +++ b/debugger/registersdlg.pp @@ -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; diff --git a/ide/basedebugmanager.pas b/ide/basedebugmanager.pas index 8cef15ce68..0d33234bb7 100644 --- a/ide/basedebugmanager.pas +++ b/ide/basedebugmanager.pas @@ -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; diff --git a/ide/debugmanager.pas b/ide/debugmanager.pas index 77e54b9f4e..09122e8c3f 100644 --- a/ide/debugmanager.pas +++ b/ide/debugmanager.pas @@ -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;