PageRenderTime 62ms CodeModel.GetById 13ms app.highlight 44ms RepoModel.GetById 2ms app.codeStats 0ms

/debugger/registersdlg.pp

http://github.com/graemeg/lazarus
Pascal | 469 lines | 370 code | 57 blank | 42 comment | 31 complexity | 5420d4519d66d77061c76eafcbb5b7f4 MD5 | raw file
  1{ $Id$ }
  2{               ----------------------------------------------  
  3                 registersdlg.pp  -  Overview of registers 
  4                ---------------------------------------------- 
  5 
  6 @created(Sun Nov 16th WET 2008)
  7 @lastmod($Date$)
  8 @author(Marc Weustink <marc@@dommelstein.net>)                       
  9
 10 This unit contains the registers debugger dialog.
 11 
 12 
 13 ***************************************************************************
 14 *                                                                         *
 15 *   This source is free software; you can redistribute it and/or modify   *
 16 *   it under the terms of the GNU General Public License as published by  *
 17 *   the Free Software Foundation; either version 2 of the License, or     *
 18 *   (at your option) any later version.                                   *
 19 *                                                                         *
 20 *   This code is distributed in the hope that it will be useful, but      *
 21 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
 22 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
 23 *   General Public License for more details.                              *
 24 *                                                                         *
 25 *   A copy of the GNU General Public License is available on the World    *
 26 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
 27 *   obtain it by writing to the Free Software Foundation,                 *
 28 *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
 29 *                                                                         *
 30 ***************************************************************************
 31}
 32unit RegistersDlg;
 33
 34{$mode objfpc}{$H+}
 35
 36interface
 37
 38uses
 39  SysUtils, Classes, Controls, Forms, Clipbrd,
 40  BaseDebugManager, IDEWindowIntf, DebuggerStrConst,
 41  ComCtrls, ActnList, Menus, Debugger, DebuggerDlg,
 42  LazarusIDEStrConsts, IDEImagesIntf, DbgIntfDebuggerBase;
 43
 44type
 45
 46  { TRegistersDlg }
 47
 48  TRegistersDlg = class(TDebuggerDlg)
 49    actCopyName: TAction;
 50    actCopyValue: TAction;
 51    actPower: TAction;
 52    ActionList1: TActionList;
 53    ImageList1: TImageList;
 54    lvRegisters: TListView;
 55    DispDefault: TMenuItem;
 56    DispHex: TMenuItem;
 57    DispBin: TMenuItem;
 58    DispOct: TMenuItem;
 59    DispDec: TMenuItem;
 60    DispRaw: TMenuItem;
 61    PopDispDefault: TMenuItem;
 62    PopDispHex: TMenuItem;
 63    PopDispBin: TMenuItem;
 64    PopDispOct: TMenuItem;
 65    PopDispDec: TMenuItem;
 66    PopDispRaw: TMenuItem;
 67    popCopyValue: TMenuItem;
 68    popCopyName: TMenuItem;
 69    popFormat: TMenuItem;
 70    popL1: TMenuItem;
 71    PopupDispType: TPopupMenu;
 72    PopupMenu1: TPopupMenu;
 73    ToolBar1: TToolBar;
 74    ToolButton1: TToolButton;
 75    ToolButtonDispType: TToolButton;
 76    ToolButtonPower: TToolButton;
 77    procedure actCopyNameExecute(Sender: TObject);
 78    procedure actCopyValueExecute(Sender: TObject);
 79    procedure actPowerExecute(Sender: TObject);
 80    procedure DispDefaultClick(Sender: TObject);
 81    procedure lvRegistersSelectItem(Sender: TObject; Item: TListItem; {%H-}Selected: Boolean);
 82    procedure ToolButtonDispTypeClick(Sender: TObject);
 83    function GetCurrentRegisters: TRegisters;
 84  private
 85    FNeedUpdateAgain: Boolean;
 86    FPowerImgIdx, FPowerImgIdxGrey: Integer;
 87    procedure RegistersChanged(Sender: TObject);
 88  protected
 89    procedure DoRegistersChanged; override;
 90    procedure DoBeginUpdate; override;
 91    procedure DoEndUpdate; override;
 92    function  ColSizeGetter(AColId: Integer; var ASize: Integer): Boolean;
 93    procedure ColSizeSetter(AColId: Integer; ASize: Integer);
 94  public
 95    constructor Create(AOwner: TComponent); override;
 96    destructor Destroy; override;
 97
 98    property RegistersMonitor;
 99    property ThreadsMonitor;
