mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-10-24 03:42:35 +02:00
+ Added Registers debug view
git-svn-id: trunk@17431 -
This commit is contained in:
marc
parent
1db8426dea
commit
88ff1df906
3
.gitattributes
vendored
3
.gitattributes
vendored
@ -1570,6 +1570,9 @@ debugger/localsdlg.lrs svneol=native#text/pascal
|
||||
debugger/localsdlg.pp svneol=native#text/pascal
|
||||
debugger/processdebugger.pp svneol=native#text/plain
|
||||
debugger/processlist.pas svneol=native#text/pascal
|
||||
debugger/registersdlg.lfm svneol=native#text/pascal
|
||||
debugger/registersdlg.lrs svneol=native#text/pascal
|
||||
debugger/registersdlg.pp svneol=native#text/pascal
|
||||
debugger/sshgdbmidebugger.pas svneol=native#text/pascal
|
||||
debugger/test/debugtest.pp svneol=native#text/pascal
|
||||
debugger/test/debugtestform.lrs svneol=native#text/pascal
|
||||
|
||||
@ -631,6 +631,68 @@ type
|
||||
end;
|
||||
|
||||
|
||||
(******************************************************************************)
|
||||
(******************************************************************************)
|
||||
(** **)
|
||||
(** R E G I S T E R S **)
|
||||
(** **)
|
||||
(******************************************************************************)
|
||||
(******************************************************************************)
|
||||
|
||||
{ TBaseRegisters }
|
||||
|
||||
TBaseRegisters = class(TObject)
|
||||
private
|
||||
protected
|
||||
function GetName(const AnIndex: Integer): String; virtual;
|
||||
function GetValue(const AnIndex: Integer): String; virtual;
|
||||
public
|
||||
constructor Create;
|
||||
function Count: Integer; virtual;
|
||||
public
|
||||
property Names[const AnIndex: Integer]: String read GetName;
|
||||
property Values[const AnIndex: Integer]: String read GetValue;
|
||||
end;
|
||||
|
||||
{ TIDERegisters }
|
||||
|
||||
TIDERegistersNotification = class(TDebuggerNotification)
|
||||
private
|
||||
FOnChange: TNotifyEvent;
|
||||
public
|
||||
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
||||
end;
|
||||
|
||||
TIDERegisters = class(TBaseRegisters)
|
||||
private
|
||||
FNotificationList: TList;
|
||||
protected
|
||||
procedure NotifyChange;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure AddNotification(const ANotification: TIDERegistersNotification);
|
||||
procedure RemoveNotification(const ANotification: TIDERegistersNotification);
|
||||
end;
|
||||
|
||||
{ TDBGRegisters }
|
||||
|
||||
TDBGRegisters = class(TBaseRegisters)
|
||||
private
|
||||
FDebugger: TDebugger; // reference to our debugger
|
||||
FOnChange: TNotifyEvent;
|
||||
protected
|
||||
procedure Changed; virtual;
|
||||
procedure DoChange;
|
||||
procedure DoStateChange(const AOldState: TDBGState); virtual;
|
||||
function GetCount: Integer; virtual;
|
||||
property Debugger: TDebugger read FDebugger;
|
||||
public
|
||||
function Count: Integer; override;
|
||||
constructor Create(const ADebugger: TDebugger);
|
||||
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
||||
end;
|
||||
|
||||
(******************************************************************************)
|
||||
(******************************************************************************)
|
||||
(** **)
|
||||
@ -986,6 +1048,7 @@ type
|
||||
//FExceptions: TDBGExceptions;
|
||||
FFileName: String;
|
||||
FLocals: TDBGLocals;
|
||||
FRegisters: TDBGRegisters;
|
||||
FShowConsole: Boolean;
|
||||
FSignals: TDBGSignals;
|
||||
FState: TDBGState;
|
||||
@ -1008,6 +1071,7 @@ type
|
||||
protected
|
||||
function CreateBreakPoints: TDBGBreakPoints; virtual;
|
||||
function CreateLocals: TDBGLocals; virtual;
|
||||
function CreateRegisters: TDBGRegisters; virtual;
|
||||
function CreateCallStack: TDBGCallStack; virtual;
|
||||
function CreateWatches: TDBGWatches; virtual;
|
||||
function CreateSignals: TDBGSignals; virtual;
|
||||
@ -1066,6 +1130,7 @@ type
|
||||
property ExternalDebugger: String read FExternalDebugger; // The name of the debugger executable
|
||||
property FileName: String read FFileName write SetFileName; // The name of the exe to be debugged
|
||||
property Locals: TDBGLocals read FLocals; // list of all localvars etc
|
||||
property Registers: TDBGRegisters 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
|
||||
@ -1245,6 +1310,7 @@ begin
|
||||
|
||||
FBreakPoints := CreateBreakPoints;
|
||||
FLocals := CreateLocals;
|
||||
FRegisters := CreateRegisters;
|
||||
FCallStack := CreateCallStack;
|
||||
FWatches := CreateWatches;
|
||||
FExceptions := CreateExceptions;
|
||||
@ -1277,6 +1343,11 @@ begin
|
||||
Result := TDebuggerProperties.Create;
|
||||
end;
|
||||
|
||||
function TDebugger.CreateRegisters: TDBGRegisters;
|
||||
begin
|
||||
Result := TDBGRegisters.Create(Self);
|
||||
end;
|
||||
|
||||
function TDebugger.CreateSignals: TDBGSignals;
|
||||
begin
|
||||
Result := TDBGSignals.Create(Self, TDBGSignal);
|
||||
@ -1304,12 +1375,14 @@ begin
|
||||
|
||||
FBreakPoints.FDebugger := nil;
|
||||
FLocals.FDebugger := nil;
|
||||
FRegisters.FDebugger := nil;
|
||||
FCallStack.FDebugger := nil;
|
||||
FWatches.FDebugger := nil;
|
||||
|
||||
FreeAndNil(FExceptions);
|
||||
FreeAndNil(FBreakPoints);
|
||||
FreeAndNil(FLocals);
|
||||
FreeAndNil(FRegisters);
|
||||
FreeAndNil(FCallStack);
|
||||
FreeAndNil(FWatches);
|
||||
FreeAndNil(FDebuggerEnvironment);
|
||||
@ -1562,6 +1635,7 @@ begin
|
||||
FState := AValue;
|
||||
FBreakpoints.DoStateChange(OldState);
|
||||
FLocals.DoStateChange(OldState);
|
||||
FRegisters.DoStateChange(OldState);
|
||||
FCallStack.DoStateChange(OldState);
|
||||
FWatches.DoStateChange(OldState);
|
||||
DoState(OldState);
|
||||
@ -3023,6 +3097,122 @@ begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
(******************************************************************************)
|
||||
(******************************************************************************)
|
||||
(** **)
|
||||
(** R E G I S T E R S **)
|
||||
(** **)
|
||||
(******************************************************************************)
|
||||
(******************************************************************************)
|
||||
|
||||
{ =========================================================================== }
|
||||
{ TBaseRegisters }
|
||||
{ =========================================================================== }
|
||||
|
||||
function TBaseRegisters.Count: Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
constructor TBaseRegisters.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
end;
|
||||
|
||||
function TBaseRegisters.GetName(const AnIndex: Integer): String;
|
||||
begin
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
function TBaseRegisters.GetValue(const AnIndex: Integer): String;
|
||||
begin
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
{ =========================================================================== }
|
||||
{ TIDERegisters }
|
||||
{ =========================================================================== }
|
||||
|
||||
procedure TIDERegisters.AddNotification(const ANotification: TIDERegistersNotification);
|
||||
begin
|
||||
FNotificationList.Add(ANotification);
|
||||
ANotification.AddReference;
|
||||
end;
|
||||
|
||||
constructor TIDERegisters.Create;
|
||||
begin
|
||||
FNotificationList := TList.Create;
|
||||
inherited Create;
|
||||
end;
|
||||
|
||||
destructor TIDERegisters.Destroy;
|
||||
var
|
||||
n: Integer;
|
||||
begin
|
||||
for n := FNotificationList.Count - 1 downto 0 do
|
||||
TDebuggerNotification(FNotificationList[n]).ReleaseReference;
|
||||
|
||||
inherited;
|
||||
|
||||
FreeAndNil(FNotificationList);
|
||||
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);
|
||||
begin
|
||||
FNotificationList.Remove(ANotification);
|
||||
ANotification.ReleaseReference;
|
||||
end;
|
||||
|
||||
{ =========================================================================== }
|
||||
{ TDBGRegisters }
|
||||
{ =========================================================================== }
|
||||
|
||||
function TDBGRegisters.Count: Integer;
|
||||
begin
|
||||
if (FDebugger <> nil)
|
||||
and (FDebugger.State = dsPause)
|
||||
then Result := GetCount
|
||||
else Result := 0;
|
||||
end;
|
||||
|
||||
constructor TDBGRegisters.Create(const ADebugger: TDebugger);
|
||||
begin
|
||||
inherited Create;
|
||||
FDebugger := ADebugger;
|
||||
end;
|
||||
|
||||
procedure TDBGRegisters.DoChange;
|
||||
begin
|
||||
if Assigned(FOnChange) then FOnChange(Self);
|
||||
end;
|
||||
|
||||
procedure TDBGRegisters.DoStateChange(const AOldState: TDBGState);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TDBGRegisters.Changed;
|
||||
begin
|
||||
DoChange;
|
||||
end;
|
||||
|
||||
function TDBGRegisters.GetCount: Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
(******************************************************************************)
|
||||
(******************************************************************************)
|
||||
(** **)
|
||||
|
||||
@ -175,6 +175,7 @@ type
|
||||
function ChangeFileName: Boolean; override;
|
||||
function CreateBreakPoints: TDBGBreakPoints; override;
|
||||
function CreateLocals: TDBGLocals; override;
|
||||
function CreateRegisters: TDBGRegisters; override;
|
||||
function CreateCallStack: TDBGCallStack; override;
|
||||
function CreateWatches: TDBGWatches; override;
|
||||
function GetSupportedCommands: TDBGCommands; override;
|
||||
@ -279,6 +280,31 @@ type
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
{ TGDBMIRegisters }
|
||||
|
||||
TGDBMIRegisters = class(TDBGRegisters)
|
||||
private
|
||||
FRegisters: array of record
|
||||
Name: String;
|
||||
Value: String;
|
||||
Modified: Boolean;
|
||||
end;
|
||||
FRegistersValid: Boolean;
|
||||
FValuesValid: Boolean;
|
||||
procedure RegistersNeeded;
|
||||
procedure ValuesNeeded;
|
||||
protected
|
||||
procedure DoStateChange(const AOldState: TDBGState); override;
|
||||
procedure Invalidate;
|
||||
function GetCount: Integer; override;
|
||||
function GetName(const AnIndex: Integer): String; override;
|
||||
function GetValue(const AnIndex: Integer): String; override;
|
||||
public
|
||||
procedure Changed; override;
|
||||
constructor Create(const ADebugger: TDebugger);
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
{ TGDBMIWatch }
|
||||
|
||||
TGDBMIWatch = class(TDBGWatch)
|
||||
@ -777,6 +803,11 @@ begin
|
||||
Result := TGDBMIDebuggerProperties.Create;
|
||||
end;
|
||||
|
||||
function TGDBMIDebugger.CreateRegisters: TDBGRegisters;
|
||||
begin
|
||||
Result := TGDBMIRegisters.Create(Self);
|
||||
end;
|
||||
|
||||
function TGDBMIDebugger.CreateWatches: TDBGWatches;
|
||||
begin
|
||||
Result := TGDBMIWatches.Create(Self, TGDBMIWatch);
|
||||
@ -2810,6 +2841,162 @@ begin
|
||||
FLocalsValid := True;
|
||||
end;
|
||||
|
||||
{ =========================================================================== }
|
||||
{ TGDBMIRegisters }
|
||||
{ =========================================================================== }
|
||||
|
||||
procedure TGDBMIRegisters.Changed;
|
||||
begin
|
||||
Invalidate;
|
||||
inherited Changed;
|
||||
end;
|
||||
|
||||
constructor TGDBMIRegisters.Create(const ADebugger: TDebugger);
|
||||
begin
|
||||
FValuesValid := False;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
destructor TGDBMIRegisters.Destroy;
|
||||
begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TGDBMIRegisters.DoStateChange(const AOldState: TDBGState);
|
||||
begin
|
||||
if Debugger <> nil
|
||||
then begin
|
||||
case Debugger.State of
|
||||
dsPause: DoChange;
|
||||
dsStop : FRegistersValid := False;
|
||||
else
|
||||
Invalidate
|
||||
end;
|
||||
end
|
||||
else Invalidate;
|
||||
end;
|
||||
|
||||
procedure TGDBMIRegisters.Invalidate;
|
||||
var
|
||||
n: Integer;
|
||||
begin
|
||||
for n := Low(FRegisters) to High(FRegisters) do
|
||||
begin
|
||||
FRegisters[n].Value := '';
|
||||
FRegisters[n].Modified := False;
|
||||
end;
|
||||
FValuesValid := False;
|
||||
end;
|
||||
|
||||
function TGDBMIRegisters.GetCount: Integer;
|
||||
begin
|
||||
if (Debugger <> nil)
|
||||
and (Debugger.State = dsPause)
|
||||
then RegistersNeeded;
|
||||
|
||||
Result := Length(FRegisters)
|
||||
end;
|
||||
|
||||
function TGDBMIRegisters.GetName(const AnIndex: Integer): String;
|
||||
begin
|
||||
if (Debugger <> nil)
|
||||
and (Debugger.State = dsPause)
|
||||
then RegistersNeeded;
|
||||
|
||||
if FRegistersValid
|
||||
and (AnIndex >= Low(FRegisters))
|
||||
and (AnIndex <= High(FRegisters))
|
||||
then Result := FRegisters[AnIndex].Name
|
||||
else Result := '';
|
||||
end;
|
||||
|
||||
function TGDBMIRegisters.GetValue(const AnIndex: Integer): String;
|
||||
begin
|
||||
if (Debugger <> nil)
|
||||
and (Debugger.State = dsPause)
|
||||
then ValuesNeeded;
|
||||
|
||||
if FValuesValid
|
||||
and FRegistersValid
|
||||
and (AnIndex >= Low(FRegisters))
|
||||
and (AnIndex <= High(FRegisters))
|
||||
then Result := FRegisters[AnIndex].Value
|
||||
else Result := '';
|
||||
end;
|
||||
|
||||
procedure TGDBMIRegisters.RegistersNeeded;
|
||||
var
|
||||
R: TGDBMIExecResult;
|
||||
List: TGDBMINameValueList;
|
||||
n: Integer;
|
||||
begin
|
||||
if Debugger = nil then Exit;
|
||||
if FRegistersValid then Exit;
|
||||
|
||||
FRegistersValid := True;
|
||||
|
||||
TGDBMIDebugger(Debugger).ExecuteCommand('-data-list-register-names', [cfIgnoreError], R);
|
||||
if R.State = dsError then Exit;
|
||||
|
||||
List := TGDBMINameValueList.Create(R, ['register-names']);
|
||||
SetLength(FRegisters, List.Count);
|
||||
for n := 0 to List.Count - 1 do
|
||||
begin
|
||||
FRegisters[n].Name := UnQuote(List.GetString(n));
|
||||
FRegisters[n].Value := '';
|
||||
FRegisters[n].Modified := False;
|
||||
end;
|
||||
FreeAndNil(List);
|
||||
end;
|
||||
|
||||
procedure TGDBMIRegisters.ValuesNeeded;
|
||||
var
|
||||
R: TGDBMIExecResult;
|
||||
List, ValList: TGDBMINameValueList;
|
||||
Item: PGDBMINameValue;
|
||||
n, idx: Integer;
|
||||
begin
|
||||
FValuesValid := True;
|
||||
|
||||
for n := Low(FRegisters) to High(FRegisters) do
|
||||
begin
|
||||
FRegisters[n].Value := '';
|
||||
FRegisters[n].Modified := False;
|
||||
end;
|
||||
|
||||
TGDBMIDebugger(Debugger).ExecuteCommand('-data-list-register-values N', [cfIgnoreError], 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^.NamePtr, Item^.NameLen);
|
||||
idx := StrToIntDef(Unquote(ValList.Values['number']), -1);
|
||||
if idx < Low(FRegisters) then Continue;
|
||||
if idx > High(FRegisters) then Continue;
|
||||
|
||||
FRegisters[idx].Value := Unquote(ValList.Values['value']);
|
||||
end;
|
||||
FreeAndNil(List);
|
||||
FreeAndNil(ValList);
|
||||
|
||||
TGDBMIDebugger(Debugger).ExecuteCommand('-data-list-changed-registers', [cfIgnoreError], R);
|
||||
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(FRegisters) then Continue;
|
||||
if idx > High(FRegisters) then Continue;
|
||||
|
||||
FRegisters[idx].Modified := True;
|
||||
end;
|
||||
FreeAndNil(List);
|
||||
end;
|
||||
|
||||
{ =========================================================================== }
|
||||
{ TGDBMIWatch }
|
||||
{ =========================================================================== }
|
||||
|
||||
@ -71,8 +71,8 @@ begin
|
||||
FLocalsNotification.AddReference;
|
||||
FLocalsNotification.OnChange := @LocalsChanged;
|
||||
Caption:= lisLocals;
|
||||
lvLocals.Columns[0].Caption:= lisDebugOptionsFrmName;
|
||||
lvLocals.Columns[1].Caption:= dlgValueColor;
|
||||
lvLocals.Columns[0].Caption:= lisLocalsDlgName;
|
||||
lvLocals.Columns[1].Caption:= lisLocalsDlgValue;
|
||||
end;
|
||||
|
||||
destructor TLocalsDlg.Destroy;
|
||||
|
||||
27
debugger/registersdlg.lfm
Normal file
27
debugger/registersdlg.lfm
Normal file
@ -0,0 +1,27 @@
|
||||
inherited RegistersDlg: TRegistersDlg
|
||||
Left = 359
|
||||
Height = 253
|
||||
Top = 126
|
||||
Width = 346
|
||||
ActiveControl = lvRegisters
|
||||
Caption = 'Registers'
|
||||
ClientHeight = 253
|
||||
ClientWidth = 346
|
||||
object lvRegisters: TListView[0]
|
||||
Height = 253
|
||||
Width = 346
|
||||
Align = alClient
|
||||
Columns = <
|
||||
item
|
||||
Caption = 'Name'
|
||||
Width = 150
|
||||
end
|
||||
item
|
||||
Caption = 'Value'
|
||||
end>
|
||||
MultiSelect = True
|
||||
RowSelect = True
|
||||
TabOrder = 0
|
||||
ViewStyle = vsReport
|
||||
end
|
||||
end
|
||||
22
debugger/registersdlg.lrs
Normal file
22
debugger/registersdlg.lrs
Normal file
@ -0,0 +1,22 @@
|
||||
{ This is an automatically generated lazarus resource file }
|
||||
|
||||
LazarusResources.Add('TLocalsDlg','FORMDATA',[
|
||||
'TPF0'#10'TLocalsDlg'#9'LocalsDlg'#13'ActiveControl'#7#8'lvLocals'#7'Caption'
|
||||
+#6#6'Locals'#12'ClientHeight'#3#200#0#11'ClientWidth'#3#244#1#13'PixelsPerIn'
|
||||
+'ch'#2'p'#18'HorzScrollBar.Page'#3#243#1#18'VertScrollBar.Page'#3#199#0#4'Le'
|
||||
+'ft'#3'g'#1#6'Height'#3#200#0#3'Top'#2'~'#5'Width'#3#244#1#0#9'TListView'#8
|
||||
+'lvLocals'#5'Align'#7#8'alClient'#7'Columns'#14#1#7'Caption'#6#4'Name'#5'Wid'
|
||||
+'th'#3#150#0#0#1#7'Caption'#6#5'Value'#0#0#11'MultiSelect'#9#9'RowSelect'#9#8
|
||||
+'TabOrder'#2#0#9'ViewStyle'#7#8'vsReport'#6'Height'#3#200#0#5'Width'#3#244#1
|
||||
+#0#0#0
|
||||
]);
|
||||
|
||||
LazarusResources.Add('TRegistersDlg','FORMDATA',[
|
||||
'TPF0'#241#13'TRegistersDlg'#12'RegistersDlg'#4'Left'#3'g'#1#6'Height'#3#253#0
|
||||
+#3'Top'#2'~'#5'Width'#3'Z'#1#13'ActiveControl'#7#11'lvRegisters'#7'Caption'#6
|
||||
+#9'Registers'#12'ClientHeight'#3#253#0#11'ClientWidth'#3'Z'#1#0#242#2#0#9'TL'
|
||||
+'istView'#11'lvRegisters'#6'Height'#3#253#0#5'Width'#3'Z'#1#5'Align'#7#8'alC'
|
||||
+'lient'#7'Columns'#14#1#7'Caption'#6#4'Name'#5'Width'#3#150#0#0#1#7'Caption'
|
||||
+#6#5'Value'#0#0#11'MultiSelect'#9#9'RowSelect'#9#8'TabOrder'#2#0#9'ViewStyle'
|
||||
+#7#8'vsReport'#0#0#0
|
||||
]);
|
||||
180
debugger/registersdlg.pp
Normal file
180
debugger/registersdlg.pp
Normal file
@ -0,0 +1,180 @@
|
||||
{ $Id$ }
|
||||
{ ----------------------------------------------
|
||||
registersdlg.pp - Overview of registers
|
||||
----------------------------------------------
|
||||
|
||||
@created(Sun Nov 16th WET 2008)
|
||||
@lastmod($Date$)
|
||||
@author(Marc Weustink <marc@@dommelstein.net>)
|
||||
|
||||
This unit contains the registers debugger dialog.
|
||||
|
||||
|
||||
***************************************************************************
|
||||
* *
|
||||
* This source is free software; you can redistribute it and/or modify *
|
||||
* it under the terms of the GNU General Public License as published by *
|
||||
* the Free Software Foundation; either version 2 of the License, or *
|
||||
* (at your option) any later version. *
|
||||
* *
|
||||
* This code is distributed in the hope that it will be useful, but *
|
||||
* WITHOUT ANY WARRANTY; without even the implied warranty of *
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
|
||||
* General Public License for more details. *
|
||||
* *
|
||||
* A copy of the GNU General Public License is available on the World *
|
||||
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
|
||||
* obtain it by writing to the Free Software Foundation, *
|
||||
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
|
||||
* *
|
||||
***************************************************************************
|
||||
}
|
||||
unit RegistersDlg;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
LResources, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
||||
ComCtrls, Debugger, DebuggerDlg;
|
||||
|
||||
type
|
||||
TRegistersDlg = class(TDebuggerDlg)
|
||||
lvRegisters: TListView;
|
||||
private
|
||||
FRegisters: TIDERegisters;
|
||||
FRegistersNotification: TIDERegistersNotification;
|
||||
procedure RegistersChanged(Sender: TObject);
|
||||
procedure SetRegisters(const AValue: TIDERegisters);
|
||||
protected
|
||||
procedure DoBeginUpdate; override;
|
||||
procedure DoEndUpdate; override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
|
||||
property Registers: TIDERegisters read FRegisters write SetRegisters;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
uses
|
||||
LazarusIDEStrConsts;
|
||||
|
||||
{ TRegistersDlg }
|
||||
|
||||
constructor TRegistersDlg.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FRegistersNotification := TIDERegistersNotification.Create;
|
||||
FRegistersNotification.AddReference;
|
||||
FRegistersNotification.OnChange := @RegistersChanged;
|
||||
Caption:= lisRegisters;
|
||||
lvRegisters.Columns[0].Caption:= lisRegistersDlgName;
|
||||
lvRegisters.Columns[1].Caption:= lisRegistersDlgValue;
|
||||
end;
|
||||
|
||||
destructor TRegistersDlg.Destroy;
|
||||
begin
|
||||
FRegistersNotification.OnChange := nil;
|
||||
FRegistersNotification.ReleaseReference;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TRegistersDlg.RegistersChanged(Sender: TObject);
|
||||
var
|
||||
n, idx: Integer;
|
||||
List: TStringList;
|
||||
Item: TListItem;
|
||||
S: String;
|
||||
begin
|
||||
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
|
||||
Item := lvRegisters.Items[n];
|
||||
S := Item.Caption;
|
||||
S := UpperCase(S);
|
||||
List.AddObject(S, Item);
|
||||
end;
|
||||
|
||||
// add/update entries
|
||||
for n := 0 to FRegisters.Count - 1 do
|
||||
begin
|
||||
idx := List.IndexOf(Uppercase(FRegisters.Names[n]));
|
||||
if idx = -1
|
||||
then begin
|
||||
// New entry
|
||||
Item := lvRegisters.Items.Add;
|
||||
Item.Caption := FRegisters.Names[n];
|
||||
Item.SubItems.Add(FRegisters.Values[n]);
|
||||
end
|
||||
else begin
|
||||
// Existing entry
|
||||
Item := TListItem(List.Objects[idx]);
|
||||
Item.SubItems[0] := FRegisters.Values[n];
|
||||
List.Delete(idx);
|
||||
end;
|
||||
end;
|
||||
|
||||
// remove obsolete entries
|
||||
for n := 0 to List.Count - 1 do
|
||||
lvRegisters.Items.Delete(TListItem(List.Objects[n]).Index);
|
||||
|
||||
finally
|
||||
EndUpdate;
|
||||
end;
|
||||
finally
|
||||
List.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRegistersDlg.SetRegisters(const AValue: TIDERegisters);
|
||||
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;
|
||||
|
||||
procedure TRegistersDlg.DoBeginUpdate;
|
||||
begin
|
||||
lvRegisters.BeginUpdate;
|
||||
end;
|
||||
|
||||
procedure TRegistersDlg.DoEndUpdate;
|
||||
begin
|
||||
lvRegisters.EndUpdate;
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I registersdlg.lrs}
|
||||
|
||||
end.
|
||||
|
||||
@ -2066,7 +2066,8 @@ Begin
|
||||
i:=AWinControl.ControlCount-1;
|
||||
while (i>=0) do begin
|
||||
ChildControl:=AWinControl.Controls[i];
|
||||
if (GetLookupRootForComponent(ChildControl)=FLookupRoot)
|
||||
// if (GetLookupRootForComponent(ChildControl)=FLookupRoot)
|
||||
if (ChildControl.Owner=FLookupRoot)
|
||||
and (IgnoreDeletingPersistent.IndexOf(ChildControl)<0) then begin
|
||||
//Debugln(['[TDesigner.RemoveComponentAndChilds] B ',dbgsName(APersistent),' Child=',dbgsName(ChildControl),' i=',i,' ',TheFormEditor.FindComponent(ChildControl)<>nil]);
|
||||
RemovePersistentAndChilds(ChildControl);
|
||||
|
||||
@ -64,6 +64,7 @@ type
|
||||
FBreakPoints: TIDEBreakPoints;
|
||||
FLocals: TIDELocals;
|
||||
FWatches: TIDEWatches;
|
||||
FRegisters: TIDERegisters;
|
||||
FManagerStates: TDebugManagerStates;
|
||||
function FindDebuggerClass(const Astring: String): TDebuggerClass;
|
||||
function GetState: TDBGState; virtual; abstract;
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -52,7 +52,7 @@ uses
|
||||
MainBar, MainIntf, MainBase, BaseBuildManager,
|
||||
SourceMarks,
|
||||
DebuggerDlg, Watchesdlg, BreakPointsdlg, LocalsDlg, WatchPropertyDlg,
|
||||
CallStackDlg, EvaluateDlg, DBGOutputForm,
|
||||
CallStackDlg, EvaluateDlg, RegistersDlg, DBGOutputForm,
|
||||
GDBMIDebugger, SSHGDBMIDebugger, ProcessDebugger,
|
||||
BaseDebugManager;
|
||||
|
||||
@ -64,7 +64,8 @@ type
|
||||
ddtWatches,
|
||||
ddtLocals,
|
||||
ddtCallStack,
|
||||
ddtEvaluate
|
||||
ddtEvaluate,
|
||||
ddtRegisters
|
||||
);
|
||||
|
||||
{ TDebugManager }
|
||||
@ -122,6 +123,7 @@ type
|
||||
procedure InitLocalsDlg;
|
||||
procedure InitCallStackDlg;
|
||||
procedure InitEvaluateDlg;
|
||||
procedure InitRegistersDlg;
|
||||
|
||||
procedure FreeDebugger;
|
||||
procedure ResetDebugger;
|
||||
@ -177,7 +179,7 @@ implementation
|
||||
const
|
||||
DebugDlgIDEWindow: array[TDebugDialogType] of TNonModalIDEWindow = (
|
||||
nmiwDbgOutput, nmiwBreakPoints, nmiwWatches, nmiwLocals, nmiwCallStack,
|
||||
nmiwEvaluate
|
||||
nmiwEvaluate, nmiwRegisters
|
||||
);
|
||||
|
||||
type
|
||||
@ -259,6 +261,8 @@ type
|
||||
property Master: TDBGWatches read FMaster write SetMaster;
|
||||
end;
|
||||
|
||||
{ TManagedLocals }
|
||||
|
||||
TManagedLocals = class(TIDELocals)
|
||||
private
|
||||
FMaster: TDBGLocals;
|
||||
@ -272,6 +276,21 @@ type
|
||||
property Master: TDBGLocals read FMaster write SetMaster;
|
||||
end;
|
||||
|
||||
{ TManagedRegisters }
|
||||
|
||||
TManagedRegisters = class(TIDERegisters)
|
||||
private
|
||||
FMaster: TDBGRegisters;
|
||||
procedure RegistersChanged(Sender: TObject);
|
||||
procedure SetMaster(const AMaster: TDBGRegisters);
|
||||
protected
|
||||
function GetName(const AnIndex: Integer): String; override;
|
||||
function GetValue(const AnIndex: Integer): String; override;
|
||||
public
|
||||
function Count: Integer; override;
|
||||
property Master: TDBGRegisters read FMaster write SetMaster;
|
||||
end;
|
||||
|
||||
{ TManagedCallStack }
|
||||
|
||||
TManagedCallStack = class(TIDECallStack)
|
||||
@ -472,6 +491,59 @@ begin
|
||||
else Result := Master.Count;
|
||||
end;
|
||||
|
||||
{ TManagedRegisters }
|
||||
|
||||
procedure TManagedRegisters.RegistersChanged(Sender: TObject);
|
||||
begin
|
||||
NotifyChange;
|
||||
end;
|
||||
|
||||
procedure TManagedRegisters.SetMaster(const AMaster: TDBGRegisters);
|
||||
var
|
||||
DoNotify: Boolean;
|
||||
begin
|
||||
if FMaster = AMaster then Exit;
|
||||
|
||||
if FMaster <> nil
|
||||
then begin
|
||||
FMaster.OnChange := nil;
|
||||
DoNotify := FMaster.Count <> 0;
|
||||
end
|
||||
else DoNotify := False;
|
||||
|
||||
FMaster := AMaster;
|
||||
|
||||
if FMaster <> nil
|
||||
then begin
|
||||
FMaster.OnChange := @RegistersChanged;
|
||||
DoNotify := DoNotify or (FMaster.Count <> 0);
|
||||
end;
|
||||
|
||||
if DoNotify
|
||||
then NotifyChange;
|
||||
end;
|
||||
|
||||
function TManagedRegisters.GetName(const AnIndex: Integer): String;
|
||||
begin
|
||||
if Master = nil
|
||||
then Result := inherited GetName(AnIndex)
|
||||
else Result := Master.Names[AnIndex];
|
||||
end;
|
||||
|
||||
function TManagedRegisters.GetValue(const AnIndex: Integer): String;
|
||||
begin
|
||||
if Master = nil
|
||||
then Result := inherited GetValue(AnIndex)
|
||||
else Result := Master.Values[AnIndex];
|
||||
end;
|
||||
|
||||
function TManagedRegisters.Count: Integer;
|
||||
begin
|
||||
if Master = nil
|
||||
then Result := 0
|
||||
else Result := Master.Count;
|
||||
end;
|
||||
|
||||
{ TManagedWatch }
|
||||
|
||||
procedure TManagedWatch.AssignTo(Dest: TPersistent);
|
||||
@ -1335,7 +1407,7 @@ procedure TDebugManager.ViewDebugDialog(const ADialogType: TDebugDialogType);
|
||||
const
|
||||
DEBUGDIALOGCLASS: array[TDebugDialogType] of TDebuggerDlgClass = (
|
||||
TDbgOutputForm, TBreakPointsDlg, TWatchesDlg, TLocalsDlg, TCallStackDlg,
|
||||
TEvaluateDlg
|
||||
TEvaluateDlg, TRegistersDlg
|
||||
);
|
||||
var
|
||||
CurDialog: TDebuggerDlg;
|
||||
@ -1356,6 +1428,7 @@ begin
|
||||
ddtBreakpoints: InitBreakPointDlg;
|
||||
ddtWatches: InitWatchesDlg;
|
||||
ddtLocals: InitLocalsDlg;
|
||||
ddtRegisters: InitRegistersDlg;
|
||||
ddtCallStack: InitCallStackDlg;
|
||||
ddtEvaluate: InitEvaluateDlg;
|
||||
end;
|
||||
@ -1422,6 +1495,14 @@ begin
|
||||
TheDialog.Locals := FLocals;
|
||||
end;
|
||||
|
||||
procedure TDebugManager.InitRegistersDlg;
|
||||
var
|
||||
TheDialog: TRegistersDlg;
|
||||
begin
|
||||
TheDialog := TRegistersDlg(FDialogs[ddtRegisters]);
|
||||
TheDialog.Registers := FRegisters;
|
||||
end;
|
||||
|
||||
procedure TDebugManager.InitCallStackDlg;
|
||||
var
|
||||
TheDialog: TCallStackDlg;
|
||||
@ -1451,6 +1532,7 @@ begin
|
||||
FSignals := TManagedSignals.Create(Self);
|
||||
FLocals := TManagedLocals.Create;
|
||||
FCallStack := TManagedCallStack.Create;
|
||||
FRegisters := TManagedRegisters.Create;
|
||||
|
||||
FUserSourceFiles := TStringList.Create;
|
||||
|
||||
@ -1491,6 +1573,8 @@ begin
|
||||
itmViewBreakPoints.Tag := Ord(ddtBreakPoints);
|
||||
itmViewLocals.OnClick := @mnuViewDebugDialogClick;
|
||||
itmViewLocals.Tag := Ord(ddtLocals);
|
||||
itmViewRegisters.OnClick := @mnuViewDebugDialogClick;
|
||||
itmViewRegisters.Tag := Ord(ddtRegisters);
|
||||
itmViewCallStack.OnClick := @mnuViewDebugDialogClick;
|
||||
itmViewCallStack.Tag := Ord(ddtCallStack);
|
||||
itmViewDebugOutput.OnClick := @mnuViewDebugDialogClick;
|
||||
@ -1527,6 +1611,7 @@ begin
|
||||
itmViewBreakpoints.Command:=GetCommand(ecToggleBreakPoints);
|
||||
itmViewDebugOutput.Command:=GetCommand(ecToggleDebuggerOut);
|
||||
itmViewLocals.Command:=GetCommand(ecToggleLocals);
|
||||
itmViewRegisters.Command:=GetCommand(ecToggleRegisters);
|
||||
itmViewCallStack.Command:=GetCommand(ecToggleCallStack);
|
||||
|
||||
itmRunMenuInspect.Command:=GetCommand(ecInspect);
|
||||
@ -2092,6 +2177,7 @@ begin
|
||||
TManagedCallStack(FCallStack).Master := nil;
|
||||
TManagedExceptions(FExceptions).Master := nil;
|
||||
TManagedSignals(FSignals).Master := nil;
|
||||
TManagedRegisters(FRegisters).Master := nil;
|
||||
end
|
||||
else begin
|
||||
TManagedBreakpoints(FBreakpoints).Master := FDebugger.BreakPoints;
|
||||
@ -2100,6 +2186,7 @@ begin
|
||||
TManagedCallStack(FCallStack).Master := FDebugger.CallStack;
|
||||
TManagedExceptions(FExceptions).Master := FDebugger.Exceptions;
|
||||
TManagedSignals(FSignals).Master := FDebugger.Signals;
|
||||
TManagedRegisters(FRegisters).Master := FDebugger.Registers;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -89,6 +89,7 @@ type
|
||||
nmiwLocals,
|
||||
nmiwCallStack,
|
||||
nmiwEvaluate,
|
||||
nmiwRegisters,
|
||||
// extra
|
||||
nmiwSearchResultsViewName,
|
||||
nmiwAnchorEditor,
|
||||
@ -129,6 +130,7 @@ const
|
||||
'Locals',
|
||||
'CallStack',
|
||||
'EvaluateModify',
|
||||
'Registers',
|
||||
// extra
|
||||
'SearchResults',
|
||||
'AnchorEditor',
|
||||
|
||||
@ -282,6 +282,7 @@ resourcestring
|
||||
lisMenuViewWatches = 'Watches';
|
||||
lisMenuViewBreakPoints = 'BreakPoints';
|
||||
lisMenuViewLocalVariables = 'Local Variables';
|
||||
lisMenuViewRegisters = 'Registers';
|
||||
lisMenuViewCallStack = 'Call Stack';
|
||||
lisMenuViewDebugOutput = 'Debug output';
|
||||
lisMenuIDEInternals = 'IDE internals';
|
||||
@ -3834,6 +3835,13 @@ resourcestring
|
||||
lisLocals = 'Locals';
|
||||
lisLocalsDlgName = 'Name';
|
||||
lisLocalsDlgValue = 'Value';
|
||||
|
||||
// Registers Dialog
|
||||
lisRegisters = 'Registers';
|
||||
lisRegistersDlgName = 'Name';
|
||||
lisRegistersDlgValue = 'Value';
|
||||
|
||||
|
||||
lisetEditCustomScanners = 'Edit custom scanners (%s)';
|
||||
|
||||
// ProjectWizard Dialog
|
||||
|
||||
@ -1929,6 +1929,8 @@ begin
|
||||
;//itmViewWatches.OnClick(Self);
|
||||
nmiwLocals:
|
||||
;//itmViewLocals.OnClick(Self);
|
||||
nmiwRegisters:
|
||||
;//itmViewRegisters.OnClick(Self);
|
||||
nmiwCallStack:
|
||||
;//itmViewCallStack.OnClick(Self);
|
||||
end;
|
||||
|
||||
@ -206,6 +206,7 @@ type
|
||||
itmViewWatches: TIDEMenuCommand;
|
||||
itmViewBreakpoints: TIDEMenuCommand;
|
||||
itmViewLocals: TIDEMenuCommand;
|
||||
itmViewRegisters: TIDEMenuCommand;
|
||||
itmViewCallStack: TIDEMenuCommand;
|
||||
itmViewDebugOutput: TIDEMenuCommand;
|
||||
//itmViewIDEInternalsWindows: TIDEMenuSection;
|
||||
|
||||
@ -557,6 +557,7 @@ begin
|
||||
CreateMenuItem(itmViewDebugWindows,itmViewWatches,'itmViewWatches',lisMenuViewWatches,'debugger_watches');
|
||||
CreateMenuItem(itmViewDebugWindows,itmViewBreakPoints,'itmViewBreakPoints',lisMenuViewBreakPoints,'debugger_breakpoints');
|
||||
CreateMenuItem(itmViewDebugWindows,itmViewLocals,'itmViewLocals',lisMenuViewLocalVariables,'');
|
||||
CreateMenuItem(itmViewDebugWindows,itmViewRegisters,'itmViewRegisters',lisMenuViewRegisters,'');
|
||||
CreateMenuItem(itmViewDebugWindows,itmViewCallStack,'itmViewCallStack',lisMenuViewCallStack,'debugger_call_stack');
|
||||
CreateMenuItem(itmViewDebugWindows,itmViewDebugOutput,'itmViewDebugOutput',lisMenuViewDebugOutput,'debugger_output');
|
||||
end;
|
||||
|
||||
@ -180,6 +180,7 @@ const
|
||||
ecViewComponents = ecFirstLazarus + 321;
|
||||
ecToggleRestrictionBrowser = ecFirstLazarus + 322;
|
||||
ecViewTodoList = ecFirstLazarus + 323;
|
||||
ecToggleRegisters = ecFirstLazarus + 324;
|
||||
|
||||
// sourcenotebook commands
|
||||
ecNextEditor = ecFirstLazarus + 330;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user