/debugger/registersdlg.pp
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