100    property CallStackMonitor;
101    //property SnapshotManager;
102  end;
103
104
105implementation
106
107{$R *.lfm}
108
109var
110  RegisterDlgWindowCreator: TIDEWindowCreator;
111
112const
113  COL_REGISTER_NAME   = 1;
114  COL_REGISTER_VALUE  = 2;
115  COL_WIDTHS: Array[0..1] of integer = ( 150, 50);
116
117function RegisterDlgColSizeGetter(AForm: TCustomForm; AColId: Integer; var ASize: Integer): Boolean;
118begin
119  Result := AForm is TRegistersDlg;
120  if Result then
121    Result := TRegistersDlg(AForm).ColSizeGetter(AColId, ASize);
122end;
123
124procedure RegisterDlgColSizeSetter(AForm: TCustomForm; AColId: Integer; ASize: Integer);
125begin
126  if AForm is TRegistersDlg then
127    TRegistersDlg(AForm).ColSizeSetter(AColId, ASize);
128end;
129
130{ TRegistersDlg }
131
132constructor TRegistersDlg.Create(AOwner: TComponent);
133var
134  i: Integer;
135begin
136  inherited Create(AOwner);
137  ThreadsNotification.OnCurrent   := @RegistersChanged;
138  CallstackNotification.OnCurrent := @RegistersChanged;
139  RegistersNotification.OnChange  := @RegistersChanged;
140
141  Caption:= lisRegisters;
142  lvRegisters.Columns[0].Caption:= lisName;
143  lvRegisters.Columns[1].Caption:= lisValue;
144
145  ActionList1.Images := IDEImages.Images_16;
146  ToolBar1.Images := IDEImages.Images_16;
147
148  FPowerImgIdx := IDEImages.LoadImage(16, 'debugger_power');
149  FPowerImgIdxGrey := IDEImages.LoadImage(16, 'debugger_power_grey');
150  actPower.ImageIndex := FPowerImgIdx;
151  //actPower.Caption := lisDbgWinPower;
152  actPower.Hint := lisDbgWinPowerHint;
153
154  actCopyName.Caption := lisLocalsDlgCopyName;
155  actCopyValue.Caption := lisLocalsDlgCopyValue;
156
157  ToolButtonDispType.Hint := regdlgDisplayTypeForSelectedRegisters;
158
159  DispDefault.Caption := dlgPasStringKeywordsOptDefault;
160  DispHex.Caption := regdlgHex;
161  DispBin.Caption := regdlgBinary;
162  DispOct.Caption := regdlgOctal;
163  DispDec.Caption := regdlgDecimal;
164  DispRaw.Caption := regdlgRaw;
165  DispDefault.Tag := ord(rdDefault);
166  DispHex.Tag := ord(rdHex);
167  DispBin.Tag := ord(rdBinary);
168  DispOct.Tag := ord(rdOctal);
169  DispDec.Tag := ord(rdDecimal);
170  DispRaw.Tag := ord(rdRaw);
171
172  PopDispDefault.Caption := dlgPasStringKeywordsOptDefault;
173  PopDispHex.Caption := regdlgHex;
174  PopDispBin.Caption := regdlgBinary;
175  PopDispOct.Caption := regdlgOctal;
176  PopDispDec.Caption := regdlgDecimal;
177  PopDispRaw.Caption := regdlgRaw;
178  PopDispDefault.Tag := ord(rdDefault);
179  PopDispHex.Tag := ord(rdHex);
180  PopDispBin.Tag := ord(rdBinary);
181  PopDispOct.Tag := ord(rdOctal);
182  PopDispDec.Tag := ord(rdDecimal);
183  PopDispRaw.Tag := ord(rdRaw);
184
185  popFormat.Caption := regdlgFormat;
186
187  actCopyName.Caption := lisLocalsDlgCopyName;
188  actCopyValue.Caption := lisLocalsDlgCopyValue;
189
190  for i := low(COL_WIDTHS) to high(COL_WIDTHS) do
191    lvRegisters.Column[i].Width := COL_WIDTHS[i];
192end;
193
194destructor TRegistersDlg.Destroy;
195begin
196  inherited Destroy;
197end;
198
199procedure TRegistersDlg.actPowerExecute(Sender: TObject);
200begin
201  if ToolButtonPower.Down
202  then begin
203    actPower.ImageIndex := FPowerImgIdx;
204    ToolButtonPower.ImageIndex := FPowerImgIdx;
205    RegistersChanged(nil);
206  end
207  else begin
208    actPower.ImageIndex := FPowerImgIdxGrey;
209    ToolButtonPower.ImageIndex := FPowerImgIdxGrey;
210  end;
211end;
212
213procedure TRegistersDlg.actCopyNameExecute(Sender: TObject);
214begin
215  Clipboard.Open;
216  Clipboard.AsText := lvRegisters.Selected.Caption;
217  Clipboard.Close;
218end;
219
220procedure TRegistersDlg.actCopyValueExecute(Sender: TObject);
221begin
222  Clipboard.Open;
223  Clipboard.AsText := lvRegisters.Selected.SubItems[0];
224  Clipboard.Close;
225end;
226
227procedure TRegistersDlg.DispDefaultClick(Sender: TObject);
228var
229  n: Integer;
230  Item: TListItem;
231  Reg: TRegisters;
232  RegVal: TRegisterValue;
233begin
234  ToolButtonPower.Down := True;
235  Reg := GetCurrentRegisters;
236  if Reg = nil then exit;
237
238  for n := 0 to lvRegisters.Items.Count -1 do
239  begin
240    Item := lvRegisters.Items[n];
241    if Item.Selected then begin
242      RegVal := Reg.EntriesByName[Item.Caption];
243      if RegVal <> nil then
244        RegVal.DisplayFormat := TRegisterDisplayFormat(TMenuItem(Sender).Tag);
245    end;
246  end;
247  lvRegistersSelectItem(nil, nil, True);
248end;
249
250procedure TRegistersDlg.lvRegistersSelectItem(Sender: TObject; Item: TListItem;
251  Selected: Boolean);
252var
253  n, j: Integer;
254  SelFormat: TRegisterDisplayFormat;
255  MultiFormat: Boolean;
256  Reg: TRegisters;
257  RegVal: TRegisterValue;
258begin
259  j := 0;
260  MultiFormat := False;
261  SelFormat := rdDefault;
262  Reg := GetCurrentRegisters;
263  if Reg = nil then exit;
264
265  for n := 0 to lvRegisters.Items.Count -1 do
266  begin
267    Item := lvRegisters.Items[n];
268    if Item.Selected then begin
269      RegVal := Reg.EntriesByName[Item.Caption];
270      if RegVal <> nil then begin
271        if j = 0
272        then SelFormat := RegVal.DisplayFormat;
273        inc(j);
274        if SelFormat <> RegVal.DisplayFormat then begin
275          MultiFormat := True;
276          break;
277        end;
278      end;
279    end;
280  end;
281  ToolButtonDispType.Enabled := j > 0;
282  popFormat.Enabled := j > 0;
283  actCopyName.Enabled := j > 0;
284  actCopyValue.Enabled := j > 0;
285
286  PopDispDefault.Checked := False;
287  PopDispHex.Checked := False;
288  PopDispBin.Checked := False;
289  PopDispOct.Checked := False;
290  PopDispDec.Checked := False;
291  PopDispRaw.Checked := False;
292  if MultiFormat
293  then ToolButtonDispType.Caption := '...'
294  else begin
295    case SelFormat of
296      rdDefault: begin
297          ToolButtonDispType.Caption := DispDefault.Caption;
298          PopDispDefault.Checked := True;
299        end;
300      rdHex:     begin
301          ToolButtonDispType.Caption := DispHex.Caption;
302          PopDispHex.Checked := True;
303        end;
304      rdBinary:  begin
305          ToolButtonDispType.Caption := DispBin.Caption;
306          PopDispBin.Checked := True;
307        end;
308      rdOctal:   begin
309          ToolButtonDispType.Caption := DispOct.Caption;
310          PopDispOct.Checked := True;
311        end;
312      rdDecimal: begin
313          ToolButtonDispType.Caption := DispDec.Caption;
314          PopDispDec.Checked := True;
315        end;
316      rdRaw:     begin
317          ToolButtonDispType.Caption := DispRaw.Caption;
318          PopDispRaw.Checked := True;
319        end;
320    end;
321  end;
322end;
323
324procedure TRegistersDlg.ToolButtonDispTypeClick(Sender: TObject);
325begin
326  ToolButtonDispType.CheckMenuDropdown;
327end;
328
329function TRegistersDlg.GetCurrentRegisters: TRegisters;
330var
331  CurThreadId, CurStackFrame: Integer;
332begin
333  Result := nil;
334  if (ThreadsMonitor = nil) or
335     (ThreadsMonitor.CurrentThreads = nil) or
336     (CallStackMonitor = nil) or
337     (CallStackMonitor.CurrentCallStackList = nil) or
338     (RegistersMonitor = nil)
339  then
340    exit;
341
342  CurThreadId := ThreadsMonitor.CurrentThreads.CurrentThreadId;
343  if (CallStackMonitor.CurrentCallStackList.EntriesForThreads[CurThreadId] = nil) then
344    exit;
345
346  CurStackFrame := CallStackMonitor.CurrentCallStackList.EntriesForThreads[CurThreadId].CurrentIndex;
347  Result := RegistersMonitor.CurrentRegistersList[CurThreadId, CurStackFrame];
348end;
349
350procedure TRegistersDlg.RegistersChanged(Sender: TObject);
351var
352  n, idx, Cnt: Integer;
353  List: TStringList;
354  Item: TListItem;
355  S: String;
356  Reg: TRegisters;
357begin
358  if (not ToolButtonPower.Down) then exit;
359
360  if IsUpdating then begin
361    FNeedUpdateAgain := True;
362    exit;
363  end;
364  FNeedUpdateAgain := False;
365
366  Reg := GetCurrentRegisters;
367  if Reg = nil then begin
368    lvRegisters.Items.Clear;
369    exit;
370  end;
371
372  List := TStringList.Create;
373  try
374    BeginUpdate;
375    try
376      //Get existing items
377      for n := 0 to lvRegisters.Items.Count - 1 do
378      begin
379        Item := lvRegisters.Items[n];
380        S := Item.Caption;
381        S := UpperCase(S);
382        List.AddObject(S, Item);
383      end;
384
385      // add/update entries
386      Cnt := Reg.Count;          // Count may trigger changes
387      FNeedUpdateAgain := False; // changes after this point, and we must update again
388
389      for n := 0 to Cnt - 1 do
390      begin
391        idx := List.IndexOf(Uppercase(Reg[n].Name));
392        if idx = -1
393        then begin
394          // New entry
395          Item := lvRegisters.Items.Add;
396          Item.Caption := Reg[n].Name;
397          Item.SubItems.Add(Reg[n].Value);
398        end
399        else begin
400          // Existing entry
401          Item := TListItem(List.Objects[idx]);
402          Item.SubItems[0] := Reg[n].Value;
403          List.Delete(idx);
404        end;
405        if Reg[n].Modified
406        then Item.ImageIndex := 0
407        else Item.ImageIndex := -1;
408      end;
409
410      // remove obsolete entries
411      for n := 0 to List.Count - 1 do
412        lvRegisters.Items.Delete(TListItem(List.Objects[n]).Index);
413
414    finally
415      EndUpdate;
416    end;
417  finally
418    List.Free;
419  end;
420
421  lvRegistersSelectItem(nil, nil, True);
422end;
423
424procedure TRegistersDlg.DoRegistersChanged;
425begin
426  RegistersChanged(nil);
427end;
428
429procedure TRegistersDlg.DoBeginUpdate;
430begin
431  lvRegisters.BeginUpdate;
432end;
433
434procedure TRegistersDlg.DoEndUpdate;
435begin
436  lvRegisters.EndUpdate;
437  if FNeedUpdateAgain then RegistersChanged(nil);
438end;
439
440function TRegistersDlg.ColSizeGetter(AColId: Integer; var ASize: Integer): Boolean;
441begin
442  if (AColId - 1 >= 0) and (AColId - 1 < lvRegisters.ColumnCount) then begin
443    ASize := lvRegisters.Column[AColId - 1].Width;
444    Result := ASize <> COL_WIDTHS[AColId - 1];
445  end
446  else
447    Result := False;
448end;
449
450procedure TRegistersDlg.ColSizeSetter(AColId: Integer; ASize: Integer);
451begin
452  case AColId of
453    COL_REGISTER_NAME:   lvRegisters.Column[0].Width := ASize;
454    COL_REGISTER_VALUE:  lvRegisters.Column[1].Width := ASize;
455  end;
456end;
457
458initialization
459
460  RegisterDlgWindowCreator := IDEWindowCreators.Add(DebugDialogNames[ddtRegisters]);
461  RegisterDlgWindowCreator.OnCreateFormProc := @CreateDebugDialog;
462  RegisterDlgWindowCreator.OnSetDividerSize := @RegisterDlgColSizeSetter;
463  RegisterDlgWindowCreator.OnGetDividerSize := @RegisterDlgColSizeGetter;
464  RegisterDlgWindowCreator.DividerTemplate.Add('RegisterName',  COL_REGISTER_NAME,  @drsColWidthName);
465  RegisterDlgWindowCreator.DividerTemplate.Add('RegisterValue', COL_REGISTER_VALUE, @drsColWidthValue);
466  RegisterDlgWindowCreator.CreateSimpleLayout;
467
468end.
469